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 10843 for NEMO/branches/UKMO/dev_r10037_GPU/src/TOP/PISCES/P4Z/p4zsbc.F90 – NEMO

Ignore:
Timestamp:
2019-04-05T16:01:32+02:00 (5 years ago)
Author:
andmirek
Message:

ticket #2197 merge with dev_r9950_GO8_package at 10320

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/UKMO/dev_r10037_GPU/src/TOP/PISCES/P4Z/p4zsbc.F90

    r9950 r10843  
    3737   REAL(wp), PUBLIC ::   concfediaz   !: Fe half-saturation Cste for diazotrophs  
    3838   REAL(wp)         ::   hratio       !: Fe:3He ratio assumed for vent iron supply 
     39   REAL(wp)         ::   distcoast    !: Distance off the coast for Iron from sediments 
    3940   REAL(wp), PUBLIC ::   fep_rats     !: Fep/Fer ratio from sed  sources 
    4041   REAL(wp), PUBLIC ::   fep_rath     !: Fep/Fer ratio from hydro sources 
     
    7475   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   hydrofe          !: Hydrothermal vent supply of iron 
    7576 
    76    REAL(wp), PUBLIC ::   rivalkinput, rivdicinput, nitdepinput, sumdepsi 
    77    REAL(wp), PUBLIC ::   rivdininput, rivdipinput, rivdsiinput 
     77   REAL(wp), PUBLIC :: sedsilfrac, sedcalfrac 
     78   REAL(wp), PUBLIC :: rivalkinput, rivdicinput 
     79   REAL(wp), PUBLIC :: rivdininput, rivdipinput, rivdsiinput 
    7880 
    7981   !! * Substitutions 
    8082#  include "vectopt_loop_substitute.h90" 
    8183   !!---------------------------------------------------------------------- 
    82    !! NEMO/TOP 3.3 , NEMO Consortium (2018) 
     84   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    8385   !! $Id$ 
    84    !! Software governed by the CeCILL licence (./LICENSE) 
     86   !! Software governed by the CeCILL license (see ./LICENSE) 
    8587   !!---------------------------------------------------------------------- 
    8688CONTAINS 
     
    109111         IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_dust > 1 ) ) THEN 
    110112            CALL fld_read( kt, 1, sf_dust ) 
    111             IF( nn_ice_tr == -1 .AND. .NOT.ln_ironice ) THEN   ;   dust(:,:) = sf_dust(1)%fnow(:,:,1) 
    112             ELSE                                               ;   dust(:,:) = sf_dust(1)%fnow(:,:,1) * ( 1.-fr_i(:,:) ) 
     113            IF( nn_ice_tr == -1 .AND. .NOT.ln_ironice ) THEN   ;   dust(:,:) = MAX( rtrn, sf_dust(1)%fnow(:,:,1) ) 
     114            ELSE                                               ;   dust(:,:) = MAX( rtrn, sf_dust(1)%fnow(:,:,1) * ( 1.-fr_i(:,:) ) ) 
    113115            ENDIF 
    114116         ENDIF 
     
    173175             zcoef = rno3 * 14E6 * ryyss 
    174176             CALL fld_read( kt, 1, sf_ndepo ) 
    175              nitdep(:,:) = sf_ndepo(1)%fnow(:,:,1) / zcoef / e3t_n(:,:,1)  
     177             nitdep(:,:) = MAX( rtrn, sf_ndepo(1)%fnow(:,:,1) / zcoef / e3t_n(:,:,1) ) 
    176178         ENDIF 
    177179         IF( .NOT.ln_linssh ) THEN 
    178180           zcoef = rno3 * 14E6 * ryyss 
    179            nitdep(:,:) = sf_ndepo(1)%fnow(:,:,1) / zcoef / e3t_n(:,:,1)  
     181           nitdep(:,:) = MAX( rtrn, sf_ndepo(1)%fnow(:,:,1) / zcoef / e3t_n(:,:,1) ) 
    180182         ENDIF 
    181183      ENDIF 
     
    205207      INTEGER  :: ik50                !  last level where depth less than 50 m 
    206208      INTEGER  :: isrow             ! index for ORCA1 starting row 
    207       REAL(wp) :: zexpide, zdenitide, zmaskt 
     209      REAL(wp) :: zexpide, zdenitide, zmaskt, zsurfc, zsurfp,ze3t, ze3t2, zcslp 
    208210      REAL(wp) :: ztimes_dust, ztimes_riv, ztimes_ndep  
    209211      REAL(wp), DIMENSION(nbtimes) :: zsteps                 ! times records 
    210212      REAL(wp), DIMENSION(:), ALLOCATABLE :: rivinput 
    211       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zdust, zndepo, zriver, zcmask 
     213      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zriver, zcmask 
    212214      ! 
    213215      CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ssr files 
     
    220222        &                sn_riverdip, sn_riverdop, sn_riverdsi, sn_ndepo, sn_ironsed, sn_hydrofe, & 
    221223        &                ln_dust, ln_solub, ln_river, ln_ndepo, ln_ironsed, ln_ironice, ln_hydrofe,    & 
    222         &                sedfeinput, dustsolub, icefeinput, wdust, mfrac, nitrfix, diazolight, concfediaz, & 
     224        &                sedfeinput, distcoast, dustsolub, icefeinput, wdust, mfrac, nitrfix, diazolight, concfediaz, & 
    223225        &                hratio, fep_rats, fep_rath, lgw_rath 
    224226      !!---------------------------------------------------------------------- 
     
    248250         WRITE(numout,*) '      fe input from hydrothermal vents         ln_hydrofe  = ', ln_hydrofe 
    249251         WRITE(numout,*) '      coastal release of iron                  sedfeinput  = ', sedfeinput 
     252         WRITE(numout,*) '      distance off the coast                   distcoast   = ', distcoast 
    250253         WRITE(numout,*) '      solubility of the dust                   dustsolub   = ', dustsolub 
    251254         WRITE(numout,*) '      Mineral Fe content of the dust           mfrac       = ', mfrac 
     
    307310            CALL iom_open (  TRIM( sn_dust%clname ) , numdust ) 
    308311            CALL iom_gettime( numdust, zsteps, kntime=ntimes_dust)  ! get number of record in file 
    309             ALLOCATE( zdust(jpi,jpj,ntimes_dust) ) 
    310             DO jm = 1, ntimes_dust 
    311                CALL iom_get( numdust, jpdom_data, TRIM( sn_dust%clvar ), zdust(:,:,jm), jm ) 
    312             END DO 
    313             CALL iom_close( numdust ) 
    314             ztimes_dust = 1._wp / REAL(ntimes_dust, wp)  
    315             sumdepsi = 0.e0 
    316             DO jm = 1, ntimes_dust 
    317                sumdepsi = sumdepsi + glob_sum( zdust(:,:,jm) * e1e2t(:,:) * tmask(:,:,1) * ztimes_dust ) 
    318             END DO 
    319             sumdepsi = sumdepsi / ( nyear_len(1) * rday ) * 12. * 8.8 * 0.075 * mfrac / 28.1  
    320             DEALLOCATE( zdust) 
    321          ENDIF 
    322       ELSE 
    323          sumdepsi  = 0._wp 
     312         END IF 
    324313      END IF 
    325314 
     
    419408            CALL iom_open ( TRIM( sn_ndepo%clname ), numdepo ) 
    420409            CALL iom_gettime( numdepo, zsteps, kntime=ntimes_ndep) 
    421             ALLOCATE( zndepo(jpi,jpj,ntimes_ndep) ) 
    422             DO jm = 1, ntimes_ndep 
    423                CALL iom_get( numdepo, jpdom_data, TRIM( sn_ndepo%clvar ), zndepo(:,:,jm), jm ) 
    424             END DO 
    425             CALL iom_close( numdepo ) 
    426             ztimes_ndep = 1._wp / REAL(ntimes_ndep, wp)  
    427             nitdepinput = 0._wp 
    428             DO jm = 1, ntimes_ndep 
    429               nitdepinput = nitdepinput + glob_sum( zndepo(:,:,jm) * e1e2t(:,:) * tmask(:,:,1) * ztimes_ndep ) 
    430             ENDDO 
    431             nitdepinput = nitdepinput / rno3 / 14E6  
    432             DEALLOCATE( zndepo) 
    433          ENDIF 
    434       ELSE 
    435          nitdepinput = 0._wp 
     410         ENDIF 
    436411      ENDIF 
    437412 
     
    459434            DO jj = 2, jpjm1 
    460435               DO ji = fs_2, fs_jpim1 
    461                   IF( tmask(ji,jj,jk) /= 0. ) THEN 
    462                      zmaskt = tmask(ji+1,jj,jk) * tmask(ji-1,jj,jk) * tmask(ji,jj+1,jk)    & 
    463                         &                       * tmask(ji,jj-1,jk) * tmask(ji,jj,jk+1) 
    464                      IF( zmaskt == 0. )   zcmask(ji,jj,jk ) = MAX( 0.1, zcmask(ji,jj,jk) )  
    465                   END IF 
     436                  ze3t   = e3t_0(ji,jj,jk) 
     437                  zsurfc =  e1u(ji,jj) * ( 1. - umask(ji  ,jj  ,jk) )   & 
     438                          + e1u(ji,jj) * ( 1. - umask(ji-1,jj  ,jk) )   & 
     439                          + e2v(ji,jj) * ( 1. - vmask(ji  ,jj  ,jk) )   & 
     440                          + e2v(ji,jj) * ( 1. - vmask(ji  ,jj-1,jk) ) 
     441                  zsurfp = zsurfc * ze3t / e1e2t(ji,jj) 
     442                  ! estimation of the coastal slope : 5 km off the coast 
     443                  ze3t2 = ze3t * ze3t 
     444                  zcslp = SQRT( ( distcoast*distcoast + ze3t2 ) / ze3t2 ) 
     445                  ! 
     446                  zcmask(ji,jj,jk) = zcmask(ji,jj,jk) + zcslp * zsurfp 
    466447               END DO 
    467448            END DO 
     
    519500         WRITE(numout,*) '    DIC Supply : ', rivdicinput*1E3*12./1E12     ,' TgC/yr' 
    520501         WRITE(numout,*)  
    521          WRITE(numout,*) '    Total input of elements from atmospheric supply' 
    522          WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    523          WRITE(numout,*) '    N Supply   : ', nitdepinput*rno3*1E3/1E12*14.,' TgN/yr' 
    524          WRITE(numout,*)  
    525       ENDIF 
     502      ENDIF 
     503      ! 
     504      sedsilfrac = 0.03     ! percentage of silica loss in the sediments 
     505      sedcalfrac = 0.6      ! percentage of calcite loss in the sediments 
    526506      ! 
    527507   END SUBROUTINE p4z_sbc_init 
Note: See TracChangeset for help on using the changeset viewer.