
MODULE tracq_mod

  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !!   SN : 5/06/2026 version de demonstration a finaliser                       !!
  !!   MODULE tracq_mod :                                                        !!
  !!                                                                             !! 
  !!   contient : tracq_dispatch et tracq_together                               !!
  !!   routines utilisées pour faciliter les développements lors du passage      !!
  !!   de tableaux "individuels pour chaque phase"                               !!
  !!   a un tableau "unique pour tous les traceurs dans toutes leurs phases"     !! 
  !!                                                                             !!
  !!   tracq_dispatch :                                                          !!
  !!   les parties du tableau unique sont copiées dans les tableaux individuels  !!
  !!                                                                             !!
  !!   tracq_together :                                                          !!
  !!   les tableaux individuels sont copiées dans le tableau unique              !!
  !!                                                                             !!
  !!   ceci permet de travailler sur chaque routine de physiq_mod indépendemment !!
  !!                                                                             !!
  !!   exemple pour reevap :                                                     !!
  !!   CALL tracq_together                                                       !!
  !!       "mettre tous les q_seri, ql_seri etc... dans qx et d_qx_eva           !!
  !!   CALL call_reevap(klon,klev,abortphy,flag_inhib_tend,itap, &               !!
  !!                        t_seri,qx,paprs,   &                                 !! 
  !!                        d_t_eva,d_qx_eva)                                    !!
  !!   CALL tracq_dispatch                                                       !! 
  !!       "remplir les sous tableaux q_seri, ql_seri etc..."                    !!
  !!   ON PEUT AINSI VERIFIER APRES REECRITURE QUE REEVAP CONSERVE LE RESULTAT   !!
  !!                                                                             !!
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  PRIVATE

  PUBLIC :: tracq_dispatch ! copie du tableau de traceur gobal dans les tableaux individuels
  PUBLIC :: tracq_together ! copie des tableaux individuels dans le tableau de traceur global 

  IMPLICIT NONE
 
CONTAINS 
 
  SUBROUTINE tracq_dispatch(klon,klev,qx, &
                            q_seri,xt_seri,ql_seri,xtl_seri,qs_seri,xts_seri, &
                            qbs_seri,xtbs_seri, &
                            cf_seri,xtcf_seri, &
                            rvc_seri,xtrvc_seri &
                           )

    USE infotrac_phy, ONLY: nqtot,nqo,ivap,iliq,isol, &
                            ibs,icf,irvc, &
                            itke, &
                            iqIsoPha,ntraciso=>ntiso
    IMPLICIT NONE

    ! inputs
    INTEGER, INTENT(IN) :: klon,klev
    REAL,DIMENSION(klon,klev,nqtot), INTENT(IN) ::qx

    ! outputs
    REAL,DIMENSION(klon,klev), INTENT(OUT) ::q_seri,ql_seri,qs_seri,qbs_seri,cf_seri,rvc_seri
    REAL,DIMENSION(ntraciso,klon,klev), INTENT(OUT) :: xt_seri,xtl_seri,xts_seri,xtbs_seri,xtcf_seri,xtrvc_seri

    ! locals
    INTEGER :: i,k,ixt

    DO k=1,klev
    DO i=1,klon
      q_seri(i,k)  = qx(i,k,ivap)
      ql_seri(i,k) = qx(i,k,iliq)
      IF (nqo.GE.3) &        !--vapour, liquid and ice
        qs_seri(i,k)  = qx(i,k,isol)
      IF (ibs.NE.0) &        !--blown snow
        qbs_seri(i,k) = qx(i,k,ibs)
      IF (icf.NE.0) &        !--cloud fraction
        cf_seri(i,k)  = qx(i,k,icf)
      IF (irvc.NE.0) &       !--cloud vapor ratio
        rvc_seri(i,k) = qx(i,k,irvc)

      DO ixt=1,ntraciso
        xt_seri(ixt,i,k)  = qx(i,k,iqIsoPha(ixt,ivap))
        xtl_seri(ixt,i,k) = qx(i,k,iqIsoPha(ixt,iliq))
        IF (nqo.GE.3) &      !--vapour, liquid and ice
          xts_seri(ixt,i,k)  = qx(i,k,iqIsoPha(ixt,isol))
        IF (ibs.NE.0) &      !--blown snow
          xtbs_seri(ixt,i,k) = qx(i,k,iqIsoPha(ixt,ibs))
        IF (icf.NE.0) &      !--cloud fraction
          xtcf_seri(ixt,i,k) = qx(i,k,iqIsoPha(ixt,icf))
        IF (irvc.NE.0) &     !--cloud vapor ratio
          xtrvc_seri(ixt,i,k)= qx(i,k,iqIsoPha(ixt,irvc))
      ENDDO !do ixt=1,niso
    ENDDO
    ENDDO

  END SUBROUTINE tracq_dispatch

  SUBROUTINE tracq_together(klon,klev,qx, &
                            q_seri,xt_seri,ql_seri,xtl_seri,qs_seri,xts_seri, &
                            qbs_seri,xtbs_seri, &
                            cf_seri,xtcf_seri, &
                            rvc_seri,xtrvc_seri &
                           )

    USE infotrac_phy, ONLY: nqtot,nqo,ivap,iliq,isol, &
                            ibs,icf,irvc, &
                            itke, &
                            iqIsoPha,ntraciso=>ntiso

    IMPLICIT NONE

    ! inputs
    INTEGER, INTENT(IN) :: klon,klev
    REAL,DIMENSION(klon,klev), INTENT(IN) :: q_seri,ql_seri,qs_seri
    REAL,DIMENSION(klon,klev), INTENT(IN) :: qbs_seri,cf_seri,rvc_seri
    REAL,DIMENSION(ntraciso,klon,klev), INTENT(IN) :: xt_seri,xtl_seri,xts_seri
    REAL,DIMENSION(ntraciso,klon,klev), INTENT(IN) :: xtbs_seri,xtcf_seri,xtrvc_seri

    ! outputs
    REAL,DIMENSION(klon,klev,nqtot), INTENT(OUT) ::qx

    ! locals
    INTEGER :: i,k,ixt

    DO k=1,klev
    DO i=1,klon  

      qx(i,k,ivap) =  q_seri(i,k)
      qx(i,k,iliq) = ql_seri(i,k)
      IF (nqo.GE.3) &             !--vapour, liquid and ice
        qx(i,k,isol) = qs_seri(i,k)
      IF (ibs.NE.0) &             !--blown snow
        qx(i,k,ibs) = qbs_seri(i,k)
      IF (icf.NE.0) &             !--cloud fraction
        qx(i,k,icf) =  cf_seri(i,k)
      IF (irvc.NE.0) &            !--cloud vapor ratio
        qx(i,k,irvc)= rvc_seri(i,k) 
    ENDDO
    ENDDO


 
    DO ixt=1,ntraciso

      DO k=1,klev
      DO i=1,klon  
        qx(i,k,iqIsoPha(ixt,ivap)) = xt_seri(ixt,i,k)  
        qx(i,k,iqIsoPha(ixt,iliq)) = xtl_seri(ixt,i,k)
        IF (nqo.GE.3) &           !--vapour, liquid and ice
          qx(i,k,iqIsoPha(ixt,isol)) = xts_seri(ixt,i,k)
        IF (ibs.NE.0) &           !--blown snow
          qx(i,k,iqIsoPha(ixt,ibs)) = xtqbs_seri(i,k)
        IF (icf.NE.0) &           !--cloud fraction
          qx(i,k,iqIsoPha(ixt,icf)) =  xtcf_seri(i,k)
        IF (irvc.NE.0) &          !--cloud vapor ratio
          qx(i,k,iqIsoPha(ixt,irvc))= xtrvc_seri(i,k)
      ENDDO
      ENDDO

    ENDDO !do ixt=1,niso

  END SUBROUTINE tracq_together

END MODULE tracq_mod
