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.
sms_pisces.F90 in NEMO/trunk/src/TOP/PISCES – NEMO

source: NEMO/trunk/src/TOP/PISCES/sms_pisces.F90 @ 13891

Last change on this file since 13891 was 12377, checked in by acc, 4 years ago

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge --ignore-ancestry \

svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The --ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

  • Property svn:keywords set to Id
File size: 9.8 KB
RevLine 
[1073]1MODULE sms_pisces   
2   !!----------------------------------------------------------------------
3   !!                     ***  sms_pisces.F90  *** 
4   !! TOP :   PISCES Source Minus Sink variables
5   !!----------------------------------------------------------------------
6   !! History :   1.0  !  2000-02 (O. Aumont) original code
[1445]7   !!             3.2  !  2009-04 (C. Ethe & NEMO team) style
[1073]8   !!----------------------------------------------------------------------
9   USE par_oce
10   USE par_trc
11
12   IMPLICIT NONE
13   PUBLIC
14
[12377]15   CHARACTER(:), ALLOCATABLE ::   numnatp_ref   !! Character buffer for reference namelist pisces
16   CHARACTER(:), ALLOCATABLE ::   numnatp_cfg   !! Character buffer for configuration namelist pisces
17   INTEGER ::   numonp      = -1                !! Logical unit for namelist pisces output
[3294]18
[3680]19   !                                                       !:  PISCES  : silicon dependant half saturation
20
[7646]21   !!* Model used
22   LOGICAL  ::  ln_p2z            !: Flag to use LOBSTER model
23   LOGICAL  ::  ln_p4z            !: Flag to use PISCES  model
24   LOGICAL  ::  ln_p5z            !: Flag to use PISCES  quota model
25   LOGICAL  ::  ln_ligand         !: Flag to enable organic ligands
[10222]26   LOGICAL  ::  ln_sediment       !: Flag to enable sediment module
[7646]27
[1445]28   !!*  Time variables
29   INTEGER  ::   nrdttrc           !: ???
30   REAL(wp) ::   rfact , rfactr    !: ???
31   REAL(wp) ::   rfact2, rfact2r   !: ???
[2528]32   REAL(wp) ::   xstep             !: Time step duration for biology
[4996]33   REAL(wp) ::   ryyss             !: number of seconds per year
34   REAL(wp) ::   r1_ryyss          !: inverse number of seconds per year
[1073]35
[4996]36
[1445]37   !!*  Biological parameters
38   REAL(wp) ::   rno3              !: ???
39   REAL(wp) ::   o2ut              !: ???
40   REAL(wp) ::   po4r              !: ???
41   REAL(wp) ::   rdenit            !: ???
[3294]42   REAL(wp) ::   rdenita           !: ???
[1445]43   REAL(wp) ::   o2nit             !: ???
44   REAL(wp) ::   wsbio, wsbio2     !: ???
[7646]45   REAL(wp) ::   wsbio2max         !: ???
46   REAL(wp) ::   wsbio2scale       !: ???
[1445]47   REAL(wp) ::   xkmort            !: ???
48   REAL(wp) ::   ferat3            !: ???
[7646]49   REAL(wp) ::   ldocp             !: ???
50   REAL(wp) ::   ldocz             !: ???
51   REAL(wp) ::   lthet             !: ???
52   REAL(wp) ::   no3rat3           !: ???
53   REAL(wp) ::   po4rat3           !: ???
[1073]54
[7646]55
[3680]56   !!*  diagnostic parameters
57   REAL(wp) ::  tpp                !: total primary production
58   REAL(wp) ::  t_oce_co2_exp      !: total carbon export
59   REAL(wp) ::  t_oce_co2_flx      !: Total ocean carbon flux
[4996]60   REAL(wp) ::  t_oce_co2_flx_cum  !: Cumulative Total ocean carbon flux
[3680]61   REAL(wp) ::  t_atm_co2_flx      !: global mean of atmospheric pco2
[1073]62
[3680]63   !!* restoring
64   LOGICAL  ::  ln_pisdmp          !: restoring or not of nutrients to a mean value
65   INTEGER  ::  nn_pisdmp          !: frequency of relaxation or not of nutrients to a mean value
[1073]66
[3680]67   !!* Mass conservation
68   LOGICAL  ::  ln_check_mass      !: Flag to check mass conservation
[10788]69   LOGICAL , PUBLIC ::   ln_ironice   !: boolean for Fe input from sea ice
[3680]70
[7646]71   !!*  Biological fluxes for light : variables shared by pisces & lobster
72   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:)   ::  neln  !: number of T-levels + 1 in the euphotic layer
73   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::  heup  !: euphotic layer depth
74   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  etot  !: par (photosynthetic available radiation)
75   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  etot_ndcy      !: PAR over 24h in case of diurnal cycle
76   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  enano, ediat   !: PAR for phyto, nano and diat
[10362]77   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  enanom, ediatm !: PAR for phyto, nano and diat
[7646]78   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  epico          !: PAR for pico
[10362]79   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  epicom         !: PAR for pico
[7646]80   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  emoy           !: averaged PAR in the mixed layer
81   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::  heup_01 !: Absolute euphotic layer depth
82   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::  xksi  !:  LOBSTER : zooplakton closure
83
[1445]84   !!*  Biological fluxes for primary production
[7646]85   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)    ::   xksimax    !: ???
[3680]86   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   biron      !: bioavailable fraction of iron
[7646]87   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   plig       !: proportion of iron organically complexed
[1073]88
[7646]89   !!*  Sinking speed
90   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   wsbio3   !: POC sinking speed
91   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   wsbio4   !: GOC sinking speed
[3294]92
[1445]93   !!*  SMS for the organic matter
[2715]94   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xfracal    !: ??
95   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   nitrfac    !: ??
[8533]96   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   nitrfac2   !: ??
[7646]97   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   orem       !: ??
[2715]98   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xdiss      !: ??
[3680]99   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   prodcal    !: Calcite production
[7646]100   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   prodpoc    !: Calcite production
101   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   conspoc    !: Calcite production
102   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   prodgoc    !: Calcite production
103   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   consgoc    !: Calcite production
[10362]104   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   blim       !: bacterial production factor
[7646]105   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sizen      !: size of diatoms
106   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sizep      !: size of diatoms
107   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sized      !: size of diatoms
108
109
[1445]110   !!* Variable for chemistry of the CO2 cycle
[2715]111   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ak13       !: ???
112   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ak23       !: ???
113   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   aksp       !: ???
114   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   hi         !: ???
[3294]115   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   excess     !: ???
[6291]116   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   aphscale   !:
[1073]117
[6291]118
[3294]119   !!* Temperature dependancy of SMS terms
120   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tgfunc    !: Temp. dependancy of various biological rates
121   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tgfunc2   !: Temp. dependancy of mesozooplankton rates
122
[12377]123   LOGICAL, SAVE :: lk_sed
124
[2715]125   !!----------------------------------------------------------------------
[10067]126   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
[2715]127   !! $Id$
[10068]128   !! Software governed by the CeCILL license (see ./LICENSE)
[2715]129   !!----------------------------------------------------------------------
130CONTAINS
131
132   INTEGER FUNCTION sms_pisces_alloc()
133      !!----------------------------------------------------------------------
134      !!        *** ROUTINE sms_pisces_alloc ***
135      !!----------------------------------------------------------------------
[10425]136      USE lib_mpp , ONLY: ctl_stop
[7646]137      INTEGER ::   ierr(10)        ! Local variables
[2715]138      !!----------------------------------------------------------------------
139      ierr(:) = 0
[3680]140      !*  Biological fluxes for light : shared variables for pisces & lobster
[7646]141      ALLOCATE( etot(jpi,jpj,jpk), neln(jpi,jpj), heup(jpi,jpj),    &
142        &       heup_01(jpi,jpj) , xksi(jpi,jpj)               ,  STAT=ierr(1) )
[2715]143      !
[7646]144 
145      IF( ln_p4z .OR. ln_p5z ) THEN
146         !*  Biological fluxes for light
147         ALLOCATE(  enano(jpi,jpj,jpk)    , ediat(jpi,jpj,jpk) ,   &
[10362]148           &        enanom(jpi,jpj,jpk)   , ediatm(jpi,jpj,jpk),   &
[7646]149           &        etot_ndcy(jpi,jpj,jpk), emoy(jpi,jpj,jpk)  ,  STAT=ierr(2) ) 
150
151         !*  Biological fluxes for primary production
152         ALLOCATE( xksimax(jpi,jpj)  , biron(jpi,jpj,jpk)      ,  STAT=ierr(3) )
[2715]153         !
[7646]154         !*  SMS for the organic matter
[8533]155         ALLOCATE( xfracal (jpi,jpj,jpk), orem(jpi,jpj,jpk)    ,    &
156            &      nitrfac(jpi,jpj,jpk), nitrfac2(jpi,jpj,jpk) ,    &
157            &      prodcal(jpi,jpj,jpk) , xdiss   (jpi,jpj,jpk),    &
[7646]158            &      prodpoc(jpi,jpj,jpk) , conspoc(jpi,jpj,jpk) ,    &
[10362]159            &      prodgoc(jpi,jpj,jpk) , consgoc(jpi,jpj,jpk) ,    &
160            &      blim   (jpi,jpj,jpk) ,                         STAT=ierr(4) )
[3680]161
[7646]162         !* Variable for chemistry of the CO2 cycle
163         ALLOCATE( ak13  (jpi,jpj,jpk) ,                            &
164            &      ak23(jpi,jpj,jpk)    , aksp  (jpi,jpj,jpk) ,     &
165            &      hi  (jpi,jpj,jpk)    , excess(jpi,jpj,jpk) ,     &
166            &      aphscale(jpi,jpj,jpk),                         STAT=ierr(5) )
[2715]167         !
[7646]168         !* Temperature dependancy of SMS terms
169         ALLOCATE( tgfunc(jpi,jpj,jpk)  , tgfunc2(jpi,jpj,jpk),   STAT=ierr(6) )
[3294]170         !
[7646]171         !* Sinkong speed
172         ALLOCATE( wsbio3 (jpi,jpj,jpk) , wsbio4 (jpi,jpj,jpk),     &
[10362]173            &                             STAT=ierr(7) )   
[7646]174         !
175         IF( ln_ligand ) THEN
[10416]176           ALLOCATE( plig(jpi,jpj,jpk)  ,                         STAT=ierr(8) )
[7646]177         ENDIF
178      ENDIF
[2715]179      !
[7646]180      IF( ln_p5z ) THEN
181         !       
[10362]182         ALLOCATE( epico(jpi,jpj,jpk)   , epicom(jpi,jpj,jpk) ,   STAT=ierr(9) ) 
[7646]183
184         !*  Size of phytoplankton cells
185         ALLOCATE( sizen(jpi,jpj,jpk), sizep(jpi,jpj,jpk),         &
186           &       sized(jpi,jpj,jpk),                            STAT=ierr(10) )
187      ENDIF
188      !
[2715]189      sms_pisces_alloc = MAXVAL( ierr )
190      !
[10425]191      IF( sms_pisces_alloc /= 0 )   CALL ctl_stop( 'STOP', 'sms_pisces_alloc: failed to allocate arrays' ) 
[2715]192      !
193   END FUNCTION sms_pisces_alloc
194
[1073]195   !!======================================================================   
196END MODULE sms_pisces   
Note: See TracBrowser for help on using the repository browser.