Changeset 3881 for trunk/LMDZ.PLUTO/libf
- Timestamp:
- Aug 7, 2025, 10:01:38 AM (4 months ago)
- Location:
- trunk/LMDZ.PLUTO/libf/phypluto
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/LMDZ.PLUTO/libf/phypluto/optci.F90
r3695 r3881 15 15 igas_CH4, igas_N2 16 16 use comcstfi_mod, only: g, r, mugaz 17 use callkeys_mod, only: kastprof,continuum,graybody 17 use callkeys_mod, only: kastprof,continuum,graybody,callmufi 18 18 use recombin_corrk_mod, only: corrk_recombin, gasi_recomb 19 19 use tpindex_mod, only: tpindex … … 94 94 !real*8 rho !! see test below 95 95 96 ! Variables for aerosol absorption 97 real*8 Fabs_aer(NAERKIND) 98 96 99 integer igas, jgas 97 100 … … 140 143 lkcoef(:,:) = 0.0 141 144 145 if(callmufi) then 146 Fabs_aer(1) = 1.2 147 Fabs_aer(2) = 1.3 148 else 149 Fabs_aer(:) = 1.0 150 endif 151 142 152 do K=2,L_LEVELS 143 153 DPR(k) = PLEV(K)-PLEV(K-1) … … 176 186 do K=2,L_LEVELS 177 187 TAEROS(K,NW,IAER) = TAUAERO(K,IAER) * QXIAER(K,NW,IAER) 178 end do ! levels 179 END DO 180 end do 188 ! Aerosol absorption correction --> impact on opacity. 189 if (callmufi .and. (TAEROS(K,NW,IAER).gt.0.d0)) then 190 TAEROS(K,NW,IAER) = TAEROS(K,NW,IAER) * & 191 ((QSIAER(K,NW,IAER)/QXIAER(K,NW,IAER)) + Fabs_aer(IAER)*(1.-(QSIAER(K,NW,IAER)/QXIAER(K,NW,IAER)))) 192 endif 193 end do ! L_LEVELS 194 END DO ! L_NSPECTI 195 end do ! naerkind 181 196 182 197 do NW=1,L_NSPECTI … … 322 337 ENDDO 323 338 end do 324 325 DO NW=1,L_NSPECTI 326 DO L=1,L_NLAYRAD-1 327 K = 2*L+1 328 btemp(L,NW) = SUM(TAUAEROLK(K,NW,1:naerkind)) + SUM(TAUAEROLK(K+1,NW,1:naerkind)) 339 340 DO NW = 1, L_NSPECTI 341 DO L = 1, L_NLAYRAD-1 342 K = 2*L + 1 343 ! Aerosol absorption correction --> impact on single scattering albedo. 344 if (callmufi) then 345 if ((TAEROS(K,NW,1).gt.0.d0) .and. TAEROS(K+1,NW,1).gt.0.d0) then 346 btemp(L,NW) = TAUAEROLK(K,NW,1) / & 347 (QSIAER(K,NW,1)/QXIAER(K,NW,1) + & 348 Fabs_aer(1)*(1.-QSIAER(K,NW,1)/QXIAER(K,NW,1))) + & 349 TAUAEROLK(K+1,NW,1) / & 350 (QSIAER(K+1,NW,1)/QXIAER(K+1,NW,1) + & 351 Fabs_aer(1)*(1.-QSIAER(K+1,NW,1)/QXIAER(K+1,NW,1))) 352 else 353 btemp(L,NW) = TAUAEROLK(K,NW,1) + TAUAEROLK(K+1,NW,1) 354 endif 355 if ((TAEROS(K,NW,2).gt.0.d0) .and. TAEROS(K+1,NW,2).gt.0.d0) then 356 btemp(L,NW) = btemp(L,NW) + & 357 (TAUAEROLK(K,NW,2) / & 358 (QSIAER(K,NW,2)/QXIAER(K,NW,2) + & 359 Fabs_aer(2)*(1.-QSIAER(K,NW,2)/QXIAER(K,NW,2)))) + & 360 (TAUAEROLK(K+1,NW,2) / & 361 (QSIAER(K+1,NW,2)/QXIAER(K+1,NW,2) + & 362 Fabs_aer(2)*(1.-QSIAER(K+1,NW,2)/QXIAER(K+1,NW,2)))) 363 else 364 btemp(L,NW) = btemp(L,NW) + TAUAEROLK(K,NW,2) + TAUAEROLK(K+1,NW,2) 365 endif 366 else 367 btemp(L,NW) = SUM(TAUAEROLK(K,NW,1:naerkind)) + SUM(TAUAEROLK(K+1,NW,1:naerkind)) 368 endif ! callmufi 329 369 END DO ! L vertical loop 330 370 331 371 ! Last level 332 L = L_NLAYRAD 333 K = 2*L+1 334 btemp(L,NW) = SUM(TAUAEROLK(K,NW,1:naerkind)) 335 336 END DO ! NW spectral loop 372 !----------- 373 L = L_NLAYRAD 374 K = 2*L+1 375 ! Aerosol absorption correction --> impact on single scattering albedo. 376 if (callmufi) then 377 if (TAEROS(K,NW,1).gt.0.d0) then 378 btemp(L,NW) = TAUAEROLK(K,NW,1) / & 379 (QSIAER(K,NW,1)/QXIAER(K,NW,1) + & 380 Fabs_aer(1)*(1.-QSIAER(K,NW,1)/QXIAER(K,NW,1))) 381 else 382 btemp(L,NW) = TAUAEROLK(K,NW,1) 383 endif 384 if (TAEROS(K,NW,2).gt.0.d0) then 385 btemp(L,NW) = btemp(L,NW) + & 386 (TAUAEROLK(K,NW,2) / & 387 (QSIAER(K,NW,2)/QXIAER(K,NW,2) + & 388 Fabs_aer(2)*(1.-QSIAER(K,NW,2)/QXIAER(K,NW,2)))) 389 else 390 btemp(L,NW) = btemp(L,NW) + TAUAEROLK(K,NW,2) 391 endif 392 else 393 btemp(L,NW) = SUM(TAUAEROLK(K,NW,1:naerkind)) 394 endif ! callmufi 395 END DO ! NW spectral loop 337 396 338 397 … … 366 425 367 426 ! Last level 368 427 !----------- 369 428 L = L_NLAYRAD 370 429 K = 2*L+1 -
trunk/LMDZ.PLUTO/libf/phypluto/optcv.F90
r3695 r3881 14 14 igas_CH4, igas_N2 15 15 use comcstfi_mod, only: g, r, mugaz 16 use callkeys_mod, only: kastprof,continuum,graybody,callgasvis 16 use callkeys_mod, only: kastprof,continuum,graybody,callgasvis,callmufi 17 17 use recombin_corrk_mod, only: corrk_recombin, gasv_recomb 18 18 use tpindex_mod, only: tpindex … … 100 100 real*8 dz(L_LEVELS) 101 101 102 ! Variables for aerosol absorption 103 real*8 Fabs_aer(NAERKIND) 102 104 103 105 integer igas, jgas … … 137 139 lkcoef(:,:) = 0.0 138 140 DTAUKV(:,:,:) = 0.0 141 142 if(callmufi) then 143 Fabs_aer(1) = 0.7 144 Fabs_aer(2) = 2.5 145 else 146 Fabs_aer(:) = 1.0 147 endif 139 148 140 149 do K=2,L_LEVELS … … 160 169 161 170 ! Spectral dependance of aerosol absorption 162 171 !JL18 It seems to be good to have aerosols in the first "radiative layer" of the gcm in the IR 163 172 ! but visible does not handle very well diffusion in first layer. 164 173 ! The tauaero and tauray are thus set to 0 (a small value for rayleigh because the code crashes otherwise) … … 170 179 do K=5,L_LEVELS 171 180 TAEROS(K,NW,IAER) = TAUAERO(K,IAER) * QXVAER(K,NW,IAER) 172 end do ! levels 173 end do 174 end do 175 181 ! Aerosol absorption correction --> impact on opacity. 182 if (callmufi .and. (TAEROS(K,NW,IAER).gt.0.d0)) then 183 TAEROS(K,NW,IAER) = TAEROS(K,NW,IAER) * & 184 ((QSVAER(K,NW,IAER)/QXVAER(K,NW,IAER)) + Fabs_aer(IAER)*(1.-(QSVAER(K,NW,IAER)/QXVAER(K,NW,IAER)))) 185 endif 186 end do ! L_LEVELS 187 end do ! L_NSPECTV 188 end do ! naerkind 189 176 190 ! Rayleigh scattering 177 191 do NW=1,L_NSPECTV … … 328 342 DO NW=1,L_NSPECTV 329 343 DO L=1,L_NLAYRAD-1 330 K = 2*L+1 331 atemp(L,NW) = SUM(GVAER(K,NW,1:naerkind) * TAUAEROLK(K,NW,1:naerkind))+SUM(GVAER(K+1,NW,1:naerkind) * TAUAEROLK(K+1,NW,1:naerkind)) 332 btemp(L,NW) = SUM(TAUAEROLK(K,NW,1:naerkind)) + SUM(TAUAEROLK(K+1,NW,1:naerkind)) 333 ctemp(L,NW) = btemp(L,NW) + 0.9999*(TRAY(K,NW) + TRAY(K+1,NW)) ! JVO 2017 : does this 0.999 is really meaningful ? 334 btemp(L,NW) = btemp(L,NW) + TRAY(K,NW) + TRAY(K+1,NW) 335 COSBV(L,NW,1:L_NGAUSS) = atemp(L,NW)/btemp(L,NW) 344 K = 2*L+1 345 atemp(L,NW) = SUM(GVAER(K,NW,1:naerkind) * TAUAEROLK(K,NW,1:naerkind)) + & 346 SUM(GVAER(K+1,NW,1:naerkind) * TAUAEROLK(K+1,NW,1:naerkind)) 347 ! Aerosol absorption correction --> impact on single scattering albedo. 348 if (callmufi) then 349 if ((TAEROS(K,NW,1).gt.0.d0) .and. TAEROS(K+1,NW,1).gt.0.d0) then 350 btemp(L,NW) = TAUAEROLK(K,NW,1) / & 351 (QSVAER(K,NW,1)/QXVAER(K,NW,1) + & 352 Fabs_aer(1)*(1.-QSVAER(K,NW,1)/QXVAER(K,NW,1))) + & 353 TAUAEROLK(K+1,NW,1) / & 354 (QSVAER(K+1,NW,1)/QXVAER(K+1,NW,1) + & 355 Fabs_aer(1)*(1.-QSVAER(K+1,NW,1)/QXVAER(K+1,NW,1))) 356 else 357 btemp(L,NW) = TAUAEROLK(K,NW,1) + TAUAEROLK(K+1,NW,1) 358 endif 359 if ((TAEROS(K,NW,2).gt.0.d0) .and. TAEROS(K+1,NW,2).gt.0.d0) then 360 btemp(L,NW) = btemp(L,NW) + & 361 (TAUAEROLK(K,NW,2) / & 362 (QSVAER(K,NW,2)/QXVAER(K,NW,2) + & 363 Fabs_aer(2)*(1.-QSVAER(K,NW,2)/QXVAER(K,NW,2)))) + & 364 (TAUAEROLK(K+1,NW,2) / & 365 (QSVAER(K+1,NW,2)/QXVAER(K+1,NW,2) + & 366 Fabs_aer(2)*(1.-QSVAER(K+1,NW,2)/QXVAER(K+1,NW,2)))) 367 else 368 btemp(L,NW) = btemp(L,NW) + TAUAEROLK(K,NW,2) + TAUAEROLK(K+1,NW,2) 369 endif 370 else 371 btemp(L,NW) = SUM(TAUAEROLK(K,NW,1:naerkind)) + SUM(TAUAEROLK(K+1,NW,1:naerkind)) 372 endif ! callmufi 373 ctemp(L,NW) = btemp(L,NW) + 0.9999*(TRAY(K,NW) + TRAY(K+1,NW)) ! JVO 2017 : does this 0.999 is really meaningful ? 374 375 btemp(L,NW) = btemp(L,NW) + TRAY(K,NW) + TRAY(K+1,NW) 376 COSBV(L,NW,1:L_NGAUSS) = atemp(L,NW)/btemp(L,NW) 336 377 END DO ! L vertical loop 337 378 338 379 ! Last level 339 L = L_NLAYRAD 340 K = 2*L+1 380 !----------- 381 L = L_NLAYRAD 382 K = 2*L+1 341 383 atemp(L,NW) = SUM(GVAER(K,NW,1:naerkind) * TAUAEROLK(K,NW,1:naerkind)) 342 btemp(L,NW) = SUM(TAUAEROLK(K,NW,1:naerkind)) 384 ! Aerosol absorption correction --> impact on single scattering albedo. 385 if (callmufi) then 386 if (TAEROS(K,NW,1).gt.0.d0) then 387 btemp(L,NW) = TAUAEROLK(K,NW,1) / & 388 (QSVAER(K,NW,1)/QXVAER(K,NW,1) + & 389 Fabs_aer(1)*(1.-QSVAER(K,NW,1)/QXVAER(K,NW,1))) 390 else 391 btemp(L,NW) = TAUAEROLK(K,NW,1) 392 endif 393 if (TAEROS(K,NW,2).gt.0.d0) then 394 btemp(L,NW) = btemp(L,NW) + & 395 (TAUAEROLK(K,NW,2) / & 396 (QSVAER(K,NW,2)/QXVAER(K,NW,2) + & 397 Fabs_aer(2)*(1.-QSVAER(K,NW,2)/QXVAER(K,NW,2)))) 398 else 399 btemp(L,NW) = btemp(L,NW) + TAUAEROLK(K,NW,2) 400 endif 401 else 402 btemp(L,NW) = SUM(TAUAEROLK(K,NW,1:naerkind)) 403 endif ! callmufi 343 404 ctemp(L,NW) = btemp(L,NW) + 0.9999*TRAY(K,NW) ! JVO 2017 : does this 0.999 is really meaningful ? 405 344 406 btemp(L,NW) = btemp(L,NW) + TRAY(K,NW) 345 407 COSBV(L,NW,1:L_NGAUSS) = atemp(L,NW)/btemp(L,NW) 346 347 348 END DO ! NW spectral loop 408 END DO ! NW spectral loop 349 409 350 410 DO NG=1,L_NGAUSS
Note: See TracChangeset
for help on using the changeset viewer.
