SUBROUTINE CALEKM2(U1D,V1D)
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C                .      .    .     
C SUBPROGRAM:    CALEKM2     COMPUTES EKMAN ROT. GEOS. WINDS
C   PRGRMMR: TREADON         ORG: W/NP2      DATE: 93-03-25       
C     
C ABSTRACT:
C     THIS ROUTINE COMPUTES EKMAN SPRIAL ROTATED GEOSTROPHIC
C     WINDS FROM THE SEA LEVEL PRESSURE.  THE EKMAN SPIRAL 
C     ROTATION IS BASED ON THE MATERIAL PRESENTED IN SECTION
C     8.5.2 (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 CALEKM2(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.,ISMTHP=2)
      PARAMETER (FACTOR=1.0,RHO=1.)
C
C     DECLARE VARIABLES
      REAL U1D(IM,JM),V1D(IM,JM),SLPH(IM,JM),SLPV(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 CALEKM2 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
        SLPH(I,J)=SLP(I,J)
        SLPV(I,J)=D00
      ENDDO
      ENDDO
C     
C     COMPUTE 1000MB HEIGHTS AT V POINTS.
C
      CALL P2FILT(ISMTHP,HBM2,SLPH)
C
      DO J=JSTA_M,JEND_M
      DO I=2,IM-1
        SLPV(I,J)=D25*(SLPH(I+IVE(J),J)+SLPH(I+IVW(J),J)
     1                +SLPH(I,J+1)+SLPH(I,J-1))
      ENDDO
      ENDDO
C
      CALL P2FLTV(ISMTHP,VBM2,SLPV)
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(I5,1X,I2,1X,5(G12.6,1X))

C
C        COMPUTE GEOSTROPHIC WIND BASED ON SEA LEVEL PRESSURE.
C
      FTRUE=(2.*F(I,J))/DT
      RRHOF=1./(RHO*FTRUE)
      DPDX =(SLPV(I+IHE(J),J)-SLPV(I+IHW(J),J))/(2.*DX(I,J))
      DPDY =(SLPV(I,J+1)-SLPV(I,J-1))/(2.*DY)
      UG   =-1.*RRHOF*DPDY*HBM2(I,J)
      VG   =RRHOF*DPDX*HBM2(I,J)
      SPDG =SQRT(UG**2+VG**2)

CX         WRITE(81,1235) G,FTRUE,DX(K),DY
CX         WRITE(81,1235) SLPV(K),SLPV(K-1),SLPV(K+IM-1),SLPV(K-IM)
CX         WRITE(81,1235) GRF,DZDX,DZDY,UG,VG,SPDG
CX 1235    FORMAT(5(G12.6,1X))

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 AN ACCEPTABLE
C     LEVEL THIS IS ENTIRELY AD HOC.  IT WAS DONE TO PRODUCE
C     A PLEASING WIND FIELD.
C
      U1D(I,J)=D50*U1D(I,J)
      V1D(I,J)=D50*V1D(I,J)

CX         WRITE(81,1234) K,LLMH,WDIRG,WDIRT,UG,VG
CX         WRITE(81,1234) K,LLMH,SQRT2,SPDG,ALPHAS/DEG2RD,SINALF
CX         WRITE(81,1234) K,LLMH,EXBZMH,COSARG,SINARG
CX         WRITE(81,1234) K,LLMH,UFAL,VFAL,U1D(K),V1D(K)

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