SUBROUTINE MEANCTL ( 1,75@DYALLOC.2256
*CALL ARGSIZE 
@DYALLOC.2257
*CALL ARGD1 @DYALLOC.2258
*CALL ARGDUMA @DYALLOC.2259
*CALL ARGDUMO @DYALLOC.2260
*CALL ARGDUMW GKR1F401.226
*CALL ARGPTRA @DYALLOC.2261
*CALL ARGPTRO @DYALLOC.2262
*CALL ARGSTS @DYALLOC.2263
*CALL ARGCONA @DYALLOC.2264
*CALL ARGINFA @DYALLOC.2265
*CALL ARGINFO GMB1F405.403
*CALL ARGPPX GKR0F305.953
& IND_IM,MEANLEV,ICODE,CMESSAGE) GRB1F305.346
C MEANCTL1.26
IMPLICIT NONE MEANCTL1.27
@DYALLOC.2267
C*L Arguments @DYALLOC.2268
@DYALLOC.2269
*CALL CMAXSIZE @DYALLOC.2270
*CALL CSUBMODL GSS1F305.933
*CALL CINTFA GDR2F405.117
*CALL TYPSIZE @DYALLOC.2271
*CALL TYPD1 @DYALLOC.2272
*CALL TYPDUMA @DYALLOC.2273
*CALL TYPDUMO @DYALLOC.2274
*CALL TYPDUMW GKR1F401.227
*CALL TYPPTRA @DYALLOC.2275
*CALL TYPPTRO @DYALLOC.2276
*CALL TYPSTS @DYALLOC.2277
*CALL TYPCONA @DYALLOC.2278
*CALL TYPINFA @DYALLOC.2279
*IF DEF,ATMOS GSM1F405.494
*CALL TYPFLDPT GSM1F405.495
*ENDIF GSM1F405.496
*CALL TYPINFO GMB1F405.404
*CALL PPXLOOK GKR0F305.954
@DYALLOC.2280
INTEGER MEANCTL1.29
& IND_IM, ! IN Internal model indicator GRB1F305.347
* MEANLEV, ! INOUT Mean level indicator MEANCTL1.31
& ICODE ! OUT return code; successful=0, error> 0 MEANCTL1.32
@DYALLOC.2281
C MEANCTL1.33
CHARACTER*80 TS150793.107
& CMESSAGE ! OUT Error message if ICODE > 0 MEANCTL1.35
C MEANCTL1.36
C Common blocks MEANCTL1.37
C MEANCTL1.38
*CALL CTIME MEANCTL1.40
*CALL CHSUNITS GRB1F305.348
*CALL CHISTORY MEANCTL1.41
*CALL CCONTROL GRB1F305.349
*CALL CMEANCTL MEANCTL1.42
*CALL CENVIR MEANCTL1.43
C MEANCTL1.44
C*L MEANCTL1.45
C*L External subroutines called: MEANCTL1.46
EXTERNAL GET_NAME,DUMPCTL,ACUMPS,SETPERLEN,MEANPS GMG1F404.128
&, TRANSIN,TRANSOUT MEANCTL1.48
&, MEANDIAG,PRINTCTL MEANCTL1.49
*IF DEF,ATMOS MEANCTL1.50
&, SETEXNER MEANCTL1.51
*ENDIF MEANCTL1.52
C MEANCTL1.53
C Local variables and arrays MEANCTL1.54
C MEANCTL1.55
INTEGER MEANCTL1.56
* IFIND, ! Loop counter MEANCTL1.57
& INDEXL, ! Loop index MEANCTL1.58
& STEP_DUMPS, ! Timestep (in multiples of restart MEANCTL1.59
* ! dump frequency) MEANCTL1.60
& NMEANS, ! No. of means chosen (fixed, unless GMG1F404.129
& ! there is a mean offset) GMG1F404.130
& RESIDU, ! Reference for partial sum data MEANCTL1.62
& MEANS_TOTAL, ! Number of mean dumps this timestep MEANCTL1.63
& NMVALS(4), ! Absolute meaning periods (in MEANCTL1.64
* ! multiples of restart dump frequency) MEANCTL1.65
& PS_FLAG(4), ! Flag for partial sum updating MEANCTL1.66
& PRINT_FLAG(4), ! Flag for mean printing frequencies MEANCTL1.67
& PRINT_FREQ(4), ! Mean printing frequencies MEANCTL1.68
& FT_PS(4,2), ! Unit numbers for dumps of partial GMG1F404.131
& ! sum data (read/write) GMG1F404.132
& PERIODLEN, ! Length in days of current period N GMG1F404.133
& PERIODLENDM, ! Length in dumps of period 1 or GMG1F404.134
& ! in days of current period N>1 GMG1F404.135
& DUMPS_PER_DAY ! Number of restart dumps per day GMG1F404.136
INTEGER MEANCTL1.71
& INDEX_READ, ! Specific index no for reading MEANCTL1.72
& INDEX_WRITE ! Specific index no for writing MEANCTL1.73
INTEGER MEANCTL1.74
& FT_READ, ! Unit number for partial sum read MEANCTL1.75
& FT_WRITE, ! Unit number for partial sum write MEANCTL1.76
& FT_DELETE, ! Unit number for partial sum delete MEANCTL1.77
& FT_SSD ! Unit no for transfer of inst. data MEANCTL1.78
*,LEN_PSNAME MEANCTL1.79
&,disk_address ! Current rounded disk address GBC6F404.89
&,number_of_data_words_on_disk ! Number of data words on disk GBC6F404.90
&,number_of_data_words_in_memory ! Number of Data Words in memory GBC6F404.91
&,get_char_len ! function returns number of non- GBC6F404.92
! blank leading characters from a GBC6F404.93
! character variable GBC6F404.94
&,maximum_file_length ! Maximum file length for FT_SSD GBC6F404.95
INTEGER internal_model GIE0F405.46
INTEGER im ! temporary internal model id for ocean or slab GIE0F405.47
INTEGER MEANCTL1.80
& REINIT_STEPS ! dummy input for GET_NAME MEANCTL1.81
&, D1_ADDR_SUBMODEL_ID ! Submodel number in D1_ADDR GSM1F403.177
LOGICAL GMG1F404.137
& LMEANINC ! increment MEANS_TOTAL or not GMG1F404.138
GPB2F405.79
*IF DEF,MPP GPB2F405.80
*CALL STPARAM GPB2F405.81
GPB2F405.82
INTEGER GPB2F405.83
& IE ! loop counter over items GPB2F405.84
&, tag ! indicates if this field is meaned GPB2F405.85
&, maxsize ! maximum dump output length GPB2F405.86
*ENDIF GPB2F405.87
GPB2F405.88
C MEANCTL1.82
C Character data MEANCTL1.83
C MEANCTL1.84
CHARACTER*14 PSNAME_READ,PSNAME_WRITE,PSNAME_DELETE MEANCTL1.85
CHARACTER*1 MEANCTL1.86
& BLANK MEANCTL1.87
&, LETTER_3 ! dummy input for GET_NAME MEANCTL1.88
CHARACTER*80 FILENAME ! Name of pipe to server GKR1F404.290
*CALL PARPARM GKR1F404.291
*CALL PARCOMM GKR1F404.292
*IF DEF,ATMOS GSM1F405.497
*CALL SETFLDPT GSM1F405.498
*ENDIF GSM1F405.499
C MEANCTL1.89
BLANK=' ' MEANCTL1.90
CMESSAGE=' ' MEANCTL1.91
LETTER_3='a' MEANCTL1.92
REINIT_STEPS=0 MEANCTL1.93
GKR1F404.293
! Get name of pipe GKR1F404.294
CALL GET_FILE(8,FILENAME,80,ICODE) GKR1F404.295
C MEANCTL1.94
C Set up unit number for instantaneous MEANCTL1.95
C dump transfer MEANCTL1.96
C MEANCTL1.97
FT_SSD=17 MEANCTL1.98
C MEANCTL1.99
C Define mode of use for means program MEANCTL1.100
C MEANCTL1.101
IF(IND_IM.EQ.1)THEN GRB1F305.350
WRITE(6,*)'MEANCTL: ***** Called in ATMOSPHERIC mode *****' GIE0F403.387
ENDIF MEANCTL1.105
IF(IND_IM.EQ.2)THEN GRB1F305.351
WRITE(6,*)'MEANCTL: ***** Called in OCEAN mode *****' GIE0F403.388
ENDIF MEANCTL1.110
CL MEANCTL1.112
CL---------------------------------------------------------------------- MEANCTL1.113
CL Find out which mean datasets need to be created MEANCTL1.114
CL on this timestep (if any) and set MEANS_TOTAL accordingly MEANCTL1.115
CL---------------------------------------------------------------------- MEANCTL1.116
CL MEANCTL1.117
C MEANCTL1.118
INDEXL=RUN_MEANCTL_RESTART ! Zero in normal circumstances MEANCTL1.119
ICODE=0 MEANCTL1.120
MEANS_TOTAL=0 MEANCTL1.121
C MEANCTL1.122
C Initially check validity of call to subroutine MEANCTL1.123
C MEANCTL1.124
IF(IND_IM.EQ.1 .or. IND_IM.EQ.2)THEN GRB1F305.352
IF(DUMPFREQim(IND_IM).EQ.0)THEN ! Is mean dump production off? GMG1F404.139
ICODE=1 MEANCTL1.128
CMESSAGE='MEANCTL: Invalid call to subroutine' MEANCTL1.129
WRITE(6,*) 'MEANCTL: DUMPFREQ(',IND_IM,')= ',DUMPFREQim(IND_IM) GIE0F403.389
GOTO 999 MEANCTL1.131
ELSEIF(MOD(STEPim(IND_IM),DUMPFREQim(IND_IM)).NE.0)THEN GRB1F305.355
ICODE=2 ! This is not a dumping timestep GMG1F404.140
CMESSAGE='MEANCTL: Incorrect timestep to call subroutine' MEANCTL1.134
WRITE(6,*) 'MEANCTL: STEP is not a multiple of DUMPFREQ' GIE0F403.390
WRITE(6,*) ' STEP(',IND_IM,')= ',STEPim(IND_IM), GIE0F403.391
& ' DUMPFREQ(',IND_IM,')= ', DUMPFREQim(IND_IM) GRB1F305.358
GOTO 999 MEANCTL1.137
ELSE MEANCTL1.138
STEP_DUMPS = (STEPim(IND_IM)/DUMPFREQim(IND_IM))+ GRB1F305.359
& OFFSET_DUMPSim(IND_IM) GRB1F305.360
ENDIF MEANCTL1.140
ENDIF MEANCTL1.141
C MEANCTL1.143
C Pick up number of means chosen from history file (MEAN_NUMBERim) GRB1F305.361
C or number determined by the offset from the reference time whilst GRB1F305.362
C the staggered start of means production unwinds (MEAN_OFFSETim) GRB1F305.363
C MEANCTL1.162
IF(IND_IM.EQ.1 .or. IND_IM.EQ.2)THEN GRB1F305.364
DO IFIND=1,MEAN_NUMBERim(IND_IM) GRB1F305.365
IF(IFIND.EQ.1)NMVALS(IFIND) = MEANFREQim(IFIND,IND_IM) GRB1F305.366
IF(IFIND.GT.1)NMVALS(IFIND) = MEANFREQim(IFIND,IND_IM)* GRB1F305.367
& NMVALS(IFIND-1) GRB1F305.368
PRINT_FREQ(IFIND)=NMVALS(IFIND)*PRINTFREQim(IFIND+1,IND_IM) GRB1F305.369
ENDDO MEANCTL1.173
ENDIF MEANCTL1.174
C MEANCTL1.185
if (lclimrealyr) then GMG1F404.141
DUMPS_PER_DAY=(24*3600*STEPS_PER_PERIODim(IND_IM))/ GMG1F404.142
& (DUMPFREQim(IND_IM)*SECS_PER_PERIODim(IND_IM)) GMG1F404.143
endif GMG1F404.144
! GMG1F404.145
IF(IND_IM.EQ.1 .or. IND_IM.EQ.2)THEN GRB1F305.370
IF(MEAN_OFFSETim(IND_IM).EQ.MEAN_NUMBERim(IND_IM))THEN GRB1F305.371
NMEANS=MEAN_NUMBERim(IND_IM) GRB1F305.372
ELSE ! there is a non-zero offset so increment mean_offset GMG1F404.146
! when run is partway into the current mean period. GMG1F404.147
DO IFIND=MEAN_OFFSETim(IND_IM)+1,MEAN_NUMBERim(IND_IM) GRB1F305.373
if (lclimrealyr) then GMG1F404.148
if ((ifind .eq. 1 .and. i_day .eq. 2 .and. GMG1F404.149
& (dumps_per_day .le. 1)) .or. ! 24h dumps GMG1F404.150
& (ifind .eq. 1 .and. i_day .eq. 1 .and. ! dumps lt 24h GMG1F404.151
& i_hour .eq. (24/dumps_per_day))) then GMG1F404.152
mean_offsetim(IND_IM)=mean_offsetim(IND_IM)+1 ! months GMG1F404.153
elseif (ifind .eq. 2 .and. GMG1F404.154
& (i_day .eq. 1) .and. i_hour .eq. 0 .and. GMG1F404.155
& mod(((i_month-1)-MEAN_REFTIMEim(2,IND_IM)),3).eq.0) GMG1F404.156
& then GMG1F404.157
mean_offsetim(IND_IM)=mean_offsetim(IND_IM)+1 ! seasons GMG1F404.158
elseif (ifind .eq. 3 .and. GMG1F404.159
& (i_day .eq. 1) .and. (i_hour .eq. 0) .and. GMG1F404.160
& mod(((i_month-3)-MEAN_REFTIMEim(2,IND_IM)),12).eq.0) GMG1F404.161
& then GMG1F404.162
mean_offsetim(IND_IM)=mean_offsetim(IND_IM)+1 ! years GMG1F404.163
endif ! of test on ifind, i_day, etc. GMG1F404.164
else ! for 360d year, use array of no. of mean dumps GMG1F404.165
IF(STEP_DUMPS.LT.0)THEN ! mean ref time not reached yet GMG1F404.166
RESIDU=1-NMVALS(IFIND) MEANCTL1.193
ELSE ! mean ref time has been passed GMG1F404.167
RESIDU=1 MEANCTL1.195
ENDIF MEANCTL1.196
IF(MOD(STEP_DUMPS,NMVALS(IFIND)).EQ.RESIDU)THEN MEANCTL1.197
MEAN_OFFSETim(IND_IM)=MEAN_OFFSETim(IND_IM)+1 GRB1F305.374
ENDIF MEANCTL1.199
endif ! end of checking whether to increment MEAN_OFFSETim GMG1F404.168
ENDDO ! end of loop over IFIND GMG1F404.169
NMEANS=MEAN_OFFSETim(IND_IM) GRB1F305.375
WRITE(6,*)' MEAN_OFFSET(',IND_IM,')=',MEAN_OFFSETim(IND_IM) GIE0F403.392
ENDIF ! end of setting NMEANS GMG1F404.170
ENDIF MEANCTL1.203
CL MEANCTL1.226
CL If no processing is required (because of staggered MEANCTL1.227
CL start in means production) then skip to end of subroutine MEANCTL1.228
CL MEANCTL1.229
IF(NMEANS.EQ.0)THEN MEANCTL1.230
ICODE=-1 MEANCTL1.231
CMESSAGE='MEANCTL: No accumulation/meaning done this step' MEANCTL1.232
WRITE(6,*)'MEANCTL: No accm/meaning due to staggered start' GIE0F403.393
GO TO 999 MEANCTL1.234
ENDIF MEANCTL1.235
CL MEANCTL1.236
CL Output message whilst stagger unwinds MEANCTL1.237
CL MEANCTL1.238
IF(IND_IM.EQ.1 .or. IND_IM.EQ.2)THEN GRB1F305.377
DO IFIND=1,MEAN_NUMBERim(IND_IM) GRB1F305.378
IF(NMEANS.LT.IFIND)THEN MEANCTL1.242
WRITE(6,*)'MEANCTL: Period_',IFIND,' mean not activated', GIE0F403.394
& BLANK,'because of staggered start in means production' MEANCTL1.244
ENDIF MEANCTL1.245
ENDDO MEANCTL1.246
ENDIF MEANCTL1.247
C MEANCTL1.259
DO IFIND=1,NMEANS MEANCTL1.260
C MEANCTL1.261
PS_FLAG(IFIND)=0 MEANCTL1.262
PRINT_FLAG(IFIND)=0 MEANCTL1.263
lmeaninc=.false. ! Initialise to avoid false positive results GMG1F404.171
C MEANCTL1.264
! Find out if the end of any meaning period has been reached. If so, GMG1F404.172
! increment MEANS_TOTAL GMG1F404.173
if (lclimrealyr .and. (ifind .eq. 1) .and. GMG1F404.174
& (i_day .eq. 1) .and. (i_hour.eq.0) ! but not 1st day of run GMG1F404.175
& .and. (STEPim(IND_IM) .gt. STEPS_PER_PERIODim(IND_IM))) then GMG1F404.176
lmeaninc=.true. ! monthly GMG1F404.177
elseif (lclimrealyr .and. (ifind .eq. 2) .and. GMG1F404.178
& (i_day .eq. 1) .and. (i_hour .eq. 0) .and. ! seasonal GMG1F404.179
& (STEPim(IND_IM) .gt. STEPS_PER_PERIODim(IND_IM)) .and. GMG1F404.180
& mod((i_month-MEAN_REFTIMEim(2,IND_IM)),3).eq.0) then GMG1F404.181
lmeaninc=.true. GMG1F404.182
elseif (lclimrealyr .and. (ifind .eq. 3) .and. GMG1F404.183
& (i_day .eq. 1) .and. (i_hour .eq. 0) .and. ! annual GMG1F404.184
& (STEPim(IND_IM) .gt. STEPS_PER_PERIODim(IND_IM)) .and. GMG1F404.185
& mod((i_month-MEAN_REFTIMEim(2,IND_IM)),12).eq.0) then GMG1F404.186
lmeaninc=.true. GMG1F404.187
elseif (.not. lclimrealyr .and. ! 360-day calendar GMG1F404.188
& MOD(STEP_DUMPS,NMVALS(IFIND)).EQ.0) then GMG1F404.189
lmeaninc=.true. GMG1F404.190
endif ! end of IF test on reaching end of meaning period GMG1F404.191
if (lmeaninc) then GMG1F404.192
MEANS_TOTAL=MEANS_TOTAL+1 MEANCTL1.266
IF(RUN_MEANCTL_RESTART.GT.1.AND. MEANCTL1.267
& RUN_MEANCTL_RESTART.GT.IFIND)THEN MEANCTL1.268
WRITE(6,*) 'MEANCTL: Period_',IFIND,' mean dump',BLANK, GIE0F403.395
& 'already created this timestep' MEANCTL1.270
ELSE MEANCTL1.271
WRITE(6,*) 'MEANCTL: Period_',IFIND,' mean dump',BLANK, GIE0F403.396
& 'to be created this timestep' MEANCTL1.273
ENDIF MEANCTL1.274
endif ! end of IF test on lmeaninc GMG1F404.193
C MEANCTL1.276
! Find out if run is one period(N-1) into the period(N), in which case GMG1F404.194
! set PS_FLAG(IFIND)=1 because there will not already be a file for GMG1F404.195
! that partial sum on the disk, so ACUMPS must get it from D1. GMG1F404.196
! GMG1F404.197
if (lclimrealyr) then GMG1F404.198
if ((ifind .eq. 1 .and. i_day .eq. 2 .and. GMG1F404.199
& (dumps_per_day .le. 1)) ! 24h dumps GMG1F404.200
& .or. (ifind .eq. 1 .and. i_day .eq. 1 .and. ! dumps lt 24h GMG1F404.201
& i_hour .eq. (24/dumps_per_day))) then GMG1F404.202
ps_flag(1)=1 ! months GMG1F404.203
elseif (ifind .eq. 2 .and. GMG1F404.204
& (i_day .eq. 1) .and. (i_hour .eq. 0) .and. GMG1F404.205
& mod(((i_month-1)-MEAN_REFTIMEim(2,IND_IM)),3).eq.0) GMG1F404.206
& then GMG1F404.207
ps_flag(2)=1 ! seasons GMG1F404.208
elseif (ifind .eq. 3 .and. GMG1F404.209
& (i_day .eq. 1) .and. (i_hour .eq. 0) .and. GMG1F404.210
& mod(((i_month-3)-MEAN_REFTIMEim(2,IND_IM)),12).eq.0) GMG1F404.211
& then GMG1F404.212
ps_flag(3)=1 ! years GMG1F404.213
endif GMG1F404.214
else ! for 360d year, check using array of no. of mean dumps GMG1F404.215
IF(STEP_DUMPS.LT.0)THEN MEANCTL1.277
IF(IFIND.EQ.1)RESIDU=1-NMVALS(IFIND) MEANCTL1.278
IF(IFIND.NE.1)RESIDU=NMVALS(IFIND-1)-NMVALS(IFIND) MEANCTL1.279
ELSE MEANCTL1.280
IF(IFIND.EQ.1)RESIDU=1 MEANCTL1.281
IF(IFIND.NE.1)RESIDU=NMVALS(IFIND-1) MEANCTL1.282
ENDIF MEANCTL1.283
IF(MOD(STEP_DUMPS,NMVALS(IFIND)).EQ.RESIDU)THEN MEANCTL1.284
PS_FLAG(IFIND)=1 MEANCTL1.285
ENDIF MEANCTL1.286
endif ! end of test on lclimrealyr and setting of PS_FLAG GMG1F404.216
C MEANCTL1.287
C Set up flag for mean printing frequencies MEANCTL1.288
C MEANCTL1.289
IF(PRINT_FREQ(IFIND).NE.0)THEN MEANCTL1.290
IF(MOD(STEP_DUMPS,PRINT_FREQ(IFIND)).EQ.0)THEN MEANCTL1.291
PRINT_FLAG(IFIND)=1 MEANCTL1.292
ENDIF MEANCTL1.293
ENDIF MEANCTL1.294
C MEANCTL1.295
ENDDO ! end of loop over IFIND from 1 to NMEANS GMG1F404.217
C MEANCTL1.297
C Set up unit numbers for partial sum dumps MEANCTL1.298
C MEANCTL1.299
IF (IND_IM.EQ.1) THEN GRB1F305.379
FT_PS(1,1)=23 MEANCTL1.301
FT_PS(1,2)=24 MEANCTL1.302
ELSE MEANCTL1.303
FT_PS(1,1)=43 MEANCTL1.304
FT_PS(1,2)=44 MEANCTL1.305
ENDIF MEANCTL1.306
DO IFIND=2,4 MEANCTL1.307
FT_PS(IFIND,1)=25 MEANCTL1.308
FT_PS(IFIND,2)=26 MEANCTL1.309
ENDDO MEANCTL1.310
C Units must still be alternated as 3 may be open at a time MEANCTL1.311
FT_PS(3,1)=45 MEANCTL1.312
FT_PS(3,2)=46 MEANCTL1.313
CL MEANCTL1.314
CL********************************************************************** MEANCTL1.315
CL LOGICAL SUB-PROCESS C51 MEANCTL1.316
CL Start of default process: updating period_1 partial sum data MEANCTL1.317
CL********************************************************************** MEANCTL1.318
CL MEANCTL1.319
C MEANCTL1.320
IF(RUN_MEANCTL_RESTART.EQ.0)THEN MEANCTL1.321
C MEANCTL1.322
INDEX_READ=RUN_MEANCTL_INDICim(1,IND_IM) GRB1F305.380
INDEX_WRITE=3-RUN_MEANCTL_INDICim(1,IND_IM) GRB1F305.381
FT_READ=FT_PS(1,INDEX_READ) MEANCTL1.325
FT_WRITE=FT_PS(1,INDEX_WRITE) MEANCTL1.326
C MEANCTL1.327
C Temporary check on unit numbers MEANCTL1.328
C MEANCTL1.329
IF(PS_FLAG(1).NE.1)THEN MEANCTL1.330
WRITE(6,*) 'Period_1 data read from unit number ',FT_READ GIE0F403.397
ENDIF MEANCTL1.332
WRITE(6,*) 'Period_1 data written to unit number ',FT_WRITE GIE0F403.398
C MEANCTL1.334
CL MEANCTL1.335
CL STEP 1 MEANCTL1.336
CL Update or create period_1 partial sum data and write out MEANCTL1.337
CL to period_1 partial sum dump MEANCTL1.338
CL MEANCTL1.339
c GBC6F404.96
c--preset the file lengths prior to the open GBC6F404.97
c GBC6F404.98
c--check and reset, if necessary, the dumpfiles addresses GBC6F404.99
*IF DEF,ATMOS GBC6F404.100
if(ind_im.eq.1) then GBC6F404.101
call set_dumpfile_address( GBC6F404.102
& a_fixhd, len_fixhd, GBC6F404.103
& a_lookup, len1_lookup, a_len2_lookup, GBC6F404.104
& number_of_data_words_in_memory, number_of_data_words_on_disk, GBC6F404.105
& disk_address) GBC6F404.106
endif GBC6F404.107
*ENDIF GBC6F404.108
*IF DEF,OCEAN GBC6F404.109
if(ind_im.eq.2) then GBC6F404.110
call set_dumpfile_address( GBC6F404.111
& o_fixhd, len_fixhd, GBC6F404.112
& o_lookup, len1_lookup, o_len2_lookup, GBC6F404.113
& number_of_data_words_in_memory, number_of_data_words_on_disk, GBC6F404.114
& disk_address) GBC6F404.115
endif GBC6F404.116
*ENDIF GBC6F404.117
c GBC6F404.118
c--pass the new file length to the I/O routines GBC6F404.119
call set_dumpfile_length(ft_read , disk_address) GBC6F404.120
call set_dumpfile_length(ft_write, disk_address) GBC6F404.121
C MEANCTL1.340
C Open input and output partial sum files (preassigned names) MEANCTL1.341
C MEANCTL1.342
CALL FILE_OPEN(FT_READ,FT_ENVIRON(FT_READ), GPB1F305.59
& LEN_FT_ENVIR(FT_READ),1,0,ICODE) GPB1F305.60
IF(ICODE.NE.0)GOTO999 MEANCTL1.345
CALL FILE_OPEN(FT_WRITE,FT_ENVIRON(FT_WRITE), GPB1F305.61
& LEN_FT_ENVIR(FT_WRITE),1,0,ICODE) GPB1F305.62
IF(ICODE.NE.0)GOTO999 MEANCTL1.348
C--zero the file lengths GBC6F404.122
call set_dumpfile_length(ft_read , 0) GBC6F404.123
call set_dumpfile_length(ft_write, 0) GBC6F404.124
C MEANCTL1.349
*IF DEF,ATMOS MEANCTL1.350
IF(IND_IM.EQ.1)THEN GRB1F305.382
D1_ADDR_SUBMODEL_ID = SUBMODEL_FOR_SM(1) GSM1F403.178
CALL ACUMPS( A_FIXHD, LEN_FIXHD, GKR1F402.2
& A_INTHD, A_LEN_INTHD, GKR1F402.3
& A_REALHD, A_LEN_REALHD, GKR1F402.4
& A_LEVDEPC, A_LEN1_LEVDEPC, A_LEN2_LEVDEPC, GKR1F402.5
& A_ROWDEPC, A_LEN1_ROWDEPC, A_LEN2_ROWDEPC, GKR1F402.6
& A_COLDEPC, A_LEN1_COLDEPC, A_LEN2_COLDEPC, GKR1F402.7
& A_FLDDEPC, A_LEN1_FLDDEPC, A_LEN2_FLDDEPC, GKR1F402.8
& A_EXTCNST, A_LEN_EXTCNST, GKR1F402.9
& A_DUMPHIST, LEN_DUMPHIST, GKR1F402.10
& A_CFI1, A_LEN_CFI1, GKR1F402.11
& A_CFI2, A_LEN_CFI2, GKR1F402.12
& A_CFI3, A_LEN_CFI3, GKR1F402.13
& A_LOOKUP,LEN1_LOOKUP,A_LEN2_LOOKUP, GSM1F403.179
& 1,NO_OBJ_D1(D1_ADDR_SUBMODEL_ID), GSM1F403.180
& D1_ADDR(1,1,D1_ADDR_SUBMODEL_ID), GSM1F403.181
*IF DEF,MPP GSM1F403.182
& A_MPP_LOOKUP,MPP_LEN1_LOOKUP, GSM1F403.183
*ENDIF GKR1F402.19
& A_LEN_DATA,D1,D1,D1,IBUFLEN(1), GKR1F402.20
& PS_FLAG(1),FT_READ,FT_WRITE,LCLIMREALYR,MEANLEV, GMG1F404.218
& I_MONTH,I_YEAR, GMG1F404.219
*CALL ARGPPX GDG0F401.837
& ICODE,CMESSAGE) GDG0F401.838
ENDIF MEANCTL1.357
*ENDIF MEANCTL1.358
*IF DEF,OCEAN MEANCTL1.359
IF(IND_IM.EQ.2)THEN GRB1F305.383
D1_ADDR_SUBMODEL_ID = SUBMODEL_FOR_SM(2) GSM1F403.184
CALL ACUMPS( O_FIXHD, LEN_FIXHD, GKR1F402.22
& O_INTHD, O_LEN_INTHD, GKR1F402.23
& O_REALHD, O_LEN_REALHD, GKR1F402.24
& O_LEVDEPC, O_LEN1_LEVDEPC, O_LEN2_LEVDEPC, GKR1F402.25
& O_ROWDEPC, O_LEN1_ROWDEPC, O_LEN2_ROWDEPC, GKR1F402.26
& O_COLDEPC, O_LEN1_COLDEPC, O_LEN2_COLDEPC, GKR1F402.27
& O_FLDDEPC, O_LEN1_FLDDEPC, O_LEN2_FLDDEPC, GKR1F402.28
& O_EXTCNST, O_LEN_EXTCNST, GKR1F402.29
& O_DUMPHIST, LEN_DUMPHIST, GKR1F402.30
& O_CFI1, O_LEN_CFI1, GKR1F402.31
& O_CFI2, O_LEN_CFI2, GKR1F402.32
& O_CFI3, O_LEN_CFI3, GKR1F402.33
& O_LOOKUP,LEN1_LOOKUP,O_LEN2_LOOKUP, GSM1F403.185
& 2,NO_OBJ_D1(D1_ADDR_SUBMODEL_ID), GSM1F403.186
& D1_ADDR(1,1,D1_ADDR_SUBMODEL_ID), GSM1F403.187
*IF DEF,MPP GSM1F403.188
& O_MPP_LOOKUP,MPP_LEN1_LOOKUP, GSM1F403.189
*ENDIF GKR1F402.39
& O_LEN_DATA,D1,D1,D1,IBUFLEN(2), GKR1F402.40
& PS_FLAG(1),FT_READ,FT_WRITE,LCLIMREALYR,MEANLEV, GMG1F404.220
& I_MONTH,I_YEAR, GMG1F404.221
*CALL ARGPPX GDG0F401.843
& ICODE,CMESSAGE) GDG0F401.844
ENDIF MEANCTL1.366
*ENDIF MEANCTL1.367
C MEANCTL1.368
C Check return code from ACUMPS MEANCTL1.369
C MEANCTL1.370
IF(ICODE.NE.0)THEN MEANCTL1.371
WRITE(6,*) 'MEANCTL: RESTART AT PERIOD_',RUN_MEANCTL_RESTART GIE0F403.399
GOTO 999 MEANCTL1.373
ENDIF MEANCTL1.374
C MEANCTL1.375
C Close input and output partial sum files MEANCTL1.376
C MEANCTL1.377
CALL FILE_CLOSE(FT_READ,FT_ENVIRON(FT_READ), GTD0F400.7
& LEN_FT_ENVIR(FT_READ),0,1,ICODE) GTD0F400.8
CALL FILE_CLOSE(FT_WRITE,FT_ENVIRON(FT_WRITE), GTD0F400.9
& LEN_FT_ENVIR(FT_WRITE),0,0,ICODE) GTD0F400.10
C MEANCTL1.382
INDEXL=INDEXL+1 MEANCTL1.383
C MEANCTL1.384
C Update RUN_MEANCTL_INDICim for period_1 data GRB1F305.384
C MEANCTL1.386
RUN_MEANCTL_INDICim(1,IND_IM)=3-RUN_MEANCTL_INDICim(1,IND_IM) GRB1F305.385
C MEANCTL1.388
ENDIF MEANCTL1.389
CL MEANCTL1.390
CL********************************************************************** MEANCTL1.391
CL End of default process: updating period_1 partial sum data MEANCTL1.392
CL********************************************************************** MEANCTL1.393
CL MEANCTL1.394
IF(MEANS_TOTAL.GT.0)THEN MEANCTL1.395
CL MEANCTL1.396
CL********************************************************************** MEANCTL1.397
CL LOGICAL SUB-PROCESS C52 MEANCTL1.398
CL Start of means processing and updating of subsequent MEANCTL1.399
CL partial sum dump MEANCTL1.400
CL********************************************************************** MEANCTL1.401
CL MEANCTL1.402
CL STEP 1 MEANCTL1.403
CL Copy instantaneous dump to SSD MEANCTL1.404
CL MEANCTL1.405
CL NB: This must include any "secondary fields" which are used on MEANCTL1.406
CL the following timestep if they are modified in making means - MEANCTL1.407
CL P_EXNER is in this class in the atmosphere case. MEANCTL1.408
CL MEANCTL1.409
c GBC6F404.125
c--compute the maximum length for the FT_SSD File GBC6F404.126
maximum_file_length=0 GBC6F404.127
*IF DEF,ATMOS GBC6F404.128
maximum_file_length=max(maximum_file_length, GBC6F404.129
2 a_len_data+(p_levels+1)*p_field) GBC6F404.130
*ENDIF GBC6F404.131
*IF DEF,OCEAN GBC6F404.132
maximum_file_length=max(maximum_file_length, GBC6F404.133
2 o_len_data) GBC6F404.134
*ENDIF GBC6F404.135
c--set the length of the file needed GBC6F404.136
call set_dumpfile_length(ft_ssd, maximum_file_length) GBC6F404.137
c GBC6F404.138
*IF DEF,ATMOS MEANCTL1.410
IF(IND_IM.EQ.1)THEN GRB1F305.386
CALL TRANSOUT( @DYALLOC.2284
*CALL ARGD1 @DYALLOC.2285
& A_LEN_DATA+(P_LEVELS+1)*P_FIELD,FT_SSD,IND_IM GRR1F402.320
& ,ICODE,CMESSAGE) MEANCTL1.413
ENDIF MEANCTL1.414
*ENDIF MEANCTL1.415
*IF DEF,OCEAN MEANCTL1.416
IF(IND_IM.EQ.2)THEN GRB1F305.387
CALL TRANSOUT( @DYALLOC.2287
*CALL ARGD1 @DYALLOC.2288
& O_LEN_DATA,FT_SSD,IND_IM GRR1F402.321
& ,ICODE,CMESSAGE) MEANCTL1.419
ENDIF MEANCTL1.420
*ENDIF MEANCTL1.421
C MEANCTL1.422
C Check return code from TRANSOUT MEANCTL1.423
C MEANCTL1.424
IF(ICODE.NE.0)THEN MEANCTL1.425
RUN_MEANCTL_RESTART=1 MEANCTL1.426
WRITE(6,*) 'MEANCTL: RESTART AT PERIOD_',RUN_MEANCTL_RESTART GIE0F403.400
GOTO 999 MEANCTL1.428
ENDIF MEANCTL1.429
C MEANCTL1.430
C CALL SETPOS(FT_SSD,0,ICODE) GTD0F400.95
CALL FILE_CLOSE(FT_SSD,FT_ENVIRON(FT_SSD), GTD0F400.11
& LEN_FT_ENVIR(FT_SSD),0,0,ICODE) GTD0F400.12
C MEANCTL1.434
DO MEANLEV=INDEXL,MEANS_TOTAL MEANCTL1.435
C MEANCTL1.436
INDEX_READ=RUN_MEANCTL_INDICim(MEANLEV,IND_IM) GRB1F305.388
FT_READ=FT_PS(MEANLEV,INDEX_READ) MEANCTL1.438
C MEANCTL1.439
C Temporary check on unit number MEANCTL1.440
C MEANCTL1.441
WRITE(6,*) 'Period_',MEANLEV,' data read:unit number ',FT_READ GIE0F403.401
CL MEANCTL1.443
CL STEP 2 MEANCTL1.444
CL Generate period_N time-meaned data and store in main data block MEANCTL1.445
CL MEANCTL1.446
! If real-period meaning selected, find length of current period GMG1F404.222
IF (LCLIMREALYR) THEN GMG1F404.223
CALL SETPERLEN (MEANLEV,I_MONTH,I_YEAR,PERIODLEN) GMG1F404.224
if (meanlev.eq.1) then ! divisor only needs to be in terms GMG1F404.225
! of restart dumps for Period_1 GMG1F404.226
PERIODLENDM=PERIODLEN*DUMPS_PER_DAY GMG1F404.227
else GMG1F404.228
PERIODLENDM=PERIODLEN GMG1F404.229
endif GMG1F404.230
ENDIF GMG1F404.231
*IF DEF,ATMOS MEANCTL1.447
IF(IND_IM.EQ.1)THEN GRB1F305.389
C MEANCTL1.449
C Open input partial sum file (preassigned or calculated name) MEANCTL1.450
C MEANCTL1.451
c--check and reset, if necessary, the dumpfiles addresses GBC6F404.139
call set_dumpfile_address( GBC6F404.140
& a_fixhd, len_fixhd, GBC6F404.141
& a_lookup, len1_lookup, a_len2_lookup, GBC6F404.142
& number_of_data_words_in_memory, GBC6F404.143
& number_of_data_words_on_disk, GBC6F404.144
& disk_address) GBC6F404.145
c--pass the new file length to the I/O routines GBC6F404.146
call set_dumpfile_length(ft_read , disk_address) GBC6F404.147
IF (MEANLEV.EQ.1) THEN MEANCTL1.452
CALL FILE_OPEN(FT_READ,FT_ENVIRON(FT_READ), GPB1F305.66
& LEN_FT_ENVIR(FT_READ),1,0,ICODE) GPB1F305.67
IF(ICODE.NE.0)GOTO999 MEANCTL1.455
ELSE MEANCTL1.456
CALL GET_NAME(EXPT_ID,JOB_ID,IND_IM,MEANLEV,INDEX_READ, GRB1F305.390
& REINIT_STEPS,'s',LETTER_3, MEANCTL1.458
& MODEL_STATUS,TIME_CONVENTION, MEANCTL1.459
& 0,PSNAME_READ,ICODE,CMESSAGE,LCAL360) GSS1F304.463
IF (ICODE.GT.0) GOTO 999 MEANCTL1.461
LEN_PSNAME=LEN(PSNAME_READ) MEANCTL1.462
CALL FILE_OPEN(FT_READ,PSNAME_READ,LEN_PSNAME,1,1,ICODE) GPB1F305.68
IF(ICODE.NE.0)GOTO999 MEANCTL1.464
ENDIF MEANCTL1.465
c--unset the file length in the I/O routines GBC6F404.148
call set_dumpfile_length(ft_read , 0) GBC6F404.149
C MEANCTL1.466
IF (LCLIMREALYR) THEN ! Real-period meaning selected GMG1F404.232
CALL MEANPS( A_FIXHD, LEN_FIXHD, GKR1F402.42
& A_INTHD, A_LEN_INTHD, GKR1F402.43
& A_REALHD, A_LEN_REALHD, GKR1F402.44
& A_LEVDEPC, A_LEN1_LEVDEPC, A_LEN2_LEVDEPC, GKR1F402.45
& A_ROWDEPC, A_LEN1_ROWDEPC, A_LEN2_ROWDEPC, GKR1F402.46
& A_COLDEPC, A_LEN1_COLDEPC, A_LEN2_COLDEPC, GKR1F402.47
& A_FLDDEPC, A_LEN1_FLDDEPC, A_LEN2_FLDDEPC, GKR1F402.48
& A_EXTCNST, A_LEN_EXTCNST, GKR1F402.49
& A_DUMPHIST, LEN_DUMPHIST, GKR1F402.50
& A_CFI1, A_LEN_CFI1, GKR1F402.51
& A_CFI2, A_LEN_CFI2, GKR1F402.52
& A_CFI3, A_LEN_CFI3, GKR1F402.53
& A_LOOKUP,LEN1_LOOKUP,A_LEN2_LOOKUP, GSM1F403.190
& 1,NO_OBJ_D1(D1_ADDR_SUBMODEL_ID), GSM1F403.191
& D1_ADDR(1,1,D1_ADDR_SUBMODEL_ID), GSM1F403.192
*IF DEF,MPP GSM1F403.193
& A_MPP_LOOKUP,MPP_LEN1_LOOKUP, GSM1F403.194
*ENDIF GKR1F402.59
& A_LEN_DATA,D1,D1,D1,IBUFLEN(1), GKR1F402.60
& FT_READ,PERIODLENDM, GMG1F404.233
*CALL ARGPPX GMG1F404.234
& ICODE,CMESSAGE) GMG1F404.235
else ! 360d year meaning selected GMG1F404.236
CALL MEANPS( A_FIXHD, LEN_FIXHD, GMG1F404.237
& A_INTHD, A_LEN_INTHD, GMG1F404.238
& A_REALHD, A_LEN_REALHD, GMG1F404.239
& A_LEVDEPC, A_LEN1_LEVDEPC, A_LEN2_LEVDEPC, GMG1F404.240
& A_ROWDEPC, A_LEN1_ROWDEPC, A_LEN2_ROWDEPC, GMG1F404.241
& A_COLDEPC, A_LEN1_COLDEPC, A_LEN2_COLDEPC, GMG1F404.242
& A_FLDDEPC, A_LEN1_FLDDEPC, A_LEN2_FLDDEPC, GMG1F404.243
& A_EXTCNST, A_LEN_EXTCNST, GMG1F404.244
& A_DUMPHIST, LEN_DUMPHIST, GMG1F404.245
& A_CFI1, A_LEN_CFI1, GMG1F404.246
& A_CFI2, A_LEN_CFI2, GMG1F404.247
& A_CFI3, A_LEN_CFI3, GMG1F404.248
& A_LOOKUP,LEN1_LOOKUP,A_LEN2_LOOKUP, GMG1F404.249
& 1,NO_OBJ_D1(D1_ADDR_SUBMODEL_ID), GMG1F404.250
& D1_ADDR(1,1,D1_ADDR_SUBMODEL_ID), GMG1F404.251
*IF DEF,MPP GMG1F404.252
& A_MPP_LOOKUP,MPP_LEN1_LOOKUP, GMG1F404.253
*ENDIF GMG1F404.254
& A_LEN_DATA,D1,D1,D1,IBUFLEN(1), GMG1F404.255
& FT_READ,MEANFREQim(MEANLEV,IND_IM), GDG0F401.848
*CALL ARGPPX GDG0F401.849
& ICODE,CMESSAGE) GDG0F401.850
ENDIF ! end of test on LCLIMREALYR GMG1F404.256
ENDIF ! end of test on IND_IM.EQ.1 GMG1F404.257
*ENDIF MEANCTL1.473
*IF DEF,OCEAN MEANCTL1.474
IF(IND_IM.EQ.2)THEN GRB1F305.392
C MEANCTL1.476
C Open input partial sum file (preassigned or calculated name) MEANCTL1.477
C MEANCTL1.478
c--check and reset, if necessary, the dumpfiles addresses GBC6F404.150
call set_dumpfile_address( GBC6F404.151
& o_fixhd, len_fixhd, GBC6F404.152
& o_lookup, len1_lookup, o_len2_lookup, GBC6F404.153
& number_of_data_words_in_memory, GBC6F404.154
& number_of_data_words_on_disk, GBC6F404.155
& disk_address) GBC6F404.156
c--pass the new file length to the I/O routines GBC6F404.157
call set_dumpfile_length(ft_read , disk_address) GBC6F404.158
IF (MEANLEV.EQ.1) THEN MEANCTL1.479
CALL FILE_OPEN(FT_READ,FT_ENVIRON(FT_READ), GPB1F305.69
& LEN_FT_ENVIR(FT_READ),1,0,ICODE) GPB1F305.70
IF(ICODE.NE.0)GOTO999 MEANCTL1.482
ELSE MEANCTL1.483
CALL GET_NAME(EXPT_ID,JOB_ID,IND_IM,MEANLEV,INDEX_READ, GRB1F305.393
& REINIT_STEPS,'s',LETTER_3, MEANCTL1.485
& MODEL_STATUS,TIME_CONVENTION, MEANCTL1.486
& 0,PSNAME_READ,ICODE,CMESSAGE,LCAL360) GSS1F304.464
IF (ICODE.GT.0) GOTO 999 MEANCTL1.488
LEN_PSNAME=LEN(PSNAME_READ) MEANCTL1.489
CALL FILE_OPEN(FT_READ,PSNAME_READ,LEN_PSNAME,1,1,ICODE) GPB1F305.71
IF(ICODE.NE.0)GOTO999 MEANCTL1.491
ENDIF MEANCTL1.492
c--unset the file length in the I/O routines GBC6F404.159
call set_dumpfile_length(ft_read , 0) GBC6F404.160
C MEANCTL1.493
IF (LCLIMREALYR) THEN GMG1F404.258
CALL MEANPS( O_FIXHD, LEN_FIXHD, GKR1F402.61
& O_INTHD, O_LEN_INTHD, GKR1F402.62
& O_REALHD, O_LEN_REALHD, GKR1F402.63
& O_LEVDEPC, O_LEN1_LEVDEPC, O_LEN2_LEVDEPC, GKR1F402.64
& O_ROWDEPC, O_LEN1_ROWDEPC, O_LEN2_ROWDEPC, GKR1F402.65
& O_COLDEPC, O_LEN1_COLDEPC, O_LEN2_COLDEPC, GKR1F402.66
& O_FLDDEPC, O_LEN1_FLDDEPC, O_LEN2_FLDDEPC, GKR1F402.67
& O_EXTCNST, O_LEN_EXTCNST, GKR1F402.68
& O_DUMPHIST, LEN_DUMPHIST, GKR1F402.69
& O_CFI1, O_LEN_CFI1, GKR1F402.70
& O_CFI2, O_LEN_CFI2, GKR1F402.71
& O_CFI3, O_LEN_CFI3, GKR1F402.72
& O_LOOKUP,LEN1_LOOKUP,O_LEN2_LOOKUP, GSM1F403.195
& 2,NO_OBJ_D1(D1_ADDR_SUBMODEL_ID), GSM1F403.196
& D1_ADDR(1,1,D1_ADDR_SUBMODEL_ID), GSM1F403.197
*IF DEF,MPP GSM1F403.198
& O_MPP_LOOKUP,MPP_LEN1_LOOKUP, GSM1F403.199
*ENDIF GKR1F402.78
& O_LEN_DATA,D1,D1,D1,IBUFLEN(2), GKR1F402.79
& FT_READ,PERIODLENDM, GMG1F404.259
*CALL ARGPPX GMG1F404.260
& ICODE,CMESSAGE) GMG1F404.261
else ! 360d year meaning selected GMG1F404.262
CALL MEANPS( O_FIXHD, LEN_FIXHD, GMG1F404.263
& O_INTHD, O_LEN_INTHD, GMG1F404.264
& O_REALHD, O_LEN_REALHD, GMG1F404.265
& O_LEVDEPC, O_LEN1_LEVDEPC, O_LEN2_LEVDEPC, GMG1F404.266
& O_ROWDEPC, O_LEN1_ROWDEPC, O_LEN2_ROWDEPC, GMG1F404.267
& O_COLDEPC, O_LEN1_COLDEPC, O_LEN2_COLDEPC, GMG1F404.268
& O_FLDDEPC, O_LEN1_FLDDEPC, O_LEN2_FLDDEPC, GMG1F404.269
& O_EXTCNST, O_LEN_EXTCNST, GMG1F404.270
& O_DUMPHIST, LEN_DUMPHIST, GMG1F404.271
& O_CFI1, O_LEN_CFI1, GMG1F404.272
& O_CFI2, O_LEN_CFI2, GMG1F404.273
& O_CFI3, O_LEN_CFI3, GMG1F404.274
& O_LOOKUP,LEN1_LOOKUP,O_LEN2_LOOKUP, GMG1F404.275
& 2,NO_OBJ_D1(D1_ADDR_SUBMODEL_ID), GMG1F404.276
& D1_ADDR(1,1,D1_ADDR_SUBMODEL_ID), GMG1F404.277
*IF DEF,MPP GMG1F404.278
& O_MPP_LOOKUP,MPP_LEN1_LOOKUP, GMG1F404.279
*ENDIF GMG1F404.280
& O_LEN_DATA,D1,D1,D1,IBUFLEN(2), GMG1F404.281
& FT_READ,MEANFREQim(MEANLEV,IND_IM), GDG0F401.854
*CALL ARGPPX GDG0F401.855
& ICODE,CMESSAGE) GDG0F401.856
ENDIF ! end of IF test on LCLIMREALYR GMG1F404.282
ENDIF ! end of IF test on IND_IM.EQ.2 GMG1F404.283
*ENDIF MEANCTL1.500
C MEANCTL1.501
C Check return code from MEANPS MEANCTL1.502
C MEANCTL1.503
IF(ICODE.NE.0)THEN MEANCTL1.504
RUN_MEANCTL_RESTART=MEANLEV MEANCTL1.505
WRITE(6,*) 'MEANCTL: RESTART AT PERIOD_',RUN_MEANCTL_RESTART GIE0F403.402
GOTO 999 MEANCTL1.507
ENDIF MEANCTL1.508
C MEANCTL1.509
PSNAME_DELETE=PSNAME_READ MEANCTL1.510
CALL SETPOS(FT_READ,0,ICODE) GTD0F400.96
FT_DELETE=FT_READ MEANCTL1.512
CL MEANCTL1.513
CL STEP 3.1 MEANCTL1.514
CL Calculate mean diagnostics and extract PPfields from mean data MEANCTL1.515
CL MEANCTL1.516
*IF DEF,ATMOS MEANCTL1.517
IF (IND_IM.EQ.1) THEN GRB1F305.395
C Set P_EXNER from mean primary fields MEANCTL1.519
CALL SETEXNER ( @DYALLOC.2292
*CALL ARGSIZE @DYALLOC.2293
*CALL ARGD1 @DYALLOC.2294
*CALL ARGPTRA @DYALLOC.2295
*CALL ARGCONA @DYALLOC.2296
* ICODE,CMESSAGE) @DYALLOC.2297
C @DYALLOC.2298
*IF DEF,MPP GPB2F405.89
! Find the largest output field size to dimension I/O buffer array GPB2F405.90
maxsize=1 GPB2F405.91
GPB2F405.92
DO IE=1,TOTITEMS GPB2F405.93
tag=STLIST(st_macrotag,IE)/1000 GPB2F405.94
IF (MOD(tag/(2**(MEANLEV-1)),2) .EQ. 1) THEN GPB2F405.95
maxsize=MAX(maxsize, GPB2F405.96
& STLIST(st_dump_output_length,IE)) GPB2F405.97
ENDIF GPB2F405.98
ENDDO GPB2F405.99
*ENDIF GPB2F405.100
! Extract mean diagnostics (both normal and sections 21-24/41-44) GMG1F404.284
CALL MEANDIAG ( @DYALLOC.2299
*CALL ARGSIZE @DYALLOC.2300
*CALL ARGD1 @DYALLOC.2301
*CALL ARGDUMA @DYALLOC.2302
*CALL ARGDUMO @DYALLOC.2303
*CALL ARGDUMW GKR1F401.228
*CALL ARGSTS @DYALLOC.2304
*CALL ARGPTRA @DYALLOC.2305
*CALL ARGPTRO @DYALLOC.2306
*CALL ARGCONA @DYALLOC.2307
*CALL ARGINFA @DYALLOC.2308
*CALL ARGINFO GMB1F405.405
*CALL ARGPPX GKR0F305.955
*CALL ARGFLDPT GSM1F405.500
* IND_IM,MEANLEV,PP_LEN2_MEANim(MEANLEV,IND_IM),STEP_DUMPS, GRB1F305.396
& NMVALS(MEANLEV), GPB2F405.101
*IF DEF,MPP GPB2F405.102
& maxsize, GPB2F405.103
*ENDIF GPB2F405.104
& ICODE,CMESSAGE) GPB2F405.105
ENDIF MEANCTL1.525
*ENDIF MEANCTL1.526
*IF DEF,OCEAN MEANCTL1.527
IF (IND_IM.EQ.2) THEN GRB1F305.397
*IF DEF,MPP GPB2F405.106
! Find the largest output field size to dimension I/O buffer array GPB2F405.107
maxsize=1 GPB2F405.108
GPB2F405.109
DO IE=1,TOTITEMS GPB2F405.110
tag=STLIST(st_macrotag,IE)/1000 GPB2F405.111
IF (MOD(tag/(2**(MEANLEV-1)),2) .EQ. 1) THEN GPB2F405.112
maxsize=MAX(maxsize, GPB2F405.113
& STLIST(st_dump_output_length,IE)) GPB2F405.114
ENDIF GPB2F405.115
ENDDO GPB2F405.116
*ENDIF GPB2F405.117
CALL MEANDIAG ( @DYALLOC.2312
*CALL ARGSIZE @DYALLOC.2313
*CALL ARGD1 @DYALLOC.2314
*CALL ARGDUMA @DYALLOC.2315
*CALL ARGDUMO @DYALLOC.2316
*CALL ARGDUMW GKR1F401.229
*CALL ARGSTS @DYALLOC.2317
*CALL ARGPTRA @DYALLOC.2318
*CALL ARGPTRO @DYALLOC.2319
*CALL ARGCONA @DYALLOC.2320
*CALL ARGINFA @DYALLOC.2321
*CALL ARGINFO GMB1F405.406
*CALL ARGPPX ORH1F400.1
*IF DEF,ATMOS GSM1F405.501
*CALL ARGFLDPT GSM1F405.502
*ENDIF GSM1F405.503
* IND_IM,MEANLEV,PP_LEN2_MEANim(MEANLEV,IND_IM),STEP_DUMPS, GRB1F305.398
& NMVALS(MEANLEV), GPB2F405.118
*IF DEF,MPP GPB2F405.119
& maxsize, GPB2F405.120
*ENDIF GPB2F405.121
& ICODE,CMESSAGE) GPB2F405.122
ENDIF @DYALLOC.2324
*ENDIF MEANCTL1.532
IF (ICODE.GT.0) GOTO 999 MEANCTL1.533
CL MEANCTL1.534
CL STEP 3.2 MEANCTL1.535
CL Calculate zonal means from period_N time-meaned data MEANCTL1.536
CL MEANCTL1.537
IF(PRINT_FLAG(MEANLEV).EQ.1)THEN MEANCTL1.538
WRITE(6,*) 'Print statistics for period_',MEANLEV,' mean' GIE0F403.403
CALL PRINTCTL ( @DYALLOC.2325
*CALL ARGSIZE @DYALLOC.2326
*CALL ARGD1 @DYALLOC.2327
*CALL ARGDUMA @DYALLOC.2328
*CALL ARGPTRA @DYALLOC.2329
*CALL ARGCONA @DYALLOC.2330
+ IND_IM,MEANLEV,ICODE,CMESSAGE) GRB1F400.62
ENDIF MEANCTL1.541
IF (ICODE.GT.0) GOTO 999 MEANCTL1.542
CL MEANCTL1.543
CL STEP 4 MEANCTL1.544
CL Check to see if period_N+1 partial sum data needs to updated MEANCTL1.545
CL or created. MEANCTL1.546
CL If so, proceed and write out to period_N+1 partial sum dump MEANCTL1.547
CL MEANCTL1.548
IF(MEANLEV.NE.NMEANS)THEN MEANCTL1.549
C MEANCTL1.550
INDEX_READ=RUN_MEANCTL_INDICim(MEANLEV+1,IND_IM) GRB1F305.400
INDEX_WRITE=3-RUN_MEANCTL_INDICim(MEANLEV+1,IND_IM) GRB1F305.401
FT_READ=FT_PS(MEANLEV+1,INDEX_READ) MEANCTL1.553
FT_WRITE=FT_PS(MEANLEV+1,INDEX_WRITE) MEANCTL1.554
C MEANCTL1.555
C Temporary check on unit numbers MEANCTL1.556
C MEANCTL1.557
IF(PS_FLAG(MEANLEV+1).NE.1)THEN MEANCTL1.558
WRITE(6,*) 'Period_',MEANLEV+1,' data read:unit number ',FT_READ GIE0F403.404
ENDIF MEANCTL1.560
WRITE(6,*) 'Period_',MEANLEV+1,' data written:unit number ', GIE0F403.405
* FT_WRITE MEANCTL1.562
C MEANCTL1.563
*IF DEF,ATMOS MEANCTL1.564
IF(IND_IM.EQ.1)THEN GRB1F305.402
C MEANCTL1.596
C Open input and output partial sum files (calculated names) MEANCTL1.597
C MEANCTL1.598
CALL GET_NAME(EXPT_ID,JOB_ID,IND_IM,MEANLEV+1,INDEX_READ, GRB1F305.403
& REINIT_STEPS,'s',LETTER_3, MEANCTL1.600
& MODEL_STATUS,TIME_CONVENTION, MEANCTL1.601
& 0,PSNAME_READ,ICODE,CMESSAGE,LCAL360) GSS1F304.468
IF (ICODE.GT.0) GOTO 999 MEANCTL1.603
c--check and reset, if necessary, the dumpfiles addresses GBC6F404.161
call set_dumpfile_address( GBC6F404.162
& a_fixhd, len_fixhd, GBC6F404.163
& a_lookup, len1_lookup, a_len2_lookup, GBC6F404.164
& number_of_data_words_in_memory, GBC6F404.165
& number_of_data_words_on_disk, GBC6F404.166
& disk_address) GBC6F404.167
c--pass the new file length to the I/O routines GBC6F404.168
call set_dumpfile_length(ft_read , disk_address) GBC6F404.169
LEN_PSNAME=LEN(PSNAME_READ) MEANCTL1.604
CALL FILE_OPEN(FT_READ,PSNAME_READ,LEN_PSNAME,1,1,ICODE) GPB1F305.72
IF(ICODE.NE.0)GOTO999 MEANCTL1.606
c--unset the file length in the I/O routines GBC6F404.170
call set_dumpfile_length(ft_read , 0) GBC6F404.171
C MEANCTL1.607
CALL GET_NAME(EXPT_ID,JOB_ID,IND_IM,MEANLEV+1,INDEX_WRITE, GRB1F305.404
& REINIT_STEPS,'s',LETTER_3, MEANCTL1.609
& MODEL_STATUS,TIME_CONVENTION, MEANCTL1.610
& 0,PSNAME_WRITE,ICODE,CMESSAGE,LCAL360) GSS1F304.469
IF (ICODE.GT.0) GOTO 999 MEANCTL1.612
c--check and reset, if necessary, the dumpfiles addresses GBC6F404.172
call set_dumpfile_address( GBC6F404.173
& a_fixhd, len_fixhd, GBC6F404.174
& a_lookup, len1_lookup, a_len2_lookup, GBC6F404.175
& number_of_data_words_in_memory, GBC6F404.176
& number_of_data_words_on_disk, GBC6F404.177
& disk_address) GBC6F404.178
c GBC6F404.179
c--pass the new file length to the I/O routines GBC6F404.180
call set_dumpfile_length(ft_write, disk_address) GBC6F404.181
LEN_PSNAME=LEN(PSNAME_WRITE) MEANCTL1.613
CALL FILE_OPEN(FT_WRITE,PSNAME_WRITE,LEN_PSNAME,1,1,ICODE) GPB1F305.74
IF(ICODE.NE.0)GOTO999 MEANCTL1.615
c--unset the file length in the I/O routines GBC6F404.182
call set_dumpfile_length(ft_write, 0) GBC6F404.183
C MEANCTL1.616
D1_ADDR_SUBMODEL_ID = SUBMODEL_FOR_SM(1) GSM1F403.200
CALL ACUMPS( A_FIXHD, LEN_FIXHD, GKR1F402.80
& A_INTHD, A_LEN_INTHD, GKR1F402.81
& A_REALHD, A_LEN_REALHD, GKR1F402.82
& A_LEVDEPC, A_LEN1_LEVDEPC, A_LEN2_LEVDEPC, GKR1F402.83
& A_ROWDEPC, A_LEN1_ROWDEPC, A_LEN2_ROWDEPC, GKR1F402.84
& A_COLDEPC, A_LEN1_COLDEPC, A_LEN2_COLDEPC, GKR1F402.85
& A_FLDDEPC, A_LEN1_FLDDEPC, A_LEN2_FLDDEPC, GKR1F402.86
& A_EXTCNST, A_LEN_EXTCNST, GKR1F402.87
& A_DUMPHIST, LEN_DUMPHIST, GKR1F402.88
& A_CFI1, A_LEN_CFI1, GKR1F402.89
& A_CFI2, A_LEN_CFI2, GKR1F402.90
& A_CFI3, A_LEN_CFI3, GKR1F402.91
& A_LOOKUP,LEN1_LOOKUP,A_LEN2_LOOKUP, GSM1F403.202
& 1,NO_OBJ_D1(D1_ADDR_SUBMODEL_ID), GSM1F403.203
& D1_ADDR(1,1,D1_ADDR_SUBMODEL_ID), GSM1F403.204
*IF DEF,MPP GSM1F403.205
& A_MPP_LOOKUP,MPP_LEN1_LOOKUP, GSM1F403.206
*ENDIF GKR1F402.97
& A_LEN_DATA,D1,D1,D1,IBUFLEN(1), GKR1F402.98
& PS_FLAG(MEANLEV+1),FT_READ,FT_WRITE, GKR1F402.99
& LCLIMREALYR,MEANLEV,I_MONTH,I_YEAR, GMG1F404.285
*CALL ARGPPX GDG0F401.861
& ICODE,CMESSAGE) GDG0F401.862
ENDIF @DYALLOC.2337
*ENDIF @DYALLOC.2338
*IF DEF,OCEAN @DYALLOC.2339
IF(IND_IM.EQ.2)THEN GRB1F305.405
C @DYALLOC.2341
C Open input and output partial sum files (calculated names) @DYALLOC.2342
C @DYALLOC.2343
CALL GET_NAME(EXPT_ID,JOB_ID,IND_IM,MEANLEV+1,INDEX_READ, GRB1F305.406
& REINIT_STEPS,'s',LETTER_3, @DYALLOC.2345
& MODEL_STATUS,TIME_CONVENTION, @DYALLOC.2346
& 0,PSNAME_READ,ICODE,CMESSAGE,LCAL360) GSS1F304.470
IF (ICODE.GT.0) GOTO 999 @DYALLOC.2348
c--check and reset, if necessary, the dumpfiles addresses GBC6F404.184
call set_dumpfile_address( GBC6F404.185
& o_fixhd, len_fixhd, GBC6F404.186
& o_lookup, len1_lookup, o_len2_lookup, GBC6F404.187
& number_of_data_words_in_memory, GBC6F404.188
& number_of_data_words_on_disk, GBC6F404.189
& disk_address) GBC6F404.190
c--pass the new file length to the I/O routines GBC6F404.191
call set_dumpfile_length(ft_read , disk_address) GBC6F404.192
LEN_PSNAME=LEN(PSNAME_READ) @DYALLOC.2349
CALL FILE_OPEN(FT_READ,PSNAME_READ,LEN_PSNAME,1,1,ICODE) GPB1F305.58
IF(ICODE.NE.0)GOTO999 @DYALLOC.2351
c--unset the file length in the I/O routines GBC6F404.193
call set_dumpfile_length(ft_read , 0) GBC6F404.194
C @DYALLOC.2352
CALL GET_NAME(EXPT_ID,JOB_ID,IND_IM,MEANLEV+1,INDEX_WRITE, GRB1F305.407
& REINIT_STEPS,'s',LETTER_3, @DYALLOC.2354
& MODEL_STATUS,TIME_CONVENTION, @DYALLOC.2355
& 0,PSNAME_WRITE,ICODE,CMESSAGE,LCAL360) GSS1F304.471
IF (ICODE.GT.0) GOTO 999 @DYALLOC.2357
c--check and reset, if necessary, the dumpfiles addresses GBC6F404.195
call set_dumpfile_address( GBC6F404.196
& o_fixhd, len_fixhd, GBC6F404.197
& o_lookup, len1_lookup, o_len2_lookup, GBC6F404.198
& number_of_data_words_in_memory, GBC6F404.199
& number_of_data_words_on_disk, GBC6F404.200
& disk_address) GBC6F404.201
c GBC6F404.202
c--pass the new file length to the I/O routines GBC6F404.203
call set_dumpfile_length(ft_write, disk_address) GBC6F404.204
LEN_PSNAME=LEN(PSNAME_WRITE) @DYALLOC.2358
CALL FILE_OPEN(FT_WRITE,PSNAME_WRITE,LEN_PSNAME,1,1,ICODE) GPB1F305.73
IF(ICODE.NE.0)GOTO999 @DYALLOC.2360
c--unset the file length in the I/O routines GBC6F404.205
call set_dumpfile_length(ft_write, 0) GBC6F404.206
C @DYALLOC.2361
D1_ADDR_SUBMODEL_ID = SUBMODEL_FOR_SM(2) GSM1F403.207
CALL ACUMPS( O_FIXHD, LEN_FIXHD, GKR1F402.100
& O_INTHD, O_LEN_INTHD, GKR1F402.101
& O_REALHD, O_LEN_REALHD, GKR1F402.102
& O_LEVDEPC, O_LEN1_LEVDEPC, O_LEN2_LEVDEPC, GKR1F402.103
& O_ROWDEPC, O_LEN1_ROWDEPC, O_LEN2_ROWDEPC, GKR1F402.104
& O_COLDEPC, O_LEN1_COLDEPC, O_LEN2_COLDEPC, GKR1F402.105
& O_FLDDEPC, O_LEN1_FLDDEPC, O_LEN2_FLDDEPC, GKR1F402.106
& O_EXTCNST, O_LEN_EXTCNST, GKR1F402.107
& O_DUMPHIST, LEN_DUMPHIST, GKR1F402.108
& O_CFI1, O_LEN_CFI1, GKR1F402.109
& O_CFI2, O_LEN_CFI2, GKR1F402.110
& O_CFI3, O_LEN_CFI3, GKR1F402.111
& O_LOOKUP,LEN1_LOOKUP,O_LEN2_LOOKUP, GSM1F403.208
& 2,NO_OBJ_D1(D1_ADDR_SUBMODEL_ID), GSM1F403.209
& D1_ADDR(1,1,D1_ADDR_SUBMODEL_ID), GSM1F403.210
*IF DEF,MPP GSM1F403.211
& O_MPP_LOOKUP,MPP_LEN1_LOOKUP, GSM1F403.212
*ENDIF GKR1F402.117
& O_LEN_DATA,D1,D1,D1,IBUFLEN(2), GKR1F402.118
& PS_FLAG(MEANLEV+1),FT_READ,FT_WRITE, GKR1F402.119
& LCLIMREALYR,MEANLEV,I_MONTH,I_YEAR, GMG1F404.286
*CALL ARGPPX GDG0F401.867
& ICODE,CMESSAGE) GDG0F401.868
ENDIF MEANCTL1.622
*ENDIF MEANCTL1.623
GKR1F404.296
! GKR1F404.297
! Check return code from ACUMPS GKR1F404.298
! GKR1F404.299
IF(ICODE.NE.0)THEN GJC0F405.29
WRITE(6,*) 'MEANCTL: RESTART AT PERIOD_',RUN_MEANCTL_RESTART GJC0F405.30
GOTO 999 GKR1F404.302
ENDIF GKR1F404.303
GKR1F404.304
C MEANCTL1.624
C Update RUN_MEANCTL_INDICim for period_N+1 data GRB1F305.408
C MEANCTL1.626
RUN_MEANCTL_INDICim(MEANLEV+1,IND_IM)= GRB1F305.409
& 3-RUN_MEANCTL_INDICim(MEANLEV+1,IND_IM) GRB1F305.410
C MEANCTL1.629
ENDIF MEANCTL1.630
CL MEANCTL1.631
! If archiving of time-meaned dumps not required then do not create them GSM2F404.3
IF (MEANARCHim(MEANLEV,IND_IM).NE.0)THEN GSM2F404.4
CL STEP 5 MEANCTL1.632
CL Transfer period_N time-meaned data to disk MEANCTL1.633
CL MEANCTL1.634
CL Set up appropriate header for time-mean dump MEANCTL1.635
CL MEANCTL1.636
*IF DEF,ATMOS MEANCTL1.637
IF (IND_IM.EQ.1) THEN GRB1F305.411
A_FIXHD(5)=2 MEANCTL1.639
ENDIF MEANCTL1.640
*ENDIF MEANCTL1.641
*IF DEF,OCEAN MEANCTL1.642
IF (IND_IM.EQ.2) THEN GRB1F305.412
O_FIXHD(5)=2 MEANCTL1.644
ENDIF MEANCTL1.645
*ENDIF MEANCTL1.646
CALL DUMPCTL ( @DYALLOC.2363
*CALL ARGSIZE @DYALLOC.2364
*CALL ARGD1 @DYALLOC.2365
*CALL ARGDUMA @DYALLOC.2366
*CALL ARGDUMO @DYALLOC.2367
*CALL ARGDUMW GKR1F401.230
*CALL ARGCONA @DYALLOC.2368
*CALL ARGPTRA @DYALLOC.2369
*CALL ARGSTS @DYALLOC.2370
*CALL ARGPPX GDG0F401.869
& IND_IM,MEANLEV,.false.,' ',0, GKR4F403.36
& ICODE,CMESSAGE) GKR4F403.37
GKR4F403.38
C MEANCTL1.648
ENDIF GSM2F404.5
C Check return code from DUMPCTL MEANCTL1.649
C MEANCTL1.650
IF(ICODE.NE.0)THEN MEANCTL1.651
RUN_MEANCTL_RESTART=MEANLEV MEANCTL1.652
WRITE(6,*) 'MEANCTL: RESTART AT PERIOD_',RUN_MEANCTL_RESTART GIE0F403.406
LEN_PSNAME=LEN(PSNAME_WRITE) MEANCTL1.654
CALL SETPOS(FT_WRITE,0,ICODE) GTD0F400.97
CALL FILE_CLOSE(FT_WRITE,PSNAME_WRITE,LEN_PSNAME,1,1,ICODE) GTD0F400.13
LEN_PSNAME=LEN(PSNAME_READ) MEANCTL1.657
CALL SETPOS(FT_READ,0,ICODE) GTD0F400.98
CALL FILE_CLOSE(FT_READ,PSNAME_READ,LEN_PSNAME,1,0,ICODE) GTD0F400.14
GOTO 999 MEANCTL1.660
ENDIF MEANCTL1.661
C MEANCTL1.662
C Decide disposition of period_N+1 partial sum dumps MEANCTL1.663
C NB: for restartability it is NOT safe to delete period 2+ sums MEANCTL1.664
C MEANCTL1.665
IF(MEANLEV.NE.NMEANS)THEN MEANCTL1.666
LEN_PSNAME=LEN(PSNAME_READ) MEANCTL1.667
CALL SETPOS(FT_READ,0,ICODE) GTD0F400.99
CALL FILE_CLOSE(FT_READ,PSNAME_READ,LEN_PSNAME,1,0,ICODE) GTD0F400.15
LEN_PSNAME=LEN(PSNAME_WRITE) MEANCTL1.670
CALL SETPOS(FT_WRITE,0,ICODE) GTD0F400.100
CALL FILE_CLOSE(FT_WRITE,PSNAME_WRITE,LEN_PSNAME,1,0,ICODE) GTD0F400.16
ENDIF MEANCTL1.673
C MEANCTL1.674
C Decide disposition of remaining period_N partial sum dump MEANCTL1.675
C NB: for restartability it is NOT safe to delete period 2 sums MEANCTL1.676
C MEANCTL1.677
IF (MEANLEV.GE.2) THEN MEANCTL1.678
LEN_PSNAME=LEN(PSNAME_DELETE) MEANCTL1.679
CALL FILE_CLOSE(FT_DELETE,PSNAME_DELETE,LEN_PSNAME,1,0, GTD0F400.17
& ICODE) GTD0F400.18
ELSE MEANCTL1.681
CALL FILE_CLOSE(FT_DELETE,FT_ENVIRON(FT_DELETE), GTD0F400.19
& LEN_FT_ENVIR(FT_DELETE),0,0,ICODE) GSM1F403.201
ENDIF MEANCTL1.684
C MEANCTL1.685
ENDDO MEANCTL1.686
CL MEANCTL1.687
CL STEP 6 MEANCTL1.688
CL Read back instantaneous dump from SSD MEANCTL1.689
CL MEANCTL1.690
*IF DEF,ATMOS MEANCTL1.691
IF(IND_IM.EQ.1)THEN GRB1F305.414
CALL TRANSIN( @DYALLOC.2372
*CALL ARGD1 @DYALLOC.2373
& A_LEN_DATA+(P_LEVELS+1)*P_FIELD,FT_SSD,IND_IM GRR1F402.322
& ,ICODE,CMESSAGE) MEANCTL1.694
A_FIXHD(5)=1 MEANCTL1.695
ENDIF MEANCTL1.696
*ENDIF MEANCTL1.697
*IF DEF,OCEAN MEANCTL1.698
IF(IND_IM.EQ.2)THEN GRB1F305.415
CALL TRANSIN( @DYALLOC.2375
*CALL ARGD1 @DYALLOC.2376
& O_LEN_DATA,FT_SSD,IND_IM GRR1F402.323
& ,ICODE,CMESSAGE) MEANCTL1.701
O_FIXHD(5)=1 MEANCTL1.702
ENDIF MEANCTL1.703
*ENDIF MEANCTL1.704
C MEANCTL1.705
C Check return code from TRANSIN MEANCTL1.706
C MEANCTL1.707
IF(ICODE.NE.0)THEN MEANCTL1.708
RUN_MEANCTL_RESTART=0 MEANCTL1.709
WRITE(6,*) 'MEANCTL: MEANS COMPLETE',BLANK, GIE0F403.407
& '- RECOVERY OF INSTANTANEOUS DATA HAS FAILED' MEANCTL1.711
GOTO 999 MEANCTL1.712
ENDIF MEANCTL1.713
C MEANCTL1.714
C CALL SETPOS(FT_SSD,0,ICODE) GTD0F400.101
CALL FILE_CLOSE(FT_SSD,FT_ENVIRON(FT_SSD),LEN_FT_ENVIR(FT_SSD), GTD0F400.21
& 0,0,ICODE) GTD0F400.22
C MEANCTL1.718
IF (ICODE .EQ. 0) THEN GKR1F404.305
! Meaning has been successful so it is now safe to delete the restart GKR1F404.306
! dumps from the previous dump time. GKR1F404.307
*IF DEF,ATMOS GIE0F405.48
*IF DEF,OCEAN GIE0F405.49
im=ocean_im GIE0F405.50
*ENDIF Ocean GIE0F405.51
*IF DEF,SLAB GIE0F405.52
im= slab_im GIE0F405.53
*ENDIF Slab GIE0F405.54
*IF DEF,OCEAN,OR,DEF,SLAB GIE0F405.55
GIE0F405.56
! Check if ocean/slab has completed the same number of groups as atmos GIE0F405.57
IF( (STEPim(atmos_im)/GROUPim(atmos_im) ).EQ. GIE0F405.58
* (STEPim( im)/GROUPim( im) ) ) THEN GIE0F405.59
internal_model=atmos_im GIE0F405.60
ELSE GIE0F405.61
internal_model= im ! either slab or ocean GIE0F405.62
ENDIF GIE0F405.63
*ELSE Not OCEAN or SLAB GIE0F405.64
internal_model=atmos_im GIE0F405.65
*ENDIF on OCEAN or SLAB GIE0F405.66
GIE0F405.67
*ELSE Not ATMOS GIE0F405.68
*IF DEF,OCEAN GIE0F405.69
internal_model=ocean_im GIE0F405.70
*ELSE GIE0F405.71
*IF DEF,WAVE GIE0F405.72
! This construct is only valid while the wave sub-model in not coupled GIE0F405.73
! to any other sub-model. GIE0F405.74
internal_model=wave_im GIE0F405.75
*ELSE GIE0F405.76
ICODE=1 GIE0F405.77
CMESSAGE="SETGRCTL : Illegal sub-model type, not ATMOS, OCEAN or GIE0F405.78
& WAVE" GIE0F405.79
*ENDIF on WAVE GIE0F405.80
*ENDIF on OCEAN GIE0F405.81
*ENDIF on ATMOS GIE0F405.82
*IF DEF,MPP GKR1F404.308
IF (mype.eq.0) THEN GKR1F404.309
*ENDIF GKR1F404.310
GKR1F404.311
IF (IND_IM .EQ. A_IM) THEN GKR1F404.312
GKR1F404.313
IF ((internal_model .EQ. atmos_im).OR. GIE0F405.83
& (internal_model .EQ. slab_im)) THEN GIE0F405.84
IF (LASTDMPim(A_IM).NE." ") THEN GKR1F404.315
WRITE(8,890) LASTDMPim(A_IM) GKR1F404.316
CLOSE(8) GKR1F404.317
ENDIF GKR1F404.318
OPEN(8,FILE=FILENAME) GKR1F404.319
ENDIF GKR1F404.320
GKR1F404.321
GKR1F404.322
ELSEIF (IND_IM .EQ. O_IM) THEN GKR1F404.323
GKR1F404.324
IF (LASTDMPim(O_IM).NE." ") THEN GKR1F404.325
WRITE(8,890) LASTDMPim(O_IM) GKR1F404.326
CLOSE(8) GKR1F404.327
ENDIF GKR1F404.328
OPEN(8,FILE=FILENAME) GKR1F404.329
GKR1F404.330
IF (internal_model .EQ. atmos_im) THEN GIE0F405.85
GIE0F405.86
GIE0F405.87
! There is > 1 internal model ie. coupled then delete the GKR1F404.332
! last atmos dump too (should put stronger test here) GKR1F404.333
IF (LASTDMPim(A_IM).NE." ") THEN GKR1F404.334
WRITE(8,890) LASTDMPim(A_IM) GKR1F404.335
CLOSE(8) GKR1F404.336
ENDIF GKR1F404.337
OPEN(8,FILE=FILENAME) GKR1F404.338
ENDIF GKR1F404.339
GKR1F404.340
GKR1F404.341
ELSEIF (IND_IM .EQ. W_IM) THEN GKR1F404.342
GKR1F404.343
IF (LASTDMPim(W_IM).NE." ") THEN GKR1F404.344
WRITE(8,890) LASTDMPim(W_IM) GKR1F404.345
CLOSE(8) GKR1F404.346
ENDIF GKR1F404.347
OPEN(8,FILE=FILENAME) GKR1F404.348
GKR1F404.349
ENDIF GKR1F404.350
GKR1F404.351
*IF DEF,MPP GKR1F404.352
ENDIF ! (mype.eq.0) GKR1F404.353
*ENDIF GKR1F404.354
GKR1F404.355
890 FORMAT('%%% ',A14,' DELETE') GKR1F404.356
GKR1F404.357
ENDIF GKR1F404.358
ENDIF MEANCTL1.719
CL MEANCTL1.720
CL********************************************************************** MEANCTL1.721
CL End of means processing and updating of subsequent MEANCTL1.722
CL partial sum dumps MEANCTL1.723
CL********************************************************************** MEANCTL1.724
CL MEANCTL1.725
C Reset RUN_MEANCTL_RESTART to zero MEANCTL1.726
C MEANCTL1.727
RUN_MEANCTL_RESTART=0 MEANCTL1.728
C MEANCTL1.729
999 CONTINUE MEANCTL1.730
C MEANCTL1.731
C Reset MEANLEV to zero MEANCTL1.732
C MEANCTL1.733
MEANLEV=0 MEANCTL1.734
RETURN MEANCTL1.735
END MEANCTL1.736
*ENDIF MEANCTL1.737