source: LMDZ6/branches/DYNAMICO-conv-GC/libf/phymar/rrtm_taumol8.F90 @ 3405

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

Inclusion de la physique de MAR


Integration of MAR physics

File size: 3.8 KB
Line 
1!*******************************************************************************
2SUBROUTINE RRTM_TAUMOL8 (KLEV,TAU,WX,&
3  &TAUAERL,FAC00,FAC01,FAC10,FAC11,JP,JT,JT1,&
4  &COLH2O,COLO3,COLN2O,CO2MULT,LAYSWTCH,SELFFAC,SELFFRAC,INDSELF,PFRAC)
5
6!     BAND 8:  1080-1180 cm-1 (low (i.e.>~300mb) - H2O; high - O3)
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  , NGS7
17USE YOERRTWN , ONLY : NG     ,NSPA   ,NSPB
18USE YOERRTA8 , ONLY : NG8    ,ABSA   ,ABSB   ,FRACREFA, FRACREFB,&
19            &KA      , KB     ,SELFREF,ABSCO2A , ABSCO2B ,&
20            &ABSN2OA , ABSN2OB,CFC12  ,CFC22ADJ, H2OREF  ,&
21            &N2OREF  , O3REF
22
23!  Input
24!#include "yoeratm.h"
25
26
27IMPLICIT NONE
28
29REAL_B :: WX(JPXSEC,JPLAY)             ! Amount of trace gases
30!  Output
31REAL_B :: TAU   (JPGPT,JPLAY)
32
33!     DUMMY INTEGER SCALARS
34INTEGER_M :: KLEV
35
36!- from AER
37REAL_B :: TAUAERL(JPLAY,JPBAND)
38
39!- from INTFAC     
40REAL_B :: FAC00(JPLAY)
41REAL_B :: FAC01(JPLAY)
42REAL_B :: FAC10(JPLAY)
43REAL_B :: FAC11(JPLAY)
44
45!- from INTIND
46INTEGER_M :: JP(JPLAY)
47INTEGER_M :: JT(JPLAY)
48INTEGER_M :: JT1(JPLAY)
49
50!- from PROFDATA             
51REAL_B :: COLH2O(JPLAY)
52REAL_B :: COLO3 (JPLAY)
53REAL_B :: COLN2O(JPLAY)
54REAL_B :: CO2MULT(JPLAY)
55INTEGER_M :: LAYSWTCH
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 :: IND0(JPLAY),IND1(JPLAY),INDS(JPLAY)
66
67!      REAL TAUAER(JPLAY)
68REAL_B :: N2OMULT(JPLAY)
69
70!     LOCAL INTEGER SCALARS
71INTEGER_M :: IG, LAY
72
73!     LOCAL REAL SCALARS
74REAL_B :: COLREF1, COLREF2, CURRN2O, FP, RATIO, WCOMB1, WCOMB2
75
76!      EQUIVALENCE (TAUAERL(1,8),TAUAER)
77
78!     Compute the optical depth by interpolating in ln(pressure) and
79!     temperature. 
80
81DO LAY = 1, LAYSWTCH
82  FP = FAC01(LAY) + FAC11(LAY)
83  IND0(LAY) = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(8) + 1
84  IND1(LAY) = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(8) + 1
85  INDS(LAY) = INDSELF(LAY)
86  COLREF1 = N2OREF(JP(LAY))
87  COLREF2 = N2OREF(JP(LAY)+1)
88  WCOMB1 = _ONE_/H2OREF(JP(LAY))
89  WCOMB2 = _ONE_/H2OREF(JP(LAY)+1)
90  RATIO = (COLREF1*WCOMB1)+FP*((COLREF2*WCOMB2)-(COLREF1*WCOMB1))
91  CURRN2O = COLH2O(LAY) * RATIO
92  N2OMULT(LAY) = COLN2O(LAY) - CURRN2O
93ENDDO
94
95!-- DS_000515
96DO IG = 1, NG8
97  DO LAY = 1, LAYSWTCH
98!-- DS_000515
99    TAU (NGS7+IG,LAY) = COLH2O(LAY) *&
100     &(FAC00(LAY) * ABSA(IND0(LAY)  ,IG) +&
101     & FAC10(LAY) * ABSA(IND0(LAY)+1,IG) +&
102     & FAC01(LAY) * ABSA(IND1(LAY)  ,IG) +&
103     & FAC11(LAY) * ABSA(IND1(LAY)+1,IG) +&
104     &SELFFAC(LAY) * (SELFREF(INDS(LAY),IG) + &
105     &SELFFRAC(LAY) *&
106     &(SELFREF(INDS(LAY)+1,IG) - SELFREF(INDS(LAY),IG))))&
107     &+ WX(3,LAY) * CFC12(IG)&
108     &+ WX(4,LAY) * CFC22ADJ(IG)&
109     &+ CO2MULT(LAY) * ABSCO2A(IG)&
110     &+ N2OMULT(LAY) * ABSN2OA(IG)&
111     &+ TAUAERL(LAY,8)
112    PFRAC(NGS7+IG,LAY) = FRACREFA(IG)
113  ENDDO
114ENDDO
115
116DO LAY = LAYSWTCH+1, KLEV
117  FP = FAC01(LAY) + FAC11(LAY)
118  IND0(LAY) = ((JP(LAY)-7)*5+(JT(LAY)-1))*NSPB(8) + 1
119  IND1(LAY) = ((JP(LAY)-6)*5+(JT1(LAY)-1))*NSPB(8) + 1
120  COLREF1 = N2OREF(JP(LAY))
121  COLREF2 = N2OREF(JP(LAY)+1)
122  WCOMB1 = _ONE_/O3REF(JP(LAY))
123  WCOMB2 = _ONE_/O3REF(JP(LAY)+1)
124  RATIO = (COLREF1*WCOMB1)+FP*((COLREF2*WCOMB2)-(COLREF1*WCOMB1))
125  CURRN2O = COLO3(LAY) * RATIO
126  N2OMULT(LAY) = COLN2O(LAY) - CURRN2O
127ENDDO
128
129!-- JJM_000517
130DO IG = 1, NG8
131  DO LAY = LAYSWTCH+1, KLEV
132!-- JJM_000517
133    TAU (NGS7+IG,LAY) = COLO3(LAY) *&
134     &(FAC00(LAY) * ABSB(IND0(LAY)  ,IG) +&
135     & FAC10(LAY) * ABSB(IND0(LAY)+1,IG) +&
136     & FAC01(LAY) * ABSB(IND1(LAY)  ,IG) +&
137     & FAC11(LAY) * ABSB(IND1(LAY)+1,IG)) &
138     &+ WX(3,LAY) * CFC12(IG)&
139     &+ WX(4,LAY) * CFC22ADJ(IG)&
140     &+ CO2MULT(LAY) * ABSCO2B(IG)&
141     &+ N2OMULT(LAY) * ABSN2OB(IG)&
142     &+ TAUAERL(LAY,8)
143    PFRAC(NGS7+IG,LAY) = FRACREFB(IG)
144  ENDDO
145ENDDO
146
147RETURN
148END SUBROUTINE RRTM_TAUMOL8
Note: See TracBrowser for help on using the repository browser.