source: CONFIG/UNIFORM/v6/IPSLCM5A2CHT/SOURCES/NEMO/closea.F90 @ 3283

Last change on this file since 3283 was 3283, checked in by acosce, 7 years ago

New configuration : modele IPSLCM5A2 coupled with INCA modele

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