/[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 40 by guez, Tue Feb 22 13:49:36 2011 UTC revision 43 by guez, Fri Apr 8 12:43:31 2011 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 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           conser, du, dv, dteta, dp, w, pbaru, pbarv, time_0)
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 dimens_m, ONLY : iim, llm
15        USE paramet_m, ONLY : iip1, ip1jm, ip1jmp1, jjp1, llmp1
16        USE comvert, ONLY : ap, bp
17        USE comgeom, ONLY : airesurg, constang
18        use sortvarc_m, only: sortvarc
19    
20        ! Arguments:
21    
22        LOGICAL, INTENT (IN):: conser
23        INTEGER, INTENT (IN):: itau
24        REAL vcov(ip1jm, llm), ucov(ip1jmp1, llm)
25        real, intent(in):: teta(ip1jmp1, llm)
26        REAL ps(ip1jmp1), phis(ip1jmp1)
27        REAL, INTENT (IN):: pk(iip1, jjp1, llm)
28        REAL pkf(ip1jmp1, llm)
29        REAL vcont(ip1jm, llm), ucont(ip1jmp1, llm)
30        REAL phi(ip1jmp1, llm), masse(ip1jmp1, llm)
31        REAL dv(ip1jm, llm), du(ip1jmp1, llm)
32        REAL dteta(ip1jmp1, llm), dp(ip1jmp1)
33        REAL pbaru(ip1jmp1, llm), pbarv(ip1jm, llm)
34        REAL, intent(in):: time_0
35        REAL, INTENT (out):: w(ip1jmp1, llm)
36    
37        ! Local:
38    
39        REAL ang(ip1jmp1, llm), p(ip1jmp1, llmp1)
40        REAL massebx(ip1jmp1, llm), masseby(ip1jm, llm), psexbarxy(ip1jm)
41        REAL vorpot(ip1jm, llm)
42        real ecin(ip1jmp1, llm), convm(ip1jmp1, llm)
43        REAL bern(ip1jmp1, llm)
44        REAL massebxy(ip1jm, llm)
45    
46        INTEGER ij, l
47    
48        !-----------------------------------------------------------------------
49    
50        CALL covcont(llm, ucov, vcov, ucont, vcont)
51        forall (l = 1: llm + 1) p(:, l) = ap(l) + bp(l) * ps
52        CALL psextbar(ps, psexbarxy)
53        CALL massdair(p, masse)
54        CALL massbar(masse, massebx, masseby)
55        CALL massbarxy(masse, massebxy)
56        CALL flumass(massebx, masseby, vcont, ucont, pbaru, pbarv)
57        CALL dteta1(teta, pbaru, pbarv, dteta)
58        CALL convmas(pbaru, pbarv, convm)
59    
60        DO ij = 1, ip1jmp1
61           dp(ij) = convm(ij, 1)/airesurg(ij)
62        END DO
63    
64        CALL vitvert(convm, w)
65        CALL tourpot(vcov, ucov, massebxy, vorpot)
66        CALL dudv1(vorpot, pbaru, pbarv, du, dv)
67        CALL enercin(vcov, ucov, vcont, ucont, ecin)
68        CALL bernoui(ip1jmp1, llm, phi, ecin, bern)
69        CALL dudv2(teta, pkf, bern, du, 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, du, dv, dteta, conser)
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  
   
   !-----------------------------------------------------------------------  
   
   CALL covcont(llm, ucov, vcov, ucont, vcont)  
   forall (l = 1: llm + 1) p(:, l) = ap(l) + bp(l) * ps  
   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.40  
changed lines
  Added in v.43
  ViewVC Help
Powered by ViewVC 1.1.21