source: LMDZ5/trunk/libf/dyn3d_common/writedynav.F90 @ 2600

Last change on this file since 2600 was 2600, checked in by Ehouarn Millour, 8 years ago

Cleanup in the dynamics: turn comvert.h into module comvert_mod.F90
EM

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