source: branches/2012/dev_r3385_NOCS04_HAMF/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90 @ 3488

Last change on this file since 3488 was 3488, checked in by acc, 9 years ago

Branch: dev_r3385_NOCS04_HAMF; #665. Stage 3 of 2012 development: Rationalisation of code. Added LIM3 changes, corrected coupled changes and highlighted areas of concern in CICE interface

  • Property svn:keywords set to Id
File size: 17.2 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   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
47   !! $Id$
48   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
49   !!----------------------------------------------------------------------
50CONTAINS
51
52   SUBROUTINE dom_clo
53      !!---------------------------------------------------------------------
54      !!                  ***  ROUTINE dom_clo  ***
55      !!       
56      !! ** Purpose :   Closed sea domain initialization
57      !!
58      !! ** Method  :   if a closed sea is located only in a model grid point
59      !!                just the thermodynamic processes are applied.
60      !!
61      !! ** Action  :   ncsi1(), ncsj1() : south-west closed sea limits (i,j)
62      !!                ncsi2(), ncsj2() : north-east Closed sea limits (i,j)
63      !!                ncsir(), ncsjr() : Location of runoff
64      !!                ncsnr            : number of point where run-off pours
65      !!                ncstt            : Type of closed sea
66      !!                                   =0 spread over the world ocean
67      !!                                   =2 put at location runoff
68      !!----------------------------------------------------------------------
69      INTEGER ::   jc            ! dummy loop indices
70      !!----------------------------------------------------------------------
71     
72      IF(lwp) WRITE(numout,*)
73      IF(lwp) WRITE(numout,*)'dom_clo : closed seas '
74      IF(lwp) WRITE(numout,*)'~~~~~~~'
75
76      ! initial values
77      ncsnr(:) = 1  ;  ncsi1(:) = 1  ;  ncsi2(:) = 1  ;  ncsir(:,:) = 1
78      ncstt(:) = 0  ;  ncsj1(:) = 1  ;  ncsj2(:) = 1  ;  ncsjr(:,:) = 1
79
80      ! set the closed seas (in data domain indices)
81      ! -------------------
82
83      IF( cp_cfg == "orca" ) THEN
84         !
85         SELECT CASE ( jp_cfg )
86         !                                           ! =======================
87         CASE ( 2 )                                  !  ORCA_R2 configuration
88            !                                        ! =======================
89            !                                            ! Caspian Sea
90            ncsnr(1)   =   1  ;  ncstt(1)   =   0           ! spread over the globe
91            ncsi1(1)   =  11  ;  ncsj1(1)   = 103
92            ncsi2(1)   =  17  ;  ncsj2(1)   = 112
93            ncsir(1,1) =   1  ;  ncsjr(1,1) =   1 
94            !                                            ! Great North American Lakes
95            ncsnr(2)   =   1  ;  ncstt(2)   =   2           ! put at St Laurent mouth
96            ncsi1(2)   =  97  ;  ncsj1(2)   = 107
97            ncsi2(2)   = 103  ;  ncsj2(2)   = 111
98            ncsir(2,1) = 110  ;  ncsjr(2,1) = 111
99            !                                            ! Black Sea 1 : west part of the Black Sea
100            ncsnr(3)   = 1    ; ncstt(3)   =   2            !            (ie west of the cyclic b.c.)
101            ncsi1(3)   = 174  ; ncsj1(3)   = 107            ! put in Med Sea
102            ncsi2(3)   = 181  ; ncsj2(3)   = 112
103            ncsir(3,1) = 171  ; ncsjr(3,1) = 106 
104            !                                            ! Black Sea 2 : est part of the Black Sea
105            ncsnr(4)   =   1  ;  ncstt(4)   =   2           !               (ie est of the cyclic b.c.)
106            ncsi1(4)   =   2  ;  ncsj1(4)   = 107           ! put in Med Sea
107            ncsi2(4)   =   6  ;  ncsj2(4)   = 112
108            ncsir(4,1) = 171  ;  ncsjr(4,1) = 106 
109            !                                        ! =======================
110         CASE ( 4 )                                  !  ORCA_R4 configuration
111            !                                        ! =======================
112            !                                            ! Caspian Sea
113            ncsnr(1)   =  1  ;  ncstt(1)   =  0 
114            ncsi1(1)   =  4  ;  ncsj1(1)   = 53 
115            ncsi2(1)   =  4  ;  ncsj2(1)   = 56
116            ncsir(1,1) =  1  ;  ncsjr(1,1) =  1
117            !                                            ! Great North American Lakes
118            ncsnr(2)   =  1  ;  ncstt(2)   =  2 
119            ncsi1(2)   = 49  ;  ncsj1(2)   = 55
120            ncsi2(2)   = 51  ;  ncsj2(2)   = 56
121            ncsir(2,1) = 57  ;  ncsjr(2,1) = 55
122            !                                            ! Black Sea
123            ncsnr(3)   =  4  ;  ncstt(3)   =  2 
124            ncsi1(3)   = 88  ;  ncsj1(3)   = 55 
125            ncsi2(3)   = 91  ;  ncsj2(3)   = 56
126            ncsir(3,1) = 86  ;  ncsjr(3,1) = 53
127            ncsir(3,2) = 87  ;  ncsjr(3,2) = 53 
128            ncsir(3,3) = 86  ;  ncsjr(3,3) = 52 
129            ncsir(3,4) = 87  ;  ncsjr(3,4) = 52
130            !                                            ! Baltic Sea
131            ncsnr(4)   =  1  ;  ncstt(4)   =  2
132            ncsi1(4)   = 75  ;  ncsj1(4)   = 59
133            ncsi2(4)   = 76  ;  ncsj2(4)   = 61
134            ncsir(4,1) = 84  ;  ncsjr(4,1) = 59 
135            !                                        ! =======================
136         CASE ( 025 )                                ! ORCA_R025 configuration
137            !                                        ! =======================
138            ncsnr(1)   = 1    ; ncstt(1)   = 0               ! Caspian + Aral sea
139            ncsi1(1)   = 1330 ; ncsj1(1)   = 645
140            ncsi2(1)   = 1400 ; ncsj2(1)   = 795
141            ncsir(1,1) = 1    ; ncsjr(1,1) = 1
142            !                                       
143            ncsnr(2)   = 1    ; ncstt(2)   = 0               ! Azov Sea
144            ncsi1(2)   = 1284 ; ncsj1(2)   = 722
145            ncsi2(2)   = 1304 ; ncsj2(2)   = 747
146            ncsir(2,1) = 1    ; ncsjr(2,1) = 1
147            !
148         END SELECT
149         !
150      ENDIF
151
152      ! convert the position in local domain indices
153      ! --------------------------------------------
154      DO jc = 1, jpncs
155         ncsi1(jc)   = mi0( ncsi1(jc) )
156         ncsj1(jc)   = mj0( ncsj1(jc) )
157
158         ncsi2(jc)   = mi1( ncsi2(jc) )   
159         ncsj2(jc)   = mj1( ncsj2(jc) ) 
160      END DO
161      !
162   END SUBROUTINE dom_clo
163
164
165   SUBROUTINE sbc_clo( kt )
166      !!---------------------------------------------------------------------
167      !!                  ***  ROUTINE sbc_clo  ***
168      !!                   
169      !! ** Purpose :   Special handling of closed seas
170      !!
171      !! ** Method  :   Water flux is forced to zero over closed sea
172      !!      Excess is shared between remaining ocean, or
173      !!      put as run-off in open ocean.
174      !!
175      !! ** Action  :   emp   updated surface freshwater flux at kt
176      !!----------------------------------------------------------------------
177      INTEGER, INTENT(in) ::   kt   ! ocean model time step
178      !
179      INTEGER                     ::   ji, jj, jc, jn   ! dummy loop indices
180      REAL(wp)                    ::   zze2, zcoef, zcoef1
181      REAL(wp), DIMENSION (jpncs) ::   zfwf 
182      !!----------------------------------------------------------------------
183      !
184      !                                                   !------------------!
185      IF( kt == nit000 ) THEN                             !  Initialisation  !
186         !                                                !------------------!
187         IF(lwp) WRITE(numout,*)
188         IF(lwp) WRITE(numout,*)'sbc_clo : closed seas '
189         IF(lwp) WRITE(numout,*)'~~~~~~~'
190
191         ! Total surface of ocean
192         surf(jpncs+1) = SUM( e1t(:,:) * e2t(:,:) * tmask_i(:,:) )
193
194         DO jc = 1, jpncs
195            surf(jc) =0.e0
196            DO jj = ncsj1(jc), ncsj2(jc)
197               DO ji = ncsi1(jc), ncsi2(jc)
198                  surf(jc) = surf(jc) + e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj)      ! surface of closed seas
199               END DO
200            END DO
201         END DO
202         IF( lk_mpp )   CALL mpp_sum ( surf, jpncs+1 )       ! mpp: sum over all the global domain
203
204         IF(lwp) WRITE(numout,*)'     Closed sea surfaces'
205         DO jc = 1, jpncs
206            IF(lwp)WRITE(numout,FMT='(1I3,4I4,5X,F16.2)') jc, ncsi1(jc), ncsi2(jc), ncsj1(jc), ncsj2(jc), surf(jc)
207         END DO
208
209         ! jpncs+1 : surface of sea, closed seas excluded
210         DO jc = 1, jpncs
211            surf(jpncs+1) = surf(jpncs+1) - surf(jc)
212         END DO           
213         !
214      ENDIF
215      !                                                   !--------------------!
216      !                                                   !  update emp        !
217      zfwf = 0.e0                                         !--------------------!
218      DO jc = 1, jpncs
219         DO jj = ncsj1(jc), ncsj2(jc)
220            DO ji = ncsi1(jc), ncsi2(jc)
221               zfwf(jc) = zfwf(jc) + e1t(ji,jj) * e2t(ji,jj) * ( emp(ji,jj)-rnf(ji,jj) ) * tmask_i(ji,jj) 
222            END DO 
223         END DO
224      END DO
225      IF( lk_mpp )   CALL mpp_sum ( zfwf(:) , jpncs )       ! mpp: sum over all the global domain
226
227      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN      ! Black Sea case for ORCA_R2 configuration
228         zze2    = ( zfwf(3) + zfwf(4) ) / 2.
229         zfwf(3) = zze2
230         zfwf(4) = zze2
231      ENDIF
232
233      DO jc = 1, jpncs
234         !
235         IF( ncstt(jc) == 0 ) THEN 
236            ! water/evap excess is shared by all open ocean
237            zcoef  = zfwf(jc) / surf(jpncs+1)
238            zcoef1 = rcp * zcoef
239            emp(:,:) = emp(:,:) + zcoef
240            qns(:,:) = qns(:,:) - zcoef1 * sst_m(:,:)
241         ELSEIF( ncstt(jc) == 1 ) THEN 
242            ! Excess water in open sea, at outflow location, excess evap shared
243            IF ( zfwf(jc) <= 0.e0 ) THEN
244                DO jn = 1, ncsnr(jc)
245                  ji = mi0(ncsir(jc,jn))
246                  jj = mj0(ncsjr(jc,jn)) ! Location of outflow in open ocean
247                  IF (      ji > 1 .AND. ji < jpi   &
248                      .AND. jj > 1 .AND. jj < jpj ) THEN
249                      zcoef  = zfwf(jc) / ( REAL(ncsnr(jc), wp) * e1t(ji,jj) * e2t(ji,jj) )
250                      zcoef1 = rcp * zcoef
251                      emp(ji,jj) = emp(ji,jj) + zcoef
252                      qns(ji,jj) = qns(ji,jj) - zcoef1 * sst_m(ji,jj)
253                  END IF
254                END DO
255            ELSE
256                zcoef  = zfwf(jc) / surf(jpncs+1)
257                zcoef1 = rcp * zcoef
258                emp(:,:) = emp(:,:) + zcoef
259                qns(:,:) = qns(:,:) - zcoef1 * sst_m(:,:)
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                  zcoef  = zfwf(jc) / ( REAL(ncsnr(jc), wp) * e1t(ji,jj) * e2t(ji,jj) )
269                  zcoef1 = rcp * zcoef
270                  emp(ji,jj) = emp(ji,jj) + zcoef
271                  qns(ji,jj) = qns(ji,jj) - zcoef1 * sst_m(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               zcoef  = zfwf(jc) / surf(jc)
279               zcoef1 = rcp * zcoef
280               emp(ji,jj) = emp(ji,jj) - zcoef
281               qns(ji,jj) = qns(ji,jj) + zcoef1 * sst_m(ji,jj)
282            END DO 
283         END DO 
284         !
285      END DO 
286      !
287      CALL lbc_lnk( emp , '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._wp   
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.