! ! $Id: lmdz_call_radiation.F90 6206 2026-04-24 10:46:01Z asima $ ! 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