SUBROUTINE OCN_FOR_STEP( 1,11@DYALLOC.2733
*CALL ARGSIZE 
@DYALLOC.2734
*CALL ARGD1 @DYALLOC.2735
*CALL ARGDUMA @DYALLOC.2736
*CALL ARGDUMO @DYALLOC.2737
*CALL ARGDUMW GKR1F401.248
*CALL ARGPTRO @DYALLOC.2739
*CALL ARGSTS @DYALLOC.2740
*CALL ARGCONO @DYALLOC.2742
*CALL ARGOCALL @DYALLOC.2743
*CALL ARGBND SI180893.21
*CALL ARGPPX GKR0F305.965
*CALL ARGOINDX ORH7F402.70
& ICODE,CMESSAGE @DYALLOC.2744
# , LL_ASS_BTRP, DU_ASS_BTRP, DV_ASS_BTRP OCNFRST1.29
# ) OCNFRST1.31
OCNFRST1.32
IMPLICIT NONE OCNFRST1.33
OCNFRST1.34
INTEGER OCNFRST1.35
& ICODE ! Return code : 0 Normal Exit OCNFRST1.36
C ! : >0 Error OCNFRST1.37
OCNFRST1.38
CHARACTER*(80) ONF0F304.2
& CMESSAGE ! Error message if return code >0 OCNFRST1.40
C* OCNFRST1.41
CL Include COMDECKS containing parameters and D1 array OCNFRST1.42
*CALL OARRYSIZ ORH6F401.16
OCNFRST1.43
*CALL CSUBMODL GDR3F305.145
*CALL CMAXSIZE @DYALLOC.2745
*CALL TYPSIZE @DYALLOC.2746
*CALL TYPDUMA @DYALLOC.2747
*CALL TYPDUMO @DYALLOC.2748
*CALL TYPDUMW GKR1F401.249
*CALL TYPD1 @DYALLOC.2749
*CALL TYPPTRO @DYALLOC.2751
*CALL TYPSTS @DYALLOC.2752
*CALL TYPCONO @DYALLOC.2754
*CALL TYPOINDX PXORDER.30
*CALL TYPOCALL @DYALLOC.2755
*CALL TYPBND SI180893.22
*CALL TYPOCTOT ORH1F304.139
*CALL PPXLOOK GKR0F305.966
OCNFRST1.46
CL* OCNFRST1.48
LOGICAL LL_ASS_BTRP ! T => analysis barotropic current increments OCNFRST1.49
C to be added in to model field OCNFRST1.50
C OCNFRST1.51
REAL DU_ASS_BTRP(IMT_ASM,JMT_ASM) ! barotrpic current increments ORH1F305.5431
&, DV_ASS_BTRP(IMT_ASM,JMT_ASM) ! calc'd in data analysis step ORH1F305.5432
CL Include OTHER COMDECKS OCNFRST1.56
OCNFRST1.57
*CALL CHSUNITS RS030293.214
*CALL CCONTROL OCNFRST1.58
*CALL CTIME OCNFRST1.59
OCNFRST1.61
C Local variables OCNFRST1.62
OCNFRST1.63
REAL OCNFRST1.64
& TTSEC ! Elapsed seconds OCNFRST1.65
INTEGER OCNFRST1.66
& elapsed_days_out ! Elapsed days TJ080294.456
&, elapsed_secs_out ! Elapsed seconds TJ080294.457
&,I,J OCNFRST1.68
& ,IM_IDENT ! internal model identifier GRB4F305.322
& ,IM_INDEX ! internal model index for STASH arrays GRB4F305.323
INTEGER ZVRTITEM ! first item number for vorticity diagnostics OMB3F401.14
PARAMETER ( ZVRTITEM = 211 ) OMB3F401.15
INTEGER S_Item ! stash item number OMB3F401.16
INTEGER ID ! loop index for vorticity diagnostics OMB3F401.17
OCNFRST1.69
C External subroutines called OCNFRST1.70
OCNFRST1.71
EXTERNAL OCNFRST1.72
& TIME2SEC, OCNFRST1.73
& BOUNDVOL, OCNFRST1.74
& OCN_CTL, OCNFRST1.75
& STASH, OCNFRST1.76
& CTODUMP, OCNFRST1.77
& DATASWAP, OCNFRST1.78
& PNTRSWAP, OCNFRST1.79
& TIMER OCNFRST1.80
OCNFRST1.81
OCNFRST1.82
C Set up internal model identifier and STASH index GRB4F305.324
im_ident = ocean_im GRB4F305.325
im_index = internal_model_index(im_ident) GRB4F305.326
GRB4F305.327
ICODE=0 OCNFRST1.83
CMESSAGE=' ' OCNFRST1.84
OCNFRST1.85
OCNFRST1.86
IF(LTIMER) THEN OCNFRST1.87
CALL TIMER('OCN_FOR_STEP',3) OCNFRST1.88
END IF OCNFRST1.89
OCNFRST1.90
OCNFRST1.91
IF (L_OPENBC) THEN OSI1F405.119
CL Increment lateral boundary values with boundary tendency OCNFRST1.93
OCNFRST1.94
CALL BOUNDVOL( @DYALLOC.2757
*CALL ARGSIZE @DYALLOC.2758
*CALL ARGOINDX OSI1F405.120
*CALL ARGD1 @DYALLOC.2759
*CALL ARGDUMO @DYALLOC.2760
*CALL ARGPTRO @DYALLOC.2761
*CALL ARGBND SI180893.23
*CALL ARGOCONE OSI1F405.121
*CALL ARGOCFLD OSI1F405.122
*CALL ARGOCFLW OSI1F405.123
& ICODE, CMESSAGE ) @DYALLOC.2763
OCNFRST1.96
ENDIF ORH1F305.5435
GSS1F304.508
CL Calculate elapsed seconds since BASIS TIME OCNFRST1.98
OCNFRST1.99
CALL TIME2SEC (I_YEAR,I_MONTH,I_DAY,I_HOUR,I_MINUTE,I_SECOND TJ080294.458
&, BASIS_TIME_DAYS,BASIS_TIME_SECS TJ080294.459
&, elapsed_days_out,elapsed_secs_out,LCAL360) GSS1F304.509
OCNFRST1.102
IF (elapsed_days_out.GT.3600) THEN ! Avoid 32-bit INT overflow TJ080294.461
TTSEC=FLOAT(elapsed_secs_out)+FLOAT(elapsed_days_out)*86400.0 TJ080294.462
ELSE TJ080294.463
TTSEC=FLOAT(elapsed_secs_out+elapsed_days_out*86400) TJ080294.464
ENDIF TJ080294.465
OCNFRST1.104
CL Sections 21-23 Ocean Routines OCNFRST1.105
OMB3F401.18
C decide whether to calculate barotropic vorticity diagnostics OMB3F401.19
C and set array sizes (which are stored in OARRYSIZ) OMB3F401.20
OMB3F401.21
L_OZVRT = .FALSE. OMB3F401.22
DO ID = 1, 10 OMB3F401.24
S_Item = ZVRTITEM + ID - 1 OMB3F401.25
IF ( SF(S_Item, 31) ) L_OZVRT = .TRUE. OMB3F401.26
END DO OMB3F401.28
OMB3F401.29
IF ( L_OZVRT ) THEN OMB3F401.30
IMT_ZVRT = IMT OMB3F401.31
JMT_ZVRT = JMT OMB3F401.32
N_ZVRT = 10 OMB3F401.33
ELSE OMB3F401.34
IMT_ZVRT = 1 OMB3F401.35
JMT_ZVRT = 1 OMB3F401.36
N_ZVRT = 1 OMB3F401.37
ENDIF OMB3F401.38
OMB3F401.39
OCNFRST1.106
IF(LTIMER) THEN OCNFRST1.107
CALL TIMER('OCN_CTL ',3) OCNFRST1.108
END IF OCNFRST1.109
OCNFRST1.110
OCNFRST1.111
CALL OCN_CTL( @DYALLOC.2764
*CALL ARGSIZE @DYALLOC.2765
*CALL ARGD1 @DYALLOC.2766
*CALL ARGDUMA @DYALLOC.2767
*CALL ARGDUMO @DYALLOC.2768
*CALL ARGDUMW GKR1F401.250
*CALL ARGPTRO @DYALLOC.2770
*CALL ARGSTS @DYALLOC.2771
*CALL ARGCONO @DYALLOC.2773
*CALL ARGOCALL @DYALLOC.2774
*CALL ARGPPX GKR0F305.967
*CALL ARGOINDX ORH7F402.72
& ICODE,CMESSAGE @DYALLOC.2775
OCNFRST1.113
C IN: model description held in dump OCNFRST1.114
OCNFRST1.115
&,STEPim(o_im),TTSEC,O_REALHD(7),O_FLDDEPC ORH1F405.31
OCNFRST1.118
C INOUT: primary variables not controlled by FORTXD OCNFRST1.119
OCNFRST1.120
&,D1(joc_stream(1)),D1(joc_stream(2)) OCNFRST1.121
&,D1(joc_tend(1)),D1(joc_tend(2)) OCNFRST1.122
&,D1(joc_cgres),D1(joc_cgresb) ORH1F401.34
&,D1(joc_eta),D1(joc_etab),D1(joc_ubt),D1(joc_ubtbbt) ORL1F404.714
&,D1(joc_vbt),D1(joc_vbtbbt),D1(joc_ubtbbc),D1(joc_vbtbbc) ORL1F404.715
&,D1(joc_mld) OCNFRST1.124
&,D1(joc_snow),D1(joc_mischt),D1(joc_htotoi),D1(joc_salinc) OCNFRST1.125
&,D1(joc_isx),D1(joc_isy) JT101193.8
&,D1(joc_icecon),D1(joc_icedep) OCNFRST1.127
&,D1(joc_iceu),D1(joc_icev) JT101193.9
&,D1(joc_athkdft) OLA2F403.17
OCNFRST1.128
C IN: ancillary fields not controlled by FORTXD OCNFRST1.129
OCNFRST1.130
&,D1(joc_surfp) OCNFRST1.131
&,D1(joc_heat),D1(joc_solar),D1(joc_snowrate),D1(joc_sublim) OCNFRST1.132
&,D1(joc_topmelt),D1(joc_botmelt),D1(joc_solice),D1(joc_climair) ORH1F405.32
&,D1(joc_climicedep),D1(joc_taux),D1(joc_tauy) ORH1F405.33
&,D1(joc_anom_heat),D1(joc_anom_salt) OJT0F304.7
C IN: assimilation barotropic current increments OCNFRST1.140
&,LL_ASS_BTRP,DU_ASS_BTRP,DV_ASS_BTRP OCNFRST1.141
C OCNFRST1.142
SI010393.2
C IN: pointers to diagnostics OCNFRST1.144
OCNFRST1.145
&,SI(201,30,im_index),SI(202,30,im_index),SI(203,30,im_index) GRB4F305.330
&,SI(204,30,im_index),SI(205,30,im_index),SI(208,30,im_index) GRB4F305.331
&,SI(248,30,im_index),SI(249,30,im_index),SI(250,30,im_index) GRB4F305.332
&,SI(251,30,im_index) GRB4F305.333
&,SI(292,30,im_index),SI(293,30,im_index) OJP0F404.887
&,SI(201,31,im_index),SI(202,31,im_index),SI(201,32,im_index) GRB4F305.334
OCNFRST1.150
C IN: stashflags for diagnostics OCNFRST1.151
&,SF(201,30),SF(202,30),SF(203,30),SF(204,30),SF(205,30) OCNFRST1.152
& ,SF(208,30) SI010393.10
&,SF(248,30),SF(249,30),SF(250,30),SF(251,30) NT071293.2
&,SF(292,30),SF(293,30) OJP0F404.888
OJP0F404.889
&,SF(201,31),SF(202,31) OCNFRST1.154
&,SF(201,32) OCNFRST1.155
OCNFRST1.156
C IN: lengths for STASH workspace OCNFRST1.157
OCNFRST1.158
&,STASH_MAXLEN(30,im_index),STASH_MAXLEN(31,im_index) GRB4F305.328
&,STASH_MAXLEN(32,im_index) GRB4F305.329
*CALL ARGOCTOT ORH1F304.140
OCNFRST1.160
&,LCAL360 OFR8F404.2
& ) OCNFRST1.161
OCNFRST1.162
IF(LTIMER) THEN OCNFRST1.163
CALL TIMER('OCN_CTL ',4) OCNFRST1.164
END IF OCNFRST1.165
OCNFRST1.166
IF(ICODE.GT.0) THEN OCNFRST1.167
RETURN OCNFRST1.168
ENDIF OCNFRST1.169
OCNFRST1.170
OCNFRST1.171
CL Output diagnostics at end of timestep OCNFRST1.172
OKR1F402.5
! Swap arrays containing pointers to prognostic variables OKR1F402.6
! within the ocean stash superarray. OKR1F402.7
OKR1F402.8
do i = 1, nt OKR1F402.9
o_spsts(o_ixsts(1) + i-1) = JOC_TRACER(i,1) OKR1F402.10
o_spsts(o_ixsts(1) + nt + i-1) = JOC_TRACER(i,2) OKR1F402.11
end do OKR1F402.12
OKR1F402.13
o_spsts(o_ixsts(2)) = JOC_U(1) OKR1F402.14
o_spsts(o_ixsts(2)+1) = JOC_U(2) OKR1F402.15
o_spsts(o_ixsts(3)) = JOC_V(1) OKR1F402.16
o_spsts(o_ixsts(3)+1) = JOC_V(2) OKR1F402.17
OKR1F402.18
OCNFRST1.173
CALL STASH(ocean_sm,ocean_im,0,D1, GKR0F305.968
*CALL ARGSIZE @DYALLOC.2777
*CALL ARGD1 @DYALLOC.2778
*CALL ARGDUMA @DYALLOC.2779
*CALL ARGDUMO @DYALLOC.2780
*CALL ARGDUMW GKR1F401.251
*CALL ARGSTS @DYALLOC.2781
*CALL ARGPPX GKR0F305.969
& ICODE,CMESSAGE) @DYALLOC.2785
OCNFRST1.175
IF (ICODE.GT.0) THEN OCNFRST1.176
RETURN OCNFRST1.177
ENDIF OCNFRST1.178
OCNFRST1.179
CL Copy some variables to the header OCNFRST1.180
OCNFRST1.181
! For MPP code, we could arrange to have CTODUMP called ORH9F402.372
! only by PE 0, since it is only setting up values for ORH9F402.373
! the dump header, however, there's nothing to be gained ORH9F402.374
! performance-wise by this, so all PEs perform CTODUMP. ORH9F402.375
CALL CTODUMP( @DYALLOC.2786
*CALL ARGSIZE @DYALLOC.2787
*CALL ARGDUMO @DYALLOC.2788
*CALL ARGOCALL @DYALLOC.2789
& JMT_GLOBAL, ORH6F402.82
* STEPim(o_im),O_INTHD(1),O_REALHD(20),O_REALHD(21), GDR5F305.130
& O_REALHD(22),O_REALHD(23) ORH1F304.141
*CALL ARGOCTOT ORH1F304.142
& ) ORH1F304.143
OCNFRST1.184
CL Copy data for timestep after present to present if DUMP is to OCNFRST1.185
CL be created OCNFRST1.186
OCNFRST1.187
IF (LDUMP) THEN OCNFRST1.188
CALL DATASWAP(O_LEN_DUALDATA OSI0F402.6
& ,D1(joc_tracer(1,1)),D1(joc_tracer(1,2))) OCNFRST1.190
ENDIF OCNFRST1.191
OCNFRST1.192
CL Swap pointers for next timestep OCNFRST1.193
OCNFRST1.194
CALL PNTRSWAP(NT,joc_tracer,joc_u,joc_v) OCNFRST1.195
OCNFRST1.196
OCNFRST1.197
IF(LTIMER) THEN OCNFRST1.198
CALL TIMER('OCN_FOR_STEP',4) OCNFRST1.199
END IF OCNFRST1.200
OCNFRST1.201
RETURN OCNFRST1.202
END OCNFRST1.203
*ENDIF OCEAN OCNFRST1.204
*ENDIF CONTROL OCNFRST1.205