66 INTEGER,
PRIVATE,
PARAMETER ::
maxlen = 500
67 INTEGER,
PRIVATE,
PARAMETER ::
simtype = 1
68 CHARACTER(LEN=32),
PRIVATE,
PARAMETER ::
simname =
"fosite"
76 CLASS(mesh_base),
ALLOCATABLE :: mesh
77 CLASS(fluxes_base),
ALLOCATABLE :: fluxes
78 CLASS(physics_base),
ALLOCATABLE :: physics
79 CLASS(fileio_base),
ALLOCATABLE :: datafile
80 CLASS(timedisc_base),
ALLOCATABLE :: timedisc
81 CLASS(fileio_base),
ALLOCATABLE :: logfile
86 LOGICAL :: aborted = .true.
87 DOUBLE PRECISION :: wall_time = 0.0
88 DOUBLE PRECISION :: log_time = 0.0
89 DOUBLE PRECISION :: start_time = 0.0
90 DOUBLE PRECISION :: end_time = 0.0
91 DOUBLE PRECISION :: run_time = 0.0
92 INTEGER :: start_count
93 CHARACTER(MAXLEN) :: buffer
131 LOGICAL :: already_initialized = .false.
134 IF (
this%Initialized())
THEN
135 CALL this%Warning(
"InitFosite",
"already initialized, trying to reset")
137 CALL this%Finalize(.false.)
141 CALL mpi_initialized(already_initialized,
this%ierror)
142 IF (.NOT.already_initialized) &
143 CALL mpi_init(
this%ierror)
156 TYPE(
dict_typ),
POINTER :: dir, iodir, config_copy
159 IF (.NOT.
this%Initialized()) &
160 CALL this%Error(
"Setup",
"Sim is uninitialized")
164 IF (
this%GetRank().EQ.0)
THEN
166 WRITE(
this%buffer,
"(A)")&
167 "+---------------------------------------------------------+"
169 WRITE(
this%buffer,
"(A1,A29,A28,A1)")&
172 WRITE(
this%buffer,
"(A1,A35,A22,A1)")&
173 "|",trim(version),
"",
"|"
175 WRITE(
this%buffer,
"(A)")&
176 "| Solution of 3D advection problems |"
178 WRITE(
this%buffer,
"(A)")&
179 "+---------------------------------------------------------+"
181 CALL this%Info(
"Initializing simulation:")
184 CALL getattr(
this%config,
"mesh", dir)
185 IF(
ASSOCIATED(dir))
THEN
188 IF(
ASSOCIATED(iodir))
CALL setattr(
this%IO,
"mesh", iodir)
189 IF (
this%Mesh%shear_dir.GT.0)
THEN
191 CALL setattr(
this%config,
"sources/shearing/stype",
shearbox)
195 CALL getattr(
this%config,
"physics", dir)
196 IF(
ASSOCIATED(dir))
THEN
199 IF(
ASSOCIATED(iodir))
CALL setattr(
this%IO,
"physics", iodir)
202 CALL getattr(
this%config,
"fluxes", dir)
203 IF(
ASSOCIATED(dir))
THEN
206 IF(
ASSOCIATED(iodir))
CALL setattr(
this%IO,
"fluxes", iodir)
209 CALL getattr(
this%config,
"timedisc", dir)
210 IF(
ASSOCIATED(dir))
THEN
213 IF(
ASSOCIATED(iodir))
CALL setattr(
this%IO,
"timedisc", iodir)
216 CALL getattr(
this%config,
"boundary", dir)
217 IF(.NOT.
ASSOCIATED(dir))
THEN
218 boundary =>
dict(
"empty"/ 0)
219 CALL setattr(
this%config,
"boundary", boundary)
220 CALL getattr(
this%config,
"boundary", dir)
222 IF(
ASSOCIATED(dir))
THEN
225 IF(
ASSOCIATED(iodir))
CALL setattr(
this%IO,
"boundary", iodir)
228 CALL getattr(
this%config,
"sources", dir)
229 IF(
ASSOCIATED(dir))
THEN
234 IF(
ASSOCIATED(iodir))
CALL setattr(
this%IO,
"sources", iodir)
238 CALL getattr(
this%config,
"datafile", dir)
239 IF(
ASSOCIATED(dir))
THEN
244 CALL getattr(
this%config,
"logfile", dir)
245 IF(
ASSOCIATED(dir))
THEN
250 CALL setattr(
this%config,
"version", trim(version))
253 CALL setattr(
this%IO,
"config", config_copy)
263 INTEGER :: datetime(8),dir
265 IF(.NOT.
this%Initialized()) &
266 CALL this%Error(
"fosite::FirstStep",
"Sim is uninitialized")
270 IF (
this%iter.GT.-1) &
271 CALL this%Error(
"fosite::FirstStep",
"FirstStep should only be called once.")
275 CALL mpi_barrier(mpi_comm_world,
this%ierror)
276 this%start_time = mpi_wtime()
277 CALL mpi_allreduce(mpi_in_place,
this%start_time,1,mpi_double_precision,mpi_max,&
278 mpi_comm_world,
this%ierror)
280 CALL cpu_time(
this%start_time)
283 CALL system_clock(
this%start_count)
289 IF (
this%GetRank().EQ.0)
THEN
291 "===================================================================")
292 CALL this%Info(
"Starting calculation...")
293 CALL date_and_time(values = datetime)
294 WRITE(
this%buffer,
"(A,I2.2,A,I2.2,A,I4.4,A,I2.2,A,I2.2,A,I2.2)")&
296 datetime(3),
".", datetime(2),
".", datetime(1),
" ",&
297 datetime(5),
":", datetime(6),
":", datetime(7)
300 "step time n t min(dt) due to adj.")
302 "-------------------------------------------------------------------")
306 IF (
this%Mesh%fargo%GetType().EQ.1)
THEN
308 CALL this%Timedisc%Boundary%CenterBoundary(
this%Mesh,
this%Physics,&
309 0.0,
this%Timedisc%pvar,
this%Timedisc%cvar)
310 CALL this%Timedisc%CalcBackgroundVelocity(
this%Mesh,
this%Physics, &
311 this%Timedisc%pvar,
this%Timedisc%cvar)
316 this%Timedisc%time,0.0,
this%Timedisc%pvar,
this%Timedisc%cvar, &
317 check_all,
this%Timedisc%rhs)
323 SELECT TYPE(phys =>
this%Physics)
324 CLASS IS(physics_eulerisotherm)
325 IF(phys%csiso.GT.0.)
THEN
326 IF(any(phys%bccsound%data1d(:).NE.phys%csiso))
THEN
327 CALL this%Error(
"FirstStep",
"isothermal sound speed set, but "&
328 //
"arrays bccsound and/or fcsound have been overwritten.")
337 this%Timedisc%cold =
this%Timedisc%cvar
340 IF (
this%Timedisc%time.EQ.0.0)
THEN
343 CALL this%PrintInfo(0,0,0.0,0.0,0,
this%Timedisc%n_adj)
346 IF(
this%Timedisc%break) &
347 CALL this%Error(
"FirstStep",
"Initial data invalid!")
356 CHARACTER(LEN=32) :: str
359 DO WHILE((
this%Timedisc%maxiter.LE.0).OR.(
this%iter.LE.
this%Timedisc%maxiter))
362 IF (
this%iter.GE.
this%Timedisc%maxiter) &
363 CALL this%Warning(
"fosite::Run",
"number of iterations exceeds limit")
367 FUNCTION step(this)
RESULT(break)
373 REAL,
DIMENSION(2) :: dt_buf
379 IF (
this%iter.EQ.-1) &
380 CALL this%FirstStep()
383 IF (abs(
this%Timedisc%stoptime-
this%Timedisc%time)&
384 .LE.1.0e-05*
this%Timedisc%stoptime)
THEN
386 this%aborted = .false.
392 dt_buf(1) =
this%Timedisc%dt
393 dt_buf(2) =
this%Timedisc%dtcause
396 this%Timedisc%dt = dt_buf(1)
397 this%Timedisc%dtcause = dt_buf(2)
399 this%run_time = mpi_wtime() -
this%log_time
400 CALL mpi_allreduce(
this%run_time,
this%wall_time,1,mpi_double_precision,&
401 mpi_min,
this%Mesh%comm_cart,
this%ierror)
403 CALL cpu_time(
this%wall_time)
408 CALL this%Datafile%AdjustTimestep(
this%Timedisc%time,&
409 this%Timedisc%dt,
this%Timedisc%dtcause)
413 dt_buf(1) =
this%Timedisc%dt
414 dt_buf(2) =
this%Timedisc%dtcause
417 this%Timedisc%dt = dt_buf(1)
418 this%Timedisc%dtcause = dt_buf(2)
426 IF ((abs(
this%Datafile%time-
this%Timedisc%time)&
427 .LE.1.0e-5*
this%Datafile%time).OR.&
428 this%Timedisc%break.OR.(
this%Datafile%walltime.LE.
this%wall_time))
THEN
432 this%Timedisc%dtmin,
this%Timedisc%dtmincause,
this%Timedisc%n_adj)
435 IF(
this%Timedisc%break.AND.
this%GetRank().EQ.0)
THEN
436 CALL this%Warning(
"SolveODE",
"Time step too small, aborting.",0)
442 IF (
this%Datafile%walltime.LE.
this%wall_time)
THEN
443 this%Datafile%walltime = huge(1.0)
447 this%Timedisc%dtmin =
this%Timedisc%stoptime
448 this%Timedisc%dtmincause = -99
449 this%Timedisc%n_adj = 0
453 this%Timedisc%dtmean = 0.
454 this%Timedisc%dtstddev = 0.
455 this%Timedisc%dtaccept = 0
457 IF(
this%Timedisc%write_error) &
458 this%Timedisc%cerr_max%data1d(:) = 0.
470 LOGICAL,
OPTIONAL,
INTENT(IN) :: mpifinalize_
473 LOGICAL :: mpifinalize
476 CALL this%ComputeRunTime()
477 CALL this%PrintBoundaryFluxes()
478 CALL this%PrintSummary()
481 DEALLOCATE(
this%Datafile)
482 IF (
ALLOCATED(
this%Logfile))
THEN
484 DEALLOCATE(
this%Logfile)
486 CALL this%Timedisc%Finalize()
487 DEALLOCATE(
this%Timedisc)
489 IF (
ALLOCATED(
this%Sources))
DEALLOCATE(
this%Sources)
491 CALL this%Fluxes%Finalize()
492 DEALLOCATE(
this%Fluxes)
494 CALL this%Physics%Finalize()
495 DEALLOCATE(
this%Physics)
497 CALL this%Mesh%Finalize()
498 DEALLOCATE(
this%Mesh)
505 IF(
PRESENT(mpifinalize_))
THEN
506 mpifinalize = mpifinalize_
511 CALL mpi_finalize(
this%ierror)
522 CALL mpi_barrier(mpi_comm_world,
this%ierror)
523 this%end_time = mpi_wtime()
524 CALL mpi_allreduce(mpi_in_place,
this%end_time,1,mpi_double_precision,mpi_min,&
525 mpi_comm_world,
this%ierror)
527 CALL cpu_time(
this%end_time)
537 INTEGER ::
step, i, dc, na
538 CHARACTER(LEN=9) :: dtcause
541 INTEGER :: drt, c, c_rate, c_max
545 IF (
this%GetRank().EQ.0)
THEN
550 WRITE(dtcause,
"(A,I2.2,A)")
" S",dc,
" "
552 WRITE(dtcause,
"(A)")
" cfl "
554 WRITE(dtcause,
"(A)")
" err_adj "
555 CASE(dtcause_smallerr)
556 WRITE(dtcause,
"(A)")
" err "
559 WRITE(dtcause,
"(A)")
" fileio "
561 WRITE(dtcause,
"(A,I3.2,A)")
" ?", dc,
"? "
564 CALL system_clock(c,c_rate, c_max)
566 drt = (c -
this%start_count)/c_rate
568 drt = c_max/c_rate + drt
570 WRITE(
this%buffer,
"(I4.4,A,I2.2,A,I2.2,A,I2.2,A,I8,A,ES11.3,A,ES11.3,A,I5)")&
571 step,
" ", drt/3600,
":", mod(drt,3600)/60,
":", mod(drt,60),&
572 " ", i,
" ", t,
" ", d, dtcause, na
582 REAL,
DIMENSION(this%Physics%VNUM,6) :: bflux
585 bflux(:,k) =
this%Fluxes%GetBoundaryFlux(
this%Mesh,
this%Physics,k)
587 IF (
this%GetRank().EQ.0)
THEN
588 CALL this%Info(
"-------------------------------------------------------------------")
589 CALL this%Info(
"total boundary fluxes:")
590 SELECT CASE(
this%Physics%VDIM)
592 IF(
this%Mesh%INUM.GT.1)
THEN
593 CALL this%Info(
" west east")
594 DO k=1,
this%Physics%VNUM
595 WRITE(
this%buffer,
"(T2,A,T21,2(ES12.3))")trim(
this%Physics%cvarname(k)), &
596 bflux(k,west), bflux(k,east)
599 ELSEIF(
this%Mesh%JNUM.GT.1)
THEN
600 CALL this%Info(
" south north")
601 DO k=1,
this%Physics%VNUM
602 WRITE(
this%buffer,
"(T2,A,T21,2(ES12.3))")trim(
this%Physics%cvarname(k)), &
603 bflux(k,south), bflux(k,north)
606 ELSEIF(
this%Mesh%KNUM.GT.1)
THEN
607 CALL this%Info(
" bottom top")
608 DO k=1,
this%Physics%VNUM
609 WRITE(
this%buffer,
"(T2,A,T21,2(ES12.3))")trim(
this%Physics%cvarname(k)), &
610 bflux(k,bottom), bflux(k,top)
615 IF(
this%Mesh%INUM.EQ.1)
THEN
616 CALL this%Info(
" south north")
617 DO k=1,
this%Physics%VNUM
618 WRITE(
this%buffer,
"(T2,A,T21,2(ES12.3))")trim(
this%Physics%cvarname(k)), &
619 bflux(k,south), bflux(k,north)
622 CALL this%Info(
" bottom top")
623 DO k=1,
this%Physics%VNUM
624 WRITE(
this%buffer,
"(T2,A,T21,2(ES12.3))")trim(
this%Physics%cvarname(k)), &
625 bflux(k,bottom), bflux(k,top)
628 ELSEIF(
this%Mesh%JNUM.EQ.1)
THEN
629 CALL this%Info(
" west east")
630 DO k=1,
this%Physics%VNUM
631 WRITE(
this%buffer,
"(T2,A,T21,2(ES12.3))")trim(
this%Physics%cvarname(k)), &
632 bflux(k,west), bflux(k,east)
635 CALL this%Info(
" bottom top")
636 DO k=1,
this%Physics%VNUM
637 WRITE(
this%buffer,
"(T2,A,T21,2(ES12.3))")trim(
this%Physics%cvarname(k)), &
638 bflux(k,bottom), bflux(k,top)
641 ELSEIF(
this%Mesh%KNUM.EQ.1)
THEN
642 CALL this%Info(
" west east")
643 DO k=1,
this%Physics%VNUM
644 WRITE(
this%buffer,
"(T2,A,T21,2(ES12.3))")trim(
this%Physics%cvarname(k)), &
645 bflux(k,west), bflux(k,east)
648 CALL this%Info(
" south north")
649 DO k=1,
this%Physics%VNUM
650 WRITE(
this%buffer,
"(T2,A,T21,2(ES12.3))")trim(
this%Physics%cvarname(k)), &
651 bflux(k,south), bflux(k,north)
656 CALL this%Info(
" west east south")
657 DO k=1,
this%Physics%VNUM
658 WRITE(
this%buffer,
"(T2,A,T21,3(ES12.3))")trim(
this%Physics%cvarname(k)), &
659 bflux(k,west), bflux(k,east), bflux(k,south)
662 CALL this%Info(
" north bottom top")
663 DO k=1,
this%Physics%VNUM
664 WRITE(
this%buffer,
"(T2,A,T21,3(ES12.3))")trim(
this%Physics%cvarname(k)), &
665 bflux(k,north), bflux(k,bottom), bflux(k,top)
677 IF (
this%GetRank().EQ.0)
THEN
678 CALL this%Info(
"===================================================================")
679 IF (
this%aborted)
THEN
680 CALL this%Info(
"time integration aborted due to errors!")
681 ELSE IF ((
this%Timedisc%maxiter.LE.0).OR.(
this%iter.LT.
this%Timedisc%maxiter))
THEN
682 CALL this%Info(
"calculation finished correctly.")
684 CALL this%Info(
"too many iterations, aborting!")
686 WRITE(
this%buffer,
"(A,F10.2,A)")
" main loop runtime: ",
this%run_time,
" sec."
subroutine, public new_boundary(Boundary, Mesh, Physics, config, IO)
Dictionary for generic data types.
recursive subroutine, public deletedict(root)
Delete the dictionary 'root' and all subnodes.
logical function, public haschild(root)
Check if the node 'root' has one or more children.
recursive subroutine, public copydict(root, outdir)
Copy complete Dictionary.
type(dict_typ) function, pointer, public dict(n1, n2, n3, n4, n5, n6, n7, n8, n9, n10, n11, n12, n13, n14, n15, n16, n17, n18, n19, n20)
Construct a new dictionary from several key/value pairs. Together with the Assign subroutine and over...
subroutine, public initdict()
subroutine, public closedict()
type(logging_base), save this
constructor for fileio class
subroutine new_fileio(Fileio, Mesh, Physics, Timedisc, Sources, config, IO)
constructor for FileIO class
constructor for fluxes class
subroutine, public new_fluxes(Fluxes, Mesh, Physics, config, IO)
subroutine, private run(this)
logical function, private step(this)
subroutine, private printinfo(this, step, i, t, d, dc, na)
subroutine, private computeruntime(this)
subroutine, private printboundaryfluxes(this)
integer, parameter, private simtype
character(len=32), parameter, private simname
subroutine, private finalize(this, mpifinalize_)
subroutine, private initfosite(this)
subroutine, private printsummary(this)
subroutine, private firststep(this)
integer, parameter, private maxlen
subroutine, private setup(this)
defines properties of a 3D spherical mesh
integer, save default_mpi_2real
default 2real type for MPI
constructor for mesh class
subroutine new_mesh(Mesh, config, IO)
constructor for physics class
subroutine new_physics(Physics, Mesh, config, IO)
allocate and initialize new physics class
constructor for reconstruction class
module to manage list of source terms
integer, parameter, public shearbox
constructor for timedisc class
subroutine new_timedisc(Timedisc, Mesh, Physics, config, IO)
container class to manage the list of source terms