!-------------------------------------- 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 set_step - initialization of common block TIMESTEP
*
#include "model_macros_f.h"
*
integer function set_step(F_argc,F_argv_S,F_cmdtyp,F_v1,F_v2)
*
#include "impnone.cdk"
*
integer F_argc,F_v1,F_v2
character *(*) F_argv_S(0:F_argc),F_cmdtyp
character*5 stuff
*
*author Vivian Lee - RPN - April 1999
*
*revision
* v2_00 - Lee V. - initial MPI version
* v2_32 - Lee V. - stepset is now an ID defined by the user, not the
* v2_32 actual "set" number forced to be in sequence
* v3_02 - Lee V. - eliminate steps repeated in one step set
*
*
*object
* initialization of the common block TIMESTEP. This function is
* called when the keyword "steps" is found in the first word
* of the directives in the input file given in the statement
* "process_f_callback". This feature is enabled by the
* ARMNLIB "rpn_fortran_callback" routine (called in "srequet")
* which allows a different way of passing user directives than
* the conventional FORTRAN namelist. This function will process
* the following example command read from the named input file.
*
* ie: steps=1,hour,0.,3.,6.,12.,24.,48.;
*
* The "rpn_fortran_callback" routine will process the above
* statement and return 5 arguments to this function. For more
* information to how this is processed, see "SREQUET".
*
*arguments
* Name I/O Description
*----------------------------------------------------------------
* F_argc I - number of elements in F_argv_S
* F_argv_S I - array of elements received
* if F_argv_S(ii) contains "[", the value in this
* argument indicates number of elements following it.
* F_cmdtyp I - character command type - not used
* F_v1 I - integer parameter 1 - not used
* F_v2 I - integer parameter 2 - not used
*
*Notes:
*
* steps=stepset#,[init],step/hour,{list};
*
* ie: steps=2,step,-1;
* steps=3,hour,<0.,48.,3.>;
* steps=4,init,step,<0.,6.,1.>;
* steps=5,step,[1,2,3,9,11];
*
* Should label the stepset# sequentially: 1,2,3,....
* 'init' - means this command only applies to output during the
* initialization period
* 'hour' - output in hours
* 'step' - output in timesteps in the model
* '-1' with "step" will give every timestep of the model
* [a,b,c] means a,b and c are requested
* <a,b,c> means a to b, incrementing every c are requested
*
*
*implicits
#include "glb_ld.cdk"
#include "cstv.cdk"
#include "dimout.cdk"
#include "timestep.cdk"
#include "step.cdk"
#include "lun.cdk"
*modules
**
*
integer i,j,k,ii,num,istep
logical hour_flag,step_flag,found_L
real frarg,hour,step
integer transtep,stepset,argc_out
transtep(frarg) = nint(3600.0 * frarg / Cstv_dt_8)
argc_out=min(F_argc,6)
if (Lun_out.gt.0) then
write(Lun_out,*)
if (argc_out.lt.F_argc) then
write(Lun_out,*) F_argv_S(0),'=',F_argv_S(1),',',F_argv_S(2),',',(F_argv_S(i),i=3,argc_out),'...'
else
write(Lun_out,*) F_argv_S(0),'=',F_argv_S(1),',',F_argv_S(2),',',(F_argv_S(i),i=3,argc_out)
endif
endif
set_step=0
read(F_argv_S(1),*)stepset
Timestep_sets = Timestep_sets + 1
if (Timestep_sets.gt.MAXSET) then
if (Lun_out.gt.0)
$ write(Lun_out,*)'SET_STEP WARNING: too many TIMESTEP sets'
Timestep_sets = Timestep_sets - 1
set_step=1
return
endif
j=Timestep_sets
i=0
hour_flag = .false.
step_flag = .false.
Timestep_id(j)=stepset
Timestep_init_L(j)=.false.
do 100 ii=2,F_argc
if (index(F_argv_S(ii),'[').gt.0) then
stuff=F_argv_S(ii)
read(stuff(2:4),*) num
else if (F_argv_S(ii).eq.'hour') then
hour_flag = .true.
step_flag = .false.
else if (F_argv_S(ii).eq.'step') then
step_flag = .true.
hour_flag = .false.
else if (F_argv_S(ii).eq.'init') then
Timestep_init_L(j)=.true.
else if (step_flag) then
i = i+1
read(F_argv_S(ii),*)step
if (step.eq.-1) then
i = i-1
do 70 istep=0,Step_total
i = i+1
Timestep(i,j)=istep
70 continue
else
Timestep(i,j)=int(step)
endif
else if (hour_flag) then
i = i+1
read(F_argv_S(ii),*)hour
Timestep(i,j)=transtep(hour)
else
if (Lun_out.gt.0)
$ write(Lun_out,*)'SET_STEP WARNING: Timestep type not recognizable'
Timestep_sets = Timestep_sets - 1
set_step=1
return
endif
100 continue
if (i.gt.MAXSTEP) then
if (Lun_out.gt.0)
$ write(Lun_out,*)'SET_STEP WARNING: Requested timesteps > MAXSTEP'
Timestep_sets = Timestep_sets - 1
set_step=1
return
endif
*
* Eliminate repeated timesteps in one Timestep set
istep = 1
do ii = 2, i
found_L = .false.
do k = 1, ii-1
if ( Timestep(ii,j).eq.Timestep(k,j) ) found_L = .true.
enddo
if (.not. found_L) then
istep = istep + 1
Timestep(istep,j) = Timestep(ii,j)
endif
enddo
Timestep_max(Timestep_sets)=istep
if (Lun_out.gt.0) then
write(Lun_out,*) ' Timestep_set(',j,') : Timestep_id=',Timestep_id(j)
write(Lun_out,*) ' Timestep_init_L=',Timestep_init_L(j)
if (Timestep_max(j).gt.30) then
write(Lun_out,*) ' Timestep=',
$ (Timestep(i,j),i=1,30),',... up to ,',Timestep(Timestep_max(j),j)
else
write(Lun_out,*) ' Timestep=',(Timestep(i,j),i=1,Timestep_max(j))
endif
endif
return
end