!-------------------------------------- LICENCE BEGIN ------------------------------------
!Environment Canada - Atmospheric Science and Technology License/Disclaimer,
! version 3; Last Modified: May 7, 2008.
!This is free but copyrighted software; you can use/redistribute/modify it under the terms
!of the Environment Canada - Atmospheric Science and Technology License/Disclaimer
!version 3 or (at your option) any later version that should be found at:
!http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html
!
!This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
!without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
!See the above mentioned License/Disclaimer for more details.
!You should have received a copy of the License/Disclaimer along with this software;
!if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec),
!CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca
!-------------------------------------- LICENCE END --------------------------------------
***s/r sergini - Prepares "first record" output for time series.
*
#include "model_macros_f.h"
*
subroutine sergini 1,22
*
implicit none
*
*author
* Andre Methot - cmc - june 1994 v0_14
*
*revision
* v2_00 - Desgagne M. - initial MPI version
* v2_20 - Lee V. - extract geophysical fields for time-series
* v2_20 from physics permanent bus,not VMM variables
* v3_11 - A. Plante - Adjust code for LAM time-series
* v3_20 - Winger K. - correct time series handling in climate mode
* v3_30 - Winger K. - Change serset to serset8 for HEURE
* v3_30 - Desgagne M. - Remove Mem_phyncore_L
*
*object
* This subroutine is part of time serie's package
* initialisation. It extracts and produce output of constant
* fields to be used by the unwrapper.
*
*arguments
* none
*
*notes
* This code is done once per model's run.
*
* The method used here is similar to SEF or RFE equivalent.
* The constraint here is to perform extractions and output
* of header and a hardcoded list of geophysical variables
* using the same calls as a real time serie's variable.
*
* The user's given list of time serie's variables is then
* temporarly overwritten by the list of constant fields.
*
* The constant fields are then loaded, and extracted.
*
* Finally, the user's given list of time serie's variables is
* re-initialised.
*
*implicits
#include "glb_ld.cdk"
#include "dcst.cdk"
#include "p_serg.cdk"
#include "lun.cdk"
#include "rstr.cdk"
#include "xst.cdk"
#include "itf_phy_buses.cdk"
#include "itf_phy_busind.cdk"
#include "clim.cdk"
#include "mem.cdk"
*
*modules
*
character *8 ptgeonm(CNSRGEO), ptbidon
integer pnsurf, i, j, m, pnerr
real prcon
real w1(p_ni),w2(p_ni),w3(p_ni),busper,busper2(max(1,p_bper_siz))
pointer (pabusper,busper(*))
**
* ---------------------------------------------------------------
*
* -----------------------------------------------------------
*C 1- skip this subroutine if in non-climate restart mode or
* if no time series are requested
* -----------------------------------------------------------
*
if ( .not. Clim_climat_L .and. Rstri_rstn_L ) goto 500
if ( Xst_nstat .le. 0 ) goto 500
*
if (lun_out.gt.0) write(Lun_out,1001)
*
* ---------------------------------------------------------------
*C 3- Building of a list of variable names for geophysical fields
* ---------------------------------------------------------------
*
ptgeonm(1) = 'MA'
ptgeonm(2) = 'LA'
ptgeonm(3) = 'LO'
ptgeonm(4) = 'ZP'
ptgeonm(5) = 'MG'
ptgeonm(6) = 'LH'
ptgeonm(7) = 'AL'
ptgeonm(8) = 'SD'
ptgeonm(9) = 'TM'
ptgeonm(10) = 'TP'
ptgeonm(11) = 'GL'
ptgeonm(12) = 'HS'
pnsurf = 12
if (pnsurf.gt.CNSRGEO) then
write(Lun_out,*)
$ 'Dimension for ptgeonm TOO SMALL, CNSRGEO= ', CNSRGEO
write(Lun_out,*)'Change CNSRGEO in p_serg.cdk > ',pnsurf
call gefstop('SERGINI')
endif
*
* ---------------------------------------------------------------
*C 4- Temporarily over-writing the user time serie's variable list
* with a list of geophysical variables
* ---------------------------------------------------------------
*
call sersetc('SURFACE', ptgeonm, pnsurf, pnerr)
call sersetc('PROFILS', ptbidon, 0, pnerr)
call serset('KOUNT', 0, 1, pnerr)
call serset8('HEURE', 0.d0, 1, pnerr)
call serdbu
*
* ---------------------------------------------------------------
*C 5- Extract time-series values for geophysical variables
* ---------------------------------------------------------------
*
prcon = 180./Dcst_pi_8
*
do 35 j= 1, p_nj
*
pabusper = loc (Phy_busper3D((j-1)*p_bper_siz+1))
do i= 1, p_ni
w1(i) = 1.0
w2(i) = busper(dlat+i-1) * prcon
w3(i) = busper(dlon+i-1) * prcon
if (w3(i).lt.0) w3(i)=360.+w3(i)
end do
*
call serxst( w1(1), 'MA',j, p_ni, 0.0, 1.0, -1)
call serxst( w2(1), 'LA',j, p_ni, 0.0, 1.0, -1)
call serxst( w3(1), 'LO',j, p_ni, 0.0, 1.0, -1)
call serxst(busper (z0), 'ZP',j, p_ni, 0.0, 1.0, -1)
call serxst(busper (mg), 'MG',j, p_ni, 0.0, 1.0, -1)
call serxst(busper (lhtg), 'LH',j, p_ni, 0.0, 1.0, -1)
call serxst(busper(alvis), 'AL',j, p_ni, 0.0, 1.0, -1)
call serxst(busper(snodp), 'SD',j, p_ni, 0.0, 1.0, -1)
call serxst(busper(twater),'TM',j, p_ni, 0.0, 1.0, -1)
call serxst(busper(tsoil), 'TP',j, p_ni, 0.0, 1.0, -1)
call serxst(busper(glsea), 'GL',j, p_ni, 0.0, 1.0, -1)
call serxst(busper(wsoil), 'HS',j, p_ni, 0.0, 1.0, -1)
35 continue
call sergout(.true.)
*
* ---------------------------------------------------------------
*C 7- Reset to extracting fields for the user time serie's variable list
* ---------------------------------------------------------------
*
call sersetc('SURFACE', P_serg_srsrf_s, P_serg_srsrf, pnerr)
call sersetc('PROFILS', P_serg_srprf_s, P_serg_srprf, pnerr)
call serdbu
if(Lun_out.gt.0)then
write(Lun_out,*)'TIME SERIES VARIABLES REQUESTED BY USER :'
write(Lun_out,*)'NUMBER OF SURFACE VARIABLES=',P_serg_srsrf
write(Lun_out,*)'LISTE OF SURFACE VARIABLES :',
$ (P_serg_srsrf_s(i),i=1,P_serg_srsrf)
write(Lun_out,*)'NUMBER OF PROFILE VARIABLES=',P_serg_srprf
write(Lun_out,*)'LISTE OF PROFILE VARIABLES :',
$ (P_serg_srprf_s(i),i=1,P_serg_srprf)
endif
*
1001 format(
+/,'INITIALISATION OF TIME SERIES PACKAGE (S/R SERGINI)',
+/,'===================================================')
*
500 continue
*
* ---------------------------------------------------------------
*
return
end