source: LMDZ5/branches/LMDZ6_rc0/libf/phymar/rrtm_taumol6.F90 @ 5405

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

Merged trunk changes -r2070:2158 into testing branch. Compilation problems introduced by revision r2155 have been corrected by hand

File size: 2.7 KB
Line 
1!----------------------------------------------------------------------------
2SUBROUTINE RRTM_TAUMOL6 (KLEV,TAU,WX,&
3  &TAUAERL,FAC00,FAC01,FAC10,FAC11,JP,JT,JT1,&
4  &COLH2O,CO2MULT,LAYTROP,SELFFAC,SELFFRAC,INDSELF,PFRAC)
5
6!     BAND 6:  820-980 cm-1 (low - H2O; 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   , NGS5
17USE YOERRTWN , ONLY : NG     ,NSPA   ,NSPB
18USE YOERRTA6 , ONLY : NG6    ,ABSA   ,ABSCO2 ,CFC11ADJ , CFC12 ,&
19            &FRACREFA, KA     ,SELFREF
20
21!  Input
22!#include "yoeratm.h"
23
24!      REAL TAUAER(JPLAY)
25
26IMPLICIT NONE
27
28REAL_B :: WX(JPXSEC,JPLAY)              ! Amount of trace gases
29!  Output
30REAL_B :: TAU   (JPGPT,JPLAY)
31
32!     DUMMY INTEGER SCALARS
33INTEGER_M :: KLEV
34
35!- from AER
36REAL_B :: TAUAERL(JPLAY,JPBAND)
37
38!- from INTFAC     
39REAL_B :: FAC00(JPLAY)
40REAL_B :: FAC01(JPLAY)
41REAL_B :: FAC10(JPLAY)
42REAL_B :: FAC11(JPLAY)
43
44!- from INTIND
45INTEGER_M :: JP(JPLAY)
46INTEGER_M :: JT(JPLAY)
47INTEGER_M :: JT1(JPLAY)
48
49!- from PROFDATA             
50REAL_B :: COLH2O(JPLAY)
51REAL_B :: CO2MULT(JPLAY)
52INTEGER_M :: LAYTROP
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
62INTEGER_M :: IND0(JPLAY),IND1(JPLAY),INDS(JPLAY)
63
64!     LOCAL INTEGER SCALARS
65INTEGER_M :: IG, LAY
66
67!      EQUIVALENCE (TAUAERL(1,6),TAUAER)
68
69!     Compute the optical depth by interpolating in ln(pressure) and
70!     temperature. The water vapor self-continuum is interpolated
71!     (in temperature) separately. 
72
73DO LAY = 1, LAYTROP
74  IND0(LAY) = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(6) + 1
75  IND1(LAY) = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(6) + 1
76  INDS(LAY) = INDSELF(LAY)
77ENDDO
78
79!-- DS_000515 
80DO IG = 1, NG6
81  DO LAY = 1, LAYTROP
82!-- DS_000515 
83    TAU (NGS5+IG,LAY) = COLH2O(LAY) *&
84     &(FAC00(LAY) * ABSA(IND0(LAY)  ,IG) +&
85     & FAC10(LAY) * ABSA(IND0(LAY)+1,IG) +&
86     & FAC01(LAY) * ABSA(IND1(LAY)  ,IG) +&
87     & FAC11(LAY) * ABSA(IND1(LAY)+1,IG) +&
88     &SELFFAC(LAY) * (SELFREF(INDS(LAY),IG) + &
89     &SELFFRAC(LAY)*&
90     &(SELFREF(INDS(LAY)+1,IG)-SELFREF(INDS(LAY),IG))))&
91     &+ WX(2,LAY) * CFC11ADJ(IG)&
92     &+ WX(3,LAY) * CFC12(IG)&
93     &+ CO2MULT(LAY) * ABSCO2(IG)&
94     &+ TAUAERL(LAY,6)
95    PFRAC(NGS5+IG,LAY) = FRACREFA(IG)
96  ENDDO
97ENDDO
98
99!     Nothing important goes on above LAYTROP in this band.
100!-- JJM_000517
101DO IG = 1, NG6
102  DO LAY = LAYTROP+1, KLEV
103!-- JJM_000517
104    TAU (NGS5+IG,LAY) = _ZERO_ &
105     &+ WX(2,LAY) * CFC11ADJ(IG)&
106     &+ WX(3,LAY) * CFC12(IG)&
107     &+ TAUAERL(LAY,6)
108    PFRAC(NGS5+IG,LAY) = FRACREFA(IG)
109  ENDDO
110ENDDO
111
112RETURN
113END SUBROUTINE RRTM_TAUMOL6
Note: See TracBrowser for help on using the repository browser.