MODULE sbcflx_adj !!====================================================================== !! *** MODULE sbcflx_adj *** !! Surface module : flux adjustment of heat/freshwater. Add qrp/erp obtained from sbcssr !!====================================================================== !! History : 0.0 ! 2015-10-14 (K. Yamazaki) Original code !!---------------------------------------------------------------------- !!---------------------------------------------------------------------- !! sbc_flx_adj : add qrp/erp to sbc to perform flux adjustment !! sbc_flx_adj_init : initialisation of flux adjustment !!---------------------------------------------------------------------- USE oce ! ocean dynamics and tracers USE dom_oce ! ocean space and time domain USE sbc_oce ! surface boundary condition USE phycst ! physical constants USE sbcrnf ! surface boundary condition : runoffs ! 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) IMPLICIT NONE PRIVATE PUBLIC sbc_flx_adj ! routine called in sbcmod PUBLIC sbc_flx_adj_init ! routine called in sbcmod !ky!REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: erp !: evaporation damping [kg/m2/s] !ky!REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qrp !: heat flux damping [w/m2] ! !!* Namelist namsbc_flx_adj * INTEGER, PUBLIC :: nn_flxadjht ! Heat/freshwater flux adjustment indicator INTEGER, PUBLIC :: nn_flxadjfw ! Heat/freshwater flux adjustment indicator REAL(wp) :: rn_dqdt ! restoring factor on SST and SSS REAL(wp) :: rn_deds ! restoring factor on SST and SSS LOGICAL :: ln_sssr_bnd ! flag to bound erp term REAL(wp) :: rn_sssr_bnd ! ABS(Max./Min.) value of erp term [mm/day] REAL(wp) , ALLOCATABLE, DIMENSION(:) :: buffer ! Temporary buffer for exchange TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_erp ! structure of input erp (file informations, fields read) TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_qrp ! structure of input qrp (file informations, fields read) !! * Substitutions # include "domzgr_substitute.h90" !!---------------------------------------------------------------------- !! NEMO/OPA 4.0 , NEMO Consortium (2011) !! $Id: sbcssr.F90 4990 2014-12-15 16:42:49Z timgraham $ !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) !!---------------------------------------------------------------------- CONTAINS SUBROUTINE sbc_flx_adj( kt ) !!--------------------------------------------------------------------- !! *** ROUTINE sbc_flx_adj *** !! !! ** Purpose : Add to heat and/or freshwater fluxes a qrp and/or erp !! to flux adjust temperature/salinity !! !! ** Method : - Read namelist namsbc_flx_adj !! - Read calculated qrp and/or erp !! - at each nscb time step !! add qrp on qns (nn_flxadjht = 1) !! add erp on sfx (nn_flxadjfw = 1) !! add erp on emp (nn_flxadjfw = 2) !!--------------------------------------------------------------------- INTEGER, INTENT(in ) :: kt ! ocean time step !! INTEGER :: ji, jj ! dummy loop indices REAL(wp) :: zerp ! local scalar for evaporation damping REAL(wp) :: zqrp ! local scalar for heat flux damping REAL(wp) :: zsrp ! local scalar for unit conversion of rn_deds factor REAL(wp) :: zerp_bnd ! local scalar for unit conversion of rn_epr_max factor INTEGER :: ierror ! return error code !! CHARACTER(len=100) :: cn_dir ! Root directory for location of ssr files TYPE(FLD_N) :: sn_qrp, sn_erp ! informations about the fields to be read !!---------------------------------------------------------------------- ! IF( nn_timing == 1 ) CALL timing_start('sbc_flx_adj') ! IF( nn_flxadjht + nn_flxadjfw /= 0 ) THEN ! IF( nn_flxadjht == 1) CALL fld_read( kt, nn_fsbc, sf_qrp ) ! Read qrp data and provides it at kt IF( nn_flxadjfw >= 1) CALL fld_read( kt, nn_fsbc, sf_erp ) ! Read erp data and provides it at kt ! ! ! ========================= ! IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN ! Add restoring term ! ! ! ========================= ! ! IF( nn_flxadjht == 1 ) THEN !* Anomalous heat flux term (qrp) DO jj = 1, jpj DO ji = 1, jpi zqrp = sf_qrp(1)%fnow(ji,jj,1) qns(ji,jj) = qns(ji,jj) + zqrp END DO END DO !ky! CALL iom_put( "qrp", qrp ) ! heat flux damping ENDIF ! IF( nn_flxadjfw == 1 ) THEN !* Anomalous freshwater term !(salt flux only (sfx)) zsrp = rn_deds / rday ! from [mm/day] to [kg/m2/s] !CDIR COLLAPSE DO jj = 1, jpj DO ji = 1, jpi zerp = ( 1. - 2.*rnfmsk(ji,jj) ) & ! No damping in vicinity of river mouths & * sf_erp(1)%fnow(ji,jj,1) & & * MAX( sss_m(ji,jj), 1.e-20 ) sfx(ji,jj) = sfx(ji,jj) + zerp ! salt flux END DO END DO !ky!CALL iom_put( "erp", erp ) ! freshwater flux damping ! ELSEIF( nn_flxadjfw == 2 ) THEN !* Salinity damping term (volume flux (emp) and associated heat flux (qns) zsrp = rn_deds / rday ! from [mm/day] to [kg/m2/s] zerp_bnd = rn_sssr_bnd / rday ! - - !CDIR COLLAPSE DO jj = 1, jpj DO ji = 1, jpi zerp = sf_erp(1)%fnow(ji,jj,1) IF( ln_sssr_bnd ) zerp = SIGN( 1., zerp ) * MIN( zerp_bnd, ABS(zerp) ) emp(ji,jj) = emp (ji,jj) + zerp qns(ji,jj) = qns(ji,jj) - zerp * rcp * sst_m(ji,jj) END DO END DO !ky!CALL iom_put( "erp", erp ) ! freshwater flux damping ENDIF ! ENDIF ! ENDIF ! IF( nn_timing == 1 ) CALL timing_stop('sbc_flx_adj') ! END SUBROUTINE sbc_flx_adj SUBROUTINE sbc_flx_adj_init !!--------------------------------------------------------------------- !! *** ROUTINE sbc_flx_adj_init *** !! !! ** Purpose : initialisation of surface damping term !! !! ** Method : - Read namelist namsbc_flx_adj !ky!!! - Read observed SST and/or SSS if required !!--------------------------------------------------------------------- INTEGER :: ji, jj ! dummy loop indices REAL(wp) :: zerp ! local scalar for evaporation damping REAL(wp) :: zqrp ! local scalar for heat flux damping REAL(wp) :: zsrp ! local scalar for unit conversion of rn_deds factor REAL(wp) :: zerp_bnd ! local scalar for unit conversion of rn_epr_max factor INTEGER :: ierror ! return error code !! CHARACTER(len=100) :: cn_dir ! Root directory for location of ssr files TYPE(FLD_N) :: sn_qrp, sn_erp ! informations about the fields to be read NAMELIST/namsbc_flx_adj/ cn_dir, nn_flxadjht, nn_flxadjfw, rn_dqdt, rn_deds, sn_qrp, sn_erp, ln_sssr_bnd, rn_sssr_bnd INTEGER :: ios !!---------------------------------------------------------------------- ! REWIND( numnam_ref ) ! Namelist namsbc_flx_adj in reference namelist : READ ( numnam_ref, namsbc_flx_adj, IOSTAT = ios, ERR = 901) 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_flx_adj in reference namelist', lwp ) REWIND( numnam_cfg ) ! Namelist namsbc_flx_adj in configuration namelist : READ ( numnam_cfg, namsbc_flx_adj, IOSTAT = ios, ERR = 902 ) 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_flx_adj in configuration namelist', lwp ) IF(lwm) WRITE ( numond, namsbc_flx_adj ) IF(lwp) THEN !* control print WRITE(numout,*) WRITE(numout,*) 'sbc_flx_adj : Heat and/or freshwater flux adjustment term ' WRITE(numout,*) '~~~~~~~ ' WRITE(numout,*) ' Namelist namsbc_flx_adj :' WRITE(numout,*) ' Anomalous heat flux (qrp) term (Yes=1) nn_flxadjht = ', nn_flxadjht WRITE(numout,*) ' Anomalous freshwater flux (erp) term (Yes=1, salt flux) nn_flxadjfw = ', nn_flxadjfw WRITE(numout,*) ' (Yes=2, volume flux) ' WRITE(numout,*) ' dQ/dT (restoring magnitude on SST) rn_dqdt = ', rn_dqdt, ' W/m2/K' WRITE(numout,*) ' dE/dS (restoring magnitude on SST) rn_deds = ', rn_deds, ' mm/day' WRITE(numout,*) ' flag to bound erp term ln_sssr_bnd = ', ln_sssr_bnd WRITE(numout,*) ' ABS(Max./Min.) erp threshold rn_sssr_bnd = ', rn_sssr_bnd, ' mm/day' ENDIF ! ! !* Allocate erp and qrp array !ky!ALLOCATE( qrp(jpi,jpj), erp(jpi,jpj), STAT=ierror ) !ky!IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate erp and qrp array' ) ! IF( nn_flxadjht == 1 ) THEN !* set sf_qrp structure & allocate arrays ! ALLOCATE( sf_qrp(1), STAT=ierror ) IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_flx_adj: unable to allocate sf_qrp structure' ) ALLOCATE( sf_sst(1)%fnow(jpi,jpj,1), STAT=ierror ) IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_flx_adj: unable to allocate sf_qrp now array' ) ! ! fill sf_qrp with sn_qrp and control print CALL fld_fill( sf_qrp, (/ sn_qrp /), cn_dir, 'sbc_flx_adj', 'Heat flux adjustment', 'namsbc_flx_adj' ) IF( sf_qrp(1)%ln_tint ) ALLOCATE( sf_qrp(1)%fdta(jpi,jpj,1,2), STAT=ierror ) IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_flx_adj: unable to allocate sf_qrp data array' ) ! ENDIF ! IF( nn_flxadjfw >= 1 ) THEN !* set sf_erp structure & allocate arrays ! ALLOCATE( sf_erp(1), STAT=ierror ) IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_flx_adj: unable to allocate sf_erp structure' ) ALLOCATE( sf_erp(1)%fnow(jpi,jpj,1), STAT=ierror ) IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_flx_adj: unable to allocate sf_erp now array' ) ! ! fill sf_erp with sn_erp and control print CALL fld_fill( sf_erp, (/ sn_erp /), cn_dir, 'sbc_erp', 'Freshwater flux adjustment term', 'namsbc_flx_adj' ) IF( sf_erp(1)%ln_tint ) ALLOCATE( sf_erp(1)%fdta(jpi,jpj,1,2), STAT=ierror ) IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_flx_adj: unable to allocate sf_erp data array' ) ! ENDIF ! !ky!! !* Initialize qrp and erp if no restoring !ky!IF( nn_sstr /= 1 ) qrp(:,:) = 0._wp !ky!IF( nn_sssr /= 1 .OR. nn_sssr /= 2 ) erp(:,:) = 0._wp ! END SUBROUTINE sbc_flx_adj_init !!====================================================================== END MODULE sbcflx_adj