source: LMDZ5/trunk/libf/phylmd/rrtm/rrtm_taumol7.F90 @ 5408

Last change on this file since 5408 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.3 KB
RevLine 
[1989]1!----------------------------------------------------------------------------
2SUBROUTINE RRTM_TAUMOL7 (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_COLO3,P_CO2MULT,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC) 
5
6!     BAND 7:  980-1080 cm-1 (low - H2O,O3; high - O3)
7
8! Modifications
9!        M.Hamrud      01-Oct-2003 CY28 Cleaning
10
11!     D Salmond 2000-05-15 speed-up
12
13USE PARKIND1  ,ONLY : JPIM     ,JPRB
14USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
15
16USE PARRRTM  , ONLY : JPLAY  ,JPBAND ,JPGPT  ,NG7   ,NGS6
17USE YOERRTWN , ONLY :      NSPA   ,NSPB
18USE YOERRTA7 , ONLY : ABSA   ,ABSB   ,ABSCO2 ,FRACREFA ,FRACREFB,SELFREF,STRRAT
19
20!  Input
21!#include "yoeratm.h"
22
23!      REAL TAUAER(JPLAY)
24
25IMPLICIT NONE
26
27!  Output
28INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
29REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAU(JPGPT,JPLAY)
30REAL(KIND=JPRB)   ,INTENT(IN)    :: P_TAUAERL(JPLAY,JPBAND)
31REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC00(JPLAY)
32REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC01(JPLAY)
33REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC10(JPLAY)
34REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC11(JPLAY)
35INTEGER(KIND=JPIM),INTENT(IN)    :: K_JP(JPLAY)
36INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT(JPLAY)
37INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT1(JPLAY)
38REAL(KIND=JPRB)   ,INTENT(IN)    :: P_ONEMINUS
39REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLH2O(JPLAY)
40REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLO3(JPLAY)
41REAL(KIND=JPRB)   ,INTENT(IN)    :: P_CO2MULT(JPLAY)
42INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP
43REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFAC(JPLAY)
44REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFRAC(JPLAY)
45INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDSELF(JPLAY)
46REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRAC(JPGPT,JPLAY)
47!- from AER
48!- from INTFAC     
49!- from INTIND
50!- from PRECISE             
51!- from PROFDATA             
52!- from SELF             
53!- from SP             
54INTEGER(KIND=JPIM) :: IJS(JPLAY)
55REAL(KIND=JPRB) :: ZFS(JPLAY),Z_SPECCOMB(JPLAY)
56INTEGER(KIND=JPIM) :: IND0(JPLAY),IND1(JPLAY),INDS(JPLAY)
57
58INTEGER(KIND=JPIM) :: IG, JS, I_LAY
59
60REAL(KIND=JPRB) :: Z_FAC000, Z_FAC001, Z_FAC010, Z_FAC011, Z_FAC100, Z_FAC101,&
61 & Z_FAC110, Z_FAC111, Z_FS, Z_SPECMULT, Z_SPECPARM 
62REAL(KIND=JPRB) :: ZHOOK_HANDLE
63
64!      EQUIVALENCE (TAUAERL(1,7),TAUAER)
65
66!     Compute the optical depth by interpolating in ln(pressure),
67!     temperature, and appropriate species.  Below LAYTROP, the water
68!     vapor self-continuum is interpolated (in temperature) separately.
69 
70IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL7',0,ZHOOK_HANDLE)
71DO I_LAY = 1, K_LAYTROP
72  Z_SPECCOMB(I_LAY) = P_COLH2O(I_LAY) + STRRAT*P_COLO3(I_LAY)
73  Z_SPECPARM = P_COLH2O(I_LAY)/Z_SPECCOMB(I_LAY)
74  Z_SPECPARM=MIN(P_ONEMINUS,Z_SPECPARM)
75  Z_SPECMULT = 8._JPRB*Z_SPECPARM
76  JS = 1 + INT(Z_SPECMULT)
77  Z_FS = MOD(Z_SPECMULT,1.0_JPRB)
78  IND0(I_LAY) = ((K_JP(I_LAY)-1)*5+(K_JT(I_LAY)-1))*NSPA(7) + JS
79  IND1(I_LAY) = (K_JP(I_LAY)*5+(K_JT1(I_LAY)-1))*NSPA(7) + JS
80  INDS(I_LAY) = K_INDSELF(I_LAY)
81  ZFS(I_LAY)=Z_FS
82  IJS(I_LAY)=JS
83
84ENDDO
85
86!-- DS_000515
87DO IG = 1, NG7
88  DO I_LAY = 1, K_LAYTROP
89!-- DS_000515
90
91    Z_FS=ZFS(I_LAY)
92    JS=IJS(I_LAY)
93!---jjm       
94!    FAC000 = (_ONE_ - FS) * FAC00(LAY)
95!    FAC010 = (_ONE_ - FS) * FAC10(LAY)
96!    FAC100 = FS * FAC00(LAY)
97!    FAC110 = FS * FAC10(LAY)
98!    FAC001 = (_ONE_ - FS) * FAC01(LAY)
99!    FAC011 = (_ONE_ - FS) * FAC11(LAY)
100!    FAC101 = FS * FAC01(LAY)
101!    FAC111 = FS * FAC11(LAY)
102!-----
103
104    P_TAU (NGS6+IG,I_LAY) = Z_SPECCOMB(I_LAY) *&
105     !-- DS_000515
106     !     &(Z_FAC000 * ABSA(IND0(I_LAY)   ,IG) +&
107     !     & Z_FAC100 * ABSA(IND0(I_LAY)+ 1,IG) +&
108     !     & Z_FAC010 * ABSA(IND0(I_LAY)+ 9,IG) +&
109     !     & Z_FAC110 * ABSA(IND0(I_LAY)+10,IG) +&
110     !     & Z_FAC001 * ABSA(IND1(I_LAY)   ,IG) +&
111     !     & Z_FAC101 * ABSA(IND1(I_LAY)+ 1,IG) +&
112     !     & Z_FAC011 * ABSA(IND1(I_LAY)+ 9,IG) +&
113     !     & Z_FAC111 * ABSA(IND1(I_LAY)+10,IG))+&
114     & ( (1. - Z_FS) *(P_FAC00(I_LAY) * ABSA(IND0(I_LAY)   ,IG) +   &
115     & P_FAC10(I_LAY) * ABSA(IND0(I_LAY)+ 9,IG) +   &
116     & P_FAC01(I_LAY) * ABSA(IND1(I_LAY)   ,IG) +    &
117     & P_FAC11(I_LAY) * ABSA(IND1(I_LAY)+ 9,IG))+   &
118     & Z_FS     *(P_FAC00(I_LAY) * ABSA(IND0(I_LAY)+ 1,IG) +   &
119     & P_FAC10(I_LAY) * ABSA(IND0(I_LAY)+10,IG) +   &
120     & P_FAC01(I_LAY) * ABSA(IND1(I_LAY)+ 1,IG) +   &
121     & P_FAC11(I_LAY) * ABSA(IND1(I_LAY)+10,IG))) + &
122     !-- DS_000515
123     & P_COLH2O(I_LAY) * &
124     & P_SELFFAC(I_LAY) * (SELFREF(INDS(I_LAY),IG) + &
125     & P_SELFFRAC(I_LAY) *&
126     & (SELFREF(INDS(I_LAY)+1,IG) - SELFREF(INDS(I_LAY),IG)))&
127     & + P_CO2MULT(I_LAY) * ABSCO2(IG)&
128     & + P_TAUAERL(I_LAY,7) 
129    PFRAC(NGS6+IG,I_LAY) = FRACREFA(IG,JS) + Z_FS *&
130     & (FRACREFA(IG,JS+1) - FRACREFA(IG,JS)) 
131  ENDDO
132ENDDO
133
134DO I_LAY = K_LAYTROP+1, KLEV
135  IND0(I_LAY) = ((K_JP(I_LAY)-13)*5+(K_JT(I_LAY)-1))*NSPB(7) + 1
136  IND1(I_LAY) = ((K_JP(I_LAY)-12)*5+(K_JT1(I_LAY)-1))*NSPB(7) + 1
137ENDDO
138
139!-- JJM_000517
140DO IG = 1, NG7
141  DO I_LAY = K_LAYTROP+1, KLEV
142!-- JJM_000517
143    P_TAU (NGS6+IG,I_LAY) = P_COLO3(I_LAY) *&
144     & (P_FAC00(I_LAY) * ABSB(IND0(I_LAY)  ,IG) +&
145     & P_FAC10(I_LAY) * ABSB(IND0(I_LAY)+1,IG) +&
146     & P_FAC01(I_LAY) * ABSB(IND1(I_LAY)  ,IG) +&
147     & P_FAC11(I_LAY) * ABSB(IND1(I_LAY)+1,IG))&
148     & + P_CO2MULT(I_LAY) * ABSCO2(IG)&
149     & + P_TAUAERL(I_LAY,7) 
150    PFRAC(NGS6+IG,I_LAY) = FRACREFB(IG)
151  ENDDO
152ENDDO
153
154IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL7',1,ZHOOK_HANDLE)
155END SUBROUTINE RRTM_TAUMOL7
Note: See TracBrowser for help on using the repository browser.