Changeset 5712 for LMDZ6/trunk/libf/phylmd/cv_routines.f90

Timestamp:

Jun 16, 2025, 7:12:42 PM (3 weeks ago)

Author:

yann meurdesoif

Message:

Convection GPU porting : Compression of active convection point is now optional (default remain to true). For GPU runs, convection is not compressed and is computed on each column. The update is done only for column where convection is active

YM

File:

• LMDZ6/trunk/libf/phylmd/cv_routines.f90 (modified) (6 diffs)

LMDZ6/trunk/libf/phylmd/cv_routines.f90

@@ -407 +407 @@
 END SUBROUTINE cv_trigger
 
-SUBROUTINE cv_compress(len, nloc, ncum, nd, iflag1, nk1, icb1, cbmf1, plcl1, &
+SUBROUTINE cv_compress(len, nloc, ncum, nd, iflag1, compress, nk1, icb1, cbmf1, plcl1, &
     tnk1, qnk1, gznk1, t1, q1, qs1, u1, v1, gz1, h1, lv1, cpn1, p1, ph1, tv1, &
     tp1, tvp1, clw1, iflag, nk, icb, cbmf, plcl, tnk, qnk, gznk, t, q, qs, u, &
@@ -419 +419 @@
   INTEGER len, ncum, nd, nloc
   INTEGER iflag1(len), nk1(len), icb1(len)
+  LOGICAL compress
   REAL cbmf1(len), plcl1(len), tnk1(len), qnk1(len), gznk1(len)
   REAL t1(len, nd), q1(len, nd), qs1(len, nd), u1(len, nd), v1(len, nd)
@@ -439 +440 @@
   CHARACTER (LEN=80) :: abort_message
 
-
-  DO k = 1, nl + 1
+  IF (compress) THEN 
+    DO k = 1, nl + 1
+      nn = 0
+      DO i = 1, len
+        IF (iflag1(i)==0) THEN
+          nn = nn + 1
+          t(nn, k) = t1(i, k)
+          q(nn, k) = q1(i, k)
+          qs(nn, k) = qs1(i, k)
+          u(nn, k) = u1(i, k)
+          v(nn, k) = v1(i, k)
+          gz(nn, k) = gz1(i, k)
+          h(nn, k) = h1(i, k)
+          lv(nn, k) = lv1(i, k)
+          cpn(nn, k) = cpn1(i, k)
+          p(nn, k) = p1(i, k)
+          ph(nn, k) = ph1(i, k)
+          tv(nn, k) = tv1(i, k)
+          tp(nn, k) = tp1(i, k)
+          tvp(nn, k) = tvp1(i, k)
+          clw(nn, k) = clw1(i, k)
+        END IF
+      END DO
+    END DO
+  
+    IF (nn/=ncum) THEN
+      WRITE (lunout, *) 'strange! nn not equal to ncum: ', nn, ncum
+      abort_message = ''
+      CALL abort_physic(modname, abort_message, 1)
+    END IF
+  
     nn = 0
     DO i = 1, len
       IF (iflag1(i)==0) THEN
         nn = nn + 1
-        t(nn, k) = t1(i, k)
-        q(nn, k) = q1(i, k)
-        qs(nn, k) = qs1(i, k)
-        u(nn, k) = u1(i, k)
-        v(nn, k) = v1(i, k)
-        gz(nn, k) = gz1(i, k)
-        h(nn, k) = h1(i, k)
-        lv(nn, k) = lv1(i, k)
-        cpn(nn, k) = cpn1(i, k)
-        p(nn, k) = p1(i, k)
-        ph(nn, k) = ph1(i, k)
-        tv(nn, k) = tv1(i, k)
-        tp(nn, k) = tp1(i, k)
-        tvp(nn, k) = tvp1(i, k)
-        clw(nn, k) = clw1(i, k)
-      END IF
-    END DO
-  END DO
-
-  IF (nn/=ncum) THEN
-    WRITE (lunout, *) 'strange! nn not equal to ncum: ', nn, ncum
-    abort_message = ''
-    CALL abort_physic(modname, abort_message, 1)
-  END IF
-
-  nn = 0
-  DO i = 1, len
-    IF (iflag1(i)==0) THEN
-      nn = nn + 1
-      cbmf(nn) = cbmf1(i)
-      plcl(nn) = plcl1(i)
-      tnk(nn) = tnk1(i)
-      qnk(nn) = qnk1(i)
-      gznk(nn) = gznk1(i)
-      nk(nn) = nk1(i)
-      icb(nn) = icb1(i)
-      iflag(nn) = iflag1(i)
-    END IF
-  END DO
+        cbmf(nn) = cbmf1(i)
+        plcl(nn) = plcl1(i)
+        tnk(nn) = tnk1(i)
+        qnk(nn) = qnk1(i)
+        gznk(nn) = gznk1(i)
+        nk(nn) = nk1(i)
+        icb(nn) = icb1(i)
+        iflag(nn) = iflag1(i)
+      END IF
+    END DO
+  
+  ELSE  !compress
+    t(:, 1:nl+1) = t1(:, 1:nl+1)
+    q(:, 1:nl+1) = q1(:, 1:nl+1)
+    qs(:, 1:nl+1) = qs1(:, 1:nl+1)
+    u(:, 1:nl+1) = u1(:, 1:nl+1)
+    v(:, 1:nl+1) = v1(:, 1:nl+1)
+    gz(:, 1:nl+1) = gz1(:, 1:nl+1)
+    h(:, 1:nl+1) = h1(:, 1:nl+1)
+    lv(:, 1:nl+1) = lv1(:, 1:nl+1)
+    cpn(:, 1:nl+1) = cpn1(:, 1:nl+1)
+    p(:, 1:nl+1) = p1(:, 1:nl+1)
+    ph(:, 1:nl+1) = ph1(:, 1:nl+1)
+    tv(:, 1:nl+1) = tv1(:, 1:nl+1)
+    tp(:, 1:nl+1) = tp1(:, 1:nl+1)
+    tvp(:, 1:nl+1) = tvp1(:, 1:nl+1)
+    clw(:, 1:nl+1) = clw1(:, 1:nl+1)
+
+    cbmf(:) = cbmf1(:)
+    plcl(:) = plcl1(:)
+    tnk(:) = tnk1(:)
+    qnk(:) = qnk1(:)
+    gznk(:) = gznk1(:)
+    nk(:) = nk1(:)
+    icb(:) = icb1(:)
+    iflag(:) = iflag1(:)
+  ENDIF
 
   DO k = 1, nl
@@ -1702 +1730 @@
 END SUBROUTINE cv_yield
 
-SUBROUTINE cv_uncompress(nloc, len, ncum, nd, idcum, iflag, precip, cbmf, ft, &
+SUBROUTINE cv_uncompress(nloc, len, ncum, nd, idcum, is_convect, compress, iflag, precip, cbmf, ft, &
     fq, fu, fv, ma, qcondc, iflag1, precip1, cbmf1, ft1, fq1, fu1, fv1, ma1, &
     qcondc1)
@@ -1712 +1740 @@
   INTEGER len, ncum, nd, nloc
   INTEGER idcum(nloc)
+  LOGICAL is_convect(nloc)
+  LOGICAL compress
   INTEGER iflag(nloc)
   REAL precip(nloc), cbmf(nloc)
@@ -1727 +1757 @@
   ! local variables:
   INTEGER i, k
-
-  DO i = 1, ncum
-    precip1(idcum(i)) = precip(i)
-    cbmf1(idcum(i)) = cbmf(i)
-    iflag1(idcum(i)) = iflag(i)
-  END DO
-
-  DO k = 1, nl
+  
+  IF (compress) THEN
     DO i = 1, ncum
-      ft1(idcum(i), k) = ft(i, k)
-      fq1(idcum(i), k) = fq(i, k)
-      fu1(idcum(i), k) = fu(i, k)
-      fv1(idcum(i), k) = fv(i, k)
-      ma1(idcum(i), k) = ma(i, k)
-      qcondc1(idcum(i), k) = qcondc(i, k)
-    END DO
-  END DO
-
+      precip1(idcum(i)) = precip(i)
+      cbmf1(idcum(i)) = cbmf(i)
+      iflag1(idcum(i)) = iflag(i)
+    END DO
+  
+    DO k = 1, nl
+      DO i = 1, ncum
+        ft1(idcum(i), k) = ft(i, k)
+        fq1(idcum(i), k) = fq(i, k)
+        fu1(idcum(i), k) = fu(i, k)
+        fv1(idcum(i), k) = fv(i, k)
+        ma1(idcum(i), k) = ma(i, k)
+        qcondc1(idcum(i), k) = qcondc(i, k)
+      END DO
+    END DO
+  ELSE
+    DO i = 1, len
+      IF (is_convect(i)) THEN
+        precip1(i) = precip(i)
+        cbmf1(i) = cbmf(i)
+        iflag1(i) = iflag(i)
+      ENDIF
+    END DO
+  
+    DO k = 1, nl
+      DO i = 1, ncum
+        IF (is_convect(i)) THEN
+          ft1(i, k) = ft(i, k)
+          fq1(i, k) = fq(i, k)
+          fu1(i, k) = fu(i, k)
+          fv1(i, k) = fv(i, k)
+          ma1(i, k) = ma(i, k)
+          qcondc1(i, k) = qcondc(i, k)
+        ENDIF
+      END DO
+    END DO    
+  ENDIF
   RETURN
 END SUBROUTINE cv_uncompress