/[lmdze]/trunk/libf/dyn3d/caldyn.f90
ViewVC logotype

Diff of /trunk/libf/dyn3d/caldyn.f90

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

revision 32 by guez, Tue Apr 6 17:52:58 2010 UTC revision 40 by guez, Tue Feb 22 13:49:36 2011 UTC
# Line 1  Line 1 
1  SUBROUTINE caldyn(itau, ucov, vcov, teta, ps, masse, pk, pkf, phis, phi, &  SUBROUTINE caldyn(itau, ucov, vcov, teta, ps, masse, pk, pkf, phis, phi, &
2       conser, du, dv, dteta, dp, w, pbaru, pbarv, time)       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
7    !   Calcul des tendances dynamiques.  
8      USE dimens_m, ONLY : iim, llm
9    USE dimens_m    USE paramet_m, ONLY : iip1, ip1jm, ip1jmp1, jjp1, llmp1
10    USE paramet_m    USE comvert, ONLY : ap, bp
11    USE comconst    USE comgeom, ONLY : airesurg, constang
12    USE comvert    use sortvarc_m, only: sortvarc
   USE comgeom  
   USE pression_m, ONLY : pression  
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)
26    REAL dv(ip1jm, llm), du(ip1jmp1, llm)    REAL dv(ip1jm, llm), du(ip1jmp1, llm)
27    REAL dteta(ip1jmp1, llm), dp(ip1jmp1)    REAL dteta(ip1jmp1, llm), dp(ip1jmp1)
28    REAL pbaru(ip1jmp1, llm), pbarv(ip1jm, llm)    REAL pbaru(ip1jmp1, llm), pbarv(ip1jm, llm)
29    REAL time    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)         phi, bern, dp, time_0)
86    
87  END SUBROUTINE caldyn  END SUBROUTINE caldyn
Legend:
Removed from v.32  
changed lines
  Added in v.40
  ViewVC Help
Powered by ViewVC 1.1.21