A First Setup

The Structure

Below you can see the structure of an initialization file. The program loads the fosite module, declares some parameters and starts fosite. In order to do the latter the configuration needs to be build and the initial data needs to be set. This generally happens in the subroutines MakeConfig and InitData.

PROGRAM foo
! 1. load fosite
...
! 2. make some declarations
...
! 3. configure (MakeConfig), initialize (InitData) and run fosite
...
! 4. configure your setup
SUBROUTINE makeconfig
...
END SUBROUTINE
! 5. set the initial data
SUBROUTINE initdata
...
END SUBROUTINE initdata
END PROGRAM FOO

In order to get in touch with Fosite we use the Rayleigh-Taylor-instabilities in the following as an easy example case.

A Detailed Example

The Header

  1. In the very beginning all necessary modules need to be loaded. The module fosite_mod from fosite.f03 includes the subroutines to start fosite. It also includes common_dict, which provides a dictionary structure for generic data types.
  2. The second part of the header is the typical declaration section. Here the parameters for the setup can be declared, which are needed below in the configuration or initial data field. Some typical things that are always necessary are, e.g., the resolution and the field size or the output setup. This part can strongly vary according to your needs. Additionally a fosite object needs to be declared as allocatable. This is mandatory, since it is the main class which hosts all other classes, like sources, timedisc, ... . The whole configuration is also saved here.
  3. To finally run Fosite there is a fixed order of subroutines, which need to be called. They are mainly part of the fosite module. However, two very important subroutines need to be written on your own
    1. The MakeConfig: This is a dictionary which saves all the settings in one directory like the geometry and the resolution, the output and of course the source modules that are needed.
    2. The InitData: Here the initial data will be declared, which can be something very easy like a constant background density and velocity field or very complicated things, which might bring you in need to add additional routines in order to set up the initial data. In the next two parts we will discuss these two subroutines in detail.
PROGRAM rti
!------------------------------------------------------------------------!
! 1. load generic modules !
!------------------------------------------------------------------------!
USE fosite_mod ! main module, subrout. to run fosite, etc.!
!------------------------------------------------------------------------!
! 2. make some declarations !
!------------------------------------------------------------------------!
! simulation parameters
REAL, PARAMETER :: TSIM = 10.0 ! simulation time !
REAL, PARAMETER :: DYNVIS = 0.0 ! dynamic viscosity constant !
REAL, PARAMETER :: BULKVIS = 0.0 ! bulk viscosity constant !
! initial condition (SI units)
REAL, PARAMETER :: RHO0 = 2.0 ! density: upper region !
REAL, PARAMETER :: RHO1 = 1.0 ! density: lower region !
REAL, PARAMETER :: YACC = 0.2 ! grav. acceleration !
REAL, PARAMETER :: P0 = 1.2 ! pressure at the top !
REAL, PARAMETER :: A0 = 0.02 ! amplitude of init. disturbance !
! mesh settings
INTEGER, PARAMETER :: XRES = 50 ! resolution in x !
INTEGER, PARAMETER :: YRES = 100 ! resolution in y !
INTEGER, PARAMETER :: ZRES = 1 ! resolution in z !
REAL, PARAMETER :: WIDTH = 1.0 ! width of comp. domain !
REAL, PARAMETER :: HEIGHT = 2.0 ! height of comp. domaina !
! output parameters
INTEGER, PARAMETER :: ONUM = 10 ! number of output data sets !
CHARACTER(LEN=256), PARAMETER &
:: ODIR = './' ! output data dir !
CHARACTER(LEN=256), PARAMETER &
:: OFNAME = 'RTI' ! output data file name !
!------------------------------------------------------------------------!
CLASS(fosite), ALLOCATABLE :: Sim
!------------------------------------------------------------------------!
!------------------------------------------------------------------------!
! 3. configure (run MakeConfig), initialize (run InitData) and run fosite!
!------------------------------------------------------------------------!
ALLOCATE(sim) ! allocate fosite object !
CALL sim%InitFosite() ! initialize Fosite !
CALL makeconfig(sim, sim%config) ! build the dictionary !
!CALL PrintDict(config) ! print the dictionary setup !
CALL sim%Setup() ! uses the config for setup !
! initialize the passive (pvar) & conservative variables (cvar)
CALL initdata(sim%Mesh, sim%Physics, sim%Timedisc%pvar, sim%Timedisc%cvar)
CALL sim%Run() ! MAIN part: runs Fosite !
CALL sim%Finalize() ! comp. runtime, deallocation !
DEALLOCATE(sim)
! This module is delivering the configuration dictionary "config"
! and is explained detail further below
SUBROUTINE makeconfig(Sim,config)
...
END SUBROUTINE
! This module is setting the initial primitive variables "pvar" and
! the conservative variables "cvar" and is explained further below
SUBROUTINE initdata(Mesh,Physics,pvar,cvar)
...
END SUBROUTINE
END PROGRAM

Configuration Dictionary

At the end of the section you can see the whole MakeConfig subroutine. It gives back a dictionary, which is called config (see common_dict for details). There, all important settings for the simulation are stored and they are also written out to the data (depending on your output format). config itself is just a collection of dictionaries, where each ones handles a different field of numerics or physics. The syntax is mostly self-explaining. The dictionaries are of the form

dictionary_name => dict("key1" / value1, "key2" / value2, ...)

You can store anything you want in the dictionaries. However, the keys that make sense are different for every module you might use.

As an example we take the first created dictionary mesh:

mesh => dict( &
"meshtype" / midpoint, & ! use midpoint rule !
"geometry" / cartesian, & ! cartesian grid !
"inum" / xres, & ! resolution in x-direction !
"jnum" / yres, & ! resolution in y-direction !
"knum" / zres, & ! resolution in z-direction !
"xmin" / 0., & ! minimum value in x-dir. !
"xmax" / width, & ! maximum value in x-dir. !
"ymin" / 0., & ! minimum value in y-dir. !
"ymax" / height, & ! maximum value in y-dir. !
"zmin" / 0., & ! minimum value in z-dir. !
"zmax" / 0.) ! maximum value in z-dir. !

The class mesh says to approximate the flux integrals with the midpoint rule. For the key geometry you can chose between a wide variety of models, but here we use the easiest case of an cartesian geometry. Thus the geometry class is included in the mesh class.

Additionally you need to add some optional or necessary parameters, like in this case the resolution and the fieldsize. The available keys can be looked up at the module overview in the html pages. Alternatively you need to look into the code of the derived type directly and search for the GetAttr() calls. At these positions the dictionaries are read out, which is always done in the initialization routines of every class or subclass.

The order of the dictionaries is not always arbitrary. For example, in order to define the sources dictionary, you need first to define dictionaries for the specific sources. In our case below, we have a constant acceleration and a viscosity. These have its own parameters. Eventually, these dictionaries are included in the overall sources dictionary. If you want to try out a test simulation without a certain source, you can just comment out the part, like shown for the viscosity source term in our case. Finally, all dictionaries are collected and stored in config. This dictionary is passed through the routines in order to have the full configuration at hand.

The output is also controlled by a dictionary. In fileformat you can chose the way the output should look like. The recommanded output is XDMF or VTK*. These are readable by common viewers like Paraview or VisIt. An alternative dictionary compared to the one below could look like

datafile => dict( &
"fileformat" / xdmf, &
"filepath" / trim('./'), &
"filename" / trim('RTI_modified'), &
"count" / 100)

Additonal parameters can be written out by setting the keys in the relating dictionaries. These are normally of the form "output/variable" with value 1 (yes) or 0 (no). For example the key/value pair *"output/volume" / 1* could be written in the mesh-dictionary in order to write out the volume of the cells.

Finally, the whole configuration subroutine could look like this:

SUBROUTINE makeconfig(Sim, config)
IMPLICIT NONE
!------------------------------------------------------------------------!
CLASS(fosite), INTENT(INOUT) :: Sim
TYPE(Dict_TYP), POINTER :: config
!------------------------------------------------------------------------!
TYPE(Dict_TYP), POINTER :: mesh, physics, boundary, datafile, logfile, &
sources, timedisc, fluxes, caccel, vis
!------------------------------------------------------------------------!
! mesh settings
mesh => dict( &
"meshtype" / midpoint, & ! use midpoint rule !
"geometry" / cartesian, & ! cartesian grid !
"inum" / xres, & ! resolution in x-direction !
"jnum" / yres, & ! resolution in y-direction !
"xmin" / 0., & ! minimum value in x-dir. !
"xmax" / width, & ! maximum value in x-dir. !
"ymin" / 0., & ! minimum value in y-dir. !
"ymax" / height, & ! maximum value in y-dir. !
"zmin" / 0., & ! minimum value in z-dir. !
"zmax" / 0.) ! maximum value in z-dir. !
! physics settings
physics => dict( &
"problem" / euler2d, & ! standard 2D hydrodynamics !
"gamma" / 1.4) ! ratio of specific heats !
! flux calculation and reconstruction method
fluxes => dict( &
"fluxtype" / kt, & ! use Kurganov-Tadmor flux !
"order" / linear, & ! linear reconstruction !
"variables" / conservative, & ! vars. for reconstruction !
"limiter" / monocent, & ! type of the limiter !
"theta" / 1.2) ! optional param. for MC !
! boundary conditions
boundary => dict( &
"western" / reflecting, & ! reflecting boundary cond. !
"eastern" / reflecting, & ! reflecting boundary cond. !
"southern" / reflecting, & ! reflecting boundary cond. !
"northern" / reflecting, & ! reflecting boundary cond. !
"southern" / reflecting, & ! reflecting boundary cond. !
"northern" / reflecting) ! reflecting boundary cond. !
! c-acceleration term
caccel => dict( &
"stype" / c_accel, & ! source 1: acceleration !
"yaccel" / (-yacc)) ! constant acc.in y-dir. !
! viscosity source term
vis => dict( &
"stype" / viscosity, & ! viscosity source !
"vismodel" / molecular, & ! visc. model: molecular !
"dynconst" / dynvis, & ! const. dynamic viscosity !
"bulkconst" / bulkvis) ! const. bulk viscosity !
! collect sources in dictionary
sources => dict( &
! "vis" / vis, & ! incl. visc. from above !
"caccel" / caccel) ! incl. accel. from above !
IF ((dynvis.GT.tiny(dynvis)).OR.(bulkvis.GT.tiny(bulkvis))) &
CALL setattr(sources, "vis", vis)
! time discretization settings
timedisc => dict( &
"method" / modified_euler, &! use modified euler !
"order" / 3, & ! third order accuracy !
"cfl" / 0.4, & ! courant-number !
"stoptime" / tsim, & ! simulation stop-time !
"dtlimit" / 1.0e-4, & ! smallest allowed timestep !
"maxiter" / 100000) ! max. iters before abort !
! initialize data input/output
datafile => dict( &
"fileformat" / vtk, ! VTK output !
"filename" / (trim(odir) // trim(ofname)), & ! filepath !
"count" / onum) ! number of outputs !
! collect all above dicts in the configuration dict
config => dict( &
"mesh" / mesh, & ! all mesh-settings !
"physics" / physics, & ! all physics settings !
"boundary" / boundary, & ! all bounary settings !
"fluxes" / fluxes, & ! all fluxes settings !
"sources" / sources, & ! all sources !
"timedisc" / timedisc, & ! all timedisc settings !
"logfile" / logfile, & ! all logfile settings !
"datafile" / datafile) ! all input/output settings !
END SUBROUTINE MakeConfig

Set Initial Data

The last thing to do is to set up the initial data. The easiest way is to define the known primitive variables pvar on the whole domain. At the end of the initialization you can observe these two routines:

CALL Physics%Convert2Conservative(Mesh,pvar,cvar)
CALL Mesh%Info(" DATA-----> initial condition: " // &
"rayleighâ“Taylor instability")€“taylor instability

The first line is converting the primitive variable to conservative ones in order to store a full set of parameters in the beginning. This call is necessary. The second is an info-call for your later logfiles. Here you can write down a reasonable description for your initial conditions.

SUBROUTINE initdata(Mesh,Physics,pvar,cvar)
IMPLICIT NONE
!------------------------------------------------------------------------!
TYPE(Physics_TYP) :: Physics
TYPE(Mesh_TYP) :: Mesh
REAL, DIMENSION(Mesh%IGMIN:Mesh%IGMAX,Mesh%JGMIN:Mesh%JGMAX,Mesh%KGMIN:Mesh%KGMAX,Physics%VNUM)&
:: pvar,cvar
!------------------------------------------------------------------------!
! Local variable declaration
REAL, DIMENSION(Mesh%IGMIN:Mesh%IGMAX,Mesh%JGMIN:Mesh%JGMAX,Mesh%KGMIN:Mesh%KMGMAX):: y0
!------------------------------------------------------------------------!
INTENT(IN) :: mesh, physics
INTENT(OUT) :: pvar, cvar
!------------------------------------------------------------------------!
! this marks the line between the two fluids
y0(:,:,:) = 0.5*mesh%ymax + a0*cos(2*pi*mesh%bcenter(:,:,:,1)/mesh%xmax)
! initial hydrostatic stratification
WHERE (mesh%bcenter(:,:,:,2).GT.y0(:,:,:))
! upper fluid
pvar(:,:,:,physics%DENSITY) = rho0
pvar(:,:,:,physics%PRESSURE) = p0 + yacc * rho0 * (mesh%ymax-mesh%bcenter(:,:,:,2))
ELSEWHERE
! lower fluid
pvar(:,:,:,physics%DENSITY) = rho1
pvar(:,:,:,physics%PRESSURE) = p0 + yacc * (rho1 * (y0(:,:,:)-mesh%bcenter(:,:,:,2)) &
+ rho0 * (mesh%ymax-y0(:,:,:)))
END WHERE
! velocity vanishes everywhere
pvar(:,:,:,physics%XVELOCITY:physics%YVELOCITY) = 0.
CALL physics%Convert2Conservative(mesh,pvar,cvar)
CALL mesh%Info(" DATA-----> initial condition: " // &
"Rayleigh–Taylor instability")
END SUBROUTINE InitData

Additional Resources

There are lots of other examples, where you can find inspiration for different initializations. Especially, if you want to know how to include gravitational source terms have a look at a self-graviting disk.