/[lmdze]/trunk/dyn3d/caldyn.f
ViewVC logotype

Diff of /trunk/dyn3d/caldyn.f

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

revision 25 by guez, Fri Mar 5 16:43:45 2010 UTC revision 67 by guez, Tue Oct 2 15:50:56 2012 UTC
# Line 1  Line 1 
1  SUBROUTINE caldyn(itau, ucov, vcov, teta, ps, masse, pk, pkf, phis, phi, &  module caldyn_m
      conser, du, dv, dteta, dp, w, pbaru, pbarv, time)  
   
   ! From dyn3d/caldyn.F, v 1.1.1.1 2004/05/19 12:53:06  
   !  Auteur :  P. Le Van  
   !   Objet:  
   !   Calcul des tendances dynamiques.  
   
   USE dimens_m  
   USE paramet_m  
   USE comconst  
   USE comvert  
   USE comgeom  
   USE pression_m, ONLY : pression  
2    
3    IMPLICIT NONE    IMPLICIT NONE
4    
5    !   Arguments:  contains
6    
7      SUBROUTINE caldyn(itau, ucov, vcov, teta, ps, masse, pk, pkf, phis, phi, &
8           dudyn, dv, dteta, dp, w, pbaru, pbarv, time_0, conser)
9    
10        ! From dyn3d/caldyn.F, v 1.1.1.1 2004/05/19 12:53:06
11        ! Auteur : P. Le Van
12        ! Objet : calcul des tendances dynamiques
13    
14        use advect_m, only: advect
15        USE comgeom, ONLY : airesurg, constang
16        USE dimens_m, ONLY : iim, llm
17        USE disvert_m, ONLY : ap, bp
18        use massdair_m, only: massdair
19        USE paramet_m, ONLY : iip1, ip1jm, ip1jmp1, jjp1, llmp1
20        use sortvarc_m, only: sortvarc
21    
22        ! Arguments:
23    
24        LOGICAL, INTENT(IN):: conser
25        INTEGER, INTENT(IN):: itau
26        REAL vcov(ip1jm, llm), ucov(ip1jmp1, llm)
27        real, intent(in):: teta(ip1jmp1, llm)
28        REAL, INTENT(IN):: ps(ip1jmp1), phis(ip1jmp1)
29        REAL, INTENT(IN):: pk(iip1, jjp1, llm)
30        REAL pkf(ip1jmp1, llm)
31        REAL vcont(ip1jm, llm), ucont(ip1jmp1, llm)
32        REAL phi(ip1jmp1, llm), masse(ip1jmp1, llm)
33        REAL dv(ip1jm, llm), dudyn(ip1jmp1, llm)
34        REAL dteta(ip1jmp1, llm)
35        real, INTENT(out):: dp(ip1jmp1)
36        REAL pbaru(ip1jmp1, llm), pbarv(ip1jm, llm)
37        REAL, intent(in):: time_0
38        REAL, INTENT(out):: w(ip1jmp1, llm)
39    
40        ! Local:
41    
42        REAL ang(ip1jmp1, llm), p(ip1jmp1, llmp1)
43        REAL massebx(ip1jmp1, llm), masseby(ip1jm, llm)
44        REAL vorpot(ip1jm, llm)
45        real ecin(ip1jmp1, llm), convm(ip1jmp1, llm)
46        REAL bern(ip1jmp1, llm)
47        REAL massebxy(ip1jm, llm)
48    
49        INTEGER ij, l
50    
51        !-----------------------------------------------------------------------
52    
53        CALL covcont(llm, ucov, vcov, ucont, vcont)
54        forall (l = 1: llm + 1) p(:, l) = ap(l) + bp(l) * ps
55        CALL massdair(p, masse)
56        CALL massbar(masse, massebx, masseby)
57        CALL massbarxy(masse, massebxy)
58        CALL flumass(massebx, masseby, vcont, ucont, pbaru, pbarv)
59        CALL dteta1(teta, pbaru, pbarv, dteta)
60        CALL convmas(pbaru, pbarv, convm)
61        dp = convm(:, 1) / airesurg
62        CALL vitvert(convm, w)
63        CALL tourpot(vcov, ucov, massebxy, vorpot)
64        CALL dudv1(vorpot, pbaru, pbarv, dudyn, dv)
65        CALL enercin(vcov, ucov, vcont, ucont, ecin)
66        CALL bernoui(ip1jmp1, llm, phi, ecin, bern)
67        CALL dudv2(teta, pkf, bern, dudyn, dv)
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        CALL advect(ang, vcov, teta, w, massebx, masseby, dudyn, dv, dteta)
76    
77        ! WARNING probleme de peridocite de dv sur les PC/linux. Pb d'arrondi
78        ! probablement. Observe sur le code compile avec pgf90 3.0-1
79        DO l = 1, llm
80           DO ij = 1, ip1jm, iip1
81              IF (dv(ij, l)/=dv(ij+iim, l)) THEN
82                 dv(ij+iim, l) = dv(ij, l)
83              END IF
84           END DO
85        END DO
86    
87        ! Sorties eventuelles des variables de controle :
88        IF (conser) CALL sortvarc(itau, ucov, teta, ps, masse, pk, phis, vorpot, &
89             phi, bern, dp, time_0)
90    
91    LOGICAL, INTENT (IN):: conser    END SUBROUTINE caldyn
   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  
   
   !   Local:  
   
   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  
   
   !-----------------------------------------------------------------------  
   !   Calcul des tendances dynamiques:  
   
   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)  
   END DO  
   
   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)  
      END DO  
   END DO  
   
   
   CALL advect(ang, vcov, teta, w, massebx, masseby, du, dv, dteta, conser)  
   
   !  WARNING probleme de peridocite de dv sur les PC/linux. Pb d'arrondi  
   !          probablement. Observe sur le code compile avec pgf90 3.0-1  
   DO l = 1, llm  
      DO ij = 1, ip1jm, iip1  
         IF (dv(ij, l)/=dv(ij+iim, l)) THEN  
            dv(ij+iim, l) = dv(ij, l)  
         END IF  
      END DO  
   END DO  
   
   !   Sorties eventuelles des variables de controle:  
   IF (conser) THEN  
      CALL sortvarc(itau, ucov, teta, ps, masse, pk, phis, vorpot, phi, bern, &  
           dp, time)  
   END IF  
92    
93  END SUBROUTINE caldyn  end module caldyn_m
Legend:
Removed from v.25  
changed lines
  Added in v.67
  ViewVC Help
Powered by ViewVC 1.1.21