SUBROUTINE SET_CONSTANTS_OCEAN( 1,41@DYALLOC.4187
*CALL ARGSIZE 
@DYALLOC.4188
*CALL ARGOCALL @DYALLOC.4189
& ICODE, CMESSAGE, @DYALLOC.4190
& SWLDEG,O_LEVDEPC,O_ROWDEPC @DYALLOC.4191
&,PHI_POLE,WEDGEDEG OSETCON.25
&,O_COLDEPC,FKMP_GLOBAL,L_STASH_LAND ORH2F405.3
&,IMT_CLN_ARG,JMT_CLN_ARG,IMT_BIO_ARG ORH2F405.4
&,LTIMER_ARG) ORH1F305.16
C OSETCON.27
C Common blocks, following COX but adapted for UM and minus OSETCON.28
C those variables appearing in the argument list OSETCON.29
C OSETCON.30
C RH141293.47
IMPLICIT NONE RH141293.48
C RH141293.49
INTEGER I, ! Grid point index (Zonal) RH141293.50
& J, ! Grid point index (Meridional) RH141293.51
& K, ! Grid point index (Vertical) RH141293.52
& L, ! Ocean segment loop control RH141293.53
& IBK, ! Index counter.. topography map printing RH141293.54
& IEPT, ! Index counter " " " RH141293.55
& IEPU, ! Index counter " " " RH141293.56
& ISP, ! Index counter " " " RH141293.57
& JREV, ! Index counter (reverse order of J) RH141293.58
& LSEGP ! LSEG + 1 (vorticity indices) RH141293.59
& ,JJ,J1,J2 ! local loop counters ORL1F404.190
& ,SEG_COUNT ! local segment counter for filter ORL1F404.191
C RH141293.60
REAL RADIUS_SI, ! Radius of Earth (metres) RH141293.61
& FIMAX, ! Maximum latitude value RH141293.62
& FIMIN, ! Minimum latitute value RH141293.63
& FIAVE ! Average latitude RH141293.64
LOGICAL LTIMER_ARG ORH1F305.17
C RH141293.65
*CALL OARRYSIZ ORH6F401.13
*CALL TYPSIZE @DYALLOC.4192
*CALL COCNINDX PXORDER.36
*CALL TYPOCALL @DYALLOC.4193
*CALL UMSCALAR OSETCON.33
*CALL CNTLOCN ORH1F305.18
*CALL OTIMER ORH1F305.20
*CALL PARVARS ORH7F402.300
*CALL GCCOM ORH7F402.302
C OSETCON.39
C Argument list OSETCON.40
C OSETCON.41
REAL OSETCON.42
& FKMP_GLOBAL(IMT,JMT_GLOBAL) ! IN no. of vert levels at T pts ORH6F402.31
&,FKMZ_GLOBAL(IMT,JMT_GLOBAL) ! No. of vert levels at ORH6F402.32
& ! interior T points ORH6F402.33
&,O_LEVDEPC(*) ! IN vertical grid spacing across U,V,T boxes OSETCON.44
&,O_ROWDEPC(*) ! IN meridional grid spacing across T boxes OSETCON.45
&,O_COLDEPC(*) ! IN zonal grid spacing across T boxes OSETCON.46
&,SWLDEG ! IN latitude in degrees of southern wall OSETCON.47
&,PHI_POLE ! IN LATITUDE IN DEGREES OF NEW NORTH POLE OSETCON.48
&,WEDGEDEG ! IN LONGITUDE IN DEGREES OF WESTERN EDGE OSETCON.49
ORH2F405.5
LOGICAL L_STASH_LAND(ICOL_CYC,JMT) ORH2F405.6
c @DYALLOC.4194
INTEGER @DYALLOC.4195
& ICODE ! OUT Error code @DYALLOC.4196
&,IMT_CLN_ARG ! IMT_CLN passed through arg list - avoids ORH1F305.21
&,JMT_CLN_ARG ! JMT_CLN dynamic allocation problems ORH1F305.22
&,IMT_BIO_ARG ! IMT_BIO with portable model. ORH1F305.23
C OSETCON.50
CHARACTER*(80) ONF0F304.8
& CMESSAGE ! OUT Error message @DYALLOC.4198
C @DYALLOC.4199
C Local parameters MB061293.6
REAL TOL_POLE ! used to check whether PHI_POLE is close to 90.0 MB061293.7
PARAMETER ( TOL_POLE = 0.0001 ) MB061293.8
C MB061293.9
C Locally defined arrays OSETCON.51
C OSETCON.52
REAL DYT_GLOBAL(JMT_GLOBAL) ! Full array of DYT - all PEs ORH3F402.443
&, CST_GLOBAL(JMT_GLOBAL) ! Full array of CST - all PEs. ORH3F402.444
*IF DEF,MPP ORH3F402.445
REAL HR_TMP(IMT) ! Temporary array for HR values ORH3F402.446
& ,DAYLEN_TMP(360) ! Temporary array for DAYLEN vals ORH3F402.447
ORH3F402.448
INTEGER PE_SEND ! Pe of sending proc (msg passing) ORH3F402.449
& , PE_RECV ! Pe of recving proc (msg passing) ORH3F402.450
& , INFO ORH3F402.451
& , IPROC ! Loop index ORH3F402.452
*ENDIF ORH3F402.453
ORH1F305.24
REAL SN260893.2
& FKMZ(IMT_CLN_ARG,JMT_CLN_ARG) ! no. of vert. levels at ORH1F305.25
! interior T points ORH1F305.26
ORH1F305.27
*IF DEF,MPP ORH9F402.1
INTEGER J_PE_IND(JMT_GLOBAL) ORH9F402.2
*ENDIF ORH9F402.3
REAL SN260893.4
& SUMDY ! summation of DYT SN260893.5
&,SUMDX ! SUMMATION OF DXT ORH1F305.28
&,FI ! REFERENCE LATITUDE @DYALLOC.4201
&,FI1 ! MIN REFERENCE LATITUDE @DYALLOC.4202
&,FI2 ! MAX REFERENCE LATITUDE @DYALLOC.4203
&,FIA ! LATITUDE OF FIRST ROW @DYALLOC.4204
&,FIB ! LATITUDE OF LAST ROW @DYALLOC.4205
&,FX,FXA,FXB,FXC ! Temporary scalars NT080993.38
&,PHI_1 ! } ORH3F402.454
&,PHI_JMT ! } Temporary scalars ORH3F402.455
&,PHIT_1 ! } ORH3F402.456
&,DYT_1 ! } ORH3F402.457
ORH3F402.458
REAL PHI_GLOBAL(JMT_GLOBAL), ORH3F402.459
& PHIT_GLOBAL(JMT_GLOBAL) ORH3F402.460
ORH3F402.461
INTEGER J_INDEX ORH3F402.462
INTEGER PE_BCAST ORH3F403.188
ORH1F305.29
REAL NT080993.40
& DECLIN(360) ! Declination angle (radians) for each day of the yea NT080993.41
&,CS_HOUR_ANG(IMT_BIO_ARG) ORH1F305.30
&,DLCOA,DLCOB,DLCOC,DLCOD ! Intermediates in calc. of light NT080993.43
&,DLCOBP,DLCOCP,DLCODP ! model layer constants NT080993.44
C NT080993.45
C Note that the 360 in the dimensioning of DECLIN refers to NT080993.46
C number of days in a climatological year - ie 360-day year is NT080993.47
C assumed as biological model would only be using for climate NT080993.48
C runs. NT080993.49
C NT080993.50
REAL med_vol ! hardwired volume flux into/out of Med OOM2F405.36
& ,hud_vol ! hardwired volume flux into/out Hudson Bay OOM2F405.37
OOM2F405.38
ORH1F305.31
INTEGER @DYALLOC.4207
& IS,IB,JCOUNT ! local loop counters @DYALLOC.4208
&,LD,LSGCM1 ! local loop counters RH141293.66
&,OPEN_STATUS @DYALLOC.4209
CHARACTER*80 FILENAME ! local for open statement @DYALLOC.4210
ORH1F305.32
CHARACTER*1 DOT,BLK,ABT(2000) ONF1F304.3
INTEGER KPR(IMT) OSETCON.65
DATA DOT/'.'/,BLK/' '/ OSETCON.66
C OSETCON.67
C OSETCON.68
C--------------------------------------------------------------------- OSETCON.69
C BEGIN EXECUTABLE CODE OSETCON.70
C--------------------------------------------------------------------- OSETCON.71
C OSETCON.72
C======================================================================= OSETCON.73
C BEGIN INTRODUCTORY SECTION WHICH IS NEEDED FOR EACH RUN ============ OSETCON.74
C (INCLUDING RESTARTS) ============ OSETCON.75
C======================================================================= OSETCON.76
C OSETCON.77
C OSETCON.79
L_OTIMER = LTIMER_ARG ORH1F305.33
ORH1F305.34
ORH1F305.36
IF (IMT .GT. 2000) THEN ONF1F304.4
WRITE(6,*)'Error:ABT array in Subroutine SET_CONSTANTS_OCEAN GIE0F403.454
& is too small' ONF1F304.6
CALL ABORT ONF1F304.7
ENDIF ONF1F304.8
ORH6F404.9
LABS(1)=13 OSETCON.82
LABS(2)=14 OSETCON.83
LABS(3)=15 OSETCON.84
PI=3.1415927 OSETCON.85
OMEGA=3.1415927/43082. OSETCON.86
RADIUS_SI=6370.E3 ! radius of earth m OSETCON.87
RADIUS=RADIUS_SI*100. ! radius of earth cm OSETCON.88
RADIAN=57.29578 OSETCON.89
GRAV_SI=9.806 ! MS-2 OSETCON.90
GRAV=GRAV_SI*100. ! CMS-2 OSETCON.91
RHO_WATER_SI=1026. ! KgM-3 OSETCON.92
SPECIFIC_HEAT_SI=3988. ! JKg-1K-1 OSETCON.93
ORH1F305.37
! The following are required when L_SEAICE = true ORH1F305.38
TFREEZE=-1.8 ! Freezing point of seawater in Celsius OSETCON.95
QFUSION=3.3352E+5 ! latent heat of fusion of ice Jkg-1 OCC0F400.23
RHOICE=900.0 ! Density of ice, in kg/m**3. OSETCON.104
RHOSNOW=300.0 ! Density of snow, in kg/m**3. OSETCON.105
RHOWATER=1000.0 ! Density of water, in kg/m**3. OCC0F400.24
ORH1F305.39
! The following are required when L_OPSEUDIC = true ORH1F305.40
TFREEZ=-1.8 !Freezing point of seawater OSETCON.108
TCHECK=TFREEZ + 1.E-5 !Value for .LE. test OSETCON.109
ORH1F305.41
ORH1F305.42
! The following are required when L_ORICHARD = true ORH1F305.43
GNUMINC_SI=1.E-3 !Min. vert. viscosity between top 2 levels OSETCON.112
GNUMINT_SI=1.E-3 !Min. vert. diffusivity " " " " OSETCON.113
ORH6F404.10
DO J = 1 , JMT ORH6F404.11
DO I = 1, IMT ORH6F404.12
FKMP(I,J) = 0.0 ORH6F404.13
ENDDO ORH6F404.14
ENDDO ORH6F404.15
*IF DEF,MPP ORH9F402.4
! Populate the portion of the PE index array which applies to ORH9F402.5
! the rows handled by this PE. ORH9F402.6
DO J = JST, JFIN ORH9F402.7
J_PE_IND(J)=O_MYPE ORH9F402.8
ENDDO ORH9F402.9
ORH9F402.10
ORH9F402.11
ORH9F402.12
CALL O_SMARTPASS(J_PE_IND(JST),J_PE_IND(1),1.0,1.0 ORH9F402.13
& ,JFIN-JST+1,JMT_GLOBAL,JST,1) ORH9F402.14
ORH9F402.15
! Now set up J_PE_xxx values for use later in the model. ORH9F402.16
J_PE_JSTM1=-1 ORH9F402.17
J_PE_JSTM2=-1 ORH9F402.18
J_PE_JFINP1=-1 ORH9F402.19
J_PE_JFINP2=-1 ORH9F402.20
ORH9F402.21
IF (JST.GT.1) J_PE_JSTM1=J_PE_IND(JST-1) ORH9F402.22
IF (JST.GT.2) J_PE_JSTM2=J_PE_IND(JST-2) ORH9F402.23
IF (JFIN.LT.JMT_GLOBAL) J_PE_JFINP1=J_PE_IND(JFIN+1) ORH9F402.24
IF (JFIN.LT.JMT_GLOBAL-1) J_PE_JFINP2=J_PE_IND(JFIN+2) ORH9F402.25
ORH9F402.26
*ENDIF ORH9F402.27
IF ((L_OMEDOUT).AND.(.NOT.L_OMEDADV)) THEN OOM2F405.39
C OJG1F404.8
C Set i and j indices, number of levels and fraction mixed for points OJG1F404.9
C involved in the Med outflow calculation. OJG1F404.10
C **NB** tendfrc is very different for the 288x144 and 96x73 oceans. OJG1F404.11
C This is a difference of parametrisation rather than resolution. In OJG1F404.12
C HADCM2, mixing is complete; in HADCM3, it is limited. OJG1F404.13
C OJG1F404.14
if (jmt_global.eq.144.and.imt.eq.290) then OJG1F404.15
C These points refer to the HADCM3 1.25 degree ocean configuration OJG1F404.16
imout(1) = 282 OJG1F404.17
imout(2) = 282 OJG1F404.18
imout(3) = 288 OJG1F404.19
imout(4) = 288 OJG1F404.20
jmout(1) = 100 OJG1F404.21
jmout(2) = 101 OJG1F404.22
jmout(3) = 102 OJG1F404.23
jmout(4) = 103 OJG1F404.24
NMEDLEV = 13 OJG1F404.25
tendfrc =9.6e-5 OJG1F404.26
elseif (jmt_global.eq.73.and.imt.eq.98) then OJG1F404.27
C These points refer to the 3.75 x 2.5 configuration e.g. HADCM2 OJG1F404.28
imout(1)=95 OJG1F404.29
imout(2)=3 OJG1F404.30
imout(3)=0 OJG1F404.31
imout(4)=0 OJG1F404.32
jmout(1)=51 OJG1F404.33
jmout(2)=52 OJG1F404.34
jmout(3)=0 OJG1F404.35
jmout(4)=0 OJG1F404.36
nmedlev=13 OJG1F404.37
tendfrc=1.0 OJG1F404.38
else OJG1F404.39
write(*,'(a/a)') OJG1F404.40
& 'OSETCON: Mediterranean outflow requested '// OJG1F404.41
& 'for an unsupported grid' OJG1F404.42
call abort OJG1F404.43
endif OJG1F404.44
C Initialise values of variable to avoid passing unset values around OJG1F404.45
do i=1,4 OJG1F404.46
J_PE_IND_MED(i)=1 OJG1F404.47
enddo OJG1F404.48
*IF DEF,MPP OJG1F404.49
C Set PE number for each processor involved in Med outflow OJG1F404.50
do i=1,4 OJG1F404.51
if (jmout(i).ne.0) J_PE_IND_MED(i)=J_PE_IND(jmout(i)) OJG1F404.52
enddo OJG1F404.53
*ENDIF OJG1F404.54
ENDIF ! L_OMEDOUT = true OJG1F404.55
IF (L_OMEDADV) THEN OOM2F405.40
C This is an alternative Mediterranean outflow param, which OOM2F405.41
C is advective rather than diffusive. It seems to give a better OOM2F405.42
C representation of the salinity tongue, and uses different points from OOM2F405.43
C the above scheme OOM2F405.44
if (jmt_global.eq.144.and.imt.eq.290) then OOM2F405.45
C these are the points involved for standard 1.25 resolution models OOM2F405.46
imout(1)=281 OOM2F405.47
imout(2)=281 OOM2F405.48
imout(3)=288 OOM2F405.49
imout(4)=288 OOM2F405.50
jmout(1)=102 OOM2F405.51
jmout(2)=103 OOM2F405.52
jmout(3)=102 OOM2F405.53
jmout(4)=103 OOM2F405.54
nmedlev=12 OOM2F405.55
tendfrc=9.6e-5 OOM2F405.56
C med_vol is the hard-wired transport (in cm**3/s) of water being OOM2F405.57
C exchanged between the Atlantic and the Mediterranean OOM2F405.58
med_vol=0.3e12 OOM2F405.59
lev_med=12 ! outflow at level lev_med OOM2F405.60
med_topflow=7 ! inflow at levels 1 to med_topflow OOM2F405.61
c first is in Hudson, second in Atlantic OOM2F405.62
imout_hud(1)=233 OOM2F405.63
imout_hud(2)=233 OOM2F405.64
imout_hud(3)=234 OOM2F405.65
imout_hud(4)=234 OOM2F405.66
jmout_hud(1)=122 OOM2F405.67
jmout_hud(2)=123 OOM2F405.68
jmout_hud(3)=120 OOM2F405.69
jmout_hud(4)=121 OOM2F405.70
C hud_vol is the hard-wired transport (in cm**3/s) of water being OOM2F405.71
C exchanged between the Atlantic and the Hudson Bay OOM2F405.72
hud_vol=0.4e12 OOM2F405.73
lev_hud=8 ! inflow at level lev_hud for Hudson Bay OOM2F405.74
OOM2F405.75
elseif (jmt_global.eq.73.and.imt.eq.98) then OOM2F405.76
C these are the points for standard 2.5x3.75 models OOM2F405.77
imout(1)=94 OOM2F405.78
imout(2)=94 OOM2F405.79
imout(3)=2 OOM2F405.80
imout(4)=2 OOM2F405.81
jmout(1)=52 OOM2F405.82
jmout(2)=53 OOM2F405.83
jmout(3)=53 OOM2F405.84
jmout(4)=54 OOM2F405.85
nmedlev=11 OOM2F405.86
tendfrc=1.0 OOM2F405.87
med_vol=0.3e12 OOM2F405.88
lev_med=11 ! outflow at level lev_med OOM2F405.89
med_topflow=7 ! inflow at levels 1 to med_topflow OOM2F405.90
c first is in Hudson, second in Atlantic OOM2F405.91
imout_hud(1)=76 ! 8 levels OOM2F405.92
imout_hud(2)=76 ! 5 levels OOM2F405.93
imout_hud(3)=80 ! 8 levels OOM2F405.94
imout_hud(4)=80 ! 5 levels OOM2F405.95
jmout_hud(1)=60 OOM2F405.96
jmout_hud(2)=61 OOM2F405.97
jmout_hud(3)=62 OOM2F405.98
jmout_hud(4)=63 OOM2F405.99
hud_vol=0.4e12 OOM2F405.100
lev_hud=5 ! inflow at level lev_hud for Hudson Bay OOM2F405.101
else OOM2F405.102
write(*,'(a/a)') OOM2F405.103
& 'OSETCON: Mediterranean outflow requested '// OOM2F405.104
& 'for an unsupported grid' OOM2F405.105
call abort OOM2F405.106
endif OOM2F405.107
C Initialise values of variable to avoid passing unset values around OOM2F405.108
do i=1,4 OOM2F405.109
J_PE_IND_MED(i)=1 OOM2F405.110
J_PE_IND_HUD(i)=1 OOM2F405.111
enddo OOM2F405.112
*IF DEF,MPP OOM2F405.113
C Set PE number for each processor involved in Med outflow OOM2F405.114
do i=1,4 OOM2F405.115
if (jmout(i).ne.0) J_PE_IND_MED(i)=J_PE_IND(jmout(i)) OOM2F405.116
if (jmout_hud(i).ne.0) OOM2F405.117
& J_PE_IND_HUD(i)=J_PE_IND(jmout_hud(i)) OOM2F405.118
enddo OOM2F405.119
*ENDIF OOM2F405.120
ENDIF ! L_OMEDADV = true OOM2F405.121
OOM2F405.122
C OSETCON.115
C--------------------------------------------------------------------- OSETCON.116
C SET Y DIMENSION OF BOXES IN DEGREES AND CONVERT TO CENTIMETERS OSETCON.117
C--------------------------------------------------------------------- OSETCON.118
C OSETCON.119
ORH3F402.463
DO J=2,JMTM1_GLOBAL ORH6F404.16
DYT_GLOBAL(J)=O_ROWDEPC(J)*RADIUS/RADIAN ORH3F402.465
IF (JST.LE.J.AND.JFIN.GE.J) THEN ORH3F402.466
! Set up local versions of DYT ORH3F402.467
DYT(J-J_OFFSET) = DYT_GLOBAL(J) ORH3F402.468
ENDIF ORH3F402.469
ENDDO ORH6F404.17
DYT_GLOBAL(1) = DYT_GLOBAL(2) ORH3F402.470
DYT_GLOBAL(JMT_GLOBAL) = DYT_GLOBAL(JMTM1_GLOBAL) ORH3F402.471
DYT_1 = DYT_GLOBAL(1) ORH3F402.472
ORH3F402.473
ORH3F402.474
IF (JST.EQ.1) THEN ORH3F402.475
DYT(J_1)=DYT_GLOBAL(1) ORH3F402.476
ENDIF ORH3F402.477
ORH3F402.478
IF (JFIN.EQ.JMT_GLOBAL) THEN ORH3F402.479
DYT(J_JMT)=DYT_GLOBAL(JMT_GLOBAL) ORH3F402.480
ENDIF ORH3F402.481
ORH3F402.482
*IF DEF,MPP ORH3F402.483
ORH3F402.484
! We need DYT at J-1 for all processes ORH3F402.485
CALL SWAPBOUNDS (DYT,1,JMT,O_EW_Halo,O_NS_Halo,1) ORH3F402.486
ORH3F402.487
ORH3F402.494
*ENDIF ORH3F402.495
C OSETCON.125
C--------------------------------------------------------------------- OSETCON.126
C SET X DIMENSION OF BOXES IN DEGREES AND CONVERT TO CENTIMETERS OSETCON.127
C--------------------------------------------------------------------- OSETCON.128
C OSETCON.129
DO I=2,IMTM1 ORH6F404.18
DXT(I)=O_COLDEPC(I)*RADIUS/RADIAN OSETCON.131
ENDDO ORH6F404.19
DXT(1)=DXT(2) OSETCON.133
DXT(IMT)=DXT(IMTM1) OSETCON.134
ORH1F305.44
IF (L_OCYCLIC) THEN ORH1F305.45
C OSETCON.136
C SET CYCLIC CONDITIONS ON DXT OSETCON.137
C OSETCON.138
DXT(1)=DXT(IMTM1) ORH1F305.46
DXT(IMT)=DXT(2) ORH1F305.47
ENDIF ORH1F305.48
C OSETCON.142
C--------------------------------------------------------------------- OSETCON.143
C SET Z DIMENSION OF BOXES (IN CENTIMETERS) OSETCON.144
C--------------------------------------------------------------------- OSETCON.145
C OSETCON.146
DO K=1,KM OSETCON.147
DZ(K)=O_LEVDEPC(K)*100. OSETCON.148
END DO OSETCON.149
C OSETCON.150
C--------------------------------------------------------------------- OSETCON.151
C COMPUTE AUXILIARY ARRAYS BASED UPON THE SPACING SPECIFIED ABOVE OSETCON.152
C--------------------------------------------------------------------- OSETCON.153
C OSETCON.154
DO K=1,KM ORH6F404.20
C2DZ(K)=2.0*DZ(K) OSETCON.156
DZ2R(K)=1.0/C2DZ(K) OSETCON.157
ENDDO ORH6F404.21
DZZ(1)=0.5*DZ(1) OSETCON.159
ZDZ(1)=DZ(1) OSETCON.160
DO K=2,KM ORH6F404.22
DZZ(K)=0.5*(DZ(K-1)+DZ(K)) OSETCON.162
ZDZ(K)=ZDZ(K-1)+DZ(K) OSETCON.163
ENDDO ORH6F404.23
DZZ(KM+1)=0.5*DZ(KM) OSETCON.165
DZZ2R(KMP1)=0.5/DZZ(KMP1) OSETCON.166
ZDZZ(1)=DZZ(1) OSETCON.167
DO K=1,KM ORH6F404.24
DZZ2R(K)=.5/DZZ(K) OSETCON.169
ZDZZ(K+1)=ZDZZ(K)+DZZ(K+1) OSETCON.170
ORH1F305.49
IF (.NOT.L_ORICHARD) THEN ORH1F305.50
EEH(K)=FKPH/(DZ(K)*DZZ(K)) ORH1F305.51
FFH(K)=FKPH/(DZ(K)*DZZ(K+1)) ORH1F305.52
EEM(K)=FKPM/(DZ(K)*DZZ(K)) ORH1F305.53
FFM(K)=FKPM/(DZ(K)*DZZ(K+1)) ORH1F305.54
ENDIF ORH1F305.55
KAR(K)=K OSETCON.177
ENDDO ORH6F404.25
IF (L_OMEDADV) THEN OOM2F405.123
med_in=med_vol/(dyt(1)*zdz(med_topflow)) OOM2F405.124
med_out=-med_vol/(dyt(1)*(dz(lev_med))) OOM2F405.125
C _in is just the near-surface flow, which is not necessarily inflow OOM2F405.126
hud_in=hud_vol/(dyt(1)*zdz(lev_hud-1)) OOM2F405.127
hud_out=-hud_vol/(dyt(1)*dz(lev_hud)) OOM2F405.128
ENDIF OOM2F405.129
OOM2F405.130
C RW071293.4
C Set up depth-dependent background vertical diffusivity KAPPA_B_SI. RW071293.5
C Taken to be a linear increase with depth from KAPPA0_SI at the RW071293.6
C surface,increasing with depth at a rate DKAPPA_DZ_SI. Setting RW071293.7
C KAPPA0_SI=1.E-5 m2/s, DKAPPA_DZ_SI=2.8E-8 m/s gives a good fit to the RW071293.8
C theoretical/observational profile shown by Krauss (Climate-Ocean RW071293.9
C Interaction, ed. Schlesinger, 1990). Note that KAPPA_B_SI(K) is the RW071293.10
C diffusivity at the TOP of box K. RW071293.11
C RW071293.12
KAPPA_B_SI(1)=KAPPA0_SI RW071293.13
DO K=2,KM RW071293.14
KAPPA_B_SI(K)= KAPPA0_SI + (ZDZ(K-1)*.01)*DKAPPA_DZ_SI RW071293.15
END DO RW071293.16
ORH1F305.56
IF (L_OVARYT) THEN ORH1F305.57
C OSETCON.180
C Set up scaled box thicknesses, etc. when using 'variable OSETCON.181
C timestep with depth' option OSETCON.182
C OSETCON.183
DO K=1,KM ORH6F404.26
RZ(K)=DZ(K)/RAT(K) ORH6F404.27
C2RZ(K)=2.0*RZ(K) ORH6F404.28
ENDDO ORH6F404.29
ORH6F404.30
RZZ(1)=0.5*RZ(1) ORH6F404.31
DO K=2,KM ORH6F404.32
RZZ(K)=0.5*(RZ(K-1)+RZ(K)) ORH6F404.33
ENDDO ORH6F404.34
ORH6F404.35
RZZ(KM+1)=0.5*RZ(KM) ORH6F404.36
RZZ2R(KMP1)=0.5/RZZ(KMP1) ORH6F404.37
DO K=1,KM ORH6F404.38
RZZ2R(K)=0.5/RZZ(K) ORH6F404.39
ENDDO ORH6F404.40
C OSETCON.197
ENDIF ORH1F305.58
ORH3F402.496
PHI_1=SWLDEG/RADIAN ORH3F402.497
PHIT_1=PHI_1-.5*DYT_1/RADIUS ORH3F402.498
ORH3F402.499
SUMDY=PHI_1 ORH3F402.500
IF (JST.EQ.1) THEN ORH3F402.501
PHI(J_1) = PHI_1 ORH3F402.503
PHIT(J_1) = PHIT_1 ORH3F402.504
ENDIF ORH3F402.505
*IF DEF,MPP ORH3F402.506
ORH3F402.507
IF (JFIN.EQ.JMT_GLOBAL) DYU(J_JMT)=DYT(J_JMT) ORH3F402.508
*ELSE ORH3F402.509
DYU(JMT)=DYT(JMT) OSETCON.202
*ENDIF ORH3F402.510
ORH3F402.511
DO J=J_1,J_JMT ORH6F404.41
IF(J+J_OFFSET.NE.JMT_GLOBAL) DYU(J)=.5*(DYT(J)+DYT(J+1)) ORH6F404.42
DYTR(J)=1./DYT(J) ORH6F404.43
DYT2R(J)=.5/DYT(J) ORH6F404.44
DYT4R(J)=.25/DYT(J) ORH6F404.45
DYUR(J)=1./DYU(J) ORH6F404.46
DYU2R(J)=.5/DYU(J) ORH6F404.47
DYU4R(J)=.25/DYU(J) ORH6F404.48
ENDDO ORH6F404.49
ORH3F402.514
! We have a full copy of DYT_GLOBAL, so we can set about ORH3F402.515
! calculating SUMDY and PHI. This is a completely ORH3F402.516
! un parallel calculation which HAS to be duplicated ORH3F402.517
! on all processes! Be careful when analysing the ORH3F402.518
! indexing of this loop.. remember the loop control ORH3F402.519
! is the global JMT value! ORH3F402.520
PHIT_GLOBAL(1) = PHIT_1 ORH3F402.521
PHI_GLOBAL(1) = PHI_1 ORH3F402.522
ORH3F402.523
DO J = 1, JMT_GLOBAL ORH3F402.524
ORH3F402.525
J_INDEX = J - J_OFFSET ORH3F402.526
ORH3F402.527
! Calculate the progressive global sum ORH3F402.530
IF(J.NE.JMT_GLOBAL) SUMDY = SUMDY + DYT_GLOBAL(J+1)/RADIUS ORH3F402.531
ORH6F404.50
! If this row refers to a row which this processor ORH3F402.535
! has responsibility for, then save the value of ORH3F402.536
! PHI and perform all the subsequent calculations ORH3F402.537
! dependent upon PHI ORH3F402.538
ORH3F402.539
IF(J.NE.JMT_GLOBAL) PHI_GLOBAL(J+1) = SUMDY ORH3F402.540
IF(J.NE.1) PHIT_GLOBAL(J)= ORH3F402.541
& .5*(PHI_GLOBAL(J-1)+PHI_GLOBAL(J)) ORH3F402.542
ORH3F402.543
IF (J.GE.JST-1.AND.J.LE.JFIN) THEN ORH3F402.544
! In this instance, the outer J loop works over ORH3F402.545
! the full global range, so when we store data ORH3F402.546
! we must index locally by subtracting J_OFFSET. ORH3F402.547
IF(J.NE.JMT_GLOBAL) PHI(J_INDEX+1) = SUMDY ORH3F402.548
IF(J.NE.1) PHIT(J_INDEX)=PHIT_GLOBAL(J) ORH3F402.549
ORH3F402.550
CST(J_INDEX)=COS(PHIT_GLOBAL(J)) ORH3F402.551
CS (J_INDEX)=COS(PHI_GLOBAL (J)) ORH3F402.552
SINE(J_INDEX)=SIN(PHI_GLOBAL(J)) ORH3F402.553
CSTR(J_INDEX)=1.0/CST(J_INDEX) ORH3F402.554
CSR(J_INDEX)=1.0/CS(J_INDEX) ORH3F402.555
TNG(J_INDEX)=SINE(J_INDEX)/CS(J_INDEX) ORH3F402.556
ENDIF ORH3F402.557
ENDDO ORH3F402.558
IF (L_OFILTER) THEN ORH0F404.42
! Only bother with CSR_JFU0 and CSTR_JFT0 for filtering ORH0F404.43
*IF DEF,MPP ORH3F402.559
! All processes need to know about CSR(JFU0) for filtering, ORH3F402.560
! so pass this from the appropriate process to everyone else. ORH3F402.561
IF (JFU0.GE.JST.AND.JFU0.LE.JFIN) THEN ORH3F403.189
CSR_JFU0 = CSR(JFU0-J_OFFSET) ORH3F403.190
ENDIF ORH3F403.191
PE_BCAST = J_PE_IND(JFU0) ORH3F403.192
CALL GC_RBCAST (1,1,PE_BCAST,nproc,info,CSR_JFU0) ORH3F403.193
ORH3F403.194
IF (JFT0.GE.JST.AND.JFT0.LE.JFIN) THEN ORH3F403.195
CSTR_JFT0 = CSTR(JFT0-J_OFFSET) ORH3F403.196
ENDIF ORH3F403.197
PE_BCAST = J_PE_IND(JFT0) ORH3F403.198
CALL GC_RBCAST (2,1,PE_BCAST,nproc,info,CSTR_JFT0) ORH3F403.199
*ELSE ORH3F402.575
CSR_JFU0 = CSR(JFU0) ORH3F402.576
CSTR_JFT0 = CSTR(JFT0) ORH3F402.577
*ENDIF ORH3F402.578
ENDIF ORH0F404.44
DXU(IMT)=DXT(IMT) OSETCON.221
IF (L_OCYCLIC) THEN ORH1F305.59
DXU(IMT)=.5*(DXT(2)+DXT(3)) ORH1F305.60
ENDIF ORH1F305.61
DO I=1,IMT ORH6F404.51
IF(I.NE.IMT) DXU(I)=.5*(DXT(I)+DXT(I+1)) OSETCON.226
DXTR(I)=1./DXT(I) OSETCON.227
DXT2R(I)=.5/DXT(I) OSETCON.228
DXT4R(I)=.25/DXT(I) OSETCON.229
DXUR(I)=1./DXU(I) OSETCON.230
DXU2R(I)=.5/DXU(I) OSETCON.231
DXU4R(I)=.25/DXU(I) OSETCON.232
ENDDO ORH6F404.52
ORH1F305.62
IF (L_OROTATE.OR.L_OCNASSM.OR.L_ICEFREEDR) THEN ODC1F405.384
ORH1F305.64
RLAMBDA(1)=WEDGEDEG/RADIAN ORH6F404.53
SUMDX=RLAMBDA(1) ORH6F404.54
DO I=2,IMT ORH6F404.55
SUMDX=SUMDX+DXT(I)/RADIUS ORH6F404.56
RLAMBDA(I)=SUMDX ORH6F404.57
ENDDO ORH6F404.58
ORH3F402.580
DO I=1,IMT ORH6F404.59
COSINE(I)=COS(RLAMBDA(I)) ORH6F404.60
ENDDO ORH6F404.61
IF ( ABS (PHI_POLE-90.0) .LT. TOL_POLE ) THEN ORH6F404.62
DO J=J_1,J_JMT ORH6F404.63
DO I=1,IMT ORH6F404.64
CORIOLIS(I,J)=2.0*OMEGA*SINE(J) ORH6F404.65
ENDDO ORH6F404.66
ENDDO ORH6F404.67
ELSE ORH6F404.68
ORH6F404.69
DO J=J_1,J_JMT ORH6F404.70
DO I=1,IMT ORH6F404.71
CORIOLIS(I,J)=2.0*OMEGA*(COS(PI*PHI_POLE/180.0)* ORH6F404.72
& COSINE(I)*CS(J)+SIN(PI*PHI_POLE/180.0)*SINE(J)) ORH6F404.73
ENDDO ORH6F404.74
ENDDO ORH6F404.75
ENDIF ! condition on PHI_POLE ORH6F404.76
ELSE ORL1F404.192
DO J=J_1,J_JMT ORL1F404.193
DO I=1,IMT ORL1F404.194
CORIOLIS(I,J)=2.0*OMEGA*SINE(J) ORL1F404.195
ENDDO ORL1F404.196
ENDDO ORL1F404.197
ENDIF ORH1F305.65
ORH1F305.66
! IMT_ROT is assigned here rather than in DERVSIZE ORH1F305.67
! because L_OROTATE cannot be assigned until the FLH ORH1F305.68
! has been read from the dump. ORH1F305.69
IF (L_OROTATE) THEN ORH1F305.70
IMT_ROT = IMT ORH1F305.71
ELSE ORH1F305.72
IMT_ROT = 1 ORH1F305.73
ENDIF ORH1F305.74
ORH1F305.75
IF (L_OFILTER) THEN ORH1F305.76
C--------------------------------------------------------------------- OSETCON.252
C COMPUTE SIN AND COS VALUES FOR VECTOR CORRECTION BEFORE FILTER OSETCON.253
C--------------------------------------------------------------------- OSETCON.254
C OSETCON.255
FX=1.0E-10 ORH6F404.77
FXA=DXT(1)/RADIUS ORH6F404.78
DO I=2,IMUM1 ORH6F404.79
FXB=FXA*FLOAT(I-2) ORH6F404.80
SPSIN(I)=SIN(FXB) ORH6F404.81
SPCOS(I)=COS(FXB) ORH6F404.82
IF(ABS(SPSIN(I)).LT.FX)SPSIN(I)=0.0 ORH6F404.83
IF(ABS(SPCOS(I)).LT.FX)SPCOS(I)=0.0 ORH6F404.84
ENDDO ORH6F404.85
SPSIN(1)=0.0 ORH6F404.86
SPCOS(1)=0.0 ORH6F404.87
SPSIN(IMU)=0.0 ORH6F404.88
SPCOS(IMU)=0.0 ORH6F404.89
ENDIF ORH1F305.77
C OSETCON.270
C---------------------------------------------------------- OSETCON.271
C-- SET UP POLYNOMIAL COEFICIENTS FOR THE EQUATION OF STATE OSETCON.272
C---------------------------------------------------------- OSETCON.273
C CALCULATE AVERAGE LATITUDE OSETCON.274
IF (.NOT.L_OROTATE) THEN ORH1F305.78
*IF DEF,MPP ORH3F402.582
! The processes with PHI(1) and PHI(JMT) must send them ORH6F404.90
! to all other processes. ORH3F402.584
IF (JST.EQ.1) THEN ORH3F403.200
PHI_1 = PHI(J_1) ORH3F403.201
ENDIF ORH3F403.202
PE_BCAST = J_PE_IND(1) ORH3F403.203
CALL GC_RBCAST (1,1,PE_BCAST,nproc,info,PHI_1) ORH3F403.204
ORH3F403.205
IF (JFIN.EQ.JMT_GLOBAL) THEN ORH3F403.206
PHI_JMT = PHI(J_JMT) ORH3F403.207
ENDIF ORH3F403.208
PE_BCAST = J_PE_IND(JMT_GLOBAL) ORH3F403.209
CALL GC_RBCAST (1,1,PE_BCAST,nproc,info,PHI_JMT) ORH3F403.210
ORH3F403.211
ORH3F403.212
*ELSE ORH3F402.598
PHI_1 = PHI(1) ORH6F404.91
PHI_JMT = PHI(JMT) ORH6F404.92
*ENDIF ORH3F402.601
ORH3F402.602
FIA = PHI_1*RADIAN ORH6F404.93
FIB = PHI_JMT*RADIAN ORH6F404.94
FI1=MIN(FIA,FIB) ORH6F404.95
FI2=MAX(FIA,FIB) ORH6F404.96
ORH1F305.79
ELSE ORH1F305.80
ORH1F305.81
FI1=90.0 ORH6F404.97
FI2=-90.0 ORH6F404.98
DO J=J_1,J_JMT ORH6F404.99
DO I=1,IMT ORH6F404.100
FI=ASIN(COS(PI*PHI_POLE/180.0)*COSINE(I)*CS(J) ORH6F404.101
& +SIN(PI*PHI_POLE/180.0)*SINE(J)) ORH6F404.102
FI=FI*RADIAN ORH6F404.103
FI1=MIN(FI1,FI) ORH6F404.104
FI2=MAX(FI2,FI) ORH6F404.105
ENDDO ORH6F404.106
ENDDO ORH6F404.107
*IF DEF,MPP ORH0F405.29
! Ensure global values of FI1 and FI2 are used. ORH0F405.30
CALL GC_RMAX (1,O_NPROC,INFO,FI1) ORH0F405.31
CALL GC_RMAX (1,O_NPROC,INFO,FI2) ORH0F405.32
*ENDIF ORH0F405.33
OSETCON.294
ENDIF ORH1F305.82
ORH1F305.83
FIMIN=MIN(ABS(FI1),ABS(FI2)) OSETCON.295
FIMAX=MAX(ABS(FI1),ABS(FI2)) OSETCON.296
OSETCON.297
IF (FI1.LT.0.0.AND.FI2.GT.0.0 OSETCON.298
& .OR.FI1.GT.0.0.AND.FI2.LT.0.0) FIMIN=0.0 OSETCON.299
OSETCON.300
FIAVE=0.5*(FIMIN+FIMAX) OSETCON.301
OSETCON.302
CALL DENSCOEF( @DYALLOC.4213
*CALL ARGSIZE SF011193.47
* ZDZZ,FIAVE) ! ################################# @DYALLOC.4214
OSETCON.304
CALL STINIT (KM,ICODE,CMESSAGE) @DYALLOC.4215
OSETCON.306
IF (L_OPRINT) THEN ORH2F401.4
C--------------------------------------------------------------------- OSETCON.307
C PRINT GRID GEOMETRY ARRAYS OSETCON.308
C--------------------------------------------------------------------- OSETCON.309
C OSETCON.310
WRITE(6,9701) ORH4F404.29
9701 FORMAT(50H0 GRID BOX THICKNESS 'DZ' ) ORH4F404.30
WRITE(6,970) DZ ORH4F404.31
WRITE(6,9702) ORH4F404.32
9702 FORMAT(50H0 GRID POINT SEPARATION 'DZZ' ) ORH4F404.33
WRITE(6,970) DZZ ORH4F404.34
WRITE(6,9703) ORH4F404.35
9703 FORMAT(50H0 DEPTH OF BOX BOTTOM 'ZDZ' ) ORH4F404.36
WRITE(6,970) ZDZ ORH4F404.37
WRITE(6,9704) ORH4F404.38
9704 FORMAT(50H0 DEPTH OF GRID POINT 'ZDZZ' ) ORH4F404.39
WRITE(6,970) ZDZZ ORH4F404.40
WRITE(6,9705) ORH4F404.41
9705 FORMAT(50H0 LATITUDE OF T,S POINTS (RADIANS) 'PHIT' ) ORH4F404.42
WRITE(6,970) PHIT ORH4F404.43
WRITE(6,9706) ORH4F404.44
9706 FORMAT(50H0 LATITUDE OF U,V POINTS (RADIANS) 'PHI' ) ORH4F404.45
WRITE(6,970) PHI ORH4F404.46
WRITE(6,9707) ORH4F404.47
9707 FORMAT(50H0 COSINE OF T,S LATITUDE 'CST' ) ORH4F404.48
WRITE(6,970) CST ORH4F404.49
WRITE(6,9708) ORH4F404.50
9708 FORMAT(50H0 COSINE OF U,V LATITUDE 'CS' ) ORH4F404.51
WRITE(6,970) CS ORH4F404.52
WRITE(6,9709) ORH4F404.53
9709 FORMAT(50H0 SINE OF U,V LATITUDE 'SINE' ) ORH4F404.54
WRITE(6,970) SINE ORH4F404.55
970 FORMAT(1X,10E13.5) ORH4F404.56
ENDIF ORH2F401.33
C OSETCON.339
C--------------------------------------------------------------------- OSETCON.340
C SET MAXIMUM LEVEL INDICATORS FOR TOPOGRAPHY OSETCON.341
C--------------------------------------------------------------------- OSETCON.342
DO J = 1,JMT_GLOBAL ORH3F402.606
DO I = 1, IMT ORH3F402.607
FKMQ_GLOBAL(I,J)=0 ORH3F402.608
IF (.NOT.L_ONOCLIN) THEN ORH3F402.609
FKMZ_GLOBAL(I,J)=0 ORH3F402.610
ENDIF ORH3F402.611
ENDDO ORH3F402.612
ENDDO ORH3F402.613
C OSETCON.343
DO J=J_1,J_JMT ORH6F404.108
DO I=1,IMT ORH6F404.109
FKMQ(I,J)=0 ORH6F404.110
IF ((.NOT.L_ONOCLIN).AND.(.NOT.L_OFREESFC)) THEN ORH6F404.111
FKMZ(I,J)=0 ORH6F404.112
ENDIF ORH6F404.113
ENDDO ORH6F404.114
ENDDO ORH6F404.115
C OSETCON.351
C 1ST, NUMBER OF VERTICAL LEVELS FOR T POINTS OSETCON.352
IF (L_OCYCLIC) THEN ORH1F305.87
C SET CYCLIC BOUNDARY CONDITIONS OSETCON.354
DO J = 1, JMT_GLOBAL ORH6F404.116
FKMP_GLOBAL( 1,J)=FKMP_GLOBAL(IMTM1,J) ORH6F404.117
FKMP_GLOBAL(IMT,J)=FKMP_GLOBAL( 2,J) ORH6F404.118
ENDDO ORH6F404.119
ORH6F402.38
ENDIF ORH1F305.88
ORH6F404.120
! Assign local values of FKMP ORH6F402.39
DO J = J_1, J_JMT ORH6F402.40
DO I = 1, IMT ORH6F402.41
FKMP(I,J) = FKMP_GLOBAL(I,J+J_OFFSET) ORH6F402.42
ENDDO ORH6F402.43
ENDDO ORH6F402.44
C OSETCON.361
*IF DEF,MPP ORH3F402.615
CALL SWAPBOUNDS(FKMP,IMT,JMT,O_EW_HALO,O_NS_HALO,1) ORH3F402.616
*ENDIF ORH3F402.617
ORH6F404.121
! Set up logical land sea mask for STASH. ORH2F405.7
DO J = 1, JMT ORH2F405.8
DO I = 1, ICOL_CYC ORH2F405.9
L_STASH_LAND(I,J)=.FALSE. ORH2F405.10
IF (FKMP(I,J).EQ.0.0) L_STASH_LAND(I,J) = .TRUE. ORH2F405.11
ENDDO ORH2F405.12
ENDDO ORH2F405.13
C 2ND, COMPUTE NUMBER OF VERTICAL LEVELS AT EACH U,V POINT OSETCON.362
DO J=1,JMTM1_GLOBAL ORH3F402.618
DO I=1,IMTM1 ORH3F402.619
FKMQ_GLOBAL(I,J)=MIN(FKMP_GLOBAL(I,J), ORH3F402.620
& FKMP_GLOBAL(I+1,J),FKMP_GLOBAL(I,J+1), ORH3F402.621
& FKMP_GLOBAL(I+1,J+1)) ORH3F402.622
ENDDO ORH3F402.623
ENDDO ORH3F402.624
C OSETCON.363
IF (L_OCYCLIC) THEN ORH1F305.90
C OSETCON.369
C SET CYCLIC CONDITIONS OSETCON.370
DO J=1,JMT_GLOBAL ORH6F404.122
FKMQ_GLOBAL(IMT,J)=FKMQ_GLOBAL(2,J) ORH6F404.123
ENDDO ORH6F404.124
ENDIF ORH6F404.125
ORH6F404.126
! Assign local values of FKMQ ORH6F404.127
DO J = J_1, J_JMT ORH6F404.128
DO I = 1, IMT ORH6F404.129
FKMQ(I,J) = FKMQ_GLOBAL(I,J+J_OFFSET) ORH6F404.130
ENDDO ORH6F404.131
ENDDO ORH3F402.628
ORH6F404.132
*IF DEF,MPP ORH3F402.630
CALL SWAPBOUNDS(FKMQ,IMT,JMT,O_EW_HALO,O_NS_HALO,1) ORH3F402.631
*ENDIF ORH3F402.632
ORH6F404.133
IF ((.NOT.L_ONOCLIN).AND.(.NOT.L_OFREESFC)) THEN ORL1F404.248
C 3RD, COMPUTE AN ARRAY TO INDICATE "INTERIOR" GRID BOXES OSETCON.378
DO J=2,JMTM1_GLOBAL ORH6F404.134
DO I=2,IMU ORH6F404.135
FKMZ_GLOBAL(I,J)=MIN(FKMQ_GLOBAL(I-1,J-1), ORH6F404.136
& FKMQ_GLOBAL(I,J-1), ORH3F402.636
& FKMQ_GLOBAL(I-1,J),FKMQ_GLOBAL(I,J)) ORH3F402.637
ENDDO ORH6F404.137
ENDDO ORH3F402.638
ORH1F305.93
IF (L_OCYCLIC) THEN ORH6F404.138
C OSETCON.386
C SET CYCLIC CONDITIONS OSETCON.387
DO J= 1,JMT_GLOBAL ORH6F404.139
FKMZ_GLOBAL(1,J)=FKMZ_GLOBAL(IMTM1,J) ORH6F404.140
ENDDO ORH6F404.141
ENDIF ORH6F404.142
ORH6F404.143
DO J=J_1,J_JMT ORH6F404.144
DO I=1,IMU ORH6F404.145
FKMZ(I,J)=FKMZ_GLOBAL(I,J+J_OFFSET) ORH6F404.146
ENDDO ORH6F404.147
ENDDO ORH6F404.148
ORH6F404.149
*IF DEF,MPP ORH3F402.645
CALL SWAPBOUNDS(FKMZ,IMT,JMT,O_EW_HALO,O_NS_HALO,1) ORH6F404.150
*ENDIF ORH3F402.647
ORH1F305.96
C OSETCON.394
C--------------------------------------------------------------------- OSETCON.395
C COMPUTE START & END INDICES FOR STREAM FUNCTION CALCULATIONS OSETCON.396
C--------------------------------------------------------------------- OSETCON.397
C OSETCON.398
LSEGP=LSEG+1 ORH6F404.151
DO J=J_3,JSCAN ORH6F404.152
ORH3F402.649
ORH3F402.650
L=1 ORH6F404.153
DO I=2,IMUM1 ORH6F404.154
IF(FKMZ(I-1,J).EQ.0. .AND. FKMZ(I,J).NE.0.) ISZ(J,L)=I ORH6F404.155
IF(I.EQ.2 .AND. FKMZ(IMT,J).NE.0.) ISZ(J,L)=2 ORH6F404.156
IF(FKMZ(I,J).NE.0. .AND. FKMZ(I+1,J).EQ.0.) IEZ(J,L)=I ORH6F404.157
IF(I.EQ.IMUM1 .AND. FKMZ(I+1,J).NE.0.) IEZ(J,L)=I ORH6F404.158
IF(FKMZ(I,J).NE.0. .AND. FKMZ(I+1,J).EQ.0.) L=L+1 ORH6F404.159
IF(L.GT.LSEGP) THEN ORH6F404.160
WRITE(6,*) "SET_CONSTANTS_OCEAN : strmfn index calc" ORH6F404.161
WRITE(6,*) "L =",L," is greater than LSEGP = ",LSEGP ORH6F404.162
ICODE = 102 ORH6F404.163
CMESSAGE = "OSETCON: Error in streamfunction indices" ORH6F404.164
GOTO 9999 ORH6F404.165
ENDIF ORH6F404.166
ENDDO ! Over I ORH6F404.167
ENDDO ! Over J ORH6F404.168
ENDIF !(.NOT.L_ONOCLIN).AND.(.NOT.L_OFREESFC) ORL1F404.249
ORL1F404.250
IF ((.NOT.L_ONOCLIN).AND.(L_OFREESFC)) THEN ORL1F404.251
ORL1F404.252
C----------------------------------------------------------------------- ORL1F404.253
C CALCULATE DO LOOP INDICES FOR ETA AND EXTERNAL MODE. ORL1F404.254
C----------------------------------------------------------------------- ORL1F404.255
C ORL1F404.256
ORL1F404.257
DO J=J_2,J_JMTM1 ORL1F404.258
ORL1F404.259
L=0 ORL1F404.260
IF ( FKMP(1,J).GT.0 .AND. FKMP(2,J).GT.0 ) THEN ORL1F404.261
L=L+1 ORL1F404.262
ISE(J,L)=2 ORL1F404.263
ENDIF ORL1F404.264
ORL1F404.265
DO I=2,IMTM1 ORL1F404.266
ORL1F404.267
IF ( FKMP(I-1,J).EQ.0 .AND. FKMP(I,J).GT.0 ) THEN ORL1F404.268
L=L+1 ORL1F404.269
ISE(J,L)=I ORL1F404.270
ENDIF ORL1F404.271
IF ( FKMP(I,J).GT.0 .AND. FKMP(I+1,J).EQ.0 ) IEE(J,L)=I ORL1F404.272
ORL1F404.273
ENDDO ! OVER I ORL1F404.274
ORL1F404.275
IF ( FKMP(IMTM1,J).GT.0 .AND. FKMP(IMT,J).GT.0 ) IEE(J,L)=IMTM1 ORL1F404.276
LSE(J)=L ORL1F404.277
ORL1F404.278
ENDDO ! OVER J ORL1F404.279
C ORL1F404.280
DO J=J_2,J_JMTM1 ORL1F404.281
ORL1F404.282
L=0 ORL1F404.283
IF ( FKMQ(1,J).GT.0 .AND. FKMQ(2,J).GT.0 ) THEN ORL1F404.284
L=L+1 ORL1F404.285
ISU(J,L)=2 ORL1F404.286
ENDIF ORL1F404.287
ORL1F404.288
DO I=2,IMUM1 ORL1F404.289
ORL1F404.290
IF ( FKMQ(I-1,J).EQ.0 .AND. FKMQ(I,J).GT.0 ) THEN ORL1F404.291
L=L+1 ORL1F404.292
ISU(J,L)=I ORL1F404.293
ENDIF ORL1F404.294
IF ( FKMQ(I,J).GT.0 .AND. FKMQ(I+1,J).EQ.0 ) IEU(J,L)=I ORL1F404.295
ORL1F404.296
ENDDO ! OVER I ORL1F404.297
ORL1F404.298
IF ( FKMQ(IMUM1,J).GT.0 .AND. FKMQ(IMU,J).GT.0 ) IEU(J,L)=IMUM1 ORL1F404.299
LSU(J)=L ORL1F404.300
ENDDO ! OVER J ORL1F404.301
ORL1F404.302
C ORL1F404.303
C----------------------------------------------------------------------- ORL1F404.304
C CALCULATE MASK FIELD AT ETA POINTS. ORL1F404.305
C----------------------------------------------------------------------- ORL1F404.306
C ORL1F404.307
DO J=J_1,J_JMT ORL1F404.308
DO I=1,IMT ORL1F404.309
ORL1F404.310
IF ( FKMP(I,J).GT.0 ) THEN ORL1F404.311
EM(I,J)=1. ORL1F404.312
ELSE ORL1F404.313
EM(I,J)=0. ORL1F404.314
ENDIF ORL1F404.315
ORL1F404.316
ENDDO ! OVER I ORL1F404.317
ENDDO ! OVER J ORL1F404.318
ORL1F404.319
ENDIF ! (.NOT.L_ONOCLIN).AND.(L_OFREESFC) ORL1F404.320
ORH1F305.98
IF (L_OFILTER) THEN ORH1F305.99
C OSETCON.412
C--------------------------------------------------------------------- OSETCON.413
C INITILISE SWITCH FOR CALCULATION OF FILTERING COEFFICIENTS @DYALLOC.4216
C--------------------------------------------------------------------- @DYALLOC.4217
C @DYALLOC.4218
INITDN=.FALSE. ORH6F404.174
C @DYALLOC.4220
C--------------------------------------------------------------------- @DYALLOC.4221
C FIND AND PRINT START & END INDICES FOR FILTERING OSETCON.414
C--------------------------------------------------------------------- OSETCON.415
C OSETCON.416
IF (L_OPRINT) WRITE(6,833) ORH6F404.175
IF (LSEGF.GT.11) WRITE(6,834) ORH6F404.176
IF (L_OPRINT) WRITE(6,835) ORH6F404.177
CALL FINDEX( ORH6F404.178
*CALL ARGOCPAR @DYALLOC.4223
*CALL ARGOINDX ORH7F402.303
& FKMP_GLOBAL,NJTBFT,KM,JFT1,JFT2,IMT,ISTF,IETF) ORH8F402.62
ORH6F404.179
IF (L_OPRINT) WRITE(6,836) ORH6F404.180
CALL FINDEX( ORH6F404.181
*CALL ARGOCPAR @DYALLOC.4226
*CALL ARGOINDX ORH7F402.304
& FKMQ_GLOBAL,NJTBFU,KM,JFU1,JFU2,IMU,ISUF,IEUF) ORH8F402.63
ORH6F404.182
IF ((.NOT.L_ONOCLIN).AND.(.NOT.L_OFREESFC)) THEN ORH6F404.183
IF (L_OPRINT) WRITE(6,837) ORH6F404.184
CALL FINDEX( ORH6F404.185
*CALL ARGOCPAR @DYALLOC.4229
*CALL ARGOINDX ORH7F402.305
& FKMZ_GLOBAL,NJTBFU, 1,JFU1,JFU2,IMT,ISZF,IEZF) ORH6F404.186
ORH8F402.65
ENDIF ! L_ONOCLIN and L_OFREESFC = false ORH6F404.187
ORH1F305.102
*IF DEF,MPP,AND,DEF,T3E ORH1F405.77
! Call routine to calculate certain values needed when ORH1F405.78
! we distribute filtering over the whole range of pes. ORH1F405.79
! This can only currently be done using shmem calls. ORH1F405.80
CALL DECOMP_FILTR( ORH1F405.81
*CALL ARGSIZE ORH1F405.82
*CALL ARGOCALL ORH1F405.83
& L_OSYMM,L_OFREESFC) ORH1F405.84
*ELSE ORH1F405.85
MAX_ROW_INDEX = JMTM1 ORH1F405.86
*ENDIF ORH1F405.87
ORH1F405.88
833 FORMAT (1H1,'START AND END INDICES FOR FOURIER FILTERING:'/) OSETCON.429
834 FORMAT (1X,'ONLY 11 SETS OF INDICES FIT ACCROSS THE PAGE.', OSETCON.430
* ' OTHERS WILL NOT BE PRINTED.'/) OSETCON.431
835 FORMAT (///1X,'FILTERING INDICES FOR T,S:') OSETCON.432
836 FORMAT (///1X,'FILTERING INDICES FOR U,V:') OSETCON.433
837 FORMAT (///1X,'FILTERING INDICES FOR STREAM FUNCTION:') OSETCON.436
ORH1F305.103
ENDIF ! L_OFILTER = true ORH1F305.104
C OSETCON.438
C--------------------------------------------------------------------- OSETCON.439
C COMPUTE FIELD OF RECIPROCAL DEPTH OSETCON.440
C--------------------------------------------------------------------- OSETCON.441
C OSETCON.442
DO J=J_1,J_JMT ORH6F404.188
DO I=1,IMT ORH6F404.189
HR(I,J)=0.0 ORH6F404.190
IF(FKMQ(I,J).NE.0) HR(I,J)=1./ZDZ(INT(FKMQ(I,J))) ORH6F404.191
ENDDO ORH6F404.192
ENDDO ORH6F404.193
ORH6F404.194
IF (L_OSYMM) THEN ORH1F305.105
C OSETCON.449
C SET SYMMETRY CONDITIONS OSETCON.450
C OSETCON.451
*IF DEF,MPP ORH3F402.652
ORH3F402.653
IF (J_PE_IND(JMT_GLOBAL).NE.J_PE_IND(JMT_GLOBAL-2)) THEN ORH6F404.195
ORH3F402.655
! ROW JMT_GLOBAL -2 must be sent to row JMT_GLOBAL. ORH6F404.196
IF (JST.GE.JMT_GLOBAL-2.AND.JFIN.LE.JMT_GLOBAL-2) THEN ORH6F404.197
DO I = 1, IMT ORH6F404.198
HR_TMP(I) = HR(I,J_JMTM2) ORH6F404.199
ENDDO ORH6F404.200
ORH3F402.661
! Information is to be received by the PE handling ORH6F404.201
! the final row. ORH6F404.202
PE_RECV = J_PE_IND(JMT_GLOBAL) ORH6F404.203
CALL GC_RSEND(2001,IMT,PE_RECV,INFO,HR_TMP,HR_TMP) ORH6F404.204
ENDIF ORH6F404.205
ENDIF ORH3F402.666
ORH3F402.667
CALL GC_GSYNC(O_NPROC,INFO) ORH6F404.206
ORH6F404.207
IF (J_PE_IND(JMT_GLOBAL).NE.J_PE_IND(JMT_GLOBAL-2)) THEN ORH6F404.208
IF (JFIN.EQ.JMT_GLOBAL) THEN ORH6F404.209
PE_SEND = J_PE_IND(JMT_GLOBAL-2) ORH6F404.210
CALL GC_RRECV(2001,IMT,PE_SEND,INFO,HR_TMP,HR_TMP) ORH6F404.211
ENDIF ORH6F404.212
ENDIF ORH6F404.213
ORH6F404.214
CALL GC_GSYNC(O_NPROC,INFO) ORH6F404.215
ORH6F404.216
IF (J_PE_IND(JMT_GLOBAL).NE.J_PE_IND(JMT_GLOBAL-2)) THEN ORH6F404.217
IF (JFIN.EQ.JMT_GLOBAL) THEN ORH6F404.218
DO I = 1, IMT ORH6F404.219
HR(I,J_JMT) = HR_TMP(I) ORH6F404.220
ENDDO ORH6F404.221
ENDIF ORH6F404.222
ELSE ORH6F404.223
IF (O_MYPE.EQ.O_NPROC-1) THEN ORH6F404.224
DO I = 1, IMT ORH6F404.225
HR(I,J_JMT) = HR(I,J_JMTM2) ORH6F404.226
ENDDO ORH6F404.227
ENDIF ORH6F404.228
ENDIF ORH6F404.229
ORH6F404.230
*ELSE ORH3F402.680
DO I=1,IMT ORH6F404.231
HR(I,JMT)=HR(I,JMTM2) ORH6F404.232
ENDDO ORH6F404.233
*ENDIF ORH3F402.681
ENDIF ORH1F305.106
C OSETCON.456
C--------------------------------------------------------------------- OSETCON.457
C COMPUTE THE SURFACE AREA AND VOLUME OF THE OCEAN OSETCON.458
C--------------------------------------------------------------------- OSETCON.459
C OSETCON.460
AREA=0.0 OSETCON.461
VOLUME=0.0 OSETCON.462
*IF DEF,MPP ORH3F402.682
! Now compile a full global copy of CST ORH3F402.683
! Note: replace this with GATHER_FIELD ORH3F402.684
CALL O_SMARTPASS(1,1,CST(J_1),CST_GLOBAL ORH3F402.685
& ,JFIN-JST+1,JMT_GLOBAL,JST,2) ORH3F402.686
*ELSE ORH3F402.687
! Set up CST_GLOBAL for non mpp code. ORH3F402.688
DO J = J_1, J_JMT ORH3F402.689
CST_GLOBAL(J)=CST(J) ORH3F402.690
ENDDO ORH3F402.691
*ENDIF ORH3F402.692
! The calculation of AREA and VOLUME use global values ORH3F402.693
! for bit reproducibilty ORH3F402.694
DO J=2,JMTM1_GLOBAL ORH3F402.695
DO I=2,IMTM1 ORH3F402.696
IF (FKMP_GLOBAL(I,J).GT.0) THEN ORH3F402.697
AREA=AREA+CST_GLOBAL(J)*DXT(I)*DYT_GLOBAL(J) ORH3F402.698
VOLUME=VOLUME+CST_GLOBAL(J)*DXT(I)*DYT_GLOBAL(J)* ORH3F402.699
& ZDZ(INT(FKMP_GLOBAL(I,J))) ORH3F402.700
ENDIF ORH3F402.701
ENDDO ORH3F402.702
ENDDO ORH3F402.703
*IF DEF,MPP ORH3F402.704
ORH3F402.705
WRITE (6,*) "AREA FOR PE",O_MYPE,AREA ORH3F402.706
WRITE (6,*) "VOLUME FOR PE",O_MYPE,VOLUME ORH3F402.707
ORH3F402.708
*ENDIF ORH3F402.709
IF (L_SEAICE) THEN ORH1F305.107
C OSETCON.471
C______________________________________________________________________ OSETCON.472
C Set arrays for EDDYDIFF and AMX OSETCON.473
C______________________________________________________________________ OSETCON.474
C OSETCON.475
DO J=J_1,J_JMT ORH6F404.234
IF (PHIT(J).LT.0.0) THEN ORH6F404.235
AMX(J)=AMXSOUTH ORH6F404.236
EDDYDIFF(J)=EDDYDIFFS ORH6F404.237
ELSE ORH6F404.238
AMX(J)=AMXNORTH ORH6F404.239
EDDYDIFF(J)=EDDYDIFFN ORH6F404.240
ENDIF ORH6F404.241
END DO ORH6F404.242
ENDIF ORH1F305.108
C OSETCON.486
IF (L_OPRINT) THEN ORH2F401.38
C--------------------------------------------------------------------- OSETCON.487
C PRINT TOPOGRAPHY MAP OSETCON.488
C (..NOTE.. THE NUMBER OF LEVELS ARE PRINTED IN HEX; OSETCON.489
C A DOT SUPERIMPOSED ===> ADD AN ADDITIONAL 16) OSETCON.490
C--------------------------------------------------------------------- OSETCON.491
C OSETCON.492
WRITE(6,950) ORH6F404.243
950 FORMAT(50H1 NUMBER OF LEVELS AT T,S POINTS AND U,V POINTS ) ORH6F404.244
DO IBK=1,IMT,65 ORH6F404.245
WRITE(6,960) ORH6F404.246
960 FORMAT(/) ORH6F404.247
ISP=IBK ORH6F404.248
IEPT=IBK+64 ORH6F404.249
IEPU=IBK+64 ORH6F404.250
IF(IEPT.GT.IMT) IEPT=IMT ORH6F404.251
IF(IEPU.GT.IMU) IEPU=IMU ORH6F404.252
DO JREV=J_1,J_JMT ORH6F404.253
J=J_JMT-JREV+1 ORH6F404.254
IF(J+J_OFFSET.NE.JMT_GLOBAL) THEN ORH6F404.255
DO I=1,IMT ORH6F404.256
KPR(I)=FKMQ(I,J) ORH6F404.257
ENDDO ORH6F404.258
WRITE(6,972) (KPR(I),I=ISP,IEPU) ORH6F404.259
972 FORMAT(2X,65(1X,Z1)) ORH6F404.260
ORH6F404.261
DO I=1,IMT ORH6F404.262
ABT(I)=BLK ORH6F404.263
ENDDO ORH6F404.264
DO I=ISP,IEPU ORH6F404.265
IF(KPR(I).GT.15)ABT(I)=DOT ORH6F404.266
ENDDO ORH6F404.267
WRITE(6,971) (ABT(I),I=ISP,IEPU) ORH6F404.268
971 FORMAT(2H+ ,65(1X,A1)) ORH6F404.269
ENDIF ORH6F404.270
DO I=1,IMT ORH6F404.271
KPR(I)=FKMP(I,J) ORH6F404.272
ENDDO ORH6F404.273
WRITE(6,982) (KPR(I),I=ISP,IEPT) ORH6F404.274
982 FORMAT(1X,65(1X,Z1)) ORH6F404.275
DO I=1,IMT ORH6F404.276
ABT(I)=BLK ORH6F404.277
ENDDO ORH6F404.278
DO I=ISP,IEPT ORH6F404.279
IF(KPR(I).GT.15)ABT(I)=DOT ORH6F404.280
ENDDO ORH6F404.281
WRITE(6,981) (ABT(I),I=ISP,IEPT) ORH6F404.282
981 FORMAT(1H+,65(1X,A1)) ORH6F404.283
ENDDO ! Over JREV ORH6F404.284
ENDDO ! Over IBK ORH6F404.285
C OSETCON.534
C--------------------------------------------------------------------- OSETCON.535
C PRINT AREA AND VOLUME OF THE OCEAN, AS WELL AS START & END OSETCON.536
C INDICES FOR THE STREAM FUNCTION CALCULATION OSETCON.537
C--------------------------------------------------------------------- OSETCON.538
C OSETCON.539
WRITE(6,940) AREA,VOLUME ORH6F404.286
940 FORMAT(//,15H SURFACE AREA =,1PE13.6,5X,9H VOLUME =,1PE13.6) ORH6F404.287
ORH1F305.109
IF ((.NOT.L_ONOCLIN).AND.(.NOT.L_OFREESFC)) THEN ORH6F404.288
ORH1F305.111
WRITE(6,9502) ORH6F404.289
9502 FORMAT(43H1 START AND END INDICES FOR STREAM FUNCTION) ORH6F404.290
DO JREV=J_1,J_JMT ORH6F404.291
J=J_JMT-JREV+1 ORH6F404.292
WRITE(6,930) J,(ISZ(J,L),IEZ(J,L),L=1,LSEG) ORH6F404.293
930 FORMAT(' J=',I3,5X,5(2I5,10X)) ORH6F404.294
ENDDO ORH6F404.295
ENDIF ORH6F404.296
ENDIF ORH2F401.39
ORH1F305.113
IF (L_OSOLAR) THEN ORH1F305.114
CL Calculates the solar penetration for a water type OSETCON.552
OSETCON.553
CALL SOLSET (SOL_PEN, RSOL, ETA1_SI, ETA2_SI, KFIX, ORH6F404.297
+ KM, OSETCON.555
+ DZ, ZDZ OSETCON.556
+ ) OSETCON.557
ORH1F305.116
IF (L_OMIXLAY) THEN ORH1F305.119
C OSETCON.560
C Set constants for mixed layer code OSETCON.561
ORH1F305.120
IF (L_OVARYT) THEN ORH1F305.121
CALL MIXSET (DELPSF, DELPSL, DECAY, ORH6F404.298
+ GRAV_SI, DZ, ZDZ, ZDZZ, OSETCON.564
+ RZ, ORH1F305.122
+ KM, OSETCON.573
+ KFIX, RSOL, ETA1_SI, ETA2_SI, DELTA_SI OSETCON.574
+ ) OSETCON.575
ORH1F305.123
ELSE ORH1F305.124
ORH1F305.125
CALL MIXSET (DELPSF, DELPSL, DECAY, ORH6F404.299
+ GRAV_SI, DZ, ZDZ, ZDZZ, ORH1F305.127
+ DZ, ORH1F305.128
+ KM, ORH1F305.129
+ KFIX, RSOL, ETA1_SI, ETA2_SI, DELTA_SI ORH1F305.130
+ ) ORH1F305.131
ENDIF ORH1F305.132
ENDIF ! L_OMIXLAY = true ORH1F305.134
ENDIF ! L_OSOLAR = true OJP0F404.621
ORH1F305.136
IF (L_OISOPYC) THEN ORH1F305.137
C OSETCON.578
C Set along-isopycnal diffusivity as a function of depth. AHI is OSETCON.579
C AI in eqn. (1.4). Note AHI in cm2/s, hence conversion factors. OSETCON.580
C OSETCON.581
DO k=1,KM ORH6F404.300
AHI(k) = AHI2_SI*1.E4 + (AHI1_SI-AHI2_SI)*1.E4* ORH6F404.301
* EXP(-ZDZZ(k)/(AHI3_SI*1.E2)) OSETCON.584
ENDDO ORH6F404.302
ENDIF ! L_OISOPYC = true ORH6F404.303
ORH1F305.138
IF (L_OISOTAPER) THEN OLA0F401.49
C The following are required when L_OISOTAPER = true OLA0F401.50
dslope=0.001 ! Values required for tapering of isopycnals ORH6F404.304
slopec=0.004 ! ORH6F404.305
ENDIF OLA0F401.53
ORH6F404.306
IF (L_OISOPYCGM.OR.L_OISOGM) THEN OOM1F405.72
IF (L_OVISBECK) THEN ORH6F404.308
C Hard wire level number to depth average Richardson number over for OLA2F403.42
C Visbeck scheme. OLA2F403.43
kri(1)=7 ORH6F404.309
IF (L_OVISHADCM4) THEN OOM1F405.73
kri(2)=13 OOM1F405.74
ELSE OOM1F405.75
kri(2)=15 OOM1F405.76
ENDIF OOM1F405.77
ELSE ORH6F404.311
c Calculate value for thickness diffusion used in GM90 scheme OLA0F401.55
do k=1,km ORH6F404.312
ATHKDF(k) = ATHKDF2_SI*1.E4 + (ATHKDF1_SI-ATHKDF2_SI)* ORH6F404.313
* 1.E4*EXP(-ZDZZ(k)/(ATHKDF3_SI*1.E2)) OLA0F401.58
enddo ORH6F404.314
write(6,*) 'ATHKDF ',athkdf ORH6F404.315
write(6,*) 'AHI ',ahi ORH6F404.316
ENDIF ORH6F404.317
ENDIF OLA0F401.62
IF (L_OFULARGE) THEN OOM1F405.427
C OOM1F405.428
C CALCULATE LEVEL WITHIN WHICH MAX_LARGE_DEPTH IS CONTAINED OOM1F405.429
DO K=1,KM OOM1F405.430
IF (ZDZ(K).LT.MAX_LARGE_DEPTH*100.) MAX_LARGE_LEVELS=K+1 OOM1F405.431
ENDDO OOM1F405.432
C OOM1F405.433
C HARD WIRE NO OF LEVELS IN EACH LAYER CONSIDERED IN OOM1F405.434
C CALCULATING MLD OOM1F405.435
NO_LAYERS_IN_LEV=5 OOM1F405.436
ENDIF OOM1F405.437
ORH1F305.140
IF (L_OHMEAD) THEN ORH1F305.141
C @DYALLOC.4231
C====================================================================== @DYALLOC.4232
C READ BASIN INDICES @DYALLOC.4233
C====================================================================== @DYALLOC.4234
C @DYALLOC.4235
@DYALLOC.4242
! In MPP mode, all pes do a complete read of the basin ORH6F404.318
! indices file and discard the information they do not ORH6F404.319
! require. I/O being what it is, this is probably not ORH6F404.320
! as efficient as reading all data to one PE and distributing ORH6F404.321
! but it's a small overhead since this routine is only ORH6F404.322
! called once. ORH6F404.323
CALL GET_FILE(58,FILENAME,80,ICODE) ORH6F404.324
OPEN(58,FILE=FILENAME,STATUS='OLD',IOSTAT=OPEN_STATUS) ORH6F404.325
IF (OPEN_STATUS.NE.0) THEN ORH6F404.326
WRITE(6,*)'error opening basin indices file ',FILENAME ORH6F404.327
ICODE=OPEN_STATUS ORH6F404.328
CMESSAGE=' OSETCON: ERROR OPENING BASIN INDICES FILE' ORH6F404.329
RETURN ORH6F404.330
ENDIF ORH6F404.331
ORH6F404.332
DO J=1,3 ORH6F404.333
READ(58,4360) ! skip three records ORH6F404.334
ENDDO ORH6F404.335
4360 FORMAT(A80) ORH6F404.336
DO J=JMT_GLOBAL,1,-1 ORH6F404.337
IF (J.GE.JST.AND.J.LE.JFIN) THEN ORH6F404.338
JREV=J-J_OFFSET ORH6F404.339
READ(58,*) JCOUNT,((ISHT(JREV,IB,IS), ORH6F404.340
& IEHT(JREV,IB,IS),IS=1,LDIV), ORH3F402.720
& IB=1,LSEGC) @DYALLOC.4249
IF (J.NE.JCOUNT) THEN ORH6F404.341
ICODE=101 ORH6F404.342
CMESSAGE=' OSETCON: ERROR IN READING BASIN' // ORH6F404.343
& ' INDICES FILE' ORH6F404.344
GOTO 9999 ORH6F404.345
ENDIF ORH6F404.346
ELSE ORH6F404.347
WRITE (6,*) "READING DUMMY BASIN RECORD",J ORH6F404.348
READ(58,*) JCOUNT ORH6F404.349
ENDIF ORH6F404.350
ENDDO ORH6F404.351
C @DYALLOC.4255
C====================================================================== OSETCON.588
C PRINT ARRAYS OF BASIN INDICES OSETCON.589
C====================================================================== OSETCON.590
C OSETCON.591
LSGCM1=LSEGC-1 ORH6F404.352
WRITE(6,4370) ORH6F404.353
4370 FORMAT(50H1 START AND STOP INDICES FOR OCEAN BASINS ) ORH6F404.354
DO J=J_JMT,J_1,-1 ORH6F404.355
JREV = J+J_OFFSET ORH6F404.356
WRITE(6,4380)JREV,((ISHT(J,L,LD),LD=1,LDIV),L=1,LSGCM1) ORH6F404.357
WRITE(6,4390) ((IEHT(J,L,LD),LD=1,LDIV),L=1,LSGCM1) ORH6F404.358
4380 FORMAT(1H ,'J=',I3,5X,10(I5,5X)) ORH6F404.359
4390 FORMAT(1H+,10X,10(5X,I5)) ORH6F404.360
ENDDO ORH6F404.361
ORH1F305.142
ENDIF ! L_OHMEAD = true ORH1F305.143
ORH1F305.144
IF (L_OLATVISC) THEN ORH1F305.145
C OSETCON.603
C Set latitude-dependent viscosity. This goes like OSETCON.604
C AM= AM0 + AM1*cos(latitude). OSETCON.605
C OSETCON.606
DO J=J_1,J_JMTM1 ORH6F404.362
AMT(J)= AM0 + AM1*CST(J) ORH6F404.363
AMU(J)= AM0 + AM1*CS(J) ORH6F404.364
ENDDO ORH6F404.365
*IF DEF,MPP ORH3F402.730
! There's little to be gained by restricting the calculation ORH3F402.731
! of AMT(JMT) to the appropriate process since it's only ORH3F402.732
! a single calculation, but it does serve as a reminder about ORH3F402.733
! how data is distributed and to leave the calculation ORH3F402.734
! unprotected for all PEs to perform would be inconsistent ORH3F402.735
! with the rest of the code and possibly confusing for future ORH3F402.736
! developers. ORH3F402.737
IF (JFIN.EQ.JMT_GLOBAL) THEN ORH6F404.366
*ENDIF ORH3F402.739
AMT(J_JMT) = AM0 + AM1*CST(J_JMT) ORH6F404.367
*IF DEF,MPP ORH3F402.741
ENDIF ORH6F404.368
*ENDIF ORH3F402.743
IF (L_OPRINT) THEN ORH6F404.369
ORH1F305.146
WRITE(6,*)'0 Viscosity on T,S points AMT' ORH6F404.370
WRITE(6,970) AMT ORH6F404.371
WRITE(6,*)'0 Viscosity on U,V points AMU' ORH6F404.372
WRITE(6,970) AMU ORH6F404.373
ENDIF ORH6F404.374
ORH6F404.375
ENDIF ! L_OLATVISC = false ORH1F305.147
ORH1F305.148
*IF DEF,MPP ORL1F404.198
C ORL1F404.199
C===================================================================== ORL1F404.200
C CALL TO SWAPBOUNDS FOR HALO UPDATE IN MPP VERSION ORL1F404.201
C===================================================================== ORL1F404.202
ORL1F404.203
CALL SWAPBOUNDS(CST,1,JMT,O_EW_HALO,O_NS_HALO,1) ORL1F404.204
CALL SWAPBOUNDS(DYTR,1,JMT,O_EW_HALO,O_NS_HALO,1) ORL1F404.205
ORL1F404.206
IF (L_OLATVISC) THEN ORL1F404.207
CALL SWAPBOUNDS(AMT,1,JMT,O_EW_HALO,O_NS_HALO,1) ORL1F404.208
ENDIF ORL1F404.209
ORL1F404.210
*ENDIF ORL1F404.211
ORL1F404.212
C---------------------------------------------------------------------- ORL1F404.213
C CALCULATE CONSTANTS USED IN CLINIC AND TROPIC FOR THE CALCULATION ORL1F404.214
C OF THE HORIZONTAL DIFFUSION COMPONENTS. ORL1F404.215
C---------------------------------------------------------------------- ORL1F404.216
IF (L_OSYMM) THEN ORL1F404.217
ORL1F404.218
JCOUNT = J_JMTM1 ORL1F404.219
ORL1F404.220
ELSE ORL1F404.221
ORL1F404.222
JCOUNT = J_JMTM2 ORL1F404.223
ORL1F404.224
ENDIF ! (L_OSYMM) ORL1F404.225
ORL1F404.226
DO J=J_2,JCOUNT ORL1F404.227
IF (L_OLATVISC) THEN ORL1F404.228
ORL1F404.229
BBU(J) = 8.0*AMU(J)*CSR(J)*CSR(J) ORL1F404.230
CCU(J) = AMT(J+1)*CST(J+1)*DYTR(J+1)*DYUR(J)*CSR(J) ORL1F404.231
DDU(J) = AMT(J)*CST(J)*DYTR(J)*DYUR(J)*CSR(J) ORL1F404.232
GGU(J) = AMU(J)*(1.0-TNG(J)*TNG(J))/(RADIUS*RADIUS) ORL1F404.233
HHU(J) = 2.0*AMU(J)*SINE(J)/(RADIUS*CS(J)*CS(J)) ORL1F404.234
ORL1F404.235
ELSE ORL1F404.236
ORL1F404.237
BBU(J) = 8.0*AM*CSR(J)*CSR(J) ORL1F404.238
CCU(J) = AM*CST(J+1)*DYTR(J+1)*DYUR(J)*CSR(J) ORL1F404.239
DDU(J) = AM*CST(J)*DYTR(J)*DYUR(J)*CSR(J) ORL1F404.240
GGU(J) = AM*(1.0-TNG(J)*TNG(J))/(RADIUS*RADIUS) ORL1F404.241
HHU(J) = 2.0*AM*SINE(J)/(RADIUS*CS(J)*CS(J)) ORL1F404.242
ORL1F404.243
ENDIF ! O_LATVISC ORL1F404.244
ORL1F404.245
END DO ORL1F404.246
ORL1F404.247
IF (L_OBIOLOGY.AND.L_OSOLARAL.AND.L_OCARBON) THEN ORH1F305.149
C NT080993.53
C Compute Declination Angle and Daylength for each NT080993.54
C row for every day of the year (assumed 360 - ie climate mode) NT080993.55
C Ensure COS of HOUR ANGLE does not exceed + or - 1, and set DAY NT080993.56
C LENGTH of 1st & last rows to be the same as that of adjacent rows NT080993.57
C to avoid possible problems at the poles (tan(90)=infinity). NT080993.58
C NT080993.59
FXA=2.0*PI/360.0 ORH6F404.376
FXB=23.45/RADIAN ORH6F404.377
FXC=2.0*12.0/PI ORH6F404.378
DO I = 1,360 ORH6F404.379
DECLIN(I) = FXB * SIN(FXA*(266.0+I)) ORH6F404.380
DO J = J_2,J_JMTM1 ORH6F404.381
CS_HOUR_ANG(J) = -TAN(PHIT(J)) * TAN(DECLIN(I)) ORH6F404.382
IF (CS_HOUR_ANG(J).LT.-1.0) CS_HOUR_ANG(J)=-1.0 ORH6F404.383
IF (CS_HOUR_ANG(J).GT.1.0) CS_HOUR_ANG(J)=1.0 ORH6F404.384
DAYLEN(J,I) = FXC * ACOS(CS_HOUR_ANG(J)) ORH6F404.385
ENDDO ORH6F404.386
*IF DEF,MPP ORH3F402.745
! If rows 1 and 2 are both on the same processor ORH6F404.387
! which they will be. ORH6F404.388
IF (JST.EQ.1) THEN ORH6F404.389
DAYLEN(J_1,I) = DAYLEN(J_2,I) ORH6F404.390
ENDIF ORH6F404.391
ORH3F402.751
ORH3F402.752
! If the final row and final row-1 are both on the ORH6F404.392
! same processor, then no problem ORH6F404.393
IF (JST.LE.JMTM1_GLOBAL.AND.JFIN.GE.JMT_GLOBAL) THEN ORH6F404.394
DAYLEN(J_JMT,I) = DAYLEN(J_JMTM1,I) ORH6F404.395
ELSE ORH6F404.396
IF (JST.LE.JMTM1_GLOBAL.AND. ORH6F404.397
& JFIN.EQ.JMTM1_GLOBAL) THEN ORH6F404.398
! Load temporary array ready for sending to PE ORH6F404.399
! handling row JMT_GLOBAL ORH6F404.400
DAYLEN_TMP(I) = DAYLEN(J_JMTM1,I) ORH6F404.401
ENDIF ORH6F404.402
ENDIF ORH6F404.403
*ELSE ORH3F402.764
DAYLEN(1,I) = DAYLEN(2,I) ORH6F404.404
DAYLEN(JMT,I) = DAYLEN(JMTM1,I) ORH6F404.405
*ENDIF ORH3F402.765
ENDDO ORH6F404.406
ORH6F404.407
*IF DEF,MPP ORH3F402.766
IF (JST.LE.JMTM1_GLOBAL.AND.JFIN.EQ.JMTM1_GLOBAL) THEN ORH6F404.408
! Information is to be received by the PE handling ORH3F402.768
! the final row. ORH3F402.769
PE_RECV = J_PE_IND(JMT_GLOBAL) ORH3F402.770
CALL GC_RSEND(2002,360,PE_RECV,INFO,DAYLEN_TMP,DAYLEN_TMP) ORH3F402.771
ENDIF ORH6F404.409
ORH3F402.773
CALL GC_GSYNC(O_NPROC,INFO) ORH6F404.410
ORH6F404.411
IF (JST.EQ.JMT_GLOBAL) THEN ORH6F404.412
PE_SEND = J_PE_IND(JMT_GLOBAL-1) ORH6F404.413
CALL GC_RRECV(2002,IMT,PE_SEND,INFO,DAYLEN_TMP,DAYLEN_TMP) ORH6F404.414
DO I = 1, 360 ORH6F404.415
DAYLEN(J_JMT,I) = DAYLEN_TMP(I) ORH6F404.416
ENDDO ORH6F404.417
ENDIF ORH6F404.418
CALL GC_GSYNC(O_NPROC,INFO) ORH6F404.419
*ENDIF ORH3F402.781
ORH3F402.782
IF (L_OPRINT) THEN ORH6F404.420
C NT080993.74
WRITE(6,*)'0 Day Length (in hours) at T,S points DAYLEN' ORH6F404.421
WRITE(6,*)'0 Day,1 Rows 1 to JMT' ORH6F404.422
WRITE(6,980) (DAYLEN(J,1),J=J_1,J_JMT) ORH6F404.423
WRITE(6,*)'0 Day 90,Rows 1 to JMT' ORH6F404.424
WRITE(6,980) (DAYLEN(J,90),J=J_1,J_JMT) ORH6F404.425
WRITE(6,*)'0 Day 180,Rows 1 to JMT' ORH6F404.426
WRITE(6,980) (DAYLEN(J,180),J=J_1,J_JMT) ORH6F404.427
WRITE(6,*)'0 Day 270,Rows 1 to JMT' ORH6F404.428
WRITE(6,980) (DAYLEN(J,270),J=J_1,J_JMT) ORH6F404.429
WRITE(6,*)'0 Day 360, Rows 1 to JMT' ORH6F404.430
WRITE(6,980) (DAYLEN(J,360),J=J_1,J_JMT) ORH6F404.431
WRITE(6,*)' ' ORH6F404.432
980 FORMAT(1X,20F7.2) ORH6F404.433
ENDIF ORH6F404.434
C NT080993.88
C ====================================================================== NT080993.89
C Set up layer coefficient terms for calculation of chlorophyll NT080993.90
C cross section, a*, in routine SPECTRAL NT080993.91
C DZ must be converted from cms to metres before use NT080993.92
C NT080993.93
DLCOA = 1.0 ORH6F404.435
DLCOB = -DLCOA ORH6F404.436
DLCOC = -2.0*DLCOB ORH6F404.437
DLCOD = -3.0*DLCOC ORH6F404.438
C NT080993.98
DO K = 1,KM ORH6F404.439
DLCOBP = DLCOB ORH6F404.440
DLCOCP = DLCOC ORH6F404.441
DLCODP = DLCOD ORH6F404.442
C NT080993.103
DLCOA = DLCOA + DZ(K)*0.01 ORH6F404.443
DLCOD = DLCOA * LOG(DLCOA) ORH6F404.444
DLCOB = DLCOD - DLCOA ORH6F404.445
DLCOD = DLCOD * LOG(DLCOA) ORH6F404.446
DLCOC = DLCOD - 2.0 * DLCOB ORH6F404.447
DLCOD = DLCOD * LOG(DLCOA) - 3.0 * DLCOC ORH6F404.448
C NT080993.110
DLCO(K,1) = DLCOB -DLCOBP ORH6F404.449
DLCO(K,2) = DLCOC -DLCOCP ORH6F404.450
DLCO(K,3) = DLCOD -DLCODP ORH6F404.451
ENDDO ORH6F404.452
C NT080993.115
ENDIF ! L_OBIOLOGY, L_OSOLARAL, L_OCARBON = true ORH1F305.150
*IF DEF,MPP ORH4F402.1
ORH3F403.269
! The following variables are needed for initialisation ORH6F404.453
! purposes at block boundaries, but are outside the scope of ORH6F404.454
! our standard mpp halo. We therefore set up special variables ORH6F404.455
! to handle them. It's a bit of a drag in terms of shuffling ORH6F404.456
! more data around in argument lists, but it does ensure ORH6F404.457
! that the necessary communications (which is te main ORH6F404.458
! performance overhead) are only performed once per run. ORH6F404.459
ORH3F403.275
IF (J_PE_JFINP1.GE.0) THEN ORH6F404.460
! We must send row J_JMT-1 ORH6F404.461
PE_RECV=J_PE_JFINP1 ORH6F404.462
CALL GC_RSEND (5002,IMT,PE_RECV,INFO,HRJ,HR(1,J_JMT-1)) ORH6F404.463
ENDIF ORH6F404.464
ORH3F403.277
CALL GC_GSYNC(O_NPROC,INFO) ORH6F404.465
ORH3F403.284
IF (J_PE_JSTM1.GE.0) THEN ORH6F404.466
! We're expecting to receive a message: ORH6F404.467
PE_SEND = J_PE_JSTM1 ORH6F404.468
CALL GC_RRECV (5002,IMT,PE_SEND,INFO,HRJ,HR) ORH6F404.469
ENDIF ORH6F404.470
ORH3F403.296
CALL GC_GSYNC(O_NPROC,INFO) ORH6F404.471
ORH6F404.472
IF (J_PE_JFINP1.GE.0) THEN ORH6F404.473
! We must send row J_JMT-1 ORH6F404.474
PE_RECV=J_PE_JFINP1 ORH6F404.475
CALL GC_RSEND (5003,1,PE_RECV,INFO,CSRJ,CSR(J_JMT-1)) ORH6F404.476
ENDIF ORH6F404.477
ORH6F404.478
CALL GC_GSYNC(O_NPROC,INFO) ORH6F404.479
ORH6F404.480
IF (J_PE_JSTM1.GE.0) THEN ORH6F404.481
! We're expecting to receive a message: ORH6F404.482
PE_SEND = J_PE_JSTM1 ORH6F404.483
CALL GC_RRECV (5003,1,PE_SEND,INFO,CSRJ,CSR) ORH6F404.484
ENDIF ORH6F404.485
ORH6F404.486
CALL GC_GSYNC(O_NPROC,INFO) ORH6F404.487
ORH6F404.488
IF (J_PE_JFINP1.GE.0) THEN ORH6F404.489
! We must send row J_JMT-1 ORH6F404.490
PE_RECV=J_PE_JFINP1 ORH6F404.491
CALL GC_RSEND(5004,1,PE_RECV,INFO,DYU2RJ,DYU2R(J_JMT-1)) ORH6F404.492
ENDIF ORH6F404.493
ORH6F404.494
CALL GC_GSYNC(O_NPROC,INFO) ORH6F404.495
ORH6F404.496
IF (J_PE_JSTM1.GE.0) THEN ORH6F404.497
! We're expecting to receive a message: ORH6F404.498
PE_SEND = J_PE_JSTM1 ORH6F404.499
CALL GC_RRECV(5004,1,PE_SEND,INFO,DYU2RJ,DYU2R) ORH6F404.500
ENDIF ORH6F404.501
ORH6F404.502
CALL GC_GSYNC(O_NPROC,INFO) ORH6F404.503
C Need to communicate various values to different PE's OOM3F405.87
OOM3F405.88
C Send value of HR(J_1+1) back to previous PE, to be HRJP OOM3F405.89
IF (L_OBIMOM.or.L_OBIHARMGM) THEN OOM3F405.90
OOM3F405.91
IF (J_PE_JSTM1.GE.0) THEN OOM3F405.92
c ! We must send row J_1+1 OOM3F405.93
PE_RECV=J_PE_JSTM1 OOM3F405.94
CALL GC_RSEND(5020,IMT,PE_RECV,INFO,HRJP,HR(1,J_1+1)) OOM3F405.95
ENDIF OOM3F405.96
OOM3F405.97
CALL GC_GSYNC(O_NPROC,INFO) OOM3F405.98
OOM3F405.99
IF (J_PE_JFINP1.GE.0) THEN OOM3F405.100
c ! We're expecting to receive a message: OOM3F405.101
PE_SEND = J_PE_JFINP1 OOM3F405.102
CALL GC_RRECV(5020,IMT,PE_SEND,INFO,HRJP,HR) OOM3F405.103
ENDIF OOM3F405.104
OOM3F405.105
CALL GC_GSYNC(O_NPROC,INFO) OOM3F405.106
OOM3F405.107
C Send value of CSR(J_1+1) back to previous PE, to be CSRJP OOM3F405.108
IF (J_PE_JSTM1.GE.0) THEN OOM3F405.109
c ! We must send row J_1+1 OOM3F405.110
PE_RECV=J_PE_JSTM1 OOM3F405.111
CALL GC_RSEND(5021,1,PE_RECV,INFO,CSRJP,CSR(J_1+1)) OOM3F405.112
ENDIF OOM3F405.113
OOM3F405.114
CALL GC_GSYNC(O_NPROC,INFO) OOM3F405.115
OOM3F405.116
IF (J_PE_JFINP1.GE.0) THEN OOM3F405.117
c ! We're expecting to receive a message: OOM3F405.118
PE_SEND = J_PE_JFINP1 OOM3F405.119
CALL GC_RRECV(5021,1,PE_SEND,INFO,CSRJP,CSR) OOM3F405.120
ENDIF OOM3F405.121
OOM3F405.122
CALL GC_GSYNC(O_NPROC,INFO) OOM3F405.123
OOM3F405.124
C Send value of DYU2R(J_1+1) back to previous PE, to be DYU2RJP OOM3F405.125
IF (J_PE_JSTM1.GE.0) THEN OOM3F405.126
c ! We must send row J_1+1 OOM3F405.127
PE_RECV=J_PE_JSTM1 OOM3F405.128
CALL GC_RSEND(5022,1,PE_RECV,INFO,DYU2RJP,DYU2R(J_1+1)) OOM3F405.129
ENDIF OOM3F405.130
OOM3F405.131
CALL GC_GSYNC(O_NPROC,INFO) OOM3F405.132
OOM3F405.133
IF (J_PE_JFINP1.GE.0) THEN OOM3F405.134
c ! We're expecting to receive a message: OOM3F405.135
PE_SEND = J_PE_JFINP1 OOM3F405.136
CALL GC_RRECV(5022,1,PE_SEND,INFO,DYU2RJP,DYU2R) OOM3F405.137
ENDIF OOM3F405.138
OOM3F405.139
CALL GC_GSYNC(O_NPROC,INFO) OOM3F405.140
OOM3F405.141
C Send value of CST(J_1+1) back to previous PE, to be CSTJP OOM3F405.142
IF (J_PE_JSTM1.GE.0) THEN OOM3F405.143
c ! We must send row J_1+1 OOM3F405.144
PE_RECV=J_PE_JSTM1 OOM3F405.145
CALL GC_RSEND(5023,1,PE_RECV,INFO,CSTJP,CST(J_1+1)) OOM3F405.146
ENDIF OOM3F405.147
OOM3F405.148
CALL GC_GSYNC(O_NPROC,INFO) OOM3F405.149
OOM3F405.150
IF (J_PE_JFINP1.GE.0) THEN OOM3F405.151
c ! We're expecting to receive a message: OOM3F405.152
PE_SEND = J_PE_JFINP1 OOM3F405.153
CALL GC_RRECV(5023,1,PE_SEND,INFO,CSTJP,CST) OOM3F405.154
ENDIF OOM3F405.155
OOM3F405.156
C Send value of DYTR(J_1+1) back to previous PE, to be DYTRJP OOM3F405.157
CALL GC_GSYNC(O_NPROC,INFO) OOM3F405.158
IF (J_PE_JSTM1.GE.0) THEN OOM3F405.159
c ! We must send row J_1+1 OOM3F405.160
PE_RECV=J_PE_JSTM1 OOM3F405.161
CALL GC_RSEND(5024,1,PE_RECV,INFO,DYTRJP,DYTR(J_1+1)) OOM3F405.162
ENDIF OOM3F405.163
OOM3F405.164
CALL GC_GSYNC(O_NPROC,INFO) OOM3F405.165
OOM3F405.166
IF (J_PE_JFINP1.GE.0) THEN OOM3F405.167
c ! We're expecting to receive a message: OOM3F405.168
PE_SEND = J_PE_JFINP1 OOM3F405.169
CALL GC_RRECV(5024,1,PE_SEND,INFO,DYTRJP,DYTR) OOM3F405.170
ENDIF OOM3F405.171
OOM3F405.172
CALL GC_GSYNC(O_NPROC,INFO) OOM3F405.173
OOM3F405.174
ENDIF ! L_OBIMOM.or.L_OBIHARMGM OOM3F405.175
OOM3F405.176
C Send value of CS(J_JMT) forward to next PE, to be CSJM OOM3F405.177
IF (J_PE_JFINP1.GE.0) THEN OOM3F405.178
c ! We must send row J_JMT-1 OOM3F405.179
PE_RECV=J_PE_JFINP1 OOM3F405.180
CALL GC_RSEND(5025,1,PE_RECV,INFO,CSJM,CS(J_JMT-1)) OOM3F405.181
ENDIF OOM3F405.182
OOM3F405.183
CALL GC_GSYNC(O_NPROC,INFO) OOM3F405.184
OOM3F405.185
IF (J_PE_JSTM1.GE.0) THEN OOM3F405.186
c ! We're expecting to receive a message: OOM3F405.187
PE_SEND = J_PE_JSTM1 OOM3F405.188
CALL GC_RRECV(5025,1,PE_SEND,INFO,CSJM,CS) OOM3F405.189
ENDIF OOM3F405.190
OOM3F405.191
C Send value of DYUR(J_JMT) forward to next PE, to be DYURJM OOM3F405.192
CALL GC_GSYNC(O_NPROC,INFO) OOM3F405.193
IF (J_PE_JFINP1.GE.0) THEN OOM3F405.194
c ! We must send row J_JMT-1 OOM3F405.195
PE_RECV=J_PE_JFINP1 OOM3F405.196
CALL GC_RSEND(5026,1,PE_RECV,INFO,DYURJM,DYUR(J_JMT-1)) OOM3F405.197
ENDIF OOM3F405.198
OOM3F405.199
CALL GC_GSYNC(O_NPROC,INFO) OOM3F405.200
OOM3F405.201
IF (J_PE_JSTM1.GE.0) THEN OOM3F405.202
c ! We're expecting to receive a message: OOM3F405.203
PE_SEND = J_PE_JSTM1 OOM3F405.204
CALL GC_RRECV(5026,1,PE_SEND,INFO,DYURJM,DYUR) OOM3F405.205
ENDIF OOM3F405.206
OOM3F405.207
CALL GC_GSYNC(O_NPROC,INFO) OOM3F405.208
OOM3F405.209
c ENDIF ! L_OBIMOM.or.L_OBIHARMGM OOM3F405.210
OOM3F405.211
ORH3F403.310
!===================================================================== ORH4F402.2
! POPULATE HALO REGIONS WITH DATA ORH4F402.3
!===================================================================== ORH4F402.4
ORH4F402.5
CALL SWAPBOUNDS(AMT,1,JMT,O_EW_HALO,O_NS_HALO,1) ORH4F402.6
ORH4F402.7
CALL SWAPBOUNDS(PHI,1,JMT,O_EW_HALO,O_NS_HALO,1) ORH4F402.8
ORH4F402.9
CALL SWAPBOUNDS(FKMP,IMT,JMT,O_EW_HALO,O_NS_HALO,1) ORH4F402.10
ORH4F402.11
CALL SWAPBOUNDS(FKMQ,IMT,JMT,O_EW_HALO,O_NS_HALO,1) ORH4F402.12
ORH4F402.13
CALL SWAPBOUNDS(CS,1,JMT,O_EW_HALO,O_NS_HALO,1) ORH4F402.14
ORH4F402.15
CALL SWAPBOUNDS(SINE,1,JMT,O_EW_HALO,O_NS_HALO,1) ORH4F402.16
ORH4F402.17
CALL SWAPBOUNDS(CSR,1,JMT,O_EW_HALO,O_NS_HALO,1) ORH4F402.18
ORH4F402.19
CALL SWAPBOUNDS(CSTR,1,JMT,O_EW_HALO,O_NS_HALO,1) ORH4F402.20
ORH4F402.21
CALL SWAPBOUNDS(CST,1,JMT,O_EW_HALO,O_NS_HALO,1) ORH4F402.22
ORH4F402.23
CALL SWAPBOUNDS(DYTR,1,JMT,O_EW_HALO,O_NS_HALO,1) ORH4F402.24
ORH4F402.25
CALL SWAPBOUNDS(DYT4R,1,JMT,O_EW_HALO,O_NS_HALO,1) ORH4F402.26
ORH4F402.27
CALL SWAPBOUNDS(DYU,1,JMT,O_EW_HALO,O_NS_HALO,1) ORH4F402.28
ORH4F402.29
CALL SWAPBOUNDS(DYUR,1,JMT,O_EW_HALO,O_NS_HALO,1) ORH4F402.30
ORH4F402.31
CALL SWAPBOUNDS(DYU2R,1,JMT,O_EW_HALO,O_NS_HALO,1) ORH4F402.32
ORH4F402.33
CALL SWAPBOUNDS(CORIOLIS,IMT,JMT,O_EW_HALO,O_NS_HALO,1) ORH4F402.34
ORH4F402.35
CALL SWAPBOUNDS(HR,IMT,JMT,O_EW_HALO,O_NS_HALO,1) ORH4F402.36
CALL SWAPBOUNDS(TNG,1,JMT,O_EW_HALO,O_NS_HALO,1) OOM3F405.212
ORH4F402.37
CALL SWAPBOUNDS(PHIT,1,JMT,O_EW_HALO,O_NS_HALO,1) ODC1F405.470
*IF DEF,MPP ORL1F404.392
C ORL1F404.393
C===================================================================== ORL1F404.394
C CALL TO SWAPBOUNDS FOR HALO UPDATE IN MPP VERSION ORL1F404.395
C===================================================================== ORL1F404.396
ORL1F404.397
CALL SWAPBOUNDS(EM,IMT,JMT,O_EW_HALO,O_NS_HALO,1) ORL1F404.398
ORL1F404.399
*ENDIF ORL1F404.400
*ENDIF ORH4F402.38
ORH4F402.39
ORH1F305.151
ORH1F305.153
9999 CONTINUE ORH6F404.504
ORH6F404.505
RETURN OSETCON.621
END OSETCON.622
*ENDIF @DYALLOC.4257