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

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

insert revision Id

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 13.3 KB
Line 
1MODULE closea
2   !!======================================================================
3   !!                       ***  MODULE  closea  ***
4   !! Closed Seas  :
5   !!======================================================================
6
7   !!----------------------------------------------------------------------
8   !!   dom_clo    : modification of the ocean domain for closed seas cases
9   !!   flx_clo    : Special handling of closed seas
10   !!----------------------------------------------------------------------
11   !! * Modules used
12   USE oce             ! dynamics and tracers
13   USE dom_oce         ! ocean space and time domain
14   USE in_out_manager  ! I/O manager
15   USE ocesbc          ! ocean surface boundary conditions (fluxes)
16   USE flxrnf          ! runoffs
17   USE lib_mpp         ! distributed memory computing library
18   USE lbclnk          ! ???
19
20   IMPLICIT NONE
21   PRIVATE
22
23   !! * Accessibility
24   PUBLIC dom_clo      ! routine called by dom_init
25   PUBLIC flx_clo      ! routine called by step
26
27   !! * Share module variables
28   INTEGER, PUBLIC, PARAMETER ::   &  !:
29      jpncs   = 4               !: number of closed sea
30   INTEGER, PUBLIC ::          & !!: namclo : closed seas and lakes
31      nclosea =  0                !: = 0 no closed sea or lake
32      !                           !  = 1 closed sea or lake in the domain
33   INTEGER, PUBLIC, DIMENSION (jpncs) ::   &  !:
34      ncstt,           &  !: Type of closed sea
35      ncsi1, ncsj1,    &  !: closed sea limits                                                                 
36      ncsi2, ncsj2,    &  !:
37      ncsnr               !: number of point where run-off pours
38   INTEGER, PUBLIC, DIMENSION (jpncs,4) ::   &
39      ncsir, ncsjr        !: Location of run-off
40
41   !! * Module variable
42   REAL(wp), DIMENSION (jpncs+1) ::   &
43      surf               ! closed sea surface
44
45   !! * Substitutions
46#  include "vectopt_loop_substitute.h90"
47   !!----------------------------------------------------------------------
48   !!  OPA 9.0 , LOCEAN-IPSL (2005)
49   !! $Id$
50   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
51   !!----------------------------------------------------------------------
52
53CONTAINS
54
55   SUBROUTINE dom_clo
56      !!---------------------------------------------------------------------
57      !!                  ***  ROUTINE dom_clo  ***
58      !!       
59      !! ** Purpose :   Closed sea domain initialization
60      !!
61      !! ** Method  :   if a closed sea is located only in a model grid point
62      !!      just the thermodynamic processes are applied.
63      !!
64      !! ** Action :   ncsi1(), ncsj1() : south-west closed sea limits (i,j)
65      !!               ncsi2(), ncsj2() : north-east Closed sea limits (i,j)
66      !!               ncsir(), ncsjr() : Location of runoff
67      !!               ncsnr            : number of point where run-off pours
68      !!               ncstt            : Type of closed sea
69      !!                                  =0 spread over the world ocean
70      !!                                  =2 put at location runoff
71      !!
72      !! History :
73      !!        !  01-04  (E. Durand)  Original code
74      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
75      !!----------------------------------------------------------------------
76      !! * Local variables
77      INTEGER ::   jc            ! dummy loop indices
78      !!----------------------------------------------------------------------
79     
80      IF(lwp) WRITE(numout,*)
81      IF(lwp) WRITE(numout,*)'dom_clo : closed seas '
82      IF(lwp) WRITE(numout,*)'~~~~~~~'
83
84      ! initial values
85      ncsnr(:) = 1  ;  ncsi1(:) = 1  ;  ncsi2(:) = 1  ;  ncsir(:,:) = 1
86      ncstt(:) = 0  ;  ncsj1(:) = 1  ;  ncsj2(:) = 1  ;  ncsjr(:,:) = 1
87
88      ! set the closed seas (in data domain indices)
89      ! -------------------
90
91      IF( cp_cfg == "orca" ) THEN
92   
93         SELECT CASE ( jp_cfg )
94         !                                           ! =======================
95         CASE ( 2 )                                  !  ORCA_R2 configuration
96            !                                        ! =======================
97
98            !                                            ! Caspian Sea
99            ncsnr(1)   =   1  ;  ncstt(1)   =   0           ! spread over the globe
100            ncsi1(1)   =  11  ;  ncsj1(1)   = 103
101            ncsi2(1)   =  17  ;  ncsj2(1)   = 112
102            ncsir(1,1) =   1  ;  ncsjr(1,1) =   1 
103            !                                            ! Great North American Lakes
104            ncsnr(2)   =   1  ;  ncstt(2)   =   2           ! put at St Laurent mouth
105            ncsi1(2)   =  97  ;  ncsj1(2)   = 107
106            ncsi2(2)   = 103  ;  ncsj2(2)   = 111
107            ncsir(2,1) = 110  ;  ncsjr(2,1) = 111
108            !                                            ! Black Sea 1 : west part of the Black Sea
109            ncsnr(3)   = 1    ; ncstt(3)   =   2            !            (ie west of the cyclic b.c.)
110            ncsi1(3)   = 174  ; ncsj1(3)   = 107            ! put in Med Sea
111            ncsi2(3)   = 181  ; ncsj2(3)   = 112
112            ncsir(3,1) = 171  ; ncsjr(3,1) = 106 
113            !                                            ! Black Sea 2 : est part of the Black Sea
114            ncsnr(4)   =   1  ;  ncstt(4)   =   2           !               (ie est of the cyclic b.c.)
115            ncsi1(4)   =   2  ;  ncsj1(4)   = 107           ! put in Med Sea
116            ncsi2(4)   =   6  ;  ncsj2(4)   = 112
117            ncsir(4,1) = 171  ;  ncsjr(4,1) = 106 
118
119            !                                        ! =======================
120         CASE ( 4 )                                  !  ORCA_R4 configuration
121            !                                        ! =======================
122
123            !                                            ! Caspian Sea
124            ncsnr(1)   =  1  ;  ncstt(1)   =  0 
125            ncsi1(1)   =  4  ;  ncsj1(1)   = 53 
126            ncsi2(1)   =  4  ;  ncsj2(1)   = 56
127            ncsir(1,1) =  1  ;  ncsjr(1,1) =  1
128            !                                            ! Great North American Lakes
129            ncsnr(2)   =  1  ;  ncstt(2)   =  2 
130            ncsi1(2)   = 49  ;  ncsj1(2)   = 55
131            ncsi2(2)   = 51  ;  ncsj2(2)   = 56
132            ncsir(2,1) = 57  ;  ncsjr(2,1) = 55
133            !                                            ! Black Sea
134            ncsnr(3)   =  4  ;  ncstt(3)   =  2 
135            ncsi1(3)   = 88  ;  ncsj1(3)   = 55 
136            ncsi2(3)   = 91  ;  ncsj2(3)   = 56
137            ncsir(3,1) = 86  ;  ncsjr(3,1) = 53
138            ncsir(3,2) = 87  ;  ncsjr(3,2) = 53 
139            ncsir(3,3) = 86  ;  ncsjr(3,3) = 52 
140            ncsir(3,4) = 87  ;  ncsjr(3,4) = 52
141            !                                            ! Baltic Sea
142            ncsnr(4)   =  1  ;  ncstt(4)   =  2
143            ncsi1(4)   = 75  ;  ncsj1(4)   = 59
144            ncsi2(4)   = 76  ;  ncsj2(4)   = 61
145            ncsir(4,1) = 84  ;  ncsjr(4,1) = 59 
146
147            !                                        ! =======================
148         CASE ( 025 )                                ! ORCA_R025 configuration
149            !                                        ! =======================
150            ncsnr(1)   = 1    ; ncstt(1)   = 0               ! Caspian + Aral sea
151            ncsi1(1)   = 1330 ; ncsj1(1)   = 645
152            ncsi2(1)   = 1400 ; ncsj2(1)   = 795
153            ncsir(1,1) = 1    ; ncsjr(1,1) = 1
154            !                                       
155            ncsnr(2)   = 1    ; ncstt(2)   = 0               ! Azov Sea
156            ncsi1(2)   = 1284 ; ncsj1(2)   = 722
157            ncsi2(2)   = 1304 ; ncsj2(2)   = 747
158            ncsir(2,1) = 1    ; ncsjr(2,1) = 1
159
160         END SELECT
161
162      ENDIF
163
164      ! convert the position in local domain indices
165      ! --------------------------------------------
166      DO jc = 1, jpncs
167         ncsi1(jc)   = mi0( ncsi1(jc) )
168         ncsj1(jc)   = mj0( ncsj1(jc) )
169
170         ncsi2(jc)   = mi1( ncsi2(jc) )   
171         ncsj2(jc)   = mj1( ncsj2(jc) ) 
172      END DO
173         
174
175   END SUBROUTINE dom_clo
176
177
178   SUBROUTINE flx_clo( kt )
179      !!---------------------------------------------------------------------
180      !!                  ***  ROUTINE flx_clo  ***
181      !!                   
182      !! ** Purpose :   Special handling of closed seas
183      !!
184      !! ** Method  :   Water flux is forced to zero over closed sea
185      !!      Excess is shared between remaining ocean, or
186      !!      put as run-off in open ocean.
187      !!
188      !! ** Action :
189      !!
190      !! History :
191      !!   8.2  !  00-05  (O. Marti)  Original code
192      !!   8.5  !  02-07  (G. Madec)  Free form, F90
193      !!----------------------------------------------------------------------
194      !! * Arguments
195      INTEGER, INTENT (in) :: kt
196
197      !! * Local declarations
198      REAL(wp), DIMENSION (jpncs) :: zemp
199      INTEGER  :: ji, jj, jc, jn
200      REAL(wp) :: zze2
201      !!----------------------------------------------------------------------
202
203      ! 1 - Initialisation
204      ! ------------------
205
206      IF( kt == nit000 ) THEN
207         IF(lwp) WRITE(numout,*)
208         IF(lwp) WRITE(numout,*)'flx_clo : closed seas '
209         IF(lwp) WRITE(numout,*)'~~~~~~~'
210
211         ! Total surface of ocean
212         surf(jpncs+1) = SUM( e1t(:,:) * e2t(:,:) * tmask_i(:,:) )
213
214         DO jc = 1, jpncs
215            surf(jc) =0.e0
216            DO jj = ncsj1(jc), ncsj2(jc)
217               DO ji = ncsi1(jc), ncsi2(jc)
218                  ! surface of closed seas
219                  surf(jc) = surf(jc) + e1t(ji,jj)*e2t(ji,jj)*tmask_i(ji,jj)
220                  ! upstream in closed seas
221                  upsadv(ji,jj) = 0.5
222               END DO
223            END DO 
224            ! upstream at closed sea outflow
225            IF( ncstt(jc) >= 1 ) THEN
226                DO jn = 1, 4
227                  ji = mi0( ncsir(jc,jn) )
228                  jj = mj0( ncsjr(jc,jn) )
229                  upsrnfh(ji,jj) = MAX( upsrnfh(ji,jj), 1.0 )
230                END DO
231            ENDIF
232         END DO
233         IF( lk_mpp )   CALL mpp_sum ( surf, jpncs+1 )       ! mpp: sum over all the global domain
234
235         IF(lwp) WRITE(numout,*)'     Closed sea surfaces'
236         DO jc = 1, jpncs
237            IF(lwp) WRITE(numout,FMT='(1I3,4I4,5X,F16.2)')    &
238                jc, ncsi1(jc), ncsi2(jc), ncsj1(jc), ncsj2(jc), surf(jc)
239         END DO
240
241         ! jpncs+1 : surface of sea, closed seas excluded
242         DO jc = 1, jpncs
243            surf(jpncs+1) = surf(jpncs+1) - surf(jc)
244         END DO           
245 
246      ENDIF
247
248      ! 2 - Computation
249      ! ---------------
250      zemp = 0.e0
251
252      DO jc = 1, jpncs
253         DO jj = ncsj1(jc), ncsj2(jc)
254            DO ji = ncsi1(jc), ncsi2(jc)
255               zemp(jc) = zemp(jc) + e1t(ji,jj) * e2t(ji,jj) * emp(ji,jj) * tmask_i(ji,jj)
256            END DO 
257         END DO
258      END DO
259      IF( lk_mpp )   CALL mpp_sum ( zemp , jpncs )       ! mpp: sum over all the global domain
260
261      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN      ! Black Sea case for ORCA_R2 configuration
262         zze2    = ( zemp(3) + zemp(4) ) / 2.
263         zemp(3) = zze2
264         zemp(4) = zze2
265      ENDIF
266
267      DO jc = 1, jpncs
268
269         IF( ncstt(jc) == 0 ) THEN 
270            ! water/evap excess is shared by all open ocean
271            emp (:,:) = emp (:,:) + zemp(jc) / surf(jpncs+1)
272            emps(:,:) = emps(:,:) + zemp(jc) / surf(jpncs+1)
273         ELSEIF( ncstt(jc) == 1 ) THEN 
274            ! Excess water in open sea, at outflow location, excess evap shared
275            IF ( zemp(jc) <= 0.e0 ) THEN
276                DO jn = 1, ncsnr(jc)
277                  ji = mi0(ncsir(jc,jn))
278                  jj = mj0(ncsjr(jc,jn)) ! Location of outflow in open ocean
279                  IF (      ji > 1 .AND. ji < jpi   &
280                      .AND. jj > 1 .AND. jj < jpj ) THEN
281                      emp (ji,jj) = emp (ji,jj) + zemp(jc) /   &
282                         (FLOAT(ncsnr(jc)) * e1t(ji,jj) * e2t(ji,jj))
283                      emps(ji,jj) = emps(ji,jj) + zemp(jc) /   &
284                          (FLOAT(ncsnr(jc)) * e1t(ji,jj) * e2t(ji,jj))
285                  END IF
286                END DO
287            ELSE
288                emp (:,:) = emp (:,:) + zemp(jc) / surf(jpncs+1)
289                emps(:,:) = emps(:,:) + zemp(jc) / surf(jpncs+1)
290            ENDIF
291         ELSEIF( ncstt(jc) == 2 ) THEN 
292            ! Excess e-p+r (either sign) goes to open ocean, at outflow location
293            IF(      ji > 1 .AND. ji < jpi    &
294               .AND. jj > 1 .AND. jj < jpj ) THEN
295                DO jn = 1, ncsnr(jc)
296                  ji = mi0(ncsir(jc,jn))
297                  jj = mj0(ncsjr(jc,jn)) ! Location of outflow in open ocean
298                  emp (ji,jj) = emp (ji,jj) + zemp(jc)   &
299                      / (FLOAT(ncsnr(jc)) *  e1t(ji,jj) * e2t(ji,jj) )
300                  emps(ji,jj) = emps(ji,jj) + zemp(jc)   &
301                      / (FLOAT(ncsnr(jc)) *  e1t(ji,jj) * e2t(ji,jj) )
302                END DO
303            ENDIF
304         ENDIF
305
306         DO jj = ncsj1(jc), ncsj2(jc)
307            DO ji = ncsi1(jc), ncsi2(jc)
308               emp (ji,jj) = emp (ji,jj) - zemp(jc) / surf(jc)
309               emps(ji,jj) = emps(ji,jj) - zemp(jc) / surf(jc)
310            END DO 
311         END DO
312
313      END DO 
314
315
316      ! 5. Boundary condition on emp and emps
317      ! -------------------------------------
318      CALL lbc_lnk( emp , 'T', 1. )
319      CALL lbc_lnk( emps, 'T', 1. )
320
321   END SUBROUTINE flx_clo
322
323   !!======================================================================
324END MODULE closea
Note: See TracBrowser for help on using the repository browser.