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 @ 9080

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

UKMO/dev_r8600_closea_rewrite branch:

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