var/obsproc/MAP_plot/Dir_map/prs2sig.F

   1 C
   2        SUBROUTINE PRS2SIG(PP,SIG,FSG,KX,PRES,FP,KXP,PS,PTOP,IWT,NAME)
   3 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
   4 C                                                                      C
   5 C     ...THIS PROGRAM WILL GET THE VALUES ON SIGMA LEVELS (SIG)        C
   6 C        FROM THE VALUES (FP) ON THE PRESSURE LEVELS (SIG). THE RESULT C
   7 C        WILL BE PUT BACK INTO  FSG.                                   C
   8 C                                                                      C
   9 C        SIG is the half sigma values (up-to-bottom)                   C
  10 C        PRES is the values from large to small in hPa                 C
  11 C                                                                      C
  12 C     ...PP is coupled P-perturbation (cb*Pa),                         C
  13 C        PS is Pstar; PTOP is Ptop in cb                               C
  14 C                                                                      C
  15 C     ... IWT = 0  LINEAR INTERPOLATION                                C
  16 C         IWT = 1  LOG LINEAR INTERPOLATION                            C
  17 C                                                                      C
  18 C     ... ICRS = 1 cross points field, = 0 dot point field             C
  19 C                                                                      C
  20 C                                                                      C
  21 C  -- Input:  PP, FP                                                   C
  22 C     Constants: SIG, PRES, PS, PTOP                                   C
  23 C                                                                      C
  24 C  -- Output: FSG                                                      C
  25 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  26 C
  27       DIMENSION PP(KX)   ,  SIG(KX+1), FSG(KX),
  28      +          PRES(KXP),    FP(KXP),
  29      +          ALP(80),ALS(80),D1(80),D2(80),SS(80)
  30       CHARACTER*6 NAME
  31 C
  32 C   inverse the sigma values and stored in to SS:
  33 C
  34 C     SIG(1) = 0.0, SID(2) = 0.10----> SIG(KX) = 0.96, SIG(KX+1) = 1.0
  35 C          SS (KX)) = .05,       ---->        SS (1) = 0.98
  36 C
  37       DO 10 K = 1,KX
  38         SS(K) = SIG(KX-K+1)
  39 10    CONTINUE
  40 C
  41 cc      PRINT 11,NAME,IWT
  42 11    FORMAT(/'CALL SIG2PRS ==> ',A6,'  IWT=',I2)
  43       DO K = 1,KX
  44          IF (K.LE.KXP) THEN
  45 c           PRINT 12,K,SIG(K),SS(K),PRES(K)
  46          ELSE IF (K.LE.KX) THEN
  47 c           PRINT 12,K,SIG(K),SS(K)
  48          ELSE
  49 c           PRINT 12,K,SIG(K)
  50          ENDIF
  51       END DO
  52 12    FORMAT(5X,I3,2X,3F10.4)
  53 C
  54       IF (IWT.EQ.0) THEN
  55 C
  56 C     ... LINEAR INTERPOLATION
  57 C                            | FIELDS RELATED TO WIND DO LINEAR
  58          DO 20 K=1,KX       ! INTERPOLATION
  59             ALS(K)=10.*(SS(K)*PS+PTOP) + PP(K)/PS/100.
  60 20       CONTINUE
  61       ELSE IF (IWT.EQ.1) THEN
  62 C
  63 C        ... LOG INTERPOLATION
  64 C                            | FIELDS RELATED TO MASS FIELD DO LOG
  65          DO 21 K=1,KX       ! IS LINEARLY INTEPOLATION
  66             ALS(K)=ALOG(10.*(SS(K)*PS+PTOP) + PP(K)/PS/100.)
  67 21       CONTINUE
  68       END IF
  69 C
  70 C  .. to get FSG at pressure levels:
  71 C
  72             IF (IWT.EQ.0) THEN
  73 C
  74 C     ... LINEAR INTERPOLATION
  75 C
  76               DO 30 K=1,KXP
  77                 ALP(K)=PRES(K)
  78                 D1(K)=FP(K)
  79 30            CONTINUE
  80             ELSE IF (IWT.EQ.1) THEN
  81 C
  82 C        ... LOG INTERPOLATION
  83 C
  84               DO 31 K=1,KXP
  85                 ALP(K)=ALOG(PRES(K))
  86                 D1(K)=FP(K)
  87 31            CONTINUE
  88             END IF
  89 C
  90 C
  91             DO 40 K=1,KX
  92                DO 50 LL=1,KXP
  93                   IF(ALP(LL).LE.ALS(K)) GO TO 100
  94 50             CONTINUE
  95 100             CONTINUE
  96                L=LL
  97 C
  98                IF (L.EQ.1) THEN
  99 C
 100 C                 ... DO THE REQUESTED EXTRAPOLATION AT BOTTOM
 101
 102 CC                  D2(K)=D1(L)+(ALP(L)-ALS(K))*
 103 CC     +                 (D1(L+1)-D1(L))/(ALP(L)-ALP(L+1))
 104 C  .. REGARDS AS MISSING:
 105                   D2(K) = -999.
 106 C
 107                ELSE IF(ALS(K).GE.ALP(KXP))THEN
 108 C
 109 C                 ... DO THE INTERPOLATION BETWEEN SIGMA LEVELS
 110 C
 111                   AD=ALP(L-1)-ALS(K)
 112                   AU=(ALS(K)-ALP(L))
 113                   D2(K)=(D1(L-1)*AU+D1(L)*AD)/(ALP(L-1)-ALP(L))
 114 C
 115                ELSE
 116 C
 117 C                 ... DO THE REQUESTED EXTRAPOLATION T TOP
 118 C
 119 cc                  IF (IWT.EQ.0) THEN
 120 cc                     D2(K)=D1(L)+(ALP(L)-ALS(K))*
 121 cc     +                     (D1(L)-D1(L-1))/(ALP(L-1)-ALP(L))
 122 cc                  ELSE
 123 C           above the old highest pressure level, T, Qv, .... will take
 124 C           the values on the old highest pressure level.
 125 cc                     D2(K) = D1(KX)
 126 cc                  ENDIF
 127 C  .. REGARDS AS MISSING:
 128                   D2(K) = -999.
 129                END IF
 130 C
 131                FSG(K) = D2(K)
 132 40          CONTINUE
 133 C
 134 cc        PRINT 310,NAME,PS
 135 310     FORMAT(/5X,'NAME=',A6,'  PS=',F10.2)
 136         DO K = 1,KX
 137           PSIG =  10.*(SS(K)*PS+PTOP) + PP(K)/PS/100.
 138           IF (K.LE.KXP) THEN
 139 cc            PRINT 311,K,PSIG,FSG(K),PRES(K),FP(K)
 140 311         FORMAT('K=',I2,' PSIG=',F8.2,' FSG=',F8.2,' PRES=',F8.2,
 141      >              ' FP=',F8.2)
 142           ELSE
 143 cc            PRINT 311,K,PSIG,FSG(K)
 144           ENDIF
 145         END DO
 146 C
 147       RETURN
 148       END
 149
 150
 151
 152
 153
 154
 155