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

Last change on this file since 5423 was 5285, checked in by abarral, 2 months ago

As discussed internally, remove generic ONLY: ... for new _mod_h modules

File size: 3.7 KB
RevLine 
[4146]1
2! $Id$
3!
4      SUBROUTINE writedyn_xios( vcov, ucov,teta,ppk,phi,q, &
5     &                           masse,ps,phis)
6
[5282]7      USE iniprint_mod_h
[5281]8      USE comgeom_mod_h
[4619]9      USE lmdz_xios
[4146]10      USE parallel_lmdz
11      USE misc_mod
12      USE infotrac, ONLY : nqtot
13      use com_io_dyn_mod, only : histaveid,histvaveid,histuaveid
14      USE comconst_mod, ONLY: cpp
15      USE temps_mod, ONLY: itau_dyn
16      USE mod_xios_dyn3dmem, ONLY : writefield_dyn_u, writefield_dyn_v
[5281]17
[5271]18      USE dimensions_mod, ONLY: iim, jjm, llm, ndm
[5285]19USE paramet_mod_h
[5271]20implicit none
[4146]21!
22!   Ecriture du fichier histoire au format xios
23!
24!
25!   Entree:
26!      vcov: vents v covariants
27!      ucov: vents u covariants
28!      teta: temperature potentielle
29!      phi : geopotentiel instantane
30!      q   : traceurs
31!      masse: masse
32!      ps   :pression au sol
33!      phis : geopotentiel au sol
[5271]34!
[4146]35!   L. Fairhead, LMD, 03/21
36!
37! =====================================================================
38!
39!   Declarations
[5271]40
[5272]41
[5282]42      !
[4146]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.