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

Last change on this file since 11101 was 11101, checked in by frrh, 18 months 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 
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 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   !!----------------------------------------------------------------------
77CONTAINS
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)
285901   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 )
289902   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   !!======================================================================
550END MODULE sbcrnf
Note: See TracBrowser for help on using the repository browser.