source: LMDZ6/branches/blowing_snow/libf/phylmd/rrtm/rrtm_taumol16.F90

Last change on this file was 1990, checked in by Laurent Fairhead, 11 years ago

Corrections à la version r1989 pour permettre la compilation avec RRTM
Inclusion de la licence CeCILL_V2 pour RRTM


Changes to revision r1989 to enable RRTM code compilation
RRTM part put under CeCILL_V2 licence

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 5.6 KB
Line 
1!----------------------------------------------------------------------------
2SUBROUTINE RRTM_TAUMOL16 (KLEV,P_TAU,&
3 & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,K_JP,K_JT,K_JT1,P_ONEMINUS,&
4 & P_COLH2O,P_COLCH4,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC) 
5
6!     BAND 16:  2600-3000 cm-1 (low - H2O,CH4; high - nothing)
7
8! Modifications
9!        M.Hamrud      01-Oct-2003 CY28 Cleaning
10
11!     D Salmond 1999-07-14 speed-up
12
13USE PARKIND1  ,ONLY : JPIM     ,JPRB
14USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
15
16USE PARRRTM  , ONLY : JPLAY  ,JPBAND ,JPGPT  ,NGS15
17USE YOERRTWN , ONLY :      NSPA   
18USE YOERRTA16, ONLY : ABSA   ,FRACREFA,SELFREF,STRRAT
19
20IMPLICIT NONE
21
22!  Output
23INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
24REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAU(JPGPT,JPLAY)
25REAL(KIND=JPRB)   ,INTENT(IN)    :: P_TAUAERL(JPLAY,JPBAND)
26REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC00(JPLAY)
27REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC01(JPLAY)
28REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC10(JPLAY)
29REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC11(JPLAY)
30INTEGER(KIND=JPIM),INTENT(IN)    :: K_JP(JPLAY)
31INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT(JPLAY)
32INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT1(JPLAY)
33REAL(KIND=JPRB)   ,INTENT(IN)    :: P_ONEMINUS
34REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLH2O(JPLAY)
35REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLCH4(JPLAY)
36INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP
37REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFAC(JPLAY)
38REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFRAC(JPLAY)
39INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDSELF(JPLAY)
40REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRAC(JPGPT,JPLAY)
41!- from AER
42!- from INTFAC     
43!- from INTIND
44!- from PRECISE             
45!- from PROFDATA             
46!- from SELF             
47!- from SP             
48INTEGER(KIND=JPIM) :: IG, IND0, IND1, INDS, JS, I_LAY
49
50REAL(KIND=JPRB) :: Z_FAC000, Z_FAC001, Z_FAC010, Z_FAC011, Z_FAC100, Z_FAC101,&
51 & Z_FAC110, Z_FAC111, Z_FS, Z_SPECCOMB, Z_SPECMULT, Z_SPECPARM 
52REAL(KIND=JPRB) :: ZHOOK_HANDLE
53
54!  Input
55!#include "yoeratm.h"
56
57!      REAL TAUAER(JPLAY)
58!      EQUIVALENCE (TAUAERL(1,16),TAUAER)
59
60!     Compute the optical depth by interpolating in ln(pressure),
61!     temperature, and appropriate species.  Below LAYTROP, the water
62!     vapor self-continuum is interpolated (in temperature) separately.
63 
64IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL16',0,ZHOOK_HANDLE)
65DO I_LAY = 1, K_LAYTROP
66  Z_SPECCOMB = P_COLH2O(I_LAY) + STRRAT*P_COLCH4(I_LAY)
67  Z_SPECPARM = P_COLH2O(I_LAY)/Z_SPECCOMB
68  Z_SPECPARM = MIN(Z_SPECPARM,P_ONEMINUS)
69  Z_SPECMULT = 8._JPRB*(Z_SPECPARM)
70  JS = 1 + INT(Z_SPECMULT)
71  Z_FS = MOD(Z_SPECMULT,1.0_JPRB)
72!----jjm         
73  Z_FAC000 = (1.0_JPRB - Z_FS) * P_FAC00(I_LAY)
74  Z_FAC010 = (1.0_JPRB - Z_FS) * P_FAC10(I_LAY)
75  Z_FAC100 = Z_FS * P_FAC00(I_LAY)
76  Z_FAC110 = Z_FS * P_FAC10(I_LAY)
77  Z_FAC001 = (1.0_JPRB - Z_FS) * P_FAC01(I_LAY)
78  Z_FAC011 = (1.0_JPRB - Z_FS) * P_FAC11(I_LAY)
79  Z_FAC101 = Z_FS * P_FAC01(I_LAY)
80  Z_FAC111 = Z_FS * P_FAC11(I_LAY)
81!-----         
82  IND0 = ((K_JP(I_LAY)-1)*5+(K_JT(I_LAY)-1))*NSPA(16) + JS
83  IND1 = (K_JP(I_LAY)*5+(K_JT1(I_LAY)-1))*NSPA(16) + JS
84  INDS = K_INDSELF(I_LAY)
85!         DO IG = 1, NG16
86!-- DS_990714
87  IG=1
88  P_TAU (NGS15+IG,I_LAY) = Z_SPECCOMB *&
89   !     &((1. - Z_FS)*(P_FAC00(I_LAY) * ABSA(IND0   ,IG) +
90   !     &            P_FAC10(I_LAY) * ABSA(IND0+ 9,IG) +
91   !     &            P_FAC01(I_LAY) * ABSA(IND1   ,IG) +
92   !     &            P_FAC11(I_LAY) * ABSA(IND1+ 9,IG))+
93   !     &    Z_FS * (  P_FAC01(I_LAY) * ABSA(IND1+ 1,IG) +
94   !     &            P_FAC10(I_LAY) * ABSA(IND0+10,IG) +
95   !     &            P_FAC00(I_LAY) * ABSA(IND0+ 1,IG) +
96   !     &            P_FAC11(I_LAY) * ABSA(IND1+10,IG))) +
97   & (Z_FAC000 * ABSA(IND0   ,IG) +&
98   & Z_FAC100 * ABSA(IND0+ 1,IG) +&
99   & Z_FAC010 * ABSA(IND0+ 9,IG) +&
100   & Z_FAC110 * ABSA(IND0+10,IG) +&
101   & Z_FAC001 * ABSA(IND1   ,IG) +&
102   & Z_FAC101 * ABSA(IND1+ 1,IG) +&
103   & Z_FAC011 * ABSA(IND1+ 9,IG) +&
104   & Z_FAC111 * ABSA(IND1+10,IG))+&
105   & P_COLH2O(I_LAY) * &
106   & P_SELFFAC(I_LAY) * (SELFREF(INDS,IG) + &
107   & P_SELFFRAC(I_LAY) *&
108   & (SELFREF(INDS+1,IG) - SELFREF(INDS,IG)))&
109   & + P_TAUAERL(I_LAY,16) 
110  PFRAC(NGS15+IG,I_LAY) = FRACREFA(IG,JS) + Z_FS *&
111   & (FRACREFA(IG,JS+1) - FRACREFA(IG,JS)) 
112  IG=2
113  P_TAU (NGS15+IG,I_LAY) = Z_SPECCOMB *&
114   !     &((1. - Z_FS)*(P_FAC00(I_LAY) * ABSA(IND0   ,IG) +
115   !     &            P_FAC10(I_LAY) * ABSA(IND0+ 9,IG) +
116   !     &            P_FAC01(I_LAY) * ABSA(IND1   ,IG) +
117   !     &            P_FAC11(I_LAY) * ABSA(IND1+ 9,IG))+
118   !     &    Z_FS * (  P_FAC01(I_LAY) * ABSA(IND1+ 1,IG) +
119   !     &            P_FAC10(I_LAY) * ABSA(IND0+10,IG) +
120   !     &            P_FAC00(I_LAY) * ABSA(IND0+ 1,IG) +
121   !     &            P_FAC11(I_LAY) * ABSA(IND1+10,IG))) +
122   & (Z_FAC000 * ABSA(IND0   ,IG) +&
123   & Z_FAC100 * ABSA(IND0+ 1,IG) +&
124   & Z_FAC010 * ABSA(IND0+ 9,IG) +&
125   & Z_FAC110 * ABSA(IND0+10,IG) +&
126   & Z_FAC001 * ABSA(IND1   ,IG) +&
127   & Z_FAC101 * ABSA(IND1+ 1,IG) +&
128   & Z_FAC011 * ABSA(IND1+ 9,IG) +&
129   & Z_FAC111 * ABSA(IND1+10,IG))+&
130   & P_COLH2O(I_LAY) *&
131   & P_SELFFAC(I_LAY) * (SELFREF(INDS,IG) +&
132   & P_SELFFRAC(I_LAY) *&
133   & (SELFREF(INDS+1,IG) - SELFREF(INDS,IG)))&
134   & + P_TAUAERL(I_LAY,16) 
135  PFRAC(NGS15+IG,I_LAY) = FRACREFA(IG,JS) + Z_FS *&
136   & (FRACREFA(IG,JS+1) - FRACREFA(IG,JS)) 
137
138!         END DO
139!-- DS_990714
140ENDDO
141
142DO I_LAY = K_LAYTROP+1, KLEV
143!         DO IG = 1, NG16
144!-- DS_990714
145  IG=1
146  P_TAU (NGS15+IG,I_LAY) = P_TAUAERL(I_LAY,16)
147  PFRAC(NGS15+IG,I_LAY) = 0.0_JPRB
148  IG=2
149  P_TAU (NGS15+IG,I_LAY) = P_TAUAERL(I_LAY,16)
150  PFRAC(NGS15+IG,I_LAY) = 0.0_JPRB
151!-- DS_990714
152!         END DO
153ENDDO
154
155IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL16',1,ZHOOK_HANDLE)
156END SUBROUTINE RRTM_TAUMOL16
Note: See TracBrowser for help on using the repository browser.