/[lmdze]/trunk/libf/dyn3d/caldyn.f90
ViewVC logotype

Diff of /trunk/libf/dyn3d/caldyn.f90

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

trunk/libf/dyn3d/caldyn.f revision 23 by guez, Mon Dec 14 15:25:16 2009 UTC trunk/libf/dyn3d/caldyn.f90 revision 25 by guez, Fri Mar 5 16:43:45 2010 UTC
# Line 1  Line 1 
1  !  SUBROUTINE caldyn(itau, ucov, vcov, teta, ps, masse, pk, pkf, phis, phi, &
2  ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/caldyn.F,v 1.1.1.1 2004/05/19 12:53:06 lmdzadmin Exp $       conser, du, dv, dteta, dp, w, pbaru, pbarv, time)
 !  
 c  
 c  
       SUBROUTINE caldyn  
      $ (itau,ucov,vcov,teta,ps,masse,pk,pkf,phis ,  
      $  phi,conser,du,dv,dteta,dp,w,pbaru,pbarv,time )  
   
       use dimens_m  
       use paramet_m  
       use comconst  
       use comvert  
       use comgeom  
       use pression_m, only: pression  
   
       IMPLICIT NONE  
   
 c=======================================================================  
 c  
 c  Auteur :  P. Le Van  
 c  
 c   Objet:  
 c   ------  
 c  
 c   Calcul des tendances dynamiques.  
 c  
 c Modif 04/93 F.Forget  
 c=======================================================================  
   
 c-----------------------------------------------------------------------  
 c   0. Declarations:  
 c   ----------------  
   
   
 c   Arguments:  
 c   ----------  
   
       LOGICAL conser  
   
       INTEGER, intent(in):: itau  
       REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)  
       REAL ps(ip1jmp1),phis(ip1jmp1)  
       REAL, intent(in):: pk(iip1,jjp1,llm)  
       real pkf(ip1jmp1,llm)  
       REAL vcont(ip1jm,llm),ucont(ip1jmp1,llm)  
       REAL phi(ip1jmp1,llm),masse(ip1jmp1,llm)  
       REAL dv(ip1jm,llm),du(ip1jmp1,llm)  
       REAL dteta(ip1jmp1,llm),dp(ip1jmp1)  
       REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)  
       REAL time  
   
 c   Local:  
 c   ------  
   
       REAL ang(ip1jmp1,llm),p(ip1jmp1,llmp1)  
       REAL massebx(ip1jmp1,llm),masseby(ip1jm,llm),psexbarxy(ip1jm)  
       REAL vorpot(ip1jm,llm)  
       REAL w(ip1jmp1,llm),ecin(ip1jmp1,llm),convm(ip1jmp1,llm)  
       REAL bern(ip1jmp1,llm)  
       REAL massebxy(ip1jm,llm)  
       
       INTEGER   ij,l  
   
 c-----------------------------------------------------------------------  
 c   Calcul des tendances dynamiques:  
 c   --------------------------------  
   
       CALL covcont  ( llm    , ucov    , vcov , ucont, vcont        )  
       CALL pression ( ip1jmp1, ap      , bp   ,  ps  , p            )  
       CALL psextbar (   ps   , psexbarxy                            )  
       CALL massdair (    p   , masse                                )  
       CALL massbar  (   masse, massebx , masseby                    )  
       call massbarxy(   masse, massebxy                             )  
       CALL flumass  ( massebx, masseby , vcont, ucont ,pbaru, pbarv )  
       CALL dteta1   (   teta , pbaru   , pbarv, dteta               )  
       CALL convmas  (   pbaru, pbarv   , convm                      )  
   
       DO ij =1, ip1jmp1  
          dp( ij ) = convm( ij,1 ) / airesurg( ij )  
       ENDDO  
   
       CALL vitvert ( convm  , w                                  )  
       CALL tourpot ( vcov   , ucov  , massebxy  , vorpot         )  
       CALL dudv1   ( vorpot , pbaru , pbarv     , du     , dv    )  
       CALL enercin ( vcov   , ucov  , vcont     , ucont  , ecin  )  
       CALL bernoui ( ip1jmp1, llm   , phi       , ecin   , bern  )  
       CALL dudv2   ( teta   , pkf   , bern      , du     , dv    )  
   
   
       DO l=1,llm  
          DO ij=1,ip1jmp1  
             ang(ij,l) = ucov(ij,l) + constang(ij)  
       ENDDO  
       ENDDO  
   
   
       CALL advect( ang, vcov, teta, w, massebx, masseby, du, dv,dteta,  
      $     conser )  
   
 C  WARNING probleme de peridocite de dv sur les PC/linux. Pb d'arrondi  
 C          probablement. Observe sur le code compile avec pgf90 3.0-1  
   
       DO l = 1, llm  
          DO ij = 1, ip1jm, iip1  
            IF( dv(ij,l).NE.dv(ij+iim,l) )  THEN  
 c         PRINT *,'!!!ATTENTION!!! probleme de periodicite sur vcov',    
 c    ,   ' dans caldyn'  
 c         PRINT *,' l,  ij = ', l, ij, ij+iim,dv(ij+iim,l),dv(ij,l)  
           dv(ij+iim,l) = dv(ij,l)  
           endif  
          enddo  
       enddo  
 c-----------------------------------------------------------------------  
 c   Sorties eventuelles des variables de controle:  
 c   ----------------------------------------------  
   
       IF( conser )  THEN  
         CALL sortvarc  
      $ ( itau,ucov,teta,ps,masse,pk,phis,vorpot,phi,bern,dp,time)  
3    
4        ENDIF    ! From dyn3d/caldyn.F, v 1.1.1.1 2004/05/19 12:53:06
5      !  Auteur :  P. Le Van
6      !   Objet:
7      !   Calcul des tendances dynamiques.
8    
9      USE dimens_m
10      USE paramet_m
11      USE comconst
12      USE comvert
13      USE comgeom
14      USE pression_m, ONLY : pression
15    
16      IMPLICIT NONE
17    
18      !   Arguments:
19    
20      LOGICAL, INTENT (IN):: conser
21      INTEGER, INTENT (IN):: itau
22      REAL vcov(ip1jm, llm), ucov(ip1jmp1, llm), teta(ip1jmp1, llm)
23      REAL ps(ip1jmp1), phis(ip1jmp1)
24      REAL, INTENT (IN) :: pk(iip1, jjp1, llm)
25      REAL pkf(ip1jmp1, llm)
26      REAL vcont(ip1jm, llm), ucont(ip1jmp1, llm)
27      REAL phi(ip1jmp1, llm), masse(ip1jmp1, llm)
28      REAL dv(ip1jm, llm), du(ip1jmp1, llm)
29      REAL dteta(ip1jmp1, llm), dp(ip1jmp1)
30      REAL pbaru(ip1jmp1, llm), pbarv(ip1jm, llm)
31      REAL time
32    
33      !   Local:
34    
35      REAL ang(ip1jmp1, llm), p(ip1jmp1, llmp1)
36      REAL massebx(ip1jmp1, llm), masseby(ip1jm, llm), psexbarxy(ip1jm)
37      REAL vorpot(ip1jm, llm)
38      REAL w(ip1jmp1, llm), ecin(ip1jmp1, llm), convm(ip1jmp1, llm)
39      REAL bern(ip1jmp1, llm)
40      REAL massebxy(ip1jm, llm)
41    
42      INTEGER ij, l
43    
44      !-----------------------------------------------------------------------
45      !   Calcul des tendances dynamiques:
46    
47      CALL covcont(llm, ucov, vcov, ucont, vcont)
48      CALL pression(ip1jmp1, ap, bp, ps, p)
49      CALL psextbar(ps, psexbarxy)
50      CALL massdair(p, masse)
51      CALL massbar(masse, massebx, masseby)
52      CALL massbarxy(masse, massebxy)
53      CALL flumass(massebx, masseby, vcont, ucont, pbaru, pbarv)
54      CALL dteta1(teta, pbaru, pbarv, dteta)
55      CALL convmas(pbaru, pbarv, convm)
56    
57      DO ij = 1, ip1jmp1
58         dp(ij) = convm(ij, 1)/airesurg(ij)
59      END DO
60    
61      CALL vitvert(convm, w)
62      CALL tourpot(vcov, ucov, massebxy, vorpot)
63      CALL dudv1(vorpot, pbaru, pbarv, du, dv)
64      CALL enercin(vcov, ucov, vcont, ucont, ecin)
65      CALL bernoui(ip1jmp1, llm, phi, ecin, bern)
66      CALL dudv2(teta, pkf, bern, du, dv)
67    
68    
69      DO l = 1, llm
70         DO ij = 1, ip1jmp1
71            ang(ij, l) = ucov(ij, l) + constang(ij)
72         END DO
73      END DO
74    
75    
76      CALL advect(ang, vcov, teta, w, massebx, masseby, du, dv, dteta, conser)
77    
78      !  WARNING probleme de peridocite de dv sur les PC/linux. Pb d'arrondi
79      !          probablement. Observe sur le code compile avec pgf90 3.0-1
80      DO l = 1, llm
81         DO ij = 1, ip1jm, iip1
82            IF (dv(ij, l)/=dv(ij+iim, l)) THEN
83               dv(ij+iim, l) = dv(ij, l)
84            END IF
85         END DO
86      END DO
87    
88      !   Sorties eventuelles des variables de controle:
89      IF (conser) THEN
90         CALL sortvarc(itau, ucov, teta, ps, masse, pk, phis, vorpot, phi, bern, &
91              dp, time)
92      END IF
93    
94        RETURN  END SUBROUTINE caldyn
       END  

Legend:
Removed from v.23  
changed lines
  Added in v.25

  ViewVC Help
Powered by ViewVC 1.1.21