marray_cellvector.f90

Go to the documentation of this file.

!#############################################################################
!#                                                                           #
!# fosite - 3D hydrodynamical simulation program                             #
!# module: marray_cellvector.f90                                             #
!#                                                                           #
!# Copyright (C) 2018,2021                                                   #
!# Tobias Illenseer <tillense@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 marray_cellvector_mod
  USE marray_base_mod
  IMPLICIT NONE
  !--------------------------------------------------------------------------!
  PRIVATE
  TYPE, EXTENDS(marray_base) :: marray_cellvector
    REAL, DIMENSION(:,:,:,:), POINTER &
                             :: center => null(), &      
                                bcenter => null()        
 
    REAL, DIMENSION(:,:,:,:,:), POINTER &
                             :: faces => null(), &       
                                corners => null()        
    CONTAINS
    PROCEDURE :: assignpointers
    final     :: finalize
  END TYPE
  INTERFACE marray_cellvector
    MODULE PROCEDURE createmarray_cellvector
  END INTERFACE
  !--------------------------------------------------------------------------!
  PUBLIC :: marray_cellvector
 
CONTAINS
 
  FUNCTION createmarray_cellvector() RESULT(new_cv)
    IMPLICIT NONE
    !-------------------------------------------------------------------!
    TYPE(marray_cellvector) :: new_cv
    !-------------------------------------------------------------------!
#if DEBUG > 2
    print *,"DEBUG INFO in marray_cellvector::CreateMArray_cellvector: new cellvector"
#endif
    ! 1 center + 1 bcenter + 6 faces + 8 corners = 16
    IF (new_cv%Init(16,3)) return ! immediately return if successful
#ifdef DEBUG
    print *,"ERROR in marray_cellvector::CreateMArray: cellvector initialization failed"
    stop 1
#endif
  END FUNCTION createmarray_cellvector
  
  FUNCTION assignpointers(this) RESULT(success)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(marray_cellvector),INTENT(INOUT) :: this
    LOGICAL :: success
    !------------------------------------------------------------------------!
#if DEBUG > 2
    print *,"DEBUG INFO in marray_cellvector::AssignPointers: assigning pointers"
#endif
    success = this%marray_base%AssignPointers()
    ! assign array pointers
    IF (success) THEN
      this%center  => this%RemapBounds(this%data5d(:,:,:,1,:))
      this%bcenter => this%RemapBounds(this%data5d(:,:,:,2,:))
      this%faces   => this%RemapBounds(this%data5d(:,:,:,3:8,:))
      this%corners => this%RemapBounds(this%data5d(:,:,:,9:16,:))
#ifdef DEBUG
    ELSE
      print *,"ERROR in marray_cellvector::AssignPointers: pointer assignment failed"
#endif
    END IF
  END FUNCTION assignpointers
 
  SUBROUTINE finalize(this)
    IMPLICIT NONE
    !-------------------------------------------------------------------!
    TYPE(marray_cellvector) :: this
    !-------------------------------------------------------------------!
#if DEBUG > 2
    print *,"DEBUG INFO in marray_cellvector::Finalize: nullify pointers"
#endif
    NULLIFY(this%center,this%bcenter,this%faces,this%corners)
  END SUBROUTINE finalize
 
END MODULE marray_cellvector_mod