/[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 76 by guez, Fri Nov 15 18:45:49 2013 UTC trunk/dyn3d/caldyn.f revision 254 by guez, Mon Feb 5 10:39:38 2018 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 comgeom, ONLY: airesurg, constang      use bernoui_m, only: bernoui
16      USE dimens_m, ONLY: iim, llm      USE comconst, ONLY: daysec, dtvr
17        USE comgeom, ONLY: airesurg_2d, 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
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
29        use massbar_m, only: massbar
30        use massbarxy_m, only: massbarxy
31      use massdair_m, only: massdair      use massdair_m, only: massdair
32      USE paramet_m, ONLY: iip1, ip1jm, 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
35      ! Arguments:      use vitvert_m, only: vitvert
36    
37      INTEGER, INTENT(IN):: itau      INTEGER, INTENT(IN):: itau
38      REAL ucov(ip1jmp1, llm), vcov(ip1jm, llm)      REAL, INTENT(IN):: ucov(:, :, :) ! (iim + 1, jjm + 1, llm) vent covariant
39      real, intent(in):: teta(ip1jmp1, llm)      REAL, INTENT(IN):: vcov(:, :, :) ! (iim + 1, jjm, llm) vent covariant
40      REAL, INTENT(IN):: ps(ip1jmp1)      REAL, INTENT(IN):: teta(:, :, :) ! (iim + 1, jjm + 1, llm)
41        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 dv(ip1jm, llm), dudyn(ip1jmp1, llm)      REAL dudyn(:, :, :) ! (iim + 1, jjm + 1, llm)
48      REAL dteta(ip1jmp1, llm)      real dv((iim + 1) * jjm, llm)
49      real, INTENT(out):: dp(ip1jmp1)      REAL, INTENT(out):: dteta(:, :, :) ! (iim + 1, jjm + 1, llm)
50      REAL, INTENT(out):: w(ip1jmp1, llm)      real, INTENT(out):: dp(:, :) ! (iim + 1, jjm + 1)
51      REAL pbaru(ip1jmp1, llm), pbarv(ip1jm, llm)      REAL, INTENT(out):: w(:, :, :) ! (iim + 1, jjm + 1, llm)
52      REAL, intent(in):: time_0      REAL, intent(out):: pbaru(:, :, :) ! (iim + 1, jjm + 1, llm)
53        REAL, intent(out):: pbarv(:, :, :) ! (iim + 1, jjm, llm)
54      LOGICAL, INTENT(IN):: conser      LOGICAL, INTENT(IN):: conser
55    
56      ! Local:      ! Local:
57        REAL vcont((iim + 1) * jjm, llm), ucont(ip1jmp1, llm)
58      REAL vcont(ip1jm, llm), ucont(ip1jmp1, llm)      REAL ang_3d(iim + 1, jjm + 1, llm), p(ip1jmp1, llmp1)
59      REAL ang(ip1jmp1, llm), p(ip1jmp1, llmp1)      REAL massebx(ip1jmp1, llm), masseby((iim + 1) * jjm, llm)
60      REAL massebx(ip1jmp1, llm), masseby(ip1jm, llm)      REAL vorpot(iim + 1, jjm, llm)
61      REAL vorpot(ip1jm, llm)      real ecin(iim + 1, jjm + 1, llm), convm(iim + 1, jjm + 1, llm)
62      real ecin(ip1jmp1, llm), convm(ip1jmp1, llm)      REAL bern(iim + 1, jjm + 1, llm)
63      REAL bern(ip1jmp1, llm)      REAL massebxy(iim + 1, jjm, llm)
     REAL massebxy(ip1jm, llm)  
   
64      INTEGER ij, l      INTEGER ij, l
65        real heure, time
66    
67      !-----------------------------------------------------------------------      !-----------------------------------------------------------------------
68    
# Line 60  contains Line 74  contains
74      CALL flumass(massebx, masseby, vcont, ucont, pbaru, pbarv)      CALL flumass(massebx, masseby, vcont, ucont, pbaru, pbarv)
75      CALL dteta1(teta, pbaru, pbarv, dteta)      CALL dteta1(teta, pbaru, pbarv, dteta)
76      CALL convmas(pbaru, pbarv, convm)      CALL convmas(pbaru, pbarv, convm)
77      dp = convm(:, 1) / airesurg      dp = convm(:, :, 1) / airesurg_2d
78      CALL vitvert(convm, w)      w = vitvert(convm)
79      CALL tourpot(vcov, ucov, massebxy, vorpot)      CALL tourpot(vcov, ucov, massebxy, vorpot)
80      CALL dudv1(vorpot, pbaru, pbarv, dudyn, dv)      CALL dudv1(vorpot, pbaru, pbarv, dudyn(:, 2: jjm, :), dv)
81      CALL enercin(vcov, ucov, vcont, ucont, ecin)      CALL enercin(vcov, ucov, vcont, ucont, ecin)
82      CALL bernoui(ip1jmp1, llm, phi, ecin, bern)      bern = bernoui(phi, ecin)
83      CALL dudv2(teta, pkf, bern, dudyn, dv)      CALL dudv2(teta, pkf, bern, dudyn, dv)
84    
85      DO l = 1, llm      forall (l = 1: llm) ang_3d(:, :, l) = ucov(:, :, l) + constang_2d
86         DO ij = 1, ip1jmp1      CALL advect(ang_3d, vcov, teta, w, massebx, masseby, dudyn, dv, dteta)
           ang(ij, l) = ucov(ij, l) + constang(ij)  
        END DO  
     END DO  
   
     CALL advect(ang, vcov, teta, w, massebx, masseby, dudyn, dv, dteta)  
87    
88      ! 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
89      ! probablement. Observe sur le code compile avec pgf90 3.0-1      ! d'arrondi probablement. Observé sur le code compilé avec pgf90
90        ! 3.0-1.
91      DO l = 1, llm      DO l = 1, llm
92         DO ij = 1, ip1jm, iip1         DO ij = 1, (iim + 1) * jjm, iip1
93            IF (dv(ij, l)/=dv(ij+iim, l)) THEN            IF (dv(ij, l)/=dv(ij+iim, l)) THEN
94               dv(ij+iim, l) = dv(ij, l)               dv(ij+iim, l) = dv(ij, l)
95            END IF            END IF
96         END DO         END DO
97      END DO      END DO
98    
99      ! Sorties eventuelles des variables de controle :      ! Sorties éventuelles des variables de contrôle :
100      IF (conser) CALL sortvarc(itau, ucov, teta, ps, masse, pk, phis, vorpot, &      IF (conser) then
101           phi, bern, dp, time_0)         CALL sortvarc(ucov, teta, ps, masse, pk, phis, vorpot, phi, bern, dp, &
102                resetvarc = .false.)
103           time = real(itau) / day_step
104           heure = mod(itau * dtvr / daysec, 1.) * 24.
105           IF (abs(heure-24.) <= 1e-4) heure = 0.
106    
107           PRINT 3500, itau, int(day_ini + time), heure, time
108           PRINT 4000, ptot, rmsdpdt, etot, ztot, stot, rmsv, ang
109        end IF
110    
111    3500 FORMAT (4X, 'pas', I7, 5X, 'jour', i5, 1X, 'heure', F5.1, 4X, 'date', &
112             F10.5)
113    4000 FORMAT (10X, 'masse', 4X, 'rmsdpdt', 7X, 'energie', 2X, 'enstrophie', &
114             2X, 'entropie', 3X, 'rmsv', 4X, 'mt.ang', /, 'GLOB  ', F10.6, &
115             E13.6, 5F10.3/)
116    
117    END SUBROUTINE caldyn    END SUBROUTINE caldyn
118    
Legend:
Removed from v.76  
changed lines
  Added in v.254
  ViewVC Help
Powered by ViewVC 1.1.21