source: trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90 @ 3294

Last change on this file since 3294 was 3294, checked in by rblod, 9 years ago

Merge of 3.4beta into the trunk

  • Property svn:keywords set to Id
File size: 22.6 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          ! 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) = fse3u_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) * e1e2t(ji,jj)
211               pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1e2t(ji+1,jj) ) / ( e1u(ji,jj) * e2u(ji,jj) )
212               pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e1e2t(ji,jj+1) ) / ( e1v(ji,jj) * e2v(ji,jj) )
213            END DO
214         END DO
215      END DO
216
217      ! Correct scale factors at locations that have been individually modified in domhgr
218      ! Such modifications break the relationship between e1e2t and e1u*e2u etc. Recompute
219      ! scale factors ignoring the modified metric.
220      !                                                ! =====================
221      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN    ! ORCA R2 configuration
222         !                                             ! =====================
223         IF( nn_cla == 0 ) THEN
224            !
225            ii0 = 139   ;   ii1 = 140        ! Gibraltar Strait (e2u was modified)
226            ij0 = 102   ;   ij1 = 102   
227            DO jk = 1, jpkm1                 ! set the before scale factors at u-points
228               DO jj = mj0(ij0), mj1(ij1)
229                  DO ji = mi0(ii0), mi1(ii1)
230                     zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj)
231                     pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) )
232                  END DO
233               END DO
234            END DO
235            !
236            ii0 = 160   ;   ii1 = 160        ! Bab el Mandeb (e2u and e1v were modified)
237            ij0 =  88   ;   ij1 =  88   
238            DO jk = 1, jpkm1                 ! set the before scale factors at u-points
239               DO jj = mj0(ij0), mj1(ij1)
240                  DO ji = mi0(ii0), mi1(ii1)
241                     zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj)
242                     pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) )
243                  END DO
244               END DO
245            END DO
246            DO jk = 1, jpkm1                 ! set the before scale factors at v-points
247               DO jj = mj0(ij0), mj1(ij1)
248                  DO ji = mi0(ii0), mi1(ii1)
249                     zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj)
250                     pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) )
251                  END DO
252               END DO
253            END DO
254         ENDIF
255
256         ii0 = 145   ;   ii1 = 146        ! Danish Straits (e2u was modified)
257         ij0 = 116   ;   ij1 = 116   
258         DO jk = 1, jpkm1                 ! set the before scale factors at u-points
259            DO jj = mj0(ij0), mj1(ij1)
260               DO ji = mi0(ii0), mi1(ii1)
261                  zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj)
262                  pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) )
263               END DO
264            END DO
265         END DO
266         !
267      ENDIF
268         !                                             ! =====================
269      IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN    ! ORCA R1 configuration
270         !                                             ! =====================
271
272         ii0 = 281   ;   ii1 = 282        ! Gibraltar Strait (e2u was modified)
273         ij0 = 200   ;   ij1 = 200   
274         DO jk = 1, jpkm1                 ! set the before scale factors at u-points
275            DO jj = mj0(ij0), mj1(ij1)
276               DO ji = mi0(ii0), mi1(ii1)
277                  zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj)
278                  pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) )
279               END DO
280            END DO
281         END DO
282
283         ii0 = 314   ;   ii1 = 315        ! Bhosporus Strait (e2u was modified)
284         ij0 = 208   ;   ij1 = 208   
285         DO jk = 1, jpkm1                 ! set the before scale factors at u-points
286            DO jj = mj0(ij0), mj1(ij1)
287               DO ji = mi0(ii0), mi1(ii1)
288                  zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj)
289                  pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) )
290               END DO
291            END DO
292         END DO
293
294         ii0 =  44   ;   ii1 =  44        ! Lombok Strait (e1v was modified)
295         ij0 = 124   ;   ij1 = 125   
296         DO jk = 1, jpkm1                 ! set the before scale factors at v-points
297            DO jj = mj0(ij0), mj1(ij1)
298               DO ji = mi0(ii0), mi1(ii1)
299                  zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj)
300                  pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) )
301               END DO
302            END DO
303         END DO
304
305         ii0 =  48   ;   ii1 =  48        ! Sumba Strait (e1v was modified) [closed from bathy_11 on]
306         ij0 = 124   ;   ij1 = 125   
307         DO jk = 1, jpkm1                 ! set the before scale factors at v-points
308            DO jj = mj0(ij0), mj1(ij1)
309               DO ji = mi0(ii0), mi1(ii1)
310                  zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj)
311                  pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) )
312               END DO
313            END DO
314         END DO
315
316         ii0 =  53   ;   ii1 =  53        ! Ombai Strait (e1v was modified)
317         ij0 = 124   ;   ij1 = 125   
318         DO jk = 1, jpkm1                 ! set the before scale factors at v-points
319            DO jj = mj0(ij0), mj1(ij1)
320               DO ji = mi0(ii0), mi1(ii1)
321                  zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj)
322                  pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) )
323               END DO
324            END DO
325         END DO
326
327         ii0 =  56   ;   ii1 =  56        ! Timor Passage (e1v was modified)
328         ij0 = 124   ;   ij1 = 125   
329         DO jk = 1, jpkm1                 ! set the before scale factors at v-points
330            DO jj = mj0(ij0), mj1(ij1)
331               DO ji = mi0(ii0), mi1(ii1)
332                  zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj)
333                  pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) )
334               END DO
335            END DO
336         END DO
337
338         ii0 =  55   ;   ii1 =  55        ! West Halmahera Strait (e1v was modified)
339         ij0 = 141   ;   ij1 = 142   
340         DO jk = 1, jpkm1                 ! set the before scale factors at v-points
341            DO jj = mj0(ij0), mj1(ij1)
342               DO ji = mi0(ii0), mi1(ii1)
343                  zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj)
344                  pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) )
345               END DO
346            END DO
347         END DO
348
349         ii0 =  58   ;   ii1 =  58        ! East Halmahera Strait (e1v was modified)
350         ij0 = 141   ;   ij1 = 142   
351         DO jk = 1, jpkm1                 ! set the before scale factors at v-points
352            DO jj = mj0(ij0), mj1(ij1)
353               DO ji = mi0(ii0), mi1(ii1)
354                  zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj)
355                  pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) )
356               END DO
357            END DO
358         END DO
359
360         !
361      ENDIF
362      !                                                ! ======================
363      IF( cp_cfg == "orca" .AND. jp_cfg == 05 ) THEN   ! ORCA R05 configuration
364         !                                             ! ======================
365         ii0 = 563   ;   ii1 = 564        ! Gibraltar Strait (e2u was modified)
366         ij0 = 327   ;   ij1 = 327   
367         DO jk = 1, jpkm1                 ! set the before scale factors at u-points
368            DO jj = mj0(ij0), mj1(ij1)
369               DO ji = mi0(ii0), mi1(ii1)
370                  zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj)
371                  pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) )
372               END DO
373            END DO
374         END DO
375         !
376         ii0 = 627   ;   ii1 = 628        ! Bosphore Strait (e2u was modified)
377         ij0 = 343   ;   ij1 = 343   
378         DO jk = 1, jpkm1                 ! set the before scale factors at u-points
379            DO jj = mj0(ij0), mj1(ij1)
380               DO ji = mi0(ii0), mi1(ii1)
381                  zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj)
382                  pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) )
383               END DO
384            END DO
385         END DO
386         !
387         ii0 =  93   ;   ii1 =  94        ! Sumba Strait (e2u was modified)
388         ij0 = 232   ;   ij1 = 232   
389         DO jk = 1, jpkm1                 ! set the before scale factors at u-points
390            DO jj = mj0(ij0), mj1(ij1)
391               DO ji = mi0(ii0), mi1(ii1)
392                  zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj)
393                  pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) )
394               END DO
395            END DO
396         END DO
397         !
398         ii0 = 103   ;   ii1 = 103        ! Ombai Strait (e2u was modified)
399         ij0 = 232   ;   ij1 = 232   
400         DO jk = 1, jpkm1                 ! set the before scale factors at u-points
401            DO jj = mj0(ij0), mj1(ij1)
402               DO ji = mi0(ii0), mi1(ii1)
403                  zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj)
404                  pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) )
405               END DO
406            END DO
407         END DO
408         !
409         ii0 =  15   ;   ii1 =  15        ! Palk Strait (e2u was modified)
410         ij0 = 270   ;   ij1 = 270   
411         DO jk = 1, jpkm1                 ! set the before scale factors at u-points
412            DO jj = mj0(ij0), mj1(ij1)
413               DO ji = mi0(ii0), mi1(ii1)
414                  zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj)
415                  pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) )
416               END DO
417            END DO
418         END DO
419         !
420         ii0 =  87   ;   ii1 =  87        ! Lombok Strait (e1v was modified)
421         ij0 = 232   ;   ij1 = 233   
422         DO jk = 1, jpkm1                 ! set the before scale factors at v-points
423            DO jj = mj0(ij0), mj1(ij1)
424               DO ji = mi0(ii0), mi1(ii1)
425                  zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj)
426                  pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) )
427               END DO
428            END DO
429         END DO
430         !
431         ii0 = 662   ;   ii1 = 662        ! Bab el Mandeb (e1v was modified)
432         ij0 = 276   ;   ij1 = 276   
433         DO jk = 1, jpkm1                 ! set the before scale factors at v-points
434            DO jj = mj0(ij0), mj1(ij1)
435               DO ji = mi0(ii0), mi1(ii1)
436                  zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj)
437                  pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) )
438               END DO
439            END DO
440         END DO
441         !
442      ENDIF
443      ! End of individual corrections to scale factors
444
445      IF( ln_zps ) THEN          ! minimum of the e3t at partial cell level
446         DO jj = 2, jpjm1
447            DO ji = fs_2, fs_jpim1
448               iku = mbku(ji,jj)
449               ikv = mbkv(ji,jj)
450               pe3u_b(ji,jj,iku) = MIN( fse3t_b(ji,jj,iku), fse3t_b(ji+1,jj  ,iku) ) 
451               pe3v_b(ji,jj,ikv) = MIN( fse3t_b(ji,jj,ikv), fse3t_b(ji  ,jj+1,ikv) ) 
452            END DO
453         END DO
454      ENDIF
455
456      pe3u_b(:,:,:) = pe3u_b(:,:,:) - fse3u_0(:,:,:)      ! anomaly to avoid zero along closed boundary/extra halos
457      pe3v_b(:,:,:) = pe3v_b(:,:,:) - fse3v_0(:,:,:)
458      CALL lbc_lnk( pe3u_b(:,:,:), 'U', 1. )               ! lateral boundary conditions
459      CALL lbc_lnk( pe3v_b(:,:,:), 'V', 1. )
460      pe3u_b(:,:,:) = pe3u_b(:,:,:) + fse3u_0(:,:,:)      ! recover the full scale factor
461      pe3v_b(:,:,:) = pe3v_b(:,:,:) + fse3v_0(:,:,:)
462      !
463      IF( nn_timing == 1 )  CALL timing_stop('dom_vvl_2')
464      !
465   END SUBROUTINE dom_vvl_2
466   
467#else
468   !!----------------------------------------------------------------------
469   !!   Default option :                                      Empty routine
470   !!----------------------------------------------------------------------
471CONTAINS
472   SUBROUTINE dom_vvl
473   END SUBROUTINE dom_vvl
474   SUBROUTINE dom_vvl_2(kdum, pudum, pvdum )
475      USE par_kind
476      INTEGER                   , INTENT(in   ) ::   kdum       
477      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pudum, pvdum
478   END SUBROUTINE dom_vvl_2
479#endif
480
481   !!======================================================================
482END MODULE domvvl
Note: See TracBrowser for help on using the repository browser.