Changeset 5158 for LMDZ6/branches/Amaury_dev/libf/dyn3d/groupe.F90

Timestamp:

Aug 2, 2024, 2:12:03 PM (3 months ago)

Author:

abarral

Message:

Add missing klon on strataer_emiss_mod.F90
Correct various missing explicit declarations
Replace tabs by spaces (tabs are not part of the fortran charset)
Continue cleaning modules
Removed unused arguments and variables

File:

• LMDZ6/branches/Amaury_dev/libf/dyn3d/groupe.F90 (modified) (1 diff)

LMDZ6/branches/Amaury_dev/libf/dyn3d/groupe.F90

@@ -1 +1 @@
 ! $Header$
 
-SUBROUTINE groupe(pext, pbaru, pbarv, pbarum, pbarvm, wm)
+MODULE lmdz_groupe
+  IMPLICIT NONE; PRIVATE
+  PUBLIC groupe
 
-  USE comconst_mod, ONLY: ngroup
-  USE lmdz_ssum_scopy, ONLY: scopy
-  USE lmdz_comgeom2
+CONTAINS
 
-  IMPLICIT NONE
+  SUBROUTINE groupe(pbaru, pbarv, pbarum, pbarvm, wm)
 
-  !   sous-programme servant a fitlrer les champs de flux de masse aux
-  !   poles en "regroupant" les mailles 2 par 2 puis 4 par 4 etc. au fur
-  !   et a mesure qu'on se rapproche du pole.
-  !
-  !   en entree: pext, pbaru et pbarv
-  !
-  !   en sortie:  pbarum,pbarvm et wm.
-  !
-  !   remarque, le wm est recalcule a partir des pbaru pbarv et on n'a donc
-  !   pas besoin de w en entree.
+    USE comconst_mod, ONLY: ngroup
+    USE lmdz_ssum_scopy, ONLY: scopy
+    USE lmdz_comgeom2
 
-  INCLUDE "dimensions.h"
-  INCLUDE "paramet.h"
+    IMPLICIT NONE
 
-  ! integer ngroup
-  ! parameter (ngroup=3)
+    !   sous-programme servant a fitlrer les champs de flux de masse aux
+    !   poles en "regroupant" les mailles 2 par 2 puis 4 par 4 etc. au fur
+    !   et a mesure qu'on se rapproche du pole.
+    !
+    !   en entree: pbaru et pbarv
+    !
+    !   en sortie:  pbarum,pbarvm et wm.
+    !
+    !   remarque, le wm est recalcule a partir des pbaru pbarv et on n'a donc
+    !   pas besoin de w en entree.
 
-  REAL :: pbaru(iip1, jjp1, llm), pbarv(iip1, jjm, llm)
-  REAL :: pext(iip1, jjp1, llm)
+    INCLUDE "dimensions.h"
+    INCLUDE "paramet.h"
 
-  REAL :: pbarum(iip1, jjp1, llm), pbarvm(iip1, jjm, llm)
-  REAL :: wm(iip1, jjp1, llm)
+    ! integer ngroup
+    ! parameter (ngroup=3)
 
-  REAL :: zconvm(iip1, jjp1, llm), zconvmm(iip1, jjp1, llm)
+    REAL :: pbaru(iip1, jjp1, llm), pbarv(iip1, jjm, llm)
 
-  REAL :: uu
+    REAL :: pbarum(iip1, jjp1, llm), pbarvm(iip1, jjm, llm)
+    REAL :: wm(iip1, jjp1, llm)
 
-  INTEGER :: i, j, l
+    REAL :: zconvm(iip1, jjp1, llm), zconvmm(iip1, jjp1, llm)
+    ! (gfortran) Warning: Array ‘zconvm’ at (1) is larger than limit set by ‘-fmax-stack-var-size=’, moved from stack to static storage.
+    ! This makes the procedure unsafe when called recursively, or concurrently from multiple threads.
 
-  LOGICAL :: firstcall, groupe_ok
-  save firstcall, groupe_ok
+    REAL :: uu
 
-  data firstcall/.TRUE./
-  data groupe_ok/.TRUE./
+    INTEGER :: i, j, l
 
-  IF (iim==1) THEN
-    groupe_ok = .FALSE.
-  ENDIF
+    LOGICAL :: firstcall, groupe_ok
+    save firstcall, groupe_ok
 
-  IF (firstcall) THEN
-    IF (groupe_ok) THEN
-      IF(mod(iim, 2**ngroup)/=0) &
-              CALL abort_gcm('groupe', 'probleme du nombre de point', 1)
-    endif
-    firstcall = .FALSE.
-  ENDIF
+    data firstcall/.TRUE./
+    data groupe_ok/.TRUE./
+
+    IF (iim==1) THEN
+      groupe_ok = .FALSE.
+    ENDIF
+
+    IF (firstcall) THEN
+      IF (groupe_ok) THEN
+        IF(mod(iim, 2**ngroup)/=0) &
+                CALL abort_gcm('groupe', 'probleme du nombre de point', 1)
+      endif
+      firstcall = .FALSE.
+    ENDIF
 
 
-  !   Champs 1D
+    !   Champs 1D
 
-  CALL convflu(pbaru, pbarv, llm, zconvm)
+    CALL convflu(pbaru, pbarv, llm, zconvm)
 
-  CALL scopy(ijp1llm, zconvm, 1, zconvmm, 1)
-  CALL scopy(ijmllm, pbarv, 1, pbarvm, 1)
+    CALL scopy(ijp1llm, zconvm, 1, zconvmm, 1)
+    CALL scopy(ijmllm, pbarv, 1, pbarvm, 1)
 
-  IF (groupe_ok) THEN
-    CALL groupeun(jjp1, llm, zconvmm)
-    CALL groupeun(jjm, llm, pbarvm)
+    IF (groupe_ok) THEN
+      CALL groupeun(jjp1, llm, zconvmm)
+      CALL groupeun(jjm, llm, pbarvm)
 
-    !   Champs 3D
-    do l = 1, llm
-      do j = 2, jjm
-        uu = pbaru(iim, j, l)
-        do i = 1, iim
-          uu = uu + pbarvm(i, j, l) - pbarvm(i, j - 1, l) - zconvmm(i, j, l)
-          pbarum(i, j, l) = uu
-          ! zconvm(i,j,l ) =  xflu(i-1,j,l)-xflu(i,j,l)+
-          !    *                      yflu(i,j,l)-yflu(i,j-1,l)
+      !   Champs 3D
+      DO l = 1, llm
+        DO j = 2, jjm
+          uu = pbaru(iim, j, l)
+          DO i = 1, iim
+            uu = uu + pbarvm(i, j, l) - pbarvm(i, j - 1, l) - zconvmm(i, j, l)
+            pbarum(i, j, l) = uu
+            ! zconvm(i,j,l ) =  xflu(i-1,j,l)-xflu(i,j,l)+
+            !    *                      yflu(i,j,l)-yflu(i,j-1,l)
+          enddo
+          pbarum(iip1, j, l) = pbarum(1, j, l)
         enddo
-        pbarum(iip1, j, l) = pbarum(1, j, l)
+      enddo
+
+    else
+      pbarum(:, :, :) = pbaru(:, :, :)
+      pbarvm(:, :, :) = pbarv(:, :, :)
+    ENDIF
+
+    !    integration de la convergence de masse de haut  en bas ......
+    DO l = 1, llm
+      DO j = 1, jjp1
+        DO i = 1, iip1
+          zconvmm(i, j, l) = zconvmm(i, j, l)
+        enddo
+      enddo
+    enddo
+    DO  l = llm - 1, 1, -1
+      DO j = 1, jjp1
+        DO i = 1, iip1
+          zconvmm(i, j, l) = zconvmm(i, j, l) + zconvmm(i, j, l + 1)
+        enddo
       enddo
     enddo
 
-  else
-    pbarum(:, :, :) = pbaru(:, :, :)
-    pbarvm(:, :, :) = pbarv(:, :, :)
-  ENDIF
+    CALL vitvert(zconvmm, wm)
 
-  !    integration de la convergence de masse de haut  en bas ......
-  do l = 1, llm
-    do j = 1, jjp1
-      do i = 1, iip1
-        zconvmm(i, j, l) = zconvmm(i, j, l)
-      enddo
-    enddo
-  enddo
-  do  l = llm - 1, 1, -1
-    do j = 1, jjp1
-      do i = 1, iip1
-        zconvmm(i, j, l) = zconvmm(i, j, l) + zconvmm(i, j, l + 1)
-      enddo
-    enddo
-  enddo
+  END SUBROUTINE  groupe
 
-  CALL vitvert(zconvmm, wm)
-
-END SUBROUTINE  groupe
-
+END MODULE lmdz_groupe