/[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 33 by guez, Fri Apr 9 10:56:14 2010 UTC revision 40 by guez, Tue Feb 22 13:49:36 2011 UTC
# Line 2  SUBROUTINE caldyn(itau, ucov, vcov, teta Line 2  SUBROUTINE caldyn(itau, ucov, vcov, teta
2       conser, du, dv, dteta, dp, w, pbaru, pbarv, time_0)       conser, du, dv, dteta, dp, w, pbaru, pbarv, time_0)
3    
4    ! From dyn3d/caldyn.F, v 1.1.1.1 2004/05/19 12:53:06    ! From dyn3d/caldyn.F, v 1.1.1.1 2004/05/19 12:53:06
5    !  Auteur :  P. Le Van    ! Auteur : P. Le Van
6    !   Objet:    ! Objet : calcul des tendances dynamiques
   !   Calcul des tendances dynamiques.  
7    
8    USE dimens_m, ONLY : iim, llm    USE dimens_m, ONLY : iim, llm
9    USE paramet_m, ONLY : iip1, ip1jm, ip1jmp1, jjp1, llmp1    USE paramet_m, ONLY : iip1, ip1jm, ip1jmp1, jjp1, llmp1
10    USE comvert, ONLY : ap, bp    USE comvert, ONLY : ap, bp
11    USE comgeom, ONLY : airesurg, constang    USE comgeom, ONLY : airesurg, constang
   USE pression_m, ONLY : pression  
12    use sortvarc_m, only: sortvarc    use sortvarc_m, only: sortvarc
13    
14    IMPLICIT NONE    IMPLICIT NONE
15    
16    !   Arguments:    ! Arguments:
17    
18    LOGICAL, INTENT (IN):: conser    LOGICAL, INTENT (IN):: conser
19    INTEGER, INTENT (IN):: itau    INTEGER, INTENT (IN):: itau
20    REAL vcov(ip1jm, llm), ucov(ip1jmp1, llm), teta(ip1jmp1, llm)    REAL vcov(ip1jm, llm), ucov(ip1jmp1, llm), teta(ip1jmp1, llm)
21    REAL ps(ip1jmp1), phis(ip1jmp1)    REAL ps(ip1jmp1), phis(ip1jmp1)
22    REAL, INTENT (IN) :: pk(iip1, jjp1, llm)    REAL, INTENT (IN):: pk(iip1, jjp1, llm)
23    REAL pkf(ip1jmp1, llm)    REAL pkf(ip1jmp1, llm)
24    REAL vcont(ip1jm, llm), ucont(ip1jmp1, llm)    REAL vcont(ip1jm, llm), ucont(ip1jmp1, llm)
25    REAL phi(ip1jmp1, llm), masse(ip1jmp1, llm)    REAL phi(ip1jmp1, llm), masse(ip1jmp1, llm)
# Line 30  SUBROUTINE caldyn(itau, ucov, vcov, teta Line 28  SUBROUTINE caldyn(itau, ucov, vcov, teta
28    REAL pbaru(ip1jmp1, llm), pbarv(ip1jm, llm)    REAL pbaru(ip1jmp1, llm), pbarv(ip1jm, llm)
29    REAL, intent(in):: time_0    REAL, intent(in):: time_0
30    
31    !   Local:    ! Local:
32    
33    REAL ang(ip1jmp1, llm), p(ip1jmp1, llmp1)    REAL ang(ip1jmp1, llm), p(ip1jmp1, llmp1)
34    REAL massebx(ip1jmp1, llm), masseby(ip1jm, llm), psexbarxy(ip1jm)    REAL massebx(ip1jmp1, llm), masseby(ip1jm, llm), psexbarxy(ip1jm)
# Line 42  SUBROUTINE caldyn(itau, ucov, vcov, teta Line 40  SUBROUTINE caldyn(itau, ucov, vcov, teta
40    INTEGER ij, l    INTEGER ij, l
41    
42    !-----------------------------------------------------------------------    !-----------------------------------------------------------------------
   !   Calcul des tendances dynamiques:  
43    
44    CALL covcont(llm, ucov, vcov, ucont, vcont)    CALL covcont(llm, ucov, vcov, ucont, vcont)
45    CALL pression(ip1jmp1, ap, bp, ps, p)    forall (l = 1: llm + 1) p(:, l) = ap(l) + bp(l) * ps
46    CALL psextbar(ps, psexbarxy)    CALL psextbar(ps, psexbarxy)
47    CALL massdair(p, masse)    CALL massdair(p, masse)
48    CALL massbar(masse, massebx, masseby)    CALL massbar(masse, massebx, masseby)
# Line 65  SUBROUTINE caldyn(itau, ucov, vcov, teta Line 62  SUBROUTINE caldyn(itau, ucov, vcov, teta
62    CALL bernoui(ip1jmp1, llm, phi, ecin, bern)    CALL bernoui(ip1jmp1, llm, phi, ecin, bern)
63    CALL dudv2(teta, pkf, bern, du, dv)    CALL dudv2(teta, pkf, bern, du, dv)
64    
   
65    DO l = 1, llm    DO l = 1, llm
66       DO ij = 1, ip1jmp1       DO ij = 1, ip1jmp1
67          ang(ij, l) = ucov(ij, l) + constang(ij)          ang(ij, l) = ucov(ij, l) + constang(ij)
68       END DO       END DO
69    END DO    END DO
70    
   
71    CALL advect(ang, vcov, teta, w, massebx, masseby, du, dv, dteta, conser)    CALL advect(ang, vcov, teta, w, massebx, masseby, du, dv, dteta, conser)
72    
73    !  WARNING probleme de peridocite de dv sur les PC/linux. Pb d'arrondi    ! WARNING probleme de peridocite de dv sur les PC/linux. Pb d'arrondi
74    !          probablement. Observe sur le code compile avec pgf90 3.0-1    ! probablement. Observe sur le code compile avec pgf90 3.0-1
75    DO l = 1, llm    DO l = 1, llm
76       DO ij = 1, ip1jm, iip1       DO ij = 1, ip1jm, iip1
77          IF (dv(ij, l)/=dv(ij+iim, l)) THEN          IF (dv(ij, l)/=dv(ij+iim, l)) THEN
# Line 85  SUBROUTINE caldyn(itau, ucov, vcov, teta Line 80  SUBROUTINE caldyn(itau, ucov, vcov, teta
80       END DO       END DO
81    END DO    END DO
82    
83    !   Sorties eventuelles des variables de controle:    ! Sorties eventuelles des variables de controle :
84    IF (conser) CALL sortvarc(itau, ucov, teta, ps, masse, pk, phis, vorpot, &    IF (conser) CALL sortvarc(itau, ucov, teta, ps, masse, pk, phis, vorpot, &
85         phi, bern, dp, time_0)         phi, bern, dp, time_0)
86    
Legend:
Removed from v.33  
changed lines
  Added in v.40
  ViewVC Help
Powered by ViewVC 1.1.21