Changeset 4982 for LMDZ6/trunk/libf/phylmdiso/isotopes_routines_mod.F90

Timestamp:

Jun 15, 2024, 5:17:08 PM (11 days ago)

Author:

crisi

Message:

suppress isotope_params.def + update physiq_mod + proof of concept of 3rd dimension with reevap routine

File:

• LMDZ6/trunk/libf/phylmdiso/isotopes_routines_mod.F90 (modified) (7 diffs)

LMDZ6/trunk/libf/phylmdiso/isotopes_routines_mod.F90

@@ -1525 +1525 @@
 #endif       
        pxtfra=max(min(pxtfra,alpha_max),0.0)
-
 
       end subroutine fractcalk_liq
@@ -15922 +15921 @@
 
       ! verif
-!      text="phyisoetat0 67"
-!      write(*,*) 'snow(8,1)=',snow(8,1)
-!      write(*,*) 'xtsnow(4,8,1)=',xtsnow(4,8,1)
 #ifdef ISOVERIF
       do i=1,klon
@@ -15934 +15930 @@
          enddo !do ixt=1,niso
       enddo !do i=1,klon
-#endif      
-#ifdef ISOVERIF
       do i=1,klon
          if (iso_eau.gt.0) then
@@ -16021 +16015 @@
          endif 
        enddo !do i=1,klon
-
 #endif
       !end verif
@@ -16128 +16121 @@
           deltaD_run_off_lic_0(ixt)=deltaD_sol(ixt)
           deltaD_land_ice(ixt)=deltaD_snow(ixt)
-          call fractcalk_liq(ixt, 283.0, alpha(ixt))            
+          call fractcalk_liq(ixt, 283.0, alpha(ixt))    
         enddo !do ixt=1,niso
         call calcul_kcin(2.0,kcin) 
@@ -18830 +18823 @@
         if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO)) then
             if (q.gt.ridicule) then
+                    write(*,*) 'xt,q=',xt,q
+                    write(*,*) 'alpha=',alpha
+                    write(*,*) 'toce,kcin,h0=',toce,kcin,h0
+                    write(*,*) 'RMerlivat=',RMerlivat
                 call iso_verif_aberrant_encadre( xt/q, 'isotopes_routines_mod 18930b: iso_init_ideal')
             endif
@@ -18902 +18899 @@
 end subroutine appel_stewart_debug
 
+
+subroutine dispatch(klon,klev,qx,q_seri,xt_seri,ql_seri,xtl_seri,qs_seri,xts_seri)
+
+use infotrac_phy, ONLY: nqtot,nqo,ivap,iliq,isol,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
+real,dimension(ntraciso,klon,klev), intent(out) :: xt_seri,xtl_seri,xts_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.EQ.2) THEN             !--vapour and liquid only
+             qs_seri(i,k) = 0.
+    ELSE IF (nqo.ge.3) THEN        !--vapour, liquid and ice
+             qs_seri(i,k) = qx(i,k,isol)
+    ENDIF
+    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.eq.2) then
+             xts_seri(ixt,i,k) = 0.
+          else if (nqo.eq.3) then
+             xts_seri(ixt,i,k) = qx(i,k,iqIsoPha(ixt,isol))
+          endif
+    enddo !do ixt=1,niso
+
+enddo
+enddo
+
+end subroutine dispatch
+
+subroutine together(klon,klev,qx,q_seri,xt_seri,ql_seri,xtl_seri,qs_seri,xts_seri)
+
+use infotrac_phy, ONLY: nqtot,nqo,ivap,iliq,isol,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(ntraciso,klon,klev), intent(in) :: xt_seri,xtl_seri,xts_seri
+
+! inputs
+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) THEN        !--vapour, liquid and ice
+             qx(i,k,isol) = qs_seri(i,k)
+    ENDIF
+    do ixt=1,ntraciso
+          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) then
+             qx(i,k,iqIsoPha(ixt,isol)) = xts_seri(ixt,i,k)
+          endif
+    enddo !do ixt=1,niso
+
+enddo
+enddo
+
+end subroutine together
+
+
 END MODULE isotopes_routines_mod
 #endif