source: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/lmdz_writehist.f90 @ 5186

Last change on this file since 5186 was 5186, checked in by abarral, 9 days ago

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