Changeset 7 for trunk/libf/dyn3d/integrd.F

Timestamp:

Oct 28, 2010, 9:30:04 AM (14 years ago)

Author:

emillour

Message:

Mise a niveau de la dynamique par rapport a la version 1447 de LMDZ5
Voir les details dans chantiers/commit_v7.log

File:

• trunk/libf/dyn3d/integrd.F (modified) (7 diffs)

trunk/libf/dyn3d/integrd.F

@@ -1 +1 @@
 !
-! $Id: integrd.F 1403 2010-07-01 09:02:53Z fairhead $
+! $Id: integrd.F 1446 2010-10-22 09:27:25Z emillour $
 !
       SUBROUTINE integrd
@@ -6 +6 @@
      $     dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps,masse,phis,finvmaold )
 
-      USE control_mod
+      use control_mod, only : planet_type
 
       IMPLICIT NONE
@@ -81 +81 @@
       CALL SCOPY(ip1jmp1*llm, masse, 1, massescr, 1)
 
-      DO 2 ij = 1,ip1jmp1
+      DO ij = 1,ip1jmp1
        pscr (ij)    = ps(ij)
        ps (ij)      = psm1(ij) + dt * dp(ij)
-   2  CONTINUE
+      ENDDO
 c
       DO ij = 1,ip1jmp1
@@ -115 +115 @@
 c    ............   integration  de  ucov, vcov,  h     ..............
 
-      DO 10 l = 1,llm
-
-      DO 4 ij = iip2,ip1jm
-      uscr( ij )   =  ucov( ij,l )
-      ucov( ij,l ) = ucovm1( ij,l ) + dt * du( ij,l )
-   4  CONTINUE
-
-      DO 5 ij = 1,ip1jm
-      vscr( ij )   =  vcov( ij,l )
-      vcov( ij,l ) = vcovm1( ij,l ) + dt * dv( ij,l )
-   5  CONTINUE
-
-      DO 6 ij = 1,ip1jmp1
-      hscr( ij )    =  teta(ij,l)
-      teta ( ij,l ) = tetam1(ij,l) *  massem1(ij,l) / masse(ij,l) 
-     $                + dt * dteta(ij,l) / masse(ij,l)
-   6  CONTINUE
+      DO l = 1,llm
+
+       DO ij = iip2,ip1jm
+        uscr( ij )   =  ucov( ij,l )
+        ucov( ij,l ) = ucovm1( ij,l ) + dt * du( ij,l )
+       ENDDO
+
+       DO ij = 1,ip1jm
+        vscr( ij )   =  vcov( ij,l )
+        vcov( ij,l ) = vcovm1( ij,l ) + dt * dv( ij,l )
+       ENDDO
+
+       DO ij = 1,ip1jmp1
+        hscr( ij )    =  teta(ij,l)
+        teta ( ij,l ) = tetam1(ij,l) *  massem1(ij,l) / masse(ij,l) 
+     &                + dt * dteta(ij,l) / masse(ij,l)
+       ENDDO
 
 c   ....  Calcul de la valeur moyenne, unique  aux poles pour  teta    ......
 c
 c
-      DO  ij   = 1, iim
+       DO  ij   = 1, iim
         tppn(ij) = aire(   ij   ) * teta(  ij    ,l)
         tpps(ij) = aire(ij+ip1jm) * teta(ij+ip1jm,l)
-      ENDDO
+       ENDDO
         tpn      = SSUM(iim,tppn,1)/apoln
         tps      = SSUM(iim,tpps,1)/apols
 
-      DO ij   = 1, iip1
+       DO ij   = 1, iip1
         teta(   ij   ,l)  = tpn
         teta(ij+ip1jm,l)  = tps
-      ENDDO
-c
-
-      IF(leapf)  THEN
+       ENDDO
+c
+
+       IF(leapf)  THEN
          CALL SCOPY ( ip1jmp1, uscr(1), 1, ucovm1(1, l), 1 )
          CALL SCOPY (   ip1jm, vscr(1), 1, vcovm1(1, l), 1 )
          CALL SCOPY ( ip1jmp1, hscr(1), 1, tetam1(1, l), 1 )
-      END IF
-
-  10  CONTINUE
+       END IF
+
+      ENDDO ! of DO l = 1,llm
 
 
@@ -185 +185 @@
 c$$$      ENDIF
 
-         if (planet_type.eq."earth") then
+      if (planet_type.eq."earth") then
 ! Earth-specific treatment of first 2 tracers (water)
-          DO l = 1, llm
-           DO ij = 1, ip1jmp1
+        DO l = 1, llm
+          DO ij = 1, ip1jmp1
             deltap(ij,l) =  p(ij,l) - p(ij,l+1) 
-           ENDDO
           ENDDO
-
-          CALL qminimum( q, nq, deltap )
-         endif ! of if (planet_type.eq."earth")
+        ENDDO
+
+        CALL qminimum( q, nq, deltap )
 
 c
@@ -200 +199 @@
 c
 
-      DO iq = 1, nq
+       DO iq = 1, nq
         DO l = 1, llm
 
@@ -216 +215 @@
 
         ENDDO
-      ENDDO
-
-
-         CALL  SCOPY( ijp1llm , finvmasse, 1, finvmaold, 1 )
+       ENDDO
+
+
+      CALL  SCOPY( ijp1llm , finvmasse, 1, finvmaold, 1 )
+
+      endif ! of if (planet_type.eq."earth")
 c
 c
 c     .....   FIN  de l'integration  de   q    .......
-
-15    continue
 
 c    .................................................................