source: LMDZ5/branches/testing/libf/dyn3dmem/writehist_loc.F @ 2435

Last change on this file since 2435 was 1910, checked in by Laurent Fairhead, 11 years ago

Merged trunk changes r1860:1909 into testing branch

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