New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
p4zligand.F90 in NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/TOP/PISCES/P4Z – NEMO

source: NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/TOP/PISCES/P4Z/p4zligand.F90 @ 12210

Last change on this file since 12210 was 12210, checked in by cetlod, 4 years ago

dev_merge_option2 : merge in fix_sn_cfctl_ticket2328 branch

  • Property svn:keywords set to Id
File size: 6.5 KB
RevLine 
[7162]1MODULE p4zligand
2   !!======================================================================
3   !!                         ***  MODULE p4zligand  ***
4   !! TOP :   PISCES Compute remineralization/dissolution of organic ligands
5   !!=========================================================================
6   !! History :   3.6  !  2016-03  (O. Aumont, A. Tagliabue) Quota model and reorganization
7   !!----------------------------------------------------------------------
[9169]8   !!   p4z_ligand     :  Compute remineralization/dissolution of organic ligands
9   !!   p4z_ligand_init:  Initialisation of parameters for remineralisation
[7162]10   !!----------------------------------------------------------------------
[9169]11   USE oce_trc         ! shared variables between ocean and passive tracers
12   USE trc             ! passive tracers common variables
13   USE sms_pisces      ! PISCES Source Minus Sink variables
14   USE prtctl_trc      ! print control for debugging
[10362]15   USE iom             !  I/O manager
[7162]16
17   IMPLICIT NONE
18   PRIVATE
19
20   PUBLIC   p4z_ligand         ! called in p4zbio.F90
21   PUBLIC   p4z_ligand_init    ! called in trcsms_pisces.F90
22
23   REAL(wp), PUBLIC ::  rlgw     !: lifetime (years) of weak ligands
24   REAL(wp), PUBLIC ::  rlgs     !: lifetime (years) of strong ligands
25   REAL(wp), PUBLIC ::  rlig     !: Remin ligand production
26   REAL(wp), PUBLIC ::  prlgw    !: Photochemical of weak ligand
27
28   !!----------------------------------------------------------------------
[10067]29   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
[10069]30   !! $Id$
[10068]31   !! Software governed by the CeCILL license (see ./LICENSE)
[7162]32   !!----------------------------------------------------------------------
33CONTAINS
34
35   SUBROUTINE p4z_ligand( kt, knt )
36      !!---------------------------------------------------------------------
37      !!                     ***  ROUTINE p4z_ligand  ***
38      !!
39      !! ** Purpose :   Compute remineralization/scavenging of organic ligands
40      !!---------------------------------------------------------------------
41      INTEGER, INTENT(in) ::   kt, knt ! ocean time step
42      !
43      INTEGER  ::   ji, jj, jk
[10416]44      REAL(wp) ::   zlgwp, zlgwpr, zlgwr, zlablgw
[10362]45      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zligrem, zligpr, zrligprod
46      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zw3d
[9169]47      CHARACTER (len=25) ::   charout
[7162]48      !!---------------------------------------------------------------------
49      !
[9124]50      IF( ln_timing )   CALL timing_start('p4z_ligand')
[7162]51      !
52      DO jk = 1, jpkm1
53         DO jj = 1, jpj
54            DO ji = 1, jpi
[9169]55               !
56               ! ------------------------------------------------------------------
57               ! Remineralization of iron ligands
58               ! ------------------------------------------------------------------
[7162]59               ! production from remineralisation of organic matter
[10362]60               zlgwp = orem(ji,jj,jk) * rlig
[7162]61               ! decay of weak ligand
62               ! This is based on the idea that as LGW is lower
63               ! there is a larger fraction of refractory OM
[7177]64               zlgwr = max( rlgs , rlgw * exp( -2 * (trb(ji,jj,jk,jplgw)*1e9) ) ) ! years
[10362]65               zlgwr = 1. / zlgwr * tgfunc(ji,jj,jk) * ( xstep / nyear_len(1) ) * blim(ji,jj,jk) * trb(ji,jj,jk,jplgw)
[7162]66               ! photochem loss of weak ligand
[7177]67               zlgwpr = prlgw * xstep * etot(ji,jj,jk) * trb(ji,jj,jk,jplgw) * (1. - fr_i(ji,jj))
[7162]68               tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + zlgwp - zlgwr - zlgwpr
[10362]69               zligrem(ji,jj,jk)   = zlgwr
70               zligpr(ji,jj,jk)    = zlgwpr
71               zrligprod(ji,jj,jk) = zlgwp
[9169]72               !
[7162]73            END DO
74         END DO
75      END DO
[9169]76      !
[10362]77      !  Output of some diagnostics variables
78      !     ---------------------------------
79      IF( lk_iomput .AND. knt == nrdttrc ) THEN
80         ALLOCATE( zw3d(jpi,jpj,jpk) )
81         IF( iom_use( "LIGREM" ) ) THEN
82            zw3d(:,:,:) = zligrem(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:)
83            CALL iom_put( "LIGREM", zw3d )
84         ENDIF
85         IF( iom_use( "LIGPR" ) ) THEN
86            zw3d(:,:,:) = zligpr(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:) 
87            CALL iom_put( "LIGPR", zw3d )
88         ENDIF
89         IF( iom_use( "LPRODR" ) ) THEN
90            zw3d(:,:,:) = zrligprod(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:) 
91            CALL iom_put( "LPRODR", zw3d )
92         ENDIF
93         DEALLOCATE( zw3d )
94      ENDIF
95      !
[12210]96      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging)
[7162]97         WRITE(charout, FMT="('ligand1')")
98         CALL prt_ctl_trc_info(charout)
99         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
[9169]100      ENDIF
[7162]101      !
[9124]102      IF( ln_timing )   CALL timing_stop('p4z_ligand')
[7162]103      !
104   END SUBROUTINE p4z_ligand
105
106
107   SUBROUTINE p4z_ligand_init
108      !!----------------------------------------------------------------------
109      !!                  ***  ROUTINE p4z_ligand_init  ***
110      !!
111      !! ** Purpose :   Initialization of remineralization parameters
112      !!
113      !! ** Method  :   Read the nampislig namelist and check the parameters
114      !!
115      !! ** input   :   Namelist nampislig
116      !!----------------------------------------------------------------------
[9124]117      INTEGER ::   ios   ! Local integer
118      !
[10416]119      NAMELIST/nampislig/ rlgw, prlgw, rlgs, rlig
[9124]120      !!----------------------------------------------------------------------
[9169]121      !
122      IF(lwp) THEN
123         WRITE(numout,*)
124         WRITE(numout,*) 'p4z_ligand_init : remineralization/scavenging of organic ligands'
125         WRITE(numout,*) '~~~~~~~~~~~~~~~'
126      ENDIF
[7162]127      READ  ( numnatp_ref, nampislig, IOSTAT = ios, ERR = 901)
[11536]128901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampislig in reference namelist' )
[7162]129      READ  ( numnatp_cfg, nampislig, IOSTAT = ios, ERR = 902 )
[11536]130902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampislig in configuration namelist' )
[7162]131      IF(lwm) WRITE ( numonp, nampislig )
[9169]132      !
[7162]133      IF(lwp) THEN                         ! control print
[9169]134         WRITE(numout,*) '   Namelist : nampislig'
135         WRITE(numout,*) '      Lifetime (years) of weak ligands             rlgw  =', rlgw
136         WRITE(numout,*) '      Remin ligand production per unit C           rlig  =', rlig
137         WRITE(numout,*) '      Photolysis of weak ligand                    prlgw =', prlgw
138         WRITE(numout,*) '      Lifetime (years) of strong ligands           rlgs  =', rlgs
[7162]139      ENDIF
140      !
141   END SUBROUTINE p4z_ligand_init
142
143   !!======================================================================
144END MODULE p4zligand
Note: See TracBrowser for help on using the repository browser.