SUBROUTINE TRANSA2O(USTRSIN,USTRSOUT,VSTRSIN, 2,80CJG6F401.29
+ VSTRSOUT,WMIXIN,WMIXOUT,SOLARIN,BLUEIN,BLUEOUT,EVAP,LONGWAVE, TRANA2O1.27
+ SENSIBLE,HEATFLUX,SNOWLS,SNOWCONV,RAINLS,RAINCONV,PMINUSE,RMDI, TRANA2O1.28
+ LC, TRANA2O1.29
*IF DEF,SEAICE TRANA2O1.30
+ AICE,SUBLMIN,BTMLTIN,TPMLTIN, TRANA2O1.31
+ SNOWOUT,SUBLMOUT,BTMLTOUT,TPMLTOUT, TRANA2O1.32
*ENDIF TRANA2O1.33
*IF DEF,TRANGRID TRANA2O1.34
& XUO,XTO,YUO,YTO,XTA,XUA,YTA,YUA, TRANA2O1.35
*ENDIF TRANA2O1.36
*IF DEF,TRANGRID,OR,DEF,RIVERS TRANA2O1.37
& AMASKTP, TRANA2O1.38
*ENDIF TRANA2O1.39
*IF DEF,RIVERS TRANA2O1.40
+ RUNOFFIN,OCENTPTS,RIVEROUT,LAND_FIELD, TRANA2O1.41
+ COS_P_LATITUDE, TRANA2O1.42
*ENDIF TRANA2O1.43
& ATMCO2, ATMCO2_OUT, CO2_ICOLS, CO2_JROWS, CO2_IMT, CO2_JMT, CCN1F405.179
+ IMT,JMT,JMTM1,ICOLS,JROWS,JROWSM1 CJG6F401.30
&,maxl,fkmp,fkmq,INVERT,CYCLIC,GLOBAL CJG6F401.31
& ,icode,cmessage) CJG6F401.32
C TRANA2O1.45
C THIS ROUTINE DEALS IN TURN WITH THE VARIOUS FIELDS TO BE TRANS- TRANA2O1.46
C FERRED FROM ATMOSPHERE TO OCEAN. THOSE ON THE U GRIDS (THE WIND TRANA2O1.47
C STRESSES) COME FIRST, FOLLOWED BY THOSE ON THE T GRIDS. TRANA2O1.48
C SECTIONS 9 TO 12 ARE ONLY PRESENT WHEN THE SEAICE SWITCH IS ON. TRANA2O1.49
C SECTION 8 IS ONLY PRESENT WHEN THE RIVERS SWITCH IS TURNED ON. TRANA2O1.50
C THE FLOW OF CONTROL IS STRAIGHTFORWARD. TRANA2O1.51
C TRANA2O1.52
IMPLICIT NONE TRANA2O1.53
C TRANA2O1.54
*CALL CNTLATM 
CCN1F405.180
*CALL CCARBON CCN1F405.181
INTEGER TRANA2O1.55
+ IMT, ! IN NO. OF COLUMNS IN OCEAN TRANA2O1.56
+ JMT, ! IN NO. OF ROWS IN OCEAN (TS GRID) TRANA2O1.57
+ JMTM1, ! IN NO. OF ROWS IN OCEAN (UV GRID) TRANA2O1.58
+ ICOLS, ! IN NO. OF COLUMNS IN ATMOSPHERE TRANA2O1.59
+ JROWS, ! IN NO. OF ROWS IN ATMOSPHERE (TP GRID) TRANA2O1.60
+ JROWSM1 ! IN NO. OF ROWS IN ATMOSPHERE (UV GRID) TRANA2O1.61
&,MAXL ! IN max. list length for area-averaging CJG6F401.33
&,CO2_ICOLS,CO2_JROWS ! IN CO2 array dimensions CCN1F405.182
&,CO2_IMT, CO2_JMT CCN1F405.183
C TRANA2O1.62
LOGICAL TRANA2O1.63
+ INVERT, ! IN TRUE WHEN ROW INVERSION IS REQUIRED TRANA2O1.64
+ CYCLIC ! IN TRUE WHEN THE OCEAN MODEL HAS CYCLIC TRANA2O1.65
+ ! BOUNDARY CONDITIONS AT EW BOUNDARIES. TRANA2O1.66
&,GLOBAL ! IN TRUE when ocean is global TRANA2O1.67
C TRANA2O1.68
REAL TRANA2O1.69
+ USTRSIN(ICOLS,JROWSM1),! IN ZONAL WIND STRESS FROM ATMOSPHERE TRANA2O1.72
+ VSTRSIN(ICOLS,JROWSM1),! IN MERID WIND STRESS FROM ATMOSPHERE TRANA2O1.73
+ WMIXIN(ICOLS,JROWS), ! IN WIND MIXING POWER FROM ATMOSPHERE TRANA2O1.74
+ SOLARIN(ICOLS,JROWS), ! IN NET DOWNWARD SHORTWAVE FLUX FROM THE TRANA2O1.75
+ ! ATMOSPHERE (ALL FREQUENCIES). TRANA2O1.76
+ BLUEIN(ICOLS,JROWS), ! IN NET DOWNWARD SHORTWAVE FLUX IN TRANA2O1.77
+ ! 'BLUE' FREQUENCY BAND ONLY. (SEE SECT4) TRANA2O1.78
+ EVAP(ICOLS,JROWS), ! IN SURFACE EVAPORATION FROM THE WATER TRANA2O1.79
+ ! FRACTION OF ALL OCEAN POINTS. AT SEA-ICE TRANA2O1.80
+ ! POINTS, THIS IS WEIGHTED BY THE TRANA2O1.81
+ ! FRACTIONAL LEAD AREA. TRANA2O1.82
+ LONGWAVE(ICOLS,JROWS),! IN NET DOWNWARD LONGWAVE HEAT FLUX. TRANA2O1.83
+ SENSIBLE(ICOLS,JROWS),! IN SENSIBLE HEAT FLUX (+VE UPWARD) FOR TRANA2O1.84
+ ! THE WATER FRACTION OF ALL OCEAN POINTS. TRANA2O1.85
+ ! AREA-WEIGHTED AT SEA-ICE POINTS. TRANA2O1.86
+ SNOWLS(ICOLS,JROWS), ! IN LARGE-SCALE SNOWFALL RATE TRANA2O1.87
+ SNOWCONV(ICOLS,JROWS),! IN CONVECTIVE SNOWFALL RATE TRANA2O1.88
+ RAINLS(ICOLS,JROWS), ! IN LARGE-SCALE RAINFALL RATE TRANA2O1.89
+ RAINCONV(ICOLS,JROWS),! IN CONVECTIVE RAINFALL RATE TRANA2O1.90
+ RMDI, ! IN MISSING DATA INDICATOR TRANA2O1.91
+ LC ! IN LATENT HEAT OF CONDENSATION TRANA2O1.92
&,FKMP(IMT,JMT) ! IN number of levels at ocean T points CJG6F401.34
&,FKMQ(IMT,JMT) ! IN number of levels at ocean U points CJG6F401.35
*IF DEF,SEAICE TRANA2O1.93
REAL TRANA2O1.94
+ AICE(ICOLS,JROWS), ! IN SEAICE CONCENTRATION TRANA2O1.95
+ SUBLMIN(ICOLS,JROWS), ! IN SUBLIMATION TRANA2O1.96
+ BTMLTIN(ICOLS,JROWS), ! IN DIFFUSIVE HEAT FLUX THROUGH ICE TRANA2O1.97
+ ! (POSITIVE DOWNWARDS) TRANA2O1.98
+ TPMLTIN(ICOLS,JROWS) ! IN SEAICE TOP MELTING HEAT FLUX TRANA2O1.99
*ENDIF TRANA2O1.100
*IF DEF,TRANGRID TRANA2O1.101
REAL TRANA2O1.102
& XUO(0:IMT) ! Ocean UV longitude coordinates TRANA2O1.103
&,XTO(IMT) ! Ocean TS longitude coordinates TRANA2O1.104
&,YUO(0:JMT) ! Ocean UV latitude coordinates TRANA2O1.105
&,YTO(JMT) ! Ocean TS latitude coordinates TRANA2O1.106
&,XTA(ICOLS+1) ! Atmosphere TP longitude coordinates TRANA2O1.107
&,XUA(0:ICOLS) ! Atmosphere UV longitude coordinates TRANA2O1.108
&,YTA(JROWS) ! Atmosphere TP latitude coordinates TRANA2O1.109
&,YUA(0:JROWS) ! Atmosphere UV latitude coordinates TRANA2O1.110
*ENDIF TRANA2O1.111
*IF DEF,TRANGRID,OR,DEF,RIVERS TRANA2O1.112
LOGICAL TRANA2O1.113
+ AMASKTP(ICOLS,JROWS) ! IN ATMOS MODEL LAND-SEA MASK FOR TP GRID. TRANA2O1.114
*ENDIF TRANA2O1.115
*IF DEF,RIVERS TRANA2O1.116
INTEGER TRANA2O1.117
+ LAND_FIELD ! IN NUMBER OF LAND POINTS IN ATMOS FIELD TRANA2O1.118
+,OCENTPTS(LAND_FIELD) ! IN COORDINATE INDEX TO OUTFLOW POINT (2D) TRANA2O1.119
REAL TRANA2O1.120
+ RUNOFFIN(ICOLS,JROWS) ! IN TOTAL RATE OF RUNOFF AT LAND POINTS TRANA2O1.121
C FOR EACH LAND POINT (KG M-2 S-1) TRANA2O1.122
C (THIS IS ZERO AT SEA POINTS) TRANA2O1.123
+,COS_P_LATITUDE(ICOLS,JROWS) ! IN COSINE OF LATITUDE AT P POINTS TRANA2O1.124
*ENDIF TRANA2O1.125
&,ATMCO2(CO2_ICOLS,CO2_JROWS) ! IN ATMOS CO2 CONC CCN1F405.184
integer CJG6F401.36
& icode ! OUT error code CJG6F401.37
C CJG6F401.38
character*80 cmessage ! OUT error message CJG6F401.39
C CJG6F401.40
REAL TRANA2O1.126
+ USTRSOUT(IMT,JMTM1), ! OUT ZONAL WIND STRESS FOR OCEAN TRANA2O1.127
+ VSTRSOUT(IMT,JMTM1), ! OUT MERID WIND STRESS FOR OCEAN TRANA2O1.128
+ WMIXOUT(IMT,JMT), ! OUT WIND MIXING POWER FOR OCEAN TRANA2O1.129
+ BLUEOUT(IMT,JMT), ! OUT PENETRATING COMPONENT OF SOLAR HEAT TRANA2O1.130
+ ! FLUX FOR OCEAN. TRANA2O1.131
+ HEATFLUX(IMT,JMT), ! OUT NON-PENETRATIVE HEAT FLUX TRANA2O1.132
+ PMINUSE(IMT,JMT) ! OUT PRECIPITATION LESS EVAPORATION TRANA2O1.133
*IF DEF,SEAICE TRANA2O1.134
REAL TRANA2O1.135
+ SNOWOUT(IMT,JMT), ! OUT SNOWFALL RATE FOR OCEAN TRANA2O1.136
+ SUBLMOUT(IMT,JMT), ! OUT SUBLIMATION RATE TRANA2O1.137
+ BTMLTOUT(IMT,JMT), ! OUT DIFFUSIVE HEAT FLUX THROUGH ICE TRANA2O1.138
+ ! (POSITIVE DOWNWARDS) TRANA2O1.139
+ TPMLTOUT(IMT,JMT) ! OUT SEAICE TOP MELTING HEAT FLUX TRANA2O1.140
*ENDIF TRANA2O1.141
*IF DEF,RIVERS TRANA2O1.142
REAL TRANA2O1.143
+ RIVEROUT(IMT,JMT) ! OUT TOTAL RIVER OUTFLOW AT COASTAL PTS. TRANA2O1.144
C INTEGRATED OVER RIVER BASINS (KG M-2 S-1) TRANA2O1.145
*ENDIF TRANA2O1.146
&,ATMCO2_OUT(CO2_IMT,CO2_JMT) ! OUT ATMOS CO2 CONC CCN1F405.185
CCN1F405.186
C* TRANA2O1.147
C EXTERNAL SUBPROGRAMS CALLED TRANA2O1.148
C TRANA2O1.149
EXTERNAL ROWSWAP,CYCLICBC,PRE_AREAVER,DO_AREAVER CJG6F401.41
*IF DEF,TRANGRID TRANA2O1.151
EXTERNAL H_INT_CO,H_INT_BL,COAST_AJ,POST_H_INT UDG1F400.360
*ELSE TRANA2O1.153
EXTERNAL COPYA2O TRANA2O1.154
external chk1box OJG1F403.56
*ENDIF TRANA2O1.155
C TRANA2O1.156
C LOCAL VARIABLES TRANA2O1.157
C TRANA2O1.158
INTEGER TRANA2O1.159
+ I,J,K,L,LANDPT, ! LOOP COUNTERS TRANA2O1.160
+ IJMT, ! NUMBER OF POINTS ON OCEAN TS GRID. TRANA2O1.161
+ IJMTM1, ! NUMBER OF POINTS ON OCEAN UV GRID. TRANA2O1.162
+ IRT,IRU ! NUMBER OF COLUMNS OF DISTINCT VALUES TRANA2O1.163
+ ! on ocean TS and UV grids TRANA2O1.164
C TRANA2O1.165
LOGICAL OMASK(IMT,JMT) ! FALSE IF POINT IS SEA IN OCEAN MODEL TRANA2O1.166
REAL TRANA2O1.167
+ WORK(IMT,JMT), ! WORK ARRAY (ON OCEAN GRID). TRANA2O1.168
+ WORKA(ICOLS,JROWS) ! WORK ARRAY (ON ATMOSPHERE GRID). TRANA2O1.169
*IF DEF,TRANGRID TRANA2O1.170
C TRANA2O1.171
C N.B. THE NEXT 8 ARRAYS ARE USED FOR BOTH TYPES OF GRID POINT. TRANA2O1.172
C THEY ARE FIRST FILLED WITH THE COORDINATES OF UV POINTS, AND TRANA2O1.173
C THE INTERPOLATION WEIGHTS THAT APPLY TO THEM. AFTER SECTION 1 TRANA2O1.174
C THEY ARE REUSED TO STORE THE CORRESPONDING INFORMATION ABOUT TRANA2O1.175
C THE TS GRID. TRANA2O1.176
C TRANA2O1.177
REAL TRANA2O1.178
+ ATLAMBDA(ICOLS), ! LONGITUDE COORDS OF COLUMNS IN ATMOSPHERIC TRANA2O1.179
+ ! GRID, IN DEGREES. TRANA2O1.180
+ ATPHI(JROWS), ! LATITUDE COORDS OF ROWS IN ATMOSPHERIC TRANA2O1.181
+ ! GRID, IN DEGREES. TRANA2O1.182
+ OCLAMBDA(IMT*JMT), ! LONGITUDE OF SEA POINTS ON OCEAN GRID TRANA2O1.183
+ OCPHI(IMT*JMT), ! LATITUDE OF SEA POINTS ON OCEAN GRID TRANA2O1.184
+ WEIGHTTR(IMT,JMT), ! WEIGHTS OF 'TOP RIGHT' CORNERS TRANA2O1.185
+ WEIGHTTL(IMT,JMT), ! WEIGHTS OF 'TOP LEFT' CORNERS TRANA2O1.186
+ WEIGHTBR(IMT,JMT), ! WEIGHTS OF 'BOTTOM RIGHT' CORNERS TRANA2O1.187
+ WEIGHTBL(IMT,JMT) ! WEIGHTS OF 'BOTTOM LEFT' CORNERS TRANA2O1.188
C TRANA2O1.189
INTEGER TRANA2O1.190
+ INDEXO(IMT*JMT), ! INDEX OF COASTAL POINTS (FROM COAST_AJ). TRANA2O1.191
+ INDEXA(IMT*JMT), ! INDEX OF CORRESPONDING ATMOSPHERE POINTS. TRANA2O1.192
+ NCOASTAL ! NUMBER OF COASTAL POINTS DETECTED. TRANA2O1.193
&,OMINT(IMT*JMT) ! INTEGER LAND-SEA MASK ON OCEAN GRID TRANA2O1.194
&,AMINT(ICOLS,JROWS) ! INTEGER LAND-SEA MASK ON ATMOSPHERE GRID TRANA2O1.195
&,SEAPOINTS ! NUMBER OF SEA POINTS IN OCEAN MASK TRANA2O1.196
&,OCPOINTS ! NUMBER OF POINTS IN OCEAN GRID TRANA2O1.197
&,OCPOINT(IMT*JMT) ! LIST OF SEA POINTS IN OCEAN GRID TRANA2O1.198
&,ATPOINTS ! NUMBER OF POINTS IN ATMOSPHERE GRID TRANA2O1.199
C TRANA2O1.200
C THE NEXT FOUR VARIABLES ARE NECESSARY TO SATISFY THE ARGUMENT TRANA2O1.201
C LIST OF COAST_AJ. THEY ARE NOT USED FOR ANYTHING IN THIS ROUTINE. TRANA2O1.202
C TRANA2O1.203
INTEGER TRANA2O1.204
+ IDUMMY1(IMT,JMT), ! DUMMY ARGUMENT FOR CALL TO COAST_AJ. TRANA2O1.205
+ IDUMMY2(IMT,JMT), ! DUMMY ARGUMENT FOR CALL TO COAST_AJ. TRANA2O1.206
+ N1, ! DUMMY ARGUMENT FOR CALL TO COAST_AJ. TRANA2O1.207
+ N2 ! DUMMY ARGUMENT FOR CALL TO COAST_AJ. TRANA2O1.208
C TRANA2O1.209
INTEGER TRANA2O1.210
+ INDEXBL(IMT,JMT), ! GATHER INDICES FOR INTERPOLATION. TRANA2O1.211
+ INDEXBR(IMT,JMT) ! GATHER INDICES FOR INTERPOLATION. TRANA2O1.212
*IF DEF,AVER_TAO,OR,DEF,CSRV_TAO OJG1F403.57
C CJG6F401.43
C Local arrays required for area-averaging CJG6F401.44
C CJG6F401.45
integer CJG6F401.46
& lenl ! length of lists on the target grid CJG6F401.47
&,index_arav(maxl) ! list of source boxes for target boxes OJG1F403.58
real CJG6F401.51
& weight(maxl) ! weights for source boxes OJG1F403.59
&,ocyd(jmt+1) ! O latitudes in decreasing order CJG6F401.53
logical CJG6F401.54
& omaskd(imt,jmt) ! O mask with lats in decreasing order CJG6F401.55
*IF DEF,AVER_TAO OJG1F403.60
integer OJG1F403.61
& count_o(imt*jmt) ! number of A boxes per O box OJG1F403.62
&,base_o(imt*jmt) ! first index in A box list OJG1F403.63
*ELSE OJG1F403.64
integer OJG1F403.65
& count_a(icols*jrows) ! number of O boxes per A box OJG1F403.66
&,base_a(icols*jrows) ! first index in O box list OJG1F403.67
*ENDIF CJG6F401.56
*ENDIF TRANA2O1.213
*ENDIF OJG1F403.68
LOGICAL AMASKUV(ICOLS,JROWSM1) ! ATMOSPHERE MASK ON UV GRID OOM3F403.4
C TRANA2O1.214
C ---------------------------------------------------------- TRANA2O1.215
C TRANA2O1.216
CL Section 0: No. of distinct columns in ocean TRANA2O1.217
C TRANA2O1.218
IF (CYCLIC) THEN TRANA2O1.219
IRT=IMT-2 TRANA2O1.220
IRU=IRT TRANA2O1.221
ELSE TRANA2O1.222
IRT=IMT TRANA2O1.223
IRU=IMT-1 TRANA2O1.224
ENDIF TRANA2O1.225
C TRANA2O1.226
CL SECTION 1: Preparation for U grids TRANA2O1.227
C TRANA2O1.228
C USE THE OCEAN NUMBER OF UV LEVELS TO IDENTIFY THE CJG6F401.57
C GRID POINTS WHERE WIND STRESSES ARE REQUIRED, AND SET THE TRANA2O1.230
C MASK ARRAY TO .FALSE. AT THOSE POINTS, AND .TRUE. ELSEWHERE. TRANA2O1.231
C (THIS CONVENTION IS CHOSEN IN ORDER TO BE CONSISTENT WITH TRANA2O1.232
C THE CONVENTION IN THE ATMOSPHERIC MODEL.) TRANA2O1.233
C TRANA2O1.234
DO 30 J = 1,JMTM1 TRANA2O1.235
DO 25 I = 1,IMT TRANA2O1.236
OMASK(I,J) = FKMQ(I,J).LT.0.1 CJG6F401.58
25 CONTINUE TRANA2O1.238
30 CONTINUE TRANA2O1.239
C OOM3F403.5
*IF DEF,CADJ_UAO OOM3F403.6
C set up logical land/sea mask on atmosphere UV grid OOM3F403.7
DO J=1,JROWSM1 OOM3F403.8
DO I=1,ICOLS-1 OOM3F403.9
AMASKUV(I,J)=AMASKTP(I,J).OR.AMASKTP(I+1,J) OOM3F403.10
+ .OR.AMASKTP(I,J+1).OR.AMASKTP(I+1,J+1) OOM3F403.11
ENDDO OOM3F403.12
AMASKUV(ICOLS,J)=AMASKTP(ICOLS,J).OR.AMASKTP(1,J) OOM3F403.13
+ .OR.AMASKTP(ICOLS,J+1).OR.AMASKTP(1,J+1) OOM3F403.14
ENDDO OOM3F403.15
*ENDIF OOM3F403.16
C TRANA2O1.240
*IF DEF,TRANGRID TRANA2O1.241
C TRANA2O1.242
C SET UP THE ARRAYS OF COORDINATES AND INDICES FOR INTERPOLATION TRANA2O1.243
C TRANA2O1.244
OCPOINTS=0 TRANA2O1.245
SEAPOINTS=0 TRANA2O1.246
DO 1010 J=1,JMTM1 TRANA2O1.247
DO 1020 I=1,IMT TRANA2O1.248
OCPOINTS=OCPOINTS+1 TRANA2O1.249
IF (.NOT.OMASK(I,J).AND.I.LE.IRU) THEN TRANA2O1.250
SEAPOINTS=SEAPOINTS+1 TRANA2O1.251
OCLAMBDA(SEAPOINTS)=XUO(I) TRANA2O1.252
OCPHI(SEAPOINTS)=YUO(J) TRANA2O1.253
OCPOINT(SEAPOINTS)=OCPOINTS TRANA2O1.254
*IF DEF,CADJ_UAO OOM3F403.17
OMINT(SEAPOINTS)=0 OOM3F403.18
*ENDIF OOM3F403.19
ENDIF TRANA2O1.255
1020 CONTINUE TRANA2O1.256
1010 CONTINUE TRANA2O1.257
DO 1030 I=1,ICOLS TRANA2O1.258
ATLAMBDA(I)=XUA(I) TRANA2O1.259
1030 CONTINUE TRANA2O1.260
DO 1040 J=1,JROWSM1 TRANA2O1.261
ATPHI(J)=YUA(J) TRANA2O1.262
1040 CONTINUE TRANA2O1.263
ATPOINTS=ICOLS*JROWSM1 TRANA2O1.264
C TRANA2O1.265
*IF DEF,CADJ_UAO OOM3F403.20
C CONSTRUCT AN INTEGER LAND-SEA MASK ON THE ATMOSPHERE UV GRID OOM3F403.21
C OOM3F403.22
DO J=1,JROWSM1 OOM3F403.23
DO I=1,ICOLS OOM3F403.24
IF (AMASKUV(I,J)) THEN OOM3F403.25
AMINT(I,J)=1 OOM3F403.26
ELSE OOM3F403.27
AMINT(I,J)=0 OOM3F403.28
ENDIF OOM3F403.29
ENDDO OOM3F403.30
ENDDO OOM3F403.31
*ENDIF OOM3F403.32
C FIND THE ARRAYS OF INTERPOLATION WEIGHTS AND GATHER INDICES TRANA2O1.266
C TRANA2O1.267
CALL H_INT_CO(INDEXBL,INDEXBR,WEIGHTTR,WEIGHTBR,WEIGHTTL, TRANA2O1.268
+ WEIGHTBL,ATLAMBDA,ATPHI,OCLAMBDA,OCPHI,ICOLS,JROWSM1, TRANA2O1.269
+ SEAPOINTS,.TRUE.) TRANA2O1.270
C TRANA2O1.271
*IF DEF,CADJ_UAO OOM3F403.33
C OOM3F403.34
C FIND THE GATHER INDICES FOR RESETTING VALUES NEAR THE OOM3F403.35
C COASTLINES, AFTER INTERPOLATIONS. OOM3F403.36
C OOM3F403.37
CALL COAST_AJ(INDEXBL,INDEXBR,WEIGHTTR,WEIGHTBR,WEIGHTTL, OOM3F403.38
+ WEIGHTBL,ICOLS,JROWSM1,SEAPOINTS,AMINT,OMINT,INDEXO,INDEXA, OOM3F403.39
+ NCOASTAL,.TRUE.,IDUMMY1,N1,IDUMMY2,N2) OOM3F403.40
*ENDIF OOM3F403.41
*IF -DEF,CADJ_UAO OOM3F403.42
C Set number of coastal points to zero for calls to POST_H_INT OOM3F403.43
NCOASTAL=0 OOM3F403.44
*ENDIF OOM3F403.45
*ENDIF TRANA2O1.272
C TRANA2O1.273
CL SECTION 2: Transfer of wind stress TRANA2O1.274
*IF DEF,TRANGRID TRANA2O1.275
C NOTE THAT THE COMPONENTS OF WIND STRESS ARE INTERPOLATED AS IF TRANA2O1.276
C THEY WERE SCALARS, WHICH IS NOT QUITE CORRECT. TRANA2O1.277
C NOTE THAT WIND STRESS VALUES ARE NOT RESET NEAR COASTS USING TRANA2O1.278
C COAST_AJ. THIS MAY HAVE TO BE RECONSIDERED IF POOR RESULTS TRANA2O1.279
C ARE OBTAINED. The first part of POST_H_INT is effectively TRANA2O1.280
C switched off by specifying 0 coastal points. TRANA2O1.281
*ENDIF TRANA2O1.282
C TRANA2O1.283
CL Section 2.1: ZONAL COMPONENT. TRANA2O1.284
C TRANA2O1.285
*IF DEF,TRANGRID TRANA2O1.286
CALL H_INT_BL(JROWSM1,ICOLS,SEAPOINTS,INDEXBL,INDEXBR,USTRSIN CCC1F401.3
&, WEIGHTBL,WEIGHTBR,WEIGHTTL,WEIGHTTR,WORK) UDG1F400.362
C perform coastal adjustment with land points masked out OOM3F403.46
CALL POST_H_INT(NCOASTAL,INDEXA,INDEXO,ATPOINTS,USTRSIN,AMINT OOM3F403.47
&,SEAPOINTS,WORK,OCPOINT,RMDI,OCPOINTS,USTRSOUT) OOM3F403.48
OOM3F403.49
*ELSE TRANA2O1.291
CALL COPYA2O(ICOLS,JROWSM1,USTRSIN,INVERT,IMT,.FALSE.,OMASK TRANA2O1.292
&,USTRSOUT) TRANA2O1.293
*ENDIF TRANA2O1.294
IF (CYCLIC) CALL CYCLICBC(USTRSOUT,IMT,JMTM1) TRANA2O1.295
C TRANA2O1.296
C Section 2.2: MERIDIONAL COMPONENT. TRANA2O1.297
C TRANA2O1.298
*IF DEF,TRANGRID TRANA2O1.299
CALL H_INT_BL(JROWSM1,ICOLS,SEAPOINTS,INDEXBL,INDEXBR,VSTRSIN CCC1F401.4
&, WEIGHTBL,WEIGHTBR,WEIGHTTL,WEIGHTTR,WORK) UDG1F400.364
C perform coastal adjustment with land points masked out OOM3F403.50
CALL POST_H_INT(NCOASTAL,INDEXA,INDEXO,ATPOINTS,VSTRSIN,AMINT OOM3F403.51
&,SEAPOINTS,WORK,OCPOINT,RMDI,OCPOINTS,VSTRSOUT) OOM3F403.52
OOM3F403.53
*ELSE TRANA2O1.304
CALL COPYA2O(ICOLS,JROWSM1,VSTRSIN,INVERT,IMT,.FALSE.,OMASK TRANA2O1.305
&,VSTRSOUT) TRANA2O1.306
*ENDIF TRANA2O1.307
IF (CYCLIC) CALL CYCLICBC(VSTRSOUT,IMT,JMTM1) TRANA2O1.308
C TRANA2O1.309
CL SECTION 3: PREPARATIONS FOR T GRIDS TRANA2O1.310
C TRANA2O1.311
C USE THE OCEAN MODEL NUMBER OF TS LEVELS TO IDENTIFY THE CJG6F401.59
C GRID POINTS WHERE HEAT FLUXES ETC ARE REQUIRED, AND SET THE TRANA2O1.313
C MASK ARRAY TO .FALSE. AT THOSE POINTS, AND .TRUE. ELSEWHERE. TRANA2O1.314
C TRANA2O1.315
DO 210 J = 1,JMT TRANA2O1.316
DO 205 I = 1,IMT TRANA2O1.317
OMASK(I,J) = FKMP(I,J).LT.0.1 CJG6F401.60
205 CONTINUE TRANA2O1.319
210 CONTINUE TRANA2O1.320
C TRANA2O1.321
*IF DEF,TRANGRID TRANA2O1.322
*IF -DEF,AVER_TAO CJG6F401.61
C TRANA2O1.323
C SET UP THE ARRAYS OF COORDINATES AND INDICES FOR INTERPOLATION TRANA2O1.324
C CONSTRUCT AN INTEGER LAND-SEA MASK ON THE OCEAN GRID TRANA2O1.325
C TRANA2O1.326
OCPOINTS=0 TRANA2O1.327
SEAPOINTS=0 TRANA2O1.328
DO 1050 J=1,JMT TRANA2O1.329
DO 1060 I=1,IMT TRANA2O1.330
OCPOINTS=OCPOINTS+1 TRANA2O1.331
IF (.NOT.OMASK(I,J).AND.I.LE.IRT) THEN TRANA2O1.332
SEAPOINTS=SEAPOINTS+1 TRANA2O1.333
OCLAMBDA(SEAPOINTS)=XTO(I) TRANA2O1.334
OCPHI(SEAPOINTS)=YTO(J) TRANA2O1.335
OCPOINT(SEAPOINTS)=OCPOINTS TRANA2O1.336
OMINT(SEAPOINTS)=0 TRANA2O1.337
ENDIF TRANA2O1.338
1060 CONTINUE TRANA2O1.339
1050 CONTINUE TRANA2O1.340
DO 1070 I=1,ICOLS TRANA2O1.341
ATLAMBDA(I)=XTA(I) TRANA2O1.342
1070 CONTINUE TRANA2O1.343
DO 1080 J=1,JROWS TRANA2O1.344
ATPHI(J)=YTA(J) TRANA2O1.345
1080 CONTINUE TRANA2O1.346
ATPOINTS=ICOLS*JROWS TRANA2O1.347
C TRANA2O1.348
C CONSTRUCT AN INTEGER LAND-SEA MASK ON THE ATMOSPHERE GRID TRANA2O1.349
C TRANA2O1.350
DO J=1,JROWS TRANA2O1.351
DO I=1,ICOLS TRANA2O1.352
IF (AMASKTP(I,J)) THEN TRANA2O1.353
AMINT(I,J)=1 TRANA2O1.354
ELSE TRANA2O1.355
AMINT(I,J)=0 TRANA2O1.356
ENDIF TRANA2O1.357
ENDDO TRANA2O1.358
ENDDO TRANA2O1.359
C TRANA2O1.360
C FIND THE ARRAYS OF INTERPOLATION WEIGHTS AND GATHER INDICES TRANA2O1.361
C TRANA2O1.362
CALL H_INT_CO(INDEXBL,INDEXBR,WEIGHTTR,WEIGHTBR,WEIGHTTL, TRANA2O1.363
+ WEIGHTBL,ATLAMBDA,ATPHI,OCLAMBDA,OCPHI,ICOLS, TRANA2O1.364
+ JROWS,SEAPOINTS,.TRUE.) TRANA2O1.365
C TRANA2O1.366
C FIND THE GATHER INDICES FOR RESETTING VALUES NEAR THE TRANA2O1.367
C COASTLINES, AFTER INTERPOLATIONS. TRANA2O1.368
C TRANA2O1.369
CALL COAST_AJ(INDEXBL,INDEXBR,WEIGHTTR,WEIGHTBR,WEIGHTTL, TRANA2O1.370
+ WEIGHTBL,ICOLS,JROWS,SEAPOINTS,AMINT,OMINT,INDEXO,INDEXA, TRANA2O1.371
+ NCOASTAL,.TRUE.,IDUMMY1,N1,IDUMMY2,N2) TRANA2O1.372
C TRANA2O1.373
*ENDIF OJG1F403.69
*IF DEF,AVER_TAO,OR,DEF,CSRV_TAO OJG1F403.70
C CJG6F401.63
C Fill array OCYD with the y-coordinates of the box boundaries CJG6F401.64
C in decreasing order, and OMASKD with the ocean mask with CJG6F401.65
C corresponding row order. CJG6F401.66
C CJG6F401.67
if (invert) then CJG6F401.68
do j=1,jmt+1 CJG6F401.69
ocyd(j)=yuo(jmt+1-j) CJG6F401.70
enddo CJG6F401.71
do j=1,jmt CJG6F401.72
do i=1,imt CJG6F401.73
omaskd(i,j)=omask(i,jmt+1-j) CJG6F401.74
enddo CJG6F401.75
enddo CJG6F401.76
else CJG6F401.77
do j=1,jmt+1 CJG6F401.78
ocyd(j)=yuo(j) CJG6F401.79
enddo CJG6F401.80
do j=1,jmt CJG6F401.81
do i=1,imt CJG6F401.82
omaskd(i,j)=omask(i,j) CJG6F401.83
enddo CJG6F401.84
enddo CJG6F401.85
endif CJG6F401.86
lenl=maxl CJG6F401.87
*IF DEF,AVER_TAO OJG1F403.71
call pre_areaver(icols,xua,jrows,yua,.true.,icols,.false. CJG6F401.88
&,amasktp,irt,xuo,jmt,ocyd,global,.true. CJG6F401.89
&,lenl,count_o,base_o,index_arav,weight,icode,cmessage) OJG1F403.72
*ELSE OJG1F403.73
call pre_areaver(irt,xuo,jmt,ocyd,global,imt,.false. OJG1F403.74
&,omaskd,icols,xua,jrows,yua,.true.,.true. OJG1F403.75
&,lenl,count_a,base_a,index_arav,weight,icode,cmessage) OJG1F403.76
call chk1box(lenl,index_arav,irt,jmt,icode,cmessage) OJG1F403.77
if (icode.ne.0) return OJG1F403.78
*ENDIF OJG1F403.79
*ENDIF CJG6F401.91
*ENDIF TRANA2O1.374
C TRANA2O1.375
CL SECTION 4: WIND MIXING POWER. TRANA2O1.376
C TRANA2O1.377
*IF DEF,TRANGRID TRANA2O1.378
*IF -DEF,AVER_TAO CJG6F401.92
CALL H_INT_BL(JROWS,ICOLS,SEAPOINTS,INDEXBL,INDEXBR,WMIXIN CCC1F401.5
&, WEIGHTBL,WEIGHTBR,WEIGHTTL,WEIGHTTR,WORK) UDG1F400.366
CALL POST_H_INT(NCOASTAL,INDEXA,INDEXO,ATPOINTS,WMIXIN,AMINT TRANA2O1.381
&,SEAPOINTS,WORK,OCPOINT,RMDI,OCPOINTS,WMIXOUT) TRANA2O1.382
*IF DEF,CSRV_TAO OJG1F403.80
call do_areaver(irt,jmt,imt,invert,wmixout,icols,jrows OJG1F403.81
&,count_a,base_a,icols,.false.,amasktp,index_arav,weight,2 OJG1F403.82
&,wmixin,icode,cmessage) OJG1F403.83
*ENDIF OJG1F403.84
*ELSE TRANA2O1.383
call do_areaver(icols,jrows,icols,.false.,wmixin,irt,jmt OJG1F403.85
&,count_o,base_o,imt,.false.,omaskd,index_arav,weight,0 OJG1F403.86
&,work,icode,cmessage) CJG6F401.95
call copya2o(imt,jmt,work,invert,imt,.false.,omask,wmixout) CJG6F401.96
*ENDIF CJG6F401.97
*ELSE CJG6F401.98
CALL COPYA2O(ICOLS,JROWS,WMIXIN,INVERT,IMT,.FALSE.,OMASK TRANA2O1.384
&,WMIXOUT) TRANA2O1.385
*ENDIF TRANA2O1.386
IF (CYCLIC) CALL CYCLICBC(WMIXOUT,IMT,JMT) TRANA2O1.387
C TRANA2O1.388
CL SECTION 5: PENETRATING COMPONENT OF SHORTWAVE RADIATION. TRANA2O1.389
C TRANA2O1.390
C BECAUSE BLUE LIGHT PENETRATES FURTHEST, THE VARIABLES INVOLVED TRANA2O1.391
C ARE CALLED BLUEIN AND BLUEOUT. HOWEVER, AT PRESENT (V1.1) TRANA2O1.392
C THEY ACTUALLY EMBRACE ALL THE VISIBLE SPECTRUM AS WELL AS TRANA2O1.393
C THE NEAR ULTRA-VIOLET AND THE VERY NEAR INFRA-RED. TRANA2O1.394
C THIS IS ALLOWED FOR IN THE OCEAN MODEL. TRANA2O1.395
C TRANA2O1.396
C *** NB: WHEN RUNNING COUPLED AT PRESENT (11/09/91), OR WITH ANCILLARY TRANA2O1.397
C *** FIELDS WHICH ONLY INCLUDE PENETR. SOLAR IN THE "SOL" FIELD, TRANA2O1.398
C *** THE INPUT NAMELIST CONSTANT "RSOL" SHOULD BE SET TO 0.0 AND TRANA2O1.399
C *** ETA2 SET TO THE PENETRATION SCALE FOR THE DEEPLY PENTRATING TRANA2O1.400
C *** RADIATION. TRANA2O1.401
C TRANA2O1.402
*IF DEF,TRANGRID TRANA2O1.403
*IF -DEF,AVER_TAO CJG6F401.99
CALL H_INT_BL(JROWS,ICOLS,SEAPOINTS,INDEXBL,INDEXBR,BLUEIN CCC1F401.6
&, WEIGHTBL,WEIGHTBR,WEIGHTTL,WEIGHTTR,WORK) UDG1F400.368
CALL POST_H_INT(NCOASTAL,INDEXA,INDEXO,ATPOINTS,BLUEIN,AMINT TRANA2O1.406
&,SEAPOINTS,WORK,OCPOINT,RMDI,OCPOINTS,BLUEOUT) TRANA2O1.407
*IF DEF,CSRV_TAO OJG1F403.87
call do_areaver(irt,jmt,imt,invert,blueout,icols,jrows OJG1F403.88
&,count_a,base_a,icols,.false.,amasktp,index_arav,weight,2 OJG1F403.89
&,bluein,icode,cmessage) OJG1F403.90
*ENDIF OJG1F403.91
*ELSE TRANA2O1.408
call do_areaver(icols,jrows,icols,.false.,bluein,irt,jmt OJG1F403.92
&,count_o,base_o,imt,.false.,omaskd,index_arav,weight,0 OJG1F403.93
&,work,icode,cmessage) CJG6F401.102
call copya2o(imt,jmt,work,invert,imt,.false.,omask,blueout) CJG6F401.103
*ENDIF CJG6F401.104
*ELSE CJG6F401.105
CALL COPYA2O(ICOLS,JROWS,BLUEIN,INVERT,IMT,.FALSE.,OMASK TRANA2O1.409
&,BLUEOUT) TRANA2O1.410
*ENDIF TRANA2O1.411
IF (CYCLIC) CALL CYCLICBC(BLUEOUT,IMT,JMT) TRANA2O1.412
C TRANA2O1.413
CL SECTION 6: NON-PENETRATIVE SURFACE HEAT FLUXES. TRANA2O1.414
C TRANA2O1.415
C NOTICE THAT THE BLUE END OF THE SOLAR SPECTRUM HAS TO BE TRANA2O1.416
C SUBTRACTED OUT HERE. IT SHOULD ALSO BE POINTED OUT THAT AT TRANA2O1.417
C SEA-ICE POINTS (IF THEY EXIST), THE SENSIBLE HEAT FLUX AND TRANA2O1.418
C THE EVAPORATION WERE ALREADY WEIGHTED BY THE FRACTIONAL AREA TRANA2O1.419
C OF LEADS WHEN THEY WERE DIAGNOSED, SO NO SPECIAL CODE IS TRANA2O1.420
C NECESSARY HERE. TRANA2O1.421
C TRANA2O1.422
DO 510 J = 1,JROWS TRANA2O1.423
DO 505 I = 1,ICOLS TRANA2O1.424
WORKA(I,J) = SOLARIN(I,J) - BLUEIN(I,J) + LONGWAVE(I,J) TRANA2O1.425
+ - ( SENSIBLE(I,J) + LC*EVAP(I,J) ) TRANA2O1.426
505 CONTINUE TRANA2O1.427
510 CONTINUE TRANA2O1.428
*IF DEF,TRANGRID TRANA2O1.429
*IF -DEF,AVER_TAO CJG6F401.106
CALL H_INT_BL(JROWS,ICOLS,SEAPOINTS,INDEXBL,INDEXBR,WORKA CCC1F401.7
&, WEIGHTBL,WEIGHTBR,WEIGHTTL,WEIGHTTR,WORK) UDG1F400.370
CALL POST_H_INT(NCOASTAL,INDEXA,INDEXO,ATPOINTS,WORKA,AMINT TRANA2O1.432
&,SEAPOINTS,WORK,OCPOINT,RMDI,OCPOINTS,HEATFLUX) TRANA2O1.433
*IF DEF,CSRV_TAO OJG1F403.94
call do_areaver(irt,jmt,imt,invert,heatflux,icols,jrows OJG1F403.95
&,count_a,base_a,icols,.false.,amasktp,index_arav,weight,1 OJG1F403.96
&,worka,icode,cmessage) OJG1F403.97
*ENDIF OJG1F403.98
*ELSE TRANA2O1.434
call do_areaver(icols,jrows,icols,.false.,worka,irt,jmt OJG1F403.99
&,count_o,base_o,imt,.false.,omaskd,index_arav,weight,0 OJG1F403.100
&,work,icode,cmessage) CJG6F401.109
call copya2o(imt,jmt,work,invert,imt,.false.,omask,heatflux) CJG6F401.110
*ENDIF CJG6F401.111
*ELSE CJG6F401.112
CALL COPYA2O(ICOLS,JROWS,WORKA,INVERT,IMT,.FALSE.,OMASK TRANA2O1.435
&,HEATFLUX) TRANA2O1.436
*ENDIF TRANA2O1.437
IF (CYCLIC) CALL CYCLICBC(HEATFLUX,IMT,JMT) TRANA2O1.438
C TRANA2O1.439
CL SECTION 7: PRECIPITATION MINUS EVAPORATION. TRANA2O1.440
C TRANA2O1.441
DO 610 J = 1,JROWS TRANA2O1.442
DO 605 I = 1,ICOLS TRANA2O1.443
WORKA(I,J) = SNOWLS(I,J) + SNOWCONV(I,J) TRANA2O1.444
*IF DEF,SEAICE TRANA2O1.445
C TRANA2O1.446
C SEA-ICE INTERCEPTS SNOWFALL, SO MULTIPLY THE SNOW CONTRIBUTION TRANA2O1.447
C TO 'P-E' BY THE AREAL FRACTION OF LEADS. NOTE THAT THIS IS NOT TRANA2O1.448
C DONE FOR RAINFALL, WHICH IS ASSUMED TO RUN OFF. ALSO, EVAPORATION TRANA2O1.449
C IS WEIGHTED BY THE LEAD AREA WHEN DIAGNOSED, SO THERE IS NO NEED TRANA2O1.450
C TO DO IT AGAIN HERE. TRANA2O1.451
C TRANA2O1.452
WORKA(I,J) = WORKA(I,J)*(1.0 - AICE(I,J)) TRANA2O1.453
*ENDIF TRANA2O1.454
WORKA(I,J) = WORKA(I,J) + RAINLS(I,J) + RAINCONV(I,J) TRANA2O1.455
+ - EVAP(I,J) TRANA2O1.456
605 CONTINUE TRANA2O1.457
610 CONTINUE TRANA2O1.458
C TRANA2O1.459
*IF DEF,TRANGRID TRANA2O1.460
*IF -DEF,AVER_TAO CJG6F401.113
CALL H_INT_BL(JROWS,ICOLS,SEAPOINTS,INDEXBL,INDEXBR,WORKA CCC1F401.8
&, WEIGHTBL,WEIGHTBR,WEIGHTTL,WEIGHTTR,WORK) UDG1F400.372
CALL POST_H_INT(NCOASTAL,INDEXA,INDEXO,ATPOINTS,WORKA,AMINT TRANA2O1.463
&,SEAPOINTS,WORK,OCPOINT,RMDI,OCPOINTS,PMINUSE) TRANA2O1.464
*IF DEF,CSRV_TAO OJG1F403.101
call do_areaver(irt,jmt,imt,invert,pminuse,icols,jrows OJG1F403.102
&,count_a,base_a,icols,.false.,amasktp,index_arav,weight,1 OJG1F403.103
&,worka,icode,cmessage) OJG1F403.104
*ENDIF OJG1F403.105
*ELSE TRANA2O1.465
call do_areaver(icols,jrows,icols,.false.,worka,irt,jmt OJG1F403.106
&,count_o,base_o,imt,.false.,omaskd,index_arav,weight,0 OJG1F403.107
&,work,icode,cmessage) CJG6F401.116
call copya2o(imt,jmt,work,invert,imt,.false.,omask,pminuse) CJG6F401.117
*ENDIF CJG6F401.118
*ELSE CJG6F401.119
CALL COPYA2O(ICOLS,JROWS,WORKA,INVERT,IMT,.FALSE.,OMASK TRANA2O1.466
&,PMINUSE) TRANA2O1.467
*ENDIF TRANA2O1.468
IF (CYCLIC) CALL CYCLICBC(PMINUSE,IMT,JMT) TRANA2O1.469
*IF DEF,RIVERS TRANA2O1.470
C TRANA2O1.471
CL SECTION 8: RIVER OUTFLOW TRANA2O1.472
C TRANA2O1.473
C SUM THE RUNOFF FOR EACH OCEAN ENTRY POINT (K,L) :- TRANA2O1.474
C FOR EVERY LAND POINT (I,J) GET THE COORDINATES OF THE OCEAN ENTRY TRANA2O1.475
C POINT (K,L) FROM ARRAY OCENTPTS AND ADD THE RUNOFF FOR POINT (I,J) TRANA2O1.476
C TO POINT (K,L) - MULTIPLY BY THE RATIO OF AREAS OF SOURCE TO TARGET TRANA2O1.477
C GRIDBOX IN FORMING SUM; THIS GIVES A MASS FLUX PER UNIT AREA. TRANA2O1.478
C TRANA2O1.479
DO J=1,JROWS TRANA2O1.480
DO I=1,ICOLS TRANA2O1.481
WORKA(I,J)=0.0 TRANA2O1.482
ENDDO TRANA2O1.483
ENDDO TRANA2O1.484
LANDPT=0 TRANA2O1.485
DO J=1,JROWS TRANA2O1.486
DO I=1,ICOLS TRANA2O1.487
IF (AMASKTP(I,J)) THEN TRANA2O1.488
LANDPT=LANDPT+1 TRANA2O1.489
K=OCENTPTS(LANDPT)/100000 TRANA2O1.490
L=MOD(OCENTPTS(LANDPT),100000) TRANA2O1.491
WORKA(K,L)=WORKA(K,L)+RUNOFFIN(I,J)* TRANA2O1.492
& COS_P_LATITUDE(I,J)/COS_P_LATITUDE(K,L) TRANA2O1.493
ENDIF TRANA2O1.494
ENDDO TRANA2O1.495
ENDDO TRANA2O1.496
*IF DEF,TRANGRID TRANA2O1.497
*IF -DEF,AVER_TAO CJG6F401.120
CALL H_INT_BL(JROWS,ICOLS,SEAPOINTS,INDEXBL,INDEXBR,WORKA CCC1F401.9
&, WEIGHTBL,WEIGHTBR,WEIGHTTL,WEIGHTTR,WORK) UDG1F400.374
CALL POST_H_INT(NCOASTAL,INDEXA,INDEXO,ATPOINTS,WORKA,AMINT NT040193.2
&,SEAPOINTS,WORK,OCPOINT,RMDI,OCPOINTS,RIVEROUT) TRANA2O1.501
*IF DEF,CSRV_TAO OJG1F403.108
call do_areaver(irt,jmt,imt,invert,riverout,icols,jrows OJG1F403.109
&,count_a,base_a,icols,.false.,amasktp,index_arav,weight,2 OJG1F403.110
&,worka,icode,cmessage) OJG1F403.111
*ENDIF OJG1F403.112
*ELSE TRANA2O1.502
call do_areaver(icols,jrows,icols,.false.,worka,irt,jmt OJG1F403.113
&,count_o,base_o,imt,.false.,omaskd,index_arav,weight,0 OJG1F403.114
&,work,icode,cmessage) CJG6F401.123
call copya2o(imt,jmt,work,invert,imt,.false.,omask,riverout) CJG6F401.124
*ENDIF CJG6F401.125
*ELSE CJG6F401.126
CALL COPYA2O(ICOLS,JROWS,WORKA,INVERT,IMT,.FALSE.,OMASK TRANA2O1.503
&,RIVEROUT) TRANA2O1.504
*ENDIF TRANA2O1.505
IF (CYCLIC) CALL CYCLICBC(RIVEROUT,IMT,JMT) TRANA2O1.506
*ELSE TRANA2O1.507
C TRANA2O1.508
C NO RIVER OUTFLOW IN THIS MODEL, BECAUSE THE RIVERS TRANA2O1.509
C CODE SWITCH WAS NOT ENABLED. TRANA2O1.510
C TRANA2O1.511
*ENDIF TRANA2O1.512
*IF DEF,SEAICE TRANA2O1.513
C TRANA2O1.514
CL SECTION 9: SNOWFALL TRANA2O1.515
C TRANA2O1.516
DO 810 J = 1,JROWS TRANA2O1.517
DO 805 I = 1,ICOLS TRANA2O1.518
WORKA(I,J) = SNOWLS(I,J) + SNOWCONV(I,J) TRANA2O1.519
805 CONTINUE TRANA2O1.520
810 CONTINUE TRANA2O1.521
*IF DEF,TRANGRID TRANA2O1.522
*IF -DEF,AVER_TAO CJG6F401.127
CALL H_INT_BL(JROWS,ICOLS,SEAPOINTS,INDEXBL,INDEXBR,WORKA CCC1F401.10
&, WEIGHTBL,WEIGHTBR,WEIGHTTL,WEIGHTTR,WORK) UDG1F400.376
CALL POST_H_INT(NCOASTAL,INDEXA,INDEXO,ATPOINTS,WORKA,AMINT TRANA2O1.525
&,SEAPOINTS,WORK,OCPOINT,RMDI,OCPOINTS,SNOWOUT) TRANA2O1.526
*IF DEF,CSRV_TAO OJG1F403.115
call do_areaver(irt,jmt,imt,invert,snowout,icols,jrows OJG1F403.116
&,count_a,base_a,icols,.false.,amasktp,index_arav,weight,2 OJG1F403.117
&,worka,icode,cmessage) OJG1F403.118
*ENDIF OJG1F403.119
*ELSE CJG6F401.128
call do_areaver(icols,jrows,icols,.false.,worka,irt,jmt OJG1F403.120
&,count_o,base_o,imt,.false.,omaskd,index_arav,weight,0 OJG1F403.121
&,work,icode,cmessage) CJG6F401.131
call copya2o(imt,jmt,work,invert,imt,.false.,omask,snowout) CJG6F401.132
*ENDIF CJG6F401.133
*ELSE TRANA2O1.527
CALL COPYA2O(ICOLS,JROWS,WORKA,INVERT,IMT,.FALSE.,OMASK TRANA2O1.528
&,SNOWOUT) TRANA2O1.529
*ENDIF TRANA2O1.530
IF (CYCLIC) CALL CYCLICBC(SNOWOUT,IMT,JMT) TRANA2O1.531
C TRANA2O1.532
CL SECTION 10: SUBLIMATION TRANA2O1.533
C TRANA2O1.534
*IF DEF,TRANGRID TRANA2O1.535
*IF -DEF,AVER_TAO CJG6F401.134
CALL H_INT_BL(JROWS,ICOLS,SEAPOINTS,INDEXBL,INDEXBR,SUBLMIN CCC1F401.11
&, WEIGHTBL,WEIGHTBR,WEIGHTTL,WEIGHTTR,WORK) UDG1F400.378
CALL POST_H_INT(NCOASTAL,INDEXA,INDEXO,ATPOINTS,SUBLMIN,AMINT TRANA2O1.538
&,SEAPOINTS,WORK,OCPOINT,RMDI,OCPOINTS,SUBLMOUT) TRANA2O1.539
*IF DEF,CSRV_TAO OJG1F403.122
call do_areaver(irt,jmt,imt,invert,sublmout,icols,jrows OJG1F403.123
&,count_a,base_a,icols,.false.,amasktp,index_arav,weight,1 OJG1F403.124
&,sublmin,icode,cmessage) OJG1F403.125
*ENDIF OJG1F403.126
*ELSE CJG6F401.135
call do_areaver(icols,jrows,icols,.false.,sublmin,irt,jmt OJG1F403.127
&,count_o,base_o,imt,.false.,omaskd,index_arav,weight,0 OJG1F403.128
&,work,icode,cmessage) CJG6F401.138
call copya2o(imt,jmt,work,invert,imt,.false.,omask,sublmout) CJG6F401.139
*ENDIF CJG6F401.140
*ELSE TRANA2O1.540
CALL COPYA2O(ICOLS,JROWS,SUBLMIN,INVERT,IMT,.FALSE.,OMASK TRANA2O1.541
&,SUBLMOUT) TRANA2O1.542
*ENDIF TRANA2O1.543
IF (CYCLIC) CALL CYCLICBC(SUBLMOUT,IMT,JMT) TRANA2O1.544
C TRANA2O1.545
CL SECTION 11: SEA ICE DIFFUSIVE HEAT FLUX TRANA2O1.546
C TRANA2O1.547
*IF DEF,TRANGRID TRANA2O1.548
*IF -DEF,AVER_TAO CJG6F401.141
CALL H_INT_BL(JROWS,ICOLS,SEAPOINTS,INDEXBL,INDEXBR,BTMLTIN CCC1F401.12
&, WEIGHTBL,WEIGHTBR,WEIGHTTL,WEIGHTTR,WORK) UDG1F400.380
CALL POST_H_INT(NCOASTAL,INDEXA,INDEXO,ATPOINTS,BTMLTIN,AMINT TRANA2O1.551
&,SEAPOINTS,WORK,OCPOINT,RMDI,OCPOINTS,BTMLTOUT) TRANA2O1.552
*IF DEF,CSRV_TAO OJG1F403.129
call do_areaver(irt,jmt,imt,invert,btmltout,icols,jrows OJG1F403.130
&,count_a,base_a,icols,.false.,amasktp,index_arav,weight,1 OJG1F403.131
&,btmltin,icode,cmessage) OJG1F403.132
*ENDIF OJG1F403.133
*ELSE CJG6F401.142
call do_areaver(icols,jrows,icols,.false.,btmltin,irt,jmt OJG1F403.134
&,count_o,base_o,imt,.false.,omaskd,index_arav,weight,0 OJG1F403.135
&,work,icode,cmessage) CJG6F401.145
call copya2o(imt,jmt,work,invert,imt,.false.,omask,btmltout) CJG6F401.146
*ENDIF CJG6F401.147
*ELSE TRANA2O1.553
CALL COPYA2O(ICOLS,JROWS,BTMLTIN,INVERT,IMT,.FALSE.,OMASK TRANA2O1.554
&,BTMLTOUT) TRANA2O1.555
*ENDIF TRANA2O1.556
IF (CYCLIC) CALL CYCLICBC(BTMLTOUT,IMT,JMT) TRANA2O1.557
C TRANA2O1.558
CL SECTION 12: SEA ICE TOP MELT HEAT FLUX TRANA2O1.559
C TRANA2O1.560
*IF DEF,TRANGRID TRANA2O1.561
*IF -DEF,AVER_TAO CJG6F401.148
CALL H_INT_BL(JROWS,ICOLS,SEAPOINTS,INDEXBL,INDEXBR,TPMLTIN CCC1F401.13
&, WEIGHTBL,WEIGHTBR,WEIGHTTL,WEIGHTTR,WORK) UDG1F400.382
CALL POST_H_INT(NCOASTAL,INDEXA,INDEXO,ATPOINTS,TPMLTIN,AMINT TRANA2O1.564
&,SEAPOINTS,WORK,OCPOINT,RMDI,OCPOINTS,TPMLTOUT) TRANA2O1.565
*IF DEF,CSRV_TAO OJG1F403.136
call do_areaver(irt,jmt,imt,invert,tpmltout,icols,jrows OJG1F403.137
&,count_a,base_a,icols,.false.,amasktp,index_arav,weight,2 OJG1F403.138
&,tpmltin,icode,cmessage) OJG1F403.139
*ENDIF OJG1F403.140
*ELSE CJG6F401.149
call do_areaver(icols,jrows,icols,.false.,tpmltin,irt,jmt OJG1F403.141
&,count_o,base_o,imt,.false.,omaskd,index_arav,weight,0 OJG1F403.142
&,work,icode,cmessage) CJG6F401.152
call copya2o(imt,jmt,work,invert,imt,.false.,omask,tpmltout) CJG6F401.153
*ENDIF CJG6F401.154
*ELSE TRANA2O1.566
CALL COPYA2O(ICOLS,JROWS,TPMLTIN,INVERT,IMT,.FALSE.,OMASK TRANA2O1.567
&,TPMLTOUT) TRANA2O1.568
*ENDIF TRANA2O1.569
IF (CYCLIC) CALL CYCLICBC(TPMLTOUT,IMT,JMT) TRANA2O1.570
*ELSE TRANA2O1.571
C TRANA2O1.572
C NO SNOWFALL, SUBLIMATION OR SEA ICE HEAT FLUXES IN THIS MODEL, TRANA2O1.573
C BECAUSE THE SEAICE CODE SWITCH WAS NOT ENABLED. TRANA2O1.574
C TRANA2O1.575
*ENDIF TRANA2O1.576
C TRANA2O1.577
*IF -DEF,TRANGRID CCN1F405.187
C CCN1F405.188
CL SECTION 13: SURFACE ATMOSPHERIC CO2 CONCENTRATION. CCN1F405.189
C CCN1F405.190
C Only implement the COPYA2O call, because CCN1F405.191
C the carbon cycle is only being run in HaDCM3L where the grids CCN1F405.192
C are congruent. CCN1F405.193
C CCN1F405.194
C Note: units are converted from kg/kg to ppmv CCN1F405.195
C CCN1F405.196
IF (L_CO2_INTERACTIVE) THEN CCN1F405.197
CCN1F405.198
CALL COPYA2O(ICOLS,JROWS,ATMCO2,INVERT,IMT,.FALSE.,OMASK CCN1F405.199
& ,ATMCO2_OUT) CCN1F405.200
CCN1F405.201
IF (CYCLIC) CALL CYCLICBC(ATMCO2_OUT,IMT,JMT) CCN1F405.202
CCN1F405.203
do j=1,jmt CCN1F405.204
do i=1,imt CCN1F405.205
if (.not.OMASK(I,J)) then CCN1F405.206
ATMCO2_OUT(i,j) = ATMCO2_OUT(i,j) * CO2CONV_A2O CCN1F405.207
endif CCN1F405.208
enddo CCN1F405.209
enddo CCN1F405.210
ENDIF ! L_CO2_INTERACTIVE CCN1F405.211
*ENDIF CCN1F405.212
RETURN TRANA2O1.578
END TRANA2O1.579
*ENDIF TRANA2O1.580