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/2019/ENHANCE-03_closea/src/OCE/DOM – NEMO

source: NEMO/branches/2019/ENHANCE-03_closea/src/OCE/DOM/closea.F90 @ 11207

Last change on this file since 11207 was 11207, checked in by mathiot, 5 years ago

ENHANCE-03_closea: closea correction change to match new closea mask in domain_cfg (ticket #2143)
  • Property svn:keywords set to Id
File size: 21.3 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   !!   sbc_clo    : Special handling of freshwater fluxes over closed seas
19   !!   clo_rnf    : set close sea outflows as river mouths (see sbcrnf)
20   !!   clo_bat    : set to zero a field over closed sea (see domzgr)
21   !!----------------------------------------------------------------------
22   USE oce             ! dynamics and tracers
23   USE dom_oce         ! ocean space and time domain
24   USE phycst          ! physical constants
25   USE sbc_oce         ! ocean surface boundary conditions
26   USE iom             ! I/O routines
27   !
28   USE in_out_manager  ! I/O manager
29   USE lib_fortran,    ONLY: glob_sum
30   USE lbclnk          ! lateral boundary condition - MPP exchanges
31   USE lib_mpp         ! MPP library
32   USE timing          ! Timing
33
34   IMPLICIT NONE
35   PRIVATE
36
37   PUBLIC dom_clo      ! called by domain module
38   PUBLIC sbc_clo_init ! called by sbcmod module
39   PUBLIC sbc_clo      ! called by sbcmod module
40   PUBLIC clo_rnf      ! called by sbcrnf module
41   PUBLIC clo_bat      ! called in domzgr module
42
43   LOGICAL, PUBLIC :: ln_maskcs  !: mask all closed sea
44   LOGICAL, PUBLIC :: ln_mask_csundef  !: mask all closed sea
45   LOGICAL, PUBLIC :: ln_clo_rnf !: closed sea treated as runoff (update rnf mask)
46
47   LOGICAL, PUBLIC :: l_sbc_clo  !: T => net evap/precip over closed seas spread outover the globe/river mouth
48   LOGICAL, PUBLIC :: l_clo_rnf  !: T => Some closed seas output freshwater (RNF) to specified runoff points.
49
50   INTEGER, PUBLIC :: jncsg      !: number of closed seas global mappings (inferred from closea_mask_glo field)
51   INTEGER, PUBLIC :: jncsr      !: number of closed seas rnf    mappings (inferred from closea_mask_rnf field)
52   INTEGER, PUBLIC :: jncse      !: number of closed seas empmr  mappings (inferred from closea_mask_emp field)
53
54   INTEGER, PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:)   :: jcsgrpg, jcsgrpr, jcsgrpe
55 
56   INTEGER, PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:) :: mask_opnsea, mask_csundef 
57 
58   INTEGER, PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:) ::  mask_csglo, mask_csgrpglo !: mask of integers defining closed seas
59   INTEGER, PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:) ::  mask_csrnf, mask_csgrprnf !: mask of integers defining closed seas rnf mappings
60   INTEGER, PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:) ::  mask_csemp, mask_csgrpemp !: mask of integers defining closed seas empmr mappings
61
62   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) :: rsurfsrcg, rsurftrgg !: closed sea target glo surface areas
63   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) :: rsurfsrcr, rsurftrgr !: closed sea target rnf surface areas
64   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) :: rsurfsrce, rsurftrge !: closed sea target emp surface areas
65
66   !! * Substitutions
67#  include "vectopt_loop_substitute.h90"
68   !!----------------------------------------------------------------------
69   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
70   !! $Id$
71   !! Software governed by the CeCILL license (see ./LICENSE)
72   !!----------------------------------------------------------------------
73CONTAINS
74
75   SUBROUTINE dom_clo()
76      !!---------------------------------------------------------------------
77      !!                  ***  ROUTINE dom_clo  ***
78      !!       
79      !! ** Purpose :   Closed sea domain initialization
80      !!
81      !! ** Method  :   if a closed sea is located only in a model grid point
82      !!                just the thermodynamic processes are applied.
83      !!
84      !! ** Action  :   Read mask_cs* fields (if needed) from domain_cfg file and infer
85      !!                number of closed seas for each case (glo, rnf, emp) from mask_cs* field.
86      !!                mask_csglo and mask_csgrpglo  : integer values defining mappings from closed seas and associated groups to the open ocean for net fluxes.
87      !!                mask_csrnf and mask_csgrprnf  : integer values defining mappings from closed seas and associated groups to a runoff area for downwards flux only.
88      !!                mask_csemp and mask_csgrpemp  : integer values defining mappings from closed seas and associated groups to a runoff area for net fluxes.
89      !!----------------------------------------------------------------------
90      INTEGER ::   ios     ! io status
91      !!
92      NAMELIST/namclo/ ln_maskcs, ln_mask_csundef, ln_clo_rnf
93      !!---------------------------------------------------------------------
94      !!
95      REWIND( numnam_ref )              ! Namelist namclo in reference namelist : Lateral momentum boundary condition
96      READ  ( numnam_ref, namclo, IOSTAT = ios, ERR = 901 )
97901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namclo in reference namelist', lwp )
98      REWIND( numnam_cfg )              ! Namelist namclo in configuration namelist : Lateral momentum boundary condition
99      READ  ( numnam_cfg, namclo, IOSTAT = ios, ERR = 902 )
100902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namclo in configuration namelist', lwp )
101      IF(lwm) WRITE ( numond, namclo )
102      !!
103      IF(lwp) WRITE(numout,*)
104      IF(lwp) WRITE(numout,*)'dom_clo : read in masks to define closed seas '
105      IF(lwp) WRITE(numout,*)'~~~~~~~'
106      !!
107      !! check option compatibility
108      IF( .NOT. ln_read_cfg ) THEN
109         CALL ctl_stop('Suppression of closed seas does not work with ln_read_cfg = .true. . Set ln_closea = .false. .')
110      ENDIF
111      !!
112      IF( (.NOT. ln_maskcs) .AND. ln_diurnal_only ) THEN
113         CALL ctl_stop('Special handling of freshwater fluxes over closed seas not compatible with ln_diurnal_only.')
114      END IF
115      !
116      l_sbc_clo = .false. ; l_clo_rnf = .false.
117      IF (.NOT. ln_maskcs)                  l_sbc_clo = .true.
118      IF (.NOT. ln_maskcs .AND. ln_clo_rnf) l_clo_rnf = .true.
119      !
120      ! read the closed seas masks (if they exist) from domain_cfg file (if it exists)
121      ! ------------------------------------------------------------------------------
122      !
123      ! load mask of open sea and undefined closed seas
124      CALL alloc_csmask( mask_opnsea )
125      CALL read_csmask( cn_domcfg, 'mask_opensea' , mask_opnsea  )
126      !
127      IF ( ln_maskcs ) THEN
128         ! not special treatment of closed sea
129         l_sbc_clo = .false. ; l_clo_rnf = .false.
130      ELSE
131         ! special treatment of closed seas
132         l_sbc_clo = .true.
133         !
134         ! river mouth from lakes added to rnf mask for special treatment
135         IF ( ln_clo_rnf) l_clo_rnf = .true.
136         !
137         IF ( ln_mask_csundef) THEN
138            ! load undef cs mask (1 in undef closed sea)
139            CALL alloc_csmask( mask_csundef )
140            CALL read_csmask( cn_domcfg, 'mask_csundef', mask_csundef )
141            ! revert the mask for masking in domzgr
142            mask_csundef = 1 - mask_csundef
143         END IF
144         !
145         ! allocate source mask
146         CALL alloc_csmask( mask_csglo )
147         CALL alloc_csmask( mask_csrnf )
148         CALL alloc_csmask( mask_csemp )
149         !
150         ! load source mask of cs for each cases
151         CALL read_csmask( cn_domcfg, 'mask_csglo', mask_csglo )
152         CALL read_csmask( cn_domcfg, 'mask_csrnf', mask_csrnf )
153         CALL read_csmask( cn_domcfg, 'mask_csemp', mask_csemp )
154         !
155         ! compute number of cs for each cases
156         jncsg = MAXVAL( mask_csglo(:,:) ) ; CALL mpp_max( 'closea', jncsg )
157         jncsr = MAXVAL( mask_csrnf(:,:) ) ; CALL mpp_max( 'closea', jncsr )
158         jncse = MAXVAL( mask_csemp(:,:) ) ; CALL mpp_max( 'closea', jncse )
159         !
160         ! allocate closed sea group masks
161         CALL alloc_csmask( mask_csgrpglo )
162         CALL alloc_csmask( mask_csgrprnf )
163         CALL alloc_csmask( mask_csgrpemp )
164
165         ! load mask of cs group for each cases
166         CALL read_csmask( cn_domcfg, 'mask_csgrpglo', mask_csgrpglo )
167         CALL read_csmask( cn_domcfg, 'mask_csgrprnf', mask_csgrprnf )
168         CALL read_csmask( cn_domcfg, 'mask_csgrpemp', mask_csgrpemp )
169         !
170         ! Allocate cs variables (surf)
171         CALL alloc_cssurf( jncsg, rsurfsrcg, rsurftrgg ) 
172         CALL alloc_cssurf( jncsr, rsurfsrcr, rsurftrgr )
173         CALL alloc_cssurf( jncse, rsurfsrce, rsurftrge )
174         !
175         ! Allocate cs group variables (jcsgrp)
176         CALL alloc_csgrp( jncsg, jcsgrpg )
177         CALL alloc_csgrp( jncsr, jcsgrpr )
178         CALL alloc_csgrp( jncse, jcsgrpe )
179         !
180      END IF
181   END SUBROUTINE dom_clo
182
183   SUBROUTINE sbc_clo_init
184
185      ! compute source surface area
186      CALL get_cssrcsurf( jncsg, mask_csglo, rsurfsrcg )
187      CALL get_cssrcsurf( jncsr, mask_csrnf, rsurfsrcr )
188      CALL get_cssrcsurf( jncse, mask_csemp, rsurfsrce )
189      !
190      ! compute target surface area and group number (jcsgrp) for all cs and cases
191      ! glo could be simpler but for lisibility, all treated the same way
192      ! It is only done once, so not a big deal
193      CALL get_cstrgsurf( jncsg, mask_csglo, mask_csgrpglo, rsurftrgg, jcsgrpg )
194      CALL get_cstrgsurf( jncsr, mask_csrnf, mask_csgrprnf, rsurftrgr, jcsgrpr )
195      CALL get_cstrgsurf( jncse, mask_csemp, mask_csgrpemp, rsurftrge, jcsgrpe )
196      !
197      ! print out in ocean.ouput
198      CALL prt_csctl( jncsg, rsurfsrcg, rsurftrgg, jcsgrpg, 'glo' )
199      CALL prt_csctl( jncsr, rsurfsrcr, rsurftrgr, jcsgrpr, 'rnf' )
200      CALL prt_csctl( jncse, rsurfsrce, rsurftrge, jcsgrpe, 'emp' )
201
202   END SUBROUTINE sbc_clo_init
203
204   SUBROUTINE get_cssrcsurf(kncs, pmaskcs, psurfsrc)
205
206      ! subroutine parameters
207      INTEGER,                 INTENT(in   ) :: kncs
208      INTEGER, DIMENSION(:,:), INTENT(in   ) :: pmaskcs
209
210      REAL(wp), DIMENSION(:)  , INTENT(inout) :: psurfsrc
211
212      ! local variables
213      INTEGER, DIMENSION(jpi,jpj) :: zmsksrc
214      INTEGER :: jcs
215
216      DO jcs = 1,kncs
217         !
218         ! build river mouth mask for this lake
219         WHERE ( pmaskcs == jcs )
220            zmsksrc = 1
221         ELSE WHERE
222            zmsksrc = 0
223         END WHERE
224         !
225         ! compute target area
226         psurfsrc(jcs) = glob_sum('closea', e1e2t(:,:) * zmsksrc(:,:) )
227         !
228      END DO
229
230   END SUBROUTINE
231
232   SUBROUTINE get_cstrgsurf(kncs, pmaskcs, pmaskcsgrp, psurftrg, kcsgrp )
233
234      ! subroutine parameters
235      INTEGER,               INTENT(in   ) :: kncs
236      INTEGER, DIMENSION(:), INTENT(inout) :: kcsgrp
237      INTEGER, DIMENSION(:,:), INTENT(in   ) :: pmaskcs, pmaskcsgrp
238
239      REAL(wp), DIMENSION(:)  , INTENT(inout) :: psurftrg
240
241      ! local variables
242      INTEGER, DIMENSION(jpi,jpj) :: zmskgrp, zmsksrc, zmsktrg
243      INTEGER :: jcs, jtmp
244
245      DO jcs = 1,kncs
246         !
247         ! find group number
248         zmskgrp = pmaskcsgrp
249         zmsksrc = pmaskcs
250         !
251         ! set value where cs is
252         zmsktrg = HUGE(1)
253         WHERE ( zmsksrc == jcs ) zmsktrg = jcs
254         !
255         ! zmsk = HUGE outside the cs number jcs
256         ! ktmp = jcs - group number
257         ! jgrp = group corresponding to the cs jcs
258         zmsktrg = zmsktrg - zmskgrp
259         jtmp = MINVAL(zmsktrg) ; CALL mpp_min('closea',jtmp)
260         kcsgrp(jcs) = jcs - jtmp
261         !
262         ! build river mouth mask for this lake
263         WHERE ( zmskgrp * mask_opnsea == kcsgrp(jcs) )
264            zmsktrg = 1
265         ELSE WHERE
266            zmsktrg = 0
267         END WHERE
268         !
269         ! compute target area
270         psurftrg(jcs) = glob_sum('closea', e1e2t(:,:) * zmsktrg(:,:) )
271         !
272      END DO
273
274   END SUBROUTINE
275
276   SUBROUTINE prt_csctl(kncs, psurfsrc, psurftrg, kcsgrp, pcstype)
277      ! subroutine parameters
278      INTEGER, INTENT(in   ) :: kncs
279      INTEGER, DIMENSION(:), INTENT(in   ) :: kcsgrp
280      !
281      REAL(wp), DIMENSION(:), INTENT(in   ) :: psurfsrc, psurftrg
282      !
283      CHARACTER(256), INTENT(in   ) :: pcstype
284      !
285      ! local variable
286      INTEGER :: jcs
287     
288      IF ( lwp .AND. kncs > 0 ) THEN
289         WRITE(numout,*)''
290         !
291         WRITE(numout,*)'Closed sea target ',TRIM(pcstype),' : '
292         !
293         DO jcs = 1,kncs
294            WRITE(numout,FMT='(3a,i3,a,i3)') ' ',TRIM(pcstype),' closed sea id is ',jcs,' and trg id is : ', kcsgrp(jcs)
295            WRITE(numout,FMT='(a,f12.2)'   ) ' src surface areas (km2) : ', psurfsrc(jcs) * 1.0e-6
296            WRITE(numout,FMT='(a,f12.2)'   ) ' trg surface areas (km2) : ', psurftrg(jcs) * 1.0e-6
297         END DO
298         !
299         WRITE(numout,*)''
300      END IF
301   END SUBROUTINE
302
303   SUBROUTINE sbc_clo( kt ) ! to be move in SBC in a file sbcclo ???
304      !!---------------------------------------------------------------------
305      !!                  ***  ROUTINE sbc_clo  ***
306      !!                   
307      !! ** Purpose :   Special handling of closed seas
308      !!
309      !! ** Method  :   Water flux is forced to zero over closed sea
310      !!      Excess is shared between remaining ocean, or
311      !!      put as run-off in open ocean.
312      !!
313      !! ** Action  :   emp updated surface freshwater fluxes and associated heat content at kt
314      !!----------------------------------------------------------------------
315      INTEGER         , INTENT(in   ) ::   kt       ! ocean model time step
316      !!----------------------------------------------------------------------
317      !
318      IF( ln_timing )  CALL timing_start('sbc_clo')
319      !
320      ! update emp and qns
321      CALL sbc_csupdate( jncsg, jcsgrpg, mask_csglo, mask_csgrpglo, rsurfsrcg, rsurftrgg, 'glo', mask_opnsea, rsurftrgg )
322      CALL sbc_csupdate( jncsr, jcsgrpr, mask_csrnf, mask_csgrprnf, rsurfsrcr, rsurftrgr, 'rnf', mask_opnsea, rsurftrgg )
323      CALL sbc_csupdate( jncse, jcsgrpe, mask_csemp, mask_csgrpemp, rsurfsrce, rsurftrge, 'emp', mask_opnsea, rsurftrgg )
324      !
325      ! is this really useful ??????
326      emp(:,:) = emp(:,:) * tmask(:,:,1)
327      qns(:,:) = qns(:,:) * tmask(:,:,1)
328      !
329      ! is this really useful ??????
330      CALL lbc_lnk( 'closea', emp , 'T', 1._wp )
331      CALL lbc_lnk( 'closea', qns , 'T', 1._wp )
332      !
333   END SUBROUTINE sbc_clo
334   
335   SUBROUTINE sbc_csupdate(kncs, kcsgrp, pmsk_src, pmsk_trg, psurfsrc, psurftrg, pcstype, pmsk_opnsea, psurf_opnsea)
336
337      ! subroutine parameters
338      INTEGER, INTENT(in   ) :: kncs
339      INTEGER, DIMENSION(:  ), INTENT(in   ) :: kcsgrp
340      INTEGER, DIMENSION(:,:), INTENT(in   ) :: pmsk_src, pmsk_trg, pmsk_opnsea
341     
342      REAL(wp), DIMENSION(:), INTENT(inout) :: psurfsrc, psurftrg, psurf_opnsea
343
344      CHARACTER(256), INTENT(in   ) :: pcstype
345
346      ! local variables
347      INTEGER :: jcs
348      INTEGER, DIMENSION(jpi,jpj) :: zmsk_src, zmsk_trg
349     
350      REAL(wp) :: zcoef, zcoef1, ztmp
351      REAL(wp) :: zcsfwf
352      REAL(wp) :: zsurftrg
353     
354      DO jcs = 1, kncs
355         !!
356         !! 0. get mask of each closed sea
357         zmsk_src(:,:) = 0
358         WHERE ( pmsk_src(:,:) == jcs ) zmsk_src = 1
359         !!
360         !! 1. Work out net freshwater fluxes over each closed seas from EMP - RNF.
361         zcsfwf = glob_sum( 'closea', e1e2t(:,:) * ( emp(:,:)-rnf(:,:) ) * zmsk_src )
362         !!
363         !! 2. Deal with runoff special case (net evaporation spread globally)
364         IF (pcstype == 'rnf' .AND. zcsfwf > 0) THEN
365            zsurftrg = psurf_opnsea(1)
366            zmsk_trg = pmsk_opnsea
367         ELSE
368            zsurftrg = psurftrg(jcs)
369            zmsk_trg = pmsk_trg
370         END IF
371         zmsk_trg = zmsk_trg * pmsk_opnsea
372         !!
373         !! 3. Add residuals to target points
374         zcoef    = zcsfwf / zsurftrg
375         zcoef1   = rcp * zcoef
376         WHERE( zmsk_trg(:,:) == kcsgrp(jcs) )
377            emp(:,:) = emp(:,:) + zcoef
378            qns(:,:) = qns(:,:) - zcoef1 * sst_m(:,:)
379         ENDWHERE
380         !!
381         !! 4. Subtract residuals from source points
382         zcoef    = zcsfwf / psurfsrc(jcs)
383         zcoef1   = rcp * zcoef
384         WHERE( pmsk_src(:,:) == jcs )
385            emp(:,:) = emp(:,:) - zcoef
386            qns(:,:) = qns(:,:) + zcoef1 * sst_m(:,:)
387         ENDWHERE
388         !!
389      END DO ! jcs
390
391   END SUBROUTINE
392
393
394   SUBROUTINE clo_rnf( p_rnfmsk )
395      !!---------------------------------------------------------------------
396      !!                  ***  ROUTINE clo_rnf  ***
397      !!                   
398      !! ** Purpose :   allow the treatment of closed sea outflow grid-points
399      !!                to be the same as river mouth grid-points
400      !!
401      !! ** Method  :   set to 1 the runoff mask (mskrnf, see sbcrnf module)
402      !!                at the closed sea outflow grid-point.
403      !!
404      !! ** Action  :   update (p_)mskrnf (set 1 at closed sea outflow)
405      !!----------------------------------------------------------------------
406      !!
407      !! subroutine parameter
408      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   p_rnfmsk   ! river runoff mask (rnfmsk array)
409      !!
410      !! local variables
411      REAL(wp), DIMENSION(jpi,jpj) :: zmsk
412      !!----------------------------------------------------------------------
413      !
414      ! zmsk > 0 where cs river mouth defined (case rnf and emp)
415      zmsk(:,:) = ( mask_csgrprnf (:,:) + mask_csgrpemp(:,:) ) * mask_opnsea(:,:)
416      WHERE( zmsk(:,:) > 0 )
417         p_rnfmsk(:,:) = 1.0_wp
418      END WHERE
419      !
420   END SUBROUTINE clo_rnf
421     
422   SUBROUTINE clo_bat( k_top, k_bot, p_mask, p_prt )
423      !!---------------------------------------------------------------------
424      !!                  ***  ROUTINE clo_bat  ***
425      !!                   
426      !! ** Purpose :   Suppress closed sea from the domain
427      !!
428      !! ** Method  :   Read in closea_mask field (if it exists) from domain_cfg file.
429      !!                Where closea_mask > 0 set first and last ocean level to 0
430      !!                (As currently coded you can't define a closea_mask field in
431      !!                usr_def_zgr).
432      !!
433      !! ** Action  :   set k_top=0 and k_bot=0 over closed seas
434      !!----------------------------------------------------------------------
435      !!
436      !! subroutine parameter
437      INTEGER, DIMENSION(:,:), INTENT(inout) ::   k_top, k_bot   ! ocean first and last level indices
438      INTEGER, DIMENSION(:,:), INTENT(in   ) ::   p_mask         ! mask used to mask ktop and k_bot
439      CHARACTER(256),          INTENT(in   ) ::   p_prt          ! text for control print
440      !!
441      !! local variables
442      !!----------------------------------------------------------------------
443      !!
444      IF ( lwp ) THEN
445         WRITE(numout,*)
446         WRITE(numout,*) 'clo_bat : Suppression closed seas based on ',TRIM(p_prt),' field.'
447         WRITE(numout,*) '~~~~~~~'
448         WRITE(numout,*)
449      ENDIF
450      !!
451      k_top(:,:) = k_top(:,:) * p_mask(:,:)
452      k_bot(:,:) = k_bot(:,:) * p_mask(:,:)
453      !!
454   END SUBROUTINE clo_bat
455
456   SUBROUTINE read_csmask(p_file, p_var, p_mskout)
457      !
458      ! subroutine parameter
459      CHARACTER(256), INTENT(in   ) :: p_file, p_var
460      INTEGER, DIMENSION(:,:), INTENT(inout) :: p_mskout
461      !
462      ! local variables
463      INTEGER :: ics
464      REAL(wp), DIMENSION(jpi,jpj) :: zdta
465      !
466      CALL iom_open ( p_file, ics )
467      CALL iom_get  ( ics, jpdom_data, TRIM(p_var), zdta )
468      CALL iom_close( ics )
469      p_mskout(:,:) = NINT(zdta(:,:))
470      !
471   END SUBROUTINE read_csmask
472
473   SUBROUTINE alloc_csmask( pmask )
474      !
475      ! subroutine parameter
476      INTEGER, ALLOCATABLE, DIMENSION(:,:), INTENT(inout) :: pmask
477      !
478      ! local variables
479      INTEGER :: ierr
480      !
481      ALLOCATE( pmask(jpi,jpj) , STAT=ierr )
482      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'alloc_csmask: failed to allocate surf array')
483      !
484   END SUBROUTINE
485
486
487   SUBROUTINE alloc_cssurf( klen, pvarsrc, pvartrg )
488      !
489      ! subroutine parameter
490      INTEGER, INTENT(in) :: klen
491      REAL(wp), ALLOCATABLE, DIMENSION(:), INTENT(inout) :: pvarsrc, pvartrg 
492      !
493      ! local variables
494      INTEGER :: ierr
495      !
496      ! klen (number of lake) can be zero so use MAX(klen,1) to avoid 0 length array
497      ALLOCATE( pvarsrc(MAX(klen,1)) , pvartrg(MAX(klen,1)) , STAT=ierr )
498      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'sbc_clo: failed to allocate surf array')
499      ! initialise to 0
500      pvarsrc(:) = 0.e0_wp
501      pvartrg(:) = 0.e0_wp
502   END SUBROUTINE
503
504   SUBROUTINE alloc_csgrp( klen, kvar )
505      !
506      ! subroutine parameter
507      INTEGER, INTENT(in) :: klen
508      INTEGER, ALLOCATABLE, DIMENSION(:), INTENT(inout) :: kvar 
509      !
510      ! local variables
511      INTEGER :: ierr
512      !
513      ! klen (number of lake) can be zero so use MAX(klen,1) to avoid 0 length array
514      ALLOCATE( kvar(MAX(klen,1)) , STAT=ierr )
515      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'sbc_clo: failed to allocate group array')
516      ! initialise to 0
517      kvar(:) = 0
518   END SUBROUTINE
519
520   !!======================================================================
521END MODULE closea
522
Note: See TracBrowser for help on using the repository browser.