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_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/OPA_SRC/DOM – NEMO

source: branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90 @ 11200

Last change on this file since 11200 was 9987, checked in by emmafiedler, 6 years ago

Merge with GO6 FOAMv14 package branch r9288

File size: 23.0 KB
Line 
1MODULE closea
2   !!======================================================================
3   !!                       ***  MODULE  closea  ***
4   !! Closed Seas  : specific treatments associated with closed seas
5   !!======================================================================
6   !! History :   8.2  !  00-05  (O. Marti)  Original code
7   !!             8.5  !  02-06  (E. Durand, G. Madec)  F90
8   !!             9.0  !  06-07  (G. Madec)  add clo_rnf, clo_ups, clo_bat
9   !!        NEMO 3.4  !  03-12  (P.G. Fogli) sbc_clo bug fix & mpp reproducibility
10   !!----------------------------------------------------------------------
11
12   !!----------------------------------------------------------------------
13   !!   dom_clo    : modification of the ocean domain for closed seas cases
14   !!   sbc_clo    : Special handling of closed seas
15   !!   clo_rnf    : set close sea outflows as river mouths (see sbcrnf)
16   !!   clo_ups    : set mixed centered/upstream scheme in closed sea (see traadv_cen2)
17   !!   clo_bat    : set to zero a field over closed sea (see domzrg)
18   !!----------------------------------------------------------------------
19   USE oce             ! dynamics and tracers
20   USE dom_oce         ! ocean space and time domain
21   USE phycst          ! physical constants
22   USE in_out_manager  ! I/O manager
23   USE sbc_oce         ! ocean surface boundary conditions
24   USE lib_fortran,    ONLY: glob_sum, DDPDD
25   USE lbclnk          ! lateral boundary condition - MPP exchanges
26   USE lib_mpp         ! MPP library
27   USE timing
28
29   IMPLICIT NONE
30   PRIVATE
31
32   PUBLIC dom_clo      ! routine called by domain module
33   PUBLIC sbc_clo      ! routine called by step module
34   PUBLIC clo_rnf      ! routine called by sbcrnf module
35   PUBLIC clo_ups      ! routine called in traadv_cen2(_jki) module
36   PUBLIC clo_bat      ! routine called in domzgr module
37
38   INTEGER, PUBLIC, PARAMETER          ::   jpncs   = 10      !: number of closed sea
39   INTEGER, PUBLIC, DIMENSION(jpncs)   ::   ncstt            !: Type of closed sea
40   INTEGER, PUBLIC, DIMENSION(jpncs)   ::   ncsi1, ncsj1     !: south-west closed sea limits (i,j)
41   INTEGER, PUBLIC, DIMENSION(jpncs)   ::   ncsi2, ncsj2     !: north-east closed sea limits (i,j)
42   INTEGER, PUBLIC, DIMENSION(jpncs)   ::   ncsnr            !: number of point where run-off pours
43   INTEGER, PUBLIC, DIMENSION(jpncs,4) ::   ncsir, ncsjr     !: Location of runoff
44
45   REAL(wp), DIMENSION (jpncs+1)       ::   surf             ! closed sea surface
46
47   !! * Substitutions
48#  include "vectopt_loop_substitute.h90"
49   !!----------------------------------------------------------------------
50   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
51   !! $Id$
52   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
53   !!----------------------------------------------------------------------
54CONTAINS
55
56   SUBROUTINE dom_clo
57      !!---------------------------------------------------------------------
58      !!                  ***  ROUTINE dom_clo  ***
59      !!       
60      !! ** Purpose :   Closed sea domain initialization
61      !!
62      !! ** Method  :   if a closed sea is located only in a model grid point
63      !!                just the thermodynamic processes are applied.
64      !!
65      !! ** Action  :   ncsi1(), ncsj1() : south-west closed sea limits (i,j)
66      !!                ncsi2(), ncsj2() : north-east Closed sea limits (i,j)
67      !!                ncsir(), ncsjr() : Location of runoff
68      !!                ncsnr            : number of point where run-off pours
69      !!                ncstt            : Type of closed sea
70      !!                                   =0 spread over the world ocean
71      !!                                   =2 put at location runoff
72      !!----------------------------------------------------------------------
73      INTEGER ::   jc            ! dummy loop indices
74      INTEGER :: isrow           ! local index
75      !!----------------------------------------------------------------------
76     
77      IF(lwp) WRITE(numout,*)
78      IF(lwp) WRITE(numout,*)'dom_clo : closed seas '
79      IF(lwp) WRITE(numout,*)'~~~~~~~'
80
81      ! initial values
82      ncsnr(:) = 1  ;  ncsi1(:) = 1  ;  ncsi2(:) = 1  ;  ncsir(:,:) = 1
83      ncstt(:) = 0  ;  ncsj1(:) = 1  ;  ncsj2(:) = 1  ;  ncsjr(:,:) = 1
84
85      ! set the closed seas (in data domain indices)
86      ! -------------------
87
88      IF( cp_cfg == "orca" ) THEN
89         !
90         SELECT CASE ( jp_cfg )
91         !                                           ! =======================
92         CASE ( 1 )                                  ! ORCA_R1 configuration
93            !                                        ! =======================
94            ! This dirty section will be suppressed by simplification process:
95            ! all this will come back in input files
96            ! Currently these hard-wired indices relate to configuration with
97            ! extend grid (jpjglo=332)
98            isrow = 332 - jpjglo
99            !
100            ncsnr(1)   = 1    ; ncstt(1)   = 0           ! Caspian Sea
101            ncsi1(1)   = 332  ; ncsj1(1)   = 243 - isrow
102            ncsi2(1)   = 344  ; ncsj2(1)   = 275 - isrow
103            ncsir(1,1) = 1    ; ncsjr(1,1) = 1
104            !                                       
105            !                                        ! =======================
106         CASE ( 2 )                                  !  ORCA_R2 configuration
107            !                                        ! =======================
108            !                                            ! Caspian Sea
109            ncsnr(1)   =   1  ;  ncstt(1)   =   0           ! spread over the globe
110            ncsi1(1)   =  11  ;  ncsj1(1)   = 103
111            ncsi2(1)   =  17  ;  ncsj2(1)   = 112
112            ncsir(1,1) =   1  ;  ncsjr(1,1) =   1 
113            !                                            ! Great North American Lakes
114            ncsnr(2)   =   1  ;  ncstt(2)   =   2           ! put at St Laurent mouth
115            ncsi1(2)   =  97  ;  ncsj1(2)   = 107
116            ncsi2(2)   = 103  ;  ncsj2(2)   = 111
117            ncsir(2,1) = 110  ;  ncsjr(2,1) = 111           
118            !                                            ! Black Sea (crossed by the cyclic boundary condition)
119            ncsnr(3:4) =   4  ;  ncstt(3:4) =   2           ! put in Med Sea (north of Aegean Sea)
120            ncsir(3:4,1) = 171;  ncsjr(3:4,1) = 106         !
121            ncsir(3:4,2) = 170;  ncsjr(3:4,2) = 106 
122            ncsir(3:4,3) = 171;  ncsjr(3:4,3) = 105 
123            ncsir(3:4,4) = 170;  ncsjr(3:4,4) = 105 
124            ncsi1(3)   = 174  ;  ncsj1(3)   = 107           ! 1 : west part of the Black Sea     
125            ncsi2(3)   = 181  ;  ncsj2(3)   = 112           !            (ie west of the cyclic b.c.)
126            ncsi1(4)   =   2  ;  ncsj1(4)   = 107           ! 2 : east part of the Black Sea
127            ncsi2(4)   =   6  ;  ncsj2(4)   = 112           !           (ie east of the cyclic b.c.)
128             
129         
130
131            !                                        ! =======================
132         CASE ( 4 )                                  !  ORCA_R4 configuration
133            !                                        ! =======================
134            !                                            ! Caspian Sea
135            ncsnr(1)   =  1  ;  ncstt(1)   =  0 
136            ncsi1(1)   =  4  ;  ncsj1(1)   = 53 
137            ncsi2(1)   =  4  ;  ncsj2(1)   = 56
138            ncsir(1,1) =  1  ;  ncsjr(1,1) =  1
139            !                                            ! Great North American Lakes
140            ncsnr(2)   =  1  ;  ncstt(2)   =  2 
141            ncsi1(2)   = 49  ;  ncsj1(2)   = 55
142            ncsi2(2)   = 51  ;  ncsj2(2)   = 56
143            ncsir(2,1) = 57  ;  ncsjr(2,1) = 55
144            !                                            ! Black Sea
145            ncsnr(3)   =  4  ;  ncstt(3)   =  2 
146            ncsi1(3)   = 88  ;  ncsj1(3)   = 55 
147            ncsi2(3)   = 91  ;  ncsj2(3)   = 56
148            ncsir(3,1) = 86  ;  ncsjr(3,1) = 53
149            ncsir(3,2) = 87  ;  ncsjr(3,2) = 53 
150            ncsir(3,3) = 86  ;  ncsjr(3,3) = 52 
151            ncsir(3,4) = 87  ;  ncsjr(3,4) = 52
152            !                                            ! Baltic Sea
153            ncsnr(4)   =  1  ;  ncstt(4)   =  2
154            ncsi1(4)   = 75  ;  ncsj1(4)   = 59
155            ncsi2(4)   = 76  ;  ncsj2(4)   = 61
156            ncsir(4,1) = 84  ;  ncsjr(4,1) = 59 
157            !                                        ! ================================
158         CASE ( 025 )                                ! ORCA_R025 extended configuration
159            !                                        ! ================================
160            ncsnr(1)   = 1    ; ncstt(1)   = 0               ! Caspian sea
161            ncsi1(1)   = 1330 ; ncsj1(1)   = 831
162            ncsi2(1)   = 1375 ; ncsj2(1)   = 981
163            ncsir(1,1) = 1    ; ncsjr(1,1) = 1
164            !                                       
165            ncsnr(2)   = 1    ; ncstt(2)   = 0               ! Aral sea
166            ncsi1(2)   = 1376 ; ncsj1(2)   = 900
167            ncsi2(2)   = 1400 ; ncsj2(2)   = 981
168            ncsir(2,1) = 1    ; ncsjr(2,1) = 1
169            !                                       
170            ncsnr(3)   = 1    ; ncstt(3)   = 0               ! Azov Sea
171            ncsi1(3)   = 1284 ; ncsj1(3)   = 908
172            ncsi2(3)   = 1304 ; ncsj2(3)   = 933
173            ncsir(3,1) = 1    ; ncsjr(3,1) = 1
174            !
175            ncsnr(4)   = 1    ; ncstt(4)   = 0               ! Lake Superior 
176            ncsi1(4)   = 781  ; ncsj1(4)   = 904 
177            ncsi2(4)   = 815  ; ncsj2(4)   = 926 
178            ncsir(4,1) = 1    ; ncsjr(4,1) = 1 
179            !
180            ncsnr(5)   = 1    ; ncstt(5)   = 0               ! Lake Michigan
181            ncsi1(5)   = 795  ; ncsj1(5)   = 871             
182            ncsi2(5)   = 813  ; ncsj2(5)   = 905 
183            ncsir(5,1) = 1    ; ncsjr(5,1) = 1 
184            !
185            ncsnr(6)   = 1    ; ncstt(6)   = 0               ! Lake Huron part 1
186            ncsi1(6)   = 814  ; ncsj1(6)   = 882             
187            ncsi2(6)   = 825  ; ncsj2(6)   = 905 
188            ncsir(6,1) = 1    ; ncsjr(6,1) = 1 
189            !
190            ncsnr(7)   = 1    ; ncstt(7)   = 0               ! Lake Huron part 2
191            ncsi1(7)   = 826  ; ncsj1(7)   = 889             
192            ncsi2(7)   = 833  ; ncsj2(7)   = 905 
193            ncsir(7,1) = 1    ; ncsjr(7,1) = 1 
194            !
195            ncsnr(8)   = 1    ; ncstt(8)   = 0               ! Lake Erie
196            ncsi1(8)   = 816  ; ncsj1(8)   = 871             
197            ncsi2(8)   = 837  ; ncsj2(8)   = 881 
198            ncsir(8,1) = 1    ; ncsjr(8,1) = 1 
199            !
200            ncsnr(9)   = 1    ; ncstt(9)   = 0               ! Lake Ontario
201            ncsi1(9)   = 831  ; ncsj1(9)   = 882             
202            ncsi2(9)   = 847  ; ncsj2(9)   = 889 
203            ncsir(9,1) = 1    ; ncsjr(9,1) = 1 
204            !
205            ncsnr(10)   = 1    ; ncstt(10)   = 0               ! Lake Victoria 
206            ncsi1(10)   = 1274 ; ncsj1(10)   = 672 
207            ncsi2(10)   = 1289 ; ncsj2(10)   = 687 
208            ncsir(10,1) = 1    ; ncsjr(10,1) = 1 
209            !
210         END SELECT
211         !
212      ENDIF
213
214      ! convert the position in local domain indices
215      ! --------------------------------------------
216      DO jc = 1, jpncs
217         ncsi1(jc)   = mi0( ncsi1(jc) )
218         ncsj1(jc)   = mj0( ncsj1(jc) )
219
220         ncsi2(jc)   = mi1( ncsi2(jc) )   
221         ncsj2(jc)   = mj1( ncsj2(jc) ) 
222      END DO
223      !
224   END SUBROUTINE dom_clo
225
226
227   SUBROUTINE sbc_clo( kt )
228      !!---------------------------------------------------------------------
229      !!                  ***  ROUTINE sbc_clo  ***
230      !!                   
231      !! ** Purpose :   Special handling of closed seas
232      !!
233      !! ** Method  :   Water flux is forced to zero over closed sea
234      !!      Excess is shared between remaining ocean, or
235      !!      put as run-off in open ocean.
236      !!
237      !! ** Action  :   emp updated surface freshwater fluxes and associated heat content at kt
238      !!----------------------------------------------------------------------
239      INTEGER, INTENT(in) ::   kt   ! ocean model time step
240      !
241      INTEGER             ::   ji, jj, jc, jn   ! dummy loop indices
242      REAL(wp), PARAMETER ::   rsmall = 1.e-20_wp    ! Closed sea correction epsilon
243      REAL(wp)            ::   zze2, ztmp, zcorr     !
244      REAL(wp)            ::   zcoef, zcoef1         !
245      COMPLEX(wp)         ::   ctmp 
246      REAL(wp), DIMENSION(jpncs) ::   zfwf   ! 1D workspace
247      !!----------------------------------------------------------------------
248      !
249      IF( nn_timing == 1 )  CALL timing_start('sbc_clo')
250      !                                                   !------------------!
251      IF( kt == nit000 ) THEN                             !  Initialisation  !
252         !                                                !------------------!
253         IF(lwp) WRITE(numout,*)
254         IF(lwp) WRITE(numout,*)'sbc_clo : closed seas '
255         IF(lwp) WRITE(numout,*)'~~~~~~~'
256
257         surf(:) = 0.e0_wp
258         !
259         surf(jpncs+1) = glob_sum( e1e2t(:,:) )   ! surface of the global ocean
260         !
261         !                                        ! surface of closed seas
262         IF( lk_mpp_rep ) THEN                         ! MPP reproductible calculation
263            DO jc = 1, jpncs
264               ctmp = CMPLX( 0.e0, 0.e0, wp )
265               DO jj = ncsj1(jc), ncsj2(jc)
266                  DO ji = ncsi1(jc), ncsi2(jc)
267                     ztmp = e1e2t(ji,jj) * tmask_i(ji,jj)
268                     CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
269                  END DO
270               END DO
271               IF( lk_mpp )   CALL mpp_sum( ctmp )
272               surf(jc) = REAL(ctmp,wp)
273            END DO
274         ELSE                                          ! Standard calculation           
275            DO jc = 1, jpncs
276               DO jj = ncsj1(jc), ncsj2(jc)
277                  DO ji = ncsi1(jc), ncsi2(jc)
278                     surf(jc) = surf(jc) + e1e2t(ji,jj) * tmask_i(ji,jj)      ! surface of closed seas
279                  END DO
280               END DO
281            END DO
282            IF( lk_mpp )   CALL mpp_sum ( surf, jpncs )       ! mpp: sum over all the global domain
283         ENDIF
284
285         IF(lwp) WRITE(numout,*)'     Closed sea surfaces'
286         DO jc = 1, jpncs
287            IF(lwp)WRITE(numout,FMT='(1I3,4I4,5X,F16.2)') jc, ncsi1(jc), ncsi2(jc), ncsj1(jc), ncsj2(jc), surf(jc)
288         END DO
289
290         ! jpncs+1 : surface of sea, closed seas excluded
291         DO jc = 1, jpncs
292            surf(jpncs+1) = surf(jpncs+1) - surf(jc)
293         END DO           
294         !
295      ENDIF
296      !                                                   !--------------------!
297      !                                                   !  update emp        !
298      zfwf = 0.e0_wp                                      !--------------------!
299      IF( lk_mpp_rep ) THEN                         ! MPP reproductible calculation
300         DO jc = 1, jpncs
301            ctmp = CMPLX( 0.e0, 0.e0, wp )
302            DO jj = ncsj1(jc), ncsj2(jc)
303               DO ji = ncsi1(jc), ncsi2(jc)
304                  ztmp = e1e2t(ji,jj) * ( emp(ji,jj)-rnf(ji,jj) ) * tmask_i(ji,jj)
305                  CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
306               END DO 
307            END DO
308            IF( lk_mpp )   CALL mpp_sum( ctmp )
309            zfwf(jc) = REAL(ctmp,wp)
310         END DO
311      ELSE                                          ! Standard calculation           
312         DO jc = 1, jpncs
313            DO jj = ncsj1(jc), ncsj2(jc)
314               DO ji = ncsi1(jc), ncsi2(jc)
315                  zfwf(jc) = zfwf(jc) + e1e2t(ji,jj) * ( emp(ji,jj)-rnf(ji,jj) ) * tmask_i(ji,jj) 
316               END DO 
317            END DO
318         END DO
319         IF( lk_mpp )   CALL mpp_sum ( zfwf(:) , jpncs )       ! mpp: sum over all the global domain
320      ENDIF
321
322      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN      ! Black Sea case for ORCA_R2 configuration
323         zze2    = ( zfwf(3) + zfwf(4) ) * 0.5_wp
324         zfwf(3) = zze2
325         zfwf(4) = zze2
326      ENDIF
327
328      zcorr = 0._wp
329
330      DO jc = 1, jpncs
331         !
332         ! The following if avoids the redistribution of the round off
333         IF ( ABS(zfwf(jc) / surf(jpncs+1) ) > rsmall) THEN
334            !
335            IF( ncstt(jc) == 0 ) THEN           ! water/evap excess is shared by all open ocean
336               zcoef    = zfwf(jc) / surf(jpncs+1)
337               zcoef1   = rcp * zcoef
338               emp(:,:) = emp(:,:) + zcoef
339               qns(:,:) = qns(:,:) - zcoef1 * sst_m(:,:)
340               ! accumulate closed seas correction
341               zcorr    = zcorr    + zcoef
342               !
343            ELSEIF( ncstt(jc) == 1 ) THEN       ! Excess water in open sea, at outflow location, excess evap shared
344               IF ( zfwf(jc) <= 0.e0_wp ) THEN
345                   DO jn = 1, ncsnr(jc)
346                     ji = mi0(ncsir(jc,jn))
347                     jj = mj0(ncsjr(jc,jn)) ! Location of outflow in open ocean
348                     IF (      ji > 1 .AND. ji < jpi   &
349                         .AND. jj > 1 .AND. jj < jpj ) THEN
350                         zcoef      = zfwf(jc) / ( REAL(ncsnr(jc)) * e1e2t(ji,jj) )
351                         zcoef1     = rcp * zcoef
352                         emp(ji,jj) = emp(ji,jj) + zcoef
353                         qns(ji,jj) = qns(ji,jj) - zcoef1 * sst_m(ji,jj)
354                     ENDIF
355                   END DO
356               ELSE
357                   zcoef    = zfwf(jc) / surf(jpncs+1)
358                   zcoef1   = rcp * zcoef
359                   emp(:,:) = emp(:,:) + zcoef
360                   qns(:,:) = qns(:,:) - zcoef1 * sst_m(:,:)
361                   ! accumulate closed seas correction
362                   zcorr    = zcorr    + zcoef
363               ENDIF
364            ELSEIF( ncstt(jc) == 2 ) THEN       ! Excess e-p-r (either sign) goes to open ocean, at outflow location
365               DO jn = 1, ncsnr(jc)
366                  ji = mi0(ncsir(jc,jn))
367                  jj = mj0(ncsjr(jc,jn)) ! Location of outflow in open ocean
368                  IF(      ji > 1 .AND. ji < jpi    &
369                     .AND. jj > 1 .AND. jj < jpj ) THEN
370                     zcoef      = zfwf(jc) / ( REAL(ncsnr(jc)) *  e1e2t(ji,jj) )
371                     zcoef1     = rcp * zcoef
372                     emp(ji,jj) = emp(ji,jj) + zcoef
373                     qns(ji,jj) = qns(ji,jj) - zcoef1 * sst_m(ji,jj)
374                  ENDIF
375               END DO
376            ENDIF 
377            !
378            DO jj = ncsj1(jc), ncsj2(jc)
379               DO ji = ncsi1(jc), ncsi2(jc)
380                  zcoef      = zfwf(jc) / surf(jc)
381                  zcoef1     = rcp * zcoef
382                  emp(ji,jj) = emp(ji,jj) - zcoef
383                  qns(ji,jj) = qns(ji,jj) + zcoef1 * sst_m(ji,jj)
384               END DO 
385            END DO 
386            !
387         END IF
388      END DO
389
390      IF ( ABS(zcorr) > rsmall ) THEN      ! remove the global correction from the closed seas
391         DO jc = 1, jpncs                  ! only if it is large enough
392            DO jj = ncsj1(jc), ncsj2(jc)
393               DO ji = ncsi1(jc), ncsi2(jc)
394                  emp(ji,jj) = emp(ji,jj) - zcorr
395                  qns(ji,jj) = qns(ji,jj) + rcp * zcorr * sst_m(ji,jj)
396               END DO 
397             END DO
398          END DO
399      ENDIF
400      !
401      emp (:,:) = emp (:,:) * tmask(:,:,1)
402      !
403      CALL lbc_lnk( emp , 'T', 1._wp )
404      !
405      IF( nn_timing == 1 )  CALL timing_stop('sbc_clo')
406      !
407   END SUBROUTINE sbc_clo
408
409
410   SUBROUTINE clo_rnf( p_rnfmsk )
411      !!---------------------------------------------------------------------
412      !!                  ***  ROUTINE sbc_rnf  ***
413      !!                   
414      !! ** Purpose :   allow the treatment of closed sea outflow grid-points
415      !!                to be the same as river mouth grid-points
416      !!
417      !! ** Method  :   set to 1 the runoff mask (mskrnf, see sbcrnf module)
418      !!                at the closed sea outflow grid-point.
419      !!
420      !! ** Action  :   update (p_)mskrnf (set 1 at closed sea outflow)
421      !!----------------------------------------------------------------------
422      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   p_rnfmsk   ! river runoff mask (rnfmsk array)
423      !
424      INTEGER  ::   jc, jn, ji, jj      ! dummy loop indices
425      !!----------------------------------------------------------------------
426      !
427      DO jc = 1, jpncs
428         IF( ncstt(jc) >= 1 ) THEN            ! runoff mask set to 1 at closed sea outflows
429             DO jn = 1, 4
430                DO jj =    mj0( ncsjr(jc,jn) ), mj1( ncsjr(jc,jn) )
431                   DO ji = mi0( ncsir(jc,jn) ), mi1( ncsir(jc,jn) )
432                      p_rnfmsk(ji,jj) = MAX( p_rnfmsk(ji,jj), 1.0_wp )
433                   END DO
434                END DO
435            END DO
436         ENDIF
437      END DO 
438      !
439   END SUBROUTINE clo_rnf
440
441   
442   SUBROUTINE clo_ups( p_upsmsk )
443      !!---------------------------------------------------------------------
444      !!                  ***  ROUTINE sbc_rnf  ***
445      !!                   
446      !! ** Purpose :   allow the treatment of closed sea outflow grid-points
447      !!                to be the same as river mouth grid-points
448      !!
449      !! ** Method  :   set to 0.5 the upstream mask (upsmsk, see traadv_cen2
450      !!                module) over the closed seas.
451      !!
452      !! ** Action  :   update (p_)upsmsk (set 0.5 over closed seas)
453      !!----------------------------------------------------------------------
454      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   p_upsmsk   ! upstream mask (upsmsk array)
455      !
456      INTEGER  ::   jc, ji, jj      ! dummy loop indices
457      !!----------------------------------------------------------------------
458      !
459      DO jc = 1, jpncs
460         DO jj = ncsj1(jc), ncsj2(jc)
461            DO ji = ncsi1(jc), ncsi2(jc)
462               p_upsmsk(ji,jj) = 0.5_wp         ! mixed upstream/centered scheme over closed seas
463            END DO
464         END DO
465       END DO 
466       !
467   END SUBROUTINE clo_ups
468   
469     
470   SUBROUTINE clo_bat( pbat, kbat )
471      !!---------------------------------------------------------------------
472      !!                  ***  ROUTINE clo_bat  ***
473      !!                   
474      !! ** Purpose :   suppress closed sea from the domain
475      !!
476      !! ** Method  :   set to 0 the meter and level bathymetry (given in
477      !!                arguments) over the closed seas.
478      !!
479      !! ** Action  :   set pbat=0 and kbat=0 over closed seas
480      !!----------------------------------------------------------------------
481      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pbat   ! bathymetry in meters (bathy array)
482      INTEGER , DIMENSION(jpi,jpj), INTENT(inout) ::   kbat   ! bathymetry in levels (mbathy array)
483      !
484      INTEGER  ::   jc, ji, jj      ! dummy loop indices
485      !!----------------------------------------------------------------------
486      !
487      DO jc = 1, jpncs
488         DO jj = ncsj1(jc), ncsj2(jc)
489            DO ji = ncsi1(jc), ncsi2(jc)
490               pbat(ji,jj) = 0._wp   
491               kbat(ji,jj) = 0   
492            END DO
493         END DO
494       END DO 
495       !
496   END SUBROUTINE clo_bat
497
498   !!======================================================================
499END MODULE closea
500
Note: See TracBrowser for help on using the repository browser.