*IF DEF,CONTROL,AND,DEF,ATMOS,AND,DEF,OCEAN,AND,-DEF,MPP GRR0F402.45
C ******************************COPYRIGHT****************************** GTS2F400.9901
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.9902
C GTS2F400.9903
C Use, duplication or disclosure of this code is subject to the GTS2F400.9904
C restrictions as set forth in the contract. GTS2F400.9905
C GTS2F400.9906
C Meteorological Office GTS2F400.9907
C London Road GTS2F400.9908
C BRACKNELL GTS2F400.9909
C Berkshire UK GTS2F400.9910
C RG12 2SZ GTS2F400.9911
C GTS2F400.9912
C If no contract has been raised with this copy of the code, the use, GTS2F400.9913
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.9914
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.9915
C Modelling at the above address. GTS2F400.9916
C ******************************COPYRIGHT****************************** GTS2F400.9917
C GTS2F400.9918
CLL Routine: SWAP_A2O ------------------------------------------------- SWAPA2O1.3
CLL SWAPA2O1.4
CLL Purpose: 2nd level control routine to control the interchange of SWAPA2O1.5
CLL data when swapping from atmosphere to ocean in a coupled SWAPA2O1.6
CLL model. Fields required from the completed atmosphere SWAPA2O1.7
CLL phase are copied to workspace from D1 addresses worked SWAPA2O1.8
CLL out by INIT_A2O; atmosphere data is written from D1 to SWAPA2O1.9
CLL disk; ocean data read from disk to overlay D1; and finally SWAPA2O1.10
CLL routine TRANSA2O is called to perform the data processing SWAPA2O1.11
CLL required to complete the coupling. SWAPA2O1.12
CLL SWAPA2O1.13
CLL Tested under compiler: cft77 SWAPA2O1.14
CLL Tested under OS version: UNICOS 5.1 SWAPA2O1.15
CLL SWAPA2O1.16
CLL JG, TJ <- programmer of some or all of previous code or changes SWAPA2O1.17
CLL SWAPA2O1.18
CLL Model Modification history from model version 3.0: SWAPA2O1.19
CLL version Date SWAPA2O1.20
CLL 3.1 3/02/93 : added comdeck CHSUNITS to define NUNITS for i/o RS030293.130
CLL 3.2 25/05/93 : Changes for dynamic allocation (TCJ). @DYALLOC.3487
CLL 4.2 22/11/96 : Allow uncompressed ocean dumps. S Ineson GSI0F402.28
CLL 4.2 11/10/96 : Enable atmos-ocean coupling for MPP. GRR0F402.46
CLL (1): Coupled fields. Disable this deck for MPP GRR0F402.47
CLL running (a separate deck SWAPA2O2 introduced for GRR0F402.48
CLL MPP). Add global size arguments for consistency GRR0F402.49
CLL with SWAPA2O2. R. Rawlins GRR0F402.50
CLL 4.2 11/10/96 : Enable atmos-ocean coupling for MPP. GRR1F402.306
CLL (2): Swap D1 memory. New argument in TRANSIN, GRR1F402.307
CLL TRANSOUT routines. R. Rawlins GRR1F402.308
CLL 4.5 1/07/98 Include code to pass atmospheric surface CO2 CCN1F405.344
CLL C.D.Jones CCN1F405.345
CLL SWAPA2O1.21
CLL Programming standard: UM Doc Paper 3, version 2 (7/9/90) SWAPA2O1.22
CLL SWAPA2O1.23
CLL Logical components covered: C??? SWAPA2O1.24
CLL SWAPA2O1.25
CLL Project task: C0 SWAPA2O1.26
CLL SWAPA2O1.27
CLL External documentation: SWAPA2O1.28
CLL Unified Model Doc Paper C2 - Atmosphere-Ocean coupling: overview CCN1F405.346
CLL SWAPA2O1.30
CLL ------------------------------------------------------------------- SWAPA2O1.31
C*L Interface and arguments: ------------------------------------------ SWAPA2O1.32
C SWAPA2O1.33
SUBROUTINE SWAP_A2O (G_P_FIELD,G_IMTJMT,CO2_DIMA,CO2_DIMO, 2,53CCN1F405.347
*CALL ARGSIZE 
@DYALLOC.3489
*CALL ARGD1 @DYALLOC.3490
*CALL ARGDUMO @DYALLOC.3491
*CALL ARGPTRA @DYALLOC.3492
*CALL ARGPTRO @DYALLOC.3493
*CALL ARGCONA @DYALLOC.3494
*CALL ARGCONO CJG6F401.18
*CALL ARGAOCPL @DYALLOC.3495
& ICODE,CMESSAGE) SWAPA2O1.35
C SWAPA2O1.36
IMPLICIT NONE SWAPA2O1.37
C SWAPA2O1.38
*CALL CMAXSIZE @DYALLOC.3496
*CALL TYPSIZE @DYALLOC.3497
*CALL TYPD1 @DYALLOC.3498
*CALL TYPDUMO @DYALLOC.3499
*CALL TYPPTRA @DYALLOC.3500
*CALL TYPPTRO @DYALLOC.3501
*CALL TYPCONA @DYALLOC.3502
*CALL TYPCONO CJG6F401.19
*CALL TYPAOCPL @DYALLOC.3503
C @DYALLOC.3504
INTEGER G_P_FIELD, ! IN Not used: required for GRR0F402.52
& G_IMTJMT ! IN consistency with MPP GRR0F402.53
& ,CO2_DIMA ! IN : dimension of atmos CO2 array CCN1F405.348
& ,CO2_DIMO ! IN : dimension of ocean CO2 array CCN1F405.349
& ,CO2_ICOLS,CO2_JROWS ! OUT: CO2 array dimensions CCN1F405.350
& ,CO2_IMT, CO2_JMT CCN1F405.351
INTEGER SWAPA2O1.39
& ICODE ! OUT - Error return code SWAPA2O1.42
CHARACTER*(*) CMESSAGE ! OUT - Error return message SWAPA2O1.43
C*---------------------------------------------------------------------- SWAPA2O1.44
C Common blocks SWAPA2O1.45
C SWAPA2O1.46
*CALL CAOPTR SWAPA2O1.50
*CALL C_LHEAT SWAPA2O1.51
*CALL C_0_DG_C SWAPA2O1.52
*CALL C_MDI SWAPA2O1.53
*CALL CHSUNITS RS030293.131
*CALL CNTLALL GDR3F305.185
*CALL TYPOCDPT CJG6F401.20
*CALL CSMID GRR1F402.309
*CALL CNTLATM CCN1F405.352
C SWAPA2O1.56
C Subroutines called SWAPA2O1.57
C SWAPA2O1.58
EXTERNAL TRANSOUT,TRANSIN,TRANSA2O CJG6F401.21
C SWAPA2O1.60
C Local variables SWAPA2O1.61
C SWAPA2O1.62
INTEGER SWAPA2O1.63
& NFTASWAP,NFTOSWAP, ! FT units for swap files SWAPA2O1.64
& I ! Loop index SWAPA2O1.65
*IF DEF,TRANGRID,OR,DEF,RIVERS SWAPA2O1.66
LOGICAL SWAPA2O1.67
& AMASKTP(P_FIELD) ! Atmosphere land-sea mask @DYALLOC.3505
*ENDIF SWAPA2O1.69
REAL SWAPA2O1.70
& TAUX(P_FIELD),TAUY(P_FIELD), ! Surface windstress @DYALLOC.3508
& WINDMIX(P_FIELD), ! Windmixing power @DYALLOC.3509
& SOLAR(P_FIELD), ! Surface net solar @DYALLOC.3510
& BLUE(P_FIELD), ! Surface net blueband solar @DYALLOC.3511
& EVAP(P_FIELD), ! Evaporation over sea @DYALLOC.3512
& LONGWAVE(P_FIELD), ! Net downward longwave @DYALLOC.3513
& SENSIBLE(P_FIELD), ! Sensible heat flux @DYALLOC.3514
& LSSNOW(P_FIELD),CVSNOW(P_FIELD),! LS and CV snowfall rates @DYALLOC.3515
& LSRAIN(P_FIELD),CVRAIN(P_FIELD) ! LS and CV rainfall rates @DYALLOC.3516
&, ATMCO2(CO2_DIMA) ! atmospheric surface CO2 CCN1F405.353
CCN1F405.354
*IF DEF,SEAICE SWAPA2O1.82
&, AICE(P_FIELD), ! Seaice fraction @DYALLOC.3517
& SUBLIM(P_FIELD), ! Sublimation @DYALLOC.3518
& BOTMELT(P_FIELD), ! Bottom melting heat flux @DYALLOC.3519
& TOPMELT(P_FIELD) ! Top melting heat flux @DYALLOC.3520
*ENDIF SWAPA2O1.87
*IF DEF,RIVERS SWAPA2O1.88
INTEGER SWAPA2O1.89
& OCENTPTS(P_FIELD) ! Ocean entry points index @DYALLOC.3521
REAL SWAPA2O1.91
& RUNOFFIN(P_FIELD) ! Total runoff from land @DYALLOC.3522
*ENDIF SWAPA2O1.93
CL---------------------------------------------------------------------- SWAPA2O1.94
CL 1. Copy coupling fields from atmosphere D1 addresses to workspace. SWAPA2O1.95
CL Note that sublimation must be converted from total amount over SWAPA2O1.96
CL the coupling period, to rate. The same is also true for runoff. SWAPA2O1.97
CL Ocean entry points field is dimensioned P_FIELD, but only @DYALLOC.3523
CL LAND_FIELD points are needed since the field is compressed. SWAPA2O1.99
CL SWAPA2O1.100
DO I=1,P_FIELD @DYALLOC.3524
TAUX(I)=D1(JA_TAUX+I-1) ! NB: TAUX and TAUY are SWAPA2O1.102
TAUY(I)=D1(JA_TAUY+I-1) ! over-dimensioned SWAPA2O1.103
WINDMIX(I)=D1(JA_WINDMIX+I-1) SWAPA2O1.104
SOLAR(I)=D1(JA_SOLAR+I-1) SWAPA2O1.105
BLUE(I)=D1(JA_BLUE+I-1) SWAPA2O1.106
EVAP(I)=D1(JA_EVAP+I-1) SWAPA2O1.107
LONGWAVE(I)=D1(JA_LONGWAVE+I-1) SWAPA2O1.108
SENSIBLE(I)=D1(JA_SENSIBLE+I-1) SWAPA2O1.109
LSSNOW(I)=D1(JA_LSSNOW+I-1) SWAPA2O1.110
CVSNOW(I)=D1(JA_CVSNOW+I-1) SWAPA2O1.111
LSRAIN(I)=D1(JA_LSRAIN+I-1) SWAPA2O1.112
CVRAIN(I)=D1(JA_CVRAIN+I-1) SWAPA2O1.113
*IF DEF,SEAICE SWAPA2O1.114
AICE(I)=D1(JA_AICE+I-1) SWAPA2O1.115
SUBLIM(I)=D1(JA_SUBLIM+I-1)/REAL(MODEL_HRS_PER_GROUP*3600) SWAPA2O1.116
BOTMELT(I)=D1(JA_BOTMELT+I-1) SWAPA2O1.117
TOPMELT(I)=D1(JA_TOPMELT+I-1) SWAPA2O1.118
*ENDIF SWAPA2O1.119
*IF DEF,TRANGRID,OR,DEF,RIVERS SWAPA2O1.120
AMASKTP(I)=LD1(JLAND+I-1) SWAPA2O1.121
*ENDIF SWAPA2O1.122
*IF DEF,RIVERS SWAPA2O1.123
RUNOFFIN(I)=(D1(JA_SLOWRUNOFF+I-1)+D1(JA_FASTRUNOFF+I-1))/ SWAPA2O1.124
* REAL(MODEL_HRS_PER_GROUP*3600) SWAPA2O1.125
*ENDIF SWAPA2O1.126
ENDDO SWAPA2O1.127
*IF DEF,RIVERS SWAPA2O1.128
DO I=1,LAND_FIELD SWAPA2O1.129
OCENTPTS(I)=ID1(JA_OCENTPTS+I-1) SWAPA2O1.130
ENDDO SWAPA2O1.131
*ENDIF SWAPA2O1.132
IF (L_CO2_INTERACTIVE) THEN CCN1F405.355
DO I=1,CO2_DIMA CCN1F405.356
ATMCO2(I)=D1(JA_CO2+I-1) CCN1F405.357
ENDDO CCN1F405.358
ENDIF CCN1F405.359
SWAPA2O1.133
CL---------------------------------------------------------------------- SWAPA2O1.134
CL 2. Perform IO to swap data in D1 from atmosphere to ocean SWAPA2O1.135
CL SWAPA2O1.136
NFTASWAP=18 SWAPA2O1.137
NFTOSWAP=19 SWAPA2O1.138
C SWAPA2O1.139
CALL TRANSOUT( @DYALLOC.3525
*CALL ARGD1 @DYALLOC.3526
& A_LEN_DATA+(P_LEVELS+1+2*Q_LEVELS)*P_FIELD, @DYALLOC.3527
& NFTASWAP,atmos_sm,ICODE,CMESSAGE) GRR1F402.310
IF (ICODE.GT.0) GOTO 999 SWAPA2O1.142
C SWAPA2O1.143
CALL TRANSIN ( @DYALLOC.3528
*CALL ARGD1 @DYALLOC.3529
& O_LEN_DATA+O_LEN_DUALDATA, GSI0F402.29
& NFTOSWAP,ocean_sm,ICODE,CMESSAGE) GRR1F402.311
IF (ICODE.GT.0) GOTO 999 SWAPA2O1.146
CL---------------------------------------------------------------------- SWAPA2O1.157
CL 3. Perform the coupling calculations SWAPA2O1.158
CL SWAPA2O1.159
IF (L_CO2_INTERACTIVE) THEN CCN1F405.360
CO2_ICOLS = ROW_LENGTH CCN1F405.361
CO2_JROWS = P_ROWS CCN1F405.362
CO2_IMT = IMT CCN1F405.363
CO2_JMT = JMT CCN1F405.364
ELSE CCN1F405.365
ATMCO2(1) = 0.0 CCN1F405.366
CO2_ICOLS = 1 CCN1F405.367
CO2_JROWS = 1 CCN1F405.368
CO2_IMT = 1 CCN1F405.369
CO2_JMT = 1 CCN1F405.370
ENDIF CCN1F405.371
CALL TRANSA2O ( SWAPA2O1.160
& TAUX,D1(JO_TAUX),TAUY,D1(JO_TAUY),WINDMIX,D1(JO_WINDMIX), SWAPA2O1.162
& SOLAR,BLUE,D1(JO_BLUE),EVAP,LONGWAVE,SENSIBLE,D1(JO_HEATFLUX), SWAPA2O1.163
& LSSNOW,CVSNOW,LSRAIN,CVRAIN,D1(JO_PMINUSE), SWAPA2O1.164
& RMDI,LC, SWAPA2O1.165
*IF DEF,SEAICE SWAPA2O1.166
& AICE,SUBLIM,BOTMELT,TOPMELT, SWAPA2O1.167
& D1(JO_SNOWFALL),D1(JO_SUBLIM),D1(JO_BOTMELT),D1(JO_TOPMELT), SWAPA2O1.168
*ENDIF SWAPA2O1.169
*IF DEF,TRANGRID SWAPA2O1.170
& XUO,XTO,YUO,YTO,XTA,XUA,YTA,YUA, SWAPA2O1.171
*ENDIF SWAPA2O1.172
*IF DEF,TRANGRID,OR,DEF,RIVERS SWAPA2O1.173
& AMASKTP, SWAPA2O1.174
*ENDIF SWAPA2O1.175
*IF DEF,RIVERS SWAPA2O1.176
+ RUNOFFIN,OCENTPTS,D1(JO_RIVEROUT),LAND_FIELD, SWAPA2O1.177
+ COS_P_LATITUDE, SWAPA2O1.178
*ENDIF SWAPA2O1.179
& ATMCO2, D1(JO_CO2), CO2_ICOLS, CO2_JROWS, CO2_IMT, CO2_JMT, CCN1F405.372
+ IMT,JMT,JMTM1,ROW_LENGTH,P_ROWS,U_ROWS CJG6F401.22
&,(IMT+ROW_LENGTH)*(JMT+P_ROWS),O_FLDDEPC,O_SPCON(jocp_fkmq) CJG6F401.23
+,INVERT_OCEAN,CYCLIC_OCEAN,GLOBAL_OCEAN CJG6F401.24
&,icode,cmessage) CJG6F401.25
C SWAPA2O1.182
999 CONTINUE SWAPA2O1.183
RETURN SWAPA2O1.184
CL---------------------------------------------------------------------- SWAPA2O1.185
END SWAPA2O1.186
*ENDIF SWAPA2O1.187