SUBROUTINE MMPPINIT( 1,4MMPPCTL1.27
*CALL ARGSIZE 
MMPPCTL1.28
*CALL ARGD1 MMPPCTL1.29
*CALL ARGDUMA MMPPCTL1.30
*CALL ARGPTRA MMPPCTL1.31
*CALL ARGCONA MMPPCTL1.32
& ICODE,CMESSAGE) MMPPCTL1.33
MMPPCTL1.34
IMPLICIT NONE MMPPCTL1.35
MMPPCTL1.36
*CALL CMAXSIZE MMPPCTL1.37
*CALL TYPSIZE MMPPCTL1.38
*CALL TYPD1 MMPPCTL1.39
*CALL TYPDUMA MMPPCTL1.40
*CALL TYPPTRA MMPPCTL1.41
*CALL TYPCONA MMPPCTL1.42
MMPPCTL1.43
INTEGER MMPPCTL1.44
& ICODE ! Return code : 0 Normal Exit MMPPCTL1.45
C ! : >0 Error MMPPCTL1.46
MMPPCTL1.47
CHARACTER*(*) MMPPCTL1.48
& CMESSAGE ! Error message if return code >0 MMPPCTL1.49
MMPPCTL1.50
*CALL CSUBMODL MMPPCTL1.51
*CALL CHSUNITS MMPPCTL1.52
*CALL CCONTROL MMPPCTL1.53
*CALL CTIME MMPPCTL1.54
*CALL CPPRINT MMPPCTL1.55
MMPPCTL1.56
C External subroutines called MMPPCTL1.57
MMPPCTL1.58
EXTERNAL MMPPCTL1.59
& PRVXN, MMPPCTL1.60
& PPRINT_A, MMPPCTL1.61
& PPRINT_S, MMPPCTL1.62
& EQTOLL MMPPCTL1.63
MMPPCTL1.64
C Local Variables MMPPCTL1.65
MMPPCTL1.66
REAL MMPPCTL1.67
& PPRINT_LATT,PPRINT_LONGT MMPPCTL1.68
MMPPCTL1.69
ICODE=0 MMPPCTL1.70
CMESSAGE=' ' MMPPCTL1.71
MMPPCTL1.72
C Max/min and patch print diagnostics from top of ATM_STEP MMPPCTL1.73
IF(LPRVXN) THEN MMPPCTL1.74
LCLOUDP=.FALSE. MMPPCTL1.75
LRADP=.FALSE. MMPPCTL1.76
LTHETAP=.TRUE. MMPPCTL1.77
IF (STEPim(a_im).EQ.1) THEN GDR5F305.96
WRITE(6,*)' Check min/max initially' MMPPCTL1.79
CALL PRVXN(P_FIELD,U_FIELD,P_LEVELS,Q_LEVELS,D1(JTSTAR), MMPPCTL1.80
& D1(JPSTAR),D1(JP_EXNER(1)), MMPPCTL1.81
& D1(JTHETA(1)),D1(JU(1)),D1(JV(1)),D1(JQ(1)), MMPPCTL1.82
& D1(JQCL(1)),D1(JQCF(1)),DUMMY,LCLOUDP, MMPPCTL1.83
& DUMMY,AKH,BKH,LTHETAP,LMOISTP,LRADP, MMPPCTL1.84
& PRVXN_LEVEL,LPRVXNP) MMPPCTL1.85
ENDIF MMPPCTL1.86
ENDIF MMPPCTL1.87
MMPPCTL1.88
IF(LPPRINT) THEN MMPPCTL1.89
LRADP=.FALSE. MMPPCTL1.90
LCLOUDP=.FALSE. MMPPCTL1.91
LTHETAP=.TRUE. MMPPCTL1.92
MMPPCTL1.93
C set LGLOBALP,PPRINT_LAT,PPRINT_LONG from header info if 1st call MMPPCTL1.94
MMPPCTL1.95
IF (STEPim(a_im).LE.PPRINT_FIRST) THEN GDR5F305.97
LGLOBALP=A_FIXHD(4).EQ.0 MMPPCTL1.97
PPRINT_LAT=A_REALHD(3) - (INT((PPRINT_POINT-1)/ROW_LENGTH))* MMPPCTL1.98
& A_REALHD(2) MMPPCTL1.99
PPRINT_LONG=A_REALHD(4) + MMPPCTL1.100
& (MOD((PPRINT_POINT-1),ROW_LENGTH))*A_REALHD(1) MMPPCTL1.101
IF(PPRINT_LONG.GT.360.) PPRINT_LONG=PPRINT_LONG-360. MMPPCTL1.102
IF(.NOT.LGLOBALP) THEN MMPPCTL1.103
CALL EQTOLL(PPRINT_LAT,PPRINT_LONG,PPRINT_LATT,PPRINT_LONGT, MMPPCTL1.104
& A_REALHD(5),A_REALHD(6),1) MMPPCTL1.105
PPRINT_LAT=PPRINT_LATT MMPPCTL1.106
PPRINT_LONG=PPRINT_LONGT MMPPCTL1.107
ENDIF MMPPCTL1.108
ENDIF MMPPCTL1.109
IF (STEPim(a_im).EQ. 1) THEN GDR5F305.98
WRITE(6,*)' Check point values initially' MMPPCTL1.111
IF(LPPRINT_A) THEN MMPPCTL1.112
CALL PPRINT_A(P_FIELD,U_FIELD,P_LEVELS,Q_LEVELS, MMPPCTL1.113
& TR_VARS,TR_LEVELS,ROW_LENGTH,P_ROWS,U_ROWS, MMPPCTL1.114
& D1(JTSTAR),D1(JPSTAR),D1(JP_EXNER(1)), MMPPCTL1.115
& D1(JTHETA(1)),D1(JU(1)),D1(JV(1)),D1(JQ(1)), MMPPCTL1.116
& D1(JQCL(1)),D1(JQCF(1)), MMPPCTL1.117
& D1(JTRACER(1,1)),D1(JCCA(1)),D1(JCCB),D1(JCCT), AJX0F404.520
& D1(JCCLWP),DUMMY,DUMMY,LCLOUDP, MMPPCTL1.119
& PPRINT_POINT,PPRINT_LAT,PPRINT_LONG, MMPPCTL1.120
& PPRINT_TOL,LVPRINT,LHPRINT,LTHETAP,LRADP,LGLOBALP, MMPPCTL1.121
& A_LEVDEPC(JAK),A_LEVDEPC(JBK),AKH,BKH,N_CCA_LEV) AJX0F404.521
ENDIF MMPPCTL1.123
C MMPPCTL1.124
IF(LPPRINT_S) THEN MMPPCTL1.125
CALL PPRINT_S(P_FIELD,LAND_FIELD, AJS1F401.1567
& ST_LEVELS,SM_LEVELS,ROW_LENGTH,P_ROWS, GDR6F405.230
& D1(JTSTAR),D1(JPSTAR), MMPPCTL1.128
& D1(J_DEEP_SOIL_TEMP(1)),D1(JSMC),D1(JCANOPY_WATER), MMPPCTL1.129
& D1(JSNODEP),D1(JZH),D1(JZ0),D1(JLAND),LAND_LIST, MMPPCTL1.130
& D1(JICE_FRACTION),D1(JICE_THICKNESS),D1(JVOL_SMC_WILT), GDR6F405.231
& D1(JVOL_SMC_CRIT),D1(JVOL_SMC_FCAP),D1(JVOL_SMC_SAT), GDR6F405.232
& D1(JSAT_SOIL_COND),D1(JEAGLE_EXP),D1(JTHERM_CAP), GDR6F405.233
& D1(JTHERM_COND),D1(JCLAPP_HORN), GDR6F405.234
& D1(JVEG_FRAC),D1(JROOT_DEPTH),D1(JSFA),D1(JMDSA), GDR6F405.235
& D1(JSURF_RESIST),D1(JSURF_CAP),D1(JINFILT),D1(JOROG), GDR6F405.236
& D1(JOROG_SD),DUMMY, MMPPCTL1.133
& PPRINT_POINT,PPRINT_LAT,PPRINT_LONG, MMPPCTL1.134
& PPRINT_TOL,LRADP,LGLOBALP,LSINGLE_HYDROL,LMOSES) GDR6F405.237
ENDIF MMPPCTL1.136
ENDIF MMPPCTL1.137
ENDIF MMPPCTL1.138
MMPPCTL1.139
RETURN MMPPCTL1.140
END MMPPCTL1.141
MMPPCTL1.142
*ENDIF MMPPCTL1.143
MMPPCTL1.144
*IF DEF,CONTROL,AND,DEF,ATMOS MMPPCTL1.145
CLL Subroutine MMPP_CTL ----------------------------------------------- MMPPCTL1.146
CLL MMPPCTL1.147
CLL Purpose : Prints max/min values, patches and other diagnostics MMPPCTL1.148
CLL under control of various logicals. MMPPCTL1.149
CLL Called from ATM_STEP at end of timestep. MMPPCTL1.150
CLL MMPPCTL1.151
CLL Level 2 control routine MMPPCTL1.152
CLL Version for CRAY YMP MMPPCTL1.153
CLL MMPPCTL1.154
CLL Model Modification history: MMPPCTL1.155
CLL version Date MMPPCTL1.156
CLL 3.2 17/06/93 New control interfacing routine required because MMPPCTL1.157
CLL of dynamic allocation changes. R.T.H.Barnes. MMPPCTL1.158
CLL 4.4 10/11/97 Updated to allow for convective cloud on model AJX0F404.522
CLL levels. Julie Gregory AJX0F404.523
CLL 4.4 28/08/97 Field increment diagnostics I/O changed from ARR0F404.24
CLL Fortran to C to free a unit no. R.Rawlins ARR0F404.25
CLL 4.5 19/01/98 Pass individual soil and veg fields to PPRINT_S. GDR6F405.238
CLL Remove SOIL_VARS and VEG_VARS. D. Robinson. GDR6F405.239
CLL MMPPCTL1.159
CLL Programming standard : unified model documentation paper No 3 MMPPCTL1.160
CLL MMPPCTL1.161
CLL System components covered : MMPPCTL1.162
CLL MMPPCTL1.163
CLL System task : Point print diagnostics MMPPCTL1.164
CLL MMPPCTL1.165
CLL Documentation : Unified model documentation paper no. MMPPCTL1.166
CLL MMPPCTL1.167
CLLEND ----------------------------------------------------------------- MMPPCTL1.168
C*L Arguments MMPPCTL1.169
SUBROUTINE MMPP_CTL( 1,4MMPPCTL1.170
*CALL ARGSIZE MMPPCTL1.171
*CALL ARGD1 MMPPCTL1.172
*CALL ARGDUMA MMPPCTL1.173
*CALL ARGPTRA MMPPCTL1.174
*CALL ARGCONA MMPPCTL1.175
& ICODE,CMESSAGE) MMPPCTL1.176
MMPPCTL1.177
IMPLICIT NONE MMPPCTL1.178
MMPPCTL1.179
*CALL CMAXSIZE MMPPCTL1.180
*CALL TYPSIZE MMPPCTL1.181
*CALL TYPD1 MMPPCTL1.182
*CALL TYPDUMA MMPPCTL1.183
*CALL TYPPTRA MMPPCTL1.184
*CALL TYPCONA MMPPCTL1.185
MMPPCTL1.186
INTEGER MMPPCTL1.187
& ICODE ! Return code : 0 Normal Exit MMPPCTL1.188
C ! : >0 Error MMPPCTL1.189
MMPPCTL1.190
CHARACTER*(*) MMPPCTL1.191
& CMESSAGE ! Error message if return code >0 MMPPCTL1.192
MMPPCTL1.193
*CALL CSUBMODL MMPPCTL1.194
*CALL CHSUNITS MMPPCTL1.195
*CALL CCONTROL MMPPCTL1.196
*CALL CTIME MMPPCTL1.197
*CALL CPPRINT MMPPCTL1.198
MMPPCTL1.199
C External subroutines called MMPPCTL1.200
MMPPCTL1.201
EXTERNAL MMPPCTL1.202
& PRVXN, MMPPCTL1.203
& PPRINT_A, MMPPCTL1.204
& PPRINT_S, MMPPCTL1.205
& EQTOLL MMPPCTL1.206
MMPPCTL1.207
C Local Variables MMPPCTL1.208
MMPPCTL1.209
REAL MMPPCTL1.210
& PPRINT_LATT,PPRINT_LONGT MMPPCTL1.211
MMPPCTL1.212
ICODE=0 MMPPCTL1.213
CMESSAGE=' ' MMPPCTL1.214
MMPPCTL1.215
C Max/min and patch print diagnostics from top of ATM_STEP MMPPCTL1.216
IF(LPRVXN) THEN MMPPCTL1.217
LCLOUDP=.FALSE. MMPPCTL1.218
LRADP=.FALSE. MMPPCTL1.219
LTHETAP=.TRUE. MMPPCTL1.220
IF(MOD(STEPim(a_im)-PRVXN_FIRST,PRVXN_STEP).EQ.0 .AND. GDR5F305.99
& STEPim(a_im).GE.PRVXN_FIRST .AND. GDR5F305.100
& (PRVXN_LAST.LE.0 .OR. STEPim(a_im).LE.PRVXN_LAST)) THEN GDR5F305.101
WRITE(6,*)' Check min/max at end of atm_step' MMPPCTL1.224
CALL PRVXN(P_FIELD,U_FIELD,P_LEVELS,Q_LEVELS,D1(JTSTAR), MMPPCTL1.225
& D1(JPSTAR),D1(JP_EXNER(1)), MMPPCTL1.226
& D1(JTHETA(1)),D1(JU(1)),D1(JV(1)),D1(JQ(1)), MMPPCTL1.227
& D1(JQCL(1)),D1(JQCF(1)),DUMMY,LCLOUDP, MMPPCTL1.228
& DUMMY,AKH,BKH,LTHETAP,LMOISTP,LRADP, MMPPCTL1.229
& PRVXN_LEVEL,LPRVXNP) MMPPCTL1.230
ENDIF MMPPCTL1.231
ENDIF MMPPCTL1.232
MMPPCTL1.233
IF(LPPRINT) THEN MMPPCTL1.234
LRADP=.FALSE. MMPPCTL1.235
LCLOUDP=.FALSE. MMPPCTL1.236
LTHETAP=.TRUE. MMPPCTL1.237
MMPPCTL1.238
IF(MOD(STEPim(a_im)-PPRINT_FIRST,PPRINT_STEP).EQ.0.AND. GDR5F305.102
& STEPim(a_im).GE.PPRINT_FIRST .AND. GDR5F305.103
& (PPRINT_LAST.LE.0 .OR. STEPim(a_im).LE.PPRINT_LAST)) THEN GDR5F305.104
WRITE(6,*)' Check point values at end of atm_step' MMPPCTL1.242
IF(LPPRINT_A) THEN MMPPCTL1.243
CALL PPRINT_A(P_FIELD,U_FIELD,P_LEVELS,Q_LEVELS, MMPPCTL1.244
& TR_VARS,TR_LEVELS,ROW_LENGTH,P_ROWS,U_ROWS, MMPPCTL1.245
& D1(JTSTAR),D1(JPSTAR),D1(JP_EXNER(1)), MMPPCTL1.246
& D1(JTHETA(1)),D1(JU(1)),D1(JV(1)),D1(JQ(1)), MMPPCTL1.247
& D1(JQCL(1)),D1(JQCF(1)), MMPPCTL1.248
& D1(JTRACER(1,1)),D1(JCCA(1)),D1(JCCB),D1(JCCT), AJX0F404.524
& D1(JCCLWP),DUMMY,DUMMY,LCLOUDP, MMPPCTL1.250
& PPRINT_POINT,PPRINT_LAT,PPRINT_LONG, MMPPCTL1.251
& PPRINT_TOL,LVPRINT,LHPRINT,LTHETAP,LRADP,LGLOBALP, MMPPCTL1.252
& A_LEVDEPC(JAK),A_LEVDEPC(JBK),AKH,BKH,N_CCA_LEV) AJX0F404.525
ENDIF MMPPCTL1.254
C MMPPCTL1.255
IF(LPPRINT_S) THEN MMPPCTL1.256
CALL PPRINT_S(P_FIELD,LAND_FIELD, AJS1F401.1569
& ST_LEVELS,SM_LEVELS,ROW_LENGTH,P_ROWS, GDR6F405.240
& D1(JTSTAR),D1(JPSTAR), MMPPCTL1.259
& D1(J_DEEP_SOIL_TEMP(1)),D1(JSMC),D1(JCANOPY_WATER), MMPPCTL1.260
& D1(JSNODEP),D1(JZH),D1(JZ0),D1(JLAND),LAND_LIST, MMPPCTL1.261
& D1(JICE_FRACTION),D1(JICE_THICKNESS),D1(JVOL_SMC_WILT), GDR6F405.241
& D1(JVOL_SMC_CRIT),D1(JVOL_SMC_FCAP),D1(JVOL_SMC_SAT), GDR6F405.242
& D1(JSAT_SOIL_COND),D1(JEAGLE_EXP),D1(JTHERM_CAP), GDR6F405.243
& D1(JTHERM_COND),D1(JCLAPP_HORN), GDR6F405.244
& D1(JVEG_FRAC),D1(JROOT_DEPTH),D1(JSFA),D1(JMDSA), GDR6F405.245
& D1(JSURF_RESIST),D1(JSURF_CAP),D1(JINFILT),D1(JOROG), GDR6F405.246
& D1(JOROG_SD),DUMMY, MMPPCTL1.264
& PPRINT_POINT,PPRINT_LAT,PPRINT_LONG, MMPPCTL1.265
& PPRINT_TOL,LRADP,LGLOBALP,LSINGLE_HYDROL,LMOSES) GDR6F405.247
ENDIF MMPPCTL1.267
ENDIF MMPPCTL1.268
ENDIF MMPPCTL1.269
C Max/min and patch print diagnostics from end of ATM_STEP MMPPCTL1.270
MMPPCTL1.271
MMPPCTL1.272
CL MMPPCTL1.273
CL GET STATS OF MAX/MIN/MEAN OF FIELDS AND CHANGES SINCE LAST STEP MMPPCTL1.274
CL MMPPCTL1.275
IF(LPRFLD) THEN MMPPCTL1.276
LTHETAP=.TRUE. MMPPCTL1.277
IF (STEPim(a_im).LE.PRFLD_LAST .AND. GDR5F305.105
& STEPim(a_im).GE.PRFLD_FIRST-1) THEN GDR5F305.106
IF(MOD(STEPim(a_im)-PRFLD_FIRST,PRFLD_STEP).EQ.0) THEN GDR5F305.107
WRITE(6,*) ' Field max/min increments at end of timestep' MMPPCTL1.280
WRITE(6,*) ' -increments over ',PRFLD_STEP,' timesteps' MMPPCTL1.281
ENDIF MMPPCTL1.282
CALL FLDSTAT(P_LEVELS,Q_LEVELS,ROW_LENGTH,P_ROWS, MMPPCTL1.283
+ P_FIELD,U_FIELD,STEPim(a_im), GDR5F305.108
+ A_LEVDEPC(JAK),A_LEVDEPC(JBK),AKH,BKH, MMPPCTL1.285
+ D1(JP_EXNER(1)),D1(JPSTAR),D1(JTHETA(1)),D1(JQ(1)), MMPPCTL1.286
+ D1(JU(1)),D1(JV(1)), MMPPCTL1.287
& LTHETAP,PRFLD_STEP,PRFLD_FIRST,PRFLD_LAST,NDEV_FLD, ARR0F404.26
& LEN_FLD_FILENAME,FLD_FILENAME) ARR0F404.27
ENDIF MMPPCTL1.289
ENDIF MMPPCTL1.290
MMPPCTL1.291
RETURN MMPPCTL1.292
END MMPPCTL1.293
MMPPCTL1.294
*ENDIF MMPPCTL1.295