source: LMDZ6/branches/IPSLCM6.0.14/libf/phymar/rrtm_taumol16.F90 @ 3118

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

Inclusion de la physique de MAR


Integration of MAR physics

File size: 4.6 KB
Line 
1!----------------------------------------------------------------------------
2SUBROUTINE RRTM_TAUMOL16 (KLEV,TAU,&
3  &TAUAERL,FAC00,FAC01,FAC10,FAC11,JP,JT,JT1,ONEMINUS,&
4  &COLH2O,COLCH4,LAYTROP,SELFFAC,SELFFRAC,INDSELF,PFRAC)
5
6!     BAND 16:  2600-3000 cm-1 (low - H2O,CH4; high - nothing)
7
8! Modifications
9!
10!     D Salmond 1999-07-14 speed-up
11
12
13#include "tsmbkind.h"
14
15USE PARRRTM  , ONLY : JPLAY  ,JPBAND ,JPGPT   ,JPXSEC ,NGS15
16USE YOERRTWN , ONLY : NG     ,NSPA   ,NSPB
17USE YOERRTA16, ONLY : NG16   ,ABSA   ,FRACREFA,KA     ,SELFREF,STRRAT
18
19
20IMPLICIT NONE
21
22!  Output
23REAL_B :: TAU   (JPGPT,JPLAY)
24
25!     DUMMY INTEGER SCALARS
26INTEGER_M :: KLEV
27
28!- from AER
29REAL_B :: TAUAERL(JPLAY,JPBAND)
30
31!- from INTFAC     
32REAL_B :: FAC00(JPLAY)
33REAL_B :: FAC01(JPLAY)
34REAL_B :: FAC10(JPLAY)
35REAL_B :: FAC11(JPLAY)
36
37!- from INTIND
38INTEGER_M :: JP(JPLAY)
39INTEGER_M :: JT(JPLAY)
40INTEGER_M :: JT1(JPLAY)
41
42!- from PRECISE             
43REAL_B :: ONEMINUS
44
45!- from PROFDATA             
46REAL_B :: COLH2O(JPLAY)
47REAL_B :: COLCH4(JPLAY)
48INTEGER_M :: LAYTROP
49
50!- from SELF             
51REAL_B :: SELFFAC(JPLAY)
52REAL_B :: SELFFRAC(JPLAY)
53INTEGER_M :: INDSELF(JPLAY)
54
55!- from SP             
56REAL_B :: PFRAC(JPGPT,JPLAY)
57
58
59!     LOCAL INTEGER SCALARS
60INTEGER_M :: IG, IND0, IND1, INDS, JS, LAY
61
62!     LOCAL REAL SCALARS
63REAL_B :: FAC000, FAC001, FAC010, FAC011, FAC100, FAC101,&
64          &FAC110, FAC111, FS, SPECCOMB, SPECMULT, SPECPARM
65
66
67!  Input
68!#include "yoeratm.h"
69
70!      REAL TAUAER(JPLAY)
71!      EQUIVALENCE (TAUAERL(1,16),TAUAER)
72
73!     Compute the optical depth by interpolating in ln(pressure),
74!     temperature, and appropriate species.  Below LAYTROP, the water
75!     vapor self-continuum is interpolated (in temperature) separately.
76 
77DO LAY = 1, LAYTROP
78  SPECCOMB = COLH2O(LAY) + STRRAT*COLCH4(LAY)
79  SPECPARM = COLH2O(LAY)/SPECCOMB
80  SPECPARM = MIN(SPECPARM,ONEMINUS)
81  SPECMULT = 8._JPRB*(SPECPARM)
82  JS = 1 + INT(SPECMULT)
83  FS = MOD(SPECMULT,_ONE_)
84!----jjm         
85  FAC000 = (_ONE_ - FS) * FAC00(LAY)
86  FAC010 = (_ONE_ - FS) * FAC10(LAY)
87  FAC100 = FS * FAC00(LAY)
88  FAC110 = FS * FAC10(LAY)
89  FAC001 = (_ONE_ - FS) * FAC01(LAY)
90  FAC011 = (_ONE_ - FS) * FAC11(LAY)
91  FAC101 = FS * FAC01(LAY)
92  FAC111 = FS * FAC11(LAY)
93!-----         
94  IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(16) + JS
95  IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(16) + JS
96  INDS = INDSELF(LAY)
97!         DO IG = 1, NG16
98!-- DS_990714
99  IG=1
100  TAU (NGS15+IG,LAY) = SPECCOMB *&
101!     &((1. - FS)*(FAC00(LAY) * ABSA(IND0   ,IG) +
102!     &            FAC10(LAY) * ABSA(IND0+ 9,IG) +
103!     &            FAC01(LAY) * ABSA(IND1   ,IG) +
104!     &            FAC11(LAY) * ABSA(IND1+ 9,IG))+
105!     &    FS * (  FAC01(LAY) * ABSA(IND1+ 1,IG) +
106!     &            FAC10(LAY) * ABSA(IND0+10,IG) +
107!     &            FAC00(LAY) * ABSA(IND0+ 1,IG) +
108!     &            FAC11(LAY) * ABSA(IND1+10,IG))) +
109   &(FAC000 * ABSA(IND0   ,IG) +&
110   & FAC100 * ABSA(IND0+ 1,IG) +&
111   & FAC010 * ABSA(IND0+ 9,IG) +&
112   & FAC110 * ABSA(IND0+10,IG) +&
113   & FAC001 * ABSA(IND1   ,IG) +&
114   & FAC101 * ABSA(IND1+ 1,IG) +&
115   & FAC011 * ABSA(IND1+ 9,IG) +&
116   & FAC111 * ABSA(IND1+10,IG))+&
117   &COLH2O(LAY) * &
118   &SELFFAC(LAY) * (SELFREF(INDS,IG) + &
119   &SELFFRAC(LAY) *&
120   &(SELFREF(INDS+1,IG) - SELFREF(INDS,IG)))&
121   &+ TAUAERL(LAY,16)
122  PFRAC(NGS15+IG,LAY) = FRACREFA(IG,JS) + FS *&
123   &(FRACREFA(IG,JS+1) - FRACREFA(IG,JS))
124  IG=2
125  TAU (NGS15+IG,LAY) = SPECCOMB *&
126!     &((1. - FS)*(FAC00(LAY) * ABSA(IND0   ,IG) +
127!     &            FAC10(LAY) * ABSA(IND0+ 9,IG) +
128!     &            FAC01(LAY) * ABSA(IND1   ,IG) +
129!     &            FAC11(LAY) * ABSA(IND1+ 9,IG))+
130!     &    FS * (  FAC01(LAY) * ABSA(IND1+ 1,IG) +
131!     &            FAC10(LAY) * ABSA(IND0+10,IG) +
132!     &            FAC00(LAY) * ABSA(IND0+ 1,IG) +
133!     &            FAC11(LAY) * ABSA(IND1+10,IG))) +
134   &(FAC000 * ABSA(IND0   ,IG) +&
135   & FAC100 * ABSA(IND0+ 1,IG) +&
136   & FAC010 * ABSA(IND0+ 9,IG) +&
137   & FAC110 * ABSA(IND0+10,IG) +&
138   & FAC001 * ABSA(IND1   ,IG) +&
139   & FAC101 * ABSA(IND1+ 1,IG) +&
140   & FAC011 * ABSA(IND1+ 9,IG) +&
141   & FAC111 * ABSA(IND1+10,IG))+&
142   &COLH2O(LAY) *&
143   &SELFFAC(LAY) * (SELFREF(INDS,IG) +&
144   &SELFFRAC(LAY) *&
145   &(SELFREF(INDS+1,IG) - SELFREF(INDS,IG)))&
146   &+ TAUAERL(LAY,16)
147  PFRAC(NGS15+IG,LAY) = FRACREFA(IG,JS) + FS *&
148   &(FRACREFA(IG,JS+1) - FRACREFA(IG,JS))
149
150!         END DO
151!-- DS_990714
152ENDDO
153
154DO LAY = LAYTROP+1, KLEV
155!         DO IG = 1, NG16
156!-- DS_990714
157  IG=1
158  TAU (NGS15+IG,LAY) = TAUAERL(LAY,16)
159  PFRAC(NGS15+IG,LAY) = _ZERO_
160  IG=2
161  TAU (NGS15+IG,LAY) = TAUAERL(LAY,16)
162  PFRAC(NGS15+IG,LAY) = _ZERO_
163!-- DS_990714
164!         END DO
165ENDDO
166
167RETURN
168END SUBROUTINE RRTM_TAUMOL16
Note: See TracBrowser for help on using the repository browser.