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

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

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

trunk/libf/bibio/writehist.f revision 61 by guez, Fri Apr 20 14:58:43 2012 UTC trunk/Sources/bibio/writehist.f revision 138 by guez, Fri May 22 23:13:19 2015 UTC
# Line 1  Line 1 
1  !  module writehist_m
2  ! $Id: writehist.F 1403 2010-07-01 09:02:53Z fairhead $  
3  !    implicit none
4        subroutine writehist(time,vcov,ucov,teta,phi,q,masse,ps,phis)  
5    contains
6        use dimens_m, only: nqmx, llm, jjm  
7        USE iniadvtrac_m, ONLY: ttext    subroutine writehist(time, vcov, ucov, teta, phi, masse, ps)
8        use com_io_dyn, only: histid,histvid,histuid  
9        use paramet_m, only: ip1jm, ip1jmp1, iip1, jjp1      ! From writehist.F 1403 2010-07-01 09:02:53Z
10        use temps, only: itau_dyn      ! Écriture du fichier histoire au format IOIPSL
11        use histwrite_m, only: histwrite      ! Appels successifs des routines histwrite
12        use histsync_m, only: histsync      ! L. Fairhead, LMD, 03/99
13        use covnat_m, only: covnat  
14        use dimens_m, only: nqmx, llm, jjm
15        implicit none      use com_io_dyn, only: histid, histvid, histuid
16        use paramet_m, only: ip1jm, ip1jmp1, iip1, jjp1
17  C      use temps, only: itau_dyn
18  C   Ecriture du fichier histoire au format IOIPSL      use histwrite_m, only: histwrite
19  C      use histsync_m, only: histsync
20  C   Appels succesifs des routines: histwrite      use covnat_m, only: covnat
21  C  
22  C   Entree:      ! Entree:
23  C      time: temps de l'ecriture      ! time: temps de l'ecriture
24  C      vcov: vents v covariants      ! vcov: vents v covariants
25  C      ucov: vents u covariants      ! ucov: vents u covariants
26  C      teta: temperature potentielle      ! teta: temperature potentielle
27  C      phi : geopotentiel instantane      ! phi : geopotentiel instantane
28  C      q   : traceurs      ! masse: masse
29  C      masse: masse      ! ps :pression au sol
30  C      ps   :pression au sol  
31  C      phis : geopotentiel au sol      ! Arguments
32  C        
33  C      REAL vcov(ip1jm, llm), ucov(ip1jmp1, llm)
34  C   L. Fairhead, LMD, 03/99      REAL teta(ip1jmp1, llm), phi(ip1jmp1, llm)
35  C      REAL, intent(in):: ps(ip1jmp1), masse(ip1jmp1, llm)
36  C =====================================================================      integer time
37  C  
38  C   Declarations      ! This routine needs IOIPSL to work
39        ! Variables locales
40  C  
41  C   Arguments      integer ndexu(ip1jmp1*llm), ndexv(ip1jm*llm), ndex2d(ip1jmp1)
42  C      logical ok_sync
43        integer itau_w
44        REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm)      REAL vnat(ip1jm, llm), unat(ip1jmp1, llm)
45        REAL teta(ip1jmp1,llm),phi(ip1jmp1,llm)                    
46        REAL ps(ip1jmp1),masse(ip1jmp1,llm)                        !---------------------------------------------------------------------
47        REAL phis(ip1jmp1)                    
48        REAL q(ip1jmp1,llm,nqmx)      ! Initialisations
49        integer time  
50        ndexu = 0
51        ndexv = 0
52  ! This routine needs IOIPSL to work      ndex2d = 0
53  C   Variables locales      ok_sync =.TRUE.
54  C      itau_w = itau_dyn + time
55        integer iq, ii, ll      ! Passage aux composantes naturelles du vent
56        integer ndexu(ip1jmp1*llm),ndexv(ip1jm*llm),ndex2d(ip1jmp1)      call covnat(llm, ucov, vcov, unat, vnat)
57        logical ok_sync  
58        integer itau_w      ! Appels a histwrite pour l'ecriture des variables a sauvegarder
59        REAL vnat(ip1jm,llm),unat(ip1jmp1,llm)  
60        ! Vents U
61  C  
62  C  Initialisations      call histwrite(histuid, 'u', itau_w, unat)
63  C  
64        ndexu = 0      ! Vents V
65        ndexv = 0  
66        ndex2d = 0      call histwrite(histvid, 'v', itau_w, vnat)
67        ok_sync =.TRUE.  
68        itau_w = itau_dyn + time      ! Temperature potentielle
69  !  Passage aux composantes naturelles du vent  
70        call covnat(llm, ucov, vcov, unat, vnat)      call histwrite(histid, 'teta', itau_w, teta)
71  C  
72  C  Appels a histwrite pour l'ecriture des variables a sauvegarder      ! Geopotentiel
73  C  
74  C  Vents U      call histwrite(histid, 'phi', itau_w, phi)
75  C  
76        call histwrite(histuid, 'u', itau_w, unat)      ! Masse
77  C  
78  C  Vents V      call histwrite(histid, 'masse', itau_w, masse)
79  C  
80        call histwrite(histvid, 'v', itau_w, vnat)      ! Pression au sol
81        call histwrite(histid, 'ps', itau_w, ps)
82  C  
83  C  Temperature potentielle      if (ok_sync) then
84  C         call histsync(histid)
85        call histwrite(histid, 'teta', itau_w, teta)         call histsync(histvid)
86  C         call histsync(histuid)
87  C  Geopotentiel      endif
88  C  
89        call histwrite(histid, 'phi', itau_w, phi)    end subroutine writehist
90  C  
91  C  Traceurs  end module writehist_m
 C  
 !        DO iq=1,nqmx  
 !          call histwrite(histid, ttext(iq), itau_w, q(:,:,iq),  
 !     .                   iip1*jjp1*llm, ndexu)  
 !        enddo  
 !C  
 C  Masse  
 C  
       call histwrite(histid,'masse',itau_w, masse)  
 C  
 C  Pression au sol  
 C  
       call histwrite(histid, 'ps', itau_w, ps)  
 C  
 C  Geopotentiel au sol  
 C  
 !      call histwrite(histid, 'phis', itau_w, phis, iip1*jjp1, ndex2d)  
 C  
 C  Fin  
 C  
       if (ok_sync) then  
         call histsync(histid)  
         call histsync(histvid)  
         call histsync(histuid)  
       endif  
       return  
       end  
Legend:
Removed from v.61  
changed lines
  Added in v.138
  ViewVC Help
Powered by ViewVC 1.1.21