/[lmdze]/trunk/Sources/dyn3d/bilan_dyn.f
ViewVC logotype

Diff of /trunk/Sources/dyn3d/bilan_dyn.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 55 by guez, Mon Dec 12 13:25:01 2011 UTC revision 56 by guez, Tue Jan 10 19:02:02 2012 UTC
# Line 5  module bilan_dyn_m Line 5  module bilan_dyn_m
5  contains  contains
6    
7    SUBROUTINE bilan_dyn(ps, masse, pk, flux_u, flux_v, teta, phi, ucov, vcov, &    SUBROUTINE bilan_dyn(ps, masse, pk, flux_u, flux_v, teta, phi, ucov, vcov, &
8         trac, dt_app, dt_cum)         trac, dt_app)
9    
10      ! From LMDZ4/libf/dyn3d/bilan_dyn.F, version 1.5 2005/03/16      ! From LMDZ4/libf/dyn3d/bilan_dyn.F, version 1.5 2005/03/16 10:12:17
     ! 10:12:17 fairhead  
11    
12      ! Sous-programme consacré à des diagnostics dynamiques de base.      ! Sous-programme consacré à des diagnostics dynamiques de base.
13      ! De façon générale, les moyennes des scalaires Q sont pondérées      ! De façon générale, les moyennes des scalaires Q sont pondérées
14      ! par la masse. Les flux de masse sont, eux, simplement moyennés.      ! par la masse. Les flux de masse sont, eux, simplement moyennés.
15    
     USE histcom, ONLY: histbeg_totreg, histdef, histend, histvert  
16      USE calendar, ONLY: ymds2ju      USE calendar, ONLY: ymds2ju
17      USE histwrite_m, ONLY: histwrite      USE conf_gcm_m, ONLY: day_step, iperiod, periodav
     USE dimens_m, ONLY: iim, jjm, llm  
     USE paramet_m, ONLY: iip1, jjp1  
18      USE comconst, ONLY: cpp      USE comconst, ONLY: cpp
19      USE comvert, ONLY: presnivs      USE comvert, ONLY: presnivs
20      USE comgeom, ONLY: constang_2d, cu_2d, cv_2d, rlatv      USE comgeom, ONLY: constang_2d, cu_2d, cv_2d, rlatv
21      USE temps, ONLY: annee_ref, day_ref, itau_dyn      USE dimens_m, ONLY: iim, jjm, llm
22      USE inigrads_m, ONLY: inigrads      USE histcom, ONLY: histbeg_totreg, histdef, histend, histvert
23        USE histwrite_m, ONLY: histwrite
24      USE nr_util, ONLY: pi      USE nr_util, ONLY: pi
25        USE paramet_m, ONLY: iip1, jjp1
26        USE temps, ONLY: annee_ref, day_ref, itau_dyn
27    
28      ! Arguments:      ! Arguments:
29    
30      real, intent(in):: dt_app, dt_cum      real, intent(in):: ps(iip1, jjp1)
31      real ps(iip1, jjp1)      real, intent(in):: masse(iip1, jjp1, llm), pk(iip1, jjp1, llm)
32      real masse(iip1, jjp1, llm), pk(iip1, jjp1, llm)      real, intent(in):: flux_u(iip1, jjp1, llm)
33      real flux_u(iip1, jjp1, llm)      real, intent(in):: flux_v(iip1, jjm, llm)
     real flux_v(iip1, jjm, llm)  
34      real, intent(in):: teta(iip1, jjp1, llm)      real, intent(in):: teta(iip1, jjp1, llm)
35      real phi(iip1, jjp1, llm)      real, intent(in):: phi(iip1, jjp1, llm)
36      real ucov(iip1, jjp1, llm)      real, intent(in):: ucov(iip1, jjp1, llm)
37      real vcov(iip1, jjm, llm)      real, intent(in):: vcov(iip1, jjm, llm)
38      real, intent(in):: trac(:, :, :) ! (iim + 1, jjm + 1, llm)      real, intent(in):: trac(:, :, :) ! (iim + 1, jjm + 1, llm)
39        real, intent(in):: dt_app
40    
41      ! Local:      ! Local:
42    
43        real dt_cum
44      integer:: icum  = 0      integer:: icum  = 0
45      integer, save:: ncum      integer, save:: ncum
46      logical:: first = .true.      logical:: first = .true.
47      real zz, zqy, zfactv(jjm, llm)      real zqy, zfactv(jjm, llm)
48    
49      integer, parameter:: nQ = 7      integer, parameter:: nQ = 7
50      character(len=4), parameter:: nom(nQ) = (/'T   ', 'gz  ', 'K   ', 'ang ', &      character(len=4), parameter:: nom(nQ) = (/'T   ', 'gz  ', 'K   ', 'ang ', &
# Line 52  contains Line 52  contains
52      character(len=5), parameter:: unites(nQ) = (/'K    ', 'm2/s2', 'm2/s2', &      character(len=5), parameter:: unites(nQ) = (/'K    ', 'm2/s2', 'm2/s2', &
53           'ang  ', 'm/s  ', 'kg/kg', 'un   '/)           'ang  ', 'm/s  ', 'kg/kg', 'un   '/)
54    
     real:: time = 0.  
55      integer:: itau = 0      integer:: itau = 0
56      real ww      real ww
57    
# Line 90  contains Line 89  contains
89      real zvQ(jjm, llm, ntr, nQ), zvQtmp(jjm, llm)      real zvQ(jjm, llm, ntr, nQ), zvQtmp(jjm, llm)
90      real zavQ(jjm, 2: ntr, nQ), psiQ(jjm, llm + 1, nQ)      real zavQ(jjm, 2: ntr, nQ), psiQ(jjm, llm + 1, nQ)
91      real zmasse(jjm, llm)      real zmasse(jjm, llm)
   
92      real zv(jjm, llm), psi(jjm, llm + 1)      real zv(jjm, llm), psi(jjm, llm + 1)
   
93      integer i, j, l, iQ      integer i, j, l, iQ
94    
95      ! Initialisation du fichier contenant les moyennes zonales.      ! Initialisation du fichier contenant les moyennes zonales.
# Line 109  contains Line 106  contains
106    
107      !!print *, "Call sequence information: bilan_dyn"      !!print *, "Call sequence information: bilan_dyn"
108    
     ! Initialisation  
   
     time = time + dt_app  
     itau = itau + 1  
   
109      first_call: if (first) then      first_call: if (first) then
110         ! initialisation des fichiers         ! initialisation des fichiers
111         first = .false.         first = .false.
112         ! ncum est la frequence de stokage en pas de temps         ! ncum est la frequence de stokage en pas de temps
113         ncum = dt_cum / dt_app         ncum = day_step / iperiod * periodav
114         if (abs(ncum * dt_app - dt_cum) > 1e-5 * dt_app) then         dt_cum = ncum * dt_app
           print *, 'Problème : le pas de cumul doit être multiple du pas'  
           print *, 'dt_app = ', dt_app  
           print *, 'dt_cum = ', dt_cum  
           stop 1  
        endif  
   
        call inigrads(i_f=4, x=(/0./), fx=180./pi, xmin=0., xmax=0., y=rlatv, &  
             ymin=-90., ymax=90., fy=180./pi, z=presnivs, fz=1., dt=dt_cum, &  
             file='dynzon', titlel='dyn_zon ')  
115    
116         ! Initialisation du fichier contenant les moyennes zonales         ! Initialisation du fichier contenant les moyennes zonales
117    
# Line 169  contains Line 152  contains
152                    zunites(itr, iQ), 1, jjm, thoriid, llm, 1, llm, zvertiid, &                    zunites(itr, iQ), 1, jjm, thoriid, llm, 1, llm, zvertiid, &
153                    'ave(X)', dt_cum, dt_cum)                    'ave(X)', dt_cum, dt_cum)
154            enddo            enddo
155            ! Declarations pour les fonctions de courant            ! Déclarations pour les fonctions de courant
156            call histdef(fileid, 'psi'//nom(iQ), 'stream fn. '//znoml(itot, iQ), &            call histdef(fileid, 'psi'//nom(iQ), 'stream fn. '//znoml(itot, iQ), &
157                 zunites(itot, iQ), 1, jjm, thoriid, llm, 1, llm, zvertiid, &                 zunites(itot, iQ), 1, jjm, thoriid, llm, 1, llm, zvertiid, &
158                 'ave(X)', dt_cum, dt_cum)                 'ave(X)', dt_cum, dt_cum)
159         enddo         enddo
160    
161         ! Declarations pour les champs de transport d'air         ! Déclarations pour les champs de transport d'air
162         call histdef(fileid, 'masse', 'masse', &         call histdef(fileid, 'masse', 'masse', &
163              'kg', 1, jjm, thoriid, llm, 1, llm, zvertiid, &              'kg', 1, jjm, thoriid, llm, 1, llm, zvertiid, &
164              'ave(X)', dt_cum, dt_cum)              'ave(X)', dt_cum, dt_cum)
165         call histdef(fileid, 'v', 'v', &         call histdef(fileid, 'v', 'v', &
166              'm/s', 1, jjm, thoriid, llm, 1, llm, zvertiid, &              'm/s', 1, jjm, thoriid, llm, 1, llm, zvertiid, &
167              'ave(X)', dt_cum, dt_cum)              'ave(X)', dt_cum, dt_cum)
168         ! Declarations pour les fonctions de courant         ! Déclarations pour les fonctions de courant
169         call histdef(fileid, 'psi', 'stream fn. MMC ', 'mega t/s', &         call histdef(fileid, 'psi', 'stream fn. MMC ', 'mega t/s', &
170              1, jjm, thoriid, llm, 1, llm, zvertiid, &              1, jjm, thoriid, llm, 1, llm, zvertiid, &
171              'ave(X)', dt_cum, dt_cum)              'ave(X)', dt_cum, dt_cum)
172    
173         ! Declaration des champs 1D de transport en latitude         ! Déclaration des champs 1D de transport en latitude
174         do iQ = 1, nQ         do iQ = 1, nQ
175            do itr = 2, ntr            do itr = 2, ntr
176               call histdef(fileid, 'a'//znom(itr, iQ), znoml(itr, iQ), &               call histdef(fileid, 'a'//znom(itr, iQ), znoml(itr, iQ), &
# Line 199  contains Line 182  contains
182         CALL histend(fileid)         CALL histend(fileid)
183      endif first_call      endif first_call
184    
185        itau = itau + 1
186    
187      ! Calcul des champs dynamiques      ! Calcul des champs dynamiques
188    
189      ! Énergie cinétique      ! Énergie cinétique
# Line 284  contains Line 269  contains
269         do iQ = 1, nQ         do iQ = 1, nQ
270            Q_cum(:, :, :, iQ) = Q_cum(:, :, :, iQ)/masse_cum            Q_cum(:, :, :, iQ) = Q_cum(:, :, :, iQ)/masse_cum
271         enddo         enddo
272         zz = 1. / real(ncum)         ps_cum = ps_cum / ncum
273         ps_cum = ps_cum*zz         masse_cum = masse_cum / ncum
274         masse_cum = masse_cum*zz         flux_u_cum = flux_u_cum / ncum
275         flux_u_cum = flux_u_cum*zz         flux_v_cum = flux_v_cum / ncum
276         flux_v_cum = flux_v_cum*zz         flux_uQ_cum = flux_uQ_cum / ncum
277         flux_uQ_cum = flux_uQ_cum*zz         flux_vQ_cum = flux_vQ_cum / ncum
278         flux_vQ_cum = flux_vQ_cum*zz         dQ = dQ / ncum
        dQ = dQ*zz  
279    
280         ! A retravailler eventuellement         ! A retravailler eventuellement
281         ! division de dQ par la masse pour revenir aux bonnes grandeurs         ! division de dQ par la masse pour revenir aux bonnes grandeurs
Legend:
Removed from v.55  
changed lines
  Added in v.56
  ViewVC Help
Powered by ViewVC 1.1.21