Changeset 10321 for NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP
- Timestamp:
- 2018-11-16T15:59:30+01:00 (5 years ago)
- Location:
- NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP
- Files:
-
- 2 deleted
- 104 edited
- 10 copied
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/AGE/par_age.F90
- Property svn:executable deleted
- Property svn:keywords set to Id
r9950 r10321 6 6 !! History : 2.0 ! 2007-12 (C. Ethe, G. Madec) revised architecture 7 7 !!---------------------------------------------------------------------- 8 !! NEMO/TOP 3.3, NEMO Consortium (2018)8 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 9 9 !! $Id$ 10 !! Software governed by the CeCILL licen ce (./LICENSE)10 !! Software governed by the CeCILL license (see ./LICENSE) 11 11 !!---------------------------------------------------------------------- 12 12 IMPLICIT NONE -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/AGE/trcice_age.F90
- Property svn:keywords set to Id
r9950 r10321 13 13 14 14 !!---------------------------------------------------------------------- 15 !! NEMO/TOP 3.3, NEMO Consortium (2018)15 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 16 16 !! $Id$ 17 !! Software governed by the CeCILL licen ce (./LICENSE)17 !! Software governed by the CeCILL license (see ./LICENSE) 18 18 !!---------------------------------------------------------------------- 19 19 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/AGE/trcini_age.F90
- Property svn:executable deleted
- Property svn:keywords set to Id
r9950 r10321 19 19 20 20 !!---------------------------------------------------------------------- 21 !! NEMO/TOP 3.3, NEMO Consortium (2018)21 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 22 22 !! $Id$ 23 !! Software governed by the CeCILL licen ce (./LICENSE)23 !! Software governed by the CeCILL license (see ./LICENSE) 24 24 !!---------------------------------------------------------------------- 25 25 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/AGE/trcnam_age.F90
- Property svn:keywords set to Id
r9598 r10321 18 18 19 19 !!---------------------------------------------------------------------- 20 !! NEMO/TOP 3.3, NEMO Consortium (2018)20 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 21 21 !! $Id$ 22 !! Software governed by the CeCILL licen ce (./LICENSE)22 !! Software governed by the CeCILL license (see ./LICENSE) 23 23 !!---------------------------------------------------------------------- 24 24 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/AGE/trcsms_age.F90
- Property svn:executable deleted
- Property svn:keywords set to Id
r9598 r10321 31 31 32 32 !!---------------------------------------------------------------------- 33 !! NEMO/TOP 3.3, NEMO Consortium (2018)33 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 34 34 !! $Id$ 35 !! Software governed by the CeCILL licen ce (./LICENSE)35 !! Software governed by the CeCILL license (see ./LICENSE) 36 36 !!---------------------------------------------------------------------- 37 37 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/AGE/trcwri_age.F90
- Property svn:executable deleted
- Property svn:keywords set to Id
r9950 r10321 50 50 51 51 !!---------------------------------------------------------------------- 52 !! NEMO/TOP 3.3, NEMO Consortium (2018)52 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 53 53 !! $Id$ 54 !! Software governed by the CeCILL licen ce (./LICENSE)54 !! Software governed by the CeCILL license (see ./LICENSE) 55 55 !!====================================================================== 56 56 END MODULE trcwri_age -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/C14/par_c14.F90
- Property svn:keywords set to Id
-
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/C14/sms_c14.F90
- Property svn:keywords set to Id
r9598 r10321 53 53 54 54 !!---------------------------------------------------------------------- 55 !! NEMO/TOP 3.3, NEMO Consortium (2018)56 !! $ $57 !! Software governed by the CeCILL licen ce (./LICENSE)55 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 56 !! $Id$ 57 !! Software governed by the CeCILL license (see ./LICENSE) 58 58 !!---------------------------------------------------------------------- 59 59 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/C14/trcatm_c14.F90
- Property svn:keywords set to Id
r9950 r10321 22 22 ! 23 23 !!---------------------------------------------------------------------- 24 !! NEMO/ OCE4.0 , NEMO Consortium (2018)24 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 25 25 !! $Id$ 26 !! Software governed by the CeCILL licen ce (./LICENSE)26 !! Software governed by the CeCILL license (see ./LICENSE) 27 27 !!---------------------------------------------------------------------- 28 28 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/C14/trcice_c14.F90
- Property svn:keywords set to Id
r9950 r10321 13 13 14 14 !!---------------------------------------------------------------------- 15 !! NEMO/TOP 3.3, NEMO Consortium (2018)15 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 16 16 !! $Id$ 17 !! Software governed by the CeCILL licen ce (./LICENSE)17 !! Software governed by the CeCILL license (see ./LICENSE) 18 18 !!---------------------------------------------------------------------- 19 19 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/C14/trcini_c14.F90
- Property svn:keywords set to Id
r9950 r10321 25 25 26 26 !!---------------------------------------------------------------------- 27 !! NEMO/TOP 3.3, NEMO Consortium (2018)27 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 28 28 !! $Id$ 29 !! Software governed by the CeCILL licen ce (./LICENSE)29 !! Software governed by the CeCILL license (see ./LICENSE) 30 30 !!---------------------------------------------------------------------- 31 31 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/C14/trcnam_c14.F90
- Property svn:keywords set to Id
r9950 r10321 19 19 !! 20 20 !!---------------------------------------------------------------------- 21 !! NEMO/TOP 3.3, NEMO Consortium (2018)21 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 22 22 !! $Id$ 23 !! Software governed by the CeCILL licen ce (./LICENSE)23 !! Software governed by the CeCILL license (see ./LICENSE) 24 24 !!---------------------------------------------------------------------- 25 25 -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/C14/trcsms_c14.F90
- Property svn:keywords set to Id
r9950 r10321 27 27 28 28 !!---------------------------------------------------------------------- 29 !! NEMO/TOP 3.3, NEMO Consortium (2018)29 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 30 30 !! $Id$ 31 !! Software governed by the CeCILL licen ce (./LICENSE)31 !! Software governed by the CeCILL license (see ./LICENSE) 32 32 !!---------------------------------------------------------------------- 33 33 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/C14/trcwri_c14.F90
- Property svn:keywords set to Id
r9950 r10321 131 131 132 132 !!---------------------------------------------------------------------- 133 !! NEMO/TOP 3.3, NEMO Consortium (2018)133 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 134 134 !! $Id$ 135 !! Software governed by the CeCILL licen ce (./LICENSE)135 !! Software governed by the CeCILL license (see ./LICENSE) 136 136 !!====================================================================== 137 137 END MODULE trcwri_c14 -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/CFC/par_cfc.F90
r9950 r10321 6 6 !! History : 2.0 ! 2007-12 (C. Ethe, G. Madec) revised architecture 7 7 !!---------------------------------------------------------------------- 8 !! NEMO/TOP 3.3, NEMO Consortium (2018)8 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 9 9 !! $Id$ 10 !! Software governed by the CeCILL licen ce (./LICENSE)10 !! Software governed by the CeCILL license (see ./LICENSE) 11 11 !!---------------------------------------------------------------------- 12 12 -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/CFC/trcice_cfc.F90
- Property svn:keywords set to Id
r9950 r10321 18 18 19 19 !!---------------------------------------------------------------------- 20 !! NEMO/TOP 3.3, NEMO Consortium (2018)20 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 21 21 !! $Id$ 22 !! Software governed by the CeCILL licen ce (./LICENSE)22 !! Software governed by the CeCILL license (see ./LICENSE) 23 23 !!---------------------------------------------------------------------- 24 24 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/CFC/trcini_cfc.F90
r9950 r10321 25 25 26 26 !!---------------------------------------------------------------------- 27 !! NEMO/TOP 3.3, NEMO Consortium (2018)27 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 28 28 !! $Id$ 29 !! Software governed by the CeCILL licen ce (./LICENSE)29 !! Software governed by the CeCILL license (see ./LICENSE) 30 30 !!---------------------------------------------------------------------- 31 31 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/CFC/trcnam_cfc.F90
r9950 r10321 20 20 21 21 !!---------------------------------------------------------------------- 22 !! NEMO/TOP 3.3, NEMO Consortium (2018)22 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 23 23 !! $Id$ 24 !! Software governed by the CeCILL licen ce (./LICENSE)24 !! Software governed by the CeCILL license (see ./LICENSE) 25 25 !!---------------------------------------------------------------------- 26 26 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/CFC/trcsms_cfc.F90
r9950 r10321 48 48 49 49 !!---------------------------------------------------------------------- 50 !! NEMO/TOP 3.3, NEMO Consortium (2018)50 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 51 51 !! $Id$ 52 !! Software governed by the CeCILL licen ce (./LICENSE)52 !! Software governed by the CeCILL license (see ./LICENSE) 53 53 !!---------------------------------------------------------------------- 54 54 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/CFC/trcwri_cfc.F90
- Property svn:keywords set to Id
r9950 r10321 50 50 51 51 !!---------------------------------------------------------------------- 52 !! NEMO/TOP 3.3, NEMO Consortium (2018)52 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 53 53 !! $Id$ 54 !! Software governed by the CeCILL licen ce (./LICENSE)54 !! Software governed by the CeCILL license (see ./LICENSE) 55 55 !!====================================================================== 56 56 END MODULE trcwri_cfc -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/MY_TRC/par_my_trc.F90
r9950 r10321 6 6 !! History : 2.0 ! 2007-12 (C. Ethe, G. Madec) revised architecture 7 7 !!---------------------------------------------------------------------- 8 !! NEMO/TOP 3.3, NEMO Consortium (2018)8 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 9 9 !! $Id$ 10 !! Software governed by the CeCILL licen ce (./LICENSE)10 !! Software governed by the CeCILL license (see ./LICENSE) 11 11 !!---------------------------------------------------------------------- 12 12 -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/MY_TRC/trcice_my_trc.F90
- Property svn:keywords set to Id
r9598 r10321 19 19 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 20 20 !! $Id$ 21 !! Software governed by the CeCILL licen ce (./LICENSE)21 !! Software governed by the CeCILL license (see ./LICENSE) 22 22 !!---------------------------------------------------------------------- 23 23 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/MY_TRC/trcini_my_trc.F90
r9950 r10321 24 24 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 25 25 !! $Id$ 26 !! Software governed by the CeCILL licen ce (./LICENSE)26 !! Software governed by the CeCILL license (see ./LICENSE) 27 27 !!---------------------------------------------------------------------- 28 28 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/MY_TRC/trcnam_my_trc.F90
r9950 r10321 21 21 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 22 22 !! $Id$ 23 !! Software governed by the CeCILL licen ce (./LICENSE)23 !! Software governed by the CeCILL license (see ./LICENSE) 24 24 !!---------------------------------------------------------------------- 25 25 -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/MY_TRC/trcsms_my_trc.F90
r9950 r10321 28 28 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 29 29 !! $Id$ 30 !! Software governed by the CeCILL licen ce (./LICENSE)30 !! Software governed by the CeCILL license (see ./LICENSE) 31 31 !!---------------------------------------------------------------------- 32 32 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/MY_TRC/trcwri_my_trc.F90
- Property svn:keywords set to Id
r9598 r10321 21 21 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 22 22 !! $Id$ 23 !! Software governed by the CeCILL licen ce (./LICENSE)23 !! Software governed by the CeCILL license (see ./LICENSE) 24 24 !!---------------------------------------------------------------------- 25 25 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/P2Z/p2zbio.F90
r9950 r10321 59 59 # include "vectopt_loop_substitute.h90" 60 60 !!---------------------------------------------------------------------- 61 !! NEMO/TOP 3.3, NEMO Consortium (2018)61 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 62 62 !! $Id$ 63 !! Software governed by the CeCILL licen ce (./LICENSE)63 !! Software governed by the CeCILL license (see ./LICENSE) 64 64 !!---------------------------------------------------------------------- 65 65 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/P2Z/p2zexp.F90
r9950 r10321 40 40 # include "vectopt_loop_substitute.h90" 41 41 !!---------------------------------------------------------------------- 42 !! NEMO/TOP 3.3, NEMO Consortium (2018)42 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 43 43 !! $Id$ 44 !! Software governed by the CeCILL licen ce (./LICENSE)44 !! Software governed by the CeCILL license (see ./LICENSE) 45 45 !!---------------------------------------------------------------------- 46 46 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/P2Z/p2zopt.F90
r9950 r10321 39 39 40 40 !!---------------------------------------------------------------------- 41 !! NEMO/TOP 3.3, NEMO Consortium (2018)41 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 42 42 !! $Id$ 43 !! Software governed by the CeCILL licen ce (./LICENSE)43 !! Software governed by the CeCILL license (see ./LICENSE) 44 44 !!---------------------------------------------------------------------- 45 45 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/P2Z/p2zsed.F90
r9950 r10321 32 32 33 33 !!---------------------------------------------------------------------- 34 !! NEMO/TOP 3.3, NEMO Consortium (2018)34 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 35 35 !! $Id$ 36 !! Software governed by the CeCILL licen ce (./LICENSE)36 !! Software governed by the CeCILL license (see ./LICENSE) 37 37 !!---------------------------------------------------------------------- 38 38 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/P2Z/p2zsms.F90
r9950 r10321 29 29 30 30 !!---------------------------------------------------------------------- 31 !! NEMO/TOP 3.3, NEMO Consortium (2018)31 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 32 32 !! $Id$ 33 !! Software governed by the CeCILL licen ce (./LICENSE)33 !! Software governed by the CeCILL license (see ./LICENSE) 34 34 !!---------------------------------------------------------------------- 35 35 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/P4Z/p4zagg.F90
- Property svn:keywords set to Id
r9950 r10321 25 25 26 26 !!---------------------------------------------------------------------- 27 !! NEMO/TOP 3.3, NEMO Consortium (2018)27 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 28 28 !! $Id$ 29 !! Software governed by the CeCILL licen ce (./LICENSE)29 !! Software governed by the CeCILL license (see ./LICENSE) 30 30 !!---------------------------------------------------------------------- 31 31 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/P4Z/p4zbio.F90
- Property svn:keywords set to Id
r9950 r10321 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 … … 39 39 40 40 !!---------------------------------------------------------------------- 41 !! NEMO/TOP 3.3, NEMO Consortium (2018)41 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 42 42 !! $Id$ 43 !! Software governed by the CeCILL licen ce (./LICENSE)43 !! Software governed by the CeCILL license (see ./LICENSE) 44 44 !!---------------------------------------------------------------------- 45 45 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/P4Z/p4zche.F90
r9950 r10321 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 … … 131 131 132 132 !!---------------------------------------------------------------------- 133 !! NEMO/TOP 3.3, NEMO Consortium (2018)133 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 134 134 !! $Id$ 135 !! Software governed by the CeCILL licen ce (./LICENSE)135 !! Software governed by the CeCILL license (see ./LICENSE) 136 136 !!---------------------------------------------------------------------- 137 137 CONTAINS … … 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/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/P4Z/p4zfechem.F90
- Property svn:keywords set to Id
r9950 r10321 36 36 37 37 !!---------------------------------------------------------------------- 38 !! NEMO/TOP 3.3, NEMO Consortium (2018)38 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 39 39 !! $Id$ 40 !! Software governed by the CeCILL licen ce (./LICENSE)40 !! Software governed by the CeCILL license (see ./LICENSE) 41 41 !!---------------------------------------------------------------------- 42 42 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/P4Z/p4zflx.F90
r9950 r10321 53 53 54 54 !!---------------------------------------------------------------------- 55 !! NEMO/TOP 3.3, NEMO Consortium (2018)55 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 56 56 !! $Id$ 57 !! Software governed by the CeCILL licen ce (./LICENSE)57 !! Software governed by the CeCILL license (see ./LICENSE) 58 58 !!---------------------------------------------------------------------- 59 59 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/P4Z/p4zint.F90
r9950 r10321 20 20 21 21 !!---------------------------------------------------------------------- 22 !! NEMO/TOP 3.3, NEMO Consortium (2018)22 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 23 23 !! $Id$ 24 !! Software governed by the CeCILL licen ce (./LICENSE)24 !! Software governed by the CeCILL license (see ./LICENSE) 25 25 !!---------------------------------------------------------------------- 26 26 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/P4Z/p4zligand.F90
- Property svn:keywords set to Id
r9950 r10321 27 27 28 28 !!---------------------------------------------------------------------- 29 !! NEMO/TOP 3.3, NEMO Consortium (2018)29 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 30 30 !! $Id$ 31 !! Software governed by the CeCILL licen ce (./LICENSE)31 !! Software governed by the CeCILL license (see ./LICENSE) 32 32 !!---------------------------------------------------------------------- 33 33 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/P4Z/p4zlim.F90
r10320 r10321 69 69 !!---------------------------------------------------------------------- 70 70 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 71 !! $Id : p4zlim.F90 10069 2018-08-28 14:12:24Z nicolasmartin $71 !! $Id$ 72 72 !! Software governed by the CeCILL license (see ./LICENSE) 73 73 !!---------------------------------------------------------------------- -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/P4Z/p4zlys.F90
- Property svn:keywords set to Id
r9950 r10321 36 36 37 37 !!---------------------------------------------------------------------- 38 !! NEMO/TOP 3.3, NEMO Consortium (2018)38 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 39 39 !! $Id$ 40 !! Software governed by the CeCILL licen ce (./LICENSE)40 !! Software governed by the CeCILL license (see ./LICENSE) 41 41 !!---------------------------------------------------------------------- 42 42 -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/P4Z/p4zmeso.F90
- Property svn:keywords set to Id
r9950 r10321 44 44 45 45 !!---------------------------------------------------------------------- 46 !! NEMO/TOP 3.3, NEMO Consortium (2018)46 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 47 47 !! $Id$ 48 !! Software governed by the CeCILL licen ce (./LICENSE)48 !! Software governed by the CeCILL license (see ./LICENSE) 49 49 !!---------------------------------------------------------------------- 50 50 CONTAINS … … 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/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/P4Z/p4zmicro.F90
- Property svn:keywords set to Id
r9950 r10321 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 … … 42 42 43 43 !!---------------------------------------------------------------------- 44 !! NEMO/TOP 3.3, NEMO Consortium (2018)44 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 45 45 !! $Id$ 46 !! Software governed by the CeCILL licen ce (./LICENSE)46 !! Software governed by the CeCILL license (see ./LICENSE) 47 47 !!---------------------------------------------------------------------- 48 48 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/P4Z/p4zmort.F90
r9950 r10321 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 … … 30 30 31 31 !!---------------------------------------------------------------------- 32 !! NEMO/TOP 3.3, NEMO Consortium (2018)32 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 33 33 !! $Id$ 34 !! Software governed by the CeCILL licen ce (./LICENSE)34 !! Software governed by the CeCILL license (see ./LICENSE) 35 35 !!---------------------------------------------------------------------- 36 36 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/P4Z/p4zopt.F90
- Property svn:keywords set to Id
r9950 r10321 43 43 44 44 !!---------------------------------------------------------------------- 45 !! NEMO/TOP 3.3, NEMO Consortium (2018)45 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 46 46 !! $Id$ 47 !! Software governed by the CeCILL licen ce (./LICENSE)47 !! Software governed by the CeCILL license (see ./LICENSE) 48 48 !!---------------------------------------------------------------------- 49 49 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/P4Z/p4zpoc.F90
- Property svn:keywords set to Id
r9950 r10321 38 38 39 39 !!---------------------------------------------------------------------- 40 !! NEMO/TOP 3.3, NEMO Consortium (2018)40 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 41 41 !! $Id$ 42 !! Software governed by the CeCILL licen ce (./LICENSE)42 !! Software governed by the CeCILL license (see ./LICENSE) 43 43 !!---------------------------------------------------------------------- 44 44 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/P4Z/p4zprod.F90
- Property svn:keywords set to Id
r9950 r10321 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 … … 49 49 50 50 !!---------------------------------------------------------------------- 51 !! NEMO/TOP 3.3, NEMO Consortium (2018)51 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 52 52 !! $Id$ 53 !! Software governed by the CeCILL licen ce (./LICENSE)53 !! Software governed by the CeCILL license (see ./LICENSE) 54 54 !!---------------------------------------------------------------------- 55 55 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/P4Z/p4zrem.F90
- Property svn:keywords set to Id
r9950 r10321 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 … … 43 43 44 44 !!---------------------------------------------------------------------- 45 !! NEMO/TOP 3.3, NEMO Consortium (2018)45 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 46 46 !! $Id$ 47 !! Software governed by the CeCILL licen ce (./LICENSE)47 !! Software governed by the CeCILL license (see ./LICENSE) 48 48 !!---------------------------------------------------------------------- 49 49 CONTAINS … … 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/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/P4Z/p4zsbc.F90
r9950 r10321 37 37 REAL(wp), PUBLIC :: concfediaz !: Fe half-saturation Cste for diazotrophs 38 38 REAL(wp) :: hratio !: Fe:3He ratio assumed for vent iron supply 39 REAL(wp) :: distcoast !: Distance off the coast for Iron from sediments 39 40 REAL(wp), PUBLIC :: fep_rats !: Fep/Fer ratio from sed sources 40 41 REAL(wp), PUBLIC :: fep_rath !: Fep/Fer ratio from hydro sources … … 74 75 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hydrofe !: Hydrothermal vent supply of iron 75 76 76 REAL(wp), PUBLIC :: rivalkinput, rivdicinput, nitdepinput, sumdepsi 77 REAL(wp), PUBLIC :: rivdininput, rivdipinput, rivdsiinput 77 REAL(wp), PUBLIC :: sedsilfrac, sedcalfrac 78 REAL(wp), PUBLIC :: rivalkinput, rivdicinput 79 REAL(wp), PUBLIC :: rivdininput, rivdipinput, rivdsiinput 78 80 79 81 !! * Substitutions 80 82 # include "vectopt_loop_substitute.h90" 81 83 !!---------------------------------------------------------------------- 82 !! NEMO/TOP 3.3, NEMO Consortium (2018)84 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 83 85 !! $Id$ 84 !! Software governed by the CeCILL licen ce (./LICENSE)86 !! Software governed by the CeCILL license (see ./LICENSE) 85 87 !!---------------------------------------------------------------------- 86 88 CONTAINS … … 109 111 IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_dust > 1 ) ) THEN 110 112 CALL fld_read( kt, 1, sf_dust ) 111 IF( nn_ice_tr == -1 .AND. .NOT.ln_ironice ) THEN ; dust(:,:) = sf_dust(1)%fnow(:,:,1)112 ELSE ; dust(:,:) = sf_dust(1)%fnow(:,:,1) * ( 1.-fr_i(:,:) )113 IF( nn_ice_tr == -1 .AND. .NOT.ln_ironice ) THEN ; dust(:,:) = MAX( rtrn, sf_dust(1)%fnow(:,:,1) ) 114 ELSE ; dust(:,:) = MAX( rtrn, sf_dust(1)%fnow(:,:,1) * ( 1.-fr_i(:,:) ) ) 113 115 ENDIF 114 116 ENDIF … … 173 175 zcoef = rno3 * 14E6 * ryyss 174 176 CALL fld_read( kt, 1, sf_ndepo ) 175 nitdep(:,:) = sf_ndepo(1)%fnow(:,:,1) / zcoef / e3t_n(:,:,1)177 nitdep(:,:) = MAX( rtrn, sf_ndepo(1)%fnow(:,:,1) / zcoef / e3t_n(:,:,1) ) 176 178 ENDIF 177 179 IF( .NOT.ln_linssh ) THEN 178 180 zcoef = rno3 * 14E6 * ryyss 179 nitdep(:,:) = sf_ndepo(1)%fnow(:,:,1) / zcoef / e3t_n(:,:,1)181 nitdep(:,:) = MAX( rtrn, sf_ndepo(1)%fnow(:,:,1) / zcoef / e3t_n(:,:,1) ) 180 182 ENDIF 181 183 ENDIF … … 205 207 INTEGER :: ik50 ! last level where depth less than 50 m 206 208 INTEGER :: isrow ! index for ORCA1 starting row 207 REAL(wp) :: zexpide, zdenitide, zmaskt 209 REAL(wp) :: zexpide, zdenitide, zmaskt, zsurfc, zsurfp,ze3t, ze3t2, zcslp 208 210 REAL(wp) :: ztimes_dust, ztimes_riv, ztimes_ndep 209 211 REAL(wp), DIMENSION(nbtimes) :: zsteps ! times records 210 212 REAL(wp), DIMENSION(:), ALLOCATABLE :: rivinput 211 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: z dust, zndepo, zriver, zcmask213 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zriver, zcmask 212 214 ! 213 215 CHARACTER(len=100) :: cn_dir ! Root directory for location of ssr files … … 220 222 & sn_riverdip, sn_riverdop, sn_riverdsi, sn_ndepo, sn_ironsed, sn_hydrofe, & 221 223 & ln_dust, ln_solub, ln_river, ln_ndepo, ln_ironsed, ln_ironice, ln_hydrofe, & 222 & sedfeinput, d ustsolub, icefeinput, wdust, mfrac, nitrfix, diazolight, concfediaz, &224 & sedfeinput, distcoast, dustsolub, icefeinput, wdust, mfrac, nitrfix, diazolight, concfediaz, & 223 225 & hratio, fep_rats, fep_rath, lgw_rath 224 226 !!---------------------------------------------------------------------- … … 248 250 WRITE(numout,*) ' fe input from hydrothermal vents ln_hydrofe = ', ln_hydrofe 249 251 WRITE(numout,*) ' coastal release of iron sedfeinput = ', sedfeinput 252 WRITE(numout,*) ' distance off the coast distcoast = ', distcoast 250 253 WRITE(numout,*) ' solubility of the dust dustsolub = ', dustsolub 251 254 WRITE(numout,*) ' Mineral Fe content of the dust mfrac = ', mfrac … … 307 310 CALL iom_open ( TRIM( sn_dust%clname ) , numdust ) 308 311 CALL iom_gettime( numdust, zsteps, kntime=ntimes_dust) ! get number of record in file 309 ALLOCATE( zdust(jpi,jpj,ntimes_dust) ) 310 DO jm = 1, ntimes_dust 311 CALL iom_get( numdust, jpdom_data, TRIM( sn_dust%clvar ), zdust(:,:,jm), jm ) 312 END DO 313 CALL iom_close( numdust ) 314 ztimes_dust = 1._wp / REAL(ntimes_dust, wp) 315 sumdepsi = 0.e0 316 DO jm = 1, ntimes_dust 317 sumdepsi = sumdepsi + glob_sum( zdust(:,:,jm) * e1e2t(:,:) * tmask(:,:,1) * ztimes_dust ) 318 END DO 319 sumdepsi = sumdepsi / ( nyear_len(1) * rday ) * 12. * 8.8 * 0.075 * mfrac / 28.1 320 DEALLOCATE( zdust) 321 ENDIF 322 ELSE 323 sumdepsi = 0._wp 312 END IF 324 313 END IF 325 314 … … 419 408 CALL iom_open ( TRIM( sn_ndepo%clname ), numdepo ) 420 409 CALL iom_gettime( numdepo, zsteps, kntime=ntimes_ndep) 421 ALLOCATE( zndepo(jpi,jpj,ntimes_ndep) ) 422 DO jm = 1, ntimes_ndep 423 CALL iom_get( numdepo, jpdom_data, TRIM( sn_ndepo%clvar ), zndepo(:,:,jm), jm ) 424 END DO 425 CALL iom_close( numdepo ) 426 ztimes_ndep = 1._wp / REAL(ntimes_ndep, wp) 427 nitdepinput = 0._wp 428 DO jm = 1, ntimes_ndep 429 nitdepinput = nitdepinput + glob_sum( zndepo(:,:,jm) * e1e2t(:,:) * tmask(:,:,1) * ztimes_ndep ) 430 ENDDO 431 nitdepinput = nitdepinput / rno3 / 14E6 432 DEALLOCATE( zndepo) 433 ENDIF 434 ELSE 435 nitdepinput = 0._wp 410 ENDIF 436 411 ENDIF 437 412 … … 459 434 DO jj = 2, jpjm1 460 435 DO ji = fs_2, fs_jpim1 461 IF( tmask(ji,jj,jk) /= 0. ) THEN 462 zmaskt = tmask(ji+1,jj,jk) * tmask(ji-1,jj,jk) * tmask(ji,jj+1,jk) & 463 & * tmask(ji,jj-1,jk) * tmask(ji,jj,jk+1) 464 IF( zmaskt == 0. ) zcmask(ji,jj,jk ) = MAX( 0.1, zcmask(ji,jj,jk) ) 465 END IF 436 ze3t = e3t_0(ji,jj,jk) 437 zsurfc = e1u(ji,jj) * ( 1. - umask(ji ,jj ,jk) ) & 438 + e1u(ji,jj) * ( 1. - umask(ji-1,jj ,jk) ) & 439 + e2v(ji,jj) * ( 1. - vmask(ji ,jj ,jk) ) & 440 + e2v(ji,jj) * ( 1. - vmask(ji ,jj-1,jk) ) 441 zsurfp = zsurfc * ze3t / e1e2t(ji,jj) 442 ! estimation of the coastal slope : 5 km off the coast 443 ze3t2 = ze3t * ze3t 444 zcslp = SQRT( ( distcoast*distcoast + ze3t2 ) / ze3t2 ) 445 ! 446 zcmask(ji,jj,jk) = zcmask(ji,jj,jk) + zcslp * zsurfp 466 447 END DO 467 448 END DO … … 519 500 WRITE(numout,*) ' DIC Supply : ', rivdicinput*1E3*12./1E12 ,' TgC/yr' 520 501 WRITE(numout,*) 521 WRITE(numout,*) ' Total input of elements from atmospheric supply' 522 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 523 WRITE(numout,*) ' N Supply : ', nitdepinput*rno3*1E3/1E12*14.,' TgN/yr' 524 WRITE(numout,*) 525 ENDIF 502 ENDIF 503 ! 504 sedsilfrac = 0.03 ! percentage of silica loss in the sediments 505 sedcalfrac = 0.6 ! percentage of calcite loss in the sediments 526 506 ! 527 507 END SUBROUTINE p4z_sbc_init -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/P4Z/p4zsed.F90
r9950 r10321 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 !!---------------------------------------------------------------------- 33 !! NEMO/TOP 3.3, NEMO Consortium (2018)35 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 34 36 !! $Id$ 35 !! Software governed by the CeCILL licen ce (./LICENSE)37 !! Software governed by the CeCILL license (see ./LICENSE) 36 38 !!---------------------------------------------------------------------- 37 39 CONTAINS … … 49 51 ! 50 52 INTEGER, INTENT(in) :: kt, knt ! ocean time step 51 INTEGER :: ji, jj, jk, ikt 52 REAL(wp) :: zsumsedsi, zsumsedpo4, zsumsedcal 53 REAL(wp) :: zrivalk, zrivsil, zrivno3 53 INTEGER :: ji, jj, jk, ikt 54 REAL(wp) :: zrivalk, zrivsil, zrivno3 54 55 REAL(wp) :: zwflux, zfminus, zfplus 55 56 REAL(wp) :: zlim, zfact, zfactcal … … 62 63 ! 63 64 CHARACTER (len=25) :: charout 64 REAL(wp), DIMENSION(jpi,jpj ) :: zwork1, zwork2, zwork3 65 REAL(wp), DIMENSION(jpi,jpj ) :: zdenit2d, zbureff 65 REAL(wp), DIMENSION(jpi,jpj ) :: zdenit2d, zbureff, zwork 66 66 REAL(wp), DIMENSION(jpi,jpj ) :: zwsbio3, zwsbio4, zwscal 67 67 REAL(wp), DIMENSION(jpi,jpj ) :: zsedcal, zsedsi, zsedc … … 73 73 IF( ln_timing ) CALL timing_start('p4z_sed') 74 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 83 ! 75 84 IF( kt == nittrc000 .AND. knt == 1 ) r1_rday = 1. / rday 76 85 ! … … 82 91 zdenit2d(:,:) = 0.e0 83 92 zbureff (:,:) = 0.e0 84 zwork1 (:,:) = 0.e0 85 zwork2 (:,:) = 0.e0 86 zwork3 (:,:) = 0.e0 93 zwork (:,:) = 0.e0 87 94 zsedsi (:,:) = 0.e0 88 95 zsedcal (:,:) = 0.e0 … … 189 196 ENDIF 190 197 191 ! Add the external input of iron from sediment mobilization192 ! ------------------------------------------------------193 IF( ln_ironsed ) THEN194 tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + ironsed(:,:,:) * rfact2195 IF( ln_ligand ) tra(:,:,:,jpfep) = tra(:,:,:,jpfep) + ( ironsed(:,:,:) * fep_rats ) * rfact2196 !197 IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "Ironsed" ) ) &198 & CALL iom_put( "Ironsed", ironsed(:,:,:) * 1.e+3 * tmask(:,:,:) ) ! iron inputs from sediments199 ENDIF200 201 198 ! Add the external input of iron from hydrothermal vents 202 199 ! ------------------------------------------------------ … … 235 232 236 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 237 245 ! Computation of the sediment denitrification proportion: The metamodel from midlleburg (2006) is being used 238 246 ! Computation of the fraction of organic matter that is permanently buried from Dunne's model … … 255 263 & + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) ) * 1E6 256 264 zbureff(ji,jj) = 0.013 + 0.53 * zflx**2 / ( 7.0 + zflx )**2 257 ENDIF 258 END DO 259 END DO 260 261 ! Loss of biogenic silicon, Caco3 organic carbon in the sediments. 262 ! First, the total loss is computed. 263 ! The factor for calcite comes from the alkalinity effect 264 ! ------------------------------------------------------------- 265 DO jj = 1, jpj 266 DO ji = 1, jpi 267 IF( tmask(ji,jj,1) == 1 ) THEN 268 ikt = mbkt(ji,jj) 269 zwork1(ji,jj) = trb(ji,jj,ikt,jpgsi) * zwsbio4(ji,jj) 270 zwork2(ji,jj) = trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj) + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) 271 ! For calcite, burial efficiency is made a function of saturation 272 zfactcal = MIN( excess(ji,jj,ikt), 0.2 ) 273 zfactcal = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) ) 274 zwork3(ji,jj) = trb(ji,jj,ikt,jpcal) * zwscal(ji,jj) * 2.e0 * zfactcal 275 ENDIF 276 END DO 277 END DO 278 zsumsedsi = glob_sum( zwork1(:,:) * e1e2t(:,:) ) * r1_rday 279 zsumsedpo4 = glob_sum( zwork2(:,:) * e1e2t(:,:) ) * r1_rday 280 zsumsedcal = glob_sum( zwork3(:,:) * e1e2t(:,:) ) * r1_rday 265 ENDIF 266 END DO 267 END DO 281 268 ! 282 269 ENDIF … … 285 272 ! Thus, the amount of silica lost in the sediments equal the supply at the surface (dust+rivers) 286 273 ! ------------------------------------------------------ 287 IF( .NOT.lk_sed ) zrivsil = 1._wp - ( sumdepsi + rivdsiinput * r1_ryyss ) / ( zsumsedsi + rtrn )274 IF( .NOT.lk_sed ) zrivsil = 1._wp - sedsilfrac 288 275 289 276 DO jj = 1, jpj … … 312 299 zfactcal = MIN( excess(ji,jj,ikt), 0.2 ) 313 300 zfactcal = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) ) 314 zrivalk = 1._wp - ( rivalkinput * r1_ryyss ) * zfactcal / ( zsumsedcal + rtrn )301 zrivalk = sedcalfrac * zfactcal 315 302 tra(ji,jj,ikt,jptal) = tra(ji,jj,ikt,jptal) + zcaloss * zrivalk * 2.0 316 303 tra(ji,jj,ikt,jpdic) = tra(ji,jj,ikt,jpdic) + zcaloss * zrivalk … … 492 479 IF( iom_use("Nfix" ) ) CALL iom_put( "Nfix", nitrpot(:,:,:) * nitrfix * rno3 * zfact * tmask(:,:,:) ) ! nitrogen fixation 493 480 IF( iom_use("INTNFIX") ) THEN ! nitrogen fixation rate in ocean ( vertically integrated ) 494 zwork 1(:,:) = 0.481 zwork(:,:) = 0. 495 482 DO jk = 1, jpkm1 496 zwork 1(:,:) = zwork1(:,:) + nitrpot(:,:,jk) * nitrfix * rno3 * zfact * e3t_n(:,:,jk) * tmask(:,:,jk)483 zwork(:,:) = zwork(:,:) + nitrpot(:,:,jk) * nitrfix * rno3 * zfact * e3t_n(:,:,jk) * tmask(:,:,jk) 497 484 ENDDO 498 CALL iom_put( "INTNFIX" , zwork 1)485 CALL iom_put( "INTNFIX" , zwork ) 499 486 ENDIF 500 487 IF( iom_use("SedCal" ) ) CALL iom_put( "SedCal", zsedcal(:,:) * zfact ) -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/P4Z/p4zsink.F90
- Property svn:keywords set to Id
r9950 r10321 39 39 40 40 !!---------------------------------------------------------------------- 41 !! NEMO/TOP 3.3, NEMO Consortium (2018)41 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 42 42 !! $Id$ 43 !! Software governed by the CeCILL licen ce (./LICENSE)43 !! Software governed by the CeCILL license (see ./LICENSE) 44 44 !!---------------------------------------------------------------------- 45 45 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/P4Z/p4zsms.F90
- Property svn:keywords set to Id
r9950 r10321 40 40 41 41 !!---------------------------------------------------------------------- 42 !! NEMO/TOP 3.3, NEMO Consortium (2018)42 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 43 43 !! $Id$ 44 !! Software governed by the CeCILL licen ce (./LICENSE)44 !! Software governed by the CeCILL license (see ./LICENSE) 45 45 !!---------------------------------------------------------------------- 46 46 CONTAINS … … 101 101 ENDIF 102 102 ! 103 IF( ll_sbc ) CALL p4z_sbc( kt ) ! external sources of nutrients 104 ! 105 #if ! defined key_sed_off 103 106 CALL p4z_che ! computation of chemical constants 104 107 CALL p4z_int( kt ) ! computation of various rates for biogeochemistry 105 108 ! 106 IF( ll_sbc ) CALL p4z_sbc( kt ) ! external sources of nutrients107 108 109 DO jnt = 1, nrdttrc ! Potential time splitting if requested 109 110 ! … … 149 150 END DO 150 151 END IF 151 ! 152 IF( lk_sed ) THEN 152 #endif 153 ! 154 IF( ln_sediment ) THEN 153 155 ! 154 156 CALL sed_model( kt ) ! Main program of Sediment model 157 ! 158 IF( ln_top_euler ) THEN 159 DO jn = jp_pcs0, jp_pcs1 160 trn(:,:,:,jn) = trb(:,:,:,jn) 161 END DO 162 ENDIF 155 163 ! 156 164 ENDIF … … 352 360 IF(lwp) WRITE(numout,*) 353 361 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( cvol(:,:,:) ) * 1e6 358 359 zalksumn = glob_sum( trn(:,:,:,jptal) * cvol(:,:,:) ) * zarea 360 zpo4sumn = glob_sum( trn(:,:,:,jppo4) * cvol(:,:,:) ) * zarea * po4r 361 zno3sumn = glob_sum( trn(:,:,:,jpno3) * cvol(:,:,:) ) * zarea * rno3 362 zsilsumn = glob_sum( trn(:,:,:,jpsil) * cvol(:,:,:) ) * zarea 362 IF( cn_cfg == "ORCA" .OR. cn_cfg == "orca") THEN 363 IF( .NOT. lk_c1d ) THEN ! ORCA configuration (not 1D) ! 364 ! ! --------------------------- ! 365 ! set total alkalinity, phosphate, nitrate & silicate 366 zarea = 1._wp / glob_sum( cvol(:,:,:) ) * 1e6 367 368 zalksumn = glob_sum( trn(:,:,:,jptal) * cvol(:,:,:) ) * zarea 369 zpo4sumn = glob_sum( trn(:,:,:,jppo4) * cvol(:,:,:) ) * zarea * po4r 370 zno3sumn = glob_sum( trn(:,:,:,jpno3) * cvol(:,:,:) ) * zarea * rno3 371 zsilsumn = glob_sum( trn(:,:,:,jpsil) * cvol(:,:,:) ) * zarea 363 372 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( trb(:,:,:,jptal) * cvol(:,:,:) ) * zarea379 zpo4sumb = glob_sum( trb(:,:,:,jppo4) * cvol(:,:,:) ) * zarea * po4r380 zno3sumb = glob_sum( trb(:,:,:,jpno3) * cvol(:,:,:) ) * zarea * rno3381 zsilsumb = glob_sum( trb(:,:,:,jpsil) * cvol(:,:,:) ) * zarea373 IF(lwp) WRITE(numout,*) ' TALKN mean : ', zalksumn 374 trn(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / zalksumn 375 376 IF(lwp) WRITE(numout,*) ' PO4N mean : ', zpo4sumn 377 trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / zpo4sumn 378 379 IF(lwp) WRITE(numout,*) ' NO3N mean : ', zno3sumn 380 trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / zno3sumn 381 382 IF(lwp) WRITE(numout,*) ' SiO3N mean : ', zsilsumn 383 trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * silmean / zsilsumn ) 384 ! 385 ! 386 IF( .NOT. ln_top_euler ) THEN 387 zalksumb = glob_sum( trb(:,:,:,jptal) * cvol(:,:,:) ) * zarea 388 zpo4sumb = glob_sum( trb(:,:,:,jppo4) * cvol(:,:,:) ) * zarea * po4r 389 zno3sumb = glob_sum( trb(:,:,:,jpno3) * cvol(:,:,:) ) * zarea * rno3 390 zsilsumb = glob_sum( trb(:,:,:,jpsil) * cvol(:,:,:) ) * zarea 382 391 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 ) 392 IF(lwp) WRITE(numout,*) ' ' 393 IF(lwp) WRITE(numout,*) ' TALKB mean : ', zalksumb 394 trb(:,:,:,jptal) = trb(:,:,:,jptal) * alkmean / zalksumb 395 396 IF(lwp) WRITE(numout,*) ' PO4B mean : ', zpo4sumb 397 trb(:,:,:,jppo4) = trb(:,:,:,jppo4) * po4mean / zpo4sumb 398 399 IF(lwp) WRITE(numout,*) ' NO3B mean : ', zno3sumb 400 trb(:,:,:,jpno3) = trb(:,:,:,jpno3) * no3mean / zno3sumb 401 402 IF(lwp) WRITE(numout,*) ' SiO3B mean : ', zsilsumb 403 trb(:,:,:,jpsil) = MIN( 400.e-6,trb(:,:,:,jpsil) * silmean / zsilsumb ) 404 ENDIF 395 405 ENDIF 396 406 ! -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/P4Z/p5zlim.F90
r10320 r10321 123 123 !!---------------------------------------------------------------------- 124 124 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 125 !! $Id : p5zlim.F90 10070 2018-08-28 14:30:54Z nicolasmartin $125 !! $Id$ 126 126 !! Software governed by the CeCILL license (see ./LICENSE) 127 127 !!---------------------------------------------------------------------- -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/P4Z/p5zmeso.F90
- Property svn:executable deleted
- Property svn:keywords set to Id
r9950 r10321 51 51 52 52 !!---------------------------------------------------------------------- 53 !! NEMO/TOP 3.3, NEMO Consortium (2018)53 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 54 54 !! $Id$ 55 !! Software governed by the CeCILL licen ce (./LICENSE)55 !! Software governed by the CeCILL license (see ./LICENSE) 56 56 !!---------------------------------------------------------------------- 57 57 -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/P4Z/p5zmicro.F90
- Property svn:executable deleted
- Property svn:keywords set to Id
r9950 r10321 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 … … 51 51 52 52 !!---------------------------------------------------------------------- 53 !! NEMO/TOP 3.3, NEMO Consortium (2018)53 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 54 54 !! $Id$ 55 !! Software governed by the CeCILL licen ce (./LICENSE)55 !! Software governed by the CeCILL license (see ./LICENSE) 56 56 !!---------------------------------------------------------------------- 57 57 -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/P4Z/p5zmort.F90
- Property svn:executable deleted
- Property svn:keywords set to Id
r9950 r10321 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 … … 33 33 34 34 !!---------------------------------------------------------------------- 35 !! NEMO/TOP 3.3, NEMO Consortium (2018)35 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 36 36 !! $Id$ 37 !! Software governed by the CeCILL licen ce (./LICENSE)37 !! Software governed by the CeCILL license (see ./LICENSE) 38 38 !!---------------------------------------------------------------------- 39 39 -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/P4Z/p5zprod.F90
- Property svn:executable deleted
- Property svn:keywords set to Id
r9950 r10321 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 … … 53 53 54 54 !!---------------------------------------------------------------------- 55 !! NEMO/TOP 3.3, NEMO Consortium (2018)55 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 56 56 !! $Id$ 57 !! Software governed by the CeCILL licen ce (./LICENSE)57 !! Software governed by the CeCILL license (see ./LICENSE) 58 58 !!---------------------------------------------------------------------- 59 59 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/SED/par_sed.F90
r9950 r10321 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 licence (./LICENSE)70 !!======================================================================71 66 END MODULE par_sed -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/SED/sed.F90
r9950 r10321 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/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/SED/sed_oce.F90
r10320 r10321 18 18 REAL(wp), PUBLIC, DIMENSION(: ), ALLOCATABLE :: profsedw !: depth of middle of each layer 19 19 20 !! $Id : sed.F90 7646 2017-02-06 09:25:03Z timgraham$20 !! $Id$ 21 21 CONTAINS 22 22 -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/SED/sedadv.F90
r9950 r10321 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/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/SED/sedarr.F90
r9950 r10321 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 3.3 , NEMO Consortium (201 8)32 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 31 33 !! $Id$ 32 !! Software governed by the CeCILL licence ( ./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/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/SED/sedbtb.F90
r9950 r10321 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/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/SED/sedchem.F90
r9950 r10321 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/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/SED/sedco3.F90
r9950 r10321 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/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/SED/seddiff.F90
r10320 r10321 20 20 !! * Module variables 21 21 22 !! $Id : seddsr.F90 5215 2015-04-15 16:11:56Z nicolasmartin$22 !! $Id$ 23 23 CONTAINS 24 24 -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/SED/seddsr.F90
r9950 r10321 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/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/SED/seddta.F90
r9950 r10321 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 10 USE iom 11 USE lib_mpp ! distribued memory computing library 11 12 12 13 IMPLICIT NONE … … 17 18 18 19 !! * Module variables 19 REAL(wp), DIMENSION(:), ALLOCATABLE :: smask ! mask for sediments points20 20 REAL(wp) :: rsecday ! number of second per a day 21 REAL(wp) :: conv1 ! [m/day]--->[cm/s]22 21 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 22 30 23 !! $Id$ … … 54 47 INTEGER :: ji, jj, js, jw, ikt 55 48 56 REAL(wp), DIMENSION( :,:), ALLOCATABLE :: zdta57 REAL(wp), DIMENSION( :) , ALLOCATABLE :: zdtap, zdtag58 49 REAL(wp), DIMENSION(jpoce) :: zdtap, zdtag 50 REAL(wp), DIMENSION(jpi,jpj) :: zwsbio4, zwsbio3, zwscal 51 REAL(wp) :: zf0, zf1, zf2, zkapp, zratio, zdep 59 52 60 53 !---------------------------------------------------------------------- … … 64 57 !------------------------------------------------------------- 65 58 66 WRITE(numsed,*) 67 WRITE(numsed,*) ' sed_dta : Bottom layer fields' 68 WRITE(numsed,*) ' ~~~~~~' 69 WRITE(numsed,*) ' Data from SMS model' 70 WRITE(numsed,*) 59 IF( ln_timing ) CALL timing_start('sed_dta') 60 61 IF (lwp) THEN 62 WRITE(numsed,*) 63 WRITE(numsed,*) ' sed_dta : Bottom layer fields' 64 WRITE(numsed,*) ' ~~~~~~' 65 WRITE(numsed,*) ' Data from SMS model' 66 WRITE(numsed,*) 67 ENDIF 71 68 72 69 73 70 ! open file 74 71 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 72 IF (lwp) WRITE(numsed,*) ' sed_dta : Sediment fields' 73 dtsed = r2dttrc 80 74 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) ) 75 ! conv2 = 1.0e+3 / ( 1.0e+4 * rsecday * 30. ) 76 conv2 = 1.0e+3 / 1.0e+4 77 rdtsed(2:jpksed) = dtsed / ( denssol * por1(2:jpksed) ) 78 ENDIF 79 80 ! Initialization of temporaries arrays 81 zdtap(:) = 0. 82 zdtag(:) = 0. 83 84 ! reading variables 85 IF (lwp) WRITE(numsed,*) 86 IF (lwp) WRITE(numsed,*) ' sed_dta : Bottom layer fields at time kt = ', kt 87 ! reading variables 88 ! 89 ! Sinking speeds of detritus is increased with depth as shown 90 ! by data and from the coagulation theory 91 ! ----------------------------------------------------------- 92 IF (ln_sediment_offline) THEN 86 93 DO jj = 1, jpj 87 94 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 95 ikt = mbkt(ji,jj) 96 zwsbio4(ji,jj) = wsbio2 / rday 97 zwsbio3(ji,jj) = wsbio / rday 98 zwscal (ji,jj) = wsbio2 / rday 99 END DO 100 END DO 101 ELSE 102 DO jj = 1, jpj 109 103 DO ji = 1, jpi 110 104 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 105 zdep = e3t_n(ji,jj,ikt) / r2dttrc 106 zwsbio4(ji,jj) = MIN( 0.99 * zdep, wsbio4(ji,jj,ikt) / rday ) 107 zwscal (ji,jj) = MIN( 0.99 * zdep, wscal (ji,jj,ikt) / rday ) 108 zwsbio3(ji,jj) = MIN( 0.99 * zdep, wsbio3(ji,jj,ikt) / rday ) 109 END DO 110 END DO 111 ENDIF 112 113 trc_data(:,:,:) = 0. 114 DO jj = 1,jpj 115 DO ji = 1, jpi 116 ikt = mbkt(ji,jj) 117 IF ( tmask(ji,jj,ikt) == 1 ) THEN 118 trc_data(ji,jj,1) = trb(ji,jj,ikt,jpsil) 119 trc_data(ji,jj,2) = trb(ji,jj,ikt,jpoxy) 120 trc_data(ji,jj,3) = trb(ji,jj,ikt,jpdic) 121 trc_data(ji,jj,4) = trb(ji,jj,ikt,jpno3) / 7.625 122 trc_data(ji,jj,5) = trb(ji,jj,ikt,jppo4) / 122. 123 trc_data(ji,jj,6) = trb(ji,jj,ikt,jptal) 124 trc_data(ji,jj,7) = trb(ji,jj,ikt,jpnh4) / 7.625 125 trc_data(ji,jj,8) = 0.0 126 trc_data(ji,jj,9) = 28.0E-3 127 trc_data(ji,jj,10) = trb(ji,jj,ikt,jpfer) 128 trc_data(ji,jj,11 ) = MIN(trb(ji,jj,ikt,jpgsi), 1E-4) * zwsbio4(ji,jj) * 1E3 129 trc_data(ji,jj,12 ) = MIN(trb(ji,jj,ikt,jppoc), 1E-4) * zwsbio3(ji,jj) * 1E3 130 trc_data(ji,jj,13 ) = MIN(trb(ji,jj,ikt,jpgoc), 1E-4) * zwsbio4(ji,jj) * 1E3 131 trc_data(ji,jj,14) = MIN(trb(ji,jj,ikt,jpcal), 1E-4) * zwscal (ji,jj) * 1E3 132 trc_data(ji,jj,15) = tsn(ji,jj,ikt,jp_tem) 133 trc_data(ji,jj,16) = tsn(ji,jj,ikt,jp_sal) 134 trc_data(ji,jj,17 ) = ( trb(ji,jj,ikt,jpsfe) * zwsbio3(ji,jj) + trb(ji,jj,ikt,jpbfe) & 135 & * zwsbio4(ji,jj) ) * 1E3 / ( trc_data(ji,jj,12 ) + trc_data(ji,jj,13 ) + rtrn ) 136 trc_data(ji,jj,17 ) = MIN(1E-3, trc_data(ji,jj,17 ) ) 137 ENDIF 126 138 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 139 ENDDO 140 141 ! Pore water initial concentration [mol/l] in k=1 142 !------------------------------------------------- 143 DO jw = 1, jpwat 144 CALL pack_arr ( jpoce, pwcp_dta(1:jpoce,jw), trc_data(1:jpi,1:jpj,jw), iarroce(1:jpoce) ) 145 END DO 146 ! Solid components : 147 !----------------------- 148 ! Sinking fluxes for OPAL in mol.m-2.s-1 ; conversion in mol.cm-2.s-1 149 CALL pack_arr ( jpoce, rainrm_dta(1:jpoce,jsopal), trc_data(1:jpi,1:jpj,11), iarroce(1:jpoce) ) 150 rainrm_dta(1:jpoce,jsopal) = rainrm_dta(1:jpoce,jsopal) * 1e-4 151 ! Sinking fluxes for POC in mol.m-2.s-1 ; conversion in mol.cm-2.s-1 152 CALL pack_arr ( jpoce, zdtap(1:jpoce), trc_data(1:jpi,1:jpj,12) , iarroce(1:jpoce) ) 153 CALL pack_arr ( jpoce, zdtag(1:jpoce), trc_data(1:jpi,1:jpj,13) , iarroce(1:jpoce) ) 154 DO ji = 1, jpoce 155 ! zkapp = MIN( (1.0 - 0.02 ) * reac_poc, 3731.0 * max(100.0, zkbot(ji) )**(-1.011) / ( 365.0 * 24.0 * 3600.0 ) ) 156 ! zkapp = MIN( 0.98 * reac_poc, 100.0 * max(100.0, zkbot(ji) )**(-0.6) / ( 365.0 * 24.0 * 3600.0 ) ) 157 ! 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 ) 158 ! zf1 = ( 0.02 * (reac_poc - reac_poc * 0.) + zkapp - reac_poc ) / ( reac_poc / 100. - reac_poc ) 159 ! zf1 = MIN(0.98, MAX(0., zf1 ) ) 160 zf1 = 0.48 161 zf0 = 1.0 - 0.02 - zf1 162 zf2 = 0.02 163 rainrm_dta(ji,jspoc) = ( zdtap(ji) + zdtag(ji) ) * 1e-4 * zf0 164 rainrm_dta(ji,jspos) = ( zdtap(ji) + zdtag(ji) ) * 1e-4 * zf1 165 rainrm_dta(ji,jspor) = ( zdtap(ji) + zdtag(ji) ) * 1e-4 * zf2 166 END DO 167 ! Sinking fluxes for Calcite in mol.m-2.s-1 ; conversion in mol.cm-2.s-1 168 CALL pack_arr ( jpoce, rainrm_dta(1:jpoce,jscal), trc_data(1:jpi,1:jpj,14), iarroce(1:jpoce) ) 169 rainrm_dta(1:jpoce,jscal) = rainrm_dta(1:jpoce,jscal) * 1e-4 170 ! vector temperature [°C] and salinity 171 CALL pack_arr ( jpoce, temp(1:jpoce), trc_data(1:jpi,1:jpj,15), iarroce(1:jpoce) ) 172 CALL pack_arr ( jpoce, salt(1:jpoce), trc_data(1:jpi,1:jpj,16), iarroce(1:jpoce) ) 173 174 ! Clay rain rate in [mol/(cm**2.s)] 175 ! inputs data in [kg.m-2.sec-1] ---> 1e+3/(1e+4) [g.cm-2.s-1] 176 ! divided after by molecular weight g.mol-1 177 CALL pack_arr ( jpoce, rainrm_dta(1:jpoce,jsclay), dust(1:jpi,1:jpj), iarroce(1:jpoce) ) 178 rainrm_dta(1:jpoce,jsclay) = rainrm_dta(1:jpoce,jsclay) * conv2 / mol_wgt(jsclay) & 179 & + wacc(1:jpoce) * por1(2) * denssol / mol_wgt(jsclay) / ( rsecday * 365.0 ) 180 rainrm_dta(1:jpoce,jsclay) = rainrm_dta(1:jpoce,jsclay) * 0.965 181 rainrm_dta(1:jpoce,jsfeo) = rainrm_dta(1:jpoce,jsclay) * mol_wgt(jsclay) / mol_wgt(jsfeo) * 0.035 / 0.965 182 ! rainrm_dta(1:jpoce,jsclay) = 1.0E-4 * conv2 / mol_wgt(jsclay) 183 184 ! Iron monosulphide rain rates. Set to 0 185 rainrm_dta(1:jpoce,jsfes) = 0. 186 187 ! Fe/C ratio in sinking particles that fall to the sediments 188 CALL pack_arr ( jpoce, fecratio(1:jpoce), trc_data(1:jpi,1:jpj,17), iarroce(1:jpoce) ) 189 190 sedligand(:,1) = 1.E-9 189 191 190 192 ! sediment pore water at 1st layer (k=1) 191 193 DO jw = 1, jpwat 192 pwcp(1:jpoce,1,jw) = pwcp_dta(1:jpoce,jw) * smask(1:jpoce)194 pwcp(1:jpoce,1,jw) = pwcp_dta(1:jpoce,jw) 193 195 ENDDO 194 196 195 197 ! rain 196 198 DO js = 1, jpsol 197 rainrm(1:jpoce,js) = rainrm_dta(1:jpoce,js) * smask(1:jpoce)199 rainrm(1:jpoce,js) = rainrm_dta(1:jpoce,js) 198 200 ENDDO 199 201 … … 212 214 dzdep(1:jpoce) = raintg(1:jpoce) * rdtsed(2) 213 215 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 216 IF( lk_iomput ) THEN 217 IF( iom_use("sflxclay" ) ) CALL iom_put( "sflxclay", dust(:,:) * conv2 * 1E4 ) 218 IF( iom_use("sflxcal" ) ) CALL iom_put( "sflxcal", trc_data(:,:,13) ) 219 IF( iom_use("sflxbsi" ) ) CALL iom_put( "sflxbsi", trc_data(:,:,10) ) 220 IF( iom_use("sflxpoc" ) ) CALL iom_put( "sflxpoc", trc_data(:,:,11) + trc_data(:,:,12) ) 221 ENDIF 222 223 IF( ln_timing ) CALL timing_stop('sed_dta') 224 224 225 225 END SUBROUTINE sed_dta 226 226 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 227 END MODULE seddta -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/SED/sedini.F90
r9950 r10321 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 trcdmp_sed 16 USE trcdta 18 17 USE iom 18 USE lib_mpp ! distribued memory computing library 19 19 20 20 … … 24 24 !! Module variables 25 25 REAL(wp) :: & 26 sisat = 800. , & !: saturation for si [ mol.l-1] 27 claysat = 0. , & !: saturation for clay [ mol.l-1] 26 sedzmin = 0.3 , & !: Minimum vertical spacing 27 sedhmax = 10.0 , & !: Maximum depth of the sediment 28 sedkth = 5.0 , & !: Default parameters 29 sedacr = 3.0 !: Default parameters 30 31 REAL(wp) :: & 32 porsurf = 0.95 , & !: Porosity at the surface 33 porinf = 0.75 , & !: Porosity at infinite depth 34 rhox = 2.0 !: Vertical length scale of porosity variation 35 36 REAL(wp) :: & 28 37 rcopal = 40. , & !: reactivity for si [l.mol-1.an-1] 29 rcclay = 0. , & !: reactivity for clay [l.mol-1.an-1]30 38 dcoef = 8.e-6 !: diffusion coefficient (*por) [cm**2/s] 31 39 40 REAL(wp), PUBLIC :: & 41 redO2 = 172. , & !: Redfield coef for Oxygen 42 redNo3 = 16. , & !: Redfield coef for Nitrate 43 redPo4 = 1. , & !: Redfield coef for Phosphate 44 redC = 122. , & !: Redfield coef for Carbon 45 redfep = 0.175 , & !: Ratio for iron bound phosphorus 46 rcorgl = 50. , & !: reactivity for POC/O2 [l.mol-1.an-1] 47 rcorgs = 0.5 , & !: reactivity of the semi-labile component 48 rcorgr = 1E-4 , & !: reactivity of the refractory component 49 rcnh4 = 10E6 , & !: reactivity for O2/NH4 [l.mol-1.an-1] 50 rch2s = 1.E5 , & !: reactivity for O2/ODU [l.mol-1.an-1] 51 rcfe2 = 5.E8 , & !: reactivity for O2/Fe2+ [l.mol-1.an-1] 52 rcfeh2s = 1.E4 , & !: Reactivity for FEOH/H2S [l.mol-1.an-1] 53 rcfes = 1.E5 , & !: Reactivity for FE2+/H2S [l.mol-1.an-1] 54 rcfeso = 3.E5 , & !: Reactivity for FES/O2 [l.mol-1.an-1] 55 xksedo2 = 5E-6 , & !: half-sturation constant for oxic remin. 56 xksedno3 = 5E-6 , & !: half-saturation constant for denitrification 57 xksedfeo = 0.6 , & !: half-saturation constant for iron remin 58 xksedso4 = 2E-3 !: half-saturation constant for SO4 remin 59 32 60 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 61 rccal = 1000., & !: reactivity for calcite [l.mol-1.an-1] 62 rcligc = 1.E-4 !: L/C ratio in POC 63 64 REAL(wp), PUBLIC :: dbiot = 15. , & !: coefficient for bioturbation [cm**2.(n-1)] 65 dbtbzsc = 10.0 , & !: Vertical scale of variation. If no variation, mixed layer in the sed [cm] 66 xirrzsc = 2.0 !: Vertical scale of irrigation variation. 51 67 REAL(wp) :: & 52 68 ryear = 365. * 24. * 3600. !: 1 year converted in second 69 70 REAL(wp), DIMENSION(jpwat), PUBLIC :: diff1 71 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 / 72 73 REAL(wp), DIMENSION(jpwat), PUBLIC :: diff2 74 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 / 75 76 53 77 54 78 !! * Routine accessibility … … 76 100 !! ! 06-07 (C. Ethe) Re-organization 77 101 !!---------------------------------------------------------------------- 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 102 INTEGER :: ji, jj, ikt, ierr 84 103 !!---------------------------------------------------------------------- 85 104 … … 90 109 CALL ctl_opn( numsed, 'sediment.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 91 110 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 111 IF (lwp) THEN 112 WRITE(numsed,*) 113 WRITE(numsed,*) ' PISCES framework' 114 WRITE(numsed,*) ' SEDIMENT model' 115 WRITE(numsed,*) ' version 3.0 (2018) ' 116 WRITE(numsed,*) 117 WRITE(numsed,*) 118 ENDIF 119 120 IF(lwp) WRITE(numsed,*) ' sed_init : Initialization of sediment module ' 121 IF(lwp) WRITE(numsed,*) ' ' 122 123 ! Read sediment Namelist 124 !------------------------- 125 CALL sed_init_nam 126 127 ! Allocate SEDIMENT arrays 128 ierr = sed_alloc() 129 ierr = ierr + sed_oce_alloc() 130 ierr = ierr + sed_adv_alloc() 131 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'sed_ini: unable to allocate sediment model arrays' ) 106 132 107 133 ! 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 134 epkbot(:,:) = 0. 142 135 DO jj = 1, jpj … … 144 137 ikt = mbkt(ji,jj) 145 138 IF( tmask(ji,jj,ikt) == 1 ) epkbot(ji,jj) = e3t_1d(ikt) 139 gdepbot(ji,jj) = gdepw_0(ji,jj,ikt) 146 140 ENDDO 147 141 ENDDO 148 #endif149 150 142 151 143 ! computation of total number of ocean points 152 144 !-------------------------------------------- 153 jpoce = COUNT( epkbot(:,:) > 0. ) 154 145 sedmask = 0. 146 IF ( COUNT( epkbot(:,:) > 0. ) == 0 ) THEN 147 sedmask = 0. 148 ELSE 149 sedmask = 1. 150 ENDIF 151 jpoce = MAX( COUNT( epkbot(:,:) > 0. ) , 1 ) 155 152 156 153 ! Allocate memory size of global variables … … 159 156 ALLOCATE( rainrm(jpoce,jpsol) ) ; ALLOCATE( rainrg(jpoce,jpsol) ) ; ALLOCATE( raintg(jpoce) ) 160 157 ALLOCATE( dzdep(jpoce) ) ; ALLOCATE( iarroce(jpoce) ) ; ALLOCATE( dzkbot(jpoce) ) 161 ALLOCATE( temp(jpoce) ) ; ALLOCATE( salt(jpoce) ) 158 ALLOCATE( zkbot(jpoce) ) ; ALLOCATE( db(jpoce,jpksed) ) 159 ALLOCATE( temp(jpoce) ) ; ALLOCATE( salt(jpoce) ) 160 ALLOCATE( diff(jpoce,jpksed,jpwat ) ) ; ALLOCATE( irrig(jpoce, jpksed) ) 161 ALLOCATE( wacc(jpoce) ) ; ALLOCATE( fecratio(jpoce) ) 162 162 ALLOCATE( press(jpoce) ) ; ALLOCATE( densSW(jpoce) ) 163 ALLOCATE( hipor(jpoce,jpksed) ) ; ALLOCATE( co3por(jpoce,jpksed) ) 163 ALLOCATE( hipor(jpoce,jpksed) ) ; ALLOCATE( co3por(jpoce,jpksed) ) 164 164 ALLOCATE( dz3d(jpoce,jpksed) ) ; ALLOCATE( volw3d(jpoce,jpksed) ) ; ALLOCATE( vols3d(jpoce,jpksed) ) 165 ALLOCATE( sedligand(jpoce, jpksed) ) 165 166 166 167 ! 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. 168 pwcp (:,:,:) = 0. ; pwcp0 (:,:,:) = 0. ; pwcp_dta (:,:) = 0. 169 solcp (:,:,:) = 0. ; solcp0(:,:,:) = 0. ; rainrm_dta(:,:) = 0. 170 rainrm(:,: ) = 0. ; rainrg(:,: ) = 0. ; raintg (: ) = 0. 171 dzdep (: ) = 0. ; iarroce(: ) = 0 ; dzkbot (: ) = 0. 172 temp (: ) = 0. ; salt (: ) = 0. ; zkbot (: ) = 0. 173 press (: ) = 0. ; densSW (: ) = 0. ; db (:,:) = 0. 174 hipor (:,: ) = 0. ; co3por (:,: ) = 0. ; irrig (:,:) = 0. 175 dz3d (:,: ) = 0. ; volw3d (:,: ) = 0. ; vols3d (:,:) = 0. 176 fecratio(:) = 1E-5 177 sedligand(:,:) = 0.6E-9 175 178 176 179 ! Chemical variables … … 178 181 ALLOCATE( ak1ps (jpoce) ) ; ALLOCATE( ak2ps (jpoce) ) ; ALLOCATE( ak3ps (jpoce) ) ; ALLOCATE( aksis (jpoce) ) 179 182 ALLOCATE( aksps (jpoce) ) ; ALLOCATE( ak12s (jpoce) ) ; ALLOCATE( ak12ps(jpoce) ) ; ALLOCATE( ak123ps(jpoce) ) 180 ALLOCATE( borats(jpoce) ) ; ALLOCATE( calcon2(jpoce) ) 183 ALLOCATE( borats(jpoce) ) ; ALLOCATE( calcon2(jpoce) ) ; ALLOCATE( sieqs (jpoce) ) 184 ALLOCATE( aks3s(jpoce) ) ; ALLOCATE( akf3s(jpoce) ) ; ALLOCATE( sulfats(jpoce) ) 185 ALLOCATE( fluorids(jpoce) ) 181 186 182 187 akbs (:) = 0. ; ak1s (:) = 0. ; ak2s (:) = 0. ; akws (:) = 0. 183 188 ak1ps (:) = 0. ; ak2ps (:) = 0. ; ak3ps (:) = 0. ; aksis (:) = 0. 184 189 aksps (:) = 0. ; ak12s (:) = 0. ; ak12ps(:) = 0. ; ak123ps(:) = 0. 185 borats(:) = 0. ; calcon2(:) = 0. 190 borats(:) = 0. ; calcon2(:) = 0. ; sieqs (:) = 0. 191 aks3s(:) = 0. ; akf3s(:) = 0. ; sulfats(:) = 0. ; fluorids(:) = 0. 186 192 187 193 ! Mass balance calculation … … 191 197 fromsed(:,:) = 0. ; tosed(:,:) = 0. ; rloss(:,:) = 0. ; tokbot(:,:) = 0. 192 198 193 ! Read sediment Namelist194 !-------------------------195 CALL sed_init_nam196 197 199 ! Initialization of sediment geometry 198 200 !------------------------------------ 199 201 CALL sed_init_geom 200 202 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 203 ! Offline specific mode 204 ! --------------------- 205 ln_sediment_offline = .FALSE. 206 207 #if defined key_sed_off 208 ln_sediment_offline = .TRUE. 209 IF (lwp) write(numsed,*) 'Sediment module is run in offline mode' 210 IF (lwp) write(numsed,*) 'key_sed_off is activated at compilation time' 211 IF (lwp) write(numsed,*) 'ln_sed_2way is forced to false' 212 IF (lwp) write(numsed,*) '--------------------------------------------' 213 ln_sed_2way = .FALSE. 214 #endif 215 ! Initialisation of tracer damping 216 ! -------------------------------- 217 IF (ln_sediment_offline) THEN 218 CALL trc_dta_ini(jptra) 219 CALL trc_dmp_sed_ini 220 ENDIF 210 221 211 222 END SUBROUTINE sed_init 212 213 223 214 224 SUBROUTINE sed_init_geom … … 227 237 !! * Modules used 228 238 !! * 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 239 INTEGER :: ji, jj, jk, jn 240 REAL(wp) :: za0, za1, zt, zw, zsum, zsur, zprof, zprofw 241 REAL(wp) :: ztmp1, ztmp2 236 242 !---------------------------------------------------------- 237 243 238 WRITE(numsed,*) ' sed_init_geom : Initialization of sediment geometry '239 WRITE(numsed,*) ' '244 IF(lwp) WRITE(numsed,*) ' sed_init_geom : Initialization of sediment geometry ' 245 IF(lwp) WRITE(numsed,*) ' ' 240 246 241 247 ! Computation of 1D array of sediments points … … 250 256 END DO 251 257 258 IF ( indoce .EQ. 0 ) THEN 259 indoce = 1 260 iarroce(indoce) = 1 261 ENDIF 262 252 263 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 264 CALL ctl_stop( 'STOP', 'sed_ini: number of ocean points indoce doesn''t match number of point' ) 259 265 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 266 IF (lwp) WRITE(numsed,*) ' ' 267 IF (lwp) WRITE(numsed,*) ' total number of ocean points jpoce = ',jpoce 268 IF (lwp) WRITE(numsed,*) ' ' 269 ENDIF 285 270 286 271 ! initialization of dzkbot in [cm] … … 288 273 CALL pack_arr ( jpoce, dzkbot(1:jpoce), epkbot(1:jpi,1:jpj), iarroce(1:jpoce) ) 289 274 dzkbot(1:jpoce) = dzkbot(1:jpoce) * 1.e+2 275 CALL pack_arr ( jpoce, zkbot(1:jpoce), gdepbot(1:jpi,1:jpj), iarroce(1:jpoce) ) 290 276 291 277 ! Geometry and constants … … 293 279 ! (1st layer= diffusive layer = pur water) 294 280 !------------------------------------------ 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 281 za1 = ( sedzmin - sedhmax / FLOAT(jpksed-1) ) & 282 & / ( TANH((1-sedkth)/sedacr) - sedacr/FLOAT(jpksed-1) * ( LOG( COSH( (jpksed - sedkth) / sedacr) ) & 283 & - LOG( COSH( ( 1 - sedkth) / sedacr) ) ) ) 284 za0 = sedzmin - za1 * TANH( (1-sedkth) / sedacr ) 285 zsur = - za0 - za1 * sedacr * LOG( COSH( (1-sedkth) / sedacr ) ) 286 287 profsedw(1) = 0.0 288 profsed(1) = -dz(1) / 2. 289 DO jk = 2, jpksed 290 zw = REAL( jk , wp ) 291 zt = REAL( jk , wp ) - 0.5_wp 292 profsed(jk) = ( zsur + za0 * zt + za1 * sedacr * LOG ( COSH( (zt-sedkth) / sedacr ) ) ) 293 profsedw(jk) = ( zsur + za0 * zw + za1 * sedacr * LOG ( COSH( (zw-sedkth) / sedacr ) ) ) 294 END DO 295 296 dz(1) = 0.1 297 DO jk = 2, jpksed 298 dz(jk) = profsedw(jk) - profsedw(jk-1) 299 END DO 306 300 307 301 DO jk = 1, jpksed … … 311 305 ENDDO 312 306 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 307 ! Porosity profile [0] 321 308 !--------------------- 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 309 por(1) = 1.0 310 DO jk = 2, jpksed 311 por(jk) = porinf + ( porsurf-porinf) * exp(-rhox * (profsed(jk) ) ) 312 END DO 333 313 334 314 ! inverse of Porosity profile … … 353 333 dz3d(1:jpoce,1) = dz(1) 354 334 355 356 335 !--------------------------------------------- 357 336 ! Molecular weight [g/mol] for solid species 358 337 !--------------------------------------------- 359 360 338 361 339 ! opal=sio2*0.4(h20)=28+2*16+0.4*(2+16) … … 371 349 & 0.59 * 27. + 10. * 16. 372 350 351 mol_wgt(jsfeo) = 55.0 + 3.0 * ( 16.0 + 1.0) 352 353 mol_wgt(jsfes) = 55.0 + 32.0 354 373 355 ! for chemistry Poc : C(122)H(244)O(86)N(16)P(1) 374 356 ! But den sity of Poc is an Hydrated material (= POC + 30H2O) … … 377 359 mol_wgt(jspoc) = ( 122. * 12. + 355. + 120. * 16.+ & 378 360 & 16. * 14. + 31. ) / 122. 361 mol_wgt(jspos) = mol_wgt(jspoc) 362 mol_wgt(jspor) = mol_wgt(jspoc) 379 363 380 364 ! CaCO3 … … 384 368 ! Density of solid material in sediment [g/cm**3] 385 369 !------------------------------------------------ 386 dens = 2.6370 denssol = 2.6 387 371 388 372 ! Initialization of diffusion coefficient as function of porosity [cm**2/s] 389 373 !-------------------------------------------------------------------- 390 diff(:) = dcoef * por(:) 374 ! DO jn = 1, jpsol 375 ! DO jk = 1, jpksed 376 ! DO ji = 1, jpoce 377 ! diff(ji,jk,jn) = dcoef / ( 1.0 - 2.0 * log(por(jk)) ) 378 ! END DO 379 ! END DO 380 ! END DO 381 382 ! Accumulation rate from Burwicz et al. (2011). This is used to 383 ! compute the flux of clays and minerals 384 ! -------------------------------------------------------------- 385 DO ji = 1, jpoce 386 ztmp1 = 0.117 / ( 1.0 + ( zkbot(ji) / 200.)**3 ) 387 ztmp2 = 0.006 / ( 1.0 + ( zkbot(ji) / 4000.)**10 ) 388 wacc(ji) = ztmp1 + ztmp2 389 END DO 391 390 392 391 393 392 ! Initialization of time step as function of porosity [cm**2/s] 394 393 !------------------------------------------------------------------ 395 rdtsed(2:jpksed) = dtsed / ( dens * por1(2:jpksed) )396 397 394 END SUBROUTINE sed_init_geom 398 395 … … 408 405 !!---------------------------------------------------------------------- 409 406 410 INTEGER :: & 411 numnamsed = 28 407 INTEGER :: numnamsed_ref = -1 !! Logical units for namelist sediment 408 INTEGER :: numnamsed_cfg = -1 !! Logical units for namelist sediment 409 INTEGER :: ios ! Local integer output status for namelist read 410 CHARACTER(LEN=20) :: clname 412 411 413 412 TYPE PSED … … 422 421 TYPE(PSED) , DIMENSION(jpdia2dsed) :: seddiag2d 423 422 424 NAMELIST/nam_time/nfreq 423 NAMELIST/nam_run/nrseddt,ln_sed_2way 424 NAMELIST/nam_geom/jpksed, sedzmin, sedhmax, sedkth, sedacr, porsurf, porinf, rhox 425 425 NAMELIST/nam_trased/sedsol, sedwat 426 426 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 427 NAMELIST/nam_inorg/rcopal, dcoef, rccal, ratligc, rcligc 428 NAMELIST/nam_poc/redO2, redNo3, redPo4, redC, redfep, rcorgl, rcorgs, & 429 & rcorgr, rcnh4, rch2s, rcfe2, rcfeh2s, rcfes, rcfeso, & 430 & xksedo2, xksedno3, xksedfeo, xksedso4 431 NAMELIST/nam_btb/dbiot, ln_btbz, dbtbzsc, adsnh4, ln_irrig, xirrzsc 432 NAMELIST/nam_rst/ln_rst_sed, cn_sedrst_indir, cn_sedrst_outdir, cn_sedrst_in, cn_sedrst_out 433 434 INTEGER :: ji, jn, jn1 436 435 !------------------------------------------------------- 437 436 438 WRITE(numsed,*) ' sed_init_nam : Read namelists '439 WRITE(numsed,*) ' '437 IF(lwp) WRITE(numsed,*) ' sed_init_nam : Read namelists ' 438 IF(lwp) WRITE(numsed,*) ' ' 440 439 441 440 ! ryear = 1 year converted in second 442 441 !------------------------------------ 443 WRITE(numsed,*) ' ' 444 WRITE(numsed,*) 'number of seconds in one year : ryear = ', ryear 445 WRITE(numsed,*) ' ' 442 IF (lwp) THEN 443 WRITE(numsed,*) ' ' 444 WRITE(numsed,*) 'number of seconds in one year : ryear = ', ryear 445 WRITE(numsed,*) ' ' 446 ENDIF 446 447 447 448 ! Reading namelist.sed variables 448 449 !--------------------------------- 449 CALL ctl_opn( numnamsed, 'namelist.sediment', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 450 451 dtsed = rdt 450 clname = 'namelist_sediment' 451 IF(lwp) WRITE(numsed,*) ' sed_init_nam : read SEDIMENT namelist' 452 IF(lwp) WRITE(numsed,*) ' ~~~~~~~~~~~~~~' 453 CALL ctl_opn( numnamsed_ref, TRIM( clname )//'_ref', 'OLD' , 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 454 CALL ctl_opn( numnamsed_cfg, TRIM( clname )//'_cfg', 'OLD' , 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 455 452 456 nitsed000 = nittrc000 453 457 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 ) 458 ! Namelist nam_run 459 REWIND( numnamsed_ref ) ! Namelist nam_run in reference namelist : Pisces variables 460 READ ( numnamsed_ref, nam_run, IOSTAT = ios, ERR = 901) 461 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_run in reference namelist', lwp ) 462 463 REWIND( numnamsed_cfg ) ! Namelist nam_run in reference namelist : Pisces variables 464 READ ( numnamsed_cfg, nam_run, IOSTAT = ios, ERR = 902) 465 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_run in configuration namelist', lwp ) 466 467 IF (lwp) THEN 468 WRITE(numsed,*) ' namelist nam_run' 469 WRITE(numsed,*) ' Nb of iterations for fast species nrseddt = ', nrseddt 470 WRITE(numsed,*) ' 2-way coupling between PISCES and Sed ln_sed_2way = ', ln_sed_2way 471 ENDIF 472 473 REWIND( numnamsed_ref ) ! Namelist nam_geom in reference namelist : Pisces variables 474 READ ( numnamsed_ref, nam_geom, IOSTAT = ios, ERR = 903) 475 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_geom in reference namelist', lwp ) 476 477 REWIND( numnamsed_cfg ) ! Namelist nam_geom in reference namelist : Pisces variables 478 READ ( numnamsed_cfg, nam_geom, IOSTAT = ios, ERR = 904) 479 904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_geom in configuration namelist', lwp ) 480 481 IF (lwp) THEN 482 WRITE(numsed,*) ' namelist nam_geom' 483 WRITE(numsed,*) ' Number of vertical layers jpksed = ', jpksed 484 WRITE(numsed,*) ' Minimum vertical spacing sedzmin = ', sedzmin 485 WRITE(numsed,*) ' Maximum depth of the sediment sedhmax = ', sedhmax 486 WRITE(numsed,*) ' Default parameter sedkth = ', sedkth 487 WRITE(numsed,*) ' Default parameter sedacr = ', sedacr 488 WRITE(numsed,*) ' Sediment porosity at the surface porsurf = ', porsurf 489 WRITE(numsed,*) ' Sediment porosity at infinite depth porinf = ', porinf 490 WRITE(numsed,*) ' Length scale of porosity variation rhox = ', rhox 491 ENDIF 492 493 jpksedm1 = jpksed - 1 494 dtsed = r2dttrc 495 496 REWIND( numnamsed_ref ) ! Namelist nam_trased in reference namelist : Pisces variables 497 READ ( numnamsed_ref, nam_trased, IOSTAT = ios, ERR = 905) 498 905 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_trased in reference namelist', lwp ) 499 500 REWIND( numnamsed_cfg ) ! Namelist nam_trased in reference namelist : Pisces variables 501 READ ( numnamsed_cfg, nam_trased, IOSTAT = ios, ERR = 906) 502 906 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_trased in configuration namelist', lwp ) 477 503 478 504 DO jn = 1, jpsol … … 489 515 END DO 490 516 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 517 IF (lwp) THEN 518 WRITE(numsed,*) ' namelist nam_trased' 519 WRITE(numsed,*) ' ' 520 DO jn = 1, jptrased 521 WRITE(numsed,*) 'name of 3d output sediment field number :',jn,' : ',TRIM(sedtrcd(jn)) 522 WRITE(numsed,*) 'long name ', TRIM(sedtrcl(jn)) 523 WRITE(numsed,*) ' in unit = ', TRIM(sedtrcu(jn)) 524 WRITE(numsed,*) ' ' 525 END DO 526 WRITE(numsed,*) ' ' 527 ENDIF 528 529 REWIND( numnamsed_ref ) ! Namelist nam_diased in reference namelist : Pisces variables 530 READ ( numnamsed_ref, nam_diased, IOSTAT = ios, ERR = 907) 531 907 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diased in reference namelist', lwp ) 532 533 REWIND( numnamsed_cfg ) ! Namelist nam_diased in reference namelist : Pisces variables 534 READ ( numnamsed_cfg, nam_diased, IOSTAT = ios, ERR = 908) 535 908 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diased in configuration namelist', lwp ) 501 536 502 REWIND( numnamsed )503 READ( numnamsed, nam_diased )504 505 537 DO jn = 1, jpdia3dsed 506 538 seddia3d(jn) = seddiag3d(jn)%snamesed … … 515 547 END DO 516 548 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 549 IF (lwp) THEN 550 WRITE(numsed,*) ' namelist nam_diased' 551 WRITE(numsed,*) ' ' 552 DO jn = 1, jpdia3dsed 553 WRITE(numsed,*) 'name of 3D output diag number :',jn, ' : ', TRIM(seddia3d(jn)) 554 WRITE(numsed,*) 'long name ', TRIM(seddia3l(jn)) 555 WRITE(numsed,*) ' in unit = ',TRIM(seddia3u(jn)) 556 WRITE(numsed,*) ' ' 557 END DO 558 559 DO jn = 1, jpdia2dsed 560 WRITE(numsed,*) 'name of 2D output diag number :',jn, ' : ', TRIM(seddia2d(jn)) 561 WRITE(numsed,*) 'long name ', TRIM(seddia2l(jn)) 562 WRITE(numsed,*) ' in unit = ',TRIM(seddia2u(jn)) 563 WRITE(numsed,*) ' ' 564 END DO 565 566 WRITE(numsed,*) ' ' 567 ENDIF 568 569 ! Inorganic chemistry parameters 537 570 !---------------------------------- 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 571 REWIND( numnamsed_ref ) ! Namelist nam_inorg in reference namelist : Pisces variables 572 READ ( numnamsed_ref, nam_inorg, IOSTAT = ios, ERR = 909) 573 909 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_inorg in reference namelist', lwp ) 574 575 REWIND( numnamsed_cfg ) ! Namelist nam_inorg in reference namelist : Pisces variables 576 READ ( numnamsed_cfg, nam_inorg, IOSTAT = ios, ERR = 910) 577 910 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_inorg in configuration namelist', lwp ) 578 579 IF (lwp) THEN 580 WRITE(numsed,*) ' namelist nam_inorg' 581 WRITE(numsed,*) ' reactivity for Si rcopal = ', rcopal 582 WRITE(numsed,*) ' diff. coef for por. dcoef = ', dcoef 583 WRITE(numsed,*) ' reactivity for calcite rccal = ', rccal 584 WRITE(numsed,*) ' L/C ratio in POC ratligc = ', ratligc 585 WRITE(numsed,*) ' reactivity for ligands rcligc = ', rcligc 586 WRITE(numsed,*) ' ' 587 ENDIF 548 588 549 589 ! Unity conversion to get saturation conc. psat in [mol.l-1] 550 590 ! and reactivity rc in [l.mol-1.s-1] 551 591 !---------------------------------------------------------- 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 592 reac_sil = rcopal / ryear 593 reac_ligc = rcligc / ryear 558 594 559 595 ! Additional parameter linked to POC/O2/No3/Po4 560 596 !---------------------------------------------- 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] 597 REWIND( numnamsed_ref ) ! Namelist nam_poc in reference namelist : Pisces variables 598 READ ( numnamsed_ref, nam_poc, IOSTAT = ios, ERR = 911) 599 911 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_poc in reference namelist', lwp ) 600 601 REWIND( numnamsed_cfg ) ! Namelist nam_poc in reference namelist : Pisces variables 602 READ ( numnamsed_cfg, nam_poc, IOSTAT = ios, ERR = 912) 603 912 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_poc in configuration namelist', lwp ) 604 605 IF (lwp) THEN 606 WRITE(numsed,*) ' namelist nam_poc' 607 WRITE(numsed,*) ' Redfield coef for oxy redO2 = ', redO2 608 WRITE(numsed,*) ' Redfield coef for no3 redNo3 = ', redNo3 609 WRITE(numsed,*) ' Redfield coef for po4 redPo4 = ', redPo4 610 WRITE(numsed,*) ' Redfield coef for carbon redC = ', redC 611 WRITE(numsed,*) ' Ration for iron bound P redfep = ', redfep 612 WRITE(numsed,*) ' reactivity for labile POC rcorgl = ', rcorgl 613 WRITE(numsed,*) ' reactivity for semi-refract. POC rcorgs = ', rcorgs 614 WRITE(numsed,*) ' reactivity for refractory POC rcorgr = ', rcorgr 615 WRITE(numsed,*) ' reactivity for NH4 rcnh4 = ', rcnh4 616 WRITE(numsed,*) ' reactivity for H2S rch2s = ', rch2s 617 WRITE(numsed,*) ' reactivity for Fe2+ rcfe2 = ', rcfe2 618 WRITE(numsed,*) ' reactivity for FeOH/H2S rcfeh2s = ', rcfeh2s 619 WRITE(numsed,*) ' reactivity for Fe2+/H2S rcfes = ', rcfes 620 WRITE(numsed,*) ' reactivity for FeS/O2 rcfeso = ', rcfeso 621 WRITE(numsed,*) ' Half-sat. cste for oxic remin xksedo2 = ', xksedo2 622 WRITE(numsed,*) ' Half-sat. cste for denit. xksedno3 = ', xksedno3 623 WRITE(numsed,*) ' Half-sat. cste for iron remin xksedfeo = ', xksedfeo 624 WRITE(numsed,*) ' Half-sat. cste for SO4 remin xksedso4 = ', xksedso4 625 WRITE(numsed,*) ' ' 626 ENDIF 627 628 629 so2ut = redO2 / redC 630 srno3 = redNo3 / redC 631 spo4r = redPo4 / redC 632 srDnit = ( (redO2 + 32. ) * 0.8 - redNo3 - redNo3 * 0.6 ) / redC 580 633 ! 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,*) ' ' 634 reac_pocl = rcorgl / ryear 635 reac_pocs = rcorgs / ryear 636 reac_pocr = rcorgr / ryear 637 reac_nh4 = rcnh4 / ryear 638 reac_h2s = rch2s / ryear 639 reac_fe2 = rcfe2 / ryear 640 reac_feh2s = rcfeh2s/ ryear 641 reac_fes = rcfes / ryear 642 reac_feso = rcfeso / ryear 591 643 592 644 ! reactivity rc in [l.mol-1.s-1] 593 645 reac_cal = rccal / ryear 594 646 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 647 ! Bioturbation parameter 607 648 !------------------------ 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. ) 649 REWIND( numnamsed_ref ) ! Namelist nam_btb in reference namelist : Pisces variables 650 READ ( numnamsed_ref, nam_btb, IOSTAT = ios, ERR = 913) 651 913 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_btb in reference namelist', lwp ) 652 653 REWIND( numnamsed_cfg ) ! Namelist nam_btb in reference namelist : Pisces variables 654 READ ( numnamsed_cfg, nam_btb, IOSTAT = ios, ERR = 914) 655 914 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_btb in configuration namelist', lwp ) 656 657 IF (lwp) THEN 658 WRITE(numsed,*) ' namelist nam_btb ' 659 WRITE(numsed,*) ' coefficient for bioturbation dbiot = ', dbiot 660 WRITE(numsed,*) ' Depth varying bioturbation ln_btbz = ', ln_btbz 661 WRITE(numsed,*) ' coefficient for btb attenuation dbtbzsc = ', dbtbzsc 662 WRITE(numsed,*) ' Adsorption coefficient of NH4 adsnh4 = ', adsnh4 663 WRITE(numsed,*) ' Bioirrigation in sediment ln_irrig = ', ln_irrig 664 WRITE(numsed,*) ' coefficient for irrig attenuation xirrzsc = ', xirrzsc 665 WRITE(numsed,*) ' ' 666 ENDIF 615 667 616 668 ! Initial value (t=0) for sediment pore water and solid components 617 669 !---------------------------------------------------------------- 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 ) 670 REWIND( numnamsed_ref ) ! Namelist nam_rst in reference namelist : Pisces variables 671 READ ( numnamsed_ref, nam_rst, IOSTAT = ios, ERR = 915) 672 915 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_rst in reference namelist', lwp ) 673 674 REWIND( numnamsed_cfg ) ! Namelist nam_rst in reference namelist : Pisces variables 675 READ ( numnamsed_cfg, nam_rst, IOSTAT = ios, ERR = 916) 676 916 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_rst in configuration namelist', lwp ) 677 678 IF (lwp) THEN 679 WRITE(numsed,*) ' namelist nam_rst ' 680 WRITE(numsed,*) ' boolean term for restart (T or F) ln_rst_sed = ', ln_rst_sed 681 WRITE(numsed,*) ' ' 682 ENDIF 683 nn_dtsed = nn_dttrc 684 685 CLOSE( numnamsed_cfg ) 686 CLOSE( numnamsed_ref ) 624 687 625 688 END SUBROUTINE sed_init_nam 626 689 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 690 END MODULE sedini -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/SED/sedinitrc.F90
r10320 r10321 29 29 PUBLIC sed_initrc ! routine called by opa.F90 30 30 31 !! $Id : sedini.F90 5215 2015-04-15 16:11:56Z nicolasmartin$31 !! $Id$ 32 32 CONTAINS 33 33 -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/SED/sedinorg.F90
r10320 r10321 20 20 PUBLIC sed_inorg 21 21 22 !! $Id : seddsr.F90 5215 2015-04-15 16:11:56Z nicolasmartin$22 !! $Id$ 23 23 CONTAINS 24 24 -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/SED/sedmat.F90
r9950 r10321 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/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/SED/sedmbc.F90
r9950 r10321 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/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/SED/sedmodel.F90
r9950 r10321 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/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/SED/sedorg.F90
r10320 r10321 23 23 REAL(wp) :: zadsnh4 24 24 25 !! $Id : seddsr.F90 5215 2015-04-15 16:11:56Z nicolasmartin$25 !! $Id$ 26 26 CONTAINS 27 27 -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/SED/sedrst.F90
r9950 r10321 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 ! ocean space and time domain variables 13 USE iom 14 USE daymod 15 USE lib_mpp ! distribued memory computing library 13 16 14 17 … … 18 21 19 22 !! * Accessibility 23 PUBLIC sed_rst_opn ! called by ??? 20 24 PUBLIC sed_rst_read 21 25 PUBLIC sed_rst_wri 22 23 !! * Module variables 24 INTEGER, PUBLIC :: numrsr, numrsw !: logical unit for sed restart (read and write) 25 26 26 PUBLIC sed_rst_cal 27 27 28 !! $Id$ 28 29 CONTAINS 29 30 31 32 SUBROUTINE sed_rst_opn( kt ) 33 !!---------------------------------------------------------------------- 34 !! *** sed_rst_opn *** 35 !! 36 !! ** purpose : output of sed-trc variable in a netcdf file 37 !!---------------------------------------------------------------------- 38 INTEGER, INTENT(in) :: kt ! number of iteration 39 ! 40 CHARACTER(LEN=20) :: clkt ! ocean time-step define as a character 41 CHARACTER(LEN=50) :: clname ! trc output restart file name 42 CHARACTER(LEN=256) :: clpath ! full path to ocean output restart file 43 !!---------------------------------------------------------------------- 44 ! 45 IF( l_offline ) THEN 46 IF( kt == nittrc000 ) THEN 47 lrst_sed = .FALSE. 48 IF( ln_rst_list ) THEN 49 nrst_lst = 1 50 nitrst = nstocklist( nrst_lst ) 51 ELSE 52 nitrst = nitend 53 ENDIF 54 ENDIF 55 IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nstock ) == 0 ) THEN 56 ! we use kt - 1 and not kt - nittrc000 to keep the same periodicity from the beginning of the experiment 57 nitrst = kt + nstock - 1 ! define the next value of nitrst for restart writing 58 IF( nitrst > nitend ) nitrst = nitend ! make sure we write a restart at the end of the run 59 ENDIF 60 ELSE 61 IF( kt == nittrc000 ) lrst_sed = .FALSE. 62 ENDIF 63 64 ! to get better performances with NetCDF format: 65 ! we open and define the tracer restart file one tracer time step before writing the data (-> at nitrst - 2*nn_dttrc + 1) 66 ! 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 67 IF( kt == nitrst - 2*nn_dtsed .OR. nstock == nn_dtsed .OR. ( kt == nitend - nn_dtsed .AND. .NOT. lrst_sed ) ) THEN 68 ! beware of the format used to write kt (default is i8.8, that should be large enough) 69 IF( nitrst > 1.0e9 ) THEN ; WRITE(clkt,* ) nitrst 70 ELSE ; WRITE(clkt,'(i8.8)') nitrst 71 ENDIF 72 ! create the file 73 IF(lwp) WRITE(numsed,*) 74 clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_sedrst_out) 75 clpath = TRIM(cn_sedrst_outdir) 76 IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 77 IF(lwp) WRITE(numsed,*) & 78 ' open sed restart.output NetCDF file: ',TRIM(clpath)//clname 79 CALL iom_open( TRIM(clpath)//TRIM(clname), numrsw, ldwrt = .TRUE., kiolib = jprstlib, kdlev = jpksed ) 80 lrst_sed = .TRUE. 81 ENDIF 82 ! 83 END SUBROUTINE sed_rst_opn 30 84 31 85 SUBROUTINE sed_rst_read … … 40 94 !! ! 06-07 (C. Ethe) original 41 95 !!---------------------------------------------------------------------- 42 !! * Modules used43 USE iom44 96 45 97 !! * 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 98 INTEGER :: ji, jj, jk, jn 99 REAL(wp), DIMENSION(jpi,jpj,jpksed,jptrased) :: zdta 100 REAL(wp), DIMENSION(jpi,jpj,jpksed,2) :: zdta1 101 REAL(wp), DIMENSION(jpi,jpj,jpksed) :: zdta2 102 REAL(wp), DIMENSION(jpoce,jpksed) :: zhipor 50 103 REAL(wp) :: zkt 51 104 CHARACTER(len = 20) :: cltra 105 CHARACTER(LEN=20) :: name1 52 106 INTEGER :: jlibalt = jprstlib 53 107 LOGICAL :: llok 54 108 !-------------------------------------------------------------------- 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 109 110 IF( ln_timing ) CALL timing_start('sed_rst_read') 111 112 IF (lwp) WRITE(numsed,*) ' ' 113 IF (lwp) WRITE(numsed,*) ' Initilization of Sediment components from restart' 114 IF (lwp) WRITE(numsed,*) ' ' 115 116 zdta = 1. 117 zdta1 = 1. 118 zdta2 = 0. 119 66 120 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) ) 121 cltra = TRIM(sedtrcd(jn)) 122 IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN 123 CALL iom_get( numrsr, jpdom_autoglo, TRIM(cltra), zdta(:,:,:,jn) ) 124 ELSE 125 zdta(:,:,:,jn) = 0.0 126 ENDIF 127 ENDDO 128 129 DO jn = 1, jpsol 130 CALL pack_arr( jpoce, solcp(1:jpoce,1:jpksed,jn), & 131 & zdta(1:jpi,1:jpj,1:jpksed,jn), iarroce(1:jpoce) ) 132 END DO 133 134 DO jn = 1, jpwat 135 CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jn), & 136 & zdta(1:jpi,1:jpj,1:jpksed,jpsol+jn), iarroce(1:jpoce) ) 137 END DO 107 138 108 139 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/) ) 140 cltra = TRIM(seddia3d(jn)) 141 IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN 142 CALL iom_get( numrsr, jpdom_autoglo, TRIM(cltra), zdta1(:,:,:,jn) ) 143 ELSE 144 zdta1(:,:,:,jn) = 0.0 145 ENDIF 112 146 ENDDO 113 147 … … 122 156 ENDDO 123 157 ENDDO 124 158 125 159 CALL pack_arr( jpoce, co3por(1:jpoce,1:jpksed), & 126 160 & zdta1(1:jpi,1:jpj,1:jpksed,2), iarroce(1:jpoce) ) … … 131 165 pwcp (1:jpoce,1,:) = 0. 132 166 133 DEALLOCATE( zdta ) 134 DEALLOCATE( zdta1 ) 135 DEALLOCATE( zhipor ) 167 cltra = "dbioturb" 168 IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN 169 CALL iom_get( numrsr, jpdom_autoglo, TRIM(cltra), zdta2(:,:,:) ) 170 ELSE 171 zdta2(:,:,:) = 0.0 172 ENDIF 173 174 CALL pack_arr( jpoce, db(1:jpoce,1:jpksed), & 175 & zdta2(1:jpi,1:jpj,1:jpksed), iarroce(1:jpoce) ) 176 177 cltra = "irrig" 178 IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN 179 CALL iom_get( numrsr, jpdom_autoglo, TRIM(cltra), zdta2(:,:,:) ) 180 ELSE 181 zdta2(:,:,:) = 0.0 182 ENDIF 183 184 CALL pack_arr( jpoce, irrig(1:jpoce,1:jpksed), & 185 & zdta2(1:jpi,1:jpj,1:jpksed), iarroce(1:jpoce) ) 186 187 cltra = "sedligand" 188 IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN 189 CALL iom_get( numrsr, jpdom_autoglo, TRIM(cltra), zdta2(:,:,:) ) 190 ELSE 191 zdta2(:,:,:) = 0.0 192 ENDIF 193 194 CALL pack_arr( jpoce, sedligand(1:jpoce,1:jpksed), & 195 & zdta2(1:jpi,1:jpj,1:jpksed), iarroce(1:jpoce) ) 196 197 IF( ln_timing ) CALL timing_stop('sed_rst_read') 136 198 137 199 END SUBROUTINE sed_rst_read … … 147 209 !!---------------------------------------------------------------------- 148 210 !!* Modules used 149 USE ioipsl150 !! *Arguments151 211 INTEGER, INTENT(in) :: kt ! number of iteration 152 212 !! * local declarations 153 INTEGER :: ji, jk 154 INTEGER :: ic, jc, jn, itime 155 REAL(wp) :: zdate0 213 INTEGER :: ji, jj, jk, jn 156 214 REAL(wp), DIMENSION(1) :: zinfo 157 CHARACTER(len=50) :: clname,cln 158 CHARACTER(len=20) :: cltra 159 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: zdta 215 CHARACTER(len=50) :: clname 216 CHARACTER(len=20) :: cltra, name1 217 REAL(wp), DIMENSION(jpoce,jpksed) :: zdta 218 REAL(wp), DIMENSION(jpi,jpj,jpksed) :: zdta2 160 219 !! ----------------------------------------------------------------------- 161 220 162 ALLOCATE( zdta(jpoce,jpksed) ) 163 164 IF( MOD(kt,nstock) == 0 .OR. kt == nitsedend ) THEN 165 221 IF( ln_timing ) CALL timing_start('sed_rst_wri') 222 166 223 !! 0. initialisations 167 224 !! ------------------ 168 225 169 170 226 IF(lwp) WRITE(numsed,*) ' ' 227 IF(lwp) WRITE(numsed,*) 'sed_rst_write : write the sediment restart file in NetCDF format ', & 171 228 'at it= ',kt 172 IF(lwp) WRITE(numsed,*) '~~~~~~~~~' 229 IF(lwp) WRITE(numsed,*) '~~~~~~~~~' 230 231 232 trcsedi(:,:,:,:) = 0.0 233 flxsedi3d(:,:,:,:) = 0.0 234 zdta(:,:) = 1.0 235 zdta2(:,:,:) = 0.0 236 173 237 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 ) ) 238 !! 1. WRITE in nutwrs 239 !! ------------------ 240 241 zinfo(1) = REAL( kt) 242 CALL iom_rstput( kt, nitrst, numrsw, 'kt', zinfo ) 243 244 ! Back to 2D geometry 245 DO jn = 1, jpsol 246 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,jn) , iarroce(1:jpoce), & 247 & solcp(1:jpoce,1:jpksed,jn ) ) 248 END DO 249 250 DO jn = 1, jpwat 251 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,jpsol+jn) , iarroce(1:jpoce), & 252 & pwcp(1:jpoce,1:jpksed,jn ) ) 253 END DO 254 ! pH 255 DO jk = 1, jpksed 256 DO ji = 1, jpoce 257 zdta(ji,jk) = -LOG10( hipor(ji,jk) / ( densSW(ji) + rtrn ) + rtrn ) 258 ENDDO 259 ENDDO 260 261 CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,1) , iarroce(1:jpoce), & 262 & zdta(1:jpoce,1:jpksed) ) 196 263 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 ) 264 CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,2) , iarroce(1:jpoce), & 265 & co3por(1:jpoce,1:jpksed) ) 266 267 ! prognostic variables 268 ! -------------------- 269 270 DO jn = 1, jptrased 271 cltra = TRIM(sedtrcd(jn)) 272 CALL iom_rstput( kt, nitrst, numrsw, TRIM(cltra), trcsedi(:,:,:,jn) ) 273 ENDDO 274 275 DO jn = 1, 2 276 cltra = TRIM(seddia3d(jn)) 277 CALL iom_rstput( kt, nitrst, numrsw, TRIM(cltra), flxsedi3d(:,:,:,jn) ) 278 ENDDO 279 280 CALL unpack_arr( jpoce, zdta2(1:jpi,1:jpj,1:jpksed) , iarroce(1:jpoce), & 281 & db(1:jpoce,1:jpksed) ) 282 283 cltra = "dbioturb" 284 CALL iom_rstput( kt, nitrst, numrsw, TRIM(cltra), zdta2(:,:,:) ) 285 286 CALL unpack_arr( jpoce, zdta2(1:jpi,1:jpj,1:jpksed) , iarroce(1:jpoce), & 287 & irrig(1:jpoce,1:jpksed) ) 288 289 cltra = "irrig" 290 CALL iom_rstput( kt, nitrst, numrsw, TRIM(cltra), zdta2(:,:,:) ) 291 292 CALL unpack_arr( jpoce, zdta2(1:jpi,1:jpj,1:jpksed) , iarroce(1:jpoce), & 293 & sedligand(1:jpoce,1:jpksed) ) 294 295 cltra = "sedligand" 296 CALL iom_rstput( kt, nitrst, numrsw, TRIM(cltra), zdta2(:,:,:) ) 297 298 IF( kt == nitrst ) THEN 299 CALL iom_close( numrsw ) ! close the restart file (only at last time step) 300 IF( l_offline .AND. ln_rst_list ) THEN 301 nrst_lst = nrst_lst + 1 302 nitrst = nstocklist( nrst_lst ) 303 ENDIF 304 ENDIF 305 306 IF( ln_timing ) CALL timing_stop('sed_rst_wri') 260 307 261 308 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 309 310 311 SUBROUTINE sed_rst_cal( kt, cdrw ) 312 !!--------------------------------------------------------------------- 313 !! *** ROUTINE sed_rst_cal *** 314 !! 315 !! ** Purpose : Read or write calendar in restart file: 316 !! 317 !! WRITE(READ) mode: 318 !! kt : number of time step since the begining of the experiment at the 319 !! end of the current(previous) run 320 !! adatrj(0) : number of elapsed days since the begining of the experiment at the 321 !! end of the current(previous) run (REAL -> keep fractions of day) 322 !! ndastp : date at the end of the current(previous) run (coded as yyyymmdd integer) 323 !! 324 !! According to namelist parameter nrstdt, 325 !! nn_rsttr = 0 no control on the date (nittrc000 is arbitrary). 326 !! nn_rsttr = 1 we verify that nittrc000 is equal to the last 327 !! time step of previous run + 1. 328 !! In both those options, the exact duration of the experiment 329 !! since the beginning (cumulated duration of all previous restart runs) 330 !! is not stored in the restart and is assumed to be (nittrc000-1)*rdt. 331 !! This is valid is the time step has remained constant. 332 !! 333 !! nn_rsttr = 2 the duration of the experiment in days (adatrj) 334 !! has been stored in the restart file. 335 !!---------------------------------------------------------------------- 336 INTEGER , INTENT(in) :: kt ! ocean time-step 337 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag 338 ! 339 INTEGER :: jlibalt = jprstlib 340 LOGICAL :: llok 341 REAL(wp) :: zkt, zrdttrc1 342 REAL(wp) :: zndastp 343 344 ! Time domain : restart 345 ! --------------------- 346 347 IF( TRIM(cdrw) == 'READ' ) THEN 348 349 IF(lwp) WRITE(numsed,*) 350 IF(lwp) WRITE(numsed,*) 'sed_rst_cal : read the SED restart file for calendar' 351 IF(lwp) WRITE(numsed,*) '~~~~~~~~~~~~' 352 353 IF( ln_rst_sed ) THEN 354 CALL iom_open( TRIM(cn_sedrst_indir)//'/'//cn_sedrst_in, numrsr, kiolib = jlibalt ) 355 CALL iom_get ( numrsr, 'kt', zkt ) ! last time-step of previous run 356 357 IF(lwp) THEN 358 WRITE(numsed,*) ' *** Info read in restart : ' 359 WRITE(numsed,*) ' previous time-step : ', NINT( zkt ) 360 WRITE(numsed,*) ' *** restart option' 361 SELECT CASE ( nn_rstsed ) 362 CASE ( 0 ) ; WRITE(numsed,*) ' nn_rstsed = 0 : no control of nittrc000' 363 CASE ( 1 ) ; WRITE(numsed,*) ' nn_rstsed = 1 : no control the date at nittrc000 (use ndate0 read in the namelist)' 364 CASE ( 2 ) ; WRITE(numsed,*) ' nn_rstsed = 2 : calendar parameters read in restart' 365 END SELECT 366 WRITE(numsed,*) 367 ENDIF 368 ! Control of date 369 IF( nittrc000 - NINT( zkt ) /= nn_dtsed .AND. nn_rstsed /= 0 ) & 370 & CALL ctl_stop( ' ===>>>> : problem with nittrc000 for the restart', & 371 & ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' ) 372 ENDIF 373 ! 374 IF( l_offline ) THEN 375 ! ! set the date in offline mode 376 IF( ln_rst_sed .AND. nn_rstsed == 2 ) THEN 377 CALL iom_get( numrsr, 'ndastp', zndastp ) 378 ndastp = NINT( zndastp ) 379 CALL iom_get( numrsr, 'adatrj', adatrj ) 380 ELSE 381 ndastp = ndate0 - 1 ! ndate0 read in the namelist in dom_nam 382 adatrj = ( REAL( nittrc000-1, wp ) * rdt ) / rday 383 ! note this is wrong if time step has changed during run 384 ENDIF 385 ! 386 IF(lwp) THEN 387 WRITE(numsed,*) ' *** Info used values : ' 388 WRITE(numsed,*) ' date ndastp : ', ndastp 389 WRITE(numsed,*) ' number of elapsed days since the begining of run : ', adatrj 390 WRITE(numsed,*) 391 ENDIF 392 ! 393 CALL day_init ! compute calendar 394 ! 395 ENDIF 396 ! 397 ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN 398 ! 399 IF( kt == nitrst ) THEN 400 IF(lwp) WRITE(numsed,*) 401 IF(lwp) WRITE(numsed,*) 'trc_wri : write the TOP restart file (NetCDF) at it= ', kt, ' date= ', ndastp 402 IF(lwp) WRITE(numsed,*) '~~~~~~~' 403 ENDIF 404 CALL iom_rstput( kt, nitrst, numrsw, 'kt' , REAL( kt , wp) ) ! time-step 405 CALL iom_rstput( kt, nitrst, numrsw, 'ndastp' , REAL( ndastp, wp) ) ! date 406 CALL iom_rstput( kt, nitrst, numrsw, 'adatrj' , adatrj ) ! number of elapsed days since 407 ! ! the begining of the run [s] 408 ENDIF 409 410 END SUBROUTINE sed_rst_cal 275 411 276 412 END MODULE sedrst -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/SED/sedsfc.F90
r9950 r10321 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/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/SED/sedstp.F90
r9950 r10321 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/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/SED/sedwri.F90
r9950 r10321 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/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/SED/trcdmp_sed.F90
r10320 r10321 38 38 !!---------------------------------------------------------------------- 39 39 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 40 !! $Id : trcdmp.F90 7646 2017-02-06 09:25:03Z timgraham $40 !! $Id$ 41 41 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 42 42 !!---------------------------------------------------------------------- -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/par_pisces.F90
r9950 r10321 65 65 66 66 !!---------------------------------------------------------------------- 67 !! NEMO/TOP 3.3, NEMO Consortium (2018)67 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 68 68 !! $Id$ 69 !! Software governed by the CeCILL licen ce (./LICENSE)69 !! Software governed by the CeCILL license (see ./LICENSE) 70 70 !!====================================================================== 71 71 END MODULE par_pisces -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/sms_pisces.F90
r9950 r10321 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 !! NEMO/TOP 3.3, NEMO Consortium (2018)127 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 133 128 !! $Id$ 134 !! Software governed by the CeCILL licen ce (./LICENSE)129 !! Software governed by the CeCILL license (see ./LICENSE) 135 130 !!---------------------------------------------------------------------- 136 131 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/trcice_pisces.F90
- Property svn:keywords set to Id
r9950 r10321 23 23 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 24 24 !! $Id$ 25 !! Software governed by the CeCILL licen ce (./LICENSE)25 !! Software governed by the CeCILL license (see ./LICENSE) 26 26 !!---------------------------------------------------------------------- 27 27 CONTAINS … … 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/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/trcini_pisces.F90
r9950 r10321 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 … … 25 26 26 27 !!---------------------------------------------------------------------- 27 !! NEMO/TOP 3.3, NEMO Consortium (2018)28 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 28 29 !! $Id$ 29 !! Software governed by the CeCILL licen ce (./LICENSE)30 !! Software governed by the CeCILL license (see ./LICENSE) 30 31 !!---------------------------------------------------------------------- 31 32 CONTAINS … … 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/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/trcnam_pisces.F90
r9950 r10321 24 24 25 25 !!---------------------------------------------------------------------- 26 !! NEMO/TOP 3.3, NEMO Consortium (2018)26 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 27 27 !! $Id$ 28 !! Software governed by the CeCILL licen ce (./LICENSE)28 !! Software governed by the CeCILL license (see ./LICENSE) 29 29 !!---------------------------------------------------------------------- 30 30 CONTAINS … … 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/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/trcsms_pisces.F90
r9950 r10321 19 19 PUBLIC trc_sms_pisces ! called in trcsms.F90 20 20 !!---------------------------------------------------------------------- 21 !! NEMO/TOP 3.3, NEMO Consortium (2018)21 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 22 22 !! $Id$ 23 !! Software governed by the CeCILL licen ce (./LICENSE)23 !! Software governed by the CeCILL license (see ./LICENSE) 24 24 !!---------------------------------------------------------------------- 25 25 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/trcwri_pisces.F90
- Property svn:keywords set to Id
r9950 r10321 20 20 21 21 !!---------------------------------------------------------------------- 22 !! NEMO/TOP 3.3, NEMO Consortium (2018)22 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 23 23 !! $Id$ 24 !! Software governed by the CeCILL licen ce (./LICENSE)24 !! Software governed by the CeCILL license (see ./LICENSE) 25 25 !!---------------------------------------------------------------------- 26 26 CONTAINS … … 97 97 98 98 !!---------------------------------------------------------------------- 99 !! NEMO/TOP 3.3, NEMO Consortium (2018)99 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 100 100 !! $Id$ 101 !! Software governed by the CeCILL licen ce (./LICENSE)101 !! Software governed by the CeCILL license (see ./LICENSE) 102 102 !!====================================================================== 103 103 END MODULE trcwri_pisces -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/TRP/trcadv.F90
r9950 r10321 64 64 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 65 65 !! $Id$ 66 !! Software governed by the CeCILL licen ce (./LICENSE)66 !! Software governed by the CeCILL license (see ./LICENSE) 67 67 !!---------------------------------------------------------------------- 68 68 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/TRP/trcbbl.F90
r9950 r10321 32 32 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 33 33 !! $Id$ 34 !! Software governed by the CeCILL licen ce (./LICENSE)34 !! Software governed by the CeCILL license (see ./LICENSE) 35 35 !!---------------------------------------------------------------------- 36 36 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/TRP/trcdmp.F90
r9950 r10321 46 46 # include "vectopt_loop_substitute.h90" 47 47 !!---------------------------------------------------------------------- 48 !! NEMO/TOP 3.3, NEMO Consortium (2018)48 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 49 49 !! $Id$ 50 !! Software governed by the CeCILL licen ce (./LICENSE)50 !! Software governed by the CeCILL license (see ./LICENSE) 51 51 !!---------------------------------------------------------------------- 52 52 CONTAINS … … 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/UKMO/NEMO4_beta_mirror/src/TOP/TRP/trcldf.F90
r9950 r10321 45 45 # include "vectopt_loop_substitute.h90" 46 46 !!---------------------------------------------------------------------- 47 !! NEMO/TOP 3.7, NEMO Consortium (2018)47 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 48 48 !! $Id$ 49 !! Software governed by the CeCILL licen ce (./LICENSE)49 !! Software governed by the CeCILL license (see ./LICENSE) 50 50 !!---------------------------------------------------------------------- 51 51 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/TRP/trcnxt.F90
r9950 r10321 48 48 49 49 !!---------------------------------------------------------------------- 50 !! NEMO/TOP 3.3, NEMO Consortium (2018)50 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 51 51 !! $Id$ 52 !! Software governed by the CeCILL licen ce (./LICENSE)52 !! Software governed by the CeCILL license (see ./LICENSE) 53 53 !!---------------------------------------------------------------------- 54 54 CONTAINS … … 103 103 IF( l_trdtrc ) THEN ! trends: store now fields before the Asselin filter application 104 104 ALLOCATE( ztrdt(jpi,jpj,jpk,jptra) ) 105 ztrdt(:,:,:,:) = trn(:,:,:,:) 105 ztrdt(:,:,:,:) = 0._wp 106 IF( ln_traldf_iso ) THEN ! diagnose the "pure" Kz diffusive trend 107 DO jn = 1, jptra 108 CALL trd_tra( kt, 'TRC', jn, jptra_zdfp, ztrdt(:,:,:,jn) ) 109 ENDDO 110 ENDIF 111 112 ! total trend for the non-time-filtered variables. 113 zfact = 1.0 / rdttrc 114 ! G Nurser 23 Mar 2017. Recalculate trend as Delta(e3t*T)/e3tn; e3tn cancel from tsn terms 115 IF( ln_linssh ) THEN ! linear sea surface height only 116 DO jn = 1, jptra 117 DO jk = 1, jpkm1 118 ztrdt(:,:,jk,jn) = ( tra(:,:,jk,jn)*e3t_a(:,:,jk) / e3t_n(:,:,jk) - trn(:,:,jk,jn)) * zfact 119 END DO 120 END DO 121 ELSE 122 DO jn = 1, jptra 123 DO jk = 1, jpkm1 124 ztrdt(:,:,jk,jn) = ( tra(:,:,jk,jn) - trn(:,:,jk,jn) ) * zfact 125 END DO 126 END DO 127 ENDIF 128 ! 129 DO jn = 1, jptra 130 CALL trd_tra( kt, 'TRC', jn, jptra_tot, ztrdt(:,:,:,jn) ) 131 ENDDO 132 ! 133 IF( ln_linssh ) THEN ! linear sea surface height only 134 ! Store now fields before applying the Asselin filter 135 ! in order to calculate Asselin filter trend later. 136 ztrdt(:,:,:,:) = trn(:,:,:,:) 137 ENDIF 138 106 139 ENDIF 107 140 ! ! Leap-Frog + Asselin filter time stepping … … 113 146 END DO 114 147 END DO 148 IF (l_trdtrc .AND. .NOT. ln_linssh ) THEN ! Zero Asselin filter contribution must be explicitly written out since for vvl 149 ! ! Asselin filter is output by tra_nxt_vvl that is not called on this time step 150 ztrdt(:,:,:,:) = 0._wp 151 DO jn = 1, jptra 152 CALL trd_tra( kt, 'TRC', jn, jptra_atf, ztrdt(:,:,:,jn) ) 153 ENDDO 154 END IF 155 ! 115 156 ELSE 116 157 IF( .NOT. l_offline ) THEN ! Leap-Frog + Asselin filter time stepping … … 126 167 ENDIF 127 168 ! 128 IF( l_trdtrc ) THEN ! trends: send Asselin filter trends to trdtra manager for further diagnostics169 IF( l_trdtrc .AND. ln_linssh ) THEN ! trend of the Asselin filter (tb filtered - tb)/dt ) 129 170 DO jn = 1, jptra 130 171 DO jk = 1, jpkm1 131 172 zfact = 1._wp / r2dttrc 132 173 ztrdt(:,:,jk,jn) = ( trb(:,:,jk,jn) - ztrdt(:,:,jk,jn) ) * zfact 133 CALL trd_tra( kt, 'TRC', jn, jptra_atf, ztrdt )134 END DO174 END DO 175 CALL trd_tra( kt, 'TRC', jn, jptra_atf, ztrdt(:,:,:,jn) ) 135 176 END DO 136 DEALLOCATE( ztrdt )137 177 END IF 178 IF( l_trdtrc ) DEALLOCATE( ztrdt ) 138 179 ! 139 180 IF(ln_ctl) THEN ! print mean trends (used for debugging) -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/TRP/trcrad.F90
r9950 r10321 29 29 30 30 !!---------------------------------------------------------------------- 31 !! NEMO/TOP 3.3, NEMO Consortium (2018)31 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 32 32 !! $Id$ 33 !! Software governed by the CeCILL licen ce (./LICENSE)33 !! Software governed by the CeCILL license (see ./LICENSE) 34 34 !!---------------------------------------------------------------------- 35 35 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/TRP/trcsbc.F90
r9950 r10321 31 31 # include "vectopt_loop_substitute.h90" 32 32 !!---------------------------------------------------------------------- 33 !! NEMO/TOP 3.3, NEMO Consortium (2018)33 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 34 34 !! $Id$ 35 !! Software governed by the CeCILL licen ce (./LICENSE)35 !! Software governed by the CeCILL license (see ./LICENSE) 36 36 !!---------------------------------------------------------------------- 37 37 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/TRP/trctrp.F90
r9950 r10321 37 37 38 38 !!---------------------------------------------------------------------- 39 !! NEMO/TOP 3.3, NEMO Consortium (2018)39 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 40 40 !! $Id$ 41 !! Software governed by the CeCILL licen ce (./LICENSE)41 !! Software governed by the CeCILL license (see ./LICENSE) 42 42 !!---------------------------------------------------------------------- 43 43 -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/TRP/trczdf.F90
r9950 r10321 30 30 31 31 !!---------------------------------------------------------------------- 32 !! NEMO/TOP 3.7, NEMO Consortium (2018)32 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 33 33 !! $Id$ 34 !! Software governed by the CeCILL licen ce (./LICENSE)34 !! Software governed by the CeCILL license (see ./LICENSE) 35 35 !!---------------------------------------------------------------------- 36 36 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/TRP/trdmxl_trc.F90
r9950 r10321 51 51 52 52 !!---------------------------------------------------------------------- 53 !! NEMO/TOP 3.3, NEMO Consortium (2018)53 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 54 54 !! $Id$ 55 !! Software governed by the CeCILL licen ce (./LICENSE)55 !! Software governed by the CeCILL license (see ./LICENSE) 56 56 !!---------------------------------------------------------------------- 57 57 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/TRP/trdmxl_trc_rst.F90
r9950 r10321 23 23 24 24 !!--------------------------------------------------------------------------------- 25 !! NEMO/TOP 3.3, NEMO Consortium (2018)25 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 26 26 !! $Id$ 27 !! Software governed by the CeCILL licen ce (./LICENSE)27 !! Software governed by the CeCILL license (see ./LICENSE) 28 28 !!--------------------------------------------------------------------------------- 29 29 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/TRP/trdtrc.F90
r9950 r10321 25 25 26 26 !!---------------------------------------------------------------------- 27 !! NEMO/TOP 3.3, NEMO Consortium (2018)27 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 28 28 !! $Id$ 29 !! Software governed by the CeCILL licen ce (./LICENSE)29 !! Software governed by the CeCILL license (see ./LICENSE) 30 30 !!---------------------------------------------------------------------- 31 31 … … 81 81 ! 82 82 SELECT CASE( ktrd ) 83 CASE( jptra_xad ) ; WRITE (cltra,'("XAD_",4a)') 84 CASE( jptra_yad ) ; WRITE (cltra,'("YAD_",4a)') 85 CASE( jptra_zad ) ; WRITE (cltra,'("ZAD_",4a)') 86 CASE( jptra_ldf ) ; WRITE (cltra,'("LDF_",4a)') 87 CASE( jptra_bbl ) ; WRITE (cltra,'("BBL_",4a)') 88 CASE( jptra_nsr ) ; WRITE (cltra,'("FOR_",4a)') 89 CASE( jptra_zdf ) ; WRITE (cltra,'("ZDF_",4a)') 90 CASE( jptra_dmp ) ; WRITE (cltra,'("DMP_",4a)') 91 CASE( jptra_sms ) ; WRITE (cltra,'("SMS_",4a)') 92 CASE( jptra_atf ) ; WRITE (cltra,'("ATF_",4a)') 93 CASE( jptra_radb ) ; WRITE (cltra,'("RDB_",4a)') 94 CASE( jptra_radn ) ; WRITE (cltra,'("RDN_",4a)') 83 CASE( jptra_xad ) ; WRITE (cltra,'("XAD_",4a)') ; cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) ; CALL iom_put( cltra, ptrtrd(:,:,:) ) 84 CASE( jptra_yad ) ; WRITE (cltra,'("YAD_",4a)') ; cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) ; CALL iom_put( cltra, ptrtrd(:,:,:) ) 85 CASE( jptra_zad ) ; WRITE (cltra,'("ZAD_",4a)') ; cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) ; CALL iom_put( cltra, ptrtrd(:,:,:) ) 86 CASE( jptra_ldf ) ; WRITE (cltra,'("LDF_",4a)') ; cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) ; CALL iom_put( cltra, ptrtrd(:,:,:) ) 87 CASE( jptra_bbl ) ; WRITE (cltra,'("BBL_",4a)') ; cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) ; CALL iom_put( cltra, ptrtrd(:,:,:) ) 88 CASE( jptra_nsr ) ; WRITE (cltra,'("FOR_",4a)') ; cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) ; CALL iom_put( cltra, ptrtrd(:,:,:) ) 89 CASE( jptra_zdf ) ; WRITE (cltra,'("ZDF_",4a)') ; cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) ; CALL iom_put( cltra, ptrtrd(:,:,:) ) 90 CASE( jptra_zdfp ) ; WRITE (cltra,'("ZDP_",4a)') ; cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) ; CALL iom_put( cltra, ptrtrd(:,:,:) ) 91 CASE( jptra_dmp ) ; WRITE (cltra,'("DMP_",4a)') ; cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) ; CALL iom_put( cltra, ptrtrd(:,:,:) ) 92 CASE( jptra_sms ) ; WRITE (cltra,'("SMS_",4a)') ; cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) ; CALL iom_put( cltra, ptrtrd(:,:,:) ) 93 CASE( jptra_tot ) ; WRITE (cltra,'("TOT_",4a)') ; cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) ; CALL iom_put( cltra, ptrtrd(:,:,:) ) 94 CASE( jptra_atf ) ; WRITE (cltra,'("ATF_",4a)') ; cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) ; CALL iom_put( cltra, ptrtrd(:,:,:) ) 95 CASE( jptra_radb ) ; WRITE (cltra,'("RDB_",4a)') ; cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) ; CALL iom_put( cltra, ptrtrd(:,:,:) ) 96 CASE( jptra_radn ) ; WRITE (cltra,'("RDN_",4a)') ; cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) ; CALL iom_put( cltra, ptrtrd(:,:,:) ) 95 97 END SELECT 96 cltra = TRIM(cltra)//TRIM(ctrcnm(kjn))97 CALL iom_put( cltra, ptrtrd(:,:,:) )98 98 ! 99 99 END IF -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/TRP/trdtrc_oce.F90
r9950 r10321 107 107 108 108 !!---------------------------------------------------------------------- 109 !! NEMO/TOP 3.3, NEMO Consortium (2018)109 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 110 110 !! $Id$ 111 !! Software governed by the CeCILL licen ce (./LICENSE)111 !! Software governed by the CeCILL license (see ./LICENSE) 112 112 !!---------------------------------------------------------------------- 113 113 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/oce_trc.F90
r9950 r10321 82 82 USE ldfslp , ONLY : wslpi => wslpi !: i-slope at w-point 83 83 USE ldfslp , ONLY : wslpj => wslpj !: j-slope at w-point 84 USE ldfslp , ONLY : ln_traldf_triad => ln_traldf_triad !: use of triad scheme 84 USE ldfslp , ONLY : ln_traldf_triad => ln_traldf_triad !: use of triad scheme 85 USE ldfslp , ONLY : ln_traldf_iso => ln_traldf_iso !: use of isopycnal scheme 85 86 !!gm end 86 87 -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/trc.F90
r9950 r10321 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 … … 130 133 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 131 134 !! $Id$ 132 !! Software governed by the CeCILL licen ce (./LICENSE)135 !! Software governed by the CeCILL license (see ./LICENSE) 133 136 !!---------------------------------------------------------------------- 134 137 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/trcbc.F90
r9950 r10321 51 51 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 52 52 !! $Id$ 53 !! Software governed by the CeCILL licen ce (./LICENSE)53 !! Software governed by the CeCILL license (see ./LICENSE) 54 54 !!---------------------------------------------------------------------- 55 55 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/trcbdy.F90
- Property svn:keywords set to Id
r9950 r10321 31 31 32 32 !!---------------------------------------------------------------------- 33 !! NEMO/ OCE4.0 , NEMO Consortium (2018)33 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 34 34 !! $Id$ 35 !! Software governed by the CeCILL licen ce (./LICENSE)35 !! Software governed by the CeCILL license (see ./LICENSE) 36 36 !!---------------------------------------------------------------------- 37 37 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/trcdta.F90
r9950 r10321 40 40 41 41 !!---------------------------------------------------------------------- 42 !! NEMO/ OCE4.0 , NEMO Consortium (2018)42 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 43 43 !! $Id$ 44 !! Software governed by the CeCILL licen ce (./LICENSE)44 !! Software governed by the CeCILL license (see ./LICENSE) 45 45 !!---------------------------------------------------------------------- 46 46 CONTAINS … … 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/UKMO/NEMO4_beta_mirror/src/TOP/trcice.F90
- Property svn:keywords set to Id
r9950 r10321 28 28 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 29 29 !! $Id$ 30 !! Software governed by the CeCILL licen ce (./LICENSE)30 !! Software governed by the CeCILL license (see ./LICENSE) 31 31 !!---------------------------------------------------------------------- 32 32 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/trcini.F90
r9950 r10321 35 35 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 36 36 !! $Id$ 37 !! Software governed by the CeCILL licen ce (./LICENSE)37 !! Software governed by the CeCILL license (see ./LICENSE) 38 38 !!---------------------------------------------------------------------- 39 39 CONTAINS … … 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/UKMO/NEMO4_beta_mirror/src/TOP/trcnam.F90
r9950 r10321 33 33 34 34 !!---------------------------------------------------------------------- 35 !! NEMO/TOP 3.3, NEMO Consortium (2018)35 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 36 36 !! $Id$ 37 !! Software governed by the CeCILL licen ce (./LICENSE)37 !! Software governed by the CeCILL license (see ./LICENSE) 38 38 !!---------------------------------------------------------------------- 39 39 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/trcrst.F90
r9950 r10321 33 33 34 34 !!---------------------------------------------------------------------- 35 !! NEMO/TOP 3.7, NEMO Consortium (2018)35 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 36 36 !! $Id$ 37 !! Software governed by the CeCILL licen ce (./LICENSE)37 !! Software governed by the CeCILL license (see ./LICENSE) 38 38 !!---------------------------------------------------------------------- 39 39 CONTAINS … … 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 ) … … 347 347 348 348 !!---------------------------------------------------------------------- 349 !! NEMO/TOP 3.3, NEMO Consortium (2018)349 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 350 350 !! $Id$ 351 !! Software governed by the CeCILL licen ce (./LICENSE)351 !! Software governed by the CeCILL license (see ./LICENSE) 352 352 !!====================================================================== 353 353 END MODULE trcrst -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/trcsms.F90
r9950 r10321 28 28 29 29 !!---------------------------------------------------------------------- 30 !! NEMO/TOP 3.3, NEMO Consortium (2018)30 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 31 31 !! $Id$ 32 !! Software governed by the CeCILL licen ce (./LICENSE)32 !! Software governed by the CeCILL license (see ./LICENSE) 33 33 !!---------------------------------------------------------------------- 34 34 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/trcstp.F90
r9950 r10321 37 37 38 38 !!---------------------------------------------------------------------- 39 !! NEMO/TOP 3.3, NEMO Consortium (2018)39 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 40 40 !! $Id$ 41 !! Software governed by the CeCILL licen ce (./LICENSE)41 !! Software governed by the CeCILL license (see ./LICENSE) 42 42 !!---------------------------------------------------------------------- 43 43 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/trcsub.F90
r9950 r10321 78 78 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 79 79 !! $Id$ 80 !! Software governed by the CeCILL licen ce (./LICENSE)80 !! Software governed by the CeCILL license (see ./LICENSE) 81 81 !!---------------------------------------------------------------------- 82 82 CONTAINS -
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/trcwri.F90
r9950 r10321 76 76 77 77 !!---------------------------------------------------------------------- 78 !! NEMO/TOP 3.3, NEMO Consortium (2018)78 !! NEMO/TOP 4.0 , NEMO Consortium (2018) 79 79 !! $Id$ 80 !! Software governed by the CeCILL licen ce (./LICENSE)80 !! Software governed by the CeCILL license (see ./LICENSE) 81 81 !!====================================================================== 82 82 END MODULE trcwri
Note: See TracChangeset
for help on using the changeset viewer.