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