From 3f12afc1aec32171ad0f697c17d704cd222884a9 Mon Sep 17 00:00:00 2001 From: daminton Date: Tue, 6 Dec 2016 15:22:49 +0000 Subject: [PATCH] Removed obsolete tally components. --- src/crater/crater_tally_observed.f90 | 100 ++++----------------------- 1 file changed, 13 insertions(+), 87 deletions(-) diff --git a/src/crater/crater_tally_observed.f90 b/src/crater/crater_tally_observed.f90 index 9b4e7c5d..5b612b07 100644 --- a/src/crater/crater_tally_observed.f90 +++ b/src/crater/crater_tally_observed.f90 @@ -18,8 +18,7 @@ ! Notes : ! !********************************************************************************************************************************** -subroutine crater_tally_observed(user,surf,domain,nkilled,onum,obsdist,obslist,oposlist,& - original_depth,current_depth,deviation_sigma,p) +subroutine crater_tally_observed(user,surf,domain,nkilled,onum,obsdist,obslist,oposlist,depthdiam) use module_globals use module_io use module_util @@ -34,7 +33,7 @@ subroutine crater_tally_observed(user,surf,domain,nkilled,onum,obsdist,obslist,o real(DP),dimension(:,:),intent(out),optional :: obsdist real(DP),dimension(:),intent(out),allocatable,optional :: obslist real(SP),dimension(:,:),intent(out),allocatable,optional :: oposlist - real(SP),dimension(:),intent(out),allocatable,optional :: original_depth,current_depth,p,deviation_sigma + real(SP),dimension(:),intent(out),allocatable,optional :: depthdiam ! Internal variables integer(I4B) :: i,j,layer,n,m,craternum,obstot @@ -42,11 +41,10 @@ subroutine crater_tally_observed(user,surf,domain,nkilled,onum,obsdist,obslist,o ! master list arrays (these contain information on every pixel that is considered a crater) integer(I4B),dimension(user%numlayers*(user%gridsize)**2) :: mlistind real(DP),dimension(:),allocatable :: mlist,melevation - integer(I2B),dimension(:),allocatable :: misrim real(SP),dimension(:,:),allocatable :: mposlist real(SP),dimension(:),allocatable :: moriginal_depth_list,mbaseline real(SP),dimension(:),allocatable :: tmp_original_depth,tmp_current_depth - real(SP),dimension(:),allocatable :: tmp_p,tmp_deviation_sigma + real(SP),dimension(:),allocatable :: tmp_depthdiam,tmp_deviation_sigma logical,dimension(:),allocatable :: countable integer(I4B),dimension(:,:),allocatable:: mpxlist integer(I4B),dimension(:),allocatable :: ind,mlayerlist @@ -90,12 +88,9 @@ subroutine crater_tally_observed(user,surf,domain,nkilled,onum,obsdist,obslist,o allocate(mlist(max(mnum,1))) - allocate(misrim(max(mnum,1))) allocate(melevation(max(mnum,1))) - allocate(mbaseline(max(mnum,1))) allocate(mposlist(2,max(mnum,1))) allocate(mpxlist(2,max(mnum,1))) - allocate(moriginal_depth_list(max(mnum,1))) allocate(mlayerlist(max(mnum,1))) allocate(ind(max(mnum,1))) allocate(istart(max(mnum,1))) @@ -103,11 +98,10 @@ subroutine crater_tally_observed(user,surf,domain,nkilled,onum,obsdist,obslist,o mlist = 0._DP ind = 0 - misrim = 0 !$OMP PARALLEL DO DEFAULT(PRIVATE) & !$OMP SHARED(user,surf,mlistind) & - !$OMP SHARED(mlist,misrim,melevation,mbaseline,mposlist,mpxlist,moriginal_depth_list,mlayerlist) + !$OMP SHARED(mlist,melevation,mposlist,mpxlist,mlayerlist) do n = 1,user%gridsize do m = 1,user%gridsize do layer = 1,user%numlayers @@ -115,7 +109,6 @@ subroutine crater_tally_observed(user,surf,domain,nkilled,onum,obsdist,obslist,o if (mlistind(q) /= 0) then imnum = mlistind(q) mlist(imnum) = surf(m,n)%diam(layer) ! The crater diameter, used also as a unique identifier for the crater - misrim(imnum) = surf(m,n)%isrim(layer) ! Is this pixel part of the original rim? 1 = yes, 0 = no melevation(imnum) = surf(m,n)%dem ! Save the elevation of this pixel ! Save the crater center coordinates mposlist(1,imnum) = surf(m,n)%xl(layer) @@ -123,8 +116,6 @@ subroutine crater_tally_observed(user,surf,domain,nkilled,onum,obsdist,obslist,o ! Save the pixel index location mpxlist(1,imnum) = m mpxlist(2,imnum) = n - moriginal_depth_list(imnum) = surf(m,n)%original_depth(layer) ! The original elevation of the crater - mbaseline(imnum) = surf(m,n)%baseline(layer) mlayerlist(imnum) = layer end if end do @@ -158,7 +149,7 @@ subroutine crater_tally_observed(user,surf,domain,nkilled,onum,obsdist,obslist,o allocate(tlist(tnum)) allocate(tmp_original_depth(tnum)) allocate(tmp_current_depth(tnum)) - allocate(tmp_p(tnum)) + allocate(tmp_depthdiam(tnum)) allocate(tmp_deviation_sigma(tnum)) allocate(countable(tnum)) countable = .false. @@ -166,8 +157,8 @@ subroutine crater_tally_observed(user,surf,domain,nkilled,onum,obsdist,obslist,o onum = 0 !$OMP PARALLEL DEFAULT(PRIVATE) IF(tnum > INCPAR) & !$OMP SHARED(user,surf) & - !$OMP SHARED(maxpix,istart,iend,ind,mlist,mposlist,misrim,melevation,mbaseline,moriginal_depth_list,mpxlist,mlayerlist) & - !$OMP SHARED(tnum,totpix,poslist,tlist,tmp_original_depth,tmp_current_depth,tmp_p,tmp_deviation_sigma,countable) & + !$OMP SHARED(maxpix,istart,iend,ind,mlist,mposlist,melevation,mpxlist,mlayerlist) & + !$OMP SHARED(tnum,totpix,poslist,tlist,tmp_depthdiam,countable) & !$OMP REDUCTION(+:nkilled) & !$OMP REDUCTION(+:onum) !allocate(dis(4*user%gridsize**2)) @@ -184,7 +175,7 @@ subroutine crater_tally_observed(user,surf,domain,nkilled,onum,obsdist,obslist,o if (totpix(craternum) < int(0.1_DP * 0.25_DP * PI * tlist(craternum) / user%pix)) then countable(craternum) = .false. killable = .true. - tmp_p(craternum) = 0.0_DP + tmp_depthdiam(craternum) = 0.0_DP else nrim = 0 nbowl = 0 @@ -212,60 +203,9 @@ subroutine crater_tally_observed(user,surf,domain,nkilled,onum,obsdist,obslist,o end do rim = rim / nrim bowl = bowl / nbowl - tmp_p(craternum) = (rim - bowl) / tlist(craternum) + tmp_depthdiam(craternum) = (rim - bowl) / tlist(craternum) -! if ((i**2 + j**2) < inc**2) then -! xpi = int(poslist(1,craternum) / user%pix) + i -! ypi = int(poslist(2,craternum) / user%pix) + j -! call util_periodic(xpi,ypi,user%gridsize) -! nprof = nprof + 1 -! elev(nprof) = surf(xpi,ypi)%dem -! dis(nprof) = sqrt((i**2 + j**2)*1.d0) * user%pix -! totavg = totavg + elev(nprof) -! end if -! end do -! end do -! totavg = totavg / nprof -! elev = elev - totavg -! call util_mrgrnk(dis(1:nprof),elevind(1:nprof)) -! avgelev = 0.0_DP -! avgdis = 0.0_DP -! Ni = 1 -! ntot = 0 -! i = 0 -! rim = 0.0_DP -! bowl = 0.0_DP -! nrim = 0 -! nbowl = 0 -! outer: do -! do -! i = i + 1 -! if (i > nprof) exit outer -! if (dis(elevind(i)) > profres * Ni) then -! avgdis = avgdis / ntot / tlist(craternum) -! avgelev = avgelev / ntot / tlist(craternum) -! if (avgdis >= 0.4_DP) then -! rim = rim + avgelev -! nrim = nrim+ 1 -! else if (avgdis <= 0.1_DP) then -! bowl = bowl + avgelev -! nbowl = nbowl + 1 -! end if -! avgelev = elev(elevind(i)) -! avgdis = dis(elevind(i)) -! ntot = 1 -! exit -! else -! avgelev = avgelev + elev(elevind(i)) -! avgdis = avgdis + dis(elevind(i)) -! ntot = ntot + 1 -! end if -! end do -! Ni = Ni + 1 -! end do outer - - - if (tmp_p(craternum) > 0.05_DP) then + if (tmp_depthdiam(craternum) > 0.05_DP) then countable(craternum) = .true. killable = .false. else @@ -288,16 +228,11 @@ subroutine crater_tally_observed(user,surf,domain,nkilled,onum,obsdist,obslist,o !deallocate(csurf) end do !$OMP END DO - !deallocate(dis) - !deallocate(elev) !$OMP END PARALLEL ! Bin the observed craters if required if (present(obsdist)) then - allocate(original_depth(onum)) - allocate(current_depth(onum)) - allocate(p(onum)) - allocate(deviation_sigma(onum)) + allocate(depthdiam(onum)) allocate(obslist(onum)) allocate(oposlist(2,onum)) ! Reset all the distribution bins @@ -320,10 +255,7 @@ subroutine crater_tally_observed(user,surf,domain,nkilled,onum,obsdist,obslist,o obsdist(4,i) = obsdist(4,i) + 1 ! Differential number obslist(obstot) = tlist(craternum) oposlist(:,obstot) = poslist(:,craternum) - original_depth(obstot) = tmp_original_depth(craternum) - current_depth(obstot) = tmp_current_depth(craternum) - p(obstot) = tmp_p(craternum) - deviation_sigma(obstot) = tmp_deviation_sigma(craternum) + depthdiam(obstot) = tmp_depthdiam(craternum) obstot = obstot - 1 end if end do @@ -346,17 +278,11 @@ subroutine crater_tally_observed(user,surf,domain,nkilled,onum,obsdist,obslist,o deallocate(istart) deallocate(iend) deallocate(mlist) - deallocate(misrim) deallocate(melevation) - deallocate(mbaseline) deallocate(mposlist) deallocate(mpxlist) - deallocate(moriginal_depth_list) deallocate(mlayerlist) - deallocate(tmp_original_depth) - deallocate(tmp_current_depth) - deallocate(tmp_p) - deallocate(tmp_deviation_sigma) + deallocate(tmp_depthdiam) deallocate(ind) deallocate(countable)