My Project
 All Classes Files Functions Variables Macros
writehist.F
Go to the documentation of this file.
1 !
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 #ifdef CPP_IOIPSL
7  USE ioipsl
8 #endif
9  USE infotrac, ONLY : nqtot, ttext
10  use com_io_dyn_mod, only : histid,histvid,histuid
11  implicit none
12 
13 C
14 C Ecriture du fichier histoire au format IOIPSL
15 C
16 C Appels succesifs des routines: histwrite
17 C
18 C Entree:
19 C time: temps de l'ecriture
20 C vcov: vents v covariants
21 C ucov: vents u covariants
22 C teta: temperature potentielle
23 C phi : geopotentiel instantane
24 C q : traceurs
25 C masse: masse
26 C ps :pression au sol
27 C phis : geopotentiel au sol
28 C
29 C
30 C L. Fairhead, LMD, 03/99
31 C
32 C =====================================================================
33 C
34 C Declarations
35 #include "dimensions.h"
36 #include "paramet.h"
37 #include "comconst.h"
38 #include "comvert.h"
39 #include "comgeom.h"
40 #include "temps.h"
41 #include "ener.h"
42 #include "logic.h"
43 #include "description.h"
44 #include "serre.h"
45 #include "iniprint.h"
46 
47 C
48 C Arguments
49 C
50 
51  REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm)
52  REAL teta(ip1jmp1,llm),phi(ip1jmp1,llm)
53  REAL ps(ip1jmp1),masse(ip1jmp1,llm)
54  REAL phis(ip1jmp1)
55  REAL q(ip1jmp1,llm,nqtot)
56  integer time
57 
58 
59 #ifdef CPP_IOIPSL
60 ! This routine needs IOIPSL to work
61 C Variables locales
62 C
63  integer iq, ii, ll
64  integer ndexu(ip1jmp1*llm),ndexv(ip1jm*llm),ndex2d(ip1jmp1)
65  logical ok_sync
66  integer itau_w
67  REAL vnat(ip1jm,llm),unat(ip1jmp1,llm)
68 
69 C
70 C Initialisations
71 C
72  ndexu = 0
73  ndexv = 0
74  ndex2d = 0
75  ok_sync =.true.
76  itau_w = itau_dyn + time
77 ! Passage aux composantes naturelles du vent
78  call covnat(llm, ucov, vcov, unat, vnat)
79 C
80 C Appels a histwrite pour l'ecriture des variables a sauvegarder
81 C
82 C Vents U
83 C
84  call histwrite(histuid, 'u', itau_w, unat,
85  . iip1*jjp1*llm, ndexu)
86 C
87 C Vents V
88 C
89  call histwrite(histvid, 'v', itau_w, vnat,
90  . iip1*jjm*llm, ndexv)
91 
92 C
93 C Temperature potentielle
94 C
95  call histwrite(histid, 'teta', itau_w, teta,
96  . iip1*jjp1*llm, ndexu)
97 C
98 C Geopotentiel
99 C
100  call histwrite(histid, 'phi', itau_w, phi,
101  . iip1*jjp1*llm, ndexu)
102 C
103 C Traceurs
104 C
105 ! DO iq=1,nqtot
106 ! call histwrite(histid, ttext(iq), itau_w, q(:,:,iq),
107 ! . iip1*jjp1*llm, ndexu)
108 ! enddo
109 !C
110 C Masse
111 C
112  call histwrite(histid,'masse',itau_w, masse,iip1*jjp1*llm,ndexu)
113 C
114 C Pression au sol
115 C
116  call histwrite(histid, 'ps', itau_w, ps, iip1*jjp1, ndex2d)
117 C
118 C Geopotentiel au sol
119 C
120 ! call histwrite(histid, 'phis', itau_w, phis, iip1*jjp1, ndex2d)
121 C
122 C Fin
123 C
124  if (ok_sync) then
125  call histsync(histid)
126  call histsync(histvid)
127  call histsync(histuid)
128  endif
129 #else
130 ! tell the user this routine should be run with ioipsl
131  write(lunout,*)"writehist: Warning this routine should not be",
132  & " used without ioipsl"
133 #endif
134 ! of #ifdef CPP_IOIPSL
135  return
136  end