sources_generic.f90

Go to the documentation of this file.

!#############################################################################
!#                                                                           #
!# fosite - 3D hydrodynamical simulation program                             #
!# module: mesh_generic.f90                                                  #
!#                                                                           #
!# Copyright (C) 2016-2018                                                   #
!# Manuel Jung <mjung@astrophysik.uni-kiel.de>                               #
!#                                                                           #
!# This program is free software; you can redistribute it and/or modify      #
!# it under the terms of the GNU General Public License as published by      #
!# the Free Software Foundation; either version 2 of the License, or (at     #
!# your option) any later version.                                           #
!#                                                                           #
!# This program is distributed in the hope that it will be useful, but       #
!# WITHOUT ANY WARRANTY; without even the implied warranty of                #
!# MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE, GOOD TITLE or        #
!# NON INFRINGEMENT.  See the GNU General Public License for more            #
!# details.                                                                  #
!#                                                                           #
!# You should have received a copy of the GNU General Public License         #
!# along with this program; if not, write to the Free Software               #
!# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.                 #
!#                                                                           #
!#############################################################################
!----------------------------------------------------------------------------!
!----------------------------------------------------------------------------!
MODULE sources_generic_mod
  USE sources_base_mod
  USE sources_c_accel_mod
  USE sources_diskcooling_mod
  USE sources_gravity_mod
  USE sources_rotframe_mod
  USE sources_shearbox_mod
  USE sources_viscosity_mod
  USE mesh_base_mod
  USE fluxes_base_mod
  USE physics_base_mod
  USE common_dict

CONTAINS

  SUBROUTINE new_sources(this,Mesh,Fluxes,Physics,config,IO)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(sources_base), POINTER :: this
    CLASS(mesh_base)             :: Mesh
    CLASS(fluxes_base)           :: Fluxes
    CLASS(physics_base)          :: Physics
    TYPE(DICT_TYP),      POINTER :: config, IO
    !------------------------------------------------------------------------!
    CLASS(sources_base), POINTER :: newsrc => null(), tmpsrc => null()
    TYPE(Dict_TYP),      POINTER :: dir,src,IOsrc,gsrc => null(),gdir => null()
    INTEGER                      :: update_disk_height = 0
    INTEGER                      :: stype
    !------------------------------------------------------------------------!
    IF (.NOT.physics%Initialized().OR..NOT.mesh%Initialized()) &
         CALL this%Error("InitSources","physics and/or mesh module uninitialized")

    dir => config
    DO WHILE(ASSOCIATED(dir))
      NULLIFY(iosrc)
      IF(haschild(dir)) THEN
        src => getchild(dir)
        CALL getattr(src, "stype", stype)

        ! object creation
        SELECT CASE(stype)
        CASE(gravity)
           ! skip initialization of gravity modules here and initialize them
           ! at the end to make sure gravity is the first source term in the list
           gsrc => src
           gdir => dir
           newsrc => null()
        CASE(c_accel)
          ALLOCATE(sources_c_accel::newsrc)
        CASE(disk_cooling)
          ALLOCATE(sources_diskcooling::newsrc)
        CASE(rotating_frame)
          ALLOCATE(sources_rotframe::newsrc)
        CASE(shearbox)
          ALLOCATE(sources_shearbox::newsrc)
        CASE(viscosity)
          ALLOCATE(sources_viscosity::newsrc)
        CASE DEFAULT
          CALL this%Error("new_sources","Unknown source type")
        END SELECT

        ! basic initialization of all source terms except gravity
        IF (ASSOCIATED(newsrc)) THEN
          SELECT TYPE(obj => newsrc)
          TYPE IS (sources_c_accel)
            CALL obj%InitSources_c_accel(mesh,physics,fluxes,src,iosrc)
          TYPE IS (sources_diskcooling)
            CALL obj%InitSources_diskcooling(mesh,physics,fluxes,src,iosrc)
            IF (obj%cooling%GetType().EQ.gray) update_disk_height = 1
          TYPE IS (sources_rotframe)
            CALL obj%InitSources_rotframe(mesh,physics,fluxes,src,iosrc)
          TYPE IS (sources_shearbox)
            CALL obj%InitSources_shearbox(mesh,physics,fluxes,src,iosrc)
          TYPE IS (sources_viscosity)
            CALL obj%InitSources_viscosity(mesh,physics,fluxes,src,iosrc)
            IF (obj%viscosity%GetType().EQ.alpha_alt) update_disk_height = 1
          END SELECT
          ! check if list of source terms is empty
          IF (.NOT.ASSOCIATED(this)) THEN
            ! first entry is the new source term
            this => newsrc
            NULLIFY(this%next)
          ELSE
            ! prepend new source term to the list of source terms
            tmpsrc => this
            this => newsrc
            this%next => tmpsrc
          END IF
        END IF

        ! process the output dictionary
        IF(ASSOCIATED(iosrc)) CALL setattr(io, getkey(dir), iosrc)

      END IF
      dir => getnext(dir)
    END DO

    ! finally initialize gravity
    IF(ASSOCIATED(gsrc)) THEN
      NULLIFY(iosrc)
      ALLOCATE(sources_gravity::newsrc)

      tmpsrc => this
      this => newsrc
      this%next => tmpsrc

      CALL setattr(gsrc,"update_disk_height", update_disk_height)
      SELECT TYPE(obj => newsrc)
      TYPE IS(sources_gravity)
        CALL obj%InitSources_gravity(mesh,physics,fluxes,gsrc,iosrc)
      END SELECT

      IF(ASSOCIATED(iosrc)) CALL setattr(io, getkey(gdir), iosrc)
    END IF

  END SUBROUTINE new_sources

  SUBROUTINE destroy_sources(this)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(sources_base), POINTER :: this
    !------------------------------------------------------------------------!
    CLASS(sources_base), POINTER :: srcptr
    !------------------------------------------------------------------------!
    ! loop over all source terms and call finalization subroutines
    IF (ASSOCIATED(this)) THEN
      CALL this%Finalize_base()
      DO
        srcptr => this
        IF (.NOT.ASSOCIATED(srcptr)) EXIT
        this => srcptr%next
        CALL srcptr%Finalize()
        DEALLOCATE(srcptr)
      END DO
    END IF
  END SUBROUTINE destroy_sources

END MODULE sources_generic_mod