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 13152 for NEMO/branches/NERC/dev_r4.0.2_NERC_Externals/src/TOP/trcrst.F90 – NEMO

Ignore:
Timestamp:
2020-06-24T14:54:29+02:00 (4 years ago)
Author:
jpalmier
Message:

revert accidental changes

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/NERC/dev_r4.0.2_NERC_Externals/src/TOP/trcrst.F90

    r13150 r13152  
    2424   USE daymod 
    2525   USE lib_mpp 
    26    USE sms_medusa 
    2726    
    2827   IMPLICIT NONE 
     
    3332   PUBLIC   trc_rst_wri       ! called by ??? 
    3433   PUBLIC   trc_rst_cal 
    35    PUBLIC   trc_rst_stat 
    36    PUBLIC   trc_rst_conserve  ! Conservation Checks  
    37  
    3834 
    3935   !!---------------------------------------------------------------------- 
     
    153149      IF( kt == nitrst ) THEN 
    154150          CALL trc_rst_stat            ! statistics 
    155           CALL trc_rst_conserve        ! Conservation Checks  
    156151          CALL iom_close( numrtw )     ! close the restart file (only at last time step) 
    157152#if ! defined key_trdmxl_trc 
     
    343338   END SUBROUTINE trc_rst_stat 
    344339 
    345    SUBROUTINE trc_rst_conserve 
    346       !!---------------------------------------------------------------------- 
    347       !!                    ***  trc_rst_conserve  *** 
    348       !! 
    349       !! ** purpose  :   Compute tracers conservation statistics 
    350       !! 
    351       !! AXY (17/11/2017) 
    352       !! This routine calculates the "now" inventories of the elemental  
    353       !! cycles of MEDUSA and compares them to those calculate when the 
    354       !! model was initialised / restarted; the cycles calculated are: 
    355       !!    nitrogen, silicon, iron, carbon, alkalinity and oxygen 
    356       !!---------------------------------------------------------------------- 
    357       INTEGER  :: ji, jj, jk, jn 
    358       REAL(wp) :: zsum3d, zsum2d, zinvt, zdelta, zratio 
    359       REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3d, zvol 
    360       REAL(wp), DIMENSION(jpi,jpj)     :: z2d, zarea 
    361       REAL(wp), DIMENSION(6)           :: loc_cycletot3, loc_cycletot2 
    362       !!---------------------------------------------------------------------- 
    363       ! 
    364       IF( lwp ) THEN 
    365          WRITE(numout,*)  
    366          WRITE(numout,*) '           ----TRACER CONSERVATION----             ' 
    367          WRITE(numout,*)  
    368       ENDIF 
    369       ! 
    370       ! ocean volume 
    371       DO jk = 1, jpk 
    372          zvol(:,:,jk) = e1e2t(:,:) * e3t_a(:,:,jk) * tmask(:,:,jk) 
    373       END DO 
    374       ! 
    375       ! ocean area (for sediments) 
    376       zarea(:,:)      = e1e2t(:,:) * tmask(:,:,1) 
    377       ! 
    378       !---------------------------------------------------------------------- 
    379       ! nitrogen 
    380       z3d(:,:,:) = trn(:,:,:,jpphn) + trn(:,:,:,jpphd) + trn(:,:,:,jpzmi) + & 
    381                    trn(:,:,:,jpzme) + trn(:,:,:,jpdet) + trn(:,:,:,jpdin) 
    382       z2d(:,:)   = zn_sed_n(:,:) 
    383       zsum3d     = glob_sum( z3d(:,:,:) * zvol(:,:,:) ) 
    384       zsum2d     = glob_sum( z2d(:,:) * zarea(:,:) ) 
    385       ! total tracer, and delta 
    386       zinvt      = zsum3d + zsum2d 
    387       zdelta     = zinvt - cycletot(1) 
    388       zratio     = 1.0e2 * zdelta / cycletot(1) 
    389       ! 
    390       IF ( lwp ) WRITE(numout,9010) 'nitrogen', zsum3d, zsum2d, zinvt,   & 
    391          cycletot(1), zdelta, zratio 
    392       IF ( lwp ) WRITE(numout,*)  
    393       ! 
    394       !---------------------------------------------------------------------- 
    395       ! silicon 
    396       z3d(:,:,:) = trn(:,:,:,jppds) + trn(:,:,:,jpsil) 
    397       z2d(:,:)   = zn_sed_si(:,:) 
    398       zsum3d     = glob_sum( z3d(:,:,:) * zvol(:,:,:) ) 
    399       zsum2d     = glob_sum( z2d(:,:) * zarea(:,:) ) 
    400       ! total tracer, and delta 
    401       zinvt      = zsum3d + zsum2d 
    402       zdelta     = zinvt - cycletot(2) 
    403       zratio     = 1.0e2 * zdelta / cycletot(2) 
    404       ! 
    405       IF ( lwp ) WRITE(numout,9010) 'silicon', zsum3d, zsum2d, zinvt,    & 
    406          cycletot(2), zdelta, zratio 
    407       IF ( lwp ) WRITE(numout,*)  
    408       ! 
    409       !---------------------------------------------------------------------- 
    410       ! iron 
    411       z3d(:,:,:) = ((trn(:,:,:,jpphn) + trn(:,:,:,jpphd) + trn(:,:,:,jpzmi) + & 
    412             trn(:,:,:,jpzme) + trn(:,:,:,jpdet)) * xrfn) + trn(:,:,:,jpfer) 
    413       z2d(:,:)   = zn_sed_fe(:,:) 
    414       zsum3d     = glob_sum( z3d(:,:,:) * zvol(:,:,:) ) 
    415       zsum2d     = glob_sum( z2d(:,:) * zarea(:,:) ) 
    416       ! total tracer, and delta 
    417       zinvt      = zsum3d + zsum2d 
    418       zdelta     = zinvt - cycletot(3) 
    419       zratio     = 1.0e2 * zdelta / cycletot(3) 
    420       ! 
    421       IF ( lwp ) WRITE(numout,9010) 'iron', zsum3d, zsum2d, zinvt,       & 
    422          cycletot(3), zdelta, zratio 
    423       IF ( lwp ) WRITE(numout,*)  
    424       ! 
    425       !---------------------------------------------------------------------- 
    426       ! carbon 
    427       z3d(:,:,:) = (trn(:,:,:,jpphn) * xthetapn)  + (trn(:,:,:,jpphd) * xthetapd)  + & 
    428                    (trn(:,:,:,jpzmi) * xthetazmi) + (trn(:,:,:,jpzme) * xthetazme) + & 
    429                    trn(:,:,:,jpdtc) + trn(:,:,:,jpdic) 
    430       z2d(:,:)   = zn_sed_c(:,:) + zn_sed_ca(:,:) 
    431       zsum3d     = glob_sum( z3d(:,:,:) * zvol(:,:,:) ) 
    432       zsum2d     = glob_sum( z2d(:,:) * zarea(:,:) ) 
    433       ! total tracer, and delta 
    434       zinvt      = zsum3d + zsum2d 
    435       zdelta     = zinvt - cycletot(4) 
    436       zratio     = 1.0e2 * zdelta / cycletot(4) 
    437       ! 
    438       IF ( lwp ) WRITE(numout,9010) 'carbon', zsum3d, zsum2d, zinvt,     & 
    439          cycletot(4), zdelta, zratio 
    440       IF ( lwp ) WRITE(numout,*)  
    441       ! 
    442       !---------------------------------------------------------------------- 
    443       ! alkalinity 
    444       z3d(:,:,:) = trn(:,:,:,jpalk) 
    445       z2d(:,:)   = zn_sed_ca(:,:) * 2.0 
    446       zsum3d     = glob_sum( z3d(:,:,:) * zvol(:,:,:) ) 
    447       zsum2d     = glob_sum( z2d(:,:) * zarea(:,:) ) 
    448       ! total tracer, and delta 
    449       zinvt      = zsum3d + zsum2d 
    450       zdelta     = zinvt - cycletot(5) 
    451       zratio     = 1.0e2 * zdelta / cycletot(5) 
    452       ! 
    453       IF ( lwp ) WRITE(numout,9010) 'alkalinity', zsum3d, zsum2d, zinvt, & 
    454          cycletot(5), zdelta, zratio 
    455       IF ( lwp ) WRITE(numout,*)  
    456       ! 
    457       !---------------------------------------------------------------------- 
    458       ! oxygen 
    459       z3d(:,:,:) = trn(:,:,:,jpoxy) 
    460       z2d(:,:)   = 0.0 
    461       zsum3d     = glob_sum( z3d(:,:,:) * zvol(:,:,:) ) 
    462       zsum2d     = glob_sum( z2d(:,:) * zarea(:,:) ) 
    463       ! total tracer, and delta 
    464       zinvt      = zsum3d + zsum2d 
    465       zdelta     = zinvt - cycletot(6) 
    466       zratio     = 1.0e2 * zdelta / cycletot(6) 
    467       ! 
    468       IF ( lwp ) WRITE(numout,9010) 'oxygen', zsum3d, zsum2d, zinvt,     & 
    469          cycletot(6), zdelta, zratio 
    470       ! 
    471       !---------------------------------------------------------------------- 
    472       ! Check  
    473       zsum3d        = glob_sum( zvol(:,:,:) ) 
    474       zsum2d        = glob_sum( zarea(:,:) ) 
    475       IF ( lwp ) THEN  
    476          WRITE(numout,*) 
    477          WRITE(numout,*) ' check : cvol    : ', zsum3d 
    478          WRITE(numout,*) ' check : carea   : ', zsum2d 
    479          WRITE(numout,*) 
    480       ENDIF 
    481       ! 
    482 9010  FORMAT(' element:',a10,                     & 
    483              ' 3d sum:',e18.10,' 2d sum:',e18.10, & 
    484              ' total:',e18.10,' initial:',e18.10, & 
    485              ' delta:',e18.10,' %:',e18.10) 
    486       ! 
    487    END SUBROUTINE trc_rst_conserve  
    488  
    489340#else 
    490341   !!---------------------------------------------------------------------- 
Note: See TracChangeset for help on using the changeset viewer.