source: LMDZ6/branches/LMDZ-QUEST/libf/phymar/rrtm_setcoef_140gp.F90 @ 5407

Last change on this file since 5407 was 2089, checked in by Laurent Fairhead, 10 years ago

Inclusion de la physique de MAR


Integration of MAR physics

File size: 6.4 KB
Line 
1SUBROUTINE RRTM_SETCOEF_140GP (KLEV,COLDRY,WKL &
2 &, FAC00,FAC01,FAC10,FAC11,FORFAC,JP,JT,JT1 &
3 &, COLH2O,COLCO2,COLO3,COLN2O,COLCH4,COLO2,CO2MULT &
4 &, LAYTROP,LAYSWTCH,LAYLOW,PAVEL,TAVEL,SELFFAC,SELFFRAC,INDSELF)
5
6!     Reformatted for F90 by JJMorcrette, ECMWF, 980714
7
8!     Purpose:  For a given atmosphere, calculate the indices and
9!     fractions related to the pressure and temperature interpolations.
10!     Also calculate the values of the integrated Planck functions
11!     for each band at the level and layer temperatures.
12
13#include "tsmbkind.h"
14
15USE PARRRTM  , ONLY : JPLAY     ,JPBAND    ,JPGPT   ,JPINPX
16USE YOERRTRF , ONLY : PREF      ,PREFLOG   ,TREF
17
18IMPLICIT NONE
19
20REAL_B :: COLDRY(JPLAY)
21REAL_B :: WKL(JPINPX,JPLAY)
22
23!     DUMMY INTEGER SCALARS
24INTEGER_M :: KLEV
25
26!- from INTFAC     
27REAL_B :: FAC00(JPLAY)
28REAL_B :: FAC01(JPLAY)
29REAL_B :: FAC10(JPLAY)
30REAL_B :: FAC11(JPLAY)
31REAL_B :: FORFAC(JPLAY)
32
33!- from INTIND
34INTEGER_M :: JP(JPLAY)
35INTEGER_M :: JT(JPLAY)
36INTEGER_M :: JT1(JPLAY)
37
38!- from PROFDATA             
39REAL_B :: COLH2O(JPLAY)
40REAL_B :: COLCO2(JPLAY)
41REAL_B :: COLO3 (JPLAY)
42REAL_B :: COLN2O(JPLAY)
43REAL_B :: COLCH4(JPLAY)
44REAL_B :: COLO2 (JPLAY)
45REAL_B :: CO2MULT(JPLAY)
46INTEGER_M :: LAYTROP
47INTEGER_M :: LAYSWTCH
48INTEGER_M :: LAYLOW
49
50!- from PROFILE             
51REAL_B :: PAVEL(JPLAY)
52REAL_B :: TAVEL(JPLAY)
53
54!- from SELF             
55REAL_B :: SELFFAC(JPLAY)
56REAL_B :: SELFFRAC(JPLAY)
57INTEGER_M :: INDSELF(JPLAY)
58
59
60!     LOCAL INTEGER SCALARS
61INTEGER_M :: JP1, LAY
62
63!     LOCAL REAL SCALARS
64REAL_B :: CO2REG, COMPFP, FACTOR, FP, FT, FT1, PLOG, SCALEFAC, STPFAC, WATER
65
66
67!#include "yoeratm.h"   
68
69STPFAC = 296._JPRB/1013._JPRB
70
71LAYTROP  = 0
72LAYSWTCH = 0
73LAYLOW   = 0
74
75!Martin control
76!PRINT*,'PAVEL(:)',PAVEL(:)
77!PRINT*,'SIZE(PAVEL)',SIZE(PAVEL)
78!Martin control
79
80DO LAY = 1, KLEV
81!        Find the two reference pressures on either side of the
82!        layer pressure.  Store them in JP and JP1.  Store in FP the
83!        fraction of the difference (in ln(pressure)) between these
84!        two values that the layer pressure lies.
85  ! Martin modif to gather MAR and LMDZ:
86  IF (PAVEL(LAY) == 0. ) PAVEL(LAY) = (PAVEL(LAY-1))/2.
87  PLOG = LOG(PAVEL(LAY))
88  JP(LAY) = INT(36._JPRB - 5*(PLOG+0.04_JPRB))
89  IF (JP(LAY)  <  1) THEN
90    JP(LAY) = 1
91  ELSEIF (JP(LAY)  >  58) THEN
92    JP(LAY) = 58
93  ENDIF
94  JP1 = JP(LAY) + 1
95  FP = 5._JPRB * (PREFLOG(JP(LAY)) - PLOG)
96
97!        Determine, for each reference pressure (JP and JP1), which
98!        reference temperature (these are different for each 
99!        reference pressure) is nearest the layer temperature but does
100!        not exceed it.  Store these indices in JT and JT1, resp.
101!        Store in FT (resp. FT1) the fraction of the way between JT
102!        (JT1) and the next highest reference temperature that the
103!        layer temperature falls.
104  JT(LAY) = INT(3._JPRB + (TAVEL(LAY)-TREF(JP(LAY)))/15._JPRB)
105  IF (JT(LAY)  <  1) THEN
106    JT(LAY) = 1
107  ELSEIF (JT(LAY)  >  4) THEN
108    JT(LAY) = 4
109  ENDIF
110  FT = ((TAVEL(LAY)-TREF(JP(LAY)))/15._JPRB) - REAL(JT(LAY)-3)
111  JT1(LAY) = INT(3._JPRB + (TAVEL(LAY)-TREF(JP1))/15._JPRB)
112  IF (JT1(LAY)  <  1) THEN
113    JT1(LAY) = 1
114  ELSEIF (JT1(LAY)  >  4) THEN
115    JT1(LAY) = 4
116  ENDIF
117  FT1 = ((TAVEL(LAY)-TREF(JP1))/15._JPRB) - REAL(JT1(LAY)-3)
118
119  WATER = WKL(1,LAY)/COLDRY(LAY)
120  SCALEFAC = PAVEL(LAY) * STPFAC / TAVEL(LAY)
121
122!        If the pressure is less than ~100mb, perform a different
123!        set of species interpolations.
124!         IF (PLOG .LE. 4.56) GO TO 5300
125!--------------------------------------         
126  IF (PLOG  >  4.56_JPRB) THEN
127    LAYTROP =  LAYTROP + 1
128!        For one band, the "switch" occurs at ~300 mb.
129    IF (PLOG  >=  5.76_JPRB) LAYSWTCH = LAYSWTCH + 1
130    IF (PLOG  >=  6.62_JPRB) LAYLOW = LAYLOW + 1
131
132    FORFAC(LAY) = SCALEFAC / (_ONE_+WATER)
133
134!        Set up factors needed to separately include the water vapor
135!        self-continuum in the calculation of absorption coefficient.
136!C           SELFFAC(LAY) = WATER * SCALEFAC / (1.+WATER)
137    SELFFAC(LAY) = WATER * FORFAC(LAY)
138    FACTOR = (TAVEL(LAY)-188.0_JPRB)/7.2_JPRB
139    INDSELF(LAY) = MIN(9, MAX(1, INT(FACTOR)-7))
140    SELFFRAC(LAY) = FACTOR - REAL(INDSELF(LAY) + 7)
141
142!        Calculate needed column amounts.
143    COLH2O(LAY) = 1.E-20_JPRB * WKL(1,LAY)
144    COLCO2(LAY) = 1.E-20_JPRB * WKL(2,LAY)
145    COLO3(LAY)  = 1.E-20_JPRB * WKL(3,LAY)
146    COLN2O(LAY) = 1.E-20_JPRB * WKL(4,LAY)
147    COLCH4(LAY) = 1.E-20_JPRB * WKL(6,LAY)
148    COLO2(LAY)  = 1.E-20_JPRB * WKL(7,LAY)
149    IF (COLCO2(LAY)  ==  _ZERO_) COLCO2(LAY) = 1.E-32_JPRB * COLDRY(LAY)
150    IF (COLN2O(LAY)  ==  _ZERO_) COLN2O(LAY) = 1.E-32_JPRB * COLDRY(LAY)
151    IF (COLCH4(LAY)  ==  _ZERO_) COLCH4(LAY) = 1.E-32_JPRB * COLDRY(LAY)
152!        Using E = 1334.2 cm-1.
153    CO2REG = 3.55E-24_JPRB * COLDRY(LAY)
154    CO2MULT(LAY)= (COLCO2(LAY) - CO2REG) *&
155     &272.63_JPRB*EXP(-1919.4_JPRB/TAVEL(LAY))/(8.7604E-4_JPRB*TAVEL(LAY))
156!         GO TO 5400
157!------------------
158  ELSE
159!        Above LAYTROP.
160! 5300    CONTINUE
161
162!        Calculate needed column amounts.
163    FORFAC(LAY) = SCALEFAC / (_ONE_+WATER)
164
165    COLH2O(LAY) = 1.E-20_JPRB * WKL(1,LAY)
166    COLCO2(LAY) = 1.E-20_JPRB * WKL(2,LAY)
167    COLO3(LAY)  = 1.E-20_JPRB * WKL(3,LAY)
168    COLN2O(LAY) = 1.E-20_JPRB * WKL(4,LAY)
169    COLCH4(LAY) = 1.E-20_JPRB * WKL(6,LAY)
170    COLO2(LAY)  = 1.E-20_JPRB * WKL(7,LAY)
171    IF (COLCO2(LAY)  ==  _ZERO_) COLCO2(LAY) = 1.E-32_JPRB * COLDRY(LAY)
172    IF (COLN2O(LAY)  ==  _ZERO_) COLN2O(LAY) = 1.E-32_JPRB * COLDRY(LAY)
173    IF (COLCH4(LAY)  ==  _ZERO_) COLCH4(LAY) = 1.E-32_JPRB * COLDRY(LAY)
174    CO2REG = 3.55E-24_JPRB * COLDRY(LAY)
175    CO2MULT(LAY)= (COLCO2(LAY) - CO2REG) *&
176     &272.63_JPRB*EXP(-1919.4_JPRB/TAVEL(LAY))/(8.7604E-4_JPRB*TAVEL(LAY))
177!----------------     
178  ENDIF
179! 5400    CONTINUE
180
181!        We have now isolated the layer ln pressure and temperature,
182!        between two reference pressures and two reference temperatures
183!        (for each reference pressure).  We multiply the pressure
184!        fraction FP with the appropriate temperature fractions to get
185!        the factors that will be needed for the interpolation that yields
186!        the optical depths (performed in routines TAUGBn for band n).
187
188  COMPFP = _ONE_ - FP
189  FAC10(LAY) = COMPFP * FT
190  FAC00(LAY) = COMPFP * (_ONE_ - FT)
191  FAC11(LAY) = FP * FT1
192  FAC01(LAY) = FP * (_ONE_ - FT1)
193
194ENDDO
195
196! MT 981104
197!-- Set LAYLOW for profiles with surface pressure less than 750 hPa.
198IF (LAYLOW == 0) LAYLOW=1
199
200RETURN
201END SUBROUTINE RRTM_SETCOEF_140GP
Note: See TracBrowser for help on using the repository browser.