Add VTK file that takes a folder path and outputs more fields by default

CMakeLists.txt

@@ -21,6 +21,7 @@ set(FASTSCAPELIB_SRC_FILES
   ${FASTSCAPELIB_SRC_DIR}/Uplift.f90
   ${FASTSCAPELIB_SRC_DIR}/VTK.f90
   ${FASTSCAPELIB_SRC_DIR}/TerrainDerivatives.f90
+  ${FASTSCAPELIB_SRC_DIR}/Named_VTK.f90
   )
 
 set(FLEXURE_SRC_DIR Flexure2D_v1.0/src)

src/Marine.f90

@@ -7,20 +7,22 @@ subroutine Marine()
   use FastScapeContext
 
   implicit none
+
+  double precision dhs(nn),dhs1(nn)
 
   double precision, dimension(:), allocatable :: flux,shelfdepth,ht,Fs,dh,dh1,dh2,Fmixt,mwater
-  double precision, dimension(:), allocatable :: dhs, dhs1, F1, F2, zi, zo
-  integer, dimension(:), allocatable :: flag,mmnrec,mmstack
+  double precision, dimension(:), allocatable :: F1, F2, zi, zo
+  integer, dimension(:), allocatable :: COTflag,mmnrec,mmstack
   integer, dimension(:,:), allocatable :: mmrec
   double precision, dimension(:,:), allocatable :: mmwrec,mmlrec
   double precision shelfslope,ratio1,ratio2,dx,dy
-  integer ij,ijr,ijk,k
+  integer ij,ijr,ijk,k,istep,i,j
 
-  allocate (flux(nn),shelfdepth(nn),ht(nn),Fs(nn),dh(nn),dh1(nn),dh2(nn),Fmixt(nn),flag(nn))
-  allocate (dhs(nn),dhs1(nn),F1(nn),F2(nn),zi(nn),zo(nn))
+  allocate (flux(nn),shelfdepth(nn),ht(nn),Fs(nn),dh(nn),dh1(nn),dh2(nn),Fmixt(nn),COTflag(nn))
+  allocate (F1(nn),F2(nn),zi(nn),zo(nn))
 
   ! set nodes at transition between ocean and continent
-  flag=0
+  COTflag=0
 
   dx=xl/(nx-1)
   dy=yl/(ny-1)
@@ -40,7 +42,14 @@ subroutine Marine()
   where (h.gt.sealevel) flux=0.d0
 
   ! set nodes at transition between ocean and continent
-  !where (flux.gt.tiny(flux)) flag=1
+  !where (flux.gt.tiny(flux)) COTflag=1
+  ! use single flow direction to set the flag that marks
+  ! the recieving node below/at sealevel of a node above/at
+  ! sealevel as a continent-ocean transition node. 
+  do ij=1,nn
+    ijr=rec(ij)
+    if (h(ij).ge.sealevel.and.h(ijr).le.sealevel) COTflag(ijr)=1
+  enddo
 
   ! decompact volume of pure solid phase (silt and sand) from onshore
   ratio1=ratio/(1.d0-poro1)
@@ -110,7 +119,7 @@ subroutine Marine()
 
   ! silt and sand coupling diffusion in ocean
   call SiltSandCouplingDiffusion (h,Fmix,flux*Fs,flux*(1.d0-Fs), &
-  nx,ny,dx,dy,dt,sealevel,layer,kdsea1,kdsea2,nGSMarine,flag,bounds_ibc)
+  nx,ny,dx,dy,dt,sealevel,layer,kdsea1,kdsea2,nGSMarine,COTflag,bounds_ibc)
 
   ! pure silt and sand during deposition/erosion
   dh1=((h-ht)*Fmix+layer*(Fmix-Fmixt))*(1.d0-poro1)
@@ -169,7 +178,7 @@ end subroutine Marine
 !----------------------------------------------------------------------------------
 
 subroutine SiltSandCouplingDiffusion (h,f,Q1,Q2,nx,ny,dx,dy,dt, &
-  sealevel,L,kdsea1,kdsea2,niter,flag,ibc)
+  sealevel,L,kdsea1,kdsea2,niter,COTflag,ibc)
 
   implicit none
 
@@ -178,7 +187,7 @@ subroutine SiltSandCouplingDiffusion (h,f,Q1,Q2,nx,ny,dx,dy,dt, &
   double precision h(nx*ny),f(nx*ny),Q1(nx*ny),Q2(nx*ny)
   double precision, dimension(:), allocatable :: hp,fp,ht,ft,hhalf,fhalf,fhalfp
   double precision, dimension(:), allocatable :: diag,sup,inf,rhs,res,tint
-  integer flag(nx*ny)
+  integer COTflag(nx*ny)
 
   double precision dx,dy,dt,sealevel,L,kdsea1,kdsea2
   double precision K1,K2,tol,err1,err2
@@ -224,7 +233,7 @@ subroutine SiltSandCouplingDiffusion (h,f,Q1,Q2,nx,ny,dx,dy,dt, &
         ijp=(j)*nx+i
         ijm=(j-2)*nx+i
         ! in ocean and not at ocean-continent transition
-        if (ht(ij).le.sealevel.and.flag(ij).eq.0) then
+        if (ht(ij).le.sealevel.and.COTflag(ij).eq.0) then
           if (i.eq.1) then
             if (cbc(4:4).eq.'1') then
               diag(i)=1.d0
@@ -298,7 +307,7 @@ subroutine SiltSandCouplingDiffusion (h,f,Q1,Q2,nx,ny,dx,dy,dt, &
         ijp=(j)*nx+i
         ijm=(j-2)*nx+i
         ! in ocean and not at ocean-continent transition
-        if (ht(ij).le.sealevel.and.flag(ij).eq.0) then
+        if (ht(ij).le.sealevel.and.COTflag(ij).eq.0) then
           ! deposition
           if (hhalf(ij).ge.(1.d0+1.d-6)*ht(ij)) then
             Dp=(hhalf(ij)-ht(ij))/dt
@@ -355,7 +364,7 @@ subroutine SiltSandCouplingDiffusion (h,f,Q1,Q2,nx,ny,dx,dy,dt, &
         ijp=(j)*nx+i
         ijm=(j-2)*nx+i
         ! in ocean and not at ocean-continent transition
-        if (ht(ij).le.sealevel.and.flag(ij).eq.0) then
+        if (ht(ij).le.sealevel.and.COTflag(ij).eq.0) then
           if (j.eq.1) then
             if (cbc(1:1).eq.'1') then
               diag(j)=1.d0
@@ -429,7 +438,7 @@ subroutine SiltSandCouplingDiffusion (h,f,Q1,Q2,nx,ny,dx,dy,dt, &
         ijp=(j)*nx+i
         ijm=(j-2)*nx+i
         ! in ocean and not at ocean-continent transition
-        if (ht(ij).le.sealevel.and.flag(ij).eq.0) then
+        if (ht(ij).le.sealevel.and.COTflag(ij).eq.0) then
           ! deposition
           if (h(ij).ge.(1.d0+1.d-6)*hhalf(ij)) then
             Dp=(h(ij)-hhalf(ij))/dt

src/Named_VTK.f90

@@ -0,0 +1,96 @@
+subroutine Fastscape_Named_VTK (f, vex, istep, foldername, k)
+
+    ! Subroutine modified from VTK.f90 to create a simple
+    ! VTK file inside of a specified folder path.
+    ! This additionally outputs the topography, basement
+    ! erosion rate, total erosion, drainage area, and
+    ! catchment on top of the given HHHHH field.
+    ! This assumes the output folder is created beforehand.
+
+    use FastScapeContext
+    implicit none
+
+    integer, intent(in) :: k, istep
+    double precision, intent(in) :: vex
+    double precision, intent(in), dimension(*) :: f
+    character(len=k), intent(in) :: foldername
+    character cstep*7
+
+    integer nheader,nfooter,npart1,npart2, ftime
+    character header*1024,footer*1024,part1*1024,part2*1024,nxc*6,nyc*6,nnc*12
+    integer i,j
+    double precision dx,dy
+
+    dx = xl/(nx - 1)
+    dy = yl/(ny - 1)
+
+    write (cstep,'(i7)') istep
+    if (istep.lt.10) cstep(1:6)='000000'
+    if (istep.lt.100) cstep(1:5)='00000'
+    if (istep.lt.1000) cstep(1:4)='0000'
+    if (istep.lt.10000) cstep(1:3)='000'
+    if (istep.lt.100000) cstep(1:2)='00'
+    if (istep.lt.1000000) cstep(1:1)='0'
+
+    write (nxc,'(i6)') nx
+    write (nyc,'(i6)') ny
+    write (nnc,'(i12)') nn
+
+    header(1:1024)=''
+    header='# vtk DataFile Version 3.0'//char(10)//'FastScape'//char(10) &
+    //'BINARY'//char(10)//'DATASET STRUCTURED_GRID'//char(10) &
+    //'DIMENSIONS '//nxc//' '//nyc//' 1'//char(10)//'POINTS' &
+    //nnc//' float'//char(10)
+    nheader=len_trim(header)
+    footer(1:1024)=''
+    footer='POINT_DATA'//nnc//char(10)
+    nfooter=len_trim(footer)
+    part1(1:1024)=''
+    part1='SCALARS '
+    npart1=len_trim(part1)+1
+    part2(1:1024)=''
+    part2=' float 1'//char(10)//'LOOKUP_TABLE default'//char(10)
+    npart2=len_trim(part2)
+
+    ! Formatting to output the correct size for each visualization field.
+    open(unit=77,file=(foldername//'/Topography'//cstep//'.vtk'),status='unknown', &
+    form='unformatted',access='direct', recl=nheader+3*4*nn+nfooter+(npart1+10+npart2+4*nn) &
+    +(npart1+5+npart2+4*nn)+(npart1+8+npart2+4*nn)+(npart1+12+npart2+4*nn)+(npart1+13+npart2+4*nn) &
+    +(npart1+13+npart2+4*nn)+(npart1+9+npart2+4*nn))
+    write (77,rec=1) &
+    header(1:nheader), &
+    ((sngl(dx*(i-1)),sngl(dy*(j-1)),sngl(h(i+(j-1)*nx)*abs(vex)),i=1,nx),j=1,ny), &
+    footer(1:nfooter), &
+    part1(1:npart1)//'topography'//part2(1:npart2),sngl(h(1:nn)), &
+    part1(1:npart1)//'HHHHH'//part2(1:npart2),sngl(f(1:nn)), &
+    part1(1:npart1)//'basement'//part2(1:npart2),sngl(b(1:nn)), &
+    part1(1:npart1)//'erosion_rate'//part2(1:npart2),sngl(erate(1:nn)), &
+    part1(1:npart1)//'total_erosion'//part2(1:npart2),sngl(etot(1:nn)), &
+    part1(1:npart1)//'drainage_area'//part2(1:npart2),sngl(a(1:nn)) , &
+    part1(1:npart1)//'catchment'//part2(1:npart2),sngl(catch(1:nn))
+    close(77)
+
+    if (vex.lt.0.d0) then
+      open(unit=77,file=(foldername//'/Basement'//cstep//'.vtk'),status='unknown',form='unformatted',access='direct', &
+      recl=nheader+3*4*nn+nfooter+(npart1+1+npart2+4*nn) &
+      +(npart1+5+npart2+4*nn))
+      write (77,rec=1) &
+      header(1:nheader), &
+      ((sngl(dx*(i-1)),sngl(dy*(j-1)),sngl(b(i+(j-1)*nx)*abs(vex)),i=1,nx),j=1,ny), &
+      footer(1:nfooter), &
+      part1(1:npart1)//'B'//part2(1:npart2),sngl(b(1:nn)), &
+      part1(1:npart1)//'HHHHH'//part2(1:npart2),sngl(f(1:nn))
+      close(77)
+      open(unit=77,file=(foldername//'/SeaLevel'//cstep//'.vtk'),status='unknown',form='unformatted',access='direct', &
+      recl=nheader+3*4*nn+nfooter+(npart1+2+npart2+4*nn))
+      write (77,rec=1) &
+      header(1:nheader), &
+      ((sngl(dx*(i-1)),sngl(dy*(j-1)),sngl(sealevel*abs(vex)),i=1,nx),j=1,ny), &
+      footer(1:nfooter), &
+      part1(1:npart1)//'SL'//part2(1:npart2),(sngl(sealevel),i=1,nn)
+      close(77)
+    endif
+
+
+    return
+  end subroutine Fastscape_Named_VTK