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

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/dyn3dpar/advect_new_p.F (modified) (10 diffs)

trunk/LMDZ.COMMON/libf/dyn3dpar/advect_new_p.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:
+c   ------
+
       REAL,SAVE :: dv1(ip1jm,llm),du1(ip1jmp1,llm),dteta1(ip1jmp1,llm)
       REAL,SAVE :: dv2(ip1jm,llm),du2(ip1jmp1,llm),dteta2(ip1jmp1,llm)
-c   Local:
-c   ------
-
       REAL,SAVE :: uav(ip1jmp1,llm),vav(ip1jm,llm)
       REAL wsur2(ip1jmp1)
@@ -60 +66 @@
          deuxjour = 2. * daysec
 
-         DO   1  ij   = 1, ip1jmp1
+         DO ij   = 1, ip1jmp1
          unsaire2(ij) = unsaire(ij) * unsaire(ij)
-   1     CONTINUE
+         ENDDO
       END IF
 
@@ -77 +83 @@
       DO ij=ijb,ije
         du2(ij,1)=0.
+        du1(ij,llm)=0.
       ENDDO
       
@@ -85 +92 @@
       DO ij=ijb,ije
         dv2(ij,1)=0.
+        dv1(ij,llm)=0.
       ENDDO
       
@@ -92 +100 @@
       DO ij=ijb,ije
         dteta2(ij,1)=0.
+        dteta1(ij,llm)=0.
       ENDDO
 c$OMP END MASTER
@@ -129 +138 @@
            ENDDO
          endif
-         
+
       ENDDO
 c$OMP END DO      
@@ -169 +178 @@
 
 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-      DO 20 l = 1, llmm1
+      DO l = 1, llmm1
 
 
 c       ......   calcul de  - w/2.    au niveau  l+1   .......
-      ijb=ij_begin
-      ije=ij_end+iip1
-      if (pole_sud)  ije=ij_end
-      
-      DO 5   ij   = ijb, ije
-      wsur2( ij ) = - 0.5 * w( ij,l+1 )
-   5  CONTINUE
+        ijb=ij_begin
+        ije=ij_end+iip1
+        if (pole_sud)  ije=ij_end
+      
+        DO ij   = ijb, ije
+          wsur2( ij ) = - 0.5 * w( ij,l+1 )
+        ENDDO
 
 
 c     .....................     calcul pour  du     ..................
       
-      ijb=ij_begin
-      ije=ij_end
-      if (pole_nord) ijb=ijb+iip1
-      if (pole_sud)  ije=ije-iip1
-         
-      DO 6 ij = ijb ,ije-1
-      ww        = wsur2 (  ij  )     + wsur2( ij+1 ) 
-      uu        = 0.5 * ( ucov(ij,l) + ucov(ij,l+1) )
-      du1(ij,l)  =  ww * ( uu - uav(ij, l ) )/massebx(ij, l )
-      du2(ij,l+1)=  ww * ( uu - uav(ij,l+1) )/massebx(ij,l+1)
-   6  CONTINUE
+        ijb=ij_begin
+        ije=ij_end
+        if (pole_nord) ijb=ijb+iip1
+        if (pole_sud)  ije=ije-iip1
+         
+        DO ij = ijb ,ije-1
+          ww        = wsur2 (  ij  )     + wsur2( ij+1 ) 
+          uu        = 0.5 * ( ucov(ij,l) + ucov(ij,l+1) )
+          du1(ij,l)  =  ww * ( uu - uav(ij, l ) )/massebx(ij, l )
+          du2(ij,l+1)=  ww * ( uu - uav(ij,l+1) )/massebx(ij,l+1)
+        ENDDO
 
 c     .................    calcul pour   dv      .....................
-      ijb=ij_begin
-      ije=ij_end
-      if (pole_sud)  ije=ij_end-iip1
-      
-      DO 8 ij = ijb, ije
-      ww        = wsur2( ij+iip1 )   + wsur2( ij )
-      vv        = 0.5 * ( vcov(ij,l) + vcov(ij,l+1) )
-      dv1(ij,l)  =  ww * (vv - vav(ij, l ) )/masseby(ij, l )
-      dv2(ij,l+1)=  ww * (vv - vav(ij,l+1) )/masseby(ij,l+1)
-   8  CONTINUE
+        ijb=ij_begin
+        ije=ij_end
+        if (pole_sud)  ije=ij_end-iip1
+      
+        DO ij = ijb, ije
+          ww        = wsur2( ij+iip1 )   + wsur2( ij )
+          vv        = 0.5 * ( vcov(ij,l) + vcov(ij,l+1) )
+          dv1(ij,l)  =  ww * (vv - vav(ij, l ) )/masseby(ij, l )
+          dv2(ij,l+1)=  ww * (vv - vav(ij,l+1) )/masseby(ij,l+1)
+        ENDDO
 
 c
@@ -220 +229 @@
         ije=ij_end
         
-        DO 15 ij = ijb, ije
+        DO ij = ijb, ije
          ww            = wsur2(ij) * (teta(ij,l) + teta(ij,l+1) )
          dteta1(ij, l ) =   ww
          dteta2(ij,l+1) =   ww
-  15    CONTINUE
+        ENDDO
 
 c ym ---> conser a voir plus tard
@@ -237 +246 @@
 c      END IF
 
-  20  CONTINUE
+      ENDDO ! of DO l = 1, llmm1
 c$OMP END DO
 
@@ -279 +288 @@
 c$OMP END DO NOWAIT      
 
-      RETURN
       END