1 | !> \file out_horiz_mod.f90 |
---|
2 | !! Module avec les routines d'ecriture et de lecture de fichiers horizontaux |
---|
3 | !< |
---|
4 | |
---|
5 | !> \namespace out_hz |
---|
6 | !! This module gathers routines to read and write horizontal files |
---|
7 | !! \author ... |
---|
8 | !! \date ... |
---|
9 | !! @note Used module |
---|
10 | !! @note - use geography |
---|
11 | !! @note - use runparam |
---|
12 | !< |
---|
13 | |
---|
14 | module out_hz |
---|
15 | |
---|
16 | use geography ! permet d'avoir nx et ny et geoplace |
---|
17 | use runparam ! permet d'avoir tbegin,tend,runname,dirout |
---|
18 | |
---|
19 | implicit none |
---|
20 | |
---|
21 | integer, parameter :: ncol=50 !< nombre maxi de colonnes de sortie |
---|
22 | integer,parameter :: nvar=100 !< nombre maxi de variables dans LISTE-VAR-HZ.dat |
---|
23 | integer :: ndtsortie !< nombre de dtsortie |
---|
24 | integer :: npredeft !< nombre de temps de sortie predefinis |
---|
25 | integer :: iglob_hz=0 |
---|
26 | integer :: ivar !< index representant le numer d'une variable dans LISTE-VAR-HZ.dat |
---|
27 | integer :: npos=0 !< position dans xxx, initialise a 0 |
---|
28 | |
---|
29 | |
---|
30 | ! tableaux dont l'indice est npos (position en numero de colonne) |
---|
31 | |
---|
32 | real,dimension(nx,ny,ncol) :: xxx !< tableau qui va contenir les variables à sortir |
---|
33 | integer,dimension(ncol) :: varnumber !< numero de la variable en position npos |
---|
34 | character(len=8),dimension(ncol) :: formatcol !< le format de sortie pour une colonne |
---|
35 | character(len=6),dimension(ncol) :: colname !< le nom de la variable pour une colonne |
---|
36 | |
---|
37 | |
---|
38 | ! Pour chaque variable (definies dans LISTE-VAR-HZ.dat) |
---|
39 | ! tableaux "caracteristiques de sortie" attachées a la variable |
---|
40 | ! indice dans ces tableaux : ivar=varnumber(npos) |
---|
41 | |
---|
42 | integer,dimension(nvar) :: isortie=0 !< si isortie=0, pas de sortie du tout. |
---|
43 | integer,dimension(nvar) :: isort_time !< 1 si sortie au temps time |
---|
44 | integer,dimension(nvar) :: interv !< entier qui code quel dtsortie utiliser |
---|
45 | real,dimension(nvar) :: dtsortvar !< pas de temps de sortie de chaque variable |
---|
46 | |
---|
47 | real,dimension(nvar) :: coefsortvar !< coefficient multiplicateur des sorties |
---|
48 | real,dimension(nvar) :: minvar !< valeur minimu de la variable !pour éviter des *** |
---|
49 | real,dimension(nvar) :: maxvar !< valeur maximum de la variable ! dans le format f |
---|
50 | character(len=6),dimension(nvar) :: varname !< le nom de la variable |
---|
51 | character(len=8),dimension(nvar) :: formatvar !< le format de sortie |
---|
52 | |
---|
53 | |
---|
54 | |
---|
55 | double precision, dimension(:),allocatable :: dtsortie_hz !< tableau des dtsortie : dimension (ndtsortie) |
---|
56 | real,dimension(:),allocatable :: predef_tsort !< tableau des temps predefinis pour sorties : |
---|
57 | !< dimension (npredft) |
---|
58 | |
---|
59 | |
---|
60 | |
---|
61 | character(len=10) :: comment |
---|
62 | character (len=6) :: varchar |
---|
63 | |
---|
64 | |
---|
65 | contains |
---|
66 | |
---|
67 | !__________________________________________________________________________ |
---|
68 | !> SUBROUTINE: init_out_hz |
---|
69 | !! Initialise les tableaux pour les sorties horizontaux |
---|
70 | !> |
---|
71 | subroutine init_out_hz |
---|
72 | |
---|
73 | implicit none |
---|
74 | integer :: err !< recuperation d'erreur |
---|
75 | integer :: ivar |
---|
76 | integer :: i2 |
---|
77 | integer :: i3 |
---|
78 | integer :: i,j,k !< indices de travail |
---|
79 | |
---|
80 | integer :: num_dat = 21 |
---|
81 | |
---|
82 | ! initialise les tableaux |
---|
83 | !---------------------------- |
---|
84 | ! dtsortie_hz, predef_tsort |
---|
85 | ! isortie,interv,dtsortvar,coefsortvar,varname,formatvar |
---|
86 | |
---|
87 | ! lecture des pas de temps de sortie |
---|
88 | !------------------------------------ |
---|
89 | ! open(num_dat,file='../'//trim(dirsource)//'/Fichiers-parametres/TEMPS-HZ.dat') |
---|
90 | open(num_dat,file=trim(dirsource)//'/Fichiers-parametres/TEMPS-HZ.dat') |
---|
91 | |
---|
92 | ! passe les commentaires qui se terminent par une ligne de ~~~ |
---|
93 | comment1: do k=1,500 |
---|
94 | read(num_dat,'(a10)') comment |
---|
95 | |
---|
96 | if (comment.eq.'~~~~~~~~~~') exit comment1 |
---|
97 | end do comment1 |
---|
98 | |
---|
99 | |
---|
100 | ! lecture frequences de sortie |
---|
101 | read(num_dat,*) ndtsortie |
---|
102 | |
---|
103 | if (.not.allocated(dtsortie_hz)) THEN |
---|
104 | allocate(dtsortie_hz(ndtsortie),stat=err) |
---|
105 | if (err/=0) then |
---|
106 | print *,"Erreur à l'allocation du tableau dtsortie_hz ",err |
---|
107 | stop 4 |
---|
108 | end if |
---|
109 | end if |
---|
110 | |
---|
111 | do k=1,ndtsortie |
---|
112 | read(num_dat,*) dtsortie_hz(k) |
---|
113 | end do |
---|
114 | |
---|
115 | read(num_dat,*) ! saute une ligne |
---|
116 | |
---|
117 | ! lecture pas de temps predefinis |
---|
118 | read(num_dat,*) npredeft |
---|
119 | |
---|
120 | |
---|
121 | if (.not.allocated(predef_tsort)) THEN |
---|
122 | allocate(predef_tsort(npredeft),stat=err) |
---|
123 | if (err/=0) then |
---|
124 | print *,"Erreur à l'allocation du tableau dt-out_hz ",err |
---|
125 | stop 4 |
---|
126 | end if |
---|
127 | end if |
---|
128 | |
---|
129 | do k=1,npredeft |
---|
130 | read(num_dat,*) predef_tsort(k) |
---|
131 | end do |
---|
132 | close(num_dat) |
---|
133 | |
---|
134 | ! Lecture des variables et de leur frequence de sortie |
---|
135 | !----------------------------------------------------------- |
---|
136 | |
---|
137 | ! open(num_dat,file='../'//trim(dirsource)//'/Fichiers-parametres/LISTE-VAR-HZ.dat') |
---|
138 | open(num_dat,file=trim(dirsource)//'/Fichiers-parametres/LISTE-VAR-HZ.dat') |
---|
139 | |
---|
140 | !saute les commentaires |
---|
141 | comment2: do k=1,500 |
---|
142 | read(num_dat,'(a10)') comment |
---|
143 | if (comment.eq.'~~~~~~~~~~') exit comment2 |
---|
144 | end do comment2 |
---|
145 | |
---|
146 | |
---|
147 | do k=1,100 |
---|
148 | read(num_dat,'(a6)',end=500,err=500) varchar |
---|
149 | read(num_dat,*,end=500,err=500) ivar,i2,i3 |
---|
150 | |
---|
151 | varname(ivar)=' '//varchar |
---|
152 | isortie(ivar)=i2 |
---|
153 | interv(ivar)=i3 |
---|
154 | |
---|
155 | if ((i3.gt.0).and.(i3.le.ndtsortie)) then |
---|
156 | dtsortvar(ivar)=dtsortie_hz(i3) |
---|
157 | else |
---|
158 | dtsortvar(ivar)=1.e10 |
---|
159 | endif |
---|
160 | |
---|
161 | read(num_dat,'(a8)',end=500,err=500) formatvar(ivar) |
---|
162 | ! call minmax_format(minvar(ivar),maxvar(ivar),formatvar(ivar)) |
---|
163 | |
---|
164 | read(num_dat,*,end=500,err=500) coefsortvar(ivar) |
---|
165 | ! print*,'k=',k,ivar,varname(ivar),interv(ivar),dtsortvar(ivar),formatvar(ivar),coefsortvar(ivar) |
---|
166 | read(num_dat,*,end=500,err=500) |
---|
167 | end do |
---|
168 | |
---|
169 | goto 510 |
---|
170 | 500 continue |
---|
171 | ! write(6,*) 'nombre de variables dans liste_var',k |
---|
172 | 510 continue |
---|
173 | |
---|
174 | |
---|
175 | close (num_dat) |
---|
176 | return |
---|
177 | end subroutine init_out_hz |
---|
178 | |
---|
179 | !> SUBROUTINE: testsort_time |
---|
180 | !! Teste variable par variable si la sortie hz est faite à ce temps là |
---|
181 | !! \param tsortie temps de sortie |
---|
182 | !> |
---|
183 | |
---|
184 | subroutine testsort_time(tsortie) |
---|
185 | |
---|
186 | implicit none |
---|
187 | double precision :: dbltime |
---|
188 | real :: tsortie |
---|
189 | real :: difftime !< difference tsortie-predef_tsort(npr) |
---|
190 | real :: debtime !< difference abs(tsortie-tbegin) |
---|
191 | real :: fintime !< difference abs(tsortie-tend) |
---|
192 | integer :: ipredef |
---|
193 | integer :: ideb |
---|
194 | integer :: ifin |
---|
195 | integer :: npr |
---|
196 | integer :: i,j,k ! indices de travail |
---|
197 | |
---|
198 | |
---|
199 | ! |
---|
200 | ! exemple. si dt_out_hz=(1000,5000,10000) |
---|
201 | ! interv=2 la sortie se fera tous les 5000 ans |
---|
202 | ! interv=0 la sortie se fera seulement sur les pas de temps predefinis |
---|
203 | ! interv=-1 la sortie ne se fait qu'aux premier pas de temps |
---|
204 | ! interv=-2 la sortie ne se fait qu'au premier et au dernier pas de temps |
---|
205 | |
---|
206 | |
---|
207 | isort_time(:)=0 |
---|
208 | dbltime=dble(tsortie) |
---|
209 | ! recherche si ce pas de temps est un pas de temps predefini |
---|
210 | ipredef=0 |
---|
211 | ideb=0 |
---|
212 | ifin=0 |
---|
213 | |
---|
214 | |
---|
215 | predef: do npr=1,npredeft |
---|
216 | difftime=abs(tsortie-predef_tsort(npr)) |
---|
217 | if (difftime.lt.dttest) then |
---|
218 | ipredef=1 |
---|
219 | exit predef |
---|
220 | end if |
---|
221 | debtime=abs(tsortie-tbegin) |
---|
222 | fintime=abs(tsortie-tend) |
---|
223 | |
---|
224 | if ((debtime.lt.dttest).or.(nt.eq.1)) ideb=1 |
---|
225 | if (fintime.lt.dttest) ifin=1 |
---|
226 | |
---|
227 | end do predef |
---|
228 | |
---|
229 | ! boucle sur les numeros de variables |
---|
230 | boucle_var: do i=1,nvar |
---|
231 | |
---|
232 | if (isortie(i).eq.0) then ! variables non attribuees et |
---|
233 | ! variables ou isortie est explicitement 0 |
---|
234 | isort_time(i)=0 |
---|
235 | |
---|
236 | else ! variables dont on veut la sortie |
---|
237 | |
---|
238 | if ((interv(i).ge.0).and.(ipredef.eq.1)) then ! pas de temps predefini |
---|
239 | isort_time(i)=1 |
---|
240 | |
---|
241 | else if ((interv(i).le.-1).and.(ideb.eq.1)) then ! sortie a Tbegin |
---|
242 | isort_time(i)=1 |
---|
243 | |
---|
244 | else if ((interv(i).eq.-2).and.(ifin.eq.1)) then ! sortie a Tend |
---|
245 | isort_time(i)=1 |
---|
246 | |
---|
247 | else if (mod(abs(dbltime),dtsortvar(i)).lt.dble(dttest)) then |
---|
248 | isort_time(i)=1 |
---|
249 | |
---|
250 | ! le test est en dble car quand le temps est tres |
---|
251 | ! grand, on peut avoir des problemes d'arrondi |
---|
252 | endif |
---|
253 | |
---|
254 | endif |
---|
255 | |
---|
256 | end do boucle_var |
---|
257 | |
---|
258 | ! initialise npos et iglob_hz |
---|
259 | npos=0 |
---|
260 | iglob_hz=maxval(isort_time) |
---|
261 | |
---|
262 | return |
---|
263 | |
---|
264 | end subroutine testsort_time |
---|
265 | !-------------------------------------------------------------------------- |
---|
266 | !> SUBROUTINE: rempli_xxx |
---|
267 | !! Rempli la colonne npos des tableaux xxx,varnumber,formatcol,colname |
---|
268 | !! \param numvar Le numero de la variable |
---|
269 | !! \param Var Nom de variable Var dans la liste LISTE-VAR-HZ.dat |
---|
270 | !> |
---|
271 | subroutine rempli_xxx(numvar,Var) |
---|
272 | ! rempli la colonne npos des tableaux xxx,varnumber,formatcol,colname |
---|
273 | ! numvar est le numero de la variable Var dans LISTE-VAR-HZ.dat |
---|
274 | ! |
---|
275 | |
---|
276 | implicit none |
---|
277 | |
---|
278 | integer :: numvar |
---|
279 | real,dimension(nx,ny) :: var |
---|
280 | real :: mincol |
---|
281 | real :: maxcol |
---|
282 | real :: coef |
---|
283 | integer :: i,j,k ! indices de travail |
---|
284 | |
---|
285 | npos=npos+1 |
---|
286 | coef=coefsortvar(numvar) ! coefficient multiplicateur |
---|
287 | mincol=minvar(numvar) |
---|
288 | maxcol=maxvar(numvar) |
---|
289 | varnumber(npos)=numvar |
---|
290 | formatcol(npos)=formatvar(numvar) |
---|
291 | colname(npos)=varname(numvar) |
---|
292 | |
---|
293 | |
---|
294 | xxx(:,:,npos)=var(:,:)*coef |
---|
295 | |
---|
296 | ! applique les minmax |
---|
297 | !do j=1,ny |
---|
298 | ! do i=1,nx |
---|
299 | ! xxx(i,j,npos)=min(xxx(i,j,npos),maxcol) |
---|
300 | ! xxx(i,j,npos)=max(xxx(i,j,npos),mincol) |
---|
301 | ! end do |
---|
302 | !end do |
---|
303 | |
---|
304 | return |
---|
305 | end subroutine rempli_xxx |
---|
306 | !--------------------------------------------------------------------------- |
---|
307 | !> SUBROUTINE: hz_output() |
---|
308 | !! Remplace plotoutput. Ecrit le tableau xxx dans un fichier avec le nom runname//snapname//.hz |
---|
309 | !! \param tsortie temps de sortie |
---|
310 | !> |
---|
311 | |
---|
312 | subroutine hz_output(tsortie) |
---|
313 | |
---|
314 | implicit none |
---|
315 | real tsortie |
---|
316 | |
---|
317 | character(len=1000) :: filout |
---|
318 | character(len=4) :: sep !< pour le format de sortie |
---|
319 | character(len=1) :: fin !< pour le format de sortie |
---|
320 | character(len=1) :: deb !< pour le format de sortie |
---|
321 | character(len=1000) :: fmtxxx !< pour le format de sortie xxx |
---|
322 | character(len=1000) :: fmtcolname !< pour le format colname |
---|
323 | character(len=1000) :: fmtvarnumber !< pour le format varnumber |
---|
324 | character(len=3) :: charncol |
---|
325 | character(len=30) :: snapname |
---|
326 | integer :: i,j,k ! indices de travail |
---|
327 | integer :: num_forc = 20 |
---|
328 | |
---|
329 | !write(6,*) 'hz_output time=', tsortie,'npos=',npos |
---|
330 | |
---|
331 | if (npos.eq.0) goto 900 |
---|
332 | |
---|
333 | ! nom du fichier |
---|
334 | call snaptime(tsortie,snapname) |
---|
335 | filout =trim(runname)//trim(snapname)//'.hz' |
---|
336 | filout = TRIM(DIRNAMEOUT)//TRIM(filout) |
---|
337 | |
---|
338 | !write(6,*) 'sortie hz pour time=',tsortie,'nb colonnes=',npos |
---|
339 | |
---|
340 | open(num_forc,file=filout) |
---|
341 | |
---|
342 | ! ecriture de la ligne format pour xxx |
---|
343 | sep=',1x,' |
---|
344 | deb='(' |
---|
345 | fin=')' |
---|
346 | fmtxxx=deb |
---|
347 | |
---|
348 | do k=1,npos-1 |
---|
349 | fmtxxx=trim(fmtxxx)//trim(formatcol(k))//sep |
---|
350 | end do |
---|
351 | |
---|
352 | fmtxxx=trim(fmtxxx)//trim(formatcol(npos))//fin |
---|
353 | |
---|
354 | ! met npos dans un character pour faire le format |
---|
355 | |
---|
356 | write(charncol,fmt='(i3)') npos |
---|
357 | charncol=adjustl( charncol) ! justifie a gauche |
---|
358 | |
---|
359 | ! format pour varname |
---|
360 | fmtcolname=deb//trim(charncol)//deb//'a6'//',1x),1x'//fin |
---|
361 | |
---|
362 | ! format pour varnumber |
---|
363 | fmtvarnumber=deb//trim(charncol)//deb//'i3'//',1x),1x'//fin |
---|
364 | |
---|
365 | |
---|
366 | ! ecriture dans le fichier sortie |
---|
367 | write(num_forc,*) tsortie, geoplace, ' time, geoplace' |
---|
368 | write(num_forc,'(10(i0,1x),a46)') nx*ny,npos,nx,ny,nint(dx/1000.),nint(seasea),xmin,xmax,ymin,ymax,& |
---|
369 | 'nx*ny,ncol,nx,ny,dx,sealev,xmin,xmax,ymin,ymax' |
---|
370 | write(num_forc,fmt=trim(fmtvarnumber)) (varnumber(k),k=1,npos) |
---|
371 | write(num_forc,fmt=trim(fmtcolname)) (colname(k),k=1,npos) |
---|
372 | |
---|
373 | do j=1,ny |
---|
374 | do i=1,nx |
---|
375 | write(num_forc,fmt=trim(fmtxxx)) (xxx(i,j,k),k=1,npos) |
---|
376 | end do |
---|
377 | end do |
---|
378 | close(num_forc) |
---|
379 | |
---|
380 | 900 continue |
---|
381 | return |
---|
382 | |
---|
383 | end subroutine hz_output |
---|
384 | |
---|
385 | |
---|
386 | !-------------------------------------------------------------------------- |
---|
387 | |
---|
388 | |
---|
389 | end module out_hz |
---|
390 | |
---|