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