source: LMDZ5/branches/IPSLCM5A2.1/libf/dyn3dmem/writedynav_loc.F @ 2866

Last change on this file since 2866 was 2603, checked in by Ehouarn Millour, 8 years ago

Cleanup in the dynamics: turn logic.h into module logic_mod.F90
EM

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