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.
Changeset 775 for branches/dev_001_GM/NEMO/TOP_SRC/PISCES_SMS/p4zbio.F90 – NEMO

Ignore:
Timestamp:
2007-12-19T14:45:15+01:00 (16 years ago)
Author:
gm
Message:

dev_001_GM - PISCES in F90 : encapsulation of all p4z...F files in module F90 + doctor norme for local variables - compilation OK

File:
1 moved

Legend:

Unmodified
Added
Removed
  • branches/dev_001_GM/NEMO/TOP_SRC/PISCES_SMS/p4zbio.F90

    r774 r775  
    1  
    2 CCC $Header$  
    3 CCC  TOP 1.0 , LOCEAN-IPSL (2005)  
    4 C This software is governed by CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    5 C --------------------------------------------------------------------------- 
    6       SUBROUTINE p4zbio 
    7 CDIR$ LIST 
    8 #if defined key_top && defined key_pisces 
    9 CCC   ------------------------------------------------------------------ 
    10 CCC    
    11 CCC   ROUTINE p4zbio : PISCES MODEL 
    12 CCC   ***************************** 
    13 CCC    
    14 CC 
    15 CC     PURPOSE. 
    16 CC     -------- 
    17 CC          *P4ZBIO* ECOSYSTEM MODEL IN THE WHOLE OCEAN 
    18 CC                   THIS ROUTINE COMPUTES THE DIFFERENT INTERACTIONS 
    19 CC                   BETWEEN THE DIFFERENT COMPARTMENTS OF THE MODEL 
    20 CC     EXTERNAL : 
    21 CC     ---------- 
    22 CC          p4zopt, p4zprod, p4znano, p4zdiat, p4zmicro, p4zmeso 
    23 CC          p4zsink, p4zrem 
    24 CC 
    25 CC   MODIFICATIONS: 
    26 CC   -------------- 
    27 CC      original      : 2004    O. Aumont 
    28 CC ---------------------------------------------------------------- 
    29 CC parameters and commons 
    30 CC ====================== 
    31 CDIR$ NOLIST 
    32       USE oce_trc 
    33       USE trp_trc 
    34       USE sms 
    35       IMPLICIT NONE 
    36 #include "domzgr_substitute.h90" 
    37 CDIR$ LIST 
    38 CC----------------------------------------------------------------- 
    39 CC local declarations 
    40 CC ================== 
    41 C      
    42       INTEGER ji, jj, jk, jn 
    43  
    44       REAL zdenom,zdenom1(jpi,jpj,jpk) 
    45       REAL prodca,ztemp 
    46  
     1MODULE p4zbio 
     2   !!====================================================================== 
     3   !!                         ***  MODULE p4zbio  *** 
     4   !! TOP :   PISCES bio-model 
     5   !!====================================================================== 
     6   !! History :   1.0  !  2004     (O. Aumont) Original code 
     7   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
     8   !!---------------------------------------------------------------------- 
     9#if defined key_pisces 
     10   !!---------------------------------------------------------------------- 
     11   !!   'key_pisces'                                       PISCES bio-model 
     12   !!---------------------------------------------------------------------- 
     13   !!   p4z_bio        :   computes the interactions between the different 
     14   !!                      compartments of PISCES 
     15   !!---------------------------------------------------------------------- 
     16   USE oce_trc         ! 
     17   USE trp_trc         !  
     18   USE sms             !  
     19   USE p4zsink         !  
     20   USE p4zsink_kriest  !  
     21   USE p4zopt          !  
     22   USE p4zlim          !  
     23   USE p4zprod         ! 
     24   USE p4znano         ! 
     25   USE p4zdiat         !  
     26   USE p4zmicro        !  
     27   USE p4zmeso         !  
     28   USE p4zrem          !  
     29    
     30   IMPLICIT NONE 
     31   PRIVATE 
     32 
     33   PUBLIC   p4z_bio    ! called in p4zprg.F90 
     34 
     35   !!* Substitution 
     36#  include "domzgr_substitute.h90" 
     37   !!---------------------------------------------------------------------- 
     38   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     39   !! $Header:$  
     40   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     41   !!---------------------------------------------------------------------- 
     42 
     43CONTAINS 
     44 
     45   SUBROUTINE p4z_bio 
     46      !!--------------------------------------------------------------------- 
     47      !!                     ***  ROUTINE p4z_bio  *** 
     48      !! 
     49      !! ** Purpose :   Ecosystem model in the whole ocean: computes the 
     50      !!              different interactions between the different compartments 
     51      !!              of PISCES 
     52      !! 
     53      !! ** Method  : - ??? 
     54      !!--------------------------------------------------------------------- 
     55      INTEGER  ::   ji, jj, jk, jn 
     56      REAL(wp) ::   zdenom, ztemp 
     57      REAL(wp) ::   zprodt, zprodca 
     58      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdenom1 
     59      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zfracal 
     60#if defined key_kriest 
     61      REAL(wp) ::   znumpoc, znumdoc 
     62#else 
     63      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdenom2 
     64#endif 
     65      !!--------------------------------------------------------------------- 
     66 
     67      !     ASSIGN THE SHEAR RATE THAT IS USED FOR AGGREGATION 
     68      !     OF PHYTOPLANKTON AND DETRITUS 
     69 
     70      zdiss(:,:,:) = 0.01 
     71 
     72!!gm the use of nmld should be better here? 
     73      DO jk = 1, jpkm1 
     74         DO jj = 1, jpj 
     75            DO ji = 1, jpi 
     76               IF( fsdepw(ji,jj,jk+1) .le. hmld(ji,jj) )   zdiss(ji,jj,jk) = 1.e0 
     77            END DO  
     78         END DO 
     79      END DO 
     80 
     81      ! Compute de different ratios for scavenging of iron 
     82      ! -------------------------------------------------- 
     83 
     84      DO jk = 1, jpk 
     85         DO jj = 1, jpj 
     86            DO ji = 1, jpi 
    4787#if ! defined key_kriest 
    48       REAL zdenom2(jpi,jpj,jpk) 
     88               zdenom = 1. / (  trn(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpgoc)           & 
     89                  &           + trn(ji,jj,jk,jpdsi) + trn(ji,jj,jk,jpcal) + rtrn ) 
     90               zdenom1(ji,jj,jk) = trn(ji,jj,jk,jppoc) * zdenom 
     91               zdenom2(ji,jj,jk) = trn(ji,jj,jk,jpgoc) * zdenom 
    4992#else 
    50       REAL znumpoc, znumdoc 
     93               zdenom = 1. / (  trn(ji,jj,jk,jppoc)                                 & 
     94                  &           + trn(ji,jj,jk,jpdsi) + trn(ji,jj,jk,jpcal) + rtrn ) 
     95               zdenom1(ji,jj,jk) = trn(ji,jj,jk,jppoc) * zdenom 
    5196#endif 
    52 C      
    53       REAL prodt 
    54       REAL zfracal(jpi,jpj,jpk) 
    55 C 
    56 C     ASSIGN THE SHEAR RATE THAT IS USED FOR AGGREGATION 
    57 C     OF PHYTOPLANKTON AND DETRITUS 
    58 C 
    59        zdiss(:,:,:) = 0.01 
    60 C 
    61       DO jk=1,jpkm1 
    62         DO jj=1,jpj 
    63           DO ji=1,jpi 
    64        if (fsdepw(ji,jj,jk+1).le.hmld(ji,jj)) zdiss(ji,jj,jk)=1. 
    65           END DO  
    66         END DO 
    67       END DO 
    68 C 
    69 C      Compute de different ratios for scavenging of iron 
    70 C      -------------------------------------------------- 
    71 C 
    72        DO jk=1,jpk 
    73          DO jj=1,jpj 
    74            DO ji=1,jpi 
    75 #if ! defined key_kriest 
    76          zdenom=1./(trn(ji,jj,jk,jppoc)+trn(ji,jj,jk,jpgoc) 
    77      $     +trn(ji,jj,jk,jpdsi)+trn(ji,jj,jk,jpcal)+rtrn) 
    78 C 
    79          zdenom1(ji,jj,jk)=trn(ji,jj,jk,jppoc)*zdenom 
    80          zdenom2(ji,jj,jk)=trn(ji,jj,jk,jpgoc)*zdenom 
     97            END DO 
     98         END DO 
     99      END DO 
     100 
     101      ! Compute the fraction of nanophytoplankton that is made of calcifiers 
     102      ! -------------------------------------------------------------------- 
     103 
     104      DO jk = 1, jpkm1 
     105         DO jj = 1, jpj 
     106            DO ji = 1, jpi 
     107               ztemp = MAX( 0., tn(ji,jj,jk) ) 
     108               zfracal(ji,jj,jk) = caco3r * xlimphy(ji,jj,jk)   & 
     109                  &                       * MAX( 0.0001, ztemp / ( 2.+ ztemp ) )   & 
     110                  &                       * MAX( 1., trn(ji,jj,jk,jpphy) * 1.e6 / 2. ) 
     111               zfracal(ji,jj,jk) = MIN( 0.8 , zfracal(ji,jj,jk) ) 
     112               zfracal(ji,jj,jk) = MAX( 0.01, zfracal(ji,jj,jk) ) 
     113            END DO 
     114         END DO 
     115      END DO 
     116 
     117      ! computation of the vertical flux of particulate organic matter 
     118      ! -------------------------------------------------------------- 
     119 
     120      IF( lk_kriest )   THEN   ;   CALL p4z_sink_kriest      ! Sink due to vertical flux of POM 
     121      ELSE                     ;   CALL p4z_sink             !  
     122      ENDIF 
     123 
     124      ! compute the PAR in the water column 
     125      ! ----------------------------------- 
     126 
     127      CALL p4z_opt       ! Optical  
     128 
     129      ! compute the co-limitations by the various nutrients 
     130      ! ---------------------------------------------------- 
     131 
     132      CALL p4z_lim 
     133 
     134      ! compute phytoplankton growth rate over the global ocean.  
     135      ! ------------------------------------------------------- 
     136      ! (Growth rates for each element is computed (C, Si, Fe, Chl)) 
     137 
     138      CALL p4z_prod 
     139 
     140      ! phytoplankton mortality (Mortality losses for each elements are computed (C, Fe, Si, Chl) ) 
     141      ! ----------------------- 
     142 
     143      CALL p4z_nano       ! nanophytoplankton 
     144       
     145      CALL p4z_diat       ! diatoms 
     146 
     147      ! zooplankton sources/sinks routines (each elements are computed (C, Fe, Si, Chl) ) 
     148      ! ---------------------------------- 
     149 
     150      CALL p4z_micro      ! microzooplankton 
     151       
     152      CALL p4z_meso       ! mesozooplankton 
     153 
     154      ! computation of remineralization terms of organic matter + scavenging of Fe 
     155      ! -------------------------------------------------------------------------- 
     156       
     157      CALL p4z_rem        ! remineralization 
     158 
     159 
     160      ! Determination of tracers concentration as a function of biological sources and sinks 
     161      ! ------------------------------------------------------------------------------------ 
     162 
     163      DO jk = 1, jpkm1 
     164 
     165         ! Evolution of PO4 
     166         ! ----------------     
     167         trn(:,:,jk,jppo4) = trn(:,:,jk,jppo4) - prorca(:,:,jk) - prorca2(:,:,jk)            & 
     168            &                                  + olimi (:,:,jk) + grarem (:,:,jk) * sigma1   & 
     169            &                                  + denitr(:,:,jk) + grarem2(:,:,jk) * sigma2 
     170 
     171         ! Evolution of NO3 and NH4 
     172         ! ------------------------ 
     173         trn(:,:,jk,jpno3) = trn(:,:,jk,jpno3) - pronew(:,:,jk) - pronew2(:,:,jk)            & 
     174            &                                  + onitr (:,:,jk) - denitr (:,:,jk) * rdenit 
     175 
     176         trn(:,:,jk,jpnh4) = trn(:,:,jk,jpnh4) - proreg(:,:,jk) - proreg2(:,:,jk)            & 
     177            &                                  + olimi (:,:,jk) + grarem (:,:,jk) * sigma1   & 
     178            &                                                   + grarem2(:,:,jk) * sigma2   & 
     179            &                                  - onitr (:,:,jk) + denitr (:,:,jk) 
     180 
     181         ! Evolution of Phytoplankton 
     182         ! -------------------------- 
     183         trn(:,:,jk,jpphy) = trn(:,:,jk,jpphy) + prorca (:,:,jk) * ( 1.- excret ) - tortp(:,:,jk)   & 
     184            &                                  - grazp  (:,:,jk) - grazn(:,:,jk)  - respp(:,:,jk) 
     185 
     186         trn(:,:,jk,jpnch) = trn(:,:,jk,jpnch) + prorca6(:,:,jk) * ( 1.- excret ) - tortnch(:,:,jk)   & 
     187            &                                  - grazpch(:,:,jk) - graznch(:,:,jk)- respnch(:,:,jk) 
     188 
     189         ! Evolution of Diatoms 
     190         ! -------------------- 
     191         trn(:,:,jk,jpdia) = trn(:,:,jk,jpdia) + prorca2(:,:,jk) * ( 1.- excret2 ) - tortp2(:,:,jk)   & 
     192            &                                  - respp2 (:,:,jk) - grazd(:,:,jk)   - grazsd(:,:,jk) 
     193 
     194         trn(:,:,jk,jpdch) = trn(:,:,jk,jpdch) + prorca7(:,:,jk) * ( 1.- excret2 ) - tortdch(:,:,jk)   & 
     195            &                                  - respdch(:,:,jk) - grazdch(:,:,jk) - grazsch(:,:,jk) 
     196 
     197         ! Evolution of Zooplankton 
     198         ! ------------------------    
     199         trn(:,:,jk,jpzoo) = trn(:,:,jk,jpzoo) + epsher * ( grazp(:,:,jk) + grazm(:,:,jk) + grazsd(:,:,jk) )   & 
     200            &                                  - grazz(:,:,jk) - tortz(:,:,jk) - respz(:,:,jk) 
     201 
     202         ! Evolution of Mesozooplankton 
     203         ! ------------------------ 
     204         trn(:,:,jk,jpmes) = trn(:,:,jk,jpmes) + epsher2 * (  grazd  (:,:,jk) + grazz  (:,:,jk) + grazn(:,:,jk)   & 
     205            &                                               + grazpoc(:,:,jk) + grazffe(:,:,jk)  )                & 
     206            &                                  - tortz2(:,:,jk) - respz2(:,:,jk) 
     207     
     208         ! Evolution of O2 
     209         ! ---------------      
     210         trn(:,:,jk,jpoxy) = trn(:,:,jk,jpoxy) + o2ut * (  proreg(:,:,jk) + proreg2(:,:,jk) - olimi(:,:,jk)        & 
     211            &                                             -grarem(:,:,jk) * sigma1 - grarem2(:,:,jk) * sigma2  )   & 
     212            &                                  + ( o2ut + o2nit ) * ( pronew(:,:,jk) + pronew2(:,:,jk) )           & 
     213            &                                  - o2nit * onitr(:,:,jk) 
     214 
     215         ! Evolution of IRON 
     216         ! ----------------- 
     217         trn(:,:,jk,jpfer) = trn(:,:,jk,jpfer) + ( excret  - 1.) * prorca5(:,:,jk) - xaggdfe (:,:,jk)   & 
     218            &                                  + ( excret2 - 1.) * prorca4(:,:,jk) - xbactfer(:,:,jk)   & 
     219            &                                  + grafer(:,:,jk) + grafer2(:,:,jk)                       & 
     220            &                                  + ofer  (:,:,jk) - xscave (:,:,jk) 
     221         ! 
     222      END DO 
     223 
     224 
     225#if defined key_kriest 
     226 
     227#include "p4zbio_kriest.h90" 
    81228 
    82229#else 
    83          zdenom=1./(trn(ji,jj,jk,jppoc) 
    84      $     +trn(ji,jj,jk,jpdsi)+trn(ji,jj,jk,jpcal)+rtrn) 
    85          zdenom1(ji,jj,jk)=trn(ji,jj,jk,jppoc)*zdenom 
     230 
     231#include "p4zbio_std.h90" 
    86232 
    87233#endif 
    88            END DO 
    89          END DO 
    90        END DO 
    91 C 
    92 C     Compute the fraction of nanophytoplankton that is made 
    93 C     of calcifiers 
    94 C     ------------------------------------------------------ 
    95 C 
    96        DO jk=1,jpkm1 
    97          DO jj=1,jpj 
    98            DO ji=1,jpi 
    99        ztemp=max(0.,tn(ji,jj,jk)) 
    100        zfracal(ji,jj,jk)=caco3r*xlimphy(ji,jj,jk)*max(0.0001 
    101      &   ,ztemp/(2.+ztemp))*max(1.,trn(ji,jj,jk,jpphy)*1E6/2.) 
    102        zfracal(ji,jj,jk)=min(0.8,zfracal(ji,jj,jk)) 
    103        zfracal(ji,jj,jk)=max(0.01,zfracal(ji,jj,jk)) 
    104            END DO 
    105          END DO 
    106        END DO 
    107  
    108 C 
    109 C     Call subroutine for computation of the vertical flux 
    110 C     of particulate organic matter 
    111 C     ---------------------------------------------------- 
    112 C 
    113       CALL p4zsink 
    114  
    115 C 
    116 C  Call optical routine to compute the PAR in the water column 
    117 C  ----------------------------------------------------------- 
    118 C 
    119       CALL p4zopt 
    120 C 
    121 C  Call routine to compute the co-limitations by the various 
    122 C  nutrients 
    123 C  --------------------------------------------------------- 
    124 C 
    125       CALL p4zlim 
    126 C 
    127 C  Call production routine to compute phytoplankton growth rate 
    128 C  over the global ocean. Growth rates for each element is  
    129 C  computed (C, Si, Fe, Chl) 
    130 C  ------------------------------------------------------------ 
    131 C 
    132       CALL p4zprod 
    133 C 
    134 C  Call phytoplankton mortality routines. Mortality losses for  
    135 C  Each elements are computed (C, Fe, Si, Chl) 
    136 C  ----------------------------------------------------------- 
    137 C 
    138       CALL p4znano 
    139       CALL p4zdiat 
    140 C 
    141 C  Call zooplankton sources/sinks routines.  
    142 C  Each elements are computed (C, Fe, Si, Chl) 
    143 C  ----------------------------------------------------------- 
    144 C 
    145       CALL p4zmicro 
    146       CALL p4zmeso 
    147  
    148 C  
    149 C     Call subroutine for computation of remineralization 
    150 C     terms of organic matter+scavenging of Fe 
    151 C     ---------------------------------------------------- 
    152       CALL p4zrem 
    153 C      
    154 C     Determination of tracers concentration as a function of  
    155 C     biological sources and sinks 
    156 C     -------------------------------------------------------- 
    157 C      
    158       DO jk = 1,jpkm1 
    159         DO jj = 1,jpj 
    160           DO ji = 1,jpi 
    161 C      
    162 C     Evolution of PO4 
    163 C     ---------------- 
    164 C      
    165           trn(ji,jj,jk,jppo4) = trn(ji,jj,jk,jppo4) 
    166      &      -prorca(ji,jj,jk)-prorca2(ji,jj,jk) 
    167      &      +olimi(ji,jj,jk)+grarem(ji,jj,jk)*sigma1+denitr(ji,jj,jk) 
    168      &      +grarem2(ji,jj,jk)*sigma2 
    169 C 
    170 C     Evolution of NO3 and NH4 
    171 C     ------------------------ 
    172 C 
    173           trn(ji,jj,jk,jpno3) = trn(ji,jj,jk,jpno3) 
    174      &      -pronew(ji,jj,jk)-pronew2(ji,jj,jk)+onitr(ji,jj,jk) 
    175      &      -denitr(ji,jj,jk)*rdenit 
    176  
    177           trn(ji,jj,jk,jpnh4) = trn(ji,jj,jk,jpnh4) 
    178      &      -proreg(ji,jj,jk)-proreg2(ji,jj,jk)+olimi(ji,jj,jk) 
    179      &      +grarem(ji,jj,jk)*sigma1+grarem2(ji,jj,jk)*sigma2 
    180      &      -onitr(ji,jj,jk)+denitr(ji,jj,jk) 
    181  
    182           END DO 
    183         END DO 
    184       END DO 
    185  
    186       DO jk = 1,jpkm1 
    187         DO jj = 1,jpj 
    188           DO ji = 1,jpi 
    189  
    190 C     
    191 C     Evolution of Phytoplankton 
    192 C     -------------------------- 
    193 C      
    194           trn(ji,jj,jk,jpphy) = trn(ji,jj,jk,jpphy) 
    195      &      +prorca(ji,jj,jk)*(1.-excret)-tortp(ji,jj,jk) 
    196      &      -grazp(ji,jj,jk)-grazn(ji,jj,jk)-respp(ji,jj,jk) 
    197  
    198           trn(ji,jj,jk,jpnch) = trn(ji,jj,jk,jpnch) 
    199      &      +prorca6(ji,jj,jk)*(1.-excret)-tortnch(ji,jj,jk) 
    200      &      -grazpch(ji,jj,jk)-graznch(ji,jj,jk)-respnch(ji,jj,jk) 
    201 C 
    202 C     Evolution of Diatoms 
    203 C     ------------------ 
    204 C 
    205           trn(ji,jj,jk,jpdia) = trn(ji,jj,jk,jpdia) 
    206      &      +prorca2(ji,jj,jk)*(1.-excret2)-tortp2(ji,jj,jk) 
    207      &      -respp2(ji,jj,jk)-grazd(ji,jj,jk)-grazsd(ji,jj,jk) 
    208  
    209           trn(ji,jj,jk,jpdch) = trn(ji,jj,jk,jpdch) 
    210      &      +prorca7(ji,jj,jk)*(1.-excret2)-tortdch(ji,jj,jk) 
    211      &      -respdch(ji,jj,jk)-grazdch(ji,jj,jk)-grazsch(ji,jj,jk) 
    212           END DO 
    213         END DO 
    214       END DO 
    215  
    216       DO jk = 1,jpkm1 
    217         DO jj = 1,jpj 
    218           DO ji = 1,jpi 
    219 C     
    220 C     Evolution of Zooplankton 
    221 C     ------------------------ 
    222 C      
    223           trn(ji,jj,jk,jpzoo) = trn(ji,jj,jk,jpzoo) 
    224      &      +epsher*(grazp(ji,jj,jk)+grazm(ji,jj,jk)+grazsd(ji,jj,jk)) 
    225      &      -grazz(ji,jj,jk)-tortz(ji,jj,jk)-respz(ji,jj,jk) 
    226 C 
    227 C     Evolution of Mesozooplankton 
    228 C     ------------------------ 
    229 C 
    230           trn(ji,jj,jk,jpmes) = trn(ji,jj,jk,jpmes) 
    231      &      +epsher2*(grazd(ji,jj,jk)+grazz(ji,jj,jk)+grazn(ji,jj,jk) 
    232      &      +grazpoc(ji,jj,jk)+grazffe(ji,jj,jk))-tortz2(ji,jj,jk) 
    233      &      -respz2(ji,jj,jk) 
    234           END DO 
    235         END DO 
    236       END DO 
    237  
    238  
    239       DO jk = 1,jpkm1 
    240         DO jj = 1,jpj 
    241           DO ji = 1,jpi 
    242 C     
    243 C     Evolution of O2 
    244 C     --------------- 
    245 C      
    246          trn(ji,jj,jk,jpoxy) = trn(ji,jj,jk,jpoxy) 
    247      &     +o2ut*(proreg(ji,jj,jk)+proreg2(ji,jj,jk)-olimi(ji,jj,jk) 
    248      &     -grarem(ji,jj,jk)*sigma1-grarem2(ji,jj,jk)*sigma2) 
    249      &     +(o2ut+o2nit)*( pronew(ji,jj,jk)+pronew2(ji,jj,jk)) 
    250      &     -o2nit*onitr(ji,jj,jk) 
    251 C 
    252           END DO 
    253         END DO 
    254       END DO 
    255  
    256  
    257       DO jk = 1,jpkm1 
    258         DO jj = 1,jpj 
    259           DO ji = 1,jpi 
    260 C 
    261 C     Evolution of IRON 
    262 C     ----------------- 
    263 C 
    264           trn(ji,jj,jk,jpfer) = trn(ji,jj,jk,jpfer) 
    265      &      +(excret-1.)*prorca5(ji,jj,jk)-xaggdfe(ji,jj,jk) 
    266      &      +(excret2-1.)*prorca4(ji,jj,jk)-xbactfer(ji,jj,jk) 
    267      &      +grafer(ji,jj,jk)+grafer2(ji,jj,jk) 
    268      &      +ofer(ji,jj,jk)-xscave(ji,jj,jk) 
    269 C 
    270           END DO 
    271         END DO 
    272       END DO 
    273  
    274  
    275 #if defined key_kriest 
    276  
    277 #include "p4zbio.kriest.h" 
     234 
     235 
     236      DO jk = 1, jpkm1 
     237 
     238         ! Evolution of biogenic Silica 
     239         ! ---------------------------- 
     240         trn(:,:,jk,jpbsi) = trn(:,:,jk,jpbsi) + prorca3(:,:,jk) * ( 1.- excret2 ) - grazss(:,:,jk)   & 
     241            &                                  - tortds (:,:,jk) - respds(:,:,jk)  - grazs (:,:,jk) 
     242 
     243         ! Evolution of sinking biogenic silica 
     244         ! ------------------------------------ 
     245         trn(:,:,jk,jpdsi) = trn(:,:,jk,jpdsi) + tortds (:,:,jk) + respds(:,:,jk)  + grazs(:,:,jk)   & 
     246            &                                  - osil   (:,:,jk) + grazss(:,:,jk) 
     247 
     248         ! Evolution of biogenic diatom Iron 
     249         ! --------------------------------- 
     250         trn(:,:,jk,jpdfe) = trn(:,:,jk,jpdfe) + prorca4(:,:,jk) * ( 1.- excret2 ) - grazsf(:,:,jk)   & 
     251            &                                  - tortdf (:,:,jk) - respdf(:,:,jk)  - grazf (:,:,jk) 
     252 
     253         ! Evolution of biogenic nanophytoplankton Iron 
     254         ! -------------------------------------------- 
     255         trn(:,:,jk,jpnfe) = trn(:,:,jk,jpnfe) + prorca5(:,:,jk) * ( 1.- excret )  - graznf(:,:,jk)   & 
     256            &                                  - tortnf (:,:,jk) - respnf(:,:,jk)  - grazpf(:,:,jk) 
     257 
     258         ! Evolution of dissolved Silica 
     259         ! ----------------------------- 
     260         trn(:,:,jk,jpsil) = trn(:,:,jk,jpsil) - ( 1.- excret2 ) * prorca3(:,:,jk) + osil(:,:,jk) 
     261 
     262      END DO 
     263      
     264      ! Evolution of calcite and silicates as a function of the two tracers 
     265      ! -------------------------------------------------------------------      
     266      DO jk = 1, jpkm1 
     267         DO jj = 1, jpj 
     268            DO ji = 1, jpi 
     269 
     270               zprodt  = prorca(ji,jj,jk) + prorca2(ji,jj,jk) - olimi(ji,jj,jk) - grarem(ji,jj,jk) * sigma1   & 
     271                  &                       - grarem2(ji,jj,jk) * sigma2 - denitr(ji,jj,jk) 
     272               zprodca = pronew(ji,jj,jk) + pronew2(ji,jj,jk) - onitr(ji,jj,jk) + rdenit * denitr(ji,jj,jk) 
     273     
     274               ! potential production of calcite and biogenic silicate 
     275               ! ------------------------------------------------------      
     276               prcaca(ji,jj,jk) = zfracal(ji,jj,jk)   & 
     277                  &             * (  part * (  unass*grazp(ji,jj,jk) + unass2*grazn(ji,jj,jk)  )   & 
     278                  &                + tortp(ji,jj,jk) + respp(ji,jj,jk)  ) 
     279 
     280               ! Consumption of Total (12C)O2 
     281               ! ----------------------------      
     282               trn(ji,jj,jk,jpdic) = trn(ji,jj,jk,jpdic) - zprodt - prcaca(ji,jj,jk) 
     283 
     284               ! Consumption of alkalinity due to ca++ uptake and increase of 
     285               !  alkalinity due to nitrate consumption during organic soft tissue production 
     286               ! ---------------------------------------------------------   
     287               trn(ji,jj,jk,jptal) = trn(ji,jj,jk,jptal) + rno3 * zprodca - 2.* prcaca(ji,jj,jk) 
     288               ! 
     289            END DO 
     290         END DO 
     291      END DO 
     292 
     293 
     294      ! Production of calcite due to biological production 
     295      ! --------------------------------------------------    
     296      DO jk = 1, jpkm1 
     297         trn(:,:,jk,jpcal) = trn(:,:,jk,jpcal) + prcaca(:,:,jk) 
     298      END DO 
     299 
     300 
     301      ! Loop to test if tracers concentrations fall below 0. 
     302      ! ---------------------------------------------------- 
     303 
     304      znegtr(:,:,:) = 1.e0 
     305      DO jn = 1, jptra 
     306         DO jk = 1, jpk 
     307            DO jj = 1, jpj 
     308               DO ji = 1, jpi 
     309                  IF( trn(ji,jj,jk,jn) < 0.e0 )   znegtr(ji,jj,jk) = 0.e0 
     310               END DO 
     311            END DO 
     312         END DO 
     313      END DO 
     314      !                                ! where at least 1 tracer concentration becomes negative 
     315      !                                ! all tracer tendancy are set to zero (i.e. trn = trb) 
     316      DO jn = 1, jptra 
     317         trn(:,:,:,jn) = trb(:,:,:,jn) + znegtr(:,:,:) * ( trn(:,:,:,jn) - trb(:,:,:,jn) ) 
     318      END DO 
     319 
     320# if defined key_trc_dia3d 
     321!!gm potential bug  hard coded index on trc3d 
     322          trc3d(:,:,:, 4) = etot(:,:,:) 
     323          trc3d(:,:,:, 5) = prorca (:,:,:) * znegtr(:,:,:) * 1.e3 * rfact2r 
     324          trc3d(:,:,:, 6) = prorca2(:,:,:) * znegtr(:,:,:) * 1.e3 * rfact2r 
     325          trc3d(:,:,:, 7) = pronew (:,:,:) * znegtr(:,:,:) * 1.e3 * rfact2r 
     326          trc3d(:,:,:, 8) = pronew2(:,:,:) * znegtr(:,:,:) * 1.e3 * rfact2r 
     327          trc3d(:,:,:, 9) = prorca3(:,:,:) * znegtr(:,:,:) * 1.e3 * rfact2r 
     328          trc3d(:,:,:,10) = prorca4(:,:,:) * znegtr(:,:,:) * 1.e3 * rfact2r 
     329#  if ! defined key_kriest 
     330          trc3d(:,:,:,11) = prorca5(:,:,:) * znegtr(:,:,:) * 1.e3 * rfact2r 
     331#  else 
     332          trc3d(:,:,:,11) = prcaca (:,:,:) * znegtr(:,:,:) * 1.e3 * rfact2r 
     333#  endif 
     334# endif 
     335      ! 
     336   END SUBROUTINE p4z_bio 
    278337 
    279338#else 
    280  
    281 #include "p4zbio.std.h" 
    282  
    283 #endif 
    284  
    285  
    286  
    287       DO jk = 1,jpkm1 
    288         DO jj = 1,jpj 
    289           DO ji = 1,jpi 
    290 C 
    291 C     Evolution of biogenic Silica 
    292 C     ---------------------------- 
    293 C 
    294           trn(ji,jj,jk,jpbsi) = trn(ji,jj,jk,jpbsi) 
    295      &      +prorca3(ji,jj,jk)*(1.-excret2)-grazss(ji,jj,jk) 
    296      &      -tortds(ji,jj,jk)-respds(ji,jj,jk)-grazs(ji,jj,jk) 
    297 C 
    298           END DO 
    299         END DO 
    300       END DO 
    301  
    302       DO jk = 1,jpkm1 
    303         DO jj = 1,jpj 
    304           DO ji = 1,jpi 
    305 C 
    306 C     Evolution of sinking biogenic silica 
    307 C     ------------------------------------ 
    308 C 
    309           trn(ji,jj,jk,jpdsi)=trn(ji,jj,jk,jpdsi) 
    310      &      +tortds(ji,jj,jk)+respds(ji,jj,jk)+grazs(ji,jj,jk) 
    311      &      -osil(ji,jj,jk)+grazss(ji,jj,jk) 
    312 C 
    313           END DO 
    314         END DO 
    315       END DO 
    316  
    317       DO jk = 1,jpkm1 
    318         DO jj = 1,jpj 
    319           DO ji = 1,jpi 
    320 C 
    321 C     Evolution of biogenic diatom Iron 
    322 C     --------------------------------- 
    323 C 
    324           trn(ji,jj,jk,jpdfe) = trn(ji,jj,jk,jpdfe) 
    325      &      +prorca4(ji,jj,jk)*(1.-excret2)-grazsf(ji,jj,jk) 
    326      &      -tortdf(ji,jj,jk)-respdf(ji,jj,jk)-grazf(ji,jj,jk) 
    327 C 
    328 C     Evolution of biogenic nanophytoplankton Iron 
    329 C     -------------------------------------------- 
    330 C 
    331           trn(ji,jj,jk,jpnfe) = trn(ji,jj,jk,jpnfe) 
    332      &      +prorca5(ji,jj,jk)*(1.-excret)-graznf(ji,jj,jk) 
    333      &      -tortnf(ji,jj,jk)-respnf(ji,jj,jk)-grazpf(ji,jj,jk) 
    334 C 
    335 C     Evolution of dissolved Silica 
    336 C     ----------------------------- 
    337 C 
    338           trn(ji,jj,jk,jpsil) = trn(ji,jj,jk,jpsil) 
    339      &      -(1.-excret2)*prorca3(ji,jj,jk)+osil(ji,jj,jk) 
    340 C 
    341           END DO 
    342         END DO 
    343       END DO 
    344 C      
    345 C     Evolution of calcite and silicates as a function of the two tracers 
    346 C     ------------------------------------------------------------------- 
    347 C      
    348       DO  jk = 1,jpkm1 
    349         DO  jj = 1,jpj 
    350           DO  ji = 1,jpi 
    351 C 
    352           prodt = prorca(ji,jj,jk)+prorca2(ji,jj,jk) 
    353      &      -olimi(ji,jj,jk)-grarem(ji,jj,jk)*sigma1 
    354      &      -grarem2(ji,jj,jk)*sigma2-denitr(ji,jj,jk) 
    355  
    356           prodca = pronew(ji,jj,jk)+pronew2(ji,jj,jk) 
    357      &      -onitr(ji,jj,jk)+rdenit*denitr(ji,jj,jk) 
    358 C      
    359 C     potential production of calcite and biogenic silicate 
    360 C     ------------------------------------------------------ 
    361 C      
    362           prcaca(ji,jj,jk)= 
    363      &      zfracal(ji,jj,jk)*(part*(unass*grazp(ji,jj,jk)+ 
    364      &      unass2*grazn(ji,jj,jk))+tortp(ji,jj,jk)+respp(ji,jj,jk)) 
    365 C      
    366 C     Consumption of Total (12C)O2 
    367 C     ---------------------------- 
    368 C      
    369           trn(ji,jj,jk,jpdic) = trn(ji,jj,jk,jpdic) 
    370      &      -prodt-prcaca(ji,jj,jk) 
    371 C      
    372 C     Consumption of alkalinity due to ca++ uptake and increase  
    373 C     of alkalinity due to nitrate consumption during organic  
    374 C     soft tissue production 
    375 C     --------------------------------------------------------- 
    376 C      
    377           trn(ji,jj,jk,jptal) = trn(ji,jj,jk,jptal) 
    378      &      +rno3*prodca-2.*prcaca(ji,jj,jk) 
    379           END DO 
    380         END DO 
    381       END DO 
    382 C 
    383       DO  jk = 1,jpkm1 
    384         DO  jj = 1,jpj 
    385           DO  ji = 1,jpi 
    386 C 
    387 C     Production of calcite due to biological production 
    388 C     -------------------------------------------------- 
    389 C      
    390            trn(ji,jj,jk,jpcal) = trn(ji,jj,jk,jpcal) 
    391      &        +prcaca(ji,jj,jk) 
    392           END DO 
    393         END DO 
    394       ENDDO 
    395 C 
    396 C 
    397 C     Loop to test if tracers concentrations fall below 0. 
    398 C     ---------------------------------------------------- 
    399 C 
    400 C 
    401       znegtr(:,:,:) = 1. 
    402 C 
    403       DO jn = 1,jptra 
    404         DO jk = 1,jpk 
    405           DO jj = 1,jpj 
    406             DO ji = 1,jpi 
    407               if (trn(ji,jj,jk,jn).lt.0.) then 
    408                znegtr(ji,jj,jk)=0. 
    409               endif 
    410             END DO 
    411           END DO 
    412         END DO 
    413       END DO 
    414 C 
    415       DO jn = 1,jptra 
    416          trn(:,:,:,jn) = trb(:,:,:,jn)+ 
    417      &     znegtr(:,:,:)*(trn(:,:,:,jn)-trb(:,:,:,jn)) 
    418       END DO 
    419 C 
    420 #    if defined key_trc_dia3d 
    421           trc3d(:,:,:,4)=etot(:,:,:) 
    422           trc3d(:,:,:,5)=prorca(:,:,:)*znegtr(:,:,:)*1e3*rfact2r 
    423           trc3d(:,:,:,6)=prorca2(:,:,:)*znegtr(:,:,:)*1e3*rfact2r 
    424           trc3d(:,:,:,7)=pronew(:,:,:)*znegtr(:,:,:)*1e3*rfact2r 
    425           trc3d(:,:,:,8)=pronew2(:,:,:)*znegtr(:,:,:)*1e3*rfact2r 
    426           trc3d(:,:,:,9)=prorca3(:,:,:)*znegtr(:,:,:)*1e3*rfact2r 
    427           trc3d(:,:,:,10)=prorca4(:,:,:)*znegtr(:,:,:)*1e3*rfact2r 
    428 #if ! defined key_kriest 
    429           trc3d(:,:,:,11)=prorca5(:,:,:)*znegtr(:,:,:)*1e3*rfact2r 
    430 #else 
    431           trc3d(:,:,:,11)=prcaca(:,:,:)*znegtr(:,:,:)*1e3*rfact2r 
    432 #endif 
    433 #    endif 
    434 C      
    435 #endif 
    436 C      
    437       RETURN 
    438       END 
     339   !!====================================================================== 
     340   !!  Dummy module :                                   No PISCES bio-model 
     341   !!====================================================================== 
     342CONTAINS 
     343   SUBROUTINE p4z_bio                         ! Empty routine 
     344   END SUBROUTINE p4z_bio 
     345#endif  
     346 
     347   !!====================================================================== 
     348END MODULE  p4zbio 
Note: See TracChangeset for help on using the changeset viewer.