coupler.F90       coverage:  91.67 %func     83.33 %block


     1) module Coupler_module
     2)  
     3)   use Condition_module
     4)   use Connection_module
     5)   use Region_module
     6)  
     7)   use PFLOTRAN_Constants_module
     8) 
     9)   implicit none
    10) 
    11)   private
    12)  
    13) #include "petsc/finclude/petscsys.h"
    14) 
    15)   ! coupler types
    16)   PetscInt, parameter, public :: INITIAL_COUPLER_TYPE = 1
    17)   PetscInt, parameter, public :: BOUNDARY_COUPLER_TYPE = 2
    18)   PetscInt, parameter, public :: SRC_SINK_COUPLER_TYPE = 3
    19)   PetscInt, parameter, public :: COUPLER_IPHASE_INDEX = 1
    20) 
    21)   type, public :: coupler_type
    22)     PetscInt :: id                                      ! id of coupler
    23)     character(len=MAXWORDLENGTH) :: name                ! name of coupler
    24)     PetscInt :: itype                                   ! integer defining type
    25)     character(len=MAXWORDLENGTH) :: ctype               ! character string defining type
    26)     character(len=MAXWORDLENGTH) :: flow_condition_name ! character string defining name of condition to be applied
    27)     character(len=MAXWORDLENGTH) :: tran_condition_name ! character string defining name of condition to be applied
    28)     character(len=MAXWORDLENGTH) :: region_name         ! character string defining name of region to be applied
    29)     PetscInt :: iflow_condition                         ! id of condition in condition array/list
    30)     PetscInt :: itran_condition                         ! id of condition in condition array/list
    31)     PetscInt :: iregion                                 ! id of region in region array/list
    32)     PetscInt :: iface                                   ! for structured grids only
    33)     PetscInt, pointer :: flow_aux_mapping(:)            ! maps flow_aux_real_var to primarhy dof
    34)     PetscInt, pointer :: flow_bc_type(:)                ! id of boundary condition type
    35)     PetscInt, pointer :: flow_aux_int_var(:,:)          ! auxiliary array for integer value
    36)     PetscReal, pointer :: flow_aux_real_var(:,:)        ! auxiliary array for real values
    37)     type(flow_condition_type), pointer :: flow_condition     ! pointer to condition in condition array/list
    38)     type(tran_condition_type), pointer :: tran_condition     ! pointer to condition in condition array/list
    39)     type(region_type), pointer :: region                ! pointer to region in region array/list
    40)     type(connection_set_type), pointer :: connection_set ! pointer to an array/list of connections
    41)     PetscInt :: numfaces_set
    42)     type(coupler_type), pointer :: next                 ! pointer to next coupler
    43)   end type coupler_type
    44)   
    45)   type, public :: coupler_ptr_type
    46)     type(coupler_type), pointer :: ptr
    47)   end type coupler_ptr_type
    48)     
    49)   type, public :: coupler_list_type
    50)     PetscInt :: num_couplers
    51)     type(coupler_type), pointer :: first
    52)     type(coupler_type), pointer :: last
    53)     type(coupler_ptr_type), pointer :: array(:)    
    54)   end type coupler_list_type
    55)   
    56)   public :: CouplerCreate, &
    57)             CouplerDestroy, &
    58)             CouplerInitList, &
    59)             CouplerAddToList, &
    60)             CouplerRead, &
    61)             CouplerDestroyList, &
    62)             CouplerGetNumConnectionsInList, &
    63)             CouplerListComputeConnections, &
    64)             CouplerGetPtrFromList
    65)   
    66)   interface CouplerCreate
    67)     module procedure CouplerCreate1
    68)     module procedure CouplerCreate2
    69)     module procedure CouplerCreateFromCoupler
    70)   end interface
    71)     
    72) contains
    73) 
    74) ! ************************************************************************** !
    75) 
    76) function CouplerCreate1()
    77)   ! 
    78)   ! CouplerCreate: Creates a coupler
    79)   ! 
    80)   ! Author: Glenn Hammond
    81)   ! Date: 10/23/07
    82)   ! 
    83) 
    84)   implicit none
    85) 
    86)   type(coupler_type), pointer :: CouplerCreate1
    87)   
    88)   type(coupler_type), pointer :: coupler
    89)   
    90)   allocate(coupler)
    91)   coupler%id = 0
    92)   coupler%name = ''
    93)   coupler%itype = BOUNDARY_COUPLER_TYPE
    94)   coupler%ctype = "boundary"
    95)   coupler%flow_condition_name = ""
    96)   coupler%tran_condition_name = ""
    97)   coupler%region_name = ""
    98)   coupler%iflow_condition = 0
    99)   coupler%itran_condition = 0
   100)   coupler%iregion = 0
   101)   coupler%iface = 0
   102)   nullify(coupler%flow_aux_mapping)
   103)   nullify(coupler%flow_bc_type)
   104)   nullify(coupler%flow_aux_int_var)
   105)   nullify(coupler%flow_aux_real_var)
   106)   nullify(coupler%flow_condition)
   107)   nullify(coupler%tran_condition)
   108)   nullify(coupler%region)
   109)   nullify(coupler%connection_set)
   110)   nullify(coupler%next)
   111)   
   112)   CouplerCreate1 => coupler
   113) 
   114) end function CouplerCreate1
   115) 
   116) ! ************************************************************************** !
   117) 
   118) function CouplerCreate2(itype)
   119)   ! 
   120)   ! Creates a coupler
   121)   ! 
   122)   ! Author: Glenn Hammond
   123)   ! Date: 10/23/07
   124)   ! 
   125) 
   126)   implicit none
   127) 
   128)   PetscInt :: itype
   129)   
   130)   type(coupler_type), pointer :: CouplerCreate2
   131)   
   132)   type(coupler_type), pointer :: coupler
   133)   
   134)   coupler => CouplerCreate1()
   135)   coupler%itype = itype
   136)   select case(itype)
   137)     case(INITIAL_COUPLER_TYPE)
   138)       coupler%ctype = 'initial'
   139)     case(BOUNDARY_COUPLER_TYPE)
   140)       coupler%ctype = 'boundary'
   141)     case(SRC_SINK_COUPLER_TYPE)
   142)       coupler%ctype = 'source_sink'
   143)   end select
   144) 
   145)   CouplerCreate2 => coupler
   146) 
   147) end function CouplerCreate2
   148) 
   149) ! ************************************************************************** !
   150) 
   151) function CouplerCreateFromCoupler(coupler)
   152)   ! 
   153)   ! Creates a coupler
   154)   ! 
   155)   ! Author: Glenn Hammond
   156)   ! Date: 10/23/07
   157)   ! 
   158) 
   159)   implicit none
   160)   
   161)   type(coupler_type), pointer :: coupler
   162)   
   163)   type(coupler_type), pointer :: CouplerCreateFromCoupler
   164)   type(coupler_type), pointer :: new_coupler
   165) 
   166)   new_coupler => CouplerCreate1()
   167) 
   168)   new_coupler%id = coupler%id
   169)   new_coupler%name = coupler%name
   170)   new_coupler%itype = coupler%itype
   171)   new_coupler%ctype = coupler%ctype
   172)   new_coupler%flow_condition_name = coupler%flow_condition_name
   173)   new_coupler%tran_condition_name = coupler%tran_condition_name
   174)   new_coupler%region_name = coupler%region_name
   175)   new_coupler%iflow_condition = coupler%iflow_condition
   176)   new_coupler%itran_condition = coupler%itran_condition
   177)   new_coupler%iregion = coupler%iregion
   178)   new_coupler%iface = coupler%iface
   179) 
   180)   ! these must remain null  
   181)   nullify(coupler%flow_condition)
   182)   nullify(coupler%tran_condition)
   183)   nullify(coupler%region)
   184)   nullify(coupler%flow_aux_mapping)
   185)   nullify(coupler%flow_bc_type)
   186)   nullify(coupler%flow_aux_int_var)
   187)   nullify(coupler%flow_aux_real_var)
   188)   nullify(coupler%connection_set)
   189)   nullify(coupler%next)
   190) 
   191)   CouplerCreateFromCoupler => new_coupler
   192) 
   193) end function CouplerCreateFromCoupler
   194) 
   195) ! ************************************************************************** !
   196) 
   197) subroutine CouplerInitList(list)
   198)   ! 
   199)   ! Initializes a coupler list
   200)   ! 
   201)   ! Author: Glenn Hammond
   202)   ! Date: 11/01/07
   203)   ! 
   204) 
   205)   implicit none
   206) 
   207)   type(coupler_list_type) :: list
   208)   
   209)   nullify(list%first)
   210)   nullify(list%last)
   211)   nullify(list%array)
   212)   list%num_couplers = 0
   213) 
   214) end subroutine CouplerInitList
   215) 
   216) ! ************************************************************************** !
   217) 
   218) subroutine CouplerRead(coupler,input,option)
   219)   ! 
   220)   ! Reads a coupler from the input file
   221)   ! 
   222)   ! Author: Glenn Hammond
   223)   ! Date: 11/01/07
   224)   ! 
   225) 
   226)   use Input_Aux_module
   227)   use String_module
   228)   use Option_module
   229)   
   230)   implicit none
   231)   
   232)   type(option_type) :: option
   233)   type(coupler_type) :: coupler
   234)   type(input_type), pointer :: input
   235)   
   236)   character(len=MAXWORDLENGTH) :: word
   237) 
   238)   input%ierr = 0
   239)   do
   240)   
   241)     call InputReadPflotranString(input,option)
   242)     if (InputError(input)) exit
   243)     if (InputCheckExit(input,option)) exit
   244)     
   245)     call InputReadWord(input,option,word,PETSC_TRUE)
   246)     call InputErrorMsg(input,option,'keyword','COUPLER')   
   247)     call StringToUpper(word)      
   248)     
   249)     select case(trim(word))
   250)     
   251)       case('REGION','SURF_REGION')
   252)         call InputReadWord(input,option,coupler%region_name,PETSC_TRUE)
   253)       case('FLOW_CONDITION','SURF_FLOW_CONDITION')
   254)         call InputReadWord(input,option,coupler%flow_condition_name,PETSC_TRUE)
   255)       case('TRANSPORT_CONDITION')
   256)         call InputReadWord(input,option,coupler%tran_condition_name,PETSC_TRUE)
   257)       case default
   258)         call InputKeywordUnrecognized(word,'coupler ',option)
   259)     end select 
   260)   
   261)   enddo  
   262) 
   263) end subroutine CouplerRead
   264) 
   265) ! ************************************************************************** !
   266) 
   267) subroutine CouplerAddToList(new_coupler,list)
   268)   ! 
   269)   ! Adds a new coupler to a coupler list
   270)   ! 
   271)   ! Author: Glenn Hammond
   272)   ! Date: 11/01/07
   273)   ! 
   274) 
   275)   implicit none
   276)   
   277)   type(coupler_type), pointer :: new_coupler
   278)   type(coupler_list_type) :: list
   279)   
   280)   list%num_couplers = list%num_couplers + 1
   281)   new_coupler%id = list%num_couplers
   282)   if (.not.associated(list%first)) list%first => new_coupler
   283)   if (associated(list%last)) list%last%next => new_coupler
   284)   list%last => new_coupler
   285)   
   286) end subroutine CouplerAddToList
   287) 
   288) ! ************************************************************************** !
   289) 
   290) subroutine CouplerListComputeConnections(grid,option,coupler_list)
   291)   ! 
   292)   ! computes connectivity for a list of couplers
   293)   ! 
   294)   ! Author: Glenn Hammond
   295)   ! Date: 02/20/08
   296)   ! 
   297) 
   298)   use Option_module
   299)   use Grid_module
   300)   
   301)   implicit none
   302)  
   303)   type(grid_type) :: grid
   304)   type(option_type) :: option
   305)   type(coupler_list_type), pointer :: coupler_list
   306)   
   307)   type(coupler_type), pointer :: coupler
   308)   PetscInt :: offset
   309)   
   310)   if (.not.associated(coupler_list)) return
   311)   
   312)   offset = 0
   313)   coupler => coupler_list%first
   314)   do
   315)     if (.not.associated(coupler)) exit 
   316)     call CouplerComputeConnections(grid,option,coupler)
   317)     if (associated(coupler%connection_set)) then
   318)       coupler%connection_set%offset = offset
   319)       offset = offset + coupler%connection_set%num_connections
   320)     endif
   321)     coupler => coupler%next
   322)   enddo
   323) 
   324) end subroutine CouplerListComputeConnections
   325) 
   326) ! ************************************************************************** !
   327) 
   328) subroutine CouplerComputeConnections(grid,option,coupler)
   329)   ! 
   330)   ! computes connectivity coupler to a grid
   331)   ! 
   332)   ! Author: Glenn Hammond
   333)   ! Date: 02/20/08
   334)   ! 
   335) 
   336)   use Connection_module
   337)   use Option_module
   338)   use Region_module
   339)   use Grid_module
   340)   use Dataset_Base_class
   341)   use Dataset_Gridded_HDF5_class
   342)   use Grid_Unstructured_Aux_module
   343)   use Grid_Unstructured_Explicit_module, only : UGridExplicitSetBoundaryConnect, &
   344)                                            UGridExplicitSetConnections
   345)   
   346)   implicit none
   347)  
   348)   type(grid_type) :: grid
   349)   type(option_type) :: option
   350)   type(coupler_type), pointer :: coupler_list
   351)   
   352)   PetscInt :: iconn
   353)   PetscInt :: cell_id_local, cell_id_ghosted
   354)   PetscInt :: connection_itype
   355)   PetscInt :: iface
   356)   type(connection_set_type), pointer :: connection_set
   357)   type(region_type), pointer :: region
   358)   type(coupler_type), pointer :: coupler
   359)   PetscBool :: nullify_connection_set
   360)   PetscErrorCode :: ierr
   361) 
   362)   if (.not.associated(coupler)) return
   363)   
   364)   nullify_connection_set = PETSC_FALSE
   365)   select case(coupler%itype)
   366)     case(INITIAL_COUPLER_TYPE)
   367)       if (associated(coupler%flow_condition)) then
   368)         if (associated(coupler%flow_condition%pressure)) then
   369)           if (coupler%flow_condition%pressure%itype /= HYDROSTATIC_BC .and. &
   370)               coupler%flow_condition%pressure%itype /= SEEPAGE_BC .and. &
   371)               coupler%flow_condition%pressure%itype /= CONDUCTANCE_BC) then
   372)             select type(selector => coupler%flow_condition%pressure%dataset)
   373)               class is(dataset_gridded_hdf5_type)
   374)               class default
   375)                 nullify_connection_set = PETSC_TRUE
   376)             end select
   377)           endif
   378)         else if (associated(coupler%flow_condition%concentration)) then
   379)           ! need to calculate connection set
   380)         endif
   381)         !geh: this is a workaround for defining temperature with a gridded
   382)         !     dataset.  still need to set up the connections.
   383)         if (associated(coupler%flow_condition%temperature)) then
   384)           select type(selector => coupler%flow_condition%temperature%dataset)
   385)             class is(dataset_gridded_hdf5_type)
   386)               nullify_connection_set = PETSC_FALSE
   387)           end select
   388)         endif
   389)       else
   390)         nullify_connection_set = PETSC_TRUE
   391)       endif
   392)       connection_itype = INITIAL_CONNECTION_TYPE
   393)     case(SRC_SINK_COUPLER_TYPE)
   394)       connection_itype = SRC_SINK_CONNECTION_TYPE
   395)     case(BOUNDARY_COUPLER_TYPE)
   396)       connection_itype = BOUNDARY_CONNECTION_TYPE
   397)   end select
   398)   
   399)   if (nullify_connection_set) then
   400)     nullify(coupler%connection_set)
   401)     return
   402)   endif
   403)   
   404)   region => coupler%region
   405) 
   406)   select case(grid%itype)
   407)     case(EXPLICIT_UNSTRUCTURED_GRID)
   408)       if (associated(region%explicit_faceset)) then
   409)         connection_set => &
   410)           UGridExplicitSetBoundaryConnect(grid%unstructured_grid% &
   411)                                             explicit_grid, &
   412)                                           region%cell_ids, &
   413)                                      region%explicit_faceset%face_centroids, &
   414)                                      region%explicit_faceset%face_areas, &
   415)                                      region%name,option)
   416)       else
   417)         connection_set => &
   418)           UGridExplicitSetConnections(grid%unstructured_grid% &
   419)                                         explicit_grid, &
   420)                                       region%cell_ids, &
   421)                                       connection_itype,option)
   422)       endif
   423)     case default
   424)       connection_set => ConnectionCreate(region%num_cells,connection_itype)
   425)     
   426)       ! if using higher order advection, allocate associated arrays
   427)       if (option%itranmode == EXPLICIT_ADVECTION .and. &
   428)           option%transport%tvd_flux_limiter /= 1 .and. &  ! 1 = upwind
   429)           connection_set%itype == BOUNDARY_CONNECTION_TYPE) then
   430)         ! connections%id_up2 should remain null as it will not be used
   431)         allocate(connection_set%id_dn2(size(connection_set%id_dn)))
   432)         connection_set%id_dn2 = 0
   433)       endif  
   434) 
   435)       iface = coupler%iface
   436)       do iconn = 1,region%num_cells
   437)     
   438)         cell_id_local = region%cell_ids(iconn)
   439)         if (associated(region%faces)) iface = region%faces(iconn)
   440)     
   441)         connection_set%id_dn(iconn) = cell_id_local
   442) 
   443)         call GridPopulateConnection(grid,connection_set,iface,iconn, &
   444)                                     cell_id_local,option)
   445)       enddo
   446)   end select
   447) 
   448)   coupler%connection_set => connection_set
   449)   nullify(connection_set)
   450)  
   451) end subroutine CouplerComputeConnections
   452) 
   453) ! ************************************************************************** !
   454) 
   455) function CouplerGetNumConnectionsInList(list)
   456)   ! 
   457)   ! Returns the number of connections associated
   458)   ! with all couplers in the list
   459)   ! 
   460)   ! Author: Glenn Hammond
   461)   ! Date: 11/19/07
   462)   ! 
   463) 
   464)   implicit none
   465)   
   466)   type(coupler_list_type) :: list
   467)   
   468)   PetscInt :: CouplerGetNumConnectionsInList
   469)   type(coupler_type), pointer :: coupler
   470)   
   471)   CouplerGetNumConnectionsInList = 0
   472)   coupler => list%first
   473)   
   474)   do
   475)     if (.not.associated(coupler)) exit
   476)     CouplerGetNumConnectionsInList = CouplerGetNumConnectionsInList + &
   477)                                      coupler%connection_set%num_connections
   478)     coupler => coupler%next
   479)   enddo
   480) 
   481) end function CouplerGetNumConnectionsInList
   482) 
   483) ! ************************************************************************** !
   484) 
   485) function CouplerGetPtrFromList(coupler_name,coupler_list)
   486)   ! 
   487)   ! Returns a pointer to the coupler matching
   488)   ! coupler_name
   489)   ! 
   490)   ! Author: Glenn Hammond
   491)   ! Date: 11/01/07
   492)   ! 
   493) 
   494)   use String_module
   495) 
   496)   implicit none
   497)   
   498)   type(coupler_type), pointer :: CouplerGetPtrFromList
   499)   character(len=MAXWORDLENGTH) :: coupler_name
   500)   PetscInt :: length
   501)   type(coupler_list_type) :: coupler_list
   502) 
   503)   type(coupler_type), pointer :: coupler
   504)     
   505)   nullify(CouplerGetPtrFromList)
   506) 
   507)   coupler => coupler_list%first
   508)   do 
   509)     if (.not.associated(coupler)) exit
   510)     length = len_trim(coupler_name)
   511)     if (length == len_trim(coupler%name) .and. &
   512)         StringCompare(coupler%name,coupler_name,length)) then
   513)       CouplerGetPtrFromList => coupler
   514)       return
   515)     endif
   516)     coupler => coupler%next
   517)   enddo
   518)   
   519) end function CouplerGetPtrFromList
   520) 
   521) ! ************************************************************************** !
   522) 
   523) subroutine CouplerDestroyList(coupler_list)
   524)   ! 
   525)   ! Deallocates a list of couplers
   526)   ! 
   527)   ! Author: Glenn Hammond
   528)   ! Date: 11/01/07
   529)   ! 
   530) 
   531)   implicit none
   532)   
   533)   type(coupler_list_type), pointer :: coupler_list
   534)   
   535)   type(coupler_type), pointer :: coupler, prev_coupler
   536)   
   537)   if (.not.associated(coupler_list)) return
   538)   
   539)   coupler => coupler_list%first
   540)   do 
   541)     if (.not.associated(coupler)) exit
   542)     prev_coupler => coupler
   543)     coupler => coupler%next
   544)     call CouplerDestroy(prev_coupler)
   545)   enddo
   546)   
   547)   coupler_list%num_couplers = 0
   548)   nullify(coupler_list%first)
   549)   nullify(coupler_list%last)
   550)   if (associated(coupler_list%array)) deallocate(coupler_list%array)
   551)   nullify(coupler_list%array)
   552)   
   553)   deallocate(coupler_list)
   554)   nullify(coupler_list)
   555) 
   556) end subroutine CouplerDestroyList
   557) 
   558) ! ************************************************************************** !
   559) 
   560) subroutine CouplerDestroy(coupler)
   561)   ! 
   562)   ! Destroys a coupler
   563)   ! 
   564)   ! Author: Glenn Hammond
   565)   ! Date: 10/23/07
   566)   ! 
   567)   use Utility_module, only : DeallocateArray
   568)   
   569)   implicit none
   570)   
   571)   type(coupler_type), pointer :: coupler
   572)   
   573)   if (.not.associated(coupler)) return
   574)   
   575)   ! since the below are simply pointers to objects in list that have already
   576)   ! or will be deallocated from the list, nullify instead of destroying
   577)   
   578)   nullify(coupler%flow_condition)     ! since these are simply pointers to 
   579)   nullify(coupler%tran_condition)     ! since these are simply pointers to 
   580)   nullify(coupler%region)        ! conditoins in list, nullify
   581) 
   582)   call DeallocateArray(coupler%flow_aux_mapping)
   583)   call DeallocateArray(coupler%flow_bc_type)
   584)   call DeallocateArray(coupler%flow_aux_int_var)
   585)   call DeallocateArray(coupler%flow_aux_real_var)
   586) 
   587)   call ConnectionDestroy(coupler%connection_set)
   588)   nullify(coupler%connection_set)
   589) 
   590)   deallocate(coupler)
   591)   nullify(coupler)
   592) 
   593) end subroutine CouplerDestroy
   594) 
   595) end module Coupler_module

generated by
Intel(R) C++/Fortran Compiler code-coverage tool
Web-Page Owner: Nobody