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.
closea.F90 in branches/UKMO/dev_r8600_closea_rewrite/NEMOGCM/NEMO/OPA_SRC/DOM – NEMO

source: branches/UKMO/dev_r8600_closea_rewrite/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90 @ 9155

Last change on this file since 9155 was 9155, checked in by davestorkey, 6 years ago

UKMO/dev_r8600_closea_rewrite branch: Remove wrk_alloc statements in line with NEMO 4.0 practice.
File size: 22.0 KB
Line 
1MODULE closea
2   !!======================================================================
3   !!                   ***  MODULE  closea  ***
4   !!
5   !! User define : specific treatments associated with closed seas
6   !!======================================================================
7   !! History :   8.2  !  2000-05  (O. Marti)  Original code
8   !!   NEMO      1.0  !  2002-06  (E. Durand, G. Madec)  F90
9   !!             3.0  !  2006-07  (G. Madec)  add clo_rnf, clo_ups, clo_bat
10   !!             3.4  !  2014-12  (P.G. Fogli) sbc_clo bug fix & mpp reproducibility
11   !!             4.0  !  2016-06  (G. Madec)  move to usrdef_closea, remove clo_ups
12   !!             4.0  !  2017-12  (D. Storkey) new formulation based on masks read from file
13   !!----------------------------------------------------------------------
14
15   !!----------------------------------------------------------------------
16   !!   dom_clo    : read in masks which define closed seas and runoff areas
17   !!   sbc_clo    : Special handling of freshwater fluxes over closed seas
18   !!   clo_rnf    : set close sea outflows as river mouths (see sbcrnf)
19   !!   clo_bat    : set to zero a field over closed sea (see domzgr)
20   !!----------------------------------------------------------------------
21   USE oce             ! dynamics and tracers
22   USE dom_oce         ! ocean space and time domain
23   USE phycst          ! physical constants
24   USE sbc_oce         ! ocean surface boundary conditions
25   USE iom             ! I/O routines
26   !
27   USE in_out_manager  ! I/O manager
28   USE lib_fortran,    ONLY: glob_sum
29   USE lbclnk          ! lateral boundary condition - MPP exchanges
30   USE lib_mpp         ! MPP library
31   USE timing
32
33   IMPLICIT NONE
34   PRIVATE
35
36   PUBLIC dom_clo      ! called by domain module
37   PUBLIC sbc_clo      ! called by sbcmod module
38   PUBLIC clo_rnf      ! called by sbcrnf module
39   PUBLIC clo_bat      ! called in domzgr module
40
41   LOGICAL, PUBLIC :: ln_closea  !:  T => keep closed seas (defined by closea_mask field) in the domain and apply
42                                 !:       special treatment of freshwater fluxes.
43                                 !:  F => suppress closed seas (defined by closea_mask field) from the bathymetry
44                                 !:       at runtime.
45                                 !:  If there is no closea_mask field in the domain_cfg file or we do not use
46                                 !:  a domain_cfg file then this logical does nothing.
47                                 !:
48   LOGICAL, PUBLIC :: l_sbc_clo  !: T => Closed seas defined, apply special treatment of freshwater fluxes.
49                                 !: F => No closed seas defined (closea_mask field not found).
50   LOGICAL, PUBLIC :: l_clo_rnf  !: T => Some closed seas output freshwater (RNF or EMPMR) to specified runoff points.
51   INTEGER, PUBLIC :: jncs       !: number of closed seas (inferred from closea_mask field)
52   INTEGER, PUBLIC :: jncsr      !: number of closed seas rnf mappings (inferred from closea_mask_rnf field)
53   INTEGER, PUBLIC :: jncse      !: number of closed seas empmr mappings (inferred from closea_mask_empmr field)
54   
55   INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:,:) ::  closea_mask       !: mask of integers defining closed seas
56   INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:,:) ::  closea_mask_rnf   !: mask of integers defining closed seas rnf mappings
57   INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:,:) ::  closea_mask_empmr !: mask of integers defining closed seas empmr mappings
58   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:)  ::   surf         !: closed sea surface areas
59                                                                  !: (and residual global surface area)
60   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:)  ::   surfr        !: closed sea target rnf surface areas
61   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:)  ::   surfe        !: closed sea target empmr surface areas
62
63   !! * Substitutions
64#  include "vectopt_loop_substitute.h90"
65   !!----------------------------------------------------------------------
66   !! NEMO/OPA 4.0 , NEMO Consortium (2016)
67   !! $Id$
68   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
69   !!----------------------------------------------------------------------
70CONTAINS
71
72   SUBROUTINE dom_clo()
73      !!---------------------------------------------------------------------
74      !!                  ***  ROUTINE dom_clo  ***
75      !!       
76      !! ** Purpose :   Closed sea domain initialization
77      !!
78      !! ** Method  :   if a closed sea is located only in a model grid point
79      !!                just the thermodynamic processes are applied.
80      !!
81      !! ** Action  :   Read closea_mask* fields (if they exist) from domain_cfg file and infer
82      !!                number of closed seas from closea_mask field.
83      !!                closea_mask       : integer values defining closed seas (or groups of closed seas)
84      !!                closea_mask_rnf   : integer values defining mappings from closed seas or groups of
85      !!                                    closed seas to a runoff area for downwards flux only.
86      !!                closea_mask_empmr : integer values defining mappings from closed seas or groups of
87      !!                                    closed seas to a runoff area for net fluxes.
88      !!
89      !!                Python code to generate the closea_masks* fields from the old-style indices
90      !!                definitions is available at TOOLS/DOMAINcfg/make_closea_masks.py
91      !!----------------------------------------------------------------------
92      INTEGER ::   inum    ! input file identifier
93      INTEGER ::   ierr    ! error code
94      INTEGER ::   id      ! netcdf variable ID
95
96      REAL(wp), DIMENSION(jpi,jpj) :: zdata_in ! temporary real array for input
97      !!----------------------------------------------------------------------
98      !
99      IF(lwp) WRITE(numout,*)
100      IF(lwp) WRITE(numout,*)'dom_clo : read in masks to define closed seas '
101      IF(lwp) WRITE(numout,*)'~~~~~~~'
102      !
103      ! read the closed seas masks (if they exist) from domain_cfg file
104      ! ---------------------------------------------------------------
105      !
106      CALL iom_open( cn_domcfg, inum )
107
108      id = iom_varid(inum, 'closea_mask', ldstop = .false.)
109      IF( id > 0 ) THEN
110         l_sbc_clo = .true.
111         ALLOCATE( closea_mask(jpi,jpj) , STAT=ierr )
112         IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'dom_clo: failed to allocate closea_mask array')
113         zdata_in(:,:) = 0.0
114         CALL iom_get ( inum, jpdom_data, 'closea_mask', zdata_in )
115         closea_mask(:,:) = NINT(zdata_in(:,:)) * tmask(:,:,1)
116         ! number of closed seas = global maximum value in closea_mask field
117         jncs = maxval(closea_mask(:,:))
118         IF( lk_mpp ) CALL mpp_max(jncs)
119         IF( jncs > 0 ) THEN
120            IF( lwp ) WRITE(numout,*) 'Number of closed seas : ',jncs
121         ELSE
122            CALL ctl_stop( 'Problem with closea_mask field in domain_cfg file. Has no values > 0 so no closed seas defined.')
123         ENDIF
124      ELSE
125         IF( lwp ) WRITE(numout,*) 'closea_mask field not found in domain_cfg file. No closed seas defined.'
126         l_sbc_clo = .false.
127         jncs = 0 
128      ENDIF
129
130      l_clo_rnf = .false.
131
132      IF( l_sbc_clo ) THEN ! No point reading in closea_mask_rnf or closea_mask_empmr fields if no closed seas defined.
133
134         id = iom_varid(inum, 'closea_mask_rnf', ldstop = .false.)
135         IF( id > 0 ) THEN
136            l_clo_rnf = .true.           
137            ALLOCATE( closea_mask_rnf(jpi,jpj) , STAT=ierr )
138            IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'dom_clo: failed to allocate closea_mask_rnf array')
139            CALL iom_get ( inum, jpdom_data, 'closea_mask_rnf', zdata_in )
140            closea_mask_rnf(:,:) = NINT(zdata_in(:,:)) * tmask(:,:,1)
141            ! number of closed seas rnf mappings = global maximum in closea_mask_rnf field
142            jncsr = maxval(closea_mask_rnf(:,:))
143            IF( lk_mpp ) CALL mpp_max(jncsr)
144            IF( jncsr > 0 ) THEN
145               IF( lwp ) WRITE(numout,*) 'Number of closed seas rnf mappings : ',jncsr
146            ELSE
147               CALL ctl_stop( 'Problem with closea_mask_rnf field in domain_cfg file. Has no values > 0 so no closed seas rnf mappings defined.')
148            ENDIF
149         ELSE
150            IF( lwp ) WRITE(numout,*) 'closea_mask_rnf field not found in domain_cfg file. No closed seas rnf mappings defined.'
151            jncsr = 0
152         ENDIF
153 
154         id = iom_varid(inum, 'closea_mask_empmr', ldstop = .false.)
155         IF( id > 0 ) THEN
156            l_clo_rnf = .true.           
157            ALLOCATE( closea_mask_empmr(jpi,jpj) , STAT=ierr )
158            IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'dom_clo: failed to allocate closea_mask_empmr array')
159            CALL iom_get ( inum, jpdom_data, 'closea_mask_empmr', zdata_in )
160            closea_mask_empmr(:,:) = NINT(zdata_in(:,:)) * tmask(:,:,1)
161            ! number of closed seas empmr mappings = global maximum value in closea_mask_empmr field
162            jncse = maxval(closea_mask_empmr(:,:))
163            IF( lk_mpp ) CALL mpp_max(jncse)
164            IF( jncse > 0 ) THEN
165               IF( lwp ) WRITE(numout,*) 'Number of closed seas empmr mappings : ',jncse
166            ELSE
167               CALL ctl_stop( 'Problem with closea_mask_empmr field in domain_cfg file. Has no values > 0 so no closed seas empmr mappings defined.')
168            ENDIF
169         ELSE
170            IF( lwp ) WRITE(numout,*) 'closea_mask_empmr field not found in domain_cfg file. No closed seas empmr mappings defined.'
171            jncse = 0
172         ENDIF
173
174      ENDIF ! l_sbc_clo
175      !
176      CALL iom_close( inum )
177      !
178   END SUBROUTINE dom_clo
179
180
181   SUBROUTINE sbc_clo( kt )
182      !!---------------------------------------------------------------------
183      !!                  ***  ROUTINE sbc_clo  ***
184      !!                   
185      !! ** Purpose :   Special handling of closed seas
186      !!
187      !! ** Method  :   Water flux is forced to zero over closed sea
188      !!      Excess is shared between remaining ocean, or
189      !!      put as run-off in open ocean.
190      !!
191      !! ** Action  :   emp updated surface freshwater fluxes and associated heat content at kt
192      !!----------------------------------------------------------------------
193      INTEGER         , INTENT(in   ) ::   kt       ! ocean model time step
194      !
195      INTEGER             ::   ierr
196      INTEGER             ::   jc, jcr, jce   ! dummy loop indices
197      REAL(wp), PARAMETER ::   rsmall = 1.e-20_wp    ! Closed sea correction epsilon
198      REAL(wp)            ::   zfwf_total, zcoef, zcoef1         !
199      REAL(wp), DIMENSION(jncs)    ::   zfwf      !:
200      REAL(wp), DIMENSION(jncsr+1) ::   zfwfr     !: freshwater fluxes over closed seas
201      REAL(wp), DIMENSION(jncse+1) ::   zfwfe     !:
202      REAL(wp), DIMENSION(jpi,jpj) ::   ztmp2d   ! 2D workspace
203      !!----------------------------------------------------------------------
204      !
205      IF( nn_timing == 1 )  CALL timing_start('sbc_clo')
206      !
207      !                                                   !------------------!
208      IF( kt == nit000 ) THEN                             !  Initialisation  !
209         !                                                !------------------!
210         IF(lwp) WRITE(numout,*)
211         IF(lwp) WRITE(numout,*)'sbc_clo : closed seas '
212         IF(lwp) WRITE(numout,*)'~~~~~~~'
213
214         ALLOCATE( surf(jncs+1) , STAT=ierr )
215         IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'sbc_clo: failed to allocate surf array')
216         surf(:) = 0.e0_wp
217         !
218         ! jncsr can be zero so add 1 to avoid allocating zero-length array
219         ALLOCATE( surfr(jncsr+1) , STAT=ierr )
220         IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'sbc_clo: failed to allocate surfr array')
221         surfr(:) = 0.e0_wp
222         !
223         ! jncse can be zero so add 1 to avoid allocating zero-length array
224         ALLOCATE( surfe(jncse+1) , STAT=ierr )
225         IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'sbc_clo: failed to allocate surfe array')
226         surfe(:) = 0.e0_wp
227         !
228         surf(jncs+1) = glob_sum( e1e2t(:,:) )   ! surface of the global ocean
229         !
230         !                                        ! surface areas of closed seas
231         DO jc = 1, jncs
232            ztmp2d(:,:) = 0.e0_wp
233            WHERE( closea_mask(:,:) == jc ) ztmp2d(:,:) = e1e2t(:,:) * tmask_i(:,:)
234            surf(jc) = glob_sum( ztmp2d(:,:) )
235         END DO
236         !
237         ! jncs+1 : surface area of global ocean, closed seas excluded
238         surf(jncs+1) = surf(jncs+1) - SUM(surf(1:jncs))
239         !
240         !                                        ! surface areas of rnf target areas
241         IF( jncsr > 0 ) THEN
242            DO jcr = 1, jncsr
243               ztmp2d(:,:) = 0.e0_wp
244               WHERE( closea_mask_rnf(:,:) == jcr .and. closea_mask(:,:) == 0 ) ztmp2d(:,:) = e1e2t(:,:) * tmask_i(:,:)
245               surfr(jcr) = glob_sum( ztmp2d(:,:) )
246            END DO
247         ENDIF
248         !
249         !                                        ! surface areas of empmr target areas
250         IF( jncse > 0 ) THEN
251            DO jce = 1, jncse
252               ztmp2d(:,:) = 0.e0_wp
253               WHERE( closea_mask_empmr(:,:) == jce .and. closea_mask(:,:) == 0 ) ztmp2d(:,:) = e1e2t(:,:) * tmask_i(:,:)
254               surfe(jce) = glob_sum( ztmp2d(:,:) )
255            END DO
256         ENDIF
257         !
258         IF(lwp) WRITE(numout,*)'     Closed sea surface areas (km2)'
259         DO jc = 1, jncs
260            IF(lwp) WRITE(numout,FMT='(1I3,5X,ES12.2)') jc, surf(jc) * 1.0e-6
261         END DO
262         IF(lwp) WRITE(numout,FMT='(A,ES12.2)') 'Global surface area excluding closed seas (km2): ', surf(jncs+1) * 1.0e-6
263         !
264         IF(jncsr > 0) THEN
265            IF(lwp) WRITE(numout,*)'     Closed sea target rnf surface areas (km2)'
266            DO jcr = 1, jncsr
267               IF(lwp) WRITE(numout,FMT='(1I3,5X,ES12.2)') jcr, surfr(jcr) * 1.0e-6
268            END DO
269         ENDIF
270         !
271         IF(jncse > 0) THEN
272            IF(lwp) WRITE(numout,*)'     Closed sea target empmr surface areas (km2)'
273            DO jce = 1, jncse
274               IF(lwp) WRITE(numout,FMT='(1I3,5X,ES12.2)') jce, surfe(jce) * 1.0e-6
275            END DO
276         ENDIF
277      ENDIF
278      !
279      !                                                      !--------------------!
280      !                                                      !  update emp        !
281      !                                                      !--------------------!
282
283      zfwf_total = 0._wp
284
285      !
286      ! 1. Work out total freshwater fluxes over closed seas from EMP - RNF.
287      !
288      zfwf(:) = 0.e0_wp           
289      DO jc = 1, jncs
290         ztmp2d(:,:) = 0.e0_wp
291         WHERE( closea_mask(:,:) == jc ) ztmp2d(:,:) = e1e2t(:,:) * ( emp(:,:)-rnf(:,:) ) * tmask_i(:,:)
292         zfwf(jc) = glob_sum( ztmp2d(:,:) )
293      END DO
294      zfwf_total = SUM(zfwf)
295
296      zfwfr(:) = 0.e0_wp           
297      IF( jncsr > 0 ) THEN
298         !
299         ! 2. Work out total FW fluxes over rnf source areas and add to rnf target areas.
300         !    Where zfwf is negative add flux at specified runoff points and subtract from fluxes for global redistribution.
301         !    Where positive leave in global redistribution total.
302         !
303         DO jcr = 1, jncsr
304            !
305            ztmp2d(:,:) = 0.e0_wp
306            WHERE( closea_mask_rnf(:,:) == jcr .and. closea_mask(:,:) > 0 ) ztmp2d(:,:) = e1e2t(:,:) * ( emp(:,:)-rnf(:,:) ) * tmask_i(:,:)
307            zfwfr(jcr) = glob_sum( ztmp2d(:,:) )
308            !
309            ! The following if avoids the redistribution of the round off
310            IF ( ABS(zfwfr(jcr) / surf(jncs+1) ) > rsmall) THEN
311               !
312               ! Add residuals to target runoff points if negative and subtract from total to be added globally
313               IF( zfwfr(jcr) < 0.0 ) THEN
314                  zfwf_total = zfwf_total - zfwfr(jcr)
315                  zcoef    = zfwfr(jcr) / surfr(jcr)
316                  zcoef1   = rcp * zcoef
317                  WHERE( closea_mask_rnf(:,:) == jcr .and. closea_mask(:,:) == 0.0)
318                     emp(:,:) = emp(:,:) + zcoef
319                     qns(:,:) = qns(:,:) - zcoef1 * sst_m(:,:)
320                  ENDWHERE
321               ENDIF
322               !
323            ENDIF
324         END DO
325      ENDIF  ! jncsr > 0   
326      !
327      zfwfe(:) = 0.e0_wp           
328      IF( jncse > 0 ) THEN
329         !
330         ! 3. Work out total fluxes over empmr source areas and add to empmr target areas. If jncse is zero does not loop.
331         !
332         DO jce = 1, jncse
333            !
334            ztmp2d(:,:) = 0.e0_wp
335            WHERE( closea_mask_empmr(:,:) == jce .and. closea_mask(:,:) > 0 ) ztmp2d(:,:) = e1e2t(:,:) * ( emp(:,:)-rnf(:,:) ) * tmask_i(:,:)
336            zfwfe(jce) = glob_sum( ztmp2d(:,:) )
337            !
338            ! The following if avoids the redistribution of the round off
339            IF ( ABS( zfwfe(jce) / surf(jncs+1) ) > rsmall ) THEN
340               !
341               ! Add residuals to runoff points and subtract from total to be added globally
342               zfwf_total = zfwf_total - zfwfe(jce)
343               zcoef    = zfwfe(jce) / surfe(jce)
344               zcoef1   = rcp * zcoef
345               WHERE( closea_mask_empmr(:,:) == jce .and. closea_mask(:,:) == 0.0)
346                  emp(:,:) = emp(:,:) + zcoef
347                  qns(:,:) = qns(:,:) - zcoef1 * sst_m(:,:)
348               ENDWHERE
349               !
350            ENDIF
351         END DO
352      ENDIF ! jncse > 0   
353
354      !
355      ! 4. Spread residual flux over global ocean.
356      !
357      ! The following if avoids the redistribution of the round off
358      IF ( ABS(zfwf_total / surf(jncs+1) ) > rsmall) THEN
359         zcoef    = zfwf_total / surf(jncs+1)
360         zcoef1   = rcp * zcoef
361         WHERE( closea_mask(:,:) == 0 )
362            emp(:,:) = emp(:,:) + zcoef
363            qns(:,:) = qns(:,:) - zcoef1 * sst_m(:,:)
364         ENDWHERE
365      ENDIF
366
367      !
368      ! 5. Subtract area means from emp (and qns) over closed seas to give zero mean FW flux over each sea.
369      !
370      DO jc = 1, jncs
371         ! The following if avoids the redistribution of the round off
372         IF ( ABS(zfwf(jc) / surf(jncs+1) ) > rsmall) THEN
373            !
374            ! Subtract residuals from fluxes over closed sea
375            zcoef    = zfwf(jc) / surf(jc)
376            zcoef1   = rcp * zcoef
377            WHERE( closea_mask(:,:) == jc )
378               emp(:,:) = emp(:,:) - zcoef
379               qns(:,:) = qns(:,:) + zcoef1 * sst_m(:,:)
380            ENDWHERE
381            !
382         ENDIF
383      END DO
384      !
385      emp (:,:) = emp (:,:) * tmask(:,:,1)
386      !
387      CALL lbc_lnk( emp , 'T', 1._wp )
388      !
389      IF( nn_timing == 1 )  CALL timing_stop('sbc_clo')
390      !
391   END SUBROUTINE sbc_clo
392
393   SUBROUTINE clo_rnf( p_rnfmsk )
394      !!---------------------------------------------------------------------
395      !!                  ***  ROUTINE sbc_rnf  ***
396      !!                   
397      !! ** Purpose :   allow the treatment of closed sea outflow grid-points
398      !!                to be the same as river mouth grid-points
399      !!
400      !! ** Method  :   set to 1 the runoff mask (mskrnf, see sbcrnf module)
401      !!                at the closed sea outflow grid-point.
402      !!
403      !! ** Action  :   update (p_)mskrnf (set 1 at closed sea outflow)
404      !!----------------------------------------------------------------------
405      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   p_rnfmsk   ! river runoff mask (rnfmsk array)
406      !!----------------------------------------------------------------------
407      !
408      IF( jncsr > 0 ) THEN
409         WHERE( closea_mask_rnf(:,:) > 0 .and. closea_mask(:,:) == 0 )
410            p_rnfmsk(:,:) = MAX( p_rnfmsk(:,:), 1.0_wp )
411         ENDWHERE
412      ENDIF
413      !
414      IF( jncse > 0 ) THEN
415         WHERE( closea_mask_empmr(:,:) > 0 .and. closea_mask(:,:) == 0 )
416            p_rnfmsk(:,:) = MAX( p_rnfmsk(:,:), 1.0_wp )
417         ENDWHERE
418      ENDIF
419      !
420   END SUBROUTINE clo_rnf
421   
422     
423   SUBROUTINE clo_bat( k_top, k_bot )
424      !!---------------------------------------------------------------------
425      !!                  ***  ROUTINE clo_bat  ***
426      !!                   
427      !! ** Purpose :   Suppress closed sea from the domain
428      !!
429      !! ** Method  :   Read in closea_mask field (if it exists) from domain_cfg file.
430      !!                Where closea_mask > 0 set first and last ocean level to 0
431      !!                (As currently coded you can't define a closea_mask field in
432      !!                usr_def_zgr).
433      !!
434      !! ** Action  :   set k_top=0 and k_bot=0 over closed seas
435      !!----------------------------------------------------------------------
436      INTEGER, DIMENSION(:,:), INTENT(inout) ::   k_top, k_bot   ! ocean first and last level indices
437      INTEGER                           :: inum, id
438      INTEGER,  DIMENSION(jpi,jpj) :: closea_mask ! closea_mask field
439      REAL(wp), DIMENSION(jpi,jpj) :: zdata_in ! temporary real array for input
440      !!----------------------------------------------------------------------
441      !
442      IF(lwp) THEN                     ! Control print
443         WRITE(numout,*)
444         WRITE(numout,*) 'clo_bat : suppression of closed seas'
445         WRITE(numout,*) '~~~~~~~'
446      ENDIF
447      !
448      CALL iom_open( cn_domcfg, inum )
449      !
450      id = iom_varid(inum, 'closea_mask', ldstop = .false.)     
451      IF( id > 0 ) THEN
452         IF( lwp ) WRITE(numout,*) 'Suppressing closed seas in bathymetry based on closea_mask field,'
453         CALL iom_get ( inum, jpdom_data, 'closea_mask', zdata_in )
454         closea_mask(:,:) = NINT(zdata_in(:,:))
455         WHERE( closea_mask(:,:) > 0 )
456            k_top(:,:) = 0   
457            k_bot(:,:) = 0   
458         ENDWHERE
459      ELSE
460         IF( lwp ) WRITE(numout,*) 'No closea_mask field found in domain_cfg file. No suppression of closed seas.'
461      ENDIF
462      !
463      ! Initialise l_sbc_clo and l_clo_rnf for this case (ln_closea=.false.)
464      l_sbc_clo = .false.
465      l_clo_rnf = .false.
466      !
467      CALL iom_close(inum)
468      !
469   END SUBROUTINE clo_bat
470
471   !!======================================================================
472END MODULE closea
473
Note: See TracBrowser for help on using the repository browser.