Changeset 2614 for LMDZ5/trunk
- Timestamp:
- Aug 24, 2016, 5:23:21 PM (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ5/trunk/libf/phylmd/physiq_mod.F90
r2613 r2614 3172 3172 enddo 3173 3173 3174 !3175 !jq - introduce the aerosol direct and first indirect radiative forcings3176 !jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)3177 IF (flag_aerosol .gt. 0) THEN3178 IF (iflag_rrtm .EQ. 0) THEN !--old radiation3179 IF (.NOT. aerosol_couple) THEN3180 !3181 CALL readaerosol_optic( &3182 debut, new_aod, flag_aerosol, itap, jD_cur-jD_ref, &3183 pdtphys, pplay, paprs, t_seri, rhcl, presnivs, &3184 mass_solu_aero, mass_solu_aero_pi, &3185 tau_aero, piz_aero, cg_aero, &3186 tausum_aero, tau3d_aero)3187 ENDIF3188 ELSE ! RRTM radiation3189 IF (aerosol_couple .AND. config_inca == 'aero' ) THEN3190 abort_message='config_inca=aero et rrtm=1 impossible'3191 call abort_physic(modname,abort_message,1)3192 ELSE3193 !3194 #ifdef CPP_RRTM3195 IF (NSW.EQ.6) THEN3196 !--new aerosol properties3197 !3198 CALL readaerosol_optic_rrtm( debut, aerosol_couple, &3199 new_aod, flag_aerosol, itap, jD_cur-jD_ref, &3200 pdtphys, pplay, paprs, t_seri, rhcl, presnivs, &3201 tr_seri, mass_solu_aero, mass_solu_aero_pi, &3202 tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm, &3203 tausum_aero, tau3d_aero)3204 3205 ELSE IF (NSW.EQ.2) THEN3206 !--for now we use the old aerosol properties3207 !3208 CALL readaerosol_optic( &3209 debut, new_aod, flag_aerosol, itap, jD_cur-jD_ref, &3210 pdtphys, pplay, paprs, t_seri, rhcl, presnivs, &3211 mass_solu_aero, mass_solu_aero_pi, &3212 tau_aero, piz_aero, cg_aero, &3213 tausum_aero, tau3d_aero)3214 !3215 !--natural aerosols3216 tau_aero_sw_rrtm(:,:,1,:)=tau_aero(:,:,3,:)3217 piz_aero_sw_rrtm(:,:,1,:)=piz_aero(:,:,3,:)3218 cg_aero_sw_rrtm (:,:,1,:)=cg_aero (:,:,3,:)3219 !--all aerosols3220 tau_aero_sw_rrtm(:,:,2,:)=tau_aero(:,:,2,:)3221 piz_aero_sw_rrtm(:,:,2,:)=piz_aero(:,:,2,:)3222 cg_aero_sw_rrtm (:,:,2,:)=cg_aero (:,:,2,:)3223 ELSE3224 abort_message='Only NSW=2 or 6 are possible with ' &3225 // 'aerosols and iflag_rrtm=1'3226 call abort_physic(modname,abort_message,1)3227 ENDIF3228 3229 !--call LW optical properties for tropospheric aerosols3230 !--only works for INCA aerosol (aerosol_couple = TRUE)3231 CALL aeropt_lw_rrtm(aerosol_couple,paprs,tr_seri)3232 !3233 #else3234 abort_message='You should compile with -rrtm if running ' &3235 // 'with iflag_rrtm=1'3236 call abort_physic(modname,abort_message,1)3237 #endif3238 !3239 ENDIF3240 ENDIF3241 ELSE3242 tausum_aero(:,:,:) = 0.3243 IF (iflag_rrtm .EQ. 0) THEN !--old radiation3244 tau_aero(:,:,:,:) = 1.e-153245 piz_aero(:,:,:,:) = 1.3246 cg_aero(:,:,:,:) = 0.3247 ELSE3248 tau_aero_sw_rrtm(:,:,:,:) = 1.e-153249 tau_aero_lw_rrtm(:,:,:,:) = 1.e-153250 piz_aero_sw_rrtm(:,:,:,:) = 1.03251 cg_aero_sw_rrtm(:,:,:,:) = 0.03252 ENDIF3253 ENDIF3254 !3255 !--STRAT AEROSOL3256 !--updates tausum_aero,tau_aero,piz_aero,cg_aero3257 IF (flag_aerosol_strat.GT.0) THEN3258 IF (prt_level .GE.10) THEN3259 PRINT *,'appel a readaerosolstrat', mth_cur3260 ENDIF3261 IF (iflag_rrtm.EQ.0) THEN3262 IF (flag_aerosol_strat.EQ.1) THEN3263 CALL readaerosolstrato(debut)3264 ELSE3265 abort_message='flag_aerosol_strat must equal 1 for rrtm=0'3266 call abort_physic(modname,abort_message,1)3267 ENDIF3268 ELSE3269 #ifdef CPP_RRTM3270 IF (flag_aerosol_strat.EQ.1) THEN3271 CALL readaerosolstrato1_rrtm(debut)3272 ELSEIF (flag_aerosol_strat.EQ.2) THEN3273 CALL stratosphere_mask(t_seri, pplay, latitude_deg)3274 CALL readaerosolstrato2_rrtm(debut)3275 ELSE3276 abort_message='flag_aerosol_strat must equal 1 or 2 for rrtm=1'3277 call abort_physic(modname,abort_message,1)3278 ENDIF3279 #else3280 abort_message='You should compile with -rrtm if running ' &3281 // 'with iflag_rrtm=1'3282 call abort_physic(modname,abort_message,1)3283 #endif3284 ENDIF3285 ENDIF3286 !--fin STRAT AEROSOL3287 3288 3174 ! On prend la somme des fractions nuageuses et des contenus en eau 3289 3175 … … 3611 3497 !enddo 3612 3498 !albedo SB <<< 3499 3500 ! 3501 !jq - introduce the aerosol direct and first indirect radiative forcings 3502 !jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr) 3503 IF (flag_aerosol .gt. 0) THEN 3504 IF (iflag_rrtm .EQ. 0) THEN !--old radiation 3505 IF (.NOT. aerosol_couple) THEN 3506 ! 3507 CALL readaerosol_optic( & 3508 debut, new_aod, flag_aerosol, itap, jD_cur-jD_ref, & 3509 pdtphys, pplay, paprs, t_seri, rhcl, presnivs, & 3510 mass_solu_aero, mass_solu_aero_pi, & 3511 tau_aero, piz_aero, cg_aero, & 3512 tausum_aero, tau3d_aero) 3513 ENDIF 3514 ELSE ! RRTM radiation 3515 IF (aerosol_couple .AND. config_inca == 'aero' ) THEN 3516 abort_message='config_inca=aero et rrtm=1 impossible' 3517 call abort_physic(modname,abort_message,1) 3518 ELSE 3519 ! 3520 #ifdef CPP_RRTM 3521 IF (NSW.EQ.6) THEN 3522 !--new aerosol properties 3523 ! 3524 CALL readaerosol_optic_rrtm( debut, aerosol_couple, & 3525 new_aod, flag_aerosol, itap, jD_cur-jD_ref, & 3526 pdtphys, pplay, paprs, t_seri, rhcl, presnivs, & 3527 tr_seri, mass_solu_aero, mass_solu_aero_pi, & 3528 tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm, & 3529 tausum_aero, tau3d_aero) 3530 3531 ELSE IF (NSW.EQ.2) THEN 3532 !--for now we use the old aerosol properties 3533 ! 3534 CALL readaerosol_optic( & 3535 debut, new_aod, flag_aerosol, itap, jD_cur-jD_ref, & 3536 pdtphys, pplay, paprs, t_seri, rhcl, presnivs, & 3537 mass_solu_aero, mass_solu_aero_pi, & 3538 tau_aero, piz_aero, cg_aero, & 3539 tausum_aero, tau3d_aero) 3540 ! 3541 !--natural aerosols 3542 tau_aero_sw_rrtm(:,:,1,:)=tau_aero(:,:,3,:) 3543 piz_aero_sw_rrtm(:,:,1,:)=piz_aero(:,:,3,:) 3544 cg_aero_sw_rrtm (:,:,1,:)=cg_aero (:,:,3,:) 3545 !--all aerosols 3546 tau_aero_sw_rrtm(:,:,2,:)=tau_aero(:,:,2,:) 3547 piz_aero_sw_rrtm(:,:,2,:)=piz_aero(:,:,2,:) 3548 cg_aero_sw_rrtm (:,:,2,:)=cg_aero (:,:,2,:) 3549 ELSE 3550 abort_message='Only NSW=2 or 6 are possible with ' & 3551 // 'aerosols and iflag_rrtm=1' 3552 call abort_physic(modname,abort_message,1) 3553 ENDIF 3554 3555 !--call LW optical properties for tropospheric aerosols 3556 !--only works for INCA aerosol (aerosol_couple = TRUE) 3557 CALL aeropt_lw_rrtm(aerosol_couple,paprs,tr_seri) 3558 ! 3559 #else 3560 abort_message='You should compile with -rrtm if running ' & 3561 // 'with iflag_rrtm=1' 3562 call abort_physic(modname,abort_message,1) 3563 #endif 3564 ! 3565 ENDIF 3566 ENDIF 3567 ELSE 3568 tausum_aero(:,:,:) = 0. 3569 IF (iflag_rrtm .EQ. 0) THEN !--old radiation 3570 tau_aero(:,:,:,:) = 1.e-15 3571 piz_aero(:,:,:,:) = 1. 3572 cg_aero(:,:,:,:) = 0. 3573 ELSE 3574 tau_aero_sw_rrtm(:,:,:,:) = 1.e-15 3575 tau_aero_lw_rrtm(:,:,:,:) = 1.e-15 3576 piz_aero_sw_rrtm(:,:,:,:) = 1.0 3577 cg_aero_sw_rrtm(:,:,:,:) = 0.0 3578 ENDIF 3579 ENDIF 3580 ! 3581 !--STRAT AEROSOL 3582 !--updates tausum_aero,tau_aero,piz_aero,cg_aero 3583 IF (flag_aerosol_strat.GT.0) THEN 3584 IF (prt_level .GE.10) THEN 3585 PRINT *,'appel a readaerosolstrat', mth_cur 3586 ENDIF 3587 IF (iflag_rrtm.EQ.0) THEN 3588 IF (flag_aerosol_strat.EQ.1) THEN 3589 CALL readaerosolstrato(debut) 3590 ELSE 3591 abort_message='flag_aerosol_strat must equal 1 for rrtm=0' 3592 call abort_physic(modname,abort_message,1) 3593 ENDIF 3594 ELSE 3595 #ifdef CPP_RRTM 3596 IF (flag_aerosol_strat.EQ.1) THEN 3597 CALL readaerosolstrato1_rrtm(debut) 3598 ELSEIF (flag_aerosol_strat.EQ.2) THEN 3599 CALL stratosphere_mask(t_seri, pplay, latitude_deg) 3600 CALL readaerosolstrato2_rrtm(debut) 3601 ELSE 3602 abort_message='flag_aerosol_strat must equal 1 or 2 for rrtm=1' 3603 call abort_physic(modname,abort_message,1) 3604 ENDIF 3605 #else 3606 abort_message='You should compile with -rrtm if running ' & 3607 // 'with iflag_rrtm=1' 3608 call abort_physic(modname,abort_message,1) 3609 #endif 3610 ENDIF 3611 ENDIF 3612 !--fin STRAT AEROSOL 3613 3613 3614 3614 !--if ok_suntime_rrtm we use ancillay data for RSUN
Note: See TracChangeset
for help on using the changeset viewer.