source: CONFIG/UNIFORM/v6/IPSLCM6/SOURCES/NEMO/closea.F90 @ 2485

Last change on this file since 2485 was 2485, checked in by omamce, 6 years ago

O.M. : handling old ORCA1 and extended ORCA1 grids

in closea.F90

File size: 22.7 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 iom             ! I/O manager library
24   USE sbc_oce         ! ocean surface boundary conditions
25   USE lib_fortran,    ONLY: glob_sum, DDPDD
26   USE lbclnk          ! lateral boundary condition - MPP exchanges
27   USE lib_mpp         ! MPP library
28   USE timing
29
30   IMPLICIT NONE
31   PRIVATE
32
33   PUBLIC dom_clo      ! routine called by domain module
34   PUBLIC sbc_clo      ! routine called by step module
35   PUBLIC clo_rnf      ! routine called by sbcrnf module
36   PUBLIC clo_ups      ! routine called in traadv_cen2(_jki) module
37   PUBLIC clo_bat      ! routine called in domzgr module
38
39   INTEGER, PUBLIC, PARAMETER          ::   jpncs   = 4      !: number of closed sea
40   INTEGER, PUBLIC, DIMENSION(jpncs)   ::   ncstt            !: Type of closed sea
41   INTEGER, PUBLIC, DIMENSION(jpncs)   ::   ncsi1, ncsj1     !: south-west closed sea limits (i,j)
42   INTEGER, PUBLIC, DIMENSION(jpncs)   ::   ncsi2, ncsj2     !: north-east closed sea limits (i,j)
43   INTEGER, PUBLIC, DIMENSION(jpncs)   ::   ncsnr            !: number of point where run-off pours
44   INTEGER, PUBLIC, DIMENSION(jpncs,4) ::   ncsir, ncsjr     !: Location of runoff
45
46   REAL(wp), DIMENSION (:,:), ALLOCATABLE :: clo_mask        !: Defines area where excess run-off is distributed
47
48   REAL(wp), DIMENSION (jpncs+1)       ::   surf             !: Closed sea surface
49
50   INTEGER :: dia_closea_alloc
51
52   !! * Substitutions
53#  include "vectopt_loop_substitute.h90"
54   !!----------------------------------------------------------------------
55   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
56   !! $Id: closea.F90 4162 2013-11-07 10:19:49Z cetlod $
57   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
58   !!----------------------------------------------------------------------
59CONTAINS
60
61   SUBROUTINE dom_clo
62      !!---------------------------------------------------------------------
63      !!                  ***  ROUTINE dom_clo  ***
64      !!       
65      !! ** Purpose :   Closed sea domain initialization
66      !!
67      !! ** Method  :   if a closed sea is located only in a model grid point
68      !!                just the thermodynamic processes are applied.
69      !!
70      !! ** Action  :   ncsi1(), ncsj1() : south-west closed sea limits (i,j)
71      !!                ncsi2(), ncsj2() : north-east Closed sea limits (i,j)
72      !!                ncsir(), ncsjr() : Location of runoff
73      !!                ncsnr            : number of point where run-off pours
74      !!                ncstt            : Type of closed sea
75      !!                                   =0 spread over the world ocean
76      !!                                   =2 put at location runoff
77      !!----------------------------------------------------------------------
78      INTEGER ::   jc               ! dummy loop indices
79      REAL(wp)::   ztmp
80      INTEGER ::   isrow
81      !!----------------------------------------------------------------------
82     
83      IF(lwp) WRITE(numout,*)
84      IF(lwp) WRITE(numout,*)'dom_clo : closed seas '
85      IF(lwp) WRITE(numout,*)'~~~~~~~'
86
87      ! Initial values
88      ncsnr(:) = 1  ;  ncsi1(:) = 1  ;  ncsi2(:) = 1  ;  ncsir(:,:) = 1
89      ncstt(:) = 0  ;  ncsj1(:) = 1  ;  ncsj2(:) = 1  ;  ncsjr(:,:) = 1
90
91      ! set the closed seas (in data domain indices)
92      ! -------------------
93
94      IF( cp_cfg == "orca" ) THEN
95         !
96         SELECT CASE ( jp_cfg )
97         !                                           ! =======================
98         CASE ( 1 )                                  ! ORCA_R1 configuration
99            !
100            !! This dirty section will be suppressed by simplification process: all this will come back in input files
101            !! Currently these hard-wired indices relate to the original (pre-v3.6) configuration which had a grid-size of 362x292.
102            !! This grid has been extended southwards for use with the under ice-shelf options (isf) introduced in v3.6. The original
103            !! domain can still be used optionally if the isf code is not activated. An adjustment (isrow) is made to the hard-wired
104            !! indices if the extended domain (362x332) is being used.
105            !! =======================
106            IF     ( jpjglo == 292 ) THEN  !  ORCA1 R1 ­ Using pre-v3.6 files or adjusted start row from isf-extended grid
107               isrow = 0
108            ELSEIF ( jpjglo == 332 ) THEN  !  ORCA1 R1 - Using full isf­extended domain.
109               isrow = 40                  !    - Adjust j­indices to account for more southerly starting latitude
110            ENDIF
111           
112            ncsnr(1)   = 1    ; ncstt(1)   = 0           ! Caspian Sea
113            ncsi1(1)   = 332  ; ncsj1(1)   = 203 + isrow   ! spread over the globe
114            ncsi2(1)   = 344  ; ncsj2(1)   = 235 + isrow
115            ncsir(1,1) = 1    ; ncsjr(1,1) = 1
116            !
117            ncsnr(2)   = 4    ; ncstt(2)   = 2           ! Great North American Lakes
118            ncsi1(2)   = 198  ; ncsj1(2)   = 209 + isrow   ! put at St Laurent mouth
119            ncsi2(2)   = 213  ; ncsj2(2)   = 223 + isrow
120            ncsir(1,2) = 225  ; ncsjr(1,2) = 220 + isrow
121            ncsir(1,2) = 225  ; ncsjr(1,2) = 221 + isrow
122            ncsir(1,2) = 226  ; ncsjr(1,2) = 220 + isrow
123            ncsir(1,2) = 226  ; ncsjr(1,2) = 221 + isrow
124
125            !                                       
126            !                                        ! =======================
127         CASE ( 2 )                                  !  ORCA_R2 configuration
128            !                                        ! =======================
129            !                                            ! Caspian Sea
130            ncsnr(1)   =   1  ;  ncstt(1)   =   0           ! spread over the globe
131            ncsi1(1)   =  11  ;  ncsj1(1)   = 103
132            ncsi2(1)   =  17  ;  ncsj2(1)   = 112
133            ncsir(1,1) =   1  ;  ncsjr(1,1) =   1 
134            !                                            ! Great North American Lakes
135            ncsnr(2)   =   1  ;  ncstt(2)   =   2           ! put at St Laurent mouth
136            ncsi1(2)   =  97  ;  ncsj1(2)   = 107
137            ncsi2(2)   = 103  ;  ncsj2(2)   = 111
138            ncsir(2,1) = 110  ;  ncsjr(2,1) = 111           
139            !                                            ! Black Sea (crossed by the cyclic boundary condition)
140            ncsnr(3:4) =   4  ;  ncstt(3:4) =   2           ! put in Med Sea (north of Aegean Sea)
141            ncsir(3:4,1) = 171;  ncsjr(3:4,1) = 106         !
142            ncsir(3:4,2) = 170;  ncsjr(3:4,2) = 106 
143            ncsir(3:4,3) = 171;  ncsjr(3:4,3) = 105 
144            ncsir(3:4,4) = 170;  ncsjr(3:4,4) = 105 
145            ncsi1(3)   = 174  ;  ncsj1(3)   = 107           ! 1 : west part of the Black Sea     
146            ncsi2(3)   = 181  ;  ncsj2(3)   = 112           !            (ie west of the cyclic b.c.)
147            ncsi1(4)   =   2  ;  ncsj1(4)   = 107           ! 2 : east part of the Black Sea
148            ncsi2(4)   =   6  ;  ncsj2(4)   = 112           !           (ie east of the cyclic b.c.)
149             
150         
151
152            !                                        ! =======================
153         CASE ( 4 )                                  !  ORCA_R4 configuration
154            !                                        ! =======================
155            !                                            ! Caspian Sea
156            ncsnr(1)   =  1  ;  ncstt(1)   =  0 
157            ncsi1(1)   =  4  ;  ncsj1(1)   = 53 
158            ncsi2(1)   =  4  ;  ncsj2(1)   = 56
159            ncsir(1,1) =  1  ;  ncsjr(1,1) =  1
160            !                                            ! Great North American Lakes
161            ncsnr(2)   =  1  ;  ncstt(2)   =  2 
162            ncsi1(2)   = 49  ;  ncsj1(2)   = 55
163            ncsi2(2)   = 51  ;  ncsj2(2)   = 56
164            ncsir(2,1) = 57  ;  ncsjr(2,1) = 55
165            !                                            ! Black Sea
166            ncsnr(3)   =  4  ;  ncstt(3)   =  2 
167            ncsi1(3)   = 88  ;  ncsj1(3)   = 55 
168            ncsi2(3)   = 91  ;  ncsj2(3)   = 56
169            ncsir(3,1) = 86  ;  ncsjr(3,1) = 53
170            ncsir(3,2) = 87  ;  ncsjr(3,2) = 53 
171            ncsir(3,3) = 86  ;  ncsjr(3,3) = 52 
172            ncsir(3,4) = 87  ;  ncsjr(3,4) = 52
173            !                                            ! Baltic Sea
174            ncsnr(4)   =  1  ;  ncstt(4)   =  2
175            ncsi1(4)   = 75  ;  ncsj1(4)   = 59
176            ncsi2(4)   = 76  ;  ncsj2(4)   = 61
177            ncsir(4,1) = 84  ;  ncsjr(4,1) = 59 
178            !                                        ! =======================
179         CASE ( 025 )                                ! ORCA_R025 configuration
180            !                                        ! =======================
181            ncsnr(1)   = 1    ; ncstt(1)   = 0               ! Caspian + Aral sea
182            ncsi1(1)   = 1330 ; ncsj1(1)   = 645
183            ncsi2(1)   = 1400 ; ncsj2(1)   = 795
184            ncsir(1,1) = 1    ; ncsjr(1,1) = 1
185            !                                       
186            ncsnr(2)   = 1    ; ncstt(2)   = 0               ! Azov Sea
187            ncsi1(2)   = 1284 ; ncsj1(2)   = 722
188            ncsi2(2)   = 1304 ; ncsj2(2)   = 747
189            ncsir(2,1) = 1    ; ncsjr(2,1) = 1
190            !
191         END SELECT
192         !
193      ENDIF
194
195      ! convert the position in local domain indices
196      ! --------------------------------------------
197      DO jc = 1, jpncs
198         ncsi1(jc)   = mi0( ncsi1(jc) )
199         ncsj1(jc)   = mj0( ncsj1(jc) )
200
201         ncsi2(jc)   = mi1( ncsi2(jc) )   
202         ncsj2(jc)   = mj1( ncsj2(jc) ) 
203      END DO
204
205      !
206   END SUBROUTINE dom_clo
207
208
209   SUBROUTINE sbc_clo( kt )
210      !!---------------------------------------------------------------------
211      !!                  ***  ROUTINE sbc_clo  ***
212      !!                   
213      !! ** Purpose :   Special handling of closed seas
214      !!
215      !! ** Method  :   Water flux is forced to zero over closed sea
216      !!      Excess is shared between remaining ocean, or
217      !!      put as run-off in open ocean.
218      !!
219      !! ** Action  :   emp updated surface freshwater fluxes and associated heat content at kt
220      !!----------------------------------------------------------------------
221      INTEGER, INTENT(in) ::   kt   ! ocean model time step
222      !
223      INTEGER             ::   ji, jj, jc, jn   ! dummy loop indices
224      REAL(wp), PARAMETER ::   rsmall = 1.e-20_wp    ! Closed sea correction epsilon
225      REAL(wp)            ::   zze2, ztmp, zcorr     !
226      REAL(wp)            ::   zcoef, zcoef1         !
227      COMPLEX(wp)         ::   ctmp 
228      REAL(wp), DIMENSION(jpncs) ::   zfwf   ! 1D workspace
229      !!----------------------------------------------------------------------
230      !
231      IF( nn_timing == 1 )  CALL timing_start('sbc_clo')
232      !                                                   !------------------!
233      IF( kt == nit000 ) THEN                             !  Initialisation  !
234         !                                                !------------------!
235         IF(lwp) WRITE(numout,*)
236         IF(lwp) WRITE(numout,*)'sbc_clo : closed seas '
237         IF(lwp) WRITE(numout,*)'~~~~~~~'
238         !
239         ! Mask
240         ! --------------------------------------------
241         ALLOCATE ( clo_mask (jpi, jpj), STAT=dia_closea_alloc)
242         IF(dia_closea_alloc /= 0)   CALL ctl_warn('dia_closea_alloc: failed to allocate arrays.')
243         
244         clo_mask (:,:) = tmask (:,:,1)
245         
246         ! Latitude limits
247         WHERE ( gphit (:,:) .GT.  30.0_wp ) clo_mask (:,:) = 0.0_wp
248         WHERE ( gphit (:,:) .LT. -30.0_wp ) clo_mask (:,:) = 0.0_wp
249         !
250         ! Remove closed seas from mask
251         DO jc = 1, jpncs
252            DO jj = ncsj1(jc), ncsj2(jc)
253               DO ji = ncsi1(jc), ncsi2(jc)
254                  clo_mask (ji, jj) = 0.0_wp
255               END DO
256            END DO
257         END DO
258         
259         IF( lk_mpp ) CALL lbc_lnk ( clo_mask, 'T', 1._wp)
260     
261         !
262         surf(:) = 0.e0_wp
263         !
264         surf(jpncs+1) = glob_sum( e1e2t(:,:) * clo_mask (:,:) )   ! surface of the ocean where excess run-off goes
265         !
266         !                                        ! surface of closed seas
267         IF( lk_mpp_rep ) THEN                         ! MPP reproductible calculation
268            DO jc = 1, jpncs
269               ctmp = CMPLX( 0.e0, 0.e0, wp )
270               DO jj = ncsj1(jc), ncsj2(jc)
271                  DO ji = ncsi1(jc), ncsi2(jc)
272                     ztmp = e1e2t(ji,jj) * tmask_i(ji,jj)
273                     CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
274                  END DO
275               END DO
276               IF( lk_mpp )   CALL mpp_sum( ctmp )
277               surf(jc) = REAL(ctmp,wp)
278            END DO
279         ELSE                                          ! Standard calculation           
280            DO jc = 1, jpncs
281               DO jj = ncsj1(jc), ncsj2(jc)
282                  DO ji = ncsi1(jc), ncsi2(jc)
283                     surf(jc) = surf(jc) + e1e2t(ji,jj) * tmask_i(ji,jj)      ! surface of closed seas
284                  END DO
285               END DO
286            END DO
287            IF( lk_mpp )   CALL mpp_sum ( surf, jpncs )       ! mpp: sum over all the global domain
288         ENDIF
289
290         IF(lwp) WRITE(numout,*)'     Closed sea surfaces'
291         DO jc = 1, jpncs
292            IF(lwp)WRITE(numout,FMT='(1I3,4I4,5X,F16.2)') jc, ncsi1(jc), ncsi2(jc), ncsj1(jc), ncsj2(jc), surf(jc)
293         END DO
294
295         IF(lwp) WRITE(numout,*)'     Surface for redistribution in closea ', surf(jpncs+1)
296         
297         !
298      ENDIF
299      !
300      !                                                   !--------------------!
301      !                                                   !  update emp        !
302      zfwf = 0.e0_wp                                      !--------------------!
303      IF( lk_mpp_rep ) THEN                         ! MPP reproductible calculation
304         DO jc = 1, jpncs
305            ctmp = CMPLX( 0.e0, 0.e0, wp )
306            DO jj = ncsj1(jc), ncsj2(jc)
307               DO ji = ncsi1(jc), ncsi2(jc)
308                  ztmp = e1e2t(ji,jj) * ( emp(ji,jj)-rnf(ji,jj) ) * tmask_i(ji,jj)
309                  CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
310               END DO 
311            END DO
312            IF( lk_mpp )   CALL mpp_sum( ctmp )
313            zfwf(jc) = REAL(ctmp,wp)
314         END DO
315      ELSE                                          ! Standard calculation           
316         DO jc = 1, jpncs
317            DO jj = ncsj1(jc), ncsj2(jc)
318               DO ji = ncsi1(jc), ncsi2(jc)
319                  zfwf(jc) = zfwf(jc) + e1e2t(ji,jj) * ( emp(ji,jj)-rnf(ji,jj) ) * tmask_i(ji,jj) 
320               END DO 
321            END DO
322         END DO
323         IF( lk_mpp )   CALL mpp_sum ( zfwf(:) , jpncs )       ! mpp: sum over all the global domain
324      ENDIF
325
326      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN      ! Black Sea case for ORCA_R2 configuration
327         zze2    = ( zfwf(3) + zfwf(4) ) * 0.5_wp
328         zfwf(3) = zze2
329         zfwf(4) = zze2
330      ENDIF
331
332      zcorr = 0._wp
333
334      DO jc = 1, jpncs
335         !
336         ! The following if avoids the redistribution of the round off
337         IF ( ABS(zfwf(jc) / surf(jpncs+1) ) > rsmall) THEN
338            !
339            IF( ncstt(jc) == 0 ) THEN           ! water/evap excess is shared by all open ocean
340               zcoef    = zfwf(jc) / surf(jpncs+1)
341               zcoef1   = rcp * zcoef
342               emp(:,:) = emp(:,:) + zcoef  * clo_mask (:,:) 
343               qns(:,:) = qns(:,:) - zcoef1 * sst_m(:,:) * clo_mask (:,:)
344               !
345            ELSEIF( ncstt(jc) == 1 ) THEN       ! Excess water in open sea, at outflow location, excess evap shared
346               IF ( zfwf(jc) <= 0.e0_wp ) THEN
347                   DO jn = 1, ncsnr(jc)
348                     ji = mi0(ncsir(jc,jn))
349                     jj = mj0(ncsjr(jc,jn)) ! Location of outflow in open ocean
350                     IF (      ji > 1 .AND. ji < jpi   &
351                         .AND. jj > 1 .AND. jj < jpj ) THEN
352                         zcoef      = zfwf(jc) / ( REAL(ncsnr(jc)) * e1e2t(ji,jj) )
353                         zcoef1     = rcp * zcoef
354                         emp(ji,jj) = emp(ji,jj) + zcoef 
355                         qns(ji,jj) = qns(ji,jj) - zcoef1 * sst_m(ji,jj)
356                     ENDIF
357                   END DO
358               ELSE
359                   zcoef    = zfwf(jc) / surf(jpncs+1)
360                   zcoef1   = rcp * zcoef
361                   emp(:,:) = emp(:,:) + zcoef  * clo_mask (:,:)
362                   qns(:,:) = qns(:,:) - zcoef1 * sst_m(:,:) * clo_mask (:,:)
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      emp (:,:) = emp (:,:) * tmask(:,:,1)
391      qns (:,:) = qns (:,:) * tmask(:,:,1)
392      !
393      CALL lbc_lnk( emp , 'T', 1._wp )
394      CALL lbc_lnk( qns , 'T', 1._wp )
395      !
396      IF( nn_timing == 1 )  CALL timing_stop('sbc_clo')
397      !
398   END SUBROUTINE sbc_clo
399
400
401   SUBROUTINE clo_rnf( p_rnfmsk )
402      !!---------------------------------------------------------------------
403      !!                  ***  ROUTINE sbc_rnf  ***
404      !!                   
405      !! ** Purpose :   allow the treatment of closed sea outflow grid-points
406      !!                to be the same as river mouth grid-points
407      !!
408      !! ** Method  :   set to 1 the runoff mask (mskrnf, see sbcrnf module)
409      !!                at the closed sea outflow grid-point.
410      !!
411      !! ** Action  :   update (p_)mskrnf (set 1 at closed sea outflow)
412      !!----------------------------------------------------------------------
413      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   p_rnfmsk   ! river runoff mask (rnfmsk array)
414      !
415      INTEGER  ::   jc, jn, ji, jj      ! dummy loop indices
416      !!----------------------------------------------------------------------
417      !
418      DO jc = 1, jpncs
419         IF( ncstt(jc) >= 1 ) THEN            ! runoff mask set to 1 at closed sea outflows
420             DO jn = 1, 4
421                DO jj =    mj0( ncsjr(jc,jn) ), mj1( ncsjr(jc,jn) )
422                   DO ji = mi0( ncsir(jc,jn) ), mi1( ncsir(jc,jn) )
423                      p_rnfmsk(ji,jj) = MAX( p_rnfmsk(ji,jj), 1.0_wp )
424                   END DO
425                END DO
426            END DO
427         ENDIF
428      END DO 
429      !
430   END SUBROUTINE clo_rnf
431
432   
433   SUBROUTINE clo_ups( p_upsmsk )
434      !!---------------------------------------------------------------------
435      !!                  ***  ROUTINE sbc_rnf  ***
436      !!                   
437      !! ** Purpose :   allow the treatment of closed sea outflow grid-points
438      !!                to be the same as river mouth grid-points
439      !!
440      !! ** Method  :   set to 0.5 the upstream mask (upsmsk, see traadv_cen2
441      !!                module) over the closed seas.
442      !!
443      !! ** Action  :   update (p_)upsmsk (set 0.5 over closed seas)
444      !!----------------------------------------------------------------------
445      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   p_upsmsk   ! upstream mask (upsmsk array)
446      !
447      INTEGER  ::   jc, ji, jj      ! dummy loop indices
448      !!----------------------------------------------------------------------
449      !
450      DO jc = 1, jpncs
451         DO jj = ncsj1(jc), ncsj2(jc)
452            DO ji = ncsi1(jc), ncsi2(jc)
453               p_upsmsk(ji,jj) = 0.5_wp         ! mixed upstream/centered scheme over closed seas
454            END DO
455         END DO
456       END DO 
457       !
458   END SUBROUTINE clo_ups
459   
460     
461   SUBROUTINE clo_bat( pbat, kbat )
462      !!---------------------------------------------------------------------
463      !!                  ***  ROUTINE clo_bat  ***
464      !!                   
465      !! ** Purpose :   suppress closed sea from the domain
466      !!
467      !! ** Method  :   set to 0 the meter and level bathymetry (given in
468      !!                arguments) over the closed seas.
469      !!
470      !! ** Action  :   set pbat=0 and kbat=0 over closed seas
471      !!----------------------------------------------------------------------
472      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pbat   ! bathymetry in meters (bathy array)
473      INTEGER , DIMENSION(jpi,jpj), INTENT(inout) ::   kbat   ! bathymetry in levels (mbathy array)
474      !
475      INTEGER  ::   jc, ji, jj      ! dummy loop indices
476      !!----------------------------------------------------------------------
477      !
478      DO jc = 1, jpncs
479         DO jj = ncsj1(jc), ncsj2(jc)
480            DO ji = ncsi1(jc), ncsi2(jc)
481               pbat(ji,jj) = 0._wp   
482               kbat(ji,jj) = 0   
483            END DO
484         END DO
485       END DO 
486       !
487   END SUBROUTINE clo_bat
488
489   !!======================================================================
490END MODULE closea
491
Note: See TracBrowser for help on using the repository browser.