source: branches/UKMO/dev_r5518_GO6_package_text_diagnostics/NEMOGCM/NEMO/OPA_SRC/LBC/cla.F90 @ 10774

Last change on this file since 10774 was 10774, checked in by andmirek, 20 months ago

GMED 450 add flush after prints

File size: 42.0 KB
Line 
1MODULE cla
2   !!======================================================================
3   !!                    ***  MODULE  cla  ***
4   !! Cross Land Advection : specific update of the horizontal divergence,
5   !!                        tracer trends and after velocity
6   !!
7   !!                 ---   Specific to ORCA_R2   ---
8   !!
9   !!======================================================================
10   !! History :  1.0  ! 2002-11 (A. Bozec)  Original code
11   !!            3.2  ! 2009-07 (G. Madec)  merge cla, cla_div, tra_cla, cla_dynspg
12   !!                 !                     and correct a mpp bug reported by A.R. Porter
13   !!----------------------------------------------------------------------
14   !!   cla_div           : update of horizontal divergence at cla straits
15   !!   tra_cla           : update of tracers at cla straits
16   !!   cla_dynspg        : update of after horizontal velocities at cla straits
17   !!   cla_init          : initialisation - control check
18   !!   cla_bab_el_mandeb : cross land advection for Bab-el-mandeb strait
19   !!   cla_gibraltar     : cross land advection for Gibraltar strait
20   !!   cla_hormuz        : cross land advection for Hormuz strait
21   !!----------------------------------------------------------------------
22   USE oce            ! ocean dynamics and tracers
23   USE dom_oce        ! ocean space and time domain
24   USE sbc_oce        ! surface boundary condition: ocean
25   USE dynspg_oce     ! ocean dynamics: surface pressure gradient variables
26   USE in_out_manager ! I/O manager
27   USE lib_mpp        ! distributed memory computing library
28   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
29   USE lib_mpp        ! MPP library
30
31   IMPLICIT NONE
32   PRIVATE
33   
34   PUBLIC   cla_init     ! routine called by opa.F90
35   PUBLIC   cla_div      ! routine called by divcur.F90
36   PUBLIC   cla_traadv   ! routine called by traadv.F90
37   PUBLIC   cla_dynspg   ! routine called by dynspg_flt.F90
38
39   INTEGER  ::   nbab, ngib, nhor   ! presence or not of required grid-point on local domain
40   !                                ! for Bab-el-Mandeb, Gibraltar, and Hormuz straits
41   
42   !                                           !   fixed part  !  time evolving    !!! profile of hdiv for some straits
43   REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) ::   hdiv_139_101, hdiv_139_101_kt    ! Gibraltar     (i,j)=(172,101)
44   REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) ::   hdiv_139_102                     ! Gibraltar     (i,j)=(139,102)
45   REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) ::   hdiv_141_102, hdiv_141_102_kt    ! Gibraltar     (i,j)=(141,102)
46   REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) ::   hdiv_161_88 , hdiv_161_88_kt     ! Bab-el-Mandeb (i,j)=(161,88)
47   REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) ::   hdiv_161_87                      ! Bab-el-Mandeb (i,j)=(161,87)
48   REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) ::   hdiv_160_89 , hdiv_160_89_kt     ! Bab-el-Mandeb (i,j)=(160,89)
49   REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) ::   hdiv_172_94                      ! Hormuz        (i,j)=(172, 94)
50
51   REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) ::   t_171_94_hor, s_171_94_hor       ! Temperature, salinity in Hormuz strait
52   
53   !! * Substitutions
54#  include "domzgr_substitute.h90"
55   !!----------------------------------------------------------------------
56   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
57   !! $Id$
58   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
59   !!----------------------------------------------------------------------
60CONTAINS
61
62   SUBROUTINE cla_div( kt )
63      !!----------------------------------------------------------------------
64      !!                 ***  ROUTINE div_cla  ***
65      !!
66      !! ** Purpose :   update the horizontal divergence of the velocity field
67      !!              at some straits ( Gibraltar, Bab el Mandeb and Hormuz ).
68      !!
69      !! ** Method  : - first time-step: initialisation of cla
70      !!              - all   time-step: using imposed transport at each strait,
71      !!              the now horizontal divergence is updated
72      !!
73      !! ** Action  :   phdivn   updted now horizontal divergence at cla straits
74      !!----------------------------------------------------------------------
75      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
76      !!----------------------------------------------------------------------
77      !     
78      IF( kt == nit000 ) THEN
79         !
80         CALL cla_init                                        ! control check
81         !
82         IF(lwp) WRITE(numout,*)
83         IF(lwp) WRITE(numout,*) 'div_cla : cross land advection on hdiv '
84         IF(lwp) WRITE(numout,*) '~~~~~~~~'
85         IF(lflush) CALL flush(numout) 
86         !
87         IF( nbab == 1 )   CALL cla_bab_el_mandeb('ini')    ! Bab el Mandeb ( Red Sea - Indian ocean )
88         IF( ngib == 1 )   CALL cla_gibraltar    ('ini')    ! Gibraltar strait (Med Sea - Atlantic ocean)
89         IF( nhor == 1 )   CALL cla_hormuz       ('ini')    ! Hormuz Strait ( Persian Gulf - Indian ocean )
90         !
91      ENDIF                           
92      !
93      IF( nbab == 1    )   CALL cla_bab_el_mandeb('div')    ! Bab el Mandeb ( Red Sea - Indian ocean )
94      IF( ngib == 1    )   CALL cla_gibraltar    ('div')    ! Gibraltar strait (Med Sea - Atlantic ocean)
95      IF( nhor == 1    )   CALL cla_hormuz       ('div')    ! Hormuz Strait ( Persian Gulf - Indian ocean )
96      !
97!!gm  lbc useless here, no?
98!!gm      CALL lbc_lnk( hdivn, 'T', 1. )                    ! Lateral boundary conditions on hdivn
99      !
100   END SUBROUTINE cla_div
101   
102   
103   SUBROUTINE cla_traadv( kt )
104      !!----------------------------------------------------------------------
105      !!                 ***  ROUTINE tra_cla  ***
106      !!                   
107      !! ** Purpose :   Update the now trend due to the advection of tracers
108      !!      and add it to the general trend of passive tracer equations
109      !!      at some straits ( Bab el Mandeb, Gibraltar, Hormuz ).
110      !!
111      !! ** Method  :   using both imposed transport at each strait and T & S
112      !!              budget, the now tracer trends is updated
113      !!
114      !! ** Action  :   (ta,sa)   updated now tracer trends at cla straits
115      !!----------------------------------------------------------------------
116      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index
117      !!----------------------------------------------------------------------
118      !
119      IF( kt == nit000 ) THEN
120         IF(lwp) WRITE(numout,*)
121         IF(lwp) WRITE(numout,*) 'tra_cla : cross land advection on tracers '
122         IF(lwp) WRITE(numout,*) '~~~~~~~~'
123         IF(lflush) CALL flush(numout)
124      ENDIF
125      !
126      IF( nbab == 1    )   CALL cla_bab_el_mandeb('tra')      ! Bab el Mandeb strait
127      IF( ngib == 1    )   CALL cla_gibraltar    ('tra')      ! Gibraltar strait
128      IF( nhor == 1    )   CALL cla_hormuz       ('tra')      ! Hormuz Strait ( Persian Gulf)
129      !
130   END SUBROUTINE cla_traadv
131
132   
133   SUBROUTINE cla_dynspg( kt )
134      !!----------------------------------------------------------------------
135      !!                 ***  ROUTINE cla_dynspg  ***
136      !!                   
137      !! ** Purpose :   Update the after velocity at some straits
138      !!              (Bab el Mandeb, Gibraltar, Hormuz).
139      !!
140      !! ** Method  :   required to compute the filtered surface pressure gradient
141      !!
142      !! ** Action  :   (ua,va)   after velocity at the cla straits
143      !!----------------------------------------------------------------------
144      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index
145      !!----------------------------------------------------------------------
146      !
147      IF( kt == nit000 ) THEN
148         IF(lwp) WRITE(numout,*)
149         IF(lwp) WRITE(numout,*) 'cla_dynspg : cross land advection on (ua,va) '
150         IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
151         IF(lflush) CALL flush(numout)
152      ENDIF
153      !
154      IF( nbab == 1    )   CALL cla_bab_el_mandeb('spg')      ! Bab el Mandeb strait
155      IF( ngib == 1    )   CALL cla_gibraltar    ('spg')      ! Gibraltar strait
156      IF( nhor == 1    )   CALL cla_hormuz       ('spg')      ! Hormuz Strait ( Persian Gulf)
157      !
158!!gm lbc is needed here, not?
159!!gm      CALL lbc_lnk( hdivn, 'U', -1. )   ;   CALL lbc_lnk( hdivn, 'V', -1. )      ! Lateral boundary conditions
160      !
161   END SUBROUTINE cla_dynspg
162
163
164   SUBROUTINE cla_init
165      !! -------------------------------------------------------------------
166      !!                   ***  ROUTINE cla_init  ***
167      !!           
168      !! ** Purpose :   control check for mpp computation 
169      !!
170      !! ** Method  : - All the strait grid-points must be inside one of the
171      !!              local domain interior for the cla advection to work
172      !!              properly in mpp (i.e. inside (2:jpim1,2:jpjm1) ).
173      !!              Define the corresponding indicators (nbab, ngib, nhor)
174      !!              - The profiles of cross-land fluxes are currently hard
175      !!              coded for L31 levels. Stop if jpk/=31
176      !!
177      !! ** Action  :   nbab, ngib, nhor   strait inside the local domain or not
178      !!---------------------------------------------------------------------
179      REAL(wp) ::   ztemp   ! local scalar
180      INTEGER  ::   ierr    ! local integer
181      !!---------------------------------------------------------------------
182      !
183      IF(lwp) WRITE(numout,*)
184      IF(lwp) WRITE(numout,*) 'cla_init : cross land advection initialisation '
185      IF(lwp) WRITE(numout,*) '~~~~~~~~~'
186      IF(lwp .AND. lflush) CALL flush(numout)
187      !
188      !                           ! Allocate arrays for this module
189      ALLOCATE( hdiv_139_101(jpk) , hdiv_139_101_kt(jpk) ,     &    ! Gibraltar
190         &      hdiv_139_102(jpk) ,                            &
191         &      hdiv_141_102(jpk) , hdiv_141_102_kt(jpk) ,     &
192         &      hdiv_161_88 (jpk) , hdiv_161_88_kt (jpk) ,     &    ! Bab-el-Mandeb
193         &      hdiv_161_87 (jpk) ,                            &                     
194         &      hdiv_160_89 (jpk) , hdiv_160_89_kt (jpk) ,     &     ! Hormuz
195         &      hdiv_172_94 (jpk) ,                            &
196         &      t_171_94_hor(jpk) , s_171_94_hor   (jpk) , STAT=ierr )
197      IF( lk_mpp    )   CALL mpp_sum( ierr )
198      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'cla_init: unable to allocate arrays' )
199      !
200      IF( .NOT.lk_dynspg_flt )   CALL ctl_stop( 'cla_init: Cross Land Advection works only with lk_dynspg_flt=T ' )
201      !
202      IF( lk_vvl             )   CALL ctl_stop( 'cla_init: Cross Land Advection does not work with lk_vvl=T option' )
203      !
204      IF( jpk /= 31          )   CALL ctl_stop( 'cla_init: Cross Land Advection hard coded for ORCA_R2_L31' )
205      !
206      !                                        _|_______|_______|_
207      !                                     89  |       |///////| 
208      !                                        _|_______|_______|_
209      ! ------------------------ !          88  |///////|       |
210      !   Bab el Mandeb strait   !             _|_______|_______|_
211      ! ------------------------ !          87  |///////|       |
212      !                                        _|_______|_______|_
213      !                                         |  160  |  161  | 
214      !
215      ! The 6 Bab el Mandeb grid-points must be inside one of the interior of the
216      ! local domain for the cla advection to work properly (i.e. (2:jpim1,2:jpjm1)
217      nbab = 0
218      IF(  ( 1 <= mj0( 88) .AND. mj1( 89) <= jpj ) .AND.    &  !* (161,89), (161,88) and (161,88) on the local pocessor
219         & ( 1 <= mi0(160) .AND. mi1(161) <= jpi )       )    nbab = 1 
220      !
221      ! test if there is no local domain that includes all required grid-points
222      ztemp = REAL( nbab )
223      IF( lk_mpp )   CALL mpp_sum( ztemp )      ! sum with other processors value
224      IF( ztemp == 0 ) THEN                     ! Only 2 points in each direction, this should never be a problem
225         CALL ctl_stop( ' cross land advection at Bab-el_Mandeb does not work with your processor cutting: change it' )
226      ENDIF
227      !                                        ___________________________
228      ! ------------------------ !         102  |       |///////|       |
229      !     Gibraltar strait     !             _|_______|_______|_______|_
230      ! ------------------------ !         101  |       |///////|       |
231      !                                        _|_______|_______|_______|_
232      !                                         |  139  |  140  |  141  |
233      !
234      ! The 6 Gibraltar grid-points must be inside one of the interior of the
235      ! local domain for the cla advection to work properly (i.e. (2:jpim1,2:jpjm1)
236      ngib = 0
237      IF(  ( 2 <= mj0(101) .AND. mj1(102) <= jpjm1 ) .AND.    &  !* (139:141,101:102) on the local pocessor
238         & ( 2 <= mi0(139) .AND. mi1(141) <= jpim1 )       )    ngib = 1 
239      !
240      ! test if there is no local domain that includes all required grid-points
241      ztemp = REAL( ngib )
242      IF( lk_mpp )   CALL mpp_sum( ztemp )      ! sum with other processors value
243      IF( ztemp == 0 ) THEN                     ! 3 points in i-direction, this may be a problem with some cutting
244           CALL ctl_stop( ' cross land advection at Gibraltar does not work with your processor cutting: change it' )
245      ENDIF
246      !                                        _______________
247      ! ------------------------ !          94  |/////|     |
248      !       Hormuz strait      !             _|_____|_____|_
249      ! ------------------------ !                171   172     
250      !           
251      ! The 2 Hormuz grid-points must be inside one of the interior of the
252      ! local domain for the cla advection to work properly (i.e. (2:jpim1,2:jpjm1)
253      nhor = 0
254      IF(    2 <= mj0( 94) .AND. mj1( 94) <= jpjm1  .AND.  & 
255         &   2 <= mi0(171) .AND. mi1(172) <= jpim1         )   nhor = 1 
256      !
257      ! test if there is no local domain that includes all required grid-points
258      ztemp = REAL( nhor )
259      IF( lk_mpp )   CALL mpp_sum( ztemp )      ! sum with other processors value
260      IF( ztemp == 0 ) THEN                     ! 3 points in i-direction, this may be a problem with some cutting
261           CALL ctl_stop( ' cross land advection at Hormuz does not work with your processor cutting: change it' )
262      ENDIF
263      !
264   END SUBROUTINE cla_init
265
266
267   SUBROUTINE cla_bab_el_mandeb( cd_td )
268      !!----------------------------------------------------------------------
269      !!                ***  ROUTINE cla_bab_el_mandeb  ***
270      !!       
271      !! ** Purpose :   update the now horizontal divergence, the tracer tendancy
272      !!              and the after velocity in vicinity of Bab el Mandeb ( Red Sea - Indian ocean).
273      !!
274      !! ** Method  :   compute the exchanges at each side of the strait :
275      !!
276      !!       surf. zio_flow
277      !! (+ balance of emp) /\  |\\\\\\\\\\\|
278      !!                    ||  |\\\\\\\\\\\| 
279      !!    deep zio_flow   ||  |\\\\\\\\\\\| 
280      !!            |  ||   ||  |\\\\\\\\\\\| 
281      !!        89  |  ||   ||  |\\\\\\\\\\\| 
282      !!            |__\/_v_||__|____________
283      !!            !\\\\\\\\\\\|          surf. zio_flow
284      !!            |\\\\\\\\\\\|<===    (+ balance of emp)
285      !!            |\\\\\\\\\\\u
286      !!        88  |\\\\\\\\\\\|<---      deep  zrecirc (upper+deep at 2 different levels)
287      !!            |___________|__________   
288      !!            !\\\\\\\\\\\|         
289      !!            |\\\\\\\\\\\| ---\     deep  zrecirc (upper+deep)
290      !!        87  !\\\\\\\\\\\u ===/   + deep  zio_flow   (all at the same level)
291      !!            !\\\\\\\\\\\| 
292      !!            !___________|__________
293      !!                160         161
294      !!
295      !!----------------------------------------------------------------------
296      CHARACTER(len=1), INTENT(in) ::   cd_td   ! ='div' update the divergence
297      !                                         ! ='tra' update the tracers
298      !                                         ! ='spg' update after velocity
299      INTEGER  ::   ji, jj, jk   ! dummy loop indices
300      REAL(wp) ::   zemp_red     ! temporary scalar
301      REAL(wp) ::   zio_flow, zrecirc_upp, zrecirc_mid, zrecirc_bot
302      !!---------------------------------------------------------------------
303      !
304      SELECT CASE( cd_td ) 
305      !                     ! ---------------- !
306      CASE( 'ini' )         !  initialisation  !
307         !                  ! ---------------- !
308         !                                   
309         zio_flow    = 0.4e6                       ! imposed in/out flow
310         zrecirc_upp = 0.2e6                       ! imposed upper recirculation water
311         zrecirc_bot = 0.5e6                       ! imposed bottom  recirculation water
312
313         hdiv_161_88(:) = 0.e0                     ! (161,88) Gulf of Aden side, north point
314         hdiv_161_87(:) = 0.e0                     ! (161,87) Gulf of Aden side, south point
315         hdiv_160_89(:) = 0.e0                     ! (160,89) Red sea side
316
317         DO jj = mj0(88), mj1(88)              !** profile of hdiv at (161,88)   (Gulf of Aden side, north point)
318            DO ji = mi0(161), mi1(161)         !------------------------------
319               DO jk = 1, 8                        ! surface in/out flow   (Ind -> Red)   (div >0)
320                  hdiv_161_88(jk) = + zio_flow / ( 8. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
321               END DO
322               !                                   ! recirculation water   (Ind -> Red)   (div >0)
323               hdiv_161_88(20) =                 + zrecirc_upp   / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,20) )
324               hdiv_161_88(21) = + ( zrecirc_bot - zrecirc_upp ) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,21) )
325            END DO
326         END DO
327         !
328         DO jj = mj0(87), mj1(87)              !** profile of hdiv at (161,88)   (Gulf of Aden side, south point)
329            DO ji = mi0(161), mi1(161)         !------------------------------
330               !                                   ! deep out flow + recirculation   (Red -> Ind)   (div <0)
331               hdiv_161_87(21) = - ( zio_flow + zrecirc_bot ) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,21) )
332            END DO
333         END DO
334         !
335         DO jj = mj0(89), mj1(89)              !** profile of hdiv at (161,88)   (Red sea side)
336            DO ji = mi0(160), mi1(160)         !------------------------------
337               DO jk = 1, 8                        ! surface inflow    (Ind -> Red)   (div <0)
338                  hdiv_160_89(jk) = - zio_flow / ( 8. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
339               END DO
340               !                                   ! deep    outflow   (Red -> Ind)   (div >0)
341               hdiv_160_89(16)    = + zio_flow / (      e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,16) )
342            END DO
343         END DO
344         !                  ! ---------------- !
345      CASE( 'div' )         !   update hdivn   ! (call by divcur module)
346         !                  ! ---------=====-- !
347         !                                     !** emp on the Red Sea   (div >0)
348         zemp_red = 0.e0                       !---------------------
349         DO jj = mj0(87), mj1(96)                  ! sum over the Red sea
350            DO ji = mi0(148), mi1(160) 
351               zemp_red = zemp_red + emp(ji,jj) * e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj)
352            END DO
353         END DO
354         IF( lk_mpp )   CALL mpp_sum( zemp_red )   ! sum with other processors value
355         zemp_red = zemp_red * 1.e-3               ! convert in m3
356         !
357         !                                     !** Correct hdivn (including emp adjustment)
358         !                                     !-------------------------------------------
359         DO jj = mj0(88), mj1(88)                  !* profile of hdiv at (161,88)   (Gulf of Aden side, north point)
360            DO ji = mi0(161), mi1(161) 
361               hdiv_161_88_kt(:) = hdiv_161_88(:)
362               DO jk = 1, 8                              ! increase the inflow from the Indian   (div >0)
363                  hdiv_161_88_kt(jk) = hdiv_161_88(jk) + zemp_red / (8. * e2u(ji,jj) * fse3u(ji,jj,jk) )
364               END DO
365               hdivn(ji,jj,:) = hdivn(ji,jj,:) + hdiv_161_88_kt(:)
366            END DO
367         END DO
368         DO jj = mj0(87), mj1(87)                  !* profile of divergence at (161,87)   (Gulf of Aden side, south point)
369            DO ji = mi0(161), mi1(161) 
370               hdivn(ji,jj,:) = hdivn(ji,jj,:) + hdiv_161_87(:)
371            END DO
372         END DO
373         DO jj = mj0(89), mj1(89)                  !* profile of divergence at (160,89)   (Red sea side)
374            DO ji = mi0(160), mi1(160) 
375               hdiv_160_89_kt(:) = hdiv_160_89(:)
376               DO jk = 1, 18                              ! increase the inflow from the Indian   (div <0)
377                  hdiv_160_89_kt(jk) = hdiv_160_89(jk) - zemp_red / (10. * e1v(ji,jj) * fse3v(ji,jj,jk) )
378               END DO
379               hdivn(ji, jj,:) = hdivn(ji, jj,:) + hdiv_160_89_kt(:)
380            END DO
381         END DO
382         !                  ! ---------------- !
383      CASE( 'tra' )         !  update (ta,sa)  ! (call by traadv module)
384         !                  ! --------=======- !
385         !
386         DO jj = mj0(88), mj1(88)              !** (161,88)   (Gulf of Aden side, north point)
387            DO ji = mi0(161), mi1(161) 
388               DO jk = 1, jpkm1                         ! surf inflow + reciculation (from Gulf of Aden)
389                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_161_88_kt(jk) * tsn(ji,jj,jk,jp_tem)
390                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_161_88_kt(jk) * tsn(ji,jj,jk,jp_sal)
391               END DO
392            END DO
393         END DO
394         DO jj = mj0(87), mj1(87)              !** (161,87)   (Gulf of Aden side, south point)
395            DO ji = mi0(161), mi1(161) 
396               jk =  21                                 ! deep outflow + recirulation (combined flux)
397               tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + hdiv_161_88(20) * tsn(ji  ,jj+1,20,jp_tem)   &  ! upper recirculation from Gulf of Aden
398                  &                        + hdiv_161_88(21) * tsn(ji  ,jj+1,21,jp_tem)   &  ! deep  recirculation from Gulf of Aden
399                  &                        + hdiv_160_89(16) * tsn(ji-1,jj+2,16,jp_tem)      ! deep inflow from Red sea
400               tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + hdiv_161_88(20) * tsn(ji  ,jj+1,20,jp_sal)   &
401                  &                        + hdiv_161_88(21) * tsn(ji  ,jj+1,21,jp_sal)   &
402                  &                        + hdiv_160_89(16) * tsn(ji-1,jj+2,16,jp_sal)   
403            END DO
404         END DO
405         DO jj = mj0(89), mj1(89)              !** (161,88)   (Red sea side)
406            DO ji = mi0(160), mi1(160)
407               DO jk = 1, 14                            ! surface inflow (from Gulf of Aden)
408                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_160_89_kt(jk) * tsn(ji+1,jj-1,jk,jp_tem)
409                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_160_89_kt(jk) * tsn(ji+1,jj-1,jk,jp_sal)
410               END DO
411               !                                  ! deep    outflow (from Red sea)
412               tsa(ji,jj,16,jp_tem) = tsa(ji,jj,16,jp_tem) - hdiv_160_89(16) * tsn(ji,jj,16,jp_tem)
413               tsa(ji,jj,16,jp_sal) = tsa(ji,jj,16,jp_sal) - hdiv_160_89(16) * tsn(ji,jj,16,jp_sal)
414            END DO
415         END DO
416         !
417         !                  ! ---------------- !
418      CASE( 'spg' )         !  update (ua,va)  ! (call by dynspg module)
419         !                  ! --------=======- !
420         ! at this stage, (ua,va) are the after velocity, not the tendancy
421         ! compute the velocity from the divergence at T-point
422         !
423         DO jj = mj0(88), mj1(88)              !** (160,88)   (Gulf of Aden side, north point)
424            DO ji = mi0(160), mi1(160)                   ! 160, not 161 as it is a U-point)
425               ua(ji,jj,:) = - hdiv_161_88_kt(:) / ( e1t(ji+1,jj) * e2t(ji+1,jj) * fse3t(ji+1,jj,:) )   &
426                  &                              * e2u(ji,jj) * fse3u(ji,jj,:)
427            END DO
428         END DO
429         DO jj = mj0(87), mj1(87)              !** (160,87)   (Gulf of Aden side, south point)
430            DO ji = mi0(160), mi1(160)                   ! 160, not 161 as it is a U-point)
431               ua(ji,jj,:) = - hdiv_161_87(:) / ( e1t(ji+1,jj) * e2t(ji+1,jj) * fse3t(ji+1,jj,:) )   &
432                  &                           * e2u(ji,jj) * fse3u(ji,jj,:)
433            END DO
434         END DO
435         DO jj = mj0(88), mj1(88)              !** profile of divergence at (160,89)   (Red sea side)
436            DO ji = mi0(160), mi1(160)                   ! 88, not 89 as it is a V-point)
437               va(ji,jj,:) = - hdiv_160_89_kt(:) / ( e1t(ji,jj+1) * e2t(ji,jj+1) * fse3t(ji,jj+1,:) )   &
438                  &                              * e1v(ji,jj) * fse3v(ji,jj,:)
439            END DO
440         END DO
441      END SELECT
442      !
443   END SUBROUTINE cla_bab_el_mandeb
444   
445
446   SUBROUTINE cla_gibraltar( cd_td )
447      !! -------------------------------------------------------------------
448      !!                 ***  ROUTINE cla_gibraltar  ***
449      !!       
450      !! ** Purpose :   update the now horizontal divergence, the tracer
451      !!              tendancyand the after velocity in vicinity of Gibraltar
452      !!              strait ( Persian Gulf - Indian ocean ).
453      !!
454      !! ** Method :
455      !!                     _______________________           
456      !!      deep  zio_flow /====|///////|====> surf. zio_flow
457      !!    + deep  zrecirc  \----|///////|     (+balance of emp)
458      !! 102                      u///////u
459      !!      mid.  recicul    <--|///////|<==== deep  zio_flow
460      !!                     _____|_______|_____ 
461      !!      surf. zio_flow ====>|///////|       
462      !!    (+balance of emp)     |///////|
463      !! 101                      u///////|             
464      !!      mid.  recicul    -->|///////|               Caution: zrecirc split into
465      !!      deep  zrecirc  ---->|///////|                  upper & bottom recirculation
466      !!                   _______|_______|_______
467      !!                     139     140     141 
468      !!
469      !!---------------------------------------------------------------------
470      CHARACTER(len=1), INTENT(in) ::   cd_td   ! ='div' update the divergence
471      !                                         ! ='tra' update the tracers
472      !                                         ! ='spg' update after velocity
473      INTEGER  ::   ji, jj, jk   ! dummy loop indices
474      REAL(wp) ::   zemp_med     ! temporary scalar
475      REAL(wp) ::   zio_flow, zrecirc_upp, zrecirc_mid, zrecirc_bot
476      !!---------------------------------------------------------------------
477      !
478      SELECT CASE( cd_td ) 
479      !                     ! ---------------- !
480      CASE( 'ini' )         !  initialisation  !
481         !                  ! ---------------- !
482         !                                     !** initialization of the velocity
483         hdiv_139_101(:) = 0.e0                     !  139,101 (Atlantic side, south point)
484         hdiv_139_102(:) = 0.e0                     !  139,102 (Atlantic side, north point)
485         hdiv_141_102(:) = 0.e0                     !  141,102 (Med sea  side)
486           
487         !                                     !** imposed transport
488         zio_flow    = 0.8e6                        ! inflow surface  water
489         zrecirc_mid = 0.7e6                        ! middle recirculation water
490         zrecirc_upp = 2.5e6                        ! upper  recirculation water
491         zrecirc_bot = 3.5e6                        ! bottom recirculation water
492         !
493         DO jj = mj0(101), mj1(101)            !** profile of hdiv at 139,101 (Atlantic side, south point)
494            DO ji = mi0(139), mi1(139)         !-----------------------------
495               DO jk = 1, 14                        ! surface in/out flow (Atl -> Med)   (div >0)
496                  hdiv_139_101(jk) = + zio_flow / ( 14. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
497               END DO
498               DO jk = 15, 20                       ! middle  reciculation (Atl 101 -> Atl 102)   (div >0)   
499                  hdiv_139_101(jk) = + zrecirc_mid / ( 6. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
500               END DO
501               !                                    ! upper reciculation (Atl 101 -> Atl 101)   (div >0)
502               hdiv_139_101(21) =               + zrecirc_upp / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
503               !
504               !                                    ! upper & bottom reciculation (Atl 101 -> Atl 101 & 102)   (div >0)
505               hdiv_139_101(22) = ( zrecirc_bot - zrecirc_upp ) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
506            END DO
507         END DO
508         DO jj = mj0(102), mj1(102)            !** profile of hdiv at 139,102 (Atlantic side, north point)
509            DO ji = mi0(139), mi1(139)         !-----------------------------
510               DO jk = 15, 20                       ! middle reciculation (Atl 101 -> Atl 102)   (div <0)               
511                  hdiv_139_102(jk) = - zrecirc_mid / ( 6. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
512               END DO
513               !                                    ! outflow of Mediterranean sea + deep recirculation   (div <0)
514               hdiv_139_102(22) = - ( zio_flow + zrecirc_bot ) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
515            END DO
516         END DO
517         DO jj = mj0(102), mj1(102)            !** velocity profile at 141,102  (Med sea side)
518            DO ji = mi0(141), mi1(141)         !------------------------------
519               DO  jk = 1, 14                       ! surface inflow in the Med     (div <0)
520                  hdiv_141_102(jk) = - zio_flow / ( 14. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
521               END DO
522               !                                    ! deep    outflow toward the Atlantic    (div >0)
523               hdiv_141_102(21)    = + zio_flow / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
524            END DO
525         END DO
526         !                  ! ---------------- !
527      CASE( 'div' )         !   update hdivn   ! (call by divcur module)
528         !                  ! ---------=====-- !
529         !                                     !** emp on the Mediterranean Sea  (div >0)
530         zemp_med = 0.e0                       !-------------------------------
531         DO jj = mj0(96), mj1(110)                  ! sum over the Med sea
532            DO ji = mi0(141),mi1(181)
533               zemp_med = zemp_med + emp(ji,jj) * e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj) 
534            END DO
535         END DO
536         DO jj = mj0(96), mj1(96)                   ! minus 2 points in Red Sea
537            DO ji = mi0(148),mi1(148)
538               zemp_med = zemp_med - emp(ji,jj) * e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj)
539            END DO
540            DO ji = mi0(149),mi1(149)
541               zemp_med = zemp_med - emp(ji,jj) * e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj)
542            END DO
543         END DO
544         IF( lk_mpp )   CALL mpp_sum( zemp_med )    ! sum with other processors value
545         zemp_med = zemp_med * 1.e-3                ! convert in m3
546         !
547         !                                     !** Correct hdivn (including emp adjustment)
548         !                                     !-------------------------------------------
549         DO jj = mj0(101), mj1(101)                 !* 139,101 (Atlantic side, south point)
550            DO ji = mi0(139), mi1(139) 
551               hdiv_139_101_kt(:) = hdiv_139_101(:)     
552               DO jk = 1, 14                              ! increase the inflow from the Atlantic   (div >0)
553                  hdiv_139_101_kt(jk) = hdiv_139_101(jk) + zemp_med / ( 14. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
554               END DO
555               hdivn(ji, jj,:) = hdivn(ji, jj,:) + hdiv_139_101_kt(:)
556            END DO
557         END DO
558         DO jj = mj0(102), mj1(102)                 !* 139,102 (Atlantic side, north point)
559            DO ji = mi0(139), mi1(139) 
560               hdivn(ji,jj,:) = hdivn(ji,jj,:) + hdiv_139_102(:)
561            END DO
562         END DO
563         DO jj = mj0(102), mj1(102)                 !* 141,102 (Med side)
564            DO ji = mi0(141), mi1(141) 
565               hdiv_141_102(:) = hdiv_141_102(:)
566               DO jk = 1, 14                              ! increase the inflow from the Atlantic   (div <0)
567                  hdiv_141_102_kt(jk) = hdiv_141_102(jk) - zemp_med / ( 14. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
568               END DO
569               hdivn(ji, jj,:) = hdivn(ji, jj,:) + hdiv_141_102_kt(:)
570            END DO
571         END DO
572         !                  ! ---------------- !
573      CASE( 'tra' )         !  update (ta,sa)  ! (call by traadv module)
574         !                  ! --------=======- !
575         !
576         DO jj = mj0(101), mj1(101)            !** 139,101 (Atlantic side, south point)   (div >0)
577            DO ji = mi0(139), mi1(139) 
578               DO jk = 1, jpkm1                         ! surf inflow + mid. & bottom reciculation (from Atlantic)   
579                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_139_101_kt(jk) * tsn(ji,jj,jk,jp_tem)
580                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_139_101_kt(jk) * tsn(ji,jj,jk,jp_sal)
581               END DO
582            END DO
583         END DO
584         !
585         DO jj = mj0(102), mj1(102)            !** 139,102 (Atlantic side, north point)   (div <0)
586            DO ji = mi0(139), mi1(139) 
587               DO jk = 15, 20                            ! middle  reciculation (Atl 101 -> Atl 102)   (div <0)
588                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_139_102(jk) * tsn(ji,jj-1,jk,jp_tem)  ! middle Atlantic recirculation
589                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_139_102(jk) * tsn(ji,jj-1,jk,jp_sal)
590               END DO
591               !                                         ! upper & bottom Atl. reciculation (Atl 101 -> Atl 102) - (div <0)
592               !                                         ! deep Med flow                    (Med 102 -> Atl 102) - (div <0)
593               tsa(ji,jj,22,jp_tem) = tsa(ji,jj,22,jp_tem) + hdiv_141_102(21) * tsn(ji+2,jj,21,jp_tem)   &  ! deep Med flow 
594                  &                        + hdiv_139_101(21) * tsn(ji,jj-1,21,jp_tem)   &  ! upper  Atlantic recirculation 
595                  &                        + hdiv_139_101(22) * tsn(ji,jj-1,22,jp_tem)      ! bottom Atlantic recirculation 
596               tsa(ji,jj,22,jp_sal) = tsa(ji,jj,22,jp_sal) + hdiv_141_102(21) * tsn(ji+2,jj,21,jp_sal)   &
597                  &                        + hdiv_139_101(21) * tsn(ji,jj-1,21,jp_sal)   &
598                  &                        + hdiv_139_101(22) * tsn(ji,jj-1,22,jp_sal) 
599            END DO
600         END DO
601         DO jj = mj0(102), mj1(102)                 !* 141,102 (Med side)   (div <0)
602            DO ji = mi0(141), mi1(141) 
603               DO jk = 1, 14                             ! surface flow from Atlantic to Med sea
604                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_141_102_kt(jk) * tsn(ji-2,jj-1,jk,jp_tem)
605                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_141_102_kt(jk) * tsn(ji-2,jj-1,jk,jp_sal)
606               END DO
607               !                                         ! deeper flow from Med sea to Atlantic
608               tsa(ji,jj,21,jp_tem) = tsa(ji,jj,21,jp_tem) - hdiv_141_102(21) * tsn(ji,jj,21,jp_tem)
609               tsa(ji,jj,21,jp_sal) = tsa(ji,jj,21,jp_sal) - hdiv_141_102(21) * tsn(ji,jj,21,jp_sal)
610            END DO
611         END DO
612         !                  ! ---------------- !
613      CASE( 'spg' )         !  update (ua,va)  ! (call by dynspg module)
614         !                  ! --------=======- !
615         ! at this stage, (ua,va) are the after velocity, not the tendancy
616         ! compute the velocity from the divergence at T-point
617         !
618         DO jj = mj0(101), mj1(101)            !** 139,101 (Atlantic side, south point)
619            DO ji = mi0(139), mi1(139)                    ! div >0 => ua >0, same sign
620               ua(ji,jj,:) = hdiv_139_101_kt(:) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,:) )   &
621                  &                             * e2u(ji,jj) * fse3u(ji,jj,:)
622            END DO
623         END DO
624         DO jj = mj0(102), mj1(102)            !** 139,102 (Atlantic side, north point)
625            DO ji = mi0(139), mi1(139)                    ! div <0 => ua <0, same sign
626               ua(ji,jj,:) = hdiv_139_102(:) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,:) )   &
627                  &                          * e2u(ji,jj) * fse3u(ji,jj,:)   
628            END DO
629         END DO
630         DO jj = mj0(102), mj1(102)            !** 140,102 (Med side) (140 not 141 as it is a U-point)
631            DO ji = mi0(140), mi1(140)                    ! div >0 => ua <0, opposite sign
632               ua(ji,jj,:) = - hdiv_141_102(:) / ( e1t(ji+1,jj) * e2t(ji+1,jj) * fse3t(ji+1,jj,:) )   &
633                  &                            * e2u(ji,jj) * fse3u(ji,jj,:)
634            END DO
635         END DO
636         !
637      END SELECT
638      !
639   END SUBROUTINE cla_gibraltar
640
641
642   SUBROUTINE cla_hormuz( cd_td )
643      !! -------------------------------------------------------------------
644      !!                   ***  ROUTINE div_hormuz  ***
645      !!             
646      !! ** Purpose :   update the now horizontal divergence, the tracer
647      !!              tendancyand the after velocity in vicinity of Hormuz
648      !!              strait ( Persian Gulf - Indian ocean ).
649      !!
650      !! ** Method  :   Hormuz strait
651      !!            ______________   
652      !!            |/////|<==      surface inflow
653      !!        94  |/////|     
654      !!            |/////|==>      deep    outflow
655      !!            |_____|_______
656      !!              171    172     
657      !!---------------------------------------------------------------------
658      CHARACTER(len=1), INTENT(in) ::   cd_td   ! ='ini' initialisation
659      !!                                        ! ='div' update the divergence
660      !!                                        ! ='tra' update the tracers
661      !!                                        ! ='spg' update after velocity
662      !!
663      INTEGER  ::   ji, jj, jk   ! dummy loop indices
664      REAL(wp) ::   zio_flow     ! temporary scalar
665      !!---------------------------------------------------------------------
666      !
667      SELECT CASE( cd_td ) 
668      !                     ! ---------------- !
669      CASE( 'ini' )         !  initialisation  !
670         !                  ! ---------------- !
671         !                                     !** profile of horizontal divergence due to cross-land advection
672         zio_flow  = 1.e6                          ! imposed in/out flow
673         !
674         hdiv_172_94(:) = 0.e0         
675         !
676         DO jj = mj0(94), mj1(94)                  ! in/out flow at (i,j) = (172,94)
677            DO ji = mi0(172), mi1(172) 
678               DO jk = 1, 8                            ! surface inflow  (Indian ocean to Persian Gulf) (div<0)
679                  hdiv_172_94(jk) = - ( zio_flow / 8.e0 * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
680               END DO
681               DO jk = 16, 18                          ! deep    outflow (Persian Gulf to Indian ocean) (div>0)
682                  hdiv_172_94(jk) = + ( zio_flow / 3.e0 * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
683               END DO
684            END DO
685         END DO
686         !                                     !** T & S profile in the Hormuz strait (use in deep outflow)
687         !      Temperature       and         Salinity
688         t_171_94_hor(:)  = 0.e0   ;   s_171_94_hor(:)  = 0.e0
689         t_171_94_hor(16) = 18.4   ;   s_171_94_hor(16) = 36.27
690         t_171_94_hor(17) = 17.8   ;   s_171_94_hor(17) = 36.4
691         t_171_94_hor(18) = 16.    ;   s_171_94_hor(18) = 36.27
692         !
693         !                  ! ---------------- !
694      CASE( 'div' )         !   update hdivn   ! (call by divcur module)
695         !                  ! ---------=====-- !
696         !                                   
697         DO jj = mj0(94), mj1(94)              !** 172,94 (Indian ocean side)
698            DO ji = mi0(172), mi1(172) 
699               hdivn(ji,jj,:) = hdivn(ji,jj,:) + hdiv_172_94(:)
700            END DO
701         END DO
702         !                  ! ---------------- !
703      CASE( 'tra' )         !  update (ta,sa)  ! (call by traadv module)
704         !                  ! --------=======- !
705         !                         
706         DO jj = mj0(94), mj1(94)              !** 172,94 (Indian ocean side)
707            DO ji = mi0(172), mi1(172) 
708               DO jk = 1, 8                          ! surface inflow   (Indian ocean to Persian Gulf) (div<0)
709                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_172_94(jk) * tsn(ji,jj,jk,jp_tem) 
710                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_172_94(jk) * tsn(ji,jj,jk,jp_sal) 
711               END DO
712               DO jk = 16, 18                        ! deep outflow     (Persian Gulf to Indian ocean) (div>0)
713                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_172_94(jk) * t_171_94_hor(jk)
714                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_172_94(jk) * s_171_94_hor(jk)
715               END DO
716            END DO
717         END DO
718         !                  ! ---------------- !
719      CASE( 'spg' )         !  update (ua,va)  ! (call by dynspg module)
720         !                  ! --------=======- !
721         ! No barotropic flow through Hormuz strait
722         ! at this stage, (ua,va) are the after velocity, not the tendancy
723         ! compute the velocity from the divergence at T-point
724         DO jj = mj0(94), mj1(94)              !** 171,94 (Indian ocean side) (171 not 172 as it is the western U-point)
725            DO ji = mi0(171), mi1(171)                ! div >0 => ua >0, opposite sign
726               ua(ji,jj,:) = - hdiv_172_94(:) / ( e1t(ji+1,jj) * e2t(ji+1,jj) * fse3t(ji+1,jj,:) )   &
727                  &                           * e2u(ji,jj) * fse3u(ji,jj,:)
728            END DO
729         END DO
730         !
731      END SELECT
732      !
733   END SUBROUTINE cla_hormuz
734   
735   !!======================================================================
736END MODULE cla
Note: See TracBrowser for help on using the repository browser.