Changeset 5246 for LMDZ6/trunk/libf/dyn3d/tetaleveli1j1.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/tetaleveli1j1.F90 (moved) (moved from LMDZ6/trunk/libf/dyn3d/tetaleveli1j1.F) (1 diff)

LMDZ6/trunk/libf/dyn3d/tetaleveli1j1.F90

@@ -1 @@
-c================================================================
-c================================================================
-      SUBROUTINE tetaleveli1j1(ilon,ilev,lnew,pgcm,pres,Qgcm,Qpres)
-c================================================================
-c================================================================
+!================================================================
+!================================================================
+SUBROUTINE tetaleveli1j1(ilon,ilev,lnew,pgcm,pres,Qgcm,Qpres)
+  !================================================================
+  !================================================================
 
-! FH 2008/05/09 On elimine toutes les clefs physiques dans la dynamique
-!      USE dimphy
-      IMPLICIT none
+  ! FH 2008/05/09 On elimine toutes les clefs physiques dans la dynamique
+   ! USE dimphy
+  IMPLICIT none
 
 #include "dimensions.h"
-cccc#include "dimphy.h"
+  !ccc#include "dimphy.h"
 
-c================================================================
-c
-c Interpoler des champs 3-D u, v et g du modele a un niveau de
-c pression donnee (pres)
-c
-c INPUT:  ilon ----- nombre de points
-c         ilev ----- nombre de couches
-c         lnew ----- true si on doit reinitialiser les poids
-c         pgcm ----- pressions modeles
-c         pres ----- pression vers laquelle on interpolle
-c         Qgcm ----- champ GCM
-c         Qpres ---- champ interpolle au niveau pres
-c
-c================================================================
-c
-c   arguments :
-c   -----------
+  !================================================================
+  !
+  ! Interpoler des champs 3-D u, v et g du modele a un niveau de
+  ! pression donnee (pres)
+  !
+  ! INPUT:  ilon ----- nombre de points
+  !     ilev ----- nombre de couches
+  !     lnew ----- true si on doit reinitialiser les poids
+  !     pgcm ----- pressions modeles
+  !     pres ----- pression vers laquelle on interpolle
+  !     Qgcm ----- champ GCM
+  !     Qpres ---- champ interpolle au niveau pres
+  !
+  !================================================================
+  !
+  !   arguments :
+  !   -----------
 
-      INTEGER ilon, ilev
-      logical lnew
+  INTEGER :: ilon, ilev
+  logical :: lnew
 
-      REAL pgcm(ilon,ilev)
-      REAL Qgcm(ilon,ilev)
-      real pres
-      REAL Qpres(ilon)
+  REAL :: pgcm(ilon,ilev)
+  REAL :: Qgcm(ilon,ilev)
+  real :: pres
+  REAL :: Qpres(ilon)
 
-c   local :
-c   -------
+  !   local :
+  !   -------
 
-cIM 211004
-c     INTEGER lt(klon), lb(klon)
-c     REAL ptop, pbot, aist(klon), aisb(klon)
-c
+  !IM 211004
+  ! INTEGER lt(klon), lb(klon)
+  ! REAL ptop, pbot, aist(klon), aisb(klon)
+  !
 #include "paramet.h"
-c
-      INTEGER lt(ip1jmp1), lb(ip1jmp1)
-      REAL ptop, pbot, aist(ip1jmp1), aisb(ip1jmp1)
-cMI 211004
-      save lt,lb,ptop,pbot,aist,aisb
+  !
+  INTEGER :: lt(ip1jmp1), lb(ip1jmp1)
+  REAL :: ptop, pbot, aist(ip1jmp1), aisb(ip1jmp1)
+  !MI 211004
+  save lt,lb,ptop,pbot,aist,aisb
 
-      INTEGER i, k
-c
-c     PRINT*,'tetalevel pres=',pres
-c=====================================================================
-      if (lnew) then
-c   on réinitialise les réindicages et les poids
-c=====================================================================
+  INTEGER :: i, k
+  !
+  ! PRINT*,'tetalevel pres=',pres
+  !=====================================================================
+  if (lnew) then
+  !   on réinitialise les réindicages et les poids
+  !=====================================================================
 
 
-c Chercher les 2 couches les plus proches du niveau a obtenir
-c
-c Eventuellement, faire l'extrapolation a partir des deux couches
-c les plus basses ou les deux couches les plus hautes:
-      DO 130 i = 1, ilon
-cIM      IF ( ABS(pres-pgcm(i,ilev) ) .LT.
-         IF ( ABS(pres-pgcm(i,ilev) ) .GT.
-     .        ABS(pres-pgcm(i,1)) ) THEN
-            lt(i) = ilev     ! 2
-            lb(i) = ilev-1   ! 1
-         ELSE
-            lt(i) = 2
-            lb(i) = 1
-         ENDIF
-cIM   PRINT*,'i, ABS(pres-pgcm),ABS(pres-pgcm)',
-cIM  .i, ABS(pres-pgcm(i,ilev)),ABS(pres-pgcm(i,1))
-  130 CONTINUE
-      DO 150 k = 1, ilev-1
-         DO 140 i = 1, ilon
-            pbot = pgcm(i,k)
-            ptop = pgcm(i,k+1)
-cIM         IF (ptop.LE.pres .AND. pbot.GE.pres) THEN
-            IF (ptop.GE.pres .AND. pbot.LE.pres) THEN
-               lt(i) = k+1
-               lb(i) = k
-            ENDIF
-  140    CONTINUE
-  150 CONTINUE
-c
-c Interpolation lineaire:
-c
-      DO i = 1, ilon
-c interpolation en logarithme de pression:
-c
-c ...   Modif . P. Le Van    ( 20/01/98) ....
-c       Modif Frédéric Hourdin (3/01/02)
+  ! Chercher les 2 couches les plus proches du niveau a obtenir
+  !
+  ! Eventuellement, faire l'extrapolation a partir des deux couches
+  ! les plus basses ou les deux couches les plus hautes:
+  DO i = 1, ilon
+  !IM      IF ( ABS(pres-pgcm(i,ilev) ) .LT.
+     IF ( ABS(pres-pgcm(i,ilev) ) .GT. &
+           ABS(pres-pgcm(i,1)) ) THEN
+        lt(i) = ilev     ! 2
+        lb(i) = ilev-1   ! 1
+     ELSE
+        lt(i) = 2
+        lb(i) = 1
+     ENDIF
+  !IM   PRINT*,'i, ABS(pres-pgcm),ABS(pres-pgcm)',
+  !IM  .i, ABS(pres-pgcm(i,ilev)),ABS(pres-pgcm(i,1))
+  END DO
+  DO k = 1, ilev-1
+     DO i = 1, ilon
+        pbot = pgcm(i,k)
+        ptop = pgcm(i,k+1)
+  !IM         IF (ptop.LE.pres .AND. pbot.GE.pres) THEN
+        IF (ptop.GE.pres .AND. pbot.LE.pres) THEN
+           lt(i) = k+1
+           lb(i) = k
+        ENDIF
+     END DO
+  END DO
+  !
+  ! Interpolation lineaire:
+  !
+  DO i = 1, ilon
+  ! interpolation en logarithme de pression:
+  !
+  ! ...   Modif . P. Le Van    ( 20/01/98) ....
+  !   Modif Frédéric Hourdin (3/01/02)
 
-        IF(pgcm(i,lb(i)).EQ.0.OR.
-     $     pgcm(i,lt(i)).EQ.0.) THEN
-c
-        PRINT*,'i,lb,lt,2pgcm,pres',i,lb(i),
-     .  lt(i),pgcm(i,lb(i)),pgcm(i,lt(i)),pres
-c
-        ENDIF 
-c
-        aist(i) = LOG( pgcm(i,lb(i))/ pres )
-     .       / LOG( pgcm(i,lb(i))/ pgcm(i,lt(i)) )
-        aisb(i) = LOG( pres / pgcm(i,lt(i)) )
-     .       / LOG( pgcm(i,lb(i))/ pgcm(i,lt(i)))
-      enddo
+    IF(pgcm(i,lb(i)).EQ.0.OR. &
+          pgcm(i,lt(i)).EQ.0.) THEN
+  !
+    PRINT*,'i,lb,lt,2pgcm,pres',i,lb(i), &
+          lt(i),pgcm(i,lb(i)),pgcm(i,lt(i)),pres
+  !
+    ENDIF
+  !
+    aist(i) = LOG( pgcm(i,lb(i))/ pres ) &
+          / LOG( pgcm(i,lb(i))/ pgcm(i,lt(i)) )
+    aisb(i) = LOG( pres / pgcm(i,lt(i)) ) &
+          / LOG( pgcm(i,lb(i))/ pgcm(i,lt(i)))
+  enddo
 
 
-      endif ! lnew
+  endif ! lnew
 
-c======================================================================
-c    inteprollation
-c======================================================================
+  !======================================================================
+  !    inteprollation
+  !======================================================================
 
-      do i=1,ilon
-         Qpres(i)= Qgcm(i,lb(i))*aisb(i)+Qgcm(i,lt(i))*aist(i)
-cIM      PRINT*,'i,Qgcm,Qpres',i,Qgcm(i,lb(i)),aisb(i),
-cIM  $   Qgcm(i,lt(i)),aist(i),Qpres(i)
-      enddo
-c
-c Je mets les vents a zero quand je rencontre une montagne
-      do i = 1, ilon
-cIM      if (pgcm(i,1).LT.pres) THEN
-         if (pgcm(i,1).GT.pres) THEN
-c           Qpres(i)=1e33
-            Qpres(i)=1e+20
-cIM         PRINT*,'i,pgcm(i,1),pres =',i,pgcm(i,1),pres
-         endif
-      enddo
+  do i=1,ilon
+     Qpres(i)= Qgcm(i,lb(i))*aisb(i)+Qgcm(i,lt(i))*aist(i)
+  !IM      PRINT*,'i,Qgcm,Qpres',i,Qgcm(i,lb(i)),aisb(i),
+  !IM  $   Qgcm(i,lt(i)),aist(i),Qpres(i)
+  enddo
+  !
+  ! Je mets les vents a zero quand je rencontre une montagne
+  do i = 1, ilon
+  !IM      if (pgcm(i,1).LT.pres) THEN
+     if (pgcm(i,1).GT.pres) THEN
+        ! Qpres(i)=1e33
+        Qpres(i)=1e+20
+  !IM         PRINT*,'i,pgcm(i,1),pres =',i,pgcm(i,1),pres
+     endif
+  enddo
 
-c
-      RETURN
-      END
+  !
+  RETURN
+END SUBROUTINE tetaleveli1j1