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 @ 3

Last change on this file since 3 was 3, checked in by opalod, 20 years ago

Initial revision
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 12.5 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 , LODYC-IPSL (2003)
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      !! History :
71      !!        !  01-04  (E. Durand)  Original code
72      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
73      !!----------------------------------------------------------------------
74      !! * Local variables
75      INTEGER ::   jc            ! dummy loop indices
76      !!----------------------------------------------------------------------
77     
78      IF(lwp) WRITE(numout,*)
79      IF(lwp) WRITE(numout,*)' dom_clo : closed seas '
80      IF(lwp) WRITE(numout,*)' ~~~~~~~'
81
82      ! initial values
83      ncsnr(:) = 1  ;  ncsi1(:) = 1  ;  ncsi2(:) = 1  ;  ncsir(:,:) = 1
84      ncstt(:) = 0  ;  ncsj1(:) = 1  ;  ncsj2(:) = 1  ;  ncsjr(:,:) = 1
85
86      ! set the closed seas (in data domain indices)
87      ! -------------------
88
89      IF( cp_cfg == "orca" ) THEN
90   
91         SELECT CASE ( jp_cfg )
92         !                                           ! =======================
93         CASE ( 2 )                                  !  ORCA_R2 configuration
94            !                                        ! =======================
95
96            !                                            ! Caspian Sea
97            ncsnr(1)   =   1  ;  ncstt(1)   =   0           ! spread over the globe
98            ncsi1(1)   =  11  ;  ncsj1(1)   = 103
99            ncsi2(1)   =  17  ;  ncsj2(1)   = 112
100            ncsir(1,1) =   1  ;  ncsjr(1,1) =   1 
101            !                                            ! Great North American Lakes
102            ncsnr(2)   =   1  ;  ncstt(2)   =   2           ! put at St Laurent mouth
103            ncsi1(2)   =  97  ;  ncsj1(2)   = 107
104            ncsi2(2)   = 103  ;  ncsj2(2)   = 111
105            ncsir(2,1) = 110  ;  ncsjr(2,1) = 111
106            !                                            ! Black Sea 1 : west part of the Black Sea
107            ncsnr(3)   = 1    ; ncstt(3)   =   2            !            (ie west of the cyclic b.c.)
108            ncsi1(3)   = 174  ; ncsj1(3)   = 107            ! put in Med Sea
109            ncsi2(3)   = 181  ; ncsj2(3)   = 112
110            ncsir(3,1) = 171  ; ncsjr(3,1) = 106 
111            !                                            ! Black Sea 2 : est part of the Black Sea
112            ncsnr(4)   =   1  ;  ncstt(4)   =   2           !               (ie est of the cyclic b.c.)
113            ncsi1(4)   =   2  ;  ncsj1(4)   = 107           ! put in Med Sea
114            ncsi2(4)   =   6  ;  ncsj2(4)   = 112
115            ncsir(4,1) = 171  ;  ncsjr(4,1) = 106 
116
117            !                                        ! =======================
118         CASE ( 4 )                                  !  ORCA_R4 configuration
119            !                                        ! =======================
120
121            !                                            ! Caspian Sea
122            ncsnr(1)   =  1  ;  ncstt(1)   =  0 
123            ncsi1(1)   =  4  ;  ncsj1(1)   = 53 
124            ncsi2(1)   =  4  ;  ncsj2(1)   = 56
125            ncsir(1,1) =  1  ;  ncsjr(1,1) =  1
126            !                                            ! Great North American Lakes
127            ncsnr(2)   =  1  ;  ncstt(2)   =  2 
128            ncsi1(2)   = 49  ;  ncsj1(2)   = 55
129            ncsi2(2)   = 51  ;  ncsj2(2)   = 56
130            ncsir(2,1) = 57  ;  ncsjr(2,1) = 55
131            !                                            ! Black Sea
132            ncsnr(3)   =  4  ;  ncstt(3)   =  2 
133            ncsi1(3)   = 88  ;  ncsj1(3)   = 55 
134            ncsi2(3)   = 91  ;  ncsj2(3)   = 56
135            ncsir(3,1) = 86  ;  ncsjr(3,1) = 53
136            ncsir(3,2) = 87  ;  ncsjr(3,2) = 53 
137            ncsir(3,3) = 86  ;  ncsjr(3,3) = 52 
138            ncsir(3,4) = 87  ;  ncsjr(3,4) = 52
139            !                                            ! Baltic Sea
140            ncsnr(4)   =  1  ;  ncstt(4)   =  2
141            ncsi1(4)   = 75  ;  ncsj1(4)   = 59
142            ncsi2(4)   = 76  ;  ncsj2(4)   = 61
143            ncsir(4,1) = 84  ;  ncsjr(4,1) = 59 
144
145         END SELECT
146
147      ENDIF
148
149      ! convert the position in local domain indices
150      ! --------------------------------------------
151      DO jc = 1, jpncs
152         ncsi1(jc)   = mi0( ncsi1(jc) )
153         ncsj1(jc)   = mj0( ncsj1(jc) )
154
155         ncsi2(jc)   = mi1( ncsi1(jc) )
156         ncsj2(jc)   = mj1( ncsj1(jc) )
157      END DO
158         
159
160   END SUBROUTINE dom_clo
161
162
163   SUBROUTINE flx_clo( kt )
164      !!---------------------------------------------------------------------
165      !!                  ***  ROUTINE flx_clo  ***
166      !!                   
167      !! ** Purpose :   Special handling of closed seas
168      !!
169      !! ** Method  :   Water flux is forced to zero over closed sea
170      !!      Excess is shared between remaining ocean, or
171      !!      put as run-off in open ocean.
172      !!
173      !! ** Action :
174      !!
175      !! History :
176      !!   8.2  !  00-05  (O. Marti)  Original code
177      !!   8.5  !  02-07  (G. Madec)  Free form, F90
178      !!----------------------------------------------------------------------
179      !! * Arguments
180      INTEGER, INTENT (in) :: kt
181
182      !! * Local declarations
183      REAL(wp), DIMENSION (jpncs) :: zemp
184      INTEGER  :: ji, jj, jc, jn
185      REAL(wp) :: zze2
186      !!----------------------------------------------------------------------
187
188      ! 1 - Initialisation
189      ! ------------------
190
191      IF( kt == nit000 ) THEN
192         IF(lwp) WRITE(numout,*)
193         IF(lwp) WRITE(numout,*)' flx_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                  ! surface of closed seas
204                  surf(jc) = surf(jc) + e1t(ji,jj)*e2t(ji,jj)*tmask_i(ji,jj)
205                  ! upstream in closed seas
206                  upsadv(ji,jj) = 0.5
207               END DO
208            END DO 
209            ! upstream at closed sea outflow
210            IF( ncstt(jc) >= 1 ) THEN
211                DO jn = 1, 4
212                  ji = mi0( ncsir(jc,jn) )
213                  jj = mj0( ncsjr(jc,jn) )
214                  upsrnfh(ji,jj) = MAX( upsrnfh(ji,jj), 1.0 )
215                END DO
216            ENDIF
217         END DO 
218
219#   if defined key_mpp
220         ! Mpp: sum over all the global domain
221         CALL mpp_sum ( surf, jpncs+1 )
222#   endif
223
224         IF(lwp) WRITE(numout,*)'     Closed sea surfaces'
225         DO jc = 1, jpncs
226            IF(lwp) WRITE(numout,FMT='(1I3,4I4,5X,F16.2)')    &
227                jc, ncsi1(jc), ncsi2(jc), ncsj1(jc), ncsj2(jc), surf(jc)
228         END DO
229
230         ! jpncs+1 : surface of sea, closed seas excluded
231         DO jc = 1, jpncs
232            surf(jpncs+1) = surf(jpncs+1) - surf(jc)
233         END DO           
234 
235      ENDIF
236
237      ! 2 - Computation
238      ! ---------------
239      zemp = 0.0e0
240
241      DO jc = 1, jpncs
242         DO jj = ncsj1(jc), ncsj2(jc)
243            DO ji = ncsi1(jc), ncsi2(jc)
244               zemp(jc) = zemp(jc) + e1t(ji,jj) * e2t(ji,jj) * emp(ji,jj) * tmask_i(ji,jj)
245            END DO 
246         END DO
247      END DO
248#   if defined key_mpp
249      ! Mpp: sum over all the global domain
250      CALL mpp_sum ( zemp , jpncs )
251#   endif
252
253      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN      ! Black Sea case for ORCA_R2 configuration
254         zze2    = ( zemp(3) + zemp(4) ) / 2.
255         zemp(3) = zze2
256         zemp(4) = zze2
257      ENDIF
258
259      DO jc = 1, jpncs
260
261         IF( ncstt(jc) == 0 ) THEN 
262            ! water/evap excess is shared by all open ocean
263            emp (:,:) = emp (:,:) + zemp(jc) / surf(jpncs+1)
264            emps(:,:) = emps(:,:) + zemp(jc) / surf(jpncs+1)
265         ELSEIF( ncstt(jc) == 1 ) THEN 
266            ! Excess water in open sea, at outflow location, excess evap shared
267            IF ( zemp(jc) <= 0.0e0 ) THEN
268                DO jn = 1, ncsnr(jc)
269                  ji = mi0(ncsir(jc,jn))
270                  jj = mj0(ncsjr(jc,jn)) ! Location of outflow in open ocean
271                  IF (      ji > 1 .AND. ji < jpi   &
272                      .AND. jj > 1 .AND. jj < jpj ) THEN
273                      emp (ji,jj) = emp (ji,jj) + zemp(jc) /   &
274                         (FLOAT(ncsnr(jc)) * e1t(ji,jj) * e2t(ji,jj))
275                      emps(ji,jj) = emps(ji,jj) + zemp(jc) /   &
276                          (FLOAT(ncsnr(jc)) * e1t(ji,jj) * e2t(ji,jj))
277                  END IF
278                END DO
279            ELSE
280                emp (:,:) = emp (:,:) + zemp(jc) / surf(jpncs+1)
281                emps(:,:) = emps(:,:) + zemp(jc) / surf(jpncs+1)
282            ENDIF
283         ELSEIF( ncstt(jc) == 2 ) THEN 
284            ! Excess e-p+r (either sign) goes to open ocean, at outflow location
285            IF(      ji > 1 .AND. ji < jpi    &
286               .AND. jj > 1 .AND. jj < jpj ) THEN
287                DO jn = 1, ncsnr(jc)
288                  ji = mi0(ncsir(jc,jn))
289                  jj = mj0(ncsjr(jc,jn)) ! Location of outflow in open ocean
290                  emp (ji,jj) = emp (ji,jj) + zemp(jc)   &
291                      / (FLOAT(ncsnr(jc)) *  e1t(ji,jj) * e2t(ji,jj) )
292                  emps(ji,jj) = emps(ji,jj) + zemp(jc)   &
293                      / (FLOAT(ncsnr(jc)) *  e1t(ji,jj) * e2t(ji,jj) )
294                END DO
295            ENDIF
296         ENDIF
297
298         DO jj = ncsj1(jc), ncsj2(jc)
299            DO ji = ncsi1(jc), ncsi2(jc)
300               emp (ji,jj) = emp (ji,jj) - zemp(jc) / surf(jc)
301               emps(ji,jj) = emps(ji,jj) - zemp(jc) / surf(jc)
302            END DO 
303         END DO
304
305      END DO 
306
307
308      ! 5. Boundary condition on emp and emps
309      ! -------------------------------------
310      CALL lbc_lnk( emp , 'T', 1. )
311      CALL lbc_lnk( emps, 'T', 1. )
312
313   END SUBROUTINE flx_clo
314
315   !!======================================================================
316END MODULE closea
Note: See TracBrowser for help on using the repository browser.