/[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 56 by guez, Tue Jan 10 19:02:02 2012 UTC trunk/bibio/writehist.f revision 82 by guez, Wed Mar 5 14:57:53 2014 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, q, 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 histcom, only: histsync      ! L. Fairhead, LMD, 03/99
13    
14        implicit none      use dimens_m, only: nqmx, llm, jjm
15        USE iniadvtrac_m, ONLY: ttext
16  C      use com_io_dyn, only: histid, histvid, histuid
17  C   Ecriture du fichier histoire au format IOIPSL      use paramet_m, only: ip1jm, ip1jmp1, iip1, jjp1
18  C      use temps, only: itau_dyn
19  C   Appels succesifs des routines: histwrite      use histwrite_m, only: histwrite
20  C      use histsync_m, only: histsync
21  C   Entree:      use covnat_m, only: covnat
22  C      time: temps de l'ecriture  
23  C      vcov: vents v covariants      ! Entree:
24  C      ucov: vents u covariants      ! time: temps de l'ecriture
25  C      teta: temperature potentielle      ! vcov: vents v covariants
26  C      phi : geopotentiel instantane      ! ucov: vents u covariants
27  C      q   : traceurs      ! teta: temperature potentielle
28  C      masse: masse      ! phi : geopotentiel instantane
29  C      ps   :pression au sol      ! q : traceurs
30  C      phis : geopotentiel au sol      ! masse: masse
31  C            ! ps :pression au sol
32  C  
33  C   L. Fairhead, LMD, 03/99      ! Arguments
34  C  
35  C =====================================================================      REAL vcov(ip1jm, llm), ucov(ip1jmp1, llm)
36  C      REAL teta(ip1jmp1, llm), phi(ip1jmp1, llm)
37  C   Declarations      REAL ps(ip1jmp1), masse(ip1jmp1, llm)
38        REAL q(ip1jmp1, llm, nqmx)
39  C      integer time
40  C   Arguments  
41  C      ! This routine needs IOIPSL to work
42        ! Variables locales
43        REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm)  
44        REAL teta(ip1jmp1,llm),phi(ip1jmp1,llm)                        integer iq, ii, ll
45        REAL ps(ip1jmp1),masse(ip1jmp1,llm)                        integer ndexu(ip1jmp1*llm), ndexv(ip1jm*llm), ndex2d(ip1jmp1)
46        REAL phis(ip1jmp1)                        logical ok_sync
47        REAL q(ip1jmp1,llm,nqmx)      integer itau_w
48        integer time      REAL vnat(ip1jm, llm), unat(ip1jmp1, llm)
49    
50        !---------------------------------------------------------------------
51  ! This routine needs IOIPSL to work  
52  C   Variables locales      ! Initialisations
53  C  
54        integer iq, ii, ll      ndexu = 0
55        integer ndexu(ip1jmp1*llm),ndexv(ip1jm*llm),ndex2d(ip1jmp1)      ndexv = 0
56        logical ok_sync      ndex2d = 0
57        integer itau_w      ok_sync =.TRUE.
58        REAL vnat(ip1jm,llm),unat(ip1jmp1,llm)      itau_w = itau_dyn + time
59        ! Passage aux composantes naturelles du vent
60  C      call covnat(llm, ucov, vcov, unat, vnat)
61  C  Initialisations  
62  C      ! Appels a histwrite pour l'ecriture des variables a sauvegarder
63        ndexu = 0  
64        ndexv = 0      ! Vents U
65        ndex2d = 0  
66        ok_sync =.TRUE.      call histwrite(histuid, 'u', itau_w, unat)
67        itau_w = itau_dyn + time  
68  !  Passage aux composantes naturelles du vent      ! Vents V
69        call covnat(llm, ucov, vcov, unat, vnat)  
70  C      call histwrite(histvid, 'v', itau_w, vnat)
71  C  Appels a histwrite pour l'ecriture des variables a sauvegarder  
72  C      ! Temperature potentielle
73  C  Vents U  
74  C      call histwrite(histid, 'teta', itau_w, teta)
75        call histwrite(histuid, 'u', itau_w, unat)  
76  C      ! Geopotentiel
77  C  Vents V  
78  C      call histwrite(histid, 'phi', itau_w, phi)
79        call histwrite(histvid, 'v', itau_w, vnat)  
80        ! Traceurs
81  C  
82  C  Temperature potentielle      ! DO iq=1, nqmx
83  C      ! call histwrite(histid, ttext(iq), itau_w, q(:, :, iq),
84        call histwrite(histid, 'teta', itau_w, teta)      ! . iip1*jjp1*llm, ndexu)
85  C      ! enddo
86  C  Geopotentiel      !C
87  C      ! Masse
88        call histwrite(histid, 'phi', itau_w, phi)  
89  C      call histwrite(histid, 'masse', itau_w, masse)
90  C  Traceurs  
91  C      ! Pression au sol
92  !        DO iq=1,nqmx      call histwrite(histid, 'ps', itau_w, ps)
93  !          call histwrite(histid, ttext(iq), itau_w, q(:,:,iq),  
94  !     .                   iip1*jjp1*llm, ndexu)      if (ok_sync) then
95  !        enddo         call histsync(histid)
96  !C         call histsync(histvid)
97  C  Masse         call histsync(histuid)
98  C      endif
99        call histwrite(histid,'masse',itau_w, masse)  
100  C    end subroutine writehist
101  C  Pression au sol  
102  C  end module writehist_m
       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.56  
changed lines
  Added in v.82
  ViewVC Help
Powered by ViewVC 1.1.21