/[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/dyn3d/caldyn.f90 revision 79 by guez, Fri Feb 28 17:52:47 2014 UTC trunk/Sources/dyn3d/caldyn.f revision 207 by guez, Thu Sep 1 10:30:53 2016 UTC
# Line 5  module caldyn_m Line 5  module caldyn_m
5  contains  contains
6    
7    SUBROUTINE caldyn(itau, ucov, vcov, teta, ps, masse, pk, pkf, phis, phi, &    SUBROUTINE caldyn(itau, ucov, vcov, teta, ps, masse, pk, pkf, phis, phi, &
8         dudyn, dv, dteta, dp, w, pbaru, pbarv, time_0, conser)         dudyn, dv, dteta, dp, w, pbaru, pbarv, conser)
9    
10      ! From dyn3d/caldyn.F, version 1.1.1.1 2004/05/19 12:53:06      ! From dyn3d/caldyn.F, version 1.1.1.1, 2004/05/19 12:53:06
11      ! Auteur : P. Le Van      ! Author: P. Le Van
12      ! Objet : calcul des tendances dynamiques      ! Objet : calcul des tendances dynamiques
13    
14      use advect_m, only: advect      use advect_m, only: advect
15        use bernoui_m, only: bernoui
16        USE comconst, ONLY: daysec, dtvr
17      USE comgeom, ONLY: airesurg, constang_2d      USE comgeom, ONLY: airesurg, constang_2d
18        USE conf_gcm_m, ONLY: day_step
19        use convmas_m, only: convmas
20        use covcont_m, only: covcont
21      USE dimens_m, ONLY: iim, jjm, llm      USE dimens_m, ONLY: iim, jjm, llm
22      USE disvert_m, ONLY: ap, bp      USE disvert_m, ONLY: ap, bp
23        use dteta1_m, only: dteta1
24        use dudv1_m, only: dudv1
25        use dudv2_m, only: dudv2
26        USE dynetat0_m, ONLY: day_ini
27        use enercin_m, only: enercin
28      use flumass_m, only: flumass      use flumass_m, only: flumass
29        use massbar_m, only: massbar
30      use massbarxy_m, only: massbarxy      use massbarxy_m, only: massbarxy
31      use massdair_m, only: massdair      use massdair_m, only: massdair
32      USE paramet_m, ONLY: iip1, ip1jmp1, jjp1, llmp1      USE paramet_m, ONLY: iip1, ip1jmp1, jjp1, llmp1
33      use sortvarc_m, only: sortvarc      use sortvarc_m, only: sortvarc, ang, etot, ptot, rmsdpdt, rmsv, stot, ztot
34      use tourpot_m, only: tourpot      use tourpot_m, only: tourpot
35        use vitvert_m, only: vitvert
36    
     ! Arguments:  
37      INTEGER, INTENT(IN):: itau      INTEGER, INTENT(IN):: itau
38      REAL, INTENT(IN):: ucov(:, :, :) ! (iim + 1, jjm + 1, llm) vent covariant      REAL, INTENT(IN):: ucov(:, :, :) ! (iim + 1, jjm + 1, llm) vent covariant
39      REAL, INTENT(IN):: vcov(:, :, :) ! (iim + 1, jjm, llm) ! vent covariant      REAL, INTENT(IN):: vcov(:, :, :) ! (iim + 1, jjm, llm) vent covariant
40      REAL, INTENT(IN):: teta(ip1jmp1, llm)      REAL, INTENT(IN):: teta(:, :, :) ! (iim + 1, jjm + 1, llm)
41      REAL, INTENT (IN):: ps(ip1jmp1)      REAL, INTENT (IN):: ps(ip1jmp1)
42      real, intent(out):: masse(ip1jmp1, llm)      real, intent(out):: masse(ip1jmp1, llm)
43      REAL, INTENT(IN):: pk(iip1, jjp1, llm)      REAL, INTENT(IN):: pk(iip1, jjp1, llm)
44      REAL pkf(ip1jmp1, llm)      REAL, INTENT(IN):: pkf(ip1jmp1, llm)
45      REAL, INTENT(IN):: phis(ip1jmp1)      REAL, INTENT(IN):: phis(ip1jmp1)
46      REAL, INTENT(IN):: phi(ip1jmp1, llm)      REAL, INTENT(IN):: phi(iim + 1, jjm + 1, llm)
47      REAL dudyn(ip1jmp1, llm), dv((iim + 1) * jjm, llm)      REAL dudyn(:, :, :) ! (iim + 1, jjm + 1, llm)
48      REAL dteta(ip1jmp1, llm)      real dv((iim + 1) * jjm, llm)
49        REAL, INTENT(out):: dteta(:, :, :) ! (iim + 1, jjm + 1, llm)
50      real, INTENT(out):: dp(ip1jmp1)      real, INTENT(out):: dp(ip1jmp1)
51      REAL, INTENT(out):: w(ip1jmp1, llm)      REAL, INTENT(out):: w(:, :, :) ! (iim + 1, jjm + 1, llm)
52      REAL, intent(out):: pbaru(ip1jmp1, llm), pbarv((iim + 1) * jjm, llm)      REAL, intent(out):: pbaru(ip1jmp1, llm), pbarv((iim + 1) * jjm, llm)
     REAL, intent(in):: time_0  
53      LOGICAL, INTENT(IN):: conser      LOGICAL, INTENT(IN):: conser
54    
55      ! Local:      ! Local:
   
56      REAL vcont((iim + 1) * jjm, llm), ucont(ip1jmp1, llm)      REAL vcont((iim + 1) * jjm, llm), ucont(ip1jmp1, llm)
57      REAL ang(iim + 1, jjm + 1, llm), p(ip1jmp1, llmp1)      REAL ang_3d(iim + 1, jjm + 1, llm), p(ip1jmp1, llmp1)
58      REAL massebx(ip1jmp1, llm), masseby((iim + 1) * jjm, llm)      REAL massebx(ip1jmp1, llm), masseby((iim + 1) * jjm, llm)
59      REAL vorpot(iim + 1, jjm, llm)      REAL vorpot(iim + 1, jjm, llm)
60      real ecin(ip1jmp1, llm), convm(ip1jmp1, llm)      real ecin(iim + 1, jjm + 1, llm), convm(ip1jmp1, llm)
61      REAL bern(ip1jmp1, llm)      REAL bern(iim + 1, jjm + 1, llm)
62      REAL massebxy(iim + 1, jjm, llm)      REAL massebxy(iim + 1, jjm, llm)
   
63      INTEGER ij, l      INTEGER ij, l
64        real heure, time
65    
66      !-----------------------------------------------------------------------      !-----------------------------------------------------------------------
67    
# Line 66  contains Line 76  contains
76      dp = convm(:, 1) / airesurg      dp = convm(:, 1) / airesurg
77      CALL vitvert(convm, w)      CALL vitvert(convm, w)
78      CALL tourpot(vcov, ucov, massebxy, vorpot)      CALL tourpot(vcov, ucov, massebxy, vorpot)
79      CALL dudv1(vorpot, pbaru, pbarv, dudyn, dv)      CALL dudv1(vorpot, pbaru, pbarv, dudyn(:, 2: jjm, :), dv)
80      CALL enercin(vcov, ucov, vcont, ucont, ecin)      CALL enercin(vcov, ucov, vcont, ucont, ecin)
81      CALL bernoui(ip1jmp1, llm, phi, ecin, bern)      bern = bernoui(phi, ecin)
82      CALL dudv2(teta, pkf, bern, dudyn, dv)      CALL dudv2(teta, pkf, bern, dudyn, dv)
83    
84      forall (l = 1: llm) ang(:, :, l) = ucov(:, :, l) + constang_2d      forall (l = 1: llm) ang_3d(:, :, l) = ucov(:, :, l) + constang_2d
85      CALL advect(ang, vcov, teta, w, massebx, masseby, dudyn, dv, dteta)      CALL advect(ang_3d, vcov, teta, w, massebx, masseby, dudyn, dv, dteta)
86    
87      ! WARNING probleme de peridocite de dv sur les PC/linux. Pb d'arrondi      ! Warning problème de périodicité de dv sur les PC Linux. Problème
88      ! probablement. Observe sur le code compile avec pgf90 3.0-1      ! d'arrondi probablement. Observé sur le code compilé avec pgf90
89        ! 3.0-1.
90      DO l = 1, llm      DO l = 1, llm
91         DO ij = 1, (iim + 1) * jjm, iip1         DO ij = 1, (iim + 1) * jjm, iip1
92            IF (dv(ij, l)/=dv(ij+iim, l)) THEN            IF (dv(ij, l)/=dv(ij+iim, l)) THEN
# Line 84  contains Line 95  contains
95         END DO         END DO
96      END DO      END DO
97    
98      ! Sorties eventuelles des variables de controle :      ! Sorties éventuelles des variables de contrôle :
99      IF (conser) CALL sortvarc(itau, ucov, teta, ps, masse, pk, phis, vorpot, &      IF (conser) then
100           phi, bern, dp, time_0)         CALL sortvarc(ucov, teta, ps, masse, pk, phis, vorpot, phi, bern, dp, &
101                resetvarc = .false.)
102           time = real(itau) / day_step
103           heure = mod(itau * dtvr / daysec, 1.) * 24.
104           IF (abs(heure-24.) <= 1e-4) heure = 0.
105    
106           PRINT 3500, itau, int(day_ini + time), heure, time
107           PRINT 4000, ptot, rmsdpdt, etot, ztot, stot, rmsv, ang
108        end IF
109    
110    3500 FORMAT (4X, 'pas', I7, 5X, 'jour', i5, 1X, 'heure', F5.1, 4X, 'date', &
111             F10.5)
112    4000 FORMAT (10X, 'masse', 4X, 'rmsdpdt', 7X, 'energie', 2X, 'enstrophie', &
113             2X, 'entropie', 3X, 'rmsv', 4X, 'mt.ang', /, 'GLOB  ', F10.6, &
114             E13.6, 5F10.3/)
115    
116    END SUBROUTINE caldyn    END SUBROUTINE caldyn
117    
Legend:
Removed from v.79  
changed lines
  Added in v.207
  ViewVC Help
Powered by ViewVC 1.1.21