Changeset 1279 for LMDZ4/trunk/libf/dyn3d/advtrac.F

Timestamp:

Dec 10, 2009, 10:02:56 AM (15 years ago)

Author:

Laurent Fairhead

Message:

Merged LMDZ4-dev branch changes r1241:1278 into the trunk
Running trunk and LMDZ4-dev in LMDZOR configuration on local
machine (sequential) and SX8 (4-proc) yields identical results
(restart and restartphy are identical binarily)
Log history from r1241 to r1278 is available by switching to
source:LMDZ4/branches/LMDZ4-dev-20091210

Location:

LMDZ4/trunk

Files:

• . (modified) (1 prop)
• libf/dyn3d/advtrac.F (modified) (4 diffs)

LMDZ4/trunk/libf/dyn3d/advtrac.F

@@ -1 +1 @@
 !
-! $Header$
+! $Id$
 !
 c
@@ -30 +30 @@
 #include "ener.h"
 #include "description.h"
+#include "iniprint.h"
 
 c-------------------------------------------------------------------
@@ -74 +75 @@
       DATA dum/.true./
 
+      integer,save :: countcfl=0
+      real cflx(ip1jmp1,llm)
+      real cfly(ip1jm,llm)
+      real cflz(ip1jmp1,llm)
+      real, save :: cflxmax(llm),cflymax(llm),cflzmax(llm)
 
       IF(iadvtr.EQ.0) THEN
@@ -139 +145 @@
          ENDDO
 
+
+c-------------------------------------------------------------------
+! Calcul des criteres CFL en X, Y et Z
+c-------------------------------------------------------------------
+
+      if (countcfl == 0. ) then
+          cflxmax(:)=0.
+          cflymax(:)=0.
+          cflzmax(:)=0.
+      endif
+
+      countcfl=countcfl+iapp_tracvl
+      cflx(:,:)=0.
+      cfly(:,:)=0.
+      cflz(:,:)=0.
+      do l=1,llm
+         do ij=iip2,ip1jm-1
+            if (pbarug(ij,l)>=0.) then
+                cflx(ij,l)=pbarug(ij,l)*dtvr/masse(ij,l)
+            else
+                cflx(ij,l)=-pbarug(ij,l)*dtvr/masse(ij+1,l)
+            endif 
+         enddo
+      enddo
+      do l=1,llm
+         do ij=iip2,ip1jm-1,iip1
+            cflx(ij+iip1,l)=cflx(ij,l)
+         enddo
+      enddo
+
+      do l=1,llm
+         do ij=1,ip1jm
+            if (pbarvg(ij,l)>=0.) then
+                cfly(ij,l)=pbarvg(ij,l)*dtvr/masse(ij,l)
+            else
+                cfly(ij,l)=-pbarvg(ij,l)*dtvr/masse(ij+iip1,l)
+            endif 
+         enddo
+      enddo
+
+      do l=2,llm
+         do ij=1,ip1jm
+            if (wg(ij,l)>=0.) then
+                cflz(ij,l)=wg(ij,l)*dtvr/masse(ij,l)
+            else
+                cflz(ij,l)=-wg(ij,l)*dtvr/masse(ij,l-1)
+            endif 
+         enddo
+      enddo
+
+      do l=1,llm
+         cflxmax(l)=max(cflxmax(l),maxval(cflx(:,l)))
+         cflymax(l)=max(cflymax(l),maxval(cfly(:,l)))
+         cflzmax(l)=max(cflzmax(l),maxval(cflz(:,l)))
+      enddo
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! Par defaut, on sort le diagnostic des CFL tous les jours.
+! Si on veut le sortir a chaque pas d'advection en cas de plantage 
+!     if (countcfl==iapp_tracvl) then
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      if (countcfl==day_step) then
+         do l=1,llm
+         write(lunout,*) 'L, CFLmax '
+     s   ,l,maxval(cflx(:,l)),maxval(cfly(:,l)),maxval(cflz(:,l))
+         enddo
+         countcfl=0
+      endif
+    
 c-------------------------------------------------------------------
 c   Advection proprement dite (Modification Le Croller (07/2001)