Changeset 5480 for LMDZ6

Timestamp:

Jan 16, 2025, 6:32:38 PM (7 hours ago)

Author:

yann meurdesoif

Message:

For GPU porting :

• add wrapper for source to source tools
• Separate initialization phase of lscp_old (firstilp), SAVE variable in compute subroutine cannot be managed properly.

YM

Location:

LMDZ6/trunk/libf/phylmd

Files:

• lmdz_lscp_old.f90 (modified) (9 diffs)
• physiq_mod.F90 (modified) (4 diffs)
• s2s.F90 (added)

LMDZ6/trunk/libf/phylmd/lmdz_lscp_old.f90

@@ -3 +3 @@
 !
 MODULE lmdz_lscp_old
+  PRIVATE
+
+  INTEGER, PARAMETER :: ninter=5 ! sous-intervals pour la precipitation
+  LOGICAL, PARAMETER :: cpartiel=.TRUE. ! condensation partielle
+  REAL, PARAMETER :: t_coup=234.0
+  REAL, PARAMETER :: DDT0=.01
+  REAL, PARAMETER :: ztfondue=278.15
+
+  LOGICAL, SAVE :: appel1er=.TRUE.
+  !$OMP THREADPRIVATE(appel1er)
+ 
+  PUBLIC fisrtilp_first, fisrtilp
+
 CONTAINS
+
+! firstilp first call part
+SUBROUTINE fisrtilp_first(klon, klev, dtime, pfrac_nucl, pfrac_1nucl, pfrac_impa)
+USE lmdz_lscp_ini, ONLY: prt_level, lunout
+IMPLICIT NONE
+  REAL, INTENT(IN)     :: dtime  ! intervalle du temps (s)
+  INTEGER, INTENT(IN)  :: klon, klev
+  INTEGER :: i, k
+
+  !AA
+  ! Coeffients de fraction lessivee : pour OFF-LINE
+  !
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: pfrac_nucl
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: pfrac_1nucl
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: pfrac_impa
+
+  IF (appel1er) THEN
+    WRITE(lunout,*) 'fisrtilp, ninter:', ninter
+    WRITE(lunout,*) 'fisrtilp, cpartiel:', cpartiel
+    WRITE(lunout,*) 'FISRTILP VERSION LUDO'
+     
+    IF (ABS(dtime/REAL(ninter)-360.0).GT.0.001) THEN
+     WRITE(lunout,*) 'fisrtilp: Ce n est pas prevu, voir Z.X.Li', dtime
+     WRITE(lunout,*) 'Je prefere un sous-intervalle de 6 minutes'
+     !         CALL abort
+    ENDIF
+    !
+    !cdir collapse
+    DO k = 1, klev
+      DO i = 1, klon
+        pfrac_nucl(i,k)=1.
+        pfrac_1nucl(i,k)=1.
+        pfrac_impa(i,k)=1.
+      ENDDO
+    ENDDO
+    appel1er = .FALSE.
+  ENDIF
+  
+END SUBROUTINE fisrtilp_first
+
 SUBROUTINE fisrtilp(klon,klev,dtime,paprs,pplay,t,q,ptconv,ratqs,sigma_qtherm, &
      d_t, d_q, d_ql, d_qi, rneb,rneblsvol,radliq, rain, snow,          &
@@ -117 +170 @@
   REAL :: smallestreal
 
-  INTEGER, PARAMETER :: ninter=5 ! sous-intervals pour la precipitation
-  LOGICAL, PARAMETER :: cpartiel=.TRUE. ! condensation partielle
-  REAL, PARAMETER :: t_coup=234.0
-  REAL, PARAMETER :: DDT0=.01
-  REAL, PARAMETER :: ztfondue=278.15
-  ! --------------------------------------------------------------------------------
+ ! --------------------------------------------------------------------------------
   !
   ! Variables locales:
@@ -142 +190 @@
 
   REAL, DIMENSION(klon) :: zpdf_sig,zpdf_k,zpdf_delta, Zpdf_a,zpdf_b,zpdf_e1,zpdf_e2, qcloud
-  REAL :: erf   
  
   REAL :: zqev, zqevt, zqev0,zqevi, zqevti, zdelq 
@@ -165 +212 @@
   REAL, DIMENSION(klon) :: zmqc
   !
-  LOGICAL, SAVE :: appel1er=.TRUE.
-  !$OMP THREADPRIVATE(appel1er)
   !
 ! iflag_oldbug_fisrtilp=0 enleve le BUG par JYG : tglace_min -> tglace_max
@@ -196 +241 @@
   REAL, DIMENSION(klon) :: zlh_solid
   REAL :: zm_solid
+  REAL :: tmp_var1d(klon) ! temporary variable for call site
 
 
@@ -218 +264 @@
 
   if (prt_level>9)write(lunout,*)'NUAGES4 A. JAM'
-  IF (appel1er) THEN
-     WRITE(lunout,*) 'fisrtilp, ninter:', ninter
-     WRITE(lunout,*) 'fisrtilp, cpartiel:', cpartiel
-     WRITE(lunout,*) 'FISRTILP VERSION LUDO'
-     
-     IF (ABS(dtime/REAL(ninter)-360.0).GT.0.001) THEN
-        WRITE(lunout,*) 'fisrtilp: Ce n est pas prevu, voir Z.X.Li', dtime
-        WRITE(lunout,*) 'Je prefere un sous-intervalle de 6 minutes'
-        !         CALL abort
-     ENDIF
-     appel1er = .FALSE.
-     !
-     !cdir collapse
-     DO k = 1, klev
-        DO i = 1, klon
-           pfrac_nucl(i,k)=1.
-           pfrac_1nucl(i,k)=1.
-           pfrac_impa(i,k)=1.
-           beta(i,k)=0.  !RomP initialisation
-        ENDDO
-     ENDDO
-
-  ENDIF          !  test sur appel1er
+
+  beta(:,:)=0.  !RomP initialisation => ym : could be probably removed but keept by security
+
   !
   !MAf Initialisation a 0 de zoliq
@@ -954 +980 @@
                  ! --------------------------
                  if (iflag_t_glace.ge.1) then
-                 CALL icefrac_lsc(klon,zt(:),pplay(:,k)/paprs(:,1),zfice(:))
+                   tmp_var1d(:) = pplay(:,k)/paprs(:,1)
+                   CALL icefrac_lsc(klon, zt(:), tmp_var1d, zfice(:))
                  endif
 
@@ -1123 +1150 @@
      ELSE
          if (iflag_t_glace.ge.1) then
-            CALL icefrac_lsc(klon,zt(:),pplay(:,k)/paprs(:,1),zfice(:))
+            tmp_var1d(:) = pplay(:,k)/paprs(:,1)
+            CALL icefrac_lsc(klon,zt(:),tmp_var1d,zfice(:))
          endif
          if (iflag_fisrtilp_qsat.lt.1) then
@@ -1242 +1270 @@
          ENDDO
        ELSE ! of IF (iflag_t_glace.EQ.0)
-         CALL icefrac_lsc(klon,zt(:),pplay(:,k)/paprs(:,1),zfice(:))
+         tmp_var1d(:) = pplay(:,k)/paprs(:,1)
+         CALL icefrac_lsc(klon,zt(:), tmp_var1d, zfice(:))
 !         DO i = 1, klon
 !            IF (rneb(i,k).GT.0.0) THEN

LMDZ6/trunk/libf/phylmd/physiq_mod.F90

@@ -77 +77 @@
     USE lmdz_lscp, ONLY : lscp
     USE lmdz_call_cloud_optics_prop, ONLY : call_cloud_optics_prop
-    USE lmdz_lscp_old, ONLY : fisrtilp
+    USE lmdz_lscp_old, ONLY : fisrtilp, fisrtilp_first
     USE lmdz_call_blowing_snow, ONLY : call_blowing_snow_sublim_sedim
     USE lmdz_wake_ini, ONLY : wake_ini
@@ -374 +374 @@
        USE phys_output_write_spl_mod, ONLY: phys_output_write_spl
        USE phytracr_spl_mod, ONLY: phytracr_spl_out_init, phytracr_spl
+       USE s2s, ONLY : s2s_initialize
     IMPLICIT NONE
     !>======================================================================
@@ -1346 +1347 @@
 
     IF (first) THEN
+        
+        CALL s2s_initialize     ! initialization of source to source tools
+        
 !       CALL init_etat0_limit_unstruct
 !       IF (.NOT. create_etat0_limit) CALL init_limit_read(days_elapsed)
@@ -3896 +3900 @@
 
     ELSE
-
+    
+    CALL fisrtilp_first(klon, klev, phys_tstep, pfrac_impa, pfrac_nucl, pfrac_1nucl)
     CALL fisrtilp(klon,klev,phys_tstep,paprs,pplay, &
          t_seri, q_seri,ptconv,ratqs,sigma_qtherm, &