/[lmdze]/trunk/libf/bibio/writedynav.f90
ViewVC logotype

Diff of /trunk/libf/bibio/writedynav.f90

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

trunk/libf/bibio/writedynav.f revision 3 by guez, Wed Feb 27 13:16:39 2008 UTC trunk/libf/bibio/writedynav.f90 revision 61 by guez, Fri Apr 20 14:58:43 2012 UTC
# Line 1  Line 1 
1  !  module writedynav_m
2  ! $Header: /home/cvsroot/LMDZ4/libf/bibio/writedynav.F,v 1.1.1.1 2004/05/19 12:53:05 lmdzadmin Exp $  
3  !    implicit none
4        subroutine writedynav( histid, nq, time, vcov,  
5       ,                          ucov,teta,ppk,phi,q,masse,ps,phis)  contains
6    
7        USE ioipsl    subroutine writedynav(vcov, ucov, teta, ppk, phi, q, masse, ps, phis, time)
8  C  
9  C   Ecriture du fichier histoire au format IOIPSL      ! From LMDZ4/libf/bibio/writedynav.F, version 1.1.1.1 2004/05/19 12:53:05
10  C      ! Ecriture du fichier histoire au format IOIPSL
11  C   Appels succesifs des routines: histwrite  
12  C      ! Appels successifs des routines histwrite
13  C   Entree:  
14  C      histid: ID du fichier histoire      ! Entree:
15  C      time: temps de l'ecriture      ! vcov: vents v covariants
16  C      vcov: vents v covariants      ! ucov: vents u covariants
17  C      ucov: vents u covariants      ! phi : geopotentiel instantane
18  C      teta: temperature potentielle      ! q : traceurs
19  C      phi : geopotentiel instantane      ! ps :pression au sol
20  C      q   : traceurs      ! phis : geopotentiel au sol
21  C      masse: masse  
22  C      ps   :pression au sol      ! L. Fairhead, LMD, 03/99
23  C      phis : geopotentiel au sol  
24  C            use covnat_m, only: covnat
25  C      USE histwrite_m, ONLY: histwrite
26  C   Sortie:      USE histsync_m, ONLY: histsync
27  C      fileid: ID du fichier netcdf cree      USE dimens_m, ONLY: llm
28  C      USE paramet_m, ONLY: iip1, ijp1llm, ip1jm, ip1jmp1, jjp1
29  C   L. Fairhead, LMD, 03/99      USE comconst, ONLY: cpp
30  C      USE temps, ONLY: itau_dyn
31  C =====================================================================      USE iniadvtrac_m, ONLY: ttext
32  C      use initdynav_m, only: histaveid
33  C   Declarations  
34        use dimens_m      REAL vcov(ip1jm, llm), ucov(ip1jmp1, llm)
35        use paramet_m      REAL, intent(in):: teta(ip1jmp1*llm) ! temperature potentielle
36        use comconst      real phi(ip1jmp1, llm), ppk(ip1jmp1*llm)
37        use comvert      REAL ps(ip1jmp1)
38        use logic      real, intent(in):: masse(ip1jmp1, llm)
39        use comgeom      REAL phis(ip1jmp1)
40        use serre      REAL, intent(in):: q(:, :, :, :) ! (iim + 1, jjm + 1, llm, nqmx)
41        use temps      integer, intent(in):: time ! temps de l'ecriture
42        use ener  
43        use advtrac_m      ! Variables locales
44        implicit none      integer ndex2d(iip1*jjp1), ndex3d(iip1*jjp1*llm), iq, ii, ll
45        real us(ip1jmp1*llm), vs(ip1jmp1*llm)
46        real tm(ip1jmp1*llm)
47  C      REAL vnat(ip1jm, llm), unat(ip1jmp1, llm)
48  C   Arguments      logical ok_sync
49  C      integer itau_w
50    
51        INTEGER histid, nq      !---------------------------------------------------------------
52        REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm)  
53        REAL teta(ip1jmp1*llm),phi(ip1jmp1,llm),ppk(ip1jmp1*llm)                        ! Initialisations
54        REAL ps(ip1jmp1),masse(ip1jmp1,llm)                        ndex3d = 0
55        REAL phis(ip1jmp1)                        ndex2d = 0
56        REAL q(ip1jmp1,llm,nq)      ok_sync = .TRUE.
57        integer, intent(in):: time      us = 999.999
58        vs = 999.999
59        tm = 999.999
60  C   Variables locales      vnat = 999.999
61  C      unat = 999.999
62        integer ndex2d(iip1*jjp1),ndex3d(iip1*jjp1*llm),iq, ii, ll      itau_w = itau_dyn + time
63        real us(ip1jmp1*llm), vs(ip1jmp1*llm)  
64        real tm(ip1jmp1*llm)      ! Passage aux composantes naturelles du vent
65        REAL vnat(ip1jm,llm),unat(ip1jmp1,llm)      call covnat(llm, ucov, vcov, unat, vnat)
66        logical ok_sync  
67        integer itau_w      ! Appels a histwrite pour l'ecriture des variables a sauvegarder
68  C  
69  C  Initialisations      ! Vents U scalaire
70  C      call gr_u_scal(llm, unat, us)
71        ndex3d = 0      call histwrite(histaveid, 'u', itau_w, us)
72        ndex2d = 0  
73        ok_sync = .TRUE.      ! Vents V scalaire
74        us = 999.999      call gr_v_scal(llm, vnat, vs)
75        vs = 999.999      call histwrite(histaveid, 'v', itau_w, vs)
76        tm = 999.999  
77        vnat = 999.999      ! Temperature potentielle moyennee
78        unat = 999.999      call histwrite(histaveid, 'theta', itau_w, teta)
79        itau_w = itau_dyn + time  
80        ! Temperature moyennee
81  C Passage aux composantes naturelles du vent      do ii = 1, ijp1llm
82        call covnat(llm, ucov, vcov, unat, vnat)         tm(ii) = teta(ii) * ppk(ii)/cpp
83        enddo
84  C      call histwrite(histaveid, 'temp', itau_w, tm)
85  C  Appels a histwrite pour l'ecriture des variables a sauvegarder  
86  C      ! Geopotentiel
87  C  Vents U scalaire      call histwrite(histaveid, 'phi', itau_w, phi)
88  C  
89        call gr_u_scal(llm, unat, us)      ! Traceurs
90        call histwrite(histid, 'u', itau_w, us,      DO iq = 1, size(q, 4)
91       .               iip1*jjp1*llm, ndex3d)         call histwrite(histaveid, ttext(iq), itau_w, q(:, :, :, iq))
92  C      enddo
93  C  Vents V scalaire  
94  C      ! Masse
95        call gr_v_scal(llm, vnat, vs)      call histwrite(histaveid, 'masse', itau_w, masse)
96        call histwrite(histid, 'v', itau_w, vs,  
97       .               iip1*jjp1*llm, ndex3d)      ! Pression au sol
98  C      call histwrite(histaveid, 'ps', itau_w, ps)
99  C  Temperature potentielle moyennee  
100  C      ! Geopotentiel au sol
101        call histwrite(histid, 'theta', itau_w, teta,      call histwrite(histaveid, 'phis', itau_w, phis)
102       .                iip1*jjp1*llm, ndex3d)  
103  C      if (ok_sync) call histsync(histaveid)
104  C  Temperature moyennee  
105  C    end subroutine writedynav
106        do ii = 1, ijp1llm  
107          tm(ii) = teta(ii) * ppk(ii)/cpp  end module writedynav_m
       enddo  
       call histwrite(histid, 'temp', itau_w, tm,  
      .                iip1*jjp1*llm, ndex3d)  
 C  
 C  Geopotentiel  
 C  
       call histwrite(histid, 'phi', itau_w, phi,  
      .                iip1*jjp1*llm, ndex3d)  
 C  
 C  Traceurs  
 C  
         DO iq=1,nq  
           call histwrite(histid, ttext(iq), itau_w, q(:,:,iq),  
      .                   iip1*jjp1*llm, ndex3d)  
         enddo  
 C  
 C  Masse  
 C  
        call histwrite(histid, 'masse', itau_w, masse, iip1*jjp1, ndex2d)  
 C  
 C  Pression au sol  
 C  
        call histwrite(histid, 'ps', itau_w, ps, iip1*jjp1, ndex2d)  
 C  
 C  Geopotentiel au sol  
 C  
        call histwrite(histid, 'phis', itau_w, phis, iip1*jjp1, ndex2d)  
 C  
 C  Fin  
 C  
       if (ok_sync) call histsync(histid)  
       return  
       end  
Legend:
Removed from v.3  
changed lines
  Added in v.61
  ViewVC Help
Powered by ViewVC 1.1.21