Context Navigation

← Previous Revision
Next Revision →
Blame
Revision Log

sbcrnf.F90

Last change on this file 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

Line
1	MODULE sbcrnf
2	!!======================================================================
3	!! * MODULE sbcrnf *
4	!! Ocean forcing: river runoff
5	!!=====================================================================
6	!! History : OPA ! 2000-11 (R. Hordoir, E. Durand) NetCDF FORMAT
7	!! NEMO 1.0 ! 2002-09 (G. Madec) F90: Free form and module
8	!! 3.0 ! 2006-07 (G. Madec) Surface module
9	!! 3.2 ! 2009-04 (B. Lemaire) Introduce iom_put
10	!! 3.3 ! 2010-10 (R. Furner, G. Madec) runoff distributed over ocean levels
11	!!----------------------------------------------------------------------
12
13	!!----------------------------------------------------------------------
14	!! sbc_rnf : monthly runoffs read in a NetCDF file
15	!! sbc_rnf_init : runoffs initialisation
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
21	USE sbcisf ! PM we could remove it I think
22	USE closea ! closed seas
23	USE fldread ! read input field at current time step
24	USE in_out_manager ! I/O manager
25	USE iom ! I/O module
26	USE lib_mpp ! MPP library
27	USE eosbn2
28	USE wrk_nemo ! Memory allocation
29	USE timing
30
31	IMPLICIT NONE
32	PRIVATE
33
34	PUBLIC sbc_rnf ! routine call in sbcmod module
35	PUBLIC sbc_rnf_div ! routine called in divcurl module
36	PUBLIC sbc_rnf_alloc ! routine call in sbcmod module
37	PUBLIC sbc_rnf_init ! (PUBLIC for TAM)
38	! !!* namsbc_rnf namelist *
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
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)
45	LOGICAL :: ln_rnf_tem !: temperature river runoffs attribute specified in a file
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
48	TYPE(FLD_N) :: sn_cnf !: information about the runoff mouth file to be read
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
53	REAL(wp) :: rn_hrnf !: runoffs, depth over which enhanced vertical mixing is used
54	REAL(wp) , PUBLIC :: rn_avt_rnf !: runoffs, value of the additional vertical mixing coef. [m2/s]
55	REAL(wp) , PUBLIC :: rn_rfact !: multiplicative factor for runoff
56
57	LOGICAL , PUBLIC :: l_rnfcpl = .false. ! runoffs recieved from oasis
58
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
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]
65
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)
69
70	!! * Substitutions
71	# include "domzgr_substitute.h90"
72	!!----------------------------------------------------------------------
73	!! NEMO/OPA 3.3 , NEMO Consortium (2010)
74	!! $Id$
75	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
76	!!----------------------------------------------------------------------
77	CONTAINS
78
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
91
92	SUBROUTINE sbc_rnf( kt )
93	!!----------------------------------------------------------------------
94	!! * ROUTINE sbc_rnf *
95	!!
96	!! ** Purpose : Introduce a climatological run off forcing
97	!!
98	!! ** Method : Set each river mouth with a monthly climatology
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
105	!
106	INTEGER :: ji, jj ! dummy loop indices
107	INTEGER :: z_err = 0 ! dummy integer for error handling
108	!!----------------------------------------------------------------------
109	REAL(wp), DIMENSION(:,:), POINTER :: ztfrz ! freezing point used for temperature correction
110	!
111	CALL wrk_alloc( jpi,jpj, ztfrz)
112	!
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
122	!
123	IF( .NOT. l_rnfcpl ) rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) ) ! updated runoff value at time step kt
124	CALL lbc_lnk(rnf(:,:), 'T', 1._wp)
125	!
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
131	END WHERE
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
138	ENDIF
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
143	ENDIF
144	!
145	! ! ---------------------------------------- !
146	IF( kt == nit000 ) THEN ! set the forcing field at nit000 - 1 !
147	! ! ---------------------------------------- !
148	IF( ln_rstart .AND. & !* Restart: read in restart file
149	& iom_varid( numror, 'rnf_b', ldstop = .FALSE. ) > 0 ) THEN
150	IF(lwp .AND. nprint > 0) WRITE(numout,*) ' nit000-1 runoff forcing fields red in the restart file'
151	IF(nn_timing == 2) CALL timing_start('iom_rstget')
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
155	IF(nn_timing == 2) CALL timing_stop('iom_rstget')
156	ELSE !* no restart: set from nit000 values
157	IF(lwp) WRITE(numout,*) ' nit000-1 runoff forcing fields set to nit000'
158	rnf_b (:,: ) = rnf (:,: )
159	rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:)
160	ENDIF
161
162	IF(lwp .AND. lflush) CALL flush(numout)
163
164	ENDIF
165	! ! ---------------------------------------- !
166	IF( lrst_oce ) THEN ! Write in the ocean restart file !
167	! ! ---------------------------------------- !
168	IF(lwp .AND. nprint > 0) THEN
169	WRITE(numout,*)
170	WRITE(numout,*) 'sbcrnf : runoff forcing fields written in ocean restart file ', &
171	& 'at it= ', kt,' date= ', ndastp
172	WRITE(numout,*) '~~~~'
173	IF(lflush) CALL flush(numout)
174	ENDIF
175	IF(nn_timing == 2) CALL timing_start('iom_rstput')
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) )
179	IF(nn_timing == 2) CALL timing_stop('iom_rstput')
180	ENDIF
181	!
182	CALL wrk_dealloc( jpi,jpj, ztfrz)
183	!
184	END SUBROUTINE sbc_rnf
185
186
187	SUBROUTINE sbc_rnf_div( phdivn )
188	!!----------------------------------------------------------------------
189	!! * ROUTINE sbc_rnf *
190	!!
191	!! ** Purpose : update the horizontal divergence with the runoff inflow
192	!!
193	!! ** Method :
194	!! CAUTION : rnf is positive (inflow) decreasing the
195	!! divergence and expressed in m/s
196	!!
197	!! ** Action : phdivn decreased by the runoff inflow
198	!!----------------------------------------------------------------------
199	REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: phdivn ! horizontal divergence
200	!!
201	INTEGER :: ji, jj, jk ! dummy loop indices
202	REAL(wp) :: zfact ! local scalar
203	!!----------------------------------------------------------------------
204	!
205	zfact = 0.5_wp
206	!
207	IF( ln_rnf_depth .OR. ln_rnf_depth_ini ) THEN !== runoff distributed over several levels ==!
208	IF( lk_vvl ) THEN ! variable volume case
209	DO jj = 1, jpj ! update the depth over which runoffs are distributed
210	DO ji = 1, jpi
211	h_rnf(ji,jj) = 0._wp
212	DO jk = 1, nk_rnf(ji,jj) ! recalculates h_rnf to be the depth in metres
213	h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk) ! to the bottom of the relevant grid box
214	END DO
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
222	DO jj = 1, jpj
223	DO ji = 1, jpi
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
227	END DO
228	END DO
229	ENDIF
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
233	ENDIF
234	phdivn(:,:,1) = phdivn(:,:,1) - ( rnf(:,:) + rnf_b(:,:) ) * zfact * r1_rau0 / fse3t(:,:,1)
235	ENDIF
236	!
237	END SUBROUTINE sbc_rnf_div
238
239
240	SUBROUTINE sbc_rnf_init
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	!!----------------------------------------------------------------------
250	CHARACTER(len=32) :: rn_dep_file ! runoff file name
251	INTEGER :: ji, jj, jk, jm ! dummy loop indices
252	INTEGER :: ierror, inum ! temporary integer
253	INTEGER :: ios ! Local integer output status for namelist read
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
259	!
260	NAMELIST/namsbc_rnf/ cn_dir , ln_rnf_depth, ln_rnf_tem, ln_rnf_sal, &
261	& sn_rnf, sn_cnf , sn_s_rnf , sn_t_rnf , sn_dep_rnf, &
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
264	!!----------------------------------------------------------------------
265	!
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	!
279	! ! ============
280	! ! Namelist
281	! ! ============
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 )
286
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 )
290	IF(lwm .AND. nprint > 2) WRITE ( numond, namsbc_rnf )
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
301	WRITE(numout,*) ' multiplicative factor for runoff rn_rfact = ', rn_rfact
302	IF(lflush) CALL flush(numout)
303	ENDIF
304	! ! ==================
305	! ! Type of runoff
306	! ! ==================
307	!
308	IF( .NOT. l_rnfcpl ) THEN
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'
312	IF(lwp .AND. lflush) CALL flush(numout)
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) )
318	CALL fld_fill( sf_rnf, (/ sn_rnf /), cn_dir, 'sbc_rnf_init', 'read runoffs data', 'namsbc_rnf' )
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'
324	IF(lwp .AND. lflush) CALL flush(numout)
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
328	ENDIF
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'
337	IF(lwp .AND. lflush) CALL flush(numout)
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
341	ENDIF
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'
350	IF(lwp .AND. lflush) CALL flush(numout)
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
358	!
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
373	END DO
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)
380	END DO
381	END DO
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
391	IF(lwp .AND. lflush) CALL flush(numout)
392
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
415	END DO
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
429	END DO
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)
439	END DO
440	END DO
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'
445	IF(lwp .AND. lflush) CALL flush(numout)
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 )
449	ENDIF
450	ELSE ! runoffs applied at the surface
451	nk_rnf(:,:) = 1
452	h_rnf (:,:) = fse3t(:,:,1)
453	ENDIF
454	!
455	rnf(:,:) = 0._wp ! runoff initialisation
456	rnf_tsc(:,:,:) = 0._wp ! runoffs temperature & salinty contents initilisation
457	!
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	!
467	IF ( ln_rnf_depth ) CALL ctl_warn( 'sbc_rnf_init: increased mixing turned on but effects may already', &
468	& 'be spread through depth by ln_rnf_depth' )
469	!
470	nkrnf = 0 ! Number of level over which Kz increase
471	IF( rn_hrnf > 0._wp ) THEN
472	nkrnf = 2
473	DO WHILE( nkrnf /= jpkm1 .AND. gdepw_1d(nkrnf+1) < rn_hrnf ) ; nkrnf = nkrnf + 1
474	END DO
475	IF( ln_sco ) CALL ctl_warn( 'sbc_rnf: number of levels over which Kz is increased is computed for zco...' )
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)'
483	IF(lwp .AND. lflush) CALL flush(numout)
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'
490	IF(lwp .AND. lflush) CALL flush(numout)
491	rnfmsk (:,:) = 0._wp
492	rnfmsk_z(:) = 0._wp
493	nkrnf = 0
494	ENDIF
495	!
496	END SUBROUTINE sbc_rnf_init
497
498
499	SUBROUTINE rnf_mouth
500	!!----------------------------------------------------------------------
501	!! * ROUTINE rnf_mouth *
502	!!
503	!! ** Purpose : define the river mouths mask
504	!!
505	!! ** Method : read the river mouth mask (=0/1) in the river runoff
506	!! climatological file. Defined a given vertical structure.
507	!! CAUTION, the vertical structure is hard coded on the
508	!! first 5 levels.
509	!! This fields can be used to:
510	!! - set an upstream advection scheme
511	!! (ln_rnf_mouth=T and ln_traadv_cen2=T)
512	!! - increase vertical on the top nn_krnf vertical levels
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	!!----------------------------------------------------------------------
519	INTEGER :: inum ! temporary integers
520	CHARACTER(len=140) :: cl_rnfile ! runoff file name
521	!!----------------------------------------------------------------------
522	!
523	IF(lwp) WRITE(numout,*)
524	IF(lwp) WRITE(numout,*) 'rnf_mouth : river mouth mask'
525	IF(lwp) WRITE(numout,*) '~~~~~~~~~ '
526	IF(lwp .AND. lflush) CALL flush(numout)
527	!
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
532	!
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
537	!
538	IF( nn_closea == 1 ) CALL clo_rnf( rnfmsk ) ! closed sea inflow set as ruver mouth
539	!
540	rnfmsk_z(:) = 0._wp ! vertical structure
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
546	!
547	END SUBROUTINE rnf_mouth
548
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

Download in other formats: