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/SED/sedstp.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/SED/sedstp.F90

    r9950 r10322  
    11MODULE sedstp 
    2 #if defined key_sed 
    32   !!====================================================================== 
    43   !!                       ***  MODULE sedstp   *** 
     
    98   USE sedchem  ! chemical constant 
    109   USE sedco3   ! carbonate in sediment pore water 
    11    USE seddsr   ! dissolution reaction 
     10   USE sedorg   ! Organic reactions and diffusion 
     11   USE sedinorg ! Inorganic dissolution 
    1212   USE sedbtb   ! bioturbation 
    1313   USE sedadv   ! vertical advection 
     
    1616   USE sedrst   ! restart 
    1717   USE sedwri   ! outputs 
     18   USE trcdmp_sed 
     19   USE lib_mpp         ! distribued memory computing library 
     20   USE iom 
    1821 
    1922   IMPLICIT NONE 
     
    4245      !!---------------------------------------------------------------------- 
    4346      INTEGER, INTENT(in) ::   kt       ! number of iteration 
     47      INTEGER :: ji,jk,js,jn,jw 
     48      !!---------------------------------------------------------------------- 
     49      IF( ln_timing )      CALL timing_start('sed_stp') 
     50        ! 
     51                                CALL sed_rst_opn  ( kt )       ! Open tracer restart file  
     52      IF( lrst_sed )            CALL sed_rst_cal  ( kt, 'WRITE' )   ! calenda 
    4453 
    45       !!---------------------------------------------------------------------- 
     54      IF(ln_sediment_offline)   CALL trc_dmp_sed  ( kt ) 
    4655 
    47       IF( kt /= nitsed000 )  THEN 
    48         CALL sed_dta( kt )       ! Load  Data for bot. wat. Chem and fluxes 
    49         CALL sed_chem( kt )      ! update of chemical constant to account for salinity, temperature changes 
     56      dtsed  = r2dttrc 
     57!      dtsed2 = dtsed 
     58      IF (kt /= nitsed000) THEN 
     59         CALL sed_dta( kt )       ! Load  Data for bot. wat. Chem and fluxes 
    5060      ENDIF 
    51       CALL sed_dsr( kt )         ! Dissolution reaction 
    52       CALL sed_adv( kt )         ! advection 
    53       CALL sed_btb( kt )         ! Bioturbation 
    5461 
    55       IF ( ( MOD( kt, nwrised ) == 0 ) .OR. ( MOD( kt, nstock ) == 0 ) .OR. ( kt == nitsedend )  )   & 
    56       CALL sed_co3( kt )         ! pH actualization for saving 
    57       CALL sed_mbc( kt )         ! cumulation for mass balance calculation 
    58 #if ! defined key_sed_off 
    59       CALL sed_sfc( kt )         ! Give back new bottom wat chem to tracer model 
    60 #endif 
    61       CALL sed_rst_wri( kt )   ! restart file output 
     62      IF (sedmask == 1. ) THEN 
     63         IF( kt /= nitsed000 )  THEN 
     64           CALL sed_chem( kt )      ! update of chemical constant to account for salinity, temperature changes 
     65         ENDIF 
     66 
     67         CALL sed_btb( kt )         ! 1st pass of bioturbation at t+1/2 
     68         CALL sed_org( kt )         ! Organic related reactions and diffusion 
     69         CALL sed_inorg( kt )       ! Dissolution reaction 
     70         CALL sed_btb( kt )         ! 2nd pass of bioturbation at t+1 
     71         tokbot(:,:) = 0.0 
     72         DO jw = 1, jpwat 
     73            DO ji = 1, jpoce 
     74               tokbot(ji,jw) = pwcp(ji,1,jw) * 1.e-3 * dzkbot(ji) 
     75            END DO 
     76         ENDDO 
     77         CALL sed_adv( kt )         ! advection 
     78         CALL sed_co3( kt )         ! pH actualization for saving 
     79         ! This routine is commented out since it does not work at all 
     80         CALL sed_mbc( kt )         ! cumulation for mass balance calculation 
     81 
     82         IF (ln_sed_2way) CALL sed_sfc( kt )         ! Give back new bottom wat chem to tracer model 
     83      ENDIF 
    6284      CALL sed_wri( kt )         ! outputs 
     85      IF( kt == nitsed000 ) THEN 
     86          CALL iom_close( numrsr )       ! close input tracer restart file 
     87!          IF(lwm) CALL FLUSH( numont )   ! flush namelist output 
     88      ENDIF 
     89      IF( lrst_sed )            CALL sed_rst_wri( kt )   ! restart file output 
    6390 
    6491      IF( kt == nitsedend )  CLOSE( numsed ) 
    6592 
     93      IF( ln_timing )   CALL timing_stop('sed_stp') 
     94 
    6695   END SUBROUTINE sed_stp 
    6796 
    68 #else 
    69    !!====================================================================== 
    70    !! MODULE sedstp  :   Dummy module  
    71    !!====================================================================== 
    72    !! $Id$ 
    73 CONTAINS 
    74    SUBROUTINE sed_stp( kt )         ! Empty routine 
    75       INTEGER, INTENT(in) :: kt 
    76       WRITE(*,*) 'sed_stp: You should not have seen this print! error?', kt 
    77    END SUBROUTINE sed_stp 
    78 #endif 
    7997END MODULE sedstp 
Note: See TracChangeset for help on using the changeset viewer.