/[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/Sources/dyn3d/caldyn.f revision 138 by guez, Fri May 22 23:13:19 2015 UTC trunk/dyn3d/caldyn.f revision 265 by guez, Tue Mar 20 09:35:59 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, conser)         du, 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      ! Author: P. Le Van      ! Author: P. Le Van
# Line 14  contains Line 14  contains
14      use advect_m, only: advect      use advect_m, only: advect
15      use bernoui_m, only: bernoui      use bernoui_m, only: bernoui
16      USE comconst, ONLY: daysec, dtvr      USE comconst, ONLY: daysec, dtvr
17      USE comgeom, ONLY: airesurg, constang_2d      USE comgeom, ONLY: airesurg_2d, constang_2d
18      USE conf_gcm_m, ONLY: day_step      USE conf_gcm_m, ONLY: day_step
19      use convmas_m, only: convmas      use convmas_m, only: convmas
20      USE dimens_m, ONLY: iim, jjm, llm      use covcont_m, only: covcont
21        USE dimensions, ONLY: iim, jjm, llm
22      USE disvert_m, ONLY: ap, bp      USE disvert_m, ONLY: ap, bp
23      use dteta1_m, only: dteta1      use dteta1_m, only: dteta1
24      use dudv1_m, only: dudv1      use dudv1_m, only: dudv1
25      use dudv2_m, only: dudv2      use dudv2_m, only: dudv2
26      USE dynetat0_m, ONLY: day_ini      USE dynetat0_m, ONLY: day_ini, ang0, etot0, ptot0, stot0, ztot0
27        use enercin_m, only: enercin
28      use flumass_m, only: flumass      use flumass_m, only: flumass
29      use massbar_m, only: massbar      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, ang, etot, ptot, rmsdpdt, rmsv, stot, ztot      use sortvarc_m, only: sortvarc
34      use tourpot_m, only: tourpot      use tourpot_m, only: tourpot
35      use vitvert_m, only: vitvert      use vitvert_m, only: vitvert
36    
# Line 42  contains Line 44  contains
44      REAL, INTENT(IN):: 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(iim + 1, jjm + 1, llm)      REAL, INTENT(IN):: phi(iim + 1, jjm + 1, llm)
47      REAL dudyn(:, :, :) ! (iim + 1, jjm + 1, llm)      REAL du(:, :, :) ! (iim + 1, jjm + 1, llm)
48      real dv((iim + 1) * jjm, llm)      real dv((iim + 1) * jjm, llm)
49      REAL, INTENT(out):: dteta(:, :, :) ! (iim + 1, jjm + 1, llm)      REAL, INTENT(out):: dteta(:, :, :) ! (iim + 1, jjm + 1, llm)
50      real, INTENT(out):: dp(ip1jmp1)      real, INTENT(out):: dp(:, :) ! (iim + 1, jjm + 1)
51      REAL, INTENT(out):: w(:, :, :) ! (iim + 1, jjm + 1, 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(:, :, :) ! (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:
# Line 55  contains Line 58  contains
58      REAL ang_3d(iim + 1, jjm + 1, llm), p(ip1jmp1, llmp1)      REAL ang_3d(iim + 1, jjm + 1, llm), p(ip1jmp1, llmp1)
59      REAL massebx(ip1jmp1, llm), masseby((iim + 1) * jjm, llm)      REAL massebx(ip1jmp1, llm), masseby((iim + 1) * jjm, llm)
60      REAL vorpot(iim + 1, jjm, llm)      REAL vorpot(iim + 1, jjm, llm)
61      real ecin(iim + 1, jjm + 1, llm), convm(ip1jmp1, llm)      real ecin(iim + 1, jjm + 1, llm), convm(iim + 1, jjm + 1, llm)
62      REAL bern(iim + 1, jjm + 1, llm)      REAL bern(iim + 1, jjm + 1, llm)
63      REAL massebxy(iim + 1, jjm, llm)      REAL massebxy(iim + 1, jjm, llm)
64      INTEGER ij, l      INTEGER ij, l
65      real heure, time      real heure, time
66        real ang, etot, ptot, ztot, stot, rmsdpdt, rmsv
67    
68      !-----------------------------------------------------------------------      !-----------------------------------------------------------------------
69    
# Line 71  contains Line 75  contains
75      CALL flumass(massebx, masseby, vcont, ucont, pbaru, pbarv)      CALL flumass(massebx, masseby, vcont, ucont, pbaru, pbarv)
76      CALL dteta1(teta, pbaru, pbarv, dteta)      CALL dteta1(teta, pbaru, pbarv, dteta)
77      CALL convmas(pbaru, pbarv, convm)      CALL convmas(pbaru, pbarv, convm)
78      dp = convm(:, 1) / airesurg      dp = convm(:, :, 1) / airesurg_2d
79      CALL vitvert(convm, w)      w = vitvert(convm)
80      CALL tourpot(vcov, ucov, massebxy, vorpot)      CALL tourpot(vcov, ucov, massebxy, vorpot)
81      CALL dudv1(vorpot, pbaru, pbarv, dudyn(:, 2: jjm, :), dv)      CALL dudv1(vorpot, pbaru, pbarv, du(:, 2: jjm, :), dv)
82      CALL enercin(vcov, ucov, vcont, ucont, ecin)      CALL enercin(vcov, ucov, vcont, ucont, ecin)
83      bern = bernoui(phi, ecin)      bern = bernoui(phi, ecin)
84      CALL dudv2(teta, pkf, bern, dudyn, dv)      CALL dudv2(teta, pkf, bern, du, dv)
85    
86      forall (l = 1: llm) ang_3d(:, :, l) = ucov(:, :, l) + constang_2d      forall (l = 1: llm) ang_3d(:, :, l) = ucov(:, :, l) + constang_2d
87      CALL advect(ang_3d, vcov, teta, w, massebx, masseby, dudyn, dv, dteta)      CALL advect(ang_3d, vcov, teta, w, massebx, masseby, du, dv, dteta)
88    
89      ! Warning problème de périodicité de dv sur les PC Linux. Problème      ! Warning problème de périodicité de dv sur les PC Linux. Problème
90      ! d'arrondi probablement. Observé sur le code compilé avec pgf90      ! d'arrondi probablement. Observé sur le code compilé avec pgf90
# Line 96  contains Line 100  contains
100      ! Sorties éventuelles des variables de contrôle :      ! Sorties éventuelles des variables de contrôle :
101      IF (conser) then      IF (conser) then
102         CALL sortvarc(ucov, teta, ps, masse, pk, phis, vorpot, phi, bern, dp, &         CALL sortvarc(ucov, teta, ps, masse, pk, phis, vorpot, phi, bern, dp, &
103              resetvarc = .false.)              ang, etot, ptot, ztot, stot, rmsdpdt, rmsv)
104    
105         time = real(itau) / day_step         time = real(itau) / day_step
106         heure = mod(itau * dtvr / daysec, 1.) * 24.         heure = mod(itau * dtvr / daysec, 1.) * 24.
107         IF (abs(heure-24.) <= 1e-4) heure = 0.         IF (abs(heure-24.) <= 1e-4) heure = 0.
108    
109         PRINT 3500, itau, int(day_ini + time), heure, time         PRINT 3500, itau, int(day_ini + time), heure, time
110         PRINT 4000, ptot, rmsdpdt, etot, ztot, stot, rmsv, ang         PRINT 4000, ptot / ptot0, rmsdpdt, etot / etot0, ztot / ztot0, &
111                stot / stot0, sqrt(rmsv / ptot), ang / ang0
112      end IF      end IF
113    
114  3500 FORMAT (4X, 'pas', I7, 5X, 'jour', i5, 1X, 'heure', F5.1, 4X, 'date', &  3500 FORMAT (4X, 'pas', I7, 5X, 'jour', i5, 1X, 'heure', F5.1, 4X, 'date', &
Legend:
Removed from v.138  
changed lines
  Added in v.265
  ViewVC Help
Powered by ViewVC 1.1.21