source: LMDZ5/branches/LF-private/libf/bibio/writedynav.F90 @ 4400

Last change on this file since 4400 was 1612, checked in by lguez, 13 years ago

Conversion to free source form.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.1 KB
Line 
1! $Id: writedynav.F90 1612 2012-01-31 10:11:48Z dcugnet $
2
3subroutine 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
141end subroutine writedynav
Note: See TracBrowser for help on using the repository browser.