MODULE sbc_arcmsk !!====================================================================== !! *** MODULE sbc_arcmsk *** !! Ocean forcing: masking Arctic (based on river runoff) !!===================================================================== !! History : ! !! NEMO 3.6 ! 2016-03 (K. Yamazaki) !!---------------------------------------------------------------------- !!---------------------------------------------------------------------- !! sbc_rnf_init_arcmsk : runoffs initialisation !! rnf_mouth_arcmsk : set river mouth mask !!---------------------------------------------------------------------- USE dom_oce ! ocean space and time domain USE phycst ! physical constants USE sbc_oce ! surface boundary condition variables USE sbcisf ! PM we could remove it I think USE sbcrnf ! surface boundary condition : runoffs USE closea ! closed seas USE fldread ! read input field at current time step USE in_out_manager ! I/O manager USE iom ! I/O module USE lib_mpp ! MPP library USE eosbn2 USE wrk_nemo ! Memory allocation IMPLICIT NONE PRIVATE PUBLIC sbc_rnf_alloc_arcmsk ! routine call in sbcmod module PUBLIC sbc_rnf_init_arcmsk ! (PUBLIC for TAM) ! !!* namsbc_rnf namelist * CHARACTER(len=100) :: cn_dir !: Root directory for location of rnf files TYPE(FLD_N) :: sn_cnf_arcmsk !: information about the runoff mouth file to be read REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rnfmsk_arcmsk !: river mouth & Arctic mask (hori.) REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: only_arcmsk !: only Arctic mask (hori.) !! * Substitutions # include "domzgr_substitute.h90" !!---------------------------------------------------------------------- !! NEMO/OPA 3.3 , NEMO Consortium (2010) !! $Id$ !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) !!---------------------------------------------------------------------- CONTAINS INTEGER FUNCTION sbc_rnf_alloc_arcmsk() !!---------------------------------------------------------------------- !! *** ROUTINE sbc_rnf_alloc_arcmsk *** !!---------------------------------------------------------------------- ALLOCATE( rnfmsk_arcmsk(jpi,jpj) , STAT=sbc_rnf_alloc_arcmsk ) ALLOCATE( only_arcmsk(jpi,jpj) , STAT=sbc_rnf_alloc_arcmsk ) ! IF( lk_mpp ) CALL mpp_sum ( sbc_rnf_alloc_arcmsk ) IF( sbc_rnf_alloc_arcmsk > 0 ) CALL ctl_warn('sbc_rnf_alloc_arcmsk: allocation of arrays failed') END FUNCTION sbc_rnf_alloc_arcmsk SUBROUTINE sbc_rnf_init_arcmsk !!---------------------------------------------------------------------- !! *** ROUTINE sbc_rnf_init_arcmsk *** !! !! ** Purpose : Initialisation of the runoffs if (ln_rnf_arcmsk=T) !! !! ** Method : - read the runoff namsbc_rnf_arcmsk namelist !! !! ** Action : - read parameters !!---------------------------------------------------------------------- INTEGER :: ios ! Local integer output status for namelist read NAMELIST/namsbc_rnf_arcmsk/ cn_dir , sn_cnf_arcmsk !!---------------------------------------------------------------------- ! ! !== allocate runoff arrays IF( sbc_rnf_alloc_arcmsk() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_rnf_alloc_arcmsk : unable to allocate arrays' ) ! IF( .NOT. ln_rnf ) THEN ! no specific treatment in vicinity of river mouths ln_rnf_mouth = .FALSE. ! default definition needed for example by sbc_ssr or by tra_adv_muscl rnfmsk_arcmsk (:,:) = 0.0_wp RETURN ENDIF ! ! ! ============ ! ! Namelist for arcmsk ! ! ============ ! REWIND( numnam_ref ) ! Namelist namsbc_rnf_arcmsk in reference namelist : Runoffs & Arctic mask READ ( numnam_ref, namsbc_rnf_arcmsk, IOSTAT = ios, ERR = 901) 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_rnf_arcmsk in reference namelist', lwp ) REWIND( numnam_cfg ) ! Namelist namsbc_rnf_arcmsk in configuration namelist : Runoffs & Arctic mask READ ( numnam_cfg, namsbc_rnf_arcmsk, IOSTAT = ios, ERR = 902 ) 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_rnf_arcmsk in configuration namelist', lwp ) IF(lwm) WRITE ( numond, namsbc_rnf_arcmsk ) ! ! ! Control print IF(lwp) THEN WRITE(numout,*) WRITE(numout,*) 'sbc_rnf_init_arcmsk : runoff & arctic mask' WRITE(numout,*) '~~~~~~~ ' WRITE(numout,*) ' Namelist namsbc_rnf_arcmsk' WRITE(numout,*) ' river mouth & Arctic file name sn_cnf_arcmsk = ', sn_cnf_arcmsk ENDIF ! ! ======================== ! ! River mouth vicinity ! ! ======================== ! ! No need to worry about it because would have been taken care of in rnfmsk already ! ! ! ======================== ! ! River mouth vicinity ! ! ======================== CALL rnf_mouth_arcmsk ! set river mouth mask & Arctic mask ! END SUBROUTINE sbc_rnf_init_arcmsk SUBROUTINE rnf_mouth_arcmsk !!---------------------------------------------------------------------- !! *** ROUTINE rnf_mouth *** !! !! ** Purpose : define the river mouths mask and mask out Arctic for use with !! SST & SSS restoring and flux adjustment !! !! ** Method : read the river mouth mask (=0/1) in the river runoff !! climatological file. !! This fields can be used to: !! - set to zero SST & SSS restoring flux at river mouth grid points and over the Arctic !! !! ** Action : rnfmsk_arcmsk set to 1 at river runoff input and Arctic, 0 elsewhere !!---------------------------------------------------------------------- INTEGER :: inum ! temporary integers CHARACTER(len=140) :: cl_rnfile ! runoff file name !!---------------------------------------------------------------------- ! IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) 'rnf_mouth_arcmsk: river mouth and Arctic mask' IF(lwp) WRITE(numout,*) '~~~~~~~~~ ' ! cl_rnfile = TRIM( cn_dir )//TRIM( sn_cnf_arcmsk%clname ) IF( .NOT. sn_cnf_arcmsk%ln_clim ) THEN ; WRITE(cl_rnfile, '(a,"_y",i4)' ) TRIM( cl_rnfile ), nyear ! add year IF( sn_cnf_arcmsk%cltype == 'monthly' ) WRITE(cl_rnfile, '(a,"m",i2)' ) TRIM( cl_rnfile ), nmonth ! add month ENDIF ! ! horizontal mask (read in NetCDF file) CALL iom_open ( cl_rnfile, inum ) ! open file CALL iom_get ( inum, jpdom_data, sn_cnf_arcmsk%clvar, only_arcmsk ) ! read the river mouth array CALL iom_close( inum ) ! close file ! !IF( nn_closea == 1 ) CALL clo_rnf( rnfmsk_arcmsk ) ! closed sea inflow set as ruver mouth ! ! combine arctic only mask and river mouth mask rnfmsk_arcmsk(:,:) = only_arcmsk(:,:) + rnfmsk(:,:) ! ! however in grids where the arctic mask and river mouth masks overlap, just use river mouth mask value where ( rnfmsk(:,:).gt.0.495 .and. rnfmsk(:,:).lt.0.505 ) rnfmsk_arcmsk(:,:) = rnfmsk(:,:) ! END SUBROUTINE rnf_mouth_arcmsk !!====================================================================== END MODULE sbc_arcmsk