! $Id: calwake.F90 6201 2026-04-23 18:18:01Z lguez $
!$gpum horizontal klon nlon
MODULE calwake_mod
  PRIVATE

  LOGICAL, SAVE, ALLOCATABLE :: first(:) ! first(klon) : first calwake computation on columns
  !$OMP THREADPRIVATE(first)

  LOGICAL, SAVE :: first_first=.TRUE.  ! fisrt call to calwake
  !$OMP THREADPRIVATE(first_first)  

  PUBLIC calwake_first, calwake

CONTAINS  

SUBROUTINE calwake_first(dtime)
USE dimphy, ONLY : klon,klev
USE lmdz_wake_first, ONLY : wake_first
  REAL, INTENT(IN)  :: dtime 
  
  IF (first_first) THEN
    ALLOCATE(first(klon))
    first(:)=.TRUE.
    
    CALL wake_first(klev, dtime)

    first_first=.FALSE.
  ENDIF

END SUBROUTINE calwake_first


SUBROUTINE calwake(iflag_wake_tend, paprs, pplay, dtime, &
    t, q, omgb, &
    dt_dwn, dq_dwn, m_dwn, m_up, dt_a, dq_a, wgen, &
    sigd, Cin, &
    wake_deltat, wake_deltaq, wake_s, awake_s, wake_dens, awake_dens, &
    wake_dth, wake_h, &
    wake_pe, wake_fip, wake_gfl, &
    dt_wake, dq_wake, wake_k, t_x, q_x, wake_omgbdth, &
    wake_dp_omgb, &
    wake_dtke, wake_dqke, &
    wake_omg, wake_dp_deltomg, &
    wake_spread, wake_cstar, wake_d_deltat_gw, &
    wake_ddeltat, wake_ddeltaq, wake_ds, awake_ds, wake_ddens, awake_ddens &
#ifdef ISO
     & ,xt,dxt_dwn,dxt_a &
     & ,wake_deltaxt,dxt_wake,xt_x,wake_ddeltaxt &
#endif      
     )
  ! **************************************************************
  ! *
  ! CALWAKE                                                     *
  ! interface avec le schema de calcul de la poche    *
  ! froide                                            *
  ! *
  ! written by   : CHERUY Frederique, 13/03/2000, 10.31.05      *
  ! modified by :  ROEHRIG Romain,    01/30/2007                *
  ! **************************************************************

  USE dimphy
  USE phys_state_var_mod, ONLY: pctsrf
  USE indice_sol_mod, ONLY: is_oce
  USE print_control_mod, ONLY: lunout, prt_level
  USE lmdz_wake, ONLY : wake
  USE lmdz_wake2, ONLY : wake2
  USE lmdz_wake3, ONLY : wake3
  USE conf_phys_m, ONLY: iflag_wake
#ifdef ISO
  USE infotrac_phy, ONLY : ntraciso=>ntiso
#ifdef ISOVERIF
  USE isotopes_mod, ONLY: iso_eau
  USE isotopes_verif_mod
#endif
#endif
  USE yomcst_mod_h
IMPLICIT NONE
  ! ======================================================================


  ! Arguments
  ! ----------
  ! Input
  ! ----
  INTEGER,                       INTENT (IN)         :: iflag_wake_tend
  REAL,                          INTENT (IN)         :: dtime
  REAL, DIMENSION(klon, klev),   INTENT (IN)         :: pplay
  REAL, DIMENSION(klon, klev+1), INTENT (IN)         :: paprs
  REAL, DIMENSION(klon, klev),   INTENT (IN)         :: t, q, omgb
  REAL, DIMENSION(klon, klev),   INTENT (IN)         :: dt_dwn, dq_dwn
  REAL, DIMENSION(klon, klev),   INTENT (IN)         :: m_up, m_dwn
  REAL, DIMENSION(klon, klev),   INTENT (IN)         :: dt_a, dq_a
  REAL, DIMENSION(klon),         INTENT (IN)         :: wgen
  REAL, DIMENSION(klon),         INTENT (IN)         :: sigd
  REAL, DIMENSION(klon),         INTENT (IN)         :: Cin
#ifdef ISO
  REAL, DIMENSION(ntraciso,klon, klev), INTENT (IN)  :: xt,dxt_dwn,dxt_a
#endif
  ! Input/Output
  ! ------------
  REAL, DIMENSION(klon, klev),   INTENT (INOUT)      :: wake_deltat, wake_deltaq
  REAL, DIMENSION(klon),         INTENT (INOUT)      :: wake_s, awake_s
  REAL, DIMENSION(klon),         INTENT (INOUT)      :: wake_dens, awake_dens
#ifdef ISO
  REAL, DIMENSION(ntraciso,klon, klev), INTENT(INOUT):: wake_deltaxt
#endif
  ! Output
  ! ------
  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: dt_wake, dq_wake
!!jyg  REAL, DIMENSION(klon),         INTENT (OUT)        :: wake_k
  INTEGER, DIMENSION(klon),      INTENT (OUT)        :: wake_k
  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: wake_d_deltat_gw
  REAL, DIMENSION(klon),         INTENT (OUT)        :: wake_h
  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: wake_dth
  REAL, DIMENSION(klon),         INTENT (OUT)        :: wake_pe, wake_fip, wake_gfl
  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: t_x, q_x
  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: wake_omgbdth, wake_dp_omgb
  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: wake_dtke, wake_dqke
  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: wake_omg, wake_dp_deltomg
  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: wake_spread
  REAL, DIMENSION(klon),         INTENT (OUT)        :: wake_cstar
  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: wake_ddeltat, wake_ddeltaq
  REAL, DIMENSION(klon),         INTENT (OUT)        :: wake_ds, awake_ds, wake_ddens, awake_ddens
#ifdef ISO
  REAL, DIMENSION(ntraciso,klon, klev), INTENT (OUT) :: dxt_wake
  REAL, DIMENSION(ntraciso,klon, klev), INTENT (OUT) :: xt_x
  REAL, DIMENSION(ntraciso,klon, klev), INTENT (OUT) :: wake_ddeltaxt
  REAL, DIMENSION(ntraciso,klon, klev)               :: wake_dxtke ! pas besoin de la sortir
#endif


  ! Variable internes
  ! -----------------
  INTEGER                                            :: i, l
  INTEGER, DIMENSION(klon)                           :: znatsurf    ! 0 if pctsrf(is_oce)>0.1; 1 else.
  REAL                                               :: aire
  REAL, DIMENSION(klon, klev)                        :: p,  pi
  REAL, DIMENSION(klon, klev+1)                      ::  ph
  REAL, DIMENSION(klon, klev)                        ::  omgbe
  REAL, DIMENSION(klon, klev)                        :: te, qe
  REAL, DIMENSION(klon, klev)                        :: dtdwn, dqdwn
  REAL, DIMENSION(klon, klev)                        :: dta, dqa
  REAL, DIMENSION(klon, klev)                        :: amdwn, amup
  REAL, DIMENSION(klon, klev)                        :: dtw, dqw, dth
  REAL, DIMENSION(klon, klev)                        :: dtls, dqls
  REAL, DIMENSION(klon, klev)                        :: tx, qx
  REAL, DIMENSION(klon)                              :: hw, wape, fip, gfl
  REAL, DIMENSION(klon)                              :: sigmaw, asigmaw, wdens, awdens
  REAL, DIMENSION(klon, klev)                        :: omgbdth
  REAL, DIMENSION(klon, klev)                        :: dp_omgb
  REAL, DIMENSION(klon, klev)                        :: dtke, dqke
  REAL, DIMENSION(klon, klev)                        :: omg
  REAL, DIMENSION(klon, klev)                        :: dp_deltomg, spread
  REAL, DIMENSION(klon)                              :: cstar
  REAL, DIMENSION(klon)                              :: sigd0
  INTEGER, DIMENSION(klon)                           :: ktopw
  REAL, DIMENSION(klon, klev)                        :: d_deltat_gw
  REAL, DIMENSION(klon, klev)                        :: d_deltatw, d_deltaqw
  REAL, DIMENSION(klon)                              :: d_sigmaw, d_asigmaw, d_wdens, d_awdens
#ifdef ISO
  REAL, DIMENSION(ntraciso,klon, klev)               :: xte
  REAL, DIMENSION(ntraciso,klon, klev)               :: dxtdwn
  REAL, DIMENSION(ntraciso,klon, klev)               :: dxta
  REAL, DIMENSION(ntraciso,klon, klev)               :: dxtw
  REAL, DIMENSION(ntraciso,klon, klev)               :: dxtls
  REAL, DIMENSION(ntraciso,klon, klev)               :: xtx
  REAL, DIMENSION(ntraciso,klon, klev)               :: dxtke
  REAL, DIMENSION(ntraciso,klon, klev)               :: d_deltaxtw
  INTEGER                                            :: ixt
#endif

  REAL                                               :: rdcp

  CHARACTER (LEN=20) :: modname = 'calwake'
  CHARACTER (LEN=80) :: abort_message

  IF (prt_level >= 10) THEN
    print *, '-> calwake, wake_s, awake_s, wgen input ', wake_s(1), awake_s(1), wgen(1)
  ENDIF

  rdcp = 1./3.5

  znatsurf(:) = 0
  DO i = 1,klon
    IF (pctsrf(i,is_oce) < 0.1) znatsurf(i) = 1
  ENDDO


  ! -----------------------------------------------------------
  ! IM 290108     DO 999 i=1,klon   ! a vectoriser
  ! ----------------------------------------------------------


  DO l = 1, klev
    DO i = 1, klon
      p(i, l) = pplay(i, l)
      ph(i, l) = paprs(i, l)
      pi(i, l) = (pplay(i,l)/100000.)**rdcp

      te(i, l) = t(i, l)
      qe(i, l) = q(i, l)
      omgbe(i, l) = omgb(i, l)

      dtdwn(i, l) = dt_dwn(i, l)
      dqdwn(i, l) = dq_dwn(i, l)
      dta(i, l) = dt_a(i, l)
      dqa(i, l) = dq_a(i, l)
#ifdef ISO
      DO ixt=1,ntraciso
        xte(ixt,i, l) = xt(ixt,i, l)
        dxtdwn(ixt,i, l) = dxt_dwn(ixt,i, l)
        dxta(ixt,i, l) = dxt_a(ixt,i, l)
      ENDDO
#endif
    ENDDO
  ENDDO

!----------------------------------------------------------------
!         Initialize tendencies to zero
!----------------------------------------------------------------
dtls(:,:) = 0.
dqls(:,:) = 0.
d_deltat_gw(:,:) = 0.
d_deltatw(:,:) = 0.
d_deltaqw(:,:) = 0.
d_sigmaw(:) = 0.
d_asigmaw(:) = 0.
d_wdens(:) = 0.
d_awdens(:) = 0.
#ifdef ISO
dxtls(:,:,:) = 0.
d_deltaxtw(:,:,:) = 0.
#endif
!

  DO i = 1, klon
    sigd0(i) = sigd(i)
  END DO
  ! print*, 'sigd0,sigd', sigd0, sigd(i)
  DO i = 1, klon
    ph(i, klev+1) = 0.
  END DO

!!jyg!  DO i = 1, klon                  
!!jyg!    ktopw(i) = NINT(wake_k(i))    
!!jyg!  END DO                          

  DO i = 1, klon
    hw(i) = wake_h(i)
  END DO
!
!    Make a copy of state variables
  DO l = 1, klev
    DO i = 1, klon
      dtw(i, l) = wake_deltat(i, l)
      dqw(i, l) = wake_deltaq(i, l)
#ifdef ISO
      dxtw(:,i, l) = wake_deltaxt(:,i, l)
#endif
    END DO
  END DO

  DO i = 1, klon
    sigmaw(i)  = wake_s(i)
    asigmaw(i) = awake_s(i)
  END DO

  DO i = 1, klon
    wdens(i) = max(0., wake_dens(i))
    awdens(i) = max(0., awake_dens(i))
  END DO

  ! fkc les flux de masses sont evalues aux niveaux et valent 0 a la surface
  ! fkc  on veut le flux de masse au milieu des couches

  DO l = 1, klev - 1
    DO i = 1, klon
      amdwn(i, l) = 0.5*(m_dwn(i,l)+m_dwn(i,l+1))
      amdwn(i, l) = (m_dwn(i,l+1))
    END DO
  END DO

  ! au sommet le flux de masse est nul

  DO i = 1, klon
    amdwn(i, klev) = 0.5*m_dwn(i, klev)
  END DO

  DO l = 1, klev
    DO i = 1, klon
      amup(i, l) = m_up(i, l)
    END DO
  END DO

#ifdef ISOVERIF
  ! verif des inputs des wakes
  WRITE(*,*) 'calwake 257: verif des inputs des wakes'
  DO l = 1, klev
    DO i = 1, klon
      IF (iso_eau.GT.0) THEN
        CALL iso_verif_egalite(qe(i,l),xte(iso_eau,i,l),'calwake 261a')
        CALL iso_verif_egalite(dqa(i,l),dxta(iso_eau,i,l),'calwake 261b')
        CALL iso_verif_egalite(dqdwn(i,l),dxtdwn(iso_eau,i,l),'calwake 261c')
        CALL iso_verif_egalite(dqw(i,l),dxtw(iso_eau,i,l),'calwake 261d')
      ENDIF
    ENDDO
  ENDDO
#endif

  IF (iflag_wake/10 == 0) THEN
    CALL wake(klon,klev,znatsurf, p, ph, pi, dtime, &
      te, qe, omgbe, &
      dtdwn, dqdwn, amdwn, amup, dta, dqa, wgen, &
      sigd0, Cin, &
      dtw, dqw, sigmaw, asigmaw, wdens, awdens, &                      ! state variables
      dth, hw, wape, fip, gfl, &
      dtls, dqls, ktopw, omgbdth, dp_omgb, tx, qx, &
      dtke, dqke, omg, dp_deltomg, spread, cstar, &
      d_deltat_gw, &
      d_deltatw, d_deltaqw, d_sigmaw, d_asigmaw, d_wdens, d_awdens &   ! tendencies
#ifdef ISO
      ,xte,dxtdwn,dxta,dxtw &
      ,dxtls,xtx,dxtke,d_deltaxtw &
#endif
      )
#ifdef ISOVERIF
  ! verif des ouputs des wakes
  WRITE(*,*) 'calwake 286: verif des outputs des wakes'
  DO l = 1, klev
    DO i = 1, klon
      IF (iso_eau.GT.0) THEN
        CALL iso_verif_egalite(dqls(i,l),dxtls(iso_eau,i,l),'calwake 290a')
        CALL iso_verif_egalite(qx(i,l),xtx(iso_eau,i,l),'calwake 290b')
        CALL iso_verif_egalite(dqke(i,l),dxtke(iso_eau,i,l),'calwake 290c')
        CALL iso_verif_egalite(d_deltaqw(i,l),d_deltaxtw(iso_eau,i,l),'calwake 290d')
        CALL iso_verif_egalite(dqw(i,l),dxtw(iso_eau,i,l),'calwake 290e')
      ENDIF
    ENDDO
  ENDDO
#endif

  ELSE IF (iflag_wake/10 == 2) THEN
#ifdef ISO
    abort_message='Water isotopes not implemented in wake2 yet -> ERROR, ABORT in calwake'
    CALL abort_physic(modname,abort_message, 1)
#endif
    CALL wake2(klon,klev,znatsurf, p, ph, pi, dtime, &
      te, qe, omgbe, &
      dtdwn, dqdwn, amdwn, amup, dta, dqa, wgen, &
      sigd0, Cin, &
      dtw, dqw, sigmaw, asigmaw, wdens, awdens, &                      ! state variables
      dth, hw, wape, fip, gfl, &
      dtls, dqls, ktopw, omgbdth, dp_omgb, tx, qx, &
      dtke, dqke, omg, dp_deltomg, spread, cstar, &
      d_deltat_gw, &
      d_deltatw, d_deltaqw, d_sigmaw, d_asigmaw, d_wdens, d_awdens)    ! tendencies

  ELSE IF (iflag_wake/10 == 3) THEN
#ifdef ISO
    abort_message='Water isotopes not implemented in wake3 yet -> ERROR, ABORT in calwake'
    CALL abort_physic(modname,abort_message, 1)
#endif
    CALL wake3(klon,klev,znatsurf, p, ph, pi, dtime, &
      te, qe, omgbe, &
      dtdwn, dqdwn, amdwn, amup, dta, dqa, wgen, &
      sigd0, Cin, &
      dtw, dqw, sigmaw, asigmaw, wdens, awdens, &                      ! state variables
      dth, hw, wape, fip, gfl, &
      dtls, dqls, ktopw, omgbdth, dp_omgb, tx, qx, &
      dtke, dqke, omg, dp_deltomg, spread, cstar, &
      d_deltat_gw, &
      d_deltatw, d_deltaqw, d_sigmaw, d_asigmaw, d_wdens, d_awdens)      ! tendencies

  END IF  !(iflag_wake/10 == 0)

  DO l = 1, klev
    DO i = 1, klon
      IF (ktopw(i)>0) THEN
        wake_d_deltat_gw(i, l) = d_deltat_gw(i, l)
        wake_omgbdth(i, l) = omgbdth(i, l)
        wake_dp_omgb(i, l) = dp_omgb(i, l)
        wake_dtke(i, l) = dtke(i, l)
        wake_dqke(i, l) = dqke(i, l)
        wake_omg(i, l) = omg(i, l)
        wake_dp_deltomg(i, l) = dp_deltomg(i, l)
        wake_spread(i, l) = spread(i, l)
        wake_dth(i, l) = dth(i, l)
        dt_wake(i, l) = dtls(i, l)*dtime         ! derivative -> tendency
        dq_wake(i, l) = dqls(i, l)*dtime         ! derivative -> tendency
        t_x(i, l) = tx(i, l)
        q_x(i, l) = qx(i, l)
#ifdef ISO
        DO ixt=1,ntraciso
          wake_dxtke(ixt,i, l) = dxtke(ixt,i, l)
          dxt_wake(ixt,i, l) = dxtls(ixt,i, l)*dtime
          xt_x(ixt,i, l) = xtx(ixt,i, l)
        ENDDO
#endif
      ELSE
        wake_d_deltat_gw(i, l) = 0.
        wake_omgbdth(i, l) = 0.
        wake_dp_omgb(i, l) = 0.
        wake_dtke(i, l) = 0.
        wake_dqke(i, l) = 0.
        wake_omg(i, l) = 0.
        wake_dp_deltomg(i, l) = 0.
        wake_spread(i, l) = 0.
        wake_dth(i, l) = 0.
        dt_wake(i, l) = 0.
        dq_wake(i, l) = 0.
        t_x(i, l) = te(i, l)
        q_x(i, l) = qe(i, l)
#ifdef ISO
        DO ixt=1,ntraciso
          wake_dxtke(ixt,i, l) = 0.
          dxt_wake(ixt,i, l) = 0.
          xt_x(ixt,i, l) = xte(ixt,i, l)
        ENDDO
#endif
      ENDIF
    ENDDO
  ENDDO

  DO i = 1, klon
    wake_h(i) = hw(i)
    wake_pe(i) = wape(i)
    wake_fip(i) = fip(i)
    wake_gfl(i) = gfl(i)
    wake_k(i) = ktopw(i)
    wake_cstar(i) = cstar(i)
  ENDDO

!  Tendencies of state variables
  DO l = 1, klev
    DO i = 1, klon
      IF (ktopw(i)>0) THEN
        wake_ddeltat(i, l) = d_deltatw(i, l)*dtime
        wake_ddeltaq(i, l) = d_deltaqw(i, l)*dtime
#ifdef ISO
        DO ixt=1,ntraciso
          wake_ddeltaxt(ixt,i, l) = d_deltaxtw(ixt,i, l)*dtime
        ENDDO
#endif
      ELSE
        wake_ddeltat(i, l) = -wake_deltat(i, l)
        wake_ddeltaq(i, l) = -wake_deltaq(i, l)
#ifdef ISO
        DO ixt=1,ntraciso
          wake_ddeltaxt(ixt,i, l) = -wake_deltaxt(ixt,i, l)
        ENDDO
#endif
      ENDIF
    ENDDO
  ENDDO
  DO i = 1, klon
    IF (ktopw(i)>0) THEN
      wake_ds(i)    = d_sigmaw(i)*dtime
      awake_ds(i)   = d_asigmaw(i)*dtime
      awake_ddens(i)= d_awdens(i)*dtime
      wake_ddens(i) = d_wdens(i)*dtime
    ELSE
      wake_ds(i)    = -wake_s(i)
      awake_ds(i)   = -awake_s(i)
      wake_ddens(i) = -wake_dens(i)
      awake_ddens(i)= -awake_dens(i)
    END IF
  END DO
!

!jyg<  
  IF (iflag_wake_tend .EQ. 0) THEN
!  Update State variables
    DO l = 1, klev
      DO i = 1, klon
        IF (ktopw(i)>0) THEN
          wake_deltat(i, l) = dtw(i, l)
          wake_deltaq(i, l) = dqw(i, l)
#ifdef ISO
          DO ixt=1,ntraciso
            wake_deltaxt(ixt,i, l) = dxtw(ixt,i, l)
          ENDDO
#endif
        ELSE
          wake_deltat(i, l) = 0.
          wake_deltaq(i, l) = 0.
#ifdef ISO
          DO ixt=1,ntraciso
            wake_deltaxt(ixt,i, l) = 0.
          ENDDO
#endif
        END IF
      END DO
    END DO
    DO i = 1, klon
      wake_s(i) = sigmaw(i)
      awake_s(i) = asigmaw(i)
      awake_dens(i) = awdens(i)
      wake_dens(i) = wdens(i)
    END DO
  ENDIF  ! (iflag_wake_tend .EQ. 0)
!
  DO i = 1,klon
    IF (first(i)) THEN
      IF (wake_dens(i) < -1.) THEN
        wake_dens(i) = wdens(i)
      ENDIF
      first(i)=.FALSE.
    ENDIF  ! (first)
  ENDDO

!>jyg
  IF (prt_level >= 10) THEN
    print *, 'calwake ->, wake_s, awake_s ', wake_s(1), awake_s(1)
  ENDIF

  RETURN
END SUBROUTINE calwake

END MODULE calwake_mod
