source: branches/DEV_R1821_Rivers/NEMO/OPA_SRC/DOM/closea.F90 @ 1938

Last change on this file since 1938 was 1938, checked in by rfurner, 10 years ago

rnf has been separated from emp and emps. Also temperature and salinity of runoff can be specified, and runoff can be added to a user specified depth

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 17.4 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) ::   zfwf 
183 
184      REAL(wp), DIMENSION (jpi,jpj)       ::   fwf              !: fresh water flux,for volume: emp-rnf 
185      REAL(wp), DIMENSION (jpi,jpj)       ::   fwfs             !: fresh water flux, for conc/dilution effect: emps-rnf 
186      !!----------------------------------------------------------------------
187      !
188      !                                                   !------------------!
189      IF( kt == nit000 ) THEN                             !  Initialisation  !
190         !                                                !------------------!
191         IF(lwp) WRITE(numout,*)
192         IF(lwp) WRITE(numout,*)'sbc_clo : closed seas '
193         IF(lwp) WRITE(numout,*)'~~~~~~~'
194
195         ! Total surface of ocean
196         surf(jpncs+1) = SUM( e1t(:,:) * e2t(:,:) * tmask_i(:,:) )
197
198         DO jc = 1, jpncs
199            surf(jc) =0.e0
200            DO jj = ncsj1(jc), ncsj2(jc)
201               DO ji = ncsi1(jc), ncsi2(jc)
202                  surf(jc) = surf(jc) + e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj)      ! surface of closed seas
203               END DO
204            END DO
205         END DO
206         IF( lk_mpp )   CALL mpp_sum ( surf, jpncs+1 )       ! mpp: sum over all the global domain
207
208         IF(lwp) WRITE(numout,*)'     Closed sea surfaces'
209         DO jc = 1, jpncs
210            IF(lwp)WRITE(numout,FMT='(1I3,4I4,5X,F16.2)') jc, ncsi1(jc), ncsi2(jc), ncsj1(jc), ncsj2(jc), surf(jc)
211         END DO
212
213         ! jpncs+1 : surface of sea, closed seas excluded
214         DO jc = 1, jpncs
215            surf(jpncs+1) = surf(jpncs+1) - surf(jc)
216         END DO           
217         !
218      ENDIF
219      !                                                   !--------------------!
220      !                                                   !  update emp, emps  !
221      zfwf = 0.e0                                         !--------------------!
222      DO jc = 1, jpncs
223         DO jj = ncsj1(jc), ncsj2(jc)
224            DO ji = ncsi1(jc), ncsi2(jc)
225               zfwf(jc) = zfwf(jc) + e1t(ji,jj) * e2t(ji,jj) * ( emp(ji,jj)-rnf(ji,jj) ) * tmask_i(ji,jj) 
226            END DO 
227         END DO
228      END DO
229      IF( lk_mpp )   CALL mpp_sum ( zfwf(:) , jpncs )       ! mpp: sum over all the global domain
230
231      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN      ! Black Sea case for ORCA_R2 configuration
232         zze2    = ( zfwf(3) + zfwf(4) ) / 2.
233         zfwf(3) = zze2
234         zfwf(4) = zze2
235      ENDIF
236
237      DO jc = 1, jpncs
238         !
239         IF( ncstt(jc) == 0 ) THEN 
240            ! water/evap excess is shared by all open ocean
241            emp (:,:) = emp (:,:) + zfwf(jc) / surf(jpncs+1)
242            emps(:,:) = emps(:,:) + zfwf(jc) / surf(jpncs+1)
243         ELSEIF( ncstt(jc) == 1 ) THEN 
244            ! Excess water in open sea, at outflow location, excess evap shared
245            IF ( zfwf(jc) <= 0.e0 ) THEN
246                DO jn = 1, ncsnr(jc)
247                  ji = mi0(ncsir(jc,jn))
248                  jj = mj0(ncsjr(jc,jn)) ! Location of outflow in open ocean
249                  IF (      ji > 1 .AND. ji < jpi   &
250                      .AND. jj > 1 .AND. jj < jpj ) THEN
251                      emp (ji,jj) = emp (ji,jj) + zfwf(jc) /   &
252                         (FLOAT(ncsnr(jc)) * e1t(ji,jj) * e2t(ji,jj))
253                      emps(ji,jj) = emps(ji,jj) + zfwf(jc) /   &
254                          (FLOAT(ncsnr(jc)) * e1t(ji,jj) * e2t(ji,jj))
255                  END IF
256                END DO
257            ELSE
258                emp (:,:) = emp (:,:) + zfwf(jc) / surf(jpncs+1)
259                emps(:,:) = emps(:,:) + zfwf(jc) / surf(jpncs+1)
260            ENDIF
261         ELSEIF( ncstt(jc) == 2 ) THEN 
262            ! Excess e-p+r (either sign) goes to open ocean, at outflow location
263            IF(      ji > 1 .AND. ji < jpi    &
264               .AND. jj > 1 .AND. jj < jpj ) THEN
265                DO jn = 1, ncsnr(jc)
266                  ji = mi0(ncsir(jc,jn))
267                  jj = mj0(ncsjr(jc,jn)) ! Location of outflow in open ocean
268                  emp (ji,jj) = emp (ji,jj) + zfwf(jc)   &
269                      / (FLOAT(ncsnr(jc)) *  e1t(ji,jj) * e2t(ji,jj) )
270                  emps(ji,jj) = emps(ji,jj) + zfwf(jc)   &
271                      / (FLOAT(ncsnr(jc)) *  e1t(ji,jj) * e2t(ji,jj) )
272                END DO
273            ENDIF
274         ENDIF 
275         !
276         DO jj = ncsj1(jc), ncsj2(jc)
277            DO ji = ncsi1(jc), ncsi2(jc)
278               emp (ji,jj) = emp (ji,jj) - zfwf(jc) / surf(jc)
279               emps(ji,jj) = emps(ji,jj) - zfwf(jc) / surf(jc)
280            END DO 
281         END DO 
282         !
283      END DO 
284      !
285      fwf(:,:)  = emp(:,:)  - rnf(:,:) 
286      fwfs(:,:) = emps(:,:) - rnf(:,:) 
287      CALL lbc_lnk( fwf , 'T', 1. ) 
288      CALL lbc_lnk( fwfs, 'T', 1. ) 
289      !
290   END SUBROUTINE sbc_clo
291   
292   
293   SUBROUTINE clo_rnf( p_rnfmsk )
294      !!---------------------------------------------------------------------
295      !!                  ***  ROUTINE sbc_rnf  ***
296      !!                   
297      !! ** Purpose :   allow the treatment of closed sea outflow grid-points
298      !!                to be the same as river mouth grid-points
299      !!
300      !! ** Method  :   set to 1 the runoff mask (mskrnf, see sbcrnf module)
301      !!                at the closed sea outflow grid-point.
302      !!
303      !! ** Action  :   update (p_)mskrnf (set 1 at closed sea outflow)
304      !!----------------------------------------------------------------------
305      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   p_rnfmsk   ! river runoff mask (rnfmsk array)
306      !
307      INTEGER  ::   jc, jn      ! dummy loop indices
308      INTEGER  ::   ii, ij      ! temporary integer
309      !!----------------------------------------------------------------------
310      !
311      DO jc = 1, jpncs
312         IF( ncstt(jc) >= 1 ) THEN            ! runoff mask set to 1 at closed sea outflows
313             DO jn = 1, 4
314               ii = mi0( ncsir(jc,jn) )
315               ij = mj0( ncsjr(jc,jn) )
316               p_rnfmsk(ii,ij) = MAX( p_rnfmsk(ii,ij), 1.0 )
317            END DO
318         ENDIF
319      END DO 
320      !
321   END SUBROUTINE clo_rnf
322
323   
324   SUBROUTINE clo_ups( p_upsmsk )
325      !!---------------------------------------------------------------------
326      !!                  ***  ROUTINE sbc_rnf  ***
327      !!                   
328      !! ** Purpose :   allow the treatment of closed sea outflow grid-points
329      !!                to be the same as river mouth grid-points
330      !!
331      !! ** Method  :   set to 0.5 the upstream mask (upsmsk, see traadv_cen2
332      !!                module) over the closed seas.
333      !!
334      !! ** Action  :   update (p_)upsmsk (set 0.5 over closed seas)
335      !!----------------------------------------------------------------------
336      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   p_upsmsk   ! upstream mask (upsmsk array)
337      !
338      INTEGER  ::   jc, ji, jj      ! dummy loop indices
339      !!----------------------------------------------------------------------
340      !
341      DO jc = 1, jpncs
342         DO jj = ncsj1(jc), ncsj2(jc)
343            DO ji = ncsi1(jc), ncsi2(jc)
344               p_upsmsk(ji,jj) = 0.5            ! mixed upstream/centered scheme over closed seas
345            END DO
346         END DO
347       END DO 
348       !
349   END SUBROUTINE clo_ups
350   
351     
352   SUBROUTINE clo_bat( pbat, kbat )
353      !!---------------------------------------------------------------------
354      !!                  ***  ROUTINE clo_bat  ***
355      !!                   
356      !! ** Purpose :   suppress closed sea from the domain
357      !!
358      !! ** Method  :   set to 0 the meter and level bathymetry (given in
359      !!                arguments) over the closed seas.
360      !!
361      !! ** Action  :   set pbat=0 and kbat=0 over closed seas
362      !!----------------------------------------------------------------------
363      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pbat   ! bathymetry in meters (bathy array)
364      INTEGER , DIMENSION(jpi,jpj), INTENT(inout) ::   kbat   ! bathymetry in levels (mbathy array)
365      !
366      INTEGER  ::   jc, ji, jj      ! dummy loop indices
367      !!----------------------------------------------------------------------
368      !
369      DO jc = 1, jpncs
370         DO jj = ncsj1(jc), ncsj2(jc)
371            DO ji = ncsi1(jc), ncsi2(jc)
372               pbat(ji,jj) = 0.e0   
373               kbat(ji,jj) = 0   
374            END DO
375         END DO
376       END DO 
377       !
378   END SUBROUTINE clo_bat
379
380   !!======================================================================
381END MODULE closea
Note: See TracBrowser for help on using the repository browser.