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

Last change on this file since 5172 was 5159, checked in by abarral, 5 months ago

Put dimensions.h and paramet.h into modules

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