source: LMDZ5/trunk/libf/phymar/rrtm_taumol12.F90 @ 5371

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

Inclusion de la physique de MAR


Integration of MAR physics

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