/[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 47 by guez, Fri Jul 1 15:00:48 2011 UTC trunk/dyn3d/caldyn.f revision 259 by guez, Tue Mar 6 16:19:52 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, 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 advect_m, only: advect      use advect_m, only: advect
15      USE dimens_m, ONLY : iim, llm      use bernoui_m, only: bernoui
16      USE paramet_m, ONLY : iip1, ip1jm, ip1jmp1, jjp1, llmp1      USE comconst, ONLY: daysec, dtvr
17      USE comvert, ONLY : ap, bp      USE comgeom, ONLY: airesurg_2d, constang_2d
18      USE comgeom, ONLY : airesurg, constang      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
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, ang0, etot0, ptot0, stot0, ztot0
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
32        USE paramet_m, ONLY: iip1, ip1jmp1, jjp1, llmp1
33      use sortvarc_m, only: sortvarc      use sortvarc_m, only: sortvarc
34        use tourpot_m, only: tourpot
35        use vitvert_m, only: vitvert
36    
     ! Arguments:  
   
     LOGICAL, INTENT(IN):: conser  
37      INTEGER, INTENT(IN):: itau      INTEGER, INTENT(IN):: itau
38      REAL vcov(ip1jm, llm), ucov(ip1jmp1, 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), phis(ip1jmp1)      REAL, INTENT(IN):: teta(:, :, :) ! (iim + 1, jjm + 1, llm)
41        REAL, INTENT (IN):: ps(ip1jmp1)
42        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 vcont(ip1jm, llm), ucont(ip1jmp1, llm)      REAL, INTENT(IN):: phis(ip1jmp1)
46      REAL phi(ip1jmp1, llm), masse(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 pbaru(ip1jmp1, llm), pbarv(ip1jm, llm)      real, INTENT(out):: dp(:, :) ! (iim + 1, jjm + 1)
51      REAL, intent(in):: time_0      REAL, INTENT(out):: w(:, :, :) ! (iim + 1, jjm + 1, llm)
52      REAL, INTENT(out):: w(ip1jmp1, llm)      REAL, intent(out):: pbaru(:, :, :) ! (iim + 1, jjm + 1, llm)
53        REAL, intent(out):: pbarv(:, :, :) ! (iim + 1, jjm, llm)
54        LOGICAL, INTENT(IN):: conser
55    
56      ! Local:      ! Local:
57        REAL vcont((iim + 1) * jjm, llm), ucont(ip1jmp1, llm)
58      REAL ang(ip1jmp1, llm), p(ip1jmp1, llmp1)      REAL ang_3d(iim + 1, jjm + 1, llm), p(ip1jmp1, llmp1)
59      REAL massebx(ip1jmp1, llm), masseby(ip1jm, llm)      REAL massebx(ip1jmp1, llm), masseby((iim + 1) * jjm, llm)
60      REAL vorpot(ip1jm, llm)      REAL vorpot(iim + 1, jjm, llm)
61      real ecin(ip1jmp1, llm), convm(ip1jmp1, llm)      real ecin(iim + 1, jjm + 1, llm), convm(iim + 1, jjm + 1, llm)
62      REAL bern(ip1jmp1, llm)      REAL bern(iim + 1, jjm + 1, llm)
63      REAL massebxy(ip1jm, llm)      REAL massebxy(iim + 1, jjm, llm)
   
64      INTEGER ij, l      INTEGER ij, l
65        real heure, time
66        real ang, etot, ptot, ztot, stot, rmsdpdt, rmsv
67    
68      !-----------------------------------------------------------------------      !-----------------------------------------------------------------------
69    
# Line 57  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, dv)      CALL dudv1(vorpot, pbaru, pbarv, dudyn(:, 2: jjm, :), dv)
82      CALL enercin(vcov, ucov, vcont, ucont, ecin)      CALL enercin(vcov, ucov, vcont, ucont, ecin)
83      CALL bernoui(ip1jmp1, llm, phi, ecin, bern)      bern = bernoui(phi, ecin)
84      CALL dudv2(teta, pkf, bern, dudyn, dv)      CALL dudv2(teta, pkf, bern, dudyn, dv)
85    
86      DO l = 1, llm      forall (l = 1: llm) ang_3d(:, :, l) = ucov(:, :, l) + constang_2d
87         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)  
88    
89      ! 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
90      ! probablement. Observe sur le code compile avec pgf90 3.0-1      ! d'arrondi probablement. Observé sur le code compilé avec pgf90
91        ! 3.0-1.
92      DO l = 1, llm      DO l = 1, llm
93         DO ij = 1, ip1jm, iip1         DO ij = 1, (iim + 1) * jjm, iip1
94            IF (dv(ij, l)/=dv(ij+iim, l)) THEN            IF (dv(ij, l)/=dv(ij+iim, l)) THEN
95               dv(ij+iim, l) = dv(ij, l)               dv(ij+iim, l) = dv(ij, l)
96            END IF            END IF
97         END DO         END DO
98      END DO      END DO
99    
100      ! Sorties eventuelles des variables de controle :      ! Sorties éventuelles des variables de contrôle :
101      IF (conser) CALL sortvarc(itau, ucov, teta, ps, masse, pk, phis, vorpot, &      IF (conser) then
102           phi, bern, dp, time_0)         CALL sortvarc(ucov, teta, ps, masse, pk, phis, vorpot, phi, bern, dp, &
103                ang, etot, ptot, ztot, stot, rmsdpdt, rmsv)
104    
105           time = real(itau) / day_step
106           heure = mod(itau * dtvr / daysec, 1.) * 24.
107           IF (abs(heure-24.) <= 1e-4) heure = 0.
108    
109           PRINT 3500, itau, int(day_ini + time), heure, time
110           PRINT 4000, ptot / ptot0, rmsdpdt, etot / etot0, ztot / ztot0, &
111                stot / stot0, sqrt(rmsv / ptot), ang / ang0
112        end IF
113    
114    3500 FORMAT (4X, 'pas', I7, 5X, 'jour', i5, 1X, 'heure', F5.1, 4X, 'date', &
115             F10.5)
116    4000 FORMAT (10X, 'masse', 4X, 'rmsdpdt', 7X, 'energie', 2X, 'enstrophie', &
117             2X, 'entropie', 3X, 'rmsv', 4X, 'mt.ang', /, 'GLOB  ', F10.6, &
118             E13.6, 5F10.3/)
119    
120    END SUBROUTINE caldyn    END SUBROUTINE caldyn
121    
Legend:
Removed from v.47  
changed lines
  Added in v.259
  ViewVC Help
Powered by ViewVC 1.1.21