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

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
sbcrnf.F90 in branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/SBC – NEMO

source: branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90 @ 8865

Last change on this file since 8865 was 8865, checked in by deazer, 6 years ago

Moving Changes from CS15mini config into NEMO main src
Updating TEST configs to run wit this version of the code
all sette tests pass at this revision other than AGRIF
Includes updates to dynnxt and tranxt required for 3D rives in WAD case to be conservative.

Next commit will update naming conventions and tidy the code.

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