source: LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/srtm_setcoef.F90 @ 5160

Last change on this file since 5160 was 5160, checked in by abarral, 3 months ago

Put .h into modules
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 8.8 KB
Line 
1SUBROUTINE SRTM_SETCOEF &
2 & ( KLEV    , KNMOL ,&
3 &   PAVEL   , PTAVEL   , PZ      , PTZ     , PTBOUND  ,&
4 &   PCOLDRY , PWKL     ,&
5 &   KLAYTROP, KLAYSWTCH, KLAYLOW ,&
6 &   PCO2MULT, PCOLCH4  , PCOLCO2 , PCOLH2O , PCOLMOL  , PCOLN2O  , PCOLO2 , PCOLO3 ,&
7 &   PFORFAC , PFORFRAC , KINDFOR , PSELFFAC, PSELFFRAC, KINDSELF ,&
8 &   PFAC00  , PFAC01   , PFAC10  , PFAC11  ,&
9 &   KJP     , KJT      , KJT1    &
10 & ) 
11
12!     J. Delamere, AER, Inc. (version 2.5, 02/04/01)
13
14!     Modifications:
15!     JJMorcrette 030224   rewritten / adapted to ECMWF F90 system
16!        M.Hamrud      01-Oct-2003 CY28 Cleaning
17
18!     Purpose:  For a given atmosphere, calculate the indices and
19!     fractions related to the pressure and temperature interpolations.
20
21USE PARKIND1  ,ONLY : JPIM     ,JPRB
22USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
23
24USE PARSRTM , ONLY : JPLAY
25USE YOESRTWN, ONLY :  PREFLOG, TREF
26!!  USE YOESWN  , ONLY : NDBUG
27                   
28IMPLICIT NONE
29
30!-- Input arguments
31
32INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
33INTEGER(KIND=JPIM)               :: KNMOL ! Argument NOT used
34REAL(KIND=JPRB)   ,INTENT(IN)    :: PAVEL(JPLAY)
35REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAVEL(JPLAY)
36REAL(KIND=JPRB)                  :: PZ(0:JPLAY) ! Argument NOT used
37REAL(KIND=JPRB)   ,INTENT(IN)    :: PTZ(0:JPLAY)
38REAL(KIND=JPRB)   ,INTENT(IN)    :: PTBOUND
39REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLDRY(JPLAY)
40REAL(KIND=JPRB)   ,INTENT(IN)    :: PWKL(35,JPLAY)
41INTEGER(KIND=JPIM),INTENT(OUT)   :: KLAYTROP
42INTEGER(KIND=JPIM),INTENT(OUT)   :: KLAYSWTCH
43INTEGER(KIND=JPIM),INTENT(OUT)   :: KLAYLOW
44REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCO2MULT(JPLAY)
45REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCOLCH4(JPLAY)
46REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCOLCO2(JPLAY)
47REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCOLH2O(JPLAY)
48REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCOLMOL(JPLAY)
49REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCOLN2O(JPLAY)
50REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCOLO2(JPLAY)
51REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCOLO3(JPLAY)
52REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFORFAC(JPLAY)
53REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFORFRAC(JPLAY)
54INTEGER(KIND=JPIM),INTENT(OUT)   :: KINDFOR(JPLAY)
55REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSELFFAC(JPLAY)
56REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSELFFRAC(JPLAY)
57INTEGER(KIND=JPIM),INTENT(OUT)   :: KINDSELF(JPLAY)
58REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFAC00(JPLAY)
59REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFAC01(JPLAY)
60REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFAC10(JPLAY)
61REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFAC11(JPLAY)
62INTEGER(KIND=JPIM),INTENT(OUT)   :: KJP(JPLAY)
63INTEGER(KIND=JPIM),INTENT(OUT)   :: KJT(JPLAY)
64INTEGER(KIND=JPIM),INTENT(OUT)   :: KJT1(JPLAY)
65!-- Output arguments
66
67!-- local integers
68
69INTEGER(KIND=JPIM) :: I_NLAYERS, INDBOUND, INDLEV0, JK
70INTEGER(KIND=JPIM) :: JP1
71
72!-- local reals
73
74REAL(KIND=JPRB) :: Z_STPFAC, Z_TBNDFRAC, Z_T0FRAC, Z_PLOG, Z_FP, Z_FT, Z_FT1, Z_WATER, Z_SCALEFAC
75REAL(KIND=JPRB) :: Z_FACTOR, Z_CO2REG, Z_COMPFP
76REAL(KIND=JPRB) :: ZHOOK_HANDLE
77
78
79
80
81IF (LHOOK) CALL DR_HOOK('SRTM_SETCOEF',0,ZHOOK_HANDLE)
82I_NLAYERS = KLEV
83
84Z_STPFAC = 296._JPRB/1013._JPRB
85
86INDBOUND = PTBOUND - 159._JPRB
87Z_TBNDFRAC = PTBOUND - INT(PTBOUND)
88INDLEV0  = PTZ(0) - 159._JPRB
89Z_T0FRAC   = PTZ(0) - INT(PTZ(0))
90
91KLAYTROP  = 0
92KLAYSWTCH = 0
93KLAYLOW   = 0
94
95!IF (NDBUG.LE.3) THEN
96!  PRINT *,'-------- Computed in SETCOEF --------'
97!  print 8990
988990 format(18x,'  T     PFAC00,    01,    10,    11  PCO2MULT     MOL   &
99 & CH4      CO2      H2O      N2O      O2      O3      SFAC  &
100 & SFRAC    FFAC    FFRAC  ISLF IFOR') 
101!END IF
102
103DO JK = 1, I_NLAYERS
104!        Find the two reference pressures on either side of the
105!        layer pressure.  Store them in JP and JP1.  Store in FP the
106!        fraction of the difference (in ln(pressure)) between these
107!        two values that the layer pressure lies.
108
109  Z_PLOG = LOG(PAVEL(JK))
110  KJP(JK) = INT(36. - 5*(Z_PLOG+0.04))
111  IF (KJP(JK) < 1) THEN
112    KJP(JK) = 1
113  ELSEIF (KJP(JK) > 58) THEN
114    KJP(JK) = 58
115  ENDIF
116  JP1 = KJP(JK) + 1
117  Z_FP = 5. * (PREFLOG(KJP(JK)) - Z_PLOG)
118
119!        Determine, for each reference pressure (JP and JP1), which
120!        reference temperature (these are different for each 
121!        reference pressure) is nearest the layer temperature but does
122!        not exceed it.  Store these indices in JT and JT1, resp.
123!        Store in FT (resp. FT1) the fraction of the way between JT
124!        (JT1) and the next highest reference temperature that the
125!        layer temperature falls.
126
127  KJT(JK) = INT(3. + (PTAVEL(JK)-TREF(KJP(JK)))/15.)
128  IF (KJT(JK) < 1) THEN
129    KJT(JK) = 1
130  ELSEIF (KJT(JK) > 4) THEN
131    KJT(JK) = 4
132  ENDIF
133  Z_FT = ((PTAVEL(JK)-TREF(KJP(JK)))/15.) - REAL(KJT(JK)-3)
134  KJT1(JK) = INT(3. + (PTAVEL(JK)-TREF(JP1))/15.)
135  IF (KJT1(JK) < 1) THEN
136    KJT1(JK) = 1
137  ELSEIF (KJT1(JK) > 4) THEN
138    KJT1(JK) = 4
139  ENDIF
140  Z_FT1 = ((PTAVEL(JK)-TREF(JP1))/15.) - REAL(KJT1(JK)-3)
141
142  Z_WATER = PWKL(1,JK)/PCOLDRY(JK)
143  Z_SCALEFAC = PAVEL(JK) * Z_STPFAC / PTAVEL(JK)
144
145!        If the pressure is less than ~100mb, perform a different
146!        set of species interpolations.
147
148  IF (Z_PLOG <= 4.56) GO TO 5300
149  KLAYTROP =  KLAYTROP + 1
150  IF (Z_PLOG >= 6.62) KLAYLOW = KLAYLOW + 1
151
152!        Set up factors needed to separately include the water vapor
153!        foreign-continuum in the calculation of absorption coefficient.
154
155  PFORFAC(JK) = Z_SCALEFAC / (1.+Z_WATER)
156  Z_FACTOR = (332.0-PTAVEL(JK))/36.0
157  KINDFOR(JK) = MIN(2, MAX(1, INT(Z_FACTOR)))
158  PFORFRAC(JK) = Z_FACTOR - REAL(KINDFOR(JK))
159
160!        Set up factors needed to separately include the water vapor
161!        self-continuum in the calculation of absorption coefficient.
162
163  PSELFFAC(JK) = Z_WATER * PFORFAC(JK)
164  Z_FACTOR = (PTAVEL(JK)-188.0)/7.2
165  KINDSELF(JK) = MIN(9, MAX(1, INT(Z_FACTOR)-7))
166  PSELFFRAC(JK) = Z_FACTOR - REAL(KINDSELF(JK) + 7)
167
168!        Calculate needed column amounts.
169
170  PCOLH2O(JK) = 1.E-20 * PWKL(1,JK)
171  PCOLCO2(JK) = 1.E-20 * PWKL(2,JK)
172  PCOLO3(JK) = 1.E-20 * PWKL(3,JK)
173!         COLO3(LAY) = 0.
174!         COLO3(LAY) = colo3(lay)/1.16
175  PCOLN2O(JK) = 1.E-20 * PWKL(4,JK)
176  PCOLCH4(JK) = 1.E-20 * PWKL(6,JK)
177  PCOLO2(JK) = 1.E-20 * PWKL(7,JK)
178  PCOLMOL(JK) = 1.E-20 * PCOLDRY(JK) + PCOLH2O(JK)
179!         colco2(lay) = 0.
180!         colo3(lay) = 0.
181!         coln2o(lay) = 0.
182!         colch4(lay) = 0.
183!         colo2(lay) = 0.
184!         colmol(lay) = 0.
185  IF (PCOLCO2(JK) == 0.) PCOLCO2(JK) = 1.E-32 * PCOLDRY(JK)
186  IF (PCOLN2O(JK) == 0.) PCOLN2O(JK) = 1.E-32 * PCOLDRY(JK)
187  IF (PCOLCH4(JK) == 0.) PCOLCH4(JK) = 1.E-32 * PCOLDRY(JK)
188  IF (PCOLO2(JK) == 0.) PCOLO2(JK) = 1.E-32 * PCOLDRY(JK)
189!        Using E = 1334.2 cm-1.
190  Z_CO2REG = 3.55E-24 * PCOLDRY(JK)
191  PCO2MULT(JK)= (PCOLCO2(JK) - Z_CO2REG) * &
192   & 272.63*EXP(-1919.4/PTAVEL(JK))/(8.7604E-4*PTAVEL(JK)) 
193  GO TO 5400
194
195!        Above LAYTROP.
196  5300    CONTINUE
197
198!        Set up factors needed to separately include the water vapor
199!        foreign-continuum in the calculation of absorption coefficient.
200
201  PFORFAC(JK) = Z_SCALEFAC / (1.+Z_WATER)
202  Z_FACTOR = (PTAVEL(JK)-188.0)/36.0
203  KINDFOR(JK) = 3
204  PFORFRAC(JK) = Z_FACTOR - 1.0
205
206!        Calculate needed column amounts.
207
208  PCOLH2O(JK) = 1.E-20 * PWKL(1,JK)
209  PCOLCO2(JK) = 1.E-20 * PWKL(2,JK)
210  PCOLO3(JK)  = 1.E-20 * PWKL(3,JK)
211  PCOLN2O(JK) = 1.E-20 * PWKL(4,JK)
212  PCOLCH4(JK) = 1.E-20 * PWKL(6,JK)
213  PCOLO2(JK)  = 1.E-20 * PWKL(7,JK)
214  PCOLMOL(JK) = 1.E-20 * PCOLDRY(JK) + PCOLH2O(JK)
215  IF (PCOLCO2(JK) == 0.) PCOLCO2(JK) = 1.E-32 * PCOLDRY(JK)
216  IF (PCOLN2O(JK) == 0.) PCOLN2O(JK) = 1.E-32 * PCOLDRY(JK)
217  IF (PCOLCH4(JK) == 0.) PCOLCH4(JK) = 1.E-32 * PCOLDRY(JK)
218  IF (PCOLO2(JK) == 0.) PCOLO2(JK)  = 1.E-32 * PCOLDRY(JK)
219  Z_CO2REG = 3.55E-24 * PCOLDRY(JK)
220  PCO2MULT(JK)= (PCOLCO2(JK) - Z_CO2REG) * &
221   & 272.63*EXP(-1919.4/PTAVEL(JK))/(8.7604E-4*PTAVEL(JK)) 
222
223  PSELFFAC(JK) =0.0_JPRB
224  PSELFFRAC(JK)=0.0_JPRB
225  KINDSELF(JK) = 0
226
227  5400    CONTINUE
228
229!        We have now isolated the layer ln pressure and temperature,
230!        between two reference pressures and two reference temperatures
231!        (for each reference pressure).  We multiply the pressure
232!        fraction FP with the appropriate temperature fractions to get
233!        the factors that will be needed for the interpolation that yields
234!        the optical depths (performed in routines TAUGBn for band n).
235
236  Z_COMPFP = 1. - Z_FP
237  PFAC10(JK) = Z_COMPFP * Z_FT
238  PFAC00(JK) = Z_COMPFP * (1. - Z_FT)
239  PFAC11(JK) = Z_FP * Z_FT1
240  PFAC01(JK) = Z_FP * (1. - Z_FT1)
241
242!  IF (NDBUG.LE.3) THEN
243!    print 9000,LAY,LAYTROP,JP(LAY),JT(LAY),JT1(LAY),TAVEL(LAY) &
244!      &,FAC00(LAY),FAC01(LAY),FAC10(LAY),FAC11(LAY) &
245!      &,CO2MULT(LAY),COLMOL(LAY),COLCH4(LAY),COLCO2(LAY),COLH2O(LAY) &
246!      &,COLN2O(LAY),COLO2(LAY),COLO3(LAY),SELFFAC(LAY),SELFFRAC(LAY) &
247!      &,FORFAC(LAY),FORFRAC(LAY),INDSELF(LAY),INDFOR(LAY)
248  9000 format(1x,2I3,3I4,F6.1,4F7.2,12E9.2,2I5)
249!  END IF
250
251ENDDO
252
253!-----------------------------------------------------------------------
254IF (LHOOK) CALL DR_HOOK('SRTM_SETCOEF',1,ZHOOK_HANDLE)
255END SUBROUTINE SRTM_SETCOEF
256
Note: See TracBrowser for help on using the repository browser.