SUBROUTINE TROP_CTL( 1,7@DYALLOC.4556
*CALL ARGSIZE 
@DYALLOC.4557
*CALL ARGD1 @DYALLOC.4558
*CALL ARGDUMA @DYALLOC.4559
*CALL ARGDUMO @DYALLOC.4560
*CALL ARGDUMW GKR1F401.275
*CALL ARGSTS @DYALLOC.4563
*CALL ARGOCALL @DYALLOC.4566
*CALL ARGPPX GKR0F305.1004
*CALL ARGOINDX ORH7F402.94
& ICODE,CMESSAGE @DYALLOC.4567
TROP_CTL.26
C IN: model description held in dump TROP_CTL.27
TROP_CTL.28
&, ITT ORH3F405.79
TROP_CTL.30
C INOUT: primary variables TROP_CTL.31
TROP_CTL.32
&,P,PB,PTD,PTDB TROP_CTL.34
&,CGRES,CGRESB ORH1F401.8
C IN: arrays for rigid lid pressure calculation OFRAF404.7
&,ZU,ZV OFRAF404.8
&,ETA,ETAB,UBT,UBTBBT,VBT,VBTBBT,UBTBBC,VBTBBC ORL1F404.854
TROP_CTL.45
C IN: arrays for interfacing between sections 30,31 TROP_CTL.46
TROP_CTL.47
&,ZTD TROP_CTL.49
&,XF,YF TROP_CTL.52
&,SWZVRT OMB3F401.81
TROP_CTL.54
C IN: pointers and stashflags to diagnostics TROP_CTL.55
TROP_CTL.56
&,SI201_31,SI202_31 TROP_CTL.57
&,SF201_31,SF202_31 TROP_CTL.58
TROP_CTL.59
C IN: STASH_MAXLEN for dimensioning stash workspace TROP_CTL.60
TROP_CTL.61
&,sw_len31 TROP_CTL.62
TROP_CTL.63
& ) TROP_CTL.64
TROP_CTL.65
TROP_CTL.66
IMPLICIT NONE TROP_CTL.67
TROP_CTL.68
INTEGER TROP_CTL.69
& SI201_31,SI202_31 TROP_CTL.70
&,sw_len31 TROP_CTL.71
&,ICODE TROP_CTL.72
&,I,J,index TROP_CTL.73
TROP_CTL.74
CHARACTER*(80) ONF0F304.21
& CMESSAGE TROP_CTL.76
TROP_CTL.77
REAL TROP_CTL.78
& STASHWORK(sw_len31) TROP_CTL.79
TROP_CTL.80
LOGICAL TROP_CTL.81
& SF201_31,SF202_31 TROP_CTL.82
TROP_CTL.83
*CALL OARRYSIZ ORH6F401.8
*CALL CSUBMODL ORH6F401.9
*CALL CMAXSIZE @DYALLOC.4568
*CALL TYPSIZE @DYALLOC.4569
*CALL TYPOINDX PXORDER.52
*CALL TYPOCALL ORH6F401.10
*CALL TYPD1 @DYALLOC.4570
*CALL TYPDUMA @DYALLOC.4571
*CALL TYPDUMO @DYALLOC.4572
*CALL TYPDUMW GKR1F401.276
*CALL TYPSTS @DYALLOC.4575
*CALL CNTLOCN ORH1F305.5465
*CALL PPXLOOK GKR0F305.1005
*CALL UMSCALAR OMB3F401.82
TROP_CTL.86
INTEGER TROP_CTL.87
& ITT TROP_CTL.88
REAL TROP_CTL.89
& ZU,ZV ORH3F405.80
&,P(IMT_STREAM,0:JMT_STREAM+1),PB(IMT_STREAM,0:JMT_STREAM+1) ORH1F402.49
&,PTD(IMT_STREAM,JMT_STREAM),PTDB(IMT_STREAM,JMT_STREAM) ORH1F305.5468
&,RLSRFP(IMT,JMT) OFRAF404.9
&,CGRES(IMT_STREAM,JMT_STREAM),CGRESB(IMT_STREAM,JMT_STREAM) ORH1F401.9
&,ETA(IMT_FSF,JMT_FSF),ETAB(IMT_FSF,JMT_FSF) ORL1F404.855
&,UBT(IMT_FSF,JMTM1_FSF),UBTBBT(IMT_FSF,JMTM1_FSF) ORL1F404.856
&,VBT(IMT_FSF,JMTM1_FSF),VBTBBT(IMT_FSF,JMTM1_FSF) ORL1F404.857
&,UBTBBC(IMT_FSF,JMTM1_FSF),VBTBBC(IMT_FSF,JMTM1_FSF) ORL1F404.858
&,ZTD(IMT_STREAM,JMT_STREAM) ORH1F305.5472
&,XF(IMT_FSF,JMT_FSF),YF(IMT_FSF,JMT_FSF) ORH1F305.5473
&,SWZVRT(IMT_ZVRT,JMT_ZVRT,N_ZVRT) ! vorticity diagnostics OMB3F401.83
C Local variables OMB3F401.84
INTEGER ZVRTITEM ! first item number for vorticity diagnostics OMB3F401.85
PARAMETER ( ZVRTITEM = 211 ) OMB3F401.86
INTEGER S_Item ! stash item number OMB3F401.87
INTEGER ID ! loop index for vorticity diagnostics OMB3F401.88
INTEGER IM_IDENT ! internal model identifier OMB3F401.89
INTEGER IM_INDEX ! internal model index for STASH arrays OMB3F401.90
TROP_CTL.104
C External subroutines called TROP_CTL.105
TROP_CTL.106
EXTERNAL TROP_CTL.107
& STASH TROP_CTL.108
& ,RELAX TROP_CTL.109
& ,CALC_RLIDP OFRAF404.11
& ,TROPIC TROP_CTL.111
& ,VORTDIAG OMB3F401.91
& ,TIMER TROP_CTL.114
TROP_CTL.116
TROP_CTL.117
OMB3F401.92
C Set up internal model identifier and STASH index OMB3F401.93
im_ident = ocean_im OMB3F401.94
im_index = internal_model_index(im_ident) OMB3F401.95
TROP_CTL.120
CL Section 32: Barotropic solution TROP_CTL.121
TROP_CTL.122
C Stash ZTD before RELAX is called (RELAX alters ZTD) OMB3F401.98
IF (SF202_31) THEN OMB3F401.99
index=-1 OMB3F401.100
DO J=J_1,J_JMT ORH3F402.280
DO I=1,ICOL_CYC OMB3F401.102
index=index+1 OMB3F401.103
STASHWORK(SI202_31+index)= ZTD(I,J) / C2DTSF OMB3F401.104
END DO OMB3F401.105
END DO OMB3F401.106
END IF ! SF202_31 OMB3F401.107
OMB3F401.108
TROP_CTL.123
C Solution if rigid lid approximation TROP_CTL.124
TROP_CTL.125
IF (.NOT.(L_OFREESFC)) THEN ORH1F305.5474
IF (L_OCONJ) THEN ORH1F401.10
CALL CG_RELAX( ORH1F401.11
*CALL ARGSIZE ORH1F401.12
*CALL ARGOCALL ORH1F401.13
*CALL ARGOINDX ORH5F402.1
! INOUT: primary variables ORH3F405.81
& P,PB,PTD,PTDB ORH3F405.82
& ,CGRES,CGRESB ORH1F401.18
! IN: arrays for interfacing between sections 30,31 ORH1F401.19
& ,ZTD ORH1F401.20
& ) ORH1F401.21
ELSE ORH1F401.22
CALL RELAX( ORH1F401.23
*CALL ARGSIZE ORH1F401.24
*CALL ARGOCALL ORH1F401.25
*CALL ARGOINDX ORH7F402.99
& P,PB,PTD,PTDB ORH3F405.83
! IN: arrays for interfacing between sections 30,31 ORH1F401.30
& ,ZTD ORH1F401.31
& ) ORH1F401.32
ENDIF ORH1F401.33
TROP_CTL.142
IF (L_OZVRT) THEN OMB3F401.109
CALL VORTDIAG( ORH7F402.96
*CALL ARGOINDX ORH7F402.97
& IMT,IMTM1,JMT,JMTM1,JMTM2,PTD,DXU2R,DYU2R, ORH7F402.98
& DXU,DYU,DXT2R,DYT2R,DYTR,CS,CSR,CSTR,DTSF,SWZVRT) OMB3F401.111
OMB3F401.112
END IF OMB3F401.113
CL Copy diagnostics for RELAX to STASHWORK for STASH processing TROP_CTL.143
ENDIF ORH1F305.5475
IF (.NOT.(L_ONOCLIN)) THEN ORH1F305.5476
IF (SF201_31) THEN TROP_CTL.146
CFPP$ NODEPCHK TROP_CTL.147
index=-1 TROP_CTL.148
*IF DEF,MPP ORH0F404.2
! Index includes STASHWORK halos. ORH0F404.3
DO J=1,JMT ORH0F404.4
*ELSE ORH0F404.5
DO J=1,JMTM1 ORH0F404.6
*ENDIF ORH0F404.7
DO I = 1, ICOL_CYC ORH1F305.5477
index=index+1 TROP_CTL.158
STASHWORK(SI201_31+index)=HR(I,J) TROP_CTL.159
END DO TROP_CTL.160
END DO TROP_CTL.161
END IF TROP_CTL.162
TROP_CTL.163
ENDIF ORH1F305.5478
OFRAF404.12
CL Calculate rigid lid surface pressure if required OFRAF404.13
OFRAF404.14
IF (SF(285,31) .AND. (.NOT. L_OFREESFC)) THEN OFRAF404.15
OFRAF404.16
CALL CALC_RLIDP( OFRAF404.17
*CALL ARGSIZE OFRAF404.18
*CALL ARGOCALL OFRAF404.19
*CALL ARGOINDX OFRAF404.20
& ICODE,CMESSAGE,ITT,ZU,ZV,PTD,RLSRFP ) OFRAF404.21
OFRAF404.22
! Place data in STASH array removing cyclic points (if present) OFRAF404.23
CALL COPYODIAGN(IMT,JMT,1,.TRUE.,0.,RLSRFP,FKMP, OFRAF404.24
& STASHWORK(SI(285,31,im_index)) ) OFRAF404.25
OFRAF404.26
ENDIF OFRAF404.27
ORH1F305.5479
IF (L_OFREESFC) THEN ORH1F305.5485
C Solution if free surface is allowed TROP_CTL.186
TROP_CTL.187
CALL TROPIC( TROP_CTL.188
*CALL ARGSIZE @DYALLOC.4582
*CALL ARGOCALL @DYALLOC.4583
*CALL ARGOINDX ORL1F404.859
ORL1F404.860
C IN: model drescription held in dump ORL1F404.861
ORL1F404.862
& ITT ORL1F404.863
ORL1F404.864
C IN: arrays for interfacing between sections 30,31 ORL1F404.865
ORL1F404.866
&,XF,YF ORL1F404.867
ORL1F404.868
C INOUT: primary variables ORL1F404.869
ORL1F404.870
&,ETA, ETAB, UBT, UBTBBT, VBT, VBTBBT ORL1F404.871
ORL1F404.872
C OUT: primary variables ORL1F404.873
ORL1F404.874
&, UBTBBC, VBTBBC ORL1F404.875
TROP_CTL.201
& ) TROP_CTL.202
TROP_CTL.203
ENDIF ORH1F305.5486
OMB3F401.114
C Store vertical mean and integral vorticity diagnostics OMB3F401.115
OMB3F401.116
IF ( L_OZVRT ) THEN OMB3F401.117
DO ID = 1, 10 OMB3F401.118
OMB3F401.119
S_Item = ZVRTITEM + ID - 1 OMB3F401.120
IF ( SF(S_Item, 31) ) THEN OMB3F401.121
OMB3F401.122
DO J = 1, JMT OMB3F401.123
index = (J-1)*IMT + SI(S_Item, 31, im_index) - 1 OMB3F401.124
DO I = 1, IMT OMB3F401.125
STASHWORK(index+I) = SWZVRT(I,J,ID) OMB3F401.126
END DO ! I OMB3F401.127
END DO ! J OMB3F401.128
OMB3F401.129
END IF ! SF item OMB3F401.130
OMB3F401.131
END DO ! ID OMB3F401.132
END IF ! L_OZVRT OMB3F401.133
OMB3F401.134
CALL STASH(o_sm,o_im,31,STASHWORK, GKR0F305.1006
*CALL ARGSIZE @DYALLOC.4585
*CALL ARGD1 @DYALLOC.4586
*CALL ARGDUMA @DYALLOC.4587
*CALL ARGDUMO @DYALLOC.4588
*CALL ARGDUMW GKR1F401.277
*CALL ARGSTS @DYALLOC.4589
*CALL ARGPPX GKR0F305.1007
& ICODE,CMESSAGE) @DYALLOC.4593
TROP_CTL.206
RETURN TROP_CTL.207
END TROP_CTL.208
*ENDIF @DYALLOC.4594