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 10322 for NEMO/branches/UKMO/dev_r9950_GO8_package/src/TOP/PISCES/P4Z/p4zsed.F90 – NEMO

Ignore:
Timestamp:
2018-11-16T16:06:47+01:00 (5 years ago)
Author:
davestorkey
Message:

UKMO/dev_r9950_GO8_package: Update to be relative to rev 10321 of NEMO4_beta_mirror branch.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/UKMO/dev_r9950_GO8_package/src/TOP/PISCES/P4Z/p4zsed.F90

    r9950 r10322  
    1414   USE trc             !  passive tracers common variables  
    1515   USE sms_pisces      !  PISCES Source Minus Sink variables 
    16    USE p4zice          !  Co-limitations of differents nutrients 
     16   USE p4zlim          !  Co-limitations of differents nutrients 
    1717   USE p4zsbc          !  External source of nutrients  
    1818   USE p4zint          !  interpolation and computation of various fields 
     19   USE sed             !  Sediment module 
    1920   USE iom             !  I/O manager 
    2021   USE prtctl_trc      !  print control for debugging 
     
    2930   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:  ) :: sdenit     !: Nitrate reduction in the sediments 
    3031   REAL(wp) :: r1_rday                  !: inverse of rday 
     32   LOGICAL, SAVE :: lk_sed 
    3133 
    3234   !!---------------------------------------------------------------------- 
    33    !! NEMO/TOP 3.3 , NEMO Consortium (2018) 
     35   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    3436   !! $Id$ 
    35    !! Software governed by the CeCILL licence (./LICENSE) 
     37   !! Software governed by the CeCILL license (see ./LICENSE) 
    3638   !!---------------------------------------------------------------------- 
    3739CONTAINS 
     
    4951      ! 
    5052      INTEGER, INTENT(in) ::   kt, knt ! ocean time step 
    51       INTEGER  ::   ji, jj, jk, ikt 
    52       REAL(wp) ::   zsumsedsi, zsumsedpo4, zsumsedcal 
    53       REAL(wp) ::   zrivalk, zrivsil, zrivno3 
     53      INTEGER  ::  ji, jj, jk, ikt 
     54      REAL(wp) ::  zrivalk, zrivsil, zrivno3 
    5455      REAL(wp) ::  zwflux, zfminus, zfplus 
    5556      REAL(wp) ::  zlim, zfact, zfactcal 
     
    6263      ! 
    6364      CHARACTER (len=25) :: charout 
    64       REAL(wp), DIMENSION(jpi,jpj    ) :: zwork1, zwork2, zwork3 
    65       REAL(wp), DIMENSION(jpi,jpj    ) :: zdenit2d, zbureff 
     65      REAL(wp), DIMENSION(jpi,jpj    ) :: zdenit2d, zbureff, zwork 
    6666      REAL(wp), DIMENSION(jpi,jpj    ) :: zwsbio3, zwsbio4, zwscal 
    6767      REAL(wp), DIMENSION(jpi,jpj    ) :: zsedcal, zsedsi, zsedc 
     
    7373      IF( ln_timing )  CALL timing_start('p4z_sed') 
    7474      ! 
     75      IF( kt == nittrc000 .AND. knt == 1 )   THEN 
     76          r1_rday  = 1. / rday 
     77          IF (ln_sediment .AND. ln_sed_2way) THEN 
     78             lk_sed = .TRUE. 
     79          ELSE 
     80             lk_sed = .FALSE. 
     81          ENDIF 
     82      ENDIF 
     83      ! 
    7584      IF( kt == nittrc000 .AND. knt == 1 )   r1_rday  = 1. / rday 
    7685      ! 
     
    8291      zdenit2d(:,:) = 0.e0 
    8392      zbureff (:,:) = 0.e0 
    84       zwork1  (:,:) = 0.e0 
    85       zwork2  (:,:) = 0.e0 
    86       zwork3  (:,:) = 0.e0 
     93      zwork   (:,:) = 0.e0 
    8794      zsedsi  (:,:) = 0.e0 
    8895      zsedcal (:,:) = 0.e0 
     
    189196      ENDIF 
    190197 
    191       ! Add the external input of iron from sediment mobilization 
    192       ! ------------------------------------------------------ 
    193       IF( ln_ironsed ) THEN 
    194                          tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + ironsed(:,:,:) * rfact2 
    195          IF( ln_ligand ) tra(:,:,:,jpfep) = tra(:,:,:,jpfep) + ( ironsed(:,:,:) * fep_rats ) * rfact2 
    196          ! 
    197          IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "Ironsed" ) )   & 
    198             &   CALL iom_put( "Ironsed", ironsed(:,:,:) * 1.e+3 * tmask(:,:,:) ) ! iron inputs from sediments 
    199       ENDIF 
    200  
    201198      ! Add the external input of iron from hydrothermal vents 
    202199      ! ------------------------------------------------------ 
     
    235232 
    236233      IF( .NOT.lk_sed ) THEN 
     234! 
     235         ! Add the external input of iron from sediment mobilization 
     236         ! ------------------------------------------------------ 
     237         IF( ln_ironsed ) THEN 
     238                            tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + ironsed(:,:,:) * rfact2 
     239            IF( ln_ligand ) tra(:,:,:,jpfep) = tra(:,:,:,jpfep) + ( ironsed(:,:,:) * fep_rats ) * rfact2 
     240            ! 
     241            IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "Ironsed" ) )   & 
     242               &   CALL iom_put( "Ironsed", ironsed(:,:,:) * 1.e+3 * tmask(:,:,:) ) ! iron inputs from sediments 
     243         ENDIF 
     244 
    237245         ! Computation of the sediment denitrification proportion: The metamodel from midlleburg (2006) is being used 
    238246         ! Computation of the fraction of organic matter that is permanently buried from Dunne's model 
     
    255263                   &     + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) ) * 1E6 
    256264                 zbureff(ji,jj) = 0.013 + 0.53 * zflx**2 / ( 7.0 + zflx )**2 
    257                 ENDIF 
    258               END DO 
    259            END DO  
    260  
    261            ! Loss of biogenic silicon, Caco3 organic carbon in the sediments.  
    262            ! First, the total loss is computed. 
    263            ! The factor for calcite comes from the alkalinity effect 
    264            ! ------------------------------------------------------------- 
    265            DO jj = 1, jpj 
    266               DO ji = 1, jpi 
    267                  IF( tmask(ji,jj,1) == 1 ) THEN 
    268                     ikt = mbkt(ji,jj)  
    269                     zwork1(ji,jj) = trb(ji,jj,ikt,jpgsi) * zwsbio4(ji,jj) 
    270                     zwork2(ji,jj) = trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj) + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj)  
    271                     ! For calcite, burial efficiency is made a function of saturation 
    272                     zfactcal      = MIN( excess(ji,jj,ikt), 0.2 ) 
    273                     zfactcal      = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) ) 
    274                     zwork3(ji,jj) = trb(ji,jj,ikt,jpcal) * zwscal(ji,jj) * 2.e0 * zfactcal 
    275                 ENDIF 
    276             END DO 
    277          END DO 
    278          zsumsedsi  = glob_sum( zwork1(:,:) * e1e2t(:,:) ) * r1_rday 
    279          zsumsedpo4 = glob_sum( zwork2(:,:) * e1e2t(:,:) ) * r1_rday 
    280          zsumsedcal = glob_sum( zwork3(:,:) * e1e2t(:,:) ) * r1_rday 
     265              ENDIF 
     266            END DO 
     267         END DO  
    281268         ! 
    282269      ENDIF 
     
    285272      ! Thus, the amount of silica lost in the sediments equal the supply at the surface (dust+rivers) 
    286273      ! ------------------------------------------------------ 
    287       IF( .NOT.lk_sed )  zrivsil =  1._wp - ( sumdepsi + rivdsiinput * r1_ryyss ) / ( zsumsedsi + rtrn ) 
     274      IF( .NOT.lk_sed )  zrivsil = 1._wp - sedsilfrac 
    288275 
    289276      DO jj = 1, jpj 
     
    312299               zfactcal = MIN( excess(ji,jj,ikt), 0.2 ) 
    313300               zfactcal = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) ) 
    314                zrivalk  =  1._wp - ( rivalkinput * r1_ryyss ) * zfactcal / ( zsumsedcal + rtrn ) 
     301               zrivalk  = sedcalfrac * zfactcal 
    315302               tra(ji,jj,ikt,jptal) =  tra(ji,jj,ikt,jptal) + zcaloss * zrivalk * 2.0 
    316303               tra(ji,jj,ikt,jpdic) =  tra(ji,jj,ikt,jpdic) + zcaloss * zrivalk 
     
    492479            IF( iom_use("Nfix"   ) ) CALL iom_put( "Nfix", nitrpot(:,:,:) * nitrfix * rno3 * zfact * tmask(:,:,:) )  ! nitrogen fixation  
    493480            IF( iom_use("INTNFIX") ) THEN   ! nitrogen fixation rate in ocean ( vertically integrated ) 
    494                zwork1(:,:) = 0. 
     481               zwork(:,:) = 0. 
    495482               DO jk = 1, jpkm1 
    496                  zwork1(:,:) = zwork1(:,:) + nitrpot(:,:,jk) * nitrfix * rno3 * zfact * e3t_n(:,:,jk) * tmask(:,:,jk) 
     483                 zwork(:,:) = zwork(:,:) + nitrpot(:,:,jk) * nitrfix * rno3 * zfact * e3t_n(:,:,jk) * tmask(:,:,jk) 
    497484               ENDDO 
    498                CALL iom_put( "INTNFIX" , zwork1 )  
     485               CALL iom_put( "INTNFIX" , zwork )  
    499486            ENDIF 
    500487            IF( iom_use("SedCal" ) ) CALL iom_put( "SedCal", zsedcal(:,:) * zfact ) 
Note: See TracChangeset for help on using the changeset viewer.