Changeset 1459 for trunk/LMDZ.COMMON/libf/dyn3d

Timestamp:

Jun 20, 2015, 9:22:53 AM (10 years ago)

Author:

emillour

Message:

Common dynamics: A couple of bug fixes

• calfis[_p].F array boundaries must be explicitely specified when underlying arrays are of different sizes.
• advect_new_p.F : missing initializations of intermediate variables at topmost layer.

EM

File:

• trunk/LMDZ.COMMON/libf/dyn3d/advect.F (modified) (5 diffs)

trunk/LMDZ.COMMON/libf/dyn3d/advect.F

@@ -28 +28 @@
 c   -------------
 
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
+      include "dimensions.h"
+      include "paramet.h"
+      include "comgeom.h"
 
 c   Arguments:
 c   ----------
 
-      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
-      REAL massebx(ip1jmp1,llm),masseby(ip1jm,llm),w(ip1jmp1,llm)
-      REAL dv(ip1jm,llm),du(ip1jmp1,llm),dteta(ip1jmp1,llm)
+      REAL,INTENT(IN) :: vcov(ip1jm,llm)
+      REAL,INTENT(IN) :: ucov(ip1jmp1,llm)
+      REAL,INTENT(IN) :: teta(ip1jmp1,llm)
+      REAL,INTENT(IN) :: massebx(ip1jmp1,llm)
+      REAL,INTENT(IN) :: masseby(ip1jm,llm)
+      REAL,INTENT(IN) :: w(ip1jmp1,llm)
+      REAL,INTENT(INOUT) :: dv(ip1jm,llm)
+      REAL,INTENT(INOUT) :: du(ip1jmp1,llm)
+      REAL,INTENT(INOUT) :: dteta(ip1jmp1,llm)
 
 c   Local:
@@ -57 +63 @@
          deuxjour = 2. * daysec
 
-         DO   1  ij   = 1, ip1jmp1
-         unsaire2(ij) = unsaire(ij) * unsaire(ij)
-   1     CONTINUE
+         DO ij   = 1, ip1jmp1
+           unsaire2(ij) = unsaire(ij) * unsaire(ij)
+         ENDDO
       END IF
 
@@ -100 +106 @@
 
 c
-      DO 20 l = 1, llmm1
+      DO l = 1, llmm1
 
 
 c       ......   calcul de  - w/2.    au niveau  l+1   .......
 
-      DO 5   ij   = 1, ip1jmp1
-      wsur2( ij ) = - 0.5 * w( ij,l+1 )
-   5  CONTINUE
+        DO ij   = 1, ip1jmp1
+          wsur2( ij ) = - 0.5 * w( ij,l+1 )
+        ENDDO
 
 
 c     .....................     calcul pour  du     ..................
 
-      DO 6 ij = iip2 ,ip1jm-1
-      ww        = wsur2 (  ij  )     + wsur2( ij+1 ) 
-      uu        = 0.5 * ( ucov(ij,l) + ucov(ij,l+1) )
-      du(ij,l)  = du(ij,l)   - ww * ( uu - uav(ij, l ) )/massebx(ij, l )
-      du(ij,l+1)= du(ij,l+1) + ww * ( uu - uav(ij,l+1) )/massebx(ij,l+1)
-   6  CONTINUE
+        DO ij = iip2 ,ip1jm-1
+          ww        = wsur2 (  ij  )     + wsur2( ij+1 ) 
+          uu        = 0.5 * ( ucov(ij,l) + ucov(ij,l+1) )
+          du(ij,l)  = du(ij,l)   -ww*(uu-uav(ij,l))/massebx(ij,l)
+          du(ij,l+1)= du(ij,l+1) +ww*(uu-uav(ij,l+1))/massebx(ij,l+1)
+        ENDDO
 
 c     .....  correction pour  du(iip1,j,l)  ........
@@ -123 +129 @@
 
 CDIR$ IVDEP
-      DO   7  ij   = iip1 +iip1, ip1jm, iip1
-      du( ij, l  ) = du( ij -iim, l  )
-      du( ij,l+1 ) = du( ij -iim,l+1 )
-   7  CONTINUE
+        DO ij   = iip1 +iip1, ip1jm, iip1
+          du( ij, l  ) = du( ij -iim, l  )
+          du( ij,l+1 ) = du( ij -iim,l+1 )
+        ENDDO
 
 c     .................    calcul pour   dv      .....................
 
-      DO 8 ij = 1, ip1jm
-      ww        = wsur2( ij+iip1 )   + wsur2( ij )
-      vv        = 0.5 * ( vcov(ij,l) + vcov(ij,l+1) )
-      dv(ij,l)  = dv(ij, l ) - ww * (vv - vav(ij, l ) )/masseby(ij, l )
-      dv(ij,l+1)= dv(ij,l+1) + ww * (vv - vav(ij,l+1) )/masseby(ij,l+1)
-   8  CONTINUE
+        DO ij = 1, ip1jm
+          ww        = wsur2( ij+iip1 )   + wsur2( ij )
+          vv        = 0.5 * ( vcov(ij,l) + vcov(ij,l+1) )
+          dv(ij,l)  = dv(ij, l ) - ww*(vv-vav(ij,l))/masseby(ij,l)
+          dv(ij,l+1)= dv(ij,l+1) + ww*(vv-vav(ij,l+1))/masseby(ij,l+1)
+        ENDDO
 
 c
@@ -147 +153 @@
 c                   ...............
 
-        DO 15 ij = 1, ip1jmp1
+        DO ij = 1, ip1jmp1
          ww            = wsur2(ij) * (teta(ij,l) + teta(ij,l+1) )
          dteta(ij, l ) = dteta(ij, l )  -  ww
          dteta(ij,l+1) = dteta(ij,l+1)  +  ww
-  15    CONTINUE
+        ENDDO
 
-      IF( conser)  THEN
-        DO 17 ij = 1,ip1jmp1
-        ge(ij)   = wsur2(ij) * wsur2(ij) * unsaire2(ij)
-  17    CONTINUE
-        gt       = SSUM( ip1jmp1,ge,1 )
-        gtot(l)  = deuxjour * SQRT( gt/ip1jmp1 )
-      END IF
+        IF( conser)  THEN
+          DO ij = 1,ip1jmp1
+            ge(ij)   = wsur2(ij) * wsur2(ij) * unsaire2(ij)
+          ENDDO
+          gt       = SSUM( ip1jmp1,ge,1 )
+          gtot(l)  = deuxjour * SQRT( gt/ip1jmp1 )
+        END IF
 
-  20  CONTINUE
+      ENDDO ! of DO l = 1, llmm1
  
-      RETURN
       END