Changeset 109 for trunk/libf/dyn3d

Timestamp:

Apr 14, 2011, 11:47:04 AM (14 years ago)

Author:

slebonnois

Message:

SLebonnois: discretisation verticale: cohabitation entre
la methode Terre et les autres.

Location:

trunk/libf/dyn3d

Files:

• comvert.h (modified) (1 diff)
• disvert_noterre.F (added)
• disvert_terre.F90 (moved) (moved from trunk/libf/dyn3d/disvert.F90) (1 diff)
• exner_milieu.F (copied) (copied from trunk/mars/libf/dyn3d/exner_hyb.F) (2 diffs)
• iniconst.F (modified) (1 diff)
• leapfrog.F (modified) (3 diffs)
• limy.F (modified) (3 diffs)
• vlsplt.F (modified) (3 diffs)
• vlspltqs.F (modified) (2 diffs)

trunk/libf/dyn3d/comvert.h

@@ -6 +6 @@
 
       COMMON/comvert/ap(llm+1),bp(llm+1),presnivs(llm),dpres(llm),      &
-     &               pa,preff,nivsigs(llm),nivsig(llm+1)
+     &               pa,preff,nivsigs(llm),nivsig(llm+1),               &
+     &               aps(llm),bps(llm)
 
-      REAL ap,bp,presnivs,dpres,pa,preff,nivsigs,nivsig
+      REAL ap,bp,presnivs,dpres,pa,preff,nivsigs,nivsig,aps,bps
 
  !-----------------------------------------------------------------------

trunk/libf/dyn3d/disvert_terre.F90

@@ -1 +1 @@
 ! $Id: disvert.F90 1480 2011-01-31 21:29:58Z jghattas $
 
-SUBROUTINE disvert(pa, preff, ap, bp, dpres, presnivs, nivsigs, nivsig)
+SUBROUTINE disvert_terre(pa, preff, ap, bp, dpres, presnivs, nivsigs, nivsig)
 
   ! Auteur : P. Le Van

trunk/libf/dyn3d/exner_milieu.F

@@ -1 @@
-      SUBROUTINE  exner_hyb ( ngrid, ps, p,beta, pks, pk, pkf )
+      SUBROUTINE  exner_milieu ( ngrid, ps, p,beta, pks, pk, pkf )
 c
 c     Auteurs :  F. Forget , Y. Wanherdrick
@@ -17 +17 @@
 c
 c     WARNING : CECI est une version speciale de exner_hyb originale
-c               Utilis‰ dans la version martienne pour pouvoir 
-c               tourner avec des coordonn‰es verticales complexe
-c              => Il ne verifie PAS la condition la proportionalit‰ en 
-c              ‰nergie totale/ interne / potentielle (F.Forget 2001)
+c               Utilise dans la version martienne pour pouvoir 
+c               tourner avec des coordonnees verticales complexe
+c              => Il ne verifie PAS la condition la proportionalite en 
+c              energie totale/ interne / potentielle (F.Forget 2001)
 c    ( voir note de Fr.Hourdin )  ,
 c

trunk/libf/dyn3d/iniconst.F

@@ -53 +53 @@
 c-----------------------------------------------------------------------
 
-       CALL disvert(pa,preff,ap,bp,dpres,presnivs,nivsigs,nivsig)
-c
+      if (planet_type.eq."earth") then
+       CALL disvert_terre(pa,preff,ap,bp,dpres,presnivs,nivsigs,nivsig)
+      else
+       CALL disvert_noterre
+      endif
 c
        RETURN

trunk/libf/dyn3d/leapfrog.F

@@ -238 +238 @@
       dq(:,:,:)=0.
       CALL pression ( ip1jmp1, ap, bp, ps, p       )
-      CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
+      if (planet_type.eq."earth") then
+        CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
+      else
+        CALL exner_milieu( ip1jmp1, ps, p, beta, pks, pk, pkf )
+      endif
+
 c------------------
 c TEST PK MONOTONE
@@ -404 +409 @@
 
          CALL pression (  ip1jmp1, ap, bp, ps,  p      )
-         CALL exner_hyb(  ip1jmp1, ps, p,alpha,beta,pks, pk, pkf )
+         if (planet_type.eq."earth") then
+           CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
+         else
+           CALL exner_milieu( ip1jmp1, ps, p, beta, pks, pk, pkf )
+         endif
 
 !           rdaym_ini  = itau * dtvr / daysec
@@ -519 +528 @@
 
         CALL pression ( ip1jmp1, ap, bp, ps, p                  )
-        CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
+        if (planet_type.eq."earth") then
+          CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
+        else
+          CALL exner_milieu( ip1jmp1, ps, p, beta, pks, pk, pkf )
+        endif
 
 

trunk/libf/dyn3d/limy.F

@@ -40 +40 @@
       REAL qbyv(ip1jm,llm)
 
-      REAL qpns,qpsn,apn,aps,dyn1,dys1,dyn2,dys2
+      REAL qpns,qpsn,appn,apps,dyn1,dys1,dyn2,dys2
       Logical extremum,first
       save first
@@ -117 +117 @@
 
 c     print*,dyqv(iip1+1)
-c     apn=abs(dyq(1)/dyqv(iip1+1))
+c     appn=abs(dyq(1)/dyqv(iip1+1))
 c     print*,dyq(ip1jm+1)
 c     print*,dyqv(ip1jm-iip1+1)
-c     aps=abs(dyq(ip1jm+1)/dyqv(ip1jm-iip1+1))
+c     apps=abs(dyq(ip1jm+1)/dyqv(ip1jm-iip1+1))
 c     do ij=2,iim
-c        apn=amax1(abs(dyq(ij)/dyqv(ij)),apn)
-c        aps=amax1(abs(dyq(ip1jm+ij)/dyqv(ip1jm-iip1+ij)),aps)
+c        appn=amax1(abs(dyq(ij)/dyqv(ij)),appn)
+c        apps=amax1(abs(dyq(ip1jm+ij)/dyqv(ip1jm-iip1+ij)),apps)
 c     enddo
-c     apn=min(pente_max/apn,1.)
-c     aps=min(pente_max/aps,1.)
+c     appn=min(pente_max/appn,1.)
+c     apps=min(pente_max/apps,1.)
 
 
@@ -132 +132 @@
 
 c     if(dyqv(ismin(iim,dyqv,1))*dyqv(ismax(iim,dyqv,1)).le.0.)
-c    &   apn=0.
+c    &   appn=0.
 c     if(dyqv(ismax(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1)*
 c    &   dyqv(ismin(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1).le.0.)
-c    &   aps=0.
+c    &   apps=0.
 
 c   limitation des pentes aux poles
 c     do ij=1,iip1
-c        dyq(ij)=apn*dyq(ij)
-c        dyq(ip1jm+ij)=aps*dyq(ip1jm+ij)
+c        dyq(ij)=appn*dyq(ij)
+c        dyq(ip1jm+ij)=apps*dyq(ip1jm+ij)
 c     enddo
 

trunk/libf/dyn3d/vlsplt.F

@@ -478 +478 @@
       REAL qbyv(ip1jm,llm)
 
-      REAL qpns,qpsn,apn,aps,dyn1,dys1,dyn2,dys2,newmasse,fn,fs
+      REAL qpns,qpsn,appn,apps,dyn1,dys1,dyn2,dys2,newmasse,fn,fs
 c     REAL newq,oldmasse
       Logical extremum,first,testcpu
@@ -602 +602 @@
 C     PRINT*,dyq(1)
 C     PRINT*,dyqv(iip1+1)
-C     apn=abs(dyq(1)/dyqv(iip1+1))
+C     appn=abs(dyq(1)/dyqv(iip1+1))
 C     PRINT*,dyq(ip1jm+1)
 C     PRINT*,dyqv(ip1jm-iip1+1)
-C     aps=abs(dyq(ip1jm+1)/dyqv(ip1jm-iip1+1))
+C     apps=abs(dyq(ip1jm+1)/dyqv(ip1jm-iip1+1))
 C     DO ij=2,iim
-C        apn=amax1(abs(dyq(ij)/dyqv(ij)),apn)
-C        aps=amax1(abs(dyq(ip1jm+ij)/dyqv(ip1jm-iip1+ij)),aps)
+C        appn=amax1(abs(dyq(ij)/dyqv(ij)),appn)
+C        apps=amax1(abs(dyq(ip1jm+ij)/dyqv(ip1jm-iip1+ij)),apps)
 C     ENDDO
-C     apn=min(pente_max/apn,1.)
-C     aps=min(pente_max/aps,1.)
+C     appn=min(pente_max/appn,1.)
+C     apps=min(pente_max/apps,1.)
 C
 C
@@ -617 +617 @@
 C
 C     IF(dyqv(ismin(iim,dyqv,1))*dyqv(ismax(iim,dyqv,1)).le.0.)
-C    &   apn=0.
+C    &   appn=0.
 C     IF(dyqv(ismax(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1)*
 C    &   dyqv(ismin(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1).le.0.)
-C    &   aps=0.
+C    &   apps=0.
 C
 C   limitation des pentes aux poles
 C     DO ij=1,iip1
-C        dyq(ij)=apn*dyq(ij)
-C        dyq(ip1jm+ij)=aps*dyq(ip1jm+ij)
+C        dyq(ij)=appn*dyq(ij)
+C        dyq(ip1jm+ij)=apps*dyq(ip1jm+ij)
 C     ENDDO
 C

trunk/libf/dyn3d/vlspltqs.F

@@ -635 +635 @@
 C     PRINT*,dyq(1)
 C     PRINT*,dyqv(iip1+1)
-C     apn=abs(dyq(1)/dyqv(iip1+1))
+C     appn=abs(dyq(1)/dyqv(iip1+1))
 C     PRINT*,dyq(ip1jm+1)
 C     PRINT*,dyqv(ip1jm-iip1+1)
-C     aps=abs(dyq(ip1jm+1)/dyqv(ip1jm-iip1+1))
+C     apps=abs(dyq(ip1jm+1)/dyqv(ip1jm-iip1+1))
 C     DO ij=2,iim
-C        apn=amax1(abs(dyq(ij)/dyqv(ij)),apn)
-C        aps=amax1(abs(dyq(ip1jm+ij)/dyqv(ip1jm-iip1+ij)),aps)
+C        appn=amax1(abs(dyq(ij)/dyqv(ij)),appn)
+C        apps=amax1(abs(dyq(ip1jm+ij)/dyqv(ip1jm-iip1+ij)),apps)
 C     ENDDO
-C     apn=min(pente_max/apn,1.)
-C     aps=min(pente_max/aps,1.)
+C     appn=min(pente_max/appn,1.)
+C     apps=min(pente_max/apps,1.)
 C
 C
@@ -650 +650 @@
 C
 C     IF(dyqv(ismin(iim,dyqv,1))*dyqv(ismax(iim,dyqv,1)).le.0.)
-C    &   apn=0.
+C    &   appn=0.
 C     IF(dyqv(ismax(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1)*
 C    &   dyqv(ismin(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1).le.0.)
-C    &   aps=0.
+C    &   apps=0.
 C
 C   limitation des pentes aux poles
 C     DO ij=1,iip1
-C        dyq(ij)=apn*dyq(ij)
-C        dyq(ip1jm+ij)=aps*dyq(ip1jm+ij)
+C        dyq(ij)=appn*dyq(ij)
+C        dyq(ip1jm+ij)=apps*dyq(ip1jm+ij)
 C     ENDDO
 C