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

Diff of /trunk/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 57 by guez, Mon Jan 30 12:54: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)
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    
16      USE histcom, ONLY: histbeg_totreg, histdef, histend, histvert      USE comconst, ONLY: cpp
17      USE calendar, ONLY: ymds2ju      USE comgeom, ONLY: constang_2d, cu_2d, cv_2d
     USE histwrite_m, ONLY: histwrite  
18      USE dimens_m, ONLY: iim, jjm, llm      USE dimens_m, ONLY: iim, jjm, llm
19        USE histwrite_m, ONLY: histwrite
20        use init_dynzon_m, only: ncum, fileid, znom, ntr, nq, nom
21      USE paramet_m, ONLY: iip1, jjp1      USE paramet_m, ONLY: iip1, jjp1
     USE comconst, ONLY: cpp  
     USE comvert, ONLY: presnivs  
     USE comgeom, ONLY: constang_2d, cu_2d, cv_2d, rlatv  
     USE temps, ONLY: annee_ref, day_ref, itau_dyn  
     USE inigrads_m, ONLY: inigrads  
     USE nr_util, ONLY: pi  
22    
23      ! Arguments:      ! Arguments:
24    
25      real, intent(in):: dt_app, dt_cum      real, intent(in):: ps(iip1, jjp1)
26      real ps(iip1, jjp1)      real, intent(in):: masse(iip1, jjp1, llm), pk(iip1, jjp1, llm)
27      real masse(iip1, jjp1, llm), pk(iip1, jjp1, llm)      real, intent(in):: flux_u(iip1, jjp1, llm)
28      real flux_u(iip1, jjp1, llm)      real, intent(in):: flux_v(iip1, jjm, llm)
     real flux_v(iip1, jjm, llm)  
29      real, intent(in):: teta(iip1, jjp1, llm)      real, intent(in):: teta(iip1, jjp1, llm)
30      real phi(iip1, jjp1, llm)      real, intent(in):: phi(iip1, jjp1, llm)
31      real ucov(iip1, jjp1, llm)      real, intent(in):: ucov(iip1, jjp1, llm)
32      real vcov(iip1, jjm, llm)      real, intent(in):: vcov(iip1, jjm, llm)
33      real, intent(in):: trac(:, :, :) ! (iim + 1, jjm + 1, llm)      real, intent(in):: trac(:, :, :) ! (iim + 1, jjm + 1, llm)
34    
35      ! Local:      ! Local:
36    
37      integer:: icum  = 0      integer:: icum  = 0
     integer, save:: ncum  
     logical:: first = .true.  
     real zz, zqy, zfactv(jjm, llm)  
   
     integer, parameter:: nQ = 7  
     character(len=4), parameter:: nom(nQ) = (/'T   ', 'gz  ', 'K   ', 'ang ', &  
          'u   ', 'ovap', 'un  '/)  
     character(len=5), parameter:: unites(nQ) = (/'K    ', 'm2/s2', 'm2/s2', &  
          'ang  ', 'm/s  ', 'kg/kg', 'un   '/)  
   
     real:: time = 0.  
38      integer:: itau = 0      integer:: itau = 0
39        real zqy, zfactv(jjm, llm)
40    
41      real ww      real ww
42    
43      ! Variables dynamiques intermédiaires      ! Variables dynamiques intermédiaires
# Line 77  contains Line 61  contains
61    
62      ! champs de tansport en moyenne zonale      ! champs de tansport en moyenne zonale
63      integer itr      integer itr
     integer, parameter:: ntr = 5  
   
     character(len=10), save:: znom(ntr, nQ)  
     character(len=26), save:: znoml(ntr, nQ)  
     character(len=12), save:: zunites(ntr, nQ)  
   
64      integer, parameter:: iave = 1, itot = 2, immc = 3, itrs = 4, istn = 5      integer, parameter:: iave = 1, itot = 2, immc = 3, itrs = 4, istn = 5
     character(len=3), parameter:: ctrs(ntr) = (/'   ', 'TOT', 'MMC', 'TRS', &  
          'STN'/)  
65    
66      real zvQ(jjm, llm, ntr, nQ), zvQtmp(jjm, llm)      real zvQ(jjm, llm, ntr, nQ), zvQtmp(jjm, llm)
67      real zavQ(jjm, 2: ntr, nQ), psiQ(jjm, llm + 1, nQ)      real zavQ(jjm, 2: ntr, nQ), psiQ(jjm, llm + 1, nQ)
68      real zmasse(jjm, llm)      real zmasse(jjm, llm)
   
69      real zv(jjm, llm), psi(jjm, llm + 1)      real zv(jjm, llm), psi(jjm, llm + 1)
   
70      integer i, j, l, iQ      integer i, j, l, iQ
71    
     ! Initialisation du fichier contenant les moyennes zonales.  
   
     integer, save:: fileid  
     integer thoriid, zvertiid  
   
     real zjulian  
     integer zan, dayref  
   
     real rlong(jjm), rlatg(jjm)  
   
72      !-----------------------------------------------------------------      !-----------------------------------------------------------------
73    
     !!print *, "Call sequence information: bilan_dyn"  
   
     ! Initialisation  
   
     time = time + dt_app  
     itau = itau + 1  
   
     first_call: if (first) then  
        ! initialisation des fichiers  
        first = .false.  
        ! ncum est la frequence de stokage en pas de temps  
        ncum = dt_cum / dt_app  
        if (abs(ncum * dt_app - dt_cum) > 1e-5 * dt_app) then  
           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 ')  
   
        ! Initialisation du fichier contenant les moyennes zonales  
   
        zan = annee_ref  
        dayref = day_ref  
        CALL ymds2ju(zan, 1, dayref, 0.0, zjulian)  
   
        rlong = 0.  
        rlatg = rlatv*180./pi  
   
        call histbeg_totreg('dynzon', rlong(:1), rlatg, 1, 1, 1, jjm, itau_dyn, &  
             zjulian, dt_cum, thoriid, fileid)  
   
        ! Appel à histvert pour la grille verticale  
   
        call histvert(fileid, 'presnivs', 'Niveaux sigma', 'mb', llm, presnivs, &  
             zvertiid)  
   
        ! Appels à histdef pour la définition des variables à sauvegarder  
        do iQ = 1, nQ  
           do itr = 1, ntr  
              if (itr == 1) then  
                 znom(itr, iQ) = nom(iQ)  
                 znoml(itr, iQ) = nom(iQ)  
                 zunites(itr, iQ) = unites(iQ)  
              else  
                 znom(itr, iQ) = ctrs(itr)//'v'//nom(iQ)  
                 znoml(itr, iQ) = 'transport : v * '//nom(iQ)//' '//ctrs(itr)  
                 zunites(itr, iQ) = 'm/s * '//unites(iQ)  
              endif  
           enddo  
        enddo  
   
        ! Déclarations des champs avec dimension verticale  
        do iQ = 1, nQ  
           do itr = 1, ntr  
              call histdef(fileid, znom(itr, iQ), znoml(itr, iQ), &  
                   zunites(itr, iQ), 1, jjm, thoriid, llm, 1, llm, zvertiid, &  
                   'ave(X)', dt_cum, dt_cum)  
           enddo  
           ! Declarations pour les fonctions de courant  
           call histdef(fileid, 'psi'//nom(iQ), 'stream fn. '//znoml(itot, iQ), &  
                zunites(itot, iQ), 1, jjm, thoriid, llm, 1, llm, zvertiid, &  
                'ave(X)', dt_cum, dt_cum)  
        enddo  
   
        ! Declarations pour les champs de transport d'air  
        call histdef(fileid, 'masse', 'masse', &  
             'kg', 1, jjm, thoriid, llm, 1, llm, zvertiid, &  
             'ave(X)', dt_cum, dt_cum)  
        call histdef(fileid, 'v', 'v', &  
             'm/s', 1, jjm, thoriid, llm, 1, llm, zvertiid, &  
             'ave(X)', dt_cum, dt_cum)  
        ! Declarations pour les fonctions de courant  
        call histdef(fileid, 'psi', 'stream fn. MMC ', 'mega t/s', &  
             1, jjm, thoriid, llm, 1, llm, zvertiid, &  
             'ave(X)', dt_cum, dt_cum)  
   
        ! Declaration des champs 1D de transport en latitude  
        do iQ = 1, nQ  
           do itr = 2, ntr  
              call histdef(fileid, 'a'//znom(itr, iQ), znoml(itr, iQ), &  
                   zunites(itr, iQ), 1, jjm, thoriid, 1, 1, 1, -99, &  
                   'ave(X)', dt_cum, dt_cum)  
           enddo  
        enddo  
   
        CALL histend(fileid)  
     endif first_call  
   
74      ! Calcul des champs dynamiques      ! Calcul des champs dynamiques
75    
76      ! Énergie cinétique      ! Énergie cinétique
# Line 232  contains Line 104  contains
104         flux_uQ_cum = 0.         flux_uQ_cum = 0.
105      endif      endif
106    
107        itau = itau + 1
108      icum = icum + 1      icum = icum + 1
109    
110      ! Accumulation des flux de masse horizontaux      ! Accumulation des flux de masse horizontaux
# Line 284  contains Line 157  contains
157         do iQ = 1, nQ         do iQ = 1, nQ
158            Q_cum(:, :, :, iQ) = Q_cum(:, :, :, iQ)/masse_cum            Q_cum(:, :, :, iQ) = Q_cum(:, :, :, iQ)/masse_cum
159         enddo         enddo
160         zz = 1. / real(ncum)         ps_cum = ps_cum / ncum
161         ps_cum = ps_cum*zz         masse_cum = masse_cum / ncum
162         masse_cum = masse_cum*zz         flux_u_cum = flux_u_cum / ncum
163         flux_u_cum = flux_u_cum*zz         flux_v_cum = flux_v_cum / ncum
164         flux_v_cum = flux_v_cum*zz         flux_uQ_cum = flux_uQ_cum / ncum
165         flux_uQ_cum = flux_uQ_cum*zz         flux_vQ_cum = flux_vQ_cum / ncum
166         flux_vQ_cum = flux_vQ_cum*zz         dQ = dQ / ncum
        dQ = dQ*zz  
167    
168         ! A retravailler eventuellement         ! A retravailler eventuellement
169         ! 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.57
  ViewVC Help
Powered by ViewVC 1.1.21