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