From c5030d360f06d9e8bcfbb76c3157ae88cfec77b8 Mon Sep 17 00:00:00 2001 From: Austin Michael Blevins Date: Thu, 3 Nov 2022 13:59:17 -0400 Subject: [PATCH] added calculation for how much melt is ejected-- will need this when melt sheets are implemented --- src/ejecta/ejecta_emplace.f90 | 10 ++++++++-- src/ejecta/ejecta_table_define.f90 | 4 ++-- src/regolith/module_regolith.f90 | 10 ++++++---- src/regolith/regolith_melt_glass.f90 | 5 +++-- src/regolith/regolith_melt_zone.f90 | 6 +++--- src/regolith/regolith_melt_zone_superdomain.f90 | 3 ++- src/regolith/regolith_streamtube.f90 | 5 +++-- src/regolith/regolith_superdomain.f90 | 4 ++-- 8 files changed, 29 insertions(+), 18 deletions(-) diff --git a/src/ejecta/ejecta_emplace.f90 b/src/ejecta/ejecta_emplace.f90 index 8da930b2..f22d26cb 100644 --- a/src/ejecta/ejecta_emplace.f90 +++ b/src/ejecta/ejecta_emplace.f90 @@ -106,6 +106,7 @@ subroutine ejecta_emplace(user,surf,crater,domain,ejb,ejtble,deltaMtot,age,age_r real(DP),dimension(:,:),allocatable :: ejdistribution,diffdistribution integer(I4B) :: bigi,bigj,maxhits,nin,nnot,dradsq character(len=MESSAGESIZE) :: message ! message for the progress bar + real(DP) :: vmelt, totmelt, volm ! Ray mixing model variables @@ -126,7 +127,8 @@ subroutine ejecta_emplace(user,surf,crater,domain,ejb,ejtble,deltaMtot,age,age_r ! Executable code - if (user%doregotrack) call regolith_melt_zone(user,crater,crater%imp,crater%impvel,rm,dm) + if (user%doregotrack) call regolith_melt_zone(user,crater,crater%imp,crater%impvel,rm,dm,totmelt) + vmelt = 0.0_DP crater%vdepth = crater%rimheight + crater%floordepth crater%vrim = crater%rimheight @@ -272,13 +274,17 @@ subroutine ejecta_emplace(user,surf,crater,domain,ejb,ejtble,deltaMtot,age,age_r if (user%doregotrack .and. ebh>1.0e-8_DP) then - call regolith_streamtube(user,surf,crater,domain,ejb,ejtble,xp,yp,xpi,ypi,lrad,ebh,rm,vsq,age,age_resolution) + call regolith_streamtube(user,surf,crater,domain,ejb,ejtble,xp,yp,xpi,ypi,lrad,ebh,rm,vsq,age,age_resolution,volm) + vmelt = vmelt + volm end if end do end do !!$OMP END PARALLEL DO + write(*,*) 'Ejected Melt: ', vmelt + write(*,*) 'Total Melt: ', totmelt + write(*,*) 'ejected / total melt:', vmelt/totmelt ejbmass = sum(cumulative_elchange) ! Create buffer to prevent infinite hole bug diff --git a/src/ejecta/ejecta_table_define.f90 b/src/ejecta/ejecta_table_define.f90 index 01ab7ce8..cf259e2d 100644 --- a/src/ejecta/ejecta_table_define.f90 +++ b/src/ejecta/ejecta_table_define.f90 @@ -38,7 +38,7 @@ subroutine ejecta_table_define(user,crater,domain,ejb,ejtble,melt) logical :: firstrun ! Regotrack internal variables - real(DP) :: rmelt,depthb,dimp,vimp + real(DP) :: rmelt,depthb,dimp,vimp, volm ! Executable code @@ -64,7 +64,7 @@ subroutine ejecta_table_define(user,crater,domain,ejb,ejtble,melt) vimp = crater%impvel end if - call regolith_melt_zone(user,crater,dimp,vimp,rmelt,depthb) + call regolith_melt_zone(user,crater,dimp,vimp,rmelt,depthb, volm) end if do k = 0,EJBTABSIZE diff --git a/src/regolith/module_regolith.f90 b/src/regolith/module_regolith.f90 index 30ec5d64..5aa2a944 100644 --- a/src/regolith/module_regolith.f90 +++ b/src/regolith/module_regolith.f90 @@ -35,12 +35,12 @@ module module_regolith save interface - subroutine regolith_melt_zone(user,crater,dimp,vimp,rmelt,depthb) + subroutine regolith_melt_zone(user,crater,dimp,vimp,rmelt,depthb, volm) use module_globals type(usertype),intent(in) :: user type(cratertype),intent(inout) :: crater real(DP),intent(in) :: dimp,vimp - real(DP),intent(out) :: rmelt,depthb + real(DP),intent(out) :: rmelt,depthb,volm end subroutine regolith_melt_zone end interface @@ -77,7 +77,7 @@ end subroutine regolith_transport interface subroutine regolith_streamtube(user,surf,crater,domain,ejb,ejtble,xp,yp,xpi,ypi,lrad,ebh,& - rm,vsq,age,age_resolution) + rm,vsq,age,age_resolution, volm) use module_globals implicit none type(usertype),intent(in) :: user @@ -89,6 +89,7 @@ subroutine regolith_streamtube(user,surf,crater,domain,ejb,ejtble,xp,yp,xpi,ypi, real(DP),intent(in) :: xp,yp,lrad,ebh integer(I4B),intent(in) :: xpi,ypi real(DP),intent(in) :: rm, vsq, age, age_resolution + real(DP),intent(inout) :: volm end subroutine regolith_streamtube end interface @@ -245,7 +246,7 @@ end subroutine regolith_depth_model end interface interface - subroutine regolith_melt_glass(user,crater,age,age_resolution,ebh,rm,eradc,lrad,deltar,newlayer,xmints) + subroutine regolith_melt_glass(user,crater,age,age_resolution,ebh,rm,eradc,lrad,deltar,newlayer,xmints,melt) use module_globals type(usertype),intent(in) :: user type(cratertype),intent(in) :: crater @@ -258,6 +259,7 @@ subroutine regolith_melt_glass(user,crater,age,age_resolution,ebh,rm,eradc,lrad, real(DP),intent(out) :: deltar type(regodatatype),intent(out) :: newlayer real(DP),intent(out) :: xmints + real(DP),intent(out) :: melt end subroutine regolith_melt_glass end interface diff --git a/src/regolith/regolith_melt_glass.f90 b/src/regolith/regolith_melt_glass.f90 index 59795081..0a639d5e 100644 --- a/src/regolith/regolith_melt_glass.f90 +++ b/src/regolith/regolith_melt_glass.f90 @@ -55,7 +55,7 @@ ! Notes : ! !********************************************************************************************************************************** -subroutine regolith_melt_glass(user,crater,age,age_resolution,ebh,rm,eradc,lrad,deltar,newlayer,xmints) +subroutine regolith_melt_glass(user,crater,age,age_resolution,ebh,rm,eradc,lrad,deltar,newlayer,xmints,melt) use module_globals use module_util use module_regolith, EXCEPT_THIS_ONE => regolith_melt_glass @@ -73,6 +73,7 @@ subroutine regolith_melt_glass(user,crater,age,age_resolution,ebh,rm,eradc,lrad, real(DP),intent(out) :: deltar type(regodatatype),intent(out) :: newlayer real(DP),intent(out) :: xmints + real(DP),intent(out) :: melt ! Internal variables ! Stream tube parameters @@ -85,7 +86,7 @@ subroutine regolith_melt_glass(user,crater,age,age_resolution,ebh,rm,eradc,lrad, ! Calculate vapor and melt zone intersection point with stream tubes real(DP) :: vst, erado, eradi real(DP) :: cosvints, sinvints, xvints, rints - real(DP) :: volv1, melt, volm1, depthb + real(DP) :: volv1, volm1, depthb real(DP) :: q1, q2, q3 real(DP) :: thetaq integer(I2B) :: n_age diff --git a/src/regolith/regolith_melt_zone.f90 b/src/regolith/regolith_melt_zone.f90 index 7eb1a19b..58ea3566 100644 --- a/src/regolith/regolith_melt_zone.f90 +++ b/src/regolith/regolith_melt_zone.f90 @@ -51,7 +51,7 @@ ! Notes : ! !********************************************************************************************************************************** -subroutine regolith_melt_zone(user,crater,dimp,vimp,rmelt,depthb) +subroutine regolith_melt_zone(user,crater,dimp,vimp,rmelt,depthb,volm) use module_globals use module_regolith, EXCEPT_THIS_ONE => regolith_melt_zone implicit none @@ -60,12 +60,12 @@ subroutine regolith_melt_zone(user,crater,dimp,vimp,rmelt,depthb) type(usertype),intent(in) :: user type(cratertype),intent(inout) :: crater real(DP),intent(in) :: dimp,vimp ! diameter and impact velocity of projectile for testing case and a real run - real(DP),intent(out) :: rmelt, depthb + real(DP),intent(out) :: rmelt, depthb, volm ! Internal variables real(DP),parameter :: Em = 3.42d06 ! specific internal energy for highland (Bjorkman and Holsapple 1987) real(DP) :: rimp - real(DP) :: volm,vtc + real(DP) :: vtc real(DP) :: b,c,d,e ! Executable code diff --git a/src/regolith/regolith_melt_zone_superdomain.f90 b/src/regolith/regolith_melt_zone_superdomain.f90 index 20d91d0d..cb084138 100644 --- a/src/regolith/regolith_melt_zone_superdomain.f90 +++ b/src/regolith/regolith_melt_zone_superdomain.f90 @@ -35,6 +35,7 @@ subroutine regolith_melt_zone_superdomain(user,crater,domain,rm,depthb) real(DP) :: vimp, sinimp, rimp, dimp real(DP) :: pvelv, pmass real(DP) :: c1, c2, pitwo, pithree, pifour, pivolg + real(DP) :: volm crater%grad = crater%rad @@ -52,6 +53,6 @@ subroutine regolith_melt_zone_superdomain(user,crater,domain,rm,depthb) (pifour**(c2/3.0)) * user%trho_r / pmass )**(1.0 / (3.0 + c2)) dimp = rimp * 2.0_DP crater%imp = dimp - call regolith_melt_zone(user,crater,dimp,vimp,rm,depthb) + call regolith_melt_zone(user,crater,dimp,vimp,rm,depthb, volm) return end subroutine regolith_melt_zone_superdomain diff --git a/src/regolith/regolith_streamtube.f90 b/src/regolith/regolith_streamtube.f90 index 0a0ebb93..c5689b43 100644 --- a/src/regolith/regolith_streamtube.f90 +++ b/src/regolith/regolith_streamtube.f90 @@ -56,7 +56,7 @@ ! Notes : ! !********************************************************************************************************************************** -subroutine regolith_streamtube(user,surf,crater,domain,ejb,ejtble,xp,yp,xpi,ypi,lrad,ebh,rm,vsq,age,age_resolution) +subroutine regolith_streamtube(user,surf,crater,domain,ejb,ejtble,xp,yp,xpi,ypi,lrad,ebh,rm,vsq,age,age_resolution,volm) use module_globals use module_util use module_regolith, EXCEPT_THIS_ONE => regolith_streamtube @@ -72,6 +72,7 @@ subroutine regolith_streamtube(user,surf,crater,domain,ejb,ejtble,xp,yp,xpi,ypi, real(DP),intent(in) :: xp,yp,lrad,ebh integer(I4B),intent(in) :: xpi,ypi real(DP),intent(in) :: rm, vsq, age, age_resolution + real(DP),intent(inout) :: volm ! Traversing a linked list real(DP),parameter :: a = 0.936457 ! Fitting parameters for the relation between height difference and a radial position of a stream tube @@ -225,7 +226,7 @@ subroutine regolith_streamtube(user,surf,crater,domain,ejb,ejtble,xp,yp,xpi,ypi, ! Purpose 2: Once we have the size information of a stream tube, we can ! calculate the distal melt: the precursor of glass spherules within a ! stream tube. The result is contained in a linked list "newlayer". - call regolith_melt_glass(user,crater,age,age_resolution,ebh,rm,eradc,lrad,deltar,newlayer,xmints) + call regolith_melt_glass(user,crater,age,age_resolution,ebh,rm,eradc,lrad,deltar,newlayer,xmints, volm) ! if (eradc>rm) then ! write(*,*) 'eradc > rm!' ! write(*,*) ebh, exp(ejb(k)%thick) diff --git a/src/regolith/regolith_superdomain.f90 b/src/regolith/regolith_superdomain.f90 index db4ff8aa..a3faa467 100644 --- a/src/regolith/regolith_superdomain.f90 +++ b/src/regolith/regolith_superdomain.f90 @@ -43,7 +43,7 @@ subroutine regolith_superdomain(user,crater,domain,regolayer,ejdistribution,xpi, real(DP) :: ebh real(DP) :: erad real(DP) :: cvpg - real(DP) :: deltar, xmints + real(DP) :: deltar, xmints, melt type(regodatatype) :: newlayer integer(I2B) :: n_age @@ -60,7 +60,7 @@ subroutine regolith_superdomain(user,crater,domain,regolayer,ejdistribution,xpi, erad = cvpg**(user%mu_b) * (lrad**(-0.5_DP * user%mu_b)) * (crater%rad)**(user%mu_b * 0.5_DP + 1.0_DP) vej = cvpg * sqrt(user%gaccel * crater%grad) * (erad / crater%grad)**(-1.0_DP / user%mu_b) !equation 18 in Richardson 2009 lrad = ( vej **2 ) / user%gaccel !assume ejection angle is 45 degree. - call regolith_melt_glass(user,crater,age,age_resolution,ebh,rm,erad,lrad,deltar,newlayer,xmints) + call regolith_melt_glass(user,crater,age,age_resolution,ebh,rm,erad,lrad,deltar,newlayer,xmints,melt) call util_push(regolayer,newlayer) return