C ********************************************************************** C This diagnostic code computes the vorticity budget of the C vertically integrated (external mode) momentun equations. C (See Ezer & Mellor, 1994: Diagnostic and prognostic calculations C of the North Atlantic circulation and sea level using a sigma C coordinate ocean model, JGR, 99(C7), 14,159-14,171). C USAGE: insert a periodic call after C C 442 CONTINUE C IF(VAMAX.GT.VMAXL) GO TO 9001 C CC IF(MOD(IINT,IWRITE).EQ.0..AND.IEXT.EQ.ISPLIT/2) C **** new pom97.f & latest versions CC 1 CALL VORT(ADVUA,ADVVA,ADX2D,ADY2D,DRX2D,DRY2D,IM,JM) C **** old pmod.f or pom.f codes C 1 CALL VORT(ADVUA,ADVVA,ADVUU,ADVVV,TRNU,TRNV,IM,JM) C C Note that variables' names in the subroutine are still as in old code. C T.E. C ********************************************************************** C C vorticity diagnostics C SUBROUTINE VORT(ADVUA,ADVVA,ADVUU,ADVVV,TRNU,TRNV,IIM,JJM) INCLUDE 'comblk97.h' DIMENSION ADVUA(IIM,JJM),ADVVA(IIM,JJM),ADVUU(IIM,JJM), 1 ADVVV(IIM,JJM),TRNU(IIM,JJM),TRNV(IIM,JJM) DIMENSION FX(IM,JM),FY(IM,JM),CTOT(IM,JM),CELG(IM,JM) DIMENSION CTSURF(IM,JM),CTBOT(IM,JM),CPVF(IM,JM) DIMENSION CJBAR(IM,JM),CADV(IM,JM),CTEN(IM,JM) C DIMENSION TOTX(IM,JM),TOTY(IM,JM) C C --- IID=1 divide terms by D ; IID=0 no div. by D IID=0 C CTSURF=0. CTBOT=0. CPVF=0. CJBAR=0. CADV=0. CTEN=0. CELG=0. CTOT=0. C TOTX=0. C TOTY=0. C C --------------- surface stress term ------------------------ DO 10 I=2,IM DO 10 J=2,JM IF(IID.EQ.1) THEN DMX=0.5*(D(I,J)+D(I-1,J)) DMY=0.5*(D(I,J)+D(I,J-1)) ELSE DMX=1. DMY=1. ENDIF FX(I,J)=WUSURF(I,J)/DMX FY(I,J)=WVSURF(I,J)/DMY 10 CONTINUE C TOTX=TOTX+FX C TOTY=TOTY+FY CALL CURL(FX,FY,DX,DY,DUM,DVM,IM,JM,CTSURF) C C --------------- bottom stress term ------------------------ DO 20 I=2,IM DO 20 J=2,JM IF(IID.EQ.1) THEN DMX=0.5*(D(I,J)+D(I-1,J)) DMY=0.5*(D(I,J)+D(I,J-1)) ELSE DMX=1. DMY=1. ENDIF FX(I,J)=-WUBOT(I,J)/DMX FY(I,J)=-WVBOT(I,J)/DMY 20 CONTINUE C TOTX=TOTX+FX C TOTY=TOTY+FY CALL CURL(FX,FY,DX,DY,DUM,DVM,IM,JM,CTBOT) C C ------------------ surf. elev. gradient term --------------- C (if not divide by D this term = 0 due to continuity) ALPHA =0.225 C DO 30 I=2,IM DO 30 J=2,JM IF(IID.EQ.1) THEN DMX=0.5*(D(I,J)+D(I-1,J)) DMY=0.5*(D(I,J)+D(I,J-1)) ELSE DMX=1. DMY=1. ENDIF FX(I,J)=.25*GRAV*(DY(I,J)+DY(I-1,J))*(D(I,J)+D(I-1,J)) 4 *( (1.-2.*ALPHA)*(EL(I,J)-EL(I-1,J)) 4 +ALPHA*(ELB(I,J)-ELB(I-1,J)+ELF(I,J)-ELF(I-1,J)) ) FX(I,J)=FX(I,J)/(ARU(I,J)*DMX) C FY(I,J)=.250*GRAV*(DX(I,J)+DX(I,J-1))*(D(I,J)+D(I,J-1)) 4 *( (1.0-2.0*ALPHA)*(EL(I,J)-EL(I,J-1)) 4 +ALPHA*(ELB(I,J)-ELB(I,J-1)+ELF(I,J)-ELF(I,J-1)) ) FY(I,J)=FY(I,J)/(ARV(I,J)*DMY) 30 CONTINUE C TOTX=TOTX+FX C TOTY=TOTY+FY CALL CURL(FX,FY,DX,DY,DUM,DVM,IM,JM,CELG) C C -------------------- JBAR term (incl. elev grad)------------ DO 40 I=2,IM DO 40 J=2,JM IF(IID.EQ.1) THEN DMX=0.5*(D(I,J)+D(I-1,J)) DMY=0.5*(D(I,J)+D(I,J-1)) ELSE DMX=1. DMY=1. ENDIF FX(I,J)=TRNU(I,J)/(ARU(I,J)*DMX) FY(I,J)=TRNV(I,J)/(ARV(I,J)*DMY) 40 CONTINUE C TOTX=TOTX+FX C TOTY=TOTY+FY CALL CURL(FX,FY,DX,DY,DUM,DVM,IM,JM,CJBAR) C CC CJBAR=CJBAR+CELG C C --------------- advection and diffusion terms -------------- DO 50 I=2,IM DO 50 J=2,JM IF(IID.EQ.1) THEN DMX=0.5*(D(I,J)+D(I-1,J)) DMY=0.5*(D(I,J)+D(I,J-1)) ELSE DMX=1. DMY=1. ENDIF FX(I,J)=(ADVUU(I,J)+ADVUA(I,J))/(ARU(I,J)*DMX) FY(I,J)=(ADVVV(I,J)+ADVVA(I,J))/(ARV(I,J)*DMY) 50 CONTINUE C TOTX=TOTX+FX C TOTY=TOTY+FY CALL CURL(FX,FY,DX,DY,DUM,DVM,IM,JM,CADV) C C ---------------------- coriolis term ----------------------- DO 60 I=2,IM DO 60 J=2,JM IF(IID.EQ.1) THEN DMX=0.5*(D(I,J)+D(I-1,J)) DMY=0.5*(D(I,J)+D(I,J-1)) ELSE DMX=1. DMY=1. ENDIF FX(I,J)=-.25*( COR(I,J)*D(I,J)*(VA(I,J+1)+VA(I,J)) 2 +COR(I-1,J)*D(I-1,J)*(VA(I-1,J+1)+VA(I-1,J)))/DMX FY(I,J)=+.25*( COR(I,J)*D(I,J)*(UA(I+1,J)+UA(I,J)) 2 +COR(I,J-1)*D(I,J-1)*(UA(I+1,J-1)+UA(I,J-1)))/DMY 60 CONTINUE C TOTX=TOTX+FX C TOTY=TOTY+FY CALL CURL(FX,FY,DX,DY,DUM,DVM,IM,JM,CPVF) C C ------------------ tendency (d/dt) term -------------------- DO 70 I=2,IM DO 70 J=2,JM IF(IID.EQ.1) THEN DMX=0.5*(D(I,J)+D(I-1,J)) DMY=0.5*(D(I,J)+D(I,J-1)) ELSE DMX=1. DMY=1. ENDIF FX(I,J)=(UAF(I,J)*(H(I,J)+ELF(I,J)+H(I-1,J)+ELF(I-1,J)) 1 -UAB(I,J)*(H(I,J)+ELB(I,J)+H(I-1,J)+ELB(I-1,J)))/ 2 (4.*DTE*DMX)*DUM(I,J) FY(I,J)=(VAF(I,J)*(H(I,J)+ELF(I,J)+H(I,J-1)+ELF(I,J-1)) 1 -VAB(I,J)*(H(I,J)+ELB(I,J)+H(I,J-1)+ELB(I,J-1)))/ 2 (4.*DTE*DMY)*DVM(I,J) 70 CONTINUE C TOTX=TOTX+FX C TOTY=TOTY+FY CALL CURL(FX,FY,DX,DY,DUM,DVM,IM,JM,CTEN) C DO 80 I=2,IM DO 80 J=2,JM CTOT(I,J)=CTSURF(I,J)+CTBOT(I,J)+CPVF(I,J)+CJBAR(I,J) 1 +CTEN(I,J)+CADV(I,J) C TOTX(I,J)=TOTX(I,J)*DUM(I,J)*DUM(I-1,J) C TOTY(I,J)=TOTY(I,J)*DVM(I,J)*DVM(I,J-1) 80 CONTINUE C TOTX(1,:)=0. C TOTX(2,:)=0. C TOTX(:,1)=0. C TOTX(:,2)=0. C TOTX(IM,:)=0. C TOTX(:,JM)=0. C TOTY(1,:)=0. C TOTY(2,:)=0. C TOTY(:,1)=0. C TOTY(:,2)=0. C TOTY(IM,:)=0. C TOTY(:,JM)=0. C C CALL PRXY(' CTSURF ',TIME,CTSURF ,IM,3,JM,3,0.0) CALL PRXY(' CTBOT ',TIME,CTBOT ,IM,3,JM,3,0.0) CALL PRXY(' CPVF ',TIME,CPVF ,IM,3,JM,3,0.0) CALL PRXY(' CJBAR ',TIME,CJBAR ,IM,3,JM,3,0.0) CALL PRXY(' CTEN ',TIME,CTEN ,IM,3,JM,3,0.0) CALL PRXY(' CELG ',TIME,CELG ,IM,3,JM,3,0.0) CALL PRXY(' CADV ',TIME,CADV ,IM,3,JM,3,0.0) C CALL PRXY(' CTOT ',TIME,CTOT ,IM,3,JM,3,0.0) C CALL PRXY(' TOTX ',TIME,TOTX ,IM,3,JM,3,0.0) C CALL PRXY(' TOTY ',TIME,TOTY ,IM,3,JM,3,0.0) C WRITE(95) CELG,CTBOT,CPVF,CJBAR,CADV,CTEN C RETURN END C C C -------------------------------------------------------------------- C SUBROUTINE CURL(FX,FY,DX,DY,DUM,DVM,IM,JM,CF) C DIMENSION FX(IM,JM),FY(IM,JM),DX(IM,JM),DY(IM,JM) DIMENSION CF(IM,JM),DUM(IM,JM),DVM(IM,JM) C DO I=3,IM-1 DO J=3,JM-1 C C=-FX(I,J)*(DX(I,J)+DX(I-1,J))+FX(I,J-1)*(DX(I,J-1)+DX(I-1,J-1)) 2 +FY(I,J)*(DY(I,J)+DY(I,J-1))-FY(I-1,J)*(DY(I-1,J)+DY(I-1,J-1)) CF(I,J)= C*DUM(I,J)*DUM(I,J-1)*DVM(I,J)*DVM(I-1,J) C AREA = 0.25*(DX(I,J)+DX(I-1,J) +DX(I,J-1)+DX(I-1,J-1)) 2 *0.25*(DY(I,J)+DY(I,J-1) +DY(I-1,J)+DY(I-1,J-1)) CF(I,J)=CF(I,J)/AREA C ENDDO ENDDO RETURN END C