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 2528 for trunk/NEMOGCM/NEMO/TOP_SRC/PISCES – NEMO

Ignore:
Timestamp:
2010-12-27T18:33:53+01:00 (13 years ago)
Author:
rblod
Message:

Update NEMOGCM from branch nemo_v3_3_beta

Location:
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES
Files:
2 deleted
19 edited
1 copied

Legend:

Unmodified
Added
Removed

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zbio.F90

    • Property svn:executable deleted
    r1800 r2528  
    4141#  include "top_substitute.h90" 
    4242   !!---------------------------------------------------------------------- 
    43    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     43   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    4444   !! $Id$  
    45    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     45   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4646   !!---------------------------------------------------------------------- 
    4747 
    … …  
    8484      CALL p4z_sink ( kt, jnt )     ! vertical flux of particulate organic matter 
    8585      CALL p4z_opt  ( kt, jnt )     ! Optic: PAR in the water column 
    86       CALL p4z_lim  ( kt, jnt )     ! co-limitations by the various nutrients 
     86      CALL p4z_lim  ( kt      )     ! co-limitations by the various nutrients 
    8787      CALL p4z_prod ( kt, jnt )     ! phytoplankton growth rate over the global ocean.  
    8888      !                             ! (for each element : C, Si, Fe, Chl ) 
    89       CALL p4z_rem  ( kt, jnt )     ! remineralization terms of organic matter+scavenging of Fe 
    90       CALL p4z_mort ( kt, jnt )     ! phytoplankton mortality 
     89      CALL p4z_rem  ( kt      )     ! remineralization terms of organic matter+scavenging of Fe 
     90      CALL p4z_mort ( kt      )     ! phytoplankton mortality 
    9191      !                             ! zooplankton sources/sinks routines  
    92       CALL p4z_micro( kt, jnt )           ! microzooplankton 
     92      CALL p4z_micro( kt      )           ! microzooplankton 
    9393      CALL p4z_meso ( kt, jnt )           ! mesozooplankton 
    9494 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zche.F90

    • Property svn:executable deleted
    r1800 r2528  
    149149#include "top_substitute.h90" 
    150150   !!---------------------------------------------------------------------- 
    151    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     151   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    152152   !! $Id$  
    153    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     153   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    154154   !!---------------------------------------------------------------------- 
    155155 
    … …  
    181181 
    182182            !                             ! SET ABSOLUTE TEMPERATURE 
    183             ztkel = tn(ji,jj,1) + 273.16 
     183            ztkel = tsn(ji,jj,1,jp_tem) + 273.16 
    184184            zqtt  = ztkel * 0.01 
    185185            zqtt2 = zqtt * zqtt 
    186             zsal  = sn(ji,jj,1) + (1.- tmask(ji,jj,1) ) * 35. 
     186            zsal  = tsn(ji,jj,1,jp_sal) + (1.- tmask(ji,jj,1) ) * 35. 
    187187            zlqtt = LOG( zqtt ) 
    188188 
    … …  
    214214 
    215215               ! SET ABSOLUTE TEMPERATURE 
    216                ztkel   = tn(ji,jj,jk) + 273.16 
     216               ztkel   = tsn(ji,jj,jk,jp_tem) + 273.16 
    217217               zqtt    = ztkel * 0.01 
    218                zsal    = sn(ji,jj,jk) + ( 1.-tmask(ji,jj,jk) ) * 35. 
     218               zsal    = tsn(ji,jj,jk,jp_sal) + ( 1.-tmask(ji,jj,jk) ) * 35. 
    219219               zsqrt  = SQRT( zsal ) 
    220220               zsal15  = zsqrt * zsal 
    … …  
    224224               zis2   = zis * zis 
    225225               zisqrt = SQRT( zis ) 
    226                ztc     = tn(ji,jj,jk) + ( 1.- tmask(ji,jj,jk) ) * 20. 
     226               ztc     = tsn(ji,jj,jk,jp_tem) + ( 1.- tmask(ji,jj,jk) ) * 20. 
    227227 
    228228               ! CHLORINITY (WOOSTER ET AL., 1969) 
    … …  
    249249                  &    + ( cb8 + cb9 * zsqrt + cb10 * zsal ) * zlogt + cb11 * zsqrt * ztkel             & 
    250250                  &    + LOG(  ( 1.+ zst / zcks + zft / zckf ) / ( 1.+ zst / zcks )  ) 
    251 !!gm zsal**2 to be replaced by a *... 
    252                zck1    = c10 * ztr + c11 + c12 * zlogt + c13 * zsal + c14 * zsal**2 
     251 
     252               zck1    = c10 * ztr + c11 + c12 * zlogt + c13 * zsal + c14 * zsal * zsal 
    253253               zck2    = c20 * ztr + c21 + c22 * zsal   + c23 * zsal**2 
    254254 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zflx.F90

    • Property svn:executable deleted
    r1836 r2528  
    2828#endif 
    2929   USE lib_mpp 
     30   USE lib_fortran 
    3031 
    3132   IMPLICIT NONE 
    … …  
    3334 
    3435   PUBLIC   p4z_flx   
    35  
    36    REAL(wp) :: &  ! pre-industrial atmospheric [co2] (ppm)   
    37       atcox  = 0.20946 ,    &  !: 
    38       atcco2 = 278.            !: 
    39  
    40    REAL(wp) :: & 
    41       xconv  = 0.01/3600      !: coefficients for conversion  
    42  
    43    INTEGER  ::  nspyr         !: number of timestep per year 
    44  
    45 #if defined key_cpl_carbon_cycle 
    46    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::  & 
    47       oce_co2            !: ocean carbon flux 
    48    REAL(wp) :: & 
    49       t_atm_co2_flx,  &  !: Total atmospheric carbon flux per year 
    50       t_oce_co2_flx      !: Total ocean carbon flux per year 
    51 #endif 
     36   PUBLIC   p4z_flx_init   
     37 
     38   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::  oce_co2            !: ocean carbon flux  
     39   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::  satmco2            !: atmospheric pco2 
     40   REAL(wp)                             ::  t_oce_co2_flx      !: Total ocean carbon flux  
     41   REAL(wp)                             ::  t_atm_co2_flx      !: global mean of atmospheric pco2 
     42   REAL(wp)                             ::  area               !: ocean surface 
     43   REAL(wp)                             ::  atcco2 = 278.      !: pre-industrial atmospheric [co2] (ppm)     
     44   REAL(wp)                             ::  atcox  = 0.20946   !: 
     45   REAL(wp)                             ::  xconv  = 0.01/3600 !: coefficients for conversion  
    5246 
    5347   !!* Substitution 
    5448#  include "top_substitute.h90" 
    5549   !!---------------------------------------------------------------------- 
    56    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     50   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    5751   !! $Id$  
    58    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     52   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    5953   !!---------------------------------------------------------------------- 
    6054 
    … …  
    7569      REAL(wp) ::   zph, zah2, zbot, zdic, zalk, zsch_o2, zalka, zsch_co2 
    7670      REAL(wp), DIMENSION(jpi,jpj) ::   zkgco2, zkgo2, zh2co3 
    77 #if defined key_trc_diaadd && defined key_iomput 
    78       REAL(wp), DIMENSION(jpi,jpj) ::  zcflx, zoflx, zkg, zdpco2, zdpo2 
     71#if defined key_diatrc && defined key_iomput 
     72      REAL(wp), DIMENSION(jpi,jpj) ::  zoflx, zkg, zdpco2, zdpo2 
    7973#endif 
    8074      CHARACTER (len=25) :: charout 
    8175 
    8276      !!--------------------------------------------------------------------- 
    83  
    84  
    85       IF( kt == nittrc000  )   CALL p4z_flx_init      ! Initialization (first time-step only) 
    8677 
    8778      ! SURFACE CHEMISTRY (PCO2 AND [H+] IN 
    8879      !     SURFACE LAYER); THE RESULT OF THIS CALCULATION 
    8980      !     IS USED TO COMPUTE AIR-SEA FLUX OF CO2 
     81 
     82#if defined key_cpl_carbon_cycle 
     83      satmco2(:,:) = atm_co2(:,:) 
     84#endif 
    9085 
    9186      DO jrorr = 1, 10 
    … …  
    128123!CDIR NOVERRCHK 
    129124         DO ji = 1, jpi 
    130             ztc  = MIN( 35., tn(ji,jj,1) ) 
     125            ztc  = MIN( 35., tsn(ji,jj,1,jp_tem) ) 
    131126            ztc2 = ztc * ztc 
    132127            ztc3 = ztc * ztc2  
    … …  
    138133            ! Compute the piston velocity for O2 and CO2 
    139134            zkgwan = 0.3 * zws  + 2.5 * ( 0.5246 + 0.016256 * ztc + 0.00049946  * ztc2 ) 
    140 # if defined key_off_degrad 
     135# if defined key_degrad 
    141136            zkgwan = zkgwan * xconv * ( 1.- fr_i(ji,jj) ) * tmask(ji,jj,1) * facvol(ji,jj,1) 
    142137#else 
    … …  
    152147         DO ji = 1, jpi 
    153148            ! Compute CO2 flux for the sea and air 
    154 #if ! defined key_cpl_carbon_cycle 
    155             zfld = atcco2 * tmask(ji,jj,1) * chemc(ji,jj,1) * zkgco2(ji,jj) 
     149            zfld = satmco2(ji,jj) * tmask(ji,jj,1) * chemc(ji,jj,1) * zkgco2(ji,jj) 
    156150            zflu = zh2co3(ji,jj) * tmask(ji,jj,1) * zkgco2(ji,jj) 
    157 #else 
    158             zfld = atm_co2(ji,jj) * tmask(ji,jj,1) * chemc(ji,jj,1) * zkgco2(ji,jj) 
    159             zflu = zh2co3(ji,jj) * tmask(ji,jj,1) * zkgco2(ji,jj) 
    160             ! compute flux of carbon 
    161151            oce_co2(ji,jj) = ( zfld - zflu ) * rfact & 
    162152               &             * e1t(ji,jj) * e2t(ji,jj) * tmask(ji,jj,1) * 1000. 
    163 #endif 
     153            ! compute the trend 
    164154            tra(ji,jj,1,jpdic) = tra(ji,jj,1,jpdic) + ( zfld - zflu ) / fse3t(ji,jj,1) 
    165155 
    … …  
    169159            tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy) + ( zfld16 - zflu16 ) / fse3t(ji,jj,1) 
    170160 
    171 #if defined key_trc_diaadd  
     161#if defined key_diatrc  
    172162            ! Save diagnostics 
    173163#  if ! defined key_iomput 
    174             trc2d(ji,jj,jp_pcs0_2d    ) = ( zfld - zflu )     * 1000. * tmask(ji,jj,1) 
     164            zfact = 1. / ( e1t(ji,jj) * e2t(ji,jj) ) / rfact 
     165            trc2d(ji,jj,jp_pcs0_2d    ) = oce_co2(ji,jj) * zfact 
    175166            trc2d(ji,jj,jp_pcs0_2d + 1) = ( zfld16 - zflu16 ) * 1000. * tmask(ji,jj,1) 
    176167            trc2d(ji,jj,jp_pcs0_2d + 2) = zkgco2(ji,jj) * tmask(ji,jj,1) 
    177             trc2d(ji,jj,jp_pcs0_2d + 3) = ( atcco2 - zh2co3(ji,jj) / ( chemc(ji,jj,1) + rtrn ) ) & 
     168            trc2d(ji,jj,jp_pcs0_2d + 3) = ( satmco2(ji,jj) - zh2co3(ji,jj) / ( chemc(ji,jj,1) + rtrn ) ) & 
    178169               &                            * tmask(ji,jj,1) 
    179170#  else 
    180             zcflx(ji,jj) = ( zfld - zflu ) * 1000.  * tmask(ji,jj,1) 
    181171            zoflx(ji,jj) = ( zfld16 - zflu16 ) * 1000. * tmask(ji,jj,1) 
    182172            zkg  (ji,jj) = zkgco2(ji,jj) * tmask(ji,jj,1) 
    183             zdpco2(ji,jj) = ( atcco2 - zh2co3(ji,jj)      / ( chemc(ji,jj,1) + rtrn ) ) & 
    184               &             * tmask(ji,jj,1) 
    185             zdpo2 (ji,jj) = ( atcox  - trn(ji,jj,1,jpoxy) / ( chemc(ji,jj,2) + rtrn ) ) & 
    186               &             * tmask(ji,jj,1) 
     173            zdpco2(ji,jj) = ( satmco2(ji,jj) - zh2co3(ji,jj) / ( chemc(ji,jj,1) + rtrn ) ) * tmask(ji,jj,1) 
     174            zdpo2 (ji,jj) = ( atcox  - trn(ji,jj,1,jpoxy) / ( chemc(ji,jj,2) + rtrn ) ) * tmask(ji,jj,1) 
    187175#  endif 
    188176#endif 
    … …  
    190178      END DO 
    191179 
    192 #if defined key_cpl_carbon_cycle 
    193       ! Total Flux of Carbon 
    194       DO jj = 1, jpj  
    195         DO ji = 1, jpi 
    196            t_atm_co2_flx = t_atm_co2_flx + atm_co2(ji,jj) * tmask_i(ji,jj) 
    197            t_oce_co2_flx = t_oce_co2_flx + oce_co2(ji,jj) * tmask_i(ji,jj) 
    198         END DO 
    199       END DO 
    200  
    201       IF( MOD( kt, nspyr ) == 0 ) THEN 
    202         IF( lk_mpp ) THEN 
    203           CALL mpp_sum( t_atm_co2_flx )   ! sum over the global domain 
    204           CALL mpp_sum( t_oce_co2_flx )   ! sum over the global domain 
    205         ENDIF 
    206         ! Conversion in GtC/yr ; negative for outgoing from ocean 
    207         t_oce_co2_flx = (-1.) * t_oce_co2_flx  * 12. / 1.e15 
    208         ! 
    209         WRITE(numout,*) ' Atmospheric pCO2    :' 
    210         WRITE(numout,*) '-------------------- : ',kt,'  ',t_atm_co2_flx 
    211         WRITE(numout,*) '(ppm)' 
    212         WRITE(numout,*) 'Total Flux of Carbon out of the ocean :' 
    213         WRITE(numout,*) '-------------------- : ',t_oce_co2_flx 
    214         WRITE(numout,*) '(GtC/yr)' 
    215         t_atm_co2_flx = 0. 
    216         t_oce_co2_flx = 0. 
    217 # if defined key_iomput 
    218         CALL iom_put( "tatpco2" , t_atm_co2_flx  ) 
    219         CALL iom_put( "tco2flx" , t_oce_co2_flx  ) 
    220 #endif 
     180      t_oce_co2_flx = t_oce_co2_flx + glob_sum( oce_co2(:,:) )                     ! Cumulative Total Flux of Carbon 
     181      IF( kt == nitend ) THEN 
     182         t_atm_co2_flx = glob_sum( satmco2(:,:) * e1t(:,:) * e2t(:,:) )            ! Total atmospheric pCO2 
     183         ! 
     184         t_oce_co2_flx = (-1.) * t_oce_co2_flx  * 12. / 1.e15                      ! Conversion in PgC ; negative for out of the ocean 
     185         t_atm_co2_flx = t_atm_co2_flx  / area                                     ! global mean of atmospheric pCO2 
     186         ! 
     187         IF( lwp) THEN 
     188            WRITE(numout,*) 
     189            WRITE(numout,*) ' Global mean of atmospheric pCO2 (ppm) at it= ', kt, ' date= ', ndastp 
     190            WRITE(numout,*) '------------------------------------------------------- :  ',t_atm_co2_flx 
     191            WRITE(numout,*) 
     192            WRITE(numout,*) ' Cumulative total Flux of Carbon out of the ocean (PgC) :' 
     193            WRITE(numout,*) '-------------------------------------------------------  ',t_oce_co2_flx 
     194         ENDIF 
     195         ! 
    221196      ENDIF 
    222 #endif 
    223197 
    224198      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    … …  
    228202      ENDIF 
    229203 
    230 # if defined key_trc_diaadd && defined key_iomput 
    231       CALL iom_put( "Cflx" , zcflx  ) 
     204# if defined key_diatrc && defined key_iomput 
     205      CALL iom_put( "Cflx" , oce_co2(:,:) / ( e1t(:,:) * e2t(:,:) ) / rfact  ) 
    232206      CALL iom_put( "Oflx" , zoflx  ) 
    233207      CALL iom_put( "Kg"   , zkg    ) 
    … …  
    246220      !! 
    247221      !! ** Method  :   Read the nampisext namelist and check the parameters 
    248       !!      called at the first timestep (nittrc000) 
     222      !!      called at the first timestep (nit000) 
    249223      !! ** input   :   Namelist nampisext 
    250224      !! 
    … …  
    263237      ENDIF 
    264238 
    265       ! number of time step per year   
    266       nspyr = INT( nyear_len(1) * rday / rdt ) 
    267  
    268 #if defined key_cpl_carbon_cycle 
     239      ! interior global domain surface 
     240      area = glob_sum( e1t(:,:) * e2t(:,:) )   
     241 
    269242      ! Initialization of Flux of Carbon 
    270       oce_co2(:,:) = 0. 
    271       t_atm_co2_flx = 0. 
    272       t_oce_co2_flx = 0. 
    273 #endif 
     243      oce_co2(:,:)  = 0._wp 
     244      t_atm_co2_flx = 0._wp 
     245      ! Initialisation of atmospheric pco2 
     246      satmco2(:,:)  = atcco2 
     247      t_oce_co2_flx = 0._wp 
    274248 
    275249   END SUBROUTINE p4z_flx_init 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zint.F90

    • Property svn:executable deleted
    r1753 r2528  
    3232 
    3333   !!---------------------------------------------------------------------- 
    34    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     34   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    3535   !! $Id$  
    36    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     36   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3737   !!---------------------------------------------------------------------- 
    3838 
    … …  
    5555      ! ------------------------------------------- 
    5656 
    57       tgfunc (:,:,:) = EXP( 0.063913 * tn(:,:,:) ) 
    58       tgfunc2(:,:,:) = EXP( 0.07608  * tn(:,:,:) ) 
     57      tgfunc (:,:,:) = EXP( 0.063913 * tsn(:,:,:,jp_tem) ) 
     58      tgfunc2(:,:,:) = EXP( 0.07608  * tsn(:,:,:,jp_tem) ) 
    5959 
    6060      ! Computation of the silicon dependant half saturation 
    … …  
    6969      END DO 
    7070 
    71       IF( nday_year == 365 ) THEN 
     71      IF( nday_year == nyear_len(1) ) THEN 
    7272         xksi    = xksimax 
    7373         xksimax = 0.e0 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zlim.F90

    r1800 r2528  
    2323 
    2424   PUBLIC p4z_lim     
     25   PUBLIC p4z_lim_init     
    2526 
    2627   !! * Shared module variables 
    … …  
    4344#  include "top_substitute.h90" 
    4445   !!---------------------------------------------------------------------- 
    45    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     46   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    4647   !! $Id$  
    47    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     48   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4849   !!---------------------------------------------------------------------- 
    4950 
    5051CONTAINS 
    5152 
    52    SUBROUTINE p4z_lim( kt, jnt ) 
     53   SUBROUTINE p4z_lim( kt ) 
    5354      !!--------------------------------------------------------------------- 
    5455      !!                     ***  ROUTINE p4z_lim  *** 
    … …  
    5960      !! ** Method  : - ??? 
    6061      !!--------------------------------------------------------------------- 
    61       INTEGER, INTENT(in) ::   kt, jnt ! ocean time step 
     62      INTEGER, INTENT(in)  :: kt 
    6263      INTEGER  ::   ji, jj, jk 
    6364      REAL(wp) ::   zlim1, zlim2, zlim3, zlim4, zno3, zferlim 
    … …  
    6768 
    6869 
    69       IF( ( kt * jnt ) == nittrc000  )   CALL p4z_lim_init      ! Initialization (first time-step only) 
    70  
    71  
    72 !  Tuning of the iron concentration to a minimum 
    73 !  level that is set to the detection limit 
    74 !  ------------------------------------- 
     70      !  Tuning of the iron concentration to a minimum 
     71      !  level that is set to the detection limit 
     72      !  ------------------------------------- 
    7573 
    7674      DO jk = 1, jpkm1 
    … …  
    8583      END DO 
    8684 
    87 !  Computation of a variable Ks for iron on diatoms 
    88 !  taking into account that increasing biomass is 
    89 !  made of generally bigger cells 
    90 !  ------------------------------------------------ 
     85      !  Computation of a variable Ks for iron on diatoms taking into account 
     86      !  that increasing biomass is made of generally bigger cells 
     87      !  ------------------------------------------------ 
    9188 
    9289      DO jk = 1, jpkm1 
    … …  
    107104      END DO 
    108105 
    109       DO jk = 1, jpkm1 
    110          DO jj = 1, jpj 
    111             DO ji = 1, jpi 
    112      
    113 !      Michaelis-Menten Limitation term for nutrients 
    114 !      Small flagellates 
    115 !      ----------------------------------------------- 
     106     !  Michaelis-Menten Limitation term for nutrients Small flagellates 
     107     !      ----------------------------------------------- 
     108      DO jk = 1, jpkm1 
     109         DO jj = 1, jpj 
     110            DO ji = 1, jpi 
    116111              zdenom = 1. / & 
    117112                  & ( conc0 * concnnh4 + concnnh4 * trn(ji,jj,jk,jpno3) + conc0 * trn(ji,jj,jk,jpnh4) ) 
    … …  
    132127      END DO 
    133128 
    134       DO jk = 1, jpkm1 
    135          DO jj = 1, jpj 
    136             DO ji = 1, jpi 
    137  
    138 !   Michaelis-Menten Limitation term for nutrients Diatoms 
    139 !   ---------------------------------------------- 
     129      !   Michaelis-Menten Limitation term for nutrients Diatoms 
     130      !   ---------------------------------------------- 
     131      DO jk = 1, jpkm1 
     132         DO jj = 1, jpj 
     133            DO ji = 1, jpi 
    140134              zdenom = 1. / & 
    141135                  & ( conc1 * concdnh4 + concdnh4 * trn(ji,jj,jk,jpno3) + conc1 * trn(ji,jj,jk,jpnh4) ) 
    … …  
    161155         DO jj = 1, jpj 
    162156            DO ji = 1, jpi 
    163                ztemp = MAX( 0., tn(ji,jj,jk) ) 
     157               ztemp = MAX( 0., tsn(ji,jj,jk,jp_tem) ) 
    164158               xfracal(ji,jj,jk) = caco3r * xlimphy(ji,jj,jk)   & 
    165159                  &                       * MAX( 0.0001, ztemp / ( 2.+ ztemp ) )   & 
    … …  
    181175      !! 
    182176      !! ** Method  :   Read the nampislim namelist and check the parameters 
    183       !!      called at the first timestep (nittrc000) 
     177      !!      called at the first timestep (nit000) 
    184178      !! 
    185179      !! ** input   :   Namelist nampislim 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zlys.F90

    • Property svn:executable deleted
    r1836 r2528  
    2727   PRIVATE 
    2828 
    29    PUBLIC   p4z_lys    ! called in p4zprg.F90 
     29   PUBLIC   p4z_lys         ! called in trcsms_pisces.F90 
     30   PUBLIC   p4z_lys_init    ! called in trcsms_pisces.F90 
    3031 
    3132   !! * Shared module variables 
    … …  
    4243 
    4344   !!---------------------------------------------------------------------- 
    44    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     45   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    4546   !! $Id$  
    46    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     47   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4748   !!---------------------------------------------------------------------- 
    4849 
    … …  
    6566      REAL(wp) ::   zomegaca, zexcess, zexcess0 
    6667      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zco3 
    67 #if defined key_trc_dia3d && defined key_iomput 
     68#if defined key_diatrc && defined key_iomput 
    6869      REAL(wp) ::   zrfact2 
    6970      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zcaldiss 
    … …  
    7273      !!--------------------------------------------------------------------- 
    7374 
    74       IF( kt == nittrc000  )   CALL p4z_lys_init      ! Initialization (first time-step only) 
    75  
    7675      zco3(:,:,:) = 0. 
    7776 
    78 # if defined key_trc_dia3d && defined key_iomput 
     77# if defined key_diatrc && defined key_iomput 
    7978      zcaldiss(:,:,:) = 0. 
    8079# endif 
    … …  
    146145               !       (ACCORDING TO THIS FORMULATION ALSO SOME PARTICULATE 
    147146               !       CACO3 GETS DISSOLVED EVEN IN THE CASE OF OVERSATURATION) 
    148 # if defined key_off_degrad 
     147# if defined key_degrad 
    149148              zdispot = kdca * zexcess * trn(ji,jj,jk,jpcal) * facvol(ji,jj,jk) 
    150149# else 
    … …  
    160159              tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) +      zremco3 
    161160 
    162 # if defined key_trc_dia3d && defined key_iomput 
     161# if defined key_diatrc && defined key_iomput 
    163162              zcaldiss(ji,jj,jk) = zremco3  ! calcite dissolution 
    164163# endif 
    … …  
    167166      END DO 
    168167 
    169 # if defined key_trc_diaadd &&  defined key_trc_dia3d 
     168# if defined key_diatrc 
    170169#  if ! defined key_iomput 
    171170      trc3d(:,:,:,jp_pcs0_3d    ) = hi  (:,:,:)          * tmask(:,:,:) 
    … …  
    197196      !! 
    198197      !! ** Method  :   Read the nampiscal namelist and check the parameters 
    199       !!      called at the first timestep (nittrc000) 
     198      !!      called at the first timestep (nit000) 
    200199      !! 
    201200      !! ** input   :   Namelist nampiscal 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zmeso.F90

    • Property svn:executable deleted
    r1836 r2528  
    2626   PRIVATE 
    2727 
    28    PUBLIC   p4z_meso         ! called in p4zbio.F90 
     28   PUBLIC   p4z_meso              ! called in p4zbio.F90 
     29   PUBLIC   p4z_meso_init         ! called in trcsms_pisces.F90 
    2930 
    3031   !! * Shared module variables 
    … …  
    4748#  include "top_substitute.h90" 
    4849   !!---------------------------------------------------------------------- 
    49    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     50   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    5051   !! $Id$  
    51    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     52   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    5253   !!---------------------------------------------------------------------- 
    5354 
    5455CONTAINS 
    5556 
    56    SUBROUTINE p4z_meso( kt,jnt ) 
     57   SUBROUTINE p4z_meso( kt, jnt ) 
    5758      !!--------------------------------------------------------------------- 
    5859      !!                     ***  ROUTINE p4z_meso  *** 
    … …  
    6566      INTEGER  :: ji, jj, jk 
    6667      REAL(wp) :: zcompadi, zcompaph, zcompapoc, zcompaz 
    67       REAL(wp) :: zfact, zstep, zcompam, zdenom, zgraze2 
     68      REAL(wp) :: zfact, zcompam, zdenom, zgraze2, zstep 
    6869      REAL(wp) :: zgrarem2, zgrafer2, zgrapoc2, zprcaca, zmortz2 
    6970#if defined key_kriest 
    7071      REAL znumpoc 
    7172#endif 
    72       REAL(wp),DIMENSION(jpi,jpj,jpk) :: zrespz2,ztortz2,zgrazd,zgrazz,zgrazpof 
    73       REAL(wp),DIMENSION(jpi,jpj,jpk) :: zgrazn,zgrazpoc,zgraznf,zgrazf 
    74       REAL(wp),DIMENSION(jpi,jpj,jpk) :: zgrazfff,zgrazffe 
     73      REAL(wp) :: zrespz2,ztortz2,zgrazd,zgrazz,zgrazpof 
     74      REAL(wp) :: zgrazn,zgrazpoc,zgraznf,zgrazf 
     75      REAL(wp) :: zgrazfff,zgrazffe 
    7576      CHARACTER (len=25) :: charout 
    76 #if defined key_trc_diaadd && defined key_trc_dia3d && defined key_iomput 
     77#if defined key_diatrc && defined key_iomput 
    7778      REAL(wp) :: zrfact2 
    7879#endif 
    7980 
    8081      !!--------------------------------------------------------------------- 
    81  
    82  
    83       IF( ( kt * jnt ) == nittrc000  )   CALL p4z_meso_init      ! Initialization (first time-step only) 
    84  
    85       zrespz2 (:,:,:) = 0. 
    86       ztortz2 (:,:,:) = 0. 
    87       zgrazd  (:,:,:) = 0. 
    88       zgrazz  (:,:,:) = 0. 
    89       zgrazpof(:,:,:) = 0. 
    90       zgrazn  (:,:,:) = 0. 
    91       zgrazpoc(:,:,:) = 0. 
    92       zgraznf (:,:,:) = 0. 
    93       zgrazf  (:,:,:) = 0. 
    94       zgrazfff(:,:,:) = 0. 
    95       zgrazffe(:,:,:) = 0. 
    96  
    97       zstep = rfact2 / rday      ! Time step duration for biology 
    9882 
    9983      DO jk = 1, jpkm1 
    … …  
    10286 
    10387               zcompam = MAX( ( trn(ji,jj,jk,jpmes) - 1.e-9 ), 0.e0 ) 
    104 # if defined key_off_degrad 
    105                zfact   = zstep * tgfunc(ji,jj,jk) * zcompam * facvol(ji,jj,jk) 
     88# if defined key_degrad 
     89               zstep   = xstep * facvol(ji,jj,jk) 
    10690# else 
     91               zstep   = xstep 
     92# endif 
    10793               zfact   = zstep * tgfunc(ji,jj,jk) * zcompam 
    108 # endif 
    109  
    110 !     Respiration rates of both zooplankton 
    111 !     ------------------------------------- 
    112                zrespz2(ji,jj,jk)  = resrat2 * zfact * ( 1. + 3. * nitrfac(ji,jj,jk) )        & 
     94 
     95               !  Respiration rates of both zooplankton 
     96               !  ------------------------------------- 
     97               zrespz2  = resrat2 * zfact * ( 1. + 3. * nitrfac(ji,jj,jk) )        & 
    11398                  &     * trn(ji,jj,jk,jpmes) / ( xkmort + trn(ji,jj,jk,jpmes) ) 
    11499 
    115 !     Zooplankton mortality. A square function has been selected with 
    116 !     no real reason except that it seems to be more stable and may 
    117 !     mimic predation. 
    118 !     --------------------------------------------------------------- 
    119                ztortz2(ji,jj,jk) = mzrat2 * 1.e6 * zfact * trn(ji,jj,jk,jpmes) 
     100               !  Zooplankton mortality. A square function has been selected with 
     101               !  no real reason except that it seems to be more stable and may mimic predation 
     102               !  --------------------------------------------------------------- 
     103               ztortz2 = mzrat2 * 1.e6 * zfact * trn(ji,jj,jk,jpmes) 
    120104               ! 
    121             END DO 
    122          END DO 
    123       END DO 
    124  
    125  
    126       DO jk = 1,jpkm1 
    127          DO jj = 1,jpj 
    128             DO ji = 1,jpi 
     105 
    129106               zcompadi  = MAX( ( trn(ji,jj,jk,jpdia) - 1.e-8 ), 0.e0 ) 
    130107               zcompaz   = MAX( ( trn(ji,jj,jk,jpzoo) - 1.e-8 ), 0.e0 ) 
    … …  
    132109               zcompapoc = MAX( ( trn(ji,jj,jk,jppoc) - 1.e-8 ), 0.e0 ) 
    133110 
    134 !     Microzooplankton grazing 
    135 !     ------------------------ 
     111               !  Microzooplankton grazing 
     112               !     ------------------------ 
    136113               zdenom = 1. / (  xkgraz2 + xprefc   * trn(ji,jj,jk,jpdia)   & 
    137114                  &                     + xprefz   * trn(ji,jj,jk,jpzoo)   & 
    … …  
    139116                  &                     + xprefpoc * trn(ji,jj,jk,jppoc)  ) 
    140117 
    141                zgraze2 = grazrat2 * zstep * Tgfunc2(ji,jj,jk) * zdenom    & 
    142 # if defined key_off_degrad 
    143                   &     * facvol(ji,jj,jk)          & 
     118               zgraze2 = grazrat2 * zstep * Tgfunc2(ji,jj,jk) * zdenom * trn(ji,jj,jk,jpmes)  
     119 
     120               zgrazd   = zgraze2  * xprefc   * zcompadi 
     121               zgrazz   = zgraze2  * xprefz   * zcompaz 
     122               zgrazn   = zgraze2  * xprefp   * zcompaph 
     123               zgrazpoc = zgraze2  * xprefpoc * zcompapoc 
     124 
     125               zgraznf  = zgrazn   * trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn) 
     126               zgrazf   = zgrazd   * trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn) 
     127               zgrazpof = zgrazpoc * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) 
     128                
     129               !  Mesozooplankton flux feeding on GOC 
     130               !  ---------------------------------- 
     131# if ! defined key_kriest 
     132               zgrazffe = grazflux * zstep * wsbio4(ji,jj,jk)          & 
     133                  &                 * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpmes) 
     134               zgrazfff = zgrazffe * trn(ji,jj,jk,jpbfe) / (trn(ji,jj,jk,jpgoc) + rtrn) 
     135# else 
     136               !!--------------------------- KRIEST3 ------------------------------------------- 
     137               !!               zgrazffe = 0.5 * 1.3e-2 / 5.5e-7 * 0.3 * zstep * wsbio3(ji,jj,jk)     & 
     138               !!                  &     * tgfunc(ji,jj,jk) * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpmes)    & 
     139               !! #  if defined key_degrad 
     140               !!                  &     * facvol(ji,jj,jk)          & 
     141               !! #  endif 
     142               !!                  &     /  (trn(ji,jj,jk,jppoc) * 1.e7 + 0.1) 
     143               !!--------------------------- KRIEST3 ------------------------------------------- 
     144 
     145              zgrazffe = grazflux * zstep * wsbio3(ji,jj,jk)     & 
     146                  &                * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpmes) 
     147              zgrazfff = zgrazffe * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) 
    144148# endif 
    145                   &     * trn(ji,jj,jk,jpmes) 
    146  
    147                zgrazd(ji,jj,jk)   = zgraze2 * xprefc   * zcompadi 
    148                zgrazz(ji,jj,jk)   = zgraze2 * xprefz   * zcompaz 
    149                zgrazn(ji,jj,jk)   = zgraze2 * xprefp   * zcompaph 
    150                zgrazpoc(ji,jj,jk) = zgraze2 * xprefpoc * zcompapoc 
    151  
    152                zgraznf(ji,jj,jk)  = zgrazn(ji,jj,jk)   * trn(ji,jj,jk,jpnfe) & 
    153                   &                                     / (trn(ji,jj,jk,jpphy) + rtrn) 
    154                zgrazf(ji,jj,jk)   = zgrazd(ji,jj,jk)   * trn(ji,jj,jk,jpdfe) & 
    155                   &                                    / (trn(ji,jj,jk,jpdia) + rtrn) 
    156                zgrazpof(ji,jj,jk) = zgrazpoc(ji,jj,jk) * trn(ji,jj,jk,jpsfe) & 
    157                   &                                   / (trn(ji,jj,jk,jppoc) + rtrn) 
    158             END DO 
    159          END DO 
    160       END DO 
    161149       
    162        
    163       DO jk = 1,jpkm1 
    164          DO jj = 1,jpj 
    165             DO ji = 1,jpi 
    166                 
    167 !    Mesozooplankton flux feeding on GOC 
    168 !    ---------------------------------- 
    169 # if ! defined key_kriest 
    170 #   if ! defined key_off_degrad 
    171                zgrazffe(ji,jj,jk) = grazflux * zstep * wsbio4(ji,jj,jk)          & 
    172                   &                 * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpmes) 
    173 #   else 
    174                zgrazffe(ji,jj,jk) = grazflux * zstep * wsbio4(ji,jj,jk) * facvol(ji,jj,jk)         & 
    175                   &                 * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpmes) 
    176 #  endif 
    177                zgrazfff(ji,jj,jk) = zgrazffe(ji,jj,jk)       & 
    178                   &                 * trn(ji,jj,jk,jpbfe) / (trn(ji,jj,jk,jpgoc) + rtrn) 
    179 # else 
    180 !!--------------------------- KRIEST3 ------------------------------------------- 
    181 !!               zgrazffe(ji,jj,jk) = 0.5 * 1.3e-2 / 5.5e-7 * 0.3 * zstep * wsbio3(ji,jj,jk)     & 
    182 !!                  &     * tgfunc(ji,jj,jk) * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpmes)    & 
    183 #  if defined key_off_degrad 
    184 !!                  &     * facvol(ji,jj,jk)          & 
    185 #  endif 
    186 !!                  &     /  (trn(ji,jj,jk,jppoc) * 1.e7 + 0.1) 
    187 !!--------------------------- KRIEST3 ------------------------------------------- 
    188  
    189 #  if ! defined key_off_degrad 
    190               zgrazffe(ji,jj,jk) = grazflux * zstep * wsbio3(ji,jj,jk)     & 
    191                   &                * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpmes) 
    192 #  else 
    193               zgrazffe(ji,jj,jk) = grazflux * zstep * wsbio3(ji,jj,jk) * facvol(ji,jj,jk)    & 
    194                   &               * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpmes) 
    195 #  endif 
    196  
    197                zgrazfff(ji,jj,jk) = zgrazffe(ji,jj,jk)      & 
    198                   &                * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) 
    199 # endif 
    200             END DO 
    201          END DO 
    202       END DO 
    203        
    204 #if defined key_trc_dia3d 
    205       ! Total grazing ( grazing by microzoo is already computed in p4zmicro )  
    206       grazing(:,:,:) = grazing(:,:,:) + (  zgrazd  (:,:,:) + zgrazz  (:,:,:) + zgrazn(:,:,:) & 
    207                      &                   + zgrazpoc(:,:,:) + zgrazffe(:,:,:)  ) 
    208 #endif 
    209  
    210  
    211       DO jk = 1,jpkm1 
    212          DO jj = 1,jpj 
    213             DO ji = 1,jpi 
    214  
    215 !    Mesozooplankton efficiency 
    216 !    -------------------------- 
    217                zgrarem2 = ( zgrazd(ji,jj,jk) + zgrazz(ji,jj,jk) + zgrazn(ji,jj,jk) & 
    218                   &     + zgrazpoc(ji,jj,jk) + zgrazffe(ji,jj,jk) )   & 
    219                   &     * ( 1. - epsher2 - unass2 ) 
     150#if defined key_diatrc 
     151              ! Total grazing ( grazing by microzoo is already computed in p4zmicro )  
     152              grazing(ji,jj,jk) = grazing(ji,jj,jk) + (  zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffe ) 
     153#endif 
     154 
     155              !    Mesozooplankton efficiency 
     156              !    -------------------------- 
     157              zgrarem2 = ( zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffe ) * ( 1. - epsher2 - unass2 ) 
    220158#if ! defined key_kriest 
    221                zgrafer2 = (zgrazf(ji,jj,jk) + zgraznf(ji,jj,jk) + zgrazz(ji,jj,jk) & 
    222                   &     * ferat3 + zgrazpof(ji,jj,jk) + zgrazfff (ji,jj,jk))*(1.-epsher2-unass2) & 
    223                   &     + epsher2 * ( & 
    224                   &      zgrazd(ji,jj,jk)   * MAX((trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn)-ferat3),0.) & 
    225                   &     + zgrazn(ji,jj,jk)   * MAX((trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn)-ferat3),0.) & 
    226                   &    + zgrazpoc(ji,jj,jk) * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)-ferat3),0.) & 
    227                   &    + zgrazffe(ji,jj,jk) * MAX((trn(ji,jj,jk,jpbfe) / (trn(ji,jj,jk,jpgoc) + rtrn)-ferat3),0.)  ) 
     159              zgrafer2 = ( zgrazf + zgraznf + zgrazz * ferat3 + zgrazpof + zgrazfff ) * ( 1.- epsher2 - unass2 ) &  
     160                  &     + epsher2 * ( zgrazd   * MAX((trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn)-ferat3),0.) & 
     161                  &                 + zgrazn   * MAX((trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn)-ferat3),0.) & 
     162                  &                 + zgrazpoc * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)-ferat3),0.) & 
     163                  &                 + zgrazffe * MAX((trn(ji,jj,jk,jpbfe) / (trn(ji,jj,jk,jpgoc) + rtrn)-ferat3),0.)  ) 
    228164#else 
    229                zgrafer2 = (zgrazf(ji,jj,jk) + zgraznf(ji,jj,jk) + zgrazz(ji,jj,jk) & 
    230                   &    * ferat3 + zgrazpof(ji,jj,jk) + zgrazfff(ji,jj,jk) )*(1.-epsher2-unass2) & 
    231                   &    + epsher2 * ( & 
    232                   &    zgrazd(ji,jj,jk)   * MAX((trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn)-ferat3),0.) & 
    233                   &    + zgrazn(ji,jj,jk)   * MAX((trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn)-ferat3),0.) & 
    234                   &    + zgrazpoc(ji,jj,jk) * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)-ferat3),0.) & 
    235                   &    + zgrazffe(ji,jj,jk) * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)-ferat3),0.)  ) 
    236  
    237 #endif 
    238                zgrapoc2 = (zgrazd(ji,jj,jk) + zgrazz(ji,jj,jk)  + zgrazn(ji,jj,jk) & 
    239                   &    + zgrazpoc(ji,jj,jk) + zgrazffe(ji,jj,jk)) * unass2 
     165              zgrafer2 = ( zgrazf + zgraznf + zgrazz * ferat3 + zgrazpof + zgrazfff ) * ( 1. - epsher2 - unass2 ) & 
     166                  &    + epsher2 * ( zgrazd   * MAX((trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn)-ferat3),0.) & 
     167                  &                + zgrazn   * MAX((trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn)-ferat3),0.) & 
     168                  &                + zgrazpoc * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)-ferat3),0.) & 
     169                  &                + zgrazffe * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)-ferat3),0.)  ) 
     170 
     171#endif 
     172               !   Update the arrays TRA which contain the biological sources and sinks 
     173 
     174               zgrapoc2 =  zgrazd + zgrazz  + zgrazn + zgrazpoc + zgrazffe 
    240175 
    241176               tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarem2 * sigma2 
    242177               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarem2 * sigma2 
    243                tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem2 * (1.-sigma2) 
     178               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem2 * ( 1. - sigma2 ) 
    244179               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarem2 * sigma2 
    245180               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer2 
    … …  
    247182                
    248183#if defined key_kriest 
    249                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc2 
    250                tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zgrapoc2 * xkr_dmeso 
     184               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc2 * unass2 
     185               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zgrapoc2 * unass2 * xkr_dmeso 
    251186#else 
    252                tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zgrapoc2 
    253 #endif 
    254             END DO 
    255          END DO 
    256       END DO 
    257  
    258       DO jk = 1, jpkm1 
    259          DO jj = 1, jpj 
    260             DO ji = 1, jpi 
    261                ! 
    262                !   Update the arrays TRA which contain the biological sources and sinks 
    263                !   -------------------------------------------------------------------- 
    264                zmortz2 = ztortz2(ji,jj,jk) + zrespz2(ji,jj,jk) 
    265                tra(ji,jj,jk,jpmes) = tra(ji,jj,jk,jpmes) - zmortz2  & 
    266                   &    + epsher2 * ( zgrazd(ji,jj,jk) + zgrazz(ji,jj,jk) + zgrazn(ji,jj,jk) & 
    267                   &    + zgrazpoc(ji,jj,jk) + zgrazffe(ji,jj,jk) ) 
    268                tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazd(ji,jj,jk) 
    269                tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zgrazz(ji,jj,jk) 
    270                tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgrazn(ji,jj,jk) 
    271                tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazn(ji,jj,jk) * trn(ji,jj,jk,jpnch)  & 
    272                   &    / ( trn(ji,jj,jk,jpphy) + rtrn ) 
    273                tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazd(ji,jj,jk) * trn(ji,jj,jk,jpdch) & 
    274                   &    / ( trn(ji,jj,jk,jpdia) + rtrn ) 
    275                tra(ji,jj,jk,jpbsi) = tra(ji,jj,jk,jpbsi) - zgrazd(ji,jj,jk) * trn(ji,jj,jk,jpbsi) & 
    276                   &    / ( trn(ji,jj,jk,jpdia) + rtrn ) 
    277                tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) +  zgrazd(ji,jj,jk) * trn(ji,jj,jk,jpbsi) & 
    278                   &    / ( trn(ji,jj,jk,jpdia) + rtrn ) 
    279                tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) -  zgraznf(ji,jj,jk) 
    280                tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) -  zgrazf(ji,jj,jk) 
    281  
    282                zprcaca = xfracal(ji,jj,jk) * unass2 * zgrazn(ji,jj,jk) 
    283 #if defined key_trc_dia3d 
     187               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zgrapoc2 * unass2 
     188#endif 
     189               zmortz2 = ztortz2 + zrespz2 
     190               tra(ji,jj,jk,jpmes) = tra(ji,jj,jk,jpmes) - zmortz2 + epsher2 * zgrapoc2 
     191               tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazd 
     192               tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zgrazz 
     193               tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgrazn 
     194               tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazn * trn(ji,jj,jk,jpnch) / ( trn(ji,jj,jk,jpphy) + rtrn ) 
     195               tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazd * trn(ji,jj,jk,jpdch) / ( trn(ji,jj,jk,jpdia) + rtrn ) 
     196               tra(ji,jj,jk,jpbsi) = tra(ji,jj,jk,jpbsi) - zgrazd * trn(ji,jj,jk,jpbsi) / ( trn(ji,jj,jk,jpdia) + rtrn ) 
     197               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zgrazd * trn(ji,jj,jk,jpbsi) / ( trn(ji,jj,jk,jpdia) + rtrn ) 
     198               tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgraznf 
     199               tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazf 
     200 
     201               zprcaca = xfracal(ji,jj,jk) * unass2 * zgrazn 
     202#if defined key_diatrc 
    284203               prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
    285204#endif 
    … …  
    290209#if defined key_kriest 
    291210               znumpoc = trn(ji,jj,jk,jpnum) / ( trn(ji,jj,jk,jppoc) + rtrn ) 
    292                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortz2  & 
    293                   &    - zgrazpoc(ji,jj,jk) - zgrazffe(ji,jj,jk)     
    294                tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) - zgrazpoc(ji,jj,jk) * znumpoc & 
    295                   &    + zmortz2  * xkr_dmeso & 
    296                   &    - zgrazffe(ji,jj,jk)   * znumpoc * wsbio4(ji,jj,jk) & 
    297                   &    / ( wsbio3(ji,jj,jk) + rtrn ) 
     211               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortz2 - zgrazpoc - zgrazffe 
     212               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) - zgrazpoc * znumpoc & 
     213                  &    + zmortz2  * xkr_dmeso - zgrazffe * znumpoc * wsbio4(ji,jj,jk) / ( wsbio3(ji,jj,jk) + rtrn ) 
    298214               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortz2 & 
    299                &       + unass2 * ( ferat3 * zgrazz(ji,jj,jk) + zgraznf(ji,jj,jk) & 
    300                &       + zgrazf(ji,jj,jk) + zgrazpof(ji,jj,jk) + zgrazfff(ji,jj,jk) ) & 
    301                &       - zgrazfff(ji,jj,jk) - zgrazpof(ji,jj,jk) 
     215               &       + unass2 * ( ferat3 * zgrazz + zgraznf + zgrazf + zgrazpof + zgrazfff ) - zgrazfff - zgrazpof 
    302216#else 
    303                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zgrazpoc(ji,jj,jk) 
    304                tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zmortz2 - zgrazffe(ji,jj,jk) 
    305                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zgrazpof(ji,jj,jk) 
     217               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zgrazpoc 
     218               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zmortz2 - zgrazffe 
     219               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zgrazpof 
    306220               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + ferat3 * zmortz2 & 
    307                &       + unass2 * ( ferat3 * zgrazz(ji,jj,jk) + zgraznf(ji,jj,jk) & 
    308                &       + zgrazf(ji,jj,jk) + zgrazpof(ji,jj,jk) + zgrazfff(ji,jj,jk) ) & 
    309                &       - zgrazfff(ji,jj,jk) 
     221               &       + unass2 * ( ferat3 * zgrazz + zgraznf + zgrazf + zgrazpof + zgrazfff ) - zgrazfff 
    310222#endif 
    311223 
    … …  
    314226      END DO 
    315227      ! 
    316 #if defined key_trc_diaadd && defined key_trc_dia3d && defined key_iomput 
     228#if defined key_diatrc && defined key_iomput 
    317229      zrfact2 = 1.e3 * rfact2r 
    318230      ! Total grazing of phyto by zoo 
    … …  
    342254      !! 
    343255      !! ** Method  :   Read the nampismes namelist and check the parameters 
    344       !!      called at the first timestep (nittrc000) 
     256      !!      called at the first timestep (nit000) 
    345257      !! 
    346258      !! ** input   :   Namelist nampismes 
    … …  
    373285      ENDIF 
    374286 
     287 
    375288   END SUBROUTINE p4z_meso_init 
    376289 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zmicro.F90

    • Property svn:executable deleted
    r1836 r2528  
    2626   PRIVATE 
    2727 
    28    PUBLIC   p4z_micro    ! called in p4zbio.F90 
     28   PUBLIC   p4z_micro         ! called in p4zbio.F90 
     29   PUBLIC   p4z_micro_init    ! called in trcsms_pisces.F90 
    2930 
    3031   !! * Shared module variables 
    … …  
    4546#  include "top_substitute.h90" 
    4647   !!---------------------------------------------------------------------- 
    47    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     48   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    4849   !! $Id$  
    49    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     50   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    5051   !!---------------------------------------------------------------------- 
    5152 
    5253CONTAINS 
    5354 
    54    SUBROUTINE p4z_micro( kt,jnt ) 
     55   SUBROUTINE p4z_micro( kt ) 
    5556      !!--------------------------------------------------------------------- 
    5657      !!                     ***  ROUTINE p4z_micro  *** 
    … …  
    6061      !! ** Method  : - ??? 
    6162      !!--------------------------------------------------------------------- 
    62       INTEGER, INTENT(in) ::   kt, jnt ! ocean time step 
     63      INTEGER, INTENT(in) ::   kt ! ocean time step 
    6364      INTEGER  :: ji, jj, jk 
    6465      REAL(wp) :: zcompadi, zcompadi2, zcompaz , zcompaph, zcompapoc 
    65       REAL(wp) :: zgraze  , zdenom  , zdenom2 
    66       REAL(wp) :: zfact   , zstep   , zinano , zidiat, zipoc 
     66      REAL(wp) :: zgraze  , zdenom  , zdenom2, zstep 
     67      REAL(wp) :: zfact   , zinano , zidiat, zipoc 
    6768      REAL(wp) :: zgrarem, zgrafer, zgrapoc, zprcaca, zmortz 
    68       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zrespz,ztortz 
    69       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazp, zgrazm, zgrazsd 
    70       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazmf, zgrazsf, zgrazpf 
     69      REAL(wp) :: zrespz, ztortz 
     70      REAL(wp) :: zgrazp, zgrazm, zgrazsd 
     71      REAL(wp) :: zgrazmf, zgrazsf, zgrazpf 
    7172      CHARACTER (len=25) :: charout 
    7273 
    7374      !!--------------------------------------------------------------------- 
    7475 
    75       IF( ( kt * jnt ) == nittrc000  )   CALL p4z_micro_init      ! Initialization (first time-step only) 
    76  
    77       zrespz (:,:,:) = 0. 
    78       ztortz (:,:,:) = 0. 
    79       zgrazp (:,:,:) = 0. 
    80       zgrazm (:,:,:) = 0. 
    81       zgrazsd(:,:,:) = 0. 
    82       zgrazmf(:,:,:) = 0. 
    83       zgrazsf(:,:,:) = 0. 
    84       zgrazpf(:,:,:) = 0. 
    85  
    86 #if defined key_trc_dia3d 
     76 
     77#if defined key_diatrc 
    8778      grazing(:,:,:) = 0.  !: Initialisation of  grazing 
    8879#endif 
    … …  
    9384         DO jj = 1, jpj 
    9485            DO ji = 1, jpi 
    95  
    9686               zcompaz = MAX( ( trn(ji,jj,jk,jpzoo) - 1.e-9 ), 0.e0 ) 
    97 # if defined key_off_degrad 
    98                zfact   = zstep * tgfunc(ji,jj,jk) * zcompaz *facvol(ji,jj,jk) 
     87# if defined key_degrad 
     88               zstep   = xstep * facvol(ji,jj,jk) 
    9989# else 
     90               zstep   = xstep 
     91# endif 
    10092               zfact   = zstep * tgfunc(ji,jj,jk) * zcompaz 
    101 # endif 
    102  
    103 !     Respiration rates of both zooplankton 
    104 !     ------------------------------------- 
    105  
    106                zrespz(ji,jj,jk) = resrat * zfact  * ( 1.+ 3.* nitrfac(ji,jj,jk) )     & 
     93 
     94               !  Respiration rates of both zooplankton 
     95               !  ------------------------------------- 
     96               zrespz = resrat * zfact  * ( 1.+ 3.* nitrfac(ji,jj,jk) )     & 
    10797                  &            * trn(ji,jj,jk,jpzoo) / ( xkmort + trn(ji,jj,jk,jpzoo) ) 
    10898 
    109 !     Zooplankton mortality. A square function has been selected with 
    110 !     no real reason except that it seems to be more stable and may 
    111 !     mimic predation. 
    112 !     --------------------------------------------------------------- 
    113                ztortz(ji,jj,jk) = mzrat * 1.e6 * zfact * trn(ji,jj,jk,jpzoo) 
    114  
    115             END DO 
    116          END DO 
    117       END DO 
    118  
    119  
    120   
    121       DO jk = 1,jpkm1 
    122          DO jj = 1,jpj 
    123             DO ji = 1,jpi 
     99               !  Zooplankton mortality. A square function has been selected with 
     100               !  no real reason except that it seems to be more stable and may mimic predation. 
     101               !  --------------------------------------------------------------- 
     102               ztortz = mzrat * 1.e6 * zfact * trn(ji,jj,jk,jpzoo) 
     103 
    124104               zcompadi  = MAX( ( trn(ji,jj,jk,jpdia) - 1.e-8 ), 0.e0 ) 
    125105               zcompadi2 = MIN( zcompadi, 5.e-7 ) 
    … …  
    131111               zdenom2 = 1./ ( xpref2p * zcompaph + xpref2c * zcompapoc + xpref2d * zcompadi2 + rtrn ) 
    132112 
    133                zgraze = grazrat * zstep * tgfunc(ji,jj,jk)     & 
    134 # if defined key_off_degrad 
    135                   &      * facvol(ji,jj,jk)         & 
    136 # endif 
    137                   &      * trn(ji,jj,jk,jpzoo) 
     113               zgraze = grazrat * zstep * tgfunc(ji,jj,jk) * trn(ji,jj,jk,jpzoo) 
    138114 
    139115               zinano = xpref2p * zcompaph  * zdenom2 
    … …  
    143119               zdenom = 1./ ( xkgraz + zinano * zcompaph + zipoc * zcompapoc + zidiat * zcompadi2 ) 
    144120 
    145                zgrazp(ji,jj,jk)  = zgraze * zinano * zcompaph * zdenom 
    146                zgrazm(ji,jj,jk)  = zgraze * zipoc  * zcompapoc * zdenom 
    147                zgrazsd(ji,jj,jk) = zgraze * zidiat * zcompadi2 * zdenom 
    148  
    149                zgrazpf (ji,jj,jk) = zgrazp(ji,jj,jk)  * trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn) 
    150                zgrazmf(ji,jj,jk)  = zgrazm(ji,jj,jk)  * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) 
    151                zgrazsf(ji,jj,jk)  = zgrazsd(ji,jj,jk) * trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn) 
    152  
    153             END DO 
    154          END DO 
    155       END DO 
    156        
    157 #if defined key_trc_dia3d 
    158       ! Grazing by microzooplankton 
    159       grazing(:,:,:) = grazing(:,:,:) + zgrazp(:,:,:) + zgrazm(:,:,:) + zgrazsd(:,:,:)  
    160 #endif 
    161  
    162       DO jk = 1,jpkm1 
    163          DO jj = 1,jpj 
    164             DO ji = 1,jpi 
    165 !    Various remineralization and excretion terms 
    166 !    -------------------------------------------- 
    167  
    168                zgrarem = (  zgrazp(ji,jj,jk) + zgrazm(ji,jj,jk)  + zgrazsd(ji,jj,jk)  ) & 
    169                   &          * ( 1.- epsher - unass ) 
    170                zgrafer = (  zgrazpf(ji,jj,jk) + zgrazsf(ji,jj,jk)  + zgrazmf(ji,jj,jk)  ) & 
    171                   &        * ( 1.- epsher - unass ) + epsher *  & 
    172                   &  ( zgrazm(ji,jj,jk)  * MAX((trn(ji,jj,jk,jpsfe) /(trn(ji,jj,jk,jppoc)+ rtrn)-ferat3),0.e0) & 
    173                   &   + zgrazp(ji,jj,jk)  * MAX((trn(ji,jj,jk,jpnfe)/(trn(ji,jj,jk,jpphy)+ rtrn)-ferat3),0.e0) & 
    174                   &   + zgrazsd(ji,jj,jk) * MAX((trn(ji,jj,jk,jpdfe)/(trn(ji,jj,jk,jpdia)+ rtrn)-ferat3),0.e0 )  ) 
    175                zgrapoc = (  zgrazp(ji,jj,jk) + zgrazm(ji,jj,jk) + zgrazsd(ji,jj,jk)  ) * unass 
     121               zgrazp  = zgraze * zinano * zcompaph * zdenom 
     122               zgrazm  = zgraze * zipoc  * zcompapoc * zdenom 
     123               zgrazsd = zgraze * zidiat * zcompadi2 * zdenom 
     124 
     125               zgrazpf = zgrazp  * trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn) 
     126               zgrazmf = zgrazm  * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) 
     127               zgrazsf = zgrazsd * trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn) 
     128#if defined key_diatrc 
     129               ! Grazing by microzooplankton 
     130               grazing(ji,jj,jk) = grazing(ji,jj,jk) + zgrazp + zgrazm + zgrazsd  
     131#endif 
     132 
     133               !    Various remineralization and excretion terms 
     134               !    -------------------------------------------- 
     135               zgrarem = ( zgrazp + zgrazm + zgrazsd ) * ( 1.- epsher - unass ) 
     136               zgrafer = ( zgrazpf + zgrazsf + zgrazmf ) * ( 1.- epsher - unass ) & 
     137                  &      + epsher * ( zgrazm  * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc)+ rtrn)-ferat3),0.e0) &  
     138                  &                 + zgrazp  * MAX((trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy)+ rtrn)-ferat3),0.e0) & 
     139                  &                 + zgrazsd * MAX((trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia)+ rtrn)-ferat3),0.e0 )  ) 
     140 
     141               zgrapoc = (  zgrazp + zgrazm + zgrazsd )  
    176142 
    177143               !  Update of the TRA arrays 
    … …  
    183149               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarem * sigma1 
    184150               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer 
    185                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc 
     151               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc * unass 
    186152               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarem * sigma1 
    187153#if defined key_kriest 
    188                tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zgrapoc * xkr_ddiat 
    189 #endif 
    190             END DO 
    191          END DO 
    192       END DO 
    193  
    194 ! 
    195 !   Update the arrays TRA which contain the biological sources and sinks 
    196 !   -------------------------------------------------------------------- 
    197  
    198       DO jk = 1, jpkm1 
    199          DO jj = 1, jpj 
    200             DO ji = 1, jpi 
    201  
    202                zmortz = ztortz(ji,jj,jk) + zrespz(ji,jj,jk) 
    203                tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zmortz  & 
    204                  &     + epsher * ( zgrazp(ji,jj,jk) + zgrazm(ji,jj,jk) + zgrazsd(ji,jj,jk)) 
    205                tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgrazp(ji,jj,jk) 
    206                tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazsd(ji,jj,jk) 
    207                tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazp(ji,jj,jk)  & 
    208                  &     * trn(ji,jj,jk,jpnch)/(trn(ji,jj,jk,jpphy)+rtrn) 
    209                tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazsd(ji,jj,jk) & 
    210                  &     * trn(ji,jj,jk,jpdch)/(trn(ji,jj,jk,jpdia)+rtrn) 
    211                tra(ji,jj,jk,jpbsi) = tra(ji,jj,jk,jpbsi) - zgrazsd(ji,jj,jk) & 
    212                  &     * trn(ji,jj,jk,jpbsi)/(trn(ji,jj,jk,jpdia)+rtrn) 
    213                tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zgrazsd(ji,jj,jk) & 
    214                  &     * trn(ji,jj,jk,jpbsi)/(trn(ji,jj,jk,jpdia)+rtrn) 
    215                tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgrazpf(ji,jj,jk) 
    216                tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazsf(ji,jj,jk) 
    217                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortz - zgrazm(ji,jj,jk) 
    218                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortz   & 
    219                  &     + unass * ( zgrazpf(ji,jj,jk) + zgrazsf (ji,jj,jk)) & 
    220                  &     - (1.-unass) * zgrazmf(ji,jj,jk) 
    221                zprcaca = xfracal(ji,jj,jk) * unass * zgrazp(ji,jj,jk) 
    222 #if defined key_trc_dia3d 
     154               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zgrapoc * unass * xkr_ddiat 
     155#endif 
     156 
     157               ! 
     158               !   Update the arrays TRA which contain the biological sources and sinks 
     159               !   -------------------------------------------------------------------- 
     160 
     161               zmortz = ztortz + zrespz 
     162               tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zmortz + epsher * zgrapoc  
     163               tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgrazp 
     164               tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazsd 
     165               tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazp  * trn(ji,jj,jk,jpnch)/(trn(ji,jj,jk,jpphy)+rtrn) 
     166               tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazsd * trn(ji,jj,jk,jpdch)/(trn(ji,jj,jk,jpdia)+rtrn) 
     167               tra(ji,jj,jk,jpbsi) = tra(ji,jj,jk,jpbsi) - zgrazsd * trn(ji,jj,jk,jpbsi)/(trn(ji,jj,jk,jpdia)+rtrn) 
     168               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zgrazsd * trn(ji,jj,jk,jpbsi)/(trn(ji,jj,jk,jpdia)+rtrn) 
     169               tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgrazpf 
     170               tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazsf 
     171               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortz - zgrazm 
     172               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortz + unass * ( zgrazpf + zgrazsf ) - (1.-unass) * zgrazmf 
     173               zprcaca = xfracal(ji,jj,jk) * unass * zgrazp 
     174#if defined key_diatrc 
    223175               prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
    224176#endif 
    … …  
    228180               tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca 
    229181#if defined key_kriest 
    230                tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + ( zmortz - zgrazm(ji,jj,jk) ) * xkr_ddiat 
     182               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + ( zmortz - zgrazm ) * xkr_ddiat 
    231183#endif 
    232184            END DO 
    … …  
    251203      !! 
    252204      !! ** Method  :   Read the nampiszoo namelist and check the parameters 
    253       !!      called at the first timestep (nittrc000) 
     205      !!      called at the first timestep (nit000) 
    254206      !! 
    255207      !! ** input   :   Namelist nampiszoo 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zmort.F90

    • Property svn:executable deleted
    r1800 r2528  
    2525 
    2626   PUBLIC   p4z_mort     
     27   PUBLIC   p4z_mort_init     
    2728 
    2829 
    … …  
    3536     mpratm = 0.01_wp           !: 
    3637 
    37    !! * Module variables 
    38    REAL(wp) :: zstep 
    39  
    40  
    4138 
    4239   !!* Substitution 
    4340#  include "top_substitute.h90" 
    4441   !!---------------------------------------------------------------------- 
    45    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     42   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    4643   !! $Id$  
    47    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     44   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4845   !!---------------------------------------------------------------------- 
    4946 
    5047CONTAINS 
    5148 
    52    SUBROUTINE p4z_mort( kt, jnt ) 
     49   SUBROUTINE p4z_mort( kt ) 
    5350      !!--------------------------------------------------------------------- 
    5451      !!                     ***  ROUTINE p4z_mort  *** 
    … …  
    5956      !! ** Method  : - ??? 
    6057      !!--------------------------------------------------------------------- 
    61       INTEGER, INTENT(in) ::   kt, jnt ! ocean time step 
    62       !!--------------------------------------------------------------------- 
    63  
    64       IF( ( kt * jnt ) == nittrc000  )   CALL p4z_mort_init      ! Initialization (first time-step only) 
    65  
    66       zstep = rfact2 / rday      ! Time step duration for biology 
     58      INTEGER, INTENT(in) ::   kt ! ocean time step 
     59      !!--------------------------------------------------------------------- 
    6760 
    6861      CALL p4z_nano            ! nanophytoplankton 
    … …  
    8376      INTEGER  :: ji, jj, jk 
    8477      REAL(wp) :: zcompaph 
    85       REAL(wp) :: zfactfe,zfactch,zprcaca,zfracal 
    86       REAL(wp) :: ztortp,zrespp,zmortp 
     78      REAL(wp) :: zfactfe, zfactch, zprcaca, zfracal 
     79      REAL(wp) :: ztortp , zrespp , zmortp , zstep 
    8780      CHARACTER (len=25) :: charout 
    8881      !!--------------------------------------------------------------------- 
    8982 
    9083 
    91 #if defined key_trc_dia3d 
     84#if defined key_diatrc 
    9285     prodcal(:,:,:) = 0.  !: Initialisation of calcite production variable 
    9386#endif 
    … …  
    9992               zcompaph = MAX( ( trn(ji,jj,jk,jpphy) - 1e-8 ), 0.e0 ) 
    10093 
    101 !     Squared mortality of Phyto similar to a sedimentation term during 
    102 !     blooms (Doney et al. 1996) 
    103 !     ----------------------------------------------------------------- 
    104                zrespp = wchl * 1.e6 * zstep * xdiss(ji,jj,jk)   & 
    105 # if defined key_off_degrad 
    106                   &        * facvol(ji,jj,jk)     & 
     94# if defined key_degrad 
     95               zstep =  xstep * facvol(ji,jj,jk)   
     96# else 
     97               zstep =  xstep   
    10798# endif 
    108                   &        * zcompaph * trn(ji,jj,jk,jpphy) 
    109  
    110 !     Phytoplankton mortality. This mortality loss is slightly 
    111 !     increased when nutrients are limiting phytoplankton growth 
    112 !     as observed for instance in case of iron limitation. 
    113 !     ---------------------------------------------------------- 
    114                ztortp = mprat * zstep * trn(ji,jj,jk,jpphy)          & 
    115 # if defined key_off_degrad 
    116                   &          * facvol(ji,jj,jk)     & 
    117 # endif 
    118                   &   / ( xkmort + trn(ji,jj,jk,jpphy) ) * zcompaph 
    119  
     99               !     Squared mortality of Phyto similar to a sedimentation term during 
     100               !     blooms (Doney et al. 1996) 
     101               zrespp = wchl * 1.e6 * zstep * xdiss(ji,jj,jk) * zcompaph * trn(ji,jj,jk,jpphy)  
     102 
     103               !     Phytoplankton mortality. This mortality loss is slightly 
     104               !     increased when nutrients are limiting phytoplankton growth 
     105               !     as observed for instance in case of iron limitation. 
     106               ztortp = mprat * xstep * trn(ji,jj,jk,jpphy) / ( xkmort + trn(ji,jj,jk,jpphy) ) * zcompaph 
    120107 
    121108               zmortp = zrespp + ztortp 
    … …  
    130117               tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zmortp * zfactfe 
    131118               zprcaca = xfracal(ji,jj,jk) * zmortp 
    132 #if defined key_trc_dia3d 
     119#if defined key_diatrc 
    133120               prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
    134121#endif 
    … …  
    169156      INTEGER  ::  ji, jj, jk 
    170157      REAL(wp) ::  zfactfe,zfactsi,zfactch, zcompadi 
    171       REAL(wp) ::  zrespp2, ztortp2, zmortp2 
     158      REAL(wp) ::  zrespp2, ztortp2, zmortp2, zstep 
    172159      CHARACTER (len=25) :: charout 
    173160  
    … …  
    175162 
    176163 
    177 !    Aggregation term for diatoms is increased in case of nutrient 
    178 !    stress as observed in reality. The stressed cells become more 
    179 !    sticky and coagulate to sink quickly out of the euphotic zone 
    180 !     ------------------------------------------------------------ 
     164      !    Aggregation term for diatoms is increased in case of nutrient 
     165      !    stress as observed in reality. The stressed cells become more 
     166      !    sticky and coagulate to sink quickly out of the euphotic zone 
     167      !     ------------------------------------------------------------ 
    181168 
    182169      DO jk = 1, jpkm1 
    … …  
    186173               zcompadi = MAX( ( trn(ji,jj,jk,jpdia) - 1e-8), 0. ) 
    187174 
    188 !    Aggregation term for diatoms is increased in case of nutrient 
    189 !    stress as observed in reality. The stressed cells become more 
    190 !    sticky and coagulate to sink quickly out of the euphotic zone 
    191 !     ------------------------------------------------------------ 
    192  
     175               !    Aggregation term for diatoms is increased in case of nutrient 
     176               !    stress as observed in reality. The stressed cells become more 
     177               !    sticky and coagulate to sink quickly out of the euphotic zone 
     178               !     ------------------------------------------------------------ 
     179 
     180# if defined key_degrad 
     181               zstep =  xstep * facvol(ji,jj,jk)   
     182# else 
     183               zstep =  xstep   
     184# endif 
     185               !  Phytoplankton respiration  
     186               !     ------------------------ 
    193187               zrespp2  = 1.e6 * zstep * (  wchl + wchld * ( 1.- xlimdia(ji,jj,jk) )  )    & 
    194 # if defined key_off_degrad 
    195                   &       * facvol(ji,jj,jk)       & 
    196 # endif 
    197188                  &       * xdiss(ji,jj,jk) * zcompadi * trn(ji,jj,jk,jpdia) 
    198                                                                                 
    199  
    200 !     Phytoplankton mortality.  
    201 !     ------------------------ 
    202                ztortp2  = mprat2 * zstep * trn(ji,jj,jk,jpdia)     & 
    203 # if defined key_off_degrad 
    204                   &        * facvol(ji,jj,jk)       & 
    205 # endif 
    206                   &      / ( xkmort + trn(ji,jj,jk,jpdia) ) * zcompadi 
    207  
    208                 zmortp2 = zrespp2 + ztortp2 
    209  
    210 !   Update the arrays tra which contains the biological sources and sinks 
    211 !   --------------------------------------------------------------------- 
     189 
     190               !     Phytoplankton mortality.  
     191               !     ------------------------ 
     192               ztortp2  = mprat2 * zstep * trn(ji,jj,jk,jpdia)  / ( xkmort + trn(ji,jj,jk,jpdia) ) * zcompadi  
     193 
     194               zmortp2 = zrespp2 + ztortp2 
     195 
     196               !   Update the arrays tra which contains the biological sources and sinks 
     197               !   --------------------------------------------------------------------- 
    212198               zfactch = trn(ji,jj,jk,jpdch) / ( trn(ji,jj,jk,jpdia) + rtrn ) 
    213199               zfactfe = trn(ji,jj,jk,jpdfe) / ( trn(ji,jj,jk,jpdia) + rtrn ) 
    … …  
    249235      !! 
    250236      !! ** Method  :   Read the nampismort namelist and check the parameters 
    251       !!      called at the first timestep (nittrc000) 
     237      !!      called at the first timestep 
    252238      !! 
    253239      !! ** input   :   Namelist nampismort 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zopt.F90

    • Property svn:executable deleted
    r1836 r2528  
    1616   USE trc            ! tracer variables 
    1717   USE oce_trc        ! tracer-ocean share variables 
    18    USE trc_oce        ! ocean-tracer share variables 
    1918   USE sms_pisces     ! Source Minus Sink of PISCES 
    2019   USE iom 
    … …  
    2322   PRIVATE 
    2423 
    25    PUBLIC   p4z_opt   ! called in p4zbio.F90 module 
     24   PUBLIC   p4z_opt        ! called in p4zbio.F90 module 
     25   PUBLIC   p4z_opt_init   ! called in trcsms_pisces.F90 module 
    2626 
    2727   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   etot, enano, ediat   !: PAR for phyto, nano and diat  
    2828   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   emoy                 !: averaged PAR in the mixed layer 
    2929 
    30    INTEGER  ::   nksrp   ! levels below which the light cannot penetrate ( depth larger than 391 m) 
    31    REAL(wp) ::   & 
    32       parlux = 0.43 / 3.e0 
     30   INTEGER  ::  nksrp   ! levels below which the light cannot penetrate ( depth larger than 391 m) 
     31   REAL(wp) ::  parlux = 0.43 / 3.e0 
    3332 
    3433   REAL(wp), DIMENSION(3,61), PUBLIC ::   xkrgb  !: tabulated attenuation coefficients for RGB absorption 
    … …  
    3736#  include "top_substitute.h90" 
    3837   !!---------------------------------------------------------------------- 
    39    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     38   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    4039   !! $Id$  
    41    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     40   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4241   !!---------------------------------------------------------------------- 
    4342 
    4443CONTAINS 
    4544 
    46    SUBROUTINE p4z_opt(kt, jnt) 
     45   SUBROUTINE p4z_opt( kt, jnt ) 
    4746      !!--------------------------------------------------------------------- 
    4847      !!                     ***  ROUTINE p4z_opt  *** 
    … …  
    5453      !!--------------------------------------------------------------------- 
    5554      INTEGER, INTENT(in) ::   kt, jnt ! ocean time step 
    56       INTEGER  ::   ji, jj, jk, jc 
     55      INTEGER  ::   ji, jj, jk 
    5756      INTEGER  ::   irgb 
    5857      REAL(wp) ::   zchl, zxsi0r 
    … …  
    6463 
    6564 
    66       !                                        !* tabulated attenuation coef.  
    67       IF( kt * jnt == nittrc000 ) THEN 
    68          !                                ! level of light extinction 
    69          nksrp = trc_oce_ext_lev( rn_si2, 0.33e2 ) 
    70          IF(lwp) THEN 
    71            WRITE(numout,*) 
    72            WRITE(numout,*) ' level max of computation of qsr = ', nksrp, ' ref depth = ', gdepw_0(nksrp+1), ' m' 
    73          ENDIF 
    74 !!         CALL trc_oce_rgb( xkrgb )     ! tabulated attenuation coefficients 
    75          CALL trc_oce_rgb_read( xkrgb )     ! tabulated attenuation coefficients 
    76          etot (:,:,:) = 0.e0 
    77          enano(:,:,:) = 0.e0 
    78          ediat(:,:,:) = 0.e0 
    79          IF( ln_qsr_bio ) etot3(:,:,:) = 0.e0 
    80       ENDIF 
    81  
    82  
    83 !     Initialisation of variables used to compute PAR 
    84 !     ----------------------------------------------- 
     65      !     Initialisation of variables used to compute PAR 
     66      !     ----------------------------------------------- 
    8567      ze1 (:,:,jpk) = 0.e0 
    8668      ze2 (:,:,jpk) = 0.e0 
    … …  
    227209      END DO 
    228210 
    229 #if defined key_trc_diaadd 
     211#if defined key_diatrc 
    230212# if ! defined key_iomput 
    231213      ! save for outputs 
    … …  
    243225   END SUBROUTINE p4z_opt 
    244226 
     227   SUBROUTINE p4z_opt_init 
     228      !!---------------------------------------------------------------------- 
     229      !!                  ***  ROUTINE p4z_opt_init  *** 
     230      !! 
     231      !! ** Purpose :   Initialization of tabulated attenuation coef 
     232      !! 
     233      !! 
     234      !!---------------------------------------------------------------------- 
     235 
     236      CALL trc_oce_rgb( xkrgb )                  ! tabulated attenuation coefficients 
     237!!      CALL trc_oce_rgb_read( xkrgb )               ! tabulated attenuation coefficients 
     238      nksrp = trc_oce_ext_lev( r_si2, 0.33e2 )     ! max level of light extinction (Blue Chl=0.01) 
     239      IF(lwp) WRITE(numout,*) '        level of light extinction = ', nksrp, ' ref depth = ', gdepw_0(nksrp+1), ' m' 
     240      ! 
     241                         etot (:,:,:) = 0.e0 
     242                         enano(:,:,:) = 0.e0 
     243                         ediat(:,:,:) = 0.e0 
     244      IF( ln_qsr_bio )   etot3(:,:,:) = 0.e0 
     245      !  
     246   END SUBROUTINE p4z_opt_init 
    245247#else 
    246248   !!---------------------------------------------------------------------- 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zprod.F90

    • Property svn:executable deleted
    r1836 r2528  
    2323 
    2424   USE lib_mpp 
     25   USE lib_fortran 
    2526 
    2627   IMPLICIT NONE 
    2728   PRIVATE 
    2829 
    29    PUBLIC   p4z_prod    ! called in p4zbio.F90 
     30   PUBLIC   p4z_prod         ! called in p4zbio.F90 
     31   PUBLIC   p4z_prod_init    ! called in trcsms_pisces.F90 
    3032 
    3133   !! * Shared module variables 
    … …  
    4143     grosip    = 0.151_wp 
    4244 
    43    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk)  ::        & 
    44      &                   prmax 
     45   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk)  ::  prmax  
    4546    
    4647   REAL(wp) ::   & 
     48      rday1                      ,  &  !: 0.6 / rday 
    4749      texcret                    ,  &  !: 1 - excret  
    4850      texcret2                   ,  &  !: 1 - excret2         
    49       rpis180                    ,  &  !: rpi / 180 
    5051      tpp                              !: Total primary production 
    51  
    52    INTEGER  ::  nspyr                  !: number of timesteps per year 
    5352 
    5453   !!* Substitution 
    5554#  include "top_substitute.h90" 
    5655   !!---------------------------------------------------------------------- 
    57    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     56   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    5857   !! $Id$  
    59    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     58   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    6059   !!---------------------------------------------------------------------- 
    6160 
    … …  
    7877      REAL(wp) ::   zmxltst, zmxlday, zlim1 
    7978      REAL(wp) ::   zpislopen  , zpislope2n 
    80       REAL(wp) ::   zrum, zcodel, zargu, zvol 
    81 #if defined key_trc_diaadd && defined key_trc_dia3d 
     79      REAL(wp) ::   zrum, zcodel, zargu, zval, zvol 
     80#if defined key_diatrc 
    8281      REAL(wp) ::   zrfact2 
    8382#endif 
    … …  
    9089      CHARACTER (len=25) :: charout 
    9190      !!--------------------------------------------------------------------- 
    92  
    93  
    94       IF( ( kt * jnt ) == nittrc000  )   CALL p4z_prod_init      ! Initialization (first time-step only) 
    95  
    9691 
    9792      zprorca (:,:,:) = 0.0 
    … …  
    109104      ! Computation of the optimal production 
    110105 
    111 # if defined key_off_degrad 
    112       prmax(:,:,:) = 0.6 / rday * tgfunc(:,:,:) * facvol(:,:,:) 
     106# if defined key_degrad 
     107      prmax(:,:,:) = rday1 * tgfunc(:,:,:) * facvol(:,:,:) 
    113108# else 
    114       prmax(:,:,:) = 0.6 / rday * tgfunc(:,:,:) 
     109      prmax(:,:,:) = rday1 * tgfunc(:,:,:) 
    115110# endif 
    116111 
    117112      ! compute the day length depending on latitude and the day 
    118       IF(lwp) write(numout,*) 
    119       IF(lwp) write(numout,*) 'p4zday : - Julian day ', nday_year 
    120       IF(lwp) write(numout,*) '~~~~~~' 
    121  
    122       IF( nleapy == 1 .AND. MOD( nyear, 4 ) == 0 ) THEN 
    123          zrum = FLOAT( nday_year - 80 ) / 366. 
    124       ELSE 
    125          zrum = FLOAT( nday_year - 80 ) / 365. 
    126       ENDIF 
    127       zcodel = ASIN(  SIN( zrum * rpi * 2. ) * SIN( rpis180 * 23.5 )  ) 
     113      zrum = FLOAT( nday_year - 80 ) / REAL(nyear_len(1), wp) 
     114      zcodel = ASIN(  SIN( zrum * rpi * 2. ) * SIN( rad * 23.5 )  ) 
    128115 
    129116      ! day length in hours 
    … …  
    131118      DO jj = 1, jpj 
    132119         DO ji = 1, jpi 
    133             zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rpis180 ) 
     120            zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad ) 
    134121            zargu = MAX( -1., MIN(  1., zargu ) ) 
    135             zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rpis180 / 15. ) 
     122            zval  = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. ) 
     123            IF( zval < 1.e0 )   zval = 24. 
     124            zstrn(ji,jj) = 24. / zval 
    136125         END DO 
    137126      END DO 
    … …  
    147136               ! Computation of the P-I slope for nanos and diatoms 
    148137               IF( etot(ji,jj,jk) > 1.E-3 ) THEN 
    149                    ztn    = MAX( 0., tn(ji,jj,jk) - 15. ) 
     138                   ztn    = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. ) 
    150139                   zadap  = 0.+ 1.* ztn / ( 2.+ ztn ) 
    151140                   zadap2 = 0.e0 
    … …  
    227216      END DO 
    228217 
    229  
    230       WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24. 
    231       zstrn(:,:) = 24. / zstrn(:,:) 
    232218 
    233219!CDIR NOVERRCHK 
    … …  
    331317 
    332318     ! Total primary production per year 
    333      DO jk = 1, jpkm1 
    334         DO jj = 1, jpj 
    335           DO ji = 1, jpi 
    336              zvol = cvol(ji,jj,jk) 
    337 #if defined key_off_degrad 
    338              zvol = zvol * facvol(ji,jj,jk) 
     319 
     320#if defined key_degrad 
     321     tpp = tpp + glob_sum( ( zprorca(:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) * facvol(:,:,:) ) 
     322#else 
     323     tpp = tpp + glob_sum( ( zprorca(:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) ) 
    339324#endif 
    340              tpp  = tpp + ( zprorca(ji,jj,jk) + zprorcad(ji,jj,jk) ) & 
    341                           * zvol * tmask(ji,jj,jk) * tmask_i(ji,jj) 
    342           END DO 
    343         END DO 
    344       END DO 
    345  
    346  
    347       IF( MOD( kt, nspyr ) == 0 .AND. jnt == nrdttrc ) THEN 
    348         IF( lk_mpp ) CALL mpp_sum( tpp ) 
    349         WRITE(numout,*) 'Total PP :' 
     325 
     326     IF( kt == nitend .AND. jnt == nrdttrc ) THEN 
     327        WRITE(numout,*) 'Total PP (Gtc) :' 
    350328        WRITE(numout,*) '-------------------- : ',tpp * 12. / 1.E12 
    351         WRITE(numout,*) '(GtC/yr)' 
    352         tpp = 0. 
     329        WRITE(numout,*)  
    353330      ENDIF 
    354331 
    355 #if defined key_trc_diaadd && defined key_trc_dia3d && ! defined key_iomput 
     332#if defined key_diatrc && ! defined key_iomput 
    356333      !   Supplementary diagnostics 
    357334      zrfact2 = 1.e3 * rfact2r 
    … …  
    367344#endif 
    368345 
    369 #if defined key_trc_diaadd && defined key_trc_dia3d && defined key_iomput 
     346#if defined key_diatrc && defined key_iomput 
    370347      zrfact2 = 1.e3 * rfact2r 
    371348      IF ( jnt == nrdttrc ) then 
    … …  
    396373      !! 
    397374      !! ** Method  :   Read the nampisprod namelist and check the parameters 
    398       !!      called at the first timestep (nittrc000) 
     375      !!      called at the first timestep (nit000) 
    399376      !! 
    400377      !! ** input   :   Namelist nampisprod 
    … …  
    423400      ENDIF 
    424401 
    425       ! number of timesteps per year 
    426       nspyr  = INT( nyear_len(1) * rday / rdt ) 
    427  
    428       rpis180   = rpi / 180. 
     402      rday1     = 0.6 / rday  
    429403      texcret   = 1.0 - excret 
    430404      texcret2  = 1.0 - excret2 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zrem.F90

    • Property svn:executable deleted
    r1800 r2528  
    2727   PRIVATE 
    2828 
    29    PUBLIC   p4z_rem    ! called in p4zbio.F90 
     29   PUBLIC   p4z_rem         ! called in p4zbio.F90 
     30   PUBLIC   p4z_rem_init    ! called in trcsms_pisces.F90 
    3031 
    3132   !! * Shared module variables 
    … …  
    4142     &                   denitr                     !: denitrification array 
    4243 
    43    REAL(wp) ::   & 
    44      xstep            !: Time step duration for biology 
    4544 
    4645   !!* Substitution 
    4746#  include "top_substitute.h90" 
    4847   !!---------------------------------------------------------------------- 
    49    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     48   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    5049   !! $Id$  
    51    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     50   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    5251   !!---------------------------------------------------------------------- 
    5352 
    5453CONTAINS 
    5554 
    56    SUBROUTINE p4z_rem(kt, jnt) 
     55   SUBROUTINE p4z_rem( kt ) 
    5756      !!--------------------------------------------------------------------- 
    5857      !!                     ***  ROUTINE p4z_rem  *** 
    … …  
    6261      !! ** Method  : - ??? 
    6362      !!--------------------------------------------------------------------- 
    64       INTEGER, INTENT(in) ::   kt, jnt ! ocean time step 
     63      INTEGER, INTENT(in) ::   kt ! ocean time step 
    6564      INTEGER  ::   ji, jj, jk 
    6665      REAL(wp) ::   zremip, zremik , zlam1b 
    … …  
    7271      REAL(wp) ::   zofer2, zdenom, zdenom2 
    7372#endif 
    74       REAL(wp) ::   zlamfac, zonitr 
     73      REAL(wp) ::   zlamfac, zonitr, zstep 
    7574      REAL(wp), DIMENSION(jpi,jpj)     ::   ztempbac 
    7675      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdepbac, zfesatur, zolimi 
    … …  
    7877 
    7978      !!--------------------------------------------------------------------- 
    80  
    81  
    82       IF( ( kt * jnt ) == nittrc000  )  THEN 
    83          CALL p4z_rem_init                ! Initialization (first time-step only) 
    84          xstep = rfact2 / rday            ! Time step duration for the biology 
    85          nitrfac(:,:,:) = 0.0 
    86          denitr (:,:,:) = 0.0   
    87       ENDIF 
    8879 
    8980 
    … …  
    9485       ztempbac(:,:)   = 0.0 
    9586 
    96 !      Computation of the mean phytoplankton concentration as 
    97 !      a crude estimate of the bacterial biomass 
    98 !      -------------------------------------------------- 
     87      !  Computation of the mean phytoplankton concentration as 
     88      !  a crude estimate of the bacterial biomass 
     89      !   -------------------------------------------------- 
    9990 
    10091      DO jk = 1, jpkm1 
    … …  
    114105         DO jj = 1, jpj 
    115106            DO ji = 1, jpi 
    116  
    117 !    DENITRIFICATION FACTOR COMPUTED FROM O2 LEVELS 
    118 !    ---------------------------------------------- 
    119  
     107               ! denitrification factor computed from O2 levels 
    120108               nitrfac(ji,jj,jk) = MAX(  0.e0, 0.4 * ( 6.e-6  - trn(ji,jj,jk,jpoxy) )    & 
    121109                  &                                / ( oxymin + trn(ji,jj,jk,jpoxy) )  ) 
    122             END DO 
    123          END DO 
    124       END DO 
    125  
    126       nitrfac(:,:,:) = MIN( 1., nitrfac(:,:,:) ) 
    127  
    128  
    129       DO jk = 1, jpkm1 
    130          DO jj = 1, jpj 
    131             DO ji = 1, jpi 
    132  
    133 !     DOC ammonification. Depends on depth, phytoplankton biomass 
    134 !     and a limitation term which is supposed to be a parameterization 
    135 !     of the bacterial activity.  
    136 !     ---------------------------------------------------------------- 
    137                zremik = xremik * xstep / 1.e-6 * xlimbac(ji,jj,jk)         & 
    138 # if defined key_off_degrad 
    139                   &            * facvol(ji,jj,jk)              & 
     110               nitrfac(ji,jj,jk) = MIN( 1., nitrfac(ji,jj,jk) ) 
     111            END DO 
     112         END DO 
     113      END DO 
     114 
     115      DO jk = 1, jpkm1 
     116         DO jj = 1, jpj 
     117            DO ji = 1, jpi 
     118# if defined key_degrad 
     119               zstep = xstep * facvol(ji,jj,jk) 
     120# else 
     121               zstep = xstep 
    140122# endif 
    141                   &            * zdepbac(ji,jj,jk) 
     123               ! DOC ammonification. Depends on depth, phytoplankton biomass 
     124               !     and a limitation term which is supposed to be a parameterization 
     125               !     of the bacterial activity.  
     126               zremik = xremik * zstep / 1.e-6 * xlimbac(ji,jj,jk) * zdepbac(ji,jj,jk)  
    142127               zremik = MAX( zremik, 5.5e-4 * xstep ) 
    143128 
    144 !     Ammonification in oxic waters with oxygen consumption 
    145 !     ----------------------------------------------------- 
     129               !     Ammonification in oxic waters with oxygen consumption 
     130               !     ----------------------------------------------------- 
    146131               zolimi(ji,jj,jk) = MIN(  ( trn(ji,jj,jk,jpoxy) - rtrn ) / o2ut,  & 
    147132                  &                    zremik * ( 1.- nitrfac(ji,jj,jk) ) * trn(ji,jj,jk,jpdoc)  )  
    148133 
    149 !     Ammonification in suboxic waters with denitrification 
    150 !     ------------------------------------------------------- 
     134               !     Ammonification in suboxic waters with denitrification 
     135               !     ------------------------------------------------------- 
    151136               denitr(ji,jj,jk) = MIN(  ( trn(ji,jj,jk,jpno3) - rtrn ) / rdenit,   & 
    152137                  &                     zremik * nitrfac(ji,jj,jk) * trn(ji,jj,jk,jpdoc)  ) 
    … …  
    167152         DO jj = 1, jpj 
    168153            DO ji = 1, jpi 
    169  
    170 !    NH4 nitrification to NO3. Ceased for oxygen concentrations 
    171 !    below 2 umol/L. Inhibited at strong light  
    172 !    ---------------------------------------------------------- 
    173                zonitr  = nitrif * xstep * trn(ji,jj,jk,jpnh4) / ( 1.+ emoy(ji,jj,jk) )     & 
    174 # if defined key_off_degrad 
    175                   &      * facvol(ji,jj,jk)              & 
     154# if defined key_degrad 
     155               zstep = xstep * facvol(ji,jj,jk) 
     156# else 
     157               zstep = xstep 
    176158# endif 
    177                   &      * ( 1.- nitrfac(ji,jj,jk) ) 
    178  
    179 ! 
    180 !   Update of the tracers trends 
    181 !   ---------------------------- 
    182  
    183               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zonitr 
    184               tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zonitr 
    185               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2nit * zonitr 
    186               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - rno3  * zonitr 
     159               !    NH4 nitrification to NO3. Ceased for oxygen concentrations 
     160               !    below 2 umol/L. Inhibited at strong light  
     161               !    ---------------------------------------------------------- 
     162               zonitr  = nitrif * zstep * trn(ji,jj,jk,jpnh4) / ( 1.+ emoy(ji,jj,jk) ) * ( 1.- nitrfac(ji,jj,jk) )  
     163 
     164               !   Update of the tracers trends 
     165               !   ---------------------------- 
     166 
     167               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zonitr 
     168               tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zonitr 
     169               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2nit * zonitr 
     170               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - rno3  * zonitr 
    187171 
    188172            END DO 
    … …  
    200184            DO ji = 1, jpi 
    201185 
    202 !    Bacterial uptake of iron. No iron is available in DOC. So 
    203 !    Bacteries are obliged to take up iron from the water. Some 
    204 !    studies (especially at Papa) have shown this uptake to be 
    205 !    significant 
    206 !    ---------------------------------------------------------- 
     186               !    Bacterial uptake of iron. No iron is available in DOC. So 
     187               !    Bacteries are obliged to take up iron from the water. Some 
     188               !    studies (especially at Papa) have shown this uptake to be significant 
     189               !    ---------------------------------------------------------- 
    207190               zbactfer = 15.e-6 * rfact2 * 4.* 0.4 * prmax(ji,jj,jk)           & 
    208                   &               * ( xlimphy(ji,jj,jk) * zdepbac(ji,jj,jk))**2           & 
     191                  &               * ( xlimphy(ji,jj,jk) * zdepbac(ji,jj,jk))           & 
     192                  &               * ( xlimphy(ji,jj,jk) * zdepbac(ji,jj,jk))           & 
    209193                  &                  / ( xkgraz2 + zdepbac(ji,jj,jk) )                    & 
    210194                  &                  * ( 0.5 + SIGN( 0.5, trn(ji,jj,jk,jpfer) -2.e-11 )  ) 
    … …  
    216200               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zbactfer 
    217201#endif 
    218  
    219202            END DO 
    220203         END DO 
    … …  
    230213         DO jj = 1, jpj 
    231214            DO ji = 1, jpi 
    232  
    233 !    POC disaggregation by turbulence and bacterial activity.  
    234 !    ------------------------------------------------------------- 
    235                zremip = xremip * xstep * tgfunc(ji,jj,jk)   & 
    236 # if defined key_off_degrad 
    237                   &            * facvol(ji,jj,jk)              & 
     215# if defined key_degrad 
     216               zstep = xstep * facvol(ji,jj,jk) 
     217# else 
     218               zstep = xstep 
    238219# endif 
    239                   &            * ( 1.- 0.5 * nitrfac(ji,jj,jk) ) 
    240  
    241 !    POC disaggregation rate is reduced in anoxic zone as shown by 
    242 !    sediment traps data. In oxic area, the exponent of the martin s 
    243 !    law is around -0.87. In anoxic zone, it is around -0.35. This 
    244 !    means a disaggregation constant about 0.5 the value in oxic zones 
    245 !    ----------------------------------------------------------------- 
     220               !    POC disaggregation by turbulence and bacterial activity.  
     221               !    ------------------------------------------------------------- 
     222               zremip = xremip * zstep * tgfunc(ji,jj,jk) * ( 1.- 0.5 * nitrfac(ji,jj,jk) )  
     223 
     224               !    POC disaggregation rate is reduced in anoxic zone as shown by 
     225               !    sediment traps data. In oxic area, the exponent of the martin s 
     226               !    law is around -0.87. In anoxic zone, it is around -0.35. This 
     227               !    means a disaggregation constant about 0.5 the value in oxic zones 
     228               !    ----------------------------------------------------------------- 
    246229               zorem  = zremip * trn(ji,jj,jk,jppoc) 
    247230               zofer  = zremip * trn(ji,jj,jk,jpsfe) 
    … …  
    253236#endif 
    254237 
    255 !  Update the appropriate tracers trends 
    256 !  ------------------------------------- 
     238               !  Update the appropriate tracers trends 
     239               !  ------------------------------------- 
    257240 
    258241               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zorem 
    … …  
    282265         DO jj = 1, jpj 
    283266            DO ji = 1, jpi 
    284  
    285 !     Remineralization rate of BSi depedant on T and saturation 
    286 !     --------------------------------------------------------- 
     267# if defined key_degrad 
     268               zstep = xstep * facvol(ji,jj,jk) 
     269# else 
     270               zstep = xstep 
     271# endif 
     272               !     Remineralization rate of BSi depedant on T and saturation 
     273               !     --------------------------------------------------------- 
    287274               zsatur  = ( sio3eq(ji,jj,jk) - trn(ji,jj,jk,jpsil) ) / ( sio3eq(ji,jj,jk) + rtrn ) 
    288275               zsatur  = MAX( rtrn, zsatur ) 
    289276               zsatur2 = zsatur * ( 1. + tn(ji,jj,jk) / 400.)**4 
    290277               znusil  = 0.225  * ( 1. + tn(ji,jj,jk) / 15.) * zsatur + 0.775 * zsatur2**9 
    291 #    if defined key_off_degrad 
    292                zsiremin = xsirem * xstep * znusil * facvol(ji,jj,jk) 
    293 # else 
    294                zsiremin = xsirem * xstep * znusil 
    295 #    endif 
     278               zsiremin = xsirem * zstep * znusil 
    296279               zosil = zsiremin * trn(ji,jj,jk,jpdsi) 
    297280 
    298281               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zosil 
    299282               tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) + zosil 
    300  
    301283               ! 
    302284            END DO 
    … …  
    317299!CDIR NOVERRCHK 
    318300            DO ji = 1, jpi 
    319 ! 
    320 !      Compute de different ratios for scavenging of iron 
    321 !      -------------------------------------------------- 
     301# if defined key_degrad 
     302               zstep = xstep * facvol(ji,jj,jk) 
     303# else 
     304               zstep = xstep 
     305# endif 
     306               !  Compute de different ratios for scavenging of iron 
     307               !  -------------------------------------------------- 
    322308 
    323309#if  defined key_kriest 
    324                 zdenom1 = trn(ji,jj,jk,jppoc) / & 
     310               zdenom1 = trn(ji,jj,jk,jppoc) / & 
    325311           &           ( trn(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpdsi) + trn(ji,jj,jk,jpcal) + rtrn ) 
    326312#else 
    327                 zdenom = 1. / ( trn(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpgoc)  & 
     313               zdenom = 1. / ( trn(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpgoc)  & 
    328314           &            + trn(ji,jj,jk,jpdsi) + trn(ji,jj,jk,jpcal) + rtrn ) 
    329315 
    330                 zdenom1 = trn(ji,jj,jk,jppoc) * zdenom 
    331                 zdenom2 = trn(ji,jj,jk,jpgoc) * zdenom 
    332 #endif 
    333  
    334  
    335 !     scavenging rate of iron. this scavenging rate depends on the 
    336 !     load in particles on which they are adsorbed. The 
    337 !     parameterization has been taken from studies on Th 
    338 !     ------------------------------------------------------------ 
     316               zdenom1 = trn(ji,jj,jk,jppoc) * zdenom 
     317               zdenom2 = trn(ji,jj,jk,jpgoc) * zdenom 
     318#endif 
     319               !  scavenging rate of iron. this scavenging rate depends on the load in particles 
     320               !  on which they are adsorbed. The  parameterization has been taken from studies on Th 
     321               !     ------------------------------------------------------------ 
    339322               zkeq = fekeq(ji,jj,jk) 
    340323               zfeequi = ( -( 1. + zfesatur(ji,jj,jk) * zkeq - zkeq * trn(ji,jj,jk,jpfer) )               & 
    … …  
    349332                  &                      + trn(ji,jj,jk,jpcal) + trn(ji,jj,jk,jpdsi)  ) * 1.e6 
    350333#endif 
    351  
    352 # if defined key_off_degrad 
    353                zscave = zfeequi * zlam1b * xstep  * facvol(ji,jj,jk) 
    354 # else 
    355                zscave = zfeequi * zlam1b * xstep 
    356 # endif 
    357  
    358 !  Increased scavenging for very high iron concentrations 
    359 !  found near the coasts due to increased lithogenic particles 
    360 !  and let s say it unknown processes (precipitation, ...) 
    361 !  ----------------------------------------------------------- 
     334               zscave = zfeequi * zlam1b * zstep 
     335 
     336               !  Increased scavenging for very high iron concentrations 
     337               !  found near the coasts due to increased lithogenic particles 
     338               !  and let s say it unknown processes (precipitation, ...) 
     339               !  ----------------------------------------------------------- 
    362340               zlamfac = MAX( 0.e0, ( gphit(ji,jj) + 55.) / 30. ) 
    363341               zlamfac = MIN( 1.  , zlamfac ) 
    … …  
    374352#endif 
    375353 
    376 # if defined key_off_degrad 
    377                zaggdfe = zlam1b * xstep * 0.5 * ( trn(ji,jj,jk,jpfer) - zfeequi ) * facvol(ji,jj,jk) 
    378 # else 
    379                zaggdfe = zlam1b * xstep * 0.5 * ( trn(ji,jj,jk,jpfer) - zfeequi ) 
    380 # endif 
     354               zaggdfe = zlam1b * zstep * 0.5 * ( trn(ji,jj,jk,jpfer) - zfeequi ) 
    381355 
    382356               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zscave - zaggdfe 
    … …  
    400374       ENDIF 
    401375 
    402 !     Update the arrays TRA which contain the biological sources and sinks 
    403 !     -------------------------------------------------------------------- 
     376       !     Update the arrays TRA which contain the biological sources and sinks 
     377       !     -------------------------------------------------------------------- 
    404378 
    405379      DO jk = 1, jpkm1 
    … …  
    429403      !! 
    430404      !! ** Method  :   Read the nampisrem namelist and check the parameters 
    431       !!      called at the first timestep (nittrc000) 
     405      !!      called at the first timestep 
    432406      !! 
    433407      !! ** input   :   Namelist nampisrem 
    … …  
    452426      ENDIF 
    453427 
     428      nitrfac(:,:,:) = 0.0 
     429      denitr (:,:,:) = 0.0   
     430 
    454431   END SUBROUTINE p4z_rem_init 
    455  
    456  
    457  
    458  
    459432 
    460433#else 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsed.F90

    • Property svn:executable deleted
    r1836 r2528  
    1919   USE sms_pisces 
    2020   USE lib_mpp 
     21   USE lib_fortran 
    2122   USE prtctl_trc 
    2223   USE p4zbio 
    … …  
    3435 
    3536   PUBLIC   p4z_sed    
     37   PUBLIC   p4z_sed_init    
    3638 
    3739   !! * Shared module variables 
    … …  
    4749 
    4850   !! * Module variables 
    49    INTEGER ::                   & 
    50      ryyss,                     &  !: number of seconds per year 
    51      rmtss                         !: number of seconds per month 
    52  
     51   REAL(wp) :: ryyss               !: number of seconds per year  
     52   REAL(wp) :: ryyss1              !: inverse of ryyss 
     53   REAL(wp) :: rmtss               !: number of seconds per month 
     54   REAL(wp) :: rday1               !: inverse of rday 
     55 
     56   INTEGER , PARAMETER :: & 
     57        jpmth = 12, jpyr = 1 
    5358   INTEGER ::                   & 
    5459      numdust,                  &  !: logical unit for surface fluxes data 
    5560      nflx1 , nflx2,            &  !: first and second record used 
    5661      nflx11, nflx12      ! ??? 
    57    REAL(wp), DIMENSION(jpi,jpj,2) ::    &  !: 
    58      dustmo                                !: 2 consecutive set of dust fields  
    59    REAL(wp), DIMENSION(jpi,jpj)   ::    & 
    60      rivinp, cotdep, nitdep, dust 
    61    REAL(wp), DIMENSION(jpi,jpj,jpk)  ::   & 
    62      ironsed 
     62   REAL(wp), DIMENSION(jpi,jpj,jpmth) ::  dustmo    !: set of dust fields 
     63   REAL(wp), DIMENSION(jpi,jpj)      ::  rivinp, cotdep, nitdep, dust  
     64   REAL(wp), DIMENSION(jpi,jpj)      ::  e1e2t 
     65   REAL(wp), DIMENSION(jpi,jpj,jpk)  ::  ironsed  
    6366   REAL(wp) :: sumdepsi, rivalkinput, rivpo4input, nitdepinput 
    6467 
    … …  
    6669#  include "top_substitute.h90" 
    6770   !!---------------------------------------------------------------------- 
    68    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     71   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    6972   !! $Header:$  
    70    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     73   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    7174   !!---------------------------------------------------------------------- 
    7275 
    7376CONTAINS 
    7477 
    75    SUBROUTINE p4z_sed(kt, jnt) 
     78   SUBROUTINE p4z_sed( kt, jnt ) 
    7679      !!--------------------------------------------------------------------- 
    7780      !!                     ***  ROUTINE p4z_sed  *** 
    … …  
    8487      !!--------------------------------------------------------------------- 
    8588      INTEGER, INTENT(in) ::   kt, jnt ! ocean time step 
    86       INTEGER  ::   ji, jj, jk 
    87       INTEGER  ::   ikt 
     89      INTEGER  ::   ji, jj, jk, ikt 
    8890#if ! defined key_sed 
    8991      REAL(wp) ::   zsumsedsi, zsumsedpo4, zsumsedcal 
     92      REAL(wp) ::   zrivalk, zrivsil, zrivpo4 
    9093#endif 
    91       REAL(wp) ::   zconctmp , zdenitot  , znitrpottot 
    92       REAL(wp) ::   zlim, zconctmp2, zstep, zfact 
     94      REAL(wp) ::   zdenitot, znitrpottot, zlim, zfact 
     95      REAL(wp) ::   zwsbio3, zwsbio4, zwscal 
    9396      REAL(wp), DIMENSION(jpi,jpj)     ::   zsidep 
     97      REAL(wp), DIMENSION(jpi,jpj)     ::   zwork, zwork1 
    9498      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   znitrpot, zirondep 
    95 #if defined key_diaadd || defined key_trc_dia3d  
    96       REAL(wp) :: zrfact2 
    97 # if defined key_iomput 
    98      REAL(wp), DIMENSION(jpi,jpj)    ::    zw2d  
    99 # endif 
    100 #endif 
    10199      CHARACTER (len=25) :: charout 
    102100      !!--------------------------------------------------------------------- 
    103101 
    104  
    105       IF( ( kt * jnt ) == nittrc000   )   CALL p4z_sed_init      ! Initialization (first time-step only) 
    106       IF( (jnt == 1) .and. ( ln_dustfer ) )  CALL p4z_sbc( kt ) 
    107  
    108       zstep = rfact2 / rday      ! Time step duration for the biology 
    109  
    110       zirondep(:,:,:) = 0.e0          ! Initialisation of variables used to compute deposition 
    111       zsidep  (:,:)   = 0.e0 
     102      IF( jnt == 1  .AND.  ln_dustfer  )  CALL p4z_sbc( kt ) 
    112103 
    113104      ! Iron and Si deposition at the surface 
    … …  
    116107      DO jj = 1, jpj 
    117108         DO ji = 1, jpi 
    118             zirondep(ji,jj,1) = ( dustsolub * dust(ji,jj) / ( 55.85 * rmtss ) + 3.e-10 / ryyss )   & 
     109            zirondep(ji,jj,1) = ( dustsolub * dust(ji,jj) / ( 55.85 * rmtss ) + 3.e-10 * ryyss1 )   & 
    119110               &             * rfact2 / fse3t(ji,jj,1) 
    120111            zsidep  (ji,jj)   = 8.8 * 0.075 * dust(ji,jj) * rfact2 / ( fse3t(ji,jj,1) * 28.1 * rmtss ) 
    … …  
    150141 
    151142#if ! defined key_sed 
    152       ! Initialisation of variables used to compute Sinking Speed 
    153       zsumsedsi  = 0.e0 
    154       zsumsedpo4 = 0.e0 
    155       zsumsedcal = 0.e0 
    156  
    157143      ! Loss of biogenic silicon, Caco3 organic carbon in the sediments.  
    158144      ! First, the total loss is computed. 
    … …  
    161147      DO jj = 1, jpj 
    162148         DO ji = 1, jpi 
    163             ikt = MAX( mbathy(ji,jj)-1, 1 ) 
    164             zfact = e1t(ji,jj) * e2t(ji,jj) / rday * tmask_i(ji,jj) 
     149            ikt = mbkt(ji,jj)  
    165150# if defined key_kriest 
    166             zsumsedsi  = zsumsedsi  + zfact * trn(ji,jj,ikt,jpdsi) * wscal (ji,jj,ikt) 
    167             zsumsedpo4 = zsumsedpo4 + zfact * trn(ji,jj,ikt,jppoc) * wsbio3(ji,jj,ikt) 
     151            zwork (ji,jj) = trn(ji,jj,ikt,jpdsi) * wscal (ji,jj,ikt) 
     152            zwork1(ji,jj) = trn(ji,jj,ikt,jppoc) * wsbio3(ji,jj,ikt) 
    168153# else 
    169             zsumsedsi  = zsumsedsi  + zfact *  trn(ji,jj,ikt,jpdsi) * wsbio4(ji,jj,ikt) 
    170             zsumsedpo4 = zsumsedpo4 + zfact *( trn(ji,jj,ikt,jpgoc) * wsbio4(ji,jj,ikt)   & 
    171                &       + trn(ji,jj,ikt,jppoc) * wsbio3(ji,jj,ikt) ) 
     154            zwork (ji,jj) = trn(ji,jj,ikt,jpdsi) * wsbio4(ji,jj,ikt) 
     155            zwork1(ji,jj) = trn(ji,jj,ikt,jpgoc) * wsbio4(ji,jj,ikt) + trn(ji,jj,ikt,jppoc) * wsbio3(ji,jj,ikt)  
    172156# endif 
    173             zsumsedcal = zsumsedcal + zfact *  trn(ji,jj,ikt,jpcal) * wscal (ji,jj,ikt) * 2.e0 
    174          END DO 
    175       END DO 
    176  
    177       IF( lk_mpp ) THEN 
    178          CALL mpp_sum( zsumsedsi  )   ! sums over the global domain 
    179          CALL mpp_sum( zsumsedcal )   ! sums over the global domain 
    180          CALL mpp_sum( zsumsedpo4 )   ! sums over the global domain 
    181       ENDIF 
    182  
     157         END DO 
     158      END DO 
     159      zsumsedsi  = glob_sum( zwork (:,:) * e1e2t(:,:) ) * rday1 
     160      zsumsedpo4 = glob_sum( zwork1(:,:) * e1e2t(:,:) ) * rday1 
     161      DO jj = 1, jpj 
     162         DO ji = 1, jpi 
     163            ikt = mbkt(ji,jj)  
     164            zwork (ji,jj) = trn(ji,jj,ikt,jpcal) * wscal (ji,jj,ikt) 
     165         END DO 
     166      END DO 
     167      zsumsedcal = glob_sum( zwork (:,:) * e1e2t(:,:) ) * 2.0 * rday1 
    183168#endif 
    184169 
    … …  
    191176      DO jj = 1, jpj 
    192177         DO ji = 1, jpi 
    193             ikt = MAX( mbathy(ji,jj) - 1, 1 ) 
    194             zconctmp = trn(ji,jj,ikt,jpdsi) * zstep / fse3t(ji,jj,ikt)   & 
    195 # if ! defined key_kriest 
    196      &             * wscal (ji,jj,ikt) 
     178            ikt = mbkt(ji,jj) 
     179            zfact = xstep / fse3t(ji,jj,ikt) 
     180            zwsbio3 = 1._wp - zfact * wsbio3(ji,jj,ikt) 
     181            zwsbio4 = 1._wp - zfact * wsbio4(ji,jj,ikt) 
     182            zwscal  = 1._wp - zfact * wscal (ji,jj,ikt) 
     183            ! 
     184# if defined key_kriest 
     185            trn(ji,jj,ikt,jpdsi) = trn(ji,jj,ikt,jpdsi) * zwsbio4 
     186            trn(ji,jj,ikt,jpnum) = trn(ji,jj,ikt,jpnum) * zwsbio4 
     187            trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) * zwsbio3 
     188            trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) * zwsbio3 
    197189# else 
    198      &             * wsbio4(ji,jj,ikt) 
     190            trn(ji,jj,ikt,jpdsi) = trn(ji,jj,ikt,jpdsi) * zwscal  
     191            trn(ji,jj,ikt,jpgoc) = trn(ji,jj,ikt,jpgoc) * zwsbio4 
     192            trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) * zwsbio3 
     193            trn(ji,jj,ikt,jpbfe) = trn(ji,jj,ikt,jpbfe) * zwsbio4 
     194            trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) * zwsbio3 
    199195# endif 
    200             trn(ji,jj,ikt,jpdsi) = trn(ji,jj,ikt,jpdsi) - zconctmp 
     196            trn(ji,jj,ikt,jpcal) = trn(ji,jj,ikt,jpcal) * zwscal 
     197         END DO 
     198      END DO 
    201199 
    202200#if ! defined key_sed 
    203             trn(ji,jj,ikt,jpsil) = trn(ji,jj,ikt,jpsil) + zconctmp   & 
    204             &      * ( 1.- ( sumdepsi + rivalkinput / ryyss / 6. ) / zsumsedsi ) 
    205 #endif 
    206          END DO 
    207       END DO 
    208  
     201      zrivsil =  1._wp - ( sumdepsi + rivalkinput * ryyss1 / 6. ) / zsumsedsi  
     202      zrivalk =  1._wp - ( rivalkinput * ryyss1 ) / zsumsedcal  
     203      zrivpo4 =  1._wp - ( rivpo4input * ryyss1 ) / zsumsedpo4  
    209204      DO jj = 1, jpj 
    210205         DO ji = 1, jpi 
    211             ikt = MAX( mbathy(ji,jj) - 1, 1 ) 
    212             zconctmp = trn(ji,jj,ikt,jpcal) * wscal(ji,jj,ikt) * zstep / fse3t(ji,jj,ikt) 
    213             trn(ji,jj,ikt,jpcal) = trn(ji,jj,ikt,jpcal) - zconctmp 
    214  
    215 #if ! defined key_sed 
    216             trn(ji,jj,ikt,jptal) = trn(ji,jj,ikt,jptal) + zconctmp   & 
    217                &   * ( 1.- ( rivalkinput / ryyss ) / zsumsedcal ) * 2.e0 
    218             trn(ji,jj,ikt,jpdic) = trn(ji,jj,ikt,jpdic) + zconctmp   & 
    219                &   * ( 1.- ( rivalkinput / ryyss ) / zsumsedcal ) 
    220 #endif 
    221          END DO 
    222       END DO 
    223  
    224       DO jj = 1, jpj 
    225          DO ji = 1, jpi 
    226             ikt = MAX( mbathy(ji,jj) - 1, 1 ) 
    227             zfact = zstep / fse3t(ji,jj,ikt) 
    228 # if ! defined key_kriest 
    229             zconctmp  = trn(ji,jj,ikt,jpgoc) 
    230             zconctmp2 = trn(ji,jj,ikt,jppoc) 
    231             trn(ji,jj,ikt,jpgoc) = trn(ji,jj,ikt,jpgoc) - zconctmp  * wsbio4(ji,jj,ikt) * zfact 
    232             trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) - zconctmp2 * wsbio3(ji,jj,ikt) * zfact 
    233 #if ! defined key_sed 
    234             trn(ji,jj,ikt,jpdoc) = trn(ji,jj,ikt,jpdoc)    & 
    235             &      + ( zconctmp  * wsbio4(ji,jj,ikt) + zconctmp2 * wsbio3(ji,jj,ikt) ) * zfact   & 
    236             &      * ( 1.- rivpo4input / (ryyss * zsumsedpo4 ) ) 
    237 #endif 
    238             trn(ji,jj,ikt,jpbfe) = trn(ji,jj,ikt,jpbfe) - trn(ji,jj,ikt,jpbfe) * wsbio4(ji,jj,ikt) * zfact 
    239             trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) - trn(ji,jj,ikt,jpsfe) * wsbio3(ji,jj,ikt) * zfact 
    240  
     206            ikt = mbkt(ji,jj) 
     207            zfact = xstep / fse3t(ji,jj,ikt) 
     208            zwsbio3 = zfact * wsbio3(ji,jj,ikt) 
     209            zwsbio4 = zfact * wsbio4(ji,jj,ikt) 
     210            zwscal  = zfact * wscal (ji,jj,ikt) 
     211            trn(ji,jj,ikt,jptal) =  trn(ji,jj,ikt,jptal) + trn(ji,jj,ikt,jpcal) * zwscal  * zrivalk * 2.0 
     212            trn(ji,jj,ikt,jpdic) =  trn(ji,jj,ikt,jpdic) + trn(ji,jj,ikt,jpcal) * zwscal  * zrivalk 
     213# if defined key_kriest 
     214            trn(ji,jj,ikt,jpsil) =  trn(ji,jj,ikt,jpsil) + trn(ji,jj,ikt,jpdsi) * zwsbio4 * zrivsil  
     215            trn(ji,jj,ikt,jpdoc) =  trn(ji,jj,ikt,jpdoc) + trn(ji,jj,ikt,jppoc) * zwsbio3 * zrivpo4  
    241216# else 
    242             zconctmp  = trn(ji,jj,ikt,jpnum) 
    243             zconctmp2 = trn(ji,jj,ikt,jppoc) 
    244             trn(ji,jj,ikt,jpnum) = trn(ji,jj,ikt,jpnum)   & 
    245             &      - zconctmp  * wsbio4(ji,jj,ikt) * zfact 
    246             trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc)   & 
    247             &      - zconctmp2 * wsbio3(ji,jj,ikt) * zfact 
    248 #if ! defined key_sed 
    249             trn(ji,jj,ikt,jpdoc) = trn(ji,jj,ikt,jpdoc)    & 
    250             &      + ( zconctmp2 * wsbio3(ji,jj,ikt) )   & 
    251             &      * zfact * ( 1.- rivpo4input / ( ryyss * zsumsedpo4 ) ) 
    252 #endif 
    253             trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe)   & 
    254             &      - trn(ji,jj,ikt,jpsfe) * wsbio3(ji,jj,ikt) * zfact 
    255  
     217            trn(ji,jj,ikt,jpsil) =  trn(ji,jj,ikt,jpsil) + trn(ji,jj,ikt,jpdsi) * zwscal  * zrivsil  
     218            trn(ji,jj,ikt,jpdoc) =  trn(ji,jj,ikt,jpdoc)   & 
     219            &                     + ( trn(ji,jj,ikt,jppoc) * zwsbio3 + trn(ji,jj,ikt,jpgoc) * zwsbio4 ) * zrivpo4 
    256220# endif 
    257221         END DO 
    258222      END DO 
     223# endif 
    259224 
    260225      ! Nitrogen fixation (simple parameterization). The total gain 
    … …  
    263228      ! ------------------------------------------------------------- 
    264229 
    265       zdenitot = 0.e0 
    266       DO jk = 1, jpkm1 
    267          DO jj = 1,jpj 
    268             DO ji = 1,jpi 
    269                zdenitot = zdenitot + denitr(ji,jj,jk) * rdenit * cvol(ji,jj,jk) * xnegtr(ji,jj,jk) 
    270             END DO 
    271          END DO 
    272       END DO 
    273  
    274       IF( lk_mpp )   CALL mpp_sum( zdenitot )      ! sum over the global domain 
     230      zdenitot = glob_sum( denitr(:,:,:)  * cvol(:,:,:) * xnegtr(:,:,:) ) * rdenit 
    275231 
    276232      ! Potential nitrogen fixation dependant on temperature and iron 
    … …  
    285241               zlim = ( 1.- xnanono3(ji,jj,jk) - xnanonh4(ji,jj,jk) ) 
    286242               IF( zlim <= 0.2 )   zlim = 0.01 
    287                znitrpot(ji,jj,jk) = MAX( 0.e0, ( 0.6 * tgfunc(ji,jj,jk) - 2.15 ) / rday )   & 
    288 # if defined key_off_degrad 
     243               znitrpot(ji,jj,jk) = MAX( 0.e0, ( 0.6 * tgfunc(ji,jj,jk) - 2.15 ) * rday1 )   & 
     244# if defined key_degrad 
    289245               &                  * facvol(ji,jj,jk)   & 
    290246# endif 
    … …  
    295251      END DO 
    296252 
    297       znitrpottot = 0.e0 
    298       DO jk = 1, jpkm1 
    299          DO jj = 1, jpj 
    300             DO ji = 1, jpi 
    301                znitrpottot = znitrpottot + znitrpot(ji,jj,jk) * cvol(ji,jj,jk) 
    302             END DO 
    303          END DO 
    304       END DO 
    305  
    306       IF( lk_mpp )   CALL mpp_sum( znitrpottot )  ! sum over the global domain 
     253      znitrpottot = glob_sum( znitrpot(:,:,:) * cvol(:,:,:) ) 
    307254 
    308255      ! Nitrogen change due to nitrogen fixation 
    … …  
    312259         DO jj = 1, jpj 
    313260            DO ji = 1, jpi 
    314 # if ! defined key_c1d && ( defined key_orca_r4 || defined key_orca_r2 || defined key_orca_r05 || defined key_orca_r025 ) 
    315 !!             zfact = znitrpot(ji,jj,jk) * zdenitot / znitrpottot 
    316261               zfact = znitrpot(ji,jj,jk) * 1.e-7 
    317 # else 
    318                zfact = znitrpot(ji,jj,jk) * 1.e-7 
    319 # endif 
    320262               trn(ji,jj,jk,jpnh4) = trn(ji,jj,jk,jpnh4) + zfact 
    321263               trn(ji,jj,jk,jpoxy) = trn(ji,jj,jk,jpoxy) + zfact   * o2nit 
    … …  
    325267      END DO 
    326268 
    327 #if defined key_trc_diaadd || defined key_trc_dia3d 
    328       zrfact2 = 1.e+3 * rfact2r 
     269#if defined key_diatrc 
     270      zfact = 1.e+3 * rfact2r 
    329271#  if  ! defined key_iomput 
    330       trc2d(:,:,jp_pcs0_2d + 11) = zirondep(:,:,1)         * zrfact2 * fse3t(:,:,1) * tmask(:,:,1) 
    331       trc2d(:,:,jp_pcs0_2d + 12) = znitrpot(:,:,1) * 1.e-7 * zrfact2 * fse3t(:,:,1) * tmask(:,:,1) 
    332 # else 
    333       ! surface downward net flux of iron 
    334       zw2d(:,:)   =  ( zirondep(:,:,1) + ironsed(:,:,1) * rfact2 ) * zrfact2 * fse3t(:,:,1) * tmask(:,:,1)  
    335       IF( jnt == nrdttrc ) CALL iom_put( "Irondep", zw2d ) 
    336       ! nitrogen fixation at surface 
    337       zw2d(:,:)   =  znitrpot(:,:,1) * 1.e-7 * zrfact2  * fse3t(:,:,1) * tmask(:,:,1) 
    338       IF( jnt == nrdttrc ) CALL iom_put( "Nfix" , zw2d ) 
    339 # endif 
    340 # endif 
     272      trc2d(:,:,jp_pcs0_2d + 11) = zirondep(:,:,1)         * zfact * fse3t(:,:,1) * tmask(:,:,1) 
     273      trc2d(:,:,jp_pcs0_2d + 12) = znitrpot(:,:,1) * 1.e-7 * zfact * fse3t(:,:,1) * tmask(:,:,1) 
     274#  else 
     275      zwork (:,:)  =  ( zirondep(:,:,1) + ironsed(:,:,1) * rfact2 ) * zfact * fse3t(:,:,1) * tmask(:,:,1)  
     276      zwork1(:,:)  =  znitrpot(:,:,1) * 1.e-7                       * zfact * fse3t(:,:,1) * tmask(:,:,1) 
     277      IF( jnt == nrdttrc ) THEN 
     278         CALL iom_put( "Irondep", zwork  )  ! surface downward net flux of iron 
     279         CALL iom_put( "Nfix"   , zwork1 )  ! nitrogen fixation at surface 
     280      ENDIF 
     281#  endif 
     282#endif 
    341283      ! 
    342284       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    … …  
    348290   END SUBROUTINE p4z_sed 
    349291 
    350    SUBROUTINE p4z_sbc(kt) 
     292   SUBROUTINE p4z_sbc( kt ) 
    351293 
    352294      !!---------------------------------------------------------------------- 
    … …  
    365307 
    366308      !! * Local declarations 
    367       INTEGER ::   & 
    368          imois, imois2,       &  ! temporary integers 
    369          i15  , iman             !    "          " 
    370       REAL(wp) ::   & 
    371          zxy                     !    "         " 
    372  
     309      INTEGER :: imois, i15, iman  
     310      REAL(wp) :: zxy 
    373311 
    374312      !!--------------------------------------------------------------------- 
    … …  
    381319      imois = nmonth + i15 - 1 
    382320      IF( imois == 0 ) imois = iman 
    383       imois2 = nmonth 
    384  
    385       ! 1. first call kt=nit000 
    386       ! ----------------------- 
    387  
    388       IF( kt == nit000 ) THEN 
    389          ! initializations 
    390          nflx1  = 0 
    391          nflx11 = 0 
    392          ! open the file 
    393          IF(lwp) THEN 
    394             WRITE(numout,*) ' ' 
    395             WRITE(numout,*) ' **** Routine p4z_sbc' 
    396          ENDIF 
    397          CALL iom_open ( 'dust.orca.nc', numdust ) 
    398       ENDIF 
    399  
    400  
    401      ! Read monthly file 
    402       ! ---------------- 
    403  
     321 
     322      ! Calendar computation 
    404323      IF( kt == nit000 .OR. imois /= nflx1 ) THEN 
    405324 
    406          ! Calendar computation 
     325         IF( kt == nit000 )  nflx1  = 0 
    407326 
    408327         ! nflx1 number of the first file record used in the simulation 
    … …  
    410329 
    411330         nflx1 = imois 
    412          nflx2 = nflx1+1 
     331         nflx2 = nflx1 + 1 
    413332         nflx1 = MOD( nflx1, iman ) 
    414333         nflx2 = MOD( nflx2, iman ) 
    415334         IF( nflx1 == 0 )   nflx1 = iman 
    416335         IF( nflx2 == 0 )   nflx2 = iman 
    417          IF(lwp) WRITE(numout,*) 'first record file used nflx1 ',nflx1 
    418          IF(lwp) WRITE(numout,*) 'last  record file used nflx2 ',nflx2 
    419  
    420          ! Read monthly fluxes data 
    421  
    422          ! humidity 
    423          CALL iom_get ( numdust, jpdom_data, 'dust', dustmo(:,:,1), nflx1 ) 
    424          CALL iom_get ( numdust, jpdom_data, 'dust', dustmo(:,:,2), nflx2 ) 
    425  
    426          IF(lwp .AND. nitend-nit000 <= 100 ) THEN 
    427             WRITE(numout,*) 
    428             WRITE(numout,*) ' read clio flx ok' 
    429             WRITE(numout,*) 
    430                WRITE(numout,*) 
    431                WRITE(numout,*) 'Clio month: ',nflx1,'  field: dust' 
    432                CALL prihre( dustmo(:,:,1),jpi,jpj,1,jpi,20,1,jpj,10,1e9,numout ) 
    433          ENDIF 
     336         IF(lwp) WRITE(numout,*)  
     337         IF(lwp) WRITE(numout,*) ' p4z_sbc : first record file used nflx1 ',nflx1 
     338         IF(lwp) WRITE(numout,*) ' p4z_sbc : last  record file used nflx2 ',nflx2 
    434339 
    435340      ENDIF 
    436341 
    437      ! 3. at every time step interpolation of fluxes 
     342      ! 3. at every time step interpolation of fluxes 
    438343      ! --------------------------------------------- 
    439344 
    440345      zxy = FLOAT( nday + 15 - 30 * i15 ) / 30 
    441       dust(:,:) = ( (1.-zxy) * dustmo(:,:,1) + zxy * dustmo(:,:,2) ) 
    442  
    443       IF( kt == nitend ) CALL iom_close (numdust) 
     346      dust(:,:) = ( (1.-zxy) * dustmo(:,:,nflx1) + zxy * dustmo(:,:,nflx2) ) 
    444347 
    445348   END SUBROUTINE p4z_sbc 
    … …  
    454357      !! 
    455358      !! ** Method  :   Read the files and compute the budget 
    456       !!      called at the first timestep (nittrc000) 
     359      !!      called at the first timestep (nit000) 
    457360      !! 
    458361      !! ** input   :   external netcdf files 
    … …  
    460363      !!---------------------------------------------------------------------- 
    461364 
    462       INTEGER ::   ji, jj, jk, jm 
    463       INTEGER , PARAMETER ::   jpmois = 12, jpan = 1 
     365      INTEGER :: ji, jj, jk, jm 
    464366      INTEGER :: numriv, numbath, numdep 
    465367 
    … …  
    469371      REAL(wp) , DIMENSION (jpi,jpj)     ::   riverdoc, river, ndepo 
    470372      REAL(wp) , DIMENSION (jpi,jpj,jpk) ::   cmask 
    471       REAL(wp) , DIMENSION(jpi,jpj,12)    ::   zdustmo 
    472373 
    473374      NAMELIST/nampissed/ ln_dustfer, ln_river, ln_ndepo, ln_sedinput, sedfeinput, dustsolub 
    … …  
    495396         IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' 
    496397         CALL iom_open ( 'dust.orca.nc', numdust ) 
    497          DO jm = 1, jpmois 
    498             CALL iom_get( numdust, jpdom_data, 'dust', zdustmo(:,:,jm), jm ) 
     398         DO jm = 1, jpmth 
     399            CALL iom_get( numdust, jpdom_data, 'dust', dustmo(:,:,jm), jm ) 
    499400         END DO 
    500401         CALL iom_close( numdust ) 
    501402      ELSE 
    502          zdustmo(:,:,:) = 0.e0 
     403         dustmo(:,:,:) = 0.e0 
    503404         dust(:,:) = 0.0 
    504405      ENDIF 
    … …  
    510411         IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    511412         CALL iom_open ( 'river.orca.nc', numriv ) 
    512          CALL iom_get  ( numriv, jpdom_data, 'riverdic', river   (:,:), jpan ) 
    513          CALL iom_get  ( numriv, jpdom_data, 'riverdoc', riverdoc(:,:), jpan ) 
     413         CALL iom_get  ( numriv, jpdom_data, 'riverdic', river   (:,:), jpyr ) 
     414         CALL iom_get  ( numriv, jpdom_data, 'riverdoc', riverdoc(:,:), jpyr ) 
    514415         CALL iom_close( numriv ) 
    515416      ELSE 
    … …  
    524425         IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    525426         CALL iom_open ( 'ndeposition.orca.nc', numdep ) 
    526          CALL iom_get  ( numdep, jpdom_data, 'ndep', ndepo(:,:), jpan ) 
     427         CALL iom_get  ( numdep, jpdom_data, 'ndep', ndepo(:,:), jpyr ) 
    527428         CALL iom_close( numdep ) 
    528429      ELSE 
    … …  
    537438         IF(lwp) WRITE(numout,*) '       from bathy.orca.nc file ' 
    538439         CALL iom_open ( 'bathy.orca.nc', numbath ) 
    539          CALL iom_get  ( numbath, jpdom_data, 'bathy', cmask(:,:,:), jpan ) 
     440         CALL iom_get  ( numbath, jpdom_data, 'bathy', cmask(:,:,:), jpyr ) 
    540441         CALL iom_close( numbath ) 
    541442         ! 
    … …  
    546447                     zmaskt = tmask(ji+1,jj,jk) * tmask(ji-1,jj,jk) * tmask(ji,jj+1,jk)    & 
    547448                        &                       * tmask(ji,jj-1,jk) * tmask(ji,jj,jk+1) 
    548                      IF( zmaskt == 0. )   cmask(ji,jj,jk ) = 0.1 
     449                     IF( zmaskt == 0. )   cmask(ji,jj,jk ) = MAX( 0.1, cmask(ji,jj,jk) )  
    549450                  ENDIF 
    550451               END DO 
    … …  
    567468 
    568469 
    569       ! Number of seconds per year and per month 
    570       ryyss = nyear_len(1) * rday 
    571       rmtss = ryyss / raamo 
     470      !                                    ! Number of seconds per year and per month 
     471      ryyss  = nyear_len(1) * rday 
     472      rmtss  = ryyss / raamo 
     473      rday1  = 1. / rday 
     474      ryyss1 = 1. / ryyss 
     475      !                                    ! ocean surface cell 
     476      e1e2t(:,:) = e1t(:,:) * e2t(:,:) 
    572477 
    573478      ! total atmospheric supply of Si 
    574479      ! ------------------------------ 
    575480      sumdepsi = 0.e0 
    576       DO jm = 1, jpmois 
    577          DO jj = 2, jpjm1 
    578             DO ji = fs_2, fs_jpim1 
    579                sumdepsi = sumdepsi + zdustmo(ji,jj,jm) / (12.*rmtss) * 8.8        & 
    580                   &     * 0.075/28.1 * e1t(ji,jj) * e2t(ji,jj) * tmask(ji,jj,1) * tmask_i(ji,jj) 
    581             END DO 
    582          END DO 
    583       END DO 
    584       IF( lk_mpp )  CALL mpp_sum( sumdepsi )  ! sum over the global domain 
     481      DO jm = 1, jpmth 
     482         zcoef = 1. / ( 12. * rmtss ) * 8.8 * 0.075 / 28.1         
     483         sumdepsi = sumdepsi + glob_sum( dustmo(:,:,jm) * e1e2t(:,:) ) * zcoef 
     484      ENDDO 
    585485 
    586486      ! N/P and Si releases due to coastal rivers 
    … …  
    588488      DO jj = 1, jpj 
    589489         DO ji = 1, jpi 
    590             zcoef = ryyss * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,1) * tmask(ji,jj,1) * tmask_i(ji,jj) 
     490            zcoef = ryyss * e1e2t(ji,jj)  * fse3t(ji,jj,1) * tmask(ji,jj,1)  
    591491            cotdep(ji,jj) =  river(ji,jj)                  *1E9 / ( 12. * zcoef + rtrn ) 
    592492            rivinp(ji,jj) = (river(ji,jj)+riverdoc(ji,jj)) *1E9 / ( 31.6* zcoef + rtrn ) 
    … …  
    597497      CALL lbc_lnk( cotdep , 'T', 1. )  ;  CALL lbc_lnk( rivinp , 'T', 1. )  ;  CALL lbc_lnk( nitdep , 'T', 1. ) 
    598498 
    599       rivpo4input = 0.e0 
    600       rivalkinput = 0.e0 
    601       nitdepinput = 0.e0 
    602       DO jj = 2 , jpjm1 
    603          DO ji = fs_2, fs_jpim1 
    604             zcoef = cvol(ji,jj,1) * ryyss 
    605             rivpo4input = rivpo4input + rivinp(ji,jj) * zcoef 
    606             rivalkinput = rivalkinput + cotdep(ji,jj) * zcoef 
    607             nitdepinput = nitdepinput + nitdep(ji,jj) * zcoef 
    608          END DO 
    609      END DO 
    610       IF( lk_mpp ) THEN 
    611          CALL mpp_sum( rivpo4input )  ! sum over the global domain 
    612          CALL mpp_sum( rivalkinput )  ! sum over the global domain 
    613          CALL mpp_sum( nitdepinput )  ! sum over the global domain 
    614       ENDIF 
     499      rivpo4input = glob_sum( rivinp(:,:) * cvol(:,:,1) ) * ryyss 
     500      rivalkinput = glob_sum( cotdep(:,:) * cvol(:,:,1) ) * ryyss 
     501      nitdepinput = glob_sum( nitdep(:,:) * cvol(:,:,1) ) * ryyss 
    615502 
    616503 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsink.F90

    • Property svn:executable deleted
    r1836 r2528  
    1919   PRIVATE 
    2020 
    21    PUBLIC   p4z_sink    ! called in p4zbio.F90 
     21   PUBLIC   p4z_sink         ! called in p4zbio.F90 
     22   PUBLIC   p4z_sink_init    ! called in trcsms_pisces.F90 
    2223 
    2324   !! * Shared module variables 
    … …  
    3132     sinkcal, sinksil,    &    !: CaCO3 and BSi sinking fluxes 
    3233     sinkfer                   !: Small BFe sinking flux 
    33  
    34    REAL(wp) ::   & 
    35      xstep , xstep2            !: Time step duration for biology 
    3634 
    3735   INTEGER  :: & 
    … …  
    7169#  include "top_substitute.h90" 
    7270   !!---------------------------------------------------------------------- 
    73    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     71   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    7472   !! $Id$  
    75    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     73   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    7674   !!---------------------------------------------------------------------- 
    7775 
    … …  
    9795      REAL(wp) :: zdiv , zdiv1, zdiv2, zdiv3, zdiv4, zdiv5 
    9896      REAL(wp) :: zval1, zval2, zval3, zval4 
    99 #if defined key_trc_diaadd 
     97#if defined key_diatrc 
    10098      REAL(wp) :: zrfact2 
    10199      INTEGER  :: ik1 
    … …  
    106104      !!--------------------------------------------------------------------- 
    107105 
    108       IF( ( kt * jnt ) == nittrc000  )  THEN  
    109           CALL p4z_sink_init   ! Initialization (first time-step only) 
    110           xstep  = rfact2 / rday      ! Time step duration for biology 
    111           xstep2 = rfact2 /  2. 
    112       ENDIF 
    113  
    114 !     Initialisation of variables used to compute Sinking Speed 
    115 !     --------------------------------------------------------- 
     106      !     Initialisation of variables used to compute Sinking Speed 
     107      !     --------------------------------------------------------- 
    116108 
    117109       znum3d(:,:,:) = 0.e0 
    … …  
    120112       zval3 = 1. + xkr_eta 
    121113 
    122 !     Computation of the vertical sinking speed : Kriest et Evans, 2000 
    123 !     ----------------------------------------------------------------- 
     114     !     Computation of the vertical sinking speed : Kriest et Evans, 2000 
     115     !     ----------------------------------------------------------------- 
    124116 
    125117      DO jk = 1, jpkm1 
    … …  
    128120               IF( tmask(ji,jj,jk) /= 0.e0 ) THEN 
    129121                  znum = trn(ji,jj,jk,jppoc) / ( trn(ji,jj,jk,jpnum) + rtrn ) / xkr_massp 
    130 ! -------------- To avoid sinking speed over 50 m/day ------- 
     122                  ! -------------- To avoid sinking speed over 50 m/day ------- 
    131123                  znum  = MIN( xnumm(jk), znum ) 
    132124                  znum  = MAX( 1.1      , znum ) 
    133125                  znum3d(ji,jj,jk) = znum 
    134 !------------------------------------------------------------ 
     126                  !------------------------------------------------------------ 
    135127                  zeps  = ( zval1 * znum - 1. )/ ( znum - 1. ) 
    136128                  zfm   = xkr_frac**( 1. - zeps ) 
    … …  
    150142      wscal(:,:,:) = MAX( wsbio3(:,:,:), 50. ) 
    151143 
    152  
    153 !   INITIALIZE TO ZERO ALL THE SINKING ARRAYS 
    154 !   ----------------------------------------- 
     144      !   INITIALIZE TO ZERO ALL THE SINKING ARRAYS 
     145      !   ----------------------------------------- 
    155146 
    156147      sinking (:,:,:) = 0.e0 
    … …  
    160151      sinksil (:,:,:) = 0.e0 
    161152 
    162 !   Compute the sedimentation term using p4zsink2 for all 
    163 !   the sinking particles 
    164 !   ----------------------------------------------------- 
     153     !   Compute the sedimentation term using p4zsink2 for all the sinking particles 
     154     !   ----------------------------------------------------- 
    165155 
    166156      CALL p4z_sink2( wsbio3, sinking , jppoc ) 
    … …  
    170160      CALL p4z_sink2( wscal , sinkcal , jpcal ) 
    171161 
    172 !  Exchange between organic matter compartments due to 
    173 !  coagulation/disaggregation 
    174 !  --------------------------------------------------- 
     162     !  Exchange between organic matter compartments due to coagulation/disaggregation 
     163     !  --------------------------------------------------- 
    175164 
    176165      zval1 = 1. + xkr_zeta 
    … …  
    185174 
    186175                  znum = trn(ji,jj,jk,jppoc)/(trn(ji,jj,jk,jpnum)+rtrn) / xkr_massp 
    187 ! -------------- To avoid sinking speed over 50 m/day ------- 
     176                  !-------------- To avoid sinking speed over 50 m/day ------- 
    188177                  znum  = min(xnumm(jk),znum) 
    189178                  znum  = MAX( 1.1,znum) 
    190 !------------------------------------------------------------ 
     179                  !------------------------------------------------------------ 
    191180                  zeps  = ( zval1 * znum - 1.) / ( znum - 1.) 
    192181                  zdiv  = MAX( 1.e-4, ABS( zeps - zval3) ) * SIGN( 1., zeps - zval3 ) 
    … …  
    199188                  zsm   = xkr_frac**xkr_eta 
    200189 
    201 !    Part I : Coagulation dependant on turbulence 
    202 !    ---------------------------------------------- 
     190                  !    Part I : Coagulation dependant on turbulence 
     191                  !    ---------------------------------------------- 
    203192 
    204193                  zagg1 = ( 0.163 * trn(ji,jj,jk,jpnum)**2               & 
    … …  
    207196                     &            * (zfm*xkr_mass_max**2-xkr_mass_min**2)                  & 
    208197                     &            * (zeps-1.)**2/(zdiv2*zdiv3))            & 
    209 # if defined key_off_degrad 
     198# if defined key_degrad 
    210199                     &                 *facvol(ji,jj,jk)       & 
    211200# endif 
    … …  
    219208                     &                    -zfm*xkr_mass_max**3*(1.+3.*((zeps-1.)/           & 
    220209                     &                    (zeps-2.)+(zeps-1.)/zdiv3)+(zeps-1.)/zdiv1))      & 
    221 #    if defined key_off_degrad 
     210#    if defined key_degrad 
    222211                     &                 *facvol(ji,jj,jk)             & 
    223212#    endif 
    … …  
    225214 
    226215                  zagg3 = (  0.163*trn(ji,jj,jk,jpnum)**2*zfm**2*8. * xkr_mass_max**3   & 
    227 #    if defined key_off_degrad 
     216#    if defined key_degrad 
    228217                     &                 *facvol(ji,jj,jk)             & 
    229218#    endif 
    … …  
    232221                  zaggsh = ( zagg1 + zagg2 + zagg3 ) * rfact2 * xdiss(ji,jj,jk) / 1000. 
    233222 
    234 !    Aggregation of small into large particles 
    235 !    Part II : Differential settling 
    236 !    ---------------------------------------------- 
     223                 !    Aggregation of small into large particles 
     224                 !    Part II : Differential settling 
     225                 !    ---------------------------------------------- 
    237226 
    238227                  zagg4 = (  2.*3.141*0.125*trn(ji,jj,jk,jpnum)**2*                       & 
    … …  
    242231                     &                 ((zfm*zfm*xkr_mass_max**2*zsm-xkr_mass_min**2)     & 
    243232                     &                 *xkr_eta)/(zdiv*zdiv3*zdiv5) )                     & 
    244 # if defined key_off_degrad 
     233# if defined key_degrad 
    245234                     &                 *facvol(ji,jj,jk)        & 
    246235# endif 
    … …  
    252241                     &                 /zdiv3-(xkr_mass_min**2-zfm*zsm*xkr_mass_max**2)    & 
    253242                     &                 /zdiv)                   & 
    254 # if defined key_off_degrad 
     243# if defined key_degrad 
    255244                     &                 *facvol(ji,jj,jk)        & 
    256245# endif 
    … …  
    261250                  zagg = 0.5 * xkr_stick * ( zaggsh + zaggsi ) 
    262251 
    263 !     Aggregation of DOC to small particles 
    264 !     -------------------------------------- 
     252                  !     Aggregation of DOC to small particles 
     253                  !     -------------------------------------- 
    265254 
    266255                  zaggdoc = ( 0.4 * trn(ji,jj,jk,jpdoc)               & 
    267256                     &        + 1018.  * trn(ji,jj,jk,jppoc)  ) * xstep    & 
    268 # if defined key_off_degrad 
     257# if defined key_degrad 
    269258                     &        * facvol(ji,jj,jk)                              & 
    270259# endif 
    … …  
    281270      END DO 
    282271 
    283 #if defined key_trc_diaadd 
     272#if defined key_diatrc 
    284273      zrfact2 = 1.e3 * rfact2r 
    285274      ik1 = iksed + 1 
    … …  
    332321      !! 
    333322      !! ** Method  :   Read the nampiskrs namelist and check the parameters 
    334       !!      called at the first timestep (nittrc000) 
     323      !!      called at the first timestep  
    335324      !! 
    336325      !! ** input   :   Namelist nampiskrs 
    … …  
    473462      REAL(wp) ::   zagg1, zagg2, zagg3, zagg4 
    474463      REAL(wp) ::   zagg , zaggfe, zaggdoc, zaggdoc2 
    475       REAL(wp) ::   zfact, zwsmax 
    476 #if defined key_trc_dia3d 
     464      REAL(wp) ::   zfact, zwsmax, zstep 
     465#if defined key_diatrc 
    477466      REAL(wp) ::   zrfact2 
    478467      INTEGER  ::   ik1 
    … …  
    481470      !!--------------------------------------------------------------------- 
    482471 
    483       IF( ( kt * jnt ) == nittrc000  )  THEN 
    484           xstep  = rfact2 / rday      ! Timestep duration for biology 
    485           xstep2 = rfact2 /  2. 
    486       ENDIF 
    487  
    488 !    Sinking speeds of detritus is increased with depth as shown 
    489 !    by data and from the coagulation theory 
    490 !    ----------------------------------------------------------- 
     472      !    Sinking speeds of detritus is increased with depth as shown 
     473      !    by data and from the coagulation theory 
     474      !    ----------------------------------------------------------- 
    491475      DO jk = 1, jpkm1 
    492476         DO jj = 1, jpj 
    493477            DO ji=1,jpi 
    494                zfact = MAX( 0., fsdepw(ji,jj,jk+1)-hmld(ji,jj) ) / 4000. 
     478               zfact = MAX( 0., fsdepw(ji,jj,jk+1) - hmld(ji,jj) ) / 4000. 
    495479               wsbio4(ji,jj,jk) = wsbio2 + ( 200.- wsbio2 ) * zfact 
    496480            END DO 
    … …  
    498482      END DO 
    499483 
    500 !      LIMIT THE VALUES OF THE SINKING SPEEDS  
    501 !      TO AVOID NUMERICAL INSTABILITIES 
    502  
     484      ! limit the values of the sinking speeds to avoid numerical instabilities   
    503485      wsbio3(:,:,:) = wsbio 
    504 ! 
    505 ! OA Below, this is garbage. the ideal would be to find a time-splitting 
    506 ! OA algorithm that does not increase the computing cost by too much 
    507 ! OA In ROMS, I have included a time-splitting procedure. But it is  
    508 ! OA too expensive as the loop is computed globally. Thus, a small e3t 
    509 ! OA at one place determines the number of subtimesteps globally 
    510 ! OA AWFULLY EXPENSIVE !! Not able to find a better approach. Damned !! 
     486      ! 
     487      ! OA Below, this is garbage. the ideal would be to find a time-splitting  
     488      ! OA algorithm that does not increase the computing cost by too much 
     489      ! OA In ROMS, I have included a time-splitting procedure. But it is  
     490      ! OA too expensive as the loop is computed globally. Thus, a small e3t 
     491      ! OA at one place determines the number of subtimesteps globally 
     492      ! OA AWFULLY EXPENSIVE !! Not able to find a better approach. Damned !! 
    511493 
    512494      DO jk = 1,jpkm1 
    … …  
    522504      wscal(:,:,:) = wsbio4(:,:,:) 
    523505 
    524 !   INITIALIZE TO ZERO ALL THE SINKING ARRAYS 
    525 !   ----------------------------------------- 
     506      !  Initializa to zero all the sinking arrays  
     507      !   ----------------------------------------- 
    526508 
    527509      sinking (:,:,:) = 0.e0 
    … …  
    532514      sinkfer2(:,:,:) = 0.e0 
    533515 
    534 !   Compute the sedimentation term using p4zsink2 for all 
    535 !   the sinking particles 
    536 !   ----------------------------------------------------- 
     516      !   Compute the sedimentation term using p4zsink2 for all the sinking particles 
     517      !   ----------------------------------------------------- 
    537518 
    538519      CALL p4z_sink2( wsbio3, sinking , jppoc ) 
    … …  
    543524      CALL p4z_sink2( wscal , sinkcal , jpcal ) 
    544525 
    545 !  Exchange between organic matter compartments due to 
    546 !  coagulation/disaggregation 
    547 !  --------------------------------------------------- 
     526      !  Exchange between organic matter compartments due to coagulation/disaggregation 
     527      !  --------------------------------------------------- 
    548528 
    549529      DO jk = 1, jpkm1 
    550530         DO jj = 1, jpj 
    551531            DO ji = 1, jpi 
    552                zfact = xstep * xdiss(ji,jj,jk) 
     532# if defined key_degrad 
     533               zstep = xstep * facvol(ji,jj,jk) 
     534# else 
     535               zstep = xstep  
     536# endif 
     537               zfact = zstep * xdiss(ji,jj,jk) 
    553538               !  Part I : Coagulation dependent on turbulence 
    554 # if defined key_off_degrad 
    555                zagg1 = 940.* zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc) * facvol(ji,jj,jk) 
    556                zagg2 = 1.054e4 * zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc) * facvol(ji,jj,jk) 
    557 # else 
    558539               zagg1 = 940.* zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc) 
    559540               zagg2 = 1.054e4 * zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc) 
    560 # endif 
    561541 
    562542               ! Part II : Differential settling 
    563543 
    564544               !  Aggregation of small into large particles 
    565 # if defined key_off_degrad 
    566                zagg3 = 0.66 * xstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc) * facvol(ji,jj,jk) 
    567                zagg4 = 0.e0 * xstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc) * facvol(ji,jj,jk) 
    568 # else 
    569                zagg3 = 0.66 * xstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc) 
    570                zagg4 = 0.e0 * xstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc) 
    571 # endif 
     545               zagg3 = 0.66 * zstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc) 
     546               zagg4 = 0.e0 * zstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc) 
     547 
    572548               zagg   = zagg1 + zagg2 + zagg3 + zagg4 
    573549               zaggfe = zagg * trn(ji,jj,jk,jpsfe) / ( trn(ji,jj,jk,jppoc) + rtrn ) 
    574550 
    575551               ! Aggregation of DOC to small particles 
    576 #if defined key_off_degrad 
    577                zaggdoc = ( 80.* trn(ji,jj,jk,jpdoc) + 698. * trn(ji,jj,jk,jppoc) )       & 
    578                   &      * facvol(ji,jj,jk)  * zfact * trn(ji,jj,jk,jpdoc) 
    579                zaggdoc2 = 1.05e4 * zfact * trn(ji,jj,jk,jpgoc)   & 
    580                   &      * facvol(ji,jj,jk) * trn(ji,jj,jk,jpdoc) 
    581 #else 
    582                zaggdoc = ( 80.* trn(ji,jj,jk,jpdoc) + 698. * trn(ji,jj,jk,jppoc) )    & 
    583                   &      *  zfact * trn(ji,jj,jk,jpdoc) 
     552               zaggdoc = ( 80.* trn(ji,jj,jk,jpdoc) + 698. * trn(ji,jj,jk,jppoc) ) *  zfact * trn(ji,jj,jk,jpdoc)  
    584553               zaggdoc2 = 1.05e4 * zfact * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpdoc) 
    585 #endif 
     554 
    586555               !  Update the trends 
    587556               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zagg + zaggdoc 
    … …  
    595564      END DO 
    596565 
    597 #if defined key_trc_diaadd 
     566#if defined key_diatrc 
    598567      zrfact2 = 1.e3 * rfact2r 
    599568      ik1  = iksed + 1 
    … …  
    623592   END SUBROUTINE p4z_sink 
    624593 
     594   SUBROUTINE p4z_sink_init 
     595      !!---------------------------------------------------------------------- 
     596      !!                  ***  ROUTINE p4z_sink_init  *** 
     597      !!---------------------------------------------------------------------- 
     598   END SUBROUTINE p4z_sink_init 
     599 
    625600#endif 
    626601 
    … …  
    641616      !! 
    642617      INTEGER  ::   ji, jj, jk, jn 
    643       REAL(wp) ::   zigma,zew,zign, zflx 
     618      REAL(wp) ::   zigma,zew,zign, zflx, zstep 
    644619      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  ztraz, zakz 
    645620      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zwsink2 
    … …  
    647622 
    648623 
     624      zstep = rfact2 / 2. 
     625 
    649626      ztraz(:,:,:) = 0.e0 
    650627      zakz (:,:,:) = 0.e0 
    651628 
    652629      DO jk = 1, jpkm1 
    653 # if defined key_off_degrad 
     630# if defined key_degrad 
    654631         zwsink2(:,:,jk+1) = -pwsink(:,:,jk) / rday * tmask(:,:,jk+1) * facvol(:,:,jk) 
    655632# else 
    … …  
    693670            DO jj = 1, jpj       
    694671               DO ji = 1, jpi     
    695                   zigma = zwsink2(ji,jj,jk+1) * xstep2 / fse3w(ji,jj,jk+1) 
     672                  zigma = zwsink2(ji,jj,jk+1) * zstep / fse3w(ji,jj,jk+1) 
    696673                  zew   = zwsink2(ji,jj,jk+1) 
    697                   psinkflx(ji,jj,jk+1) = -zew * ( trn(ji,jj,jk,jp_tra) - 0.5 * ( 1 + zigma ) * zakz(ji,jj,jk) ) * xstep2 
     674                  psinkflx(ji,jj,jk+1) = -zew * ( trn(ji,jj,jk,jp_tra) - 0.5 * ( 1 + zigma ) * zakz(ji,jj,jk) ) * zstep 
    698675               END DO 
    699676            END DO 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/par_pisces.F90

    r2049 r2528  
    66   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture 
    77   !!---------------------------------------------------------------------- 
    8    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     8   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    99   !! $Id$  
    10    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     10   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    1111   !!---------------------------------------------------------------------- 
    1212   USE par_lobster, ONLY : jp_lobster      !: number of tracers in LOBSTER 
    … …  
    1717   IMPLICIT NONE 
    1818 
    19    INTEGER, PARAMETER ::   jp_lp      = jp_lobster      !: cumulative number of already defined TRC 
    20    INTEGER, PARAMETER ::   jp_lp_2d   = jp_lobster_2d   !: 
    21    INTEGER, PARAMETER ::   jp_lp_3d   = jp_lobster_3d   !: 
    22    INTEGER, PARAMETER ::   jp_lp_trd  = jp_lobster_trd  !: 
     19   INTEGER, PUBLIC, PARAMETER ::   jp_lp      = jp_lobster      !: cumulative number of already defined TRC 
     20   INTEGER, PUBLIC, PARAMETER ::   jp_lp_2d   = jp_lobster_2d   !: 
     21   INTEGER, PUBLIC, PARAMETER ::   jp_lp_3d   = jp_lobster_3d   !: 
     22   INTEGER, PUBLIC, PARAMETER ::   jp_lp_trd  = jp_lobster_trd  !: 
    2323 
    2424#if defined key_pisces  &&  defined key_kriest 
    … …  
    2929   LOGICAL, PUBLIC, PARAMETER ::   lk_kriest     = .TRUE.  !: Kriest flag  
    3030   INTEGER, PUBLIC, PARAMETER ::   jp_pisces     =  23     !: number of passive tracers 
    31    INTEGER, PUBLIC, PARAMETER ::   jp_pisces_2d  =  13     !: additional 2d output ('key_trc_diaadd') 
    32    INTEGER, PUBLIC, PARAMETER ::   jp_pisces_3d  =  18     !: additional 3d output ('key_trc_diaadd') 
     31   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_2d  =  13     !: additional 2d output ('key_diatrc') 
     32   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_3d  =  18     !: additional 3d output ('key_diatrc') 
    3333   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_trd =   1     !: number of sms trends for PISCES 
    3434 
    … …  
    6767   LOGICAL, PUBLIC, PARAMETER ::   lk_kriest     = .FALSE. !: Kriest flag  
    6868   INTEGER, PUBLIC, PARAMETER ::   jp_pisces     = 24      !: number of PISCES passive tracers 
    69    INTEGER, PUBLIC, PARAMETER ::   jp_pisces_2d  = 13      !: additional 2d output ('key_trc_diaadd') 
    70    INTEGER, PUBLIC, PARAMETER ::   jp_pisces_3d  = 11      !: additional 3d output ('key_trc_diaadd') 
     69   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_2d  = 13      !: additional 2d output ('key_diatrc') 
     70   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_3d  = 11      !: additional 3d output ('key_diatrc') 
    7171   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_trd =  1      !: number of sms trends for PISCES 
    7272 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/sms_pisces.F90

    r1836 r2528  
    2323   REAL(wp) ::   rfact , rfactr    !: ??? 
    2424   REAL(wp) ::   rfact2, rfact2r   !: ??? 
     25   REAL(wp) ::   xstep             !: Time step duration for biology 
    2526 
    2627   !!*  Biological parameters  
    … …  
    6263   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   xlimbac    !: ?? 
    6364   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   xdiss      !: ?? 
    64 #if defined key_trc_dia3d 
     65#if defined key_diatrc 
    6566   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   prodcal    !: Calcite production 
    6667   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   grazing    !: Total zooplankton grazing 
    … …  
    9192    
    9293   !!---------------------------------------------------------------------- 
    93    !! NEMO/TOP 3.2 , LOCEAN-IPSL (2009)  
     94   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    9495   !! $Id$  
    95    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     96   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    9697   !!======================================================================    
    9798END MODULE sms_pisces     

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90

    r1800 r2528  
    4040#  include "top_substitute.h90" 
    4141   !!---------------------------------------------------------------------- 
    42    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     42   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    4343   !! $Id$  
    44    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     44   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4545   !!---------------------------------------------------------------------- 
    4646 
    … …  
    5555 
    5656 
     57      !  Control consitency 
     58      CALL trc_ctl_pisces 
     59 
     60 
    5761      IF(lwp) WRITE(numout,*) 
    5862      IF(lwp) WRITE(numout,*) ' trc_ini_pisces :   PISCES biochemical model initialisation' 
    5963      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 
    6064 
    61  
    6265      !                                            ! Time-step 
    63       rfact   = rdttra(1) * float(ndttrc)          ! --------- 
     66      rfact   = rdttrc(1)                          ! --------- 
    6467      rfactr  = 1. / rfact 
    65       rfact2  = rfact / float(nrdttrc) 
     68      rfact2  = rfact / FLOAT( nrdttrc ) 
    6669      rfact2r = 1. / rfact2 
    6770 
    68       IF(lwp) WRITE(numout,*) '    Tracer  time step    rfact  = ', rfact, ' rdt = ', rdt 
    69       IF(lwp) write(numout,*) '    Biology time step    rfact2 = ', rfact2 
     71      IF(lwp) WRITE(numout,*) '    Passive Tracer  time step    rfact  = ', rfact, ' rdt = ', rdttra(1) 
     72      IF(lwp) write(numout,*) '    PISCES  Biology time step    rfact2 = ', rfact2 
    7073 
    7174 
    … …  
    8083 
    8184      CALL p4z_che        ! initialize the chemical constants 
    82  
    83       ndayflxtr = 0      !  Initialize a counter for the computation of chemistry 
    8485 
    8586      ! Initialization of tracer concentration in case of  no restart  
    … …  
    128129      ! 
    129130   END SUBROUTINE trc_ini_pisces 
    130     
     131  
     132   SUBROUTINE trc_ctl_pisces 
     133      !!---------------------------------------------------------------------- 
     134      !!                     ***  ROUTINE trc_ctl_pisces  *** 
     135      !! 
     136      !! ** Purpose :   control the cpp options, namelist and files  
     137      !!---------------------------------------------------------------------- 
     138 
     139      IF(lwp) WRITE(numout,*) 
     140      IF(lwp) WRITE(numout,*) ' use PISCES biological model ' 
     141 
     142   ! Check number of tracers 
     143   ! ----------------------- 
     144#if  defined key_kriest 
     145      IF( jp_pisces /= 23) CALL ctl_stop( ' PISCES must have 23 passive tracers. Change jp_pisces in par_pisces.F90' ) 
     146#else 
     147      IF( jp_pisces /= 24) CALL ctl_stop( ' PISCES must have 24 passive tracers. Change jp_pisces in par_pisces.F90' ) 
     148#endif 
     149 
     150   END SUBROUTINE trc_ctl_pisces 
     151   
    131152#else 
    132153   !!---------------------------------------------------------------------- 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcrst_pisces.F90

    • Property svn:keywords set to Id
    r1836 r2528  
    2121   USE iom 
    2222   USE trcdta 
     23   USE lib_mpp 
     24   USE lib_fortran 
    2325 
    2426   IMPLICIT NONE 
    … …  
    118120      IF(lwp)  WRITE(numout,*) 
    119121 
    120       IF( cp_cfg == "orca" .AND. .NOT. lk_trc_c1d ) THEN      ! ORCA condiguration (not 1D) ! 
     122      IF( cp_cfg == "orca" .AND. .NOT. lk_c1d ) THEN      ! ORCA condiguration (not 1D) ! 
    121123         !                                                    ! --------------------------- ! 
    122124         ! set total alkalinity, phosphate, nitrate & silicate 
    123125 
    124          zalksum = 0.e0 
    125          zpo4sum = 0.e0 
    126          zno3sum = 0.e0 
    127          zsilsum = 0.e0 
    128          DO jk = 1, jpk 
    129             DO jj = 1, jpj 
    130                DO ji = 1, jpi 
    131                   zvol = cvol(ji,jj,jk) 
    132 #  if defined key_off_degrad 
    133                   zvol = zvol * facvol(ji,jj,jk) 
    134 #  endif 
    135                   zalksum = zalksum + trn(ji,jj,jk,jptal) * zvol 
    136                   zpo4sum = zpo4sum + trn(ji,jj,jk,jppo4) * zvol 
    137                   zno3sum = zno3sum + trn(ji,jj,jk,jpno3) * zvol 
    138                   zsilsum = zsilsum + trn(ji,jj,jk,jpsil) * zvol 
    139                END DO 
    140             END DO 
    141          END DO 
    142          IF( lk_mpp )   CALL mpp_sum( zalksum )     ! sum over the global domain 
    143          IF( lk_mpp )   CALL mpp_sum( zpo4sum )     ! sum over the global domain 
    144          IF( lk_mpp )   CALL mpp_sum( zno3sum )     ! sum over the global domain 
    145          IF( lk_mpp )   CALL mpp_sum( zsilsum )     ! sum over the global domain 
    146126         zarea   = 1. / areatot * 1.e6 
    147          zalksum = zalksum * zarea 
    148          zpo4sum = zpo4sum * zarea / 122. 
    149          zno3sum = zno3sum * zarea / 7.6 
    150          zsilsum = zsilsum * zarea 
     127# if defined key_degrad 
     128         zalksum = glob_sum( trn(:,:,:,jptal) * cvol(:,:,:) * facvol(:,:,:) ) * zarea 
     129         zpo4sum = glob_sum( trn(:,:,:,jppo4) * cvol(:,:,:) * facvol(:,:,:) ) * zarea / 122. 
     130         zno3sum = glob_sum( trn(:,:,:,jpno3) * cvol(:,:,:) * facvol(:,:,:) ) * zarea / 7.6 
     131         zsilsum = glob_sum( trn(:,:,:,jpsil) * cvol(:,:,:) * facvol(:,:,:) ) * zarea 
     132# else 
     133         zalksum = glob_sum( trn(:,:,:,jptal) * cvol(:,:,:)  ) * zarea 
     134         zpo4sum = glob_sum( trn(:,:,:,jppo4) * cvol(:,:,:)  ) * zarea / 122. 
     135         zno3sum = glob_sum( trn(:,:,:,jpno3) * cvol(:,:,:)  ) * zarea / 7.6 
     136         zsilsum = glob_sum( trn(:,:,:,jpsil) * cvol(:,:,:)  ) * zarea 
     137# endif 
    151138 
    152139         IF(lwp) WRITE(numout,*) '       TALK mean : ', zalksum 
    … …  
    263250#if defined key_dtatrc 
    264251      ! Restore close seas values to initial data 
    265       CALL trc_dta( nittrc000 )  
     252      CALL trc_dta( nit000 )  
    266253      DO jn = 1, jptra 
    267254         IF( lutini(jn) ) THEN 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcsms_pisces.F90

    • Property svn:executable deleted
    r1753 r2528  
    2222   USE p4zche          !  
    2323   USE p4zbio          !  
     24   USE p4zsink         !  
     25   USE p4zopt          !  
     26   USE p4zlim          !  
     27   USE p4zprod         ! 
     28   USE p4zmort         ! 
     29   USE p4zmicro        !  
     30   USE p4zmeso         !  
     31   USE p4zrem          !  
    2432   USE p4zsed          !  
    2533   USE p4zlys          !  
    2634   USE p4zflx          !  
    2735 
    28    USE trdmld_trc_oce 
    29    USE trdmld_trc 
     36   USE prtctl_trc 
     37 
     38   USE trdmod_oce 
     39   USE trdmod_trc 
    3040 
    3141   USE sedmodel 
    … …  
    3747 
    3848   !!---------------------------------------------------------------------- 
    39    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     49   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    4050   !! $Id$  
    41    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     51   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4252   !!---------------------------------------------------------------------- 
    4353 
    … …  
    5969      INTEGER ::   jnt, jn 
    6070      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztrpis   ! used for pisces sms trends 
     71      CHARACTER (len=25) :: charout 
    6172      !!--------------------------------------------------------------------- 
    6273 
    63       IF( kt == nittrc000  .AND. .NOT. ln_rsttr )   CALL trc_sms_pisces_init    ! Initialization (first time-step only) 
     74      IF( kt == nit000 )   CALL trc_sms_pisces_init    ! Initialization (first time-step only) 
    6475 
    65       IF( ndayflxtr /= nday ) THEN      ! New days 
     76      IF( ndayflxtr /= nday_year ) THEN      ! New days 
    6677         ! 
    67          ndayflxtr = nday 
     78         ndayflxtr = nday_year 
     79 
     80         IF(lwp) write(numout,*) 
     81         IF(lwp) write(numout,*) ' New chemical constants and various rates for biogeochemistry at new day : ', nday_year 
     82         IF(lwp) write(numout,*) '~~~~~~' 
    6883 
    6984         CALL p4z_che          ! computation of chemical constants 
    … …  
    7186         ! 
    7287      ENDIF 
    73  
    7488 
    7589      DO jnt = 1, nrdttrc          ! Potential time splitting if requested 
    … …  
    91105      END DO 
    92106 
     107 
    93108      IF( l_trdtrc ) THEN 
    94109          DO jn = jp_pcs0, jp_pcs1 
    95110            ztrpis(:,:,:) = tra(:,:,:,jn) 
    96             CALL trd_mod_trc( ztrpis, jn, jptrc_trd_sms, kt )   ! save trends 
     111            CALL trd_mod_trc( ztrpis, jn, jptra_trd_sms, kt )   ! save trends 
    97112          END DO 
    98113      END IF 
    … …  
    121136      REAL(wp) ::  ztmas, ztmas1 
    122137 
    123       ! Initialization of chemical variables of the carbon cycle 
    124       ! -------------------------------------------------------- 
    125       DO jk = 1, jpk 
    126          DO jj = 1, jpj 
    127             DO ji = 1, jpi 
    128                ztmas   = tmask(ji,jj,jk) 
    129                ztmas1  = 1. - tmask(ji,jj,jk) 
    130                zcaralk = trn(ji,jj,jk,jptal) - borat(ji,jj,jk) / (  1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) )  ) 
    131                zco3    = ( zcaralk - trn(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1 
    132                zbicarb = ( 2. * trn(ji,jj,jk,jpdic) - zcaralk ) 
    133                hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1 
     138      IF( .NOT. ln_rsttr ) THEN 
     139         ! Initialization of chemical variables of the carbon cycle 
     140         ! -------------------------------------------------------- 
     141         DO jk = 1, jpk 
     142            DO jj = 1, jpj 
     143               DO ji = 1, jpi 
     144                  ztmas   = tmask(ji,jj,jk) 
     145                  ztmas1  = 1. - tmask(ji,jj,jk) 
     146                  zcaralk = trn(ji,jj,jk,jptal) - borat(ji,jj,jk) / (  1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) )  ) 
     147                  zco3    = ( zcaralk - trn(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1 
     148                  zbicarb = ( 2. * trn(ji,jj,jk,jpdic) - zcaralk ) 
     149                  hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1 
     150               END DO 
    134151            END DO 
    135152         END DO 
    136       END DO 
     153         ! 
     154      END IF 
     155 
     156      ! Time step duration for biology 
     157      xstep = rfact2 / rday 
     158 
     159      CALL p4z_sink_init      ! vertical flux of particulate organic matter 
     160      CALL p4z_opt_init       ! Optic: PAR in the water column 
     161      CALL p4z_lim_init       ! co-limitations by the various nutrients 
     162      CALL p4z_prod_init      ! phytoplankton growth rate over the global ocean.  
     163      CALL p4z_rem_init       ! remineralisation 
     164      CALL p4z_mort_init      ! phytoplankton mortality 
     165      CALL p4z_micro_init     ! microzooplankton 
     166      CALL p4z_meso_init      ! mesozooplankton 
     167      CALL p4z_sed_init       ! sedimentation 
     168      CALL p4z_lys_init       ! calcite saturation 
     169      CALL p4z_flx_init       ! gas exchange 
     170 
     171      ndayflxtr = 0 
    137172 
    138173   END SUBROUTINE trc_sms_pisces_init 
Note: See TracChangeset for help on using the changeset viewer.