Context Navigation

sbcrnf.F90 @ 11101

Last change on this file since 11101 was 11101, checked in by frrh, 5 years ago

Merge changes from Met Office GMED ticket 450 to reduce unnecessary
text output from NEMO.
This output, which is typically not switchable, is rarely of interest
in normal (non-debugging) runs and simply redunantley consumes extra
file space.
Further, the presence of this text output has been shown to
significantly degrade performance of models which are run during
Met Office HPC RAID (disk) checks.
The new code introduces switches which are configurable via the
changes made in the associated Met Office MOCI ticket 399.

File size: 29.9 KB

Rev	Line
[888]	1	MODULE sbcrnf
	2	!!======================================================================
	3	!! * MODULE sbcrnf *
	4	!! Ocean forcing: river runoff
	5	!!=====================================================================
[2528]	6	!! History : OPA ! 2000-11 (R. Hordoir, E. Durand) NetCDF FORMAT
	7	!! NEMO 1.0 ! 2002-09 (G. Madec) F90: Free form and module
[3764]	8	!! 3.0 ! 2006-07 (G. Madec) Surface module
[2528]	9	!! 3.2 ! 2009-04 (B. Lemaire) Introduce iom_put
	10	!! 3.3 ! 2010-10 (R. Furner, G. Madec) runoff distributed over ocean levels
[888]	11	!!----------------------------------------------------------------------
	12
	13	!!----------------------------------------------------------------------
	14	!! sbc_rnf : monthly runoffs read in a NetCDF file
[1116]	15	!! sbc_rnf_init : runoffs initialisation
[888]	16	!! rnf_mouth : set river mouth mask
	17	!!----------------------------------------------------------------------
	18	USE dom_oce ! ocean space and time domain
	19	USE phycst ! physical constants
	20	USE sbc_oce ! surface boundary condition variables
[4990]	21	USE sbcisf ! PM we could remove it I think
[2715]	22	USE closea ! closed seas
[2528]	23	USE fldread ! read input field at current time step
[888]	24	USE in_out_manager ! I/O manager
	25	USE iom ! I/O module
[2715]	26	USE lib_mpp ! MPP library
[4990]	27	USE eosbn2
	28	USE wrk_nemo ! Memory allocation
[9321]	29	USE timing
[888]	30
	31	IMPLICIT NONE
	32	PRIVATE
	33
[2528]	34	PUBLIC sbc_rnf ! routine call in sbcmod module
[5407]	35	PUBLIC sbc_rnf_div ! routine called in divcurl module
[2715]	36	PUBLIC sbc_rnf_alloc ! routine call in sbcmod module
[3764]	37	PUBLIC sbc_rnf_init ! (PUBLIC for TAM)
[2715]	38	! !!* namsbc_rnf namelist *
[5431]	39	CHARACTER(len=100) :: cn_dir !: Root directory for location of rnf files
	40	LOGICAL :: ln_rnf_depth !: depth river runoffs attribute specified in a file
[5385]	41	LOGICAL :: ln_rnf_depth_ini !: depth river runoffs computed at the initialisation
	42	REAL(wp) :: rn_rnf_max !: maximum value of the runoff climatologie ( ln_rnf_depth_ini = .true )
	43	REAL(wp) :: rn_dep_max !: depth over which runoffs is spread ( ln_rnf_depth_ini = .true )
	44	INTEGER :: nn_rnf_depth_file !: create (=1) a runoff depth file or not (=0)
[5431]	45	LOGICAL :: ln_rnf_tem !: temperature river runoffs attribute specified in a file
[4147]	46	LOGICAL , PUBLIC :: ln_rnf_sal !: salinity river runoffs attribute specified in a file
	47	TYPE(FLD_N) , PUBLIC :: sn_rnf !: information about the runoff file to be read
[5431]	48	TYPE(FLD_N) :: sn_cnf !: information about the runoff mouth file to be read
[4147]	49	TYPE(FLD_N) :: sn_s_rnf !: information about the salinities of runoff file to be read
	50	TYPE(FLD_N) :: sn_t_rnf !: information about the temperatures of runoff file to be read
	51	TYPE(FLD_N) :: sn_dep_rnf !: information about the depth which river inflow affects
	52	LOGICAL , PUBLIC :: ln_rnf_mouth !: specific treatment in mouths vicinity
[5431]	53	REAL(wp) :: rn_hrnf !: runoffs, depth over which enhanced vertical mixing is used
[4147]	54	REAL(wp) , PUBLIC :: rn_avt_rnf !: runoffs, value of the additional vertical mixing coef. [m2/s]
[6498]	55	REAL(wp) , PUBLIC :: rn_rfact !: multiplicative factor for runoff
[888]	56
[5407]	57	LOGICAL , PUBLIC :: l_rnfcpl = .false. ! runoffs recieved from oasis
	58
[2715]	59	INTEGER , PUBLIC :: nkrnf = 0 !: nb of levels over which Kz is increased at river mouths
	60	REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rnfmsk !: river mouth mask (hori.)
	61	REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: rnfmsk_z !: river mouth mask (vert.)
	62	REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: h_rnf !: depth of runoff in m
	63	INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: nk_rnf !: depth of runoff in model levels
[3764]	64	REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: rnf_tsc_b, rnf_tsc !: before and now T & S runoff contents [K.m/s & PSU.m/s]
[888]	65
[5431]	66	TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_rnf ! structure: river runoff (file information, fields read)
	67	TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_s_rnf ! structure: river runoff salinity (file information, fields read)
	68	TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_t_rnf ! structure: river runoff temperature (file information, fields read)
[2528]	69
	70	!! * Substitutions
	71	# include "domzgr_substitute.h90"
[888]	72	!!----------------------------------------------------------------------
[2528]	73	!! NEMO/OPA 3.3 , NEMO Consortium (2010)
[1146]	74	!! $Id$
[2528]	75	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[888]	76	!!----------------------------------------------------------------------
	77	CONTAINS
	78
[2715]	79	INTEGER FUNCTION sbc_rnf_alloc()
	80	!!----------------------------------------------------------------------
	81	!! * ROUTINE sbc_rnf_alloc *
	82	!!----------------------------------------------------------------------
	83	ALLOCATE( rnfmsk(jpi,jpj) , rnfmsk_z(jpk) , &
	84	& h_rnf (jpi,jpj) , nk_rnf (jpi,jpj) , &
	85	& rnf_tsc_b(jpi,jpj,jpts) , rnf_tsc (jpi,jpj,jpts) , STAT=sbc_rnf_alloc )
	86	!
	87	IF( lk_mpp ) CALL mpp_sum ( sbc_rnf_alloc )
	88	IF( sbc_rnf_alloc > 0 ) CALL ctl_warn('sbc_rnf_alloc: allocation of arrays failed')
	89	END FUNCTION sbc_rnf_alloc
	90
[3625]	91
[888]	92	SUBROUTINE sbc_rnf( kt )
	93	!!----------------------------------------------------------------------
	94	!! * ROUTINE sbc_rnf *
[3764]	95	!!
[888]	96	!! ** Purpose : Introduce a climatological run off forcing
	97	!!
[3764]	98	!! ** Method : Set each river mouth with a monthly climatology
[888]	99	!! provided from different data.
	100	!! CAUTION : upward water flux, runoff forced to be < 0
	101	!!
	102	!! ** Action : runoff updated runoff field at time-step kt
	103	!!----------------------------------------------------------------------
	104	INTEGER, INTENT(in) :: kt ! ocean time step
[3625]	105	!
[3832]	106	INTEGER :: ji, jj ! dummy loop indices
	107	INTEGER :: z_err = 0 ! dummy integer for error handling
[888]	108	!!----------------------------------------------------------------------
[4990]	109	REAL(wp), DIMENSION(:,:), POINTER :: ztfrz ! freezing point used for temperature correction
[3764]	110	!
[4990]	111	CALL wrk_alloc( jpi,jpj, ztfrz)
[7993]	112	!
[5407]	113	! !-------------------!
	114	! ! Update runoff !
	115	! !-------------------!
	116	!
	117	IF( .NOT. l_rnfcpl ) CALL fld_read ( kt, nn_fsbc, sf_rnf ) ! Read Runoffs data and provide it at kt
	118	IF( ln_rnf_tem ) CALL fld_read ( kt, nn_fsbc, sf_t_rnf ) ! idem for runoffs temperature if required
	119	IF( ln_rnf_sal ) CALL fld_read ( kt, nn_fsbc, sf_s_rnf ) ! idem for runoffs salinity if required
	120	!
	121	IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN
[888]	122	!
[5407]	123	IF( .NOT. l_rnfcpl ) rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) ) ! updated runoff value at time step kt
[8302]	124	CALL lbc_lnk(rnf(:,:), 'T', 1._wp)
[2528]	125	!
[5407]	126	! ! set temperature & salinity content of runoffs
	127	IF( ln_rnf_tem ) THEN ! use runoffs temperature data
	128	rnf_tsc(:,:,jp_tem) = ( sf_t_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0
	129	WHERE( sf_t_rnf(1)%fnow(:,:,1) == -999._wp ) ! if missing data value use SST as runoffs temperature
	130	rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0
[2528]	131	END WHERE
[5407]	132	WHERE( sf_t_rnf(1)%fnow(:,:,1) == -222._wp ) ! where fwf comes from melting of ice shelves or iceberg
	133	ztfrz(:,:) = -1.9 !tfreez( sss_m(:,:) ) !PM to be discuss (trouble if sensitivity study)
	134	rnf_tsc(:,:,jp_tem) = ztfrz(:,:) * rnf(:,:) * r1_rau0 - rnf(:,:) * lfusisf * r1_rau0_rcp
	135	END WHERE
	136	ELSE ! use SST as runoffs temperature
	137	rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0
[2528]	138	ENDIF
[5407]	139	! ! use runoffs salinity data
	140	IF( ln_rnf_sal ) rnf_tsc(:,:,jp_sal) = ( sf_s_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0
	141	! ! else use S=0 for runoffs (done one for all in the init)
	142	CALL iom_put( "runoffs", rnf ) ! output runoffs arrays
[2528]	143	ENDIF
	144	!
[5407]	145	! ! ---------------------------------------- !
[2528]	146	IF( kt == nit000 ) THEN ! set the forcing field at nit000 - 1 !
	147	! ! ---------------------------------------- !
	148	IF( ln_rstart .AND. & !* Restart: read in restart file
[3764]	149	& iom_varid( numror, 'rnf_b', ldstop = .FALSE. ) > 0 ) THEN
[11101]	150	IF(lwp .AND. nprint > 0) WRITE(numout,*) ' nit000-1 runoff forcing fields red in the restart file'
[9321]	151	IF(nn_timing == 2) CALL timing_start('iom_rstget')
[2528]	152	CALL iom_get( numror, jpdom_autoglo, 'rnf_b', rnf_b ) ! before runoff
	153	CALL iom_get( numror, jpdom_autoglo, 'rnf_hc_b', rnf_tsc_b(:,:,jp_tem) ) ! before heat content of runoff
	154	CALL iom_get( numror, jpdom_autoglo, 'rnf_sc_b', rnf_tsc_b(:,:,jp_sal) ) ! before salinity content of runoff
[9321]	155	IF(nn_timing == 2) CALL timing_stop('iom_rstget')
[2528]	156	ELSE !* no restart: set from nit000 values
	157	IF(lwp) WRITE(numout,*) ' nit000-1 runoff forcing fields set to nit000'
[5407]	158	rnf_b (:,: ) = rnf (:,: )
	159	rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:)
[2528]	160	ENDIF
[11101]	161
	162	IF(lwp .AND. lflush) CALL flush(numout)
	163
[2528]	164	ENDIF
	165	! ! ---------------------------------------- !
	166	IF( lrst_oce ) THEN ! Write in the ocean restart file !
	167	! ! ---------------------------------------- !
[11101]	168	IF(lwp .AND. nprint > 0) THEN
	169	WRITE(numout,*)
	170	WRITE(numout,*) 'sbcrnf : runoff forcing fields written in ocean restart file ', &
[2528]	171	& 'at it= ', kt,' date= ', ndastp
[11101]	172	WRITE(numout,*) '~~~~'
	173	IF(lflush) CALL flush(numout)
	174	ENDIF
[9321]	175	IF(nn_timing == 2) CALL timing_start('iom_rstput')
[2528]	176	CALL iom_rstput( kt, nitrst, numrow, 'rnf_b' , rnf )
	177	CALL iom_rstput( kt, nitrst, numrow, 'rnf_hc_b', rnf_tsc(:,:,jp_tem) )
	178	CALL iom_rstput( kt, nitrst, numrow, 'rnf_sc_b', rnf_tsc(:,:,jp_sal) )
[9321]	179	IF(nn_timing == 2) CALL timing_stop('iom_rstput')
[2528]	180	ENDIF
[5407]	181	!
[4990]	182	CALL wrk_dealloc( jpi,jpj, ztfrz)
[2528]	183	!
	184	END SUBROUTINE sbc_rnf
	185
	186
	187	SUBROUTINE sbc_rnf_div( phdivn )
	188	!!----------------------------------------------------------------------
	189	!! * ROUTINE sbc_rnf *
[3764]	190	!!
[2528]	191	!! ** Purpose : update the horizontal divergence with the runoff inflow
	192	!!
[3764]	193	!! ** Method :
	194	!! CAUTION : rnf is positive (inflow) decreasing the
[2528]	195	!! divergence and expressed in m/s
	196	!!
	197	!! ** Action : phdivn decreased by the runoff inflow
	198	!!----------------------------------------------------------------------
[2715]	199	REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: phdivn ! horizontal divergence
[2528]	200	!!
	201	INTEGER :: ji, jj, jk ! dummy loop indices
	202	REAL(wp) :: zfact ! local scalar
	203	!!----------------------------------------------------------------------
	204	!
	205	zfact = 0.5_wp
	206	!
[5503]	207	IF( ln_rnf_depth .OR. ln_rnf_depth_ini ) THEN !== runoff distributed over several levels ==!
[3764]	208	IF( lk_vvl ) THEN ! variable volume case
[2528]	209	DO jj = 1, jpj ! update the depth over which runoffs are distributed
	210	DO ji = 1, jpi
[3764]	211	h_rnf(ji,jj) = 0._wp
[2528]	212	DO jk = 1, nk_rnf(ji,jj) ! recalculates h_rnf to be the depth in metres
[3764]	213	h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk) ! to the bottom of the relevant grid box
	214	END DO
[2528]	215	! ! apply the runoff input flow
	216	DO jk = 1, nk_rnf(ji,jj)
	217	phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rau0 / h_rnf(ji,jj)
	218	END DO
	219	END DO
	220	END DO
	221	ELSE ! constant volume case : just apply the runoff input flow
[888]	222	DO jj = 1, jpj
	223	DO ji = 1, jpi
[2528]	224	DO jk = 1, nk_rnf(ji,jj)
	225	phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rau0 / h_rnf(ji,jj)
	226	END DO
[888]	227	END DO
	228	END DO
	229	ENDIF
[2528]	230	ELSE !== runoff put only at the surface ==!
	231	IF( lk_vvl ) THEN ! variable volume case
	232	h_rnf(:,:) = fse3t(:,:,1) ! recalculate h_rnf to be depth of top box
[1303]	233	ENDIF
[2528]	234	phdivn(:,:,1) = phdivn(:,:,1) - ( rnf(:,:) + rnf_b(:,:) ) * zfact * r1_rau0 / fse3t(:,:,1)
[888]	235	ENDIF
	236	!
[2528]	237	END SUBROUTINE sbc_rnf_div
[888]	238
	239
[2528]	240	SUBROUTINE sbc_rnf_init
[1116]	241	!!----------------------------------------------------------------------
	242	!! * ROUTINE sbc_rnf_init *
	243	!!
	244	!! ** Purpose : Initialisation of the runoffs if (ln_rnf=T)
	245	!!
	246	!! ** Method : - read the runoff namsbc_rnf namelist
	247	!!
	248	!! ** Action : - read parameters
	249	!!----------------------------------------------------------------------
[3764]	250	CHARACTER(len=32) :: rn_dep_file ! runoff file name
[5385]	251	INTEGER :: ji, jj, jk, jm ! dummy loop indices
[2528]	252	INTEGER :: ierror, inum ! temporary integer
[4147]	253	INTEGER :: ios ! Local integer output status for namelist read
[5385]	254	INTEGER :: nbrec ! temporary integer
	255	REAL(wp) :: zacoef
	256	REAL(wp), DIMENSION(12) :: zrec ! times records
	257	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zrnfcl
	258	REAL(wp), DIMENSION(:,: ), ALLOCATABLE :: zrnf
[3625]	259	!
[5407]	260	NAMELIST/namsbc_rnf/ cn_dir , ln_rnf_depth, ln_rnf_tem, ln_rnf_sal, &
[3764]	261	& sn_rnf, sn_cnf , sn_s_rnf , sn_t_rnf , sn_dep_rnf, &
[5385]	262	& ln_rnf_mouth , rn_hrnf , rn_avt_rnf, rn_rfact, &
	263	& ln_rnf_depth_ini , rn_dep_max , rn_rnf_max, nn_rnf_depth_file
[1116]	264	!!----------------------------------------------------------------------
[3625]	265	!
[5431]	266	! !== allocate runoff arrays
	267	IF( sbc_rnf_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_rnf_alloc : unable to allocate arrays' )
	268	!
	269	IF( .NOT. ln_rnf ) THEN ! no specific treatment in vicinity of river mouths
	270	ln_rnf_mouth = .FALSE. ! default definition needed for example by sbc_ssr or by tra_adv_muscl
	271	nkrnf = 0
	272	rnf (:,:) = 0.0_wp
	273	rnf_b (:,:) = 0.0_wp
	274	rnfmsk (:,:) = 0.0_wp
	275	rnfmsk_z(:) = 0.0_wp
	276	RETURN
	277	ENDIF
	278	!
[1116]	279	! ! ============
	280	! ! Namelist
	281	! ! ============
[4147]	282	!
	283	REWIND( numnam_ref ) ! Namelist namsbc_rnf in reference namelist : Runoffs
	284	READ ( numnam_ref, namsbc_rnf, IOSTAT = ios, ERR = 901)
	285	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_rnf in reference namelist', lwp )
[1116]	286
[4147]	287	REWIND( numnam_cfg ) ! Namelist namsbc_rnf in configuration namelist : Runoffs
	288	READ ( numnam_cfg, namsbc_rnf, IOSTAT = ios, ERR = 902 )
	289	902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_rnf in configuration namelist', lwp )
[11101]	290	IF(lwm .AND. nprint > 2) WRITE ( numond, namsbc_rnf )
[1116]	291	!
	292	! ! Control print
	293	IF(lwp) THEN
	294	WRITE(numout,*)
	295	WRITE(numout,*) 'sbc_rnf : runoff '
	296	WRITE(numout,*) '~~~~~~~ '
	297	WRITE(numout,*) ' Namelist namsbc_rnf'
	298	WRITE(numout,*) ' specific river mouths treatment ln_rnf_mouth = ', ln_rnf_mouth
	299	WRITE(numout,*) ' river mouth additional Kz rn_avt_rnf = ', rn_avt_rnf
	300	WRITE(numout,*) ' depth of river mouth additional mixing rn_hrnf = ', rn_hrnf
[3764]	301	WRITE(numout,*) ' multiplicative factor for runoff rn_rfact = ', rn_rfact
[11101]	302	IF(lflush) CALL flush(numout)
[1116]	303	ENDIF
	304	! ! ==================
	305	! ! Type of runoff
	306	! ! ==================
	307	!
[5407]	308	IF( .NOT. l_rnfcpl ) THEN
[2528]	309	ALLOCATE( sf_rnf(1), STAT=ierror ) ! Create sf_rnf structure (runoff inflow)
	310	IF(lwp) WRITE(numout,*)
	311	IF(lwp) WRITE(numout,*) ' runoffs inflow read in a file'
[11101]	312	IF(lwp .AND. lflush) CALL flush(numout)
[2528]	313	IF( ierror > 0 ) THEN
	314	CALL ctl_stop( 'sbc_rnf: unable to allocate sf_rnf structure' ) ; RETURN
	315	ENDIF
	316	ALLOCATE( sf_rnf(1)%fnow(jpi,jpj,1) )
	317	IF( sn_rnf%ln_tint ) ALLOCATE( sf_rnf(1)%fdta(jpi,jpj,1,2) )
[1133]	318	CALL fld_fill( sf_rnf, (/ sn_rnf /), cn_dir, 'sbc_rnf_init', 'read runoffs data', 'namsbc_rnf' )
[5407]	319	ENDIF
	320	!
	321	IF( ln_rnf_tem ) THEN ! Create (if required) sf_t_rnf structure
	322	IF(lwp) WRITE(numout,*)
	323	IF(lwp) WRITE(numout,*) ' runoffs temperatures read in a file'
[11101]	324	IF(lwp .AND. lflush) CALL flush(numout)
[5407]	325	ALLOCATE( sf_t_rnf(1), STAT=ierror )
	326	IF( ierror > 0 ) THEN
	327	CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_t_rnf structure' ) ; RETURN
[2528]	328	ENDIF
[5407]	329	ALLOCATE( sf_t_rnf(1)%fnow(jpi,jpj,1) )
	330	IF( sn_t_rnf%ln_tint ) ALLOCATE( sf_t_rnf(1)%fdta(jpi,jpj,1,2) )
	331	CALL fld_fill (sf_t_rnf, (/ sn_t_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff temperature data', 'namsbc_rnf' )
	332	ENDIF
	333	!
	334	IF( ln_rnf_sal ) THEN ! Create (if required) sf_s_rnf and sf_t_rnf structures
	335	IF(lwp) WRITE(numout,*)
	336	IF(lwp) WRITE(numout,*) ' runoffs salinities read in a file'
[11101]	337	IF(lwp .AND. lflush) CALL flush(numout)
[5407]	338	ALLOCATE( sf_s_rnf(1), STAT=ierror )
	339	IF( ierror > 0 ) THEN
	340	CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_s_rnf structure' ) ; RETURN
[2528]	341	ENDIF
[5407]	342	ALLOCATE( sf_s_rnf(1)%fnow(jpi,jpj,1) )
	343	IF( sn_s_rnf%ln_tint ) ALLOCATE( sf_s_rnf(1)%fdta(jpi,jpj,1,2) )
	344	CALL fld_fill (sf_s_rnf, (/ sn_s_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff salinity data', 'namsbc_rnf' )
	345	ENDIF
	346	!
	347	IF( ln_rnf_depth ) THEN ! depth of runoffs set from a file
	348	IF(lwp) WRITE(numout,*)
	349	IF(lwp) WRITE(numout,*) ' runoffs depth read in a file'
[11101]	350	IF(lwp .AND. lflush) CALL flush(numout)
[5407]	351	rn_dep_file = TRIM( cn_dir )//TRIM( sn_dep_rnf%clname )
	352	IF( .NOT. sn_dep_rnf%ln_clim ) THEN ; WRITE(rn_dep_file, '(a,"_y",i4)' ) TRIM( rn_dep_file ), nyear ! add year
	353	IF( sn_dep_rnf%cltype == 'monthly' ) WRITE(rn_dep_file, '(a,"m",i2)' ) TRIM( rn_dep_file ), nmonth ! add month
	354	ENDIF
	355	CALL iom_open ( rn_dep_file, inum ) ! open file
	356	CALL iom_get ( inum, jpdom_data, sn_dep_rnf%clvar, h_rnf ) ! read the river mouth array
	357	CALL iom_close( inum ) ! close file
[2528]	358	!
[5407]	359	nk_rnf(:,:) = 0 ! set the number of level over which river runoffs are applied
	360	DO jj = 1, jpj
	361	DO ji = 1, jpi
	362	IF( h_rnf(ji,jj) > 0._wp ) THEN
	363	jk = 2
	364	DO WHILE ( jk /= mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ; jk = jk + 1
	365	END DO
	366	nk_rnf(ji,jj) = jk
	367	ELSEIF( h_rnf(ji,jj) == -1._wp ) THEN ; nk_rnf(ji,jj) = 1
	368	ELSEIF( h_rnf(ji,jj) == -999._wp ) THEN ; nk_rnf(ji,jj) = mbkt(ji,jj)
	369	ELSE
	370	CALL ctl_stop( 'sbc_rnf_init: runoff depth not positive, and not -999 or -1, rnf value in file fort.999' )
	371	WRITE(999,*) 'ji, jj, h_rnf(ji,jj) :', ji, jj, h_rnf(ji,jj)
	372	ENDIF
[3764]	373	END DO
[5407]	374	END DO
	375	DO jj = 1, jpj ! set the associated depth
	376	DO ji = 1, jpi
	377	h_rnf(ji,jj) = 0._wp
	378	DO jk = 1, nk_rnf(ji,jj)
	379	h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk)
[2528]	380	END DO
	381	END DO
[5407]	382	END DO
	383	!
	384	ELSE IF( ln_rnf_depth_ini ) THEN ! runoffs applied at the surface
	385	!
	386	IF(lwp) WRITE(numout,*)
	387	IF(lwp) WRITE(numout,*) ' depth of runoff computed once from max value of runoff'
	388	IF(lwp) WRITE(numout,*) ' max value of the runoff climatologie (over global domain) rn_rnf_max = ', rn_rnf_max
	389	IF(lwp) WRITE(numout,*) ' depth over which runoffs is spread rn_dep_max = ', rn_dep_max
	390	IF(lwp) WRITE(numout,*) ' create (=1) a runoff depth file or not (=0) nn_rnf_depth_file = ', nn_rnf_depth_file
[11101]	391	IF(lwp .AND. lflush) CALL flush(numout)
[5385]	392
[5407]	393	CALL iom_open( TRIM( sn_rnf%clname ), inum ) ! open runoff file
	394	CALL iom_gettime( inum, zrec, kntime=nbrec)
	395	ALLOCATE( zrnfcl(jpi,jpj,nbrec) ) ; ALLOCATE( zrnf(jpi,jpj) )
	396	DO jm = 1, nbrec
	397	CALL iom_get( inum, jpdom_data, TRIM( sn_rnf%clvar ), zrnfcl(:,:,jm), jm )
	398	END DO
	399	CALL iom_close( inum )
	400	zrnf(:,:) = MAXVAL( zrnfcl(:,:,:), DIM=3 ) ! maximum value in time
	401	DEALLOCATE( zrnfcl )
	402	!
	403	h_rnf(:,:) = 1.
	404	!
	405	zacoef = rn_dep_max / rn_rnf_max ! coef of linear relation between runoff and its depth (150m for max of runoff)
	406	!
	407	WHERE( zrnf(:,:) > 0._wp ) h_rnf(:,:) = zacoef * zrnf(:,:) ! compute depth for all runoffs
	408	!
	409	DO jj = 1, jpj ! take in account min depth of ocean rn_hmin
	410	DO ji = 1, jpi
	411	IF( zrnf(ji,jj) > 0._wp ) THEN
	412	jk = mbkt(ji,jj)
	413	h_rnf(ji,jj) = MIN( h_rnf(ji,jj), gdept_0(ji,jj,jk ) )
	414	ENDIF
[5385]	415	END DO
[5407]	416	END DO
	417	!
	418	nk_rnf(:,:) = 0 ! number of levels on which runoffs are distributed
	419	DO jj = 1, jpj
	420	DO ji = 1, jpi
	421	IF( zrnf(ji,jj) > 0._wp ) THEN
	422	jk = 2
	423	DO WHILE ( jk /= mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ; jk = jk + 1
	424	END DO
	425	nk_rnf(ji,jj) = jk
	426	ELSE
	427	nk_rnf(ji,jj) = 1
	428	ENDIF
[5385]	429	END DO
[5407]	430	END DO
	431	!
	432	DEALLOCATE( zrnf )
	433	!
	434	DO jj = 1, jpj ! set the associated depth
	435	DO ji = 1, jpi
	436	h_rnf(ji,jj) = 0._wp
	437	DO jk = 1, nk_rnf(ji,jj)
	438	h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk)
[5385]	439	END DO
	440	END DO
[5407]	441	END DO
	442	!
	443	IF( nn_rnf_depth_file == 1 ) THEN ! save output nb levels for runoff
	444	IF(lwp) WRITE(numout,*) ' create runoff depht file'
[11101]	445	IF(lwp .AND. lflush) CALL flush(numout)
[5407]	446	CALL iom_open ( TRIM( sn_dep_rnf%clname ), inum, ldwrt = .TRUE., kiolib = jprstlib )
	447	CALL iom_rstput( 0, 0, inum, 'rodepth', h_rnf )
	448	CALL iom_close ( inum )
[3764]	449	ENDIF
[5407]	450	ELSE ! runoffs applied at the surface
	451	nk_rnf(:,:) = 1
	452	h_rnf (:,:) = fse3t(:,:,1)
[1116]	453	ENDIF
[2528]	454	!
[3294]	455	rnf(:,:) = 0._wp ! runoff initialisation
[2528]	456	rnf_tsc(:,:,:) = 0._wp ! runoffs temperature & salinty contents initilisation
	457	!
[1116]	458	! ! ========================
	459	! ! River mouth vicinity
	460	! ! ========================
	461	!
	462	IF( ln_rnf_mouth ) THEN ! Specific treatment in vicinity of river mouths :
	463	! ! - Increase Kz in surface layers ( rn_hrnf > 0 )
	464	! ! - set to zero SSS damping (ln_ssr=T)
	465	! ! - mixed upstream-centered (ln_traadv_cen2=T)
	466	!
[2528]	467	IF ( ln_rnf_depth ) CALL ctl_warn( 'sbc_rnf_init: increased mixing turned on but effects may already', &
[3764]	468	& 'be spread through depth by ln_rnf_depth' )
[2528]	469	!
	470	nkrnf = 0 ! Number of level over which Kz increase
	471	IF( rn_hrnf > 0._wp ) THEN
[1116]	472	nkrnf = 2
[5407]	473	DO WHILE( nkrnf /= jpkm1 .AND. gdepw_1d(nkrnf+1) < rn_hrnf ) ; nkrnf = nkrnf + 1
	474	END DO
[3625]	475	IF( ln_sco ) CALL ctl_warn( 'sbc_rnf: number of levels over which Kz is increased is computed for zco...' )
[1116]	476	ENDIF
	477	IF(lwp) WRITE(numout,*)
	478	IF(lwp) WRITE(numout,*) ' Specific treatment used in vicinity of river mouths :'
	479	IF(lwp) WRITE(numout,*) ' - Increase Kz in surface layers (if rn_hrnf > 0 )'
	480	IF(lwp) WRITE(numout,*) ' by ', rn_avt_rnf,' m2/s over ', nkrnf, ' w-levels'
	481	IF(lwp) WRITE(numout,*) ' - set to zero SSS damping (if ln_ssr=T)'
	482	IF(lwp) WRITE(numout,*) ' - mixed upstream-centered (if ln_traadv_cen2=T)'
[11101]	483	IF(lwp .AND. lflush) CALL flush(numout)
[1116]	484	!
	485	CALL rnf_mouth ! set river mouth mask
	486	!
	487	ELSE ! No treatment at river mouths
	488	IF(lwp) WRITE(numout,*)
	489	IF(lwp) WRITE(numout,*) ' No specific treatment at river mouths'
[11101]	490	IF(lwp .AND. lflush) CALL flush(numout)
[3764]	491	rnfmsk (:,:) = 0._wp
[2528]	492	rnfmsk_z(:) = 0._wp
[1116]	493	nkrnf = 0
	494	ENDIF
[3625]	495	!
[1116]	496	END SUBROUTINE sbc_rnf_init
	497
	498
[888]	499	SUBROUTINE rnf_mouth
	500	!!----------------------------------------------------------------------
	501	!! * ROUTINE rnf_mouth *
[3764]	502	!!
[888]	503	!! ** Purpose : define the river mouths mask
	504	!!
	505	!! ** Method : read the river mouth mask (=0/1) in the river runoff
[3764]	506	!! climatological file. Defined a given vertical structure.
	507	!! CAUTION, the vertical structure is hard coded on the
[888]	508	!! first 5 levels.
	509	!! This fields can be used to:
[3764]	510	!! - set an upstream advection scheme
[1116]	511	!! (ln_rnf_mouth=T and ln_traadv_cen2=T)
[3764]	512	!! - increase vertical on the top nn_krnf vertical levels
[888]	513	!! at river runoff input grid point (nn_krnf>=2, see step.F90)
	514	!! - set to zero SSS restoring flux at river mouth grid points
	515	!!
	516	!! ** Action : rnfmsk set to 1 at river runoff input, 0 elsewhere
	517	!! rnfmsk_z vertical structure
	518	!!----------------------------------------------------------------------
[2784]	519	INTEGER :: inum ! temporary integers
	520	CHARACTER(len=140) :: cl_rnfile ! runoff file name
[888]	521	!!----------------------------------------------------------------------
[3764]	522	!
[888]	523	IF(lwp) WRITE(numout,*)
	524	IF(lwp) WRITE(numout,*) 'rnf_mouth : river mouth mask'
	525	IF(lwp) WRITE(numout,*) '~~~~~~~~~ '
[11101]	526	IF(lwp .AND. lflush) CALL flush(numout)
[3625]	527	!
[1133]	528	cl_rnfile = TRIM( cn_dir )//TRIM( sn_cnf%clname )
	529	IF( .NOT. sn_cnf%ln_clim ) THEN ; WRITE(cl_rnfile, '(a,"_y",i4)' ) TRIM( cl_rnfile ), nyear ! add year
	530	IF( sn_cnf%cltype == 'monthly' ) WRITE(cl_rnfile, '(a,"m",i2)' ) TRIM( cl_rnfile ), nmonth ! add month
	531	ENDIF
[3625]	532	!
[888]	533	! horizontal mask (read in NetCDF file)
	534	CALL iom_open ( cl_rnfile, inum ) ! open file
	535	CALL iom_get ( inum, jpdom_data, sn_cnf%clvar, rnfmsk ) ! read the river mouth array
	536	CALL iom_close( inum ) ! close file
[3625]	537	!
[3632]	538	IF( nn_closea == 1 ) CALL clo_rnf( rnfmsk ) ! closed sea inflow set as ruver mouth
[3625]	539	!
[3764]	540	rnfmsk_z(:) = 0._wp ! vertical structure
[888]	541	rnfmsk_z(1) = 1.0
	542	rnfmsk_z(2) = 1.0 ! **********
	543	rnfmsk_z(3) = 0.5 ! HARD CODED on the 5 first levels
	544	rnfmsk_z(4) = 0.25 ! **********
	545	rnfmsk_z(5) = 0.125
[3764]	546	!
[888]	547	END SUBROUTINE rnf_mouth
[3764]	548
[888]	549	!!======================================================================
	550	END MODULE sbcrnf

Note: See TracBrowser for help on using the repository browser.

New URL for NEMO forge! http://forge.nemo-ocean.eu

Context Navigation

source: branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90 @ 11101

Download in other formats: