source: LMDZ6/branches/contrails/libf/dyn3d_common/writedynav.f90 @ 5440

Last change on this file since 5440 was 5285, checked in by abarral, 8 weeks ago

As discussed internally, remove generic ONLY: ... for new _mod_h modules

  • 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: 2.9 KB
Line 
1! $Id: writedynav.f90 5285 2024-10-28 13:33:29Z evignon $
2
3subroutine writedynav(time, vcov, ucov, teta, ppk, phi, q, masse, ps, phis)
4
5  USE iniprint_mod_h
6  USE comgeom_mod_h
7  USE ioipsl
8  USE infotrac, ONLY : nqtot
9  use com_io_dyn_mod, only : histaveid, histvaveid, histuaveid
10  USE comconst_mod, ONLY: cpp
11  USE temps_mod, ONLY: itau_dyn
12  USE dimensions_mod, ONLY: iim, jjm, llm, ndm
13USE paramet_mod_h
14implicit none
15
16  !   Ecriture du fichier histoire au format IOIPSL
17
18  !   Appels succesifs des routines: histwrite
19
20  !   Entree:
21  !      time: temps de l'ecriture
22  !      vcov: vents v covariants
23  !      ucov: vents u covariants
24  !      teta: temperature potentielle
25  !      phi : geopotentiel instantane
26  !      q   : traceurs
27  !      masse: masse
28  !      ps   :pression au sol
29  !      phis : geopotentiel au sol
30
31  !   L. Fairhead, LMD, 03/99
32
33  !   Declarations
34
35
36  !   Arguments
37
38  REAL vcov(ip1jm, llm), ucov(ip1jmp1, llm)
39  REAL teta(ip1jmp1*llm), phi(ip1jmp1, llm), ppk(ip1jmp1*llm)     
40  REAL ps(ip1jmp1), masse(ip1jmp1, llm)                   
41  REAL phis(ip1jmp1)                 
42  REAL q(ip1jmp1, llm, nqtot)
43  integer time
44
45  ! This routine needs IOIPSL to work
46  !   Variables locales
47
48  integer ndex2d(ip1jmp1), ndexu(ip1jmp1*llm), ndexv(ip1jm*llm)
49  INTEGER iq, ii, ll
50  real tm(ip1jmp1*llm)
51  REAL vnat(ip1jm, llm), unat(ip1jmp1, llm)
52  logical ok_sync
53  integer itau_w
54
55  !-----------------------------------------------------------------
56
57  !  Initialisations
58
59  ndexu = 0
60  ndexv = 0
61  ndex2d = 0
62  ok_sync = .TRUE.
63  tm = 999.999
64  vnat = 999.999
65  unat = 999.999
66  itau_w = itau_dyn + time
67
68  ! Passage aux composantes naturelles du vent
69  call covnat(llm, ucov, vcov, unat, vnat)
70
71  !  Appels a histwrite pour l'ecriture des variables a sauvegarder
72
73  !  Vents U
74
75  call histwrite(histuaveid, 'u', itau_w, unat,  &
76       iip1*jjp1*llm, ndexu)
77
78  !  Vents V
79
80  call histwrite(histvaveid, 'v', itau_w, vnat,  &
81       iip1*jjm*llm, ndexv)
82
83  !  Temperature potentielle moyennee
84
85  call histwrite(histaveid, 'theta', itau_w, teta,  &
86       iip1*jjp1*llm, ndexu)
87
88  !  Temperature moyennee
89
90  do ii = 1, ijp1llm
91     tm(ii) = teta(ii) * ppk(ii)/cpp
92  enddo
93  call histwrite(histaveid, 'temp', itau_w, tm,  &
94       iip1*jjp1*llm, ndexu)
95
96  !  Geopotentiel
97
98  call histwrite(histaveid, 'phi', itau_w, phi,  &
99       iip1*jjp1*llm, ndexu)
100
101  !  Traceurs
102
103  !  DO iq=1, nqtot
104  !       call histwrite(histaveid, tracers(iq)%longName, itau_w, &
105  !                   q(:, :, iq), iip1*jjp1*llm, ndexu)
106  ! enddo
107
108  !  Masse
109
110  call histwrite(histaveid, 'masse', itau_w, masse,  &
111       iip1*jjp1*llm, ndexu)
112
113  !  Pression au sol
114
115  call histwrite(histaveid, 'ps', itau_w, ps, iip1*jjp1, ndex2d)
116
117  ! Geopotentiel au sol
118
119  ! call histwrite(histaveid, 'phis', itau_w, phis, iip1*jjp1, ndex2d)
120
121  if (ok_sync) then
122     call histsync(histaveid)
123     call histsync(histvaveid)
124     call histsync(histuaveid)
125  ENDIF
126
127
128
129
130end subroutine writedynav
Note: See TracBrowser for help on using the repository browser.