source: LMDZ6/branches/Ocean_skin/libf/phylmd/rrtm/rrtm_taumol15.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.7 KB
Line 
1!----------------------------------------------------------------------------
2SUBROUTINE RRTM_TAUMOL15 (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_COLCO2,P_COLN2O,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC) 
5
6!     BAND 15:  2380-2600 cm-1 (low - N2O,CO2; 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  ,NGS14
17USE YOERRTWN , ONLY :      NSPA   
18USE YOERRTA15, 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_COLCO2(JPLAY)
36REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLN2O(JPLAY)
37INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP
38REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFAC(JPLAY)
39REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFRAC(JPLAY)
40INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDSELF(JPLAY)
41REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRAC(JPGPT,JPLAY)
42!- from AER
43!- from INTFAC     
44!- from INTIND
45!- from PRECISE             
46!- from PROFDATA             
47!- from SELF             
48!- from SP             
49INTEGER(KIND=JPIM) :: IG, IND0, IND1, INDS, JS, I_LAY
50
51REAL(KIND=JPRB) :: Z_FAC000, Z_FAC001, Z_FAC010, Z_FAC011, Z_FAC100, Z_FAC101,&
52 & Z_FAC110, Z_FAC111, Z_FS, Z_SPECCOMB, Z_SPECMULT, Z_SPECPARM 
53REAL(KIND=JPRB) :: ZHOOK_HANDLE
54
55!  Input
56!#include "yoeratm.h"
57
58!      REAL TAUAER(JPLAY)
59!      EQUIVALENCE (TAUAERL(1,15),TAUAER)
60
61!     Compute the optical depth by interpolating in ln(pressure),
62!     temperature, and appropriate species.  Below LAYTROP, the water
63!     vapor self-continuum is interpolated (in temperature) separately.
64 
65IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL15',0,ZHOOK_HANDLE)
66DO I_LAY = 1, K_LAYTROP
67  Z_SPECCOMB = P_COLN2O(I_LAY) + STRRAT*P_COLCO2(I_LAY)
68  Z_SPECPARM = P_COLN2O(I_LAY)/Z_SPECCOMB
69  Z_SPECPARM = MIN(Z_SPECPARM,P_ONEMINUS)
70  Z_SPECMULT = 8._JPRB*(Z_SPECPARM)
71  JS = 1 + INT(Z_SPECMULT)
72  Z_FS = MOD(Z_SPECMULT,1.0_JPRB)
73!-----jjm       
74  Z_FAC000 = (1.0_JPRB - Z_FS) * P_FAC00(I_LAY)
75  Z_FAC010 = (1.0_JPRB - Z_FS) * P_FAC10(I_LAY)
76  Z_FAC100 = Z_FS * P_FAC00(I_LAY)
77  Z_FAC110 = Z_FS * P_FAC10(I_LAY)
78  Z_FAC001 = (1.0_JPRB - Z_FS) * P_FAC01(I_LAY)
79  Z_FAC011 = (1.0_JPRB - Z_FS) * P_FAC11(I_LAY)
80  Z_FAC101 = Z_FS * P_FAC01(I_LAY)
81  Z_FAC111 = Z_FS * P_FAC11(I_LAY)
82!------         
83  IND0 = ((K_JP(I_LAY)-1)*5+(K_JT(I_LAY)-1))*NSPA(15) + JS
84  IND1 = (K_JP(I_LAY)*5+(K_JT1(I_LAY)-1))*NSPA(15) + JS
85  INDS = K_INDSELF(I_LAY)
86!-- DS_990714 
87!         DO IG = 1, NG15
88  IG=1
89  P_TAU (NGS14+IG,I_LAY) = Z_SPECCOMB *&
90   !     &((1. - Z_FS)*(P_FAC00(I_LAY) * ABSA(IND0,IG) +
91   !     &            P_FAC10(I_LAY) * ABSA(IND0+9,IG) +
92   !     &            P_FAC01(I_LAY) * ABSA(IND1,IG) +
93   !     &            P_FAC11(I_LAY) * ABSA(IND1+9,IG)) +
94   !     &     Z_FS *  (P_FAC01(I_LAY) * ABSA(IND1+1,IG) +
95   !     &            P_FAC10(I_LAY) * ABSA(IND0+10,IG) +
96   !     &            P_FAC00(I_LAY) * ABSA(IND0+1,IG) +
97   !     &            P_FAC11(I_LAY) * ABSA(IND1+10,IG))) +
98   & (Z_FAC000 * ABSA(IND0   ,IG) +&
99   & Z_FAC100 * ABSA(IND0+ 1,IG) +&
100   & Z_FAC010 * ABSA(IND0+ 9,IG) +&
101   & Z_FAC110 * ABSA(IND0+10,IG) +&
102   & Z_FAC001 * ABSA(IND1   ,IG) +&
103   & Z_FAC101 * ABSA(IND1+ 1,IG) +&
104   & Z_FAC011 * ABSA(IND1+ 9,IG) +&
105   & Z_FAC111 * ABSA(IND1+10,IG))+&
106   & P_COLH2O(I_LAY) * &
107   & P_SELFFAC(I_LAY) * (SELFREF(INDS,IG) + &
108   & P_SELFFRAC(I_LAY) *&
109   & (SELFREF(INDS+1,IG) - SELFREF(INDS,IG)))&
110   & + P_TAUAERL(I_LAY,15) 
111  PFRAC(NGS14+IG,I_LAY) = FRACREFA(IG,JS) + Z_FS *&
112   & (FRACREFA(IG,JS+1) - FRACREFA(IG,JS)) 
113  IG=2
114  P_TAU (NGS14+IG,I_LAY) = Z_SPECCOMB *&
115   !     &((1. - Z_FS)*(P_FAC00(I_LAY) * ABSA(IND0,IG) +
116   !     &            P_FAC10(I_LAY) * ABSA(IND0+9,IG) +
117   !     &            P_FAC01(I_LAY) * ABSA(IND1,IG) +
118   !     &            P_FAC11(I_LAY) * ABSA(IND1+9,IG)) +
119   !     &     Z_FS *  (P_FAC01(I_LAY) * ABSA(IND1+1,IG) +
120   !     &            P_FAC10(I_LAY) * ABSA(IND0+10,IG) +
121   !     &            P_FAC00(I_LAY) * ABSA(IND0+1,IG) +
122   !     &            P_FAC11(I_LAY) * ABSA(IND1+10,IG))) +
123   & (Z_FAC000 * ABSA(IND0   ,IG) +&
124   & Z_FAC100 * ABSA(IND0+ 1,IG) +&
125   & Z_FAC010 * ABSA(IND0+ 9,IG) +&
126   & Z_FAC110 * ABSA(IND0+10,IG) +&
127   & Z_FAC001 * ABSA(IND1   ,IG) +&
128   & Z_FAC101 * ABSA(IND1+ 1,IG) +&
129   & Z_FAC011 * ABSA(IND1+ 9,IG) +&
130   & Z_FAC111 * ABSA(IND1+10,IG))+&
131   & P_COLH2O(I_LAY) *&
132   & P_SELFFAC(I_LAY) * (SELFREF(INDS,IG) +&
133   & P_SELFFRAC(I_LAY) *&
134   & (SELFREF(INDS+1,IG) - SELFREF(INDS,IG)))&
135   & + P_TAUAERL(I_LAY,15) 
136  PFRAC(NGS14+IG,I_LAY) = FRACREFA(IG,JS) + Z_FS *&
137   & (FRACREFA(IG,JS+1) - FRACREFA(IG,JS)) 
138
139!         END DO
140!-- DS_990714 
141ENDDO
142
143DO I_LAY = K_LAYTROP+1, KLEV
144!         DO IG = 1, NG15
145!-- DS_990714 
146  IG=1
147  P_TAU (NGS14+IG,I_LAY) = P_TAUAERL(I_LAY,15)
148  PFRAC(NGS14+IG,I_LAY) = 0.0_JPRB
149  IG=2
150  P_TAU (NGS14+IG,I_LAY) = P_TAUAERL(I_LAY,15)
151  PFRAC(NGS14+IG,I_LAY) = 0.0_JPRB
152!-- DS_990714 
153!         END DO
154ENDDO
155
156IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL15',1,ZHOOK_HANDLE)
157END SUBROUTINE RRTM_TAUMOL15
Note: See TracBrowser for help on using the repository browser.