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/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC – NEMO

source: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90 @ 3211

Last change on this file since 3211 was 3211, checked in by spickles2, 12 years ago

Stephen Pickles, 11 Dec 2011

Commit to bring the rest of the DCSE NEMO development branch
in line with the latest development version. This includes
array index re-ordering of all OPA_SRC/.

  • Property svn:keywords set to Id
File size: 27.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 closea          ! closed seas
22   USE fldread         ! read input field at current time step
23   USE restart         ! restart
24   USE in_out_manager  ! I/O manager
25   USE iom             ! I/O module
26   USE lib_mpp         ! MPP library
27
28   IMPLICIT NONE
29   PRIVATE
30
31   PUBLIC   sbc_rnf       ! routine call in sbcmod module
32   PUBLIC   sbc_rnf_div   ! routine called in sshwzv module
33   PUBLIC   sbc_rnf_alloc ! routine call in sbcmod module
34
35   !                                                     !!* namsbc_rnf namelist *
36   CHARACTER(len=100), PUBLIC ::   cn_dir       = './'    !: Root directory for location of ssr files
37   LOGICAL           , PUBLIC ::   ln_rnf_depth = .false. !: depth       river runoffs attribute specified in a file
38   LOGICAL           , PUBLIC ::   ln_rnf_tem   = .false. !: temperature river runoffs attribute specified in a file
39   LOGICAL           , PUBLIC ::   ln_rnf_sal   = .false. !: salinity    river runoffs attribute specified in a file
40   LOGICAL           , PUBLIC ::   ln_rnf_emp   = .false. !: runoffs into a file to be read or already into precipitation
41   TYPE(FLD_N)       , PUBLIC ::   sn_rnf                 !: information about the runoff file to be read
42   TYPE(FLD_N)       , PUBLIC ::   sn_cnf                 !: information about the runoff mouth file to be read
43   TYPE(FLD_N)                ::   sn_s_rnf               !: information about the salinities of runoff file to be read 
44   TYPE(FLD_N)                ::   sn_t_rnf               !: information about the temperatures of runoff file to be read 
45   TYPE(FLD_N)                ::   sn_dep_rnf             !: information about the depth which river inflow affects
46   LOGICAL           , PUBLIC ::   ln_rnf_mouth = .false. !: specific treatment in mouths vicinity
47   REAL(wp)          , PUBLIC ::   rn_hrnf      = 0._wp   !: runoffs, depth over which enhanced vertical mixing is used
48   REAL(wp)          , PUBLIC ::   rn_avt_rnf   = 0._wp   !: runoffs, value of the additional vertical mixing coef. [m2/s]
49   REAL(wp)          , PUBLIC ::   rn_rfact     = 1._wp   !: multiplicative factor for runoff
50
51   INTEGER , PUBLIC  ::   nkrnf = 0         !: nb of levels over which Kz is increased at river mouths
52   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rnfmsk              !: river mouth mask (hori.)
53   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)     ::   rnfmsk_z            !: river mouth mask (vert.)
54   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   h_rnf               !: depth of runoff in m
55   INTEGER,  PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   nk_rnf              !: depth of runoff in model levels
56   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rnf_tsc_b, rnf_tsc  !: before and now T & S runoff contents
57   !                                                                              !            [K.m/s & PSU.m/s]
58   
59   REAL(wp) ::   r1_rau0   ! = 1 / rau0
60
61   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_rnf       ! structure: river runoff (file information, fields read)
62   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_s_rnf     ! structure: river runoff salinity (file info, fields read) 
63   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_t_rnf     ! structure: river runoff temperature (file info, fields read) 
64
65   !! * Control permutation of array indices
66#  include "dom_oce_ftrans.h90"
67#  include "sbc_oce_ftrans.h90"
68 
69   !! * Substitutions 
70#  include "domzgr_substitute.h90" 
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   SUBROUTINE sbc_rnf( kt )
91      !!----------------------------------------------------------------------
92      !!                  ***  ROUTINE sbc_rnf  ***
93      !!       
94      !! ** Purpose :   Introduce a climatological run off forcing
95      !!
96      !! ** Method  :   Set each river mouth with a monthly climatology
97      !!                provided from different data.
98      !!                CAUTION : upward water flux, runoff forced to be < 0
99      !!
100      !! ** Action  :   runoff updated runoff field at time-step kt
101      !!----------------------------------------------------------------------
102      INTEGER, INTENT(in) ::   kt          ! ocean time step
103      !!
104      INTEGER  ::   ji, jj   ! dummy loop indices
105      !!----------------------------------------------------------------------
106      !                                   
107      IF( kt == nit000 )   CALL sbc_rnf_init                           ! Read namelist and allocate structures
108
109      !                                            ! ---------------------------------------- !
110      IF( kt /= nit000 ) THEN                      !          Swap of forcing fields          !
111         !                                         ! ---------------------------------------- !
112         rnf_b    (:,:  ) = rnf    (:,:  )               ! Swap the ocean forcing fields except at nit000
113         rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:)               ! where before fields are set at the end of the routine
114         !
115      ENDIF
116
117      !                                                   !-------------------!
118      IF( .NOT. ln_rnf_emp ) THEN                         !   Update runoff   !
119         !                                                !-------------------!
120         !
121                             CALL fld_read ( kt, nn_fsbc, sf_rnf   )    ! Read Runoffs data and provide it at kt
122         IF( ln_rnf_tem  )   CALL fld_read ( kt, nn_fsbc, sf_t_rnf )    ! idem for runoffs temperature if required
123         IF( ln_rnf_sal  )   CALL fld_read ( kt, nn_fsbc, sf_s_rnf )    ! idem for runoffs salinity    if required
124         !
125         ! Runoff reduction only associated to the ORCA2_LIM configuration
126         ! when reading the NetCDF file runoff_1m_nomask.nc
127         IF( cp_cfg == 'orca' .AND. jp_cfg == 2 )   THEN
128            WHERE( 40._wp < gphit(:,:) .AND. gphit(:,:) < 65._wp )
129               sf_rnf(1)%fnow(:,:,1) = 0.85 * sf_rnf(1)%fnow(:,:,1)
130            END WHERE
131         ENDIF
132         !
133         IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN
134            rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) ) 
135            !
136            r1_rau0 = 1._wp / rau0
137            !                                                     ! set temperature & salinity content of runoffs
138            IF( ln_rnf_tem ) THEN                                       ! use runoffs temperature data
139               rnf_tsc(:,:,jp_tem) = ( sf_t_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0
140               WHERE( sf_t_rnf(1)%fnow(:,:,1) == -999 )                 ! if missing data value use SST as runoffs temperature 
141                   rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0
142               END WHERE
143            ELSE                                                        ! use SST as runoffs temperature
144               rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0
145            ENDIF 
146            !                                                           ! use runoffs salinity data
147            IF( ln_rnf_sal )   rnf_tsc(:,:,jp_sal) = ( sf_s_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0
148            !                                                           ! else use S=0 for runoffs (done one for all in the init)
149            !
150            IF( ln_rnf_tem .OR. ln_rnf_sal ) THEN                 ! runoffs as outflow: use ocean SST and SSS
151               WHERE( rnf(:,:) < 0._wp )                                 ! example baltic model when flow is out of domain
152                  rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0
153                  rnf_tsc(:,:,jp_sal) = sss_m(:,:) * rnf(:,:) * r1_rau0
154               END WHERE
155            ENDIF
156            !
157            CALL iom_put( "runoffs", rnf )         ! output runoffs arrays
158         ENDIF
159         !
160      ENDIF
161      !
162      IF( kt == nit000 ) THEN                          !   set the forcing field at nit000 - 1    !
163         !                                             ! ---------------------------------------- !
164         IF( ln_rstart .AND.    &                               !* Restart: read in restart file
165            & iom_varid( numror, 'rnf_b', ldstop = .FALSE. ) > 0 ) THEN
166            IF(lwp) WRITE(numout,*) '          nit000-1 runoff forcing fields red in the restart file'
167            CALL iom_get( numror, jpdom_autoglo, 'rnf_b', rnf_b )     ! before runoff
168            CALL iom_get( numror, jpdom_autoglo, 'rnf_hc_b', rnf_tsc_b(:,:,jp_tem) )   ! before heat content of runoff
169            CALL iom_get( numror, jpdom_autoglo, 'rnf_sc_b', rnf_tsc_b(:,:,jp_sal) )   ! before salinity content of runoff
170         ELSE                                                   !* no restart: set from nit000 values
171            IF(lwp) WRITE(numout,*) '          nit000-1 runoff forcing fields set to nit000'
172             rnf_b    (:,:  ) = rnf    (:,:  ) 
173             rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:)   
174         ENDIF
175      ENDIF
176      !                                                ! ---------------------------------------- !
177      IF( lrst_oce ) THEN                              !      Write in the ocean restart file     !
178         !                                             ! ---------------------------------------- !
179         IF(lwp) WRITE(numout,*)
180         IF(lwp) WRITE(numout,*) 'sbcrnf : runoff forcing fields written in ocean restart file ',   &
181            &                    'at it= ', kt,' date= ', ndastp
182         IF(lwp) WRITE(numout,*) '~~~~'
183         CALL iom_rstput( kt, nitrst, numrow, 'rnf_b' , rnf )
184         CALL iom_rstput( kt, nitrst, numrow, 'rnf_hc_b', rnf_tsc(:,:,jp_tem) )
185         CALL iom_rstput( kt, nitrst, numrow, 'rnf_sc_b', rnf_tsc(:,:,jp_sal) )
186      ENDIF
187      !
188   END SUBROUTINE sbc_rnf
189
190
191   SUBROUTINE sbc_rnf_div( phdivn )
192      !!----------------------------------------------------------------------
193      !!                  ***  ROUTINE sbc_rnf  ***
194      !!       
195      !! ** Purpose :   update the horizontal divergence with the runoff inflow
196      !!
197      !! ** Method  :   
198      !!                CAUTION : rnf is positive (inflow) decreasing the
199      !!                          divergence and expressed in m/s
200      !!
201      !! ** Action  :   phdivn   decreased by the runoff inflow
202      !!----------------------------------------------------------------------
203      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   phdivn   ! horizontal divergence
204!FTRANS phdivn :I :I :z
205      !!
206      INTEGER  ::   ji, jj, jk   ! dummy loop indices
207      REAL(wp) ::   r1_rau0   ! local scalar
208      REAL(wp) ::   zfact     ! local scalar
209      !!----------------------------------------------------------------------
210      !
211      zfact = 0.5_wp
212      !
213      r1_rau0 = 1._wp / rau0
214      IF( ln_rnf_depth ) THEN      !==   runoff distributed over several levels   ==!
215         IF( lk_vvl ) THEN             ! variable volume case
216            DO jj = 1, jpj                   ! update the depth over which runoffs are distributed
217               DO ji = 1, jpi
218                  h_rnf(ji,jj) = 0._wp 
219                  DO jk = 1, nk_rnf(ji,jj)                           ! recalculates h_rnf to be the depth in metres
220                     h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk)   ! to the bottom of the relevant grid box
221                  END DO 
222                  !                          ! apply the runoff input flow
223                  DO jk = 1, nk_rnf(ji,jj)
224                     phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rau0 / h_rnf(ji,jj)
225                  END DO
226               END DO
227            END DO
228         ELSE                          ! constant volume case : just apply the runoff input flow
229            DO jj = 1, jpj
230               DO ji = 1, jpi
231                  DO jk = 1, nk_rnf(ji,jj)
232                     phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rau0 / h_rnf(ji,jj)
233                  END DO
234               END DO
235            END DO
236         ENDIF
237      ELSE                       !==   runoff put only at the surface   ==!
238         IF( lk_vvl ) THEN              ! variable volume case
239            h_rnf(:,:) = fse3t(:,:,1)   ! recalculate h_rnf to be depth of top box
240         ENDIF
241         phdivn(:,:,1) = phdivn(:,:,1) - ( rnf(:,:) + rnf_b(:,:) ) * zfact * r1_rau0 / fse3t(:,:,1)
242      ENDIF
243      !
244   END SUBROUTINE sbc_rnf_div
245
246   !! * Reset control of array index permutation
247#  include "dom_oce_ftrans.h90"
248#  include "sbc_oce_ftrans.h90"
249
250   SUBROUTINE sbc_rnf_init
251      !!----------------------------------------------------------------------
252      !!                  ***  ROUTINE sbc_rnf_init  ***
253      !!
254      !! ** Purpose :   Initialisation of the runoffs if (ln_rnf=T)
255      !!
256      !! ** Method  : - read the runoff namsbc_rnf namelist
257      !!
258      !! ** Action  : - read parameters
259      !!----------------------------------------------------------------------
260      CHARACTER(len=32) ::   rn_dep_file   ! runoff file name 
261      INTEGER           ::   ji, jj, jk    ! dummy loop indices
262      INTEGER           ::   ierror, inum  ! temporary integer
263      !!
264      NAMELIST/namsbc_rnf/ cn_dir, ln_rnf_emp, ln_rnf_depth, ln_rnf_tem, ln_rnf_sal,   &
265         &                 sn_rnf, sn_cnf    , sn_s_rnf    , sn_t_rnf  , sn_dep_rnf,   & 
266         &                 ln_rnf_mouth      , rn_hrnf     , rn_avt_rnf, rn_rfact 
267      !!----------------------------------------------------------------------
268
269      !                                   ! ============
270      !                                   !   Namelist
271      !                                   ! ============
272      ! (NB: frequency positive => hours, negative => months)
273      !            !   file    ! frequency !  variable  ! time intep !  clim  ! 'yearly' or ! weights  ! rotation   !
274      !            !   name    !  (hours)  !   name     !   (T/F)    !  (T/F) !  'monthly'  ! filename ! pairs      !
275      sn_rnf = FLD_N( 'runoffs',    -1     , 'sorunoff' ,  .TRUE.    , .true. ,   'yearly'  , ''       , ''         )
276      sn_cnf = FLD_N( 'runoffs',     0     , 'sorunoff' ,  .FALSE.   , .true. ,   'yearly'  , ''       , ''         )
277
278      sn_s_rnf = FLD_N( 'runoffs',  24.  , 'rosaline' ,  .TRUE.    , .true. ,   'yearly'  , ''    , ''  ) 
279      sn_t_rnf = FLD_N( 'runoffs',  24.  , 'rotemper' ,  .TRUE.    , .true. ,   'yearly'  , ''    , ''  ) 
280      sn_dep_rnf = FLD_N( 'runoffs',   0.  , 'rodepth'  ,  .FALSE.   , .true. ,   'yearly'  , ''    , ''  ) 
281      !
282      REWIND ( numnam )                         ! Read Namelist namsbc_rnf
283      READ   ( numnam, namsbc_rnf )
284
285      !                                         ! Control print
286      IF(lwp) THEN
287         WRITE(numout,*)
288         WRITE(numout,*) 'sbc_rnf : runoff '
289         WRITE(numout,*) '~~~~~~~ '
290         WRITE(numout,*) '   Namelist namsbc_rnf'
291         WRITE(numout,*) '      runoff in a file to be read                ln_rnf_emp   = ', ln_rnf_emp
292         WRITE(numout,*) '      specific river mouths treatment            ln_rnf_mouth = ', ln_rnf_mouth
293         WRITE(numout,*) '      river mouth additional Kz                  rn_avt_rnf   = ', rn_avt_rnf
294         WRITE(numout,*) '      depth of river mouth additional mixing     rn_hrnf      = ', rn_hrnf
295         WRITE(numout,*) '      multiplicative factor for runoff           rn_rfact     = ', rn_rfact   
296      ENDIF
297
298      !                                   ! ==================
299      !                                   !   Type of runoff
300      !                                   ! ==================
301      !                                         !==  allocate runoff arrays
302      IF( sbc_rnf_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_rnf_alloc : unable to allocate arrays' )
303      !
304      IF( ln_rnf_emp ) THEN                     !==  runoffs directly provided in the precipitations  ==!
305         IF(lwp) WRITE(numout,*)
306         IF(lwp) WRITE(numout,*) '          runoffs directly provided in the precipitations'
307         IF( ln_rnf_depth .OR. ln_rnf_tem .OR. ln_rnf_sal ) THEN
308           CALL ctl_warn( 'runoffs already included in precipitations, so runoff (T,S, depth) attributes will not be used' ) 
309           ln_rnf_depth = .FALSE.   ;   ln_rnf_tem = .FALSE.   ;   ln_rnf_sal = .FALSE.
310         ENDIF
311         !
312      ELSE                                      !==  runoffs read in a file : set sf_rnf structure  ==!
313         !
314         ALLOCATE( sf_rnf(1), STAT=ierror )         ! Create sf_rnf structure (runoff inflow)
315         IF(lwp) WRITE(numout,*)
316         IF(lwp) WRITE(numout,*) '          runoffs inflow read in a file'
317         IF( ierror > 0 ) THEN
318            CALL ctl_stop( 'sbc_rnf: unable to allocate sf_rnf structure' )   ;   RETURN
319         ENDIF
320         ALLOCATE( sf_rnf(1)%fnow(jpi,jpj,1)   )
321         IF( sn_rnf%ln_tint ) ALLOCATE( sf_rnf(1)%fdta(jpi,jpj,1,2) )
322         !                                          ! fill sf_rnf with the namelist (sn_rnf) and control print
323         CALL fld_fill( sf_rnf, (/ sn_rnf /), cn_dir, 'sbc_rnf_init', 'read runoffs data', 'namsbc_rnf' )
324         !
325         IF( ln_rnf_tem ) THEN                      ! Create (if required) sf_t_rnf structure
326            IF(lwp) WRITE(numout,*)
327            IF(lwp) WRITE(numout,*) '          runoffs temperatures read in a file'
328            ALLOCATE( sf_t_rnf(1), STAT=ierror  )
329            IF( ierror > 0 ) THEN
330               CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_t_rnf structure' )   ;   RETURN
331            ENDIF
332            ALLOCATE( sf_t_rnf(1)%fnow(jpi,jpj,1)   )
333            IF( sn_t_rnf%ln_tint ) ALLOCATE( sf_t_rnf(1)%fdta(jpi,jpj,1,2) )
334            CALL fld_fill (sf_t_rnf, (/ sn_t_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff temperature data', 'namsbc_rnf' ) 
335         ENDIF
336         !
337         IF( ln_rnf_sal  ) THEN                     ! Create (if required) sf_s_rnf and sf_t_rnf structures
338            IF(lwp) WRITE(numout,*)
339            IF(lwp) WRITE(numout,*) '          runoffs salinities read in a file'
340            ALLOCATE( sf_s_rnf(1), STAT=ierror  )
341            IF( ierror > 0 ) THEN
342               CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_s_rnf structure' )   ;   RETURN
343            ENDIF
344            ALLOCATE( sf_s_rnf(1)%fnow(jpi,jpj,1)   )
345            IF( sn_s_rnf%ln_tint ) ALLOCATE( sf_s_rnf(1)%fdta(jpi,jpj,1,2) )
346            CALL fld_fill (sf_s_rnf, (/ sn_s_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff salinity data', 'namsbc_rnf' ) 
347         ENDIF
348         !
349         IF( ln_rnf_depth ) THEN                    ! depth of runoffs set from a file
350            IF(lwp) WRITE(numout,*)
351            IF(lwp) WRITE(numout,*) '          runoffs depth read in a file'
352            rn_dep_file = TRIM( cn_dir )//TRIM( sn_dep_rnf%clname ) 
353            CALL iom_open ( rn_dep_file, inum )                           ! open file 
354            CALL iom_get  ( inum, jpdom_data, sn_dep_rnf%clvar, h_rnf )   ! read the river mouth array 
355            CALL iom_close( inum )                                        ! close file 
356            !
357            nk_rnf(:,:) = 0                               ! set the number of level over which river runoffs are applied
358            DO jj = 1, jpj 
359               DO ji = 1, jpi 
360                  IF( h_rnf(ji,jj) > 0._wp ) THEN 
361                     jk = 2 
362                     DO WHILE ( jk /= mbkt(ji,jj) .AND. fsdept(ji,jj,jk) < h_rnf(ji,jj) ) ;  jk = jk + 1 ;  END DO 
363                     nk_rnf(ji,jj) = jk 
364                  ELSEIF( h_rnf(ji,jj) == -1   ) THEN   ;  nk_rnf(ji,jj) = 1 
365                  ELSEIF( h_rnf(ji,jj) == -999 ) THEN   ;  nk_rnf(ji,jj) = mbkt(ji,jj)
366                  ELSEIF( h_rnf(ji,jj) /=  0   ) THEN 
367                     CALL ctl_stop( 'runoff depth not positive, and not -999 or -1, rnf value in file fort.999'  ) 
368                     WRITE(999,*) 'ji, jj, rnf(ji,jj) :', ji, jj, rnf(ji,jj) 
369                  ENDIF 
370               END DO 
371            END DO 
372            DO jj = 1, jpj                                ! set the associated depth
373               DO ji = 1, jpi 
374                  h_rnf(ji,jj) = 0._wp
375                  DO jk = 1, nk_rnf(ji,jj)                       
376                     h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk) 
377                  END DO
378               END DO
379            END DO
380         ELSE                                       ! runoffs applied at the surface
381            nk_rnf(:,:) = 1 
382            h_rnf (:,:) = fse3t(:,:,1)
383         ENDIF 
384         !
385      ENDIF
386      !
387      rnf_tsc(:,:,:) = 0._wp                    ! runoffs temperature & salinty contents initilisation
388      !
389      !                                   ! ========================
390      !                                   !   River mouth vicinity
391      !                                   ! ========================
392      !
393      IF( ln_rnf_mouth ) THEN                   ! Specific treatment in vicinity of river mouths :
394         !                                      !    - Increase Kz in surface layers ( rn_hrnf > 0 )
395         !                                      !    - set to zero SSS damping (ln_ssr=T)
396         !                                      !    - mixed upstream-centered (ln_traadv_cen2=T)
397         !
398         IF ( ln_rnf_depth )   CALL ctl_warn( 'sbc_rnf_init: increased mixing turned on but effects may already',   &
399            &                                              'be spread through depth by ln_rnf_depth'               ) 
400         !
401         nkrnf = 0                                  ! Number of level over which Kz increase
402         IF( rn_hrnf > 0._wp ) THEN
403            nkrnf = 2
404            DO WHILE( nkrnf /= jpkm1 .AND. gdepw_0(nkrnf+1) < rn_hrnf )   ;   nkrnf = nkrnf + 1   ;   END DO
405            IF( ln_sco )   &
406               CALL ctl_warn( 'sbc_rnf: number of levels over which Kz is increased is computed for zco...' )
407         ENDIF
408         IF(lwp) WRITE(numout,*)
409         IF(lwp) WRITE(numout,*) '          Specific treatment used in vicinity of river mouths :'
410         IF(lwp) WRITE(numout,*) '             - Increase Kz in surface layers (if rn_hrnf > 0 )'
411         IF(lwp) WRITE(numout,*) '               by ', rn_avt_rnf,' m2/s  over ', nkrnf, ' w-levels'
412         IF(lwp) WRITE(numout,*) '             - set to zero SSS damping       (if ln_ssr=T)'
413         IF(lwp) WRITE(numout,*) '             - mixed upstream-centered       (if ln_traadv_cen2=T)'
414         !
415         CALL rnf_mouth                             ! set river mouth mask
416         !
417      ELSE                                      ! No treatment at river mouths
418         IF(lwp) WRITE(numout,*)
419         IF(lwp) WRITE(numout,*) '          No specific treatment at river mouths'
420         rnfmsk  (:,:) = 0._wp 
421         rnfmsk_z(:)   = 0._wp
422         nkrnf = 0
423      ENDIF
424
425   END SUBROUTINE sbc_rnf_init
426
427
428   SUBROUTINE rnf_mouth
429      !!----------------------------------------------------------------------
430      !!                  ***  ROUTINE rnf_mouth  ***
431      !!       
432      !! ** Purpose :   define the river mouths mask
433      !!
434      !! ** Method  :   read the river mouth mask (=0/1) in the river runoff
435      !!                climatological file. Defined a given vertical structure.
436      !!                CAUTION, the vertical structure is hard coded on the
437      !!                first 5 levels.
438      !!                This fields can be used to:
439      !!                 - set an upstream advection scheme 
440      !!                   (ln_rnf_mouth=T and ln_traadv_cen2=T)
441      !!                 - increase vertical on the top nn_krnf vertical levels
442      !!                   at river runoff input grid point (nn_krnf>=2, see step.F90)
443      !!                 - set to zero SSS restoring flux at river mouth grid points
444      !!
445      !! ** Action  :   rnfmsk   set to 1 at river runoff input, 0 elsewhere
446      !!                rnfmsk_z vertical structure
447      !!----------------------------------------------------------------------
448      !
449      INTEGER           ::   inum        ! temporary integers
450      CHARACTER(len=32) ::   cl_rnfile   ! runoff file name
451      !!----------------------------------------------------------------------
452      !
453      IF(lwp) WRITE(numout,*)
454      IF(lwp) WRITE(numout,*) 'rnf_mouth : river mouth mask'
455      IF(lwp) WRITE(numout,*) '~~~~~~~~~ '
456
457      cl_rnfile = TRIM( cn_dir )//TRIM( sn_cnf%clname )
458      IF( .NOT. sn_cnf%ln_clim ) THEN   ;   WRITE(cl_rnfile, '(a,"_y",i4)' ) TRIM( cl_rnfile ), nyear    ! add year
459         IF( sn_cnf%cltype == 'monthly' )   WRITE(cl_rnfile, '(a,"m",i2)'  ) TRIM( cl_rnfile ), nmonth   ! add month
460      ENDIF
461 
462      ! horizontal mask (read in NetCDF file)
463      CALL iom_open ( cl_rnfile, inum )                           ! open file
464      CALL iom_get  ( inum, jpdom_data, sn_cnf%clvar, rnfmsk )    ! read the river mouth array
465      CALL iom_close( inum )                                      ! close file
466     
467      IF( nclosea == 1 )    CALL clo_rnf( rnfmsk )                ! closed sea inflow set as ruver mouth
468
469      rnfmsk_z(:)   = 0._wp                                        ! vertical structure
470      rnfmsk_z(1)   = 1.0
471      rnfmsk_z(2)   = 1.0                                         ! **********
472      rnfmsk_z(3)   = 0.5                                         ! HARD CODED on the 5 first levels
473      rnfmsk_z(4)   = 0.25                                        ! **********
474      rnfmsk_z(5)   = 0.125
475      !         
476   END SUBROUTINE rnf_mouth
477   
478   !!======================================================================
479END MODULE sbcrnf
Note: See TracBrowser for help on using the repository browser.