libf/bibio/writehist.f

!
! $Id: writehist.F 1403 2010-07-01 09:02:53Z fairhead $
!
      subroutine writehist(time,vcov,ucov,teta,phi,q,masse,ps,phis)

      use dimens_m, only: nqmx, llm, jjm
      USE iniadvtrac_m, ONLY: ttext
      use com_io_dyn, only: histid,histvid,histuid
      use paramet_m, only: ip1jm, ip1jmp1, iip1, jjp1
      use temps, only: itau_dyn
      use histwrite_m, only: histwrite
      use histcom, only: histsync

      implicit none

C
C   Ecriture du fichier histoire au format IOIPSL
C
C   Appels succesifs des routines: histwrite
C
C   Entree:
C      time: temps de l'ecriture
C      vcov: vents v covariants
C      ucov: vents u covariants
C      teta: temperature potentielle
C      phi : geopotentiel instantane
C      q   : traceurs
C      masse: masse
C      ps   :pression au sol
C      phis : geopotentiel au sol
C      
C
C   L. Fairhead, LMD, 03/99
C
C =====================================================================
C
C   Declarations

C
C   Arguments
C

      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) 
      REAL teta(ip1jmp1,llm),phi(ip1jmp1,llm)                   
      REAL ps(ip1jmp1),masse(ip1jmp1,llm)                   
      REAL phis(ip1jmp1)                  
      REAL q(ip1jmp1,llm,nqmx)
      integer time


! This routine needs IOIPSL to work
C   Variables locales
C
      integer iq, ii, ll
      integer ndexu(ip1jmp1*llm),ndexv(ip1jm*llm),ndex2d(ip1jmp1)
      logical ok_sync
      integer itau_w
      REAL vnat(ip1jm,llm),unat(ip1jmp1,llm)

C
C  Initialisations
C
      ndexu = 0
      ndexv = 0
      ndex2d = 0
      ok_sync =.TRUE.
      itau_w = itau_dyn + time
!  Passage aux composantes naturelles du vent
      call covnat(llm, ucov, vcov, unat, vnat)
C
C  Appels a histwrite pour l'ecriture des variables a sauvegarder
C
C  Vents U
C
      call histwrite(histuid, 'u', itau_w, unat)
C
C  Vents V
C
      call histwrite(histvid, 'v', itau_w, vnat)

C
C  Temperature potentielle
C
      call histwrite(histid, 'teta', itau_w, teta)
C
C  Geopotentiel
C
      call histwrite(histid, 'phi', itau_w, phi)
C
C  Traceurs
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
1	guez	56	!
2			! $Id: writehist.F 1403 2010-07-01 09:02:53Z fairhead $
3			!
4			subroutine writehist(time,vcov,ucov,teta,phi,q,masse,ps,phis)
5
6			use dimens_m, only: nqmx, llm, jjm
7			USE iniadvtrac_m, ONLY: ttext
8			use com_io_dyn, only: histid,histvid,histuid
9			use paramet_m, only: ip1jm, ip1jmp1, iip1, jjp1
10			use temps, only: itau_dyn
11			use histwrite_m, only: histwrite
12			use histcom, only: histsync
13
14			implicit none
15
16			C
17			C Ecriture du fichier histoire au format IOIPSL
18			C
19			C Appels succesifs des routines: histwrite
20			C
21			C Entree:
22			C time: temps de l'ecriture
23			C vcov: vents v covariants
24			C ucov: vents u covariants
25			C teta: temperature potentielle
26			C phi : geopotentiel instantane
27			C q : traceurs
28			C masse: masse
29			C ps :pression au sol
30			C phis : geopotentiel au sol
31			C
32			C
33			C L. Fairhead, LMD, 03/99
34			C
35			C =====================================================================
36			C
37			C Declarations
38
39			C
40			C Arguments
41			C
42
43			REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm)
44			REAL teta(ip1jmp1,llm),phi(ip1jmp1,llm)
45			REAL ps(ip1jmp1),masse(ip1jmp1,llm)
46			REAL phis(ip1jmp1)
47			REAL q(ip1jmp1,llm,nqmx)
48			integer time
49
50
51			! This routine needs IOIPSL to work
52			C Variables locales
53			C
54			integer iq, ii, ll
55			integer ndexu(ip1jmp1llm),ndexv(ip1jmllm),ndex2d(ip1jmp1)
56			logical ok_sync
57			integer itau_w
58			REAL vnat(ip1jm,llm),unat(ip1jmp1,llm)
59
60			C
61			C Initialisations
62			C
63			ndexu = 0
64			ndexv = 0
65			ndex2d = 0
66			ok_sync =.TRUE.
67			itau_w = itau_dyn + time
68			! Passage aux composantes naturelles du vent
69			call covnat(llm, ucov, vcov, unat, vnat)
70			C
71			C Appels a histwrite pour l'ecriture des variables a sauvegarder
72			C
73			C Vents U
74			C
75			call histwrite(histuid, 'u', itau_w, unat)
76			C
77			C Vents V
78			C
79			call histwrite(histvid, 'v', itau_w, vnat)
80
81			C
82			C Temperature potentielle
83			C
84			call histwrite(histid, 'teta', itau_w, teta)
85			C
86			C Geopotentiel
87			C
88			call histwrite(histid, 'phi', itau_w, phi)
89			C
90			C Traceurs
91			C
92			! DO iq=1,nqmx
93			! call histwrite(histid, ttext(iq), itau_w, q(:,:,iq),
94			! . iip1jjp1llm, ndexu)
95			! enddo
96			!C
97			C Masse
98			C
99			call histwrite(histid,'masse',itau_w, masse)
100			C
101			C Pression au sol
102			C
103			call histwrite(histid, 'ps', itau_w, ps)
104			C
105			C Geopotentiel au sol
106			C
107			! call histwrite(histid, 'phis', itau_w, phis, iip1*jjp1, ndex2d)
108			C
109			C Fin
110			C
111			if (ok_sync) then
112			call histsync(histid)
113			call histsync(histvid)
114			call histsync(histuid)
115			endif
116			return
117			end