Rocburn_load_module.f90

Go to the documentation of this file.

! *********************************************************************
! * Rocstar Simulation Suite                                          *
! * Copyright@2015, Illinois Rocstar LLC. All rights reserved.        *
! *                                                                   *
! * Illinois Rocstar LLC                                              *
! * Champaign, IL                                                     *
! * www.illinoisrocstar.com                                           *
! * sales@illinoisrocstar.com                                         *
! *                                                                   *
! * License: See LICENSE file in top level of distribution package or *
! * http://opensource.org/licenses/NCSA                               *
! *********************************************************************
! *********************************************************************
! * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,   *
! * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES   *
! * OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND          *
! * NONINFRINGEMENT.  IN NO EVENT SHALL THE CONTRIBUTORS OR           *
! * COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER       *
! * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,   *
! * Arising FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE    *
! * USE OR OTHER DEALINGS WITH THE SOFTWARE.                          *
! *********************************************************************
!
! ---------------------------------------------------------------------------
!
!  Purpose: Registering subroutines of ROCBURN with Roccom. This (hopefully)
!           is the only file need to be changed to add another 1D model.
!
!  Author:            X. Jiao
!
!  Creation Date:     Aug. 30, 2002
!
!  Modifications:
!
!    No.     Date         Programmer    Description
!
! ---------------------------------------------------------------------------
!

MODULE m_init_1dmodules
  USE m_rocburn_2d
  IMPLICIT NONE

  INTERFACE 
     SUBROUTINE com_set_data( attr, ptr)  ! Must be explicitly declared here
       USE m_rocburn_interface_data
       CHARACTER(*), INTENT(IN)   :: attr
       EXTERNAL  ptr
     END SUBROUTINE com_set_data
  END INTERFACE

CONTAINS  

!
! The following subroutines registers subroutines of indiviudal 1-D burning 
!   rate model to Roccom. Rocman calls corresponding subroutine
!   related to the burning rate model used.
!

  SUBROUTINE rocburn_init_funcs_apn( mname) 
    USE m_rocburn_1d_apn
    CHARACTER(*), INTENT(IN) :: mname
    
    CALL com_set_external( mname//".init_0d", 0, initialize_0d)
    CALL com_set_external( mname//".init_1d", 0, initialize_1d)
    CALL com_set_external( mname//".finalize_0d", 0, finalize_0d)
    CALL com_set_external( mname//".get_burn_rate", 0, get_burning_rate_1d)

  END SUBROUTINE rocburn_init_funcs_apn

  SUBROUTINE rocburn_init_funcs_py( mname) 
    USE m_rocburn_1d_py
    CHARACTER(*), INTENT(IN) :: mname

    CALL com_set_external( mname//".init_0d", 0, initialize_0d)
    CALL com_set_external( mname//".init_1d", 0, initialize_1d)
    CALL com_set_external( mname//".finalize_0d", 0, finalize_0d)
    CALL com_set_external( mname//".get_film_coeff", 0, get_film_coeff_1d)
    CALL com_set_external( mname//".get_time_step", 0, get_time_step_1d)
    CALL com_set_external( mname//".get_burn_rate", 0, get_burning_rate_1d)

  END SUBROUTINE rocburn_init_funcs_py

  SUBROUTINE rocburn_init_funcs_zn( mname) 
    USE m_rocburn_1d_zn
    CHARACTER(*), INTENT(IN) :: mname

    CALL com_set_external( mname//".init_0d", 0, initialize_0d)
    CALL com_set_external( mname//".init_1d", 0, initialize_1d)
    CALL com_set_external( mname//".finalize_0d", 0, finalize_0d)
    CALL com_set_external( mname//".get_film_coeff", 0, get_film_coeff_1d)
    CALL com_set_external( mname//".get_time_step", 0, get_time_step_1d)
    CALL com_set_external( mname//".get_burn_rate", 0, get_burning_rate_1d)

  END SUBROUTINE rocburn_init_funcs_zn
END MODULE m_init_1dmodules

SUBROUTINE rocburn_load_module( module_name)

  USE m_init_1dmodules
  USE m_rocburn_interface_data, ONLY : associate_pointer
  IMPLICIT NONE
 
  CHARACTER(*), INTENT(IN)  :: module_name
  TYPE(list_block), POINTER :: g_b
  INTEGER                   :: types(7)

  INTERFACE 
     SUBROUTINE com_set_pointer( attr, ptr, asso)
       USE       m_rocburn_interface_data, ONLY : list_block
       CHARACTER(*), INTENT(IN) :: attr
       TYPE(list_block), POINTER :: ptr
       EXTERNAL asso
     END SUBROUTINE com_set_pointer
  END INTERFACE

  ALLOCATE( g_b)
  g_b%mname = module_name
  g_b%TBL_flag = no_tbl
  IF ( module_name == "RocburnAPN") THEN
     g_b%burn_model = model_apn
  ELSE IF ( module_name == "RocburnPY") THEN
     g_b%burn_model = model_py
  ELSE IF ( module_name == "RocburnZN") THEN
     g_b%burn_model = model_zn
  ELSE
     print *, "Rocburn-2D: Unknown module name", module_name
     print *, "Rocburn-2D: Use APN instead", module_name
     g_b%burn_model = model_apn
  END IF

  CALL com_new_window( module_name)
!!! Create an attribute for global data
  CALL com_new_attribute( module_name//".global", 'w', com_f90pointer, 1, '')
  CALL com_resize_array( module_name//".global")

  CALL com_new_attribute( module_name//".init_0d", 'w', com_void, 1, '')
  CALL com_new_attribute( module_name//".init_1d", 'w', com_void, 1, '')
  CALL com_new_attribute( module_name//".finalize_0d", 'w', com_void, 1, '')
  CALL com_new_attribute( module_name//".get_film_coeff", 'w', com_void, 1, '')
  CALL com_new_attribute( module_name//".get_time_step", 'w', com_void, 1, '')
  CALL com_new_attribute( module_name//".get_burn_rate", 'w', com_void, 1, '')

  CALL com_resize_array( module_name//".init_0d")
  CALL com_resize_array( module_name//".init_1d")
  CALL com_resize_array( module_name//".finalize_0d")
  CALL com_resize_array( module_name//".get_film_coeff")
  CALL com_resize_array( module_name//".get_time_step")
  CALL com_resize_array( module_name//".get_burn_rate")


!!! Now initialize the 1D module
  IF ( g_b%burn_model == model_py) THEN
     CALL rocburn_init_funcs_py( module_name)
  ELSE IF ( g_b%burn_model == model_zn) THEN
     CALL rocburn_init_funcs_zn( module_name)
  ELSE 
     CALL rocburn_init_funcs_apn( module_name)
  END IF
  
  types(1) = com_f90pointer
  types(2) = com_double_precision
  types(3) = com_mpi_comm
  types(4) = com_integer
  types(5) = com_string
  types(6) = com_string
  types(7) = com_integer

  CALL com_set_member_function( module_name//".initialize", &
       init_wrapper, module_name//".global", "biiiiii", types)
  
  types(1) = com_f90pointer
  types(2) = com_integer
  types(3) = com_string
  types(4) = com_string
  types(5) = com_rawdata
  types(6) = com_rawdata
  types(7) = com_integer

  CALL com_set_member_function( module_name//".init_internal", &
       initialize, module_name//".global", "biiiiii", types)
  
  types(1) = com_f90pointer
  types(2) = com_double_precision
  types(3) = com_double_precision
  types(4) = com_integer

  CALL com_set_member_function( module_name//".update_solution",  &
       update_wrapper, module_name//".global", "biii", types)

  types(1) = com_f90pointer
  types(2) = com_double_precision
  types(3) = com_double_precision
  types(4) = com_integer
  types(5) = com_rawdata
  types(6) = com_rawdata
  types(7) = com_rawdata

  CALL com_set_member_function( module_name//".update_internal",  &
       update, module_name//".global", "biiiiii", types)


  types(1) = com_f90pointer
  types(2) = com_rawdata
  CALL com_set_member_function( module_name//".finalize", &
       finalize, module_name//".global", "b", types)

  CALL com_window_init_done( module_name)

  g_b%INIT = com_get_function_handle(module_name//".init_internal")
  g_b%UPDATE = com_get_function_handle(module_name//".update_internal")
  g_b%INIT_1D = com_get_attribute_handle(module_name//".init_1d")
  g_b%INIT_0D = com_get_attribute_handle(module_name//".init_0d")
  g_b%GET_FILM_COEFF = com_get_attribute_handle(module_name//".get_film_coeff")
  g_b%GET_BURN_RATE  = com_get_attribute_handle(module_name//".get_burn_rate")
  g_b%GET_TIME_STEP = com_get_attribute_handle(module_name//".get_time_step")

  CALL com_set_pointer( module_name//".global", g_b, associate_pointer)
END SUBROUTINE rocburn_load_module

SUBROUTINE rocburn_unload_module( module_name)
  USE m_rocburn_interface_data, ONLY : list_block, associate_pointer
  IMPLICIT NONE

  CHARACTER(*), INTENT(IN) :: module_name

  TYPE( list_block), POINTER  :: glb
  
  INTERFACE 
     SUBROUTINE com_get_pointer( attr, ptr, asso)
       USE m_rocburn_interface_data
       CHARACTER(*), INTENT(IN)  :: attr
       TYPE(list_block), POINTER :: ptr
       EXTERNAL asso
     END SUBROUTINE com_get_pointer
  END INTERFACE

  CALL com_get_pointer( module_name//".global", glb, associate_pointer)
  DEALLOCATE( glb)

  CALL com_delete_window( module_name)

END SUBROUTINE rocburn_unload_module