source: LMDZ5/trunk/libf/dyn3dmem/writehist_loc.F @ 1632

Last change on this file since 1632 was 1632, checked in by Laurent Fairhead, 12 years ago

Import initial du répertoire dyn3dmem

Attention! ceci n'est qu'une version préliminaire du code "basse mémoire":
le code contenu dans ce répertoire est basé sur la r1320 et a donc besoin
d'être mis à jour par rapport à la dynamique parallèle d'aujourd'hui.
Ce code est toutefois mis à disposition pour circonvenir à des problèmes
de mémoire que certaines configurations du modèle pourraient rencontrer.
Dans l'état, il compile et tourne sur vargas et au CCRT


Initial import of dyn3dmem

Warning! this is just a preliminary version of the memory light code:
it is based on r1320 of the code and thus needs to be updated before
it can replace the present dyn3dpar code. It is nevertheless put at your
disposal to circumvent some memory problems some LMDZ configurations may
encounter. In its present state, it will compile and run on vargas and CCRT

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
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.