var/convertor/wave2grid_kma/SPLDIF3_H.inc

   1       SUBROUTINE SPLDIF3_H( ZOUT, POUT, LMXOUT, ZIN, PIN, LMXIN, IJMAX,
   2      W SM, H, AL, AM, AP, C )
   3       DIMENSION ZOUT(IJMAX,LMXOUT), POUT(IJMAX,LMXOUT),
   4      1          ZIN (IJMAX,LMXIN),  PIN (IJMAX,LMXIN)
   5       DIMENSION SM(IJMAX,LMXIN), H(IJMAX,LMXIN), AL(IJMAX,LMXIN),
   6      1          AM(IJMAX,LMXIN), AP(IJMAX,LMXIN), C(IJMAX,LMXIN)
   7
   8 C     INPUT / ZIN (L), PIN (L), LMXIN  : INPUT.DATA, PRES(LOG), NUMBER
   9 C     OUTPUT/ ZOUT(L), POUT(L), LMXOUT : OUTPUT-VAL, PRES(LOG), NUMBER
  10
  11       LM1 = LMXIN-1
  12       GR = -gravity/gas_constant
  13
  14       DO 110 L = 2, LMXIN
  15       DO 110 I = 1, IJMAX
  16         H(I,L) = PIN(I,L)-PIN(I,L-1)
  17   110 CONTINUE
  18
  19       DO 120 L = 2, LM1
  20       DO 120 I = 1, IJMAX
  21         AL(I,L) = 0.5*H(I,L+1)/(H(I,L)+H(I,L+1))
  22         AM(I,L) = 0.5-AL(I,L)
  23   120 CONTINUE
  24
  25 C     ( LAPSE RATE IS CONSTANT )
  26 C     SM(1) = SM(2) ; SM(LMXIN-1) = SM(LMXIN) : SECOND DERIVATIVE
  27       DO 125 I = 1, IJMAX
  28         AL(I,1)     = -1.0      ! ORG
  29         AM(I,LMXIN) =  0.0  ! UPPER BOUNDARY
  30 CORG    AM(I,LMXIN) = -1.0      ! ORG
  31         AL(I,LMXIN) =  0.0      ! ORG
  32 CHOON   AL(I,LMXIN) = -1.0  ! KMA
  33   125 CONTINUE
  34
  35       DO 130 L = 2, LMXIN
  36       DO 130 I = 1, IJMAX
  37 C
  38         AP(I,L) = 1.0/(1.0-AL(I,L-1)*AM(I,L))
  39         AL(I,L) = AL(I,L)*AP(I,L)
  40   130 CONTINUE
  41
  42       DO 155 I = 1, IJMAX
  43       C(I,1)     = 0.0
  44       C(I,LMXIN) = 0.0
  45   155 CONTINUE
  46 C
  47       DO 160 L = 2, LM1
  48       DO 160 I = 1, IJMAX
  49         C(I,L) = 3.0*((ZIN(I,L+1)-ZIN(I,L))/H(I,L+1)
  50      1         - (ZIN(I,L)-ZIN(I,L-1))/H(I,L))
  51      2            /(H(I,L)+H(I,L+1))
  52   160 CONTINUE
  53
  54 C     FORWARD SUBSTITUTION
  55
  56       DO 200 L = 2, LMXIN
  57       DO 200 I = 1, IJMAX
  58         C(I,L) = (C(I,L)-C(I,L-1)*AM(I,L))*AP(I,L)
  59   200 CONTINUE
  60       DO 205 I = 1, IJMAX
  61       SM(I,LMXIN) = C(I,LMXIN)
  62   205 CONTINUE
  63
  64 C     BACKWARD SUBSTUTUTION
  65
  66       DO 220 K = 1, LM1
  67       DO 220 I = 1, IJMAX
  68         L = LMXIN-K
  69         SM(I,L) = C(I,L)-AL(I,L)*SM(I,L+1)
  70   220 CONTINUE
  71
  72 C     INTERPOLATION
  73
  74 C     LB = 2
  75
  76       DO 500 LOUT = 1, LMXOUT
  77       DO 500 I = 1, IJMAX
  78
  79         X = POUT(I,LOUT)
  80         L = LOUT ! FOR ONLY PIN.EQ.POUT
  81         IF( L.LT.2 ) L=2
  82 CM      DO 300 L = LB, LMXIN
  83 CM        IF( X.GE.PIN(L) ) GO TO 310
  84 CM300   CONTINUE
  85 CM      L = LMXIN
  86 CM310   LB = L
  87
  88         ZOUT(I,LOUT) = SM(I,L-1)*(  -(PIN(I,L)-X)**2
  89      1             /(2.0*H(I,L))+H(I,L)/6.0 )
  90      2             + SM(I,L)  *( (X-PIN(I,L-1))**2
  91      3             /(2.0*H(I,L))-H(I,L)/6.0 )
  92      \             + ( ZIN(I,L)-ZIN(I,L-1) )/H(I,L)
  93         ZOUT(I,LOUT) = ZOUT(I,LOUT)*GR
  94
  95   500 CONTINUE
  96
  97       RETURN
  98       END SUBROUTINE SPLDIF3_H