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 858 for branches/dev_001_GM – NEMO

Changeset 858 for branches/dev_001_GM


Ignore:
Timestamp:
2008-03-13T15:17:04+01:00 (16 years ago)
Author:
cetlod
Message:

include the new version of PISCES model , see ticket:91

Location:
branches/dev_001_GM/NEMO/TOP_SRC/PISCES
Files:
20 edited

Legend:

Unmodified
Added
Removed

  • branches/dev_001_GM/NEMO/TOP_SRC/PISCES/p4zbio.F90

    r775 r858  
    2727   USE p4zmeso         !  
    2828   USE p4zrem          !  
     29   USE prtctl_trc 
    2930    
    3031   IMPLICIT NONE 
    … …  
    4344CONTAINS 
    4445 
    45    SUBROUTINE p4z_bio 
     46   SUBROUTINE p4z_bio ( kt ) 
    4647      !!--------------------------------------------------------------------- 
    4748      !!                     ***  ROUTINE p4z_bio  *** 
    … …  
    5354      !! ** Method  : - ??? 
    5455      !!--------------------------------------------------------------------- 
     56      INTEGER, INTENT(in) :: kt 
    5557      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 
     58      CHARACTER (len=25) :: charout 
     59 
    6560      !!--------------------------------------------------------------------- 
    6661 
    … …  
    6863      !     OF PHYTOPLANKTON AND DETRITUS 
    6964 
    70       zdiss(:,:,:) = 0.01 
     65      xdiss(:,:,:) = 0.01 
    7166 
    7267!!gm the use of nmld should be better here? 
    … …  
    7469         DO jj = 1, jpj 
    7570            DO ji = 1, jpi 
    76                IF( fsdepw(ji,jj,jk+1) .le. hmld(ji,jj) )   zdiss(ji,jj,jk) = 1.e0 
     71               IF( fsdepw(ji,jj,jk+1) .le. hmld(ji,jj) )   xdiss(ji,jj,jk) = 1.e0 
    7772            END DO  
    7873         END DO 
    7974      END DO 
    8075 
    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 
    87 #if ! defined key_kriest 
    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 
    92 #else 
    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 
    96 #endif 
    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 
    11676 
    11777      ! computation of the vertical flux of particulate organic matter 
    … …  
    12282      ENDIF 
    12383 
     84 
    12485      ! compute the PAR in the water column 
    12586      ! ----------------------------------- 
    12687 
    12788      CALL p4z_opt       ! Optical  
     89 
     90 
    12891 
    12992      ! compute the co-limitations by the various nutrients 
    … …  
    13295      CALL p4z_lim 
    13396 
     97 
    13498      ! compute phytoplankton growth rate over the global ocean.  
    13599      ! ------------------------------------------------------- 
    136100      ! (Growth rates for each element is computed (C, Si, Fe, Chl)) 
    137101 
    138       CALL p4z_prod 
     102      CALL p4z_prod ( kt ) 
     103 
     104 
    139105 
    140106      ! phytoplankton mortality (Mortality losses for each elements are computed (C, Fe, Si, Chl) ) 
    … …  
    143109      CALL p4z_nano       ! nanophytoplankton 
    144110       
     111 
    145112      CALL p4z_diat       ! diatoms 
     113 
    146114 
    147115      ! zooplankton sources/sinks routines (each elements are computed (C, Fe, Si, Chl) ) 
    … …  
    149117 
    150118      CALL p4z_micro      ! microzooplankton 
     119 
    151120       
    152121      CALL p4z_meso       ! mesozooplankton 
     122 
    153123 
    154124      ! computation of remineralization terms of organic matter + scavenging of Fe 
    … …  
    158128 
    159129 
    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" 
    228  
    229 #else 
    230  
    231 #include "p4zbio_std.h90" 
    232  
    233 #endif 
    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  
    301130      ! Loop to test if tracers concentrations fall below 0. 
    302131      ! ---------------------------------------------------- 
    303132 
    304       znegtr(:,:,:) = 1.e0 
    305       DO jn = 1, jptra 
     133      xnegtr(:,:,:) = 1.e0 
     134      DO jn = jp_pcs0, jp_pcs1 
    306135         DO jk = 1, jpk 
    307136            DO jj = 1, jpj 
    308137               DO ji = 1, jpi 
    309                   IF( trn(ji,jj,jk,jn) < 0.e0 )   znegtr(ji,jj,jk) = 0.e0 
     138                  IF( ( trn(ji,jj,jk,jn) + tra(ji,jj,jk,jn) ) < 0.e0 )   & 
     139             &      xnegtr(ji,jj,jk) = 0.e0 
    310140               END DO 
    311141            END DO 
    … …  
    314144      !                                ! where at least 1 tracer concentration becomes negative 
    315145      !                                ! 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) ) 
     146      DO jn = jp_pcs0, jp_pcs1 
     147         trn(:,:,:,jn) = trn(:,:,:,jn) + xnegtr(:,:,:) * tra(:,:,:,jn) 
    318148      END DO 
    319149 
    320 # if defined key_trc_dia3d 
     150 
     151      tra(:,:,:,:) = 0.0 
     152 
     153#if defined key_kriest 
     154        DO jk = 1,jpkm1 
     155           DO jj = 1,jpj 
     156              DO ji = 1,jpi 
     157                 trn(ji,jj,jk,jpnum) = MAX( trn(ji,jj,jk,jpnum),  & 
     158     &                                      trn(ji,jj,jk,jppoc) / xkr_massp / xnumm(jk) ) 
     159 
     160                 trn(ji,jj,jk,jpnum) = MIN( trn(ji,jj,jk,jpnum),  & 
     161     &                                      trn(ji,jj,jk,jppoc) / xkr_massp / 1.1 ) 
     162 
     163          END DO 
     164        END DO 
     165      END DO 
     166#endif 
     167 
     168 
     169# if defined key_trc_dia3d && defined key_kriest 
    321170!!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 
     171     trc3d(:,:,:,11) = tra(:,:,:,jpcal) * xnegtr(:,:,:) * 1.e3 * rfact2r 
    334172# endif 
    335173      ! 
     174       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     175         WRITE(charout, FMT="('bio ')") 
     176         CALL prt_ctl_trc_info(charout) 
     177         CALL prt_ctl_trc(tab4d=trn, mask=tmask, clinfo=ctrcnm) 
     178       ENDIF 
     179 
    336180   END SUBROUTINE p4z_bio 
    337181 

  • branches/dev_001_GM/NEMO/TOP_SRC/PISCES/p4zche.F90

    r775 r858  
    2525 
    2626   PUBLIC   p4z_che    ! called in p4zprg.F90 
     27 
     28   !! * Module variables 
     29 
     30   REAL(wp) :: & 
     31      salchl = 1./1.80655 ! conversion factor for salinity --> chlorinity (Wooster et al. 1969) 
     32 
     33   REAL(wp) :: &            ! coeff. for apparent solubility equilibrium  
     34      akcc1 = -171.9065 , &    ! Millero et al. 1995 from Mucci 1983 
     35      akcc2 = -0.077993 , &   
     36      akcc3 = 2839.319  , &   
     37      akcc4 = 71.595    , &   
     38      akcc5 = -0.77712  , &   
     39      akcc6 = 0.0028426 , &   
     40      akcc7 = 178.34    , &   
     41      akcc8 = -0.07711  , &   
     42      akcc9 = 0.0041249 
     43 
     44 
     45   REAL(wp) :: &             ! universal gas constants 
     46      rgas = 83.143, & 
     47      oxyco = 1./22.4144 
     48 
     49   REAL(wp) :: &             ! borat constants 
     50      bor1 = 0.00023, & 
     51      bor2 = 1./10.82 
     52 
     53   REAL(wp) :: &              ! 
     54      ca0 = -162.8301  , & 
     55      ca1 = 218.2968   , & 
     56      ca2 = 90.9241    , & 
     57      ca3 = -1.47696   , & 
     58      ca4 = 0.025695   , & 
     59      ca5 = -0.025225  , & 
     60      ca6 = 0.0049867 
     61 
     62   REAL(wp) :: &              ! coeff. for 1. dissoc. of carbonic acid (Edmond and Gieskes, 1970)    
     63      c10 = -3670.7   , & 
     64      c11 = 62.008    , & 
     65      c12 = -9.7944   , & 
     66      c13 = 0.0118    , & 
     67      c14 = -0.000116 
     68 
     69   REAL(wp) :: &              ! coeff. for 2. dissoc. of carbonic acid (Millero, 1995)    
     70      c20 = -1394.7   , & 
     71      c21 = -4.777    , & 
     72      c22 = 0.0184    , & 
     73      c23 = -0.000118 
     74 
     75   REAL(wp) :: &             ! constants for calculate concentrations  
     76      st1  = 0.14     , &    ! for sulfate (Morris & Riley 1966) 
     77      st2  = 1./96.062, & 
     78      ks0  = 141.328  , & 
     79      ks1  = -4276.1  , & 
     80      ks2  = -23.093  , & 
     81      ks3  = -13856.  , & 
     82      ks4  = 324.57   , & 
     83      ks5  = -47.986  , & 
     84      ks6  = 35474.   , & 
     85      ks7  = -771.54  , & 
     86      ks8  = 114.723  , & 
     87      ks9  = -2698.   , & 
     88      ks10 = 1776.    , & 
     89      ks11 = 1.       , & 
     90      ks12 = -0.001005  
     91 
     92   REAL(wp) :: &             ! constants for calculate concentrations  
     93      ft1  = 0.000067   , &  ! fluorides (Dickson & Riley 1979 ) 
     94      ft2  = 1./18.9984 , & 
     95      kf0  = -12.641    , & 
     96      kf1  = 1590.2     , & 
     97      kf2  = 1.525      , & 
     98      kf3  = 1.0        , & 
     99      kf4  =-0.001005 
     100 
     101 
     102   REAL(wp) :: &              ! coeff. for 1. dissoc. of boric acid (Dickson and Goyet, 1994) 
     103      cb0  = -8966.90, & 
     104      cb1  = -2890.53, & 
     105      cb2  = -77.942 , & 
     106      cb3  = 1.728   , & 
     107      cb4  = -0.0996 , & 
     108      cb5  = 148.0248, & 
     109      cb6  = 137.1942, & 
     110      cb7  = 1.62142 , & 
     111      cb8  = -24.4344, & 
     112      cb9  = -25.085 , & 
     113      cb10 = -0.2474 , & 
     114      cb11 = 0.053105 
     115 
     116   REAL(wp) :: &             ! coeff. for dissoc. of water (Dickson and Riley, 1979 ) 
     117      cw0 = -13847.26  , & 
     118      cw1 = 148.9652   , & 
     119      cw2 = -23.6521   , & 
     120      cw3 = 118.67     , & 
     121      cw4 = -5.977     , & 
     122      cw5 = 1.0495     , & 
     123      cw6 = -0.01615 
     124  
     125   REAL(wp) :: &             ! coeff. for dissoc. of phosphate (Millero (1974) 
     126      cp10 = 115.54    , & 
     127      cp11 = -4576.752 , & 
     128      cp12 = -18.453   , & 
     129      cp13 = -106.736  , & 
     130      cp14 = 0.69171   , & 
     131      cp15 = -0.65643  , & 
     132      cp16 = -0.01844  , & 
     133      cp20 = 172.1033  , & 
     134      cp21 = -8814.715 , & 
     135      cp22 = -27.927   , & 
     136      cp23 = -160.340  , & 
     137      cp24 = 1.3566    , & 
     138      cp25 = 0.37335   , & 
     139      cp26 = -0.05778  , & 
     140      cp30 = -18.126   , & 
     141      cp31 = -3070.75  , & 
     142      cp32 = 17.27039  , & 
     143      cp33 = 2.81197   , & 
     144      cp34 = -44.99486 , & 
     145      cp35 = -0.09984 
     146 
     147   REAL(wp) :: &             ! coeff. for dissoc. of silicates (Millero (1974)   
     148      cs10 = 117.385   , &   
     149      cs11 = -8904.2   , &  
     150      cs12 = -19.334   , &  
     151      cs13 = -458.79   , &  
     152      cs14 = 3.5913    , &  
     153      cs15 = 188.74    , &  
     154      cs16 = -1.5998   , &  
     155      cs17 = -12.1652  , &  
     156      cs18 = 0.07871   , &  
     157      cs19 = 0.        , &  
     158      cs20 = 1.        , &  
     159      cs21 = -0.001005 
     160 
     161   REAL(wp) :: &              ! volumetric solubility constants for o2 in ml/l (Weiss, 1974) 
     162      ox0 = -58.3877   , & 
     163      ox1 = 85.8079    , & 
     164      ox2 = 23.8439    , & 
     165      ox3 = -0.034892  , & 
     166      ox4 = 0.015568   , & 
     167      ox5 = -0.0019387  
     168 
     169   REAL(wp), DIMENSION(5)  :: &  ! coeff. for seawater pressure correction  
     170      devk1, devk2, devk3,    &  ! (millero 95) 
     171      devk4, devk5 
     172 
     173   DATA devk1 / -25.5    , -15.82    , -29.48  , -25.60     , -48.76    /    
     174   DATA devk2 / 0.1271   , -0.0219   , 0.1622  , 0.2324     , 0.5304    /    
     175   DATA devk3 / 0.       , 0.        , 2.608E-3,  -3.6246E-3, 0.        /    
     176   DATA devk4 / -3.08E-3 , 1.13E-3   , -2.84E-3, -5.13E-3   , -11.76E-3 /    
     177   DATA devk5 / 0.0877E-3, -0.1475E-3,  0.     , 0.0794E-3  , 0.3692E-3 / 
    27178 
    28179   !!* Substitution 
    … …  
    46197      INTEGER  ::   ji, jj, jk 
    47198      REAL(wp) ::   ztkel, zsal , zqtt  , zbuf1 , zbuf2 
    48       REAL(wp) ::   zpres, ztc  , zcl   , zcpexp, zcek0, zoxy  , zcpexp2 
     199      REAL(wp) ::   zpres, ztc  , zcl   , zcpexp, zoxy  , zcpexp2 
    49200      REAL(wp) ::   zsqrt, ztr  , zlogt , zcek1 
    50201      REAL(wp) ::   zlqtt, zqtt2, zsal15, zis   , zis2 , zisqrt 
    51202      REAL(wp) ::   zckb , zck1 , zck2  , zckw  , zak1 , zak2  , zakb , zaksp0, zakw 
    52       REAL(wp) ::   zckp1, zckp2, zckp3 , zcksi , zakp1, zakp2 , zakp3, zaksi 
    53       REAL(wp) ::   zst  , zft  , zcks  , zckf  , zaks , zakf  , zaksp1 
     203      REAL(wp) ::   zst  , zft  , zcks  , zckf  , zaksp1 
    54204      !!--------------------------------------------------------------------- 
    55205 
    56206      ! CHEMICAL CONSTANTS - SURFACE LAYER 
    57207      ! ---------------------------------- 
    58  
     208!CDIR NOVERRCHK 
    59209      DO jj = 1, jpj 
     210!CDIR NOVERRCHK 
    60211         DO ji = 1, jpi 
    61212 
    … …  
    69220            !                             ! LN(K0) OF SOLUBILITY OF CO2 (EQ. 12, WEISS, 1980) 
    70221            !                             !     AND FOR THE ATMOSPHERE FOR NON IDEAL GAS 
    71             zcek0 = c00 + c01 / zqtt + c02 * zlqtt + zsal * ( c03 + c04 * zqtt + c05 * zqtt2 ) 
    72222            zcek1 = ca0 + ca1 / zqtt + ca2 * zlqtt + ca3 * zqtt2 + zsal*( ca4 + ca5 * zqtt + ca6 * zqtt2 ) 
    73223 
    … …  
    76226 
    77227            !                             ! SET SOLUBILITIES OF O2 AND CO2 
    78             chemc(ji,jj,1) = EXP( zcek0 ) * 1.e-6 * rhop(ji,jj,1) / 1000. 
     228            chemc(ji,jj,1) = EXP( zcek1 ) * 1.e-6 * rhop(ji,jj,1) / 1000. 
    79229            chemc(ji,jj,2) = EXP( zoxy  ) * oxyco 
    80             chemc(ji,jj,3) = EXP( zcek1 ) * 1.e-6 * rhop(ji,jj,1) / 1000. 
    81230 
    82231         END DO 
    … …  
    85234      ! CHEMICAL CONSTANTS - DEEP OCEAN 
    86235      ! ------------------------------- 
    87  
     236!CDIR NOVERRCHK 
    88237      DO jk = 1, jpk 
     238!CDIR NOVERRCHK 
    89239         DO jj = 1, jpj 
     240!CDIR NOVERRCHK 
    90241            DO ji = 1, jpi 
    91242 
    … …  
    136287               zckw    = cw0 * ztr + cw1 + cw2 * zlogt + ( cw3 * ztr + cw4 + cw5 * zlogt ) * zsqrt + cw6 * zsal 
    137288 
    138                ! DISSOCIATION CONSTANT FOR PHOSPHATE AND SILICATE (seawater scale) 
    139                zckp1 = cp10 + cp11 * ztr + cp12 * zlogt + zsqrt * ( cp13 * ztr + cp14 ) + zsal * ( cp15 * ztr + cp16 ) 
    140                zckp2 = cp20 + cp21 * ztr + cp22 * zlogt + zsqrt * ( cp23 * ztr + cp24 ) + zsal * ( cp25 * ztr + cp26 ) 
    141                zckp3 = cp30 + cp31 * ztr                + zsqrt * ( cp32 * ztr + cp33 ) + zsal * ( cp34 * ztr + cp35 ) 
    142                zcksi = cs10 + cs11 * ztr + cs12 * zlogt + zisqrt* ( cs13 * ztr + cs14 ) + zis * ( cs15 * ztr + cs16 )  & 
    143                   &                                    + zis2  * ( cs17 * ztr + cs18 ) + LOG( 1.   + cs19 * zsal )     & 
    144                   &                                                                    + LOG( cs20 + cs21 * zsal ) 
    145289 
    146290               ! APPARENT SOLUBILITY PRODUCT K'SP OF CALCITE IN SEAWATER 
    … …  
    153297               zak2    = 10**(zck2) 
    154298               zakb    = EXP( zckb  ) 
    155                zakp1   = EXP( zckp1 ) 
    156                zakp2   = EXP( zckp2 ) 
    157                zakp3   = EXP( zckp3 ) 
    158                zaksi   = EXP( zcksi ) 
    159299               zakw    = EXP( zckw ) 
    160300               zaksp1  = 10**(zaksp0) 
    161                zaks    = exp( zcks ) 
    162                zakf    = exp( zckf ) 
    163301 
    164302               ! FORMULA FOR CPEXP AFTER EDMOND & GIESKES (1970) 
    … …  
    178316               !        CORRECTION AFTER CULBERSON AND PYTKOWICZ (1968) 
    179317               !        (CF. BROECKER ET AL., 1982) 
     318 
     319               zbuf1  = -(devk1(1)+devk2(1)*ztc+devk3(1)*ztc*ztc) 
     320               zbuf2  = 0.5*(devk4(1)+devk5(1)*ztc) 
     321               ak13(ji,jj,jk) = zak1 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
     322 
     323               zbuf1  =     - ( devk1(2) + devk2(2) * ztc + devk3(2) * ztc * ztc ) 
     324               zbuf2  = 0.5 * ( devk4(2) + devk5(2) * ztc ) 
     325               ak23(ji,jj,jk) = zak2 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
     326 
    180327               zbuf1  =     - ( devk1(3) + devk2(3) * ztc + devk3(3) * ztc * ztc ) 
    181328               zbuf2  = 0.5 * ( devk4(3) + devk5(3) * ztc ) 
    182329               akb3(ji,jj,jk) = zakb * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
    183330 
    184                zbuf1  = -(devk1(1)+devk2(1)*ztc+devk3(1)*ztc*ztc) 
    185                zbuf2  = 0.5*(devk4(1)+devk5(1)*ztc) 
    186                ak13(ji,jj,jk) = zak1 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
    187  
    188                zbuf1  =     - ( devk1(2) + devk2(2) * ztc + devk3(2) * ztc * ztc ) 
    189                zbuf2  = 0.5 * ( devk4(2) + devk5(2) * ztc ) 
    190                ak23(ji,jj,jk) = zak2 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
    191  
    192331               zbuf1  =     - ( devk1(4) + devk2(4) * ztc + devk3(4) * ztc * ztc ) 
    193332               zbuf2  = 0.5 * ( devk4(4) + devk5(4) * ztc ) 
    194                akp13(ji,jj,jk) = zakp1 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
    195  
    196                zbuf1  =     - ( devk1(5) + devk2(5) * ztc + devk3(5) * ztc * ztc ) 
    197                zbuf2  = 0.5 * ( devk4(5) + devk5(5) * ztc ) 
    198                akp23(ji,jj,jk) = zakp2 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
    199  
    200                zbuf1  =     - ( devk1(6) + devk2(6) * ztc + devk3(6) * ztc * ztc ) 
    201                zbuf2  = 0.5 * ( devk4(6) + devk5(6) * ztc ) 
    202                akp33(ji,jj,jk) = zakp3 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
    203  
    204                zbuf1  =     - ( devk1(7) + devk2(7) * ztc + devk3(7) * ztc * ztc ) 
    205                zbuf2  = 0.5 * ( devk4(7) + devk5(7) * ztc ) 
    206333               akw3(ji,jj,jk) = zakw * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
    207334 
    208                !  Ksi 
    209                !            aksi3(ji,jj,jk) = zaksi 
    210                ! 
    211                !  Or using coefficient of borates (cf millero 95+ corrected version html doc co2sys) 
    212                !  "deltaVsi and deltaKsi have been estimated from the value of boric acid" 
    213                zbuf1  =     - ( devk1(3) + devk2(3) * ztc + devk3(3) * ztc * ztc ) 
    214                zbuf2  = 0.5 * ( devk4(3) + devk5(3) * ztc ) 
    215                aksi3(ji,jj,jk) = zaksi * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
    216335 
    217336               ! APPARENT SOLUBILITY PRODUCT K'SP OF CALCITE  
    218337               !        AS FUNCTION OF PRESSURE FOLLOWING MILLERO 
    219338               !        (P. 1285) AND BERNER (1976) 
    220                zbuf1  =     - ( devk1(8) + devk2(8) * ztc + devk3(8) * ztc * ztc ) 
    221                zbuf2  = 0.5 * ( devk4(8) + devk5(8) * ztc ) 
     339               zbuf1  =     - ( devk1(5) + devk2(5) * ztc + devk3(5) * ztc * ztc ) 
     340               zbuf2  = 0.5 * ( devk4(5) + devk5(5) * ztc ) 
    222341               aksp(ji,jj,jk) = zaksp1 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
    223342 
    224                !  Pressure correction for sulfate and fluoride 
    225                zbuf1  =     - ( devk1(9) + devk2(9) * ztc + devk3(9) * ztc * ztc ) 
    226                zbuf2  = 0.5 * ( devk4(9) + devk5(9) * ztc ) 
    227                aks3(ji,jj,jk) = zaks   * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
    228  
    229                zbuf1  =     - ( devk1(10) + devk2(10) * ztc + devk3(10) * ztc * ztc ) 
    230                zbuf2  = 0.5 * ( devk4(10) + devk5(10) * ztc ) 
    231                akf3(ji,jj,jk) = zakf   * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
    232343 
    233344               ! TOTAL BORATE CONCENTR. [MOLES/L] 

  • branches/dev_001_GM/NEMO/TOP_SRC/PISCES/p4zdiat.F90

    r775 r858  
    1616   USE trp_trc         !  
    1717   USE sms             !  
     18   USE prtctl_trc 
    1819 
    1920   IMPLICIT NONE 
    … …  
    4041      !! ** Method  : - ??? 
    4142      !!--------------------------------------------------------------------- 
    42       INTEGER  ::   ji, jj, jk 
    43       REAL(wp) ::   zfact, zstep, zcompadi 
     43      INTEGER  ::  ji, jj, jk 
     44      REAL(wp) ::  zfactfe,zfactsi,zfactch, zstep, zcompadi 
     45      REAL(wp) ::  zrespp2, ztortp2, zmortp2 
     46      CHARACTER (len=25) :: charout 
     47  
    4448      !!--------------------------------------------------------------------- 
    4549 
    … …  
    5761 
    5862               zcompadi = MAX( ( trn(ji,jj,jk,jpdia) - 1e-8), 0. ) 
    59                zfact    = 1. / ( trn(ji,jj,jk,jpdia) + rtrn ) 
    6063 
    6164!    Aggregation term for diatoms is increased in case of nutrient 
    … …  
    6467!     ------------------------------------------------------------ 
    6568 
    66                respp2 (ji,jj,jk) = 1.e6 * zstep * (  wchl + wchld * ( 1.- xlimdia(ji,jj,jk) )  )    & 
     69               zrespp2 = 1.e6 * zstep * (  wchl + wchld * ( 1.- xlimdia(ji,jj,jk) )  )    & 
    6770# if defined key_off_degrad 
    68                   &              * facvol(ji,jj,jk)       & 
     71                  &       * facvol(ji,jj,jk)       & 
    6972# endif 
    70                   &              * zdiss(ji,jj,jk) * zcompadi * trn(ji,jj,jk,jpdia) 
     73                  &       * xdiss(ji,jj,jk) * zcompadi * trn(ji,jj,jk,jpdia) 
    7174                                                                                
    72                respds (ji,jj,jk) = respp2(ji,jj,jk) * trn(ji,jj,jk,jpbsi) * zfact 
    73  
    74                respdf (ji,jj,jk) = respp2(ji,jj,jk) * trn(ji,jj,jk,jpdfe) * zfact 
    75                                                                                 
    76                respdch(ji,jj,jk) = respp2(ji,jj,jk) * trn(ji,jj,jk,jpdch) * zfact 
    7775 
    7876!     Phytoplankton mortality.  
    7977!     ------------------------ 
    80                tortp2 (ji,jj,jk) = mprat2 * zstep * trn(ji,jj,jk,jpdia)     & 
     78               ztortp2 = mprat2 * zstep * trn(ji,jj,jk,jpdia)     & 
    8179# if defined key_off_degrad 
    82                   &              * facvol(ji,jj,jk)       & 
     80                  &        * facvol(ji,jj,jk)       & 
    8381# endif 
    84                   &              / ( xkmort + trn(ji,jj,jk,jpdia) ) * zcompadi 
     82                  &      / ( xkmort + trn(ji,jj,jk,jpdia) ) * zcompadi 
    8583 
    86                tortds (ji,jj,jk) = tortp2(ji,jj,jk) * trn(ji,jj,jk,jpbsi) * zfact 
     84                zmortp2 = zrespp2 + ztortp2 
    8785 
    88                tortdf (ji,jj,jk) = tortp2(ji,jj,jk) * trn(ji,jj,jk,jpdfe) * zfact 
     86!   Update the arrays tra which contains the biological sources and sinks 
     87!   --------------------------------------------------------------------- 
     88               zfactch = trn(ji,jj,jk,jpdch) / ( trn(ji,jj,jk,jpdia) + rtrn ) 
     89               zfactfe = trn(ji,jj,jk,jpdfe) / ( trn(ji,jj,jk,jpdia) + rtrn ) 
     90               zfactsi = trn(ji,jj,jk,jpbsi) / ( trn(ji,jj,jk,jpdia) + rtrn ) 
    8991 
    90                tortdch(ji,jj,jk) = tortp2(ji,jj,jk) * trn(ji,jj,jk,jpdch) * zfact 
    91  
     92               tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zmortp2  
     93               tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zmortp2 * zfactch 
     94               tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zmortp2 * zfactfe 
     95               tra(ji,jj,jk,jpbsi) = tra(ji,jj,jk,jpbsi) - zmortp2 * zfactsi 
     96               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zmortp2 * zfactsi 
     97#if defined key_kriest 
     98               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortp2   
     99               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + ztortp2 * xkr_ndiat + zrespp2 * xkr_naggr 
     100               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zmortp2 * zfactfe 
     101#else 
     102               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zrespp2 + 0.5 * ztortp2 
     103               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + 0.5 * ztortp2 
     104               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + 0.5 * ztortp2 * zfactfe 
     105               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + ( zrespp2 + 0.5 * ztortp2 ) * zfactfe 
     106#endif 
    92107            END DO 
    93108         END DO 
    94109      END DO 
    95110      ! 
     111        IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     112         WRITE(charout, FMT="('diat')") 
     113         CALL prt_ctl_trc_info(charout) 
     114         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     115       ENDIF 
     116              
    96117   END SUBROUTINE p4z_diat 
    97118 

  • branches/dev_001_GM/NEMO/TOP_SRC/PISCES/p4zflx.F90

    r775 r858  
    1919   USE trp_trc 
    2020   USE sms 
     21   USE prtctl_trc 
    2122 
    2223   IMPLICIT NONE 
    … …  
    2425 
    2526   PUBLIC   p4z_flx    ! called in p4zprg.F90 
     27 
     28   REAL(wp) :: &  ! pre-industrial atmospheric [co2] (ppm)   
     29     atcox = 0.20946 
     30 
    2631 
    2732   !!* Substitution 
    … …  
    3540CONTAINS 
    3641 
    37    SUBROUTINE p4z_flx 
     42   SUBROUTINE p4z_flx ( kt ) 
    3843      !!--------------------------------------------------------------------- 
    3944      !!                     ***  ROUTINE p4z_flx  *** 
    … …  
    4348      !! ** Method  : - ??? 
    4449      !!--------------------------------------------------------------------- 
    45       INTEGER  ::   ji, jj, jrorr 
    46       REAL(wp) ::   zpdtan, zttc, zws 
     50      INTEGER, INTENT(in) :: kt 
     51      INTEGER  ::   ji, jj, jrorr, nspyr 
     52      REAL(wp) ::   zttc, zws 
    4753      REAL(wp) ::   zfld, zflu, zoxy16, zflu16, zfact 
    4854      REAL(wp) ::   zph, zah2, zbot, zdic, zalk, zschmitto2, zalka, zschmittco2 
    49       REAL(wp), DIMENSION(jpi,jpj) ::   zkgco2, zkgo2, zh2co3 
     55      REAL(wp), DIMENSION(jpi,jpj) ::   zkgco2, zkgo2, zh2co3, zqcumtemp  
     56      CHARACTER (len=25) :: charout 
     57 
    5058      !!--------------------------------------------------------------------- 
    5159 
    … …  
    5563      ! ----------------------------------------------------- 
    5664 
    57       zpdtan = raass / rdt 
     65      nspyr = INT( raass / rdt ) 
    5866 
    5967      ! SURFACE CHEMISTRY (PCO2 AND [H+] IN 
    … …  
    6371      DO jrorr = 1, 10 
    6472 
     73!CDIR NOVERRCHK 
    6574         DO jj = 1, jpj 
     75!CDIR NOVERRCHK 
    6676            DO ji = 1, jpi 
    6777 
    … …  
    94104      ! ------------------------------------------- 
    95105 
    96       DO jj = 1, jpj 
     106!CDIR NOVERRCHK 
     107      DO jj = 1, jpj 
     108!CDIR NOVERRCHK 
    97109         DO ji = 1, jpi 
    98110 
    … …  
    140152      END DO 
    141153 
     154      zqcumtemp(:,:) = 0. 
    142155      DO jj = 1, jpj 
    143156         DO ji = 1, jpi 
    144157 
    145158            ! Compute CO2 flux for the sea and air 
    146             zfld = atcco2 * tmask(ji,jj,1) * chemc(ji,jj,3) * zkgco2(ji,jj) 
     159            zfld = atcco2 * tmask(ji,jj,1) * chemc(ji,jj,1) * zkgco2(ji,jj) 
    147160            zflu = zh2co3(ji,jj) * tmask(ji,jj,1) * zkgco2(ji,jj) 
    148161            tra(ji,jj,1,jpdic) = tra(ji,jj,1,jpdic) + ( zfld - zflu ) / fse3t(ji,jj,1) 
    149162 
     163            zqcumtemp(ji,jj) = ( zfld - zflu ) * rfact & 
     164               &             * e1t(ji,jj) * e2t(ji,jj) * tmask(ji,jj,1) * 1000. 
    150165            ! Compute O2 flux  
    151166            zoxy16 = trn(ji,jj,1,jpoxy) 
    … …  
    158173            trc2d(ji,jj,2) = zflu16 * 1000. 
    159174            trc2d(ji,jj,3) = zkgco2(ji,jj) 
    160             trc2d(ji,jj,4) = atcco2 - zh2co3(ji,jj) / ( chemc(ji,jj,3) + rtrn ) 
     175            trc2d(ji,jj,4) = atcco2 - zh2co3(ji,jj) / ( chemc(ji,jj,1) + rtrn ) 
    161176# endif 
    162177         END DO 
    163178      END DO 
    164179      ! 
     180 
     181      DO jj = 1, jpj 
     182        DO ji = 1, jpi 
     183           qcumul(1) = qcumul(1) + zqcumtemp(ji,jj) * tmask_i(ji,jj) 
     184        END DO 
     185      END DO 
     186 
     187      IF( MOD( kt, nspyr ) == 0 ) THEN 
     188        WRITE(numout,*) ' Atmospheric pCO2    :' 
     189        WRITE(numout,*) '-------------------- : ',kt,'  ',atcco2 
     190        WRITE(numout,*) '(ppm)' 
     191        WRITE(numout,*) 'Total Flux of Carbon :' 
     192        WRITE(numout,*) '-------------------- : ',qcumul(1)*12./1E15 
     193        WRITE(numout,*) '(GtC/an)' 
     194        qcumul(1) = 0. 
     195      ENDIF 
     196 
     197       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     198         WRITE(charout, FMT="('flx ')") 
     199         CALL prt_ctl_trc_info(charout) 
     200         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     201       ENDIF 
     202 
     203 
    165204   END SUBROUTINE p4z_flx 
    166205 

  • branches/dev_001_GM/NEMO/TOP_SRC/PISCES/p4zlim.F90

    r775 r858  
    4444      REAL(wp) ::   zlim1, zlim2, zlim3, zlim4, zno3, zferlim 
    4545      REAL(wp) ::   zconctemp, zconctemp2, zconctempn, zconctempn2 
     46      REAL(wp) ::   ztemp, zdenom 
    4647      !!--------------------------------------------------------------------- 
    4748 
    … …  
    7071            DO ji = 1, jpi 
    7172               zconctemp   = MAX( 0.e0 , trn(ji,jj,jk,jpdia)-5e-7 ) 
    72                zconctemp2  = MIN( 5.e-7, trn(ji,jj,jk,jpdia)      ) 
     73               zconctemp2  = trn(ji,jj,jk,jpdia) - zconctemp 
    7374               zconctempn  = MAX( 0.e0 , trn(ji,jj,jk,jpphy)-1e-6 ) 
    74                zconctempn2 = MIN( 1.e-6, trn(ji,jj,jk,jpphy)      ) 
     75               zconctempn2 = trn(ji,jj,jk,jpphy) - zconctempn 
    7576               concdfe(ji,jj,jk) = ( zconctemp2 * conc3 + 0.4e-9 * zconctemp)   & 
    76                   &              / ( zconctemp2 + zconctemp + rtrn ) 
     77                  &              / ( trn(ji,jj,jk,jpdia) + rtrn ) 
    7778               concdfe(ji,jj,jk) = MAX( conc3, concdfe(ji,jj,jk) ) 
    7879               concnfe(ji,jj,jk) = ( zconctempn2 * conc2 + 0.08e-9 * zconctempn)   & 
    79                   &              / ( zconctempn2 + zconctempn + rtrn ) 
     80                  &              / ( trn(ji,jj,jk,jpphy) + rtrn ) 
    8081               concnfe(ji,jj,jk) = MAX( conc2, concnfe(ji,jj,jk) ) 
    8182            END DO 
    … …  
    9091!      Small flagellates 
    9192!      ----------------------------------------------- 
     93              zdenom = 1. / & 
     94                  & ( conc0 * concnnh4 + concnnh4 * trn(ji,jj,jk,jpno3) + conc0 * trn(ji,jj,jk,jpnh4) ) 
     95               xnanono3(ji,jj,jk) = trn(ji,jj,jk,jpno3) * concnnh4 * zdenom 
     96               xnanonh4(ji,jj,jk) = trn(ji,jj,jk,jpnh4) * conc0    * zdenom 
    9297 
    93                xnanono3(ji,jj,jk) = trn(ji,jj,jk,jpno3) * concnnh4           & 
    94                   &               / ( conc0 * concnnh4 + concnnh4 * trn(ji,jj,jk,jpno3)   & 
    95                   &                                    + conc0    * trn(ji,jj,jk,jpnh4) ) 
    96                xnanonh4(ji,jj,jk) = trn(ji,jj,jk,jpnh4) * conc0              & 
    97                   &               / ( conc0 * concnnh4 + concnnh4 * trn(ji,jj,jk,jpno3)   & 
    98                   &                                    + conc0    * trn(ji,jj,jk,jpnh4) ) 
    9998               zlim1 = xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) 
    10099               zlim2 = trn(ji,jj,jk,jppo4) / ( trn(ji,jj,jk,jppo4) + concnnh4          )  
    … …  
    116115!   Michaelis-Menten Limitation term for nutrients Diatoms 
    117116!   ---------------------------------------------- 
     117              zdenom = 1. / & 
     118                  & ( conc1 * concdnh4 + concdnh4 * trn(ji,jj,jk,jpno3) + conc1 * trn(ji,jj,jk,jpnh4) ) 
    118119 
    119                xdiatno3(ji,jj,jk) = trn(ji,jj,jk,jpno3) * concdnh4                         & 
    120                   &               / ( conc1  * concdnh4 + concdnh4 * trn(ji,jj,jk,jpno3)   & 
    121                   &                                     + conc1    * trn(ji,jj,jk,jpnh4) ) 
    122                xdiatnh4(ji,jj,jk) = trn(ji,jj,jk,jpnh4) * conc1                            & 
    123                   &               / ( conc1  * concdnh4 + concdnh4 * trn(ji,jj,jk,jpno3)   & 
    124                   &                                     + conc1   * trn(ji,jj,jk,jpnh4) ) 
     120               xdiatno3(ji,jj,jk) = trn(ji,jj,jk,jpno3) * concdnh4 * zdenom 
     121               xdiatnh4(ji,jj,jk) = trn(ji,jj,jk,jpnh4) * conc1    * zdenom  
    125122 
    126123               zlim1 = xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) 
    … …  
    130127               xlimdia(ji,jj,jk) = MIN( zlim1, zlim2, zlim3, zlim4 ) 
    131128 
     129            END DO 
     130         END DO 
     131      END DO 
     132 
     133 
     134      ! Compute the fraction of nanophytoplankton that is made of calcifiers 
     135      ! -------------------------------------------------------------------- 
     136 
     137      DO jk = 1, jpkm1 
     138         DO jj = 1, jpj 
     139            DO ji = 1, jpi 
     140               ztemp = MAX( 0., tn(ji,jj,jk) ) 
     141               xfracal(ji,jj,jk) = caco3r * xlimphy(ji,jj,jk)   & 
     142                  &                       * MAX( 0.0001, ztemp / ( 2.+ ztemp ) )   & 
     143                  &                       * MAX( 1., trn(ji,jj,jk,jpphy) * 1.e6 / 2. ) 
     144               xfracal(ji,jj,jk) = MIN( 0.8 , xfracal(ji,jj,jk) ) 
     145               xfracal(ji,jj,jk) = MAX( 0.01, xfracal(ji,jj,jk) ) 
    132146            END DO 
    133147         END DO 

  • branches/dev_001_GM/NEMO/TOP_SRC/PISCES/p4zlys.F90

    r775 r858  
    1919   USE trp_trc 
    2020   USE sms 
     21   USE prtctl_trc 
    2122 
    2223   IMPLICIT NONE 
    … …  
    2425 
    2526   PUBLIC   p4z_lys    ! called in p4zprg.F90 
     27 
     28   !! * Module variables 
     29 
     30   REAL(wp) :: & 
     31      calcon = 1.03E-2        ! mean calcite concentration [Ca2+] in sea water [mole/kg solution] 
    2632 
    2733   !!---------------------------------------------------------------------- 
    … …  
    4854      REAL(wp) ::   zomegaca, zexcess, zexcess0 
    4955      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zco3 
     56      CHARACTER (len=25) :: charout 
    5057      !!--------------------------------------------------------------------- 
    5158 
    … …  
    5764      DO jn = 1, 5                               !  BEGIN OF ITERATION 
    5865         ! 
     66!CDIR NOVERRCHK 
    5967         DO jk = 1, jpkm1 
     68!CDIR NOVERRCHK 
    6069            DO jj = 1, jpj 
     70!CDIR NOVERRCHK 
    6171               DO ji = 1, jpi 
    6272 
    … …  
    131141 
    132142# if defined key_trc_dia3d 
    133          trc3d(:,:,:,1) = rhop(:,:,:) 
     143         trc3d(:,:,:,1) = hi(:,:,:) 
    134144         trc3d(:,:,:,2) = zco3(:,:,:) 
    135145         trc3d(:,:,:,3) = aksp(:,:,:) / calcon 
    136146# endif 
    137147      ! 
     148       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     149         WRITE(charout, FMT="('lys ')") 
     150         CALL prt_ctl_trc_info(charout) 
     151         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     152       ENDIF 
     153 
    138154   END SUBROUTINE p4z_lys 
    139155 

  • branches/dev_001_GM/NEMO/TOP_SRC/PISCES/p4zmeso.F90

    r775 r858  
    1616   USE trp_trc         !  
    1717   USE sms             !  
     18   USE prtctl_trc 
    1819 
    1920   IMPLICIT NONE 
    … …  
    4041      !! ** Method  : - ??? 
    4142      !!--------------------------------------------------------------------- 
    42       INTEGER  ::   ji, jj, jk 
    43       REAL(wp) ::   zcompadi, zcompaph, zcompapoc, zcompaz 
    44       REAL(wp) ::   zfact, zstep, zcompam, zdenom, zgraze2 
     43      INTEGER  :: ji, jj, jk 
     44      REAL(wp) :: zcompadi, zcompaph, zcompapoc, zcompaz 
     45      REAL(wp) :: zfact, zstep, zcompam, zdenom, zgraze2 
     46      REAL(wp) :: zgrarem2, zgrafer2, zgrapoc2, zprcaca, zmortz2 
     47#if defined key_kriest 
     48      REAL znumpoc 
     49#endif 
     50      REAL(wp),DIMENSION(jpi,jpj,jpk) :: zrespz2,ztortz2,zgrazd,zgrazz,zgrazpof 
     51      REAL(wp),DIMENSION(jpi,jpj,jpk) :: zgrazn,zgrazpoc,zgraznf,zgrazf 
     52      REAL(wp),DIMENSION(jpi,jpj,jpk) :: zgrazfff,zgrazffe 
     53      CHARACTER (len=25) :: charout 
    4554      !!--------------------------------------------------------------------- 
    4655 
    … …  
    6069!     Respiration rates of both zooplankton 
    6170!     ------------------------------------- 
    62                respz2(ji,jj,jk) = resrat2 * zfact * ( 1. + 3. * nitrfac(ji,jj,jk) )        & 
    63                   &             * trn(ji,jj,jk,jpmes) / ( xkmort + trn(ji,jj,jk,jpmes) ) 
     71               zrespz2(ji,jj,jk) = resrat2 * zfact * ( 1. + 3. * nitrfac(ji,jj,jk) )        & 
     72                  &       * trn(ji,jj,jk,jpmes) / ( xkmort + trn(ji,jj,jk,jpmes) ) 
    6473 
    6574!     Zooplankton mortality. A square function has been selected with 
    … …  
    6776!     mimic predation. 
    6877!     --------------------------------------------------------------- 
    69                tortz2(ji,jj,jk) = mzrat2 * 1.e6 * zfact * trn(ji,jj,jk,jpmes) 
     78               ztortz2(ji,jj,jk) = mzrat2 * 1.e6 * zfact * trn(ji,jj,jk,jpmes) 
    7079               ! 
    7180            END DO 
    … …  
    7382      END DO 
    7483 
    75       DO jk = 1, jpkm1 
    76          DO jj = 1, jpj 
    77             DO ji = 1, jpi 
    78  
     84 
     85      DO jk = 1,jpkm1 
     86         DO jj = 1,jpj 
     87            DO ji = 1,jpi 
    7988               zcompadi  = MAX( ( trn(ji,jj,jk,jpdia) - 1.e-8 ), 0.e0 ) 
    8089               zcompaz   = MAX( ( trn(ji,jj,jk,jpzoo) - 1.e-8 ), 0.e0 ) 
    … …  
    95104                  &     * trn(ji,jj,jk,jpmes) 
    96105 
    97                grazd  (ji,jj,jk) = zgraze2 * xprefc   * zcompadi 
    98                grazz  (ji,jj,jk) = zgraze2 * xprefz   * zcompaz 
    99                grazn  (ji,jj,jk) = zgraze2 * xprefp   * zcompaph 
    100                grazpoc(ji,jj,jk) = zgraze2 * xprefpoc * zcompapoc 
    101  
    102                graznf (ji,jj,jk) = grazn  (ji,jj,jk) * trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn) 
    103  
    104                graznch(ji,jj,jk) = grazn  (ji,jj,jk) * trn(ji,jj,jk,jpnch) / (trn(ji,jj,jk,jpphy) + rtrn) 
    105  
    106                grazs  (ji,jj,jk) = grazd  (ji,jj,jk) * trn(ji,jj,jk,jpbsi) / (trn(ji,jj,jk,jpdia) + rtrn) 
    107  
    108                grazf  (ji,jj,jk) = grazd  (ji,jj,jk) * trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn) 
    109  
    110                grazdch(ji,jj,jk) = grazd  (ji,jj,jk) * trn(ji,jj,jk,jpdch) / (trn(ji,jj,jk,jpdia) + rtrn) 
    111  
    112                grazpof(ji,jj,jk) = grazpoc(ji,jj,jk) * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) 
    113             END DO 
    114          END DO 
    115       END DO 
    116  
    117       DO jk = 1, jpkm1 
    118          DO jj = 1, jpj 
    119             DO ji = 1, jpi 
    120  
     106               zgrazd(ji,jj,jk)   = zgraze2 * xprefc   * zcompadi 
     107               zgrazz(ji,jj,jk)   = zgraze2 * xprefz   * zcompaz 
     108               zgrazn(ji,jj,jk)   = zgraze2 * xprefp   * zcompaph 
     109               zgrazpoc(ji,jj,jk) = zgraze2 * xprefpoc * zcompapoc 
     110 
     111               zgraznf(ji,jj,jk)  = zgrazn(ji,jj,jk)   * trn(ji,jj,jk,jpnfe) & 
     112                  &                                     / (trn(ji,jj,jk,jpphy) + rtrn) 
     113               zgrazf(ji,jj,jk)   = zgrazd(ji,jj,jk)   * trn(ji,jj,jk,jpdfe) & 
     114                  &                                    / (trn(ji,jj,jk,jpdia) + rtrn) 
     115               zgrazpof(ji,jj,jk) = zgrazpoc(ji,jj,jk) * trn(ji,jj,jk,jpsfe) & 
     116                  &                                   / (trn(ji,jj,jk,jppoc) + rtrn) 
     117            END DO 
     118         END DO 
     119      END DO 
     120       
     121       
     122      DO jk = 1,jpkm1 
     123         DO jj = 1,jpj 
     124            DO ji = 1,jpi 
     125                
    121126!    Mesozooplankton flux feeding on GOC 
    122127!    ---------------------------------- 
    123128# if ! defined key_kriest 
    124                grazffe(ji,jj,jk) = 5.e3 * zstep * wsbio4(ji,jj,jk)          & 
     129               zgrazffe(ji,jj,jk) = 5.e3 * zstep * wsbio4(ji,jj,jk)          & 
    125130#  if defined key_off_degrad 
    126131                  &     * facvol(ji,jj,jk)          & 
    … …  
    128133                  &     * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpmes) 
    129134 
    130                grazfff(ji,jj,jk) = grazffe(ji,jj,jk)         & 
     135               zgrazfff(ji,jj,jk) = zgrazffe(ji,jj,jk)       & 
    131136                  &     * trn(ji,jj,jk,jpbfe) / (trn(ji,jj,jk,jpgoc) + rtrn) 
    132137# else 
    133138! KRIEST3 
    134                grazffe(ji,jj,jk) = 0.5 * 1.3e-2 / 5.5e-7 * 0.3 * zstep * wsbio3(ji,jj,jk)     & 
     139               zgrazffe(ji,jj,jk) = 0.5 * 1.3e-2 / 5.5e-7 * 0.3 * zstep * wsbio3(ji,jj,jk)     & 
    135140                  &     * tgfunc(ji,jj,jk) * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpmes)    & 
    136141#  if defined key_off_degrad 
    … …  
    139144                  &     /  (trn(ji,jj,jk,jppoc) * 1.e7 + 0.1) 
    140145 
    141 !!C        grazffe(ji,jj,jk) = 5.e3 * zstep * wsbio3(ji,jj,jk) 
     146!!C        zgrazffe(ji,jj,jk) = 5.e3 * zstep * wsbio3(ji,jj,jk) 
    142147!!C     &     * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpmes) 
    143148!!C#    if defined key_off_degrad 
    … …  
    145150!!C#    endif 
    146151 
    147                grazfff(ji,jj,jk) = grazffe(ji,jj,jk)       & 
     152               zgrazfff(ji,jj,jk) = zgrazffe(ji,jj,jk)      & 
    148153                  &     * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) 
    149154# endif 
     155            END DO 
     156         END DO 
     157      END DO 
     158       
     159 
     160      DO jk = 1,jpkm1 
     161         DO jj = 1,jpj 
     162            DO ji = 1,jpi 
     163 
     164!    Mesozooplankton efficiency 
     165!    -------------------------- 
     166               zgrarem2 = ( zgrazd(ji,jj,jk) + zgrazz(ji,jj,jk) + zgrazn(ji,jj,jk) & 
     167                  &            + zgrazpoc(ji,jj,jk) + zgrazffe(ji,jj,jk) )   & 
     168                  &     * ( 1. - epsher2 - unass2 ) 
     169#if ! defined key_kriest 
     170               zgrafer2 = (zgrazf(ji,jj,jk) + zgraznf(ji,jj,jk) + zgrazz(ji,jj,jk) & 
     171                  &     * ferat3 + zgrazpof(ji,jj,jk) + zgrazfff (ji,jj,jk))*(1.-epsher2-unass2) & 
     172                  &       + epsher2 * ( & 
     173                  &      zgrazd(ji,jj,jk)   * MAX((trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn)-ferat3),0.) & 
     174                  &    + zgrazn(ji,jj,jk)   * MAX((trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn)-ferat3),0.) & 
     175                  &    + zgrazpoc(ji,jj,jk) * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)-ferat3),0.) & 
     176                  &    + zgrazffe(ji,jj,jk) * MAX((trn(ji,jj,jk,jpbfe) / (trn(ji,jj,jk,jpgoc) + rtrn)-ferat3),0.)  ) 
     177#else 
     178               zgrafer2 = (zgrazf(ji,jj,jk) + zgraznf(ji,jj,jk) + zgrazz(ji,jj,jk) & 
     179                  &       * ferat3 + zgrazpof(ji,jj,jk) + zgrazfff(ji,jj,jk) )*(1.-epsher2-unass2) & 
     180                  &       + epsher2 * ( & 
     181                  &      zgrazd(ji,jj,jk)   * MAX((trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn)-ferat3),0.) & 
     182                  &    + zgrazn(ji,jj,jk)   * MAX((trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn)-ferat3),0.) & 
     183                  &    + zgrazpoc(ji,jj,jk) * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)-ferat3),0.) & 
     184                  &    + zgrazffe(ji,jj,jk) * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)-ferat3),0.)  ) 
     185 
     186#endif 
     187               zgrapoc2 = (zgrazd(ji,jj,jk) + zgrazz(ji,jj,jk)  + zgrazn(ji,jj,jk) & 
     188                  &          + zgrazpoc(ji,jj,jk) + zgrazffe(ji,jj,jk)) * unass2 
     189 
     190               tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarem2 * sigma2 
     191               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarem2 * sigma2 
     192               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem2 * (1.-sigma2) 
     193               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarem2 * sigma2 
     194               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer2 
     195               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarem2 * sigma2 
     196                
     197#if defined key_kriest 
     198               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc2 
     199               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zgrapoc2 * xkr_nmeso 
     200#else 
     201               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zgrapoc2 
     202#endif 
    150203            END DO 
    151204         END DO 
    … …  
    155208         DO jj = 1, jpj 
    156209            DO ji = 1, jpi 
    157  
    158 !    Mesozooplankton efficiency 
    159 !    -------------------------- 
    160                grarem2(ji,jj,jk) = (grazd(ji,jj,jk) + grazz(ji,jj,jk)              & 
    161                   &     + grazn(ji,jj,jk) + grazpoc(ji,jj,jk) + grazffe(ji,jj,jk))   & 
    162                   &     * (1.-epsher2-unass2) 
    163 #if ! defined key_kriest 
    164                grafer2(ji,jj,jk) = (grazf(ji,jj,jk) + graznf(ji,jj,jk)                       & 
    165                   &     + grazz(ji,jj,jk) * ferat3 + grazpof(ji,jj,jk)                       & 
    166                   &     + grazfff(ji,jj,jk)) * (1.-epsher2-unass2)                       & 
    167                   &     + epsher2 * (grazd(ji,jj,jk) * MAX(                       & 
    168                   &    (trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn)                       & 
    169                   &    -ferat3),0.) + grazn(ji,jj,jk) * MAX(                       & 
    170                   &    (trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn)                       & 
    171                   &    -ferat3),0.) + grazpoc(ji,jj,jk) * MAX(                       & 
    172                   &    (trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)                       & 
    173                   &    -ferat3),0.) + grazffe(ji,jj,jk) * MAX(                       & 
    174                   &    (trn(ji,jj,jk,jpbfe) / (trn(ji,jj,jk,jpgoc) + rtrn)                       & 
    175                   &    -ferat3),0.) ) 
    176 #else 
    177                grafer2(ji,jj,jk) = (grazf(ji,jj,jk) + graznf(ji,jj,jk)                       & 
    178                   &     + grazz(ji,jj,jk) * ferat3 + grazpof(ji,jj,jk)                       & 
    179                   &     + grazfff(ji,jj,jk)) * (1.-epsher2-unass2)                       & 
    180                   &     + epsher2 * (grazd(ji,jj,jk) * MAX(                       & 
    181                   &    (trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn)                       & 
    182                   &    -ferat3),0.) + grazn(ji,jj,jk) * MAX(                       & 
    183                   &    (trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn)                       & 
    184                   &    -ferat3),0.) + grazpoc(ji,jj,jk) * MAX(                       & 
    185                   &    (trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)                       & 
    186                   &    -ferat3),0.) + grazffe(ji,jj,jk) * MAX(                       & 
    187                   &    (trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)                       & 
    188                   &    -ferat3),0.) ) 
    189 #endif 
    190                grapoc2(ji,jj,jk) = (grazd(ji,jj,jk) + grazz(ji,jj,jk)                     & 
    191                   &     + grazn(ji,jj,jk) + grazpoc(ji,jj,jk) + grazffe(ji,jj,jk)) * unass2 
    192210               ! 
     211               !   Update the arrays TRA which contain the biological sources and sinks 
     212               !   -------------------------------------------------------------------- 
     213               zmortz2 = ztortz2(ji,jj,jk) + zrespz2(ji,jj,jk) 
     214               tra(ji,jj,jk,jpmes) = tra(ji,jj,jk,jpmes) - zmortz2  & 
     215                  &    + epsher2 * ( zgrazd(ji,jj,jk) + zgrazz(ji,jj,jk) + zgrazn(ji,jj,jk) & 
     216                  &                 + zgrazpoc(ji,jj,jk) + zgrazffe(ji,jj,jk) ) 
     217               tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazd(ji,jj,jk) 
     218               tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zgrazz(ji,jj,jk) 
     219               tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgrazn(ji,jj,jk) 
     220               tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazn(ji,jj,jk) * trn(ji,jj,jk,jpnch)  & 
     221                  &                 / ( trn(ji,jj,jk,jpphy) + rtrn ) 
     222               tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazd(ji,jj,jk) * trn(ji,jj,jk,jpdch) & 
     223                  &                / ( trn(ji,jj,jk,jpdia) + rtrn ) 
     224               tra(ji,jj,jk,jpbsi) = tra(ji,jj,jk,jpbsi) - zgrazd(ji,jj,jk) * trn(ji,jj,jk,jpbsi) & 
     225                  &                / ( trn(ji,jj,jk,jpdia) + rtrn ) 
     226               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) +  zgrazd(ji,jj,jk) * trn(ji,jj,jk,jpbsi) & 
     227                  &                / ( trn(ji,jj,jk,jpdia) + rtrn ) 
     228               tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) -  zgraznf(ji,jj,jk) 
     229               tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) -  zgrazf(ji,jj,jk) 
     230 
     231               zprcaca = xfracal(ji,jj,jk) * part * unass2 * zgrazn(ji,jj,jk) 
     232 
     233               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprcaca 
     234               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca 
     235               tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca 
     236#if defined key_kriest 
     237               znumpoc = trn(ji,jj,jk,jpnum) / ( trn(ji,jj,jk,jppoc) + rtrn ) 
     238               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortz2  & 
     239                  &                 - zgrazpoc(ji,jj,jk) - zgrazffe(ji,jj,jk)     
     240               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) - zgrazpoc(ji,jj,jk) * znumpoc & 
     241                  &                  + zmortz2  * xkr_nmeso & 
     242                  &                  - zgrazffe(ji,jj,jk)   * znumpoc * wsbio4(ji,jj,jk) & 
     243                  &                  / ( wsbio3(ji,jj,jk) + rtrn ) 
     244               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortz2 & 
     245               &                    + unass2 * ( ferat3 * zgrazz(ji,jj,jk) + zgraznf(ji,jj,jk) & 
     246               &                    + zgrazf(ji,jj,jk) + zgrazpof(ji,jj,jk) + zgrazfff(ji,jj,jk) ) & 
     247               &                    - zgrazfff(ji,jj,jk) - zgrazpof(ji,jj,jk) 
     248#else 
     249               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zgrazpoc(ji,jj,jk) 
     250               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zmortz2 - zgrazffe(ji,jj,jk) 
     251               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zgrazpof(ji,jj,jk) 
     252               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + ferat3 * zmortz2 & 
     253               &                     + unass2 * ( ferat3 * zgrazz(ji,jj,jk) + zgraznf(ji,jj,jk) & 
     254               &                     + zgrazf(ji,jj,jk) + zgrazpof(ji,jj,jk) + zgrazfff(ji,jj,jk) ) & 
     255               &                     - zgrazfff(ji,jj,jk) 
     256#endif 
     257 
    193258            END DO 
    194259         END DO 
    195260      END DO 
    196261      ! 
     262       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     263         WRITE(charout, FMT="('meso')") 
     264         CALL prt_ctl_trc_info(charout) 
     265         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     266       ENDIF 
     267 
    197268   END SUBROUTINE p4z_meso 
    198269 

  • branches/dev_001_GM/NEMO/TOP_SRC/PISCES/p4zmicro.F90

    r775 r858  
    1616   USE trp_trc         !  
    1717   USE sms             !  
     18   USE prtctl_trc 
    1819 
    1920   IMPLICIT NONE 
    … …  
    4041      !! ** Method  : - ??? 
    4142      !!--------------------------------------------------------------------- 
    42       INTEGER  ::   ji, jj, jk 
    43       REAL(wp) ::   zcompadi, zcompadi2, zcompaz , zcompaph, zcompapoc 
    44       REAL(wp) ::   zgraze  , zdenom  , zdenom2 
    45       REAL(wp) ::   zfact   , zstep   , zinano , zidiat, zipoc 
     43      INTEGER  :: ji, jj, jk 
     44      REAL(wp) :: zcompadi, zcompadi2, zcompaz , zcompaph, zcompapoc 
     45      REAL(wp) :: zgraze  , zdenom  , zdenom2 
     46      REAL(wp) :: zfact   , zstep   , zinano , zidiat, zipoc 
     47      REAL(wp) :: zgrarem, zgrafer, zgrapoc, zprcaca, zmortz 
     48      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zrespz,ztortz 
     49      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazp, zgrazm, zgrazsd 
     50      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazmf, zgrazsf, zgrazpf 
     51      CHARACTER (len=25) :: charout 
     52 
    4653      !!--------------------------------------------------------------------- 
    4754 
    … …  
    6269!     ------------------------------------- 
    6370 
    64                respz(ji,jj,jk) = resrat * zfact  * ( 1.+ 3.* nitrfac(ji,jj,jk) )     & 
     71               zrespz(ji,jj,jk) = resrat * zfact  * ( 1.+ 3.* nitrfac(ji,jj,jk) )     & 
    6572                  &            * trn(ji,jj,jk,jpzoo) / ( xkmort + trn(ji,jj,jk,jpzoo) ) 
    6673 
    … …  
    6976!     mimic predation. 
    7077!     --------------------------------------------------------------- 
    71  
    72                tortz(ji,jj,jk) = mzrat * 1.e6 * zfact * trn(ji,jj,jk,jpzoo) 
    73  
    74             END DO 
    75          END DO 
    76       END DO 
    77  
    78       DO jk = 1, jpkm1 
    79          DO jj = 1, jpj 
    80             DO ji = 1, jpi 
    81  
     78               ztortz(ji,jj,jk) = mzrat * 1.e6 * zfact * trn(ji,jj,jk,jpzoo) 
     79 
     80            END DO 
     81         END DO 
     82      END DO 
     83 
     84 
     85  
     86      DO jk = 1,jpkm1 
     87         DO jj = 1,jpj 
     88            DO ji = 1,jpi 
    8289               zcompadi  = MAX( ( trn(ji,jj,jk,jpdia) - 1.e-8 ), 0.e0 ) 
    8390               zcompadi2 = MIN( zcompadi, 5.e-7 ) 
    8491               zcompaph  = MAX( ( trn(ji,jj,jk,jpphy) - 2.e-7 ), 0.e0 ) 
    8592               zcompapoc = MAX( ( trn(ji,jj,jk,jppoc) - 1.e-8 ), 0.e0 ) 
    86  
    87 !     Microzooplankton grazing 
    88 !     ------------------------ 
     93                
     94               !     Microzooplankton grazing 
     95               !     ------------------------ 
    8996               zdenom2 = 1./ ( zprefp * zcompaph + zprefc * zcompapoc + zprefd * zcompadi2 + rtrn ) 
    9097 
    … …  
    101108               zdenom = 1./ ( xkgraz + zinano * zcompaph + zipoc * zcompapoc + zidiat * zcompadi2 ) 
    102109 
    103                grazp (ji,jj,jk) = zgraze * zinano * zcompaph * zdenom 
    104                grazm (ji,jj,jk) = zgraze * zipoc  * zcompapoc * zdenom 
    105                grazsd(ji,jj,jk) = zgraze * zidiat * zcompadi2 * zdenom 
    106  
    107                grazpf (ji,jj,jk) = grazp (ji,jj,jk) * trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn) 
    108  
    109                grazpch(ji,jj,jk) = grazp (ji,jj,jk) * trn(ji,jj,jk,jpnch) / (trn(ji,jj,jk,jpphy) + rtrn) 
    110  
    111                grazmf (ji,jj,jk) = grazm (ji,jj,jk) * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) 
    112  
    113                grazsf (ji,jj,jk) = grazsd(ji,jj,jk) * trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn) 
    114  
    115                grazss (ji,jj,jk) = grazsd(ji,jj,jk) * trn(ji,jj,jk,jpbsi) / (trn(ji,jj,jk,jpdia) + rtrn) 
    116  
    117                grazsch(ji,jj,jk) = grazsd(ji,jj,jk) * trn(ji,jj,jk,jpdch) / (trn(ji,jj,jk,jpdia) + rtrn) 
    118  
    119             END DO 
    120          END DO 
    121       END DO 
     110               zgrazp(ji,jj,jk)  = zgraze * zinano * zcompaph * zdenom 
     111               zgrazm(ji,jj,jk)  = zgraze * zipoc  * zcompapoc * zdenom 
     112               zgrazsd(ji,jj,jk) = zgraze * zidiat * zcompadi2 * zdenom 
     113 
     114               zgrazpf (ji,jj,jk) = zgrazp(ji,jj,jk)  * trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn) 
     115               zgrazmf(ji,jj,jk)  = zgrazm(ji,jj,jk)  * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) 
     116               zgrazsf(ji,jj,jk)  = zgrazsd(ji,jj,jk) * trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn) 
     117 
     118            END DO 
     119         END DO 
     120      END DO 
     121       
     122 
     123      DO jk = 1,jpkm1 
     124         DO jj = 1,jpj 
     125            DO ji = 1,jpi 
     126!    Various remineralization and excretion terms 
     127!    -------------------------------------------- 
     128 
     129               zgrarem = (  zgrazp(ji,jj,jk) + zgrazm(ji,jj,jk)  + zgrazsd(ji,jj,jk)  ) & 
     130                  &          * ( 1.- epsher - unass ) 
     131               zgrafer = (  zgrazpf(ji,jj,jk) + zgrazsf(ji,jj,jk)  + zgrazmf(ji,jj,jk)  ) & 
     132                  &        * ( 1.- epsher - unass ) + epsher *  & 
     133                  &  ( zgrazm(ji,jj,jk)  * MAX((trn(ji,jj,jk,jpsfe) /(trn(ji,jj,jk,jppoc)+ rtrn)-ferat3),0.e0) & 
     134                  &   + zgrazp(ji,jj,jk)  * MAX((trn(ji,jj,jk,jpnfe)/(trn(ji,jj,jk,jpphy)+ rtrn)-ferat3),0.e0) & 
     135                  &   + zgrazsd(ji,jj,jk) * MAX((trn(ji,jj,jk,jpdfe)/(trn(ji,jj,jk,jpdia)+ rtrn)-ferat3),0.e0 )  ) 
     136               zgrapoc = (  zgrazp(ji,jj,jk) + zgrazm(ji,jj,jk) + zgrazsd(ji,jj,jk)  ) * unass 
     137 
     138               !  Update of the TRA arrays 
     139               !  ------------------------ 
     140 
     141               tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarem * sigma1 
     142               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarem * sigma1 
     143               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem * (1.-sigma1) 
     144               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarem * sigma1 
     145               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer 
     146               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc 
     147               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarem * sigma1 
     148#if defined key_kriest 
     149               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zgrapoc * xkr_ndiat 
     150#endif 
     151            END DO 
     152         END DO 
     153      END DO 
     154 
     155! 
     156!   Update the arrays TRA which contain the biological sources and sinks 
     157!   -------------------------------------------------------------------- 
    122158 
    123159      DO jk = 1, jpkm1 
    … …  
    125161            DO ji = 1, jpi 
    126162 
    127 !    Various remineralization and excretion terms 
    128 !    -------------------------------------------- 
    129  
    130                grarem(ji,jj,jk) = (  grazp(ji,jj,jk) + grazm (ji,jj,jk)        & 
    131                   &                                  + grazsd(ji,jj,jk)  ) * ( 1.- epsher - unass ) 
    132  
    133                grafer(ji,jj,jk) = (  grazpf(ji,jj,jk) + grazsf(ji,jj,jk)      & 
    134                   &                                   + grazmf(ji,jj,jk)  ) * ( 1.- epsher - unass )   & 
    135                   &             + (  grazm (ji,jj,jk) * MAX( (trn(ji,jj,jk,jpsfe) /     & 
    136                   &                                          (trn(ji,jj,jk,jppoc) + rtrn) - ferat3), 0.e0 )   & 
    137                   &                + grazp (ji,jj,jk) * MAX( (trn(ji,jj,jk,jpnfe) /   & 
    138                   &                                          (trn(ji,jj,jk,jpphy) + rtrn) - ferat3), 0.e0 )   & 
    139                   &                + grazsd(ji,jj,jk) * MAX( (trn(ji,jj,jk,jpdfe) /   & 
    140                   &                                         (trn(ji,jj,jk,jpdia) + rtrn) - ferat3), 0.e0 )  ) * epsher  
    141  
    142                grapoc(ji,jj,jk) = (  grazp(ji,jj,jk) + grazm(ji,jj,jk) + grazsd(ji,jj,jk)  ) * unass 
    143  
     163               zmortz = ztortz(ji,jj,jk) + zrespz(ji,jj,jk) 
     164               tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zmortz  & 
     165               &     + epsher * ( zgrazp(ji,jj,jk) + zgrazm(ji,jj,jk) + zgrazsd(ji,jj,jk)) 
     166               tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgrazp(ji,jj,jk) 
     167               tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazsd(ji,jj,jk) 
     168               tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazp(ji,jj,jk)  & 
     169               &                   * trn(ji,jj,jk,jpnch)/(trn(ji,jj,jk,jpphy)+rtrn) 
     170               tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazsd(ji,jj,jk) & 
     171               &                   * trn(ji,jj,jk,jpdch)/(trn(ji,jj,jk,jpdia)+rtrn) 
     172               tra(ji,jj,jk,jpbsi) = tra(ji,jj,jk,jpbsi) - zgrazsd(ji,jj,jk) & 
     173               &                   * trn(ji,jj,jk,jpbsi)/(trn(ji,jj,jk,jpdia)+rtrn) 
     174               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zgrazsd(ji,jj,jk) & 
     175               &                   * trn(ji,jj,jk,jpbsi)/(trn(ji,jj,jk,jpdia)+rtrn) 
     176               tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgrazpf(ji,jj,jk) 
     177               tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazsf(ji,jj,jk) 
     178               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortz - zgrazm(ji,jj,jk) 
     179               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortz   & 
     180               &                    + unass * ( zgrazpf(ji,jj,jk) + zgrazsf (ji,jj,jk)) & 
     181               &                   - (1.-unass) * zgrazmf(ji,jj,jk) 
     182               zprcaca = xfracal(ji,jj,jk) * part * unass * zgrazp(ji,jj,jk) 
     183               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprcaca 
     184               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal)- 2. * zprcaca 
     185               tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca 
     186#if defined key_kriest 
     187               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + ( zmortz - zgrazm(ji,jj,jk) ) * xkr_ndiat 
     188#endif 
    144189            END DO 
    145190         END DO 
    146191      END DO 
    147192      ! 
     193       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     194         WRITE(charout, FMT="('micro')") 
     195         CALL prt_ctl_trc_info(charout) 
     196         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     197       ENDIF 
     198 
    148199   END SUBROUTINE p4z_micro 
    149200 

  • branches/dev_001_GM/NEMO/TOP_SRC/PISCES/p4znano.F90

    r775 r858  
    1616   USE trp_trc         !  
    1717   USE sms             !  
     18   USE prtctl_trc 
    1819 
    1920   IMPLICIT NONE 
    … …  
    4041      !! ** Method  : - ??? 
    4142      !!--------------------------------------------------------------------- 
    42       INTEGER  ::   ji, jj, jk 
    43       REAL(wp) ::   zfact, zstep, zcompaph 
     43      INTEGER  :: ji, jj, jk 
     44      REAL(wp) :: zstep, zcompaph 
     45      REAL(wp) :: zfactfe,zfactch,zprcaca,zfracal 
     46      REAL(wp) :: ztortp,zrespp,zmortp 
     47      CHARACTER (len=25) :: charout 
    4448      !!--------------------------------------------------------------------- 
    4549 
    … …  
    5357 
    5458               zcompaph = MAX( ( trn(ji,jj,jk,jpphy) - 1e-8 ), 0.e0 ) 
    55                zfact    = 1./ ( trn(ji,jj,jk,jpphy) + rtrn ) 
    5659 
    5760!     Squared mortality of Phyto similar to a sedimentation term during 
    5861!     blooms (Doney et al. 1996) 
    5962!     ----------------------------------------------------------------- 
    60                respp(ji,jj,jk) = wchl * 1.e6 * zstep * zdiss(ji,jj,jk)   & 
     63               zrespp = wchl * 1.e6 * zstep * xdiss(ji,jj,jk)   & 
    6164# if defined key_off_degrad 
    62                   &            * facvol(ji,jj,jk)     & 
     65                  &        * facvol(ji,jj,jk)     & 
    6366# endif 
    64                   &            * zcompaph * trn(ji,jj,jk,jpphy) 
    65                                                                                 
    66                respnf (ji,jj,jk) = respp(ji,jj,jk) * trn(ji,jj,jk,jpnfe) * zfact 
    67                                                                                 
    68                respnch(ji,jj,jk) = respp(ji,jj,jk) * trn(ji,jj,jk,jpnch) * zfact 
     67                  &        * zcompaph * trn(ji,jj,jk,jpphy) 
    6968 
    7069!     Phytoplankton mortality. This mortality loss is slightly 
    … …  
    7271!     as observed for instance in case of iron limitation. 
    7372!     ---------------------------------------------------------- 
    74                tortp  (ji,jj,jk) = mprat * zstep * trn(ji,jj,jk,jpphy)          & 
     73               ztortp = mprat * zstep * trn(ji,jj,jk,jpphy)          & 
    7574# if defined key_off_degrad 
    76                   &              * facvol(ji,jj,jk)     & 
     75                  &          * facvol(ji,jj,jk)     & 
    7776# endif 
    78                   &              / ( xkmort + trn(ji,jj,jk,jpphy) ) * zcompaph 
     77                  &   / ( xkmort + trn(ji,jj,jk,jpphy) ) * zcompaph 
     78 
    7979                                                                                
    80                tortnf (ji,jj,jk) = tortp(ji,jj,jk) * trn(ji,jj,jk,jpnfe) * zfact 
    81                                                                                 
    82                tortnch(ji,jj,jk) = tortp(ji,jj,jk) * trn(ji,jj,jk,jpnch) * zfact 
     80               zmortp = zrespp + ztortp 
    8381 
     82               !   Update the arrays TRA which contains the biological sources and sinks 
     83                
     84               zfactfe = trn(ji,jj,jk,jpnfe)/(trn(ji,jj,jk,jpphy)+rtrn) 
     85               zfactch = trn(ji,jj,jk,jpnch)/(trn(ji,jj,jk,jpphy)+rtrn) 
     86                
     87               tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zmortp 
     88               tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zmortp * zfactch 
     89               tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zmortp * zfactfe 
     90               zprcaca = xfracal(ji,jj,jk) * zmortp 
     91               zfracal = 0.5 * xfracal(ji,jj,jk) 
     92               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprcaca 
     93               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca 
     94               tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca 
     95#if defined key_kriest 
     96               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortp 
     97               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + ztortp * xkr_nnano + zrespp * xkr_ndiat 
     98               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zmortp * zfactfe 
     99#else 
     100               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zfracal * zmortp 
     101               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + ( 1. - zfracal ) * zmortp 
     102               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ( 1. - zfracal ) * zmortp * zfactfe 
     103               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zfracal * zmortp * zfactfe 
     104#endif 
    84105            END DO 
    85106         END DO 
    86107      END DO 
    87108      ! 
     109       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     110         WRITE(charout, FMT="('nano')") 
     111         CALL prt_ctl_trc_info(charout) 
     112         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     113       ENDIF 
     114 
    88115   END SUBROUTINE p4z_nano 
    89116 

  • branches/dev_001_GM/NEMO/TOP_SRC/PISCES/p4zopt.F90

    r775 r858  
    9191      END DO 
    9292 
     93!CDIR NOVERRCHK 
    9394      DO jj = 1,jpj 
     95!CDIR NOVERRCHK 
    9496         DO ji = 1,jpi 
    9597 
    … …  
    108110      END DO 
    109111 
     112!CDIR NOVERRCHK 
    110113      DO jk = 2, jpkm1 
     114!CDIR NOVERRCHK 
    111115          DO jj = 1, jpj 
     116!CDIR NOVERRCHK 
    112117            DO ji = 1, jpi 
    113118 
    … …  
    131136 
    132137      etot(:,:,:) = ze1(:,:,:) + ze2(:,:,:) + ze3(:,:,:) 
     138      enano(:,:,:) = 2.1 * ze1(:,:,:) + 0.42 * ze2(:,:,:) + 0.4 * ze3(:,:,:) 
     139      ediat(:,:,:) = 1.6 * ze1(:,:,:) + 0.69 * ze2(:,:,:) + 0.7 * ze3(:,:,:) 
     140 
    133141 
    134142      IF( ln_qsr_sms ) THEN 
    … …  
    137145!   ------------------------------------------------------------------------------ 
    138146 
    139          DO jj = 1, jpj 
     147!CDIR NOVERRCHK 
     148         DO jj = 1, jpj 
     149!CDIR NOVERRCHK 
    140150            DO ji = 1, jpi 
    141151 
    … …  
    155165         END DO 
    156166 
     167!CDIR NOVERRCHK 
    157168         DO jk = 2, jpkm1 
     169!CDIR NOVERRCHK 
    158170            DO jj = 1, jpj 
     171!CDIR NOVERRCHK 
    159172               DO ji = 1, jpi 
    160173 
    … …  
    162175!     ------------------------------------------------- 
    163176 
    164                   zblight1 = zekb(ji,jj,jk-1) * fse3t(ji,jj,jk-1) 
    165                   zglight1 = zekg(ji,jj,jk-1) * fse3t(ji,jj,jk-1) 
    166                   zrlight1 = zekr(ji,jj,jk-1) * fse3t(ji,jj,jk-1) 
     177                  zblight = zekb(ji,jj,jk-1) * fse3t(ji,jj,jk-1) 
     178                  zglight = zekg(ji,jj,jk-1) * fse3t(ji,jj,jk-1) 
     179                  zrlight = zekr(ji,jj,jk-1) * fse3t(ji,jj,jk-1) 
    167180 
    168181                  ze3lum(ji,jj,jk) = ze3lum(ji,jj,jk-1) * EXP( -zblight ) 
    … …  
    182195!     --------------------------------- 
    183196     
    184       zmeu(:,:) = 300.e0 
     197      heup(:,:) = 300.e0 
    185198 
    186199      DO jk = 2, jpkm1 
    187200         DO jj = 1, jpj 
    188201            DO ji = 1, jpi 
    189                IF( etot(ji,jj,jk) >= 0.0043 * qsr(ji,jj) )   zmeu(ji,jj) = fsdepw(ji,jj,jk+1) 
    190             END DO 
    191          END DO 
    192       END DO 
    193  
    194       zmeu(:,:) = MIN( 300., zmeu(:,:) ) 
     202               IF( etot(ji,jj,jk) >= 0.0043 * qsr(ji,jj) )   heup(ji,jj) = fsdepw(ji,jj,jk+1) 
     203            END DO 
     204         END DO 
     205      END DO 
     206 
     207      heup(:,:) = MIN( 300., heup(:,:) ) 
    195208 
    196209!    Computation of the mean light over the mixed layer depth 
    … …  
    224237      END DO 
    225238 
     239 
    226240# if defined key_trc_diaadd 
    227       trc2d(:,:,11) = zmeu(:,:) 
     241      trc2d(:,:,11) = heup(:,:) 
    228242# endif 
    229243      ! 

  • branches/dev_001_GM/NEMO/TOP_SRC/PISCES/p4zprg.F90

    r775 r858  
    2525   USE p4zlys          !  
    2626   USE p4zflx          !  
    27     
     27 
    2828   IMPLICIT NONE 
    2929   PRIVATE 
    … …  
    5454      INTEGER ::   jnt, jn 
    5555      INTEGER ::   iyy, imm, idd 
     56 
     57 
    5658      !!--------------------------------------------------------------------- 
    5759 
    … …  
    7476      DO jnt = 1, nrdttrc             ! ??? 
    7577         ! 
    76          CALL p4z_bio          ! Compute soft tissue production (POC) 
     78         CALL p4z_bio ( kt )         ! Compute soft tissue production (POC) 
     79 
    7780 
    7881         CALL p4z_sed          ! compute soft tissue remineralisation 
     82 
    7983         ! 
    8084         trb(:,:,:,:) = trn(:,:,:,:) 
    … …  
    8488      CALL p4z_lys             ! Compute CaCO3 saturation 
    8589 
    86       CALL p4z_flx             ! Compute surface fluxes 
     90      CALL p4z_flx( kt )             ! Compute surface fluxes 
    8791 
    88       DO jn = 1, jptra 
     92 
     93      DO jn = jp_pcs0, jp_pcs1 
    8994        CALL lbc_lnk( trn(:,:,:,jn), 'T', 1. ) 
    9095        CALL lbc_lnk( trb(:,:,:,jn), 'T', 1. ) 

  • branches/dev_001_GM/NEMO/TOP_SRC/PISCES/p4zprod.F90

    r775 r858  
    1717   USE sms             !  
    1818   USE p4zday          ! 
    19     
     19   USE prtctl_trc 
     20 
    2021   IMPLICIT NONE 
    2122   PRIVATE 
    … …  
    2324   PUBLIC   p4z_prod    ! called in p4zbio.F90 
    2425 
     26    
    2527   !!* Substitution 
    2628#  include "domzgr_substitute.h90" 
    … …  
    3335CONTAINS 
    3436 
    35    SUBROUTINE p4z_prod 
     37   SUBROUTINE p4z_prod( kt ) 
    3638      !!--------------------------------------------------------------------- 
    3739      !!                     ***  ROUTINE p4z_prod  *** 
    … …  
    4244      !! ** Method  : - ??? 
    4345      !!--------------------------------------------------------------------- 
    44       INTEGER  ::   ji, jj, jk 
    45       REAL(wp) ::   zsilfac, zfact 
     46      INTEGER, INTENT(in) :: kt 
     47      INTEGER  ::   ji, jj, jk, nspyr 
     48      REAL(wp) ::   zsilfac, zfact, zrfact2 
    4649      REAL(wp) ::   zprdiachl, zprbiochl, zsilim, ztn, zadap, zadap2 
    47       REAL(wp) ::   zlim, zsilfac2, zsiborn, zprod 
    48       REAL(wp) ::   zmxltst, zmxlday, zlim1 
    49       REAL(wp), DIMENSION(jpi,jpj)     ::   zmixnano , zmixdiat 
    50       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zpislopen, zpislope2n 
    51       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zsopt    , zpislopead 
    52       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zprdia   , zprbio 
    53       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zetot2   , zpislopead2 
     50      REAL(wp) ::   zlim, zsilfac2, zsiborn, zprod, zetot2, zmax, zproreg, zproreg2 
     51      REAL(wp) ::   zmxltst, zmxlday, zlim1, zexcret, zexcret2 
     52      REAL(wp) ::   zpislopen  , zpislope2n 
     53      REAL(wp), DIMENSION(jpi,jpj)     ::   zmixnano   , zmixdiat 
     54      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zpislopead , zpislopead2 
     55      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zprdia     , zprbio, zysopt 
     56      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zprorca    , zprorca2, zprorca4 
     57      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zprorca5   , zprorca6, zprorca7 
     58      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zpronew    , zpronew2 
     59      CHARACTER (len=25) :: charout 
    5460      !!--------------------------------------------------------------------- 
     61 
     62      zprorca (:,:,:) = 0.0 
     63      zprorca2(:,:,:) = 0.0 
     64      zprorca4(:,:,:) = 0.0 
     65      zprorca5(:,:,:) = 0.0 
     66      zprorca6(:,:,:) = 0.0 
     67      zprorca7(:,:,:) = 0.0 
     68      zpronew (:,:,:) = 0.0 
     69      zpronew2(:,:,:) = 0.0 
     70      zprdia  (:,:,:) = 0.0 
     71      zprbio  (:,:,:) = 0.0 
     72      zysopt  (:,:,:) = 0.0 
     73 
     74      nspyr  = INT( raass / rdt ) 
     75 
     76      zexcret  = 1. - excret 
     77      zexcret2 = 1. - excret2 
    5578 
    5679!     Computation of the optimal production 
    … …  
    6588      CALL p4z_day       ! Computation of the day length 
    6689 
    67  
    68       DO jk = 1, jpkm1 
    69          DO jj = 1, jpj 
     90!CDIR NOVERRCHK 
     91      DO jk = 1, jpkm1 
     92!CDIR NOVERRCHK 
     93         DO jj = 1, jpj 
     94!CDIR NOVERRCHK 
    7095            DO ji = 1, jpi 
    7196 
    7297!      Computation of the P-I slope for nanos and diatoms 
    7398!      -------------------------------------------------- 
    74  
    75                ztn    = MAX( 0., tn(ji,jj,jk) - 15. ) 
    76                zadap  = 1.+ 2.* ztn / ( 2.+ ztn ) 
    77                zadap2 = 1.e0 
    78  
    79                zfact  = EXP( -0.21 * emoy(ji,jj,jk) ) 
    80  
    81                zpislopead (ji,jj,jk) = pislope  * ( 1.+ zadap  * zfact ) 
    82                zpislopead2(ji,jj,jk) = pislope2 * ( 1.+ zadap2 * zfact ) 
    83  
    84                zpislopen(ji,jj,jk) = zpislopead(ji,jj,jk) * trn(ji,jj,jk,jpnch)               & 
    85                   &                / ( trn(ji,jj,jk,jpphy) * 12.                   + rtrn )   & 
    86                   &                / ( prmax(ji,jj,jk) * rjjss * xlimphy(ji,jj,jk) + rtrn ) 
    87  
    88                zpislope2n(ji,jj,jk) = zpislopead2(ji,jj,jk) * trn(ji,jj,jk,jpdch)              & 
    89                   &                 / ( trn(ji,jj,jk,jpdia) * 12.                   + rtrn )   & 
    90                   &                 / ( prmax(ji,jj,jk) * rjjss * xlimdia(ji,jj,jk) + rtrn ) 
    91  
    92             END DO 
    93          END DO 
    94       END DO 
    95  
    96       DO jk = 1, jpkm1 
    97          DO jj = 1, jpj 
    98             DO ji = 1, jpi 
     99                IF( etot(ji,jj,jk) > 1.E-3 ) THEN 
     100                   ztn    = MAX( 0., tn(ji,jj,jk) - 15. ) 
     101                   zadap  = 0.+ 1.* ztn / ( 2.+ ztn ) 
     102                   zadap2 = 0.e0 
     103 
     104                   zfact  = EXP( -0.21 * emoy(ji,jj,jk) ) 
     105 
     106                   zpislopead (ji,jj,jk) = pislope  * ( 1.+ zadap  * zfact ) 
     107                   zpislopead2(ji,jj,jk) = pislope2 * ( 1.+ zadap2 * zfact ) 
     108 
     109                   zpislopen = zpislopead(ji,jj,jk) * trn(ji,jj,jk,jpnch)               & 
     110                     &         / ( trn(ji,jj,jk,jpphy) * 12.                   + rtrn )   & 
     111                     &         / ( prmax(ji,jj,jk) * rjjss * xlimphy(ji,jj,jk) + rtrn ) 
     112 
     113                   zpislope2n = zpislopead2(ji,jj,jk) * trn(ji,jj,jk,jpdch)              & 
     114                     &          / ( trn(ji,jj,jk,jpdia) * 12.                   + rtrn )   & 
     115                     &          / ( prmax(ji,jj,jk) * rjjss * xlimdia(ji,jj,jk) + rtrn ) 
    99116 
    100117!     Computation of production function 
    101118!     ---------------------------------- 
    102119 
    103                zprbio(ji,jj,jk) = prmax(ji,jj,jk) * (  1.- EXP( -zpislopen (ji,jj,jk) * etot(ji,jj,jk) )  ) 
    104                zprdia(ji,jj,jk) = prmax(ji,jj,jk) * (  1.- EXP( -zpislope2n(ji,jj,jk) * etot(ji,jj,jk) )  ) 
    105  
    106             END DO 
    107          END DO 
    108       END DO 
    109  
    110       DO jk = 1, jpkm1 
    111          DO jj = 1, jpj 
    112             DO ji = 1, jpi 
    113  
     120                   zprbio(ji,jj,jk) = prmax(ji,jj,jk) * & 
     121                     &                (  1.- EXP( -zpislopen * enano(ji,jj,jk) )  ) 
     122                   zprdia(ji,jj,jk) = prmax(ji,jj,jk) * & 
     123                     &                (  1.- EXP( -zpislope2n * ediat(ji,jj,jk) )  ) 
     124               ENDIF 
     125            END DO 
     126         END DO 
     127      END DO 
     128 
     129 
     130      DO jk = 1, jpkm1 
     131         DO jj = 1, jpj 
     132            DO ji = 1, jpi 
     133 
     134                IF( etot(ji,jj,jk) > 1.E-3 ) THEN 
    114135!    Si/C of diatoms 
    115136!    ------------------------ 
    … …  
    118139!    to mimic the very high ratios observed in the Southern Ocean (silpot2) 
    119140 
    120                zlim1  = trn(ji,jj,jk,jpsil) / ( trn(ji,jj,jk,jpsil) + xksi1 ) 
    121                zlim   = xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) 
    122  
    123                zsilim = MIN( zprdia(ji,jj,jk)    / ( rtrn + prmax(ji,jj,jk) ),                    & 
     141                  zlim1  = trn(ji,jj,jk,jpsil) / ( trn(ji,jj,jk,jpsil) + xksi1 ) 
     142                  zlim   = xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) 
     143 
     144                  zsilim = MIN( zprdia(ji,jj,jk)    / ( rtrn + prmax(ji,jj,jk) ),                    & 
    124145                  &          trn(ji,jj,jk,jpfer) / ( concdfe(ji,jj,jk) + trn(ji,jj,jk,jpfer) ),   & 
    125146                  &          trn(ji,jj,jk,jppo4) / ( concdnh4 + trn(ji,jj,jk,jppo4) ),            & 
    126147                  &          zlim ) 
    127                zsilfac = 5.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim1 - 0.5 ) )  ) + 1.e0 
    128                zsiborn = MAX( 0.e0, ( trn(ji,jj,jk,jpsil) - 15.e-6 ) ) 
    129                zsilfac2 = 1.+ 3.* zsiborn / ( zsiborn + xksi2 ) 
    130                zsilfac = MIN( 6.4,zsilfac * zsilfac2) 
    131  
    132                zsopt(ji,jj,jk) = grosip * trn(ji,jj,jk,jpsil) / ( trn(ji,jj,jk,jpsil) + xksi1 ) * zsilfac 
    133  
     148                  zsilfac = 5.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim1 - 0.5 ) )  ) + 1.e0 
     149                  zsiborn = MAX( 0.e0, ( trn(ji,jj,jk,jpsil) - 15.e-6 ) ) 
     150                  zsilfac2 = 1.+ 3.* zsiborn / ( zsiborn + xksi2 ) 
     151                  zsilfac = MIN( 6.4,zsilfac * zsilfac2) 
     152                  zysopt(ji,jj,jk) = grosip * zlim1 * zsilfac 
     153 
     154              ENDIF 
    134155            END DO 
    135156         END DO 
    … …  
    142163      DO jj = 1, jpj 
    143164         DO ji = 1, jpi 
    144             zmxltst = MAX( 0.e0, hmld(ji,jj) - zmeu(ji,jj) ) 
     165            zmxltst = MAX( 0.e0, hmld(ji,jj) - heup(ji,jj) ) 
    145166            zmxlday = zmxltst**2 / rjjss 
    146167            zmixnano(ji,jj) = 1.- zmxlday / ( 1.+ zmxlday ) 
    … …  
    163184      END DO 
    164185 
    165       DO jk = 1, jpkm1 
    166          DO jj = 1, jpj 
    167             DO ji = 1, jpi 
     186 
     187      DO jj = 1, jpj 
     188         DO ji = 1, jpi 
    168189 
    169190!      Computation of the maximum light intensity 
    170191!      ------------------------------------------ 
    171                zetot2(ji,jj,jk) = etot(ji,jj,jk) * 24. / ( strn(ji,jj) + rtrn ) 
    172                IF( strn(ji,jj) < 1.e0 )   zetot2(ji,jj,jk) = etot(ji,jj,jk) 
    173  
    174             END DO 
    175          END DO 
    176       END DO 
    177  
    178       DO jk = 1, jpkm1 
    179          DO jj = 1, jpj 
    180             DO ji = 1, jpi 
    181  
     192            IF( strn(ji,jj) < 1.e0 )   strn(ji,jj) = 24. 
     193         END DO 
     194      END DO 
     195 
     196!CDIR NOVERRCHK 
     197      DO jk = 1, jpkm1 
     198!CDIR NOVERRCHK 
     199         DO jj = 1, jpj 
     200!CDIR NOVERRCHK 
     201            DO ji = 1, jpi 
     202 
     203               IF( etot(ji,jj,jk) > 1.E-3 ) THEN 
    182204!     Computation of the various production terms for nanophyto. 
    183205!     ---------------------------------------------------------- 
    184                zpislopen(ji,jj,jk) = zpislopead(ji,jj,jk)          & 
    185                   &                * trn(ji,jj,jk,jpnch) / ( rtrn + trn(ji,jj,jk,jpphy) * 12.)         & 
    186                   &                / ( prmax(ji,jj,jk) * rjjss * MAX( 0.1, xlimphy(ji,jj,jk) ) + rtrn ) 
    187  
    188                zprbiochl = prmax(ji,jj,jk) * (  1.- EXP( -zpislopen(ji,jj,jk) * zetot2(ji,jj,jk) )  ) 
    189  
    190                prorca(ji,jj,jk) = zprbio(ji,jj,jk)  * xlimphy(ji,jj,jk) * trn(ji,jj,jk,jpphy) * rfact2 
    191  
    192                pronew(ji,jj,jk) = prorca(ji,jj,jk) * xnanono3(ji,jj,jk)    & 
     206                  zetot2 = enano(ji,jj,jk) * 24. / ( strn(ji,jj) + rtrn ) 
     207                  zmax = MAX( 0.1, xlimphy(ji,jj,jk) ) 
     208                  zpislopen = zpislopead(ji,jj,jk)          & 
     209                  &         * trn(ji,jj,jk,jpnch) / ( rtrn + trn(ji,jj,jk,jpphy) * 12.)         & 
     210                  &         / ( prmax(ji,jj,jk) * rjjss * zmax + rtrn ) 
     211 
     212                  zprbiochl = prmax(ji,jj,jk) * (  1.- EXP( -zpislopen * zetot2 )  ) 
     213 
     214                  zprorca(ji,jj,jk) = zprbio(ji,jj,jk)  * xlimphy(ji,jj,jk) * trn(ji,jj,jk,jpphy) * rfact2 
     215 
     216                  zpronew(ji,jj,jk) = zprorca(ji,jj,jk) * xnanono3(ji,jj,jk)    & 
    193217                  &             / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn ) 
    194                proreg(ji,jj,jk) = prorca(ji,jj,jk) - pronew(ji,jj,jk) 
    195  
    196                zprod = rjjss * prorca(ji,jj,jk) * zprbiochl * trn(ji,jj,jk,jpphy)   & 
    197                   &                             * MAX( 0.1, xlimphy(ji,jj,jk) ) 
    198  
    199                prorca5(ji,jj,jk) = (fecnm)**2 * zprod / chlcnm            & 
    200                   &              / (  zpislopead(ji,jj,jk) * zetot2(ji,jj,jk) * trn(ji,jj,jk,jpnfe) + rtrn  ) 
    201  
    202                prorca6(ji,jj,jk) = chlcnm * 144. * zprod                  & 
    203                   &              / (  zpislopead(ji,jj,jk) * zetot2(ji,jj,jk) * trn(ji,jj,jk,jpnch) + rtrn  ) 
    204  
    205             END DO 
    206          END DO 
    207       END DO 
    208  
    209       DO jk = 1, jpkm1 
    210          DO jj = 1, jpj 
    211             DO ji = 1, jpi 
    212  
     218                  zprod = rjjss * zprorca(ji,jj,jk) * zprbiochl * trn(ji,jj,jk,jpphy) *zmax 
     219 
     220                  zprorca5(ji,jj,jk) = (fecnm)**2 * zprod / chlcnm            & 
     221                  &              / (  zpislopead(ji,jj,jk) * zetot2 * trn(ji,jj,jk,jpnfe) + rtrn ) 
     222 
     223                  zprorca6(ji,jj,jk) = chlcnm * 144. * zprod                  & 
     224                  &              / (  zpislopead(ji,jj,jk) * zetot2 * trn(ji,jj,jk,jpnch) + rtrn  ) 
     225               ENDIF 
     226            END DO 
     227         END DO 
     228      END DO 
     229 
     230!CDIR NOVERRCHK 
     231      DO jk = 1, jpkm1 
     232!CDIR NOVERRCHK 
     233         DO jj = 1, jpj 
     234!CDIR NOVERRCHK 
     235            DO ji = 1, jpi 
     236               IF( etot(ji,jj,jk) > 1.E-3 ) THEN 
    213237!       Computation of the various production terms for diatoms 
    214238!       ------------------------------------------------------- 
    215                zpislope2n(ji,jj,jk) = zpislopead2(ji,jj,jk) * trn(ji,jj,jk,jpdch)        & 
    216                   &                 / ( rtrn + trn(ji,jj,jk,jpdia) * 12.)        & 
    217                   &                 / ( prmax(ji,jj,jk) * rjjss * MAX( 0.1, xlimdia(ji,jj,jk) ) + rtrn ) 
    218  
    219                zprdiachl = prmax(ji,jj,jk) * (  1.- EXP( -zetot2(ji,jj,jk) * zpislope2n(ji,jj,jk) )  ) 
    220  
    221                prorca2(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * trn(ji,jj,jk,jpdia) * rfact2 
    222  
    223                pronew2(ji,jj,jk) = prorca2(ji,jj,jk) * xdiatno3(ji,jj,jk)     & 
     239                  zetot2 = ediat(ji,jj,jk) * 24. / ( strn(ji,jj) + rtrn ) 
     240                  zmax = MAX( 0.1, xlimdia(ji,jj,jk) ) 
     241                  zpislope2n = zpislopead2(ji,jj,jk) * trn(ji,jj,jk,jpdch)        & 
     242                  &           / ( rtrn + trn(ji,jj,jk,jpdia) * 12.)        & 
     243                  &           / ( prmax(ji,jj,jk) * rjjss * zmax + rtrn ) 
     244 
     245                  zprdiachl = prmax(ji,jj,jk) * (  1.- EXP( -zetot2 * zpislope2n )  ) 
     246 
     247                  zprorca2(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * trn(ji,jj,jk,jpdia) * rfact2 
     248 
     249                  zpronew2(ji,jj,jk) = zprorca2(ji,jj,jk) * xdiatno3(ji,jj,jk)     & 
    224250                  &              / ( xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) + rtrn ) 
    225                proreg2(ji,jj,jk) = prorca2(ji,jj,jk) - pronew2(ji,jj,jk) 
    226                prorca3(ji,jj,jk) = prorca2(ji,jj,jk) * zsopt(ji,jj,jk) 
    227  
    228                zprod=rjjss * prorca2(ji,jj,jk) * zprdiachl * trn(ji,jj,jk,jpdia) * MAX( 0.1, xlimdia(ji,jj,jk) ) 
    229  
    230                prorca4(ji,jj,jk) = (fecdm)**2 * zprod / chlcdm                   & 
    231                   &              / ( zpislopead2(ji,jj,jk) * zetot2(ji,jj,jk) * trn(ji,jj,jk,jpdfe) + rtrn ) 
    232  
    233                prorca7(ji,jj,jk) = chlcdm * 144. * zprod       & 
    234                   &              / ( zpislopead2(ji,jj,jk) * zetot2(ji,jj,jk) * trn(ji,jj,jk,jpdch) + rtrn ) 
    235  
     251 
     252                  zprod = rjjss * zprorca2(ji,jj,jk) * zprdiachl * trn(ji,jj,jk,jpdia) * zmax 
     253 
     254                  zprorca4(ji,jj,jk) = (fecdm)**2 * zprod / chlcdm                   & 
     255                  &              / ( zpislopead2(ji,jj,jk) * zetot2 * trn(ji,jj,jk,jpdfe) + rtrn ) 
     256 
     257                  zprorca7(ji,jj,jk) = chlcdm * 144. * zprod       & 
     258                  &              / ( zpislopead2(ji,jj,jk) * zetot2 * trn(ji,jj,jk,jpdch) + rtrn ) 
     259 
     260               ENDIF 
    236261            END DO 
    237262         END DO 
    238263      END DO 
    239264      ! 
     265 
     266! 
     267!   Update the arrays TRA which contain the biological sources and sinks 
     268!   -------------------------------------------------------------------- 
     269 
     270      DO jk = 1, jpkm1 
     271         DO jj = 1, jpj 
     272           DO ji =1 ,jpi 
     273              zproreg  = zprorca(ji,jj,jk) - zpronew(ji,jj,jk) 
     274              zproreg2 = zprorca2(ji,jj,jk) - zpronew2(ji,jj,jk) 
     275              tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - zprorca(ji,jj,jk) - zprorca2(ji,jj,jk) 
     276              tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - zpronew(ji,jj,jk) - zpronew2(ji,jj,jk) 
     277              tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zproreg - zproreg2 
     278              tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zprorca(ji,jj,jk) * zexcret 
     279              tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) + zprorca6(ji,jj,jk) * zexcret 
     280              tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) + zprorca5(ji,jj,jk) * zexcret 
     281              tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) + zprorca2(ji,jj,jk) * zexcret2 
     282              tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) + zprorca7(ji,jj,jk) * zexcret2 
     283              tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) + zprorca4(ji,jj,jk) * zexcret2 
     284              tra(ji,jj,jk,jpbsi) = tra(ji,jj,jk,jpbsi) + zprorca2(ji,jj,jk) * zysopt(ji,jj,jk) * zexcret2 
     285              tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + & 
     286              &                     excret2 * zprorca2(ji,jj,jk) + excret * zprorca(ji,jj,jk) 
     287              tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2ut * ( zproreg + zproreg2) & 
     288              &                    + ( o2ut + o2nit ) * ( zpronew(ji,jj,jk) + zpronew2(ji,jj,jk) ) 
     289              tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) & 
     290              &                     - zexcret * zprorca5(ji,jj,jk) - zexcret2 * zprorca4(ji,jj,jk) 
     291              tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) & 
     292              &                     - zexcret2 * zprorca2(ji,jj,jk) * zysopt(ji,jj,jk) 
     293              tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprorca(ji,jj,jk) - zprorca2(ji,jj,jk) 
     294              tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) & 
     295              &                    + rno3 * ( zpronew(ji,jj,jk) + zpronew2(ji,jj,jk) ) 
     296          END DO 
     297        END DO 
     298     END DO 
     299 
     300 
     301     DO jk = 1, jpkm1 
     302        DO jj = 1, jpj 
     303          DO ji = 1, jpi 
     304             qcumul(2) = qcumul(2) + ( zprorca(ji,jj,jk) + zprorca2(ji,jj,jk) )  & 
     305             &                       * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) * tmask_i(ji,jj) 
     306          END DO 
     307        END DO 
     308      END DO 
     309 
     310      IF( MOD( kt, nspyr ) == 0 ) THEN 
     311        WRITE(numout,*) 'Total PP :' 
     312        WRITE(numout,*) '-------------------- : ',qcumul(2)*12./1E12 
     313        WRITE(numout,*) '(GtC/an)' 
     314        qcumul(2) = 0. 
     315      ENDIF 
     316 
     317#if defined key_trc_dia3d 
     318      zrfact2 = 1.e3 * rfact2r 
     319!   Supplementary diagnostics 
     320!   ------------------------- 
     321      trc3d(:,:,:,4)  = etot(:,:,:) 
     322      trc3d(:,:,:,5)  = zprorca(:,:,:)  * zrfact2 
     323      trc3d(:,:,:,6)  = zprorca2(:,:,:) * zrfact2 
     324      trc3d(:,:,:,7)  = zpronew(:,:,:)  * zrfact2 
     325      trc3d(:,:,:,8)  = zpronew2(:,:,:) * zrfact2 
     326      trc3d(:,:,:,9)  = zprorca2(:,:,:) * zysopt(:,:,:) * zrfact2 
     327      trc3d(:,:,:,10) = zprorca4(:,:,:) * zrfact2 
     328#if ! defined key_kriest 
     329      trc3d(:,:,:,11) = zprorca5(:,:,:) * zrfact2 
     330#endif 
     331#endif 
     332 
     333       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     334         WRITE(charout, FMT="('prod')") 
     335         CALL prt_ctl_trc_info(charout) 
     336         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     337       ENDIF 
     338 
    240339   END SUBROUTINE p4z_prod 
    241340 

  • branches/dev_001_GM/NEMO/TOP_SRC/PISCES/p4zrem.F90

    r775 r858  
    1717   USE trp_trc         !  
    1818   USE sms             !  
     19   USE prtctl_trc 
    1920 
    2021   IMPLICIT NONE 
    … …  
    4546      REAL(wp) ::   zkeq  , zfeequi, zsiremin 
    4647      REAL(wp) ::   zsatur, zsatur2, znusil 
    47       REAL(wp) ::   zlamfac, zstep 
     48      REAL(wp) ::   zbactfer, zorem, zorem2, zofer, zofer2 
     49      REAL(wp) ::   zosil, zdenom, zdenom1, zdenom2, zscave, zaggdfe 
     50      REAL(wp) ::   zlamfac, zstep, zonitr 
    4851      REAL(wp), DIMENSION(jpi,jpj)     ::   ztempbac 
    49       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdepbac, zfesatur 
     52      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdepbac, zfesatur, zolimi 
     53      CHARACTER (len=25) :: charout 
     54 
    5055      !!--------------------------------------------------------------------- 
    5156 
    … …  
    8590      nitrfac(:,:,:) = MIN( 1., nitrfac(:,:,:) ) 
    8691 
     92 
    8793      DO jk = 1, jpkm1 
    8894         DO jj = 1, jpj 
    … …  
    102108!     Ammonification in oxic waters with oxygen consumption 
    103109!     ----------------------------------------------------- 
    104                olimi(ji,jj,jk) = MIN(  ( trn(ji,jj,jk,jpoxy) - rtrn ) / o2ut,                     & 
     110               zolimi(ji,jj,jk) = MIN(  ( trn(ji,jj,jk,jpoxy) - rtrn ) / o2ut,  & 
    105111                  &                    zremik * ( 1.- nitrfac(ji,jj,jk) ) * trn(ji,jj,jk,jpdoc)  )  
    106112 
    107113!     Ammonification in suboxic waters with denitrification 
    108114!     ------------------------------------------------------- 
    109                denitr(ji,jj,jk) = MIN(  ( trn(ji,jj,jk,jpno3) - rtrn ) / rdenit,           & 
     115               denitr(ji,jj,jk) = MIN(  ( trn(ji,jj,jk,jpno3) - rtrn ) / rdenit,   & 
    110116                  &                     zremik * nitrfac(ji,jj,jk) * trn(ji,jj,jk,jpdoc)  ) 
    111117            END DO 
    … …  
    113119      END DO 
    114120 
    115       olimi (:,:,:) = MAX( 0.e0, olimi (:,:,:) ) 
    116       denitr(:,:,:) = MAX( 0.e0, denitr(:,:,:) ) 
     121      zolimi (:,:,:) = MAX( 0.e0, zolimi (:,:,:) ) 
     122      denitr (:,:,:) = MAX( 0.e0, denitr (:,:,:) ) 
    117123 
    118124      DO jk = 1, jpkm1 
    … …  
    123129!    below 2 umol/L. Inhibited at strong light  
    124130!    ---------------------------------------------------------- 
    125                onitr(ji,jj,jk) = nitrif * zstep * trn(ji,jj,jk,jpnh4) / ( 1.+ emoy(ji,jj,jk) )     & 
    126 # if defined key_off_degrad 
    127                   &            * facvol(ji,jj,jk)              & 
    128 # endif 
    129                   &            * ( 1.- nitrfac(ji,jj,jk) ) 
    130             END DO 
    131          END DO 
    132       END DO 
     131               zonitr  = nitrif * zstep * trn(ji,jj,jk,jpnh4) / ( 1.+ emoy(ji,jj,jk) )     & 
     132# if defined key_off_degrad 
     133                  &      * facvol(ji,jj,jk)              & 
     134# endif 
     135                  &      * ( 1.- nitrfac(ji,jj,jk) ) 
     136 
     137! 
     138!   Update of the tracers trends 
     139!   ---------------------------- 
     140 
     141              tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zonitr 
     142              tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zonitr 
     143              tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2nit * zonitr 
     144              tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - rno3  * zonitr 
     145 
     146            END DO 
     147         END DO 
     148      END DO 
     149 
     150       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     151         WRITE(charout, FMT="('rem1')") 
     152         CALL prt_ctl_trc_info(charout) 
     153         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     154       ENDIF 
    133155 
    134156      DO jk = 1, jpkm1 
    … …  
    141163!    significant 
    142164!    ---------------------------------------------------------- 
    143                xbactfer(ji,jj,jk) = 15.e-6 * rfact2 * 4.* 0.4 * prmax(ji,jj,jk)           & 
     165               zbactfer = 15.e-6 * rfact2 * 4.* 0.4 * prmax(ji,jj,jk)           & 
    144166                  &               * ( xlimphy(ji,jj,jk) * zdepbac(ji,jj,jk))**2           & 
    145167                  &                  / ( xkgraz2 + zdepbac(ji,jj,jk) )                    & 
    146168                  &                  * ( 0.5 + SIGN( 0.5, trn(ji,jj,jk,jpfer) -2.e-11 )  ) 
    147169 
    148             END DO 
    149          END DO 
    150       END DO 
     170               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zbactfer 
     171#if defined key_kriest 
     172               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zbactfer 
     173#else 
     174               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zbactfer 
     175#endif 
     176 
     177            END DO 
     178         END DO 
     179      END DO 
     180 
     181       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     182         WRITE(charout, FMT="('rem2')") 
     183         CALL prt_ctl_trc_info(charout) 
     184         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     185       ENDIF 
    151186 
    152187      DO jk = 1, jpkm1 
    … …  
    167202!    means a disaggregation constant about 0.5 the value in oxic zones 
    168203!    ----------------------------------------------------------------- 
    169                orem (ji,jj,jk) = zremip * trn(ji,jj,jk,jppoc) 
    170                ofer (ji,jj,jk) = zremip * trn(ji,jj,jk,jpsfe) 
     204               zorem = zremip * trn(ji,jj,jk,jppoc) 
     205               zofer = zremip * trn(ji,jj,jk,jpsfe) 
    171206#if ! defined key_kriest 
    172                orem2(ji,jj,jk) = zremip * trn(ji,jj,jk,jpgoc) 
    173                ofer2(ji,jj,jk) = zremip * trn(ji,jj,jk,jpbfe) 
    174 #else 
    175                orem2(ji,jj,jk) = zremip * trn(ji,jj,jk,jpnum) 
    176 #endif 
    177             END DO 
    178          END DO 
    179       END DO 
     207               zorem2 = zremip * trn(ji,jj,jk,jpgoc) 
     208               zofer2 = zremip * trn(ji,jj,jk,jpbfe) 
     209#else 
     210               zorem2 = zremip * trn(ji,jj,jk,jpnum) 
     211#endif 
     212 
     213!  Update the appropriate tracers trends 
     214!  ------------------------------------- 
     215 
     216               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zorem 
     217               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zofer 
     218#if defined key_kriest 
     219               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zorem 
     220               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) - zorem2 
     221               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zofer 
     222#else 
     223               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zorem2 - zorem 
     224               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) - zorem2 
     225               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zofer2 - zofer 
     226               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) - zofer2 
     227#endif 
     228 
     229            END DO 
     230         END DO 
     231      END DO 
     232 
     233       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     234         WRITE(charout, FMT="('rem3')") 
     235         CALL prt_ctl_trc_info(charout) 
     236         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     237       ENDIF 
    180238 
    181239      DO jk = 1, jpkm1 
    … …  
    194252               zsiremin = xsirem * zstep * znusil 
    195253#    endif 
    196                osil(ji,jj,jk) = zsiremin * trn(ji,jj,jk,jpdsi) 
     254               zosil = zsiremin * trn(ji,jj,jk,jpdsi) 
     255 
     256               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zosil 
     257               tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) + zosil 
     258 
    197259               ! 
    198260            END DO 
    … …  
    200262      END DO 
    201263 
     264      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     265         WRITE(charout, FMT="('rem4')") 
     266         CALL prt_ctl_trc_info(charout) 
     267         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     268       ENDIF 
     269 
    202270      zfesatur(:,:,:) = 0.6e-9 
    203  
    204       DO jk = 1, jpkm1 
    205          DO jj = 1, jpj 
    206             DO ji = 1, jpi 
     271!CDIR NOVERRCHK 
     272      DO jk = 1, jpkm1 
     273!CDIR NOVERRCHK 
     274         DO jj = 1, jpj 
     275!CDIR NOVERRCHK 
     276            DO ji = 1, jpi 
     277! 
     278!      Compute de different ratios for scavenging of iron 
     279!      -------------------------------------------------- 
     280 
     281#if  defined key_kriest 
     282               zdenom1 = trn(ji,jj,jk,jppoc) / & 
     283           &           ( trn(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpdsi) + trn(ji,jj,jk,jpcal) + rtrn ) 
     284#else 
     285                zdenom = 1. / ( trn(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpgoc)  & 
     286           &            + trn(ji,jj,jk,jpdsi) + trn(ji,jj,jk,jpcal) + rtrn ) 
     287 
     288                zdenom1 = trn(ji,jj,jk,jppoc) * zdenom 
     289                zdenom2 = trn(ji,jj,jk,jpgoc) * zdenom 
     290#endif 
     291 
    207292 
    208293!     scavenging rate of iron. this scavenging rate depends on the 
    … …  
    222307#endif 
    223308# if defined key_off_degrad 
    224                xscave(ji,jj,jk) = zfeequi * zlam1b * zstep  * facvol(ji,jj,jk) 
     309               zscave = zfeequi * zlam1b * zstep  * facvol(ji,jj,jk) 
    225310# else 
    226                xscave(ji,jj,jk) = zfeequi * zlam1b * zstep 
     311               zscave = zfeequi * zlam1b * zstep 
    227312# endif 
    228313 
    … …  
    236321               zlam1b = (  80.* ( trn(ji,jj,jk,jpdoc) + 35.e-6 )                           & 
    237322                  &     + 698.*   trn(ji,jj,jk,jppoc) + 1.05e4 * trn(ji,jj,jk,jpgoc)  )                    & 
    238                   &   * zdiss(ji,jj,jk) + 1E-4 * (1.-zlamfac)                & 
     323                  &   * xdiss(ji,jj,jk) + 1E-4 * (1.-zlamfac)                & 
    239324                  &   + xlam1 * MAX( 0.e0, ( trn(ji,jj,jk,jpfer) * 1.e9 - 1.)  ) 
    240325#else 
    241326               zlam1b = (  80.* (trn(ji,jj,jk,jpdoc) + 35E-6)           & 
    242327                  &     + 698.*  trn(ji,jj,jk,jppoc)  )                    & 
    243                   &   * zdiss(ji,jj,jk) + 1E-4 * (1.-zlamfac)           & 
     328                  &   * xdiss(ji,jj,jk) + 1E-4 * (1.-zlamfac)           & 
    244329                  &   + xlam1 * MAX( 0.e0, ( trn(ji,jj,jk,jpfer) * 1.e9 - 1.)  ) 
    245330#endif 
    246331 
    247332# if defined key_off_degrad 
    248                xaggdfe(ji,jj,jk) = zlam1b * zstep * 0.5 * ( trn(ji,jj,jk,jpfer) - zfeequi ) * facvol(ji,jj,jk) 
     333               zaggdfe = zlam1b * zstep * 0.5 * ( trn(ji,jj,jk,jpfer) - zfeequi ) * facvol(ji,jj,jk) 
    249334# else 
    250                xaggdfe(ji,jj,jk) = zlam1b * zstep * 0.5 * ( trn(ji,jj,jk,jpfer) - zfeequi ) 
    251 # endif 
     335               zaggdfe = zlam1b * zstep * 0.5 * ( trn(ji,jj,jk,jpfer) - zfeequi ) 
     336# endif 
     337 
     338               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zscave - zaggdfe 
     339 
     340#if defined key_kriest 
     341               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zscave * zdenom1 
     342#else 
     343               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zscave * zdenom1 
     344               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zscave * zdenom2 
     345#endif 
     346 
    252347            END DO 
    253348         END DO 
    254349      END DO 
    255350      ! 
     351 
     352       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     353         WRITE(charout, FMT="('rem5')") 
     354         CALL prt_ctl_trc_info(charout) 
     355         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     356       ENDIF 
     357 
     358!     Update the arrays TRA which contain the biological sources and sinks 
     359!     -------------------------------------------------------------------- 
     360 
     361      DO jk = 1, jpkm1 
     362         tra(:,:,jk,jppo4) = tra(:,:,jk,jppo4) + zolimi(:,:,jk) + denitr(:,:,jk) 
     363         tra(:,:,jk,jpnh4) = tra(:,:,jk,jpnh4) + zolimi(:,:,jk) + denitr(:,:,jk) 
     364         tra(:,:,jk,jpno3) = tra(:,:,jk,jpno3) - denitr(:,:,jk) * rdenit 
     365         tra(:,:,jk,jpdoc) = tra(:,:,jk,jpdoc) - zolimi(:,:,jk) - denitr(:,:,jk) 
     366         tra(:,:,jk,jpoxy) = tra(:,:,jk,jpoxy) - zolimi(:,:,jk) * o2ut 
     367         tra(:,:,jk,jpdic) = tra(:,:,jk,jpdic) + zolimi(:,:,jk) + denitr(:,:,jk) 
     368         tra(:,:,jk,jptal) = tra(:,:,jk,jptal) + denitr(:,:,jk) * rno3 * rdenit 
     369     END DO 
     370 
     371       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     372         WRITE(charout, FMT="('rem6')") 
     373         CALL prt_ctl_trc_info(charout) 
     374         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     375       ENDIF 
     376 
    256377   END SUBROUTINE p4z_rem 
    257378 

  • branches/dev_001_GM/NEMO/TOP_SRC/PISCES/p4zsed.F90

    r775 r858  
    1717   USE sms 
    1818   USE lib_mpp 
     19   USE prtctl_trc 
     20 
    1921 
    2022   IMPLICIT NONE 
    … …  
    5052      REAL(wp), DIMENSION(jpi,jpj)     ::   zsidep 
    5153      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   znitrpot, zirondep 
     54      CHARACTER (len=25) :: charout 
    5255      !!--------------------------------------------------------------------- 
    5356 
    … …  
    221224            DO ji = 2, jpim1 
    222225               zdenitot = zdenitot + denitr(ji,jj,jk) * rdenit * e1t(ji,jj) * e2t(ji,jj)   & 
    223                   &    *fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) * znegtr(ji,jj,jk) 
     226                  &    *fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) * xnegtr(ji,jj,jk) 
    224227            END DO 
    225228         END DO 
    … …  
    231234      ! ------------------------------------------------------------- 
    232235 
     236!CDIR NOVERRCHK 
    233237      DO jk = 1, jpk 
    234          DO jj = 1, jpj 
     238!CDIR NOVERRCHK 
     239         DO jj = 1, jpj 
     240!CDIR NOVERRCHK 
    235241            DO ji = 1, jpi 
    236242               zlim = ( 1.- xnanono3(ji,jj,jk) - xnanonh4(ji,jj,jk) ) 
    … …  
    265271            DO ji = 1, jpi 
    266272# if ! defined key_cfg_1d && ( defined key_orca_r4 || defined key_orca_r2 || defined key_orca_r05 || defined key_orca_r025 ) 
    267                zfact = znitrpot(ji,jj,jk) * zdenitot / znitrpottot 
     273!!               zfact = znitrpot(ji,jj,jk) * zdenitot / znitrpottot 
     274               zfact = znitrpot(ji,jj,jk) * 1.e-7 
    268275# else 
    269276               zfact = znitrpot(ji,jj,jk) * 1.e-7 
    … …  
    285292# endif 
    286293      ! 
     294       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     295         WRITE(charout, FMT="('sed ')") 
     296         CALL prt_ctl_trc_info(charout) 
     297         CALL prt_ctl_trc(tab4d=trn, mask=tmask, clinfo=ctrcnm) 
     298       ENDIF 
     299 
    287300   END SUBROUTINE p4z_sed 
    288301 

  • branches/dev_001_GM/NEMO/TOP_SRC/PISCES/p4zsink.F90

    r775 r858  
    1818   USE sms 
    1919   USE p4zsink2        ! 
     20   USE prtctl_trc 
     21 
    2022 
    2123   IMPLICIT NONE 
    … …  
    4648      INTEGER  ::   iksed 
    4749      REAL(wp) ::   zagg1, zagg2, zagg3, zagg4 
     50      REAL(wp) ::   zagg , zaggfe, zaggdoc, zaggdoc2 
    4851      REAL(wp) ::   zfact, zstep, zwsmax 
    4952#if defined key_trc_dia3d 
    … …  
    5356      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zsinkfer, zsinkfer2 
    5457      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zsinkcal, zsinksil 
     58      CHARACTER (len=25) :: charout 
    5559      !!--------------------------------------------------------------------- 
    5660 
    … …  
    120124            DO ji = 1, jpi 
    121125 
    122                zfact = zstep * zdiss(ji,jj,jk) 
     126               zfact = zstep * xdiss(ji,jj,jk) 
    123127 
    124128!    Part I : Coagulation dependent on turbulence 
    … …  
    155159# endif 
    156160 
    157                xagg  (ji,jj,jk) = zagg1 + zagg2 + zagg3 + zagg4 
    158                xaggfe(ji,jj,jk) = xagg(ji,jj,jk) * trn(ji,jj,jk,jpsfe) / ( trn(ji,jj,jk,jppoc) + rtrn ) 
     161               zagg  = zagg1 + zagg2 + zagg3 + zagg4 
     162               zaggfe = zagg * trn(ji,jj,jk,jpsfe) / ( trn(ji,jj,jk,jppoc) + rtrn ) 
    159163 
    160164!     Aggregation of DOC to small particles 
    161165!     -------------------------------------- 
    162166 
    163                xaggdoc(ji,jj,jk) = ( 80.* trn(ji,jj,jk,jpdoc) + 698. * trn(ji,jj,jk,jppoc) )       & 
    164 # if defined key_off_degrad 
    165                   &              * facvol(ji,jj,jk)                           & 
    166 # endif 
    167                   &              * zfact * trn(ji,jj,jk,jpdoc) 
    168  
    169                xaggdoc2(ji,jj,jk) = 1.05e4 * zfact * trn(ji,jj,jk,jpgoc)   & 
    170 # if defined key_off_degrad 
    171                   &               * facvol(ji,jj,jk)                            & 
     167               zaggdoc = ( 80.* trn(ji,jj,jk,jpdoc) + 698. * trn(ji,jj,jk,jppoc) )       & 
     168# if defined key_off_degrad 
     169                  &      * facvol(ji,jj,jk)                           & 
     170# endif 
     171                  &      * zfact * trn(ji,jj,jk,jpdoc) 
     172 
     173               zaggdoc2 = 1.05e4 * zfact * trn(ji,jj,jk,jpgoc)   & 
     174# if defined key_off_degrad 
     175                  &        * facvol(ji,jj,jk)                            & 
    172176# endif       
    173                   &               * trn(ji,jj,jk,jpdoc) 
     177                  &        * trn(ji,jj,jk,jpdoc) 
     178 
     179               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zagg + zaggdoc 
     180               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zagg + zaggdoc2 
     181               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zaggfe 
     182               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zaggfe 
     183               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zaggdoc - zaggdoc2 
    174184 
    175185            END DO 
    … …  
    187197# endif 
    188198      ! 
     199       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     200         WRITE(charout, FMT="('sink')") 
     201         CALL prt_ctl_trc_info(charout) 
     202         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     203       ENDIF 
     204 
    189205   END SUBROUTINE p4z_sink 
    190206 

  • branches/dev_001_GM/NEMO/TOP_SRC/PISCES/p4zsink2.F90

    r775 r858  
    4747      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   sinktemp   ! ??? 
    4848      !! 
    49       INTEGER  ::   ji, jj, jk 
     49      INTEGER  ::   ji, jj, jk, jnt 
    5050      REAL(wp) ::   zigma,zew,zstep,zign 
    5151      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztraz, zakz 
    52       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zkz  , wstmp2 
     52      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zkz  , zwstmp2 
    5353      !!--------------------------------------------------------------------- 
    5454 
    55       zstep  = rfact2 
     55      zstep  = rfact2 / 2. 
    5656 
    5757      ztraz(:,:,:) = 0.e0 
    … …  
    6161      DO jk = 1, jpkm1 
    6262# if defined key_off_degrad 
    63          wstmp2(:,:,jk+1)=-wstmp(:,:,jk)/rjjss*tmask(:,:,jk+1)*facvol(:,:,jk) 
     63         zwstmp2(:,:,jk+1)=-wstmp(:,:,jk)/rjjss*tmask(:,:,jk+1)*facvol(:,:,jk) 
    6464# else 
    65          wstmp2(:,:,jk+1)=-wstmp(:,:,jk)/rjjss*tmask(:,:,jk+1) 
     65         zwstmp2(:,:,jk+1)=-wstmp(:,:,jk)/rjjss*tmask(:,:,jk+1) 
    6666 
    6767# endif 
    6868      END DO 
    6969  
    70       wstmp2(:,:,1) = 0.e0 
     70      zwstmp2(:,:,1) = 0.e0 
    7171! 
    7272! Vertical advective flux 
    7373!------------------------------- 
    74 ! ... first guess of the slopes 
    75 !   ... interior values 
    76       DO jk = 2, jpkm1 
    77          ztraz(:,:,jk) = (trn(:,:,jk-1,jn) - trn(:,:,jk,jn)) *tmask(:,:,jk) 
    78       END DO 
     74 
     75      DO jnt = 1, 2 
     76 
     77! ... first guess of the slopes interior values 
     78 
     79         DO jk = 2, jpkm1 
     80            ztraz(:,:,jk) = (trn(:,:,jk-1,jn) - trn(:,:,jk,jn)) *tmask(:,:,jk) 
     81         END DO 
     82 
     83         ztraz(:,:,1  ) = 0.0 
     84         ztraz(:,:,jpk) = 0.0 
    7985! 
    8086! slopes 
    81       DO jk=2,jpkm1 
    82          DO jj = 1,jpj 
    83             DO ji = 1, jpi 
    84                zign = 0.5*(sign(1.,ztraz(ji,jj,jk)*ztraz(ji,jj,jk+1))+1) 
    85                zakz(ji,jj,jk) = 0.5*(ztraz(ji,jj,jk) + ztraz(ji,jj,jk+1) ) * zign 
    86             END DO 
    87           END DO 
    88         END DO         
    89 ! 
    90 ! Slopes limitation 
    91       DO jk = 2, jpkm1 
    92          DO jj = 1, jpj 
    93             DO ji = 1, jpi 
    94                zakz(ji,jj,jk) = sign(1.,zakz(ji,jj,jk)) *        & 
    95                   &             min(abs(zakz(ji,jj,jk)),         & 
    96                   &             2.*abs(ztraz(ji,jj,jk+1)),       & 
    97                   &             2.*abs(ztraz(ji,jj,jk))) 
     87         DO jk=2,jpkm1 
     88            DO jj = 1,jpj 
     89               DO ji = 1, jpi 
     90                  zign = 0.25 + SIGN( 0.25,ztraz(ji,jj,jk)*ztraz(ji,jj,jk+1) ) 
     91                  zakz(ji,jj,jk) = (ztraz(ji,jj,jk) + ztraz(ji,jj,jk+1) ) * zign 
     92               END DO 
    9893            END DO 
    9994         END DO 
    100       END DO         
    101  
    102 ! vertical advective flux 
    103       DO jk = 1, jpkm1 
    104          DO jj = 1, jpj       
    105             DO ji = 1, jpi     
    106                zigma = wstmp2(ji,jj,jk+1)*zstep/fse3w(ji,jj,jk+1) 
    107                zew   = wstmp2(ji,jj,jk+1) 
    108                sinktemp(ji,jj,jk+1) = -zew*(trn(ji,jj,jk,jn)                & 
    109                   &                 -0.5*(1+zigma)*zakz(ji,jj,jk))*zstep 
     95         ! 
     96         ! Slopes limitation 
     97         DO jk = 2, jpkm1 
     98            DO jj = 1, jpj 
     99               DO ji = 1, jpi 
     100                  zakz(ji,jj,jk) = SIGN(1.,zakz(ji,jj,jk)) *        & 
     101                     &             MIN(ABS(zakz(ji,jj,jk)),         & 
     102                     &             2.*ABS(ztraz(ji,jj,jk+1)),       & 
     103                     &             2.*ABS(ztraz(ji,jj,jk))) 
     104               END DO 
    110105            END DO 
    111106         END DO 
    112       END DO  
    113 ! 
    114 ! Boundary conditions 
    115       sinktemp(:,:,1  ) = 0.e0 
    116       sinktemp(:,:,jpk) = 0.e0 
     107          
     108         ! vertical advective flux 
     109         DO jk = 1, jpkm1 
     110            DO jj = 1, jpj       
     111               DO ji = 1, jpi     
     112                  zigma = zwstmp2(ji,jj,jk+1)*zstep/fse3w(ji,jj,jk+1) 
     113                  zew   = zwstmp2(ji,jj,jk+1) 
     114                  sinktemp(ji,jj,jk+1) = -zew*(trn(ji,jj,jk,jn)                & 
     115                     &                 -0.5*(1+zigma)*zakz(ji,jj,jk))*zstep 
     116               END DO 
     117            END DO 
     118         END DO 
     119         ! 
     120         ! Boundary conditions 
     121         sinktemp(:,:,1  ) = 0.e0 
     122         sinktemp(:,:,jpk) = 0.e0 
     123          
     124         DO jk=1,jpkm1 
     125            DO jj = 1,jpj 
     126               DO ji = 1, jpi 
     127                  trn(ji,jj,jk,jn) = trn(ji,jj,jk,jn)               & 
     128                     &        + (sinktemp(ji,jj,jk)-sinktemp(ji,jj,jk+1))     & 
     129                     &        /fse3t(ji,jj,jk) 
     130               END DO 
     131            END DO 
     132         END DO 
     133 
     134      ENDDO 
    117135 
    118136      DO jk=1,jpkm1 
    119137         DO jj = 1,jpj 
    120138            DO ji = 1, jpi 
    121                trn(ji,jj,jk,jn) = trn(ji,jj,jk,jn)               & 
    122                   &        + (sinktemp(ji,jj,jk)-sinktemp(ji,jj,jk+1))     & 
    123                   &        /fse3t(ji,jj,jk) 
    124             END DO 
    125          END DO 
    126       END DO 
     139               !  
     140               trb(ji,jj,jk,jn) = trb(ji,jj,jk,jn)      & 
     141               &        + 2.*(sinktemp(ji,jj,jk)-sinktemp(ji,jj,jk+1)) & 
     142               &        /fse3t(ji,jj,jk) 
     143! 
     144          ENDDO 
     145        ENDDO 
     146      ENDDO 
     147! 
     148        trn(:,:,:,jn)   = trb(:,:,:,jn) 
     149        sinktemp(:,:,:) = 2. * sinktemp(:,:,:) 
    127150 
    128       trb(:,:,:,jn) = trn(:,:,:,jn) 
    129151      ! 
    130152   END SUBROUTINE p4z_sink2 

  • branches/dev_001_GM/NEMO/TOP_SRC/PISCES/p4zsink_kriest.F90

    r775 r858  
    2020   USE sms 
    2121   USE p4zsink2 
     22   USE prtctl_trc 
    2223 
    2324   IMPLICIT NONE 
    … …  
    4546      !! ** Method  : - ??? 
    4647      !!--------------------------------------------------------------------- 
    47       INTEGER  ::   ji, jj, jk 
    48       INTEGER  ::   iksed 
    49       REAL(wp) ::   zagg1, zagg2, zagg3, zagg4, zagg5, zaggsi, zaggsh 
    50       REAL(wp) ::   znum , zeps, zfm, zgm, zsm 
    51       REAL(wp) ::   zdiv , zdiv1, zdiv2, zdiv3, zdiv4, zdiv5 
    52       REAL(wp) ::   zval1, zval2, zval3, zval4 
    53       REAL(wp) ::   zstep 
     48      INTEGER  :: ji, jj, jk 
     49      INTEGER  :: iksed 
     50      REAL(wp) :: zagg1, zagg2, zagg3, zagg4, zagg5, zaggsi, zaggsh 
     51      REAL(wp) :: zagg , zaggdoc, znumdoc 
     52      REAL(wp) :: znum , zeps, zfm, zgm, zsm 
     53      REAL(wp) :: zdiv , zdiv1, zdiv2, zdiv3, zdiv4, zdiv5 
     54      REAL(wp) :: zval1, zval2, zval3, zval4 
     55      REAL(wp) :: zstep 
    5456#if defined key_trc_dia3d 
    5557      REAL(wp) ::   zrfact2 
    … …  
    5961      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   sinkfer 
    6062      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   sinkcal, sinksil 
     63      CHARACTER (len=25) :: charout 
     64 
    6165      !!--------------------------------------------------------------------- 
    6266 
    … …  
    184188                     &    ) 
    185189 
    186                   zaggsh = ( zagg1 + zagg2 + zagg3 ) * rfact2 * zdiss(ji,jj,jk) / 1000. 
     190                  zaggsh = ( zagg1 + zagg2 + zagg3 ) * rfact2 * xdiss(ji,jj,jk) / 1000. 
    187191 
    188192!    Aggregation of small into large particles 
    … …  
    213217                  zaggsi = ( zagg4 + zagg5 ) * zstep / 10. 
    214218 
    215                   xagg(ji,jj,jk) = 0.5 * xkr_stick * ( zaggsh + zaggsi ) 
     219                  zagg = 0.5 * xkr_stick * ( zaggsh + zaggsi ) 
    216220 
    217221!     Aggregation of DOC to small particles 
    218222!     -------------------------------------- 
    219223 
    220                   xaggdoc(ji,jj,jk) = (     0.4 * trn(ji,jj,jk,jpdoc)               & 
    221                      &                 + 1018.  * trn(ji,jj,jk,jppoc)  ) * zstep    & 
    222 # if defined key_off_degrad 
    223                      &              * facvol(ji,jj,jk)                              & 
    224 # endif 
    225                      &              * zdiss(ji,jj,jk) * trn(ji,jj,jk,jpdoc) 
     224                  zaggdoc = ( 0.4 * trn(ji,jj,jk,jpdoc)               & 
     225                     &        + 1018.  * trn(ji,jj,jk,jppoc)  ) * zstep    & 
     226# if defined key_off_degrad 
     227                     &        * facvol(ji,jj,jk)                              & 
     228# endif 
     229                     &        * xdiss(ji,jj,jk) * trn(ji,jj,jk,jpdoc) 
     230                       
     231                  znumdoc = trn(ji,jj,jk,jpnum) / ( trn(ji,jj,jk,jppoc) + rtrn ) 
     232                  tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zaggdoc 
     233                  tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zaggdoc * znumdoc - zagg 
     234                  tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zaggdoc 
    226235 
    227236               ENDIF 
    … …  
    246255#    endif 
    247256      ! 
     257       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     258         WRITE(charout, FMT="('sink')") 
     259         CALL prt_ctl_trc_info(charout) 
     260         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     261       ENDIF 
    248262   END SUBROUTINE p4z_sink_kriest 
    249263 

  • branches/dev_001_GM/NEMO/TOP_SRC/PISCES/sms_pisces.h90

    r852 r858  
    1515   !! Variable for chemistry of the CO2 cycle 
    1616   !! --------------------------------------------------------------------- 
    17    REAL(wp) ::   atcco2, atcox 
     17   REAL(wp) ::   atcco2 
    1818   ! 
    1919   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   akb3, ak13, ak23, aksp, akw3             !: ??? 
    20    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   akp13, akp23, akp33, aksi3, aks3, akf3   !: ??? 
    2120   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   hi, borat                                !: ??? 
     21   REAL, DIMENSION(2) :: qcumul 
    2222 
    2323   !!---------------------------------------------------------------------- 
    2424   !!  Variable for chemistry of the CO2 cycle 
    2525   !! --------------------------------------------------------------------- 
    26    REAL(wp), DIMENSION(10) ::   devk1, devk2, devk3, devk4, devk5      
    2726   ! 
    28    REAL(wp) ::   akcc1, akcc2, akcc3, akcc4,akcc5, akcc6, akcc7, akcc8, akcc9     !: ??? 
    29    REAL(wp) ::   bor1, bor2, c00, c01, c02, c03, c04, c05, c10, c11               !: ??? 
    30    REAL(wp) ::   c12, c13, c20, c21, c22, c23, cb0, cb1, cb2, cb3                 !: ??? 
    31    REAL(wp) ::   cb4, cb5, cb6, cb7, cb8, cb9, cb10, cb11, c14                    !: ??? 
    32    REAL(wp) ::   cw3, cw4, cw5, cw6, cw0, cw1, cw2, ox0, ox1, ox2, ox3, ox4,ox5   !: ??? 
    33    REAL(wp) ::   salchl, rgas, oxyco, ca0, ca1, ca2, ca3, ca4, ca5, ca6           !: ??? 
    34    REAL(wp) ::   cp10, cp11, cp12, cp13, cp14, cp15, cp16, cp20, cp21             !: ??? 
    35    REAL(wp) ::   cp22, cp23, cp24, cp25, cp26, cp30, cp31, cp32, cp33             !: ??? 
    36    REAL(wp) ::   cp34, cp35, cs10, cs11, cs12, cs13, cs14, cs15, cs16             !: ??? 
    37    REAL(wp) ::   cs17, cs18, cs19, cs20, cs21                                     !: ??? 
    38    REAL(wp) ::   st1, st2, ft1, ft2, ks0, ks1, ks2, ks3, ks4, ks5                 !: ??? 
    39    REAL(wp) ::   ks6, ks7, ks8, ks9, ks10, ks11, ks12, kf0, kf1                   !: ??? 
    40    REAL(wp) ::   kf2, kf3, kf4 
    41    ! 
    42    REAL(wp), DIMENSION(jpi,jpj,3) ::   chemc   !: ??? 
     27   REAL(wp), DIMENSION(jpi,jpj,2) ::   chemc   !: ??? 
    4328 
    4429   !!---------------------------------------------------------------------- 
    … …  
    6853   REAL(wp) ::   caco3r, kdca, nca, part, rno3, o2ut, po4r               !: ??? 
    6954   REAL(wp) ::   sco2, dispo0, conc0,sumdepsi,rivalkinput,sedfeinput     !: ??? 
    70    REAL(wp) ::   calcon, rivpo4input,nitdepinput,oxymin,spocri           !: ??? 
     55   REAL(wp) ::   rivpo4input,nitdepinput,oxymin,spocri           !: ??? 
    7156   REAL(wp) ::   nitrif,rdenit,o2nit,concnnh4,concdnh4                   !: ??? 
    7257   REAL(wp) ::   pislope,excret,wsbio,resrat,mprat,wchl,wchld            !: ??? 
    … …  
    8368   !!--------------------------------------------- 
    8469   REAL(wp), DIMENSION(3,61)        ::   xkrgb                 !: ??? 
    85    REAL(wp), DIMENSION(jpi,jpj)     ::   zmeu                  !: ??? 
     70   REAL(wp), DIMENSION(jpi,jpj)     ::   heup                  !: ??? 
    8671   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   etot, etot3, emoy     !: ??? 
     72   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   enano, ediat 
    8773 
    8874!!---------------------------------------------------------- 
    … …  
    9278   ! 
    9379   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   prmax, tgfunc, tgfunc2                       !: ??? 
    94    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   prcaca, prorca, prorca2, prorca3             !: ??? 
    95    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   prorca4, prorca5, prorca6, prorca7           !: ??? 
    96    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   pronew, pronew2, proreg, proreg2             !: ??? 
    9780   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   xnanono3, xdiatno3, xnanonh4, xdiatnh4       !: ??? 
    98    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   xlimphy, xlimdia, concdfe, concnfe, znegtr   !: ??? 
    99  
    100    !!------------------------------------------ 
    101    !! Sinks for phytoplankton 
    102    !!------------------------------------------ 
    103    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   tortp, tortnf, tortnch            !: ??? 
    104    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   respp, respp2, respnch, respdch   !: ??? 
    105    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   tortp2, tortdf, tortdch, tortds   !: ??? 
    106    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   respds, respdf, respnf            !: ??? 
    107  
    108    !!------------------------------------ 
    109    !!  SMS for zooplankton 
    110    !!------------------------------------- 
    111    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   respz, tortz, grazp, grazpf                   !: ??? 
    112    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   grazpch, grazm, grazmf, grazsd                !: ??? 
    113    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   grazsf, grazss, grazsch, grarem               !: ??? 
    114    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   grafer,respz2,tortz2,grazd, grazz,grazn       !: ??? 
    115    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   grazpoc,graznf, graznch, grazs, grazf         !: ??? 
    116    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   grazdch, grazpof, grarem2, grafer2, grapoc2   !: ??? 
    117    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   grapoc, grazffe, grazfff                      !: ??? 
     81   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   xlimphy, xlimdia, concdfe, concnfe, xnegtr   !: ??? 
    11882 
    11983   !!--------------------------------------------- 
    … …  
    12286   REAL(wp) ::   wsbio2 
    12387   ! 
    124    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   xagg, xaggfe, zdiss, xaggdoc, xaggdfe, xbactfer   !: ??? 
    125    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   xscave, olimi, orem, orem2, ofer, ofer2           !: ??? 
    126    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   osil, xaggdoc2, nitrfac, xlimbac                  !: ??? 
     88   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   xdiss, xfracal, nitrfac, xlimbac                  !: ??? 
    12789   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   wsbio4, wsbio3, wscal                             !: ??? 
    12890 
    … …  
    13698   REAL(wp), DIMENSION(jpi,jpj)     ::   dust, cotdep, nitdep, rivinp   !: ??? 
    13799   REAL(wp), DIMENSION(jpi,jpj,12)  ::   dustmo                         !: ??? 
    138    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   onitr, denitr, ironsed         !: ??? 
     100   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   denitr, ironsed         !: ??? 
    139101 
    140102#if defined key_kriest 

  • branches/dev_001_GM/NEMO/TOP_SRC/PISCES/trcctl.pisces.h90

    r855 r858  
    1818   ! ----------------------- 
    1919#if  defined key_kriest 
    20       IF( jptra /= 23) THEN  
     20      IF( jp_pisces /= 23) THEN  
    2121#else 
    22       IF( jptra /= 24) THEN 
     22      IF( jp_pisces /= 24) THEN 
    2323#endif 
    2424          IF (lwp) THEN  
    … …  
    2626              WRITE (numout,*) ' =======   ============= ' 
    2727              WRITE (numout,*)                               & 
    28               &   ' STOP, change jptra',               &  
     28              &   ' STOP, change jp_pisces',               &  
    2929              &   ' in parameter.passivetrc.pisces.h '   
    3030          END IF  

  • branches/dev_001_GM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90

    r853 r858  
    2121   USE oce_trc         ! ocean variables 
    2222   USE trp_trc         ! 
     23   USE p4zche  
     24   USE lbclnk 
    2325 
    2426   USE iom 
    … …  
    2830 
    2931   PUBLIC   trc_ini_pisces   ! called by trcini.F90 module 
     32 
    3033 
    3134#  include "domzgr_substitute.h90" 
    … …  
    295298      o2ut   = 140.     / 122. 
    296299 
    297       !---------------------------------------------------------------------- 
    298       ! Initialize chemical variables  
    299       !---------------------------------------------------------------------- 
    300  
    301       ! set pre-industrial atmospheric [co2] (ppm) and o2/n2 ratio 
    302       ! ---------------------------------------------------------- 
    303       atcox = 0.20946 
    304  
    305       ! Set lower/upper limits for temperature and salinity 
    306       ! --------------------------------------------------- 
    307       salchl = 1.e0 / 1.80655 
    308       calcon = 1.03e-2 
    309  
    310       ! Set coefficients for apparent solubility equilibrium of calcite 
    311       ! Millero et al. 1995 from Mucci 1983 
    312       ! -------------------------------------------------------------- 
    313       akcc1 = -171.9065 
    314       akcc2 =   -0.077993 
    315       akcc3 = 2839.319 
    316       akcc4 =   71.595 
    317       akcc5 =   -0.77712 
    318       akcc6 =    0.0028426 
    319       akcc7 =  178.34 
    320       akcc8 =   -0.07711 
    321       akcc9 =    0.0041249 
    322  
    323       ! Set coefficients for seawater pressure correction 
    324       ! ------------------------------------------------- 
    325       devk1(1) = -25.5 
    326       devk2(1) =   0.1271 
    327       devk3(1) =   0.e0 
    328       devk4(1) =  -3.08E-3 
    329       devk5(1) =   0.0877E-3 
    330       ! 
    331       devk1(2) = -15.82 
    332       devk2(2) =  -0.0219 
    333       devk3(2) =   0.e0 
    334       devk4(2) =   1.13E-3 
    335       devk5(2) =  -0.1475E-3 
    336       ! 
    337       devk1(3) = -29.48 
    338       devk2(3) =   0.1622 
    339       devk3(3) =   2.608E-3 
    340       devk4(3) =  -2.84E-3 
    341       devk5(3) =   0.e0 
    342       ! 
    343       devk1(4) = -14.51 
    344       devk2(4) =   0.1211 
    345       devk3(4) =  -0.321E-3 
    346       devk4(4) =  -2.67E-3 
    347       devk5(4) =   0.0427E-3 
    348       ! 
    349       devk1(5) = -23.12 
    350       devk2(5) =   0.1758 
    351       devk3(5) =  -2.647E-3 
    352       devk4(5) =  -5.15E-3 
    353       devk5(5) =   0.09E-3 
    354       ! 
    355       devk1(6) = -26.57 
    356       devk2(6) =   0.2020 
    357       devk3(6) =  -3.042E-3 
    358       devk4(6) =  -4.08E-3 
    359       devk5(6) =   0.0714E-3 
    360       ! 
    361       devk1(7) = -25.60 
    362       devk2(7) =   0.2324 
    363       devk3(7) =  -3.6246E-3 
    364       devk4(7) =  -5.13E-3 
    365       devk5(7) =   0.0794E-3 
    366       ! 
    367       ! For calcite with Edmond and Gieske 1970 
    368       !     devkst = 0.23 
    369       !     devks  = 35.4 
    370       ! Millero 95 takes this depth dependance for calcite 
    371       devk1(8) = -48.76 
    372       devk2(8) =   0.5304 
    373       devk3(8) =   0.e0 
    374       devk4(8) = -11.76E-3 
    375       devk5(8) =   0.3692E-3 
    376       ! 
    377       ! Coefficients for sulfate and fluoride 
    378       devk1(9) = -18.03 
    379       devk2(9) =   0.0466 
    380       devk3(9) =   0.316e-3 
    381       devk4(9) =  -4.53e-3 
    382       devk5(9) =   0.09e-3 
    383  
    384       devk1(10) = -9.78 
    385       devk2(10) = -0.0090 
    386       devk3(10) = -0.942e-3 
    387       devk4(10) = -3.91e-3 
    388       devk5(10) =  0.054e-3 
    389  
    390  
    391       ! Set universal gas constants 
    392       ! --------------------------- 
    393       rgas  = 83.143 
    394       oxyco =  1.e0 / 22.4144 
    395  
    396       ! Set boron constants 
    397       ! ------------------- 
    398       bor1 = 0.00023 
    399       bor2 = 1.e0 / 10.82 
    400  
    401       ! Set volumetric solubility constants for co2 in ml/l (Weiss, 1974) 
    402       ! ----------------------------------------------------------------- 
    403       c00 = -60.2409 
    404       c01 =  93.4517 
    405       c02 =  23.3585 
    406       c03 =   0.023517 
    407       c04 =  -0.023656 
    408       c05 =   0.0047036 
    409       ! 
    410       ca0 = -162.8301 
    411       ca1 =  218.2968 
    412       ca2 =   90.9241 
    413       ca3 =   -1.47696 
    414       ca4 =    0.025695 
    415       ca5 =   -0.025225 
    416       ca6 =    0.0049867 
    417  
    418       ! Set coeff. for 1. dissoc. of carbonic acid (Edmond and Gieskes, 1970) 
    419       ! --------------------------------------------------------------------- 
    420       c10 = -3670.7 
    421       c11 =    62.008 
    422       c12 =    -9.7944 
    423       c13 =     0.0118 
    424       c14 =    -0.000116 
    425  
    426       ! Set coeff. for 2. dissoc. of carbonic acid (Edmond and Gieskes, 1970) 
    427       ! --------------------------------------------------------------------- 
    428       c20 = -1394.7 
    429       c21 =    -4.777 
    430       c22 =     0.0184 
    431       c23 =    -0.000118 
    432  
    433       ! Set constants for calculate concentrations for sulfate and fluoride 
    434       ! sulfates (Morris & Riley 1966) 
    435       !---------------------------------------------------------------------- 
    436       st1 = 0.14 
    437       st2 = 1.e0 / 96.062 
    438  
    439       ! fluoride 
    440       ! -------- 
    441       ft1 = 0.000067 
    442       ft2 = 1.e0 / 18.9984 
    443  
    444       ! sulfates (Dickson 1990 change to mol:kg soln, idem OCMIP) 
    445       !---------------------------------------------------------- 
    446       ks0  =    141.328 
    447       ks1  =  -4276.1 
    448       ks2  =    -23.093 
    449       ks3  = -13856. 
    450       ks4  =    324.57 
    451       ks5  =    -47.986 
    452       ks6  =  35474. 
    453       ks7  =   -771.54 
    454       ks8  =    114.723 
    455       ks9  =  -2698. 
    456       ks10 =   1776. 
    457       ks11 =      1. 
    458       ks12 =     -0.001005 
    459  
    460       ! fluorides (Dickson & Riley 1979 change to mol/kg soln) 
    461       !------------------------------------------------------- 
    462       kf0 =  -12.641 
    463       kf1 = 1590.2 
    464       kf2 =    1.525 
    465       kf3 =    1.0 
    466       kf4 =   -0.001005 
    467  
    468       ! Set coeff. for 1. dissoc. of boric acid (Edmond and Gieskes, 1970) 
    469       ! ------------------------------------------------------------------ 
    470       cb0  = -8966.90 
    471       cb1  = -2890.53 
    472       cb2  =   -77.942 
    473       cb3  =     1.728 
    474       cb4  =    -0.0996 
    475       cb5  =   148.0248 
    476       cb6  =   137.1942 
    477       cb7  =     1.62142 
    478       cb8  =   -24.4344 
    479       cb9  =   -25.085 
    480       cb10 =    -0.2474 
    481       cb11 =     0.053105 
    482  
    483       ! Set coeff. for dissoc. of water (Dickson and Riley, 1979,  
    484       !   eq. 7, coefficient cw2 corrected from 0.9415 to 0.09415  
    485       !   after pers. commun. to B. Bacastow, 1988) 
    486       ! --------------------------------------------------------- 
    487       cw0 = -13847.26 
    488       cw1 =    148.9652 
    489       cw2 =    -23.6521 
    490       cw3 =    118.67 
    491       cw4 =     -5.977 
    492       cw5 =      1.0495 
    493       cw6 =     -0.01615 
    494  
    495       ! Set coeff. for dissoc. of phosphate (Millero (1974) 
    496       ! --------------------------------------------------- 
    497       cp10 =   115.54 
    498       cp11 = -4576.752 
    499       cp12 =   -18.453 
    500       cp13 =  -106.736 
    501       cp14 =     0.69171 
    502       cp15 =    -0.65643 
    503       cp16 =    -0.01844 
    504       ! 
    505       cp20 =   172.1033 
    506       cp21 = -8814.715 
    507       cp22 =   -27.927 
    508       cp23 =  -160.340 
    509       cp24 =     1.3566 
    510       cp25 =     0.37335 
    511       cp26 =    -0.05778 
    512       ! 
    513       cp30 =   -18.126 
    514       cp31 = -3070.75 
    515       cp32 =    17.27039 
    516       cp33 =     2.81197 
    517       cp34 =   -44.99486 
    518       cp35 =    -0.09984 
    519  
    520       ! Set coeff. for dissoc. of phosphate (Millero (1974) 
    521       ! --------------------------------------------------- 
    522       cs10 =   117.385 
    523       cs11 = -8904.2 
    524       cs12 =   -19.334 
    525       cs13 =  -458.79 
    526       cs14 =     3.5913 
    527       cs15 =   188.74 
    528       cs16 =    -1.5998 
    529       cs17 =   -12.1652 
    530       cs18 =     0.07871 
    531       cs19 =     0.e0 
    532       cs20 =     1.e0 
    533       cs21 =    -0.001005 
    534  
    535  
    536       ! Set volumetric solubility constants for o2 in ml/l (Weiss, 1970) 
    537       ! ---------------------------------------------------------------- 
    538       ox0 = -58.3877 
    539       ox1 =  85.8079 
    540       ox2 =  23.8439 
    541       ox3 =  -0.034892 
    542       ox4 =   0.015568 
    543       ox5 =  -0.0019387 
    544  
    545300      !  FROM THE NEW BIOOPTIC MODEL PROPOSED JM ANDRE, WE READ HERE 
    546301      !  A PRECOMPUTED ARRAY CORRESPONDING TO THE ATTENUATION COEFFICIENT 
    … …  
    554309 
    555310 
    556       CALL p4zche        ! initialize the chemical constants 
     311      CALL p4z_che        ! initialize the chemical constants 
    557312 
    558313 
Note: See TracChangeset for help on using the changeset viewer.