surface_global.F90       coverage:  28.57 %func     42.75 %block


     1) module Surface_Global_module
     2) 
     3)   use Surface_Global_Aux_module
     4) 
     5)   use PFLOTRAN_Constants_module
     6) 
     7)   implicit none
     8) 
     9)   private
    10)   
    11) #include "petsc/finclude/petscsys.h"
    12) 
    13)   public SurfaceGlobalSetup, &
    14)          SurfaceGlobalSetAuxVarScalar, &
    15)          SurfaceGlobalSetAuxVarVecLoc, &
    16)          SurfaceGlobalUpdateAuxVars
    17) 
    18) contains
    19) 
    20) ! ************************************************************************** !
    21) 
    22) subroutine SurfaceGlobalSetup(surf_realization)
    23)   ! 
    24)   ! This routine
    25)   ! 
    26)   ! Author: Gautam Bisht, LBNL
    27)   ! Date: 03/07/13
    28)   ! 
    29) 
    30)   use Realization_Surface_class
    31)   use Patch_module
    32)   
    33)   implicit none
    34) 
    35)   class(realization_surface_type) :: surf_realization
    36)   
    37)   type(patch_type), pointer :: cur_patch
    38)   
    39)   cur_patch => surf_realization%patch_list%first
    40)   do
    41)     if (.not.associated(cur_patch)) exit
    42)     surf_realization%patch => cur_patch
    43)     call SurfaceGlobalSetupPatch(surf_realization)
    44)     cur_patch => cur_patch%next
    45)   enddo
    46) 
    47) end subroutine SurfaceGlobalSetup
    48) 
    49) ! ************************************************************************** !
    50) 
    51) subroutine SurfaceGlobalSetupPatch(surf_realization)
    52)   ! 
    53)   ! This routine
    54)   ! 
    55)   ! Author: Gautam Bisht, LBNL
    56)   ! Date: 03/07/13
    57)   ! 
    58) 
    59)   use Realization_Surface_class
    60)   use Patch_module
    61)   use Option_module
    62)   use Coupler_module
    63)   use Connection_module
    64)   use Grid_module
    65)  
    66)   implicit none
    67)   
    68)   class(realization_surface_type) :: surf_realization
    69) 
    70)   type(option_type), pointer :: option
    71)   type(patch_type),pointer :: patch
    72)   type(grid_type), pointer :: grid
    73)   type(coupler_type), pointer :: boundary_condition
    74)   type(coupler_type), pointer :: source_sink
    75) 
    76)   PetscInt :: ghosted_id, iconn, sum_connection
    77)   type(surface_global_auxvar_type), pointer :: auxvars(:)
    78)   type(surface_global_auxvar_type), pointer :: auxvars_bc(:)
    79)   type(surface_global_auxvar_type), pointer :: auxvars_ss(:)
    80)   
    81)   option => surf_realization%option
    82)   patch => surf_realization%patch
    83)   grid => patch%grid
    84) 
    85)   patch%surf_aux%SurfaceGlobal => SurfaceGlobalAuxCreate()
    86)   
    87)   ! allocate auxvar data structures for all grid cells  
    88) #ifdef COMPUTE_INTERNAL_MASS_FLUX
    89)   option%iflag = 1 ! allocate mass_balance array
    90) #else  
    91)   option%iflag = 0 ! be sure not to allocate mass_balance array
    92) #endif
    93)   allocate(auxvars(grid%ngmax))
    94)   do ghosted_id = 1, grid%ngmax
    95)     call SurfaceGlobalAuxVarInit(auxvars(ghosted_id),option)
    96)   enddo
    97)   patch%surf_aux%SurfaceGlobal%auxvars => auxvars
    98)   patch%surf_aux%SurfaceGlobal%num_aux = grid%ngmax
    99)   
   100)   ! count the number of boundary connections and allocate
   101)   ! auxvar data structures for them  
   102)   boundary_condition => patch%boundary_condition_list%first
   103)   sum_connection = 0    
   104)   do 
   105)     if (.not.associated(boundary_condition)) exit
   106)     sum_connection = sum_connection + &
   107)                      boundary_condition%connection_set%num_connections
   108)     boundary_condition => boundary_condition%next
   109)   enddo
   110) 
   111)   if (sum_connection > 0) then
   112)     option%iflag = 1 ! enable allocation of mass_balance array 
   113)     allocate(auxvars_bc(sum_connection))
   114)     do iconn = 1, sum_connection
   115)       call SurfaceGlobalAuxVarInit(auxvars_bc(iconn),option)
   116)     enddo
   117)     patch%surf_aux%SurfaceGlobal%auxvars_bc => auxvars_bc
   118)   endif
   119)   patch%surf_aux%SurfaceGlobal%num_aux_bc = sum_connection
   120) 
   121)   ! count the number of source/sink connections and allocate
   122)   ! auxvar data structures for them  
   123)   source_sink => patch%source_sink_list%first
   124)   sum_connection = 0    
   125)   do 
   126)     if (.not.associated(source_sink)) exit
   127)     sum_connection = sum_connection + &
   128)                      source_sink%connection_set%num_connections
   129)     source_sink => source_sink%next
   130)   enddo
   131) 
   132)   if (sum_connection > 0) then
   133)     option%iflag = 1 ! enable allocation of mass_balance array 
   134)     allocate(auxvars_ss(sum_connection))
   135)     do iconn = 1, sum_connection
   136)       call SurfaceGlobalAuxVarInit(auxvars_ss(iconn),option)
   137)     enddo
   138)     patch%surf_aux%SurfaceGlobal%auxvars_ss => auxvars_ss
   139)   endif
   140)   patch%surf_aux%SurfaceGlobal%num_aux_ss = sum_connection
   141) 
   142)   option%iflag = 0
   143)   
   144) end subroutine SurfaceGlobalSetupPatch
   145) 
   146) ! ************************************************************************** !
   147) 
   148) subroutine SurfaceGlobalSetAuxVarScalar(surf_realization,value,ivar)
   149)   ! 
   150)   ! This routine
   151)   ! 
   152)   ! Author: Gautam Bisht, LBNL
   153)   ! Date: 03/07/13
   154)   ! 
   155) 
   156)   use Realization_Surface_class
   157)   use Patch_module
   158) 
   159)   implicit none
   160) 
   161)   class(realization_surface_type) :: surf_realization
   162)   PetscReal :: value
   163)   PetscInt :: ivar
   164)   
   165)   type(patch_type), pointer :: cur_patch
   166)   
   167)   cur_patch => surf_realization%patch_list%first
   168)   do
   169)     if (.not.associated(cur_patch)) exit
   170)     surf_realization%patch => cur_patch
   171)     call SurfaceGlobalSetAuxVarScalarPatch(surf_realization,value,ivar)
   172)     cur_patch => cur_patch%next
   173)   enddo
   174)   
   175) end subroutine SurfaceGlobalSetAuxVarScalar
   176) 
   177) ! ************************************************************************** !
   178) 
   179) subroutine SurfaceGlobalSetAuxVarScalarPatch(surf_realization,value,ivar)
   180) 
   181)   use Realization_Surface_class
   182)   use Option_module
   183)   use Patch_module
   184)   use Variables_module, only : SURFACE_LIQUID_HEAD, &
   185)                                SURFACE_LIQUID_TEMPERATURE, &
   186)                                SURFACE_LIQUID_DENSITY
   187)   
   188)   implicit none
   189) 
   190)   class(realization_surface_type) :: surf_realization
   191)   PetscReal :: value
   192)   PetscInt :: ivar
   193) 
   194)   type(option_type), pointer :: option
   195)   type(patch_type), pointer :: patch
   196)     
   197)   PetscInt :: i
   198)   
   199)   patch => surf_realization%patch
   200)   option => surf_realization%option  
   201)   
   202)   select case(ivar)
   203)     case(SURFACE_LIQUID_HEAD)
   204)       do i=1, patch%surf_aux%SurfaceGlobal%num_aux
   205)         patch%surf_aux%SurfaceGlobal%auxvars(i)%head = value
   206)       enddo
   207)       do i=1, patch%surf_aux%SurfaceGlobal%num_aux_bc
   208)         patch%surf_aux%SurfaceGlobal%auxvars_bc(i)%head = value
   209)       enddo
   210)     case(SURFACE_LIQUID_TEMPERATURE)
   211)       do i=1, patch%surf_aux%SurfaceGlobal%num_aux
   212)         patch%surf_aux%SurfaceGlobal%auxvars(i)%temp = value
   213)       enddo
   214)       do i=1, patch%surf_aux%SurfaceGlobal%num_aux_bc
   215)         patch%surf_aux%SurfaceGlobal%auxvars_bc(i)%temp = value
   216)       enddo
   217)     case(SURFACE_LIQUID_DENSITY)
   218)       do i=1, patch%surf_aux%SurfaceGlobal%num_aux
   219)         patch%surf_aux%SurfaceGlobal%auxvars(i)%den_kg(option%liquid_phase) = value
   220)       enddo
   221)       do i=1, surf_realization%patch%surf_aux%SurfaceGlobal%num_aux_bc
   222)         patch%surf_aux%SurfaceGlobal%auxvars_bc(i)%den_kg(option%liquid_phase) = value
   223)       enddo
   224)   end select
   225)   
   226) end subroutine SurfaceGlobalSetAuxVarScalarPatch
   227) 
   228) ! ************************************************************************** !
   229) 
   230) subroutine SurfaceGlobalSetAuxVarVecLoc(surf_realization,vec_loc,ivar,isubvar)
   231)   ! 
   232)   ! This routine
   233)   ! 
   234)   ! Author: Gautam Bisht, LBNL
   235)   ! Date: 03/07/13
   236)   ! 
   237) 
   238)   use Realization_Surface_class
   239)   use Patch_module
   240) 
   241)   implicit none
   242)   
   243) #include "petsc/finclude/petscvec.h"
   244) #include "petsc/finclude/petscvec.h90"  
   245) 
   246)   class(realization_surface_type) :: surf_realization
   247)   Vec :: vec_loc
   248)   PetscInt :: ivar
   249)   PetscInt :: isubvar
   250)   
   251)   type(patch_type), pointer :: cur_patch
   252)   
   253)   cur_patch => surf_realization%patch_list%first
   254)   do
   255)     if (.not.associated(cur_patch)) exit
   256)     surf_realization%patch => cur_patch
   257)     call SurfaceGlobalSetAuxVarVecLocPatch(surf_realization,vec_loc,ivar,isubvar)
   258)     cur_patch => cur_patch%next
   259)   enddo
   260) 
   261) end subroutine SurfaceGlobalSetAuxVarVecLoc
   262) 
   263) ! ************************************************************************** !
   264) 
   265) subroutine SurfaceGlobalSetAuxVarVecLocPatch(surf_realization,vec_loc,ivar,isubvar)
   266)   ! 
   267)   ! This routine
   268)   ! 
   269)   ! Author: Gautam Bisht, LBNL
   270)   ! Date: 03/07/13
   271)   ! 
   272) 
   273)   use Realization_Surface_class
   274)   use Patch_module
   275)   use Grid_module
   276)   use Option_module
   277)   use Variables_module, only : SURFACE_LIQUID_HEAD, &
   278)                                SURFACE_LIQUID_TEMPERATURE, &
   279)                                SURFACE_LIQUID_DENSITY
   280)   
   281)   implicit none
   282) 
   283) #include "petsc/finclude/petscvec.h"
   284) #include "petsc/finclude/petscvec.h90"
   285) 
   286)   class(realization_surface_type) :: surf_realization
   287)   Vec :: vec_loc
   288)   PetscInt :: ivar
   289)   PetscInt :: isubvar  
   290)   
   291)   type(option_type), pointer :: option
   292)   type(patch_type), pointer :: patch
   293)   type(grid_type), pointer :: grid
   294)   
   295)   PetscInt :: ghosted_id
   296)   PetscReal, pointer :: vec_loc_p(:)
   297)   PetscErrorCode :: ierr
   298)   
   299)   patch => surf_realization%patch
   300)   grid => patch%grid
   301)   option => surf_realization%option
   302)   
   303)   call VecGetArrayF90(vec_loc,vec_loc_p,ierr);CHKERRQ(ierr)
   304)   
   305)   select case(ivar)
   306)     case(SURFACE_LIQUID_HEAD)
   307)       select case(isubvar)
   308)         case default
   309)           do ghosted_id=1, grid%ngmax
   310)             patch%surf_aux%SurfaceGlobal%auxvars(ghosted_id)%head(option%liquid_phase) &
   311)               = vec_loc_p(ghosted_id)
   312)           enddo
   313)       end select
   314)     case(SURFACE_LIQUID_TEMPERATURE)
   315)       select case(isubvar)
   316)         case default
   317)           do ghosted_id=1, grid%ngmax
   318)             patch%surf_aux%SurfaceGlobal%auxvars(ghosted_id)%temp = vec_loc_p(ghosted_id)
   319)           enddo
   320)       end select
   321)     case(SURFACE_LIQUID_DENSITY)
   322)       select case(isubvar)
   323)         case default
   324)           do ghosted_id=1, grid%ngmax
   325)             patch%surf_aux%SurfaceGlobal%auxvars(ghosted_id)%den_kg(option%liquid_phase) &
   326)               = vec_loc_p(ghosted_id)
   327)           enddo
   328)       end select
   329)   end select
   330) 
   331)   call VecRestoreArrayF90(vec_loc,vec_loc_p,ierr);CHKERRQ(ierr)
   332) 
   333) end subroutine SurfaceGlobalSetAuxVarVecLocPatch
   334) 
   335) ! ************************************************************************** !
   336) 
   337) subroutine SurfaceGlobalUpdateAuxVars(surf_realization,time_level)
   338)   ! 
   339)   ! This routine
   340)   ! 
   341)   ! Author: Gautam Bisht, LBNL
   342)   ! Date: 03/07/13
   343)   ! 
   344) 
   345)   use Realization_Surface_class
   346)   use Surface_Field_module
   347)   use Option_module
   348)   use Discretization_module
   349)   use Variables_module, only : SURFACE_LIQUID_HEAD, &
   350)                                SURFACE_LIQUID_TEMPERATURE, &
   351)                                LIQUID_DENSITY
   352)   
   353)   class(realization_surface_type) :: surf_realization
   354)   PetscInt :: time_level
   355)   
   356)   type(surface_field_type), pointer :: surf_field
   357)   type(option_type), pointer :: option
   358)   
   359)   option => surf_realization%option
   360)   surf_field => surf_realization%surf_field
   361)   
   362)   ! liquid density
   363)   call RealizSurfGetVariable(surf_realization,surf_field%work,LIQUID_DENSITY, &
   364)                              ZERO_INTEGER)
   365)   call DiscretizationGlobalToLocal(surf_realization%discretization, &
   366)                                    surf_field%work,surf_field%work_loc,ONEDOF)
   367)   call SurfaceGlobalSetAuxVarVecLoc(surf_realization,surf_field%work_loc, &
   368)                                     LIQUID_DENSITY,time_level)
   369) 
   370)   select case(option%iflowmode)
   371)     case(TH_MODE)
   372)       ! head
   373)       call RealizSurfGetVariable(surf_realization,surf_field%work, &
   374)               SURFACE_LIQUID_HEAD,ZERO_INTEGER)
   375)       call DiscretizationGlobalToLocal(surf_realization%discretization, &
   376)                                   surf_field%work,surf_field%work_loc,ONEDOF)
   377)       call SurfaceGlobalSetAuxVarVecLoc(surf_realization,surf_field%work_loc, &
   378)               SURFACE_LIQUID_HEAD,time_level)
   379)  
   380)       ! temperature
   381)       call RealizSurfGetVariable(surf_realization,surf_field%work, &
   382)               SURFACE_LIQUID_TEMPERATURE, ZERO_INTEGER)
   383)       call DiscretizationGlobalToLocal(surf_realization%discretization, &
   384)                                    surf_field%work,surf_field%work_loc,ONEDOF)
   385)       call SurfaceGlobalSetAuxVarVecLoc(surf_realization,surf_field%work_loc, &
   386)               SURFACE_LIQUID_TEMPERATURE,time_level)
   387)       
   388) 
   389)   end select
   390) 
   391) end subroutine SurfaceGlobalUpdateAuxVars
   392) 
   393) end module Surface_Global_module

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