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 2104 for branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC – NEMO

Ignore:
Timestamp:
2010-09-17T14:35:46+02:00 (14 years ago)
Author:
cetlod
Message:

update DEV_r2006_merge_TRA_TRC according to review

Location:
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC
Files:
42 edited

Legend:

Unmodified
Added
Removed

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/C14b/trcini_c14b.F90

    r2038 r2104  
    179179      ! Check number of tracers 
    180180      ! -----------------------    
    181       IF( jp_c14b > 1) THEN 
    182           IF(lwp) THEN 
    183               WRITE (numout,*) ' ===>>>> : w a r n i n g ' 
    184               WRITE (numout,*) ' =======   ============= ' 
    185               WRITE (numout,*)                             & 
    186               &   ' STOP, change jp_c14b to 1 in par_C14b module ' 
    187           END IF 
    188           STOP 'TRC_CTL' 
    189       END IF 
     181      IF( jp_c14b > 1) CALL ctl_stop( ' Change jp_c14b to be equal 1 in par_c14b.F90' ) 
    190182 
    191183      ! Check tracer names 
    … …  
    197189 
    198190      IF(lwp) THEN 
    199          WRITE (numout,*) ' ===>>>> : w a r n i n g ' 
    200          WRITE (numout,*) ' =======   ============= ' 
    201          WRITE (numout,*) ' we force tracer names' 
     191         CALL ctl_warn( ' we force tracer names' ) 
    202192         WRITE(numout,*) ' tracer nb: ',jpc14,' name = ',ctrcnm(jpc14), ctrcnl(jpc14) 
    203193         WRITE(numout,*) ' ' 
    … …  
    209199          ctrcun(jpc14) = 'ration' 
    210200          IF(lwp) THEN 
    211              WRITE (numout,*) ' ===>>>> : w a r n i n g ' 
    212              WRITE (numout,*) ' =======   ============= ' 
    213              WRITE (numout,*) ' we force tracer unit' 
     201             CALL ctl_warn( ' we force tracer unit' ) 
    214202             WRITE(numout,*) ' tracer  ',ctrcnm(jpc14), 'UNIT= ',ctrcun(jpc14) 
    215203             WRITE(numout,*) ' ' 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/C14b/trcrst_c14b.F90

    r1953 r2104  
    4343      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 
    4444       
    45       DO jn = jp_c14b0, jp_c14b1 
    46          CALL iom_get( knum, jpdom_autoglo, 'qint_'//ctrcnm(jn), qint_c14(:,:,jn) )  
    47       END DO 
     45      CALL iom_get( knum, jpdom_autoglo, 'qint_c14', qint_c14 )  
    4846 
    4947   END SUBROUTINE trc_rst_read_c14b 
    … …  
    5957      INTEGER, INTENT(in)  :: kitrst  ! time step of restart write 
    6058      INTEGER, INTENT(in)  :: knum    ! unit of the restart file 
    61       INTEGER              :: jn      ! dummy loop indices 
    6259      !!---------------------------------------------------------------------- 
    6360 
    … …  
    6663      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 
    6764 
    68       DO jn = jp_c14b0, jp_c14b1 
    69          CALL iom_rstput( kt, kitrst, kum, 'qint_'//ctrcnm(jn), qint_c14(:,:,jn) ) 
    70       END DO 
     65      CALL iom_rstput( kt, kitrst, knum, 'qint_c14', qint_c14 ) 
    7166 
    7267   END SUBROUTINE trc_rst_wri_c14b 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/C14b/trcsms_c14b.F90

    r2082 r2104  
    131131      !!---------------------------------------------------------------------- 
    132132 
    133       IF( kt == nittrc000 )  THEN 
     133      IF( kt == nit000 )  THEN 
    134134         ! Computation of decay coeffcient 
    135135         zdemi   = 5730. 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/CFC/trcsms_cfc.F90

    r2082 r2104  
    9393      !!---------------------------------------------------------------------- 
    9494 
    95       IF( kt == nittrc000 )   CALL trc_cfc_cst 
     95      IF( kt == nit000 )   CALL trc_cfc_cst 
    9696 
    9797      ! Temporal interpolation 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/LOBSTER/trcbio.F90

    r2082 r2104  
    2020   USE lbclnk          !  
    2121   USE prtctl_trc      ! Print control for debbuging 
     22   USE trdmod_oce 
    2223   USE trdmod_trc 
    2324   USE iom 
    … …  
    8182      !!--------------------------------------------------------------------- 
    8283 
    83       IF( kt == nittrc000 ) THEN 
     84      IF( kt == nit000 ) THEN 
    8485         IF(lwp) WRITE(numout,*) 
    8586         IF(lwp) WRITE(numout,*) ' trc_bio: LOBSTER bio-model' 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/LOBSTER/trcexp.F90

    r2082 r2104  
    1919   USE lbclnk 
    2020   USE trc 
    21    USE trctrp_lec 
     21   USE trcnam_trp 
    2222   USE prtctl_trc      ! Print control for debbuging 
     23   USE trdmod_oce 
    2324   USE trdmod_trc 
    2425   USE iom 
    … …  
    6061      !!--------------------------------------------------------------------- 
    6162 
    62       IF( kt == nittrc000 ) THEN 
     63      IF( kt == nit000 ) THEN 
    6364         IF(lwp) WRITE(numout,*) 
    6465         IF(lwp) WRITE(numout,*) ' trc_exp: LOBSTER export' 
    … …  
    125126      IF( ln_trczdf_exp .AND. (ln_trcadv_cen2 .OR. ln_trcadv_tvd) ) THEN 
    126127         zfact = 2. * rdttra(jk) * FLOAT( nn_dttrc )  
    127          IF( neuler == 0 .AND. kt == nittrc000 )   zfact = rdttra(jk) * FLOAT(nn_dttrc)  
     128         IF( neuler == 0 .AND. kt == nit000 )   zfact = rdttra(jk) * FLOAT(nn_dttrc)  
    128129         sedpoca(:,:) =  sedpocb(:,:) + zfact * sedpoca(:,:)  
    129130      ENDIF 
    … …  
    133134      ! ------------------------------ 
    134135      IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd  ) THEN         ! centred or tvd scheme 
    135          IF( neuler == 0 .AND. kt == nittrc000 ) THEN 
     136         IF( neuler == 0 .AND. kt == nit000 ) THEN 
    136137            DO jj = 1, jpj 
    137138               DO ji = 1, jpi 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/LOBSTER/trcini_lobster.F90

    r2038 r2104  
    275275      ! Check number of tracers 
    276276      ! ----------------------- 
    277       IF (jp_lobster /= 6) THEN 
    278           IF (lwp) THEN 
    279               WRITE (numout,*) ' ===>>>> : w a r n i n g ' 
    280               WRITE (numout,*) ' =======   ============= ' 
    281               WRITE (numout,*)                             & 
    282               &   ' STOP, change jp_lobster to 6 in '           & 
    283               &   ,'par_lobster.F90 ' 
    284           END IF 
    285           STOP 'TRC_CTL' 
    286       END IF 
     277      IF( jp_lobster /= 6 ) CALL ctl_stop( ' LOBSTER has 6 passive tracers. Change jp_lobster in par_lobster.F90' ) 
     278 
    287279      ! Check tracer names 
    288280      ! ------------------ 
    … …  
    309301         ctrcnl(jp_lob_dom)='Dissolved organic matter' 
    310302         IF(lwp) THEN 
    311             WRITE (numout,*) ' ===>>>> : w a r n i n g ' 
    312             WRITE (numout,*) ' =======   ============= ' 
    313             WRITE (numout,*) ' we force tracer names' 
     303            CALL ctl_warn( ' We force tracer names ' ) 
    314304            DO jl = 1, jp_lobster 
    315305               jn = jp_lob0 + jl - 1 
    … …  
    326316            ctrcun(jn) = 'mmole-N/m3' 
    327317            IF(lwp) THEN 
    328                WRITE (numout,*) ' ===>>>> : w a r n i n g ' 
    329                WRITE (numout,*) ' =======   ============= ' 
    330                WRITE (numout,*) ' we force tracer unit' 
     318               CALL ctl_warn( ' We force tracer units ' ) 
    331319               WRITE(numout,*) ' tracer  ',ctrcnm(jn), 'UNIT= ',ctrcun(jn) 
    332320            ENDIF 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/LOBSTER/trcopt.F90

    r2082 r2104  
    6565      !!--------------------------------------------------------------------- 
    6666 
    67       IF( kt == nittrc000 ) THEN 
     67      IF( kt == nit000 ) THEN 
    6868         IF(lwp) WRITE(numout,*) 
    6969         IF(lwp) WRITE(numout,*) ' trc_opt : LOBSTER optic-model' 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/LOBSTER/trcsed.F90

    r2082 r2104  
    1818   USE sms_lobster 
    1919   USE lbclnk 
     20   USE trdmod_oce 
    2021   USE trdmod_trc 
    2122   USE iom 
    … …  
    6768      !!--------------------------------------------------------------------- 
    6869 
    69       IF( kt == nittrc000 ) THEN 
     70      IF( kt == nit000 ) THEN 
    7071         IF(lwp) WRITE(numout,*) 
    7172         IF(lwp) WRITE(numout,*) ' trc_sed: LOBSTER sedimentation' 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/LOBSTER/trcsms_lobster.F90

    r2038 r2104  
    2020   USE trcexp 
    2121   USE trdmod_oce 
     22   USE trdmod_trc_oce 
    2223   USE trdmod_trc 
    2324   USE trdmld_trc 

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

    r1953 r2104  
    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 

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

    r2082 r2104  
    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 

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

    r2082 r2104  
    3333 
    3434   PUBLIC   p4z_flx   
     35   PUBLIC   p4z_flx_init   
    3536 
    3637   REAL(wp) :: &  ! pre-industrial atmospheric [co2] (ppm)   
    … …  
    8182 
    8283      !!--------------------------------------------------------------------- 
    83  
    84  
    85       IF( kt == nittrc000  )   CALL p4z_flx_init      ! Initialization (first time-step only) 
    8684 
    8785      ! SURFACE CHEMISTRY (PCO2 AND [H+] IN 
    … …  
    246244      !! 
    247245      !! ** Method  :   Read the nampisext namelist and check the parameters 
    248       !!      called at the first timestep (nittrc000) 
     246      !!      called at the first timestep (nit000) 
    249247      !! ** input   :   Namelist nampisext 
    250248      !! 

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

    r2082 r2104  
    2323 
    2424   PUBLIC p4z_lim     
     25   PUBLIC p4z_lim_init     
    2526 
    2627   !! * Shared module variables 
    … …  
    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) ) 
    … …  
    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 

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

    r2038 r2104  
    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 
    … …  
    7273      !!--------------------------------------------------------------------- 
    7374 
    74       IF( kt == nittrc000  )   CALL p4z_lys_init      ! Initialization (first time-step only) 
    75  
    7675      zco3(:,:,:) = 0. 
    7776 
    … …  
    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 

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

    r2038 r2104  
    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 
    … …  
    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 
    7677#if defined key_diatrc && defined key_iomput 
    … …  
    8081      !!--------------------------------------------------------------------- 
    8182 
    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 
    98  
    9983      DO jk = 1, jpkm1 
    10084         DO jj = 1, jpj 
    … …  
    10387               zcompam = MAX( ( trn(ji,jj,jk,jpmes) - 1.e-9 ), 0.e0 ) 
    10488# if defined key_degrad 
    105                zfact   = zstep * tgfunc(ji,jj,jk) * zcompam * facvol(ji,jj,jk) 
     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_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 
    161        
    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_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_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_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 
    203149       
    204150#if defined key_diatrc 
    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 ) 
     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) 
     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 
    283202#if defined key_diatrc 
    284203               prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
    … …  
    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 
    … …  
    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 

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

    r2038 r2104  
    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 
    … …  
    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. 
    8576 
    8677#if defined key_diatrc 
    … …  
    9384         DO jj = 1, jpj 
    9485            DO ji = 1, jpi 
    95  
    9686               zcompaz = MAX( ( trn(ji,jj,jk,jpzoo) - 1.e-9 ), 0.e0 ) 
    9787# if defined key_degrad 
    98                zfact   = zstep * tgfunc(ji,jj,jk) * zcompaz *facvol(ji,jj,jk) 
     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_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        
     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) 
    157128#if defined key_diatrc 
    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 
     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) 
     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 
    222174#if defined key_diatrc 
    223175               prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
    … …  
    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 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/p4zmort.F90

    r2038 r2104  
    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 
    … …  
    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      !!--------------------------------------------------------------------- 
    … …  
    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)   & 
    10594# if defined key_degrad 
    106                   &        * facvol(ji,jj,jk)     & 
     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_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 
    … …  
    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_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_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 ) 

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

    r2038 r2104  
    2222   PRIVATE 
    2323 
    24    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 
    2526 
    2627   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   etot, enano, ediat   !: PAR for phyto, nano and diat  
    … …  
    4344CONTAINS 
    4445 
    45    SUBROUTINE p4z_opt(kt, jnt) 
     46   SUBROUTINE p4z_opt( kt, jnt ) 
    4647      !!--------------------------------------------------------------------- 
    4748      !!                     ***  ROUTINE p4z_opt  *** 
    … …  
    6364 
    6465 
    65       !                                        !* tabulated attenuation coef.  
    66       IF( kt * jnt == nittrc000 ) THEN 
    67          !                                ! level of light extinction 
    68          nksrp = trc_oce_ext_lev( rn_si2, 0.33e2 ) 
    69          IF(lwp) THEN 
    70            WRITE(numout,*) 
    71            WRITE(numout,*) ' level max of computation of qsr = ', nksrp, ' ref depth = ', gdepw_0(nksrp+1), ' m' 
    72          ENDIF 
    73 !!         CALL trc_oce_rgb( xkrgb )     ! tabulated attenuation coefficients 
    74          CALL trc_oce_rgb_read( xkrgb )     ! tabulated attenuation coefficients 
    75          etot (:,:,:) = 0.e0 
    76          enano(:,:,:) = 0.e0 
    77          ediat(:,:,:) = 0.e0 
    78          IF( ln_qsr_bio ) etot3(:,:,:) = 0.e0 
    79       ENDIF 
    80  
    81  
    82 !     Initialisation of variables used to compute PAR 
    83 !     ----------------------------------------------- 
     66      !     Initialisation of variables used to compute PAR 
     67      !     ----------------------------------------------- 
    8468      ze1 (:,:,jpk) = 0.e0 
    8569      ze2 (:,:,jpk) = 0.e0 
    … …  
    242226   END SUBROUTINE p4z_opt 
    243227 
     228   SUBROUTINE p4z_opt_init 
     229      !!---------------------------------------------------------------------- 
     230      !!                  ***  ROUTINE p4z_opt_init  *** 
     231      !! 
     232      !! ** Purpose :   Initialization of tabulated attenuation coef 
     233      !! 
     234      !! 
     235      !!---------------------------------------------------------------------- 
     236 
     237      !                                ! level of light extinction 
     238      nksrp = trc_oce_ext_lev( rn_si2, 0.33e2 ) 
     239      IF(lwp) THEN 
     240        WRITE(numout,*) 
     241        WRITE(numout,*) ' level max of computation of qsr = ', nksrp, ' ref depth = ', gdepw_0(nksrp+1), ' m' 
     242      ENDIF 
     243!!      CALL trc_oce_rgb( xkrgb )     ! tabulated attenuation coefficients 
     244      CALL trc_oce_rgb_read( xkrgb )     ! tabulated attenuation coefficients 
     245      etot (:,:,:) = 0.e0 
     246      enano(:,:,:) = 0.e0 
     247      ediat(:,:,:) = 0.e0 
     248      IF( ln_qsr_bio ) etot3(:,:,:) = 0.e0 
     249      !  
     250   END SUBROUTINE p4z_opt_init 
    244251#else 
    245252   !!---------------------------------------------------------------------- 

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

    r2082 r2104  
    2727   PRIVATE 
    2828 
    29    PUBLIC   p4z_prod    ! called in p4zbio.F90 
     29   PUBLIC   p4z_prod         ! called in p4zbio.F90 
     30   PUBLIC   p4z_prod_init    ! called in trcsms_pisces.F90 
    3031 
    3132   !! * Shared module variables 
    … …  
    4748      texcret                    ,  &  !: 1 - excret  
    4849      texcret2                   ,  &  !: 1 - excret2         
    49       rpis180                    ,  &  !: rpi / 180 
    5050      tpp                              !: Total primary production 
    5151 
    … …  
    7878      REAL(wp) ::   zmxltst, zmxlday, zlim1 
    7979      REAL(wp) ::   zpislopen  , zpislope2n 
    80       REAL(wp) ::   zrum, zcodel, zargu, zvol 
     80      REAL(wp) ::   zrum, zcodel, zargu, zval, zvol 
    8181#if defined key_diatrc 
    8282      REAL(wp) ::   zrfact2 
    … …  
    9191      !!--------------------------------------------------------------------- 
    9292 
    93  
    94       IF( ( kt * jnt ) == nittrc000  )   CALL p4z_prod_init      ! Initialization (first time-step only) 
    95  
    96  
    9793      zprorca (:,:,:) = 0.0 
    9894      zprorcad(:,:,:) = 0.0 
    … …  
    125121         zrum = FLOAT( nday_year - 80 ) / 365. 
    126122      ENDIF 
    127       zcodel = ASIN(  SIN( zrum * rpi * 2. ) * SIN( rpis180 * 23.5 )  ) 
     123      zcodel = ASIN(  SIN( zrum * rpi * 2. ) * SIN( rad * 23.5 )  ) 
    128124 
    129125      ! day length in hours 
    … …  
    131127      DO jj = 1, jpj 
    132128         DO ji = 1, jpi 
    133             zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rpis180 ) 
     129            zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad ) 
    134130            zargu = MAX( -1., MIN(  1., zargu ) ) 
    135             zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rpis180 / 15. ) 
     131            zval  = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. ) 
     132            IF( zval < 1.e0 )   zval = 24. 
     133            zstrn(ji,jj) = 24. / zval 
    136134         END DO 
    137135      END DO 
    … …  
    227225      END DO 
    228226 
    229  
    230       WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24. 
    231       zstrn(:,:) = 24. / zstrn(:,:) 
    232227 
    233228!CDIR NOVERRCHK 
    … …  
    396391      !! 
    397392      !! ** Method  :   Read the nampisprod namelist and check the parameters 
    398       !!      called at the first timestep (nittrc000) 
     393      !!      called at the first timestep (nit000) 
    399394      !! 
    400395      !! ** input   :   Namelist nampisprod 
    … …  
    426421      nspyr  = INT( nyear_len(1) * rday / rdt ) 
    427422 
    428       rpis180   = rpi / 180. 
    429423      texcret   = 1.0 - excret 
    430424      texcret2  = 1.0 - excret2 

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

    r2082 r2104  
    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 
    … …  
    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 
    6766      REAL(wp) ::   zkeq  , zfeequi, zsiremin 
    68       REAL(wp) ::   zsatur, zsatur2, znusil 
     67      REAL(wp) ::   zsatur, zsatur1, zsatur2, zsatur22, znusil 
     68      REAL(wp) ::   ztem1, ztem2 
    6969      REAL(wp) ::   zbactfer, zorem, zorem2, zofer 
    7070      REAL(wp) ::   zosil, zdenom1, zscave, zaggdfe 
    … …  
    7272      REAL(wp) ::   zofer2, zdenom, zdenom2 
    7373#endif 
    74       REAL(wp) ::   zlamfac, zonitr 
     74      REAL(wp) ::   zlamfac, zonitr, zstep 
    7575      REAL(wp), DIMENSION(jpi,jpj)     ::   ztempbac 
    7676      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdepbac, zfesatur, zolimi 
    … …  
    7878 
    7979      !!--------------------------------------------------------------------- 
    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 
    8880 
    8981 
    … …  
    9486       ztempbac(:,:)   = 0.0 
    9587 
    96 !      Computation of the mean phytoplankton concentration as 
    97 !      a crude estimate of the bacterial biomass 
    98 !      -------------------------------------------------- 
     88      !  Computation of the mean phytoplankton concentration as 
     89      !  a crude estimate of the bacterial biomass 
     90      !   -------------------------------------------------- 
    9991 
    10092      DO jk = 1, jpkm1 
    … …  
    114106         DO jj = 1, jpj 
    115107            DO ji = 1, jpi 
    116  
    117 !    DENITRIFICATION FACTOR COMPUTED FROM O2 LEVELS 
    118 !    ---------------------------------------------- 
    119  
     108               ! denitrification factor computed from O2 levels 
    120109               nitrfac(ji,jj,jk) = MAX(  0.e0, 0.4 * ( 6.e-6  - trn(ji,jj,jk,jpoxy) )    & 
    121110                  &                                / ( 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)         & 
     111               nitrfac(ji,jj,jk) = MIN( 1., nitrfac(ji,jj,jk) ) 
     112            END DO 
     113         END DO 
     114      END DO 
     115 
     116      DO jk = 1, jpkm1 
     117         DO jj = 1, jpj 
     118            DO ji = 1, jpi 
    138119# if defined key_degrad 
    139                   &            * facvol(ji,jj,jk)              & 
     120               zstep = xstep * facvol(ji,jj,jk) 
     121# else 
     122               zstep = xstep 
    140123# endif 
    141                   &            * zdepbac(ji,jj,jk) 
     124               ! DOC ammonification. Depends on depth, phytoplankton biomass 
     125               !     and a limitation term which is supposed to be a parameterization 
     126               !     of the bacterial activity.  
     127               zremik = xremik * zstep / 1.e-6 * xlimbac(ji,jj,jk) * zdepbac(ji,jj,jk)  
    142128               zremik = MAX( zremik, 5.5e-4 * xstep ) 
    143129 
    144 !     Ammonification in oxic waters with oxygen consumption 
    145 !     ----------------------------------------------------- 
     130               !     Ammonification in oxic waters with oxygen consumption 
     131               !     ----------------------------------------------------- 
    146132               zolimi(ji,jj,jk) = MIN(  ( trn(ji,jj,jk,jpoxy) - rtrn ) / o2ut,  & 
    147133                  &                    zremik * ( 1.- nitrfac(ji,jj,jk) ) * trn(ji,jj,jk,jpdoc)  )  
    148134 
    149 !     Ammonification in suboxic waters with denitrification 
    150 !     ------------------------------------------------------- 
     135               !     Ammonification in suboxic waters with denitrification 
     136               !     ------------------------------------------------------- 
    151137               denitr(ji,jj,jk) = MIN(  ( trn(ji,jj,jk,jpno3) - rtrn ) / rdenit,   & 
    152138                  &                     zremik * nitrfac(ji,jj,jk) * trn(ji,jj,jk,jpdoc)  ) 
    … …  
    167153         DO jj = 1, jpj 
    168154            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) )     & 
    174155# if defined key_degrad 
    175                   &      * facvol(ji,jj,jk)              & 
     156               zstep = xstep * facvol(ji,jj,jk) 
     157# else 
     158               zstep = xstep 
    176159# 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 
     160               !    NH4 nitrification to NO3. Ceased for oxygen concentrations 
     161               !    below 2 umol/L. Inhibited at strong light  
     162               !    ---------------------------------------------------------- 
     163               zonitr  = nitrif * zstep * trn(ji,jj,jk,jpnh4) / ( 1.+ emoy(ji,jj,jk) ) * ( 1.- nitrfac(ji,jj,jk) )  
     164 
     165               !   Update of the tracers trends 
     166               !   ---------------------------- 
     167 
     168               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zonitr 
     169               tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zonitr 
     170               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2nit * zonitr 
     171               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - rno3  * zonitr 
    187172 
    188173            END DO 
    … …  
    200185            DO ji = 1, jpi 
    201186 
    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 !    ---------------------------------------------------------- 
     187               !    Bacterial uptake of iron. No iron is available in DOC. So 
     188               !    Bacteries are obliged to take up iron from the water. Some 
     189               !    studies (especially at Papa) have shown this uptake to be significant 
     190               !    ---------------------------------------------------------- 
    207191               zbactfer = 15.e-6 * rfact2 * 4.* 0.4 * prmax(ji,jj,jk)           & 
    208                   &               * ( xlimphy(ji,jj,jk) * zdepbac(ji,jj,jk))**2           & 
     192                  &               * ( xlimphy(ji,jj,jk) * zdepbac(ji,jj,jk))           & 
     193                  &               * ( xlimphy(ji,jj,jk) * zdepbac(ji,jj,jk))           & 
    209194                  &                  / ( xkgraz2 + zdepbac(ji,jj,jk) )                    & 
    210195                  &                  * ( 0.5 + SIGN( 0.5, trn(ji,jj,jk,jpfer) -2.e-11 )  ) 
    … …  
    216201               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zbactfer 
    217202#endif 
    218  
    219203            END DO 
    220204         END DO 
    … …  
    230214         DO jj = 1, jpj 
    231215            DO ji = 1, jpi 
    232  
    233 !    POC disaggregation by turbulence and bacterial activity.  
    234 !    ------------------------------------------------------------- 
    235                zremip = xremip * xstep * tgfunc(ji,jj,jk)   & 
    236216# if defined key_degrad 
    237                   &            * facvol(ji,jj,jk)              & 
     217               zstep = xstep * facvol(ji,jj,jk) 
     218# else 
     219               zstep = xstep 
    238220# 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 !    ----------------------------------------------------------------- 
     221               !    POC disaggregation by turbulence and bacterial activity.  
     222               !    ------------------------------------------------------------- 
     223               zremip = xremip * zstep * tgfunc(ji,jj,jk) * ( 1.- 0.5 * nitrfac(ji,jj,jk) )  
     224 
     225               !    POC disaggregation rate is reduced in anoxic zone as shown by 
     226               !    sediment traps data. In oxic area, the exponent of the martin s 
     227               !    law is around -0.87. In anoxic zone, it is around -0.35. This 
     228               !    means a disaggregation constant about 0.5 the value in oxic zones 
     229               !    ----------------------------------------------------------------- 
    246230               zorem  = zremip * trn(ji,jj,jk,jppoc) 
    247231               zofer  = zremip * trn(ji,jj,jk,jpsfe) 
    … …  
    253237#endif 
    254238 
    255 !  Update the appropriate tracers trends 
    256 !  ------------------------------------- 
     239               !  Update the appropriate tracers trends 
     240               !  ------------------------------------- 
    257241 
    258242               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zorem 
    … …  
    282266         DO jj = 1, jpj 
    283267            DO ji = 1, jpi 
    284  
    285 !     Remineralization rate of BSi depedant on T and saturation 
    286 !     --------------------------------------------------------- 
    287                zsatur  = ( sio3eq(ji,jj,jk) - trn(ji,jj,jk,jpsil) ) / ( sio3eq(ji,jj,jk) + rtrn ) 
    288                zsatur  = MAX( rtrn, zsatur ) 
    289                zsatur2 = zsatur * ( 1. + tsn(ji,jj,jk,jp_tem) / 400.)**4 
    290                znusil  = 0.225  * ( 1. + tsn(ji,jj,jk,jp_tem) / 15.) * zsatur + 0.775 * zsatur2**9 
    291 #    if defined key_degrad 
    292                zsiremin = xsirem * xstep * znusil * facvol(ji,jj,jk) 
     268# if defined key_degrad 
     269               zstep = xstep * facvol(ji,jj,jk) 
    293270# else 
    294                zsiremin = xsirem * xstep * znusil 
    295 #    endif 
    296                zosil = zsiremin * trn(ji,jj,jk,jpdsi) 
     271               zstep = xstep 
     272# endif 
     273               !     Remineralization rate of BSi depedant on T and saturation 
     274               !     --------------------------------------------------------- 
     275               zsatur   = ( sio3eq(ji,jj,jk) - trn(ji,jj,jk,jpsil) ) / ( sio3eq(ji,jj,jk) + rtrn ) 
     276               zsatur   = MAX( rtrn, zsatur ) 
     277               ztem1    = ( 1. + tsn(ji,jj,jk,jp_tem) / 15.) 
     278               ztem2    = ( 1. + tsn(ji,jj,jk,jp_tem) / 400.) 
     279               zsatur1  = zsatur * ztem1 
     280               zsatur2  = zsatur * ztem2 * ztem2 * ztem2 * ztem2 
     281               zsatur22 = zsatur2 * zsatur2 
     282               znusil   = 0.225  * zsatur1 + 0.775 * zsatur22 * zsatur22 * zsatur22 * zsatur22 * zsatur2 
     283               zsiremin = xsirem * zstep * znusil 
     284               zosil    = zsiremin * trn(ji,jj,jk,jpdsi) 
    297285 
    298286               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zosil 
    299287               tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) + zosil 
    300  
    301288               ! 
    302289            END DO 
    … …  
    317304!CDIR NOVERRCHK 
    318305            DO ji = 1, jpi 
    319 ! 
    320 !      Compute de different ratios for scavenging of iron 
    321 !      -------------------------------------------------- 
     306# if defined key_degrad 
     307               zstep = xstep * facvol(ji,jj,jk) 
     308# else 
     309               zstep = xstep 
     310# endif 
     311               !  Compute de different ratios for scavenging of iron 
     312               !  -------------------------------------------------- 
    322313 
    323314#if  defined key_kriest 
    324                 zdenom1 = trn(ji,jj,jk,jppoc) / & 
     315               zdenom1 = trn(ji,jj,jk,jppoc) / & 
    325316           &           ( trn(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpdsi) + trn(ji,jj,jk,jpcal) + rtrn ) 
    326317#else 
    327                 zdenom = 1. / ( trn(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpgoc)  & 
     318               zdenom = 1. / ( trn(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpgoc)  & 
    328319           &            + trn(ji,jj,jk,jpdsi) + trn(ji,jj,jk,jpcal) + rtrn ) 
    329320 
    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 !     ------------------------------------------------------------ 
     321               zdenom1 = trn(ji,jj,jk,jppoc) * zdenom 
     322               zdenom2 = trn(ji,jj,jk,jpgoc) * zdenom 
     323#endif 
     324               !  scavenging rate of iron. this scavenging rate depends on the load in particles 
     325               !  on which they are adsorbed. The  parameterization has been taken from studies on Th 
     326               !     ------------------------------------------------------------ 
    339327               zkeq = fekeq(ji,jj,jk) 
    340328               zfeequi = ( -( 1. + zfesatur(ji,jj,jk) * zkeq - zkeq * trn(ji,jj,jk,jpfer) )               & 
    … …  
    349337                  &                      + trn(ji,jj,jk,jpcal) + trn(ji,jj,jk,jpdsi)  ) * 1.e6 
    350338#endif 
    351  
    352 # if defined key_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 !  ----------------------------------------------------------- 
     339               zscave = zfeequi * zlam1b * zstep 
     340 
     341               !  Increased scavenging for very high iron concentrations 
     342               !  found near the coasts due to increased lithogenic particles 
     343               !  and let s say it unknown processes (precipitation, ...) 
     344               !  ----------------------------------------------------------- 
    362345               zlamfac = MAX( 0.e0, ( gphit(ji,jj) + 55.) / 30. ) 
    363346               zlamfac = MIN( 1.  , zlamfac ) 
    … …  
    374357#endif 
    375358 
    376 # if defined key_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 
     359               zaggdfe = zlam1b * zstep * 0.5 * ( trn(ji,jj,jk,jpfer) - zfeequi ) 
    381360 
    382361               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zscave - zaggdfe 
    … …  
    400379       ENDIF 
    401380 
    402 !     Update the arrays TRA which contain the biological sources and sinks 
    403 !     -------------------------------------------------------------------- 
     381       !     Update the arrays TRA which contain the biological sources and sinks 
     382       !     -------------------------------------------------------------------- 
    404383 
    405384      DO jk = 1, jpkm1 
    … …  
    452431      ENDIF 
    453432 
     433      nitrfac(:,:,:) = 0.0 
     434      denitr (:,:,:) = 0.0   
     435 
    454436   END SUBROUTINE p4z_rem_init 
    455  
    456  
    457  
    458  
    459437 
    460438#else 

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

    r2082 r2104  
    3434 
    3535   PUBLIC   p4z_sed    
     36   PUBLIC   p4z_sed_init    
    3637 
    3738   !! * Shared module variables 
    … …  
    9091#endif 
    9192      REAL(wp) ::   zconctmp , zdenitot  , znitrpottot 
    92       REAL(wp) ::   zlim, zconctmp2, zstep, zfact 
     93      REAL(wp) ::   zlim, zconctmp2, zfact, zrivalk 
    9394      REAL(wp), DIMENSION(jpi,jpj)     ::   zsidep 
    9495      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   znitrpot, zirondep 
    … …  
    102103      !!--------------------------------------------------------------------- 
    103104 
    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 
     105      IF( ( jnt == 1 ) .AND. ( ln_dustfer ) )  CALL p4z_sbc( kt ) 
    109106 
    110107      zirondep(:,:,:) = 0.e0          ! Initialisation of variables used to compute deposition 
    … …  
    192189         DO ji = 1, jpi 
    193190            ikt = MAX( mbathy(ji,jj) - 1, 1 ) 
    194             zconctmp = trn(ji,jj,ikt,jpdsi) * zstep / fse3t(ji,jj,ikt)   & 
    195191# if ! defined key_kriest 
    196      &             * wscal (ji,jj,ikt) 
     192            zconctmp = trn(ji,jj,ikt,jpdsi) * xstep / fse3t(ji,jj,ikt) * wscal (ji,jj,ikt)  
    197193# else 
    198      &            * wsbio4(ji,jj,ikt) 
     194            zconctmp = trn(ji,jj,ikt,jpdsi) * xstep / fse3t(ji,jj,ikt) * wsbio4(ji,jj,ikt) 
    199195# endif 
    200196            trn(ji,jj,ikt,jpdsi) = trn(ji,jj,ikt,jpdsi) - zconctmp 
    201197 
    202198#if ! defined key_sed 
    203             trn(ji,jj,ikt,jpsil) = trn(ji,jj,ikt,jpsil) + zconctmp   & 
    204             &      * ( 1.- ( sumdepsi + rivalkinput / ryyss / 6. ) / zsumsedsi ) 
     199            zrivalk = ( 1.- ( sumdepsi + rivalkinput / ryyss / 6. ) / zsumsedsi ) 
     200            trn(ji,jj,ikt,jpsil) = trn(ji,jj,ikt,jpsil) + zconctmp  * zrivalk  
    205201#endif 
    206202         END DO 
    … …  
    210206         DO ji = 1, jpi 
    211207            ikt = MAX( mbathy(ji,jj) - 1, 1 ) 
    212             zconctmp = trn(ji,jj,ikt,jpcal) * wscal(ji,jj,ikt) * zstep / fse3t(ji,jj,ikt) 
     208            zconctmp = trn(ji,jj,ikt,jpcal) * wscal(ji,jj,ikt) * xstep / fse3t(ji,jj,ikt) 
    213209            trn(ji,jj,ikt,jpcal) = trn(ji,jj,ikt,jpcal) - zconctmp 
    214  
    215210#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 ) 
     211            zrivalk = ( 1.- ( rivalkinput / ryyss ) / zsumsedcal ) 
     212            trn(ji,jj,ikt,jptal) = trn(ji,jj,ikt,jptal) + zconctmp * zrivalk * 2.0 
     213            trn(ji,jj,ikt,jpdic) = trn(ji,jj,ikt,jpdic) + zconctmp * zrivalk  
    220214#endif 
    221215         END DO 
    … …  
    225219         DO ji = 1, jpi 
    226220            ikt = MAX( mbathy(ji,jj) - 1, 1 ) 
    227             zfact = zstep / fse3t(ji,jj,ikt) 
     221            zfact = xstep / fse3t(ji,jj,ikt) 
    228222# if ! defined key_kriest 
    229223            zconctmp  = trn(ji,jj,ikt,jpgoc) 
    … …  
    242236            zconctmp  = trn(ji,jj,ikt,jpnum) 
    243237            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 
     238            trn(ji,jj,ikt,jpnum) = trn(ji,jj,ikt,jpnum) - zconctmp  * wsbio4(ji,jj,ikt) * zfact  
     239            trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) - zconctmp2 * wsbio3(ji,jj,ikt) * zfact  
    248240#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 ) ) 
     241            trn(ji,jj,ikt,jpdoc) = trn(ji,jj,ikt,jpdoc) + ( zconctmp2 * wsbio3(ji,jj,ikt) )   
     242            &                     * zfact * ( 1.- rivpo4input / ( ryyss * zsumsedpo4 ) ) 
    252243#endif 
    253             trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe)   & 
    254             &      - trn(ji,jj,ikt,jpsfe) * wsbio3(ji,jj,ikt) * zfact 
    255  
     244            trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) - trn(ji,jj,ikt,jpsfe) * wsbio3(ji,jj,ikt) * zfact  
    256245# endif 
    257246         END DO 
    … …  
    383372      imois2 = nmonth 
    384373 
    385       ! 1. first call kt=nittrc000 
     374      ! 1. first call kt=nit000 
    386375      ! ----------------------- 
    387376 
    388       IF( kt == nittrc000 ) THEN 
     377      IF( kt == nit000 ) THEN 
    389378         ! initializations 
    390379         nflx1  = 0 
    … …  
    402391      ! ---------------- 
    403392 
    404       IF( kt == nittrc000 .OR. imois /= nflx1 ) THEN 
     393      IF( kt == nit000 .OR. imois /= nflx1 ) THEN 
    405394 
    406395         ! Calendar computation 
    … …  
    445434      !! 
    446435      !! ** Method  :   Read the files and compute the budget 
    447       !!      called at the first timestep (nittrc000) 
     436      !!      called at the first timestep (nit000) 
    448437      !! 
    449438      !! ** input   :   external netcdf files 

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

    r2038 r2104  
    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  :: & 
    … …  
    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               & 
    … …  
    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*                       & 
    … …  
    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)               & 
    … …  
    473462      REAL(wp) ::   zagg1, zagg2, zagg3, zagg4 
    474463      REAL(wp) ::   zagg , zaggfe, zaggdoc, zaggdoc2 
    475       REAL(wp) ::   zfact, zwsmax 
     464      REAL(wp) ::   zfact, zwsmax, zstep 
    476465#if defined key_diatrc 
    477466      REAL(wp) ::   zrfact2 
    … …  
    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_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_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_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 
    … …  
    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 
    646621      !!--------------------------------------------------------------------- 
    647622 
     623 
     624      zstep = rfact2 / 2. 
    648625 
    649626      ztraz(:,:,:) = 0.e0 
    … …  
    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 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/sms_pisces.F90

    r2038 r2104  
    2323   REAL(wp) ::   rfact , rfactr    !: ??? 
    2424   REAL(wp) ::   rfact2, rfact2r   !: ??? 
     25   REAL(wp) ::   xstep             !: Time step duration for biology 
    2526 
    2627   !!*  Biological parameters  

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

    r2038 r2104  
    145145   ! ----------------------- 
    146146#if  defined key_kriest 
    147       IF( jp_pisces /= 23) THEN 
     147      IF( jp_pisces /= 23) CALL ctl_stop( ' PISCES must have 23 passive tracers. Change jp_pisces in par_pisces.F90' ) 
    148148#else 
    149       IF( jp_pisces /= 24) THEN 
     149      IF( jp_pisces /= 24) CALL ctl_stop( ' PISCES must have 24 passive tracers. Change jp_pisces in par_pisces.F90' ) 
    150150#endif 
    151           IF (lwp) THEN 
    152               WRITE (numout,*) ' ===>>>> : w a r n i n g ' 
    153               WRITE (numout,*) ' =======   ============= ' 
    154               WRITE (numout,*)                               & 
    155               &   ' STOP, change jp_pisces',               & 
    156               &   ' in par_pisces.F90' 
    157           END IF 
    158           STOP 'TRC_CTL' 
    159       END IF 
    160151 
    161152   END SUBROUTINE trc_ctl_pisces 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/trcrst_pisces.F90

    r2038 r2104  
    263263#if defined key_dtatrc 
    264264      ! Restore close seas values to initial data 
    265       CALL trc_dta( nittrc000 )  
     265      CALL trc_dta( nit000 )  
    266266      DO jn = 1, jptra 
    267267         IF( lutini(jn) ) THEN 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/trcsms_pisces.F90

    r2038 r2104  
    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          !  
    … …  
    6169      !!--------------------------------------------------------------------- 
    6270 
    63       IF( kt == nittrc000  .AND. .NOT. ln_rsttr )   CALL trc_sms_pisces_init    ! Initialization (first time-step only) 
     71      IF( kt == nit000 )   CALL trc_sms_pisces_init    ! Initialization (first time-step only) 
    6472 
    6573      IF( ndayflxtr /= nday ) THEN      ! New days 
    … …  
    121129      REAL(wp) ::  ztmas, ztmas1 
    122130 
    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 
     131      IF( .NOT. ln_rsttr ) THEN 
     132         ! Initialization of chemical variables of the carbon cycle 
     133         ! -------------------------------------------------------- 
     134         DO jk = 1, jpk 
     135            DO jj = 1, jpj 
     136               DO ji = 1, jpi 
     137                  ztmas   = tmask(ji,jj,jk) 
     138                  ztmas1  = 1. - tmask(ji,jj,jk) 
     139                  zcaralk = trn(ji,jj,jk,jptal) - borat(ji,jj,jk) / (  1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) )  ) 
     140                  zco3    = ( zcaralk - trn(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1 
     141                  zbicarb = ( 2. * trn(ji,jj,jk,jpdic) - zcaralk ) 
     142                  hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1 
     143               END DO 
    134144            END DO 
    135145         END DO 
    136       END DO 
     146         ! 
     147      END IF 
     148 
     149      ! Time step duration for biology 
     150      xstep = rfact2 / rday 
     151 
     152      CALL p4z_sink_init      ! vertical flux of particulate organic matter 
     153      CALL p4z_opt_init       ! Optic: PAR in the water column 
     154      CALL p4z_lim_init       ! co-limitations by the various nutrients 
     155      CALL p4z_prod_init      ! phytoplankton growth rate over the global ocean.  
     156      CALL p4z_rem_init       ! remineralisation 
     157      CALL p4z_mort_init      ! phytoplankton mortality 
     158      CALL p4z_micro_init     ! microzooplankton 
     159      CALL p4z_meso_init      ! mesozooplankton 
     160      CALL p4z_sed_init       ! sedimentation 
     161      CALL p4z_lys_init       ! calcite saturation 
     162      CALL p4z_flx_init       ! gas exchange 
    137163 
    138164   END SUBROUTINE trc_sms_pisces_init 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/SED/sed.F90

    r2082 r2104  
    3838   USE trc, ONLY :  & 
    3939      trn        , & !: tracer  
    40       nittrc000  , & !: 1st time step of tracer model 
    4140      nwritetrc      !: outputs frequency of tracer model 
    4241 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/SED/sedini.F90

    r1581 r2104  
    443443 
    444444      dtsed = rdt 
     445      nitsed000 = nit000 
     446      nitsedend = nitend 
    445447#if ! defined key_sed_off 
    446       nitsed000 = nittrc000 
    447       nitsedend = nitend 
    448448      nwrised   = nwritetrc 
    449449#else 
    450       nitsed000 = nit000 
    451       nitsedend = nitend 
    452450      nwrised   = nwrite 
    453451#endif 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/oce_trc.F90

    r2085 r2104  
    66   !! History :   1.0  !  2004-03  (C. Ethe)  original code 
    77   !!             2.0  !  2007-12 (C. Ethe, G. Madec)  rewritting 
    8    !!---------------------------------------------------------------------- 
    9    !! NEMO/TOP 2.0,  LOCEAN-IPSL (2007) 
    10    !! $Id$ 
    11    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    128   !!---------------------------------------------------------------------- 
    139#if defined key_top 
    … …  
    254250#endif 
    255251 
     252   !!---------------------------------------------------------------------- 
     253   !! NEMO/TOP 3.3,  LOCEAN-IPSL (2010) 
     254   !! $Id$ 
     255   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    256256   !!====================================================================== 
    257257END MODULE oce_trc 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/par_trc.F90

    r2052 r2104  
    99   !!             1.0  !  2004-03  (C. Ethe) Free form and module 
    1010   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture 
    11    !!---------------------------------------------------------------------- 
    12    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
    13    !! $Id$  
    14    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    1511   !!---------------------------------------------------------------------- 
    1612   USE par_kind          ! kind parameters 
    … …  
    4137 
    4238   REAL(wp), PUBLIC  :: rtrn  = 1.e-15      !: truncation value      
     39 
     40   !!---------------------------------------------------------------------- 
     41   !! NEMO/TOP 3.3 , LOCEAN-IPSL (2010)  
     42   !! $Id$  
     43   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4344   !!====================================================================== 
    4445END MODULE par_trc 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/prtctl_trc.F90

    r1581 r2104  
    3535   PUBLIC prt_ctl_trc_info    ! 
    3636   PUBLIC prt_ctl_trc_init    ! called by opa.F90 
    37  
    38    !!---------------------------------------------------------------------- 
    39    !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
    40    !! $Id$  
    41    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    42    !!---------------------------------------------------------------------- 
    4337 
    4438CONTAINS 
    … …  
    466460   !!---------------------------------------------------------------------- 
    467461#endif 
    468      
    469    !!====================================================================== 
     462  
     463   !!---------------------------------------------------------------------- 
     464   !! NEMO/TOP 3.3 , LOCEAN-IPSL (2010)  
     465   !! $Id$  
     466   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     467   !!======================================================================    
    470468END MODULE prtctl_trc 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/top_substitute.h90

    r2052 r2104  
    22   !!                    ***  top_substitute.h90   *** 
    33   !!---------------------------------------------------------------------- 
    4    !! ** purpose : Statement function file: to be include in all routines 
    5    !!              concerning passive tracer model  
     4   !! ** purpose : Statement function file: to be include in all passive tracer modules 
    65   !!---------------------------------------------------------------------- 
    76   !! History :   1.0  !  2004-03 (C. Ethe) Original code 
    87   !!             2.0  !  2007-12 (C. Ethe, G. Madec) new architecture 
    98   !!---------------------------------------------------------------------- 
    10    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     9#  include "domzgr_substitute.h90" 
     10#  include "ldfeiv_substitute.h90" 
     11#  include "ldftra_substitute.h90" 
     12#  include "vectopt_loop_substitute.h90" 
     13   !!---------------------------------------------------------------------- 
     14   !! NEMO/TOP 3.3 , LOCEAN-IPSL (2010)  
    1115   !! $Id$  
    1216   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    1317   !!---------------------------------------------------------------------- 
    14 ! ======================================================== 
    15 #include "domzgr_substitute.h90" 
    16 #include "ldfeiv_substitute.h90" 
    17 #include "ldftra_substitute.h90" 
    18 #include "vectopt_loop_substitute.h90" 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/trc.F90

    r2082 r2104  
    44   !! Passive tracers   :  module for tracers defined 
    55   !!====================================================================== 
    6    !! History :    -   !  1996-01  (M. Levy)  Original code 
     6   !! History :   OPA  !  1996-01  (M. Levy)  Original code 
    77   !!              -   !  1999-07  (M. Levy)  for LOBSTER1 or NPZD model 
    88   !!              -   !  2000-04  (O. Aumont, M.A. Foujols)  HAMOCC3 and P3ZD 
    9    !!             1.0  !  2004-03  (C. Ethe)  Free form and module 
    10    !!---------------------------------------------------------------------- 
    11    !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
    12    !! $Id$  
    13    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     9   !!   NEMO      1.0  !  2004-03  (C. Ethe)  Free form and module 
    1410   !!---------------------------------------------------------------------- 
    1511#if defined key_top 
    … …  
    3834   !! passive tracers fields (before,now,after) 
    3935   !! -------------------------------------------------- 
    40    REAL(wp), PUBLIC ::   trai                         !: initial total tracer 
    41    REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk) :: cvol  !: masked grid volume  
    42    REAL(wp), PUBLIC ::   areatot                      !: total volume  
     36   REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk) :: cvol   !: volume correction -degrad option-  
     37   REAL(wp), PUBLIC ::   trai                          !: initial total tracer 
     38   REAL(wp), PUBLIC ::   areatot                       !: total volume  
    4339 
    4440   REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk,jptra) ::   trn   !: traceur concentration for actual time step 
    … …  
    4642   REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk,jptra) ::   trb   !: traceur concentration for before time step 
    4743 
    48 #if ! defined key_zco 
    4944   !! interpolated gradient 
    5045   !!--------------------------------------------------   
    5146   REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jptra) ::   gtru   !: horizontal gradient at u-points at bottom ocean level 
    5247   REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jptra) ::   gtrv   !: horizontal gradient at v-points at bottom ocean level 
    53 #endif 
    5448    
    5549   !! passive tracers restart (input and output) 
    5650   !! ------------------------------------------   
    57    LOGICAL , PUBLIC  ::  ln_rsttr      !: boolean term for restart i/o for passive tracers (namelist) 
    58    LOGICAL , PUBLIC  ::  lrst_trc      !: logical to control the trc restart write 
    59    INTEGER , PUBLIC  ::  nutwrs        !: output FILE for passive tracers restart 
    60    INTEGER , PUBLIC  ::  nutrst        !: logical unit for restart FILE for passive tracers 
    61    INTEGER , PUBLIC  ::  nn_rsttr      !: control of the time step ( 0 or 1 ) for pass. tr. 
    62    CHARACTER(len=50) ::  cn_trcrst_in  !: suffix of pass. tracer restart name (input) 
    63    CHARACTER(len=50) ::  cn_trcrst_out !: suffix of pass. tracer restart name (output) 
     51   LOGICAL , PUBLIC          ::  ln_rsttr      !: boolean term for restart i/o for passive tracers (namelist) 
     52   LOGICAL , PUBLIC          ::  lrst_trc      !: logical to control the trc restart write 
     53   INTEGER , PUBLIC          ::  nn_dttrc      !: frequency of step on passive tracers 
     54   INTEGER , PUBLIC          ::  nutwrs        !: output FILE for passive tracers restart 
     55   INTEGER , PUBLIC          ::  nutrst        !: logical unit for restart FILE for passive tracers 
     56   INTEGER , PUBLIC          ::  nn_rsttr      !: control of the time step ( 0 or 1 ) for pass. tr. 
     57   CHARACTER(len=50), PUBLIC ::  cn_trcrst_in  !: suffix of pass. tracer restart name (input) 
     58   CHARACTER(len=50), PUBLIC ::  cn_trcrst_out !: suffix of pass. tracer restart name (output) 
    6459    
    6560   !! information for outputs 
    … …  
    7065   !! additional 2D/3D outputs namelist 
    7166   !! -------------------------------------------------- 
    72    CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia2d) ::   ctrc2d   !: 2d output field name 
    73    CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia2d) ::   ctrc2u   !: 2d output field unit    
    74    CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia3d) ::   ctrc3d   !: 3d output field name 
    75    CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia3d) ::   ctrc3u   !: 3d output field unit 
    76    CHARACTER(len=80), PUBLIC, DIMENSION (jpdia2d) ::   ctrc2l   !: 2d output field long name 
    77    CHARACTER(len=80), PUBLIC, DIMENSION (jpdia3d) ::   ctrc3l   !: 3d output field long name 
     67   INTEGER , PUBLIC                               ::   nwritedia   !: frequency of additional arrays outputs(namelist) 
     68   CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia2d) ::   ctrc2d      !: 2d output field name 
     69   CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia2d) ::   ctrc2u      !: 2d output field unit    
     70   CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia3d) ::   ctrc3d      !: 3d output field name 
     71   CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia3d) ::   ctrc3u      !: 3d output field unit 
     72   CHARACTER(len=80), PUBLIC, DIMENSION (jpdia2d) ::   ctrc2l      !: 2d output field long name 
     73   CHARACTER(len=80), PUBLIC, DIMENSION (jpdia3d) ::   ctrc3l      !: 3d output field long name 
    7874 
    79    REAL(wp), PUBLIC, DIMENSION (jpi,jpj,    jpdia2d) ::   trc2d   !:  additional 2d outputs   
    80    REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk,jpdia3d) ::   trc3d   !:  additional 3d outputs   
     75   REAL(wp), PUBLIC, DIMENSION (jpi,jpj,    jpdia2d) ::   trc2d    !:  additional 2d outputs   
     76   REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk,jpdia3d) ::   trc3d    !:  additional 3d outputs   
    8177    
    82    INTEGER , PUBLIC ::   nwritedia     !: frequency of additional arrays outputs(namelist) 
    8378# endif 
    8479 
    8580#if defined key_diabio || defined key_trdmld_trc 
    86    CHARACTER(len=8),  DIMENSION(jpdiabio) ::   ctrbio   !: biological trends name      (NAMELIST) 
    87    CHARACTER(len=20), DIMENSION(jpdiabio) ::   ctrbiu   !: biological trends unit      (NAMELIST) 
    88    CHARACTER(len=80), DIMENSION(jpdiabio) ::   ctrbil   !: biological trends long name (NAMELIST) 
    89    INTEGER ::   nwritebio   !: time step frequency for biological outputs (NAMELIST) 
     81   !                                                              !!*  namtop_XXX namelist * 
     82   INTEGER , PUBLIC                               ::   nwritebio   !: time step frequency for biological outputs  
     83   CHARACTER(len=8 ), PUBLIC, DIMENSION(jpdiabio) ::   ctrbio      !: biological trends name       
     84   CHARACTER(len=20), PUBLIC, DIMENSION(jpdiabio) ::   ctrbiu      !: biological trends unit    
     85   CHARACTER(len=80), PUBLIC, DIMENSION(jpdiabio) ::   ctrbil      !: biological trends long name 
    9086#endif 
    9187# if defined key_diabio 
    9288   !! Biological trends 
    9389   !! ----------------- 
    94    REAL(wp), DIMENSION(jpi,jpj,jpk,jpdiabio) :: trbio   !: biological trends 
     90   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk,jpdiabio) :: trbio   !: biological trends 
    9591# endif 
    9692 
    … …  
    108104#endif 
    109105 
     106   !!---------------------------------------------------------------------- 
     107   !! NEMO/TOP 3.3 , LOCEAN-IPSL (2010)  
     108   !! $Id$  
     109   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    110110   !!====================================================================== 
    111111END MODULE trc 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/trcdia.F90

    r2038 r2104  
    44   !! TOP :   Output of passive tracers 
    55   !!====================================================================== 
    6    !! History :    -   !  1995-01 (M. Levy)  Original code 
     6   !! History :   OPA  !  1995-01 (M. Levy)  Original code 
    77   !!              -   !  1998-01 (C. Levy) NETCDF format using ioipsl interface 
    88   !!              -   !  1999-01 (M.A. Foujols) adapted for passive tracer 
    99   !!              -   !  1999-09 (M.A. Foujols) split into three parts 
    10    !!             1.0  !  2005-03 (O. Aumont, A. El Moussaoui) F90 
     10   !!   NEMO      1.0  !  2005-03 (O. Aumont, A. El Moussaoui) F90 
    1111   !!                  !  2008-05 (C. Ethe re-organization) 
    1212   !!---------------------------------------------------------------------- 
    … …  
    3232   PRIVATE 
    3333 
    34    PUBLIC trc_dia       
     34   PUBLIC   trc_dia   ! called by XXX module  
    3535 
    3636   INTEGER  ::   nit5      !: id for tracer output file 
    … …  
    5656#  include "top_substitute.h90" 
    5757   !!---------------------------------------------------------------------- 
    58    !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
     58   !! NEMO/TOP 3.3 , LOCEAN-IPSL (2010)  
    5959   !! $Id$  
    6060   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    6161   !!---------------------------------------------------------------------- 
    62  
    6362CONTAINS 
    6463 
    … …  
    7271      INTEGER               :: kindic 
    7372      !!--------------------------------------------------------------------- 
    74        
     73      ! 
    7574      CALL trcdit_wr( kt, kindic )      ! outputs for tracer concentration 
    7675      CALL trcdii_wr( kt, kindic )      ! outputs for additional arrays 
    7776      CALL trcdib_wr( kt, kindic )      ! outputs for biological trends 
    78  
    7977      ! 
    8078   END SUBROUTINE trc_dia 
     79 
    8180 
    8281   SUBROUTINE trcdit_wr( kt, kindic ) 
    … …  
    108107      CHARACTER (len=80) :: cltral 
    109108      REAL(wp) :: zsto, zout, zdt 
    110       INTEGER  :: iimi, iima, ijmi, ijma, ipk, it, itmod 
     109      INTEGER  :: iimi, iima, ijmi, ijma, ipk, it, itmod, iiter 
    111110      !!---------------------------------------------------------------------- 
    112111 
    … …  
    138137 
    139138      ! define time axis 
    140       itmod = kt - nittrc000 + 1 
     139      itmod = kt - nit000 + 1 
    141140      it    = kt 
     141      iiter = ( nit000 - 1 ) / nn_dttrc 
    142142 
    143143      ! Define NETCDF files and fields at beginning of first time step 
    … …  
    146146      IF(ll_print)WRITE(numout,*)'trcdit_wr kt=',kt,' kindic ',kindic 
    147147       
    148       IF( kt == nittrc000 ) THEN 
     148      IF( kt == nit000 ) THEN 
    149149 
    150150         ! Compute julian date from starting date of the run 
    … …  
    152152         zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment 
    153153         IF(lwp)WRITE(numout,*)' '   
    154          IF(lwp)WRITE(numout,*)' Date 0 used :', nittrc000                         & 
     154         IF(lwp)WRITE(numout,*)' Date 0 used :', nit000                         & 
    155155            &                 ,' YEAR ', nyear, ' MONTH ', nmonth, ' DAY ', nday   & 
    156156            &                 ,'Julian day : ', zjulian   
    … …  
    176176         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,     & 
    177177            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,         &  
    178             &          nittrc000-ndttrc, zjulian, zdt, nhorit5, nit5 , domain_id=nidom) 
     178            &          iiter, zjulian, zdt, nhorit5, nit5 , domain_id=nidom) 
    179179 
    180180         ! Vertical grid for tracer : gdept 
    … …  
    250250      CHARACTER (len=80) ::   cltral 
    251251      INTEGER  ::   jl 
    252       INTEGER  ::   iimi, iima, ijmi, ijma, ipk, it, itmod 
     252      INTEGER  ::   iimi, iima, ijmi, ijma, ipk, it, itmod, iiter 
    253253      REAL(wp) ::   zsto, zout, zdt 
    254254      !!---------------------------------------------------------------------- 
    … …  
    281281 
    282282      ! define time axis 
    283       itmod = kt - nittrc000 + 1 
     283      itmod = kt - nit000 + 1 
    284284      it    = kt 
     285      iiter = ( nit000 - 1 ) / nn_dttrc 
    285286 
    286287      ! 1. Define NETCDF files and fields at beginning of first time step 
    … …  
    289290      IF( ll_print ) WRITE(numout,*) 'trcdii_wr kt=', kt, ' kindic ', kindic 
    290291 
    291       IF( kt == nittrc000 ) THEN 
     292      IF( kt == nit000 ) THEN 
    292293 
    293294         ! Define the NETCDF files for additional arrays : 2D or 3D 
    … …  
    302303         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,             & 
    303304            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,         & 
    304             &          nittrc000-ndttrc, zjulian, zdt, nhoritd, nitd , domain_id=nidom ) 
     305            &          iiter, zjulian, zdt, nhoritd, nitd , domain_id=nidom ) 
    305306 
    306307         ! Vertical grid for 2d and 3d arrays 
    … …  
    367368 
    368369# else 
    369  
    370370   SUBROUTINE trcdii_wr( kt, kindic )                      ! Dummy routine 
    371371      INTEGER, INTENT ( in ) :: kt, kindic 
    372372   END SUBROUTINE trcdii_wr 
    373  
    374373# endif 
    375374 
    … …  
    392391      !!        IF kindic >0, output of fields before the time step loop 
    393392      !!---------------------------------------------------------------------- 
    394       !! 
    395393      INTEGER, INTENT( in ) ::   kt          ! ocean time-step 
    396394      INTEGER, INTENT( in ) ::   kindic      ! indicator of abnormal termination 
    … …  
    401399      CHARACTER (len=80) ::   cltral 
    402400      INTEGER  ::   ji, jj, jk, jl 
    403       INTEGER  ::   iimi, iima, ijmi, ijma, ipk, it, itmod 
     401      INTEGER  ::   iimi, iima, ijmi, ijma, ipk, it, itmod, iiter 
    404402      REAL(wp) ::   zsto, zout, zdt 
    405403      !!---------------------------------------------------------------------- 
    … …  
    433431 
    434432      ! define time axis 
    435       itmod = kt - nittrc000 + 1 
     433      itmod = kt - nit000 + 1 
    436434      it    = kt 
     435      iiter = ( nit000 - 1 ) / nn_dttrc 
    437436 
    438437      ! Define NETCDF files and fields at beginning of first time step 
    … …  
    441440      IF(ll_print) WRITE(numout,*)'trcdib_wr kt=',kt,' kindic ',kindic 
    442441 
    443       IF( kt == nittrc000 ) THEN 
     442      IF( kt == nit000 ) THEN 
    444443 
    445444         ! Define the NETCDF files for biological trends 
    … …  
    450449         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,      & 
    451450            &    iimi, iima-iimi+1, ijmi, ijma-ijmi+1,          & 
    452             &    nittrc000-ndttrc, zjulian, zdt, nhoritb, nitb , domain_id=nidom ) 
     451            &    iiter, zjulian, zdt, nhoritb, nitb , domain_id=nidom ) 
    453452         ! Vertical grid for biological trends 
    454453         CALL histvert(nitb, 'deptht', 'Vertical T levels', 'm', ipk, gdept_0, ndepitb) 
    … …  
    510509      INTEGER, INTENT(in) :: kt 
    511510   END SUBROUTINE trc_dia    
    512  
    513511#endif 
    514512 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/trcdta.F90

    r1953 r2104  
    3636#  include "top_substitute.h90" 
    3737   !!---------------------------------------------------------------------- 
    38    !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
     38   !! NEMO/TOP 3.3 , LOCEAN-IPSL (2010)  
    3939   !! $Id$  
    4040   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4141   !!---------------------------------------------------------------------- 
    42  
    4342CONTAINS 
    4443 
    45    !!---------------------------------------------------------------------- 
    46    !!   Default case                                            NetCDF file 
    47    !!---------------------------------------------------------------------- 
    48     
    4944   SUBROUTINE trc_dta( kt ) 
    5045      !!---------------------------------------------------------------------- 
    … …  
    6358      !! 
    6459      CHARACTER (len=39) ::   clname(jptra) 
    65       INTEGER, PARAMETER ::   & 
    66          jpmonth = 12    ! number of months 
     60      INTEGER, PARAMETER ::   jpmonth = 12    ! number of months 
    6761      INTEGER ::   ji, jj, jn, jl  
    6862      INTEGER ::   imois, iman, i15, ik  ! temporary integers  
    6963      REAL(wp) ::   zxy, zl 
     64!!gm HERE the daymod should be used instead of computation of month and co !! 
     65!!gm      better in case of real calandar and leap-years ! 
    7066      !!---------------------------------------------------------------------- 
    7167 
    … …  
    7470         IF( lutini(jn) ) THEN  
    7571 
    76             IF ( kt == nittrc000 ) THEN 
     72            IF ( kt == nit000 ) THEN 
    7773               !! 3D tracer data 
    7874               IF(lwp)WRITE(numout,*) 
    … …  
    9288            ! -------------------- 
    9389 
    94             IF ( kt == nittrc000 .AND. nlectr(jn) == 0 ) THEN 
     90            IF ( kt == nit000 .AND. nlectr(jn) == 0 ) THEN 
    9591               ntrc1(jn) = 0 
    9692               IF(lwp) WRITE(numout,*) ' trc_dta : Levitus tracer data monthly fields' 
    … …  
    107103# if defined key_pisces 
    108104            ! Read montly file 
    109             IF( ( kt == nittrc000 .AND. nlectr(jn) == 0)  .OR. imois /= ntrc1(jn) ) THEN 
     105            IF( ( kt == nit000 .AND. nlectr(jn) == 0)  .OR. imois /= ntrc1(jn) ) THEN 
    110106               nlectr(jn) = 1 
    111107 
    … …  
    189185# else 
    190186            ! Read init file only 
    191             IF( kt == nittrc000  ) THEN 
     187            IF( kt == nit000  ) THEN 
    192188               ntrc1(jn) = 1 
    193189               CALL iom_get ( numtr(jn), jpdom_data, ctrcnm(jn), trdta(:,:,:,jn), ntrc1(jn) ) 
    … …  
    196192            ENDIF  
    197193# endif 
    198  
    199194         ENDIF 
    200195 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/trcini.F90

    r2087 r2104  
    4141    !! * Substitutions 
    4242#  include "domzgr_substitute.h90" 
    43    !!---------------------------------------------------------------------- 
    44    !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
    45    !! $Id$  
    46    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    47    !!---------------------------------------------------------------------- 
    4843   
    4944CONTAINS 
    … …  
    123118# if defined key_dtatrc 
    124119         ! Initialization of tracer from a file that may also be used for damping 
    125          CALL trc_dta( nittrc000 ) 
     120         CALL trc_dta( nit000 ) 
    126121         DO jn = 1, jptra 
    127122            IF( lutini(jn) )   trn(:,:,:,jn) = trdta(:,:,:,jn) * tmask(:,:,:)   ! initialisation from file if required 
    … …  
    138133       
    139134      IF( ln_zps .AND. .NOT. lk_trc_c1d )   &              ! Partial steps: before horizontal gradient of passive 
    140       &                     CALL zps_hde( nittrc000, jptra, trb, gtru, gtrv )       ! tracers at the bottom ocean level 
     135      &                     CALL zps_hde( nit000, jptra, trb, gtru, gtrv )       ! tracers at the bottom ocean level 
    141136 
    142137 
    … …  
    181176#endif 
    182177 
     178   !!---------------------------------------------------------------------- 
     179   !! NEMO/TOP 3.3 , LOCEAN-IPSL (2010)  
     180   !! $Id$  
     181   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    183182   !!====================================================================== 
    184183END MODULE trcini 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/trcnam.F90

    r2038 r2104  
    102102      READ  ( numnat, namtrc ) 
    103103 
    104       !!Chris  computes the first time step of tracer model 
    105       nittrc000 = nit000 + nn_dttrc - 1 
    106  
    107104      DO jn = 1, jptra 
    108105         ctrcnm(jn) = sn_tracer(jn)%clsname 
    … …  
    118115         WRITE(numout,*) ' Namelist : namtrc' 
    119116         WRITE(numout,*) '    time step freq. for pass. trac. nn_dttrc             = ', nn_dttrc 
    120          WRITE(numout,*) '    1st time step for pass. trac. nittrc000              = ', nittrc000 
    121117         WRITE(numout,*) '    frequency of outputs for passive tracers nn_writetrc = ', nn_writetrc   
    122118         WRITE(numout,*) '    restart LOGICAL for passive tr. ln_rsttr             = ', ln_rsttr 
    … …  
    200196#endif 
    201197 
     198   !!---------------------------------------------------------------------- 
     199   !! NEMO/TOP 3.3 , LOCEAN-IPSL (2010)  
     200   !! $Id: $  
     201   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    202202   !!====================================================================== 
    203203END MODULE  trcnam 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/trcrst.F90

    r2038 r2104  
    4747   !! * Substitutions 
    4848#  include "top_substitute.h90" 
    49    !!---------------------------------------------------------------------- 
    50    !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
    51    !! $Id$  
    52    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    53    !!---------------------------------------------------------------------- 
    5449    
    5550CONTAINS 
    … …  
    128123      ! Time domain : restart 
    129124      ! --------------------- 
    130       CALL trc_rst_cal( nittrc000, 'READ' )   ! calendar 
     125      CALL trc_rst_cal( nit000, 'READ' )   ! calendar 
    131126 
    132127      IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd ) THEN   ;   iarak0 = 1 
    … …  
    222217      !! 
    223218      !!   According to namelist parameter nrstdt, 
    224       !!       nn_rsttr = 0  no control on the date (nittrc000 is  arbitrary). 
     219      !!       nn_rsttr = 0  no control on the date (nit000 is  arbitrary). 
    225220      !!       nn_rsttr = 1  we verify that nit000 is equal to the last 
    226221      !!                   time step of previous run + 1. 
    … …  
    251246            WRITE(numout,*) ' *** restart option' 
    252247            SELECT CASE ( nn_rsttr ) 
    253             CASE ( 0 )   ;   WRITE(numout,*) ' nn_rsttr = 0 : no control of nittrc000' 
     248            CASE ( 0 )   ;   WRITE(numout,*) ' nn_rsttr = 0 : no control of nit000' 
    254249            CASE ( 1 )   ;   WRITE(numout,*) ' nn_rsttr = 1 : no control the date at nit000 (use ndate0 read in the namelist)' 
    255250            CASE ( 2 )   ;   WRITE(numout,*) ' nn_rsttr = 2 : calendar parameters read in restart' 
    … …  
    258253         ENDIF 
    259254         ! Control of date  
    260          IF( nittrc000  - NINT( zkt ) /= 1 .AND.  nn_rsttr /= 0 )                                  & 
     255         IF( nit000  - NINT( zkt ) /= 1 .AND.  nn_rsttr /= 0 )                                  & 
    261256            &   CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart',                 & 
    262257            &                  ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' ) 
    … …  
    269264         ELSE 
    270265            ndastp = ndate0 - 1     ! ndate0 read in the namelist in dom_nam 
    271             adatrj = ( REAL( nittrc000-1, wp ) * rdttra(1) ) / rday 
     266            adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday 
    272267            ! note this is wrong if time step has changed during run 
    273268         ENDIF 
    … …  
    369364#endif 
    370365 
     366   !!---------------------------------------------------------------------- 
     367   !! NEMO/TOP 3.3 , LOCEAN-IPSL (2010)  
     368   !! $Id$  
     369   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    371370   !!====================================================================== 
    372371END MODULE trcrst 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/trcsms.F90

    r2038 r2104  
    2828 
    2929   !!---------------------------------------------------------------------- 
    30    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     30   !! NEMO/TOP 3.3 , LOCEAN-IPSL (2010)  
    3131   !! $Id$  
    3232   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/trcstp.F90

    r2038 r2104  
    44   !! Time-stepping    : time loop of opa for passive tracer 
    55   !!====================================================================== 
     6   !! History :  1.0  !  2004-03  (C. Ethe)  Original 
     7   !!---------------------------------------------------------------------- 
    68#if defined key_top 
    79   !!---------------------------------------------------------------------- 
    810   !!   trc_stp      : passive tracer system time-stepping 
    911   !!---------------------------------------------------------------------- 
    10    !! * Modules used 
    1112   USE oce_trc          ! ocean dynamics and active tracers variables 
    1213   USE trc 
    … …  
    2526   PRIVATE 
    2627 
    27    !! * Routine accessibility 
    28    PUBLIC trc_stp           ! called by step 
     28   PUBLIC   trc_stp    ! called by step 
     29    
    2930   !!---------------------------------------------------------------------- 
    30    !!   TOP 1.0 , LOCEAN-IPSL (2005)  
    31    !! $Id: trcstp.F90 1285 2009-02-03 13:38:51Z cetlod $  
    32    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     31   !! NEMO/TOP 3.3 , LOCEAN-IPSL (2010)  
     32   !! $Id: $  
     33   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    3334   !!---------------------------------------------------------------------- 
    34  
    3535CONTAINS 
    3636 
    … …  
    4444      !!              Compute the passive tracers trends  
    4545      !!              Update the passive tracers 
    46       !! 
    47       !! History : 
    48       !!   9.0  !  04-03  (C. Ethe)  Original 
    4946      !!------------------------------------------------------------------- 
    50       !! * Arguments 
    5147      INTEGER, INTENT( in ) ::  kt  ! ocean time-step index 
    5248      CHARACTER (len=25)    ::  charout 
     49      !!------------------------------------------------------------------- 
    5350 
    54       ! this ROUTINE is called only every nn_dttrc time step 
    55       IF( MOD( kt , nn_dttrc ) /= 0 ) RETURN 
    56  
    57       IF(ln_ctl) THEN 
    58          WRITE(charout,FMT="('kt =', I4,'  d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear 
    59          CALL prt_ctl_trc_info(charout) 
     51      IF( MOD( kt - 1 , nn_dttrc ) == 0 ) THEN      ! only every nn_dttrc time step 
     52         ! 
     53         IF(ln_ctl) THEN 
     54            WRITE(charout,FMT="('kt =', I4,'  d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear 
     55            CALL prt_ctl_trc_info(charout) 
     56         ENDIF 
     57         ! 
     58         tra(:,:,:,:) = 0.e0 
     59         ! 
     60         IF( kt == nit000 .AND. lk_trdmld_trc  )  & 
     61            &                      CALL trd_mld_trc_init        ! trends: Mixed-layer 
     62                                   CALL trc_rst_opn( kt )       ! Open tracer restart file  
     63         IF( lk_iomput ) THEN  ;   CALL trc_wri( kt )           ! output of passive tracers 
     64         ELSE                  ;   CALL trc_dia( kt ) 
     65         ENDIF 
     66                                   CALL trc_sms( kt )           ! tracers: sink and source 
     67                                   CALL trc_trp( kt )           ! transport of passive tracers 
     68         IF( kt == nit000 )     CALL iom_close( numrtr )     ! close input  passive tracers restart file 
     69         IF( lrst_trc )            CALL trc_rst_wri( kt )       ! write tracer restart file 
     70         IF( lk_trdmld_trc  )      CALL trd_mld_trc( kt )       ! trends: Mixed-layer 
     71         ! 
    6072      ENDIF 
    61  
    62       tra(:,:,:,:) = 0. 
    63  
    64       IF( kt == nittrc000 .AND. lk_trdmld_trc  )  & 
    65          &                   CALL trd_mld_trc_init        ! trends: Mixed-layer 
    66                              CALL trc_rst_opn( kt )       ! Open tracer restart file  
    67                              CALL trc_sms( kt )           ! tracers: sink and source 
    68                              CALL trc_trp( kt )           ! transport of passive tracers 
    69       IF( kt == nittrc000 )  CALL iom_close( numrtr )     ! close input  passive tracers restart file 
    70       IF( lrst_trc )         CALL trc_rst_wri( kt )       ! write tracer restart file 
    71       IF( lk_iomput ) THEN 
    72                              CALL trc_wri( kt )           ! output of passive tracers 
    73       ELSE 
    74                              CALL trc_dia( kt )   ! diagnostics 
    75       ENDIF 
    76       IF( lk_trdmld_trc  )   CALL trd_mld_trc( kt )     ! trends: Mixed-layer 
    7773 
    7874   END SUBROUTINE trc_stp 
    … …  
    8480CONTAINS 
    8581   SUBROUTINE trc_stp( kt )        ! Empty routine 
    86       INTEGER, INTENT(in) :: kt 
    8782      WRITE(*,*) 'trc_stp: You should not have seen this print! error?', kt 
    8883   END SUBROUTINE trc_stp 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/trcwri.F90

    r2038 r2104  
    2828   !! * Substitutions 
    2929#  include "top_substitute.h90" 
    30    !!---------------------------------------------------------------------- 
    31    !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
    32    !! $Id: trcdia.F90 1450 2009-05-15 14:12:12Z cetlod $  
    33    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    34    !!---------------------------------------------------------------------- 
    3530 
    3631CONTAINS 
    … …  
    6863  
    6964#if defined key_offline 
    70       IF( kt == nittrc000 ) THEN 
     65      IF( kt == nit000 ) THEN 
    7166        ! WRITE root name in date.file for use by postpro 
    7267         IF(lwp) THEN 
    … …  
    9893#endif 
    9994 
     95   !!---------------------------------------------------------------------- 
     96   !! NEMO/TOP 3.3 , LOCEAN-IPSL (2010)  
     97   !! $Id: $  
     98   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    10099   !!====================================================================== 
    101100END MODULE trcwri 
Note: See TracChangeset for help on using the changeset viewer.