source: LMDZ6/trunk/libf/dyn3dmem/writedyn_xios.f90 @ 5279

Last change on this file since 5279 was 5272, checked in by abarral, 31 hours ago

Turn paramet.h into a module

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