├── ci ├── run_examples.sh └── build_examples.sh ├── src_python └── fastscapelib_fortran │ └── __init__.py ├── docs ├── images │ ├── BC.jpg │ └── FastScapePython.jpg ├── references.adoc ├── index.adoc ├── release_notes.adoc ├── install.adoc ├── examples.adoc ├── asciidoc.conf └── api.adoc ├── pyproject.toml ├── src ├── Uplift.f90 ├── TerrainDerivatives.f90 ├── Advect.f90 ├── Strati.f90 ├── Diffusion.f90 ├── VTK.f90 ├── FlowRouting.f90 ├── StreamPowerLaw.f90 ├── Marine.f90 └── FastScape_api.f90 ├── .editorconfig ├── .github └── workflows │ ├── test-doc.yml │ ├── deploy-doc.yml │ ├── test-fortran.yml │ └── test-python.yml ├── Flexure2D_v1.0 ├── Makefile └── src │ ├── sinft.f │ ├── realft.f │ ├── four1.f │ └── flexure2D.f90 ├── setup.py ├── examples ├── CMakeLists.txt ├── Mountain.f90 ├── Fan.f90 ├── DippingDyke.f90 ├── Margin.f90 ├── Strati_test.f90 └── flexure_test.f90 ├── .gitignore ├── .appveyor.yml ├── README.md ├── cmake ├── FindF2PY.cmake ├── UseF2PY.cmake └── UsePythonExtensions.cmake └── CMakeLists.txt /ci/run_examples.sh: -------------------------------------------------------------------------------- 1 | cd build/examples 2 | ./Fan 3 | -------------------------------------------------------------------------------- /src_python/fastscapelib_fortran/__init__.py: -------------------------------------------------------------------------------- 1 | from ._fastscapelib_fortran import * 2 | -------------------------------------------------------------------------------- /docs/images/BC.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fastscape-lem/fastscapelib-fortran/HEAD/docs/images/BC.jpg -------------------------------------------------------------------------------- /docs/images/FastScapePython.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fastscape-lem/fastscapelib-fortran/HEAD/docs/images/FastScapePython.jpg -------------------------------------------------------------------------------- /ci/build_examples.sh: -------------------------------------------------------------------------------- 1 | mkdir build 2 | cd build 3 | cmake -DBUILD_FASTSCAPELIB_SHARED=ON -DBUILD_EXAMPLES=ON -DCMAKE_BUILD_TYPE=Debug .. 4 | make 5 | -------------------------------------------------------------------------------- /pyproject.toml: -------------------------------------------------------------------------------- 1 | [build-system] 2 | requires = ["setuptools", "wheel", "scikit-build", "cmake", "ninja", "numpy"] 3 | build-backend = "setuptools.build_meta" 4 | -------------------------------------------------------------------------------- /src/Uplift.f90: -------------------------------------------------------------------------------- 1 | subroutine Uplift () 2 | 3 | ! subroutine to apply an uplift step using the uplift function/array u 4 | 5 | use FastScapeContext 6 | 7 | implicit none 8 | 9 | h = h + u*dt 10 | b = b + u*dt 11 | 12 | return 13 | 14 | end subroutine Uplift 15 | -------------------------------------------------------------------------------- /.editorconfig: -------------------------------------------------------------------------------- 1 | # EditorConfig is awesome: https://EditorConfig.org 2 | 3 | # top-most EditorConfig file 4 | root = true 5 | 6 | # Unix-style newlines with a newline ending every file 7 | [*] 8 | end_of_line = lf 9 | insert_final_newline = true 10 | 11 | [{*.f,*.f90}] 12 | indent_style = space 13 | indent_size = 2 14 | trim_trailing_whitespace = true 15 | -------------------------------------------------------------------------------- /.github/workflows/test-doc.yml: -------------------------------------------------------------------------------- 1 | name: test-doc 2 | 3 | on: 4 | push: 5 | branches: 6 | - 'master' 7 | pull_request: 8 | branches: 9 | - 'master' 10 | 11 | jobs: 12 | adoc-build: 13 | runs-on: ubuntu-latest 14 | steps: 15 | - name: Checkout code 16 | uses: actions/checkout@v2 17 | - name: Build docs 18 | uses: avattathil/asciidoctor-action@v2 19 | with: 20 | program: "asciidoctor docs/index.adoc -o docs/index.html" 21 | -------------------------------------------------------------------------------- /Flexure2D_v1.0/Makefile: -------------------------------------------------------------------------------- 1 | LIB = libflexure.a 2 | 3 | SRC_DIR = src 4 | 5 | OBJECTS_LIB = \ 6 | flexure2D.o \ 7 | four1.o \ 8 | realft.o \ 9 | sinft.o 10 | 11 | FLAGS = -Wall -c -O3 #-fbounds-check 12 | 13 | .PHONY: all clean 14 | 15 | all: $(LIB) 16 | 17 | $(LIB): $(OBJECTS_LIB) 18 | libtool -static -o $@ $^ 19 | 20 | %.o: $(SRC_DIR)/%.f90 21 | gfortran $(FLAGS) -c $< -o $@ 22 | 23 | %.o: $(SRC_DIR)/%.f 24 | gfortran $(FLAGS) -c $< -o $@ 25 | 26 | %.o: $(SRC_DIR)/%.c 27 | gcc $(FLAGS)-c $< -o $@ 28 | 29 | clean: 30 | $(RM) *.o 31 | -------------------------------------------------------------------------------- /setup.py: -------------------------------------------------------------------------------- 1 | from skbuild import setup 2 | 3 | setup( 4 | name="fastscapelib-fortran", 5 | version="2.9.0dev", 6 | description=("A library of efficient algorithms" 7 | "for landscape evolution modeling"), 8 | author='Jean Braun', 9 | license="GPLv3", 10 | packages=['fastscapelib_fortran'], 11 | package_dir={"": "src_python"}, 12 | cmake_args=['-DBUILD_FASTSCAPELIB_STATIC=OFF', 13 | '-DUSE_FLEXURE=ON'], 14 | cmake_languages=('C', 'Fortran'), 15 | cmake_minimum_required_version='3.5' 16 | ) 17 | -------------------------------------------------------------------------------- /examples/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | cmake_minimum_required(VERSION 3.5) 2 | 3 | set(FASTSCAPELIB_EXAMPLES_SRC_FILES 4 | DippingDyke.f90 5 | Fan.f90 6 | Margin.f90 7 | Mountain.f90 8 | Strati_test.f90 9 | flexure_test.f90 10 | ) 11 | 12 | foreach(EXAMPLE_SRC_FILE ${FASTSCAPELIB_EXAMPLES_SRC_FILES}) 13 | string(REGEX REPLACE "\\.[^.]*$" "" EXAMPLE_EXE_FILE ${EXAMPLE_SRC_FILE}) 14 | 15 | add_executable(${EXAMPLE_EXE_FILE} ${EXAMPLE_SRC_FILE}) 16 | 17 | target_link_libraries(${EXAMPLE_EXE_FILE} ${FASTSCAPELIB_STATIC}) 18 | endforeach(EXAMPLE_SRC_FILE) 19 | -------------------------------------------------------------------------------- /.github/workflows/deploy-doc.yml: -------------------------------------------------------------------------------- 1 | name: deploy-doc 2 | 3 | on: 4 | push: 5 | branches: 6 | - 'master' 7 | 8 | jobs: 9 | adoc-build-deploy: 10 | runs-on: ubuntu-20.04 11 | steps: 12 | - name: Checkout code 13 | uses: actions/checkout@v2 14 | - name: Build docs 15 | uses: avattathil/asciidoctor-action@v2 16 | with: 17 | program: "asciidoctor docs/index.adoc -o docs/index.html" 18 | - name: Deploy docs to gh-pages 19 | uses: peaceiris/actions-gh-pages@v3 20 | with: 21 | github_token: ${{ secrets.GITHUB_TOKEN }} 22 | publish_branch: gh-pages 23 | publish_dir: ./docs 24 | -------------------------------------------------------------------------------- /Flexure2D_v1.0/src/sinft.f: -------------------------------------------------------------------------------- 1 | c SINFT 2 | 3 | c taken from numerical recipes (see book for further information) 4 | 5 | c subroutines called: 6 | c NONE 7 | 8 | SUBROUTINE SINFT(Y,N) 9 | IMPLICIT INTEGER (A-Z) 10 | common /vocal/ ivocal 11 | REAL*8 WR,WI,WPR,WPI,WTEMP,THETA 12 | REAL*8 Y1,Y2,SUM 13 | REAL*8 Y(N) 14 | THETA=3.14159265358979D0/DBLE(N) 15 | WR=1.0D0 16 | WI=0.0D0 17 | WPR=-2.0D0*DSIN(0.5D0*THETA)**2 18 | WPI=DSIN(THETA) 19 | Y(1)=0.0 20 | M=N/2 21 | DO 11 J=1,M 22 | WTEMP=WR 23 | WR=WR*WPR-WI*WPI+WR 24 | WI=WI*WPR+WTEMP*WPI+WI 25 | Y1=WI*(Y(J+1)+Y(N-J+1)) 26 | Y2=0.5*(Y(J+1)-Y(N-J+1)) 27 | Y(J+1)=Y1+Y2 28 | Y(N-J+1)=Y1-Y2 29 | 11 CONTINUE 30 | CALL REALFT(Y,M,+1) 31 | SUM=0.0 32 | Y(1)=0.5*Y(1) 33 | Y(2)=0.0 34 | DO 12 J=1,N-1,2 35 | SUM=SUM+Y(J) 36 | Y(J)=Y(J+1) 37 | Y(J+1)=SUM 38 | 12 CONTINUE 39 | RETURN 40 | END 41 | 42 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Prerequisites 2 | *.d 3 | 4 | # Compiled Object files 5 | *.slo 6 | *.lo 7 | *.o 8 | *.obj 9 | 10 | # Precompiled Headers 11 | *.gch 12 | *.pch 13 | 14 | # Compiled Dynamic libraries 15 | *.so 16 | *.dylib 17 | *.dll 18 | 19 | # Fortran module files 20 | *.mod 21 | *.smod 22 | 23 | # Compiled Static libraries 24 | *.lai 25 | *.la 26 | *.a 27 | *.lib 28 | 29 | # Executables 30 | *.exe 31 | *.out 32 | *.app 33 | 34 | # CMake 35 | build/ 36 | 37 | # VSCode 38 | .vscode/ 39 | 40 | # Emacs 41 | .dir-locals.el 42 | 43 | # Python 44 | __pycache__/ 45 | *.py[cod] 46 | *$py.class 47 | .Python 48 | build/ 49 | develop-eggs/ 50 | dist/ 51 | downloads/ 52 | eggs/ 53 | .eggs/ 54 | lib/ 55 | lib64/ 56 | parts/ 57 | sdist/ 58 | var/ 59 | wheels/ 60 | pip-wheel-metadata/ 61 | share/python-wheels/ 62 | *.egg-info/ 63 | .installed.cfg 64 | *.egg 65 | MANIFEST 66 | 67 | # Jupyter Notebooks 68 | .ipynb_checkpoints 69 | 70 | # Examples 71 | examples/VTK 72 | 73 | # Docs 74 | docs/*.html 75 | 76 | # Misc 77 | .DS_Store 78 | 79 | test/VTK 80 | test/*.f90 81 | fluxes.txt 82 | -------------------------------------------------------------------------------- /docs/references.adoc: -------------------------------------------------------------------------------- 1 | [#references] 2 | == References 3 | 4 | * link:https://www.sciencedirect.com/science/article/pii/S0169555X12004618[Braun, J. and Willett, S.D., 2013.] A very efficient, O(n), implicit and parallel method to solve the basic stream power law equation governing fluvial incision and landscape evolution. Geomorphology, 180-181, pp., 170-179. 5 | 6 | * link:https://doi.org/10.5194/esurf-7-549-2019[Cordonnier, G., Bovy, B. and Braun, J., 2019.] A versatile, linear complexity algorithm for flow routing in topographies with depressions. Earth Surf. Dynam., 7, pp. 549–562. 7 | 8 | * link:https://doi.org/10.1029/2018JF004867[Yuan, X., Braun, J., Guerit, L., Rouby, D. and Cordonnier, G., 2019.] A New Efficient Method to Solve the Stream Power Law Model Taking Into Account Sediment Deposition. Journal of Geohysical Research - Surface, 124 (6), pp. 1346-1365. 9 | 10 | * link:https://doi.org/10.1016/j.epsl.2019.115728[Yuan, X., Braun, J., Guerit, L., Simon, B., Bovy, B., Rouby, D., Robin, C. and Jiao, R., 2019.] Linking continental deposition to marine sediment transport and deposition: a new implicit and o(n) method for inverse analysis. Earth and Planetary Science Letters, 524, 115728. 11 | -------------------------------------------------------------------------------- /Flexure2D_v1.0/src/realft.f: -------------------------------------------------------------------------------- 1 | c REALFT 2 | 3 | c taken from numerical recipes (see book for further information) 4 | 5 | c subroutines called: 6 | c NONE 7 | 8 | SUBROUTINE REALFT(DATA,N,ISIGN) 9 | IMPLICIT INTEGER (A-Z) 10 | common /vocal/ ivocal 11 | REAL*8 WR,WI,WPR,WPI,WTEMP,WRS,WIS,THETA 12 | REAL*8 C1,C2,H1R,H1I,H2R,H2I 13 | REAL*8 DATA(*) 14 | THETA=6.28318530717959D0/2.0D0/DBLE(N) 15 | C1=0.5 16 | IF (ISIGN.EQ.1) THEN 17 | C2=-0.5 18 | CALL FOUR1(DATA,N,+1) 19 | ELSE 20 | C2=0.5 21 | THETA=-THETA 22 | ENDIF 23 | WPR=-2.0D0*DSIN(0.5D0*THETA)**2 24 | WPI=DSIN(THETA) 25 | WR=1.0D0+WPR 26 | WI=WPI 27 | N2P3=2*N+3 28 | DO 11 I=2,N/2+1 29 | I1=2*I-1 30 | I2=I1+1 31 | I3=N2P3-I2 32 | I4=I3+1 33 | WRS=SNGL(WR) 34 | WIS=SNGL(WI) 35 | H1R=C1*(DATA(I1)+DATA(I3)) 36 | H1I=C1*(DATA(I2)-DATA(I4)) 37 | H2R=-C2*(DATA(I2)+DATA(I4)) 38 | H2I=C2*(DATA(I1)-DATA(I3)) 39 | DATA(I1)=H1R+WRS*H2R-WIS*H2I 40 | DATA(I2)=H1I+WRS*H2I+WIS*H2R 41 | DATA(I3)=H1R-WRS*H2R+WIS*H2I 42 | DATA(I4)=-H1I+WRS*H2I+WIS*H2R 43 | WTEMP=WR 44 | WR=WR*WPR-WI*WPI+WR 45 | WI=WI*WPR+WTEMP*WPI+WI 46 | 11 CONTINUE 47 | IF (ISIGN.EQ.1) THEN 48 | H1R=DATA(1) 49 | DATA(1)=H1R+DATA(2) 50 | DATA(2)=H1R-DATA(2) 51 | ELSE 52 | H1R=DATA(1) 53 | DATA(1)=C1*(H1R+DATA(2)) 54 | DATA(2)=C1*(H1R-DATA(2)) 55 | CALL FOUR1(DATA,N,-1) 56 | ENDIF 57 | RETURN 58 | END 59 | -------------------------------------------------------------------------------- /Flexure2D_v1.0/src/four1.f: -------------------------------------------------------------------------------- 1 | c FOUR1 2 | 3 | c this routine is taken directly out of numerical recipes 4 | c see the book for further information 5 | 6 | c subroutines called: 7 | c NONE 8 | 9 | SUBROUTINE FOUR1(DATA,NN,ISIGN) 10 | IMPLICIT INTEGER (A-Z) 11 | common /vocal/ ivocal 12 | REAL*8 WR,WI,WPR,WPI,WTEMP,THETA 13 | REAL*8 TEMPI,TEMPR 14 | REAL*8 DATA(*) 15 | N=2*NN 16 | J=1 17 | DO 11 I=1,N,2 18 | IF(J.GT.I)THEN 19 | TEMPR=DATA(J) 20 | TEMPI=DATA(J+1) 21 | DATA(J)=DATA(I) 22 | DATA(J+1)=DATA(I+1) 23 | DATA(I)=TEMPR 24 | DATA(I+1)=TEMPI 25 | ENDIF 26 | M=N/2 27 | 1 IF ((M.GE.2).AND.(J.GT.M)) THEN 28 | J=J-M 29 | M=M/2 30 | GO TO 1 31 | ENDIF 32 | J=J+M 33 | 11 CONTINUE 34 | MMAX=2 35 | 2 IF (N.GT.MMAX) THEN 36 | ISTEP=2*MMAX 37 | THETA=6.28318530717959D0/(ISIGN*MMAX) 38 | WPR=-2.D0*DSIN(0.5D0*THETA)**2 39 | WPI=DSIN(THETA) 40 | WR=1.D0 41 | WI=0.D0 42 | DO 13 M=1,MMAX,2 43 | DO 12 I=M,N,ISTEP 44 | J=I+MMAX 45 | TEMPR=SNGL(WR)*DATA(J)-SNGL(WI)*DATA(J+1) 46 | TEMPI=SNGL(WR)*DATA(J+1)+SNGL(WI)*DATA(J) 47 | DATA(J)=DATA(I)-TEMPR 48 | DATA(J+1)=DATA(I+1)-TEMPI 49 | DATA(I)=DATA(I)+TEMPR 50 | DATA(I+1)=DATA(I+1)+TEMPI 51 | 12 CONTINUE 52 | WTEMP=WR 53 | WR=WR*WPR-WI*WPI+WR 54 | WI=WI*WPR+WTEMP*WPI+WI 55 | 13 CONTINUE 56 | MMAX=ISTEP 57 | GO TO 2 58 | ENDIF 59 | RETURN 60 | END 61 | 62 | -------------------------------------------------------------------------------- /docs/index.adoc: -------------------------------------------------------------------------------- 1 | = **FastScapeLib** Documentation 2 | :author_name: Jean Braun 3 | :author_email: jbraun@gfz-potsdam.de 4 | :author: {author_name} 5 | :email: {author_email} 6 | :toc: left 7 | :icons: font 8 | :math: 9 | :stem: latexmath 10 | 11 | **FastScapeLib** is an interface or library (i.e. a set of subroutines) to model landscape evolution by river incision, sediment transport and deposition in continental and marine environments. 12 | 13 | **FastScapeLib** is a set of routines that solve (a) the stream power law (SPL) that has been enriched by a sediment transport/deposition term (see Yuan et al, 2019a in <>) (b) hillslope diffusion and (c) marine transport and deposition (see Yuan et al, 2019b in <>), using a set of highly efficient algorithms that are all latexmath:[\mathcal{O}(n)] complexity and implicit in time. These routines can be called from a Fortran, C or Python main program and are ideally suited to be coupled to a tectonic model, be it very simple, such as a flexural isostatic model, or very complex, such as a 3D thermo-mechanical model. 14 | 15 | Basic partial differential equation solved by **FastScapeLib** is: 16 | 17 | [latexmath] 18 | ++++ 19 | \frac{\partial h}{\partial t} = U - K_f A^m S^n + \frac{G}{A} \int_A \left(U - \frac{\partial h}{\partial t}\right) dA + K_d \nabla^2 h 20 | ++++ 21 | 22 | where latexmath:[h] is topography, latexmath:[U] is uplift, latexmath:[S] is slope, latexmath:[A] is drainage area, and latexmath:[K_f], latexmath:[m], latexmath:[n], latexmath:[G] and latexmath:[K_d] are parameters (see further down for unit and meaning). 23 | 24 | include::install.adoc[] 25 | 26 | include::api.adoc[] 27 | 28 | include::examples.adoc[] 29 | 30 | include::references.adoc[] 31 | 32 | include::release_notes.adoc[] 33 | -------------------------------------------------------------------------------- /.appveyor.yml: -------------------------------------------------------------------------------- 1 | branches: 2 | only: 3 | - master 4 | 5 | build: false 6 | 7 | platform: 8 | - x64 9 | 10 | image: 11 | - Visual Studio 2017 12 | 13 | environment: 14 | matrix: 15 | - RUN_FORTRAN_EXAMPLES: yes 16 | MINGW_DIR: C:\mingw-w64\x86_64-7.2.0-posix-seh-rt_v5-rev1\mingw64\bin 17 | - TEST_IMPORT_PYTHON_MODULE: yes 18 | MINGW_DIR: C:\mingw-w64\x86_64-7.2.0-posix-seh-rt_v5-rev1\mingw64\bin 19 | PYTHON: "C:\\Python36-x64" 20 | PYTHON_VERSION: "3.6.x" 21 | PYTHON_ARCH: "64" 22 | 23 | install: 24 | - cmd: set PATH=%MINGW_DIR%;%PATH% 25 | - if "%TEST_IMPORT_PYTHON_MODULE%"=="yes" set PATH=%PYTHON%;%PYTHON%\Scripts;%PATH% 26 | - echo "%PATH%" 27 | - cmake --version 28 | - mingw32-make --version 29 | - if "%TEST_IMPORT_PYTHON_MODULE%"=="yes" python --version 30 | - if "%TEST_IMPORT_PYTHON_MODULE%"=="yes" python -m ensurepip 31 | - if "%TEST_IMPORT_PYTHON_MODULE%"=="yes" python -m pip install --upgrade pip setuptools wheel 32 | - if "%TEST_IMPORT_PYTHON_MODULE%"=="yes" python -m pip install scikit-build ninja numpy 33 | - # CMake refuses to generate MinGW Makefiles if sh.exe is in the Path 34 | - ps: Get-Command sh.exe -All | Remove-Item 35 | 36 | build_script: 37 | - if "%RUN_FORTRAN_EXAMPLES%"=="yes" mkdir build 38 | - if "%RUN_FORTRAN_EXAMPLES%"=="yes" cd build 39 | - if "%RUN_FORTRAN_EXAMPLES%"=="yes" cmake -G "MinGW Makefiles" -DBUILD_FASTSCAPELIB_SHARED=ON -DBUILD_EXAMPLES=ON -DCMAKE_BUILD_TYPE=Debug .. 40 | - if "%RUN_FORTRAN_EXAMPLES%"=="yes" cmake --build . 41 | - if "%TEST_IMPORT_PYTHON_MODULE%"=="yes" python -m pip install . --no-build-isolation 42 | 43 | test_script: 44 | - if "%RUN_FORTRAN_EXAMPLES%"=="yes" cd examples 45 | - if "%RUN_FORTRAN_EXAMPLES%"=="yes" Fan 46 | - if "%TEST_IMPORT_PYTHON_MODULE%"=="yes" python -c "import sys; sys.path.pop(0); import fastscapelib_fortran" 47 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Fastscapelib-fortran 2 | 3 | [![Build Status](https://github.com/fastscape-lem/fastscapelib-fortran/workflows/test-fortran/badge.svg)](https://github.com/fastscape-lem/fastscapelib-fortran/actions) 4 | [![Build Status](https://github.com/fastscape-lem/fastscapelib-fortran/workflows/test-python/badge.svg)](https://github.com/fastscape-lem/fastscapelib-fortran/actions) 5 | [![Build status](https://ci.appveyor.com/api/projects/status/c0wfit5kj1gpo1a7/branch/master?svg=true)](https://ci.appveyor.com/project/benbovy/fastscapelib-fortran/branch/master) 6 | [![Build Doc](https://github.com/fastscape-lem/fastscapelib-fortran/workflows/deploy-doc/badge.svg)](https://github.com/fastscape-lem/fastscapelib-fortran/actions) 7 | [![DOI](https://zenodo.org/badge/167184498.svg)](https://zenodo.org/badge/latestdoi/167184498) 8 | 9 | **PLEASE NOTE: this repository is in maintenance-only mode, further development (new features and reworked API) is happening in the https://github.com/fastscape-lem/fastscapelib repository.** 10 | 11 | A Fortran (+ Python bindings) library of efficient algorithms for 12 | landscape evolution modeling. 13 | 14 | See the [documentation](https://fastscape-lem.github.io/fastscapelib-fortran/) 15 | online for more details on how to build, install and use the library. 16 | 17 | ## License 18 | 19 | GPLv3. See [License file](https://github.com/fastscape-lem/fastscapelib-fortran/blob/master/LICENSE). 20 | 21 | Some CMake modules included here have been copied from 22 | [scikit-build](https://github.com/scikit-build/scikit-build) (MIT license). 23 | 24 | ## Acknowledgment 25 | 26 | This project is supported by the 27 | [Earth Surface Process Modelling](http://www.gfz-potsdam.de/en/section/earth-surface-process-modelling/) 28 | group of the GFZ Helmholtz Centre Potsdam. 29 | 30 | ## Citation 31 | 32 | If you use Fastscapelib-fortran in a scientific publication, we would 33 | appreciate a citation. See the documentation for a list of related 34 | publications or click on the DOI badge here above. 35 | -------------------------------------------------------------------------------- /src/TerrainDerivatives.f90: -------------------------------------------------------------------------------- 1 | !------------------------------------------------------------------- 2 | 3 | subroutine slope (h,s,nx,ny,dx,dy) 4 | 5 | implicit none 6 | 7 | integer nx,ny 8 | double precision h(nx*ny),s(nx*ny),dx,dy 9 | 10 | integer i,j,ij,ia,ib,ic,id,ie,if,ig,ih,ii 11 | double precision dzdx,dzdy,con 12 | 13 | con=45.d0/atan(1.d0) 14 | 15 | s=0.d0 16 | do j=2,ny-1 17 | do i=2,nx-1 18 | ij=i+(j-1)*nx 19 | ia=ij+nx-1 20 | ib=ia+1 21 | ic=ib+1 22 | id=ij-1 23 | ie=ij 24 | if=ij+1 25 | ig=ij-nx-1 26 | ih=ig+1 27 | ii=ih+1 28 | dzdx=((h(ic)+2.d0*h(if)+h(ii))-(h(ia)+2.d0*h(id)+h(ig)))/8.d0/dx 29 | dzdy=((h(ig)+2.d0*h(ih)+h(ii))-(h(ia)+2.d0*h(ib)+h(ic)))/8.d0/dy 30 | s(ij)=dzdx**2+dzdy**2 31 | if (s(ij).gt.tiny(s(ij))) s(ij)=atan(sqrt(s(ij)))*con 32 | enddo 33 | enddo 34 | 35 | end subroutine slope 36 | 37 | !------------------------------------------------------------------- 38 | 39 | subroutine curvature (h,curv,nx,ny,dx,dy) 40 | 41 | implicit none 42 | 43 | integer nx,ny 44 | double precision dx,dy 45 | double precision h(nx*ny),curv(nx*ny) 46 | 47 | integer i,j,ij,i1,i2,i3,i4,i5,i6,i7,i8,i9 48 | double precision a,b,c,d,e,f 49 | 50 | curv=0.d0 51 | do j=2,ny-1 52 | do i=2,nx-1 53 | ij=i+(j-1)*nx 54 | i1=ij+nx-1 55 | i2=i1+1 56 | i3=i2+1 57 | i4=ij-1 58 | i5=ij 59 | i6=ij+1 60 | i7=ij-nx-1 61 | i8=i7+1 62 | i9=i8+1 63 | a=(h(i1)+h(i3)+h(i4)+h(i6)+h(i7)+h(i9))/dx/dx/12.d0-(h(i2)+h(i5)+h(i8))/dx/dx/6.d0 64 | b=(h(i1)+h(i2)+h(i3)+h(i7)+h(i8)+h(i9))/dy/dy/12.d0-(h(i4)+h(i5)+h(i6))/dy/dy/6.d0 65 | c=(h(i3)+h(i7)-h(i1)-h(i9))/dx/dy/4.d0 66 | d=(h(i3)+h(i6)+h(i9)-h(i1)-h(i4)-h(i7))/dx/6.d0 67 | e=(h(i1)+h(i2)+h(i3)-h(i7)-h(i8)-h(i9))/dy/6.d0 68 | f=(2.d0*(h(i2)+h(i4)+h(i6)+h(i8))-(h(i1)+h(i3)+h(i7)+h(i9))+5.d0*h(i5))/9.d0 69 | curv(ij)=1.d0+d**2+e**2 70 | if (curv(ij).gt.tiny(curv(ij))) curv(ij)=(a*(1.d0+e**2)+b*(1.d0+d**2)-c*d*e)/(curv(ij)**(3.d0/2.d0)) 71 | enddo 72 | enddo 73 | 74 | end subroutine curvature 75 | -------------------------------------------------------------------------------- /.github/workflows/test-fortran.yml: -------------------------------------------------------------------------------- 1 | name: test-fortran 2 | 3 | on: 4 | push: 5 | branches: 6 | - 'master' 7 | pull_request: 8 | branches: 9 | - 'master' 10 | 11 | env: 12 | HOMEBREW_NO_ANALYTICS: "ON" # Make Homebrew installation a little quicker 13 | HOMEBREW_NO_AUTO_UPDATE: "ON" 14 | HOMEBREW_NO_BOTTLE_SOURCE_FALLBACK: "ON" 15 | HOMEBREW_NO_GITHUB_API: "ON" 16 | HOMEBREW_NO_INSTALL_CLEANUP: "ON" 17 | BUILD_DIR: _build 18 | CMAKE_OPTIONS: >- 19 | -DBUILD_EXAMPLES=ON -DBUILD_FASTSCAPELIB_SHARED=ON -DCMAKE_BUILD_TYPE=Debug 20 | 21 | jobs: 22 | gcc-build: 23 | name: gcc (${{ matrix.os }}) 24 | runs-on: ${{ matrix.os }} 25 | strategy: 26 | fail-fast: false 27 | matrix: 28 | os: [ubuntu-latest, macos-latest] 29 | steps: 30 | - name: Checkout 31 | uses: actions/checkout@v2 32 | 33 | - name: Set Compiler (Linux) 34 | if: contains(matrix.os, 'ubuntu') 35 | run: | 36 | echo "FC=gfortran" >> $GITHUB_ENV 37 | echo "CC=gcc" >> $GITHUB_ENV 38 | 39 | - name: Install and Set Compiler (MacOS) 40 | if: contains(matrix.os, 'macos') 41 | run: | 42 | brew reinstall gfortran 43 | echo "FC=gfortran" >> $GITHUB_ENV 44 | echo "CC=gcc" >> $GITHUB_ENV 45 | 46 | - name: Configure build 47 | run: cmake -B ${BUILD_DIR} ${CMAKE_OPTIONS} 48 | 49 | - name: Build project 50 | run: cmake --build ${BUILD_DIR} 51 | 52 | - name: Run Fan example 53 | run: | 54 | cd ${BUILD_DIR}/examples 55 | ./Fan 56 | 57 | mingw-build: 58 | name: mingw (windows-latest) 59 | runs-on: windows-latest 60 | defaults: 61 | run: 62 | shell: msys2 {0} 63 | steps: 64 | - uses: actions/checkout@v2 65 | 66 | - uses: msys2/setup-msys2@v2 67 | with: 68 | msystem: MINGW64 69 | update: false 70 | install: >- 71 | mingw-w64-x86_64-gcc-fortran 72 | mingw-w64-x86_64-cmake 73 | mingw-w64-x86_64-ninja 74 | 75 | - name: Configure build 76 | run: cmake -B ${BUILD_DIR} -G Ninja ${CMAKE_OPTIONS} 77 | env: 78 | FC: gfortran 79 | CC: gcc 80 | 81 | - name: Build project 82 | run: cmake --build ${BUILD_DIR} 83 | 84 | - name: Run Fan example 85 | run: | 86 | cd ${BUILD_DIR}/examples 87 | ./Fan.exe 88 | -------------------------------------------------------------------------------- /docs/release_notes.adoc: -------------------------------------------------------------------------------- 1 | [#release_notes] 2 | == Release notes 3 | 4 | === Version 2.9.0 (Unreleased) 5 | 6 | ==== Changes 7 | 8 | ==== Bug fixes 9 | 10 | === Version 2.8.4 (29 September 2023) 11 | 12 | ==== Changes 13 | 14 | - Update source and online documentation of silt fraction #54 15 | 16 | ==== Bug fixes 17 | 18 | - Fixed compilation issues #56 19 | 20 | === Version 2.8.3 (2 December 2022) 21 | 22 | ==== Changes 23 | 24 | - Added user parametrable relative and absolute convergence parameters #51 25 | - VTK: set output files endianness using flags instead of within the code #47 26 | - VTK: added Filled Stratigraphic file for easier viewing and producing wells #41 27 | 28 | ==== Bug fixes 29 | 30 | - Fixed various warnings and errors #47 31 | - Added a couple of missing type declaration statements #43 32 | - Fixed bug in estimating erosional flux #39 33 | 34 | === Version 2.8.2 (19 May 2020) 35 | 36 | ==== Changes 37 | 38 | - Improved the documentation on installing Python bindings #37 39 | 40 | ==== Bug fixes 41 | 42 | - Made internal changes for more flexibility downstream #25 43 | - Refactored boundary conditions #33 44 | - Fixed boundary conditions in flexure #34 45 | - Explicit deallocation of arrays in StreamPowerLaw routines #35 46 | - Fixed some build issues with recent NumPy versions #37 47 | - Simplified CMake script for building the Python extension #37 48 | - Moved lake depth computation in flow routing subroutines #38 49 | 50 | === Version 2.8.1 (13 October 2019) 51 | 52 | ==== Bug fixes 53 | 54 | - Fixed regression with boundary conditions and StreamPowerLaw #29 55 | 56 | === Version 2.8.0 (18 September 2019) 57 | 58 | ==== Changes 59 | 60 | - Refactor stream power law implementation (decouple from flow 61 | routing) #23 62 | 63 | - Rename Union internal subroutine (could cause name conflicts when 64 | building the library with f2py) #22 65 | 66 | ==== New features 67 | 68 | - New routines for computing curvature and slope #15 69 | 70 | - New component for marine sediment transport and deposition #20 71 | 72 | ==== Bug fixes 73 | 74 | - Fixed VTK files export on Windows #7 75 | 76 | - Improved efficiency of stream power law erosion and flexure #8 77 | 78 | - Fixed bug in lake filling algorithm #12 79 | 80 | - Fixed bug in ADI implementation of diffusion #17 81 | 82 | - Fixed bug in Strati subroutine #18 83 | 84 | === Version 2.7.0 (30 January 2019) 85 | 86 | - First release in VCS. 87 | -------------------------------------------------------------------------------- /src/Advect.f90: -------------------------------------------------------------------------------- 1 | subroutine Advect () 2 | 3 | use FastScapeContext 4 | 5 | ! routine to advect the topography (h), basement (hb) and total erosion(etot) 6 | ! by a velocity field vx, vy, vz known at the same locations on a rectangular 7 | ! grid of nx by ny points separated by dx, dy over a time step dt 8 | 9 | implicit none 10 | 11 | double precision, dimension(:), allocatable :: diag,sup,inf,rhs,res 12 | double precision dx,dy 13 | integer i,j 14 | 15 | !print*,'Advect' 16 | 17 | dx=xl/(nx-1) 18 | dy=yl/(ny-1) 19 | 20 | ! x-advection using an implicit, second-order scheme to solve advection eq. 21 | 22 | allocate (diag(nx),sup(nx),inf(nx),rhs(nx),res(nx)) 23 | 24 | do j=1,ny 25 | 26 | diag=1.d0 27 | sup=0.d0 28 | inf=0.d0 29 | 30 | do i=1,nx 31 | if (vx2(i,j).gt.0.d0) then 32 | diag(i)=1.d0+vx2(i,j)*dt/dx 33 | inf(i)=-vx2(i,j)*dt/dx 34 | elseif (vx2(i,j).lt.0.d0) then 35 | diag(i)=1.d0-vx2(i,j)*dt/dx 36 | sup(i)=vx2(i,j)*dt/dx 37 | endif 38 | enddo 39 | sup(1)=0.d0 40 | diag(1)=1.d0 41 | diag(nx)=1.d0 42 | inf(nx)=0.d0 43 | 44 | rhs=h2(:,j) 45 | call tridag (inf,diag,sup,rhs,res,nx) 46 | h2(:,j)=res 47 | 48 | rhs=b2(:,j) 49 | call tridag (inf,diag,sup,rhs,res,nx) 50 | b2(:,j)=res 51 | 52 | rhs=etot2(:,j) 53 | call tridag (inf,diag,sup,rhs,res,nx) 54 | etot2(:,j)=res 55 | 56 | enddo 57 | 58 | deallocate (diag,sup,inf,rhs,res) 59 | 60 | ! y-advection using an implicit, second-order scheme to solve advection eq. 61 | 62 | allocate (diag(ny),sup(ny),inf(ny),rhs(ny),res(ny)) 63 | 64 | do i=1,nx 65 | 66 | diag=1.d0 67 | sup=0.d0 68 | inf=0.d0 69 | 70 | do j=1,ny 71 | if (vy2(i,j).gt.0.d0) then 72 | diag(j)=1.d0+vy2(i,j)*dt/dy 73 | inf(j)=-vy2(i,j)*dt/dy 74 | elseif (vy2(i,j).lt.0.d0) then 75 | diag(j)=1.d0-vy2(i,j)*dt/dy 76 | sup(j)=vy2(i,j)*dt/dy 77 | endif 78 | enddo 79 | sup(1)=0.d0 80 | diag(1)=1.d0 81 | diag(ny)=1.d0 82 | inf(ny)=0.d0 83 | 84 | rhs=h2(i,:) 85 | call tridag (inf,diag,sup,rhs,res,ny) 86 | h2(i,:)=res 87 | 88 | rhs=b2(i,:) 89 | call tridag (inf,diag,sup,rhs,res,ny) 90 | b2(i,:)=res 91 | 92 | rhs=etot2(i,:) 93 | call tridag (inf,diag,sup,rhs,res,ny) 94 | etot2(i,:)=res 95 | 96 | enddo 97 | 98 | deallocate (diag,sup,inf,rhs,res) 99 | 100 | b=min(b,h) 101 | 102 | return 103 | end 104 | -------------------------------------------------------------------------------- /examples/Mountain.f90: -------------------------------------------------------------------------------- 1 | program Mountain 2 | 3 | ! simple example of the use of the FastScapeLib 4 | ! where a square domain (100x100km) is subjected to constant and uniform uplift 5 | ! of 1 mm/yr 6 | ! all boundaries are at base level 7 | ! initial random topography 8 | ! nonlinear erosion law (n=1.5, m=0.6) 9 | ! transport coefficient g = 1 10 | 11 | implicit none 12 | 13 | integer :: nx, ny, istep, nstep 14 | double precision :: xl, yl, dt, kfsed, m, n, kdsed, g 15 | double precision, dimension(:), allocatable :: h, u, chi, kf, kd 16 | 17 | ! initialize FastScape 18 | call FastScape_Init () 19 | 20 | ! set grid size 21 | nx = 401 22 | ny = 401 23 | call FastScape_Set_NX_NY (nx,ny) 24 | 25 | ! allocate memory 26 | call FastScape_Setup () 27 | 28 | ! set model dimensions 29 | xl = 100.d3 30 | yl = xl 31 | call FastScape_Set_XL_YL (xl,yl) 32 | 33 | ! set time step 34 | dt = 1.d5 35 | call FastScape_Set_DT (dt) 36 | 37 | ! set random initial topography 38 | allocate (h(nx*ny)) 39 | call random_number (h) 40 | call FastScape_Init_H (h) 41 | 42 | ! set erosional parameters 43 | allocate (kf(nx*ny),kd(nx*ny)) 44 | kf = 2.d-6 45 | kfsed = -1.d0 46 | m = 0.6d0 47 | n = 1.5d0 48 | kd = 1.d-1 49 | kdsed = -1.d0 50 | g = 0.d0 51 | call FastScape_Set_Erosional_Parameters (kf, kfsed, m, n, kd, kdsed, g, g, -2.d0) 52 | 53 | ! set uplift rate (uniform while keeping boundaries at base level) 54 | allocate (u(nx*ny)) 55 | u = 1.d-3 56 | u(1:nx)=0.d0 57 | u(nx:nx*ny:nx)=0.d0 58 | u(1:nx*ny:nx)=0.d0 59 | u(nx*(ny-1)+1:nx*ny)=0.d0 60 | call FastScape_Set_U (u) 61 | 62 | ! set boundary conditions 63 | call FastScape_Set_BC (1111) 64 | 65 | ! set number of time steps and initialize counter istep 66 | nstep = 100 67 | call FastScape_Get_Step (istep) 68 | 69 | !allocate memory to extract chi 70 | allocate (chi(nx*ny)) 71 | 72 | ! loop on time stepping 73 | do while (istep> $GITHUB_ENV 37 | echo "CC=gcc" >> $GITHUB_ENV 38 | 39 | - name: Install and Set Compiler (MacOS) 40 | if: contains(matrix.os, 'macos') 41 | run: | 42 | brew reinstall gfortran 43 | echo "FC=gfortran" >> $GITHUB_ENV 44 | echo "CC=gcc" >> $GITHUB_ENV 45 | 46 | - name: Build and install Python bindings 47 | run: python -m pip install . -v --no-build-isolation --no-deps --ignore-installed --no-cache-dir 48 | 49 | - name: Test import Python module 50 | run: python -c "import sys; sys.path.pop(0); import fastscapelib_fortran" 51 | 52 | windows: 53 | name: 3.12 (windows-latest) 54 | runs-on: windows-latest 55 | steps: 56 | - name: Checkout 57 | uses: actions/checkout@v4 58 | 59 | - name: Setup Conda 60 | uses: conda-incubator/setup-miniconda@v3 61 | with: 62 | python-version: 3.12 63 | miniforge-version: latest 64 | 65 | - name: Install dependencies 66 | shell: cmd 67 | run: | 68 | conda create -n test python=3.12 cmake c-compiler flang=5.0 scikit-build pip wheel setuptools numpy 69 | 70 | - name: Conda env info 71 | shell: cmd 72 | run: >- 73 | conda activate test && 74 | echo %CONDA% && 75 | ls %CONDA%\envs\test\Library\bin 76 | 77 | - name: Build and install project 78 | shell: cmd 79 | run: >- 80 | conda activate test && 81 | set FC=%CONDA%\envs\test\Library\bin\flang.exe && 82 | python setup.py bdist_wheel --dist-dir="dist" -G "NMake Makefiles" -- -DCMAKE_Fortran_COMPILER:FILEPATH="%FC%" && 83 | python -m pip install --no-index --find-links="dist" fastscapelib_fortran -vvv 84 | 85 | - name: Test import Python module 86 | run: python -c "import sys; sys.path.pop(0); import fastscapelib_fortran" 87 | -------------------------------------------------------------------------------- /examples/Fan.f90: -------------------------------------------------------------------------------- 1 | program Fan 2 | 3 | ! Example of a small fan 4 | 5 | ! This fan is created by relaxation/erosion of a pre-existing plateau 6 | 7 | ! Note how sediments are progressively deposited in the valleys until 8 | ! the fan is coimpletely full (it has reached steady-state) at which stage 9 | ! the valleys are progressively emptied 10 | 11 | ! The evolution of the sedimentary flux out of the system and out of the 12 | ! plateau only is stored in the Fluxes.txt file 13 | 14 | implicit none 15 | 16 | integer :: nx,ny,istep,nstep,nn,ibc 17 | double precision, dimension(:), allocatable :: h,hp,x,y,kf,kd,b 18 | real :: time_in,time_out 19 | double precision :: kfsed,m,n,kdsed,g1,g2,expp 20 | double precision xl,yl,dt,pi,vex 21 | 22 | integer i,j 23 | 24 | ! set model resolution 25 | nx = 101 26 | ny = 201 27 | nn = nx*ny 28 | 29 | pi=atan(1.d0)*4.d0 30 | 31 | ! initialize FastScape 32 | call FastScape_Init () 33 | call FastScape_Set_NX_NY (nx,ny) 34 | call FastScape_Setup () 35 | 36 | ! set model dimensions 37 | xl=10.d3 38 | yl=20.d3 39 | call FastScape_Set_XL_YL (xl,yl) 40 | 41 | ! construct nodal coordinate arrays x and y 42 | allocate (x(nx*ny),y(nx*ny)) 43 | x = (/((xl*float(i-1)/(nx-1), i=1,nx),j=1,ny)/) 44 | y = (/((yl*float(j-1)/(ny-1), i=1,nx),j=1,ny)/) 45 | 46 | ! set time step 47 | dt=2.d3 48 | call FastScape_Set_DT (dt) 49 | 50 | ! we make the sediment slightly more easily erodible 51 | allocate (kf(nn),kd(nn)) 52 | kf=1.d-4 53 | kfsed=1.5d-4 54 | m=0.4d0 55 | n=1.d0 56 | kd=1.d-2 57 | kdsed=1.5d-2 58 | g1=1.d0 59 | g2=1.d0 60 | expp=1.d0 61 | call FastScape_Set_Erosional_Parameters (kf,kfsed,m,n,kd,kdsed,g1,g2,expp) 62 | 63 | ! bottom side is fixed only 64 | ibc=1000 65 | call FastScape_Set_BC (ibc) 66 | 67 | ! initial topography is a 1000 m high plateau 68 | allocate (h(nn),b(nn),hp(nn)) 69 | call random_number (h) 70 | where (y.gt.yl/2.d0) h=h+1000.d0 71 | call FastScape_Init_H (h) 72 | 73 | ! set number of time steps 74 | nstep = 200 75 | 76 | ! echo model setup 77 | call FastScape_View () 78 | 79 | ! initializes time step 80 | call FastScape_Get_Step (istep) 81 | 82 | ! set vertical exaggeration 83 | vex = 3.d0 84 | 85 | ! start of time loop 86 | call cpu_time (time_in) 87 | do while (istep.lt.nstep) 88 | 89 | ! execute FastScape step 90 | call FastScape_Execute_Step () 91 | call FastScape_Get_Step (istep) 92 | 93 | ! output vtk with sediment thickness information 94 | call FastScape_Copy_H (h) 95 | call FastScape_Copy_Basement (b) 96 | call FastScape_VTK (h-b, vex) 97 | 98 | enddo 99 | 100 | ! display timing information 101 | call FastScape_Debug() 102 | call cpu_time (time_out) 103 | print*,'Total run time',time_out-time_in 104 | 105 | ! exits FastScape 106 | call FastScape_Destroy () 107 | 108 | ! deallocate memory 109 | deallocate (h,x,y,kf,kd,b,hp) 110 | 111 | end program Fan 112 | -------------------------------------------------------------------------------- /examples/DippingDyke.f90: -------------------------------------------------------------------------------- 1 | program DippingDyke 2 | 3 | ! problem to test the variability in erodibility (kf) 4 | ! we assume that a dyke dipping at 30 degrees is buried beneath the landscape 5 | ! and is progressively exhumed by erosion; for this we use the total erosion 6 | ! to define the erodibility array kf 7 | 8 | implicit none 9 | 10 | integer :: nx, ny, istep, nstep, i, j 11 | double precision :: xl, yl, dt, m, n, g, xDyke, dxDyke, angle, cotana 12 | double precision, dimension(:), allocatable :: h, u, chi, kf, kd, x, y, e 13 | 14 | ! initialize FastScape 15 | call FastScape_Init () 16 | 17 | ! set grid size 18 | nx = 201 19 | ny = 201 20 | call FastScape_Set_NX_NY (nx,ny) 21 | 22 | ! allocate memory 23 | call FastScape_Setup () 24 | 25 | ! set model dimensions 26 | xl = 100.d3 27 | yl = xl 28 | call FastScape_Set_XL_YL (xl,yl) 29 | 30 | ! computes x and y coordinate arrays 31 | allocate (x(nx*ny),y(nx*ny)) 32 | x = (/((float(i-1)/(nx-1)*xl,i=1,nx),j=1,ny)/) 33 | y = (/((float(j-1)/(ny-1)*yl,i=1,nx),j=1,ny)/) 34 | 35 | ! set time step 36 | dt = 1.d5 37 | call FastScape_Set_DT (dt) 38 | 39 | ! set random initial topography 40 | allocate (h(nx*ny)) 41 | call random_number (h) 42 | call FastScape_Init_H (h) 43 | 44 | ! set erosional parameters 45 | allocate (kf(nx*ny),kd(nx*ny)) 46 | kf = 2.d-5 47 | m = 0.4d0 48 | n = 1.d0 49 | kd = 1.d-1 50 | g = 0.d0 51 | call FastScape_Set_Erosional_Parameters (kf, -1.d0, m, n, kd, -1.d0, g, -1.d0, 1.d0) 52 | 53 | ! set uplift rate 54 | allocate (u(nx*ny)) 55 | u = 1.d-3 56 | u(1:nx)=0.d0 57 | u(nx:nx*ny:nx)=0.d0 58 | u(1:nx*ny:nx)=0.d0 59 | u(nx*(ny-1)+1:nx*ny)=0.d0 60 | call FastScape_Set_U (u) 61 | 62 | ! set boundary conditions 63 | call FastScape_Set_BC (1111) 64 | 65 | ! set number of time steps and initialize counter istep 66 | nstep = 500 67 | call FastScape_Get_Step (istep) 68 | 69 | allocate (chi(nx*ny)) 70 | 71 | xDyke = xl/10.d0 72 | dxDyke = xl/50.d0 73 | angle = 30.d0 74 | cotana = 1.d0/tan(angle*3.141592654d0/180.d0) 75 | 76 | allocate (e(nx*ny)) 77 | 78 | ! loop on time stepping 79 | do while (istep < nstep) 80 | call FastScape_Copy_Total_Erosion (e) 81 | kf = 2.d-5 82 | where ((x-xDyke-e*cotana-dxDyke)*(x-xDyke-e*cotana+dxDyke).le.0.d0) kf = 1.d-5 83 | call FastScape_Set_Erosional_Parameters (kf, -1.d0, m, n, kd, -1.d0, g, -1.d0, 1.d0) 84 | ! execute step 85 | call FastScape_Execute_Step() 86 | ! get value of time step counter 87 | call FastScape_Get_Step (istep) 88 | ! extract solution 89 | call FastScape_Copy_Chi (chi) 90 | ! create VTK file 91 | call FastScape_VTK (chi, 2.d0) 92 | ! outputs h values 93 | call FastScape_Copy_h (h) 94 | print*,'step',istep,'h range:',minval(h),sum(h)/(nx*ny),maxval(h) 95 | enddo 96 | 97 | ! output timing 98 | call FastScape_Debug() 99 | 100 | ! end FastScape run 101 | call FastScape_Destroy () 102 | 103 | deallocate (h,u,kf,kd,chi,x,y,e) 104 | 105 | end program DippingDyke 106 | -------------------------------------------------------------------------------- /examples/Margin.f90: -------------------------------------------------------------------------------- 1 | program Margin 2 | 3 | ! Example of the use of the FastScapeInterface 4 | ! where a square domain (100x100km) is subjected to constant and uniform uplift 5 | ! of 1 mm/yr while adjacent area (100x100 km) is kept 1000 m below sea level 6 | ! bottom boundary is at base level, top is nu flux and left and rigth are cyclic 7 | ! initial random topography 8 | ! nonlinear erosion law (n=2, m=0.8) 9 | ! transport coefficient g = 1 10 | ! marine tranport is activated too 11 | 12 | ! note that this example introduces 2 arrays x and y containing the position 13 | ! of the nodes on the grid; these are used to define the uplift function and 14 | ! the initial topography 15 | 16 | implicit none 17 | 18 | integer :: nx, ny, istep, nstep, nfreq, i, j 19 | double precision :: xl, yl, dt, kfsed, m, n, kdsed, g, sealevel, poro, zporo, ratio, L, kds 20 | double precision, dimension(:), allocatable :: h, u, x, y, kf, kd, fd 21 | 22 | ! initialize FastScape 23 | call FastScape_Init () 24 | 25 | ! set grid size 26 | nx = 101 27 | ny = 151 28 | call FastScape_Set_NX_NY (nx,ny) 29 | 30 | ! allocate memory 31 | call FastScape_Setup () 32 | 33 | ! set model dimensions 34 | xl = 100.d3 35 | yl = 150.d3 36 | call FastScape_Set_XL_YL (xl,yl) 37 | 38 | ! construct nodal coordinate arrays x and y 39 | allocate (x(nx*ny),y(nx*ny)) 40 | x = (/((xl*float(i-1)/(nx-1), i=1,nx),j=1,ny)/) 41 | y = (/((yl*float(j-1)/(ny-1), i=1,nx),j=1,ny)/) 42 | 43 | ! set time step 44 | dt = 1.d3 45 | call FastScape_Set_DT (dt) 46 | 47 | ! set random initial topography 48 | allocate (h(nx*ny),kf(nx*ny),kd(nx*ny)) 49 | call random_number (h) 50 | where (y .. 36 | make 37 | ---- 38 | 39 | There are several build options, here shown with their default values: 40 | 41 | - `-DBUILD_FASTSCAPELIB_STATIC=ON`: build fastscapelib as a static library 42 | - `-DBUILD_FASTSCAPELIB_SHARED=OFF`: build fastscapelib as a shared library 43 | - `-DUSE_FLEXURE=OFF`: include flexure routines in the library 44 | - `-DBUILD_EXAMPLES=OFF`: "build usage examples that are in the 'examples' directory 45 | 46 | === Install the Fortran library 47 | 48 | If you want to install the **FastScapeLib** Fortran static/shared 49 | libraries in your system, then simply run: 50 | 51 | ---- 52 | make install 53 | ---- 54 | 55 | You should now be able to link your programs using **FastScapeLib** 56 | routines, e.g., with `-lfastscapelib_fortran`. See some Fortran programs 57 | in the 'examples' folder. 58 | 59 | === Install the Python package (using conda) 60 | 61 | [NOTE] 62 | ==== 63 | If you want to use this tool from within Python, you may consider using the 64 | **FastScape** package instead, which is built on top of FastScapeLib and which 65 | provides a high-level, user-friendly interface. See 66 | https://fastscape.readthedocs.io. 67 | ==== 68 | 69 | **FastScapeLib**'s Python bindings are available as a conda package 70 | (https://docs.conda.io/en/latest/). Conda can be installed from 71 | https://docs.conda.io/en/latest/miniconda.html. 72 | 73 | Then run the following command: 74 | 75 | ---- 76 | conda install fastscapelib-f2py -c conda-forge 77 | ---- 78 | 79 | You should now be able to import the package from within Python, e.g., 80 | 81 | ---- 82 | >>> import fastscapelib_fortran as fs 83 | ---- 84 | 85 | There is a Jupyter notebook in the 'examples' folder showing simple 86 | usage of the library. 87 | 88 | === Install the Python package (from source) 89 | 90 | You can also install **FastScapeLib**'s Python bindings from source, e.g, for 91 | development purpose. Run the following command from the source directory (i.e., 92 | the top-level folder containing the file `setup.py`): 93 | 94 | ---- 95 | python -m pip install . 96 | ---- 97 | 98 | This will also temporarily install all the tools needed to build the package 99 | (except a Fortran compiler, which must be already installed). Note: you need pip 100 | >= 10. 101 | 102 | If you experience issues when installing or importing the package (NumPy 103 | compatibility issues), try running pip without build isolation: 104 | 105 | ---- 106 | python -m pip install . --no-build-isolation 107 | ---- 108 | 109 | Note that in this case you may first need to manually install all the tools 110 | required to build the package (i.e., CMake, NumPy, scikit-build). 111 | -------------------------------------------------------------------------------- /src/Strati.f90: -------------------------------------------------------------------------------- 1 | subroutine Strati (b,F,nx,ny,xl,yl,reflector,nreflector,ireflector,istep,fields,nfield,vex,dt, & 2 | rec,sealevel) 3 | 4 | ! this routine tracks information (fields) on a set of reflectors (reflector) 5 | ! and outputs it to a set of VTKs. 6 | 7 | implicit none 8 | 9 | integer :: nx, ny, nn, nreflector, ireflector, i, nfield, istep 10 | double precision reflector(nx*ny,nreflector), b(nx*ny), F(nx*ny), dx, dy, vex, dt 11 | double precision fields(nx*ny,nfield,nreflector), xl, yl,sealevel 12 | integer, dimension(nx*ny) :: rec 13 | character names(nfield)*30 14 | 15 | double precision, dimension(:), allocatable :: s,dist 16 | character :: ref*3 17 | 18 | ! 1: current depth 19 | ! 2: current slope 20 | ! 3: current thickness between me and next horizon 21 | ! 4: current thickness between me and basement 22 | ! 5: paleo bathymetry 23 | ! 6: paleo slope 24 | ! 7: paleo distance to shore 25 | ! 8: paleo F 26 | ! 9: age of reflector (always with respect to present) 27 | ! 10: how much has been eroded below 28 | 29 | nn = nx*ny 30 | allocate (s(nn),dist(nn)) 31 | 32 | dx = xl/(nx - 1) 33 | dy = yl/(ny - 1) 34 | 35 | do i = 1, nreflector 36 | fields(:,1,i) = reflector(:,i) 37 | call slope (reflector(:,i),s,nx,ny,dx,dy) 38 | fields(:,2,i) = s 39 | if (rec(1).ne.0) call distance_to_shore (reflector(:,i),dist,nx,ny,rec,xl,yl) 40 | if (i.gt.1) then 41 | fields(:,3,i) = reflector(:,i)-reflector(:,i-1) 42 | else 43 | fields(:,3,i) = reflector(:,i)-b 44 | endif 45 | fields(:,4,i) = reflector(:,i)-b 46 | if (i.ge.ireflector) then 47 | fields(:,5,i) = reflector(:,i) + sealevel 48 | fields(:,6,i) = s 49 | fields(:,7,i) = dist 50 | fields(:,8,i) = F 51 | endif 52 | fields(:,9,i) = max(dt*(nreflector-i),0.d0) 53 | enddo 54 | 55 | names(1) = '1.CurrentDepth(m)' 56 | names(2) = '2.CurrentSlope(Deg)' 57 | names(3) = '3.ThicknessToNextReflector(m)' 58 | names(4) = '4.ThicknessToBasement(m)' 59 | names(5) = '5.DepositionalBathymetry(m)' 60 | names(6) = '6.DepositionalSlope(Deg)' 61 | names(7) = '7.DistanceToShore(m)' 62 | names(8) = '8.SiltFraction' 63 | names(9) = '9.ReflectorAge(yr)' 64 | names(10) = 'A.ThicknessErodedBelow(m)' 65 | 66 | do i = 1, nreflector 67 | write (ref,'(i3)') i 68 | if (i.lt.10) ref(1:2)='00' 69 | if (i.lt.100) ref(1:1)='0' 70 | call VTK (reflector(:,i),'Horizon'//ref//'-',nfield,fields(:,1:nfield,i),names, nx,ny,dx,dy,istep,vex) 71 | enddo 72 | 73 | call distance_to_shore (b,dist,nx,ny,rec,xl,yl) 74 | call VTK_filled (b, nreflector, reflector, nfield, fields, names, nx, ny, dx, dy, istep, vex, dist) 75 | 76 | deallocate (s,dist) 77 | 78 | if (ireflector.eq.nreflector) call VTK_CUBE (fields, nx, ny, nfield, nreflector, xl, yl, names) 79 | 80 | return 81 | 82 | end subroutine Strati 83 | 84 | !------------------------------------------------------------------- 85 | 86 | subroutine distance_to_shore (h,d,nx,ny,rec,xl,yl) 87 | 88 | implicit none 89 | 90 | integer nx, ny 91 | double precision xl, yl 92 | double precision, dimension(nx*ny) :: h, d 93 | integer, dimension(nx*ny) :: rec 94 | 95 | double precision, dimension(:), allocatable :: x,y 96 | double precision rat, xshore, yshore, dist 97 | integer :: i, j, ij, ijk 98 | 99 | d = 2.d0*(xl**2 + yl**2) 100 | 101 | allocate (x(nx*ny), y(nx*ny)) 102 | x = (/((xl*float(i-1)/(nx-1), i=1,nx),j=1,ny)/) 103 | y = (/((yl*float(j-1)/(ny-1), i=1,nx),j=1,ny)/) 104 | 105 | do ij = 1, nx*ny 106 | 107 | if (h(ij)*h(rec(ij)).lt.0.d0) then 108 | 109 | rat = 0.5d0 110 | if (h(rec(ij))-h(ij).ne.0.d0) rat = h(ij)/(h(rec(ij))-h(ij)) 111 | xshore = x(ij) + rat*(x(rec(ij))-x(ij)) 112 | yshore = y(ij) + rat*(y(rec(ij))-y(ij)) 113 | 114 | do ijk = 1, nx*ny 115 | dist = (x(ijk) - xshore)**2 + (y(ijk) - yshore)**2 116 | d(ijk) = min (d(ijk),dist) 117 | enddo 118 | 119 | endif 120 | 121 | enddo 122 | 123 | where (d>0.d0) d = sqrt(d) 124 | 125 | return 126 | 127 | end subroutine distance_to_shore 128 | -------------------------------------------------------------------------------- /docs/examples.adoc: -------------------------------------------------------------------------------- 1 | [#examples] 2 | == Examples 3 | 4 | Several examples are provided in the `examples` directory. They are meant to be used as templates by the user. To compile them, use the CMake option `-DBUILD_EXAMPLES=ON` (see <> section for more details). This creates executables in the `examples` subfolder of your build directory. To run one of those examples, e.g., `Mountain`: 5 | 6 | ---- 7 | rm VTK/*.vtk 8 | ./Mountain 9 | ---- 10 | 11 | The first line is needed to remove any pre-existing `.vtk` file in the `VTK` directory. 12 | 13 | === Mountain.f90 14 | 15 | This is the basic square mountain problem where a landscape is formed by a uniform uplift, all four boundaries being kept at base level. The resolution is medium (400x400). The SPL is non linear (n = 1.5) but no sediment effect is included (g = 0). Single direction flow is selected by setting `expp = 10`. The model run lasts for 10 Myr (100 time steps of 100 kyr each). 16 | 17 | This model should run in approximately 90-100 seconds on a reasonably fast modern computer. 18 | 19 | === Margin.f90 20 | 21 | Example showing the use of the Marine component of **FastScapeLib**. 22 | 23 | An area of 100x150 km is set to uplift on one half only. The other half is 1000 m below sea level and accumulate sediment eroded from the uplifting area. The erosion model is nonlinear (n = 2) and sediment transport affects erosion (g = 1). Multiple direction flow is selected. Marine transport is 10 x more efficient for silt than sand. No compaction. Resolution is 100x150. Boundary conditions are no flux boundaries except along the bottom boundary where base level is fixed at -1000 m. 24 | 25 | This model should run in approximately 90-95 seconds on a reasonably fast modern computer. 26 | 27 | === Fan.f90 28 | 29 | Example of the use of the continental transport/deposition component of **FastScapeLib**. 30 | 31 | Here we create a sedimentary fan at the base of an initially 1000 m high plateau. The model is relatively small (10x20 km) and low resolution (101x201). The erosion law is linear (n = 1) but sediments are more easily eroded (by a factor 1.5). Sediment transport/deposition is strong (g = 1). Multiple direction flow is selected. Boundary conditions are no flux on the top boundary, cyclic on the left and right boundaries and fixed height along the bottom boundary where base level is fixed at sea level (0 m). 32 | 33 | This model should run in approximately 12 seconds on a reasonably fast modern computer. 34 | 35 | === DippingDyke.f90 36 | 37 | Example of the use of spatially and temporally variable erodibility 38 | 39 | Here we look at the effect of a resistant dyke dipping at 30 degree angle and being progressively exhumed. The dyke's surface expression progressively traverses the landscape and affects the drainage pattern. 40 | 41 | The model, otherwise, is very simple: block uplift, all boundaries at base level, linear SPL, multiple direction flow and no sediment. 42 | 43 | This model should run in approximately 25 seconds on a reasonably fast modern computer. 44 | 45 | === flexure_test.f90 46 | 47 | This example shows how to use `flexure` but also how it interacts with **FastScapeLib**: the flexure module needs the topography computed by **FastScapeLib** as input to `flexure` but the user also needs to set the topography and basement geometry to the new values estimated by `flexure`. Running this model creates an ASCII file (`Fluxes.txt`) containing the fluxes coming out of the model. 48 | 49 | This model should run in approximately 6 minutes on a reasonably fast modern computer. 50 | 51 | === FastScape_test.ipynb 52 | 53 | This Jupyter notebook contains a simple (low resolution) example where the right-hand side of a rectangular model is an initially 100 m high plateau subjected to erosion, while the left-hand side is kept fixed at base level. The SPL is linear (`n = 1`) but completed by a sediment transport/deposition algoithm with `g = 1`. 54 | 55 | Boundary conditions are closed except for the left hand-side (boundary number 4) set to base level. 56 | 57 | The model is run for 200 time steps and the results are stored in `.vtk` files where the drainage area is also stored. 58 | 59 | The drainage area of the last time step is also shown as a contour plot as shown in Figure <<#img-FastScapePyhton>> 60 | 61 | [#img-FastScapePyhton] 62 | .Fan example. 63 | image::images/FastScapePython.jpg[FastScapePyhton,600,300] 64 | -------------------------------------------------------------------------------- /examples/flexure_test.f90: -------------------------------------------------------------------------------- 1 | program flexure_test 2 | 3 | ! test example to demonstrate how to use the flexure routine 4 | ! see relevant section below for explanations 5 | 6 | implicit none 7 | 8 | integer :: nx,ny,istep,nstep,nn,nfreq,ibc,nreflector 9 | double precision, dimension(:), allocatable :: u,h,b,hp,h0,rhos,p,x,y,kf,kd 10 | real :: time_in,time_out 11 | double precision :: kfsed,m,n,kdsed,g,expp 12 | double precision xl,yl,dt,pi,vex 13 | double precision rhoa, eet, tflux, eflux, bflux 14 | 15 | integer i,j 16 | 17 | ! set model resolution 18 | 19 | nx = 201 20 | ny = 401 21 | nn = nx*ny 22 | 23 | pi=atan(1.d0)*4.d0 24 | 25 | ! initializes FastScape 26 | 27 | call FastScape_Init () 28 | call FastScape_Set_NX_NY (nx,ny) 29 | call FastScape_Setup () 30 | 31 | ! set model dimensions 32 | xl=200.d3 33 | yl=400.d3 34 | call FastScape_Set_XL_YL (xl,yl) 35 | 36 | ! buid geometry arrays (x and y) 37 | allocate (x(nx*ny),y(nx*ny)) 38 | x = (/((xl*float(i-1)/(nx-1), i=1,nx),j=1,ny)/) 39 | y = (/((yl*float(j-1)/(ny-1), i=1,nx),j=1,ny)/) 40 | 41 | ! set time step length 42 | dt=20.d3 43 | call FastScape_Set_DT (dt) 44 | 45 | ! set continental erosion parameters 46 | allocate (kf(nn),kd(nn)) 47 | kf=1.d-5 48 | kfsed=1.d-5 49 | m=0.4d0 50 | n=1.d0 51 | kd=1.d-2 52 | kdsed=1.d-2 53 | kd=0.d0 54 | kdsed=0.d0 55 | g=1.d0 56 | expp=-1.d0 57 | call FastScape_Set_Erosional_Parameters (kf,kfsed,m,n,kd,kdsed,g,g,expp) 58 | 59 | ! set boundary conditions (base level at bottom, no flux at top, cyclic on left and right) 60 | ibc=1000 61 | call FastScape_Set_BC (ibc) 62 | 63 | ! set initial topography 64 | allocate (h(nn),b(nn),u(nn),hp(nn),h0(nn),rhos(nn),p(nn)) 65 | call random_number (h) 66 | where (y.gt.2.d0*yl/4.d0) h = h + 100.d0 67 | h=h+1.*cos(x/xl*2.d0*pi) 68 | call FastScape_Init_H (h) 69 | 70 | ! set number of time steps and frequency of output 71 | nstep = 1000 72 | nfreq = 10 73 | 74 | ! echo model setup 75 | call FastScape_View() 76 | 77 | ! set uplift function (on half of the model) 78 | u = 3.d-4 79 | where (y.lt.yl/2.d0) u =0.d0 80 | call FastScape_Set_U (u) 81 | 82 | ! set uniform precipitation rate 83 | p = 1.d0 84 | call FastScape_Set_Precip (p) 85 | 86 | ! activate tracking of stratigraphy (using 5 relfectors) and set vertical exaggeration 87 | nreflector = 5 88 | vex = 50.d0 89 | call FastScape_Strati (nstep, nreflector, nfreq, vex) 90 | 91 | ! set parameters for flexure (asthenospheric and surface densities and EET) 92 | rhoa = 3250.d0 93 | eet = 10.d3 94 | rhos = 2400.d0 95 | 96 | ! sets the clock to estimate total execution time 97 | call cpu_time (time_in) 98 | 99 | ! opens a file to track fluxes 100 | open (88,file='Fluxes.txt',status='unknown') 101 | 102 | ! get step number (shold be zero as we have not yet called FastScape_Execute_Step) 103 | call FastScape_Get_Step (istep) 104 | 105 | ! start of time loop 106 | do while (istep.lt.nstep) 107 | 108 | ! stores topography at time t 109 | call FastScape_Copy_H (hp) 110 | 111 | ! execute an erosion/deposition step 112 | call FastScape_Execute_Step () 113 | call FastScape_Get_Step (istep) 114 | 115 | ! get solution at time t+Dt and stores it in h0 116 | call FastScape_Copy_H (h) 117 | h0 = h 118 | 119 | ! apply flexure 120 | call flexure (h,hp,nx,ny,xl,yl,rhos,rhoa,eet,ibc) 121 | h0 = h-h0 122 | call FastScape_Set_All_Layers (h0) 123 | 124 | ! when needed saves solution to VTK file 125 | if (mod(istep,nfreq)==0) then 126 | call FastScape_Copy_H (h) 127 | call FastScape_Copy_Erosion_Rate (b) 128 | print*,istep 129 | print*,'topo',minval(h),sum(h)/nn,maxval(h) 130 | print*,'erosion rate',minval(b),sum(b)/nn,maxval(b) 131 | call FastScape_VTK (b,-vex) 132 | endif 133 | 134 | ! compute fluxes and store them in a file 135 | call FastScape_Get_Fluxes (tflux, eflux, bflux) 136 | write (88,*) tflux, eflux, bflux 137 | 138 | enddo 139 | 140 | ! close flux file 141 | close (88) 142 | 143 | ! compute and display total CPU time 144 | call cpu_time (time_out) 145 | print*,'Total run time',time_out-time_in 146 | 147 | ! exit FastScape (ie releases memory) 148 | call FastScape_Destroy () 149 | 150 | ! deallocate all arrays 151 | deallocate (u,h,b,hp,h0,rhos,x,y,kf,kd) 152 | 153 | end program flexure_test 154 | -------------------------------------------------------------------------------- /cmake/FindF2PY.cmake: -------------------------------------------------------------------------------- 1 | #.rst: 2 | # 3 | # The purpose of the F2PY –Fortran to Python interface generator– project is to provide a 4 | # connection between Python and Fortran languages. 5 | # 6 | # F2PY is a Python package (with a command line tool f2py and a module f2py2e) that facilitates 7 | # creating/building Python C/API extension modules that make it possible to call Fortran 77/90/95 8 | # external subroutines and Fortran 90/95 module subroutines as well as C functions; to access Fortran 9 | # 77 COMMON blocks and Fortran 90/95 module data, including allocatable arrays from Python. 10 | # 11 | # For more information on the F2PY project, see http://www.f2py.com/. 12 | # 13 | # The following variables are defined: 14 | # 15 | # :: 16 | # 17 | # F2PY_EXECUTABLE - absolute path to the F2PY executable 18 | # 19 | # :: 20 | # 21 | # F2PY_VERSION_STRING - the version of F2PY found 22 | # F2PY_VERSION_MAJOR - the F2PY major version 23 | # F2PY_VERSION_MINOR - the F2PY minor version 24 | # F2PY_VERSION_PATCH - the F2PY patch version 25 | # 26 | # 27 | # .. note:: 28 | # 29 | # By default, the module finds the F2PY program associated with the installed NumPy package. 30 | # 31 | # Example usage 32 | # ^^^^^^^^^^^^^ 33 | # 34 | # Assuming that a package named ``method`` is declared in ``setup.py`` and that the corresponding directory 35 | # containing ``__init__.py`` also exists, the following CMake code can be added to ``method/CMakeLists.txt`` 36 | # to ensure the C sources associated with ``cylinder_methods.f90`` are generated and the corresponding module 37 | # is compiled: 38 | # 39 | # .. code-block:: cmake 40 | # 41 | # find_package(F2PY REQUIRED) 42 | # 43 | # set(f2py_module_name "_cylinder_methods") 44 | # set(fortran_src_file "${CMAKE_CURRENT_SOURCE_DIR}/cylinder_methods.f90") 45 | # 46 | # set(generated_module_file ${CMAKE_CURRENT_BINARY_DIR}/${f2py_module_name}${PYTHON_EXTENSION_MODULE_SUFFIX}) 47 | # 48 | # add_custom_target(${f2py_module_name} ALL 49 | # DEPENDS ${generated_module_file} 50 | # ) 51 | # 52 | # add_custom_command( 53 | # OUTPUT ${generated_module_file} 54 | # COMMAND ${F2PY_EXECUTABLE} 55 | # -m ${f2py_module_name} 56 | # -c 57 | # ${fortran_src_file} 58 | # WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR} 59 | # ) 60 | # 61 | # install(FILES ${generated_module_file} DESTINATION methods) 62 | # 63 | # .. warning:: 64 | # 65 | # Using ``f2py`` with ``-c`` argument means that f2py is also responsible to build the module. In that 66 | # case, CMake is not used to find the compiler and configure the associated build system. 67 | # 68 | 69 | # temporarily disable and force searching the program path through the python numpy module (below) 70 | # (see patch added in https://github.com/conda-forge/fastscapelib-f2py-feedstock/pull/17) 71 | # (see https://github.com/conda-forge/numpy-feedstock/issues/276) 72 | # find_program(F2PY_EXECUTABLE NAMES f2py${PYTHON_VERSION_MAJOR} f2py) 73 | 74 | # XXX This is required to support NumPy < v0.15.0. See note in module documentation above. 75 | if(NOT F2PY_EXECUTABLE) 76 | find_package(NumPy) 77 | set(F2PY_EXECUTABLE "${PYTHON_EXECUTABLE}" "-m" "numpy.f2py.__main__") 78 | endif() 79 | 80 | if(NOT F2PY_INCLUDE_DIR) 81 | execute_process( 82 | COMMAND "${PYTHON_EXECUTABLE}" 83 | -c "import os; from numpy import f2py; print(os.path.dirname(f2py.__file__))" 84 | OUTPUT_VARIABLE _f2py_directory 85 | OUTPUT_STRIP_TRAILING_WHITESPACE 86 | ERROR_QUIET 87 | ) 88 | string(REPLACE "\\" "/" _f2py_directory ${_f2py_directory}) 89 | 90 | set(F2PY_INCLUDE_DIR "${_f2py_directory}/src" CACHE STRING "F2PY source directory location" FORCE) 91 | endif() 92 | 93 | # Set-up the F2PY libraries and include directories 94 | file(GLOB _f2py_sources "${F2PY_INCLUDE_DIR}/*.c") 95 | add_library(_f2py_runtime_library STATIC ${_f2py_sources}) 96 | target_include_directories( 97 | _f2py_runtime_library 98 | PRIVATE ${PYTHON_INCLUDE_DIRS} ${NumPy_INCLUDE_DIRS} 99 | ) 100 | 101 | set_target_properties(_f2py_runtime_library PROPERTIES POSITION_INDEPENDENT_CODE ON) 102 | 103 | set(F2PY_LIBRARIES _f2py_runtime_library) 104 | set(F2PY_INCLUDE_DIRS "${F2PY_INCLUDE_DIR}" "${NumPy_INCLUDE_DIRS}") 105 | 106 | if(F2PY_EXECUTABLE) 107 | # extract the version string 108 | execute_process(COMMAND "${F2PY_EXECUTABLE}" -v 109 | OUTPUT_VARIABLE F2PY_VERSION_STRING 110 | OUTPUT_STRIP_TRAILING_WHITESPACE) 111 | if("${F2PY_VERSION_STRING}" MATCHES "^([0-9]+)(.([0-9+]))?(.([0-9+]))?$") 112 | set(F2PY_VERSION_MAJOR ${CMAKE_MATCH_1}) 113 | set(F2PY_VERSION_MINOR "${CMAKE_MATCH_3}") 114 | set(F2PY_VERSION_PATCH "${CMAKE_MATCH_5}") 115 | endif() 116 | endif() 117 | 118 | # handle the QUIETLY and REQUIRED arguments and set F2PY_FOUND to TRUE if 119 | # all listed variables are TRUE 120 | include(FindPackageHandleStandardArgs) 121 | find_package_handle_standard_args(F2PY 122 | REQUIRED_VARS F2PY_EXECUTABLE 123 | VERSION_VAR F2PY_VERSION_STRING 124 | ) 125 | 126 | mark_as_advanced(F2PY_EXECUTABLE) 127 | 128 | include(UseF2PY) 129 | -------------------------------------------------------------------------------- /cmake/UseF2PY.cmake: -------------------------------------------------------------------------------- 1 | #.rst: 2 | # 3 | # The following functions are defined: 4 | # 5 | # .. cmake:command:: add_f2py_target 6 | # 7 | # Create a custom rule to generate the source code for a Python extension module 8 | # using f2py. 9 | # 10 | # add_f2py_target( [] 11 | # [OUTPUT_VAR ]) 12 | # 13 | # ```` is the name of the new target, and ```` 14 | # is the path to a pyf source file. Note that, despite the name, no new 15 | # targets are created by this function. Instead, see ``OUTPUT_VAR`` for 16 | # retrieving the path to the generated source for subsequent targets. 17 | # 18 | # If only ```` is provided, and it ends in the ".pyf" extension, then it 19 | # is assumed to be the ````. The name of the input without the 20 | # extension is used as the target name. If only ```` is provided, and it 21 | # does not end in the ".pyf" extension, then the ```` is assumed to 22 | # be ``.pyf``. 23 | # 24 | # 25 | # Options: 26 | # 27 | # ``OUTPUT_VAR `` 28 | # Set the variable ```` in the parent scope to the path to the 29 | # generated source file. By default, ```` is used as the output 30 | # variable name. 31 | # 32 | # ``DEPENDS [source [source2...]]`` 33 | # Sources that must be generated before the F2PY command is run. 34 | # 35 | # Defined variables: 36 | # 37 | # ```` 38 | # The path of the generated source file. 39 | # 40 | # Example usage 41 | # ^^^^^^^^^^^^^ 42 | # 43 | # .. code-block:: cmake 44 | # 45 | # find_package(F2PY) 46 | # 47 | # # Note: In this case, either one of these arguments may be omitted; their 48 | # # value would have been inferred from that of the other. 49 | # add_f2py_target(f2py_code f2py_code.pyf) 50 | # 51 | # add_library(f2py_code MODULE ${f2py_code}) 52 | # target_link_libraries(f2py_code ...) 53 | # 54 | #============================================================================= 55 | # Copyright 2011 Kitware, Inc. 56 | # 57 | # Licensed under the Apache License, Version 2.0 (the "License"); 58 | # you may not use this file except in compliance with the License. 59 | # You may obtain a copy of the License at 60 | # 61 | # http://www.apache.org/licenses/LICENSE-2.0 62 | # 63 | # Unless required by applicable law or agreed to in writing, software 64 | # distributed under the License is distributed on an "AS IS" BASIS, 65 | # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 66 | # See the License for the specific language governing permissions and 67 | # limitations under the License. 68 | #============================================================================= 69 | 70 | get_property(languages GLOBAL PROPERTY ENABLED_LANGUAGES) 71 | 72 | function(add_f2py_target _name) 73 | set(options ) 74 | set(oneValueArgs OUTPUT_VAR) 75 | set(multiValueArgs DEPENDS) 76 | cmake_parse_arguments(_args "${options}" "${oneValueArgs}" "${multiValueArgs}" ${ARGN}) 77 | 78 | list(GET _args_UNPARSED_ARGUMENTS 0 _arg0) 79 | 80 | # if provided, use _arg0 as the input file path 81 | if(_arg0) 82 | set(_source_file ${_arg0}) 83 | 84 | # otherwise, must determine source file from name, or vice versa 85 | else() 86 | get_filename_component(_name_ext "${_name}" EXT) 87 | 88 | # if extension provided, _name is the source file 89 | if(_name_ext) 90 | set(_source_file ${_name}) 91 | string(REGEX REPLACE "\\.[^.]*$" "" _name ${_source}) 92 | 93 | # otherwise, assume the source file is ${_name}.pyf 94 | else() 95 | set(_source_file ${_name}.pyf) 96 | endif() 97 | endif() 98 | 99 | set(_embed_main FALSE) 100 | 101 | if("C" IN_LIST languages) 102 | set(_output_syntax "C") 103 | else() 104 | message(FATAL_ERROR "C must be enabled to use F2PY") 105 | endif() 106 | 107 | set(extension "c") 108 | 109 | set(generated_file "${CMAKE_CURRENT_BINARY_DIR}/${_name}module.${extension}") 110 | set(generated_wrappers 111 | "${CMAKE_CURRENT_BINARY_DIR}/${_name}-f2pywrappers.f" 112 | "${CMAKE_CURRENT_BINARY_DIR}/${_name}-f2pywrappers2.f90" 113 | ) 114 | 115 | get_filename_component(generated_file_dir ${generated_file} DIRECTORY) 116 | 117 | set_source_files_properties(${generated_file} PROPERTIES GENERATED TRUE) 118 | set_source_files_properties(${generated_wrappers} PROPERTIES GENERATED TRUE) 119 | 120 | set(_output_var ${_name}) 121 | if(_args_OUTPUT_VAR) 122 | set(_output_var ${_args_OUTPUT_VAR}) 123 | endif() 124 | set(${_output_var} ${generated_file} ${generated_wrappers} PARENT_SCOPE) 125 | 126 | file(RELATIVE_PATH generated_file_relative 127 | ${CMAKE_BINARY_DIR} ${generated_file}) 128 | 129 | set(comment "Generating ${_output_syntax} source ${generated_file_relative}") 130 | 131 | # Get the include directories. 132 | get_source_file_property(pyf_location ${_source_file} LOCATION) 133 | get_filename_component(pyf_path ${pyf_location} PATH) 134 | 135 | # Create the directory so that the command can cd to it 136 | file(MAKE_DIRECTORY ${generated_file_dir}) 137 | 138 | # Add the command to run the compiler. 139 | add_custom_command(OUTPUT ${generated_file} ${generated_wrappers} 140 | COMMAND ${F2PY_EXECUTABLE} ${pyf_location} 141 | DEPENDS ${_source_file} 142 | ${_args_DEPENDS} 143 | WORKING_DIRECTORY ${generated_file_dir} 144 | COMMENT ${source_comment}) 145 | 146 | endfunction() 147 | -------------------------------------------------------------------------------- /src/Diffusion.f90: -------------------------------------------------------------------------------- 1 | subroutine Diffusion () 2 | 3 | ! subroutine to solve the diffusion equation by ADI 4 | 5 | use FastScapeContext 6 | 7 | implicit none 8 | 9 | double precision, dimension(:), allocatable :: f,diag,sup,inf,res 10 | double precision, dimension(:,:), allocatable :: zint,kdint,zintp 11 | integer i,j,ij 12 | double precision factxp,factxm,factyp,factym,dx,dy 13 | character cbc*4 14 | 15 | !print*,'Diffusion' 16 | 17 | write (cbc,'(i4)') bounds_ibc 18 | 19 | dx=xl/(nx-1) 20 | dy=yl/(ny-1) 21 | 22 | ! creates 2D internal arrays to store topo and kd 23 | 24 | allocate (zint(nx,ny),kdint(nx,ny),zintp(nx,ny)) 25 | 26 | do j=1,ny 27 | do i=1,nx 28 | ij=(j-1)*nx+i 29 | zint(i,j)=h(ij) 30 | kdint(i,j)=kd(ij) 31 | if (kdsed.gt.0.d0 .and. (h(ij)-b(ij)).gt.1.d-6) kdint(i,j)=kdsed 32 | enddo 33 | enddo 34 | 35 | zintp = zint 36 | 37 | ! first pass along the x-axis 38 | 39 | allocate (f(nx),diag(nx),sup(nx),inf(nx),res(nx)) 40 | f=0.d0 41 | diag=0.d0 42 | sup=0.d0 43 | inf=0.d0 44 | res=0.d0 45 | do j=2,ny-1 46 | do i=2,nx-1 47 | factxp=(kdint(i+1,j)+kdint(i,j))/2.d0*(dt/2.)/dx**2 48 | factxm=(kdint(i-1,j)+kdint(i,j))/2.d0*(dt/2.)/dx**2 49 | factyp=(kdint(i,j+1)+kdint(i,j))/2.d0*(dt/2.)/dy**2 50 | factym=(kdint(i,j-1)+kdint(i,j))/2.d0*(dt/2.)/dy**2 51 | diag(i)=1.d0+factxp+factxm 52 | sup(i)=-factxp 53 | inf(i)=-factxm 54 | f(i)=zintp(i,j)+factyp*zintp(i,j+1)-(factyp+factym)*zintp(i,j)+factym*zintp(i,j-1) 55 | enddo 56 | ! left bc 57 | if (cbc(4:4).eq.'1') then 58 | diag(1)=1. 59 | sup(1)=0. 60 | f(1)=zintp(1,j) 61 | else 62 | factxp=(kdint(2,j)+kdint(1,j))/2.d0*(dt/2.)/dx**2 63 | factyp=(kdint(1,j+1)+kdint(1,j))/2.d0*(dt/2.)/dy**2 64 | factym=(kdint(1,j-1)+kdint(1,j))/2.d0*(dt/2.)/dy**2 65 | diag(1)=1.d0+factxp 66 | sup(1)=-factxp 67 | f(1)=zintp(1,j)+factyp*zintp(1,j+1)-(factyp+factym)*zintp(1,j)+factym*zintp(1,j-1) 68 | endif 69 | ! right bc 70 | if (cbc(2:2).eq.'1') then 71 | diag(nx)=1. 72 | inf(nx)=0. 73 | f(nx)=zintp(nx,j) 74 | else 75 | factxm=(kdint(nx-1,j)+kdint(nx,j))/2.d0*(dt/2.)/dx**2 76 | factyp=(kdint(nx,j+1)+kdint(nx,j))/2.d0*(dt/2.)/dy**2 77 | factym=(kdint(nx,j-1)+kdint(nx,j))/2.d0*(dt/2.)/dy**2 78 | diag(nx)=1.d0+factxm 79 | inf(nx)=-factxm 80 | f(nx)=zintp(nx,j)+factyp*zintp(nx,j+1)-(factyp+factym)*zintp(nx,j)+factym*zintp(nx,j-1) 81 | endif 82 | call tridag (inf,diag,sup,f,res,nx) 83 | do i=1,nx 84 | zint(i,j)=res(i) 85 | enddo 86 | enddo 87 | deallocate (f,diag,sup,inf,res) 88 | 89 | ! second pass along y-axis 90 | 91 | allocate (f(ny),diag(ny),sup(ny),inf(ny),res(ny)) 92 | f=0.d0 93 | diag=0.d0 94 | sup=0.d0 95 | inf=0.d0 96 | res=0.d0 97 | do i=2,nx-1 98 | do j=2,ny-1 99 | factxp=(kdint(i+1,j)+kdint(i,j))/2.d0*(dt/2.)/dx**2 100 | factxm=(kdint(i-1,j)+kdint(i,j))/2.d0*(dt/2.)/dx**2 101 | factyp=(kdint(i,j+1)+kdint(i,j))/2.d0*(dt/2.)/dy**2 102 | factym=(kdint(i,j-1)+kdint(i,j))/2.d0*(dt/2.)/dy**2 103 | diag(j)=1.d0+factyp+factym 104 | sup(j)=-factyp 105 | inf(j)=-factym 106 | f(j)=zint(i,j)+factxp*zint(i+1,j)-(factxp+factxm)*zint(i,j)+factxm*zint(i-1,j) 107 | enddo 108 | ! bottom bc 109 | if (cbc(1:1).eq.'1') then 110 | diag(1)=1. 111 | sup(1)=0. 112 | f(1)=zint(i,1) 113 | else 114 | factxp=(kdint(i+1,1)+kdint(i,j))/2.d0*(dt/2.)/dx**2 115 | factxm=(kdint(i-1,1)+kdint(i,1))/2.d0*(dt/2.)/dx**2 116 | factyp=(kdint(i,2)+kdint(i,1))/2.d0*(dt/2.)/dy**2 117 | diag(1)=1.d0+factyp 118 | sup(1)=-factyp 119 | f(1)=zint(i,1)+factxp*zint(i+1,1)-(factxp+factxm)*zint(i,1)+factxm*zint(i-1,1) 120 | endif 121 | ! top bc 122 | if (cbc(3:3).eq.'1') then 123 | diag(ny)=1. 124 | inf(ny)=0. 125 | f(ny)=zint(i,ny) 126 | else 127 | factxp=(kdint(i+1,ny)+kdint(i,ny))/2.d0*(dt/2.)/dx**2 128 | factxm=(kdint(i-1,ny)+kdint(i,ny))/2.d0*(dt/2.)/dx**2 129 | factym=(kdint(i,ny-1)+kdint(i,ny))/2.d0*(dt/2.)/dy**2 130 | diag(ny)=1.d0+factym 131 | inf(ny)=-factym 132 | f(ny)=zint(i,ny)+factxp*zint(i+1,ny)-(factxp+factxm)*zint(i,ny)+factxm*zint(i-1,ny) 133 | endif 134 | call tridag (inf,diag,sup,f,res,ny) 135 | do j=1,ny 136 | zintp(i,j)=res(j) 137 | enddo 138 | enddo 139 | deallocate (f,diag,sup,inf,res) 140 | 141 | ! stores result in 1D array 142 | 143 | do j=1,ny 144 | do i=1,nx 145 | ij=(j-1)*nx+i 146 | etot(ij)=etot(ij)+h(ij)-zintp(i,j) 147 | erate(ij)=erate(ij)+(h(ij)-zintp(i,j))/dt 148 | h(ij)=zintp(i,j) 149 | enddo 150 | enddo 151 | 152 | b=min(h,b) 153 | 154 | deallocate (zint,kdint,zintp) 155 | 156 | return 157 | 158 | end subroutine Diffusion 159 | 160 | !---------- 161 | 162 | ! subroutine to solve a tri-diagonal system of equations (from Numerical Recipes) 163 | 164 | SUBROUTINE tridag(a,b,c,r,u,n) 165 | 166 | implicit none 167 | 168 | INTEGER n 169 | double precision a(n),b(n),c(n),r(n),u(n) 170 | INTEGER j 171 | double precision bet 172 | double precision,dimension(:),allocatable::gam 173 | 174 | allocate (gam(n)) 175 | 176 | if(b(1).eq.0.d0) stop 'in tridag' 177 | 178 | ! first pass 179 | 180 | bet=b(1) 181 | u(1)=r(1)/bet 182 | do 11 j=2,n 183 | gam(j)=c(j-1)/bet 184 | bet=b(j)-a(j)*gam(j) 185 | if(bet.eq.0.) then 186 | print*,'tridag failed' 187 | stop 188 | endif 189 | u(j)=(r(j)-a(j)*u(j-1))/bet 190 | 11 continue 191 | 192 | ! second pass 193 | 194 | do 12 j=n-1,1,-1 195 | u(j)=u(j)-gam(j+1)*u(j+1) 196 | 12 continue 197 | 198 | deallocate (gam) 199 | 200 | return 201 | 202 | END 203 | -------------------------------------------------------------------------------- /CMakeLists.txt: -------------------------------------------------------------------------------- 1 | cmake_minimum_required(VERSION 3.5) 2 | project(fastscapelib-fortran C Fortran) 3 | 4 | set(FASTSCAPELIB_NAME fastscapelib_fortran) 5 | 6 | # Sources 7 | # ======= 8 | 9 | set(FASTSCAPELIB_SRC_DIR src) 10 | 11 | set(FASTSCAPELIB_SRC_FILES 12 | ${FASTSCAPELIB_SRC_DIR}/Advect.f90 13 | ${FASTSCAPELIB_SRC_DIR}/Diffusion.f90 14 | ${FASTSCAPELIB_SRC_DIR}/FastScape_api.f90 15 | ${FASTSCAPELIB_SRC_DIR}/FastScape_ctx.f90 16 | ${FASTSCAPELIB_SRC_DIR}/LocalMinima.f90 17 | ${FASTSCAPELIB_SRC_DIR}/Marine.f90 18 | ${FASTSCAPELIB_SRC_DIR}/Strati.f90 19 | ${FASTSCAPELIB_SRC_DIR}/StreamPowerLaw.f90 20 | ${FASTSCAPELIB_SRC_DIR}/FlowRouting.f90 21 | ${FASTSCAPELIB_SRC_DIR}/Uplift.f90 22 | ${FASTSCAPELIB_SRC_DIR}/VTK.f90 23 | ${FASTSCAPELIB_SRC_DIR}/TerrainDerivatives.f90 24 | ) 25 | 26 | set(FLEXURE_SRC_DIR Flexure2D_v1.0/src) 27 | 28 | set(FLEXURE_SRC_FILES 29 | ${FLEXURE_SRC_DIR}/flexure2D.f90 30 | ${FLEXURE_SRC_DIR}/four1.f 31 | ${FLEXURE_SRC_DIR}/realft.f 32 | ${FLEXURE_SRC_DIR}/sinft.f 33 | ) 34 | 35 | # Pre-processor 36 | # ============= 37 | 38 | if(WIN32) 39 | add_compile_definitions(ON_WINDOWS) 40 | endif() 41 | 42 | set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -cpp") 43 | 44 | # Flags 45 | # ===== 46 | 47 | if(CMAKE_Fortran_COMPILER_ID MATCHES "Flang|GNU") 48 | set(dialect "-ffree-form -std=f2008 -fimplicit-none -fall-intrinsics") 49 | set(ioflags "-fconvert=big-endian") 50 | set(f77flags "-std=legacy -ffixed-form") 51 | set(bounds "-fbounds-check") 52 | set(warnings "-Wall") 53 | endif() 54 | if(CMAKE_Fortran_COMPILER_ID MATCHES "Intel") 55 | set(dialect "-stand f08 -free -implicitnone") 56 | set(ioflags "-convert big_endian") 57 | set(f77flags "-stand none -fixed") 58 | set(bounds "-check bounds") 59 | set(warnings "-warn all") 60 | endif() 61 | if(CMAKE_Fortran_COMPILER_ID MATCHES "PGI") 62 | set(dialect "-Mfreeform -Mdclchk -Mstandard -Mallocatable=03") 63 | set(ioflags "") 64 | set(f77flags "-Mfixed") 65 | set(bounds "-C") 66 | set(warnings "-Wall") 67 | endif() 68 | 69 | set(CMAKE_Fortran_FLAGS_DEBUG 70 | "${CMAKE_Fortran_FLAGS_DEBUG} ${bounds} ${warnings}") 71 | 72 | # let F2PY (scikit-build) configure flags for F77 and F90 source 73 | if(NOT SKBUILD) 74 | set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${dialect} ${ioflags}") 75 | else() 76 | if(APPLE AND MAKE_SYSTEM_PROCESSOR STREQUAL "arm64") 77 | # https://github.com/numpy/numpy/issues/25869 ? 78 | # (seems problematic only on MacOS Mx) 79 | set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} -Wno-error=incompatible-function-pointer-types") 80 | endif() 81 | endif() 82 | 83 | # override flags for old-school F77 files 84 | set_source_files_properties(${FLEXURE_SRC_DIR}/four1.f PROPERTIES COMPILE_FLAGS ${f77flags}) 85 | set_source_files_properties(${FLEXURE_SRC_DIR}/realft.f PROPERTIES COMPILE_FLAGS ${f77flags}) 86 | set_source_files_properties(${FLEXURE_SRC_DIR}/sinft.f PROPERTIES COMPILE_FLAGS ${f77flags}) 87 | 88 | # Build options 89 | # ============= 90 | 91 | OPTION(BUILD_FASTSCAPELIB_STATIC "build fastscapelib as a static library" ON) 92 | OPTION(BUILD_FASTSCAPELIB_SHARED "build fastscapelib as a shared library" OFF) 93 | OPTION(USE_FLEXURE "include flexure routines in the library" OFF) 94 | OPTION(BUILD_EXAMPLES "build usage examples that are in the 'examples' directory" OFF) 95 | 96 | if(BUILD_EXAMPLES) 97 | set(BUILD_FASTSCAPELIB_STATIC ON) 98 | set(USE_FLEXURE ON) 99 | endif() 100 | 101 | if(USE_FLEXURE) 102 | list(APPEND FASTSCAPELIB_SRC_FILES ${FLEXURE_SRC_FILES}) 103 | endif() 104 | 105 | # Fortran library (static/shared) 106 | # =============================== 107 | 108 | if(BUILD_FASTSCAPELIB_STATIC OR BUILD_FASTSCAPELIB_SHARED) 109 | set(FASTSCAPELIB_OBJECTS libfastscape_objects) 110 | add_library(${FASTSCAPELIB_OBJECTS} OBJECT ${FASTSCAPELIB_SRC_FILES}) 111 | endif() 112 | 113 | if(BUILD_FASTSCAPELIB_STATIC) 114 | set(FASTSCAPELIB_STATIC libfastscape_static) 115 | 116 | add_library(${FASTSCAPELIB_STATIC} STATIC $) 117 | 118 | set_target_properties(${FASTSCAPELIB_STATIC} 119 | PROPERTIES 120 | OUTPUT_NAME ${FASTSCAPELIB_NAME}) 121 | 122 | install(TARGETS ${FASTSCAPELIB_STATIC} DESTINATION lib) 123 | endif() 124 | 125 | if(BUILD_FASTSCAPELIB_SHARED) 126 | set(FASTSCAPELIB_SHARED libfastscape_shared) 127 | 128 | # shared libraries need PIC 129 | set_target_properties(${FASTSCAPELIB_OBJECTS} 130 | PROPERTIES 131 | POSITION_INDEPENDENT_CODE 1) 132 | 133 | add_library(${FASTSCAPELIB_SHARED} SHARED $) 134 | 135 | set_target_properties(${FASTSCAPELIB_SHARED} 136 | PROPERTIES 137 | OUTPUT_NAME ${FASTSCAPELIB_NAME}) 138 | 139 | install(TARGETS ${FASTSCAPELIB_SHARED} DESTINATION lib) 140 | endif() 141 | 142 | # Examples 143 | # ======== 144 | 145 | if(BUILD_EXAMPLES) 146 | add_subdirectory(examples) 147 | endif() 148 | 149 | # Python module 150 | # ============= 151 | 152 | if(SKBUILD) 153 | # TODO: remove when https://github.com/scikit-build/scikit-build/pull/495 is merged 154 | set(CMAKE_MODULE_PATH "${CMAKE_SOURCE_DIR}/cmake/" ${CMAKE_MODULE_PATH}) 155 | 156 | find_package(PythonLibs REQUIRED) 157 | find_package(PythonExtensions REQUIRED) 158 | find_package(NumPy REQUIRED) 159 | find_package(F2PY REQUIRED) 160 | 161 | set(F2PY_MODULE_NAME "_fastscapelib_fortran") 162 | 163 | add_python_library(${F2PY_MODULE_NAME} MODULE 164 | SOURCES ${FASTSCAPELIB_SRC_FILES} 165 | INCLUDE_DIRECTORIES ${FASTSCAPELIB_SRC_DIR} 166 | ) 167 | 168 | if (UNIX) 169 | if (APPLE) 170 | set_target_properties(${F2PY_MODULE_NAME} PROPERTIES 171 | LINK_FLAGS '-Wl,-dylib,-undefined,dynamic_lookup') 172 | else() 173 | set_target_properties(${F2PY_MODULE_NAME} PROPERTIES 174 | LINK_FLAGS '-Wl,--allow-shlib-undefined') 175 | endif() 176 | endif() 177 | 178 | python_extension_module(${F2PY_MODULE_NAME}) 179 | 180 | install( 181 | TARGETS ${F2PY_MODULE_NAME} 182 | LIBRARY DESTINATION "src_python/${FASTSCAPELIB_NAME}" 183 | ) 184 | endif() 185 | -------------------------------------------------------------------------------- /Flexure2D_v1.0/src/flexure2D.f90: -------------------------------------------------------------------------------- 1 | subroutine flexure (hh2,hp2,nx,ny,xl,yl,rhos2,rhoa,eet,ibc) 2 | 3 | ! Routine to compute the flexural response of erosion 4 | ! in input: 5 | ! hp(nx,ny), the topography (in isostatic equilibrium) before erosion, in m, 6 | ! h(nx,ny), the topography (out of isostatic equilibrium) after erosion, in m, 7 | ! rhos(nx,ny), surface rock density, in kg/m^3 8 | ! rhoa, asthenospheric density, in kg/m^3 9 | ! eet, effective elastic thickness, in m 10 | ! nx,ny, resolution of the input topography 11 | ! xl,yl, horizontal dimensions of the input topography, in m 12 | 13 | ! Here fixed values are assumed for: 14 | ! Young modulus, 1.d11 Pa 15 | ! Poisson ratio, 0.25 16 | ! g, 9.81 m/s^2 17 | 18 | ! the flexural, biharmonic equation is solved by FFT method (see Nunn and Aires, 1988) 19 | ! on a 1024x1024 mesh 20 | 21 | implicit none 22 | 23 | integer, intent(in) :: nx,ny,ibc 24 | double precision, intent(inout), dimension(*) :: hh2 25 | double precision, intent(in), dimension(*) :: hp2,rhos2 26 | double precision, intent(in) :: xl,yl,rhoa,eet 27 | 28 | integer nxflex,nyflex,i,j,ii,jj,ij 29 | double precision, dimension(:,:), allocatable :: w,h,hp,rhos 30 | double precision hx,hy,dflex,d,xk,pihx,pihy,g,fi,fj,tij,dx,dy,r,s,h1,h2,h3,h4 31 | double precision ddxf,ddyf,xloc,yloc,dw,xflexloc,yflexloc 32 | integer iflexmin,iflexmax,jflexmin,jflexmax 33 | character cbc*4 34 | 35 | double precision, dimension(:,:,:), allocatable :: hw 36 | integer, dimension(:,:), allocatable :: iiw,jjw 37 | 38 | allocate (h(nx,ny),hp(nx,ny),rhos(nx,ny)) 39 | 40 | do j=1,ny 41 | do i=1,nx 42 | ij=(j-1)*nx+i 43 | h(i,j)=hh2(ij) 44 | hp(i,j)=hp2(ij) 45 | rhos(i,j)=rhos2(ij) 46 | enddo 47 | enddo 48 | 49 | write (cbc,'(i4)') ibc 50 | if (cbc(1:1).eq.'') cbc(1:1)='0' 51 | if (cbc(2:2).eq.'') cbc(2:2)='0' 52 | if (cbc(3:3).eq.'') cbc(3:3)='0' 53 | if (cbc(4:4).eq.'') cbc(4:4)='0' 54 | 55 | ! allocate memory 56 | 57 | nxflex=1 58 | do while (nxflex.lt.nx) 59 | nxflex=nxflex*2 60 | enddo 61 | 62 | nyflex=1 63 | do while (nyflex.lt.ny) 64 | nyflex=nyflex*2 65 | enddo 66 | 67 | allocate (hw(4,nx,ny), iiw(nx,ny), jjw(nx,ny)) 68 | allocate (w(nxflex,nyflex)) 69 | 70 | ! compute relevant geometrical, flexural and spectral parameters 71 | 72 | iflexmin=nxflex/2-nxflex/8 73 | iflexmax=nxflex/2+nxflex/8 74 | jflexmin=nyflex/2-nyflex/8 75 | jflexmax=nyflex/2+nyflex/8 76 | 77 | dx=xl/(nx-1) 78 | dy=yl/(ny-1) 79 | ddxf=xl/(iflexmax-iflexmin) 80 | ddyf=yl/(jflexmax-jflexmin) 81 | hx=ddxf*(nxflex-1) 82 | hy=ddyf*(nyflex-1) 83 | dflex=1.d11/12.d0/(1.d0-0.25d0**2) 84 | d=dflex*eet**3 85 | g=9.81d0 86 | xk=rhoa*g 87 | pihx=3.141592654d0/hx 88 | pihy=3.141592654d0/hx 89 | 90 | ! compute weigths corresponding to the increase in topography by interpolation 91 | ! from the nx,ny grid to the nflex, nflex grid, using a bilinear interpolation scheme 92 | 93 | w=0.d0 94 | jj=jflexmin 95 | yflexloc=0.d0 96 | do j=1,ny 97 | yloc=(j-1)*dy 98 | if (yloc.gt.yflexloc+ddyf) jj=jj+1 99 | yflexloc=(jj-jflexmin)*ddyf 100 | ii=iflexmin 101 | xflexloc=0.d0 102 | do i=1,nx 103 | xloc=(i-1)*dx 104 | if (xloc.gt.xflexloc+ddxf) ii=ii+1 105 | xflexloc=(ii-iflexmin)*ddxf 106 | r=(xloc-xflexloc)/ddxf*2.d0-1.d0 107 | s=(yloc-yflexloc)/ddyf*2.d0-1.d0 108 | h1=(1.d0-r)*(1.d0-s)/4.d0 109 | h2=(1.d0+r)*(1.d0-s)/4.d0 110 | h3=(1.d0-r)*(1.d0+s)/4.d0 111 | h4=(1.d0+r)*(1.d0+s)/4.d0 112 | iiw(i,j)=ii 113 | jjw(i,j)=jj 114 | hw(1,i,j)=h1 115 | hw(2,i,j)=h2 116 | hw(3,i,j)=h3 117 | hw(4,i,j)=h4 118 | dw=(hp(i,j)-h(i,j))*rhos(i,j)*dx*dy*g 119 | w(ii,jj) = w(ii,jj) + dw*h1 120 | w(ii+1,jj) = w(ii+1,jj) + dw*h2 121 | w(ii,jj+1) = w(ii,jj+1) + dw*h3 122 | w(ii+1,jj+1) = w(ii+1,jj+1) + dw*h4 123 | enddo 124 | enddo 125 | 126 | call addw (w,nxflex,nyflex,iflexmin,iflexmax,jflexmin,jflexmax,cbc) 127 | 128 | ! compute FFT of weights 129 | 130 | do j=1,nyflex 131 | call sinft (w(:,j),nxflex) 132 | enddo 133 | 134 | w=transpose(w) 135 | 136 | do i=1,nxflex 137 | call sinft (w(:,i),nyflex) 138 | enddo 139 | 140 | ! apply filter to FFT of weights to simulated flexure (see Nunn and Aires, 1988) 141 | 142 | w=w*4./hx/hy 143 | 144 | do j=1,nyflex 145 | fj=(j*pihx)**2 146 | do i=1,nxflex 147 | fi=(i*pihx)**2 148 | tij=d/xk*(fi**2+2.d0*fi*fj+fj**2)+1.d0 149 | w(j,i)=w(j,i)/xk/tij 150 | enddo 151 | enddo 152 | 153 | ! compute inverse FFT of filtered weights to obtain deflection 154 | 155 | do i=1,nxflex 156 | call sinft (w(:,i),nyflex) 157 | enddo 158 | 159 | w=transpose(w) 160 | 161 | do j=1,nyflex 162 | call sinft (w(:,j),nxflex) 163 | enddo 164 | 165 | ! add deflection by interpolation from the nflex,nflex grid to the nx,ny grid 166 | ! by bilinear interpolation 167 | 168 | do j=1,ny 169 | do i=1,nx 170 | ii=iiw(i,j) 171 | jj=jjw(i,j) 172 | h1=hw(1,i,j) 173 | h2=hw(2,i,j) 174 | h3=hw(3,i,j) 175 | h4=hw(4,i,j) 176 | h(i,j)=h(i,j)+w(ii,jj)*h1+w(ii+1,jj)*h2+w(ii,jj+1)*h3+w(ii+1,jj+1)*h4 177 | enddo 178 | enddo 179 | 180 | ! deallocate memory 181 | 182 | do j=1,ny 183 | do i=1,nx 184 | ij=(j-1)*nx+i 185 | hh2(ij)=h(i,j) 186 | enddo 187 | enddo 188 | 189 | deallocate (w,h,hp,rhos,iiw,jjw,hw) 190 | 191 | end subroutine flexure 192 | 193 | !----------- 194 | 195 | subroutine addw (w,nxflex,nyflex,iflexmin,iflexmax,jflexmin,jflexmax,cbc) 196 | 197 | implicit none 198 | 199 | integer :: nxflex,nyflex,i,j,iflexmin,iflexmax,jflexmin,jflexmax 200 | double precision w(nxflex,nyflex) 201 | character cbc*4 202 | 203 | if (cbc(1:1).eq.'0') w(:,jflexmin)=w(:,jflexmin+1) 204 | if (cbc(2:2).eq.'0') w(iflexmax,:)=w(iflexmax-1,:) 205 | if (cbc(3:3).eq.'0') w(:,jflexmax)=w(:,jflexmax-1) 206 | if (cbc(4:4).eq.'0') w(iflexmin,:)=w(iflexmin+1,:) 207 | 208 | do j=jflexmin,jflexmax 209 | do i=iflexmin,iflexmax 210 | if (cbc(1:1).eq.'0') w(i,jflexmin-(j-jflexmin+1))=w(i,jflexmin-(j-jflexmin+1))+w(i,j) 211 | if (cbc(3:3).eq.'0') w(i,jflexmax+(jflexmax-j+1))=w(i,jflexmax+(jflexmax-j+1))+w(i,j) 212 | if (cbc(4:4).eq.'0') w(iflexmin-(i-iflexmin+1),j)=w(iflexmin-(i-iflexmin+1),j)+w(i,j) 213 | if (cbc(2:2).eq.'0') w(iflexmax+(iflexmax-i+1),j)=w(iflexmax+(iflexmax-i+1),j)+w(i,j) 214 | if (cbc(1:1).eq.'0'.and.cbc(2:2).eq.'0') w(iflexmax+(iflexmax-i+1),jflexmin-(j-jflexmin+1))= & 215 | w(iflexmax+(iflexmax-i+1),jflexmin-(j-jflexmin+1))+w(i,j) 216 | if (cbc(2:2).eq.'0'.and.cbc(3:3).eq.'0') w(iflexmax+(iflexmax-i+1),jflexmax+(jflexmax-j+1))= & 217 | w(iflexmax+(iflexmax-i+1),jflexmax+(jflexmax-j+1))+w(i,j) 218 | if (cbc(3:3).eq.'0'.and.cbc(4:4).eq.'0') w(iflexmin-(i-iflexmin+1),jflexmax+(jflexmax-j+1))= & 219 | w(iflexmin-(i-iflexmin+1),jflexmax+(jflexmax-j+1))+w(i,j) 220 | if (cbc(4:4).eq.'0'.and.cbc(1:1).eq.'0') w(iflexmin-(i-iflexmin+1),jflexmin-(j-jflexmin+1))= & 221 | w(iflexmin-(i-iflexmin+1),jflexmin-(j-jflexmin+1))+w(i,j) 222 | enddo 223 | enddo 224 | 225 | return 226 | 227 | end subroutine addw 228 | -------------------------------------------------------------------------------- /src/VTK.f90: -------------------------------------------------------------------------------- 1 | subroutine VTK (h,name,nf,f,fname,nx,ny,dx,dy,istep,vex) 2 | 3 | ! subroutine to create a simple VTK file for plotting 4 | 5 | implicit none 6 | 7 | integer nx,ny,nf,istep,nheader,nfooter,npart1,npart2,nn,namel 8 | double precision h(nx,ny),f(nx,ny,nf),dx,dy,vex 9 | character header*1024,footer*1024,part1*1024,part2*1024,nxc*6,nyc*6,nnc*12 10 | character*(*) name,fname(nf) 11 | 12 | integer i,j,k 13 | character cstep*7 14 | 15 | namel = sum(len_trim(fname(:))) 16 | 17 | write (cstep,'(i7)') istep 18 | if (istep.lt.10) cstep(1:6)='000000' 19 | if (istep.lt.100) cstep(1:5)='00000' 20 | if (istep.lt.1000) cstep(1:4)='0000' 21 | if (istep.lt.10000) cstep(1:3)='000' 22 | if (istep.lt.100000) cstep(1:2)='00' 23 | if (istep.lt.1000000) cstep(1:1)='0' 24 | 25 | !if (nf.gt.10) stop 'too many fields to be displayed by VTK, maximum is 10' 26 | ! do i=1,nf 27 | ! write (CI(i),'(i1)') i 28 | ! enddo 29 | 30 | #ifdef ON_WINDOWS 31 | call system ('if not exist "VTK" mkdir VTK') 32 | #else 33 | call system ("mkdir -p VTK") 34 | #endif 35 | 36 | nn=nx*ny 37 | write (nxc,'(i6)') nx 38 | write (nyc,'(i6)') ny 39 | write (nnc,'(i12)') nn 40 | header(1:1024)='' 41 | header='# vtk DataFile Version 3.0'//char(10)//'FastScape'//char(10) & 42 | //'BINARY'//char(10)//'DATASET STRUCTURED_GRID'//char(10) & 43 | //'DIMENSIONS '//nxc//' '//nyc//' 1'//char(10)//'POINTS' & 44 | //nnc//' float'//char(10) 45 | nheader=len_trim(header) 46 | footer(1:1024)='' 47 | footer='POINT_DATA'//nnc//char(10) 48 | nfooter=len_trim(footer) 49 | part1(1:1024)='' 50 | part1='SCALARS ' 51 | npart1=len_trim(part1)+1 52 | part2(1:1024)='' 53 | part2=' float 1'//char(10)//'LOOKUP_TABLE default'//char(10) 54 | npart2=len_trim(part2) 55 | 56 | #ifdef ON_WINDOWS 57 | call system ('del VTK/'//trim(name)//cstep//'.vtk') 58 | #else 59 | call system ('rm -f VTK/'//trim(name)//cstep//'.vtk') 60 | #endif 61 | 62 | open(unit=77,file='VTK/'//trim(name)//cstep//'.vtk',status='unknown',form='unformatted',access='direct', & 63 | recl=nheader+3*4*nn+nfooter+(npart1+1+npart2+4*nn) & 64 | +nf*(npart1+npart2+4*nn)+namel) 65 | write (77,rec=1) & 66 | header(1:nheader), & 67 | ((sngl(dx*(i-1)),sngl(dy*(j-1)),sngl(h(i,j)*vex),i=1,nx),j=1,ny), & 68 | footer(1:nfooter), & 69 | part1(1:npart1)//'H'//part2(1:npart2),sngl(h), & 70 | (part1(1:npart1)//trim(fname(k))//part2(1:npart2),sngl(f(:,:,k)),k=1,nf) 71 | close(77) 72 | 73 | return 74 | end subroutine VTK 75 | 76 | !------------------------------------------------ 77 | 78 | subroutine VTK_CUBE (fields, nx, ny, nf, nreflector, xl, yl, fname) 79 | 80 | implicit none 81 | 82 | integer :: nx, ny, nf, nreflector 83 | double precision, dimension(nx,ny,nf,nreflector) :: fields 84 | double precision :: xl, yl 85 | integer nheader,nfooter,npart1,npart2,nn,namel 86 | character header*1024,footer*1024,part1*1024,part2*1024,nxc*6,nyc*6,nnc*12,nrefc*3 87 | character*(*) fname(nf) 88 | double precision :: dx, dy, dz 89 | integer :: i, j, k 90 | 91 | dx = xl/(nx - 1) 92 | dy = yl/(ny - 1) 93 | dz = (dx+dy)/2.d0 94 | 95 | namel = sum(len_trim(fname(:))) 96 | 97 | nn=nx*ny*(nreflector + 1) 98 | write (nxc,'(i6)') nx 99 | write (nyc,'(i6)') ny 100 | write (nrefc,'(i3)') nreflector 101 | write (nnc,'(i12)') nn 102 | 103 | header(1:1024)='' 104 | header='# vtk DataFile Version 3.0'//char(10)//'FastScape'//char(10) & 105 | //'BINARY'//char(10)//'DATASET STRUCTURED_GRID'//char(10) & 106 | //'DIMENSIONS '//nxc//' '//nyc//' '//nrefc//char(10)//'POINTS' & 107 | //nnc//' float'//char(10) 108 | nheader=len_trim(header) 109 | footer(1:1024)='' 110 | footer='POINT_DATA'//nnc//char(10) 111 | nfooter=len_trim(footer) 112 | part1(1:1024)='' 113 | part1='SCALARS ' 114 | npart1=len_trim(part1)+1 115 | part2(1:1024)='' 116 | part2=' float 1'//char(10)//'LOOKUP_TABLE default'//char(10) 117 | npart2=len_trim(part2) 118 | 119 | open(unit=77,file='VTK/CUBE.vtk',status='unknown',form='unformatted',access='direct', & 120 | recl=nheader+3*4*nn+nfooter+nf*(npart1+npart2+4*nn)+namel) 121 | write (77,rec=1) & 122 | header(1:nheader), & 123 | (((sngl(dx*(i-1)),sngl(dy*(j-1)),sngl(dz*(k-1)),i=1,nx),j=1,ny),k=1,nreflector), & 124 | footer(1:nfooter), & 125 | (part1(1:npart1)//trim(fname(k))//part2(1:npart2),sngl(fields(:,:,k,:)),k=1,nf) 126 | close(77) 127 | 128 | end subroutine VTK_CUBE 129 | 130 | !------------------------------------------------ 131 | 132 | subroutine VTK_filled (basement, nreflector, reflector, nfield, fields, names, nx, ny, dx, dy, istep, vex, distb) 133 | 134 | ! This routine produces a 3D volume containing all the information produced by Strati in vtk format 135 | ! The resulting file(s) called Strati-number (where number is the step number) can be loaded in 136 | ! Paraview for viewing and data extraction (along synthetic wells) 137 | ! Note however that the data is only stored at the location of the reflectors and that the information 138 | ! in between reflectors is the result of interpolation made in Paraview 139 | ! The larger the number of reflectors, the less the interpolation 140 | 141 | ! Note that contrary to all other VTK producing routines, this one outputs the geometric information 142 | ! in ASCII format (not binary); this means that the files it generates are larger and take more time 143 | ! to load into Paraview 144 | 145 | integer :: nx, ny, nreflector, nfield, istep, i, j, k, l, ij 146 | double precision basement(nx*ny), reflector(nx*ny,nreflector), dx, dy, vex, distb(nx*ny) 147 | double precision fields(nx*ny,nfield,nreflector) 148 | character names(nfield)*30 149 | 150 | character cstep*7, name*128 151 | integer iunit, nnode, nelem 152 | 153 | write (cstep,'(i7)') istep 154 | if (istep.lt.10) cstep(1:6)='000000' 155 | if (istep.lt.100) cstep(1:5)='00000' 156 | if (istep.lt.1000) cstep(1:4)='0000' 157 | if (istep.lt.10000) cstep(1:3)='000' 158 | if (istep.lt.100000) cstep(1:2)='00' 159 | if (istep.lt.1000000) cstep(1:1)='0' 160 | 161 | iunit=30 162 | 163 | #ifdef ON_WINDOWS 164 | call system ('if not exist "VTK" mkdir VTK') 165 | #else 166 | call system ("mkdir -p VTK") 167 | #endif 168 | 169 | name='Strati-' 170 | 171 | #ifdef ON_WINDOWS 172 | call system ('del VTK/'//trim(name)//cstep//'.vtk') 173 | #else 174 | call system ('rm -f VTK/'//trim(name)//cstep//'.vtk') 175 | #endif 176 | 177 | nnode = nx*ny*(nreflector+1) 178 | nelem = (nx-1)*(ny-1)*nreflector 179 | 180 | open(unit=iunit,file='VTK/'//trim(name)//cstep//'.vtk') 181 | write(iunit,'(a)')'# vtk DataFile Version 3.0' 182 | write(iunit,'(a)')'FilledStratigraphy' 183 | write(iunit,'(a)')'ASCII' 184 | write(iunit,'(a)')'DATASET UNSTRUCTURED_GRID' 185 | write(iunit,'(a7,i10,a6)')'POINTS ',nnode,' float' 186 | 187 | do k = 0, nreflector 188 | do j = 1, ny 189 | do i = 1, nx 190 | ij = (j - 1)*nx + i 191 | if (k.eq.0) then 192 | write(iunit,'(3f16.4)') dx*(i - 1), dy*(j - 1), basement(ij)*vex 193 | else 194 | write(iunit,'(3f16.4)') dx*(i - 1), dy*(j - 1), reflector(ij, k)*vex 195 | endif 196 | enddo 197 | enddo 198 | enddo 199 | 200 | write(iunit,'(A6, 2I10)') 'CELLS ',nelem,9*nelem 201 | do k=1,nreflector 202 | do j=1,ny-1 203 | do i=1,nx-1 204 | ij = (k-1)*nx*ny+(j-1)*nx+i-1 205 | write(iunit,'(9I10)') 8 , ij, ij+1, ij+1+nx, ij+nx, & 206 | ij+nx*ny, ij+1+nx*ny, ij+1+nx+nx*ny, ij+nx+nx*ny 207 | enddo 208 | enddo 209 | enddo 210 | 211 | write(iunit,'(A11, I10)') 'CELL_TYPES ',nelem 212 | do k=1,nelem 213 | write(iunit,'(I2)') 12 ! octree (8 nodes) 214 | enddo 215 | 216 | write(iunit,'(a11,i10)')'POINT_DATA ',nnode 217 | 218 | write(iunit,'(a)')'SCALARS 0.Reflector float 1' 219 | write(iunit,'(a)')'LOOKUP_TABLE default' 220 | do k = 0, nreflector 221 | do j = 1, ny 222 | do i = 1, nx 223 | ij = (j - 1)*nx + i 224 | write(iunit,'(e10.4)') float(k) 225 | enddo 226 | enddo 227 | enddo 228 | 229 | do l = 1, nfield 230 | write(iunit,'(a)')'SCALARS '//names(l)//' float 1' 231 | write(iunit,'(a)')'LOOKUP_TABLE default' 232 | do k = 0, nreflector 233 | do j = 1, ny 234 | do i = 1, nx 235 | ij = (j - 1)*nx + i 236 | if (k.eq.0) then 237 | if (l.eq.1.or.l.eq.2) then 238 | write(iunit,'(e10.4)') fields(ij,l,k+1) 239 | elseif (l.eq.7) then 240 | write(iunit,'(e10.4)') distb(ij) 241 | elseif (l.eq.9) then 242 | write(iunit,'(e10.4)') 2*fields(ij,l,k+1)-fields(ij,l,k+2) 243 | else 244 | write(iunit,'(e10.4)') 0. 245 | endif 246 | else 247 | write(iunit,'(e10.4)') fields(ij,l,k) 248 | endif 249 | enddo 250 | enddo 251 | enddo 252 | enddo 253 | 254 | close (iunit) 255 | 256 | end subroutine VTK_filled 257 | -------------------------------------------------------------------------------- /cmake/UsePythonExtensions.cmake: -------------------------------------------------------------------------------- 1 | #.rst: 2 | # 3 | # The following functions are defined: 4 | # 5 | # .. cmake:command:: add_python_library 6 | # 7 | # Add a library that contains a mix of C, C++, Fortran, Cython, F2PY, Template, 8 | # and Tempita sources. The required targets are automatically generated to 9 | # "lower" source files from their high-level representation to a file that the 10 | # compiler can accept. 11 | # 12 | # 13 | # add_python_library( 14 | # SOURCES [source1 [source2 ...]] 15 | # [INCLUDE_DIRECTORIES [dir1 [dir2 ...]] 16 | # [LINK_LIBRARIES [lib1 [lib2 ...]] 17 | # [DEPENDS [source1 [source2 ...]]]) 18 | # 19 | # 20 | # Example usage 21 | # ^^^^^^^^^^^^^ 22 | # 23 | # .. code-block:: cmake 24 | # 25 | # find_package(PythonExtensions) 26 | # 27 | # file(GLOB arpack_sources ARPACK/SRC/*.f ARPACK/UTIL/*.f) 28 | # 29 | # add_python_library(arpack_scipy 30 | # SOURCES ${arpack_sources} 31 | # ${g77_wrapper_sources} 32 | # INCLUDE_DIRECTORIES ARPACK/SRC 33 | # ) 34 | # 35 | # .. cmake:command:: add_python_extension 36 | # 37 | # Add a extension that contains a mix of C, C++, Fortran, Cython, F2PY, Template, 38 | # and Tempita sources. The required targets are automatically generated to 39 | # "lower" source files from their high-level representation to a file that the 40 | # compiler can accept. 41 | # 42 | # 43 | # add_python_extension( 44 | # SOURCES [source1 [source2 ...]] 45 | # [INCLUDE_DIRECTORIES [dir1 [dir2 ...]] 46 | # [LINK_LIBRARIES [lib1 [lib2 ...]] 47 | # [DEPENDS [source1 [source2 ...]]]) 48 | # 49 | # 50 | # Example usage 51 | # ^^^^^^^^^^^^^ 52 | # 53 | # .. code-block:: cmake 54 | # 55 | # find_package(PythonExtensions) 56 | # 57 | # file(GLOB arpack_sources ARPACK/SRC/*.f ARPACK/UTIL/*.f) 58 | # 59 | # add_python_extension(arpack_scipy 60 | # SOURCES ${arpack_sources} 61 | # ${g77_wrapper_sources} 62 | # INCLUDE_DIRECTORIES ARPACK/SRC 63 | # ) 64 | # 65 | # 66 | #============================================================================= 67 | # Copyright 2011 Kitware, Inc. 68 | # 69 | # Licensed under the Apache License, Version 2.0 (the "License"); 70 | # you may not use this file except in compliance with the License. 71 | # You may obtain a copy of the License at 72 | # 73 | # http://www.apache.org/licenses/LICENSE-2.0 74 | # 75 | # Unless required by applicable law or agreed to in writing, software 76 | # distributed under the License is distributed on an "AS IS" BASIS, 77 | # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 78 | # See the License for the specific language governing permissions and 79 | # limitations under the License. 80 | #============================================================================= 81 | 82 | macro(_remove_whitespace _output) 83 | string(REGEX REPLACE "[ \r\n\t]+" " " ${_output} "${${_output}}") 84 | string(STRIP "${${_output}}" ${_output}) 85 | endmacro() 86 | 87 | function(add_python_library _name) 88 | set(options STATIC SHARED MODULE) 89 | set(multiValueArgs SOURCES INCLUDE_DIRECTORIES LINK_LIBRARIES COMPILE_DEFINITIONS DEPENDS) 90 | cmake_parse_arguments(_args "${options}" "" "${multiValueArgs}" ${ARGN} ) 91 | 92 | # Validate arguments to allow simpler debugging 93 | if(NOT _args_SOURCES) 94 | message( 95 | FATAL_ERROR 96 | "You have called add_python_library for library ${_name} without " 97 | "any source files. This typically indicates a problem with " 98 | "your CMakeLists.txt file" 99 | ) 100 | endif() 101 | 102 | # Initialize the list of sources 103 | set(_sources ${_args_SOURCES}) 104 | 105 | # Generate targets for all *.src files 106 | set(_processed ) 107 | foreach(_source IN LISTS _sources) 108 | if(${_source} MATCHES ".pyf.src$" OR ${_source} MATCHES "\\.f\\.src$") 109 | if(NOT NumPy_FOUND) 110 | message( 111 | FATAL_ERROR 112 | "NumPy is required to process *.src Template files" 113 | ) 114 | endif() 115 | string(REGEX REPLACE "\\.[^.]*$" "" _source_we ${_source}) 116 | add_custom_command( 117 | OUTPUT ${_source_we} 118 | COMMAND ${NumPy_FROM_TEMPLATE_EXECUTABLE} 119 | ${CMAKE_CURRENT_SOURCE_DIR}/${_source} 120 | ${CMAKE_CURRENT_BINARY_DIR}/${_source_we} 121 | DEPENDS ${_source} ${_args_DEPENDS} 122 | COMMENT "Generating ${_source_we} from template ${_source}" 123 | ) 124 | list(APPEND _processed ${_source_we}) 125 | elseif(${_source} MATCHES "\\.c\\.src$") 126 | if(NOT NumPy_FOUND) 127 | message( 128 | FATAL_ERROR 129 | "NumPy is required to process *.src Template files" 130 | ) 131 | endif() 132 | string(REGEX REPLACE "\\.[^.]*$" "" _source_we ${_source}) 133 | add_custom_command( 134 | OUTPUT ${_source_we} 135 | COMMAND ${NumPy_CONV_TEMPLATE_EXECUTABLE} 136 | ${CMAKE_CURRENT_SOURCE_DIR}/${_source} 137 | ${CMAKE_CURRENT_BINARY_DIR}/${_source_we} 138 | DEPENDS ${_source} ${_args_DEPENDS} 139 | COMMENT "Generating ${_source_we} from template ${_source}" 140 | ) 141 | list(APPEND _processed ${_source_we}) 142 | elseif(${_source} MATCHES "\\.pyx\\.in$") 143 | if(NOT Cython_FOUND) 144 | message( 145 | FATAL_ERROR 146 | "Cython is required to process *.in Tempita files" 147 | ) 148 | endif() 149 | string(REGEX REPLACE "\\.[^.]*$" "" _source_we ${_source}) 150 | configure_file( 151 | ${CMAKE_CURRENT_SOURCE_DIR}/${_source} 152 | ${CMAKE_CURRENT_BINARY_DIR}/${_source} 153 | COPYONLY 154 | ) 155 | set(_tempita_command 156 | " 157 | import os; 158 | import sys; 159 | from Cython.Tempita import Template; 160 | cwd = os.getcwd(); 161 | open(os.path.join(cwd, '${_source_we}'), 'w+') 162 | .write( 163 | Template.from_filename(os.path.join(cwd, '${_source}'), 164 | encoding=sys.getdefaultencoding()).substitute() 165 | ) 166 | " 167 | ) 168 | _remove_whitespace(_tempita_command) 169 | add_custom_command( 170 | OUTPUT ${_source_we} 171 | COMMAND ${PYTHON_EXECUTABLE} -c "${_tempita_command}" 172 | DEPENDS "${CMAKE_CURRENT_BINARY_DIR}/${_source}" 173 | ${_args_DEPENDS} 174 | ) 175 | list(APPEND _processed ${_source_we}) 176 | else() 177 | list(APPEND _processed ${_source}) 178 | endif() 179 | endforeach() 180 | set(_sources ${_processed}) 181 | 182 | # If we're building a Python extension and we're given only Fortran sources, 183 | # We can conclude that we need to generate a Fortran interface file 184 | list(FILTER _processed EXCLUDE REGEX "(\\.f|\\.f90)$") 185 | if(NOT _processed AND _args_MODULE) 186 | if(NOT NumPy_FOUND) 187 | message( 188 | FATAL_ERROR 189 | "NumPy is required to process *.pyf F2PY files" 190 | ) 191 | endif() 192 | set(_sources_abs ) 193 | foreach(_source IN LISTS _sources) 194 | if(NOT IS_ABSOLUTE ${_source}) 195 | set(_source ${CMAKE_CURRENT_SOURCE_DIR}/${_source}) 196 | endif() 197 | list(APPEND _sources_abs ${_source}) 198 | endforeach() 199 | add_custom_command( 200 | OUTPUT ${CMAKE_CURRENT_BINARY_DIR}/${_name}.pyf 201 | WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR} 202 | COMMAND ${F2PY_EXECUTABLE} 203 | ARGS -h ${_name}.pyf -m ${_name} --overwrite-signature 204 | ${_sources_abs} 205 | DEPENDS ${_sources} ${_args_DEPENDS} 206 | COMMENT "Generating ${_name} Fortran interface file" 207 | ) 208 | list(APPEND _sources ${_name}.pyf) 209 | endif() 210 | 211 | # Are there F2PY targets? 212 | set(_has_f2py_targets OFF) 213 | set(_has_cython_targets OFF) 214 | 215 | # Generate targets for all *.pyx and *.pyf files 216 | set(_processed ) 217 | foreach(_source IN LISTS _sources) 218 | if(${_source} MATCHES \\.pyx$) 219 | if(NOT Cython_FOUND) 220 | message( 221 | FATAL_ERROR 222 | "Cython is required to process *.pyx Cython files" 223 | ) 224 | endif() 225 | string(REGEX REPLACE "\\.[^.]*$" "" _pyx_target_name ${_source}) 226 | set(_has_cython_targets ON) 227 | add_cython_target(${_pyx_target_name} 228 | ${_source} 229 | OUTPUT_VAR _pyx_target_output 230 | DEPENDS ${_args_DEPENDS} 231 | ) 232 | list(APPEND _processed ${_pyx_target_output}) 233 | elseif(${_source} MATCHES \\.pyf$) 234 | if(NOT NumPy_FOUND) 235 | message( 236 | FATAL_ERROR 237 | "NumPy is required to process *.pyf F2PY files" 238 | ) 239 | endif() 240 | string(REGEX REPLACE "\\.[^.]*$" "" _pyf_target_name ${_source}) 241 | set(_has_f2py_targets ON) 242 | add_f2py_target(${_pyf_target_name} 243 | ${_source} 244 | OUTPUT_VAR _pyf_target_output 245 | DEPENDS ${_args_DEPENDS} 246 | ) 247 | list(APPEND _processed ${_pyf_target_output}) 248 | else() 249 | list(APPEND _processed ${_source}) 250 | endif() 251 | endforeach() 252 | set(_sources ${_processed}) 253 | 254 | if(_args_SHARED) 255 | add_library(${_name} SHARED ${_sources}) 256 | elseif(_args_MODULE) 257 | add_library(${_name} MODULE ${_sources}) 258 | else() 259 | # Assume static 260 | add_library(${_name} STATIC ${_sources}) 261 | endif() 262 | 263 | target_include_directories(${_name} PRIVATE ${_args_INCLUDE_DIRECTORIES}) 264 | target_link_libraries(${_name} ${_args_LINK_LIBRARIES}) 265 | 266 | if(_has_f2py_targets) 267 | target_include_directories(${_name} PRIVATE ${F2PY_INCLUDE_DIRS}) 268 | target_link_libraries(${_name} ${F2PY_LIBRARIES}) 269 | endif() 270 | 271 | if(_args_COMPILE_DEFINITIONS) 272 | target_compile_definitions(${_name} PRIVATE ${_args_COMPILE_DEFINITIONS}) 273 | endif() 274 | 275 | if(_args_DEPENDS) 276 | add_custom_target( 277 | "${_name}_depends" 278 | DEPENDS ${_args_DEPENDS} 279 | ) 280 | add_dependencies(${_name} "${_name}_depends") 281 | endif() 282 | endfunction() 283 | 284 | function(add_python_extension _name) 285 | # FIXME: make sure that extensions with the same name can happen 286 | # in multiple directories 287 | 288 | set(multiValueArgs SOURCES INCLUDE_DIRECTORIES LINK_LIBRARIES COMPILE_DEFINITIONS DEPENDS) 289 | cmake_parse_arguments(_args "" "" "${multiValueArgs}" ${ARGN} ) 290 | 291 | # Validate arguments to allow simpler debugging 292 | if(NOT _args_SOURCES) 293 | message( 294 | FATAL_ERROR 295 | "You have called add_python_extension for library ${_name} without " 296 | "any source files. This typically indicates a problem with " 297 | "your CMakeLists.txt file" 298 | ) 299 | endif() 300 | 301 | add_python_library(${_name} MODULE 302 | SOURCES ${_args_SOURCES} 303 | INCLUDE_DIRECTORIES ${_args_INCLUDE_DIRECTORIES} 304 | LINK_LIBRARIES ${_args_LINK_LIBRARIES} 305 | COMPILE_DEFINITIONS ${_args_COMPILE_DEFINITIONS} 306 | DEPENDS ${_args_DEPENDS} 307 | ) 308 | python_extension_module(${_name}) 309 | 310 | file(RELATIVE_PATH _relative "${CMAKE_SOURCE_DIR}" "${CMAKE_CURRENT_SOURCE_DIR}") 311 | if(_relative STREQUAL "") 312 | set(_relative ".") 313 | endif() 314 | 315 | install( 316 | TARGETS ${_name} 317 | LIBRARY DESTINATION "${_relative}" 318 | RUNTIME DESTINATION "${_relative}" 319 | ) 320 | endfunction() 321 | -------------------------------------------------------------------------------- /src/FlowRouting.f90: -------------------------------------------------------------------------------- 1 | !-------------------------------------------------------------------------------------------- 2 | 3 | subroutine FlowRouting () 4 | 5 | use FastScapeContext 6 | 7 | implicit none 8 | 9 | double precision :: dx, dy 10 | 11 | dx = xl/(nx - 1) 12 | dy = yl/(ny - 1) 13 | 14 | ! finds receiver 15 | 16 | call find_receiver (h, nx, ny, dx, dy, rec, length, & 17 | bounds_i1, bounds_i2, bounds_j1, bounds_j2, bounds_xcyclic, bounds_ycyclic) 18 | 19 | ! finds donors 20 | 21 | call find_donor (rec, nn, ndon, don) 22 | 23 | ! find stack 24 | 25 | call find_stack (rec, don, ndon, nn, catch0, stack, catch) 26 | 27 | ! removes local minima 28 | call LocalMinima (stack,rec,bounds_bc,ndon,don,h,length,nx,ny,dx,dy) 29 | 30 | ! computes receiver and stack information for mult-direction flow 31 | call find_mult_rec (h,rec,stack,hwater,mrec,mnrec,mwrec,mlrec,mstack,nx,ny,dx,dy,p,p_mfd_exp, & 32 | bounds_i1, bounds_i2, bounds_j1, bounds_j2, bounds_xcyclic, bounds_ycyclic) 33 | 34 | ! compute lake depth 35 | lake_depth = hwater - h 36 | 37 | return 38 | 39 | end subroutine FlowRouting 40 | 41 | !-------------------------------------------------------------------------------------------- 42 | 43 | subroutine FlowRoutingSingleFlowDirection () 44 | 45 | use FastScapeContext 46 | 47 | implicit none 48 | 49 | integer :: i, ijk, ijr 50 | double precision :: dx, dy,deltah 51 | 52 | dx = xl/(nx - 1) 53 | dy = yl/(ny - 1) 54 | 55 | ! finds receiver 56 | 57 | call find_receiver (h, nx, ny, dx, dy, rec, length, & 58 | bounds_i1, bounds_i2, bounds_j1, bounds_j2, bounds_xcyclic, bounds_ycyclic) 59 | 60 | ! finds donors 61 | 62 | call find_donor (rec, nn, ndon, don) 63 | 64 | ! find stack 65 | 66 | call find_stack (rec, don, ndon, nn, catch0, stack, catch) 67 | 68 | ! removes local minima 69 | call LocalMinima (stack,rec,bounds_bc,ndon,don,h,length,nx,ny,dx,dy) 70 | 71 | ! find hwater 72 | 73 | hwater = h 74 | 75 | ! fill the local minima with a nearly planar surface 76 | 77 | deltah = 1.d-8 78 | do i=1,nn 79 | ijk = stack(i) 80 | ijr = rec(ijk) 81 | if (ijr.ne.0) then 82 | if (hwater(ijr).gt.hwater(ijk)) then 83 | hwater(ijk) = hwater(ijr) + deltah 84 | endif 85 | endif 86 | enddo 87 | 88 | ! compute lake depth 89 | lake_depth = hwater - h 90 | 91 | return 92 | 93 | end subroutine FlowRoutingSingleFlowDirection 94 | 95 | !-------------------------------------------------------------------------------------------- 96 | 97 | subroutine FlowAccumulation () 98 | 99 | use FastScapeContext 100 | 101 | implicit none 102 | 103 | integer :: ij, ijk, k 104 | double precision :: dx,dy 105 | 106 | dx=xl/(nx-1) 107 | dy=yl/(ny-1) 108 | 109 | a=dx*dy*precip 110 | do ij=1,nn 111 | ijk=mstack(ij) 112 | do k =1,mnrec(ijk) 113 | a(mrec(k,ijk))=a(mrec(k,ijk))+a(ijk)*mwrec(k,ijk) 114 | enddo 115 | enddo 116 | 117 | return 118 | 119 | end subroutine FlowAccumulation 120 | 121 | !-------------------------------------------------------------------------------------------- 122 | 123 | subroutine FlowAccumulationSingleFlowDirection () 124 | 125 | use FastScapeContext 126 | 127 | implicit none 128 | 129 | integer :: ij, ijk 130 | double precision :: dx,dy 131 | 132 | dx=xl/(nx-1) 133 | dy=yl/(ny-1) 134 | 135 | a=dx*dy*precip 136 | do ij=nn,1,-1 137 | ijk=stack(ij) 138 | a(rec(ijk))=a(rec(ijk))+a(ijk) 139 | enddo 140 | 141 | return 142 | 143 | end subroutine FlowAccumulationSingleFlowDirection 144 | 145 | !-------------------------------------------------------------------------------------------- 146 | 147 | subroutine find_mult_rec (h,rec0,stack0,water,rec,nrec,wrec,lrec,stack,nx,ny,dx,dy,p,p_mfd_exp, & 148 | bounds_i1, bounds_i2, bounds_j1, bounds_j2, bounds_xcyclic, bounds_ycyclic) 149 | 150 | ! subroutine to find multiple receiver information 151 | ! in input: 152 | ! h is topography 153 | ! rec0 is single receiver information 154 | ! stack0 is stack (from bottom to top) obtained by using single receiver information 155 | ! water is the surface of the lakes (or topography where there is no lake) 156 | ! nx, ny resolution in x- and y-directions 157 | ! dx, dy grid spacing in x- and y-directions 158 | ! p is exponent to which the slope is put to share the water/sediment among receivers 159 | ! bounds: boundaries type (boundary conditions) 160 | ! in output: 161 | ! rec: multiple receiver information 162 | ! nrec: number of receivers for each node 163 | ! wrec: weight for each receiver 164 | ! lrec: distance to each receiver 165 | ! stack: stoack order for multiple receivers (from top to bottom) 166 | 167 | integer, intent(in) :: bounds_i1, bounds_i2, bounds_j1, bounds_j2 168 | logical, intent(in) :: bounds_xcyclic, bounds_ycyclic 169 | integer nx,ny 170 | double precision h(nx*ny),wrec(8,nx*ny),lrec(8,nx*ny),dx,dy,p,water(nx*ny),p_mfd_exp(nx*ny) 171 | integer rec(8,nx*ny),nrec(nx*ny),stack(nx*ny),rec0(nx*ny),stack0(nx*ny) 172 | 173 | integer :: nn,i,j,ii,jj,iii,jjj,ijk,k,ijr,nparse,nstack,ijn,ij 174 | double precision :: slopemax,sumweight,deltah,slope 175 | integer, dimension(:), allocatable :: ndon,vis,parse 176 | integer, dimension(:,:), allocatable :: don 177 | double precision, dimension(:), allocatable :: h0 178 | 179 | nn=nx*ny 180 | 181 | allocate (h0(nn)) 182 | 183 | h0=h 184 | 185 | ! fill the local minima with a nearly planar surface 186 | 187 | deltah = 1.d-8 188 | do i=1,nn 189 | ijk=stack0(i) 190 | ijr=rec0(ijk) 191 | if (ijr.ne.0) then 192 | if (h0(ijr).gt.h0(ijk)) then 193 | h0(ijk)=h0(ijr)+deltah 194 | endif 195 | endif 196 | enddo 197 | 198 | water = h0 199 | 200 | nrec=0 201 | wrec=0.d0 202 | 203 | ! loop on all nodes 204 | do j=bounds_j1,bounds_j2 205 | do i=bounds_i1,bounds_i2 206 | ij = (j-1)*nx + i 207 | slopemax = 0. 208 | do jj=-1,1 209 | jjj= j + jj 210 | if (jjj.lt.1.and.bounds_ycyclic) jjj=jjj+ny 211 | jjj=max(jjj,1) 212 | if (jjj.gt.ny.and.bounds_ycyclic) jjj=jjj-ny 213 | jjj=min(jjj,ny) 214 | do ii=-1,1 215 | iii = i + ii 216 | if (iii.lt.1.and.bounds_xcyclic) iii=iii+nx 217 | iii=max(iii,1) 218 | if (iii.gt.nx.and.bounds_xcyclic) iii=iii-nx 219 | iii=min(iii,nx) 220 | ijk = (jjj-1)*nx + iii 221 | if (h0(ij).gt.h0(ijk)) then 222 | nrec(ij)=nrec(ij)+1 223 | rec(nrec(ij),ij) = ijk 224 | lrec(nrec(ij),ij) = sqrt((ii*dx)**2 + (jj*dy)**2) 225 | wrec(nrec(ij),ij) = (h0(ij) - h0(ijk))/lrec(nrec(ij),ij) 226 | endif 227 | enddo 228 | enddo 229 | enddo 230 | enddo 231 | 232 | do ij =1,nn 233 | if (p<0.d0) then 234 | slope = 0.d0 235 | if (nrec(ij).ne.0) slope = real(sum(wrec(1:nrec(ij),ij))/nrec(ij)) 236 | p_mfd_exp(ij) = 0.5 + 0.6*slope 237 | endif 238 | do k=1,nrec(ij) 239 | wrec(k,ij) = wrec(k,ij)**p_mfd_exp(ij) 240 | enddo 241 | sumweight = sum(wrec(1:nrec(ij),ij)) 242 | wrec(1:nrec(ij),ij) = wrec(1:nrec(ij),ij)/sumweight 243 | enddo 244 | 245 | allocate (ndon(nn),don(8,nn)) 246 | 247 | ndon=0 248 | 249 | do ij=1,nn 250 | do k=1,nrec(ij) 251 | ijk = rec(k,ij) 252 | ndon(ijk)=ndon(ijk)+1 253 | don(ndon(ijk),ijk) = ij 254 | enddo 255 | enddo 256 | 257 | allocate (vis(nn),parse(nn)) 258 | 259 | nparse=0 260 | nstack=0 261 | stack=0 262 | vis=0 263 | parse=0 264 | 265 | ! we go through the nodes 266 | do ij=1,nn 267 | ! when we find a "summit" (ie a node that has no donors) 268 | ! we parse it (put it in a stack called parse) 269 | if (ndon(ij).eq.0) then 270 | nparse=nparse+1 271 | parse(nparse)=ij 272 | endif 273 | ! we go through the parsing stack 274 | do while (nparse.gt.0) 275 | ijn=parse(nparse) 276 | nparse=nparse-1 277 | ! we add the node to the stack 278 | nstack=nstack+1 279 | stack(nstack)=ijn 280 | ! for each of its receivers we increment a counter called vis 281 | do ijk=1,nrec(ijn) 282 | ijr=rec(ijk,ijn) 283 | vis(ijr)=vis(ijr)+1 284 | ! if the counter is equal to the number of donors for that node we add it to the parsing stack 285 | if (vis(ijr).eq.ndon(ijr)) then 286 | nparse=nparse+1 287 | parse(nparse)=ijr 288 | endif 289 | enddo 290 | enddo 291 | enddo 292 | if (nstack.ne.nn) stop 'error in stack' 293 | 294 | deallocate (ndon,don,vis,parse,h0) 295 | 296 | return 297 | 298 | end subroutine find_mult_rec 299 | 300 | !-------------------------------------------------------------------------------------------- 301 | 302 | subroutine find_receiver (h, nx, ny, dx, dy, rec, length, & 303 | bounds_i1, bounds_i2, bounds_j1, bounds_j2, bounds_xcyclic, bounds_ycyclic) 304 | 305 | implicit none 306 | 307 | integer, intent(in) :: bounds_i1, bounds_i2, bounds_j1, bounds_j2 308 | logical, intent(in) :: bounds_xcyclic, bounds_ycyclic 309 | integer, intent(in) :: nx, ny 310 | double precision, dimension(nx*ny), intent(in) :: h 311 | double precision, intent(in) :: dx, dy 312 | integer, dimension(nx*ny), intent(out) :: rec 313 | double precision, dimension(nx*ny), intent(out) :: length 314 | 315 | integer :: nn, ij, i, j, ii, jj, iii, jjj, ijk 316 | double precision :: l, smax, slope 317 | 318 | nn = nx*ny 319 | 320 | ! resets receiver and distance between node and its receiver 321 | 322 | do ij=1,nn 323 | rec(ij)=ij 324 | length(ij)=0.d0 325 | enddo 326 | 327 | ! finds receiver using steepest descent/neighbour method 328 | 329 | do j=bounds_j1,bounds_j2 330 | do i=bounds_i1,bounds_i2 331 | ij=i+(j-1)*nx 332 | smax=tiny(smax) 333 | do jj=-1,1 334 | do ii=-1,1 335 | iii=i+ii 336 | if (iii.lt.1.and.bounds_xcyclic) iii=iii+nx 337 | iii=max(iii,1) 338 | if (iii.gt.nx.and.bounds_xcyclic) iii=iii-nx 339 | iii=min(iii,nx) 340 | jjj=j+jj 341 | if (jjj.lt.1.and.bounds_ycyclic) jjj=jjj+ny 342 | jjj=max(jjj,1) 343 | if (jjj.gt.ny.and.bounds_ycyclic) jjj=jjj-ny 344 | jjj=min(jjj,ny) 345 | ijk=iii+(jjj-1)*nx 346 | if (ijk.ne.ij) then 347 | l=sqrt((dx*ii)**2+(dy*jj)**2) 348 | slope=(h(ij)-h(ijk))/l 349 | if (slope.gt.smax) then 350 | smax=slope 351 | rec(ij)=ijk 352 | length(ij)=l 353 | endif 354 | endif 355 | enddo 356 | enddo 357 | enddo 358 | enddo 359 | 360 | return 361 | 362 | end subroutine find_receiver 363 | 364 | !-------------------------------------------------------------------------------------------- 365 | 366 | subroutine find_donor (rec, nn, ndon, don) 367 | 368 | implicit none 369 | 370 | integer, intent(in) :: nn 371 | integer, dimension(nn), intent(in) :: rec 372 | integer, dimension(nn), intent(out) :: ndon 373 | integer, dimension(8,nn), intent(out) :: don 374 | 375 | integer ij, ijk 376 | 377 | ! inverts receiver array to compute donor arrays 378 | ndon=0 379 | do ij=1,nn 380 | if (rec(ij).ne.ij) then 381 | ijk=rec(ij) 382 | ndon(ijk)=ndon(ijk)+1 383 | don(ndon(ijk),ijk)=ij 384 | endif 385 | enddo 386 | 387 | return 388 | 389 | end subroutine find_donor 390 | 391 | !-------------------------------------------------------------------------------------------- 392 | 393 | subroutine find_stack (rec, don, ndon, nn, catch0, stack, catch) 394 | 395 | implicit none 396 | 397 | integer, intent(in) :: nn 398 | integer, intent(in), dimension(nn) :: rec, ndon 399 | integer, intent(in), dimension(8,nn) :: don 400 | double precision, intent(in), dimension(nn) :: catch0 401 | integer, intent(out), dimension(nn) :: stack 402 | double precision, dimension(nn), intent(out) :: catch 403 | 404 | integer :: ij, nstack 405 | 406 | ! computes stack by recursion 407 | nstack=0 408 | catch=catch0 409 | do ij=1,nn 410 | if (rec(ij).eq.ij) then 411 | nstack=nstack+1 412 | stack(nstack)=ij 413 | call find_stack_recursively (ij,don,ndon,nn,stack,nstack,catch) 414 | endif 415 | enddo 416 | 417 | return 418 | 419 | end subroutine find_stack 420 | 421 | !-------------------------------------------------------------------------------------------- 422 | 423 | recursive subroutine find_stack_recursively (ij,don,ndon,nn,stack,nstack,catch) 424 | 425 | ! recursive routine to go through all nodes following donor information 426 | 427 | implicit none 428 | 429 | integer k,ij,ijk,nn,nstack 430 | integer don(8,nn),ndon(nn),stack(nn) 431 | double precision catch(nn) 432 | 433 | do k=1,ndon(ij) 434 | ijk=don(k,ij) 435 | nstack=nstack+1 436 | stack(nstack)=ijk 437 | catch(ijk)=catch(ij) 438 | call find_stack_recursively (ijk,don,ndon,nn,stack,nstack,catch) 439 | enddo 440 | 441 | return 442 | 443 | end subroutine find_stack_recursively 444 | 445 | !-------------------------------------------------------------------------------------------- 446 | -------------------------------------------------------------------------------- /src/StreamPowerLaw.f90: -------------------------------------------------------------------------------- 1 | !-------------------------------------------------------------------------------------------- 2 | 3 | subroutine StreamPowerLaw () 4 | 5 | ! subroutine to solve the stream power law equation following the FastScape method described 6 | ! in Braun and Willett, Geomorphology, 2015 7 | 8 | use FastScapeContext 9 | 10 | implicit none 11 | 12 | integer :: ij,ijk,ijr,k,ijr1 13 | double precision :: dx,dy,fact,tol,err 14 | double precision :: f,df,errp,h0,hn,omega,tolp,w_rcv 15 | double precision, dimension(:), allocatable :: ht,kfint,dh,hp 16 | double precision, dimension(:), allocatable :: elev 17 | double precision, dimension(:), allocatable :: water,lake_water_volume,lake_sediment 18 | integer, dimension(:), allocatable :: lake_sill 19 | 20 | allocate (ht(nn),kfint(nn),dh(nn),hp(nn)) 21 | allocate (elev(nn)) 22 | allocate (water(nn),lake_water_volume(nn),lake_sediment(nn),lake_sill(nn)) 23 | 24 | dx=xl/(nx-1) 25 | dy=yl/(ny-1) 26 | 27 | ! set g, dimensionless parameter for sediment transport and deposition 28 | ! if g1<0, skip and use g values directly from FastScapeContext (not in API!!!) 29 | if (g1.ge.0.d0) then 30 | g=g1 31 | if (g2.gt.0.d0) where ((h-b).gt.1.d0) g=g2 32 | endif 33 | 34 | ! set kf / kfsed 35 | kfint=kf 36 | if (kfsed.gt.0.d0) where ((h-b).gt.1.d0) kfint=kfsed 37 | 38 | if (count(mstack==0).ne.0) print*,'incomplete stack',count(mstack==0),nn 39 | 40 | ! modified by Jean Braun (20/11/2022) to allow for relative versus 41 | ! absolute tolerance 42 | tol = tol_rel*maxval(abs(h)) + tol_abs 43 | err=2.d0*tol 44 | 45 | ! store the elevation at t 46 | ht=h 47 | 48 | ! Gauss-Seidel iteration 49 | nGSStreamPowerLaw=0 50 | 51 | lake_sediment=0.d0 52 | lake_sill=0.d0 53 | dh=0.d0 54 | hp=h 55 | 56 | do while (err.gt.tol.and.nGSStreamPowerLaw.lt.nGSStreamPowerLawMax-1) 57 | nGSStreamPowerLaw=nGSStreamPowerLaw+1 58 | 59 | where (bounds_bc) 60 | elev=ht 61 | elsewhere 62 | elev=ht+(dh-(ht-hp))*g*dx*dy/a 63 | endwhere 64 | 65 | ! apply modified stream power law using lake surface (hwater) 66 | 67 | if (abs(n-1.d0).lt.tiny(n)) then 68 | 69 | do ij=nn,1,-1 70 | ijk=mstack(ij) 71 | ijr1=rec(ijk) 72 | if (ijr1.eq.ijk) then 73 | water(ijk)=ht(ijk) 74 | lake_sill(ijk)=ijk 75 | lake_water_volume(ijk)=0.d0 76 | else 77 | w_rcv=water(ijr1) 78 | if (elev(ijk).gt.w_rcv) then 79 | if (mnrec(ijk).gt.0) then 80 | if (h(ijk).ge.sealevel.or..not.runMarine) then 81 | f = elev(ijk) 82 | df = 1.d0 83 | do k=1,mnrec(ijk) 84 | if (ht(ijk).ge.ht(mrec(k,ijk))) then 85 | fact = kfint(ijk)*dt*(a(ijk)*mwrec(k,ijk))**m/mlrec(k,ijk) 86 | f = f + fact*h(mrec(k,ijk)) 87 | df = df + fact 88 | endif 89 | enddo 90 | h(ijk)=f/df 91 | endif 92 | endif 93 | lake_sill(ijk)=ijk 94 | lake_water_volume(ijk)=0.d0 95 | if (h(ijk).lt.w_rcv) h(ijk)=w_rcv 96 | else 97 | h(ijk)=elev(ijk) 98 | lake_sill(ijk)=lake_sill(ijr1) 99 | if (lake_sill(ijk).ne.0) lake_water_volume(lake_sill(ijk)) = & 100 | lake_water_volume(lake_sill(ijk))+(w_rcv-h(ijk)) 101 | endif 102 | water(ijk)=max(w_rcv,h(ijk)) 103 | endif 104 | enddo 105 | 106 | else 107 | 108 | do ij=nn,1,-1 109 | ijk=mstack(ij) 110 | ijr1=rec(ijk) 111 | if (ijr1.eq.ijk) then 112 | water(ijk)=ht(ijk) 113 | lake_sill(ijk)=ijk 114 | lake_water_volume(ijk)=0.d0 115 | else 116 | w_rcv=water(ijr1) 117 | if (elev(ijk).gt.w_rcv) then 118 | if (mnrec(ijk).gt.0) then 119 | if (ht(ijk).ge.sealevel.or..not.runMarine) then 120 | omega=0.875d0/n 121 | tolp=1.d-3 122 | errp=2.d0*tolp 123 | h0=elev(ijk) 124 | do while (errp.gt.tolp) 125 | f=h(ijk)-h0 126 | df=1.d0 127 | do k=1,mnrec(ijk) 128 | if (ht(ijk).gt.ht(mrec(k,ijk))) then 129 | fact = kfint(ijk)*dt*(a(ijk)*mwrec(k,ijk))**m/mlrec(k,ijk)**n 130 | f=f+fact*max(0.d0,h(ijk)-h(mrec(k,ijk)))**n 131 | df=df+fact*n*max(0.d0,h(ijk)-h(mrec(k,ijk)))**(n-1.d0) 132 | endif 133 | enddo 134 | hn=h(ijk)-f/df 135 | errp=abs(hn-h(ijk)) 136 | h(ijk)=h(ijk)*(1.d0-omega)+hn*omega 137 | enddo 138 | endif 139 | endif 140 | lake_sill(ijk)=ijk 141 | lake_water_volume(ijk)=0.d0 142 | if (h(ijk).lt.w_rcv) h(ijk)=w_rcv 143 | else 144 | h(ijk)=elev(ijk) 145 | lake_sill(ijk)=lake_sill(ijr1) 146 | if (lake_sill(ijk).ne.0) lake_water_volume(lake_sill(ijk)) = & 147 | lake_water_volume(lake_sill(ijk))+(w_rcv-h(ijk)) 148 | endif 149 | water(ijk)=max(w_rcv,h(ijk)) 150 | endif 151 | enddo 152 | 153 | endif 154 | 155 | err=sqrt(sum((h-hp)**2)/nn) 156 | ! Jean Braun modification 18/11/2022: moved the computation of redistribution of sediment in lakes 157 | ! following Sebastian Wolf's suggestion; this ensures mass conservation in multi-minima cases 158 | ! guess/update the elevation at t+Dt (k) 159 | hp=h 160 | 161 | ! calculate erosion/deposition at each node 162 | dh=ht-hp 163 | 164 | ! sum the erosion in stack order 165 | do ij=1,nn 166 | ijk=mstack(ij) 167 | ijr1=rec(ijk) 168 | if (ijr1.ne.ijk) then 169 | dh(ijk)=dh(ijk)-(ht(ijk)-hp(ijk)) 170 | if (lake_sill(ijk).eq.ijk) then 171 | if (dh(ijk).le.0.d0) then 172 | lake_sediment(ijk)=0.d0 173 | else 174 | lake_sediment(ijk)=dh(ijk) 175 | endif 176 | endif 177 | dh(ijk)=dh(ijk)+(ht(ijk)-hp(ijk)) 178 | do k=1,mnrec(ijk) 179 | ijr=mrec(k,ijk) 180 | dh(ijr)=dh(ijr)+dh(ijk)*mwrec(k,ijk) 181 | enddo 182 | else 183 | lake_sediment(ijk)=dh(ijk) 184 | endif 185 | enddo 186 | 187 | 188 | if (maxval(g).lt.tiny(g)) err=0.d0 189 | 190 | enddo 191 | 192 | b=min(h,b) 193 | 194 | do ij=1,nn 195 | if (lake_sill(ij).ne.0) then 196 | if (lake_water_volume(lake_sill(ij)).gt.0.d0) h(ij)=h(ij) & 197 | +max(0.d0,min(lake_sediment(lake_sill(ij)),lake_water_volume(lake_sill(ij))))/ & 198 | lake_water_volume(lake_sill(ij))*(water(ij)-h(ij)) 199 | endif 200 | enddo 201 | 202 | ! stores total erosion, erosion rate and flux for output 203 | etot=etot+ht-h 204 | erate=(ht-h)/dt 205 | Sedflux=ht-h 206 | !if (runMarine) where (h.lt.sealevel) Sedflux=0.d0 207 | 208 | deallocate (ht,kfint,dh,hp,elev,water,lake_water_volume,lake_sediment,lake_sill) 209 | 210 | return 211 | 212 | end subroutine StreamPowerLaw 213 | 214 | !-------------------------------------------------------------------------------------------- 215 | 216 | subroutine StreamPowerLawSingleFlowDirection () 217 | 218 | ! subroutine to solve the stream power law equation following the FastScape method described 219 | ! in Braun and Willett, Geomorphology, 2015 220 | 221 | use FastScapeContext 222 | 223 | implicit none 224 | 225 | integer :: ij,ijk,ijr 226 | double precision :: dx,dy,fact,tol,err 227 | double precision :: f,df,errp,h0,hn,omega,tolp,w_rcv 228 | double precision, dimension(:), allocatable :: ht,kfint,dh,hp 229 | double precision, dimension(:), allocatable :: elev 230 | double precision, dimension(:), allocatable :: water,lake_water_volume,lake_sediment 231 | integer, dimension(:), allocatable :: lake_sill 232 | 233 | allocate (ht(nn),kfint(nn),dh(nn),hp(nn)) 234 | allocate (elev(nn)) 235 | allocate (water(nn),lake_water_volume(nn),lake_sediment(nn),lake_sill(nn)) 236 | 237 | dx=xl/(nx-1) 238 | dy=yl/(ny-1) 239 | 240 | ! set g, dimensionless parameter for sediment transport and deposition 241 | ! if g1<0, skip and use g values directly from FastScapeContext (not in API!!!) 242 | if (g1.ge.0.d0) then 243 | g=g1 244 | if (g2.gt.0.d0) where ((h-b).gt.1.d0) g=g2 245 | endif 246 | 247 | ! set kf / kfsed 248 | kfint=kf 249 | if (kfsed.gt.0.d0) where ((h-b).gt.1.d0) kfint=kfsed 250 | 251 | ! modified by Jean Braun (20/11/2022) to allow for relative versus 252 | ! absolute tolerance 253 | tol = tol_rel*maxval(abs(h)) + tol_abs 254 | err=2.d0*tol 255 | 256 | ! store the elevation at t 257 | ht=h 258 | 259 | ! Gauss-Seidel iteration 260 | nGSStreamPowerLaw=0 261 | 262 | lake_sediment=0.d0 263 | dh=0.d0 264 | hp=h 265 | 266 | do while (err.gt.tol.and.nGSStreamPowerLaw.lt.nGSStreamPowerLawMax-1) 267 | nGSStreamPowerLaw=nGSStreamPowerLaw+1 268 | where (bounds_bc) 269 | elev=ht 270 | elsewhere 271 | elev=ht+(dh-(ht-hp))*g*dx*dy/a 272 | endwhere 273 | 274 | ! apply modified stream power law using lake surface (hwater) 275 | 276 | if (abs(n-1.d0).lt.tiny(n)) then 277 | 278 | do ij=1,nn 279 | ijk=stack(ij) 280 | ijr=rec(ijk) 281 | if (ijr.eq.ijk) then 282 | water(ijk)=ht(ijk) 283 | lake_sill(ijk)=ijk 284 | lake_water_volume(ijk)=0.d0 285 | else 286 | w_rcv=water(ijr) 287 | if (elev(ijk).gt.w_rcv) then 288 | if (h(ijk).ge.sealevel.or..not.runMarine) then 289 | f = elev(ijk) 290 | df = 1.d0 291 | ! todo: check if we don't need those checks for single flow 292 | ! if (ht(ijk).ge.ht(ijr)) then 293 | fact = kfint(ijk)*dt*a(ijk)**m/length(ijk) 294 | f = f + fact*h(ijr) 295 | df = df + fact 296 | ! endif 297 | h(ijk)=f/df 298 | ! h(ijk)=min(f/df,minval(h(don(1:ndon(ijk),ijk)))) 299 | endif 300 | lake_sill(ijk)=ijk 301 | lake_water_volume(ijk)=0.d0 302 | if (h(ijk).lt.w_rcv) h(ijk)=w_rcv 303 | else 304 | h(ijk)=elev(ijk) 305 | lake_sill(ijk)=lake_sill(ijr) 306 | if (lake_sill(ijk).ne.0) lake_water_volume(lake_sill(ijk)) = & 307 | lake_water_volume(lake_sill(ijk))+(w_rcv-h(ijk)) 308 | endif 309 | water(ijk)=max(w_rcv,h(ijk)) 310 | endif 311 | enddo 312 | 313 | else 314 | 315 | do ij=1,nn 316 | ijk=stack(ij) 317 | ijr=rec(ijk) 318 | if (ijr.eq.ijk) then 319 | water(ijk)=ht(ijk) 320 | lake_sill(ijk)=ijk 321 | lake_water_volume(ijk)=0.d0 322 | else 323 | w_rcv=water(ijr) 324 | if (elev(ijk).gt.w_rcv) then 325 | if (ht(ijk).ge.sealevel.or..not.runMarine) then 326 | omega=0.875d0/n 327 | tolp=1.d-3 328 | errp=2.d0*tolp 329 | h0=elev(ijk) 330 | do while (errp.gt.tolp) 331 | f=h(ijk)-h0 332 | df=1.d0 333 | if (ht(ijk).gt.ht(ijr)) then 334 | fact = kfint(ijk)*dt*a(ijk)**m/length(ijk)**n 335 | f=f+fact*max(0.d0,h(ijk)-h(ijr))**n 336 | df=df+fact*n*max(0.d0,h(ijk)-h(ijr))**(n-1.d0) 337 | endif 338 | hn=h(ijk)-f/df 339 | errp=abs(hn-h(ijk)) 340 | h(ijk)=h(ijk)*(1.d0-omega)+hn*omega 341 | enddo 342 | endif 343 | lake_sill(ijk)=ijk 344 | lake_water_volume(ijk)=0.d0 345 | if (h(ijk).lt.w_rcv) h(ijk)=w_rcv 346 | else 347 | h(ijk)=elev(ijk) 348 | lake_sill(ijk)=lake_sill(ijr) 349 | if (lake_sill(ijk).ne.0) lake_water_volume(lake_sill(ijk)) = & 350 | lake_water_volume(lake_sill(ijk))+(w_rcv-h(ijk)) 351 | endif 352 | water(ijk)=max(w_rcv,h(ijk)) 353 | endif 354 | enddo 355 | 356 | endif 357 | 358 | err=sqrt(sum((h-hp)**2)/nn) 359 | 360 | ! Jean Braun modification 18/11/2022: moved the computation of redistribution of sediment in lakes 361 | ! following Sebastian Wolf's suggestion; this ensures mass conservation in multi-minima cases 362 | ! guess/update the elevation at t+Dt (k) 363 | hp=h 364 | 365 | ! calculate erosion/deposition at each node 366 | dh=ht-hp 367 | 368 | ! sum the erosion in stack order 369 | do ij=nn,1,-1 370 | ijk=stack(ij) 371 | ijr=rec(ijk) 372 | if (ijr.ne.ijk) then 373 | dh(ijk)=dh(ijk)-(ht(ijk)-hp(ijk)) 374 | if (lake_sill(ijk).eq.ijk) then 375 | if (dh(ijk).le.0.d0) then 376 | lake_sediment(ijk)=0.d0 377 | else 378 | lake_sediment(ijk)=min(dh(ijk),lake_water_volume(ijk)) 379 | dh(ijk) = dh(ijk)-lake_water_volume(ijk) !remove the sediment that is going to be deposited in the lake from the dh stack 380 | if (dh(ijk)<0.d0) dh(ijk)=0.d0 381 | endif 382 | endif 383 | dh(ijk)=dh(ijk)+(ht(ijk)-hp(ijk)) 384 | dh(ijr)=dh(ijr)+dh(ijk) 385 | else 386 | lake_sediment(ijk)=dh(ijk) 387 | endif 388 | enddo 389 | 390 | 391 | if (maxval(g).lt.tiny(g)) err=0.d0 392 | enddo 393 | 394 | b=min(h,b) 395 | 396 | 397 | do ij=1,nn 398 | if (lake_sill(ij).ne.0) then 399 | if (lake_water_volume(lake_sill(ij)).gt.0.d0) h(ij)=h(ij) & 400 | +max(0.d0,min(lake_sediment(lake_sill(ij)),lake_water_volume(lake_sill(ij))))/ & 401 | lake_water_volume(lake_sill(ij))*(water(ij)-h(ij)) 402 | endif 403 | enddo 404 | 405 | ! stores total erosion, erosion rate and flux for output 406 | etot=etot+ht-h 407 | erate=(ht-h)/dt 408 | Sedflux=ht-h 409 | !if (runMarine) where (h.lt.sealevel) Sedflux=0.d0 410 | 411 | deallocate (ht,kfint,dh,hp,elev,water,lake_water_volume,lake_sediment,lake_sill) 412 | 413 | return 414 | 415 | end subroutine StreamPowerLawSingleFlowDirection 416 | 417 | !-------------------------------------------------------------------------------------------- 418 | -------------------------------------------------------------------------------- /docs/asciidoc.conf: -------------------------------------------------------------------------------- 1 | # This file is an AsciiDoc configuration file that makes 2 | # AsciiDoc conform with Asciidoctor's fixes and customizations. 3 | # 4 | # Place this file in the same directory as your AsciiDoc document and the 5 | # AsciiDoc processor (asciidoc) will automatically use it. 6 | 7 | [miscellaneous] 8 | newline=\n 9 | 10 | [attributes] 11 | # make html5 the default html backend 12 | backend-alias-html=html5 13 | asterisk=* 14 | backtick=` 15 | brvbar=¦ 16 | caret=^ 17 | # plus introduced in AsciiDoc 8.6.9 18 | plus=+ 19 | blank= 20 | tilde=~ 21 | cpp=C++ 22 | user-home={eval:os.path.expanduser('~')} 23 | vbar=| 24 | # NOTE use -a no-inline-literal to set compat-mode to default when using AsciiDoc Python 25 | ifndef::no-inline-literal[] 26 | compat-mode=legacy 27 | endif::[] 28 | 29 | [replacements] 30 | # right single quote 31 | (?[\S].*?)(?: +\1)?$ 52 | sect1=^(==|##) +(?P[\S].*?)(?: +\1)?$ 53 | sect2=^(===|###) +(?P<title>[\S].*?)(?: +\1)?$ 54 | sect3=^(====|####) +(?P<title>[\S].*?)(?: +\1)?$ 55 | sect4=^(=====|#####) +(?P<title>[\S].*?)(?: +\1)?$ 56 | sect5=^(======|######) +(?P<title>[\S].*?)(?: +\1)?$ 57 | 58 | # Disable subs on pass block by default 59 | [blockdef-pass] 60 | subs=none 61 | 62 | # enables fenced code blocks 63 | # FIXME I haven't sorted out yet how to do syntax highlighting 64 | [blockdef-fenced-code] 65 | delimiter=^```(?:\w+(?:,numbered)?)?$ 66 | ifdef::language[] 67 | style=source 68 | template::[source-filter-style] 69 | endif::language[] 70 | ifndef::language[] 71 | template=listingblock 72 | subs=verbatim 73 | posattrs=style 74 | endif::language[] 75 | 76 | # enables blockquotes to be defined using two double quotes 77 | [blockdef-air-quote] 78 | template::[blockdef-quote] 79 | delimiter=^""$ 80 | 81 | # markdown-style blockquote (paragraph only) 82 | # FIXME does not strip leading > on subsequent lines 83 | [paradef-markdown-quote] 84 | delimiter=(?s)>\s*(?P<text>\S.*) 85 | style=quote 86 | quote-style=template="quoteparagraph",posattrs=("style","attribution","citetitle") 87 | 88 | # fix regex for callout list to require number; also makes markdown-style blockquote work 89 | [listdef-callout] 90 | posattrs=style 91 | delimiter=^<?(?P<index>\d+>) +(?P<text>.+)$ 92 | type=callout 93 | tags=callout 94 | style=arabic 95 | 96 | # enables literal block to be used as source block 97 | [blockdef-literal] 98 | template::[source-filter-style] 99 | 100 | # enables source block when source-highlighter is not defined 101 | ifndef::source-highlighter[] 102 | [source-filter-style] 103 | source-style=template="listingblock",subs=("specialcharacters","callouts"),posattrs=("style","language","src_numbered","src_tab") 104 | 105 | [paradef-default] 106 | template::[source-filter-style] 107 | 108 | [paradef-literal] 109 | template::[source-filter-style] 110 | 111 | [blockdef-open] 112 | template::[source-filter-style] 113 | 114 | [blockdef-listing] 115 | template::[source-filter-style] 116 | endif::source-highlighter[] 117 | 118 | [tabledef-csv] 119 | template::[tabledef-default] 120 | delimiter=^,={3,}$ 121 | format=csv 122 | 123 | [tabledef-dsv] 124 | template::[tabledef-default] 125 | delimiter=^:={3,}$ 126 | format=dsv 127 | 128 | [macros] 129 | ifdef::no-inline-literal[] 130 | (?su)\\?\+\+(?P<passtext>.*?)\+\+=pass[specialcharacters] 131 | (?su)(?<![+\w])(\\?\+(?P<passtext>\S|\S.*?\S)\+)(?![+\w])=pass[specialcharacters] 132 | endif::no-inline-literal[] 133 | 134 | # additional callout match behind line comments 135 | #(?://|#|;;) ?\((?P<index>\d+)\)=callout 136 | # additional callout match for XML 137 | [\\]?<!--(?P<index>\d+)-->=callout 138 | 139 | # --- or *** or ___ or - - - or * * * or _ _ _ (in addition to the built-in ''') 140 | ^ {0,3}([-\*_])( *)\1\2\1$=#ruler 141 | 142 | # btn:[Save] 143 | (?su)(?<!\w)\\?btn:\[(?P<attrlist>(?:\\\]|[^\]])+?)\]=button 144 | 145 | # kbd:[F11] or kbd:[Ctrl+T] or kbd:[Ctrl,T] 146 | (?su)(?<!\w)\\?kbd:\[(?P<attrlist>(?:\\\]|[^\]])+?)\]=keyboard 147 | 148 | # menu:Search[] or menu:File[New...] or menu:View[Page Style, No Style] 149 | # TODO implement menu:View[Page Style > No Style] syntax 150 | (?su)(?<!\w)[\\]?(?P<name>menu):(?P<target>\w|\w.*?\S)?\[(?P<attrlist>.*?)\]= 151 | 152 | ifdef::basebackend-html[] 153 | 154 | [sect5] 155 | <div class="sect5{style? {style}}{role? {role}}"> 156 | <h6{id? id="{id}"}>{title}</h6> 157 | | 158 | </div> 159 | 160 | [button-inlinemacro] 161 | <b class="button">{1}</b> 162 | 163 | [keyboard-inlinemacro] 164 | {set2:keys:{eval:re.split(r'(?<!\+ |.\+)\+', '{1}')}} 165 | {2%}{eval:len({keys}) == 1}<kbd>{1}</kbd> 166 | {2%}{eval:len({keys}) == 2}<kbd class="combo"><kbd>{eval:{keys}[0].strip()}</kbd>+<kbd>{eval:{keys}[1].strip()}</kbd></kbd> 167 | {2%}{eval:len({keys}) == 3}<kbd class="combo"><kbd>{eval:{keys}[0].strip()}</kbd>+<kbd>{eval:{keys}[1].strip()}</kbd>+<kbd>{eval:{keys}[2].strip()}</kbd></kbd> 168 | {2#}{3%}<kbd class="combo"><kbd>{1}</kbd>+<kbd>{2}</kbd></kbd> 169 | {3#}<kbd class="combo"><kbd>{1}</kbd>+<kbd>{2}</kbd>+<kbd>{3}</kbd></kbd> 170 | 171 | [menu-inlinemacro] 172 | {1%}<span class="menu">{target}</span> 173 | {1#}{2%}<span class="menuseq"><span class="menu">{target}</span> ▸ <span class="menuitem">{1}</span></span> 174 | {2#}{3%}<span class="menuseq"><span class="menu">{target}</span> ▸ <span class="submenu">{1}</span> ▸ <span class="menuitem">{2}</span></span> 175 | {3#}<span class="menuseq"><span class="menu">{target}</span> ▸ <span class="submenu">{1}</span> ▸ <span class="submenu">{2}</span> ▸ <span class="menuitem">{3}</span></span> 176 | 177 | [literal-inlinemacro] 178 | <code>{passtext}</code> 179 | 180 | [tags] 181 | emphasis=<em{1? class="{1}"}>|</em> 182 | strong=<strong{1? class="{1}"}>|</strong> 183 | monospaced=<code{1? class="{1}"}>|</code> 184 | superscript=<sup{1? class="{1}"}>|</sup> 185 | subscript=<sub{1? class="{1}"}>|</sub> 186 | mark={1=<mark>}{1?<span class="{1}">}|{1?</span>}{1=</mark>} 187 | 188 | [monospacedwords] 189 | <code>{words}</code> 190 | 191 | ifdef::linkattrs[] 192 | [http-inlinemacro] 193 | <a href="{name}:{target}"{id? id="{id}"}{role? class="{role}"}{window? target="{window}"}>{1={name}:{target}}</a> 194 | [https-inlinemacro] 195 | <a href="{name}:{target}"{id? id="{id}"}{role? class="{role}"}{window? target="{window}"}>{1={name}:{target}}</a> 196 | [ftp-inlinemacro] 197 | <a href="{name}:{target}"{id? id="{id}"}{role? class="{role}"}{window? target="{window}"}>{1={name}:{target}}</a> 198 | [file-inlinemacro] 199 | <a href="{name}:{target}"{id? id="{id}"}{role? class="{role}"}{window? target="{window}"}>{1={name}:{target}}</a> 200 | [irc-inlinemacro] 201 | <a href="{name}:{target}"{id? id="{id}"}{role? class="{role}"}{window? target="{window}"}>{1={name}:{target}}</a> 202 | [mailto-inlinemacro] 203 | <a href="mailto:{target}"{id? id="{id}"}{role? class="{role}"}{window? target="{window}"}>{1={target}}</a> 204 | [link-inlinemacro] 205 | <a href="{target}"{id? id="{id}"}{role? class="{role}"}{window? target="{window}"}>{1={target}}</a> 206 | endif::linkattrs[] 207 | 208 | [listtags-numbered] 209 | list=<div class="olist{style? {style}}{compact-option? compact}{role? {role}}"{id? id="{id}"}>{title?<div class="title">{title}</div>}<ol class="{style}"{style@loweralpha: type="a"}{style@lowerroman: type="i"}{style@upperalpha: type="A"}{style@upperroman: type="I"}{start? start="{start}"}>|</ol></div> 210 | 211 | [tabletags-monospaced] 212 | paragraph=<p class="tableblock"><code>|</code></p> 213 | 214 | [sect0] 215 | <h1{id? id="{id}"} class="sect0">{title}</h1> 216 | | 217 | 218 | # support for document title in embedded documents 219 | ifeval::[not config.header_footer] 220 | [preamble] 221 | <h1>{title={doctitle}}</h1>{set:title-rendered:} 222 | <div id="preamble"> 223 | <div class="sectionbody"> 224 | | 225 | </div> 226 | {toc,toc2#}{toc-placement$preamble:}{template:toc} 227 | </div> 228 | 229 | [sect1] 230 | {title-rendered%}<h1>{doctitle}</h1> 231 | <div class="sect1{style? {style}}{role? {role}}"> 232 | <h2{id? id="{id}"}>{numbered?{sectnum} }{title}</h2> 233 | <div class="sectionbody"> 234 | | 235 | </div> 236 | </div> 237 | endif::[] 238 | 239 | # override to add the admonition name to the class attribute of the outer element 240 | [admonitionblock] 241 | <div class="admonitionblock {name}{role? {role}}{unbreakable-option? unbreakable}"{id? id="{id}"}> 242 | <table><tr> 243 | <td class="icon"> 244 | {data-uri%}{icons#}<img src="{icon={iconsdir}/{name}.png}" alt="{caption}"> 245 | {data-uri#}{icons#}<img alt="{caption}" src="data:image/png;base64, 246 | {data-uri#}{icons#}{sys:"{python}" -u -c "import base64,sys; base64.encode(sys.stdin,sys.stdout)" < "{eval:os.path.join(r"{indir={outdir}}",r"{icon={iconsdir}/{name}.png}")}"}"> 247 | {icons%}<div class="title">{caption}</div> 248 | </td> 249 | <td class="content"> 250 | <div class="title">{title}</div> 251 | | 252 | </td> 253 | </tr></table> 254 | </div> 255 | 256 | # modified so that: 257 | # a. imagesdir is only prepended if target is not a uri or absolute path (relative path only) 258 | # b. automatic alt text is calculated from basename of target without extension 259 | # note that the escaped_target attribute must be set in order to use a uri in the conditional attribute reference 260 | [image-inlinemacro] 261 | <span class="image{role? {role}}"{float? style="float: {float}"}>{set2:escaped_target:{eval:'{target}'.replace(':','\:')}} 262 | <a class="image" href="{link}"> 263 | {data-uri%}<img src="{target@^(/|https?\://).*:{escaped_target}:{imagesdir?{imagesdir}}{imagesdir?/}{escaped_target}}" alt="{alt={eval:os.path.splitext(os.path.basename('{target}'))[0]}}"{width? width="{width}"}{height? height="{height}"}{title? title="{title}"}> 264 | {data-uri#}<img alt="{alt={target}}"{width? width="{width}"}{height? height="{height}"}{title? title="{title}"} 265 | {data-uri#}{sys:"{python}" -u -c "import mimetypes,base64,sys; print 'src=\"data:'+mimetypes.guess_type(r'{target}')[0]+';base64,'; base64.encode(sys.stdin,sys.stdout)" < "{eval:os.path.join(r"{indir={outdir}}",r"{imagesdir=}",r"{target}")}"}"> 266 | {link#}</a> 267 | </span> 268 | 269 | # modified so that: 270 | # a. imagesdir is only prepended if target is not a uri or absolute path (relative path only) 271 | # b. automatic alt text is calculated from basename of target without extension 272 | # note that the escaped_target attribute must be set in order to use a uri in the conditional attribute reference 273 | [image-blockmacro] 274 | <div class="imageblock{style? {style}}{role? {role}}{unbreakable-option? unbreakable}"{id? id="{id}"}{align? style="text-align:{align};"}{float? style="float: {float}"}> 275 | <div class="content">{set2:escaped_target:{eval:'{target}'.replace(':','\:')}} 276 | <a class="image" href="{link}"> 277 | {data-uri%}<img src="{target@^(/|https?\://).*:{escaped_target}:{imagesdir?{imagesdir}}{imagesdir?/}{escaped_target}}" alt="{alt={eval:os.path.splitext(os.path.basename('{target}'))[0]}}"{width? width="{width}"}{height? height="{height}"}> 278 | {data-uri#}<img alt="{alt={target}}"{width? width="{width}"}{height? height="{height}"} 279 | {data-uri#}{sys:"{python}" -u -c "import mimetypes,base64,sys; print 'src=\"data:'+mimetypes.guess_type(r'{target}')[0]+';base64,'; base64.encode(sys.stdin,sys.stdout)" < "{eval:os.path.join(r"{indir={outdir}}",r"{imagesdir=}",r"{target}")}"}"> 280 | {link#}</a> 281 | </div> 282 | <div class="title">{caption={figure-caption} {counter:figure-number}. }{title}</div> 283 | </div> 284 | 285 | # a common template for emitting the attribute for a quote or verse block 286 | # don't output attribution div if attribution or citetitle are both empty 287 | [attribution] 288 | {attribution,citetitle#}<div class="attribution"> 289 | — {attribution}{citetitle?<br>} 290 | <cite>{citetitle}</cite> 291 | {attribution,citetitle#}</div> 292 | 293 | # override to use blockquote element for content and cite element for cite title 294 | [quoteblock] 295 | <div class="quoteblock{role? {role}}{unbreakable-option? unbreakable}"{id? id="{id}"}> 296 | <div class="title">{title}</div> 297 | <blockquote> 298 | | 299 | </blockquote> 300 | template::[attribution] 301 | </div> 302 | 303 | # override to use cite element for cite title 304 | [verseblock] 305 | <div class="verseblock{role? {role}}{unbreakable-option? unbreakable}"{id? id="{id}"}> 306 | <div class="title">{title}</div> 307 | <pre class="content"> 308 | | 309 | </pre> 310 | template::[attribution] 311 | </div> 312 | 313 | # override tabletags to support cellbgcolor 314 | [tabletags-default] 315 | headdata=<th class="tableblock halign-{halign=left} valign-{valign=top}"{colspan@1:: colspan="{colspan}"}{rowspan@1:: rowspan="{rowspan}"}{cellbgcolor? style="background-color:{cellbgcolor};"}>|</th> 316 | bodydata=<td class="tableblock halign-{halign=left} valign-{valign=top}"{colspan@1:: colspan="{colspan}"}{rowspan@1:: rowspan="{rowspan}"}{cellbgcolor? style="background-color:{cellbgcolor};"}>|</td> 317 | 318 | # override header cells to use th 319 | [tabletags-header] 320 | bodydata=<th class="tableblock halign-{halign=left} valign-{valign=top}" {colspan@1::colspan="{colspan}" }{rowspan@1::rowspan="{rowspan}" }>|</th> 321 | paragraph=<p class="tableblock">|</p> 322 | 323 | [toc] 324 | <div id="toc"> 325 | <div id="toctitle">{toc-title}</div> 326 | ifdef::toc2[] 327 | <script type="text/javascript"> 328 | document.body.className += ' toc2'; 329 | document.getElementById('toc').className = 'toc2'; 330 | </script> 331 | endif::toc2[] 332 | <noscript><p><b>JavaScript must be enabled in your browser to display the table of contents.</b></p></noscript> 333 | </div> 334 | 335 | endif::basebackend-html[] 336 | 337 | # Override docinfo to support subtitle 338 | ifdef::basebackend-docbook[] 339 | 340 | [sect5] 341 | <section{id? id="{id}"}{role? role="{role}"}{reftext? xreflabel="{reftext}"}> 342 | <title>{title} 343 | | 344 | 345 | 346 | [tags] 347 | monospaced=| 348 | subscript=| 349 | superscript=| 350 | 351 | [button-inlinemacro] 352 | {1} 353 | 354 | [keyboard-inlinemacro] 355 | {set2:keys:{eval:re.split(r'(?{1} 357 | {2%}{eval:len({keys}) == 2}{eval:{keys}[0].strip()}{eval:{keys}[1].strip()} 358 | {2%}{eval:len({keys}) == 3}{eval:{keys}[0].strip()}{eval:{keys}[1].strip()}{eval:{keys}[2].strip()} 359 | {2#}{3%}{1}{2} 360 | {3#}{1}{2}{3} 361 | 362 | [menu-inlinemacro] 363 | {1%}{target} 364 | {1#}{2%}{target} {1} 365 | {2#}{3%}{target} {1} {2} 366 | {3#}{target} {1} {2} {3} 367 | 368 | # override tabletags to support cellbgcolor 369 | [tabletags-default] 370 | headdata={cellbgcolor?}| 371 | bodydata={cellbgcolor?}| 372 | 373 | [docinfo] 374 | ifndef::notitle[] 375 | {set2:subtitle_offset:{eval:'{doctitle}'.rfind(': ')}} 376 | {eval:{subtitle_offset} != -1}{eval:'{doctitle}'[0:{subtitle_offset}]} 377 | {eval:{subtitle_offset} != -1}{eval:'{doctitle}'[{subtitle_offset} + 2:]} 378 | {eval:{subtitle_offset} < 0}{doctitle} 379 | endif::notitle[] 380 | {revdate} 381 | # To ensure valid articleinfo/bookinfo when there is no AsciiDoc header. 382 | {doctitle%}{revdate%}{docdate} 383 | {authored#} 384 | {firstname} 385 | {middlename} 386 | {lastname} 387 | {email} 388 | {authored#} 389 | {authorinitials} 390 | {revnumber?{revnumber}}{revdate}{authorinitials?{authorinitials}}{revremark?{revremark}} 391 | {docinfo1,docinfo2#}{include:{docdir}/docinfo.xml} 392 | {docinfo,docinfo2#}{include:{docdir}/{docname}-docinfo.xml} 393 | {orgname} 394 | 395 | endif::basebackend-docbook[] 396 | -------------------------------------------------------------------------------- /src/Marine.f90: -------------------------------------------------------------------------------- 1 | subroutine Marine() 2 | 3 | ! Marine transport component 4 | ! using silt and sand coupling diffusion solver 5 | ! developed by Xiaoping Yuan (2017-2018) 6 | 7 | use FastScapeContext 8 | 9 | implicit none 10 | 11 | double precision, dimension(:), allocatable :: flux,shelfdepth,ht,Fs,dh,dh1,dh2,Fmixt,mwater 12 | double precision, dimension(:), allocatable :: dhs, dhs1, F1, F2, zi, zo 13 | integer, dimension(:), allocatable :: COTflag,mmnrec,mmstack 14 | integer, dimension(:,:), allocatable :: mmrec 15 | double precision, dimension(:,:), allocatable :: mmwrec,mmlrec 16 | double precision shelfslope,ratio1,ratio2,dx,dy 17 | integer ij,ijr,ijk,k 18 | 19 | allocate (flux(nn),shelfdepth(nn),ht(nn),Fs(nn),dh(nn),dh1(nn),dh2(nn),Fmixt(nn),COTflag(nn)) 20 | allocate (dhs(nn),dhs1(nn),F1(nn),F2(nn),zi(nn),zo(nn)) 21 | 22 | ! set nodes at transition between ocean and continent 23 | COTflag=0 24 | 25 | dx=xl/(nx-1) 26 | dy=yl/(ny-1) 27 | 28 | ! computing flux from continental erosion 29 | flux=0.d0 30 | where (h.gt.sealevel) flux=Sedflux 31 | do ij=nn,1,-1 32 | ijk=stack(ij) 33 | ijr=rec(ijk) 34 | if (ijr.ne.ijk.and.h(ijk).gt.sealevel) then 35 | flux(ijr)=flux(ijr)+flux(ijk) 36 | endif 37 | enddo 38 | ! here the integral of erosion/deposition has been done 39 | ! and distributed as flux to ocean 40 | where (h.gt.sealevel) flux=0.d0 41 | 42 | ! set nodes at transition between ocean and continent 43 | !where (flux.gt.tiny(flux)) COTflag=1 44 | ! use single flow direction to set the flag that marks 45 | ! the recieving node below/at sealevel of a node above/at 46 | ! sealevel as a continent-ocean transition node. 47 | do ij=1,nn 48 | ijr=rec(ij) 49 | if (h(ij).ge.sealevel.and.h(ijr).le.sealevel) COTflag(ijr)=1 50 | enddo 51 | 52 | ! decompact volume of pure solid phase (silt and sand) from onshore 53 | ratio1=ratio/(1.d0-poro1) 54 | ratio2=(1.d0-ratio)/(1.d0-poro2) 55 | ! total volume of silt and sand after decompaction 56 | flux=flux*(ratio1+ratio2) 57 | 58 | ! modifications made by Jean for multiple flow to distribute continental flux to ocean on the shelf 59 | ! Dec 2018 60 | 61 | allocate (mmrec(8,nn),mmnrec(nn),mmwrec(8,nn),mmlrec(8,nn),mmstack(nn),mwater(nn)) 62 | 63 | call find_mult_rec (h,rec,stack,mwater,mmrec,mmnrec,mmwrec,mmlrec,mmstack,nx,ny,dx,dy,0.d0,p_mfd_exp, & 64 | bounds_i1, bounds_i2, bounds_j1, bounds_j2, bounds_xcyclic, bounds_ycyclic) 65 | 66 | !print*,count(flux>0.and.mmnrec==0),count(flux>0),count(mmstack==0) 67 | 68 | ! modifications made by Jean 69 | ! to compute shelf depth 70 | shelfdepth=sealevel 71 | shelfslope=-1.d-4 72 | do ij=1,nn 73 | ijk=mmstack(ij) 74 | do k=1,mmnrec(ijk) 75 | ijr=mmrec(k,ijk) 76 | if (h(ijk).lt.sealevel) then 77 | shelfdepth(ijr)=min(shelfdepth(ijr),shelfdepth(ijk)+mmlrec(k,ijk)*shelfslope) 78 | shelfdepth(ijr)=max(shelfdepth(ijr),h(ijr)) 79 | endif 80 | enddo 81 | enddo 82 | ! end modifications 83 | 84 | ! passes the flux across the shelf 85 | ! modifications made by Jean 86 | 87 | where (h.lt.sealevel) flux=flux+(h-shelfdepth) 88 | do ij=1,nn 89 | ijk=mmstack(ij) 90 | do k=1,mmnrec(ijk) 91 | ijr=mmrec(k,ijk) 92 | flux(ijr)=flux(ijr)+max(0.d0,flux(ijk)*mmwrec(k,ijk)) 93 | enddo 94 | enddo 95 | ! modifications made by Jean 96 | 97 | deallocate (mmrec,mmnrec,mmwrec,mmlrec,mmstack,mwater) 98 | 99 | where (flux.gt.0.d0.and.h.lt.sealevel) flux=-(h-shelfdepth) 100 | where (flux.le.0.d0.and.h.lt.sealevel) flux=flux-(h-shelfdepth) 101 | where (h.ge.sealevel) flux=0.d0 102 | flux=max(flux,0.d0) 103 | 104 | ! silt fraction (after decompaction) in shelf 105 | Fs=0.d0 106 | where (flux.gt.0.d0) Fs=ratio1/(ratio1+ratio2) 107 | 108 | ! scales flux by time step 109 | flux=flux/dt 110 | 111 | ! stores initial height and fraction 112 | ht=h 113 | Fmixt=Fmix 114 | 115 | !print*,'flux',minval(flux),sum(flux)/nx/ny,maxval(flux) 116 | !print*,'Fmix',minval(Fmix),sum(Fmix)/nx/ny,maxval(Fmix) 117 | 118 | ! silt and sand coupling diffusion in ocean 119 | call SiltSandCouplingDiffusion (h,Fmix,flux*Fs,flux*(1.d0-Fs), & 120 | nx,ny,dx,dy,dt,sealevel,layer,kdsea1,kdsea2,nGSMarine,COTflag,bounds_ibc) 121 | 122 | ! pure silt and sand during deposition/erosion 123 | dh1=((h-ht)*Fmix+layer*(Fmix-Fmixt))*(1.d0-poro1) 124 | dh2=((h-ht)*(1.d0-Fmix)+layer*(Fmixt-Fmix))*(1.d0-poro2) 125 | dh=dh1+dh2 126 | 127 | ! >>>>>>>> compaction starts added by Jean (Dec 2018) 128 | 129 | ! sum of pure silt and solid phase 130 | if (step.eq.0) then 131 | dhs1=dh1 132 | dhs=dh 133 | else 134 | dhs1=dhs1+dh1 135 | dhs=dhs+dh 136 | endif 137 | where (dhs1.lt.0.d0) dhs1=0.d0 138 | where (dhs.lt.0.d0) dhs=0.d0 139 | 140 | ! calculate the average silt (and sand) fraction in ocean part 141 | F1=0.d0;F2=0.d0 142 | where (h.le.sealevel.and.dhs.gt.0.d0) F1=dhs1/dhs 143 | F1=max(0.d0,F1);F1=min(1.d0,F1) 144 | where (h.le.sealevel.and.dhs.gt.0.d0) F2=1.d0-F1 145 | 146 | ! calculate the thickness after compaction, initial thickness of sediments 147 | !zi=ht-b 148 | !call compaction (F1,F2,poro1,poro2,zporo1,zporo2,nn,dh,zi,zo) 149 | ! update the elevation 150 | !h=b+zo 151 | 152 | ! >>>>>>>> compaction ends 153 | 154 | ! update the elevation 155 | !h=ht+dh 156 | etot=etot+ht-h 157 | erate=erate+(ht-h)/dt 158 | where (h.lt.sealevel) Sedflux=0.d0 159 | where (h.lt.sealevel) etot=0.d0 160 | where (h.lt.sealevel) erate=0.d0 161 | 162 | ! set the silt fraction in continent 163 | where (h.ge.sealevel+1.d-3) Fmix=0.d-1 164 | Fmix=max(0.d0,Fmix) 165 | Fmix=min(1.d0,Fmix) 166 | 167 | ! updates basement 168 | b=min(h,b) 169 | 170 | deallocate (flux,shelfdepth,ht,Fs,dh,dh1,dh2,Fmixt) 171 | 172 | return 173 | 174 | end subroutine Marine 175 | 176 | !---------------------------------------------------------------------------------- 177 | 178 | subroutine SiltSandCouplingDiffusion (h,f,Q1,Q2,nx,ny,dx,dy,dt, & 179 | sealevel,L,kdsea1,kdsea2,niter,COTflag,ibc) 180 | 181 | implicit none 182 | 183 | ! define the parameters 184 | integer i,j,ij,ipj,imj,ijp,ijm,nn,nx,ny,niter,ibc 185 | double precision h(nx*ny),f(nx*ny),Q1(nx*ny),Q2(nx*ny) 186 | double precision, dimension(:), allocatable :: hp,fp,ht,ft,hhalf,fhalf,fhalfp 187 | double precision, dimension(:), allocatable :: diag,sup,inf,rhs,res,tint 188 | integer COTflag(nx*ny) 189 | 190 | double precision dx,dy,dt,sealevel,L,kdsea1,kdsea2 191 | double precision K1,K2,tol,err1,err2 192 | double precision Ap,Bp,Cp,Dp,Ep,Mp,Np 193 | 194 | character cbc*4 195 | 196 | write (cbc,'(i4)') ibc 197 | 198 | K1=kdsea1 199 | K2=kdsea2 200 | 201 | nn=nx*ny 202 | 203 | allocate (hp(nn),fp(nn),ht(nn),ft(nn),hhalf(nn),fhalf(nn),fhalfp(nn),tint(nn)) 204 | 205 | ! initilize the elevation and silt fraction at time t and t+dt/2 206 | ht=h 207 | ft=f 208 | hhalf=h 209 | fhalf=f 210 | 211 | ! tolerance is in m 212 | tol=1.d0 213 | err1=2*tol 214 | err2=2*tol 215 | niter=0 216 | 217 | ! iteration until convergence is reached 218 | do while (err1.gt.tol) 219 | ! update the elevation and silt fraction during each iteration 220 | hp=h 221 | fp=f 222 | fhalfp=fhalf 223 | niter=niter+1 224 | ! calculate the elevation h in x-direction 225 | allocate (diag(nx),sup(nx),inf(nx),rhs(nx),res(nx)) 226 | do j=2,ny-1 227 | do i=1,nx 228 | ij=(j-1)*nx+i 229 | ipj=(j-1)*nx+i+1 230 | imj=(j-1)*nx+i-1 231 | ijp=(j)*nx+i 232 | ijm=(j-2)*nx+i 233 | ! in ocean and not at ocean-continent transition 234 | if (ht(ij).le.sealevel.and.COTflag(ij).eq.0) then 235 | if (i.eq.1) then 236 | if (cbc(4:4).eq.'1') then 237 | diag(i)=1.d0 238 | sup(i)=0.d0 239 | rhs(i)=ht(ij) 240 | else 241 | Ap=dt/2.d0*(K2+(K1-K2)*(fhalfp(ipj)+fhalfp(ij))/2.d0)/dx**2 242 | diag(i)=1.d0+Ap 243 | sup(i)=-Ap 244 | Cp=dt/2.d0*(K2+(K1-K2)*(ft(ijp)+ft(ij))/2.d0)*(ht(ijp)-ht(ij))/dy**2 & 245 | -dt/2.d0*(K2+(K1-K2)*(ft(ij)+ft(ijm))/2.d0)*(ht(ij)-ht(ijm))/dy**2 & 246 | +(Q1(ij)+Q2(ij))*dt/2.d0 247 | rhs(i)=Cp+ht(ij) 248 | endif 249 | elseif (i.eq.nx) then 250 | if (cbc(2:2).eq.'1') then 251 | diag(i)=1.d0 252 | inf(i)=0.d0 253 | rhs(i)=ht(ij) 254 | else 255 | Bp=-dt/2.d0*(K2+(K1-K2)*(fhalfp(ij)+fhalfp(imj))/2.d0)/dx**2 256 | diag(i)=1.d0-Bp 257 | inf(i)=Bp 258 | Cp=dt/2.d0*(K2+(K1-K2)*(ft(ijp)+ft(ij))/2.d0)*(ht(ijp)-ht(ij))/dy**2 & 259 | -dt/2.d0*(K2+(K1-K2)*(ft(ij)+ft(ijm))/2.d0)*(ht(ij)-ht(ijm))/dy**2 & 260 | +(Q1(ij)+Q2(ij))*dt/2.d0 261 | rhs(i)=Cp+ht(ij) 262 | endif 263 | else 264 | Ap=dt/2.d0*(K2+(K1-K2)*(fhalfp(ipj)+fhalfp(ij))/2.d0)/dx**2 265 | Bp=-dt/2.d0*(K2+(K1-K2)*(fhalfp(ij)+fhalfp(imj))/2.d0)/dx**2 266 | diag(i)=1.d0+Ap-Bp 267 | sup(i)=-Ap 268 | inf(i)=Bp 269 | Cp=dt/2.d0*(K2+(K1-K2)*(ft(ijp)+ft(ij))/2.d0)*(ht(ijp)-ht(ij))/dy**2 & 270 | -dt/2.d0*(K2+(K1-K2)*(ft(ij)+ft(ijm))/2.d0)*(ht(ij)-ht(ijm))/dy**2 & 271 | +(Q1(ij)+Q2(ij))*dt/2.d0 272 | rhs(i)=Cp+ht(ij) 273 | endif 274 | ! in continent 275 | else 276 | diag(i)=1.d0 277 | sup(i)=0.d0 278 | inf(i)=0.d0 279 | rhs(i)=ht(ij) 280 | endif 281 | enddo 282 | ! solve a tri-diagonal system of equations 283 | call tridag (inf,diag,sup,rhs,res,nx) 284 | do i=1,nx 285 | ij=(j-1)*nx+i 286 | hhalf(ij)=res(i) 287 | enddo 288 | enddo 289 | tint=hhalf 290 | ! the corner nodes (1,1) and (1,ny) 291 | hhalf(1)=hhalf(2) 292 | hhalf((ny-1)*nx+1)=hhalf((ny-1)*nx+2) 293 | ! the corner nodes (nx,1) and (nx,ny) 294 | hhalf(nx)=hhalf(nx-1) 295 | hhalf(nx*ny)=hhalf(nx*ny-1) 296 | deallocate (diag,sup,inf,rhs,res) 297 | 298 | ! calculate the silt fraction F in x-direction 299 | allocate (diag(nx),sup(nx),inf(nx),rhs(nx),res(nx)) 300 | do j=2,ny-1 301 | do i=2,nx-1 302 | ij=(j-1)*nx+i 303 | ipj=(j-1)*nx+i+1 304 | imj=(j-1)*nx+i-1 305 | ijp=(j)*nx+i 306 | ijm=(j-2)*nx+i 307 | ! in ocean and not at ocean-continent transition 308 | if (ht(ij).le.sealevel.and.COTflag(ij).eq.0) then 309 | ! deposition 310 | if (hhalf(ij).ge.(1.d0+1.d-6)*ht(ij)) then 311 | Dp=(hhalf(ij)-ht(ij))/dt 312 | Ep=K1/2.d0*(hhalf(ipj)-hhalf(ij))/dx**2 313 | Mp=-K1/2.d0*(hhalf(ij)-hhalf(imj))/dx**2 314 | Np=K1/2.d0*(ft(ijp)+ft(ij))*(ht(ijp)-ht(ij))/dy**2 & 315 | -K1/2.d0*(ft(ij)+ft(ijm))*(ht(ij)-ht(ijm))/dy**2 & 316 | +Q1(ij) 317 | diag(i)=2.d0*L/dt+Dp-Mp-Ep 318 | sup(i)=-Ep 319 | inf(i)=-Mp 320 | rhs(i)=Np-Dp*ft(ij)+2.d0*L*ft(ij)/dt 321 | ! erosion 322 | else 323 | diag(i)=1.d0 324 | sup(i)=0.d0 325 | inf(i)=0.d0 326 | rhs(i)=ft(ij) 327 | endif 328 | ! in continent 329 | else 330 | diag(i)=1.d0 331 | sup(i)=0.d0 332 | inf(i)=0.d0 333 | rhs(i)=ft(ij) 334 | endif 335 | enddo 336 | ! bc on i=1 337 | diag(1)=1.d0 338 | sup(1)=-1.d0 339 | rhs(1)=0.d0 340 | ! bc on i=nx 341 | diag(nx)=1.d0 342 | inf(nx)=-1.d0 343 | rhs(nx)=0.d0 344 | ! solve a tri-diagonal system of equations 345 | call tridag (inf,diag,sup,rhs,res,nx) 346 | do i=1,nx 347 | ij=(j-1)*nx+i 348 | fhalf(ij)=res(i) 349 | enddo 350 | enddo 351 | fhalf=max(0.d0,fhalf) 352 | fhalf=min(1.d0,fhalf) 353 | deallocate (diag,sup,inf,rhs,res) 354 | 355 | ! calculate the elevation h in y-direction 356 | allocate (diag(ny),sup(ny),inf(ny),rhs(ny),res(ny)) 357 | do i=2,nx-1 358 | do j=1,ny 359 | ij=(j-1)*nx+i 360 | ipj=(j-1)*nx+i+1 361 | imj=(j-1)*nx+i-1 362 | ijp=(j)*nx+i 363 | ijm=(j-2)*nx+i 364 | ! in ocean and not at ocean-continent transition 365 | if (ht(ij).le.sealevel.and.COTflag(ij).eq.0) then 366 | if (j.eq.1) then 367 | if (cbc(1:1).eq.'1') then 368 | diag(j)=1.d0 369 | sup(j)=0.d0 370 | rhs(j)=hhalf(ij) 371 | else 372 | Ap=dt/2.d0*(K2+(K1-K2)*(fp(ijp)+fp(ij))/2.d0)/dy**2 373 | diag(j)=1.d0+Ap 374 | sup(j)=-Ap 375 | Cp=dt/2.d0*(K2+(K1-K2)*(fhalf(ipj)+fhalf(ij))/2.d0)*(hhalf(ipj)-hhalf(ij))/dx**2 & 376 | -dt/2.d0*(K2+(K1-K2)*(fhalf(ij)+fhalf(imj))/2.d0)*(hhalf(ij)-hhalf(imj))/dx**2 & 377 | +(Q1(ij)+Q2(ij))*dt/2.d0 378 | rhs(j)=Cp+hhalf(ij) 379 | endif 380 | elseif (j.eq.ny) then 381 | if (cbc(3:3).eq.'1') then 382 | diag(j)=1.d0 383 | inf(j)=0.d0 384 | rhs(j)=hhalf(ij) 385 | else 386 | Bp=-dt/2.d0*(K2+(K1-K2)*(fp(ij)+fp(ijm))/2.d0)/dy**2 387 | diag(j)=1.d0-Bp 388 | inf(j)=Bp 389 | Cp=dt/2.d0*(K2+(K1-K2)*(fhalf(ipj)+fhalf(ij))/2.d0)*(hhalf(ipj)-hhalf(ij))/dx**2 & 390 | -dt/2.d0*(K2+(K1-K2)*(fhalf(ij)+fhalf(imj))/2.d0)*(hhalf(ij)-hhalf(imj))/dx**2 & 391 | +(Q1(ij)+Q2(ij))*dt/2.d0 392 | rhs(j)=Cp+hhalf(ij) 393 | endif 394 | else 395 | Ap=dt/2.d0*(K2+(K1-K2)*(fp(ijp)+fp(ij))/2.d0)/dy**2 396 | Bp=-dt/2.d0*(K2+(K1-K2)*(fp(ij)+fp(ijm))/2.d0)/dy**2 397 | diag(j)=1.d0+Ap-Bp 398 | sup(j)=-Ap 399 | inf(j)=Bp 400 | Cp=dt/2.d0*(K2+(K1-K2)*(fhalf(ipj)+fhalf(ij))/2.d0)*(hhalf(ipj)-hhalf(ij))/dx**2 & 401 | -dt/2.d0*(K2+(K1-K2)*(fhalf(ij)+fhalf(imj))/2.d0)*(hhalf(ij)-hhalf(imj))/dx**2 & 402 | +(Q1(ij)+Q2(ij))*dt/2.d0 403 | rhs(j)=Cp+hhalf(ij) 404 | endif 405 | ! in continent 406 | else 407 | diag(j)=1.d0 408 | sup(j)=0.d0 409 | inf(j)=0.d0 410 | rhs(j)=hhalf(ij) 411 | endif 412 | enddo 413 | ! solve a tri-diagonal system of equations 414 | call tridag (inf,diag,sup,rhs,res,ny) 415 | do j=1,ny 416 | ij=(j-1)*nx+i 417 | tint(ij)=res(j) 418 | enddo 419 | enddo 420 | h=tint 421 | ! the corner nodes (1,1) and (1,ny) 422 | h(1)=h(2) 423 | h((ny-1)*nx+1)=h((ny-1)*nx+2) 424 | ! the corner nodes (nx,1) and (nx,ny) 425 | h(nx)=h(nx-1) 426 | h(nx*ny)=h(nx*ny-1) 427 | deallocate (diag,sup,inf,rhs,res) 428 | 429 | ! calculate the silt fraction F in y-direction 430 | allocate (diag(ny),sup(ny),inf(ny),rhs(ny),res(ny)) 431 | do i=2,nx-1 432 | do j=2,ny-1 433 | ij=(j-1)*nx+i 434 | ipj=(j-1)*nx+i+1 435 | imj=(j-1)*nx+i-1 436 | ijp=(j)*nx+i 437 | ijm=(j-2)*nx+i 438 | ! in ocean and not at ocean-continent transition 439 | if (ht(ij).le.sealevel.and.COTflag(ij).eq.0) then 440 | ! deposition 441 | if (h(ij).ge.(1.d0+1.d-6)*hhalf(ij)) then 442 | Dp=(h(ij)-hhalf(ij))/dt 443 | Ep=K1/2.d0*(h(ijp)-h(ij))/dy**2 444 | Mp=-K1/2.d0*(h(ij)-h(ijm))/dy**2 445 | Np=K1/2.d0*(fhalf(ipj)+fhalf(ij))*(hhalf(ipj)-hhalf(ij))/dx**2 & 446 | -K1/2.d0*(fhalf(ij)+fhalf(imj))*(hhalf(ij)-hhalf(imj))/dx**2 & 447 | +Q1(ij) 448 | diag(j)=2.d0*L/dt+Dp-Mp-Ep 449 | sup(j)=-Ep 450 | inf(j)=-Mp 451 | rhs(j)=Np-Dp*fhalf(ij)+2.d0*L*fhalf(ij)/dt 452 | ! erosion 453 | else 454 | diag(j)=1.d0 455 | sup(j)=0.d0 456 | inf(j)=0.d0 457 | rhs(j)=fhalf(ij) 458 | endif 459 | ! in continent 460 | else 461 | diag(j)=1.d0 462 | sup(j)=0.d0 463 | inf(j)=0.d0 464 | rhs(j)=fhalf(ij) 465 | endif 466 | enddo 467 | ! bc on j=1 468 | diag(1)=1.d0 469 | sup(1)=-1.d0 470 | rhs(1)=0.d0 471 | ! bc on j=ny 472 | diag(ny)=1.d0 473 | inf(ny)=-1.d0 474 | rhs(ny)=0.d0 475 | ! solve a tri-diagonal system of equations 476 | call tridag (inf,diag,sup,rhs,res,ny) 477 | do j=1,ny 478 | ij=(j-1)*nx+i 479 | f(ij)=res(j) 480 | enddo 481 | enddo 482 | f=max(0.d0,f) 483 | f=min(1.d0,f) 484 | deallocate (diag,sup,inf,rhs,res) 485 | 486 | ! calculate the errors in each iteration 487 | err1=maxval(abs(h-hp)) 488 | err2=maxval(abs(h-hp)/(1.d0+abs(h))) 489 | 490 | !print*,'niter',niter,minval(h-hp),sum(h-hp)/nn,maxval(h-hp),err1 491 | 492 | if (niter.gt.1000) then 493 | print*,'Multi-lithology diffusion not convergning; decrease time step' 494 | stop 495 | endif 496 | 497 | ! end of iteration 498 | enddo 499 | 500 | ! set the silt fraction for continent 501 | where (h.ge.sealevel+1.d-3) f=0.d-1 502 | 503 | deallocate (hp,fp,ht,ft,hhalf,fhalf,fhalfp) 504 | 505 | ! end of the subroutine 506 | end subroutine SiltSandCouplingDiffusion 507 | 508 | !----------------------------------------------------- 509 | 510 | subroutine compaction (F1,F2,poro1,poro2,z1,z2,nn,dh,zi,zo) 511 | 512 | ! Newton iteration to calculate the thickness after compaction 513 | 514 | implicit none 515 | 516 | integer k,nn 517 | double precision poro1,poro2,z1,z2,fx,dfx 518 | double precision F1(nn),F2(nn),dh(nn),zi(nn),zo(nn) 519 | 520 | ! initial guess on zo 521 | zo=zi 522 | ! iteration process 523 | do k=1,nn 524 | 1000 continue 525 | fx=zo(k)-zi(k)+F1(k)*poro1*z1*(exp(-zo(k)/z1)-exp(-zi(k)/z1)) & 526 | +F2(k)*poro2*z2*(exp(-zo(k)/z2)-exp(-zi(k)/z2))-dh(k) 527 | dfx=1.d0-F1(k)*poro1*exp(-zo(k)/z1)-F2(k)*poro2*exp(-zo(k)/z2) 528 | zo(k)=zo(k)-fx/dfx 529 | if (abs(fx/dfx).gt.1.d-6) goto 1000 530 | enddo 531 | 532 | return 533 | 534 | end subroutine compaction 535 | -------------------------------------------------------------------------------- /src/FastScape_api.f90: -------------------------------------------------------------------------------- 1 | ! FastScape API 2 | 3 | ! ----------------------------------------------------------------------------------------- 4 | 5 | ! contains a series of subroutines that can be accessed from outside FastScape 6 | ! to setup, run and close FastScape when used as a subroutine from another program 7 | 8 | ! subroutines and their functions 9 | 10 | ! FastScape_Init () 11 | ! Must be called before any other routine to initialize nx, ny and step 12 | 13 | ! FastScape_SetUp () 14 | ! Must be called to allocate memory for all internal arrays 15 | ! can only be called once FastScapeSetNXNY has been used to set up nx and ny 16 | 17 | ! FastScape_Execute_Step () 18 | ! Executes a single step solving the SPL and diffusion equations 19 | 20 | ! FastScape_Destroy () 21 | ! Must be called to deallocate memory 22 | 23 | ! FastScape_View () 24 | ! prints to standard output the value of nx,ny,nn,step,xl,yl,dt,K,m,n,kd,ibc 25 | ! as well as min, mean and max values of h and u 26 | 27 | ! FastScape_Set_NX_NY (nx,ny) 28 | ! sets the value of nx and ny, the rectangular grid dimensions 29 | ! nx and ny are integer 30 | 31 | ! FastScape_Set_XL_YL (xl,yl) 32 | ! sets the value of xl,yl, the rectangular grid extent (in m) 33 | ! xl and yl are double precision 34 | 35 | ! FastScape_Set_Erosional_Parameters (k1,k2,m,n,kd1,kd2,g1,g2) 36 | ! sets the value of the erosional parameters 37 | ! k1,k2 are rate coefficient in the stream power law (in m^(1-2*m)/yr) for bedrock and sediment respectively 38 | ! m is the area exponent in the stream power law 39 | ! kd1, kd2 are the hillslope transport coefficient or diffusivity (in m^2/yr) for bedrock and sediment respectively 40 | ! g1, g2 are the sediment fluvial transport/deposition coefficients (dimensionless) for bedrock and sediment respectively 41 | ! all parameters are double precision 42 | 43 | ! FastScape_Set_Marine_Parameters (sealevel, poro1, poro2, zporo1, zporo2, ratio, length, kds1, kds2) 44 | ! sets the value of the marine transport parameters 45 | ! sl is sea level (in m) 46 | ! poro1 is surface porosity for silt (dimensionless) 47 | ! poro2 is surface porosity for sand (dimensionless) 48 | ! zporo1 is e-folding porosity depth for silt (in m) 49 | ! zporo2 is e-folding porosity depth for sand (in m) 50 | ! ratio is the ratio of sand in the incoming flux from the continent (dimensionless) 51 | ! length is the thickness of the "mixed" surface layer (in m) at the bottom of the ocean 52 | ! kds1 and kds2 are the marine transport coefficients (diffusivities) for silt and sand respectively (in m^2/yr) 53 | 54 | ! FastScape_Set_DT (dt) 55 | ! sets the time step length (in yr) 56 | ! dt is double precision 57 | 58 | ! FastScape_Set_BC (ibc) 59 | ! sets the boundary conditions 60 | ! two types are allowed (0 is reflective bc and 1 is fixed base level) 61 | ! ibc should be an integer made of 0 and 1 corresponding to the four boundaries in the 62 | ! following order: bottom, right, top and left 63 | ! ibc is integer 64 | 65 | ! FastScape_Set_U (u) 66 | ! sets the uplift velocity/rate (in m/yr) 67 | ! an array of dimension nn(=nx*ny) should be passed 68 | ! u is double precision of size nn 69 | 70 | ! FastScape_Set_V (vx,vy) 71 | ! sets the x- and y-direction advection velocities/rates (in m/yr) 72 | ! two array of dimension nn(=nx*ny) should be passed 73 | ! vx and vy are double precision of size nn 74 | 75 | ! FastScape_Init_H (h) 76 | ! sets the initial topography (in m) as well as the basement heigh to h 77 | ! an array of dimension nn(=nx*ny) should be passed 78 | ! h is double precision of size nn 79 | 80 | ! FastScape_Init_F (F) 81 | ! sets the initial silt fraction to F 82 | ! an array of dimension nn(=nx*ny) should be passed 83 | ! F is double precision of size nn 84 | 85 | ! FastScape_Copy_H (h) 86 | ! returns the current topographic height (in m) 87 | ! as an array of dimension nn(=nx*ny) 88 | ! h is double precision of size nn 89 | 90 | ! FastScape_Copy_Basement (b) 91 | ! returns the current basement height (in m) 92 | ! as an array of dimension nn(=nx*ny) 93 | ! b is double precision of size nn 94 | 95 | ! FastScape_Copy_F (F) 96 | ! returns the current surface silt fraction (in m) 97 | ! as an array of dimension nn(=nx*ny) 98 | ! F is double precision of size nn 99 | 100 | ! FastScape_Copy_Etot (etot) 101 | ! returns the current cumulative erosion (in m) 102 | ! as an array of dimension nn(=nx*ny) 103 | ! etot is double precision of size nn 104 | 105 | ! FastScape_Reset_Cumulative_Erosion () 106 | ! resets current cumulative erosion 107 | 108 | ! FastScape_Copy_Area (area) 109 | ! returns the drainage area at each point (in m^2) 110 | ! as an array of dimension nn(=nx*ny) 111 | ! area is double precision of size nn 112 | 113 | ! FastScape_Copy_Erate (erate) 114 | ! returns the current erosion rate (in m/yr) 115 | ! as an array of dimension nn(=nx*ny) 116 | ! erate is double precision of size nn 117 | 118 | ! FastScape_Get_Sizes (nx,ny) 119 | ! returns the value of the grid size 120 | ! nx and ny are integer 121 | 122 | ! FastScape_Get_Step (step) 123 | ! returns the value of the current time step 124 | ! step is integer 125 | 126 | ! FastScape_Set_H (h) 127 | ! resets the surface topography (in m) 128 | ! an array of dimension nn(=nx*ny) should be passed 129 | ! h is double precision of size nn 130 | 131 | ! FastScape_Set_Basement (b) 132 | ! resets the basement topography (in m) 133 | ! an array of dimension nn(=nx*ny) should be passed 134 | ! b is double precision of size nn 135 | 136 | ! FastScape_Set_Precip (p) 137 | ! resets the precipitation rate (in m/yr) 138 | ! an array of dimension nn(=nx*ny) should be passed 139 | ! p is double precision of size nn 140 | 141 | ! FastScape_Debug() 142 | ! writes debugging information to the default output 143 | 144 | ! ----------------------------------------------------------------------------------------- 145 | 146 | subroutine FastScape_Init() 147 | 148 | use FastScapeContext 149 | 150 | implicit none 151 | 152 | call Init() 153 | 154 | return 155 | 156 | end subroutine FastScape_Init 157 | 158 | !-------------------------------------------------------------------------- 159 | 160 | subroutine FastScape_Setup() 161 | 162 | use FastScapeContext 163 | 164 | implicit none 165 | 166 | call SetUp() 167 | 168 | return 169 | 170 | end subroutine FastScape_Setup 171 | 172 | !-------------------------------------------------------------------------- 173 | 174 | subroutine FastScape_Destroy() 175 | 176 | use FastScapeContext 177 | 178 | implicit none 179 | 180 | call Destroy() 181 | 182 | return 183 | 184 | end subroutine FastScape_Destroy 185 | 186 | !-------------------------------------------------------------------------- 187 | 188 | subroutine FastScape_View() 189 | 190 | use FastScapeContext 191 | 192 | implicit none 193 | 194 | call View() 195 | 196 | return 197 | 198 | end subroutine FastScape_View 199 | 200 | !-------------------------------------------------------------------------- 201 | subroutine FastScape_Execute_Step() 202 | 203 | use FastScapeContext 204 | 205 | implicit none 206 | 207 | real :: time_in, time_out 208 | 209 | if (runAdvect) then 210 | call cpu_time (time_in) 211 | call Advect () 212 | call cpu_time (time_out) 213 | timeAdvect = timeAdvect + time_out-time_in 214 | endif 215 | 216 | if (runUplift) then 217 | call cpu_time (time_in) 218 | call Uplift() 219 | call cpu_time (time_out) 220 | timeUplift = timeUplift + time_out-time_in 221 | endif 222 | 223 | if (runSPL) then 224 | call cpu_time (time_in) 225 | if (SingleFlowDirection) then 226 | call FlowRoutingSingleFlowDirection () 227 | call FlowAccumulationSingleFlowDirection () 228 | call StreamPowerLawSingleFlowDirection () 229 | else 230 | call FlowRouting () 231 | call FlowAccumulation () 232 | call StreamPowerLaw () 233 | endif 234 | call cpu_time (time_out) 235 | timeSPL = timeSPL + time_out-time_in 236 | endif 237 | 238 | if (runDiffusion) then 239 | call cpu_time (time_in) 240 | call Diffusion () 241 | call cpu_time (time_out) 242 | timeDiffusion = timeDiffusion + time_out-time_in 243 | endif 244 | 245 | if (runMarine) then 246 | call cpu_time (time_in) 247 | call Marine () 248 | call cpu_time (time_out) 249 | timeMarine = timeMarine + time_out-time_in 250 | endif 251 | 252 | if (runStrati) then 253 | call cpu_time (time_in) 254 | call Run_Strati () 255 | call cpu_time (time_out) 256 | timeStrati = timeStrati + time_out-time_in 257 | endif 258 | 259 | step=step+1 260 | 261 | return 262 | 263 | end subroutine FastScape_Execute_Step 264 | 265 | !-------------------------------------------------------------------------- 266 | 267 | subroutine FastScape_Init_H(hp) 268 | 269 | use FastScapeContext 270 | 271 | implicit none 272 | 273 | double precision, intent(inout), dimension(*) :: hp 274 | 275 | call InitH(hp) 276 | 277 | return 278 | 279 | end subroutine FastScape_Init_H 280 | 281 | !-------------------------------------------------------------------------- 282 | 283 | subroutine FastScape_Init_F(Fmixp) 284 | 285 | use FastScapeContext 286 | 287 | implicit none 288 | 289 | double precision, intent(inout), dimension(*) :: Fmixp 290 | 291 | call InitF (Fmixp) 292 | 293 | return 294 | 295 | end subroutine FastScape_Init_F 296 | 297 | !-------------------------------------------------------------------------- 298 | 299 | subroutine FastScape_Copy_H(hp) 300 | 301 | use FastScapeContext 302 | 303 | implicit none 304 | 305 | double precision, intent(inout), dimension(*) :: hp 306 | 307 | call CopyH(hp) 308 | 309 | return 310 | 311 | end subroutine FastScape_Copy_H 312 | 313 | !-------------------------------------------------------------------------- 314 | 315 | subroutine FastScape_Copy_Basement(bp) 316 | 317 | use FastScapeContext 318 | 319 | implicit none 320 | 321 | double precision, intent(inout), dimension(*) :: bp 322 | 323 | call CopyBasement(bp) 324 | 325 | return 326 | 327 | end subroutine FastScape_Copy_Basement 328 | 329 | !-------------------------------------------------------------------------- 330 | 331 | subroutine FastScape_Copy_Total_Erosion (etotp) 332 | 333 | use FastScapeContext 334 | 335 | implicit none 336 | 337 | double precision, intent(inout), dimension(*) :: etotp 338 | 339 | call CopyEtot(etotp) 340 | 341 | return 342 | 343 | end subroutine FastScape_Copy_Total_Erosion 344 | 345 | !-------------------------------------------------------------------------- 346 | 347 | subroutine FastScape_Copy_Drainage_Area (ap) 348 | 349 | use FastScapeContext 350 | 351 | implicit none 352 | 353 | double precision, intent(inout), dimension(*) :: ap 354 | 355 | call CopyArea(ap) 356 | 357 | return 358 | 359 | end subroutine FastScape_Copy_Drainage_Area 360 | 361 | !-------------------------------------------------------------------------- 362 | 363 | subroutine FastScape_Copy_Erosion_Rate (eratep) 364 | 365 | use FastScapeContext 366 | 367 | implicit none 368 | 369 | double precision, intent(inout), dimension(*) :: eratep 370 | 371 | call CopyERate(eratep) 372 | 373 | return 374 | 375 | end subroutine FastScape_Copy_Erosion_Rate 376 | 377 | !-------------------------------------------------------------------------- 378 | 379 | subroutine FastScape_Copy_Chi (chip) 380 | 381 | use FastScapeContext 382 | 383 | implicit none 384 | 385 | double precision, intent(inout), dimension(*) :: chip 386 | 387 | call CopyChi(chip) 388 | 389 | return 390 | 391 | end subroutine FastScape_Copy_Chi 392 | 393 | !-------------------------------------------------------------------------- 394 | 395 | subroutine FastScape_Copy_Slope (slopep) 396 | 397 | use FastScapeContext 398 | 399 | implicit none 400 | 401 | double precision, intent(inout), dimension(*) :: slopep 402 | 403 | call CopySlope(slopep) 404 | 405 | return 406 | 407 | end subroutine FastScape_Copy_Slope 408 | 409 | !-------------------------------------------------------------------------- 410 | 411 | subroutine FastScape_Copy_Curvature (curvaturep) 412 | 413 | use FastScapeContext 414 | 415 | implicit none 416 | 417 | double precision, intent(inout), dimension(*) :: curvaturep 418 | 419 | call CopyCurvature(curvaturep) 420 | 421 | return 422 | 423 | end subroutine FastScape_Copy_Curvature 424 | 425 | !-------------------------------------------------------------------------- 426 | 427 | subroutine FastScape_Copy_Catchment (catchp) 428 | 429 | use FastScapeContext 430 | 431 | implicit none 432 | 433 | double precision, intent(inout), dimension(*) :: catchp 434 | 435 | call CopyCatchment (catchp) 436 | 437 | return 438 | 439 | end subroutine FastScape_Copy_Catchment 440 | 441 | !-------------------------------------------------------------------------- 442 | 443 | subroutine FastScape_Copy_F(Fmixp) 444 | 445 | use FastScapeContext 446 | 447 | implicit none 448 | 449 | double precision, intent(inout), dimension(*) :: Fmixp 450 | 451 | call CopyF(Fmixp) 452 | 453 | return 454 | 455 | end subroutine FastScape_Copy_F 456 | 457 | !-------------------------------------------------------------------------- 458 | 459 | subroutine FastScape_Copy_Lake_Depth(Lp) 460 | 461 | use FastScapeContext 462 | 463 | implicit none 464 | 465 | double precision, intent(inout), dimension(*) :: Lp 466 | 467 | call CopyLakeDepth(Lp) 468 | 469 | return 470 | 471 | end subroutine FastScape_Copy_Lake_Depth 472 | 473 | !-------------------------------------------------------------------------- 474 | 475 | subroutine FastScape_Set_NX_NY (nnx,nny) 476 | 477 | use FastScapeContext 478 | 479 | implicit none 480 | 481 | integer, intent(in) :: nnx,nny 482 | 483 | call SetNXNY (nnx,nny) 484 | 485 | return 486 | 487 | end subroutine FastScape_Set_NX_NY 488 | 489 | !-------------------------------------------------------------------------- 490 | 491 | subroutine FastScape_Set_XL_YL (xxl,yyl) 492 | 493 | use FastScapeContext 494 | 495 | implicit none 496 | 497 | double precision, intent(in) :: xxl,yyl 498 | 499 | call SetXLYL (xxl,yyl) 500 | 501 | return 502 | 503 | end subroutine FastScape_Set_XL_YL 504 | 505 | !-------------------------------------------------------------------------- 506 | 507 | subroutine FastScape_Set_DT (dtt) 508 | 509 | use FastScapeContext 510 | 511 | implicit none 512 | 513 | double precision, intent(in) :: dtt 514 | 515 | call SetDT (dtt) 516 | 517 | return 518 | 519 | end subroutine FastScape_Set_DT 520 | 521 | !-------------------------------------------------------------------------- 522 | 523 | subroutine FastScape_Set_Erosional_Parameters (kkf,kkfsed,mm,nnn,kkd,kkdsed,gg1,gg2,pp) 524 | 525 | use FastScapeContext 526 | 527 | implicit none 528 | 529 | double precision, intent(in), dimension(*) :: kkf,kkd 530 | double precision, intent(in) :: kkfsed,mm,nnn,kkdsed,gg1,gg2,pp 531 | 532 | call SetErosionalParam (kkf,kkfsed,mm,nnn,kkd,kkdsed,gg1,gg2,pp) 533 | 534 | return 535 | 536 | end subroutine FastScape_Set_Erosional_Parameters 537 | 538 | !-------------------------------------------------------------------------- 539 | 540 | subroutine FastScape_Set_Marine_Parameters (sl, p1, p2, z1, z2, r, l, kds1, kds2) 541 | 542 | use FastScapeContext 543 | 544 | implicit none 545 | 546 | double precision, intent(in) :: sl, p1, p2, z1, z2, r, l, kds1, kds2 547 | 548 | call SetMarineParam (sl, p1, p2, z1, z2, r, l, kds1, kds2) 549 | 550 | return 551 | 552 | end subroutine FastScape_Set_Marine_Parameters 553 | 554 | !-------------------------------------------------------------------------- 555 | 556 | subroutine FastScape_Get_Sizes (nnx,nny) 557 | 558 | use FastScapeContext 559 | 560 | implicit none 561 | 562 | integer, intent(out) :: nnx,nny 563 | 564 | call GetSizes (nnx,nny) 565 | 566 | return 567 | 568 | end subroutine FastScape_Get_Sizes 569 | 570 | !-------------------------------------------------------------------------- 571 | 572 | subroutine FastScape_Get_Step (sstep) 573 | 574 | use FastScapeContext 575 | 576 | implicit none 577 | 578 | integer, intent(out) :: sstep 579 | 580 | call GetStep (sstep) 581 | 582 | return 583 | 584 | end subroutine FastScape_Get_Step 585 | 586 | !-------------------------------------------------------------------------- 587 | 588 | subroutine FastScape_Debug() 589 | 590 | use FastScapeContext 591 | 592 | implicit none 593 | 594 | call Debug() 595 | 596 | return 597 | 598 | end subroutine FastScape_Debug 599 | 600 | !-------------------------------------------------------------------------- 601 | 602 | subroutine FastScape_Set_BC(jbc) 603 | 604 | use FastScapeContext 605 | 606 | implicit none 607 | 608 | integer, intent(in) :: jbc 609 | 610 | call SetBC (jbc) 611 | 612 | return 613 | 614 | end subroutine FastScape_Set_BC 615 | 616 | !-------------------------------------------------------------------------- 617 | 618 | subroutine FastScape_Set_U (up) 619 | 620 | use FastScapeContext 621 | 622 | implicit none 623 | 624 | double precision, intent(in), dimension(*) :: up 625 | 626 | call SetU(up) 627 | 628 | return 629 | 630 | end subroutine FastScape_Set_U 631 | 632 | !-------------------------------------------------------------------------- 633 | 634 | subroutine FastScape_Set_V (ux,uy) 635 | 636 | use FastScapeContext 637 | 638 | implicit none 639 | 640 | double precision, intent(in), dimension(*) :: ux,uy 641 | 642 | call SetV(ux,uy) 643 | 644 | return 645 | 646 | end subroutine FastScape_Set_V 647 | 648 | !-------------------------------------------------------------------------- 649 | 650 | subroutine FastScape_Reset_Cumulative_Erosion () 651 | 652 | use FastScapeContext 653 | 654 | implicit none 655 | 656 | call ResetCumulativeErosion () 657 | 658 | return 659 | 660 | end subroutine FastScape_Reset_Cumulative_Erosion 661 | 662 | !-------------------------------------------------------------------------- 663 | 664 | subroutine FastScape_Set_H(hp) 665 | 666 | use FastScapeContext 667 | 668 | implicit none 669 | 670 | double precision, intent(inout), dimension(*) :: hp 671 | 672 | call SetH(hp) 673 | 674 | return 675 | 676 | end subroutine FastScape_Set_H 677 | 678 | !-------------------------------------------------------------------------- 679 | 680 | subroutine FastScape_Set_All_Layers (dhp) 681 | 682 | use FastScapeContext 683 | 684 | implicit none 685 | 686 | double precision, intent(inout), dimension(*) :: dhp 687 | 688 | call SetAllLayers(dhp) 689 | 690 | return 691 | 692 | end subroutine FastScape_Set_All_Layers 693 | 694 | !-------------------------------------------------------------------------- 695 | 696 | subroutine FastScape_Set_Basement(bp) 697 | 698 | use FastScapeContext 699 | 700 | implicit none 701 | 702 | double precision, intent(inout), dimension(*) :: bp 703 | 704 | call SetBasement(bp) 705 | 706 | return 707 | 708 | end subroutine FastScape_Set_Basement 709 | 710 | !-------------------------------------------------------------------------- 711 | 712 | subroutine FastScape_Set_Precip (precipp) 713 | 714 | use FastScapeContext 715 | 716 | implicit none 717 | 718 | double precision, intent(inout), dimension(*) :: precipp 719 | 720 | call SetPrecip (precipp) 721 | 722 | return 723 | 724 | end subroutine FastScape_Set_Precip 725 | 726 | !-------------------------------------------------------------------------- 727 | 728 | subroutine FastScape_VTK (fp, vexp) 729 | 730 | use FastScapeContext 731 | 732 | implicit none 733 | 734 | double precision, intent(inout), dimension(*) :: fp 735 | double precision, intent(inout) :: vexp 736 | 737 | call Make_VTK (fp, vexp) 738 | 739 | return 740 | 741 | end subroutine FastScape_VTK 742 | 743 | !-------------------------------------------------------------------------- 744 | 745 | subroutine FastScape_Strati (nstepp, nreflectorp, nfreqp, vexp) 746 | 747 | use FastScapeContext 748 | 749 | implicit none 750 | 751 | integer, intent(inout) :: nstepp, nreflectorp, nfreqp 752 | double precision, intent(inout) :: vexp 753 | 754 | call Activate_Strati (nstepp, nreflectorp, nfreqp, vexp) 755 | 756 | return 757 | 758 | end subroutine FastScape_Strati 759 | 760 | !-------------------------------------------------------------------------- 761 | 762 | subroutine FastScape_Get_Fluxes (ttectonic_flux, eerosion_flux, bboundary_flux) 763 | 764 | use FastScapeContext 765 | 766 | implicit none 767 | 768 | double precision, intent(out) :: ttectonic_flux, eerosion_flux, bboundary_flux 769 | 770 | call compute_fluxes (ttectonic_flux, eerosion_flux, bboundary_flux) 771 | 772 | return 773 | 774 | end subroutine FastScape_Get_Fluxes 775 | 776 | !-------------------------------------------------------------------------- 777 | 778 | subroutine FastScape_Set_Tolerance (tol_relp, tol_absp, nGSStreamPowerLawMaxp) 779 | 780 | use FastScapeContext 781 | 782 | implicit none 783 | 784 | double precision :: tol_relp, tol_absp 785 | integer :: nGSStreamPowerLawMaxp 786 | 787 | call set_tolerance (tol_relp, tol_absp, nGSStreamPowerLawMaxp) 788 | 789 | return 790 | 791 | end subroutine FastScape_Set_Tolerance 792 | 793 | !-------------------------------------------------------------------------- 794 | 795 | subroutine FastScape_Get_GSSIterations (nGSSp) 796 | 797 | use FastScapeContext 798 | 799 | implicit none 800 | 801 | integer :: nGSSp 802 | 803 | call get_nGSSiterations (nGSSp) 804 | 805 | return 806 | 807 | end subroutine FastScape_Get_GSSIterations 808 | -------------------------------------------------------------------------------- /docs/api.adoc: -------------------------------------------------------------------------------- 1 | [#fortran-api] 2 | == Fortran API 3 | 4 | **FastScapeLib** contains the following routines: 5 | 6 | === FastScape_Init 7 | 8 | This routine must be called first, i.e. before calling any other subroutine of the inteface. It resets internal variables. 9 | 10 | This routine has no argument: 11 | 12 | `FastScape_Init ()` 13 | 14 | === FastScape_Set_NX_NY 15 | 16 | This routine is used to set the resolution of the landscape evolution model. It must be called immediately after `FastScape_Init`. 17 | 18 | Arguments: 19 | 20 | `FastScape_Set_NX_NY ( nx, ny)` 21 | 22 | `nx` :: 23 | Resolution or number of grid points in the x-direction (integer) 24 | 25 | `ny` :: 26 | Resolution or number of grid points in the y-direction (integer) 27 | [NOTE] 28 | ==== 29 | `ny` can be different from `nx` 30 | ==== 31 | 32 | === FastScape_Setup 33 | 34 | This routine creates internal arrays by allocating memory. It must be called right after `FastScape_Set_NX_NY`. 35 | 36 | This routine has no argument: 37 | 38 | `FastScape_Setup ()` 39 | 40 | === FastScape_Set_XL_YL 41 | 42 | This routine is used to set the dimensions of the model, `xl` and `yl` in meters 43 | 44 | Arguments: 45 | 46 | `FastScape_Set_XL_YL ( xl, yl)` 47 | 48 | `xl` :: 49 | 50 | x-dimension of the model in meters (double precision) 51 | 52 | `yl` :: 53 | 54 | y-dimension of the model in meters (double precision) 55 | 56 | === FastScape_Set_DT 57 | 58 | This routine is used to set the time step in years 59 | 60 | Arguments: 61 | 62 | `FastScape_Set_DT (dt)` 63 | 64 | `dt` :: 65 | 66 | length of the time step in years (double precision) 67 | 68 | === FastScape_Init_H 69 | 70 | This routine is used to initialize the topography in meters 71 | 72 | Arguments: 73 | 74 | `FastScape_Init_H ( h)` 75 | 76 | `h` :: 77 | 78 | array of dimension `(nx*ny)` containing the initial topography in meters (double precision) 79 | 80 | === FastScape_Init_F 81 | 82 | This routine is used to initialize the silt fraction 83 | 84 | Arguments: 85 | 86 | `FastScape_Init_F( F)` 87 | 88 | `F` :: 89 | 90 | array of dimension `(nx*ny)` containing the initial silt fraction (double precision) 91 | 92 | 93 | === FastScape_Set_Erosional_Parameters 94 | 95 | This routine is used to set the continental erosional parameters 96 | 97 | Arguments: 98 | 99 | `FastScape_Set_Erosional_Parameters ( kf, kfsed, m, n, kd, kdsed, g, gsed, p)` 100 | 101 | `kf` :: 102 | 103 | array of dimension `(nx*ny)` containing the bedrock river incision (SPL) rate parameter (or Kf) in meters (to the power 1-2m) per year (double precision) 104 | 105 | `kfsed` :: 106 | 107 | sediment river incision (SPL) rate parameter (or Kf) in meters (to the power 1-2m) per year (double precision); note that when `kfsed < 0`, its value is not used, i.e., kf for sediment and bedrock have the same value, regardless of sediment thickness 108 | 109 | [NOTE] 110 | ==== 111 | bedrock refers to situations/locations where deposited sediment thickness is less than 1 meter, whereas sediment refers to situations/locations where sediment thickness is greater than 1 meter 112 | ==== 113 | 114 | `m` :: 115 | 116 | drainage area exponent in the SPL (double precision) 117 | 118 | `n` :: 119 | 120 | slope exponent in the SPL (double precision) 121 | 122 | [WARNING] 123 | ==== 124 | Valuers of `n` different from unity will cause the algorithm to perform Newton-Raphson iterations, which will cause it to slow down substantially (by a factor order `n` when `n > 1`) 125 | ==== 126 | 127 | `kd` :: 128 | 129 | array of dimension `(nx*ny)` containing the bedrock transport coefficient (or diffusivity) for hillslope processes in meter squared per year (double precision) 130 | 131 | `kdsed` :: 132 | 133 | sediment transport coefficient (or diffusivity) for hillslope processes in meter squared per year (double precision; )note that when `kdsed < 0`, its value is not used, i.e., kd for sediment and bedrock have the same value, regardless of sediment thickness 134 | 135 | `g` :: 136 | 137 | bedrock dimensionless deposition/transport coefficient for the enriched SPL (double precision) 138 | 139 | [WARNING] 140 | ==== 141 | When `g > 0`, the algorithm requires that Gauss-Seidel iterations be performed; depending on the value of `g`, the number of iterations can be significant (from 1 when `g` is near 0 to 20 when `g` is near 1). `g` must be equal or greater than zero. 142 | ==== 143 | 144 | `gsed` :: 145 | 146 | sediment dimensionless deposition/transport coefficient for the enriched SPL (double precision); note that when `gsed < 0`, its value is not used, i.e., g for sediment and bedrock have the same value, regardless of sediment thickness 147 | 148 | `p` :: 149 | 150 | slope exponent for multi-direction flow; the distribution of flow among potential receivers (defined as the neighbouring nodes that define a negative slope)is proportional to local slope to power `p` 151 | 152 | [NOTE] 153 | ==== 154 | `p = 0.d0` corresponds to a uniform distribution of flow among receivers, regardless of the slope; 155 | 156 | `p = 10.d0` (equivalent to `p` = infinity) corresponds to single direction flow or steepest descent; 157 | ==== 158 | 159 | [WARNING] 160 | ==== 161 | `p = -1.d0` (or any negative value for `p`) corresponds to an exponent that varies with slope according to: `p = 0.5 + 0.6*slope` 162 | ==== 163 | 164 | === FastScape_Set_Marine_Parameters 165 | 166 | This routine is used to set the marine transport/compaction parameters 167 | 168 | Arguments: 169 | 170 | `FastScape_Set_Marine_Parameters ( SL, p1, p2, z1, z2, r, L, kds1, kds2)` 171 | 172 | `SL` :: 173 | 174 | sea level in meters (double precision) 175 | 176 | `p1`:: 177 | 178 | reference/surface porosity for silt (double precision) 179 | 180 | `p2`:: 181 | 182 | reference/surface porosity for sand (double precision) 183 | 184 | `z1`:: 185 | 186 | e-folding depth for exponential porosity law for silt (double precision) 187 | 188 | `z2`:: 189 | 190 | e-folding depth for exponential porosity law for sand (double precision) 191 | 192 | `r` :: 193 | 194 | silt fraction for material leaving the continent (double precision) 195 | 196 | `L` :: 197 | 198 | averaging depth/thickness needed to solve the silt-sand equation in meters (double precision) 199 | 200 | `kds1` :: 201 | 202 | marine transport coefficient (diffusivity) for silt in meters squared per year (double precision) 203 | 204 | `kds2` :: 205 | 206 | marine transport coefficient (diffusivity) for sand in meters squared per year (double precision) 207 | 208 | [WARNING] 209 | ==== 210 | When `kds2` is not equal to `kds1`, it is possible that the algorithm fails to converge; the time step should be decreased until the maximum amount of sediment deposited in one time step is less than `L` the averaging depth; in theory, the convergence should not be affected when the increment in deposited sediment is higher than `L` and Xiaoping and Jean aere working on solving this problem 211 | ==== 212 | 213 | === FastScape_Set_BC 214 | 215 | This routine is used to set the boundary conditions 216 | 217 | Arguments: 218 | 219 | `FastScape_Set_BC ( ibc)` 220 | 221 | `ibc` :: 222 | 223 | `ibc` is made of four digits which can be one or zero (ex: `1111` or `0101` or `1000`); each digit corresponds to a type of boundary conditions (`0` = reflective and `1` = fixed height boundary); when two reflective boundaris face each other they become cyclic. The four bonudaries of the domain correspond to each of the four digits of ibc; the first one is the bottom boundary (`y=0`), the second is the right-hand side boundary (`x=xl`), the third one is the top boundary (`y=yl`) and the fourth one is the left-hand side boundary (`x=0`) (integer). 224 | 225 | [#img-bc] 226 | .Order of the boundaries in argument `ibc`. 227 | image::IMAGES/BC.jpg[Fan,300,200] 228 | 229 | [NOTE] 230 | ==== 231 | The fixed boundary condition does not imply that the boundary cannot be uplifted; i.e. the uplift array can be finite (not nil) on fixed height boundaries. To keep a boundary at base level, this must be specified in the uplift rate array, `u`, used in `FastScape_Set_U (u)` subroutine. 232 | ==== 233 | 234 | === FastScape_Set_U 235 | 236 | This routine is used to set the uplift velocity in meters per year 237 | 238 | Arguments: 239 | 240 | `FastScape_Set_U ( u)` 241 | 242 | `u` :: 243 | 244 | array of dimension `(nx*ny)` containing the uplift rate in meters per year (double precision) 245 | 246 | [NOTE] 247 | ==== 248 | A fixed boundary condition does not imply that the boundary cannot be uplifted; i.e. the uplift array can be finite (not nil) on fixed height boundaries. To keep a boundary at base level, this must be specified in the uplift rate array, `u`, used in `FastScape_Set_U (u)` subroutine. 249 | ==== 250 | 251 | === FastScape_Set_V 252 | 253 | This routine is used to set the advection horizontal velocities in meters per year 254 | 255 | Arguments: 256 | 257 | `FastScape_Set_V ( ux, uy)` 258 | 259 | `ux` :: 260 | 261 | array of dimension `(nx*ny)` containing the advection x-velocity in meters per year (double precision) 262 | 263 | `uy` :: 264 | 265 | array of dimension `(nx*ny)` containing the advection y-velocity in meters per year (double precision) 266 | 267 | === FastScape_Set_Precip 268 | 269 | This routine is used to set the precipitation rate in meters per year 270 | 271 | Arguments: 272 | 273 | `FastScape_Set_Precip ( p)` 274 | 275 | `p` :: 276 | 277 | array of dimension `(nx*ny)` containing the relative precipitation rate, i.e. with respect to a mean value already contained in `Kf` and `g` (double precision) 278 | 279 | [WARNING] 280 | ==== 281 | The value of this array should be considered as describing the spatial and temporal variation of relative precipitation rate, not its absolute value which is already contained in the definition of `Kf` and `g`. 282 | ==== 283 | 284 | === FastScape_Execute_Step 285 | 286 | This routine is used to execute one time step of the model 287 | 288 | This routine has no argument: 289 | 290 | `FastScape_Execute_Step ()` 291 | 292 | === FastScape_Get_Step 293 | 294 | This routine is used to extract from the model the current time step 295 | 296 | Arguments: 297 | 298 | `FastScape_Get_Step ( istep)` 299 | 300 | `istep` :: 301 | 302 | step number; this counter is incremented by one unit each time the routine `FastScape_Execute_Step` is called; its initial value is 0 (integer) 303 | 304 | === FastScape_Set_H 305 | 306 | This routine is used to set the topography in meters 307 | [NOTE] 308 | ==== 309 | This routine can be used to artificially impose a value to `h` ; for example to add an uplift that is due to isostasy 310 | ==== 311 | 312 | Arguments: 313 | 314 | `FastScape_Set_H ( h)` 315 | 316 | `h` :: 317 | 318 | array of dimension `(nx*ny)` containing the topography in meters (double precision) 319 | 320 | === FastScape_Set_Basement 321 | 322 | This routine is used to set the basement height in meters 323 | 324 | Arguments: 325 | 326 | `FastScape_Set_Basement ( b)` 327 | 328 | `b` :: 329 | 330 | array of dimension `(nx*ny)` containing the basement height in meters (double precision) 331 | 332 | === FastScape_Set_All_Layers 333 | 334 | This routine is used to increment (or uplift) the topography `h`, the basement height `b` and the stratigraphic horizons 335 | 336 | Arguments: 337 | 338 | `FastScape_Set_All_Layers ( dh)` 339 | 340 | `dh` :: 341 | 342 | array of dimension `(nx*ny)` containing the topographic increment in meters to be added to the topography `h`, the basement `b` and the stratigraphic horizons created when the **Stratigraphy** option has been turned on by calling the `FastScape_Strati` routine (double precision) 343 | 344 | === FastScape_Set_Tolerance 345 | 346 | This routine can be used to set the convergence parameters for the Gauss-Seidel iterations performed while numerically solving the Stream Power law. 347 | 348 | Arguments: 349 | 350 | `FastScape_Set_Tolerance ( tol_relp, tol_absp, nGSStreamPowerLawMaxp)` 351 | 352 | `tol_relp` :: 353 | 354 | relative tolerance (applied to the current max. topographic elevation) 355 | 356 | `tol_absp` :: 357 | 358 | absolute tolerance 359 | 360 | `nGSStreamPowerLawMaxp` :: 361 | 362 | maximum number of Gauss-Seidel iterations 363 | 364 | === FastScape_Get_GSSIterations 365 | 366 | This routine is used to get the actual number of Gauss-Seidel iterations performed while numerically solving the Stream Power law during the last time step. 367 | 368 | Arguments: 369 | 370 | `FastScape_Get_GSSIterations ( nGSSp)` 371 | 372 | `nGSSp` :: 373 | 374 | number of Gauss-Seidel iterations 375 | 376 | === FastScape_Copy_H 377 | 378 | This routine is used to extract from the model the current topography in meters 379 | 380 | Arguments: 381 | 382 | `FastScape_Copy_H ( h)` 383 | 384 | `h` :: 385 | 386 | array of dimension `(nx*ny)` containing the extracted topography in meters (double precision) 387 | 388 | === FastScape_Copy_F 389 | 390 | This routine is used to extract from the model the current silt fraction 391 | 392 | Arguments: 393 | 394 | `FastScape_Copy_F ( F)` 395 | 396 | `F` :: 397 | 398 | array of dimension `(nx*ny)` containing the extracted silt fraction (double precision) 399 | 400 | === FastScape_Copy_Basement 401 | 402 | This routine is used to extract from the model the current basement height in meters 403 | 404 | Arguments: 405 | 406 | `FastScape_Copy_Basement ( b)` 407 | 408 | `b` :: 409 | 410 | array of dimension `(nx*ny)` containing the extracted basement height in meters (double precision) 411 | 412 | === FastScape_Copy_Total_Erosion 413 | 414 | This routine is used to extract from the model the current total erosion in meters 415 | 416 | Arguments: 417 | 418 | `FastScape_Copy_Total_Erosion ( e)` 419 | 420 | `e` :: 421 | 422 | array of dimension `(nx*ny)` containing the extracted total erosion in meters (double precision) 423 | 424 | === FastScape_Reset_Cumulative_Erosion 425 | 426 | This routine is used to reset the total erosion to zero 427 | 428 | This routine has no argument: 429 | 430 | `FastScape_Reset_Cumulative_Erosion ()` 431 | 432 | === FastScape_Copy_Drainage_Area 433 | 434 | This routine is used to extract from the model the current drainage area in meters squared 435 | 436 | Arguments: 437 | 438 | `FastScape_Copy_Drainage_Area ( a)` 439 | 440 | `a` :: 441 | 442 | array of dimension `(nx*ny)` containing the extracted drainage area in meters squared (double precision) 443 | 444 | === FastScape_Copy_Erosion_Rate 445 | 446 | This routine is used to extract from the model the current erosion rate in meters per year 447 | 448 | Arguments: 449 | 450 | `FastScape_Copy_Erosion_Rate ( er)` 451 | 452 | `er` :: 453 | 454 | array of dimension `(nx*ny)` containing the extracted erosion rate in meters per year (double precision) 455 | 456 | === FastScape_Copy_Slope 457 | 458 | This routine is used to extract from the model the current slope (expressed in degrees) 459 | 460 | Arguments: 461 | 462 | `FastScape_Copy_Slope ( s)` 463 | 464 | `s` :: 465 | 466 | array of dimension `(nx*ny)` containing the extracted slope (double precision) 467 | 468 | === FastScape_Copy_Curvature 469 | 470 | This routine is used to extract from the model the current curvature 471 | 472 | Arguments: 473 | 474 | `FastScape_Copy_Curvature ( c)` 475 | 476 | `c` :: 477 | 478 | array of dimension `(nx*ny)` containing the extracted curvature (double precision) 479 | 480 | === FastScape_Copy_Chi 481 | 482 | This routine is used to extract from the model the current chi parameter 483 | 484 | Arguments: 485 | 486 | `FastScape_Copy_Chi ( c)` 487 | 488 | `c` :: 489 | 490 | array of dimension `(nx*ny)` containing the extracted chi-parameter (double precision) 491 | 492 | === FastScape_Copy_Catchment 493 | 494 | This routine is used to extract from the model the current catchment area in meter squared 495 | 496 | Arguments: 497 | 498 | `FastScape_Copy_Catchment ( c)` 499 | 500 | `c` :: 501 | 502 | array of dimension `(nx*ny)` containing a different index for each catchment (double precision) 503 | [NOTE] 504 | ==== 505 | the catchment index is the node number (in a series going from 1 to nx*ny from bottom left corner to upper right corner) corresponding to the outlet (base level node) of the catchment 506 | ==== 507 | 508 | === FastScape_Copy_Lake_Depth 509 | 510 | This routine is used to extract from the model the geometry and depth of lakes (ie., regions draining into a local minimum) 511 | 512 | Arguments: 513 | 514 | `FastScape_Copy_Lake_Depth ( Ld)` 515 | 516 | `Ld` :: 517 | 518 | array of dimension `(nx*ny)` containing the depth of lakes in meters (double precision) 519 | 520 | === FastScape_Get_Sizes 521 | 522 | This routine is used to extract from the model the model dimensions 523 | 524 | Arguments: 525 | 526 | `FastScape_Get_Sizes ( nx, ny)` 527 | 528 | `nx` :: 529 | Resolution or number of grid points in the x-direction (integer) 530 | 531 | `ny` :: 532 | Resolution or number of grid points in the y-direction (integer) 533 | 534 | === FastScape_Get_Fluxes 535 | 536 | This routine is used to extract three fluxes from the model at the current time step: the tectonic flux which is the integral over the model of the uplift/subsidence function, the erosion flux which is the integral over the model of the erosion/deposition rate and the boundary flux which is the integral of sedimentary flux across the four boundaries (all in m^3^/yr) 537 | 538 | Arguments: 539 | 540 | `FastScape_Get_Fluxes ( tflux, eflux, bflux)` 541 | 542 | `tflux` :: 543 | tectonic flux in m^3^/yr (double precision) 544 | 545 | `teflux` :: 546 | erosion flux in m^3^/yr (double precision) 547 | 548 | `bflux` :: 549 | boundary flux in m^3^/yr (double precision) 550 | 551 | === FastScape_View 552 | 553 | This routine is used to display on the screen basic information about the model 554 | 555 | This routine has no argument: 556 | 557 | `FastScape_View ()` 558 | 559 | === FastScape_Debug 560 | 561 | This routine is used to display debug information and routine timing 562 | 563 | This routine has no argument: 564 | 565 | `FastScape_Debug()` 566 | 567 | === FastScape_Destroy 568 | 569 | This routine is used to terminate a landscape evolution model. Its main purpose is to release memory that has been previously allocated by the interface 570 | 571 | This routine has no argument: 572 | 573 | `FastScape_Destroy ()` 574 | 575 | === FastScape_VTK 576 | 577 | This routine creates a `.vtk` file for visualization in **Paraview** (see `http://www.paraview.org`); the file will be named `Topographyxxxxxx.vtk` where `xxxxxx` is the current time step number and stored in a directory called `VTK`. If `vex < 0`, it also creates other `.vtk` files named `Basementxxxxxx.vtk` (containing the basement geometry in m) and `SeaLevelxxxxxx.vtk` (containing the current sea level in m). 578 | 579 | [WARNING] 580 | ==== 581 | If the directory `VTK` does not exist it is created 582 | ==== 583 | 584 | Arguments: 585 | 586 | `FastScape_VTK ( f, vex)` 587 | 588 | `f` :: 589 | array of dimension `(nx*ny)` containing the field to be displayed on the topography (double precision) 590 | 591 | `vex` :: 592 | 593 | vertical exaggeration used to scale the topographic height with respect to the horizontal coordinates (double precision) 594 | 595 | === FastScape_Strati 596 | 597 | routine to produce a set of `.vtk` files containing stratigraphic information and to be opened in **Paraview** (see `http://www.paraview.org`). The stratigraphic files are called `Horizonxxx-yyyyyyy.vtk`, where `xxx` is the name (or number) of the horizon and `yyyyyyy` the time step. They are stored in a `VTK` directory. The name (or number) of the basement is `000` and the name of the last horizon is `nhorizon` 598 | 599 | [WARNING] 600 | ==== 601 | If the directory `VTK` does not exist it is created 602 | ==== 603 | 604 | Arguments: 605 | 606 | `FastScape_Strati ( nstep, nhorizon, nfreq, vex)` 607 | 608 | `nstep`:: 609 | 610 | Total number of steps in the run (integer) 611 | 612 | `nhorizon`:: 613 | 614 | Total number of horizons to be stored/created (integer) 615 | 616 | `nfreq`:: 617 | 618 | Frequency of output of the horizons VTKs/files (integer); if `nfreq = 10`, a horizon file will be created every 10 time steps 619 | 620 | `vex`:: 621 | 622 | vertical exaggeration used to scale the horizons with respect to the horizontal coordinates (double precision) 623 | 624 | [NOTE] 625 | ==== 626 | The routine `FastScape_Strati` should only be called once before the beginning of the time loop 627 | ==== 628 | 629 | What is stored on each horizon: 630 | 631 | [cols="10,20,70"] 632 | |=== 633 | |*Field*|*Name*|*Description* 634 | |H|Topography|Topography expressed in meters 635 | |1|CurrentDepth|Current depth expressed in meters (identical to H) 636 | |2|CurrentSlope|Current Slope in degrees 637 | |3|ThicknessToNextHorizon|Sediment thikness from current horizon to the next horizon in meters 638 | |4|ThicknessToBasement|Total sediment thickness from current horizon/horizon to basement in meters 639 | |5|DepositionalBathymetry|Bathymetry at time of deposition in meters 640 | |6|DepositionalSlope| Slope at time of depostion in degrees 641 | |7|DistanceToSHore| Distance to shore at time of deposition in meters 642 | |8|Sand/ShaleRatio|Silt fraction at time of deposition 643 | |9|HorizonAge|Age of the current horizon in years 644 | |A|ThicknessErodedBelow|Sediment thickness eroded below current horizon in meters 645 | |=== 646 | 647 | [#fortran-api-extra] 648 | == Auxiliary routines 649 | 650 | === Flexure 651 | 652 | We provide a Fortran subroutine called `flexure` to compute the flexural isostatic rebound associated with erosional loading/unloading. To use this routine, you need to enable the CMake option `-DUSE_FLEXURE=ON` when building **FastScapeLib** (see <> section). By default, flexure is not part of the **FastScapeLib** library as it rather corresponds to a simple example of a tectonic model that uses the library interface. 653 | 654 | Here we only describe the main subroutine. It takes an initial (at time `t`) and final topography (at time `t+Dt`) (i.e. before and after erosion/deposition) and returns a corrected final topography that includes the effect of erosional/depositional unloading/loading. 655 | 656 | The routine assumes a value of 10^11^ Pa for Young's modulus, 0.25 for Poisson's ratio and 9.81 m/s^2^ for g, the gravitational acceleration. It uses a spectral method to solve the bi-harmonic equation governing the bending/flexure of a thin elastic plate floating on an inviscid fluid (the asthenosphere). 657 | 658 | Arguments: 659 | 660 | `flexure ( h, hp, nx, ny, xl, yl, rhos, rhoa, eet, ibc)` 661 | 662 | `h` :: 663 | array of dimension (`nx*ny`) containing the topography at time `t+Dt`; on return it will be replaced by the topography at time t+Dt corrected for isostatic rebound (double precision) 664 | 665 | `hp` :: 666 | array of dimension (`nx*ny`) containing the topography at time `t`, assumed to be at isostatic equilibrium (double precision) 667 | 668 | `nx` :: 669 | model topography (`h`) resolution or number of grid points in the x-direction (integer) 670 | 671 | `ny` :: 672 | model topography (`h`) resolution or number of grid points in the y-direction (integer) 673 | 674 | `xl` :: 675 | x-dimension of the model topography in meters (double precision) 676 | 677 | `yl` :: 678 | y-dimension of the model topography in meters (double precision) 679 | 680 | `rhos` :: 681 | array of dimension(`nx*ny`) containing the surface rock density in kg/m^3^ (double precision) 682 | 683 | `rhoa` :: 684 | asthenospheric rhoc density in kg/m^3^ (double precision) 685 | 686 | `eet` :: 687 | effective elastic plate thickness in m (double precision) 688 | 689 | `ibc` :: 690 | same as in <> 691 | 692 | [#python-api] 693 | == Python API 694 | 695 | All **FastScapeLib** routines above can be called from within 696 | Python. See <> section for more 697 | details on how install the Python package. See also the Jupyter 698 | Notebook in the `examples` directory for further instructions on how 699 | to use **FastScapeLib** from within Python. 700 | 701 | [WARNING] 702 | ==== 703 | Note that all routine names must be in lower caps in 704 | the calling python code. 705 | ==== 706 | --------------------------------------------------------------------------------