source: LMDZ6/branches/SETHET_DECOUPLE/libf/phymar/rrtm_taumol7.F90 @ 5412

Last change on this file since 5412 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 
1!----------------------------------------------------------------------------
2SUBROUTINE RRTM_TAUMOL7 (KLEV,TAU,&
3  &TAUAERL,FAC00,FAC01,FAC10,FAC11,JP,JT,JT1,ONEMINUS,&
4  &COLH2O,COLO3,CO2MULT,LAYTROP,SELFFAC,SELFFRAC,INDSELF,PFRAC)
5
6!     BAND 7:  980-1080 cm-1 (low - H2O,O3; high - O3)
7
8! Modifications
9!
10!     D Salmond 2000-05-15 speed-up
11
12
13#include "tsmbkind.h"
14
15USE PARRRTM  , ONLY : JPLAY  ,JPBAND ,JPGPT  ,JPXSEC ,NGS6
16USE YOERRTWN , ONLY : NG     ,NSPA   ,NSPB
17USE YOERRTA7 , ONLY : NG7    ,ABSA   ,ABSB   ,ABSCO2 ,FRACREFA ,FRACREFB,&
18            &KA       ,KB     ,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 :: COLO3 (JPLAY)
54REAL_B :: CO2MULT(JPLAY)
55INTEGER_M :: LAYTROP
56
57!- from SELF             
58REAL_B :: SELFFAC(JPLAY)
59REAL_B :: SELFFRAC(JPLAY)
60INTEGER_M :: INDSELF(JPLAY)
61
62!- from SP             
63REAL_B :: PFRAC(JPGPT,JPLAY)
64
65INTEGER_M :: IJS(JPLAY)
66REAL_B :: ZFS(JPLAY),SPECCOMB(JPLAY)
67INTEGER_M :: IND0(JPLAY),IND1(JPLAY),INDS(JPLAY)
68
69!     LOCAL INTEGER SCALARS
70INTEGER_M :: IG, JS, LAY
71
72!     LOCAL REAL SCALARS
73REAL_B :: FAC000, FAC001, FAC010, FAC011, FAC100, FAC101,&
74          &FAC110, FAC111, FS, SPECMULT, SPECPARM
75
76
77!      EQUIVALENCE (TAUAERL(1,7),TAUAER)
78
79!     Compute the optical depth by interpolating in ln(pressure),
80!     temperature, and appropriate species.  Below LAYTROP, the water
81!     vapor self-continuum is interpolated (in temperature) separately.
82 
83DO LAY = 1, LAYTROP
84  SPECCOMB(LAY) = COLH2O(LAY) + STRRAT*COLO3(LAY)
85  SPECPARM = COLH2O(LAY)/SPECCOMB(LAY)
86  SPECPARM=MIN(ONEMINUS,SPECPARM)
87  SPECMULT = 8._JPRB*SPECPARM
88  JS = 1 + INT(SPECMULT)
89  FS = MOD(SPECMULT,_ONE_)
90  IND0(LAY) = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(7) + JS
91  IND1(LAY) = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(7) + JS
92  INDS(LAY) = INDSELF(LAY)
93  ZFS(LAY)=FS
94  IJS(LAY)=JS
95
96ENDDO
97
98!-- DS_000515
99DO IG = 1, NG7
100  DO LAY = 1, LAYTROP
101!-- DS_000515
102
103    FS=ZFS(LAY)
104    JS=IJS(LAY)
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
116    TAU (NGS6+IG,LAY) = SPECCOMB(LAY) *&
117!-- DS_000515
118!     &(FAC000 * ABSA(IND0(LAY)   ,IG) +&
119!     & FAC100 * ABSA(IND0(LAY)+ 1,IG) +&
120!     & FAC010 * ABSA(IND0(LAY)+ 9,IG) +&
121!     & FAC110 * ABSA(IND0(LAY)+10,IG) +&
122!     & FAC001 * ABSA(IND1(LAY)   ,IG) +&
123!     & FAC101 * ABSA(IND1(LAY)+ 1,IG) +&
124!     & FAC011 * ABSA(IND1(LAY)+ 9,IG) +&
125!     & FAC111 * ABSA(IND1(LAY)+10,IG))+&
126     &( (1. - FS) *(FAC00(LAY) * ABSA(IND0(LAY)   ,IG) +   &
127     &              FAC10(LAY) * ABSA(IND0(LAY)+ 9,IG) +   &
128     &              FAC01(LAY) * ABSA(IND1(LAY)   ,IG) +   &
129     &              FAC11(LAY) * ABSA(IND1(LAY)+ 9,IG))+   &
130     &     FS     *(FAC00(LAY) * ABSA(IND0(LAY)+ 1,IG) +   &
131     &              FAC10(LAY) * ABSA(IND0(LAY)+10,IG) +   &
132     &              FAC01(LAY) * ABSA(IND1(LAY)+ 1,IG) +   &
133     &              FAC11(LAY) * ABSA(IND1(LAY)+10,IG))) + &
134!-- DS_000515
135     &COLH2O(LAY) * &
136     &SELFFAC(LAY) * (SELFREF(INDS(LAY),IG) + &
137     &SELFFRAC(LAY) *&
138     &(SELFREF(INDS(LAY)+1,IG) - SELFREF(INDS(LAY),IG)))&
139     &+ CO2MULT(LAY) * ABSCO2(IG)&
140     &+ TAUAERL(LAY,7)
141    PFRAC(NGS6+IG,LAY) = FRACREFA(IG,JS) + FS *&
142     &(FRACREFA(IG,JS+1) - FRACREFA(IG,JS))
143  ENDDO
144ENDDO
145
146DO LAY = LAYTROP+1, KLEV
147  IND0(LAY) = ((JP(LAY)-13)*5+(JT(LAY)-1))*NSPB(7) + 1
148  IND1(LAY) = ((JP(LAY)-12)*5+(JT1(LAY)-1))*NSPB(7) + 1
149ENDDO
150
151!-- JJM_000517
152DO IG = 1, NG7
153  DO LAY = LAYTROP+1, KLEV
154!-- JJM_000517
155    TAU (NGS6+IG,LAY) = COLO3(LAY) *&
156     &(FAC00(LAY) * ABSB(IND0(LAY)  ,IG) +&
157     & FAC10(LAY) * ABSB(IND0(LAY)+1,IG) +&
158     & FAC01(LAY) * ABSB(IND1(LAY)  ,IG) +&
159     & FAC11(LAY) * ABSB(IND1(LAY)+1,IG))&
160     &+ CO2MULT(LAY) * ABSCO2(IG)&
161     &+ TAUAERL(LAY,7)
162    PFRAC(NGS6+IG,LAY) = FRACREFB(IG)
163  ENDDO
164ENDDO
165
166RETURN
167END SUBROUTINE RRTM_TAUMOL7
Note: See TracBrowser for help on using the repository browser.