source: LMDZ5/branches/IPSLCM5A2.1/libf/phymar/rrtm_taumol11.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: 2.7 KB
Line 
1!******************************************************************************
2SUBROUTINE RRTM_TAUMOL11 (KLEV,TAU,&
3  &TAUAERL,FAC00,FAC01,FAC10,FAC11,JP,JT,JT1,&
4  &COLH2O,LAYTROP,SELFFAC,SELFFRAC,INDSELF,PFRAC)
5
6!     BAND 11:  1480-1800 cm-1 (low - H2O; high - H2O)
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  , NGS10
17USE YOERRTWN , ONLY : NG     ,NSPA   ,NSPB
18USE YOERRTA11, ONLY : NG11   ,ABSA   ,ABSB   ,FRACREFA, FRACREFB,&
19            &KA      , KB     ,SELFREF
20
21!  Input
22!#include "yoeratm.h"
23
24!      REAL TAUAER(JPLAY)
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 PROFDATA             
49REAL_B :: COLH2O(JPLAY)
50INTEGER_M :: LAYTROP
51
52!- from SELF             
53REAL_B :: SELFFAC(JPLAY)
54REAL_B :: SELFFRAC(JPLAY)
55INTEGER_M :: INDSELF(JPLAY)
56
57!- from SP             
58REAL_B :: PFRAC(JPGPT,JPLAY)
59
60INTEGER_M :: IND0(JPLAY),IND1(JPLAY),INDS(JPLAY)
61
62!     LOCAL INTEGER SCALARS
63INTEGER_M :: IG, LAY
64
65!      EQUIVALENCE (TAUAERL(1,11),TAUAER)
66
67!     Compute the optical depth by interpolating in ln(pressure) and
68!     temperature.  Below LAYTROP, the water vapor self-continuum
69!     is interpolated (in temperature) separately.
70 
71DO LAY = 1, LAYTROP
72  IND0(LAY) = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(11) + 1
73  IND1(LAY) = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(11) + 1
74  INDS(LAY) = INDSELF(LAY)
75ENDDO
76
77!-- DS_000515 
78DO IG = 1, NG11
79  DO LAY = 1, LAYTROP
80!-- DS_000515 
81    TAU (NGS10+IG,LAY) = COLH2O(LAY) *&
82     &(FAC00(LAY) * ABSA(IND0(LAY)  ,IG) +&
83     & FAC10(LAY) * ABSA(IND0(LAY)+1,IG) +&
84     & FAC01(LAY) * ABSA(IND1(LAY)  ,IG) +&
85     & FAC11(LAY) * ABSA(IND1(LAY)+1,IG) +&
86     &SELFFAC(LAY) * (SELFREF(INDS(LAY),IG) + &
87     &SELFFRAC(LAY) *&
88     &(SELFREF(INDS(LAY)+1,IG) - SELFREF(INDS(LAY),IG))))&
89     &+ TAUAERL(LAY,11)
90    PFRAC(NGS10+IG,LAY) = FRACREFA(IG)
91  ENDDO
92ENDDO
93
94DO LAY = LAYTROP+1, KLEV
95  IND0(LAY) = ((JP(LAY)-13)*5+(JT(LAY)-1))*NSPB(11) + 1
96  IND1(LAY) = ((JP(LAY)-12)*5+(JT1(LAY)-1))*NSPB(11) + 1
97ENDDO
98
99!-- JJM_000517
100DO IG = 1, NG11
101  DO LAY = LAYTROP+1, KLEV
102!-- JJM_000517
103    TAU (NGS10+IG,LAY) = COLH2O(LAY) *&
104     &(FAC00(LAY) * ABSB(IND0(LAY)  ,IG) +&
105     & FAC10(LAY) * ABSB(IND0(LAY)+1,IG) +&
106     & FAC01(LAY) * ABSB(IND1(LAY)  ,IG) +&
107     & FAC11(LAY) * ABSB(IND1(LAY)+1,IG)) &
108     &+ TAUAERL(LAY,11)
109    PFRAC(NGS10+IG,LAY) = FRACREFB(IG)
110  ENDDO
111ENDDO
112
113RETURN
114END SUBROUTINE RRTM_TAUMOL11
Note: See TracBrowser for help on using the repository browser.