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)

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