SUBROUTINE CALEKM(U1D,V1D) C$$$ SUBPROGRAM DOCUMENTATION BLOCK C . . . C SUBPROGRAM: CALEKM COMPUTES EKMAN ROT. GEOS. WINDS C PRGRMMR: TREADON ORG: W/NP2 DATE: 93-03-23 C C ABSTRACT: C THIS ROUTINE COMPUTES EKMAN SPRIAL ROTATED GEOSTROPHIC C WINDS USING 1000MB HEIGHTS. THE EKMAN SPIRAL ROTATION C IS BASED ON THE MATERIAL PRESENTED IN SECTION 8.5.2 C (PP274-277) OF "NUMERICAL WEATHER PREDICTION AND C DYNAMIC METEOROLOGY" BY HALTINER AND WILLIAMS C (WILEY,1980). C . C C PROGRAM HISTORY LOG: C 93-03-23 RUSS TREADON C 98-06-16 T BLACK - CONVERSION FROM 1-D TO 2-D C 00-01-04 JIM TUCCILLO - MPI VERSION C C USAGE: CALL CALEKM(U1D,V1D) C INPUT ARGUMENT LIST: C NONE C C OUTPUT ARGUMENT LIST: C U1D - EKMAN SPIRAL GEOSTROPHIC U WIND C V1D - EKMAN SPIRAL GEOSTROPHIC V WIND C C OUTPUT FILES: C NONE C C SUBPROGRAMS CALLED: C UTILITIES: C NONE C LIBRARY: C COMMON - EXTRA C VRBLS C DYNAMD C MAPOT C CTLBLK C MASKS C LOOPS C INDX C C ATTRIBUTES: C LANGUAGE: FORTRAN 90 C MACHINE : CRAY C-90 C$$$ C C C INCLUDE PARAMETERS INCLUDE "parmeta" INCLUDE "params" C PARAMETER (EDDYK=5.,TWOK=2.*EDDYK) PARAMETER (Z=250.,H=50.,ZMH=Z-H) PARAMETER (ARGLIM=500.,ISMTHZ=2) PARAMETER (FACTOR=1.0,RHO=1.) C C DECLARE VARIABLES REAL U1D(IM,JM),V1D(IM,JM),ZH(IM,JM),ZV(IM,JM) C C INCLUDE COMMON BLOCKS. INCLUDE "EXTRA.comm" INCLUDE "VRBLS.comm" INCLUDE "DYNAMD.comm" INCLUDE "MAPOT.comm" INCLUDE "CTLBLK.comm" INCLUDE "MASKS.comm" INCLUDE "LOOPS.comm" INCLUDE "INDX.comm" C C****************************************************************** C START CALEKM HERE. C C SET CONSTANTS. D75PI =3.*ACOS(-1.)/4. DEG2RD=ACOS(-1.)/180. SQRT2 =SQRT(2.) C C INITIALIZE WIND COMPONENTS TO ZERO. C !$omp parallel do DO J=JSTA,JEND DO I=1,IM U1D(I,J)=D00 V1D(I,J)=D00 ZH(I,J) =Z1000(I,J) ZV(I,J) =D00 ENDDO ENDDO C C COMPUTE 1000MB HEIGHTS AT V POINTS. SMOOTH MASS POINT C HEIGHTS PRIOR TO CALCULATION. SMOOTH WIND POINT HEIGHTS C AFTER CALCULATION. C CALL P2FILT(ISMTHZ,HBM2,ZH) C DO J=JSTA_M,JEND_M DO I=2,IM-1 ZV(I,J)=D25*(ZH(I+IVE(J),J)+ZH(I+IVW(J),J) 1 +ZH(I,J+1)+ZH(I,J-1)) ENDDO ENDDO C CALL P2FLTV(ISMTHZ,VBM2,ZV) C C LOOP OVER HORIZONTAL GRID. C DO 30 J=JSTA_M2,JEND_M2 DO 30 I=2,IM-1 C C OBTAIN FAL WIND COMPONENTS C LLMH=LMH(I,J) UFAL=U(I,J,LLMH) VFAL=V(I,J,LLMH) CX WRITE(81,*)' ' CX 1234 FORMAT(I3,1X,I3,1X,I2,1X,5(G12.6,1X)) C C COMPUTE GEOSTROPHIC WIND BASED ON 1000MB HEIGHTS. C FTRUE=(2.*F(I,J))/DT GRF =G/FTRUE DZDX =(ZV(I+IHE(J),J)-ZV(I+IHW(J),J))/(2.*DX(I,J)) DZDY =(ZV(I,J+1)-ZV(I,J-1))/(2.*DY) UG =-1.*GRF*DZDY*HBM2(I,J) VG =GRF*DZDX*HBM2(I,J) SPDG =SQRT(UG*UG+VG*VG) C C COMPUTE EKMAN SPIRAL COEFFICIENTS. C WDIRT = WDIR(UFAL,VFAL) WDIRG = WDIR(UG,VG) B = SQRT(FTRUE/TWOK) BZMH = B*ZMH IF (BZMH.GT. ARGLIM) BZMH= ARGLIM IF (BZMH.LT.-ARGLIM) BZMH=-ARGLIM EXBZMH = EXP(-1.*BZMH) C C COMPUTE EKMAN SPIRAL U WIND COMPONENT. C ALPHAS=+45. ALPHAS=ALPHAS*DEG2RD*FACTOR SINALF=SIN(ALPHAS) ARG =D75PI + ALPHAS - BZMH COSARG=COS(ARG) IF(((WDIRG.GE.000.).AND.(WDIRG.LE.090.)).OR. X ((WDIRG.GE.270.).AND.(WDIRG.LE.360.))) X COSARG=-1.*COSARG U1D(I,J)=UG+SQRT2*SPDG*SINALF*EXBZMH*COSARG CX WRITE(81,1235) WDIRG,WDIRT,ALPHAS,SINALF CX WRITE(81,1235) B,ZMH,BZMH,EXBZMH CX WRITE(81,1235) ARG,COSARG,SINARG C C COMPUTE EKMAN SPIRAL V WIND COMPONENT. C ALPHAS=+45. ALPHAS=ALPHAS*DEG2RD*FACTOR SINALF=SIN(ALPHAS) ARG =D75PI+ALPHAS-BZMH SINARG=SIN(ARG) IF((WDIRG.GE.000.).AND.(WDIRG.LE.180.)) X SINARG=-1.*SINARG V1D(I,J)=VG+SQRT2*SPDG*SINALF*EXBZMH*SINARG CX WRITE(81,1235) WDIRG,WDIRT,ALPHAS,SINALF CX WRITE(81,1235) B,ZMH,BZMH,EXBZMH CX WRITE(81,1235) ARG,COSARG,SINARG C C SCALE EKMAN SPIRAL WIND COMPONENTS TO ACCEPTABLE C LEVEL. THIS IS ENTIRELY AD HOC. IT WAS DONE TO C PRODUCE A PLEASING WIND FIELD. C U1D(I,J)=D50*U1D(I,J) V1D(I,J)=D50*V1D(I,J) CX WRITE(81,1234)I,J,LLMH,WDIRG,WDIRT,UG,VG CX WRITE(81,1234)I,J,LLMH,SQRT2,SPDG,ALPHAS/DEG2RD,SINALF CX WRITE(81,1234)I,J,LLMH,EXBZMH,COSARG,SINARG CX WRITE(81,1234)I,J,LLMH,UFAL,VFAL,U1D(I,J),V1D(I,J) 30 CONTINUE C C END OF ROUTINE. RETURN END