source: LMDZ6/trunk/libf/dyn3d_common/writedynav.f90 @ 5355

Last change on this file since 5355 was 5285, checked in by abarral, 7 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
RevLine 
[1279]1! $Id: writedynav.f90 5285 2024-10-28 13:33:29Z ymeurdesoif $
[524]2
[1612]3subroutine writedynav(time, vcov, ucov, teta, ppk, phi, q, masse, ps, phis)
4
[5282]5  USE iniprint_mod_h
[5281]6  USE comgeom_mod_h
[1612]7  USE ioipsl
[4046]8  USE infotrac, ONLY : nqtot
[1612]9  use com_io_dyn_mod, only : histaveid, histvaveid, histuaveid
[2597]10  USE comconst_mod, ONLY: cpp
[2601]11  USE temps_mod, ONLY: itau_dyn
[5271]12  USE dimensions_mod, ONLY: iim, jjm, llm, ndm
[5285]13USE paramet_mod_h
[5271]14implicit none
[524]15
[1612]16  !   Ecriture du fichier histoire au format IOIPSL
[524]17
[1612]18  !   Appels succesifs des routines: histwrite
[524]19
[1612]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
[524]30
[1612]31  !   L. Fairhead, LMD, 03/99
32
33  !   Declarations
[5271]34
[5272]35
[1612]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
[524]47
[1612]48  integer ndex2d(ip1jmp1), ndexu(ip1jmp1*llm), ndexv(ip1jm*llm)
49  INTEGER iq, ii, ll
50  real tm(ip1jmp1*llm)
[5267]51  REAL vnat(ip1jm, llm), unat(ip1jmp1, llm)
[1612]52  logical ok_sync
53  integer itau_w
[524]54
[1612]55  !-----------------------------------------------------------------
[1279]56
[1612]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
[5267]73  !  Vents U
[1612]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
[4046]104  !       call histwrite(histaveid, tracers(iq)%longName, itau_w, &
105  !                   q(:, :, iq), iip1*jjp1*llm, ndexu)
[1612]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
[5267]128
129
[1612]130end subroutine writedynav
Note: See TracBrowser for help on using the repository browser.