Changeset 5105 for LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dteta1_loc.f90

Timestamp:

Jul 23, 2024, 7:14:34 PM (8 weeks ago)

Author:

abarral

Message:

Replace 1DUTILS.h by module lmdz_1dutils.f90
Replace 1DConv.h by module lmdz_old_1dconv.f90 (it's only used by old_* files)
Convert *.F to *.f90
Fix gradsdef.h formatting
Remove unnecessary "RETURN" at the end of functions/subroutines

File:

• LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dteta1_loc.f90 (moved) (moved from LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dteta1_loc.F) (1 diff)

LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dteta1_loc.f90

@@ -1 @@
-      SUBROUTINE dteta1_loc ( teta, pbaru, pbarv, dteta)
-      USE parallel_lmdz
-      USE write_field_p
-      USE mod_filtreg_p
-      IMPLICIT NONE
+SUBROUTINE dteta1_loc ( teta, pbaru, pbarv, dteta)
+  USE parallel_lmdz
+  USE write_field_p
+  USE mod_filtreg_p
+  IMPLICIT NONE
 
-c=======================================================================
-c
-c   Auteur:  P. Le Van
-c   -------
-c Modif F.Forget 03/94 (on retire q et dq  pour construire dteta1)
-c
-c   ********************************************************************
-c   ... calcul du terme de convergence horizontale du flux d'enthalpie
-c        potentielle   ......
-c   ********************************************************************
-c  .. teta,pbaru et pbarv sont des arguments d'entree  pour le s-pg ....
-c     dteta               sont des arguments de sortie pour le s-pg ....
-c
-c=======================================================================
+  !=======================================================================
+  !
+  !   Auteur:  P. Le Van
+  !   -------
+  ! Modif F.Forget 03/94 (on retire q et dq  pour construire dteta1)
+  !
+  !   ********************************************************************
+  !   ... calcul du terme de convergence horizontale du flux d'enthalpie
+  !    potentielle   ......
+  !   ********************************************************************
+  !  .. teta,pbaru et pbarv sont des arguments d'entree  pour le s-pg ....
+  ! dteta                 sont des arguments de sortie pour le s-pg ....
+  !
+  !=======================================================================
 
 
-      include "dimensions.h"
-      include "paramet.h"
+  include "dimensions.h"
+  include "paramet.h"
 
-      REAL teta( ijb_u:ije_u,llm )
-      REAL pbaru( ijb_u:ije_u,llm ),pbarv( ijb_v:ije_v,llm)
-      REAL dteta( ijb_u:ije_u,llm )
-      INTEGER   l,ij
+  REAL :: teta( ijb_u:ije_u,llm )
+  REAL :: pbaru( ijb_u:ije_u,llm ),pbarv( ijb_v:ije_v,llm)
+  REAL :: dteta( ijb_u:ije_u,llm )
+  INTEGER :: l,ij
 
-      REAL hbyv( ijb_v:ije_v,llm ), hbxu( ijb_u:ije_u,llm )
+  REAL :: hbyv( ijb_v:ije_v,llm ), hbxu( ijb_u:ije_u,llm )
 
-c
-      INTEGER ijb,ije,jjb,jje
-
-      
-      jjb=jj_begin
-      jje=jj_end
-
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)    
-      DO l = 1,llm
-      
-      ijb=ij_begin
-      ije=ij_end
-      
-      if (pole_nord) ijb=ij_begin+iip1
-      if (pole_sud)  ije=ij_end-iip1
-      
-      DO ij = ijb, ije - 1
-        hbxu(ij,l) = pbaru(ij,l) * 0.5 * ( teta(ij,l)+teta(ij+1,l) )
-      END DO
-
-c    .... correction pour  hbxu(iip1,j,l)  .....
-c    ....   hbxu(iip1,j,l)= hbxu(1,j,l) ....
-
-CDIR$ IVDEP
-      DO ij = ijb+iip1-1, ije, iip1
-        hbxu( ij, l ) = hbxu( ij - iim, l )
-      END DO
-
-      ijb=ij_begin-iip1
-      if (pole_nord) ijb=ij_begin
-      
-      DO ij = ijb,ije
-        hbyv(ij,l)= pbarv(ij, l)* 0.5 * ( teta(ij, l)+teta(ij+iip1,l) )
-      END DO
-
-       if (.not. pole_sud) then
-          hbxu(ije+1:ije+iip1,l) = 0
-          hbyv(ije+1:ije+iip1,l) = 0
-        endif
-        
-      END DO
-c$OMP END DO NOWAIT
-       
-        
-        CALL  convflu_loc ( hbxu, hbyv, llm, dteta )
+  !
+  INTEGER :: ijb,ije,jjb,jje
 
 
-c    stockage dans  dh de la convergence horizont. filtree' du  flux
-c                  ....                           ...........
-c           d'enthalpie potentielle .
-      
-      
-      CALL filtreg_p( dteta,jjb_u,jje_u,jjb,jje,jjp1, llm, 
-     &                2, 2, .TRUE., 1)
-      
-      
-      RETURN
-      END
+  jjb=jj_begin
+  jje=jj_end
+
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+  DO l = 1,llm
+
+  ijb=ij_begin
+  ije=ij_end
+
+  if (pole_nord) ijb=ij_begin+iip1
+  if (pole_sud)  ije=ij_end-iip1
+
+  DO ij = ijb, ije - 1
+    hbxu(ij,l) = pbaru(ij,l) * 0.5 * ( teta(ij,l)+teta(ij+1,l) )
+  END DO
+
+  !    .... correction pour  hbxu(iip1,j,l)  .....
+  !    ....   hbxu(iip1,j,l)= hbxu(1,j,l) ....
+
+  !DIR$ IVDEP
+  DO ij = ijb+iip1-1, ije, iip1
+    hbxu( ij, l ) = hbxu( ij - iim, l )
+  END DO
+
+  ijb=ij_begin-iip1
+  if (pole_nord) ijb=ij_begin
+
+  DO ij = ijb,ije
+    hbyv(ij,l)= pbarv(ij, l)* 0.5 * ( teta(ij, l)+teta(ij+iip1,l) )
+  END DO
+
+   if (.not. pole_sud) then
+      hbxu(ije+1:ije+iip1,l) = 0
+      hbyv(ije+1:ije+iip1,l) = 0
+    endif
+
+  END DO
+!$OMP END DO NOWAIT
+
+
+    CALL  convflu_loc ( hbxu, hbyv, llm, dteta )
+
+
+  !    stockage dans  dh de la convergence horizont. filtree' du  flux
+               ! ....                           ...........
+        ! d'enthalpie potentielle .
+
+
+  CALL filtreg_p( dteta,jjb_u,jje_u,jjb,jje,jjp1, llm, &
+        2, 2, .TRUE., 1)
+
+
+
+END SUBROUTINE dteta1_loc