*IF DEF,CONTROL SETTSCT1.2
C ******************************COPYRIGHT****************************** GTS2F400.8749
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.8750
C GTS2F400.8751
C Use, duplication or disclosure of this code is subject to the GTS2F400.8752
C restrictions as set forth in the contract. GTS2F400.8753
C GTS2F400.8754
C Meteorological Office GTS2F400.8755
C London Road GTS2F400.8756
C BRACKNELL GTS2F400.8757
C Berkshire UK GTS2F400.8758
C RG12 2SZ GTS2F400.8759
C GTS2F400.8760
C If no contract has been raised with this copy of the code, the use, GTS2F400.8761
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.8762
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.8763
C Modelling at the above address. GTS2F400.8764
C ******************************COPYRIGHT****************************** GTS2F400.8765
C GTS2F400.8766
CLL Routine: SETTSCTL ------------------------------------------------- SETTSCT1.3
CLL SETTSCT1.4
CLL Purpose: Sets timestep loop control switches and STASHflags. SETTSCT1.5
CLL Note STEP on entry is the values at the N+1 (ie. updated) SETTSCT1.6
CLL timelevel; control switches are therefore set using SETTSCT1.7
CLL A_STEP/O_STEP, whereas physical switches are set using SETTSCT1.8
CLL A_STEP-1/O_STEP-1 to ensure correct synchronisation. SETTSCT1.9
CLL Note also that step on entry is N (i.e. not updated) when SETTSCT1.10
CCL called from INITIAL. SETTSCT1.11
CCL SETTSCT1.12
CLL Tested under compiler: cft77 SETTSCT1.13
CLL Tested under OS version: UNICOS 5.1 SETTSCT1.14
CLL SETTSCT1.15
CLL Author: T.C.Johns SETTSCT1.16
CLL SETTSCT1.17
CLL Model Modification history from model version 3.0: SETTSCT1.18
CLL version Date SETTSCT1.19
CLL 3.2 27/03/93 Dynamic allocation of main data arrays. R. Rawlins @DYALLOC.3260
CLL @DYALLOC.3261
CLL 3.1 4/2/93 1. Cater for boundary files for multiple LAM areas DR240293.1005
CLL 2. Rearrange code in loop which sets PP file DR240293.1006
CLL switches (LPP/LPP_SELECT) for timestep. DR240293.1007
CLL 3.1 8/02/93 : Altered loop over units to use NUNITS from TJ061293.72
CLL CHSUNITS. TJ061293.73
CLL 3.2 13/07/93 Changed CHARACTER*(*) to CHARACTER*(80) for TS150793.183
CLL portability. Author Tracey Smith. TS150793.184
CLL 3.2 7/6/93 Set SF(0,sect)=TRUE if any item to process in the @DYALLOC.3262
CLL section, FALSE otherwise. (TCJ) @DYALLOC.3263
CLL 3.3 03/09/93 Set L_CONVECT to control calls to convection scheme RB300993.121
CLL in CONV_CTL. R.T.H.Barnes. RB300993.122
CLL 3.3 26/10/93 M. Carter. Part of an extensive mod that: MC261093.247
CLL 1.Removes the limit on primary STASH item numbers. MC261093.248
CLL 2.Removes the assumption that (section,item) MC261093.249
CLL defines the sub-model. MC261093.250
CLL 3.Thus allows for user-prognostics. MC261093.251
CLL Remove reference to A_MAX_VARIABLE MC261093.252
CLL New indexing for PPXREF MC261093.253
CLL 3.3 02/12/93 Generalise switch settings for SLAB model (TCJ). TJ061293.74
CLL 3.3 21/12/93 Change LEXIT so that is also set to true if the TJ061293.75
CLL run end time has been reached. (Claire Douglas) TJ061293.76
CLL 3.4 27/09/94 Use ANCIL_REFTIME to improve time interpolation of GRB1F304.211
CLL ancillaries, with offset in LANCILLARY. RTHBarnes. GRB1F304.212
CLL 3.5 18/04/95 Submodels Stage 1. Replace hardwired submodels with GRB1F305.516
CLL generic forms where possible. R. Rawlins GRB1F305.517
CLL 4.1 29/02/96 Introduce Wave sub-model. RTHBarnes. WRB1F401.752
CLL 4.1 26/04/96 Allow an offset from model_basis_time for GOK1F401.8
CLL logical switch LBOUNDARY. S.Ineson GOK1F401.9
CLL 4.1 15/05/96 Revise use of O_INT_OBS_FRSH M. J. Bell OMB1F401.98
CLL 4.4 21/10/97 Update data time during IAU run. Adam Clayton. VSB2F404.102
CLL VSB2F404.103
!LL 4.4 05/09/97 Add flag to reset net flux field. S.D.Mullerworth GSM3F404.13
!LL 4.4 06/06/97 Allow reinitialisation of non-mean PP files on real GMG1F404.302
!LL month boundaries, as long as 365d calendar used. GMG1F404.303
!LL M.Gallani GMG1F404.304
!LL 4.5 10/11/98 Increase number of dumps allowed at irregular GRR2F405.57
!LL timesteps from 10 to 40: move lengths into GRR2F405.58
!LL CNTLGEN. R Rawlins GRR2F405.59
!LL 4.5 29/07/98 New naming convention for boundary files. GDR2F405.149
!LL D. Robinson. GDR2F405.150
!LL 4.5 29/07/98 Generalise for atmos & ocean boundary files. GMB1F405.539
!LL Call INTF_AREA. M. Bell/P. Horrocks. GMB1F405.540
!LL GMG1F404.305
CLL Programming standard: UM Doc Paper 3, version 2 (07/9/90) SETTSCT1.21
CLL SETTSCT1.22
CLL Logical components covered: C0 SETTSCT1.23
CLL SETTSCT1.24
CLL Project task: C0 SETTSCT1.25
CLL SETTSCT1.26
CLL External documentation: On-line UM document C0 - The top-level SETTSCT1.27
CLL control system SETTSCT1.28
CLL SETTSCT1.29
CLLEND------------------------------------------------------------------ SETTSCT1.30
C*L Interface and arguments: ------------------------------------------ SETTSCT1.31
C SETTSCT1.32
SUBROUTINE SETTSCTL ( 2,4@DYALLOC.3264
*CALL ARGSIZE 
@DYALLOC.3265
*CALL ARGDUMA @DYALLOC.3266
*CALL ARGDUMO @DYALLOC.3267
*CALL ARGDUMW WRB1F401.753
*CALL ARGSTS @DYALLOC.3268
*CALL ARGINFA @DYALLOC.3269
*CALL ARGINFO @DYALLOC.3270
*CALL ARGINFW WRB1F401.754
& internal_model,LINITIAL,MEANLEV,ICODE,CMESSAGE) GRB1F305.518
C TJ061293.78
IMPLICIT NONE SETTSCT1.34
C TJ061293.79
INTEGER internal_model ! IN - internal model identifier GRB1F305.519
LOGICAL LINITIAL ! IN - true in called from INITIAL SETTSCT1.36
INTEGER MEANLEV ! OUT - Mean level indicator SETTSCT1.37
*CALL CMAXSIZE @DYALLOC.3272
*CALL CSUBMODL ! Needed for N_INTERNAL_MODEL GSS1F305.793
*CALL TYPSIZE @DYALLOC.3273
*CALL TYPDUMA @DYALLOC.3274
*CALL TYPDUMO @DYALLOC.3275
*CALL TYPDUMW WRB1F401.755
*CALL TYPSTS ! Contains *CALL CPPXREF GSS1F305.794
*CALL TYPINFA @DYALLOC.3277
*CALL TYPINFO @DYALLOC.3278
*CALL TYPINFW WRB1F401.756
INTEGER ICODE ! Out - Return code SETTSCT1.38
CHARACTER*(80) CMESSAGE ! Out - Return error message TS150793.185
C SETTSCT1.40
C*---------------------------------------------------------------------- SETTSCT1.41
C Common blocks SETTSCT1.42
C SETTSCT1.43
*CALL CHSUNITS GRB1F305.520
*CALL CHISTORY GRB1F305.521
*CALL CCONTROL SETTSCT1.44
*CALL CTIME SETTSCT1.48
*CALL STPARAM SETTSCT1.49
*CALL CLOOKADD SETTSCT1.50
C SETTSCT1.51
C SETTSCT1.52
C Local variables SETTSCT1.53
C SETTSCT1.54
INTEGER I,NFTUNIT ! Loop counters SETTSCT1.55
INTEGER ITIME ! Loop index over selected dump times SETTSCT1.56
INTEGER STEP ! A_STEP or O_STEP for atmos/ocean SETTSCT1.57
INTEGER IS,II,IL,IM,NTAB,IT,IE ! STASH variables GSS1F305.795
INTEGER modl ! Int model no, read from STASH list arra GSS1F305.796
INTEGER MODJOBREL ! modulus of JOBREL_STEP() SETTSCT1.59
INTEGER STEP_ASSIM ! model step rel. to assim start SETTSCT1.60
C SETTSCT1.61
INTEGER JINTF ! Interface area index DR240293.1010
INTEGER ANCIL_REF_DAYS,ANCIL_REF_SECS GRB1F304.213
INTEGER ANCIL_OFFSET_STEPS ! offset of ref. from basis time GRB1F304.214
INTEGER MINS_PER_STEP ! minutes per timestep GMG1F404.306
GRB1F304.215
! Temporary variables for development of 3.5 start GRB1F305.522
INTEGER SECS_PER_DAY GRR2F405.60
PARAMETER (SECS_PER_DAY = 24*3600) GRR2F405.61
INTEGER A_S_Steps ! Atmosphere steps: slab steps GRB1F305.531
GRB1F305.532
INTEGER SECS_PER_PERIOD GRB1F305.533
INTEGER STEPS_PER_PERIOD GRB1F305.534
INTEGER DUMPFREQ GRB1F305.535
INTEGER OFFSET_DUMPS GRB1F305.536
INTEGER EXITFREQ GRB1F305.537
INTEGER TARGET_END_STEP GRB1F305.538
INTEGER ANCILLARY_STEPS GRB1F305.539
INTEGER BOUNDARY_STEPS GRB1F305.540
INTEGER BNDARY_OFFSET GOK1F401.10
INTEGER DUMPTIMES(DUMPTIMES_LEN1) GRB1F305.541
INTEGER MEANFREQ (MEANFREQ_LEN1) GRB1F305.542
INTEGER PRINTFREQ(PRINTFREQ_LEN1) GRB1F305.543
INTEGER JOBREL_STEP(JOBREL_LEN1) GRB1F305.544
! Temporary variables for development of 3.5 end GRB1F305.545
GRB1F305.546
LOGICAL IAU_SETDT ! If .TRUE., set data time to that of IAU dump. VSB2F404.104
GRB1F305.547
CL Subroutines called GRB1F304.216
EXTERNAL GRB1F304.217
& INTF_AREA, TIME2SEC, TIM2STEP GMB1F405.541
GRB1F304.219
ICODE=0 SETTSCT1.62
DR240293.1018
CL 1. Set timestep loop top-level control switches SETTSCT1.64
CL SETTSCT1.65
CL SETTSCT1.66
CL 1.0 Initialise control switches which are shared in coupled runs SETTSCT1.67
CL SETTSCT1.68
C GRB1F305.548
STEP= STEPim(internal_model) GRB1F305.549
SECS_PER_PERIOD= SECS_PER_PERIODim(internal_model) GRB1F305.550
STEPS_PER_PERIOD=STEPS_PER_PERIODim(internal_model) GRB1F305.551
mins_per_step=SECS_PER_PERIOD/(60*STEPS_PER_PERIOD) GMG1F404.307
DUMPFREQ= DUMPFREQim(internal_model) GRB1F305.552
OFFSET_DUMPS= OFFSET_DUMPSim(internal_model) GRB1F305.553
EXITFREQ= EXITFREQim(internal_model) GRB1F305.554
TARGET_END_STEP= TARGET_END_STEPim(internal_model) GRB1F305.555
ANCILLARY_STEPS= ANCILLARY_STEPSim(internal_model) GRB1F305.556
BOUNDARY_STEPS = BOUNDARY_STEPSim(internal_model) GRB1F305.557
BNDARY_OFFSET = BNDARY_OFFSETim(internal_model) GOK1F401.11
DO I=1,DUMPTIMES_LEN1 GRB1F305.558
DUMPTIMES(I)= DUMPTIMESim(I,internal_model) GRB1F305.559
ENDDO ! I GRB1F305.560
DO I=1,MEANFREQ_LEN1 GRB1F305.561
MEANFREQ(I)= MEANFREQim(I,internal_model) GRB1F305.562
ENDDO ! I GRB1F305.563
DO I=1,PRINTFREQ_LEN1 GRB1F305.564
PRINTFREQ(I)= PRINTFREQim(I,internal_model) GRB1F305.565
ENDDO ! I GRB1F305.566
DO I=1,JOBREL_LEN1 GRB1F305.567
JOBREL_STEP(I)= JOBREL_STEPim(I,internal_model) GRB1F305.568
ENDDO ! I GRB1F305.569
C SETTSCT1.79
LASSIMILATION=.FALSE. SETTSCT1.80
LDUMP= .FALSE. SETTSCT1.81
LEXIT= .FALSE. SETTSCT1.82
LMEAN= .FALSE. SETTSCT1.83
LHISTORY= .FALSE. TJ061293.88
LPRINT= .FALSE. SETTSCT1.84
LANCILLARY= .FALSE. SETTSCT1.85
LBOUNDARY= .FALSE. SETTSCT1.86
LINTERFACE= .FALSE. SETTSCT1.87
LJOBRELEASE = .FALSE. GRB1F305.570
CL SETTSCT1.88
CL 1.1 Set up PPfile switches for the timestep SETTSCT1.89
CL SETTSCT1.90
LPP =.FALSE. SETTSCT1.91
TJ061293.89
DO NFTUNIT=20,NUNITS RS030293.193
IF (FT_INPUT(NFTUNIT).EQ.'Y'.OR.FT_OUTPUT(NFTUNIT).EQ.'Y') THEN SETTSCT1.93
DR240293.1020
! Allow mix of real-month & regular reinit. periods on different units GMG1F404.308
IF (FT_STEPS(NFTUNIT).LT.0) THEN ! For real-month reinit. GMG1F404.309
DR240293.1022
C Select files to be reinitialised this timestep DR240293.1023
IF ( STEP.EQ.0 .AND. FT_FIRSTSTEP(NFTUNIT).EQ.0 ) then GMG1F404.310
LPP_SELECT(NFTUNIT) =.true. ! 0th tstep GMG1F404.311
ELSEIF ((.not. lcal360) .and. GMG1F404.312
& (nftunit.ge.60 .and. nftunit.lt.70) .and. (i_day.eq.1) GMG1F404.313
& .and. (i_hour .eq. 0) .and. (i_minute .eq. mins_per_step) GMG1F404.314
& .and. (STEP .GT. FT_FIRSTSTEP(NFTUNIT)) .and. GMG1F404.315
& .not.(STEP .LT. ((60/mins_per_step)+1) ! not 1st run hour GMG1F404.316
& .AND. FT_FIRSTSTEP(NFTUNIT).EQ.0)) then GMG1F404.317
if (FT_STEPS(NFTUNIT).eq.-1) then GMG1F404.318
LPP_SELECT(NFTUNIT) =.true. ! months GMG1F404.319
elseif (FT_STEPS(NFTUNIT).eq.-3 .and. GMG1F404.320
& mod((i_month-(MODEL_BASIS_TIME(2) GMG1F404.321
& +FT_FIRSTSTEP(NFTUNIT))),3).eq.0 ) then GMG1F404.322
LPP_SELECT(NFTUNIT) =.true. ! seasons GMG1F404.323
elseif (FT_STEPS(NFTUNIT).eq.-12 .and. GMG1F404.324
& mod((i_month-(MODEL_BASIS_TIME(2) GMG1F404.325
& +FT_FIRSTSTEP(NFTUNIT))),12).eq.0 ) then GMG1F404.326
LPP_SELECT(NFTUNIT) =.true. ! years GMG1F404.327
endif ! of FT_STEPS(NFTUNIT)=reinit. period GMG1F404.328
ELSE ! ensure LPP_SELECT() isn't accidentally set true GMG1F404.329
LPP_SELECT(NFTUNIT)=.false. ! avoid probs if unset GMG1F404.330
ENDIF ! of lcal360 and nftunit etc. GMG1F404.331
ELSE IF (FT_STEPS(NFTUNIT).GT.0) THEN ! use regular reinit. GMG1F404.332
LPP_SELECT(NFTUNIT) = SETTSCT1.106
DR240293.1024
C Is file to be initialised at step 0 DR240293.1025
* ( STEP.EQ.0 .AND. FT_FIRSTSTEP(NFTUNIT).EQ.0 ) DR240293.1026
DR240293.1027
* .OR. DR240293.1028
DR240293.1029
C Is file to be reinitialised this timestep (STEP) DR240293.1030
* ( STEP.GT.FT_FIRSTSTEP(NFTUNIT) DR240293.1031
* .AND. DR240293.1032
* MOD(STEP-1-FT_FIRSTSTEP(NFTUNIT),FT_STEPS(NFTUNIT)).EQ.0 DR240293.1033
* .AND. .NOT. DR240293.1034
C Do not reinitialise files on step 1 if they were DR240293.1035
C initialised at step 0 DR240293.1036
* (STEP.EQ.1 .AND.FT_FIRSTSTEP(NFTUNIT).EQ.0) DR240293.1037
* .AND.( GRB1F305.571
C Sub model id must correspond with TYPE_LETTER_2 GRB1F305.572
*(internal_model.EQ.atmos_im.AND.TYPE_LETTER_2(NFTUNIT).EQ.'a').OR. GRB1F305.573
*(internal_model.EQ.ocean_im.AND.TYPE_LETTER_2(NFTUNIT).EQ.'o')) ) GRB1F305.574
DR240293.1042
CL TJ061293.93
CL 1.1.1 Set up PPfile switches for boundary output files - this needs TJ061293.94
CL to be protected on SLAB model timesteps TJ061293.95
CL TJ061293.96
IF (TYPE_LETTER_1(NFTUNIT).EQ.'b') THEN ! Boundary File GDR2F405.151
DR240293.1049
! Get interface area number GMB1F405.542
call intf_area( internal_model, NFTUNIT, JINTF) GMB1F405.543
DR240293.1051
LPP_SELECT(NFTUNIT) = ( LPP_SELECT(NFTUNIT) TJ061293.99
* .AND. .NOT. TJ061293.100
C Do not reinitialise first file on timestep ft_firststep TJ061293.101
* (STEP-1-FT_FIRSTSTEP(NFTUNIT).EQ.0) ) TJ061293.102
* .OR. TJ061293.103
C Initialise first file if start of sequence is offset TJ061293.104
C from beginning of run TJ061293.105
* (STEP-1+INTERFACE_STEPSim(JINTF,internal_model) - GMB1F405.544
* FT_FIRSTSTEP(NFTUNIT) .EQ. 0) GDR5F305.152
* .OR. TJ061293.108
C Select boundary file if incomplete on continuation run TJ061293.109
* (LINITIAL TJ061293.110
* .AND. TJ061293.111
* STEP+INTERFACE_STEPSim(JINTF,internal_model).GT. GMB1F405.545
* FT_FIRSTSTEP(NFTUNIT) GDR5F305.154
* .AND. TJ061293.113
* STEP.LE.INTERFACE_LSTEPim(JINTF,internal_model) GMB1F405.546
* .AND. TJ061293.115
* (STEP-FT_FIRSTSTEP(NFTUNIT).EQ.0 .OR. TJ061293.116
* MOD(STEP-FT_FIRSTSTEP(NFTUNIT),FT_STEPS(NFTUNIT)).NE.0) TJ061293.117
* ) TJ061293.118
DR240293.1071
ENDIF DR240293.1072
DR240293.1073
ELSE ! for files not reinitialised, ie. ft_steps(nftunit)=0 GMG1F404.333
DR240293.1075
C Initialise at step 0 DR240293.1076
LPP_SELECT(NFTUNIT) = STEP.EQ.0 .AND. DR240293.1077
* (FT_STEPS(NFTUNIT).EQ.0.OR.FT_FIRSTSTEP(NFTUNIT).EQ.0) DR240293.1078
DR240293.1079
C Select boundary file if incomplete on continuation run DR240293.1080
IF (LINITIAL .AND. DR240293.1081
& TYPE_LETTER_1(NFTUNIT).EQ.'b') THEN ! Boundary File GDR2F405.152
DR240293.1088
! Get interface area number GMB1F405.547
call intf_area( internal_model, NFTUNIT, JINTF) GMB1F405.548
DR240293.1090
LPP_SELECT(NFTUNIT) = LPP_SELECT(NFTUNIT) .OR. DR240293.1091
* (STEP.GT.0.AND.STEP.LE. GMB1F405.549
* INTERFACE_LSTEPim(JINTF,internal_model)) GMB1F405.550
DR240293.1093
ENDIF DR240293.1094
DR240293.1095
END IF ! of FT_STEPS(NFTUNIT) lt, gt or =0, ie. reinit. type GMG1F404.334
ENDIF ! of FT_INPUT(NFTUNIT) or FT_OUTPUT(NFTUNIT) =Y GMG1F404.335
LPP = LPP .OR. LPP_SELECT(NFTUNIT) SETTSCT1.136
END DO ! of loop over nftunit from 20 to nunits GMG1F404.336
CL SETTSCT1.138
CL 1.2 Set switches for general internal models. GRB1F305.576
CL For coupled models dump related switches can only be set when GRB1F305.577
CL the last internal model in a submodel has completed its group GRB1F305.578
CL of timesteps. For coupled models the only safe restart point GRB1F305.579
CL is at the completion of all groups within a model timestep. GRB1F305.580
GRB1F305.581
IF(N_INTERNAL_MODEL.EQ.1.OR.( ! if not coupled model, or GRB1F305.582
* LAST_IM_IN_SM(internal_model).AND. ! last model in submodel GRB1F305.583
* MOD(STEP,STEPS_PER_PERIOD).EQ.0)) ! and last step in group GRB1F305.584
* THEN GRB1F305.585
C TJ061293.128
C LDUMP : Write-up dump on this timestep TJ061293.129
C TJ061293.130
IF (DUMPFREQ.GT.0) THEN GRB1F305.586
LDUMP= (MOD(STEP,DUMPFREQ) .EQ.0) GRB1F305.587
ELSE SETTSCT1.145
LDUMP=.FALSE. SETTSCT1.146
DO ITIME=1,DUMPTIMES_LEN1 GRB1F305.588
LDUMP=LDUMP.OR.(STEP.EQ.DUMPTIMES(ITIME)) GRB1F305.589
ENDDO SETTSCT1.149
ENDIF SETTSCT1.150
C TJ061293.131
C LMEAN : Perform climate-meaning from dumps on this timestep TJ061293.132
C LHISTORY: Write-up history file on this timestep TJ061293.133
C TJ061293.134
IF (DUMPFREQ.GT.0.AND.MEANFREQ(1).GT.0) THEN GRB1F305.590
LMEAN= (MOD(STEP,DUMPFREQ) .EQ.0) GRB1F305.591
LHISTORY= (MOD(STEP-OFFSET_DUMPS*DUMPFREQ, GRB1F305.592
& DUMPFREQ*MEANFREQ(1)).EQ.0) GRB1F305.593
ELSE TJ061293.139
LMEAN= .FALSE. TJ061293.140
LHISTORY= LDUMP TJ061293.141
ENDIF TJ061293.142
! For coupled models, only allow history write-ups if model GRB1F305.594
! timestep complete, ie last internal model. GRB1F305.595
IF(LHISTORY.AND.N_INTERNAL_MODEL.GT.1.AND. ! Coupled model GRB1F305.596
* internal_model.NE.INTERNAL_MODEL_LIST(N_INTERNAL_MODEL)) THEN GRB1F305.597
LHISTORY= .FALSE. GRB1F305.598
ENDIF ! Test on last internal model in coupled GRB1F305.599
C TJ061293.143
C LPRINT : Write a formatted print from dump on this timestep TJ061293.144
C TJ061293.145
IF (LDUMP) THEN TJ061293.146
IF (DUMPFREQ.GT.0.AND.PRINTFREQ(1).GT.0) THEN GRB1F305.600
LPRINT= (MOD(STEP,DUMPFREQ*PRINTFREQ(1)).EQ.0) GRB1F305.601
ELSE TJ061293.149
LPRINT= .FALSE. TJ061293.150
ENDIF TJ061293.151
ELSE TJ061293.152
LPRINT= .FALSE. TJ061293.153
ENDIF TJ061293.154
C TJ061293.155
C LEXIT : Check for exit condition on this timestep TJ061293.156
C TJ061293.157
IF (EXITFREQ.GT.0) THEN ! Implies climate meaning GRB1F305.602
GRB1F305.603
LEXIT= ( (MOD(STEP,EXITFREQ) .EQ.0) .OR. GRB1F305.604
& (STEP .GE. TARGET_END_STEP) ) GRB1F305.605
GRB1F305.606
ELSE ! No climate meaning GRB1F305.607
GRB1F305.608
LEXIT= (STEP .GE. TARGET_END_STEP) GRB1F305.609
GRB1F305.610
ENDIF GRB1F305.611
C TJ061293.161
C LANCILLARY: Update ancillary fields on this timestep TJ061293.162
C LBOUNDARY : Update boundary fields on this timestep TJ061293.163
C TJ061293.164
CL Convert ancillary reference time to days & secs GRB1F304.220
CALL TIME2SEC(ANCIL_REFTIME(1),ANCIL_REFTIME(2), GRB1F304.221
& ANCIL_REFTIME(3),ANCIL_REFTIME(4), GRB1F304.222
& ANCIL_REFTIME(5),ANCIL_REFTIME(6), GRB1F304.223
& 0,0,ANCIL_REF_DAYS,ANCIL_REF_SECS,LCAL360) GRB1F304.224
GRB1F304.225
CL Compute offset in timesteps of basis time from ancillary ref.time GRB1F304.226
CALL TIM2STEP(BASIS_TIME_DAYS-ANCIL_REF_DAYS, GRB1F304.227
& BASIS_TIME_SECS-ANCIL_REF_SECS, GRB1F304.228
& STEPS_PER_PERIOD,SECS_PER_PERIOD,ANCIL_OFFSET_STEPS) GRB1F305.612
GRB1F304.230
IF (ANCILLARY_STEPS.GT.0.AND.STEP.GT.0) GRB1F305.613
&LANCILLARY=(MOD(STEP+ANCIL_OFFSET_STEPS,ANCILLARY_STEPS).EQ.0) GRB1F305.614
TJ061293.169
ENDIF ! Test for non-coupled or coupled + last step in group GRB1F305.615
GRB1F305.616
C GRB1F305.617
C LBOUNDARY : Update boundary fields on this timestep GRB1F305.618
C GRB1F305.619
IF (BOUNDARY_STEPS.GT.0) GRB1F305.620
& LBOUNDARY= (MOD(STEP+BNDARY_OFFSET,BOUNDARY_STEPS) .EQ.0) GOK1F401.12
C GRB1F305.622
C LJOBRELEASE : Release user jobs on this timestep GRB1F305.623
C GRB1F305.624
DO I=1,JOBREL_LEN1 GRB1F305.625
MODJOBREL=ABS(JOBREL_STEP(I)) GRB1F305.626
IF (MODJOBREL.NE.0)THEN GRB1F305.627
LJOBRELEASE = LJOBRELEASE .OR. GRB1F305.628
* (STEP.EQ.JOBREL_STEP(I) .AND. JOBREL_STEP(I).GT.0).OR. GRB1F305.629
* (MOD(STEP,MODJOBREL).EQ.0.AND. JOBREL_STEP(I).LT.0) GRB1F305.630
ENDIF GRB1F305.631
ENDDO GRB1F305.632
GRB1F305.633
GRB1F305.634
CL GRB1F305.635
CL 1.2.1 Set switches for atmosphere timestep GRB1F305.636
CL GRB1F305.637
*IF DEF,ATMOS GRB1F305.638
IF (internal_model.EQ.atmos_im) THEN GRB1F305.639
CL 1.2.2 Set switches for all cases TJ061293.171
C TJ061293.172
C LENERGY : Readjust energy/mass correction on this timestep TJ061293.173
C TJ061293.174
IF (A_ENERGYSTEPS.GT.0) THEN GSM3F404.14
LENERGY= (MOD(STEP,A_ENERGYSTEPS).EQ.0) GSM3F404.15
LFLUX_RESET= (MOD(STEP-1,A_ENERGYSTEPS).EQ.0) GSM3F404.16
ENDIF GSM3F404.17
C TJ061293.177
C LDAY : End of day on this timestep TJ061293.178
C TJ061293.179
! Assumes that period is an integral number of days GRB1F305.641
! or an integral divisor of a day. GRB1F305.642
IF (SECS_PER_PERIOD.GT.0) THEN GRB1F305.643
GRB1F305.644
IF(SECS_PER_PERIOD.LT.SECS_PER_DAY) THEN ! ts < 1 day GRB1F305.645
LDAY= (MOD(STEP, GRB1F305.646
* STEPS_PER_PERIOD*(SECS_PER_DAY/SECS_PER_PERIOD)) GRB1F305.647
* .EQ.0) GRB1F305.648
ELSE ! ts >= 1 day GRB1F305.649
LDAY= .TRUE. GRB1F305.650
ENDIF GRB1F305.651
GRB1F305.652
ELSE TJ061293.182
CMESSAGE='SETTSCTL: SECS_PER_PERIOD has illegal value' GRB1F305.653
ICODE=1 TJ061293.184
GOTO 999 TJ061293.185
ENDIF TJ061293.186
C TJ061293.187
C LASSIMILATION: Perform data assimilation on this timestep TJ061293.188
C TJ061293.189
LASSIMILATION= (STEP.GT.ASSIM_FIRSTSTEPim(a_im) .AND. GRB1F305.654
& (STEP-ASSIM_FIRSTSTEPim(a_im) .LE. GRB1F305.655
& ASSIM_STEPSim(a_im)+ASSIM_EXTRASTEPSim(a_im))) GRB1F305.656
LASSIMILATION=LASSIMILATION.AND. SETTSCT1.153
& ( MODEL_ASSIM_MODE.EQ.'Atmosphere' .OR. SETTSCT1.154
& MODEL_ASSIM_MODE.EQ.'Coupled ') SETTSCT1.155
CL SETTSCT1.156
CL Reset Data Time fields in dump header at new analysis time SETTSCT1.157
CL ( also in history block ) SETTSCT1.158
CL ( This now includes resetting prognostic field LOOKUP headers ) SETTSCT1.159
CL NB: done even if assimilation suppressed by RUN_ASSIM_MODE SETTSCT1.160
CL Set MEANLEV to -1 and LDUMP to TRUE to force dump of analysis SETTSCT1.161
CL - otherwise set MEANLEV to 0 (ie. instantaneous) SETTSCT1.162
CL SETTSCT1.163
IAU_SETDT=.FALSE. VSB2F404.105
IF (L_IAU) THEN VSB2F404.106
IF (IAU_DATA_TIME(1).EQ.A_FIXHD(28) .AND. VSB2F404.107
& IAU_DATA_TIME(2).EQ.A_FIXHD(29) .AND. VSB2F404.108
& IAU_DATA_TIME(3).EQ.A_FIXHD(30) .AND. VSB2F404.109
& IAU_DATA_TIME(4).EQ.A_FIXHD(31) .AND. VSB2F404.110
& IAU_DATA_TIME(5).EQ.A_FIXHD(32) .AND. VSB2F404.111
& IAU_DATA_TIME(6).EQ.A_FIXHD(33)) IAU_SETDT=.TRUE. VSB2F404.112
ENDIF VSB2F404.113
IF ( (STEP.EQ.ASSIM_FIRSTSTEPim(a_im)+ASSIM_STEPSim(a_im) VSB2F404.114
* .AND.LASSIMILATION) .OR. IAU_SETDT) THEN VSB2F404.115
VSB2F404.116
DO I=21,27 SETTSCT1.166
A_FIXHD(I)=A_FIXHD(I+7) SETTSCT1.167
ENDDO SETTSCT1.168
DO I=1,6 SETTSCT1.169
MODEL_DATA_TIME(I)=A_FIXHD(20+I) SETTSCT1.170
ENDDO SETTSCT1.171
DO I=1,A_PROG_LOOKUP SETTSCT1.172
A_LOOKUP(LBYRD ,I)=A_FIXHD(21) SETTSCT1.173
A_LOOKUP(LBMOND,I)=A_FIXHD(22) SETTSCT1.174
A_LOOKUP(LBDATD,I)=A_FIXHD(23) SETTSCT1.175
A_LOOKUP(LBHRD ,I)=A_FIXHD(24) SETTSCT1.176
A_LOOKUP(LBMIND,I)=A_FIXHD(25) SETTSCT1.177
A_LOOKUP(LBDAYD,I)=A_FIXHD(27) SETTSCT1.178
ENDDO SETTSCT1.179
MEANLEV=-1 SETTSCT1.180
LDUMP=.TRUE. SETTSCT1.181
ELSE SETTSCT1.182
MEANLEV=0 SETTSCT1.183
ENDIF SETTSCT1.184
CL SETTSCT1.185
CL Suppress assimilation using RUN_ASSIM_MODE if necessary SETTSCT1.186
LASSIMILATION=LASSIMILATION.AND. SETTSCT1.187
& ((RUN_ASSIM_MODE.EQ.'Atmosphere').OR. SETTSCT1.188
& (RUN_ASSIM_MODE.EQ.'Coupled ')) SETTSCT1.189
C TJ061293.190
C L_SET_FILTER : Recalculate filter weights on this timestep TJ061293.191
C L_SW_RADIATE : Perform SW-radiation on this timestep TJ061293.192
C L_LW_RADIATE : Perform LW-radiation on this timestep TJ061293.193
C TJ061293.194
IF (A_NSET_FILTER.GT.0) SETTSCT1.190
& L_SET_FILTER= (MOD(STEP-1,A_NSET_FILTER).EQ.0) GRB1F305.658
IF (A_SW_RADSTEP.GT.0) SETTSCT1.192
& L_SW_RADIATE=(MOD(STEP-1,A_SW_RADSTEP) .EQ.0) GRB1F305.659
IF (A_LW_RADSTEP.GT.0) SETTSCT1.194
& L_LW_RADIATE=(MOD(STEP-1,A_LW_RADSTEP) .EQ.0) GRB1F305.660
IF (A_CONV_STEP.GT.0) RB300993.123
& L_CONVECT = (MOD(STEP-1,A_CONV_STEP) .EQ. 0) GRB1F305.661
C TJ061293.195
C LINTERFACE: Output interface fields on this timestep (>1 file poss.) TJ061293.196
C TJ061293.197
DO JINTF=1,N_INTF_A TJ061293.198
IF (INTERFACE_STEPSim(JINTF,atmos_im).GT.0) THEN GRB1F305.662
LINTERFACE = LINTERFACE .OR. TJ061293.200
& (MOD(STEP-INTERFACE_FSTEPim(JINTF,atmos_im), GRB1F305.663
& INTERFACE_STEPSim(JINTF,atmos_im)).EQ.0 GRB1F305.664
& .AND. STEP.GE.INTERFACE_FSTEPim(JINTF,atmos_im) GRB1F305.665
& .AND. STEP.LE.INTERFACE_LSTEPim(JINTF,atmos_im) ) GRB1F305.666
ENDIF TJ061293.205
ENDDO TJ061293.206
ENDIF ! Test for atmos_im GRB1F305.667
*ENDIF ATMOS SETTSCT1.250
CL SETTSCT1.251
CL 1.3 Set switches for ocean timestep SETTSCT1.252
CL SETTSCT1.253
*IF DEF,OCEAN SETTSCT1.254
IF (Internal_model.EQ.ocean_im) THEN GRB1F305.668
C SETTSCT1.264
*IF DEF,OCNASSM SETTSCT1.265
C SETTSCT1.266
CL Set LASSIMILATION and set LDUMP to TRUE at analysis time to force dum SETTSCT1.267
C SETTSCT1.268
STEP_ASSIM = STEP - ASSIM_FIRSTSTEPim(o_im) GRB1F305.669
LASSIMILATION= (STEP.GT.ASSIM_FIRSTSTEPim(o_im) .AND. GRB1F305.670
& (STEP_ASSIM.LE.ASSIM_STEPSim(o_im)+ASSIM_EXTRASTEPSim(o_im))) GRB1F305.671
LASSIMILATION=LASSIMILATION.AND. SETTSCT1.272
& ( MODEL_ASSIM_MODE.EQ.'Ocean ' .OR. SETTSCT1.273
& MODEL_ASSIM_MODE.EQ.'Coupled ') SETTSCT1.274
CL SETTSCT1.275
CL Reset Data Time fields in dump header at new analysis time SETTSCT1.276
CL ( also in history block ) SETTSCT1.277
CL ( This includes resetting prognostic field LOOKUP headers ) SETTSCT1.278
CL NB: done even if assimilation suppressed by RUN_ASSIM_MODE SETTSCT1.279
CL Set MEANLEV to -1 and LDUMP to TRUE to force dump of analysis SETTSCT1.280
CL - otherwise set MEANLEV to 0 (ie. instantaneous) SETTSCT1.281
CL SETTSCT1.282
IF (STEP.EQ.ASSIM_FIRSTSTEPim(o_im)+ASSIM_STEPSim(o_im) GRB1F305.672
* .AND.LASSIMILATION) THEN SETTSCT1.284
DO I=21,27 SETTSCT1.285
O_FIXHD(I)=O_FIXHD(I+7) SETTSCT1.286
ENDDO SETTSCT1.287
DO I=1,6 SETTSCT1.288
MODEL_DATA_TIME(I)=O_FIXHD(20+I) SETTSCT1.289
ENDDO SETTSCT1.290
DO I=1,O_PROG_LOOKUP SETTSCT1.291
O_LOOKUP(LBYRD ,I)=O_FIXHD(21) SETTSCT1.292
O_LOOKUP(LBMOND,I)=O_FIXHD(22) SETTSCT1.293
O_LOOKUP(LBDATD,I)=O_FIXHD(23) SETTSCT1.294
O_LOOKUP(LBHRD ,I)=O_FIXHD(24) SETTSCT1.295
O_LOOKUP(LBMIND,I)=O_FIXHD(25) SETTSCT1.296
O_LOOKUP(LBDAYD,I)=O_FIXHD(27) SETTSCT1.297
ENDDO SETTSCT1.298
MEANLEV=-1 SETTSCT1.299
LDUMP=.TRUE. SETTSCT1.300
ELSE SETTSCT1.301
MEANLEV=0 SETTSCT1.302
ENDIF SETTSCT1.303
CL SETTSCT1.304
CL Suppress assimilation using RUN_ASSIM_MODE if necessary SETTSCT1.305
CL SETTSCT1.306
LASSIMILATION=LASSIMILATION.AND. SETTSCT1.307
& ((RUN_ASSIM_MODE.EQ.'Ocean ').OR. SETTSCT1.308
& (RUN_ASSIM_MODE.EQ.'Coupled ')) SETTSCT1.309
*ENDIF OCNASSM SETTSCT1.310
C SETTSCT1.311
DO JINTF=1,N_INTF_O GMB1F405.551
IF (INTERFACE_STEPSim(JINTF,o_im).GT.0) THEN GMB1F405.552
LINTERFACE = LINTERFACE .OR. GMB1F405.553
& (MOD(STEP-INTERFACE_FSTEPim(JINTF,o_im), GMB1F405.554
& INTERFACE_STEPSim(JINTF,o_im)).EQ.0 GMB1F405.555
& .AND. STEP.GE.INTERFACE_FSTEPim(JINTF,o_im) GMB1F405.556
& .AND. STEP.LE.INTERFACE_LSTEPim(JINTF,o_im) ) GMB1F405.557
ENDIF GMB1F405.558
ENDDO GMB1F405.559
C SETTSCT1.357
*IF DEF,OCNASSM SETTSCT1.358
C SETTSCT1.359
CL Set the other high level switches for ocean assimilation SETTSCT1.360
C SETTSCT1.361
LAS_CLM_INC = ( STEP.GT.O_CLM_FIRSTSTEP .AND. GRB1F305.673
& (STEP .LE. O_CLM_LASTSTEP) ) GRB1F305.674
IF ( LAS_CLM_INC .AND. O_INT_CLM_INC.GT.0 ) LAS_CLM_INC = SETTSCT1.364
& MOD(STEP - O_CLM_FIRSTSTEP, O_INT_CLM_INC) .EQ. 0 GRB1F305.675
C SETTSCT1.366
IF ( LASSIMILATION ) THEN SETTSCT1.367
C SETTSCT1.368
LAS_ADD_INC = O_INT_ANA_STP .GT. 1 SETTSCT1.369
C SETTSCT1.370
IF ( O_INT_ANA_STP .GT. 0 ) THEN SETTSCT1.371
LAS_ANA_STP = MOD (STEP_ASSIM, O_INT_ANA_STP) .EQ. 0 SETTSCT1.372
ELSE SETTSCT1.373
LAS_ANA_STP = .FALSE. SETTSCT1.374
END IF SETTSCT1.375
C SETTSCT1.376
IF ( O_INT_EVO_BTS .GT. 0 ) THEN SETTSCT1.377
LAS_EVO_BTS = MOD (STEP_ASSIM, O_INT_EVO_BTS) .EQ. 0 SETTSCT1.378
ELSE SETTSCT1.379
LAS_EVO_BTS = .FALSE. SETTSCT1.380
END IF SETTSCT1.381
C SETTSCT1.382
IF ( O_INT_VRY_BTS .GT. 0 ) THEN SETTSCT1.383
LAS_VRY_BTS = MOD (STEP_ASSIM, O_INT_VRY_BTS) .EQ. 0 SETTSCT1.384
ELSE SETTSCT1.385
LAS_VRY_BTS = .FALSE. SETTSCT1.386
END IF SETTSCT1.387
C SETTSCT1.388
IF ( O_INT_WTS_ACC .GT. 0 ) THEN SETTSCT1.389
LAS_WTS_ACC = MOD (STEP_ASSIM, O_INT_WTS_ACC) .EQ. 0 SETTSCT1.390
ELSE SETTSCT1.391
LAS_WTS_ACC = .FALSE. SETTSCT1.392
END IF SETTSCT1.393
C SETTSCT1.394
IF ( O_INT_OBS_FRSH .GT. 0 ) THEN SETTSCT1.395
LAS_OBS_FRSH = MOD (STEP_ASSIM, O_INT_OBS_FRSH) .EQ. 1 OMB1F401.99
OMB1F401.100
ELSE SETTSCT1.397
LAS_OBS_FRSH = .FALSE. SETTSCT1.398
END IF SETTSCT1.399
C SETTSCT1.400
IF ( O_INT_OBS_OUT .GT. 0 ) THEN SETTSCT1.401
LAS_OBS_OUT = MOD (STEP_ASSIM, O_INT_OBS_OUT) .EQ. 0 SETTSCT1.402
ELSE SETTSCT1.403
LAS_OBS_OUT = .FALSE. SETTSCT1.404
END IF SETTSCT1.405
C SETTSCT1.406
IF ( O_INT_OBS_STR .GT. 0 ) THEN SETTSCT1.407
LAS_OBS_STR = MOD (STEP_ASSIM, O_INT_OBS_STR) .EQ. 0 SETTSCT1.408
ELSE SETTSCT1.409
LAS_OBS_STR = .FALSE. SETTSCT1.410
END IF SETTSCT1.411
C SETTSCT1.412
IF ( O_INT_FLD_STR .GT. 0 ) THEN SETTSCT1.413
LAS_FLD_STR = MOD (STEP_ASSIM, O_INT_FLD_STR) .EQ. 0 SETTSCT1.414
ELSE SETTSCT1.415
LAS_FLD_STR = .FALSE. SETTSCT1.416
END IF SETTSCT1.417
C SETTSCT1.418
ELSE SETTSCT1.419
C SETTSCT1.420
LAS_ADD_INC = .FALSE. SETTSCT1.421
C SETTSCT1.422
END IF ! LASSIMILATION SETTSCT1.423
C SETTSCT1.424
*ENDIF OCNASSM SETTSCT1.425
C SETTSCT1.426
ENDIF ! Test on ocean_im GRB1F305.676
*ENDIF OCEAN SETTSCT1.427
CL---------------------------------------------------------------------- SETTSCT1.428
CL 2. Set STASHflags to activate diagnostics this timestep SETTSCT1.429
CL SETTSCT1.430
C IS is section number SETTSCT1.431
C IE is item number within section SETTSCT1.432
C IL is item number within STASHlist SETTSCT1.433
C II is counter within given section/item sublist for repeated items SETTSCT1.434
C IM is cumulative active item number within section SETTSCT1.435
C SETTSCT1.436
CL Clear all STASHflags SETTSCT1.437
SETTSCT1.438
DO IS=0,NSECTS SETTSCT1.439
DO IM=0,NITEMS @DYALLOC.3279
SF(IM,IS) = .FALSE. SETTSCT1.441
ENDDO SETTSCT1.442
ENDDO SETTSCT1.443
SETTSCT1.444
CL Loop over all items in STASHlist, enabling flags for diagnostics SETTSCT1.445
CL which are active this step -- SETTSCT1.446
CL note that atmosphere/ocean diagnostics must be discriminated SETTSCT1.447
SETTSCT1.448
DO IL =1,TOTITEMS GSS1F305.797
modl=STLIST(st_model_code ,IL) GSS1F305.798
IS =STLIST(st_sect_no_code,IL) GSS1F305.799
IM =STLIST(st_item_code ,IL) GSS1F305.800
C Skip diagnostics which are not active TJ061293.276
IF(STLIST(st_proc_no_code,IL).EQ.0) GOTO 200 GSS1F305.801
C Skip diagnostics which don't correspond to the submodel this timestep TJ061293.277
! IF(ISUBMODL.NE.modl) GOTO 200 GSS1F305.802
IF(Internal_model.NE.modl) GOTO 200 GSS1F305.803
C SETTSCT1.465
C STASHflag is off by default. SETTSCT1.466
C But reset ... SETTSCT1.467
C SETTSCT1.468
C ... if required every timestep between start and end SETTSCT1.469
C SETTSCT1.470
IF (STLIST(st_freq_code,IL).EQ.1) THEN SETTSCT1.471
IF (STEP.GE.STLIST(st_start_time_code,IL).AND. SETTSCT1.472
& (STEP.LE.STLIST(st_end_time_code,IL).OR. SETTSCT1.473
& STLIST(st_end_time_code,IL).EQ.st_infinite_time)) SETTSCT1.474
& THEN @DYALLOC.3280
SF(IM,IS)=.TRUE. @DYALLOC.3281
SF(0 ,IS)=.TRUE. @DYALLOC.3282
ENDIF @DYALLOC.3283
C SETTSCT1.476
C ... if required at specified times and this is one of them SETTSCT1.477
C SETTSCT1.478
ELSEIF(STLIST(st_freq_code,IL).LT.0)THEN SETTSCT1.479
NTAB=-STLIST(st_freq_code,IL) SETTSCT1.480
DO IT=1,NSTTIMS SETTSCT1.481
IF(STTABL(IT,NTAB).EQ.st_end_of_list) GOTO 200 SETTSCT1.482
IF(STEP.EQ.STTABL(IT,NTAB)) THEN @DYALLOC.3284
SF(IM,IS)=.TRUE. @DYALLOC.3285
SF(0 ,IS)=.TRUE. @DYALLOC.3286
ENDIF @DYALLOC.3287
ENDDO SETTSCT1.484
C SETTSCT1.485
C ... if required every N timesteps and this is one of them SETTSCT1.486
C SETTSCT1.487
ELSEIF (STLIST(st_freq_code,IL).GT.0) THEN SETTSCT1.488
IF (MOD((STEP-STLIST(st_start_time_code,IL)), SETTSCT1.489
& STLIST(st_freq_code,IL)).EQ.0.AND. SETTSCT1.490
& STEP.GE.STLIST(st_start_time_code,IL).AND. SETTSCT1.491
& (STEP.LE.STLIST(st_end_time_code,IL).OR. SETTSCT1.492
& STLIST(st_end_time_code,IL).EQ.st_infinite_time)) SETTSCT1.493
& THEN @DYALLOC.3288
SF(IM,IS)=.TRUE. @DYALLOC.3289
SF(0 ,IS)=.TRUE. @DYALLOC.3290
ENDIF @DYALLOC.3291
ENDIF SETTSCT1.495
C SETTSCT1.496
C Next item SETTSCT1.497
C SETTSCT1.498
200 CONTINUE SETTSCT1.499
ENDDO SETTSCT1.500
CL---------------------------------------------------------------------- SETTSCT1.501
CL 3. If errors occurred in setting STASHflags, set error return code SETTSCT1.502
IF (ICODE.EQ.1) CMESSAGE='SETTSCTL: STASH code error' SETTSCT1.503
999 CONTINUE SETTSCT1.504
RETURN SETTSCT1.505
CL---------------------------------------------------------------------- SETTSCT1.506
END SETTSCT1.507
*ENDIF SETTSCT1.508