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/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/OPA_SRC/SBC – NEMO

source: branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90 @ 5870

Last change on this file since 5870 was 5870, checked in by acc, 8 years ago

Branch 2015/dev_r5803_NOC_WAD. Merge in trunk changes from 5803 to 5869 in preparation for merge. Also tidied and reorganised some wetting and drying code. Renamed wadlmt.F90 to wetdry.F90. Wetting drying code changes restricted to domzgr.F90, domvvl.F90 nemogcm.F90 sshwzv.F90, dynspg_ts.F90, wetdry.F90 and dynhpg.F90. Code passes full SETTE tests with ln_wd=.false.. Still awaiting test case for checking with ln_wd=.false.

  • Property svn:keywords set to Id
File size: 29.8 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
30   IMPLICIT NONE
31   PRIVATE
32
33   PUBLIC   sbc_rnf       ! routine called in sbcmod module
34   PUBLIC   sbc_rnf_div   ! routine called in divhor module
35   PUBLIC   sbc_rnf_alloc ! routine called in sbcmod module
36   PUBLIC   sbc_rnf_init  ! routine called in sbcmod module
37   
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)                   ::   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      IF( kt /= nit000 ) THEN                      !          Swap of forcing fields          !
115         !                                         ! ---------------------------------------- !
116         rnf_b    (:,:  ) = rnf    (:,:  )               ! Swap the ocean forcing fields except at nit000
117         rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:)               ! where before fields are set at the end of the routine
118         !
119      ENDIF
120
121      !                                            !-------------------!
122      !                                            !   Update runoff   !
123      !                                            !-------------------!
124      !
125      IF( .NOT. l_rnfcpl )   CALL fld_read ( kt, nn_fsbc, sf_rnf   )    ! Read Runoffs data and provide it at kt
126      IF(   ln_rnf_tem   )   CALL fld_read ( kt, nn_fsbc, sf_t_rnf )    ! idem for runoffs temperature if required
127      IF(   ln_rnf_sal   )   CALL fld_read ( kt, nn_fsbc, sf_s_rnf )    ! idem for runoffs salinity    if required
128      !
129      ! Runoff reduction only associated to the ORCA2_LIM configuration
130      ! when reading the NetCDF file runoff_1m_nomask.nc
131      IF( cp_cfg == 'orca' .AND. jp_cfg == 2 .AND. .NOT. l_rnfcpl )   THEN
132         WHERE( 40._wp < gphit(:,:) .AND. gphit(:,:) < 65._wp )
133            sf_rnf(1)%fnow(:,:,1) = 0.85 * sf_rnf(1)%fnow(:,:,1)
134         END WHERE
135      ENDIF
136      !
137      IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN
138         !
139         IF( .NOT. l_rnfcpl )   rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) )       ! updated runoff value at time step kt
140         !
141         !                                                     ! set temperature & salinity content of runoffs
142         IF( ln_rnf_tem ) THEN                                       ! use runoffs temperature data
143            rnf_tsc(:,:,jp_tem) = ( sf_t_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0
144            WHERE( sf_t_rnf(1)%fnow(:,:,1) == -999._wp )             ! if missing data value use SST as runoffs temperature
145               rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0
146            END WHERE
147            WHERE( sf_t_rnf(1)%fnow(:,:,1) == -222._wp )             ! where fwf comes from melting of ice shelves or iceberg
148               ztfrz(:,:) = -1.9 !tfreez( sss_m(:,:) ) !PM to be discuss (trouble if sensitivity study)
149               rnf_tsc(:,:,jp_tem) = ztfrz(:,:) * rnf(:,:) * r1_rau0 - rnf(:,:) * lfusisf * r1_rau0_rcp
150            END WHERE
151         ELSE                                                        ! use SST as runoffs temperature
152            rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0
153         ENDIF
154         !                                                           ! use runoffs salinity data
155         IF( ln_rnf_sal )   rnf_tsc(:,:,jp_sal) = ( sf_s_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0
156         !                                                           ! else use S=0 for runoffs (done one for all in the init)
157         CALL iom_put( "runoffs", rnf )         ! output runoffs arrays
158      ENDIF
159      !
160      !                                                ! ---------------------------------------- !
161      IF( kt == nit000 ) THEN                          !   set the forcing field at nit000 - 1    !
162         !                                             ! ---------------------------------------- !
163         IF( ln_rstart .AND.    &                               !* Restart: read in restart file
164            & iom_varid( numror, 'rnf_b', ldstop = .FALSE. ) > 0 ) THEN
165            IF(lwp) WRITE(numout,*) '          nit000-1 runoff forcing fields red in the restart file'
166            CALL iom_get( numror, jpdom_autoglo, 'rnf_b', rnf_b )     ! before runoff
167            CALL iom_get( numror, jpdom_autoglo, 'rnf_hc_b', rnf_tsc_b(:,:,jp_tem) )   ! before heat content of runoff
168            CALL iom_get( numror, jpdom_autoglo, 'rnf_sc_b', rnf_tsc_b(:,:,jp_sal) )   ! before salinity content of runoff
169         ELSE                                                   !* no restart: set from nit000 values
170            IF(lwp) WRITE(numout,*) '          nit000-1 runoff forcing fields set to nit000'
171            rnf_b    (:,:  ) = rnf    (:,:  )
172            rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:)
173         ENDIF
174      ENDIF
175      !                                                ! ---------------------------------------- !
176      IF( lrst_oce ) THEN                              !      Write in the ocean restart file     !
177         !                                             ! ---------------------------------------- !
178         IF(lwp) WRITE(numout,*)
179         IF(lwp) WRITE(numout,*) 'sbcrnf : runoff forcing fields written in ocean restart file ',   &
180            &                    'at it= ', kt,' date= ', ndastp
181         IF(lwp) WRITE(numout,*) '~~~~'
182         CALL iom_rstput( kt, nitrst, numrow, 'rnf_b' , rnf )
183         CALL iom_rstput( kt, nitrst, numrow, 'rnf_hc_b', rnf_tsc(:,:,jp_tem) )
184         CALL iom_rstput( kt, nitrst, numrow, 'rnf_sc_b', rnf_tsc(:,:,jp_sal) )
185      ENDIF
186      !
187      CALL wrk_dealloc( jpi,jpj, ztfrz)
188      !
189   END SUBROUTINE sbc_rnf
190
191
192   SUBROUTINE sbc_rnf_div( phdivn )
193      !!----------------------------------------------------------------------
194      !!                  ***  ROUTINE sbc_rnf  ***
195      !!
196      !! ** Purpose :   update the horizontal divergence with the runoff inflow
197      !!
198      !! ** Method  :
199      !!                CAUTION : rnf is positive (inflow) decreasing the
200      !!                          divergence and expressed in m/s
201      !!
202      !! ** Action  :   phdivn   decreased by the runoff inflow
203      !!----------------------------------------------------------------------
204      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   phdivn   ! horizontal divergence
205      !!
206      INTEGER  ::   ji, jj, jk   ! dummy loop indices
207      REAL(wp) ::   zfact     ! local scalar
208      !!----------------------------------------------------------------------
209      !
210      zfact = 0.5_wp
211      !
212      IF( ln_rnf_depth .OR. ln_rnf_depth_ini ) THEN      !==   runoff distributed over several levels   ==!
213         IF( lk_vvl ) THEN             ! variable volume case
214            DO jj = 1, jpj                   ! update the depth over which runoffs are distributed
215               DO ji = 1, jpi
216                  h_rnf(ji,jj) = 0._wp
217                  DO jk = 1, nk_rnf(ji,jj)                           ! recalculates h_rnf to be the depth in metres
218                     h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk)   ! to the bottom of the relevant grid box
219                  END DO
220                  !                          ! apply the runoff input flow
221                  DO jk = 1, nk_rnf(ji,jj)
222                     phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rau0 / h_rnf(ji,jj)
223                  END DO
224               END DO
225            END DO
226         ELSE                          ! constant volume case : just apply the runoff input flow
227            DO jj = 1, jpj
228               DO ji = 1, jpi
229                  DO jk = 1, nk_rnf(ji,jj)
230                     phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rau0 / h_rnf(ji,jj)
231                  END DO
232               END DO
233            END DO
234         ENDIF
235      ELSE                       !==   runoff put only at the surface   ==!
236         IF( lk_vvl ) THEN              ! variable volume case
237            h_rnf(:,:) = fse3t(:,:,1)   ! recalculate h_rnf to be depth of top box
238         ENDIF
239         phdivn(:,:,1) = phdivn(:,:,1) - ( rnf(:,:) + rnf_b(:,:) ) * zfact * r1_rau0 / fse3t(:,:,1)
240      ENDIF
241      !
242   END SUBROUTINE sbc_rnf_div
243
244
245   SUBROUTINE sbc_rnf_init
246      !!----------------------------------------------------------------------
247      !!                  ***  ROUTINE sbc_rnf_init  ***
248      !!
249      !! ** Purpose :   Initialisation of the runoffs if (ln_rnf=T)
250      !!
251      !! ** Method  : - read the runoff namsbc_rnf namelist
252      !!
253      !! ** Action  : - read parameters
254      !!----------------------------------------------------------------------
255      CHARACTER(len=32) ::   rn_dep_file   ! runoff file name
256      INTEGER           ::   ji, jj, jk, jm    ! dummy loop indices
257      INTEGER           ::   ierror, inum  ! temporary integer
258      INTEGER           ::   ios           ! Local integer output status for namelist read
259      INTEGER           ::   nbrec         ! temporary integer
260      REAL(wp)          ::   zacoef 
261      REAL(wp), DIMENSION(12)                 :: zrec             ! times records
262      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zrnfcl   
263      REAL(wp), DIMENSION(:,:  ), ALLOCATABLE :: zrnf
264      !
265      NAMELIST/namsbc_rnf/ cn_dir            , ln_rnf_depth, ln_rnf_tem, ln_rnf_sal,   &
266         &                 sn_rnf, sn_cnf    , sn_s_rnf    , sn_t_rnf  , sn_dep_rnf,   &
267         &                 ln_rnf_mouth      , rn_hrnf     , rn_avt_rnf, rn_rfact,     &
268         &                 ln_rnf_depth_ini  , rn_dep_max  , rn_rnf_max, nn_rnf_depth_file
269      !!----------------------------------------------------------------------
270      !
271      !                                         !==  allocate runoff arrays
272      IF( sbc_rnf_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_rnf_alloc : unable to allocate arrays' )
273      !
274      IF( .NOT. ln_rnf ) THEN                      ! no specific treatment in vicinity of river mouths
275         ln_rnf_mouth  = .FALSE.                   ! default definition needed for example by sbc_ssr or by tra_adv_muscl
276         nkrnf         = 0
277         rnf     (:,:) = 0.0_wp
278         rnf_b   (:,:) = 0.0_wp
279         rnfmsk  (:,:) = 0.0_wp
280         rnfmsk_z(:)   = 0.0_wp
281         RETURN
282      ENDIF
283      !
284      !                                   ! ============
285      !                                   !   Namelist
286      !                                   ! ============
287      !
288      REWIND( numnam_ref )              ! Namelist namsbc_rnf in reference namelist : Runoffs
289      READ  ( numnam_ref, namsbc_rnf, IOSTAT = ios, ERR = 901)
290901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_rnf in reference namelist', lwp )
291
292      REWIND( numnam_cfg )              ! Namelist namsbc_rnf in configuration namelist : Runoffs
293      READ  ( numnam_cfg, namsbc_rnf, IOSTAT = ios, ERR = 902 )
294902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_rnf in configuration namelist', lwp )
295      IF(lwm) WRITE ( numond, namsbc_rnf )
296      !
297      !                                         ! Control print
298      IF(lwp) THEN
299         WRITE(numout,*)
300         WRITE(numout,*) 'sbc_rnf : runoff '
301         WRITE(numout,*) '~~~~~~~ '
302         WRITE(numout,*) '   Namelist namsbc_rnf'
303         WRITE(numout,*) '      specific river mouths treatment            ln_rnf_mouth = ', ln_rnf_mouth
304         WRITE(numout,*) '      river mouth additional Kz                  rn_avt_rnf   = ', rn_avt_rnf
305         WRITE(numout,*) '      depth of river mouth additional mixing     rn_hrnf      = ', rn_hrnf
306         WRITE(numout,*) '      multiplicative factor for runoff           rn_rfact     = ', rn_rfact
307      ENDIF
308      !                                   ! ==================
309      !                                   !   Type of runoff
310      !                                   ! ==================
311      !
312      IF( .NOT. l_rnfcpl ) THEN                   
313         ALLOCATE( sf_rnf(1), STAT=ierror )         ! Create sf_rnf structure (runoff inflow)
314         IF(lwp) WRITE(numout,*)
315         IF(lwp) WRITE(numout,*) '          runoffs inflow read in a file'
316         IF( ierror > 0 ) THEN
317            CALL ctl_stop( 'sbc_rnf: unable to allocate sf_rnf structure' )   ;   RETURN
318         ENDIF
319         ALLOCATE( sf_rnf(1)%fnow(jpi,jpj,1)   )
320         IF( sn_rnf%ln_tint ) ALLOCATE( sf_rnf(1)%fdta(jpi,jpj,1,2) )
321         CALL fld_fill( sf_rnf, (/ sn_rnf /), cn_dir, 'sbc_rnf_init', 'read runoffs data', 'namsbc_rnf' )
322      ENDIF
323      !
324      IF( ln_rnf_tem ) THEN                      ! Create (if required) sf_t_rnf structure
325         IF(lwp) WRITE(numout,*)
326         IF(lwp) WRITE(numout,*) '          runoffs temperatures read in a file'
327         ALLOCATE( sf_t_rnf(1), STAT=ierror  )
328         IF( ierror > 0 ) THEN
329            CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_t_rnf structure' )   ;   RETURN
330         ENDIF
331         ALLOCATE( sf_t_rnf(1)%fnow(jpi,jpj,1)   )
332         IF( sn_t_rnf%ln_tint ) ALLOCATE( sf_t_rnf(1)%fdta(jpi,jpj,1,2) )
333         CALL fld_fill (sf_t_rnf, (/ sn_t_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff temperature data', 'namsbc_rnf' )
334      ENDIF
335      !
336      IF( ln_rnf_sal  ) THEN                     ! Create (if required) sf_s_rnf and sf_t_rnf structures
337         IF(lwp) WRITE(numout,*)
338         IF(lwp) WRITE(numout,*) '          runoffs salinities read in a file'
339         ALLOCATE( sf_s_rnf(1), STAT=ierror  )
340         IF( ierror > 0 ) THEN
341            CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_s_rnf structure' )   ;   RETURN
342         ENDIF
343         ALLOCATE( sf_s_rnf(1)%fnow(jpi,jpj,1)   )
344         IF( sn_s_rnf%ln_tint ) ALLOCATE( sf_s_rnf(1)%fdta(jpi,jpj,1,2) )
345         CALL fld_fill (sf_s_rnf, (/ sn_s_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff salinity data', 'namsbc_rnf' )
346      ENDIF
347      !
348      IF( ln_rnf_depth ) THEN                    ! depth of runoffs set from a file
349         IF(lwp) WRITE(numout,*)
350         IF(lwp) WRITE(numout,*) '          runoffs depth read in a file'
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
392         CALL iom_open( TRIM( sn_rnf%clname ), inum )    !  open runoff file
393         CALL iom_gettime( inum, zrec, kntime=nbrec)
394         ALLOCATE( zrnfcl(jpi,jpj,nbrec) )     ;      ALLOCATE( zrnf(jpi,jpj) )
395         DO jm = 1, nbrec
396            CALL iom_get( inum, jpdom_data, TRIM( sn_rnf%clvar ), zrnfcl(:,:,jm), jm )
397         END DO
398         CALL iom_close( inum )
399         zrnf(:,:) = MAXVAL( zrnfcl(:,:,:), DIM=3 )   !  maximum value in time
400         DEALLOCATE( zrnfcl )
401         !
402         h_rnf(:,:) = 1.
403         !
404         zacoef = rn_dep_max / rn_rnf_max            ! coef of linear relation between runoff and its depth (150m for max of runoff)
405         !
406         WHERE( zrnf(:,:) > 0._wp )  h_rnf(:,:) = zacoef * zrnf(:,:)   ! compute depth for all runoffs
407         !
408         DO jj = 1, jpj                     ! take in account min depth of ocean rn_hmin
409            DO ji = 1, jpi
410               IF( zrnf(ji,jj) > 0._wp ) THEN
411                  jk = mbkt(ji,jj)
412                  h_rnf(ji,jj) = MIN( h_rnf(ji,jj), gdept_0(ji,jj,jk ) )
413               ENDIF
414            END DO
415         END DO
416         !
417         nk_rnf(:,:) = 0                       ! number of levels on which runoffs are distributed
418         DO jj = 1, jpj
419            DO ji = 1, jpi
420               IF( zrnf(ji,jj) > 0._wp ) THEN
421                  jk = 2
422                  DO WHILE ( jk /= mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ;  jk = jk + 1
423                  END DO
424                  nk_rnf(ji,jj) = jk
425               ELSE
426                  nk_rnf(ji,jj) = 1
427               ENDIF
428            END DO
429         END DO
430         !
431         DEALLOCATE( zrnf )
432         !
433         DO jj = 1, jpj                                ! set the associated depth
434            DO ji = 1, jpi
435               h_rnf(ji,jj) = 0._wp
436               DO jk = 1, nk_rnf(ji,jj)
437                  h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk)
438               END DO
439            END DO
440         END DO
441         !
442         IF( nn_rnf_depth_file == 1 ) THEN      !  save  output nb levels for runoff
443            IF(lwp) WRITE(numout,*) '              create runoff depht file'
444            CALL iom_open  ( TRIM( sn_dep_rnf%clname ), inum, ldwrt = .TRUE., kiolib = jprstlib )
445            CALL iom_rstput( 0, 0, inum, 'rodepth', h_rnf )
446            CALL iom_close ( inum )
447         ENDIF
448      ELSE                                       ! runoffs applied at the surface
449         nk_rnf(:,:) = 1
450         h_rnf (:,:) = fse3t(:,:,1)
451      ENDIF
452      !
453      rnf(:,:) =  0._wp                         ! runoff initialisation
454      rnf_tsc(:,:,:) = 0._wp                    ! runoffs temperature & salinty contents initilisation
455      !
456      !                                   ! ========================
457      !                                   !   River mouth vicinity
458      !                                   ! ========================
459      !
460      IF( ln_rnf_mouth ) THEN                   ! Specific treatment in vicinity of river mouths :
461         !                                      !    - Increase Kz in surface layers ( rn_hrnf > 0 )
462         !                                      !    - set to zero SSS damping (ln_ssr=T)
463         !                                      !    - mixed upstream-centered (ln_traadv_cen2=T)
464         !
465         IF ( ln_rnf_depth )   CALL ctl_warn( 'sbc_rnf_init: increased mixing turned on but effects may already',   &
466            &                                              'be spread through depth by ln_rnf_depth'               )
467         !
468         nkrnf = 0                                  ! Number of level over which Kz increase
469         IF( rn_hrnf > 0._wp ) THEN
470            nkrnf = 2
471            DO WHILE( nkrnf /= jpkm1 .AND. gdepw_1d(nkrnf+1) < rn_hrnf )   ;   nkrnf = nkrnf + 1
472            END DO
473            IF( ln_sco )   CALL ctl_warn( 'sbc_rnf: number of levels over which Kz is increased is computed for zco...' )
474         ENDIF
475         IF(lwp) WRITE(numout,*)
476         IF(lwp) WRITE(numout,*) '          Specific treatment used in vicinity of river mouths :'
477         IF(lwp) WRITE(numout,*) '             - Increase Kz in surface layers (if rn_hrnf > 0 )'
478         IF(lwp) WRITE(numout,*) '               by ', rn_avt_rnf,' m2/s  over ', nkrnf, ' w-levels'
479         IF(lwp) WRITE(numout,*) '             - set to zero SSS damping       (if ln_ssr=T)'
480         IF(lwp) WRITE(numout,*) '             - mixed upstream-centered       (if ln_traadv_cen2=T)'
481         !
482         CALL rnf_mouth                             ! set river mouth mask
483         !
484      ELSE                                      ! No treatment at river mouths
485         IF(lwp) WRITE(numout,*)
486         IF(lwp) WRITE(numout,*) '          No specific treatment at river mouths'
487         rnfmsk  (:,:) = 0._wp
488         rnfmsk_z(:)   = 0._wp
489         nkrnf = 0
490      ENDIF
491      !
492   END SUBROUTINE sbc_rnf_init
493
494
495   SUBROUTINE rnf_mouth
496      !!----------------------------------------------------------------------
497      !!                  ***  ROUTINE rnf_mouth  ***
498      !!
499      !! ** Purpose :   define the river mouths mask
500      !!
501      !! ** Method  :   read the river mouth mask (=0/1) in the river runoff
502      !!                climatological file. Defined a given vertical structure.
503      !!                CAUTION, the vertical structure is hard coded on the
504      !!                first 5 levels.
505      !!                This fields can be used to:
506      !!                 - set an upstream advection scheme
507      !!                   (ln_rnf_mouth=T and ln_traadv_cen2=T)
508      !!                 - increase vertical on the top nn_krnf vertical levels
509      !!                   at river runoff input grid point (nn_krnf>=2, see step.F90)
510      !!                 - set to zero SSS restoring flux at river mouth grid points
511      !!
512      !! ** Action  :   rnfmsk   set to 1 at river runoff input, 0 elsewhere
513      !!                rnfmsk_z vertical structure
514      !!----------------------------------------------------------------------
515      INTEGER            ::   inum        ! temporary integers
516      CHARACTER(len=140) ::   cl_rnfile   ! runoff file name
517      !!----------------------------------------------------------------------
518      !
519      IF(lwp) WRITE(numout,*)
520      IF(lwp) WRITE(numout,*) 'rnf_mouth : river mouth mask'
521      IF(lwp) WRITE(numout,*) '~~~~~~~~~ '
522      !
523      cl_rnfile = TRIM( cn_dir )//TRIM( sn_cnf%clname )
524      IF( .NOT. sn_cnf%ln_clim ) THEN   ;   WRITE(cl_rnfile, '(a,"_y",i4)' ) TRIM( cl_rnfile ), nyear    ! add year
525         IF( sn_cnf%cltype == 'monthly' )   WRITE(cl_rnfile, '(a,"m",i2)'  ) TRIM( cl_rnfile ), nmonth   ! add month
526      ENDIF
527      !
528      ! horizontal mask (read in NetCDF file)
529      CALL iom_open ( cl_rnfile, inum )                           ! open file
530      CALL iom_get  ( inum, jpdom_data, sn_cnf%clvar, rnfmsk )    ! read the river mouth array
531      CALL iom_close( inum )                                      ! close file
532      !
533      IF( nn_closea == 1 )   CALL clo_rnf( rnfmsk )               ! closed sea inflow set as ruver mouth
534      !
535      rnfmsk_z(:)   = 0._wp                                       ! vertical structure
536      rnfmsk_z(1)   = 1.0
537      rnfmsk_z(2)   = 1.0                                         ! **********
538      rnfmsk_z(3)   = 0.5                                         ! HARD CODED on the 5 first levels
539      rnfmsk_z(4)   = 0.25                                        ! **********
540      rnfmsk_z(5)   = 0.125
541      !
542   END SUBROUTINE rnf_mouth
543
544   !!======================================================================
545END MODULE sbcrnf
Note: See TracBrowser for help on using the repository browser.