source: LMDZ6/branches/Ocean_skin/libf/dyn3dmem/writedyn_xios.F90 @ 5086

Last change on this file since 5086 was 4368, checked in by lguez, 2 years ago

Sync latest trunk changes to Ocean_skin

File size: 3.8 KB
Line 
1
2! $Id$
3!
4      SUBROUTINE writedyn_xios( vcov, ucov,teta,ppk,phi,q, &
5     &                           masse,ps,phis)
6
7#ifdef CPP_XIOS
8      USE xios
9      USE parallel_lmdz
10      USE misc_mod
11      USE infotrac, ONLY : nqtot
12      use com_io_dyn_mod, only : histaveid,histvaveid,histuaveid
13      USE comconst_mod, ONLY: cpp
14      USE temps_mod, ONLY: itau_dyn
15      USE mod_xios_dyn3dmem, ONLY : writefield_dyn_u, writefield_dyn_v
16     
17      implicit none
18!
19!   Ecriture du fichier histoire au format xios
20!
21!
22!   Entree:
23!      vcov: vents v covariants
24!      ucov: vents u covariants
25!      teta: temperature potentielle
26!      phi : geopotentiel instantane
27!      q   : traceurs
28!      masse: masse
29!      ps   :pression au sol
30!      phis : geopotentiel au sol
31!     
32!   L. Fairhead, LMD, 03/21
33!
34! =====================================================================
35!
36!   Declarations
37      include "dimensions.h"
38      include "paramet.h"
39      include "comgeom.h"
40      include "description.h"
41      include "iniprint.h"
42
43!
44!   Arguments
45!
46
47      REAL vcov(ijb_v:ije_v,llm),ucov(ijb_u:ije_u,llm)
48      REAL teta(ijb_u:ije_u,llm),phi(ijb_u:ije_u,llm)
49      REAL ppk(ijb_u:ije_u,llm)                 
50      REAL ps(ijb_u:ije_u),masse(ijb_u:ije_u,llm)                   
51      REAL phis(ijb_u:ije_u)                 
52      REAL q(ijb_u:ije_u,llm,nqtot)
53      integer time
54
55
56!   Variables locales
57!
58      INTEGER,SAVE,ALLOCATABLE :: ndex2d(:),ndexu(:),ndexv(:)
59      INTEGER :: iq, ii, ll
60      REAL,SAVE,ALLOCATABLE :: tm(:,:)
61      REAL,SAVE,ALLOCATABLE :: vnat(:,:),unat(:,:)
62      REAL,SAVE,ALLOCATABLE :: vbuffer(:,:)
63      logical ok_sync
64      integer itau_w
65      integer :: ijb,ije,jjn
66      LOGICAL,SAVE :: first=.TRUE.
67      LOGICAL,SAVE :: debuglf=.true.
68!$OMP THREADPRIVATE(debuglf)
69!$OMP THREADPRIVATE(first)
70
71!
72!  Initialisations
73!
74
75!      WRITE(*,*)'IN WRITEDYN_XIOS'
76      IF (first) THEN
77!$OMP BARRIER
78!$OMP MASTER
79        ALLOCATE(unat(ijb_u:ije_u,llm))
80        ALLOCATE(vnat(ijb_v:ije_v,llm))
81        IF (pole_sud) THEN
82           ALLOCATE(vbuffer(ijb_v:ije_v+iip1,llm))
83        ELSE
84           ALLOCATE(vbuffer(ijb_v:ije_v+iip1,llm))
85        ENDIF
86        ALLOCATE(tm(ijb_u:ije_u,llm))
87        ALLOCATE(ndex2d(ijnb_u*llm))
88        ALLOCATE(ndexu(ijnb_u*llm))
89        ALLOCATE(ndexv(ijnb_v*llm))
90        unat = 0.; vnat = 0.; tm = 0. ;
91        ndex2d = 0
92        ndexu = 0
93        ndexv = 0
94        vbuffer=0.
95!$OMP END MASTER
96!$OMP BARRIER
97        first=.FALSE.
98      ENDIF
99     
100      ok_sync = .TRUE.
101      itau_w = itau_dyn + time
102
103! Passage aux composantes naturelles du vent
104      call covnat_loc(llm, ucov, vcov, unat, vnat)
105
106!
107!  Appels a histwrite pour l'ecriture des variables a sauvegarder
108!
109!  Vents U
110!
111      ijb=ij_begin
112      ije=ij_end
113      jjn=jj_nb
114     
115      CALL writefield_dyn_u('U', unat(ijb:ije,:))
116
117!
118!  Vents V
119!
120      ije=ij_end
121      IF (pole_sud) THEN
122         jjn=jj_nb-1
123         ije=ij_end-iip1
124      ENDIF
125      vbuffer(ijb:ije,:)=vnat(ijb:ije,:)
126
127
128      IF (pole_sud) THEN
129         CALL writefield_dyn_v('V', vbuffer(ijb:ije+iip1,:))
130      ELSE
131         CALL writefield_dyn_v('V', vbuffer(ijb:ije,:))
132      ENDIF
133     
134
135     
136!
137!  Temperature potentielle moyennee
138!
139      ijb=ij_begin
140      ije=ij_end
141      jjn=jj_nb
142     CALL writefield_dyn_u('THETA', teta(ijb:ije,:))
143
144!
145!  Temperature moyennee
146!
147
148!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)       
149      do ll=1,llm
150        do ii = ijb, ije
151          tm(ii,ll) = teta(ii,ll) * ppk(ii,ll)/cpp
152        enddo
153      enddo
154!$OMP ENDDO
155      CALL writefield_dyn_u('TEMP', tm(ijb:ije,:))
156
157
158!
159!  Geopotentiel
160!
161      CALL writefield_dyn_u('PHI', phi(ijb:ije,:))
162
163
164!
165! Tracers?
166!
167!        DO iq=1,nqtot
168!        ENDDO
169
170
171!
172!  Masse
173!
174      CALL writefield_dyn_u('MASSE', masse(ijb:ije,:))
175
176
177!
178!  Pression au sol
179!
180      CALL writefield_dyn_u('PS', ps(ijb:ije))
181
182#endif
183
184      END
Note: See TracBrowser for help on using the repository browser.