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

Diff of /trunk/dyn3d/caldyn.f

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

trunk/libf/dyn3d/caldyn.f90 revision 33 by guez, Fri Apr 9 10:56:14 2010 UTC trunk/dyn3d/caldyn.f90 revision 76 by guez, Fri Nov 15 18:45:49 2013 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_0)  
   
   ! 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, ONLY : iim, llm  
   USE paramet_m, ONLY : iip1, ip1jm, ip1jmp1, jjp1, llmp1  
   USE comvert, ONLY : ap, bp  
   USE comgeom, ONLY : airesurg, constang  
   USE pression_m, ONLY : pression  
   use sortvarc_m, only: sortvarc  
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, version 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        INTEGER, INTENT(IN):: itau
25        REAL ucov(ip1jmp1, llm), vcov(ip1jm, llm)
26        real, intent(in):: teta(ip1jmp1, llm)
27        REAL, INTENT(IN):: ps(ip1jmp1)
28        real, intent(out):: masse(ip1jmp1, llm)
29        REAL, INTENT(IN):: pk(iip1, jjp1, llm)
30        REAL pkf(ip1jmp1, llm)
31        REAL, INTENT(IN):: phis(ip1jmp1)
32        REAL, INTENT(IN):: phi(ip1jmp1, llm)
33        REAL dv(ip1jm, llm), dudyn(ip1jmp1, llm)
34        REAL dteta(ip1jmp1, llm)
35        real, INTENT(out):: dp(ip1jmp1)
36        REAL, INTENT(out):: w(ip1jmp1, llm)
37        REAL pbaru(ip1jmp1, llm), pbarv(ip1jm, llm)
38        REAL, intent(in):: time_0
39        LOGICAL, INTENT(IN):: conser
40    
41        ! Local:
42    
43        REAL vcont(ip1jm, llm), ucont(ip1jmp1, llm)
44        REAL ang(ip1jmp1, llm), p(ip1jmp1, llmp1)
45        REAL massebx(ip1jmp1, llm), masseby(ip1jm, llm)
46        REAL vorpot(ip1jm, llm)
47        real ecin(ip1jmp1, llm), convm(ip1jmp1, llm)
48        REAL bern(ip1jmp1, llm)
49        REAL massebxy(ip1jm, llm)
50    
51        INTEGER ij, l
52    
53        !-----------------------------------------------------------------------
54    
55        CALL covcont(llm, ucov, vcov, ucont, vcont)
56        forall (l = 1: llm + 1) p(:, l) = ap(l) + bp(l) * ps
57        CALL massdair(p, masse)
58        CALL massbar(masse, massebx, masseby)
59        CALL massbarxy(masse, massebxy)
60        CALL flumass(massebx, masseby, vcont, ucont, pbaru, pbarv)
61        CALL dteta1(teta, pbaru, pbarv, dteta)
62        CALL convmas(pbaru, pbarv, convm)
63        dp = convm(:, 1) / airesurg
64        CALL vitvert(convm, w)
65        CALL tourpot(vcov, ucov, massebxy, vorpot)
66        CALL dudv1(vorpot, pbaru, pbarv, dudyn, dv)
67        CALL enercin(vcov, ucov, vcont, ucont, ecin)
68        CALL bernoui(ip1jmp1, llm, phi, ecin, bern)
69        CALL dudv2(teta, pkf, bern, dudyn, dv)
70    
71        DO l = 1, llm
72           DO ij = 1, ip1jmp1
73              ang(ij, l) = ucov(ij, l) + constang(ij)
74           END DO
75        END DO
76    
77        CALL advect(ang, vcov, teta, w, massebx, masseby, dudyn, dv, dteta)
78    
79        ! WARNING probleme de peridocite de dv sur les PC/linux. Pb d'arrondi
80        ! probablement. Observe sur le code compile avec pgf90 3.0-1
81        DO l = 1, llm
82           DO ij = 1, ip1jm, iip1
83              IF (dv(ij, l)/=dv(ij+iim, l)) THEN
84                 dv(ij+iim, l) = dv(ij, l)
85              END IF
86           END DO
87        END DO
88    
89        ! Sorties eventuelles des variables de controle :
90        IF (conser) CALL sortvarc(itau, ucov, teta, ps, masse, pk, phis, vorpot, &
91             phi, bern, dp, time_0)
92    
93    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, intent(in):: time_0  
   
   !   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) CALL sortvarc(itau, ucov, teta, ps, masse, pk, phis, vorpot, &  
        phi, bern, dp, time_0)  
94    
95  END SUBROUTINE caldyn  end module caldyn_m
Legend:
Removed from v.33  
changed lines
  Added in v.76
  ViewVC Help
Powered by ViewVC 1.1.21