! ! $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 ZCO2 = RCO2 ZCH4 = RCH4 ZN2O = RN2O ZNO2 = 0.0 ZCFC11 = RCFC11 ZCFC12 = RCFC12 ZHCFC22 = 0.0 ZO2 = 0.0 ZCCL4 = 0.0 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 ZCO2 = RCO2_per ZCH4 = RCH4_per ZN2O = RN2O_per ZNO2 = 0.0 ZCFC11 = RCFC11_per ZCFC12 = RCFC12_per ZHCFC22 = 0.0 ZO2 = 0.0 ZCCL4 = 0.0 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