*IF DEF,OCEAN VORTDIAG.2
VORTDIAG.3
C ******************************COPYRIGHT****************************** VORTDIAG.4
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. VORTDIAG.5
C VORTDIAG.6
C Use, duplication or disclosure of this code is subject to the VORTDIAG.7
C restrictions as set forth in the contract. VORTDIAG.8
C VORTDIAG.9
C Meteorological Office VORTDIAG.10
C London Road VORTDIAG.11
C BRACKNELL VORTDIAG.12
C Berkshire UK VORTDIAG.13
C RG12 2SZ VORTDIAG.14
C VORTDIAG.15
C If no contract has been raised with this copy of the code, the use, VORTDIAG.16
C duplication or disclosure of it is strictly prohibited. Permission VORTDIAG.17
C to do so must first be obtained in writing from the Head of Numerical VORTDIAG.18
C Modelling at the above address. VORTDIAG.19
C ******************************COPYRIGHT****************************** VORTDIAG.20
C VORTDIAG.21
CLL Subroutine VORTDIAG -------------------------------------------- VORTDIAG.22
CLL VORTDIAG.23
CLL Author : M. Bell VORTDIAG.24
CLL VORTDIAG.25
CLL Reviewer : R. Hill VORTDIAG.26
CLL VORTDIAG.27
CLL Description : Calculate correction to bottom pressure torque for VORTDIAG.28
CLL vorticity diagnostics. VORTDIAG.29
CLL VORTDIAG.30
CLL History : VORTDIAG.31
CLL Version Date Comment & Name VORTDIAG.32
CLL ------- -------- -------------------------------------------- VORTDIAG.33
CLL 4.2 02/10/96 Converted code to run on MPP systems. R. Hill ORH7F402.100
CLL 4.4 04/06/97 Bottom pressure torque corrected to be OMB2F404.1
CLL sum of barotropic and baroclinic OMB2F404.2
CLL contributions (baroclinic had been lost) OMB2F404.3
CLL -------------------------------------------------------------------- VORTDIAG.34
VORTDIAG.35
SUBROUTINE VORTDIAG( 1,5ORH7F402.101
*CALL ARGOINDX 
ORH7F402.102
& IMT,IMTM1,JMT,JMTM1,JMTM2,PTD,DXU2R,DYU2R, ORH7F402.103
& DXU,DYU,DXT2R,DYT2R,DYTR,CS,CSR,CSTR,DTSF,SWZVRT) VORTDIAG.37
VORTDIAG.38
VORTDIAG.39
IMPLICIT NONE VORTDIAG.40
VORTDIAG.41
*CALL TYPOINDX ORH7F402.104
*CALL OARRYSIZ VORTDIAG.42
*CALL CNTLOCN VORTDIAG.43
*CALL OTIMER VORTDIAG.44
VORTDIAG.45
INTEGER VORTDIAG.46
& I VORTDIAG.47
& ,IMT VORTDIAG.48
& ,IMTM1 VORTDIAG.49
& ,J VORTDIAG.50
& ,JIND ! last row for vorticity diagnostic calculations VORTDIAG.51
& ,JINDP1 ! JIND plus 1 ORH3F402.282
& ,JMT VORTDIAG.52
& ,JMTM1 VORTDIAG.53
& ,JMTM2 VORTDIAG.54
& ,JTEMP ! Loop control to cater for MPP code ORH3F402.283
VORTDIAG.55
REAL VORTDIAG.56
& PTD(IMT_STREAM,JMT_STREAM) ! IN VORTDIAG.57
& ,CS(JMT) ! VORTDIAG.58
& ,CSR(JMT) ! VORTDIAG.59
& ,CSTR(JMT) ! VORTDIAG.60
& ,SWZVRT(IMT_ZVRT,JMT_ZVRT,N_ZVRT)! IN/OUT vorticity diagnostics VORTDIAG.61
& ,vort1(IMT), vort2(IMT) ! contributions to vorticity VORTDIAG.62
& ,UTD(IMT_ZVRT,JMT_ZVRT) ! } barotropic u and v VORTDIAG.63
& ,VTD(IMT_ZVRT,JMT_ZVRT) ! } velocity tendencies VORTDIAG.64
& ,DXU(IMT) ! Spacing of U points along row VORTDIAG.65
& ,DXU2R(IMT) ! Half reciprocal ---------"--------------- VORTDIAG.66
& ,DXT2R(IMT) ! Half reciprocal ---------"--------------- (T) VORTDIAG.67
& ,DYU(JMT) ! Spacing of U points N/S VORTDIAG.68
& ,DYU2R(JMT) ! Half reciprocal ---------"--------------- VORTDIAG.69
& ,DYT2R(JMT) ! Half reciprocal ---------"--------------- (T) VORTDIAG.70
& ,DYTR(JMT) VORTDIAG.71
VORTDIAG.72
REAL recip_2dt ! factor to convert PTD to a true rate of change VORTDIAG.73
& ,DIAG1,DIAG2 ! contributions to velocity calculation VORTDIAG.74
& ,DTSF ! Length of ts on stream function VORTDIAG.75
!----------------------------------------------------------------------- VORTDIAG.76
VORTDIAG.77
IF (L_OTIMER) CALL TIMER('VORTDIAG',3) VORTDIAG.78
! VORTDIAG.79
!--------------------------------------------------------------------- VORTDIAG.80
! Calculate the curl of the integral of the rate of change of vorticity VORTDIAG.81
! for the bottom pressure torque (vorticity) diagnostic VORTDIAG.82
!--------------------------------------------------------------------- VORTDIAG.83
! VORTDIAG.84
VORTDIAG.87
recip_2dt = 1.0 / (2.0 * DTSF) VORTDIAG.88
VORTDIAG.89
! calculations done for row JMT - 1 only for symmetric model VORTDIAG.90
IF (.NOT.(L_OSYMM)) THEN VORTDIAG.91
JIND = J_JMTM2 ORH3F402.284
JINDP1 = J_JMTM1 ORH3F402.285
ELSE VORTDIAG.93
JIND = J_JMTM1 ORH3F402.286
JINDP1 = J_JMT ORH3F402.287
ENDIF VORTDIAG.95
VORTDIAG.96
! calculate the rate of change of the vertically integrated velocities VORTDIAG.97
VORTDIAG.98
*IF DEF,MPP ORH3F402.288
! MPP version requires halos of +/- 1 for PTD ORH3F402.289
CALL SWAPBOUNDS(PTD,IMT,JMT,O_EW_HALO,O_NS_HALO,1) ORH3F402.290
*ENDIF ORH3F402.291
ORH3F402.292
ORH3F402.293
DO J = J_2, JINDP1 ORH3F402.294
DO I=1,IMTM1 VORTDIAG.100
DIAG1=PTD (I+1,J+1)-PTD (I ,J) ORH3F402.295
DIAG2=PTD (I ,J+1)-PTD (I+1,J) ORH3F402.296
UTD (I,J)=-(DIAG1+DIAG2)*DYU2R(J) * recip_2dt ORH3F402.297
VTD (I,J)= (DIAG1-DIAG2)*DXU2R(I) * CSR(J) * recip_2dt ORH3F402.298
END DO ! I VORTDIAG.105
END DO ! J VORTDIAG.106
VORTDIAG.107
! set values for row 1 VORTDIAG.108
VORTDIAG.109
*IF DEF,MPP ORH3F402.299
IF (JST.EQ.1) THEN ORH3F402.300
*ENDIF ORH3F402.301
DO I=1,IMT VORTDIAG.110
UTD(I,J_1) = 0.0 ORH3F402.302
VTD(I,J_1) = 0.0 ORH3F402.303
END DO VORTDIAG.113
VORTDIAG.114
*IF DEF,MPP ORH3F402.304
ENDIF ORH3F402.305
*ENDIF ORH3F402.306
! cyclic boundary conditions VORTDIAG.115
if (L_OCYCLIC) then VORTDIAG.116
do J=J_1,JINDP1 ORH3F402.307
UTD(1,J) = UTD(IMT-1,J) VORTDIAG.118
UTD(IMT,J) = UTD(2,J) VORTDIAG.119
VTD(1,J) = VTD(IMT-1,J) VORTDIAG.120
VTD(IMT,J) = VTD(2,J) VORTDIAG.121
end do ! J VORTDIAG.122
end if ! L_OCYCLIC VORTDIAG.123
VORTDIAG.124
! calculate rate of change of integral vorticity and add into VORTDIAG.125
! bottom pressure torque diagnostic (last vorticity diagnostic) VORTDIAG.126
*IF DEF,MPP ORH3F402.308
! MPP version requires halos of +/- 1 for UTD and VTD ORH3F402.309
CALL SWAPBOUNDS(UTD,IMT,JMT,O_EW_HALO,O_NS_HALO,1) ORH3F402.310
CALL SWAPBOUNDS(VTD,IMT,JMT,O_EW_HALO,O_NS_HALO,1) ORH3F402.311
VORTDIAG.127
! Set JTEMP for control of the following loop. ORH3F402.312
! Under L_OSYMM = true, the value of SWZVRT ORH3F402.313
! at row JMTM1 (global row number) must be available ORH3F402.314
! to the PE handling row JMT. To avoid message ORH3F402.315
! passing, which seems an unnecessary overhead ORH3F402.316
! we may adjust the loop control of the process handling ORH3F402.317
! row JMT so that the value at row JMTM1 is computed ORH3F402.318
! redundantly and is thus available without ORH3F402.319
! message passing. However this will only have ORH3F402.320
! to be done when the PE handling row JMT_GLOBAL ORH3F402.321
! only handles this row and no others. ORH3F402.322
IF ((L_OSYMM).AND.(JST.EQ.JMT_GLOBAL)) THEN ORH3F402.323
JTEMP = J_2 - 1 ORH3F402.324
ELSE ORH3F402.325
JTEMP = J_2 ORH3F402.326
ENDIF ORH3F402.327
ORH3F402.328
*ELSE ORH3F402.329
JTEMP = J_2 ! equals 2 for non mpp code ORH3F402.330
*ENDIF ORH3F402.331
ORH3F402.332
DO J = JTEMP,JIND ORH3F402.333
DO I = 2,IMT VORTDIAG.129
vort1(I)= VORTDIAG.130
& ((UTD(I,J )*DXU(I)+UTD(I-1,J )*DXU(I-1))*CS(J ) VORTDIAG.131
& - (UTD(I,J-1)*DXU(I)+UTD(I-1,J-1)*DXU(I-1))*CS(J-1)) VORTDIAG.132
VORTDIAG.133
vort2(I)= (VTD(I,J )-VTD(I-1,J ))*DYU(J) VORTDIAG.134
& +(VTD(I,J-1)-VTD(I-1,J-1))*DYU(J-1) VORTDIAG.135
VORTDIAG.136
SWZVRT(I,J,N_ZVRT) = SWZVRT(I,J,N_ZVRT) + OMB2F404.4
& ( vort2(I) - vort1(I) ) * DXT2R(I)*DYTR(J)*CSTR(J) OMB2F404.5
END DO ! I VORTDIAG.139
END DO ! J VORTDIAG.140
VORTDIAG.141
! Set symmetric boundary conditions for SWZVRT VORTDIAG.142
IF ( L_OSYMM ) THEN VORTDIAG.143
*IF DEF,MPP ORH3F402.334
! See above for explanation of how this works for MPP code ORH3F402.335
IF (JFIN.EQ.JMT_GLOBAL) THEN ORH3F402.336
*ENDIF ORH3F402.337
DO I=1,IMT VORTDIAG.144
SWZVRT(I,J_JMT,N_ZVRT)= - SWZVRT(I,J_JMT-1,N_ZVRT) ORH3F402.338
END DO VORTDIAG.146
*IF DEF,MPP ORH3F402.339
ENDIF ORH3F402.340
*ENDIF ORH3F402.341
END IF ! L_OSYMM VORTDIAG.147
VORTDIAG.148
! cyclic boundary conditions VORTDIAG.149
if ( L_OCYCLIC ) then VORTDIAG.150
do J=J_1,JINDP1 ORH3F402.342
SWZVRT(1,J,N_ZVRT) = SWZVRT(IMT-1,J,N_ZVRT) VORTDIAG.152
end do VORTDIAG.153
end if VORTDIAG.154
VORTDIAG.155
IF (L_OTIMER) CALL TIMER('VORTDIAG',4) VORTDIAG.156
VORTDIAG.157
RETURN VORTDIAG.158
VORTDIAG.159
END VORTDIAG.160
*ENDIF VORTDIAG.161