pmc_surface.F90       coverage:  77.78 %func     50.00 %block


     1) module PMC_Surface_class
     2) 
     3)   use PMC_Base_class
     4)   use Realization_Subsurface_class
     5)   use Realization_Surface_class
     6)   use Timestepper_Surface_class
     7) 
     8)   use PFLOTRAN_Constants_module
     9) 
    10)   implicit none
    11) 
    12) #include "petsc/finclude/petscsys.h"
    13) 
    14)   private
    15) 
    16)   type, public, extends(pmc_base_type) :: pmc_surface_type
    17)     class(realization_subsurface_type), pointer :: subsurf_realization
    18)     class(realization_surface_type), pointer :: surf_realization
    19)   contains
    20)     procedure, public :: Init => PMCSurfaceInit
    21)     procedure, public :: RunToTime => PMCSurfaceRunToTime
    22)     procedure, public :: GetAuxData => PMCSurfaceGetAuxData
    23)     procedure, public :: SetAuxData => PMCSurfaceSetAuxData
    24)     procedure, public :: PMCSurfaceGetAuxDataAfterRestart
    25)     procedure, public :: Destroy => PMCSurfaceDestroy
    26)   end type pmc_surface_type
    27) 
    28)   public :: PMCSurfaceCreate
    29) 
    30) contains
    31) 
    32) ! ************************************************************************** !
    33) 
    34) function PMCSurfaceCreate()
    35)   ! 
    36)   ! This routine
    37)   ! 
    38)   ! Author: Gautam Bisht, LBNL
    39)   ! Date: 06/27/13
    40)   ! 
    41) 
    42)   implicit none
    43)   
    44)   class(pmc_surface_type), pointer :: PMCSurfaceCreate
    45)   
    46)   class(pmc_surface_type), pointer :: pmc
    47) 
    48)   print *, 'PMCSurfaceCreate%Create()'
    49)   
    50)   allocate(pmc)
    51)   call pmc%Init()
    52)   
    53)   PMCSurfaceCreate => pmc  
    54)   
    55) end function PMCSurfaceCreate
    56) 
    57) ! ************************************************************************** !
    58) 
    59) subroutine PMCSurfaceInit(this)
    60)   ! 
    61)   ! This routine
    62)   ! 
    63)   ! Author: Gautam Bisht, LBNL
    64)   ! Date: 06/27/13
    65)   ! 
    66) 
    67)   implicit none
    68)   
    69)   class(pmc_surface_type) :: this
    70)   
    71)   print *, 'PMCSurfaceInit%Init()'
    72)   
    73)   call PMCBaseInit(this)
    74)   nullify(this%surf_realization)
    75)   nullify(this%subsurf_realization)
    76) !  nullify(this%surf_timestepper)
    77) 
    78) end subroutine PMCSurfaceInit
    79) 
    80) ! ************************************************************************** !
    81) 
    82) recursive subroutine PMCSurfaceRunToTime(this,sync_time,stop_flag)
    83)   ! 
    84)   ! This routine
    85)   ! 
    86)   ! Author: Gautam Bisht, LBNL
    87)   ! Date: 06/27/13
    88)   ! 
    89) 
    90)   use Timestepper_Base_class
    91)   use Output_Aux_module
    92)   use Output_module, only : Output
    93)   use Realization_Subsurface_class, only : realization_subsurface_type
    94)   use PM_Base_class
    95)   use PM_Surface_Flow_class
    96)   use Option_module
    97)   use Surface_Flow_module
    98)   use Surface_TH_module
    99)   use Output_Surface_module
   100)   use Checkpoint_module
   101)   
   102)   implicit none
   103) #include "petsc/finclude/petscviewer.h"
   104)   
   105)   class(pmc_surface_type), target :: this
   106)   PetscReal :: sync_time
   107)   PetscInt :: stop_flag
   108)   character(len=MAXSTRINGLENGTH) :: filename_append
   109)   class(pmc_base_type), pointer :: pmc_base
   110)   PetscInt :: local_stop_flag
   111)   PetscBool :: failure
   112)   PetscBool :: snapshot_plot_flag
   113)   PetscBool :: observation_plot_flag
   114)   PetscBool :: massbal_plot_flag
   115)   PetscBool :: checkpoint_at_this_time_flag
   116)   PetscBool :: checkpoint_at_this_timestep_flag
   117)   class(pm_base_type), pointer :: cur_pm
   118)   PetscReal :: dt_max_loc
   119)   PetscReal :: dt_max_glb
   120)   PetscViewer :: viewer
   121)   PetscErrorCode :: ierr
   122)   
   123)   this%option%io_buffer = trim(this%name) // ':' // trim(this%pm_list%name)
   124)   call printVerboseMsg(this%option)
   125)   
   126)   ! Get data of other process-model
   127)   if (this%option%restart_flag .and. this%option%first_step_after_restart) then
   128)     this%option%first_step_after_restart = PETSC_FALSE
   129)   else
   130)     call this%GetAuxData()
   131)   endif
   132) 
   133)   local_stop_flag = TS_CONTINUE
   134)   do
   135)     if (local_stop_flag /= TS_CONTINUE) exit ! end simulation
   136)     if (this%timestepper%target_time >= sync_time) exit
   137)     
   138)     call SetOutputFlags(this)
   139)     snapshot_plot_flag = PETSC_FALSE
   140)     observation_plot_flag = PETSC_FALSE
   141)     massbal_plot_flag = PETSC_FALSE
   142)     checkpoint_at_this_time_flag = PETSC_FALSE
   143)     checkpoint_at_this_timestep_flag = PETSC_FALSE
   144)     
   145)     cur_pm => this%pm_list
   146) 
   147)     select case(this%option%iflowmode)
   148)       case (RICHARDS_MODE)
   149)         call SurfaceFlowComputeMaxDt(this%surf_realization,dt_max_loc)
   150)       case (TH_MODE)
   151)         call SurfaceTHComputeMaxDt(this%surf_realization,dt_max_loc)
   152)     end select
   153) 
   154)     ! Find mininum allowable timestep across all processors
   155)     call MPI_Allreduce(dt_max_loc,dt_max_glb,ONE_INTEGER_MPI, &
   156)                        MPI_DOUBLE_PRECISION,MPI_MIN,this%option%mycomm,ierr)
   157)     select type(timestepper => this%timestepper)
   158)       class is(timestepper_surface_type)
   159)         timestepper%dt_max_allowable = dt_max_glb
   160)         timestepper%surf_subsurf_coupling_flow_dt = &
   161)           this%option%surf_subsurf_coupling_flow_dt
   162)     end select
   163)     call this%timestepper%SetTargetTime(sync_time,this%option, &
   164)                                         local_stop_flag,snapshot_plot_flag, &
   165)                                         observation_plot_flag, &
   166)                                         massbal_plot_flag, &
   167)                                         checkpoint_at_this_time_flag)
   168) 
   169)     this%option%surf_flow_dt = this%timestepper%dt
   170) 
   171)     ! Accumulate data needed by process-model
   172)     call this%AccumulateAuxData()
   173) 
   174)     call this%timestepper%StepDT(this%pm_list,local_stop_flag)
   175) 
   176)     if (local_stop_flag  == TS_STOP_FAILURE) exit ! failure
   177)     ! Have to loop over all process models coupled in this object and update
   178)     ! the time step size.  Still need code to force all process models to
   179)     ! use the same time step size if tightly or iteratively coupled.
   180)     cur_pm => this%pm_list
   181)     do
   182)       if (.not.associated(cur_pm)) exit
   183)       ! have to update option%time for conditions
   184)       this%option%time = this%timestepper%target_time
   185)       call cur_pm%UpdateSolution()
   186)       !! TODO(gb)
   187)       !!!call this%timestepper%UpdateDT(cur_pm)
   188)       cur_pm => cur_pm%next
   189)     enddo
   190) 
   191) #if 0
   192)     ! Run underlying process model couplers
   193)     if (associated(this%child)) then
   194)       call this%child%RunToTime(this%timestepper%target_time,local_stop_flag)
   195)     endif
   196) #endif
   197)     
   198)     ! only print output for process models of depth 0
   199)     ! TODO(GB): Modify OutputSurface()
   200)     !if (associated(this%Output)) then
   201)       if (this%timestepper%time_step_cut_flag) then
   202)         snapshot_plot_flag = PETSC_FALSE
   203)       endif
   204)       ! however, if we are using the modulus of the output_option%imod, we may
   205)       ! still print
   206)       if (mod(this%timestepper%steps,this%pm_list% &
   207)               output_option%periodic_snap_output_ts_imod) == 0) then
   208)         snapshot_plot_flag = PETSC_TRUE
   209)       endif
   210)       if (mod(this%timestepper%steps,this%pm_list%output_option% &
   211)               periodic_obs_output_ts_imod) == 0) then
   212)         observation_plot_flag = PETSC_TRUE
   213)       endif
   214)       if (mod(this%timestepper%steps,this%pm_list%output_option% &
   215)               periodic_msbl_output_ts_imod) == 0) then
   216)         massbal_plot_flag = PETSC_TRUE
   217)       endif
   218)       !call this%Output(this%pm_list%realization_base,snapshot_plot_flag, &
   219)       !                 observation_plot_flag, massbal_plot_flag)
   220)       call OutputSurface(this%surf_realization, this%subsurf_realization, &
   221)                          snapshot_plot_flag, observation_plot_flag, &
   222)                          massbal_plot_flag)
   223)     !endif
   224) 
   225)     if (this%is_master .and. associated(this%checkpoint_option)) then
   226)       if (this%checkpoint_option%periodic_ts_incr > 0 .and. &
   227)           mod(this%timestepper%steps, &
   228)               this%checkpoint_option%periodic_ts_incr) == 0) then
   229)         checkpoint_at_this_timestep_flag = PETSC_TRUE
   230)       endif
   231)     endif
   232) 
   233)     if (checkpoint_at_this_time_flag .or. &
   234)         checkpoint_at_this_timestep_flag) then
   235)       ! if checkpointing, need to sync all other PMCs.  Those "below" are
   236)       ! already in sync, but not those "next".
   237)       ! Set data needed by process-model
   238)       call this%SetAuxData()
   239)       ! Run neighboring process model couplers
   240)       if (associated(this%peer)) then
   241)         call this%peer%RunToTime(this%timestepper%target_time,local_stop_flag)
   242)       endif
   243)       call this%GetAuxData()
   244)       ! it is possible that two identical checkpoint files will be created,
   245)       ! one at the time and another at the time step, but this is fine.
   246)       if (checkpoint_at_this_time_flag) then
   247)         filename_append = &
   248)           CheckpointAppendNameAtTime(this%checkpoint_option, &
   249)                                      this%option%time, &
   250)                                      this%option)
   251)         call this%Checkpoint(filename_append)
   252)       endif
   253)       if (checkpoint_at_this_timestep_flag) then
   254)         filename_append = &
   255)           CheckpointAppendNameAtTimestep(this%checkpoint_option, &
   256)                                          this%timestepper%steps, &
   257)                                          this%option)
   258)         call this%Checkpoint(filename_append)
   259)       endif
   260)     endif                         
   261)                          
   262)   enddo
   263)   
   264)   this%option%surf_flow_time = this%timestepper%target_time
   265) 
   266)   ! Set data needed by process-model
   267)   call this%SetAuxData()
   268) 
   269)   ! Run neighboring process model couplers
   270)   if (associated(this%peer)) then
   271)     call this%peer%RunToTime(sync_time,local_stop_flag)
   272)   endif
   273) 
   274)   stop_flag = max(stop_flag,local_stop_flag)
   275)   
   276) end subroutine PMCSurfaceRunToTime
   277) 
   278) ! ************************************************************************** !
   279) 
   280) subroutine PMCSurfaceGetAuxData(this)
   281)   ! 
   282)   ! This routine
   283)   ! 
   284)   ! Author: Gautam Bisht, LBNL
   285)   ! Date: 08/21/13
   286)   ! 
   287) 
   288)   use Surface_Flow_module
   289)   use Surface_TH_module
   290)   use Surface_TH_module
   291)   use Option_module
   292) 
   293)   implicit none
   294)   
   295) #include "petsc/finclude/petscvec.h"
   296) #include "petsc/finclude/petscvec.h90"
   297) 
   298)   class(pmc_surface_type) :: this
   299) 
   300)   PetscErrorCode :: ierr
   301) 
   302) #ifdef DEBUG
   303)   print *, 'PMCSurfaceGetAuxData()'
   304) #endif
   305) 
   306)   if (this%option%subsurf_surf_coupling == SEQ_COUPLED) then
   307)     select type(pmc => this)
   308)       class is(pmc_surface_type)
   309)         select case(this%option%iflowmode)
   310)           case (RICHARDS_MODE)
   311)             call VecScatterBegin(pmc%sim_aux%subsurf_to_surf, &
   312)                                  pmc%sim_aux%subsurf_pres_top_bc, &
   313)                                  pmc%surf_realization%surf_field%press_subsurf, &
   314)                                  INSERT_VALUES,SCATTER_FORWARD, &
   315)                                  ierr);CHKERRQ(ierr)
   316)             call VecScatterEnd(pmc%sim_aux%subsurf_to_surf, &
   317)                                pmc%sim_aux%subsurf_pres_top_bc, &
   318)                                pmc%surf_realization%surf_field%press_subsurf, &
   319)                                INSERT_VALUES,SCATTER_FORWARD, &
   320)                                ierr);CHKERRQ(ierr)
   321)             call SurfaceFlowUpdateSurfState(pmc%surf_realization)
   322)           case (TH_MODE)
   323)             call VecScatterBegin(pmc%sim_aux%subsurf_to_surf, &
   324)                                  pmc%sim_aux%subsurf_pres_top_bc, &
   325)                                  pmc%surf_realization%surf_field%press_subsurf, &
   326)                                  INSERT_VALUES,SCATTER_FORWARD, &
   327)                                  ierr);CHKERRQ(ierr)
   328)             call VecScatterEnd(pmc%sim_aux%subsurf_to_surf, &
   329)                                pmc%sim_aux%subsurf_pres_top_bc, &
   330)                                pmc%surf_realization%surf_field%press_subsurf, &
   331)                                INSERT_VALUES,SCATTER_FORWARD, &
   332)                                ierr);CHKERRQ(ierr)
   333)             call VecScatterBegin(pmc%sim_aux%subsurf_to_surf, &
   334)                                  pmc%sim_aux%subsurf_temp_top_bc, &
   335)                                  pmc%surf_realization%surf_field%temp_subsurf, &
   336)                                  INSERT_VALUES,SCATTER_FORWARD, &
   337)                                  ierr);CHKERRQ(ierr)
   338)             call VecScatterEnd(pmc%sim_aux%subsurf_to_surf, &
   339)                                pmc%sim_aux%subsurf_temp_top_bc, &
   340)                                pmc%surf_realization%surf_field%temp_subsurf, &
   341)                                INSERT_VALUES,SCATTER_FORWARD, &
   342)                                ierr);CHKERRQ(ierr)
   343)             call SurfaceTHUpdateSurfState(pmc%surf_realization)
   344)         end select
   345)     end select
   346)   endif
   347) 
   348) end subroutine PMCSurfaceGetAuxData
   349) 
   350) ! ************************************************************************** !
   351) 
   352) subroutine PMCSurfaceSetAuxData(this)
   353)   ! 
   354)   ! This routine extracts data from surface flow model and stores it sim-aux,
   355)   ! which will be required by the subsurface flow model.
   356)   ! 
   357)   ! Author: Gautam Bisht, LBNL
   358)   ! Date: 08/21/13
   359)   ! 
   360) 
   361)   use Connection_module
   362)   use Coupler_module
   363)   use Grid_module
   364)   use Option_module
   365)   use Patch_module
   366)   use Surface_Global_Aux_module
   367)   use Surface_Flow_module
   368)   use Surface_TH_module
   369)   use Surface_TH_Aux_module
   370)   use Realization_Surface_class
   371)   use String_module
   372) 
   373)   implicit none
   374)   
   375) #include "petsc/finclude/petscvec.h"
   376) #include "petsc/finclude/petscvec.h90"
   377) 
   378)   class(pmc_surface_type) :: this
   379) 
   380)   type(grid_type), pointer :: surf_grid
   381)   type(surface_global_auxvar_type), pointer :: surf_global_auxvars(:)
   382)   type(Surface_TH_auxvar_type), pointer :: surf_auxvars(:)
   383)   type(patch_type), pointer :: surf_patch
   384)   type(coupler_type), pointer :: source_sink
   385)   type(connection_set_type), pointer :: cur_connection_set
   386)   class(realization_surface_type), pointer :: surf_realization
   387) 
   388)   PetscInt :: local_id
   389)   PetscInt :: ghosted_id
   390)   PetscInt :: iend
   391)   PetscInt :: istart
   392)   PetscInt :: iconn
   393) 
   394)   PetscReal :: dt
   395)   PetscReal, pointer :: xx_loc_p(:)
   396)   PetscReal, pointer :: surf_head_p(:)
   397)   PetscReal, pointer :: surf_temp_p(:)
   398)   PetscReal, pointer :: surf_hflux_p(:)
   399)   PetscBool :: found
   400)   PetscReal :: esrc
   401)   PetscReal :: atm_temp
   402)   PetscErrorCode :: ierr
   403) 
   404)   dt = this%option%surf_subsurf_coupling_flow_dt
   405) 
   406)   if (this%option%subsurf_surf_coupling == SEQ_COUPLED) then
   407)     select type(pmc => this)
   408)       class is(pmc_surface_type)
   409) 
   410)         select case(this%option%iflowmode)
   411) 
   412)           case (RICHARDS_MODE)
   413)             call VecCopy(pmc%surf_realization%surf_field%flow_xx, &
   414)                          pmc%sim_aux%surf_head, ierr);CHKERRQ(ierr)
   415)           case (TH_MODE)
   416) 
   417)             surf_realization => pmc%surf_realization
   418)             surf_patch => surf_realization%patch
   419)             surf_grid => surf_patch%grid
   420)             surf_global_auxvars => surf_patch%surf_aux%SurfaceGlobal%auxvars
   421)             surf_auxvars => surf_patch%surf_aux%SurfaceTH%auxvars
   422) 
   423)             call VecGetArrayF90(pmc%surf_realization%surf_field%flow_xx_loc, &
   424)                                 xx_loc_p,ierr);CHKERRQ(ierr)
   425)             call VecGetArrayF90(pmc%sim_aux%surf_head, surf_head_p,  &
   426)                                 ierr);CHKERRQ(ierr)
   427)             call VecGetArrayF90(pmc%sim_aux%surf_temp, surf_temp_p,  &
   428)                                 ierr);CHKERRQ(ierr)
   429)             call VecGetArrayF90(pmc%sim_aux%surf_hflux_exchange_with_subsurf, &
   430)                                 surf_hflux_p, ierr);CHKERRQ(ierr)
   431) 
   432)             do ghosted_id = 1, surf_grid%ngmax
   433)               local_id = surf_grid%nG2L(ghosted_id)
   434)               if (local_id < 1) cycle
   435)               iend = local_id*this%option%nflowdof
   436)               istart = iend - this%option%nflowdof+1
   437)               if (xx_loc_p(istart) < 1.d-8) then
   438)                 surf_head_p(local_id) = 0.d0
   439)                 surf_temp_p(local_id) = this%option%reference_temperature
   440)               else
   441)                 surf_head_p(local_id) = xx_loc_p(istart)
   442)                 surf_temp_p(local_id) = surf_global_auxvars(ghosted_id)%temp
   443)               endif
   444)             enddo
   445) 
   446)             found = PETSC_FALSE
   447)             source_sink => surf_patch%source_sink_list%first
   448)             do
   449)               if (.not.associated(source_sink)) exit
   450) 
   451)               if (associated(source_sink%flow_aux_real_var)) then
   452)                 cur_connection_set => source_sink%connection_set
   453) 
   454)                 if (StringCompare(source_sink%name,'atm_energy_ss')) then
   455) 
   456)                   do iconn = 1, cur_connection_set%num_connections
   457) 
   458)                     local_id = cur_connection_set%id_dn(iconn)
   459)                     select case(source_sink%flow_condition%itype(TH_TEMPERATURE_DOF))
   460)                       case (ENERGY_RATE_SS)
   461)                         esrc = source_sink%flow_condition%energy_rate%dataset%rarray(1)
   462)                       case (HET_ENERGY_RATE_SS)
   463)                         esrc = source_sink%flow_aux_real_var(TWO_INTEGER,iconn)
   464)                       case (DIRICHLET_BC)
   465)                         esrc = source_sink%flow_condition%temperature%dataset%rarray(1)
   466)                       case (HET_DIRICHLET)
   467)                         esrc = source_sink%flow_aux_real_var(TWO_INTEGER,iconn)
   468)                       case default
   469)                         this%option%io_buffer = 'atm_energy_ss does not have '// &
   470)                           'a temperature condition that is either a ' // &
   471)                           ' ENERGY_RATE_SS/HET_ENERGY_RATE_SSDIRICHLET_BC/HET_DIRICHLET'
   472)                         call printErrMsg(this%option)
   473)                     end select
   474) 
   475)                     ! Only when no standing water is present, the atmospheric
   476)                     ! energy flux is applied directly on subsurface domain.
   477)                     if (surf_head_p(local_id) < 1.d-8) then
   478)                       surf_hflux_p(local_id) = esrc
   479)                     else
   480)                       surf_hflux_p(local_id) = 0.d0
   481)                     endif
   482) 
   483)                   enddo
   484) 
   485)                   found = PETSC_TRUE
   486) 
   487)                 endif ! StringCompare()
   488)               endif ! associate()
   489) 
   490)               source_sink => source_sink%next
   491)             enddo
   492) 
   493)             call VecRestoreArrayF90(pmc%surf_realization%surf_field%flow_xx_loc, &
   494)                                     xx_loc_p,ierr);CHKERRQ(ierr)
   495)             call VecRestoreArrayF90(pmc%sim_aux%surf_head, surf_head_p, &
   496)                                     ierr);CHKERRQ(ierr)
   497)             call VecRestoreArrayF90(pmc%sim_aux%surf_temp, surf_temp_p, &
   498)                                     ierr);CHKERRQ(ierr)
   499)             call VecRestoreArrayF90(pmc%sim_aux%surf_hflux_exchange_with_subsurf, &
   500)                                 surf_hflux_p, ierr);CHKERRQ(ierr)
   501) 
   502)             if (.not.(found)) then
   503)               this%option%io_buffer = 'atm_energy_ss not found in surface-flow model'
   504)               call printErrMsg(this%option)
   505)             endif
   506)         end select
   507)     end select
   508)   endif
   509) 
   510) end subroutine PMCSurfaceSetAuxData
   511) 
   512) ! ************************************************************************** !
   513) 
   514) subroutine PMCSurfaceGetAuxDataAfterRestart(this)
   515)   ! 
   516)   ! This routine is called to set values in sim_aux PETSc vectors after restart
   517)   ! checkpoint files is read.
   518)   ! 
   519)   ! Author: Gautam Bisht, LBNL
   520)   ! Date: 09/23/13
   521)   ! 
   522) 
   523)   use Surface_Flow_module
   524)   use Surface_TH_Aux_module
   525)   use Surface_TH_module
   526)   use Option_module
   527)   use EOS_Water_module
   528) 
   529)   implicit none
   530) 
   531) #include "petsc/finclude/petscvec.h"
   532) #include "petsc/finclude/petscvec.h90"
   533) 
   534)   class(pmc_surface_type) :: this
   535) 
   536)   PetscInt :: ghosted_id
   537)   PetscInt :: local_id
   538)   PetscInt :: count
   539)   PetscReal, pointer :: xx_p(:)
   540)   PetscReal, pointer :: surfpress_p(:)
   541)   PetscReal, pointer :: surftemp_p(:)
   542)   PetscInt :: istart, iend
   543)   PetscReal :: den
   544)   PetscReal :: dum1
   545)   PetscErrorCode :: ierr
   546)   type(Surface_TH_auxvar_type), pointer :: surf_auxvars(:)
   547) 
   548)   print *, 'PMCSurfaceGetAuxDataAfterRestart()'
   549) 
   550)   if (this%option%subsurf_surf_coupling == SEQ_COUPLED) then
   551)     select type(pmc => this)
   552)       class is(pmc_surface_type)
   553)         select case(this%option%iflowmode)
   554)           case (RICHARDS_MODE)
   555) 
   556)             call EOSWaterdensity(this%option%reference_temperature, &
   557)                                  this%option%reference_pressure,den,dum1,ierr)
   558) 
   559)             call VecGetArrayF90(pmc%surf_realization%surf_field%flow_xx, xx_p,  &
   560)                                 ierr);CHKERRQ(ierr)
   561)             call VecGetArrayF90(pmc%surf_realization%surf_field%press_subsurf, surfpress_p,  &
   562)                                 ierr);CHKERRQ(ierr)
   563)             count = 0
   564)             do ghosted_id = 1, pmc%surf_realization%discretization%grid%ngmax
   565) 
   566)               local_id = pmc%surf_realization%discretization%grid%nG2L(ghosted_id)
   567)               if (local_id <= 0) cycle
   568) 
   569)               count = count + 1
   570)               surfpress_p(count) = xx_p(ghosted_id)*den*abs(this%option%gravity(3)) + &
   571)                                    this%option%reference_pressure
   572)             enddo
   573)             call VecRestoreArrayF90(pmc%surf_realization%surf_field%flow_xx, xx_p,  &
   574)                                     ierr);CHKERRQ(ierr)
   575)             call VecRestoreArrayF90(pmc%surf_realization%surf_field%press_subsurf, surfpress_p,  &
   576)                                     ierr);CHKERRQ(ierr)
   577) 
   578)             call VecScatterBegin(pmc%sim_aux%subsurf_to_surf, &
   579)                                  pmc%surf_realization%surf_field%press_subsurf, &
   580)                                  pmc%sim_aux%subsurf_pres_top_bc, &
   581)                                  INSERT_VALUES,SCATTER_REVERSE, &
   582)                                  ierr);CHKERRQ(ierr)
   583)             call VecScatterEnd(pmc%sim_aux%subsurf_to_surf, &
   584)                                pmc%surf_realization%surf_field%press_subsurf, &
   585)                                pmc%sim_aux%subsurf_pres_top_bc, &
   586)                                INSERT_VALUES,SCATTER_REVERSE, &
   587)                                ierr);CHKERRQ(ierr)
   588) 
   589)           case (TH_MODE)
   590) 
   591)             ! NOTE(GB:) This is strictly not correct since density should be
   592)             ! computed based on surface-water temperature (not on
   593)             ! reference-temperature). Presently, SurfaceCheckpointProcessModel()
   594)             ! does not output surface-water temperature for TH-Mode and the
   595)             ! subroutine needs to be modified in future.
   596)             call EOSWaterdensity(this%option%reference_temperature, &
   597)                                  this%option%reference_pressure,den,dum1,ierr)
   598) 
   599)             surf_auxvars => pmc%surf_realization%patch%surf_aux%SurfaceTH%auxvars
   600) 
   601)             call VecGetArrayF90(pmc%surf_realization%surf_field%flow_xx, xx_p,  &
   602)                                 ierr);CHKERRQ(ierr)
   603)             call VecGetArrayF90(pmc%surf_realization%surf_field%press_subsurf, surfpress_p,  &
   604)                                 ierr);CHKERRQ(ierr)
   605)             call VecGetArrayF90(pmc%surf_realization%surf_field%temp_subsurf, surftemp_p,  &
   606)                                 ierr);CHKERRQ(ierr)
   607) 
   608)             count = 0
   609)             do ghosted_id = 1, pmc%surf_realization%discretization%grid%ngmax
   610) 
   611)               local_id = pmc%surf_realization%discretization%grid%nG2L(ghosted_id)
   612)               if (local_id <= 0) cycle
   613) 
   614)               count = count + 1
   615)               iend = ghosted_id*this%option%nflowdof
   616)               istart = iend - this%option%nflowdof+1
   617)               surfpress_p(count) = xx_p(istart)*den*abs(this%option%gravity(3)) + &
   618)                                    this%option%reference_pressure
   619)               surftemp_p = xx_p(iend)/xx_p(istart)/den/ &
   620)                       surf_auxvars(ghosted_id)%Cwi - 273.15d0
   621)             enddo
   622)             call VecRestoreArrayF90(pmc%surf_realization%surf_field%flow_xx, xx_p,  &
   623)                                     ierr);CHKERRQ(ierr)
   624)             call VecRestoreArrayF90(pmc%surf_realization%surf_field%press_subsurf, surfpress_p,  &
   625)                                     ierr);CHKERRQ(ierr)
   626)             call VecRestoreArrayF90(pmc%surf_realization%surf_field%temp_subsurf, surftemp_p,  &
   627)                                     ierr);CHKERRQ(ierr)
   628) 
   629)             call VecScatterBegin(pmc%sim_aux%subsurf_to_surf, &
   630)                                  pmc%sim_aux%subsurf_pres_top_bc, &
   631)                                  pmc%surf_realization%surf_field%press_subsurf, &
   632)                                  INSERT_VALUES,SCATTER_FORWARD, &
   633)                                  ierr);CHKERRQ(ierr)
   634)             call VecScatterEnd(pmc%sim_aux%subsurf_to_surf, &
   635)                                pmc%sim_aux%subsurf_pres_top_bc, &
   636)                                pmc%surf_realization%surf_field%press_subsurf, &
   637)                                INSERT_VALUES,SCATTER_FORWARD, &
   638)                                ierr);CHKERRQ(ierr)
   639)             call VecScatterBegin(pmc%sim_aux%subsurf_to_surf, &
   640)                                  pmc%sim_aux%subsurf_temp_top_bc, &
   641)                                  pmc%surf_realization%surf_field%temp_subsurf, &
   642)                                  INSERT_VALUES,SCATTER_FORWARD, &
   643)                                  ierr);CHKERRQ(ierr)
   644)             call VecScatterEnd(pmc%sim_aux%subsurf_to_surf, &
   645)                                pmc%sim_aux%subsurf_temp_top_bc, &
   646)                                pmc%surf_realization%surf_field%temp_subsurf, &
   647)                                INSERT_VALUES,SCATTER_FORWARD, &
   648)                                ierr);CHKERRQ(ierr)
   649)         end select
   650)     end select
   651)   endif
   652) 
   653) end subroutine PMCSurfaceGetAuxDataAfterRestart
   654) 
   655) ! ************************************************************************** !
   656) 
   657) recursive subroutine PMCSurfaceFinalizeRun(this)
   658)   ! 
   659)   ! This routine
   660)   ! 
   661)   ! Author: Gautam Bisht, LBNL
   662)   ! Date: 06/27/13
   663)   ! 
   664) 
   665)   use Option_module
   666)   
   667)   implicit none
   668)   
   669)   class(pmc_surface_type), target :: this
   670)   
   671)   call printMsg(this%option,'PMCSurface%FinalizeRun()')
   672)   
   673)   nullify(this%surf_realization)
   674) !  nullify(this%surf_timestepper)
   675)   
   676) end subroutine PMCSurfaceFinalizeRun
   677) 
   678) ! ************************************************************************** !
   679) 
   680) subroutine PMCSurfaceStrip(this)
   681)   !
   682)   ! Deallocates members of PMC Surface.
   683)   !
   684)   ! Author: Glenn Hammond
   685)   ! Date: 12/02/14
   686)   
   687)   implicit none
   688)   
   689)   class(pmc_surface_type) :: this
   690) 
   691)   call PMCBaseStrip(this)
   692)   ! realizations destroyed elsewhere
   693)   nullify(this%subsurf_realization)
   694)   nullify(this%surf_realization)
   695) 
   696) end subroutine PMCSurfaceStrip
   697) 
   698) ! ************************************************************************** !
   699) 
   700) recursive subroutine PMCSurfaceDestroy(this)
   701)   ! 
   702)   ! Author: Glenn Hammond
   703)   ! Date: 12/02/14
   704)   ! 
   705)   use Option_module
   706) 
   707)   implicit none
   708)   
   709)   class(pmc_surface_type) :: this
   710)   
   711) #ifdef DEBUG
   712)   call printMsg(this%option,'PMCSurface%Destroy()')
   713) #endif
   714) 
   715)   if (associated(this%child)) then
   716)     call this%child%Destroy()
   717)     ! destroy does not currently destroy; it strips
   718)     deallocate(this%child)
   719)     nullify(this%child)
   720)   endif 
   721)   
   722)   if (associated(this%peer)) then
   723)     call this%peer%Destroy()
   724)     ! destroy does not currently destroy; it strips
   725)     deallocate(this%peer)
   726)     nullify(this%peer)
   727)   endif
   728)   
   729)   call PMCSurfaceStrip(this)
   730)   
   731) end subroutine PMCSurfaceDestroy
   732) 
   733) end module PMC_Surface_class

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