MODULE sbcrnf !!====================================================================== !! *** MODULE sbcrnf *** !! Ocean forcing: river runoff !!===================================================================== !! History : OPA ! 2000-11 (R. Hordoir, E. Durand) NetCDF FORMAT !! NEMO 1.0 ! 2002-09 (G. Madec) F90: Free form and module !! 3.0 ! 2006-07 (G. Madec) Surface module !! 3.2 ! 2009-04 (B. Lemaire) Introduce iom_put !!---------------------------------------------------------------------- !!---------------------------------------------------------------------- !! 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 sbc_oce ! surface boundary condition variables USE fldread ! ??? USE in_out_manager ! I/O manager 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 TYPE(FLD_N) :: sn_sal_rnf !: information about the salinities of runoff file to be read TYPE(FLD_N) :: sn_tmp_rnf !: information about the temperatures of runoff file to be read TYPE(FLD_N) :: sn_dep_rnf !: information about the depth which river inflow affects 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] LOGICAL , PUBLIC :: ln_rnf_att = .false. !: river runoffs attributes (temp, sal & depth) are specified in a file REAL(wp) , PUBLIC :: rn_rfact = 1.e0 !: multiplicative factor for runoff 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 river runoff (file information, fields read) TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_sal_rnf !: structure of input river runoff salinity (file information, fields read) TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_tmp_rnf !: structure of input river runoff temperature (file information, fields read) REAL, PUBLIC, DIMENSION(jpi,jpj) :: rnf_dep !: depth of runoff in m INTEGER, PUBLIC, DIMENSION(jpi,jpj) :: rnf_mod_dep !: depth of runoff in model levels REAL, PUBLIC, DIMENSION(jpi,jpj) :: rnf_sal !: salinity of river runoff REAL, PUBLIC, DIMENSION(jpi,jpj) :: rnf_tmp !: temperature of river runoff INTEGER :: ji, jj ,jk ! dummy loop indices INTEGER :: inum ! temporary logical unit !! * Substitutions # include "domzgr_substitute.h90" !!---------------------------------------------------------------------- !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) !! $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 CALL sbc_rnf_init ! Read namelist and allocate structures 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 IF ( ln_rnf_att ) THEN CALL fld_read ( kt, nn_fsbc, sf_sal_rnf ) CALL fld_read ( kt, nn_fsbc, sf_tmp_rnf ) ENDIF ! 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 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:) ) IF ( ln_rnf_att ) THEN rnf_sal(:,:) = ( sf_sal_rnf(1)%fnow(:,:) ) rnf_tmp(:,:) = ( sf_tmp_rnf(1)%fnow(:,:) ) ELSE rnf_sal(:,:) = 0 rnf_tmp(:,:) = -999 ENDIF CALL iom_put( "runoffs", rnf ) ! runoffs ENDIF ! ENDIF ! END SUBROUTINE sbc_rnf SUBROUTINE sbc_rnf_init !!---------------------------------------------------------------------- !! *** ROUTINE sbc_rnf_init *** !! !! ** Purpose : Initialisation of the runoffs if (ln_rnf=T) !! !! ** Method : - read the runoff namsbc_rnf namelist !! !! ** Action : - read parameters !!---------------------------------------------------------------------- CHARACTER(len=32) :: rn_dep_file ! runoff file name !! NAMELIST/namsbc_rnf/ cn_dir, ln_rnf_emp, sn_rnf, sn_cnf, sn_sal_rnf, sn_tmp_rnf, sn_dep_rnf, & & ln_rnf_mouth, ln_rnf_att, rn_hrnf, rn_avt_rnf, rn_rfact !!---------------------------------------------------------------------- ! ! ============ ! ! 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' , '' , '' ) sn_sal_rnf = FLD_N( 'runoffs', 24. , 'rosaline' , .TRUE. , .true. , 'yearly' , '' , '' ) sn_tmp_rnf = FLD_N( 'runoffs', 24. , 'rotemper' , .TRUE. , .true. , 'yearly' , '' , '' ) sn_dep_rnf = FLD_N( 'runoffs', 0. , 'rodepth' , .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 WRITE(numout,*) ' multiplicative factor for runoff rn_rfact = ', rn_rfact 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' IF ( ln_rnf_att ) THEN CALL ctl_warn( 'runoffs already included in precipitations & so runoff attributes will not be used' ) ln_rnf_att = .FALSE. ENDIF ! ELSE ! runoffs read in a file : set sf_rnf structure ! ! Allocate sf_rnf structure and (if required) sf_sal_rnf and sf_tmp_rnf structures 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) ) IF( ln_rnf_att ) THEN ALLOCATE( sf_sal_rnf(1), STAT=ierror ) IF( ierror > 0 ) THEN CALL ctl_stop( 'sbc_sal_rnf: unable to allocate sf_sal_rnf structure' ) ; RETURN ENDIF ALLOCATE( sf_sal_rnf(1)%fnow(jpi,jpj) ) ALLOCATE( sf_sal_rnf(1)%fdta(jpi,jpj,2) ) ALLOCATE( sf_tmp_rnf(1), STAT=ierror ) IF( ierror > 0 ) THEN CALL ctl_stop( 'sbc_tmp_rnf: unable to allocate sf_tmp_rnf structure' ) ; RETURN ENDIF ALLOCATE( sf_tmp_rnf(1)%fnow(jpi,jpj) ) ALLOCATE( sf_tmp_rnf(1)%fdta(jpi,jpj,2) ) ENDIF ! 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' ) IF ( ln_rnf_att ) THEN CALL fld_fill (sf_sal_rnf, (/ sn_sal_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff salinity data', 'namsbc_rnf' ) CALL fld_fill (sf_tmp_rnf, (/ sn_tmp_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff temperature data', 'namsbc_rnf' ) rn_dep_file = TRIM( cn_dir )//TRIM( sn_dep_rnf%clname ) CALL iom_open ( rn_dep_file, inum ) ! open file CALL iom_get ( inum, jpdom_data, sn_dep_rnf%clvar, rnf_dep ) ! read the river mouth array CALL iom_close( inum ) ! close file rnf_mod_dep(:,:)=0 DO jj=1,jpj DO ji=1,jpi IF ( rnf_dep(ji,jj) > 0.e0 ) THEN jk=2 DO WHILE ( jk/=(mbathy(ji,jj)-1) .AND. fsdept(ji,jj,jk) < rnf_dep(ji,jj) ); jk=jk+1; ENDDO rnf_mod_dep(ji,jj)=jk ELSE IF ( rnf_dep(ji,jj) .eq. -1 ) THEN rnf_mod_dep(ji,jj)=1 ELSE IF ( rnf_dep(ji,jj) .eq. -999 ) THEN rnf_mod_dep(ji,jj)=mbathy(ji,jj)-1 ELSE IF ( rnf_dep(ji,jj) /= 0 ) THEN CALL ctl_stop( 'runoff depth not positive, and not -999 or -1, rnf value in file fort.999' ) WRITE(999,*) 'ji, jj, rnf(ji,jj) :', ji, jj, rnf(ji,jj) ENDIF ENDDO ENDDO ELSE rnf_mod_dep(:,:)=1 ENDIF ! 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 IF ( ln_rnf_att ) & & CALL ctl_warn( 'increased mixing turned on but effects may already be spread through depth by ln_rnf_att' ) 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 : clo_rnf ! 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