geometry_logcylindrical.f90

Go to the documentation of this file.

!#############################################################################
!#                                                                           #
!# fosite - 3D hydrodynamical simulation program                             #
!# module: geometry_logcylindrical.f90                                       #
!#                                                                           #
!# Copyright (C) 2007-2018                                                   #
!# Tobias Illenseer <tillense@astrophysik.uni-kiel.de>                       #
!# Jannes Klee <jklee@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 geometry_logcylindrical_mod
  USE geometry_base_mod
  USE geometry_cylindrical_mod, ONLY: geometry_cylindrical
  USE common_dict
  IMPLICIT NONE
  !--------------------------------------------------------------------------!
  TYPE, EXTENDS (geometry_cylindrical) :: geometry_logcylindrical
  CONTAINS
    PROCEDURE :: initgeometry_logcylindrical
    PROCEDURE :: scalefactors_1
    PROCEDURE :: scalefactors_2
    PROCEDURE :: scalefactors_3
    PROCEDURE :: scalefactors_4
    PROCEDURE :: radius_1
    PROCEDURE :: radius_2
    PROCEDURE :: radius_3
    PROCEDURE :: radius_4
    PROCEDURE :: positionvector_1
    PROCEDURE :: positionvector_2
    PROCEDURE :: positionvector_3
    PROCEDURE :: positionvector_4
    PROCEDURE :: convert2cartesian_coords_1
    PROCEDURE :: convert2cartesian_coords_2
    PROCEDURE :: convert2cartesian_coords_3
    PROCEDURE :: convert2cartesian_coords_4
    PROCEDURE :: convert2curvilinear_coords_1
    PROCEDURE :: convert2curvilinear_coords_2
    PROCEDURE :: convert2curvilinear_coords_3
    PROCEDURE :: convert2curvilinear_coords_4
    PROCEDURE :: finalize
  END TYPE
  PRIVATE
  CHARACTER(LEN=32), PARAMETER :: geometry_name = "logcylindrical"
  !--------------------------------------------------------------------------!
  PUBLIC :: geometry_logcylindrical
  !--------------------------------------------------------------------------!
 
CONTAINS
 
  SUBROUTINE initgeometry_logcylindrical(this,config)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(geometry_logcylindrical), INTENT(INOUT) :: this
    TYPE(dict_typ), POINTER                    :: config
    !------------------------------------------------------------------------!
    REAL :: gparam
    !------------------------------------------------------------------------!
    CALL getattr(config, "gparam", gparam, 1.0)
 
    CALL this%SetScale(gparam)
    CALL this%InitGeometry(logcylindrical,geometry_name,config)
    CALL this%SetAzimuthIndex(2)
  END SUBROUTINE initgeometry_logcylindrical
 
  PURE SUBROUTINE scalefactors_1(this,coords,hx,hy,hz)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(geometry_logcylindrical), INTENT(IN) :: this
    REAL, INTENT(IN),  DIMENSION(:,:) :: coords
    REAL, INTENT(OUT), DIMENSION(:)   :: hx,hy,hz
    !------------------------------------------------------------------------!
    CALL scalefactors(this%geoparam(1),coords(:,1),coords(:,2),coords(:,3),hx(:),hy(:),hz(:))
  END SUBROUTINE scalefactors_1
 
  PURE SUBROUTINE scalefactors_2(this,coords,hx,hy,hz)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(geometry_logcylindrical), INTENT(IN) :: this
    REAL, INTENT(IN),  DIMENSION(:,:,:) :: coords
    REAL, INTENT(OUT), DIMENSION(:,:)   :: hx,hy,hz
    !------------------------------------------------------------------------!
    CALL scalefactors(this%geoparam(1),coords(:,:,1),coords(:,:,2),coords(:,:,3), &
                      hx(:,:),hy(:,:),hz(:,:))
  END SUBROUTINE scalefactors_2
 
  PURE SUBROUTINE scalefactors_3(this,coords,hx,hy,hz)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(geometry_logcylindrical), INTENT(IN) :: this
    REAL, INTENT(IN),  DIMENSION(:,:,:,:) :: coords
    REAL, INTENT(OUT), DIMENSION(:,:,:)   :: hx,hy,hz
    !------------------------------------------------------------------------!
    CALL scalefactors(this%geoparam(1),coords(:,:,:,1),coords(:,:,:,2),coords(:,:,:,3), &
                      hx(:,:,:),hy(:,:,:),hz(:,:,:))
  END SUBROUTINE scalefactors_3
 
  PURE SUBROUTINE scalefactors_4(this,coords,hx,hy,hz)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(geometry_logcylindrical), INTENT(IN) :: this
    REAL, INTENT(IN),  DIMENSION(:,:,:,:,:) :: coords
    REAL, INTENT(OUT), DIMENSION(:,:,:,:)   :: hx,hy,hz
    !------------------------------------------------------------------------!
    CALL scalefactors(this%geoparam(1),coords(:,:,:,:,1),coords(:,:,:,:,2),coords(:,:,:,:,3), &
                      hx(:,:,:,:),hy(:,:,:,:),hz(:,:,:,:))
  END SUBROUTINE scalefactors_4
 
  PURE SUBROUTINE radius_1(this,coords,r)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(geometry_logcylindrical), INTENT(IN) :: this
    REAL, DIMENSION(:,:), INTENT(IN) :: coords
    REAL, DIMENSION(:),  INTENT(OUT) :: r
    !------------------------------------------------------------------------!
    r = radius(this%geoparam(1),coords(:,1),coords(:,3))
  END SUBROUTINE radius_1
 
  PURE SUBROUTINE radius_2(this,coords,r)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(geometry_logcylindrical), INTENT(IN) :: this
    REAL, DIMENSION(:,:,:), INTENT(IN) :: coords
    REAL, DIMENSION(:,:),  INTENT(OUT) :: r
    !------------------------------------------------------------------------!
    r = radius(this%geoparam(1),coords(:,:,1),coords(:,:,3))
  END SUBROUTINE radius_2
 
  PURE SUBROUTINE radius_3(this,coords,r)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(geometry_logcylindrical), INTENT(IN) :: this
    REAL, DIMENSION(:,:,:,:), INTENT(IN) :: coords
    REAL, DIMENSION(:,:,:),  INTENT(OUT) :: r
    !------------------------------------------------------------------------!
    r = radius(this%geoparam(1),coords(:,:,:,1),coords(:,:,:,3))
  END SUBROUTINE radius_3
 
  PURE SUBROUTINE radius_4(this,coords,r)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(geometry_logcylindrical), INTENT(IN) :: this
    REAL, DIMENSION(:,:,:,:,:), INTENT(IN) :: coords
    REAL, DIMENSION(:,:,:,:),  INTENT(OUT) :: r
    !------------------------------------------------------------------------!
    r = radius(this%geoparam(1),coords(:,:,:,:,1),coords(:,:,:,:,3))
  END SUBROUTINE radius_4
 
  PURE SUBROUTINE positionvector_1(this,coords,posvec)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(geometry_logcylindrical), INTENT(IN)  :: this
    REAL, DIMENSION(:,:), INTENT(IN)  :: coords
    REAL, DIMENSION(:,:), INTENT(OUT) :: posvec
    !------------------------------------------------------------------------!
    CALL positionvector(this%geoparam(1),coords(:,1),coords(:,3),posvec(:,1), &
                        posvec(:,2),posvec(:,3))
  END SUBROUTINE positionvector_1
 
  PURE SUBROUTINE positionvector_2(this,coords,posvec)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(geometry_logcylindrical), INTENT(IN)  :: this
    REAL, DIMENSION(:,:,:), INTENT(IN)  :: coords
    REAL, DIMENSION(:,:,:), INTENT(OUT) :: posvec
    !------------------------------------------------------------------------!
    CALL positionvector(this%geoparam(1),coords(:,:,1),coords(:,:,3), &
                        posvec(:,:,1),posvec(:,:,2),posvec(:,:,3))
  END SUBROUTINE positionvector_2
 
  PURE SUBROUTINE positionvector_3(this,coords,posvec)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(geometry_logcylindrical), INTENT(IN)  :: this
    REAL, DIMENSION(:,:,:,:), INTENT(IN)  :: coords
    REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: posvec
    !------------------------------------------------------------------------!
    CALL positionvector(this%geoparam(1),coords(:,:,:,1),coords(:,:,:,3), &
                        posvec(:,:,:,1),posvec(:,:,:,2),posvec(:,:,:,3))
  END SUBROUTINE positionvector_3
 
  PURE SUBROUTINE positionvector_4(this,coords,posvec)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(geometry_logcylindrical), INTENT(IN)  :: this
    REAL, DIMENSION(:,:,:,:,:), INTENT(IN)  :: coords
    REAL, DIMENSION(:,:,:,:,:), INTENT(OUT) :: posvec
    !------------------------------------------------------------------------!
    CALL positionvector(this%geoparam(1),coords(:,:,:,:,1),coords(:,:,:,:,3), &
                        posvec(:,:,:,:,1),posvec(:,:,:,:,2),posvec(:,:,:,:,3))
  END SUBROUTINE positionvector_4
 
  PURE SUBROUTINE convert2cartesian_coords_1(this,curv,cart)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(geometry_logcylindrical), INTENT(IN) :: this
    REAL, DIMENSION(:,:), INTENT(IN)  :: curv
    REAL, DIMENSION(:,:), INTENT(OUT) :: cart
    !------------------------------------------------------------------------!
    CALL convert2cartesian_coords(this%geoparam(1),curv(:,1),curv(:,2),curv(:,3), &
                                  cart(:,1),cart(:,2),cart(:,3))
  END SUBROUTINE convert2cartesian_coords_1
 
  PURE SUBROUTINE convert2cartesian_coords_2(this,curv,cart)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(geometry_logcylindrical), INTENT(IN) :: this
    REAL, DIMENSION(:,:,:), INTENT(IN)  :: curv
    REAL, DIMENSION(:,:,:), INTENT(OUT) :: cart
    !------------------------------------------------------------------------!
    CALL convert2cartesian_coords(this%geoparam(1),curv(:,:,1),curv(:,:,2),curv(:,:,3), &
                                  cart(:,:,1),cart(:,:,2),cart(:,:,3))
  END SUBROUTINE convert2cartesian_coords_2
 
  PURE SUBROUTINE convert2cartesian_coords_3(this,curv,cart)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(geometry_logcylindrical), INTENT(IN) :: this
    REAL, DIMENSION(:,:,:,:), INTENT(IN)  :: curv
    REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: cart
    !------------------------------------------------------------------------!
    CALL convert2cartesian_coords(this%geoparam(1),curv(:,:,:,1),curv(:,:,:,2),curv(:,:,:,3), &
                                  cart(:,:,:,1),cart(:,:,:,2),cart(:,:,:,3))
  END SUBROUTINE convert2cartesian_coords_3
 
  PURE SUBROUTINE convert2cartesian_coords_4(this,curv,cart)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(geometry_logcylindrical), INTENT(IN) :: this
    REAL, DIMENSION(:,:,:,:,:), INTENT(IN)  :: curv
    REAL, DIMENSION(:,:,:,:,:), INTENT(OUT) :: cart
    !------------------------------------------------------------------------!
    CALL convert2cartesian_coords(this%geoparam(1),curv(:,:,:,:,1),curv(:,:,:,:,2),curv(:,:,:,:,3), &
                                  cart(:,:,:,:,1),cart(:,:,:,:,2),cart(:,:,:,:,3))
  END SUBROUTINE convert2cartesian_coords_4
 
  PURE SUBROUTINE convert2curvilinear_coords_1(this,cart,curv)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(geometry_logcylindrical), INTENT(IN) :: this
    REAL, DIMENSION(:,:), INTENT(IN)  :: cart
    REAL, DIMENSION(:,:), INTENT(OUT) :: curv
    !------------------------------------------------------------------------!
    CALL convert2curvilinear_coords(this%geoparam(1),cart(:,1),cart(:,2),cart(:,3), &
                                    curv(:,1),curv(:,2),curv(:,3))
  END SUBROUTINE convert2curvilinear_coords_1
 
  PURE SUBROUTINE convert2curvilinear_coords_2(this,cart,curv)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(geometry_logcylindrical), INTENT(IN) :: this
    REAL, DIMENSION(:,:,:), INTENT(IN)  :: cart
    REAL, DIMENSION(:,:,:), INTENT(OUT) :: curv
    !------------------------------------------------------------------------!
    CALL convert2curvilinear_coords(this%geoparam(1),cart(:,:,1),cart(:,:,2),cart(:,:,3), &
                                    curv(:,:,1),curv(:,:,2),curv(:,:,3))
  END SUBROUTINE convert2curvilinear_coords_2
 
  PURE SUBROUTINE convert2curvilinear_coords_3(this,cart,curv)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(geometry_logcylindrical), INTENT(IN) :: this
    REAL, DIMENSION(:,:,:,:), INTENT(IN)  :: cart
    REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: curv
    !------------------------------------------------------------------------!
    CALL convert2curvilinear_coords(this%geoparam(1),cart(:,:,:,1),cart(:,:,:,2),cart(:,:,:,3), &
                                    curv(:,:,:,1),curv(:,:,:,2),curv(:,:,:,3))
  END SUBROUTINE convert2curvilinear_coords_3
 
  PURE SUBROUTINE convert2curvilinear_coords_4(this,cart,curv)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(geometry_logcylindrical), INTENT(IN) :: this
    REAL, DIMENSION(:,:,:,:,:), INTENT(IN)  :: cart
    REAL, DIMENSION(:,:,:,:,:), INTENT(OUT) :: curv
    !------------------------------------------------------------------------!
    CALL convert2curvilinear_coords(this%geoparam(1),cart(:,:,:,:,1),cart(:,:,:,:,2),cart(:,:,:,:,3), &
                                    curv(:,:,:,:,1),curv(:,:,:,:,2),curv(:,:,:,:,3))
  END SUBROUTINE convert2curvilinear_coords_4
 
  SUBROUTINE finalize(this)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(geometry_logcylindrical), INTENT(INOUT) :: this
    !------------------------------------------------------------------------!
    CALL this%Finalize_base()
  END SUBROUTINE finalize
 
  ELEMENTAL SUBROUTINE scalefactors(gp,logr,phi,z,hlogr,hphi,hz)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    REAL, INTENT(IN)  :: gp,logr,phi,z
    REAL, INTENT(OUT) :: hlogr,hphi,hz
    !------------------------------------------------------------------------!
    hlogr = gp*exp(logr)
    hphi  = hlogr
    hz    = 1.
  END SUBROUTINE scalefactors
 
  ELEMENTAL FUNCTION radius(gp,logr,z)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    REAL, INTENT(IN)  :: gp,logr,z
    REAL :: radius
    !------------------------------------------------------------------------!
    REAL :: r
    !------------------------------------------------------------------------!
    r = gp*exp(logr)
    radius = sqrt(r*r+z*z)
  END FUNCTION radius
 
  ELEMENTAL SUBROUTINE positionvector(gp,logr,z,rx,ry,rz)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    REAL, INTENT(IN)  :: gp,logr,z
    REAL, INTENT(OUT) :: rx,ry,rz
    !------------------------------------------------------------------------!
    rx = radius(gp,logr,z)
    ry = 0.0
    rz = z
  END SUBROUTINE positionvector
 
  ELEMENTAL SUBROUTINE convert2cartesian_coords(gp,logr,phi,zz,x,y,z)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    REAL, INTENT(IN)  :: gp,logr,phi,zz
    REAL, INTENT(OUT) :: x,y,z
    !------------------------------------------------------------------------!
    REAL :: r
    !------------------------------------------------------------------------!
    r = gp*exp(logr)
    x = r*cos(phi)
    y = r*sin(phi)
    z = zz
  END SUBROUTINE convert2cartesian_coords
 
  ELEMENTAL SUBROUTINE convert2curvilinear_coords(gp,x,y,z,logr,phi,zz)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    REAL, INTENT(IN)  :: gp,x,y,z
    REAL, INTENT(OUT) :: logr,phi,zz
    !------------------------------------------------------------------------!
    REAL :: x_,y_
    !------------------------------------------------------------------------!
    x_ = x/gp
    y_ = y/gp
    logr = 0.5*log(x_*x_+y_*y_)
    phi = atan2(y_,x_)
    IF (phi.LT.0.0) THEN
      phi = phi + 2.0*pi
    END IF
    zz = z
  END SUBROUTINE convert2curvilinear_coords
 
END MODULE geometry_logcylindrical_mod