source: LMDZ6/trunk/libf/dyn3dmem/writedyn_xios.F90

Last change on this file was 4619, checked in by yann meurdesoif, 11 months ago

Suppress usage of preprocessing key CPP_XIOS.
Wrapper file is used to suppress XIOS symbol when xios is not linked and not used (-io ioipsl)
The CPP_XIOS key is replaced in model by "using_xios" boolean variable to switch between IOIPSL or XIOS output.

YM

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