source: LMDZ6/branches/LMDZ-COSP/libf/phylmd/rrtm/srtm_taumol22.F90 @ 3847

Last change on this file since 3847 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: 6.1 KB
Line 
1SUBROUTINE SRTM_TAUMOL22 &
2 & ( KLEV,&
3 & P_FAC00   , P_FAC01  , P_FAC10   , P_FAC11,&
4 & K_JP      , K_JT     , K_JT1     , P_ONEMINUS,&
5 & P_COLH2O  , P_COLMOL , P_COLO2,&
6 & K_LAYTROP , P_SELFFAC, P_SELFFRAC, K_INDSELF  , P_FORFAC, P_FORFRAC, K_INDFOR,&
7 & P_SFLUXZEN, P_TAUG   , P_TAUR    &
8 & ) 
9
10!     Written by Eli J. Mlawer, Atmospheric & Environmental Research.
11
12!     BAND 22:  7700-8050 cm-1 (low - H2O,O2; high - O2)
13
14! Modifications
15!        M.Hamrud      01-Oct-2003 CY28 Cleaning
16
17!     JJMorcrette 2003-02-24 adapted to ECMWF environment
18
19!      PARAMETER (MG=16, MXLAY=203, NBANDS=14)
20
21USE PARKIND1  ,ONLY : JPIM     ,JPRB
22USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
23
24USE PARSRTM  , ONLY : JPLAY, JPG, NG22
25USE YOESRTA22, ONLY : ABSA, ABSB, FORREFC, SELFREFC &
26 & , SFLUXREFC, RAYL &
27 & , LAYREFFR, STRRAT 
28USE YOESRTWN , ONLY : NSPA, NSPB
29
30IMPLICIT NONE
31
32!-- Output
33INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
34REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC00(JPLAY)
35REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC01(JPLAY)
36REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC10(JPLAY)
37REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC11(JPLAY)
38INTEGER(KIND=JPIM),INTENT(IN)    :: K_JP(JPLAY)
39INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT(JPLAY)
40INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT1(JPLAY)
41REAL(KIND=JPRB)   ,INTENT(IN)    :: P_ONEMINUS
42REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLH2O(JPLAY)
43REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLMOL(JPLAY)
44REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLO2(JPLAY)
45INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP
46REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFAC(JPLAY)
47REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFRAC(JPLAY)
48INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDSELF(JPLAY)
49REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FORFAC(JPLAY)
50REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FORFRAC(JPLAY)
51INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDFOR(JPLAY)
52
53REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_SFLUXZEN(JPG)
54REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAUG(JPLAY,JPG)
55REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAUR(JPLAY,JPG)
56!- from INTFAC     
57!- from INTIND
58!- from PRECISE             
59!- from PROFDATA             
60!- from SELF             
61INTEGER(KIND=JPIM) :: IG, IND0, IND1, INDS, INDF, JS, I_LAY, I_LAYSOLFR, I_NLAYERS
62
63REAL(KIND=JPRB) :: Z_FAC000, Z_FAC001, Z_FAC010, Z_FAC011, Z_FAC100, Z_FAC101,&
64 & Z_FAC110, Z_FAC111, Z_FS, Z_SPECCOMB, Z_SPECMULT, Z_SPECPARM, &
65 & Z_TAURAY, Z_O2ADJ , Z_O2CONT 
66REAL(KIND=JPRB) :: ZHOOK_HANDLE
67
68IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL22',0,ZHOOK_HANDLE)
69I_NLAYERS = KLEV
70
71!     The following factor is the ratio of total O2 band intensity (lines
72!     and Mate continuum) to O2 band intensity (line only).  It is needed
73!     to adjust the optical depths since the k's include only lines.
74Z_O2ADJ = 1.6_JPRB
75     
76!     Compute the optical depth by interpolating in ln(pressure),
77!     temperature, and appropriate species.  Below LAYTROP, the water
78!     vapor self-continuum is interpolated (in temperature) separately. 
79
80I_LAYSOLFR = K_LAYTROP
81
82DO I_LAY = 1, K_LAYTROP
83  IF (K_JP(I_LAY) < LAYREFFR .AND. K_JP(I_LAY+1) >= LAYREFFR) &
84   & I_LAYSOLFR = MIN(I_LAY+1,K_LAYTROP) 
85  Z_O2CONT = 4.35e-4*P_COLO2(I_LAY)/(350.0*2.0)
86  Z_SPECCOMB = P_COLH2O(I_LAY) + Z_O2ADJ*STRRAT*P_COLO2(I_LAY)
87  Z_SPECPARM = P_COLH2O(I_LAY)/Z_SPECCOMB
88  IF (Z_SPECPARM >= P_ONEMINUS) Z_SPECPARM = P_ONEMINUS
89  Z_SPECMULT = 8.*(Z_SPECPARM)
90!         ODADJ = SPECPARM + O2ADJ * (1. - SPECPARM)
91  JS = 1 + INT(Z_SPECMULT)
92  Z_FS = MOD(Z_SPECMULT, 1.0_JPRB )
93! Z_FAC000 = (1. - Z_FS) * P_FAC00(I_LAY)
94! Z_FAC010 = (1. - Z_FS) * P_FAC10(I_LAY)
95! Z_FAC100 = Z_FS * P_FAC00(I_LAY)
96! Z_FAC110 = Z_FS * P_FAC10(I_LAY)
97! Z_FAC001 = (1. - Z_FS) * P_FAC01(I_LAY)
98! Z_FAC011 = (1. - Z_FS) * P_FAC11(I_LAY)
99! Z_FAC101 = Z_FS * P_FAC01(I_LAY)
100! Z_FAC111 = Z_FS * P_FAC11(I_LAY)
101  IND0 = ((K_JP(I_LAY)-1)*5+(K_JT(I_LAY)-1))*NSPA(22) + JS
102  IND1 = (K_JP(I_LAY)*5+(K_JT1(I_LAY)-1))*NSPA(22) + JS
103  INDS = K_INDSELF(I_LAY)
104  INDF = K_INDFOR(I_LAY)
105  Z_TAURAY = P_COLMOL(I_LAY) * RAYL
106
107!  DO IG = 1, NG(22)
108  DO IG = 1 , NG22
109    P_TAUG(I_LAY,IG) = Z_SPECCOMB * &
110!    & (Z_FAC000 * ABSA(IND0,IG) + &
111!    & Z_FAC100 * ABSA(IND0+1,IG) + &
112!    & Z_FAC010 * ABSA(IND0+9,IG) + &
113!    & Z_FAC110 * ABSA(IND0+10,IG) + &
114!    & Z_FAC001 * ABSA(IND1,IG) + &
115!    & Z_FAC101 * ABSA(IND1+1,IG) + &
116!    & Z_FAC011 * ABSA(IND1+9,IG) + &
117!    & Z_FAC111 * ABSA(IND1+10,IG)) + &
118     & (&
119     & (1. - Z_FS) * ( ABSA(IND0,IG) * P_FAC00(I_LAY) + &
120     &                 ABSA(IND0+9,IG) * P_FAC10(I_LAY) + &
121     &                 ABSA(IND1,IG) * P_FAC01(I_LAY) + &
122     &                 ABSA(IND1+9,IG) * P_FAC11(I_LAY) ) + &
123     & Z_FS        * ( ABSA(IND0+1,IG) * P_FAC00(I_LAY) + &
124     &                 ABSA(IND0+10,IG) * P_FAC10(I_LAY) + &
125     &                 ABSA(IND1+1,IG) * P_FAC01(I_LAY) + &
126     &                 ABSA(IND1+10,IG) * P_FAC11(I_LAY) ) &
127     & ) + &
128     & P_COLH2O(I_LAY) * &
129     & (P_SELFFAC(I_LAY) * (SELFREFC(INDS,IG) + &
130     & P_SELFFRAC(I_LAY) * &
131     & (SELFREFC(INDS+1,IG) - SELFREFC(INDS,IG))) + &
132     & P_FORFAC(I_LAY) * (FORREFC(INDF,IG) + &
133     & P_FORFRAC(I_LAY) * &
134     & (FORREFC(INDF+1,IG) - FORREFC(INDF,IG)))) &
135     & + Z_O2CONT 
136!     &          + TAURAY
137!    SSA(LAY,IG) = TAURAY/TAUG(LAY,IG)
138    IF (I_LAY == I_LAYSOLFR) P_SFLUXZEN(IG) = SFLUXREFC(IG,JS) &
139     & + Z_FS * (SFLUXREFC(IG,JS+1) - SFLUXREFC(IG,JS)) 
140    P_TAUR(I_LAY,IG) = Z_TAURAY
141  ENDDO
142ENDDO
143
144DO I_LAY = K_LAYTROP+1, I_NLAYERS
145  Z_O2CONT = 4.35e-4*P_COLO2(I_LAY)/(350.0*2.0)
146  IND0 = ((K_JP(I_LAY)-13)*5+(K_JT(I_LAY)-1))*NSPB(22) + 1
147  IND1 = ((K_JP(I_LAY)-12)*5+(K_JT1(I_LAY)-1))*NSPB(22) + 1
148  Z_TAURAY = P_COLMOL(I_LAY) * RAYL
149
150!  DO IG = 1, NG(22)
151  DO IG = 1 , NG22
152    P_TAUG(I_LAY,IG) = P_COLO2(I_LAY) * Z_O2ADJ * &
153     & (P_FAC00(I_LAY) * ABSB(IND0,IG) + &
154     & P_FAC10(I_LAY) * ABSB(IND0+1,IG) + &
155     & P_FAC01(I_LAY) * ABSB(IND1,IG) + &
156     & P_FAC11(I_LAY) * ABSB(IND1+1,IG)) + &
157     & Z_O2CONT 
158!     &           + TAURAY
159!    SSA(LAY,IG) = TAURAY/TAUG(LAY,IG)
160    P_TAUR(I_LAY,IG) = Z_TAURAY
161  ENDDO
162ENDDO
163
164!-----------------------------------------------------------------------
165IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL22',1,ZHOOK_HANDLE)
166END SUBROUTINE SRTM_TAUMOL22
167
Note: See TracBrowser for help on using the repository browser.