! ! $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