Changeset 5885 for LMDZ6/branches/PBLSURF_GPUPORT/libf/phylmd/yamada_c.F90

Timestamp:

Nov 24, 2025, 6:39:59 PM (6 weeks ago)

Author:

yann meurdesoif

Message:

yamada_c : bug fix

• mismatch index on zlev
• uninitialized levels

+ GPU port of yamada_c
YM

File:

• LMDZ6/branches/PBLSURF_GPUPORT/libf/phylmd/yamada_c.F90 (modified) (10 diffs)

LMDZ6/branches/PBLSURF_GPUPORT/libf/phylmd/yamada_c.F90

@@ -2 +2 @@
 ! $Header$
 !
+MODULE yamada_c_mod
+  PRIVATE
+
+  INTEGER, SAVE :: iflag_tke_diff=0
+  !$OMP THTREADPRIVATE(iflag_tke_diff) 
+
+  PUBLIC :: yamada_c_init, yamada_c
+
+CONTAINS
+      
+      SUBROUTINE yamada_c_init
+      USE ioipsl_getin_p_mod, ONLY : getin_p
+      IMPLICIT NONE
+
+        CALL getin_p('iflag_tke_diff',iflag_tke_diff)
+
+      END SUBROUTINE yamada_c_init
+      
+
       SUBROUTINE yamada_c(klon, ngrid,timestep,plev,play &
      &   ,pu,pv,pt,d_u,d_v,d_t,cd,q2,km,kn,kq,d_t_diss,ustar &
      &   ,iflag_pbl)
+!$gpum horizontal klon ngrid
       USE dimphy, ONLY: klev
       USE print_control_mod, ONLY: prt_level
-      USE ioipsl_getin_p_mod, ONLY : getin_p
       USE yamada4_mod, ONLY : vdif_q2
       USE yomcst_mod_h
@@ -80 +99 @@
       integer nlay,nlev
 
-      logical first
-      integer ipas
-      save first,ipas
+!ym      logical first
+!ym      integer ipas
+!ym      save first,ipas
 !FH/IM     data first,ipas/.true.,0/
-      data first,ipas/.false.,0/
-!$OMP THREADPRIVATE( first,ipas)
-       INTEGER, SAVE :: iflag_tke_diff=0
-!$OMP THREADPRIVATE(iflag_tke_diff)
+!ym      data first,ipas/.false.,0/
+!ym!$OMP THREADPRIVATE( first,ipas)
+!ym       INTEGER, SAVE :: iflag_tke_diff=0
+!ym!$OMP THREADPRIVATE(iflag_tke_diff)
 
 
@@ -102 +121 @@
       real l(klon,klev+1)
       real leff(klon,klev+1)
-      real,allocatable,save :: l0(:)
-!$OMP THREADPRIVATE(l0)      
+      real l0(klon)
+!ym      real,allocatable,save :: l0(:)
+!ym!$OMP THREADPRIVATE(l0)      
       real sq(klon),sqz(klon),zz(klon,klev+1)
       integer iter
 
-      real ric,rifc,b1,kap
-      save ric,rifc,b1,kap
-      data ric,rifc,b1,kap/0.195,0.191,16.6,0.4/
-!$OMP THREADPRIVATE(ric,rifc,b1,kap)
+!ym      real ric,rifc,b1,kap
+!ym      save ric,rifc,b1,kap
+!ym      data ric,rifc,b1,kap/0.195,0.191,16.6,0.4/
+!ym!$OMP THREADPRIVATE(ric,rifc,b1,kap)
+      real, parameter :: ric=0.195,rifc=0.191,b1=16.6,kap=0.4
       real frif,falpha,fsm
       real fl,zzz,zl0,zq2,zn2
@@ -117 +138 @@
       real lyam(klon,klev),knyam(klon,klev)
       real w2yam(klon,klev),t2yam(klon,klev)
-      logical,save :: firstcall=.true.
-!$OMP THREADPRIVATE(firstcall)       
+!ym      logical,save :: firstcall=.true.
+!ym!$OMP THREADPRIVATE(firstcall)       
       CHARACTER(len=20),PARAMETER :: modname="yamada_c"
 REAL, DIMENSION(klon,klev+1) :: fluxu,fluxv,fluxt
@@ -129 +150 @@
       falpha(ri)=1.318*(0.2231-ri)/(0.2341-ri)
       fsm(ri)=1.96*(0.1912-ri)*(0.2341-ri)/((1.-ri)*(0.2231-ri))
+!ym   pas glop! pas glop!
+!ym      fl(zzz,zl0,zq2,zn2)= &
+!ym     &     max(min(zl0(ig)*kap*zlev(ig,k)/(kap*zlev(ig,k)+l0(ig)) &
+!ym     &     ,0.5*sqrt(q2(ig,k))/sqrt(max(n2(ig,k),1.e-10))) ,1.)
       fl(zzz,zl0,zq2,zn2)= &
-     &     max(min(l0(ig)*kap*zlev(ig,k)/(kap*zlev(ig,k)+l0(ig)) &
-     &     ,0.5*sqrt(q2(ig,k))/sqrt(max(n2(ig,k),1.e-10))) ,1.)
+     &     max(min(zl0*kap*zzz/(kap*zzz+zl0) &
+     &     ,0.5*sqrt(zq2)/sqrt(max(zn2,1.e-10))) ,1.)
 
 
       okiophys=klon==1
-      if (firstcall) then
-        CALL getin_p('iflag_tke_diff',iflag_tke_diff)
-        allocate(l0(klon))
-        firstcall=.false.
-      endif
+!ym      if (firstcall) then
+!ym        CALL getin_p('iflag_tke_diff',iflag_tke_diff)
+!ym        allocate(l0(klon))
+!ym        firstcall=.false.
+!ym      endif
 
    IF (ngrid<=0) RETURN ! Bizarre : on n a pas ce probeleme pour coef_diff_turb
@@ -175 +200 @@
    do k=1,klev-1
       zlay(:,k+1)=zlay(:,k)+0.5*RCPD*(teta(:,k)+teta(:,k+1))*(exner(:,k)-exner(:,k+1))/RG
-      zlev(:,k)=0.5*(zlay(:,k)+zlay(:,k+1)) ! PASBO
+      zlev(:,k+1)=0.5*(zlay(:,k)+zlay(:,k+1)) ! PASBO
+                                              ! ym bugfix : zlev(:,k) => zlev(:,k+1)
    enddo
 
@@ -220 +246 @@
 
 
-      ipas=ipas+1
+!ym      ipas=ipas+1
 
 
@@ -312 +338 @@
       l0(ig)=0.2*sqz(ig)/sq(ig)
                                                           enddo
+      l(:,1) = 0.
+      l(:,klev+1) = 0.
       do k=2,klev
                                                           do ig=1,ngrid
@@ -326 +354 @@
 
           l0(:)=150.
+          l(:,1) = 0.
+          l(:,klev+1) = 0.
           do k=2,klev
                                                           do ig=1,ngrid
@@ -480 +510 @@
       RETURN
       END SUBROUTINE yamada_c
+
+END MODULE yamada_c_mod