Changeset 10345 for NEMO/branches
- Timestamp:
- 2018-11-21T11:25:53+01:00 (5 years ago)
- Location:
- NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE
- Files:
-
- 8 deleted
- 66 edited
- 54 copied
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/INSTALL.rst
r9596 r10345 1 Install the modelling framework (NEMO and XIOS) 1 ********************* 2 Install the framework 3 ********************* 2 4 3 Last edition: 2018-02-14 21:32 CET by nicolasmartin 5 .. contents:: 6 :local: 7 8 Dependencies 9 ============ 4 10 5 Extract the NEMO code 6 Description of NEMOGCM directory tree 7 Extract and install XIOS 8 Setup your architecture configuration file 9 Compile and create NEMO executable 10 More options 11 Default behaviour 12 Tools used during the process 13 Examples 14 Running the model 15 Viewing and changing list of active CPP keys 11 | The NEMO source code is written in Fortran 95 and part of its dependencies are already included (``./ext``): 12 AGRIF preprocessing program "conv", FCM build system and IOIPSL library for outputs. 13 | And some Perl 5, Fortran compiler (ifort, gfortran, pgfortran, ...), MPI library (Open MPI or MPICH) 16 14 17 Extract the NEMO code 15 But The following dependencies should be from the official repositories of your Linux distribution but 16 you will probably have to compile them from source for enabling parallel I/O support. 18 17 19 Using your account registered here ('my_login' with password) 18 - `HDF5`_ (C library) 19 - `NetCDF`_ (C and Fortran libraries) 20 21 Extract the source code 22 ======================= 23 24 Download the source code 25 ------------------------ 20 26 21 27 .. code:: console 22 svn --username 'mylogin' co http://forge.ipsl.jussieu.fr/nemo/svn/branches/2015/nemo_v3_6_STABLE/NEMOGCM23 28 24 Description of NEMOGCM directory tree 29 $ svn co http://forge.ipsl.jussieu.fr/nemo/svn/NEMO/releases/release-4.0 25 30 26 The image below shows the directory tree: 31 Description of directory tree 32 ----------------------------- 27 33 28 simple table: 29 ARCH Compilation option files, with format arch_compiler.fcm, the compiler name has to be provided with –m option 30 CONFIG All configurations and a cpp.fcm file containing the list of CPP keys to each configuration 31 EXTERNAL Package to implement an embedded model (AGRIF) 32 NEMO FORTRAN source codes in several sub-directories 33 SETTE Package to make tests to ensure the reproducibility and restartability of the code after changes 34 TOOLS Useful softwares to different utilities 34 +-----------+------------------------------------------------------------+ 35 | Folder | Purpose | 36 +===========+============================================================+ 37 | ``arch`` | Settings (per architecture-compiler pair) | 38 +-----------+------------------------------------------------------------+ 39 | ``cfgs`` | :doc:`Reference configurations <configurations>` | 40 +-----------+------------------------------------------------------------+ 41 | ``doc`` | - ``latex``: reference manuals for |OPA|, |SI3| & |TOP| | 42 | | - ``namelists``: k start guide | 43 | | - ``rst``: quick start guide | 44 +-----------+------------------------------------------------------------+ 45 | ``ext`` | Dependencies included (AGRIF, FCM & IOIPSL) | 46 +-----------+------------------------------------------------------------+ 47 | ``mk`` | Building routines | 48 +-----------+------------------------------------------------------------+ 49 | ``src`` | Modelling routines | 50 | | | 51 | | - ``ICE``: |SI3| for sea ice | 52 | | - ``NST``: AGRIF for embedded zooms | 53 | | - ``OCE``: |OPA| for ocean dynamics | 54 | | - ``MBG``: |TOP| for tracers | 55 +-----------+------------------------------------------------------------+ 56 | ``tests`` | :doc:`Test cases <test_cases>` (unsupported) | 57 +-----------+------------------------------------------------------------+ 58 | ``tools`` | :doc:`Utilities <tools>` to [pre|post]process data | 59 +-----------+------------------------------------------------------------+ 35 60 36 61 Extract and install XIOS 62 ======================== 37 63 38 64 Diagnostic outputs from NEMO are handled by the third party XIOS library. … … 42 68 43 69 When you compile NEMO you will need to specify the following CPP keys: 44 70 45 71 key_iomput 46 72 key_mpp_mpi (if you want to run with multiple processes and/or use "detached mode" for the IOs system XIOS) … … 48 74 49 75 Setup your architecture configuration file 76 ========================================== 50 77 51 78 All compiler options in NEMO are controlled using files in NEMOGCM/ARCH/arch-'my_arch'.fcm where 'my_arch' is the name of the computing architecture. … … 58 85 59 86 Compile and create NEMO executable 87 ================================== 60 88 61 89 The main script to compile and create executable is called makenemo and located in the CONFIG directory, it is used to identify the routines you need from the source code, to build the makefile and run it. 62 90 As an example, compile GYRE with 'my_arch' to create a 'MY_GYRE' configuration: 63 91 64 cd NEMOGCM/CONFIG; ./makenemo –m 'my_arch' –r GYRE -n 'MY_GYRE' 92 .. code-block:: sh 93 94 ./makenemo –m 'my_arch' –r GYRE -n 'MY_GYRE' 65 95 66 96 The image below shows the structure and some content of "MY_CONFIG" directory from the launching of the configuration creation (directories and fundamental files created by makenemo). 67 97 68 98 +------------+----------------------------------------------------+ 99 | Folder | Purpose | 100 +============+====================================================+ 101 | ``BLD`` | | 102 +------------+----------------------------------------------------+ 103 | ``EXP00`` | | 104 +------------+----------------------------------------------------+ 105 | ``EXPREF`` | | 106 +------------+----------------------------------------------------+ 107 | ``MY_SRC`` | | 108 +------------+----------------------------------------------------+ 109 | ``WORK`` | | 110 +------------+----------------------------------------------------+ 69 111 70 WORK 71 72 73 74 Folder with the symbolic links to all unpreprocessed routines considered in the configuration 75 76 BLD 77 78 79 80 Compilation folder (executables, headers files, libraries, preprocessed routines, flags, …) 81 82 EXP00 83 84 85 86 Computation folder for running the model (namelists, xml, executables and inputs-outputs) 87 88 MY_SRC 89 90 91 92 Folder intended to contain your customized routines (modified from initial ones or new entire routines) 112 Folder with the symbolic links to all unpreprocessed routines considered in the configuration 113 Compilation folder (executables, headers files, libraries, preprocessed routines, flags, …) 114 Computation folder for running the model (namelists, xml, executables and inputs-outputs) 115 Folder intended to contain your customised routines (modified from initial ones or new entire routines) 93 116 94 117 After successful execution of makenemo command, the executable called opa is created in the EXP00 directory (in the example above, the executable is created in CONFIG/MY_GYRE/EXP00). 95 118 More options 96 119 97 echo "Usage : "${b_n} \ 98 " [-h] [-n name] [-m arch] [-d "dir1 dir2"] [-r conf] [-u conf] [-s Path] [-e Path] [-j No] [-v No] [-k 0/1]"; 99 echo " -h : help"; 100 echo " -h institute : specific help for consortium members"; 101 echo " -n name : config name, [-n help] to list existing configurations"; 102 echo " -m arch : choose compiler, [-m help] to list existing compilers"; 103 echo " -d dir : choose NEMO sub-directories"; 104 echo " -r conf : choose reference configuration"; 105 echo " -u conf : choose an unsupported (external) configuration"; 106 echo " -s Path : choose alternative location for NEMO main directory"; 107 echo " -e Path : choose alternative location for MY_SRC directory"; 108 echo " -j No : number of processes used to compile (0=nocompilation)"; 109 echo " -v No : set verbosity level for compilation [0-3]"; 110 echo " -k 0/1 : used cpp keys check (default = 1 -> check activated)"; 111 echo " -t dir : temporary directory for compilation" 112 echo ""; 120 .. 121 .. literalinclude:: 113 122 114 123 Default behaviour 124 ----------------- 115 125 116 126 At the first use, you need the -m option to specify the architecture configuration file (compiler and its options, routines and libraries to include), then for next compilation, it is assumed you will be using the same compiler. … … 118 128 119 129 Tools used during the process 130 ----------------------------- 120 131 121 132 functions.sh : bash functions used by makenemo, for instance to create the WORK directory … … 124 135 125 136 Examples 137 -------- 126 138 127 139 echo "Example to install a new configuration MY_CONFIG"; … … 149 161 150 162 Running the model 163 ================= 151 164 152 Once makenemo has run successfully, the opa executable is available in CONFIG/"MY_CONFIG"/EXP00153 For the reference configurations, the EXP00 folder also contains the initial input files (namelists, *xml files for the IOs…). If the configuration also needs NetCDF input files, this should be downloaded here from the corresponding tar file, see Users/Reference Configurations165 Once makenemo has run successfully, the opa executable is available in ``CONFIG/MY_CONFIG/EXP00`` 166 For the reference configurations, the EXP00 folder also contains the initial input files (namelists, \*xml files for the IOs…). If the configuration also needs NetCDF input files, this should be downloaded here from the corresponding tar file, see Users/Reference Configurations 154 167 155 168 cd 'MY_CONFIG'/EXP00 … … 157 170 158 171 Viewing and changing list of active CPP keys 172 ============================================ 159 173 160 For a given configuration (here called MY_CONFIG), the list of active CPP keys can be found in 174 For a given configuration (here called MY_CONFIG), the list of active CPP keys can be found in:: 161 175 162 176 NEMOGCM/CONFIG/'MYCONFIG'/cpp_'MY_CONFIG'.fcm 163 177 164 178 This text file can be edited to change the list of active CPP keys. Once changed, one needs to recompile opa executable using makenemo command in order for this change to be taken in account. 179 180 .. _HDF5: http://www.hdfgroup.org/downloads/hdf5 181 .. _NetCDF: http://www.unidata.ucar.edu/downloads/netcdf -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/README.rst
r9650 r10345 1 .. role:: rstblue 2 .. role:: rstgrey 3 .. role:: rstgreen 1 :Authors: NEMO System Team 2 :Release: |release| 3 :Date: |today| 4 4 5 ================ 6 NEMO Ocean Model 7 ================ 5 `NEMO`_ for *Nucleus for European Modelling of the Ocean* is a state-of-the-art modelling framework for 6 research activities and forecasting services in ocean and climate sciences. 8 7 9 NEMO_ (Nucleus for European Modelling of the Ocean) is a state-of-the-art modelling framework of 10 ocean related engines for oceanographic research, operational oceanography, seasonal forecast and 11 [paleo]climate studies. 8 .. contents:: 9 :local: 10 11 Overview 12 ======== 12 13 13 14 The NEMO ocean model has 3 major components: 14 15 15 - :rstblue:`OPA` is fundamental to all users by modelling the ocean [thermo]dynamics and16 solving the primitive equations;17 - :rstgrey:`LIM` for sea-ice simulates ice [thermo]dynamics, brine inclusions and18 subgrid-scale thickness variations;19 - :rstgreen:`TOP-PISCES` models biogeochemistry with TOP for20 the on/offline oceanic tracers transport and PISCES for the biogeochemical processes.16 - |OPA| models the ocean [thermo]dynamics and solves the primitive equations 17 (``./src/OCE``) :cite:`NEMO_manual`; 18 - |SI3| simulates ice [thermo]dynamics, brine inclusions and subgrid-scale thickness variations 19 (``./src/ICE``) :cite:`SI3_manual`; 20 - |TOP| models the [on|off]line oceanic tracers transport and the biogeochemical processes 21 (``./src/MBG``) :cite:`TOP_manual`. 21 22 22 These physical engines are described in their respective `reference publications`_. 23 These physical core engines are described in their respective <reference publications> that must be cited for 24 any work related to their use. 23 25 24 They are complemented by a 2-way nesting software (AGRIF_) and 25 a versatile data assimilation interface with 3 different modules 26 (linear-tangent TAM, observational operators OBS, and increment ASM). 26 Applications and capabilities 27 ============================= 27 28 28 ------------ 29 Applications 30 ------------ 29 Not only does the NEMO framework model the ocean circulation, 30 it offers various features to enable 31 31 32 | Distributed under CeCILL license (GNU GPL compatible - see ``LICENSE``), 33 the framework offers several builtins reference configurations to 34 check your computing architecture and evaluate the model skills and performances (``./cfgs``).35 | The end user could also find some idealized test cases on the web to serve as examples and 36 to study particular processes.32 - Create :doc:`embedded zooms <zooms>` seamlessly with 2-way nesting package `AGRIF`_. 33 - :doc:`Low cost biogeochemistry <coarsening>` and :doc:`alternative model opportunity <tracers>`. 34 - Versatile :doc:`assimilation <assimilation>`. 35 - :doc:`Output diagnostics <diagnostics>` with `XIOS`_ server. 36 - :doc:`Coupling <coupling>` via `OASIS`_ for Earth system modelling. 37 37 38 A set of tools is also provided to setup your own configuration and 39 [pre|post]process your data (``./tools``). 38 | Several :doc:`builtins configurations <configurations>` are provided to assess the skills and performances of 39 the model which can be used as templates for :doc:`setting up a new configuration <setup>` (``./cfgs``). 40 | The end user could also find some :doc:`idealised test cases <test_cases>` online to serve as templates and 41 to study particular processes (``./tests``). 40 42 41 ------- 42 Options 43 ------- 43 A set of :doc:`utilities <tools>` is also provided to [pre|post]process your data (``./tools``). 44 44 45 For writing diagnostics in a efficient way, NEMO make use of XIOS_ server which 46 controlled the outputs using XML input file. 45 Literature 46 ========== 47 47 48 To enable Earth system modelling, NEMO can be interfaced via 49 OASIS_ coupleur to external components such as atmospheric models or 50 alternative models of sea-ice or biogeochemistry. 48 :doc:`install` 51 49 52 ------------- 53 Documentation 54 ------------- 50 The reference documentation is archived online 55 51 56 The NEMO reference manual can be generated from the LaTeX source code (``./doc``), 57 either in PDF or in HTML format, but it mights require some additionnal installations. 52 +-------+-------------------+----------------+ 53 | | Reference manual | |NEMO manual|_ | 54 | |OPA| +-------------------+----------------+ 55 | | Quick start guide | |NEMO guide|_ | 56 +-------+-------------------+----------------+ 57 | |SI3| | |SI3 manual|_ | 58 +---------------------------+----------------+ 59 | |TOP| | |TOP manual|_ | 60 +---------------------------+----------------+ 58 61 59 In any case, both formats are available online on the `NEMO website`__. 62 .. |NEMO manual| image:: http://zenodo.org/badge/DOI/10.5281/zenodo.1464816.svg 63 .. |NEMO guide| image:: http://zenodo.org/badge/DOI/10.5281/zenodo.1475325.svg 64 .. |SI3 manual| image:: http://zenodo.org/badge/DOI/10.5281/zenodo.1471689.svg 65 .. |TOP manual| image:: http://zenodo.org/badge/DOI/10.5281/zenodo.1471700.svg 60 66 61 --------------------- 67 | Reference manuals and quick start guide can be build from source and exported to HTML or PDF (``./doc``). 68 | In any case, one can find them online: 69 70 Since 2014 the project has a `Special Issue <http://www.geosci-model-dev.net/special_issue40.html>`_ in 71 the open-access journal Geoscientific Model Development (GMD) from the European Geosciences Union (EGU). 72 The main scope is to collect relevant manuscripts covering various topics and to provide a single portal to 73 assess the model potential and evolution. 74 75 Used by a wide audience, numerous :website:`associated projects <projects>` have been carried out and 76 extensive :website:`bibliography <bibliography/publications>` published. 77 62 78 Community development 63 --------------------- 79 ===================== 64 80 65 | The NEMO Consortium gathering 6 European institutes organises the sustainable development in order to 66 keep a reliable evolving system since 2008. 67 | It defined the multiyear development strategy which is implemented by the NEMO System Team. 81 | The NEMO Consortium pulling together 5 European institutes (`CMCC`_, `CNRS`_, `MOI`_, `Met Office`_ and `NERC`_) 82 plans the sustainable development in order to keep a reliable evolving framework since 2008. 83 | It defines the |NEMO strategy|_ which is implemented by the System Team on 84 a yearly basis in order to release a new version almost every four years. 68 85 69 -------- 70 Acronyms 71 -------- 86 .. |NEMO strategy| replace:: multi-year development strategy 72 87 73 AGRIF 74 Adaptive Grid Refinement In Fortran 75 76 LIM 77 Louvain-la-Neuve Ice Model 78 79 OPA 80 "Océan PArallélisé" (french) 81 82 PISCES 83 Pelagic Interactions Scheme for Carbon and Ecosystem Studies 84 85 TAM 86 Tangent Adjoint Model 87 88 TOP 89 Tracers in Ocean Paradigm 90 91 XIOS 92 XML Input Output Server 93 94 ---- 95 96 .. _AGRIF: http://agrif.imag.fr 97 .. _Forge: http://forge.ipsl.jussieu.fr/nemo 98 .. _NEMO: http://www.nemo-ocean.eu 99 .. _OASIS: http://verc.enes.org/oasis 100 .. _reference publications: http://www.nemo-ocean.eu/bibliography/documentation 101 .. _XIOS: http://forge.ipsl.jussieu.fr/ioserver 102 103 .. __: NEMO_ 88 When the need arises, :forge:`working groups <wiki/WorkingGroups>` are created or resumed to 89 gather the community expertise for advising on the development activities. -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/RELEASE_NOTES.rst
r10150 r10345 1 ================ 2 NEMO 4.0 Release 3 ================ 1 ********************** 2 What's new in NEMO 4.0 3 ********************** 4 4 5 5 .. contents:: 6 7 ---------- 8 What's new 9 ---------- 10 6 :local: 7 11 8 Original sea-ice component SI\ :sup:`3`\ 12 9 ======================================== … … 50 47 Define and install a separate repository for test cases to all easy contributions from the NEMO Users Community 51 48 52 +-------------------+--------------------------------------------------------+------------------------------------+53 | Name | Purpose | References |54 +===================+=================+======================================+====================================+55 | ``CANAL`` | East-west periodic canal of variable size with several | |56 | | initial states and associated geostrophic currents | |57 | | (zonal jets or vortex). | |58 +-------------------+--------------------------------------------------------+------------------------------------+59 | ``ICEDYN`` | East-west + north-south periodic channel. | |60 | | The common configuration includes an AGRIF zoom (1:3) | |61 | | in the middle of the basin to test how an ice patch is | |62 | | advected through it but one can also test the | |63 | | advection schemes (Prather and Ultimate-Macho) by | |64 | | removing the ``key_agrif`` in the CPP keys. | |65 +-------------------+--------------------------------------------------------+------------------------------------+66 | ``ISOMIP`` | Simple box configuration with an iceshelf with simple | `Hunter 2006`_ |67 | | geometry on top. | |68 | | The purpose of this test case is to evaluate the | |69 | | impact of various schemes and new development with | |70 | | iceshelf cavities. | |71 +-------------------+--------------------------------------------------------+------------------------------------+72 | ``LOCK_EXCHANGE`` | Classical fluid dynamics experiment that has been | - `Haidvogel and Beckmann 1999`_ |73 | | adapted for testing advection schemes in ocean | - `Burchard and Bolding 2002`_ |74 | | circulation models. | - `Ilıcak 2012`_ |75 | | This experiment can in particular illustrate the | |76 | | impact of different choices of numerical schemes | |77 | | and/or subgrid closures on spurious interior mixing. | |78 +-------------------+--------------------------------------------------------+------------------------------------+79 | ``OVERFLOW`` | Adapted from the non-rotating overflow configuration | - `Haidvogel and Beckmann 1999`_ |80 | | Illustrates the impact of different choices of | - `Ilıcak 2012`_ |81 | | numerical schemes and/or subgrid closures on spurious | |82 | | interior mixing close to bottom topography. | |83 +-------------------+--------------------------------------------------------+------------------------------------+84 | ``VORTEX`` | Illustrates the propagation of an anticyclonic eddy | - `Debreu 2012`_ |85 | | over a Beta plan and flat bottom. | - `Penven 2006`_ |86 | | It is implemented here with an online refined | - `Spall and Holland 1991`_ |87 | | subdomain (thanks to AGRIF library) out of which the | |88 | | vortex propagates and serves as a benchmark to | |89 | | diagnose nesting errors. | |90 +-------------------+--------------------------------------------------------+------------------------------------+91 | ``WAD`` | Set of simple closed basin geometries for testing the | |92 | | wetting and drying capabilities. | |93 | | Examples range from a closed channel with EW linear | |94 | | bottom slope to a parabolic EW channel with a Gaussian | |95 | | ridge. | |96 +-------------------+--------------------------------------------------------+------------------------------------+97 98 -----------99 Improvments100 -----------101 102 49 Core components 103 50 =============== … … 108 55 - The passive tracers transport component was redesigned toward a modular structure and 109 56 users can enable each module directly through logical flags in namelist_top (no more Fortran macros!). 110 - TOP on-line user documentation is available on NEMO Trac platform ( TOP-UserQuickGuide_)57 - TOP on-line user documentation is available on NEMO Trac platform (`TOP User Quick Guide`_) 111 58 - TOP currently accounts for the following 5 modules: 112 59 … … 130 77 AGRIF (embedded zooms) 131 78 ---------------------- 79 80 The NEMO 4.0 includes new capabilities, configurations and test cases with AGRIF: 81 82 .. role:: underline 83 :class: underline 84 85 :underline:`New capabilities from NEMO 3.6 to NEMO 4.0` 86 87 AGRIF is continuously maintained so that it could be activated with all NEMO components (OPA, sea-ice, TOP). 88 Depending on NEMO version, it is nevertheless not the case so that some options may not be compatible with 89 the use of online grid refinement. 90 Check out the table below to know the status according to the NEMO release you may use. 91 92 :underline:`Status of available options with AGRIF (if not listed, option is compatible with AGRIF)`: 93 94 +--------------------------------------------------------+----------------+---------------------+ 95 | | NEMO 3.6 | NEMO 4.0 | 96 +========================================================+================+=====================+ 97 | LIM2 | yes | ``-`` | 98 +--------------------------------------------------------+----------------+---------------------+ 99 | LIM3/SI3 | no | yes | 100 +--------------------------------------------------------+----------------+---------------------+ 101 | TOP | yes | yes | 102 +--------------------------------------------------------+----------------+---------------------+ 103 | GLS vertical mixing | no | yes | 104 +--------------------------------------------------------+----------------+---------------------+ 105 | z* | no | yes | 106 +--------------------------------------------------------+----------------+---------------------+ 107 | z~ | no | no | 108 +--------------------------------------------------------+----------------+---------------------+ 109 | Lagrangian icebergs | no | no | 110 +--------------------------------------------------------+----------------+---------------------+ 111 | East-west periodic and/or north fold bcs in zooms | no | no | 112 +--------------------------------------------------------+----------------+---------------------+ 113 | Online timing | no | no | 114 +--------------------------------------------------------+----------------+---------------------+ 115 | Stochastic parameterization | no | no | 116 +--------------------------------------------------------+----------------+---------------------+ 117 | Vertical coordinate change in zooms (``key_vertical``) | no | yes, but not tested | 118 +--------------------------------------------------------+----------------+---------------------+ 119 | Number of ghost cells | 1 (hard coded) | 3 (parameter) | 120 +--------------------------------------------------------+----------------+---------------------+ 121 122 [Important notice concerning the change of ghost cells number] 123 124 The default number of ghost cells (i.e. the number of cells that serve as open boundary data provision) has been 125 increased from 1 to 3 in NEMO 4.0. 126 This allows to properly handle boundary conditions for numerical schemes that 127 have a discretization order greater than 2. 128 On the user point of view this does not change anything++ except in the definition of level 1 grids in 129 the ``AGRIF_FixedGrids.in`` file. 130 In order to retrieve exactly the position of a nested grid in NEMO 4.0 one has to shift indices by 131 2 points to the south-west. 132 Taking the ``ICEDYN`` example above for NEMO 4.0, the "old" NEMO 3.6 corresponding file would contain:: 133 134 1 135 36 65 36 65 3 3 3 136 0 137 138 ++ Child grid output files are now greater by 4 points in each direction. 132 139 133 140 - Now compatible with new sea ice component and z* coordinate … … 159 166 - Wave coupling: large scale wave interaction process added in momentum and tracer equations 160 167 - Remove the acceleration of convergence 161 168 162 169 Numerics 163 170 -------- … … 197 204 198 205 .. _sea ice working group: http://forge.ipsl.jussieu.fr/nemo/wiki/WorkingGroups/SI3 199 .. _TOP -UserQuickGuide:http://forge.ipsl.jussieu.fr/nemo/wiki/WorkingGroups/top-dg/TOP-UserQuickGuide200 201 .. _Hunter 2006: http://staff.acecrc.org.au/~bkgalton/ISOMIP/test_cavities.pdf206 .. _TOP User Quick Guide: http://forge.ipsl.jussieu.fr/nemo/wiki/WorkingGroups/top-dg/TOP-UserQuickGuide 207 208 .. The following references should be in the manual bibliographies and referenced via 'bibliography' directive 202 209 .. _Brodeau 2017: http://doi.org/10.1175/JPO-D-16-0169.1 203 .. _Haidvogel and Beckmann 1999: http://hdl.handle.net/10013/epic.11761204 .. _Burchard and Bolding 2002: http://www.researchgate.net/publication/258128069_GETM_A_General_Estuarine_Transport_Model_Scientific_Documentation205 .. _Ilıcak 2012: http://doi.org/10.1016/j.ocemod.2011.10.003206 .. _Debreu 2012: http://doi.org/10.1016/j.ocemod.2012.03.003207 .. _Penven 2006: http://doi.org/10.1016/j.ocemod.2005.05.002208 .. _Spall and Holland 1991: http://www.researchgate.net/publication/232101325_A_Nested_Primitive_Equation_Model_for_Oceanic_Applications209 210 .. _Holland 2012: http://doi.org/10.1175/JCLI-D-11-00078.1 210 211 .. _Lupkes 2012: http://doi.org/10.1029/2012JD017630 -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/cfgs/ORCA2_ICE_PISCES/EXPREF/context_nemo.xml
r9930 r10345 6 6 <context id="nemo"> 7 7 <!-- $id$ --> 8 <variable_definition>9 <!-- Year of time origin for NetCDF files; defaults to 1800 -->10 <variable id="ref_year" type="int" > 1800 </variable>11 <variable id="rau0" type="float" > 1026.0 </variable>12 <variable id="cpocean" type="float" > 3991.86795711963 </variable>13 <variable id="convSpsu" type="float" > 0.99530670233846 </variable>14 <variable id="rhoic" type="float" > 917.0 </variable>15 <variable id="rhosn" type="float" > 330.0 </variable>16 <variable id="missval" type="float" > 1.e20 </variable>17 </variable_definition>18 8 <!-- Fields definition --> 19 <field_definition src="./field_def_nemo-oce.xml"/> <!-- NEMO ocean dynamics --> 20 <field_definition src="./field_def_nemo-ice.xml"/> <!-- NEMO sea-ice model --> 21 <field_definition src="./field_def_nemo-pisces.xml"/> <!-- NEMO ocean biology --> 9 <field_definition src="./field_def_nemo-oce.xml"/> <!-- NEMO ocean dynamics --> 10 <field_definition src="./field_def_nemo-ice.xml"/> <!-- NEMO sea-ice model --> 11 <field_definition src="./field_def_nemo-pisces.xml"/> <!-- NEMO ocean biology --> 22 12 23 13 <!-- Files definition --> 24 <file_definition src="./file_def_nemo-oce.xml"/> <!-- NEMO ocean dynamics --> 25 <file_definition src="./file_def_nemo-ice.xml"/> <!-- NEMO sea-ice model --> 26 <file_definition src="./file_def_nemo-pisces.xml"/> <!-- NEMO ocean biology --> 14 <file_definition src="./file_def_nemo-oce.xml"/> <!-- NEMO ocean dynamics --> 15 <file_definition src="./file_def_nemo-ice.xml"/> <!-- NEMO sea-ice model --> 16 <file_definition src="./file_def_nemo-pisces.xml"/> <!-- NEMO ocean biology --> 27 17 <!-- 28 18 ============================================================================================================ … … 32 22 33 23 <axis_definition> 34 <axis id="deptht" long_name="Vertical T levels" unit="m" positive="down" /> 35 <axis id="depthu" long_name="Vertical U levels" unit="m" positive="down" /> 36 <axis id="depthv" long_name="Vertical V levels" unit="m" positive="down" /> 37 <axis id="depthw" long_name="Vertical W levels" unit="m" positive="down" /> 38 <axis id="nfloat" long_name="Float number" unit="-" /> 39 <axis id="icbcla" long_name="Iceberg class" unit="1" /> 40 <axis id="ncatice" long_name="Ice category" unit="1" /> 41 <axis id="iax_20C" long_name="20 degC isotherm" unit="degC" /> 42 <axis id="iax_28C" long_name="28 degC isotherm" unit="degC" /> 24 <axis id="deptht" long_name="Vertical T levels" unit="m" positive="down" /> 25 <axis id="depthu" long_name="Vertical U levels" unit="m" positive="down" /> 26 <axis id="depthv" long_name="Vertical V levels" unit="m" positive="down" /> 27 <axis id="depthw" long_name="Vertical W levels" unit="m" positive="down" /> 28 <axis id="profsed" long_name="Vertical S levels" unit="cm" positive="down" /> 29 <axis id="nfloat" long_name="Float number" unit="-" /> 30 <axis id="icbcla" long_name="Iceberg class" unit="1" /> 31 <axis id="ncatice" long_name="Ice category" unit="1" /> 32 <axis id="iax_20C" long_name="20 degC isotherm" unit="degC" /> 33 <axis id="iax_28C" long_name="28 degC isotherm" unit="degC" /> 43 34 </axis_definition> 44 35 … … 46 37 47 38 <grid_definition src="./grid_def_nemo.xml"/> 48 39 49 40 </context> -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/cfgs/ORCA2_ICE_PISCES/EXPREF/namelist_cfg
r10075 r10345 88 88 nn_fwb = 2 ! FreshWater Budget: 89 89 ! ! =2 annual global mean of e-p-r set to zero 90 ln_wave = .false. ! Activate coupling with wave (T => fill namsbc_wave) 91 ln_cdgw = .false. ! Neutral drag coefficient read from wave model (T => ln_wave=.true. & fill namsbc_wave) 92 ln_sdw = .false. ! Read 2D Surf Stokes Drift & Computation of 3D stokes drift (T => ln_wave=.true. & fill namsbc_wave) 93 nn_sdrift = 0 ! Parameterization for the calculation of 3D-Stokes drift from the surface Stokes drift 94 ! ! = 0 Breivik 2015 parameterization: v_z=v_0*[exp(2*k*z)/(1-8*k*z)] 95 ! ! = 1 Phillips: v_z=v_o*[exp(2*k*z)-beta*sqrt(-2*k*pi*z)*erfc(sqrt(-2*k*z))] 96 ! ! = 2 Phillips as (1) but using the wave frequency from a wave model 97 ln_tauwoc = .false. ! Activate ocean stress modified by external wave induced stress (T => ln_wave=.true. & fill namsbc_wave) 98 ln_tauw = .false. ! Activate ocean stress components from wave model 99 ln_stcor = .false. ! Activate Stokes Coriolis term (T => ln_wave=.true. & ln_sdw=.true. & fill namsbc_wave) 90 100 / 91 101 !----------------------------------------------------------------------- … … 151 161 / 152 162 !----------------------------------------------------------------------- 163 &namsbc_wave ! External fields from wave model (ln_wave=T) 164 !----------------------------------------------------------------------- 165 / 166 !----------------------------------------------------------------------- 153 167 &namberg ! iceberg parameters (default: OFF) 154 168 !----------------------------------------------------------------------- -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/cfgs/ORCA2_ICE_PISCES/EXPREF/namelist_pisces_cfg
r9572 r10345 16 16 / 17 17 !----------------------------------------------------------------------- 18 &namp4z ice! parameters for nutrient limitations for PISCES std - ln_p4z18 &namp4zlim ! parameters for nutrient limitations for PISCES std - ln_p4z 19 19 !----------------------------------------------------------------------- 20 20 / 21 21 !----------------------------------------------------------------------- 22 &namp5z ice! parameters for nutrient limitations PISCES QUOTA - ln_p5z22 &namp5zlim ! parameters for nutrient limitations PISCES QUOTA - ln_p5z 23 23 !----------------------------------------------------------------------- 24 24 / -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/cfgs/ORCA2_OFF_PISCES/EXPREF/context_nemo.xml
r9930 r10345 23 23 <axis id="depthv" long_name="Vertical V levels" unit="m" positive="down" /> 24 24 <axis id="depthw" long_name="Vertical W levels" unit="m" positive="down" /> 25 <axis id="profsed" long_name="Vertical S levels" unit="cm" positive="down" /> 25 26 <axis id="nfloat" long_name="Float number" unit="-" /> 26 27 <axis id="icbcla" long_name="Iceberg class" unit="1" /> -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/cfgs/ORCA2_OFF_PISCES/EXPREF/namelist_pisces_cfg
r9572 r10345 17 17 / 18 18 !----------------------------------------------------------------------- 19 &namp4z ice! parameters for nutrient limitations for PISCES std - ln_p4z19 &namp4zlim ! parameters for nutrient limitations for PISCES std - ln_p4z 20 20 !----------------------------------------------------------------------- 21 21 / 22 22 !----------------------------------------------------------------------- 23 &namp5z ice! parameters for nutrient limitations PISCES QUOTA - ln_p5z23 &namp5zlim ! parameters for nutrient limitations PISCES QUOTA - ln_p5z 24 24 !----------------------------------------------------------------------- 25 25 / -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/cfgs/SHARED/field_def_nemo-pisces.xml
r9539 r10345 115 115 116 116 </field_group> 117 118 <!-- SEDIMENT variables on T sediment grid --> 119 <field_group id="sed_T" grid_ref="grid_T_3DS"> 120 <field id="SedDIC" long_name="Dissolved inorganic Concentration" unit="mmol/m3" /> 121 <field id="SedAlkalini" long_name="Total Alkalinity Concentration" unit="mmol/m3" /> 122 <field id="SedO2" long_name="Oxygen Concentration" unit="mmol/m3" /> 123 <field id="SedCaCO3" long_name="Calcite Concentration" unit="%" /> 124 <field id="SedPOS" long_name="Semi-ref POC Concentration" unit="%" /> 125 <field id="SedPOR" long_name="Refractory POC Concentration" unit="%" /> 126 <field id="SedPO4" long_name="Phosphate Concentration" unit="mmol/m3" /> 127 <field id="SedPOC" long_name="Labile POC Concentration" unit="%" /> 128 <field id="SedSil" long_name="Silicate Concentration" unit="mmol/m3" /> 129 <field id="SedFe2" long_name="Fe2+ Concentration" unit="mmol/m3" /> 130 <field id="SedBSi" long_name="Biogenic Silicate Concentration" unit="%" /> 131 <field id="SedNO3" long_name="Nitrate Concentration" unit="mmol/m3" /> 132 <field id="SedNH4" long_name="Ammonium Concentration" unit="mmol/m3" /> 133 <field id="SedH2S" long_name="H2S Concentration" unit="mmol/m3" /> 134 <field id="SedSO4" long_name="SO4 Concentration" unit="mmol/m3" /> 135 <field id="SedClay" long_name="Clay Concentration" unit="%" /> 136 <field id="SedFeO" long_name="Fe(OH)3 Concentration" unit="%" /> 137 <field id="SedFeS" long_name="FeS Concentration" unit="%" /> 138 <field id="SedpH" long_name="PH" unit="1" /> 139 <field id="SedCO3por" long_name="Bicarbonates" unit="mol/m3" /> 140 </field_group> 141 142 <!-- SEDIMENT additional variables on T sediment grid --> 143 <field_group id="Diag_S" grid_ref="grid_T_2D"> 144 <field id="FlxSi" long_name="Si sediment flux" unit="mol/cm2/s" /> 145 <field id="FlxO2" long_name="O2 sediment flux" unit="mol/cm2/s" /> 146 <field id="FlxDIC" long_name="DIC sediment flux" unit="mol/cm2/s" /> 147 <field id="FlxNO3" long_name="NO3 sediment flux" unit="mol/cm2/s" /> 148 <field id="FlxPO4" long_name="PO4 sediment flux" unit="mol/cm2/s" /> 149 <field id="FlxAlkalini" long_name="Alkalinity sediment flux" unit="mol/cm2/s" /> 150 <field id="FlxNH4" long_name="Ammonium sediment flux" unit="mol/cm2/s" /> 151 <field id="FlxH2S" long_name="H2S sediment flux" unit="mol/cm2/s" /> 152 <field id="FlxSO4" long_name="SO4 sediment flux" unit="mol/cm2/s" /> 153 <field id="FlxFe2" long_name="Fe2+ sediment flux" unit="mol/cm2/s" /> 154 <field id="Flxtot" long_name="Sediment net burial rate" unit="cm/s" /> 155 <field id="dzdep" long_name="Sedimentation rate" unit="cm/s" /> 156 <field id="sflxclay" long_name="Clay sedimentation rate" unit="g/m2/s" /> 157 <field id="sflxcal" long_name="Calcite sedimentation rate" unit="mol/m2/s" /> 158 <field id="sflxbsi" long_name="BSi Sedimentation rate" unit="mol/m2/s" /> 159 <field id="sflxpoc" long_name="POC Sedimentation rate" unit="mol/m2/s" /> 160 <field id="sflxfeo" long_name="Fe(OH)3 Sedimentation rate" unit="mol/m2/s" /> 161 </field_group> 117 162 118 163 <!-- PISCES additional diagnostics on T grid --> -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/cfgs/SHARED/grid_def_nemo.xml
r9930 r10345 15 15 <domain id="grid_T" /> 16 16 <axis id="deptht" /> 17 </grid> 18 <!-- --> 19 <grid id="grid_T_3DS" > 20 <domain id="grid_T" /> 21 <axis id="profsed" /> 17 22 </grid> 18 23 <!-- --> -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/cfgs/SHARED/namelist_pisces_ref
r10111 r10345 17 17 ln_p5z = .false. ! PISCES QUOTA model used 18 18 ln_ligand = .false. ! Enable organic ligands 19 ln_sediment = .false. ! Enable sediment module 19 20 / 20 21 !----------------------------------------------------------------------- … … 62 63 / 63 64 !----------------------------------------------------------------------- 64 &namp4z ice! parameters for nutrient limitations for PISCES std - ln_p4z65 &namp4zlim ! parameters for nutrient limitations for PISCES std - ln_p4z 65 66 !----------------------------------------------------------------------- 66 67 concnno3 = 1.e-6 ! Nitrate half saturation of nanophytoplankton … … 86 87 / 87 88 !----------------------------------------------------------------------- 88 &namp5z ice! parameters for nutrient limitations PISCES QUOTA - ln_p5z89 &namp5zlim ! parameters for nutrient limitations PISCES QUOTA - ln_p5z 89 90 !----------------------------------------------------------------------- 90 91 concnno3 = 3e-6 ! Nitrate half saturation of nanophytoplankton -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/cfgs/SHARED/namelist_ref
r10075 r10345 481 481 ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights filename ! rotation ! land/sea mask ! 482 482 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! ! pairing ! filename ! 483 sn_cdg = 'sdw_ wave' , 1 , 'drag_coeff' , .true. , .false., 'daily' , '', '' , ''484 sn_usd = 'sdw_ wave' , 1 , 'u_sd2d' , .true. , .false., 'daily' , '', '' , ''485 sn_vsd = 'sdw_ wave' , 1 , 'v_sd2d' , .true. , .false., 'daily' , '', '' , ''486 sn_hsw = 'sdw_ wave' , 1 , 'hs' , .true. , .false., 'daily' , '', '' , ''487 sn_wmp = 'sdw_ wave' , 1 , 'wmp' , .true. , .false., 'daily' , '', '' , ''488 sn_wfr = 'sdw_ wave' , 1 , 'wfr' , .true. , .false., 'daily' , '', '' , ''489 sn_wnum = 'sdw_ wave' , 1 , 'wave_num' , .true. , .false., 'daily' , '', '' , ''490 sn_tauwoc = 'sdw_ wave' , 1 , 'wave_stress', .true. , .false., 'daily' , '', '' , ''491 sn_tauwx = 'sdw_ wave' , 1 , 'wave_stress', .true. , .false., 'daily' , '', '' , ''492 sn_tauwy = 'sdw_ wave' , 1 , 'wave_stress', .true. , .false., 'daily' , '', '' , ''483 sn_cdg = 'sdw_ecwaves_orca2' , 6 , 'drag_coeff' , .true. , .true. , 'yearly' , '' , '' , '' 484 sn_usd = 'sdw_ecwaves_orca2' , 6 , 'u_sd2d' , .true. , .true. , 'yearly' , '' , '' , '' 485 sn_vsd = 'sdw_ecwaves_orca2' , 6 , 'v_sd2d' , .true. , .true. , 'yearly' , '' , '' , '' 486 sn_hsw = 'sdw_ecwaves_orca2' , 6 , 'hs' , .true. , .true. , 'yearly' , '' , '' , '' 487 sn_wmp = 'sdw_ecwaves_orca2' , 6 , 'wmp' , .true. , .true. , 'yearly' , '' , '' , '' 488 sn_wfr = 'sdw_ecwaves_orca2' , 6 , 'wfr' , .true. , .true. , 'yearly' , '' , '' , '' 489 sn_wnum = 'sdw_ecwaves_orca2' , 6 , 'wave_num' , .true. , .true. , 'yearly' , '' , '' , '' 490 sn_tauwoc = 'sdw_ecwaves_orca2' , 6 , 'wave_stress', .true. , .true. , 'yearly' , '' , '' , '' 491 sn_tauwx = 'sdw_ecwaves_orca2' , 6 , 'wave_stress', .true. , .true. , 'yearly' , '' , '' , '' 492 sn_tauwy = 'sdw_ecwaves_orca2' , 6 , 'wave_stress', .true. , .true. , 'yearly' , '' , '' , '' 493 493 / 494 494 !----------------------------------------------------------------------- -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/ICE/icedyn_adv_umx.F90
r10292 r10345 229 229 ! 230 230 DO jl = 1, ipl 231 DO jj = 1, jpjm1231 DO jj = 2, jpjm1 232 232 DO ji = 1, fs_jpim1 ! vector opt. 233 233 zfu_ho(ji,jj,jl) = puc(ji,jj) * zt_u(ji,jj,jl) 234 END DO 235 END DO 236 END DO 237 DO jl = 1, ipl 238 DO jj = 1, jpjm1 239 DO ji = fs_2, fs_jpim1 ! vector opt. 234 240 zfv_ho(ji,jj,jl) = pvc(ji,jj) * zt_v(ji,jj,jl) 235 241 END DO … … 242 248 ! -------------------------------------------------- 243 249 DO jl = 1, ipl 244 DO jj = 1, jpjm1250 DO jj = 2, jpjm1 245 251 DO ji = 1, fs_jpim1 ! vector opt. 246 252 zfu_ho(ji,jj,jl) = zfu_ho(ji,jj,jl) - zfu_ups(ji,jj,jl) 253 END DO 254 END DO 255 END DO 256 DO jl = 1, ipl 257 DO jj = 1, jpjm1 258 DO ji = fs_2, fs_jpim1 ! vector opt. 247 259 zfv_ho(ji,jj,jl) = zfv_ho(ji,jj,jl) - zfv_ups(ji,jj,jl) 248 260 END DO -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/ICE/icedyn_rhg_evp.F90
r10297 r10345 26 26 USE sbc_ice , ONLY : utau_ice, vtau_ice, snwice_mass, snwice_mass_b 27 27 USE ice ! sea-ice: ice variables 28 USE icevar ! ice_var_sshdyn 28 29 USE icedyn_rdgrft ! sea-ice: ice strength 29 30 USE bdy_oce , ONLY : ln_bdy … … 143 144 REAL(wp), DIMENSION(jpi,jpj) :: zs1, zs2, zs12 ! stress tensor components 144 145 REAL(wp), DIMENSION(jpi,jpj) :: zu_ice, zv_ice, zresr ! check convergence 145 REAL(wp), DIMENSION(jpi,jpj) :: z pice! array used for the calculation of ice surface slope:146 REAL(wp), DIMENSION(jpi,jpj) :: zssh_lead_m ! array used for the calculation of ice surface slope: 146 147 ! ! ocean surface (ssh_m) if ice is not embedded 147 148 ! ! ice top surface if ice is embedded … … 261 262 !------------------------------------------------------------------------------! 262 263 263 IF( ln_ice_embd ) THEN !== embedded sea ice: compute representative ice top surface ==! 264 ! 265 ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[n/nn_fsbc], n=0,nn_fsbc-1} 266 ! = (1/nn_fsbc)^2 * {SUM[n] , n=0,nn_fsbc-1} 267 zintn = REAL( nn_fsbc - 1 ) / REAL( nn_fsbc ) * 0.5_wp 268 ! 269 ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[1-n/nn_fsbc], n=0,nn_fsbc-1} 270 ! = (1/nn_fsbc)^2 * (nn_fsbc^2 - {SUM[n], n=0,nn_fsbc-1}) 271 zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp 272 ! 273 zpice(:,:) = ssh_m(:,:) + ( zintn * snwice_mass(:,:) + zintb * snwice_mass_b(:,:) ) * r1_rau0 274 ! 275 ELSE !== non-embedded sea ice: use ocean surface for slope calculation ==! 276 zpice(:,:) = ssh_m(:,:) 277 ENDIF 264 !== embedded sea ice: compute representative ice top surface ==! 265 !== non-embedded sea ice: use ocean surface for slope calculation ==! 266 zssh_lead_m(:,:) = ice_var_sshdyn( ssh_m, snwice_mass, snwice_mass_b) 278 267 279 268 DO jj = 2, jpjm1 … … 313 302 314 303 ! Surface pressure gradient (- m*g*GRAD(ssh)) at U-V points 315 zspgU(ji,jj) = - zmassU * grav * ( z pice(ji+1,jj) - zpice(ji,jj) ) * r1_e1u(ji,jj)316 zspgV(ji,jj) = - zmassV * grav * ( z pice(ji,jj+1) - zpice(ji,jj) ) * r1_e2v(ji,jj)304 zspgU(ji,jj) = - zmassU * grav * ( zssh_lead_m(ji+1,jj) - zssh_lead_m(ji,jj) ) * r1_e1u(ji,jj) 305 zspgV(ji,jj) = - zmassV * grav * ( zssh_lead_m(ji,jj+1) - zssh_lead_m(ji,jj) ) * r1_e2v(ji,jj) 317 306 318 307 ! masks -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/ICE/icevar.F90
r10069 r10345 49 49 !! ice_var_bv : brine volume 50 50 !! ice_var_enthalpy : compute ice and snow enthalpies from temperature 51 !! ice_var_sshdyn : compute equivalent ssh in lead 51 52 !!---------------------------------------------------------------------- 52 53 USE dom_oce ! ocean space and time domain 53 54 USE phycst ! physical constants (ocean directory) 54 USE sbc_oce , ONLY : sss_m 55 USE sbc_oce , ONLY : sss_m, ln_ice_embd, nn_fsbc 55 56 USE ice ! sea-ice: variables 56 57 USE ice1D ! sea-ice: thermodynamics variables … … 74 75 PUBLIC ice_var_bv 75 76 PUBLIC ice_var_enthalpy 77 PUBLIC ice_var_sshdyn 76 78 77 79 !!---------------------------------------------------------------------- … … 949 951 END SUBROUTINE ice_var_enthalpy 950 952 953 FUNCTION ice_var_sshdyn(pssh, psnwice_mass, psnwice_mass_b) 954 !!--------------------------------------------------------------------- 955 !! *** ROUTINE rhg_evp_rst *** 956 !! 957 !! ** Purpose : compute the equivalent ssh in lead when sea ice is embedded 958 !! 959 !! ** Method : ssh_lead = ssh + (Mice + Msnow) / rau0 960 !! 961 !! ** Reference : Jean-Michel Campin, John Marshall, David Ferreira, 962 !! Sea ice-ocean coupling using a rescaled vertical coordinate z*, 963 !! Ocean Modelling, Volume 24, Issues 1-2, 2008 964 !! 965 !!---------------------------------------------------------------------- 966 ! 967 ! input 968 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pssh !: ssh [m] 969 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: psnwice_mass !: mass of snow and ice at current ice time step [Kg/m2] 970 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: psnwice_mass_b !: mass of snow and ice at previous ice time step [Kg/m2] 971 ! 972 ! output 973 REAL(wp), DIMENSION(jpi,jpj) :: ice_var_sshdyn ! equivalent ssh in lead [m] 974 ! 975 ! temporary 976 REAL(wp) :: zintn, zintb ! time interpolation weights [] 977 REAL(wp), DIMENSION(jpi,jpj) :: zsnwiceload ! snow and ice load [m] 978 ! 979 ! compute ice load used to define the equivalent ssh in lead 980 IF( ln_ice_embd ) THEN 981 ! 982 ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[n/nn_fsbc], n=0,nn_fsbc-1} 983 ! = (1/nn_fsbc)^2 * {SUM[n] , n=0,nn_fsbc-1} 984 zintn = REAL( nn_fsbc - 1 ) / REAL( nn_fsbc ) * 0.5_wp 985 ! 986 ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[1-n/nn_fsbc], n=0,nn_fsbc-1} 987 ! = (1/nn_fsbc)^2 * (nn_fsbc^2 - {SUM[n], n=0,nn_fsbc-1}) 988 zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp 989 ! 990 zsnwiceload(:,:) = ( zintn * psnwice_mass(:,:) + zintb * psnwice_mass_b(:,:) ) * r1_rau0 991 ! 992 ELSE 993 zsnwiceload(:,:) = 0.0_wp 994 ENDIF 995 ! compute equivalent ssh in lead 996 ice_var_sshdyn(:,:) = pssh(:,:) + zsnwiceload(:,:) 997 ! 998 END FUNCTION ice_var_sshdyn 999 1000 951 1001 #else 952 1002 !!---------------------------------------------------------------------- -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/DOM/domvvl.F90
r10314 r10345 234 234 END DO 235 235 END DO 236 IF( cn_cfg == "orca" .AND. nn_cfg == 3 ) THEN ! ORCA2: Suppress ztilde in the Foxe Basin for ORCA2 237 ii0 = 103 ; ii1 = 111 238 ij0 = 128 ; ij1 = 135 ; 239 frq_rst_e3t( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.0_wp 240 frq_rst_hdv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0_wp / rdt 236 IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN 237 IF( nn_cfg == 3 ) THEN ! ORCA2: Suppress ztilde in the Foxe Basin for ORCA2 238 ii0 = 103 ; ii1 = 111 239 ij0 = 128 ; ij1 = 135 ; 240 frq_rst_e3t( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.0_wp 241 frq_rst_hdv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0_wp / rdt 242 ENDIF 241 243 ENDIF 242 244 ENDIF -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/DOM/dtatsd.F90
r10068 r10345 150 150 ! 151 151 ! !== ORCA_R2 configuration and T & S damping ==! 152 IF( cn_cfg == "orca" .AND. nn_cfg == 2 .AND. ln_tsd_dmp ) THEN ! some hand made alterations 153 ! 154 ij0 = 101 ; ij1 = 109 ! Reduced T & S in the Alboran Sea 155 ii0 = 141 ; ii1 = 155 156 DO jj = mj0(ij0), mj1(ij1) 157 DO ji = mi0(ii0), mi1(ii1) 158 sf_tsd(jp_tem)%fnow(ji,jj,13:13) = sf_tsd(jp_tem)%fnow(ji,jj,13:13) - 0.20_wp 159 sf_tsd(jp_tem)%fnow(ji,jj,14:15) = sf_tsd(jp_tem)%fnow(ji,jj,14:15) - 0.35_wp 160 sf_tsd(jp_tem)%fnow(ji,jj,16:25) = sf_tsd(jp_tem)%fnow(ji,jj,16:25) - 0.40_wp 161 ! 162 sf_tsd(jp_sal)%fnow(ji,jj,13:13) = sf_tsd(jp_sal)%fnow(ji,jj,13:13) - 0.15_wp 163 sf_tsd(jp_sal)%fnow(ji,jj,14:15) = sf_tsd(jp_sal)%fnow(ji,jj,14:15) - 0.25_wp 164 sf_tsd(jp_sal)%fnow(ji,jj,16:17) = sf_tsd(jp_sal)%fnow(ji,jj,16:17) - 0.30_wp 165 sf_tsd(jp_sal)%fnow(ji,jj,18:25) = sf_tsd(jp_sal)%fnow(ji,jj,18:25) - 0.35_wp 152 IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN 153 IF( nn_cfg == 2 .AND. ln_tsd_dmp ) THEN ! some hand made alterations 154 ! 155 ij0 = 101 ; ij1 = 109 ! Reduced T & S in the Alboran Sea 156 ii0 = 141 ; ii1 = 155 157 DO jj = mj0(ij0), mj1(ij1) 158 DO ji = mi0(ii0), mi1(ii1) 159 sf_tsd(jp_tem)%fnow(ji,jj,13:13) = sf_tsd(jp_tem)%fnow(ji,jj,13:13) - 0.20_wp 160 sf_tsd(jp_tem)%fnow(ji,jj,14:15) = sf_tsd(jp_tem)%fnow(ji,jj,14:15) - 0.35_wp 161 sf_tsd(jp_tem)%fnow(ji,jj,16:25) = sf_tsd(jp_tem)%fnow(ji,jj,16:25) - 0.40_wp 162 ! 163 sf_tsd(jp_sal)%fnow(ji,jj,13:13) = sf_tsd(jp_sal)%fnow(ji,jj,13:13) - 0.15_wp 164 sf_tsd(jp_sal)%fnow(ji,jj,14:15) = sf_tsd(jp_sal)%fnow(ji,jj,14:15) - 0.25_wp 165 sf_tsd(jp_sal)%fnow(ji,jj,16:17) = sf_tsd(jp_sal)%fnow(ji,jj,16:17) - 0.30_wp 166 sf_tsd(jp_sal)%fnow(ji,jj,18:25) = sf_tsd(jp_sal)%fnow(ji,jj,18:25) - 0.35_wp 167 END DO 166 168 END DO 167 END DO168 ij0 = 87 ; ij1 = 96 ! Reduced temperature in Red Sea169 ii0 = 148 ; ii1 = 160170 sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 4:10 ) = 7.0_wp171 sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 ) = 6.5_wp172 sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 ) = 6.0_wp169 ij0 = 87 ; ij1 = 96 ! Reduced temperature in Red Sea 170 ii0 = 148 ; ii1 = 160 171 sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 4:10 ) = 7.0_wp 172 sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 ) = 6.5_wp 173 sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 ) = 6.0_wp 174 ENDIF 173 175 ENDIF 174 176 !!gm end -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/DYN/dynspg_ts.F90
r10297 r10345 1114 1114 & ) * ssvmask(ji,jj) 1115 1115 1116 !jth implicit bottom friction:1117 IF ( ll_wd ) THEN ! revert to explicit for bit comparison tests in non wad runs1118 ua_e(ji,jj) = ua_e(ji,jj) /(1.0 - rdtbt * zCdU_u(ji,jj) * hur_e(ji,jj))1119 va_e(ji,jj) = va_e(ji,jj) /(1.0 - rdtbt * zCdU_v(ji,jj) * hvr_e(ji,jj))1120 ENDIF1121 1122 1116 END DO 1123 1117 END DO … … 1144 1138 & + hv_n(ji,jj) * zv_frc(ji,jj) ) & 1145 1139 & ) * zhvra 1140 END DO 1141 END DO 1142 ENDIF 1143 !jth implicit bottom friction: 1144 IF ( ll_wd ) THEN ! revert to explicit for bit comparison tests in non wad runs 1145 DO jj = 2, jpjm1 1146 DO ji = fs_2, fs_jpim1 ! vector opt. 1147 ua_e(ji,jj) = ua_e(ji,jj) /(1.0 - rdtbt * zCdU_u(ji,jj) * hur_e(ji,jj)) 1148 va_e(ji,jj) = va_e(ji,jj) /(1.0 - rdtbt * zCdU_v(ji,jj) * hvr_e(ji,jj)) 1146 1149 END DO 1147 1150 END DO … … 1393 1396 IF( TRIM(cdrw) == 'READ' ) THEN ! Read/initialise 1394 1397 ! ! --------------- 1395 IF( ln_rstart .AND. ln_bt_fw ) THEN !* Read the restart file1398 IF( ln_rstart .AND. ln_bt_fw .AND. (neuler/=0) ) THEN !* Read the restart file 1396 1399 CALL iom_get( numror, jpdom_autoglo, 'ub2_b' , ub2_b (:,:), ldxios = lrxios ) 1397 1400 CALL iom_get( numror, jpdom_autoglo, 'vb2_b' , vb2_b (:,:), ldxios = lrxios ) -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/ICB/icbutl.F90
r10314 r10345 24 24 #if defined key_si3 25 25 USE ice, ONLY: u_ice, v_ice, hm_i ! SI3 variables 26 USE icevar ! ice_var_sshdyn 27 USE sbc_ice, ONLY: snwice_mass, snwice_mass_b 26 28 #endif 27 29 … … 60 62 !! ** Method : - blah blah 61 63 !!---------------------------------------------------------------------- 62 64 #if defined key_si3 65 REAL(wp), DIMENSION(jpi,jpj) :: zssh_lead_m ! ocean surface (ssh_m) if ice is not embedded 66 ! ! ocean surface in leads if ice is embedded 67 #endif 63 68 ! copy nemo forcing arrays into iceberg versions with extra halo 64 69 ! only necessary for variables not on T points … … 84 89 ui_e(:,:) = 0._wp ; ui_e(1:jpi, 1:jpj) = u_ice(:,:) 85 90 vi_e(:,:) = 0._wp ; vi_e(1:jpi, 1:jpj) = v_ice(:,:) 91 ! 92 ! compute ssh slope using ssh_lead if embedded 93 zssh_lead_m(:,:) = ice_var_sshdyn(ssh_m, snwice_mass, snwice_mass_b) 94 ssh_e(:,:) = 0._wp ; ssh_e(1:jpi, 1:jpj) = zssh_lead_m(:,:) * tmask(:,:,1) 86 95 ! 87 96 CALL lbc_lnk_icb( 'icbutl', hicth, 'T', +1._wp, 1, 1 ) 88 97 CALL lbc_lnk_icb( 'icbutl', ui_e , 'U', -1._wp, 1, 1 ) 89 98 CALL lbc_lnk_icb( 'icbutl', vi_e , 'V', -1._wp, 1, 1 ) 99 #else 100 ssh_e(:,:) = 0._wp ; ssh_e(1:jpi, 1:jpj) = ssh_m(:,:) * tmask(:,:,1) 90 101 #endif 91 102 92 103 !! special for ssh which is used to calculate slope 93 104 !! so fudge some numbers all the way around the boundary 94 95 ssh_e(:,:) = 0._wp ; ssh_e(1:jpi, 1:jpj) = ssh_m(:,:) * tmask(:,:,1)96 105 ssh_e(0 , :) = ssh_e(1 , :) 97 106 ssh_e(jpi+1, :) = ssh_e(jpi, :) -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/IOM/iom.F90
r10170 r10345 43 43 USE ioipsl, ONLY : ju2ymds ! for calendar 44 44 USE crs ! Grid coarsening 45 #if defined key_top 46 USE trc, ONLY : profsed 47 #endif 45 48 USE lib_fortran 46 49 USE diurnal_bulk, ONLY : ln_diurnal_only, ln_diurnal … … 193 196 ! vertical grid definition 194 197 IF(.NOT.llrst_context) THEN 195 CALL iom_set_axis_attr( "deptht", paxis = gdept_1d )196 CALL iom_set_axis_attr( "depthu", paxis = gdept_1d )197 CALL iom_set_axis_attr( "depthv", paxis = gdept_1d )198 CALL iom_set_axis_attr( "depthw", paxis = gdepw_1d )198 CALL iom_set_axis_attr( "deptht", paxis = gdept_1d ) 199 CALL iom_set_axis_attr( "depthu", paxis = gdept_1d ) 200 CALL iom_set_axis_attr( "depthv", paxis = gdept_1d ) 201 CALL iom_set_axis_attr( "depthw", paxis = gdepw_1d ) 199 202 200 203 ! Add vertical grid bounds … … 219 222 CALL iom_set_axis_attr( "nstrait", (/ (REAL(ji,wp), ji=1,4) /) ) 220 223 # endif 224 #if defined key_top 225 CALL iom_set_axis_attr( "profsed", paxis = profsed ) 226 #endif 221 227 CALL iom_set_axis_attr( "icbcla", class_num ) 222 228 CALL iom_set_axis_attr( "iax_20C", (/ REAL(20,wp) /) ) -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/LBC/lbclnk.F90
r10314 r10345 173 173 174 174 !!---------------------------------------------------------------------- 175 !! *** routine lbc_bdy_lnk_(2,3 )d ***175 !! *** routine lbc_bdy_lnk_(2,3,4)d *** 176 176 !! 177 177 !! wrapper rountine to 'lbc_lnk_3d'. This wrapper is used -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/LBC/mppini.F90
r10330 r10345 139 139 !!---------------------------------------------------------------------- 140 140 INTEGER :: ji, jj, jn, jproc, jarea ! dummy loop indices 141 INTEGER :: inij , inijmin141 INTEGER :: inijmin 142 142 INTEGER :: i2add 143 143 INTEGER :: inum ! local logical unit -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/SBC/sbcblk.F90
r10297 r10345 239 239 !drag coefficient read from wave model definable only with mfs bulk formulae and core 240 240 ELSEIF (ln_cdgw .AND. .NOT. ln_NCAR ) THEN 241 CALL ctl_stop( 'drag coefficient read from wave model definable only with mfs bulk formulae and core')241 CALL ctl_stop( 'drag coefficient read from wave model definable only with NCAR and CORE bulk formulae') 242 242 ELSEIF (ln_stcor .AND. .NOT. ln_sdw) THEN 243 243 CALL ctl_stop( 'Stokes-Coriolis term calculated only if activated Stokes Drift ln_sdw=T') -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/SBC/sbcblk_algo_ncar.F90
r10069 r10345 149 149 Ch = 1.e-3*sqrt_Cd_n10*(18.*stab + 32.7*(1. - stab)) 150 150 stab = sqrt_Cd_n10 ! Temporaty array !!! stab == SQRT(Cd) 151 152 IF( ln_cdgw ) Cen = Ce ; Chn = Ch 151 153 152 154 !! Initializing values at z_u with z_t values: … … 186 188 IF( ln_cdgw ) THEN ! surface wave case 187 189 stab = vkarmn / ( vkarmn / sqrt_Cd_n10 - ztmp2 ) ! (stab == SQRT(Cd)) 188 Cd = stab * stab 190 Cd = stab * stab 191 ztmp0 = (LOG(zu/10.) - zpsi_h_u) / vkarmn / sqrt_Cd_n10 192 ztmp2 = stab / sqrt_Cd_n10 ! (stab == SQRT(Cd)) 193 ztmp1 = 1. + Chn * ztmp0 194 Ch = Chn * ztmp2 / ztmp1 ! L&Y 2004 eq. (10b) 195 ztmp1 = 1. + Cen * ztmp0 196 Ce = Cen * ztmp2 / ztmp1 ! L&Y 2004 eq. (10c) 197 189 198 ELSE 190 199 ! Update neutral wind speed at 10m and neutral Cd at 10m (L&Y 2004 eq. 9a)... … … 205 214 Cd = ztmp0 / ( ztmp1*ztmp1 ) 206 215 stab = SQRT( Cd ) ! Temporary array !!! (stab == SQRT(Cd)) 207 ENDIF 208 209 ztmp0 = (LOG(zu/10.) - zpsi_h_u) / vkarmn / sqrt_Cd_n10210 ztmp2 = stab / sqrt_Cd_n10 ! (stab == SQRT(Cd))211 ztmp1 = 1. + Cx_n10*ztmp0 ! (Cx_n10 == Ch_n10)212 Ch = Cx_n10*ztmp2 / ztmp1 ! L&Y 2004 eq. (10b) 213 214 Cx_n10 = 1.e-3 * (34.6 * sqrt_Cd_n10) ! L&Y 2004 eq. (6b) ! Cx_n10 == Ce_n10215 Cen(:,:) = Cx_n10216 ztmp1 = 1. + Cx_n10*ztmp0217 Ce = Cx_n10*ztmp2 / ztmp1 ! L&Y 2004 eq. (10c)216 217 ztmp0 = (LOG(zu/10.) - zpsi_h_u) / vkarmn / sqrt_Cd_n10 218 ztmp2 = stab / sqrt_Cd_n10 ! (stab == SQRT(Cd)) 219 ztmp1 = 1. + Cx_n10*ztmp0 ! (Cx_n10 == Ch_n10) 220 Ch = Cx_n10*ztmp2 / ztmp1 ! L&Y 2004 eq. (10b) 221 222 Cx_n10 = 1.e-3 * (34.6 * sqrt_Cd_n10) ! L&Y 2004 eq. (6b) ! Cx_n10 == Ce_n10 223 Cen(:,:) = Cx_n10 224 ztmp1 = 1. + Cx_n10*ztmp0 225 Ce = Cx_n10*ztmp2 / ztmp1 ! L&Y 2004 eq. (10c) 226 ENDIF 218 227 ! 219 228 END DO -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/SBC/sbcmod.F90
r10297 r10345 160 160 WRITE(numout,*) ' wave modified ocean stress component ln_tauw = ', ln_tauw 161 161 WRITE(numout,*) ' Stokes coriolis term ln_stcor = ', ln_stcor 162 WRITE(numout,*) ' neutral drag coefficient (CORE, MFS) ln_cdgw = ', ln_cdgw 163 ENDIF 164 ! 162 WRITE(numout,*) ' neutral drag coefficient (CORE,NCAR) ln_cdgw = ', ln_cdgw 163 ENDIF 164 ! 165 IF( .NOT.ln_wave ) THEN 166 ln_sdw = .false. ; ln_cdgw = .false. ; ln_tauwoc = .false. ; ln_tauw = .false. ; ln_stcor = .false. 167 ENDIF 165 168 IF( ln_sdw ) THEN 166 169 IF( .NOT.(nn_sdrift==jp_breivik_2014 .OR. nn_sdrift==jp_li_2017 .OR. nn_sdrift==jp_peakfr) ) & -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/ZDF/zdfgls.F90
r10297 r10345 275 275 ! building the matrix 276 276 zcof = rfact_tke * tmask(ji,jj,jk) 277 ! ! lower diagonal277 ! ! lower diagonal, in fact not used for jk = 2 (see surface conditions) 278 278 zd_lw(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk ) + p_avm(ji,jj,jk-1) ) / ( e3t_n(ji,jj,jk-1) * e3w_n(ji,jj,jk) ) 279 ! ! upper diagonal279 ! ! upper diagonal, in fact not used for jk = ibotm1 (see bottom conditions) 280 280 zd_up(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk+1) + p_avm(ji,jj,jk ) ) / ( e3t_n(ji,jj,jk ) * e3w_n(ji,jj,jk) ) 281 ! 281 ! ! diagonal 282 282 zdiag(ji,jj,jk) = 1._wp - zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) + rdt * zdiss * wmask(ji,jj,jk) 283 ! 283 ! ! right hand side in en 284 284 en(ji,jj,jk) = en(ji,jj,jk) + rdt * zesh2 * wmask(ji,jj,jk) 285 285 END DO … … 792 792 zstm(:,:,1) = zstm(:,:,2) 793 793 794 DO jj = 2, jpjm1 794 ! default value, in case jpk > mbkt(ji,jj)+1. Not needed but avoid a bug when looking for undefined values (-fpe0) 795 zstm(:,:,jpk) = 0. 796 DO jj = 2, jpjm1 ! update bottom with good values 795 797 DO ji = fs_2, fs_jpim1 ! vector opt. 796 798 zstm(ji,jj,mbkt(ji,jj)+1) = zstm(ji,jj,mbkt(ji,jj)) 797 799 END DO 798 800 END DO 801 802 zstt(:,:, 1) = wmask(:,:, 1) ! default value not needed but avoid a bug when looking for undefined values (-fpe0) 803 zstt(:,:,jpk) = wmask(:,:,jpk) ! default value not needed but avoid a bug when looking for undefined values (-fpe0) 804 799 805 !!gm should be done for ISF (top boundary cond.) 800 806 !!gm so, totally new staff needed!!gm … … 802 808 ! Compute diffusivities/viscosities 803 809 ! The computation below could be restrained to jk=2 to jpkm1 if GOTM style Dirichlet conditions are used 810 ! -> yes BUT p_avm(:,:1) and p_avm(:,:jpk) are used when we compute zd_lw(:,:2) and zd_up(:,:jpkm1). These values are 811 ! later overwritten by surface/bottom boundaries conditions, so we don't really care of p_avm(:,:1) and p_avm(:,:jpk) 812 ! for zd_lw and zd_up but they have to be defined to avoid a bug when looking for undefined values (-fpe0) 804 813 DO jk = 1, jpk 805 814 DO jj = 2, jpjm1 -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OFF/dtadyn.F90
r10297 r10345 46 46 PRIVATE 47 47 48 PUBLIC dta_dyn_init ! called by opa.F90 49 PUBLIC dta_dyn ! called by step.F90 50 PUBLIC dta_dyn_swp ! called by step.F90 48 PUBLIC dta_dyn_init ! called by opa.F90 49 PUBLIC dta_dyn ! called by step.F90 50 PUBLIC dta_dyn_sed_init ! called by opa.F90 51 PUBLIC dta_dyn_sed ! called by step.F90 52 PUBLIC dta_dyn_swp ! called by step.F90 51 53 52 54 CHARACTER(len=100) :: cn_dir !: Root directory for location of ssr files … … 164 166 hmld(:,:) = sf_dyn(jf_mld)%fnow(:,:,1) * tmask(:,:,1) ! mixed layer depht 165 167 avt(:,:,:) = sf_dyn(jf_avt)%fnow(:,:,:) * tmask(:,:,:) ! vertical diffusive coefficient 168 avs(:,:,:) = avt(:,:,:) 166 169 ! 167 170 IF( ln_trabbl .AND. .NOT.lk_c1d ) THEN ! diffusive Bottom boundary layer param … … 182 185 CALL prt_ctl(tab3d_1=uslp , clinfo1=' slp - u : ', tab3d_2=vslp, clinfo2=' v : ', kdim=jpk) 183 186 CALL prt_ctl(tab3d_1=wslpi , clinfo1=' slp - wi: ', tab3d_2=wslpj, clinfo2=' wj: ', kdim=jpk) 184 ! CALL prt_ctl(tab2d_1=fr_i , clinfo1=' fr_i - : ', mask1=tmask )185 ! CALL prt_ctl(tab2d_1=hmld , clinfo1=' hmld - : ', mask1=tmask )186 ! CALL prt_ctl(tab2d_1=fmmflx , clinfo1=' fmmflx - : ', mask1=tmask )187 ! CALL prt_ctl(tab2d_1=emp , clinfo1=' emp - : ', mask1=tmask )188 ! CALL prt_ctl(tab2d_1=wndm , clinfo1=' wspd - : ', mask1=tmask )189 ! CALL prt_ctl(tab2d_1=qsr , clinfo1=' qsr - : ', mask1=tmask )190 187 ENDIF 191 188 ! … … 418 415 END SUBROUTINE dta_dyn_init 419 416 417 SUBROUTINE dta_dyn_sed( kt ) 418 !!---------------------------------------------------------------------- 419 !! *** ROUTINE dta_dyn *** 420 !! 421 !! ** Purpose : Prepares dynamics and physics fields from a NEMO run 422 !! for an off-line simulation of passive tracers 423 !! 424 !! ** Method : calculates the position of data 425 !! - computes slopes if needed 426 !! - interpolates data if needed 427 !!---------------------------------------------------------------------- 428 INTEGER, INTENT(in) :: kt ! ocean time-step index 429 ! 430 !!---------------------------------------------------------------------- 431 ! 432 IF( ln_timing ) CALL timing_start( 'dta_dyn_sed') 433 ! 434 nsecdyn = nsec_year + nsec1jan000 ! number of seconds between Jan. 1st 00h of nit000 year and the middle of time step 435 ! 436 IF( kt == nit000 ) THEN ; nprevrec = 0 437 ELSE ; nprevrec = sf_dyn(jf_tem)%nrec_a(2) 438 ENDIF 439 CALL fld_read( kt, 1, sf_dyn ) != read data at kt time step ==! 440 ! 441 tsn(:,:,:,jp_tem) = sf_dyn(jf_tem)%fnow(:,:,:) * tmask(:,:,:) ! temperature 442 tsn(:,:,:,jp_sal) = sf_dyn(jf_sal)%fnow(:,:,:) * tmask(:,:,:) ! salinity 443 ! 444 CALL eos ( tsn, rhd, rhop, gdept_0(:,:,:) ) ! In any case, we need rhop 445 446 IF(ln_ctl) THEN ! print control 447 CALL prt_ctl(tab3d_1=tsn(:,:,:,jp_tem), clinfo1=' tn - : ', mask1=tmask, kdim=jpk ) 448 CALL prt_ctl(tab3d_1=tsn(:,:,:,jp_sal), clinfo1=' sn - : ', mask1=tmask, kdim=jpk ) 449 ENDIF 450 ! 451 IF( ln_timing ) CALL timing_stop( 'dta_dyn_sed') 452 ! 453 END SUBROUTINE dta_dyn_sed 454 455 456 SUBROUTINE dta_dyn_sed_init 457 !!---------------------------------------------------------------------- 458 !! *** ROUTINE dta_dyn_init *** 459 !! 460 !! ** Purpose : Initialisation of the dynamical data 461 !! ** Method : - read the data namdta_dyn namelist 462 !!---------------------------------------------------------------------- 463 INTEGER :: ierr, ierr0, ierr1, ierr2, ierr3 ! return error code 464 INTEGER :: ifpr ! dummy loop indice 465 INTEGER :: jfld ! dummy loop arguments 466 INTEGER :: inum, idv, idimv ! local integer 467 INTEGER :: ios ! Local integer output status for namelist read 468 !! 469 CHARACTER(len=100) :: cn_dir ! Root directory for location of core files 470 TYPE(FLD_N), DIMENSION(2) :: slf_d ! array of namelist informations on the fields to read 471 TYPE(FLD_N) :: sn_tem , sn_sal ! " " 472 !! 473 NAMELIST/namdta_dyn/cn_dir, ln_dynrnf, ln_dynrnf_depth, fwbcorr, & 474 & sn_tem, sn_sal 475 !!---------------------------------------------------------------------- 476 ! 477 REWIND( numnam_ref ) ! Namelist namdta_dyn in reference namelist : Offline: init. of dynamical data 478 READ ( numnam_ref, namdta_dyn, IOSTAT = ios, ERR = 901) 479 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdta_dyn in reference namelist', lwp ) 480 REWIND( numnam_cfg ) ! Namelist namdta_dyn in configuration namelist : Offline: init. of dynamical data 481 READ ( numnam_cfg, namdta_dyn, IOSTAT = ios, ERR = 902 ) 482 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namdta_dyn in configuration namelist', lwp ) 483 IF(lwm) WRITE ( numond, namdta_dyn ) 484 ! ! store namelist information in an array 485 ! ! Control print 486 IF(lwp) THEN 487 WRITE(numout,*) 488 WRITE(numout,*) 'dta_dyn : offline dynamics ' 489 WRITE(numout,*) '~~~~~~~ ' 490 WRITE(numout,*) ' Namelist namdta_dyn' 491 WRITE(numout,*) ' runoffs option enabled (T) or not (F) ln_dynrnf = ', ln_dynrnf 492 WRITE(numout,*) ' runoffs is spread in vertical ln_dynrnf_depth = ', ln_dynrnf_depth 493 WRITE(numout,*) ' annual global mean of empmr for ssh correction fwbcorr = ', fwbcorr 494 WRITE(numout,*) 495 ENDIF 496 ! 497 jf_tem = 1 ; jf_sal = 2 ; jfld = jf_sal 498 ! 499 slf_d(jf_tem) = sn_tem ; slf_d(jf_sal) = sn_sal 500 ! 501 ALLOCATE( sf_dyn(jfld), STAT=ierr ) ! set sf structure 502 IF( ierr > 0 ) THEN 503 CALL ctl_stop( 'dta_dyn: unable to allocate sf structure' ) ; RETURN 504 ENDIF 505 ! ! fill sf with slf_i and control print 506 CALL fld_fill( sf_dyn, slf_d, cn_dir, 'dta_dyn_init', 'Data in file', 'namdta_dyn' ) 507 ! 508 ! Open file for each variable to get his number of dimension 509 DO ifpr = 1, jfld 510 CALL fld_clopn( sf_dyn(ifpr), nyear, nmonth, nday ) 511 idv = iom_varid( sf_dyn(ifpr)%num , slf_d(ifpr)%clvar ) ! id of the variable sdjf%clvar 512 idimv = iom_file ( sf_dyn(ifpr)%num )%ndims(idv) ! number of dimension for variable sdjf%clvar 513 IF( sf_dyn(ifpr)%num /= 0 ) CALL iom_close( sf_dyn(ifpr)%num ) ! close file if already open 514 ierr1=0 515 IF( idimv == 3 ) THEN ! 2D variable 516 ALLOCATE( sf_dyn(ifpr)%fnow(jpi,jpj,1) , STAT=ierr0 ) 517 IF( slf_d(ifpr)%ln_tint ) ALLOCATE( sf_dyn(ifpr)%fdta(jpi,jpj,1,2) , STAT=ierr1 ) 518 ELSE ! 3D variable 519 ALLOCATE( sf_dyn(ifpr)%fnow(jpi,jpj,jpk) , STAT=ierr0 ) 520 IF( slf_d(ifpr)%ln_tint ) ALLOCATE( sf_dyn(ifpr)%fdta(jpi,jpj,jpk,2), STAT=ierr1 ) 521 ENDIF 522 IF( ierr0 + ierr1 > 0 ) THEN 523 CALL ctl_stop( 'dta_dyn_init : unable to allocate sf_dyn array structure' ) ; RETURN 524 ENDIF 525 END DO 526 ! 527 CALL dta_dyn_sed( nit000 ) 528 ! 529 END SUBROUTINE dta_dyn_sed_init 420 530 421 531 SUBROUTINE dta_dyn_swp( kt ) -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OFF/nemogcm.F90
r10297 r10345 110 110 IF( istp /= nit000 ) CALL day ( istp ) ! Calendar (day was already called at nit000 in day_init) 111 111 CALL iom_setkt ( istp - nit000 + 1, cxios_context ) ! say to iom that we are at time step kstp 112 #if defined key_sed_off 113 CALL dta_dyn_sed( istp ) ! Interpolation of the dynamical fields 114 #else 112 115 CALL dta_dyn ( istp ) ! Interpolation of the dynamical fields 113 116 IF( .NOT.ln_linssh ) CALL dta_dyn_swp( istp ) ! swap of sea surface height and vertical scale factors 114 117 #endif 115 118 CALL trc_stp ( istp ) ! time-stepping 116 119 CALL stp_ctl ( istp, indic ) ! Time loop: control and print … … 287 290 CALL trc_nam_run ! Needed to get restart parameters for passive tracers 288 291 CALL trc_rst_cal( nit000, 'READ' ) ! calendar 292 #if defined key_sed_off 293 CALL dta_dyn_sed_init ! Initialization for the dynamics 294 #else 289 295 CALL dta_dyn_init ! Initialization for the dynamics 296 #endif 290 297 291 298 CALL trc_init ! Passive tracers initialization -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/TOP/PISCES/P4Z/p4zbio.F90
r10069 r10345 15 15 USE p4zsink ! vertical flux of particulate matter due to sinking 16 16 USE p4zopt ! optical model 17 USE p4z ice! Co-limitations of differents nutrients17 USE p4zlim ! Co-limitations of differents nutrients 18 18 USE p4zprod ! Growth rate of the 2 phyto groups 19 19 USE p4zmort ! Mortality terms for phytoplankton 20 20 USE p4zmicro ! Sources and sinks of microzooplankton 21 21 USE p4zmeso ! Sources and sinks of mesozooplankton 22 USE p5z ice! Co-limitations of differents nutrients22 USE p5zlim ! Co-limitations of differents nutrients 23 23 USE p5zprod ! Growth rate of the 2 phyto groups 24 24 USE p5zmort ! Mortality terms for phytoplankton -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/TOP/PISCES/P4Z/p4zche.F90
r10068 r10345 37 37 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tempis ! In situ temperature 38 38 39 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: akb3 !: ???40 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: akw3 !: ???41 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: akf3 !: ???42 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: aks3 !: ???43 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ak1p3 !: ???44 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ak2p3 !: ???45 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ak3p3 !: ???46 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: aksi3 !: ???47 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: borat !: ???48 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: fluorid !: ???49 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sulfat !: ???39 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: akb3 !: ??? 40 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: akw3 !: ??? 41 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: akf3 !: ??? 42 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: aks3 !: ??? 43 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ak1p3 !: ??? 44 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ak2p3 !: ??? 45 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ak3p3 !: ??? 46 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: aksi3 !: ??? 47 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: borat !: ??? 48 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: fluorid !: ??? 49 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sulfat !: ??? 50 50 51 51 !!* Variable for chemistry of the CO2 cycle … … 233 233 END DO 234 234 235 236 237 235 ! CHEMICAL CONSTANTS - DEEP OCEAN 238 236 ! ------------------------------- … … 449 447 ! 450 448 END SUBROUTINE p4z_che 451 452 449 453 450 SUBROUTINE ahini_for_at(p_hini) -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/TOP/PISCES/P4Z/p4zmeso.F90
r10069 r10345 108 108 zdenom = zfoodlim / ( xkgraz2 + zfoodlim ) 109 109 zdenom2 = zdenom / ( zfood + rtrn ) 110 zgraze2 = grazrat2 * xstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpmes) 110 zgraze2 = grazrat2 * xstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpmes) * (1. - nitrfac(ji,jj,jk)) 111 111 112 112 zgrazd = zgraze2 * xprefc * zcompadi * zdenom2 -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/TOP/PISCES/P4Z/p4zmicro.F90
r10069 r10345 14 14 USE trc ! passive tracers common variables 15 15 USE sms_pisces ! PISCES Source Minus Sink variables 16 USE p4z ice! Co-limitations16 USE p4zlim ! Co-limitations 17 17 USE p4zprod ! production 18 18 USE iom ! I/O manager -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/TOP/PISCES/P4Z/p4zmort.F90
r10068 r10345 14 14 USE sms_pisces ! PISCES Source Minus Sink variables 15 15 USE p4zprod ! Primary productivity 16 USE p4z ice! Phytoplankton limitation terms16 USE p4zlim ! Phytoplankton limitation terms 17 17 USE prtctl_trc ! print control for debugging 18 18 -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/TOP/PISCES/P4Z/p4zprod.F90
r10314 r10345 15 15 USE trc ! passive tracers common variables 16 16 USE sms_pisces ! PISCES Source Minus Sink variables 17 USE p4z ice! Co-limitations of differents nutrients17 USE p4zlim ! Co-limitations of differents nutrients 18 18 USE prtctl_trc ! print control for debugging 19 19 USE iom ! I/O manager -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/TOP/PISCES/P4Z/p4zrem.F90
r10069 r10345 17 17 USE p4zche ! chemical model 18 18 USE p4zprod ! Growth rate of the 2 phyto groups 19 USE p4z ice19 USE p4zlim 20 20 USE prtctl_trc ! print control for debugging 21 21 USE iom ! I/O manager … … 116 116 zammonic = zremik * nitrfac(ji,jj,jk) * trb(ji,jj,jk,jpdoc) 117 117 denitr(ji,jj,jk) = zammonic * ( 1. - nitrfac2(ji,jj,jk) ) 118 zoxyrem = zammonic * nitrfac2(ji,jj,jk) 118 denitr(ji,jj,jk) = MIN( ( trb(ji,jj,jk,jpno3) - rtrn ) / rdenit, denitr(ji,jj,jk) ) 119 zoxyrem = zammonic - denitr(ji,jj,jk) 119 120 ! 120 121 zolimi (ji,jj,jk) = MAX( 0.e0, zolimi (ji,jj,jk) ) … … 189 190 & / ( 1.+ emoy(ji,jj,jk) ) * ( 1. + fr_i(ji,jj) * emoy(ji,jj,jk) ) 190 191 zdenitnh4 = nitrif * xstep * trb(ji,jj,jk,jpnh4) * nitrfac(ji,jj,jk) 192 zdenitnh4 = MIN( ( trb(ji,jj,jk,jpno3) - rtrn ) / rdenita, zdenitnh4 ) 191 193 ! Update of the tracers trends 192 194 ! ---------------------------- -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/TOP/PISCES/P4Z/p4zsed.F90
r10127 r10345 14 14 USE trc ! passive tracers common variables 15 15 USE sms_pisces ! PISCES Source Minus Sink variables 16 USE p4z ice! Co-limitations of differents nutrients16 USE p4zlim ! Co-limitations of differents nutrients 17 17 USE p4zsbc ! External source of nutrients 18 18 USE p4zint ! interpolation and computation of various fields 19 USE sed ! Sediment module 19 20 USE iom ! I/O manager 20 21 USE prtctl_trc ! print control for debugging … … 29 30 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,: ) :: sdenit !: Nitrate reduction in the sediments 30 31 REAL(wp) :: r1_rday !: inverse of rday 32 LOGICAL, SAVE :: lk_sed 31 33 32 34 !!---------------------------------------------------------------------- … … 70 72 ! 71 73 IF( ln_timing ) CALL timing_start('p4z_sed') 74 ! 75 IF( kt == nittrc000 .AND. knt == 1 ) THEN 76 r1_rday = 1. / rday 77 IF (ln_sediment .AND. ln_sed_2way) THEN 78 lk_sed = .TRUE. 79 ELSE 80 lk_sed = .FALSE. 81 ENDIF 82 ENDIF 72 83 ! 73 84 IF( kt == nittrc000 .AND. knt == 1 ) r1_rday = 1. / rday … … 185 196 ENDIF 186 197 187 ! Add the external input of iron from sediment mobilization188 ! ------------------------------------------------------189 IF( ln_ironsed ) THEN190 tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + ironsed(:,:,:) * rfact2191 IF( ln_ligand ) tra(:,:,:,jpfep) = tra(:,:,:,jpfep) + ( ironsed(:,:,:) * fep_rats ) * rfact2192 !193 IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "Ironsed" ) ) &194 & CALL iom_put( "Ironsed", ironsed(:,:,:) * 1.e+3 * tmask(:,:,:) ) ! iron inputs from sediments195 ENDIF196 197 198 ! Add the external input of iron from hydrothermal vents 198 199 ! ------------------------------------------------------ … … 231 232 232 233 IF( .NOT.lk_sed ) THEN 234 ! 235 ! Add the external input of iron from sediment mobilization 236 ! ------------------------------------------------------ 237 IF( ln_ironsed ) THEN 238 tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + ironsed(:,:,:) * rfact2 239 IF( ln_ligand ) tra(:,:,:,jpfep) = tra(:,:,:,jpfep) + ( ironsed(:,:,:) * fep_rats ) * rfact2 240 ! 241 IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "Ironsed" ) ) & 242 & CALL iom_put( "Ironsed", ironsed(:,:,:) * 1.e+3 * tmask(:,:,:) ) ! iron inputs from sediments 243 ENDIF 244 233 245 ! Computation of the sediment denitrification proportion: The metamodel from midlleburg (2006) is being used 234 246 ! Computation of the fraction of organic matter that is permanently buried from Dunne's model -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/TOP/PISCES/P4Z/p4zsms.F90
r10314 r10345 74 74 CALL p4z_che ! initialize the chemical constants 75 75 CALL ahini_for_at(hi) ! set PH at kt=nit000 76 t_oce_co2_flx_cum = 0._wp 76 77 ELSE 77 78 CALL p4z_rst( nittrc000, 'READ' ) !* read or initialize all required fields … … 101 102 ENDIF 102 103 ! 104 IF( ll_sbc ) CALL p4z_sbc( kt ) ! external sources of nutrients 105 ! 106 #if ! defined key_sed_off 103 107 CALL p4z_che ! computation of chemical constants 104 108 CALL p4z_int( kt ) ! computation of various rates for biogeochemistry 105 109 ! 106 IF( ll_sbc ) CALL p4z_sbc( kt ) ! external sources of nutrients107 108 110 DO jnt = 1, nrdttrc ! Potential time splitting if requested 109 111 ! … … 149 151 END DO 150 152 END IF 151 ! 152 IF( lk_sed ) THEN 153 #endif 154 ! 155 IF( ln_sediment ) THEN 153 156 ! 154 157 CALL sed_model( kt ) ! Main program of Sediment model 158 ! 159 IF( ln_top_euler ) THEN 160 DO jn = jp_pcs0, jp_pcs1 161 trn(:,:,:,jn) = trb(:,:,:,jn) 162 END DO 163 ENDIF 155 164 ! 156 165 ENDIF … … 352 361 IF(lwp) WRITE(numout,*) 353 362 354 IF( cn_cfg == "orca" .AND. .NOT. lk_c1d ) THEN ! ORCA configuration (not 1D) ! 355 ! ! --------------------------- ! 356 ! set total alkalinity, phosphate, nitrate & silicate 357 zarea = 1._wp / glob_sum( 'p4zsms', cvol(:,:,:) ) * 1e6 358 359 zalksumn = glob_sum( 'p4zsms', trn(:,:,:,jptal) * cvol(:,:,:) ) * zarea 360 zpo4sumn = glob_sum( 'p4zsms', trn(:,:,:,jppo4) * cvol(:,:,:) ) * zarea * po4r 361 zno3sumn = glob_sum( 'p4zsms', trn(:,:,:,jpno3) * cvol(:,:,:) ) * zarea * rno3 362 zsilsumn = glob_sum( 'p4zsms', trn(:,:,:,jpsil) * cvol(:,:,:) ) * zarea 363 IF( cn_cfg == "ORCA" .OR. cn_cfg == "orca") THEN 364 IF( .NOT. lk_c1d ) THEN ! ORCA configuration (not 1D) ! 365 ! ! --------------------------- ! 366 ! set total alkalinity, phosphate, nitrate & silicate 367 zarea = 1._wp / glob_sum( 'p4zsms', cvol(:,:,:) ) * 1e6 368 369 zalksumn = glob_sum( 'p4zsms', trn(:,:,:,jptal) * cvol(:,:,:) ) * zarea 370 zpo4sumn = glob_sum( 'p4zsms', trn(:,:,:,jppo4) * cvol(:,:,:) ) * zarea * po4r 371 zno3sumn = glob_sum( 'p4zsms', trn(:,:,:,jpno3) * cvol(:,:,:) ) * zarea * rno3 372 zsilsumn = glob_sum( 'p4zsms', trn(:,:,:,jpsil) * cvol(:,:,:) ) * zarea 363 373 364 IF(lwp) WRITE(numout,*) ' TALKN mean : ', zalksumn365 trn(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / zalksumn366 367 IF(lwp) WRITE(numout,*) ' PO4N mean : ', zpo4sumn368 trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / zpo4sumn369 370 IF(lwp) WRITE(numout,*) ' NO3N mean : ', zno3sumn371 trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / zno3sumn372 373 IF(lwp) WRITE(numout,*) ' SiO3N mean : ', zsilsumn374 trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * silmean / zsilsumn )375 !376 !377 IF( .NOT. ln_top_euler ) THEN378 zalksumb = glob_sum( 'p4zsms', trb(:,:,:,jptal) * cvol(:,:,:) ) * zarea379 zpo4sumb = glob_sum( 'p4zsms', trb(:,:,:,jppo4) * cvol(:,:,:) ) * zarea * po4r380 zno3sumb = glob_sum( 'p4zsms', trb(:,:,:,jpno3) * cvol(:,:,:) ) * zarea * rno3381 zsilsumb = glob_sum( 'p4zsms', trb(:,:,:,jpsil) * cvol(:,:,:) ) * zarea374 IF(lwp) WRITE(numout,*) ' TALKN mean : ', zalksumn 375 trn(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / zalksumn 376 377 IF(lwp) WRITE(numout,*) ' PO4N mean : ', zpo4sumn 378 trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / zpo4sumn 379 380 IF(lwp) WRITE(numout,*) ' NO3N mean : ', zno3sumn 381 trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / zno3sumn 382 383 IF(lwp) WRITE(numout,*) ' SiO3N mean : ', zsilsumn 384 trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * silmean / zsilsumn ) 385 ! 386 ! 387 IF( .NOT. ln_top_euler ) THEN 388 zalksumb = glob_sum( 'p4zsms', trb(:,:,:,jptal) * cvol(:,:,:) ) * zarea 389 zpo4sumb = glob_sum( 'p4zsms', trb(:,:,:,jppo4) * cvol(:,:,:) ) * zarea * po4r 390 zno3sumb = glob_sum( 'p4zsms', trb(:,:,:,jpno3) * cvol(:,:,:) ) * zarea * rno3 391 zsilsumb = glob_sum( 'p4zsms', trb(:,:,:,jpsil) * cvol(:,:,:) ) * zarea 382 392 383 IF(lwp) WRITE(numout,*) ' ' 384 IF(lwp) WRITE(numout,*) ' TALKB mean : ', zalksumb 385 trb(:,:,:,jptal) = trb(:,:,:,jptal) * alkmean / zalksumb 386 387 IF(lwp) WRITE(numout,*) ' PO4B mean : ', zpo4sumb 388 trb(:,:,:,jppo4) = trb(:,:,:,jppo4) * po4mean / zpo4sumb 389 390 IF(lwp) WRITE(numout,*) ' NO3B mean : ', zno3sumb 391 trb(:,:,:,jpno3) = trb(:,:,:,jpno3) * no3mean / zno3sumb 392 393 IF(lwp) WRITE(numout,*) ' SiO3B mean : ', zsilsumb 394 trb(:,:,:,jpsil) = MIN( 400.e-6,trb(:,:,:,jpsil) * silmean / zsilsumb ) 393 IF(lwp) WRITE(numout,*) ' ' 394 IF(lwp) WRITE(numout,*) ' TALKB mean : ', zalksumb 395 trb(:,:,:,jptal) = trb(:,:,:,jptal) * alkmean / zalksumb 396 397 IF(lwp) WRITE(numout,*) ' PO4B mean : ', zpo4sumb 398 trb(:,:,:,jppo4) = trb(:,:,:,jppo4) * po4mean / zpo4sumb 399 400 IF(lwp) WRITE(numout,*) ' NO3B mean : ', zno3sumb 401 trb(:,:,:,jpno3) = trb(:,:,:,jpno3) * no3mean / zno3sumb 402 403 IF(lwp) WRITE(numout,*) ' SiO3B mean : ', zsilsumb 404 trb(:,:,:,jpsil) = MIN( 400.e-6,trb(:,:,:,jpsil) * silmean / zsilsumb ) 405 ENDIF 395 406 ENDIF 396 407 ! -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/TOP/PISCES/P4Z/p5zmicro.F90
r10070 r10345 15 15 USE trc ! passive tracers common variables 16 16 USE sms_pisces ! PISCES Source Minus Sink variables 17 USE p5z ice! Phytoplankton limitation terms17 USE p5zlim ! Phytoplankton limitation terms 18 18 USE iom ! I/O manager 19 19 USE prtctl_trc ! print control for debugging -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/TOP/PISCES/P4Z/p5zmort.F90
r10070 r10345 14 14 USE trc ! passive tracers common variables 15 15 USE sms_pisces ! PISCES Source Minus Sink variables 16 USE p5z ice! Phytoplankton limitation terms16 USE p5zlim ! Phytoplankton limitation terms 17 17 USE prtctl_trc ! print control for debugging 18 18 -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/TOP/PISCES/P4Z/p5zprod.F90
r10314 r10345 16 16 USE trc ! passive tracers common variables 17 17 USE sms_pisces ! PISCES Source Minus Sink variables 18 USE p5z ice! Co-limitations of differents nutrients18 USE p5zlim ! Co-limitations of differents nutrients 19 19 USE prtctl_trc ! print control for debugging 20 20 USE iom ! I/O manager -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/TOP/PISCES/SED/par_sed.F90
r10068 r10345 7 7 !! ! 06-12 (C. Ethe) Orignal 8 8 !!---------------------------------------------------------------------- 9 #if defined key_sed 10 !!---------------------------------------------------------------------- 11 !! 'key_sed' Sediment 12 !!---------------------------------------------------------------------- 9 !! $Id$ 13 10 14 11 !! Domain characteristics … … 19 16 jpim1 => jpim1 , & !: jpi - 1 20 17 jpjm1 => jpjm1 , & !: jpj - 1 21 jpij => jpij 22 jp_tem => jp_tem 18 jpij => jpij , & !: jpi x jpj 19 jp_tem => jp_tem, & !: indice of temperature 23 20 jp_sal => jp_sal !: indice of salintity 24 21 25 #if ! defined key_sed_off 26 USE par_pisces 27 #endif 28 29 INTEGER, PARAMETER :: jpdta = 12 30 22 INTEGER, PARAMETER :: jpdta = 17 31 23 32 24 ! Vertical sediment geometry 33 INTEGER, P ARAMETER ::&34 jpksed = 11 , & !: number of sediment layers35 jpksedm1 = jpksed - 136 25 INTEGER, PUBLIC :: & 26 jpksed = 11 , & 27 jpksedm1 = 10 28 37 29 ! sediment tracer species 38 INTEGER, PARAMETER :: & 39 jpsol = 4, & !: number of solid component 40 jpwat = 7, & !: number of pore water component 41 jpwatp1 = jpwat + 1 30 INTEGER, PARAMETER :: & 31 jpsol = 8, & !: number of solid component 32 jpwat = 10, & !: number of pore water component 33 jpwatp1 = jpwat +1, & 34 jpsol1 = jpsol - 1 35 42 36 43 37 ! pore water components … … 49 43 jwpo4 = 5, & !: phosphate 50 44 jwalk = 6, & !: alkalinity 51 jwc13 = 7 !: dissolved inorganic carbon 13 45 jwnh4 = 7, & !: Ammonium 46 jwh2s = 8, & !: Sulfate 47 jwso4 = 9, & !: H2S 48 jwfe2 = 10 !: Fe2+ 52 49 53 50 ! solid components … … 56 53 jsclay = 2, & !: clay 57 54 jspoc = 3, & !: organic carbon 58 jscal = 4 !: calcite 55 jscal = 4, & !: calcite 56 jspos = 5, & !: semi-ref POC 57 jspor = 6, & !: refractory POC 58 jsfeo = 7, & !: iron hydroxides 59 jsfes = 8 !: FeS 59 60 60 61 INTEGER, PARAMETER :: & 61 62 jptrased = jpsol + jpwat , & 62 jpdia3dsed = 3 , & 63 jpdia2dsed = 7 64 #endif 63 jpdia3dsed = 2 , & 64 jpdia2dsed = 12 65 65 66 !!----------------------------------------------------------------------67 !! NEMO/TOP 4.0 , NEMO Consortium (2018)68 !! $Id$69 !! Software governed by the CeCILL license (see ./LICENSE)70 !!======================================================================71 66 END MODULE par_sed -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/TOP/PISCES/SED/sed.F90
r9124 r10345 7 7 !! ! 06-12 (C. Ethe) Orignal 8 8 !!---------------------------------------------------------------------- 9 #if defined key_sed10 !!----------------------------------------------------------------------11 !! 'key_sed' Sediment12 !!----------------------------------------------------------------------13 9 USE par_sed 10 USE oce_sed 14 11 USE in_out_manager 12 15 13 16 14 IMPLICIT NONE 17 15 PUBLIC 18 16 19 PUBLIC sed_alloc 20 21 USE dom_oce , ONLY : nidom => nidom !: 22 USE dom_oce , ONLY : glamt => glamt !: longitude of t-point (degre) 23 USE dom_oce , ONLY : gphit => gphit !: latitude of t-point (degre) 24 USE dom_oce , ONLY : e3t_1d => e3t_1d !: reference depth of t-points (m) 25 USE dom_oce , ONLY : mbkt => mbkt !: vertical index of the bottom last T- ocean level 26 USE dom_oce , ONLY : tmask => tmask !: land/ocean mask at t-points 27 USE dom_oce , ONLY : rdt => rdt !: time step for the dynamics 28 USE dom_oce , ONLY : nyear => nyear !: Current year 29 USE dom_oce , ONLY : nmonth => nmonth !: Current month 30 USE dom_oce , ONLY : nday => nday !: Current day 31 USE dom_oce , ONLY : ndastp => ndastp !: time step date in year/month/day aammjj 32 USE dom_oce , ONLY : nday_year => nday_year !: curent day counted from jan 1st of the current year 33 USE dom_oce , ONLY : adatrj => adatrj !: number of elapsed days since the begining of the run 34 ! !: it is the accumulated duration of previous runs 35 ! !: that may have been run with different time steps. 36 37 #if ! defined key_sed_off 38 39 USE oce , ONLY : tsn => tsn !: pot. temperature (celsius) and salinity (psu) 40 41 USE trc , ONLY : trn => trc !: tracer 42 USE trc , ONLY : nwritetrc => nwritetrc !: outputs frequency of tracer model 43 44 USE p4zsink , ONLY : sinking => sinking !: sinking flux for POC 45 USE p4zsink , ONLY : sinking2 => sinking2 !: sinking flux for GOC 46 USE p4zsink , ONLY : sinkcal => sinkcal !: sinking flux for calcite 47 USE p4zsink , ONLY : sinksil => sinksil !: sinking flux for opal ( dsi ) 48 49 USE sms_pisces, ONLY : akb3 => akb3 !: Chemical constants 50 USE sms_pisces, ONLY : ak13 => ak13 !: Chemical constants 51 USE sms_pisces, ONLY : ak23 => ak23 !: Chemical constants 52 USE sms_pisces, ONLY : akw3 => akw3 !: Chemical constants 53 USE sms_pisces, ONLY : aksp => aksp !: Chemical constants 54 USE sms_pisces, ONLY : borat => borat !: Chemical constants ( borat ) 55 56 #endif 57 17 PUBLIC sed_alloc 58 18 59 19 !! Namelist 60 REAL(wp), PUBLIC, DIMENSION(5) :: reac !: reactivity rc in [l.mol-1.s-1]61 20 REAL(wp), PUBLIC :: reac_sil !: reactivity of silicate in [l.mol-1.s-1] 62 21 REAL(wp), PUBLIC :: reac_clay !: reactivity of clay in [l.mol-1.s-1] 63 REAL(wp), PUBLIC :: reac_poc !: reactivity of poc in [l.mol-1.s-1] 64 REAL(wp), PUBLIC :: reac_no3 !: reactivity of no3 in [l.mol-1.s-1] 22 REAL(wp), PUBLIC :: reac_ligc !: reactivity of Ligands [l.mol-1.s-1] 23 REAL(wp), PUBLIC :: reac_pocl !: reactivity of pocl in [s-1] 24 REAL(wp), PUBLIC :: reac_pocs !: reactivity of pocs in [s-1] 25 REAL(wp), PUBLIC :: reac_pocr !: reactivity of pocr in [s-1] 26 REAL(wp), PUBLIC :: reac_nh4 !: reactivity of NH4 in [l.mol-1.s-1] 27 REAL(wp), PUBLIC :: reac_h2s !: reactivity of ODU in [l.mol-1.s-1] 28 REAL(wp), PUBLIC :: reac_fe2 !: reactivity of Fe2+ in [l.mol-1.s-1] 29 REAL(wp), PUBLIC :: reac_feh2s !: reactivity of Fe2+ in [l.mol-1.s-1] 30 REAL(wp), PUBLIC :: reac_fes !: reactivity of Fe with H2S in [l.mol-1.s-1] 31 REAL(wp), PUBLIC :: reac_feso !: reactivity of FeS with O2 in [l.mol-1.s-1] 65 32 REAL(wp), PUBLIC :: reac_cal !: reactivity of cal in [l.mol-1.s-1] 66 REAL(wp), PUBLIC :: sat_sil !: saturation concentration for silicate in [mol.l-1]67 REAL(wp), PUBLIC :: sat_clay !: saturation concentration for clay in [mol.l-1]33 REAL(wp), PUBLIC :: adsnh4 !: adsorption coefficient of NH4 34 REAL(wp), PUBLIC :: ratligc !: C/L ratio in POC 68 35 REAL(wp), PUBLIC :: so2ut 69 36 REAL(wp), PUBLIC :: srno3 70 37 REAL(wp), PUBLIC :: spo4r 71 38 REAL(wp), PUBLIC :: srDnit 72 REAL(wp), PUBLIC :: sthro2 !: threshold O2 concen. in [mol.l-1]73 REAL(wp), PUBLIC :: pdb = 0.0112372 !: 13C/12C in PD Belemnite74 REAL(wp), PUBLIC :: rc13P = 0.980 !: 13C/12C in POC = rc13P*PDB75 REAL(wp), PUBLIC :: rc13Ca = 1.001 !: 13C/12C in CaCO3 = rc13Ca*PDB76 39 REAL(wp), PUBLIC :: dtsed !: sedimentation time step 77 REAL(wp), PUBLIC :: db !: bioturb coefficient in [cm2.s-1] 78 40 REAL(wp), PUBLIC :: dtsed2 !: sedimentation time step 79 41 INTEGER , PUBLIC :: nitsed000 80 42 INTEGER , PUBLIC :: nitsedend 81 INTEGER , PUBLIC :: nwrised 82 INTEGER , PUBLIC :: nfreq 83 REAL(wp), PUBLIC :: dens !: density of solid material 43 INTEGER, PUBLIC :: nrseddt 44 REAL , PUBLIC :: sedmask 45 REAL(wp), PUBLIC :: denssol !: density of solid material 46 INTEGER , PUBLIC :: numrsr, numrsw !: logical unit for sed restart (read and write) 47 LOGICAL , PUBLIC :: lrst_sed !: logical to control the trc restart write 48 LOGICAL , PUBLIC :: ln_rst_sed = .TRUE. !: initialisation from a restart file or not 49 LOGICAL , PUBLIC :: ln_btbz = .FALSE. !: Depth variation of the bioturbation coefficient 50 LOGICAL , PUBLIC :: ln_irrig = .FALSE. !: iActivation of the bioirrigation 51 LOGICAL , PUBLIC :: ln_sed_2way = .FALSE. !: 2 way coupling with PISCES 52 LOGICAL , PUBLIC :: ln_sediment_offline = .FALSE. !: Offline mode for sediment module 53 INTEGER , PUBLIC :: nn_rstsed !: control of the time step ( 0 or 1 ) for pass. tr. 54 INTEGER , PUBLIC :: nn_dtsed = 1 !: frequency of step on passive tracers 55 CHARACTER(len = 80) , PUBLIC :: cn_sedrst_in !: suffix of pass. tracer restart name (input) 56 CHARACTER(len = 256), PUBLIC :: cn_sedrst_indir !: restart input directory 57 CHARACTER(len = 80) , PUBLIC :: cn_sedrst_out !: suffix of pass. tracer restart name (output) 58 CHARACTER(len = 256), PUBLIC :: cn_sedrst_outdir !: restart output directory 59 84 60 ! 85 61 REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: pwcp !: pore water sediment data at given time-step … … 87 63 REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: solcp !: solid sediment data at given time-step 88 64 REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: solcp0 !: solid sediment data at initial time 65 REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: trc_dta 66 REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: diff 89 67 90 68 !! * Shared module variables … … 102 80 REAL(wp), PUBLIC, DIMENSION(: ), ALLOCATABLE :: press !: pressure 103 81 REAL(wp), PUBLIC, DIMENSION(: ), ALLOCATABLE :: raintg !: total massic flux rained in each cell (sum of sol. comp.) 82 REAL(wp), PUBLIC, DIMENSION(: ), ALLOCATABLE :: fecratio !: Fe/C ratio in falling particles to the sediments 104 83 REAL(wp), PUBLIC, DIMENSION(: ), ALLOCATABLE :: dzdep !: total thickness of solid material rained [cm] in each cell 84 REAL(wp), PUBLIC, DIMENSION(: ), ALLOCATABLE :: zkbot !: total thickness of solid material rained [cm] in each cell 85 REAL(wp), PUBLIC, DIMENSION(: ), ALLOCATABLE :: wacc !: total thickness of solid material rained [cm] in each cell 105 86 ! 106 87 REAL(wp), PUBLIC, DIMENSION(:,: ), ALLOCATABLE :: hipor !: [h+] in mol/kg*densSW … … 127 108 REAL(wp), PUBLIC, DIMENSION(: ), ALLOCATABLE :: aksis 128 109 REAL(wp), PUBLIC, DIMENSION(: ), ALLOCATABLE :: aksps 110 REAL(wp), PUBLIC, DIMENSION(: ), ALLOCATABLE :: sieqs 111 REAL(wp), PUBLIC, DIMENSION(: ), ALLOCATABLE :: aks3s 112 REAL(wp), PUBLIC, DIMENSION(: ), ALLOCATABLE :: akf3s 113 REAL(wp), PUBLIC, DIMENSION(: ), ALLOCATABLE :: sulfats 114 REAL(wp), PUBLIC, DIMENSION(: ), ALLOCATABLE :: fluorids 129 115 130 116 REAL(wp), PUBLIC, DIMENSION(: ), ALLOCATABLE :: mol_wgt !: molecular weight of solid sediment data … … 133 119 !! Geometry 134 120 INTEGER , PUBLIC, SAVE :: jpoce, indoce !: Ocean points ( number/indices ) 135 REAL(wp), PUBLIC, DIMENSION(: ), ALLOCATABLE :: iarroce !: Computation of 1D array of sediments points121 INTEGER , PUBLIC, DIMENSION(: ), ALLOCATABLE :: iarroce !: Computation of 1D array of sediments points 136 122 REAL(wp), PUBLIC, DIMENSION(:,: ), ALLOCATABLE :: epkbot !: ocean bottom layer thickness 123 REAL(wp), PUBLIC, DIMENSION(:,: ), ALLOCATABLE :: gdepbot !: Depth of the sediment 137 124 REAL(wp), PUBLIC, DIMENSION(: ), ALLOCATABLE :: dzkbot !: ocean bottom layer thickness in meters 138 REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: tmasksed !: sediment mask139 REAL(wp), PUBLIC, DIMENSION(:,: ), ALLOCATABLE :: sbathy !: bathymetry140 125 REAL(wp), PUBLIC, DIMENSION(: ), ALLOCATABLE :: dz !: sediment layers thickness 141 126 REAL(wp), PUBLIC, DIMENSION(: ), ALLOCATABLE :: por !: porosity profile 142 127 REAL(wp), PUBLIC, DIMENSION(: ), ALLOCATABLE :: por1 !: 1-por 143 REAL(wp), PUBLIC, DIMENSION(: ), ALLOCATABLE :: profsed !: depth of middle of each layer144 128 REAL(wp), PUBLIC, DIMENSION(: ), ALLOCATABLE :: volw !: volume of pore water cell fraction 145 129 REAL(wp), PUBLIC, DIMENSION(: ), ALLOCATABLE :: vols !: volume of solid cell fraction 146 REAL(wp), PUBLIC, DIMENSION(: ), ALLOCATABLE :: diff !: diffusion ceofficient 130 REAL(wp), PUBLIC, DIMENSION(:,: ), ALLOCATABLE :: db !: bioturbation ceofficient 131 REAL(wp), PUBLIC, DIMENSION(:,: ), ALLOCATABLE :: irrig !: bioturbation ceofficient 147 132 REAL(wp), PUBLIC, DIMENSION(: ), ALLOCATABLE :: rdtsed !: sediment model time-step 133 REAL(wp), PUBLIC, DIMENSION(:,: ), ALLOCATABLE :: sedligand 148 134 REAL(wp) :: dens !: density of solid material 149 135 !! Inputs / Outputs … … 171 157 !!------------------------------------------------------------------- 172 158 ! 173 ALLOCATE( trc_dta(jpi,jpj,jdta) , & 174 & epkbot(jpi,jpj), sbathy(jpi,jpj) , & 175 & tmasksed(jpi,jpj,jpksed) , & 176 & dz(jpksed) , por(jpksed) , por1(jpksed), profsed(jpksed) , & 177 & volw(jpksed), vols(jpksed), diff(jpksed), rdtsed(jpksed) , & 159 ALLOCATE( trc_data(jpi,jpj,jpdta) , & 160 & epkbot(jpi,jpj), gdepbot(jpi,jpj) , & 161 & dz(jpksed) , por(jpksed) , por1(jpksed) , & 162 & volw(jpksed), vols(jpksed), rdtsed(jpksed) , & 178 163 & trcsedi (jpi,jpj,jpksed,jptrased) , & 179 164 & flxsedi3d(jpi,jpj,jpksed,jpdia3dsed) , & 180 & flxsedi2d(jpi,jpj,jp ksed,jpdia2dsed), &165 & flxsedi2d(jpi,jpj,jpdia2dsed) , & 181 166 & mol_wgt(jpsol), STAT=sed_alloc ) 182 167 … … 185 170 END FUNCTION sed_alloc 186 171 187 #else188 !!======================================================================189 !! No Sediment model190 !!======================================================================191 #endif192 193 172 END MODULE sed -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/TOP/PISCES/SED/sedadv.F90
r9124 r10345 4 4 !! Sediment : vertical advection and burial 5 5 !!===================================================================== 6 #if defined key_sed 7 !!---------------------------------------------------------------------- 8 !! 'key_sed' Sediment 6 !! * Modules used 9 7 !!---------------------------------------------------------------------- 10 8 !! sed_adv : 11 9 !!---------------------------------------------------------------------- 12 10 USE sed ! sediment global variable 11 USE lib_mpp ! distribued memory computing library 12 13 IMPLICIT NONE 14 PRIVATE 13 15 14 16 PUBLIC sed_adv 15 16 !! * Module variable 17 INTEGER, PARAMETER :: nztime = jpksed ! number of time step between sunrise and sunset 18 19 REAL(wp), DIMENSION(jpksed), SAVE :: dvolsp, dvolsm 20 REAL(wp), DIMENSION(jpksed), SAVE :: c2por, ckpor 17 PUBLIC sed_adv_alloc 18 19 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: dvolsp, dvolsm 20 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: c2por, ckpor 21 21 22 22 REAL(wp) :: cpor … … 49 49 ! * local variables 50 50 INTEGER :: ji, jk, js 51 INTEGER :: jn, ntimes, ikwneg51 INTEGER :: jn, ntimes, nztime, ikwneg 52 52 53 REAL(wp), DIMENSION( :,:), ALLOCATABLE:: zsolcpno54 REAL(wp), DIMENSION( : ), ALLOCATABLE:: zfilled, zfull, zfromup, zempty55 REAL(wp), DIMENSION( :,:), ALLOCATABLE:: zgap, zwb56 REAL(wp), DIMENSION( :,:), ALLOCATABLE:: zrainrf57 REAL(wp), DIMENSION( nztime) ::zraipush58 59 REAL(wp) :: zkwnup, zkwnlo, zfrac, zfromce, zrest 53 REAL(wp), DIMENSION(jpksed,jpsol) :: zsolcpno 54 REAL(wp), DIMENSION(jpksed) :: zfilled, zfull, zfromup, zempty 55 REAL(wp), DIMENSION(jpoce,jpksed) :: zgap, zwb 56 REAL(wp), DIMENSION(jpoce,jpsol) :: zrainrf 57 REAL(wp), DIMENSION(: ), ALLOCATABLE :: zraipush 58 59 REAL(wp) :: zkwnup, zkwnlo, zfrac, zfromce, zrest, sumtot, zsumtot1 60 60 61 61 !------------------------------------------------------------------------ 62 62 63 63 64 IF( ln_timing ) CALL timing_start('sed_adv') 65 ! 64 66 IF( kt == nitsed000 ) THEN 65 WRITE(numsed,*) ' ' 66 WRITE(numsed,*) ' sed_adv : vertical sediment advection ' 67 WRITE(numsed,*) ' ' 68 por1clay = dens * por1(jpksed) * dz(jpksed) / mol_wgt(jsclay) 67 IF (lwp) THEN 68 WRITE(numsed,*) ' ' 69 WRITE(numsed,*) ' sed_adv : vertical sediment advection ' 70 WRITE(numsed,*) ' ' 71 ENDIF 72 por1clay = denssol * por1(jpksed) * dz(jpksed) 69 73 cpor = por1(jpksed) / por1(2) 70 74 DO jk = 2, jpksed … … 80 84 ENDIF 81 85 82 ALLOCATE( zsolcpno(jpksed,jpsol), zrainrf(jpoce,jpsol) )83 ALLOCATE( zfilled(jpksed), zfull(jpksed), zfromup(jpksed), zempty(jpksed) )84 ALLOCATE( zgap (jpoce,jpksed) , zwb(jpoce,jpksed) )85 86 86 ! Initialization of data for mass balance calculation 87 87 !--------------------------------------------------- … … 89 89 tosed (:,:) = 0. 90 90 rloss (:,:) = 0. 91 91 ikwneg = 1 92 nztime = jpksed 93 94 ALLOCATE( zraipush(nztime) ) 92 95 93 96 ! Initiate gap … … 104 107 zgap(1:jpoce,1:jpksed) = 1. - zgap(1:jpoce,1:jpksed) 105 108 106 107 109 ! Initiate burial rates 108 110 !----------------------- 109 111 zwb(:,:) = 0. 110 112 DO jk = 2, jpksed 111 zfrac = dtsed / ( dens * por1(jk) )113 zfrac = dtsed / ( denssol * por1(jk) ) 112 114 DO ji = 1, jpoce 113 115 zwb(ji,jk) = zfrac * raintg(ji) … … 127 129 ENDDO 128 130 129 130 131 zrainrf(:,:) = 0. 131 132 DO ji = 1, jpoce … … 206 207 ! quantities to push in deeper sediment 207 208 tosed (ji,js) = zsolcpno(jpksed,js) & 208 & * zwb(ji,jpksed) * dens * por1(jpksed) / mol_wgt(js)209 ENDDO 210 209 & * zwb(ji,jpksed) * denssol * por1(jpksed) 210 ENDDO 211 211 212 ELSE ! what is remaining is great than dz(2) 212 213 213 214 ntimes = INT( zrest / dz(2) ) + 1 214 IF( ntimes > nztime ) THEN 215 WRITE( numsed,* ) ' sedadv : rest too large at sediment point ji = ', ji 216 STOP 217 ENDIF 215 IF( ntimes > nztime ) CALL ctl_stop( 'STOP', 'sed_adv : rest too large ' ) 218 216 zraipush(1) = dz(2) 219 217 zrest = zrest - zraipush(1) … … 249 247 fromsed(ji,js) = 0. 250 248 tosed (ji,js) = tosed(ji,js) + zsolcpno(jpksed,js) * zraipush(jn) & 251 & * dens * por1(2) / mol_wgt(js)249 & * denssol * por1(2) 252 250 ENDDO 253 251 ENDDO … … 279 277 ! for the last layer, one make go up clay 280 278 solcp(ji,jpksed,jsclay) = solcp(ji,jpksed,jsclay) + zempty(jpksed) * 1. 281 !! C. Heinze fromsed(ji,jsclay) = zempty(jpksed) * 1. * dens * por1(jpksed) / mol_wgt(jsclay)282 279 fromsed(ji,jsclay) = zempty(jpksed) * 1. * por1clay 283 284 280 ELSE ! rain > 0 and rain < total reaction loss 285 281 … … 323 319 ENDDO 324 320 solcp(ji,jpksed,jsclay) = solcp(ji,jpksed,jsclay) + zempty(jpksed) * 1. 325 !! C. Heinze fromsed(ji,jsclay) = zempty(jpksed) * 1. * dens * por1(jpksed) / mol_wgt(jsclay)321 !! C. Heinze fromsed(ji,jsclay) = zempty(jpksed) * 1. * denssol * por1(jpksed) / mol_wgt(jsclay) 326 322 fromsed(ji,jsclay) = zempty(jpksed) * 1. * por1clay 327 323 … … 339 335 solcp(ji,2,js) = zfull(2) * zsolcpno(2,js) + zempty(2) * zrainrf(ji,js) 340 336 ENDDO 341 DO js = 1, jpsol 337 DO js = 1, jpsol 342 338 DO jk = jpksedm1, 3, -1 343 339 solcp(ji,jk,js) = zfull(jk) * zsolcpno(jk,js) + zempty(jk) * zsolcpno(jk-1,js) … … 349 345 ENDDO 350 346 solcp(ji,jpksed,jsclay) = solcp(ji,jpksed,jsclay) + zkwnlo * 1. 351 ! Heinze fromsed(ji,jsclay) = zkwnlo * 1. * dens * por1(jpksed) / mol_wgt(jsclay)347 ! Heinze fromsed(ji,jsclay) = zkwnlo * 1. * denssol * por1(jpksed) / mol_wgt(jsclay) 352 348 fromsed(ji,jsclay) = zkwnlo * 1.* por1clay 353 349 ELSE ! 2 < ikwneg(ji) <= jpksedm1 … … 415 411 fromsed(ji,js) = 0. 416 412 ENDDO 417 ! Heinze fromsed(ji,jsclay) = zempty * 1. * dens * por1(jpksed) / mol_wgt(jsclay)413 ! Heinze fromsed(ji,jsclay) = zempty * 1. * denssol * por1(jpksed) / mol_wgt(jsclay) 418 414 fromsed(ji,jsclay) = zempty(jpksed) * 1. * por1clay 415 419 416 ENDIF ! ikwneg(ji) = 2 420 417 ENDIF ! zwb > 0 … … 425 422 raintg(:) = 0. 426 423 427 DEALLOCATE( zsolcpno ) 428 DEALLOCATE( zrainrf ) 429 DEALLOCATE( zfilled ) 430 DEALLOCATE( zfull ) 431 DEALLOCATE( zfromup ) 432 DEALLOCATE( zempty ) 433 DEALLOCATE( zgap ) 434 DEALLOCATE( zwb ) 435 424 DEALLOCATE( zraipush ) 425 426 IF( ln_timing ) CALL timing_stop('sed_adv') 436 427 437 428 END SUBROUTINE sed_adv 438 #else 439 !!====================================================================== 440 !! MODULE sedbtb : Dummy module 441 !!====================================================================== 442 !! $Id$ 443 CONTAINS 444 SUBROUTINE sed_adv( kt ) ! Empty routine 445 INTEGER, INTENT(in) :: kt 446 WRITE(*,*) 'sed_adv: You should not have seen this print! error?', kt 447 END SUBROUTINE sed_adv 448 449 !!====================================================================== 450 451 #endif 429 430 431 INTEGER FUNCTION sed_adv_alloc() 432 !!---------------------------------------------------------------------- 433 !! *** ROUTINE p4z_prod_alloc *** 434 !!---------------------------------------------------------------------- 435 ALLOCATE( dvolsp(jpksed), dvolsm(jpksed), c2por(jpksed), & 436 & ckpor(jpksed) , STAT = sed_adv_alloc ) 437 ! 438 IF( sed_adv_alloc /= 0 ) CALL ctl_warn('sed_adv_alloc : failed to allocate arrays.') 439 ! 440 END FUNCTION sed_adv_alloc 441 452 442 END MODULE sedadv -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/TOP/PISCES/SED/sedarr.F90
r10068 r10345 4 4 !! transform 1D (2D) array to a 2D (1D) table 5 5 !!====================================================================== 6 #if defined key_sed 6 7 7 !!---------------------------------------------------------------------- 8 8 !! arr_2d_1d : 2-D to 1-D … … 11 11 !! * Modules used 12 12 USE par_sed 13 USE dom_oce 14 USE sed 13 15 14 16 IMPLICIT NONE … … 28 30 29 31 !!---------------------------------------------------------------------- 30 !! NEMO/TOP 4.0 , NEMO Consortium (2018)32 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 31 33 !! $Id$ 32 !! Software governed by the CeCILL licen se (see ./LICENSE)34 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 33 35 !!---------------------------------------------------------------------- 34 36 CONTAINS … … 42 44 43 45 INTEGER :: jn, jid, jjd 46 47 IF( ln_timing ) CALL timing_start('pack_arr_2d_1d') 44 48 45 49 DO jn = 1, ndim1d … … 48 52 tab1d(jn) = tab2d(jid, jjd) 49 53 END DO 54 55 IF( ln_timing ) CALL timing_stop('pack_arr_2d_1d') 50 56 51 57 END SUBROUTINE pack_arr_2d_1d … … 59 65 INTEGER :: jn, jid, jjd 60 66 67 IF( ln_timing ) CALL timing_start('unpack_arr_1d_2d') 68 61 69 DO jn = 1, ndim1d 62 70 jid = MOD( tab_ind(jn) - 1, jpi) + 1 … … 64 72 tab2d(jid, jjd) = tab1d(jn) 65 73 END DO 74 75 IF( ln_timing ) CALL timing_stop('unpack_arr_1d_2d') 66 76 67 77 END SUBROUTINE unpack_arr_1d_2d … … 75 85 INTEGER, DIMENSION(ndim1d) :: jid, jjd 76 86 INTEGER :: jk, jn , ji, jj 87 88 IF( ln_timing ) CALL timing_start('pack_arr_2d_3d') 77 89 78 90 DO jn = 1, ndim1d … … 88 100 ENDDO 89 101 ENDDO 102 103 IF( ln_timing ) CALL timing_stop('pack_arr_2d_3d') 90 104 91 105 END SUBROUTINE pack_arr_3d_2d … … 100 114 INTEGER, DIMENSION(ndim1d) :: jid, jjd 101 115 INTEGER :: jk, jn , ji, jj 102 103 DO jn = 1, ndim1d 116 ! 117 IF( ln_timing ) CALL timing_start('unpack_arr_2d_3d') 118 ! 119 DO jn = 1, ndim1d 104 120 jid(jn) = MOD( tab_ind(jn) - 1, jpi ) + 1 105 121 jjd(jn) = ( tab_ind(jn) - 1 ) / jpi + 1 … … 114 130 ENDDO 115 131 132 IF( ln_timing ) CALL timing_stop('unpack_arr_2d_3d') 133 116 134 END SUBROUTINE unpack_arr_2d_3d 117 135 118 #else119 !!======================================================================120 !! MODULE sedarr : Dummy module121 !!======================================================================122 CONTAINS123 SUBROUTINE pack_arr ! Empty routine124 END SUBROUTINE pack_arr125 SUBROUTINE unpack_arr ! Empty routine126 END SUBROUTINE unpack_arr127 !!======================================================================128 #endif129 136 END MODULE sedarr -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/TOP/PISCES/SED/sedbtb.F90
r5215 r10345 1 1 MODULE sedbtb 2 #if defined key_sed3 2 !!====================================================================== 4 3 !! *** MODULE sedbtb *** … … 8 7 USE sed ! sediment global variable 9 8 USE sedmat ! linear system of equations 9 USE lib_mpp ! distribued memory computing library 10 11 IMPLICIT NONE 12 PRIVATE 10 13 11 14 PUBLIC sed_btb … … 33 36 ! * local variables 34 37 INTEGER :: ji, jk, js 35 REAL(wp), DIMENSION( :,:,:) , ALLOCATABLE:: zsol ! solution38 REAL(wp), DIMENSION(jpoce,jpksedm1,jpsol) :: zsol ! solution 36 39 !------------------------------------------------------------------------ 37 40 41 IF( ln_timing ) CALL timing_start('sed_btb') 42 38 43 IF( kt == nitsed000 ) THEN 39 WRITE(numsed,*) ' sed_btb : Bioturbation '40 WRITE(numsed,*) ' '44 IF (lwp) WRITE(numsed,*) ' sed_btb : Bioturbation ' 45 IF (lwp) WRITE(numsed,*) ' ' 41 46 ENDIF 42 47 43 48 ! Initializations 44 49 !---------------- 45 ALLOCATE( zsol(jpoce,jpksedm1,jpsol) )46 47 50 zsol(:,:,:) = 0. 48 49 51 50 52 ! right hand side of coefficient matrix … … 58 60 ENDDO 59 61 60 CALL sed_mat( jpsol, jpoce, jpksedm1, zsol )62 CALL sed_mat( jpsol, jpoce, jpksedm1, zsol, dtsed / 2.0 ) 61 63 62 64 … … 70 72 ENDDO 71 73 ENDDO 72 73 DEALLOCATE( zsol)74 75 IF( ln_timing ) CALL timing_stop('sed_btb') 74 76 75 77 END SUBROUTINE sed_btb 76 #else77 !!======================================================================78 !! MODULE sedbtb : Dummy module79 !!======================================================================80 !! $Id$81 CONTAINS82 SUBROUTINE sed_btb( kt ) ! Empty routine83 INTEGER, INTENT(in) :: kt84 WRITE(*,*) 'sed_btb: You should not have seen this print! error?', kt85 END SUBROUTINE sed_btb86 78 87 !!======================================================================88 89 #endif90 79 END MODULE sedbtb -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/TOP/PISCES/SED/sedchem.F90
r5215 r10345 1 1 MODULE sedchem 2 2 3 #if defined key_sed4 3 !!====================================================================== 5 4 !! *** Module sedchem *** … … 9 8 USE sed ! sediment global variable 10 9 USE sedarr 10 USE eosbn2, ONLY : neos 11 USE lib_mpp ! distribued memory computing library 12 13 IMPLICIT NONE 14 PRIVATE 11 15 12 16 !! * Accessibility 13 PUBLIC sed_chem 17 PUBLIC sed_chem 18 PUBLIC ahini_for_at_sed ! 19 PUBLIC solve_at_general_sed ! 20 21 ! Maximum number of iterations for each method 22 INTEGER, PARAMETER :: jp_maxniter_atgen = 20 23 REAL(wp), PARAMETER :: pp_rdel_ah_target = 1.E-4_wp 14 24 15 25 !! * Module variables 16 26 REAL(wp) :: & 17 salchl = 1./1.80655 , & ! conversion factor for salinity --> chlorinity (Wooster et al. 1969)18 27 calcon = 1.03E-2 ! mean calcite concentration [Ca2+] in sea water [mole/kg solution] 19 28 20 REAL(wp) :: & ! coeff. for 1. dissoc. of carbonic acid (Millero, 1995) 21 c10 = 3670.7 , & 22 c11 = 62.008 , & 23 c12 = 9.7944 , & 24 c13 = 0.0118 , & 25 c14 = 0.000116 26 27 REAL(wp) :: & ! coeff. for 2. dissoc. of carbonic acid (Millero, 1995) 28 c20 = 1394.7 , & 29 c21 = 4.777 , & 30 c22 = 0. , & 31 c23 = 0.0184 , & 32 c24 = 0.000118 33 34 REAL(wp) :: & ! coeff. for 1. dissoc. of boric acid (Dickson and Goyet, 1994) 35 cb0 = -8966.90, & 36 cb1 = -2890.53, & 37 cb2 = -77.942 , & 38 cb3 = 1.728 , & 39 cb4 = -0.0996 , & 40 cb5 = 148.0248, & 41 cb6 = 137.1942, & 42 cb7 = 1.62142 , & 43 cb8 = -24.4344, & 44 cb9 = -25.085 , & 45 cb10 = -0.2474 , & 46 cb11 = 0.053105 47 48 REAL(wp) :: & ! borat constants 49 bor1 = 0.000232, & 50 bor2 = 1./10.811 51 52 REAL(wp) :: & ! constants for calculate concentrations 53 st1 = 0.14 , & ! for sulfate (Morris & Riley 1966) 54 st2 = 1./96.062, & 55 ks0 = 141.328 , & 56 ks1 = -4276.1 , & 57 ks2 = -23.093 , & 58 ks3 = -13856. , & 59 ks4 = 324.57 , & 60 ks5 = -47.986 , & 61 ks6 = 35474. , & 62 ks7 = -771.54 , & 63 ks8 = 114.723 , & 64 ks9 = -2698. , & 65 ks10 = 1776. , & 66 ks11 = 1. , & 67 ks12 = -0.001005 68 69 REAL(wp) :: & ! constants for calculate concentrations 70 ft1 = 0.000067 , & ! fluorides (Dickson & Riley 1979 ) 71 ft2 = 1./18.9984 , & 72 kf0 = -12.641 , & 73 kf1 = 1590.2 , & 74 kf2 = 1.525 , & 75 kf3 = 1.0 , & 76 kf4 =-0.001005 77 78 REAL(wp) :: & ! coeff. for dissoc. of water (Dickson and Riley, 1979 ) 79 cw0 = -13847.26 , & 80 cw1 = 148.9802 , & 81 cw2 = -23.6521 , & 82 cw3 = 118.67 , & 83 cw4 = -5.977 , & 84 cw5 = 1.0495 , & 85 cw6 = -0.01615 86 87 REAL(wp) :: & ! coeff. for dissoc. of phosphate (Millero (1974) 88 cp10 = 115.54 , & 89 cp11 = -4576.752 , & 90 cp12 = -18.453 , & 91 cp13 = -106.736 , & 92 cp14 = 0.69171 , & 93 cp15 = -0.65643 , & 94 cp16 = -0.01844 , & 95 cp20 = 172.1033 , & 96 cp21 = -8814.715 , & 97 cp22 = -27.927 , & 98 cp23 = -160.340 , & 99 cp24 = 1.3566 , & 100 cp25 = 0.37335 , & 101 cp26 = -0.05778 , & 102 cp30 = -18.126 , & 103 cp31 = -3070.75 , & 104 cp32 = 17.27039 , & 105 cp33 = 2.81197 , & 106 cp34 = -44.99486 , & 107 cp35 = -0.09984 108 109 REAL(wp) :: & ! coeff. for dissoc. of silicates (Millero (1974) 110 cs10 = 117.40 , & 111 cs11 = -8904.2 , & 112 cs12 = -19.334 , & 113 cs13 = -458.79 , & 114 cs14 = 3.5913 , & 115 cs15 = 188.74 , & 116 cs16 = -1.5998 , & 117 cs17 = -12.1652 , & 118 cs18 = 0.07871 , & 119 cs19 = 0. , & 120 cs20 = 1. , & 121 cs21 = -0.001005 122 123 REAL(wp) :: & ! coeff. for apparent solubility equilibrium 124 ! akcc1 = -34.452 , & ! of calcite (Ingle,1975, 1800, eq. 6) 125 ! akcc2 = -39.866 , & 126 ! akcc3 = 110.21 , & 127 ! akcc4 = -7.5752E-6 128 akcc1 = -171.9065 , & ! Millero et al. 1995 from Mucci 1983 129 akcc2 = -0.077993 , & 130 akcc3 = 2839.319 , & 131 akcc4 = 71.595 , & 132 akcc5 = -0.77712 , & 133 akcc6 = 0.0028426 , & 134 akcc7 = 178.34 , & 135 akcc8 = -0.07711 , & 136 akcc9 = 0.0041249 137 138 REAL(wp) :: & ! universal gas constant 139 rgas = 83.145 ! bar.cm3/(mol.K) or R=8.31451 J/(g.mol.K) 140 141 142 ! coeff. for seawater pressure correction (millero 95) 143 REAL(wp), DIMENSION(8) :: & 144 devk1, devk2, devk3, devk4, devk5 145 146 DATA devk1/ -25.5 , -15.82 , -29.48 , -25.60 , -48.76 , -14.51 , -23.12 , -26.57 / 147 DATA devk2/ 0.1271 , -0.0219 , 0.1622 , 0.2324 , -0.5304 , 0.1211 , 0.1758 , 0.2020 / 148 DATA devk3/ 0. , 0. , 2.608E-3, -3.6246E-3, 0. , -0.321E-3, -2.647E-3, -3.042E-3/ 149 DATA devk4/-3.08E-3 , 1.13E-3 , -2.84E-3, -5.13E-3 , -11.76E-3 , -2.67E-3 , -5.15E-3 , -4.08E-3 / 150 DATA devk5/0.0877E-3, -0.1475E-3, 0. , 0.0794E-3 , -0.3692E-3, 0.0427E-3, 0.09E-3 , 0.0714E-3/ 151 29 REAL(wp) :: rgas = 83.14472 ! universal gas constants 152 30 153 31 ! coeff. for density of sea water (Millero & Poisson 1981) … … 162 40 REAL(wp), DIMENSION(6) :: Ddsw 163 41 DATA Ddsw / 999.842594 , 6.793952E-2 , -9.095290E-3, 1.001685E-4, -1.120083E-6, 6.536332E-9/ 42 43 REAL(wp) :: devk10 = -25.5 44 REAL(wp) :: devk11 = -15.82 45 REAL(wp) :: devk12 = -29.48 46 REAL(wp) :: devk13 = -20.02 47 REAL(wp) :: devk14 = -18.03 48 REAL(wp) :: devk15 = -9.78 49 REAL(wp) :: devk16 = -48.76 50 REAL(wp) :: devk17 = -14.51 51 REAL(wp) :: devk18 = -23.12 52 REAL(wp) :: devk19 = -26.57 53 REAL(wp) :: devk110 = -29.48 54 ! 55 REAL(wp) :: devk20 = 0.1271 56 REAL(wp) :: devk21 = -0.0219 57 REAL(wp) :: devk22 = 0.1622 58 REAL(wp) :: devk23 = 0.1119 59 REAL(wp) :: devk24 = 0.0466 60 REAL(wp) :: devk25 = -0.0090 61 REAL(wp) :: devk26 = 0.5304 62 REAL(wp) :: devk27 = 0.1211 63 REAL(wp) :: devk28 = 0.1758 64 REAL(wp) :: devk29 = 0.2020 65 REAL(wp) :: devk210 = 0.1622 66 ! 67 REAL(wp) :: devk30 = 0. 68 REAL(wp) :: devk31 = 0. 69 REAL(wp) :: devk32 = 2.608E-3 70 REAL(wp) :: devk33 = -1.409e-3 71 REAL(wp) :: devk34 = 0.316e-3 72 REAL(wp) :: devk35 = -0.942e-3 73 REAL(wp) :: devk36 = 0. 74 REAL(wp) :: devk37 = -0.321e-3 75 REAL(wp) :: devk38 = -2.647e-3 76 REAL(wp) :: devk39 = -3.042e-3 77 REAL(wp) :: devk310 = -2.6080e-3 78 ! 79 REAL(wp) :: devk40 = -3.08E-3 80 REAL(wp) :: devk41 = 1.13E-3 81 REAL(wp) :: devk42 = -2.84E-3 82 REAL(wp) :: devk43 = -5.13E-3 83 REAL(wp) :: devk44 = -4.53e-3 84 REAL(wp) :: devk45 = -3.91e-3 85 REAL(wp) :: devk46 = -11.76e-3 86 REAL(wp) :: devk47 = -2.67e-3 87 REAL(wp) :: devk48 = -5.15e-3 88 REAL(wp) :: devk49 = -4.08e-3 89 REAL(wp) :: devk410 = -2.84e-3 90 ! 91 REAL(wp) :: devk50 = 0.0877E-3 92 REAL(wp) :: devk51 = -0.1475E-3 93 REAL(wp) :: devk52 = 0. 94 REAL(wp) :: devk53 = 0.0794E-3 95 REAL(wp) :: devk54 = 0.09e-3 96 REAL(wp) :: devk55 = 0.054e-3 97 REAL(wp) :: devk56 = 0.3692E-3 98 REAL(wp) :: devk57 = 0.0427e-3 99 REAL(wp) :: devk58 = 0.09e-3 100 REAL(wp) :: devk59 = 0.0714e-3 101 REAL(wp) :: devk510 = 0.0 164 102 165 103 !! $Id$ … … 179 117 INTEGER, INTENT(in) :: kt ! time step 180 118 181 #if ! defined key_sed_off182 119 INTEGER :: ji, jj, ikt 183 REAL(wp) :: ztkel, ztc, ztc2, zpres, ztr 184 REAL(wp) :: zsal, zsal2, zsqrt, zsal15 185 REAL(wp) :: zis, zis2, zisqrt 120 REAL(wp) :: ztc, ztc2 121 REAL(wp) :: zsal, zsal15 186 122 REAL(wp) :: zdens0, zaw, zbw, zcw 187 REAL(wp) :: zbuf1, zbuf2 188 REAL(wp) :: zcpexp, zcpexp2 189 REAL(wp) :: zck1p, zck2p, zck3p, zcksi 190 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zchem_data 191 192 #endif 123 REAL(wp), DIMENSION(jpi,jpj,15) :: zchem_data 193 124 !!---------------------------------------------------------------------- 194 125 195 IF( MOD( kt - 1, nfreq ) /= 0 ) RETURN 196 197 WRITE(numsed,*) ' Getting Chemical constants from tracer model at time kt = ', kt 198 WRITE(numsed,*) ' ' 199 200 201 #if defined key_sed_off 202 CALL sed_chem_off 203 #else 126 127 IF( ln_timing ) CALL timing_start('sed_chem') 128 129 IF (lwp) WRITE(numsed,*) ' Getting Chemical constants from tracer model at time kt = ', kt 130 IF (lwp) WRITE(numsed,*) ' ' 131 204 132 ! reading variables 205 ALLOCATE( zchem_data(jpi,jpj,6) ) ; zchem_data(:,:,:) = 0. 206 207 DO jj = 1,jpj 208 DO ji = 1, jpi 209 ikt = mbkt(ji,jj) 210 IF ( tmask(ji,jj,ikt) == 1 ) THEN 211 zchem_data(ji,jj,1) = ak13 (ji,jj,ikt) 212 zchem_data(ji,jj,2) = ak23 (ji,jj,ikt) 213 zchem_data(ji,jj,3) = akb3 (ji,jj,ikt) 214 zchem_data(ji,jj,4) = akw3 (ji,jj,ikt) 215 zchem_data(ji,jj,5) = aksp (ji,jj,ikt) 216 zchem_data(ji,jj,6) = borat(ji,jj,ikt) 217 ENDIF 133 zchem_data(:,:,:) = rtrn 134 135 IF (ln_sediment_offline) THEN 136 CALL sed_chem_cst 137 ELSE 138 DO jj = 1,jpj 139 DO ji = 1, jpi 140 ikt = mbkt(ji,jj) 141 IF ( tmask(ji,jj,ikt) == 1 ) THEN 142 zchem_data(ji,jj,1) = ak13 (ji,jj,ikt) 143 zchem_data(ji,jj,2) = ak23 (ji,jj,ikt) 144 zchem_data(ji,jj,3) = akb3 (ji,jj,ikt) 145 zchem_data(ji,jj,4) = akw3 (ji,jj,ikt) 146 zchem_data(ji,jj,5) = aksp (ji,jj,ikt) 147 zchem_data(ji,jj,6) = borat (ji,jj,ikt) 148 zchem_data(ji,jj,7) = ak1p3 (ji,jj,ikt) 149 zchem_data(ji,jj,8) = ak2p3 (ji,jj,ikt) 150 zchem_data(ji,jj,9) = ak3p3 (ji,jj,ikt) 151 zchem_data(ji,jj,10)= aksi3 (ji,jj,ikt) 152 zchem_data(ji,jj,11)= sio3eq(ji,jj,ikt) 153 zchem_data(ji,jj,12)= aks3 (ji,jj,ikt) 154 zchem_data(ji,jj,13)= akf3 (ji,jj,ikt) 155 zchem_data(ji,jj,14)= sulfat(ji,jj,ikt) 156 zchem_data(ji,jj,15)= fluorid(ji,jj,ikt) 157 ENDIF 158 ENDDO 218 159 ENDDO 219 ENDDO 220 221 CALL pack_arr ( jpoce, ak1s (1:jpoce), zchem_data(1:jpi,1:jpj,1), iarroce(1:jpoce) ) 222 CALL pack_arr ( jpoce, ak2s (1:jpoce), zchem_data(1:jpi,1:jpj,2), iarroce(1:jpoce) ) 223 CALL pack_arr ( jpoce, akbs (1:jpoce), zchem_data(1:jpi,1:jpj,3), iarroce(1:jpoce) ) 224 CALL pack_arr ( jpoce, akws (1:jpoce), zchem_data(1:jpi,1:jpj,4), iarroce(1:jpoce) ) 225 CALL pack_arr ( jpoce, aksps (1:jpoce), zchem_data(1:jpi,1:jpj,5), iarroce(1:jpoce) ) 226 CALL pack_arr ( jpoce, borats(1:jpoce), zchem_data(1:jpi,1:jpj,6), iarroce(1:jpoce) ) 227 228 DEALLOCATE( zchem_data ) 160 161 CALL pack_arr ( jpoce, ak1s (1:jpoce), zchem_data(1:jpi,1:jpj,1) , iarroce(1:jpoce) ) 162 CALL pack_arr ( jpoce, ak2s (1:jpoce), zchem_data(1:jpi,1:jpj,2) , iarroce(1:jpoce) ) 163 CALL pack_arr ( jpoce, akbs (1:jpoce), zchem_data(1:jpi,1:jpj,3) , iarroce(1:jpoce) ) 164 CALL pack_arr ( jpoce, akws (1:jpoce), zchem_data(1:jpi,1:jpj,4) , iarroce(1:jpoce) ) 165 CALL pack_arr ( jpoce, aksps (1:jpoce), zchem_data(1:jpi,1:jpj,5) , iarroce(1:jpoce) ) 166 CALL pack_arr ( jpoce, borats(1:jpoce), zchem_data(1:jpi,1:jpj,6) , iarroce(1:jpoce) ) 167 CALL pack_arr ( jpoce, ak1ps (1:jpoce), zchem_data(1:jpi,1:jpj,7) , iarroce(1:jpoce) ) 168 CALL pack_arr ( jpoce, ak2ps (1:jpoce), zchem_data(1:jpi,1:jpj,8) , iarroce(1:jpoce) ) 169 CALL pack_arr ( jpoce, ak3ps (1:jpoce), zchem_data(1:jpi,1:jpj,9) , iarroce(1:jpoce) ) 170 CALL pack_arr ( jpoce, aksis (1:jpoce), zchem_data(1:jpi,1:jpj,10), iarroce(1:jpoce) ) 171 CALL pack_arr ( jpoce, sieqs (1:jpoce), zchem_data(1:jpi,1:jpj,11), iarroce(1:jpoce) ) 172 CALL pack_arr ( jpoce, aks3s (1:jpoce), zchem_data(1:jpi,1:jpj,12), iarroce(1:jpoce) ) 173 CALL pack_arr ( jpoce, akf3s (1:jpoce), zchem_data(1:jpi,1:jpj,13), iarroce(1:jpoce) ) 174 CALL pack_arr ( jpoce, sulfats(1:jpoce), zchem_data(1:jpi,1:jpj,14), iarroce(1:jpoce) ) 175 CALL pack_arr ( jpoce, fluorids(1:jpoce), zchem_data(1:jpi,1:jpj,15), iarroce(1:jpoce) ) 176 ENDIF 229 177 230 178 DO ji = 1, jpoce 231 ztkel = temp(ji) + 273.16232 179 ztc = temp(ji) 233 180 ztc2 = ztc * ztc 234 zpres = press(ji)235 181 ! zqtt = ztkel * 0.01 236 182 zsal = salt(ji) 237 zsal2 = zsal * zsal 238 zsqrt = SQRT( zsal ) 239 zsal15 = zsqrt * zsal 240 zlogt = LOG( ztkel ) 241 ztr = 1./ ztkel 242 ! zis=ionic strength (ORNL/CDIAC-74, DOE 94,Dickson and Goyet) 243 zis = 19.924 * zsal / ( 1000. - 1.005 * zsal ) 244 zis2 = zis * zis 245 zisqrt = SQRT( zis ) 183 zsal15 = SQRT( zsal ) * zsal 246 184 247 185 ! Density of Sea Water - F(temp,sal) [kg/m3] … … 256 194 densSW(ji) = densSW(ji) * 1E-3 ! to get dens in [kg/l] 257 195 258 ! FORMULA FOR CPEXP AFTER EDMOND AND GIESKES (1970)259 ! (REFERENCE TO CULBERSON AND PYTKOQICZ (1968) AS MADE IN BROECKER ET AL. (1982)260 ! IS INCORRECT; HERE RGAS IS TAKEN TENFOLD TO CORRECT FOR THE NOTATION OF pres IN261 ! DBAR INSTEAD OF BAR AND THE EXPRESSION FOR CPEXP IS MULTIPLIED BY LN(10.)262 ! TO ALLOW USE OF EXP-FUNCTION WITH BASIS E IN THE FORMULA FOR AKSPP263 ! (CF. EDMOND AND GIESKES (1970), P. 1285 AND P. 1286 (THE SMALL FORMULA ON P. 1286264 ! IS RIGHT AND CONSISTENT WITH THE SIGN IN PARTIAL MOLAR VOLUME CHANGE AS SHOWN ON P. 1285)265 !-----------------------------------------------------------------------------------------266 zcpexp = zpres / ( rgas*ztkel )267 zcpexp2 = zpres * zcpexp268 269 ! For Phodphates (phosphoric acid) (DOE 1994)270 !----------------------------------------------271 zck1p = cp10 + cp11*ztr + cp12*zlogt + ( cp13*ztr + cp14 ) * zsqrt &272 & + ( cp15*ztr + cp16 ) * zsal273 zck2p = cp20 + cp21*ztr + cp22*zlogt + ( cp23*ztr + cp24 ) * zsqrt &274 & + ( cp25*ztr + cp26 ) * zsal275 zck3p = cp30 + cp31*ztr + ( cp32*ztr + cp33 ) * zsqrt &276 & + ( cp34*ztr + cp35 ) * zsal277 278 ! For silicates (DOE 1994) change to mol/kg soln) (OCMIP)279 !--------------------------------------------------------280 zcksi = cs10 + cs11*ztr + cs12*zlogt + ( cs13*ztr + cs14) * zisqrt &281 & + ( cs15*ztr + cs16 ) * zis &282 & + ( cs17*ztr + cs18 ) * zis2 &283 & + LOG( 1. + cs19*zsal ) + LOG( cs20 + cs21*zsal )284 285 286 !K1, K2 of carbonic acid, KB of boric acid, KW (H2O)287 !---------------------------------------------------288 zak1p = EXP ( zck1p )289 zak2p = EXP ( zck2p )290 zak3p = EXP ( zck3p )291 zaksil = EXP ( zcksi )292 293 zbuf1 = - ( devk1(3) + devk2(3)*ztc + devk3(3)*ztc2 )294 zbuf2 = 0.5 * ( devk4(3) + devk5(3)*ztc )295 aksis(ji) = zaksil * EXP( zbuf1*zcpexp + zbuf2*zcpexp2 )296 297 zbuf1 = - ( devk1(6) + devk2(6)*ztc + devk3(6)*ztc2 )298 zbuf2 = 0.5 * ( devk4(6) + devk5(6)*ztc )299 ak1ps(ji) = zak1p * EXP( zbuf1*zcpexp + zbuf2*zcpexp2 )300 301 zbuf1 = - ( devk1(7) + devk2(7)*ztc + devk3(7)*ztc2 )302 zbuf2 = 0.5 * ( devk4(7) + devk5(7)*ztc )303 ak2ps(ji) = zak2p * EXP( zbuf1*zcpexp + zbuf2*zcpexp2 )304 305 zbuf1 = - ( devk1(8) + devk2(8)*ztc + devk3(8)*ztc2 )306 zbuf2 = 0.5 * ( devk4(8) + devk5(8)*ztc )307 ak3ps(ji) = zak3p * EXP( zbuf1*zcpexp + zbuf2*zcpexp2 )308 309 196 ak12s (ji) = ak1s (ji) * ak2s (ji) 310 197 ak12ps (ji) = ak1ps(ji) * ak2ps(ji) … … 313 200 calcon2(ji) = 0.01028 * ( salt(ji) / 35. ) * densSW(ji) 314 201 ENDDO 315 316 202 317 #endif 203 IF( ln_timing ) CALL timing_stop('sed_chem') 318 204 319 205 END SUBROUTINE sed_chem 320 206 321 #if defined key_sed_off 322 323 SUBROUTINE sed_chem_off 324 !!---------------------------------------------------------------------- 325 !! *** ROUTINE sed_chem_off *** 326 !! 327 !! ** Purpose : compute chemical constants 207 SUBROUTINE ahini_for_at_sed(p_hini) 208 !!--------------------------------------------------------------------- 209 !! *** ROUTINE ahini_for_at *** 328 210 !! 329 !! History : 330 !! ! 04-10 (N. Emprin, M. Gehlen ) Original code 331 !! ! 06-04 (C. Ethe) Re-organization 332 !!---------------------------------------------------------------------- 333 !! * Local declarations 334 INTEGER :: ji 335 336 REAL(wp) :: ztkel, ztc, ztc2, zpres, ztr 337 REAL(wp) :: zsal, zsal2, zsqrt, zsal15 338 REAL(wp) :: zis, zis2, zisqrt 339 REAL(wp) :: zdens0, zaw, zbw, zcw 340 REAL(wp) :: zchl, zst, zft, zbuf1, zbuf2 341 REAL(wp) :: zcpexp, zcpexp2 342 REAL(wp) :: zckb, zck1, zck2, zckw 343 REAL(wp) :: zck1p, zck2p, zck3p, zcksi 344 REAL(wp) :: zak1, zak2, zakb, zakw 345 REAL(wp) :: zaksp0, zksp, zks, zkf 346 211 !! Subroutine returns the root for the 2nd order approximation of the 212 !! DIC -- B_T -- A_CB equation for [H+] (reformulated as a cubic 213 !! polynomial) around the local minimum, if it exists. 214 !! Returns * 1E-03_wp if p_alkcb <= 0 215 !! * 1E-10_wp if p_alkcb >= 2*p_dictot + p_bortot 216 !! * 1E-07_wp if 0 < p_alkcb < 2*p_dictot + p_bortot 217 !! and the 2nd order approximation does not have 218 !! a solution 219 !!--------------------------------------------------------------------- 220 REAL(wp), DIMENSION(jpoce,jpksed), INTENT(OUT) :: p_hini 221 INTEGER :: ji, jk 222 REAL(wp) :: zca1, zba1 223 REAL(wp) :: zd, zsqrtd, zhmin 224 REAL(wp) :: za2, za1, za0 225 REAL(wp) :: p_dictot, p_bortot, p_alkcb 226 227 IF( ln_timing ) CALL timing_start('ahini_for_at_sed') 228 ! 229 DO jk = 1, jpksed 230 DO ji = 1, jpoce 231 p_alkcb = pwcp(ji,jk,jwalk) / densSW(ji) 232 p_dictot = pwcp(ji,jk,jwdic) / densSW(ji) 233 p_bortot = borats(ji) / densSW(ji) 234 IF (p_alkcb <= 0.) THEN 235 p_hini(ji,jk) = 1.e-3 236 ELSEIF (p_alkcb >= (2.*p_dictot + p_bortot)) THEN 237 p_hini(ji,jk) = 1.e-10_wp 238 ELSE 239 zca1 = p_dictot/( p_alkcb + rtrn ) 240 zba1 = p_bortot/ (p_alkcb + rtrn ) 241 ! Coefficients of the cubic polynomial 242 za2 = aKbs(ji)*(1. - zba1) + ak1s(ji)*(1.-zca1) 243 za1 = ak1s(ji)*akbs(ji)*(1. - zba1 - zca1) & 244 & + ak1s(ji)*ak2s(ji)*(1. - (zca1+zca1)) 245 za0 = ak1s(ji)*ak2s(ji)*akbs(ji)*(1. - zba1 - (zca1+zca1)) 246 ! Taylor expansion around the minimum 247 zd = za2*za2 - 3.*za1 ! Discriminant of the quadratic equation 248 ! for the minimum close to the root 249 250 IF(zd > 0.) THEN ! If the discriminant is positive 251 zsqrtd = SQRT(zd) 252 IF(za2 < 0) THEN 253 zhmin = (-za2 + zsqrtd)/3. 254 ELSE 255 zhmin = -za1/(za2 + zsqrtd) 256 ENDIF 257 p_hini(ji,jk) = zhmin + SQRT(-(za0 + zhmin*(za1 + zhmin*(za2 + zhmin)))/zsqrtd) 258 ELSE 259 p_hini(ji,jk) = 1.e-7 260 ENDIF 261 ! 262 ENDIF 263 END DO 264 END DO 265 ! 266 IF( ln_timing ) CALL timing_stop('ahini_for_at_sed') 267 ! 268 END SUBROUTINE ahini_for_at_sed 269 270 !=============================================================================== 271 SUBROUTINE anw_infsup_sed( p_alknw_inf, p_alknw_sup ) 272 273 ! Subroutine returns the lower and upper bounds of "non-water-selfionization" 274 ! contributions to total alkalinity (the infimum and the supremum), i.e 275 ! inf(TA - [OH-] + [H+]) and sup(TA - [OH-] + [H+]) 276 277 ! Argument variables 278 INTEGER :: jk 279 REAL(wp), DIMENSION(jpoce,jpksed), INTENT(OUT) :: p_alknw_inf 280 REAL(wp), DIMENSION(jpoce,jpksed), INTENT(OUT) :: p_alknw_sup 281 282 DO jk = 1, jpksed 283 p_alknw_inf(:,jk) = -pwcp(:,jk,jwpo4) / densSW(:) 284 p_alknw_sup(:,jk) = (2. * pwcp(:,jk,jwdic) + 2. * pwcp(:,jk,jwpo4) + pwcp(:,jk,jwsil) & 285 & + borats(:) ) / densSW(:) 286 END DO 287 288 END SUBROUTINE anw_infsup_sed 289 290 291 SUBROUTINE solve_at_general_sed( p_hini, zhi ) 292 293 ! Universal pH solver that converges from any given initial value, 294 ! determines upper an lower bounds for the solution if required 295 296 ! Argument variables 297 !-------------------- 298 REAL(wp), DIMENSION(jpoce,jpksed), INTENT(IN) :: p_hini 299 REAL(wp), DIMENSION(jpoce,jpksed), INTENT(OUT) :: zhi 300 301 ! Local variables 302 !----------------- 303 INTEGER :: ji, jk, jn 304 REAL(wp) :: zh_ini, zh, zh_prev, zh_lnfactor 305 REAL(wp) :: zdelta, zh_delta 306 REAL(wp) :: zeqn, zdeqndh, zalka 307 REAL(wp) :: aphscale 308 REAL(wp) :: znumer_dic, zdnumer_dic, zdenom_dic, zalk_dic, zdalk_dic 309 REAL(wp) :: znumer_bor, zdnumer_bor, zdenom_bor, zalk_bor, zdalk_bor 310 REAL(wp) :: znumer_po4, zdnumer_po4, zdenom_po4, zalk_po4, zdalk_po4 311 REAL(wp) :: znumer_sil, zdnumer_sil, zdenom_sil, zalk_sil, zdalk_sil 312 REAL(wp) :: znumer_so4, zdnumer_so4, zdenom_so4, zalk_so4, zdalk_so4 313 REAL(wp) :: znumer_flu, zdnumer_flu, zdenom_flu, zalk_flu, zdalk_flu 314 REAL(wp) :: zalk_wat, zdalk_wat 315 REAL(wp) :: zfact, p_alktot, zdic, zbot, zpt, zst, zft, zsit 316 LOGICAL :: l_exitnow 317 REAL(wp), PARAMETER :: pz_exp_threshold = 1.0 318 REAL(wp), DIMENSION(jpoce,jpksed) :: zalknw_inf, zalknw_sup, rmask, zh_min, zh_max, zeqn_absmin 319 320 IF( ln_timing ) CALL timing_start('solve_at_general_sed') 321 ! Allocate temporary workspace 322 CALL anw_infsup_sed( zalknw_inf, zalknw_sup ) 323 324 rmask(:,:) = 1.0 325 zhi(:,:) = 0. 326 327 ! TOTAL H+ scale: conversion factor for Htot = aphscale * Hfree 328 DO jk = 1, jpksed 329 DO ji = 1, jpoce 330 IF (rmask(ji,jk) == 1.) THEN 331 p_alktot = pwcp(ji,jk,jwalk) / densSW(ji) 332 aphscale = 1. + sulfats(ji)/aks3s(ji) 333 zh_ini = p_hini(ji,jk) 334 335 zdelta = (p_alktot-zalknw_inf(ji,jk))**2 + 4.*akws(ji) / aphscale 336 337 IF(p_alktot >= zalknw_inf(ji,jk)) THEN 338 zh_min(ji,jk) = 2.*akws(ji) /( p_alktot-zalknw_inf(ji,jk) + SQRT(zdelta) ) 339 ELSE 340 zh_min(ji,jk) = aphscale * (-(p_alktot-zalknw_inf(ji,jk)) + SQRT(zdelta) ) / 2. 341 ENDIF 342 343 zdelta = (p_alktot-zalknw_sup(ji,jk))**2 + 4.*akws(ji) / aphscale 344 345 IF(p_alktot <= zalknw_sup(ji,jk)) THEN 346 zh_max(ji,jk) = aphscale * (-(p_alktot-zalknw_sup(ji,jk)) + SQRT(zdelta) ) / 2. 347 ELSE 348 zh_max(ji,jk) = 2.*akws(ji) /( p_alktot-zalknw_sup(ji,jk) + SQRT(zdelta) ) 349 ENDIF 350 351 zhi(ji,jk) = MAX(MIN(zh_max(ji,jk), zh_ini), zh_min(ji,jk)) 352 ENDIF 353 END DO 354 END DO 355 356 zeqn_absmin(:,:) = HUGE(1._wp) 357 358 DO jn = 1, jp_maxniter_atgen 359 DO jk = 1, jpksed 360 DO ji = 1, jpoce 361 IF (rmask(ji,jk) == 1.) THEN 362 363 p_alktot = pwcp(ji,jk,jwalk) / densSW(ji) 364 zdic = pwcp(ji,jk,jwdic) / densSW(ji) 365 zbot = borats(ji) / densSW(ji) 366 zpt = pwcp(ji,jk,jwpo4) / densSW(ji) 367 zsit = pwcp(ji,jk,jwsil) / densSW(ji) 368 zst = sulfats(ji) 369 zft = fluorids(ji) 370 aphscale = 1. + sulfats(ji)/aks3s(ji) 371 zh = zhi(ji,jk) 372 zh_prev = zh 373 374 ! H2CO3 - HCO3 - CO3 : n=2, m=0 375 znumer_dic = 2.*ak1s(ji)*ak2s(ji) + zh*ak1s(ji) 376 zdenom_dic = ak1s(ji)*ak2s(ji) + zh*(ak1s(ji) + zh) 377 zalk_dic = zdic * (znumer_dic/zdenom_dic) 378 zdnumer_dic = ak1s(ji)*ak1s(ji)*ak2s(ji) + zh & 379 *(4.*ak1s(ji)*ak2s(ji) + zh*ak1s(ji)) 380 zdalk_dic = -zdic*(zdnumer_dic/zdenom_dic**2) 381 382 383 ! B(OH)3 - B(OH)4 : n=1, m=0 384 znumer_bor = akbs(ji) 385 zdenom_bor = akbs(ji) + zh 386 zalk_bor = zbot * (znumer_bor/zdenom_bor) 387 zdnumer_bor = akbs(ji) 388 zdalk_bor = -zbot*(zdnumer_bor/zdenom_bor**2) 389 390 391 ! H3PO4 - H2PO4 - HPO4 - PO4 : n=3, m=1 392 znumer_po4 = 3.*ak1ps(ji)*ak2ps(ji)*ak3ps(ji) & 393 & + zh*(2.*ak1ps(ji)*ak2ps(ji) + zh* ak1ps(ji)) 394 zdenom_po4 = ak1ps(ji)*ak2ps(ji)*ak3ps(ji) & 395 & + zh*( ak1ps(ji)*ak2ps(ji) + zh*(ak1ps(ji) + zh)) 396 zalk_po4 = zpt * (znumer_po4/zdenom_po4 - 1.) ! Zero level of H3PO4 = 1 397 zdnumer_po4 = ak1ps(ji)*ak2ps(ji)*ak1ps(ji)*ak2ps(ji)*ak3ps(ji) & 398 & + zh*(4.*ak1ps(ji)*ak1ps(ji)*ak2ps(ji)*ak3ps(ji) & 399 & + zh*(9.*ak1ps(ji)*ak2ps(ji)*ak3ps(ji) & 400 & + ak1ps(ji)*ak1ps(ji)*ak2ps(ji) & 401 & + zh*(4.*ak1ps(ji)*ak2ps(ji) + zh * ak1ps(ji) ) ) ) 402 zdalk_po4 = -zpt * (zdnumer_po4/zdenom_po4**2) 403 404 ! H4SiO4 - H3SiO4 : n=1, m=0 405 znumer_sil = aksis(ji) 406 zdenom_sil = aksis(ji) + zh 407 zalk_sil = zsit * (znumer_sil/zdenom_sil) 408 zdnumer_sil = aksis(ji) 409 zdalk_sil = -zsit * (zdnumer_sil/zdenom_sil**2) 410 411 ! HSO4 - SO4 : n=1, m=1 412 aphscale = 1.0 + zst/aks3s(ji) 413 znumer_so4 = aks3s(ji) * aphscale 414 zdenom_so4 = aks3s(ji) * aphscale + zh 415 zalk_so4 = zst * (znumer_so4/zdenom_so4 - 1.) 416 zdnumer_so4 = aks3s(ji) * aphscale 417 zdalk_so4 = -zst * (zdnumer_so4/zdenom_so4**2) 418 419 ! HF - F : n=1, m=1 420 znumer_flu = akf3s(ji) 421 zdenom_flu = akf3s(ji) + zh 422 zalk_flu = zft * (znumer_flu/zdenom_flu - 1.) 423 zdnumer_flu = akf3s(ji) 424 zdalk_flu = -zft * (zdnumer_flu/zdenom_flu**2) 425 426 ! H2O - OH 427 zalk_wat = akws(ji)/zh - zh/aphscale 428 zdalk_wat = -akws(ji)/zh**2 - 1./aphscale 429 430 ! CALCULATE [ALK]([CO3--], [HCO3-]) 431 zeqn = zalk_dic + zalk_bor + zalk_po4 + zalk_sil & 432 & + zalk_so4 + zalk_flu & 433 & + zalk_wat - p_alktot 434 435 zalka = p_alktot - (zalk_bor + zalk_po4 + zalk_sil & 436 & + zalk_so4 + zalk_flu + zalk_wat) 437 438 zdeqndh = zdalk_dic + zdalk_bor + zdalk_po4 + zdalk_sil & 439 & + zdalk_so4 + zdalk_flu + zdalk_wat 440 441 ! Adapt bracketing interval 442 IF(zeqn > 0._wp) THEN 443 zh_min(ji,jk) = zh_prev 444 ELSEIF(zeqn < 0._wp) THEN 445 zh_max(ji,jk) = zh_prev 446 ENDIF 447 448 IF(ABS(zeqn) >= 0.5_wp*zeqn_absmin(ji,jk)) THEN 449 ! if the function evaluation at the current point is 450 ! not decreasing faster than with a bisection step (at least linearly) 451 ! in absolute value take one bisection step on [ph_min, ph_max] 452 ! ph_new = (ph_min + ph_max)/2d0 453 ! 454 ! In terms of [H]_new: 455 ! [H]_new = 10**(-ph_new) 456 ! = 10**(-(ph_min + ph_max)/2d0) 457 ! = SQRT(10**(-(ph_min + phmax))) 458 ! = SQRT(zh_max * zh_min) 459 zh = SQRT(zh_max(ji,jk) * zh_min(ji,jk)) 460 zh_lnfactor = (zh - zh_prev)/zh_prev ! Required to test convergence below 461 ELSE 462 ! dzeqn/dpH = dzeqn/d[H] * d[H]/dpH 463 ! = -zdeqndh * LOG(10) * [H] 464 ! \Delta pH = -zeqn/(zdeqndh*d[H]/dpH) = zeqn/(zdeqndh*[H]*LOG(10)) 465 ! 466 ! pH_new = pH_old + \deltapH 467 ! 468 ! [H]_new = 10**(-pH_new) 469 ! = 10**(-pH_old - \Delta pH) 470 ! = [H]_old * 10**(-zeqn/(zdeqndh*[H]_old*LOG(10))) 471 ! = [H]_old * EXP(-LOG(10)*zeqn/(zdeqndh*[H]_old*LOG(10))) 472 ! = [H]_old * EXP(-zeqn/(zdeqndh*[H]_old)) 473 474 zh_lnfactor = -zeqn/(zdeqndh*zh_prev) 475 476 IF(ABS(zh_lnfactor) > pz_exp_threshold) THEN 477 zh = zh_prev*EXP(zh_lnfactor) 478 ELSE 479 zh_delta = zh_lnfactor*zh_prev 480 zh = zh_prev + zh_delta 481 ENDIF 482 483 IF( zh < zh_min(ji,jk) ) THEN 484 ! if [H]_new < [H]_min 485 ! i.e., if ph_new > ph_max then 486 ! take one bisection step on [ph_prev, ph_max] 487 ! ph_new = (ph_prev + ph_max)/2d0 488 ! In terms of [H]_new: 489 ! [H]_new = 10**(-ph_new) 490 ! = 10**(-(ph_prev + ph_max)/2d0) 491 ! = SQRT(10**(-(ph_prev + phmax))) 492 ! = SQRT([H]_old*10**(-ph_max)) 493 ! = SQRT([H]_old * zh_min) 494 zh = SQRT(zh_prev * zh_min(ji,jk)) 495 zh_lnfactor = (zh - zh_prev)/zh_prev ! Required to test convergence below 496 ENDIF 497 498 IF( zh > zh_max(ji,jk) ) THEN 499 ! if [H]_new > [H]_max 500 ! i.e., if ph_new < ph_min, then 501 ! take one bisection step on [ph_min, ph_prev] 502 ! ph_new = (ph_prev + ph_min)/2d0 503 ! In terms of [H]_new: 504 ! [H]_new = 10**(-ph_new) 505 ! = 10**(-(ph_prev + ph_min)/2d0) 506 ! = SQRT(10**(-(ph_prev + ph_min))) 507 ! = SQRT([H]_old*10**(-ph_min)) 508 ! = SQRT([H]_old * zhmax) 509 zh = SQRT(zh_prev * zh_max(ji,jk)) 510 zh_lnfactor = (zh - zh_prev)/zh_prev ! Required to test convergence below 511 ENDIF 512 ENDIF 513 514 zeqn_absmin(ji,jk) = MIN( ABS(zeqn), zeqn_absmin(ji,jk)) 515 516 ! Stop iterations once |\delta{[H]}/[H]| < rdel 517 ! <=> |(zh - zh_prev)/zh_prev| = |EXP(-zeqn/(zdeqndh*zh_prev)) -1| < rdel 518 ! |EXP(-zeqn/(zdeqndh*zh_prev)) -1| ~ |zeqn/(zdeqndh*zh_prev)| 519 ! Alternatively: 520 ! |\Delta pH| = |zeqn/(zdeqndh*zh_prev*LOG(10))| 521 ! ~ 1/LOG(10) * |\Delta [H]|/[H] 522 ! < 1/LOG(10) * rdel 523 524 ! Hence |zeqn/(zdeqndh*zh)| < rdel 525 526 ! rdel <-- pp_rdel_ah_target 527 l_exitnow = (ABS(zh_lnfactor) < pp_rdel_ah_target) 528 529 IF(l_exitnow) THEN 530 rmask(ji,jk) = 0. 531 ENDIF 532 533 zhi(ji,jk) = zh 534 535 IF(jn >= jp_maxniter_atgen) THEN 536 zhi(ji,jk) = -1._wp 537 ENDIF 538 539 ENDIF 540 END DO 541 END DO 542 END DO 543 ! 544 IF( ln_timing ) CALL timing_stop('solve_at_general_sed') 545 546 END SUBROUTINE solve_at_general_sed 547 548 SUBROUTINE sed_chem_cst 549 !!--------------------------------------------------------------------- 550 !! *** ROUTINE sed_chem_cst *** 551 !! 552 !! ** Purpose : Sea water chemistry computed following MOCSY protocol 553 !! Computation is done at the bottom of the ocean only 554 !! 555 !! ** Method : - ... 556 !!--------------------------------------------------------------------- 557 INTEGER :: ji 558 REAL(wp), DIMENSION(jpoce) :: saltprac, temps 559 REAL(wp) :: ztkel, ztkel1, zt , zsal , zsal2 , zbuf1 , zbuf2 560 REAL(wp) :: ztgg , ztgg2, ztgg3 , ztgg4 , ztgg5 561 REAL(wp) :: zpres, ztc , zcl , zcpexp, zoxy , zcpexp2 562 REAL(wp) :: zsqrt, ztr , zlogt , zcek1, zc1, zplat 563 REAL(wp) :: zis , zis2 , zsal15, zisqrt, za1, za2 564 REAL(wp) :: zckb , zck1 , zck2 , zckw , zak1 , zak2 , zakb , zaksp0, zakw 565 REAL(wp) :: zck1p, zck2p, zck3p, zcksi, zak1p, zak2p, zak3p, zaksi 566 REAL(wp) :: zst , zft , zcks , zckf , zaksp1 567 REAL(wp) :: total2free, free2SWS, total2SWS, SWS2total 568 !!--------------------------------------------------------------------- 569 ! 570 IF( ln_timing ) CALL timing_start('sed_chem_cst') 571 ! 572 ! Computation of chemical constants require practical salinity 573 ! Thus, when TEOS08 is used, absolute salinity is converted to 574 ! practical salinity 575 ! ------------------------------------------------------------- 576 IF (neos == -1) THEN 577 saltprac(:) = salt(:) * 35.0 / 35.16504 578 ELSE 579 saltprac(:) = temp(:) 580 ENDIF 581 582 ! 583 ! Computations of chemical constants require in situ temperature 584 ! Here a quite simple formulation is used to convert 585 ! potential temperature to in situ temperature. The errors is less than 586 ! 0.04°C relative to an exact computation 587 ! --------------------------------------------------------------------- 588 DO ji = 1, jpoce 589 zpres = zkbot(ji) / 1000. 590 za1 = 0.04 * ( 1.0 + 0.185 * temp(ji) + 0.035 * (saltprac(ji) - 35.0) ) 591 za2 = 0.0075 * ( 1.0 - temp(ji) / 30.0 ) 592 temps(ji) = temp(ji) - za1 * zpres + za2 * zpres**2 593 END DO 347 594 348 595 ! CHEMICAL CONSTANTS - DEEP OCEAN 349 !------------------------------------- 350 ! [chem constants]=mol/kg solution (or (mol/kg sol)2 for akws and aksp) 351 596 ! ------------------------------- 352 597 DO ji = 1, jpoce 353 ztkel = temp(ji) + 273.16 354 ztc = temp(ji) 355 ztc2 = ztc * ztc 356 zpres = press(ji) 357 ! zqtt = ztkel * 0.01 358 zsal = salt(ji) 359 zsal2 = zsal * zsal 360 zsqrt = SQRT( zsal ) 598 ! SET PRESSION ACCORDING TO SAUNDER (1980) 599 zc1 = 5.92E-3 600 zpres = ((1-zc1)-SQRT(((1-zc1)**2)-(8.84E-6*zkbot(ji)))) / 4.42E-6 601 zpres = zpres / 10.0 602 603 ! SET ABSOLUTE TEMPERATURE 604 ztkel = temps(ji) + 273.15 605 zsal = saltprac(ji) 606 zsqrt = SQRT( zsal ) 361 607 zsal15 = zsqrt * zsal 362 zlogt = LOG( ztkel ) 363 ztr = 1./ ztkel 364 ! zis=ionic strength (ORNL/CDIAC-74, DOE 94,Dickson and Goyet) 365 zis = 19.924 * zsal / ( 1000. - 1.005 * zsal ) 366 zis2 = zis * zis 367 zisqrt = SQRT( zis ) 368 369 370 ! Density of Sea Water - F(temp,sal) [kg/m3] 371 zdens0 = Ddsw(1) + Ddsw(2) * ztc + Ddsw(3) * ztc2 & 372 + Ddsw(4) * ztc * ztc2 + Ddsw(5) * ztc2 * ztc2 & 373 + Ddsw(6) * ztc * ztc2 * ztc2 374 zaw = Adsw(1) + Adsw(2) * ztc + Adsw(3)* ztc2 + Adsw(4) * ztc * ztc2 & 375 + Adsw(5) * ztc2 * ztc2 376 zbw = Bdsw(1) + Bdsw(2) * ztc + Bdsw(3) * ztc2 377 zcw = Cdsw 378 densSW(ji) = zdens0 + zaw * zsal + zbw * zsal15 + zcw * zsal * zsal 379 densSW(ji) = densSW(ji) * 1E-3 ! to get dens in [kg/l] 380 381 382 ! FORMULA FOR CPEXP AFTER EDMOND AND GIESKES (1970) 383 ! (REFERENCE TO CULBERSON AND PYTKOQICZ (1968) AS MADE IN BROECKER ET AL. (1982) 384 ! IS INCORRECT; HERE RGAS IS TAKEN TENFOLD TO CORRECT FOR THE NOTATION OF pres IN 385 ! DBAR INSTEAD OF BAR AND THE EXPRESSION FOR CPEXP IS MULTIPLIED BY LN(10.) 386 ! TO ALLOW USE OF EXP-FUNCTION WITH BASIS E IN THE FORMULA FOR AKSPP 387 ! (CF. EDMOND AND GIESKES (1970), P. 1285 AND P. 1286 (THE SMALL FORMULA ON P. 1286 388 ! IS RIGHT AND CONSISTENT WITH THE SIGN IN PARTIAL MOLAR VOLUME CHANGE AS SHOWN ON P. 1285) 389 !----------------------------------------------------------------------------------------- 390 zcpexp = zpres / ( rgas*ztkel ) 608 zlogt = LOG( ztkel ) 609 ztr = 1. / ztkel 610 zis = 19.924 * zsal / ( 1000.- 1.005 * zsal ) 611 zis2 = zis * zis 612 zisqrt = SQRT( zis ) 613 ztc = temps(ji) 614 615 ! CHLORINITY (WOOSTER ET AL., 1969) 616 zcl = zsal / 1.80655 617 618 ! TOTAL SULFATE CONCENTR. [MOLES/kg soln] 619 zst = 0.14 * zcl /96.062 620 621 ! TOTAL FLUORIDE CONCENTR. [MOLES/kg soln] 622 zft = 0.000067 * zcl /18.9984 623 624 ! DISSOCIATION CONSTANT FOR SULFATES on free H scale (Dickson 1990) 625 zcks = EXP(-4276.1 * ztr + 141.328 - 23.093 * zlogt & 626 & + (-13856. * ztr + 324.57 - 47.986 * zlogt) * zisqrt & 627 & + (35474. * ztr - 771.54 + 114.723 * zlogt) * zis & 628 & - 2698. * ztr * zis**1.5 + 1776.* ztr * zis2 & 629 & + LOG(1.0 - 0.001005 * zsal)) 630 631 ! DISSOCIATION CONSTANT FOR FLUORIDES on free H scale (Dickson and Riley 79) 632 zckf = EXP( 1590.2*ztr - 12.641 + 1.525*zisqrt & 633 & + LOG(1.0d0 - 0.001005d0*zsal) & 634 & + LOG(1.0d0 + zst/zcks)) 635 636 ! DISSOCIATION CONSTANT FOR CARBONATE AND BORATE 637 zckb= (-8966.90 - 2890.53*zsqrt - 77.942*zsal & 638 & + 1.728*zsal15 - 0.0996*zsal*zsal)*ztr & 639 & + (148.0248 + 137.1942*zsqrt + 1.62142*zsal) & 640 & + (-24.4344 - 25.085*zsqrt - 0.2474*zsal) & 641 & * zlogt + 0.053105*zsqrt*ztkel 642 643 ! DISSOCIATION COEFFICIENT FOR CARBONATE ACCORDING TO 644 ! MEHRBACH (1973) REFIT BY MILLERO (1995), seawater scale 645 zck1 = -1.0*(3633.86*ztr - 61.2172 + 9.6777*zlogt & 646 - 0.011555*zsal + 0.0001152*zsal*zsal) 647 zck2 = -1.0*(471.78*ztr + 25.9290 - 3.16967*zlogt & 648 - 0.01781*zsal + 0.0001122*zsal*zsal) 649 650 ! PKW (H2O) (MILLERO, 1995) from composite data 651 zckw = -13847.26 * ztr + 148.9652 - 23.6521 * zlogt + ( 118.67 * ztr & 652 - 5.977 + 1.0495 * zlogt ) * zsqrt - 0.01615 * zsal 653 654 ! CONSTANTS FOR PHOSPHATE (MILLERO, 1995) 655 zck1p = -4576.752*ztr + 115.540 - 18.453*zlogt & 656 & + (-106.736*ztr + 0.69171) * zsqrt & 657 & + (-0.65643*ztr - 0.01844) * zsal 658 659 zck2p = -8814.715*ztr + 172.1033 - 27.927*zlogt & 660 & + (-160.340*ztr + 1.3566)*zsqrt & 661 & + (0.37335*ztr - 0.05778)*zsal 662 663 zck3p = -3070.75*ztr - 18.126 & 664 & + (17.27039*ztr + 2.81197) * zsqrt & 665 & + (-44.99486*ztr - 0.09984) * zsal 666 667 ! CONSTANT FOR SILICATE, MILLERO (1995) 668 zcksi = -8904.2*ztr + 117.400 - 19.334*zlogt & 669 & + (-458.79*ztr + 3.5913) * zisqrt & 670 & + (188.74*ztr - 1.5998) * zis & 671 & + (-12.1652*ztr + 0.07871) * zis2 & 672 & + LOG(1.0 - 0.001005*zsal) 673 674 ! APPARENT SOLUBILITY PRODUCT K'SP OF CALCITE IN SEAWATER 675 ! (S=27-43, T=2-25 DEG C) at pres =0 (atmos. pressure) (MUCCI 1983) 676 zaksp0 = -171.9065 -0.077993*ztkel + 2839.319*ztr + 71.595*LOG10( ztkel ) & 677 & + (-0.77712 + 0.00284263*ztkel + 178.34*ztr) * zsqrt & 678 & - 0.07711*zsal + 0.0041249*zsal15 679 680 ! K1, K2 OF CARBONIC ACID, KB OF BORIC ACID, KW (H2O) (LIT.?) 681 zak1 = 10**(zck1) * total2SWS 682 zak2 = 10**(zck2) * total2SWS 683 zakb = EXP( zckb ) * total2SWS 684 zakw = EXP( zckw ) 685 zaksp1 = 10**(zaksp0) 686 zak1p = exp( zck1p ) 687 zak2p = exp( zck2p ) 688 zak3p = exp( zck3p ) 689 zaksi = exp( zcksi ) 690 zckf = zckf * total2SWS 691 692 ! FORMULA FOR CPEXP AFTER EDMOND & GIESKES (1970) 693 ! (REFERENCE TO CULBERSON & PYTKOQICZ (1968) AS MADE 694 ! IN BROECKER ET AL. (1982) IS INCORRECT; HERE RGAS IS 695 ! TAKEN TENFOLD TO CORRECT FOR THE NOTATION OF pres IN 696 ! DBAR INSTEAD OF BAR AND THE EXPRESSION FOR CPEXP IS 697 ! MULTIPLIED BY LN(10.) TO ALLOW USE OF EXP-FUNCTION 698 ! WITH BASIS E IN THE FORMULA FOR AKSPP (CF. EDMOND 699 ! & GIESKES (1970), P. 1285-1286 (THE SMALL 700 ! FORMULA ON P. 1286 IS RIGHT AND CONSISTENT WITH THE 701 ! SIGN IN PARTIAL MOLAR VOLUME CHANGE AS SHOWN ON P. 1285)) 702 zcpexp = zpres / (rgas*ztkel) 391 703 zcpexp2 = zpres * zcpexp 392 704 393 394 ! chlorinity (WOOSTER ET AL., 1969) 395 !--------------------------------------- 396 zchl = zsal * salchl 397 398 ! total sulfate concentration [mol/kg soln] 399 ! -------------------------------------- 400 zst = st1 * zchl * st2 401 402 ! total fluoride concentration [mol/kg soln] 403 ! -------------------------------------- 404 zft = ft1 * zchl * ft2 405 406 ! dissociation constant for carbonate (Mehrback 74 - Dickson & Millero 87) 407 !--------------------------------------------------------------------------- 408 zck1 = c10*ztr - c11 + c12*zlogt - c13*zsal + c14*zsal2 409 zck2 = c20*ztr + c21 - c22*zlogt - c23*zsal + c24*zsal2 410 411 ! dissociation constant for sulfates (Dickson 1990) 412 !-------------------------------------------------- 413 zks = EXP( ks0 + ks1*ztr + ks2*zlogt & 414 & + ( ks3*ztr + ks4 + ks5*zlogt ) * zisqrt & 415 & + ( ks6*ztr + ks7 + ks8*zlogt ) * zis & 416 & + ks9*ztr*zis*zisqrt + ks10*ztr*zis2 & 417 & + LOG( ks11 + ks12*zsal ) ) 418 419 ! dissociation constant for fluorides (Dickson and Riley 79) 420 !-------------------------------------------------- 421 zkf = EXP( kf0 + kf1*ztr + kf2*zisqrt + LOG( kf3 + kf4*zsal ) ) 422 423 ! dissociation constant for borates (Doe 94) 424 !-------------------------------------------------- 425 zckb = ( cb0 + cb1*zsqrt + cb2*zsal + cb3*zsal15 + cb4*zsal2) * ztr & 426 & + ( cb5 + cb6*zsqrt + cb7*zsal) & 427 & + ( cb8 + cb9*zsqrt + cb10*zsal) * zlogt & 428 & + cb11*zsqrt*ztkel + LOG( ( 1. + zst/zks + zft/zkf ) / ( 1. + zst/zks ) ) 429 430 ! PKW (H2O) (DICKSON AND RILEY, 1979) 431 !-------------------------------------- 432 zckw = cw0*ztr + cw1 + cw2*zlogt & 433 & +( cw3*ztr + cw4 + cw5*zlogt )* zsqrt + cw6*zsal 434 435 ! For Phodphates (phosphoric acid) (DOE 1994) 436 !---------------------------------------------- 437 zck1p = cp10 + cp11*ztr + cp12*zlogt + ( cp13*ztr + cp14 ) * zsqrt & 438 & + ( cp15*ztr + cp16 ) * zsal 439 zck2p = cp20 + cp21*ztr + cp22*zlogt + ( cp23*ztr + cp24 ) * zsqrt & 440 & + ( cp25*ztr + cp26 ) * zsal 441 zck3p = cp30 + cp31*ztr + ( cp32*ztr + cp33 ) * zsqrt & 442 & + ( cp34*ztr + cp35 ) * zsal 443 444 ! For silicates (DOE 1994) change to mol/kg soln) (OCMIP) 445 !-------------------------------------------------------- 446 zcksi = cs10 + cs11*ztr + cs12*zlogt + ( cs13*ztr + cs14) * zisqrt & 447 & + ( cs15*ztr + cs16 ) * zis & 448 & + ( cs17*ztr + cs18 ) * zis2 & 449 & + LOG( 1. + cs19*zsal ) + LOG( cs20 + cs21*zsal ) 450 451 ! apparent solublity product K'SP of calcite in seawater 452 ! (S=27-43, T=2-25 DEG C) AT pres =0 (INGLE, 1975, EQ. 6) 453 ! prob: olivier a log = ln et C. Heize a LOG10(sal) 454 ! aksp0 = 1.E-7*(akcc1+akcc2*sal**(1./3.)+akcc3*log(sal)+akcc4*tkel*tkel) 455 ! aksp0 = 1.E-7*(akcc1+akcc2*sal**(1./3.)+akcc3*log10(sal)+akcc4*tkel*tkel) 456 !-------------------------------------------------------------------- 457 zaksp0 = akcc1 + akcc2*ztkel + akcc3*ztr + akcc4 * LOG10(ztkel) & 458 & + ( akcc5 + akcc6*ztkel+ akcc7*ztr ) * zsqrt & 459 & + akcc8*zsal + akcc9*zsal15 460 461 !K1, K2 of carbonic acid, KB of boric acid, KW (H2O) 462 !--------------------------------------------------- 463 zak1 = 10**( -zck1 ) 464 zak2 = 10**( -zck2 ) 465 zakb = EXP ( zckb ) 466 zakw = EXP ( zckw ) 467 zksp = 10**( zaksp0 ) 468 469 470 471 ! KB of boric acid, K1,K2 of carbonic acid pressure correction 472 ! after Culberson and AND Pytkowicz (1968) (CF. BROECKER ET AL., 1982) Millero 95 473 !-------------------------------------------------------------------------------- 474 zbuf1 = - ( devk1(1) + devk2(1)*ztc + devk3(1)*ztc2 ) 475 zbuf2 = 0.5 * ( devk4(1) + devk5(1)*ztc ) 476 ak1s(ji) = zak1 * EXP( zbuf1*zcpexp + zbuf2*zcpexp2 ) 477 478 zbuf1 = -( devk1(2) + devk2(2)*ztc + devk3(2)*ztc2 ) 479 zbuf2 = 0.5 * ( devk4(2) + devk5(2)*ztc ) 480 ak2s(ji) = zak2 * EXP( zbuf1*zcpexp + zbuf2*zcpexp2 ) 481 482 zbuf1 = - ( devk1(3) + devk2(3)*ztc + devk3(3)*ztc2 ) 483 zbuf2 = 0.5 * ( devk4(3) + devk5(3) * ztc ) 484 akbs(ji) = zakb * EXP( zbuf1*zcpexp + zbuf2*zcpexp2 ) 485 486 zbuf1 = - ( devk1(4) + devk2(4)*ztc + devk3(4)*ztc2 ) 487 zbuf2 = 0.5 * ( devk4(4) + devk5(4)*ztc ) 488 akws(ji) = zakw * EXP( zbuf1*zcpexp + zbuf2*zcpexp2 ) 489 490 491 ! APPARENT SOLUBILITY PRODUCT K''SP OF CALCITE (OR ARAGONITE) 492 ! AS FUNCTION OF PRESSURE FOLLWING EDMOND AND GIESKES (1970) 493 ! (P. 1285) AND BERNER (1976) 494 !----------------------------------------------------------------- 495 ! aksp(ji) = aksp0*exp(zcpexp*(devks-devkst*tc)) 496 ! or following Mucci 497 zbuf1 = - ( devk1(5) + devk2(5)*ztc + devk3(5)*ztc2 ) 498 zbuf2 = 0.5 *( devk4(5) + devk5(5)*ztc ) 499 aksps(ji) = zksp * EXP( zbuf1*zcpexp + zbuf2*zcpexp2 ) 500 501 ! For Phodphates (phosphoric acid) (DOE 1994) 502 !---------------------------------------------- 503 zck1p = cp10 + cp11*ztr + cp12*zlogt + ( cp13*ztr + cp14 ) * zsqrt & 504 & + ( cp15*ztr + cp16 ) * zsal 505 zck2p = cp20 + cp21*ztr + cp22*zlogt + ( cp23*ztr + cp24 ) * zsqrt & 506 & + ( cp25*ztr + cp26 ) * zsal 507 zck3p = cp30 + cp31*ztr + ( cp32*ztr + cp33 ) * zsqrt & 508 & + ( cp34*ztr + cp35 ) * zsal 509 510 ! For silicates (DOE 1994) change to mol/kg soln) (OCMIP) 511 !-------------------------------------------------------- 512 zcksi = cs10 + cs11*ztr + cs12*zlogt + ( cs13*ztr + cs14) * zisqrt & 513 & + ( cs15*ztr + cs16 ) * zis & 514 & + ( cs17*ztr + cs18 ) * zis2 & 515 & + LOG( 1. + cs19*zsal ) + LOG( cs20 + cs21*zsal ) 516 517 518 !K1, K2 of carbonic acid, KB of boric acid, KW (H2O) 519 !--------------------------------------------------- 520 zak1p = EXP ( zck1p ) 521 zak2p = EXP ( zck2p ) 522 zak3p = EXP ( zck3p ) 523 zaksil = EXP ( zcksi ) 524 525 zbuf1 = - ( devk1(3) + devk2(3)*ztc + devk3(3)*ztc2 ) 526 zbuf2 = 0.5 * ( devk4(3) + devk5(3)*ztc ) 527 aksis(ji) = zaksil * EXP( zbuf1*zcpexp + zbuf2*zcpexp2 ) 528 529 zbuf1 = - ( devk1(6) + devk2(6)*ztc + devk3(6)*ztc2 ) 530 zbuf2 = 0.5 * ( devk4(6) + devk5(6)*ztc ) 531 ak1ps(ji) = zak1p * EXP( zbuf1*zcpexp + zbuf2*zcpexp2 ) 532 533 zbuf1 = - ( devk1(7) + devk2(7)*ztc + devk3(7)*ztc2 ) 534 zbuf2 = 0.5 * ( devk4(7) + devk5(7)*ztc ) 535 ak2ps(ji) = zak2p * EXP( zbuf1*zcpexp + zbuf2*zcpexp2 ) 536 537 zbuf1 = - ( devk1(8) + devk2(8)*ztc + devk3(8)*ztc2 ) 538 zbuf2 = 0.5 * ( devk4(8) + devk5(8)*ztc ) 539 ak3ps(ji) = zak3p * EXP( zbuf1*zcpexp + zbuf2*zcpexp2 ) 540 541 ! total borat concentration. [mol/l] 542 ! or from Millero 1995 [mol/l] : borat(l) = 0.000416_8*(sal/35._8)*densSW(l) 543 ! -------------------------------------------------------------------------- 544 borats(ji) = bor1 * zchl * bor2 * densSW(ji) 545 546 ak12s (ji) = ak1s (ji) * ak2s (ji) 547 ak12ps (ji) = ak1ps(ji) * ak2ps(ji) 548 ak123ps(ji) = ak1ps(ji) * ak2ps(ji) * ak3ps(ji) 549 550 calcon2(ji) = 0.01028 * ( zsal / 35. ) * densSW(ji) 551 552 ENDDO 553 554 END SUBROUTINE sed_chem_off 555 556 #endif 557 558 #else 559 !!====================================================================== 560 !! MODULE sedchem : Dummy module 561 !!====================================================================== 562 !! $Id$ 563 CONTAINS 564 SUBROUTINE sed_chem( kt ) ! Empty routine 565 INTEGER, INTENT(in) :: kt 566 WRITE(*,*) 'trc_stp: You should not have seen this print! error?', kt 567 END SUBROUTINE sed_chem 568 569 !!====================================================================== 570 571 #endif 705 ! KB OF BORIC ACID, K1,K2 OF CARBONIC ACID PRESSURE 706 ! CORRECTION AFTER CULBERSON AND PYTKOWICZ (1968) 707 ! (CF. BROECKER ET AL., 1982) 708 709 zbuf1 = - ( devk10 + devk20 * ztc + devk30 * ztc * ztc ) 710 zbuf2 = 0.5 * ( devk40 + devk50 * ztc ) 711 ak1s(ji) = zak1 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 712 713 zbuf1 = - ( devk11 + devk21 * ztc + devk31 * ztc * ztc ) 714 zbuf2 = 0.5 * ( devk41 + devk51 * ztc ) 715 ak2s(ji) = zak2 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 716 717 zbuf1 = - ( devk12 + devk22 * ztc + devk32 * ztc * ztc ) 718 zbuf2 = 0.5 * ( devk42 + devk52 * ztc ) 719 akbs(ji) = zakb * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 720 721 zbuf1 = - ( devk13 + devk23 * ztc + devk33 * ztc * ztc ) 722 zbuf2 = 0.5 * ( devk43 + devk53 * ztc ) 723 akws(ji) = zakw * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 724 725 zbuf1 = - ( devk14 + devk24 * ztc + devk34 * ztc * ztc ) 726 zbuf2 = 0.5 * ( devk44 + devk54 * ztc ) 727 aks3s(ji) = zcks * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 728 729 zbuf1 = - ( devk15 + devk25 * ztc + devk35 * ztc * ztc ) 730 zbuf2 = 0.5 * ( devk45 + devk55 * ztc ) 731 akf3s(ji) = zckf * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 732 733 zbuf1 = - ( devk17 + devk27 * ztc + devk37 * ztc * ztc ) 734 zbuf2 = 0.5 * ( devk47 + devk57 * ztc ) 735 ak1ps(ji) = zak1p * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 736 737 zbuf1 = - ( devk18 + devk28 * ztc + devk38 * ztc * ztc ) 738 zbuf2 = 0.5 * ( devk48 + devk58 * ztc ) 739 ak2ps(ji) = zak2p * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 740 741 zbuf1 = - ( devk110 + devk210 * ztc + devk310 * ztc * ztc ) 742 zbuf2 = 0.5 * ( devk410 + devk510 * ztc ) 743 aksis(ji) = zaksi * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 744 745 ! CONVERT FROM DIFFERENT PH SCALES 746 total2free = 1.0/(1.0 + zst/aks3s(ji)) 747 free2SWS = 1. + zst/aks3s(ji) + zft/akf3s(ji) 748 total2SWS = total2free * free2SWS 749 SWS2total = 1.0 / total2SWS 750 751 ! Convert to total scale 752 ak1s(ji) = ak1s(ji) * SWS2total 753 ak2s(ji) = ak2s(ji) * SWS2total 754 akbs(ji) = akbs(ji) * SWS2total 755 akws(ji) = akws(ji) * SWS2total 756 ak1ps(ji) = ak1ps(ji) * SWS2total 757 ak2ps(ji) = ak2ps(ji) * SWS2total 758 ak3ps(ji) = ak3ps(ji) * SWS2total 759 aksis(ji) = aksis(ji) * SWS2total 760 akf3s(ji) = akf3s(ji) / total2free 761 762 ! APPARENT SOLUBILITY PRODUCT K'SP OF CALCITE 763 ! AS FUNCTION OF PRESSURE FOLLOWING MILLERO 764 ! (P. 1285) AND BERNER (1976) 765 zbuf1 = - ( devk16 + devk26 * ztc + devk36 * ztc * ztc ) 766 zbuf2 = 0.5 * ( devk46 + devk56 * ztc ) 767 aksps(ji) = zaksp1 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 768 769 ! TOTAL F, S, and BORATE CONCENTR. [MOLES/L] 770 borats(ji) = 0.0002414 * zcl / 10.811 771 sulfats(ji) = zst 772 fluorids(ji) = zft 773 774 ! Iron and SIO3 saturation concentration from ... 775 sieqs(ji) = EXP( LOG( 10.) * ( 6.44 - 968. / ztkel ) ) * 1.e-6 776 END DO 777 ! 778 IF( ln_timing ) CALL timing_stop('sed_chem_cst') 779 ! 780 END SUBROUTINE sed_chem_cst 781 572 782 573 783 END MODULE sedchem -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/TOP/PISCES/SED/sedco3.F90
r9598 r10345 1 1 MODULE sedco3 2 #if defined key_sed3 2 !!====================================================================== 4 3 !! *** MODULE sedco3 *** … … 7 6 !! * Modules used 8 7 USE sed ! sediment global variable 8 USE sedchem 9 USE lib_mpp ! distribued memory computing library 9 10 10 11 … … 15 16 PUBLIC sed_co3 16 17 17 18 !! * Module variables19 REAL(wp) :: epsmax = 1.e-12 ! convergence limite value20 21 18 !!---------------------------------------------------------------------- 22 !! OPA 9.0 ! NEMO Consortium(2003)19 !! OPA 9.0 ! LODYC-IPSL (2003) 23 20 !!---------------------------------------------------------------------- 24 21 … … 45 42 !! * Arguments 46 43 INTEGER, INTENT(in) :: kt ! time step 47 48 44 ! 49 45 !---Local variables 50 INTEGER :: ji ter, ji, jk, ipt! dummy loop indices46 INTEGER :: ji, jk ! dummy loop indices 51 47 52 INTEGER :: itermax ! maximum number of Newton-Raphson iterations 53 INTEGER :: itime ! number of time to perform Newton-Raphson algorithm 54 LOGICAL :: lconv = .FALSE. ! flag for convergence 55 REAL(wp) :: brems ! relaxation. parameter 56 REAL(wp) :: zresm, zresm1, zhipor_min 57 REAL(wp) :: zalk, zbor, zsil, zpo4, zdic 58 REAL(wp) :: zh_old, zh_old2, zh_old3, zh_old4 59 REAL(wp) :: zuu, zvv, zduu, zdvv 60 REAL(wp) :: zup, zvp, zdup, zdvp 61 REAL(wp) :: zah_old, zah_olds 62 REAL(wp) :: zh_new, zh_new2, zco3 63 48 REAL(wp), DIMENSION(jpoce,jpksed) :: zhinit, zhi 64 49 !!---------------------------------------------------------------------- 65 50 51 IF( ln_timing ) CALL timing_start('sed_co3') 52 66 53 IF( kt == nitsed000 ) THEN 67 WRITE(numsed,*) ' sed_co3 : carbonate ion and proton concentration calculation '68 WRITE(numsed,*) ' '54 IF (lwp) WRITE(numsed,*) ' sed_co3 : carbonate ion and proton concentration calculation ' 55 IF (lwp) WRITE(numsed,*) ' ' 69 56 ENDIF 70 57 71 itermax = 3072 brems = 1.73 itime = 058 DO jk = 1, jpksed 59 zhinit(:,jk) = hipor(:,jk) / densSW(:) 60 END DO 74 61 62 ! ------------------------------------------- 63 ! COMPUTE [CO3--] and [H+] CONCENTRATIONS 64 ! ------------------------------------------- 65 66 CALL solve_at_general_sed(zhinit, zhi) 75 67 76 68 DO jk = 1, jpksed 77 DO WHILE( itime <= 2 ) 78 lconv = .FALSE. 79 IF( itime > 0 ) THEN 80 ! increase max number of iterations and relaxation parameter 81 itermax = 200 82 !! brems = 0.3 83 IF( itime == 2 ) hipor(1:jpoce,jk) = 3.e-9 ! re-initilazation of [H] values 84 ENDIF 69 DO ji = 1, jpoce 70 co3por(ji,jk) = pwcp(ji,jk,jwdic) * ak1s(ji) * ak2s(ji) / (zhi(ji,jk)**2 & 71 & + ak1s(ji) * zhi(ji,jk) + ak1s(ji) * ak2s(ji) + rtrn ) 72 hipor(ji,jk) = zhi(ji,jk) * densSW(ji) 73 END DO 74 END DO 85 75 86 iflag: DO jiter = 1, itermax 87 88 ! Store previous hi field. 89 zresm = -1.e10 90 ipt = 1 91 DO ji = 1, jpoce 92 ! dissociation constant are in mol/kg of solution 93 ! convert pwcp concentration [mol/l] in mol/kg for solution 94 zalk = pwcp(ji,jk,jwalk) / densSW(ji) 95 zh_old = hipor(ji,jk) / densSW(ji) 96 zh_old2 = zh_old * zh_old 97 zh_old3 = zh_old2 * zh_old 98 zh_old4 = zh_old3 * zh_old 99 zbor = borats(ji) / densSW(ji) 100 zsil = pwcp(ji,jk,jwsil) / densSW(ji) 101 zpo4 = pwcp(ji,jk,jwpo4) / densSW(ji) 102 zdic = pwcp(ji,jk,jwdic) / densSW(ji) 103 ! intermediate calculation 104 zuu = zdic * ( ak1s(ji) / zh_old + 2.* ak12s(ji) / zh_old2 ) 105 zvv = 1. + ak1s(ji) / zh_old + ak12s(ji) / zh_old2 106 zduu = zdic * ( -ak1s(ji) / zh_old2 - 4. * ak12s(ji) / zh_old3 ) 107 zdvv = -ak1s(ji) / zh_old2 - 2. * ak12s(ji) / zh_old3 108 zup = zpo4 * ( ak12ps(ji) / zh_old2 + 2. * ak123ps(ji) / zh_old3 - 1.) 109 zvp = 1. + ak1ps(ji) / zh_old + ak12ps(ji) / zh_old2 + ak123ps(ji) / zh_old3 110 zdup = zpo4 * ( -2. * ak12ps(ji) / zh_old3 - 6. * ak123ps(ji) / zh_old4 ) 111 zdvp = -ak1ps(ji) / zh_old2 - 2.* ak12ps(ji) / zh_old3 - 3. * ak123ps(ji) / zh_old4 112 113 zah_old = zuu / zvv + zbor / ( 1. + zh_old / akbs(ji) ) + & 114 & akws(ji) / zh_old - zh_old + zsil / ( 1. + zh_old / aksis(ji) ) + & 115 & zup / zvp 116 117 zah_olds = ( ( zduu * zvv - zdvv * zuu ) / ( zvv * zvv ) ) - & 118 & zbor / akbs(ji) * ( 1. + zh_old / akbs(ji) )**(-2) - & 119 & akws(ji) / zh_old2 - 1. - & 120 & zsil / aksis(ji) * ( 1. + zh_old / aksis(ji) )**(-2) + & 121 & ( ( zdup * zvp - zdvp * zup ) / ( zvp * zvp ) ) 122 ! 123 zh_new = zh_old - brems * ( zah_old - zalk ) / zah_olds 124 ! 125 zresm1 = ABS( zh_new - zh_old ) 126 IF( zresm1 > zresm ) THEN 127 zresm = zresm1 128 ENDIF 129 ! 130 zh_new2 = zh_new * zh_new 131 zco3 = ( ak12s(ji) * zdic ) / ( ak12s(ji) + ak1s(ji) * zh_new + zh_new2) 132 ! again in mol/l 133 hipor (ji,jk) = zh_new * densSW(ji) 134 co3por(ji,jk) = zco3 * densSW(ji) 135 136 ENDDO ! end loop ji 137 138 ! convergence test 139 IF( zresm <= epsmax ) THEN 140 lconv = .TRUE. 141 !minimum value of hipor 142 zhipor_min = MINVAL( hipor(1:jpoce,jk ) ) 143 EXIT iflag 144 ENDIF 145 146 ENDDO iflag 147 148 IF( lconv ) THEN 149 ! WRITE(numsed,*) ' convergence after iter =', jiter, ' iterations ; res =',zresm 150 IF( zhipor_min < 0. ) THEN 151 IF ( itime == 0 ) THEN 152 ! WRITE(numsed,*) ' but hipor < 0 ; try one more time for jk = ', jk 153 ! WRITE(numsed,*) ' with re-initialization of initial PH field ' 154 itime = 2 155 ELSE 156 ! WRITE(numsed,*) ' convergence after iter =', jiter, ' iterations ; res =',zresm 157 ! WRITE(numsed,*) ' but hipor < 0, again for second time for jk = ', jk 158 ! WRITE(numsed,*) ' We stop : STOP ' 159 STOP 160 ENDIF 161 ELSE 162 ! WRITE(numsed,*) ' successfull convergence for level jk = ',jk,& 163 ! & ' after iter =', jiter, ' iterations ; res =',zresm 164 ! WRITE(numsed,*) ' ' 165 itime = 3 166 ENDIF 167 ELSE 168 itime = itime + 1 169 WRITE(numsed,*) ' No convergence for jk = ', jk, ' after ', itime, ' try' 170 IF ( itime == 1 ) THEN 171 WRITE(numsed,*) ' try one more time with more iterations and higher relax. value' 172 ELSE IF ( itime == 2 ) THEN 173 WRITE(numsed,*) ' try one more time for with more iterations, higher relax. value' 174 WRITE(numsed,*) ' and with re-initialization of initial PH field ' 175 ELSE 176 WRITE(numsed,*) ' No more... we stop ' 177 STOP 178 ENDIF 179 ENDIF 180 ENDDO ! End of WHILE LOOP 181 ENDDO 76 IF( ln_timing ) CALL timing_stop('sed_co3') 182 77 183 78 END SUBROUTINE sed_co3 184 #else185 !!======================================================================186 !! MODULE sedco3 : Dummy module187 !!======================================================================188 !! $Id$189 CONTAINS190 SUBROUTINE sed_co3( kt ) ! Empty routine191 INTEGER, INTENT(in) :: kt192 WRITE(*,*) 'sed_co3: You should not have seen this print! error?', kt193 END SUBROUTINE sed_co3194 195 !!======================================================================196 197 #endif198 79 199 80 END MODULE sedco3 -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/TOP/PISCES/SED/seddsr.F90
r5215 r10345 1 1 MODULE seddsr 2 #if defined key_sed3 2 !!====================================================================== 4 3 !! *** MODULE seddsr *** 5 !! Sediment : dissolution and reaction in pore water 4 !! Sediment : dissolution and reaction in pore water related 5 !! related to organic matter 6 6 !!===================================================================== 7 7 !! * Modules used 8 8 USE sed ! sediment global variable 9 USE sedmat ! linear system of equations 10 USE sedco3 ! carbonate ion and proton concentration 9 USE sed_oce 10 USE sedini 11 USE lib_mpp ! distribued memory computing library 12 USE lib_fortran 13 14 IMPLICIT NONE 15 PRIVATE 11 16 12 17 PUBLIC sed_dsr … … 14 19 !! * Module variables 15 20 16 REAL(wp), DIMENSION(:), ALLOCATABLE, PUBLIC :: cons_o2 17 REAL(wp), DIMENSION(:), ALLOCATABLE, PUBLIC :: cons_no3 18 REAL(wp), DIMENSION(:), ALLOCATABLE, PUBLIC :: sour_no3 19 REAL(wp), DIMENSION(:), ALLOCATABLE, PUBLIC :: sour_c13 20 REAL(wp), DIMENSION(:), ALLOCATABLE, PUBLIC :: dens_mol_wgt ! molecular density 21 REAL(wp) :: zadsnh4 22 REAL(wp), DIMENSION(jpsol), PUBLIC :: dens_mol_wgt ! molecular density 23 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zvolc ! temp. variables 24 21 25 22 26 !! $Id$ 23 27 CONTAINS 24 28 25 SUBROUTINE sed_dsr( kt )29 SUBROUTINE sed_dsr( kt, knt ) 26 30 !!---------------------------------------------------------------------- 27 31 !! *** ROUTINE sed_dsr *** … … 29 33 !! ** Purpose : computes pore water dissolution and reaction 30 34 !! 31 !! ** Methode : implicit simultaneous computation of undersaturation 32 !! resulting from diffusive pore water transport and chemical 33 !! pore water reactions. Solid material is consumed according 34 !! to redissolution and remineralisation 35 !! 36 !! ** Remarks : 37 !! - undersaturation : deviation from saturation concentration 38 !! - reaction rate : sink of undersaturation from dissolution 39 !! of solid material 35 !! ** Methode : Computation of the redox reactions in sediment. 36 !! The main redox reactions are solved in sed_dsr whereas 37 !! the secondary reactions are solved in sed_dsr_redoxb. 38 !! A strand spliting approach is being used here (see 39 !! sed_dsr_redoxb for more information). 40 40 !! 41 41 !! History : … … 43 43 !! ! 04-10 (N. Emprin, M. Gehlen ) f90 44 44 !! ! 06-04 (C. Ethe) Re-organization 45 !! ! 19-08 (O. Aumont) Debugging and improvement of the model. 46 !! The original method is replaced by a 47 !! Strand splitting method which deals 48 !! well with stiff reactions. 45 49 !!---------------------------------------------------------------------- 46 50 !! Arguments 47 INTEGER, INTENT(in) :: kt ! number of iteration51 INTEGER, INTENT(in) :: kt, knt ! number of iteration 48 52 ! --- local variables 49 INTEGER :: ji, jk, js, jw ! dummy looop indices 50 INTEGER :: nv ! number of variables in linear tridiagonal eq 51 52 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zrearat ! reaction rate in pore water 53 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zundsat ! undersaturation ; indice jpwatp1 is for calcite 54 REAL(wp), DIMENSION(: ), ALLOCATABLE :: zmo2_0, zmo2_1 ! temp. array for mass balance calculation 55 REAL(wp), DIMENSION(: ), ALLOCATABLE :: zmno3_0, zmno3_1, zmno3_2 56 REAL(wp), DIMENSION(: ), ALLOCATABLE :: zmc13_0, zmc13_1, zmc13_2, zmc13_3 57 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zvolc ! temp. variables 53 INTEGER :: ji, jk, js, jw, jn ! dummy looop indices 54 55 REAL(wp), DIMENSION(jpoce,jpksed) :: zrearat1, zrearat2, zrearat3 ! reaction rate in pore water 56 REAL(wp), DIMENSION(jpoce,jpksed) :: zundsat ! undersaturation ; indice jpwatp1 is for calcite 57 REAL(wp), DIMENSION(jpoce,jpksed) :: zkpoc, zkpos, zkpor, zlimo2, zlimno3, zlimso4, zlimfeo ! undersaturation ; indice jpwatp1 is for calcite 58 REAL(wp), DIMENSION(jpoce) :: zsumtot 58 59 REAL(wp) :: zsolid1, zsolid2, zsolid3, zvolw, zreasat 59 60 REAL(wp) :: zsatur, zsatur2, znusil, zkpoca, zkpocb, zkpocc 61 REAL(wp) :: zratio, zgamma, zbeta, zlimtmp, zundsat2 60 62 !! 61 63 !!---------------------------------------------------------------------- 62 64 63 IF( kt == nitsed000 ) THEN 64 WRITE(numsed,*) ' sed_dsr : Dissolution reaction ' 65 WRITE(numsed,*) ' ' 66 ! 67 ALLOCATE( dens_mol_wgt((jpoce) ) 68 dens_mol_wgt(1:jpsol) = dens / mol_wgt(1:jpsol) 69 ! 70 ALLOCATE( cons_o2 (jpoce) ) ; ALLOCATE( cons_no3(jpoce) ) 71 ALLOCATE( sour_no3(jpoce) ) ; ALLOCATE( sour_c13(jpoce) ) 65 IF( ln_timing ) CALL timing_start('sed_dsr') 66 ! 67 IF( kt == nitsed000 .AND. knt == 1 ) THEN 68 IF (lwp) THEN 69 WRITE(numsed,*) ' sed_dsr : Dissolution reaction ' 70 WRITE(numsed,*) ' ' 71 ENDIF 72 72 ENDIF 73 73 74 ! Initialization of data for mass balance calculation 75 !--------------------------------------------------- 76 77 tokbot(:,:) = 0. 78 cons_o2 (:) = 0. 79 cons_no3(:) = 0. 80 sour_no3(:) = 0. 81 sour_c13(:) = 0. 82 83 ! Initializations 84 !---------------------- 85 ALLOCATE( zmo2_0 (jpoce) ) ; ALLOCATE( zmo2_1 (jpoce) ) 86 ALLOCATE( zmno3_0(jpoce) ) ; ALLOCATE( zmno3_1(jpoce) ) ; ALLOCATE( zmno3_2(jpoce) ) 87 ALLOCATE( zmc13_0(jpoce) ) ; ALLOCATE( zmc13_1(jpoce) ) ; ALLOCATE( zmc13_2(jpoce) ) ; ALLOCATE( zmc13_3(jpoce) ) 88 89 zmo2_0 (:) = 0. ; zmo2_1 (:) = 0. 90 zmno3_0(:) = 0. ; zmno3_1(:) = 0. ; zmno3_2(:) = 0. 91 zmc13_0(:) = 0. ; zmc13_1(:) = 0. ; zmc13_2(:) = 0. ; zmc13_3(:) = 0. 74 ! Initializations 75 !---------------------- 92 76 93 ALLOCATE( zrearat(jpoce,jpksed,3) ) ; ALLOCATE( zundsat(jpoce,jpksed,3) ) 94 zrearat(:,:,:) = 0. ; zundsat(:,:,:) = 0. 95 96 97 ALLOCATE( zvolc(jpoce,jpksed,jpsol) ) 98 zvolc(:,:,:) = 0. 99 100 !-------------------------------------------------------------------- 101 ! Temporary accomodation to take account of particule rain deposition 102 !--------------------------------------------------------------------- 103 104 105 ! 1. Change of geometry 106 ! Increase of dz3d(2) thickness : dz3d(2) = dz3d(2)+dzdep 107 ! Warning : no change for dz(2) 108 !--------------------------------------------------------- 109 dz3d(1:jpoce,2) = dz3d(1:jpoce,2) + dzdep(1:jpoce) 110 111 112 ! New values for volw3d(:,2) and vols3d(:,2) 113 ! Warning : no change neither for volw(2) nor vols(2) 114 !------------------------------------------------------ 115 volw3d(1:jpoce,2) = dz3d(1:jpoce,2) * por(2) 116 vols3d(1:jpoce,2) = dz3d(1:jpoce,2) * por1(2) 77 zrearat1(:,:) = 0. ; zundsat(:,:) = 0. ; zkpoc(:,:) = 0. 78 zlimo2 (:,:) = 0. ; zlimno3(:,:) = 0. ; zrearat2(:,:) = 0. 79 zlimso4(:,:) = 0. ; zkpor(:,:) = 0. ; zrearat3(:,:) = 0. 80 zkpos (:,:) = 0. 81 zsumtot(:) = rtrn 82 83 ALLOCATE( zvolc(jpoce, jpksed, jpsol) ) 84 zvolc(:,:,:) = 0. 85 zadsnh4 = 1.0 / ( 1.0 + adsnh4 ) 86 87 ! Inhibition terms for the different redox equations 88 ! -------------------------------------------------- 89 DO jk = 1, jpksed 90 DO ji = 1, jpoce 91 zkpoc(ji,jk) = reac_pocl 92 zkpos(ji,jk) = reac_pocs 93 zkpor(ji,jk) = reac_pocr 94 END DO 95 END DO 117 96 118 97 ! Conversion of volume units … … 120 99 DO js = 1, jpsol 121 100 DO jk = 1, jpksed 122 DO ji = 1, jpoce 101 DO ji = 1, jpoce 123 102 zvolc(ji,jk,js) = ( vols3d(ji,jk) * dens_mol_wgt(js) ) / & 124 & ( volw3d(ji,jk) * 1.e-3 ) 103 & ( volw3d(ji,jk) * 1.e-3 ) 125 104 ENDDO 126 105 ENDDO 127 106 ENDDO 128 107 129 ! 2. Change of previous solid fractions (due to volum changes) for k=2130 !---------------------------------------------------------------------131 132 DO js = 1, jpsol133 DO ji = 1, jpoce134 solcp(ji,2,js) = solcp(ji,2,js) * dz(2) / dz3d(ji,2)135 ENDDO136 END DO137 138 ! 3. New solid fractions (including solid rain fractions) for k=2139 !------------------------------------------------------------------140 DO js = 1, jpsol141 DO ji = 1, jpoce142 solcp(ji,2,js) = solcp(ji,2,js) + &143 & ( rainrg(ji,js) / raintg(ji) ) * ( dzdep(ji) / dz3d(ji,2) )144 ! rainrm are temporary cancel145 rainrm(ji,js) = 0.146 END DO147 ENDDO148 149 ! 4. Adjustment of bottom water concen.(pwcp(1)):150 ! We impose that pwcp(2) is constant. Including dzdep in dz3d(:,2) we assume151 ! that dzdep has got a porosity of por(2). So pore water volum of jk=2 increase.152 ! To keep pwcp(2) cste we must compensate this "increase" by a slight adjusment153 ! of bottom water concentration.154 ! This adjustment is compensate at the end of routine155 !-------------------------------------------------------------156 DO jw = 1, jpwat157 DO ji = 1, jpoce158 pwcp(ji,1,jw) = pwcp(ji,1,jw) - &159 & pwcp(ji,2,jw) * dzdep(ji) * por(2) / dzkbot(ji)160 END DO161 ENDDO162 163 164 108 !---------------------------------------------------------- 165 ! 5. Beginning of Pore Water diffusion andsolid reaction109 ! 5. Beginning of solid reaction 166 110 !--------------------------------------------------------- 167 168 !-----------------------------------------------------------------------------169 ! For jk=2,jpksed, and for couple170 ! 1 : jwsil/jsopal ( SI/Opal )171 ! 2 : jsclay/jsclay ( clay/clay )172 ! 3 : jwoxy/jspoc ( O2/POC )173 ! reaction rate is a function of solid=concentration in solid reactif in [mol/l]174 ! and undersaturation in [mol/l].175 ! Solid weight fractions should be in ie [mol/l])176 ! second member and solution are in zundsat variable177 !-------------------------------------------------------------------------178 179 !number of variables180 nv = 3181 182 DO jk = 1, jpksed183 DO ji = 1, jpoce184 ! For Silicic Acid and clay185 zundsat(ji,jk,1) = sat_sil - pwcp(ji,jk,jwsil)186 zundsat(ji,jk,2) = sat_clay187 ! For O2188 zundsat(ji,jk,3) = pwcp(ji,jk,jwoxy) / so2ut189 ENDDO190 ENDDO191 192 111 193 112 ! Definition of reaction rates [rearat]=sans dim 194 113 ! For jk=1 no reaction (pure water without solid) for each solid compo 195 DO ji = 1, jpoce 196 zrearat(ji,1,:) = 0. 197 ENDDO 198 114 zrearat1(:,:) = 0. 115 zrearat2(:,:) = 0. 116 zrearat3(:,:) = 0. 117 118 zundsat(:,:) = pwcp(:,:,jwoxy) 119 120 DO jk = 2, jpksed 121 DO ji = 1, jpoce 122 zlimo2(ji,jk) = 1.0 / ( zundsat(ji,jk) + xksedo2 ) 123 zsolid1 = zvolc(ji,jk,jspoc) * solcp(ji,jk,jspoc) 124 zsolid2 = zvolc(ji,jk,jspos) * solcp(ji,jk,jspos) 125 zsolid3 = zvolc(ji,jk,jspor) * solcp(ji,jk,jspor) 126 zkpoca = zkpoc(ji,jk) * zlimo2(ji,jk) 127 zkpocb = zkpos(ji,jk) * zlimo2(ji,jk) 128 zkpocc = zkpor(ji,jk) * zlimo2(ji,jk) 129 zrearat1(ji,jk) = ( zkpoc(ji,jk) * dtsed2 * zsolid1 ) / & 130 & ( 1. + zkpoca * zundsat(ji,jk ) * dtsed2 ) 131 zrearat2(ji,jk) = ( zkpos(ji,jk) * dtsed2 * zsolid2 ) / & 132 & ( 1. + zkpocb * zundsat(ji,jk ) * dtsed2 ) 133 zrearat3(ji,jk) = ( zkpor(ji,jk) * dtsed2 * zsolid3 ) / & 134 & ( 1. + zkpocc * zundsat(ji,jk ) * dtsed2 ) 135 ENDDO 136 ENDDO 199 137 200 138 ! left hand side of coefficient matrix 201 DO jk = 2, jpksed 202 DO ji = 1, jpoce 203 zsolid1 = zvolc(ji,jk,jsopal) * solcp(ji,jk,jsopal) 204 zsolid2 = zvolc(ji,jk,jsclay) * solcp(ji,jk,jsclay) 205 zsolid3 = zvolc(ji,jk,jspoc) * solcp(ji,jk,jspoc) 206 207 zrearat(ji,jk,1) = ( reac_sil * dtsed * zsolid1 ) / & 208 & ( 1. + reac_sil * dtsed * zundsat(ji,jk,1 ) ) 209 zrearat(ji,jk,2) = ( reac_clay * dtsed * zsolid2 ) / & 210 & ( 1. + reac_clay * dtsed * zundsat(ji,jk,2 ) ) 211 zrearat(ji,jk,3) = ( reac_poc * dtsed * zsolid3 ) / & 212 & ( 1. + reac_poc * dtsed * zundsat(ji,jk,3 ) ) 213 ENDDO 214 ENDDO 215 216 217 CALL sed_mat( nv, jpoce, jpksed, zrearat, zundsat ) 218 139 ! DO jn = 1, 5 140 DO jk = 2, jpksed 141 DO ji = 1, jpoce 142 jflag1: DO jn = 1, 10 143 zsolid1 = zvolc(ji,jk,jspoc) * solcp(ji,jk,jspoc) 144 zsolid2 = zvolc(ji,jk,jspos) * solcp(ji,jk,jspos) 145 zsolid3 = zvolc(ji,jk,jspor) * solcp(ji,jk,jspor) 146 zbeta = xksedo2 - pwcp(ji,jk,jwoxy) + so2ut * ( zrearat1(ji,jk) & 147 & + zrearat2(ji,jk) + zrearat3(ji,jk) ) 148 zgamma = - xksedo2 * pwcp(ji,jk,jwoxy) 149 zundsat2 = zundsat(ji,jk) 150 zundsat(ji,jk) = ( - zbeta + SQRT( zbeta**2 - 4.0 * zgamma ) ) / 2.0 151 zlimo2(ji,jk) = 1.0 / ( zundsat(ji,jk) + xksedo2 ) 152 zkpoca = zkpoc(ji,jk) * zlimo2(ji,jk) 153 zkpocb = zkpos(ji,jk) * zlimo2(ji,jk) 154 zkpocc = zkpor(ji,jk) * zlimo2(ji,jk) 155 zrearat1(ji,jk) = ( zkpoc(ji,jk) * dtsed2 * zsolid1 ) / & 156 & ( 1. + zkpoca * zundsat(ji,jk ) * dtsed2 ) 157 zrearat2(ji,jk) = ( zkpos(ji,jk) * dtsed2 * zsolid2 ) / & 158 & ( 1. + zkpocb * zundsat(ji,jk ) * dtsed2 ) 159 zrearat3(ji,jk) = ( zkpor(ji,jk) * dtsed2 * zsolid3 ) / & 160 & ( 1. + zkpocc * zundsat(ji,jk ) * dtsed2 ) 161 IF ( ABS( (zundsat(ji,jk)-zundsat2)/(zundsat2+rtrn)) < 1E-8 ) THEN 162 EXIT jflag1 163 ENDIF 164 END DO jflag1 165 END DO 166 END DO 219 167 220 168 ! New solid concentration values (jk=2 to jksed) for each couple 221 DO js = 1, nv 222 DO jk = 2, jpksed 223 DO ji = 1, jpoce 224 zreasat = zrearat(ji,jk,js) * zundsat(ji,jk,js) / zvolc(ji,jk,js) 225 solcp(ji,jk,js) = solcp(ji,jk,js) - zreasat 226 ENDDO 227 ENDDO 228 ENDDO 229 ! mass of O2/NO3 before POC remin. for mass balance check 230 ! det. of o2 consomation/NO3 production Mc13 231 DO jk = 1, jpksed 232 DO ji = 1, jpoce 233 zvolw = volw3d(ji,jk) * 1.e-3 234 zmo2_0 (ji) = zmo2_0 (ji) + pwcp(ji,jk,jwoxy) * zvolw 235 zmno3_0(ji) = zmno3_0(ji) + pwcp(ji,jk,jwno3) * zvolw 236 zmc13_0(ji) = zmc13_0(ji) + pwcp(ji,jk,jwc13) * zvolw 169 DO jk = 2, jpksed 170 DO ji = 1, jpoce 171 zreasat = zrearat1(ji,jk) * zlimo2(ji,jk) * zundsat(ji,jk) / zvolc(ji,jk,jspoc) 172 solcp(ji,jk,jspoc) = solcp(ji,jk,jspoc) - zreasat 173 zreasat = zrearat2(ji,jk) * zlimo2(ji,jk) * zundsat(ji,jk) / zvolc(ji,jk,jspos) 174 solcp(ji,jk,jspos) = solcp(ji,jk,jspos) - zreasat 175 zreasat = zrearat3(ji,jk) * zlimo2(ji,jk) * zundsat(ji,jk) / zvolc(ji,jk,jspor) 176 solcp(ji,jk,jspor) = solcp(ji,jk,jspor) - zreasat 237 177 ENDDO 238 178 ENDDO 239 179 240 180 ! New pore water concentrations 241 DO jk = 1, jpksed181 DO jk = 2, jpksed 242 182 DO ji = 1, jpoce 243 183 ! Acid Silicic 244 pwcp(ji,jk,jwsil) = sat_sil - zundsat(ji,jk,1) 245 ! For O2 (in mol/l) 246 pwcp(ji,jk,jwoxy) = zundsat(ji,jk,3) * so2ut 247 zreasat = zrearat(ji,jk,3) * zundsat(ji,jk,3) ! oxygen 184 pwcp(ji,jk,jwoxy) = zundsat(ji,jk) 185 zreasat = ( zrearat1(ji,jk) + zrearat2(ji,jk) + zrearat3(ji,jk) ) * zlimo2(ji,jk) * zundsat(ji,jk) ! oxygen 248 186 ! For DIC 249 187 pwcp(ji,jk,jwdic) = pwcp(ji,jk,jwdic) + zreasat 250 ! For nitrates 251 pwcp(ji,jk,jwno3) = pwcp(ji,jk,jwno3) + zreasat * srno3 188 zsumtot(ji) = zsumtot(ji) + zreasat / dtsed2 * volw3d(ji,jk) * 1.e-3 * 86400. * 365. * 1E3 252 189 ! For Phosphate (in mol/l) 253 pwcp(ji,jk,jwpo4) = pwcp(ji,jk,jwpo4) + zreasat * spo4r 190 pwcp(ji,jk,jwpo4) = pwcp(ji,jk,jwpo4) + zreasat * spo4r 191 ! For iron (in mol/l) 192 pwcp(ji,jk,jwfe2) = pwcp(ji,jk,jwfe2) + fecratio(ji) * zreasat 254 193 ! For alkalinity 255 pwcp(ji,jk,jwalk) = pwcp(ji,jk,jwalk) - zreasat * ( srno3 + 2.* spo4r ) 256 ! For DIC13 257 pwcp(ji,jk,jwc13) = pwcp(ji,jk,jwc13) + zreasat * rc13P * pdb 258 ENDDO 259 ENDDO 260 261 262 ! Mass of O2 for mass balance check and det. of o2 consomation 263 DO jk = 1, jpksed 264 DO ji = 1, jpoce 265 zvolw = volw3d(ji,jk) * 1.e-3 266 zmo2_1 (ji) = zmo2_1 (ji) + pwcp(ji,jk,jwoxy) * zvolw 267 zmno3_1(ji) = zmno3_1(ji) + pwcp(ji,jk,jwno3) * zvolw 268 zmc13_1(ji) = zmc13_1(ji) + pwcp(ji,jk,jwc13) * zvolw 269 ENDDO 270 ENDDO 271 272 DO ji = 1, jpoce 273 cons_o2 (ji) = zmo2_0 (ji) - zmo2_1 (ji) 274 sour_no3(ji) = zmno3_1(ji) - zmno3_0(ji) 275 sour_c13(ji) = zmc13_1(ji) - zmc13_0(ji) 276 ENDDO 277 194 pwcp(ji,jk,jwalk) = pwcp(ji,jk,jwalk) + zreasat * ( srno3 * zadsnh4 - 2.* spo4r ) 195 ! Ammonium 196 pwcp(ji,jk,jwnh4) = pwcp(ji,jk,jwnh4) + zreasat * srno3 * zadsnh4 197 ! Ligands 198 sedligand(ji,jk) = sedligand(ji,jk) + ratligc * zreasat - reac_ligc * sedligand(ji,jk) 199 ENDDO 200 ENDDO 278 201 279 202 !-------------------------------------------------------------------- … … 282 205 !-------------------------------------------------------------------- 283 206 284 nv = 1 285 DO jk = 1, jpksed 286 DO ji = 1, jpoce 287 zundsat(ji,jk,1) = pwcp(ji,jk,jwno3) / srDnit 288 ENDDO 289 ENDDO 290 DO jk = 2, jpksed 291 DO ji = 1, jpoce 292 IF( pwcp(ji,jk,jwoxy) < sthrO2 ) THEN 207 zrearat1(:,:) = 0. 208 zrearat2(:,:) = 0. 209 zrearat3(:,:) = 0. 210 211 zundsat(:,:) = pwcp(:,:,jwno3) 212 213 DO jk = 2, jpksed 214 DO ji = 1, jpoce 215 zlimno3(ji,jk) = ( 1.0 - pwcp(ji,jk,jwoxy) * zlimo2(ji,jk) ) / ( zundsat(ji,jk) + xksedno3 ) 216 zsolid1 = zvolc(ji,jk,jspoc) * solcp(ji,jk,jspoc) 217 zsolid2 = zvolc(ji,jk,jspos) * solcp(ji,jk,jspos) 218 zsolid3 = zvolc(ji,jk,jspor) * solcp(ji,jk,jspor) 219 zkpoca = zkpoc(ji,jk) * zlimno3(ji,jk) 220 zkpocb = zkpos(ji,jk) * zlimno3(ji,jk) 221 zkpocc = zkpor(ji,jk) * zlimno3(ji,jk) 222 zrearat1(ji,jk) = ( zkpoc(ji,jk) * dtsed2 * zsolid1 ) / & 223 & ( 1. + zkpoca * zundsat(ji,jk ) * dtsed2 ) 224 zrearat2(ji,jk) = ( zkpos(ji,jk) * dtsed2 * zsolid2 ) / & 225 & ( 1. + zkpocb * zundsat(ji,jk ) * dtsed2 ) 226 zrearat3(ji,jk) = ( zkpor(ji,jk) * dtsed2 * zsolid3 ) / & 227 & ( 1. + zkpocc * zundsat(ji,jk ) * dtsed2 ) 228 END DO 229 END DO 230 231 ! DO jn = 1, 5 232 DO jk = 2, jpksed 233 DO ji = 1, jpoce 234 jflag2: DO jn = 1, 10 235 zlimtmp = ( 1.0 - pwcp(ji,jk,jwoxy) * zlimo2(ji,jk) ) 293 236 zsolid1 = zvolc(ji,jk,jspoc) * solcp(ji,jk,jspoc) 294 zrearat(ji,jk,1) = ( reac_no3 * dtsed * zsolid1 ) / & 295 & ( 1. + reac_no3 * dtsed * zundsat(ji,jk,1 ) ) 296 ELSE 297 zrearat(ji,jk,1) = 0. 298 ENDIF 299 END DO 300 END DO 301 302 303 ! solves tridiagonal system 304 CALL sed_mat( nv, jpoce, jpksed, zrearat, zundsat ) 237 zsolid2 = zvolc(ji,jk,jspos) * solcp(ji,jk,jspos) 238 zsolid3 = zvolc(ji,jk,jspor) * solcp(ji,jk,jspor) 239 zbeta = xksedno3 - pwcp(ji,jk,jwno3) + srDnit * ( zrearat1(ji,jk) & 240 & + zrearat2(ji,jk) + zrearat3(ji,jk) ) * zlimtmp 241 zgamma = - xksedno3 * pwcp(ji,jk,jwno3) 242 zundsat2 = zundsat(ji,jk) 243 zundsat(ji,jk) = ( - zbeta + SQRT( zbeta**2 - 4.0 * zgamma ) ) / 2.0 244 zlimno3(ji,jk) = ( 1.0 - pwcp(ji,jk,jwoxy) * zlimo2(ji,jk) ) / ( zundsat(ji,jk) + xksedno3 ) 245 zkpoca = zkpoc(ji,jk) * zlimno3(ji,jk) 246 zkpocb = zkpos(ji,jk) * zlimno3(ji,jk) 247 zkpocc = zkpor(ji,jk) * zlimno3(ji,jk) 248 zrearat1(ji,jk) = ( zkpoc(ji,jk) * dtsed2 * zsolid1 ) / & 249 & ( 1. + zkpoca * zundsat(ji,jk ) * dtsed2 ) 250 zrearat2(ji,jk) = ( zkpos(ji,jk) * dtsed2 * zsolid2 ) / & 251 & ( 1. + zkpocb * zundsat(ji,jk ) * dtsed2 ) 252 zrearat3(ji,jk) = ( zkpor(ji,jk) * dtsed2 * zsolid3 ) / & 253 & ( 1. + zkpocc * zundsat(ji,jk ) * dtsed2 ) 254 IF ( ABS( (zundsat(ji,jk)-zundsat2)/(zundsat2+rtrn)) < 1E-8 ) THEN 255 EXIT jflag2 256 ENDIF 257 END DO jflag2 258 END DO 259 END DO 305 260 306 261 … … 308 263 DO jk = 2, jpksed 309 264 DO ji = 1, jpoce 310 zreasat = zrearat (ji,jk,1) * zundsat(ji,jk,1) / zvolc(ji,jk,jspoc)265 zreasat = zrearat1(ji,jk) * zlimno3(ji,jk) * zundsat(ji,jk) / zvolc(ji,jk,jspoc) 311 266 solcp(ji,jk,jspoc) = solcp(ji,jk,jspoc) - zreasat 267 zreasat = zrearat2(ji,jk) * zlimno3(ji,jk) * zundsat(ji,jk) / zvolc(ji,jk,jspos) 268 solcp(ji,jk,jspos) = solcp(ji,jk,jspos) - zreasat 269 zreasat = zrearat3(ji,jk) * zlimno3(ji,jk) * zundsat(ji,jk) / zvolc(ji,jk,jspor) 270 solcp(ji,jk,jspor) = solcp(ji,jk,jspor) - zreasat 312 271 ENDDO 313 272 ENDDO 314 273 315 274 ! New dissolved concentrations 316 DO jk = 1, jpksed 317 DO ji = 1, jpoce 318 zreasat = zrearat(ji,jk,1) * zundsat(ji,jk,1) 275 DO jk = 2, jpksed 276 DO ji = 1, jpoce 319 277 ! For nitrates 320 pwcp(ji,jk,jwno3) = zundsat(ji,jk,1) * srDnit 278 pwcp(ji,jk,jwno3) = zundsat(ji,jk) 279 zreasat = ( zrearat1(ji,jk) + zrearat2(ji,jk) + zrearat3(ji,jk) ) * zlimno3(ji,jk) * zundsat(ji,jk) 321 280 ! For DIC 322 281 pwcp(ji,jk,jwdic) = pwcp(ji,jk,jwdic) + zreasat 282 zsumtot(ji) = zsumtot(ji) + zreasat / dtsed2 * volw3d(ji,jk) * 1.e-3 * 86400. * 365. * 1E3 323 283 ! For Phosphate (in mol/l) 324 284 pwcp(ji,jk,jwpo4) = pwcp(ji,jk,jwpo4) + zreasat * spo4r 285 ! Ligands 286 sedligand(ji,jk) = sedligand(ji,jk) + ratligc * zreasat 287 ! For iron (in mol/l) 288 pwcp(ji,jk,jwfe2) = pwcp(ji,jk,jwfe2) + fecratio(ji) * zreasat 325 289 ! For alkalinity 326 pwcp(ji,jk,jwalk) = pwcp(ji,jk,jwalk) + zreasat * ( srDnit - 2.* spo4r ) 327 ! For DIC13 328 pwcp(ji,jk,jwc13) = pwcp(ji,jk,jwc13) + zreasat * rc13P * pdb 329 ENDDO 330 ENDDO 331 332 333 ! Mass of O2 for mass balance check and det. of o2 consomation 334 DO jk = 1, jpksed 335 DO ji = 1, jpoce 336 zvolw = volw3d(ji,jk) * 1.e-3 337 zmno3_2(ji) = zmno3_2(ji) + pwcp(ji,jk ,jwno3) * zvolw 338 zmc13_2(ji) = zmc13_2(ji) + pwcp(ji,jk ,jwc13) * zvolw 339 ENDDO 340 ENDDO 341 342 DO ji = 1, jpoce 343 cons_no3(ji) = zmno3_1(ji) - zmno3_2(ji) 344 sour_c13(ji) = sour_c13(ji) + zmc13_2(ji) - zmc13_1(ji) 345 ENDDO 346 347 348 !--------------------------- 349 ! Solves PO4 diffusion 350 !---------------------------- 351 352 nv = 1 353 DO jk = 1, jpksed 354 DO ji = 1, jpoce 355 zundsat(ji,jk,1) = pwcp(ji,jk,jwpo4) 356 zrearat(ji,jk,1) = 0. 357 ENDDO 358 ENDDO 359 360 361 ! solves tridiagonal system 362 CALL sed_mat( nv, jpoce, jpksed, zrearat, zundsat ) 363 364 365 ! New undsaturation values and dissolved concentrations 366 DO jk = 1, jpksed 367 DO ji = 1, jpoce 368 pwcp(ji,jk,jwpo4) = zundsat(ji,jk,1) 369 ENDDO 370 ENDDO 371 372 373 !--------------------------------------------------------------- 374 ! Performs CaCO3 particle deposition and redissolution (indice 9) 375 !-------------------------------------------------------------- 376 377 ! computes co3por from the updated pwcp concentrations (note [co3por] = mol/l) 378 379 CALL sed_co3( kt ) 380 381 382 nv = 1 383 ! *densSW(l)**2 converts aksps [mol2/kg sol2] into [mol2/l2] to get [undsat] in [mol/l] 384 DO jk = 1, jpksed 385 DO ji = 1, jpoce 386 zundsat(ji,jk,1) = aksps(ji) * densSW(ji) * densSW(ji) / calcon2(ji) & 387 & - co3por(ji,jk) 388 ! positive values of undersaturation 389 zundsat(ji,jk,1) = MAX( 0., zundsat(ji,jk,1) ) 390 ENDDO 391 ENDDO 392 393 DO jk = 2, jpksed 394 DO ji = 1, jpoce 395 zsolid1 = zvolc(ji,jk,jscal) * solcp(ji,jk,jscal) 396 zrearat(ji,jk,1) = ( reac_cal * dtsed * zsolid1 ) / & 397 & ( 1. + reac_cal * dtsed * zundsat(ji,jk,1) ) 398 END DO 399 END DO 400 401 402 ! solves tridiagonal system 403 CALL sed_mat( nv, jpoce, jpksed, zrearat, zundsat ) 404 405 406 ! New solid concentration values (jk=2 to jksed) for cacO3 407 DO jk = 2, jpksed 408 DO ji = 1, jpoce 409 zreasat = zrearat(ji,jk,1) * zundsat(ji,jk,1) / zvolc(ji,jk,jscal) 410 solcp(ji,jk,jscal) = solcp(ji,jk,jscal) - zreasat 411 ENDDO 412 ENDDO 290 pwcp(ji,jk,jwalk) = pwcp(ji,jk,jwalk) + zreasat * ( srDnit + srno3 * zadsnh4 - 2.* spo4r ) 291 ! Ammonium 292 pwcp(ji,jk,jwnh4) = pwcp(ji,jk,jwnh4) + zreasat * srno3 * zadsnh4 293 ENDDO 294 ENDDO 295 296 !-------------------------------------------------------------------- 297 ! Begining POC iron reduction 298 ! (indice n�5 for couple POFe(OH)3 ie solcp(:,:,jspoc)/pwcp(:,:,jsfeo)) 299 !-------------------------------------------------------------------- 300 301 zrearat1(:,:) = 0. 302 zrearat2(:,:) = 0. 303 zrearat3(:,:) = 0. 304 305 zundsat(:,:) = solcp(:,:,jsfeo) 306 307 DO jk = 2, jpksed 308 DO ji = 1, jpoce 309 zlimfeo(ji,jk) = ( 1.0 - pwcp(ji,jk,jwoxy) * zlimo2(ji,jk) ) * ( 1.0 - pwcp(ji,jk,jwno3) & 310 & / ( pwcp(ji,jk,jwno3) + xksedno3 ) ) / ( zundsat(ji,jk) + xksedfeo ) 311 zsolid1 = zvolc(ji,jk,jspoc) * solcp(ji,jk,jspoc) 312 zsolid2 = zvolc(ji,jk,jspos) * solcp(ji,jk,jspos) 313 zsolid3 = zvolc(ji,jk,jspor) * solcp(ji,jk,jspor) 314 zkpoca = zkpoc(ji,jk) * zlimfeo(ji,jk) 315 zkpocb = zkpos(ji,jk) * zlimfeo(ji,jk) 316 zkpocc = zkpor(ji,jk) * zlimfeo(ji,jk) 317 zrearat1(ji,jk) = ( zkpoc(ji,jk) * dtsed2 * zsolid1 ) / & 318 & ( 1. + zkpoca * zundsat(ji,jk) * dtsed2 ) 319 zrearat2(ji,jk) = ( zkpos(ji,jk) * dtsed2 * zsolid2 ) / & 320 & ( 1. + zkpocb * zundsat(ji,jk) * dtsed2 ) 321 zrearat3(ji,jk) = ( zkpor(ji,jk) * dtsed2 * zsolid3 ) / & 322 & ( 1. + zkpocc * zundsat(ji,jk) * dtsed2 ) 323 END DO 324 END DO 325 326 ! DO jn = 1, 5 327 DO jk = 2, jpksed 328 DO ji = 1, jpoce 329 jflag3: DO jn = 1, 10 330 zlimtmp = ( 1.0 - pwcp(ji,jk,jwoxy) * zlimo2(ji,jk) ) * ( 1.0 - pwcp(ji,jk,jwno3) & 331 & / ( pwcp(ji,jk,jwno3) + xksedno3 ) ) 332 zsolid1 = zvolc(ji,jk,jspoc) * solcp(ji,jk,jspoc) 333 zsolid2 = zvolc(ji,jk,jspos) * solcp(ji,jk,jspos) 334 zsolid3 = zvolc(ji,jk,jspor) * solcp(ji,jk,jspor) 335 zreasat = ( zrearat1(ji,jk) + zrearat2(ji,jk) + zrearat3(ji,jk) ) / zvolc(ji,jk,jsfeo) 336 zbeta = xksedfeo - solcp(ji,jk,jsfeo) + 4.0 * zreasat * zlimtmp 337 zgamma = -xksedfeo * solcp(ji,jk,jsfeo) 338 zundsat2 = zundsat(ji,jk) 339 zundsat(ji,jk) = ( - zbeta + SQRT( zbeta**2 - 4.0 * zgamma ) ) / 2.0 340 zlimfeo(ji,jk) = ( 1.0 - pwcp(ji,jk,jwoxy) * zlimo2(ji,jk) ) * ( 1.0 - pwcp(ji,jk,jwno3) & 341 & / ( pwcp(ji,jk,jwno3) + xksedno3 ) ) / ( zundsat(ji,jk) + xksedfeo ) 342 zkpoca = zkpoc(ji,jk) * zlimfeo(ji,jk) 343 zkpocb = zkpos(ji,jk) * zlimfeo(ji,jk) 344 zkpocc = zkpor(ji,jk) * zlimfeo(ji,jk) 345 zrearat1(ji,jk) = ( zkpoc(ji,jk) * dtsed2 * zsolid1 ) / & 346 & ( 1. + zkpoca * zundsat(ji,jk) * dtsed2 ) 347 zrearat2(ji,jk) = ( zkpos(ji,jk) * dtsed2 * zsolid2 ) / & 348 & ( 1. + zkpocb * zundsat(ji,jk) * dtsed2 ) 349 zrearat3(ji,jk) = ( zkpor(ji,jk) * dtsed2 * zsolid3 ) / & 350 & ( 1. + zkpocc * zundsat(ji,jk) * dtsed2 ) 351 IF ( ABS( (zundsat(ji,jk)-zundsat2)/( MAX(0.,zundsat2)+rtrn)) < 1E-8 ) THEN 352 EXIT jflag3 353 ENDIF 354 END DO jflag3 355 END DO 356 END DO 357 358 359 ! New solid concentration values (jk=2 to jksed) for each couple 360 DO jk = 2, jpksed 361 DO ji = 1, jpoce 362 zreasat = zrearat1(ji,jk) * zlimfeo(ji,jk) * zundsat(ji,jk) / zvolc(ji,jk,jspoc) 363 solcp(ji,jk,jspoc) = solcp(ji,jk,jspoc) - zreasat 364 zreasat = zrearat2(ji,jk) * zlimfeo(ji,jk) * zundsat(ji,jk) / zvolc(ji,jk,jspos) 365 solcp(ji,jk,jspos) = solcp(ji,jk,jspos) - zreasat 366 zreasat = zrearat3(ji,jk) * zlimfeo(ji,jk) * zundsat(ji,jk) / zvolc(ji,jk,jspor) 367 solcp(ji,jk,jspor) = solcp(ji,jk,jspor) - zreasat 368 END DO 369 END DO 413 370 414 371 ! New dissolved concentrations 415 DO jk = 1, jpksed 416 DO ji = 1, jpoce 417 zreasat = zrearat(ji,jk,1) * zundsat(ji,jk,1) 372 DO jk = 2, jpksed 373 DO ji = 1, jpoce 374 zreasat = ( zrearat1(ji,jk) + zrearat2(ji,jk) + zrearat3(ji,jk) ) * zlimfeo(ji,jk) * zundsat(ji,jk) 375 ! For FEOH 376 solcp(ji,jk,jsfeo) = zundsat(ji,jk) 418 377 ! For DIC 419 378 pwcp(ji,jk,jwdic) = pwcp(ji,jk,jwdic) + zreasat 379 zsumtot(ji) = zsumtot(ji) + zreasat / dtsed2 * volw3d(ji,jk) * 1.e-3 * 86400. * 365. * 1E3 380 ! For Phosphate (in mol/l) 381 pwcp(ji,jk,jwpo4) = pwcp(ji,jk,jwpo4) + zreasat * ( spo4r + 4.0 * redfep ) 382 ! Ligands 383 sedligand(ji,jk) = sedligand(ji,jk) + ratligc * zreasat 384 ! For iron (in mol/l) 385 pwcp(ji,jk,jwfe2) = pwcp(ji,jk,jwfe2) + fecratio(ji) * zreasat 420 386 ! For alkalinity 421 pwcp(ji,jk,jwalk) = pwcp(ji,jk,jwalk) + 2.* zreasat 422 ! For DIC13 423 pwcp(ji,jk,jwc13) = pwcp(ji,jk,jwc13) + zreasat * rc13Ca * pdb 424 ENDDO 425 ENDDO 426 427 DO jk = 1, jpksed 428 DO ji = 1, jpoce 429 zmc13_3(ji) = zmc13_3(ji) + pwcp(ji,jk,jwc13) * volw3d(ji,jk) * 1.e-3 430 ENDDO 431 ENDDO 432 433 DO ji = 1, jpoce 434 sour_c13(ji) = sour_c13(ji) + zmc13_3(ji) - zmc13_2(ji) 435 ENDDO 436 437 !------------------------------------------------- 438 ! Beginning DIC, Alkalinity and DIC13 diffusion 439 !------------------------------------------------- 440 441 nv = 3 442 DO jk = 1, jpksed 443 DO ji = 1, jpoce 444 zundsat(ji,jk,1) = pwcp(ji,jk,jwdic) 445 zundsat(ji,jk,2) = pwcp(ji,jk,jwalk) 446 zundsat(ji,jk,3) = pwcp(ji,jk,jwc13) 447 448 zrearat(ji,jk,1) = 0. 449 zrearat(ji,jk,2) = 0. 450 zrearat(ji,jk,3) = 0. 451 452 ENDDO 453 ENDDO 454 455 456 ! solves tridiagonal system 457 CALL sed_mat( nv, jpoce, jpksed, zrearat, zundsat ) 458 459 460 ! New dissolved concentrations 461 DO jk = 1, jpksed 462 DO ji = 1, jpoce 463 pwcp(ji,jk,jwdic) = zundsat(ji,jk,1) 464 pwcp(ji,jk,jwalk) = zundsat(ji,jk,2) 465 pwcp(ji,jk,jwc13) = zundsat(ji,jk,3) 466 ENDDO 467 ENDDO 468 469 !---------------------------------- 470 ! Back to initial geometry 471 !----------------------------- 472 473 !--------------------------------------------------------------------- 474 ! 1/ Compensation for ajustement of the bottom water concentrations 475 ! (see note n° 1 about *por(2)) 387 pwcp(ji,jk,jwalk) = pwcp(ji,jk,jwalk) + zreasat * ( srno3 * zadsnh4 - 2.* spo4r ) + 8.0 * zreasat 388 ! Ammonium 389 pwcp(ji,jk,jwnh4) = pwcp(ji,jk,jwnh4) + zreasat * srno3 * zadsnh4 390 pwcp(ji,jk,jwfe2) = pwcp(ji,jk,jwfe2) + zreasat * 4.0 391 ENDDO 392 ENDDO 393 476 394 !-------------------------------------------------------------------- 477 DO jw = 1, jpwat 478 DO ji = 1, jpoce 479 pwcp(ji,1,jw) = pwcp(ji,1,jw) + & 480 & pwcp(ji,2,jw) * dzdep(ji) * por(2) / dzkbot(ji) 481 END DO 482 ENDDO 483 484 !----------------------------------------------------------------------- 485 ! 2/ Det of new rainrg taking account of the new weight fraction obtained 486 ! in dz3d(2) after diffusion/reaction (react/diffu are also in dzdep!) 487 ! This new rain (rgntg rm) will be used in advection/burial routine 488 !------------------------------------------------------------------------ 489 DO js = 1, jpsol 490 DO ji = 1, jpoce 491 rainrg(ji,js) = raintg(ji) * solcp(ji,2,js) 492 rainrm(ji,js) = rainrg(ji,js) / mol_wgt(js) 493 END DO 494 ENDDO 495 496 ! New raintg 497 raintg(:) = 0. 498 DO js = 1, jpsol 499 DO ji = 1, jpoce 500 raintg(ji) = raintg(ji) + rainrg(ji,js) 501 END DO 502 ENDDO 503 504 !-------------------------------- 505 ! 3/ back to initial geometry 506 !-------------------------------- 395 ! Begining POC denitrification and NO3- diffusion 396 ! (indice n�5 for couple POC/NO3- ie solcp(:,:,jspoc)/pwcp(:,:,jwno3)) 397 !-------------------------------------------------------------------- 398 399 zrearat1(:,:) = 0. 400 zrearat2(:,:) = 0. 401 zrearat3(:,:) = 0. 402 403 zundsat(:,:) = pwcp(:,:,jwso4) 404 405 DO jk = 2, jpksed 406 DO ji = 1, jpoce 407 zlimso4(ji,jk) = ( 1.0 - pwcp(ji,jk,jwoxy) * zlimo2(ji,jk) ) * ( 1.0 - pwcp(ji,jk,jwno3) & 408 & / ( pwcp(ji,jk,jwno3) + xksedno3 ) ) * ( 1. - solcp(ji,jk,jsfeo) & 409 & / ( solcp(ji,jk,jsfeo) + xksedfeo ) ) / ( zundsat(ji,jk) + xksedso4 ) 410 zsolid1 = zvolc(ji,jk,jspoc) * solcp(ji,jk,jspoc) 411 zsolid2 = zvolc(ji,jk,jspos) * solcp(ji,jk,jspos) 412 zsolid3 = zvolc(ji,jk,jspor) * solcp(ji,jk,jspor) 413 zkpoca = zkpoc(ji,jk) * zlimso4(ji,jk) 414 zkpocb = zkpos(ji,jk) * zlimso4(ji,jk) 415 zkpocc = zkpor(ji,jk) * zlimso4(ji,jk) 416 zrearat1(ji,jk) = ( zkpoc(ji,jk) * dtsed2 * zsolid1 ) / & 417 & ( 1. + zkpoca * zundsat(ji,jk ) * dtsed2 ) 418 zrearat2(ji,jk) = ( zkpos(ji,jk) * dtsed2 * zsolid2 ) / & 419 & ( 1. + zkpocb * zundsat(ji,jk ) * dtsed2 ) 420 zrearat3(ji,jk) = ( zkpor(ji,jk) * dtsed2 * zsolid3 ) / & 421 & ( 1. + zkpocc * zundsat(ji,jk ) * dtsed2 ) 422 END DO 423 END DO 424 ! 425 ! DO jn = 1, 5 426 DO jk = 2, jpksed 427 DO ji = 1, jpoce 428 jflag4: DO jn = 1, 10 429 zlimtmp = ( 1.0 - pwcp(ji,jk,jwoxy) * zlimo2(ji,jk) ) * ( 1.0 - pwcp(ji,jk,jwno3) & 430 & / ( pwcp(ji,jk,jwno3) + xksedno3 ) ) * ( 1. - solcp(ji,jk,jsfeo) & 431 & / ( solcp(ji,jk,jsfeo) + xksedfeo ) ) 432 zsolid1 = zvolc(ji,jk,jspoc) * solcp(ji,jk,jspoc) 433 zsolid2 = zvolc(ji,jk,jspos) * solcp(ji,jk,jspos) 434 zsolid3 = zvolc(ji,jk,jspor) * solcp(ji,jk,jspor) 435 zreasat = ( zrearat1(ji,jk) + zrearat2(ji,jk) + zrearat3(ji,jk) ) 436 zbeta = xksedso4 - pwcp(ji,jk,jwso4) + 0.5 * zreasat * zlimtmp 437 zgamma = - xksedso4 * pwcp(ji,jk,jwso4) 438 zundsat2 = zundsat(ji,jk) 439 zundsat(ji,jk) = ( - zbeta + SQRT( zbeta**2 - 4.0 * zgamma ) ) / 2.0 440 zlimso4(ji,jk) = ( 1.0 - pwcp(ji,jk,jwoxy) * zlimo2(ji,jk) ) * ( 1.0 - pwcp(ji,jk,jwno3) & 441 & / ( pwcp(ji,jk,jwno3) + xksedno3 ) ) * ( 1. - solcp(ji,jk,jsfeo) & 442 & / ( solcp(ji,jk,jsfeo) + xksedfeo ) ) / ( zundsat(ji,jk) + xksedso4 ) 443 zkpoca = zkpoc(ji,jk) * zlimso4(ji,jk) 444 zkpocb = zkpos(ji,jk) * zlimso4(ji,jk) 445 zkpocc = zkpor(ji,jk) * zlimso4(ji,jk) 446 zrearat1(ji,jk) = ( zkpoc(ji,jk) * dtsed2 * zsolid1 ) / & 447 & ( 1. + zkpoca * zundsat(ji,jk ) * dtsed2 ) 448 zrearat2(ji,jk) = ( zkpos(ji,jk) * dtsed2 * zsolid2 ) / & 449 & ( 1. + zkpocb * zundsat(ji,jk ) * dtsed2 ) 450 zrearat3(ji,jk) = ( zkpor(ji,jk) * dtsed2 * zsolid3 ) / & 451 & ( 1. + zkpocc * zundsat(ji,jk ) * dtsed2 ) 452 IF ( ABS( (zundsat(ji,jk)-zundsat2)/(zundsat2+rtrn)) < 1E-8 ) THEN 453 EXIT jflag4 454 ENDIF 455 END DO jflag4 456 END DO 457 END DO 458 459 ! New solid concentration values (jk=2 to jksed) for each couple 460 DO jk = 2, jpksed 461 DO ji = 1, jpoce 462 zreasat = zrearat1(ji,jk) * zlimso4(ji,jk) * zundsat(ji,jk) / zvolc(ji,jk,jspoc) 463 solcp(ji,jk,jspoc) = solcp(ji,jk,jspoc) - zreasat 464 zreasat = zrearat2(ji,jk) * zlimso4(ji,jk) * zundsat(ji,jk) / zvolc(ji,jk,jspos) 465 solcp(ji,jk,jspos) = solcp(ji,jk,jspos) - zreasat 466 zreasat = zrearat3(ji,jk) * zlimso4(ji,jk) * zundsat(ji,jk) / zvolc(ji,jk,jspor) 467 solcp(ji,jk,jspor) = solcp(ji,jk,jspor) - zreasat 468 ENDDO 469 ENDDO 470 ! 471 ! New dissolved concentrations 472 DO jk = 2, jpksed 473 DO ji = 1, jpoce 474 ! For sulfur 475 pwcp(ji,jk,jwh2s) = pwcp(ji,jk,jwh2s) - ( zundsat(ji,jk) - pwcp(ji,jk,jwso4) ) 476 pwcp(ji,jk,jwso4) = zundsat(ji,jk) 477 zreasat = ( zrearat1(ji,jk) + zrearat2(ji,jk) + zrearat3(ji,jk) ) * zlimso4(ji,jk) * zundsat(ji,jk) 478 ! For DIC 479 pwcp(ji,jk,jwdic) = pwcp(ji,jk,jwdic) + zreasat 480 zsumtot(ji) = zsumtot(ji) + zreasat / dtsed2 * volw3d(ji,jk) * 1.e-3 * 86400. * 365. * 1E3 481 ! For Phosphate (in mol/l) 482 pwcp(ji,jk,jwpo4) = pwcp(ji,jk,jwpo4) + zreasat * spo4r 483 ! Ligands 484 sedligand(ji,jk) = sedligand(ji,jk) + ratligc * zreasat 485 ! For iron (in mol/l) 486 pwcp(ji,jk,jwfe2) = pwcp(ji,jk,jwfe2) + fecratio(ji) * zreasat 487 ! For alkalinity 488 pwcp(ji,jk,jwalk) = pwcp(ji,jk,jwalk) + zreasat * ( srno3 * zadsnh4 - 2.* spo4r ) + zreasat 489 ! Ammonium 490 pwcp(ji,jk,jwnh4) = pwcp(ji,jk,jwnh4) + zreasat * srno3 * zadsnh4 491 ENDDO 492 ENDDO 493 494 ! Oxydation of the reduced products. Here only ammonium and ODU is accounted for 495 ! There are two options here: A simple time splitting scheme and a modified 496 ! Patankar scheme 497 ! ------------------------------------------------------------------------------ 498 499 call sed_dsr_redoxb 500 501 ! -------------------------------------------------------------- 502 ! 4/ Computation of the bioturbation coefficient 503 ! This parameterization is taken from Archer et al. (2002) 504 ! -------------------------------------------------------------- 505 507 506 DO ji = 1, jpoce 508 dz3d (ji,2) = dz(2) 509 volw3d(ji,2) = dz3d(ji,2) * por(2) 510 vols3d(ji,2) = dz3d(ji,2) * por1(2) 511 ENDDO 512 513 !---------------------------------------------------------------------- 514 ! 4/ Saving new amount of material in dzkbot for mass balance check 515 ! tokbot in [mol] (implicit *1cm*1cm for spacial dim) 516 !---------------------------------------------------------------------- 517 DO jw = 1, jpwat 518 DO ji = 1, jpoce 519 tokbot(ji,jw) = pwcp(ji,1,jw) * 1.e-3 * dzkbot(ji) 520 END DO 521 ENDDO 522 523 DEALLOCATE( zmo2_0 ) ; DEALLOCATE( zmno3_1 ) ; DEALLOCATE( zmno3_2 ) 524 DEALLOCATE( zmc13_0 ) ; DEALLOCATE( zmc13_1 ) ; DEALLOCATE( zmc13_2 ) ; DEALLOCATE( zmc13_3 ) 525 526 DEALLOCATE( zrearat ) ; DEALLOCATE( zundsat ) ; DEALLOCATE( zvolc ) 527 507 db(ji,:) = dbiot * zsumtot(ji) * pwcp(ji,1,jwoxy) / (pwcp(ji,1,jwoxy) + 20.E-6) 508 END DO 509 510 ! ------------------------------------------------------ 511 ! Vertical variations of the bioturbation coefficient 512 ! ------------------------------------------------------ 513 IF (ln_btbz) THEN 514 DO ji = 1, jpoce 515 db(ji,:) = db(ji,:) * exp( -(profsedw(:) / dbtbzsc)**2 ) / (365.0 * 86400.0) 516 END DO 517 ELSE 518 DO jk = 1, jpksed 519 IF (profsedw(jk) > dbtbzsc) THEN 520 db(:,jk) = 0.0 521 ENDIF 522 END DO 523 ENDIF 524 525 IF (ln_irrig) THEN 526 DO jk = 1, jpksed 527 DO ji = 1, jpoce 528 irrig(ji,jk) = ( 7.63752 - 7.4465 * exp( -0.89603 * zsumtot(ji) ) ) * pwcp(ji,1,jwoxy) & 529 & / (pwcp(ji,1,jwoxy) + 20.E-6) 530 irrig(ji,jk) = irrig(ji,jk) * exp( -(profsedw(jk) / xirrzsc) ) 531 END DO 532 END DO 533 ELSE 534 irrig(:,:) = 0.0 535 ENDIF 536 537 DEALLOCATE( zvolc ) 538 539 IF( ln_timing ) CALL timing_stop('sed_dsr') 540 ! 528 541 END SUBROUTINE sed_dsr 529 #else 530 !!====================================================================== 531 !! MODULE seddsr : Dummy module 532 !!====================================================================== 533 !! $Id$ 534 CONTAINS 535 SUBROUTINE sed_dsr ( kt ) 536 INTEGER, INTENT(in) :: kt 537 WRITE(*,*) 'sed_dsr: You should not have seen this print! error?', kt 538 END SUBROUTINE sed_dsr 539 #endif 540 542 543 SUBROUTINE sed_dsr_redoxb 544 !!---------------------------------------------------------------------- 545 !! *** ROUTINE sed_dsr_redox *** 546 !! 547 !! ** Purpose : computes secondary redox reactions 548 !! 549 !! ** Methode : It uses Strand splitter algorithm proposed by 550 !! Nguyen et al. (2009) and modified by Wang et al. (2018) 551 !! Basically, each equation is solved analytically when 552 !! feasible, otherwise numerically at t+1/2. Then 553 !! the last equation is solved at t+1. The other equations 554 !! are then solved at t+1 starting in the reverse order. 555 !! Ideally, it's better to start from the fastest reaction 556 !! to the slowest and then reverse the order to finish up 557 !! with the fastest one. But random order works well also. 558 !! The scheme is second order, positive and mass 559 !! conserving. It works well for stiff systems. 560 !! 561 !! History : 562 !! ! 18-08 (O. Aumont) Original code 563 !!---------------------------------------------------------------------- 564 !! Arguments 565 ! --- local variables 566 INTEGER :: ji, jk, jn ! dummy looop indices 567 568 REAL, DIMENSION(6) :: zsedtrn, zsedtra 569 REAL(wp) :: zalpha, zbeta, zgamma, zdelta, zepsi, zsedfer 570 !! 571 !!---------------------------------------------------------------------- 572 573 IF( ln_timing ) CALL timing_start('sed_dsr_redoxb') 574 575 DO ji = 1, jpoce 576 DO jk = 2, jpksed 577 zsedtrn(1) = pwcp(ji,jk,jwoxy) 578 zsedtrn(2) = MAX(0., pwcp(ji,jk,jwh2s) ) 579 zsedtrn(3) = pwcp(ji,jk,jwnh4) 580 zsedtrn(4) = MAX(0., pwcp(ji,jk,jwfe2) - sedligand(ji,jk) ) 581 zsedfer = MIN(0., pwcp(ji,jk,jwfe2) - sedligand(ji,jk) ) 582 zsedtrn(5) = solcp(ji,jk,jsfeo) * zvolc(ji,jk,jsfeo) 583 zsedtrn(6) = solcp(ji,jk,jsfes) * zvolc(ji,jk,jsfes) 584 zsedtra(:) = zsedtrn(:) 585 586 ! First pass of the scheme. At the end, it is 1st order 587 ! ----------------------------------------------------- 588 ! Fe + O2 589 zalpha = zsedtra(1) - 0.25 * zsedtra(4) 590 zbeta = zsedtra(4) + zsedtra(5) 591 zgamma = pwcp(ji,jk,jwalk) - 2.0 * zsedtra(4) 592 zdelta = pwcp(ji,jk,jwpo4) - redfep * zsedtra(4) 593 zsedtra(4) = ( zsedtra(4) * zalpha ) / ( 0.25 * zsedtra(4) * ( exp( reac_fe2 * zalpha * dtsed2 / 2. ) - 1.0 ) & 594 & + zalpha * exp( reac_fe2 * zalpha * dtsed2 / 2. ) + rtrn ) 595 zsedtra(1) = zalpha + 0.25 * zsedtra(4) 596 zsedtra(5) = zbeta - zsedtra(4) 597 pwcp(ji,jk,jwalk) = zgamma + 2.0 * zsedtra(4) 598 pwcp(ji,jk,jwpo4) = zdelta + redfep * zsedtra(4) 599 ! H2S + O2 600 zalpha = zsedtra(1) - 2.0 * zsedtra(2) 601 zbeta = pwcp(ji,jk,jwso4) + zsedtra(2) 602 zgamma = pwcp(ji,jk,jwalk) - 2.0 * zsedtra(2) 603 zsedtra(2) = ( zsedtra(2) * zalpha ) / ( 2.0 * zsedtra(2) * ( exp( reac_h2s * zalpha * dtsed2 / 2. ) - 1.0 ) & 604 & + zalpha * exp( reac_h2s * zalpha * dtsed2 / 2. ) + rtrn ) 605 zsedtra(1) = zalpha + 2.0 * zsedtra(2) 606 pwcp(ji,jk,jwalk) = zgamma + 2.0 * zsedtra(2) 607 pwcp(ji,jk,jwso4) = zbeta - zsedtra(2) 608 ! NH4 + O2 609 zalpha = zsedtra(1) - 2.0 * zsedtra(3) 610 zgamma = pwcp(ji,jk,jwalk) - 2.0 * zsedtra(3) 611 zsedtra(3) = ( zsedtra(3) * zalpha ) / ( 2.0 * zsedtra(3) * ( exp( reac_nh4 * zadsnh4 * zalpha * dtsed2 / 2. ) - 1.0 ) & 612 & + zalpha * exp( reac_nh4 * zadsnh4 * zalpha * dtsed2 /2. ) + rtrn ) 613 zsedtra(1) = zalpha + 2.0 * zsedtra(3) 614 pwcp(ji,jk,jwalk) = zgamma + 2.0 * zsedtra(3) 615 ! FeS - O2 616 zalpha = zsedtra(1) - 2.0 * zsedtra(6) 617 zbeta = zsedtra(4) + zsedtra(6) 618 zgamma = pwcp(ji,jk,jwso4) + zsedtra(6) 619 zsedtra(6) = ( zsedtra(6) * zalpha ) / ( 2.0 * zsedtra(6) * ( exp( reac_feso * zalpha * dtsed2 / 2. ) - 1.0 ) & 620 & + zalpha * exp( reac_feso * zalpha * dtsed2 /2. ) + rtrn ) 621 zsedtra(1) = zalpha + 2.0 * zsedtra(6) 622 zsedtra(4) = zbeta - zsedtra(6) 623 pwcp(ji,jk,jwso4) = zgamma - zsedtra(6) 624 ! ! Fe - H2S 625 zalpha = zsedtra(2) - zsedtra(4) 626 zbeta = zsedtra(4) + zsedtra(6) 627 zgamma = pwcp(ji,jk,jwalk) - 2.0 * zsedtra(4) 628 zsedtra(4) = ( zsedtra(4) * zalpha ) / ( zsedtra(4) * ( exp( reac_fes * zalpha * dtsed2 / 2. ) - 1.0 ) & 629 & + zalpha * exp( reac_fes * zalpha * dtsed2 /2. ) + rtrn ) 630 zsedtra(2) = zalpha + zsedtra(4) 631 zsedtra(6) = zbeta - zsedtra(4) 632 pwcp(ji,jk,jwalk) = zgamma + 2.0 * zsedtra(4) 633 ! FEOH + H2S 634 zalpha = zsedtra(5) - 2.0 * zsedtra(2) 635 zbeta = zsedtra(5) + zsedtra(4) 636 zgamma = pwcp(ji,jk,jwalk) - 2.0 * zsedtra(4) 637 zdelta = pwcp(ji,jk,jwso4) + zsedtra(2) 638 zepsi = pwcp(ji,jk,jwpo4) + redfep * zsedtra(5) 639 zsedtra(2) = ( zsedtra(2) * zalpha ) / ( 2.0 * zsedtra(2) * ( exp( reac_feh2s * zalpha * dtsed2 ) - 1.0 ) & 640 & + zalpha * exp( reac_feh2s * zalpha * dtsed2 ) + rtrn ) 641 zsedtra(5) = zalpha + 2.0 * zsedtra(2) 642 zsedtra(4) = zbeta - zsedtra(5) 643 pwcp(ji,jk,jwso4) = zdelta - zsedtra(2) 644 pwcp(ji,jk,jwalk) = zgamma + 2.0 * zsedtra(4) 645 pwcp(ji,jk,jwpo4) = zepsi - redfep * zsedtra(5) 646 ! Fe - H2S 647 zalpha = zsedtra(2) - zsedtra(4) 648 zbeta = zsedtra(4) + zsedtra(6) 649 zgamma = pwcp(ji,jk,jwalk) - 2.0 * zsedtra(4) 650 zsedtra(4) = ( zsedtra(4) * zalpha ) / ( zsedtra(4) * ( exp( reac_fes * zalpha * dtsed2 / 2. ) - 1.0 ) & 651 & + zalpha * exp( reac_fes * zalpha * dtsed2 /2. ) + rtrn ) 652 zsedtra(2) = zalpha + zsedtra(4) 653 zsedtra(6) = zbeta - zsedtra(4) 654 pwcp(ji,jk,jwalk) = zgamma + 2.0 * zsedtra(4) 655 ! FeS - O2 656 zalpha = zsedtra(1) - 2.0 * zsedtra(6) 657 zbeta = zsedtra(4) + zsedtra(6) 658 zgamma = pwcp(ji,jk,jwso4) + zsedtra(6) 659 zsedtra(6) = ( zsedtra(6) * zalpha ) / ( 2.0 * zsedtra(6) * ( exp( reac_feso * zalpha * dtsed2 / 2. ) - 1.0 ) & 660 & + zalpha * exp( reac_feso * zalpha * dtsed2 /2. ) + rtrn ) 661 zsedtra(1) = zalpha + 2.0 * zsedtra(6) 662 zsedtra(4) = zbeta - zsedtra(6) 663 pwcp(ji,jk,jwso4) = zgamma - zsedtra(6) 664 ! NH4 + O2 665 zalpha = zsedtra(1) - 2.0 * zsedtra(3) 666 zgamma = pwcp(ji,jk,jwalk) - 2.0 * zsedtra(3) 667 zsedtra(3) = ( zsedtra(3) * zalpha ) / ( 2.0 * zsedtra(3) * ( exp( reac_nh4 * zadsnh4 * zalpha * dtsed2 / 2. ) - 1.0 ) & 668 & + zalpha * exp( reac_nh4 * zadsnh4 * zalpha * dtsed2 /2. ) + rtrn ) 669 zsedtra(1) = zalpha + 2.0 * zsedtra(3) 670 pwcp(ji,jk,jwalk) = zgamma + 2.0 * zsedtra(3) 671 ! H2S + O2 672 zalpha = zsedtra(1) - 2.0 * zsedtra(2) 673 zbeta = pwcp(ji,jk,jwso4) + zsedtra(2) 674 zgamma = pwcp(ji,jk,jwalk) - 2.0 * zsedtra(2) 675 zsedtra(2) = ( zsedtra(2) * zalpha ) / ( 2.0 * zsedtra(2) * ( exp( reac_h2s * zalpha * dtsed2 / 2. ) - 1.0 ) & 676 & + zalpha * exp( reac_h2s * zalpha * dtsed2 / 2. ) + rtrn ) 677 zsedtra(1) = zalpha + 2.0 * zsedtra(2) 678 pwcp(ji,jk,jwso4) = zbeta - zsedtra(2) 679 pwcp(ji,jk,jwalk) = zgamma + 2.0 * zsedtra(2) 680 ! Fe + O2 681 zalpha = zsedtra(1) - 0.25 * zsedtra(4) 682 zbeta = zsedtra(4) + zsedtra(5) 683 zgamma = pwcp(ji,jk,jwalk) - 2.0 * zsedtra(4) 684 zdelta = pwcp(ji,jk,jwpo4) - redfep * zsedtra(4) 685 zsedtra(4) = ( zsedtra(4) * zalpha ) / ( 0.25 * zsedtra(4) * ( exp( reac_fe2 * zalpha * dtsed2 / 2. ) - 1.0 ) & 686 & + zalpha * exp( reac_fe2 * zalpha * dtsed2 / 2. ) + rtrn ) 687 zsedtra(1) = zalpha + 0.25 * zsedtra(4) 688 zsedtra(5) = zbeta - zsedtra(4) 689 pwcp(ji,jk,jwpo4) = zdelta + redfep * zsedtra(4) 690 pwcp(ji,jk,jwalk) = zgamma + 2.0 * zsedtra(4) 691 pwcp(ji,jk,jwoxy) = zsedtra(1) 692 pwcp(ji,jk,jwh2s) = zsedtra(2) 693 pwcp(ji,jk,jwnh4) = zsedtra(3) 694 pwcp(ji,jk,jwfe2) = zsedtra(4) + sedligand(ji,jk) + zsedfer 695 pwcp(ji,jk,jwno3) = pwcp(ji,jk,jwno3) + ( zsedtrn(3) - pwcp(ji,jk,jwnh4) ) 696 solcp(ji,jk,jsfeo) = zsedtra(5) / zvolc(ji,jk,jsfeo) 697 solcp(ji,jk,jsfes) = zsedtra(6) / zvolc(ji,jk,jsfes) 698 END DO 699 END DO 700 701 IF( ln_timing ) CALL timing_stop('sed_dsr_redoxb') 702 703 END SUBROUTINE sed_dsr_redoxb 704 541 705 END MODULE seddsr -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/TOP/PISCES/SED/seddta.F90
r7646 r10345 4 4 !! Sediment data : read sediment input data from a file 5 5 !!===================================================================== 6 #if defined key_sed 6 7 7 !! * Modules used 8 8 USE sed 9 9 USE sedarr 10 USE phycst, ONLY : rday 10 11 USE iom 12 USE lib_mpp ! distribued memory computing library 11 13 12 14 IMPLICIT NONE … … 17 19 18 20 !! * Module variables 19 REAL(wp), DIMENSION(:), ALLOCATABLE :: smask ! mask for sediments points20 21 REAL(wp) :: rsecday ! number of second per a day 21 REAL(wp) :: conv1 ! [m/day]--->[cm/s]22 22 REAL(wp) :: conv2 ! [kg/m2/month]-->[g/cm2/s] ( 1 month has 30 days ) 23 24 INTEGER :: numbio25 26 #if defined key_sed_off27 INTEGER :: numoce28 #endif29 23 30 24 !! $Id$ … … 54 48 INTEGER :: ji, jj, js, jw, ikt 55 49 56 REAL(wp), DIMENSION( :,:), ALLOCATABLE :: zdta57 REAL(wp), DIMENSION( :) , ALLOCATABLE :: zdtap, zdtag58 50 REAL(wp), DIMENSION(jpoce) :: zdtap, zdtag 51 REAL(wp), DIMENSION(jpi,jpj) :: zwsbio4, zwsbio3, zwscal 52 REAL(wp) :: zf0, zf1, zf2, zkapp, zratio, zdep 59 53 60 54 !---------------------------------------------------------------------- … … 64 58 !------------------------------------------------------------- 65 59 66 WRITE(numsed,*) 67 WRITE(numsed,*) ' sed_dta : Bottom layer fields' 68 WRITE(numsed,*) ' ~~~~~~' 69 WRITE(numsed,*) ' Data from SMS model' 70 WRITE(numsed,*) 60 IF( ln_timing ) CALL timing_start('sed_dta') 61 62 IF (lwp) THEN 63 WRITE(numsed,*) 64 WRITE(numsed,*) ' sed_dta : Bottom layer fields' 65 WRITE(numsed,*) ' ~~~~~~' 66 WRITE(numsed,*) ' Data from SMS model' 67 WRITE(numsed,*) 68 ENDIF 71 69 72 70 73 71 ! open file 74 72 IF( kt == nitsed000 ) THEN 75 WRITE(numsed,*) ' sed_dta : Sediment fields' 76 CALL iom_open ( 'data_bio_bot' , numbio ) 77 #if defined key_sed_off 78 CALL iom_open( 'data_oce_bot', numoce) 79 #endif 73 IF (lwp) WRITE(numsed,*) ' sed_dta : Sediment fields' 74 dtsed = r2dttrc 80 75 rsecday = 60.* 60. * 24. 81 conv1 = 1.0e+2 / rsecday 82 conv2 = 1.0e+3 / ( 1.0e+4 * rsecday * 30. ) 83 84 ! Compute sediment mask 85 ALLOCATE( zdta(jpi,jpj) ) 76 ! conv2 = 1.0e+3 / ( 1.0e+4 * rsecday * 30. ) 77 conv2 = 1.0e+3 / 1.0e+4 78 rdtsed(2:jpksed) = dtsed / ( denssol * por1(2:jpksed) ) 79 ENDIF 80 81 ! Initialization of temporaries arrays 82 zdtap(:) = 0. 83 zdtag(:) = 0. 84 85 ! reading variables 86 IF (lwp) WRITE(numsed,*) 87 IF (lwp) WRITE(numsed,*) ' sed_dta : Bottom layer fields at time kt = ', kt 88 ! reading variables 89 ! 90 ! Sinking speeds of detritus is increased with depth as shown 91 ! by data and from the coagulation theory 92 ! ----------------------------------------------------------- 93 IF (ln_sediment_offline) THEN 86 94 DO jj = 1, jpj 87 95 DO ji = 1, jpi 88 ikt = MAX( INT( sbathy(ji,jj) ) - 1, 1 ) 89 zdta(ji,jj) = tmask(ji,jj,ikt) 90 ENDDO 91 ENDDO 92 ALLOCATE( smask(jpoce) ) 93 smask(:) = 0. 94 CALL pack_arr( jpoce, smask(1:jpoce), zdta(1:jpi,1:jpj), iarroce(1:jpoce) ) 95 ENDIF 96 97 ! Initialization of temporaries arrays 98 ALLOCATE( zdtap(jpoce) ) ; zdtap(:) = 0. 99 ALLOCATE( zdtag(jpoce) ) ; zdtag(:) = 0. 100 101 IF( MOD( kt - 1, nfreq ) == 0 ) THEN 102 ! reading variables 103 WRITE(numsed,*) 104 WRITE(numsed,*) ' sed_dta : Bottom layer fields at time kt = ', kt 105 ! reading variables 106 trc_data(:,:,:) = 0. 107 #if ! defined key_sed_off 108 DO jj = 1,jpj 96 ikt = mbkt(ji,jj) 97 zwsbio4(ji,jj) = wsbio2 / rday 98 zwsbio3(ji,jj) = wsbio / rday 99 zwscal (ji,jj) = wsbio2 / rday 100 END DO 101 END DO 102 ELSE 103 DO jj = 1, jpj 109 104 DO ji = 1, jpi 110 105 ikt = mbkt(ji,jj) 111 IF ( tmask(ji,jj,ikt) == 1 ) THEN 112 trc_data(ji,jj,1) = trn (ji,jj,ikt,jptal) 113 trc_data(ji,jj,2) = trn (ji,jj,ikt,jpdic) 114 trc_data(ji,jj,3) = trn (ji,jj,ikt,jpno3) / 7.6 115 trc_data(ji,jj,4) = trn (ji,jj,ikt,jppo4) / 122. 116 trc_data(ji,jj,5) = trn (ji,jj,ikt,jpoxy) 117 trc_data(ji,jj,6) = trn (ji,jj,ikt,jpsil) 118 trc_data(ji,jj,7 ) = sinksil (ji,jj,ikt) 119 trc_data(ji,jj,8 ) = sinking (ji,jj,ikt) 120 trc_data(ji,jj,9 ) = sinking2(ji,jj,ikt) 121 trc_data(ji,jj,10) = sinkcal (ji,jj,ikt) 122 trc_data(ji,jj,11) = tsn (ji,jj,ikt,jp_tem) 123 trc_data(ji,jj,12) = tsn (ji,jj,ikt,jp_sal) 124 ENDIF 125 ENDDO 106 zdep = e3t_n(ji,jj,ikt) / r2dttrc 107 zwsbio4(ji,jj) = MIN( 0.99 * zdep, wsbio4(ji,jj,ikt) / rday ) 108 zwscal (ji,jj) = MIN( 0.99 * zdep, wscal (ji,jj,ikt) / rday ) 109 zwsbio3(ji,jj) = MIN( 0.99 * zdep, wsbio3(ji,jj,ikt) / rday ) 110 END DO 111 END DO 112 ENDIF 113 114 trc_data(:,:,:) = 0. 115 DO jj = 1,jpj 116 DO ji = 1, jpi 117 ikt = mbkt(ji,jj) 118 IF ( tmask(ji,jj,ikt) == 1 ) THEN 119 trc_data(ji,jj,1) = trb(ji,jj,ikt,jpsil) 120 trc_data(ji,jj,2) = trb(ji,jj,ikt,jpoxy) 121 trc_data(ji,jj,3) = trb(ji,jj,ikt,jpdic) 122 trc_data(ji,jj,4) = trb(ji,jj,ikt,jpno3) / 7.625 123 trc_data(ji,jj,5) = trb(ji,jj,ikt,jppo4) / 122. 124 trc_data(ji,jj,6) = trb(ji,jj,ikt,jptal) 125 trc_data(ji,jj,7) = trb(ji,jj,ikt,jpnh4) / 7.625 126 trc_data(ji,jj,8) = 0.0 127 trc_data(ji,jj,9) = 28.0E-3 128 trc_data(ji,jj,10) = trb(ji,jj,ikt,jpfer) 129 trc_data(ji,jj,11 ) = MIN(trb(ji,jj,ikt,jpgsi), 1E-4) * zwsbio4(ji,jj) * 1E3 130 trc_data(ji,jj,12 ) = MIN(trb(ji,jj,ikt,jppoc), 1E-4) * zwsbio3(ji,jj) * 1E3 131 trc_data(ji,jj,13 ) = MIN(trb(ji,jj,ikt,jpgoc), 1E-4) * zwsbio4(ji,jj) * 1E3 132 trc_data(ji,jj,14) = MIN(trb(ji,jj,ikt,jpcal), 1E-4) * zwscal (ji,jj) * 1E3 133 trc_data(ji,jj,15) = tsn(ji,jj,ikt,jp_tem) 134 trc_data(ji,jj,16) = tsn(ji,jj,ikt,jp_sal) 135 trc_data(ji,jj,17 ) = ( trb(ji,jj,ikt,jpsfe) * zwsbio3(ji,jj) + trb(ji,jj,ikt,jpbfe) & 136 & * zwsbio4(ji,jj) ) * 1E3 / ( trc_data(ji,jj,12 ) + trc_data(ji,jj,13 ) + rtrn ) 137 trc_data(ji,jj,17 ) = MIN(1E-3, trc_data(ji,jj,17 ) ) 138 ENDIF 126 139 ENDDO 127 128 #else 129 CALL iom_get( numbio, jpdom_data, 'ALKBOT' , trc_data(:,:,1 ) ) 130 CALL iom_get( numbio, jpdom_data, 'DICBOT' , trc_data(:,:,2 ) ) 131 CALL iom_get( numbio, jpdom_data, 'NO3BOT' , trc_data(:,:,3 ) ) 132 CALL iom_get( numbio, jpdom_data, 'PO4BOT' , trc_data(:,:,4 ) ) 133 CALL iom_get( numbio, jpdom_data, 'O2BOT' , trc_data(:,:,5 ) ) 134 CALL iom_get( numbio, jpdom_data, 'SIBOT' , trc_data(:,:,6 ) ) 135 CALL iom_get( numbio, jpdom_data, 'OPALFLXBOT' , trc_data(:,:,7 ) ) 136 CALL iom_get( numbio, jpdom_data, 'POCFLXBOT' , trc_data(:,:,8 ) ) 137 CALL iom_get( numbio, jpdom_data, 'GOCFLXBOT' , trc_data(:,:,9 ) ) 138 CALL iom_get( numbio, jpdom_data, 'CACO3FLXBOT', trc_data(:,:,10) ) 139 CALL iom_get( numoce, jpdom_data, 'TBOT' , trc_data(:,:,11) ) 140 CALL iom_get( numoce, jpdom_data, 'SBOT' , trc_data(:,:,12) ) 141 #endif 142 143 ! Pore water initial concentration [mol/l] in k=1 144 !------------------------------------------------- 145 146 ! Alkalinity ( 1 umol = 10-6equivalent ) 147 CALL pack_arr ( jpoce, pwcp_dta(1:jpoce,jwalk), trc_data(1:jpi,1:jpj,1), iarroce(1:jpoce) ) 148 ! DIC 149 CALL pack_arr ( jpoce, pwcp_dta(1:jpoce,jwdic), trc_data(1:jpi,1:jpj,2), iarroce(1:jpoce) ) 150 ! Nitrates (1 umol/l = 10-6 mol/l) 151 CALL pack_arr ( jpoce, pwcp_dta(1:jpoce,jwno3), trc_data(1:jpi,1:jpj,3), iarroce(1:jpoce) ) 152 ! Phosphates (1 umol/l = 10-6 mol/l) 153 CALL pack_arr ( jpoce, pwcp_dta(1:jpoce,jwpo4), trc_data(1:jpi,1:jpj,4), iarroce(1:jpoce) ) 154 ! Oxygen (1 umol/l = 10-6 mol/l) 155 CALL pack_arr ( jpoce, pwcp_dta(1:jpoce,jwoxy), trc_data(1:jpi,1:jpj,5), iarroce(1:jpoce) ) 156 ! Silicic Acid [mol.l-1] 157 CALL pack_arr ( jpoce, pwcp_dta(1:jpoce,jwsil), trc_data(1:jpi,1:jpj,6), iarroce(1:jpoce) ) 158 ! DIC13 (mol/l)obtained from dc13 and DIC (12) and PDB 159 CALL iom_get ( numbio,jpdom_data,'DC13',zdta(:,:) ) 160 CALL pack_arr ( jpoce, pwcp_dta(1:jpoce,jwc13), zdta(1:jpi,1:jpj), iarroce(1:jpoce) ) 161 pwcp_dta(1:jpoce,jwc13) = pdb * ( pwcp_dta(1:jpoce,jwc13) * 1.0e-3 + 1.0 ) & 162 & * pwcp_dta(1:jpoce,jwdic) 163 164 ! Solid components : 165 !----------------------- 166 ! Sinking fluxes for OPAL in mol.m-2.s-1 ; conversion in mol.cm-2.s-1 167 CALL pack_arr ( jpoce, rainrm_dta(1:jpoce,jsopal), trc_data(1:jpi,1:jpj,7), iarroce(1:jpoce) ) 168 rainrm_dta(1:jpoce,jsopal) = rainrm_dta(1:jpoce,jsopal) * 1e-4 169 ! Sinking fluxes for POC in mol.m-2.s-1 ; conversion in mol.cm-2.s-1 170 CALL pack_arr ( jpoce, zdtap(1:jpoce), trc_data(1:jpi,1:jpj,8) , iarroce(1:jpoce) ) 171 CALL pack_arr ( jpoce, zdtag(1:jpoce), trc_data(1:jpi,1:jpj,9) , iarroce(1:jpoce) ) 172 rainrm_dta(1:jpoce,jspoc) = ( zdtap(1:jpoce) + zdtag(1:jpoce) ) * 1e-4 173 ! Sinking fluxes for Calcite in mol.m-2.s-1 ; conversion in mol.cm-2.s-1 174 CALL pack_arr ( jpoce, rainrm_dta(1:jpoce,jscal), trc_data(1:jpi,1:jpj,10), iarroce(1:jpoce) ) 175 rainrm_dta(1:jpoce,jscal) = rainrm_dta(1:jpoce,jscal) * 1e-4 176 ! vector temperature [°C] and salinity 177 CALL pack_arr ( jpoce, temp(1:jpoce), trc_data(1:jpi,1:jpj,11), iarroce(1:jpoce) ) 178 CALL pack_arr ( jpoce, salt(1:jpoce), trc_data(1:jpi,1:jpj,12), iarroce(1:jpoce) ) 179 180 ! Clay rain rate in [mol/(cm**2.s)] 181 ! inputs data in [kg.m-2.mois-1] ---> 1e+3/(1e+4*60*24*60*60) [g.cm-2.s-1] 182 ! divided after by molecular weight g.mol-1 183 zdta(:,:) = 0. 184 CALL iom_get( numbio, jpdom_data, 'CLAY', zdta(:,:) ) 185 CALL pack_arr ( jpoce, rainrm_dta(1:jpoce,jsclay) , zdta(1:jpi,1:jpj), iarroce(1:jpoce) ) 186 rainrm_dta(1:jpoce,jsclay) = rainrm_dta(1:jpoce,jsclay) * conv2 / mol_wgt(jsclay) 187 188 ENDIF 140 ENDDO 141 142 ! Pore water initial concentration [mol/l] in k=1 143 !------------------------------------------------- 144 DO jw = 1, jpwat 145 CALL pack_arr ( jpoce, pwcp_dta(1:jpoce,jw), trc_data(1:jpi,1:jpj,jw), iarroce(1:jpoce) ) 146 END DO 147 ! Solid components : 148 !----------------------- 149 ! Sinking fluxes for OPAL in mol.m-2.s-1 ; conversion in mol.cm-2.s-1 150 CALL pack_arr ( jpoce, rainrm_dta(1:jpoce,jsopal), trc_data(1:jpi,1:jpj,11), iarroce(1:jpoce) ) 151 rainrm_dta(1:jpoce,jsopal) = rainrm_dta(1:jpoce,jsopal) * 1e-4 152 ! Sinking fluxes for POC in mol.m-2.s-1 ; conversion in mol.cm-2.s-1 153 CALL pack_arr ( jpoce, zdtap(1:jpoce), trc_data(1:jpi,1:jpj,12) , iarroce(1:jpoce) ) 154 CALL pack_arr ( jpoce, zdtag(1:jpoce), trc_data(1:jpi,1:jpj,13) , iarroce(1:jpoce) ) 155 DO ji = 1, jpoce 156 ! zkapp = MIN( (1.0 - 0.02 ) * reac_poc, 3731.0 * max(100.0, zkbot(ji) )**(-1.011) / ( 365.0 * 24.0 * 3600.0 ) ) 157 ! zkapp = MIN( 0.98 * reac_poc, 100.0 * max(100.0, zkbot(ji) )**(-0.6) / ( 365.0 * 24.0 * 3600.0 ) ) 158 ! zratio = ( ( 1.0 - 0.02 ) * reac_poc + 0.02 * reac_poc * 0. - zkapp) / ( ( 0.02 - 1.0 ) * reac_poc / 100. - 0.02 * reac_poc * 0. + zkapp ) 159 ! zf1 = ( 0.02 * (reac_poc - reac_poc * 0.) + zkapp - reac_poc ) / ( reac_poc / 100. - reac_poc ) 160 ! zf1 = MIN(0.98, MAX(0., zf1 ) ) 161 zf1 = 0.48 162 zf0 = 1.0 - 0.02 - zf1 163 zf2 = 0.02 164 rainrm_dta(ji,jspoc) = ( zdtap(ji) + zdtag(ji) ) * 1e-4 * zf0 165 rainrm_dta(ji,jspos) = ( zdtap(ji) + zdtag(ji) ) * 1e-4 * zf1 166 rainrm_dta(ji,jspor) = ( zdtap(ji) + zdtag(ji) ) * 1e-4 * zf2 167 END DO 168 ! Sinking fluxes for Calcite in mol.m-2.s-1 ; conversion in mol.cm-2.s-1 169 CALL pack_arr ( jpoce, rainrm_dta(1:jpoce,jscal), trc_data(1:jpi,1:jpj,14), iarroce(1:jpoce) ) 170 rainrm_dta(1:jpoce,jscal) = rainrm_dta(1:jpoce,jscal) * 1e-4 171 ! vector temperature [°C] and salinity 172 CALL pack_arr ( jpoce, temp(1:jpoce), trc_data(1:jpi,1:jpj,15), iarroce(1:jpoce) ) 173 CALL pack_arr ( jpoce, salt(1:jpoce), trc_data(1:jpi,1:jpj,16), iarroce(1:jpoce) ) 174 175 ! Clay rain rate in [mol/(cm**2.s)] 176 ! inputs data in [kg.m-2.sec-1] ---> 1e+3/(1e+4) [g.cm-2.s-1] 177 ! divided after by molecular weight g.mol-1 178 CALL pack_arr ( jpoce, rainrm_dta(1:jpoce,jsclay), dust(1:jpi,1:jpj), iarroce(1:jpoce) ) 179 rainrm_dta(1:jpoce,jsclay) = rainrm_dta(1:jpoce,jsclay) * conv2 / mol_wgt(jsclay) & 180 & + wacc(1:jpoce) * por1(2) * denssol / mol_wgt(jsclay) / ( rsecday * 365.0 ) 181 rainrm_dta(1:jpoce,jsclay) = rainrm_dta(1:jpoce,jsclay) * 0.965 182 rainrm_dta(1:jpoce,jsfeo) = rainrm_dta(1:jpoce,jsclay) * mol_wgt(jsclay) / mol_wgt(jsfeo) * 0.035 / 0.965 183 ! rainrm_dta(1:jpoce,jsclay) = 1.0E-4 * conv2 / mol_wgt(jsclay) 184 185 ! Iron monosulphide rain rates. Set to 0 186 rainrm_dta(1:jpoce,jsfes) = 0. 187 188 ! Fe/C ratio in sinking particles that fall to the sediments 189 CALL pack_arr ( jpoce, fecratio(1:jpoce), trc_data(1:jpi,1:jpj,17), iarroce(1:jpoce) ) 190 191 sedligand(:,1) = 1.E-9 189 192 190 193 ! sediment pore water at 1st layer (k=1) 191 194 DO jw = 1, jpwat 192 pwcp(1:jpoce,1,jw) = pwcp_dta(1:jpoce,jw) * smask(1:jpoce)195 pwcp(1:jpoce,1,jw) = pwcp_dta(1:jpoce,jw) 193 196 ENDDO 194 197 195 198 ! rain 196 199 DO js = 1, jpsol 197 rainrm(1:jpoce,js) = rainrm_dta(1:jpoce,js) * smask(1:jpoce)200 rainrm(1:jpoce,js) = rainrm_dta(1:jpoce,js) 198 201 ENDDO 199 202 … … 212 215 dzdep(1:jpoce) = raintg(1:jpoce) * rdtsed(2) 213 216 214 215 DEALLOCATE( zdta ) 216 DEALLOCATE( zdtap ) ; DEALLOCATE( zdtag ) 217 218 IF( kt == nitsedend ) THEN 219 CALL iom_close ( numbio ) 220 #if defined key_sed_off 221 CALL iom_close ( numoce ) 222 #endif 223 ENDIF 217 IF( lk_iomput ) THEN 218 IF( iom_use("sflxclay" ) ) CALL iom_put( "sflxclay", dust(:,:) * conv2 * 1E4 ) 219 IF( iom_use("sflxcal" ) ) CALL iom_put( "sflxcal", trc_data(:,:,13) ) 220 IF( iom_use("sflxbsi" ) ) CALL iom_put( "sflxbsi", trc_data(:,:,10) ) 221 IF( iom_use("sflxpoc" ) ) CALL iom_put( "sflxpoc", trc_data(:,:,11) + trc_data(:,:,12) ) 222 ENDIF 223 224 IF( ln_timing ) CALL timing_stop('sed_dta') 224 225 225 226 END SUBROUTINE sed_dta 226 227 227 #else228 !!======================================================================229 !! MODULE seddta : Dummy module230 !!======================================================================231 !! $Id$232 CONTAINS233 SUBROUTINE sed_dta ( kt )234 INTEGER, INTENT(in) :: kt235 WRITE(*,*) 'sed_stp: You should not have seen this print! error?', kt236 END SUBROUTINE sed_dta237 #endif238 239 228 END MODULE seddta -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/TOP/PISCES/SED/sedini.F90
r5215 r10345 4 4 !! Sediment : define sediment variables 5 5 !!===================================================================== 6 #if defined key_sed7 6 8 7 !!---------------------------------------------------------------------- … … 11 10 !! * Modules used 12 11 USE sed ! sediment global variable 13 USE seddta 14 USE sedrst 15 USE sedco3 16 USE sedchem 12 USE sed_oce 17 13 USE sedarr 14 USE sedadv 15 USE trc_oce, ONLY : nn_dttrc 16 USE trcdmp_sed 17 USE trcdta 18 18 USE iom 19 USE lib_mpp ! distribued memory computing library 19 20 20 21 … … 24 25 !! Module variables 25 26 REAL(wp) :: & 26 sisat = 800. , & !: saturation for si [ mol.l-1] 27 claysat = 0. , & !: saturation for clay [ mol.l-1] 27 sedzmin = 0.3 , & !: Minimum vertical spacing 28 sedhmax = 10.0 , & !: Maximum depth of the sediment 29 sedkth = 5.0 , & !: Default parameters 30 sedacr = 3.0 !: Default parameters 31 32 REAL(wp) :: & 33 porsurf = 0.95 , & !: Porosity at the surface 34 porinf = 0.75 , & !: Porosity at infinite depth 35 rhox = 2.0 !: Vertical length scale of porosity variation 36 37 REAL(wp) :: & 28 38 rcopal = 40. , & !: reactivity for si [l.mol-1.an-1] 29 rcclay = 0. , & !: reactivity for clay [l.mol-1.an-1]30 39 dcoef = 8.e-6 !: diffusion coefficient (*por) [cm**2/s] 31 40 41 REAL(wp), PUBLIC :: & 42 redO2 = 172. , & !: Redfield coef for Oxygen 43 redNo3 = 16. , & !: Redfield coef for Nitrate 44 redPo4 = 1. , & !: Redfield coef for Phosphate 45 redC = 122. , & !: Redfield coef for Carbon 46 redfep = 0.175 , & !: Ratio for iron bound phosphorus 47 rcorgl = 50. , & !: reactivity for POC/O2 [l.mol-1.an-1] 48 rcorgs = 0.5 , & !: reactivity of the semi-labile component 49 rcorgr = 1E-4 , & !: reactivity of the refractory component 50 rcnh4 = 10E6 , & !: reactivity for O2/NH4 [l.mol-1.an-1] 51 rch2s = 1.E5 , & !: reactivity for O2/ODU [l.mol-1.an-1] 52 rcfe2 = 5.E8 , & !: reactivity for O2/Fe2+ [l.mol-1.an-1] 53 rcfeh2s = 1.E4 , & !: Reactivity for FEOH/H2S [l.mol-1.an-1] 54 rcfes = 1.E5 , & !: Reactivity for FE2+/H2S [l.mol-1.an-1] 55 rcfeso = 3.E5 , & !: Reactivity for FES/O2 [l.mol-1.an-1] 56 xksedo2 = 5E-6 , & !: half-sturation constant for oxic remin. 57 xksedno3 = 5E-6 , & !: half-saturation constant for denitrification 58 xksedfeo = 0.6 , & !: half-saturation constant for iron remin 59 xksedso4 = 2E-3 !: half-saturation constant for SO4 remin 60 32 61 REAL(wp) :: & 33 redO2 = 172. , & !: Redfield coef for Oxygene 34 redNo3 = 16. , & !: Redfield coef for Nitrates 35 redPo4 = 1. , & !: Redfield coef for Phosphates 36 redC = 122. , & !: Redfield coef for Carbone 37 redDnit = 97.6 , & !: Redfield coef for denitrification 38 rcorg = 50. , & !: reactivity for POC/O2 [l.mol-1.an-1] 39 o2seuil = 1. , & !: threshold O2 concentration for [mol.l-1] 40 rcorgN = 50. !: reactivity for POC/No3 [l.mol-1.an-1] 41 42 REAL(wp) :: & 43 rccal = 1000. !: reactivity for calcite [l.mol-1.an-1] 44 45 REAL(wp) :: & 46 dbiot = 15. !: coefficient for bioturbation [cm**2.(1000an-1)] 47 48 LOGICAL :: & 49 ln_rst_sed = .TRUE. !: initialisation from a restart file or not 50 62 rccal = 1000., & !: reactivity for calcite [l.mol-1.an-1] 63 rcligc = 1.E-4 !: L/C ratio in POC 64 65 REAL(wp), PUBLIC :: dbiot = 15. , & !: coefficient for bioturbation [cm**2.(n-1)] 66 dbtbzsc = 10.0 , & !: Vertical scale of variation. If no variation, mixed layer in the sed [cm] 67 xirrzsc = 2.0 !: Vertical scale of irrigation variation. 51 68 REAL(wp) :: & 52 69 ryear = 365. * 24. * 3600. !: 1 year converted in second 70 71 REAL(wp), DIMENSION(jpwat), PUBLIC :: diff1 72 DATA diff1/4.59E-6, 1.104E-5, 4.81E-6 , 9.78E-6, 3.58E-6, 4.01E-6, 9.8E-6, 9.73E-6, 5.0E-6, 3.31E-6 / 73 74 REAL(wp), DIMENSION(jpwat), PUBLIC :: diff2 75 DATA diff2/1.74E-7, 4.47E-7, 2.51E-7, 3.89E-7, 1.77E-7, 2.5E-7, 3.89E-7, 3.06E-7, 2.5E-7, 1.5E-7 / 76 77 53 78 54 79 !! * Routine accessibility … … 76 101 !! ! 06-07 (C. Ethe) Re-organization 77 102 !!---------------------------------------------------------------------- 78 INTEGER :: ji, jj, ikt 79 #if defined key_sed_off 80 INTEGER :: numblt 81 INTEGER :: nummsh 82 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zdta 83 #endif 103 INTEGER :: ji, jj, ikt, ierr 84 104 !!---------------------------------------------------------------------- 85 105 … … 90 110 CALL ctl_opn( numsed, 'sediment.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 91 111 92 WRITE(numsed,*) 93 WRITE(numsed,*) ' L S C E - C E A' 94 WRITE(numsed,*) ' SEDIMENT model' 95 WRITE(numsed,*) ' version 2.0 (2007) ' 96 WRITE(numsed,*) 97 WRITE(numsed,*) 98 99 100 WRITE(numsed,*) ' sed_init : Initialization of sediment module ' 101 WRITE(numsed,*) ' ' 102 103 ! ! Allocate LOBSTER arrays 104 IF( sed_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sed_ini: unable to allocate sediment model arrays' ) 105 112 IF (lwp) THEN 113 WRITE(numsed,*) 114 WRITE(numsed,*) ' PISCES framework' 115 WRITE(numsed,*) ' SEDIMENT model' 116 WRITE(numsed,*) ' version 3.0 (2018) ' 117 WRITE(numsed,*) 118 WRITE(numsed,*) 119 ENDIF 120 121 IF(lwp) WRITE(numsed,*) ' sed_init : Initialization of sediment module ' 122 IF(lwp) WRITE(numsed,*) ' ' 123 124 ! Read sediment Namelist 125 !------------------------- 126 CALL sed_init_nam 127 128 ! Allocate SEDIMENT arrays 129 ierr = sed_alloc() 130 ierr = ierr + sed_oce_alloc() 131 ierr = ierr + sed_adv_alloc() 132 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'sed_ini: unable to allocate sediment model arrays' ) 106 133 107 134 ! Determination of sediments number of points and allocate global variables 108 #if defined key_sed_off109 ! Reading Netcdf Pisces file for deepest water layer thickness [m]110 ! This data will be used as mask to merdge space in 1D vector111 !----------------------------------------------------------------112 113 CALL iom_open ( 'mesh_mask' , nummsh )114 CALL iom_open ( 'e3tbot' , numblt )115 116 ! mask sediment points for outputs117 CALL iom_get( nummsh, jpdom_data, 'tmask' , tmask )118 CALL iom_get( nummsh, jpdom_data, 'mbathy', sbathy )119 120 ! longitude/latitude values121 CALL iom_get ( nummsh, jpdom_data,'nav_lon', glamt(:,:) )122 CALL iom_get ( nummsh, jpdom_data,'nav_lat', gphit(:,:) )123 124 ! bottom layer thickness125 ALLOCATE( zdta(jpi,jpj) )126 CALL iom_get ( numblt, jpdom_data, 'E3TBOT', zdta(:,:) )127 epkbot(:,:) = 0.128 DO jj = 1, jpj129 DO ji = 1, jpi130 ikt = MAX( INT( sbathy(ji,jj) ), 1 )131 IF( tmask(ji,jj,ikt) == 1 ) epkbot(ji,jj) = zdta(ji,jj)132 ENDDO133 ENDDO134 135 CALL iom_close( nummsh )136 CALL iom_close( numblt )137 138 DEALLOCATE( zdta )139 #else140 141 135 epkbot(:,:) = 0. 142 136 DO jj = 1, jpj … … 144 138 ikt = mbkt(ji,jj) 145 139 IF( tmask(ji,jj,ikt) == 1 ) epkbot(ji,jj) = e3t_1d(ikt) 140 gdepbot(ji,jj) = gdepw_0(ji,jj,ikt) 146 141 ENDDO 147 142 ENDDO 148 #endif149 150 143 151 144 ! computation of total number of ocean points 152 145 !-------------------------------------------- 153 jpoce = COUNT( epkbot(:,:) > 0. ) 154 146 sedmask = 0. 147 IF ( COUNT( epkbot(:,:) > 0. ) == 0 ) THEN 148 sedmask = 0. 149 ELSE 150 sedmask = 1. 151 ENDIF 152 jpoce = MAX( COUNT( epkbot(:,:) > 0. ) , 1 ) 155 153 156 154 ! Allocate memory size of global variables … … 159 157 ALLOCATE( rainrm(jpoce,jpsol) ) ; ALLOCATE( rainrg(jpoce,jpsol) ) ; ALLOCATE( raintg(jpoce) ) 160 158 ALLOCATE( dzdep(jpoce) ) ; ALLOCATE( iarroce(jpoce) ) ; ALLOCATE( dzkbot(jpoce) ) 161 ALLOCATE( temp(jpoce) ) ; ALLOCATE( salt(jpoce) ) 159 ALLOCATE( zkbot(jpoce) ) ; ALLOCATE( db(jpoce,jpksed) ) 160 ALLOCATE( temp(jpoce) ) ; ALLOCATE( salt(jpoce) ) 161 ALLOCATE( diff(jpoce,jpksed,jpwat ) ) ; ALLOCATE( irrig(jpoce, jpksed) ) 162 ALLOCATE( wacc(jpoce) ) ; ALLOCATE( fecratio(jpoce) ) 162 163 ALLOCATE( press(jpoce) ) ; ALLOCATE( densSW(jpoce) ) 163 ALLOCATE( hipor(jpoce,jpksed) ) ; ALLOCATE( co3por(jpoce,jpksed) ) 164 ALLOCATE( hipor(jpoce,jpksed) ) ; ALLOCATE( co3por(jpoce,jpksed) ) 164 165 ALLOCATE( dz3d(jpoce,jpksed) ) ; ALLOCATE( volw3d(jpoce,jpksed) ) ; ALLOCATE( vols3d(jpoce,jpksed) ) 166 ALLOCATE( sedligand(jpoce, jpksed) ) 165 167 166 168 ! Initialization of global variables 167 pwcp (:,:,:) = 0. ; pwcp0 (:,:,:) = 0. ; pwcp_dta (:,:) = 0. 168 solcp (:,:,:) = 0. ; solcp0(:,:,:) = 0. ; rainrm_dta(:,:) = 0. 169 rainrm(:,: ) = 0. ; rainrg(:,: ) = 0. ; raintg (: ) = 0. 170 dzdep (: ) = 0. ; iarroce(: ) = 0 ; dzkbot (: ) = 0. 171 temp (: ) = 0. ; salt (: ) = 0. 172 press (: ) = 0. ; densSW (: ) = 0. 173 hipor (:,: ) = 0. ; co3por (:,: ) = 0. 174 dz3d (:,: ) = 0. ; volw3d (:,: ) = 0. ; vols3d (:,:) = 0. 169 pwcp (:,:,:) = 0. ; pwcp0 (:,:,:) = 0. ; pwcp_dta (:,:) = 0. 170 solcp (:,:,:) = 0. ; solcp0(:,:,:) = 0. ; rainrm_dta(:,:) = 0. 171 rainrm(:,: ) = 0. ; rainrg(:,: ) = 0. ; raintg (: ) = 0. 172 dzdep (: ) = 0. ; iarroce(: ) = 0 ; dzkbot (: ) = 0. 173 temp (: ) = 0. ; salt (: ) = 0. ; zkbot (: ) = 0. 174 press (: ) = 0. ; densSW (: ) = 0. ; db (:,:) = 0. 175 hipor (:,: ) = 0. ; co3por (:,: ) = 0. ; irrig (:,:) = 0. 176 dz3d (:,: ) = 0. ; volw3d (:,: ) = 0. ; vols3d (:,:) = 0. 177 fecratio(:) = 1E-5 178 sedligand(:,:) = 0.6E-9 175 179 176 180 ! Chemical variables … … 178 182 ALLOCATE( ak1ps (jpoce) ) ; ALLOCATE( ak2ps (jpoce) ) ; ALLOCATE( ak3ps (jpoce) ) ; ALLOCATE( aksis (jpoce) ) 179 183 ALLOCATE( aksps (jpoce) ) ; ALLOCATE( ak12s (jpoce) ) ; ALLOCATE( ak12ps(jpoce) ) ; ALLOCATE( ak123ps(jpoce) ) 180 ALLOCATE( borats(jpoce) ) ; ALLOCATE( calcon2(jpoce) ) 184 ALLOCATE( borats(jpoce) ) ; ALLOCATE( calcon2(jpoce) ) ; ALLOCATE( sieqs (jpoce) ) 185 ALLOCATE( aks3s(jpoce) ) ; ALLOCATE( akf3s(jpoce) ) ; ALLOCATE( sulfats(jpoce) ) 186 ALLOCATE( fluorids(jpoce) ) 181 187 182 188 akbs (:) = 0. ; ak1s (:) = 0. ; ak2s (:) = 0. ; akws (:) = 0. 183 189 ak1ps (:) = 0. ; ak2ps (:) = 0. ; ak3ps (:) = 0. ; aksis (:) = 0. 184 190 aksps (:) = 0. ; ak12s (:) = 0. ; ak12ps(:) = 0. ; ak123ps(:) = 0. 185 borats(:) = 0. ; calcon2(:) = 0. 191 borats(:) = 0. ; calcon2(:) = 0. ; sieqs (:) = 0. 192 aks3s(:) = 0. ; akf3s(:) = 0. ; sulfats(:) = 0. ; fluorids(:) = 0. 186 193 187 194 ! Mass balance calculation … … 191 198 fromsed(:,:) = 0. ; tosed(:,:) = 0. ; rloss(:,:) = 0. ; tokbot(:,:) = 0. 192 199 193 ! Read sediment Namelist194 !-------------------------195 CALL sed_init_nam196 197 200 ! Initialization of sediment geometry 198 201 !------------------------------------ 199 202 CALL sed_init_geom 200 203 201 202 ! sets initial sediment composition 203 ! ( only clay or reading restart file ) 204 !--------------------------------------- 205 CALL sed_init_data 206 207 208 CALL sed_init_wri 209 204 ! Offline specific mode 205 ! --------------------- 206 ln_sediment_offline = .FALSE. 207 208 #if defined key_sed_off 209 ln_sediment_offline = .TRUE. 210 IF (lwp) write(numsed,*) 'Sediment module is run in offline mode' 211 IF (lwp) write(numsed,*) 'key_sed_off is activated at compilation time' 212 IF (lwp) write(numsed,*) 'ln_sed_2way is forced to false' 213 IF (lwp) write(numsed,*) '--------------------------------------------' 214 ln_sed_2way = .FALSE. 215 #endif 216 ! Initialisation of tracer damping 217 ! -------------------------------- 218 IF (ln_sediment_offline) THEN 219 CALL trc_dta_ini(jptra) 220 CALL trc_dmp_sed_ini 221 ENDIF 210 222 211 223 END SUBROUTINE sed_init 212 213 224 214 225 SUBROUTINE sed_init_geom … … 227 238 !! * Modules used 228 239 !! * local declarations 229 INTEGER :: & 230 ji, jj, jk 231 232 #if defined key_sed_off 233 REAL(wp) , DIMENSION (jpi,jpj) :: zdta 234 INTEGER :: numpres 235 #endif 240 INTEGER :: ji, jj, jk, jn 241 REAL(wp) :: za0, za1, zt, zw, zsum, zsur, zprof, zprofw 242 REAL(wp) :: ztmp1, ztmp2 236 243 !---------------------------------------------------------- 237 244 238 WRITE(numsed,*) ' sed_init_geom : Initialization of sediment geometry '239 WRITE(numsed,*) ' '245 IF(lwp) WRITE(numsed,*) ' sed_init_geom : Initialization of sediment geometry ' 246 IF(lwp) WRITE(numsed,*) ' ' 240 247 241 248 ! Computation of 1D array of sediments points … … 250 257 END DO 251 258 259 IF ( indoce .EQ. 0 ) THEN 260 indoce = 1 261 iarroce(indoce) = 1 262 ENDIF 263 252 264 IF( indoce .NE. jpoce ) THEN 253 WRITE(numsed,*) ' ' 254 WRITE(numsed,*) 'Warning : number of ocean points indoce = ', indoce, & 255 & ' doesn''t match number of point where epkbot>0 jpoce = ', jpoce 256 WRITE(numsed,*) ' ' 257 WRITE(numsed,*) ' ' 258 STOP 265 CALL ctl_stop( 'STOP', 'sed_ini: number of ocean points indoce doesn''t match number of point' ) 259 266 ELSE 260 WRITE(numsed,*) ' ' 261 WRITE(numsed,*) ' total number of ocean points jpoce = ',jpoce 262 WRITE(numsed,*) ' ' 263 ENDIF 264 265 #if defined key_sed_off 266 267 ! Reading Netcdf Pisces file for deepest water layer thickness [m] 268 ! This data will be used as mask to merdge space in 1D vector 269 !---------------------------------------------------------------- 270 CALL iom_open ( 'pressbot' , numpres ) 271 272 ! pressure in bars 273 CALL iom_get ( numpres, jpdom_data,'BATH', zdta(:,:) ) 274 CALL pack_arr ( jpoce, press(1:jpoce), zdta(1:jpi,1:jpj), iarroce(1:jpoce) ) 275 press(1:jpoce) = press(1:jpoce) * 1.025e-1 276 277 CALL iom_close ( numpres ) 278 #endif 279 280 281 ! mask sediment points for outputs 282 DO jk = 1, jpksed 283 tmasksed(:,:,jk) = tmask(:,:,1) 284 ENDDO 267 IF (lwp) WRITE(numsed,*) ' ' 268 IF (lwp) WRITE(numsed,*) ' total number of ocean points jpoce = ',jpoce 269 IF (lwp) WRITE(numsed,*) ' ' 270 ENDIF 285 271 286 272 ! initialization of dzkbot in [cm] … … 288 274 CALL pack_arr ( jpoce, dzkbot(1:jpoce), epkbot(1:jpi,1:jpj), iarroce(1:jpoce) ) 289 275 dzkbot(1:jpoce) = dzkbot(1:jpoce) * 1.e+2 276 CALL pack_arr ( jpoce, zkbot(1:jpoce), gdepbot(1:jpi,1:jpj), iarroce(1:jpoce) ) 290 277 291 278 ! Geometry and constants … … 293 280 ! (1st layer= diffusive layer = pur water) 294 281 !------------------------------------------ 295 dz(1) = 0.1 296 dz(2) = 0.3 297 dz(3) = 0.3 298 dz(4) = 0.5 299 dz(5) = 0.5 300 dz(6) = 0.5 301 dz(7) = 1. 302 dz(8) = 1. 303 dz(9) = 1. 304 dz(10) = 2.45 305 dz(11) = 2.45 282 za1 = ( sedzmin - sedhmax / FLOAT(jpksed-1) ) & 283 & / ( TANH((1-sedkth)/sedacr) - sedacr/FLOAT(jpksed-1) * ( LOG( COSH( (jpksed - sedkth) / sedacr) ) & 284 & - LOG( COSH( ( 1 - sedkth) / sedacr) ) ) ) 285 za0 = sedzmin - za1 * TANH( (1-sedkth) / sedacr ) 286 zsur = - za0 - za1 * sedacr * LOG( COSH( (1-sedkth) / sedacr ) ) 287 288 profsedw(1) = 0.0 289 profsed(1) = -dz(1) / 2. 290 DO jk = 2, jpksed 291 zw = REAL( jk , wp ) 292 zt = REAL( jk , wp ) - 0.5_wp 293 profsed(jk) = ( zsur + za0 * zt + za1 * sedacr * LOG ( COSH( (zt-sedkth) / sedacr ) ) ) 294 profsedw(jk) = ( zsur + za0 * zw + za1 * sedacr * LOG ( COSH( (zw-sedkth) / sedacr ) ) ) 295 END DO 296 297 dz(1) = 0.1 298 DO jk = 2, jpksed 299 dz(jk) = profsedw(jk) - profsedw(jk-1) 300 END DO 306 301 307 302 DO jk = 1, jpksed … … 311 306 ENDDO 312 307 313 ! Depth(jk)= depth of middle of each layer314 !----------------------------------------315 profsed(1) = -dz(1)/ 2.316 DO jk = 2, jpksed317 profsed(jk) = profsed(jk-1) + dz(jk-1) / 2. + dz(jk) / 2.318 ENDDO319 320 308 ! Porosity profile [0] 321 309 !--------------------- 322 por(1) = 1. 323 por(2) = 0.95 324 por(3) = 0.9 325 por(4) = 0.85 326 por(5) = 0.81 327 por(6) = 0.75 328 por(7) = 0.75 329 por(8) = 0.75 330 por(9) = 0.75 331 por(10) = 0.75 332 por(11) = 0.75 310 por(1) = 1.0 311 DO jk = 2, jpksed 312 por(jk) = porinf + ( porsurf-porinf) * exp(-rhox * (profsed(jk) ) ) 313 END DO 333 314 334 315 ! inverse of Porosity profile … … 353 334 dz3d(1:jpoce,1) = dz(1) 354 335 355 356 336 !--------------------------------------------- 357 337 ! Molecular weight [g/mol] for solid species 358 338 !--------------------------------------------- 359 360 339 361 340 ! opal=sio2*0.4(h20)=28+2*16+0.4*(2+16) … … 371 350 & 0.59 * 27. + 10. * 16. 372 351 352 mol_wgt(jsfeo) = 55.0 + 3.0 * ( 16.0 + 1.0) 353 354 mol_wgt(jsfes) = 55.0 + 32.0 355 373 356 ! for chemistry Poc : C(122)H(244)O(86)N(16)P(1) 374 357 ! But den sity of Poc is an Hydrated material (= POC + 30H2O) … … 377 360 mol_wgt(jspoc) = ( 122. * 12. + 355. + 120. * 16.+ & 378 361 & 16. * 14. + 31. ) / 122. 362 mol_wgt(jspos) = mol_wgt(jspoc) 363 mol_wgt(jspor) = mol_wgt(jspoc) 379 364 380 365 ! CaCO3 … … 384 369 ! Density of solid material in sediment [g/cm**3] 385 370 !------------------------------------------------ 386 dens = 2.6371 denssol = 2.6 387 372 388 373 ! Initialization of diffusion coefficient as function of porosity [cm**2/s] 389 374 !-------------------------------------------------------------------- 390 diff(:) = dcoef * por(:) 375 ! DO jn = 1, jpsol 376 ! DO jk = 1, jpksed 377 ! DO ji = 1, jpoce 378 ! diff(ji,jk,jn) = dcoef / ( 1.0 - 2.0 * log(por(jk)) ) 379 ! END DO 380 ! END DO 381 ! END DO 382 383 ! Accumulation rate from Burwicz et al. (2011). This is used to 384 ! compute the flux of clays and minerals 385 ! -------------------------------------------------------------- 386 DO ji = 1, jpoce 387 ztmp1 = 0.117 / ( 1.0 + ( zkbot(ji) / 200.)**3 ) 388 ztmp2 = 0.006 / ( 1.0 + ( zkbot(ji) / 4000.)**10 ) 389 wacc(ji) = ztmp1 + ztmp2 390 END DO 391 391 392 392 393 393 ! Initialization of time step as function of porosity [cm**2/s] 394 394 !------------------------------------------------------------------ 395 rdtsed(2:jpksed) = dtsed / ( dens * por1(2:jpksed) )396 397 395 END SUBROUTINE sed_init_geom 398 396 … … 408 406 !!---------------------------------------------------------------------- 409 407 410 INTEGER :: & 411 numnamsed = 28 408 INTEGER :: numnamsed_ref = -1 !! Logical units for namelist sediment 409 INTEGER :: numnamsed_cfg = -1 !! Logical units for namelist sediment 410 INTEGER :: ios ! Local integer output status for namelist read 411 CHARACTER(LEN=20) :: clname 412 412 413 413 TYPE PSED … … 422 422 TYPE(PSED) , DIMENSION(jpdia2dsed) :: seddiag2d 423 423 424 NAMELIST/nam_time/nfreq 424 NAMELIST/nam_run/nrseddt,ln_sed_2way 425 NAMELIST/nam_geom/jpksed, sedzmin, sedhmax, sedkth, sedacr, porsurf, porinf, rhox 425 426 NAMELIST/nam_trased/sedsol, sedwat 426 427 NAMELIST/nam_diased/seddiag3d, seddiag2d 427 NAMELIST/nam_reac/sisat, claysat, rcopal, rcclay, dcoef 428 NAMELIST/nam_poc/redO2, redNo3, redPo4, redC, redDnit, & 429 & rcorg, o2seuil, rcorgN 430 NAMELIST/nam_cal/rccal 431 NAMELIST/nam_dc13/pdb, rc13P, rc13Ca 432 NAMELIST/nam_btb/dbiot 433 NAMELIST/nam_rst/ln_rst_sed 434 435 INTEGER :: jn, jn1 428 NAMELIST/nam_inorg/rcopal, dcoef, rccal, ratligc, rcligc 429 NAMELIST/nam_poc/redO2, redNo3, redPo4, redC, redfep, rcorgl, rcorgs, & 430 & rcorgr, rcnh4, rch2s, rcfe2, rcfeh2s, rcfes, rcfeso, & 431 & xksedo2, xksedno3, xksedfeo, xksedso4 432 NAMELIST/nam_btb/dbiot, ln_btbz, dbtbzsc, adsnh4, ln_irrig, xirrzsc 433 NAMELIST/nam_rst/ln_rst_sed, cn_sedrst_indir, cn_sedrst_outdir, cn_sedrst_in, cn_sedrst_out 434 435 INTEGER :: ji, jn, jn1 436 436 !------------------------------------------------------- 437 437 438 WRITE(numsed,*) ' sed_init_nam : Read namelists '439 WRITE(numsed,*) ' '438 IF(lwp) WRITE(numsed,*) ' sed_init_nam : Read namelists ' 439 IF(lwp) WRITE(numsed,*) ' ' 440 440 441 441 ! ryear = 1 year converted in second 442 442 !------------------------------------ 443 WRITE(numsed,*) ' ' 444 WRITE(numsed,*) 'number of seconds in one year : ryear = ', ryear 445 WRITE(numsed,*) ' ' 443 IF (lwp) THEN 444 WRITE(numsed,*) ' ' 445 WRITE(numsed,*) 'number of seconds in one year : ryear = ', ryear 446 WRITE(numsed,*) ' ' 447 ENDIF 446 448 447 449 ! Reading namelist.sed variables 448 450 !--------------------------------- 449 CALL ctl_opn( numnamsed, 'namelist.sediment', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 450 451 dtsed = rdt 451 clname = 'namelist_sediment' 452 IF(lwp) WRITE(numsed,*) ' sed_init_nam : read SEDIMENT namelist' 453 IF(lwp) WRITE(numsed,*) ' ~~~~~~~~~~~~~~' 454 CALL ctl_opn( numnamsed_ref, TRIM( clname )//'_ref', 'OLD' , 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 455 CALL ctl_opn( numnamsed_cfg, TRIM( clname )//'_cfg', 'OLD' , 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 456 452 457 nitsed000 = nittrc000 453 458 nitsedend = nitend 454 #if ! defined key_sed_off 455 nwrised = nwritetrc 456 #else 457 nwrised = nwrite 458 #endif 459 ! Diffraction/reaction parameters 460 !---------------------------------- 461 READ( numnamsed, nam_time ) 462 WRITE(numsed,*) ' namelist nam_time' 463 464 #if ! defined key_sed_off 465 nfreq = 1 466 #endif 467 468 WRITE(numsed,*) ' sedimentation time step dtsed = ', dtsed 469 WRITE(numsed,*) ' 1st time step for sediment. nitsed000 = ', nitsed000 470 WRITE(numsed,*) ' last time step for sediment. nitsedend = ', nitsedend 471 WRITE(numsed,*) ' frequency of sediment outputs nwrised = ', nwrised 472 WRITE(numsed,*) ' frequency of restoring inputs data nfreq = ', nfreq 473 WRITE(numsed,*) ' ' 474 475 REWIND( numnamsed ) ! read nattrc 476 READ ( numnamsed, nam_trased ) 459 ! Namelist nam_run 460 REWIND( numnamsed_ref ) ! Namelist nam_run in reference namelist : Pisces variables 461 READ ( numnamsed_ref, nam_run, IOSTAT = ios, ERR = 901) 462 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_run in reference namelist', lwp ) 463 464 REWIND( numnamsed_cfg ) ! Namelist nam_run in reference namelist : Pisces variables 465 READ ( numnamsed_cfg, nam_run, IOSTAT = ios, ERR = 902) 466 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_run in configuration namelist', lwp ) 467 468 IF (lwp) THEN 469 WRITE(numsed,*) ' namelist nam_run' 470 WRITE(numsed,*) ' Nb of iterations for fast species nrseddt = ', nrseddt 471 WRITE(numsed,*) ' 2-way coupling between PISCES and Sed ln_sed_2way = ', ln_sed_2way 472 ENDIF 473 474 REWIND( numnamsed_ref ) ! Namelist nam_geom in reference namelist : Pisces variables 475 READ ( numnamsed_ref, nam_geom, IOSTAT = ios, ERR = 903) 476 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_geom in reference namelist', lwp ) 477 478 REWIND( numnamsed_cfg ) ! Namelist nam_geom in reference namelist : Pisces variables 479 READ ( numnamsed_cfg, nam_geom, IOSTAT = ios, ERR = 904) 480 904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_geom in configuration namelist', lwp ) 481 482 IF (lwp) THEN 483 WRITE(numsed,*) ' namelist nam_geom' 484 WRITE(numsed,*) ' Number of vertical layers jpksed = ', jpksed 485 WRITE(numsed,*) ' Minimum vertical spacing sedzmin = ', sedzmin 486 WRITE(numsed,*) ' Maximum depth of the sediment sedhmax = ', sedhmax 487 WRITE(numsed,*) ' Default parameter sedkth = ', sedkth 488 WRITE(numsed,*) ' Default parameter sedacr = ', sedacr 489 WRITE(numsed,*) ' Sediment porosity at the surface porsurf = ', porsurf 490 WRITE(numsed,*) ' Sediment porosity at infinite depth porinf = ', porinf 491 WRITE(numsed,*) ' Length scale of porosity variation rhox = ', rhox 492 ENDIF 493 494 jpksedm1 = jpksed - 1 495 dtsed = r2dttrc 496 497 REWIND( numnamsed_ref ) ! Namelist nam_trased in reference namelist : Pisces variables 498 READ ( numnamsed_ref, nam_trased, IOSTAT = ios, ERR = 905) 499 905 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_trased in reference namelist', lwp ) 500 501 REWIND( numnamsed_cfg ) ! Namelist nam_trased in reference namelist : Pisces variables 502 READ ( numnamsed_cfg, nam_trased, IOSTAT = ios, ERR = 906) 503 906 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_trased in configuration namelist', lwp ) 477 504 478 505 DO jn = 1, jpsol … … 489 516 END DO 490 517 491 WRITE(numsed,*) ' namelist nam_trased' 492 WRITE(numsed,*) ' ' 493 DO jn = 1, jptrased 494 WRITE(numsed,*) 'name of 3d output sediment field number :',jn,' : ',TRIM(sedtrcd(jn)) 495 WRITE(numsed,*) 'long name ', TRIM(sedtrcl(jn)) 496 WRITE(numsed,*) ' in unit = ', TRIM(sedtrcu(jn)) 497 WRITE(numsed,*) ' ' 498 END DO 499 WRITE(numsed,*) ' ' 500 518 IF (lwp) THEN 519 WRITE(numsed,*) ' namelist nam_trased' 520 WRITE(numsed,*) ' ' 521 DO jn = 1, jptrased 522 WRITE(numsed,*) 'name of 3d output sediment field number :',jn,' : ',TRIM(sedtrcd(jn)) 523 WRITE(numsed,*) 'long name ', TRIM(sedtrcl(jn)) 524 WRITE(numsed,*) ' in unit = ', TRIM(sedtrcu(jn)) 525 WRITE(numsed,*) ' ' 526 END DO 527 WRITE(numsed,*) ' ' 528 ENDIF 529 530 REWIND( numnamsed_ref ) ! Namelist nam_diased in reference namelist : Pisces variables 531 READ ( numnamsed_ref, nam_diased, IOSTAT = ios, ERR = 907) 532 907 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diased in reference namelist', lwp ) 533 534 REWIND( numnamsed_cfg ) ! Namelist nam_diased in reference namelist : Pisces variables 535 READ ( numnamsed_cfg, nam_diased, IOSTAT = ios, ERR = 908) 536 908 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diased in configuration namelist', lwp ) 501 537 502 REWIND( numnamsed )503 READ( numnamsed, nam_diased )504 505 538 DO jn = 1, jpdia3dsed 506 539 seddia3d(jn) = seddiag3d(jn)%snamesed … … 515 548 END DO 516 549 517 WRITE(numsed,*) ' namelist nam_diased' 518 WRITE(numsed,*) ' ' 519 DO jn = 1, jpdia3dsed 520 WRITE(numsed,*) 'name of 3D output diag number :',jn, ' : ', TRIM(seddia3d(jn)) 521 WRITE(numsed,*) 'long name ', TRIM(seddia3l(jn)) 522 WRITE(numsed,*) ' in unit = ',TRIM(seddia3u(jn)) 523 WRITE(numsed,*) ' ' 524 END DO 525 526 DO jn = 1, jpdia2dsed 527 WRITE(numsed,*) 'name of 2D output diag number :',jn, ' : ', TRIM(seddia2d(jn)) 528 WRITE(numsed,*) 'long name ', TRIM(seddia2l(jn)) 529 WRITE(numsed,*) ' in unit = ',TRIM(seddia2u(jn)) 530 WRITE(numsed,*) ' ' 531 END DO 532 533 WRITE(numsed,*) ' ' 534 535 536 ! Diffraction/reaction parameters 550 IF (lwp) THEN 551 WRITE(numsed,*) ' namelist nam_diased' 552 WRITE(numsed,*) ' ' 553 DO jn = 1, jpdia3dsed 554 WRITE(numsed,*) 'name of 3D output diag number :',jn, ' : ', TRIM(seddia3d(jn)) 555 WRITE(numsed,*) 'long name ', TRIM(seddia3l(jn)) 556 WRITE(numsed,*) ' in unit = ',TRIM(seddia3u(jn)) 557 WRITE(numsed,*) ' ' 558 END DO 559 560 DO jn = 1, jpdia2dsed 561 WRITE(numsed,*) 'name of 2D output diag number :',jn, ' : ', TRIM(seddia2d(jn)) 562 WRITE(numsed,*) 'long name ', TRIM(seddia2l(jn)) 563 WRITE(numsed,*) ' in unit = ',TRIM(seddia2u(jn)) 564 WRITE(numsed,*) ' ' 565 END DO 566 567 WRITE(numsed,*) ' ' 568 ENDIF 569 570 ! Inorganic chemistry parameters 537 571 !---------------------------------- 538 REWIND( numnamsed ) 539 READ( numnamsed, nam_reac ) 540 WRITE(numsed,*) ' namelist nam_reac' 541 WRITE(numsed,*) ' saturation for si sisat = ', sisat 542 WRITE(numsed,*) ' saturation for clay claysat = ', claysat 543 WRITE(numsed,*) ' reactivity for Si rcopal = ', rcopal 544 WRITE(numsed,*) ' reactivity for clay rcclay = ', rcclay 545 WRITE(numsed,*) ' diff. coef for por. dcoef = ', dcoef 546 WRITE(numsed,*) ' ' 547 572 REWIND( numnamsed_ref ) ! Namelist nam_inorg in reference namelist : Pisces variables 573 READ ( numnamsed_ref, nam_inorg, IOSTAT = ios, ERR = 909) 574 909 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_inorg in reference namelist', lwp ) 575 576 REWIND( numnamsed_cfg ) ! Namelist nam_inorg in reference namelist : Pisces variables 577 READ ( numnamsed_cfg, nam_inorg, IOSTAT = ios, ERR = 910) 578 910 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_inorg in configuration namelist', lwp ) 579 580 IF (lwp) THEN 581 WRITE(numsed,*) ' namelist nam_inorg' 582 WRITE(numsed,*) ' reactivity for Si rcopal = ', rcopal 583 WRITE(numsed,*) ' diff. coef for por. dcoef = ', dcoef 584 WRITE(numsed,*) ' reactivity for calcite rccal = ', rccal 585 WRITE(numsed,*) ' L/C ratio in POC ratligc = ', ratligc 586 WRITE(numsed,*) ' reactivity for ligands rcligc = ', rcligc 587 WRITE(numsed,*) ' ' 588 ENDIF 548 589 549 590 ! Unity conversion to get saturation conc. psat in [mol.l-1] 550 591 ! and reactivity rc in [l.mol-1.s-1] 551 592 !---------------------------------------------------------- 552 sat_sil = sisat * 1.e-6 553 sat_clay = claysat * 1.e-6 554 555 reac_sil = rcopal / ryear 556 reac_clay = rcclay / ryear 557 593 reac_sil = rcopal / ryear 594 reac_ligc = rcligc / ryear 558 595 559 596 ! Additional parameter linked to POC/O2/No3/Po4 560 597 !---------------------------------------------- 561 REWIND( numnamsed ) 562 READ( numnamsed, nam_poc ) 563 WRITE(numsed,*) ' namelist nam_poc' 564 WRITE(numsed,*) ' Redfield coef for oxy redO2 = ', redO2 565 WRITE(numsed,*) ' Redfield coef for no3 redNo3 = ', redNo3 566 WRITE(numsed,*) ' Redfield coef for po4 redPo4 = ', redPo4 567 WRITE(numsed,*) ' Redfield coef for carbone redC = ', redC 568 WRITE(numsed,*) ' Redfield coef for denitri redDnit = ', redDnit 569 WRITE(numsed,*) ' reactivity for POC/O2 rcorg = ', rcorg 570 WRITE(numsed,*) ' threshold O2 concen. o2seuil = ', o2seuil 571 WRITE(numsed,*) ' reactivity for POC/NO3 rcorgN = ', rcorgN 572 WRITE(numsed,*) ' ' 573 574 575 so2ut = redO2 / redC 576 srno3 = redNo3 / redC 577 spo4r = redPo4 / redC 578 srDnit = redDnit / redC 579 sthro2 = o2seuil * 1.e-6 ! threshold O2 concen. in [mol.l-1] 598 REWIND( numnamsed_ref ) ! Namelist nam_poc in reference namelist : Pisces variables 599 READ ( numnamsed_ref, nam_poc, IOSTAT = ios, ERR = 911) 600 911 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_poc in reference namelist', lwp ) 601 602 REWIND( numnamsed_cfg ) ! Namelist nam_poc in reference namelist : Pisces variables 603 READ ( numnamsed_cfg, nam_poc, IOSTAT = ios, ERR = 912) 604 912 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_poc in configuration namelist', lwp ) 605 606 IF (lwp) THEN 607 WRITE(numsed,*) ' namelist nam_poc' 608 WRITE(numsed,*) ' Redfield coef for oxy redO2 = ', redO2 609 WRITE(numsed,*) ' Redfield coef for no3 redNo3 = ', redNo3 610 WRITE(numsed,*) ' Redfield coef for po4 redPo4 = ', redPo4 611 WRITE(numsed,*) ' Redfield coef for carbon redC = ', redC 612 WRITE(numsed,*) ' Ration for iron bound P redfep = ', redfep 613 WRITE(numsed,*) ' reactivity for labile POC rcorgl = ', rcorgl 614 WRITE(numsed,*) ' reactivity for semi-refract. POC rcorgs = ', rcorgs 615 WRITE(numsed,*) ' reactivity for refractory POC rcorgr = ', rcorgr 616 WRITE(numsed,*) ' reactivity for NH4 rcnh4 = ', rcnh4 617 WRITE(numsed,*) ' reactivity for H2S rch2s = ', rch2s 618 WRITE(numsed,*) ' reactivity for Fe2+ rcfe2 = ', rcfe2 619 WRITE(numsed,*) ' reactivity for FeOH/H2S rcfeh2s = ', rcfeh2s 620 WRITE(numsed,*) ' reactivity for Fe2+/H2S rcfes = ', rcfes 621 WRITE(numsed,*) ' reactivity for FeS/O2 rcfeso = ', rcfeso 622 WRITE(numsed,*) ' Half-sat. cste for oxic remin xksedo2 = ', xksedo2 623 WRITE(numsed,*) ' Half-sat. cste for denit. xksedno3 = ', xksedno3 624 WRITE(numsed,*) ' Half-sat. cste for iron remin xksedfeo = ', xksedfeo 625 WRITE(numsed,*) ' Half-sat. cste for SO4 remin xksedso4 = ', xksedso4 626 WRITE(numsed,*) ' ' 627 ENDIF 628 629 630 so2ut = redO2 / redC 631 srno3 = redNo3 / redC 632 spo4r = redPo4 / redC 633 srDnit = ( (redO2 + 32. ) * 0.8 - redNo3 - redNo3 * 0.6 ) / redC 580 634 ! reactivity rc in [l.mol-1.s-1] 581 reac_poc = rcorg / ryear 582 reac_no3 = rcorgN / ryear 583 584 585 ! Carbonate parameters 586 !--------------------- 587 READ( numnamsed, nam_cal ) 588 WRITE(numsed,*) ' namelist nam_cal' 589 WRITE(numsed,*) ' reactivity for calcite rccal = ', rccal 590 WRITE(numsed,*) ' ' 635 reac_pocl = rcorgl / ryear 636 reac_pocs = rcorgs / ryear 637 reac_pocr = rcorgr / ryear 638 reac_nh4 = rcnh4 / ryear 639 reac_h2s = rch2s / ryear 640 reac_fe2 = rcfe2 / ryear 641 reac_feh2s = rcfeh2s/ ryear 642 reac_fes = rcfes / ryear 643 reac_feso = rcfeso / ryear 591 644 592 645 ! reactivity rc in [l.mol-1.s-1] 593 646 reac_cal = rccal / ryear 594 647 595 596 ! C13 parameters597 !----------------598 READ( numnamsed, nam_dc13 )599 WRITE(numsed,*) ' namelist nam_dc13 '600 WRITE(numsed,*) ' 13C/12C in PD Belemnite PDB = ', pdb601 WRITE(numsed,*) ' 13C/12C in POC = rc13P*PDB rc13P = ', rc13P602 WRITE(numsed,*) ' 13C/12C in CaCO3 = rc13Ca*PDB rc13Ca = ', rc13Ca603 WRITE(numsed,*) ' '604 605 606 648 ! Bioturbation parameter 607 649 !------------------------ 608 READ( numnamsed, nam_btb ) 609 WRITE(numsed,*) ' namelist nam_btb ' 610 WRITE(numsed,*) ' coefficient for bioturbation dbiot = ', dbiot 611 WRITE(numsed,*) ' ' 612 613 ! Unity convertion to get bioturb coefficient in [cm2.s-1] 614 db = dbiot / ( ryear * 1000. ) 650 REWIND( numnamsed_ref ) ! Namelist nam_btb in reference namelist : Pisces variables 651 READ ( numnamsed_ref, nam_btb, IOSTAT = ios, ERR = 913) 652 913 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_btb in reference namelist', lwp ) 653 654 REWIND( numnamsed_cfg ) ! Namelist nam_btb in reference namelist : Pisces variables 655 READ ( numnamsed_cfg, nam_btb, IOSTAT = ios, ERR = 914) 656 914 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_btb in configuration namelist', lwp ) 657 658 IF (lwp) THEN 659 WRITE(numsed,*) ' namelist nam_btb ' 660 WRITE(numsed,*) ' coefficient for bioturbation dbiot = ', dbiot 661 WRITE(numsed,*) ' Depth varying bioturbation ln_btbz = ', ln_btbz 662 WRITE(numsed,*) ' coefficient for btb attenuation dbtbzsc = ', dbtbzsc 663 WRITE(numsed,*) ' Adsorption coefficient of NH4 adsnh4 = ', adsnh4 664 WRITE(numsed,*) ' Bioirrigation in sediment ln_irrig = ', ln_irrig 665 WRITE(numsed,*) ' coefficient for irrig attenuation xirrzsc = ', xirrzsc 666 WRITE(numsed,*) ' ' 667 ENDIF 615 668 616 669 ! Initial value (t=0) for sediment pore water and solid components 617 670 !---------------------------------------------------------------- 618 READ( numnamsed, nam_rst ) 619 WRITE(numsed,*) ' namelist nam_rst ' 620 WRITE(numsed,*) ' boolean term for restart (T or F) ln_rst_sed = ', ln_rst_sed 621 WRITE(numsed,*) ' ' 622 623 CLOSE( numnamsed ) 671 REWIND( numnamsed_ref ) ! Namelist nam_rst in reference namelist : Pisces variables 672 READ ( numnamsed_ref, nam_rst, IOSTAT = ios, ERR = 915) 673 915 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_rst in reference namelist', lwp ) 674 675 REWIND( numnamsed_cfg ) ! Namelist nam_rst in reference namelist : Pisces variables 676 READ ( numnamsed_cfg, nam_rst, IOSTAT = ios, ERR = 916) 677 916 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_rst in configuration namelist', lwp ) 678 679 IF (lwp) THEN 680 WRITE(numsed,*) ' namelist nam_rst ' 681 WRITE(numsed,*) ' boolean term for restart (T or F) ln_rst_sed = ', ln_rst_sed 682 WRITE(numsed,*) ' ' 683 ENDIF 684 nn_dtsed = nn_dttrc 685 686 CLOSE( numnamsed_cfg ) 687 CLOSE( numnamsed_ref ) 624 688 625 689 END SUBROUTINE sed_init_nam 626 690 627 SUBROUTINE sed_init_data628 !!----------------------------------------------------------------------629 !! *** ROUTINE sed_init_data ***630 !!631 !! ** Purpose : Initialization of sediment module632 !! - sets initial sediment composition633 !! ( only clay or reading restart file )634 !!635 !! History :636 !! ! 06-07 (C. Ethe) original637 !!----------------------------------------------------------------------638 639 ! local variables640 INTEGER :: &641 ji, jk, zhipor642 643 !--------------------------------------------------------------------644 645 646 IF( .NOT. ln_rst_sed ) THEN647 648 WRITE(numsed,*) ' Initilization of default values of sediment components'649 650 ! default values for initial pore water concentrations [mol/l]651 pwcp(:,:,:) = 0.652 ! default value for initial solid component (fraction of dry weight dim=[0])653 ! clay654 solcp(:,:,:) = 0.655 solcp(:,2:jpksed,jsclay) = 1.656 657 ! Initialization of [h+] and [co3--]658 659 zhipor = 8.660 ! Initialization of [h+] in mol/kg661 DO jk = 1, jpksed662 DO ji = 1, jpoce663 hipor (ji,jk) = 10.**( -1. * zhipor )664 ENDDO665 ENDDO666 667 co3por(:,:) = 0.668 669 ELSE670 671 WRITE(numsed,*) ' Initilization of Sediment components from restart'672 673 CALL sed_rst_read674 675 ENDIF676 677 678 ! Load initial Pisces Data for bot. wat. Chem and fluxes679 CALL sed_dta ( nitsed000 )680 681 ! Initialization of chemical constants682 CALL sed_chem ( nitsed000 )683 684 ! Stores initial sediment data for mass balance calculation685 pwcp0 (1:jpoce,1:jpksed,1:jpwat ) = pwcp (1:jpoce,1:jpksed,1:jpwat )686 solcp0(1:jpoce,1:jpksed,1:jpsol ) = solcp(1:jpoce,1:jpksed,1:jpsol)687 688 ! Conversion of [h+] in mol/Kg to get it in mol/l ( multiplication by density)689 DO jk = 1, jpksed690 hipor(1:jpoce,jk) = hipor(1:jpoce,jk) * densSW(1:jpoce)691 ENDDO692 693 694 ! In default case - no restart - sedco3 is run to initiate [h+] and [co32-]695 ! Otherwise initiate values of pH and co3 read in restart696 IF( .NOT. ln_rst_sed ) THEN697 ! sedco3 is run to initiate[h+] [co32-] in mol/l of solution698 CALL sed_co3 ( nitsed000 )699 700 ENDIF701 702 END SUBROUTINE sed_init_data703 704 SUBROUTINE sed_init_wri705 706 INTEGER :: jk707 708 WRITE(numsed,*)' '709 WRITE(numsed,*)'======== Write summary of initial state ============'710 WRITE(numsed,*)' '711 WRITE(numsed,*)' '712 WRITE(numsed,*)'-------------------------------------------------------------------'713 WRITE(numsed,*)' Initial Conditions '714 WRITE(numsed,*)'-------------------------------------------------------------------'715 WRITE(numsed,*)'dzm = dzkbot minimum to calculate ', 0.716 WRITE(numsed,*)'Local zone : jpi, jpj : ',jpi, jpj717 WRITE(numsed,*)'jpoce = ',jpoce,' nbtot pts = ',jpij,' nb earth pts = ',jpij - jpoce718 WRITE(numsed,*)'sublayer thickness dz(1) [cm] : ', dz(1)719 WRITE(numsed,*)'Coeff diff for k=1 (cm2/s) : ',diff(1)720 WRITE(numsed,*)' nb solid comp : ',jpsol721 WRITE(numsed,*)'(1=opal,2=clay,3=POC,4=CaCO3)'722 WRITE(numsed,*)'weight mol 1,2,3,4'723 WRITE(numsed,'(4(F0.2,3X))')mol_wgt(jsopal),mol_wgt(jsclay),mol_wgt(jspoc),mol_wgt(jscal)724 WRITE(numsed,*)'nb dissolved comp',jpwat725 WRITE(numsed,*)'(1=silicic acid,2="dissolved" clay,3=O2,4=DIC,5=Nitrate,&726 &6=Phosphates,7=Alk))'727 WRITE(numsed,*)'Psat (umol/l) for silicic Acid and "dissolved" clay'728 WRITE(numsed,'(2(F0.2,3X))') sat_sil * 1e+6, sat_clay * 1e+6729 WRITE(numsed,*)'reaction rate rc for Op/si,Clay,POC/O2,caco3, POC/No3 (an-1)'730 WRITE(numsed,'(5(F0.2,3X))') reac_sil * ryear, reac_clay * ryear, reac_poc * ryear, &731 reac_cal * ryear, reac_no3 * ryear732 WRITE(numsed,*)'redfield coef C,O,N P Dit '733 WRITE(numsed,'(5(F0.2,3X))')1./spo4r,so2ut/spo4r,srno3/spo4r,spo4r/spo4r,srDnit/spo4r734 WRITE(numsed,*)'threshold for stating denitrification [mol/l]'735 WRITE(numsed,'(1PE8.2)') sthrO2736 WRITE(numsed,*)'-------------------------------------------------------------------'737 WRITE(numsed,*)'Min-Max-Mean'738 WRITE(numsed,*)'For each variable : min, max, moy value observed on selected local zone'739 WRITE(numsed,*)'-------------------------------------------------------------------'740 WRITE(numsed,*)'thickness of the last wet layer dzkbot [m]'741 WRITE(numsed,'(3(F0.2,3X))') MINVAL(dzkbot(1:jpoce))/100.,MAXVAL(dzkbot(1:jpoce))/100.,&742 &SUM(dzkbot(1:jpoce))/jpoce/100.743 WRITE(numsed,*)'temp [°C]'744 WRITE(numsed,'(3(F0.2,3X))') MINVAL(temp(1:jpoce)),MAXVAL(temp(1:jpoce)),&745 & SUM(temp(1:jpoce))/jpoce746 WRITE(numsed,*)'salt o/oo'747 WRITE(numsed,'(3(F0.2,3X))')MINVAL(salt(1:jpoce)),MAXVAL(salt(1:jpoce)),&748 & SUM(salt(1:jpoce))/jpoce749 #if defined key_sed_off750 WRITE(numsed,*)'pressure [bar] (depth in m is about 10*pressure)'751 WRITE(numsed,'(3(F0.2,3X))') MINVAL(press(1:jpoce)),MAXVAL(press(1:jpoce)),&752 & SUM(press(1:jpoce))/jpoce753 #endif754 WRITE(numsed,*)'density of Sea Water'755 WRITE(numsed,'(3(F0.2,3X))') MINVAL(densSW(1:jpoce)), MAXVAL(densSW(1:jpoce)),&756 & SUM(densSW(1:jpoce))/jpoce757 WRITE(numsed,*)''758 WRITE(numsed,*)' Dissolved Components '759 WRITE(numsed,*)' ====================='760 WRITE(numsed,*)'[Si(OH)4] dissolved (1)(k=1)(µmol/l)(and min value in mol/kg of solution)'761 WRITE(numsed,'(4(F0.3,2X))') MINVAL(pwcp(1:jpoce,1,jwsil))*1.e+6,MAXVAL(pwcp(1:jpoce,1,jwsil))*1.e+6,&762 & SUM(pwcp(1:jpoce,1,jwsil))*1.e+6/jpoce,&763 & MINVAL(pwcp(1:jpoce,1,jwsil)*1.e+6/densSW(1:jpoce))764 WRITE(numsed,*)'[O2] dissolved (3) (k=1)(µmol/l)(and min value in mol/kg of solution)'765 WRITE(numsed,'(4(F0.3,2X))') MINVAL(pwcp(1:jpoce,1,jwoxy))*1.e+6,MAXVAL(pwcp(1:jpoce,1,jwoxy))*1.e+6,&766 &SUM(pwcp(1:jpoce,1,jwoxy))*1.e+6/jpoce,&767 &MINVAL(pwcp(1:jpoce,1,jwoxy)*1.e+6/densSW(1:jpoce))768 WRITE(numsed,*)'[DIC] dissolved (4) (k=1)(µmol/l)(and min value in mol/kg of solution)'769 WRITE(numsed,'(4(F0.3,2X))') MINVAL(pwcp(1:jpoce,1,jwdic))*1.e+6,MAXVAL(pwcp(1:jpoce,1,jwdic))*1.e+6,&770 &SUM(pwcp(1:jpoce,1,jwdic))*1.e+6/jpoce,&771 &MINVAL(pwcp(1:jpoce,1,jwdic)*1.e+6/densSW(1:jpoce))772 WRITE(numsed,*)'[NO3] dissolved (5) (k=1)(µmol/l)(and min value in mol/kg of solution)'773 WRITE(numsed,'(4(F0.3,2X))') MINVAL(pwcp(1:jpoce,1,jwno3))*1.e+6,MAXVAL(pwcp(1:jpoce,1,jwno3))*1.e+6,&774 &SUM(pwcp(1:jpoce,1,jwno3))*1.e+6/jpoce,&775 &MINVAL(pwcp(1:jpoce,1,jwno3)*1.e+6/densSW(1:jpoce))776 WRITE(numsed,*)'[PO4] dissolved (6) (k=1)(µmol/l)(and min value in mol/kg of solution)'777 WRITE(numsed,'(4(F0.3,2X))') MINVAL(pwcp(1:jpoce,1,jwpo4))*1.e+6,MAXVAL(pwcp(1:jpoce,1,jwpo4))*1.e+6,&778 &SUM(pwcp(1:jpoce,1,jwpo4))*1.e+6/jpoce,&779 &MINVAL(pwcp(1:jpoce,1,jwpo4)*1.e+6/densSW(1:jpoce))780 WRITE(numsed,*)'[Alk] dissolved (7) (k=1)(µequi)(and min value in mol/kg of solution)'781 WRITE(numsed,'(4(F0.3,2X))') MINVAL(pwcp(1:jpoce,1,jwalk))*1.e+6,MAXVAL(pwcp(1:jpoce,1,jwalk))*1.e+6,&782 &SUM(pwcp(1:jpoce,1,jwalk))*1.e+6/jpoce,&783 &MINVAL(pwcp(1:jpoce,1,jwalk)*1.e+6/densSW(1:jpoce))784 WRITE(numsed,*)'[DIC13] dissolved (8) (k=1)(µmol/l)(and min value in mol/kg of solution)'785 WRITE(numsed,'(4(F0.3,2X))') MINVAL(pwcp(1:jpoce,1,jwc13))*1.e+6,MAXVAL(pwcp(1:jpoce,1,jwc13))*1.e+6,&786 &SUM(pwcp(1:jpoce,1,jwc13))*1.e+6/jpoce,&787 &MINVAL(pwcp(1:jpoce,1,jwc13)*1.e+6/densSW(1:jpoce))788 WRITE(numsed,*)''789 WRITE(numsed,*)' Solid Components '790 WRITE(numsed,*)' ====================='791 WRITE(numsed,*)'nmole of Opale rained per dt'792 WRITE(numsed,'(3(1PE9.3,2X))') MINVAL(rainrm(1:jpoce,jsopal))*dtsed,MAXVAL(rainrm(1:jpoce,jsopal))*dtsed,&793 &SUM(rainrm(1:jpoce,1))*dtsed/jpoce794 WRITE(numsed,*)'nmole of Clay rained per dt'795 WRITE(numsed,'(3(1PE9.3,2X))') MINVAL(rainrm(1:jpoce,jsclay))*dtsed,MAXVAL(rainrm(1:jpoce,jsclay))*dtsed,&796 &SUM(rainrm(1:jpoce,jsclay))*dtsed/jpoce797 WRITE(numsed,*)'nmole of POC rained per dt'798 WRITE(numsed,'(3(1PE9.3,2X))') MINVAL(rainrm(1:jpoce,jspoc))*dtsed,MAXVAL(rainrm(1:jpoce,jspoc))*dtsed,&799 &SUM(rainrm(1:jpoce,jspoc))*dtsed/jpoce800 WRITE(numsed,*)'nmole of CaCO3 rained per dt'801 WRITE(numsed,'(3(1PE9.3,2X))') MINVAL(rainrm(1:jpoce,jscal))*dtsed,MAXVAL(rainrm(1:jpoce,jscal))*dtsed,&802 &SUM(rainrm(1:jpoce,jscal))*dtsed/jpoce803 WRITE(numsed,*)' '804 WRITE(numsed,*)'Weight frac of opal rained (%) '805 WRITE(numsed,'(3(F0.3,7X))') MINVAL(rainrg(1:jpoce,jsopal)/raintg(1:jpoce))*100.,&806 &MAXVAL(rainrg(1:jpoce,jsopal)/raintg(1:jpoce))*100.,&807 & SUM(rainrg(1:jpoce,jsopal)/raintg(1:jpoce))*100./jpoce808 WRITE(numsed,*)'Weight frac of clay rained (%) '809 WRITE(numsed,'(3(F0.3,7X))') MINVAL(rainrg(1:jpoce,jsclay)/raintg(1:jpoce))*100.,&810 &MAXVAL(rainrg(1:jpoce,jsclay)/raintg(1:jpoce))*100.,&811 &SUM(rainrg(1:jpoce,jsclay)/raintg(1:jpoce))*100./jpoce812 WRITE(numsed,*)'Weight frac of POC rained (%)'813 WRITE(numsed,'(3(F0.3,7X))') MINVAL(rainrg(1:jpoce,jspoc)/raintg(1:jpoce))*100.,&814 &MAXVAL(rainrg(1:jpoce,jspoc)/raintg(1:jpoce))*100.,&815 &SUM(rainrg(1:jpoce,jspoc)/raintg(1:jpoce))*100./jpoce816 WRITE(numsed,*)'Weight frac of CaCO3 rained (%)'817 WRITE(numsed,'(3(F0.3,7X))') MINVAL(rainrg(1:jpoce,jscal)/raintg(1:jpoce))*100.,&818 &MAXVAL(rainrg(1:jpoce,jscal)/raintg(1:jpoce))*100.,&819 &SUM(rainrg(1:jpoce,jscal)/raintg(1:jpoce))*100./jpoce820 WRITE(numsed,*)''821 WRITE(numsed,*)' Thickness of sediment layer added by particule rain, dzdep cm '822 WRITE(numsed,*)' =============================================================='823 WRITE(numsed,'(3(F0.5,2X))') MINVAL(dzdep(1:jpoce)),MAXVAL(dzdep(1:jpoce)),SUM(dzdep(1:jpoce))/jpoce824 WRITE(numsed,*)''825 WRITE(numsed,*)' chemical constants K1,pK1,K2,pK2,Kw,pKw and Kb pKb (min max) [mol/kgsol] or [mol/kgsol]2 '826 WRITE(numsed,*)' ========================================================================================='827 WRITE(numsed,'(4(1PE10.3,2X))')MINVAL(ak1s(1:jpoce)),MAXVAL(ak1s(1:jpoce)),-LOG10(MINVAL(ak1s(1:jpoce))),&828 &-LOG10(MAXVAL(ak1s(1:jpoce)))829 WRITE(numsed,'(4(1PE10.3,2X))')MINVAL(ak2s(1:jpoce)),MAXVAL(ak2s(1:jpoce)),-LOG10(MINVAL(ak2s(1:jpoce))),&830 &-LOG10(MAXVAL(ak2s(1:jpoce)))831 WRITE(numsed,'(4(1PE10.3,2X))')MINVAL(akws(1:jpoce)),MAXVAL(akws(1:jpoce)),-LOG10(MINVAL(akws(1:jpoce))),&832 &-LOG10(MAXVAL(akws(1:jpoce)))833 WRITE(numsed,'(4(1PE10.3,2X))')MINVAL(akbs(1:jpoce)),MAXVAL(akbs(1:jpoce)),-LOG10(MINVAL(akbs(1:jpoce))),&834 &-LOG10(MAXVAL(akbs(1:jpoce)))835 WRITE(numsed,*)'and boron'836 WRITE(numsed,'(2(1PE10.3,2X))')MINVAL(borats(1:jpoce)),MAXVAL(borats(1:jpoce))837 WRITE(numsed,*)''838 WRITE(numsed,*)' Compo of initial sediment for point jpoce'839 WRITE(numsed,*)' ========================================='840 WRITE(numsed,*)'solcp(1), solcp(2), solcp(3), solcp(4), hipor, pH, co3por'841 DO jk = 1,jpksed842 WRITE(numsed,'(7(1PE10.3,2X))')solcp(jpoce,jk,jsopal),solcp(jpoce,jk,jsclay),solcp(jpoce,jk,jspoc),solcp(jpoce,jk,jscal),&843 & hipor(jpoce,jk),-LOG10(hipor(jpoce,jk)/densSW(jpoce)),co3por(jpoce,jk)844 ENDDO845 WRITE(numsed,'(A82)')'pwcp(1), pwcp(2), pwcp(3), pwcp(4), pwcp(5), pwcp(6), pwcp(7)'846 DO jk = 1, jpksed847 WRITE(numsed,'(7(1PE10.3,2X))')pwcp(jpoce,jk,jwsil),pwcp(jpoce,jk,jwoxy),pwcp(jpoce,jk,jwdic),&848 & pwcp(jpoce,jk,jwno3),pwcp(jpoce,jk,jwpo4),pwcp(jpoce,jk,jwalk),pwcp(jpoce,jk,jwc13)849 ENDDO850 WRITE(numsed,*) ' '851 WRITE(numsed,*) ' End Of Initialization '852 WRITE(numsed,*) ' '853 !854 END SUBROUTINE sed_init_wri855 #else856 !!----------------------------------------------------------------------857 !! Dummy module : NO Sediment model858 !!----------------------------------------------------------------------859 !! $Id$860 CONTAINS861 SUBROUTINE sed_ini ! Empty routine862 END SUBROUTINE sed_ini863 #endif864 865 866 691 END MODULE sedini -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/TOP/PISCES/SED/sedmat.F90
r5215 r10345 1 1 MODULE sedmat 2 #if defined key_sed3 2 !!====================================================================== 4 3 !! *** MODULE sedmat *** … … 9 8 10 9 USE sed ! sediment global variable 10 USE lib_mpp ! distribued memory computing library 11 11 12 12 13 IMPLICIT NONE … … 25 26 CONTAINS 26 27 27 SUBROUTINE sed_mat_dsr( nvar, ndim, nlev, preac, ps ol)28 SUBROUTINE sed_mat_dsr( nvar, ndim, nlev, preac, psms, psol, dtsed_in ) 28 29 !!--------------------------------------------------------------------- 29 30 !! *** ROUTINE sed_mat_dsr *** … … 48 49 !!---------------------------------------------------------------------- 49 50 !! * Arguments 50 INTEGER , INTENT(in) :: nvar ! number of variable s51 INTEGER , INTENT(in) :: nvar ! number of variable 51 52 INTEGER , INTENT(in) :: ndim ! number of points 52 53 INTEGER , INTENT(in) :: nlev ! number of sediment levels 53 54 54 REAL(wp), DIMENSION(ndim,nlev,nvar), INTENT(in ) :: preac ! reaction rates 55 REAL(wp), DIMENSION(ndim,nlev,nvar), INTENT(inout) :: psol ! solution ( undersaturation values ) 55 REAL(wp), DIMENSION(ndim,nlev), INTENT(in ) :: preac ! reaction rates 56 REAL(wp), DIMENSION(ndim,nlev), INTENT(in ) :: psms ! reaction rates 57 REAL(wp), DIMENSION(ndim,nlev), INTENT(inout) :: psol ! solution ( undersaturation values ) 58 REAL(wp), INTENT(in) :: dtsed_in 56 59 57 60 !---Local declarations … … 67 70 !---------------------------------------------------------------------- 68 71 72 IF( ln_timing ) CALL timing_start('sed_mat_dsr') 69 73 70 74 ! Computation left hand side of linear system of … … 73 77 74 78 79 jn = nvar 75 80 ! first sediment level 76 81 DO ji = 1, ndim 77 aplus = ( ( volw3d(ji,1) / dz3d(ji,1) ) + &78 ( volw3d(ji,2) / dz3d(ji,2) ) ) / 2.82 aplus = ( ( volw3d(ji,1) / ( dz3d(ji,1) ) ) + & 83 ( volw3d(ji,2) / ( dz3d(ji,2) ) ) ) / 2. 79 84 dxplus = ( dz3d(ji,1) + dz3d(ji,2) ) / 2. 80 rplus = ( dtsed / volw3d(ji,1) ) * diff(1) * aplus / dxplus85 rplus = ( dtsed_in / ( volw3d(ji,1) ) ) * diff(ji,1,jn) * aplus / dxplus 81 86 82 87 za(ji,1) = 0. … … 87 92 DO jk = 2, nlev - 1 88 93 DO ji = 1, ndim 89 aminus = ( ( volw3d(ji,jk-1) / dz3d(ji,jk-1) ) + &90 & ( volw3d(ji,jk ) / dz3d(ji,jk) ) ) / 2.94 aminus = ( ( volw3d(ji,jk-1) / ( dz3d(ji,jk-1) ) ) + & 95 & ( volw3d(ji,jk ) / ( dz3d(ji,jk ) ) ) ) / 2. 91 96 dxminus = ( dz3d(ji,jk-1) + dz3d(ji,jk) ) / 2. 92 97 93 aplus = ( ( volw3d(ji,jk ) / dz3d(ji,jk) ) + &94 & ( volw3d(ji,jk+1) / dz3d(ji,jk+1) ) ) / 2.98 aplus = ( ( volw3d(ji,jk ) / ( dz3d(ji,jk ) ) ) + & 99 & ( volw3d(ji,jk+1) / ( dz3d(ji,jk+1) ) ) ) / 2. 95 100 dxplus = ( dz3d(ji,jk) + dz3d(ji,jk+1) ) / 2 96 !97 rminus = ( dtsed / volw3d(ji,jk) ) * diff(jk-1) * aminus / dxminus98 rplus = ( dtsed / volw3d(ji,jk) ) * diff(jk) * aplus / dxplus99 !101 ! 102 rminus = ( dtsed_in / volw3d(ji,jk) ) * diff(ji,jk-1,jn) * aminus / dxminus 103 rplus = ( dtsed_in / volw3d(ji,jk) ) * diff(ji,jk,jn) * aplus / dxplus 104 ! 100 105 za(ji,jk) = -rminus 101 106 zb(ji,jk) = 1. + rminus + rplus … … 105 110 106 111 DO ji = 1, ndim 107 aminus = ( ( volw3d(ji,nlev-1) / dz3d(ji,nlev-1) ) + &108 112 aminus = ( ( volw3d(ji,nlev-1) / dz3d(ji,nlev-1) ) + & 113 & ( volw3d(ji,nlev) / dz3d(ji,nlev) ) ) / 2. 109 114 dxminus = ( dz3d(ji,nlev-1) + dz3d(ji,nlev) ) / 2. 110 rminus = ( dtsed / volw3d(ji,nlev) ) * diff(nlev-1) * aminus / dxminus115 rminus = ( dtsed_in / volw3d(ji,nlev) ) * diff(ji,nlev-1,jn) * aminus / dxminus 111 116 ! 112 117 za(ji,nlev) = -rminus … … 119 124 ! ----------------------------------------------- 120 125 121 DO jn = 1, nvar122 123 zr (:,:) = psol(:,:,jn)124 zbet(: ) = zb(:,1) + preac(:,1,jn)125 psol(:,1,jn) = zr(:,1) / zbet(:) 126 zr (:,:) = psol(:,:) + psms(:,:) 127 zb (:,:) = zb(:,:) + preac(:,:) 128 zbet(: ) = zb(:,1) 129 psol(:,1) = zr(:,1) / zbet(:) 130 126 131 ! 127 128 129 zgamm(ji,jk)= zc(ji,jk-1) / zbet(ji)130 zbet(ji) = ( zb(ji,jk) + preac(ji,jk,jn)) - za(ji,jk) * zgamm(ji,jk)131 psol(ji,jk,jn) = ( zr(ji,jk) - za(ji,jk) * psol(ji,jk-1,jn) ) / zbet(ji)132 133 132 DO jk = 2, nlev 133 DO ji = 1, ndim 134 zgamm(ji,jk) = zc(ji,jk-1) / zbet(ji) 135 zbet(ji) = zb(ji,jk) - za(ji,jk) * zgamm(ji,jk) 136 psol(ji,jk) = ( zr(ji,jk) - za(ji,jk) * psol(ji,jk-1) ) / zbet(ji) 137 END DO 138 ENDDO 134 139 ! 135 DO jk = nlev - 1, 1, -1 136 DO ji = 1,ndim 137 psol(ji,jk,jn) = psol(ji,jk,jn) - zgamm(ji,jk+1) * psol(ji,jk+1,jn) 138 END DO 139 ENDDO 140 140 DO jk = nlev - 1, 1, -1 141 DO ji = 1,ndim 142 psol(ji,jk) = psol(ji,jk) - zgamm(ji,jk+1) * psol(ji,jk+1) 143 END DO 141 144 ENDDO 142 145 146 IF( ln_timing ) CALL timing_stop('sed_mat_dsr') 147 143 148 144 149 END SUBROUTINE sed_mat_dsr 145 150 146 147 SUBROUTINE sed_mat_btb( nvar, ndim, nlev, psol ) 151 SUBROUTINE sed_mat_btb( nvar, ndim, nlev, psol, dtsed_in ) 148 152 !!--------------------------------------------------------------------- 149 153 !! *** ROUTINE sed_mat_btb *** … … 170 174 psol ! solution 171 175 176 REAL(wp), INTENT(in) :: dtsed_in 177 172 178 !---Local declarations 173 179 INTEGER :: & … … 192 198 193 199 200 IF( ln_timing ) CALL timing_start('sed_mat_btb') 201 194 202 ! first sediment level 195 aplus = ( ( vols(2) / dz(2) ) + ( vols(3) / dz(3) ) ) / 2. 196 dxplus = ( dz(2) + dz(3) ) / 2. 197 rplus = ( dtsed / vols(2) ) * db * aplus / dxplus 198 199 za(1) = 0. 200 zb(1) = 1. + rplus 201 zc(1) = -rplus 203 DO ji = 1, ndim 204 aplus = ( ( vols(2) / dz(2) ) + ( vols(3) / dz(3) ) ) / 2. 205 dxplus = ( dz(2) + dz(3) ) / 2. 206 rplus = ( dtsed_in / vols(2) ) * db(ji,2) * aplus / dxplus 207 208 za(1) = 0. 209 zb(1) = 1. + rplus 210 zc(1) = -rplus 202 211 203 212 204 DO jk = 2, nlev - 1 205 aminus = ( ( vols(jk) / dz(jk) ) + ( vols(jk+1) / dz(jk+1) ) ) / 2. 206 dxminus = ( dz(jk) + dz(jk+1) ) / 2. 207 rminus = ( dtsed / vols(jk+1) ) * db * aminus / dxminus 208 ! 209 aplus = ( ( vols(jk+1) / dz(jk+1 ) ) + ( vols(jk+2) / dz(jk+2) ) ) / 2. 210 dxplus = ( dz(jk+1) + dz(jk+2) ) / 2. 211 rplus = ( dtsed / vols(jk+1) ) * db * aplus / dxplus 212 ! 213 za(jk) = -rminus 214 zb(jk) = 1. + rminus + rplus 215 zc(jk) = -rplus 216 ENDDO 217 218 aminus = ( ( vols(nlev) / dz(nlev) ) + ( vols(nlev+1) / dz(nlev+1) ) ) / 2. 219 dxminus = ( dz(nlev) + dz(nlev+1) ) / 2. 220 rminus = ( dtsed / vols(nlev+1) ) * db * aminus / dxminus 213 DO jk = 2, nlev - 1 214 aminus = ( ( vols(jk) / dz(jk) ) + ( vols(jk+1) / dz(jk+1) ) ) / 2. 215 dxminus = ( dz(jk) + dz(jk+1) ) / 2. 216 rminus = ( dtsed_in / vols(jk+1) ) * db(ji,jk) * aminus / dxminus 217 ! 218 aplus = ( ( vols(jk+1) / dz(jk+1 ) ) + ( vols(jk+2) / dz(jk+2) ) ) / 2. 219 dxplus = ( dz(jk+1) + dz(jk+2) ) / 2. 220 rplus = ( dtsed_in / vols(jk+1) ) * db(ji,jk+1) * aplus / dxplus 221 ! 222 za(jk) = -rminus 223 zb(jk) = 1. + rminus + rplus 224 zc(jk) = -rplus 225 ENDDO 226 227 aminus = ( ( vols(nlev) / dz(nlev) ) + ( vols(nlev+1) / dz(nlev+1) ) ) / 2. 228 dxminus = ( dz(nlev) + dz(nlev+1) ) / 2. 229 rminus = ( dtsed_in / vols(nlev+1) ) * db(ji,nlev) * aminus / dxminus 230 ! 231 za(nlev) = -rminus 232 zb(nlev) = 1. + rminus 233 zc(nlev) = 0. 234 235 236 ! solves tridiagonal system of linear equations 237 ! ----------------------------------------------- 238 DO jn = 1, nvar 239 240 DO jk = 1, nlev 241 zr (ji,jk) = psol(ji,jk,jn) 242 END DO 243 zbet = zb(1) 244 psol(ji,1,jn) = zr(ji,1) / zbet 245 ! 246 DO jk = 2, nlev 247 zgamm(jk) = zc(jk-1) / zbet 248 zbet = zb(jk) - za(jk) * zgamm(jk) 249 psol(ji,jk,jn) = ( zr(ji,jk) - za(jk) * psol(ji,jk-1,jn) ) / zbet 250 ENDDO 251 ! 252 DO jk = nlev - 1, 1, -1 253 psol(ji,jk,jn) = psol(ji,jk,jn) - zgamm(jk+1) * psol(ji,jk+1,jn) 254 ENDDO 255 256 ENDDO 257 258 END DO 221 259 ! 222 223 za(nlev) = -rminus 224 zb(nlev) = 1. + rminus 225 zc(nlev) = 0. 226 227 228 ! solves tridiagonal system of linear equations 229 ! ----------------------------------------------- 230 DO jn = 1, nvar 231 232 zr (:,:) = psol(:,:,jn) 233 zbet = zb(1) 234 psol(:,1,jn) = zr(:,1) / zbet 235 ! 236 DO jk = 2, nlev 237 zgamm(jk) = zc(jk-1) / zbet 238 zbet = zb(jk) - za(jk) * zgamm(jk) 239 DO ji = 1, ndim 240 psol(ji,jk,jn) = ( zr(ji,jk) - za(jk) * psol(ji,jk-1,jn) ) / zbet 241 END DO 242 ENDDO 243 ! 244 DO jk = nlev - 1, 1, -1 245 DO ji = 1,ndim 246 psol(ji,jk,jn) = psol(ji,jk,jn) - zgamm(jk+1) * psol(ji,jk+1,jn) 247 END DO 248 ENDDO 249 250 ENDDO 260 IF( ln_timing ) CALL timing_stop('sed_mat_btb') 251 261 252 262 253 263 END SUBROUTINE sed_mat_btb 254 264 255 256 #else257 !!======================================================================258 !! MODULE sedmat : Dummy module259 !!======================================================================260 !! $Id$261 CONTAINS262 SUBROUTINE sed_mat ! Empty routine263 END SUBROUTINE sed_mat264 !!======================================================================265 #endif266 267 265 END MODULE sedmat -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/TOP/PISCES/SED/sedmbc.F90
r5215 r10345 1 1 MODULE sedmbc 2 #if defined key_sed3 2 !!====================================================================== 4 3 !! *** MODULE sedmbc *** … … 12 11 USE sed ! sediment global variable 13 12 USE seddsr 13 USE lib_mpp ! distribued memory computing library 14 14 15 15 IMPLICIT NONE … … 27 27 REAL(wp), DIMENSION(jpwat) :: diss_in_tot ! total input in pore water 28 28 REAL(wp), DIMENSION(jpwat) :: diss_out_tot ! total output from pore water 29 30 REAL(wp) :: cons_tot_o2 ! cumulative o2 consomation31 REAL(wp) :: sour_tot_no3 ! cumulative no3 source32 REAL(wp) :: cons_tot_no3 ! cumulative no3 consomation33 REAL(wp) :: sour_tot_c13 ! cumulative o2 source34 35 REAL(wp) :: src13p36 REAL(wp) :: src13ca37 29 38 30 !! $Id$ … … 67 59 REAL, DIMENSION(jpwat) :: zpwcp_inv_i, zpwcp_inv_f 68 60 REAL(wp) :: zdelta_sil, zdelta_clay 69 REAL(wp) :: zdelta_co2, zdelta_ oxy61 REAL(wp) :: zdelta_co2, zdelta_fe 70 62 REAL(wp) :: zdelta_po4, zdelta_no3 71 REAL(wp) :: zdelta_c13, zdelta_c13b72 63 73 64 !!---------------------------------------------------------------------- 74 65 ! Initilization 75 66 !--------------- 67 IF( ln_timing ) CALL timing_start('sed_mbc') 68 ! 76 69 IF( kt == nitsed000 ) THEN 77 cons_tot_o2 = 0.78 sour_tot_no3 = 0.79 cons_tot_no3 = 0.80 sour_tot_c13 = 0.81 70 82 71 DO js = 1, jpsol … … 92 81 ENDDO 93 82 94 src13p = rc13P * pdb95 src13ca = rc13Ca * pdb96 83 ENDIF 97 84 … … 106 93 ! input [mol] 107 94 rain_tot (js) = rain_tot (js) + dtsed * rainrm_dta(ji,js) 108 fromsed_tot(js) = fromsed_tot(js) + fromsed(ji,js) 95 fromsed_tot(js) = fromsed_tot(js) + fromsed(ji,js) / mol_wgt(js) 109 96 ! output [mol] 110 tosed_tot (js) = tosed_tot (js) + tosed(ji,js) 111 rloss_tot (js) = rloss_tot (js) + rloss(ji,js) 97 tosed_tot (js) = tosed_tot (js) + tosed(ji,js) / mol_wgt(js) 98 rloss_tot (js) = rloss_tot (js) + rloss(ji,js) / mol_wgt(js) 112 99 ENDDO 113 100 ENDDO … … 122 109 ENDDO 123 110 ENDDO 124 125 ! cumulativ o2 and no3 consomation126 DO ji = 1, jpoce127 cons_tot_o2 = cons_tot_o2 + cons_o2 (ji)128 sour_tot_no3 = sour_tot_no3 + sour_no3(ji)129 cons_tot_no3 = cons_tot_no3 + cons_no3(ji)130 sour_tot_c13 = sour_tot_c13 + sour_c13(ji)131 ENDDO132 133 111 134 112 ! Mass balance check … … 141 119 zpwcp_inv_f (:) = 0. 142 120 DO js = 1, jpsol 143 zdsw = dens / mol_wgt(js)121 zdsw = denssol / mol_wgt(js) 144 122 DO jk = 2, jpksed 145 123 DO ji = 1, jpoce … … 178 156 179 157 ! mass balance for carbon ( carbon in POC, CaCo3, DIC ) 180 zinit = zsolcp_inv_i(jspoc) + zsolcp_inv_i(jscal) + zpwcp_inv_i(jwdic) 181 zfinal = zsolcp_inv_f(jspoc) + zsolcp_inv_f(jscal) + zpwcp_inv_f(jwdic) 182 zinput = rain_tot (jspoc) + rain_tot (jscal) + diss_in_tot(jwdic) 183 zoutput = tosed_tot (jspoc) + tosed_tot (jscal) + diss_out_tot(jwdic) & 184 & + rloss_tot (jspoc) + rloss_tot (jscal) 158 zinit = zsolcp_inv_i(jspoc) + zsolcp_inv_i(jspos) + zsolcp_inv_i(jspor) & 159 & + zsolcp_inv_i(jscal) + zpwcp_inv_i(jwdic) 160 zfinal = zsolcp_inv_f(jspoc) + zsolcp_inv_f(jspos) + zsolcp_inv_f(jspor) & 161 & + zsolcp_inv_f(jscal) + zpwcp_inv_f(jwdic) 162 zinput = rain_tot (jspoc) + rain_tot (jspos) + rain_tot (jspor) & 163 & + rain_tot (jscal) + diss_in_tot(jwdic) 164 zoutput = tosed_tot(jspoc) + tosed_tot(jspos) + tosed_tot(jspor) + tosed_tot(jscal) + diss_out_tot(jwdic) & 165 & + rloss_tot(jspoc) + rloss_tot(jspos) + rloss_tot(jspor) + rloss_tot(jscal) 185 166 zdelta_co2 = ( zfinal + zoutput ) - ( zinit + zinput ) 186 167 187 ! mass balance for oxygen : O2 is in POC remineralization 188 zinit = zpwcp_inv_i(jwoxy) 189 zfinal = zpwcp_inv_f(jwoxy) 190 zinput = diss_in_tot(jwoxy) 191 zoutput = diss_out_tot(jwoxy) + cons_tot_o2 192 zdelta_oxy = ( zfinal + zoutput ) - ( zinit + zinput ) 193 194 ! mass balance for phosphate ( PO4 in POC and dissolved phosphates ) 195 zinit = zsolcp_inv_i(jspoc) * spo4r + zpwcp_inv_i(jwpo4) 196 zfinal = zsolcp_inv_f(jspoc) * spo4r + zpwcp_inv_f(jwpo4) 197 zinput = rain_tot (jspoc) * spo4r + diss_in_tot(jwpo4) 198 zoutput = tosed_tot (jspoc) * spo4r + diss_out_tot(jwpo4) & 199 & + rloss_tot (jspoc) * spo4r 200 zdelta_po4 = ( zfinal + zoutput ) - ( zinit + zinput ) 201 202 203 ! mass balance for Nitrate 204 zinit = zpwcp_inv_i (jwno3) 205 zfinal = zpwcp_inv_f (jwno3) 206 zinput = diss_in_tot (jwno3) + sour_tot_no3 207 zoutput = diss_out_tot(jwno3) + cons_tot_no3 168 ! mass balance for Sulfur 169 zinit = zpwcp_inv_i(jwso4) + zpwcp_inv_i(jwh2s) & 170 & + zsolcp_inv_i(jsfes) 171 zfinal = zpwcp_inv_f(jwso4) + zpwcp_inv_f(jwh2s) & 172 & + zsolcp_inv_f(jsfes) 173 zinput = diss_in_tot (jwso4) + diss_in_tot (jwh2s) & 174 & + rain_tot (jsfes) 175 zoutput = diss_out_tot(jwso4) + diss_out_tot(jwh2s) & 176 & + tosed_tot(jsfes) + rloss_tot(jsfes) 208 177 zdelta_no3 = ( zfinal + zoutput ) - ( zinit + zinput ) 209 178 210 ! mass balance for DIC13 211 zinit = zpwcp_inv_i(jwc13) & 212 & + src13p * zsolcp_inv_i(jspoc) + src13Ca * zsolcp_inv_i(jscal) 213 zfinal = zpwcp_inv_f(jwc13) & 214 & + src13p * zsolcp_inv_f(jspoc) + src13Ca * zsolcp_inv_f(jscal) 215 zinput = diss_in_tot (jwc13) & 216 & + src13p * rain_tot(jspoc) + src13Ca * rain_tot(jscal) 217 zoutput = diss_out_tot(jwc13) & 218 & + src13p * tosed_tot(jspoc) + src13Ca * tosed_tot(jscal) & 219 & + src13p * rloss_tot(jspoc) + src13Ca * rloss_tot(jscal) 220 zdelta_c13 = ( zfinal + zoutput ) - ( zinit + zinput ) 221 222 ! other mass balance for DIC13 223 zinit = zpwcp_inv_i (jwc13) 224 zfinal = zpwcp_inv_f (jwc13) 225 zinput = diss_in_tot (jwc13) + sour_tot_c13 226 zoutput = diss_out_tot(jwc13) 227 zdelta_c13b= ( zfinal + zoutput ) - ( zinit + zinput ) 179 ! mass balance for iron 180 zinit = zpwcp_inv_i(jwfe2) + zsolcp_inv_i(jsfeo) & 181 & + zsolcp_inv_i(jsfes) 182 zfinal = zpwcp_inv_f(jwfe2) + zsolcp_inv_f(jsfeo) & 183 & + zsolcp_inv_f(jsfes) 184 zinput = diss_in_tot (jwfe2) + rain_tot (jsfeo) & 185 & + rain_tot (jsfes) 186 zoutput = diss_out_tot(jwfe2) + tosed_tot(jsfeo) & 187 & + tosed_tot(jsfes) + rloss_tot(jsfes) + rloss_tot(jsfeo) 188 zdelta_fe = ( zfinal + zoutput ) - ( zinit + zinput ) 189 228 190 229 191 END IF … … 231 193 IF( kt == nitsedend) THEN 232 194 195 IF (lwp) THEN 233 196 WRITE(numsed,*) 234 197 WRITE(numsed,*)'================== General mass balance ================== ' 235 198 WRITE(numsed,*)' ' 236 199 WRITE(numsed,*)' ' 237 WRITE(numsed,*)' Initial total solid Masses (mole/dx.dy) (k=2-11)'200 WRITE(numsed,*)' Initial total solid Masses (mole/dx.dy) ' 238 201 WRITE(numsed,*)' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 239 WRITE(numsed,*)' Opal e, Clay, POC, CaCO3, C13'240 WRITE(numsed,'( 4x,5(1PE10.3,2X))')zsolcp_inv_i(jsopal),zsolcp_inv_i(jsclay),zsolcp_inv_i(jspoc), &241 & zsolcp_inv_i(js cal),( src13P * zsolcp_inv_i(jspoc) + src13Ca * zsolcp_inv_i(jscal))242 WRITE(numsed,*)' ' 243 WRITE(numsed,*)' Initial total dissolved Masses (mole/dx.dy) (k=2-11)'202 WRITE(numsed,*)' Opal, Clay, POC, POS, POR, CaCO3, FeOH, FeS' 203 WRITE(numsed,'(8x,4(1PE10.3,2X))')zsolcp_inv_i(jsopal),zsolcp_inv_i(jsclay),zsolcp_inv_i(jspoc), & 204 & zsolcp_inv_i(jspos),zsolcp_inv_i(jspor),zsolcp_inv_i(jscal),zsolcp_inv_i(jsfeo),zsolcp_inv_i(jsfes) 205 WRITE(numsed,*)' ' 206 WRITE(numsed,*)' Initial total dissolved Masses (mole/dx.dy) ' 244 207 WRITE(numsed,*)' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 245 WRITE(numsed,*)' Si, O2, DIC, Nit Phos, DIC13' 246 WRITE(numsed,'(4x,6(1PE10.3,2X))') zpwcp_inv_i(jwsil), zpwcp_inv_i(jwoxy), & 247 & zpwcp_inv_i(jwdic), zpwcp_inv_i(jwno3), zpwcp_inv_i(jwpo4), zpwcp_inv_i(jwc13) 248 WRITE(numsed,*)' ' 249 WRITE(numsed,*)' Solid inputs : Opale, Clay, POC, CaCO3, C13' 250 WRITE(numsed,'(A4,10X,5(1PE10.3,2X))')'Rain : ',rain_tot(jsopal),rain_tot(jsclay),rain_tot(jspoc),& 251 & rain_tot(jscal),( src13P * rain_tot(jspoc) + src13Ca * rain_tot(jscal) ) 252 WRITE(numsed,'(A12,6x,4(1PE10.3,2X))')' From Sed : ',fromsed_tot(jsopal), fromsed_tot(jsclay), & 253 & fromsed_tot(jspoc), fromsed_tot(jscal) 254 WRITE(numsed,*)'Diss. inputs : Si, O2, DIC, Nit, Phos, DIC13' 208 WRITE(numsed,*)' Si, O2, DIC, Nit, Phos, Fe2+' 209 WRITE(numsed,'(5x,5(1PE10.3,2X))') zpwcp_inv_i(jwsil), zpwcp_inv_i(jwoxy), & 210 & zpwcp_inv_i(jwdic), zpwcp_inv_i(jwno3), zpwcp_inv_i(jwpo4), zpwcp_inv_i(jwfe2) 211 WRITE(numsed,*)' ' 212 WRITE(numsed,*)' Solid inputs : Opale, Clay, POC, CaCO3, Fe' 213 WRITE(numsed,'(A4,10X,5(1PE10.3,2X))')'Rain : ',rain_tot(jsopal),rain_tot(jsclay),rain_tot(jspoc) + rain_tot(jspos) + rain_tot(jspor),& 214 & rain_tot(jscal), rain_tot(jsfeo) 215 WRITE(numsed,'(A12,6x,5(1PE10.3,2X))')' From Sed : ',fromsed_tot(jsopal), fromsed_tot(jsclay), & 216 & fromsed_tot(jspoc)+fromsed_tot(jspos)+fromsed_tot(jspor), fromsed_tot(jscal), & 217 & fromsed_tot(jsfeo) + fromsed_tot(jsfes) 218 WRITE(numsed,*)'Diss. inputs : Si, O2, DIC, Nit, Phos, Fe' 255 219 WRITE(numsed,'(A9,1x,6(1PE10.3,2X))')' From Pisc : ', diss_in_tot(jwsil), & 256 & diss_in_tot(jwoxy), diss_in_tot(jwdic), diss_in_tot(jwno3), diss_in_tot(jwpo4), & 257 & diss_in_tot(jwc13) 258 WRITE(numsed,*)' ' 259 WRITE(numsed,*)'Solid output : Opale, Clay, POC, CaCO3, C13' 260 WRITE(numsed,'(A6,8x,5(1PE10.3,2X))')'To sed', tosed_tot(jsopal),tosed_tot(jsclay),tosed_tot(jspoc),& 261 & tosed_tot(jscal),( src13P * tosed_tot(jspoc) + src13Ca * tosed_tot(jscal) ) 262 WRITE(numsed,'(A5,9x,5(1PE10.3,2X))')'Perdu', rloss_tot(jsopal),rloss_tot(jsclay),rloss_tot(jspoc),& 263 & rloss_tot(jscal),( src13P * rloss_tot(jspoc) + src13Ca * rloss_tot(jscal) ) 264 WRITE(numsed,*)'Diss. output : Si, O2, DIC, Nit, Phos, DIC13 ' 220 & diss_in_tot(jwoxy), diss_in_tot(jwdic), diss_in_tot(jwno3), diss_in_tot(jwpo4), diss_in_tot(jwfe2) 221 WRITE(numsed,*)' ' 222 WRITE(numsed,*)'Solid output : Opale, Clay, POC, CaCO3, Fe' 223 WRITE(numsed,'(A6,8x,5(1PE10.3,2X))')'To sed', tosed_tot(jsopal),tosed_tot(jsclay),tosed_tot(jspoc) & 224 & +tosed_tot(jspos)+tosed_tot(jspor),tosed_tot(jscal), tosed_tot(jsfeo)+tosed_tot(jsfes) 225 WRITE(numsed,'(A5,9x,5(1PE10.3,2X))')'Perdu', rloss_tot(jsopal),rloss_tot(jsclay),rloss_tot(jspoc) & 226 & +rloss_tot(jspos)+rloss_tot(jspor),rloss_tot(jscal),rloss_tot(jsfeo)+rloss_tot(jsfes) 227 WRITE(numsed,*)'Diss. output : Si, O2, DIC, Nit, Phos, Fe ' 265 228 WRITE(numsed,'(A7,2x,6(1PE10.3,2X))')'To kbot', diss_out_tot(jwsil), & 266 & diss_out_tot(jwoxy), diss_out_tot(jwdic), diss_out_tot(jwno3), diss_out_tot(jwpo4), & 267 & diss_out_tot(jwc13) 268 WRITE(numsed,*)' ' 269 WRITE(numsed,*)' Total consomation in POC remineralization [mol]: O2, NO3' 270 WRITE(numsed,'(51x,2(1PE10.3,2X))') cons_tot_o2,cons_tot_no3 271 WRITE(numsed,*)' ' 272 WRITE(numsed,*)'Final solid Masses (mole/dx.dy) (k=2-11)' 273 WRITE(numsed,*)' Opale, Clay, POC, CaCO3, C13' 274 WRITE(numsed,'(4x,5(1PE10.3,2X))')zsolcp_inv_f(jsopal),zsolcp_inv_f(jsclay),zsolcp_inv_f(jspoc), & 275 & zsolcp_inv_f(jscal),( src13P * zsolcp_inv_f(jspoc) + src13Ca * zsolcp_inv_f(jscal) ) 229 & diss_out_tot(jwoxy), diss_out_tot(jwdic), diss_out_tot(jwno3), diss_out_tot(jwpo4), diss_out_tot(jwfe2) 230 WRITE(numsed,*)' ' 231 WRITE(numsed,*)'Final solid Masses (mole/dx.dy) ' 232 WRITE(numsed,*)' Opale, Clay, POC, CaCO3, Fe' 233 WRITE(numsed,'(4x,5(1PE10.3,2X))')zsolcp_inv_f(jsopal),zsolcp_inv_f(jsclay),zsolcp_inv_f(jspoc) & 234 & +zsolcp_inv_f(jspos)+zsolcp_inv_f(jspor),zsolcp_inv_f(jscal),zsolcp_inv_f(jsfeo)+zsolcp_inv_f(jsfes) 276 235 WRITE(numsed,*)' ' 277 236 WRITE(numsed,*)'Final dissolved Masses (mole/dx.dy) (k=2-11)' 278 WRITE(numsed,*)' Si, O2, DIC, Nit, Phos, DIC13'237 WRITE(numsed,*)' Si, O2, DIC, Nit, Phos, Fe' 279 238 WRITE(numsed,'(4x,6(1PE10.3,2X))') zpwcp_inv_f(jwsil), zpwcp_inv_f(jwoxy), & 280 & zpwcp_inv_f(jwdic), zpwcp_inv_f(jwno3), zpwcp_inv_f(jwpo4), zpwcp_inv_f(jw c13)239 & zpwcp_inv_f(jwdic), zpwcp_inv_f(jwno3), zpwcp_inv_f(jwpo4), zpwcp_inv_f(jwfe2) 281 240 WRITE(numsed,*)' ' 282 WRITE(numsed,*)'Delta : Opale, Clay, C, O, N, P, C13' 283 WRITE(numsed,'(7x,7(1PE11.3,1X))') zdelta_sil, zdelta_clay, zdelta_co2, zdelta_oxy, zdelta_no3,& 284 & zdelta_po4, zdelta_c13 285 WRITE(numsed,*)' ' 286 WRITE(numsed,*)'deltaC13bis : ',zdelta_c13b 287 241 WRITE(numsed,*)'Delta : Opale, Clay, C, Fe, S,' 242 WRITE(numsed,'(7x,6(1PE11.3,1X))') zdelta_sil / ( zsolcp_inv_i(jsopal) + zpwcp_inv_i(jwsil) ) , & 243 & zdelta_clay / ( zsolcp_inv_i(jsclay) ) , & 244 & zdelta_co2 / ( zsolcp_inv_i(jspoc) + zsolcp_inv_i(jspos) + zsolcp_inv_i(jspor) & 245 & + zsolcp_inv_i(jscal) + zpwcp_inv_i(jwdic) ), & 246 & zdelta_fe / ( zpwcp_inv_i(jwfe2) + zsolcp_inv_i(jsfeo) + zsolcp_inv_i(jsfes) ) , & 247 & zdelta_no3 / ( zpwcp_inv_i(jwso4) + zpwcp_inv_i(jwh2s) + zsolcp_inv_i(jsfes) ) 288 248 WRITE(numsed,*)'==========================================================================' 289 WRITE(numsed,*)' Composition of final sediment for point jpoce'290 WRITE(numsed,*)' ========================================='291 WRITE(numsed,*)'Opale, Clay, POC, CaCo3, hipor, pH, co3por'292 DO jk = 1,jpksed293 WRITE(numsed,'(4(F8.4,4X),3(1PE10.3,2X))') solcp(jpoce,jk,jsopal)*100.,solcp(jpoce,jk,jsclay)*100.,&294 & solcp(jpoce,jk,jspoc)*100.,solcp(jpoce,jk,jscal)*100.,&295 & hipor(jpoce,jk),-LOG10(hipor(jpoce,jk)/densSW(jpoce)),co3por(jpoce,jk)296 ENDDO297 WRITE(numsed,*)'Silicic A., Oxygen, DIC, Nitrats, Phosphats, Alkal., DIC13'298 DO jk = 1, jpksed299 WRITE(numsed,'(8(1PE10.3,2X))')pwcp(jpoce,jk,jwsil),pwcp(jpoce,jk,jwoxy),&300 & pwcp(jpoce,jk,jwdic),pwcp(jpoce,jk,jwno3),pwcp(jpoce,jk,jwpo4),pwcp(jpoce,jk,jwalk),pwcp(jpoce,jk,jwc13)301 ENDDO302 WRITE(numsed,*)'densSW at the end : ',densSW(jpoce)303 WRITE(numsed,*)'=========================================================================='304 249 305 250 ENDIF 251 ENDIF 252 253 IF( ln_timing ) CALL timing_stop('sed_mbc') 306 254 307 255 END SUBROUTINE sed_mbc 308 256 309 310 #else311 !!======================================================================312 !! MODULE sedmbc : Dummy module313 !!======================================================================314 !! $Id$315 CONTAINS316 SUBROUTINE sed_mbc( kt ) ! Empty routine317 INTEGER, INTENT(in) :: kt318 WRITE(*,*) 'sed_mbc: You should not have seen this print! error?', kt319 END SUBROUTINE sed_mbc320 #endif321 257 END MODULE sedmbc -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/TOP/PISCES/SED/sedmodel.F90
r7646 r10345 1 1 MODULE sedmodel 2 #if defined key_sed3 2 !!====================================================================== 4 3 !! *** MODULE sedmodel *** … … 6 5 !!====================================================================== 7 6 USE sed 8 USE sedini ! sediment variables initialization9 7 USE sedstp ! time stepping 8 USE sedinitrc 10 9 11 10 IMPLICIT NONE … … 33 32 34 33 35 IF( kt == nittrc000 ) CALL sed_init ! Initialization of sediment model34 IF( ln_timing ) CALL timing_start('sed_model') 36 35 37 CALL sed_stp( kt ) ! Time stepping of Sediment model 36 IF( kt == nittrc000 ) CALL sed_initrc ! Initialization of sediment model 37 CALL sed_stp( kt ) ! Time stepping of Sediment model 38 38 39 IF( ln_timing ) CALL timing_stop('sed_model') 39 40 40 41 END SUBROUTINE sed_model 41 42 42 #else43 !!======================================================================44 !! MODULE sedmodel : Dummy module45 !!======================================================================46 CONTAINS47 SUBROUTINE sed_model( kt ) ! Empty routine48 INTEGER, INTENT(in) :: kt49 WRITE(*,*) 'sed_stp: You should not have seen this print! error?', kt50 END SUBROUTINE sed_model51 #endif52 53 43 END MODULE sedmodel -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/TOP/PISCES/SED/sedrst.F90
r6140 r10345 1 1 MODULE sedrst 2 #if defined key_sed3 2 !!====================================================================== 4 3 !! *** MODULE sedrst *** … … 11 10 USE sed 12 11 USE sedarr 12 USE trc_oce, ONLY : l_offline, nn_dttrc 13 USE phycst , ONLY : rday 14 USE iom 15 USE daymod 16 USE lib_mpp ! distribued memory computing library 13 17 14 18 … … 18 22 19 23 !! * Accessibility 24 PUBLIC sed_rst_opn ! called by ??? 20 25 PUBLIC sed_rst_read 21 26 PUBLIC sed_rst_wri 22 23 !! * Module variables 24 INTEGER, PUBLIC :: numrsr, numrsw !: logical unit for sed restart (read and write) 25 26 27 PUBLIC sed_rst_cal 28 27 29 !! $Id$ 28 30 CONTAINS 29 31 32 33 SUBROUTINE sed_rst_opn( kt ) 34 !!---------------------------------------------------------------------- 35 !! *** sed_rst_opn *** 36 !! 37 !! ** purpose : output of sed-trc variable in a netcdf file 38 !!---------------------------------------------------------------------- 39 INTEGER, INTENT(in) :: kt ! number of iteration 40 ! 41 CHARACTER(LEN=20) :: clkt ! ocean time-step define as a character 42 CHARACTER(LEN=50) :: clname ! trc output restart file name 43 CHARACTER(LEN=256) :: clpath ! full path to ocean output restart file 44 !!---------------------------------------------------------------------- 45 ! 46 IF( l_offline ) THEN 47 IF( kt == nittrc000 ) THEN 48 lrst_sed = .FALSE. 49 IF( ln_rst_list ) THEN 50 nrst_lst = 1 51 nitrst = nstocklist( nrst_lst ) 52 ELSE 53 nitrst = nitend 54 ENDIF 55 ENDIF 56 IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nstock ) == 0 ) THEN 57 ! we use kt - 1 and not kt - nittrc000 to keep the same periodicity from the beginning of the experiment 58 nitrst = kt + nstock - 1 ! define the next value of nitrst for restart writing 59 IF( nitrst > nitend ) nitrst = nitend ! make sure we write a restart at the end of the run 60 ENDIF 61 ELSE 62 IF( kt == nittrc000 ) lrst_sed = .FALSE. 63 ENDIF 64 65 ! to get better performances with NetCDF format: 66 ! we open and define the tracer restart file one tracer time step before writing the data (-> at nitrst - 2*nn_dttrc + 1) 67 ! except if we write tracer restart files every tracer time step or if a tracer restart file was writen at nitend - 2*nn_dttrc + 1 68 IF( kt == nitrst - 2*nn_dtsed .OR. nstock == nn_dtsed .OR. ( kt == nitend - nn_dtsed .AND. .NOT. lrst_sed ) ) THEN 69 ! beware of the format used to write kt (default is i8.8, that should be large enough) 70 IF( nitrst > 1.0e9 ) THEN ; WRITE(clkt,* ) nitrst 71 ELSE ; WRITE(clkt,'(i8.8)') nitrst 72 ENDIF 73 ! create the file 74 IF(lwp) WRITE(numsed,*) 75 clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_sedrst_out) 76 clpath = TRIM(cn_sedrst_outdir) 77 IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 78 IF(lwp) WRITE(numsed,*) & 79 ' open sed restart.output NetCDF file: ',TRIM(clpath)//clname 80 CALL iom_open( TRIM(clpath)//TRIM(clname), numrsw, ldwrt = .TRUE., kiolib = jprstlib, kdlev = jpksed ) 81 lrst_sed = .TRUE. 82 ENDIF 83 ! 84 END SUBROUTINE sed_rst_opn 30 85 31 86 SUBROUTINE sed_rst_read … … 40 95 !! ! 06-07 (C. Ethe) original 41 96 !!---------------------------------------------------------------------- 42 !! * Modules used43 USE iom44 97 45 98 !! * local declarations 46 INTEGER :: ji, jk, jn 47 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: zdta 48 REAL(wp), ALLOCATABLE, DIMENSION(:,:,: ) :: zdta1 49 REAL(wp), ALLOCATABLE, DIMENSION(:,: ) :: zhipor 99 INTEGER :: ji, jj, jk, jn 100 REAL(wp), DIMENSION(jpi,jpj,jpksed,jptrased) :: zdta 101 REAL(wp), DIMENSION(jpi,jpj,jpksed,2) :: zdta1 102 REAL(wp), DIMENSION(jpi,jpj,jpksed) :: zdta2 103 REAL(wp), DIMENSION(jpoce,jpksed) :: zhipor 50 104 REAL(wp) :: zkt 51 105 CHARACTER(len = 20) :: cltra 106 CHARACTER(LEN=20) :: name1 52 107 INTEGER :: jlibalt = jprstlib 53 108 LOGICAL :: llok 54 109 !-------------------------------------------------------------------- 55 56 57 WRITE(numsed,*) ' ' 58 WRITE(numsed,*) ' Initilization of Sediment components from restart'59 WRITE(numsed,*) ''60 61 ALLOCATE( zdta(jpi,jpj,jpksed,jptrased), zdta1(jpi,jpj,jpksed,2), zhipor(jpoce,jpksed) ) 62 63 CALL iom_open( 'restart_sed', numrsr, kiolib = jlibalt )64 CALL iom_get( numrsr, 'kt' , zkt ) ! time-step65 110 111 IF( ln_timing ) CALL timing_start('sed_rst_read') 112 113 IF (lwp) WRITE(numsed,*) ' ' 114 IF (lwp) WRITE(numsed,*) ' Initilization of Sediment components from restart' 115 IF (lwp) WRITE(numsed,*) ' ' 116 117 zdta = 1. 118 zdta1 = 1. 119 zdta2 = 0. 120 66 121 DO jn = 1, jptrased 67 cltra = sedtrcd(jn) 68 CALL iom_get( numrsr, jpdom_unknown, cltra, zdta(:,:,:,jn), & 69 & kstart=(/1,1,1/), kcount=(/jpi,jpj,jpksed/) ) 70 ENDDO 71 72 73 CALL pack_arr( jpoce, solcp(1:jpoce,1:jpksed,jsopal), & 74 & zdta(1:jpi,1:jpj,1:jpksed,1), iarroce(1:jpoce) ) 75 76 CALL pack_arr( jpoce, solcp(1:jpoce,1:jpksed,jsclay), & 77 & zdta(1:jpi,1:jpj,1:jpksed,2), iarroce(1:jpoce) ) 78 79 CALL pack_arr( jpoce, solcp(1:jpoce,1:jpksed,jspoc), & 80 & zdta(1:jpi,1:jpj,1:jpksed,3), iarroce(1:jpoce) ) 81 82 CALL pack_arr( jpoce, solcp(1:jpoce,1:jpksed,jscal), & 83 & zdta(1:jpi,1:jpj,1:jpksed,4), iarroce(1:jpoce) ) 84 85 CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwsil), & 86 & zdta(1:jpi,1:jpj,1:jpksed,5), iarroce(1:jpoce) ) 87 88 89 CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwoxy), & 90 & zdta(1:jpi,1:jpj,1:jpksed,6), iarroce(1:jpoce) ) 91 92 93 CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwdic), & 94 & zdta(1:jpi,1:jpj,1:jpksed,7), iarroce(1:jpoce) ) 95 96 CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwno3), & 97 & zdta(1:jpi,1:jpj,1:jpksed,8), iarroce(1:jpoce) ) 98 99 CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwpo4), & 100 & zdta(1:jpi,1:jpj,1:jpksed,9), iarroce(1:jpoce) ) 101 102 CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwalk), & 103 & zdta(1:jpi,1:jpj,1:jpksed,10), iarroce(1:jpoce) ) 104 105 CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwc13), & 106 & zdta(1:jpi,1:jpj,1:jpksed,11), iarroce(1:jpoce) ) 122 cltra = TRIM(sedtrcd(jn)) 123 IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN 124 CALL iom_get( numrsr, jpdom_autoglo, TRIM(cltra), zdta(:,:,:,jn) ) 125 ELSE 126 zdta(:,:,:,jn) = 0.0 127 ENDIF 128 ENDDO 129 130 DO jn = 1, jpsol 131 CALL pack_arr( jpoce, solcp(1:jpoce,1:jpksed,jn), & 132 & zdta(1:jpi,1:jpj,1:jpksed,jn), iarroce(1:jpoce) ) 133 END DO 134 135 DO jn = 1, jpwat 136 CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jn), & 137 & zdta(1:jpi,1:jpj,1:jpksed,jpsol+jn), iarroce(1:jpoce) ) 138 END DO 107 139 108 140 DO jn = 1, 2 109 cltra = seddia3d(jn) 110 CALL iom_get( numrsr, jpdom_unknown, cltra, zdta1(:,:,:,jn), & 111 & kstart=(/1,1,1/), kcount=(/jpi,jpj,jpksed/) ) 141 cltra = TRIM(seddia3d(jn)) 142 IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN 143 CALL iom_get( numrsr, jpdom_autoglo, TRIM(cltra), zdta1(:,:,:,jn) ) 144 ELSE 145 zdta1(:,:,:,jn) = 0.0 146 ENDIF 112 147 ENDDO 113 148 … … 122 157 ENDDO 123 158 ENDDO 124 159 125 160 CALL pack_arr( jpoce, co3por(1:jpoce,1:jpksed), & 126 161 & zdta1(1:jpi,1:jpj,1:jpksed,2), iarroce(1:jpoce) ) … … 131 166 pwcp (1:jpoce,1,:) = 0. 132 167 133 DEALLOCATE( zdta ) 134 DEALLOCATE( zdta1 ) 135 DEALLOCATE( zhipor ) 168 cltra = "dbioturb" 169 IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN 170 CALL iom_get( numrsr, jpdom_autoglo, TRIM(cltra), zdta2(:,:,:) ) 171 ELSE 172 zdta2(:,:,:) = 0.0 173 ENDIF 174 175 CALL pack_arr( jpoce, db(1:jpoce,1:jpksed), & 176 & zdta2(1:jpi,1:jpj,1:jpksed), iarroce(1:jpoce) ) 177 178 cltra = "irrig" 179 IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN 180 CALL iom_get( numrsr, jpdom_autoglo, TRIM(cltra), zdta2(:,:,:) ) 181 ELSE 182 zdta2(:,:,:) = 0.0 183 ENDIF 184 185 CALL pack_arr( jpoce, irrig(1:jpoce,1:jpksed), & 186 & zdta2(1:jpi,1:jpj,1:jpksed), iarroce(1:jpoce) ) 187 188 cltra = "sedligand" 189 IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN 190 CALL iom_get( numrsr, jpdom_autoglo, TRIM(cltra), zdta2(:,:,:) ) 191 ELSE 192 zdta2(:,:,:) = 0.0 193 ENDIF 194 195 CALL pack_arr( jpoce, sedligand(1:jpoce,1:jpksed), & 196 & zdta2(1:jpi,1:jpj,1:jpksed), iarroce(1:jpoce) ) 197 198 IF( ln_timing ) CALL timing_stop('sed_rst_read') 136 199 137 200 END SUBROUTINE sed_rst_read … … 147 210 !!---------------------------------------------------------------------- 148 211 !!* Modules used 149 USE ioipsl150 !! *Arguments151 212 INTEGER, INTENT(in) :: kt ! number of iteration 152 213 !! * local declarations 153 INTEGER :: ji, jk 154 INTEGER :: ic, jc, jn, itime 155 REAL(wp) :: zdate0 214 INTEGER :: ji, jj, jk, jn 156 215 REAL(wp), DIMENSION(1) :: zinfo 157 CHARACTER(len=50) :: clname,cln 158 CHARACTER(len=20) :: cltra 159 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: zdta 216 CHARACTER(len=50) :: clname 217 CHARACTER(len=20) :: cltra, name1 218 REAL(wp), DIMENSION(jpoce,jpksed) :: zdta 219 REAL(wp), DIMENSION(jpi,jpj,jpksed) :: zdta2 160 220 !! ----------------------------------------------------------------------- 161 221 162 ALLOCATE( zdta(jpoce,jpksed) ) 163 164 IF( MOD(kt,nstock) == 0 .OR. kt == nitsedend ) THEN 165 222 IF( ln_timing ) CALL timing_start('sed_rst_wri') 223 166 224 !! 0. initialisations 167 225 !! ------------------ 168 226 169 170 227 IF(lwp) WRITE(numsed,*) ' ' 228 IF(lwp) WRITE(numsed,*) 'sed_rst_write : write the sediment restart file in NetCDF format ', & 171 229 'at it= ',kt 172 IF(lwp) WRITE(numsed,*) '~~~~~~~~~' 230 IF(lwp) WRITE(numsed,*) '~~~~~~~~~' 231 232 233 trcsedi(:,:,:,:) = 0.0 234 flxsedi3d(:,:,:,:) = 0.0 235 zdta(:,:) = 1.0 236 zdta2(:,:,:) = 0.0 237 173 238 174 !! 1. WRITE in nutwrs 175 !! ------------------ 176 177 ic = 1 178 DO jc = 1,16 179 IF( cexper(jc:jc) /= ' ') ic = jc 180 END DO 181 WRITE( cln,'("_",i5.5,i2.2,i2.2,"_restart.sed")') nyear, nmonth, nday 182 clname = cexper(1:ic)//cln 183 itime = 0 184 CALL ymds2ju( nyear, nmonth, nday, rdt, zdate0 ) 185 zdate0 = zdate0 - adatrj ! set calendar origin to the beginning of the experiment 186 CALL restini( 'NONE', jpi, jpj, glamt, gphit, jpksed, dz, & 187 & clname, itime, zdate0, dtsed*nstock, numrsw, domain_id=nidom ) 188 zinfo(1) = REAL( kt) 189 CALL restput( numrsw, 'kt', 1,1, 1,0, zinfo ) 190 191 192 193 ! Back to 2D geometry 194 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,1) , iarroce(1:jpoce), & 195 & solcp(1:jpoce,1:jpksed,jsopal ) ) 239 !! 1. WRITE in nutwrs 240 !! ------------------ 241 242 zinfo(1) = REAL( kt) 243 CALL iom_rstput( kt, nitrst, numrsw, 'kt', zinfo ) 244 245 ! Back to 2D geometry 246 DO jn = 1, jpsol 247 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,jn) , iarroce(1:jpoce), & 248 & solcp(1:jpoce,1:jpksed,jn ) ) 249 END DO 250 251 DO jn = 1, jpwat 252 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,jpsol+jn) , iarroce(1:jpoce), & 253 & pwcp(1:jpoce,1:jpksed,jn ) ) 254 END DO 255 ! pH 256 DO jk = 1, jpksed 257 DO ji = 1, jpoce 258 zdta(ji,jk) = -LOG10( hipor(ji,jk) / ( densSW(ji) + rtrn ) + rtrn ) 259 ENDDO 260 ENDDO 261 262 CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,1) , iarroce(1:jpoce), & 263 & zdta(1:jpoce,1:jpksed) ) 196 264 197 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,2) , iarroce(1:jpoce), & 198 & solcp(1:jpoce,1:jpksed,jsclay ) ) 199 200 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,3) , iarroce(1:jpoce), & 201 & solcp(1:jpoce,1:jpksed,jspoc ) ) 202 203 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,4) , iarroce(1:jpoce), & 204 & solcp(1:jpoce,1:jpksed,jscal ) ) 205 206 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,5) , iarroce(1:jpoce), & 207 & pwcp(1:jpoce,1:jpksed,jwsil ) ) 208 209 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,6) , iarroce(1:jpoce), & 210 & pwcp(1:jpoce,1:jpksed,jwoxy ) ) 211 212 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,7) , iarroce(1:jpoce), & 213 & pwcp(1:jpoce,1:jpksed,jwdic ) ) 214 215 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,8) , iarroce(1:jpoce), & 216 & pwcp(1:jpoce,1:jpksed,jwno3 ) ) 217 218 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,9) , iarroce(1:jpoce), & 219 & pwcp(1:jpoce,1:jpksed,jwpo4 ) ) 220 221 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,10) , iarroce(1:jpoce), & 222 & pwcp(1:jpoce,1:jpksed,jwalk ) ) 223 224 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,11) , iarroce(1:jpoce), & 225 & pwcp(1:jpoce,1:jpksed,jwc13 ) ) 226 227 ! porosity 228 zdta(:,:) = 0. 229 DO jk = 1, jpksed 230 DO ji = 1, jpoce 231 zdta(ji,jk) = -LOG10( hipor(ji,jk) / densSW(ji) ) 232 ENDDO 233 ENDDO 234 CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,1) , iarroce(1:jpoce), & 235 & zdta(1:jpoce,1:jpksed) ) 236 237 CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,2) , iarroce(1:jpoce), & 238 & co3por(1:jpoce,1:jpksed) ) 239 240 ! prognostic variables 241 ! -------------------- 242 243 244 DO jn = 1, jptrased 245 cltra = sedtrcd(jn) 246 CALL restput( numrsw, cltra, jpi, jpj, jpksed, 0, trcsedi(:,:,:,jn) ) 247 ENDDO 248 249 DO jn = 1, 2 250 cltra = seddia3d(jn) 251 CALL restput( numrsw, cltra, jpi, jpj, jpksed, 0, flxsedi3d(:,:,:,jn) ) 252 ENDDO 253 254 255 CALL restclo( numrsw ) 256 257 ENDIF 258 259 DEALLOCATE( zdta ) 265 CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,2) , iarroce(1:jpoce), & 266 & co3por(1:jpoce,1:jpksed) ) 267 268 ! prognostic variables 269 ! -------------------- 270 271 DO jn = 1, jptrased 272 cltra = TRIM(sedtrcd(jn)) 273 CALL iom_rstput( kt, nitrst, numrsw, TRIM(cltra), trcsedi(:,:,:,jn) ) 274 ENDDO 275 276 DO jn = 1, 2 277 cltra = TRIM(seddia3d(jn)) 278 CALL iom_rstput( kt, nitrst, numrsw, TRIM(cltra), flxsedi3d(:,:,:,jn) ) 279 ENDDO 280 281 CALL unpack_arr( jpoce, zdta2(1:jpi,1:jpj,1:jpksed) , iarroce(1:jpoce), & 282 & db(1:jpoce,1:jpksed) ) 283 284 cltra = "dbioturb" 285 CALL iom_rstput( kt, nitrst, numrsw, TRIM(cltra), zdta2(:,:,:) ) 286 287 CALL unpack_arr( jpoce, zdta2(1:jpi,1:jpj,1:jpksed) , iarroce(1:jpoce), & 288 & irrig(1:jpoce,1:jpksed) ) 289 290 cltra = "irrig" 291 CALL iom_rstput( kt, nitrst, numrsw, TRIM(cltra), zdta2(:,:,:) ) 292 293 CALL unpack_arr( jpoce, zdta2(1:jpi,1:jpj,1:jpksed) , iarroce(1:jpoce), & 294 & sedligand(1:jpoce,1:jpksed) ) 295 296 cltra = "sedligand" 297 CALL iom_rstput( kt, nitrst, numrsw, TRIM(cltra), zdta2(:,:,:) ) 298 299 IF( kt == nitrst ) THEN 300 CALL iom_close( numrsw ) ! close the restart file (only at last time step) 301 IF( l_offline .AND. ln_rst_list ) THEN 302 nrst_lst = nrst_lst + 1 303 nitrst = nstocklist( nrst_lst ) 304 ENDIF 305 ENDIF 306 307 IF( ln_timing ) CALL timing_stop('sed_rst_wri') 260 308 261 309 END SUBROUTINE sed_rst_wri 262 #else 263 !!====================================================================== 264 !! MODULE sedrst : Dummy module 265 !!====================================================================== 266 !! $Id$ 267 CONTAINS 268 SUBROUTINE sed_rst_read ! Empty routines 269 END SUBROUTINE sed_rst_read 270 SUBROUTINE sed_rst_wri( kt ) 271 INTEGER, INTENT ( in ) :: kt 272 WRITE(*,*) 'sed_rst_wri: You should not have seen this print! error?', kt 273 END SUBROUTINE sed_rst_wri 274 #endif 310 311 312 SUBROUTINE sed_rst_cal( kt, cdrw ) 313 !!--------------------------------------------------------------------- 314 !! *** ROUTINE sed_rst_cal *** 315 !! 316 !! ** Purpose : Read or write calendar in restart file: 317 !! 318 !! WRITE(READ) mode: 319 !! kt : number of time step since the begining of the experiment at the 320 !! end of the current(previous) run 321 !! adatrj(0) : number of elapsed days since the begining of the experiment at the 322 !! end of the current(previous) run (REAL -> keep fractions of day) 323 !! ndastp : date at the end of the current(previous) run (coded as yyyymmdd integer) 324 !! 325 !! According to namelist parameter nrstdt, 326 !! nn_rsttr = 0 no control on the date (nittrc000 is arbitrary). 327 !! nn_rsttr = 1 we verify that nittrc000 is equal to the last 328 !! time step of previous run + 1. 329 !! In both those options, the exact duration of the experiment 330 !! since the beginning (cumulated duration of all previous restart runs) 331 !! is not stored in the restart and is assumed to be (nittrc000-1)*rdt. 332 !! This is valid is the time step has remained constant. 333 !! 334 !! nn_rsttr = 2 the duration of the experiment in days (adatrj) 335 !! has been stored in the restart file. 336 !!---------------------------------------------------------------------- 337 INTEGER , INTENT(in) :: kt ! ocean time-step 338 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag 339 ! 340 INTEGER :: jlibalt = jprstlib 341 LOGICAL :: llok 342 REAL(wp) :: zkt, zrdttrc1 343 REAL(wp) :: zndastp 344 345 ! Time domain : restart 346 ! --------------------- 347 348 IF( TRIM(cdrw) == 'READ' ) THEN 349 350 IF(lwp) WRITE(numsed,*) 351 IF(lwp) WRITE(numsed,*) 'sed_rst_cal : read the SED restart file for calendar' 352 IF(lwp) WRITE(numsed,*) '~~~~~~~~~~~~' 353 354 IF( ln_rst_sed ) THEN 355 CALL iom_open( TRIM(cn_sedrst_indir)//'/'//cn_sedrst_in, numrsr, kiolib = jlibalt ) 356 CALL iom_get ( numrsr, 'kt', zkt ) ! last time-step of previous run 357 358 IF(lwp) THEN 359 WRITE(numsed,*) ' *** Info read in restart : ' 360 WRITE(numsed,*) ' previous time-step : ', NINT( zkt ) 361 WRITE(numsed,*) ' *** restart option' 362 SELECT CASE ( nn_rstsed ) 363 CASE ( 0 ) ; WRITE(numsed,*) ' nn_rstsed = 0 : no control of nittrc000' 364 CASE ( 1 ) ; WRITE(numsed,*) ' nn_rstsed = 1 : no control the date at nittrc000 (use ndate0 read in the namelist)' 365 CASE ( 2 ) ; WRITE(numsed,*) ' nn_rstsed = 2 : calendar parameters read in restart' 366 END SELECT 367 WRITE(numsed,*) 368 ENDIF 369 ! Control of date 370 IF( nittrc000 - NINT( zkt ) /= nn_dtsed .AND. nn_rstsed /= 0 ) & 371 & CALL ctl_stop( ' ===>>>> : problem with nittrc000 for the restart', & 372 & ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' ) 373 ENDIF 374 ! 375 IF( l_offline ) THEN 376 ! ! set the date in offline mode 377 IF( ln_rst_sed .AND. nn_rstsed == 2 ) THEN 378 CALL iom_get( numrsr, 'ndastp', zndastp ) 379 ndastp = NINT( zndastp ) 380 CALL iom_get( numrsr, 'adatrj', adatrj ) 381 ELSE 382 ndastp = ndate0 - 1 ! ndate0 read in the namelist in dom_nam 383 adatrj = ( REAL( nittrc000-1, wp ) * rdt ) / rday 384 ! note this is wrong if time step has changed during run 385 ENDIF 386 ! 387 IF(lwp) THEN 388 WRITE(numsed,*) ' *** Info used values : ' 389 WRITE(numsed,*) ' date ndastp : ', ndastp 390 WRITE(numsed,*) ' number of elapsed days since the begining of run : ', adatrj 391 WRITE(numsed,*) 392 ENDIF 393 ! 394 CALL day_init ! compute calendar 395 ! 396 ENDIF 397 ! 398 ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN 399 ! 400 IF( kt == nitrst ) THEN 401 IF(lwp) WRITE(numsed,*) 402 IF(lwp) WRITE(numsed,*) 'trc_wri : write the TOP restart file (NetCDF) at it= ', kt, ' date= ', ndastp 403 IF(lwp) WRITE(numsed,*) '~~~~~~~' 404 ENDIF 405 CALL iom_rstput( kt, nitrst, numrsw, 'kt' , REAL( kt , wp) ) ! time-step 406 CALL iom_rstput( kt, nitrst, numrsw, 'ndastp' , REAL( ndastp, wp) ) ! date 407 CALL iom_rstput( kt, nitrst, numrsw, 'adatrj' , adatrj ) ! number of elapsed days since 408 ! ! the begining of the run [s] 409 ENDIF 410 411 END SUBROUTINE sed_rst_cal 275 412 276 413 END MODULE sedrst -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/TOP/PISCES/SED/sedsfc.F90
r5215 r10345 4 4 !! Sediment : Data at sediment surface 5 5 !!===================================================================== 6 #if defined key_sed && ! defined key_sed_off7 6 !! * Modules used 8 7 USE sed ! sediment global variable … … 32 31 33 32 !------------------------------------------------------------------------ 33 ! reading variables 34 34 35 IF( kt == nitsed000 ) THEN 36 WRITE(numsed,*) ' sed_sfc : Give data from sediment model to tracer model ' 37 WRITE(numsed,*) ' ' 38 ENDIF 39 40 ! reading variables 35 IF( ln_timing ) CALL timing_start('sed_sfc') 41 36 42 37 CALL unpack_arr ( jpoce, trc_data(1:jpi,1:jpj,1), iarroce(1:jpoce), pwcp(1:jpoce,1,jwalk) ) … … 46 41 CALL unpack_arr ( jpoce, trc_data(1:jpi,1:jpj,5), iarroce(1:jpoce), pwcp(1:jpoce,1,jwoxy) ) 47 42 CALL unpack_arr ( jpoce, trc_data(1:jpi,1:jpj,6), iarroce(1:jpoce), pwcp(1:jpoce,1,jwsil) ) 43 CALL unpack_arr ( jpoce, trc_data(1:jpi,1:jpj,7), iarroce(1:jpoce), pwcp(1:jpoce,1,jwnh4) ) 44 CALL unpack_arr ( jpoce, trc_data(1:jpi,1:jpj,8), iarroce(1:jpoce), pwcp(1:jpoce,1,jwfe2) ) 48 45 49 46 … … 52 49 ikt = mbkt(ji,jj) 53 50 IF ( tmask(ji,jj,ikt) == 1 ) THEN 54 trn(ji,jj,ikt,jptal) = trc_data(ji,jj,1) 55 trn(ji,jj,ikt,jpdic) = trc_data(ji,jj,2) 56 trn(ji,jj,ikt,jpno3) = trc_data(ji,jj,3) * 7.6 57 trn(ji,jj,ikt,jppo4) = trc_data(ji,jj,4) * 122. 58 trn(ji,jj,ikt,jpoxy) = trc_data(ji,jj,5) 59 trn(ji,jj,ikt,jpsil) = trc_data(ji,jj,6) 51 trb(ji,jj,ikt,jptal) = trc_data(ji,jj,1) 52 trb(ji,jj,ikt,jpdic) = trc_data(ji,jj,2) 53 trb(ji,jj,ikt,jpno3) = trc_data(ji,jj,3) * 7.625 54 trb(ji,jj,ikt,jppo4) = trc_data(ji,jj,4) * 122. 55 trb(ji,jj,ikt,jpoxy) = trc_data(ji,jj,5) 56 trb(ji,jj,ikt,jpsil) = trc_data(ji,jj,6) 57 trb(ji,jj,ikt,jpnh4) = trc_data(ji,jj,7) * 7.625 58 trb(ji,jj,ikt,jpfer) = trc_data(ji,jj,8) 60 59 ENDIF 61 60 ENDDO 62 61 ENDDO 63 62 63 IF( ln_timing ) CALL timing_stop('sed_sfc') 64 64 65 END SUBROUTINE sed_sfc 65 66 66 #else67 !!======================================================================68 !! MODULE sedsfc : Dummy module69 !!======================================================================70 !! $Id$71 CONTAINS72 SUBROUTINE sed_sfc ( kt )73 INTEGER, INTENT(in) :: kt74 WRITE(*,*) 'sed_sfc: You should not have seen this print! error?', kt75 END SUBROUTINE sed_sfc76 #endif77 78 67 END MODULE sedsfc -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/TOP/PISCES/SED/sedstp.F90
r5215 r10345 1 1 MODULE sedstp 2 #if defined key_sed3 2 !!====================================================================== 4 3 !! *** MODULE sedstp *** … … 9 8 USE sedchem ! chemical constant 10 9 USE sedco3 ! carbonate in sediment pore water 11 USE seddsr ! dissolution reaction 10 USE sedorg ! Organic reactions and diffusion 11 USE sedinorg ! Inorganic dissolution 12 12 USE sedbtb ! bioturbation 13 13 USE sedadv ! vertical advection … … 16 16 USE sedrst ! restart 17 17 USE sedwri ! outputs 18 USE trcdmp_sed 19 USE lib_mpp ! distribued memory computing library 20 USE iom 18 21 19 22 IMPLICIT NONE … … 42 45 !!---------------------------------------------------------------------- 43 46 INTEGER, INTENT(in) :: kt ! number of iteration 47 INTEGER :: ji,jk,js,jn,jw 48 !!---------------------------------------------------------------------- 49 IF( ln_timing ) CALL timing_start('sed_stp') 50 ! 51 CALL sed_rst_opn ( kt ) ! Open tracer restart file 52 IF( lrst_sed ) CALL sed_rst_cal ( kt, 'WRITE' ) ! calenda 44 53 45 !!----------------------------------------------------------------------54 IF(ln_sediment_offline) CALL trc_dmp_sed ( kt ) 46 55 47 IF( kt /= nitsed000 ) THEN 48 CALL sed_dta( kt ) ! Load Data for bot. wat. Chem and fluxes 49 CALL sed_chem( kt ) ! update of chemical constant to account for salinity, temperature changes 56 dtsed = r2dttrc 57 ! dtsed2 = dtsed 58 IF (kt /= nitsed000) THEN 59 CALL sed_dta( kt ) ! Load Data for bot. wat. Chem and fluxes 50 60 ENDIF 51 CALL sed_dsr( kt ) ! Dissolution reaction52 CALL sed_adv( kt ) ! advection53 CALL sed_btb( kt ) ! Bioturbation54 61 55 IF ( ( MOD( kt, nwrised ) == 0 ) .OR. ( MOD( kt, nstock ) == 0 ) .OR. ( kt == nitsedend ) ) & 56 CALL sed_co3( kt ) ! pH actualization for saving 57 CALL sed_mbc( kt ) ! cumulation for mass balance calculation 58 #if ! defined key_sed_off 59 CALL sed_sfc( kt ) ! Give back new bottom wat chem to tracer model 60 #endif 61 CALL sed_rst_wri( kt ) ! restart file output 62 IF (sedmask == 1. ) THEN 63 IF( kt /= nitsed000 ) THEN 64 CALL sed_chem( kt ) ! update of chemical constant to account for salinity, temperature changes 65 ENDIF 66 67 CALL sed_btb( kt ) ! 1st pass of bioturbation at t+1/2 68 CALL sed_org( kt ) ! Organic related reactions and diffusion 69 CALL sed_inorg( kt ) ! Dissolution reaction 70 CALL sed_btb( kt ) ! 2nd pass of bioturbation at t+1 71 tokbot(:,:) = 0.0 72 DO jw = 1, jpwat 73 DO ji = 1, jpoce 74 tokbot(ji,jw) = pwcp(ji,1,jw) * 1.e-3 * dzkbot(ji) 75 END DO 76 ENDDO 77 CALL sed_adv( kt ) ! advection 78 CALL sed_co3( kt ) ! pH actualization for saving 79 ! This routine is commented out since it does not work at all 80 CALL sed_mbc( kt ) ! cumulation for mass balance calculation 81 82 IF (ln_sed_2way) CALL sed_sfc( kt ) ! Give back new bottom wat chem to tracer model 83 ENDIF 62 84 CALL sed_wri( kt ) ! outputs 85 IF( kt == nitsed000 ) THEN 86 CALL iom_close( numrsr ) ! close input tracer restart file 87 ! IF(lwm) CALL FLUSH( numont ) ! flush namelist output 88 ENDIF 89 IF( lrst_sed ) CALL sed_rst_wri( kt ) ! restart file output 63 90 64 91 IF( kt == nitsedend ) CLOSE( numsed ) 65 92 93 IF( ln_timing ) CALL timing_stop('sed_stp') 94 66 95 END SUBROUTINE sed_stp 67 96 68 #else69 !!======================================================================70 !! MODULE sedstp : Dummy module71 !!======================================================================72 !! $Id$73 CONTAINS74 SUBROUTINE sed_stp( kt ) ! Empty routine75 INTEGER, INTENT(in) :: kt76 WRITE(*,*) 'sed_stp: You should not have seen this print! error?', kt77 END SUBROUTINE sed_stp78 #endif79 97 END MODULE sedstp -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/TOP/PISCES/SED/sedwri.F90
r5215 r10345 1 1 MODULE sedwri 2 #if defined key_sed3 2 !!====================================================================== 4 3 !! *** MODULE sedwri *** … … 7 6 USE sed 8 7 USE sedarr 9 USE ioipsl10 USE dianam ! build name of file (routine)8 USE lib_mpp ! distribued memory computing library 9 USE iom 11 10 12 11 IMPLICIT NONE … … 15 14 !! * Accessibility 16 15 PUBLIC sed_wri 17 18 INTEGER :: nised19 INTEGER :: nhorised20 INTEGER :: ndimt5221 INTEGER :: ndimt5122 INTEGER :: ndepsed23 REAL(wp) :: zjulian24 INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndext5225 INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndext5126 16 27 17 !! $Id$ … … 43 33 INTEGER, INTENT(in) :: kt 44 34 45 CHARACTER(len = 60) :: clhstnam, clop 46 INTEGER :: ji, jk, js, jw, jn 47 REAL(wp) :: zsto,zout, zdt 48 INTEGER :: iimi, iima, ijmi, ijma,ipk, it, itmod 49 CHARACTER(len = 20) :: cltra , cltrau 50 CHARACTER(len = 80) :: cltral 35 INTEGER :: ji, jj, jk, js, jw, jn 36 INTEGER :: it 37 CHARACTER(len = 20) :: cltra 51 38 REAL(wp) :: zrate 52 39 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zdta, zflx … … 57 44 ! Initialisation 58 45 ! ----------------- 59 IF( kt == nittrc000 ) ALLOCATE( ndext52(jpij*jpksed), ndext51(jpij) )60 61 ! Define frequency of output and means62 zdt = dtsed63 IF( ln_mskland ) THEN ; clop = "only(x)" ! put 1.e+20 on land (very expensive!!)64 ELSE ; clop = "x" ! no use of the mask value (require less cpu time)65 ENDIF66 #if defined key_diainstant67 zsto = nwrised * zdt68 clop = "inst("//TRIM(clop)//")"69 #else70 zsto = zdt71 clop = "ave("//TRIM(clop)//")"72 #endif73 zout = nwrised * zdt74 75 ! Define indices of the horizontal output zoom and vertical limit storage76 iimi = 1 ; iima = jpi77 ijmi = 1 ; ijma = jpj78 ipk = jpksed79 80 ! define time axis81 it = kt82 itmod = kt - nitsed000 + 183 84 46 85 47 ! 1. Initilisations 86 48 ! ----------------------------------------------------------------- 87 WRITE(numsed,*) ' ' 88 WRITE(numsed,*) 'sed_wri kt = ', kt 89 WRITE(numsed,*) ' ' 49 IF( ln_timing ) CALL timing_start('sed_wri') 50 ! 51 IF (lwp) WRITE(numsed,*) ' ' 52 IF (lwp) WRITE(numsed,*) 'sed_wri kt = ', kt 53 IF (lwp) WRITE(numsed,*) ' ' 90 54 91 55 ALLOCATE( zdta(jpoce,jpksed) ) ; ALLOCATE( zflx(jpoce,jpwatp1) ) 92 56 57 ! Initialize variables 58 ! -------------------- 59 60 trcsedi(:,:,:,:) = 0.0 61 flxsedi3d(:,:,:,:) = 0.0 62 flxsedi2d(:,:,:) = 0.0 93 63 94 64 ! 2. Back to 2D geometry 95 65 ! ----------------------------------------------------------------- 96 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,1) , iarroce(1:jpoce), & 97 & solcp(1:jpoce,1:jpksed,jsopal ) ) 66 DO jn = 1, jpsol 67 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,jn) , iarroce(1:jpoce), & 68 & solcp(1:jpoce,1:jpksed,jn ) ) 69 END DO 98 70 99 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,2) , iarroce(1:jpoce), & 100 & solcp(1:jpoce,1:jpksed,jsclay ) ) 101 102 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,3) , iarroce(1:jpoce), & 103 & solcp(1:jpoce,1:jpksed,jspoc ) ) 104 105 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,4) , iarroce(1:jpoce), & 106 & solcp(1:jpoce,1:jpksed,jscal ) ) 107 108 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,5) , iarroce(1:jpoce), & 109 & pwcp(1:jpoce,1:jpksed,jwsil ) ) 110 111 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,6) , iarroce(1:jpoce), & 112 & pwcp(1:jpoce,1:jpksed,jwoxy ) ) 113 114 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,7) , iarroce(1:jpoce), & 115 & pwcp(1:jpoce,1:jpksed,jwdic ) ) 116 117 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,8) , iarroce(1:jpoce), & 118 & pwcp(1:jpoce,1:jpksed,jwno3 ) ) 119 120 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,9) , iarroce(1:jpoce), & 121 & pwcp(1:jpoce,1:jpksed,jwpo4 ) ) 122 123 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,10) , iarroce(1:jpoce), & 124 & pwcp(1:jpoce,1:jpksed,jwalk ) ) 125 126 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,11) , iarroce(1:jpoce), & 127 & pwcp(1:jpoce,1:jpksed,jwc13 ) ) 128 71 DO jn = 1, jpwat 72 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,jpsol + jn) , iarroce(1:jpoce), & 73 & pwcp(1:jpoce,1:jpksed,jn ) ) 74 END DO 75 129 76 ! porosity 130 77 zdta(:,:) = 0. 131 78 DO jk = 1, jpksed 132 79 DO ji = 1, jpoce 133 zdta(ji,jk) = -LOG10( hipor(ji,jk) / densSW(ji))80 zdta(ji,jk) = -LOG10( hipor(ji,jk) / ( densSW(ji) + rtrn ) + rtrn ) 134 81 ENDDO 135 82 ENDDO 83 136 84 CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,1) , iarroce(1:jpoce), & 137 85 & zdta(1:jpoce,1:jpksed) ) … … 140 88 & co3por(1:jpoce,1:jpksed) ) 141 89 142 143 ! computation of delta 13C 144 zdta(:,:) = 0. 145 DO jk = 1, jpksed 146 DO ji = 1, jpoce 147 zdta(ji,jk) = ( ( pwcp(ji,jk,jwc13) / pwcp(ji,jk,jwdic) / pdb ) - 1. ) & 148 & * 1000. 149 ENDDO 150 ENDDO 151 CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,3) , iarroce(1:jpoce), & 152 & zdta(1:jpoce,1:jpksed) ) 153 154 90 ! flxsedi3d = 0. 155 91 zflx(:,:) = 0. 156 92 ! Calculation of fluxes mol/cm2/s … … 158 94 DO ji = 1, jpoce 159 95 zflx(ji,jw) = ( pwcp(ji,1,jw) - pwcp_dta(ji,jw) ) & 160 & * 1.e -3 * dzkbot(ji) / dtsed96 & * 1.e3 / 1.e2 * dzkbot(ji) / r2dttrc 161 97 ENDDO 162 98 ENDDO 99 163 100 ! Calculation of accumulation rate per dt 164 101 DO js = 1, jpsol 165 zrate = mol_wgt(js) / ( dens * por1(jpksed) ) / dtsed102 zrate = 1.0 / ( denssol * por1(jpksed) ) / r2dttrc 166 103 DO ji = 1, jpoce 167 104 zflx(ji,jpwatp1) = zflx(ji,jpwatp1) + ( tosed(ji,js) - fromsed(ji,js) ) * zrate … … 169 106 ENDDO 170 107 171 CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,1), iarroce(1:jpoce), zflx(1:jpoce,1) ) 172 CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,2), iarroce(1:jpoce), zflx(1:jpoce,2) ) 173 CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,3), iarroce(1:jpoce), zflx(1:jpoce,3) ) 174 CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,4), iarroce(1:jpoce), zflx(1:jpoce,4) ) 175 CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,5), iarroce(1:jpoce), zflx(1:jpoce,5) ) 176 CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,6), iarroce(1:jpoce), zflx(1:jpoce,6) ) 177 CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,7), iarroce(1:jpoce), zflx(1:jpoce,8) ) 178 179 180 ! 3. Define NETCDF files and fields at beginning of first time step 181 ! ----------------------------------------------------------------- 182 183 IF( kt == nitsed000 ) THEN 184 185 ! Define the NETCDF files 186 CALL ymds2ju ( nyear, nmonth, nday, rdt, zjulian ) 187 zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment 188 CALL dia_nam ( clhstnam, nwrised, 'sed_T' ) 189 CALL histbeg ( clhstnam, jpi, glamt, jpj, gphit, & 190 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 191 & nitsed000-1, zjulian, zdt, nhorised, nised , domain_id=nidom, snc4chunks=snc4set ) 192 CALL histvert( nised,'deptht','Vertic.sed.T levels','m',ipk, profsed, ndepsed, 'down' ) 193 CALL wheneq ( jpi*jpj*ipk, tmasksed, 1, 1., ndext52, ndimt52 ) 194 CALL wheneq ( jpi*jpj, tmasksed(:,:,1), 1, 1., ndext51, ndimt51 ) 195 196 ! Declare all the output fields as NETCDF variables 197 198 DO jn = 1, jptrased 199 cltra = sedtrcd(jn) ! short title for sediment variable 200 cltral = sedtrcl(jn) ! long title for sediment variable 201 cltrau = sedtrcu(jn) ! unit for sediment variable 202 203 CALL histdef( nised, cltra,cltral,cltrau, jpi, jpj, nhorised, & 204 & ipk, 1, ipk, ndepsed, 32, clop, zsto, zout ) 205 ENDDO 206 207 ! 3D diagnostic 208 DO jn = 1, jpdia3dsed 209 cltra = seddia3d(jn) ! short title for 3D diagnostic 210 cltral = seddia3l(jn) ! long title for 3D diagnostic 211 cltrau = seddia3u(jn) ! UNIT for 3D diagnostic 212 213 CALL histdef( nised, cltra,cltral,cltrau, jpi, jpj, nhorised, & 214 & ipk, 1, ipk, ndepsed, 32, clop, zsto, zout ) 215 ENDDO 216 217 ! Fluxes 218 DO jn = 1, jpdia2dsed 219 cltra = seddia2d(jn) ! short title for 2D diagnostic 220 cltral = seddia2l(jn) ! long title for 2D diagnostic 221 cltrau = seddia2u(jn) ! UNIT for 2D diagnostic 222 223 CALL histdef( nised, cltra,cltral,cltrau, jpi, jpj, nhorised, & 224 & 1, 1, 1, -99, 32, clop, zsto, zout ) 225 ENDDO 226 227 228 CALL histend( nised, snc4set ) 229 230 WRITE(numsed,*) 231 WRITE(numsed,*) 'End of NetCDF sediment output file Initialization' 232 233 ENDIF 108 DO jn = 1, jpdia2dsed - 1 109 CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,jn), iarroce(1:jpoce), zflx(1:jpoce,jn) ) 110 END DO 111 zflx(:,1) = dzdep(:) / dtsed 112 CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,jpdia2dsed), iarroce(1:jpoce), zflx(1:jpoce,1) ) 234 113 235 114 ! Start writing data … … 237 116 DO jn = 1, jptrased 238 117 cltra = sedtrcd(jn) ! short title for 3D diagnostic 239 CALL histwrite( nised, cltra, it, trcsedi(:,:,:,jn), ndimt52, ndext52)118 CALL iom_put( cltra, trcsedi(:,:,:,jn) ) 240 119 END DO 241 120 242 121 DO jn = 1, jpdia3dsed 243 122 cltra = seddia3d(jn) ! short title for 3D diagnostic 244 CALL histwrite( nised, cltra, it, flxsedi3d(:,:,:,jn), ndimt52, ndext52)123 CALL iom_put( cltra, flxsedi3d(:,:,:,jn) ) 245 124 END DO 246 125 247 126 DO jn = 1, jpdia2dsed 248 249 CALL histwrite( nised, cltra, it, flxsedi2d(:,:,jn ), ndimt51, ndext51)127 cltra = seddia2d(jn) ! short title for 2D diagnostic 128 CALL iom_put( cltra, flxsedi2d(:,:,jn) ) 250 129 END DO 251 130 252 131 253 ! 3. Closing all files 254 ! -------------------- 255 IF( kt == nitsedend ) THEN 256 CALL histclo( nised ) 257 ENDIF 132 DEALLOCATE( zdta ) ; DEALLOCATE( zflx ) 258 133 259 DEALLOCATE( zdta ) ; DEALLOCATE( zflx)134 IF( ln_timing ) CALL timing_stop('sed_wri') 260 135 261 136 END SUBROUTINE sed_wri 262 137 263 #else264 !!======================================================================265 !! MODULE sedwri : Dummy module266 !!======================================================================267 !! $Id$268 CONTAINS269 SUBROUTINE sed_wri( kt ) ! Empty routine270 INTEGER, INTENT(in) :: kt271 WRITE(*,*) 'sed_adv: You should not have seen this print! error?', kt272 END SUBROUTINE sed_wri273 274 !!======================================================================275 #endif276 277 138 END MODULE sedwri -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/TOP/PISCES/sms_pisces.F90
r10068 r10345 24 24 LOGICAL :: ln_p5z !: Flag to use PISCES quota model 25 25 LOGICAL :: ln_ligand !: Flag to enable organic ligands 26 LOGICAL :: ln_sediment !: Flag to enable sediment module 26 27 27 28 !!* Time variables … … 123 124 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tgfunc2 !: Temp. dependancy of mesozooplankton rates 124 125 125 #if defined key_sed126 LOGICAL, PUBLIC, PARAMETER :: lk_sed = .TRUE. !: sediment flag127 #else128 LOGICAL, PUBLIC, PARAMETER :: lk_sed = .FALSE. !: sediment flag129 #endif130 131 126 !!---------------------------------------------------------------------- 132 127 !! NEMO/TOP 4.0 , NEMO Consortium (2018) -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/TOP/PISCES/trcice_pisces.F90
r10069 r10345 273 273 WHERE( gphit(:,:) < 0._wp ) ; trc_o(:,:,jn) = zpisc(jn,3) ; END WHERE ! Antarctic 274 274 ENDIF 275 IF( cn_cfg == "orca" ) THEN ! Baltic Sea particular case for ORCA configurations275 IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN ! Baltic Sea particular case for ORCA configurations 276 276 WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND. & 277 277 54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp ) … … 312 312 313 313 !-- Baltic 314 IF( cn_cfg == "orca" ) THEN ! Baltic treated seperately for ORCA configs314 IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN 315 315 IF ( trc_ice_ratio(jn) >= - 1._wp ) THEN ! no prescribed conc. ; typically everything but iron) 316 316 WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND. & -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/TOP/PISCES/trcini_pisces.F90
r10297 r10345 18 18 USE trcnam_pisces ! PISCES namelist 19 19 USE sms_pisces ! PISCES Source Minus Sink variables 20 USE sedini ! SEDIMENTS initialization routine 20 21 21 22 IMPLICIT NONE … … 61 62 USE p4zrem ! Remineralisation of organic matter 62 63 USE p4zflx ! Gas exchange 63 USE p4z ice! Co-limitations of differents nutrients64 USE p4zlim ! Co-limitations of differents nutrients 64 65 USE p4zprod ! Growth rate of the 2 phyto groups 65 66 USE p4zmicro ! Sources and sinks of microzooplankton … … 70 71 USE p4zpoc ! Remineralization of organic particles 71 72 USE p4zligand ! Remineralization of organic ligands 72 USE p5z ice! Co-limitations of differents nutrients73 USE p5zlim ! Co-limitations of differents nutrients 73 74 USE p5zprod ! Growth rate of the 2 phyto groups 74 75 USE p5zmicro ! Sources and sinks of microzooplankton … … 269 270 & CALL p4z_flx_init ! gas exchange 270 271 272 ! Initialization of the sediment model 273 IF( ln_sediment) THEN 274 CALL sed_init 275 ELSE 276 ALLOCATE( profsed(2) ) 277 ENDIF 278 271 279 IF(lwp) WRITE(numout,*) 272 280 IF(lwp) WRITE(numout,*) ' ==>>> Initialization of PISCES tracers done' -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/TOP/PISCES/trcnam_pisces.F90
r10068 r10345 43 43 CHARACTER(LEN=20):: clname 44 44 !! 45 NAMELIST/nampismod/ln_p2z, ln_p4z, ln_p5z, ln_ligand 45 NAMELIST/nampismod/ln_p2z, ln_p4z, ln_p5z, ln_ligand, ln_sediment 46 46 !!---------------------------------------------------------------------- 47 47 … … 65 65 IF(lwp) THEN ! control print 66 66 WRITE(numout,*) ' Namelist : nampismod ' 67 WRITE(numout,*) ' Flag to use LOBSTER model ln_p2z = ', ln_p2z 68 WRITE(numout,*) ' Flag to use PISCES standard model ln_p4z = ', ln_p4z 69 WRITE(numout,*) ' Flag to use PISCES quota model ln_p5z = ', ln_p5z 70 WRITE(numout,*) ' Flag to ligand ln_ligand = ', ln_ligand 67 WRITE(numout,*) ' Flag to use LOBSTER model ln_p2z = ', ln_p2z 68 WRITE(numout,*) ' Flag to use PISCES standard model ln_p4z = ', ln_p4z 69 WRITE(numout,*) ' Flag to use PISCES quota model ln_p5z = ', ln_p5z 70 WRITE(numout,*) ' Flag to ligand ln_ligand = ', ln_ligand 71 WRITE(numout,*) ' Flag to use sediment ln_sediment = ', ln_sediment 71 72 ENDIF 72 73 ! 73 74 IF(lwp) THEN ! control print 74 75 WRITE(numout,*) 75 IF( ln_p5z ) WRITE(numout,*) ' ==>>> PISCES QUOTA model is used'76 IF( ln_p4z ) WRITE(numout,*) ' ==>>> PISCES STANDARD model is used'77 IF( ln_p2z ) WRITE(numout,*) ' ==>>> LOBSTER model is used'76 IF( ln_p5z ) WRITE(numout,*) ' ==>>> PISCES QUOTA model is used' 77 IF( ln_p4z ) WRITE(numout,*) ' ==>>> PISCES STANDARD model is used' 78 IF( ln_p2z ) WRITE(numout,*) ' ==>>> LOBSTER model is used' 78 79 IF( ln_ligand ) WRITE(numout,*) ' ==>>> Compute remineralization/dissolution of organic ligands' 80 IF( ln_sediment ) WRITE(numout,*) ' ==>>> Sediment module is used' 79 81 ENDIF 80 82 -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/TOP/TRP/trcdmp.F90
r10068 r10345 251 251 ! ------------------- 252 252 253 IF( cn_cfg == "orca" ) THEN253 IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA") THEN 254 254 ! 255 255 SELECT CASE ( nn_cfg ) -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/TOP/trc.F90
r10068 r10345 122 122 CHARACTER(len=20), PUBLIC, DIMENSION(jp_bdy) :: cn_trc ! Choice of boundary condition for tracers 123 123 INTEGER, PUBLIC, DIMENSION(jp_bdy) :: nn_trcdmp_bdy !: =T Tracer damping 124 ! 125 ! Vertical axis used in the sediment module 126 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: profsed 124 127 !$AGRIF_DO_NOT_TREAT 125 128 ! External data structure of BDY for TOP. Available elements: cn_obc, ll_trc, trcnow, dmp -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/TOP/trcdta.F90
r10068 r10345 217 217 ELSE !== z- or zps- coordinate ==! 218 218 ! zps-coordinate (partial steps) interpolation at the last ocean level 219 IF( ln_zps ) THEN220 DO jj = 1, jpj221 DO ji = 1, jpi222 ik = mbkt(ji,jj)223 IF( ik > 1 ) THEN224 zl = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) )225 ptrcdta(ji,jj,ik) = (1.-zl) * ptrcdta(ji,jj,ik) + zl * ptrcdta(ji,jj,ik-1)226 ENDIF227 ik = mikt(ji,jj)228 IF( ik > 1 ) THEN229 zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) )230 ptrcdta(ji,jj,ik) = (1.-zl) * ptrcdta(ji,jj,ik) + zl * ptrcdta(ji,jj,ik+1)231 ENDIF232 END DO233 END DO234 ENDIF219 ! IF( ln_zps ) THEN 220 ! DO jj = 1, jpj 221 ! DO ji = 1, jpi 222 ! ik = mbkt(ji,jj) 223 ! IF( ik > 1 ) THEN 224 ! zl = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 225 ! ptrcdta(ji,jj,ik) = (1.-zl) * ptrcdta(ji,jj,ik) + zl * ptrcdta(ji,jj,ik-1) 226 ! ENDIF 227 ! ik = mikt(ji,jj) 228 ! IF( ik > 1 ) THEN 229 ! zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) ) 230 ! ptrcdta(ji,jj,ik) = (1.-zl) * ptrcdta(ji,jj,ik) + zl * ptrcdta(ji,jj,ik+1) 231 ! ENDIF 232 ! END DO 233 ! END DO 234 ! ENDIF 235 235 ! 236 236 ENDIF -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/TOP/trcini.F90
r10314 r10345 174 174 END DO 175 175 ! 176 IF( ln_pisces ) CALL trc_ini_pisces ! PISCES model 177 IF( ln_my_trc ) CALL trc_ini_my_trc ! MY_TRC model 178 IF( ll_cfc ) CALL trc_ini_cfc ! CFC's 179 IF( ln_c14 ) CALL trc_ini_c14 ! C14 model 180 IF( ln_age ) CALL trc_ini_age ! AGE 176 IF( ln_pisces ) CALL trc_ini_pisces ! PISCES model 177 IF( ln_my_trc ) CALL trc_ini_my_trc ! MY_TRC model 178 IF( ll_cfc ) CALL trc_ini_cfc ! CFC's 179 IF( ln_c14 ) CALL trc_ini_c14 ! C14 model 180 IF( ln_age ) CALL trc_ini_age ! AGE 181 IF( .NOT.ln_pisces ) ALLOCATE( profsed(2) ) 181 182 ! 182 183 IF(lwp) THEN ! control print -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/TOP/trcrst.F90
r10314 r10345 252 252 ! parameters corresponding to nit000 - 1 (as we start the step 253 253 ! loop with a call to day) 254 ndastp = ndate0 ! ndate0 read in the namelist in dom_nam254 ndastp = ndate0 - 1 ! ndate0 read in the namelist in dom_nam 255 255 nhour = nn_time0 / 100 256 256 nminute = ( nn_time0 - nhour * 100 )
Note: See TracChangeset
for help on using the changeset viewer.