source: LMDZ6/branches/DYNAMICO-conv/libf/dyn3dmem/writedynav_loc.F @ 4669

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

Some code tidying: turn ener.h into ener_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 "description.h"
50      include "iniprint.h"
51
52C
53C   Arguments
54C
55
56      REAL vcov(ijb_v:ije_v,llm),ucov(ijb_u:ije_u,llm)
57      REAL teta(ijb_u:ije_u,llm),phi(ijb_u:ije_u,llm)
58      REAL ppk(ijb_u:ije_u,llm)                 
59      REAL ps(ijb_u:ije_u),masse(ijb_u:ije_u,llm)                   
60      REAL phis(ijb_u:ije_u)                 
61      REAL q(ijb_u:ije_u,llm,nqtot)
62      integer time
63
64
65#ifdef CPP_IOIPSL
66! This routine needs IOIPSL
67C   Variables locales
68C
69      INTEGER,SAVE,ALLOCATABLE :: ndex2d(:),ndexu(:),ndexv(:)
70      INTEGER :: iq, ii, ll
71      REAL,SAVE,ALLOCATABLE :: tm(:,:)
72      REAL,SAVE,ALLOCATABLE :: vnat(:,:),unat(:,:)
73      logical ok_sync
74      integer itau_w
75      integer :: ijb,ije,jjn
76      LOGICAL,SAVE :: first=.TRUE.
77!$OMP THREADPRIVATE(first)
78
79C
80C  Initialisations
81C
82      if (adjust) return
83     
84      IF (first) THEN
85!$OMP BARRIER
86!$OMP MASTER
87        ALLOCATE(unat(ijb_u:ije_u,llm))
88        ALLOCATE(vnat(ijb_v:ije_v,llm))
89        ALLOCATE(tm(ijb_u:ije_u,llm))
90        ALLOCATE(ndex2d(ijnb_u*llm))
91        ALLOCATE(ndexu(ijnb_u*llm))
92        ALLOCATE(ndexv(ijnb_v*llm))
93        ndex2d = 0
94        ndexu = 0
95        ndexv = 0
96!$OMP END MASTER
97!$OMP BARRIER
98        first=.FALSE.
99      ENDIF
100     
101      ok_sync = .TRUE.
102      itau_w = itau_dyn + time
103
104C Passage aux composantes naturelles du vent
105      call covnat_loc(llm, ucov, vcov, unat, vnat)
106
107C
108C  Appels a histwrite pour l'ecriture des variables a sauvegarder
109C
110C  Vents U
111C
112
113!$OMP BARRIER     
114!$OMP MASTER
115      ijb=ij_begin
116      ije=ij_end
117      jjn=jj_nb
118     
119      call histwrite(histuaveid, 'u', itau_w, unat(ijb:ije,:),
120     .               iip1*jjn*llm, ndexu)
121!$OMP END MASTER     
122
123C
124C  Vents V
125C
126      ije=ij_end
127      if (pole_sud) jjn=jj_nb-1
128      if (pole_sud) ije=ij_end-iip1
129!$OMP BARRIER
130!$OMP MASTER     
131      call histwrite(histvaveid, 'v', itau_w, vnat(ijb:ije,:),
132     .               iip1*jjn*llm, ndexv)
133!$OMP END MASTER     
134
135
136C
137C  Temperature potentielle moyennee
138C
139      ijb=ij_begin
140      ije=ij_end
141      jjn=jj_nb
142!$OMP MASTER     
143      call histwrite(histaveid, 'theta', itau_w, teta(ijb:ije,:),
144     .                iip1*jjn*llm, ndexu)
145!$OMP END MASTER     
146
147C
148C  Temperature moyennee
149C
150
151!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)       
152      do ll=1,llm
153        do ii = ijb, ije
154          tm(ii,ll) = teta(ii,ll) * ppk(ii,ll)/cpp
155        enddo
156      enddo
157!$OMP ENDDO
158
159!$OMP MASTER     
160      call histwrite(histaveid, 'temp', itau_w, tm(ijb:ije,:),
161     .                iip1*jjn*llm, ndexu)
162!$OMP END MASTER
163
164
165C
166C  Geopotentiel
167C
168!$OMP MASTER     
169      call histwrite(histaveid, 'phi', itau_w, phi(ijb:ije,:),
170     .                iip1*jjn*llm, ndexu)
171!$OMP END MASTER
172
173
174C
175C  Traceurs
176C
177!!$OMP MASTER     
178!        DO iq=1,nqtot
179!          call histwrite(histaveid, ttext(iq), itau_w, q(ijb:ije,:,iq),
180!     .                   iip1*jjn*llm, ndexu)
181!        enddo
182!!$OMP END MASTER
183
184
185C
186C  Masse
187C
188!$OMP MASTER     
189       call histwrite(histaveid, 'masse', itau_w, masse(ijb:ije,:),
190     .                iip1*jjn*llm, ndexu)
191!$OMP END MASTER
192
193
194C
195C  Pression au sol
196C
197!$OMP MASTER     
198
199       call histwrite(histaveid, 'ps', itau_w, ps(ijb:ije),
200     .                 iip1*jjn, ndex2d)
201!$OMP END MASTER
202
203C
204C  Geopotentiel au sol
205C
206!$OMP MASTER     
207!       call histwrite(histaveid, 'phis', itau_w, phis(ijb:ije),
208!     .                 iip1*jjn, ndex2d)
209!$OMP END MASTER
210
211C
212C  Fin
213C
214!$OMP MASTER     
215      if (ok_sync) then
216          call histsync(histaveid)
217          call histsync(histvaveid)
218          call histsync(histuaveid)
219      ENDIF
220!$OMP END MASTER
221#else
222      write(lunout,*)'writedynav_loc: Needs IOIPSL to function'
223#endif
224! #endif of #ifdef CPP_IOIPSL
225      end
Note: See TracBrowser for help on using the repository browser.