source: branches/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90 @ 11738

Last change on this file since 11738 was 11738, checked in by marc, 12 months ago

The Dr Hook changes from my perl code.

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