RocFracLoadModule.f90

Go to the documentation of this file.

!*********************************************************************
!* Illinois Open Source License                                      *
!*                                                                   *
!* University of Illinois/NCSA                                       * 
!* Open Source License                                               *
!*                                                                   *
!* Copyright@2008, University of Illinois.  All rights reserved.     *
!*                                                                   *
!*  Developed by:                                                    *
!*                                                                   *
!*     Center for Simulation of Advanced Rockets                     *
!*                                                                   *
!*     University of Illinois                                        *
!*                                                                   *
!*     www.csar.uiuc.edu                                             *
!*                                                                   *
!* Permission is hereby granted, free of charge, to any person       *
!* obtaining a copy of this software and associated documentation    *
!* files (the "Software"), to deal with the Software without         *
!* restriction, including without limitation the rights to use,      *
!* copy, modify, merge, publish, distribute, sublicense, and/or      *
!* sell copies of the Software, and to permit persons to whom the    *
!* Software is furnished to do so, subject to the following          *
!* conditions:                                                       *
!*                                                                   *
!*                                                                   *
!* @ Redistributions of source code must retain the above copyright  * 
!*   notice, this list of conditions and the following disclaimers.  *
!*                                                                   * 
!* @ Redistributions in binary form must reproduce the above         *
!*   copyright notice, this list of conditions and the following     *
!*   disclaimers in the documentation and/or other materials         *
!*   provided with the distribution.                                 *
!*                                                                   *
!* @ Neither the names of the Center for Simulation of Advanced      *
!*   Rockets, the University of Illinois, nor the names of its       *
!*   contributors may be used to endorse or promote products derived * 
!*   from this Software without specific prior written permission.   *
!*                                                                   *
!* 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.                          *
!*********************************************************************
!* Please acknowledge The University of Illinois Center for          *
!* Simulation of Advanced Rockets in works and publications          *
!* resulting from this software or its derivatives.                  *
!*********************************************************************
SUBROUTINE rocfrac_load_module( module_name)
  USE rocfracmain
  USE rocfracsubinterface
  USE integralcheck
  IMPLICIT NONE
  include 'roccomf90.h'
  include 'rocmanf90.h'
    
  CHARACTER(*), INTENT(IN) :: module_name

  LOGICAL   :: isdummy
  INTEGER :: types(7)
  TYPE(rocfrac_global), POINTER :: glb
    
  INTERFACE 
     SUBROUTINE com_set_pointer( attr, ptr, asso)
       USE      rocstar_rocfrac
       CHARACTER(*), INTENT(IN) :: attr
       TYPE(rocfrac_global), POINTER :: ptr
       EXTERNAL asso
     END SUBROUTINE com_set_pointer
  END INTERFACE
    
  isdummy = trim(module_name) == "RocfracDummy"
  
  ALLOCATE( glb)
  ! dummy rocfrac flag
  glb%iDummyRocfrac = isdummy
    
  CALL com_new_window( module_name)
  
  CALL com_new_attribute( module_name//".global", 'w', com_f90pointer, 1, '')
  CALL com_resize_array( module_name//".global")
  
  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", &
       rocfracinitialize, module_name//".global", "biiiiii", types)

  CALL com_set_member_function( module_name//".finalize", &
       rocfracfinalize, module_name//".global", "b", types)

  types(3) = com_double_precision
  types(4) = com_integer
  IF ( .NOT. isdummy) THEN
     CALL com_set_member_function( module_name//".update_solution", &
          rocfracsoln, module_name//".global", "biii", types)
  ELSE
     CALL com_set_member_function( module_name//".update_solution", &
          rocfracinterfaceupdate, module_name//".global", "biii", types)
  END IF

!!! This is for running Rocfrac in standalone mode
  CALL com_set_member_function( module_name//".update_inbuff_bc_solid", &
       rocfracupdateinbuff, module_name//".global", "bi", types)

  types(1) = com_f90pointer
  types(2) = com_double_precision

  CALL com_set_member_function( module_name//'.'//man_comp_integ_name, &
       checkintegral, module_name//".global", "bo", types)
  CALL com_window_init_done( module_name)

  CALL com_set_pointer( module_name//".global", glb, associate_pointer)

END SUBROUTINE rocfrac_load_module

SUBROUTINE rocfrac_unload_module( module_name) 
  USE rocstar_rocfrac
  IMPLICIT NONE
  include 'roccomf90.h'

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

  TYPE(rocfrac_global), POINTER :: glb

  INTERFACE 
     SUBROUTINE com_get_pointer( attr, ptr, asso)
       USE rocfracmain
       CHARACTER(*), INTENT(IN) :: attr
       TYPE(rocfrac_global), 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 rocfrac_unload_module