surface_global_aux.F90       coverage:  71.43 %func     70.27 %block


     1) module Surface_Global_Aux_module
     2) 
     3)   use PFLOTRAN_Constants_module
     4) 
     5)   implicit none
     6) 
     7)   private
     8) 
     9) #include "petsc/finclude/petscsys.h"
    10) 
    11)   type, public :: surface_global_auxvar_type
    12)     PetscInt :: istate
    13)     PetscReal, pointer :: head(:)   ! [m]
    14)     PetscReal :: temp   ! [C]
    15)     PetscReal, pointer :: den_kg(:) ! [kg/m^3]
    16)     PetscBool :: is_dry
    17)   end type surface_global_auxvar_type
    18)   
    19)   type, public :: surface_global_type
    20)     PetscInt :: num_aux, num_aux_bc, num_aux_ss
    21)     type(surface_global_auxvar_type), pointer :: auxvars(:)
    22)     type(surface_global_auxvar_type), pointer :: auxvars_bc(:)
    23)     type(surface_global_auxvar_type), pointer :: auxvars_ss(:)
    24)   end type surface_global_type
    25)   
    26)   interface SurfaceGlobalAuxVarDestroy
    27)     module procedure SurfaceGlobalAuxVarSingleDestroy
    28)     module procedure SurfaceGlobalAuxVarArrayDestroy
    29)   end interface SurfaceGlobalAuxVarDestroy
    30) 
    31)   public :: SurfaceGlobalAuxCreate, &
    32)             SurfaceGlobalAuxDestroy, &
    33)             SurfaceGlobalAuxVarInit, &
    34)             SurfaceGlobalAuxVarCopy, &
    35)             SurfaceGlobalAuxVarDestroy, &
    36)             SurfaceGlobalAuxVarStrip
    37) 
    38) contains
    39) 
    40) ! ************************************************************************** !
    41) 
    42) function SurfaceGlobalAuxCreate()
    43)   ! 
    44)   ! This routine
    45)   ! 
    46)   ! Author: Gautam Bisht, LBNL
    47)   ! Date: 02/28/13
    48)   ! 
    49) 
    50)   use Option_module
    51) 
    52)   implicit none
    53)   
    54)   type(surface_global_type), pointer :: SurfaceGlobalAuxCreate
    55)   
    56)   type(surface_global_type), pointer :: aux
    57) 
    58)   allocate(aux) 
    59)   aux%num_aux = 0
    60)   aux%num_aux_bc = 0
    61)   aux%num_aux_ss = 0
    62)   nullify(aux%auxvars)
    63)   nullify(aux%auxvars_bc)
    64)   nullify(aux%auxvars_ss)
    65) 
    66)   SurfaceGlobalAuxCreate => aux
    67)   
    68) end function SurfaceGlobalAuxCreate
    69) 
    70) ! ************************************************************************** !
    71) 
    72) subroutine SurfaceGlobalAuxVarInit(auxvar,option)
    73)   ! 
    74)   ! This routine
    75)   ! 
    76)   ! Author: Gautam Bisht, LBNL
    77)   ! Date: 02/28/13
    78)   ! 
    79) 
    80)   use Option_module
    81)   use PFLOTRAN_Constants_module, only : DUMMY_VALUE
    82) 
    83)   implicit none
    84)   
    85)   type(surface_global_auxvar_type) :: auxvar
    86)   type(option_type) :: option
    87)   
    88)   auxvar%istate = 0
    89)   auxvar%is_dry = PETSC_FALSE
    90)   allocate(auxvar%head(option%nphase))
    91)   auxvar%head = 0.d0
    92)   auxvar%temp = option%reference_temperature
    93)   allocate(auxvar%den_kg(option%nphase))
    94)   auxvar%den_kg = 0.d0
    95) 
    96) end subroutine SurfaceGlobalAuxVarInit
    97) 
    98) ! ************************************************************************** !
    99) 
   100) subroutine SurfaceGlobalAuxVarCopy(auxvar,auxvar2,option)
   101)   ! 
   102)   ! This routine
   103)   ! 
   104)   ! Author: Gautam Bisht, LBNL
   105)   ! Date: 02/28/13
   106)   ! 
   107) 
   108)   use Option_module
   109) 
   110)   implicit none
   111)   
   112)   type(surface_global_auxvar_type) :: auxvar, auxvar2
   113)   type(option_type) :: option
   114) 
   115)   auxvar2%istate = auxvar%istate
   116)   auxvar2%is_dry = auxvar%is_dry
   117)   auxvar2%head = auxvar%head
   118)   auxvar2%temp = auxvar%temp
   119)   auxvar2%den_kg = auxvar%den_kg
   120) 
   121) end subroutine SurfaceGlobalAuxVarCopy
   122) 
   123) ! ************************************************************************** !
   124) 
   125) subroutine SurfaceGlobalAuxVarSingleDestroy(auxvar)
   126)   ! 
   127)   ! This routine
   128)   ! 
   129)   ! Author: Gautam Bisht, LBNL
   130)   ! Date: 02/28/13
   131)   ! 
   132) 
   133)   implicit none
   134) 
   135)   type(surface_global_auxvar_type), pointer :: auxvar
   136)   
   137)   if (associated(auxvar)) then
   138)     call SurfaceGlobalAuxVarStrip(auxvar)
   139)     deallocate(auxvar)
   140)   endif
   141)   nullify(auxvar)
   142) 
   143) end subroutine SurfaceGlobalAuxVarSingleDestroy
   144) 
   145) ! ************************************************************************** !
   146) 
   147) subroutine SurfaceGlobalAuxVarArrayDestroy(auxvars)
   148)   ! 
   149)   ! This routine
   150)   ! 
   151)   ! Author: Gautam Bisht, LBNL
   152)   ! Date: 02/28/13
   153)   ! 
   154) 
   155)   implicit none
   156) 
   157)   type(surface_global_auxvar_type), pointer :: auxvars(:)
   158)   
   159)   PetscInt :: iaux
   160)   
   161)   if (associated(auxvars)) then
   162)     do iaux = 1, size(auxvars)
   163)       call SurfaceGlobalAuxVarStrip(auxvars(iaux))
   164)     enddo  
   165)     deallocate(auxvars)
   166)   endif
   167)   nullify(auxvars)
   168) 
   169) end subroutine SurfaceGlobalAuxVarArrayDestroy
   170) 
   171) ! ************************************************************************** !
   172) 
   173) subroutine SurfaceGlobalAuxVarStrip(auxvar)
   174)   ! 
   175)   ! This routine
   176)   ! 
   177)   ! Author: Gautam Bisht, LBNL
   178)   ! Date: 02/28/13
   179)   ! 
   180) 
   181)   use Utility_module, only: DeallocateArray
   182) 
   183)   implicit none
   184) 
   185)   type(surface_global_auxvar_type) :: auxvar
   186)   
   187)   call DeallocateArray(auxvar%head)
   188)   call DeallocateArray(auxvar%den_kg)
   189) 
   190) 
   191) end subroutine SurfaceGlobalAuxVarStrip
   192) 
   193) ! ************************************************************************** !
   194) 
   195) subroutine SurfaceGlobalAuxDestroy(aux)
   196)   ! 
   197)   ! This routine
   198)   ! 
   199)   ! Author: Gautam Bisht, LBNL
   200)   ! Date: 02/28/13
   201)   ! 
   202) 
   203)   implicit none
   204) 
   205)   type(surface_global_type), pointer :: aux
   206)   PetscInt :: iaux
   207)   
   208)   if (.not.associated(aux)) return
   209)   
   210)   call SurfaceGlobalAuxVarDestroy(aux%auxvars)
   211)   call SurfaceGlobalAuxVarDestroy(aux%auxvars_bc)
   212)   call SurfaceGlobalAuxVarDestroy(aux%auxvars_ss)
   213)   
   214)   deallocate(aux)
   215)   nullify(aux)
   216)   
   217) end subroutine SurfaceGlobalAuxDestroy
   218) 
   219) end module Surface_Global_Aux_module

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