source: LMDZ5/trunk/libf/bibio/writedynav.F90 @ 2091

Last change on this file since 2091 was 1907, checked in by lguez, 11 years ago

Added a copyright property to every file of the distribution, except
for the fcm files (which have their own copyright). Use svn propget on
a file to see the copyright. For instance:

$ svn propget copyright libf/phylmd/physiq.F90
Name of program: LMDZ
Creation date: 1984
Version: LMDZ5
License: CeCILL version 2
Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
See the license file in the root directory

Also added the files defining the CeCILL version 2 license, in French
and English, at the top of the LMDZ tree.

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • 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 1907 2013-11-26 13:10:46Z fhourdin $
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.