source: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/writehist_loc.f90 @ 5409

Last change on this file since 5409 was 5195, checked in by abarral, 3 months ago

Correct r5192, some lmdz_description cases were missing

  • 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
File size: 4.2 KB
Line 
1! $Id: writedynav_p.F 1279 2009-12-10 09:02:56Z fairhead $
2
3SUBROUTINE writehist_loc(time, vcov, ucov, teta, ppk, phi, q, masse, ps, phis)
4  USE ioipsl
5  USE parallel_lmdz
6  USE misc_mod
7  USE lmdz_infotrac, ONLY: nqtot
8  USE com_io_dyn_mod, ONLY: histid, histvid, histuid
9  USE comconst_mod, ONLY: cpp
10  USE temps_mod, ONLY: itau_dyn
11  USE lmdz_iniprint, ONLY: lunout, prt_level
12  USE lmdz_comgeom
13
14  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
15  USE lmdz_paramet
16  IMPLICIT NONE
17
18
19  !   Ecriture du fichier histoire au format IOIPSL
20
21  !   Appels succesifs des routines: histwrite
22
23  !   Entree:
24  !  histid: ID du fichier histoire
25  !  time: temps de l'ecriture
26  !  vcov: vents v covariants
27  !  ucov: vents u covariants
28  !  teta: temperature potentielle
29  !  phi : geopotentiel instantane
30  !  q   : traceurs
31  !  masse: masse
32  !  ps   :pression au sol
33  !  phis : geopotentiel au sol
34
35
36  !   Sortie:
37  !  fileid: ID du fichier netcdf cree
38
39  !   L. Fairhead, LMD, 03/99
40
41  ! =====================================================================
42
43  !   Declarations
44
45
46
47
48  !   Arguments
49  !
50
51  REAL :: vcov(ijb_v:ije_v, llm), ucov(ijb_u:ije_u, llm)
52  REAL :: teta(ijb_u:ije_u, llm), phi(ijb_u:ije_u, llm)
53  REAL :: ppk(ijb_u:ije_u, llm)
54  REAL :: ps(ijb_u:ije_u), masse(ijb_u:ije_u, llm)
55  REAL :: phis(ijb_u:ije_u)
56  REAL :: q(ijb_u:ije_u, llm, nqtot)
57  INTEGER :: time
58
59
60  ! This routine needs IOIPSL
61  !   Variables locales
62
63  INTEGER, SAVE, ALLOCATABLE :: ndex2d(:), ndexu(:), ndexv(:)
64  INTEGER :: iq, ii, ll
65  REAL, SAVE, ALLOCATABLE :: tm(:, :)
66  REAL, SAVE, ALLOCATABLE :: vnat(:, :), unat(:, :)
67  LOGICAL :: ok_sync
68  INTEGER :: itau_w
69  INTEGER :: ijb, ije, jjn
70  LOGICAL, SAVE :: first = .TRUE.
71  !$OMP THREADPRIVATE(first)
72
73
74  !  Initialisations
75
76  IF (adjust) return
77
78  IF (first) THEN
79    !$OMP BARRIER
80    !$OMP MASTER
81    ALLOCATE(unat(ijb_u:ije_u, llm))
82    ALLOCATE(vnat(ijb_v:ije_v, llm))
83    ALLOCATE(tm(ijb_u:ije_u, llm))
84    ALLOCATE(ndex2d(ijnb_u * llm))
85    ALLOCATE(ndexu(ijnb_u * llm))
86    ALLOCATE(ndexv(ijnb_v * llm))
87    ndex2d = 0
88    ndexu = 0
89    ndexv = 0
90    !$OMP END MASTER
91    !$OMP BARRIER
92    first = .FALSE.
93  ENDIF
94
95  ok_sync = .TRUE.
96  itau_w = itau_dyn + time
97
98  ! Passage aux composantes naturelles du vent
99  CALL covnat_loc(llm, ucov, vcov, unat, vnat)
100
101
102  !  Appels a histwrite pour l'ecriture des variables a sauvegarder
103
104  !  Vents U
105  !
106
107  !$OMP BARRIER
108  !$OMP MASTER
109  ijb = ij_begin
110  ije = ij_end
111  jjn = jj_nb
112
113  CALL histwrite(histuid, 'u', itau_w, unat(ijb:ije, :), &
114          iip1 * jjn * llm, ndexu)
115  !$OMP END MASTER
116
117
118  !  Vents V
119
120  ije = ij_end
121  IF (pole_sud) jjn = jj_nb - 1
122  IF (pole_sud) ije = ij_end - iip1
123  !$OMP BARRIER
124  !$OMP MASTER
125  CALL histwrite(histvid, 'v', itau_w, vnat(ijb:ije, :), &
126          iip1 * jjn * llm, ndexv)
127  !$OMP END MASTER
128
129
130
131  !  Temperature potentielle
132
133  ijb = ij_begin
134  ije = ij_end
135  jjn = jj_nb
136  !$OMP MASTER
137  CALL histwrite(histid, 'theta', itau_w, teta(ijb:ije, :), &
138          iip1 * jjn * llm, ndexu)
139  !$OMP END MASTER
140
141
142  !  Temperature
143  !
144
145  !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
146  DO ll = 1, llm
147    DO ii = ijb, ije
148      tm(ii, ll) = teta(ii, ll) * ppk(ii, ll) / cpp
149    enddo
150  enddo
151  !$OMP ENDDO
152
153  !$OMP MASTER
154  CALL histwrite(histid, 'temp', itau_w, tm(ijb:ije, :), &
155          iip1 * jjn * llm, ndexu)
156  !$OMP END MASTER
157
158
159
160  !  Geopotentiel
161
162  !$OMP MASTER
163  CALL histwrite(histid, 'phi', itau_w, phi(ijb:ije, :), &
164          iip1 * jjn * llm, ndexu)
165  !$OMP END MASTER
166
167
168
169  !  Traceurs
170
171  !!$OMP MASTER
172  !    DO iq=1,nqtot
173  !      CALL histwrite(histid, tracers(iq)%longName, itau_w,
174  ! .                   q(ijb:ije,:,iq), iip1*jjn*llm, ndexu)
175  !    enddo
176  !!$OMP END MASTER
177
178
179
180  !  Masse
181
182  !$OMP MASTER
183  CALL histwrite(histid, 'masse', itau_w, masse(ijb:ije, :), &
184          iip1 * jjn * llm, ndexu)
185  !$OMP END MASTER
186
187
188
189  !  Pression au sol
190
191  !$OMP MASTER
192  CALL histwrite(histid, 'ps', itau_w, ps(ijb:ije), &
193          iip1 * jjn, ndex2d)
194  !$OMP END MASTER
195
196
197  !  Geopotentiel au sol
198
199  !$OMP MASTER
200  ! CALL histwrite(histid, 'phis', itau_w, phis(ijb:ije),
201  ! .                 iip1*jjn, ndex2d)
202  !$OMP END MASTER
203
204
205  !  Fin
206
207  !$OMP MASTER
208  IF (ok_sync) THEN
209    CALL histsync(histid)
210    CALL histsync(histvid)
211    CALL histsync(histuid)
212  ENDIF
213  !$OMP END MASTER
214END SUBROUTINE writehist_loc
Note: See TracBrowser for help on using the repository browser.