MODULE trcsed_medusa !!====================================================================== !! *** MODULE trcsed_medusa *** !! TOP : MEDUSA Compute loss of organic matter in the sediments !!====================================================================== !! History : - ! 1995-06 (M. Levy) original code !! - ! 2000-12 (E. Kestenare) clean up !! 2.0 ! 2007-12 (C. Deltel, G. Madec) F90 + simplifications !! - ! 2008-08 (K. Popova) adaptation for MEDUSA !! - ! 2008-11 (A. Yool) continuing adaptation for MEDUSA !! - ! 2010-03 (A. Yool) updated for branch inclusion !! - ! 2011-04 (A. Yool) updated for ROAM project !!---------------------------------------------------------------------- #if defined key_medusa !!---------------------------------------------------------------------- !! 'key_medusa' MEDUSA bio-model !!---------------------------------------------------------------------- !! trc_sed_medusa : Compute loss of organic matter in the sediments !!---------------------------------------------------------------------- USE oce_trc ! USE trc USE sms_medusa !! AXY (10/02/09) USE iom USE lbclnk USE prtctl_trc ! Print control for debbuging IMPLICIT NONE PRIVATE PUBLIC trc_sed_medusa ! called in ??? PUBLIC trc_sed_medusa_sbc !! * Module variables INTEGER :: & ryyss, & !: number of seconds per year rmtss !: number of seconds per month !! AXY (10/02/09) LOGICAL, PUBLIC :: & bdustfer = .TRUE. REAL(wp), PUBLIC :: & sedfeinput = 1.e-9_wp , & dustsolub = 0.014_wp INTEGER :: & numdust, & nflx1, nflx2, & nflx11, nflx12 !!* Substitution # include "domzgr_substitute.h90" !!---------------------------------------------------------------------- !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) !! $Id$ !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) !!---------------------------------------------------------------------- CONTAINS SUBROUTINE trc_sed_medusa( kt ) !!--------------------------------------------------------------------- !! *** ROUTINE trc_sed_medusa *** !! !! ** Purpose : compute the now trend due to the vertical sedimentation of !! detritus and add it to the general trend of detritus equations !! !! ** Method : this ROUTINE compute not exactly the advection but the !! transport term, i.e. dz(wt) and dz(ws)., dz(wtr) !! using an upstream scheme !! the now vertical advection of tracers is given by: !! dz(trn wn) = 1/bt dk+1( e1t e2t vsed (trn) ) !! add this trend now to the general trend of tracer (ta,sa,tra): !! tra = tra + dz(trn wn) !! !! IF 'key_trc_diabio' is defined, the now vertical advection !! trend of passive tracers is saved for futher diagnostics. !!--------------------------------------------------------------------- INTEGER, INTENT( in ) :: kt ! ocean time-step index !! AXY (10/02/09) INTEGER :: jnt !! INTEGER :: ji, jj, jk REAL(wp) :: ztra REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwork !! AXY (10/02/09) REAL(wp), DIMENSION(jpi,jpj) :: zsidep !! Si deposition REAL(wp), DIMENSION(jpi,jpj,jpk) :: zirondep !! Fe deposition REAL(wp) :: rfact2 CHARACTER (len=25) :: charout !!--------------------------------------------------------------------- !! AXY (10/02/09) jnt = 1 rfact2 = 1.0 ! Number of seconds per year and per month ryyss = nyear_len(1) * rday rmtss = ryyss / raamo !! AXY (20/11/14): alter this to report on first MEDUSA call !! IF( kt == nit000 ) THEN IF( kt == nittrc000 ) THEN IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) ' trc_sed_medusa: MEDUSA sedimentation' IF(lwp) WRITE(numout,*) ' ~~~~~~~' IF(lwp) WRITE(numout,*) ' kt =',kt ENDIF !! AXY (04/11/13): replace this with a call in trc_ini_medusa !! AXY (25/02/10) !! call routine for populating CCD array if this is the first time-step !! IF( kt == nittrc000 ) CALL medusa_ccd( kt ) !! AXY (04/11/13): replace this with a call in trc_ini_medusa !! AXY (26/01/12) !! call routine for populating river arrays if this is the first time-step !! IF( kt == nittrc000 ) CALL medusa_river( kt ) !! AXY (10/02/09) IF( (jnt == 1) .and. (bdustfer) ) CALL trc_sed_medusa_sbc( kt ) !! zirondep(:,:,:) = 0.e0 !! Initialisation of deposition variables zsidep (:,:) = 0.e0 !! !! Iron and Si deposition at the surface !! ------------------------------------- !! DO jj = 1, jpj DO ji = 1, jpi zirondep(ji,jj,1) = (dustsolub * dust(ji,jj) / (55.85 * rmtss) + 3.e-10 / ryyss) & & * rfact2 / fse3t(ji,jj,1) zsidep (ji,jj) = 8.8 * 0.075 * dust(ji,jj) * rfact2 / & & (fse3t(ji,jj,1) * 28.1 * rmtss) END DO END DO ! sedimentation of detrital nitrogen : upstream scheme ! ---------------------------------------------------- ! zwork(:,:,:) = 0.e0 ! initialisation of sinking variable ! for detrital nitrogen sedimentation only - jpdet zwork(:,:,1 ) = 0.e0 ! surface value set to zero zwork(:,:,jpk) = 0.e0 ! bottom value set to zero ! ! tracer flux at w-point: we use -vsed (downward flux) with simplification : no e1*e2 DO jk = 2, jpk ! AXY (17/07/14): change "0.d0" to "0." ! zwork(:,:,jk) = -vsed * max(trn(:,:,jk-1,jpdet),0.d0) * tmask(:,:,jk-1) zwork(:,:,jk) = -vsed * max(trn(:,:,jk-1,jpdet),0.) * tmask(:,:,jk-1) ! ! AXY (16/01/14): stop sinking in upper 10m to reduce model instability ! in shallower grid cells ! if ( jk .lt. 9 ) zwork(:,:,jk) = 0.e0 END DO ! ! tracer flux divergence at t-point added to the general trend DO jk = 1, jpkm1 DO jj = 1, jpj DO ji = 1,jpi ztra = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / fse3t(ji,jj,jk) tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + ztra # if defined key_trc_diabio trbio(ji,jj,jk,8) = ztra # endif IF( ln_diatrc ) & & trc2d(ji,jj,8) = trc2d(ji,jj,8) + ztra * fse3t(ji,jj,jk) * 86400. END DO END DO END DO ! # if defined key_trc_diabio CALL lbc_lnk (trbio(:,:,1,8), 'T', 1. ) ! Lateral boundary conditions on trcbio # endif IF( ln_diatrc ) CALL lbc_lnk( trc2d(:,:,8), 'T', 1. ) ! Lateral boundary conditions on trc2d # if defined key_iomput CALL iom_put( "DSED",trc2d(:,:,8) ) # endif # if defined key_roam ! sedimentation of detrital carbon : upstream scheme ! -------------------------------------------------- ! zwork(:,:,:) = 0.e0 ! initialisation of sinking variable ! for detrital carbon sedimentation only - jpdtc zwork(:,:,1 ) = 0.e0 ! surface value set to zero zwork(:,:,jpk) = 0.e0 ! bottom value set to zero ! ! tracer flux at w-point: we use -vsed (downward flux) with simplification : no e1*e2 DO jk = 2, jpk ! AXY (17/07/14): change "0.d0" to "0." ! zwork(:,:,jk) = -vsed * max(trn(:,:,jk-1,jpdtc),0.d0) * tmask(:,:,jk-1) zwork(:,:,jk) = -vsed * max(trn(:,:,jk-1,jpdtc),0.) * tmask(:,:,jk-1) ! ! AXY (16/01/14): stop sinking in upper 10m to reduce model instability ! in shallower grid cells ! if ( jk .lt. 9 ) zwork(:,:,jk) = 0.e0 END DO ! ! tracer flux divergence at t-point added to the general trend DO jk = 1, jpkm1 DO jj = 1, jpj DO ji = 1,jpi ztra = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / fse3t(ji,jj,jk) tra(ji,jj,jk,jpdtc) = tra(ji,jj,jk,jpdtc) + ztra !! # if defined key_trc_diabio !! trbio(ji,jj,jk,8) = ztra !! # endif !! IF( ln_diatrc ) & !! & trc2d(ji,jj,8) = trc2d(ji,jj,8) + ztra * fse3t(ji,jj,jk) * 86400. END DO END DO END DO ! !! # if defined key_trc_diabio !! CALL lbc_lnk (trbio(:,:,1,8), 'T', 1. ) ! Lateral boundary conditions on trcbio !! # endif !! IF( ln_diatrc ) CALL lbc_lnk( trc2d(:,:,8), 'T', 1. ) ! Lateral boundary conditions on trc2d !! # if defined key_iomput !! CALL iom_put( "DSED",trc2d(:,:,8) ) !! # endif # endif IF(ln_ctl) THEN ! print mean trends (used for debugging) WRITE(charout, FMT="('sed')") CALL prt_ctl_trc_info(charout) CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) ENDIF END SUBROUTINE trc_sed_medusa !! ====================================================================== !! ====================================================================== !! ====================================================================== !! AXY (10/02/09) SUBROUTINE trc_sed_medusa_sbc(kt) !!---------------------------------------------------------------------- !! *** ROUTINE trc_sed_medusa_sbc *** !! !! ** Purpose : Read and interpolate the external sources of !! nutrients !! !! ** Method : Read the files and interpolate the appropriate variables !! !! ** input : external netcdf files !! !!---------------------------------------------------------------------- !! * arguments INTEGER, INTENT( in ) :: kt ! ocean time step !! * Local declarations INTEGER :: & imois, imois2, & ! temporary integers i15 , iman ! " " REAL(wp) :: & zxy ! " " !!--------------------------------------------------------------------- !! Initialization !! -------------- !! i15 = nday / 16 iman = INT( raamo ) imois = nmonth + i15 - 1 IF( imois == 0 ) imois = iman imois2 = nmonth !! 1. first call kt=nittrc000 !! ----------------------- !! IF( kt == nittrc000 ) THEN ! initializations nflx1 = 0 nflx11 = 0 ! open the file IF(lwp) THEN WRITE(numout,*) ' ' WRITE(numout,*) ' **** Routine trc_sed_medusa_sbc' ENDIF CALL iom_open ( 'dust.orca.nc', numdust ) IF(lwp) WRITE(numout,*) 'trc_sed_medusa_sbc: dust.orca.nc opened' ENDIF !! Read monthly file !! ---------------- !! IF( kt == nittrc000 .OR. imois /= nflx1 ) THEN !! Calendar computation !! !! nflx1 number of the first file record used in the simulation !! nflx2 number of the last file record !! nflx1 = imois nflx2 = nflx1+1 nflx1 = MOD( nflx1, iman ) nflx2 = MOD( nflx2, iman ) IF( nflx1 == 0 ) nflx1 = iman IF( nflx2 == 0 ) nflx2 = iman IF(lwp) WRITE(numout,*) 'trc_sed_medusa_sbc: first record file used nflx1 ',nflx1 IF(lwp) WRITE(numout,*) 'trc_sed_medusa_sbc: last record file used nflx2 ',nflx2 !! Read monthly fluxes data !! !! humidity !! CALL iom_get ( numdust, jpdom_data, 'dust', dustmo(:,:,1), nflx1 ) CALL iom_get ( numdust, jpdom_data, 'dust', dustmo(:,:,2), nflx2 ) IF(lwp .AND. nitend-nit000 <= 100 ) THEN WRITE(numout,*) WRITE(numout,*) ' read clio flx ok' WRITE(numout,*) WRITE(numout,*) WRITE(numout,*) 'Clio month: ',nflx1,' field: dust' CALL prihre( dustmo(:,:,1),jpi,jpj,1,jpi,20,1,jpj,10,1e9,numout ) ENDIF ENDIF !! 3. at every time step interpolation of fluxes !! --------------------------------------------- !! zxy = FLOAT( nday + 15 - 30 * i15 ) / 30 dust(:,:) = ( (1.-zxy) * dustmo(:,:,1) + zxy * dustmo(:,:,2) ) IF( kt == nitend ) THEN CALL iom_close (numdust) IF(lwp) WRITE(numout,*) 'trc_sed_medusa_sbc: dust.orca.nc closed' ENDIF END SUBROUTINE trc_sed_medusa_sbc #else !!====================================================================== !! Dummy module : No MEDUSA bio-model !!====================================================================== CONTAINS SUBROUTINE trc_sed_medusa( kt ) ! Empty routine INTEGER, INTENT( in ) :: kt WRITE(*,*) 'trc_sed_medusa: You should not have seen this print! error?', kt END SUBROUTINE trc_sed_medusa #endif !!====================================================================== END MODULE trcsed_medusa