MODULE sbcrnf !!====================================================================== !! *** MODULE sbcrnf *** !! Ocean forcing: river runoff !!===================================================================== !! History : ! 00-11 (R. Hordoir, E. Durand) NetCDF FORMAT !! 8.5 ! 02-09 (G. Madec) F90: Free form and module !! 9.0 ! 06-07 (G. Madec) Surface module !!---------------------------------------------------------------------- !!---------------------------------------------------------------------- !! sbc_rnf : monthly runoffs read in a NetCDF file !! sbc_rnf_init : runoffs initialisation !! rnf_mouth : set river mouth mask !!---------------------------------------------------------------------- USE dom_oce ! ocean space and time domain USE phycst ! physical constants USE dom_oce ! ocean domain variables USE sbc_oce ! surface boundary condition variables USE fldread ! ??? USE in_out_manager ! I/O manager USE daymod ! calendar USE iom ! I/O module IMPLICIT NONE PRIVATE PUBLIC sbc_rnf ! routine call in step module !! * namsbc_rnf namelist CHARACTER(len=100), PUBLIC :: cn_dir = './' !: Root directory for location of ssr files LOGICAL , PUBLIC :: ln_rnf_emp = .false. !: runoffs into a file to be read or already into precipitation TYPE(FLD_N) , PUBLIC :: sn_rnf !: information about the runoff file to be read TYPE(FLD_N) , PUBLIC :: sn_cnf !: information about the runoff mouth file to be read LOGICAL , PUBLIC :: ln_rnf_mouth = .false. !: specific treatment in mouths vicinity REAL(wp) , PUBLIC :: rn_hrnf = 0.e0 !: runoffs, depth over which enhanced vertical mixing is used REAL(wp) , PUBLIC :: rn_avt_rnf = 0.e0 !: runoffs, value of the additional vertical mixing coef. [m2/s] INTEGER , PUBLIC :: nkrnf = 0 !: number of levels over which Kz is increased at river mouths REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: rnfmsk !: river mouth mask (hori.) REAL(wp), PUBLIC, DIMENSION(jpk) :: rnfmsk_z !: river mouth mask (vert.) TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_rnf ! structure of input SST (file information, fields read) !!---------------------------------------------------------------------- !! OPA 9.0 , LOCEAN-IPSL (2006) !! $Id$ !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) !!---------------------------------------------------------------------- CONTAINS SUBROUTINE sbc_rnf( kt ) !!---------------------------------------------------------------------- !! *** ROUTINE sbc_rnf *** !! !! ** Purpose : Introduce a climatological run off forcing !! !! ** Method : Set each river mouth with a monthly climatology !! provided from different data. !! CAUTION : upward water flux, runoff forced to be < 0 !! !! ** Action : runoff updated runoff field at time-step kt !!---------------------------------------------------------------------- INTEGER, INTENT(in) :: kt ! ocean time step ! INTEGER :: ji, jj ! dummy loop indices INTEGER :: ierror ! temporary integer !!---------------------------------------------------------------------- ! IF( kt == nit000 ) THEN IF( .NOT. ln_rnf_emp ) THEN ALLOCATE( sf_rnf(1), STAT=ierror ) IF( ierror > 0 ) THEN CALL ctl_stop( 'sbc_rnf: unable to allocate sf_rnf structure' ) ; RETURN ENDIF ALLOCATE( sf_rnf(1)%fnow(jpi,jpj) ) ALLOCATE( sf_rnf(1)%fdta(jpi,jpj,2) ) ENDIF CALL sbc_rnf_init(sf_rnf) ENDIF ! !-------------------! IF( .NOT. ln_rnf_emp ) THEN ! Update runoff ! ! !-------------------! ! CALL fld_read( kt, nn_fsbc, sf_rnf ) ! Read Runoffs data and provides it ! ! at the current time-step ! Runoff reduction only associated to the ORCA2_LIM configuration ! when reading the NetCDF file runoff_1m_nomask.nc IF( cp_cfg == 'orca' .AND. jp_cfg == 2 ) THEN DO jj = 1, jpj DO ji = 1, jpi IF( gphit(ji,jj) > 40 .AND. gphit(ji,jj) < 65 ) sf_rnf(1)%fnow(ji,jj) = 0.85 * sf_rnf(1)%fnow(ji,jj) END DO END DO ENDIF ! C a u t i o n : runoff is negative and in kg/m2/s emp (:,:) = emp (:,:) - ABS( sf_rnf(1)%fnow(:,:) ) emps(:,:) = emps(:,:) - ABS( sf_rnf(1)%fnow(:,:) ) ! ENDIF ! END SUBROUTINE sbc_rnf SUBROUTINE sbc_rnf_init( sf_rnf ) !!---------------------------------------------------------------------- !! *** ROUTINE sbc_rnf_init *** !! !! ** Purpose : Initialisation of the runoffs if (ln_rnf=T) !! !! ** Method : - read the runoff namsbc_rnf namelist !! !! ** Action : - read parameters !!---------------------------------------------------------------------- TYPE(FLD), INTENT(inout), DIMENSION(:) :: sf_rnf ! input data !! NAMELIST/namsbc_rnf/ cn_dir, ln_rnf_emp, sn_rnf, sn_cnf, ln_rnf_mouth, & & rn_hrnf, rn_avt_rnf !!---------------------------------------------------------------------- ! ! ============ ! ! Namelist ! ! ============ ! (NB: frequency positive => hours, negative => months) ! ! file ! frequency ! variable ! time intep ! clim ! 'yearly' or ! weights ! rotation ! ! ! name ! (hours) ! name ! (T/F) ! (T/F) ! 'monthly' ! filename ! pairs ! sn_rnf = FLD_N( 'runoffs', -1. , 'sorunoff' , .TRUE. , .true. , 'yearly' , '' , '' ) sn_cnf = FLD_N( 'runoffs', 0. , 'sorunoff' , .FALSE. , .true. , 'yearly' , '' , '' ) ! REWIND ( numnam ) ! Read Namelist namsbc_rnf READ ( numnam, namsbc_rnf ) ! ! Control print IF(lwp) THEN WRITE(numout,*) WRITE(numout,*) 'sbc_rnf : runoff ' WRITE(numout,*) '~~~~~~~ ' WRITE(numout,*) ' Namelist namsbc_rnf' WRITE(numout,*) ' runoff in a file to be read ln_rnf_emp = ', ln_rnf_emp WRITE(numout,*) ' specific river mouths treatment ln_rnf_mouth = ', ln_rnf_mouth WRITE(numout,*) ' river mouth additional Kz rn_avt_rnf = ', rn_avt_rnf WRITE(numout,*) ' depth of river mouth additional mixing rn_hrnf = ', rn_hrnf ENDIF ! ! ================== ! ! Type of runoff ! ! ================== ! IF( ln_rnf_emp ) THEN ! runoffs directly provided in the precipitations IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) ' runoffs directly provided in the precipitations' ! ELSE ! runoffs read in a file : set sf_rnf structure ! ! sf_rnf already allocated in main routine ! fill sf_rnf with sn_rnf and control print CALL fld_fill( sf_rnf, (/ sn_rnf /), cn_dir, 'sbc_rnf_init', 'read runoffs data', 'namsbc_rnf' ) ! ENDIF ! ! ======================== ! ! River mouth vicinity ! ! ======================== ! IF( ln_rnf_mouth ) THEN ! Specific treatment in vicinity of river mouths : ! ! - Increase Kz in surface layers ( rn_hrnf > 0 ) ! ! - set to zero SSS damping (ln_ssr=T) ! ! - mixed upstream-centered (ln_traadv_cen2=T) ! ! ! Number of level over which Kz increase nkrnf = 0 IF( rn_hrnf > 0.e0 ) THEN nkrnf = 2 DO WHILE( nkrnf /= jpkm1 .AND. gdepw_0(nkrnf+1) < rn_hrnf ) ; nkrnf = nkrnf + 1 ; END DO IF( ln_sco ) & CALL ctl_warn( 'sbc_rnf: number of levels over which Kz is increased is computed for zco...' ) ENDIF IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) ' Specific treatment used in vicinity of river mouths :' IF(lwp) WRITE(numout,*) ' - Increase Kz in surface layers (if rn_hrnf > 0 )' IF(lwp) WRITE(numout,*) ' by ', rn_avt_rnf,' m2/s over ', nkrnf, ' w-levels' IF(lwp) WRITE(numout,*) ' - set to zero SSS damping (if ln_ssr=T)' IF(lwp) WRITE(numout,*) ' - mixed upstream-centered (if ln_traadv_cen2=T)' ! CALL rnf_mouth ! set river mouth mask ! ELSE ! No treatment at river mouths IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) ' No specific treatment at river mouths' rnfmsk (:,:) = 0.e0 rnfmsk_z(:) = 0.e0 nkrnf = 0 ENDIF END SUBROUTINE sbc_rnf_init SUBROUTINE rnf_mouth !!---------------------------------------------------------------------- !! *** ROUTINE rnf_mouth *** !! !! ** Purpose : define the river mouths mask !! !! ** Method : read the river mouth mask (=0/1) in the river runoff !! climatological file. Defined a given vertical structure. !! CAUTION, the vertical structure is hard coded on the !! first 5 levels. !! This fields can be used to: !! - set an upstream advection scheme !! (ln_rnf_mouth=T and ln_traadv_cen2=T) !! - increase vertical on the top nn_krnf vertical levels !! at river runoff input grid point (nn_krnf>=2, see step.F90) !! - set to zero SSS restoring flux at river mouth grid points !! !! ** Action : rnfmsk set to 1 at river runoff input, 0 elsewhere !! rnfmsk_z vertical structure !!---------------------------------------------------------------------- USE closea, ONLY : nclosea, clo_rnf ! closed sea flag, rnfmsk update routine ! INTEGER :: inum ! temporary integers CHARACTER(len=32) :: cl_rnfile ! runoff file name !!---------------------------------------------------------------------- ! IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) 'rnf_mouth : river mouth mask' IF(lwp) WRITE(numout,*) '~~~~~~~~~ ' cl_rnfile = TRIM( cn_dir )//TRIM( sn_cnf%clname ) IF( .NOT. sn_cnf%ln_clim ) THEN ; WRITE(cl_rnfile, '(a,"_y",i4)' ) TRIM( cl_rnfile ), nyear ! add year IF( sn_cnf%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%clvar, rnfmsk ) ! read the river mouth array CALL iom_close( inum ) ! close file IF( nclosea == 1 ) CALL clo_rnf( rnfmsk ) ! closed sea inflow set as ruver mouth rnfmsk_z(:) = 0.e0 ! vertical structure rnfmsk_z(1) = 1.0 rnfmsk_z(2) = 1.0 ! ********** rnfmsk_z(3) = 0.5 ! HARD CODED on the 5 first levels rnfmsk_z(4) = 0.25 ! ********** rnfmsk_z(5) = 0.125 ! END SUBROUTINE rnf_mouth !!====================================================================== END MODULE sbcrnf