Sources/bibio/writedynav.f

!
! $Header: /home/cvsroot/LMDZ4/libf/bibio/writedynav.F,v 1.1.1.1 2004/05/19 12:53:05 lmdzadmin Exp $
!
      subroutine writedynav( histid, nq, time, vcov, 
     ,                          ucov,teta,ppk,phi,q,masse,ps,phis)

      USE ioipsl
C
C   Ecriture du fichier histoire au format IOIPSL
C
C   Appels succesifs des routines: histwrite
C
C   Entree:
C      histid: ID du fichier histoire
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   Sortie:
C      fileid: ID du fichier netcdf cree
C
C   L. Fairhead, LMD, 03/99
C
C =====================================================================
C
C   Declarations
      use dimens_m
      use paramet_m
      use comconst
      use comvert
      use logic
      use comgeom
      use serre
      use temps
      use ener
      use iniadvtrac_m
      implicit none


C
C   Arguments
C

      INTEGER histid, nq
      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) 
      REAL teta(ip1jmp1*llm),phi(ip1jmp1,llm),ppk(ip1jmp1*llm)                  
      REAL ps(ip1jmp1),masse(ip1jmp1,llm)                   
      REAL phis(ip1jmp1)                  
      REAL q(ip1jmp1,llm,nq)
      integer, intent(in):: time


C   Variables locales
C
      integer ndex2d(iip1*jjp1),ndex3d(iip1*jjp1*llm),iq, ii, ll
      real us(ip1jmp1*llm), vs(ip1jmp1*llm)
      real tm(ip1jmp1*llm)
      REAL vnat(ip1jm,llm),unat(ip1jmp1,llm) 
      logical ok_sync
      integer itau_w
C
C  Initialisations
C
      ndex3d = 0
      ndex2d = 0
      ok_sync = .TRUE.
      us = 999.999
      vs = 999.999
      tm = 999.999
      vnat = 999.999
      unat = 999.999
      itau_w = itau_dyn + time

C 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 scalaire
C
      call gr_u_scal(llm, unat, us)
      call histwrite(histid, 'u', itau_w, us)
C
C  Vents V scalaire
C
      call gr_v_scal(llm, vnat, vs)
      call histwrite(histid, 'v', itau_w, vs)
C
C  Temperature potentielle moyennee
C
      call histwrite(histid, 'theta', itau_w, teta)
C
C  Temperature moyennee
C
      do ii = 1, ijp1llm
        tm(ii) = teta(ii) * ppk(ii)/cpp
      enddo
      call histwrite(histid, 'temp', itau_w, tm)
C
C  Geopotentiel
C
      call histwrite(histid, 'phi', itau_w, phi)
C
C  Traceurs
C
        DO iq=1,nq
          call histwrite(histid, ttext(iq), itau_w, q(:,:,iq))
        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)
C
C  Fin
C
      if (ok_sync) call histsync(histid)
      return
      end
1	guez	3	!
2			! $Header: /home/cvsroot/LMDZ4/libf/bibio/writedynav.F,v 1.1.1.1 2004/05/19 12:53:05 lmdzadmin Exp $
3			!
4			subroutine writedynav( histid, nq, time, vcov,
5			, ucov,teta,ppk,phi,q,masse,ps,phis)
6
7			USE ioipsl
8			C
9			C Ecriture du fichier histoire au format IOIPSL
10			C
11			C Appels succesifs des routines: histwrite
12			C
13			C Entree:
14			C histid: ID du fichier histoire
15			C time: temps de l'ecriture
16			C vcov: vents v covariants
17			C ucov: vents u covariants
18			C teta: temperature potentielle
19			C phi : geopotentiel instantane
20			C q : traceurs
21			C masse: masse
22			C ps :pression au sol
23			C phis : geopotentiel au sol
24			C
25			C
26			C Sortie:
27			C fileid: ID du fichier netcdf cree
28			C
29			C L. Fairhead, LMD, 03/99
30			C
31			C =====================================================================
32			C
33			C Declarations
34			use dimens_m
35			use paramet_m
36			use comconst
37			use comvert
38			use logic
39			use comgeom
40			use serre
41			use temps
42			use ener
43	guez	18	use iniadvtrac_m
44	guez	3	implicit none
45
46
47			C
48			C Arguments
49			C
50
51			INTEGER histid, nq
52			REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm)
53			REAL teta(ip1jmp1llm),phi(ip1jmp1,llm),ppk(ip1jmp1llm)
54			REAL ps(ip1jmp1),masse(ip1jmp1,llm)
55			REAL phis(ip1jmp1)
56			REAL q(ip1jmp1,llm,nq)
57			integer, intent(in):: time
58
59
60			C Variables locales
61			C
62			integer ndex2d(iip1jjp1),ndex3d(iip1jjp1*llm),iq, ii, ll
63			real us(ip1jmp1llm), vs(ip1jmp1llm)
64			real tm(ip1jmp1*llm)
65			REAL vnat(ip1jm,llm),unat(ip1jmp1,llm)
66			logical ok_sync
67			integer itau_w
68			C
69			C Initialisations
70			C
71			ndex3d = 0
72			ndex2d = 0
73			ok_sync = .TRUE.
74			us = 999.999
75			vs = 999.999
76			tm = 999.999
77			vnat = 999.999
78			unat = 999.999
79			itau_w = itau_dyn + time
80
81			C Passage aux composantes naturelles du vent
82			call covnat(llm, ucov, vcov, unat, vnat)
83
84			C
85			C Appels a histwrite pour l'ecriture des variables a sauvegarder
86			C
87			C Vents U scalaire
88			C
89			call gr_u_scal(llm, unat, us)
90	guez	15	call histwrite(histid, 'u', itau_w, us)
91	guez	3	C
92			C Vents V scalaire
93			C
94			call gr_v_scal(llm, vnat, vs)
95	guez	15	call histwrite(histid, 'v', itau_w, vs)
96	guez	3	C
97			C Temperature potentielle moyennee
98			C
99	guez	15	call histwrite(histid, 'theta', itau_w, teta)
100	guez	3	C
101			C Temperature moyennee
102			C
103			do ii = 1, ijp1llm
104			tm(ii) = teta(ii) * ppk(ii)/cpp
105			enddo
106	guez	15	call histwrite(histid, 'temp', itau_w, tm)
107	guez	3	C
108			C Geopotentiel
109			C
110	guez	15	call histwrite(histid, 'phi', itau_w, phi)
111	guez	3	C
112			C Traceurs
113			C
114			DO iq=1,nq
115	guez	15	call histwrite(histid, ttext(iq), itau_w, q(:,:,iq))
116	guez	3	enddo
117			C
118			C Masse
119			C
120	guez	15	call histwrite(histid, 'masse', itau_w, masse)
121	guez	3	C
122			C Pression au sol
123			C
124	guez	15	call histwrite(histid, 'ps', itau_w, ps)
125	guez	3	C
126			C Geopotentiel au sol
127			C
128	guez	15	call histwrite(histid, 'phis', itau_w, phis)
129	guez	3	C
130			C Fin
131			C
132			if (ok_sync) call histsync(histid)
133			return
134			end