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

Last change on this file since 392 was 247, checked in by opalod, 19 years ago

CL : Add CVS Header and CeCILL licence information
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 20.3 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 in_out_manager  ! I/O manager
21   USE ocesbc          ! ocean surface boundary condition (fluxes)
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   !! $Header$
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      !!       * z-coordinate (default key) and partial steps (key_partial_steps)
107      !!         hdivn = 1/(e1t*e2t) [ di(e2u  un) + dj(e1v  vn) ]
108      !!
109      !! ** History :
110      !!           !         (A. Bozec) Original code
111      !!      8.5  !  02-11  (A. Bozec) F90: Free form and module
112      !!----------------------------------------------------------------------
113      !! * Local declarations
114      INTEGER  :: ji, jj, jk   ! dummy loop indices
115      REAL(wp) :: zsu, zvt, zwei   ! temporary scalar
116      REAL(wp), DIMENSION (jpk) ::  zu1_rs, zu2_rs, zu3_rs
117      !!---------------------------------------------------------------------
118     
119      ! EMP on the Red Sea
120      ! ------------------
121
122      zempred = 0.e0
123      zwei = 0.e0
124      DO jj = mj0(87), mj1(96)
125         DO ji = mi0(148), mi1(160) 
126            zwei    = tmask(ji,jj,1) * e1t(ji,jj) * e2t(ji,jj)
127            zempred = zempred + emp(ji,jj) * zwei
128         END DO
129      END DO
130      IF( lk_mpp )   CALL mpp_sum( zempred )      ! sum with other processors value
131
132
133      ! convert in m3
134      zempred = zempred * 1.e-3         
135
136      ! Velocity profile at each point
137      ! ------------------------------
138
139      zu1_rs(:) = zu1_rs_i(:)
140      zu2_rs(:) = zu2_rs_i(:)
141      zu3_rs(:) = zu3_rs_i(:)
142
143      ! velocity profile at 161,88 North point
144      ! we imposed zisw_rs + EMP above the Red Sea
145      DO jk = 1,  8                                     
146         DO jj = mj0(88), mj1(88) 
147            DO ji = mi0(160), mi1(160) 
148               zu1_rs(jk) = zu1_rs(jk) - ( zempred / 8. ) / ( e2u(ji, jj) * fse3u(ji, jj,jk) )
149            END DO
150         END DO
151      END DO
152
153      ! velocity profile at 160,88 North  point
154      ! we imposed zisw_rs + EMP above the Red Sea
155      DO jk = 1,  10                                     
156         DO jj = mj0(88), mj1(88) 
157            DO ji = mi0(160), mi1(160) 
158               zu3_rs(jk) = zu3_rs(jk) + ( zempred / 10. ) / ( e1v(ji, jj) * fse3v(ji, jj,jk) )
159            END DO
160         END DO
161      END DO
162       
163      ! Divergence at each point of the straits
164      ! ---------------------------------------
165
166      ! compute the new divergence at 161,88
167      DO jk = 1, 21
168         DO jj = mj0(88), mj1(88) 
169            DO ji = mi0(161), mi1(161) 
170               zvt = e1t(ji, jj) * e2t(ji, jj) * fse3t(ji, jj,jk)
171               zsu = e2u(ji-1, jj) * fse3u(ji-1, jj,jk)
172               hdivn(ji, jj  ,jk) = hdivn(ji, jj  ,jk) - ( 1. / zvt ) * zsu * zu1_rs(jk)
173            END DO
174         END DO
175      END DO
176
177      ! compute the new divergence at 161,87
178      DO jk = 1, 21
179         DO jj = mj0(87), mj1(87) 
180            DO ji = mi0(161), mi1(161) 
181               zvt = e1t(ji, jj) * e2t(ji, jj) * fse3t(ji, jj,jk)
182               zsu = e2u(ji-1, jj) * fse3u(ji-1, jj,jk)
183               hdivn(ji, jj,jk) = hdivn(ji, jj,jk) - ( 1. / zvt ) * zsu * zu2_rs(jk)
184            END DO
185         END DO
186      END DO
187
188      ! compute the divergence at 160,89
189      DO jk = 1, 18
190         DO jj = mj0(89), mj1(89) 
191            DO ji = mi0(160), mi1(160) 
192               zvt = e1t(ji, jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
193               zsu = e1v(ji, jj-1) * fse3v(ji, jj-1,jk)
194               hdivn(ji, jj,jk) = hdivn(ji, jj,jk) - ( 1. / zvt ) * zsu * zu3_rs(jk)
195            END DO
196         END DO
197      END DO
198
199   END SUBROUTINE div_bab_el_mandeb
200
201   SUBROUTINE div_gibraltar
202      !! -------------------------------------------------------------------
203      !!                 ***  ROUTINE div_gibraltar  ***
204      !!       
205      !! ** Purpose :   update the now horizontal divergence of the velocity
206      !!     field in Gibraltar.
207      !!
208      !! ** Method :
209      !!          ________________      N        ________________
210      !! 102           |    |->         |           <-|    |<-
211      !! 101      ___->|____|_____   W - - E     ___->|____|_____
212      !!           139   140  141       |         139   140  141
213      !!          horizontal view       S        horizontal view
214      !!            surface                          depth
215      !!      The now divergence is given by :
216      !!         hdivn = 1/(e1t*e2t) [ di(e2u  un) + dj(e1v  vn) ]
217      !!
218      !! ** History :
219      !!           !         (A. Bozec) Original code
220      !!      8.5  !  02-10  (A. Bozec) F90: Free form and module
221      !!---------------------------------------------------------------------
222      !! * Local declarations
223      INTEGER  :: ji, jj, jk   ! dummy loop indices
224      REAL(wp) :: zsu, zvt
225      REAL(wp) :: zwei
226      REAL(wp), DIMENSION (jpk) ::  zu1_ms, zu2_ms, zu3_ms
227      !!---------------------------------------------------------------------
228     
229      ! EMP on the Mediterranean Sea
230      ! ----------------------------
231
232      zempmed = 0.e0
233      zwei = 0.e0
234      DO jj = mj0(96), mj1(110)
235         DO ji = mi0(141),mi1(181)
236            zwei    = tmask(ji,jj,1) * e1t(ji,jj) * e2t(ji,jj)
237            zempmed = zempmed + emp(ji,jj) * zwei
238         END DO
239      END DO
240      IF( lk_mpp )   CALL mpp_sum( zempmed )      ! sum with other processors value
241
242      ! minus 2 points in Red Sea and 3 in Atlantic
243      DO jj = mj0(96), mj1(96)
244         DO ji = mi0(148),mi1(148)
245            zempmed = zempmed -  emp(ji  , jj) * tmask(ji  , jj,1) * e1t(ji  , jj) * e2t(ji  , jj)   &
246                              -  emp(ji+1, jj) * tmask(ji+1, jj,1) * e1t(ji+1, jj) * e2t(ji+1, jj)   
247         END DO
248      END DO
249
250      ! convert in m3
251      zempmed = zempmed * 1.e-3
252
253      ! Velocity profile at each point
254      ! ------------------------------
255
256      zu1_ms(:) = zu1_ms_i(:)
257      zu2_ms(:) = zu2_ms_i(:)
258      zu3_ms(:) = zu3_ms_i(:)
259
260      ! velocity profile at 139,101 South point
261      ! we imposed zisw + EMP above the Mediterranean Sea
262      DO jk = 1, 14                     
263         DO jj = mj0(102), mj1(102) 
264            DO ji = mi0(140), mi1(140) 
265               zu1_ms(jk) =  zu1_ms(jk) + ( zempmed / 14. ) / ( e2u(ji-1, jj-1) * fse3u(ji-1, jj-1,jk) ) 
266            END DO
267         END DO
268      END DO
269     
270      ! velocity profile at 141,102  East point
271      ! flux in surface inflow of the Atlantic ocean + EMP   
272      DO  jk = 1, 14                     
273         DO jj = mj0(102), mj1(102) 
274            DO ji = mi0(140), mi1(140) 
275               zu3_ms(jk) = zu3_ms(jk) +  ( zempmed / 14. ) / ( e2u(ji, jj) * fse3u(ji, jj,jk) ) 
276            END DO
277         END DO
278      END DO
279     
280      ! Divergence at each point of the straits
281      ! ---------------------------------------
282
283      ! compute the new divergence at 139,101 South point 
284      DO jk = 1, jpk
285         DO jj = mj0(101), mj1(101) 
286            DO ji = mi0(139), mi1(139) 
287               zvt = e1t(ji, jj) * e2t(ji, jj) * fse3t(ji, jj,jk)
288               zsu = e2u(ji, jj) * fse3u(ji, jj,jk)
289               hdivn(ji, jj,jk) = hdivn(ji, jj,jk) + ( 1. / zvt ) * zsu * zu1_ms(jk) 
290            END DO
291         END DO
292      END DO
293
294      ! compute the new divergence at 139,102 deep North point
295      DO jk = 1, jpk
296         DO jj = mj0(102), mj1(102) 
297            DO ji = mi0(139), mi1(139) 
298               zvt = e1t(ji, jj) * e2t(ji, jj) * fse3t(ji, jj,jk)
299               zsu = e2u(ji, jj) * fse3u(ji, jj,jk)
300               hdivn(ji, jj,jk) = hdivn(ji, jj,jk) + ( 1. / zvt ) * zsu * zu2_ms(jk) 
301            END DO
302         END DO
303      END DO
304
305      ! compute the divergence at 141,102 East point
306      DO jk = 1, jpk
307         DO jj = mj0(102), mj1(102) 
308            DO ji = mi0(141), mi1(141) 
309               zvt = e1t(ji, jj) * e2t(ji, jj) * fse3t(ji, jj,jk)
310               zsu = e2u(ji-1, jj) * fse3u(ji-1, jj,jk)
311               hdivn(ji, jj,jk) = hdivn(ji, jj,jk) - ( 1. / zvt ) * zsu * zu3_ms(jk)
312            END DO
313         END DO
314      END DO
315
316   END SUBROUTINE div_gibraltar
317
318   SUBROUTINE div_hormuz
319      !! -------------------------------------------------------------------
320      !!                   ***  ROUTINE div_hormuz  ***
321      !!             
322      !! ** Purpose :   update the now horizontal divergence of the velocity
323      !!     field in Hormuz ( Persic Gulf strait ) .
324      !!
325      !! ** Method :
326      !!      The now divergence is given by :
327      !!         hdivn = 1/(e1t*e2t) [ di(e2u  un) + dj(e1v  vn) ]
328      !!
329      !! ** History :
330      !!           !         (A. Bozec) Original code
331      !!      8.5  !  02-10  (A. Bozec) F90: Free form and module
332      !!---------------------------------------------------------------------
333      !! * Local declarations
334      INTEGER  :: ji, jj, jk   ! dummy loop indices
335      REAL(wp) :: zsu, zvt     ! temporary scalars
336      !!---------------------------------------------------------------------
337
338      ! New divergence at Hormuz
339      ! ------------------------
340      DO jk = 1, jpk
341         DO jj = mj0(94), mj1(94) 
342            DO ji = mi0(172), mi1(172) 
343               zvt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
344               zsu = e2u(ji-1,jj) * fse3u(ji-1,jj,jk)
345               hdivn(ji,jj,jk) = hdivn(ji,jj,jk) - ( 1. / zvt ) * zsu * zu_pg(jk)
346            END DO
347         END DO
348      END DO
349
350   END SUBROUTINE div_hormuz
351
352
353   SUBROUTINE div_cla_init
354      !! -------------------------------------------------------------------
355      !!                   ***  ROUTINE div_cla_init  ***
356      !!           
357      !! ** Purpose :   Initialization of variables at all straits 
358      !!
359      !! ** History :
360      !!           !         (A. Bozec) Original code
361      !!      8.5  !  02-10  (A. Bozec) F90: Free form and module
362      !!---------------------------------------------------------------------
363      !! * Local declarations
364      INTEGER  :: ji, jj, jk   ! dummy loop indices
365      !!---------------------------------------------------------------------
366
367      ! Control print
368      ! -------------
369      IF(lwp) WRITE(numout,*)
370      IF(lwp) WRITE(numout,*) 'divmod_cross_land : cross land advection on divergence '
371      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~'
372      IF(lwp) WRITE(numout,*) ' '
373
374      ! Initialization at Bab el Mandeb
375      ! -------------------------------
376
377      ! imposed transport
378      zisw_rs = 0.4e6             ! inflow surface water
379      zurw_rs = 0.2e6             ! upper recirculation water
380!Alex      zbrw = 1.2e6        ! bottom  recirculation water
381      zbrw_rs = 0.5e6             ! bottom  recirculation water
382
383      ! initialization of the velocity
384      zu1_rs_i(:) = 0.e0          ! velocity profile at 161,88 South point
385      zu2_rs_i(:) = 0.e0          ! velocity profile at 161,87 North point
386      zu3_rs_i(:) = 0.e0          ! velocity profile at 160,88 East  point
387
388      ! velocity profile at 161,88 North point
389      ! we imposed zisw_rs + EMP above the Red Sea
390      DO jk = 1,  8                                     
391         DO jj = mj0(88), mj1(88) 
392            DO ji = mi0(160), mi1(160) 
393               zu1_rs_i(jk) = -( zisw_rs / 8. ) / ( e2u(ji, jj) * fse3u(ji, jj,jk) )
394            END DO
395         END DO
396      END DO
397
398      ! recirculation water
399      DO jj = mj0(88), mj1(88) 
400         DO ji = mi0(160), mi1(160) 
401            zu1_rs_i(20) =            - zurw_rs   / ( e2u(ji, jj) * fse3u(ji, jj,20) )
402            zu1_rs_i(21) = -( zbrw_rs - zurw_rs ) / ( e2u(ji, jj) * fse3u(ji, jj,21) )
403         END DO
404      END DO
405     
406      ! velocity profile at 161,87 South point
407      DO jj = mj0(88), mj1(88) 
408         DO ji = mi0(160), mi1(160) 
409            zu2_rs_i(21) =  ( zbrw_rs + zisw_rs ) / ( e2u(ji, jj-1 ) * fse3u(ji, jj-1,21) )
410         END DO
411      END DO
412
413      ! velocity profile at 160,88 North  point
414      ! we imposed zisw_rs + EMP above the Red Sea
415      DO jk = 1,  10                                     
416         DO jj = mj0(88), mj1(88) 
417            DO ji = mi0(160), mi1(160) 
418               zu3_rs_i(jk) = ( zisw_rs / 10. ) / ( e1v(ji, jj) * fse3v(ji, jj,jk) )
419            END DO
420         END DO
421      END DO
422
423      ! deeper
424      DO jj = mj0(88), mj1(88) 
425         DO ji = mi0(160), mi1(160) 
426            zu3_rs_i(16)  = - zisw_rs / ( e1v(ji, jj) * fse3v(ji, jj,16) )
427         END DO
428      END DO
429     
430
431      ! Initialization at Gibraltar
432      ! ---------------------------
433
434      ! imposed transport
435      zisw_ms = 0.8e6             ! inflow surface  water
436      zmrw_ms = 0.7e6             ! middle recirculation water
437      zurw_ms = 2.5e6             ! upper  recirculation water
438      zbrw_ms = 3.5e6             ! bottom recirculation water
439
440      ! initialization of the velocity
441      zu1_ms_i(:) = 0.e0          ! velocity profile at 139,101 South point
442      zu2_ms_i(:) = 0.e0          ! velocity profile at 139,102 North point
443      zu3_ms_i(:) = 0.e0          ! velocity profile at 141,102 East  point
444
445      ! velocity profile at 139,101 South point
446      DO jk = 1, 14                     
447         DO jj = mj0(102), mj1(102) 
448            DO ji = mi0(140), mi1(140) 
449               zu1_ms_i(jk) =  ( zisw_ms / 14. ) / ( e2u(ji-1, jj-1) * fse3u(ji-1, jj-1,jk) ) 
450            END DO
451         END DO
452      END DO
453
454      ! recirculation water
455      DO jk = 15, 20                     
456         DO jj = mj0(102), mj1(102) 
457            DO ji = mi0(140), mi1(140) 
458               zu1_ms_i(jk) =  ( zmrw_ms / 6. ) / ( e2u(ji-1, jj-1) * fse3u(ji-1, jj-1,jk) ) 
459            END DO
460         END DO
461      END DO
462
463      DO jj = mj0(102), mj1(102) 
464         DO ji = mi0(140), mi1(140) 
465            zu1_ms_i(21) =  (           zurw_ms ) / ( e2u(ji-1, jj-1) * fse3u(ji-1, jj-1,21) )
466            zu1_ms_i(22) =  ( zbrw_ms - zurw_ms ) / ( e2u(ji-1, jj-1) * fse3u(ji-1, jj-1,22) )
467         END DO
468      END DO
469     
470      ! velocity profile at 139,102 North point
471      DO jk = 15, 20                     
472         DO jj = mj0(102), mj1(102) 
473            DO ji = mi0(140), mi1(140) 
474               zu2_ms_i(jk) = -( zmrw_ms / 6. ) / ( e2u(ji-1, jj) * fse3u(ji-1, jj,jk) ) 
475            END DO
476         END DO
477      END DO
478
479      ! outflow of Mediterranean sea + recirculation
480      DO jj = mj0(102), mj1(102) 
481         DO ji = mi0(140), mi1(140) 
482            zu2_ms_i(22) = -( zisw_ms + zbrw_ms ) / ( e2u(ji-1, jj) * fse3u(ji-1, jj,22) )
483         END DO
484      END DO
485     
486      ! velocity profile at 141,102  East point
487      ! flux in surface inflow of the Atlantic ocean   
488      DO  jk = 1, 14                     
489         DO jj = mj0(102), mj1(102) 
490            DO ji = mi0(140), mi1(140) 
491               zu3_ms_i(jk) =  ( zisw_ms / 14. ) / ( e2u(ji, jj) * fse3u(ji, jj,jk) ) 
492            END DO
493         END DO
494      END DO
495
496      ! deeper
497      DO jj = mj0(102), mj1(102) 
498         DO ji = mi0(140), mi1(140) 
499            zu3_ms_i(21) = - zisw_ms / ( e2u(ji, jj) * fse3u(ji, jj,21) )
500         END DO
501      END DO
502
503      ! Initialization at Hormuz
504      ! ------------------------
505
506      ! imposed transport
507      zisw_pg = 4. * 0.25e6       ! inflow surface  water
508      zbrw_pg = 4. * 0.25e6       ! bottom recirculation water
509
510      ! initialization of the velocity
511      zu_pg(:) = 0.e0           ! velocity profile at 172,94
512
513      ! velocity profile
514      DO jk = 1, 8 
515         DO jj = mj0(94), mj1(94) 
516            DO ji = mi0(172), mi1(172) 
517               zu_pg(jk) = -( zisw_pg / 8. ) / ( e2u(ji-1,jj) * fse3u(ji-1,jj, jk) )
518            END DO
519         END DO
520      END DO
521
522      DO jk = 16, 18
523         DO jj = mj0(94), mj1(94) 
524            DO ji = mi0(172), mi1(172) 
525               zu_pg(jk) =  ( zbrw_pg / 3. ) / ( e2u(ji-1,jj) * fse3u(ji-1,jj, jk) )
526            END DO
527         END DO
528      END DO
529
530   END SUBROUTINE div_cla_init
531#else
532   !!----------------------------------------------------------------------
533   !!   Default key                                            Dummy module
534   !!----------------------------------------------------------------------
535CONTAINS
536   SUBROUTINE div_cla( kt )
537      WRITE(*,*) 'div_cla: You should have not see this print! error?', kt
538   END SUBROUTINE div_cla
539#endif
540   
541   !!======================================================================
542END MODULE cla_div
Note: See TracBrowser for help on using the repository browser.