Skip to content

Commit

Permalink
Merge branch 'glasstracking' into debugGlassMerge
Browse files Browse the repository at this point in the history
  • Loading branch information
@daminton
daminton committed Jul 23, 2021
2 parents b9907c3 + b7121bc commit 6d1af96
Show file tree
Hide file tree
Showing 83 changed files with 5,708 additions and 1,404 deletions.
16 changes: 12 additions & 4 deletions src/Makefile.am
View file
Original file line number Diff line number Diff line change
Expand Up @@ -41,7 +41,6 @@ io/io_input.f90\
io/io_read_craterlist.f90\
io/io_read_prod.f90\
io/io_read_regotrack.f90\
io/io_read_porotrack.f90\
io/io_read_vdist.f90\
io/io_read_surf.f90\
io/io_ejecta_table.f90\
Expand All @@ -50,11 +49,13 @@ io/io_write_tally.f90\
io/io_write_surf.f90\
io/io_write_const.f90\
io/io_write_regotrack.f90\
io/io_write_porotrack.f90\
io/io_crater_profile.f90\
io/io_updatePbar.f90\
io/io_resetPbar.f90\
io/io_splash.f90\
io/io_write_age.f90\
io/io_write_pindex_map.f90\
io/io_write_age_depth.f90\
ejecta/ejecta_emplace.f90\
ejecta/ejecta_ray_pattern.f90\
ejecta/ejecta_blanket.f90\
Expand All @@ -73,20 +74,21 @@ crater/crater_averages.f90\
crater/crater_emplace.f90\
crater/crater_form_interior.f90\
crater/crater_form_exterior.f90\
crater/crater_form_exterior_func.f90\
crater/crater_form_exterior_rootfind.f90\
crater/crater_record.f90\
crater/crater_tally_true.f90\
crater/crater_tally_observed.f90\
crater/crater_slope_collapse.f90\
crater/crater_soften.f90\
crater/crater_soften_accumulate.f90\
crater/crater_subpixel_diffusion.f90\
crater/crater_make_list.f90\
crater/crater_critical_slope.f90\
crater/crater_superdomain.f90\
init/init_domain.f90\
init/init_dist.f90\
init/init_surf.f90\
init/init_regolith_stack.f90\
init/init_porosity_stack.f90\
seismic/seismic_shake.f90\
seismic/seismic_distance.f90\
seismic/seismic_kdiff_func.f90\
Expand All @@ -106,6 +108,12 @@ regolith/regolith_subpixel_streamtube.f90\
regolith/regolith_transport.f90\
regolith/regolith_traverse_streamtube.f90\
regolith/regolith_subcrater_mix.f90\
regolith/regolith_melt_glass.f90\
regolith/regolith_superdomain.f90\
regolith/regolith_melt_zone_superdomain.f90\
regolith/regolith_streamtube_volume_func.f90\
regolith/regolith_shock_damage_zone.f90\
regolith/regolith_shock_damage.f90\
porosity/porosity_form_interior.f90\
main/CTEM.f90
CLEANFILES = *.mod
9 changes: 3 additions & 6 deletions src/crater/crater_emplace.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -64,7 +64,7 @@ subroutine crater_emplace(user,surf,crater,domain,deltaMtot)
real(DP),intent(out) :: deltaMtot

! Internal variables
real(DP) :: lradsq,newelev, x_relative, y_relative
real(DP) :: lradsq,newelev
integer(I4B) :: xpi,ypi,i,j,inc,incsq,iradsq
real(DP) :: xp,yp,fradsq,deltaMi,rimheight
logical :: lastloop
Expand Down Expand Up @@ -94,13 +94,10 @@ subroutine crater_emplace(user,surf,crater,domain,deltaMtot)

! periodic boundary conditions
call util_periodic(xpi,ypi,user%gridsize)
x_relative = (crater%xl - xp)
y_relative = (crater%yl - yp)

lradsq = x_relative**2 + y_relative**2
lradsq = (crater%xl - xp)**2 + (crater%yl - yp)**2

if (lradsq > crater%frad**2) cycle
call crater_form_interior(user,surf(xpi,ypi),crater,x_relative, y_relative,newelev,deltaMi)
call crater_form_interior(user,surf(xpi,ypi),crater,lradsq,newelev,deltaMi)
deltaMtot = deltaMtot + deltaMi

! do porosity computation if (user%doporosity)
Expand Down
6 changes: 3 additions & 3 deletions src/crater/crater_form_interior.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -18,7 +18,7 @@
! Notes :
!
!**********************************************************************************************************************************
subroutine crater_form_interior(user,surfi,crater,x_relative, y_relative ,newelev,deltaMi)
subroutine crater_form_interior(user,surfi,crater,lradsq,newelev,deltaMi)
use module_globals
use module_util
use module_crater, EXCEPT_THIS_ONE => crater_form_interior
Expand All @@ -28,7 +28,7 @@ subroutine crater_form_interior(user,surfi,crater,x_relative, y_relative ,newele
type(usertype),intent(in) :: user
type(surftype),intent(inout) :: surfi
type(cratertype),intent(in) :: crater
real(DP),intent(in) :: x_relative, y_relative
real(DP),intent(in) :: lradsq
real(DP),intent(in) :: newelev
real(DP),intent(out) :: deltaMi

Expand All @@ -42,7 +42,7 @@ subroutine crater_form_interior(user,surfi,crater,x_relative, y_relative ,newele
! Executable code

!change digital elevation map
r = sqrt(x_relative**2+y_relative**2) / crater%frad
r = sqrt(lradsq) / crater%frad
! Use empirical crater form from Fassett et al. 2014
if (r < 0.2_DP) then
cform = -0.181_DP * crater%fcrat
Expand Down
90 changes: 48 additions & 42 deletions src/crater/crater_populate.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -76,15 +76,22 @@ subroutine crater_populate(user,surf,crater,domain,prod,production_list,vdist,nt
real(DP) :: ejbmass
logical :: makecrater
real(DP),dimension(user%gridsize,user%gridsize) :: kdiff
TARGET :: surf
integer(I4B) :: oldpbarpos

! ejecta blanket array
type(ejbtype),dimension(EJBTABSIZE) :: ejb ! Ejecta blanket lookup table
integer(I4B) :: ejtble
! doregotrack
real(DP) :: melt, clock!, volume, r1, r2, h
! subpixel utilities
real(DP),dimension(2,domain%pnum) :: p
integer(I4B) :: craters_since_subpixel_mix, icrater_last_subpixel_mix
integer(I4B) :: craters_since_subpixel_mix, icrater_last_subpixel_mix

! doregotrack & age simulation test
real(DP) :: melt, age, thick
real(SP),dimension(user%gridsize, user%gridsize) :: agetop
real(SP),dimension(60) :: agetot
type(regolisttype),pointer :: current => null()
real(DP) :: age_resolution

if (user%testflag) then
write(*,*) "Generating a test crater"
Expand Down Expand Up @@ -123,20 +130,21 @@ subroutine crater_populate(user,surf,crater,domain,prod,production_list,vdist,nt
! begin cratering loop
if (.not.user%testflag) then
pbarival = floor(real(ntrue)/real(PBARRES))
call io_resetPbar()
!call io_resetPbar()
end if

icrater_last_tally = 0
icrater_last_subpixel = 0
icrater = 0
clock = 0.0_DP
! Reset age
finterval = 1.0_DP / real(ntotcrat,kind=DP)
age = user%interval
age_resolution = age / real(MAXAGEBINS)

! Reset coverage map
domain%tallycoverage = 0
domain%subpixelcoverage = 0
kdiff = 0.0_DP
pbarpos = 0
call io_updatePbar("")
oldpbarpos = 0
do while (icrater < ntotcrat)
makecrater = .true.
timestamp_old = real(curyear + real(icrater,kind=DP) / real(ntotcrat,kind=DP) * user%interval,kind=SP)
Expand Down Expand Up @@ -218,7 +226,6 @@ subroutine crater_populate(user,surf,crater,domain,prod,production_list,vdist,nt
truelist(4,ntrue) = crater%yl
truelist(5,ntrue) = crater%impvel
truelist(6,ntrue) = crater%sinimpang
truelist(7,ntrue) = crater%timestamp
mass = mass + crater%impmass

crater%maxinc = 0
Expand Down Expand Up @@ -253,7 +260,7 @@ subroutine crater_populate(user,surf,crater,domain,prod,production_list,vdist,nt
call ejecta_table_define(user,crater,domain,ejb,ejtble)
call ejecta_interpolate(crater,domain,crater%frad,ejb(1:ejtble),ejtble,crater%ejrim)
end if
call ejecta_emplace(user,surf,crater,domain,ejb(1:ejtble),ejtble,ejbmass)
call ejecta_emplace(user,surf,crater,domain,ejb(1:ejtble),ejtble,ejbmass,age,age_resolution)
else
ejtble = 0
end if
Expand All @@ -266,12 +273,7 @@ subroutine crater_populate(user,surf,crater,domain,prod,production_list,vdist,nt
call util_sort_layer(user,surf,crater)
vistrue = vistrue + 1
nsincetally = nsincetally + 1
if (.not.user%testflag) then
if (pbarpos /= oldpbarpos) then
call io_updatePbar("")
oldpbarpos = pbarpos
end if
end if
!if (.not.user%testflag) call io_updatePbar("")

!if (user%docrustal_thinning) call crust_thin(user,surf,crater,domain,mdepth)

Expand Down Expand Up @@ -301,41 +303,45 @@ subroutine crater_populate(user,surf,crater,domain,prod,production_list,vdist,nt
end if

! Do sub-pixel craters vertical mixing
! Do superdomain ray deposits
finterval = 1.0_DP / real(ntotcrat,kind=DP)
if (user%doregotrack) then
finterval = 1.0_DP / real(ntotcrat,kind=DP)
call crater_superdomain(user,surf,age,age_resolution,prod,nflux,domain,finterval)
call regolith_depth_model(user,domain,finterval,nflux,p)
call regolith_subcrater_mix(user,surf,domain,nflux,finterval,p)
end if

! Do periodic subpixel processes on the whole grid
if (.not.user%testflag) then
if ((domain%subpixelcoverage / real(user%gridsize**2,kind=DP) > SUBPIXELCOVERAGE).or.(icrater == ntotcrat)) then
domain%subpixelcoverage = 0
write(message,*) "Subpixel"
call io_updatePbar(message)
craters_since_subpixel = icrater - icrater_last_subpixel
finterval = craters_since_subpixel / real(ntotcrat,kind=DP)
call crater_subpixel_diffusion(user,surf,prod,nflux,domain,finterval,kdiff)
icrater_last_subpixel = icrater
end if
! Intermediate tally step
if (domain%tallycoverage / real(user%gridsize**2,kind=DP) > TALLYCOVERAGE) then
domain%tallycoverage = 0
write(message,*) "Tally"
call io_updatePbar(message)
craters_since_tally = icrater - icrater_last_tally
finterval = craters_since_tally / real(ntotcrat,kind=DP)
icrater_last_tally = icrater
call crater_tally_observed(user,surf,domain,nkilled,onum)
write(message,*) "Tally killed ",nkilled
call io_updatePbar(message)
ntotkilled = ntotkilled + nkilled
nsincetally = 0
if (.not.user%doregotrack) then ! Disable whole grid subpixel if doregotrack flag is on
if (.not.user%testflag) then
if ((domain%subpixelcoverage / real(user%gridsize**2,kind=DP) > SUBPIXELCOVERAGE).or.(icrater == ntotcrat)) then
domain%subpixelcoverage = 0
write(message,*) "Subpixel"
call io_updatePbar(message)
craters_since_subpixel = icrater - icrater_last_subpixel
finterval = craters_since_subpixel / real(ntotcrat,kind=DP)
call crater_subpixel_diffusion(user,surf,prod,nflux,domain,finterval,kdiff)
icrater_last_subpixel = icrater
end if
! Intermediate tally step
if (domain%tallycoverage / real(user%gridsize**2,kind=DP) > TALLYCOVERAGE) then
domain%tallycoverage = 0
write(message,*) "Tally"
call io_updatePbar(message)
craters_since_tally = icrater - icrater_last_tally
finterval = craters_since_tally / real(ntotcrat,kind=DP)
icrater_last_tally = icrater
call crater_tally_observed(user,surf,domain,nkilled,onum)
write(message,*) "Tally killed ",nkilled
call io_updatePbar(message)
ntotkilled = ntotkilled + nkilled
nsincetally = 0
end if
end if

end if

end do ! end crater production loop

! Resize the true crater size array to the actual number of craters produced
! Display stats
ddmax = rmax / cmax
Expand Down
Loading

0 comments on commit 6d1af96

Please sign in to comment.