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

Last change on this file since 5409 was 5195, checked in by abarral, 3 months ago

Correct r5192, some lmdz_description cases were missing

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