/[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 79 by guez, Fri Feb 28 17:52:47 2014 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_2d
16        USE dimens_m, ONLY: iim, jjm, llm
17        USE disvert_m, ONLY: ap, bp
18        use flumass_m, only: flumass
19        use massbarxy_m, only: massbarxy
20        use massdair_m, only: massdair
21        USE paramet_m, ONLY: iip1, ip1jmp1, jjp1, llmp1
22        use sortvarc_m, only: sortvarc
23        use tourpot_m, only: tourpot
24    
25        ! Arguments:
26        INTEGER, INTENT(IN):: itau
27        REAL, INTENT(IN):: ucov(:, :, :) ! (iim + 1, jjm + 1, llm) vent covariant
28        REAL, INTENT(IN):: vcov(:, :, :) ! (iim + 1, jjm, llm) ! vent covariant
29        REAL, INTENT(IN):: teta(ip1jmp1, llm)
30        REAL, INTENT (IN):: ps(ip1jmp1)
31        real, intent(out):: masse(ip1jmp1, llm)
32        REAL, INTENT(IN):: pk(iip1, jjp1, llm)
33        REAL pkf(ip1jmp1, llm)
34        REAL, INTENT(IN):: phis(ip1jmp1)
35        REAL, INTENT(IN):: phi(ip1jmp1, llm)
36        REAL dudyn(ip1jmp1, llm), dv((iim + 1) * jjm, llm)
37        REAL dteta(ip1jmp1, llm)
38        real, INTENT(out):: dp(ip1jmp1)
39        REAL, INTENT(out):: w(ip1jmp1, llm)
40        REAL, intent(out):: pbaru(ip1jmp1, llm), pbarv((iim + 1) * jjm, llm)
41        REAL, intent(in):: time_0
42        LOGICAL, INTENT(IN):: conser
43    
44        ! Local:
45    
46        REAL vcont((iim + 1) * jjm, llm), ucont(ip1jmp1, llm)
47        REAL ang(iim + 1, jjm + 1, llm), p(ip1jmp1, llmp1)
48        REAL massebx(ip1jmp1, llm), masseby((iim + 1) * jjm, llm)
49        REAL vorpot(iim + 1, jjm, llm)
50        real ecin(ip1jmp1, llm), convm(ip1jmp1, llm)
51        REAL bern(ip1jmp1, llm)
52        REAL massebxy(iim + 1, jjm, llm)
53    
54        INTEGER ij, l
55    
56        !-----------------------------------------------------------------------
57    
58        CALL covcont(llm, ucov, vcov, ucont, vcont)
59        forall (l = 1: llm + 1) p(:, l) = ap(l) + bp(l) * ps
60        CALL massdair(p, masse)
61        CALL massbar(masse, massebx, masseby)
62        CALL massbarxy(masse, massebxy)
63        CALL flumass(massebx, masseby, vcont, ucont, pbaru, pbarv)
64        CALL dteta1(teta, pbaru, pbarv, dteta)
65        CALL convmas(pbaru, pbarv, convm)
66        dp = convm(:, 1) / airesurg
67        CALL vitvert(convm, w)
68        CALL tourpot(vcov, ucov, massebxy, vorpot)
69        CALL dudv1(vorpot, pbaru, pbarv, dudyn, dv)
70        CALL enercin(vcov, ucov, vcont, ucont, ecin)
71        CALL bernoui(ip1jmp1, llm, phi, ecin, bern)
72        CALL dudv2(teta, pkf, bern, dudyn, dv)
73    
74        forall (l = 1: llm) ang(:, :, l) = ucov(:, :, l) + constang_2d
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, (iim + 1) * jjm, 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, 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)  
92    
93  END SUBROUTINE caldyn  end module caldyn_m
Legend:
Removed from v.33  
changed lines
  Added in v.79
  ViewVC Help
Powered by ViewVC 1.1.21