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