SUBROUTINE PPRINT_A(P_POINTS,U_POINTS,LEVELS,Q_LEVELS, 2,10PPRINT1.39
+ TR_VARS,TR_LEVELS,ROW_LENGTH,P_ROWS,U_ROWS,TSTAR, PPRINT1.40
+ PSTAR,EXNER,THETA,U,V,Q,QCL,QCF,TRACER,CCA,CCB,CCT,CCLWP, PPRINT1.41
+ RADINCS,CLOUD,LCLOUDP, PPRINT1.42
+ KPOINT,RLAT,RLONG,KTOL,LVPRINT,LHPRINT,LTHETA,LRADP, PPRINT1.43
+ LGLOBALP,AK,BK,AKH,BKH,N_CCA_LEV) AJX0F404.528
PPRINT1.45
PPRINT1.46
IMPLICIT NONE PPRINT1.47
PPRINT1.48
INTEGER PPRINT1.49
* P_POINTS !IN 1ST DIMENSION OF FIELDS ON P-grid PPRINT1.50
*, U_POINTS !IN 1ST DIMENSION OF FIELDS ON U-grid PPRINT1.51
*, P_ROWS !IN NUMBER OF ROWS of P-grid PPRINT1.52
*, U_ROWS !IN NUMBER OF ROWS of U-grid PPRINT1.53
*, LEVELS !IN NUMBER OF MODEL LEVELS PPRINT1.54
*, Q_LEVELS !IN NUMBER OF moist LEVELS PPRINT1.55
*, TR_VARS !IN number of tracers PPRINT1.56
*, TR_LEVELS !IN number of tracer levels PPRINT1.57
*, ROW_LENGTH !IN number of points in row PPRINT1.58
&, N_CCA_LEV !IN number of convective cloud levels AJX0F404.529
C PPRINT1.59
INTEGER PPRINT1.60
* KPOINT !IN point number in field PPRINT1.61
*, KTOL !IN tolerance for points printed around PPRINT1.62
C ! central point PPRINT1.63
C PPRINT1.64
REAL RLAT !IN latitude of central point PPRINT1.65
REAL RLONG !IN longitude of central point PPRINT1.66
REAL PSTAR(P_POINTS) !IN surface pressure field PPRINT1.67
REAL TSTAR(P_POINTS) !IN surface temperature field PPRINT1.68
REAL EXNER(P_POINTS,LEVELS+1) !IN exner function PPRINT1.69
REAL THETA (P_POINTS,LEVELS) !IN atmospheric (potential) temps PPRINT1.70
REAL U (U_POINTS,LEVELS) !IN U-component wind PPRINT1.71
REAL V (U_POINTS,LEVELS) !IN V-component wind PPRINT1.72
REAL Q (P_POINTS,Q_LEVELS) !IN specific humidity PPRINT1.73
REAL QCL (P_POINTS,Q_LEVELS) !IN cloud liquid water PPRINT1.74
REAL QCF (P_POINTS,Q_LEVELS) !IN cloud frozen water PPRINT1.75
REAL CLOUD (P_POINTS,Q_LEVELS) !IN cloud amounts PPRINT1.76
REAL CCA (P_POINTS,N_CCA_LEV) !IN convective cloud amounts AJX0F404.530
REAL CCLWP(P_POINTS) !IN convective cloud liquid water PPRINT1.78
REAL RADINCS (P_POINTS,0:LEVELS) !IN radiative heating rates PPRINT1.79
REAL TRACER (P_POINTS,TR_LEVELS,TR_VARS) !IN tracers PPRINT1.80
INTEGER CCT (P_POINTS) !IN convective cloud top PPRINT1.81
INTEGER CCB (P_POINTS) !IN convective cloud base PPRINT1.82
C PPRINT1.83
PPRINT1.84
C AK,BK DEFINE HYBRID VERTICAL COORDINATES P=A+BP*, PPRINT1.85
REAL PPRINT1.86
* AK (LEVELS) !IN Hybrid Coords. A and B values PPRINT1.87
*,BK (LEVELS) !IN for model full levels. PPRINT1.88
*,AKH(LEVELS+1) !IN Hybrid Coords. A and B values PPRINT1.89
*,BKH(LEVELS+1) !IN for model half levels. PPRINT1.90
LOGICAL PPRINT1.91
* LVPRINT !IN vertical format print switch PPRINT1.92
*,LHPRINT !IN horizontal format print switch PPRINT1.93
*,LTHETA !IN if true THETA contains potential temp PPRINT1.94
C ! if false THETA contains temperature PPRINT1.95
*,LRADP !IN true to print radiation array PPRINT1.96
*,LCLOUDP !IN true to print cloud array PPRINT1.97
*,LGLOBALP !IN true for global model else LAM PPRINT1.98
C*--------------------------------------------------------------------- PPRINT1.99
PPRINT1.100
C*L WORKSPACE USAGE:------------------------------------------------- PPRINT1.101
C DEFINE LOCAL WORKSPACE ARRAYS: PPRINT1.102
C PPRINT1.103
REAL TEMP (-KTOL:KTOL)!array for calculating temperatures PPRINT1.110
INTEGER INDEX(-KTOL-1:KTOL) ! index for patch points to cope PPRINT1.111
& !with start/end of rows PPRINT1.112
REAL QS(5,Q_LEVELS) ! saturated humidities PPRINT1.113
C*--------------------------------------------------------------------- PPRINT1.115
C PPRINT1.116
C*L EXTERNAL SUBROUTINES CALLED--------------------------------------- PPRINT1.117
EXTERNAL QSAT PPRINT1.118
C*------------------------------------------------------------------ PPRINT1.119
C DEFINE LOCAL VARIABLES PPRINT1.120
INTEGER IL1, IL2 !bottom and top level limits PPRINT1.121
INTEGER JL,JP !loop indices for levels,points PPRINT1.122
INTEGER IL !loop index for row PPRINT1.123
INTEGER JTR !tracer loop index PPRINT1.124
INTEGER IROW,IPOINT !row and point no in row PPRINT1.125
INTEGER KP,KPW,KPE,KPN,KPS,KUSE,KUSW,KUNE,KUNW !pointers for PPRINT1.126
& !cross prints PPRINT1.127
REAL Z, ZW, ZE, ZN, ZS !local stores PPRINT1.128
REAL P_EXNER_FULL ! Exner pressure at full model level PPRINT1.129
REAL PJLP1,PJL ! Pressures at half levels JL+1 and JL PPRINT1.130
REAL RH(5),P ! relative humidity and Pressure PPRINT1.131
REAL PPRINT1.132
* KTOLWN,KTOLWS,KTOLWW,KTOLWE !tolerances for winds PPRINT1.133
C PPRINT1.134
PPRINT1.135
*CALL C_R_CP 
PPRINT1.136
*CALL P_EXNERC PPRINT1.137
PPRINT1.138
C------------------------------------------------------------------- PPRINT1.139
CL INTERNAL STRUCTURE INCLUDING SUBROUTINE CALLS: PPRINT1.140
CL 0. INITIALISATION PPRINT1.141
C-------------------------- PPRINT1.142
PPRINT1.143
C------------------------------------------------------------------ PPRINT1.144
CL 0.1 set row and point values and pointers PPRINT1.145
C------------------------------------------------------------------ PPRINT1.146
PPRINT1.147
IROW=(KPOINT+ROW_LENGTH-1)/ROW_LENGTH PPRINT1.148
KTOLWN=1 PPRINT1.149
KTOLWS=0 PPRINT1.150
KTOLWW=1 PPRINT1.151
KTOLWE=0 PPRINT1.152
PPRINT1.153
C Alter chosen point by one row if polar point is selected PPRINT1.154
IF(IROW.EQ.1) THEN PPRINT1.155
KPOINT=KPOINT+ROW_LENGTH PPRINT1.156
IROW=2 PPRINT1.157
KTOL=1 PPRINT1.158
KTOLWN=0 PPRINT1.159
WRITE(6,*)' PPRINT_A == POLAR/BOUNDARY POINT CHOSEN - CENTRE POINT GIE0F403.504
&IS ONE ROW TO THE SOUTH, AND TOLERANCE SET TO 1' PPRINT1.161
ENDIF PPRINT1.162
PPRINT1.163
IF(IROW.EQ.P_ROWS) THEN PPRINT1.164
KPOINT=KPOINT-ROW_LENGTH PPRINT1.165
IROW=P_ROWS-1 PPRINT1.166
KTOL=1 PPRINT1.167
KTOLWS=-1 PPRINT1.168
WRITE(6,*)' PPRINT_A == POLAR/BOUNDARY POINT CHOSEN - CENTRE POINT GIE0F403.505
&IS ONE ROW TO THE NORTH, AND TOLERANCE SET TO 1' PPRINT1.170
ENDIF PPRINT1.171
PPRINT1.172
C Alter tolerance if too close to polar/boundary rows PPRINT1.173
IF((IROW-KTOL).LT.1) THEN PPRINT1.174
KTOL=IROW-1 PPRINT1.175
KTOLWN=0 PPRINT1.176
WRITE(6,*)' PPRINT_A == Too close to boundary for tolerance chosen GIE0F403.506
&- tolerance reset to ',KTOL PPRINT1.178
ENDIF PPRINT1.179
IF((IROW-KTOL).EQ.1) KTOLWN=0 PPRINT1.180
PPRINT1.181
IF((IROW+KTOL).GT.P_ROWS) THEN PPRINT1.182
KTOL=P_ROWS-IROW PPRINT1.183
KTOLWS=-1 PPRINT1.184
WRITE(6,*)' PPRINT_A == Too close to boundary for tolerance chosen GIE0F403.507
&- tolerance reset to ',KTOL PPRINT1.186
ENDIF PPRINT1.187
IF((IROW+KTOL).EQ.P_ROWS) KTOLWS=-1 PPRINT1.188
PPRINT1.189
C find point no in row PPRINT1.190
IPOINT=KPOINT-ROW_LENGTH*(IROW-1) PPRINT1.191
PPRINT1.192
IF(.NOT.LGLOBALP ) THEN PPRINT1.193
IF(IPOINT.EQ.1) THEN PPRINT1.194
KPOINT=KPOINT+1 PPRINT1.195
IPOINT=2 PPRINT1.196
KTOL=1 PPRINT1.197
KTOLWW=0 PPRINT1.198
WRITE(6,*)' PPRINT_A == BOUNDARY POINT CHOSEN -CENTRE POINT IS ONE GIE0F403.508
&POINT TO THE EAST, AND TOLERANCE SET TO 1' PPRINT1.200
ENDIF PPRINT1.201
PPRINT1.202
IF(IPOINT.EQ.ROW_LENGTH) THEN PPRINT1.203
KPOINT=KPOINT-1 PPRINT1.204
IPOINT=ROW_LENGTH-1 PPRINT1.205
KTOL=1 PPRINT1.206
KTOLWE=-1 PPRINT1.207
WRITE(6,*)' PPRINT_A == BOUNDARY POINT CHOSEN -CENTRE POINT IS ONE GIE0F403.509
&POINT TO THE WEST, AND TOLERANCE SET TO 1' PPRINT1.209
ENDIF PPRINT1.210
PPRINT1.211
C Alter tolerance if too close to EW boundary points PPRINT1.212
PPRINT1.213
IF((IPOINT-KTOL).LT.1) THEN PPRINT1.214
KTOL=IPOINT-1 PPRINT1.215
KTOLWW=0 PPRINT1.216
WRITE(6,*)' PPRINT_A == Too close to boundary for tolerance chosen GIE0F403.510
&- tolerance reset to ',KTOL PPRINT1.218
ENDIF PPRINT1.219
IF((IPOINT-KTOL).EQ.1) KTOLWW=0 PPRINT1.220
PPRINT1.221
IF((IPOINT+KTOL).GT.ROW_LENGTH) THEN PPRINT1.222
KTOL=ROW_LENGTH-IPOINT PPRINT1.223
KTOLWE=-1 PPRINT1.224
WRITE(6,*)' PPRINT_A == Too close to boundary for tolerance chosen GIE0F403.511
&- tolerance reset to ',KTOL PPRINT1.226
ENDIF PPRINT1.227
IF((IPOINT+KTOL).EQ.ROW_LENGTH) KTOLWE=-1 PPRINT1.228
PPRINT1.229
ENDIF ! .NOT.LGLOBALP PPRINT1.230
PPRINT1.231
KP=KPOINT PPRINT1.232
KPW=KPOINT-1 PPRINT1.233
KPE=KPOINT+1 PPRINT1.234
KPN=KPOINT-ROW_LENGTH PPRINT1.235
KPS=KPOINT+ROW_LENGTH PPRINT1.236
KUSE=KPOINT PPRINT1.237
KUSW=KPW PPRINT1.238
KUNE=KPN PPRINT1.239
KUNW=KPN-1 PPRINT1.240
C------------------------------------------------------------------ PPRINT1.241
CL 0.1.1 correct for start and end of rows if GLOBAL PPRINT1.242
C------------------------------------------------------------------ PPRINT1.243
IF(IPOINT.EQ.1.AND.LGLOBALP ) THEN PPRINT1.244
KPW=KPW+ROW_LENGTH PPRINT1.245
KUNW=KUNW+ROW_LENGTH PPRINT1.246
KUSW=KUSW+ROW_LENGTH PPRINT1.247
ENDIF PPRINT1.248
IF(IPOINT.EQ.ROW_LENGTH.AND.LGLOBALP) THEN PPRINT1.249
KPE=KPE-ROW_LENGTH PPRINT1.250
KUNE=KUNE-ROW_LENGTH PPRINT1.251
KUSE=KUSE-ROW_LENGTH PPRINT1.252
ENDIF PPRINT1.253
C PPRINT1.254
IL1=1 PPRINT1.255
IL2=LEVELS PPRINT1.256
C PPRINT1.257
C------------------------------------------------------------------ PPRINT1.258
CL 1.0 P* / Exner PPRINT1.259
C------------------------------------------------------------------ PPRINT1.260
C PPRINT1.261
IF(LVPRINT) THEN PPRINT1.262
C PPRINT1.263
PRINT 101,KPOINT,IROW,IPOINT, RLAT,RLONG PPRINT1.264
101 FORMAT(1X,'Current values around p_point no= ',I6,', row=',I4, GPB0F405.134
+ ' point=',I4,' latitude=',F7.1,' longitude=',F7.1,/ PPRINT1.266
+ ' FIELD LEVEL CENTRAL WEST EAST NORTH SOUT PPRINT1.267
+H') PPRINT1.268
C FFFFFFFFLLL XXXXXXXXXX XXXXXXXXXX XXXXXXXXXX XXXXXXXXXX XXXXXX PPRINT1.269
C XXXX PPRINT1.270
102 FORMAT(1X,'Current values around p_point no= ',I6,', row=',I4, GPB0F405.135
+ ' point=',I4,' latitude=',F7.1,' longitude=',F7.1,/ PPRINT1.272
+ ' TRACER LEVEL CENTRAL WEST EAST NORTH SOUT PPRINT1.273
+H') PPRINT1.274
C FFFFFFFFLLL XXXXXXXXXX XXXXXXXXXX XXXXXXXXXX XXXXXXXXXX XXXXXX PPRINT1.275
C XXXX PPRINT1.276
C PPRINT1.277
C PPRINT1.278
PRINT 111, 'Pstar ',0,PSTAR(KP),PSTAR(KPW),PSTAR(KPE), PPRINT1.279
+ PSTAR(KPN),PSTAR(KPS) PPRINT1.280
PPRINT1.281
111 FORMAT(1X,A8,I3.0,2X,1P,5(E10.3,1X)) PPRINT1.282
112 FORMAT(1X,A8,I3.0,2X,1P,4(E10.3,1X)) PPRINT1.283
113 FORMAT(1X,I3,5X,I3.0,2X,1P,5(E10.3,1X)) PPRINT1.284
114 FORMAT(1X,A8,I3.0,2X,5(I10,1X)) PPRINT1.285
C PPRINT1.286
DO 130 JL=IL1,IL2 PPRINT1.287
PRINT 111, 'Exner ',JL,EXNER(KP,JL),EXNER(KPW,JL), PPRINT1.288
+ EXNER(KPE,JL),EXNER(KPN,JL),EXNER(KPS,JL) PPRINT1.289
130 CONTINUE PPRINT1.290
C PPRINT1.291
C------------------------------------------------------------------ PPRINT1.292
CL--- 2 T*,Theta/T PPRINT1.293
C------------------------------------------------------------------ PPRINT1.294
PRINT 111, 'Tstar ',0,TSTAR(KP),TSTAR(KPW),TSTAR(KPE), PPRINT1.295
+ TSTAR(KPN),TSTAR(KPS) PPRINT1.296
IF(LTHETA) THEN PPRINT1.297
DO 220 JL=IL1,IL2 PPRINT1.298
PRINT 111, 'Theta ',JL,THETA(KP,JL),THETA(KPW,JL), PPRINT1.299
+ THETA(KPE,JL),THETA(KPN,JL),THETA(KPS,JL) PPRINT1.300
220 CONTINUE PPRINT1.301
C PPRINT1.302
DO 240 JL=IL1,IL2 PPRINT1.303
PPRINT1.304
PJLP1 = AKH(JL+1) + BKH(JL+1)*PSTAR(KP) PPRINT1.305
PJL = AKH(JL) + BKH(JL) *PSTAR(KP) PPRINT1.306
P_EXNER_FULL = P_EXNER_C PPRINT1.307
+(EXNER(KP,JL+1),EXNER(KP,JL),PJLP1,PJL,KAPPA) PPRINT1.308
Z = THETA(KP,JL) * P_EXNER_FULL PPRINT1.309
PPRINT1.310
PJLP1 = AKH(JL+1) + BKH(JL+1)*PSTAR(KPW) PPRINT1.311
PJL = AKH(JL) + BKH(JL) *PSTAR(KPW) PPRINT1.312
P_EXNER_FULL = P_EXNER_C PPRINT1.313
+(EXNER(KPW,JL+1),EXNER(KPW,JL),PJLP1,PJL,KAPPA) PPRINT1.314
ZW = THETA(KPW,JL) * P_EXNER_FULL PPRINT1.315
PPRINT1.316
PJLP1 = AKH(JL+1) + BKH(JL+1)*PSTAR(KPE) PPRINT1.317
PJL = AKH(JL) + BKH(JL) *PSTAR(KPE) PPRINT1.318
P_EXNER_FULL = P_EXNER_C PPRINT1.319
+(EXNER(KPE,JL+1),EXNER(KPE,JL),PJLP1,PJL,KAPPA) PPRINT1.320
ZE = THETA(KPE,JL) * P_EXNER_FULL PPRINT1.321
PPRINT1.322
PJLP1 = AKH(JL+1) + BKH(JL+1)*PSTAR(KPN) PPRINT1.323
PJL = AKH(JL) + BKH(JL) *PSTAR(KPN) PPRINT1.324
P_EXNER_FULL = P_EXNER_C PPRINT1.325
+(EXNER(KPN,JL+1),EXNER(KPN,JL),PJLP1,PJL,KAPPA) PPRINT1.326
ZN = THETA(KPN,JL) * P_EXNER_FULL PPRINT1.327
PPRINT1.328
PJLP1 = AKH(JL+1) + BKH(JL+1)*PSTAR(KPS) PPRINT1.329
PJL = AKH(JL) + BKH(JL) *PSTAR(KPS) PPRINT1.330
P_EXNER_FULL = P_EXNER_C PPRINT1.331
+(EXNER(KPS,JL+1),EXNER(KPS,JL),PJLP1,PJL,KAPPA) PPRINT1.332
ZS = THETA(KPS,JL) * P_EXNER_FULL PPRINT1.333
PPRINT1.334
PRINT 111, 'Temp ',JL,Z,ZW,ZE,ZN,ZS PPRINT1.335
PPRINT1.336
IF(JL.LE.Q_LEVELS) THEN PPRINT1.337
P=PSTAR(KP)*BK(JL)+AK(JL) PPRINT1.338
CALL QSAT(QS(1,JL),Z,P,1) PPRINT1.339
P=PSTAR(KPW)*BK(JL)+AK(JL) PPRINT1.340
CALL QSAT(QS(2,JL),ZW,P,1) PPRINT1.341
P=PSTAR(KPE)*BK(JL)+AK(JL) PPRINT1.342
CALL QSAT(QS(3,JL),ZE,P,1) PPRINT1.343
P=PSTAR(KPN)*BK(JL)+AK(JL) PPRINT1.344
CALL QSAT(QS(4,JL),ZN,P,1) PPRINT1.345
P=PSTAR(KPS)*BK(JL)+AK(JL) PPRINT1.346
CALL QSAT(QS(5,JL),ZS,P,1) PPRINT1.347
ENDIF PPRINT1.348
PPRINT1.349
240 CONTINUE PPRINT1.350
C PPRINT1.351
ELSE ! Theta contains Temperature PPRINT1.352
C PPRINT1.353
DO 260 JL=IL1,IL2 PPRINT1.354
PRINT 111, 'Temp ',JL,THETA(KP,JL),THETA(KPW,JL), PPRINT1.355
+ THETA(KPE,JL),THETA(KPN,JL),THETA(KPS,JL) PPRINT1.356
Z=THETA(KP,JL) PPRINT1.357
ZW=THETA(KPW,JL) PPRINT1.358
ZE=THETA(KPE,JL) PPRINT1.359
ZN=THETA(KPN,JL) PPRINT1.360
ZS=THETA(KPS,JL) PPRINT1.361
PPRINT1.362
IF(JL.LE.Q_LEVELS) THEN PPRINT1.363
P=PSTAR(KP)*BK(JL)+AK(JL) PPRINT1.364
CALL QSAT(QS(1,JL),Z,P,1) PPRINT1.365
P=PSTAR(KPW)*BK(JL)+AK(JL) PPRINT1.366
CALL QSAT(QS(2,JL),ZW,P,1) PPRINT1.367
P=PSTAR(KPE)*BK(JL)+AK(JL) PPRINT1.368
CALL QSAT(QS(3,JL),ZE,P,1) PPRINT1.369
P=PSTAR(KPN)*BK(JL)+AK(JL) PPRINT1.370
CALL QSAT(QS(4,JL),ZN,P,1) PPRINT1.371
P=PSTAR(KPS)*BK(JL)+AK(JL) PPRINT1.372
CALL QSAT(QS(5,JL),ZS,P,1) PPRINT1.373
ENDIF PPRINT1.374
PPRINT1.375
260 CONTINUE PPRINT1.376
ENDIF ! LTHETA test PPRINT1.377
C PPRINT1.378
C------------------------------------------------------------------ PPRINT1.379
CL--- 3 Q,QCL,QCF PPRINT1.380
C------------------------------------------------------------------ PPRINT1.381
C PPRINT1.382
IL2=Q_LEVELS PPRINT1.383
DO 320 JL=IL1,IL2 PPRINT1.384
PRINT 111, 'Q ', PPRINT1.385
+ JL,Q(KP,JL),Q(KPW,JL),Q(KPE,JL),Q(KPN,JL),Q(KPS,JL) PPRINT1.386
RH(1)=Q(KP,JL)/QS(1,JL) PPRINT1.387
RH(2)=Q(KPW,JL)/QS(2,JL) PPRINT1.388
RH(3)=Q(KPE,JL)/QS(3,JL) PPRINT1.389
RH(4)=Q(KPN,JL)/QS(4,JL) PPRINT1.390
RH(5)=Q(KPS,JL)/QS(5,JL) PPRINT1.391
PRINT 111, 'Rel hum ', PPRINT1.392
+ JL,rh PPRINT1.393
320 CONTINUE PPRINT1.394
C PPRINT1.395
DO 340 JL=IL1,IL2 PPRINT1.396
PRINT 111, 'QCL ', PPRINT1.397
+ JL,QCL(KP,JL),QCL(KPW,JL),QCL(KPE,JL),QCL(KPN,JL),QCL(KPS,JL) PPRINT1.398
340 CONTINUE PPRINT1.399
C PPRINT1.400
DO 360 JL=IL1,IL2 PPRINT1.401
PRINT 111, 'QCF ', PPRINT1.402
+ JL,QCF(KP,JL),QCF(KPW,JL),QCF(KPE,JL),QCF(KPN,JL),QCF(KPS,JL) PPRINT1.403
360 CONTINUE PPRINT1.404
C---------------------------------------------------------------------- PPRINT1.405
CL--- 3a cloudfraction PPRINT1.406
C---------------------------------------------------------------------- PPRINT1.407
C PPRINT1.408
IF(LCLOUDP) THEN PPRINT1.409
PPRINT1.410
IL2=Q_LEVELS PPRINT1.411
DO 365 JL=IL1,IL2 PPRINT1.412
PRINT 111, 'CLOUD ', PPRINT1.413
+ JL,CLOUD(KP,JL),CLOUD(KPW,JL),CLOUD(KPE,JL),CLOUD(KPN,JL), PPRINT1.414
+ CLOUD(KPS,JL) PPRINT1.415
365 CONTINUE PPRINT1.416
ENDIF ! LCLOUDP=T PPRINT1.417
C PPRINT1.418
C---------------------------------------------------------------------- PPRINT1.419
CL--- 3b TRACERS PPRINT1.420
C---------------------------------------------------------------------- PPRINT1.421
C PPRINT1.422
IF(TR_VARS.GE.1) THEN PPRINT1.423
PRINT 102,KPOINT,IROW,IPOINT,RLAT,RLONG PPRINT1.424
IL2=TR_LEVELS PPRINT1.425
DO 380 JTR=1,TR_VARS PPRINT1.426
DO 370 JL=IL1,IL2 PPRINT1.427
PRINT 113, JTR,JL, PPRINT1.428
+ TRACER(KP,JL,JTR),TRACER(KPW,JL,JTR),TRACER(KPE,JL,JTR), PPRINT1.429
+ TRACER(KPN,JL,JTR),TRACER(KPS,JL,JTR) PPRINT1.430
370 CONTINUE PPRINT1.431
380 CONTINUE PPRINT1.432
ENDIF ! tr_vars>=1 PPRINT1.433
C PPRINT1.434
C---------------------------------------------------------------------- PPRINT1.435
CL--- 3c convective cloud amount,base,top,LWP PPRINT1.436
C---------------------------------------------------------------------- PPRINT1.437
C PPRINT1.438
PRINT 101,KPOINT,IROW,IPOINT,RLAT,RLONG PPRINT1.439
C PPRINT1.440
DO JL=1,N_CCA_LEV AJX0F404.531
PRINT 111, 'CCA ', PPRINT1.441
+ JL,CCA(KP,JL),CCA(KPW,JL),CCA(KPE,JL),CCA(KPN,JL),CCA(KPS,JL) AJX0F404.532
ENDDO AJX0F404.533
PRINT 114, 'CCB ', PPRINT1.443
+ 0,CCB(KP),CCB(KPW),CCB(KPE),CCB(KPN),CCB(KPS) PPRINT1.444
PRINT 114, 'CCT ', PPRINT1.445
+ 0,CCT(KP),CCT(KPW),CCT(KPE),CCT(KPN),CCT(KPS) PPRINT1.446
PRINT 111, 'CCLWP ', PPRINT1.447
+ 0,CCLWP(KP),CCLWP(KPW),CCLWP(KPE),CCLWP(KPN),CCLWP(KPS) PPRINT1.448
C PPRINT1.449
C---------------------------------------------------------------------- PPRINT1.450
CL--- 3d radiative heating rates PPRINT1.451
C---------------------------------------------------------------------- PPRINT1.452
IF(LRADP) THEN PPRINT1.453
C PPRINT1.454
IL2=LEVELS PPRINT1.455
DO 390 JL=0,IL2 PPRINT1.456
PRINT 111, 'Radincs', PPRINT1.457
+ JL,RADINCS(KP,JL),RADINCS(KPW,JL),RADINCS(KPE,JL), PPRINT1.458
+ RADINCS(KPN,JL),RADINCS(KPS,JL) PPRINT1.459
390 CONTINUE PPRINT1.460
C PPRINT1.461
ENDIF ! LRADP=T PPRINT1.462
C---------------------------------------------------------------------- PPRINT1.463
CL--- 4 U,V PPRINT1.464
C---------------------------------------------------------------------- PPRINT1.465
C PPRINT1.466
IL2=LEVELS PPRINT1.467
PRINT 401,KPOINT,IROW,IPOINT,RLAT,RLONG PPRINT1.468
401 FORMAT(1X,'Current values around p_point no= ',I6,', row=',I4, GPB0F405.136
+ ' point=',I4,' latitude=',F7.1,' longitude=',F7.1,/ GPB0F405.137
+ ' FIELD LEVEL N/WEST N/EAST S/WEST S/EAST') PPRINT1.471
C FFFFFFFFLLL XXXXXXXXXX XXXXXXXXXX XXXXXXXXXX XXXXXXXXXX PPRINT1.472
C PPRINT1.473
DO 420 JL=IL1,IL2 PPRINT1.474
PRINT 112, 'U wind ',JL,U(KUNW,JL),U(KUNE,JL),U(KUSW,JL), PPRINT1.475
+ U(KUSE,JL) PPRINT1.476
420 CONTINUE PPRINT1.477
C PPRINT1.478
DO 421 JL=IL1,IL2 PPRINT1.479
PRINT 112, 'V wind ',JL,V(KUNW,JL),V(KUNE,JL),V(KUSW,JL), PPRINT1.480
+ V(KUSE,JL) PPRINT1.481
421 CONTINUE PPRINT1.482
C PPRINT1.483
ENDIF ! LVPRINT PPRINT1.484
C PPRINT1.485
IF(LHPRINT) THEN PPRINT1.486
C PPRINT1.487
C---------------------------------------------------------------------- PPRINT1.488
CL 5.0 Horizontal format starts here PPRINT1.489
CL set up INDEX to cope with endpoint problems at ends of rows PPRINT1.490
CL--- P*/Exner PPRINT1.491
C---------------------------------------------------------------------- PPRINT1.492
DO JP=-KTOL-1,KTOL PPRINT1.493
INDEX(JP)=JP PPRINT1.494
IF((MOD(KPOINT,ROW_LENGTH)+JP).LE.0) INDEX(JP)=JP+ROW_LENGTH PPRINT1.495
IF((MOD(KPOINT,ROW_LENGTH)+JP).GT.ROW_LENGTH) PPRINT1.496
& INDEX(JP)=JP-ROW_LENGTH PPRINT1.497
ENDDO PPRINT1.498
PPRINT1.499
PRINT 501,KPOINT,IROW,IPOINT,RLAT,RLONG PPRINT1.500
501 FORMAT(1X,'Current values around p_point no= ',I6,', row=',I4, GPB0F405.138
+ ' point=',I4,' latitude=',F7.1,' longitude=',F7.1) PPRINT1.502
C PPRINT1.503
WRITE(6,*)' Pstar' GIE0F403.512
DO 510 IL=-KTOL,+KTOL PPRINT1.505
KP=KPOINT+IL*ROW_LENGTH PPRINT1.506
PRINT 502,(PSTAR(INDEX(JP)+KP),JP=-KTOL,+KTOL) PPRINT1.507
510 CONTINUE PPRINT1.508
502 FORMAT(1X,1P,10(E10.3,1X)) PPRINT1.509
503 FORMAT(1X,1P,10(I10,1X)) PPRINT1.510
C PPRINT1.511
DO 530 JL=IL1,IL2 PPRINT1.512
WRITE(6,*)' Exner level=',JL GIE0F403.513
DO 520 IL=-KTOL,+KTOL PPRINT1.514
KP=KPOINT+IL*ROW_LENGTH PPRINT1.515
PRINT 502,(EXNER(INDEX(JP)+KP,JL),JP=-KTOL,+KTOL) PPRINT1.516
520 CONTINUE PPRINT1.517
530 CONTINUE PPRINT1.518
C PPRINT1.519
C---------------------------------------------------------------------- PPRINT1.520
CL--- 6 T*/Theta/T PPRINT1.521
C---------------------------------------------------------------------- PPRINT1.522
C PPRINT1.523
WRITE(6,*)' Tstar' GIE0F403.514
DO 601 IL=-KTOL,+KTOL PPRINT1.525
KP=KPOINT+IL*ROW_LENGTH PPRINT1.526
PRINT 502,(TSTAR(JP),JP=KP-KTOL,KP+KTOL) PPRINT1.527
601 CONTINUE PPRINT1.528
IF(LTHETA) THEN PPRINT1.529
DO 620 JL=IL1,IL2 PPRINT1.530
WRITE(6,*)' Theta level=',JL GIE0F403.515
DO 610 IL=-KTOL,+KTOL PPRINT1.532
KP=KPOINT+IL*ROW_LENGTH PPRINT1.533
PRINT 502,(THETA(INDEX(JP)+KP,JL),JP=-KTOL,+KTOL) PPRINT1.534
610 CONTINUE PPRINT1.535
620 CONTINUE PPRINT1.536
C PPRINT1.537
DO 640 JL=IL1,IL2 PPRINT1.538
WRITE(6,*)' Temperature level=',JL GIE0F403.516
DO 630 IL=-KTOL,+KTOL PPRINT1.540
KP=KPOINT+IL*ROW_LENGTH PPRINT1.541
DO 625 JP=-KTOL,+KTOL PPRINT1.542
PJLP1 = AKH(JL+1) + BKH(JL+1)*PSTAR(KP+INDEX(JP)) PPRINT1.543
PJL = AKH(JL) + BKH(JL) *PSTAR(KP+INDEX(JP)) PPRINT1.544
P_EXNER_FULL = P_EXNER_C PPRINT1.545
+ (EXNER(KP+INDEX(JP),JL+1),EXNER(KP+INDEX(JP),JL), PPRINT1.546
+ PJLP1,PJL,KAPPA) PPRINT1.547
PPRINT1.548
TEMP(JP) = THETA(KP+INDEX(JP),JL) * P_EXNER_FULL PPRINT1.549
625 CONTINUE PPRINT1.550
PRINT 502,(TEMP(JP),JP=-KTOL,+KTOL) PPRINT1.551
630 CONTINUE PPRINT1.552
640 CONTINUE PPRINT1.553
C PPRINT1.554
ELSE ! Theta contains Temperature PPRINT1.555
C PPRINT1.556
DO 660 JL=IL1,IL2 PPRINT1.557
WRITE(6,*)' Temperature level=',JL GIE0F403.517
DO 650 IL=-KTOL,+KTOL PPRINT1.559
KP=KPOINT+IL*ROW_LENGTH PPRINT1.560
PRINT 502,(THETA(INDEX(JP)+KP,JL),JP=-KTOL,+KTOL) PPRINT1.561
650 CONTINUE PPRINT1.562
660 CONTINUE PPRINT1.563
ENDIF PPRINT1.564
C---------------------------------------------------------------------- PPRINT1.565
CL--- 7 Q,QCL,QCF PPRINT1.566
C---------------------------------------------------------------------- PPRINT1.567
C PPRINT1.568
IL2=Q_LEVELS PPRINT1.569
DO 720 JL=IL1,IL2 PPRINT1.570
WRITE(6,*)' Q level=',JL GIE0F403.518
DO 710 IL=-KTOL,+KTOL PPRINT1.572
KP=KPOINT+IL*ROW_LENGTH PPRINT1.573
PRINT 502,(Q(INDEX(JP)+KP,JL),JP=-KTOL,+KTOL) PPRINT1.574
710 CONTINUE PPRINT1.575
720 CONTINUE PPRINT1.576
C PPRINT1.577
DO 740 JL=IL1,IL2 PPRINT1.578
WRITE(6,*)' QCL level=',JL GIE0F403.519
DO 730 IL=-KTOL,+KTOL PPRINT1.580
KP=KPOINT+IL*ROW_LENGTH PPRINT1.581
PRINT 502,(QCL(INDEX(JP)+KP,JL),JP=-KTOL,+KTOL) PPRINT1.582
730 CONTINUE PPRINT1.583
740 CONTINUE PPRINT1.584
C PPRINT1.585
DO 760 JL=IL1,IL2 PPRINT1.586
WRITE(6,*)' QCF level=',JL GIE0F403.520
DO 750 IL=-KTOL,+KTOL PPRINT1.588
KP=KPOINT+IL*ROW_LENGTH PPRINT1.589
PRINT 502,(QCF(INDEX(JP)+KP,JL),JP=-KTOL,+KTOL) PPRINT1.590
750 CONTINUE PPRINT1.591
760 CONTINUE PPRINT1.592
C---------------------------------------------------------------------- PPRINT1.593
CL--- 7a cloud fraction PPRINT1.594
C---------------------------------------------------------------------- PPRINT1.595
C PPRINT1.596
IF(LCLOUDP) THEN PPRINT1.597
PPRINT1.598
IL2=Q_LEVELS PPRINT1.599
DO 766 JL=IL1,IL2 PPRINT1.600
WRITE(6,*)' CLOUD level=',JL GIE0F403.521
DO 765 IL=-KTOL,+KTOL PPRINT1.602
KP=KPOINT+IL*ROW_LENGTH PPRINT1.603
PRINT 502,(CLOUD(INDEX(JP)+KP,JL),JP=-KTOL,+KTOL) PPRINT1.604
765 CONTINUE PPRINT1.605
766 CONTINUE PPRINT1.606
ENDIF ! LCLOUDP=T PPRINT1.607
PPRINT1.608
C---------------------------------------------------------------------- PPRINT1.609
CL--- 7b TRACERS PPRINT1.610
C---------------------------------------------------------------------- PPRINT1.611
C PPRINT1.612
IF(TR_VARS.GE.1) THEN PPRINT1.613
IL2=TR_LEVELS PPRINT1.614
DO 790 JTR=1,TR_VARS PPRINT1.615
DO 780 JL=IL1,IL2 PPRINT1.616
WRITE(6,*)' Tracer ',JTR,' level=',JL GIE0F403.522
DO 770 IL=-KTOL,+KTOL PPRINT1.618
KP=KPOINT+IL*ROW_LENGTH PPRINT1.619
PRINT 502,(TRACER(INDEX(JP)+KP,JL,JTR),JP=-KTOL,+KTOL) PPRINT1.620
770 CONTINUE PPRINT1.621
780 CONTINUE PPRINT1.622
790 CONTINUE PPRINT1.623
ENDIF ! tr_vars>=1 PPRINT1.624
C PPRINT1.625
C---- 7c convective cloud amount,base,top,LWP PPRINT1.626
C PPRINT1.627
DO JL=1,N_CCA_LEV AJX0F404.534
WRITE(6,*)' CCA' AJX0F404.535
IF (N_CCA_LEV .GT. 1) WRITE(6,*)' level=',JL AJX0F404.536
DO 7900 IL=-KTOL,+KTOL PPRINT1.629
KP=KPOINT+IL*ROW_LENGTH PPRINT1.630
PRINT 502,(CCA(INDEX(JP)+KP,JL),JP=-KTOL,+KTOL) AJX0F404.537
7900 CONTINUE PPRINT1.632
ENDDO AJX0F404.538
WRITE(6,*)' CCB ' GIE0F403.524
DO 7901 IL=-KTOL,+KTOL PPRINT1.634
KP=KPOINT+IL*ROW_LENGTH PPRINT1.635
PRINT 503,(CCB(INDEX(JP)+KP),JP=-KTOL,+KTOL) PPRINT1.636
7901 CONTINUE PPRINT1.637
WRITE(6,*)' CCT ' GIE0F403.525
DO 7902 IL=-KTOL,+KTOL PPRINT1.639
KP=KPOINT+IL*ROW_LENGTH PPRINT1.640
PRINT 503,(CCT(INDEX(JP)+KP),JP=-KTOL,+KTOL) PPRINT1.641
7902 CONTINUE PPRINT1.642
WRITE(6,*)' CCLWP' GIE0F403.526
DO 7903 IL=-KTOL,+KTOL PPRINT1.644
KP=KPOINT+IL*ROW_LENGTH PPRINT1.645
PRINT 502,(CCLWP(INDEX(JP)+KP),JP=-KTOL,+KTOL) PPRINT1.646
7903 CONTINUE PPRINT1.647
C---------------------------------------------------------------------- PPRINT1.648
CL--- 7d radiative heating rates PPRINT1.649
C---------------------------------------------------------------------- PPRINT1.650
C PPRINT1.651
IF(LRADP) THEN PPRINT1.652
PPRINT1.653
IL1=0 PPRINT1.654
IL2=LEVELS PPRINT1.655
DO 7920 JL=IL1,IL2 PPRINT1.656
WRITE(6,*)' Radincs level=',JL GIE0F403.527
DO 7910 IL=-KTOL,+KTOL PPRINT1.658
KP=KPOINT+IL*ROW_LENGTH PPRINT1.659
PRINT 502,(RADINCS(INDEX(JP)+KP,JL),JP=-KTOL,+KTOL) PPRINT1.660
7910 CONTINUE PPRINT1.661
7920 CONTINUE PPRINT1.662
C PPRINT1.663
ENDIF ! LRADP=T PPRINT1.664
IL1=1 PPRINT1.665
PPRINT1.666
C---------------------------------------------------------------------- PPRINT1.667
CL--- 8 U,V PPRINT1.668
C---------------------------------------------------------------------- PPRINT1.669
C PPRINT1.670
IL2=LEVELS PPRINT1.671
PRINT 501,KPOINT,IROW,IPOINT,RLAT,RLONG PPRINT1.672
C PPRINT1.673
DO 812 JL=IL1,IL2 PPRINT1.674
WRITE(6,*)' U wind level=',JL GIE0F403.528
DO 810 IL=-KTOL-KTOLWN,+KTOL+KTOLWS PPRINT1.676
KP=KPOINT+IL*ROW_LENGTH PPRINT1.677
PRINT 502,(U(INDEX(JP)+KP,JL),JP=-KTOL-KTOLWW,KTOL+KTOLWE) PPRINT1.678
810 CONTINUE PPRINT1.679
812 CONTINUE PPRINT1.680
DO 820 JL=IL1,IL2 PPRINT1.681
WRITE(6,*)' V wind level=',JL GIE0F403.529
DO 814 IL=-KTOL-KTOLWN,+KTOL+KTOLWS PPRINT1.683
KP=KPOINT+IL*ROW_LENGTH PPRINT1.684
PRINT 502,(V(INDEX(JP)+KP,JL),JP=-KTOL-KTOLWW,KTOL+KTOLWE) PPRINT1.685
814 CONTINUE PPRINT1.686
820 CONTINUE PPRINT1.687
C PPRINT1.688
C PPRINT1.689
ENDIF ! LHPRINT PPRINT1.690
C PPRINT1.691
C PPRINT1.692
C---- FINISH PPRINT1.693
C PPRINT1.694
RETURN PPRINT1.695
END PPRINT1.696
PPRINT1.697
CLL SUBROUTINE PPRINT_S----------------------------------------- PPRINT1.698
CLL PPRINT1.699
CLL PURPOSE: PPRINT1.700
CLL PRINT VALUES OF T*,P*, surface ,soil and vegetation variables PPRINT1.701
CLL AT KPOINT AND KPOINT+/-KTOL,and ROW+/-KTOL,i.e.box (1+2KTOL)square PPRINT1.702
CLL PPRINT1.703
CLL SUITABLE FOR ROTATED GRIDS PPRINT1.704
CLL PPRINT1.705
CLL Model Modification history from model version 3.0: PPRINT1.706
CLL version Date PPRINT1.707
CLL 3.2 19/04/93 Code for new real missing data indicator (TCJ). TJ050593.106
CLL 4.2 March 97 Replace obsolete call to ISRCHEQ with fortran GSS1F403.6
CLL S.J.Swarbrick GSS1F403.7
CLL 4.5 19/01/98 Replace SOIL_FIELDS and VEG_FIELDS with GDR6F405.248
CLL individual fields. D. Robinson. GDR6F405.249
CLL PPRINT1.708
CLL ORIGINAL VERSION FOR CRAY Y-MP PPRINT1.709
CLL WRITTEN BY C. WILSON PPRINT1.710
CLL PPRINT1.711
CLL PROGRAMMING STANDARD: UNIFIED MODEL DOCUMENTATION PAPER NO. 5, PPRINT1.712
CLL VERSION 4, DATED 31/05/90 PPRINT1.713
CLL PPRINT1.714
CLL SYSTEM TASK: point print diagnostics D?? PPRINT1.715
CLL PPRINT1.716
CLLEND------------------------------------------------------------- PPRINT1.717
C PPRINT1.718
C*L ARGUMENTS:--------------------------------------------------- PPRINT1.719
SUBROUTINE PPRINT_S(P_POINTS,LAND_FIELD, 2AJS1F401.1572
& ST_LEVELS,SM_LEVELS, GDR6F405.250
& ROW_LENGTH,P_ROWS,TSTAR, GDR6F405.251
+ PSTAR,DEEP_SOIL_T,SMC,C_WATER,SNODEP,ZH,Z0,LAND,LAND_LIST, PPRINT1.722
& ICE_FRACTION,ICE_THICK, GDR6F405.252
& VOL_SMC_WILT, VOL_SMC_CRIT, VOL_SMC_FCAP, VOL_SMC_SAT, GDR6F405.253
& SAT_SOIL_COND, EAGLE_EXP, THERM_CAP, THERM_COND, CLAPP_HORN, GDR6F405.254
& VEG_FRAC, ROOT_DEPTH, SNOW_FREE_ALBEDO, DEEP_SNOW_ALBEDO, GDR6F405.255
& SURF_RESIST, SURF_CAPACITY, INFILT_FACT, GDR6F405.256
& OROG, SD_OROG, RAD_FLUX, GDR6F405.257
& KPOINT,RLAT,RLONG,KTOL,LRADP,LGLOBALP,LSINGLE_HYDROL,LMOSES) GDR6F405.258
PPRINT1.727
PPRINT1.728
IMPLICIT NONE PPRINT1.729
PPRINT1.730
INTEGER PPRINT1.731
* P_POINTS !IN 1ST DIMENSION OF FIELDS ON P-grid PPRINT1.732
*, LAND_FIELD !IN Dimension of land only fields PPRINT1.733
*, P_ROWS !IN NUMBER OF ROWS of P-grid PPRINT1.734
*, ROW_LENGTH !IN Number of points in row PPRINT1.735
&, ST_LEVELS !IN Number of soil temperature levels AJS1F401.1574
&, SM_LEVELS !IN Number of soil moisture levels AJS1F401.1575
*, SOIL_VARS !IN number of soil variables PPRINT1.737
*, VEG_VARS !IN number of vegetation variables PPRINT1.738
C PPRINT1.739
INTEGER PPRINT1.740
* KPOINT !IN point number in field PPRINT1.741
*, KTOL !IN tolerance for points printed around PPRINT1.742
C ! central point PPRINT1.743
INTEGER PPRINT1.744
* LAND_LIST (LAND_FIELD) !IN land index PPRINT1.745
C PPRINT1.746
REAL RLAT !IN latitude of central point PPRINT1.747
& ,RLONG !IN longitude of central point PPRINT1.748
& ,PSTAR(P_POINTS) !IN surface pressure field PPRINT1.749
& ,TSTAR(P_POINTS) !IN surface temperature field PPRINT1.750
& ,RAD_FLUX(P_POINTS) !IN net radiative flux PPRINT1.751
& ,DEEP_SOIL_T (LAND_FIELD,ST_LEVELS) !IN deep soil temperatures AJS1F401.1576
& ,SMC (LAND_FIELD) !IN soil moisture PPRINT1.755
& ,C_WATER (LAND_FIELD) !IN canopy water PPRINT1.756
& ,SNODEP (P_POINTS) !IN snowdepth PPRINT1.757
& ,ZH (P_POINTS) !IN boundary layer height PPRINT1.758
& ,Z0 (P_POINTS) !IN roughness length PPRINT1.759
& ,ICE_FRACTION (P_POINTS) !IN ice fraction PPRINT1.760
& ,ICE_THICK (P_POINTS) !IN ice thickness PPRINT1.761
! Soil Fields GDR6F405.259
& ,VOL_SMC_WILT (LAND_FIELD) !IN vol smc at wilting GDR6F405.260
& ,VOL_SMC_CRIT (LAND_FIELD) !IN vol smc at critical point GDR6F405.261
& ,VOL_SMC_FCAP (LAND_FIELD) !IN vol smc at field capacity GDR6F405.262
& ,VOL_SMC_SAT (LAND_FIELD) !IN vol smc at saturation GDR6F405.263
& ,SAT_SOIL_COND (LAND_FIELD) !IN saturated soil conductivity GDR6F405.264
& ,EAGLE_EXP (LAND_FIELD) !IN eagle exponent GDR6F405.265
& ,THERM_CAP (LAND_FIELD) !IN thermal capacity GDR6F405.266
& ,THERM_COND (LAND_FIELD) !IN thermal conductivity GDR6F405.267
& ,CLAPP_HORN (LAND_FIELD) !IN clapp-hornberger B coefficient GDR6F405.268
! Veg Fields GDR6F405.269
& ,VEG_FRAC (LAND_FIELD) !IN vegetation fraction GDR6F405.270
& ,ROOT_DEPTH (LAND_FIELD) !IN root depth GDR6F405.271
& ,SNOW_FREE_ALBEDO (LAND_FIELD) !IN snowfree albedo GDR6F405.272
& ,DEEP_SNOW_ALBEDO (LAND_FIELD) !IN deep snow albedo PPRINT1.763
& ,SURF_RESIST (LAND_FIELD) !IN surface resistance GDR6F405.273
& ,SURF_CAPACITY (LAND_FIELD) !IN surface capacity GDR6F405.274
& ,INFILT_FACT (LAND_FIELD) !IN infiltration factor GDR6F405.275
& ,OROG (P_POINTS) !IN mean orography PPRINT1.764
& ,SD_OROG (LAND_FIELD) !IN standard deviation of orography PPRINT1.765
LOGICAL LAND (P_POINTS) !IN land/sea mask PPRINT1.766
C PPRINT1.767
LOGICAL PPRINT1.768
* LRADP !IN true to print radiation array PPRINT1.769
*,LGLOBALP !IN true for global model else LAM PPRINT1.770
&,LSINGLE_HYDROL !IN T : Single Hydology Scheme on GDR6F405.276
&,LMOSES !IN T : MOSES Scheme on GDR6F405.277
C*--------------------------------------------------------------------- PPRINT1.771
PPRINT1.772
C*L WORKSPACE USAGE:------------------------------------------------- PPRINT1.773
C DEFINE LOCAL WORKSPACE ARRAYS: PPRINT1.774
C PPRINT1.775
REAL PPRINT1.784
& TEMP(-KTOL:KTOL,-KTOL:KTOL) !temporary used with land only vars PPRINT1.785
INTEGER PPRINT1.786
& ITEMP(-KTOL:KTOL,-KTOL:KTOL) !index for patch points to cope with PPRINT1.787
& !land only variables PPRINT1.788
INTEGER INDEX(-KTOL:KTOL) ! index for patch points to cope PPRINT1.789
& !with start/end of rows PPRINT1.790
C*--------------------------------------------------------------------- PPRINT1.792
C PPRINT1.793
C*L EXTERNAL SUBROUTINES CALLED--------------------------------------- PPRINT1.794
C*------------------------------------------------------------------ PPRINT1.797
C DEFINE LOCAL VARIABLES PPRINT1.798
INTEGER IL1, IL2 !bottom and top level limits PPRINT1.799
INTEGER JL,JP !loop indices for levels,points PPRINT1.800
INTEGER IL !loop index for row PPRINT1.801
INTEGER JS !loop index for soil PPRINT1.802
INTEGER JV !loop index for veg PPRINT1.803
INTEGER IROW,IPOINT !row and point no in row PPRINT1.804
INTEGER KP !Pointers PPRINT1.805
INTEGER KS ! counter for sea points PPRINT1.806
LOGICAL LALLSEA ! avoid print of land only if all sea points PPRINT1.807
integer I,J !loop counters & GSS1F403.8
logical ifound !logical used in search of LAND_LIST array GSS1F403.9
C PPRINT1.808
*CALL C_MDI TJ050593.107
PPRINT1.809
C------------------------------------------------------------------- PPRINT1.810
CL INTERNAL STRUCTURE INCLUDING SUBROUTINE CALLS: PPRINT1.811
CL 0. INITIALISATION PPRINT1.812
C-------------------------- PPRINT1.813
PPRINT1.814
PPRINT1.815
C----------------------------------------------------------------------- PPRINT1.816
CL 0.1 Prelim set row,point values PPRINT1.817
C----------------------------------------------------------------------- PPRINT1.818
PPRINT1.819
IROW=(KPOINT+ROW_LENGTH-1)/ROW_LENGTH PPRINT1.820
PPRINT1.821
C Alter chosen point by one row if polar point is selected PPRINT1.822
IF(IROW.EQ.1) THEN PPRINT1.823
KPOINT=KPOINT+ROW_LENGTH PPRINT1.824
IROW=2 PPRINT1.825
KTOL=1 PPRINT1.826
WRITE(6,*)' PPRINT_S == POLAR/BOUNDARY POINT CHOSEN - CENTRE POINT GIE0F403.530
&IS ONE ROW TO THE SOUTH, AND TOLERANCE SET TO 1' PPRINT1.828
ENDIF PPRINT1.829
PPRINT1.830
IF(IROW.EQ.P_ROWS) THEN PPRINT1.831
KPOINT=KPOINT-ROW_LENGTH PPRINT1.832
IROW=P_ROWS-1 PPRINT1.833
KTOL=1 PPRINT1.834
WRITE(6,*)' PPRINT_S == POLAR/BOUNDARY POINT CHOSEN - CENTRE POINT GIE0F403.531
&IS ONE ROW TO THE NORTH, AND TOLERANCE SET TO 1' PPRINT1.836
ENDIF PPRINT1.837
PPRINT1.838
C Alter tolerance if too close to polar/boundary rows PPRINT1.839
IF((IROW-KTOL).LT.1) THEN PPRINT1.840
KTOL=IROW-1 PPRINT1.841
WRITE(6,*)' PPRINT_S == Too close to boundary for tolerance chosen GIE0F403.532
&- tolerance reset to ',KTOL PPRINT1.843
ENDIF PPRINT1.844
PPRINT1.845
IF((IROW+KTOL).GT.P_ROWS) THEN PPRINT1.846
KTOL=P_ROWS-IROW PPRINT1.847
WRITE(6,*)' PPRINT_S == Too close to boundary for tolerance chosen GIE0F403.533
&- tolerance reset to ',KTOL PPRINT1.849
ENDIF PPRINT1.850
PPRINT1.851
PPRINT1.852
C find point no in row PPRINT1.853
IPOINT=KPOINT-ROW_LENGTH*(IROW-1) PPRINT1.854
PPRINT1.855
IF(.NOT.LGLOBALP ) THEN PPRINT1.856
PPRINT1.857
IF(IPOINT.EQ.1 ) THEN PPRINT1.858
KPOINT=KPOINT+1 PPRINT1.859
IPOINT=2 PPRINT1.860
KTOL=1 PPRINT1.861
WRITE(6,*)' PPRINT_S == BOUNDARY POINT CHOSEN -CENTRE POINT IS ONE GIE0F403.534
&POINT TO THE EAST, AND TOLERANCE SET TO 1' PPRINT1.863
ENDIF PPRINT1.864
PPRINT1.865
IF(IPOINT.EQ.ROW_LENGTH ) THEN PPRINT1.866
KPOINT=KPOINT-1 PPRINT1.867
IPOINT=ROW_LENGTH-1 PPRINT1.868
KTOL=1 PPRINT1.869
WRITE(6,*)' PPRINT_S == BOUNDARY POINT CHOSEN -CENTRE POINT IS ONE GIE0F403.535
&POINT TO THE WEST, AND TOLERANCE SET TO 1' PPRINT1.871
ENDIF PPRINT1.872
PPRINT1.873
C Alter tolerance if too close to EW boundary points PPRINT1.874
PPRINT1.875
IF((IPOINT-KTOL).LT.1) THEN PPRINT1.876
KTOL=IPOINT-1 PPRINT1.877
WRITE(6,*)' PPRINT_S == Too close to boundary for tolerance chosen GIE0F403.536
&- tolerance reset to ',KTOL PPRINT1.879
ENDIF PPRINT1.880
PPRINT1.881
IF((IPOINT+KTOL).GT.ROW_LENGTH) THEN PPRINT1.882
KTOL=ROW_LENGTH-IPOINT PPRINT1.883
WRITE(6,*)' PPRINT_S == Too close to boundary for tolerance chosen GIE0F403.537
&- tolerance reset to ',KTOL PPRINT1.885
ENDIF PPRINT1.886
PPRINT1.887
ENDIF ! .NOT.LGLOBALP PPRINT1.888
PPRINT1.889
KP=KPOINT PPRINT1.890
C PPRINT1.891
C----------------------------------------------------------------------- PPRINT1.892
CL 0.2 set up INDEX to cope with endpoint problems at ends of rows PPRINT1.893
C----------------------------------------------------------------------- PPRINT1.894
PPRINT1.895
DO JP=-KTOL,KTOL PPRINT1.896
INDEX(JP)=JP PPRINT1.897
IF((MOD(KPOINT,ROW_LENGTH)+JP).LE.0) INDEX(JP)=JP+ROW_LENGTH PPRINT1.898
IF((MOD(KPOINT,ROW_LENGTH)+JP).GT.ROW_LENGTH) PPRINT1.899
& INDEX(JP)=JP-ROW_LENGTH PPRINT1.900
ENDDO PPRINT1.901
PPRINT1.902
C PPRINT1.903
C----------------------------------------------------------------------- PPRINT1.904
CL 0.3 set up ITEMP and TEMP for use with land only variables PPRINT1.905
C----------------------------------------------------------------------- PPRINT1.906
PPRINT1.907
KS=0 PPRINT1.908
DO IL=-KTOL,KTOL PPRINT1.909
KP=KPOINT+IL*ROW_LENGTH PPRINT1.910
DO JP=-KTOL,KTOL PPRINT1.911
IF(LAND(INDEX(JP)+KP)) THEN PPRINT1.912
J =1 GSS1F403.10
ITEMP(JP,IL)=0 GSS1F403.11
ifound =.false. GSS1F403.12
if (LAND_FIELD.gt.0) then GSS1F403.13
DO I=1,LAND_FIELD GSS1F403.14
if (.not.ifound) then GSS1F403.15
if ( LAND_LIST(J).ne.(INDEX(JP)+KP) ) then GSS1F403.16
J=J+1 GSS1F403.17
else GSS1F403.18
ifound=.true. GSS1F403.19
ITEMP(JP,IL)=I GSS1F403.20
end if GSS1F403.21
end if GSS1F403.22
ENDDO GSS1F403.23
end if GSS1F403.24
ELSE PPRINT1.915
C non land-only points PPRINT1.916
TEMP(JP,IL)=RMDI TJ050593.108
ITEMP(JP,IL)=0 PPRINT1.918
KS=KS+1 PPRINT1.919
ENDIF PPRINT1.920
ENDDO PPRINT1.921
ENDDO PPRINT1.922
LALLSEA=KS.EQ.( (2*KTOL+1)*(2*KTOL+1) ) PPRINT1.923
PPRINT1.924
C---------------------------------------------------------------------- PPRINT1.925
CL--- 1 land mask/p* PPRINT1.926
C---------------------------------------------------------------------- PPRINT1.927
C PPRINT1.928
PRINT 101,KPOINT,IROW,IPOINT,RLAT,RLONG PPRINT1.929
101 FORMAT(1X,'Current values around p_point no= ',I6,', row=',I4, GPB0F405.139
+ ' point=',I4,' latitude=',F7.1,' longitude=',F7.1) PPRINT1.931
C PPRINT1.932
WRITE(6,*)' land ' GIE0F403.538
DO 110 IL=-KTOL,+KTOL PPRINT1.934
KP=KPOINT+IL*ROW_LENGTH PPRINT1.935
PRINT 103,(LAND(INDEX(JP)+KP),JP=-KTOL,+KTOL) PPRINT1.936
110 CONTINUE PPRINT1.937
C PPRINT1.938
WRITE(6,*)' Pstar' GIE0F403.539
DO 120 IL=-KTOL,+KTOL PPRINT1.940
KP=KPOINT+IL*ROW_LENGTH PPRINT1.941
PRINT 102,(PSTAR(INDEX(JP)+KP),JP=-KTOL,+KTOL) PPRINT1.942
120 CONTINUE PPRINT1.943
102 FORMAT(1X,1P,10(E10.3,1X)) PPRINT1.944
103 FORMAT(1X,1P,10(L10,1X)) PPRINT1.945
C PPRINT1.946
C---------------------------------------------------------------------- PPRINT1.947
CL--- 2 T*/deep_soil_t PPRINT1.948
C---------------------------------------------------------------------- PPRINT1.949
C PPRINT1.950
IL1=1 PPRINT1.951
IL2=ST_LEVELS AJS1F401.1577
C PPRINT1.953
WRITE(6,*)' Tstar' GIE0F403.540
DO 201 IL=-KTOL,+KTOL PPRINT1.955
KP=KPOINT+IL*ROW_LENGTH PPRINT1.956
PRINT 102,(TSTAR(INDEX(JP)+KP),JP=-KTOL,+KTOL) PPRINT1.957
201 CONTINUE PPRINT1.958
IF(.NOT.LALLSEA) THEN PPRINT1.959
DO 220 JL=IL1,IL2 PPRINT1.960
WRITE(6,*)' Deep_soil_T level=',JL GIE0F403.541
PPRINT1.962
DO IL=-KTOL,KTOL PPRINT1.963
DO JP=-KTOL,KTOL PPRINT1.964
IF(ITEMP(JP,IL).NE.0) THEN PPRINT1.965
TEMP(JP,IL)=DEEP_SOIL_T(ITEMP(JP,IL),JL) PPRINT1.966
ENDIF PPRINT1.967
ENDDO PPRINT1.968
PRINT 102,(TEMP(JP,IL),JP=-KTOL,+KTOL) PPRINT1.969
ENDDO PPRINT1.970
PPRINT1.971
220 CONTINUE PPRINT1.972
ENDIF ! .NOT.LALLSEA PPRINT1.973
C PPRINT1.974
C---------------------------------------------------------------------- PPRINT1.975
CL--- 3 SMC,C_WATER,SNODEP,ICE_FRACTION,ICE_THICK PPRINT1.976
C---------------------------------------------------------------------- PPRINT1.977
C PPRINT1.978
IF(.NOT.LALLSEA) THEN PPRINT1.979
WRITE(6,*)' SMC ' GIE0F403.542
PPRINT1.981
DO IL=-KTOL,KTOL PPRINT1.982
DO JP=-KTOL,KTOL PPRINT1.983
IF(ITEMP(JP,IL).NE.0) THEN PPRINT1.984
TEMP(JP,IL)=SMC(ITEMP(JP,IL)) PPRINT1.985
ENDIF PPRINT1.986
ENDDO PPRINT1.987
PRINT 102,(TEMP(JP,IL),JP=-KTOL,+KTOL) PPRINT1.988
ENDDO PPRINT1.989
PPRINT1.990
C PPRINT1.991
WRITE(6,*)' C_WATER' GIE0F403.543
PPRINT1.993
DO IL=-KTOL,KTOL PPRINT1.994
DO JP=-KTOL,KTOL PPRINT1.995
IF(ITEMP(JP,IL).NE.0) THEN PPRINT1.996
TEMP(JP,IL)=C_WATER(ITEMP(JP,IL)) PPRINT1.997
ENDIF PPRINT1.998
ENDDO PPRINT1.999
PRINT 102,(TEMP(JP,IL),JP=-KTOL,+KTOL) PPRINT1.1000
ENDDO PPRINT1.1001
ENDIF ! .NOT.LALLSEA PPRINT1.1002
PPRINT1.1003
C PPRINT1.1004
WRITE(6,*)' SNODEP' GIE0F403.544
DO 330 IL=-KTOL,+KTOL PPRINT1.1006
KP=KPOINT+IL*ROW_LENGTH PPRINT1.1007
PRINT 102,(SNODEP(INDEX(JP)+KP),JP=-KTOL,+KTOL) PPRINT1.1008
330 CONTINUE PPRINT1.1009
C PPRINT1.1010
WRITE(6,*)' Ice_fraction' GIE0F403.545
DO 340 IL=-KTOL,+KTOL PPRINT1.1012
KP=KPOINT+IL*ROW_LENGTH PPRINT1.1013
PRINT 102,(ICE_FRACTION(INDEX(JP)+KP),JP=-KTOL,+KTOL) PPRINT1.1014
340 CONTINUE PPRINT1.1015
C PPRINT1.1016
WRITE(6,*)' Ice_thickness' GIE0F403.546
DO 350 IL=-KTOL,+KTOL PPRINT1.1018
KP=KPOINT+IL*ROW_LENGTH PPRINT1.1019
PRINT 102,(ICE_THICK(INDEX(JP)+KP),JP=-KTOL,+KTOL) PPRINT1.1020
350 CONTINUE PPRINT1.1021
C PPRINT1.1022
C---------------------------------------------------------------------- PPRINT1.1023
CL--- 3B radiative fluxes PPRINT1.1024
C---------------------------------------------------------------------- PPRINT1.1025
C PPRINT1.1026
IF(LRADP) THEN PPRINT1.1027
PPRINT1.1028
WRITE(6,*)' radflux ' GIE0F403.547
DO 3910 IL=-KTOL,+KTOL PPRINT1.1030
KP=KPOINT+IL*ROW_LENGTH PPRINT1.1031
PRINT 102,(RAD_FLUX(INDEX(JP)+KP),JP=-KTOL,+KTOL) PPRINT1.1032
3910 CONTINUE PPRINT1.1033
C PPRINT1.1034
ENDIF ! LRADP=T PPRINT1.1035
C PPRINT1.1036
C---------------------------------------------------------------------- PPRINT1.1037
CL--- 4 ZH,Z0,orog,sd_orog GDR6F405.278
C---------------------------------------------------------------------- PPRINT1.1039
C PPRINT1.1040
WRITE(6,*)' ZH ' GIE0F403.548
DO 410 IL=-KTOL,+KTOL PPRINT1.1042
KP=KPOINT+IL*ROW_LENGTH PPRINT1.1043
PRINT 102,(ZH(INDEX(JP)+KP),JP=-KTOL,+KTOL) PPRINT1.1044
410 CONTINUE PPRINT1.1045
C PPRINT1.1046
WRITE(6,*)' Z0 ' GIE0F403.549
DO 420 IL=-KTOL,+KTOL PPRINT1.1048
KP=KPOINT+IL*ROW_LENGTH PPRINT1.1049
PRINT 102,(Z0(INDEX(JP)+KP),JP=-KTOL,+KTOL) PPRINT1.1050
420 CONTINUE PPRINT1.1051
C PPRINT1.1052
WRITE(6,*)' Orog' GIE0F403.550
DO 430 IL=-KTOL,+KTOL PPRINT1.1054
KP=KPOINT+IL*ROW_LENGTH PPRINT1.1055
PRINT 102,(OROG(INDEX(JP)+KP),JP=-KTOL,+KTOL) PPRINT1.1056
430 CONTINUE PPRINT1.1057
C PPRINT1.1058
IF(.NOT.LALLSEA) THEN PPRINT1.1059
WRITE(6,*)' sd_orog' GIE0F403.551
PPRINT1.1061
DO IL=-KTOL,KTOL PPRINT1.1062
DO JP=-KTOL,KTOL PPRINT1.1063
IF(ITEMP(JP,IL).NE.0) THEN PPRINT1.1064
TEMP(JP,IL)=SD_OROG(ITEMP(JP,IL)) PPRINT1.1065
ENDIF PPRINT1.1066
ENDDO PPRINT1.1067
PRINT 102,(TEMP(JP,IL),JP=-KTOL,+KTOL) PPRINT1.1068
ENDDO PPRINT1.1069
C PPRINT1.1094
C---------------------------------------------------------------------- PPRINT1.1095
CL--- 5 soil_fields PPRINT1.1096
C---------------------------------------------------------------------- PPRINT1.1097
C PPRINT1.1098
WRITE(6,*)' Soil_field : Volumetric SMC at Wilting (40)' GDR6F405.279
GDR6F405.280
DO IL=-KTOL,KTOL GDR6F405.281
DO JP=-KTOL,KTOL GDR6F405.282
IF(ITEMP(JP,IL).NE.0) THEN GDR6F405.283
TEMP(JP,IL)=VOL_SMC_WILT(ITEMP(JP,IL)) GDR6F405.284
ENDIF GDR6F405.285
ENDDO GDR6F405.286
PRINT 102,(TEMP(JP,IL),JP=-KTOL,+KTOL) GDR6F405.287
ENDDO GDR6F405.288
GDR6F405.289
WRITE(6,*)' Soil_field : Volumetric SMC at Critical Point (41)' GDR6F405.290
GDR6F405.291
DO IL=-KTOL,KTOL GDR6F405.292
DO JP=-KTOL,KTOL GDR6F405.293
IF(ITEMP(JP,IL).NE.0) THEN GDR6F405.294
TEMP(JP,IL)=VOL_SMC_CRIT(ITEMP(JP,IL)) GDR6F405.295
ENDIF GDR6F405.296
ENDDO GDR6F405.297
PRINT 102,(TEMP(JP,IL),JP=-KTOL,+KTOL) GDR6F405.298
ENDDO GDR6F405.299
GDR6F405.300
WRITE(6,*)' Soil_field : Volumetric SMC Field at Capacity (42)' GDR6F405.301
GDR6F405.302
DO IL=-KTOL,KTOL GDR6F405.303
DO JP=-KTOL,KTOL GDR6F405.304
IF(ITEMP(JP,IL).NE.0) THEN GDR6F405.305
TEMP(JP,IL)=VOL_SMC_FCAP(ITEMP(JP,IL)) GDR6F405.306
ENDIF GDR6F405.307
ENDDO GDR6F405.308
PRINT 102,(TEMP(JP,IL),JP=-KTOL,+KTOL) GDR6F405.309
ENDDO GDR6F405.310
GDR6F405.311
WRITE(6,*)' Soil_field : Volumetric SMC at Saturation (43)' GDR6F405.312
GDR6F405.313
DO IL=-KTOL,KTOL GDR6F405.314
DO JP=-KTOL,KTOL GDR6F405.315
IF(ITEMP(JP,IL).NE.0) THEN GDR6F405.316
TEMP(JP,IL)=VOL_SMC_SAT(ITEMP(JP,IL)) GDR6F405.317
ENDIF GDR6F405.318
ENDDO GDR6F405.319
PRINT 102,(TEMP(JP,IL),JP=-KTOL,+KTOL) GDR6F405.320
ENDDO GDR6F405.321
GDR6F405.322
WRITE(6,*)' Soil_field : Sat Soil Conductivity (44)' GDR6F405.323
DO IL=-KTOL,KTOL GDR6F405.324
DO JP=-KTOL,KTOL GDR6F405.325
IF(ITEMP(JP,IL).NE.0) THEN GDR6F405.326
TEMP(JP,IL)=SAT_SOIL_COND(ITEMP(JP,IL)) GDR6F405.327
ENDIF GDR6F405.328
ENDDO GDR6F405.329
PRINT 102,(TEMP(JP,IL),JP=-KTOL,+KTOL) GDR6F405.330
ENDDO GDR6F405.331
GDR6F405.332
IF (LSINGLE_HYDROL) THEN GDR6F405.333
GDR6F405.334
WRITE(6,*)' Soil_field : Eagle Exponent (45)' GDR6F405.335
GDR6F405.336
DO IL=-KTOL,KTOL GDR6F405.337
DO JP=-KTOL,KTOL GDR6F405.338
IF(ITEMP(JP,IL).NE.0) THEN GDR6F405.339
TEMP(JP,IL)=EAGLE_EXP(ITEMP(JP,IL)) GDR6F405.340
ENDIF GDR6F405.341
ENDDO GDR6F405.342
PRINT 102,(TEMP(JP,IL),JP=-KTOL,+KTOL) GDR6F405.343
ENDDO GDR6F405.344
GDR6F405.345
ENDIF GDR6F405.346
GDR6F405.347
WRITE(6,*)' Soil_field : Thermal Capacity (46)' GDR6F405.348
GDR6F405.349
DO IL=-KTOL,KTOL GDR6F405.350
DO JP=-KTOL,KTOL GDR6F405.351
IF(ITEMP(JP,IL).NE.0) THEN GDR6F405.352
TEMP(JP,IL)=THERM_CAP(ITEMP(JP,IL)) GDR6F405.353
ENDIF GDR6F405.354
ENDDO GDR6F405.355
PRINT 102,(TEMP(JP,IL),JP=-KTOL,+KTOL) GDR6F405.356
ENDDO GDR6F405.357
GDR6F405.358
WRITE(6,*)' Soil_field : Thermal Conductivity (47).' GDR6F405.359
GDR6F405.360
DO IL=-KTOL,KTOL GDR6F405.361
DO JP=-KTOL,KTOL GDR6F405.362
IF(ITEMP(JP,IL).NE.0) THEN GDR6F405.363
TEMP(JP,IL)=THERM_COND(ITEMP(JP,IL)) GDR6F405.364
ENDIF GDR6F405.365
ENDDO GDR6F405.366
PRINT 102,(TEMP(JP,IL),JP=-KTOL,+KTOL) GDR6F405.367
ENDDO GDR6F405.368
GDR6F405.369
IF (LMOSES) THEN GDR6F405.370
GDR6F405.371
WRITE(6,*)' Soil_field : Clapp-Hornberger B Coefficient (207).' GDR6F405.372
GDR6F405.373
DO IL=-KTOL,KTOL GDR6F405.374
DO JP=-KTOL,KTOL GDR6F405.375
IF(ITEMP(JP,IL).NE.0) THEN GDR6F405.376
TEMP(JP,IL)=CLAPP_HORN(ITEMP(JP,IL)) GDR6F405.377
ENDIF GDR6F405.378
ENDDO GDR6F405.379
PRINT 102,(TEMP(JP,IL),JP=-KTOL,+KTOL) GDR6F405.380
ENDDO GDR6F405.381
GDR6F405.382
ENDIF GDR6F405.383
GDR6F405.384
C PPRINT1.1112
C---------------------------------------------------------------------- PPRINT1.1113
CL--- 6 veg_fields PPRINT1.1114
C---------------------------------------------------------------------- PPRINT1.1115
C PPRINT1.1116
WRITE(6,*)' Veg_Field : Vegetation Fraction (50)' GDR6F405.385
GDR6F405.386
DO IL=-KTOL,KTOL GDR6F405.387
DO JP=-KTOL,KTOL GDR6F405.388
IF(ITEMP(JP,IL).NE.0) THEN GDR6F405.389
TEMP(JP,IL)=VEG_FRAC(ITEMP(JP,IL)) GDR6F405.390
ENDIF GDR6F405.391
ENDDO GDR6F405.392
PRINT 102,(TEMP(JP,IL),JP=-KTOL,+KTOL) GDR6F405.393
ENDDO GDR6F405.394
GDR6F405.395
WRITE(6,*)' Veg_Field : Root Depth (51)' GDR6F405.396
GDR6F405.397
DO IL=-KTOL,KTOL GDR6F405.398
DO JP=-KTOL,KTOL GDR6F405.399
IF(ITEMP(JP,IL).NE.0) THEN GDR6F405.400
TEMP(JP,IL)=ROOT_DEPTH(ITEMP(JP,IL)) GDR6F405.401
ENDIF GDR6F405.402
ENDDO GDR6F405.403
PRINT 102,(TEMP(JP,IL),JP=-KTOL,+KTOL) GDR6F405.404
ENDDO GDR6F405.405
GDR6F405.406
WRITE(6,*)' Veg_Field : Snow Free Albedo (52)' GDR6F405.407
GDR6F405.408
DO IL=-KTOL,KTOL GDR6F405.409
DO JP=-KTOL,KTOL GDR6F405.410
IF(ITEMP(JP,IL).NE.0) THEN GDR6F405.411
TEMP(JP,IL)=SNOW_FREE_ALBEDO(ITEMP(JP,IL)) GDR6F405.412
ENDIF GDR6F405.413
ENDDO GDR6F405.414
PRINT 102,(TEMP(JP,IL),JP=-KTOL,+KTOL) GDR6F405.415
ENDDO GDR6F405.416
GDR6F405.417
WRITE(6,*)' Veg_Field : Deep Snow Albedo (53)' GDR6F405.418
GDR6F405.419
DO IL=-KTOL,KTOL GDR6F405.420
DO JP=-KTOL,KTOL GDR6F405.421
IF(ITEMP(JP,IL).NE.0) THEN GDR6F405.422
TEMP(JP,IL)=DEEP_SNOW_ALBEDO(ITEMP(JP,IL)) GDR6F405.423
ENDIF GDR6F405.424
ENDDO GDR6F405.425
PRINT 102,(TEMP(JP,IL),JP=-KTOL,+KTOL) GDR6F405.426
ENDDO GDR6F405.427
GDR6F405.428
WRITE(6,*)' Veg_Field : Surface Resistance (54)' GDR6F405.429
GDR6F405.430
DO IL=-KTOL,KTOL GDR6F405.431
DO JP=-KTOL,KTOL GDR6F405.432
IF(ITEMP(JP,IL).NE.0) THEN GDR6F405.433
TEMP(JP,IL)=SURF_RESIST(ITEMP(JP,IL)) GDR6F405.434
ENDIF GDR6F405.435
ENDDO GDR6F405.436
PRINT 102,(TEMP(JP,IL),JP=-KTOL,+KTOL) GDR6F405.437
ENDDO GDR6F405.438
GDR6F405.439
WRITE(6,*)' Veg_Field : Surface Capacity (55)' GDR6F405.440
GDR6F405.441
DO IL=-KTOL,KTOL GDR6F405.442
DO JP=-KTOL,KTOL GDR6F405.443
IF(ITEMP(JP,IL).NE.0) THEN GDR6F405.444
TEMP(JP,IL)=SURF_CAPACITY(ITEMP(JP,IL)) GDR6F405.445
ENDIF GDR6F405.446
ENDDO GDR6F405.447
PRINT 102,(TEMP(JP,IL),JP=-KTOL,+KTOL) GDR6F405.448
ENDDO GDR6F405.449
GDR6F405.450
WRITE(6,*)' Veg_field : Infiltration Factor (56)' GDR6F405.451
GDR6F405.452
DO IL=-KTOL,KTOL GDR6F405.453
DO JP=-KTOL,KTOL GDR6F405.454
IF(ITEMP(JP,IL).NE.0) THEN GDR6F405.455
TEMP(JP,IL)=INFILT_FACT(ITEMP(JP,IL)) GDR6F405.456
ENDIF GDR6F405.457
ENDDO GDR6F405.458
PRINT 102,(TEMP(JP,IL),JP=-KTOL,+KTOL) GDR6F405.459
ENDDO GDR6F405.460
ENDIF ! .NOT.LALLSEA PPRINT1.1130
C PPRINT1.1131
C---- FINISH PPRINT1.1132
C PPRINT1.1133
RETURN PPRINT1.1134
END PPRINT1.1135
PPRINT1.1136
PPRINT1.1159
*ENDIF PPRINT1.1160