source: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/writedyn_xios.F90 @ 5118

Last change on this file since 5118 was 5118, checked in by abarral, 8 weeks ago

Replace iniprint.h by lmdz_iniprint.f90
(lint) along the way

File size: 3.5 KB
Line 
1! $Id$
2
3SUBROUTINE writedyn_xios(vcov, ucov, teta, ppk, phi, q, &
4        masse, ps, phis)
5
6  USE lmdz_xios
7  USE parallel_lmdz
8  USE misc_mod
9  USE infotrac, ONLY: nqtot
10  USE com_io_dyn_mod, ONLY: histaveid, histvaveid, histuaveid
11  USE comconst_mod, ONLY: cpp
12  USE temps_mod, ONLY: itau_dyn
13  USE mod_xios_dyn3dmem, ONLY: writefield_dyn_u, writefield_dyn_v
14  USE lmdz_description, ONLY: descript
15  USE lmdz_iniprint, ONLY: lunout, prt_level
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
41  !   Arguments
42
43  REAL vcov(ijb_v:ije_v, llm), ucov(ijb_u:ije_u, llm)
44  REAL teta(ijb_u:ije_u, llm), phi(ijb_u:ije_u, llm)
45  REAL ppk(ijb_u:ije_u, llm)
46  REAL ps(ijb_u:ije_u), masse(ijb_u:ije_u, llm)
47  REAL phis(ijb_u:ije_u)
48  REAL q(ijb_u:ije_u, llm, nqtot)
49  INTEGER time
50
51
52  !   Variables locales
53
54  INTEGER, SAVE, ALLOCATABLE :: ndex2d(:), ndexu(:), ndexv(:)
55  INTEGER :: iq, ii, ll
56  REAL, SAVE, ALLOCATABLE :: tm(:, :)
57  REAL, SAVE, ALLOCATABLE :: vnat(:, :), unat(:, :)
58  REAL, SAVE, ALLOCATABLE :: vbuffer(:, :)
59  LOGICAL ok_sync
60  INTEGER itau_w
61  INTEGER :: ijb, ije, jjn
62  LOGICAL, SAVE :: first = .TRUE.
63  LOGICAL, SAVE :: debuglf = .TRUE.
64  !$OMP THREADPRIVATE(debuglf)
65  !$OMP THREADPRIVATE(first)
66
67  !  Initialisations
68
69  !      WRITE(*,*)'IN WRITEDYN_XIOS'
70  IF (first) THEN
71    !$OMP BARRIER
72    !$OMP MASTER
73    ALLOCATE(unat(ijb_u:ije_u, llm))
74    ALLOCATE(vnat(ijb_v:ije_v, llm))
75    IF (pole_sud) THEN
76      ALLOCATE(vbuffer(ijb_v:ije_v + iip1, llm))
77    ELSE
78      ALLOCATE(vbuffer(ijb_v:ije_v + iip1, llm))
79    ENDIF
80    ALLOCATE(tm(ijb_u:ije_u, llm))
81    ALLOCATE(ndex2d(ijnb_u * llm))
82    ALLOCATE(ndexu(ijnb_u * llm))
83    ALLOCATE(ndexv(ijnb_v * llm))
84    unat = 0.; vnat = 0.; tm = 0. ;
85    ndex2d = 0
86    ndexu = 0
87    ndexv = 0
88    vbuffer = 0.
89    !$OMP END MASTER
90    !$OMP BARRIER
91    first = .FALSE.
92  ENDIF
93
94  ok_sync = .TRUE.
95  itau_w = itau_dyn + time
96
97  ! Passage aux composantes naturelles du vent
98  CALL covnat_loc(llm, ucov, vcov, unat, vnat)
99
100  !  Appels a histwrite pour l'ecriture des variables a sauvegarder
101
102  !  Vents U
103
104  ijb = ij_begin
105  ije = ij_end
106  jjn = jj_nb
107
108  CALL writefield_dyn_u('U', unat(ijb:ije, :))
109
110  !  Vents V
111
112  ije = ij_end
113  IF (pole_sud) THEN
114    jjn = jj_nb - 1
115    ije = ij_end - iip1
116  ENDIF
117  vbuffer(ijb:ije, :) = vnat(ijb:ije, :)
118
119  IF (pole_sud) THEN
120    CALL writefield_dyn_v('V', vbuffer(ijb:ije + iip1, :))
121  ELSE
122    CALL writefield_dyn_v('V', vbuffer(ijb:ije, :))
123  ENDIF
124
125  !  Temperature potentielle moyennee
126
127  ijb = ij_begin
128  ije = ij_end
129  jjn = jj_nb
130  CALL writefield_dyn_u('THETA', teta(ijb:ije, :))
131
132  !  Temperature moyennee
133
134  !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
135  do ll = 1, llm
136    do ii = ijb, ije
137      tm(ii, ll) = teta(ii, ll) * ppk(ii, ll) / cpp
138    enddo
139  enddo
140  !$OMP ENDDO
141  CALL writefield_dyn_u('TEMP', tm(ijb:ije, :))
142
143  !  Geopotentiel
144
145  CALL writefield_dyn_u('PHI', phi(ijb:ije, :))
146
147  ! Tracers?
148
149  !        DO iq=1,nqtot
150  !        ENDDO
151
152  !  Masse
153
154  CALL writefield_dyn_u('MASSE', masse(ijb:ije, :))
155
156  !  Pression au sol
157
158  CALL writefield_dyn_u('PS', ps(ijb:ije))
159
160END
Note: See TracBrowser for help on using the repository browser.