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 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)) = qbs_seri(i,k) IF (icf.NE.0) & !--cloud fraction qx(i,k,iqIsoPha(ixt,icf)) = cf_seri(i,k) IF (irvc.NE.0) & !--cloud vapor ratio qx(i,k,iqIsoPha(ixt,irvc))= rvc_seri(i,k) ENDDO ENDDO ENDDO !do ixt=1,niso END SUBROUTINE tracq_together END MODULE tracq_mod