libf/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 advtrac_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	!
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	use advtrac_m
44	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	call histwrite(histid, 'u', itau_w, us)
91	C
92	C Vents V scalaire
93	C
94	call gr_v_scal(llm, vnat, vs)
95	call histwrite(histid, 'v', itau_w, vs)
96	C
97	C Temperature potentielle moyennee
98	C
99	call histwrite(histid, 'theta', itau_w, teta)
100	C
101	C Temperature moyennee
102	C
103	do ii = 1, ijp1llm
104	tm(ii) = teta(ii) * ppk(ii)/cpp
105	enddo
106	call histwrite(histid, 'temp', itau_w, tm)
107	C
108	C Geopotentiel
109	C
110	call histwrite(histid, 'phi', itau_w, phi)
111	C
112	C Traceurs
113	C
114	DO iq=1,nq
115	call histwrite(histid, ttext(iq), itau_w, q(:,:,iq))
116	enddo
117	C
118	C Masse
119	C
120	call histwrite(histid, 'masse', itau_w, masse)
121	C
122	C Pression au sol
123	C
124	call histwrite(histid, 'ps', itau_w, ps)
125	C
126	C Geopotentiel au sol
127	C
128	call histwrite(histid, 'phis', itau_w, phis)
129	C
130	C Fin
131	C
132	if (ok_sync) call histsync(histid)
133	return
134	end