source: LMDZ6/branches/DYNAMICO-conv-GC/libf/phymar/rrtm_gasabs1a_140gp.F90

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

Inclusion de la physique de MAR


Integration of MAR physics

File size: 4.4 KB
Line 
1SUBROUTINE RRTM_GASABS1A_140GP (KLEV,ATR1,OD,TF1,COLDRY,WX,&
2  &TAUAERL,FAC00,FAC01,FAC10,FAC11,FORFAC,JP,JT,JT1,ONEMINUS,&
3  &COLH2O,COLCO2,COLO3,COLN2O,COLCH4,COLO2,CO2MULT,&
4  &LAYTROP,LAYSWTCH,LAYLOW,SELFFAC,SELFFRAC,INDSELF,PFRAC)
5
6!     Reformatted for F90 by JJMorcrette, ECMWF, 980714
7
8#include "tsmbkind.h"
9
10USE PARRRTM  , ONLY : JPLAY    ,JPBAND   ,JPGPT   ,JPXSEC
11USE YOERRTAB , ONLY : TRANS    ,BPADE
12
13IMPLICIT NONE
14
15REAL_B :: ATR1  (JPGPT,JPLAY)
16REAL_B :: OD    (JPGPT,JPLAY)
17REAL_B :: TF1   (JPGPT,JPLAY)
18REAL_B :: COLDRY(JPLAY)
19REAL_B :: WX(JPXSEC,JPLAY)           ! Amount of trace gases
20
21!     DUMMY INTEGER SCALARS
22INTEGER_M :: KLEV
23
24!- from AER
25REAL_B :: TAUAERL(JPLAY,JPBAND)
26
27!- from INTFAC     
28REAL_B :: FAC00(JPLAY)
29REAL_B :: FAC01(JPLAY)
30REAL_B :: FAC10(JPLAY)
31REAL_B :: FAC11(JPLAY)
32REAL_B :: FORFAC(JPLAY)
33
34!- from INTIND
35INTEGER_M :: JP(JPLAY)
36INTEGER_M :: JT(JPLAY)
37INTEGER_M :: JT1(JPLAY)
38
39!- from PRECISE             
40REAL_B :: ONEMINUS
41
42!- from PROFDATA             
43REAL_B :: COLH2O(JPLAY)
44REAL_B :: COLCO2(JPLAY)
45REAL_B :: COLO3 (JPLAY)
46REAL_B :: COLN2O(JPLAY)
47REAL_B :: COLCH4(JPLAY)
48REAL_B :: COLO2 (JPLAY)
49REAL_B :: CO2MULT(JPLAY)
50INTEGER_M :: LAYTROP
51INTEGER_M :: LAYSWTCH
52INTEGER_M :: LAYLOW
53
54!- from SELF             
55REAL_B :: SELFFAC(JPLAY)
56REAL_B :: SELFFRAC(JPLAY)
57INTEGER_M :: INDSELF(JPLAY)
58
59!- from SP             
60REAL_B :: PFRAC(JPGPT,JPLAY)
61
62
63REAL_B :: TAU   (JPGPT,JPLAY)
64
65!     LOCAL INTEGER SCALARS
66INTEGER_M :: IPR, ITR, LAY
67
68!     LOCAL REAL SCALARS
69REAL_B :: ODEPTH, SECANG, TF
70
71
72!- SECANG is equal to the secant of the diffusivity angle.
73SECANG = 1.66_JPRB
74
75CALL RRTM_TAUMOL1  (KLEV,TAU,&
76  &TAUAERL,FAC00,FAC01,FAC10,FAC11,FORFAC,JP,JT,JT1,&
77  &COLH2O,LAYTROP,SELFFAC,SELFFRAC,INDSELF,PFRAC)
78CALL RRTM_TAUMOL2  (KLEV,TAU,COLDRY,&
79  &TAUAERL,FAC00,FAC01,FAC10,FAC11,FORFAC,JP,JT,JT1,&
80  &COLH2O,LAYTROP,SELFFAC,SELFFRAC,INDSELF,PFRAC)
81CALL RRTM_TAUMOL3  (KLEV,TAU,&
82  &TAUAERL,FAC00,FAC01,FAC10,FAC11,FORFAC,JP,JT,JT1,ONEMINUS,&
83  &COLH2O,COLCO2,COLN2O,LAYTROP,SELFFAC,SELFFRAC,INDSELF,PFRAC)
84CALL RRTM_TAUMOL4  (KLEV,TAU,&
85  &TAUAERL,FAC00,FAC01,FAC10,FAC11,FORFAC,JP,JT,JT1,ONEMINUS,&
86  &COLH2O,COLCO2,COLO3,LAYTROP,SELFFAC,SELFFRAC,INDSELF,PFRAC)
87CALL RRTM_TAUMOL5  (KLEV,TAU,WX,&
88  &TAUAERL,FAC00,FAC01,FAC10,FAC11,FORFAC,JP,JT,JT1,ONEMINUS,&
89  &COLH2O,COLCO2,COLO3,LAYTROP,SELFFAC,SELFFRAC,INDSELF,PFRAC)
90CALL RRTM_TAUMOL6  (KLEV,TAU,WX,&
91  &TAUAERL,FAC00,FAC01,FAC10,FAC11,JP,JT,JT1,&
92  &COLH2O,CO2MULT,LAYTROP,SELFFAC,SELFFRAC,INDSELF,PFRAC)
93CALL RRTM_TAUMOL7  (KLEV,TAU,&
94  &TAUAERL,FAC00,FAC01,FAC10,FAC11,JP,JT,JT1,ONEMINUS,&
95  &COLH2O,COLO3,CO2MULT,LAYTROP,SELFFAC,SELFFRAC,INDSELF,PFRAC)
96CALL RRTM_TAUMOL8  (KLEV,TAU,WX,&
97  &TAUAERL,FAC00,FAC01,FAC10,FAC11,JP,JT,JT1,&
98  &COLH2O,COLO3,COLN2O,CO2MULT,LAYSWTCH,SELFFAC,SELFFRAC,INDSELF,PFRAC)
99CALL RRTM_TAUMOL9  (KLEV,TAU,&
100  &TAUAERL,FAC00,FAC01,FAC10,FAC11,JP,JT,JT1,ONEMINUS,&
101  &COLH2O,COLN2O,COLCH4,LAYTROP,LAYSWTCH,LAYLOW,SELFFAC,SELFFRAC,INDSELF,PFRAC)
102CALL RRTM_TAUMOL10 (KLEV,TAU,&
103  &TAUAERL,FAC00,FAC01,FAC10,FAC11,JP,JT,JT1,&
104  &COLH2O,LAYTROP,PFRAC)
105CALL RRTM_TAUMOL11 (KLEV,TAU,&
106  &TAUAERL,FAC00,FAC01,FAC10,FAC11,JP,JT,JT1,&
107  &COLH2O,LAYTROP,SELFFAC,SELFFRAC,INDSELF,PFRAC)
108CALL RRTM_TAUMOL12 (KLEV,TAU,&
109  &TAUAERL,FAC00,FAC01,FAC10,FAC11,JP,JT,JT1,ONEMINUS,&
110  &COLH2O,COLCO2,LAYTROP,SELFFAC,SELFFRAC,INDSELF,PFRAC)
111CALL RRTM_TAUMOL13 (KLEV,TAU,&
112  &TAUAERL,FAC00,FAC01,FAC10,FAC11,JP,JT,JT1,ONEMINUS,&
113  &COLH2O,COLN2O,LAYTROP,SELFFAC,SELFFRAC,INDSELF,PFRAC)
114CALL RRTM_TAUMOL14 (KLEV,TAU,&
115  &TAUAERL,FAC00,FAC01,FAC10,FAC11,JP,JT,JT1,&
116  &COLCO2,LAYTROP,SELFFAC,SELFFRAC,INDSELF,PFRAC)
117CALL RRTM_TAUMOL15 (KLEV,TAU,&
118  &TAUAERL,FAC00,FAC01,FAC10,FAC11,JP,JT,JT1,ONEMINUS,&
119  &COLH2O,COLCO2,COLN2O,LAYTROP,SELFFAC,SELFFRAC,INDSELF,PFRAC)
120CALL RRTM_TAUMOL16 (KLEV,TAU,&
121  &TAUAERL,FAC00,FAC01,FAC10,FAC11,JP,JT,JT1,ONEMINUS,&
122  &COLH2O,COLCH4,LAYTROP,SELFFAC,SELFFRAC,INDSELF,PFRAC)
123
124!- Loop over g-channels.
125DO LAY = 1, KLEV
126  DO IPR = 1, JPGPT
127    ODEPTH = SECANG * TAU(IPR,LAY)
128    OD(IPR,LAY) = ODEPTH
129!-- revised code to get the pre-computed transmission           
130    TF = ODEPTH/(BPADE+ODEPTH)
131!          IF (ODEPTH.LE.0.) PRINT*, 'ODEPTH = ',ODEPTH
132    IF (ODEPTH <= _ZERO_) TF = _ZERO_
133    ITR=INT(5.E+03_JPRB*TF+_HALF_)
134    ATR1(IPR,LAY) = _ONE_ - TRANS(ITR)
135    TF1(IPR,LAY) = TF
136  ENDDO
137ENDDO
138
139!     -----------------------------------------------------------------
140
141RETURN
142END SUBROUTINE RRTM_GASABS1A_140GP
Note: See TracBrowser for help on using the repository browser.