| 1 | SUBROUTINE SW & |
|---|
| 2 | & ( KIDIA, KFDIA , KLON , KLEV , KAER,& |
|---|
| 3 | & PSCT , PCARDI, PPSOL , PALBD, PALBP , PWV, PQS,& |
|---|
| 4 | & PRMU0, PCG , PCLDSW, PDP , POMEGA, POZ, PPMB,& |
|---|
| 5 | & PTAU , PTAVE , PAER,& |
|---|
| 6 | & PFDOWN, PFUP,& |
|---|
| 7 | & PCDOWN, PCUP,& |
|---|
| 8 | & PFDNN, PFDNV , PFUPN, PFUPV,& |
|---|
| 9 | & PCDNN, PCDNV , PCUPN, PCUPV,& |
|---|
| 10 | & PSUDU, PUVDF , PPARF, PPARCF, PDIFFS , PDIRFS, & |
|---|
| 11 | & LRDUST, PPIZA_DST,PCGA_DST,PTAUREL_DST & |
|---|
| 12 | & ) |
|---|
| 13 | |
|---|
| 14 | |
|---|
| 15 | !**** *SW* - COMPUTES THE SHORTWAVE RADIATION FLUXES. |
|---|
| 16 | |
|---|
| 17 | ! PURPOSE. |
|---|
| 18 | ! -------- |
|---|
| 19 | |
|---|
| 20 | ! THIS ROUTINE COMPUTES THE SHORTWAVE RADIATION FLUXES IN TWO |
|---|
| 21 | ! SPECTRAL INTERVALS FOLLOWING FOUQUART AND BONNEL (1980). |
|---|
| 22 | |
|---|
| 23 | !** INTERFACE. |
|---|
| 24 | ! ---------- |
|---|
| 25 | |
|---|
| 26 | ! *SW* IS CALLED FROM *RADLSW* |
|---|
| 27 | |
|---|
| 28 | ! IMPLICIT ARGUMENTS : |
|---|
| 29 | ! -------------------- |
|---|
| 30 | |
|---|
| 31 | ! ==== INPUTS === |
|---|
| 32 | ! ==== OUTPUTS === |
|---|
| 33 | |
|---|
| 34 | ! METHOD. |
|---|
| 35 | ! ------- |
|---|
| 36 | |
|---|
| 37 | ! 1. COMPUTES ABSORBER AMOUNTS (SWU) |
|---|
| 38 | ! 2. COMPUTES FLUXES IN U.V./VISIBLE SPECTRAL INTERVAL (SW1S) |
|---|
| 39 | ! 3. COMPUTES FLUXES IN NEAR-INFRARED SPECTRAL INTERVAL (SWNI) |
|---|
| 40 | |
|---|
| 41 | ! EXTERNALS. |
|---|
| 42 | ! ---------- |
|---|
| 43 | |
|---|
| 44 | ! *SWU*, *SW1S*, *SWNI* |
|---|
| 45 | |
|---|
| 46 | ! REFERENCE. |
|---|
| 47 | ! ---------- |
|---|
| 48 | |
|---|
| 49 | ! SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT |
|---|
| 50 | ! DOCUMENTATION, AND FOUQUART AND BONNEL (1980) |
|---|
| 51 | |
|---|
| 52 | ! AUTHOR. |
|---|
| 53 | ! ------- |
|---|
| 54 | ! JEAN-JACQUES MORCRETTE *ECMWF* |
|---|
| 55 | |
|---|
| 56 | ! MODIFICATIONS. |
|---|
| 57 | ! -------------- |
|---|
| 58 | ! ORIGINAL : 89-07-14 |
|---|
| 59 | ! 95-01-01 J.-J. MORCRETTE Direct/Diffuse Albedo |
|---|
| 60 | ! 95-12-07 J.-J. MORCRETTE Near-Infrared in nsw-1 Intervals |
|---|
| 61 | ! 990128 JJMorcrette sunshine duration |
|---|
| 62 | ! 99-05-25 JJMorcrette Revised aerosols |
|---|
| 63 | ! 00-12-18 JJMorcrette 6 spectral intervals |
|---|
| 64 | ! 02-09-01 JJMorcrette UV and PAR |
|---|
| 65 | ! M.Hamrud 01-Oct-2003 CY28 Cleaning |
|---|
| 66 | ! Y.Seity 04-11-18 : add two arguments for AROME extern. surface |
|---|
| 67 | ! Y.Seity 05-10-10 : add add 3 optional arg. for dust SW properties |
|---|
| 68 | ! JJMorcrette 20060721 PP of clear-sky PAR |
|---|
| 69 | ! ------------------------------------------------------------------ |
|---|
| 70 | |
|---|
| 71 | USE PARKIND1 ,ONLY : JPIM ,JPRB |
|---|
| 72 | USE YOMHOOK ,ONLY : LHOOK, DR_HOOK |
|---|
| 73 | !USE YOERAD , ONLY : NSW |
|---|
| 74 | ! NSW mis dans .def MPL 20140211 |
|---|
| 75 | USE write_field_phy |
|---|
| 76 | |
|---|
| 77 | IMPLICIT NONE |
|---|
| 78 | |
|---|
| 79 | include "clesphys.h" |
|---|
| 80 | |
|---|
| 81 | integer, save :: icount=0 |
|---|
| 82 | INTEGER(KIND=JPIM),INTENT(IN) :: KLON |
|---|
| 83 | INTEGER(KIND=JPIM),INTENT(IN) :: KLEV |
|---|
| 84 | INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA |
|---|
| 85 | INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA |
|---|
| 86 | INTEGER(KIND=JPIM),INTENT(IN) :: KAER |
|---|
| 87 | REAL(KIND=JPRB) ,INTENT(IN) :: PSCT |
|---|
| 88 | REAL(KIND=JPRB) ,INTENT(IN) :: PCARDI |
|---|
| 89 | REAL(KIND=JPRB) ,INTENT(IN) :: PPSOL(KLON) |
|---|
| 90 | REAL(KIND=JPRB) ,INTENT(IN) :: PALBD(KLON,NSW) |
|---|
| 91 | REAL(KIND=JPRB) ,INTENT(IN) :: PALBP(KLON,NSW) |
|---|
| 92 | REAL(KIND=JPRB) ,INTENT(IN) :: PWV(KLON,KLEV) |
|---|
| 93 | REAL(KIND=JPRB) ,INTENT(IN) :: PQS(KLON,KLEV) |
|---|
| 94 | REAL(KIND=JPRB) ,INTENT(IN) :: PRMU0(KLON) |
|---|
| 95 | REAL(KIND=JPRB) ,INTENT(IN) :: PCG(KLON,NSW,KLEV) |
|---|
| 96 | REAL(KIND=JPRB) ,INTENT(IN) :: PCLDSW(KLON,KLEV) |
|---|
| 97 | REAL(KIND=JPRB) :: PDP(KLON,KLEV) ! Argument NOT used |
|---|
| 98 | REAL(KIND=JPRB) ,INTENT(IN) :: POMEGA(KLON,NSW,KLEV) |
|---|
| 99 | REAL(KIND=JPRB) ,INTENT(IN) :: POZ(KLON,KLEV) |
|---|
| 100 | REAL(KIND=JPRB) ,INTENT(IN) :: PPMB(KLON,KLEV+1) |
|---|
| 101 | REAL(KIND=JPRB) ,INTENT(IN) :: PTAU(KLON,NSW,KLEV) |
|---|
| 102 | REAL(KIND=JPRB) ,INTENT(IN) :: PTAVE(KLON,KLEV) |
|---|
| 103 | REAL(KIND=JPRB) ,INTENT(IN) :: PAER(KLON,6,KLEV) |
|---|
| 104 | !++MODIFCODE |
|---|
| 105 | LOGICAL ,INTENT(IN) :: LRDUST |
|---|
| 106 | REAL(KIND=JPRB) ,INTENT(IN) :: PPIZA_DST(KLON,KLEV,NSW) |
|---|
| 107 | REAL(KIND=JPRB) ,INTENT(IN) :: PCGA_DST(KLON,KLEV,NSW) |
|---|
| 108 | REAL(KIND=JPRB) ,INTENT(IN) :: PTAUREL_DST(KLON,KLEV,NSW) |
|---|
| 109 | !--MODIFCODE |
|---|
| 110 | REAL(KIND=JPRB) ,INTENT(OUT) :: PFDOWN(KLON,KLEV+1) |
|---|
| 111 | REAL(KIND=JPRB) ,INTENT(OUT) :: PFUP(KLON,KLEV+1) |
|---|
| 112 | REAL(KIND=JPRB) ,INTENT(OUT) :: PCDOWN(KLON,KLEV+1) |
|---|
| 113 | REAL(KIND=JPRB) ,INTENT(OUT) :: PCUP(KLON,KLEV+1) |
|---|
| 114 | REAL(KIND=JPRB) ,INTENT(OUT) :: PFDNN(KLON) |
|---|
| 115 | REAL(KIND=JPRB) ,INTENT(OUT) :: PFDNV(KLON) |
|---|
| 116 | REAL(KIND=JPRB) ,INTENT(OUT) :: PFUPN(KLON) |
|---|
| 117 | REAL(KIND=JPRB) ,INTENT(OUT) :: PFUPV(KLON) |
|---|
| 118 | REAL(KIND=JPRB) ,INTENT(OUT) :: PCDNN(KLON) |
|---|
| 119 | REAL(KIND=JPRB) ,INTENT(OUT) :: PCDNV(KLON) |
|---|
| 120 | REAL(KIND=JPRB) ,INTENT(OUT) :: PCUPN(KLON) |
|---|
| 121 | REAL(KIND=JPRB) ,INTENT(OUT) :: PCUPV(KLON) |
|---|
| 122 | REAL(KIND=JPRB) ,INTENT(OUT) :: PSUDU(KLON) |
|---|
| 123 | REAL(KIND=JPRB) ,INTENT(OUT) :: PUVDF(KLON) |
|---|
| 124 | REAL(KIND=JPRB) ,INTENT(OUT) :: PPARF(KLON) |
|---|
| 125 | REAL(KIND=JPRB) ,INTENT(OUT) :: PPARCF(KLON) |
|---|
| 126 | REAL(KIND=JPRB) ,INTENT(OUT) :: PDIFFS(KLON,NSW) |
|---|
| 127 | REAL(KIND=JPRB) ,INTENT(OUT) :: PDIRFS(KLON,NSW) |
|---|
| 128 | ! ------------------------------------------------------------------ |
|---|
| 129 | |
|---|
| 130 | !* 0.1 ARGUMENTS |
|---|
| 131 | ! --------- |
|---|
| 132 | |
|---|
| 133 | ! ------------------------------------------------------------------ |
|---|
| 134 | |
|---|
| 135 | ! ------------ |
|---|
| 136 | |
|---|
| 137 | REAL(KIND=JPRB) :: ZAKI(KLON,2,NSW)& |
|---|
| 138 | & , ZCLD(KLON,KLEV) , ZCLEAR(KLON) & |
|---|
| 139 | & , ZDSIG(KLON,KLEV) , ZFACT(KLON)& |
|---|
| 140 | & , ZFD(KLON,KLEV+1) , ZCD(KLON,KLEV+1)& |
|---|
| 141 | & , ZCDOWN(KLON,KLEV+1), ZCDNIR(KLON,KLEV+1), ZCDUVS(KLON,KLEV+1)& |
|---|
| 142 | & , ZFDOWN(KLON,KLEV+1), ZFDNIR(KLON,KLEV+1), ZFDUVS(KLON,KLEV+1)& |
|---|
| 143 | & , ZFU(KLON,KLEV+1) , ZCU(KLON,KLEV+1)& |
|---|
| 144 | & , ZCUP(KLON,KLEV+1) , ZCUNIR(KLON,KLEV+1), ZCUUVS(KLON,KLEV+1)& |
|---|
| 145 | & , ZFUP(KLON,KLEV+1) , ZFUNIR(KLON,KLEV+1), ZFUUVS(KLON,KLEV+1)& |
|---|
| 146 | & , ZRMU(KLON) , ZSEC(KLON) & |
|---|
| 147 | & , ZSUDU1(KLON) , ZSUDU2(KLON) & |
|---|
| 148 | & , ZSUDU1T(KLON) , ZSUDU2T(KLON) & |
|---|
| 149 | & , ZUD(KLON,5,KLEV+1) ,ZDIFF(KLON,KLEV) ,ZDIRF(KLON,KLEV) & |
|---|
| 150 | & , ZDIFF2(KLON,KLEV) , ZDIRF2(KLON,KLEV) |
|---|
| 151 | |
|---|
| 152 | INTEGER(KIND=JPIM) :: JK, JL, JNU, INUVS, INUIR |
|---|
| 153 | |
|---|
| 154 | REAL(KIND=JPRB) :: ZHOOK_HANDLE |
|---|
| 155 | LOGICAL :: LLDEBUG |
|---|
| 156 | character*1 str1 |
|---|
| 157 | |
|---|
| 158 | #include "sw1s.intfb.h" |
|---|
| 159 | #include "swni.intfb.h" |
|---|
| 160 | #include "swu.intfb.h" |
|---|
| 161 | |
|---|
| 162 | ! ------------------------------------------------------------------ |
|---|
| 163 | |
|---|
| 164 | !* 1. ABSORBER AMOUNTS AND OTHER USEFUL QUANTITIES |
|---|
| 165 | ! -------------------------------------------- |
|---|
| 166 | |
|---|
| 167 | IF (LHOOK) CALL DR_HOOK('SW',0,ZHOOK_HANDLE) |
|---|
| 168 | LLDEBUG=.FALSE. |
|---|
| 169 | CALL SWU ( KIDIA,KFDIA ,KLON ,KLEV,& |
|---|
| 170 | & PSCT ,PCARDI,PCLDSW,PPMB ,PPSOL,& |
|---|
| 171 | & PRMU0,PTAVE ,PWV,& |
|---|
| 172 | & ZAKI ,ZCLD ,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD ) |
|---|
| 173 | |
|---|
| 174 | ! ------------------------------------------------------------------ |
|---|
| 175 | !* 2. INTERVAL (0.185/0.25-0.68 MICRON): U.V. AND VISIBLE |
|---|
| 176 | ! --------------------------------------------------- |
|---|
| 177 | IF (NSW <= 4) THEN |
|---|
| 178 | INUVS=1 |
|---|
| 179 | INUIR=2 |
|---|
| 180 | ELSEIF (NSW == 6) THEN |
|---|
| 181 | INUVS=1 |
|---|
| 182 | INUIR=4 |
|---|
| 183 | ENDIF |
|---|
| 184 | |
|---|
| 185 | DO JK = 1 , KLEV+1 |
|---|
| 186 | DO JL = KIDIA,KFDIA |
|---|
| 187 | ZFD(JL,JK) =0.0_JPRB |
|---|
| 188 | ZFU(JL,JK) =0.0_JPRB |
|---|
| 189 | ZCD(JL,JK) =0.0_JPRB |
|---|
| 190 | ZCU(JL,JK) =0.0_JPRB |
|---|
| 191 | ENDDO |
|---|
| 192 | ENDDO |
|---|
| 193 | DO JL = KIDIA,KFDIA |
|---|
| 194 | ZSUDU1T(JL)=0.0_JPRB |
|---|
| 195 | PUVDF(JL) =0.0_JPRB |
|---|
| 196 | PPARF(JL) =0.0_JPRB |
|---|
| 197 | PPARCF(JL) =0.0_JPRB |
|---|
| 198 | ENDDO |
|---|
| 199 | |
|---|
| 200 | IF(LLDEBUG) THEN |
|---|
| 201 | call writefield_phy('sw_zsec',ZSEC,1) |
|---|
| 202 | call writefield_phy('sw_zrmu',ZRMU,1) |
|---|
| 203 | call writefield_phy('sw_prmu0',PRMU0,1) |
|---|
| 204 | call writefield_phy('sw_zfact',ZFACT,1) |
|---|
| 205 | ENDIF |
|---|
| 206 | |
|---|
| 207 | icount=icount+1 |
|---|
| 208 | DO JNU = INUVS , INUIR-1 |
|---|
| 209 | !++MODIFCODE |
|---|
| 210 | CALL SW1S & |
|---|
| 211 | &( KIDIA , KFDIA, KLON , KLEV , KAER , JNU & |
|---|
| 212 | &, PAER , PALBD , PALBP, PCG , ZCLD , ZCLEAR & |
|---|
| 213 | &, ZDSIG, POMEGA, POZ , ZRMU , ZSEC , PTAU , ZUD & |
|---|
| 214 | &, ZFDUVS,ZFUUVS, ZCDUVS,ZCUUVS, ZSUDU1, ZDIFF,ZDIRF & |
|---|
| 215 | &, LRDUST,PPIZA_DST(:,:,JNU) & ! SSA for this wavelength |
|---|
| 216 | &, PCGA_DST(:,:,JNU) & ! GCA for this wavelengt |
|---|
| 217 | &, PTAUREL_DST(:,:,JNU) ) ! TAUREL for this wavelength |
|---|
| 218 | !--MODIFCODE |
|---|
| 219 | IF(LLDEBUG) THEN |
|---|
| 220 | ! Ecriture des champs avec un indicage du fichier par l'intervalle spectral |
|---|
| 221 | write(str1,'(i1)') jnu |
|---|
| 222 | call writefield_phy("sw_zcduvs"//str1,zcduvs,klev+1) |
|---|
| 223 | ENDIF |
|---|
| 224 | |
|---|
| 225 | |
|---|
| 226 | DO JL=KIDIA,KFDIA |
|---|
| 227 | PDIFFS(JL,JNU)=ZDIFF(JL,1)*ZFACT(JL) |
|---|
| 228 | PDIRFS(JL,JNU)=ZDIRF(JL,1)*ZFACT(JL) |
|---|
| 229 | ENDDO |
|---|
| 230 | DO JK = 1 , KLEV+1 |
|---|
| 231 | DO JL = KIDIA,KFDIA |
|---|
| 232 | ZFD(JL,JK)=ZFD(JL,JK)+ZFDUVS(JL,JK) |
|---|
| 233 | ZFU(JL,JK)=ZFU(JL,JK)+ZFUUVS(JL,JK) |
|---|
| 234 | ZCD(JL,JK)=ZCD(JL,JK)+ZCDUVS(JL,JK) |
|---|
| 235 | ZCU(JL,JK)=ZCU(JL,JK)+ZCUUVS(JL,JK) |
|---|
| 236 | ENDDO |
|---|
| 237 | ENDDO |
|---|
| 238 | DO JL = KIDIA,KFDIA |
|---|
| 239 | ZSUDU1T(JL)=ZSUDU1T(JL)+ZSUDU1(JL) |
|---|
| 240 | ENDDO |
|---|
| 241 | |
|---|
| 242 | IF (NSW == 6) THEN |
|---|
| 243 | IF (JNU <= 2) THEN |
|---|
| 244 | DO JL = KIDIA,KFDIA |
|---|
| 245 | PUVDF(JL)=PUVDF(JL)+ZFDUVS(JL,1) |
|---|
| 246 | ENDDO |
|---|
| 247 | ELSEIF (JNU == 3) THEN |
|---|
| 248 | DO JL=KIDIA,KFDIA |
|---|
| 249 | PPARF(JL)=PPARF(JL)+ZFDUVS(JL,1) |
|---|
| 250 | PPARCF(JL)=PPARCF(JL)+ZCDUVS(JL,1) |
|---|
| 251 | ENDDO |
|---|
| 252 | ENDIF |
|---|
| 253 | ENDIF |
|---|
| 254 | ENDDO |
|---|
| 255 | |
|---|
| 256 | !if (icount==5) stop'on arrete dans sw.F90 au bout de 5 appels' |
|---|
| 257 | ! ------------------------------------------------------------------ |
|---|
| 258 | |
|---|
| 259 | !* 3. INTERVAL (0.68-4.00 MICRON): NEAR-INFRARED |
|---|
| 260 | ! ------------------------------------------ |
|---|
| 261 | |
|---|
| 262 | DO JK = 1 , KLEV+1 |
|---|
| 263 | DO JL = KIDIA,KFDIA |
|---|
| 264 | ZFDOWN(JL,JK)=0.0_JPRB |
|---|
| 265 | ZFUP (JL,JK)=0.0_JPRB |
|---|
| 266 | ZCDOWN(JL,JK)=0.0_JPRB |
|---|
| 267 | ZCUP (JL,JK)=0.0_JPRB |
|---|
| 268 | ZSUDU2T(JL) =0.0_JPRB |
|---|
| 269 | ENDDO |
|---|
| 270 | ENDDO |
|---|
| 271 | |
|---|
| 272 | DO JNU = INUIR , NSW |
|---|
| 273 | !++MODIFCODE |
|---|
| 274 | CALL SWNI & |
|---|
| 275 | &( KIDIA ,KFDIA , KLON , KLEV , KAER , JNU & |
|---|
| 276 | &, PAER ,ZAKI , PALBD, PALBP, PCG , ZCLD, ZCLEAR & |
|---|
| 277 | &, ZDSIG ,POMEGA, POZ , ZRMU , ZSEC , PTAU, ZUD & |
|---|
| 278 | &, PWV ,PQS & |
|---|
| 279 | &, ZFDNIR,ZFUNIR,ZCDNIR,ZCUNIR,ZSUDU2,ZDIFF2,ZDIRF2 & |
|---|
| 280 | &, LRDUST,PPIZA_DST(:,:,JNU) & |
|---|
| 281 | &, PCGA_DST(:,:,JNU) & |
|---|
| 282 | &, PTAUREL_DST(:,:,JNU) & |
|---|
| 283 | &) |
|---|
| 284 | !--MODIFCODE |
|---|
| 285 | |
|---|
| 286 | IF(LLDEBUG) THEN |
|---|
| 287 | ! Ecriture des champs avec un indicage du fichier par l'intervalle spectral |
|---|
| 288 | write(str1,'(i1)') jnu |
|---|
| 289 | call writefield_phy("sw_zcdnir"//str1,zcdnir,klev+1) |
|---|
| 290 | ENDIF |
|---|
| 291 | |
|---|
| 292 | DO JL=KIDIA,KFDIA |
|---|
| 293 | PDIFFS(JL,JNU)=ZDIFF2(JL,1)*ZFACT(JL) |
|---|
| 294 | PDIRFS(JL,JNU)=ZDIRF2(JL,1)*ZFACT(JL) |
|---|
| 295 | ENDDO |
|---|
| 296 | DO JK = 1 , KLEV+1 |
|---|
| 297 | DO JL = KIDIA,KFDIA |
|---|
| 298 | ZFDOWN(JL,JK)=ZFDOWN(JL,JK)+ZFDNIR(JL,JK) |
|---|
| 299 | ZFUP (JL,JK)=ZFUP (JL,JK)+ZFUNIR(JL,JK) |
|---|
| 300 | ZCDOWN(JL,JK)=ZCDOWN(JL,JK)+ZCDNIR(JL,JK) |
|---|
| 301 | ZCUP (JL,JK)=ZCUP (JL,JK)+ZCUNIR(JL,JK) |
|---|
| 302 | ENDDO |
|---|
| 303 | ENDDO |
|---|
| 304 | DO JL = KIDIA,KFDIA |
|---|
| 305 | ZSUDU2T(JL)=ZSUDU2T(JL)+ZSUDU2(JL) |
|---|
| 306 | ENDDO |
|---|
| 307 | ENDDO |
|---|
| 308 | |
|---|
| 309 | ! ------------------------------------------------------------------ |
|---|
| 310 | |
|---|
| 311 | !* 4. FILL THE DIAGNOSTIC ARRAYS |
|---|
| 312 | ! -------------------------- |
|---|
| 313 | |
|---|
| 314 | DO JL = KIDIA,KFDIA |
|---|
| 315 | PFDNN(JL)=ZFDOWN(JL,1)*ZFACT(JL) |
|---|
| 316 | PFDNV(JL)=ZFD(JL,1)*ZFACT(JL) |
|---|
| 317 | PFUPN(JL)=ZFUP(JL,KLEV+1)*ZFACT(JL) |
|---|
| 318 | PFUPV(JL)=ZFU(JL,KLEV+1)*ZFACT(JL) |
|---|
| 319 | |
|---|
| 320 | PCDNN(JL)=ZCDOWN(JL,1)*ZFACT(JL) |
|---|
| 321 | PCDNV(JL)=ZCD(JL,1)*ZFACT(JL) |
|---|
| 322 | PCUPN(JL)=ZCUP(JL,KLEV+1)*ZFACT(JL) |
|---|
| 323 | PCUPV(JL)=ZCU(JL,KLEV+1)*ZFACT(JL) |
|---|
| 324 | |
|---|
| 325 | PSUDU(JL)=(ZSUDU1T(JL)+ZSUDU2T(JL))*ZFACT(JL) |
|---|
| 326 | PUVDF(JL)=PUVDF(JL)*ZFACT(JL) |
|---|
| 327 | PPARF(JL)=PPARF(JL)*ZFACT(JL) |
|---|
| 328 | PPARCF(JL)=PPARCF(JL)*ZFACT(JL) |
|---|
| 329 | ENDDO |
|---|
| 330 | |
|---|
| 331 | !WRITE(*,'("---> Dans SW:")') |
|---|
| 332 | !WRITE(*,'("ZFUP ",10E12.5)') (ZFUP(1,JK),JK=1,KLEV+1) |
|---|
| 333 | !WRITE(*,'("ZFU ",10E12.5)') (ZFU(1,JK),JK=1,KLEV+1) |
|---|
| 334 | !WRITE(*,'("ZFUNIR",10E12.5)') (ZFUNIR(1,JK),JK=1,KLEV+1) |
|---|
| 335 | !WRITE(*,'("ZFACT ",E12.5)') ZFACT(1) |
|---|
| 336 | |
|---|
| 337 | DO JK = 1 , KLEV+1 |
|---|
| 338 | DO JL = KIDIA,KFDIA |
|---|
| 339 | PFUP(JL,JK) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL) |
|---|
| 340 | PFDOWN(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL) |
|---|
| 341 | PCUP(JL,JK) = (ZCUP(JL,JK) + ZCU(JL,JK)) * ZFACT(JL) |
|---|
| 342 | PCDOWN(JL,JK) = (ZCDOWN(JL,JK) + ZCD(JL,JK)) * ZFACT(JL) |
|---|
| 343 | ENDDO |
|---|
| 344 | ENDDO |
|---|
| 345 | IF(LLDEBUG) THEN |
|---|
| 346 | call writefield_phy('sw_pcdown',PCDOWN,KLEV+1) |
|---|
| 347 | ENDIF |
|---|
| 348 | |
|---|
| 349 | ! ------------------------------------------------------------------ |
|---|
| 350 | |
|---|
| 351 | IF (LHOOK) CALL DR_HOOK('SW',1,ZHOOK_HANDLE) |
|---|
| 352 | END SUBROUTINE SW |
|---|
