source: LMDZ6/trunk/libf/phylmd/rrtm/swu.F90 @ 5428

Last change on this file since 5428 was 5294, checked in by Laurent Fairhead, 2 months ago

Keeping clesphys.h was not the right solution
LF
  • 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: 7.3 KB
Line 
1!OPTIONS XOPT(HSFUN)
2SUBROUTINE SWU &
3 & ( KIDIA, KFDIA , KLON  , KLEV,&
4 & PSCT , PCARDI, PCLDSW, PPMB , PPSOL, PRMU0, PTAVE, PWV,&
5 & PAKI , PCLD  , PCLEAR, PDSIG, PFACT, PRMU , PSEC , PUD &
6 & ) 
7
8!**** *SWU* - SHORTWAVE RADIATION, ABSORBER AMOUNTS
9
10!     PURPOSE.
11!     --------
12!           COMPUTES THE ABSORBER AMOUNTS USED IN SHORTWAVE RADIATION
13!     CALCULATIONS
14
15!**   INTERFACE.
16!     ----------
17!          *SWU* IS CALLED BY *SW*
18
19!        IMPLICIT ARGUMENTS :
20!        --------------------
21
22!     ==== INPUTS ===
23!     ==== OUTPUTS ===
24
25!     METHOD.
26!     -------
27
28!          1. COMPUTES ABSORBER AMOUNTS WITH TEMPERATURE AND PRESSURE
29!     SCALING.
30
31!     EXTERNALS.
32!     ----------
33
34!          *SWTT*
35
36!     REFERENCE.
37!     ----------
38
39!        SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
40!        DOCUMENTATION, AND FOUQUART AND BONNEL (1980)
41
42!     AUTHOR.
43!     -------
44!        JEAN-JACQUES MORCRETTE  *ECMWF*
45
46!     MODIFICATIONS.
47!     --------------
48!        ORIGINAL : 89-07-14
49!        03-03-18   JJMorcrette  security on normalized cloud cover
50!        M.Hamrud      01-Oct-2003 CY28 Cleaning
51!        Y.Seity 06-09-09 : add modset from O.Thouron (MesoNH) under NOVLP tests
52
53!     ------------------------------------------------------------------
54
55USE PARKIND1  ,ONLY : JPIM     ,JPRB
56USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
57
58USE YOECLD   , ONLY : REPSEC
59!USE YOERAD   , ONLY :   NOVLP    ,NSW
60! NSW mis dans .def MPL 20140211
61USE YOERAD   , ONLY :   NOVLP   
62USE YOERDU   , ONLY : REPSCQ
63USE YOESW    , ONLY : RPDH1    ,RPDU1    ,RPNH     ,RPNU     ,&
64 & RTDH2O   ,RTDUMG   ,RTH2O    ,RTUMG 
65USE YOEOVLP  , ONLY : RA1OVLP
66! Temporary fix waiting for cleaner interface (or not)
67USE clesphys_mod_h, ONLY: NSW
68
69IMPLICIT NONE
70
71!!include "clesphys.h"
72INTEGER(KIND=JPIM),INTENT(IN)    :: KLON
73INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
74INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
75INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
76REAL(KIND=JPRB)   ,INTENT(IN)    :: PSCT
77REAL(KIND=JPRB)   ,INTENT(IN)    :: PCARDI
78REAL(KIND=JPRB)   ,INTENT(IN)    :: PCLDSW(KLON,KLEV)
79REAL(KIND=JPRB)   ,INTENT(IN)    :: PPMB(KLON,KLEV+1)
80REAL(KIND=JPRB)   ,INTENT(IN)    :: PPSOL(KLON)
81REAL(KIND=JPRB)   ,INTENT(IN)    :: PRMU0(KLON)
82REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAVE(KLON,KLEV)
83REAL(KIND=JPRB)   ,INTENT(IN)    :: PWV(KLON,KLEV)
84REAL(KIND=JPRB)   ,INTENT(OUT)   :: PAKI(KLON,2,NSW)
85REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCLD(KLON,KLEV)
86REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCLEAR(KLON)
87REAL(KIND=JPRB)   ,INTENT(OUT)   :: PDSIG(KLON,KLEV)
88REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFACT(KLON)
89REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRMU(KLON)
90REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSEC(KLON)
91REAL(KIND=JPRB)   ,INTENT(OUT)   :: PUD(KLON,5,KLEV+1)
92!     ------------------------------------------------------------------
93
94!*       0.1   ARGUMENTS
95!              ---------
96
97INTEGER(KIND=JPIM) :: INUIR 
98
99!     ------------------------------------------------------------------
100
101!              ------------
102
103INTEGER(KIND=JPIM) :: IIND(2)
104REAL(KIND=JPRB) :: ZC1J(KLON,KLEV+1),ZCLEAR(KLON),ZCLOUD(KLON)&
105 & ,  ZN175(KLON), ZN190(KLON), ZO175(KLON)&
106 & ,  ZO190(KLON), ZSIGN(KLON)&
107 & ,  ZR(KLON,2) , ZSIGO(KLON), ZUD(KLON,2) 
108
109INTEGER(KIND=JPIM) :: JA, JK, JKL, JKLP1, JKP1, JL, JNU
110
111REAL(KIND=JPRB) :: ZDSCO2, ZDSH2O, ZFPPW, ZRTH, ZRTU, ZWH2O, ZALPHA1
112REAL(KIND=JPRB) :: ZHOOK_HANDLE
113
114#include "swtt1.intfb.h"
115
116!     ------------------------------------------------------------------
117
118!*         1.     COMPUTES AMOUNTS OF ABSORBERS
119!                 -----------------------------
120
121REPSEC=1.E-12_JPRB   !!!!! A REVOIR (MPL)
122IF (LHOOK) CALL DR_HOOK('SWU',0,ZHOOK_HANDLE)
123IIND(1)=1
124IIND(2)=2
125
126!*         1.1    INITIALIZES QUANTITIES
127!                 ----------------------
128
129DO JL = KIDIA,KFDIA
130  PUD(JL,1,KLEV+1)=0.0_JPRB
131  PUD(JL,2,KLEV+1)=0.0_JPRB
132  PUD(JL,3,KLEV+1)=0.0_JPRB
133  PUD(JL,4,KLEV+1)=0.0_JPRB
134  PUD(JL,5,KLEV+1)=0.0_JPRB
135  PFACT(JL)= PRMU0(JL) * PSCT
136!- already accounted for in RADINT     
137!      PRMU(JL)=SQRT(1224.* PRMU0(JL) * PRMU0(JL) + 1.) / 35.
138  PRMU(JL)=PRMU0(JL)
139  PSEC(JL)=1.0_JPRB/PRMU(JL)
140  ZC1J(JL,KLEV+1)=0.0_JPRB
141ENDDO
142
143!*          1.3    AMOUNTS OF ABSORBERS
144!                  --------------------
145
146DO JL= KIDIA,KFDIA
147  ZUD(JL,1) = 0.0_JPRB
148  ZUD(JL,2) = 0.0_JPRB
149  ZO175(JL) = PPSOL(JL)** RPDU1
150  ZO190(JL) = PPSOL(JL)** RPDH1
151  ZSIGO(JL) = PPSOL(JL)
152  ZCLEAR(JL)=1.0_JPRB
153  ZCLOUD(JL)=0.0_JPRB
154ENDDO
155
156DO JK = 1 , KLEV
157  JKP1 = JK + 1
158  JKL = KLEV+1 - JK
159  JKLP1 = JKL+1
160  ZALPHA1=RA1OVLP(KLEV+1-JK)
161 
162  DO JL = KIDIA,KFDIA
163    ZRTH=(RTH2O/PTAVE(JL,JK))**RTDH2O
164    ZRTU=(RTUMG/PTAVE(JL,JK))**RTDUMG
165    ZWH2O = MAX (PWV(JL,JKL) , REPSCQ )
166
167    ZSIGN(JL) = 100._JPRB * PPMB(JL,JKP1)
168    PDSIG(JL,JK) = (ZSIGO(JL) - ZSIGN(JL))/PPSOL(JL)
169    ZN175(JL) = ZSIGN(JL) ** RPDU1
170    ZN190(JL) = ZSIGN(JL) ** RPDH1
171    ZDSCO2 = ZO175(JL) - ZN175(JL)
172    ZDSH2O = ZO190(JL) - ZN190(JL)
173    PUD(JL,1,JK) = RPNH * ZDSH2O * ZWH2O  * ZRTH
174    PUD(JL,2,JK) = RPNU * ZDSCO2 * PCARDI * ZRTU
175   
176    ZFPPW=1.6078_JPRB*ZWH2O/(1.0_JPRB+0.608_JPRB*ZWH2O)
177    PUD(JL,4,JK)=PUD(JL,1,JK)*ZFPPW
178    PUD(JL,5,JK)=PUD(JL,1,JK)*(1.0_JPRB-ZFPPW)
179    ZUD(JL,1) = ZUD(JL,1) + PUD(JL,1,JK)
180    ZUD(JL,2) = ZUD(JL,2) + PUD(JL,2,JK)
181    ZSIGO(JL) = ZSIGN(JL)
182    ZO175(JL) = ZN175(JL)
183    ZO190(JL) = ZN190(JL)
184!print *,'SWU: RTH2O RTDH2O RTUMG RTDUMG',RTH2O,RTDH2O,RTUMG,RTDUMG
185!print *,'SWU: RPNH ZDSH2O ZWH2O ZRTH',RPNH,ZDSH2O,ZWH2O,ZRTH
186!print *,'SWU: RPNU ZDSCO2 PCARDI ZRTU',RPNU,ZDSCO2,PCARDI,ZRTU
187
188!++MODIFCODE
189    IF ((NOVLP == 1).OR.(NOVLP==6).OR.(NOVLP==8)) THEN
190      ZCLEAR(JL)=ZCLEAR(JL)&
191       & *(1.0_JPRB-MAX(PCLDSW(JL,JKL),ZCLOUD(JL)))&
192       & /(1.0_JPRB-MIN(ZCLOUD(JL),1.0_JPRB-REPSEC)) 
193      ZC1J(JL,JKL)= 1.0_JPRB - ZCLEAR(JL)
194      ZCLOUD(JL) = PCLDSW(JL,JKL)
195    ELSEIF ((NOVLP == 2).OR.(NOVLP==7)) THEN
196      ZCLOUD(JL) = MAX(PCLDSW(JL,JKL),ZCLOUD(JL))
197      ZC1J(JL,JKL) = ZCLOUD(JL)
198    ELSEIF ((NOVLP == 3).OR.(NOVLP==5)) THEN
199      ZCLEAR(JL) = ZCLEAR(JL)*(1.0_JPRB-PCLDSW(JL,JKL))
200      ZCLOUD(JL) = 1.0_JPRB - ZCLEAR(JL)
201      ZC1J(JL,JKL) = ZCLOUD(JL)
202    ELSEIF (NOVLP == 4) THEN
203!** Hogan & Illingworth (2001)     
204      ZCLEAR(JL)=ZCLEAR(JL)*( &
205       & ZALPHA1*(1.0_JPRB-MAX(PCLDSW(JL,JKL),ZCLOUD(JL))) &
206       & /(1.0_JPRB-MIN(ZCLOUD(JL),1.0_JPRB-REPSEC)) &
207       & +(1.0_JPRB-ZALPHA1)*(1.0_JPRB-PCLDSW(JL,JKL)) ) 
208      ZC1J(JL,JKL) = 1.0_JPRB - ZCLEAR(JL)
209      ZCLOUD(JL) = PCLDSW(JL,JKL)
210    ENDIF
211!--MODIFCODE
212  ENDDO
213ENDDO
214
215DO JL=KIDIA,KFDIA
216  PCLEAR(JL)=1.0_JPRB-ZC1J(JL,1)
217ENDDO
218DO JK=1,KLEV
219  DO JL=KIDIA,KFDIA
220    IF (PCLEAR(JL) < 1.0_JPRB) THEN
221      PCLD(JL,JK)=PCLDSW(JL,JK)/(1.0_JPRB-PCLEAR(JL))
222    ELSE
223      PCLD(JL,JK)=0.0_JPRB
224    ENDIF
225    PCLD(JL,JK)=MAX(0.0_JPRB,MIN(1.0_JPRB,PCLD(JL,JK)))
226  ENDDO
227ENDDO
228
229!*         1.4    COMPUTES CLEAR-SKY GREY ABSORPTION COEFFICIENTS
230!                 -----------------------------------------------
231
232DO JA = 1,2
233  DO JL = KIDIA,KFDIA
234    ZUD(JL,JA) = ZUD(JL,JA) * PSEC(JL)
235  ENDDO
236ENDDO
237
238IF (NSW <= 4) THEN
239  INUIR=2
240ELSEIF (NSW == 6) THEN
241  INUIR=4
242ENDIF     
243
244DO JNU= INUIR,NSW
245
246  CALL SWTT1 ( KIDIA,KFDIA,KLON, JNU, 2, IIND,&
247   & ZUD,&
248   & ZR                            ) 
249
250  DO JA = 1,2
251    DO JL = KIDIA,KFDIA
252      PAKI(JL,JA,JNU) = -LOG( ZR(JL,JA) ) / ZUD(JL,JA)
253    ENDDO
254  ENDDO
255ENDDO
256
257!     ------------------------------------------------------------------
258
259IF (LHOOK) CALL DR_HOOK('SWU',1,ZHOOK_HANDLE)
260END SUBROUTINE SWU
261
Note: See TracBrowser for help on using the repository browser.