Index: /LMDZ6/trunk/libf/phylmd/lmdz_call_ecrad.F90 =================================================================== --- /LMDZ6/trunk/libf/phylmd/lmdz_call_ecrad.F90 (revision 6181) +++ /LMDZ6/trunk/libf/phylmd/lmdz_call_ecrad.F90 (revision 6181) @@ -0,0 +1,764 @@ +! +! $Id: radlwsw_m.F90 6127 2026-03-26 13:59:25Z idelkadi $ +! +MODULE lmdz_call_ecrad + + IMPLICIT NONE + +CONTAINS + + SUBROUTINE call_ecrad ( & + debut, dist, rmu0, fract, & + paprs, pplay,tsol,SFRWL,alb_dir, alb_dif, & + t,q,wo,cldfra, cldemi, cldtaupd,& + tau_aero, piz_aero, cg_aero,& + tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm,& ! rajoute par OB RRTM + cldtaupi, m_allaer, qsat, flwc, fiwc, & + ref_liq, ref_ice, & + namelist_ecrad_file, & + heat,heat0,cool,cool0,albpla,& + heat_volc, cool_volc,& + topsw,toplw,solsw,solswfdiff,sollw,& + sollwdown,topsw0,toplw0,solsw0,sollw0,& + lwdnc0, lwdn0, lwdn, lwupc0, lwup0, lwup,& + swdnc0, swdn0, swdn, swupc0, swup0, swup,& + topswad_aero, solswad_aero,topswai_aero, solswai_aero, & + topswad0_aero, solswad0_aero,topsw_aero, topsw0_aero,& + solsw_aero, solsw0_aero, topswcf_aero, solswcf_aero,& + toplwad_aero, sollwad_aero,toplwai_aero, sollwai_aero, & + toplwad0_aero, sollwad0_aero, & + ZLWFT0_i, ZFLDN0, ZFLUP0, & + ZSWFT0_i, ZFSDN0, ZFSUP0, & + ZFLUX_DIR, ZFLUX_DIR_CLEAR, ZFLUX_DIR_INTO_SUN, & + cloud_cover_sw) + + ! Modules necessaires + USE DIMPHY + USE assert_m, ONLY : assert + USE write_field_phy + + USE aero_mod + USE conf_phys_m, ONLY: iflag_rrtm, ok_2xcall_ecrad, flag_aerosol_strat, ok_volcan + !ok_ade, ok_aie, ok_volcan, flag_volc_surfstrat, & + !flag_aerosol, flag_aerosol_strat, flag_aer_feedback, & + !iflag_rrtm, ok_2xcall_ecrad + ! AI 02.2021 + ! Besoin pour ECRAD de pctsrf, zmasq, longitude, altitude +#ifdef CPP_ECRAD + USE geometry_mod, ONLY: latitude, longitude + USE indice_sol_mod + USE time_phylmdz_mod, only: current_time + USE phys_cal_mod, only: day_cur + USE lmdz_ecrad_interface_m +#endif + USE yomcst_mod_h + USE clesphys_mod_h + USE yoethf_mod_h + USE phys_constants_mod, ONLY: dobson_u + USE wxios_mod, ONLY: missing_val + + USE lmdz_radiation_pre + USE lmdz_radiation_post + + ! Input arguments + REAL, INTENT(in) :: dist + REAL, INTENT(in) :: rmu0(KLON), fract(KLON) + REAL, INTENT(in) :: paprs(KLON,KLEV+1), pplay(KLON,KLEV) + !albedo SB >>> + ! REAL, INTENT(in) :: alb1(KLON), alb2(KLON), tsol(KLON) + REAL, INTENT(in) :: tsol(KLON) + REAL, INTENT(in) :: alb_dir(KLON,NSW),alb_dif(KLON,NSW) + REAL, INTENT(in) :: SFRWL(6) + !albedo SB <<< + REAL, INTENT(in) :: t(KLON,KLEV), q(KLON,KLEV) + + REAL, INTENT(in):: wo(:, :, :) ! dimension(KLON,KLEV, 1 or 2) + ! column-density of ozone in a layer, in kilo-Dobsons + ! "wo(:, :, 1)" is for the average day-night field, + ! "wo(:, :, 2)" is for daylight time. + + REAL, INTENT(in) :: cldfra(KLON,KLEV), cldemi(KLON,KLEV), cldtaupd(KLON,KLEV) + REAL, INTENT(in) :: tau_aero(KLON,KLEV,naero_grp,2) ! aerosol optical properties (see aeropt.F) + REAL, INTENT(in) :: piz_aero(KLON,KLEV,naero_grp,2) ! aerosol optical properties (see aeropt.F) + REAL, INTENT(in) :: cg_aero(KLON,KLEV,naero_grp,2) ! aerosol optical properties (see aeropt.F) + REAL, INTENT(in) :: tau_aero_sw_rrtm(KLON,KLEV,2,NSW) ! aerosol optical properties RRTM + REAL, INTENT(in) :: piz_aero_sw_rrtm(KLON,KLEV,2,NSW) ! aerosol optical properties RRTM + REAL, INTENT(in) :: cg_aero_sw_rrtm(KLON,KLEV,2,NSW) ! aerosol optical properties RRTM + + REAL, INTENT(in) :: cldtaupi(KLON,KLEV) ! cloud optical thickness for pre-industrial aerosol concentrations + REAL, INTENT(in) :: qsat(klon,klev) ! Variable pour iflag_rrtm=1 + REAL, INTENT(in) :: flwc(klon,klev) ! Variable pour iflag_rrtm=1 + REAL, INTENT(in) :: fiwc(klon,klev) ! Variable pour iflag_rrtm=1 + REAL, INTENT(in) :: ref_liq(klon,klev) ! cloud droplet radius present-day from newmicro + REAL, INTENT(in) :: ref_ice(klon,klev) ! ice crystal radius present-day from newmicro + REAL, INTENT(in) :: m_allaer(klon,klev,naero_tot) ! mass aero + + CHARACTER(len=512), INTENT(in) :: namelist_ecrad_file + LOGICAL, INTENT(in) :: debut + + ! Output arguments + REAL, INTENT(out) :: heat(KLON,KLEV), cool(KLON,KLEV) + REAL, INTENT(out) :: heat0(KLON,KLEV), cool0(KLON,KLEV) + REAL, INTENT(out) :: heat_volc(KLON,KLEV), cool_volc(KLON,KLEV) !NL + REAL, INTENT(out) :: topsw(KLON), toplw(KLON) + REAL, INTENT(out) :: solsw(KLON), sollw(KLON), albpla(KLON), solswfdiff(KLON) + REAL, INTENT(out) :: topsw0(KLON), toplw0(KLON), solsw0(KLON), sollw0(KLON) + REAL, INTENT(out) :: sollwdown(KLON) + REAL, INTENT(out) :: swdn(KLON,kflev+1),swdn0(KLON,kflev+1), swdnc0(KLON,kflev+1) + REAL, INTENT(out) :: swup(KLON,kflev+1),swup0(KLON,kflev+1), swupc0(KLON,kflev+1) + REAL, INTENT(out) :: lwdn(KLON,kflev+1),lwdn0(KLON,kflev+1), lwdnc0(KLON,kflev+1) + REAL, INTENT(out) :: lwup(KLON,kflev+1),lwup0(KLON,kflev+1), lwupc0(KLON,kflev+1) + REAL, INTENT(out) :: topswad_aero(KLON), solswad_aero(KLON) ! output: aerosol direct forcing at TOA and surface + REAL, INTENT(out) :: topswai_aero(KLON), solswai_aero(KLON) ! output: aerosol indirect forcing atTOA and surface + REAL, INTENT(out) :: toplwad_aero(KLON), sollwad_aero(KLON) ! output: LW aerosol direct forcing at TOA and surface + REAL, INTENT(out) :: toplwai_aero(KLON), sollwai_aero(KLON) ! output: LW aerosol indirect forcing atTOA and surface + REAL, DIMENSION(klon), INTENT(out) :: topswad0_aero + REAL, DIMENSION(klon), INTENT(out) :: solswad0_aero + REAL, DIMENSION(klon), INTENT(out) :: toplwad0_aero + REAL, DIMENSION(klon), INTENT(out) :: sollwad0_aero + REAL, DIMENSION(kdlon,9), INTENT(out) :: topsw_aero + REAL, DIMENSION(kdlon,9), INTENT(out) :: topsw0_aero + REAL, DIMENSION(kdlon,9), INTENT(out) :: solsw_aero + REAL, DIMENSION(kdlon,9), INTENT(out) :: solsw0_aero + REAL, DIMENSION(kdlon,3), INTENT(out) :: topswcf_aero + REAL, DIMENSION(kdlon,3), INTENT(out) :: solswcf_aero + REAL, DIMENSION(kdlon,kflev+1), INTENT(out) :: ZSWFT0_i + REAL, DIMENSION(kdlon,kflev+1), INTENT(out) :: ZLWFT0_i + + ! Local variables + REAL(KIND=8) ZFSUP(KDLON,KFLEV+1) + REAL(KIND=8) ZFSDN(KDLON,KFLEV+1) + REAL(KIND=8) ZFSUP0(KDLON,KFLEV+1) + REAL(KIND=8) ZFSDN0(KDLON,KFLEV+1) + REAL(KIND=8) ZFSUPC0(KDLON,KFLEV+1) + REAL(KIND=8) ZFSDNC0(KDLON,KFLEV+1) + REAL(KIND=8) ZFLUP(KDLON,KFLEV+1) + REAL(KIND=8) ZFLDN(KDLON,KFLEV+1) + REAL(KIND=8) ZFLUP0(KDLON,KFLEV+1) + REAL(KIND=8) ZFLDN0(KDLON,KFLEV+1) + REAL(KIND=8) ZFLUPC0(KDLON,KFLEV+1) + REAL(KIND=8) ZFLDNC0(KDLON,KFLEV+1) + REAL(KIND=8) zx_alpha1, zx_alpha2 + INTEGER k, kk, l, i, iof + INTEGER ist,iend,ktdia,kmode + REAL(KIND=8) PSCT + REAL(KIND=8) PALBD(kdlon,2), PALBP(kdlon,2) + ! MPL 06.01.09: pour RRTM, creation de PALBD_NEW et PALBP_NEW + ! avec NSW en deuxieme dimension + REAL(KIND=8) PALBD_NEW(kdlon,NSW), PALBP_NEW(kdlon,NSW) + REAL(KIND=8) PEMIS(kdlon), PDT0(kdlon), PVIEW(kdlon) + REAL(KIND=8) PPSOL(kdlon), PDP(kdlon,KLEV) + REAL(KIND=8) PTL(kdlon,kflev+1), PPMB(kdlon,kflev+1) + REAL(KIND=8) PTAVE(kdlon,kflev) + REAL(KIND=8) PWV(kdlon,kflev), PQS(kdlon,kflev) + + REAL(KIND=8) cloud_cover_sw(klon) + REAL(KIND=8), dimension(klon,klev+1) :: ZFLUX_DIR_i, & ! Direct compt of surf flux into horizontal plane + ZFLUX_DIR_CLEAR_i ! CS Direct + REAL(KIND=8), dimension(klon,klev+1) :: ZFLUX_DIR, & ! Direct compt of surf flux into horizontal plane + ZFLUX_DIR_CLEAR ! CS Direct + REAL(KIND=8), dimension(klon) :: ZFLUX_DIR_INTO_SUN + + ! Declarations specifiques pour ECRAD ! + ! AI 02.2021 +#ifdef CPP_ECRAD + ! ATTENTION les dimensions klon, kdlon ??? + ! INPUTS + REAL, DIMENSION(kdlon,kflev+1) :: ZSWFT0_ii, ZLWFT0_ii + REAL(KIND=8) ZEMISW(klon), & ! LW emissivity inside the window region + ZEMIS(klon) ! LW emissivity outside the window region + REAL(KIND=8) ZGELAM(klon), & ! longitudes en rad + ZGEMU(klon) ! sin(latitude) + REAL(KIND=8) ZCO2, & ! CO2 mass mixing ratios on full levels + ZCH4, & ! CH4 mass mixing ratios on full levels + ZN2O, & ! N2O mass mixing ratios on full levels + ZNO2, & ! NO2 mass mixing ratios on full levels + ZCFC11, & ! CFC11 + ZCFC12, & ! CFC12 + ZHCFC22, & ! HCFC22 + ZCCL4, & ! CCL4 + ZO2 ! O2 + + REAL(KIND=8) ZQ_RAIN(klon,klev), & ! Rain cloud mass mixing ratio (kg/kg) ? + ZQ_SNOW(klon,klev) ! Snow cloud mass mixing ratio (kg/kg) ? + REAL(KIND=8) ZAEROSOL_OLD(KLON,6,KLEV), & ! + ZAEROSOL(KLON,KLEV,naero_spc) ! + ! Interm + REAL(KIND=8), dimension(klon) :: ZFLUX_UV, & ! UV flux + ZFLUX_PAR, & ! photosynthetically active radiation similarly + ZFLUX_PAR_CLEAR, & ! CS photosynthetically + ZEMIS_OUT ! effective broadband emissivity + REAL(KIND=8), dimension(klon,klev+1) :: ZLWDERIVATIVE ! LW derivatives + + ! REAL(KIND=8) ZSWDIFFUSEBAND(klon,NSW), & ! SW DN flux in diffuse albedo band + ! ZSWDIRECTBAND(klon,NSW) ! SW DN flux in direct albedo band + REAL(KIND=8) SOLARIRAD + REAL(KIND=8) seuilmach + ! AI 10 mars 22 : Pour les tests Offline + logical :: lldebug_for_offline = .false. + REAL(KIND=8) & + ZCO2_off(klon,klev), & + ZCH4_off(klon,klev), & ! CH4 mass mixing ratios on full levels + ZN2O_off(klon,klev), & ! N2O mass mixing ratios on full levels + ZNO2_off(klon,klev), & ! NO2 mass mixing ratios on full levels + ZCFC11_off(klon,klev), & ! CFC11 + ZCFC12_off(klon,klev), & ! CFC12 + ZHCFC22_off(klon,klev), & ! HCFC22 + ZCCL4_off(klon,klev), & ! CCL4 + ZO2_off(klon,klev) ! O2#endif +#endif + ! + + REAL(kind=8) POZON(kdlon, kflev, size(wo, 3)) ! mass fraction of ozone + ! "POZON(:, :, 1)" is for the average day-night field, + ! "POZON(:, :, 2)" is for daylight time. + ! Modif MPL 6.01.09 avec RRTM, on passe de 5 a 6 + REAL(KIND=8) PAER(kdlon,kflev,6) + REAL(KIND=8) PCLDLD(kdlon,kflev) + REAL(KIND=8) PCLDLU(kdlon,kflev) + REAL(KIND=8) PCLDSW(kdlon,kflev) + REAL(KIND=8) PTAU(kdlon,2,kflev) + REAL(KIND=8) POMEGA(kdlon,2,kflev) + REAL(KIND=8) PCG(kdlon,2,kflev) + REAL(KIND=8) zfract(kdlon), zrmu0(kdlon), zdist + REAL(KIND=8) zheat(kdlon,kflev), zcool(kdlon,kflev) + REAL(KIND=8) zheat0(kdlon,kflev), zcool0(kdlon,kflev) + REAL(KIND=8) zheat_volc(kdlon,kflev), zcool_volc(kdlon,kflev) !NL + REAL(KIND=8) ztopsw(kdlon), ztoplw(kdlon) + REAL(KIND=8) zsolsw(kdlon), zsollw(kdlon), zalbpla(kdlon), zsolswfdiff(kdlon) + REAL(KIND=8) zsollwdown(kdlon) + REAL(KIND=8) ztopsw0(kdlon), ztoplw0(kdlon) + REAL(KIND=8) zsolsw0(kdlon), zsollw0(kdlon) + REAL(KIND=8) tauaero(kdlon,kflev,naero_grp,2) ! aer opt properties + REAL(KIND=8) pizaero(kdlon,kflev,naero_grp,2) + REAL(KIND=8) cgaero(kdlon,kflev,naero_grp,2) + REAL(KIND=8) PTAUA(kdlon,2,kflev) ! present-day value of cloud opt thickness (PTAU is pre-industrial value), local use + REAL(KIND=8) POMEGAA(kdlon,2,kflev) ! dito for single scatt albedo + REAL(KIND=8) ztopswadaero(kdlon), zsolswadaero(kdlon) ! Aerosol direct forcing at TOAand surface + REAL(KIND=8) ztopswad0aero(kdlon), zsolswad0aero(kdlon) ! Aerosol direct forcing at TOAand surface + REAL(KIND=8) ztopswaiaero(kdlon), zsolswaiaero(kdlon) ! dito, indirect + !--NL + REAL(KIND=8) zswadaero(kdlon,kflev+1) ! SW Aerosol direct forcing + REAL(KIND=8) zlwadaero(kdlon,kflev+1) ! LW Aerosol direct forcing + !-LW by CK + REAL(KIND=8) ztoplwadaero(kdlon), zsollwadaero(kdlon) ! LW Aerosol direct forcing at TOAand surface + REAL(KIND=8) ztoplwad0aero(kdlon), zsollwad0aero(kdlon) ! LW Aerosol direct forcing at TOAand surface + REAL(KIND=8) ztoplwaiaero(kdlon), zsollwaiaero(kdlon) ! dito, indirect + !-end + REAL(KIND=8) ztopsw_aero(kdlon,9), ztopsw0_aero(kdlon,9) + REAL(KIND=8) zsolsw_aero(kdlon,9), zsolsw0_aero(kdlon,9) + REAL(KIND=8) ztopswcf_aero(kdlon,3), zsolswcf_aero(kdlon,3) + !MPL input supplementaires pour RECMWFL + ! flwc, fiwc = Liquid Water Content & Ice Water Content (kg/kg) + !MPL input RECMWFL: + ! Tableaux aux niveaux inverses pour respecter convention Arpege + REAL(KIND=8) ref_liq_i(klon,klev) ! cloud droplet radius present-day from newmicro (inverted) + REAL(KIND=8) ref_ice_i(klon,klev) ! ice crystal radius present-day from newmicro (inverted) + !--OB + !REAL(KIND=8) ref_liq_pi_i(klon,klev) ! cloud droplet radius pre-industrial from newmicro (inverted) + !REAL(KIND=8) ref_ice_pi_i(klon,klev) ! ice crystal radius pre-industrial from newmicro (inverted) + !--end OB + REAL(KIND=8) paprs_i(klon,klev+1) + REAL(KIND=8) pplay_i(klon,klev) + REAL(KIND=8) cldfra_i(klon,klev) + REAL(KIND=8) POZON_i(kdlon,kflev, size(wo, 3)) ! mass fraction of ozone + ! "POZON(:, :, 1)" is for the average day-night field, + ! "POZON(:, :, 2)" is for daylight time. + ! Modif MPL 6.01.09 avec RRTM, on passe de 5 a 6 + REAL(KIND=8) PAER_i(kdlon,kflev,6) + REAL(KIND=8) PDP_i(klon,klev) + REAL(KIND=8) t_i(klon,klev),q_i(klon,klev),qsat_i(klon,klev) + REAL(KIND=8) flwc_i(klon,klev),fiwc_i(klon,klev) + !MPL output RECMWFL: + REAL(KIND=8) ZEMTD (klon,klev+1),ZEMTD_i (klon,klev+1) + REAL(KIND=8) ZEMTU (klon,klev+1),ZEMTU_i (klon,klev+1) + REAL(KIND=8) ZTRSO (klon,klev+1),ZTRSO_i (klon,klev+1) + REAL(KIND=8) ZTH_i (klon,klev+1) + REAL(KIND=8) ZLWFT (klon,klev+1),ZLWFT_i (klon,klev+1) + REAL(KIND=8) ZSWFT (klon,klev+1),ZSWFT_i (klon,klev+1) + REAL(KIND=8) PSFSWDIR(klon,NSW) + REAL(KIND=8) PSFSWDIF(klon,NSW) + !MPL On ne redefinit pas les tableaux ZFLUX,ZFLUC, + !MPL ZFSDWN,ZFCDWN,ZFSUP,ZFCUP car ils existent deja + !MPL sous les noms de ZFLDN,ZFLDN0,ZFLUP,ZFLUP0, + !MPL ZFSDN,ZFSDN0,ZFSUP,ZFSUP0 + REAL(KIND=8) ZFLUX_i (klon,2,klev+1) + REAL(KIND=8) ZFLUC_i (klon,2,klev+1) + + REAL(KIND=8) ZFSDWN_i (klon,klev+1) + REAL(KIND=8) ZFCDWN_i (klon,klev+1) + REAL(KIND=8) ZFCCDWN_i (klon,klev+1) + REAL(KIND=8) ZFSUP_i (klon,klev+1) + REAL(KIND=8) ZFCUP_i (klon,klev+1) + REAL(KIND=8) ZFCCUP_i (klon,klev+1) + REAL(KIND=8) ZFLCCDWN_i (klon,klev+1) + REAL(KIND=8) ZFLCCUP_i (klon,klev+1) + ! 3 lignes suivantes a activer pour CCMVAL (MPL 20100412) + ! REAL(KIND=8) RSUN(3,2) + ! REAL(KIND=8) SUN(3) + ! REAL(KIND=8) SUN_FRACT(2) + CHARACTER (LEN=80) :: abort_message + CHARACTER (LEN=80) :: modname='radlwsw_m' + + REAL zdir(klon), zdif(klon) + INTEGER :: dimoz + + dimoz=size(wo,3) + + CALL radiation_pre( & + ist,iend,ktdia,kmode, & + dist, rmu0, fract, & + paprs, pplay,tsol,SFRWL,alb_dir, alb_dif, & + t,q,wo,cldfra, cldemi, cldtaupd,& + tau_aero, piz_aero, cg_aero,& + tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm,& + cldtaupi, qsat, flwc, fiwc, iof, & + heat,heat0,cool,cool0,heat_volc, cool_volc,& + zheat,zheat0,zcool,zcool0,zheat_volc, zcool_volc,& + zdist,PSCT,zfract,zrmu0, & + PAER,PCLDLD,PCLDLU,PCLDSW,& + PTAU,PTAUA,POMEGA,POMEGAA,PCG, & + PALBD,PALBP,PALBD_NEW,PALBP_NEW,& + PEMIS,PDT0,PVIEW,PPSOL,PDP, & + PTL,PPMB,PTAVE,PWV,PQS, & + zx_alpha1,zx_alpha2,POZON, & + tauaero,pizaero,cgaero, & + ztopsw_aero,ztopsw0_aero,zsolsw_aero,zsolsw0_aero, & + ztopswcf_aero,zsolswcf_aero, & + ztopswadaero,zsolswadaero,ztopswad0aero, & + zsolswad0aero,zsollwadaero,zsollwad0aero, & + ztopswaiaero,zsolswaiaero,ztoplwaiaero,zsollwaiaero) + ! + !===== iflag_rrtm ================================================ + ! + ! AI fev 2021 + IF(iflag_rrtm == 2) THEN + print*,'Traitement cas iflag_rrtm = ',iflag_rrtm + ! print*,'Mise a zero des flux ' +#ifdef CPP_ECRAD + ZEMIS = 1.0 + ZEMISW = 1.0 + ZGELAM = longitude + ZGEMU = sin(latitude) + ZCO2 = RCO2 + ZCH4 = RCH4 + ZN2O = RN2O + ZNO2 = 0.0 + ZCFC11 = RCFC11 + ZCFC12 = RCFC12 + ZHCFC22 = 0.0 + ZO2 = 0.0 + ZCCL4 = 0.0 + ZQ_RAIN = 0.0 + ZQ_SNOW = 0.0 + ZAEROSOL_OLD = 0.0 + ZAEROSOL = 0.0 + seuilmach=tiny(seuilmach) + + DO k = 1, kflev+1 + DO i = 1, kdlon + ZEMTD_i(i,k)=0. + ZEMTU_i(i,k)=0. + ZTRSO_i(i,k)=0. + ZTH_i(i,k)=0. + ZLWFT_i(i,k)=0. + ZSWFT_i(i,k)=0. + ZFLUX_i(i,1,k)=0. + ZFLUX_i(i,2,k)=0. + ZFLUC_i(i,1,k)=0. + ZFLUC_i(i,2,k)=0. + ZFSDWN_i(i,k)=0. + ZFCDWN_i(i,k)=0. + ZFCCDWN_i(i,k)=0. + ZFSUP_i(i,k)=0. + ZFCUP_i(i,k)=0. + ZFCCUP_i(i,k)=0. + ZFLCCDWN_i(i,k)=0. + ZFLCCUP_i(i,k)=0. + ENDDO + ENDDO + ! + ! AI ATTENTION Aerosols A REVOIR + DO kk= 1, naero_spc + DO k = 1, kflev + DO i = 1, kdlon + ! DO kk=1, NSW + ! + ! PTAU_TOT(i,kflev+1-k,kk)=tau_aero_sw_rrtm(i,k,2,kk) + ! PPIZA_TOT(i,kflev+1-k,kk)=piz_aero_sw_rrtm(i,k,2,kk) + ! PCGA_TOT(i,kflev+1-k,kk)=cg_aero_sw_rrtm(i,k,2,kk) + ! + ! PTAU_NAT(i,kflev+1-k,kk)=tau_aero_sw_rrtm(i,k,1,kk) + ! PPIZA_NAT(i,kflev+1-k,kk)=piz_aero_sw_rrtm(i,k,1,kk) + ! PCGA_NAT(i,kflev+1-k,kk)=cg_aero_sw_rrtm(i,k,1,kk) + ! ZAEROSOL(i,kflev+1-k,kk)=m_allaer(i,k,kk) + ZAEROSOL(i,kflev+1-k,kk)=m_allaer(i,k,kk) + ! + ENDDO + ENDDO + ENDDO + !-end OB + ! + ! DO i = 1, kdlon + ! DO k = 1, kflev + ! DO kk=1, NLW + ! + ! PTAU_LW_TOT(i,kflev+1-k,kk)=tau_aero_lw_rrtm(i,k,2,kk) + ! PTAU_LW_NAT(i,kflev+1-k,kk)=tau_aero_lw_rrtm(i,k,1,kk) + ! + ! ENDDO + ! ENDDO + ! ENDDO + !-end C. Kleinschmitt + ! + + DO kk = 1, NSW + DO i = 1, kdlon + PSFSWDIR(i,kk)=0. + PSFSWDIF(i,kk)=0. + ENDDO + ENDDO + !----- Fin des mises a zero des tableaux output ------------------- + + ! On met les donnees dans l'ordre des niveaux ecrad + ! print*,'On inverse sur la verticale ' + paprs_i(:,1)=paprs(:,klev+1) + DO k=1,klev + DO i=1,klon + paprs_i(i,k+1) =paprs(i,klev+1-k) + pplay_i(i,k) =pplay(i,klev+1-k) + cldfra_i(i,k) =cldfra(i,klev+1-k) + PDP_i(i,k) =PDP(i,klev+1-k) + t_i(i,k) =t(i,klev+1-k) + q_i(i,k) =q(i,klev+1-k) + qsat_i(i,k) =qsat(i,klev+1-k) + flwc_i(i,k) =flwc(i,klev+1-k) + fiwc_i(i,k) =fiwc(i,klev+1-k) + ref_liq_i(i,k) =ref_liq(i,klev+1-k)*1.0e-6 + ref_ice_i(i,k) =ref_ice(i,klev+1-k)*1.0e-6 + !-OB + !ref_liq_pi_i(i,k) =ref_liq_pi(i,klev+1-k) + !ref_ice_pi_i(i,k) =ref_ice_pi(i,klev+1-k) + ENDDO + ENDDO + + DO l=1,dimoz + DO k=1,kflev + POZON_i(1:klon,k,l)=POZON(1:klon,kflev+1-k,l) + ! ZO3_DP_i(1:klon,k)=ZO3_DP(1:klon,kflev+1-k) + ! DO i=1,6 + PAER_i(1:klon,k,l)=PAER(1:klon,kflev+1-k,l) + ! ENDDO + ENDDO + ENDDO + + ! A. Idelkadi 11.2021 + ! Calcul de ZTH_i (temp aux interfaces 1:klev+1) + ! IFS currently sets the half-level temperature at the surface to be + ! equal to the skin temperature. The radiation scheme takes as input + ! only the half-level temperatures and assumes the Planck function to + ! vary linearly in optical depth between half levels. In the lowest + ! atmospheric layer, where the atmospheric temperature can be much + ! cooler than the skin temperature, this can lead to significant + ! differences between the effective temperature of this lowest layer + ! and the true value in the model. + ! We may approximate the temperature profile in the lowest model level + ! as piecewise linear between the top of the layer T[k-1/2], the + ! centre of the layer T[k] and the base of the layer Tskin. The mean + ! temperature of the layer is then 0.25*T[k-1/2] + 0.5*T[k] + + ! 0.25*Tskin, which can be achieved by setting the atmospheric + ! temperature at the half-level corresponding to the surface as + ! follows: + ! AI ATTENTION fais dans interface radlw + !thermodynamics%temperature_hl(KIDIA:KFDIA,KLEV+1) & + ! & = PTEMPERATURE(KIDIA:KFDIA,KLEV) & + ! & + 0.5_JPRB * (PTEMPERATURE_H(KIDIA:KFDIA,KLEV+1) & + ! & -PTEMPERATURE_H(KIDIA:KFDIA,KLEV)) + + DO K=2,KLEV + DO i = 1, kdlon + ZTH_i(i,K)=& + & (t_i(i,K-1)*pplay_i(i,K-1)*(pplay_i(i,K)-paprs_i(i,K))& + & +t_i(i,K)*pplay_i(i,K)*(paprs_i(i,K)-pplay_i(i,K-1)))& + & *(1.0/(paprs_i(i,K)*(pplay_i(i,K)-pplay_i(i,K-1)))) + ENDDO + ENDDO + DO i = 1, kdlon + ! Sommet + ZTH_i(i,1)=t_i(i,1)-pplay_i(i,1)*(t_i(i,1)-ZTH_i(i,2))& + & /(pplay_i(i,1)-paprs_i(i,2)) + ! Vers le sol + ZTH_i(i,KLEV+1)=t_i(i,KLEV) + 0.5 * & + (tsol(i) - ZTH_i(i,KLEV)) + ENDDO + + + print *,'RADLWSW: avant RADIATION_SCHEME ' + + ! AI mars 2022 + SOLARIRAD = solaire/zdist/zdist + ! diagnos pour la comparaison a la version offline + ! - Gas en VMR pour offline et MMR pour online + ! - on utilise pour solarirrad une valeur constante + if (lldebug_for_offline) then + SOLARIRAD = 1366.0896 + ZCH4_off = CH4_ppb*1e-9 + ZN2O_off = N2O_ppb*1e-9 + ZNO2_off = 0.0 + ZCFC11_off = CFC11_ppt*1e-12 + ZCFC12_off = CFC12_ppt*1e-12 + ZHCFC22_off = 0.0 + ZCCL4_off = 0.0 + ZO2_off = 0.0 + ZCO2_off = co2_ppm*1e-6 + + CALL writefield_phy('rmu0',rmu0,1) + CALL writefield_phy('tsol',tsol,1) + CALL writefield_phy('emissiv_out',ZEMIS,1) + CALL writefield_phy('paprs_i',paprs_i,klev+1) + CALL writefield_phy('ZTH_i',ZTH_i,klev+1) + CALL writefield_phy('cldfra_i',cldfra_i,klev) + CALL writefield_phy('q_i',q_i,klev) + CALL writefield_phy('fiwc_i',fiwc_i,klev) + CALL writefield_phy('flwc_i',flwc_i,klev) + CALL writefield_phy('palbd_new',PALBD_NEW,NSW) + CALL writefield_phy('palbp_new',PALBP_NEW,NSW) + CALL writefield_phy('POZON',POZON_i(:,:,1),klev) + CALL writefield_phy('ZCO2',ZCO2_off,klev) + CALL writefield_phy('ZCH4',ZCH4_off,klev) + CALL writefield_phy('ZN2O',ZN2O_off,klev) + CALL writefield_phy('ZO2',ZO2_off,klev) + CALL writefield_phy('ZNO2',ZNO2_off,klev) + CALL writefield_phy('ZCFC11',ZCFC11_off,klev) + CALL writefield_phy('ZCFC12',ZCFC12_off,klev) + CALL writefield_phy('ZHCFC22',ZHCFC22_off,klev) + CALL writefield_phy('ZCCL4',ZCCL4_off,klev) + CALL writefield_phy('ref_liq_i',ref_liq_i,klev) + CALL writefield_phy('ref_ice_i',ref_ice_i,klev) + endif + ! lldebug_for_offline + + if (namelist_ecrad_file.eq.'namelist_ecrad') then + print*,' 1er apell Ecrad : ok_2xcall_ecrad, namelist_ecrad_file = ', & + ok_2xcall_ecrad, namelist_ecrad_file + CALL lmdz_ecrad_interface & + ! inputs + & (ist, iend, klon, klev, naero_spc, NSW, & + & namelist_ecrad_file, ok_2xcall_ecrad, & + & debut, ok_volcan, flag_aerosol_strat, & + & day_cur, current_time, & + & SOLARIRAD, & ! Cste solaire/(d_Terre-Soleil)**2 + & rmu0, tsol, & ! Cos(angle zin), temp sol + & PALBD_NEW,PALBP_NEW, & ! Albedo diffuse et directe + & ZEMIS, ZEMISW, & ! Emessivite : PEMIS_WINDOW (???), + & ZGELAM, ZGEMU, & ! longitude(rad), sin(latitude), PMASQ_ ??? + & paprs_i, ZTH_i, q_i, qsat_i, & ! Temp et pres aux interf, vapeur eau, Satur spec humid + & ZCO2, ZCH4, ZN2O, ZNO2, ZCFC11, ZCFC12, ZHCFC22, & ! Gas + & ZCCL4, POZON_i(:,:,1), ZO2, & + & cldfra_i, flwc_i, fiwc_i, ZQ_SNOW, & ! Nuages + & ref_liq_i, ref_ice_i, & ! rayons effectifs des gouttelettes + & ZAEROSOL_OLD, ZAEROSOL, & ! aerosols + ! Outputs + & ZSWFT_i, ZLWFT_i, ZSWFT0_ii, ZLWFT0_ii, & ! Net flux + & ZFSDWN_i, ZFLUX_i(:,2,:), ZFCDWN_i, ZFLUC_i(:,2,:), & ! DWN flux + & ZFSUP_i, ZFLUX_i(:,1,:), ZFCUP_i, ZFLUC_i(:,1,:), & ! UP flux + & ZFLUX_DIR_i, ZFLUX_DIR_CLEAR_i, ZFLUX_DIR_INTO_SUN, & ! Direct flux + & ZFLUX_UV, ZFLUX_PAR, ZFLUX_PAR_CLEAR, & ! UV and para flux + & ZEMIS_OUT, ZLWDERIVATIVE, & ! + & PSFSWDIF, PSFSWDIR, & + & cloud_cover_sw) + else + print*,' 2e apell Ecrad : ok_2xcall_ecrad, namelist_ecrad_file = ', & + ok_2xcall_ecrad, namelist_ecrad_file + CALL lmdz_ecrad_interface_2call & + & (ist, iend, klon, klev, naero_grp, NSW, & + & namelist_ecrad_file, ok_2xcall_ecrad, & + & debut, ok_volcan, flag_aerosol_strat, & + & day_cur, current_time, & + & SOLARIRAD, & + & rmu0, tsol, & + & PALBD_NEW,PALBP_NEW, & + & ZEMIS, ZEMISW, & + & ZGELAM, ZGEMU, & + & paprs_i, ZTH_i, q_i, qsat_i, & + & ZCO2, ZCH4, ZN2O, ZNO2, ZCFC11, ZCFC12, ZHCFC22, & + & ZCCL4, POZON_i(:,:,1), ZO2, & + & cldfra_i, flwc_i, fiwc_i, ZQ_SNOW, & + & ref_liq_i, ref_ice_i, & + & ZAEROSOL_OLD, ZAEROSOL, & + & ZSWFT_i, ZLWFT_i, ZSWFT0_ii, ZLWFT0_ii, & + & ZFSDWN_i, ZFLUX_i(:,2,:), ZFCDWN_i, ZFLUC_i(:,2,:), & + & ZFSUP_i, ZFLUX_i(:,1,:), ZFCUP_i, ZFLUC_i(:,1,:), & + & ZFLUX_DIR_i, ZFLUX_DIR_CLEAR_i, ZFLUX_DIR_INTO_SUN, & + & ZFLUX_UV, ZFLUX_PAR, ZFLUX_PAR_CLEAR, & + & ZEMIS_OUT, ZLWDERIVATIVE, & + & PSFSWDIF, PSFSWDIR, & + & cloud_cover_sw) + endif + + + print *,'========= CALL_ECRAD apres RADIATION_SCHEME ==================== ' + + if (lldebug_for_offline) then + CALL writefield_phy('FLUX_LW',ZLWFT_i,klev+1) + CALL writefield_phy('FLUX_LW_CLEAR',ZLWFT0_ii,klev+1) + CALL writefield_phy('FLUX_SW',ZSWFT_i,klev+1) + CALL writefield_phy('FLUX_SW_CLEAR',ZSWFT0_ii,klev+1) + CALL writefield_phy('FLUX_DN_SW',ZFSDWN_i,klev+1) + CALL writefield_phy('FLUX_DN_LW',ZFLUX_i(:,2,:),klev+1) + CALL writefield_phy('FLUX_DN_SW_CLEAR',ZFCDWN_i,klev+1) + CALL writefield_phy('FLUX_DN_LW_CLEAR',ZFLUC_i(:,2,:),klev+1) + CALL writefield_phy('PSFSWDIR',PSFSWDIR,6) + CALL writefield_phy('PSFSWDIF',PSFSWDIF,6) + CALL writefield_phy('FLUX_UP_LW',ZFLUX_i(:,1,:),klev+1) + CALL writefield_phy('FLUX_UP_LW_CLEAR',ZFLUC_i(:,1,:),klev+1) + CALL writefield_phy('FLUX_UP_SW',ZFSUP_i,klev+1) + CALL writefield_phy('FLUX_UP_SW_CLEAR',ZFCUP_i,klev+1) + endif + + ! --------- + ! On retablit l'ordre des niveaux lmd pour les tableaux de sortie + ! D autre part, on multiplie les resultats SW par fract pour etre coherent + ! avec l ancien rayonnement AR4. Si nuit, fract=0 donc pas de + ! rayonnement SW. (MPL 260609) + print*,'On retablit l ordre des niveaux verticaux pour LMDZ' + print*,'On multiplie les flux SW par fract et LW dwn par -1' + DO k=0,klev + DO i=1,klon + ZEMTD(i,k+1) = ZEMTD_i(i,klev+1-k) + ZEMTU(i,k+1) = ZEMTU_i(i,klev+1-k) + ZTRSO(i,k+1) = ZTRSO_i(i,klev+1-k) + ! ZTH(i,k+1) = ZTH_i(i,klev+1-k) + ! AI ATTENTION + ZLWFT(i,k+1) = ZLWFT_i(i,klev+1-k) + ZSWFT(i,k+1) = ZSWFT_i(i,klev+1-k)*fract(i) + ZSWFT0_i(i,k+1) = ZSWFT0_ii(i,klev+1-k)*fract(i) + ZLWFT0_i(i,k+1) = ZLWFT0_ii(i,klev+1-k) + ! + ZFLUP(i,k+1) = ZFLUX_i(i,1,klev+1-k) + ZFLDN(i,k+1) = -1.*ZFLUX_i(i,2,klev+1-k) + ZFLUP0(i,k+1) = ZFLUC_i(i,1,klev+1-k) + ZFLDN0(i,k+1) = -1.*ZFLUC_i(i,2,klev+1-k) + ZFSDN(i,k+1) = ZFSDWN_i(i,klev+1-k)*fract(i) + ZFSDN0(i,k+1) = ZFCDWN_i(i,klev+1-k)*fract(i) + ZFSDNC0(i,k+1)= ZFCCDWN_i(i,klev+1-k)*fract(i) + ZFSUP (i,k+1) = ZFSUP_i(i,klev+1-k)*fract(i) + ZFSUP0(i,k+1) = ZFCUP_i(i,klev+1-k)*fract(i) + ZFSUPC0(i,k+1)= ZFCCUP_i(i,klev+1-k)*fract(i) + ZFLDNC0(i,k+1)= -1.*ZFLCCDWN_i(i,klev+1-k) + ZFLUPC0(i,k+1)= ZFLCCUP_i(i,klev+1-k) + ! Direct flux + ZFLUX_DIR(i,k+1) = ZFLUX_DIR_i(i,klev+1-k) + ZFLUX_DIR_CLEAR(i,k+1) = ZFLUX_DIR_CLEAR_i(i,klev+1-k) + IF (ok_volcan) THEN + ZSWADAERO(i,k+1)=ZSWADAERO(i,klev+1-k)*fract(i) !--NL + ENDIF + + ! Nouveau calcul car visiblement ZSWFT et ZSWFC sont nuls dans RRTM cy32 + ! en sortie de radlsw.F90 - MPL 7.01.09 + ! AI ATTENTION + ! ZSWFT(i,k+1) = (ZFSDWN_i(i,k+1)-ZFSUP_i(i,k+1))*fract(i) + ! ZSWFT0_i(i,k+1) = (ZFCDWN_i(i,k+1)-ZFCUP_i(i,k+1))*fract(i) + ! ZLWFT(i,k+1) =-ZFLUX_i(i,2,k+1)-ZFLUX_i(i,1,k+1) + ! ZLWFT0_i(i,k+1)=-ZFLUC_i(i,2,k+1)-ZFLUC_i(i,1,k+1) + ENDDO + ENDDO + + !--ajout OB + ZTOPSWADAERO(:) =ZTOPSWADAERO(:) *fract(:) + ZSOLSWADAERO(:) =ZSOLSWADAERO(:) *fract(:) + ZTOPSWAD0AERO(:)=ZTOPSWAD0AERO(:)*fract(:) + ZSOLSWAD0AERO(:)=ZSOLSWAD0AERO(:)*fract(:) + ZTOPSWAIAERO(:) =ZTOPSWAIAERO(:) *fract(:) + ZSOLSWAIAERO(:) =ZSOLSWAIAERO(:) *fract(:) + ZTOPSWCF_AERO(:,1)=ZTOPSWCF_AERO(:,1)*fract(:) + ZTOPSWCF_AERO(:,2)=ZTOPSWCF_AERO(:,2)*fract(:) + ZTOPSWCF_AERO(:,3)=ZTOPSWCF_AERO(:,3)*fract(:) + ZSOLSWCF_AERO(:,1)=ZSOLSWCF_AERO(:,1)*fract(:) + ZSOLSWCF_AERO(:,2)=ZSOLSWCF_AERO(:,2)*fract(:) + ZSOLSWCF_AERO(:,3)=ZSOLSWCF_AERO(:,3)*fract(:) + ztoplwadaero = missing_val + ztoplwad0aero = missing_val + + ! --------- + ! On renseigne les champs LMDz, pour avoir la meme chose qu'en sortie de + ! LW_LMDAR4 et SW_LMDAR4 + + !--fraction of diffuse radiation in surface SW downward radiation + + zdir(:)=0. + zdif(:)=0. + DO k=1,nsw + DO i = 1, kdlon + zdir(i)=zdir(i)+PSFSWDIR(i,k) + zdif(i)=zdif(i)+PSFSWDIF(i,k) + ENDDO + ENDDO + + DO i = 1, kdlon + IF (fract(i).GT.0.0.and.(zdir(i)+zdif(i)).gt.seuilmach) THEN + zsolswfdiff(i) = zdif(i)/(zdir(i)+zdif(i)) + ELSE !--night + zsolswfdiff(i) = 1.0 + ENDIF + ENDDO + ! + DO i = 1, kdlon + zsolsw(i) = ZSWFT(i,1) + zsolsw0(i) = ZSWFT0_i(i,1) + ztopsw(i) = ZSWFT(i,klev+1) + ztopsw0(i) = ZSWFT0_i(i,klev+1) + zsollw(i) = ZLWFT(i,1) + zsollw0(i) = ZLWFT0_i(i,1) + ztoplw(i) = ZLWFT(i,klev+1)*(-1) + ztoplw0(i) = ZLWFT0_i(i,klev+1)*(-1) + ! + zsollwdown(i)= -1.*ZFLDN(i,1) + ENDDO + + DO k=1,kflev + DO i=1,kdlon + zheat(i,k)=(ZSWFT(i,k+1)-ZSWFT(i,k))*RDAY*RG/RCPD/PDP(i,k) + zheat0(i,k)=(ZSWFT0_i(i,k+1)-ZSWFT0_i(i,k))*RDAY*RG/RCPD/PDP(i,k) + zcool(i,k)=(ZLWFT(i,k)-ZLWFT(i,k+1))*RDAY*RG/RCPD/PDP(i,k) + zcool0(i,k)=(ZLWFT0_i(i,k)-ZLWFT0_i(i,k+1))*RDAY*RG/RCPD/PDP(i,k) + IF (ok_volcan) THEN + zheat_volc(i,k)=(ZSWADAERO(i,k+1)-ZSWADAERO(i,k))*RG/RCPD/PDP(i,k) !NL + zcool_volc(i,k)=(ZLWADAERO(i,k)-ZLWADAERO(i,k+1))*RG/RCPD/PDP(i,k) !NL + ENDIF + ENDDO + ENDDO +#endif + print*,'Fin traitement ECRAD' + ! Fin ECRAD + ENDIF !test_iflag_rrtm + ! ecrad + !====================================================================== + + CALL radiation_post( & + iof,PWV, & + ZFSUP,ZFSDN,ZFSUP0,ZFSDN0, & + ZFSUPC0,ZFSDNC0,ZFLUP,ZFLDN, & + ZFLUP0,ZFLDN0,ZFLUPC0,ZFLDNC0, & + zheat,zcool,zheat0,zcool0,zheat_volc,zcool_volc, & + ztopsw,ztoplw,zsolsw,zsollw,zalbpla,zsolswfdiff, & + zsollwdown,ztopsw0,ztoplw0,zsolsw0,zsollw0, & + ztopswadaero,zsolswadaero,ztopswad0aero,zsolswad0aero, & + ztopswaiaero,zsolswaiaero,ztoplwadaero,zsollwadaero, & + ztoplwad0aero,zsollwad0aero,ztoplwaiaero,zsollwaiaero, & + ztopsw_aero,ztopsw0_aero,zsolsw_aero,zsolsw0_aero, & + ztopswcf_aero,zsolswcf_aero, & + heat,heat0,cool,cool0,albpla,heat_volc, cool_volc,& + topsw,toplw,solsw,solswfdiff,sollw,sollwdown,& + topsw0,toplw0,solsw0,sollw0,& + lwdnc0,lwdn0,lwdn,lwupc0,lwup0,lwup,& + swdnc0,swdn0,swdn,swupc0,swup0,swup,& + topswad_aero,solswad_aero,topswai_aero,solswai_aero, & + topswad0_aero,solswad0_aero,topsw_aero,topsw0_aero,& + solsw_aero,solsw0_aero,topswcf_aero,solswcf_aero,& + toplwad_aero,sollwad_aero,toplwai_aero,sollwai_aero, & + toplwad0_aero,sollwad0_aero,& + cloud_cover_sw,ZFLUX_DIR,ZFLUX_DIR_CLEAR,ZFLUX_DIR_INTO_SUN) + + END SUBROUTINE call_ecrad +END MODULE lmdz_call_ecrad Index: DZ6/trunk/libf/phylmd/lmdz_call_ecrad_m.F90 =================================================================== --- /LMDZ6/trunk/libf/phylmd/lmdz_call_ecrad_m.F90 (revision 6180) +++ (revision ) @@ -1,764 +1,0 @@ -! -! $Id: radlwsw_m.F90 6127 2026-03-26 13:59:25Z idelkadi $ -! -MODULE lmdz_call_ecrad_m - - IMPLICIT NONE - -CONTAINS - - SUBROUTINE lmdz_call_ecrad( & - debut, dist, rmu0, fract, & - paprs, pplay,tsol,SFRWL,alb_dir, alb_dif, & - t,q,wo,cldfra, cldemi, cldtaupd,& - tau_aero, piz_aero, cg_aero,& - tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm,& ! rajoute par OB RRTM - cldtaupi, m_allaer, qsat, flwc, fiwc, & - ref_liq, ref_ice, & - namelist_ecrad_file, & - heat,heat0,cool,cool0,albpla,& - heat_volc, cool_volc,& - topsw,toplw,solsw,solswfdiff,sollw,& - sollwdown,topsw0,toplw0,solsw0,sollw0,& - lwdnc0, lwdn0, lwdn, lwupc0, lwup0, lwup,& - swdnc0, swdn0, swdn, swupc0, swup0, swup,& - topswad_aero, solswad_aero,topswai_aero, solswai_aero, & - topswad0_aero, solswad0_aero,topsw_aero, topsw0_aero,& - solsw_aero, solsw0_aero, topswcf_aero, solswcf_aero,& - toplwad_aero, sollwad_aero,toplwai_aero, sollwai_aero, & - toplwad0_aero, sollwad0_aero, & - ZLWFT0_i, ZFLDN0, ZFLUP0, & - ZSWFT0_i, ZFSDN0, ZFSUP0, & - ZFLUX_DIR, ZFLUX_DIR_CLEAR, ZFLUX_DIR_INTO_SUN, & - cloud_cover_sw) - - ! Modules necessaires - USE DIMPHY - USE assert_m, ONLY : assert - USE write_field_phy - - USE aero_mod - USE conf_phys_m, ONLY: iflag_rrtm, ok_2xcall_ecrad, flag_aerosol_strat, ok_volcan - !ok_ade, ok_aie, ok_volcan, flag_volc_surfstrat, & - !flag_aerosol, flag_aerosol_strat, flag_aer_feedback, & - !iflag_rrtm, ok_2xcall_ecrad - ! AI 02.2021 - ! Besoin pour ECRAD de pctsrf, zmasq, longitude, altitude -#ifdef CPP_ECRAD - USE geometry_mod, ONLY: latitude, longitude - USE indice_sol_mod - USE time_phylmdz_mod, only: current_time - USE phys_cal_mod, only: day_cur - USE lmdz_ecrad_interface_m -#endif - USE yomcst_mod_h - USE clesphys_mod_h - USE yoethf_mod_h - USE phys_constants_mod, ONLY: dobson_u - USE wxios_mod, ONLY: missing_val - - USE lmdz_rad_ini_m - USE lmdz_rad_out_m - - ! Input arguments - REAL, INTENT(in) :: dist - REAL, INTENT(in) :: rmu0(KLON), fract(KLON) - REAL, INTENT(in) :: paprs(KLON,KLEV+1), pplay(KLON,KLEV) - !albedo SB >>> - ! REAL, INTENT(in) :: alb1(KLON), alb2(KLON), tsol(KLON) - REAL, INTENT(in) :: tsol(KLON) - REAL, INTENT(in) :: alb_dir(KLON,NSW),alb_dif(KLON,NSW) - REAL, INTENT(in) :: SFRWL(6) - !albedo SB <<< - REAL, INTENT(in) :: t(KLON,KLEV), q(KLON,KLEV) - - REAL, INTENT(in):: wo(:, :, :) ! dimension(KLON,KLEV, 1 or 2) - ! column-density of ozone in a layer, in kilo-Dobsons - ! "wo(:, :, 1)" is for the average day-night field, - ! "wo(:, :, 2)" is for daylight time. - - REAL, INTENT(in) :: cldfra(KLON,KLEV), cldemi(KLON,KLEV), cldtaupd(KLON,KLEV) - REAL, INTENT(in) :: tau_aero(KLON,KLEV,naero_grp,2) ! aerosol optical properties (see aeropt.F) - REAL, INTENT(in) :: piz_aero(KLON,KLEV,naero_grp,2) ! aerosol optical properties (see aeropt.F) - REAL, INTENT(in) :: cg_aero(KLON,KLEV,naero_grp,2) ! aerosol optical properties (see aeropt.F) - REAL, INTENT(in) :: tau_aero_sw_rrtm(KLON,KLEV,2,NSW) ! aerosol optical properties RRTM - REAL, INTENT(in) :: piz_aero_sw_rrtm(KLON,KLEV,2,NSW) ! aerosol optical properties RRTM - REAL, INTENT(in) :: cg_aero_sw_rrtm(KLON,KLEV,2,NSW) ! aerosol optical properties RRTM - - REAL, INTENT(in) :: cldtaupi(KLON,KLEV) ! cloud optical thickness for pre-industrial aerosol concentrations - REAL, INTENT(in) :: qsat(klon,klev) ! Variable pour iflag_rrtm=1 - REAL, INTENT(in) :: flwc(klon,klev) ! Variable pour iflag_rrtm=1 - REAL, INTENT(in) :: fiwc(klon,klev) ! Variable pour iflag_rrtm=1 - REAL, INTENT(in) :: ref_liq(klon,klev) ! cloud droplet radius present-day from newmicro - REAL, INTENT(in) :: ref_ice(klon,klev) ! ice crystal radius present-day from newmicro - REAL, INTENT(in) :: m_allaer(klon,klev,naero_tot) ! mass aero - - CHARACTER(len=512), INTENT(in) :: namelist_ecrad_file - LOGICAL, INTENT(in) :: debut - - ! Output arguments - REAL, INTENT(out) :: heat(KLON,KLEV), cool(KLON,KLEV) - REAL, INTENT(out) :: heat0(KLON,KLEV), cool0(KLON,KLEV) - REAL, INTENT(out) :: heat_volc(KLON,KLEV), cool_volc(KLON,KLEV) !NL - REAL, INTENT(out) :: topsw(KLON), toplw(KLON) - REAL, INTENT(out) :: solsw(KLON), sollw(KLON), albpla(KLON), solswfdiff(KLON) - REAL, INTENT(out) :: topsw0(KLON), toplw0(KLON), solsw0(KLON), sollw0(KLON) - REAL, INTENT(out) :: sollwdown(KLON) - REAL, INTENT(out) :: swdn(KLON,kflev+1),swdn0(KLON,kflev+1), swdnc0(KLON,kflev+1) - REAL, INTENT(out) :: swup(KLON,kflev+1),swup0(KLON,kflev+1), swupc0(KLON,kflev+1) - REAL, INTENT(out) :: lwdn(KLON,kflev+1),lwdn0(KLON,kflev+1), lwdnc0(KLON,kflev+1) - REAL, INTENT(out) :: lwup(KLON,kflev+1),lwup0(KLON,kflev+1), lwupc0(KLON,kflev+1) - REAL, INTENT(out) :: topswad_aero(KLON), solswad_aero(KLON) ! output: aerosol direct forcing at TOA and surface - REAL, INTENT(out) :: topswai_aero(KLON), solswai_aero(KLON) ! output: aerosol indirect forcing atTOA and surface - REAL, INTENT(out) :: toplwad_aero(KLON), sollwad_aero(KLON) ! output: LW aerosol direct forcing at TOA and surface - REAL, INTENT(out) :: toplwai_aero(KLON), sollwai_aero(KLON) ! output: LW aerosol indirect forcing atTOA and surface - REAL, DIMENSION(klon), INTENT(out) :: topswad0_aero - REAL, DIMENSION(klon), INTENT(out) :: solswad0_aero - REAL, DIMENSION(klon), INTENT(out) :: toplwad0_aero - REAL, DIMENSION(klon), INTENT(out) :: sollwad0_aero - REAL, DIMENSION(kdlon,9), INTENT(out) :: topsw_aero - REAL, DIMENSION(kdlon,9), INTENT(out) :: topsw0_aero - REAL, DIMENSION(kdlon,9), INTENT(out) :: solsw_aero - REAL, DIMENSION(kdlon,9), INTENT(out) :: solsw0_aero - REAL, DIMENSION(kdlon,3), INTENT(out) :: topswcf_aero - REAL, DIMENSION(kdlon,3), INTENT(out) :: solswcf_aero - REAL, DIMENSION(kdlon,kflev+1), INTENT(out) :: ZSWFT0_i - REAL, DIMENSION(kdlon,kflev+1), INTENT(out) :: ZLWFT0_i - - ! Local variables - REAL(KIND=8) ZFSUP(KDLON,KFLEV+1) - REAL(KIND=8) ZFSDN(KDLON,KFLEV+1) - REAL(KIND=8) ZFSUP0(KDLON,KFLEV+1) - REAL(KIND=8) ZFSDN0(KDLON,KFLEV+1) - REAL(KIND=8) ZFSUPC0(KDLON,KFLEV+1) - REAL(KIND=8) ZFSDNC0(KDLON,KFLEV+1) - REAL(KIND=8) ZFLUP(KDLON,KFLEV+1) - REAL(KIND=8) ZFLDN(KDLON,KFLEV+1) - REAL(KIND=8) ZFLUP0(KDLON,KFLEV+1) - REAL(KIND=8) ZFLDN0(KDLON,KFLEV+1) - REAL(KIND=8) ZFLUPC0(KDLON,KFLEV+1) - REAL(KIND=8) ZFLDNC0(KDLON,KFLEV+1) - REAL(KIND=8) zx_alpha1, zx_alpha2 - INTEGER k, kk, l, i, iof - INTEGER ist,iend,ktdia,kmode - REAL(KIND=8) PSCT - REAL(KIND=8) PALBD(kdlon,2), PALBP(kdlon,2) - ! MPL 06.01.09: pour RRTM, creation de PALBD_NEW et PALBP_NEW - ! avec NSW en deuxieme dimension - REAL(KIND=8) PALBD_NEW(kdlon,NSW), PALBP_NEW(kdlon,NSW) - REAL(KIND=8) PEMIS(kdlon), PDT0(kdlon), PVIEW(kdlon) - REAL(KIND=8) PPSOL(kdlon), PDP(kdlon,KLEV) - REAL(KIND=8) PTL(kdlon,kflev+1), PPMB(kdlon,kflev+1) - REAL(KIND=8) PTAVE(kdlon,kflev) - REAL(KIND=8) PWV(kdlon,kflev), PQS(kdlon,kflev) - - REAL(KIND=8) cloud_cover_sw(klon) - REAL(KIND=8), dimension(klon,klev+1) :: ZFLUX_DIR_i, & ! Direct compt of surf flux into horizontal plane - ZFLUX_DIR_CLEAR_i ! CS Direct - REAL(KIND=8), dimension(klon,klev+1) :: ZFLUX_DIR, & ! Direct compt of surf flux into horizontal plane - ZFLUX_DIR_CLEAR ! CS Direct - REAL(KIND=8), dimension(klon) :: ZFLUX_DIR_INTO_SUN - - ! Declarations specifiques pour ECRAD ! - ! AI 02.2021 -#ifdef CPP_ECRAD - ! ATTENTION les dimensions klon, kdlon ??? - ! INPUTS - REAL, DIMENSION(kdlon,kflev+1) :: ZSWFT0_ii, ZLWFT0_ii - REAL(KIND=8) ZEMISW(klon), & ! LW emissivity inside the window region - ZEMIS(klon) ! LW emissivity outside the window region - REAL(KIND=8) ZGELAM(klon), & ! longitudes en rad - ZGEMU(klon) ! sin(latitude) - REAL(KIND=8) ZCO2, & ! CO2 mass mixing ratios on full levels - ZCH4, & ! CH4 mass mixing ratios on full levels - ZN2O, & ! N2O mass mixing ratios on full levels - ZNO2, & ! NO2 mass mixing ratios on full levels - ZCFC11, & ! CFC11 - ZCFC12, & ! CFC12 - ZHCFC22, & ! HCFC22 - ZCCL4, & ! CCL4 - ZO2 ! O2 - - REAL(KIND=8) ZQ_RAIN(klon,klev), & ! Rain cloud mass mixing ratio (kg/kg) ? - ZQ_SNOW(klon,klev) ! Snow cloud mass mixing ratio (kg/kg) ? - REAL(KIND=8) ZAEROSOL_OLD(KLON,6,KLEV), & ! - ZAEROSOL(KLON,KLEV,naero_spc) ! - ! Interm - REAL(KIND=8), dimension(klon) :: ZFLUX_UV, & ! UV flux - ZFLUX_PAR, & ! photosynthetically active radiation similarly - ZFLUX_PAR_CLEAR, & ! CS photosynthetically - ZEMIS_OUT ! effective broadband emissivity - REAL(KIND=8), dimension(klon,klev+1) :: ZLWDERIVATIVE ! LW derivatives - - ! REAL(KIND=8) ZSWDIFFUSEBAND(klon,NSW), & ! SW DN flux in diffuse albedo band - ! ZSWDIRECTBAND(klon,NSW) ! SW DN flux in direct albedo band - REAL(KIND=8) SOLARIRAD - REAL(KIND=8) seuilmach - ! AI 10 mars 22 : Pour les tests Offline - logical :: lldebug_for_offline = .false. - REAL(KIND=8) & - ZCO2_off(klon,klev), & - ZCH4_off(klon,klev), & ! CH4 mass mixing ratios on full levels - ZN2O_off(klon,klev), & ! N2O mass mixing ratios on full levels - ZNO2_off(klon,klev), & ! NO2 mass mixing ratios on full levels - ZCFC11_off(klon,klev), & ! CFC11 - ZCFC12_off(klon,klev), & ! CFC12 - ZHCFC22_off(klon,klev), & ! HCFC22 - ZCCL4_off(klon,klev), & ! CCL4 - ZO2_off(klon,klev) ! O2#endif -#endif - ! - - REAL(kind=8) POZON(kdlon, kflev, size(wo, 3)) ! mass fraction of ozone - ! "POZON(:, :, 1)" is for the average day-night field, - ! "POZON(:, :, 2)" is for daylight time. - ! Modif MPL 6.01.09 avec RRTM, on passe de 5 a 6 - REAL(KIND=8) PAER(kdlon,kflev,6) - REAL(KIND=8) PCLDLD(kdlon,kflev) - REAL(KIND=8) PCLDLU(kdlon,kflev) - REAL(KIND=8) PCLDSW(kdlon,kflev) - REAL(KIND=8) PTAU(kdlon,2,kflev) - REAL(KIND=8) POMEGA(kdlon,2,kflev) - REAL(KIND=8) PCG(kdlon,2,kflev) - REAL(KIND=8) zfract(kdlon), zrmu0(kdlon), zdist - REAL(KIND=8) zheat(kdlon,kflev), zcool(kdlon,kflev) - REAL(KIND=8) zheat0(kdlon,kflev), zcool0(kdlon,kflev) - REAL(KIND=8) zheat_volc(kdlon,kflev), zcool_volc(kdlon,kflev) !NL - REAL(KIND=8) ztopsw(kdlon), ztoplw(kdlon) - REAL(KIND=8) zsolsw(kdlon), zsollw(kdlon), zalbpla(kdlon), zsolswfdiff(kdlon) - REAL(KIND=8) zsollwdown(kdlon) - REAL(KIND=8) ztopsw0(kdlon), ztoplw0(kdlon) - REAL(KIND=8) zsolsw0(kdlon), zsollw0(kdlon) - REAL(KIND=8) tauaero(kdlon,kflev,naero_grp,2) ! aer opt properties - REAL(KIND=8) pizaero(kdlon,kflev,naero_grp,2) - REAL(KIND=8) cgaero(kdlon,kflev,naero_grp,2) - REAL(KIND=8) PTAUA(kdlon,2,kflev) ! present-day value of cloud opt thickness (PTAU is pre-industrial value), local use - REAL(KIND=8) POMEGAA(kdlon,2,kflev) ! dito for single scatt albedo - REAL(KIND=8) ztopswadaero(kdlon), zsolswadaero(kdlon) ! Aerosol direct forcing at TOAand surface - REAL(KIND=8) ztopswad0aero(kdlon), zsolswad0aero(kdlon) ! Aerosol direct forcing at TOAand surface - REAL(KIND=8) ztopswaiaero(kdlon), zsolswaiaero(kdlon) ! dito, indirect - !--NL - REAL(KIND=8) zswadaero(kdlon,kflev+1) ! SW Aerosol direct forcing - REAL(KIND=8) zlwadaero(kdlon,kflev+1) ! LW Aerosol direct forcing - !-LW by CK - REAL(KIND=8) ztoplwadaero(kdlon), zsollwadaero(kdlon) ! LW Aerosol direct forcing at TOAand surface - REAL(KIND=8) ztoplwad0aero(kdlon), zsollwad0aero(kdlon) ! LW Aerosol direct forcing at TOAand surface - REAL(KIND=8) ztoplwaiaero(kdlon), zsollwaiaero(kdlon) ! dito, indirect - !-end - REAL(KIND=8) ztopsw_aero(kdlon,9), ztopsw0_aero(kdlon,9) - REAL(KIND=8) zsolsw_aero(kdlon,9), zsolsw0_aero(kdlon,9) - REAL(KIND=8) ztopswcf_aero(kdlon,3), zsolswcf_aero(kdlon,3) - !MPL input supplementaires pour RECMWFL - ! flwc, fiwc = Liquid Water Content & Ice Water Content (kg/kg) - !MPL input RECMWFL: - ! Tableaux aux niveaux inverses pour respecter convention Arpege - REAL(KIND=8) ref_liq_i(klon,klev) ! cloud droplet radius present-day from newmicro (inverted) - REAL(KIND=8) ref_ice_i(klon,klev) ! ice crystal radius present-day from newmicro (inverted) - !--OB - !REAL(KIND=8) ref_liq_pi_i(klon,klev) ! cloud droplet radius pre-industrial from newmicro (inverted) - !REAL(KIND=8) ref_ice_pi_i(klon,klev) ! ice crystal radius pre-industrial from newmicro (inverted) - !--end OB - REAL(KIND=8) paprs_i(klon,klev+1) - REAL(KIND=8) pplay_i(klon,klev) - REAL(KIND=8) cldfra_i(klon,klev) - REAL(KIND=8) POZON_i(kdlon,kflev, size(wo, 3)) ! mass fraction of ozone - ! "POZON(:, :, 1)" is for the average day-night field, - ! "POZON(:, :, 2)" is for daylight time. - ! Modif MPL 6.01.09 avec RRTM, on passe de 5 a 6 - REAL(KIND=8) PAER_i(kdlon,kflev,6) - REAL(KIND=8) PDP_i(klon,klev) - REAL(KIND=8) t_i(klon,klev),q_i(klon,klev),qsat_i(klon,klev) - REAL(KIND=8) flwc_i(klon,klev),fiwc_i(klon,klev) - !MPL output RECMWFL: - REAL(KIND=8) ZEMTD (klon,klev+1),ZEMTD_i (klon,klev+1) - REAL(KIND=8) ZEMTU (klon,klev+1),ZEMTU_i (klon,klev+1) - REAL(KIND=8) ZTRSO (klon,klev+1),ZTRSO_i (klon,klev+1) - REAL(KIND=8) ZTH_i (klon,klev+1) - REAL(KIND=8) ZLWFT (klon,klev+1),ZLWFT_i (klon,klev+1) - REAL(KIND=8) ZSWFT (klon,klev+1),ZSWFT_i (klon,klev+1) - REAL(KIND=8) PSFSWDIR(klon,NSW) - REAL(KIND=8) PSFSWDIF(klon,NSW) - !MPL On ne redefinit pas les tableaux ZFLUX,ZFLUC, - !MPL ZFSDWN,ZFCDWN,ZFSUP,ZFCUP car ils existent deja - !MPL sous les noms de ZFLDN,ZFLDN0,ZFLUP,ZFLUP0, - !MPL ZFSDN,ZFSDN0,ZFSUP,ZFSUP0 - REAL(KIND=8) ZFLUX_i (klon,2,klev+1) - REAL(KIND=8) ZFLUC_i (klon,2,klev+1) - - REAL(KIND=8) ZFSDWN_i (klon,klev+1) - REAL(KIND=8) ZFCDWN_i (klon,klev+1) - REAL(KIND=8) ZFCCDWN_i (klon,klev+1) - REAL(KIND=8) ZFSUP_i (klon,klev+1) - REAL(KIND=8) ZFCUP_i (klon,klev+1) - REAL(KIND=8) ZFCCUP_i (klon,klev+1) - REAL(KIND=8) ZFLCCDWN_i (klon,klev+1) - REAL(KIND=8) ZFLCCUP_i (klon,klev+1) - ! 3 lignes suivantes a activer pour CCMVAL (MPL 20100412) - ! REAL(KIND=8) RSUN(3,2) - ! REAL(KIND=8) SUN(3) - ! REAL(KIND=8) SUN_FRACT(2) - CHARACTER (LEN=80) :: abort_message - CHARACTER (LEN=80) :: modname='radlwsw_m' - - REAL zdir(klon), zdif(klon) - INTEGER :: dimoz - - dimoz=size(wo,3) - - CALL lmdz_rad_ini( & - ist,iend,ktdia,kmode, & - dist, rmu0, fract, & - paprs, pplay,tsol,SFRWL,alb_dir, alb_dif, & - t,q,wo,cldfra, cldemi, cldtaupd,& - tau_aero, piz_aero, cg_aero,& - tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm,& - cldtaupi, qsat, flwc, fiwc, iof, & - heat,heat0,cool,cool0,heat_volc, cool_volc,& - zheat,zheat0,zcool,zcool0,zheat_volc, zcool_volc,& - zdist,PSCT,zfract,zrmu0, & - PAER,PCLDLD,PCLDLU,PCLDSW,& - PTAU,PTAUA,POMEGA,POMEGAA,PCG, & - PALBD,PALBP,PALBD_NEW,PALBP_NEW,& - PEMIS,PDT0,PVIEW,PPSOL,PDP, & - PTL,PPMB,PTAVE,PWV,PQS, & - zx_alpha1,zx_alpha2,POZON, & - tauaero,pizaero,cgaero, & - ztopsw_aero,ztopsw0_aero,zsolsw_aero,zsolsw0_aero, & - ztopswcf_aero,zsolswcf_aero, & - ztopswadaero,zsolswadaero,ztopswad0aero, & - zsolswad0aero,zsollwadaero,zsollwad0aero, & - ztopswaiaero,zsolswaiaero,ztoplwaiaero,zsollwaiaero) - ! - !===== iflag_rrtm ================================================ - ! - ! AI fev 2021 - IF(iflag_rrtm == 2) THEN - print*,'Traitement cas iflag_rrtm = ',iflag_rrtm - ! print*,'Mise a zero des flux ' -#ifdef CPP_ECRAD - ZEMIS = 1.0 - ZEMISW = 1.0 - ZGELAM = longitude - ZGEMU = sin(latitude) - ZCO2 = RCO2 - ZCH4 = RCH4 - ZN2O = RN2O - ZNO2 = 0.0 - ZCFC11 = RCFC11 - ZCFC12 = RCFC12 - ZHCFC22 = 0.0 - ZO2 = 0.0 - ZCCL4 = 0.0 - ZQ_RAIN = 0.0 - ZQ_SNOW = 0.0 - ZAEROSOL_OLD = 0.0 - ZAEROSOL = 0.0 - seuilmach=tiny(seuilmach) - - DO k = 1, kflev+1 - DO i = 1, kdlon - ZEMTD_i(i,k)=0. - ZEMTU_i(i,k)=0. - ZTRSO_i(i,k)=0. - ZTH_i(i,k)=0. - ZLWFT_i(i,k)=0. - ZSWFT_i(i,k)=0. - ZFLUX_i(i,1,k)=0. - ZFLUX_i(i,2,k)=0. - ZFLUC_i(i,1,k)=0. - ZFLUC_i(i,2,k)=0. - ZFSDWN_i(i,k)=0. - ZFCDWN_i(i,k)=0. - ZFCCDWN_i(i,k)=0. - ZFSUP_i(i,k)=0. - ZFCUP_i(i,k)=0. - ZFCCUP_i(i,k)=0. - ZFLCCDWN_i(i,k)=0. - ZFLCCUP_i(i,k)=0. - ENDDO - ENDDO - ! - ! AI ATTENTION Aerosols A REVOIR - DO kk= 1, naero_spc - DO k = 1, kflev - DO i = 1, kdlon - ! DO kk=1, NSW - ! - ! PTAU_TOT(i,kflev+1-k,kk)=tau_aero_sw_rrtm(i,k,2,kk) - ! PPIZA_TOT(i,kflev+1-k,kk)=piz_aero_sw_rrtm(i,k,2,kk) - ! PCGA_TOT(i,kflev+1-k,kk)=cg_aero_sw_rrtm(i,k,2,kk) - ! - ! PTAU_NAT(i,kflev+1-k,kk)=tau_aero_sw_rrtm(i,k,1,kk) - ! PPIZA_NAT(i,kflev+1-k,kk)=piz_aero_sw_rrtm(i,k,1,kk) - ! PCGA_NAT(i,kflev+1-k,kk)=cg_aero_sw_rrtm(i,k,1,kk) - ! ZAEROSOL(i,kflev+1-k,kk)=m_allaer(i,k,kk) - ZAEROSOL(i,kflev+1-k,kk)=m_allaer(i,k,kk) - ! - ENDDO - ENDDO - ENDDO - !-end OB - ! - ! DO i = 1, kdlon - ! DO k = 1, kflev - ! DO kk=1, NLW - ! - ! PTAU_LW_TOT(i,kflev+1-k,kk)=tau_aero_lw_rrtm(i,k,2,kk) - ! PTAU_LW_NAT(i,kflev+1-k,kk)=tau_aero_lw_rrtm(i,k,1,kk) - ! - ! ENDDO - ! ENDDO - ! ENDDO - !-end C. Kleinschmitt - ! - - DO kk = 1, NSW - DO i = 1, kdlon - PSFSWDIR(i,kk)=0. - PSFSWDIF(i,kk)=0. - ENDDO - ENDDO - !----- Fin des mises a zero des tableaux output ------------------- - - ! On met les donnees dans l'ordre des niveaux ecrad - ! print*,'On inverse sur la verticale ' - paprs_i(:,1)=paprs(:,klev+1) - DO k=1,klev - DO i=1,klon - paprs_i(i,k+1) =paprs(i,klev+1-k) - pplay_i(i,k) =pplay(i,klev+1-k) - cldfra_i(i,k) =cldfra(i,klev+1-k) - PDP_i(i,k) =PDP(i,klev+1-k) - t_i(i,k) =t(i,klev+1-k) - q_i(i,k) =q(i,klev+1-k) - qsat_i(i,k) =qsat(i,klev+1-k) - flwc_i(i,k) =flwc(i,klev+1-k) - fiwc_i(i,k) =fiwc(i,klev+1-k) - ref_liq_i(i,k) =ref_liq(i,klev+1-k)*1.0e-6 - ref_ice_i(i,k) =ref_ice(i,klev+1-k)*1.0e-6 - !-OB - !ref_liq_pi_i(i,k) =ref_liq_pi(i,klev+1-k) - !ref_ice_pi_i(i,k) =ref_ice_pi(i,klev+1-k) - ENDDO - ENDDO - - DO l=1,dimoz - DO k=1,kflev - POZON_i(1:klon,k,l)=POZON(1:klon,kflev+1-k,l) - ! ZO3_DP_i(1:klon,k)=ZO3_DP(1:klon,kflev+1-k) - ! DO i=1,6 - PAER_i(1:klon,k,l)=PAER(1:klon,kflev+1-k,l) - ! ENDDO - ENDDO - ENDDO - - ! A. Idelkadi 11.2021 - ! Calcul de ZTH_i (temp aux interfaces 1:klev+1) - ! IFS currently sets the half-level temperature at the surface to be - ! equal to the skin temperature. The radiation scheme takes as input - ! only the half-level temperatures and assumes the Planck function to - ! vary linearly in optical depth between half levels. In the lowest - ! atmospheric layer, where the atmospheric temperature can be much - ! cooler than the skin temperature, this can lead to significant - ! differences between the effective temperature of this lowest layer - ! and the true value in the model. - ! We may approximate the temperature profile in the lowest model level - ! as piecewise linear between the top of the layer T[k-1/2], the - ! centre of the layer T[k] and the base of the layer Tskin. The mean - ! temperature of the layer is then 0.25*T[k-1/2] + 0.5*T[k] + - ! 0.25*Tskin, which can be achieved by setting the atmospheric - ! temperature at the half-level corresponding to the surface as - ! follows: - ! AI ATTENTION fais dans interface radlw - !thermodynamics%temperature_hl(KIDIA:KFDIA,KLEV+1) & - ! & = PTEMPERATURE(KIDIA:KFDIA,KLEV) & - ! & + 0.5_JPRB * (PTEMPERATURE_H(KIDIA:KFDIA,KLEV+1) & - ! & -PTEMPERATURE_H(KIDIA:KFDIA,KLEV)) - - DO K=2,KLEV - DO i = 1, kdlon - ZTH_i(i,K)=& - & (t_i(i,K-1)*pplay_i(i,K-1)*(pplay_i(i,K)-paprs_i(i,K))& - & +t_i(i,K)*pplay_i(i,K)*(paprs_i(i,K)-pplay_i(i,K-1)))& - & *(1.0/(paprs_i(i,K)*(pplay_i(i,K)-pplay_i(i,K-1)))) - ENDDO - ENDDO - DO i = 1, kdlon - ! Sommet - ZTH_i(i,1)=t_i(i,1)-pplay_i(i,1)*(t_i(i,1)-ZTH_i(i,2))& - & /(pplay_i(i,1)-paprs_i(i,2)) - ! Vers le sol - ZTH_i(i,KLEV+1)=t_i(i,KLEV) + 0.5 * & - (tsol(i) - ZTH_i(i,KLEV)) - ENDDO - - - print *,'RADLWSW: avant RADIATION_SCHEME ' - - ! AI mars 2022 - SOLARIRAD = solaire/zdist/zdist - ! diagnos pour la comparaison a la version offline - ! - Gas en VMR pour offline et MMR pour online - ! - on utilise pour solarirrad une valeur constante - if (lldebug_for_offline) then - SOLARIRAD = 1366.0896 - ZCH4_off = CH4_ppb*1e-9 - ZN2O_off = N2O_ppb*1e-9 - ZNO2_off = 0.0 - ZCFC11_off = CFC11_ppt*1e-12 - ZCFC12_off = CFC12_ppt*1e-12 - ZHCFC22_off = 0.0 - ZCCL4_off = 0.0 - ZO2_off = 0.0 - ZCO2_off = co2_ppm*1e-6 - - CALL writefield_phy('rmu0',rmu0,1) - CALL writefield_phy('tsol',tsol,1) - CALL writefield_phy('emissiv_out',ZEMIS,1) - CALL writefield_phy('paprs_i',paprs_i,klev+1) - CALL writefield_phy('ZTH_i',ZTH_i,klev+1) - CALL writefield_phy('cldfra_i',cldfra_i,klev) - CALL writefield_phy('q_i',q_i,klev) - CALL writefield_phy('fiwc_i',fiwc_i,klev) - CALL writefield_phy('flwc_i',flwc_i,klev) - CALL writefield_phy('palbd_new',PALBD_NEW,NSW) - CALL writefield_phy('palbp_new',PALBP_NEW,NSW) - CALL writefield_phy('POZON',POZON_i(:,:,1),klev) - CALL writefield_phy('ZCO2',ZCO2_off,klev) - CALL writefield_phy('ZCH4',ZCH4_off,klev) - CALL writefield_phy('ZN2O',ZN2O_off,klev) - CALL writefield_phy('ZO2',ZO2_off,klev) - CALL writefield_phy('ZNO2',ZNO2_off,klev) - CALL writefield_phy('ZCFC11',ZCFC11_off,klev) - CALL writefield_phy('ZCFC12',ZCFC12_off,klev) - CALL writefield_phy('ZHCFC22',ZHCFC22_off,klev) - CALL writefield_phy('ZCCL4',ZCCL4_off,klev) - CALL writefield_phy('ref_liq_i',ref_liq_i,klev) - CALL writefield_phy('ref_ice_i',ref_ice_i,klev) - endif - ! lldebug_for_offline - - if (namelist_ecrad_file.eq.'namelist_ecrad') then - print*,' 1er apell Ecrad : ok_2xcall_ecrad, namelist_ecrad_file = ', & - ok_2xcall_ecrad, namelist_ecrad_file - CALL lmdz_ecrad_interface & - ! inputs - & (ist, iend, klon, klev, naero_spc, NSW, & - & namelist_ecrad_file, ok_2xcall_ecrad, & - & debut, ok_volcan, flag_aerosol_strat, & - & day_cur, current_time, & - & SOLARIRAD, & ! Cste solaire/(d_Terre-Soleil)**2 - & rmu0, tsol, & ! Cos(angle zin), temp sol - & PALBD_NEW,PALBP_NEW, & ! Albedo diffuse et directe - & ZEMIS, ZEMISW, & ! Emessivite : PEMIS_WINDOW (???), - & ZGELAM, ZGEMU, & ! longitude(rad), sin(latitude), PMASQ_ ??? - & paprs_i, ZTH_i, q_i, qsat_i, & ! Temp et pres aux interf, vapeur eau, Satur spec humid - & ZCO2, ZCH4, ZN2O, ZNO2, ZCFC11, ZCFC12, ZHCFC22, & ! Gas - & ZCCL4, POZON_i(:,:,1), ZO2, & - & cldfra_i, flwc_i, fiwc_i, ZQ_SNOW, & ! Nuages - & ref_liq_i, ref_ice_i, & ! rayons effectifs des gouttelettes - & ZAEROSOL_OLD, ZAEROSOL, & ! aerosols - ! Outputs - & ZSWFT_i, ZLWFT_i, ZSWFT0_ii, ZLWFT0_ii, & ! Net flux - & ZFSDWN_i, ZFLUX_i(:,2,:), ZFCDWN_i, ZFLUC_i(:,2,:), & ! DWN flux - & ZFSUP_i, ZFLUX_i(:,1,:), ZFCUP_i, ZFLUC_i(:,1,:), & ! UP flux - & ZFLUX_DIR_i, ZFLUX_DIR_CLEAR_i, ZFLUX_DIR_INTO_SUN, & ! Direct flux - & ZFLUX_UV, ZFLUX_PAR, ZFLUX_PAR_CLEAR, & ! UV and para flux - & ZEMIS_OUT, ZLWDERIVATIVE, & ! - & PSFSWDIF, PSFSWDIR, & - & cloud_cover_sw) - else - print*,' 2e apell Ecrad : ok_2xcall_ecrad, namelist_ecrad_file = ', & - ok_2xcall_ecrad, namelist_ecrad_file - CALL lmdz_ecrad_interface_2call & - & (ist, iend, klon, klev, naero_grp, NSW, & - & namelist_ecrad_file, ok_2xcall_ecrad, & - & debut, ok_volcan, flag_aerosol_strat, & - & day_cur, current_time, & - & SOLARIRAD, & - & rmu0, tsol, & - & PALBD_NEW,PALBP_NEW, & - & ZEMIS, ZEMISW, & - & ZGELAM, ZGEMU, & - & paprs_i, ZTH_i, q_i, qsat_i, & - & ZCO2, ZCH4, ZN2O, ZNO2, ZCFC11, ZCFC12, ZHCFC22, & - & ZCCL4, POZON_i(:,:,1), ZO2, & - & cldfra_i, flwc_i, fiwc_i, ZQ_SNOW, & - & ref_liq_i, ref_ice_i, & - & ZAEROSOL_OLD, ZAEROSOL, & - & ZSWFT_i, ZLWFT_i, ZSWFT0_ii, ZLWFT0_ii, & - & ZFSDWN_i, ZFLUX_i(:,2,:), ZFCDWN_i, ZFLUC_i(:,2,:), & - & ZFSUP_i, ZFLUX_i(:,1,:), ZFCUP_i, ZFLUC_i(:,1,:), & - & ZFLUX_DIR_i, ZFLUX_DIR_CLEAR_i, ZFLUX_DIR_INTO_SUN, & - & ZFLUX_UV, ZFLUX_PAR, ZFLUX_PAR_CLEAR, & - & ZEMIS_OUT, ZLWDERIVATIVE, & - & PSFSWDIF, PSFSWDIR, & - & cloud_cover_sw) - endif - - - print *,'========= CALL_ECRAD apres RADIATION_SCHEME ==================== ' - - if (lldebug_for_offline) then - CALL writefield_phy('FLUX_LW',ZLWFT_i,klev+1) - CALL writefield_phy('FLUX_LW_CLEAR',ZLWFT0_ii,klev+1) - CALL writefield_phy('FLUX_SW',ZSWFT_i,klev+1) - CALL writefield_phy('FLUX_SW_CLEAR',ZSWFT0_ii,klev+1) - CALL writefield_phy('FLUX_DN_SW',ZFSDWN_i,klev+1) - CALL writefield_phy('FLUX_DN_LW',ZFLUX_i(:,2,:),klev+1) - CALL writefield_phy('FLUX_DN_SW_CLEAR',ZFCDWN_i,klev+1) - CALL writefield_phy('FLUX_DN_LW_CLEAR',ZFLUC_i(:,2,:),klev+1) - CALL writefield_phy('PSFSWDIR',PSFSWDIR,6) - CALL writefield_phy('PSFSWDIF',PSFSWDIF,6) - CALL writefield_phy('FLUX_UP_LW',ZFLUX_i(:,1,:),klev+1) - CALL writefield_phy('FLUX_UP_LW_CLEAR',ZFLUC_i(:,1,:),klev+1) - CALL writefield_phy('FLUX_UP_SW',ZFSUP_i,klev+1) - CALL writefield_phy('FLUX_UP_SW_CLEAR',ZFCUP_i,klev+1) - endif - - ! --------- - ! On retablit l'ordre des niveaux lmd pour les tableaux de sortie - ! D autre part, on multiplie les resultats SW par fract pour etre coherent - ! avec l ancien rayonnement AR4. Si nuit, fract=0 donc pas de - ! rayonnement SW. (MPL 260609) - print*,'On retablit l ordre des niveaux verticaux pour LMDZ' - print*,'On multiplie les flux SW par fract et LW dwn par -1' - DO k=0,klev - DO i=1,klon - ZEMTD(i,k+1) = ZEMTD_i(i,klev+1-k) - ZEMTU(i,k+1) = ZEMTU_i(i,klev+1-k) - ZTRSO(i,k+1) = ZTRSO_i(i,klev+1-k) - ! ZTH(i,k+1) = ZTH_i(i,klev+1-k) - ! AI ATTENTION - ZLWFT(i,k+1) = ZLWFT_i(i,klev+1-k) - ZSWFT(i,k+1) = ZSWFT_i(i,klev+1-k)*fract(i) - ZSWFT0_i(i,k+1) = ZSWFT0_ii(i,klev+1-k)*fract(i) - ZLWFT0_i(i,k+1) = ZLWFT0_ii(i,klev+1-k) - ! - ZFLUP(i,k+1) = ZFLUX_i(i,1,klev+1-k) - ZFLDN(i,k+1) = -1.*ZFLUX_i(i,2,klev+1-k) - ZFLUP0(i,k+1) = ZFLUC_i(i,1,klev+1-k) - ZFLDN0(i,k+1) = -1.*ZFLUC_i(i,2,klev+1-k) - ZFSDN(i,k+1) = ZFSDWN_i(i,klev+1-k)*fract(i) - ZFSDN0(i,k+1) = ZFCDWN_i(i,klev+1-k)*fract(i) - ZFSDNC0(i,k+1)= ZFCCDWN_i(i,klev+1-k)*fract(i) - ZFSUP (i,k+1) = ZFSUP_i(i,klev+1-k)*fract(i) - ZFSUP0(i,k+1) = ZFCUP_i(i,klev+1-k)*fract(i) - ZFSUPC0(i,k+1)= ZFCCUP_i(i,klev+1-k)*fract(i) - ZFLDNC0(i,k+1)= -1.*ZFLCCDWN_i(i,klev+1-k) - ZFLUPC0(i,k+1)= ZFLCCUP_i(i,klev+1-k) - ! Direct flux - ZFLUX_DIR(i,k+1) = ZFLUX_DIR_i(i,klev+1-k) - ZFLUX_DIR_CLEAR(i,k+1) = ZFLUX_DIR_CLEAR_i(i,klev+1-k) - IF (ok_volcan) THEN - ZSWADAERO(i,k+1)=ZSWADAERO(i,klev+1-k)*fract(i) !--NL - ENDIF - - ! Nouveau calcul car visiblement ZSWFT et ZSWFC sont nuls dans RRTM cy32 - ! en sortie de radlsw.F90 - MPL 7.01.09 - ! AI ATTENTION - ! ZSWFT(i,k+1) = (ZFSDWN_i(i,k+1)-ZFSUP_i(i,k+1))*fract(i) - ! ZSWFT0_i(i,k+1) = (ZFCDWN_i(i,k+1)-ZFCUP_i(i,k+1))*fract(i) - ! ZLWFT(i,k+1) =-ZFLUX_i(i,2,k+1)-ZFLUX_i(i,1,k+1) - ! ZLWFT0_i(i,k+1)=-ZFLUC_i(i,2,k+1)-ZFLUC_i(i,1,k+1) - ENDDO - ENDDO - - !--ajout OB - ZTOPSWADAERO(:) =ZTOPSWADAERO(:) *fract(:) - ZSOLSWADAERO(:) =ZSOLSWADAERO(:) *fract(:) - ZTOPSWAD0AERO(:)=ZTOPSWAD0AERO(:)*fract(:) - ZSOLSWAD0AERO(:)=ZSOLSWAD0AERO(:)*fract(:) - ZTOPSWAIAERO(:) =ZTOPSWAIAERO(:) *fract(:) - ZSOLSWAIAERO(:) =ZSOLSWAIAERO(:) *fract(:) - ZTOPSWCF_AERO(:,1)=ZTOPSWCF_AERO(:,1)*fract(:) - ZTOPSWCF_AERO(:,2)=ZTOPSWCF_AERO(:,2)*fract(:) - ZTOPSWCF_AERO(:,3)=ZTOPSWCF_AERO(:,3)*fract(:) - ZSOLSWCF_AERO(:,1)=ZSOLSWCF_AERO(:,1)*fract(:) - ZSOLSWCF_AERO(:,2)=ZSOLSWCF_AERO(:,2)*fract(:) - ZSOLSWCF_AERO(:,3)=ZSOLSWCF_AERO(:,3)*fract(:) - ztoplwadaero = missing_val - ztoplwad0aero = missing_val - - ! --------- - ! On renseigne les champs LMDz, pour avoir la meme chose qu'en sortie de - ! LW_LMDAR4 et SW_LMDAR4 - - !--fraction of diffuse radiation in surface SW downward radiation - - zdir(:)=0. - zdif(:)=0. - DO k=1,nsw - DO i = 1, kdlon - zdir(i)=zdir(i)+PSFSWDIR(i,k) - zdif(i)=zdif(i)+PSFSWDIF(i,k) - ENDDO - ENDDO - - DO i = 1, kdlon - IF (fract(i).GT.0.0.and.(zdir(i)+zdif(i)).gt.seuilmach) THEN - zsolswfdiff(i) = zdif(i)/(zdir(i)+zdif(i)) - ELSE !--night - zsolswfdiff(i) = 1.0 - ENDIF - ENDDO - ! - DO i = 1, kdlon - zsolsw(i) = ZSWFT(i,1) - zsolsw0(i) = ZSWFT0_i(i,1) - ztopsw(i) = ZSWFT(i,klev+1) - ztopsw0(i) = ZSWFT0_i(i,klev+1) - zsollw(i) = ZLWFT(i,1) - zsollw0(i) = ZLWFT0_i(i,1) - ztoplw(i) = ZLWFT(i,klev+1)*(-1) - ztoplw0(i) = ZLWFT0_i(i,klev+1)*(-1) - ! - zsollwdown(i)= -1.*ZFLDN(i,1) - ENDDO - - DO k=1,kflev - DO i=1,kdlon - zheat(i,k)=(ZSWFT(i,k+1)-ZSWFT(i,k))*RDAY*RG/RCPD/PDP(i,k) - zheat0(i,k)=(ZSWFT0_i(i,k+1)-ZSWFT0_i(i,k))*RDAY*RG/RCPD/PDP(i,k) - zcool(i,k)=(ZLWFT(i,k)-ZLWFT(i,k+1))*RDAY*RG/RCPD/PDP(i,k) - zcool0(i,k)=(ZLWFT0_i(i,k)-ZLWFT0_i(i,k+1))*RDAY*RG/RCPD/PDP(i,k) - IF (ok_volcan) THEN - zheat_volc(i,k)=(ZSWADAERO(i,k+1)-ZSWADAERO(i,k))*RG/RCPD/PDP(i,k) !NL - zcool_volc(i,k)=(ZLWADAERO(i,k)-ZLWADAERO(i,k+1))*RG/RCPD/PDP(i,k) !NL - ENDIF - ENDDO - ENDDO -#endif - print*,'Fin traitement ECRAD' - ! Fin ECRAD - ENDIF !test_iflag_rrtm - ! ecrad - !====================================================================== - - CALL lmdz_rad_out( & - iof,PWV, & - ZFSUP,ZFSDN,ZFSUP0,ZFSDN0, & - ZFSUPC0,ZFSDNC0,ZFLUP,ZFLDN, & - ZFLUP0,ZFLDN0,ZFLUPC0,ZFLDNC0, & - zheat,zcool,zheat0,zcool0,zheat_volc,zcool_volc, & - ztopsw,ztoplw,zsolsw,zsollw,zalbpla,zsolswfdiff, & - zsollwdown,ztopsw0,ztoplw0,zsolsw0,zsollw0, & - ztopswadaero,zsolswadaero,ztopswad0aero,zsolswad0aero, & - ztopswaiaero,zsolswaiaero,ztoplwadaero,zsollwadaero, & - ztoplwad0aero,zsollwad0aero,ztoplwaiaero,zsollwaiaero, & - ztopsw_aero,ztopsw0_aero,zsolsw_aero,zsolsw0_aero, & - ztopswcf_aero,zsolswcf_aero, & - heat,heat0,cool,cool0,albpla,heat_volc, cool_volc,& - topsw,toplw,solsw,solswfdiff,sollw,sollwdown,& - topsw0,toplw0,solsw0,sollw0,& - lwdnc0,lwdn0,lwdn,lwupc0,lwup0,lwup,& - swdnc0,swdn0,swdn,swupc0,swup0,swup,& - topswad_aero,solswad_aero,topswai_aero,solswai_aero, & - topswad0_aero,solswad0_aero,topsw_aero,topsw0_aero,& - solsw_aero,solsw0_aero,topswcf_aero,solswcf_aero,& - toplwad_aero,sollwad_aero,toplwai_aero,sollwai_aero, & - toplwad0_aero,sollwad0_aero,& - cloud_cover_sw,ZFLUX_DIR,ZFLUX_DIR_CLEAR,ZFLUX_DIR_INTO_SUN) - - END SUBROUTINE lmdz_call_ecrad -END MODULE lmdz_call_ecrad_m Index: /LMDZ6/trunk/libf/phylmd/lmdz_call_oldrad.F90 =================================================================== --- /LMDZ6/trunk/libf/phylmd/lmdz_call_oldrad.F90 (revision 6181) +++ /LMDZ6/trunk/libf/phylmd/lmdz_call_oldrad.F90 (revision 6181) @@ -0,0 +1,380 @@ +! +! $Id: radlwsw_m.F90 6127 2026-03-26 13:59:25Z idelkadi $ +! +MODULE lmdz_call_oldrad + + IMPLICIT NONE + +CONTAINS + + SUBROUTINE call_oldrad( & + dist, rmu0, fract, & + paprs, pplay,tsol,SFRWL,alb_dir, alb_dif, & + t,q,wo,cldfra, cldemi, cldtaupd,& + tau_aero, piz_aero, cg_aero,& + tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm,& + cldtaupi, qsat, flwc, fiwc, & + heat,heat0,cool,cool0,albpla,heat_volc, cool_volc,& + topsw,toplw,solsw,solswfdiff,sollw,sollwdown,& + topsw0,toplw0,solsw0,sollw0,& + lwdnc0, lwdn0, lwdn, lwupc0, lwup0, lwup,& + swdnc0, swdn0, swdn, swupc0, swup0, swup,& + topswad_aero, solswad_aero, topswai_aero, solswai_aero, & + topswad0_aero, solswad0_aero, topsw_aero, topsw0_aero,& + solsw_aero, solsw0_aero, topswcf_aero, solswcf_aero,& + toplwad_aero, sollwad_aero, toplwai_aero, sollwai_aero, & + toplwad0_aero, sollwad0_aero, & + ZLWFT0_i, ZFLDN0, ZFLUP0, ZSWFT0_i, ZFSDN0, ZFSUP0, & + ZFLUX_DIR, ZFLUX_DIR_CLEAR, ZFLUX_DIR_INTO_SUN, & + cloud_cover_sw) + + !=================================================================================================== + ! A. Idelkadi, mars 2026 : + ! Recriture de l interface radlwsw_m.F90 entre LMDZ + ! et les codes radiatifs oldrad/rrtm/ecrad + ! --------------------------------------------------------------------------- + ! lmdz_call_oldrad.F90 : + ! Interface avec ancien code de transfert radiatif (2 bandes SW) + ! + ! TODO : + ! - Nettoyage bloc declarations : + ! * USE (supprimer use inutules / identifier les variables par ONLY) + ! * declaraions variables locales + ! - Nettoyage partie avant et apres appel a oldrad + ! ------------------------------------------------------------------------------------------- + +! Modules necessaires + USE DIMPHY + USE write_field_phy + USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_REPROBUS + USE aero_mod + USE conf_phys_m, ONLY: ok_ade,ok_aie, flag_aerosol,flag_aerosol_strat, & + iflag_rrtm + ! AI 02.2021 + ! Besoin pour ECRAD de pctsrf, zmasq, longitude, altitude + USE yomcst_mod_h + USE clesphys_mod_h + USE yoethf_mod_h + USE phys_constants_mod, ONLY: dobson_u + USE lmdz_radiation_pre + USE lmdz_radiation_post + + ! ==================================================================== + + ! ============== + ! DECLARATIONS + ! ============== + + ! Input arguments + REAL, INTENT(in) :: dist + REAL, INTENT(in) :: rmu0(KLON), fract(KLON) + REAL, INTENT(in) :: paprs(KLON,KLEV+1), pplay(KLON,KLEV) + !albedo SB >>> + ! REAL, INTENT(in) :: alb1(KLON), alb2(KLON), tsol(KLON) + REAL, INTENT(in) :: tsol(KLON) + REAL, INTENT(in) :: alb_dir(KLON,NSW),alb_dif(KLON,NSW) + REAL, INTENT(in) :: SFRWL(6) + !albedo SB <<< + REAL, INTENT(in) :: t(KLON,KLEV), q(KLON,KLEV) + + REAL, INTENT(in):: wo(:, :, :) ! dimension(KLON,KLEV, 1 or 2) + ! column-density of ozone in a layer, in kilo-Dobsons + ! "wo(:, :, 1)" is for the average day-night field, + ! "wo(:, :, 2)" is for daylight time. + + REAL, INTENT(in) :: cldfra(KLON,KLEV), cldemi(KLON,KLEV), cldtaupd(KLON,KLEV) + REAL, INTENT(in) :: tau_aero(KLON,KLEV,naero_grp,2) ! aerosol optical properties (see aeropt.F) + REAL, INTENT(in) :: piz_aero(KLON,KLEV,naero_grp,2) ! aerosol optical properties (see aeropt.F) + REAL, INTENT(in) :: cg_aero(KLON,KLEV,naero_grp,2) ! aerosol optical properties (see aeropt.F) + !--OB + REAL, INTENT(in) :: tau_aero_sw_rrtm(KLON,KLEV,2,NSW) ! aerosol optical properties RRTM + REAL, INTENT(in) :: piz_aero_sw_rrtm(KLON,KLEV,2,NSW) ! aerosol optical properties RRTM + REAL, INTENT(in) :: cg_aero_sw_rrtm(KLON,KLEV,2,NSW) ! aerosol optical properties RRTM + !--OB fin + + REAL, INTENT(in) :: cldtaupi(KLON,KLEV) ! cloud optical thickness for pre-industrial aerosol concentrations + REAL, INTENT(in) :: qsat(klon,klev) ! Variable pour iflag_rrtm=1 + REAL, INTENT(in) :: flwc(klon,klev) ! Variable pour iflag_rrtm=1 + REAL, INTENT(in) :: fiwc(klon,klev) ! Variable pour iflag_rrtm=1 + + ! Output arguments + REAL, INTENT(out) :: heat(KLON,KLEV), cool(KLON,KLEV) + REAL, INTENT(out) :: heat0(KLON,KLEV), cool0(KLON,KLEV) + REAL, INTENT(out) :: heat_volc(KLON,KLEV), cool_volc(KLON,KLEV) !NL + REAL, INTENT(out) :: topsw(KLON), toplw(KLON) + REAL, INTENT(out) :: solsw(KLON), sollw(KLON), solswfdiff(KLON) + REAL, INTENT(out) :: topsw0(KLON), toplw0(KLON), solsw0(KLON), sollw0(KLON) + REAL, INTENT(out) :: sollwdown(KLON) + REAL, INTENT(out) :: swdn(KLON,kflev+1),swdn0(KLON,kflev+1), swdnc0(KLON,kflev+1) + REAL, INTENT(out) :: swup(KLON,kflev+1),swup0(KLON,kflev+1), swupc0(KLON,kflev+1) + REAL, INTENT(out) :: lwdn(KLON,kflev+1),lwdn0(KLON,kflev+1), lwdnc0(KLON,kflev+1) + REAL, INTENT(out) :: lwup(KLON,kflev+1),lwup0(KLON,kflev+1), lwupc0(KLON,kflev+1) + + REAL, INTENT(out) :: topswad_aero(KLON), solswad_aero(KLON) ! output: aerosol direct forcing at TOA and surface + REAL, INTENT(out) :: topswai_aero(KLON), solswai_aero(KLON) ! output: aerosol indirect forcing atTOA and surface + REAL, INTENT(out) :: toplwad_aero(KLON), sollwad_aero(KLON) ! output: LW aerosol direct forcing at TOA and surface + REAL, INTENT(out) :: toplwai_aero(KLON), sollwai_aero(KLON) ! output: LW aerosol indirect forcing atTOA and surface + REAL, DIMENSION(klon), INTENT(out) :: topswad0_aero + REAL, DIMENSION(klon), INTENT(out) :: solswad0_aero + REAL, DIMENSION(klon), INTENT(out) :: toplwad0_aero + REAL, DIMENSION(klon), INTENT(out) :: sollwad0_aero + REAL, DIMENSION(kdlon,9), INTENT(out) :: topsw_aero + REAL, DIMENSION(kdlon,9), INTENT(out) :: topsw0_aero + REAL, DIMENSION(kdlon,9), INTENT(out) :: solsw_aero + REAL, DIMENSION(kdlon,9), INTENT(out) :: solsw0_aero + REAL, DIMENSION(kdlon,3), INTENT(out) :: topswcf_aero + REAL, DIMENSION(kdlon,3), INTENT(out) :: solswcf_aero + REAL, DIMENSION(kdlon,kflev+1), INTENT(out) :: ZSWFT0_i + REAL, DIMENSION(kdlon,kflev+1), INTENT(out) :: ZLWFT0_i + REAL, INTENT(inout) :: albpla(KLON) + !Ecrad : + REAL(KIND=8), INTENT(out) :: cloud_cover_sw(klon), & ! SW cloud cover issued from Rcrad + ZFLUX_DIR(klon,klev+1), & ! Direct compt of surf flux into horizontal plane + ZFLUX_DIR_CLEAR(klon,klev+1), & ! CS Direct + ZFLUX_DIR_INTO_SUN(klon) + + ! Local variables + REAL(KIND=8) ZFSUP(KDLON,KFLEV+1) + REAL(KIND=8) ZFSDN(KDLON,KFLEV+1) + REAL(KIND=8) ZFSUP0(KDLON,KFLEV+1) + REAL(KIND=8) ZFSDN0(KDLON,KFLEV+1) + REAL(KIND=8) ZFSUPC0(KDLON,KFLEV+1) + REAL(KIND=8) ZFSDNC0(KDLON,KFLEV+1) + REAL(KIND=8) ZFLUP(KDLON,KFLEV+1) + REAL(KIND=8) ZFLDN(KDLON,KFLEV+1) + REAL(KIND=8) ZFLUP0(KDLON,KFLEV+1) + REAL(KIND=8) ZFLDN0(KDLON,KFLEV+1) + REAL(KIND=8) ZFLUPC0(KDLON,KFLEV+1) + REAL(KIND=8) ZFLDNC0(KDLON,KFLEV+1) + REAL(KIND=8) zx_alpha1, zx_alpha2 + INTEGER k, i, iof + INTEGER ist,iend,ktdia,kmode + REAL(KIND=8) PSCT + REAL(KIND=8) PALBD(kdlon,2), PALBP(kdlon,2) + ! MPL 06.01.09: pour RRTM, creation de PALBD_NEW et PALBP_NEW + ! avec NSW en deuxieme dimension + REAL(KIND=8) PALBD_NEW(kdlon,NSW), PALBP_NEW(kdlon,NSW) + REAL(KIND=8) PEMIS(kdlon), PDT0(kdlon), PVIEW(kdlon) + REAL(KIND=8) PPSOL(kdlon), PDP(kdlon,KLEV) + REAL(KIND=8) PTL(kdlon,kflev+1), PPMB(kdlon,kflev+1) + REAL(KIND=8) PTAVE(kdlon,kflev) + REAL(KIND=8) PWV(kdlon,kflev), PQS(kdlon,kflev) + + REAL(kind=8) POZON(kdlon, kflev, size(wo, 3)) ! mass fraction of ozone + ! "POZON(:, :, 1)" is for the average day-night field, + ! "POZON(:, :, 2)" is for daylight time. + ! Modif MPL 6.01.09 avec RRTM, on passe de 5 a 6 + REAL(KIND=8) PAER(kdlon,kflev,6) + REAL(KIND=8) PCLDLD(kdlon,kflev) + REAL(KIND=8) PCLDLU(kdlon,kflev) + REAL(KIND=8) PCLDSW(kdlon,kflev) + REAL(KIND=8) PTAU(kdlon,2,kflev) + REAL(KIND=8) POMEGA(kdlon,2,kflev) + REAL(KIND=8) PCG(kdlon,2,kflev) + REAL(KIND=8) zfract(kdlon), zrmu0(kdlon), zdist + REAL(KIND=8) zheat(kdlon,kflev), zcool(kdlon,kflev) + REAL(KIND=8) zheat0(kdlon,kflev), zcool0(kdlon,kflev) + REAL(KIND=8) zheat_volc(kdlon,kflev), zcool_volc(kdlon,kflev) !NL + REAL(KIND=8) ztopsw(kdlon), ztoplw(kdlon) + REAL(KIND=8) zsolsw(kdlon), zsollw(kdlon), zalbpla(kdlon), zsolswfdiff(kdlon) + REAL(KIND=8) zsollwdown(kdlon) + REAL(KIND=8) ztopsw0(kdlon), ztoplw0(kdlon) + REAL(KIND=8) zsolsw0(kdlon), zsollw0(kdlon) + REAL(KIND=8) tauaero(kdlon,kflev,naero_grp,2) ! aer opt properties + REAL(KIND=8) pizaero(kdlon,kflev,naero_grp,2) + REAL(KIND=8) cgaero(kdlon,kflev,naero_grp,2) + REAL(KIND=8) PTAUA(kdlon,2,kflev) ! present-day value of cloud opt thickness (PTAU is pre-industrial value), local use + REAL(KIND=8) POMEGAA(kdlon,2,kflev) ! dito for single scatt albedo + REAL(KIND=8) ztopswadaero(kdlon), zsolswadaero(kdlon) ! Aerosol direct forcing at TOAand surface + REAL(KIND=8) ztopswad0aero(kdlon), zsolswad0aero(kdlon) ! Aerosol direct forcing at TOAand surface + REAL(KIND=8) ztopswaiaero(kdlon), zsolswaiaero(kdlon) ! dito, indirect + !--NL + REAL(KIND=8) zswadaero(kdlon,kflev+1) ! SW Aerosol direct forcing + !-LW by CK + REAL(KIND=8) ztoplwadaero(kdlon), zsollwadaero(kdlon) ! LW Aerosol direct forcing at TOAand surface + REAL(KIND=8) ztoplwad0aero(kdlon), zsollwad0aero(kdlon) ! LW Aerosol direct forcing at TOAand surface + REAL(KIND=8) ztoplwaiaero(kdlon), zsollwaiaero(kdlon) ! dito, indirect + !-end + REAL(KIND=8) ztopsw_aero(kdlon,9), ztopsw0_aero(kdlon,9) + REAL(KIND=8) zsolsw_aero(kdlon,9), zsolsw0_aero(kdlon,9) + REAL(KIND=8) ztopswcf_aero(kdlon,3), zsolswcf_aero(kdlon,3) + REAL(KIND=8) ZFLUCDWN_i(klon,klev+1),ZFLUCUP_i(klon,klev+1) + + REAL(KIND=8) ZFCDWN_i (klon,klev+1) + REAL(KIND=8) ZFCCDWN_i (klon,klev+1) + REAL(KIND=8) ZFCUP_i (klon,klev+1) + REAL(KIND=8) ZFCCUP_i (klon,klev+1) + REAL(KIND=8) ZFLCCDWN_i (klon,klev+1) + REAL(KIND=8) ZFLCCUP_i (klon,klev+1) + + ! ========= INITIALISATIONS ============================================== + CALL radiation_pre( & + ist,iend,ktdia,kmode, & + dist, rmu0, fract, & + paprs, pplay,tsol,SFRWL,alb_dir, alb_dif, & + t,q,wo, cldfra, cldemi, cldtaupd,& + tau_aero, piz_aero, cg_aero,& + tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm,& + cldtaupi, & + qsat, flwc, fiwc, iof, & + heat,heat0,cool,cool0,& + heat_volc, cool_volc,& + zheat,zheat0,zcool,zcool0,& + zheat_volc, zcool_volc,& + zdist,PSCT,zfract,zrmu0, & + PAER,PCLDLD,PCLDLU,PCLDSW,& + PTAU,PTAUA,POMEGA,POMEGAA,PCG, & + PALBD,PALBP,PALBD_NEW,PALBP_NEW,& + PEMIS,PDT0,PVIEW,PPSOL,PDP, & + PTL,PPMB,PTAVE,PWV,PQS, & + zx_alpha1,zx_alpha2,POZON, & + tauaero,pizaero,cgaero, & + ztopsw_aero,ztopsw0_aero,zsolsw_aero,zsolsw0_aero, & + ztopswcf_aero,zsolswcf_aero,& + ztopswadaero,zsolswadaero,ztopswad0aero, & + zsolswad0aero,zsollwadaero,zsollwad0aero, & + ztopswaiaero,zsolswaiaero,ztoplwaiaero,zsollwaiaero) + + IF (iflag_rrtm == 0) THEN ! remettre 0 juste pour tester l'ancien rayt via rrtm + ! {{{ + !--- Mise a zero des tableaux output du rayonnement LW-AR4 ---------- + DO k = 1, kflev+1 + DO i = 1, kdlon + ! print *,'RADLWSW: boucle mise a zero i k',i,k + ZFLUP(i,k)=0. + ZFLDN(i,k)=0. + ZFLUP0(i,k)=0. + ZFLDN0(i,k)=0. + ZLWFT0_i(i,k)=0. + ZFLUCUP_i(i,k)=0. + ZFLUCDWN_i(i,k)=0. + ENDDO + ENDDO + DO k = 1, kflev + DO i = 1, kdlon + zcool(i,k)=0. + zcool_volc(i,k)=0. !NL + zcool0(i,k)=0. + ENDDO + ENDDO + DO i = 1, kdlon + ztoplw(i)=0. + zsollw(i)=0. + ztoplw0(i)=0. + zsollw0(i)=0. + zsollwdown(i)=0. + ztoplwad0aero(i) = 0. + ztoplwadaero(i) = 0. + ENDDO + ! Old radiation scheme, used for AR4 runs + ! average day-night ozone for longwave + CALL LW_LMDAR4(& + PPMB, PDP,& + PPSOL,PDT0,PEMIS,& + PTL, PTAVE, PWV, POZON(:, :, 1), PAER,& + PCLDLD,PCLDLU,& + PVIEW,& + zcool, zcool0,& + ztoplw,zsollw,ztoplw0,zsollw0,& + zsollwdown,& + ZFLUP, ZFLDN, ZFLUP0,ZFLDN0) + !----- Mise a zero des tableaux output du rayonnement SW-AR4 + DO k = 1, kflev+1 + DO i = 1, kdlon + ZFSUP(i,k)=0. + ZFSDN(i,k)=0. + ZFSUP0(i,k)=0. + ZFSDN0(i,k)=0. + ZFSUPC0(i,k)=0. + ZFSDNC0(i,k)=0. + ZFLUPC0(i,k)=0. + ZFLDNC0(i,k)=0. + ZSWFT0_i(i,k)=0. + ZFCUP_i(i,k)=0. + ZFCDWN_i(i,k)=0. + ZFCCUP_i(i,k)=0. + ZFCCDWN_i(i,k)=0. + ZFLCCUP_i(i,k)=0. + ZFLCCDWN_i(i,k)=0. + zswadaero(i,k)=0. !--NL + ENDDO + ENDDO + DO k = 1, kflev + DO i = 1, kdlon + zheat(i,k)=0. + zheat_volc(i,k)=0. + zheat0(i,k)=0. + ENDDO + ENDDO + DO i = 1, kdlon + zalbpla(i)=0. + ztopsw(i)=0. + zsolsw(i)=0. + ztopsw0(i)=0. + zsolsw0(i)=0. + ztopswadaero(i)=0. + zsolswadaero(i)=0. + ztopswaiaero(i)=0. + zsolswaiaero(i)=0. + ENDDO + + !--fraction of diffuse radiation in surface SW downward radiation + !--not computed with old radiation scheme + zsolswfdiff(:) = -999.999 + + ! print *,'Avant SW_LMDAR4: PSCT zrmu0 zfract',PSCT, zrmu0, zfract + ! daylight ozone, if we have it, for short wave + CALL SW_AEROAR4(PSCT, zrmu0, zfract,& + PPMB, PDP,& + PPSOL, PALBD, PALBP,& + PTAVE, PWV, PQS, POZON(:, :, size(wo, 3)), PAER,& + PCLDSW, PTAU, POMEGA, PCG,& + zheat, zheat0,& + zalbpla,ztopsw,zsolsw,ztopsw0,zsolsw0,& + ZFSUP,ZFSDN,ZFSUP0,ZFSDN0,& + tauaero, pizaero, cgaero, & + PTAUA, POMEGAA,& + ztopswadaero,zsolswadaero,& + ztopswad0aero,zsolswad0aero,& + ztopswaiaero,zsolswaiaero, & + ztopsw_aero,ztopsw0_aero,& + zsolsw_aero,zsolsw0_aero,& + ztopswcf_aero,zsolswcf_aero, & + ok_ade, ok_aie, flag_aerosol,flag_aerosol_strat) + + ZSWFT0_i(:,:) = ZFSDN0(:,:)-ZFSUP0(:,:) + ZLWFT0_i(:,:) =-ZFLDN0(:,:)-ZFLUP0(:,:) + + ENDIF + !====================================================================== + + ! ----- flux radiatifs => sorties --------------------------------- + + CALL radiation_post( & + iof,PWV, & + ZFSUP,ZFSDN,ZFSUP0,ZFSDN0, & + ZFSUPC0,ZFSDNC0,ZFLUP,ZFLDN, & + ZFLUP0,ZFLDN0,ZFLUPC0,ZFLDNC0, & + zheat,zcool,zheat0,zcool0,zheat_volc,zcool_volc, & + ztopsw,ztoplw,zsolsw,zsollw,zalbpla,zsolswfdiff, & + zsollwdown,ztopsw0,ztoplw0,zsolsw0,zsollw0, & + ztopswadaero,zsolswadaero,ztopswad0aero,zsolswad0aero, & + ztopswaiaero,zsolswaiaero,ztoplwadaero,zsollwadaero, & + ztoplwad0aero,zsollwad0aero,ztoplwaiaero,zsollwaiaero, & + ztopsw_aero,ztopsw0_aero,zsolsw_aero,zsolsw0_aero, & + ztopswcf_aero,zsolswcf_aero, & + heat,heat0,cool,cool0,albpla,heat_volc, cool_volc,& + topsw,toplw,solsw,solswfdiff,sollw,sollwdown,& + topsw0,toplw0,solsw0,sollw0,& + lwdnc0,lwdn0,lwdn,lwupc0,lwup0,lwup,& + swdnc0,swdn0,swdn,swupc0,swup0,swup,& + topswad_aero,solswad_aero,topswai_aero,solswai_aero, & + topswad0_aero,solswad0_aero,topsw_aero,topsw0_aero,& + solsw_aero,solsw0_aero,topswcf_aero,solswcf_aero,& + toplwad_aero,sollwad_aero,toplwai_aero,sollwai_aero, & + toplwad0_aero,sollwad0_aero, & + cloud_cover_sw,ZFLUX_DIR,ZFLUX_DIR_CLEAR,ZFLUX_DIR_INTO_SUN) + + END SUBROUTINE call_oldrad + +END MODULE lmdz_call_oldrad Index: DZ6/trunk/libf/phylmd/lmdz_call_oldrad_m.F90 =================================================================== --- /LMDZ6/trunk/libf/phylmd/lmdz_call_oldrad_m.F90 (revision 6180) +++ (revision ) @@ -1,380 +1,0 @@ -! -! $Id: radlwsw_m.F90 6127 2026-03-26 13:59:25Z idelkadi $ -! -MODULE lmdz_call_oldrad_m - - IMPLICIT NONE - -CONTAINS - - SUBROUTINE lmdz_call_oldrad( & - dist, rmu0, fract, & - paprs, pplay,tsol,SFRWL,alb_dir, alb_dif, & - t,q,wo,cldfra, cldemi, cldtaupd,& - tau_aero, piz_aero, cg_aero,& - tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm,& - cldtaupi, qsat, flwc, fiwc, & - heat,heat0,cool,cool0,albpla,heat_volc, cool_volc,& - topsw,toplw,solsw,solswfdiff,sollw,sollwdown,& - topsw0,toplw0,solsw0,sollw0,& - lwdnc0, lwdn0, lwdn, lwupc0, lwup0, lwup,& - swdnc0, swdn0, swdn, swupc0, swup0, swup,& - topswad_aero, solswad_aero, topswai_aero, solswai_aero, & - topswad0_aero, solswad0_aero, topsw_aero, topsw0_aero,& - solsw_aero, solsw0_aero, topswcf_aero, solswcf_aero,& - toplwad_aero, sollwad_aero, toplwai_aero, sollwai_aero, & - toplwad0_aero, sollwad0_aero, & - ZLWFT0_i, ZFLDN0, ZFLUP0, ZSWFT0_i, ZFSDN0, ZFSUP0, & - ZFLUX_DIR, ZFLUX_DIR_CLEAR, ZFLUX_DIR_INTO_SUN, & - cloud_cover_sw) - - !=================================================================================================== - ! A. Idelkadi, mars 2026 : - ! Recriture de l interface radlwsw_m.F90 entre LMDZ - ! et les codes radiatifs oldrad/rrtm/ecrad - ! --------------------------------------------------------------------------- - ! lmdz_call_oldrad_m.F90 : - ! Interface avec ancien code de transfert radiatif (2 bandes SW) - ! - ! TODO : - ! - Nettoyage bloc declarations : - ! * USE (supprimer use inutules / identifier les variables par ONLY) - ! * declaraions variables locales - ! - Nettoyage partie avant et apres appel a oldrad - ! ------------------------------------------------------------------------------------------- - -! Modules necessaires - USE DIMPHY - USE write_field_phy - USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_REPROBUS - USE aero_mod - USE conf_phys_m, ONLY: ok_ade,ok_aie, flag_aerosol,flag_aerosol_strat, & - iflag_rrtm - ! AI 02.2021 - ! Besoin pour ECRAD de pctsrf, zmasq, longitude, altitude - USE yomcst_mod_h - USE clesphys_mod_h - USE yoethf_mod_h - USE phys_constants_mod, ONLY: dobson_u - USE lmdz_rad_ini_m - USE lmdz_rad_out_m - - ! ==================================================================== - - ! ============== - ! DECLARATIONS - ! ============== - - ! Input arguments - REAL, INTENT(in) :: dist - REAL, INTENT(in) :: rmu0(KLON), fract(KLON) - REAL, INTENT(in) :: paprs(KLON,KLEV+1), pplay(KLON,KLEV) - !albedo SB >>> - ! REAL, INTENT(in) :: alb1(KLON), alb2(KLON), tsol(KLON) - REAL, INTENT(in) :: tsol(KLON) - REAL, INTENT(in) :: alb_dir(KLON,NSW),alb_dif(KLON,NSW) - REAL, INTENT(in) :: SFRWL(6) - !albedo SB <<< - REAL, INTENT(in) :: t(KLON,KLEV), q(KLON,KLEV) - - REAL, INTENT(in):: wo(:, :, :) ! dimension(KLON,KLEV, 1 or 2) - ! column-density of ozone in a layer, in kilo-Dobsons - ! "wo(:, :, 1)" is for the average day-night field, - ! "wo(:, :, 2)" is for daylight time. - - REAL, INTENT(in) :: cldfra(KLON,KLEV), cldemi(KLON,KLEV), cldtaupd(KLON,KLEV) - REAL, INTENT(in) :: tau_aero(KLON,KLEV,naero_grp,2) ! aerosol optical properties (see aeropt.F) - REAL, INTENT(in) :: piz_aero(KLON,KLEV,naero_grp,2) ! aerosol optical properties (see aeropt.F) - REAL, INTENT(in) :: cg_aero(KLON,KLEV,naero_grp,2) ! aerosol optical properties (see aeropt.F) - !--OB - REAL, INTENT(in) :: tau_aero_sw_rrtm(KLON,KLEV,2,NSW) ! aerosol optical properties RRTM - REAL, INTENT(in) :: piz_aero_sw_rrtm(KLON,KLEV,2,NSW) ! aerosol optical properties RRTM - REAL, INTENT(in) :: cg_aero_sw_rrtm(KLON,KLEV,2,NSW) ! aerosol optical properties RRTM - !--OB fin - - REAL, INTENT(in) :: cldtaupi(KLON,KLEV) ! cloud optical thickness for pre-industrial aerosol concentrations - REAL, INTENT(in) :: qsat(klon,klev) ! Variable pour iflag_rrtm=1 - REAL, INTENT(in) :: flwc(klon,klev) ! Variable pour iflag_rrtm=1 - REAL, INTENT(in) :: fiwc(klon,klev) ! Variable pour iflag_rrtm=1 - - ! Output arguments - REAL, INTENT(out) :: heat(KLON,KLEV), cool(KLON,KLEV) - REAL, INTENT(out) :: heat0(KLON,KLEV), cool0(KLON,KLEV) - REAL, INTENT(out) :: heat_volc(KLON,KLEV), cool_volc(KLON,KLEV) !NL - REAL, INTENT(out) :: topsw(KLON), toplw(KLON) - REAL, INTENT(out) :: solsw(KLON), sollw(KLON), solswfdiff(KLON) - REAL, INTENT(out) :: topsw0(KLON), toplw0(KLON), solsw0(KLON), sollw0(KLON) - REAL, INTENT(out) :: sollwdown(KLON) - REAL, INTENT(out) :: swdn(KLON,kflev+1),swdn0(KLON,kflev+1), swdnc0(KLON,kflev+1) - REAL, INTENT(out) :: swup(KLON,kflev+1),swup0(KLON,kflev+1), swupc0(KLON,kflev+1) - REAL, INTENT(out) :: lwdn(KLON,kflev+1),lwdn0(KLON,kflev+1), lwdnc0(KLON,kflev+1) - REAL, INTENT(out) :: lwup(KLON,kflev+1),lwup0(KLON,kflev+1), lwupc0(KLON,kflev+1) - - REAL, INTENT(out) :: topswad_aero(KLON), solswad_aero(KLON) ! output: aerosol direct forcing at TOA and surface - REAL, INTENT(out) :: topswai_aero(KLON), solswai_aero(KLON) ! output: aerosol indirect forcing atTOA and surface - REAL, INTENT(out) :: toplwad_aero(KLON), sollwad_aero(KLON) ! output: LW aerosol direct forcing at TOA and surface - REAL, INTENT(out) :: toplwai_aero(KLON), sollwai_aero(KLON) ! output: LW aerosol indirect forcing atTOA and surface - REAL, DIMENSION(klon), INTENT(out) :: topswad0_aero - REAL, DIMENSION(klon), INTENT(out) :: solswad0_aero - REAL, DIMENSION(klon), INTENT(out) :: toplwad0_aero - REAL, DIMENSION(klon), INTENT(out) :: sollwad0_aero - REAL, DIMENSION(kdlon,9), INTENT(out) :: topsw_aero - REAL, DIMENSION(kdlon,9), INTENT(out) :: topsw0_aero - REAL, DIMENSION(kdlon,9), INTENT(out) :: solsw_aero - REAL, DIMENSION(kdlon,9), INTENT(out) :: solsw0_aero - REAL, DIMENSION(kdlon,3), INTENT(out) :: topswcf_aero - REAL, DIMENSION(kdlon,3), INTENT(out) :: solswcf_aero - REAL, DIMENSION(kdlon,kflev+1), INTENT(out) :: ZSWFT0_i - REAL, DIMENSION(kdlon,kflev+1), INTENT(out) :: ZLWFT0_i - REAL, INTENT(inout) :: albpla(KLON) - !Ecrad : - REAL(KIND=8), INTENT(out) :: cloud_cover_sw(klon), & ! SW cloud cover issued from Rcrad - ZFLUX_DIR(klon,klev+1), & ! Direct compt of surf flux into horizontal plane - ZFLUX_DIR_CLEAR(klon,klev+1), & ! CS Direct - ZFLUX_DIR_INTO_SUN(klon) - - ! Local variables - REAL(KIND=8) ZFSUP(KDLON,KFLEV+1) - REAL(KIND=8) ZFSDN(KDLON,KFLEV+1) - REAL(KIND=8) ZFSUP0(KDLON,KFLEV+1) - REAL(KIND=8) ZFSDN0(KDLON,KFLEV+1) - REAL(KIND=8) ZFSUPC0(KDLON,KFLEV+1) - REAL(KIND=8) ZFSDNC0(KDLON,KFLEV+1) - REAL(KIND=8) ZFLUP(KDLON,KFLEV+1) - REAL(KIND=8) ZFLDN(KDLON,KFLEV+1) - REAL(KIND=8) ZFLUP0(KDLON,KFLEV+1) - REAL(KIND=8) ZFLDN0(KDLON,KFLEV+1) - REAL(KIND=8) ZFLUPC0(KDLON,KFLEV+1) - REAL(KIND=8) ZFLDNC0(KDLON,KFLEV+1) - REAL(KIND=8) zx_alpha1, zx_alpha2 - INTEGER k, i, iof - INTEGER ist,iend,ktdia,kmode - REAL(KIND=8) PSCT - REAL(KIND=8) PALBD(kdlon,2), PALBP(kdlon,2) - ! MPL 06.01.09: pour RRTM, creation de PALBD_NEW et PALBP_NEW - ! avec NSW en deuxieme dimension - REAL(KIND=8) PALBD_NEW(kdlon,NSW), PALBP_NEW(kdlon,NSW) - REAL(KIND=8) PEMIS(kdlon), PDT0(kdlon), PVIEW(kdlon) - REAL(KIND=8) PPSOL(kdlon), PDP(kdlon,KLEV) - REAL(KIND=8) PTL(kdlon,kflev+1), PPMB(kdlon,kflev+1) - REAL(KIND=8) PTAVE(kdlon,kflev) - REAL(KIND=8) PWV(kdlon,kflev), PQS(kdlon,kflev) - - REAL(kind=8) POZON(kdlon, kflev, size(wo, 3)) ! mass fraction of ozone - ! "POZON(:, :, 1)" is for the average day-night field, - ! "POZON(:, :, 2)" is for daylight time. - ! Modif MPL 6.01.09 avec RRTM, on passe de 5 a 6 - REAL(KIND=8) PAER(kdlon,kflev,6) - REAL(KIND=8) PCLDLD(kdlon,kflev) - REAL(KIND=8) PCLDLU(kdlon,kflev) - REAL(KIND=8) PCLDSW(kdlon,kflev) - REAL(KIND=8) PTAU(kdlon,2,kflev) - REAL(KIND=8) POMEGA(kdlon,2,kflev) - REAL(KIND=8) PCG(kdlon,2,kflev) - REAL(KIND=8) zfract(kdlon), zrmu0(kdlon), zdist - REAL(KIND=8) zheat(kdlon,kflev), zcool(kdlon,kflev) - REAL(KIND=8) zheat0(kdlon,kflev), zcool0(kdlon,kflev) - REAL(KIND=8) zheat_volc(kdlon,kflev), zcool_volc(kdlon,kflev) !NL - REAL(KIND=8) ztopsw(kdlon), ztoplw(kdlon) - REAL(KIND=8) zsolsw(kdlon), zsollw(kdlon), zalbpla(kdlon), zsolswfdiff(kdlon) - REAL(KIND=8) zsollwdown(kdlon) - REAL(KIND=8) ztopsw0(kdlon), ztoplw0(kdlon) - REAL(KIND=8) zsolsw0(kdlon), zsollw0(kdlon) - REAL(KIND=8) tauaero(kdlon,kflev,naero_grp,2) ! aer opt properties - REAL(KIND=8) pizaero(kdlon,kflev,naero_grp,2) - REAL(KIND=8) cgaero(kdlon,kflev,naero_grp,2) - REAL(KIND=8) PTAUA(kdlon,2,kflev) ! present-day value of cloud opt thickness (PTAU is pre-industrial value), local use - REAL(KIND=8) POMEGAA(kdlon,2,kflev) ! dito for single scatt albedo - REAL(KIND=8) ztopswadaero(kdlon), zsolswadaero(kdlon) ! Aerosol direct forcing at TOAand surface - REAL(KIND=8) ztopswad0aero(kdlon), zsolswad0aero(kdlon) ! Aerosol direct forcing at TOAand surface - REAL(KIND=8) ztopswaiaero(kdlon), zsolswaiaero(kdlon) ! dito, indirect - !--NL - REAL(KIND=8) zswadaero(kdlon,kflev+1) ! SW Aerosol direct forcing - !-LW by CK - REAL(KIND=8) ztoplwadaero(kdlon), zsollwadaero(kdlon) ! LW Aerosol direct forcing at TOAand surface - REAL(KIND=8) ztoplwad0aero(kdlon), zsollwad0aero(kdlon) ! LW Aerosol direct forcing at TOAand surface - REAL(KIND=8) ztoplwaiaero(kdlon), zsollwaiaero(kdlon) ! dito, indirect - !-end - REAL(KIND=8) ztopsw_aero(kdlon,9), ztopsw0_aero(kdlon,9) - REAL(KIND=8) zsolsw_aero(kdlon,9), zsolsw0_aero(kdlon,9) - REAL(KIND=8) ztopswcf_aero(kdlon,3), zsolswcf_aero(kdlon,3) - REAL(KIND=8) ZFLUCDWN_i(klon,klev+1),ZFLUCUP_i(klon,klev+1) - - REAL(KIND=8) ZFCDWN_i (klon,klev+1) - REAL(KIND=8) ZFCCDWN_i (klon,klev+1) - REAL(KIND=8) ZFCUP_i (klon,klev+1) - REAL(KIND=8) ZFCCUP_i (klon,klev+1) - REAL(KIND=8) ZFLCCDWN_i (klon,klev+1) - REAL(KIND=8) ZFLCCUP_i (klon,klev+1) - - ! ========= INITIALISATIONS ============================================== - CALL lmdz_rad_ini( & - ist,iend,ktdia,kmode, & - dist, rmu0, fract, & - paprs, pplay,tsol,SFRWL,alb_dir, alb_dif, & - t,q,wo, cldfra, cldemi, cldtaupd,& - tau_aero, piz_aero, cg_aero,& - tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm,& - cldtaupi, & - qsat, flwc, fiwc, iof, & - heat,heat0,cool,cool0,& - heat_volc, cool_volc,& - zheat,zheat0,zcool,zcool0,& - zheat_volc, zcool_volc,& - zdist,PSCT,zfract,zrmu0, & - PAER,PCLDLD,PCLDLU,PCLDSW,& - PTAU,PTAUA,POMEGA,POMEGAA,PCG, & - PALBD,PALBP,PALBD_NEW,PALBP_NEW,& - PEMIS,PDT0,PVIEW,PPSOL,PDP, & - PTL,PPMB,PTAVE,PWV,PQS, & - zx_alpha1,zx_alpha2,POZON, & - tauaero,pizaero,cgaero, & - ztopsw_aero,ztopsw0_aero,zsolsw_aero,zsolsw0_aero, & - ztopswcf_aero,zsolswcf_aero,& - ztopswadaero,zsolswadaero,ztopswad0aero, & - zsolswad0aero,zsollwadaero,zsollwad0aero, & - ztopswaiaero,zsolswaiaero,ztoplwaiaero,zsollwaiaero) - - IF (iflag_rrtm == 0) THEN ! remettre 0 juste pour tester l'ancien rayt via rrtm - ! {{{ - !--- Mise a zero des tableaux output du rayonnement LW-AR4 ---------- - DO k = 1, kflev+1 - DO i = 1, kdlon - ! print *,'RADLWSW: boucle mise a zero i k',i,k - ZFLUP(i,k)=0. - ZFLDN(i,k)=0. - ZFLUP0(i,k)=0. - ZFLDN0(i,k)=0. - ZLWFT0_i(i,k)=0. - ZFLUCUP_i(i,k)=0. - ZFLUCDWN_i(i,k)=0. - ENDDO - ENDDO - DO k = 1, kflev - DO i = 1, kdlon - zcool(i,k)=0. - zcool_volc(i,k)=0. !NL - zcool0(i,k)=0. - ENDDO - ENDDO - DO i = 1, kdlon - ztoplw(i)=0. - zsollw(i)=0. - ztoplw0(i)=0. - zsollw0(i)=0. - zsollwdown(i)=0. - ztoplwad0aero(i) = 0. - ztoplwadaero(i) = 0. - ENDDO - ! Old radiation scheme, used for AR4 runs - ! average day-night ozone for longwave - CALL LW_LMDAR4(& - PPMB, PDP,& - PPSOL,PDT0,PEMIS,& - PTL, PTAVE, PWV, POZON(:, :, 1), PAER,& - PCLDLD,PCLDLU,& - PVIEW,& - zcool, zcool0,& - ztoplw,zsollw,ztoplw0,zsollw0,& - zsollwdown,& - ZFLUP, ZFLDN, ZFLUP0,ZFLDN0) - !----- Mise a zero des tableaux output du rayonnement SW-AR4 - DO k = 1, kflev+1 - DO i = 1, kdlon - ZFSUP(i,k)=0. - ZFSDN(i,k)=0. - ZFSUP0(i,k)=0. - ZFSDN0(i,k)=0. - ZFSUPC0(i,k)=0. - ZFSDNC0(i,k)=0. - ZFLUPC0(i,k)=0. - ZFLDNC0(i,k)=0. - ZSWFT0_i(i,k)=0. - ZFCUP_i(i,k)=0. - ZFCDWN_i(i,k)=0. - ZFCCUP_i(i,k)=0. - ZFCCDWN_i(i,k)=0. - ZFLCCUP_i(i,k)=0. - ZFLCCDWN_i(i,k)=0. - zswadaero(i,k)=0. !--NL - ENDDO - ENDDO - DO k = 1, kflev - DO i = 1, kdlon - zheat(i,k)=0. - zheat_volc(i,k)=0. - zheat0(i,k)=0. - ENDDO - ENDDO - DO i = 1, kdlon - zalbpla(i)=0. - ztopsw(i)=0. - zsolsw(i)=0. - ztopsw0(i)=0. - zsolsw0(i)=0. - ztopswadaero(i)=0. - zsolswadaero(i)=0. - ztopswaiaero(i)=0. - zsolswaiaero(i)=0. - ENDDO - - !--fraction of diffuse radiation in surface SW downward radiation - !--not computed with old radiation scheme - zsolswfdiff(:) = -999.999 - - ! print *,'Avant SW_LMDAR4: PSCT zrmu0 zfract',PSCT, zrmu0, zfract - ! daylight ozone, if we have it, for short wave - CALL SW_AEROAR4(PSCT, zrmu0, zfract,& - PPMB, PDP,& - PPSOL, PALBD, PALBP,& - PTAVE, PWV, PQS, POZON(:, :, size(wo, 3)), PAER,& - PCLDSW, PTAU, POMEGA, PCG,& - zheat, zheat0,& - zalbpla,ztopsw,zsolsw,ztopsw0,zsolsw0,& - ZFSUP,ZFSDN,ZFSUP0,ZFSDN0,& - tauaero, pizaero, cgaero, & - PTAUA, POMEGAA,& - ztopswadaero,zsolswadaero,& - ztopswad0aero,zsolswad0aero,& - ztopswaiaero,zsolswaiaero, & - ztopsw_aero,ztopsw0_aero,& - zsolsw_aero,zsolsw0_aero,& - ztopswcf_aero,zsolswcf_aero, & - ok_ade, ok_aie, flag_aerosol,flag_aerosol_strat) - - ZSWFT0_i(:,:) = ZFSDN0(:,:)-ZFSUP0(:,:) - ZLWFT0_i(:,:) =-ZFLDN0(:,:)-ZFLUP0(:,:) - - ENDIF - !====================================================================== - - ! ----- flux radiatifs => sorties --------------------------------- - - CALL lmdz_rad_out( & - iof,PWV, & - ZFSUP,ZFSDN,ZFSUP0,ZFSDN0, & - ZFSUPC0,ZFSDNC0,ZFLUP,ZFLDN, & - ZFLUP0,ZFLDN0,ZFLUPC0,ZFLDNC0, & - zheat,zcool,zheat0,zcool0,zheat_volc,zcool_volc, & - ztopsw,ztoplw,zsolsw,zsollw,zalbpla,zsolswfdiff, & - zsollwdown,ztopsw0,ztoplw0,zsolsw0,zsollw0, & - ztopswadaero,zsolswadaero,ztopswad0aero,zsolswad0aero, & - ztopswaiaero,zsolswaiaero,ztoplwadaero,zsollwadaero, & - ztoplwad0aero,zsollwad0aero,ztoplwaiaero,zsollwaiaero, & - ztopsw_aero,ztopsw0_aero,zsolsw_aero,zsolsw0_aero, & - ztopswcf_aero,zsolswcf_aero, & - heat,heat0,cool,cool0,albpla,heat_volc, cool_volc,& - topsw,toplw,solsw,solswfdiff,sollw,sollwdown,& - topsw0,toplw0,solsw0,sollw0,& - lwdnc0,lwdn0,lwdn,lwupc0,lwup0,lwup,& - swdnc0,swdn0,swdn,swupc0,swup0,swup,& - topswad_aero,solswad_aero,topswai_aero,solswai_aero, & - topswad0_aero,solswad0_aero,topsw_aero,topsw0_aero,& - solsw_aero,solsw0_aero,topswcf_aero,solswcf_aero,& - toplwad_aero,sollwad_aero,toplwai_aero,sollwai_aero, & - toplwad0_aero,sollwad0_aero, & - cloud_cover_sw,ZFLUX_DIR,ZFLUX_DIR_CLEAR,ZFLUX_DIR_INTO_SUN) - - END SUBROUTINE lmdz_call_oldrad - -END MODULE lmdz_call_oldrad_m Index: /LMDZ6/trunk/libf/phylmd/lmdz_call_radiation.F90 =================================================================== --- /LMDZ6/trunk/libf/phylmd/lmdz_call_radiation.F90 (revision 6181) +++ /LMDZ6/trunk/libf/phylmd/lmdz_call_radiation.F90 (revision 6181) @@ -0,0 +1,363 @@ +! +! $Id$ +! + +MODULE lmdz_call_radiation + + IMPLICIT NONE + +contains + + SUBROUTINE call_radiation( & + debut, dist, rmu0, fract, & + paprs, pplay, tsol, SFRWL,alb_dir, alb_dif, & + t, q, wo, cldfra, cldemi, cldtaupd,& + tau_aero, piz_aero, cg_aero,& + tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm,& + tau_aero_lw_rrtm, cldtaupi, m_allaer, & + qsat, flwc, fiwc, & + ref_liq, ref_ice, ref_liq_pi, ref_ice_pi, & + namelist_ecrad_file, & + heat,heat0,cool,cool0,albpla,heat_volc, cool_volc,& + topsw, toplw, solsw, solswfdiff, sollw,& + sollwdown, topsw0, toplw0, solsw0, sollw0,& + lwdnc0, lwdn0, lwdn, lwupc0, lwup0, lwup,& + lwtoa0b, lwtoab , & + swdnc0, swdn0, swdn, swupc0, swup0, swup,& + topswad_aero, solswad_aero, topswai_aero, solswai_aero, & + topswad0_aero, solswad0_aero, topsw_aero, topsw0_aero,& + solsw_aero, solsw0_aero, topswcf_aero, solswcf_aero,& + toplwad_aero, sollwad_aero, toplwai_aero, sollwai_aero, & + toplwad0_aero, sollwad0_aero, & + ZLWFT0_i, ZFLDN0, ZFLUP0, ZSWFT0_i, ZFSDN0, ZFSUP0, & + ZFLUX_DIR, ZFLUX_DIR_CLEAR, ZFLUX_DIR_INTO_SUN, & + cloud_cover_sw) + + !======================================================================================================== + ! A. Idelkadi, F. Hourdin, L. Fairhead, mars 2026 : + ! Recriture de l interface entre LMDZ et les codes radiatifs oldrad/rrtm/ecrad => + ! lmdz_call_radiatifcodes_m.F90 + ! ------------------------------------------------------------------------------------------ + ! -> - Declarations => in / out / locales + ! - Appel de chaque interface avec le code radiatif (pilote par le flag iflag_rrtm) : + ! 0 => CALL lmdz_call_oldrad + ! 1 => CALL lmdz_call_rrtm + ! 2 => CALL lmdz_call_ecrad + ! -> A FAIRE + ! - Cles logiques a introduire : oldrad_rad / rrtm_rad / ecrad_rad + ! - Nettoyage bloc declarations : + ! * USE (supprimer use inutules / identifier les variables par ONLY) + ! * declaraions variables locales + ! * cles CPP + ! Structure de chaque interface (rad=oldrad/rrtm/ecrad) => lmdz_call_$rad_m.F90 + ! -> - Declarations + ! - CALL lmdz_call_rad_ini + ! - CALL $rad + ! - CALL lmdz_call_rad_out + ! -> A FAIRE + ! * Nettoyer les déclarations, warnings, ... + ! * Cles CPP + !====================================================================== + + !====================================================================== + ! Auteur(s): Z.X. Li (LMD/CNRS) date: 19960719 + ! Objet: interface entre le modele et les rayonnements + ! Arguments: + ! INPUTS + ! dist----- input-R- distance astronomique terre-soleil + ! rmu0----- input-R- cosinus de l'angle zenithal + ! fract---- input-R- duree d'ensoleillement normalisee + ! co2_ppm-- input-R- concentration du gaz carbonique (en ppm) + ! paprs---- input-R- pression a inter-couche (Pa) + ! pplay---- input-R- pression au milieu de couche (Pa) + ! tsol----- input-R- temperature du sol (en K) + ! alb1----- input-R- albedo du sol(entre 0 et 1) dans l'interval visible + ! alb2----- input-R- albedo du sol(entre 0 et 1) dans l'interval proche infra-rouge + ! t-------- input-R- temperature (K) + ! q-------- input-R- vapeur d'eau (en kg/kg) + ! cldfra--- input-R- fraction nuageuse (entre 0 et 1) + ! cldtaupd- input-R- epaisseur optique des nuages dans le visible (present-day value) + ! cldemi--- input-R- emissivite des nuages dans l'IR (entre 0 et 1) + ! ok_ade--- input-L- apply the Aerosol Direct Effect or not? + ! ok_aie--- input-L- apply the Aerosol Indirect Effect or not? + ! ok_volcan input-L- activate volcanic diags (SW heat & LW cool rate, SW & LW flux) + ! flag_volc_surfstrat input-I- activate volcanic surf cooling or strato heating (or nothing) + ! flag_aerosol input-I- aerosol flag from 0 to 6 + ! flag_aerosol_strat input-I- use stratospheric aerosols flag (0, 1, 2) + ! flag_aer_feedback input-I- activate aerosol radiative feedback (T, F) + ! tau_ae, piz_ae, cg_ae input-R- aerosol optical properties (calculated in aeropt.F) + ! cldtaupi input-R- epaisseur optique des nuages dans le visible + ! calculated for pre-industrial (pi) aerosol concentrations, i.e. with smaller + ! droplet concentration, thus larger droplets, thus generally cdltaupi cldtaupd + ! it is needed for the diagnostics of the aerosol indirect radiative forcing + ! + ! OUTPUTS + ! heat-----output-R- echauffement atmospherique (visible) (K/jour) + ! cool-----output-R- refroidissement dans l'IR (K/jour) + ! albpla---output-R- albedo planetaire (entre 0 et 1) + ! topsw----output-R- flux solaire net au sommet de l'atm. + ! toplw----output-R- ray. IR montant au sommet de l'atmosphere + ! solsw----output-R- flux solaire net a la surface + ! solswfdiff----output-R- fraction de rayonnement diffus pour le flux solaire descendant a la surface + ! sollw----output-R- ray. IR montant a la surface + ! solswad---output-R- ray. solaire net absorbe a la surface (aerosol dir) + ! topswad---output-R- ray. solaire absorbe au sommet de l'atm. (aerosol dir) + ! solswai---output-R- ray. solaire net absorbe a la surface (aerosol ind) + ! topswai---output-R- ray. solaire absorbe au sommet de l'atm. (aerosol ind) + ! + ! heat_volc-----output-R- echauffement atmospherique du au forcage volcanique (visible) (K/s) + ! cool_volc-----output-R- refroidissement dans l'IR du au forcage volcanique (K/s) + ! + ! ATTENTION: swai and swad have to be interpreted in the following manner: + ! --------- + ! ok_ade=F & ok_aie=F -both are zero + ! ok_ade=T & ok_aie=F -aerosol direct forcing is F_{AD} = topsw-topswad + ! indirect is zero + ! ok_ade=F & ok_aie=T -aerosol indirect forcing is F_{AI} = topsw-topswai + ! direct is zero + ! ok_ade=T & ok_aie=T -aerosol indirect forcing is F_{AI} = topsw-topswai + ! aerosol direct forcing is F_{AD} = topswai-topswad + ! + ! --------- RRTM: output RECMWFL + ! ZEMTD (KPROMA,KLEV+1) ; TOTAL DOWNWARD LONGWAVE EMISSIVITY + ! ZEMTU (KPROMA,KLEV+1) ; TOTAL UPWARD LONGWAVE EMISSIVITY + ! ZTRSO (KPROMA,KLEV+1) ; TOTAL SHORTWAVE TRANSMISSIVITY + ! ZTH (KPROMA,KLEV+1) ; HALF LEVEL TEMPERATURE + ! ZCTRSO(KPROMA,2) ; CLEAR-SKY SHORTWAVE TRANSMISSIVITY + ! ZCEMTR(KPROMA,2) ; CLEAR-SKY NET LONGWAVE EMISSIVITY + ! ZTRSOD(KPROMA) ; TOTAL-SKY SURFACE SW TRANSMISSITY + ! ZLWFC (KPROMA,2) ; CLEAR-SKY LONGWAVE FLUXES + ! ZLWFT (KPROMA,KLEV+1) ; TOTAL-SKY LONGWAVE FLUXES + ! ZLWFT0(KPROMA,KLEV+1) ; CLEAR-SKY LONGWAVE FLUXES ! added by MPL 090109 + ! ZSWFC (KPROMA,2) ; CLEAR-SKY SHORTWAVE FLUXES + ! ZSWFT (KPROMA,KLEV+1) ; TOTAL-SKY SHORTWAVE FLUXES + ! ZSWFT0(KPROMA,KLEV+1) ; CLEAR-SKY SHORTWAVE FLUXES ! added by MPL 090109 + ! ZFLUX (KLON,2,KLEV+1) ; TOTAL LW FLUXES 1=up, 2=DWN ! added by MPL 080411 + ! ZFLUC (KLON,2,KLEV+1) ; CLEAR SKY LW FLUXES ! added by MPL 080411 + ! ZFSDWN(klon,KLEV+1) ; TOTAL SW DWN FLUXES ! added by MPL 080411 + ! ZFCDWN(klon,KLEV+1) ; CLEAR SKY SW DWN FLUXES ! added by MPL 080411 + ! ZFCCDWN(klon,KLEV+1) ; CLEAR SKY CLEAN (NO AEROSOL) SW DWN FLUXES ! added by OB 211117 + ! ZFSUP (klon,KLEV+1) ; TOTAL SW UP FLUXES ! added by MPL 080411 + ! ZFCUP (klon,KLEV+1) ; CLEAR SKY SW UP FLUXES ! added by MPL 080411 + ! ZFCCUP (klon,KLEV+1) ; CLEAR SKY CLEAN (NO AEROSOL) SW UP FLUXES ! added by OB 211117 + ! ZFLCCDWN(klon,KLEV+1) ; CLEAR SKY CLEAN (NO AEROSOL) LW DWN FLUXES ! added by OB 211117 + ! ZFLCCUP (klon,KLEV+1) ; CLEAR SKY CLEAN (NO AEROSOL) LW UP FLUXES ! added by OB 211117 + + ! ==================================================================== + ! Adapte au modele de chimie INCA par Celine Deandreis & Anne Cozic -- 2009 + ! 1 = ZERO + ! 2 = AER total + ! 3 = NAT + ! 4 = BC + ! 5 = SO4 + ! 6 = POM + ! 7 = DUST + ! 8 = SS + ! 9 = NO3 + ! ===================================================================== + + ! ===================================================================== +! --------------------- DECLARATIONS ------------------------------------ + ! ===================================================================== +! Modules necessaires + USE DIMPHY + USE clesphys_mod_h, ONLY: nsw + USE aero_mod + USE conf_phys_m, ONLY: & + !ok_ade,ok_aie,ok_volcan,flag_volc_surfstrat, & + !flag_aerosol,flag_aerosol_strat, & + iflag_rrtm,ok_2xcall_ecrad + + USE lmdz_call_oldrad + USE lmdz_call_rrtm + USE lmdz_call_ecrad + USE assert_m, ONLY : assert + ! +#ifdef CPP_RRTM + USE YOERAD , ONLY : NLW + USE YOMPHY3 , ONLY : RII0 +#endif + +! ------------- Input arguments --------------------------------------------------------------------------- + REAL, INTENT(in) :: dist + REAL, INTENT(in) :: rmu0(KLON), fract(KLON) + REAL, INTENT(in) :: paprs(KLON,KLEV+1), pplay(KLON,KLEV) + REAL, INTENT(in) :: tsol(KLON) + REAL, INTENT(in) :: alb_dir(KLON,NSW),alb_dif(KLON,NSW) + REAL, INTENT(in) :: SFRWL(6) + REAL, INTENT(in) :: t(KLON,KLEV), q(KLON,KLEV) + REAL, INTENT(in) :: wo(:, :, :) ! dimension(KLON,KLEV, 1 or 2) + ! column-density of ozone in a layer, in kilo-Dobsons + ! "wo(:, :, 1)" is for the average day-night field, + ! "wo(:, :, 2)" is for daylight time. + REAL, INTENT(in) :: cldfra(KLON,KLEV), cldemi(KLON,KLEV), cldtaupd(KLON,KLEV) + REAL, INTENT(in) :: tau_aero(KLON,KLEV,naero_grp,2) ! aerosol optical properties (see aeropt.F) + REAL, INTENT(in) :: piz_aero(KLON,KLEV,naero_grp,2) ! aerosol optical properties (see aeropt.F) + REAL, INTENT(in) :: cg_aero(KLON,KLEV,naero_grp,2) ! aerosol optical properties (see aeropt.F) + REAL, INTENT(in) :: tau_aero_sw_rrtm(KLON,KLEV,2,NSW) ! aerosol optical properties RRTM + REAL, INTENT(in) :: piz_aero_sw_rrtm(KLON,KLEV,2,NSW) ! aerosol optical properties RRTM + REAL, INTENT(in) :: cg_aero_sw_rrtm(KLON,KLEV,2,NSW) ! aerosol optical properties RRTM +#ifdef CPP_RRTM + REAL, INTENT(in) :: tau_aero_lw_rrtm(KLON,KLEV,2,NLW) ! LW aerosol optical properties RRTM +#else + REAL, INTENT(in) :: tau_aero_lw_rrtm(KLON,KLEV,2,nbands_lw_rrtm) +#endif + REAL, INTENT(in) :: cldtaupi(KLON,KLEV) ! cloud optical thickness for pre-industrial aerosol concentrations + REAL, INTENT(in) :: qsat(klon,klev) ! Variable pour iflag_rrtm=1 + REAL, INTENT(in) :: flwc(klon,klev) ! Variable pour iflag_rrtm=1 + REAL, INTENT(in) :: fiwc(klon,klev) ! Variable pour iflag_rrtm=1 + REAL, INTENT(in) :: ref_liq(klon,klev) ! cloud droplet radius present-day from newmicro + REAL, INTENT(in) :: ref_ice(klon,klev) ! ice crystal radius present-day from newmicro + REAL, INTENT(in) :: ref_liq_pi(klon,klev) ! cloud droplet radius pre-industrial from newmicro + REAL, INTENT(in) :: ref_ice_pi(klon,klev) ! ice crystal radius pre-industrial from newmicro + REAL, INTENT(in) :: m_allaer(klon,klev,naero_tot) ! mass aero + + CHARACTER(len=512), INTENT(in) :: namelist_ecrad_file + LOGICAL, INTENT(in) :: debut + +! --------------- Output arguments ------------------------------------------------------- + REAL, INTENT(out) :: heat(KLON,KLEV), cool(KLON,KLEV) + REAL, INTENT(out) :: heat0(KLON,KLEV), cool0(KLON,KLEV) + REAL, INTENT(out) :: heat_volc(KLON,KLEV), cool_volc(KLON,KLEV) !NL + REAL, INTENT(out) :: topsw(KLON), toplw(KLON) + REAL, INTENT(out) :: solsw(KLON), sollw(KLON), albpla(KLON), solswfdiff(KLON) + REAL, INTENT(out) :: topsw0(KLON), toplw0(KLON), solsw0(KLON), sollw0(KLON) + REAL, INTENT(out) :: sollwdown(KLON) + REAL, INTENT(out) :: swdn(KLON,kflev+1),swdn0(KLON,kflev+1), swdnc0(KLON,kflev+1) + REAL, INTENT(out) :: swup(KLON,kflev+1),swup0(KLON,kflev+1), swupc0(KLON,kflev+1) + REAL, INTENT(out) :: lwdn(KLON,kflev+1),lwdn0(KLON,kflev+1), lwdnc0(KLON,kflev+1) + REAL, INTENT(out) :: lwup(KLON,kflev+1),lwup0(KLON,kflev+1), lwupc0(KLON,kflev+1) + ! ??? + REAL, DIMENSION(kdlon,kflev+1), INTENT(out) :: ZSWFT0_i + REAL, DIMENSION(kdlon,kflev+1), INTENT(out) :: ZLWFT0_i + !FC je remplace NLW par nbands_lw_rrtm qui est defini dans aero_mod peut etre que a ce niveau NLW est attribué? + REAL, INTENT(out) :: lwtoa0b(KLON,nbands_lw_rrtm), lwtoab(KLON,nbands_lw_rrtm) !FC flux TOA LW par bandes + ! aerosols + REAL, INTENT(out) :: topswad_aero(KLON), solswad_aero(KLON) ! output: aerosol direct forcing at TOA and surface + REAL, INTENT(out) :: topswai_aero(KLON), solswai_aero(KLON) ! output: aerosol indirect forcing atTOA and surface + REAL, INTENT(out) :: toplwad_aero(KLON), sollwad_aero(KLON) ! output: LW aerosol direct forcing at TOA and surface + REAL, INTENT(out) :: toplwai_aero(KLON), sollwai_aero(KLON) ! output: LW aerosol indirect forcing atTOA and surface + REAL, DIMENSION(klon), INTENT(out) :: topswad0_aero + REAL, DIMENSION(klon), INTENT(out) :: solswad0_aero + REAL, DIMENSION(klon), INTENT(out) :: toplwad0_aero + REAL, DIMENSION(klon), INTENT(out) :: sollwad0_aero + REAL, DIMENSION(kdlon,9), INTENT(out) :: topsw_aero + REAL, DIMENSION(kdlon,9), INTENT(out) :: topsw0_aero + REAL, DIMENSION(kdlon,9), INTENT(out) :: solsw_aero + REAL, DIMENSION(kdlon,9), INTENT(out) :: solsw0_aero + REAL, DIMENSION(kdlon,3), INTENT(out) :: topswcf_aero + REAL, DIMENSION(kdlon,3), INTENT(out) :: solswcf_aero + !Ecrad : + REAL(KIND=8), INTENT(out) :: cloud_cover_sw(klon), & ! SW cloud cover issued from Ecrad + ZFLUX_DIR(klon,klev+1), & ! Direct compt of surf flux into horizontal plane + ZFLUX_DIR_CLEAR(klon,klev+1), & ! CS Direct + ZFLUX_DIR_INTO_SUN(klon) + +! -------- Local var ------------------------------------------------------ + REAL(KIND=8) ZFSUP0(KDLON,KFLEV+1) + REAL(KIND=8) ZFSDN0(KDLON,KFLEV+1) + REAL(KIND=8) ZFLUP0(KDLON,KFLEV+1) + REAL(KIND=8) ZFLDN0(KDLON,KFLEV+1) + CHARACTER (LEN=80) :: abort_message + CHARACTER (LEN=80) :: modname='lmdz_call_radiatifcodes_m' + + PRINT*,'size(wo, 1), klon, size(wo, 2), klev', & + size(wo, 1), klon, size(wo, 2), klev + + CALL assert(size(wo, 1) == klon, size(wo, 2) == klev, "lmdz_call_radiatifcodes wo") + + ! + !===== iflag_rrtm ================================================ + ! + test_iflag_rrtm: & + IF (iflag_rrtm == 0) THEN ! Oldrad + + CALL call_oldrad ( & + dist, rmu0, fract, & + paprs, pplay, tsol, SFRWL, alb_dir, alb_dif, & + t, q, wo, cldfra, cldemi, cldtaupd,& + tau_aero, piz_aero, cg_aero,& + tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm,& ! rajoute par OB RRTM + cldtaupi, qsat, flwc, fiwc, & + heat, heat0, cool, cool0, albpla, heat_volc, cool_volc,& + topsw, toplw, solsw, solswfdiff, sollw, sollwdown,& + topsw0, toplw0, solsw0, sollw0,& + lwdnc0, lwdn0, lwdn, lwupc0, lwup0, lwup,& + swdnc0, swdn0, swdn, swupc0, swup0, swup,& + topswad_aero, solswad_aero, topswai_aero, solswai_aero, & + topswad0_aero, solswad0_aero, topsw_aero, topsw0_aero,& + solsw_aero, solsw0_aero, topswcf_aero, solswcf_aero,& + toplwad_aero, sollwad_aero, toplwai_aero, sollwai_aero, & + toplwad0_aero, sollwad0_aero, & + ZLWFT0_i, ZFLDN0, ZFLUP0, ZSWFT0_i, ZFSDN0, ZFSUP0, & + ZFLUX_DIR, ZFLUX_DIR_CLEAR, ZFLUX_DIR_INTO_SUN, & + cloud_cover_sw) + + ELSE IF (iflag_rrtm == 1) then test_iflag_rrtm ! RRTM +#ifdef CPP_RRTM + + CALL call_rrtm ( & + dist, rmu0, fract, & + paprs, pplay,tsol,SFRWL,alb_dir, alb_dif, & + t, q, wo, cldfra, cldemi, cldtaupd,& + tau_aero, piz_aero, cg_aero,& + tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm,& + tau_aero_lw_rrtm, cldtaupi, & + qsat, flwc, fiwc, ref_liq, ref_ice, ref_liq_pi, ref_ice_pi, & + heat, heat0, cool, cool0, albpla, heat_volc, cool_volc,& + topsw, toplw, solsw, solswfdiff,sollw,& + sollwdown, topsw0, toplw0, solsw0, sollw0,& + lwdnc0, lwdn0, lwdn, lwupc0, lwup0, lwup,& + lwtoa0b, lwtoab , & !FC flux spectraux LW TOA + swdnc0, swdn0, swdn, swupc0, swup0, swup,& + topswad_aero, solswad_aero, topswai_aero, solswai_aero, & + topswad0_aero, solswad0_aero, topsw_aero, topsw0_aero,& + solsw_aero, solsw0_aero, topswcf_aero, solswcf_aero,& + toplwad_aero, sollwad_aero, toplwai_aero, sollwai_aero, & + toplwad0_aero, sollwad0_aero, & + ZLWFT0_i, ZFLDN0, ZFLUP0, ZSWFT0_i, ZFSDN0, ZFSUP0, & + ZFLUX_DIR, ZFLUX_DIR_CLEAR, ZFLUX_DIR_INTO_SUN, & + cloud_cover_sw) + +#else + abort_message="You should compile with -rrtm if running with iflag_rrtm=1" + call abort_physic(modname, abort_message, 1) +#endif + !====================================================================== + ! AI fev 2021 + ELSE IF(iflag_rrtm == 2) THEN test_iflag_rrtm ! ECRAD + PRINT*,'Traitement cas iflag_rrtm = ',iflag_rrtm +#ifdef CPP_ECRAD + CALL call_ecrad ( & + debut, dist, rmu0, fract, & + paprs, pplay,tsol,SFRWL,alb_dir, alb_dif, & + t, q, wo, cldfra, cldemi, cldtaupd,& + tau_aero, piz_aero, cg_aero,& + tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm,& ! rajoute par OB RRTM + cldtaupi, m_allaer, qsat, flwc, fiwc, & + ref_liq, ref_ice, & + namelist_ecrad_file, & + heat,heat0,cool,cool0,albpla,heat_volc, cool_volc,& + topsw,toplw,solsw,solswfdiff,sollw,& + sollwdown,topsw0,toplw0,solsw0,sollw0,& + lwdnc0, lwdn0, lwdn, lwupc0, lwup0, lwup,& + swdnc0, swdn0, swdn, swupc0, swup0, swup,& + topswad_aero, solswad_aero, topswai_aero, solswai_aero, & + topswad0_aero, solswad0_aero, topsw_aero, topsw0_aero,& + solsw_aero, solsw0_aero, topswcf_aero, solswcf_aero,& + toplwad_aero, sollwad_aero, toplwai_aero, sollwai_aero, & + toplwad0_aero, sollwad0_aero, & + ZLWFT0_i, ZFLDN0, ZFLUP0, ZSWFT0_i, ZFSDN0, ZFSUP0, & + ZFLUX_DIR, ZFLUX_DIR_CLEAR, ZFLUX_DIR_INTO_SUN, & + cloud_cover_sw) +#else + abort_message="You should compile with -rrtm if running with iflag_rrtm=2" + call abort_physic(modname, abort_message, 1) +#endif + PRINT*,'Fin traitement ECRAD' + ! Fin ECRAD + ENDIF test_iflag_rrtm + !====================================================================== + + END SUBROUTINE call_radiation +END MODULE lmdz_call_radiation Index: DZ6/trunk/libf/phylmd/lmdz_call_rads_m.F90 =================================================================== --- /LMDZ6/trunk/libf/phylmd/lmdz_call_rads_m.F90 (revision 6180) +++ (revision ) @@ -1,363 +1,0 @@ -! -! $Id$ -! - -MODULE lmdz_call_rads_m - - IMPLICIT NONE - -contains - - SUBROUTINE lmdz_call_rads( & - debut, dist, rmu0, fract, & - paprs, pplay, tsol, SFRWL,alb_dir, alb_dif, & - t, q, wo, cldfra, cldemi, cldtaupd,& - tau_aero, piz_aero, cg_aero,& - tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm,& - tau_aero_lw_rrtm, cldtaupi, m_allaer, & - qsat, flwc, fiwc, & - ref_liq, ref_ice, ref_liq_pi, ref_ice_pi, & - namelist_ecrad_file, & - heat,heat0,cool,cool0,albpla,heat_volc, cool_volc,& - topsw, toplw, solsw, solswfdiff, sollw,& - sollwdown, topsw0, toplw0, solsw0, sollw0,& - lwdnc0, lwdn0, lwdn, lwupc0, lwup0, lwup,& - lwtoa0b, lwtoab , & - swdnc0, swdn0, swdn, swupc0, swup0, swup,& - topswad_aero, solswad_aero, topswai_aero, solswai_aero, & - topswad0_aero, solswad0_aero, topsw_aero, topsw0_aero,& - solsw_aero, solsw0_aero, topswcf_aero, solswcf_aero,& - toplwad_aero, sollwad_aero, toplwai_aero, sollwai_aero, & - toplwad0_aero, sollwad0_aero, & - ZLWFT0_i, ZFLDN0, ZFLUP0, ZSWFT0_i, ZFSDN0, ZFSUP0, & - ZFLUX_DIR, ZFLUX_DIR_CLEAR, ZFLUX_DIR_INTO_SUN, & - cloud_cover_sw) - - !======================================================================================================== - ! A. Idelkadi, F. Hourdin, L. Fairhead, mars 2026 : - ! Recriture de l interface entre LMDZ et les codes radiatifs oldrad/rrtm/ecrad => - ! lmdz_call_radiatifcodes_m.F90 - ! ------------------------------------------------------------------------------------------ - ! -> - Declarations => in / out / locales - ! - Appel de chaque interface avec le code radiatif (pilote par le flag iflag_rrtm) : - ! 0 => CALL lmdz_call_oldrad - ! 1 => CALL lmdz_call_rrtm - ! 2 => CALL lmdz_call_ecrad - ! -> A FAIRE - ! - Cles logiques a introduire : oldrad_rad / rrtm_rad / ecrad_rad - ! - Nettoyage bloc declarations : - ! * USE (supprimer use inutules / identifier les variables par ONLY) - ! * declaraions variables locales - ! * cles CPP - ! Structure de chaque interface (rad=oldrad/rrtm/ecrad) => lmdz_call_$rad_m.F90 - ! -> - Declarations - ! - CALL lmdz_call_rad_ini - ! - CALL $rad - ! - CALL lmdz_call_rad_out - ! -> A FAIRE - ! * Nettoyer les déclarations, warnings, ... - ! * Cles CPP - !====================================================================== - - !====================================================================== - ! Auteur(s): Z.X. Li (LMD/CNRS) date: 19960719 - ! Objet: interface entre le modele et les rayonnements - ! Arguments: - ! INPUTS - ! dist----- input-R- distance astronomique terre-soleil - ! rmu0----- input-R- cosinus de l'angle zenithal - ! fract---- input-R- duree d'ensoleillement normalisee - ! co2_ppm-- input-R- concentration du gaz carbonique (en ppm) - ! paprs---- input-R- pression a inter-couche (Pa) - ! pplay---- input-R- pression au milieu de couche (Pa) - ! tsol----- input-R- temperature du sol (en K) - ! alb1----- input-R- albedo du sol(entre 0 et 1) dans l'interval visible - ! alb2----- input-R- albedo du sol(entre 0 et 1) dans l'interval proche infra-rouge - ! t-------- input-R- temperature (K) - ! q-------- input-R- vapeur d'eau (en kg/kg) - ! cldfra--- input-R- fraction nuageuse (entre 0 et 1) - ! cldtaupd- input-R- epaisseur optique des nuages dans le visible (present-day value) - ! cldemi--- input-R- emissivite des nuages dans l'IR (entre 0 et 1) - ! ok_ade--- input-L- apply the Aerosol Direct Effect or not? - ! ok_aie--- input-L- apply the Aerosol Indirect Effect or not? - ! ok_volcan input-L- activate volcanic diags (SW heat & LW cool rate, SW & LW flux) - ! flag_volc_surfstrat input-I- activate volcanic surf cooling or strato heating (or nothing) - ! flag_aerosol input-I- aerosol flag from 0 to 6 - ! flag_aerosol_strat input-I- use stratospheric aerosols flag (0, 1, 2) - ! flag_aer_feedback input-I- activate aerosol radiative feedback (T, F) - ! tau_ae, piz_ae, cg_ae input-R- aerosol optical properties (calculated in aeropt.F) - ! cldtaupi input-R- epaisseur optique des nuages dans le visible - ! calculated for pre-industrial (pi) aerosol concentrations, i.e. with smaller - ! droplet concentration, thus larger droplets, thus generally cdltaupi cldtaupd - ! it is needed for the diagnostics of the aerosol indirect radiative forcing - ! - ! OUTPUTS - ! heat-----output-R- echauffement atmospherique (visible) (K/jour) - ! cool-----output-R- refroidissement dans l'IR (K/jour) - ! albpla---output-R- albedo planetaire (entre 0 et 1) - ! topsw----output-R- flux solaire net au sommet de l'atm. - ! toplw----output-R- ray. IR montant au sommet de l'atmosphere - ! solsw----output-R- flux solaire net a la surface - ! solswfdiff----output-R- fraction de rayonnement diffus pour le flux solaire descendant a la surface - ! sollw----output-R- ray. IR montant a la surface - ! solswad---output-R- ray. solaire net absorbe a la surface (aerosol dir) - ! topswad---output-R- ray. solaire absorbe au sommet de l'atm. (aerosol dir) - ! solswai---output-R- ray. solaire net absorbe a la surface (aerosol ind) - ! topswai---output-R- ray. solaire absorbe au sommet de l'atm. (aerosol ind) - ! - ! heat_volc-----output-R- echauffement atmospherique du au forcage volcanique (visible) (K/s) - ! cool_volc-----output-R- refroidissement dans l'IR du au forcage volcanique (K/s) - ! - ! ATTENTION: swai and swad have to be interpreted in the following manner: - ! --------- - ! ok_ade=F & ok_aie=F -both are zero - ! ok_ade=T & ok_aie=F -aerosol direct forcing is F_{AD} = topsw-topswad - ! indirect is zero - ! ok_ade=F & ok_aie=T -aerosol indirect forcing is F_{AI} = topsw-topswai - ! direct is zero - ! ok_ade=T & ok_aie=T -aerosol indirect forcing is F_{AI} = topsw-topswai - ! aerosol direct forcing is F_{AD} = topswai-topswad - ! - ! --------- RRTM: output RECMWFL - ! ZEMTD (KPROMA,KLEV+1) ; TOTAL DOWNWARD LONGWAVE EMISSIVITY - ! ZEMTU (KPROMA,KLEV+1) ; TOTAL UPWARD LONGWAVE EMISSIVITY - ! ZTRSO (KPROMA,KLEV+1) ; TOTAL SHORTWAVE TRANSMISSIVITY - ! ZTH (KPROMA,KLEV+1) ; HALF LEVEL TEMPERATURE - ! ZCTRSO(KPROMA,2) ; CLEAR-SKY SHORTWAVE TRANSMISSIVITY - ! ZCEMTR(KPROMA,2) ; CLEAR-SKY NET LONGWAVE EMISSIVITY - ! ZTRSOD(KPROMA) ; TOTAL-SKY SURFACE SW TRANSMISSITY - ! ZLWFC (KPROMA,2) ; CLEAR-SKY LONGWAVE FLUXES - ! ZLWFT (KPROMA,KLEV+1) ; TOTAL-SKY LONGWAVE FLUXES - ! ZLWFT0(KPROMA,KLEV+1) ; CLEAR-SKY LONGWAVE FLUXES ! added by MPL 090109 - ! ZSWFC (KPROMA,2) ; CLEAR-SKY SHORTWAVE FLUXES - ! ZSWFT (KPROMA,KLEV+1) ; TOTAL-SKY SHORTWAVE FLUXES - ! ZSWFT0(KPROMA,KLEV+1) ; CLEAR-SKY SHORTWAVE FLUXES ! added by MPL 090109 - ! ZFLUX (KLON,2,KLEV+1) ; TOTAL LW FLUXES 1=up, 2=DWN ! added by MPL 080411 - ! ZFLUC (KLON,2,KLEV+1) ; CLEAR SKY LW FLUXES ! added by MPL 080411 - ! ZFSDWN(klon,KLEV+1) ; TOTAL SW DWN FLUXES ! added by MPL 080411 - ! ZFCDWN(klon,KLEV+1) ; CLEAR SKY SW DWN FLUXES ! added by MPL 080411 - ! ZFCCDWN(klon,KLEV+1) ; CLEAR SKY CLEAN (NO AEROSOL) SW DWN FLUXES ! added by OB 211117 - ! ZFSUP (klon,KLEV+1) ; TOTAL SW UP FLUXES ! added by MPL 080411 - ! ZFCUP (klon,KLEV+1) ; CLEAR SKY SW UP FLUXES ! added by MPL 080411 - ! ZFCCUP (klon,KLEV+1) ; CLEAR SKY CLEAN (NO AEROSOL) SW UP FLUXES ! added by OB 211117 - ! ZFLCCDWN(klon,KLEV+1) ; CLEAR SKY CLEAN (NO AEROSOL) LW DWN FLUXES ! added by OB 211117 - ! ZFLCCUP (klon,KLEV+1) ; CLEAR SKY CLEAN (NO AEROSOL) LW UP FLUXES ! added by OB 211117 - - ! ==================================================================== - ! Adapte au modele de chimie INCA par Celine Deandreis & Anne Cozic -- 2009 - ! 1 = ZERO - ! 2 = AER total - ! 3 = NAT - ! 4 = BC - ! 5 = SO4 - ! 6 = POM - ! 7 = DUST - ! 8 = SS - ! 9 = NO3 - ! ===================================================================== - - ! ===================================================================== -! --------------------- DECLARATIONS ------------------------------------ - ! ===================================================================== -! Modules necessaires - USE DIMPHY - USE clesphys_mod_h, ONLY: nsw - USE aero_mod - USE conf_phys_m, ONLY: & - !ok_ade,ok_aie,ok_volcan,flag_volc_surfstrat, & - !flag_aerosol,flag_aerosol_strat, & - iflag_rrtm,ok_2xcall_ecrad - - USE lmdz_call_oldrad_m - USE lmdz_call_rrtm_m - USE lmdz_call_ecrad_m - USE assert_m, ONLY : assert - ! -#ifdef CPP_RRTM - USE YOERAD , ONLY : NLW - USE YOMPHY3 , ONLY : RII0 -#endif - -! ------------- Input arguments --------------------------------------------------------------------------- - REAL, INTENT(in) :: dist - REAL, INTENT(in) :: rmu0(KLON), fract(KLON) - REAL, INTENT(in) :: paprs(KLON,KLEV+1), pplay(KLON,KLEV) - REAL, INTENT(in) :: tsol(KLON) - REAL, INTENT(in) :: alb_dir(KLON,NSW),alb_dif(KLON,NSW) - REAL, INTENT(in) :: SFRWL(6) - REAL, INTENT(in) :: t(KLON,KLEV), q(KLON,KLEV) - REAL, INTENT(in) :: wo(:, :, :) ! dimension(KLON,KLEV, 1 or 2) - ! column-density of ozone in a layer, in kilo-Dobsons - ! "wo(:, :, 1)" is for the average day-night field, - ! "wo(:, :, 2)" is for daylight time. - REAL, INTENT(in) :: cldfra(KLON,KLEV), cldemi(KLON,KLEV), cldtaupd(KLON,KLEV) - REAL, INTENT(in) :: tau_aero(KLON,KLEV,naero_grp,2) ! aerosol optical properties (see aeropt.F) - REAL, INTENT(in) :: piz_aero(KLON,KLEV,naero_grp,2) ! aerosol optical properties (see aeropt.F) - REAL, INTENT(in) :: cg_aero(KLON,KLEV,naero_grp,2) ! aerosol optical properties (see aeropt.F) - REAL, INTENT(in) :: tau_aero_sw_rrtm(KLON,KLEV,2,NSW) ! aerosol optical properties RRTM - REAL, INTENT(in) :: piz_aero_sw_rrtm(KLON,KLEV,2,NSW) ! aerosol optical properties RRTM - REAL, INTENT(in) :: cg_aero_sw_rrtm(KLON,KLEV,2,NSW) ! aerosol optical properties RRTM -#ifdef CPP_RRTM - REAL, INTENT(in) :: tau_aero_lw_rrtm(KLON,KLEV,2,NLW) ! LW aerosol optical properties RRTM -#else - REAL, INTENT(in) :: tau_aero_lw_rrtm(KLON,KLEV,2,nbands_lw_rrtm) -#endif - REAL, INTENT(in) :: cldtaupi(KLON,KLEV) ! cloud optical thickness for pre-industrial aerosol concentrations - REAL, INTENT(in) :: qsat(klon,klev) ! Variable pour iflag_rrtm=1 - REAL, INTENT(in) :: flwc(klon,klev) ! Variable pour iflag_rrtm=1 - REAL, INTENT(in) :: fiwc(klon,klev) ! Variable pour iflag_rrtm=1 - REAL, INTENT(in) :: ref_liq(klon,klev) ! cloud droplet radius present-day from newmicro - REAL, INTENT(in) :: ref_ice(klon,klev) ! ice crystal radius present-day from newmicro - REAL, INTENT(in) :: ref_liq_pi(klon,klev) ! cloud droplet radius pre-industrial from newmicro - REAL, INTENT(in) :: ref_ice_pi(klon,klev) ! ice crystal radius pre-industrial from newmicro - REAL, INTENT(in) :: m_allaer(klon,klev,naero_tot) ! mass aero - - CHARACTER(len=512), INTENT(in) :: namelist_ecrad_file - LOGICAL, INTENT(in) :: debut - -! --------------- Output arguments ------------------------------------------------------- - REAL, INTENT(out) :: heat(KLON,KLEV), cool(KLON,KLEV) - REAL, INTENT(out) :: heat0(KLON,KLEV), cool0(KLON,KLEV) - REAL, INTENT(out) :: heat_volc(KLON,KLEV), cool_volc(KLON,KLEV) !NL - REAL, INTENT(out) :: topsw(KLON), toplw(KLON) - REAL, INTENT(out) :: solsw(KLON), sollw(KLON), albpla(KLON), solswfdiff(KLON) - REAL, INTENT(out) :: topsw0(KLON), toplw0(KLON), solsw0(KLON), sollw0(KLON) - REAL, INTENT(out) :: sollwdown(KLON) - REAL, INTENT(out) :: swdn(KLON,kflev+1),swdn0(KLON,kflev+1), swdnc0(KLON,kflev+1) - REAL, INTENT(out) :: swup(KLON,kflev+1),swup0(KLON,kflev+1), swupc0(KLON,kflev+1) - REAL, INTENT(out) :: lwdn(KLON,kflev+1),lwdn0(KLON,kflev+1), lwdnc0(KLON,kflev+1) - REAL, INTENT(out) :: lwup(KLON,kflev+1),lwup0(KLON,kflev+1), lwupc0(KLON,kflev+1) - ! ??? - REAL, DIMENSION(kdlon,kflev+1), INTENT(out) :: ZSWFT0_i - REAL, DIMENSION(kdlon,kflev+1), INTENT(out) :: ZLWFT0_i - !FC je remplace NLW par nbands_lw_rrtm qui est defini dans aero_mod peut etre que a ce niveau NLW est attribué? - REAL, INTENT(out) :: lwtoa0b(KLON,nbands_lw_rrtm), lwtoab(KLON,nbands_lw_rrtm) !FC flux TOA LW par bandes - ! aerosols - REAL, INTENT(out) :: topswad_aero(KLON), solswad_aero(KLON) ! output: aerosol direct forcing at TOA and surface - REAL, INTENT(out) :: topswai_aero(KLON), solswai_aero(KLON) ! output: aerosol indirect forcing atTOA and surface - REAL, INTENT(out) :: toplwad_aero(KLON), sollwad_aero(KLON) ! output: LW aerosol direct forcing at TOA and surface - REAL, INTENT(out) :: toplwai_aero(KLON), sollwai_aero(KLON) ! output: LW aerosol indirect forcing atTOA and surface - REAL, DIMENSION(klon), INTENT(out) :: topswad0_aero - REAL, DIMENSION(klon), INTENT(out) :: solswad0_aero - REAL, DIMENSION(klon), INTENT(out) :: toplwad0_aero - REAL, DIMENSION(klon), INTENT(out) :: sollwad0_aero - REAL, DIMENSION(kdlon,9), INTENT(out) :: topsw_aero - REAL, DIMENSION(kdlon,9), INTENT(out) :: topsw0_aero - REAL, DIMENSION(kdlon,9), INTENT(out) :: solsw_aero - REAL, DIMENSION(kdlon,9), INTENT(out) :: solsw0_aero - REAL, DIMENSION(kdlon,3), INTENT(out) :: topswcf_aero - REAL, DIMENSION(kdlon,3), INTENT(out) :: solswcf_aero - !Ecrad : - REAL(KIND=8), INTENT(out) :: cloud_cover_sw(klon), & ! SW cloud cover issued from Ecrad - ZFLUX_DIR(klon,klev+1), & ! Direct compt of surf flux into horizontal plane - ZFLUX_DIR_CLEAR(klon,klev+1), & ! CS Direct - ZFLUX_DIR_INTO_SUN(klon) - -! -------- Local var ------------------------------------------------------ - REAL(KIND=8) ZFSUP0(KDLON,KFLEV+1) - REAL(KIND=8) ZFSDN0(KDLON,KFLEV+1) - REAL(KIND=8) ZFLUP0(KDLON,KFLEV+1) - REAL(KIND=8) ZFLDN0(KDLON,KFLEV+1) - CHARACTER (LEN=80) :: abort_message - CHARACTER (LEN=80) :: modname='lmdz_call_radiatifcodes_m' - - PRINT*,'size(wo, 1), klon, size(wo, 2), klev', & - size(wo, 1), klon, size(wo, 2), klev - - CALL assert(size(wo, 1) == klon, size(wo, 2) == klev, "lmdz_call_radiatifcodes wo") - - ! - !===== iflag_rrtm ================================================ - ! - test_iflag_rrtm: & - IF (iflag_rrtm == 0) THEN ! Oldrad - - CALL lmdz_call_oldrad( & - dist, rmu0, fract, & - paprs, pplay, tsol, SFRWL, alb_dir, alb_dif, & - t, q, wo, cldfra, cldemi, cldtaupd,& - tau_aero, piz_aero, cg_aero,& - tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm,& ! rajoute par OB RRTM - cldtaupi, qsat, flwc, fiwc, & - heat, heat0, cool, cool0, albpla, heat_volc, cool_volc,& - topsw, toplw, solsw, solswfdiff, sollw, sollwdown,& - topsw0, toplw0, solsw0, sollw0,& - lwdnc0, lwdn0, lwdn, lwupc0, lwup0, lwup,& - swdnc0, swdn0, swdn, swupc0, swup0, swup,& - topswad_aero, solswad_aero, topswai_aero, solswai_aero, & - topswad0_aero, solswad0_aero, topsw_aero, topsw0_aero,& - solsw_aero, solsw0_aero, topswcf_aero, solswcf_aero,& - toplwad_aero, sollwad_aero, toplwai_aero, sollwai_aero, & - toplwad0_aero, sollwad0_aero, & - ZLWFT0_i, ZFLDN0, ZFLUP0, ZSWFT0_i, ZFSDN0, ZFSUP0, & - ZFLUX_DIR, ZFLUX_DIR_CLEAR, ZFLUX_DIR_INTO_SUN, & - cloud_cover_sw) - - ELSE IF (iflag_rrtm == 1) then test_iflag_rrtm ! RRTM -#ifdef CPP_RRTM - - CALL lmdz_call_rrtm( & - dist, rmu0, fract, & - paprs, pplay,tsol,SFRWL,alb_dir, alb_dif, & - t, q, wo, cldfra, cldemi, cldtaupd,& - tau_aero, piz_aero, cg_aero,& - tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm,& - tau_aero_lw_rrtm, cldtaupi, & - qsat, flwc, fiwc, ref_liq, ref_ice, ref_liq_pi, ref_ice_pi, & - heat, heat0, cool, cool0, albpla, heat_volc, cool_volc,& - topsw, toplw, solsw, solswfdiff,sollw,& - sollwdown, topsw0, toplw0, solsw0, sollw0,& - lwdnc0, lwdn0, lwdn, lwupc0, lwup0, lwup,& - lwtoa0b, lwtoab , & !FC flux spectraux LW TOA - swdnc0, swdn0, swdn, swupc0, swup0, swup,& - topswad_aero, solswad_aero, topswai_aero, solswai_aero, & - topswad0_aero, solswad0_aero, topsw_aero, topsw0_aero,& - solsw_aero, solsw0_aero, topswcf_aero, solswcf_aero,& - toplwad_aero, sollwad_aero, toplwai_aero, sollwai_aero, & - toplwad0_aero, sollwad0_aero, & - ZLWFT0_i, ZFLDN0, ZFLUP0, ZSWFT0_i, ZFSDN0, ZFSUP0, & - ZFLUX_DIR, ZFLUX_DIR_CLEAR, ZFLUX_DIR_INTO_SUN, & - cloud_cover_sw) - -#else - abort_message="You should compile with -rrtm if running with iflag_rrtm=1" - call abort_physic(modname, abort_message, 1) -#endif - !====================================================================== - ! AI fev 2021 - ELSE IF(iflag_rrtm == 2) THEN test_iflag_rrtm ! ECRAD - PRINT*,'Traitement cas iflag_rrtm = ',iflag_rrtm -#ifdef CPP_ECRAD - CALL lmdz_call_ecrad( & - debut, dist, rmu0, fract, & - paprs, pplay,tsol,SFRWL,alb_dir, alb_dif, & - t, q, wo, cldfra, cldemi, cldtaupd,& - tau_aero, piz_aero, cg_aero,& - tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm,& ! rajoute par OB RRTM - cldtaupi, m_allaer, qsat, flwc, fiwc, & - ref_liq, ref_ice, & - namelist_ecrad_file, & - heat,heat0,cool,cool0,albpla,heat_volc, cool_volc,& - topsw,toplw,solsw,solswfdiff,sollw,& - sollwdown,topsw0,toplw0,solsw0,sollw0,& - lwdnc0, lwdn0, lwdn, lwupc0, lwup0, lwup,& - swdnc0, swdn0, swdn, swupc0, swup0, swup,& - topswad_aero, solswad_aero, topswai_aero, solswai_aero, & - topswad0_aero, solswad0_aero, topsw_aero, topsw0_aero,& - solsw_aero, solsw0_aero, topswcf_aero, solswcf_aero,& - toplwad_aero, sollwad_aero, toplwai_aero, sollwai_aero, & - toplwad0_aero, sollwad0_aero, & - ZLWFT0_i, ZFLDN0, ZFLUP0, ZSWFT0_i, ZFSDN0, ZFSUP0, & - ZFLUX_DIR, ZFLUX_DIR_CLEAR, ZFLUX_DIR_INTO_SUN, & - cloud_cover_sw) -#else - abort_message="You should compile with -rrtm if running with iflag_rrtm=2" - call abort_physic(modname, abort_message, 1) -#endif - PRINT*,'Fin traitement ECRAD' - ! Fin ECRAD - ENDIF test_iflag_rrtm - !====================================================================== - - END SUBROUTINE lmdz_call_rads -END MODULE lmdz_call_rads_m Index: /LMDZ6/trunk/libf/phylmd/lmdz_call_rrtm.F90 =================================================================== --- /LMDZ6/trunk/libf/phylmd/lmdz_call_rrtm.F90 (revision 6181) +++ /LMDZ6/trunk/libf/phylmd/lmdz_call_rrtm.F90 (revision 6181) @@ -0,0 +1,719 @@ +! +! $Id: radlwsw_m.F90 6127 2026-03-26 13:59:25Z idelkadi $ +! +module lmdz_call_rrtm + + IMPLICIT NONE + +contains + + SUBROUTINE call_rrtm( & + dist, rmu0, fract, & + paprs, pplay,tsol,SFRWL,alb_dir, alb_dif, & + t, q, wo, cldfra, cldemi, cldtaupd,& + tau_aero, piz_aero, cg_aero,& + tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm,& + tau_aero_lw_rrtm, & + cldtaupi, qsat, flwc, fiwc, & + ref_liq, ref_ice, ref_liq_pi, ref_ice_pi, & + heat,heat0,cool,cool0,albpla, heat_volc, cool_volc,& + topsw,toplw,solsw,solswfdiff,sollw,& + sollwdown,topsw0,toplw0,solsw0,sollw0,& + lwdnc0, lwdn0, lwdn, lwupc0, lwup0, lwup,& + lwtoa0b, lwtoab , & + swdnc0, swdn0, swdn, swupc0, swup0, swup,& + topswad_aero, solswad_aero, topswai_aero, solswai_aero, & + topswad0_aero, solswad0_aero, topsw_aero, topsw0_aero,& + solsw_aero, solsw0_aero, topswcf_aero, solswcf_aero,& + toplwad_aero, sollwad_aero, toplwai_aero, sollwai_aero, & + toplwad0_aero, sollwad0_aero, & + ZLWFT0_i, ZFLDN0, ZFLUP0, ZSWFT0_i, ZFSDN0, ZFSUP0, & + ZFLUX_DIR, ZFLUX_DIR_CLEAR, ZFLUX_DIR_INTO_SUN, & + cloud_cover_sw) + + !=================================================================================================== + ! A. Idelkadi, mars 2026 : + ! Recriture de l interface radlwsw_m.F90 entre LMDZ + ! et les codes radiatifs oldrad/rrtm/ecrad + ! --------------------------------------------------------------------------- + ! lmdz_call_rrtm_m.F90 : + ! Interface avec le code de transfert radiatif RRTM + ! + ! TODO : + ! - Nettoyage bloc declarations : + ! * USE (supprimer use inutules / identifier les variables par ONLY) + ! * declaraions variables locales + ! - Nettoyage partie avant et apres appel a oldrad + ! ------------------------------------------------------------------------------------------- + + ! Modules necessaires + USE DIMPHY + USE write_field_phy + ! +#ifdef CPP_RRTM + USE YOERAD , ONLY : NLW + USE YOMPHY3 , ONLY : RII0 +#endif + USE aero_mod + USE conf_phys_m, ONLY: ok_ade, ok_aie, ok_volcan, flag_volc_surfstrat, & + flag_aerosol,flag_aerosol_strat,flag_aer_feedback,& + iflag_rrtm + + USE yomcst_mod_h + USE clesphys_mod_h + USE yoethf_mod_h + USE phys_constants_mod, ONLY: dobson_u + + USE lmdz_radiation_pre + USE lmdz_radiation_post + +! ============== + ! DECLARATIONS + ! ============== + + ! Input arguments + REAL, INTENT(in) :: dist + REAL, INTENT(in) :: rmu0(KLON), fract(KLON) + REAL, INTENT(in) :: paprs(KLON,KLEV+1), pplay(KLON,KLEV) + !albedo SB >>> + ! REAL, INTENT(in) :: alb1(KLON), alb2(KLON), tsol(KLON) + REAL, INTENT(in) :: tsol(KLON) + REAL, INTENT(in) :: alb_dir(KLON,NSW),alb_dif(KLON,NSW) + REAL, INTENT(in) :: SFRWL(6) + !albedo SB <<< + REAL, INTENT(in) :: t(KLON,KLEV), q(KLON,KLEV) + + REAL, INTENT(in):: wo(:, :, :) ! dimension(KLON,KLEV, 1 or 2) + ! column-density of ozone in a layer, in kilo-Dobsons + ! "wo(:, :, 1)" is for the average day-night field, + ! "wo(:, :, 2)" is for daylight time. + + LOGICAL :: lldebug=.false. + REAL, INTENT(in) :: cldfra(KLON,KLEV), cldemi(KLON,KLEV), cldtaupd(KLON,KLEV) + REAL, INTENT(in) :: tau_aero(KLON,KLEV,naero_grp,2) ! aerosol optical properties (see aeropt.F) + REAL, INTENT(in) :: piz_aero(KLON,KLEV,naero_grp,2) ! aerosol optical properties (see aeropt.F) + REAL, INTENT(in) :: cg_aero(KLON,KLEV,naero_grp,2) ! aerosol optical properties (see aeropt.F) + !--OB + REAL, INTENT(in) :: tau_aero_sw_rrtm(KLON,KLEV,2,NSW) ! aerosol optical properties RRTM + REAL, INTENT(in) :: piz_aero_sw_rrtm(KLON,KLEV,2,NSW) ! aerosol optical properties RRTM + REAL, INTENT(in) :: cg_aero_sw_rrtm(KLON,KLEV,2,NSW) ! aerosol optical properties RRTM + +#ifdef CPP_RRTM + REAL, INTENT(in) :: tau_aero_lw_rrtm(KLON,KLEV,2,NLW) ! LW aerosol optical properties RRTM +#else + REAL, INTENT(in) :: tau_aero_lw_rrtm(KLON,KLEV,2,nbands_lw_rrtm) +#endif + + REAL, INTENT(in) :: cldtaupi(KLON,KLEV) ! cloud optical thickness for pre-industrial aerosol concentrations + REAL, INTENT(in) :: qsat(klon,klev) ! Variable pour iflag_rrtm=1 + REAL, INTENT(in) :: flwc(klon,klev) ! Variable pour iflag_rrtm=1 + REAL, INTENT(in) :: fiwc(klon,klev) ! Variable pour iflag_rrtm=1 + REAL, INTENT(in) :: ref_liq(klon,klev) ! cloud droplet radius present-day from newmicro + REAL, INTENT(in) :: ref_ice(klon,klev) ! ice crystal radius present-day from newmicro + REAL, INTENT(in) :: ref_liq_pi(klon,klev) ! cloud droplet radius pre-industrial from newmicro + REAL, INTENT(in) :: ref_ice_pi(klon,klev) ! ice crystal radius pre-industrial from newmicro + + ! Output arguments + REAL, INTENT(out) :: heat(KLON,KLEV), cool(KLON,KLEV) + REAL, INTENT(out) :: heat0(KLON,KLEV), cool0(KLON,KLEV) + REAL, INTENT(out) :: heat_volc(KLON,KLEV), cool_volc(KLON,KLEV) !NL + REAL, INTENT(out) :: topsw(KLON), toplw(KLON) + REAL, INTENT(out) :: solsw(KLON), sollw(KLON), albpla(KLON), solswfdiff(KLON) + REAL, INTENT(out) :: topsw0(KLON), toplw0(KLON), solsw0(KLON), sollw0(KLON) + REAL, INTENT(out) :: sollwdown(KLON) + REAL, INTENT(out) :: swdn(KLON,kflev+1),swdn0(KLON,kflev+1), swdnc0(KLON,kflev+1) + REAL, INTENT(out) :: swup(KLON,kflev+1),swup0(KLON,kflev+1), swupc0(KLON,kflev+1) + REAL, INTENT(out) :: lwdn(KLON,kflev+1),lwdn0(KLON,kflev+1), lwdnc0(KLON,kflev+1) + REAL, INTENT(out) :: lwup(KLON,kflev+1),lwup0(KLON,kflev+1), lwupc0(KLON,kflev+1) + !FC je remplace NLW par nbands_lw_rrtm qui est defini dans aero_mod peut etre que a ce niveau NLW est attribué? + REAL, INTENT(out) :: lwtoa0b(KLON,nbands_lw_rrtm), lwtoab(KLON,nbands_lw_rrtm) !FC flux TOA LW par bandes + + REAL, INTENT(out) :: topswad_aero(KLON), solswad_aero(KLON) ! output: aerosol direct forcing at TOA and surface + REAL, INTENT(out) :: topswai_aero(KLON), solswai_aero(KLON) ! output: aerosol indirect forcing atTOA and surface + REAL, INTENT(out) :: toplwad_aero(KLON), sollwad_aero(KLON) ! output: LW aerosol direct forcing at TOA and surface + REAL, INTENT(out) :: toplwai_aero(KLON), sollwai_aero(KLON) ! output: LW aerosol indirect forcing atTOA and surface + REAL, DIMENSION(klon), INTENT(out) :: topswad0_aero + REAL, DIMENSION(klon), INTENT(out) :: solswad0_aero + REAL, DIMENSION(klon), INTENT(out) :: toplwad0_aero + REAL, DIMENSION(klon), INTENT(out) :: sollwad0_aero + REAL, DIMENSION(kdlon,9), INTENT(out) :: topsw_aero + REAL, DIMENSION(kdlon,9), INTENT(out) :: topsw0_aero + REAL, DIMENSION(kdlon,9), INTENT(out) :: solsw_aero + REAL, DIMENSION(kdlon,9), INTENT(out) :: solsw0_aero + REAL, DIMENSION(kdlon,3), INTENT(out) :: topswcf_aero + REAL, DIMENSION(kdlon,3), INTENT(out) :: solswcf_aero + REAL, DIMENSION(kdlon,kflev+1), INTENT(out) :: ZSWFT0_i + REAL, DIMENSION(kdlon,kflev+1), INTENT(out) :: ZLWFT0_i + + ! Local variables + REAL(KIND=8) ZFSUP(KDLON,KFLEV+1) + REAL(KIND=8) ZFSDN(KDLON,KFLEV+1) + REAL(KIND=8) ZFSUP0(KDLON,KFLEV+1) + REAL(KIND=8) ZFSDN0(KDLON,KFLEV+1) + REAL(KIND=8) ZFSUPC0(KDLON,KFLEV+1) + REAL(KIND=8) ZFSDNC0(KDLON,KFLEV+1) + REAL(KIND=8) ZFLUP(KDLON,KFLEV+1) + REAL(KIND=8) ZFLDN(KDLON,KFLEV+1) + REAL(KIND=8) ZFLUP0(KDLON,KFLEV+1) + REAL(KIND=8) ZFLDN0(KDLON,KFLEV+1) + REAL(KIND=8) ZFLUPC0(KDLON,KFLEV+1) + REAL(KIND=8) ZFLDNC0(KDLON,KFLEV+1) + REAL(KIND=8) zx_alpha1, zx_alpha2 + INTEGER k, kk, i, l, iof, jb !FC + INTEGER ist,iend,ktdia,kmode + REAL(KIND=8) PSCT + REAL(KIND=8) PALBD(kdlon,2), PALBP(kdlon,2) + ! MPL 06.01.09: pour RRTM, creation de PALBD_NEW et PALBP_NEW + ! avec NSW en deuxieme dimension + REAL(KIND=8) PALBD_NEW(kdlon,NSW), PALBP_NEW(kdlon,NSW) + REAL(KIND=8) PEMIS(kdlon), PDT0(kdlon), PVIEW(kdlon) + REAL(KIND=8) PPSOL(kdlon), PDP(kdlon,KLEV) + REAL(KIND=8) PTL(kdlon,kflev+1), PPMB(kdlon,kflev+1) + REAL(KIND=8) PTAVE(kdlon,kflev) + REAL(KIND=8) PWV(kdlon,kflev), PQS(kdlon,kflev) + + REAL(KIND=8) cloud_cover_sw(klon) + REAL(KIND=8), dimension(klon,klev+1) :: ZFLUX_DIR, & ! Direct compt of surf flux into horizontal plane + ZFLUX_DIR_CLEAR ! CS Direct + REAL(KIND=8), dimension(klon) :: ZFLUX_DIR_INTO_SUN + + REAL(kind=8) POZON(kdlon, kflev, size(wo, 3)) ! mass fraction of ozone + ! "POZON(:, :, 1)" is for the average day-night field, + ! "POZON(:, :, 2)" is for daylight time. + ! Modif MPL 6.01.09 avec RRTM, on passe de 5 a 6 + REAL(KIND=8) PAER(kdlon,kflev,6) + REAL(KIND=8) PCLDLD(kdlon,kflev) + REAL(KIND=8) PCLDLU(kdlon,kflev) + REAL(KIND=8) PCLDSW(kdlon,kflev) + REAL(KIND=8) PTAU(kdlon,2,kflev) + REAL(KIND=8) POMEGA(kdlon,2,kflev) + REAL(KIND=8) PCG(kdlon,2,kflev) + REAL(KIND=8) zfract(kdlon), zrmu0(kdlon), zdist + REAL(KIND=8) zheat(kdlon,kflev), zcool(kdlon,kflev) + REAL(KIND=8) zheat0(kdlon,kflev), zcool0(kdlon,kflev) + REAL(KIND=8) zheat_volc(kdlon,kflev), zcool_volc(kdlon,kflev) !NL + REAL(KIND=8) ztopsw(kdlon), ztoplw(kdlon) + REAL(KIND=8) zsolsw(kdlon), zsollw(kdlon), zalbpla(kdlon), zsolswfdiff(kdlon) + REAL(KIND=8) zsollwdown(kdlon) + REAL(KIND=8) ztopsw0(kdlon), ztoplw0(kdlon) + REAL(KIND=8) zsolsw0(kdlon), zsollw0(kdlon) + REAL(KIND=8) tauaero(kdlon,kflev,naero_grp,2) ! aer opt properties + REAL(KIND=8) pizaero(kdlon,kflev,naero_grp,2) + REAL(KIND=8) cgaero(kdlon,kflev,naero_grp,2) + REAL(KIND=8) PTAUA(kdlon,2,kflev) ! present-day value of cloud opt thickness (PTAU is pre-industrial value), local use + REAL(KIND=8) POMEGAA(kdlon,2,kflev) ! dito for single scatt albedo + REAL(KIND=8) ztopswadaero(kdlon), zsolswadaero(kdlon) ! Aerosol direct forcing at TOAand surface + REAL(KIND=8) ztopswad0aero(kdlon), zsolswad0aero(kdlon) ! Aerosol direct forcing at TOAand surface + REAL(KIND=8) ztopswaiaero(kdlon), zsolswaiaero(kdlon) ! dito, indirect + !--NL + REAL(KIND=8) zswadaero(kdlon,kflev+1) ! SW Aerosol direct forcing + REAL(KIND=8) zlwadaero(kdlon,kflev+1) ! LW Aerosol direct forcing + REAL(KIND=8) volmip_solsw(kdlon) ! SW clear sky in the case of VOLMIP + !-LW by CK + REAL(KIND=8) ztoplwadaero(kdlon), zsollwadaero(kdlon) ! LW Aerosol direct forcing at TOAand surface + REAL(KIND=8) ztoplwad0aero(kdlon), zsollwad0aero(kdlon) ! LW Aerosol direct forcing at TOAand surface + REAL(KIND=8) ztoplwaiaero(kdlon), zsollwaiaero(kdlon) ! dito, indirect + !-end + REAL(KIND=8) ztopsw_aero(kdlon,9), ztopsw0_aero(kdlon,9) + REAL(KIND=8) zsolsw_aero(kdlon,9), zsolsw0_aero(kdlon,9) + REAL(KIND=8) ztopswcf_aero(kdlon,3), zsolswcf_aero(kdlon,3) + !MPL input supplementaires pour RECMWFL + ! flwc, fiwc = Liquid Water Content & Ice Water Content (kg/kg) + !MPL input RECMWFL: + ! Tableaux aux niveaux inverses pour respecter convention Arpege + REAL(KIND=8) ref_liq_i(klon,klev) ! cloud droplet radius present-day from newmicro (inverted) + REAL(KIND=8) ref_ice_i(klon,klev) ! ice crystal radius present-day from newmicro (inverted) + !--OB + REAL(KIND=8) ref_liq_pi_i(klon,klev) ! cloud droplet radius pre-industrial from newmicro (inverted) + REAL(KIND=8) ref_ice_pi_i(klon,klev) ! ice crystal radius pre-industrial from newmicro (inverted) + !--end OB + REAL(KIND=8) paprs_i(klon,klev+1) + REAL(KIND=8) pplay_i(klon,klev) + REAL(KIND=8) cldfra_i(klon,klev) + REAL(KIND=8) POZON_i(kdlon,kflev, size(wo, 3)) ! mass fraction of ozone + ! "POZON(:, :, 1)" is for the average day-night field, + ! "POZON(:, :, 2)" is for daylight time. + ! Modif MPL 6.01.09 avec RRTM, on passe de 5 a 6 + REAL(KIND=8) PAER_i(kdlon,kflev,6) + REAL(KIND=8) PDP_i(klon,klev) + REAL(KIND=8) t_i(klon,klev),q_i(klon,klev),qsat_i(klon,klev) + REAL(KIND=8) flwc_i(klon,klev),fiwc_i(klon,klev) + !MPL output RECMWFL: + REAL(KIND=8) ZEMTD (klon,klev+1),ZEMTD_i (klon,klev+1) + REAL(KIND=8) ZEMTU (klon,klev+1),ZEMTU_i (klon,klev+1) + REAL(KIND=8) ZTRSO (klon,klev+1),ZTRSO_i (klon,klev+1) + REAL(KIND=8) ZTH (klon,klev+1),ZTH_i (klon,klev+1) + REAL(KIND=8) ZCTRSO(klon,2) + REAL(KIND=8) ZCEMTR(klon,2) + REAL(KIND=8) ZTRSOD(klon) + REAL(KIND=8) ZLWFC (klon,2) + REAL(KIND=8) ZLWFT (klon,klev+1),ZLWFT_i (klon,klev+1) + REAL(KIND=8) ZSWFC (klon,2) + REAL(KIND=8) ZSWFT (klon,klev+1),ZSWFT_i (klon,klev+1) + REAL(KIND=8) PPIZA_TOT(klon,klev,NSW) + REAL(KIND=8) PCGA_TOT(klon,klev,NSW) + REAL(KIND=8) PTAU_TOT(klon,klev,NSW) + REAL(KIND=8) PPIZA_NAT(klon,klev,NSW) + REAL(KIND=8) PCGA_NAT(klon,klev,NSW) + REAL(KIND=8) PTAU_NAT(klon,klev,NSW) +#ifdef CPP_RRTM + REAL(KIND=8) PTAU_LW_TOT(klon,klev,NLW) + REAL(KIND=8) PTAU_LW_NAT(klon,klev,NLW) +#endif + REAL(KIND=8) PSFSWDIR(klon,NSW) + REAL(KIND=8) PSFSWDIF(klon,NSW) + REAL(KIND=8) PFSDNN(klon) + REAL(KIND=8) PFSDNV(klon) + !MPL On ne redefinit pas les tableaux ZFLUX,ZFLUC, + !MPL ZFSDWN,ZFCDWN,ZFSUP,ZFCUP car ils existent deja + !MPL sous les noms de ZFLDN,ZFLDN0,ZFLUP,ZFLUP0, + !MPL ZFSDN,ZFSDN0,ZFSUP,ZFSUP0 + REAL(KIND=8) ZFLUX_i (klon,2,klev+1) + REAL(KIND=8) ZFLUC_i (klon,2,klev+1) + !FC + !FC je remplace NLW par nbands_lw_rrtm qui est defini dans aero_mod + + REAL(KIND=8) ZTOAB_i (klon,nbands_lw_rrtm) + REAL(KIND=8) ZTOACB_i (klon,nbands_lw_rrtm) + !FC + + REAL(KIND=8) ZFSDWN_i (klon,klev+1) + REAL(KIND=8) ZFCDWN_i (klon,klev+1) + REAL(KIND=8) ZFCCDWN_i (klon,klev+1) + REAL(KIND=8) ZFSUP_i (klon,klev+1) + REAL(KIND=8) ZFCUP_i (klon,klev+1) + REAL(KIND=8) ZFCCUP_i (klon,klev+1) + REAL(KIND=8) ZFLCCDWN_i (klon,klev+1) + REAL(KIND=8) ZFLCCUP_i (klon,klev+1) + ! 3 lignes suivantes a activer pour CCMVAL (MPL 20100412) + ! REAL(KIND=8) RSUN(3,2) + ! REAL(KIND=8) SUN(3) + ! REAL(KIND=8) SUN_FRACT(2) + CHARACTER (LEN=80) :: abort_message + CHARACTER (LEN=80) :: modname='lmdz_call_rrtm' + + REAL zdir(klon), zdif(klon) + INTEGER :: dimoz + + dimoz=size(wo,3) + + CALL radiation_pre( & + ist,iend,ktdia,kmode, & + dist, rmu0, fract, & + paprs, pplay, tsol, SFRWL, alb_dir, alb_dif, & + t, q, wo, cldfra, cldemi, cldtaupd, & + tau_aero, piz_aero, cg_aero, & + tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm, & + cldtaupi, qsat, flwc, fiwc, iof, & + heat, heat0, cool, cool0, heat_volc, cool_volc, & + zheat, zheat0, zcool, zcool0, zheat_volc, zcool_volc, & + zdist, PSCT, zfract, zrmu0, & + PAER, PCLDLD, PCLDLU, PCLDSW, & + PTAU, PTAUA, POMEGA, POMEGAA, PCG, & + PALBD, PALBP, PALBD_NEW, PALBP_NEW, & + PEMIS, PDT0, PVIEW, PPSOL,PDP, & + PTL, PPMB, PTAVE, PWV, PQS, & + zx_alpha1, zx_alpha2, POZON, & + tauaero, pizaero, cgaero, & + ztopsw_aero, ztopsw0_aero, zsolsw_aero, zsolsw0_aero, & + ztopswcf_aero, zsolswcf_aero, & + ztopswadaero,zsolswadaero,ztopswad0aero, & + zsolswad0aero,zsollwadaero,zsollwad0aero, & + ztopswaiaero,zsolswaiaero,ztoplwaiaero,zsollwaiaero) + ! + !===== iflag_rrtm ================================================ + IF (iflag_rrtm == 1) then +#ifdef CPP_RRTM + ! if (prt_level.gt.10)write(lunout,*)'CPP_RRTM=.T.' + !===== iflag_rrtm=1, on passe dans SW via RECMWFL =============== + + DO k = 1, kflev+1 + DO i = 1, kdlon + ZEMTD_i(i,k)=0. + ZEMTU_i(i,k)=0. + ZTRSO_i(i,k)=0. + ZTH_i(i,k)=0. + ZLWFT_i(i,k)=0. + ZSWFT_i(i,k)=0. + ZFLUX_i(i,1,k)=0. + ZFLUX_i(i,2,k)=0. + ZFLUC_i(i,1,k)=0. + ZFLUC_i(i,2,k)=0. + ZFSDWN_i(i,k)=0. + ZFCDWN_i(i,k)=0. + ZFCCDWN_i(i,k)=0. + ZFSUP_i(i,k)=0. + ZFCUP_i(i,k)=0. + ZFCCUP_i(i,k)=0. + ZFLCCDWN_i(i,k)=0. + ZFLCCUP_i(i,k)=0. + ENDDO + ENDDO + ! + !--OB + !--aerosol TOT - anthropogenic+natural - index 2 + !--aerosol NAT - natural only - index 1 + ! + DO kk=1, NSW + DO k = 1, kflev + DO i = 1, kdlon + ! + PTAU_TOT(i,kflev+1-k,kk)=tau_aero_sw_rrtm(i,k,2,kk) + PPIZA_TOT(i,kflev+1-k,kk)=piz_aero_sw_rrtm(i,k,2,kk) + PCGA_TOT(i,kflev+1-k,kk)=cg_aero_sw_rrtm(i,k,2,kk) + ! + PTAU_NAT(i,kflev+1-k,kk)=tau_aero_sw_rrtm(i,k,1,kk) + PPIZA_NAT(i,kflev+1-k,kk)=piz_aero_sw_rrtm(i,k,1,kk) + PCGA_NAT(i,kflev+1-k,kk)=cg_aero_sw_rrtm(i,k,1,kk) + ! + ENDDO + ENDDO + ENDDO + !-end OB + ! + !--C. Kleinschmitt + !--aerosol TOT - anthropogenic+natural - index 2 + !--aerosol NAT - natural only - index 1 + ! + DO kk=1, NLW + DO k = 1, kflev + DO i = 1, kdlon + ! + PTAU_LW_TOT(i,kflev+1-k,kk)=tau_aero_lw_rrtm(i,k,2,kk) + PTAU_LW_NAT(i,kflev+1-k,kk)=tau_aero_lw_rrtm(i,k,1,kk) + ! + ENDDO + ENDDO + ENDDO + !-end C. Kleinschmitt + ! + DO i = 1, kdlon + ZCTRSO(i,1)=0. + ZCTRSO(i,2)=0. + ZCEMTR(i,1)=0. + ZCEMTR(i,2)=0. + ZTRSOD(i)=0. + ZLWFC(i,1)=0. + ZLWFC(i,2)=0. + ZSWFC(i,1)=0. + ZSWFC(i,2)=0. + PFSDNN(i)=0. + PFSDNV(i)=0. + ENDDO + + DO kk = 1, NSW + DO i = 1, kdlon + PSFSWDIR(i,kk)=0. + PSFSWDIF(i,kk)=0. + ENDDO + ENDDO + !----- Fin des mises a zero des tableaux output de RECMWF ------------------- + ! GEMU(1:klon)=sin(rlatd(1:klon)) + ! On met les donnees dans l'ordre des niveaux arpege + paprs_i(:,1)=paprs(:,klev+1) + DO k=1,klev + DO i = 1, klon + paprs_i(i,k+1) =paprs(i,klev+1-k) + pplay_i(i,k) =pplay(i,klev+1-k) + cldfra_i(i,k) =cldfra(i,klev+1-k) + PDP_i(i,k) =PDP(i,klev+1-k) + t_i(i,k) =t(i,klev+1-k) + q_i(i,k) =q(i,klev+1-k) + qsat_i(i,k) =qsat(i,klev+1-k) + flwc_i(i,k) =flwc(i,klev+1-k) + fiwc_i(i,k) =fiwc(i,klev+1-k) + ref_liq_i(i,k) =ref_liq(i,klev+1-k) + ref_ice_i(i,k) =ref_ice(i,klev+1-k) + !-OB + ref_liq_pi_i(i,k) =ref_liq_pi(i,klev+1-k) + ref_ice_pi_i(i,k) =ref_ice_pi(i,klev+1-k) + ENDDO + ENDDO + + DO l=1,dimoz + DO k=1,kflev + POZON_i(1:klon,k,l)=POZON(1:klon,kflev+1-k,l) + ! POZON_i(1:klon,k)=POZON(1:klon,k) ! on laisse 1=sol et klev=top + ! print *,'Juste avant RECMWFL: k tsol temp',k,tsol,t(1,k) + ! Modif MPL 6.01.09 avec RRTM, on passe de 5 a 6 + ENDDO + ENDDO + + DO l=1,6 + DO k=1,kflev + PAER_i(1:klon,k,l)=PAER(1:klon,kflev+1-k,l) + ENDDO + ENDDO + + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! La version ARPEGE1D utilise differentes valeurs de la constante + ! solaire suivant le rayonnement utilise. + ! A controler ... + ! SOLAR FLUX AT THE TOP (/YOMPHY3/) + ! introduce season correction + !-------------------------------------- + ! RII0 = RIP0 + ! IF(LRAYFM) + ! RII0 = RIP0M ! =rip0m if Morcrette non-each time step call. + ! IF(LRAYFM15) + ! RII0 = RIP0M15 ! =rip0m if Morcrette non-each time step call. + RII0=solaire/zdist/zdist + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! Ancien appel a RECMWF (celui du cy25) + ! CALL RECMWF (ist , iend, klon , ktdia , klev , kmode , + ! s PALBD , PALBP , paprs_i , pplay_i , RCO2 , cldfra_i, + ! s POZON_i , PAER_i , PDP_i , PEMIS , GEMU , rmu0, + ! s q_i , qsat_i , fiwc_i , flwc_i , zmasq , t_i ,tsol, + ! s ZEMTD_i , ZEMTU_i , ZTRSO_i , + ! s ZTH_i , ZCTRSO , ZCEMTR , ZTRSOD , + ! s ZLWFC , ZLWFT_i , ZSWFC , ZSWFT_i , + ! s ZFLUX_i , ZFLUC_i , ZFSDWN_i, ZFSUP_i , ZFCDWN_i,ZFCUP_i) + ! s 'RECMWF ') + ! + IF (lldebug) THEN + CALL writefield_phy('paprs_i',paprs_i,klev+1) + CALL writefield_phy('pplay_i',pplay_i,klev) + CALL writefield_phy('cldfra_i',cldfra_i,klev) + CALL writefield_phy('pozon_i',POZON_i,klev) + CALL writefield_phy('paer_i',PAER_i,klev) + CALL writefield_phy('pdp_i',PDP_i,klev) + CALL writefield_phy('q_i',q_i,klev) + CALL writefield_phy('qsat_i',qsat_i,klev) + CALL writefield_phy('fiwc_i',fiwc_i,klev) + CALL writefield_phy('flwc_i',flwc_i,klev) + CALL writefield_phy('t_i',t_i,klev) + CALL writefield_phy('palbd_new',PALBD_NEW,NSW) + CALL writefield_phy('palbp_new',PALBP_NEW,NSW) + ENDIF + + ! Nouvel appel a RECMWF (celui du cy32t0) + CALL RECMWF_AERO (ist , iend, klon , ktdia , klev , kmode ,& + PALBD_NEW,PALBP_NEW, paprs_i , pplay_i , RCO2 , cldfra_i,& + POZON_i , PAER_i , PDP_i , PEMIS , rmu0 ,& + q_i , qsat_i , fiwc_i , flwc_i , zmasq , t_i ,tsol,& + ref_liq_i, ref_ice_i, & + ref_liq_pi_i, ref_ice_pi_i, & ! rajoute par OB pour diagnostiquer effet indirect + ZEMTD_i , ZEMTU_i , ZTRSO_i ,& + ZTH_i , ZCTRSO , ZCEMTR , ZTRSOD ,& + ZLWFC , ZLWFT_i , ZSWFC , ZSWFT_i ,& + PSFSWDIR , PSFSWDIF, PFSDNN , PFSDNV ,& + PPIZA_TOT, PCGA_TOT,PTAU_TOT,& + PPIZA_NAT, PCGA_NAT,PTAU_NAT, & ! rajoute par OB pour diagnostiquer effet direct + PTAU_LW_TOT, PTAU_LW_NAT, & ! rajoute par C. Kleinschmitt + ZFLUX_i , ZFLUC_i ,& + ZTOAB_i , ZTOACB_i, & ! FC flux spectraux TOA + ZFSDWN_i , ZFSUP_i , ZFCDWN_i, ZFCUP_i, ZFCCDWN_i, ZFCCUP_i, ZFLCCDWN_i, ZFLCCUP_i, & + ZTOPSWADAERO,ZSOLSWADAERO,& ! rajoute par OB pour diagnostics + ZTOPSWAD0AERO,ZSOLSWAD0AERO,& + ZTOPSWAIAERO,ZSOLSWAIAERO, & + ZTOPSWCF_AERO,ZSOLSWCF_AERO, & + ZSWADAERO, & !--NL + ZTOPLWADAERO,ZSOLLWADAERO,& ! rajoute par C. Kleinscmitt pour LW diagnostics + ZTOPLWAD0AERO,ZSOLLWAD0AERO,& + ZTOPLWAIAERO,ZSOLLWAIAERO, & + ZLWADAERO, & !--NL + volmip_solsw, flag_volc_surfstrat, & !--VOLMIP + ok_ade, ok_aie, ok_volcan, flag_aerosol,flag_aerosol_strat, flag_aer_feedback) ! flags aerosols + + ! print *,'RADLWSW: apres RECMWF' + IF (lldebug) THEN + CALL writefield_phy('zemtd_i',ZEMTD_i,klev+1) + CALL writefield_phy('zemtu_i',ZEMTU_i,klev+1) + CALL writefield_phy('ztrso_i',ZTRSO_i,klev+1) + CALL writefield_phy('zth_i',ZTH_i,klev+1) + CALL writefield_phy('zctrso',ZCTRSO,2) + CALL writefield_phy('zcemtr',ZCEMTR,2) + CALL writefield_phy('ztrsod',ZTRSOD,1) + CALL writefield_phy('zlwfc',ZLWFC,2) + CALL writefield_phy('zlwft_i',ZLWFT_i,klev+1) + CALL writefield_phy('zswfc',ZSWFC,2) + CALL writefield_phy('zswft_i',ZSWFT_i,klev+1) + CALL writefield_phy('psfswdir',PSFSWDIR,6) + CALL writefield_phy('psfswdif',PSFSWDIF,6) + CALL writefield_phy('pfsdnn',PFSDNN,1) + CALL writefield_phy('pfsdnv',PFSDNV,1) + CALL writefield_phy('ppiza_dst',PPIZA_TOT,klev) + CALL writefield_phy('pcga_dst',PCGA_TOT,klev) + CALL writefield_phy('ptaurel_dst',PTAU_TOT,klev) + CALL writefield_phy('zflux_i',ZFLUX_i,klev+1) + CALL writefield_phy('zfluc_i',ZFLUC_i,klev+1) + CALL writefield_phy('zfsdwn_i',ZFSDWN_i,klev+1) + CALL writefield_phy('zfsup_i',ZFSUP_i,klev+1) + CALL writefield_phy('zfcdwn_i',ZFCDWN_i,klev+1) + CALL writefield_phy('zfcup_i',ZFCUP_i,klev+1) + ENDIF + + ! --------- + ! --------- + ! On retablit l'ordre des niveaux lmd pour les tableaux de sortie + ! D autre part, on multiplie les resultats SW par fract pour etre coherent + ! avec l ancien rayonnement AR4. Si nuit, fract=0 donc pas de + ! rayonnement SW. (MPL 260609) + DO k=0,klev + DO i=1,klon + ZEMTD(i,k+1) = ZEMTD_i(i,k+1) + ZEMTU(i,k+1) = ZEMTU_i(i,k+1) + ZTRSO(i,k+1) = ZTRSO_i(i,k+1) + ZTH(i,k+1) = ZTH_i(i,k+1) + ! ZLWFT(i,k+1) = ZLWFT_i(i,klev+1-k) + ! ZSWFT(i,k+1) = ZSWFT_i(i,klev+1-k) + ZFLUP(i,k+1) = ZFLUX_i(i,1,k+1) + ZFLDN(i,k+1) = ZFLUX_i(i,2,k+1) + ZFLUP0(i,k+1) = ZFLUC_i(i,1,k+1) + ZFLDN0(i,k+1) = ZFLUC_i(i,2,k+1) + ZFSDN(i,k+1) = ZFSDWN_i(i,k+1)*fract(i) + ZFSDN0(i,k+1) = ZFCDWN_i(i,k+1)*fract(i) + ZFSDNC0(i,k+1)= ZFCCDWN_i(i,k+1)*fract(i) + ZFSUP (i,k+1) = ZFSUP_i(i,k+1)*fract(i) + ZFSUP0(i,k+1) = ZFCUP_i(i,k+1)*fract(i) + ZFSUPC0(i,k+1)= ZFCCUP_i(i,k+1)*fract(i) + ZFLDNC0(i,k+1)= ZFLCCDWN_i(i,k+1) + ZFLUPC0(i,k+1)= ZFLCCUP_i(i,k+1) + IF (ok_volcan) THEN + ZSWADAERO(i,k+1)=ZSWADAERO(i,k+1)*fract(i) !--NL + ENDIF + + ! Nouveau calcul car visiblement ZSWFT et ZSWFC sont nuls dans RRTM cy32 + ! en sortie de radlsw.F90 - MPL 7.01.09 + ZSWFT(i,k+1) = (ZFSDWN_i(i,k+1)-ZFSUP_i(i,k+1))*fract(i) + ZSWFT0_i(i,k+1) = (ZFCDWN_i(i,k+1)-ZFCUP_i(i,k+1))*fract(i) + ! WRITE(*,'("FSDN FSUP FCDN FCUP: ",4E12.5)') ZFSDWN_i(i,k+1),& + ! ZFSUP_i(i,k+1),ZFCDWN_i(i,k+1),ZFCUP_i(i,k+1) + ZLWFT(i,k+1) =-ZFLUX_i(i,2,k+1)-ZFLUX_i(i,1,k+1) + ZLWFT0_i(i,k+1)=-ZFLUC_i(i,2,k+1)-ZFLUC_i(i,1,k+1) + ! print *,'FLUX2 FLUX1 FLUC2 FLUC1',ZFLUX_i(i,2,k+1),& + ! & ZFLUX_i(i,1,k+1),ZFLUC_i(i,2,k+1),ZFLUC_i(i,1,k+1) + ENDDO + ENDDO + + !--ajout OB + ZTOPSWADAERO(:) =ZTOPSWADAERO(:) *fract(:) + ZSOLSWADAERO(:) =ZSOLSWADAERO(:) *fract(:) + ZTOPSWAD0AERO(:)=ZTOPSWAD0AERO(:)*fract(:) + ZSOLSWAD0AERO(:)=ZSOLSWAD0AERO(:)*fract(:) + ZTOPSWAIAERO(:) =ZTOPSWAIAERO(:) *fract(:) + ZSOLSWAIAERO(:) =ZSOLSWAIAERO(:) *fract(:) + ZTOPSWCF_AERO(:,1)=ZTOPSWCF_AERO(:,1)*fract(:) + ZTOPSWCF_AERO(:,2)=ZTOPSWCF_AERO(:,2)*fract(:) + ZTOPSWCF_AERO(:,3)=ZTOPSWCF_AERO(:,3)*fract(:) + ZSOLSWCF_AERO(:,1)=ZSOLSWCF_AERO(:,1)*fract(:) + ZSOLSWCF_AERO(:,2)=ZSOLSWCF_AERO(:,2)*fract(:) + ZSOLSWCF_AERO(:,3)=ZSOLSWCF_AERO(:,3)*fract(:) + + ! --------- + ! --------- + ! On renseigne les champs LMDz, pour avoir la meme chose qu'en sortie de + ! LW_LMDAR4 et SW_LMDAR4 + + !--fraction of diffuse radiation in surface SW downward radiation + zdir(:)=0. + zdif(:)=0. + DO k=1,NSW + DO i = 1, kdlon + zdir(i)=zdir(i) + PSFSWDIR(i,k) + zdif(i)=zdif(i) + PSFSWDIF(i,k) + ENDDO + ENDDO + + DO i = 1, kdlon + IF (fract(i).GT.0.0) THEN + zsolswfdiff(i) = zdif(i)/(zdir(i)+zdif(i)) + ELSE !--night + zsolswfdiff(i) = 1.0 + ENDIF + ENDDO + ! + DO i = 1, kdlon + zsolsw(i) = ZSWFT(i,1) + zsolsw0(i) = ZSWFT0_i(i,1) + ! zsolsw0(i) = ZFSDN0(i,1) -ZFSUP0(i,1) + ztopsw(i) = ZSWFT(i,klev+1) + ztopsw0(i) = ZSWFT0_i(i,klev+1) + ! ztopsw0(i) = ZFSDN0(i,klev+1)-ZFSUP0(i,klev+1) + ! + ! zsollw(i) = ZFLDN(i,1) -ZFLUP(i,1) + ! zsollw0(i) = ZFLDN0(i,1) -ZFLUP0(i,1) + ! ztoplw(i) = ZFLDN(i,klev+1) -ZFLUP(i,klev+1) + ! ztoplw0(i) = ZFLDN0(i,klev+1)-ZFLUP0(i,klev+1) + zsollw(i) = ZLWFT(i,1) + zsollw0(i) = ZLWFT0_i(i,1) + ztoplw(i) = ZLWFT(i,klev+1)*(-1) + ztoplw0(i) = ZLWFT0_i(i,klev+1)*(-1) + ! + IF (fract(i) == 0.) THEN + ! A REVOIR MPL (20090630) ca n a pas de sens quand fract=0 + ! pas plus que dans le sw_AR4 + zalbpla(i) = 1.0e+39 + ELSE + zalbpla(i) = ZFSUP(i,klev+1)/ZFSDN(i,klev+1) + ENDIF + ! 5 juin 2015 + ! Correction MP bug RRTM + zsollwdown(i)= -1.*ZFLDN(i,1) + ENDDO + ! print*,'OK2' + + !--add VOLMIP (surf cool or strat heat activate) + IF (flag_volc_surfstrat > 0) THEN + DO i = 1, kdlon + zsolsw(i) = volmip_solsw(i)*fract(i) + ENDDO + ENDIF + + DO k=1,kflev + DO i=1,kdlon + zheat(i,k)=(ZSWFT(i,k+1)-ZSWFT(i,k))*RDAY*RG/RCPD/PDP(i,k) + zheat0(i,k)=(ZSWFT0_i(i,k+1)-ZSWFT0_i(i,k))*RDAY*RG/RCPD/PDP(i,k) + zcool(i,k)=(ZLWFT(i,k)-ZLWFT(i,k+1))*RDAY*RG/RCPD/PDP(i,k) + zcool0(i,k)=(ZLWFT0_i(i,k)-ZLWFT0_i(i,k+1))*RDAY*RG/RCPD/PDP(i,k) + IF (ok_volcan) THEN + zheat_volc(i,k)=(ZSWADAERO(i,k+1)-ZSWADAERO(i,k))*RG/RCPD/PDP(i,k) !NL + zcool_volc(i,k)=(ZLWADAERO(i,k)-ZLWADAERO(i,k+1))*RG/RCPD/PDP(i,k) !NL + ENDIF + ENDDO + ENDDO + !FC + DO jb = 1, nbands_lw_rrtm !FC + DO i=1,kdlon + lwtoab(i,jb) = ZTOAB_i(i,jb) + lwtoa0b(i,jb) = ZTOACB_i(i,jb) + ENDDO + ENDDO + +#else + abort_message="You should compile with -rrtm if running with iflag_rrtm=1" + call abort_physic(modname, abort_message, 1) +#endif + ENDIF + !====================================================================== + + ! ----- flux radiatifs => sorties --------------------------------- + + CALL radiation_post( & + iof, PWV, & + ZFSUP, ZFSDN, ZFSUP0, ZFSDN0, & + ZFSUPC0, ZFSDNC0, ZFLUP, ZFLDN, & + ZFLUP0, ZFLDN0, ZFLUPC0, ZFLDNC0, & + zheat, zcool, zheat0, zcool0, zheat_volc, zcool_volc, & + ztopsw, ztoplw, zsolsw, zsollw, zalbpla, zsolswfdiff, & + zsollwdown, ztopsw0, ztoplw0, zsolsw0, zsollw0, & + ztopswadaero, zsolswadaero, ztopswad0aero, zsolswad0aero, & + ztopswaiaero, zsolswaiaero, ztoplwadaero, zsollwadaero, & + ztoplwad0aero, zsollwad0aero, ztoplwaiaero, zsollwaiaero, & + ztopsw_aero, ztopsw0_aero, zsolsw_aero, zsolsw0_aero, & + ztopswcf_aero, zsolswcf_aero, & + heat, heat0, cool, cool0, albpla, heat_volc, cool_volc,& + topsw, toplw, solsw, solswfdiff, sollw, sollwdown,& + topsw0, toplw0, solsw0, sollw0,& + lwdnc0, lwdn0, lwdn, lwupc0, lwup0, lwup,& + swdnc0, swdn0, swdn, swupc0, swup0, swup,& + topswad_aero, solswad_aero, topswai_aero, solswai_aero, & + topswad0_aero, solswad0_aero, topsw_aero, topsw0_aero,& + solsw_aero, solsw0_aero, topswcf_aero, solswcf_aero,& + toplwad_aero, sollwad_aero, toplwai_aero, sollwai_aero, & + toplwad0_aero, sollwad0_aero, & + cloud_cover_sw, ZFLUX_DIR, ZFLUX_DIR_CLEAR, ZFLUX_DIR_INTO_SUN) + + END SUBROUTINE call_rrtm + +END MODULE lmdz_call_rrtm Index: DZ6/trunk/libf/phylmd/lmdz_call_rrtm_m.F90 =================================================================== --- /LMDZ6/trunk/libf/phylmd/lmdz_call_rrtm_m.F90 (revision 6180) +++ (revision ) @@ -1,719 +1,0 @@ -! -! $Id: radlwsw_m.F90 6127 2026-03-26 13:59:25Z idelkadi $ -! -module lmdz_call_rrtm_m - - IMPLICIT NONE - -contains - - SUBROUTINE lmdz_call_rrtm( & - dist, rmu0, fract, & - paprs, pplay,tsol,SFRWL,alb_dir, alb_dif, & - t, q, wo, cldfra, cldemi, cldtaupd,& - tau_aero, piz_aero, cg_aero,& - tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm,& - tau_aero_lw_rrtm, & - cldtaupi, qsat, flwc, fiwc, & - ref_liq, ref_ice, ref_liq_pi, ref_ice_pi, & - heat,heat0,cool,cool0,albpla, heat_volc, cool_volc,& - topsw,toplw,solsw,solswfdiff,sollw,& - sollwdown,topsw0,toplw0,solsw0,sollw0,& - lwdnc0, lwdn0, lwdn, lwupc0, lwup0, lwup,& - lwtoa0b, lwtoab , & - swdnc0, swdn0, swdn, swupc0, swup0, swup,& - topswad_aero, solswad_aero, topswai_aero, solswai_aero, & - topswad0_aero, solswad0_aero, topsw_aero, topsw0_aero,& - solsw_aero, solsw0_aero, topswcf_aero, solswcf_aero,& - toplwad_aero, sollwad_aero, toplwai_aero, sollwai_aero, & - toplwad0_aero, sollwad0_aero, & - ZLWFT0_i, ZFLDN0, ZFLUP0, ZSWFT0_i, ZFSDN0, ZFSUP0, & - ZFLUX_DIR, ZFLUX_DIR_CLEAR, ZFLUX_DIR_INTO_SUN, & - cloud_cover_sw) - - !=================================================================================================== - ! A. Idelkadi, mars 2026 : - ! Recriture de l interface radlwsw_m.F90 entre LMDZ - ! et les codes radiatifs oldrad/rrtm/ecrad - ! --------------------------------------------------------------------------- - ! lmdz_call_rrtm_m.F90 : - ! Interface avec le code de transfert radiatif RRTM - ! - ! TODO : - ! - Nettoyage bloc declarations : - ! * USE (supprimer use inutules / identifier les variables par ONLY) - ! * declaraions variables locales - ! - Nettoyage partie avant et apres appel a oldrad - ! ------------------------------------------------------------------------------------------- - - ! Modules necessaires - USE DIMPHY - USE write_field_phy - ! -#ifdef CPP_RRTM - USE YOERAD , ONLY : NLW - USE YOMPHY3 , ONLY : RII0 -#endif - USE aero_mod - USE conf_phys_m, ONLY: ok_ade, ok_aie, ok_volcan, flag_volc_surfstrat, & - flag_aerosol,flag_aerosol_strat,flag_aer_feedback,& - iflag_rrtm - - USE yomcst_mod_h - USE clesphys_mod_h - USE yoethf_mod_h - USE phys_constants_mod, ONLY: dobson_u - - USE lmdz_rad_ini_m - USE lmdz_rad_out_m - -! ============== - ! DECLARATIONS - ! ============== - - ! Input arguments - REAL, INTENT(in) :: dist - REAL, INTENT(in) :: rmu0(KLON), fract(KLON) - REAL, INTENT(in) :: paprs(KLON,KLEV+1), pplay(KLON,KLEV) - !albedo SB >>> - ! REAL, INTENT(in) :: alb1(KLON), alb2(KLON), tsol(KLON) - REAL, INTENT(in) :: tsol(KLON) - REAL, INTENT(in) :: alb_dir(KLON,NSW),alb_dif(KLON,NSW) - REAL, INTENT(in) :: SFRWL(6) - !albedo SB <<< - REAL, INTENT(in) :: t(KLON,KLEV), q(KLON,KLEV) - - REAL, INTENT(in):: wo(:, :, :) ! dimension(KLON,KLEV, 1 or 2) - ! column-density of ozone in a layer, in kilo-Dobsons - ! "wo(:, :, 1)" is for the average day-night field, - ! "wo(:, :, 2)" is for daylight time. - - LOGICAL :: lldebug=.false. - REAL, INTENT(in) :: cldfra(KLON,KLEV), cldemi(KLON,KLEV), cldtaupd(KLON,KLEV) - REAL, INTENT(in) :: tau_aero(KLON,KLEV,naero_grp,2) ! aerosol optical properties (see aeropt.F) - REAL, INTENT(in) :: piz_aero(KLON,KLEV,naero_grp,2) ! aerosol optical properties (see aeropt.F) - REAL, INTENT(in) :: cg_aero(KLON,KLEV,naero_grp,2) ! aerosol optical properties (see aeropt.F) - !--OB - REAL, INTENT(in) :: tau_aero_sw_rrtm(KLON,KLEV,2,NSW) ! aerosol optical properties RRTM - REAL, INTENT(in) :: piz_aero_sw_rrtm(KLON,KLEV,2,NSW) ! aerosol optical properties RRTM - REAL, INTENT(in) :: cg_aero_sw_rrtm(KLON,KLEV,2,NSW) ! aerosol optical properties RRTM - -#ifdef CPP_RRTM - REAL, INTENT(in) :: tau_aero_lw_rrtm(KLON,KLEV,2,NLW) ! LW aerosol optical properties RRTM -#else - REAL, INTENT(in) :: tau_aero_lw_rrtm(KLON,KLEV,2,nbands_lw_rrtm) -#endif - - REAL, INTENT(in) :: cldtaupi(KLON,KLEV) ! cloud optical thickness for pre-industrial aerosol concentrations - REAL, INTENT(in) :: qsat(klon,klev) ! Variable pour iflag_rrtm=1 - REAL, INTENT(in) :: flwc(klon,klev) ! Variable pour iflag_rrtm=1 - REAL, INTENT(in) :: fiwc(klon,klev) ! Variable pour iflag_rrtm=1 - REAL, INTENT(in) :: ref_liq(klon,klev) ! cloud droplet radius present-day from newmicro - REAL, INTENT(in) :: ref_ice(klon,klev) ! ice crystal radius present-day from newmicro - REAL, INTENT(in) :: ref_liq_pi(klon,klev) ! cloud droplet radius pre-industrial from newmicro - REAL, INTENT(in) :: ref_ice_pi(klon,klev) ! ice crystal radius pre-industrial from newmicro - - ! Output arguments - REAL, INTENT(out) :: heat(KLON,KLEV), cool(KLON,KLEV) - REAL, INTENT(out) :: heat0(KLON,KLEV), cool0(KLON,KLEV) - REAL, INTENT(out) :: heat_volc(KLON,KLEV), cool_volc(KLON,KLEV) !NL - REAL, INTENT(out) :: topsw(KLON), toplw(KLON) - REAL, INTENT(out) :: solsw(KLON), sollw(KLON), albpla(KLON), solswfdiff(KLON) - REAL, INTENT(out) :: topsw0(KLON), toplw0(KLON), solsw0(KLON), sollw0(KLON) - REAL, INTENT(out) :: sollwdown(KLON) - REAL, INTENT(out) :: swdn(KLON,kflev+1),swdn0(KLON,kflev+1), swdnc0(KLON,kflev+1) - REAL, INTENT(out) :: swup(KLON,kflev+1),swup0(KLON,kflev+1), swupc0(KLON,kflev+1) - REAL, INTENT(out) :: lwdn(KLON,kflev+1),lwdn0(KLON,kflev+1), lwdnc0(KLON,kflev+1) - REAL, INTENT(out) :: lwup(KLON,kflev+1),lwup0(KLON,kflev+1), lwupc0(KLON,kflev+1) - !FC je remplace NLW par nbands_lw_rrtm qui est defini dans aero_mod peut etre que a ce niveau NLW est attribué? - REAL, INTENT(out) :: lwtoa0b(KLON,nbands_lw_rrtm), lwtoab(KLON,nbands_lw_rrtm) !FC flux TOA LW par bandes - - REAL, INTENT(out) :: topswad_aero(KLON), solswad_aero(KLON) ! output: aerosol direct forcing at TOA and surface - REAL, INTENT(out) :: topswai_aero(KLON), solswai_aero(KLON) ! output: aerosol indirect forcing atTOA and surface - REAL, INTENT(out) :: toplwad_aero(KLON), sollwad_aero(KLON) ! output: LW aerosol direct forcing at TOA and surface - REAL, INTENT(out) :: toplwai_aero(KLON), sollwai_aero(KLON) ! output: LW aerosol indirect forcing atTOA and surface - REAL, DIMENSION(klon), INTENT(out) :: topswad0_aero - REAL, DIMENSION(klon), INTENT(out) :: solswad0_aero - REAL, DIMENSION(klon), INTENT(out) :: toplwad0_aero - REAL, DIMENSION(klon), INTENT(out) :: sollwad0_aero - REAL, DIMENSION(kdlon,9), INTENT(out) :: topsw_aero - REAL, DIMENSION(kdlon,9), INTENT(out) :: topsw0_aero - REAL, DIMENSION(kdlon,9), INTENT(out) :: solsw_aero - REAL, DIMENSION(kdlon,9), INTENT(out) :: solsw0_aero - REAL, DIMENSION(kdlon,3), INTENT(out) :: topswcf_aero - REAL, DIMENSION(kdlon,3), INTENT(out) :: solswcf_aero - REAL, DIMENSION(kdlon,kflev+1), INTENT(out) :: ZSWFT0_i - REAL, DIMENSION(kdlon,kflev+1), INTENT(out) :: ZLWFT0_i - - ! Local variables - REAL(KIND=8) ZFSUP(KDLON,KFLEV+1) - REAL(KIND=8) ZFSDN(KDLON,KFLEV+1) - REAL(KIND=8) ZFSUP0(KDLON,KFLEV+1) - REAL(KIND=8) ZFSDN0(KDLON,KFLEV+1) - REAL(KIND=8) ZFSUPC0(KDLON,KFLEV+1) - REAL(KIND=8) ZFSDNC0(KDLON,KFLEV+1) - REAL(KIND=8) ZFLUP(KDLON,KFLEV+1) - REAL(KIND=8) ZFLDN(KDLON,KFLEV+1) - REAL(KIND=8) ZFLUP0(KDLON,KFLEV+1) - REAL(KIND=8) ZFLDN0(KDLON,KFLEV+1) - REAL(KIND=8) ZFLUPC0(KDLON,KFLEV+1) - REAL(KIND=8) ZFLDNC0(KDLON,KFLEV+1) - REAL(KIND=8) zx_alpha1, zx_alpha2 - INTEGER k, kk, i, l, iof, jb !FC - INTEGER ist,iend,ktdia,kmode - REAL(KIND=8) PSCT - REAL(KIND=8) PALBD(kdlon,2), PALBP(kdlon,2) - ! MPL 06.01.09: pour RRTM, creation de PALBD_NEW et PALBP_NEW - ! avec NSW en deuxieme dimension - REAL(KIND=8) PALBD_NEW(kdlon,NSW), PALBP_NEW(kdlon,NSW) - REAL(KIND=8) PEMIS(kdlon), PDT0(kdlon), PVIEW(kdlon) - REAL(KIND=8) PPSOL(kdlon), PDP(kdlon,KLEV) - REAL(KIND=8) PTL(kdlon,kflev+1), PPMB(kdlon,kflev+1) - REAL(KIND=8) PTAVE(kdlon,kflev) - REAL(KIND=8) PWV(kdlon,kflev), PQS(kdlon,kflev) - - REAL(KIND=8) cloud_cover_sw(klon) - REAL(KIND=8), dimension(klon,klev+1) :: ZFLUX_DIR, & ! Direct compt of surf flux into horizontal plane - ZFLUX_DIR_CLEAR ! CS Direct - REAL(KIND=8), dimension(klon) :: ZFLUX_DIR_INTO_SUN - - REAL(kind=8) POZON(kdlon, kflev, size(wo, 3)) ! mass fraction of ozone - ! "POZON(:, :, 1)" is for the average day-night field, - ! "POZON(:, :, 2)" is for daylight time. - ! Modif MPL 6.01.09 avec RRTM, on passe de 5 a 6 - REAL(KIND=8) PAER(kdlon,kflev,6) - REAL(KIND=8) PCLDLD(kdlon,kflev) - REAL(KIND=8) PCLDLU(kdlon,kflev) - REAL(KIND=8) PCLDSW(kdlon,kflev) - REAL(KIND=8) PTAU(kdlon,2,kflev) - REAL(KIND=8) POMEGA(kdlon,2,kflev) - REAL(KIND=8) PCG(kdlon,2,kflev) - REAL(KIND=8) zfract(kdlon), zrmu0(kdlon), zdist - REAL(KIND=8) zheat(kdlon,kflev), zcool(kdlon,kflev) - REAL(KIND=8) zheat0(kdlon,kflev), zcool0(kdlon,kflev) - REAL(KIND=8) zheat_volc(kdlon,kflev), zcool_volc(kdlon,kflev) !NL - REAL(KIND=8) ztopsw(kdlon), ztoplw(kdlon) - REAL(KIND=8) zsolsw(kdlon), zsollw(kdlon), zalbpla(kdlon), zsolswfdiff(kdlon) - REAL(KIND=8) zsollwdown(kdlon) - REAL(KIND=8) ztopsw0(kdlon), ztoplw0(kdlon) - REAL(KIND=8) zsolsw0(kdlon), zsollw0(kdlon) - REAL(KIND=8) tauaero(kdlon,kflev,naero_grp,2) ! aer opt properties - REAL(KIND=8) pizaero(kdlon,kflev,naero_grp,2) - REAL(KIND=8) cgaero(kdlon,kflev,naero_grp,2) - REAL(KIND=8) PTAUA(kdlon,2,kflev) ! present-day value of cloud opt thickness (PTAU is pre-industrial value), local use - REAL(KIND=8) POMEGAA(kdlon,2,kflev) ! dito for single scatt albedo - REAL(KIND=8) ztopswadaero(kdlon), zsolswadaero(kdlon) ! Aerosol direct forcing at TOAand surface - REAL(KIND=8) ztopswad0aero(kdlon), zsolswad0aero(kdlon) ! Aerosol direct forcing at TOAand surface - REAL(KIND=8) ztopswaiaero(kdlon), zsolswaiaero(kdlon) ! dito, indirect - !--NL - REAL(KIND=8) zswadaero(kdlon,kflev+1) ! SW Aerosol direct forcing - REAL(KIND=8) zlwadaero(kdlon,kflev+1) ! LW Aerosol direct forcing - REAL(KIND=8) volmip_solsw(kdlon) ! SW clear sky in the case of VOLMIP - !-LW by CK - REAL(KIND=8) ztoplwadaero(kdlon), zsollwadaero(kdlon) ! LW Aerosol direct forcing at TOAand surface - REAL(KIND=8) ztoplwad0aero(kdlon), zsollwad0aero(kdlon) ! LW Aerosol direct forcing at TOAand surface - REAL(KIND=8) ztoplwaiaero(kdlon), zsollwaiaero(kdlon) ! dito, indirect - !-end - REAL(KIND=8) ztopsw_aero(kdlon,9), ztopsw0_aero(kdlon,9) - REAL(KIND=8) zsolsw_aero(kdlon,9), zsolsw0_aero(kdlon,9) - REAL(KIND=8) ztopswcf_aero(kdlon,3), zsolswcf_aero(kdlon,3) - !MPL input supplementaires pour RECMWFL - ! flwc, fiwc = Liquid Water Content & Ice Water Content (kg/kg) - !MPL input RECMWFL: - ! Tableaux aux niveaux inverses pour respecter convention Arpege - REAL(KIND=8) ref_liq_i(klon,klev) ! cloud droplet radius present-day from newmicro (inverted) - REAL(KIND=8) ref_ice_i(klon,klev) ! ice crystal radius present-day from newmicro (inverted) - !--OB - REAL(KIND=8) ref_liq_pi_i(klon,klev) ! cloud droplet radius pre-industrial from newmicro (inverted) - REAL(KIND=8) ref_ice_pi_i(klon,klev) ! ice crystal radius pre-industrial from newmicro (inverted) - !--end OB - REAL(KIND=8) paprs_i(klon,klev+1) - REAL(KIND=8) pplay_i(klon,klev) - REAL(KIND=8) cldfra_i(klon,klev) - REAL(KIND=8) POZON_i(kdlon,kflev, size(wo, 3)) ! mass fraction of ozone - ! "POZON(:, :, 1)" is for the average day-night field, - ! "POZON(:, :, 2)" is for daylight time. - ! Modif MPL 6.01.09 avec RRTM, on passe de 5 a 6 - REAL(KIND=8) PAER_i(kdlon,kflev,6) - REAL(KIND=8) PDP_i(klon,klev) - REAL(KIND=8) t_i(klon,klev),q_i(klon,klev),qsat_i(klon,klev) - REAL(KIND=8) flwc_i(klon,klev),fiwc_i(klon,klev) - !MPL output RECMWFL: - REAL(KIND=8) ZEMTD (klon,klev+1),ZEMTD_i (klon,klev+1) - REAL(KIND=8) ZEMTU (klon,klev+1),ZEMTU_i (klon,klev+1) - REAL(KIND=8) ZTRSO (klon,klev+1),ZTRSO_i (klon,klev+1) - REAL(KIND=8) ZTH (klon,klev+1),ZTH_i (klon,klev+1) - REAL(KIND=8) ZCTRSO(klon,2) - REAL(KIND=8) ZCEMTR(klon,2) - REAL(KIND=8) ZTRSOD(klon) - REAL(KIND=8) ZLWFC (klon,2) - REAL(KIND=8) ZLWFT (klon,klev+1),ZLWFT_i (klon,klev+1) - REAL(KIND=8) ZSWFC (klon,2) - REAL(KIND=8) ZSWFT (klon,klev+1),ZSWFT_i (klon,klev+1) - REAL(KIND=8) PPIZA_TOT(klon,klev,NSW) - REAL(KIND=8) PCGA_TOT(klon,klev,NSW) - REAL(KIND=8) PTAU_TOT(klon,klev,NSW) - REAL(KIND=8) PPIZA_NAT(klon,klev,NSW) - REAL(KIND=8) PCGA_NAT(klon,klev,NSW) - REAL(KIND=8) PTAU_NAT(klon,klev,NSW) -#ifdef CPP_RRTM - REAL(KIND=8) PTAU_LW_TOT(klon,klev,NLW) - REAL(KIND=8) PTAU_LW_NAT(klon,klev,NLW) -#endif - REAL(KIND=8) PSFSWDIR(klon,NSW) - REAL(KIND=8) PSFSWDIF(klon,NSW) - REAL(KIND=8) PFSDNN(klon) - REAL(KIND=8) PFSDNV(klon) - !MPL On ne redefinit pas les tableaux ZFLUX,ZFLUC, - !MPL ZFSDWN,ZFCDWN,ZFSUP,ZFCUP car ils existent deja - !MPL sous les noms de ZFLDN,ZFLDN0,ZFLUP,ZFLUP0, - !MPL ZFSDN,ZFSDN0,ZFSUP,ZFSUP0 - REAL(KIND=8) ZFLUX_i (klon,2,klev+1) - REAL(KIND=8) ZFLUC_i (klon,2,klev+1) - !FC - !FC je remplace NLW par nbands_lw_rrtm qui est defini dans aero_mod - - REAL(KIND=8) ZTOAB_i (klon,nbands_lw_rrtm) - REAL(KIND=8) ZTOACB_i (klon,nbands_lw_rrtm) - !FC - - REAL(KIND=8) ZFSDWN_i (klon,klev+1) - REAL(KIND=8) ZFCDWN_i (klon,klev+1) - REAL(KIND=8) ZFCCDWN_i (klon,klev+1) - REAL(KIND=8) ZFSUP_i (klon,klev+1) - REAL(KIND=8) ZFCUP_i (klon,klev+1) - REAL(KIND=8) ZFCCUP_i (klon,klev+1) - REAL(KIND=8) ZFLCCDWN_i (klon,klev+1) - REAL(KIND=8) ZFLCCUP_i (klon,klev+1) - ! 3 lignes suivantes a activer pour CCMVAL (MPL 20100412) - ! REAL(KIND=8) RSUN(3,2) - ! REAL(KIND=8) SUN(3) - ! REAL(KIND=8) SUN_FRACT(2) - CHARACTER (LEN=80) :: abort_message - CHARACTER (LEN=80) :: modname='lmdz_call_rrtm' - - REAL zdir(klon), zdif(klon) - INTEGER :: dimoz - - dimoz=size(wo,3) - - CALL lmdz_rad_ini( & - ist,iend,ktdia,kmode, & - dist, rmu0, fract, & - paprs, pplay, tsol, SFRWL, alb_dir, alb_dif, & - t, q, wo, cldfra, cldemi, cldtaupd, & - tau_aero, piz_aero, cg_aero, & - tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm, & - cldtaupi, qsat, flwc, fiwc, iof, & - heat, heat0, cool, cool0, heat_volc, cool_volc, & - zheat, zheat0, zcool, zcool0, zheat_volc, zcool_volc, & - zdist, PSCT, zfract, zrmu0, & - PAER, PCLDLD, PCLDLU, PCLDSW, & - PTAU, PTAUA, POMEGA, POMEGAA, PCG, & - PALBD, PALBP, PALBD_NEW, PALBP_NEW, & - PEMIS, PDT0, PVIEW, PPSOL,PDP, & - PTL, PPMB, PTAVE, PWV, PQS, & - zx_alpha1, zx_alpha2, POZON, & - tauaero, pizaero, cgaero, & - ztopsw_aero, ztopsw0_aero, zsolsw_aero, zsolsw0_aero, & - ztopswcf_aero, zsolswcf_aero, & - ztopswadaero,zsolswadaero,ztopswad0aero, & - zsolswad0aero,zsollwadaero,zsollwad0aero, & - ztopswaiaero,zsolswaiaero,ztoplwaiaero,zsollwaiaero) - ! - !===== iflag_rrtm ================================================ - IF (iflag_rrtm == 1) then -#ifdef CPP_RRTM - ! if (prt_level.gt.10)write(lunout,*)'CPP_RRTM=.T.' - !===== iflag_rrtm=1, on passe dans SW via RECMWFL =============== - - DO k = 1, kflev+1 - DO i = 1, kdlon - ZEMTD_i(i,k)=0. - ZEMTU_i(i,k)=0. - ZTRSO_i(i,k)=0. - ZTH_i(i,k)=0. - ZLWFT_i(i,k)=0. - ZSWFT_i(i,k)=0. - ZFLUX_i(i,1,k)=0. - ZFLUX_i(i,2,k)=0. - ZFLUC_i(i,1,k)=0. - ZFLUC_i(i,2,k)=0. - ZFSDWN_i(i,k)=0. - ZFCDWN_i(i,k)=0. - ZFCCDWN_i(i,k)=0. - ZFSUP_i(i,k)=0. - ZFCUP_i(i,k)=0. - ZFCCUP_i(i,k)=0. - ZFLCCDWN_i(i,k)=0. - ZFLCCUP_i(i,k)=0. - ENDDO - ENDDO - ! - !--OB - !--aerosol TOT - anthropogenic+natural - index 2 - !--aerosol NAT - natural only - index 1 - ! - DO kk=1, NSW - DO k = 1, kflev - DO i = 1, kdlon - ! - PTAU_TOT(i,kflev+1-k,kk)=tau_aero_sw_rrtm(i,k,2,kk) - PPIZA_TOT(i,kflev+1-k,kk)=piz_aero_sw_rrtm(i,k,2,kk) - PCGA_TOT(i,kflev+1-k,kk)=cg_aero_sw_rrtm(i,k,2,kk) - ! - PTAU_NAT(i,kflev+1-k,kk)=tau_aero_sw_rrtm(i,k,1,kk) - PPIZA_NAT(i,kflev+1-k,kk)=piz_aero_sw_rrtm(i,k,1,kk) - PCGA_NAT(i,kflev+1-k,kk)=cg_aero_sw_rrtm(i,k,1,kk) - ! - ENDDO - ENDDO - ENDDO - !-end OB - ! - !--C. Kleinschmitt - !--aerosol TOT - anthropogenic+natural - index 2 - !--aerosol NAT - natural only - index 1 - ! - DO kk=1, NLW - DO k = 1, kflev - DO i = 1, kdlon - ! - PTAU_LW_TOT(i,kflev+1-k,kk)=tau_aero_lw_rrtm(i,k,2,kk) - PTAU_LW_NAT(i,kflev+1-k,kk)=tau_aero_lw_rrtm(i,k,1,kk) - ! - ENDDO - ENDDO - ENDDO - !-end C. Kleinschmitt - ! - DO i = 1, kdlon - ZCTRSO(i,1)=0. - ZCTRSO(i,2)=0. - ZCEMTR(i,1)=0. - ZCEMTR(i,2)=0. - ZTRSOD(i)=0. - ZLWFC(i,1)=0. - ZLWFC(i,2)=0. - ZSWFC(i,1)=0. - ZSWFC(i,2)=0. - PFSDNN(i)=0. - PFSDNV(i)=0. - ENDDO - - DO kk = 1, NSW - DO i = 1, kdlon - PSFSWDIR(i,kk)=0. - PSFSWDIF(i,kk)=0. - ENDDO - ENDDO - !----- Fin des mises a zero des tableaux output de RECMWF ------------------- - ! GEMU(1:klon)=sin(rlatd(1:klon)) - ! On met les donnees dans l'ordre des niveaux arpege - paprs_i(:,1)=paprs(:,klev+1) - DO k=1,klev - DO i = 1, klon - paprs_i(i,k+1) =paprs(i,klev+1-k) - pplay_i(i,k) =pplay(i,klev+1-k) - cldfra_i(i,k) =cldfra(i,klev+1-k) - PDP_i(i,k) =PDP(i,klev+1-k) - t_i(i,k) =t(i,klev+1-k) - q_i(i,k) =q(i,klev+1-k) - qsat_i(i,k) =qsat(i,klev+1-k) - flwc_i(i,k) =flwc(i,klev+1-k) - fiwc_i(i,k) =fiwc(i,klev+1-k) - ref_liq_i(i,k) =ref_liq(i,klev+1-k) - ref_ice_i(i,k) =ref_ice(i,klev+1-k) - !-OB - ref_liq_pi_i(i,k) =ref_liq_pi(i,klev+1-k) - ref_ice_pi_i(i,k) =ref_ice_pi(i,klev+1-k) - ENDDO - ENDDO - - DO l=1,dimoz - DO k=1,kflev - POZON_i(1:klon,k,l)=POZON(1:klon,kflev+1-k,l) - ! POZON_i(1:klon,k)=POZON(1:klon,k) ! on laisse 1=sol et klev=top - ! print *,'Juste avant RECMWFL: k tsol temp',k,tsol,t(1,k) - ! Modif MPL 6.01.09 avec RRTM, on passe de 5 a 6 - ENDDO - ENDDO - - DO l=1,6 - DO k=1,kflev - PAER_i(1:klon,k,l)=PAER(1:klon,kflev+1-k,l) - ENDDO - ENDDO - - ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - ! La version ARPEGE1D utilise differentes valeurs de la constante - ! solaire suivant le rayonnement utilise. - ! A controler ... - ! SOLAR FLUX AT THE TOP (/YOMPHY3/) - ! introduce season correction - !-------------------------------------- - ! RII0 = RIP0 - ! IF(LRAYFM) - ! RII0 = RIP0M ! =rip0m if Morcrette non-each time step call. - ! IF(LRAYFM15) - ! RII0 = RIP0M15 ! =rip0m if Morcrette non-each time step call. - RII0=solaire/zdist/zdist - ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - ! Ancien appel a RECMWF (celui du cy25) - ! CALL RECMWF (ist , iend, klon , ktdia , klev , kmode , - ! s PALBD , PALBP , paprs_i , pplay_i , RCO2 , cldfra_i, - ! s POZON_i , PAER_i , PDP_i , PEMIS , GEMU , rmu0, - ! s q_i , qsat_i , fiwc_i , flwc_i , zmasq , t_i ,tsol, - ! s ZEMTD_i , ZEMTU_i , ZTRSO_i , - ! s ZTH_i , ZCTRSO , ZCEMTR , ZTRSOD , - ! s ZLWFC , ZLWFT_i , ZSWFC , ZSWFT_i , - ! s ZFLUX_i , ZFLUC_i , ZFSDWN_i, ZFSUP_i , ZFCDWN_i,ZFCUP_i) - ! s 'RECMWF ') - ! - IF (lldebug) THEN - CALL writefield_phy('paprs_i',paprs_i,klev+1) - CALL writefield_phy('pplay_i',pplay_i,klev) - CALL writefield_phy('cldfra_i',cldfra_i,klev) - CALL writefield_phy('pozon_i',POZON_i,klev) - CALL writefield_phy('paer_i',PAER_i,klev) - CALL writefield_phy('pdp_i',PDP_i,klev) - CALL writefield_phy('q_i',q_i,klev) - CALL writefield_phy('qsat_i',qsat_i,klev) - CALL writefield_phy('fiwc_i',fiwc_i,klev) - CALL writefield_phy('flwc_i',flwc_i,klev) - CALL writefield_phy('t_i',t_i,klev) - CALL writefield_phy('palbd_new',PALBD_NEW,NSW) - CALL writefield_phy('palbp_new',PALBP_NEW,NSW) - ENDIF - - ! Nouvel appel a RECMWF (celui du cy32t0) - CALL RECMWF_AERO (ist , iend, klon , ktdia , klev , kmode ,& - PALBD_NEW,PALBP_NEW, paprs_i , pplay_i , RCO2 , cldfra_i,& - POZON_i , PAER_i , PDP_i , PEMIS , rmu0 ,& - q_i , qsat_i , fiwc_i , flwc_i , zmasq , t_i ,tsol,& - ref_liq_i, ref_ice_i, & - ref_liq_pi_i, ref_ice_pi_i, & ! rajoute par OB pour diagnostiquer effet indirect - ZEMTD_i , ZEMTU_i , ZTRSO_i ,& - ZTH_i , ZCTRSO , ZCEMTR , ZTRSOD ,& - ZLWFC , ZLWFT_i , ZSWFC , ZSWFT_i ,& - PSFSWDIR , PSFSWDIF, PFSDNN , PFSDNV ,& - PPIZA_TOT, PCGA_TOT,PTAU_TOT,& - PPIZA_NAT, PCGA_NAT,PTAU_NAT, & ! rajoute par OB pour diagnostiquer effet direct - PTAU_LW_TOT, PTAU_LW_NAT, & ! rajoute par C. Kleinschmitt - ZFLUX_i , ZFLUC_i ,& - ZTOAB_i , ZTOACB_i, & ! FC flux spectraux TOA - ZFSDWN_i , ZFSUP_i , ZFCDWN_i, ZFCUP_i, ZFCCDWN_i, ZFCCUP_i, ZFLCCDWN_i, ZFLCCUP_i, & - ZTOPSWADAERO,ZSOLSWADAERO,& ! rajoute par OB pour diagnostics - ZTOPSWAD0AERO,ZSOLSWAD0AERO,& - ZTOPSWAIAERO,ZSOLSWAIAERO, & - ZTOPSWCF_AERO,ZSOLSWCF_AERO, & - ZSWADAERO, & !--NL - ZTOPLWADAERO,ZSOLLWADAERO,& ! rajoute par C. Kleinscmitt pour LW diagnostics - ZTOPLWAD0AERO,ZSOLLWAD0AERO,& - ZTOPLWAIAERO,ZSOLLWAIAERO, & - ZLWADAERO, & !--NL - volmip_solsw, flag_volc_surfstrat, & !--VOLMIP - ok_ade, ok_aie, ok_volcan, flag_aerosol,flag_aerosol_strat, flag_aer_feedback) ! flags aerosols - - ! print *,'RADLWSW: apres RECMWF' - IF (lldebug) THEN - CALL writefield_phy('zemtd_i',ZEMTD_i,klev+1) - CALL writefield_phy('zemtu_i',ZEMTU_i,klev+1) - CALL writefield_phy('ztrso_i',ZTRSO_i,klev+1) - CALL writefield_phy('zth_i',ZTH_i,klev+1) - CALL writefield_phy('zctrso',ZCTRSO,2) - CALL writefield_phy('zcemtr',ZCEMTR,2) - CALL writefield_phy('ztrsod',ZTRSOD,1) - CALL writefield_phy('zlwfc',ZLWFC,2) - CALL writefield_phy('zlwft_i',ZLWFT_i,klev+1) - CALL writefield_phy('zswfc',ZSWFC,2) - CALL writefield_phy('zswft_i',ZSWFT_i,klev+1) - CALL writefield_phy('psfswdir',PSFSWDIR,6) - CALL writefield_phy('psfswdif',PSFSWDIF,6) - CALL writefield_phy('pfsdnn',PFSDNN,1) - CALL writefield_phy('pfsdnv',PFSDNV,1) - CALL writefield_phy('ppiza_dst',PPIZA_TOT,klev) - CALL writefield_phy('pcga_dst',PCGA_TOT,klev) - CALL writefield_phy('ptaurel_dst',PTAU_TOT,klev) - CALL writefield_phy('zflux_i',ZFLUX_i,klev+1) - CALL writefield_phy('zfluc_i',ZFLUC_i,klev+1) - CALL writefield_phy('zfsdwn_i',ZFSDWN_i,klev+1) - CALL writefield_phy('zfsup_i',ZFSUP_i,klev+1) - CALL writefield_phy('zfcdwn_i',ZFCDWN_i,klev+1) - CALL writefield_phy('zfcup_i',ZFCUP_i,klev+1) - ENDIF - - ! --------- - ! --------- - ! On retablit l'ordre des niveaux lmd pour les tableaux de sortie - ! D autre part, on multiplie les resultats SW par fract pour etre coherent - ! avec l ancien rayonnement AR4. Si nuit, fract=0 donc pas de - ! rayonnement SW. (MPL 260609) - DO k=0,klev - DO i=1,klon - ZEMTD(i,k+1) = ZEMTD_i(i,k+1) - ZEMTU(i,k+1) = ZEMTU_i(i,k+1) - ZTRSO(i,k+1) = ZTRSO_i(i,k+1) - ZTH(i,k+1) = ZTH_i(i,k+1) - ! ZLWFT(i,k+1) = ZLWFT_i(i,klev+1-k) - ! ZSWFT(i,k+1) = ZSWFT_i(i,klev+1-k) - ZFLUP(i,k+1) = ZFLUX_i(i,1,k+1) - ZFLDN(i,k+1) = ZFLUX_i(i,2,k+1) - ZFLUP0(i,k+1) = ZFLUC_i(i,1,k+1) - ZFLDN0(i,k+1) = ZFLUC_i(i,2,k+1) - ZFSDN(i,k+1) = ZFSDWN_i(i,k+1)*fract(i) - ZFSDN0(i,k+1) = ZFCDWN_i(i,k+1)*fract(i) - ZFSDNC0(i,k+1)= ZFCCDWN_i(i,k+1)*fract(i) - ZFSUP (i,k+1) = ZFSUP_i(i,k+1)*fract(i) - ZFSUP0(i,k+1) = ZFCUP_i(i,k+1)*fract(i) - ZFSUPC0(i,k+1)= ZFCCUP_i(i,k+1)*fract(i) - ZFLDNC0(i,k+1)= ZFLCCDWN_i(i,k+1) - ZFLUPC0(i,k+1)= ZFLCCUP_i(i,k+1) - IF (ok_volcan) THEN - ZSWADAERO(i,k+1)=ZSWADAERO(i,k+1)*fract(i) !--NL - ENDIF - - ! Nouveau calcul car visiblement ZSWFT et ZSWFC sont nuls dans RRTM cy32 - ! en sortie de radlsw.F90 - MPL 7.01.09 - ZSWFT(i,k+1) = (ZFSDWN_i(i,k+1)-ZFSUP_i(i,k+1))*fract(i) - ZSWFT0_i(i,k+1) = (ZFCDWN_i(i,k+1)-ZFCUP_i(i,k+1))*fract(i) - ! WRITE(*,'("FSDN FSUP FCDN FCUP: ",4E12.5)') ZFSDWN_i(i,k+1),& - ! ZFSUP_i(i,k+1),ZFCDWN_i(i,k+1),ZFCUP_i(i,k+1) - ZLWFT(i,k+1) =-ZFLUX_i(i,2,k+1)-ZFLUX_i(i,1,k+1) - ZLWFT0_i(i,k+1)=-ZFLUC_i(i,2,k+1)-ZFLUC_i(i,1,k+1) - ! print *,'FLUX2 FLUX1 FLUC2 FLUC1',ZFLUX_i(i,2,k+1),& - ! & ZFLUX_i(i,1,k+1),ZFLUC_i(i,2,k+1),ZFLUC_i(i,1,k+1) - ENDDO - ENDDO - - !--ajout OB - ZTOPSWADAERO(:) =ZTOPSWADAERO(:) *fract(:) - ZSOLSWADAERO(:) =ZSOLSWADAERO(:) *fract(:) - ZTOPSWAD0AERO(:)=ZTOPSWAD0AERO(:)*fract(:) - ZSOLSWAD0AERO(:)=ZSOLSWAD0AERO(:)*fract(:) - ZTOPSWAIAERO(:) =ZTOPSWAIAERO(:) *fract(:) - ZSOLSWAIAERO(:) =ZSOLSWAIAERO(:) *fract(:) - ZTOPSWCF_AERO(:,1)=ZTOPSWCF_AERO(:,1)*fract(:) - ZTOPSWCF_AERO(:,2)=ZTOPSWCF_AERO(:,2)*fract(:) - ZTOPSWCF_AERO(:,3)=ZTOPSWCF_AERO(:,3)*fract(:) - ZSOLSWCF_AERO(:,1)=ZSOLSWCF_AERO(:,1)*fract(:) - ZSOLSWCF_AERO(:,2)=ZSOLSWCF_AERO(:,2)*fract(:) - ZSOLSWCF_AERO(:,3)=ZSOLSWCF_AERO(:,3)*fract(:) - - ! --------- - ! --------- - ! On renseigne les champs LMDz, pour avoir la meme chose qu'en sortie de - ! LW_LMDAR4 et SW_LMDAR4 - - !--fraction of diffuse radiation in surface SW downward radiation - zdir(:)=0. - zdif(:)=0. - DO k=1,NSW - DO i = 1, kdlon - zdir(i)=zdir(i) + PSFSWDIR(i,k) - zdif(i)=zdif(i) + PSFSWDIF(i,k) - ENDDO - ENDDO - - DO i = 1, kdlon - IF (fract(i).GT.0.0) THEN - zsolswfdiff(i) = zdif(i)/(zdir(i)+zdif(i)) - ELSE !--night - zsolswfdiff(i) = 1.0 - ENDIF - ENDDO - ! - DO i = 1, kdlon - zsolsw(i) = ZSWFT(i,1) - zsolsw0(i) = ZSWFT0_i(i,1) - ! zsolsw0(i) = ZFSDN0(i,1) -ZFSUP0(i,1) - ztopsw(i) = ZSWFT(i,klev+1) - ztopsw0(i) = ZSWFT0_i(i,klev+1) - ! ztopsw0(i) = ZFSDN0(i,klev+1)-ZFSUP0(i,klev+1) - ! - ! zsollw(i) = ZFLDN(i,1) -ZFLUP(i,1) - ! zsollw0(i) = ZFLDN0(i,1) -ZFLUP0(i,1) - ! ztoplw(i) = ZFLDN(i,klev+1) -ZFLUP(i,klev+1) - ! ztoplw0(i) = ZFLDN0(i,klev+1)-ZFLUP0(i,klev+1) - zsollw(i) = ZLWFT(i,1) - zsollw0(i) = ZLWFT0_i(i,1) - ztoplw(i) = ZLWFT(i,klev+1)*(-1) - ztoplw0(i) = ZLWFT0_i(i,klev+1)*(-1) - ! - IF (fract(i) == 0.) THEN - ! A REVOIR MPL (20090630) ca n a pas de sens quand fract=0 - ! pas plus que dans le sw_AR4 - zalbpla(i) = 1.0e+39 - ELSE - zalbpla(i) = ZFSUP(i,klev+1)/ZFSDN(i,klev+1) - ENDIF - ! 5 juin 2015 - ! Correction MP bug RRTM - zsollwdown(i)= -1.*ZFLDN(i,1) - ENDDO - ! print*,'OK2' - - !--add VOLMIP (surf cool or strat heat activate) - IF (flag_volc_surfstrat > 0) THEN - DO i = 1, kdlon - zsolsw(i) = volmip_solsw(i)*fract(i) - ENDDO - ENDIF - - DO k=1,kflev - DO i=1,kdlon - zheat(i,k)=(ZSWFT(i,k+1)-ZSWFT(i,k))*RDAY*RG/RCPD/PDP(i,k) - zheat0(i,k)=(ZSWFT0_i(i,k+1)-ZSWFT0_i(i,k))*RDAY*RG/RCPD/PDP(i,k) - zcool(i,k)=(ZLWFT(i,k)-ZLWFT(i,k+1))*RDAY*RG/RCPD/PDP(i,k) - zcool0(i,k)=(ZLWFT0_i(i,k)-ZLWFT0_i(i,k+1))*RDAY*RG/RCPD/PDP(i,k) - IF (ok_volcan) THEN - zheat_volc(i,k)=(ZSWADAERO(i,k+1)-ZSWADAERO(i,k))*RG/RCPD/PDP(i,k) !NL - zcool_volc(i,k)=(ZLWADAERO(i,k)-ZLWADAERO(i,k+1))*RG/RCPD/PDP(i,k) !NL - ENDIF - ENDDO - ENDDO - !FC - DO jb = 1, nbands_lw_rrtm !FC - DO i=1,kdlon - lwtoab(i,jb) = ZTOAB_i(i,jb) - lwtoa0b(i,jb) = ZTOACB_i(i,jb) - ENDDO - ENDDO - -#else - abort_message="You should compile with -rrtm if running with iflag_rrtm=1" - call abort_physic(modname, abort_message, 1) -#endif - ENDIF - !====================================================================== - - ! ----- flux radiatifs => sorties --------------------------------- - - CALL lmdz_rad_out( & - iof, PWV, & - ZFSUP, ZFSDN, ZFSUP0, ZFSDN0, & - ZFSUPC0, ZFSDNC0, ZFLUP, ZFLDN, & - ZFLUP0, ZFLDN0, ZFLUPC0, ZFLDNC0, & - zheat, zcool, zheat0, zcool0, zheat_volc, zcool_volc, & - ztopsw, ztoplw, zsolsw, zsollw, zalbpla, zsolswfdiff, & - zsollwdown, ztopsw0, ztoplw0, zsolsw0, zsollw0, & - ztopswadaero, zsolswadaero, ztopswad0aero, zsolswad0aero, & - ztopswaiaero, zsolswaiaero, ztoplwadaero, zsollwadaero, & - ztoplwad0aero, zsollwad0aero, ztoplwaiaero, zsollwaiaero, & - ztopsw_aero, ztopsw0_aero, zsolsw_aero, zsolsw0_aero, & - ztopswcf_aero, zsolswcf_aero, & - heat, heat0, cool, cool0, albpla, heat_volc, cool_volc,& - topsw, toplw, solsw, solswfdiff, sollw, sollwdown,& - topsw0, toplw0, solsw0, sollw0,& - lwdnc0, lwdn0, lwdn, lwupc0, lwup0, lwup,& - swdnc0, swdn0, swdn, swupc0, swup0, swup,& - topswad_aero, solswad_aero, topswai_aero, solswai_aero, & - topswad0_aero, solswad0_aero, topsw_aero, topsw0_aero,& - solsw_aero, solsw0_aero, topswcf_aero, solswcf_aero,& - toplwad_aero, sollwad_aero, toplwai_aero, sollwai_aero, & - toplwad0_aero, sollwad0_aero, & - cloud_cover_sw, ZFLUX_DIR, ZFLUX_DIR_CLEAR, ZFLUX_DIR_INTO_SUN) - - END SUBROUTINE lmdz_call_rrtm - -END MODULE lmdz_call_rrtm_m Index: DZ6/trunk/libf/phylmd/lmdz_rad_ini_m.F90 =================================================================== --- /LMDZ6/trunk/libf/phylmd/lmdz_rad_ini_m.F90 (revision 6180) +++ (revision ) @@ -1,383 +1,0 @@ -! -! $Id: radlwsw_m.F90 6127 2026-03-26 13:59:25Z idelkadi $ -! -MODULE lmdz_rad_ini_m - IMPLICIT NONE -CONTAINS - - SUBROUTINE lmdz_rad_ini( & - ist,iend,ktdia,kmode, & - dist, rmu0, fract, & - paprs, pplay,tsol,SFRWL,alb_dir, alb_dif, & - t,q,wo,& - cldfra, cldemi, cldtaupd,& - tau_aero, piz_aero, cg_aero,& - tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm,& ! rajoute par OB RRTM - cldtaupi, & - qsat, flwc, fiwc, iof, & - heat,heat0,cool,cool0,& - heat_volc, cool_volc,& - zheat,zheat0,zcool,zcool0,& - zheat_volc, zcool_volc,& - zdist,PSCT,zfract,zrmu0, & - PAER,PCLDLD,PCLDLU,PCLDSW,& - PTAU,PTAUA,POMEGA,POMEGAA,PCG, & - PALBD,PALBP,PALBD_NEW,PALBP_NEW,& - PEMIS,PDT0,PVIEW,PPSOL,PDP, & - PTL,PPMB,PTAVE,PWV,PQS, & - zx_alpha1,zx_alpha2,POZON, & - tauaero,pizaero,cgaero, & - ztopsw_aero,ztopsw0_aero,zsolsw_aero,zsolsw0_aero, & - ztopswcf_aero,zsolswcf_aero,& - ztopswadaero,zsolswadaero,ztopswad0aero, & - zsolswad0aero,zsollwadaero,zsollwad0aero, & - ztopswaiaero,zsolswaiaero,ztoplwaiaero,zsollwaiaero) - - !=================================================================================================== - ! A. Idelkadi, mars 2026 : Recriture de l interface radlwsw_m.F90 entre LMDZ - ! et les codes radiatifs oldrad/rrtm/ecrad - ! -------------------------------------------------------------------------- - ! - Declarations => in / out (pas de variables locales) - ! - Appel de chaque interface avec le code radiatif pilote par iflag_rrtm - ! * iflag_rrtm = 0 => CALL lmdz_call_oldrad - ! * = 1 => CALL lmdz_call_rrtm - ! * = 2 => CALL lmdz_call_ecrad - ! lmdz_rad_ini_m.F90 : - ! - Declarations - ! - Initialisations : heat, cool, ... - ! - Calcul des champs input pour les codes radiatifs (albedo, meteo, ...) - ! A completer - ! -------------------------------------------------------------------------------------------- - - ! Modules necessaires - USE DIMPHY - USE assert_m, ONLY : assert - USE infotrac_phy, ONLY : type_trac, nbtr - USE write_field_phy - - USE lmdz_reprobus_wrappers, ONLY : solaireTIME, ok_SUNTIME, ndimozon, rad_interactif - USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_REPROBUS - USE phys_local_var_mod, ONLY : tr_seri - -#ifdef CPP_RRTM - ! modules necessaires au rayonnement - ! ----------------------------------------- - USE YOERAD , ONLY : NLW, LRRTM ,LCCNL ,LCCNO ,& - NRADIP , NRADLP , NICEOPT, NLIQOPT ,RCCNLND , RCCNSEA - USE YOELW , ONLY : NSIL ,NTRA ,NUA ,TSTAND ,XP - USE YOESW , ONLY : RYFWCA ,RYFWCB ,RYFWCC ,RYFWCD,& - RYFWCE ,RYFWCF ,REBCUA ,REBCUB ,REBCUC,& - REBCUD ,REBCUE ,REBCUF ,REBCUI ,REBCUJ,& - REBCUG ,REBCUH ,RHSAVI ,RFULIO ,RFLAA0,& - RFLAA1 ,RFLBB0 ,RFLBB1 ,RFLBB2 ,RFLBB3,& - RFLCC0 ,RFLCC1 ,RFLCC2 ,RFLCC3 ,RFLDD0,& - RFLDD1 ,RFLDD2 ,RFLDD3 ,RFUETA ,RASWCA,& - RASWCB ,RASWCC ,RASWCD ,RASWCE ,RASWCF - USE YOERDU , ONLY : NUAER ,NTRAER ,REPLOG ,REPSC ,REPSCW ,DIFF - USE YOERRTWN , ONLY : DELWAVE ,TOTPLNK - USE YOMPHY3 , ONLY : RII0 -#endif - - USE aero_mod - USE conf_phys_m, ONLY: ok_ade, ok_aie, ok_volcan, flag_volc_surfstrat, & - flag_aerosol, flag_aerosol_strat, flag_aer_feedback, & - iflag_rrtm - USE yomcst_mod_h - USE clesphys_mod_h - USE yoethf_mod_h - USE phys_constants_mod, ONLY: dobson_u - USE wxios_mod, ONLY: missing_val - - ! ============== - ! DECLARATIONS - ! ============== - - ! Input arguments - REAL, INTENT(in) :: dist - REAL, INTENT(in) :: rmu0(KLON), fract(KLON) - REAL, INTENT(in) :: paprs(KLON,KLEV+1), pplay(KLON,KLEV) - REAL, INTENT(in) :: tsol(KLON) - REAL, INTENT(in) :: alb_dir(KLON,NSW),alb_dif(KLON,NSW) - REAL, INTENT(in) :: SFRWL(6) - REAL, INTENT(in) :: t(KLON,KLEV), q(KLON,KLEV) - REAL, INTENT(in) :: wo(:, :, :) ! dimension(KLON,KLEV, 1 or 2) - ! column-density of ozone in a layer, in kilo-Dobsons - ! "wo(:, :, 1)" is for the average day-night field, - ! "wo(:, :, 2)" is for daylight time. - LOGICAL :: lldebug=.false. - REAL, INTENT(in) :: cldfra(KLON,KLEV), cldemi(KLON,KLEV), cldtaupd(KLON,KLEV) - REAL, INTENT(in) :: tau_aero(KLON,KLEV,naero_grp,2) ! aerosol optical properties (see aeropt.F) - REAL, INTENT(in) :: piz_aero(KLON,KLEV,naero_grp,2) ! aerosol optical properties (see aeropt.F) - REAL, INTENT(in) :: cg_aero(KLON,KLEV,naero_grp,2) ! aerosol optical properties (see aeropt.F) - REAL, INTENT(in) :: tau_aero_sw_rrtm(KLON,KLEV,2,NSW) ! aerosol optical properties RRTM - REAL, INTENT(in) :: piz_aero_sw_rrtm(KLON,KLEV,2,NSW) ! aerosol optical properties RRTM - REAL, INTENT(in) :: cg_aero_sw_rrtm(KLON,KLEV,2,NSW) ! aerosol optical properties RRTM - REAL, INTENT(in) :: cldtaupi(KLON,KLEV) ! cloud optical thickness for pre-industrial aerosol concentrations - REAL, INTENT(in) :: qsat(klon,klev) ! Variable pour iflag_rrtm=1 - REAL, INTENT(in) :: flwc(klon,klev) ! Variable pour iflag_rrtm=1 - REAL, INTENT(in) :: fiwc(klon,klev) ! Variable pour iflag_rrtm=1 - - ! Variables inout (initialisation) - REAL, INTENT(inout) :: heat(KLON,KLEV), cool(KLON,KLEV) - REAL, INTENT(inout) :: heat0(KLON,KLEV), cool0(KLON,KLEV) - REAL, INTENT(inout) :: heat_volc(KLON,KLEV), cool_volc(KLON,KLEV) !NL - REAL(KIND=8), INTENT(inout) :: zheat(kdlon,kflev), zcool(kdlon,kflev) - REAL(KIND=8), INTENT(inout) :: zheat0(kdlon,kflev), zcool0(kdlon,kflev) - REAL(KIND=8), INTENT(inout) :: zheat_volc(kdlon,kflev), zcool_volc(kdlon,kflev) !NL - ! - REAL(KIND=8), INTENT(inout) :: ztopswadaero(kdlon), zsolswadaero(kdlon), & ! Aerosol direct forcing at TOAand surface - zsollwadaero(kdlon) - REAL(KIND=8), INTENT(inout) :: ztopswad0aero(kdlon), zsolswad0aero(kdlon), & ! Aerosol direct forcing at TOAand surface - zsollwad0aero(kdlon) - REAL(KIND=8), INTENT(inout) :: ztopswaiaero(kdlon), zsolswaiaero(kdlon), & ! dito, indirect - ztoplwaiaero(kdlon), zsollwaiaero(kdlon) - REAL(KIND=8), INTENT(inout) :: ztopsw_aero(kdlon,9), ztopsw0_aero(kdlon,9) - REAL(KIND=8), INTENT(inout) :: zsolsw_aero(kdlon,9), zsolsw0_aero(kdlon,9) - REAL(KIND=8), INTENT(inout) :: ztopswcf_aero(kdlon,3), zsolswcf_aero(kdlon,3) - - ! Variables out - INTEGER, INTENT(out) :: iof - REAL(KIND=8), INTENT(out) :: PSCT - REAL(KIND=8), INTENT(out) :: PALBD(kdlon,2), PALBP(kdlon,2) - ! MPL 06.01.09: pour RRTM, creation de PALBD_NEW et PALBP_NEW - ! avec NSW en deuxieme dimension - REAL(KIND=8), INTENT(out) :: PALBD_NEW(kdlon,NSW), PALBP_NEW(kdlon,NSW) - REAL(KIND=8), INTENT(out) :: PEMIS(kdlon), PDT0(kdlon), PVIEW(kdlon) - REAL(KIND=8), INTENT(out) :: PPSOL(kdlon), PDP(kdlon,KLEV) - REAL(KIND=8), INTENT(out) :: PTL(kdlon,kflev+1), PPMB(kdlon,kflev+1) - REAL(KIND=8), INTENT(out) :: PTAVE(kdlon,kflev) - REAL(KIND=8), INTENT(out) :: PWV(kdlon,kflev), PQS(kdlon,kflev) - REAL(kind=8), INTENT(out) :: POZON(kdlon, kflev, size(wo, 3)) ! mass fraction of ozone - ! "POZON(:, :, 1)" is for the average day-night field, - ! "POZON(:, :, 2)" is for daylight time. - ! Modif MPL 6.01.09 avec RRTM, on passe de 5 a 6 - REAL(KIND=8), INTENT(out) :: PAER(kdlon,kflev,6) - REAL(KIND=8), INTENT(out) :: PCLDLD(kdlon,kflev) - REAL(KIND=8), INTENT(out) :: PCLDLU(kdlon,kflev) - REAL(KIND=8), INTENT(out) :: PCLDSW(kdlon,kflev) - REAL(KIND=8), INTENT(out) :: PTAU(kdlon,2,kflev) - REAL(KIND=8), INTENT(out) :: POMEGA(kdlon,2,kflev) - REAL(KIND=8), INTENT(out) :: PCG(kdlon,2,kflev) - REAL(KIND=8), INTENT(out) :: zfract(kdlon), zrmu0(kdlon), zdist - REAL(KIND=8), INTENT(out) :: tauaero(kdlon,kflev,naero_grp,2) ! aer opt properties - REAL(KIND=8), INTENT(out) :: pizaero(kdlon,kflev,naero_grp,2) - REAL(KIND=8), INTENT(out) :: cgaero(kdlon,kflev,naero_grp,2) - REAL(KIND=8), INTENT(out) :: PTAUA(kdlon,2,kflev) ! present-day value of cloud opt thickness (PTAU is pre-industrial value), local use - REAL(KIND=8), INTENT(out) :: POMEGAA(kdlon,2,kflev) ! dito for single scatt albedo - INTEGER, INTENT(out) :: ist,iend,ktdia,kmode - - ! Local variables - INTEGER :: dimoz - REAL(KIND=8) zx_alpha1, zx_alpha2 - INTEGER k, kk, i, j, l, nb_gr,jb !FC - - dimoz=size(wo,3) - - ! ========= INITIALISATIONS ============================================== - IF (lldebug) THEN - print*,'Entree dans radlwsw ' - print*,'************* INITIALISATIONS *****************************' - print*,'klon, kdlon, klev, kflev =',klon, kdlon, klev, kflev - print*,'size(wo, 1) , klon, size(wo, 2), klev ', & - size(wo, 1) , klon, size(wo, 2), klev - - ENDIF - - CALL assert(size(wo, 1) == klon, size(wo, 2) == klev, "radlwsw wo") - - ist=1 - iend=klon - ktdia=1 - kmode=ist - ! Aeros - tauaero(:,:,:,:)=0. - pizaero(:,:,:,:)=0. - cgaero(:,:,:,:)=0. - ! lldebug=.FALSE. - - ztopsw_aero(:,:) = 0. !ym missing init : warning : not initialized in SW_AEROAR4 - ztopsw0_aero(:,:) = 0. !ym missing init : warning : not initialized in SW_AEROAR4 - zsolsw_aero(:,:) = 0. !ym missing init : warning : not initialized in SW_AEROAR4 - zsolsw0_aero(:,:) = 0. !ym missing init : warning : not initialized in SW_AEROAR4 - - ! Direct effect aero - ztopswadaero(:) = 0. !ym missing init - zsolswadaero(:) = 0. !ym missing init - zsollwadaero(:) = 0. !ym missing init - ztopswad0aero(:) = 0. !ym missing init - zsolswad0aero(:) = 0. !ym missing init - zsollwad0aero(:) = 0. !ym missing init - ! Indirect effect aero - ztopswaiaero(:) = 0. !ym missing init - zsolswaiaero(:) = 0. !ym missing init - ztoplwaiaero(:) = 0. !ym missing init - zsollwaiaero(:) = 0. !ym missing init - ! - ztopswcf_aero(:,:)= 0.!ym missing init - zsolswcf_aero(:,:)= 0. !ym missing init - - !------------------------------------------- - nb_gr = KLON / kdlon - IF (nb_gr*kdlon .NE. KLON) THEN - PRINT*, "kdlon mauvais:", KLON, kdlon, nb_gr - call abort_physic("radlwsw", "", 1) - ENDIF - IF (kflev .NE. KLEV) THEN - PRINT*, "kflev differe de KLEV, kflev, KLEV" - call abort_physic("radlwsw", "", 1) - ENDIF - !------------------------------------------- - DO k = 1, KLEV - DO i = 1, KLON - heat(i,k)=0. - cool(i,k)=0. - heat_volc(i,k)=0. !NL - cool_volc(i,k)=0. !NL - heat0(i,k)=0. - cool0(i,k)=0. - ENDDO - ENDDO - ! - zdist = dist - ! - PSCT = solaire/zdist/zdist - - IF (type_trac == 'repr') THEN - IF (CPPKEY_REPROBUS) THEN - IF (iflag_rrtm==0) THEN - IF (ok_SUNTIME) PSCT = solaireTIME/zdist/zdist - print*,'Constante solaire: ',PSCT*zdist*zdist - ENDIF - END IF - ENDIF - - IF (lldebug) THEN - print*,'************** Debut boucle de 1 a ', nb_gr - ENDIF - - !DO j = 1, nb_gr - j = 1 - iof = kdlon*(j-1) - DO i = 1, kdlon - zfract(i) = fract(iof+i) - zrmu0(i) = rmu0(iof+i) - ENDDO - - IF (iflag_rrtm==0) THEN - DO i = 1, kdlon - - ! Albedo - PALBD(i,1)=alb_dif(iof+i,1) - PALBD(i,2)=alb_dif(iof+i,2) - PALBP(i,1)=alb_dir(iof+i,1) - PALBP(i,2)=alb_dir(iof+i,2) - ! AI 02.2021 cas iflag_rrtm=1 et 2 - ENDDO - - ELSEIF (iflag_rrtm==1.OR.iflag_rrtm==2) THEN - DO kk=1,NSW - DO i = 1, kdlon - - PALBD_NEW(i,kk)=alb_dif(iof+i,kk) - PALBP_NEW(i,kk)=alb_dir(iof+i,kk) - ENDDO - ENDDO - - ! - ENDIF - !albedo SB <<< - DO i = 1, kdlon - PEMIS(i) = 1.0 ! A REVOIR (MPL) - PVIEW(i) = 1.66 - PPSOL(i) = paprs(iof+i,1) - zx_alpha1 = (paprs(iof+i,1)-pplay(iof+i,2))/(pplay(iof+i,1)-pplay(iof+i,2)) - zx_alpha2 = 1.0 - zx_alpha1 - PTL(i,1) = t(iof+i,1) * zx_alpha1 + t(iof+i,2) * zx_alpha2 - PTL(i,KLEV+1) = t(iof+i,KLEV) - PDT0(i) = tsol(iof+i) - PTL(i,1) - ENDDO - - DO k = 2, kflev - DO i = 1, kdlon - PTL(i,k) = (t(iof+i,k)+t(iof+i,k-1))*0.5 - ENDDO - ENDDO - - ! Confert from column density of ozone in a cell, in kDU, to a mass fraction - DO l=1, dimoz - DO k = 1, kflev - DO i = 1, kdlon - POZON(i,k, l) = wo(iof+i, k, l) * RG * dobson_u * 1e3 & - / (paprs(iof+i, k) - paprs(iof+i, k+1)) - ! A activer pour CCMVAL on prend l'ozone impose (MPL 07042010) - ! POZON(i,k,:) = wo(i,k,:) - ! print *,'RADLWSW: POZON',k, POZON(i,k,1) - ENDDO - ENDDO - ENDDO - - DO k = 1, kflev - DO i = 1, kdlon - PDP(i,k) = paprs(iof+i,k)-paprs(iof+i,k+1) - PTAVE(i,k) = t(iof+i,k) - PWV(i,k) = MAX (q(iof+i,k), 1.0e-12) - PQS(i,k) = PWV(i,k) - PCLDLD(i,k) = cldfra(iof+i,k)*cldemi(iof+i,k) - PCLDLU(i,k) = cldfra(iof+i,k)*cldemi(iof+i,k) - PCLDSW(i,k) = cldfra(iof+i,k) - PTAU(i,1,k) = MAX(cldtaupi(iof+i,k), 1.0e-05)! 1e-12 serait instable - PTAU(i,2,k) = MAX(cldtaupi(iof+i,k), 1.0e-05)! pour 32-bit machines - POMEGA(i,1,k) = 0.9999 - 5.0e-04 * EXP(-0.5 * PTAU(i,1,k)) - POMEGA(i,2,k) = 0.9988 - 2.5e-03 * EXP(-0.05 * PTAU(i,2,k)) - PCG(i,1,k) = 0.865 - PCG(i,2,k) = 0.910 - !- - ! Introduced for aerosol indirect forcings. - ! The following values use the cloud optical thickness calculated from - ! present-day aerosol concentrations whereas the quantities without the - ! "A" at the end are for pre-industial (natural-only) aerosol concentrations - ! - PTAUA(i,1,k) = MAX(cldtaupd(iof+i,k), 1.0e-05)! 1e-12 serait instable - PTAUA(i,2,k) = MAX(cldtaupd(iof+i,k), 1.0e-05)! pour 32-bit machines - POMEGAA(i,1,k) = 0.9999 - 5.0e-04 * EXP(-0.5 * PTAUA(i,1,k)) - POMEGAA(i,2,k) = 0.9988 - 2.5e-03 * EXP(-0.05 * PTAUA(i,2,k)) - ENDDO - ENDDO - - IF (type_trac == 'repr') THEN - IF (CPPKEY_REPROBUS) THEN - ndimozon = size(wo, 3) - CALL RAD_INTERACTIF(POZON,iof,tr_seri,nbtr) - END IF - ENDIF - ! - DO k = 1, kflev+1 - DO i = 1, kdlon - PPMB(i,k) = paprs(iof+i,k)/100.0 - ENDDO - ENDDO - ! - ! Modif MPL 6.01.09 avec RRTM, on passe de 5 a 6 - DO kk = 1, 6 - DO k = 1, kflev - DO i = 1, kdlon - PAER(i,k,kk) = 1.0E-15 ! A REVOIR (MPL) - ENDDO - ENDDO - ENDDO - - DO l=1,naero_grp - DO k = 1, kflev - DO i = 1, kdlon - tauaero(i,k,l,1)=tau_aero(iof+i,k,l,1) - pizaero(i,k,l,1)=piz_aero(iof+i,k,l,1) - cgaero(i,k,l,1) =cg_aero(iof+i,k,l,1) - tauaero(i,k,l,2)=tau_aero(iof+i,k,l,2) - pizaero(i,k,l,2)=piz_aero(iof+i,k,l,2) - cgaero(i,k,l,2) =cg_aero(iof+i,k,l,2) - ENDDO - ENDDO - ENDDO - ! - END SUBROUTINE lmdz_rad_ini -END MODULE lmdz_rad_ini_m Index: DZ6/trunk/libf/phylmd/lmdz_rad_out_m.F90 =================================================================== --- /LMDZ6/trunk/libf/phylmd/lmdz_rad_out_m.F90 (revision 6180) +++ (revision ) @@ -1,244 +1,0 @@ -! -! $Id: radlwsw_m.F90 6127 2026-03-26 13:59:25Z idelkadi $ -! -MODULE lmdz_rad_out_m - IMPLICIT NONE -CONTAINS - - SUBROUTINE lmdz_rad_out( & - iof,PWV, & - ZFSUP,ZFSDN,ZFSUP0,ZFSDN0, & - ZFSUPC0,ZFSDNC0,ZFLUP,ZFLDN, & - ZFLUP0,ZFLDN0,ZFLUPC0,ZFLDNC0, & - zheat,zcool,zheat0,zcool0,zheat_volc,zcool_volc, & - ztopsw,ztoplw,zsolsw,zsollw,zalbpla,zsolswfdiff, & - zsollwdown,ztopsw0,ztoplw0,zsolsw0,zsollw0, & - ztopswadaero,zsolswadaero,ztopswad0aero,zsolswad0aero, & - ztopswaiaero,zsolswaiaero,ztoplwadaero,zsollwadaero, & - ztoplwad0aero,zsollwad0aero,ztoplwaiaero,zsollwaiaero, & - ztopsw_aero,ztopsw0_aero,zsolsw_aero,zsolsw0_aero, & - ztopswcf_aero,zsolswcf_aero, & - heat,heat0,cool,cool0,albpla,heat_volc, cool_volc,& - topsw,toplw,solsw,solswfdiff,sollw,sollwdown,& - topsw0,toplw0,solsw0,sollw0,& - lwdnc0,lwdn0,lwdn,lwupc0,lwup0,lwup,& - swdnc0,swdn0,swdn,swupc0,swup0,swup,& - topswad_aero,solswad_aero,topswai_aero,solswai_aero, & - topswad0_aero,solswad0_aero,topsw_aero,topsw0_aero,& - solsw_aero,solsw0_aero,topswcf_aero,solswcf_aero,& - toplwad_aero,sollwad_aero,toplwai_aero,sollwai_aero, & - toplwad0_aero,sollwad0_aero, & - cloud_cover_sw,ZFLUX_DIR,ZFLUX_DIR_CLEAR,ZFLUX_DIR_INTO_SUN) - - !================================================================================================== - ! A. Idelkadi, mars 2026 : - ! Recriture de l interface radlwsw_m.F90 entre LMDZ - ! et les codes radiatifs oldrad/rrtm/ecrad - ! - ! lmdz_rad_out_m.F90 : calcul des flux radiatif pour les sorties LMDZ (commun aux 3 codes rad) - ! -------------------------------------------------------------------------------------------------- - - ! Modules necessaires - USE DIMPHY - USE yoethf_mod_h - USE aero_mod - USE conf_phys_m, ONLY: ok_ade, ok_aie, ok_volcan, iflag_rrtm - USE wxios_mod, ONLY: missing_val - ! ==================================================================== - - ! ============== - ! DECLARATIONS - ! ============== - - ! Input arguments - INTEGER, INTENT(in) :: iof - REAL(KIND=8), INTENT(in) :: PWV(kdlon,kflev) - REAL(KIND=8), INTENT(in) :: ZFSUP(KDLON,KFLEV+1) - REAL(KIND=8), INTENT(in) :: ZFSDN(KDLON,KFLEV+1) - REAL(KIND=8), INTENT(in) :: ZFSUP0(KDLON,KFLEV+1) - REAL(KIND=8), INTENT(in) :: ZFSDN0(KDLON,KFLEV+1) - REAL(KIND=8), INTENT(in) :: ZFSUPC0(KDLON,KFLEV+1) - REAL(KIND=8), INTENT(in) :: ZFSDNC0(KDLON,KFLEV+1) - REAL(KIND=8), INTENT(in) :: ZFLUP(KDLON,KFLEV+1) - REAL(KIND=8), INTENT(in) :: ZFLDN(KDLON,KFLEV+1) - REAL(KIND=8), INTENT(in) :: ZFLUP0(KDLON,KFLEV+1) - REAL(KIND=8), INTENT(in) :: ZFLDN0(KDLON,KFLEV+1) - REAL(KIND=8), INTENT(in) :: ZFLUPC0(KDLON,KFLEV+1) - REAL(KIND=8), INTENT(in) :: ZFLDNC0(KDLON,KFLEV+1) - REAL(KIND=8), INTENT(in) :: zheat(kdlon,kflev), zcool(kdlon,kflev) - REAL(KIND=8), INTENT(in) :: zheat0(kdlon,kflev), zcool0(kdlon,kflev) - REAL(KIND=8), INTENT(in) :: zheat_volc(kdlon,kflev), zcool_volc(kdlon,kflev) !NL - REAL(KIND=8), INTENT(in) :: ztopsw(kdlon), ztoplw(kdlon) - REAL(KIND=8), INTENT(in) :: zsolsw(kdlon), zsollw(kdlon), zalbpla(kdlon), zsolswfdiff(kdlon) - REAL(KIND=8), INTENT(in) ::zsollwdown(kdlon) - REAL(KIND=8), INTENT(in) :: ztopsw0(kdlon), ztoplw0(kdlon) - REAL(KIND=8), INTENT(in) :: zsolsw0(kdlon), zsollw0(kdlon) - REAL(KIND=8), INTENT(in) :: ztopswadaero(kdlon), zsolswadaero(kdlon) ! Aerosol direct forcing at TOAand surface - REAL(KIND=8), INTENT(in) :: ztopswad0aero(kdlon), zsolswad0aero(kdlon) ! Aerosol direct forcing at TOAand surface - REAL(KIND=8), INTENT(in) :: ztopswaiaero(kdlon), zsolswaiaero(kdlon) ! dito, indirect - REAL(KIND=8), INTENT(in) :: ztoplwadaero(kdlon), zsollwadaero(kdlon) ! LW Aerosol direct forcing at TOAand surface - REAL(KIND=8), INTENT(in) :: ztoplwad0aero(kdlon), zsollwad0aero(kdlon) ! LW Aerosol direct forcing at TOAand surface - REAL(KIND=8), INTENT(in) :: ztoplwaiaero(kdlon), zsollwaiaero(kdlon) ! dito, indirect - REAL(KIND=8), INTENT(in) :: ztopsw_aero(kdlon,9), ztopsw0_aero(kdlon,9) - REAL(KIND=8), INTENT(in) :: zsolsw_aero(kdlon,9), zsolsw0_aero(kdlon,9) - REAL(KIND=8), INTENT(in) :: ztopswcf_aero(kdlon,3), zsolswcf_aero(kdlon,3) - - ! Output arguments - REAL, INTENT(out) :: heat(KLON,KLEV), cool(KLON,KLEV) - REAL, INTENT(out) :: heat0(KLON,KLEV), cool0(KLON,KLEV) - REAL, INTENT(out) :: heat_volc(KLON,KLEV), cool_volc(KLON,KLEV) !NL - REAL, INTENT(out) :: topsw(KLON), toplw(KLON) - REAL, INTENT(out) :: solsw(KLON), sollw(KLON), solswfdiff(KLON) - REAL, INTENT(out) :: topsw0(KLON), toplw0(KLON), solsw0(KLON), sollw0(KLON) - REAL, INTENT(out) :: sollwdown(KLON) - REAL, INTENT(out) :: swdn(KLON,kflev+1),swdn0(KLON,kflev+1), swdnc0(KLON,kflev+1) - REAL, INTENT(out) :: swup(KLON,kflev+1),swup0(KLON,kflev+1), swupc0(KLON,kflev+1) - REAL, INTENT(out) :: lwdn(KLON,kflev+1),lwdn0(KLON,kflev+1), lwdnc0(KLON,kflev+1) - REAL, INTENT(out) :: lwup(KLON,kflev+1),lwup0(KLON,kflev+1), lwupc0(KLON,kflev+1) - REAL, INTENT(out) :: topswad_aero(KLON), solswad_aero(KLON) ! output: aerosol direct forcing at TOA and surface - REAL, INTENT(out) :: topswai_aero(KLON), solswai_aero(KLON) ! output: aerosol indirect forcing atTOA and surface - REAL, INTENT(out) :: toplwad_aero(KLON), sollwad_aero(KLON) ! output: LW aerosol direct forcing at TOA and surface - REAL, INTENT(out) :: toplwai_aero(KLON), sollwai_aero(KLON) ! output: LW aerosol indirect forcing atTOA and surface - REAL, DIMENSION(klon), INTENT(out) :: topswad0_aero - REAL, DIMENSION(klon), INTENT(out) :: solswad0_aero - REAL, DIMENSION(klon), INTENT(out) :: toplwad0_aero - REAL, DIMENSION(klon), INTENT(out) :: sollwad0_aero - REAL, DIMENSION(kdlon,9), INTENT(out) :: topsw_aero - REAL, DIMENSION(kdlon,9), INTENT(out) :: topsw0_aero - REAL, DIMENSION(kdlon,9), INTENT(out) :: solsw_aero - REAL, DIMENSION(kdlon,9), INTENT(out) :: solsw0_aero - REAL, DIMENSION(kdlon,3), INTENT(out) :: topswcf_aero - REAL, DIMENSION(kdlon,3), INTENT(out) :: solswcf_aero - REAL, INTENT(out) :: albpla(KLON) - !Ecrad : - REAL(KIND=8), INTENT(out) :: cloud_cover_sw(klon), & ! SW cloud cover issued from Rcrad - ZFLUX_DIR(klon,klev+1), & ! Direct compt of surf flux into horizontal plane - ZFLUX_DIR_CLEAR(klon,klev+1), & ! CS Direct - ZFLUX_DIR_INTO_SUN(klon) - - ! Local variables - INTEGER k, i - REAL(KIND=8) zznormcp - - ! ----- flux radiatifs => sorties --------------------------------- - DO i = 1, kdlon - topsw(iof+i) = ztopsw(i) - toplw(iof+i) = ztoplw(i) - solsw(iof+i) = zsolsw(i) - solswfdiff(iof+i) = zsolswfdiff(i) - sollw(iof+i) = zsollw(i) - sollwdown(iof+i) = zsollwdown(i) - ENDDO - - DO k = 1, kflev+1 - DO i = 1, kdlon - lwdn0 ( iof+i,k) = ZFLDN0 ( i,k) - lwdn ( iof+i,k) = ZFLDN ( i,k) - lwup0 ( iof+i,k) = ZFLUP0 ( i,k) - lwup ( iof+i,k) = ZFLUP ( i,k) - ENDDO - ENDDO - - DO i = 1, kdlon - topsw0(iof+i) = ztopsw0(i) - toplw0(iof+i) = ztoplw0(i) - solsw0(iof+i) = zsolsw0(i) - sollw0(iof+i) = zsollw0(i) - albpla(iof+i) = zalbpla(i) - ENDDO - - DO k = 1, kflev+1 - DO i = 1, kdlon - swdnc0( iof+i,k) = ZFSDNC0( i,k) - swdn0 ( iof+i,k) = ZFSDN0 ( i,k) - swdn ( iof+i,k) = ZFSDN ( i,k) - swupc0( iof+i,k) = ZFSUPC0( i,k) - swup0 ( iof+i,k) = ZFSUP0 ( i,k) - swup ( iof+i,k) = ZFSUP ( i,k) - lwdnc0( iof+i,k) = ZFLDNC0( i,k) - lwupc0( iof+i,k) = ZFLUPC0( i,k) - ENDDO - ENDDO - !-transform the aerosol forcings, if they have - ! to be calculated - IF (ok_ade) THEN - DO i = 1, kdlon - topswad_aero(iof+i) = ztopswadaero(i) - topswad0_aero(iof+i) = ztopswad0aero(i) - solswad_aero(iof+i) = zsolswadaero(i) - solswad0_aero(iof+i) = zsolswad0aero(i) - ENDDO - - topsw_aero(:,:) = ztopsw_aero(:,:) - topsw0_aero(:,:) = ztopsw0_aero(:,:) - solsw_aero(:,:) = zsolsw_aero(:,:) - solsw0_aero(:,:) = zsolsw0_aero(:,:) - topswcf_aero(:,:) = ztopswcf_aero(:,:) - solswcf_aero(:,:) = zsolswcf_aero(:,:) - !-LW - DO i = 1, kdlon - toplwad_aero(iof+i) = ztoplwadaero(i) - toplwad0_aero(iof+i) = ztoplwad0aero(i) - sollwad_aero(iof+i) = zsollwadaero(i) - sollwad0_aero(iof+i) = zsollwad0aero(i) - ENDDO - ELSE - DO i = 1, kdlon - topswad_aero(iof+i) = 0.0 - solswad_aero(iof+i) = 0.0 - topswad0_aero(iof+i) = 0.0 - solswad0_aero(iof+i) = 0.0 - ENDDO - topsw_aero(:,:) = 0. - topsw0_aero(:,:) =0. - solsw_aero(:,:) = 0. - solsw0_aero(:,:) = 0. - !-LW - DO i = 1, kdlon - toplwad_aero(iof+i) = 0.0 - sollwad_aero(iof+i) = 0.0 - toplwad0_aero(iof+i) = 0.0 - sollwad0_aero(iof+i) = 0.0 - ENDDO - ENDIF - IF (ok_aie) THEN - DO i = 1, kdlon - topswai_aero(iof+i) = ztopswaiaero(i) - solswai_aero(iof+i) = zsolswaiaero(i) - !-LW - toplwai_aero(iof+i) = ztoplwaiaero(i) - sollwai_aero(iof+i) = zsollwaiaero(i) - ENDDO - ELSE - DO i = 1, kdlon - topswai_aero(iof+i) = 0.0 - solswai_aero(iof+i) = 0.0 - !-LW - toplwai_aero(iof+i) = 0.0 - sollwai_aero(iof+i) = 0.0 - ENDDO - ENDIF - DO k = 1, kflev - DO i = 1, kdlon - ! scale factor to take into account the difference between - ! dry air and watter vapour scpecifi! heat capacity - zznormcp=1.0+RVTMP2*PWV(i,k) - heat(iof+i,k) = zheat(i,k)/zznormcp - cool(iof+i,k) = zcool(i,k)/zznormcp - heat0(iof+i,k) = zheat0(i,k)/zznormcp - cool0(iof+i,k) = zcool0(i,k)/zznormcp - IF(ok_volcan) THEN !NL - heat_volc(iof+i,k) = zheat_volc(i,k)/zznormcp - cool_volc(iof+i,k) = zcool_volc(i,k)/zznormcp - ENDIF - ENDDO - ENDDO - IF (iflag_rrtm.ne.2) THEN - cloud_cover_sw(:) = missing_val - ZFLUX_DIR(:,:) = missing_val - ZFLUX_DIR_CLEAR(:,:) = missing_val - ZFLUX_DIR_INTO_SUN = missing_val - END IF - - END SUBROUTINE lmdz_rad_out -END MODULE lmdz_rad_out_m Index: /LMDZ6/trunk/libf/phylmd/lmdz_radiation_post.F90 =================================================================== --- /LMDZ6/trunk/libf/phylmd/lmdz_radiation_post.F90 (revision 6181) +++ /LMDZ6/trunk/libf/phylmd/lmdz_radiation_post.F90 (revision 6181) @@ -0,0 +1,244 @@ +! +! $Id: radlwsw_m.F90 6127 2026-03-26 13:59:25Z idelkadi $ +! +MODULE lmdz_radiation_post + IMPLICIT NONE +CONTAINS + + SUBROUTINE radiation_post( & + iof,PWV, & + ZFSUP,ZFSDN,ZFSUP0,ZFSDN0, & + ZFSUPC0,ZFSDNC0,ZFLUP,ZFLDN, & + ZFLUP0,ZFLDN0,ZFLUPC0,ZFLDNC0, & + zheat,zcool,zheat0,zcool0,zheat_volc,zcool_volc, & + ztopsw,ztoplw,zsolsw,zsollw,zalbpla,zsolswfdiff, & + zsollwdown,ztopsw0,ztoplw0,zsolsw0,zsollw0, & + ztopswadaero,zsolswadaero,ztopswad0aero,zsolswad0aero, & + ztopswaiaero,zsolswaiaero,ztoplwadaero,zsollwadaero, & + ztoplwad0aero,zsollwad0aero,ztoplwaiaero,zsollwaiaero, & + ztopsw_aero,ztopsw0_aero,zsolsw_aero,zsolsw0_aero, & + ztopswcf_aero,zsolswcf_aero, & + heat,heat0,cool,cool0,albpla,heat_volc, cool_volc,& + topsw,toplw,solsw,solswfdiff,sollw,sollwdown,& + topsw0,toplw0,solsw0,sollw0,& + lwdnc0,lwdn0,lwdn,lwupc0,lwup0,lwup,& + swdnc0,swdn0,swdn,swupc0,swup0,swup,& + topswad_aero,solswad_aero,topswai_aero,solswai_aero, & + topswad0_aero,solswad0_aero,topsw_aero,topsw0_aero,& + solsw_aero,solsw0_aero,topswcf_aero,solswcf_aero,& + toplwad_aero,sollwad_aero,toplwai_aero,sollwai_aero, & + toplwad0_aero,sollwad0_aero, & + cloud_cover_sw,ZFLUX_DIR,ZFLUX_DIR_CLEAR,ZFLUX_DIR_INTO_SUN) + + !================================================================================================== + ! A. Idelkadi, mars 2026 : + ! Recriture de l interface radlwsw_m.F90 entre LMDZ + ! et les codes radiatifs oldrad/rrtm/ecrad + ! + ! lmdz_rad_out_m.F90 : calcul des flux radiatif pour les sorties LMDZ (commun aux 3 codes rad) + ! -------------------------------------------------------------------------------------------------- + + ! Modules necessaires + USE DIMPHY + USE yoethf_mod_h + USE aero_mod + USE conf_phys_m, ONLY: ok_ade, ok_aie, ok_volcan, iflag_rrtm + USE wxios_mod, ONLY: missing_val + ! ==================================================================== + + ! ============== + ! DECLARATIONS + ! ============== + + ! Input arguments + INTEGER, INTENT(in) :: iof + REAL(KIND=8), INTENT(in) :: PWV(kdlon,kflev) + REAL(KIND=8), INTENT(in) :: ZFSUP(KDLON,KFLEV+1) + REAL(KIND=8), INTENT(in) :: ZFSDN(KDLON,KFLEV+1) + REAL(KIND=8), INTENT(in) :: ZFSUP0(KDLON,KFLEV+1) + REAL(KIND=8), INTENT(in) :: ZFSDN0(KDLON,KFLEV+1) + REAL(KIND=8), INTENT(in) :: ZFSUPC0(KDLON,KFLEV+1) + REAL(KIND=8), INTENT(in) :: ZFSDNC0(KDLON,KFLEV+1) + REAL(KIND=8), INTENT(in) :: ZFLUP(KDLON,KFLEV+1) + REAL(KIND=8), INTENT(in) :: ZFLDN(KDLON,KFLEV+1) + REAL(KIND=8), INTENT(in) :: ZFLUP0(KDLON,KFLEV+1) + REAL(KIND=8), INTENT(in) :: ZFLDN0(KDLON,KFLEV+1) + REAL(KIND=8), INTENT(in) :: ZFLUPC0(KDLON,KFLEV+1) + REAL(KIND=8), INTENT(in) :: ZFLDNC0(KDLON,KFLEV+1) + REAL(KIND=8), INTENT(in) :: zheat(kdlon,kflev), zcool(kdlon,kflev) + REAL(KIND=8), INTENT(in) :: zheat0(kdlon,kflev), zcool0(kdlon,kflev) + REAL(KIND=8), INTENT(in) :: zheat_volc(kdlon,kflev), zcool_volc(kdlon,kflev) !NL + REAL(KIND=8), INTENT(in) :: ztopsw(kdlon), ztoplw(kdlon) + REAL(KIND=8), INTENT(in) :: zsolsw(kdlon), zsollw(kdlon), zalbpla(kdlon), zsolswfdiff(kdlon) + REAL(KIND=8), INTENT(in) ::zsollwdown(kdlon) + REAL(KIND=8), INTENT(in) :: ztopsw0(kdlon), ztoplw0(kdlon) + REAL(KIND=8), INTENT(in) :: zsolsw0(kdlon), zsollw0(kdlon) + REAL(KIND=8), INTENT(in) :: ztopswadaero(kdlon), zsolswadaero(kdlon) ! Aerosol direct forcing at TOAand surface + REAL(KIND=8), INTENT(in) :: ztopswad0aero(kdlon), zsolswad0aero(kdlon) ! Aerosol direct forcing at TOAand surface + REAL(KIND=8), INTENT(in) :: ztopswaiaero(kdlon), zsolswaiaero(kdlon) ! dito, indirect + REAL(KIND=8), INTENT(in) :: ztoplwadaero(kdlon), zsollwadaero(kdlon) ! LW Aerosol direct forcing at TOAand surface + REAL(KIND=8), INTENT(in) :: ztoplwad0aero(kdlon), zsollwad0aero(kdlon) ! LW Aerosol direct forcing at TOAand surface + REAL(KIND=8), INTENT(in) :: ztoplwaiaero(kdlon), zsollwaiaero(kdlon) ! dito, indirect + REAL(KIND=8), INTENT(in) :: ztopsw_aero(kdlon,9), ztopsw0_aero(kdlon,9) + REAL(KIND=8), INTENT(in) :: zsolsw_aero(kdlon,9), zsolsw0_aero(kdlon,9) + REAL(KIND=8), INTENT(in) :: ztopswcf_aero(kdlon,3), zsolswcf_aero(kdlon,3) + + ! Output arguments + REAL, INTENT(out) :: heat(KLON,KLEV), cool(KLON,KLEV) + REAL, INTENT(out) :: heat0(KLON,KLEV), cool0(KLON,KLEV) + REAL, INTENT(out) :: heat_volc(KLON,KLEV), cool_volc(KLON,KLEV) !NL + REAL, INTENT(out) :: topsw(KLON), toplw(KLON) + REAL, INTENT(out) :: solsw(KLON), sollw(KLON), solswfdiff(KLON) + REAL, INTENT(out) :: topsw0(KLON), toplw0(KLON), solsw0(KLON), sollw0(KLON) + REAL, INTENT(out) :: sollwdown(KLON) + REAL, INTENT(out) :: swdn(KLON,kflev+1),swdn0(KLON,kflev+1), swdnc0(KLON,kflev+1) + REAL, INTENT(out) :: swup(KLON,kflev+1),swup0(KLON,kflev+1), swupc0(KLON,kflev+1) + REAL, INTENT(out) :: lwdn(KLON,kflev+1),lwdn0(KLON,kflev+1), lwdnc0(KLON,kflev+1) + REAL, INTENT(out) :: lwup(KLON,kflev+1),lwup0(KLON,kflev+1), lwupc0(KLON,kflev+1) + REAL, INTENT(out) :: topswad_aero(KLON), solswad_aero(KLON) ! output: aerosol direct forcing at TOA and surface + REAL, INTENT(out) :: topswai_aero(KLON), solswai_aero(KLON) ! output: aerosol indirect forcing atTOA and surface + REAL, INTENT(out) :: toplwad_aero(KLON), sollwad_aero(KLON) ! output: LW aerosol direct forcing at TOA and surface + REAL, INTENT(out) :: toplwai_aero(KLON), sollwai_aero(KLON) ! output: LW aerosol indirect forcing atTOA and surface + REAL, DIMENSION(klon), INTENT(out) :: topswad0_aero + REAL, DIMENSION(klon), INTENT(out) :: solswad0_aero + REAL, DIMENSION(klon), INTENT(out) :: toplwad0_aero + REAL, DIMENSION(klon), INTENT(out) :: sollwad0_aero + REAL, DIMENSION(kdlon,9), INTENT(out) :: topsw_aero + REAL, DIMENSION(kdlon,9), INTENT(out) :: topsw0_aero + REAL, DIMENSION(kdlon,9), INTENT(out) :: solsw_aero + REAL, DIMENSION(kdlon,9), INTENT(out) :: solsw0_aero + REAL, DIMENSION(kdlon,3), INTENT(out) :: topswcf_aero + REAL, DIMENSION(kdlon,3), INTENT(out) :: solswcf_aero + REAL, INTENT(out) :: albpla(KLON) + !Ecrad : + REAL(KIND=8), INTENT(out) :: cloud_cover_sw(klon), & ! SW cloud cover issued from Rcrad + ZFLUX_DIR(klon,klev+1), & ! Direct compt of surf flux into horizontal plane + ZFLUX_DIR_CLEAR(klon,klev+1), & ! CS Direct + ZFLUX_DIR_INTO_SUN(klon) + + ! Local variables + INTEGER k, i + REAL(KIND=8) zznormcp + + ! ----- flux radiatifs => sorties --------------------------------- + DO i = 1, kdlon + topsw(iof+i) = ztopsw(i) + toplw(iof+i) = ztoplw(i) + solsw(iof+i) = zsolsw(i) + solswfdiff(iof+i) = zsolswfdiff(i) + sollw(iof+i) = zsollw(i) + sollwdown(iof+i) = zsollwdown(i) + ENDDO + + DO k = 1, kflev+1 + DO i = 1, kdlon + lwdn0 ( iof+i,k) = ZFLDN0 ( i,k) + lwdn ( iof+i,k) = ZFLDN ( i,k) + lwup0 ( iof+i,k) = ZFLUP0 ( i,k) + lwup ( iof+i,k) = ZFLUP ( i,k) + ENDDO + ENDDO + + DO i = 1, kdlon + topsw0(iof+i) = ztopsw0(i) + toplw0(iof+i) = ztoplw0(i) + solsw0(iof+i) = zsolsw0(i) + sollw0(iof+i) = zsollw0(i) + albpla(iof+i) = zalbpla(i) + ENDDO + + DO k = 1, kflev+1 + DO i = 1, kdlon + swdnc0( iof+i,k) = ZFSDNC0( i,k) + swdn0 ( iof+i,k) = ZFSDN0 ( i,k) + swdn ( iof+i,k) = ZFSDN ( i,k) + swupc0( iof+i,k) = ZFSUPC0( i,k) + swup0 ( iof+i,k) = ZFSUP0 ( i,k) + swup ( iof+i,k) = ZFSUP ( i,k) + lwdnc0( iof+i,k) = ZFLDNC0( i,k) + lwupc0( iof+i,k) = ZFLUPC0( i,k) + ENDDO + ENDDO + !-transform the aerosol forcings, if they have + ! to be calculated + IF (ok_ade) THEN + DO i = 1, kdlon + topswad_aero(iof+i) = ztopswadaero(i) + topswad0_aero(iof+i) = ztopswad0aero(i) + solswad_aero(iof+i) = zsolswadaero(i) + solswad0_aero(iof+i) = zsolswad0aero(i) + ENDDO + + topsw_aero(:,:) = ztopsw_aero(:,:) + topsw0_aero(:,:) = ztopsw0_aero(:,:) + solsw_aero(:,:) = zsolsw_aero(:,:) + solsw0_aero(:,:) = zsolsw0_aero(:,:) + topswcf_aero(:,:) = ztopswcf_aero(:,:) + solswcf_aero(:,:) = zsolswcf_aero(:,:) + !-LW + DO i = 1, kdlon + toplwad_aero(iof+i) = ztoplwadaero(i) + toplwad0_aero(iof+i) = ztoplwad0aero(i) + sollwad_aero(iof+i) = zsollwadaero(i) + sollwad0_aero(iof+i) = zsollwad0aero(i) + ENDDO + ELSE + DO i = 1, kdlon + topswad_aero(iof+i) = 0.0 + solswad_aero(iof+i) = 0.0 + topswad0_aero(iof+i) = 0.0 + solswad0_aero(iof+i) = 0.0 + ENDDO + topsw_aero(:,:) = 0. + topsw0_aero(:,:) =0. + solsw_aero(:,:) = 0. + solsw0_aero(:,:) = 0. + !-LW + DO i = 1, kdlon + toplwad_aero(iof+i) = 0.0 + sollwad_aero(iof+i) = 0.0 + toplwad0_aero(iof+i) = 0.0 + sollwad0_aero(iof+i) = 0.0 + ENDDO + ENDIF + IF (ok_aie) THEN + DO i = 1, kdlon + topswai_aero(iof+i) = ztopswaiaero(i) + solswai_aero(iof+i) = zsolswaiaero(i) + !-LW + toplwai_aero(iof+i) = ztoplwaiaero(i) + sollwai_aero(iof+i) = zsollwaiaero(i) + ENDDO + ELSE + DO i = 1, kdlon + topswai_aero(iof+i) = 0.0 + solswai_aero(iof+i) = 0.0 + !-LW + toplwai_aero(iof+i) = 0.0 + sollwai_aero(iof+i) = 0.0 + ENDDO + ENDIF + DO k = 1, kflev + DO i = 1, kdlon + ! scale factor to take into account the difference between + ! dry air and watter vapour scpecifi! heat capacity + zznormcp=1.0+RVTMP2*PWV(i,k) + heat(iof+i,k) = zheat(i,k)/zznormcp + cool(iof+i,k) = zcool(i,k)/zznormcp + heat0(iof+i,k) = zheat0(i,k)/zznormcp + cool0(iof+i,k) = zcool0(i,k)/zznormcp + IF(ok_volcan) THEN !NL + heat_volc(iof+i,k) = zheat_volc(i,k)/zznormcp + cool_volc(iof+i,k) = zcool_volc(i,k)/zznormcp + ENDIF + ENDDO + ENDDO + IF (iflag_rrtm.ne.2) THEN + cloud_cover_sw(:) = missing_val + ZFLUX_DIR(:,:) = missing_val + ZFLUX_DIR_CLEAR(:,:) = missing_val + ZFLUX_DIR_INTO_SUN = missing_val + END IF + + END SUBROUTINE radiation_post +END MODULE lmdz_radiation_post Index: /LMDZ6/trunk/libf/phylmd/lmdz_radiation_pre.F90 =================================================================== --- /LMDZ6/trunk/libf/phylmd/lmdz_radiation_pre.F90 (revision 6181) +++ /LMDZ6/trunk/libf/phylmd/lmdz_radiation_pre.F90 (revision 6181) @@ -0,0 +1,383 @@ +! +! $Id: radlwsw_m.F90 6127 2026-03-26 13:59:25Z idelkadi $ +! +MODULE lmdz_radiation_pre + IMPLICIT NONE +CONTAINS + + SUBROUTINE radiation_pre( & + ist,iend,ktdia,kmode, & + dist, rmu0, fract, & + paprs, pplay,tsol,SFRWL,alb_dir, alb_dif, & + t,q,wo,& + cldfra, cldemi, cldtaupd,& + tau_aero, piz_aero, cg_aero,& + tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm,& ! rajoute par OB RRTM + cldtaupi, & + qsat, flwc, fiwc, iof, & + heat,heat0,cool,cool0,& + heat_volc, cool_volc,& + zheat,zheat0,zcool,zcool0,& + zheat_volc, zcool_volc,& + zdist,PSCT,zfract,zrmu0, & + PAER,PCLDLD,PCLDLU,PCLDSW,& + PTAU,PTAUA,POMEGA,POMEGAA,PCG, & + PALBD,PALBP,PALBD_NEW,PALBP_NEW,& + PEMIS,PDT0,PVIEW,PPSOL,PDP, & + PTL,PPMB,PTAVE,PWV,PQS, & + zx_alpha1,zx_alpha2,POZON, & + tauaero,pizaero,cgaero, & + ztopsw_aero,ztopsw0_aero,zsolsw_aero,zsolsw0_aero, & + ztopswcf_aero,zsolswcf_aero,& + ztopswadaero,zsolswadaero,ztopswad0aero, & + zsolswad0aero,zsollwadaero,zsollwad0aero, & + ztopswaiaero,zsolswaiaero,ztoplwaiaero,zsollwaiaero) + + !=================================================================================================== + ! A. Idelkadi, mars 2026 : Recriture de l interface radlwsw_m.F90 entre LMDZ + ! et les codes radiatifs oldrad/rrtm/ecrad + ! -------------------------------------------------------------------------- + ! - Declarations => in / out (pas de variables locales) + ! - Appel de chaque interface avec le code radiatif pilote par iflag_rrtm + ! * iflag_rrtm = 0 => CALL lmdz_call_oldrad + ! * = 1 => CALL lmdz_call_rrtm + ! * = 2 => CALL lmdz_call_ecrad + ! lmdz_rad_ini_m.F90 : + ! - Declarations + ! - Initialisations : heat, cool, ... + ! - Calcul des champs input pour les codes radiatifs (albedo, meteo, ...) + ! A completer + ! -------------------------------------------------------------------------------------------- + + ! Modules necessaires + USE DIMPHY + USE assert_m, ONLY : assert + USE infotrac_phy, ONLY : type_trac, nbtr + USE write_field_phy + + USE lmdz_reprobus_wrappers, ONLY : solaireTIME, ok_SUNTIME, ndimozon, rad_interactif + USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_REPROBUS + USE phys_local_var_mod, ONLY : tr_seri + +#ifdef CPP_RRTM + ! modules necessaires au rayonnement + ! ----------------------------------------- + USE YOERAD , ONLY : NLW, LRRTM ,LCCNL ,LCCNO ,& + NRADIP , NRADLP , NICEOPT, NLIQOPT ,RCCNLND , RCCNSEA + USE YOELW , ONLY : NSIL ,NTRA ,NUA ,TSTAND ,XP + USE YOESW , ONLY : RYFWCA ,RYFWCB ,RYFWCC ,RYFWCD,& + RYFWCE ,RYFWCF ,REBCUA ,REBCUB ,REBCUC,& + REBCUD ,REBCUE ,REBCUF ,REBCUI ,REBCUJ,& + REBCUG ,REBCUH ,RHSAVI ,RFULIO ,RFLAA0,& + RFLAA1 ,RFLBB0 ,RFLBB1 ,RFLBB2 ,RFLBB3,& + RFLCC0 ,RFLCC1 ,RFLCC2 ,RFLCC3 ,RFLDD0,& + RFLDD1 ,RFLDD2 ,RFLDD3 ,RFUETA ,RASWCA,& + RASWCB ,RASWCC ,RASWCD ,RASWCE ,RASWCF + USE YOERDU , ONLY : NUAER ,NTRAER ,REPLOG ,REPSC ,REPSCW ,DIFF + USE YOERRTWN , ONLY : DELWAVE ,TOTPLNK + USE YOMPHY3 , ONLY : RII0 +#endif + + USE aero_mod + USE conf_phys_m, ONLY: ok_ade, ok_aie, ok_volcan, flag_volc_surfstrat, & + flag_aerosol, flag_aerosol_strat, flag_aer_feedback, & + iflag_rrtm + USE yomcst_mod_h + USE clesphys_mod_h + USE yoethf_mod_h + USE phys_constants_mod, ONLY: dobson_u + USE wxios_mod, ONLY: missing_val + + ! ============== + ! DECLARATIONS + ! ============== + + ! Input arguments + REAL, INTENT(in) :: dist + REAL, INTENT(in) :: rmu0(KLON), fract(KLON) + REAL, INTENT(in) :: paprs(KLON,KLEV+1), pplay(KLON,KLEV) + REAL, INTENT(in) :: tsol(KLON) + REAL, INTENT(in) :: alb_dir(KLON,NSW),alb_dif(KLON,NSW) + REAL, INTENT(in) :: SFRWL(6) + REAL, INTENT(in) :: t(KLON,KLEV), q(KLON,KLEV) + REAL, INTENT(in) :: wo(:, :, :) ! dimension(KLON,KLEV, 1 or 2) + ! column-density of ozone in a layer, in kilo-Dobsons + ! "wo(:, :, 1)" is for the average day-night field, + ! "wo(:, :, 2)" is for daylight time. + LOGICAL :: lldebug=.false. + REAL, INTENT(in) :: cldfra(KLON,KLEV), cldemi(KLON,KLEV), cldtaupd(KLON,KLEV) + REAL, INTENT(in) :: tau_aero(KLON,KLEV,naero_grp,2) ! aerosol optical properties (see aeropt.F) + REAL, INTENT(in) :: piz_aero(KLON,KLEV,naero_grp,2) ! aerosol optical properties (see aeropt.F) + REAL, INTENT(in) :: cg_aero(KLON,KLEV,naero_grp,2) ! aerosol optical properties (see aeropt.F) + REAL, INTENT(in) :: tau_aero_sw_rrtm(KLON,KLEV,2,NSW) ! aerosol optical properties RRTM + REAL, INTENT(in) :: piz_aero_sw_rrtm(KLON,KLEV,2,NSW) ! aerosol optical properties RRTM + REAL, INTENT(in) :: cg_aero_sw_rrtm(KLON,KLEV,2,NSW) ! aerosol optical properties RRTM + REAL, INTENT(in) :: cldtaupi(KLON,KLEV) ! cloud optical thickness for pre-industrial aerosol concentrations + REAL, INTENT(in) :: qsat(klon,klev) ! Variable pour iflag_rrtm=1 + REAL, INTENT(in) :: flwc(klon,klev) ! Variable pour iflag_rrtm=1 + REAL, INTENT(in) :: fiwc(klon,klev) ! Variable pour iflag_rrtm=1 + + ! Variables inout (initialisation) + REAL, INTENT(inout) :: heat(KLON,KLEV), cool(KLON,KLEV) + REAL, INTENT(inout) :: heat0(KLON,KLEV), cool0(KLON,KLEV) + REAL, INTENT(inout) :: heat_volc(KLON,KLEV), cool_volc(KLON,KLEV) !NL + REAL(KIND=8), INTENT(inout) :: zheat(kdlon,kflev), zcool(kdlon,kflev) + REAL(KIND=8), INTENT(inout) :: zheat0(kdlon,kflev), zcool0(kdlon,kflev) + REAL(KIND=8), INTENT(inout) :: zheat_volc(kdlon,kflev), zcool_volc(kdlon,kflev) !NL + ! + REAL(KIND=8), INTENT(inout) :: ztopswadaero(kdlon), zsolswadaero(kdlon), & ! Aerosol direct forcing at TOAand surface + zsollwadaero(kdlon) + REAL(KIND=8), INTENT(inout) :: ztopswad0aero(kdlon), zsolswad0aero(kdlon), & ! Aerosol direct forcing at TOAand surface + zsollwad0aero(kdlon) + REAL(KIND=8), INTENT(inout) :: ztopswaiaero(kdlon), zsolswaiaero(kdlon), & ! dito, indirect + ztoplwaiaero(kdlon), zsollwaiaero(kdlon) + REAL(KIND=8), INTENT(inout) :: ztopsw_aero(kdlon,9), ztopsw0_aero(kdlon,9) + REAL(KIND=8), INTENT(inout) :: zsolsw_aero(kdlon,9), zsolsw0_aero(kdlon,9) + REAL(KIND=8), INTENT(inout) :: ztopswcf_aero(kdlon,3), zsolswcf_aero(kdlon,3) + + ! Variables out + INTEGER, INTENT(out) :: iof + REAL(KIND=8), INTENT(out) :: PSCT + REAL(KIND=8), INTENT(out) :: PALBD(kdlon,2), PALBP(kdlon,2) + ! MPL 06.01.09: pour RRTM, creation de PALBD_NEW et PALBP_NEW + ! avec NSW en deuxieme dimension + REAL(KIND=8), INTENT(out) :: PALBD_NEW(kdlon,NSW), PALBP_NEW(kdlon,NSW) + REAL(KIND=8), INTENT(out) :: PEMIS(kdlon), PDT0(kdlon), PVIEW(kdlon) + REAL(KIND=8), INTENT(out) :: PPSOL(kdlon), PDP(kdlon,KLEV) + REAL(KIND=8), INTENT(out) :: PTL(kdlon,kflev+1), PPMB(kdlon,kflev+1) + REAL(KIND=8), INTENT(out) :: PTAVE(kdlon,kflev) + REAL(KIND=8), INTENT(out) :: PWV(kdlon,kflev), PQS(kdlon,kflev) + REAL(kind=8), INTENT(out) :: POZON(kdlon, kflev, size(wo, 3)) ! mass fraction of ozone + ! "POZON(:, :, 1)" is for the average day-night field, + ! "POZON(:, :, 2)" is for daylight time. + ! Modif MPL 6.01.09 avec RRTM, on passe de 5 a 6 + REAL(KIND=8), INTENT(out) :: PAER(kdlon,kflev,6) + REAL(KIND=8), INTENT(out) :: PCLDLD(kdlon,kflev) + REAL(KIND=8), INTENT(out) :: PCLDLU(kdlon,kflev) + REAL(KIND=8), INTENT(out) :: PCLDSW(kdlon,kflev) + REAL(KIND=8), INTENT(out) :: PTAU(kdlon,2,kflev) + REAL(KIND=8), INTENT(out) :: POMEGA(kdlon,2,kflev) + REAL(KIND=8), INTENT(out) :: PCG(kdlon,2,kflev) + REAL(KIND=8), INTENT(out) :: zfract(kdlon), zrmu0(kdlon), zdist + REAL(KIND=8), INTENT(out) :: tauaero(kdlon,kflev,naero_grp,2) ! aer opt properties + REAL(KIND=8), INTENT(out) :: pizaero(kdlon,kflev,naero_grp,2) + REAL(KIND=8), INTENT(out) :: cgaero(kdlon,kflev,naero_grp,2) + REAL(KIND=8), INTENT(out) :: PTAUA(kdlon,2,kflev) ! present-day value of cloud opt thickness (PTAU is pre-industrial value), local use + REAL(KIND=8), INTENT(out) :: POMEGAA(kdlon,2,kflev) ! dito for single scatt albedo + INTEGER, INTENT(out) :: ist,iend,ktdia,kmode + + ! Local variables + INTEGER :: dimoz + REAL(KIND=8) zx_alpha1, zx_alpha2 + INTEGER k, kk, i, j, l, nb_gr,jb !FC + + dimoz=size(wo,3) + + ! ========= INITIALISATIONS ============================================== + IF (lldebug) THEN + print*,'Entree dans radlwsw ' + print*,'************* INITIALISATIONS *****************************' + print*,'klon, kdlon, klev, kflev =',klon, kdlon, klev, kflev + print*,'size(wo, 1) , klon, size(wo, 2), klev ', & + size(wo, 1) , klon, size(wo, 2), klev + + ENDIF + + CALL assert(size(wo, 1) == klon, size(wo, 2) == klev, "radlwsw wo") + + ist=1 + iend=klon + ktdia=1 + kmode=ist + ! Aeros + tauaero(:,:,:,:)=0. + pizaero(:,:,:,:)=0. + cgaero(:,:,:,:)=0. + ! lldebug=.FALSE. + + ztopsw_aero(:,:) = 0. !ym missing init : warning : not initialized in SW_AEROAR4 + ztopsw0_aero(:,:) = 0. !ym missing init : warning : not initialized in SW_AEROAR4 + zsolsw_aero(:,:) = 0. !ym missing init : warning : not initialized in SW_AEROAR4 + zsolsw0_aero(:,:) = 0. !ym missing init : warning : not initialized in SW_AEROAR4 + + ! Direct effect aero + ztopswadaero(:) = 0. !ym missing init + zsolswadaero(:) = 0. !ym missing init + zsollwadaero(:) = 0. !ym missing init + ztopswad0aero(:) = 0. !ym missing init + zsolswad0aero(:) = 0. !ym missing init + zsollwad0aero(:) = 0. !ym missing init + ! Indirect effect aero + ztopswaiaero(:) = 0. !ym missing init + zsolswaiaero(:) = 0. !ym missing init + ztoplwaiaero(:) = 0. !ym missing init + zsollwaiaero(:) = 0. !ym missing init + ! + ztopswcf_aero(:,:)= 0.!ym missing init + zsolswcf_aero(:,:)= 0. !ym missing init + + !------------------------------------------- + nb_gr = KLON / kdlon + IF (nb_gr*kdlon .NE. KLON) THEN + PRINT*, "kdlon mauvais:", KLON, kdlon, nb_gr + call abort_physic("radlwsw", "", 1) + ENDIF + IF (kflev .NE. KLEV) THEN + PRINT*, "kflev differe de KLEV, kflev, KLEV" + call abort_physic("radlwsw", "", 1) + ENDIF + !------------------------------------------- + DO k = 1, KLEV + DO i = 1, KLON + heat(i,k)=0. + cool(i,k)=0. + heat_volc(i,k)=0. !NL + cool_volc(i,k)=0. !NL + heat0(i,k)=0. + cool0(i,k)=0. + ENDDO + ENDDO + ! + zdist = dist + ! + PSCT = solaire/zdist/zdist + + IF (type_trac == 'repr') THEN + IF (CPPKEY_REPROBUS) THEN + IF (iflag_rrtm==0) THEN + IF (ok_SUNTIME) PSCT = solaireTIME/zdist/zdist + print*,'Constante solaire: ',PSCT*zdist*zdist + ENDIF + END IF + ENDIF + + IF (lldebug) THEN + print*,'************** Debut boucle de 1 a ', nb_gr + ENDIF + + !DO j = 1, nb_gr + j = 1 + iof = kdlon*(j-1) + DO i = 1, kdlon + zfract(i) = fract(iof+i) + zrmu0(i) = rmu0(iof+i) + ENDDO + + IF (iflag_rrtm==0) THEN + DO i = 1, kdlon + + ! Albedo + PALBD(i,1)=alb_dif(iof+i,1) + PALBD(i,2)=alb_dif(iof+i,2) + PALBP(i,1)=alb_dir(iof+i,1) + PALBP(i,2)=alb_dir(iof+i,2) + ! AI 02.2021 cas iflag_rrtm=1 et 2 + ENDDO + + ELSEIF (iflag_rrtm==1.OR.iflag_rrtm==2) THEN + DO kk=1,NSW + DO i = 1, kdlon + + PALBD_NEW(i,kk)=alb_dif(iof+i,kk) + PALBP_NEW(i,kk)=alb_dir(iof+i,kk) + ENDDO + ENDDO + + ! + ENDIF + !albedo SB <<< + DO i = 1, kdlon + PEMIS(i) = 1.0 ! A REVOIR (MPL) + PVIEW(i) = 1.66 + PPSOL(i) = paprs(iof+i,1) + zx_alpha1 = (paprs(iof+i,1)-pplay(iof+i,2))/(pplay(iof+i,1)-pplay(iof+i,2)) + zx_alpha2 = 1.0 - zx_alpha1 + PTL(i,1) = t(iof+i,1) * zx_alpha1 + t(iof+i,2) * zx_alpha2 + PTL(i,KLEV+1) = t(iof+i,KLEV) + PDT0(i) = tsol(iof+i) - PTL(i,1) + ENDDO + + DO k = 2, kflev + DO i = 1, kdlon + PTL(i,k) = (t(iof+i,k)+t(iof+i,k-1))*0.5 + ENDDO + ENDDO + + ! Confert from column density of ozone in a cell, in kDU, to a mass fraction + DO l=1, dimoz + DO k = 1, kflev + DO i = 1, kdlon + POZON(i,k, l) = wo(iof+i, k, l) * RG * dobson_u * 1e3 & + / (paprs(iof+i, k) - paprs(iof+i, k+1)) + ! A activer pour CCMVAL on prend l'ozone impose (MPL 07042010) + ! POZON(i,k,:) = wo(i,k,:) + ! print *,'RADLWSW: POZON',k, POZON(i,k,1) + ENDDO + ENDDO + ENDDO + + DO k = 1, kflev + DO i = 1, kdlon + PDP(i,k) = paprs(iof+i,k)-paprs(iof+i,k+1) + PTAVE(i,k) = t(iof+i,k) + PWV(i,k) = MAX (q(iof+i,k), 1.0e-12) + PQS(i,k) = PWV(i,k) + PCLDLD(i,k) = cldfra(iof+i,k)*cldemi(iof+i,k) + PCLDLU(i,k) = cldfra(iof+i,k)*cldemi(iof+i,k) + PCLDSW(i,k) = cldfra(iof+i,k) + PTAU(i,1,k) = MAX(cldtaupi(iof+i,k), 1.0e-05)! 1e-12 serait instable + PTAU(i,2,k) = MAX(cldtaupi(iof+i,k), 1.0e-05)! pour 32-bit machines + POMEGA(i,1,k) = 0.9999 - 5.0e-04 * EXP(-0.5 * PTAU(i,1,k)) + POMEGA(i,2,k) = 0.9988 - 2.5e-03 * EXP(-0.05 * PTAU(i,2,k)) + PCG(i,1,k) = 0.865 + PCG(i,2,k) = 0.910 + !- + ! Introduced for aerosol indirect forcings. + ! The following values use the cloud optical thickness calculated from + ! present-day aerosol concentrations whereas the quantities without the + ! "A" at the end are for pre-industial (natural-only) aerosol concentrations + ! + PTAUA(i,1,k) = MAX(cldtaupd(iof+i,k), 1.0e-05)! 1e-12 serait instable + PTAUA(i,2,k) = MAX(cldtaupd(iof+i,k), 1.0e-05)! pour 32-bit machines + POMEGAA(i,1,k) = 0.9999 - 5.0e-04 * EXP(-0.5 * PTAUA(i,1,k)) + POMEGAA(i,2,k) = 0.9988 - 2.5e-03 * EXP(-0.05 * PTAUA(i,2,k)) + ENDDO + ENDDO + + IF (type_trac == 'repr') THEN + IF (CPPKEY_REPROBUS) THEN + ndimozon = size(wo, 3) + CALL RAD_INTERACTIF(POZON,iof,tr_seri,nbtr) + END IF + ENDIF + ! + DO k = 1, kflev+1 + DO i = 1, kdlon + PPMB(i,k) = paprs(iof+i,k)/100.0 + ENDDO + ENDDO + ! + ! Modif MPL 6.01.09 avec RRTM, on passe de 5 a 6 + DO kk = 1, 6 + DO k = 1, kflev + DO i = 1, kdlon + PAER(i,k,kk) = 1.0E-15 ! A REVOIR (MPL) + ENDDO + ENDDO + ENDDO + + DO l=1,naero_grp + DO k = 1, kflev + DO i = 1, kdlon + tauaero(i,k,l,1)=tau_aero(iof+i,k,l,1) + pizaero(i,k,l,1)=piz_aero(iof+i,k,l,1) + cgaero(i,k,l,1) =cg_aero(iof+i,k,l,1) + tauaero(i,k,l,2)=tau_aero(iof+i,k,l,2) + pizaero(i,k,l,2)=piz_aero(iof+i,k,l,2) + cgaero(i,k,l,2) =cg_aero(iof+i,k,l,2) + ENDDO + ENDDO + ENDDO + ! + END SUBROUTINE radiation_pre +END MODULE lmdz_radiation_pre Index: /LMDZ6/trunk/libf/phylmd/physiq_mod.F90 =================================================================== --- /LMDZ6/trunk/libf/phylmd/physiq_mod.F90 (revision 6180) +++ /LMDZ6/trunk/libf/phylmd/physiq_mod.F90 (revision 6181) @@ -119,5 +119,5 @@ USE readaerosol_mod, ONLY : init_aero_fromfile USE readaerosolstrato_m, ONLY : init_readaerosolstrato - USE lmdz_call_rads_m, ONLY: lmdz_call_rads + USE lmdz_call_radiation, ONLY: call_radiation USE regr_horiz_time_climoz_m, ONLY: regr_horiz_time_climoz USE regr_pr_time_av_m, ONLY: regr_pr_time_av @@ -1106,11 +1106,11 @@ ! retros liees aux CRF REAL, dimension(klon, klev) :: cldtaurad ! epaisseur optique - ! pour lmdz_call_rads pour + ! pour call_radiation pour ! tester "CRF off" REAL, dimension(klon, klev) :: cldtaupirad ! epaisseur optique - ! pour lmdz_call_rads pour + ! pour call_radsiation pour ! tester "CRF off" REAL, dimension(klon, klev) :: cldemirad ! emissivite pour - ! lmdz_call_rads pour tester + ! call_radiation pour tester ! "CRF off" REAL, dimension(klon, klev) :: cldfrarad ! fraction nuageuse @@ -2570,5 +2570,5 @@ ! Calculs de l'orbite. ! Necessaires pour le rayonnement et la surface (calcul de l'albedo). - ! doit donc etre plac\'e avant lmdz_call_rads et pbl_surface + ! doit donc etre plac\'e avant call_radiation et pbl_surface ! !! jyg 17 Sep 2010 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -4434,5 +4434,5 @@ namelist_ecrad_file='namelist_ecrad' ! - CALL lmdz_call_rads & + CALL call_radiation & (debut, dist, rmu0, fract, & !albedo SB >>> @@ -4507,10 +4507,10 @@ ! IF (prt_level .GE.10) THEN - print *,' ->lmdz_call_rads, number 2 ' + print *,' ->call_radiation, number 2 ' ENDIF ! namelist_ecrad_file='namelist_ecrad' ! - CALL lmdz_call_rads & + CALL call_radiation & (debut, dist, rmu0, fract, & !albedo SB >>> @@ -4562,5 +4562,5 @@ ! print*,'ok_2xcall_ecrad = ',ok_2xcall_ecrad namelist_ecrad_file='namelist_ecrad_s2' - CALL lmdz_call_rads & + CALL call_radiation & (debut, dist, rmu0, fract, & paprs, pplay,zxtsol,SFRWL,albsol_dir, albsol_dif, & @@ -4634,5 +4634,5 @@ ! - ! Calculer radsol a l'exterieur de lmdz_call_rads + ! Calculer radsol a l'exterieur de call_radiation ! pour prendre en compte le cycle diurne ! recode par Olivier Boucher en sept 2015 Index: /LMDZ6/trunk/libf/phylmdiso/physiq_mod.F90 =================================================================== --- /LMDZ6/trunk/libf/phylmdiso/physiq_mod.F90 (revision 6180) +++ /LMDZ6/trunk/libf/phylmdiso/physiq_mod.F90 (revision 6181) @@ -92,5 +92,5 @@ USE readaerosol_mod, ONLY : init_aero_fromfile USE readaerosolstrato_m, ONLY : init_readaerosolstrato - USE lmdz_call_rads_m, ONLY: lmdz_call_rads + USE lmdz_call_radiation, ONLY: call_radiation USE reevap_mod, ONLY: reevap USE regr_horiz_time_climoz_m, ONLY: regr_horiz_time_climoz @@ -1180,11 +1180,11 @@ ! retros liees aux CRF REAL, DIMENSION(klon, klev) :: cldtaurad ! epaisseur optique - ! pour lmdz_call_rads pour + ! pour call_radiation pour ! tester "CRF off" REAL, DIMENSION(klon, klev) :: cldtaupirad ! epaisseur optique - ! pour lmdz_call_rads pour + ! pour call_radiation pour ! tester "CRF off" REAL, DIMENSION(klon, klev) :: cldemirad ! emissivite pour - ! lmdz_call_rads pour tester + ! call_radiation pour tester ! "CRF off" REAL, DIMENSION(klon, klev) :: cldfrarad ! fraction nuageuse @@ -2967,5 +2967,5 @@ ! Calculs de l'orbite. ! Necessaires pour le rayonnement et la surface (calcul de l'albedo). - ! doit donc etre place avant lmdz_call_rads et pbl_surface + ! doit donc etre place avant call_radiation et pbl_surface ! !! jyg 17 Sep 2010 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -5977,11 +5977,11 @@ IF (prt_level .GE.10) THEN - print *,' ->lmdz_call_rads, number 1 ' + print *,' ->call_radiation, number 1 ' ENDIF ! - ! AI namelist utilise pour l appel principal de lmdz_call_rads (ecrad) + ! AI namelist utilise pour l appel principal de call_radiation (ecrad) namelist_ecrad_file='namelist_ecrad' ! - CALL lmdz_call_rads & + CALL call_radiation & (debut, dist, rmu0, fract, & !albedo SB >>> @@ -6056,10 +6056,10 @@ ! IF (prt_level .GE.10) THEN - print *,' ->lmdz_call_rads, number 2 ' + print *,' ->call_radiation, number 2 ' ENDIF ! namelist_ecrad_file='namelist_ecrad' ! - CALL lmdz_call_rads & + CALL call_radiation & (debut, dist, rmu0, fract, & !albedo SB >>> @@ -6111,5 +6111,5 @@ ! print*,'ok_2xcall_ecrad = ',ok_2xcall_ecrad namelist_ecrad_file='namelist_ecrad_s2' - CALL lmdz_call_rads & + CALL call_radiation & (debut, dist, rmu0, fract, & paprs, pplay,zxtsol,SFRWL,albsol_dir, albsol_dif, & @@ -6183,5 +6183,5 @@ ! - ! Calculer radsol a l'exterieur de lmdz_call_rads + ! Calculer radsol a l'exterieur de call_radiation ! pour prendre en compte le cycle diurne ! recode par Olivier Boucher en sept 2015