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