*IF DEF,CONTROL INITMEA1.2
C ******************************COPYRIGHT****************************** GTS2F400.4789
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.4790
C GTS2F400.4791
C Use, duplication or disclosure of this code is subject to the GTS2F400.4792
C restrictions as set forth in the contract. GTS2F400.4793
C GTS2F400.4794
C Meteorological Office GTS2F400.4795
C London Road GTS2F400.4796
C BRACKNELL GTS2F400.4797
C Berkshire UK GTS2F400.4798
C RG12 2SZ GTS2F400.4799
C GTS2F400.4800
C If no contract has been raised with this copy of the code, the use, GTS2F400.4801
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.4802
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.4803
C Modelling at the above address. GTS2F400.4804
C ******************************COPYRIGHT****************************** GTS2F400.4805
C GTS2F400.4806
CLL INITMEA1.3
CLL Subroutine: INITMEA1.4
CLL INITMEAN INITMEA1.5
CLL INITMEA1.6
CLL Purpose: INITMEA1.7
CLL To set up and check the input parameters for the INITMEA1.8
CLL meaning subroutines INITMEA1.9
CLL INITMEA1.10
CLL Tested under compiler: Tested under OS version: INITMEA1.11
CLL cft77 UNICOS 5.1 INITMEA1.12
CLL INITMEA1.13
CLL Model Modification history from model version 3.0: INITMEA1.14
CLL version date INITMEA1.15
CLL 3.2 13/07/93 Changed CHARACTER*(*) to CHARACTER*(80) for TS150793.87
CLL portability. Author Tracey Smith. TS150793.88
CLL 3.3 06/04/94 Loop over ALL dump fields in setting IBUFLEN. TJ300394.64
CLL Change I_AO to ISUBMODL. Author: Tim Johns. TJ300394.65
CLL 3.3 08/02/94 Modify calls to TIME2SEC/SEC2TIME to output/input TJ080294.199
CLL elapsed times in days & secs, for portability. TCJ TJ080294.200
CLL 3.4 17/06/94 Argument LCAL360 added and passed to GSS1F304.407
CLL S/R TIME2SEC GSS1F304.408
CLL S.J.Swarbrick GSS1F304.409
CLL 3.4 08/08/94 Correct misspelled TIM2STEP in EXTERNAL stmt. TCJ GTJ0F304.3
CLL 3.5 12/04/95 Sub-models stage 1: revise History and Control file GRB1F305.143
CLL contents. RTHBarnes. GRB1F305.144
CLL 4.1 17/04/96 Introduce wave sub-model. RTHBarnes. WRB1F401.526
!LL 4.5 11/09/98 Set OFFSET_DUMPS for slab model. K Rogers. GKR2F405.6
CLL INITMEA1.16
CLL Programming standard: INITMEA1.17
CLL UM Doc Paper 3 INITMEA1.18
CLL INITMEA1.19
CLL Logical system components covered: INITMEA1.20
CLL C5 INITMEA1.21
CLL INITMEA1.22
CLL Project tasks: INITMEA1.23
CLL C5 INITMEA1.24
CLL INITMEA1.25
CLL External documentation: INITMEA1.26
CLL On-line UM document C5 - Control of means calculations INITMEA1.27
CLL INITMEA1.28
C*L Interface and arguments: INITMEA1.29
SUBROUTINE INITMEAN ( 1,3@DYALLOC.2021
*CALL ARGSIZE 
@DYALLOC.2022
*CALL ARGDUMA @DYALLOC.2023
*CALL ARGDUMO @DYALLOC.2024
*CALL ARGDUMW WRB1F401.527
+ ISUBMODL,ICODE,CMESSAGE) GRB1F305.145
C INITMEA1.31
IMPLICIT NONE INITMEA1.32
@DYALLOC.2026
C*L Arguments @DYALLOC.2027
@DYALLOC.2028
*CALL TYPSIZE @DYALLOC.2029
*CALL TYPDUMA @DYALLOC.2030
*CALL TYPDUMO @DYALLOC.2031
*CALL TYPDUMW WRB1F401.528
@DYALLOC.2032
INTEGER INITMEA1.34
& ISUBMODL ! IN Submodel identifier (eg. atmos,ocean) TJ300394.67
& ,ICODE ! OUT return code; successful=0, error> 0 @DYALLOC.2034
C INITMEA1.37
CHARACTER*80 TS150793.89
& CMESSAGE ! OUT Error message if ICODE > 0 @DYALLOC.2035
@DYALLOC.2036
C INITMEA1.40
C Common blocks INITMEA1.41
C INITMEA1.42
*CALL CMAXSIZE GRB1F305.146
*CALL CSUBMODL GRB1F305.147
*CALL CHSUNITS GRB1F305.148
*CALL CTIME INITMEA1.44
*CALL CHISTORY INITMEA1.45
*CALL CCONTROL GRB1F305.149
*CALL CMEANCTL INITMEA1.46
*CALL CLOOKADD INITMEA1.47
C*L INITMEA1.48
C*L External subroutines called: INITMEA1.49
EXTERNAL TIME2SEC,TIM2STEP GTJ0F304.4
C INITMEA1.51
C Local variables and arrays INITMEA1.52
C INITMEA1.53
INTEGER INITMEA1.54
& IFIND,I, ! Loop counts INITMEA1.55
& NMEANS, ! No. of means chosen (fixed) INITMEA1.56
& MEAN_REFTIME_DAYS, ! Reference time for period means (D) TJ080294.202
& MEAN_REFTIME_SECS, ! Reference time for period means (s) INITMEA1.57
& MEAN_START_DAYS, ! Start time for model run (days) TJ080294.203
& MEAN_START_SECS, ! Start time for model run (s) INITMEA1.58
& MEAN_OFFSET_DAYS, ! Offset from mean ref. time (days) TJ080294.204
& MEAN_OFFSET_SECS, ! Offset from mean ref. time (s) INITMEA1.59
& MEAN_OFFSET_STEPS, ! Offset from mean ref. time (steps) TJ080294.205
& MEAN_FREQ_DUMPS, ! Mean frequency in dumps (updated) INITMEA1.60
& HOUR_SECS, ! No. of secs in an hour INITMEA1.61
& YEAR, ! Local variables for year, INITMEA1.62
& MONTH, ! month etc INITMEA1.63
& DAY, INITMEA1.64
& HOUR, INITMEA1.65
& MINUTE, INITMEA1.66
& SECOND INITMEA1.67
C INITMEA1.68
CMESSAGE=' ' INITMEA1.69
C INITMEA1.70
ICODE=0 INITMEA1.71
C INITMEA1.72
HOUR_SECS=3600 INITMEA1.73
C INITMEA1.74
C Define mode of use for means program INITMEA1.75
C INITMEA1.76
*IF DEF,ATMOS INITMEA1.77
IF(ISUBMODL.EQ.atmos_sm)THEN TJ300394.69
WRITE(6,*)'INITMEAN: ***** Called in ATMOSPHERIC mode *****' GIE0F403.317
ENDIF INITMEA1.80
*ENDIF INITMEA1.81
*IF DEF,OCEAN INITMEA1.82
IF(ISUBMODL.EQ.ocean_sm)THEN TJ300394.70
WRITE(6,*)'INITMEAN: ***** Called in OCEAN mode *****' GIE0F403.318
ENDIF WRB1F401.529
*ENDIF WRB1F401.530
*IF DEF,WAVE WRB1F401.531
IF(ISUBMODL.EQ.wave_sm)THEN WRB1F401.532
WRITE(6,*)'INITMEAN: ***** Called in WAVE mode *****' GIE0F403.319
WRITE(6,*)'INITMEAN: *** Code not yet written for WAVE model ***' GIE0F403.320
GO TO 999 WRB1F401.535
ENDIF INITMEA1.85
*ENDIF INITMEA1.86
C INITMEA1.87
C Check input parameters INITMEA1.88
C INITMEA1.89
NMEANS=0 INITMEA1.90
C INITMEA1.91
DO 20 IFIND=1,4 INITMEA1.92
*IF DEF,ATMOS INITMEA1.93
IF(ISUBMODL.EQ.atmos_sm)THEN TJ300394.71
IF(MEANFREQim(IFIND,atmos_sm).GT.0)THEN GRB1F305.150
NMEANS=NMEANS+1 INITMEA1.96
ENDIF INITMEA1.97
IF(MEANFREQim(IFIND,atmos_sm).EQ.1.OR. GRB1F305.151
& MEANFREQim(IFIND,atmos_sm).LT.0)THEN GRB1F305.152
ICODE=1 INITMEA1.99
CMESSAGE='INITMEAN: Invalid atmos mean frequency' INITMEA1.100
WRITE(6,*) 'INITMEAN: MEANFREQ(',IFIND,atmos_sm,') set to ', GIE0F403.321
& MEANFREQim(IFIND,atmos_sm) GRB1F305.154
GO TO 999 INITMEA1.103
ENDIF INITMEA1.104
ENDIF INITMEA1.105
*ENDIF INITMEA1.106
*IF DEF,OCEAN INITMEA1.107
IF(ISUBMODL.EQ.ocean_sm)THEN TJ300394.72
IF(MEANFREQim(IFIND,ocean_sm).GT.0)THEN GRB1F305.155
NMEANS=NMEANS+1 INITMEA1.110
ENDIF INITMEA1.111
IF(MEANFREQim(IFIND,ocean_sm).EQ.1.OR. GRB1F305.156
& MEANFREQim(IFIND,ocean_sm).LT.0)THEN GRB1F305.157
ICODE=2 INITMEA1.113
CMESSAGE='INITMEAN: Invalid ocean mean frequency' INITMEA1.114
WRITE(6,*) 'INITMEAN: MEANFREQ(',IFIND,ocean_sm,') set to ', GIE0F403.322
& MEANFREQim(IFIND,ocean_sm) GRB1F305.159
GO TO 999 INITMEA1.117
ENDIF INITMEA1.118
ENDIF INITMEA1.119
*ENDIF INITMEA1.120
20 CONTINUE INITMEA1.121
IF(ISUBMODL.EQ.atmos_sm .or. ISUBMODL.EQ.ocean_sm)THEN GRB1F305.160
MEAN_NUMBERim(ISUBMODL) = NMEANS GRB1F305.161
IF(MEAN_NUMBERim(ISUBMODL).EQ.0)THEN GRB1F305.162
ICODE=-1 INITMEA1.126
WRITE(6,*) 'INITMEAN: No means requested' GIE0F403.323
GO TO 999 INITMEA1.128
ENDIF INITMEA1.129
ENDIF INITMEA1.130
C INITMEA1.142
C If means are to be created: INITMEA1.143
C Establish whether an offset exists between the INITMEA1.144
C reference time for means creation and the start INITMEA1.145
C of the integration INITMEA1.146
C N.B. In the case of a restart, this check is ignored INITMEA1.147
C INITMEA1.148
IF(ISUBMODL.EQ.atmos_sm .or. ISUBMODL.EQ.ocean_sm)THEN GRB1F305.163
WRITE(6,*)' H_STEP=',H_STEPim(ISUBMODL) GIE0F403.324
IF(H_STEPim(ISUBMODL).EQ.0)THEN GRB1F305.165
C INITMEA1.153
YEAR=MEAN_REFTIMEim(1,ISUBMODL) GRB1F305.166
MONTH=MEAN_REFTIMEim(2,ISUBMODL) GRB1F305.167
DAY=MEAN_REFTIMEim(3,ISUBMODL) GRB1F305.168
HOUR=MEAN_REFTIMEim(4,ISUBMODL) GRB1F305.169
MINUTE=MEAN_REFTIMEim(5,ISUBMODL) GRB1F305.170
SECOND=MEAN_REFTIMEim(6,ISUBMODL) GRB1F305.171
C INITMEA1.160
IF(YEAR .EQ.0.AND. INITMEA1.161
& MONTH .EQ.0.AND. INITMEA1.162
& DAY .EQ.0.AND. INITMEA1.163
& HOUR .EQ.0.AND. INITMEA1.164
& MINUTE.EQ.0.AND. INITMEA1.165
& SECOND.EQ.0)THEN INITMEA1.166
C INITMEA1.167
MEAN_OFFSETim(ISUBMODL) = MEAN_NUMBERim(ISUBMODL) GRB1F305.172
WRITE(6,*)'INITMEAN: No offset specified for means creation' GIE0F403.325
C INITMEA1.170
ELSE INITMEA1.171
C INITMEA1.172
CALL TIME2SEC(YEAR,MONTH,DAY,HOUR,MINUTE,SECOND INITMEA1.173
& ,0,0,MEAN_REFTIME_DAYS,MEAN_REFTIME_SECS, GSS1F304.412
& LCAL360) GSS1F304.413
C INITMEA1.175
YEAR=MODEL_BASIS_TIME(1) INITMEA1.176
MONTH=MODEL_BASIS_TIME(2) INITMEA1.177
DAY=MODEL_BASIS_TIME(3) INITMEA1.178
HOUR=MODEL_BASIS_TIME(4) INITMEA1.179
MINUTE=MODEL_BASIS_TIME(5) INITMEA1.180
SECOND=MODEL_BASIS_TIME(6) INITMEA1.181
C INITMEA1.182
CALL TIME2SEC(YEAR,MONTH,DAY,HOUR,MINUTE,SECOND INITMEA1.183
& ,0,0,MEAN_START_DAYS,MEAN_START_SECS, GSS1F304.414
& LCAL360) GSS1F304.415
C INITMEA1.185
CALL TIM2STEP(MEAN_START_DAYS-MEAN_REFTIME_DAYS, TJ080294.208
& MEAN_START_SECS-MEAN_REFTIME_SECS, TJ080294.209
& STEPS_PER_PERIODim(ISUBMODL),SECS_PER_PERIODim(ISUBMODL), GRB1F305.173
& MEAN_OFFSET_STEPS) GRB1F305.174
OFFSET_DUMPSim(ISUBMODL) = MEAN_OFFSET_STEPS/ GRB1F305.175
& DUMPFREQim(ISUBMODL) GRB1F305.176
if (INTERNAL_MODEL_INDEX(slab_im) .ne. 0) then GKR2F405.7
! This is a slab model so offset_dumps needs to be set GKR2F405.8
! in addition to the submodel cases. GKR2F405.9
OFFSET_DUMPSim(slab_im) = MEAN_OFFSET_STEPS/ GKR2F405.10
& DUMPFREQim(atmos_sm) GKR2F405.11
endif GKR2F405.12
WRITE(6,*)'INITMEAN: Offset set up for means creation' GIE0F403.326
WRITE(6,*)' OFFSET_DUMPSim(ISUBMODL)=',OFFSET_DUMPSim(ISUBMODL) GIE0F403.327
MEAN_OFFSETim(ISUBMODL) = 0 GRB1F305.178
DO 40 I=1,MEAN_NUMBERim(ISUBMODL) GRB1F305.179
IF(I.EQ.1)THEN INITMEA1.193
MEAN_FREQ_DUMPS=MEANFREQim(I,ISUBMODL) GRB1F305.180
ELSE INITMEA1.195
MEAN_FREQ_DUMPS=MEAN_FREQ_DUMPS*MEANFREQim(I,ISUBMODL) GRB1F305.181
ENDIF INITMEA1.197
IF(MOD(OFFSET_DUMPSim(ISUBMODL),MEAN_FREQ_DUMPS).EQ.0)THEN GRB1F305.182
MEAN_OFFSETim(ISUBMODL) = MEAN_OFFSETim(ISUBMODL)+1 GRB1F305.183
ENDIF INITMEA1.256
40 CONTINUE INITMEA1.257
ENDIF INITMEA1.258
ENDIF INITMEA1.259
ENDIF INITMEA1.260
CL INITMEA1.262
CL Set IBUFLEN to the largest data field present in the dump INITMEA1.263
CL for dimensioning of IO buffers in ACUMPS and MEANPS. INITMEA1.264
CL INITMEA1.265
*IF DEF,ATMOS INITMEA1.266
IF (ISUBMODL.EQ.atmos_sm) THEN TJ300394.77
IBUFLEN(atmos_sm)=1 TJ300394.78
DO I=1,A_LEN2_LOOKUP TJ300394.79
IF (A_LOOKUP(LBLREC,I).GT.IBUFLEN(atmos_sm)) TJ300394.80
& IBUFLEN(atmos_sm)=A_LOOKUP(LBLREC,I) TJ300394.81
ENDDO INITMEA1.272
ENDIF INITMEA1.273
*ENDIF INITMEA1.274
*IF DEF,OCEAN INITMEA1.275
IF (ISUBMODL.EQ.ocean_sm) THEN TJ300394.82
IBUFLEN(ocean_sm)=1 TJ300394.83
DO I=1,O_LEN2_LOOKUP TJ300394.84
IF (O_LOOKUP(LBLREC,I).GT.IBUFLEN(ocean_sm)) TJ300394.85
& IBUFLEN(ocean_sm)=O_LOOKUP(LBLREC,I) TJ300394.86
ENDDO INITMEA1.281
ENDIF INITMEA1.282
*ENDIF INITMEA1.283
999 CONTINUE INITMEA1.284
RETURN INITMEA1.285
END INITMEA1.286
*ENDIF INITMEA1.287