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
      doout30: DO J=JSTA_M2,JEND_M2
      doin30: DO 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)

      END DO doin30
      END DO doout30
C
C     END OF ROUTINE.
      RETURN
      END