My Project
 All Classes Files Functions Variables Macros
writehist_p.F
Go to the documentation of this file.
1 !
2 ! $Id: writehist_p.F 1279 2009-12-10 09:02:56Z fairhead $
3 !
4  subroutine writehist_p( histid, histvid, time, vcov,
5  , ucov,teta,phi,q,masse,ps,phis)
6 
7 #ifdef CPP_IOIPSL
8 ! This routine needs IOIPSL
9  USE ioipsl
10 #endif
11  USE parallel
12  USE misc_mod
13  USE infotrac
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 histid: ID du fichier histoire
23 C histvid:ID du fichier histoire pour les vents V (appele a disparaitre)
24 C time: temps de l'ecriture
25 C vcov: vents v covariants
26 C ucov: vents u covariants
27 C teta: temperature potentielle
28 C phi : geopotentiel instantane
29 C q : traceurs
30 C masse: masse
31 C ps :pression au sol
32 C phis : geopotentiel au sol
33 C
34 C
35 C Sortie:
36 C fileid: ID du fichier netcdf cree
37 C
38 C L. Fairhead, LMD, 03/99
39 C
40 C =====================================================================
41 C
42 C Declarations
43 #include "dimensions.h"
44 #include "paramet.h"
45 #include "comconst.h"
46 #include "comvert.h"
47 #include "comgeom.h"
48 #include "temps.h"
49 #include "ener.h"
50 #include "logic.h"
51 #include "description.h"
52 #include "serre.h"
53 #include "iniprint.h"
54 
55 C
56 C Arguments
57 C
58 
59  INTEGER histid, histvid
60  REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm)
61  REAL teta(ip1jmp1,llm),phi(ip1jmp1,llm)
62  REAL ps(ip1jmp1),masse(ip1jmp1,llm)
63  REAL phis(ip1jmp1)
64  REAL q(ip1jmp1,llm,nqtot)
65  integer time
66 
67 #ifdef CPP_IOIPSL
68 ! This routine needs IOIPSL
69 C Variables locales
70 C
71  integer iq, ii, ll
72  integer ndexu(ip1jmp1*llm),ndexv(ip1jm*llm),ndex2d(ip1jmp1)
73  logical ok_sync
74  integer itau_w
75  integer :: ijb,ije,jjn
76 C
77 C Initialisations
78 C
79  if (adjust) return
80 
81 
82  ndexu = 0
83  ndexv = 0
84  ndex2d = 0
85  ok_sync =.true.
86  itau_w = itau_dyn + time
87 C
88 C Appels a histwrite pour l'ecriture des variables a sauvegarder
89 C
90 C Vents U
91 C
92  ijb=ij_begin
93  ije=ij_end
94  jjn=jj_nb
95 
96  call histwrite(histid, 'ucov', itau_w, ucov(ijb:ije,:),
97  . iip1*jjn*llm, ndexu)
98 
99 C
100 C Vents V
101 C
102  if (pole_sud) ije=ij_end-iip1
103  if (pole_sud) jjn=jj_nb-1
104 
105  call histwrite(histvid, 'vcov', itau_w, vcov(ijb:ije,:),
106  . iip1*jjn*llm, ndexv)
107 
108 C
109 C Temperature potentielle
110 C
111  ijb=ij_begin
112  ije=ij_end
113  jjn=jj_nb
114 
115  call histwrite(histid, 'teta', itau_w, teta(ijb:ije,:),
116  . iip1*jjn*llm, ndexu)
117 C
118 C Geopotentiel
119 C
120  call histwrite(histid, 'phi', itau_w, phi(ijb:ije,:),
121  . iip1*jjn*llm, ndexu)
122 C
123 C Traceurs
124 C
125  DO iq=1,nqtot
126  call histwrite(histid, ttext(iq), itau_w, q(ijb:ije,:,iq),
127  . iip1*jjn*llm, ndexu)
128  enddo
129 C
130 C Masse
131 C
132  call histwrite(histid, 'masse', itau_w, masse(ijb:ije,1),
133  . iip1*jjn, ndex2d)
134 C
135 C Pression au sol
136 C
137  call histwrite(histid, 'ps', itau_w, ps(ijb:ije),
138  . iip1*jjn, ndex2d)
139 C
140 C Geopotentiel au sol
141 C
142  call histwrite(histid, 'phis', itau_w, phis(ijb:ije),
143  . iip1*jjn, ndex2d)
144 C
145 C Fin
146 C
147  if (ok_sync) then
148  call histsync(histid)
149  call histsync(histvid)
150  endif
151 #else
152  write(lunout,*)'writehist_p: Needs IOIPSL to function'
153 #endif
154 ! #endif of #ifdef CPP_IOIPSL
155  return
156  end