Changeset 5246 for LMDZ6/trunk/libf/dyn3d/dteta1.f90

Timestamp:

Oct 21, 2024, 2:58:45 PM (23 hours ago)

Author:

abarral

Message:

Convert fixed-form to free-form sources .F -> .{f,F}90
(WIP: some .F remain, will be handled in subsequent commits)

File:

• LMDZ6/trunk/libf/dyn3d/dteta1.f90 (moved) (moved from LMDZ6/trunk/libf/dyn3d/dteta1.F) (1 diff)

LMDZ6/trunk/libf/dyn3d/dteta1.f90

@@ -2 +2 @@
 ! $Header$
 !
-      SUBROUTINE dteta1 ( teta, pbaru, pbarv, dteta)
-      IMPLICIT NONE
+SUBROUTINE dteta1 ( teta, pbaru, pbarv, dteta)
+  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( ip1jmp1,llm ),pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm)
-      REAL dteta( ip1jmp1,llm )
-      INTEGER   l,ij
+  REAL :: teta( ip1jmp1,llm ),pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm)
+  REAL :: dteta( ip1jmp1,llm )
+  INTEGER :: l,ij
 
-      REAL hbyv( ip1jm,llm ), hbxu( ip1jmp1,llm )
+  REAL :: hbyv( ip1jm,llm ), hbxu( ip1jmp1,llm )
 
-c
+  !
 
-      DO 5 l = 1,llm
+  DO l = 1,llm
 
-      DO 1  ij = iip2, ip1jm - 1
-      hbxu(ij,l) = pbaru(ij,l) * 0.5 * ( teta(ij,l) + teta(ij+1,l) )
-   1  CONTINUE
+  DO  ij = iip2, ip1jm - 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) ....
+  !    .... correction pour  hbxu(iip1,j,l)  .....
+  !    ....   hbxu(iip1,j,l)= hbxu(1,j,l) ....
 
-CDIR$ IVDEP
-      DO 2 ij = iip1+ iip1, ip1jm, iip1
-      hbxu( ij, l ) = hbxu( ij - iim, l )
-   2  CONTINUE
+  !DIR$ IVDEP
+  DO ij = iip1+ iip1, ip1jm, iip1
+  hbxu( ij, l ) = hbxu( ij - iim, l )
+  END DO
 
 
-      DO 3 ij = 1,ip1jm
-      hbyv(ij,l)= pbarv(ij, l)* 0.5 * ( teta(ij, l)+ teta(ij +iip1,l) )
-   3  CONTINUE
+  DO ij = 1,ip1jm
+  hbyv(ij,l)= pbarv(ij, l)* 0.5 * ( teta(ij, l)+ teta(ij +iip1,l) )
+  END DO
 
-   5  CONTINUE
+  END DO
 
 
-        CALL  convflu ( hbxu, hbyv, llm, dteta )
+    CALL  convflu ( hbxu, hbyv, llm, dteta )
 
 
-c    stockage dans  dh de la convergence horizont. filtree' du  flux
-c                  ....                           ...........
-c           d'enthalpie potentielle .
+  !    stockage dans  dh de la convergence horizont. filtree' du  flux
+               ! ....                           ...........
+        ! d'enthalpie potentielle .
 
-      CALL filtreg( dteta, jjp1, llm, 2, 2, .true., 1)
+  CALL filtreg( dteta, jjp1, llm, 2, 2, .true., 1)
 
-c
-      RETURN
-      END
+  !
+  RETURN
+END SUBROUTINE dteta1