MODULE trcsbcssr !!====================================================================== !! *** MODULE trcsbcssr *** !! Surface module : restoring term towards surface chlorophyll climatology !!====================================================================== !! History : 3.6 ! 2017-06 (D. Ford) Adapt from sbcssr.F90 !!---------------------------------------------------------------------- #if defined key_top !!---------------------------------------------------------------------- !! trc_sbc_ssr : add a restoring term toward chl climatology !! trc_sbc_ssr_init : initialisation of surface restoring !!---------------------------------------------------------------------- USE dom_oce ! ocean space and time domain USE oce_trc ! shared variables between ocean and passive tracers USE trc USE trcnam_trp ! USE fldread ! read input fields USE iom ! I/O manager USE in_out_manager ! I/O manager USE lib_mpp ! distribued memory computing library USE lbclnk ! ocean lateral boundary conditions (or mpp link) USE timing ! Timing USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) #if defined key_fabm USE par_fabm #endif IMPLICIT NONE PRIVATE PUBLIC trc_sbc_ssr ! routine called in trctrp TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_chldmp ! structure of input Chl (file informations, fields read) !! * Substitutions # include "top_substitute.h90" CONTAINS SUBROUTINE trc_sbc_ssr( kt ) !!--------------------------------------------------------------------- !! *** ROUTINE trc_sbc_ssr *** !! !! ** Purpose : Add to chlorophyll a damping term !! toward chlorophyll climatology !! !! ** Method : - Read chlorophyll climatology !! - at each trc time step add term to each PFT !! surface only (nn_chldmp = 1) !! mixed layer (nn_chldmp = 2) !!--------------------------------------------------------------------- INTEGER, INTENT(in ) :: kt ! ocean time step !! INTEGER :: ji, jj, jk ! dummy loop indices REAL(wp), DIMENSION(jpi,jpj) :: ztra, zchl REAL(wp) :: zpft !!---------------------------------------------------------------------- ! IF( nn_timing == 1 ) CALL timing_start('trc_sbc_ssr') ! IF( kt == nittrc000 ) THEN ! CALL trc_sbc_ssr_init ! IF( nn_chldmp > 0 ) THEN ! IF (lwp) WRITE(numout,*) 'Damping chlorophyll on timestep ', kt ! CALL fld_read( kt, 1, sf_chldmp ) ! Read Chl data and provides it at kt ! #if defined key_fabm zchl(:,:) = trb(:,:,1,jp_fabm_m1+jp_fabm_chl1) + & & trb(:,:,1,jp_fabm_m1+jp_fabm_chl2) + & & trb(:,:,1,jp_fabm_m1+jp_fabm_chl3) + & & trb(:,:,1,jp_fabm_m1+jp_fabm_chl4) ztra(:,:) = rn_chldmp * ( sf_chldmp(1)%fnow(:,:,1) - zchl(:,:) ) ! DO jj = 2, jpjm1 DO ji = fs_2, fs_jpim1 ! vector opt. IF ( ( sf_chldmp(1)%fnow(ji,jj,1) > 0.0 ) .AND. & & ( sf_chldmp(1)%fnow(ji,jj,1) < 100.0 ) .AND. & & ( zchl(ji,jj) > 0.0 ) ) THEN zpft = ( trb(ji,jj,1,jp_fabm_m1+jp_fabm_chl1) / zchl(ji,jj) ) * ztra(ji,jj) tra(ji,jj,1,jp_fabm_m1+jp_fabm_chl1) = tra(ji,jj,1,jp_fabm_m1+jp_fabm_chl1) + zpft IF( nn_chldmp == 2 ) THEN DO jk = 2, jpkm1 IF( fsdept(ji,jj,jk) < hmlp (ji,jj) ) THEN tra(ji,jj,jk,jp_fabm_m1+jp_fabm_chl1) = tra(ji,jj,jk,jp_fabm_m1+jp_fabm_chl1) + zpft ENDIF END DO ENDIF ! zpft = ( trb(ji,jj,1,jp_fabm_m1+jp_fabm_chl2) / zchl(ji,jj) ) * ztra(ji,jj) tra(ji,jj,1,jp_fabm_m1+jp_fabm_chl2) = tra(ji,jj,1,jp_fabm_m1+jp_fabm_chl2) + zpft IF( nn_chldmp == 2 ) THEN DO jk = 2, jpkm1 IF( fsdept(ji,jj,jk) < hmlp (ji,jj) ) THEN tra(ji,jj,jk,jp_fabm_m1+jp_fabm_chl2) = tra(ji,jj,jk,jp_fabm_m1+jp_fabm_chl2) + zpft ENDIF END DO ENDIF ! zpft = ( trb(ji,jj,1,jp_fabm_m1+jp_fabm_chl3) / zchl(ji,jj) ) * ztra(ji,jj) tra(ji,jj,1,jp_fabm_m1+jp_fabm_chl3) = tra(ji,jj,1,jp_fabm_m1+jp_fabm_chl3) + zpft IF( nn_chldmp == 2 ) THEN DO jk = 2, jpkm1 IF( fsdept(ji,jj,jk) < hmlp (ji,jj) ) THEN tra(ji,jj,jk,jp_fabm_m1+jp_fabm_chl3) = tra(ji,jj,jk,jp_fabm_m1+jp_fabm_chl3) + zpft ENDIF END DO ENDIF ! zpft = ( trb(ji,jj,1,jp_fabm_m1+jp_fabm_chl4) / zchl(ji,jj) ) * ztra(ji,jj) tra(ji,jj,1,jp_fabm_m1+jp_fabm_chl4) = tra(ji,jj,1,jp_fabm_m1+jp_fabm_chl4) + zpft IF( nn_chldmp == 2 ) THEN DO jk = 2, jpkm1 IF( fsdept(ji,jj,jk) < hmlp (ji,jj) ) THEN tra(ji,jj,jk,jp_fabm_m1+jp_fabm_chl4) = tra(ji,jj,jk,jp_fabm_m1+jp_fabm_chl4) + zpft ENDIF END DO ENDIF ENDIF END DO END DO #else CALL ctl_stop( 'STOP', 'trc_sbc_ssr: only works with FABM-ERSEM' ) #endif ! ENDIF ! ENDIF ! IF( nn_timing == 1 ) CALL timing_stop('trc_sbc_ssr') ! END SUBROUTINE trc_sbc_ssr SUBROUTINE trc_sbc_ssr_init !!--------------------------------------------------------------------- !! *** ROUTINE trc_sbc_ssr_init *** !! !! ** Purpose : initialisation of surface damping term !! !! ** Method : - Read chlorophyll !!--------------------------------------------------------------------- INTEGER :: ierror ! return error code !!---------------------------------------------------------------------- ! IF( nn_chldmp > 0 ) THEN !* set sf_sss structure & allocate arrays ! ALLOCATE( sf_chldmp(1), STAT=ierror ) IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'trc_sbc_ssr: unable to allocate sf_chldmp structure' ) ALLOCATE( sf_chldmp(1)%fnow(jpi,jpj,1), STAT=ierror ) IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'trc_sbc_ssr: unable to allocate sf_chldmp now array' ) ! ! fill sf_sss with sn_sss and control print CALL fld_fill( sf_chldmp, (/ sn_chldmp /), cn_dir_chldmp, 'trc_sbc_ssr', 'Chl restoring term', 'namtrc_dmp' ) IF( sf_chldmp(1)%ln_tint ) ALLOCATE( sf_chldmp(1)%fdta(jpi,jpj,1,2), STAT=ierror ) IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'trc_sbc_ssr: unable to allocate sf_chldmp data array' ) ! ENDIF ! END SUBROUTINE trc_sbc_ssr_init #else SUBROUTINE trc_sbc_ssr( kt ) ! Empty routine INTEGER, INTENT(in) :: kt WRITE(*,*) 'trc_sbc_ssr: You should not have seen this print! error?', kt END SUBROUTINE trc_sbc_ssr #endif !!====================================================================== END MODULE trcsbcssr