source: LMDZ6/trunk/libf/dyn3d_common/writehist.F90 @ 5248

Last change on this file since 5248 was 5246, checked in by abarral, 20 hours ago

Convert fixed-form to free-form sources .F -> .{f,F}90
(WIP: some .F remain, will be handled in subsequent commits)

  • 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.8 KB
Line 
1!
2! $Id: writehist.F90 5246 2024-10-21 12:58:45Z abarral $
3!
4subroutine writehist(time,vcov,ucov,teta,phi,q,masse,ps,phis)
5
6#ifdef CPP_IOIPSL
7  USE ioipsl
8#endif
9  USE infotrac, ONLY : nqtot
10  use com_io_dyn_mod, only : histid,histvid,histuid
11  USE temps_mod, ONLY: itau_dyn
12
13  implicit none
14
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  !
32  !   L. Fairhead, LMD, 03/99
33  !
34  ! =====================================================================
35  !
36  !   Declarations
37  include "dimensions.h"
38  include "paramet.h"
39  include "comgeom.h"
40  include "description.h"
41  include "iniprint.h"
42
43  !
44  !   Arguments
45  !
46
47  REAL :: vcov(ip1jm,llm),ucov(ip1jmp1,llm)
48  REAL :: teta(ip1jmp1,llm),phi(ip1jmp1,llm)
49  REAL :: ps(ip1jmp1),masse(ip1jmp1,llm)
50  REAL :: phis(ip1jmp1)
51  REAL :: q(ip1jmp1,llm,nqtot)
52  integer :: time
53
54
55#ifdef CPP_IOIPSL
56  ! This routine needs IOIPSL to work
57  !   Variables locales
58  !
59  integer :: iq, ii, ll
60  integer :: ndexu(ip1jmp1*llm),ndexv(ip1jm*llm),ndex2d(ip1jmp1)
61  logical :: ok_sync
62  integer :: itau_w
63  REAL :: vnat(ip1jm,llm),unat(ip1jmp1,llm)
64
65  !
66  !  Initialisations
67  !
68  ndexu = 0
69  ndexv = 0
70  ndex2d = 0
71  ok_sync =.TRUE.
72  itau_w = itau_dyn + time
73  !  Passage aux composantes naturelles du vent
74  call covnat(llm, ucov, vcov, unat, vnat)
75  !
76  !  Appels a histwrite pour l'ecriture des variables a sauvegarder
77  !
78  !  Vents U
79  !
80  call histwrite(histuid, 'u', itau_w, unat, &
81        iip1*jjp1*llm, ndexu)
82  !
83  !  Vents V
84  !
85  call histwrite(histvid, 'v', itau_w, vnat, &
86        iip1*jjm*llm, ndexv)
87
88  !
89  !  Temperature potentielle
90  !
91  call histwrite(histid, 'teta', itau_w, teta, &
92        iip1*jjp1*llm, ndexu)
93  !
94  !  Geopotentiel
95  !
96  call histwrite(histid, 'phi', itau_w, phi, &
97        iip1*jjp1*llm, ndexu)
98  !
99  !  Traceurs
100  !
101  !    DO iq=1,nqtot
102  !      call histwrite(histid, tracers(iq)%longName, itau_w,
103  ! .                   q(:,:,iq), iip1*jjp1*llm, ndexu)
104  !    enddo
105  !C
106  !  Masse
107  !
108  call histwrite(histid,'masse',itau_w, masse,iip1*jjp1*llm,ndexu)
109  !
110  !  Pression au sol
111  !
112  call histwrite(histid, 'ps', itau_w, ps, iip1*jjp1, ndex2d)
113  !
114  !  Geopotentiel au sol
115  !
116  !  call histwrite(histid, 'phis', itau_w, phis, iip1*jjp1, ndex2d)
117  !
118  !  Fin
119  !
120  if (ok_sync) then
121    call histsync(histid)
122    call histsync(histvid)
123    call histsync(histuid)
124  endif
125#else
126  ! tell the user this routine should be run with ioipsl
127  write(lunout,*)"writehist: Warning this routine should not be", &
128        " used without ioipsl"
129#endif
130  ! of #ifdef CPP_IOIPSL
131  return
132end subroutine writehist
Note: See TracBrowser for help on using the repository browser.