*IF DEF,CONTROL,AND,DEF,ATMOS ST_MEAN1.2
C ******************************COPYRIGHT****************************** GTS2F400.9865
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.9866
C GTS2F400.9867
C Use, duplication or disclosure of this code is subject to the GTS2F400.9868
C restrictions as set forth in the contract. GTS2F400.9869
C GTS2F400.9870
C Meteorological Office GTS2F400.9871
C London Road GTS2F400.9872
C BRACKNELL GTS2F400.9873
C Berkshire UK GTS2F400.9874
C RG12 2SZ GTS2F400.9875
C GTS2F400.9876
C If no contract has been raised with this copy of the code, the use, GTS2F400.9877
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.9878
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.9879
C Modelling at the above address. GTS2F400.9880
C ******************************COPYRIGHT****************************** GTS2F400.9881
C GTS2F400.9882
CLL Routine: ST_MEAN -------------------------------------------------- ST_MEAN1.3
CLL ST_MEAN1.4
CLL Purpose: Extracts derived diagnostics from climate mean data in the ST_MEAN1.5
CLL D1 array, using the special mean diagnostic sections 21-24 ST_MEAN1.6
CLL to define the required diagnostics. ST_MEAN1.7
CLL Designed to be called from within the means subroutine. ST_MEAN1.8
CLL This routine is closely modelled on routines ST_DIAG1 and ST_MEAN1.9
CLL ST_DIAG2, but here the functionality is merged into a ST_MEAN1.10
CLL single routine, although using the same underlying PCRs ST_MEAN1.11
CLL DYN_DIAG and PHY_DIAG. ST_MEAN1.12
CLL ST_MEAN1.13
CLL Author: T C Johns ST_MEAN1.14
CLL ST_MEAN1.15
CLL Tested under compiler: cft77 ST_MEAN1.16
CLL Tested under OS version: UNICOS 5.1 ST_MEAN1.17
CLL ST_MEAN1.18
CLL Model Modification history from model version 3.0: ST_MEAN1.19
CLL version Date ST_MEAN1.20
CLL 3.1 9/02/93 : added comdeck CHSUNITS to define NUNITS for RS030293.233
CLL comdeck CCONTROL. RS030293.234
CLL 3.1 14/01/93 Include dummy code for added pv diagnostics. MC110693.1
CLL 3.2 11/06/93 Include dummy code for added test diagnostics. MC110693.2
CLL 3.2 13/07/93 Changed CHARACTER*(*) to CHARACTER*(80) for TS150793.192
CLL portability. Author Tracey Smith. TS150793.193
CLL 3.3 24/09/93 : added NUM_STASH_LEVELSDA and P_FIELDDA to NF171193.56
CLL argument list for portable dyanmic arrays. NF171193.57
CLL Author : Paul Burton NF171193.58
CLL 3.4 26/05/94 LOGICAL LLINTS passed to DYN_DIAG GSS1F304.209
CLL S.J.Swarbrick GSS1F304.210
CLL 3.5 10/04/95 Sub-model changes : Timestep length removed ADR1F305.222
CLL from Atmos Dump Header. D. Robinson. ADR1F305.223
CLL 4.1 04/06/96 Correct errors in argument list for PHY_DIAG and ADP0F401.124
CLL add dummy code for tracer diagnostics. ADP0F401.125
CLL Author : Darren Podd ADP0F401.126
!LL 4.4 10/04/97 : Added to arguement list for DYN_DIAG R A Stratton ARS1F404.325
!LL 30/07/97 : Further additions to list. ARS1F404.326
!LL 19/08/97 : Further additions to list. ARS1F404.327
!LL 4.4 09/09/97 Remove hard-wired variable LEVNO_ABOVE_BOUNDARY GDR3F404.6
!LL with LEVNO_PMSL_CALC. D. Robinson. GDR3F404.7
!LL 4.5 21/04/97 Pass ARGFLDPT to DYN_DIAG,PHY_DIAG and initialise GSM1F405.471
!LL STASHWORK array. S.D.Mullerworth GSM1F405.472
!LL 4.5 05/06/98 New arguments L_VINT_TP, L_LSPICE for PHY_DIAG. GDR4F405.6
!LL D. Robinson GDR4F405.7
CLL ST_MEAN1.21
CLL Programming standard: UM Doc Paper 3, version 2 (7/9/90) ST_MEAN1.22
CLL ST_MEAN1.23
CLL Logical components covered: D55 ST_MEAN1.24
CLL ST_MEAN1.25
CLL Project task: D4 ST_MEAN1.26
CLL ST_MEAN1.27
CLL External documentation: ST_MEAN1.28
CLL UM Doc Paper C0 - The top-level control system ST_MEAN1.29
CLL ST_MEAN1.30
CLLEND------------------------------------------------------------------ ST_MEAN1.31
C*L Interface and arguments: ------------------------------------------ ST_MEAN1.32
C ST_MEAN1.33
SUBROUTINE ST_MEAN ( 1,9@DYALLOC.3333
*CALL ARGSIZE
@DYALLOC.3334
*CALL ARGD1
@DYALLOC.3335
*CALL ARGDUMA
@DYALLOC.3336
*CALL ARGDUMO
@DYALLOC.3337
*CALL ARGDUMW
GKR1F401.272
*CALL ARGSTS
@DYALLOC.3338
*CALL ARGPTRA
@DYALLOC.3339
*CALL ARGPTRO
@DYALLOC.3340
*CALL ARGCONA
@DYALLOC.3341
*CALL ARGPPX
GKR0F305.1000
*CALL ARGFLDPT
GSM1F405.473
& SN,INTMEAN, NF171193.59
& NUM_STASH_LEVELSDA, P_FIELDDA, NF171193.60
& ICODE,CMESSAGE) NF171193.61
C ST_MEAN1.36
IMPLICIT NONE ST_MEAN1.37
@DYALLOC.3343
*CALL CMAXSIZE
@DYALLOC.3344
*CALL CSUBMODL
GSS1F305.941
*CALL TYPSIZE
@DYALLOC.3345
*CALL TYPD1
@DYALLOC.3346
*CALL TYPDUMA
@DYALLOC.3347
*CALL TYPDUMO
@DYALLOC.3348
*CALL TYPDUMW
GKR1F401.273
*CALL TYPSTS
@DYALLOC.3349
*CALL TYPPTRA
@DYALLOC.3350
*CALL TYPPTRO
@DYALLOC.3351
*CALL TYPCONA
@DYALLOC.3352
*CALL TYPFLDPT
GSM1F405.474
*CALL PPXLOOK
GKR0F305.1001
@DYALLOC.3353
@DYALLOC.3354
INTEGER @DYALLOC.3355
* SN ! IN - Section number for mean diagnostics @DYALLOC.3356
* ,INTMEAN ! IN - Size of STASHWORK array @DYALLOC.3357
* ,NUM_STASH_LEVELSDA ! IN - Copy of NUM_STASH_LEVELS NF171193.62
* ,P_FIELDDA ! IN - Copy of P_FIELD NF171193.63
NF171193.64
* ,ICODE ! OUT - Return code from routine @DYALLOC.3358
@DYALLOC.3359
CHARACTER*(80) CMESSAGE ! OUT - Return message if failure occurred TS150793.194
C ST_MEAN1.43
C*---------------------------------------------------------------------- ST_MEAN1.44
C Common blocks ST_MEAN1.45
C ST_MEAN1.46
*CALL CHSUNITS
RS030293.235
*CALL CCONTROL
ST_MEAN1.51
*CALL CPHYSCON
ST_MEAN1.52
*CALL CTIME
ADR1F305.224
*CALL C_ETA_PMSL
GDR3F404.8
C @DYALLOC.3360
C Subroutines called ST_MEAN1.54
C ST_MEAN1.55
EXTERNAL DYN_DIAG,PHY_DIAG,STASH,TIMER ST_MEAN1.56
C ST_MEAN1.57
C Dynamically allocated workspace for STASH processing ST_MEAN1.58
C ST_MEAN1.59
REAL STASHWORK(INTMEAN) ST_MEAN1.60
ST_MEAN1.61
C Pressures for DYN_DIAG ST_MEAN1.62
REAL ST_MEAN1.63
* UCOMP_PRESS(NUM_STASH_LEVELSDA) NF171193.65
* ,VCOMP_PRESS(NUM_STASH_LEVELSDA) NF171193.66
* ,CAT_PROB_PRESS(NUM_STASH_LEVELSDA) NF171193.67
& ,PV_THETA(NUM_STASH_LEVELSDA) ! requested theta levels NF171193.68
& ! for pv. MM180193.144
& ,PV_PRESS(NUM_STASH_LEVELSDA) ! requested p levels NF171193.69
& ,THETA_ON_PV(NUM_STASH_LEVELSDA) ! requested pv levels NF171193.70
* ,T_PRESS(NUM_STASH_LEVELSDA) NF171193.71
* ,W_PRESS(NUM_STASH_LEVELSDA) NF171193.72
* ,Q_PRESS(NUM_STASH_LEVELSDA) NF171193.73
& ,HEAVY_PRESS(NUM_STASH_LEVELSDA) ARS1F404.328
& ,Z_PRESS(NUM_STASH_LEVELSDA) ARS1F404.329
* ,DUMMY_LEVELS(NUM_STASH_LEVELSDA) NF171193.74
ST_MEAN1.71
C Dummy array for DYN_DIAG ST_MEAN1.72
REAL ST_MEAN1.73
* PSTAR_OLD(P_FIELDDA) NF171193.75
ST_MEAN1.75
C Dummy arguments for DYN_DIAG MC110693.4
INTEGER IDUMMY MC110693.5
MC110693.6
C Pressures for PHY_DIAG ST_MEAN1.76
REAL ST_MEAN1.77
* T_P_PRESS(NUM_STASH_LEVELSDA) NF171193.76
* ,HTS_PRESS(NUM_STASH_LEVELSDA) NF171193.77
* ,Q_P_PRESS(NUM_STASH_LEVELSDA) NF171193.78
* ,WBPT_PRESS(NUM_STASH_LEVELSDA) NF171193.79
* ,TH_ADV_PRESS(NUM_STASH_LEVELSDA) NF171193.80
* ,DUMMY_TR_PRESS(TR_VARS+1,NUM_STASH_LEVELSDA) ADP0F401.127
C Trig functions ST_MEAN1.83
REAL ST_MEAN1.84
* NMOST_LAT, ST_MEAN1.85
* WMOST_LONG, ST_MEAN1.86
* EW_SPACE, ST_MEAN1.87
* NS_SPACE, ST_MEAN1.88
* PHI_POLE, ST_MEAN1.89
* LAMBDA_POLE, ST_MEAN1.90
* LAT_STEP_INVERSE, ST_MEAN1.91
* LONG_STEP_INVERSE ST_MEAN1.92
C ST_MEAN1.93
C Local variables ST_MEAN1.94
C ST_MEAN1.95
INTEGER ST_MEAN1.96
* I,K, ST_MEAN1.97
* ISL, ST_MEAN1.98
* NI, ST_MEAN1.99
* LEVEL, ST_MEAN1.100
* UCOMP_P_LEVS, ST_MEAN1.101
* VCOMP_P_LEVS, ST_MEAN1.102
* CAT_PROB_LEVS, ST_MEAN1.103
& PV_THETA_LEVS, MM180193.147
& PV_PRESS_LEVS, MM180193.148
& THETA_ON_PV_LEVS, MM180193.149
& DUMMY_TR_LEVS(TR_VARS+1), ADP0F401.128
& TR_P_FIELD_DA, ! Dummy size for DA of tracer fields ADP0F401.129
& n_levels, TD141293.98
* UV_P_LEVS,TWIND_LEVS,UT_P_LEVS,VT_P_LEVS,T2_P_LEVS, ST_MEAN1.105
* U2_P_LEVS,V2_P_LEVS,OMEGA_LEVS,WT_P_LEVS,WU_P_LEVS, ST_MEAN1.106
* WV_P_LEVS,SPHUM_LEVS,QU_P_LEVS,QV_P_LEVS,QW_P_LEVS, ARS1F404.330
* T_P_LEVS, ST_MEAN1.108
* HTS_LEVS,H2_P_LEVS, ST_MEAN1.109
* Q_P_LEVS, ST_MEAN1.110
* WBPT_LEVS, ST_MEAN1.111
* TH_ADV_P_LEVS, ST_MEAN1.112
* TESTD_P_LEVS,TESTD_M_LEVS MC110693.8
& ,HEAVY_P_LEVS,Z_P_LEVS,UZ_P_LEVS,VZ_P_LEVS ARS1F404.331
& ,im_ident ! Internal Model Identifier GDR4F305.261
& ,im_index ! Internal Model Index for stash arrays GDR4F305.262
INTEGER ST_MEAN1.114
* PT201,PT202,PT203,PT204,PT205,PT206,PT207,PT208,PT209, ST_MEAN1.115
* PT210,PT211,PT212,PT213,PT214,PT215,PT216,PT217,PT218,PT219, ST_MEAN1.116
* PT220,PT221,PT222,PT223,PT224,PT225,PT226,PT227,PT228,PT229 ST_MEAN1.117
C Dummy 1 element arrays for indices ST_MEAN1.118
INTEGER ST_MEAN1.119
* UV_IND,UT_IND,VT_IND,T2_IND,U2_IND,V2_IND,WT_IND,Wu_IND, ST_MEAN1.120
* WV_IND,QU_IND,QV_IND,QW_IND,H2_IND,UZ_IND,VZ_IND ARS1F404.332
ST_MEAN1.122
LOGICAL ROTATE_UV,ROTATE_MAX_UV ST_MEAN1.123
& ,SF_TRACER(TR_VARS+1) ADP0F401.130
C ST_MEAN1.124
C NB: mean P_EXNER has been calculated in MEANCTL1 ST_MEAN1.125
C ST_MEAN1.126
! Set to atmosphere internal model GDR4F305.263
im_ident = atmos_im GDR4F305.264
im_index = internal_model_index(im_ident) GDR4F305.265
GDR4F305.266
! DYN_DIAG and PHY_DIAG do not initialise MPP halos GSM1F405.475
!* DIR$ CACHE_BYPASS STASHWORK GSM1F405.476
DO I=1,INTMEAN GSM1F405.477
STASHWORK(I)=0. GSM1F405.478
ENDDO GSM1F405.479
GSM1F405.480
CL---------------------------------------------------------------------- ST_MEAN1.127
CL 2. Set up levels and pointer information for call to DYN_DIAG ST_MEAN1.128
CL NOTE: Item nos differ from section 15. ST_MEAN1.129
CL ST_MEAN1.130
ISL=STINDEX(1,201,SN,im_index) GDR4F305.267
IF(ISL.GT.0) THEN ST_MEAN1.132
IF(STLIST(10,ISL).LT.0) THEN ST_MEAN1.133
IF(STLIST(11,ISL).EQ.2) THEN ST_MEAN1.134
NI=-STLIST(10,ISL) ST_MEAN1.135
UCOMP_P_LEVS=STASH_LEVELS(1,NI) ST_MEAN1.136
DO K=1,UCOMP_P_LEVS ST_MEAN1.137
UCOMP_PRESS(K)=STASH_LEVELS(K+1,NI)/1000.0 ST_MEAN1.138
ENDDO ST_MEAN1.139
ELSE ST_MEAN1.140
ICODE=1 ST_MEAN1.141
CMESSAGE='ST_MEAN : STASH_LEVELS not pressure for U_COMP' ST_MEAN1.142
GOTO 999 ST_MEAN1.143
ENDIF ST_MEAN1.144
ELSE ST_MEAN1.145
CMESSAGE='ST_MEAN : STASH_LEVELS not a LEVEL list for U_COMP' ST_MEAN1.146
ICODE=1 ST_MEAN1.147
GOTO 999 ST_MEAN1.148
END IF ST_MEAN1.149
ELSE ST_MEAN1.150
UCOMP_P_LEVS=1 ST_MEAN1.151
END IF ST_MEAN1.152
ST_MEAN1.153
ISL=STINDEX(1,202,SN,im_index) GDR4F305.268
IF(ISL.GT.0) THEN ST_MEAN1.155
IF(STLIST(10,ISL).LT.0) THEN ST_MEAN1.156
IF(STLIST(11,ISL).EQ.2) THEN ST_MEAN1.157
NI=-STLIST(10,ISL) ST_MEAN1.158
VCOMP_P_LEVS=STASH_LEVELS(1,NI) ST_MEAN1.159
DO K=1,VCOMP_P_LEVS ST_MEAN1.160
VCOMP_PRESS(K)=STASH_LEVELS(K+1,NI)/1000.0 ST_MEAN1.161
ENDDO ST_MEAN1.162
ELSE ST_MEAN1.163
ICODE=1 ST_MEAN1.164
CMESSAGE='ST_MEAN : STASH_LEVELS not pressure for V_COMP' ST_MEAN1.165
GOTO 999 ST_MEAN1.166
ENDIF ST_MEAN1.167
ELSE ST_MEAN1.168
CMESSAGE='ST_MEAN : STASH_LEVELS not a LEVEL list for V_COMP' ST_MEAN1.169
ICODE=1 ST_MEAN1.170
GOTO 999 ST_MEAN1.171
END IF ST_MEAN1.172
ELSE ST_MEAN1.173
VCOMP_P_LEVS=1 ST_MEAN1.174
END IF ST_MEAN1.175
ST_MEAN1.176
ISL=STINDEX(1,205,SN,im_index) GDR4F305.269
IF(ISL.GT.0) THEN ST_MEAN1.178
IF(STLIST(10,ISL).LT.0) THEN ST_MEAN1.179
IF(STLIST(11,ISL).EQ.2) THEN ST_MEAN1.180
NI=-STLIST(10,ISL) ST_MEAN1.181
CAT_PROB_LEVS=STASH_LEVELS(1,NI) ST_MEAN1.182
DO K=1,CAT_PROB_LEVS ST_MEAN1.183
CAT_PROB_PRESS(K)=STASH_LEVELS(K+1,NI)/1000.0 ST_MEAN1.184
ENDDO ST_MEAN1.185
ELSE ST_MEAN1.186
ICODE=1 ST_MEAN1.187
CMESSAGE='ST_MEAN : STASH_LEVELS not pressure for CATPROB' ST_MEAN1.188
GOTO 999 ST_MEAN1.189
ENDIF ST_MEAN1.190
ELSE ST_MEAN1.191
CMESSAGE='ST_MEAN : STASH_LEVELS not a LEVEL list for CATPROB' ST_MEAN1.192
ICODE=1 ST_MEAN1.193
GOTO 999 ST_MEAN1.194
END IF ST_MEAN1.195
ELSE ST_MEAN1.196
CAT_PROB_LEVS=1 ST_MEAN1.197
END IF ST_MEAN1.198
C Set level numbers to 1 for diagnostics not available from 21-24 ST_MEAN1.199
PV_THETA_LEVS = 1 ST_MEAN1.200
PV_PRESS_LEVS = 1 MM180193.150
THETA_ON_PV_LEVS = 1 MM180193.151
UV_P_LEVS=1 ST_MEAN1.201
UT_P_LEVS=1 ST_MEAN1.202
VT_P_LEVS=1 ST_MEAN1.203
WT_P_LEVS=1 ST_MEAN1.204
WU_P_LEVS=1 ST_MEAN1.205
WV_P_LEVS=1 ST_MEAN1.206
T2_P_LEVS=1 ST_MEAN1.207
U2_P_LEVS=1 ST_MEAN1.208
V2_P_LEVS=1 ST_MEAN1.209
QU_P_LEVS=1 ST_MEAN1.210
QV_P_LEVS=1 ST_MEAN1.211
QW_P_LEVS=1 ARS1F404.333
TWIND_LEVS=1 ST_MEAN1.212
OMEGA_LEVS=1 ST_MEAN1.213
SPHUM_LEVS=1 ST_MEAN1.214
TESTD_P_LEVS=1 MC110693.9
TESTD_M_LEVS=1 MC110693.10
HEAVY_P_LEVS=1 ARS1F404.334
Z_P_LEVS=1 ARS1F404.335
UZ_P_LEVS=1 ARS1F404.336
VZ_P_LEVS=1 ARS1F404.337
ARS1F404.338
ST_MEAN1.215
PT201=SI(201,SN,im_index) GDR4F305.270
PT202=SI(202,SN,im_index) GDR4F305.271
PT205=SI(205,SN,im_index) GDR4F305.272
PT206=SI(206,SN,im_index) GDR4F305.273
PT207=SI(207,SN,im_index) GDR4F305.274
PT208=SI(208,SN,im_index) GDR4F305.275
PT209=SI(209,SN,im_index) GDR4F305.276
ST_MEAN1.223
CL---------------------------------------------------------------------- ST_MEAN1.224
CL 3. Call DYN_DIAG for section SN diagnostics ST_MEAN1.225
CL ST_MEAN1.226
C Set flags to control wind rotation according to whether ELF grid ST_MEAN1.227
IF(A_FIXHD(4).EQ.3.OR.A_FIXHD(4).EQ.103) THEN ! ELF Grid ST_MEAN1.228
ROTATE_UV=.TRUE. ST_MEAN1.229
ROTATE_MAX_UV=.TRUE. ST_MEAN1.230
ELSE ST_MEAN1.231
ROTATE_UV=.FALSE. ST_MEAN1.232
ROTATE_MAX_UV=.FALSE. ST_MEAN1.233
ENDIF ST_MEAN1.234
NMOST_LAT=A_REALHD(3) ST_MEAN1.235
WMOST_LONG=A_REALHD(4) ST_MEAN1.236
NS_SPACE=A_REALHD(2) ST_MEAN1.237
EW_SPACE=A_REALHD(1) ST_MEAN1.238
PHI_POLE=A_REALHD(5) ST_MEAN1.239
LAMBDA_POLE=A_REALHD(6) ST_MEAN1.240
n_levels=p_levels-1 TD141293.100
IF (LTIMER) CALL TIMER
('DYN_DIAG',3) GSM1F405.481
ST_MEAN1.242
CALL DYN_DIAG
( ST_MEAN1.243
*CALL ARGFLDPT
GSM1F405.482
C Primary data in ST_MEAN1.244
& D1(JPSTAR),D1(JU(1)),D1(JV(1)), ST_MEAN1.245
& D1(JQ(1)),D1(JTHETA(1)),D1(JOROG),D1(JP_EXNER(1)),PSTAR_OLD, ST_MEAN1.246
ST_MEAN1.247
C Primary data constants ST_MEAN1.248
ST_MEAN1.249
& U_ROWS,P_ROWS,ROW_LENGTH,P_LEVELS,Q_LEVELS,P_FIELD,U_FIELD, ST_MEAN1.250
& A_LEVDEPC(JAK),A_LEVDEPC(JBK),AKH,BKH,A_LEVDEPC(JDELTA_AK), ST_MEAN1.251
& A_LEVDEPC(JDELTA_BK),NMOST_LAT,WMOST_LONG,NS_SPACE,EW_SPACE, ST_MEAN1.252
& PHI_POLE,LAMBDA_POLE,SEC_U_LATITUDE, MC110693.11
& ROTATE_UV,ROTATE_MAX_UV,ELF, MC110693.12
& ETA_MATRIX_INV,MATRIX_POLY_ORDER,LAT_STEP_INVERSE, ST_MEAN1.254
& LONG_STEP_INVERSE,SECS_PER_STEPim(atmos_im),SEC_P_LATITUDE, ADR1F305.225
& COS_U_LATITUDE,F3,IDUMMY, ADR1F305.226
ST_MEAN1.257
C Required level lists & dummy indices MC110693.14
ST_MEAN1.259
& PV_THETA,PV_PRESS,THETA_ON_PV,REQ_THETA_PV_LEVS, MM180193.152
& n_levels, TD141293.99
& UCOMP_PRESS,VCOMP_PRESS,CAT_PROB_PRESS,T_PRESS,W_PRESS, ST_MEAN1.261
& Q_PRESS,DUMMY_LEVELS,HEAVY_PRESS,Z_PRESS,DUMMY_LEVELS, ARS1F404.339
MC110693.16
C Dummy indices MC110693.17
MC110693.18
& UV_IND,UT_IND,VT_IND,T2_IND,U2_IND,V2_IND,WT_IND, MC110693.19
& WU_IND,WV_IND,QU_IND,QV_IND,QW_IND,UZ_IND,VZ_IND, ARS1F404.340
ST_MEAN1.264
C DIAGNOSTICS OUT ST_MEAN1.265
ST_MEAN1.266
& STASHWORK(PT201),STASHWORK(PT202),STASHWORK ,STASHWORK, ST_MEAN1.267
& STASHWORK(PT205),STASHWORK(PT206),STASHWORK,STASHWORK(PT207), ST_MEAN1.268
& STASHWORK(PT208),STASHWORK(PT209),STASHWORK ,STASHWORK, ST_MEAN1.269
& STASHWORK,STASHWORK,STASHWORK,STASHWORK,STASHWORK,STASHWORK, ST_MEAN1.270
& STASHWORK,STASHWORK,STASHWORK,STASHWORK,STASHWORK,STASHWORK, ST_MEAN1.271
& STASHWORK,STASHWORK,STASHWORK,STASHWORK,STASHWORK,STASHWORK, MM180193.153
& STASHWORK,STASHWORK,STASHWORK,STASHWORK, MC110693.20
& STASHWORK,STASHWORK,STASHWORK,STASHWORK,STASHWORK,STASHWORK, ARS1F404.341
& STASHWORK, ARS1F404.342
ST_MEAN1.273
C Diagnostic length ST_MEAN1.274
ST_MEAN1.275
& UCOMP_P_LEVS,VCOMP_P_LEVS,CAT_PROB_LEVS,PV_THETA_LEVS, ST_MEAN1.276
& PV_PRESS_LEVS,THETA_ON_PV_LEVS,THETA_PV_P_LEVS, MM180193.154
& UV_P_LEVS,TWIND_LEVS, ST_MEAN1.277
& UT_P_LEVS,VT_P_LEVS,T2_P_LEVS,U2_P_LEVS,V2_P_LEVS,OMEGA_LEVS, ST_MEAN1.278
& WT_P_LEVS,Wu_P_LEVS,WV_P_LEVS,SPHUM_LEVS,QU_P_LEVS,QV_P_LEVS, ST_MEAN1.279
& TESTD_P_LEVS,TESTD_M_LEVS, MC110693.21
& QW_P_LEVS,HEAVY_P_LEVS,Z_P_LEVS,UZ_P_LEVS,VZ_P_LEVS, ARS1F404.343
ST_MEAN1.280
C Diagnostic logical indicators ST_MEAN1.281
ST_MEAN1.282
& SF(201,SN),SF(202,SN),.FALSE.,.FALSE.,SF(205,SN),SF(206,SN), ST_MEAN1.283
& .FALSE.,SF(207,SN),SF(208,SN),SF(209,SN),.FALSE.,.FALSE., ST_MEAN1.284
& .FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE., ST_MEAN1.285
& .FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE., ST_MEAN1.286
& .FALSE.,.FALSE., MM180193.155
& .FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE., ARS1F404.344
& .FALSE.,.FALSE.,.FALSE.,.FALSE., MC110693.22
& LEVNO_PMSL_CALC, GDR3F404.9
C Diagnostic return code and message ST_MEAN1.288
ST_MEAN1.289
& ICODE,CMESSAGE, GSS1F304.211
GSS1F304.212
C Logical switch LLINTS - for linear TS calc GSS1F304.213
GSS1F304.214
& LLINTS) GSS1F304.215
ST_MEAN1.291
IF (LTIMER) CALL TIMER
('DYN_DIAG',4) ST_MEAN1.292
CL---------------------------------------------------------------------- ST_MEAN1.293
CL 5. Set up levels and pointer information for call to PHY_DIAG ST_MEAN1.294
CL NOTE: Item nos differ from section 16. ST_MEAN1.295
CL ST_MEAN1.296
ISL=STINDEX(1,212,SN,im_index) GDR4F305.277
IF(ISL.GT.0) THEN ST_MEAN1.298
IF(STLIST(10,ISL).LT.0) THEN ST_MEAN1.299
IF(STLIST(11,ISL).EQ.2) THEN ST_MEAN1.300
NI=-STLIST(10,ISL) ST_MEAN1.301
T_P_LEVS=STASH_LEVELS(1,NI) ST_MEAN1.302
DO K=1,T_P_LEVS ST_MEAN1.303
T_P_PRESS(K)=STASH_LEVELS(K+1,NI)/1000.0 ST_MEAN1.304
ENDDO ST_MEAN1.305
ELSE ST_MEAN1.306
ICODE=1 ST_MEAN1.307
CMESSAGE='ST_MEAN : STASH_LEVELS not pressure for T_P ' ST_MEAN1.308
GOTO 999 ST_MEAN1.309
ENDIF ST_MEAN1.310
ELSE ST_MEAN1.311
CMESSAGE='ST_MEAN : STASH_LEVELS not a LEVEL list for T_P ' ST_MEAN1.312
ICODE=1 ST_MEAN1.313
GOTO 999 ST_MEAN1.314
END IF ST_MEAN1.315
ELSE ST_MEAN1.316
T_P_LEVS=1 ST_MEAN1.317
END IF ST_MEAN1.318
ST_MEAN1.319
ISL=STINDEX(1,211,SN,im_index) GDR4F305.278
IF(ISL.GT.0) THEN ST_MEAN1.321
IF(STLIST(10,ISL).LT.0) THEN ST_MEAN1.322
IF(STLIST(11,ISL).EQ.2) THEN ST_MEAN1.323
NI=-STLIST(10,ISL) ST_MEAN1.324
HTS_LEVS=STASH_LEVELS(1,NI) ST_MEAN1.325
DO K=1,HTS_LEVS ST_MEAN1.326
HTS_PRESS(K)=STASH_LEVELS(K+1,NI)/1000.0 ST_MEAN1.327
ENDDO ST_MEAN1.328
ELSE ST_MEAN1.329
ICODE=1 ST_MEAN1.330
CMESSAGE='ST_MEAN : STASH_LEVELS not pressure for HTS ' ST_MEAN1.331
GOTO 999 ST_MEAN1.332
ENDIF ST_MEAN1.333
ELSE ST_MEAN1.334
CMESSAGE='ST_MEAN : STASH_LEVELS not a LEVEL list for HTS ' ST_MEAN1.335
ICODE=1 ST_MEAN1.336
GOTO 999 ST_MEAN1.337
END IF ST_MEAN1.338
ELSE ST_MEAN1.339
HTS_LEVS=1 ST_MEAN1.340
END IF ST_MEAN1.341
ST_MEAN1.342
ISL=STINDEX(1,213,SN,im_index) GDR4F305.279
IF(ISL.GT.0) THEN ST_MEAN1.344
IF(STLIST(10,ISL).LT.0) THEN ST_MEAN1.345
IF(STLIST(11,ISL).EQ.2) THEN ST_MEAN1.346
NI=-STLIST(10,ISL) ST_MEAN1.347
Q_P_LEVS=STASH_LEVELS(1,NI) ST_MEAN1.348
DO K=1,Q_P_LEVS ST_MEAN1.349
Q_P_PRESS(K)=STASH_LEVELS(K+1,NI)/1000.0 ST_MEAN1.350
ENDDO ST_MEAN1.351
ELSE ST_MEAN1.352
ICODE=1 ST_MEAN1.353
CMESSAGE='ST_MEAN : STASH_LEVELS not pressure for Q_P ' ST_MEAN1.354
GOTO 999 ST_MEAN1.355
ENDIF ST_MEAN1.356
ELSE ST_MEAN1.357
CMESSAGE='ST_MEAN : STASH_LEVELS not a LEVEL list for Q_P ' ST_MEAN1.358
ICODE=1 ST_MEAN1.359
GOTO 999 ST_MEAN1.360
END IF ST_MEAN1.361
ELSE ST_MEAN1.362
Q_P_LEVS=1 ST_MEAN1.363
END IF ST_MEAN1.364
ST_MEAN1.365
ISL=STINDEX(1,214,SN,im_index) GDR4F305.280
IF(ISL.GT.0) THEN ST_MEAN1.367
IF(STLIST(10,ISL).LT.0) THEN ST_MEAN1.368
IF(STLIST(11,ISL).EQ.2) THEN ST_MEAN1.369
NI=-STLIST(10,ISL) ST_MEAN1.370
WBPT_LEVS=STASH_LEVELS(1,NI) ST_MEAN1.371
DO K=1,WBPT_LEVS ST_MEAN1.372
WBPT_PRESS(K)=STASH_LEVELS(K+1,NI)/1000.0 ST_MEAN1.373
ENDDO ST_MEAN1.374
ELSE ST_MEAN1.375
ICODE=1 ST_MEAN1.376
CMESSAGE='ST_MEAN : STASH_LEVELS not pressure for WBPT ' ST_MEAN1.377
GOTO 999 ST_MEAN1.378
ENDIF ST_MEAN1.379
ELSE ST_MEAN1.380
CMESSAGE='ST_MEAN : STASH_LEVELS not a LEVEL list for WBPT ' ST_MEAN1.381
ICODE=1 ST_MEAN1.382
GOTO 999 ST_MEAN1.383
END IF ST_MEAN1.384
ELSE ST_MEAN1.385
WBPT_LEVS=1 ST_MEAN1.386
END IF ST_MEAN1.387
ST_MEAN1.388
H2_P_LEVS=1 ST_MEAN1.389
ST_MEAN1.390
DO K=1,TR_VARS+1 ADP0F401.131
SF_TRACER(K)=.FALSE. ! Set tracer logical indicators to false ADP0F401.132
ENDDO ADP0F401.133
ADP0F401.134
TR_P_FIELD_DA=1 ! Set size for tracer arrays to 1 ADP0F401.135
C ADP0F401.136
IF(SF(211,SN)) THEN ST_MEAN1.391
SF(210,SN)=.TRUE. !making sure model half heights switched ST_MEAN1.392
ENDIF !on if heights on pressure surface is reqd ST_MEAN1.393
ST_MEAN1.394
PT211=SI(211,SN,im_index) GDR4F305.281
PT212=SI(212,SN,im_index) GDR4F305.282
PT213=SI(213,SN,im_index) GDR4F305.283
PT214=SI(214,SN,im_index) GDR4F305.284
PT215=SI(215,SN,im_index) GDR4F305.285
PT216=SI(216,SN,im_index) GDR4F305.286
PT217=SI(217,SN,im_index) GDR4F305.287
PT218=SI(218,SN,im_index) GDR4F305.288
PT219=SI(219,SN,im_index) GDR4F305.289
PT220=SI(220,SN,im_index) GDR4F305.290
PT224=SI(224,SN,im_index) GDR4F305.291
ST_MEAN1.407
CL---------------------------------------------------------------------- ST_MEAN1.408
CL 6. Call PHY_DIAG for section SN diagnostics ST_MEAN1.409
CL ST_MEAN1.410
IF (LTIMER) CALL TIMER
('PHY_DIAG',3) ST_MEAN1.411
ST_MEAN1.412
CALL PHY_DIAG
( ST_MEAN1.413
*CALL ARGFLDPT
GSM1F405.483
C Primary data in ST_MEAN1.415
ST_MEAN1.416
& D1(JPSTAR),D1(JU(1)),D1(JV(1)),D1(JQ(1)), ST_MEAN1.417
& D1(JTHETA(1)),D1(JOROG),D1(JP_EXNER(1)),D1(JLAND),D1(JTSTAR), @DYALLOC.3362
& D1(JTRACER(1,1)), ADP0F401.137
ST_MEAN1.419
C Primary data constants ST_MEAN1.420
ST_MEAN1.421
& U_ROWS,P_ROWS,ROW_LENGTH,P_LEVELS,Q_LEVELS,P_FIELD, ST_MEAN1.422
& U_FIELD,A_LEVDEPC(JAK),A_LEVDEPC(JBK),AKH,BKH, ST_MEAN1.423
& EW_SPACE,NS_SPACE,SEC_U_LATITUDE, ST_MEAN1.424
& TR_LEVELS,TR_VARS,TR_P_FIELD_DA, ADP0F401.138
ST_MEAN1.425
C Required pressures ST_MEAN1.426
ST_MEAN1.427
& T_P_PRESS,HTS_PRESS,Q_P_PRESS,WBPT_PRESS,TH_ADV_PRESS, ST_MEAN1.428
& DUMMY_TR_PRESS, ADP0F401.139
& H2_IND, ST_MEAN1.429
ST_MEAN1.430
C DIAGNOSTICS OUT ST_MEAN1.431
ST_MEAN1.432
& STASHWORK(PT211),STASHWORK(PT212),STASHWORK(PT213), ST_MEAN1.433
& STASHWORK(PT214),STASHWORK(PT215),STASHWORK , ST_MEAN1.434
& STASHWORK ,STASHWORK ,STASHWORK(PT216), ST_MEAN1.435
& STASHWORK(PT217),STASHWORK ,STASHWORK , ST_MEAN1.436
& STASHWORK(PT218),STASHWORK(PT219),STASHWORK(PT220), ST_MEAN1.437
& STASHWORK ,STASHWORK ,STASHWORK , ST_MEAN1.438
& STASHWORK ,STASHWORK ,STASHWORK(PT224), ST_MEAN1.439
& STASHWORK ,STASHWORK ,STASHWORK , ADP0F401.140
& STASHWORK ,INTMEAN ,STASHWORK , ADP0F401.141
ST_MEAN1.441
C Diagnostic lengths ST_MEAN1.442
ST_MEAN1.443
& T_P_LEVS,HTS_LEVS,Q_P_LEVS,WBPT_LEVS,TH_ADV_P_LEVS,H2_P_LEVS, ST_MEAN1.444
& DUMMY_TR_LEVS,NUM_STASH_LEVELSDA, ADP0F401.142
ST_MEAN1.445
C Diagnostic logical indicators ST_MEAN1.446
ST_MEAN1.447
& SF(210,SN),SF(211,SN),SF(212,SN),SF(213,SN),SF(214,SN), ST_MEAN1.448
& SF(215,SN),.FALSE.,.FALSE.,.FALSE.,SF(216,SN),SF(217,SN), ST_MEAN1.449
& .FALSE.,.FALSE.,SF(218,SN),SF(219,SN),SF(220,SN),.FALSE., ST_MEAN1.450
& .FALSE.,.FALSE.,.FALSE.,.FALSE.,SF(224,SN),.FALSE., ST_MEAN1.451
& .FALSE.,.FALSE.,SF_TRACER, ADP0F401.143
ADP0F401.144
ST_MEAN1.452
& LEVNO_PMSL_CALC, L_VINT_TP, L_LSPICE, GDR4F405.8
& ICODE, CMESSAGE) GDR4F405.9
ST_MEAN1.454
IF (LTIMER) CALL TIMER
('PHY_DIAG',4) ST_MEAN1.455
CL---------------------------------------------------------------------- ST_MEAN1.456
CL 7. Call STASH to perform processing for merged DYN_DIAG/PHY_DIAG ST_MEAN1.457
CL diagnostics for mean section SN ST_MEAN1.458
CL ST_MEAN1.459
IF (LTIMER) CALL TIMER
('STASH ',3) ST_MEAN1.460
ST_MEAN1.461
CALL STASH
(a_sm,a_im,SN,STASHWORK, GKR0F305.1002
*CALL ARGSIZE
@DYALLOC.3364
*CALL ARGD1
@DYALLOC.3365
*CALL ARGDUMA
@DYALLOC.3366
*CALL ARGDUMO
@DYALLOC.3367
*CALL ARGDUMW
GKR1F401.274
*CALL ARGSTS
@DYALLOC.3368
*CALL ARGPPX
GKR0F305.1003
* ICODE,CMESSAGE) @DYALLOC.3372
ST_MEAN1.463
IF (LTIMER) CALL TIMER
('STASH ',4) ST_MEAN1.464
999 CONTINUE ST_MEAN1.465
RETURN ST_MEAN1.466
CL---------------------------------------------------------------------- ST_MEAN1.467
END ST_MEAN1.468
*ENDIF ST_MEAN1.469