source: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/writedynav.F90 @ 5133

Last change on this file since 5133 was 5118, checked in by abarral, 5 months ago

Replace iniprint.h by lmdz_iniprint.f90
(lint) along the way

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