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 NEMO/branches/2020/dev_12905_xios_ancil/src/OCE/DOM – NEMO

source: NEMO/branches/2020/dev_12905_xios_ancil/src/OCE/DOM/closea.F90 @ 13016

Last change on this file since 13016 was 13016, checked in by andmirek, 4 years ago

Ticket #2475 implementation of new interface
  • Property svn:keywords set to Id
File size: 12.8 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   !!             4.1  !  2019-07  (P. Mathiot) update to the new domcfg.nc input file
14   !!----------------------------------------------------------------------
15
16   !!----------------------------------------------------------------------
17   !!   dom_clo    : read in masks which define closed seas and runoff areas
18   !!   clo_rnf    : set close sea outflows as river mouths (see sbcrnf)
19   !!   clo_msk    : set to zero a field over closed sea (see domzgr)
20   !!----------------------------------------------------------------------
21   USE in_out_manager  ! I/O manager
22   USE iom_def
23   !
24   USE diu_bulk    , ONLY: ln_diurnal_only            ! used for sanity check
25   USE iom         , ONLY: iom_open, iom_get, iom_close, jpdom_data, iom_swap ! I/O routines
26   USE lib_fortran , ONLY: glob_sum                   ! fortran library
27   USE lib_mpp     , ONLY: mpp_max, ctl_nam, ctl_stop ! MPP library
28
29   IMPLICIT NONE
30
31   PRIVATE
32
33   PUBLIC dom_clo      ! called by domain module
34   PUBLIC clo_rnf      ! called by sbcrnf module
35   PUBLIC clo_msk      ! called in domzgr module
36
37   LOGICAL, PUBLIC :: ln_maskcs        !: logical to mask all closed sea
38   LOGICAL, PUBLIC :: ln_mask_csundef  !: logical to mask all undefined closed sea
39   LOGICAL, PUBLIC :: ln_clo_rnf       !: closed sea treated as runoff (update rnf mask)
40
41   LOGICAL, PUBLIC :: l_sbc_clo  !: T => net evap/precip over closed seas spread outover the globe/river mouth
42   LOGICAL, PUBLIC :: l_clo_rnf  !: T => Some closed seas output freshwater (RNF) to specified runoff points.
43
44   INTEGER, PUBLIC :: ncsg      !: number of closed seas global mappings (inferred from closea_mask_glo field)
45   INTEGER, PUBLIC :: ncsr      !: number of closed seas rnf    mappings (inferred from closea_mask_rnf field)
46   INTEGER, PUBLIC :: ncse      !: number of closed seas empmr  mappings (inferred from closea_mask_emp field)
47
48   INTEGER, PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:) :: mask_opnsea, mask_csundef  !: mask defining the open sea and the undefined closed sea
49 
50   INTEGER, PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:) :: mask_csglo , mask_csgrpglo !: mask of integers defining closed seas
51   INTEGER, PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:) :: mask_csrnf , mask_csgrprnf !: mask of integers defining closed seas rnf mappings
52   INTEGER, PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:) :: mask_csemp , mask_csgrpemp !: mask of integers defining closed seas empmr mappings
53
54   !!----------------------------------------------------------------------
55   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
56   !! $Id$
57   !! Software governed by the CeCILL license (see ./LICENSE)
58   !!----------------------------------------------------------------------
59CONTAINS
60
61   SUBROUTINE dom_clo()
62      !!---------------------------------------------------------------------
63      !!                  ***  ROUTINE dom_clo  ***
64      !!       
65      !! ** Purpose :   Closed sea domain initialization
66      !!
67      !! ** Action  :   Read mask_cs* fields (if needed) from domain_cfg file and infer
68      !!                number of closed seas for each case (glo, rnf, emp) from mask_cs* field.
69      !!
70      !! ** Output  :   mask_csglo and mask_csgrpglo  : integer values defining mappings from closed seas and associated groups to the open ocean for net fluxes.
71      !!                mask_csrnf and mask_csgrprnf  : integer values defining mappings from closed seas and associated groups to a runoff area for downwards flux only.
72      !!                mask_csemp and mask_csgrpemp  : integer values defining mappings from closed seas and associated groups to a runoff area for net fluxes.
73      !!----------------------------------------------------------------------
74      INTEGER ::   ios     ! io status
75      !!
76      NAMELIST/namclo/ ln_maskcs, ln_mask_csundef, ln_clo_rnf
77      !!---------------------------------------------------------------------
78      !!
79      READ  ( numnam_ref, namclo, IOSTAT = ios, ERR = 901 )
80901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namclo in reference namelist' )
81      READ  ( numnam_cfg, namclo, IOSTAT = ios, ERR = 902 )
82902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namclo in configuration namelist' )
83      IF(lwm) WRITE ( numond, namclo )
84      !!
85      IF(lwp) WRITE(numout,*)
86      IF(lwp) WRITE(numout,*)'dom_clo : read in masks to define closed seas '
87      IF(lwp) WRITE(numout,*)'~~~~~~~'
88      IF(lwp) WRITE(numout,*)
89      !!
90      !! check option compatibility
91      IF( .NOT. ln_read_cfg ) THEN
92         CALL ctl_stop('Suppression of closed seas does not work with ln_read_cfg = .true. . Set ln_closea = .false. .')
93      ENDIF
94      !!
95      IF( (.NOT. ln_maskcs) .AND. ln_diurnal_only ) THEN
96         CALL ctl_stop('Special handling of freshwater fluxes over closed seas not compatible with ln_diurnal_only.')
97      END IF
98      !
99      ! read the closed seas masks (if they exist) from domain_cfg file (if it exists)
100      ! ------------------------------------------------------------------------------
101      !
102      ! load mask of open sea
103      CALL alloc_csmask( mask_opnsea )
104      CALL read_csmask( cn_domcfg, 'mask_opensea' , mask_opnsea  )
105      !
106      IF ( ln_maskcs ) THEN
107         ! closed sea are masked
108         IF(lwp) WRITE(numout,*)'          ln_maskcs = T : all closed seas are masked'
109         IF(lwp) WRITE(numout,*)
110         ! no special treatment of closed sea
111         ! no redistribution of emp unbalance over closed sea into river mouth/open ocean
112         l_sbc_clo = .false. ; l_clo_rnf = .false.
113      ELSE
114         ! redistribution of emp unbalance over closed sea into river mouth/open ocean
115         IF(lwp) WRITE(numout,*)'          ln_maskcs = F : net emp is corrected over defined closed seas'
116         !
117         l_sbc_clo = .true.
118         !
119         ! river mouth from lakes added to rnf mask for special treatment
120         IF ( ln_clo_rnf) l_clo_rnf = .true.
121         !
122         IF ( ln_mask_csundef) THEN
123            ! closed sea not defined (ie not in the domcfg namelist used to build the domcfg.nc file) are masked
124            IF(lwp) WRITE(numout,*)'          ln_mask_csundef = T : all undefined closed seas are masked'
125            !
126            CALL alloc_csmask( mask_csundef )
127            CALL read_csmask( cn_domcfg, 'mask_csundef', mask_csundef )
128            ! revert the mask for masking of undefined closed seas in domzgr
129            ! (0 over the undefined closed sea and 1 elsewhere)
130            mask_csundef(:,:) = 1 - mask_csundef(:,:)
131         END IF
132         IF(lwp) WRITE(numout,*)
133         !
134         ! allocate source mask for each cases
135         CALL alloc_csmask( mask_csglo )
136         CALL alloc_csmask( mask_csrnf )
137         CALL alloc_csmask( mask_csemp )
138         !
139         ! load source mask of cs for each cases
140         CALL read_csmask( cn_domcfg, 'mask_csglo', mask_csglo )
141         CALL read_csmask( cn_domcfg, 'mask_csrnf', mask_csrnf )
142         CALL read_csmask( cn_domcfg, 'mask_csemp', mask_csemp )
143         !
144         ! compute number of cs for each cases
145         ncsg = MAXVAL( mask_csglo(:,:) ) ; CALL mpp_max( 'closea', ncsg )
146         ncsr = MAXVAL( mask_csrnf(:,:) ) ; CALL mpp_max( 'closea', ncsr )
147         ncse = MAXVAL( mask_csemp(:,:) ) ; CALL mpp_max( 'closea', ncse )
148         !
149         ! allocate closed sea group masks
150         !(used to defined the target area in case multiple lakes have the same river mouth (great lakes for example))
151         CALL alloc_csmask( mask_csgrpglo )
152         CALL alloc_csmask( mask_csgrprnf )
153         CALL alloc_csmask( mask_csgrpemp )
154
155         ! load mask of cs group for each cases
156         CALL read_csmask( cn_domcfg, 'mask_csgrpglo', mask_csgrpglo )
157         CALL read_csmask( cn_domcfg, 'mask_csgrprnf', mask_csgrprnf )
158         CALL read_csmask( cn_domcfg, 'mask_csgrpemp', mask_csgrpemp )
159         !
160      END IF
161   END SUBROUTINE dom_clo
162
163   SUBROUTINE clo_rnf( p_rnfmsk )
164      !!---------------------------------------------------------------------
165      !!                  ***  ROUTINE clo_rnf  ***
166      !!                   
167      !! ** Purpose :   allow the treatment of closed sea outflow grid-points
168      !!                to be the same as river mouth grid-points
169      !!
170      !! ** Method  :   set to 1 the runoff mask (mskrnf, see sbcrnf module)
171      !!                at the closed sea outflow grid-point.
172      !!
173      !! ** Action  :   update (p_)mskrnf (set 1 at closed sea outflow)
174      !!----------------------------------------------------------------------
175      !! subroutine parameter
176      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   p_rnfmsk   ! river runoff mask (rnfmsk array)
177      !!
178      !! local variables
179      REAL(wp), DIMENSION(jpi,jpj) :: zmsk
180      !!----------------------------------------------------------------------
181      !
182      ! zmsk > 0 where cs river mouth defined (case rnf and emp)
183      zmsk(:,:) = ( mask_csgrprnf (:,:) + mask_csgrpemp(:,:) ) * mask_opnsea(:,:)
184      WHERE( zmsk(:,:) > 0 )
185         p_rnfmsk(:,:) = 1.0_wp
186      END WHERE
187      !
188   END SUBROUTINE clo_rnf
189     
190   SUBROUTINE clo_msk( k_top, k_bot, k_mask, cd_prt )
191      !!---------------------------------------------------------------------
192      !!                  ***  ROUTINE clo_msk  ***
193      !!                   
194      !! ** Purpose :   Suppress closed sea from the domain
195      !!
196      !! ** Method  :   Where closea_mask > 0 set first and last ocean level to 0
197      !!                (As currently coded you can't define a closea_mask field in
198      !!                usr_def_zgr).
199      !!
200      !! ** Action  :   set k_top=0 and k_bot=0 over closed seas
201      !!----------------------------------------------------------------------
202      !! subroutine parameter
203      INTEGER, DIMENSION(:,:), INTENT(inout) ::   k_top, k_bot   ! ocean first and last level indices
204      INTEGER, DIMENSION(:,:), INTENT(in   ) ::   k_mask         ! mask used to mask ktop and k_bot
205      CHARACTER(LEN=*),        INTENT(in   ) ::   cd_prt         ! text for control print
206      !!
207      !! local variables
208      !!----------------------------------------------------------------------
209      !!
210      IF ( lwp ) THEN
211         WRITE(numout,*)
212         WRITE(numout,*) 'clo_msk : Suppression closed seas based on ',TRIM(cd_prt),' field.'
213         WRITE(numout,*) '~~~~~~~'
214         WRITE(numout,*)
215      ENDIF
216      !!
217      k_top(:,:) = k_top(:,:) * k_mask(:,:)
218      k_bot(:,:) = k_bot(:,:) * k_mask(:,:)
219      !!
220   END SUBROUTINE clo_msk
221
222   SUBROUTINE read_csmask(cd_file, cd_var, k_mskout)
223      !!---------------------------------------------------------------------
224      !!                  ***  ROUTINE read_csmask  ***
225      !!                   
226      !! ** Purpose : read mask in cd_filec file
227      !!----------------------------------------------------------------------
228      ! subroutine parameter
229      CHARACTER(LEN=256),          INTENT(in   ) :: cd_file    ! netcdf file     name
230      CHARACTER(LEN= * ),          INTENT(in   ) :: cd_var     ! netcdf variable name
231      INTEGER, DIMENSION(:,:), INTENT(  out) :: k_mskout            ! output mask variable
232      !
233      ! local variables
234      INTEGER :: ics                       ! netcdf id
235      REAL(wp), DIMENSION(jpi,jpj) :: zdta ! netcdf data
236      !!----------------------------------------------------------------------
237      !
238      IF(lcfg_xios) CALL iom_swap("dom_context")
239
240      CALL iom_open ( cd_file, ics )
241      CALL iom_get  ( ics, jpdom_data, TRIM(cd_var), zdta,  ldxios = lcfg_xios )
242
243      CALL iom_close( ics )
244      k_mskout(:,:) = NINT(zdta(:,:))
245      !
246   END SUBROUTINE read_csmask
247
248   SUBROUTINE alloc_csmask( kmask )
249      !!---------------------------------------------------------------------
250      !!                  ***  ROUTINE alloc_csmask  ***
251      !!                   
252      !! ** Purpose : allocated cs mask
253      !!----------------------------------------------------------------------
254      ! subroutine parameter
255      INTEGER, ALLOCATABLE, DIMENSION(:,:), INTENT(inout) :: kmask
256      !
257      ! local variables
258      INTEGER :: ierr
259      !!----------------------------------------------------------------------
260      !
261      ALLOCATE( kmask(jpi,jpj) , STAT=ierr )
262      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'alloc_csmask: failed to allocate surf array')
263      !
264   END SUBROUTINE
265
266END MODULE closea
Note: See TracBrowser for help on using the repository browser.