source: dynamico_lmdz/aquaplanet/LMDZ5/libf/phymar/rrtm_taumol14.F90 @ 4031

Last change on this file since 4031 was 3990, checked in by millour, 8 years ago

An updated LMDZ5 (based on LMDZ rev 2786) to play with.
EM
File size: 3.1 KB
Line 
1!******************************************************************************
2SUBROUTINE RRTM_TAUMOL14 (KLEV,TAU,&
3  &TAUAERL,FAC00,FAC01,FAC10,FAC11,JP,JT,JT1,&
4  &COLCO2,LAYTROP,SELFFAC,SELFFRAC,INDSELF,PFRAC)
5
6!     BAND 14:  2250-2380 cm-1 (low - CO2; high - CO2)
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  , NGS13
16USE YOERRTWN , ONLY : NG     ,NSPA   ,NSPB
17USE YOERRTA14, ONLY : NG14   ,ABSA   ,ABSB   ,FRACREFA, FRACREFB,&
18              &KA    , KB    ,SELFREF
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 PROFDATA             
43REAL_B :: COLCO2(JPLAY)
44INTEGER_M :: LAYTROP
45
46!- from SELF             
47REAL_B :: SELFFAC(JPLAY)
48REAL_B :: SELFFRAC(JPLAY)
49INTEGER_M :: INDSELF(JPLAY)
50
51!- from SP             
52REAL_B :: PFRAC(JPGPT,JPLAY)
53
54
55!     LOCAL INTEGER SCALARS
56INTEGER_M :: IG, IND0, IND1, INDS, LAY
57
58
59!  Input
60!#include "yoeratm.h"
61
62!      REAL TAUAER(JPLAY)
63!      EQUIVALENCE (TAUAERL(1,14),TAUAER)
64
65!     Compute the optical depth by interpolating in ln(pressure) and
66!     temperature.  Below LAYTROP, the water vapor self-continuum
67!     is interpolated (in temperature) separately. 
68
69DO LAY = 1, LAYTROP
70  IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(14) + 1
71  IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(14) + 1
72  INDS = INDSELF(LAY)
73!-- DS_990714 
74!         DO IG = 1, NG14
75  IG=1
76  TAU (NGS13+IG,LAY) = COLCO2(LAY) *&
77   &(FAC00(LAY) * ABSA(IND0  ,IG) +&
78   & FAC10(LAY) * ABSA(IND0+1,IG) +&
79   & FAC01(LAY) * ABSA(IND1  ,IG) +&
80   & FAC11(LAY) * ABSA(IND1+1,IG) +&
81   &SELFFAC(LAY) * (SELFREF(INDS,IG) + &
82   &SELFFRAC(LAY) *&
83   &(SELFREF(INDS+1,IG) - SELFREF(INDS,IG))))&
84   &+ TAUAERL(LAY,14)
85  PFRAC(NGS13+IG,LAY) = FRACREFA(IG)
86  IG=2
87  TAU (NGS13+IG,LAY) = COLCO2(LAY) *&
88   &(FAC00(LAY) * ABSA(IND0  ,IG) +&
89   & FAC10(LAY) * ABSA(IND0+1,IG) +&
90   & FAC01(LAY) * ABSA(IND1  ,IG) +&
91   & FAC11(LAY) * ABSA(IND1+1,IG) +&
92   &SELFFAC(LAY) * (SELFREF(INDS,IG) +&
93   &SELFFRAC(LAY) *&
94   &(SELFREF(INDS+1,IG) - SELFREF(INDS,IG))))&
95   &+ TAUAERL(LAY,14)
96  PFRAC(NGS13+IG,LAY) = FRACREFA(IG)
97!         END DO
98!-- DS_990714 
99ENDDO
100
101DO LAY = LAYTROP+1, KLEV
102  IND0 = ((JP(LAY)-13)*5+(JT(LAY)-1))*NSPB(14) + 1
103  IND1 = ((JP(LAY)-12)*5+(JT1(LAY)-1))*NSPB(14) + 1
104!-- DS_990714 
105!         DO IG = 1, NG14
106  IG=1
107  TAU (NGS13+IG,LAY) = COLCO2(LAY) *&
108   &(FAC00(LAY) * ABSB(IND0  ,IG) +&
109   & FAC10(LAY) * ABSB(IND0+1,IG) +&
110   & FAC01(LAY) * ABSB(IND1  ,IG) +&
111   & FAC11(LAY) * ABSB(IND1+1,IG)) &
112   &+ TAUAERL(LAY,14)
113  PFRAC(NGS13+IG,LAY) = FRACREFB(IG)
114  IG=2
115  TAU (NGS13+IG,LAY) = COLCO2(LAY) *&
116   &(FAC00(LAY) * ABSB(IND0  ,IG) +&
117   & FAC10(LAY) * ABSB(IND0+1,IG) +&
118   & FAC01(LAY) * ABSB(IND1  ,IG) +&
119   & FAC11(LAY) * ABSB(IND1+1,IG)) &
120   &+ TAUAERL(LAY,14)
121  PFRAC(NGS13+IG,LAY) = FRACREFB(IG)
122!         END DO
123!-- DS_990714 
124ENDDO
125
126RETURN
127END SUBROUTINE RRTM_TAUMOL14
Note: See TracBrowser for help on using the repository browser.