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

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

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