Changeset 5950 for LMDZ6/trunk/libf/phylmd/pbl_surface_mod.F90

Timestamp:

Dec 18, 2025, 5:46:30 PM (2 weeks ago)

Author:

yann meurdesoif

Message:

GPU port of cdrag + call_atke + coef_diff_turb
Merge of commit r5876
YM

File:

• LMDZ6/trunk/libf/phylmd/pbl_surface_mod.F90 (modified) (46 diffs)

LMDZ6/trunk/libf/phylmd/pbl_surface_mod.F90

@@ -108 +108 @@
     USE dimsoil_mod_h, ONLY: nsoilmx
     USE flux_arp_mod_h
+    USE cdrag_mod, ONLY : cdrag_init
     IMPLICIT NONE
  
@@ -260 +261 @@
     CALL wx_pbl_init
 !>jyg
+
+    CALL cdrag_init
 
   END SUBROUTINE pbl_surface_init
@@ -1645 +1648 @@
     USE surf_param_mod, ONLY: eff_surf_param  !AM
     USE yomcst_mod_h
-    USE phys_local_var_mod, only: l_mixmin, l_mix
+    USE phys_local_var_mod, only: l_mixmin, l_mix, wprime
 IMPLICIT NONE
 
@@ -2015 +2018 @@
  runoff(:)=0. ; icesub_lic(:)=0.
  l_mixmin(:,:,:)=0.
- l_mix(:,:,:)=0.
+ l_mix(:,:,:) = 0.
+ wprime(:,:,:) = 0 
 #ifdef ISO
 zxxtevap(:,:)=0.
@@ -2324 +2328 @@
        delp, d_t_diss_x, d_t_diss_w, flux_t_x, flux_q_x, flux_t_w, flux_q_w,&
        flux_u_x, flux_v_x, flux_u_w, flux_v_w, fluxlat_x, fluxlat_w)
+!$gpum horizontal knon
+
+
 !****************************************************************************************
 ! Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
@@ -2435 +2442 @@
     USE lmdz_checksum, ONLY : checksum
     USE mod_phys_lmdz_para, ONLY : is_master
+    USE cdrag_mod, ONLY : cdrag
+
 IMPLICIT NONE
 
@@ -3272 +3281 @@
             ENDDO
             !
+
             CALL eff_surf_param(knon, nbtersrf, yz0m_tersrf, yfrac_tersrf, 'CDN', yz0m, zgeo1/RG)
             CALL eff_surf_param(knon, nbtersrf, yz0h_tersrf, yfrac_tersrf, 'CDN', yz0h, zgeo1/RG)
@@ -3280 +3290 @@
 !
         ypblh_tmp(:)=s_pblh(ni(:))
+
         CALL cdrag(knon, nsrf, &
             speed, yt(:,1), yq(:,1), zgeo1, ypaprs(:,1), ypblh_tmp, &
@@ -3327 +3338 @@
 
         ypblh_tmp(:)=s_pblh_w(ni(:))
+
         CALL cdrag(knon, nsrf, &
             speed_w, yt_w(:,1), yq_w(:,1), zgeo1_w, ypaprs(:,1),s_pblh_w,&
@@ -3372 +3384 @@
 
         IF (iflag_pbl>=50) THEN
+
         CALL call_atke(dtime,knon,klev,nsrf,ni,ycdragm, ycdragh,yus0,yvs0,yts, &
                   yu, yv,yt,yq,ypplay,ypaprs,       &
@@ -3377 +3390 @@
 
         ELSE
+
 
         CALL coef_diff_turb(dtime, nsrf, knon, ni,  &
@@ -3421 +3435 @@
 
         ELSE
+
 
         CALL coef_diff_turb(dtime, nsrf, knon, ni,  &
@@ -3456 +3471 @@
         IF (iflag_pbl>=50) THEN
         
-        CALL call_atke(dtime,knon,klev,nsrf,ni,ycdragm_w(1:knon),ycdragh_w(1:knon),yus0(1:knon),yvs0(1:knon),yts_w(1:knon), &
-                yu_w(1:knon,:),yv_w(1:knon,:),yt_w(1:knon,:),yq_w(1:knon,:),ypplay(1:knon,:),ypaprs(1:knon,:),      &
-                ytke_w(1:knon,:),yeps_w(1:knon,:),ycoefm_w(1:knon,:),ycoefh_w(1:knon,:))
+
+        CALL call_atke(dtime,knon,klev,nsrf,ni,ycdragm_w,ycdragh_w,yus0,yvs0,yts_w, &
+                yu_w, yv_w, yt_w, yq_w, ypplay, ypaprs,      &
+                ytke_w, yeps_w, ycoefm_w, ycoefh_w)
 
         ELSE
@@ -3519 +3535 @@
          &   )
        ELSE  !(iflag_split .eq.0)
+
         CALL climb_hq_down(knon, ni, ycoefh_x, ypaprs, ypplay, &
             ydelp, yt_x, yq_x, dtime, &
@@ -3536 +3553 @@
        ENDIF
 
+
         CALL climb_hq_down(knon, ni, ycoefh_w, ypaprs, ypplay, &
             ydelp, yt_w, yq_w, dtime, &
@@ -3558 +3576 @@
 ! - Calculate the coefficients Ccoef_U, Ccoef_V, Dcoef_U and Dcoef_V
        IF (iflag_split .eq.0) THEN
+
         CALL climb_wind_down(knon, ni, dtime, ycoefm, ypplay, ypaprs, yt, ydelp, yu, yv, &
             CcoefU, CcoefV, DcoefU, DcoefV, &
@@ -3563 +3582 @@
             AcoefU, AcoefV, BcoefU, BcoefV)
        ELSE  ! (iflag_split .eq.0)
+
         CALL climb_wind_down(knon, ni, dtime, ycoefm_x, ypplay, ypaprs, yt_x, ydelp, yu_x, yv_x, &
             CcoefU_x, CcoefV_x, DcoefU_x, DcoefV_x, &
@@ -3584 +3604 @@
         enddo
      enddo
+
      CALL climb_qbs_down(knon, ni, ycoefqbs, ypaprs, ypplay, &
      ydelp, yt, yqbs, dtime, & 
@@ -3654 +3675 @@
     ENDIF  ! ( f_z0qh_oce .ne. 1. .and. nsrf .eq.is_oce)
 !
+
          CALL wx_pbl_prelim_0(knon, nsrf, dtime, ypplay, ypaprs, ywake_s,  &
                          yts, y_delta_tsurf, ygustiness, &
@@ -3669 +3691 @@
                          BcoefQ_x, BcoefQ_w  &
                          )
+
          CALL wx_pbl0_merge(knon, ypplay, ypaprs,  &
                          ywake_s, ydTs0, ydqs0, &
@@ -3685 +3708 @@
                          )
          IF (iflag_split .eq. 2 .AND. nsrf .ne. is_oce) THEN
+
            CALL wx_pbl_dts_merge(knon, dtime, ypplay, ypaprs, &
                            ywake_s, ybeta, ywake_cstar, ywake_dens, &
@@ -3743 +3767 @@
           ! Calculate the temperature et relative humidity at 2m and the wind at 10m 
           IF (iflag_new_t2mq2m==1) THEN
-           CALL stdlevvarn(knon, knon, is_ter, zxli, &
+
+         CALL stdlevvarn(knon, knon, is_ter, zxli, &
                yu(:,1), yv(:,1), yt(:,1), yq(:,1), zgeo1, &
                yts, yqsurf, yz0m, yz0h, ypaprs(:,1), ypplay(:,1), &
@@ -3749 +3774 @@
                yn2mout)
           ELSE 
+
           CALL stdlevvar(knon, knon, is_ter, zxli, &
                yu(:,1), yv(:,1), yt(:,1), yq(:,1), zgeo1, &
@@ -3767 +3793 @@
      
        CASE(is_ter)
+
           CALL surf_land(itap, dtime, date0, jour, knon, ni,&
                rlon, rlat, yrmu0, &
@@ -3792 +3819 @@
 
             IF (ifl_pbltree .ge. 1) THEN
+
               CALL   freinage(knon, knon, yu, yv, yt, &
                 yveget,ylai, yheight,ypaprs,ypplay,y_treedrg, y_d_u_frein,y_d_v_frein)
@@ -3830 +3858 @@
           IF (landice_opt .LT. 2) THEN
              ! Land ice is treated by LMDZ and not by ORCHIDEE
+
              CALL surf_landice(itap, dtime, knon, ni, &
                   rlon, rlat, debut, lafin, &
@@ -3916 +3945 @@
         ENDDO
 
-        DO j = 1, knon
-             k= minloc(abs(ypphii(j,:)-300),1)
-             ydthetadz300(j)=ydthetadz(j,k)
+!ym  minloc does't work on GPU (nvfortran + openacc) 
+!        DO j = 1, knon
+!             k= minloc(abs(ypphii(j,:)-300),1)
+!             ydthetadz300(j)=ydthetadz(j,k)
+!        ENDDO
+
+        ydthetadz300(1:knon) = ydthetadz(1:knon,1)
+        DO k=2, klev
+          DO j=1,knon
+            IF (abs(ypphii(j,k)-300) < ydthetadz300(j)) ydthetadz300(j) = abs(ypphii(j,k)-300)
+          ENDDO
         ENDDO
+
         end if
 
@@ -3942 +3980 @@
 #endif               
          &      )
+!$gpum nocall
            CALL checksum("yalb_dir_new_ocean",yalb_dir_new(1:knon,:))
       IF (prt_level >=10) THEN
@@ -3967 +4006 @@
           
        CASE(is_sic)
+
           CALL surf_seaice( &
                rlon, rlat, ysolsw, ysollw, yalb_vis, yfder, &
@@ -4135 +4175 @@
                         BcoefQ_x, BcoefQ_w  &
                         )
+
         CALL wx_pbl0_merge(knon, ypplay, ypaprs,  &
                           ywake_s, ydTs0, ydqs0, &
@@ -4151 +4192 @@
                           )
           IF (iflag_split .eq. 2) THEN
+
             CALL wx_pbl_dts_merge(knon, dtime, ypplay, ypaprs, &
                             ywake_s, ybeta, ywake_cstar, ywake_dens, &
@@ -4219 +4261 @@
 
          IF (nsrf .ne. is_oce) THEN
+
            CALL wx_pbl_dts_check(knon, dtime, ypplay, ypaprs, ywake_s, ybeta, iflag_split, &
                          yTs, y_delta_tsurf,  & 
@@ -4282 +4325 @@
         &    )    
        ELSE  !(iflag_split .eq.0)
+
         CALL climb_hq_up(knon, ni, dtime, yt_x, yq_x, &
             y_flux_q1_x, y_flux_t1_x, ypaprs, ypplay, &
@@ -4295 +4339 @@
         &    )    
 !
+
        CALL climb_hq_up(knon, ni, dtime, yt_w, yq_w, &
             y_flux_q1_w, y_flux_t1_w, ypaprs, ypplay, &
@@ -4361 +4406 @@
      y_d_t_diss(:,:)=0.
      IF (iflag_pbl>=20 .and. iflag_pbl<30) THEN
+
         CALL yamada_c(knon, knon,dtime,ypaprs,ypplay &
     &   ,yu,yv,yt,y_d_u,y_d_v,y_d_t,ycdragm,ytke,ycoefm,ycoefh,ycoefq,y_d_t_diss,yustar &
@@ -4367 +4413 @@
 
        ELSE  !(iflag_split .eq.0)
+
         CALL climb_wind_up(knon, ni, dtime, yu_x, yv_x, y_flux_u1_x, y_flux_v1_x, &
             AcoefU_x, AcoefV_x, BcoefU_x, BcoefV_x, &
@@ -4375 +4422 @@
      y_d_t_diss_x(:,:)=0.
      IF (iflag_pbl>=20 .and. iflag_pbl<30) THEN
+
         CALL yamada_c(knon, knon,dtime,ypaprs,ypplay &
     &   ,yu_x,yv_x,yt_x,y_d_u_x,y_d_v_x,y_d_t_x,ycdragm_x,ytke_x,ycoefm_x,ycoefh_x &
@@ -4389 +4437 @@
      y_d_t_diss_w(:,:)=0.
      IF (iflag_pbl>=20 .and. iflag_pbl<30) THEN
+
         CALL yamada_c(knon, knon,dtime,ypaprs,ypplay &
     &   ,yu_w,yv_w,yt_w,y_d_u_w,y_d_v_w,y_d_t_w,ycdragm_w,ytke_w,ycoefm_w,ycoefh_w &
@@ -4403 +4452 @@
 
        IF (ok_bs) THEN
+
             CALL climb_qbs_up(knon, ni, dtime, yqbs, &
             y_flux_bs, ypaprs, ypplay, &
@@ -4877 +4927 @@
            CALL checksum("yq2m_bis", yq2m(1:knon))
         ELSE
+
         CALL stdlevvar(knon, knon, nsrf, zxli, &
             uzon, vmer, tair1, qair1, zgeo1, &
@@ -4884 +4935 @@
        ELSE  !(iflag_split .eq.0)
         IF (iflag_new_t2mq2m==1) THEN
+
          CALL stdlevvarn(knon, knon, nsrf, zxli, &
             uzon_x, vmer_x, tair1_x, qair1_x, zgeo1_x, &
@@ -4889 +4941 @@
             yt2m_x, yq2m_x, yt10m_x, yq10m_x, yu10m_x, yustar_x, &
             yn2mout_x(:, :, :))
+
          CALL stdlevvarn(knon, knon, nsrf, zxli, &
             uzon_w, vmer_w, tair1_w, qair1_w, zgeo1_w, &
@@ -4895 +4948 @@
             yn2mout_w(:, :, :))
         ELSE
+
         CALL stdlevvar(knon, knon, nsrf, zxli, &
             uzon_x, vmer_x, tair1_x, qair1_x, zgeo1_x, &
             tairsol_x, qairsol, yz0m, yz0h_oupas, psfce, patm, &
             yt2m_x, yq2m_x, yt10m_x, yq10m_x, yu10m_x, yustar_x, ypblh_x, rain_f, yzxtsol)
+
         CALL stdlevvar(knon, knon, nsrf, zxli, &
             uzon_w, vmer_w, tair1_w, qair1_w, zgeo1_w, &
@@ -5010 +5065 @@
 
        IF (iflag_split .eq.0) THEN
+
         CALL hbtm(knon, ypaprs, ypplay, &
             yt2m,yt10m,yq2m,yq10m,yustar,ywstar, &
@@ -5029 +5085 @@
           ENDIF
        ELSE  ! (iflag_split .eq.0)
+
         CALL HBTM(knon, ypaprs, ypplay, &
             yt2m_x,yt10m_x,yq2m_x,yq10m_x,yustar_x,ywstar_x, &
@@ -5047 +5104 @@
        print *,' Arg. de HBTM: yq_x ',yq_x(1:knon,:)
           ENDIF
+
         CALL HBTM(knon, ypaprs, ypplay, &
             yt2m_w,yt10m_w,yq2m_w,yq10m_w,yustar_w,ywstar_w, &