restart.f90
Go to the documentation of this file.
1!#############################################################################
2!# #
3!# fosite - 3D hydrodynamical simulation program #
4!# module: restart.f90 #
5!# #
6!# Copyright (C) 2015-2019 #
7!# Manuel Jung <mjung@astrophysik.uni-kiel.de> #
8!# Jannes Klee <jklee@astrophysik.uni-kiel.de> #
9!# #
10!# This program is free software; you can redistribute it and/or modify #
11!# it under the terms of the GNU General Public License as published by #
12!# the Free Software Foundation; either version 2 of the License, or (at #
13!# your option) any later version. #
14!# #
15!# This program is distributed in the hope that it will be useful, but #
16!# WITHOUT ANY WARRANTY; without even the implied warranty of #
17!# MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE, GOOD TITLE or #
18!# NON INFRINGEMENT. See the GNU General Public License for more #
19!# details. #
20!# #
21!# You should have received a copy of the GNU General Public License #
22!# along with this program; if not, write to the Free Software #
23!# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. #
24!# #
25!#############################################################################
26
27!----------------------------------------------------------------------------!
48!----------------------------------------------------------------------------!
49PROGRAM restart
50 USE fosite_mod
51#ifdef PARALLEL
52#ifdef HAVE_MPI_MOD
53 USE mpi
54#endif
55#endif
56 IMPLICIT NONE
57#ifdef PARALLEL
58#ifdef HAVE_MPIF_H
59 include 'mpif.h'
60#endif
61#endif
62#ifdef PARALLEL
63#define OFFSET_TYPE INTEGER(KIND=MPI_OFFSET_KIND)
64#else
65#define OFFSET_TYPE INTEGER
66#endif
67 !--------------------------------------------------------------------------!
68 CLASS(fosite), ALLOCATABLE :: sim
69 TYPE(dict_typ), POINTER :: input
70 REAL :: time,stoptime
71 INTEGER :: i, step
72 CHARACTER(LEN=100) :: filename, filename_tmp
73#ifdef PARALLEL
74 INTEGER, DIMENSION(3) :: decomposition
75#endif
76 LOGICAL :: file_exists
77 REAL :: hratio = 0.05
78 REAL, DIMENSION(:,:,:), POINTER :: r, sigma
79 REAL, DIMENSION(:,:,:,:), POINTER :: r_faces
80 REAL, DIMENSION(:,:,:), POINTER :: bccsound
81 REAL, DIMENSION(:,:,:,:), POINTER :: fcsound
82 REAL, PARAMETER :: mbh1 = 0.4465*1.0
83 REAL, PARAMETER :: mbh2 = 0.4465*1.0
84 INTEGER :: count
85 !--------------------------------------------------------------------------!
86
87 ! load file
88 CALL get_command_argument(1, filename)
89 INQUIRE(file=trim(filename), exist=file_exists)
90 IF(.NOT.file_exists) THEN
91 print *, "restart, ", "Input file does not exist!"
92 stop
93 END IF
94
95 ALLOCATE(sim)
96
97 CALL sim%InitFosite()
98
99 !-------------------- load configuration-----------------------------------!
100 input => loadconfig(trim(filename))
101 CALL getattr(input, "config", sim%config)
102
103 ! set starting time in fosite
104 CALL getattr(input, '/timedisc/time', time)
105!time = 0.0
106 CALL setattr(sim%config,"/timedisc/starttime", time)
107
108#ifdef PARALLEL
109 decomposition(1) = 1
110 decomposition(2) = -1
111 decomposition(3) = 1
112 CALL setattr(sim%config, "/mesh/decomposition", decomposition)
113#endif
114
115 ! get step number by stripping from filename
116 filename_tmp = filename
117 i = scan(filename_tmp,'_',back=.true.)
118 IF(i.GT.0) THEN
119 filename_tmp = filename_tmp(i+1:i+4)
120 IF(filename_tmp(1:1) .EQ. "0") filename_tmp = filename_tmp(2:)
121 IF(filename_tmp(1:1) .EQ. "0") filename_tmp = filename_tmp(2:)
122 IF(filename_tmp(1:1) .EQ. "0") filename_tmp = filename_tmp(2:)
123 READ(filename_tmp,*) step
124 CALL setattr(sim%config,"/datafile/step", step)
125 ELSE
126 CALL sim%Error("Restart", "Unable to find starting step in filename_tmp.")
127 END IF
128
129
130 !-------------------- setup & data initialization -------------------------!
131 CALL sim%Setup()
132
133 CALL loaddata(sim,trim(filename))
134
135 !--------------------------------------------------------------------------!
136 SELECT TYPE (phys => sim%Physics)
137 TYPE IS(physics_eulerisotherm)
138 ! Set sound speed
139 ALLOCATE( &
140 bccsound(sim%Mesh%IGMIN:sim%Mesh%IGMAX,sim%Mesh%JGMIN:sim%Mesh%JGMAX,sim%Mesh%KGMIN:sim%Mesh%KGMAX), &
141 fcsound(sim%Mesh%IGMIN:sim%Mesh%IGMAX,sim%Mesh%JGMIN:sim%Mesh%JGMAX,sim%Mesh%KGMIN:sim%Mesh%KGMAX,6))
142
143 r => sim%Mesh%RemapBounds(sim%Mesh%radius%bcenter)
144 r_faces => sim%Mesh%RemapBounds(sim%Mesh%radius%faces)
145 bccsound = hratio*sqrt((mbh1+mbh2)*phys%Constants%GN/r(:,:,:))
146 DO i =1,6
147 fcsound(:,:,:,i) = hratio*sqrt((mbh1+mbh2)*phys%constants%GN/r_faces(:,:,:,i))
148 END DO
149 ! set isothermal sound speeds
150 CALL phys%SetSoundSpeeds(sim%Mesh,bccsound)
151 CALL phys%SetSoundSpeeds(sim%Mesh,fcsound)
152
153 ! boundary conditions
154 ! custom boundary conditions at western boundary if requested
155 SELECT TYPE(bwest => sim%Timedisc%Boundary%boundary(west)%p)
156 CLASS IS (boundary_custom)
157 CALL bwest%SetCustomBoundaries(sim%Mesh,sim%Physics, &
158 (/custom_nograd,custom_outflow,custom_kepler/))
159 END SELECT
160 SELECT TYPE(beast => sim%Timedisc%Boundary%boundary(east)%p)
161 CLASS IS (boundary_custom)
162 CALL beast%SetCustomBoundaries(sim%Mesh,sim%Physics, &
163 (/custom_nograd,custom_outflow,custom_kepler/))
164 END SELECT
165 END SELECT
166 !--------------------------------------------------------------------------!
167
168
169 CALL sim%Info(" DATA-----> initial condition: restarted from data file - " // &
170 trim(filename))
171
172 CALL sim%Physics%Convert2Conservative(sim%Timedisc%pvar,sim%Timedisc%cvar)
173! CALL Sim%FirstStep()
174
175 CALL sim%Run()
176 CALL sim%Finalize()
177 DEALLOCATE(sim)
178
179CONTAINS
180
181
186FUNCTION loadconfig(filename) RESULT(res)
187 IMPLICIT NONE
188 !--------------------------------------------------------------------------!
189 CHARACTER(LEN=*) :: filename
190 TYPE(dict_typ),POINTER :: res
191 !--------------------------------------------------------------------------!
192 INTEGER :: file, ierror, keylen, intsize, realsize, &
193 type, bytes, l, dims(5)
194 CHARACTER(LEN=6) :: magic
195 CHARACTER(LEN=2) :: endian
196 CHARACTER(LEN=13) :: header
197 CHARACTER(LEN=4) :: sizestr
198 CHARACTER(LEN=1),DIMENSION(128) :: buffer
199#ifndef PARALLEL
200 INTEGER :: offset
201 CHARACTER(LEN=1) :: version
202#else
203 INTEGER(KIND=MPI_OFFSET_KIND) :: offset, offset_0, filesize
204 INTEGER :: version
205#endif
206 CHARACTER(LEN=1),DIMENSION(:),POINTER :: keybuf
207 CHARACTER(LEN=MAX_CHAR_LEN) :: key,kf
208 REAL,DIMENSION(:,:,:), POINTER :: ptr3 => null()
209 CHARACTER(LEN=1),DIMENSION(:),POINTER :: val
210#ifdef PARALLEL
211 INTEGER :: handle
212 INTEGER :: bufsize
213 INTEGER :: position
214 INTEGER, DIMENSION(2) :: gsizes,lsizes,indices,memsizes
215 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: status
216#endif
217 !--------------------------------------------------------------------------!
218 INTENT(IN) :: filename
219 !--------------------------------------------------------------------------!
220 NULLIFY(res)
221 offset = 1
222#ifndef PARALLEL
223 file = 5555
224 OPEN(file, &
225 file = trim(filename), &
226 status = 'OLD', &
227 access = 'STREAM', &
228 action = 'READ', &
229 position = 'REWIND', &
230 iostat = ierror)
231#else
232 ! Open File
233 CALL mpi_file_open(mpi_comm_world,trim(filename),mpi_mode_rdonly, &
234 mpi_info_null,handle,ierror)
235 offset_0 = 0
236 CALL mpi_file_set_view(handle,offset_0,mpi_byte,mpi_byte,'native',mpi_info_null,ierror)
237 CALL mpi_file_seek(handle,offset-1,mpi_seek_set,ierror)
238#endif
239
240#ifndef PARALLEL
241 READ(file,pos=offset) magic, endian, version, sizestr
242#else
243 CALL mpi_file_read_all(handle, header, len(header), mpi_byte, &
244 status,ierror)
245 WRITE (magic, '(A6)') header(1:6)
246 WRITE (endian, '(A2)') header(7:8)
247 version = iachar(header(9:9))
248 WRITE (sizestr, '(A4)') header(10:13)
249#endif
250 offset = offset + 13
251 READ(sizestr, '(I2,I2)') realsize, intsize
252
253#ifndef PARALLEL
254 READ(file, iostat=ierror, pos=offset) keylen
255#else
256! TODO: keylen from data does not need to have the same intsize like from the actual run with Fosite
257 buffer = ''
258 CALL mpi_file_seek(handle,offset-1,mpi_seek_set,ierror)
259 CALL mpi_file_read_all(handle, buffer, intsize, mpi_byte, status,ierror)
260 keylen = transfer(buffer(1:intsize),keylen)
261#endif
262 offset = offset + intsize
263
264 DO WHILE(ierror.EQ.0)
265 key = ''
266 buffer = ''
267 ALLOCATE(keybuf(keylen))
268#ifndef PARALLEL
269 READ(file, pos=offset) keybuf,type,bytes
270#else
271 CALL mpi_file_seek(handle,offset-1,mpi_seek_set,ierror)
272 CALL mpi_file_read_all(handle, buffer, keylen+2*intsize, mpi_byte, &
273 status,ierror)
274 keybuf = transfer(buffer(1:keylen), keybuf)
275 type = transfer(buffer(keylen+1:keylen+intsize), type)
276 bytes = transfer(buffer(keylen+intsize+1:keylen+2*intsize), bytes)
277#endif
278 WRITE(kf,'(A, I4, A)') '(',keylen,'(A))'
279 WRITE(key,kf) keybuf
280 DEALLOCATE(keybuf)
281 key = trim(key)
282 offset = offset + keylen + 2*intsize
283 dims(:) = 1
284 SELECT CASE(type)
285 CASE(dict_real_twod)
286 l = 3
287 CASE(dict_real_threed)
288 l = 3
289 CASE(dict_real_fourd)
290 l = 4
291 CASE(dict_real_fived)
292 l = 5
293 CASE DEFAULT
294 l = 0
295 END SELECT
296 IF(l.GE.2) THEN
297#ifndef PARALLEL
298 READ(file, pos=offset) dims(1:l)
299#else
300 buffer = ''
301 CALL mpi_file_seek(handle,offset-1,mpi_seek_set,ierror)
302 CALL mpi_file_read_all(handle,buffer(1:l*intsize),l*intsize,mpi_byte,status,ierror)
303 dims(1:l) = transfer(buffer(1:l*intsize),dims(1:l))
304#endif
305 bytes = bytes - l*intsize
306 offset = offset + l*intsize
307 END IF
308
309
310 ! Here, the data fields are skipped (only single values are set, e.g.
311 ! configs, central mass, etc.)
312 ! TODO: The allocation of the field is not good here and just a workaround
313 ! - Problem: The data parts in the file need to be skipped somewhow,
314 ! but the POS argument is not available in F95, which can be used
315 ! on NEC/SX-Ace. At the field decomposition by MPI is done after
316 ! reading in the dictionary in SetupFosite.
317 SELECT CASE(l)
318 CASE(2)
319 CASE(3)
320 CASE(4)
321 CASE(5)
322 CASE DEFAULT
323 IF(bytes.GT.0) THEN
324 ALLOCATE(val(bytes))
325#ifndef PARALLEL
326 READ(file, pos=offset) val
327#else
328 buffer = ''
329 CALL mpi_file_seek(handle,offset-1,mpi_seek_set,ierror)
330 CALL mpi_file_read_all(handle,buffer(1:bytes),bytes,mpi_byte,status,ierror)
331 val = transfer(buffer(1:bytes),val)
332#endif
333 IF(key.EQ.'/config/mesh/decomposition')THEN
334 ! Do not set the key for composition. Use new one.
335 ELSE
336 CALL setattr(res,key,val,type)
337 END IF
338 DEALLOCATE(val)
339 END IF
340 END SELECT
341
342 offset = offset + bytes
343
344#ifndef PARALLEL
345 READ(file, pos=offset, iostat=ierror) keylen
346#else
347 buffer = ''
348 CALL mpi_file_seek(handle,offset-1,mpi_seek_set,ierror)
349 CALL mpi_file_read_all(handle,buffer(1:intsize),intsize,mpi_byte,status,ierror)
350 keylen = transfer(buffer(1:intsize),keylen)
351
352
353 CALL mpi_file_get_position(handle,offset_0,ierror)
354 CALL mpi_file_get_size(handle,filesize,ierror)
355 IF (filesize.LE.offset_0) THEN
356 ierror=1
357 END IF
358
359#endif
360 offset = offset + intsize
361
362 END DO
363
364 CLOSE(file)
365END FUNCTION loadconfig
366
373SUBROUTINE loaddata(this,filename)
374 USE sources_base_mod, ONLY : sources_base
375 USE sources_gravity_mod, ONLY : sources_gravity
376 IMPLICIT NONE
377 !--------------------------------------------------------------------------!
378 CLASS(fosite) :: this
379 CHARACTER(LEN=*) :: filename
380 !--------------------------------------------------------------------------!
381 INTEGER :: unit, ierror, keylen, &
382 intsize, realsize, type, bytes, &
383 l, dims(5)
384! CHARACTER(LEN=64) :: keybufsize
385 CHARACTER(LEN=13) :: header
386 CHARACTER(LEN=6) :: magic
387 CHARACTER(LEN=2) :: endian
388 CHARACTER(LEN=1),DIMENSION(128) :: buffer
389#ifndef PARALLEL
390 INTEGER :: offset
391 CHARACTER(LEN=1) :: version
392#else
393 INTEGER(KIND=MPI_OFFSET_KIND) :: offset, offset_0, filesize
394 INTEGER :: version
395#endif
396 CHARACTER(LEN=4) :: sizestr
397 CHARACTER(LEN=1),DIMENSION(:),POINTER :: keybuf
398 CHARACTER(LEN=MAX_CHAR_LEN) :: key,kf
399 REAL,DIMENSION(:,:), POINTER :: ptr2 => null()
400 REAL,DIMENSION(:,:,:), POINTER :: ptr3 => null()
401 REAL,DIMENSION(:,:,:,:), POINTER :: ptr4 => null()
402 REAL,DIMENSION(:,:,:,:,:), POINTER :: ptr5 => null()
403 CHARACTER(LEN=1),DIMENSION(:),POINTER :: val
404#ifdef PARALLEL
405 INTEGER :: handle
406 INTEGER :: filetype
407 INTEGER :: bufsize
408 INTEGER :: position
409 INTEGER, DIMENSION(2) :: gsizes,lsizes,indices,memsizes
410 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: status
411#endif
412 CLASS(sources_base), POINTER :: srcptr
413 CLASS(gravity_base), POINTER :: gravptr
414 !--------------------------------------------------------------------------!
415 INTENT(IN) :: filename
416 INTENT(INOUT) :: this
417 !--------------------------------------------------------------------------!
418 offset = 1
419
420#ifndef PARALLEL
421 unit = 5555
422 OPEN(unit, &
423 file = trim(filename), &
424 status = 'OLD', &
425 access = 'STREAM', &
426 action = 'READ', &
427 position = 'REWIND', &
428 iostat = ierror)
429#else
430 ! First create Datatype that will be read in
431 gsizes(1) = sim%Mesh%INUM
432 gsizes(2) = sim%Mesh%JNUM
433 lsizes(1) = sim%Mesh%IMAX-sim%Mesh%IMIN+1
434 lsizes(2) = sim%Mesh%JMAX-sim%Mesh%JMIN+1
435 indices(1)= sim%Mesh%IMIN-1
436 indices(2)= sim%Mesh%JMIN-1
437 bufsize = product(lsizes)
438 CALL mpi_type_create_subarray(2, gsizes, lsizes, indices, mpi_order_fortran,&
439 default_mpi_real,filetype,ierror)
440 CALL mpi_type_commit(filetype,ierror)
441
442 ! Open File
443 CALL mpi_file_open(mpi_comm_world,trim(filename),mpi_mode_rdonly, &
444 mpi_info_null,handle,ierror)
445! CALL MPI_File_seek(handle,offset-1,MPI_SEEK_SET,ierror)
446#endif
447
448#ifndef PARALLEL
449 READ(unit) magic, endian, version, sizestr
450#else
451 CALL mpi_file_read_all(handle, header, len(header), mpi_byte, &
452 status,ierror)
453 WRITE (magic, '(A6)') header(1:6)
454 WRITE (endian, '(A2)') header(7:8)
455 version = iachar(header(9:9))
456 WRITE (sizestr, '(A4)') header(10:13)
457#endif
458 offset = offset + 13
459 READ(sizestr, '(I2,I2)') realsize, intsize
460#ifndef PARALLEL
461 READ(unit, iostat=ierror) keylen
462#else
463! TODO: keylen from data does not need to have the same intsize like from the actual run with Fosite
464 buffer = ''
465 CALL mpi_file_read_all(handle, buffer, intsize, mpi_byte, status,ierror)
466 keylen = transfer(buffer(1:intsize),keylen)
467#endif
468 offset = offset + intsize
469
470!------------------- loop over data ------------------------------------------!
471 DO WHILE(ierror.EQ.0)
472 NULLIFY(ptr2)
473 key = ''
474 buffer = ''
475 ALLOCATE(keybuf(keylen))
476#ifndef PARALLEL
477 READ(unit) keybuf,type,bytes
478#else
479 CALL mpi_file_read_all(handle, buffer, keylen+2*intsize, mpi_byte, &
480 status,ierror)
481 keybuf = transfer(buffer(1:keylen), keybuf)
482 type = transfer(buffer(keylen+1:keylen+intsize), type)
483 bytes = transfer(buffer(keylen+intsize+1:keylen+2*intsize), bytes)
484#endif
485 WRITE(kf,'(A, I4, A)') '(',keylen,'(A))'
486 WRITE(key,kf) keybuf
487 DEALLOCATE(keybuf)
488 offset = offset + keylen + 2*intsize
489 dims(:) = 1
490 SELECT CASE(type)
491 CASE(dict_real_twod)
492 l = 3
493 CASE(dict_real_threed)
494 l = 3
495 CASE(dict_real_fourd)
496 l = 4
497 CASE(dict_real_fived)
498 l = 5
499 CASE DEFAULT
500 l = 0
501 END SELECT
502 IF(l.GE.2) THEN
503#ifndef PARALLEL
504 READ(unit) dims(1:l)
505#else
506 buffer = ''
507 CALL mpi_file_read_all(handle,buffer(1:l*intsize),l*intsize,mpi_byte,status,ierror)
508 dims(1:l) = transfer(buffer(1:l*intsize),dims(1:l))
509#endif
510 bytes = bytes - l*intsize
511 offset = offset + l*intsize
512 END IF
513
514 SELECT CASE(trim(key))
515 CASE('/timedisc/density')
516 sim%Timedisc%pvar%data4d(sim%Mesh%IGMIN:sim%Mesh%IGMAX,sim%Mesh%JGMIN:sim%Mesh%JGMAX, &
517 sim%Mesh%KGMIN:sim%Mesh%KGMAX,sim%Physics%DENSITY) = 0.0
518#ifndef PARALLEL
519 READ(unit) sim%Timedisc%pvar%data4d(sim%Mesh%IMIN:sim%Mesh%IMAX,sim%Mesh%JMIN:sim%Mesh%JMAX, &
520 sim%Mesh%KMIN:sim%Mesh%KMAX,sim%Physics%DENSITY)
521#else
522 CALL mpi_file_set_view(handle, offset-1,default_mpi_real,filetype, 'native', mpi_info_null, ierror)
523 CALL mpi_file_read_all(handle, &
524 sim%Timedisc%pvar%data4d(sim%Mesh%IMIN:sim%Mesh%IMAX,sim%Mesh%JMIN:sim%Mesh%JMAX, &
525 sim%Mesh%KMIN:sim%Mesh%KMAX,sim%Physics%DENSITY), &
526 bufsize, default_mpi_real, status, ierror)
527 offset_0 = 0
528 CALL mpi_file_set_view(handle,offset_0,mpi_byte,mpi_byte,'native',mpi_info_null,ierror)
529#endif
530 CASE('/timedisc/xvelocity')
531 sim%Timedisc%pvar%data4d(sim%Mesh%IGMIN:sim%Mesh%IGMAX,sim%Mesh%JGMIN:sim%Mesh%JGMAX, &
532 sim%Mesh%KGMIN:sim%Mesh%KGMAX,sim%Physics%XVELOCITY) = 0.0
533#ifndef PARALLEL
534 READ(unit) sim%Timedisc%pvar%data4d(sim%Mesh%IMIN:sim%Mesh%IMAX,sim%Mesh%JMIN:sim%Mesh%JMAX, &
535 sim%Mesh%KMIN:sim%Mesh%KMAX,sim%Physics%XVELOCITY)
536#else
537 CALL mpi_file_set_view(handle, offset-1,default_mpi_real,filetype, 'native', mpi_info_null, ierror)
538 CALL mpi_file_read_all(handle, &
539 sim%Timedisc%pvar%data4d(sim%Mesh%IMIN:sim%Mesh%IMAX,sim%Mesh%JMIN:sim%Mesh%JMAX, &
540 sim%Mesh%KMIN:sim%Mesh%KMAX,sim%Physics%XVELOCITY),&
541 bufsize, default_mpi_real, status, ierror)
542 offset_0 = 0
543 CALL mpi_file_set_view(handle,offset_0,mpi_byte,mpi_byte,'native',mpi_info_null,ierror)
544#endif
545 CASE('/timedisc/yvelocity')
546 sim%Timedisc%pvar%data4d(sim%Mesh%IGMIN:sim%Mesh%IGMAX,sim%Mesh%JGMIN:sim%Mesh%JGMAX, &
547 sim%Mesh%KGMIN:sim%Mesh%KGMAX,sim%Physics%YVELOCITY) = 0.0
548#ifndef PARALLEL
549 READ(unit) sim%Timedisc%pvar%data4d(sim%Mesh%IMIN:sim%Mesh%IMAX,sim%Mesh%JMIN:sim%Mesh%JMAX, &
550 sim%Mesh%KMIN:sim%Mesh%KMAX,sim%Physics%YVELOCITY)
551#else
552 CALL mpi_file_set_view(handle, offset-1,default_mpi_real,filetype, 'native', mpi_info_null, ierror)
553 CALL mpi_file_read_all(handle, &
554 sim%Timedisc%pvar%data4d(sim%Mesh%IMIN:sim%Mesh%IMAX,sim%Mesh%JMIN:sim%Mesh%JMAX, &
555 sim%Mesh%KMIN:sim%Mesh%KMAX,sim%Physics%YVELOCITY),&
556 bufsize, default_mpi_real, status, ierror)
557 offset_0 = 0
558 CALL mpi_file_set_view(handle,offset_0,mpi_byte,mpi_byte,'native',mpi_info_null,ierror)
559#endif
560 CASE('/timedisc/zvelocity')
561 sim%Timedisc%pvar%data4d(sim%Mesh%IGMIN:sim%Mesh%IGMAX,sim%Mesh%JGMIN:sim%Mesh%JGMAX, &
562 sim%Mesh%KGMIN:sim%Mesh%KGMAX,sim%Physics%ZVELOCITY) = 0.0
563#ifndef PARALLEL
564 READ(unit) sim%Timedisc%pvar%data4d(sim%Mesh%IMIN:sim%Mesh%IMAX,sim%Mesh%JMIN:sim%Mesh%JMAX, &
565 sim%Mesh%KMIN:sim%Mesh%KMAX,sim%Physics%ZVELOCITY)
566#else
567 CALL mpi_file_set_view(handle, offset-1,default_mpi_real,filetype, 'native', mpi_info_null, ierror)
568 CALL mpi_file_read_all(handle, &
569 sim%Timedisc%pvar%data4d(sim%Mesh%IMIN:sim%Mesh%IMAX,sim%Mesh%JMIN:sim%Mesh%JMAX, &
570 sim%Mesh%KMIN:sim%Mesh%KMAX,sim%Physics%ZVELOCITY),&
571 bufsize, default_mpi_real, status, ierror)
572 offset_0 = 0
573 CALL mpi_file_set_view(handle,offset_0,mpi_byte,mpi_byte,'native',mpi_info_null,ierror)
574#endif
575 CASE('/timedisc/pressure')
576 SELECT TYPE (phys => sim%Physics)
577 TYPE IS(physics_euler)
578 sim%Timedisc%pvar%data4d(sim%Mesh%IGMIN:sim%Mesh%IGMAX,sim%Mesh%JGMIN:sim%Mesh%JGMAX, &
579 sim%Mesh%KGMIN:sim%Mesh%KGMAX,phys%PRESSURE) = 0.0
580#ifndef PARALLEL
581 READ(unit) sim%Timedisc%pvar%data4d(sim%Mesh%IMIN:sim%Mesh%IMAX,sim%Mesh%JMIN:sim%Mesh%JMAX, &
582 sim%Mesh%KMIN:sim%Mesh%KMAX,phys%PRESSURE)
583#else
584 CALL mpi_file_set_view(handle, offset-1,default_mpi_real,filetype, 'native', mpi_info_null, ierror)
585 CALL mpi_file_read_all(handle, &
586 sim%Timedisc%pvar%data4d(sim%Mesh%IMIN:sim%Mesh%IMAX,sim%Mesh%JMIN:sim%Mesh%JMAX, &
587 sim%Mesh%KMIN:sim%Mesh%KMAX,phys%PRESSURE),&
588 bufsize, default_mpi_real, status, ierror)
589 offset_0 = 0
590 CALL mpi_file_set_view(handle,offset_0,mpi_byte,mpi_byte,'native',mpi_info_null,ierror)
591#endif
592 END SELECT
593 CASE('/physics/bccsound')
594 SELECT TYPE (phys => sim%Physics)
595 TYPE IS(physics_eulerisotherm)
596 phys%bccsound%data3d(sim%Mesh%IGMIN:sim%Mesh%IGMAX,sim%Mesh%JGMIN:sim%Mesh%JGMAX, &
597 sim%Mesh%KGMIN:sim%Mesh%KGMAX) = 0.0
598#ifndef PARALLEL
599 READ(unit) phys%bccsound%data3d(sim%Mesh%IMIN:sim%Mesh%IMAX,sim%Mesh%JMIN:sim%Mesh%JMAX, &
600 sim%Mesh%KMIN:sim%Mesh%KMAX)
601#else
602 CALL mpi_file_set_view(handle, offset-1,default_mpi_real,filetype, 'native', mpi_info_null, ierror)
603 CALL mpi_file_read_all(handle, &
604 phys%bccsound%data3d(sim%Mesh%IMIN:sim%Mesh%IMAX,sim%Mesh%JMIN:sim%Mesh%JMAX, &
605 sim%Mesh%KMIN:sim%Mesh%KMAX),&
606 bufsize, default_mpi_real, status, ierror)
607 offset_0 = 0
608 CALL mpi_file_set_view(handle,offset_0,mpi_byte,mpi_byte,'native',mpi_info_null,ierror)
609#endif
610 END SELECT
611 CASE('/physics/fcsound')
612 SELECT TYPE (phys => sim%Physics)
613 TYPE IS(physics_eulerisotherm)
614 phys%fcsound%data4d(sim%Mesh%IGMIN:sim%Mesh%IGMAX,sim%Mesh%JGMIN:sim%Mesh%JGMAX, &
615 sim%Mesh%KGMIN:sim%Mesh%KGMAX,1:sim%Mesh%NFACES) = 0.0
616#ifndef PARALLEL
617 READ(unit) phys%fcsound%data4d(sim%Mesh%IMIN:sim%Mesh%IMAX,sim%Mesh%JMIN:sim%Mesh%JMAX, &
618 sim%Mesh%KMIN:sim%Mesh%KMAX,1:sim%Mesh%NFACES)
619#else
620 CALL mpi_file_set_view(handle, offset-1,default_mpi_real,filetype, 'native', mpi_info_null, ierror)
621 CALL mpi_file_read_all(handle, &
622 phys%fcsound%data4d(sim%Mesh%IMIN:sim%Mesh%IMAX,sim%Mesh%JMIN:sim%Mesh%JMAX, &
623 sim%Mesh%KMIN:sim%Mesh%KMAX,1:sim%Mesh%NFACES),&
624 bufsize, default_mpi_real, status, ierror)
625 offset_0 = 0
626 CALL mpi_file_set_view(handle,offset_0,mpi_byte,mpi_byte,'native',mpi_info_null,ierror)
627#endif
628 END SELECT
629 CASE('/sources/grav/binary/binpos')
630 srcptr => this%Sources%GetSourcesPointer(gravity)
631 IF (ASSOCIATED(srcptr)) THEN
632 SELECT TYPE (gravity => srcptr)
633 CLASS IS(sources_gravity)
634 gravptr => gravity%glist
635 DO WHILE (ASSOCIATED(gravptr))
636 SELECT TYPE (binary => gravptr)
637 TYPE IS (gravity_binary)
638 READ(unit) binary%pos(1:3,1:2)
639 CLASS DEFAULT
640 ! do nothing or add fields/values in gravities
641 END SELECT
642 gravptr => gravptr%next
643 END DO
644 END SELECT
645 END IF
646 CASE('/sources/grav/binary/mass')
647 srcptr => this%Sources%GetSourcesPointer(gravity)
648 IF (ASSOCIATED(srcptr)) THEN
649 SELECT TYPE (gravity => srcptr)
650 CLASS IS(sources_gravity)
651 gravptr => gravity%glist
652 DO WHILE (ASSOCIATED(gravptr))
653 SELECT TYPE (binary => gravptr)
654 TYPE IS (gravity_binary)
655 READ(unit) binary%mass
656 CLASS DEFAULT
657 ! do nothing or add fields/values in gravities
658 END SELECT
659 gravptr => gravptr%next
660 END DO
661 END SELECT
662 END IF
663 CASE('/sources/grav/binary/mass2')
664 srcptr => this%Sources%GetSourcesPointer(gravity)
665 IF (ASSOCIATED(srcptr)) THEN
666 SELECT TYPE (gravity => srcptr)
667 CLASS IS(sources_gravity)
668 gravptr => gravity%glist
669 DO WHILE (ASSOCIATED(gravptr))
670 SELECT TYPE (binary => gravptr)
671 TYPE IS (gravity_binary)
672 READ(unit) binary%mass2
673 CLASS DEFAULT
674 ! do nothing or add fields/values in gravities
675 END SELECT
676 gravptr => gravptr%next
677 END DO
678 END SELECT
679 END IF
680 CASE DEFAULT
681 SELECT CASE(l)
682 CASE(2)
683#ifndef PARALLEL
684 ALLOCATE(ptr2(dims(1),dims(2)))
685 READ(unit) ptr2
686 DEALLOCATE(ptr2)
687#endif
688 CASE(3)
689#ifndef PARALLEL
690 ALLOCATE(ptr3(dims(1),dims(2),dims(3)))
691 READ(unit) ptr3
692 DEALLOCATE(ptr3)
693#endif
694 CASE(4)
695#ifndef PARALLEL
696 ALLOCATE(ptr4(dims(1),dims(2),dims(3),dims(4)))
697 READ(unit) ptr4
698 DEALLOCATE(ptr4)
699#endif
700 CASE(5)
701#ifndef PARALLEL
702 ALLOCATE(ptr5(dims(1),dims(2),dims(3),dims(4),dims(5)))
703 READ(unit) ptr5
704 DEALLOCATE(ptr5)
705#endif
706 CASE DEFAULT
707 IF(bytes.GT.0) THEN
708#ifndef PARALLEL
709 ALLOCATE(val(bytes))
710 READ(unit) val
711 DEALLOCATE(val)
712#endif
713 END IF
714 END SELECT
715 END SELECT
716 offset = offset + bytes
717
718#ifndef PARALLEL
719 READ(unit, iostat=ierror) keylen
720#else
721 buffer = ''
722 CALL mpi_file_seek(handle,offset-1,mpi_seek_set,ierror)
723 CALL mpi_file_read_all(handle,buffer(1:intsize),intsize,mpi_byte,status,ierror)
724 keylen = transfer(buffer(1:intsize),keylen)
725
726 CALL mpi_file_get_position(handle,offset_0,ierror)
727 CALL mpi_file_get_size(handle,filesize,ierror)
728 IF (filesize.LE.offset_0) THEN
729 ierror=1
730 END IF
731#endif
732 offset = offset + intsize
733 END DO
734#ifndef PARALLEL
735 CLOSE(unit)
736#else
737 CALL mpi_file_close(handle,ierror)
738#endif
739END SUBROUTINE loaddata
740
741END PROGRAM restart
fosite_mod
Definition: fosite.f90:41
fosite_mod::step
logical function, private step(this)
Definition: fosite.f90:368
sources_base_mod
generic source terms module providing functionaly common to all source terms
Definition: sources_base.f90:42
sources_gravity_mod
generic gravity terms module providing functionaly common to all gravity terms
Definition: sources_gravity.f90:41
restart
program restart
Definition: restart.f90:49
loaddata
subroutine loaddata(this, filename)
Loads the datafields from binary input that are necessary for initialization.
Definition: restart.f90:374
loadconfig
type(dict_typ) function, pointer loadconfig(filename)
Loads the whole dictionary from binary input AND scalar data.
Definition: restart.f90:187
fosite_mod::fosite
main fosite class
Definition: fosite.f90:71
sources_base_mod::sources_base
Definition: sources_base.f90:57
sources_gravity_mod::sources_gravity
Definition: sources_gravity.f90:58
Generated by   doxygen 1.9.4