source: LMDZ6/branches/cirrus/libf/phylmd/ecrad.v1.5.1/srtm_taumol22.F90 @ 5435

Last change on this file since 5435 was 4395, checked in by idelkadi, 2 years ago

Inversion of the order of loops in the srtm_taumol22.F90 routine.
The code crashes on the IRENE computer using the O3 compilation option.
File size: 7.9 KB
Line 
1SUBROUTINE SRTM_TAUMOL22 &
2 & ( KIDIA   , KFDIA    , 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    , PRMU0   &
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!        D.Salmond  31-Oct-2007 Vector version in the style of RRTM from Meteo France & NEC
19!     JJMorcrette 20110610 Flexible configuration for number of g-points
20
21USE PARKIND1 , ONLY : JPIM, JPRB
22USE YOMHOOK  , ONLY : LHOOK, DR_HOOK
23USE PARSRTM  , ONLY : JPG
24USE YOESRTM  , ONLY : NG22
25USE YOESRTA22, ONLY : ABSA, ABSB, FORREFC, SELFREFC, SFLUXREFC, RAYL, LAYREFFR, STRRAT 
26USE YOESRTWN , ONLY : NSPA, NSPB
27
28IMPLICIT NONE
29
30!-- Output
31INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA, KFDIA
32INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
33REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC00(KIDIA:KFDIA,KLEV)
34REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC01(KIDIA:KFDIA,KLEV)
35REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC10(KIDIA:KFDIA,KLEV)
36REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC11(KIDIA:KFDIA,KLEV)
37INTEGER(KIND=JPIM),INTENT(IN)    :: K_JP(KIDIA:KFDIA,KLEV)
38INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT(KIDIA:KFDIA,KLEV)
39INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT1(KIDIA:KFDIA,KLEV)
40REAL(KIND=JPRB)   ,INTENT(IN)    :: P_ONEMINUS(KIDIA:KFDIA)
41REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLH2O(KIDIA:KFDIA,KLEV)
42REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLMOL(KIDIA:KFDIA,KLEV)
43REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLO2(KIDIA:KFDIA,KLEV)
44INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP(KIDIA:KFDIA)
45REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFAC(KIDIA:KFDIA,KLEV)
46REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFRAC(KIDIA:KFDIA,KLEV)
47INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDSELF(KIDIA:KFDIA,KLEV)
48REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FORFAC(KIDIA:KFDIA,KLEV)
49REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FORFRAC(KIDIA:KFDIA,KLEV)
50INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDFOR(KIDIA:KFDIA,KLEV)
51
52REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_SFLUXZEN(KIDIA:KFDIA,JPG)
53REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAUG(KIDIA:KFDIA,KLEV,JPG)
54REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAUR(KIDIA:KFDIA,KLEV,JPG)
55REAL(KIND=JPRB)   ,INTENT(IN)    :: PRMU0(KIDIA:KFDIA)
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(KIDIA:KFDIA), I_NLAYERS, IPLON
62
63INTEGER(KIND=JPIM) :: I_LAY_NEXT
64
65REAL(KIND=JPRB) :: Z_FAC000, Z_FAC001, Z_FAC010, Z_FAC011, Z_FAC100, Z_FAC101,&
66 & Z_FAC110, Z_FAC111, Z_FS, Z_SPECCOMB, Z_SPECMULT, Z_SPECPARM, &
67 & Z_TAURAY, Z_O2ADJ , Z_O2CONT 
68REAL(KIND=JPRB) :: ZHOOK_HANDLE
69
70ASSOCIATE(NFLEVG=>KLEV)
71IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL22',0,ZHOOK_HANDLE)
72
73I_NLAYERS = KLEV
74
75!     The following factor is the ratio of total O2 band intensity (lines
76!     and Mate continuum) to O2 band intensity (line only).  It is needed
77!     to adjust the optical depths since the k's include only lines.
78Z_O2ADJ = 1.6_JPRB
79
80!     Compute the optical depth by interpolating in ln(pressure),
81!     temperature, and appropriate species.  Below LAYTROP, the water
82!     vapor self-continuum is interpolated (in temperature) separately. 
83
84I_LAYSOLFR(KIDIA:KFDIA) = K_LAYTROP(KIDIA:KFDIA)
85
86!AI inversion des boucles pb avec option de compil O3
87DO IPLON = KIDIA, KFDIA
88  DO I_LAY = 1, I_NLAYERS
89  I_LAY_NEXT = MIN(I_NLAYERS, I_LAY+1)
90!  DO IPLON = KIDIA, KFDIA
91    IF (PRMU0(IPLON) > 0.0_JPRB) THEN
92      IF (I_LAY <= K_LAYTROP(IPLON)) THEN
93        IF (K_JP(IPLON,I_LAY) < LAYREFFR .AND. K_JP(IPLON,I_LAY_NEXT) >= LAYREFFR) &
94         & I_LAYSOLFR(IPLON) = MIN(I_LAY+1,K_LAYTROP(IPLON)) 
95        Z_O2CONT = 4.35e-4*P_COLO2(IPLON,I_LAY)/(350.0*2.0)
96        Z_SPECCOMB = P_COLH2O(IPLON,I_LAY) + Z_O2ADJ*STRRAT*P_COLO2(IPLON,I_LAY)
97        Z_SPECPARM = P_COLH2O(IPLON,I_LAY)/Z_SPECCOMB
98        IF (Z_SPECPARM >= P_ONEMINUS(IPLON)) Z_SPECPARM = P_ONEMINUS(IPLON)
99        Z_SPECMULT = 8.*(Z_SPECPARM)
100        !         ODADJ = SPECPARM + O2ADJ * (1. - SPECPARM)
101        JS = 1 + INT(Z_SPECMULT)
102        Z_FS = MOD(Z_SPECMULT, 1.0_JPRB )
103        ! Z_FAC000 = (1. - Z_FS) * P_FAC00(I_LAY)
104        ! Z_FAC010 = (1. - Z_FS) * P_FAC10(I_LAY)
105        ! Z_FAC100 = Z_FS * P_FAC00(I_LAY)
106        ! Z_FAC110 = Z_FS * P_FAC10(I_LAY)
107        ! Z_FAC001 = (1. - Z_FS) * P_FAC01(I_LAY)
108        ! Z_FAC011 = (1. - Z_FS) * P_FAC11(I_LAY)
109        ! Z_FAC101 = Z_FS * P_FAC01(I_LAY)
110        ! Z_FAC111 = Z_FS * P_FAC11(I_LAY)
111        IND0 = ((K_JP(IPLON,I_LAY)-1)*5+(K_JT(IPLON,I_LAY)-1))*NSPA(22) + JS
112        IND1 = (K_JP(IPLON,I_LAY)*5+(K_JT1(IPLON,I_LAY)-1))*NSPA(22) + JS
113        INDS = K_INDSELF(IPLON,I_LAY)
114        INDF = K_INDFOR(IPLON,I_LAY)
115        Z_TAURAY = P_COLMOL(IPLON,I_LAY) * RAYL
116
117        !  DO IG = 1, NG(22)
118!CDIR UNROLL=NG22
119        DO IG = 1 , NG22
120          P_TAUG(IPLON,I_LAY,IG) = Z_SPECCOMB * &
121           !    & (Z_FAC000 * ABSA(IND0,IG) + &
122           !    & Z_FAC100 * ABSA(IND0+1,IG) + &
123           !    & Z_FAC010 * ABSA(IND0+9,IG) + &
124           !    & Z_FAC110 * ABSA(IND0+10,IG) + &
125           !    & Z_FAC001 * ABSA(IND1,IG) + &
126           !    & Z_FAC101 * ABSA(IND1+1,IG) + &
127           !    & Z_FAC011 * ABSA(IND1+9,IG) + &
128           !    & Z_FAC111 * ABSA(IND1+10,IG)) + &
129           & (&
130           & (1. - Z_FS) * ( ABSA(IND0,IG) * P_FAC00(IPLON,I_LAY) + &
131           &                 ABSA(IND0+9,IG) * P_FAC10(IPLON,I_LAY) + &
132           &                 ABSA(IND1,IG) * P_FAC01(IPLON,I_LAY) + &
133           &                 ABSA(IND1+9,IG) * P_FAC11(IPLON,I_LAY) ) + &
134           & Z_FS        * ( ABSA(IND0+1,IG) * P_FAC00(IPLON,I_LAY) + &
135           &                 ABSA(IND0+10,IG) * P_FAC10(IPLON,I_LAY) + &
136           &                 ABSA(IND1+1,IG) * P_FAC01(IPLON,I_LAY) + &
137           &                 ABSA(IND1+10,IG) * P_FAC11(IPLON,I_LAY) ) &
138           & ) + &
139           & P_COLH2O(IPLON,I_LAY) * &
140           & (P_SELFFAC(IPLON,I_LAY) * (SELFREFC(INDS,IG) + &
141           & P_SELFFRAC(IPLON,I_LAY) * &
142           & (SELFREFC(INDS+1,IG) - SELFREFC(INDS,IG))) + &
143           & P_FORFAC(IPLON,I_LAY) * (FORREFC(INDF,IG) + &
144           & P_FORFRAC(IPLON,I_LAY) * &
145           & (FORREFC(INDF+1,IG) - FORREFC(INDF,IG)))) &
146           & + Z_O2CONT 
147          !     &          + TAURAY
148          !    SSA(LAY,IG) = TAURAY/TAUG(LAY,IG)
149          IF (I_LAY == I_LAYSOLFR(IPLON)) P_SFLUXZEN(IPLON,IG) = SFLUXREFC(IG,JS) &
150           & + Z_FS * (SFLUXREFC(IG,JS+1) - SFLUXREFC(IG,JS)) 
151          P_TAUR(IPLON,I_LAY,IG) = Z_TAURAY
152        ENDDO
153      ENDIF
154    ENDIF
155  ENDDO
156ENDDO
157
158DO I_LAY = 1, I_NLAYERS
159  DO IPLON = KIDIA, KFDIA
160    IF (PRMU0(IPLON) > 0.0_JPRB) THEN
161      IF (I_LAY >= K_LAYTROP(IPLON)+1) THEN
162        Z_O2CONT = 4.35e-4*P_COLO2(IPLON,I_LAY)/(350.0*2.0)
163        IND0 = ((K_JP(IPLON,I_LAY)-13)*5+(K_JT(IPLON,I_LAY)-1))*NSPB(22) + 1
164        IND1 = ((K_JP(IPLON,I_LAY)-12)*5+(K_JT1(IPLON,I_LAY)-1))*NSPB(22) + 1
165        Z_TAURAY = P_COLMOL(IPLON,I_LAY) * RAYL
166
167        !  DO IG = 1, NG(22)
168!CDIR UNROLL=NG22
169        DO IG = 1 , NG22
170          P_TAUG(IPLON,I_LAY,IG) = P_COLO2(IPLON,I_LAY) * Z_O2ADJ * &
171           & (P_FAC00(IPLON,I_LAY) * ABSB(IND0,IG) + &
172           & P_FAC10(IPLON,I_LAY) * ABSB(IND0+1,IG) + &
173           & P_FAC01(IPLON,I_LAY) * ABSB(IND1,IG) + &
174           & P_FAC11(IPLON,I_LAY) * ABSB(IND1+1,IG)) + &
175           & Z_O2CONT 
176          !     &           + TAURAY
177          !    SSA(LAY,IG) = TAURAY/TAUG(LAY,IG)
178          P_TAUR(IPLON,I_LAY,IG) = Z_TAURAY
179        ENDDO
180      ENDIF
181    ENDIF
182  ENDDO
183ENDDO
184
185!-----------------------------------------------------------------------
186IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL22',1,ZHOOK_HANDLE)
187END ASSOCIATE
188END SUBROUTINE SRTM_TAUMOL22
Note: See TracBrowser for help on using the repository browser.