SUBROUTINE TRANSO2A(TSTARIN,TSTAROUT,UIN,UOUT,VIN,VOUT, 2,40TRANO2A1.29
*IF DEF,SEAICE TRANO2A1.30
+ AICEIN,AICEOUT,HICEIN,HICEOUT,HSNOWIN,HSNOWOUT, TRANO2A1.31
*ENDIF TRANO2A1.32
& CO2FLUXIN, CO2FLUXOUT, CO2_ICOLS, CO2_JROWS, CO2_IMT, CO2_JMT, CCN1F405.317
*IF DEF,TRANGRID TRANO2A1.33
& XUO,XTO,YUO,YTO,XTA,XUA,YTA,YUA,AMASKTP, TRANO2A1.34
*ENDIF TRANO2A1.35
+ IMT,JMT,JMTM1,ICOLS,JROWS,JROWSM1,MAXL,FKMP,FKMQ, CJG6F401.11
+ INVERT,CYCLIC,GLOBAL,ZERODEGC,TFS,ICODE,CMESSAGE) CJT0F304.12
C TRANO2A1.38
C THIS ROUTINE CONSISTS OF UP TO 5 SECTIONS, ONE FOR EACH FIELD TRANO2A1.39
C TRANSFERRED FROM OCEAN TO ATMOSPHERE (COUNTING THE TWO COMPONENTS TRANO2A1.40
C OF THE SURFACE CURRENT AS ONE FIELD). SECTIONS 2,3 AND 4 ARE ONLY TRANO2A1.41
C PRESENT WHEN THE SEAICE SWITCH IS TURNED ON. TRANO2A1.42
C THE FLOW OF CONTROL IS STRAIGHTFORWARD. TRANO2A1.43
C TRANO2A1.44
IMPLICIT NONE TRANO2A1.45
C TRANO2A1.46
INTEGER TRANO2A1.47
+ IMT, ! IN NO. OF COLUMNS IN OCEAN TRANO2A1.48
+ JMT, ! IN NO. OF ROWS IN OCEAN (TS GRID) TRANO2A1.49
+ JMTM1, ! IN NO. OF ROWS IN OCEAN (UV GRID) TRANO2A1.50
+ ICOLS, ! IN NO. OF COLUMNS IN ATMOSPHERE TRANO2A1.51
+ JROWS, ! IN NO. OF ROWS IN ATMOSPHERE (TP GRID) TRANO2A1.52
+ JROWSM1, ! IN NO. OF ROWS IN ATMOSPHERE (UV GRID) TRANO2A1.53
& MAXL, ! IN max. list length for area-averaging TRANO2A1.54
+ ICODE ! IN OUT ERROR RETURN CODE. TRANO2A1.55
&,CO2_ICOLS,CO2_JROWS ! IN CO2 array dimensions CCN1F405.318
&,CO2_IMT, CO2_JMT CCN1F405.319
C TRANO2A1.56
LOGICAL TRANO2A1.57
+ INVERT, ! IN TRUE WHEN ROW INVERSION IS REQUIRED TRANO2A1.58
+ CYCLIC ! IN TRUE WHEN OCEAN HAS CYCLIC EW BOUNDS. TRANO2A1.59
&,GLOBAL ! IN TRUE WHEN OCEAN is global TRANO2A1.60
C TRANO2A1.61
REAL TRANO2A1.62
+ TSTARIN(IMT,JMT), ! IN TEMPERATURE OF OCEAN SURFACE LAYER TRANO2A1.63
+ TSTAROUT(ICOLS,JROWS),! INOUT SURFACE TEMPERATURE OF ATMOSPHERE TRANO2A1.64
+ UIN(IMT,JMTM1), ! IN ZONAL SURFACE CURRENT FROM OCEAN TRANO2A1.65
+ UOUT(ICOLS,JROWSM1), ! IN OUT ZONAL SURFACE CURRENT IN ATMOS TRANO2A1.66
+ VIN(IMT,JMTM1), ! IN MERID SURFACE CURRENT FROM OCEAN TRANO2A1.67
+ VOUT(ICOLS,JROWSM1), ! IN OUT MERID SURF CURRENT IN ATMOSPHERE TRANO2A1.68
+ ZERODEGC, ! IN KELVIN EQUIVALENT OF ZERO DEGREES C TRANO2A1.70
+ TFS ! IN FREEZING POINT OF SEAWATER IN K. TRANO2A1.71
&,FKMP(IMT,JMT) ! IN number of levels at ocean T points CJG6F401.12
&,FKMQ(IMT,JMT) ! IN number of levels at ocean U points CJG6F401.13
&,CO2FLUXIN(CO2_IMT,CO2_JMT) ! IN ocean co2 flux (mol/m2/yr) CCN1F405.322
&,CO2FLUXOUT(CO2_ICOLS,CO2_JROWS) ! INOUT ocean co2 flux CCN1F405.323
! (Kg CO2/m2/s) CCN1F405.324
CCN1F405.325
C TRANO2A1.72
CHARACTER*(*) CMESSAGE ! IN OUT TEXT OF ERROR MESSAGE. TRANO2A1.73
C TRANO2A1.74
*CALL CNTLATM 
CCN1F405.320
*CALL CCARBON CCN1F405.321
*CALL C_MDI CJT0F304.13
C CJT0F304.14
*IF DEF,SEAICE TRANO2A1.75
REAL TRANO2A1.76
+ AICEIN(IMT,JMT), ! INOUT ICE CONCENTRATION FROM OCEAN TRANO2A1.77
+ AICEOUT(ICOLS,JROWS), ! INOUT ICE CONCENTRATION IN ATMOS TRANO2A1.78
+ HICEIN(IMT,JMT), ! INOUT ICE DEPTH FROM OCEAN TRANO2A1.79
+ HICEOUT(ICOLS,JROWS), ! INOUT ICE DEPTH IN ATMOSPHERE TRANO2A1.80
+ HSNOWIN(IMT,JMT), ! INOUT SNOW DEPTH FROM OCEAN TRANO2A1.81
+ HSNOWOUT(ICOLS,JROWS) ! INOUT SNOW DEPTH IN ATMOSPHERE TRANO2A1.82
*ENDIF TRANO2A1.83
*IF DEF,TRANGRID TRANO2A1.84
REAL TRANO2A1.85
& XUO(0:IMT) ! Ocean UV longitude coordinates TRANO2A1.86
&,XTO(IMT) ! Ocean TS longitude coordinates TRANO2A1.87
&,YUO(0:JMT) ! Ocean UV latitude coordinates TRANO2A1.88
&,YTO(JMT) ! Ocean TS latitude coordinates TRANO2A1.89
&,XTA(ICOLS+1) ! Atmosphere TP longitude coordinates TRANO2A1.90
&,XUA(0:ICOLS) ! Atmosphere UV longitude coordinates TRANO2A1.91
&,YTA(JROWS) ! Atmosphere TP latitude coordinates TRANO2A1.92
&,YUA(0:JROWS) ! Atmosphere UV latitude coordinates TRANO2A1.93
LOGICAL TRANO2A1.94
+ AMASKTP(ICOLS,JROWS) ! IN ATMOS MODEL LAND-SEA MASK FOR TP GRID. TRANO2A1.95
*ENDIF TRANO2A1.96
C TRANO2A1.97
C EXTERNAL SUBPROGRAMS CALLED TRANO2A1.98
C TRANO2A1.99
EXTERNAL COPYO2A TRANO2A1.100
*IF DEF,TRANGRID TRANO2A1.101
*IF -DEF,AVER_U,OR,-DEF,AVER_T TRANO2A1.102
EXTERNAL H_INT_CO,H_INT_BL UDG1F400.385
*ENDIF TRANO2A1.104
*IF -DEF,AVER_T TRANO2A1.105
&,COAST_AJ,POST_H_INT TRANO2A1.106
*ENDIF TRANO2A1.107
*IF DEF,AVER_T TRANO2A1.108
&,ROWSWAP TRANO2A1.109
*ENDIF TRANO2A1.110
*IF DEF,AVER_U,OR,DEF,AVER_T TRANO2A1.111
&,PRE_AREAVER,DO_AREAVER TRANO2A1.112
*ENDIF TRANO2A1.113
*ENDIF TRANO2A1.114
C TRANO2A1.115
C LOCAL VARIABLES TRANO2A1.116
C TRANO2A1.117
LOGICAL TRANO2A1.118
& OMASK(IMT,JMT) ! Ocean land/sea mask (.T. for land) TRANO2A1.119
C TRANO2A1.120
REAL TRANO2A1.121
+ WORK_A(ICOLS,JROWS), ! WORK ARRAY ON ATMOSPHERE GRID. TRANO2A1.122
+ WORK_O(IMT,JMT) ! WORK ARRAY ON OCEAN GRID. TRANO2A1.123
C NB WORK_O is sometimes passed to subroutines as if (IR,*), TRANO2A1.124
C where IR=IRU,IRT is the number of truly distinct columns TRANO2A1.125
&,RCMPM ! reciprocal of cm per m TRANO2A1.126
*IF DEF,SEAICE TRANO2A1.127
+,AICEREF(ICOLS,JROWS) ! STORAGE FOR OLD VALUES OF AICEOUT TRANO2A1.128
+,CONRATIO ! RATIO OF CONDUCTIVITIES (ICE/SNOW) TRANO2A1.129
+,RHOSNOW ! DENSITY OF SNOW IN KG/M**3 TRANO2A1.130
+,AICEMIN ! MINIMUM ICE CONCENTRATION IF ICE PRESENT TRANO2A1.131
PARAMETER (CONRATIO = 6.5656) TRANO2A1.132
PARAMETER (RHOSNOW = 300.0) TRANO2A1.133
PARAMETER (AICEMIN = 0.001) TRANO2A1.134
*ENDIF TRANO2A1.135
PARAMETER(RCMPM=0.01) TRANO2A1.136
C* TRANO2A1.137
INTEGER TRANO2A1.138
& IRT,IRU ! No. of distinct cols. in ocean T/U grid TRANO2A1.139
+,I,J ! Working indices TRANO2A1.140
&,count ! counter for checking lsm at u,v points GRR0F403.319
C TRANO2A1.141
*IF DEF,TRANGRID TRANO2A1.142
*IF -DEF,AVER_T,OR,-DEF,AVER_U TRANO2A1.143
C TRANO2A1.144
C THE FOLLOWING OBJECTS ARE NEEDED FOR INTERPOLATION AND COASTAL TRANO2A1.145
C ADJUSTMENT. IF INTER_U IS ENABLED, THEY ARE USED IN SECTION 1 TRANO2A1.146
C FOR U GRIDS; IF INTER_T IS ENABLED, THEY ARE (RE)USED IN LATER TRANO2A1.147
C SECTIONS FOR T GRIDS. TRANO2A1.148
C TRANO2A1.149
REAL TRANO2A1.150
+ OCLAMBDA(IMT), ! LONGITUDE COORDS OF COLUMNS IN OCEAN TRANO2A1.151
+ ! GRID, IN DEGREES. TRANO2A1.152
+ ATLAMBDA(ICOLS*JROWS), ! LAMBDA COORDS OF ATMOSPHERE POINTS TRANO2A1.153
+ ATPHI(ICOLS*JROWS), ! PHI COORDS OF ATMOSPHERE POINTS TRANO2A1.154
+ WEIGHTTR(ICOLS*JROWS), ! WEIGHTS OF 'TOP RIGHT' CORNERS TRANO2A1.155
+ WEIGHTTL(ICOLS*JROWS), ! WEIGHTS OF 'TOP LEFT' CORNERS TRANO2A1.156
+ WEIGHTBR(ICOLS*JROWS), ! WEIGHTS OF 'BOTTOM RIGHT' CORNERS TRANO2A1.157
+ WEIGHTBL(ICOLS*JROWS) ! WEIGHTS OF 'BOTTOM LEFT' CORNERS TRANO2A1.158
&,OCWEST,OCEAST,OCNORTH,OCSOUTH TRANO2A1.159
C ! limits of the ocean domain TRANO2A1.160
C TRANO2A1.161
INTEGER TRANO2A1.162
+ ATPOINTS, ! NUMBER OF POINTS IN ATMOSPHERE GRID TRANO2A1.163
+ INDEXBL(ICOLS*JROWS), ! GATHER INDICES FOR INTERPOLATION. TRANO2A1.164
+ INDEXBR(ICOLS*JROWS) ! GATHER INDICES FOR INTERPOLATION. TRANO2A1.165
*ENDIF TRANO2A1.166
*IF -DEF,AVER_T TRANO2A1.167
C TRANO2A1.168
C These entities are required for coastal adjustment. The last four TRANO2A1.169
C are not used, but are declared simply to satisfy COAST_AJ. TRANO2A1.170
C TRANO2A1.171
INTEGER TRANO2A1.172
& SEAPOINTS, ! number of sea points in AMASKTP TRANO2A1.173
& ATPOINT(ICOLS*JROWS), ! list of these sea points TRANO2A1.174
+ IJMT, ! number of points in the ocean grid TRANO2A1.175
+ OMINT(IMT*JMT), ! integer land-sea mask on ocean grid TRANO2A1.176
+ AMINT(ICOLS*JROWS), ! integer land-sea mask on atmosphere grid TRANO2A1.177
+ INDEXI(ICOLS*JROWS), ! INDEX OF COASTAL POINTS (FROM COAST_AJ). TRANO2A1.178
+ INDEXO(ICOLS*JROWS), ! INDEX OF CORRESPONDING OCEAN POINTS. TRANO2A1.179
+ NCOASTAL, ! NUMBER OF COASTAL POINTS DETECTED. TRANO2A1.180
+ IDUMMY1(ICOLS,JROWS), ! DUMMY ARGUMENT FOR CALL TO COAST_AJ. TRANO2A1.181
+ IDUMMY2(ICOLS,JROWS), ! DUMMY ARGUMENT FOR CALL TO COAST_AJ. TRANO2A1.182
+ N1, ! DUMMY ARGUMENT FOR CALL TO COAST_AJ. TRANO2A1.183
+ N2 ! DUMMY ARGUMENT FOR CALL TO COAST_AJ. TRANO2A1.184
C TRANO2A1.185
REAL TRANO2A1.186
& WORK_I(ICOLS*JROWS) ! Working field at atmosphere seapoints TRANO2A1.187
&,WORK_O2(IMT*JMT) ! Working field on ocean grid TRANO2A1.188
*ENDIF TRANO2A1.189
*IF DEF,AVER_U,OR,DEF,AVER_T TRANO2A1.190
C TRANO2A1.191
C THE FOLLOWING OBJECTS ARE NEEDED FOR AREA-AVERAGING. IF AVER_U TRANO2A1.192
C IS ENABLED, THEY ARE USED IN SECTIONS 1&2 FOR U GRIDS; IF AVER_T TRANO2A1.193
C IS ENABLED, THEY ARE (RE)USED IN LATER SECTIONS FOR T GRIDS. TRANO2A1.194
C TRANO2A1.195
INTEGER TRANO2A1.196
& LENL ! Length of lists TRANO2A1.197
&,COUNT_A(ICOLS,JROWS) ! No. of ocean boxes in atmosphere box TRANO2A1.198
&,BASE_A(ICOLS,JROWS) ! First index in list for atmosphere box TRANO2A1.199
&,POINT_O(MAXL) ! List of ocean box indices TRANO2A1.200
REAL TRANO2A1.201
& WEIGHT(MAXL) ! List of weights for ocean boxes TRANO2A1.202
*ENDIF TRANO2A1.203
*IF DEF,AVER_U TRANO2A1.204
LOGICAL AMASKUV(ICOLS,JROWSM1) TRANO2A1.205
C ! Dummy mask on atmosphere UV grid TRANO2A1.206
*ENDIF TRANO2A1.207
REAL TRANO2A1.208
+ OCPHI(JMT+1) ! LATITUDE ROWS IN OCEAN GRID TRANO2A1.209
*ENDIF TRANO2A1.210
C TRANO2A1.211
CL SECTION 0: No. of distinct columns in ocean TRANO2A1.212
C TRANO2A1.213
IF (CYCLIC) THEN TRANO2A1.214
IRU=IMT-2 TRANO2A1.215
IRT=IRU TRANO2A1.216
ELSE TRANO2A1.217
IRU=IMT-1 TRANO2A1.218
IRT=IMT TRANO2A1.219
ENDIF TRANO2A1.220
C TRANO2A1.221
CL SECTION 1: Set up for U grids TRANO2A1.222
C TRANO2A1.223
C OCPHI contains the point coordinates for interpolation, or the TRANO2A1.224
C box limits for area-averaging, going from N to S. In the latter TRANO2A1.225
C case, OCPHI(1) is the N limit of the northernmost box, OCPHI(JMT) TRANO2A1.226
C the S limit of the southernmost box. TRANO2A1.227
C TRANO2A1.228
IF (INVERT) THEN TRANO2A1.229
DO J=1,JMTM1 TRANO2A1.230
*IF DEF,TRANGRID TRANO2A1.231
*IF -DEF,AVER_U TRANO2A1.232
OCPHI(JMTM1-J+1)=YUO(J) TRANO2A1.233
*ELSE TRANO2A1.234
OCPHI(JMTM1-J+1)=YTO(J+1) TRANO2A1.235
*ENDIF TRANO2A1.236
*ENDIF TRANO2A1.237
DO I=1,IRU TRANO2A1.238
OMASK(I,JMTM1-J+1)=FKMQ(I,J).LT.0.1 CJG6F401.14
ENDDO TRANO2A1.240
ENDDO TRANO2A1.241
*IF DEF,TRANGRID,AND,DEF,AVER_U TRANO2A1.242
OCPHI(JMT)=YTO(1) TRANO2A1.243
*ENDIF TRANO2A1.244
ELSE TRANO2A1.245
DO J=1,JMTM1 TRANO2A1.246
*IF DEF,TRANGRID TRANO2A1.247
*IF -DEF,AVER_U TRANO2A1.248
OCPHI(J)=YUO(J) TRANO2A1.249
*ELSE TRANO2A1.250
OCPHI(J)=YTO(J) TRANO2A1.251
*ENDIF TRANO2A1.252
*ENDIF TRANO2A1.253
DO I=1,IRU TRANO2A1.254
OMASK(I,J)=FKMQ(I,J).LT.0.1 CJG6F401.15
ENDDO TRANO2A1.256
ENDDO TRANO2A1.257
*IF DEF,TRANGRID,AND,DEF,AVER_U TRANO2A1.258
OCPHI(JMT)=YTO(JMT) TRANO2A1.259
*ENDIF TRANO2A1.260
ENDIF TRANO2A1.261
*IF DEF,TRANGRID GRR0F404.12
*IF -DEF,AVER_U TRANO2A1.263
C TRANO2A1.264
C FIND THE ARRAYS OF INTERPOLATION WEIGHTS AND GATHER INDICES TRANO2A1.265
C FOR THE U GRIDS. TRANO2A1.266
C Note that no coastal adjustment is done for currents. TRANO2A1.267
C If ocean not global, exclude atmosphere points whose boxes are TRANO2A1.268
C entirely outside the ocean domain. The ocean domain is defined TRANO2A1.269
C by the outside limits of the boxes at its edges, and the con- TRANO2A1.270
C dition tested amounts to accepting the atmosphere box... TRANO2A1.271
C IF ((distance E of E edge of box from W edge of ocean TRANO2A1.272
C < width of box TRANO2A1.273
C OR W edge of box is W of E edge of ocean) TRANO2A1.274
C AND S edge of box is S of N edge of ocean TRANO2A1.275
C AND N edge of box is N of S edge of ocean) TRANO2A1.276
C The E-W tests are written in such a way that the A and O grids TRANO2A1.277
C are not assumed to have the same base of longitude. The E and W TRANO2A1.278
C tests differ in form because one edge of the ocean, the W edge TRANO2A1.279
C in fact, has been taken as the base of longitude. It is therefore TRANO2A1.280
C no good to test whether the E edge of the box is E of the W edge TRANO2A1.281
C of the ocean, as this will be true for all longitudes. There is TRANO2A1.282
C no complexity N-S as there is no wrap-round. TRANO2A1.283
C TRANO2A1.284
DO I=1,IRU TRANO2A1.285
OCLAMBDA(I)=XUO(I) TRANO2A1.286
ENDDO TRANO2A1.287
IF (.NOT.GLOBAL) THEN TRANO2A1.288
OCWEST=XTO(1)-720. TRANO2A1.289
OCEAST=XTO(IRU+1)-XTO(1) TRANO2A1.290
IF (INVERT) THEN TRANO2A1.291
OCNORTH=YTO(JMT) TRANO2A1.292
OCSOUTH=YTO(1) TRANO2A1.293
ELSE TRANO2A1.294
OCNORTH=YTO(1) TRANO2A1.295
OCSOUTH=YTO(JMT) TRANO2A1.296
ENDIF TRANO2A1.297
ENDIF TRANO2A1.298
ATPOINTS=0 TRANO2A1.299
DO J=1,JROWSM1 TRANO2A1.300
DO I=1,ICOLS TRANO2A1.301
IF (GLOBAL.OR.((MOD(XTA(I+1)-OCWEST,360.).LE.XTA(I+1)-XTA(I) TRANO2A1.302
& .OR.MOD(XTA(I)-OCWEST,360.).LE.OCEAST) TRANO2A1.303
& .AND.YTA(J+1).LE.OCNORTH.AND.YTA(J).GE.OCSOUTH)) THEN TRANO2A1.304
ATPOINTS=ATPOINTS+1 TRANO2A1.305
ATLAMBDA(ATPOINTS)=XUA(I) TRANO2A1.306
ATPHI(ATPOINTS)=YUA(J) TRANO2A1.307
ENDIF TRANO2A1.308
ENDDO TRANO2A1.309
ENDDO TRANO2A1.310
CALL H_INT_CO(INDEXBL,INDEXBR,WEIGHTTR,WEIGHTBR,WEIGHTTL,WEIGHTBL TRANO2A1.311
&,OCLAMBDA,OCPHI,ATLAMBDA,ATPHI,IRU,JMTM1,ATPOINTS,CYCLIC) TRANO2A1.312
*ELSE TRANO2A1.313
C TRANO2A1.314
C Fill atmosphere mask and calculate weights and indices for TRANO2A1.315
C area-averaging between the U grids TRANO2A1.316
C TRANO2A1.317
DO J=1,JROWSM1 TRANO2A1.318
DO I=1,ICOLS TRANO2A1.319
AMASKUV(I,J)=.FALSE. TRANO2A1.320
ENDDO TRANO2A1.321
ENDDO TRANO2A1.322
LENL=MAXL TRANO2A1.323
CALL PRE_AREAVER(IRU,XTO,JMTM1,OCPHI,GLOBAL,IMT,.FALSE. TRANO2A1.324
&,OMASK,ICOLS,XTA,JROWSM1,YTA,.TRUE.,.TRUE. CJG1F401.48
&,LENL,COUNT_A,BASE_A,POINT_O,WEIGHT,ICODE,CMESSAGE) CJG1F401.49
*ENDIF TRANO2A1.327
*ENDIF TRANO2A1.328
C TRANO2A1.329
! Check ocean currents for missing data at active points and abort CJG1F405.3
! if any are found CJG1F405.4
! CJG1F405.5
count=0 GRR0F403.339
DO J=1,JMTM1 GRR0F403.340
DO I=1,IRU GRR0F403.341
IF(FKMQ(I,J).GT.0.1 CJG1F405.6
& .AND.(UIN(I,J).EQ.RMDI.OR.VIN(I,J).EQ.RMDI)) THEN CJG1F405.7
count=count + 1 GRR0F403.343
ENDIF GRR0F403.345
ENDDO ! I GRR0F403.346
ENDDO ! J GRR0F403.347
IF(count.NE.0) THEN GRR0F403.348
WRITE(6,'(''TRANSO2A: Missing data in ocean UV fields at'' CJG1F405.8
& ,I6,''active ocean points'')') count CJG1F405.9
CMESSAGE='TRANSO2A: Missing data in ocean UV fields' CJG1F405.10
ICODE=84 CJG1F405.11
RETURN CJG1F405.12
ENDIF GRR0F403.353
C CJG1F405.13
CL SECTION 2.1: Zonal component of surface current CJG1F405.14
C CJG1F405.15
*IF DEF,TRANGRID TRANO2A1.332
C IT IS IMPORTANT TO ZERO CURRENTS OVER LAND BEFORE TRANSFERRING TRANO2A1.333
C THEM TO THE ATMOSPHERE GRID. THIS, TOGETHER WITH THE OCEAN MODEL TRANO2A1.334
C BOUNDARY CONDITION (ZERO CURRENT AT THE COASTS) SHOULD ENSURE TRANO2A1.335
C THAT THE INTERPOLATED FIELD CONTAINS NO NONZERO VALUES OVER LAND. TRANO2A1.336
C This is done as part of COPYO2A. TRANO2A1.337
C TRANO2A1.338
*IF -DEF,AVER_U TRANO2A1.339
CALL COPYO2A(IMT,JMTM1,UIN,.FALSE.,OMASK TRANO2A1.340
&,.TRUE.,INVERT,IRU,WORK_O) TRANO2A1.341
CALL H_INT_BL(JMTM1,IRU,ATPOINTS,INDEXBL,INDEXBR,WORK_O CCC1F401.16
&, WEIGHTBL,WEIGHTBR,WEIGHTTL,WEIGHTTR,UOUT) CCC1F401.17
*ELSE TRANO2A1.344
CALL COPYO2A(IMT,JMTM1,UIN,.FALSE.,OMASK TRANO2A1.345
&,.TRUE.,INVERT,IRU,WORK_O) TRANO2A1.346
CALL DO_AREAVER(IRU,JMTM1,IRU,.false. OJG1F403.143
&,WORK_O,ICOLS,JROWSM1,COUNT_A OJG1F403.144
&,BASE_A,ICOLS,.FALSE.,AMASKUV,POINT_O,WEIGHT OJG1F403.145
&,0,UOUT,ICODE,CMESSAGE) OJG1F403.146
*ENDIF TRANO2A1.349
*ELSE TRANO2A1.350
C If grids are congruent we assume that JMTM1=JROWSM1, IRU=ICOLS TRANO2A1.351
C TRANO2A1.352
CALL COPYO2A(IMT,JMTM1,UIN,.FALSE.,OMASK,.TRUE.,INVERT,IRU,UOUT) TRANO2A1.353
*ENDIF TRANO2A1.354
C TRANO2A1.355
CL SECTION 2.2: Meridional component of surface current TRANO2A1.356
C TRANO2A1.357
*IF DEF,TRANGRID TRANO2A1.358
*IF -DEF,AVER_U TRANO2A1.359
CALL COPYO2A(IMT,JMTM1,VIN,.FALSE.,OMASK TRANO2A1.360
&,.TRUE.,INVERT,IRU,WORK_O) TRANO2A1.361
CALL H_INT_BL(JMTM1,IRU,ATPOINTS,INDEXBL,INDEXBR,WORK_O CCC1F401.18
&, WEIGHTBL,WEIGHTBR,WEIGHTTL,WEIGHTTR,VOUT) CCC1F401.19
*ELSE TRANO2A1.364
CALL COPYO2A(IMT,JMTM1,VIN,.FALSE.,OMASK TRANO2A1.365
&,.TRUE.,INVERT,IRU,WORK_O) TRANO2A1.366
CALL DO_AREAVER(IRU,JMTM1,IRU,.false. OJG1F403.147
&,WORK_O,ICOLS,JROWSM1,COUNT_A OJG1F403.148
&,BASE_A,ICOLS,.FALSE.,AMASKUV,POINT_O,WEIGHT OJG1F403.149
&,0,VOUT,ICODE,CMESSAGE) OJG1F403.150
*ENDIF TRANO2A1.369
*ELSE TRANO2A1.370
CALL COPYO2A(IMT,JMTM1,VIN,.FALSE.,OMASK,.TRUE.,INVERT,IRU,VOUT) TRANO2A1.371
*ENDIF TRANO2A1.372
C TRANO2A1.373
C Rescale surface currents from ocean (cm/s) to atmosphere (m/s) units TRANO2A1.374
C TRANO2A1.375
DO J=1,JROWSM1 TRANO2A1.376
DO I=1,ICOLS TRANO2A1.377
IF (UOUT(I,J).NE.RMDI) THEN TRANO2A1.378
UOUT(I,J)=UOUT(I,J)*RCMPM TRANO2A1.379
VOUT(I,J)=VOUT(I,J)*RCMPM TRANO2A1.380
ENDIF TRANO2A1.381
ENDDO TRANO2A1.382
ENDDO TRANO2A1.383
C TRANO2A1.384
CL SECTION 3: Set up for T grids TRANO2A1.385
C TRANO2A1.386
IF (INVERT) THEN TRANO2A1.387
DO J=1,JMT TRANO2A1.388
*IF DEF,TRANGRID TRANO2A1.389
*IF -DEF,AVER_T TRANO2A1.390
OCPHI(JMT-J+1)=YTO(J) TRANO2A1.391
*ELSE TRANO2A1.392
OCPHI(JMT-J+1)=YUO(J) TRANO2A1.393
*ENDIF TRANO2A1.394
*ENDIF TRANO2A1.395
DO I=1,IRT TRANO2A1.396
OMASK(I,JMT-J+1)=FKMP(I,J).LT.0.1 CJG6F401.16
ENDDO TRANO2A1.398
ENDDO TRANO2A1.399
*IF DEF,TRANGRID,AND,DEF,AVER_T TRANO2A1.400
OCPHI(JMT+1)=YUO(0) TRANO2A1.401
*ENDIF TRANO2A1.402
ELSE TRANO2A1.403
DO J=1,JMT TRANO2A1.404
*IF DEF,TRANGRID TRANO2A1.405
*IF -DEF,AVER_T TRANO2A1.406
OCPHI(J)=YTO(J) TRANO2A1.407
*ELSE TRANO2A1.408
OCPHI(J)=YUO(J-1) TRANO2A1.409
*ENDIF TRANO2A1.410
*ENDIF TRANO2A1.411
DO I=1,IRT TRANO2A1.412
OMASK(I,J)=FKMP(I,J).LT.0.1 CJG6F401.17
ENDDO TRANO2A1.414
ENDDO TRANO2A1.415
*IF DEF,TRANGRID,AND,DEF,AVER_T TRANO2A1.416
OCPHI(JMT+1)=YUO(JMT) TRANO2A1.417
*ENDIF TRANO2A1.418
ENDIF TRANO2A1.419
*IF DEF,TRANGRID TRANO2A1.420
*IF -DEF,AVER_T TRANO2A1.421
C TRANO2A1.422
C FIND THE ARRAYS OF INTERPOLATION WEIGHTS AND GATHER INDICES TRANO2A1.423
C FOR THE T GRIDS, and the indices for coastal adjustment TRANO2A1.424
C TRANO2A1.425
DO I=1,IRT TRANO2A1.426
OCLAMBDA(I)=XTO(I) TRANO2A1.427
ENDDO TRANO2A1.428
IF (.NOT.GLOBAL) THEN TRANO2A1.429
OCWEST=XUO(0)-720. TRANO2A1.430
OCEAST=XUO(IRT)-XUO(0) TRANO2A1.431
IF (INVERT) THEN TRANO2A1.432
OCNORTH=YUO(JMT) TRANO2A1.433
OCSOUTH=YUO(0) TRANO2A1.434
ELSE TRANO2A1.435
OCNORTH=YUO(0) TRANO2A1.436
OCSOUTH=YUO(JMT) TRANO2A1.437
ENDIF TRANO2A1.438
ENDIF TRANO2A1.439
IJMT=0 TRANO2A1.440
DO J=1,JMT TRANO2A1.441
DO I=1,IRT TRANO2A1.442
IJMT=IJMT+1 TRANO2A1.443
IF (OMASK(I,J)) THEN TRANO2A1.444
OMINT(IJMT)=1 TRANO2A1.445
ELSE TRANO2A1.446
OMINT(IJMT)=0 TRANO2A1.447
ENDIF TRANO2A1.448
ENDDO TRANO2A1.449
ENDDO TRANO2A1.450
ATPOINTS=0 TRANO2A1.451
SEAPOINTS=0 TRANO2A1.452
DO J=1,JROWS TRANO2A1.453
DO I=1,ICOLS TRANO2A1.454
ATPOINTS=ATPOINTS+1 TRANO2A1.455
IF (.NOT.AMASKTP(I,J).AND.(GLOBAL TRANO2A1.456
& .OR.((MOD(XUA(I)-OCWEST,360.).LE.XUA(I)-XUA(I-1) TRANO2A1.457
& .OR.MOD(XUA(I-1)-OCWEST,360.).LE.OCEAST) TRANO2A1.458
& .AND.YTA(J).LE.OCNORTH.AND.YTA(J-1).GE.OCSOUTH))) THEN TRANO2A1.459
SEAPOINTS=SEAPOINTS+1 TRANO2A1.460
ATLAMBDA(SEAPOINTS)=XTA(I) TRANO2A1.461
ATPHI(SEAPOINTS)=YTA(J) TRANO2A1.462
ATPOINT(SEAPOINTS)=ATPOINTS TRANO2A1.463
AMINT(SEAPOINTS)=0 TRANO2A1.464
ENDIF TRANO2A1.465
ENDDO TRANO2A1.466
ENDDO TRANO2A1.467
CALL H_INT_CO(INDEXBL,INDEXBR,WEIGHTTR,WEIGHTBR,WEIGHTTL,WEIGHTBL TRANO2A1.468
&,OCLAMBDA,OCPHI,ATLAMBDA,ATPHI,IRT,JMT,SEAPOINTS,CYCLIC) TRANO2A1.469
CALL COAST_AJ(INDEXBL,INDEXBR,WEIGHTTR,WEIGHTBR,WEIGHTTL,WEIGHTBL TRANO2A1.470
&,IRT,JMT,SEAPOINTS,OMINT,AMINT,INDEXI,INDEXO,NCOASTAL,.TRUE. TRANO2A1.471
&,IDUMMY1,N1,IDUMMY2,N2) TRANO2A1.472
*ELSE TRANO2A1.473
C TRANO2A1.474
C Calculate weights and indices for area-averaging for the T grids TRANO2A1.475
C TRANO2A1.476
LENL=MAXL TRANO2A1.477
CALL PRE_AREAVER(IRT,XUO,JMT,OCPHI,GLOBAL,IMT,.FALSE. TRANO2A1.478
&,OMASK,ICOLS,XUA,JROWS,YUA,.TRUE.,.TRUE. CJG1F401.50
&,LENL,COUNT_A,BASE_A,POINT_O,WEIGHT,ICODE,CMESSAGE) CJG1F401.51
*ENDIF TRANO2A1.481
*ENDIF TRANO2A1.482
C TRANO2A1.483
C WORK_A initialised with RMDI so that we may see where the TRANO2A1.484
C atmosphere field is going to be updated by the ocean (used TRANO2A1.485
C in sections 5 and 7) TRANO2A1.486
C TRANO2A1.487
DO J=1,JROWS TRANO2A1.488
DO I=1,ICOLS TRANO2A1.489
WORK_A(I,J)=RMDI TRANO2A1.490
ENDDO TRANO2A1.491
ENDDO TRANO2A1.492
*IF DEF,SEAICE TRANO2A1.493
C TRANO2A1.494
CL SECTION 4: ICE CONCENTRATION. TRANO2A1.495
C TRANO2A1.496
C COPY THE VALUES CURRENTLY IN THE ATMOSPHERE TO A LOCAL ARRAY TRANO2A1.497
C FOR REFERENCE DURING SECTION 7. TRANO2A1.498
C TRANO2A1.499
DO J=1,JROWS TRANO2A1.500
DO I=1,ICOLS TRANO2A1.501
AICEREF(I,J)=AICEOUT(I,J) TRANO2A1.502
ENDDO TRANO2A1.503
ENDDO TRANO2A1.504
C TRANO2A1.505
*IF DEF,TRANGRID TRANO2A1.506
*IF -DEF,AVER_T TRANO2A1.507
CALL COPYO2A(IMT,JMT,AICEIN,.FALSE.,OMASK TRANO2A1.508
&,.TRUE.,INVERT,IRT,WORK_O) TRANO2A1.509
CALL H_INT_BL(JMT,IRT,SEAPOINTS,INDEXBL,INDEXBR,WORK_O CCC1F401.20
&, WEIGHTBL,WEIGHTBR,WEIGHTTL,WEIGHTTR,WORK_I) UDG1F400.391
CALL POST_H_INT(NCOASTAL,INDEXO,INDEXI,IJMT,WORK_O,OMINT TRANO2A1.512
&,SEAPOINTS,WORK_I,ATPOINT,RMDI,ATPOINTS,AICEOUT) TRANO2A1.513
*ELSE TRANO2A1.514
CALL COPYO2A(IMT,JMT,AICEIN,.FALSE.,OMASK TRANO2A1.515
&,.FALSE.,INVERT,IMT,WORK_O) TRANO2A1.516
CALL DO_AREAVER(IRT,JMT,IMT,.false. OJG1F403.151
&,WORK_O,ICOLS,JROWS,COUNT_A,BASE_A OJG1F403.152
&,ICOLS,.FALSE.,AMASKTP,POINT_O,WEIGHT OJG1F403.153
&,0,AICEOUT,ICODE,CMESSAGE) OJG1F403.154
*ENDIF TRANO2A1.519
*ELSE TRANO2A1.520
C If grids are congruent we assume that JMT=JROWS, IRT=ICOLS TRANO2A1.521
C TRANO2A1.522
CALL COPYO2A(IMT,JMT,AICEIN,.FALSE.,OMASK TRANO2A1.523
&,.FALSE.,INVERT,IRT,AICEOUT) TRANO2A1.524
*ENDIF TRANO2A1.525
C TRANO2A1.526
CL SECTION 5: ICE DEPTH. TRANO2A1.527
C TRANO2A1.528
C BEGIN BY CONVERTING FROM THE GRID BOX MEAN ACTUAL ICE DEPTH TRANO2A1.529
C TO THE EQUIVALENT ICE DEPTH AVERAGED OVER THICK ICE. TRANO2A1.530
C THIS PROCESS USES THE ICE CONCENTRATION AND SNOW DEPTH FIELDS. TRANO2A1.531
C Neglect sea-ice in boxes with less than the minimum ice fraction TRANO2A1.532
C TRANO2A1.533
DO 210 J = 1,JMT TRANO2A1.534
DO 205 I = 1,IRT TRANO2A1.535
IF (TSTARIN(I,J).NE.RMDI) THEN TRANO2A1.536
IF (AICEIN(I,J).LT.AICEMIN) THEN TRANO2A1.537
WORK_O(I,J)=0. TRANO2A1.538
ELSE TRANO2A1.539
WORK_O(I,J)=HICEIN(I,J)/AICEIN(I,J) TRANO2A1.540
& + CONRATIO*HSNOWIN(I,J) TRANO2A1.541
ENDIF TRANO2A1.542
ENDIF TRANO2A1.543
205 CONTINUE TRANO2A1.544
210 CONTINUE TRANO2A1.545
C TRANO2A1.546
*IF DEF,TRANGRID TRANO2A1.547
*IF -DEF,AVER_T TRANO2A1.548
CALL COPYO2A(IMT,JMT,WORK_O,.FALSE.,OMASK TRANO2A1.549
&,.TRUE.,INVERT,IRT,WORK_O2) TRANO2A1.550
CALL H_INT_BL(JMT,IRT,SEAPOINTS,INDEXBL,INDEXBR,WORK_O2 CCC1F401.21
&, WEIGHTBL,WEIGHTBR,WEIGHTTL,WEIGHTTR,WORK_I) UDG1F400.393
CALL POST_H_INT(NCOASTAL,INDEXO,INDEXI,IJMT,WORK_O2,OMINT TRANO2A1.553
&,SEAPOINTS,WORK_I,ATPOINT,RMDI,ATPOINTS,WORK_A) TRANO2A1.554
*ELSE TRANO2A1.555
IF (INVERT) CALL ROWSWAP(WORK_O,WORK_O,IMT,JMT) TRANO2A1.556
CALL DO_AREAVER(IRT,JMT,IMT,.false. OJG1F403.155
&,WORK_O,ICOLS,JROWS,COUNT_A,BASE_A OJG1F403.156
&,ICOLS,.FALSE.,AMASKTP,POINT_O,WEIGHT OJG1F403.157
&,0,WORK_A,ICODE,CMESSAGE) OJG1F403.158
*ENDIF TRANO2A1.559
*ELSE TRANO2A1.560
CALL COPYO2A(IMT,JMT,WORK_O,.FALSE.,OMASK TRANO2A1.561
&,.FALSE.,INVERT,IRT,WORK_A) TRANO2A1.562
*ENDIF TRANO2A1.563
C TRANO2A1.564
C Remove sea-ice at boxes with less than the minimum ice fraction; TRANO2A1.565
C set icedepth to zero at ice-free boxes TRANO2A1.566
C TRANO2A1.567
DO J=1,JROWS TRANO2A1.568
DO I=1,ICOLS TRANO2A1.569
IF (WORK_A(I,J).NE.RMDI) THEN TRANO2A1.570
IF (AICEOUT(I,J).LT.AICEMIN) AICEOUT(I,J)=0. TRANO2A1.571
IF (AICEOUT(I,J).EQ.0.) WORK_A(I,J)=0. TRANO2A1.572
HICEOUT(I,J)=WORK_A(I,J) TRANO2A1.573
ENDIF TRANO2A1.574
ENDDO TRANO2A1.575
ENDDO TRANO2A1.576
C TRANO2A1.577
CL SECTION 6: SNOW DEPTH. TRANO2A1.578
C TRANO2A1.579
C NOTE THAT THIS HAS TO BE CONVERTED FROM M TO KG/M**2. TRANO2A1.580
C TRANO2A1.581
DO J=1,JMT TRANO2A1.582
DO I=1,IRT TRANO2A1.583
IF (TSTARIN(I,J).NE.RMDI) TRANO2A1.584
& WORK_O(I,J)=HSNOWIN(I,J)*RHOSNOW TRANO2A1.585
ENDDO TRANO2A1.586
ENDDO TRANO2A1.587
*IF DEF,TRANGRID TRANO2A1.588
*IF -DEF,AVER_T TRANO2A1.589
CALL COPYO2A(IMT,JMT,WORK_O,.FALSE.,OMASK TRANO2A1.590
&,.TRUE.,INVERT,IRT,WORK_O2) TRANO2A1.591
CALL H_INT_BL(JMT,IRT,SEAPOINTS,INDEXBL,INDEXBR,WORK_O2 CCC1F401.22
&, WEIGHTBL,WEIGHTBR,WEIGHTTL,WEIGHTTR,WORK_I) UDG1F400.395
CALL POST_H_INT(NCOASTAL,INDEXO,INDEXI,IJMT,WORK_O2,OMINT TRANO2A1.594
&,SEAPOINTS,WORK_I,ATPOINT,RMDI,ATPOINTS,HSNOWOUT) TRANO2A1.595
*ELSE TRANO2A1.596
IF (INVERT) CALL ROWSWAP(WORK_O,WORK_O,IMT,JMT) TRANO2A1.597
CALL DO_AREAVER(IRT,JMT,IMT,.false. OJG1F403.159
&,WORK_O,ICOLS,JROWS,COUNT_A,BASE_A OJG1F403.160
&,ICOLS,.FALSE.,AMASKTP,POINT_O,WEIGHT OJG1F403.161
&,0,HSNOWOUT,ICODE,CMESSAGE) OJG1F403.162
*ENDIF TRANO2A1.600
*ELSE TRANO2A1.601
CALL COPYO2A(IMT,JMT,WORK_O,.FALSE.,OMASK TRANO2A1.602
&,.FALSE.,INVERT,IRT,HSNOWOUT) TRANO2A1.603
*ENDIF TRANO2A1.604
*ENDIF TRANO2A1.605
C TRANO2A1.606
CL SECTION 7: SEA SURFACE TEMPERATURE. TRANO2A1.607
C TRANO2A1.608
C NOTE THAT THIS HAS TO BE CONVERTED FROM CELSIUS TO KELVIN. TRANO2A1.609
C TRANO2A1.610
*IF DEF,TRANGRID TRANO2A1.611
*IF -DEF,AVER_T TRANO2A1.612
CALL COPYO2A(IMT,JMT,TSTARIN,.FALSE.,OMASK TRANO2A1.613
&,.TRUE.,INVERT,IRT,WORK_O) TRANO2A1.614
CALL H_INT_BL(JMT,IRT,SEAPOINTS,INDEXBL,INDEXBR,WORK_O CCC1F401.23
CCC1F401.24
&, WEIGHTBL,WEIGHTBR,WEIGHTTL,WEIGHTTR,WORK_I) UDG1F400.397
UDG1F400.398
CALL POST_H_INT(NCOASTAL,INDEXO,INDEXI,IJMT,WORK_O,OMINT TRANO2A1.617
&,SEAPOINTS,WORK_I,ATPOINT,RMDI,ATPOINTS,WORK_A) TRANO2A1.618
*ELSE TRANO2A1.619
CALL COPYO2A(IMT,JMT,TSTARIN,.FALSE.,OMASK TRANO2A1.620
&,.FALSE.,INVERT,IMT,WORK_O) TRANO2A1.621
CALL DO_AREAVER(IRT,JMT,IMT,.false. OJG1F403.163
&,WORK_O,ICOLS,JROWS,COUNT_A,BASE_A OJG1F403.164
&,ICOLS,.FALSE.,AMASKTP,POINT_O,WEIGHT OJG1F403.165
&,0,WORK_A,ICODE,CMESSAGE) OJG1F403.166
*ENDIF TRANO2A1.624
*ELSE TRANO2A1.625
CALL COPYO2A(IMT,JMT,TSTARIN,.FALSE.,OMASK TRANO2A1.626
&,.FALSE.,INVERT,IRT,WORK_A) TRANO2A1.627
*ENDIF TRANO2A1.628
C TRANO2A1.629
*IF DEF,SEAICE TRANO2A1.630
C AT SEA-ICE POINTS, THE GRID BOX MEAN SURFACE TEMPERATURE IS TRANO2A1.631
C ALTERED IN SUCH A WAY THAT THE SURFACE TEMPERATURE OF THE ICY TRANO2A1.632
C PORTION OF THE BOX IS THE SAME AS IT WAS AT THE END OF THE LAST TRANO2A1.633
C ATMOSPHERIC PHASE. HOWEVER, IF ICE APPEARED DURING THE TRANO2A1.634
C MOST RECENT OCEAN PHASE, ITS TEMPERATURE IS INITIALISED AT THE TRANO2A1.635
C FREEZING POINT OF SEAWATER. TRANO2A1.636
C THIS CODE USES THE OLD VALUES OF ICE CONCENTRATION, WHICH WERE TRANO2A1.637
C STORED DURING SECTION 2 IN AICEREF. TRANO2A1.638
C TRANO2A1.639
DO 420 J = 1,JROWS TRANO2A1.640
DO 415 I = 1,ICOLS TRANO2A1.641
IF (WORK_A(I,J) .NE. RMDI) THEN TRANO2A1.642
IF (AICEOUT(I,J) .EQ. 0.0) THEN TRANO2A1.643
TSTAROUT(I,J) = WORK_A(I,J) + ZERODEGC TRANO2A1.644
ELSEIF (AICEREF(I,J) .GE. AICEMIN) THEN TRANO2A1.645
TSTAROUT(I,J) = TFS + ( AICEOUT(I,J)/AICEREF(I,J) ) TRANO2A1.646
+ *( TSTAROUT(I,J) - TFS ) TRANO2A1.647
ELSE TRANO2A1.648
TSTAROUT(I,J) = TFS TRANO2A1.649
ENDIF TRANO2A1.650
ENDIF TRANO2A1.651
415 CONTINUE TRANO2A1.652
420 CONTINUE TRANO2A1.653
*ELSE TRANO2A1.654
DO 430 J = 1,JROWS TRANO2A1.655
DO 425 I = 1,ICOLS TRANO2A1.656
IF (WORK_A(I,J) .NE. RMDI) THEN TRANO2A1.657
TSTAROUT(I,J) = WORK_A(I,J) + ZERODEGC TRANO2A1.658
ENDIF TRANO2A1.659
425 CONTINUE TRANO2A1.660
430 CONTINUE TRANO2A1.661
*ENDIF TRANO2A1.662
*IF -DEF,TRANGRID CCN1F405.326
C CCN1F405.327
CL SECTION 8: ocean co2 flux CCN1F405.328
C CCN1F405.329
CCN1F405.330
IF (L_CO2_INTERACTIVE) THEN CCN1F405.331
CALL COPYO2A(IMT,JMT,CO2FLUXIN,.FALSE.,OMASK CCN1F405.332
& ,.TRUE.,INVERT,IRT,CO2FLUXOUT) CCN1F405.333
CCN1F405.334
DO J=1,JROWS CCN1F405.335
DO I=1,ICOLS CCN1F405.336
IF (CO2FLUXOUT(i,j) .ne. RMDI) THEN CCN1F405.337
CO2FLUXOUT(i,j) = CO2FLUXOUT(i,j) * CO2CONV_O2A CCN1F405.338
ENDIF CCN1F405.339
ENDDO CCN1F405.340
ENDDO CCN1F405.341
ENDIF CCN1F405.342
*ENDIF CCN1F405.343
C TRANO2A1.663
999 CONTINUE TRANO2A1.664
RETURN TRANO2A1.665
END TRANO2A1.666
*ENDIF TRANO2A1.667