var/convertor/wave2grid_kma/TETEN.inc

   1       SUBROUTINE TETEN(ICE)
   2 C     IMPLICIT DOUBLE PRECISION (A-H,O-Z,\)
   3       REAL*8 XB,XC,X,TABLE,DTABLE
   4       REAL*8 B,C,BI,CI,TSAT,TSATI
   5       REAL*8 RTABLE                                                 !##
   6       COMMON/CTETEN /TABLE (25000)
   7       COMMON/DTETEN /DTABLE(25000)
   8       COMMON/CLATENT/CTABLE(25000),DCL,TEMP0,TEMPI
   9       COMMON/RLQIC  /RTABLE(25000),TLI1,TLI2                        !##
  10       COMMON/COMPHC/ CP,HL,GASR,ER,G,STB,SOLCON,TWOMG
  11       COMMON/COMEVP/CEV(4001),DFW,RDFW
  12       DATA XB,XC/21.18123D0,5418.0D0/
  13       DATA B,C,BI,CI,TSAT,TSATI/19.480254D0,4304.412D0,
  14      &                          23.684812D0,5803.3203D0,
  15      &                          29.55D0,7.85D0/
  16       TEMP0 = t_kelvin
  17 CBBK      TEMPI = 233.15
  18       TEMPI = 258.15
  19       DTEMP = TEMP0-TEMPI
  20       TLI1  = TEMPI                                                 !##
  21       TLI2  = TEMP0                                                 !##
  22       IF(ICE.EQ.1) THEN
  23       DICE = 3.33E5
  24       ELSE
  25       DICE = 0.0
  26       ENDIF
  27       HICE = HL + DICE
  28 C  DL/DT
  29       DCL = -DICE/DTEMP
  30 CX    CLBYCP = HL/CP
  31 CX    CLBYCPI = HICE/CP
  32       IF(ICE.EQ.0) THEN
  33       DO 10 I = 1,25000
  34       X = 123.2D0 + 0.01D0*I
  35 ! WRFVAR compiles at double precision by default, so DEXP is overkill
  36 !      TABLE(I) = 0.622*DEXP(B-C/(X-TSAT))
  37       TABLE(I) = 0.622*EXP(B-C/(X-TSAT))
  38       DTABLE(I) = TABLE(I)*C/(X-TSAT)**2
  39       CTABLE(I) = HL
  40       RTABLE(I) = 1.                                                !##
  41  10   CONTINUE
  42       ELSE
  43       DO 20 I = 1,25000
  44       X = 123.2D0 + 0.01D0*I
  45       IF(X.GE.TEMP0) THEN
  46 !      TABLE(I) = 0.622*DEXP(B-C/(X-TSAT))
  47       TABLE(I) = 0.622*EXP(B-C/(X-TSAT))
  48       DTABLE(I) = TABLE(I)*C/(X-TSAT)**2
  49       CTABLE(I) = HL
  50       RTABLE(I) = 1.                                                !##
  51       ELSEIF(X.LE.TEMPI) THEN
  52 !      TABLE(I) = 0.622*DEXP(BI-CI/(X-TSATI))
  53       TABLE(I) = 0.622*EXP(BI-CI/(X-TSATI))
  54       DTABLE(I) = TABLE(I)*CI/(X-TSATI)**2
  55       CTABLE(I) = HICE
  56       RTABLE(I) = 0.                                                !##
  57       ELSE
  58       RR = (TEMP0-X)/DTEMP
  59       CTABLE(I) = HL*(1.0-RR) + HICE*RR
  60 !      TBL1 = 0.622*DEXP(B-C/(X-TSAT))
  61       TBL1 = 0.622*EXP(B-C/(X-TSAT))
  62       DTBL1 = TBL1*C/(X-TSAT)**2
  63 !      TBL2 = 0.622*DEXP(BI-CI/(X-TSATI))
  64       TBL2 = 0.622*EXP(BI-CI/(X-TSATI))
  65       DTBL2 = TBL2*CI/(X-TSATI)**2
  66       TABLE(I)  = TBL1*(1.D0-RR)+TBL2*RR
  67       DTABLE(I) = DTBL1*(1.D0-RR)+DTBL2*RR+(TBL1-TBL2)/DTEMP
  68       RTABLE(I) = 1.D0-RR                                           !##
  69 C ##                         3-JI KANSUU : RTABLE(I) = TT*TT*(3.-2.*TT)
  70 C ##                                       WHERE   TT = 1.D0-RR
  71       ENDIF
  72  20   CONTINUE
  73       ENDIF
  74       FWMX = 5.0
  75       FWMN = 0.0
  76       IFWM = 4001
  77       DFW = (FWMX-FWMN)/(IFWM-1.)
  78       RDFW=1./DFW
  79 *VOPTION NOFVAL
  80       DO 30 I = 1,IFWM
  81       FW = FWMN + DFW*(I-1.)
  82       CEV(I) = 8.*GASR*(1.6+23.2*(FW)**0.167)*(FW)**0.467
  83    30 CONTINUE
  84       CEV(1) = 0.0
  85 C ##           CALL MNTRLQIC (RTABLE,TLI1,TLI2)
  86       RETURN
  87       END SUBROUTINE TETEN