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/2017/dev_merge_2017/NEMOGCM/NEMO/OCE_SRC/DOM – NEMO

source: branches/2017/dev_merge_2017/NEMOGCM/NEMO/OCE_SRC/DOM/closea.F90 @ 9580

Last change on this file since 9580 was 9570, checked in by nicolasmartin, 6 years ago

Global renaming for core routines (./NEMO)

  • Folders
    • LIM_SRC_3 -> ICE_SRC
    • OPA_SRC -> OCE_SRC
  • CPP key: key_lim3 -> key_si3
  • Modules, (sub)routines and variables names
    • MPI: mpi_comm_opa -> mpi_comm_oce, MPI_COMM_OPA -> MPI_COMM_OCE, mpi_init_opa -> mpi_init_oce
    • AGRIF: agrif_opa_* -> agrif_oce_*, agrif_lim3_* -> agrif_si3_* and few more
    • TOP-PISCES: p.zlim -> p.zice, namp.zlim -> namp.zice
  • Comments
    • NEMO/OPA -> NEMO/OCE
    • ESIM|LIM3 -> SI3
File size: 22.7 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          ! 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/OCE 4.0 , NEMO Consortium (2016)
67   !! $Id: usrdef_closea.F90 9124 2017-12-19 08:26:25Z gm $
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 (if it exists)
104      ! ------------------------------------------------------------------------------
105      !
106      IF( ln_read_cfg) THEN
107         !
108         CALL iom_open( cn_domcfg, inum )
109         !
110         id = iom_varid(inum, 'closea_mask', ldstop = .false.)
111         IF( id > 0 ) THEN
112            l_sbc_clo = .true.
113            ALLOCATE( closea_mask(jpi,jpj) , STAT=ierr )
114            IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'dom_clo: failed to allocate closea_mask array')
115            zdata_in(:,:) = 0.0
116            CALL iom_get ( inum, jpdom_data, 'closea_mask', zdata_in )
117            closea_mask(:,:) = NINT(zdata_in(:,:)) * tmask(:,:,1)
118            ! number of closed seas = global maximum value in closea_mask field
119            jncs = maxval(closea_mask(:,:))
120            IF( lk_mpp ) CALL mpp_max(jncs)
121            IF( jncs > 0 ) THEN
122               IF( lwp ) WRITE(numout,*) 'Number of closed seas : ',jncs
123            ELSE
124               CALL ctl_stop( 'Problem with closea_mask field in domain_cfg file. Has no values > 0 so no closed seas defined.')
125            ENDIF
126         ELSE
127            IF( lwp ) WRITE(numout,*)
128            IF( lwp ) WRITE(numout,*) '   ==>>>   closea_mask field not found in domain_cfg file.'
129            IF( lwp ) WRITE(numout,*) '           No closed seas defined.'
130            IF( lwp ) WRITE(numout,*)
131            l_sbc_clo = .false.
132            jncs = 0 
133         ENDIF
134
135         l_clo_rnf = .false.
136
137         IF( l_sbc_clo ) THEN ! No point reading in closea_mask_rnf or closea_mask_empmr fields if no closed seas defined.
138
139            id = iom_varid(inum, 'closea_mask_rnf', ldstop = .false.)
140            IF( id > 0 ) THEN
141               l_clo_rnf = .true.           
142               ALLOCATE( closea_mask_rnf(jpi,jpj) , STAT=ierr )
143               IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'dom_clo: failed to allocate closea_mask_rnf array')
144               CALL iom_get ( inum, jpdom_data, 'closea_mask_rnf', zdata_in )
145               closea_mask_rnf(:,:) = NINT(zdata_in(:,:)) * tmask(:,:,1)
146               ! number of closed seas rnf mappings = global maximum in closea_mask_rnf field
147               jncsr = maxval(closea_mask_rnf(:,:))
148               IF( lk_mpp ) CALL mpp_max(jncsr)
149               IF( jncsr > 0 ) THEN
150                  IF( lwp ) WRITE(numout,*) 'Number of closed seas rnf mappings : ',jncsr
151               ELSE
152                  CALL ctl_stop( 'Problem with closea_mask_rnf field in domain_cfg file. Has no values > 0 so no closed seas rnf mappings defined.')
153               ENDIF
154            ELSE
155               IF( lwp ) WRITE(numout,*) 'closea_mask_rnf field not found in domain_cfg file. No closed seas rnf mappings defined.'
156               jncsr = 0
157            ENDIF
158 
159            id = iom_varid(inum, 'closea_mask_empmr', ldstop = .false.)
160            IF( id > 0 ) THEN
161               l_clo_rnf = .true.           
162               ALLOCATE( closea_mask_empmr(jpi,jpj) , STAT=ierr )
163               IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'dom_clo: failed to allocate closea_mask_empmr array')
164               CALL iom_get ( inum, jpdom_data, 'closea_mask_empmr', zdata_in )
165               closea_mask_empmr(:,:) = NINT(zdata_in(:,:)) * tmask(:,:,1)
166               ! number of closed seas empmr mappings = global maximum value in closea_mask_empmr field
167               jncse = maxval(closea_mask_empmr(:,:))
168               IF( lk_mpp ) CALL mpp_max(jncse)
169               IF( jncse > 0 ) THEN
170                  IF( lwp ) WRITE(numout,*) 'Number of closed seas empmr mappings : ',jncse
171               ELSE
172                  CALL ctl_stop( 'Problem with closea_mask_empmr field in domain_cfg file. Has no values > 0 so no closed seas empmr mappings defined.')
173               ENDIF
174            ELSE
175               IF( lwp ) WRITE(numout,*) 'closea_mask_empmr field not found in domain_cfg file. No closed seas empmr mappings defined.'
176               jncse = 0
177            ENDIF
178
179         ENDIF ! l_sbc_clo
180         !
181         CALL iom_close( inum )
182         !
183      ELSE ! ln_read_cfg = .false. so no domain_cfg file
184         IF( lwp ) WRITE(numout,*) 'No domain_cfg file so no closed seas defined.'
185         l_sbc_clo = .false.
186         l_clo_rnf = .false.
187      ENDIF
188      !
189   END SUBROUTINE dom_clo
190
191
192   SUBROUTINE sbc_clo( kt )
193      !!---------------------------------------------------------------------
194      !!                  ***  ROUTINE sbc_clo  ***
195      !!                   
196      !! ** Purpose :   Special handling of closed seas
197      !!
198      !! ** Method  :   Water flux is forced to zero over closed sea
199      !!      Excess is shared between remaining ocean, or
200      !!      put as run-off in open ocean.
201      !!
202      !! ** Action  :   emp updated surface freshwater fluxes and associated heat content at kt
203      !!----------------------------------------------------------------------
204      INTEGER         , INTENT(in   ) ::   kt       ! ocean model time step
205      !
206      INTEGER             ::   ierr
207      INTEGER             ::   jc, jcr, jce   ! dummy loop indices
208      REAL(wp), PARAMETER ::   rsmall = 1.e-20_wp    ! Closed sea correction epsilon
209      REAL(wp)            ::   zfwf_total, zcoef, zcoef1         !
210      REAL(wp), DIMENSION(jncs)    ::   zfwf      !:
211      REAL(wp), DIMENSION(jncsr+1) ::   zfwfr     !: freshwater fluxes over closed seas
212      REAL(wp), DIMENSION(jncse+1) ::   zfwfe     !:
213      REAL(wp), DIMENSION(jpi,jpj) ::   ztmp2d   ! 2D workspace
214      !!----------------------------------------------------------------------
215      !
216      IF( ln_timing )  CALL timing_start('sbc_clo')
217      !
218      !                                                   !------------------!
219      IF( kt == nit000 ) THEN                             !  Initialisation  !
220         !                                                !------------------!
221         IF(lwp) WRITE(numout,*)
222         IF(lwp) WRITE(numout,*)'sbc_clo : closed seas '
223         IF(lwp) WRITE(numout,*)'~~~~~~~'
224
225         ALLOCATE( surf(jncs+1) , STAT=ierr )
226         IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'sbc_clo: failed to allocate surf array')
227         surf(:) = 0.e0_wp
228         !
229         ! jncsr can be zero so add 1 to avoid allocating zero-length array
230         ALLOCATE( surfr(jncsr+1) , STAT=ierr )
231         IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'sbc_clo: failed to allocate surfr array')
232         surfr(:) = 0.e0_wp
233         !
234         ! jncse can be zero so add 1 to avoid allocating zero-length array
235         ALLOCATE( surfe(jncse+1) , STAT=ierr )
236         IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'sbc_clo: failed to allocate surfe array')
237         surfe(:) = 0.e0_wp
238         !
239         surf(jncs+1) = glob_sum( e1e2t(:,:) )   ! surface of the global ocean
240         !
241         !                                        ! surface areas of closed seas
242         DO jc = 1, jncs
243            ztmp2d(:,:) = 0.e0_wp
244            WHERE( closea_mask(:,:) == jc ) ztmp2d(:,:) = e1e2t(:,:) * tmask_i(:,:)
245            surf(jc) = glob_sum( ztmp2d(:,:) )
246         END DO
247         !
248         ! jncs+1 : surface area of global ocean, closed seas excluded
249         surf(jncs+1) = surf(jncs+1) - SUM(surf(1:jncs))
250         !
251         !                                        ! surface areas of rnf target areas
252         IF( jncsr > 0 ) THEN
253            DO jcr = 1, jncsr
254               ztmp2d(:,:) = 0.e0_wp
255               WHERE( closea_mask_rnf(:,:) == jcr .and. closea_mask(:,:) == 0 ) ztmp2d(:,:) = e1e2t(:,:) * tmask_i(:,:)
256               surfr(jcr) = glob_sum( ztmp2d(:,:) )
257            END DO
258         ENDIF
259         !
260         !                                        ! surface areas of empmr target areas
261         IF( jncse > 0 ) THEN
262            DO jce = 1, jncse
263               ztmp2d(:,:) = 0.e0_wp
264               WHERE( closea_mask_empmr(:,:) == jce .and. closea_mask(:,:) == 0 ) ztmp2d(:,:) = e1e2t(:,:) * tmask_i(:,:)
265               surfe(jce) = glob_sum( ztmp2d(:,:) )
266            END DO
267         ENDIF
268         !
269         IF(lwp) WRITE(numout,*)'     Closed sea surface areas (km2)'
270         DO jc = 1, jncs
271            IF(lwp) WRITE(numout,FMT='(1I3,5X,ES12.2)') jc, surf(jc) * 1.0e-6
272         END DO
273         IF(lwp) WRITE(numout,FMT='(A,ES12.2)') 'Global surface area excluding closed seas (km2): ', surf(jncs+1) * 1.0e-6
274         !
275         IF(jncsr > 0) THEN
276            IF(lwp) WRITE(numout,*)'     Closed sea target rnf surface areas (km2)'
277            DO jcr = 1, jncsr
278               IF(lwp) WRITE(numout,FMT='(1I3,5X,ES12.2)') jcr, surfr(jcr) * 1.0e-6
279            END DO
280         ENDIF
281         !
282         IF(jncse > 0) THEN
283            IF(lwp) WRITE(numout,*)'     Closed sea target empmr surface areas (km2)'
284            DO jce = 1, jncse
285               IF(lwp) WRITE(numout,FMT='(1I3,5X,ES12.2)') jce, surfe(jce) * 1.0e-6
286            END DO
287         ENDIF
288      ENDIF
289      !
290      !                                                      !--------------------!
291      !                                                      !  update emp        !
292      !                                                      !--------------------!
293
294      zfwf_total = 0._wp
295
296      !
297      ! 1. Work out total freshwater fluxes over closed seas from EMP - RNF.
298      !
299      zfwf(:) = 0.e0_wp           
300      DO jc = 1, jncs
301         ztmp2d(:,:) = 0.e0_wp
302         WHERE( closea_mask(:,:) == jc ) ztmp2d(:,:) = e1e2t(:,:) * ( emp(:,:)-rnf(:,:) ) * tmask_i(:,:)
303         zfwf(jc) = glob_sum( ztmp2d(:,:) )
304      END DO
305      zfwf_total = SUM(zfwf)
306
307      zfwfr(:) = 0.e0_wp           
308      IF( jncsr > 0 ) THEN
309         !
310         ! 2. Work out total FW fluxes over rnf source areas and add to rnf target areas.
311         !    Where zfwf is negative add flux at specified runoff points and subtract from fluxes for global redistribution.
312         !    Where positive leave in global redistribution total.
313         !
314         DO jcr = 1, jncsr
315            !
316            ztmp2d(:,:) = 0.e0_wp
317            WHERE( closea_mask_rnf(:,:) == jcr .and. closea_mask(:,:) > 0 ) ztmp2d(:,:) = e1e2t(:,:) * ( emp(:,:)-rnf(:,:) ) * tmask_i(:,:)
318            zfwfr(jcr) = glob_sum( ztmp2d(:,:) )
319            !
320            ! The following if avoids the redistribution of the round off
321            IF ( ABS(zfwfr(jcr) / surf(jncs+1) ) > rsmall) THEN
322               !
323               ! Add residuals to target runoff points if negative and subtract from total to be added globally
324               IF( zfwfr(jcr) < 0.0 ) THEN
325                  zfwf_total = zfwf_total - zfwfr(jcr)
326                  zcoef    = zfwfr(jcr) / surfr(jcr)
327                  zcoef1   = rcp * zcoef
328                  WHERE( closea_mask_rnf(:,:) == jcr .and. closea_mask(:,:) == 0.0)
329                     emp(:,:) = emp(:,:) + zcoef
330                     qns(:,:) = qns(:,:) - zcoef1 * sst_m(:,:)
331                  ENDWHERE
332               ENDIF
333               !
334            ENDIF
335         END DO
336      ENDIF  ! jncsr > 0   
337      !
338      zfwfe(:) = 0.e0_wp           
339      IF( jncse > 0 ) THEN
340         !
341         ! 3. Work out total fluxes over empmr source areas and add to empmr target areas.
342         !
343         DO jce = 1, jncse
344            !
345            ztmp2d(:,:) = 0.e0_wp
346            WHERE( closea_mask_empmr(:,:) == jce .and. closea_mask(:,:) > 0 ) ztmp2d(:,:) = e1e2t(:,:) * ( emp(:,:)-rnf(:,:) ) * tmask_i(:,:)
347            zfwfe(jce) = glob_sum( ztmp2d(:,:) )
348            !
349            ! The following if avoids the redistribution of the round off
350            IF ( ABS( zfwfe(jce) / surf(jncs+1) ) > rsmall ) THEN
351               !
352               ! Add residuals to runoff points and subtract from total to be added globally
353               zfwf_total = zfwf_total - zfwfe(jce)
354               zcoef    = zfwfe(jce) / surfe(jce)
355               zcoef1   = rcp * zcoef
356               WHERE( closea_mask_empmr(:,:) == jce .and. closea_mask(:,:) == 0.0)
357                  emp(:,:) = emp(:,:) + zcoef
358                  qns(:,:) = qns(:,:) - zcoef1 * sst_m(:,:)
359               ENDWHERE
360               !
361            ENDIF
362         END DO
363      ENDIF ! jncse > 0   
364
365      !
366      ! 4. Spread residual flux over global ocean.
367      !
368      ! The following if avoids the redistribution of the round off
369      IF ( ABS(zfwf_total / surf(jncs+1) ) > rsmall) THEN
370         zcoef    = zfwf_total / surf(jncs+1)
371         zcoef1   = rcp * zcoef
372         WHERE( closea_mask(:,:) == 0 )
373            emp(:,:) = emp(:,:) + zcoef
374            qns(:,:) = qns(:,:) - zcoef1 * sst_m(:,:)
375         ENDWHERE
376      ENDIF
377
378      !
379      ! 5. Subtract area means from emp (and qns) over closed seas to give zero mean FW flux over each sea.
380      !
381      DO jc = 1, jncs
382         ! The following if avoids the redistribution of the round off
383         IF ( ABS(zfwf(jc) / surf(jncs+1) ) > rsmall) THEN
384            !
385            ! Subtract residuals from fluxes over closed sea
386            zcoef    = zfwf(jc) / surf(jc)
387            zcoef1   = rcp * zcoef
388            WHERE( closea_mask(:,:) == jc )
389               emp(:,:) = emp(:,:) - zcoef
390               qns(:,:) = qns(:,:) + zcoef1 * sst_m(:,:)
391            ENDWHERE
392            !
393         ENDIF
394      END DO
395      !
396      emp (:,:) = emp (:,:) * tmask(:,:,1)
397      !
398      CALL lbc_lnk( emp , 'T', 1._wp )
399      !
400   END SUBROUTINE sbc_clo
401
402   SUBROUTINE clo_rnf( p_rnfmsk )
403      !!---------------------------------------------------------------------
404      !!                  ***  ROUTINE sbc_rnf  ***
405      !!                   
406      !! ** Purpose :   allow the treatment of closed sea outflow grid-points
407      !!                to be the same as river mouth grid-points
408      !!
409      !! ** Method  :   set to 1 the runoff mask (mskrnf, see sbcrnf module)
410      !!                at the closed sea outflow grid-point.
411      !!
412      !! ** Action  :   update (p_)mskrnf (set 1 at closed sea outflow)
413      !!----------------------------------------------------------------------
414      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   p_rnfmsk   ! river runoff mask (rnfmsk array)
415      !!----------------------------------------------------------------------
416      !
417      IF( jncsr > 0 ) THEN
418         WHERE( closea_mask_rnf(:,:) > 0 .and. closea_mask(:,:) == 0 )
419            p_rnfmsk(:,:) = MAX( p_rnfmsk(:,:), 1.0_wp )
420         ENDWHERE
421      ENDIF
422      !
423      IF( jncse > 0 ) THEN
424         WHERE( closea_mask_empmr(:,:) > 0 .and. closea_mask(:,:) == 0 )
425            p_rnfmsk(:,:) = MAX( p_rnfmsk(:,:), 1.0_wp )
426         ENDWHERE
427      ENDIF
428      !
429   END SUBROUTINE clo_rnf
430   
431     
432   SUBROUTINE clo_bat( k_top, k_bot )
433      !!---------------------------------------------------------------------
434      !!                  ***  ROUTINE clo_bat  ***
435      !!                   
436      !! ** Purpose :   Suppress closed sea from the domain
437      !!
438      !! ** Method  :   Read in closea_mask field (if it exists) from domain_cfg file.
439      !!                Where closea_mask > 0 set first and last ocean level to 0
440      !!                (As currently coded you can't define a closea_mask field in
441      !!                usr_def_zgr).
442      !!
443      !! ** Action  :   set k_top=0 and k_bot=0 over closed seas
444      !!----------------------------------------------------------------------
445      INTEGER, DIMENSION(:,:), INTENT(inout) ::   k_top, k_bot   ! ocean first and last level indices
446      INTEGER                           :: inum, id
447      INTEGER,  DIMENSION(jpi,jpj) :: closea_mask ! closea_mask field
448      REAL(wp), DIMENSION(jpi,jpj) :: zdata_in ! temporary real array for input
449      !!----------------------------------------------------------------------
450      !
451      IF(lwp) THEN                     ! Control print
452         WRITE(numout,*)
453         WRITE(numout,*) 'clo_bat : suppression of closed seas'
454         WRITE(numout,*) '~~~~~~~'
455      ENDIF
456      !
457      IF( ln_read_cfg ) THEN
458         !
459         CALL iom_open( cn_domcfg, inum )
460         !
461         id = iom_varid(inum, 'closea_mask', ldstop = .false.)     
462         IF( id > 0 ) THEN
463            IF( lwp ) WRITE(numout,*) 'Suppressing closed seas in bathymetry based on closea_mask field,'
464            CALL iom_get ( inum, jpdom_data, 'closea_mask', zdata_in )
465            closea_mask(:,:) = NINT(zdata_in(:,:))
466            WHERE( closea_mask(:,:) > 0 )
467               k_top(:,:) = 0   
468               k_bot(:,:) = 0   
469            ENDWHERE
470         ELSE
471            IF( lwp ) WRITE(numout,*) 'No closea_mask field found in domain_cfg file. No suppression of closed seas.'
472         ENDIF
473         !
474         CALL iom_close(inum)
475         !
476      ELSE
477         IF( lwp ) WRITE(numout,*) 'No 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   END SUBROUTINE clo_bat
485
486   !!======================================================================
487END MODULE closea
488
Note: See TracBrowser for help on using the repository browser.