New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
closea.F90 in trunk/NEMO/OPA_SRC/DOM – NEMO

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

Last change on this file since 1601 was 1601, checked in by ctlod, 15 years ago

Doctor naming of OPA namelist variables , see ticket: #526

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