source: trunk/NEMO/OPA_SRC/DOM/closea.F90 @ 703

Last change on this file since 703 was 703, checked in by smasson, 12 years ago

code modifications associated with the new routines, see ticket:4

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 17.3 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   !!----------------------------------------------------------------------
10
11   !!----------------------------------------------------------------------
12   !!   dom_clo    : modification of the ocean domain for closed seas cases
13   !!   sbc_clo    : Special handling of closed seas
14   !!   clo_rnf    : set close sea outflows as river mouths (see sbcrnf)
15   !!   clo_ups    : set mixed centered/upstream scheme in closed sea (see traadv_cen2)
16   !!   clo_bat    : set to zero a field over closed sea (see domzrg)
17   !!----------------------------------------------------------------------
18   USE oce             ! dynamics and tracers
19   USE dom_oce         ! ocean space and time domain
20   USE in_out_manager  ! I/O manager
21   USE sbc_oce         ! ocean surface boundary conditions
22   USE lib_mpp         ! distributed memory computing library
23   USE lbclnk          ! ???
24
25   IMPLICIT NONE
26   PRIVATE
27
28   PUBLIC dom_clo      ! routine called by domain module
29   PUBLIC sbc_clo      ! routine called by step module
30   PUBLIC clo_rnf      ! routine called by sbcrnf module
31   PUBLIC clo_ups      ! routine called in traadv_cen2(_jki) module
32   PUBLIC clo_bat      ! routine called in domzgr module
33
34   !!* Namelist namclo : closed seas and lakes
35   INTEGER, PUBLIC                     ::   nclosea =  0     !: = 0 no closed sea or lake
36      !                                                      !  = 1 closed sea or lake in the domain
37     
38   INTEGER, PUBLIC, PARAMETER          ::   jpncs   = 4      !: 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   !!  OPA 9.0 , LOCEAN-IPSL (2006)
51   !! $Id$
52   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
53   !!----------------------------------------------------------------------
54
55CONTAINS
56
57   SUBROUTINE dom_clo
58      !!---------------------------------------------------------------------
59      !!                  ***  ROUTINE dom_clo  ***
60      !!       
61      !! ** Purpose :   Closed sea domain initialization
62      !!
63      !! ** Method  :   if a closed sea is located only in a model grid point
64      !!                just the thermodynamic processes are applied.
65      !!
66      !! ** Action  :   ncsi1(), ncsj1() : south-west closed sea limits (i,j)
67      !!                ncsi2(), ncsj2() : north-east Closed sea limits (i,j)
68      !!                ncsir(), ncsjr() : Location of runoff
69      !!                ncsnr            : number of point where run-off pours
70      !!                ncstt            : Type of closed sea
71      !!                                   =0 spread over the world ocean
72      !!                                   =2 put at location runoff
73      !!----------------------------------------------------------------------
74      INTEGER ::   jc            ! dummy loop indices
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 ( 2 )                                  !  ORCA_R2 configuration
93            !                                        ! =======================
94            !                                            ! Caspian Sea
95            ncsnr(1)   =   1  ;  ncstt(1)   =   0           ! spread over the globe
96            ncsi1(1)   =  11  ;  ncsj1(1)   = 103
97            ncsi2(1)   =  17  ;  ncsj2(1)   = 112
98            ncsir(1,1) =   1  ;  ncsjr(1,1) =   1 
99            !                                            ! Great North American Lakes
100            ncsnr(2)   =   1  ;  ncstt(2)   =   2           ! put at St Laurent mouth
101            ncsi1(2)   =  97  ;  ncsj1(2)   = 107
102            ncsi2(2)   = 103  ;  ncsj2(2)   = 111
103            ncsir(2,1) = 110  ;  ncsjr(2,1) = 111
104            !                                            ! Black Sea 1 : west part of the Black Sea
105            ncsnr(3)   = 1    ; ncstt(3)   =   2            !            (ie west of the cyclic b.c.)
106            ncsi1(3)   = 174  ; ncsj1(3)   = 107            ! put in Med Sea
107            ncsi2(3)   = 181  ; ncsj2(3)   = 112
108            ncsir(3,1) = 171  ; ncsjr(3,1) = 106 
109            !                                            ! Black Sea 2 : est part of the Black Sea
110            ncsnr(4)   =   1  ;  ncstt(4)   =   2           !               (ie est of the cyclic b.c.)
111            ncsi1(4)   =   2  ;  ncsj1(4)   = 107           ! put in Med Sea
112            ncsi2(4)   =   6  ;  ncsj2(4)   = 112
113            ncsir(4,1) = 171  ;  ncsjr(4,1) = 106 
114            !                                        ! =======================
115         CASE ( 4 )                                  !  ORCA_R4 configuration
116            !                                        ! =======================
117            !                                            ! Caspian Sea
118            ncsnr(1)   =  1  ;  ncstt(1)   =  0 
119            ncsi1(1)   =  4  ;  ncsj1(1)   = 53 
120            ncsi2(1)   =  4  ;  ncsj2(1)   = 56
121            ncsir(1,1) =  1  ;  ncsjr(1,1) =  1
122            !                                            ! Great North American Lakes
123            ncsnr(2)   =  1  ;  ncstt(2)   =  2 
124            ncsi1(2)   = 49  ;  ncsj1(2)   = 55
125            ncsi2(2)   = 51  ;  ncsj2(2)   = 56
126            ncsir(2,1) = 57  ;  ncsjr(2,1) = 55
127            !                                            ! Black Sea
128            ncsnr(3)   =  4  ;  ncstt(3)   =  2 
129            ncsi1(3)   = 88  ;  ncsj1(3)   = 55 
130            ncsi2(3)   = 91  ;  ncsj2(3)   = 56
131            ncsir(3,1) = 86  ;  ncsjr(3,1) = 53
132            ncsir(3,2) = 87  ;  ncsjr(3,2) = 53 
133            ncsir(3,3) = 86  ;  ncsjr(3,3) = 52 
134            ncsir(3,4) = 87  ;  ncsjr(3,4) = 52
135            !                                            ! Baltic Sea
136            ncsnr(4)   =  1  ;  ncstt(4)   =  2
137            ncsi1(4)   = 75  ;  ncsj1(4)   = 59
138            ncsi2(4)   = 76  ;  ncsj2(4)   = 61
139            ncsir(4,1) = 84  ;  ncsjr(4,1) = 59 
140            !                                        ! =======================
141         CASE ( 025 )                                ! ORCA_R025 configuration
142            !                                        ! =======================
143            ncsnr(1)   = 1    ; ncstt(1)   = 0               ! Caspian + Aral sea
144            ncsi1(1)   = 1330 ; ncsj1(1)   = 645
145            ncsi2(1)   = 1400 ; ncsj2(1)   = 795
146            ncsir(1,1) = 1    ; ncsjr(1,1) = 1
147            !                                       
148            ncsnr(2)   = 1    ; ncstt(2)   = 0               ! Azov Sea
149            ncsi1(2)   = 1284 ; ncsj1(2)   = 722
150            ncsi2(2)   = 1304 ; ncsj2(2)   = 747
151            ncsir(2,1) = 1    ; ncsjr(2,1) = 1
152            !
153         END SELECT
154         !
155      ENDIF
156
157      ! convert the position in local domain indices
158      ! --------------------------------------------
159      DO jc = 1, jpncs
160         ncsi1(jc)   = mi0( ncsi1(jc) )
161         ncsj1(jc)   = mj0( ncsj1(jc) )
162
163         ncsi2(jc)   = mi1( ncsi2(jc) )   
164         ncsj2(jc)   = mj1( ncsj2(jc) ) 
165      END DO
166      !
167   END SUBROUTINE dom_clo
168
169
170   SUBROUTINE sbc_clo( kt )
171      !!---------------------------------------------------------------------
172      !!                  ***  ROUTINE sbc_clo  ***
173      !!                   
174      !! ** Purpose :   Special handling of closed seas
175      !!
176      !! ** Method  :   Water flux is forced to zero over closed sea
177      !!      Excess is shared between remaining ocean, or
178      !!      put as run-off in open ocean.
179      !!
180      !! ** Action  :   emp, emps   updated surface freshwater fluxes at kt
181      !!----------------------------------------------------------------------
182      INTEGER, INTENT(in) ::   kt   ! ocean model time step
183      !
184      INTEGER                     ::   ji, jj, jc, jn   ! dummy loop indices
185      REAL(wp)                    ::   zze2
186      REAL(wp), DIMENSION (jpncs) ::   zemp
187      !!----------------------------------------------------------------------
188      !
189      !                                                   !------------------!
190      IF( kt == nit000 ) THEN                             !  Initialisation  !
191         !                                                !------------------!
192         IF(lwp) WRITE(numout,*)
193         IF(lwp) WRITE(numout,*)'sbc_clo : closed seas '
194         IF(lwp) WRITE(numout,*)'~~~~~~~'
195
196         ! Total surface of ocean
197         surf(jpncs+1) = SUM( e1t(:,:) * e2t(:,:) * tmask_i(:,:) )
198
199         DO jc = 1, jpncs
200            surf(jc) =0.e0
201            DO jj = ncsj1(jc), ncsj2(jc)
202               DO ji = ncsi1(jc), ncsi2(jc)
203                  surf(jc) = surf(jc) + e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj)      ! surface of closed seas
204               END DO
205            END DO
206         END DO
207         IF( lk_mpp )   CALL mpp_sum ( surf, jpncs+1 )       ! mpp: sum over all the global domain
208
209         IF(lwp) WRITE(numout,*)'     Closed sea surfaces'
210         DO jc = 1, jpncs
211            IF(lwp)WRITE(numout,FMT='(1I3,4I4,5X,F16.2)') jc, ncsi1(jc), ncsi2(jc), ncsj1(jc), ncsj2(jc), surf(jc)
212         END DO
213
214         ! jpncs+1 : surface of sea, closed seas excluded
215         DO jc = 1, jpncs
216            surf(jpncs+1) = surf(jpncs+1) - surf(jc)
217         END DO           
218         !
219      ENDIF
220      !                                                   !--------------------!
221      !                                                   !  update emp, emps  !
222      zemp = 0.e0                                         !--------------------!
223      DO jc = 1, jpncs
224         DO jj = ncsj1(jc), ncsj2(jc)
225            DO ji = ncsi1(jc), ncsi2(jc)
226               zemp(jc) = zemp(jc) + e1t(ji,jj) * e2t(ji,jj) * emp(ji,jj) * tmask_i(ji,jj)
227            END DO 
228         END DO
229      END DO
230      IF( lk_mpp )   CALL mpp_sum ( zemp(:) , jpncs )       ! mpp: sum over all the global domain
231
232      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN      ! Black Sea case for ORCA_R2 configuration
233         zze2    = ( zemp(3) + zemp(4) ) / 2.
234         zemp(3) = zze2
235         zemp(4) = zze2
236      ENDIF
237
238      DO jc = 1, jpncs
239         !
240         IF( ncstt(jc) == 0 ) THEN 
241            ! water/evap excess is shared by all open ocean
242            emp (:,:) = emp (:,:) + zemp(jc) / surf(jpncs+1)
243            emps(:,:) = emps(:,:) + zemp(jc) / surf(jpncs+1)
244         ELSEIF( ncstt(jc) == 1 ) THEN 
245            ! Excess water in open sea, at outflow location, excess evap shared
246            IF ( zemp(jc) <= 0.e0 ) THEN
247                DO jn = 1, ncsnr(jc)
248                  ji = mi0(ncsir(jc,jn))
249                  jj = mj0(ncsjr(jc,jn)) ! Location of outflow in open ocean
250                  IF (      ji > 1 .AND. ji < jpi   &
251                      .AND. jj > 1 .AND. jj < jpj ) THEN
252                      emp (ji,jj) = emp (ji,jj) + zemp(jc) /   &
253                         (FLOAT(ncsnr(jc)) * e1t(ji,jj) * e2t(ji,jj))
254                      emps(ji,jj) = emps(ji,jj) + zemp(jc) /   &
255                          (FLOAT(ncsnr(jc)) * e1t(ji,jj) * e2t(ji,jj))
256                  END IF
257                END DO
258            ELSE
259                emp (:,:) = emp (:,:) + zemp(jc) / surf(jpncs+1)
260                emps(:,:) = emps(:,:) + zemp(jc) / surf(jpncs+1)
261            ENDIF
262         ELSEIF( ncstt(jc) == 2 ) THEN 
263            ! Excess e-p+r (either sign) goes to open ocean, at outflow location
264            IF(      ji > 1 .AND. ji < jpi    &
265               .AND. jj > 1 .AND. jj < jpj ) THEN
266                DO jn = 1, ncsnr(jc)
267                  ji = mi0(ncsir(jc,jn))
268                  jj = mj0(ncsjr(jc,jn)) ! Location of outflow in open ocean
269                  emp (ji,jj) = emp (ji,jj) + zemp(jc)   &
270                      / (FLOAT(ncsnr(jc)) *  e1t(ji,jj) * e2t(ji,jj) )
271                  emps(ji,jj) = emps(ji,jj) + zemp(jc)   &
272                      / (FLOAT(ncsnr(jc)) *  e1t(ji,jj) * e2t(ji,jj) )
273                END DO
274            ENDIF
275         ENDIF 
276         !
277         DO jj = ncsj1(jc), ncsj2(jc)
278            DO ji = ncsi1(jc), ncsi2(jc)
279               emp (ji,jj) = emp (ji,jj) - zemp(jc) / surf(jc)
280               emps(ji,jj) = emps(ji,jj) - zemp(jc) / surf(jc)
281            END DO 
282         END DO 
283         !
284      END DO 
285      !
286      CALL lbc_lnk( emp , 'T', 1. )
287      CALL lbc_lnk( emps, 'T', 1. )
288      !
289   END SUBROUTINE sbc_clo
290   
291   
292   SUBROUTINE clo_rnf( p_rnfmsk )
293      !!---------------------------------------------------------------------
294      !!                  ***  ROUTINE sbc_rnf  ***
295      !!                   
296      !! ** Purpose :   allow the treatment of closed sea outflow grid-points
297      !!                to be the same as river mouth grid-points
298      !!
299      !! ** Method  :   set to 1 the runoff mask (mskrnf, see sbcrnf module)
300      !!                at the closed sea outflow grid-point.
301      !!
302      !! ** Action  :   update (p_)mskrnf (set 1 at closed sea outflow)
303      !!----------------------------------------------------------------------
304      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   p_rnfmsk   ! river runoff mask (rnfmsk array)
305      !
306      INTEGER  ::   jc, jn      ! dummy loop indices
307      INTEGER  ::   ii, ij      ! temporary integer
308      !!----------------------------------------------------------------------
309      !
310      DO jc = 1, jpncs
311         IF( ncstt(jc) >= 1 ) THEN            ! runoff mask set to 1 at closed sea outflows
312             DO jn = 1, 4
313               ii = mi0( ncsir(jc,jn) )
314               ij = mj0( ncsjr(jc,jn) )
315               p_rnfmsk(ii,ij) = MAX( p_rnfmsk(ii,ij), 1.0 )
316            END DO
317         ENDIF
318      END DO 
319      !
320   END SUBROUTINE clo_rnf
321
322   
323   SUBROUTINE clo_ups( p_upsmsk )
324      !!---------------------------------------------------------------------
325      !!                  ***  ROUTINE sbc_rnf  ***
326      !!                   
327      !! ** Purpose :   allow the treatment of closed sea outflow grid-points
328      !!                to be the same as river mouth grid-points
329      !!
330      !! ** Method  :   set to 0.5 the upstream mask (upsmsk, see traadv_cen2
331      !!                module) over the closed seas.
332      !!
333      !! ** Action  :   update (p_)upsmsk (set 0.5 over closed seas)
334      !!----------------------------------------------------------------------
335      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   p_upsmsk   ! upstream mask (upsmsk array)
336      !
337      INTEGER  ::   jc, ji, jj      ! dummy loop indices
338      !!----------------------------------------------------------------------
339      !
340      DO jc = 1, jpncs
341         DO jj = ncsj1(jc), ncsj2(jc)
342            DO ji = ncsi1(jc), ncsi2(jc)
343               p_upsmsk(ji,jj) = 0.5            ! mixed upstream/centered scheme over closed seas
344            END DO
345         END DO
346       END DO 
347       !
348   END SUBROUTINE clo_ups
349   
350     
351   SUBROUTINE clo_bat( pbat, kbat )
352      !!---------------------------------------------------------------------
353      !!                  ***  ROUTINE clo_bat  ***
354      !!                   
355      !! ** Purpose :   suppress closed sea from the domain
356      !!
357      !! ** Method  :   set to 0 the meter and level bathymetry (given in
358      !!                arguments) over the closed seas.
359      !!
360      !! ** Action  :   set pbat=0 and kbat=0 over closed seas
361      !!----------------------------------------------------------------------
362      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pbat   ! bathymetry in meters (bathy array)
363      INTEGER , DIMENSION(jpi,jpj), INTENT(inout) ::   kbat   ! bathymetry in levels (mbathy array)
364      !
365      INTEGER  ::   jc, ji, jj      ! dummy loop indices
366      !!----------------------------------------------------------------------
367      !
368      DO jc = 1, jpncs
369         DO jj = ncsj1(jc), ncsj2(jc)
370            DO ji = ncsi1(jc), ncsi2(jc)
371               pbat(ji,jj) = 0.e0   
372               kbat(ji,jj) = 0   
373            END DO
374         END DO
375       END DO 
376       !
377   END SUBROUTINE clo_bat
378
379   !!======================================================================
380END MODULE closea
Note: See TracBrowser for help on using the repository browser.