var/convertor/wave2grid_kma/RELHUM.inc

   1       SUBROUTINE RELHUM             !shc start
   2      I  (GTMP,GWV,GPS,IMAX,JMAX,KMAX,A,B,
   3      O   GRH)
   4 C***********************************************************************
   5 C                  CALCULATION OF RELATIVE HUMIDITY
   6 C   ƒtƒ‹ƒŒƒxƒ‹‹Cˆ³ŒvŽZ‹@”\•t�iJ•ªŠ„”Å�j
   7 C   CREATED                                      MAR.05,1998  T.TSUYUKI
   8 C   REVISED TO DECREASE LOG CALCULATION          AUG    1999  Y.TAHARA
   9 C 2000.04.18 �ì‹Æ”z—ñ‚ð—p‚¢‚½�‚‘¬”Å RELHUM9‚Æ‚Ç‚¿‚ç‚ª‘¬‚¢‚©
  10 C            –¢ƒ`ƒFƒbƒN
  11 C***********************************************************************
  12 C<INPUT>
  13 C GTMP: ‹C‰·�iƒtƒ‹ƒŒƒxƒ‹�j(K)
  14 C GWV: ”äŽ¼�iƒtƒ‹ƒŒƒxƒ‹�j(KG/KG)
  15 C GPS: ƒ‚ƒfƒ‹’n•\‹Cˆ³(ƒŒƒxƒ‹1/2�j(HPA)
  16 C<OUTPUT>
  17 C GRH: ‘Š‘ÎŽ¼“x�iƒtƒ‹ƒŒƒxƒ‹�j(NON-UNIT)
  18 C***********************************************************************
  19 !      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
  20 C
  21       PARAMETER (KM=50,IMAXD=640)
  22 C
  23       DIMENSION GTMP(IMAX,JMAX,KMAX), GWV (IMAX,JMAX,KMAX),
  24      &          GPS (IMAX,JMAX     )
  25       DIMENSION GRH (IMAX,JMAX,KMAX)
  26 C
  27       DIMENSION PFULL(IMAXD,KM)
  28       REAL*8    A(KMAX+1), B(KMAX+1)
  29       PARAMETER( E0C=6.11D0,AL=17.3D0,BL=237.3D0,
  30      .                                  AI=21.9D0,BI=265.3D0)
  31 C******************** PROCEDURE ****************************************
  32       IF (KMAX.GT.KM) THEN
  33         WRITE(6,*) ' ERROR: <KMAX> IS TOO LARGE. in RELHUM'
  34         STOP 100
  35       END IF
  36 C : ŠiŽq“_–ˆ‚Ì�ˆ—�
  37       DO 1000 J = 1, JMAX
  38 C : ƒn�[ƒtƒŒƒxƒ‹‹Cˆ³(HPA)ŒvŽZ
  39         DO 100 K = 1, KMAX-1
  40       DO 1100 I = 1, IMAX
  41           PU  = A(K+1) + B(K+1)*GPS(I,J)
  42           PD  = A(K  ) + B(K  )*GPS(I,J)
  43 C : ƒtƒ‹ƒŒƒxƒ‹‹Cˆ³(HPA)ŒvŽZ
  44 ! WRFVAR compiles at double precision by default, so DLOG is overkill
  45 !          PFULL(I,K) = DEXP(( PD*DLOG(PD)-PU*DLOG(PU) )/(PD-PU) -1.D0)
  46           PFULL(I,K) = EXP(( PD*LOG(PD)-PU*LOG(PU) )/(PD-PU) -1.D0)
  47  1100 CONTINUE
  48   100   CONTINUE
  49       DO 1300 I = 1, IMAX
  50         PFULL(I,KMAX) = (A(KMAX)+B(KMAX)*GPS(I,J))/2.D0
  51  1300 CONTINUE
  52
  53 C : ƒtƒ‹ƒŒƒxƒ‹‘Š‘ÎŽ¼“x(NON-UNIT)ŒvŽZ
  54         DO 300 K = 1, KMAX
  55       DO 1400 I = 1, IMAX
  56           P = PFULL(I,K)
  57           T = GTMP(I,J,K)
  58           Q = GWV (I,J,K)
  59
  60           E = Q*P/(0.378D0*Q+0.622D0)
  61 C         CALL TETEN  (ES,T)
  62 C=====================================================
  63       TC = T-t_kelvin
  64       IF (TC.GE.0.D0) THEN
  65         ES= E0C *  EXP(AL*TC/(BL+TC))
  66       ELSE IF (TC.LE.-15.D0) THEN
  67         ES= E0C *  EXP(AI*TC/(BI+TC))
  68       ELSE
  69         ES= E0C * (EXP(AL*TC/(BL+TC))*(15.D0+TC)/15.D0 +
  70      .             EXP(AI*TC/(BI+TC))*(-TC)/15.D0)
  71       END IF
  72 C=====================================================
  73           GRH(I,J,K) = E/ES
  74
  75  1400 CONTINUE
  76   300   CONTINUE
  77
  78  1000 CONTINUE
  79
  80       RETURN
  81       END SUBROUTINE RELHUM    !shc end