var/convertor/wave2grid_kma/GPLHGT.inc

   1       SUBROUTINE GPLHGT
   2      I  (GPS ,GTMP,GWV ,GPHIS,IMAX,JMAX,KMAX,RGAS,G,A,B,
   3      I   JSTA,JFIN,
   4      O   GHGT)
   5 C***********************************************************************
   6 C                CALCULATION OF GEOPOTENTIAL HEIGHT
   7 C***********************************************************************
   8 ! WRFVAR compiles at double precision by default, so DOUBLE PRECISION is
   9 ! overkill
  10 !      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
  11 C
  12       REAL*8    RGAS,G
  13       REAL*8    GPS (IMAX,JMAX     ), GTMP(IMAX,JMAX,KMAX),
  14      &          GWV (IMAX,JMAX,KMAX), GPHIS(IMAX,JMAX     )
  15       REAL*8    GHGT(IMAX,JMAX,KMAX)
  16 C
  17       PARAMETER (KM=50)
  18 C
  19 C     DIMENSION PHALF(KM), DELP(KM), ALPHA(KM), TV(KM)
  20       DIMENSION PHALF(KM),           ALPHA(KM), TV(KM)
  21       DIMENSION PHALFL(KM)
  22 Crizvi      REAL*8    A(50), B(50)
  23       REAL*8    A(KMAX+1), B(KMAX+1)
  24 C
  25 C     DATA COEF /0.608D0/
  26 C********************* PROCEDURE *************************************
  27       COEF=0.608D0
  28       IF (KMAX.GT.KM) THEN
  29         WRITE(6,*) ' ERROR: <KMAX> IS TOO LARGE. in GPLHGT'
  30         STOP 100
  31       END IF
  32       RGASG = RGAS/G
  33       ALPHA(KMAX) = LOG(2.D0)
  34 CPOPTION PARALLEL,DIVNUM(12),PRIND((J,1))
  35 C2000.08.25
  36 CLSW*POPTION PARALLEL
  37 CLSW*POPTION TLOCAL(J,I,K,DELP,SHGT,HYDRO,
  38 CLSW*POPTION PHALF,TV,ALPHA,PHALFL)
  39 CLSW*POPTION INIT(ALPHA(KMAX))
  40       DO 1000 J = JSTA,JFIN
  41 C     DO 1000 J = 1, JMAX
  42       DO 1000 I = 1, IMAX
  43         DO 100 K = 1, KMAX
  44           PHALF(K) = A(K) + B(K)*GPS (I,J)
  45 C         TV   (K) = (1.D0+COEF*GWV(I,J,K))*GTMP(I,J,K)
  46           TV   (K) = (1.D0+COEF*GWV(I,J,K))*GTMP(I,J,K)*RGASG
  47 C         WRITE(6,*) ' K,PHALF,TV=',K,PHALF(K),TV(K)
  48   100   CONTINUE
  49         DO 200 K = 1, KMAX-1
  50 C         DELP (K) = PHALF(K) - PHALF(K+1)
  51           DELP     = PHALF(K) - PHALF(K+1)
  52 C         ALPHA(K) = 1.D0-PHALF(K+1)*LOG(PHALF(K)/PHALF(K+1))/DELP(K)
  53           PHALFL(K)= LOG(PHALF(K)/PHALF(K+1))
  54 C         ALPHA(K) = 1.D0-PHALF(K+1)*PHALFL(K)/DELP(K)
  55           ALPHA(K) = 1.D0-PHALF(K+1)*PHALFL(K)/DELP
  56   200   CONTINUE
  57 C       ALPHA(KMAX) = LOG(2.D0)
  58         SHGT = GPHIS(I,J)/G !SHCO
  59 C       SHGT = GPHIS(I,J)   !SHCN
  60 C         WRITE(6,*) ' SHGT=',SHGT
  61         DO 300 K = 1, KMAX
  62 C         GHGT(I,J,K) = SHGT + ALPHA(K)*RGASG*TV(K)
  63           GHGT(I,J,K) = SHGT + ALPHA(K)*TV(K)
  64 C         WRITE(6,*) ' K,SHGT+LEVEL K-1/2 TO K=',K,GHGT(I,J,K)
  65   300   CONTINUE
  66         HYDRO = 0.D0
  67 C         WRITE(6,*) ' K,GHGT=',1,GHGT(I,J,1)
  68         DO 400 K = 2, KMAX
  69 C         HYDRO = HYDRO + RGASG*TV(K-1)*LOG(PHALF(K-1)/PHALF(K))
  70           HYDRO = HYDRO + TV(K-1)*PHALFL(K-1)
  71           GHGT(I,J,K) = GHGT(I,J,K) + HYDRO
  72 C         WRITE(6,*) ' K,GHGT=',K,GHGT(I,J,K)
  73   400   CONTINUE
  74 C
  75  1000 CONTINUE
  76 C
  77       RETURN
  78       END SUBROUTINE GPLHGT