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 sbc_arcmsk ! surface boundary condition : runoffs & Arctic mask ! 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 01/11/2016 uncommented below two lines for test !ky 16/10/2016 commented out below two lines !ky 06/09/2016 uncommented below two lines for FA test !ky 11/12/2015 recommented below two lines !!ky 3/12/2015 uncommented below two lines for FA test! REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: erp !: evaporation damping [kg/m2/s] 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 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) :: delta_toa ! global mean annual mean TOA for FA to perturbed ensemble [W/m2] REAL(wp) :: delta_delta_toa ! perturbation to delta_toa [W/m2] 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$ !! 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) :: 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 !!---------------------------------------------------------------------- ! ! ky 17/10/2016 commented out below two lines !write(numout,*) '*** In sbcflx_adj *** delta_toa, delta_delta_toa=', & ! & delta_toa, delta_delta_toa 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 ! K.Y. 16/03/2016 Apply Arctic mask to heat flux adjustment zqrp = ( 1. - 2.*only_arcmsk(ji,jj) ) & & * (sf_qrp(1)%fnow(ji,jj,1) & & + delta_toa + delta_delta_toa) ! & * sf_qrp(1)%fnow(ji,jj,1) & ! & + delta_toa + delta_delta_toa ! K.Y. 02/11/2016 recoded two lines above to only add delta_toas to FA regions ! K.Y. 16/10/2016 added "&" to 2 lines above and ! delta_toa, delta_delta_toa to above line !zqrp = sf_qrp(1)%fnow(ji,jj,1) !ky 07/09/2016 copied 1 line below for FA test !ky 11/12/2015 commented out 1 line below !!ky 3/12/2015 1 line below for FA test! !qrp(ji,jj) = sf_qrp(1)%fnow(ji,jj,1) !ky 07/09/2016 copied 1 line above and modified as below for FA test !ky 16/10/2016 commented out 1 line below !ky 01/11/2016 uncommented 1 line below for test qrp(ji,jj) = zqrp qns(ji,jj) = qns(ji,jj) + zqrp END DO END DO !ky 01/11/2016 uncommented 1 line below for test !ky 16/10/2016 commented out below 1 line below !ky 06/09/2016 uncommented below 1 line below for FA test! !ky 11/12/2015 recommented out below 1 line below !!ky 3/12/2015 uncommented below 1 line below for FA test! CALL iom_put( "qrp", qrp ) ! heat flux damping !ky 01/11/2016 added 1 line below for test CALL iom_put( "only_arcmsk", only_arcmsk ) ! arctic mask ENDIF ! IF( nn_flxadjfw == 1 ) THEN !* Anomalous freshwater term !(salt flux only (sfx)) !CDIR COLLAPSE DO jj = 1, jpj !!write(numout,*) 'sf_qrp(1)%fnow(30,',jj,',1)=',sf_qrp(1)%fnow(30,jj,1), & !! & 'sf_erp(1)%fnow(30,',jj,',1)=',sf_erp(1)%fnow(30,jj,1), & !! & 'sst_m(30,',jj,')=',sst_m(30,jj),'sss_m(30,',jj,')=',sss_m(30,jj) DO ji = 1, jpi zerp = ( 1. - 2.*rnfmsk_arcmsk(ji,jj) ) & ! No damping in vicinity of river mouths & * sf_erp(1)%fnow(ji,jj,1) & & * MAX( sss_m(ji,jj), 1.e-20 )! reconverted into salinity flux !ky 22/07/2016 inserted 1 line above to reflect Dave Storkey's code review !ky 11/12/2015 recommented out 1 line below !!ky 3/12/2015 1 line below for FA test! !erp(ji,jj) = sf_erp(1)%fnow(ji,jj,1) !ky 01/11/2016 uncommented two lines below for test. erp is freshwater flux. !ky 16/10/2016 commented out below two lines !ky 06/09/2016 copied line above and changed to below two lines for FA test! erp(ji,jj) = ( 1. - 2.*rnfmsk_arcmsk(ji,jj) ) & ! No damping in vicinity of river mouths & * sf_erp(1)%fnow(ji,jj,1) sfx(ji,jj) = sfx(ji,jj) + zerp ! salt flux END DO END DO !ky 01/11/2016 uncommented below one line for test !ky 16/10/2016 commented out below one line !ky 06/09/2016 uncommented below one line for FA test! !ky 11/12/2015 recommented out below one line !!ky 3/12/2015 uncommented below one line for FA test! CALL iom_put( "erp", erp ) ! freshwater flux damping !ky 01/11/2016 added 1 line below for test CALL iom_put( "rnfmsk_arcmsk", rnfmsk_arcmsk ) ! river mough & arctic ! ELSEIF( nn_flxadjfw == 2 ) THEN !* Salinity damping term (volume flux (emp) and associated heat flux (qns) zerp_bnd = rn_sssr_bnd / rday ! - - !CDIR COLLAPSE DO jj = 1, jpj DO ji = 1, jpi zerp = ( 1. - 2.*rnfmsk_arcmsk(ji,jj) ) & ! No damping in vicinity of river mouths & * sf_erp(1)%fnow(ji,jj,1) IF( ln_sssr_bnd ) zerp = SIGN( 1., zerp ) * MIN( zerp_bnd, ABS(zerp) ) !ky 11/12/2015 recommented out 1 line below !!ky 3/12/2015 1 line below for FA test! !erp(ji,jj) = sf_erp(1)%fnow(ji,jj,1) !ky 06/09/2016 copied line above and changed to below line for FA test! !ky 01/11/2016 uncommented below line for test !ky 16/10/2016 commented out below line erp(ji,jj) = 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 01/11/2016 uncommented below 1 line for test !ky 16/10/2016 commented out below 1 line !ky 06/09/2016 uncommented below 1 line for FA test! !ky 11/12/2015 recommented out below 1 line !!ky 3/12/2015 uncommented below 1 line for FA test! CALL iom_put( "erp", erp ) ! freshwater flux damping !ky 01/11/2016 added 1 line below for test CALL iom_put( "rnfmsk_arcmsk", rnfmsk_arcmsk ) ! river mough & arctic 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) :: 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, sn_qrp, sn_erp, & & ln_sssr_bnd, rn_sssr_bnd, delta_toa, delta_delta_toa INTEGER :: ios !!---------------------------------------------------------------------- ! !!write(numout,*) '*** in sbcflx_adj_init ***' 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,*) ' Anom. heat flux (qrp) term (Yes=1) nn_flxadjht = ', nn_flxadjht WRITE(numout,*) ' Anom. fw flux (erp) term (Yes=1, salt flux) nn_flxadjfw = ', nn_flxadjfw WRITE(numout,*) ' (Yes=2, volume flux) ' 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' WRITE(numout,*) ' global mean, annual mean TOA to supplement FA delta_toa = ', delta_toa, ' W/m2' WRITE(numout,*) ' perturbation to delta_toa = ', delta_delta_toa, ' W/m2' ENDIF ! ! !* Allocate erp and qrp array !ky 01/11/2016 uncommented out below two lines for test !ky 16/10/2016 commented out below two lines !ky 06/09/2016 uncommented below two lines for FA test! !ky 11/12/2015 recommented out below two lines !!ky 3/12/2015 uncommented below two lines for FA test! ALLOCATE( qrp(jpi,jpj), erp(jpi,jpj), STAT=ierror ) 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_qrp(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_qrp', '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 01/11/2016 uncommented below two lines for test !ky 16/10/2016 commented out below two lines !ky 06/09/2016 below two lines for FA test! !ky 11/12/2015 commented out below two lines !!ky 3/12/2015 below two lines for FA test! IF( nn_flxadjht /= 1 ) qrp(:,:) = 0._wp IF( nn_flxadjfw /= 1 .OR. nn_flxadjfw /= 2 ) erp(:,:) = 0._wp !!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