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.
domvvl.F90 in branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/OPA_SRC/DOM – NEMO

source: branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90 @ 4153

Last change on this file since 4153 was 4153, checked in by cetlod, 10 years ago

dev_LOCEAN_2013: merge in trunk changes between r3940 and r4028, see ticket #1169
  • Property svn:keywords set to Id
File size: 22.8 KB
Line 
1MODULE domvvl
2   !!======================================================================
3   !!                       ***  MODULE domvvl   ***
4   !! Ocean :
5   !!======================================================================
6   !! History :  2.0  !  2006-06  (B. Levier, L. Marie)  original code
7   !!            3.1  !  2009-02  (G. Madec, M. Leclair, R. Benshila)  pure z* coordinate
8   !!----------------------------------------------------------------------
9#if defined key_vvl
10   !!----------------------------------------------------------------------
11   !!   'key_vvl'                              variable volume
12   !!----------------------------------------------------------------------
13   !!   dom_vvl     : defined coefficients to distribute ssh on each layers
14   !!----------------------------------------------------------------------
15   USE oce             ! ocean dynamics and tracers
16   USE dom_oce         ! ocean space and time domain
17   USE sbc_oce         ! surface boundary condition: ocean
18   USE phycst          ! physical constants
19   USE in_out_manager  ! I/O manager
20   USE lib_mpp         ! distributed memory computing library
21   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
22   USE wrk_nemo        ! Memory allocation
23   USE timing          ! Timing
24
25   IMPLICIT NONE
26   PRIVATE
27
28   PUBLIC   dom_vvl         ! called by domain.F90
29   PUBLIC   dom_vvl_2       ! called by domain.F90
30   PUBLIC   dom_vvl_alloc   ! called by nemogcm.F90
31
32   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   mut , muu , muv , muf    !: 1/H_0 at t-,u-,v-,f-points
33
34   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:)     ::   r2dt   ! vertical profile time-step, = 2 rdttra
35      !                                                              ! except at nit000 (=rdttra) if neuler=0
36
37   !! * Substitutions
38#  include "domzgr_substitute.h90"
39#  include "vectopt_loop_substitute.h90"
40   !!----------------------------------------------------------------------
41   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
42   !! $Id$
43   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
44   !!----------------------------------------------------------------------
45CONTAINS       
46
47   INTEGER FUNCTION dom_vvl_alloc()
48      !!----------------------------------------------------------------------
49      !!                ***  ROUTINE dom_vvl_alloc  ***
50      !!----------------------------------------------------------------------
51      !
52      ALLOCATE( mut (jpi,jpj,jpk) , muu (jpi,jpj,jpk) , muv (jpi,jpj,jpk) , muf (jpi,jpj,jpk) ,     &
53         &      r2dt        (jpk)                                                             , STAT=dom_vvl_alloc )
54         !
55      IF( lk_mpp             )   CALL mpp_sum ( dom_vvl_alloc )
56      IF( dom_vvl_alloc /= 0 )   CALL ctl_warn('dom_vvl_alloc: failed to allocate arrays')
57      !
58   END FUNCTION dom_vvl_alloc
59
60
61   SUBROUTINE dom_vvl
62      !!----------------------------------------------------------------------
63      !!                ***  ROUTINE dom_vvl  ***
64      !!                   
65      !! ** Purpose :   compute mu coefficients at t-, u-, v- and f-points to
66      !!              spread ssh over the whole water column (scale factors)
67      !!                set the before and now ssh at u- and v-points
68      !!              (also f-point in now case)
69      !!----------------------------------------------------------------------
70      !
71      INTEGER  ::   ji, jj, jk   ! dummy loop indices
72      REAL(wp) ::   zcoefu, zcoefv , zcoeff                ! local scalars
73      REAL(wp) ::   zvt   , zvt_ip1, zvt_jp1, zvt_ip1jp1   !   -      -
74      REAL(wp), POINTER, DIMENSION(:,:) ::  zee_t, zee_u, zee_v, zee_f   ! 2D workspace
75      !!----------------------------------------------------------------------
76      !
77      IF( nn_timing == 1 )  CALL timing_start('dom_vvl')
78      !
79      CALL wrk_alloc( jpi, jpj, zee_t, zee_u, zee_v, zee_f )
80      !
81      IF(lwp) THEN
82         WRITE(numout,*)
83         WRITE(numout,*) 'dom_vvl : Variable volume initialization'
84         WRITE(numout,*) '~~~~~~~~  compute coef. used to spread ssh over each layers'
85      ENDIF
86     
87      IF( dom_vvl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dom_vvl : unable to allocate arrays' )
88
89      fsdept(:,:,:) = gdept (:,:,:)
90      fsdepw(:,:,:) = gdepw (:,:,:)
91      fsde3w(:,:,:) = gdep3w(:,:,:)
92      fse3t (:,:,:) = e3t   (:,:,:)
93      fse3u (:,:,:) = e3u   (:,:,:)
94      fse3v (:,:,:) = e3v   (:,:,:)
95      fse3f (:,:,:) = e3f   (:,:,:)
96      fse3w (:,:,:) = e3w   (:,:,:)
97      fse3uw(:,:,:) = e3uw  (:,:,:)
98      fse3vw(:,:,:) = e3vw  (:,:,:)
99
100      !                                 !==  mu computation  ==!
101      zee_t(:,:) = fse3t_0(:,:,1)                ! Lower bound : thickness of the first model level
102      zee_u(:,:) = fse3u_0(:,:,1)
103      zee_v(:,:) = fse3v_0(:,:,1)
104      zee_f(:,:) = fse3f_0(:,:,1)
105      DO jk = 2, jpkm1                          ! Sum of the masked vertical scale factors
106         zee_t(:,:) = zee_t(:,:) + fse3t_0(:,:,jk) * tmask(:,:,jk)
107         zee_u(:,:) = zee_u(:,:) + fse3u_0(:,:,jk) * umask(:,:,jk)
108         zee_v(:,:) = zee_v(:,:) + fse3v_0(:,:,jk) * vmask(:,:,jk)
109         DO jj = 1, jpjm1                      ! f-point : fmask=shlat at coasts, use the product of umask
110            zee_f(:,jj) = zee_f(:,jj) + fse3f_0(:,jj,jk) *  umask(:,jj,jk) * umask(:,jj+1,jk)
111         END DO
112      END DO 
113      !                                         ! Compute and mask the inverse of the local depth at T, U, V and F points
114      zee_t(:,:) = 1._wp / zee_t(:,:) * tmask(:,:,1)
115      zee_u(:,:) = 1._wp / zee_u(:,:) * umask(:,:,1)
116      zee_v(:,:) = 1._wp / zee_v(:,:) * vmask(:,:,1)
117      DO jj = 1, jpjm1                               ! f-point case fmask cannot be used
118         zee_f(:,jj) = 1._wp / zee_f(:,jj) * umask(:,jj,1) * umask(:,jj+1,1)
119      END DO
120      CALL lbc_lnk( zee_f, 'F', 1. )                 ! lateral boundary condition on ee_f
121      !
122      DO jk = 1, jpk                            ! mu coefficients
123         mut(:,:,jk) = zee_t(:,:) * tmask(:,:,jk)     ! T-point at T levels
124         muu(:,:,jk) = zee_u(:,:) * umask(:,:,jk)     ! U-point at T levels
125         muv(:,:,jk) = zee_v(:,:) * vmask(:,:,jk)     ! V-point at T levels
126      END DO
127      DO jk = 1, jpk                                 ! F-point : fmask=shlat at coasts, use the product of umask
128         DO jj = 1, jpjm1
129               muf(:,jj,jk) = zee_f(:,jj) * umask(:,jj,jk) * umask(:,jj+1,jk)   ! at T levels
130         END DO
131         muf(:,jpj,jk) = 0._wp
132      END DO
133      CALL lbc_lnk( muf, 'F', 1. )                   ! lateral boundary condition
134
135
136      hu_0(:,:) = 0.e0                          ! Reference ocean depth at U- and V-points
137      hv_0(:,:) = 0.e0
138      DO jk = 1, jpk
139         hu_0(:,:) = hu_0(:,:) + fse3u_0(:,:,jk) * umask(:,:,jk)
140         hv_0(:,:) = hv_0(:,:) + fse3v_0(:,:,jk) * vmask(:,:,jk)
141      END DO
142     
143      DO jj = 1, jpjm1                          ! initialise before and now Sea Surface Height at u-, v-, f-points
144         DO ji = 1, jpim1   ! NO vector opt.
145            zcoefu = 0.50_wp / ( e1u(ji,jj) * e2u(ji,jj) ) * umask(ji,jj,1)
146            zcoefv = 0.50_wp / ( e1v(ji,jj) * e2v(ji,jj) ) * vmask(ji,jj,1)
147            zcoeff = 0.25_wp / ( e1f(ji,jj) * e2f(ji,jj) ) * umask(ji,jj,1) * umask(ji,jj+1,1)
148            !
149            zvt           = e1e2t(ji  ,jj  ) * sshb(ji  ,jj  )    ! before fields
150            zvt_ip1       = e1e2t(ji+1,jj  ) * sshb(ji+1,jj  )
151            zvt_jp1       = e1e2t(ji  ,jj+1) * sshb(ji  ,jj+1)
152            sshu_b(ji,jj) = zcoefu * ( zvt + zvt_ip1 )
153            sshv_b(ji,jj) = zcoefv * ( zvt + zvt_jp1 )
154            !
155            zvt           = e1e2t(ji  ,jj  ) * sshn(ji  ,jj  )    ! now fields
156            zvt_ip1       = e1e2t(ji+1,jj  ) * sshn(ji+1,jj  )
157            zvt_jp1       = e1e2t(ji  ,jj+1) * sshn(ji  ,jj+1)
158            zvt_ip1jp1    = e1e2t(ji+1,jj+1) * sshn(ji+1,jj+1)
159            sshu_n(ji,jj) = zcoefu * ( zvt + zvt_ip1 )
160            sshv_n(ji,jj) = zcoefv * ( zvt + zvt_jp1 )
161            sshf_n(ji,jj) = zcoeff * ( zvt + zvt_ip1 + zvt_jp1 + zvt_ip1jp1 )
162         END DO
163      END DO
164      CALL lbc_lnk( sshu_n, 'U', 1. )   ;   CALL lbc_lnk( sshu_b, 'U', 1. )      ! lateral boundary conditions
165      CALL lbc_lnk( sshv_n, 'V', 1. )   ;   CALL lbc_lnk( sshv_b, 'V', 1. )
166      CALL lbc_lnk( sshf_n, 'F', 1. )
167      !
168      CALL wrk_dealloc( jpi, jpj, zee_t, zee_u, zee_v, zee_f )
169      !
170      IF( nn_timing == 1 )  CALL timing_stop('dom_vvl')
171      !
172   END SUBROUTINE dom_vvl
173
174
175   SUBROUTINE dom_vvl_2( kt, pe3u_b, pe3v_b )
176      !!----------------------------------------------------------------------
177      !!                ***  ROUTINE dom_vvl_2  ***
178      !!                   
179      !! ** Purpose :   compute the vertical scale factors at u- and v-points
180      !!              in variable volume case.
181      !!
182      !! ** Method  :   In variable volume case (non linear sea surface) the
183      !!              the vertical scale factor at velocity points is computed
184      !!              as the average of the cell surface weighted e3t.
185      !!                It uses the sea surface heigth so it have to be initialized
186      !!              after ssh is read/set
187      !!----------------------------------------------------------------------
188      INTEGER                   , INTENT(in   ) ::   kt               ! ocean time-step index
189      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pe3u_b, pe3v_b   ! before vertical scale factor at u- & v-pts
190      !
191      INTEGER  ::   ji, jj, jk   ! dummy loop indices
192      INTEGER  ::   iku, ikv     ! local integers   
193      INTEGER  ::   ii0, ii1, ij0, ij1   ! temporary integers
194      REAL(wp) ::   zvt, zvtip1, zvtjp1  ! local scalars
195      !!----------------------------------------------------------------------
196      !
197      IF( nn_timing == 1 )  CALL timing_start('dom_vvl_2')
198      !
199      IF( lwp .AND. kt == nit000 ) THEN
200         WRITE(numout,*)
201         WRITE(numout,*) 'dom_vvl_2 : Variable volume, fse3t_b initialization'
202         WRITE(numout,*) '~~~~~~~~~ '
203         pe3u_b(:,:,jpk) = fse3u_0(:,:,jpk)
204         pe3v_b(:,:,jpk) = fse3v_0(:,:,jpk)
205      ENDIF
206     
207      DO jk = 1, jpkm1           ! set the before scale factors at u- & v-points
208         DO jj = 2, jpjm1
209            DO ji = fs_2, fs_jpim1
210               zvt    = ( fse3t_b(ji  ,jj  ,jk) - fse3t_0(ji  ,jj  ,jk) ) * e1e2t(ji  ,jj  )
211               zvtip1 = ( fse3t_b(ji+1,jj  ,jk) - fse3t_0(ji+1,jj  ,jk) ) * e1e2t(ji+1,jj  )
212               zvtjp1 = ( fse3t_b(ji  ,jj+1,jk) - fse3t_0(ji  ,jj+1,jk) ) * e1e2t(ji  ,jj+1)
213               pe3u_b(ji,jj,jk) = fse3u_0(ji,jj,jk) + 0.5_wp * ( zvt + zvtip1 ) / ( e1u(ji,jj) * e2u(ji,jj) )
214               pe3v_b(ji,jj,jk) = fse3v_0(ji,jj,jk) + 0.5_wp * ( zvt + zvtjp1 ) / ( e1v(ji,jj) * e2v(ji,jj) )
215            END DO
216         END DO
217      END DO
218
219      ! Correct scale factors at locations that have been individually modified in domhgr
220      ! Such modifications break the relationship between e1e2t and e1u*e2u etc. Recompute
221      ! scale factors ignoring the modified metric.
222      !                                                ! =====================
223      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN    ! ORCA R2 configuration
224         !                                             ! =====================
225         IF( nn_cla == 0 ) THEN
226            !
227            ii0 = 139   ;   ii1 = 140        ! Gibraltar Strait (e2u was modified)
228            ij0 = 102   ;   ij1 = 102   
229            DO jk = 1, jpkm1                 ! set the before scale factors at u-points
230               DO jj = mj0(ij0), mj1(ij1)
231                  DO ji = mi0(ii0), mi1(ii1)
232                     zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj)
233                     pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) )
234                  END DO
235               END DO
236            END DO
237            !
238            ii0 = 160   ;   ii1 = 160        ! Bab el Mandeb (e2u and e1v were modified)
239            ij0 =  88   ;   ij1 =  88   
240            DO jk = 1, jpkm1                 ! set the before scale factors at u-points
241               DO jj = mj0(ij0), mj1(ij1)
242                  DO ji = mi0(ii0), mi1(ii1)
243                     zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj)
244                     pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) )
245                  END DO
246               END DO
247            END DO
248            DO jk = 1, jpkm1                 ! set the before scale factors at v-points
249               DO jj = mj0(ij0), mj1(ij1)
250                  DO ji = mi0(ii0), mi1(ii1)
251                     zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj)
252                     pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) )
253                  END DO
254               END DO
255            END DO
256         ENDIF
257
258         ii0 = 145   ;   ii1 = 146        ! Danish Straits (e2u was modified)
259         ij0 = 116   ;   ij1 = 116   
260         DO jk = 1, jpkm1                 ! set the before scale factors at u-points
261            DO jj = mj0(ij0), mj1(ij1)
262               DO ji = mi0(ii0), mi1(ii1)
263                  zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj)
264                  pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) )
265               END DO
266            END DO
267         END DO
268         !
269      ENDIF
270         !                                             ! =====================
271      IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN    ! ORCA R1 configuration
272         !                                             ! =====================
273
274         ii0 = 281   ;   ii1 = 282        ! Gibraltar Strait (e2u was modified)
275         ij0 = 200   ;   ij1 = 200   
276         DO jk = 1, jpkm1                 ! set the before scale factors at u-points
277            DO jj = mj0(ij0), mj1(ij1)
278               DO ji = mi0(ii0), mi1(ii1)
279                  zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj)
280                  pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) )
281               END DO
282            END DO
283         END DO
284
285         ii0 = 314   ;   ii1 = 315        ! Bhosporus Strait (e2u was modified)
286         ij0 = 208   ;   ij1 = 208   
287         DO jk = 1, jpkm1                 ! set the before scale factors at u-points
288            DO jj = mj0(ij0), mj1(ij1)
289               DO ji = mi0(ii0), mi1(ii1)
290                  zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj)
291                  pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) )
292               END DO
293            END DO
294         END DO
295
296         ii0 =  44   ;   ii1 =  44        ! Lombok Strait (e1v was modified)
297         ij0 = 124   ;   ij1 = 125   
298         DO jk = 1, jpkm1                 ! set the before scale factors at v-points
299            DO jj = mj0(ij0), mj1(ij1)
300               DO ji = mi0(ii0), mi1(ii1)
301                  zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj)
302                  pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) )
303               END DO
304            END DO
305         END DO
306
307         ii0 =  48   ;   ii1 =  48        ! Sumba Strait (e1v was modified) [closed from bathy_11 on]
308         ij0 = 124   ;   ij1 = 125   
309         DO jk = 1, jpkm1                 ! set the before scale factors at v-points
310            DO jj = mj0(ij0), mj1(ij1)
311               DO ji = mi0(ii0), mi1(ii1)
312                  zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj)
313                  pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) )
314               END DO
315            END DO
316         END DO
317
318         ii0 =  53   ;   ii1 =  53        ! Ombai Strait (e1v was modified)
319         ij0 = 124   ;   ij1 = 125   
320         DO jk = 1, jpkm1                 ! set the before scale factors at v-points
321            DO jj = mj0(ij0), mj1(ij1)
322               DO ji = mi0(ii0), mi1(ii1)
323                  zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj)
324                  pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) )
325               END DO
326            END DO
327         END DO
328
329         ii0 =  56   ;   ii1 =  56        ! Timor Passage (e1v was modified)
330         ij0 = 124   ;   ij1 = 125   
331         DO jk = 1, jpkm1                 ! set the before scale factors at v-points
332            DO jj = mj0(ij0), mj1(ij1)
333               DO ji = mi0(ii0), mi1(ii1)
334                  zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj)
335                  pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) )
336               END DO
337            END DO
338         END DO
339
340         ii0 =  55   ;   ii1 =  55        ! West Halmahera Strait (e1v was modified)
341         ij0 = 141   ;   ij1 = 142   
342         DO jk = 1, jpkm1                 ! set the before scale factors at v-points
343            DO jj = mj0(ij0), mj1(ij1)
344               DO ji = mi0(ii0), mi1(ii1)
345                  zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj)
346                  pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) )
347               END DO
348            END DO
349         END DO
350
351         ii0 =  58   ;   ii1 =  58        ! East Halmahera Strait (e1v was modified)
352         ij0 = 141   ;   ij1 = 142   
353         DO jk = 1, jpkm1                 ! set the before scale factors at v-points
354            DO jj = mj0(ij0), mj1(ij1)
355               DO ji = mi0(ii0), mi1(ii1)
356                  zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj)
357                  pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) )
358               END DO
359            END DO
360         END DO
361
362         !
363      ENDIF
364      !                                                ! ======================
365      IF( cp_cfg == "orca" .AND. jp_cfg == 05 ) THEN   ! ORCA R05 configuration
366         !                                             ! ======================
367         ii0 = 563   ;   ii1 = 564        ! Gibraltar Strait (e2u was modified)
368         ij0 = 327   ;   ij1 = 327   
369         DO jk = 1, jpkm1                 ! set the before scale factors at u-points
370            DO jj = mj0(ij0), mj1(ij1)
371               DO ji = mi0(ii0), mi1(ii1)
372                  zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj)
373                  pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) )
374               END DO
375            END DO
376         END DO
377         !
378         ii0 = 627   ;   ii1 = 628        ! Bosphore Strait (e2u was modified)
379         ij0 = 343   ;   ij1 = 343   
380         DO jk = 1, jpkm1                 ! set the before scale factors at u-points
381            DO jj = mj0(ij0), mj1(ij1)
382               DO ji = mi0(ii0), mi1(ii1)
383                  zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj)
384                  pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) )
385               END DO
386            END DO
387         END DO
388         !
389         ii0 =  93   ;   ii1 =  94        ! Sumba Strait (e2u was modified)
390         ij0 = 232   ;   ij1 = 232   
391         DO jk = 1, jpkm1                 ! set the before scale factors at u-points
392            DO jj = mj0(ij0), mj1(ij1)
393               DO ji = mi0(ii0), mi1(ii1)
394                  zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj)
395                  pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) )
396               END DO
397            END DO
398         END DO
399         !
400         ii0 = 103   ;   ii1 = 103        ! Ombai Strait (e2u was modified)
401         ij0 = 232   ;   ij1 = 232   
402         DO jk = 1, jpkm1                 ! set the before scale factors at u-points
403            DO jj = mj0(ij0), mj1(ij1)
404               DO ji = mi0(ii0), mi1(ii1)
405                  zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj)
406                  pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) )
407               END DO
408            END DO
409         END DO
410         !
411         ii0 =  15   ;   ii1 =  15        ! Palk Strait (e2u was modified)
412         ij0 = 270   ;   ij1 = 270   
413         DO jk = 1, jpkm1                 ! set the before scale factors at u-points
414            DO jj = mj0(ij0), mj1(ij1)
415               DO ji = mi0(ii0), mi1(ii1)
416                  zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj)
417                  pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) )
418               END DO
419            END DO
420         END DO
421         !
422         ii0 =  87   ;   ii1 =  87        ! Lombok Strait (e1v was modified)
423         ij0 = 232   ;   ij1 = 233   
424         DO jk = 1, jpkm1                 ! set the before scale factors at v-points
425            DO jj = mj0(ij0), mj1(ij1)
426               DO ji = mi0(ii0), mi1(ii1)
427                  zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj)
428                  pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) )
429               END DO
430            END DO
431         END DO
432         !
433         ii0 = 662   ;   ii1 = 662        ! Bab el Mandeb (e1v was modified)
434         ij0 = 276   ;   ij1 = 276   
435         DO jk = 1, jpkm1                 ! set the before scale factors at v-points
436            DO jj = mj0(ij0), mj1(ij1)
437               DO ji = mi0(ii0), mi1(ii1)
438                  zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj)
439                  pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) )
440               END DO
441            END DO
442         END DO
443         !
444      ENDIF
445      ! End of individual corrections to scale factors
446
447      IF( ln_zps ) THEN          ! minimum of the e3t at partial cell level
448         DO jj = 2, jpjm1
449            DO ji = fs_2, fs_jpim1
450               iku = mbku(ji,jj)
451               ikv = mbkv(ji,jj)
452               pe3u_b(ji,jj,iku) = MIN( fse3t_b(ji,jj,iku), fse3t_b(ji+1,jj  ,iku) ) 
453               pe3v_b(ji,jj,ikv) = MIN( fse3t_b(ji,jj,ikv), fse3t_b(ji  ,jj+1,ikv) ) 
454            END DO
455         END DO
456      ENDIF
457
458      pe3u_b(:,:,:) = pe3u_b(:,:,:) - fse3u_0(:,:,:)      ! anomaly to avoid zero along closed boundary/extra halos
459      pe3v_b(:,:,:) = pe3v_b(:,:,:) - fse3v_0(:,:,:)
460      CALL lbc_lnk( pe3u_b(:,:,:), 'U', 1. )               ! lateral boundary conditions
461      CALL lbc_lnk( pe3v_b(:,:,:), 'V', 1. )
462      pe3u_b(:,:,:) = pe3u_b(:,:,:) + fse3u_0(:,:,:)      ! recover the full scale factor
463      pe3v_b(:,:,:) = pe3v_b(:,:,:) + fse3v_0(:,:,:)
464      !
465      IF( nn_timing == 1 )  CALL timing_stop('dom_vvl_2')
466      !
467   END SUBROUTINE dom_vvl_2
468   
469#else
470   !!----------------------------------------------------------------------
471   !!   Default option :                                      Empty routine
472   !!----------------------------------------------------------------------
473CONTAINS
474   SUBROUTINE dom_vvl
475   END SUBROUTINE dom_vvl
476   SUBROUTINE dom_vvl_2(kdum, pudum, pvdum )
477      USE par_kind
478      INTEGER                   , INTENT(in   ) ::   kdum       
479      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pudum, pvdum
480   END SUBROUTINE dom_vvl_2
481#endif
482
483   !!======================================================================
484END MODULE domvvl
Note: See TracBrowser for help on using the repository browser.