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.
cla_div.F90 in trunk/NEMO/OPA_SRC – NEMO

source: trunk/NEMO/OPA_SRC/cla_div.F90 @ 896

Last change on this file since 896 was 888, checked in by ctlod, 16 years ago

merge dev_001_SBC branche with the trunk to include the New Surface Module package, see ticket: #113

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 20.2 KB
Line 
1MODULE cla_div
2   !!==============================================================================
3   !!                    ***  MODULE  cla_div  ***
4   !! Ocean diagnostic variable : specific update of the horizontal divergence
5   !!                             CAUTION: Specific to ORCA_R2
6   !!==============================================================================
7#if defined key_orca_r2
8   !!----------------------------------------------------------------------
9   !!   'key_orca_r2'                                 global ocean model R2
10   !!----------------------------------------------------------------------
11   !!   div_cla      :
12   !!   div_bab_el_mandeb
13   !!   div_gibraltar
14   !!   div_hormuz
15   !!   div_cla_init :
16   !!----------------------------------------------------------------------
17   !! * Modules used
18   USE oce             ! ocean dynamics and tracers
19   USE dom_oce         ! ocean space and time domain
20   USE sbc_oce         ! surface boundary condition: ocean
21   USE in_out_manager  ! I/O manager
22   USE lib_mpp         ! distributed memory computing library
23   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
24
25   IMPLICIT NONE
26   PRIVATE
27
28   !! * Module variables
29   REAL(wp) :: zempmed, zempred       ! EMP of Mediterranean and Red Sea
30
31   REAL(wp) :: zisw_rs, zbrw_rs, zurw_rs          ! imposed transport at Red Sea
32   REAL(wp) :: zisw_ms, zbrw_ms, zurw_ms, zmrw_ms ! imposed transport at Mediterranean Sea
33   REAL(wp) :: zisw_pg, zbrw_pg                   ! imposed transport at Persic Gulf
34
35   REAL(wp), DIMENSION (jpk) ::   &
36      zu1_rs_i, zu2_rs_i, zu3_rs_i,                   & ! Red Sea velocities
37      zu1_ms_i, zu2_ms_i, zu3_ms_i,                   & ! Mediterranean Sea velocities
38      zu_pg                                             ! Persic Gulf velocities
39   
40   !! * Routine accessibility
41   PUBLIC div_cla     ! routine called by step.F90
42
43   !! * Substitutions
44#  include "domzgr_substitute.h90"
45   !!----------------------------------------------------------------------
46   !!   OPA 9.0 , LOCEAN-IPSL (2005)
47   !! $Id$
48   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
49   !!----------------------------------------------------------------------
50
51CONTAINS
52
53   SUBROUTINE div_cla ( kt )
54      !!----------------------------------------------------------------------
55      !!                 ***  ROUTINE div_cla  ***
56      !!
57      !! ** Purpose :   update the horizontal divergence of the velocity field
58      !!      for at some straits ( Gibraltar, Bab el Mandeb and Hormuz ).
59      !!
60      !! ** Method  :   With imposed transport at each strait, we compute
61      !!      corresponding velocities and update horizontal divergence.
62      !!        Apply lateral boundary conditions on hdivn through a call
63      !!      to routine lbc_lnk.
64      !!
65      !! ** Action  :   update hdivn array : the now horizontal divergence
66      !!
67      !! History :
68      !!   8.5  !  02-11 (A. Bozec)  Free form, F90
69      !!----------------------------------------------------------------------
70      !! * Arguments
71      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
72      !!----------------------------------------------------------------------
73
74      ! Correction of the Divergence at some straits
75           
76      IF( kt == nit000 )     CALL div_cla_init    ! Initialization
77
78      CALL div_bab_el_mandeb                        ! New divergence at Bab el Mandeb
79
80      CALL div_gibraltar                            ! New divergence at Gibraltar
81
82      CALL div_hormuz                               ! Hormuz Strait ( persian Gulf)
83
84      ! Lateral boundary conditions on hdivn
85      CALL lbc_lnk( hdivn, 'T', 1. )
86
87   END SUBROUTINE div_cla
88
89   SUBROUTINE div_bab_el_mandeb
90      !!----------------------------------------------------------------------
91      !!                ***  ROUTINE div_bab_el_mandeb  ***
92      !!       
93      !! ** Purpose :   Update  the now horizontal divergence of the velocity
94      !!     field in Bab el Mandeb ( Red Sea strait ).
95      !!
96      !! ** Method  :   Set the velocity field at each side of the strait :
97      !!                                          |
98      !!            |/ \|            N          |\ /|
99      !!            |_|_|______      |          |___|______
100      !!        88  |   |<-       W - - E    88 |   |<-
101      !!        87  |___|______      |       87 |___|->____
102      !!             160 161         S           160 161
103      !!       horizontal view                horizontal view
104      !!          surface                        depth
105      !!      The now divergence is given by :
106      !!         hdivn = 1/(e1t*e2t) [ di(e2u  un) + dj(e1v  vn) ]
107      !!
108      !! ** History :
109      !!           !         (A. Bozec) Original code
110      !!      8.5  !  02-11  (A. Bozec) F90: Free form and module
111      !!----------------------------------------------------------------------
112      !! * Local declarations
113      INTEGER  :: ji, jj, jk   ! dummy loop indices
114      REAL(wp) :: zsu, zvt, zwei   ! temporary scalar
115      REAL(wp), DIMENSION (jpk) ::  zu1_rs, zu2_rs, zu3_rs
116      !!---------------------------------------------------------------------
117     
118      ! EMP on the Red Sea
119      ! ------------------
120
121      zempred = 0.e0
122      zwei = 0.e0
123      DO jj = mj0(87), mj1(96)
124         DO ji = mi0(148), mi1(160) 
125            zwei    = tmask(ji,jj,1) * e1t(ji,jj) * e2t(ji,jj)
126            zempred = zempred + emp(ji,jj) * zwei
127         END DO
128      END DO
129      IF( lk_mpp )   CALL mpp_sum( zempred )      ! sum with other processors value
130
131
132      ! convert in m3
133      zempred = zempred * 1.e-3         
134
135      ! Velocity profile at each point
136      ! ------------------------------
137
138      zu1_rs(:) = zu1_rs_i(:)
139      zu2_rs(:) = zu2_rs_i(:)
140      zu3_rs(:) = zu3_rs_i(:)
141
142      ! velocity profile at 161,88 North point
143      ! we imposed zisw_rs + EMP above the Red Sea
144      DO jk = 1,  8                                     
145         DO jj = mj0(88), mj1(88) 
146            DO ji = mi0(160), mi1(160) 
147               zu1_rs(jk) = zu1_rs(jk) - ( zempred / 8. ) / ( e2u(ji, jj) * fse3u(ji, jj,jk) )
148            END DO
149         END DO
150      END DO
151
152      ! velocity profile at 160,88 North  point
153      ! we imposed zisw_rs + EMP above the Red Sea
154      DO jk = 1,  10                                     
155         DO jj = mj0(88), mj1(88) 
156            DO ji = mi0(160), mi1(160) 
157               zu3_rs(jk) = zu3_rs(jk) + ( zempred / 10. ) / ( e1v(ji, jj) * fse3v(ji, jj,jk) )
158            END DO
159         END DO
160      END DO
161       
162      ! Divergence at each point of the straits
163      ! ---------------------------------------
164
165      ! compute the new divergence at 161,88
166      DO jk = 1, 21
167         DO jj = mj0(88), mj1(88) 
168            DO ji = mi0(161), mi1(161) 
169               zvt = e1t(ji, jj) * e2t(ji, jj) * fse3t(ji, jj,jk)
170               zsu = e2u(ji-1, jj) * fse3u(ji-1, jj,jk)
171               hdivn(ji, jj  ,jk) = hdivn(ji, jj  ,jk) - ( 1. / zvt ) * zsu * zu1_rs(jk)
172            END DO
173         END DO
174      END DO
175
176      ! compute the new divergence at 161,87
177      DO jk = 1, 21
178         DO jj = mj0(87), mj1(87) 
179            DO ji = mi0(161), mi1(161) 
180               zvt = e1t(ji, jj) * e2t(ji, jj) * fse3t(ji, jj,jk)
181               zsu = e2u(ji-1, jj) * fse3u(ji-1, jj,jk)
182               hdivn(ji, jj,jk) = hdivn(ji, jj,jk) - ( 1. / zvt ) * zsu * zu2_rs(jk)
183            END DO
184         END DO
185      END DO
186
187      ! compute the divergence at 160,89
188      DO jk = 1, 18
189         DO jj = mj0(89), mj1(89) 
190            DO ji = mi0(160), mi1(160) 
191               zvt = e1t(ji, jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
192               zsu = e1v(ji, jj-1) * fse3v(ji, jj-1,jk)
193               hdivn(ji, jj,jk) = hdivn(ji, jj,jk) - ( 1. / zvt ) * zsu * zu3_rs(jk)
194            END DO
195         END DO
196      END DO
197
198   END SUBROUTINE div_bab_el_mandeb
199
200   SUBROUTINE div_gibraltar
201      !! -------------------------------------------------------------------
202      !!                 ***  ROUTINE div_gibraltar  ***
203      !!       
204      !! ** Purpose :   update the now horizontal divergence of the velocity
205      !!     field in Gibraltar.
206      !!
207      !! ** Method :
208      !!          ________________      N        ________________
209      !! 102           |    |->         |           <-|    |<-
210      !! 101      ___->|____|_____   W - - E     ___->|____|_____
211      !!           139   140  141       |         139   140  141
212      !!          horizontal view       S        horizontal view
213      !!            surface                          depth
214      !!      The now divergence is given by :
215      !!         hdivn = 1/(e1t*e2t) [ di(e2u  un) + dj(e1v  vn) ]
216      !!
217      !! ** History :
218      !!           !         (A. Bozec) Original code
219      !!      8.5  !  02-10  (A. Bozec) F90: Free form and module
220      !!---------------------------------------------------------------------
221      !! * Local declarations
222      INTEGER  :: ji, jj, jk   ! dummy loop indices
223      REAL(wp) :: zsu, zvt
224      REAL(wp) :: zwei
225      REAL(wp), DIMENSION (jpk) ::  zu1_ms, zu2_ms, zu3_ms
226      !!---------------------------------------------------------------------
227     
228      ! EMP on the Mediterranean Sea
229      ! ----------------------------
230
231      zempmed = 0.e0
232      zwei = 0.e0
233      DO jj = mj0(96), mj1(110)
234         DO ji = mi0(141),mi1(181)
235            zwei    = tmask(ji,jj,1) * e1t(ji,jj) * e2t(ji,jj)
236            zempmed = zempmed + emp(ji,jj) * zwei
237         END DO
238      END DO
239      IF( lk_mpp )   CALL mpp_sum( zempmed )      ! sum with other processors value
240
241      ! minus 2 points in Red Sea and 3 in Atlantic
242      DO jj = mj0(96), mj1(96)
243         DO ji = mi0(148),mi1(148)
244            zempmed = zempmed -  emp(ji  , jj) * tmask(ji  , jj,1) * e1t(ji  , jj) * e2t(ji  , jj)   &
245                              -  emp(ji+1, jj) * tmask(ji+1, jj,1) * e1t(ji+1, jj) * e2t(ji+1, jj)   
246         END DO
247      END DO
248
249      ! convert in m3
250      zempmed = zempmed * 1.e-3
251
252      ! Velocity profile at each point
253      ! ------------------------------
254
255      zu1_ms(:) = zu1_ms_i(:)
256      zu2_ms(:) = zu2_ms_i(:)
257      zu3_ms(:) = zu3_ms_i(:)
258
259      ! velocity profile at 139,101 South point
260      ! we imposed zisw + EMP above the Mediterranean Sea
261      DO jk = 1, 14                     
262         DO jj = mj0(102), mj1(102) 
263            DO ji = mi0(140), mi1(140) 
264               zu1_ms(jk) =  zu1_ms(jk) + ( zempmed / 14. ) / ( e2u(ji-1, jj-1) * fse3u(ji-1, jj-1,jk) ) 
265            END DO
266         END DO
267      END DO
268     
269      ! velocity profile at 141,102  East point
270      ! flux in surface inflow of the Atlantic ocean + EMP   
271      DO  jk = 1, 14                     
272         DO jj = mj0(102), mj1(102) 
273            DO ji = mi0(140), mi1(140) 
274               zu3_ms(jk) = zu3_ms(jk) +  ( zempmed / 14. ) / ( e2u(ji, jj) * fse3u(ji, jj,jk) ) 
275            END DO
276         END DO
277      END DO
278     
279      ! Divergence at each point of the straits
280      ! ---------------------------------------
281
282      ! compute the new divergence at 139,101 South point 
283      DO jk = 1, jpk
284         DO jj = mj0(101), mj1(101) 
285            DO ji = mi0(139), mi1(139) 
286               zvt = e1t(ji, jj) * e2t(ji, jj) * fse3t(ji, jj,jk)
287               zsu = e2u(ji, jj) * fse3u(ji, jj,jk)
288               hdivn(ji, jj,jk) = hdivn(ji, jj,jk) + ( 1. / zvt ) * zsu * zu1_ms(jk) 
289            END DO
290         END DO
291      END DO
292
293      ! compute the new divergence at 139,102 deep North point
294      DO jk = 1, jpk
295         DO jj = mj0(102), mj1(102) 
296            DO ji = mi0(139), mi1(139) 
297               zvt = e1t(ji, jj) * e2t(ji, jj) * fse3t(ji, jj,jk)
298               zsu = e2u(ji, jj) * fse3u(ji, jj,jk)
299               hdivn(ji, jj,jk) = hdivn(ji, jj,jk) + ( 1. / zvt ) * zsu * zu2_ms(jk) 
300            END DO
301         END DO
302      END DO
303
304      ! compute the divergence at 141,102 East point
305      DO jk = 1, jpk
306         DO jj = mj0(102), mj1(102) 
307            DO ji = mi0(141), mi1(141) 
308               zvt = e1t(ji, jj) * e2t(ji, jj) * fse3t(ji, jj,jk)
309               zsu = e2u(ji-1, jj) * fse3u(ji-1, jj,jk)
310               hdivn(ji, jj,jk) = hdivn(ji, jj,jk) - ( 1. / zvt ) * zsu * zu3_ms(jk)
311            END DO
312         END DO
313      END DO
314
315   END SUBROUTINE div_gibraltar
316
317   SUBROUTINE div_hormuz
318      !! -------------------------------------------------------------------
319      !!                   ***  ROUTINE div_hormuz  ***
320      !!             
321      !! ** Purpose :   update the now horizontal divergence of the velocity
322      !!     field in Hormuz ( Persic Gulf strait ) .
323      !!
324      !! ** Method :
325      !!      The now divergence is given by :
326      !!         hdivn = 1/(e1t*e2t) [ di(e2u  un) + dj(e1v  vn) ]
327      !!
328      !! ** History :
329      !!           !         (A. Bozec) Original code
330      !!      8.5  !  02-10  (A. Bozec) F90: Free form and module
331      !!---------------------------------------------------------------------
332      !! * Local declarations
333      INTEGER  :: ji, jj, jk   ! dummy loop indices
334      REAL(wp) :: zsu, zvt     ! temporary scalars
335      !!---------------------------------------------------------------------
336
337      ! New divergence at Hormuz
338      ! ------------------------
339      DO jk = 1, jpk
340         DO jj = mj0(94), mj1(94) 
341            DO ji = mi0(172), mi1(172) 
342               zvt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
343               zsu = e2u(ji-1,jj) * fse3u(ji-1,jj,jk)
344               hdivn(ji,jj,jk) = hdivn(ji,jj,jk) - ( 1. / zvt ) * zsu * zu_pg(jk)
345            END DO
346         END DO
347      END DO
348
349   END SUBROUTINE div_hormuz
350
351
352   SUBROUTINE div_cla_init
353      !! -------------------------------------------------------------------
354      !!                   ***  ROUTINE div_cla_init  ***
355      !!           
356      !! ** Purpose :   Initialization of variables at all straits 
357      !!
358      !! ** History :
359      !!           !         (A. Bozec) Original code
360      !!      8.5  !  02-10  (A. Bozec) F90: Free form and module
361      !!---------------------------------------------------------------------
362      !! * Local declarations
363      INTEGER  :: ji, jj, jk   ! dummy loop indices
364      !!---------------------------------------------------------------------
365
366      ! Control print
367      ! -------------
368      IF(lwp) WRITE(numout,*)
369      IF(lwp) WRITE(numout,*) 'divmod_cross_land : cross land advection on divergence '
370      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~'
371      IF(lwp) WRITE(numout,*) ' '
372
373      ! Initialization at Bab el Mandeb
374      ! -------------------------------
375
376      ! imposed transport
377      zisw_rs = 0.4e6             ! inflow surface water
378      zurw_rs = 0.2e6             ! upper recirculation water
379!Alex      zbrw = 1.2e6        ! bottom  recirculation water
380      zbrw_rs = 0.5e6             ! bottom  recirculation water
381
382      ! initialization of the velocity
383      zu1_rs_i(:) = 0.e0          ! velocity profile at 161,88 South point
384      zu2_rs_i(:) = 0.e0          ! velocity profile at 161,87 North point
385      zu3_rs_i(:) = 0.e0          ! velocity profile at 160,88 East  point
386
387      ! velocity profile at 161,88 North point
388      ! we imposed zisw_rs + EMP above the Red Sea
389      DO jk = 1,  8                                     
390         DO jj = mj0(88), mj1(88) 
391            DO ji = mi0(160), mi1(160) 
392               zu1_rs_i(jk) = -( zisw_rs / 8. ) / ( e2u(ji, jj) * fse3u(ji, jj,jk) )
393            END DO
394         END DO
395      END DO
396
397      ! recirculation water
398      DO jj = mj0(88), mj1(88) 
399         DO ji = mi0(160), mi1(160) 
400            zu1_rs_i(20) =            - zurw_rs   / ( e2u(ji, jj) * fse3u(ji, jj,20) )
401            zu1_rs_i(21) = -( zbrw_rs - zurw_rs ) / ( e2u(ji, jj) * fse3u(ji, jj,21) )
402         END DO
403      END DO
404     
405      ! velocity profile at 161,87 South point
406      DO jj = mj0(88), mj1(88) 
407         DO ji = mi0(160), mi1(160) 
408            zu2_rs_i(21) =  ( zbrw_rs + zisw_rs ) / ( e2u(ji, jj-1 ) * fse3u(ji, jj-1,21) )
409         END DO
410      END DO
411
412      ! velocity profile at 160,88 North  point
413      ! we imposed zisw_rs + EMP above the Red Sea
414      DO jk = 1,  10                                     
415         DO jj = mj0(88), mj1(88) 
416            DO ji = mi0(160), mi1(160) 
417               zu3_rs_i(jk) = ( zisw_rs / 10. ) / ( e1v(ji, jj) * fse3v(ji, jj,jk) )
418            END DO
419         END DO
420      END DO
421
422      ! deeper
423      DO jj = mj0(88), mj1(88) 
424         DO ji = mi0(160), mi1(160) 
425            zu3_rs_i(16)  = - zisw_rs / ( e1v(ji, jj) * fse3v(ji, jj,16) )
426         END DO
427      END DO
428     
429
430      ! Initialization at Gibraltar
431      ! ---------------------------
432
433      ! imposed transport
434      zisw_ms = 0.8e6             ! inflow surface  water
435      zmrw_ms = 0.7e6             ! middle recirculation water
436      zurw_ms = 2.5e6             ! upper  recirculation water
437      zbrw_ms = 3.5e6             ! bottom recirculation water
438
439      ! initialization of the velocity
440      zu1_ms_i(:) = 0.e0          ! velocity profile at 139,101 South point
441      zu2_ms_i(:) = 0.e0          ! velocity profile at 139,102 North point
442      zu3_ms_i(:) = 0.e0          ! velocity profile at 141,102 East  point
443
444      ! velocity profile at 139,101 South point
445      DO jk = 1, 14                     
446         DO jj = mj0(102), mj1(102) 
447            DO ji = mi0(140), mi1(140) 
448               zu1_ms_i(jk) =  ( zisw_ms / 14. ) / ( e2u(ji-1, jj-1) * fse3u(ji-1, jj-1,jk) ) 
449            END DO
450         END DO
451      END DO
452
453      ! recirculation water
454      DO jk = 15, 20                     
455         DO jj = mj0(102), mj1(102) 
456            DO ji = mi0(140), mi1(140) 
457               zu1_ms_i(jk) =  ( zmrw_ms / 6. ) / ( e2u(ji-1, jj-1) * fse3u(ji-1, jj-1,jk) ) 
458            END DO
459         END DO
460      END DO
461
462      DO jj = mj0(102), mj1(102) 
463         DO ji = mi0(140), mi1(140) 
464            zu1_ms_i(21) =  (           zurw_ms ) / ( e2u(ji-1, jj-1) * fse3u(ji-1, jj-1,21) )
465            zu1_ms_i(22) =  ( zbrw_ms - zurw_ms ) / ( e2u(ji-1, jj-1) * fse3u(ji-1, jj-1,22) )
466         END DO
467      END DO
468     
469      ! velocity profile at 139,102 North point
470      DO jk = 15, 20                     
471         DO jj = mj0(102), mj1(102) 
472            DO ji = mi0(140), mi1(140) 
473               zu2_ms_i(jk) = -( zmrw_ms / 6. ) / ( e2u(ji-1, jj) * fse3u(ji-1, jj,jk) ) 
474            END DO
475         END DO
476      END DO
477
478      ! outflow of Mediterranean sea + recirculation
479      DO jj = mj0(102), mj1(102) 
480         DO ji = mi0(140), mi1(140) 
481            zu2_ms_i(22) = -( zisw_ms + zbrw_ms ) / ( e2u(ji-1, jj) * fse3u(ji-1, jj,22) )
482         END DO
483      END DO
484     
485      ! velocity profile at 141,102  East point
486      ! flux in surface inflow of the Atlantic ocean   
487      DO  jk = 1, 14                     
488         DO jj = mj0(102), mj1(102) 
489            DO ji = mi0(140), mi1(140) 
490               zu3_ms_i(jk) =  ( zisw_ms / 14. ) / ( e2u(ji, jj) * fse3u(ji, jj,jk) ) 
491            END DO
492         END DO
493      END DO
494
495      ! deeper
496      DO jj = mj0(102), mj1(102) 
497         DO ji = mi0(140), mi1(140) 
498            zu3_ms_i(21) = - zisw_ms / ( e2u(ji, jj) * fse3u(ji, jj,21) )
499         END DO
500      END DO
501
502      ! Initialization at Hormuz
503      ! ------------------------
504
505      ! imposed transport
506      zisw_pg = 4. * 0.25e6       ! inflow surface  water
507      zbrw_pg = 4. * 0.25e6       ! bottom recirculation water
508
509      ! initialization of the velocity
510      zu_pg(:) = 0.e0           ! velocity profile at 172,94
511
512      ! velocity profile
513      DO jk = 1, 8 
514         DO jj = mj0(94), mj1(94) 
515            DO ji = mi0(172), mi1(172) 
516               zu_pg(jk) = -( zisw_pg / 8. ) / ( e2u(ji-1,jj) * fse3u(ji-1,jj, jk) )
517            END DO
518         END DO
519      END DO
520
521      DO jk = 16, 18
522         DO jj = mj0(94), mj1(94) 
523            DO ji = mi0(172), mi1(172) 
524               zu_pg(jk) =  ( zbrw_pg / 3. ) / ( e2u(ji-1,jj) * fse3u(ji-1,jj, jk) )
525            END DO
526         END DO
527      END DO
528
529   END SUBROUTINE div_cla_init
530#else
531   !!----------------------------------------------------------------------
532   !!   Default key                                            Dummy module
533   !!----------------------------------------------------------------------
534CONTAINS
535   SUBROUTINE div_cla( kt )
536      WRITE(*,*) 'div_cla: You should have not see this print! error?', kt
537   END SUBROUTINE div_cla
538#endif
539   
540   !!======================================================================
541END MODULE cla_div
Note: See TracBrowser for help on using the repository browser.