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_r3867_MERCATOR1_DYN/NEMOGCM/NEMO/OPA_SRC/DOM – NEMO

source: branches/2013/dev_r3867_MERCATOR1_DYN/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90 @ 3970

Last change on this file since 3970 was 3970, checked in by cbricaud, 11 years ago

Time splitting update, see ticket #1079
  • Property svn:keywords set to Id
File size: 23.9 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#if defined key_dynspg_ts
144      ! bg jchanut tschanges
145      ht_0(:,:) = 0._wp                         ! Reference ocean depth at T-points
146      DO jk = 1, jpk
147         ht_0(:,:) = ht_0(:,:) + fse3t_0(:,:,jk) * tmask(:,:,jk)
148      END DO 
149                                                ! Reference ocean depth at F-points
150                                                ! Ensure that depth is non-zero over land
151      IF ( .not. ln_sco ) THEN
152         IF( rn_hmin < 0._wp ) THEN    ;   jk = - INT( rn_hmin )                                      ! from a nb of level
153         ELSE                          ;   jk = MINLOC( gdepw_0, mask = gdepw_0 > rn_hmin, dim = 1 )  ! from a depth
154         ENDIF
155         hf_0(:,:) = gdepw_0(jk+1)
156      ELSE
157         hf_0(:,:) = hbatf(:,:)
158      END IF
159
160      DO jj = 1, jpjm1
161         hf_0(:,jj) = hf_0(:,jj)*(1._wp- umask(:,jj,1) * umask(:,jj+1,1))
162      END DO 
163           
164      DO jk = 1, jpkm1
165         DO jj = 1, jpjm1
166            hf_0(:,jj) = hf_0(:,jj) + fse3f_0(:,jj,jk) * umask(:,jj,jk) * umask(:,jj+1,jk)
167         END DO
168      END DO
169      CALL lbc_lnk( hf_0, 'F', 1._wp )
170      ! end jchanut tschanges
171#endif 
172
173      DO jj = 1, jpjm1                          ! initialise before and now Sea Surface Height at u-, v-, f-points
174         DO ji = 1, jpim1   ! NO vector opt.
175            zcoefu = 0.50_wp / ( e1u(ji,jj) * e2u(ji,jj) ) * umask(ji,jj,1)
176            zcoefv = 0.50_wp / ( e1v(ji,jj) * e2v(ji,jj) ) * vmask(ji,jj,1)
177            zcoeff = 0.25_wp / ( e1f(ji,jj) * e2f(ji,jj) ) * umask(ji,jj,1) * umask(ji,jj+1,1)
178            !
179            zvt           = e1e2t(ji  ,jj  ) * sshb(ji  ,jj  )    ! before fields
180            zvt_ip1       = e1e2t(ji+1,jj  ) * sshb(ji+1,jj  )
181            zvt_jp1       = e1e2t(ji  ,jj+1) * sshb(ji  ,jj+1)
182            sshu_b(ji,jj) = zcoefu * ( zvt + zvt_ip1 )
183            sshv_b(ji,jj) = zcoefv * ( zvt + zvt_jp1 )
184            !
185            zvt           = e1e2t(ji  ,jj  ) * sshn(ji  ,jj  )    ! now fields
186            zvt_ip1       = e1e2t(ji+1,jj  ) * sshn(ji+1,jj  )
187            zvt_jp1       = e1e2t(ji  ,jj+1) * sshn(ji  ,jj+1)
188            zvt_ip1jp1    = e1e2t(ji+1,jj+1) * sshn(ji+1,jj+1)
189            sshu_n(ji,jj) = zcoefu * ( zvt + zvt_ip1 )
190            sshv_n(ji,jj) = zcoefv * ( zvt + zvt_jp1 )
191            sshf_n(ji,jj) = zcoeff * ( zvt + zvt_ip1 + zvt_jp1 + zvt_ip1jp1 )
192         END DO
193      END DO
194      CALL lbc_lnk( sshu_n, 'U', 1. )   ;   CALL lbc_lnk( sshu_b, 'U', 1. )      ! lateral boundary conditions
195      CALL lbc_lnk( sshv_n, 'V', 1. )   ;   CALL lbc_lnk( sshv_b, 'V', 1. )
196      CALL lbc_lnk( sshf_n, 'F', 1. )
197      !
198      CALL wrk_dealloc( jpi, jpj, zee_t, zee_u, zee_v, zee_f )
199      !
200      IF( nn_timing == 1 )  CALL timing_stop('dom_vvl')
201      !
202   END SUBROUTINE dom_vvl
203
204
205   SUBROUTINE dom_vvl_2( kt, pe3u_b, pe3v_b )
206      !!----------------------------------------------------------------------
207      !!                ***  ROUTINE dom_vvl_2  ***
208      !!                   
209      !! ** Purpose :   compute the vertical scale factors at u- and v-points
210      !!              in variable volume case.
211      !!
212      !! ** Method  :   In variable volume case (non linear sea surface) the
213      !!              the vertical scale factor at velocity points is computed
214      !!              as the average of the cell surface weighted e3t.
215      !!                It uses the sea surface heigth so it have to be initialized
216      !!              after ssh is read/set
217      !!----------------------------------------------------------------------
218      INTEGER                   , INTENT(in   ) ::   kt               ! ocean time-step index
219      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pe3u_b, pe3v_b   ! before vertical scale factor at u- & v-pts
220      !
221      INTEGER  ::   ji, jj, jk   ! dummy loop indices
222      INTEGER  ::   iku, ikv     ! local integers   
223      INTEGER  ::   ii0, ii1, ij0, ij1   ! temporary integers
224      REAL(wp) ::   zvt, zvtip1, zvtjp1  ! local scalars
225      !!----------------------------------------------------------------------
226      !
227      IF( nn_timing == 1 )  CALL timing_start('dom_vvl_2')
228      !
229      IF( lwp .AND. kt == nit000 ) THEN
230         WRITE(numout,*)
231         WRITE(numout,*) 'dom_vvl_2 : Variable volume, fse3t_b initialization'
232         WRITE(numout,*) '~~~~~~~~~ '
233         pe3u_b(:,:,jpk) = fse3u_0(:,:,jpk)
234         pe3v_b(:,:,jpk) = fse3v_0(:,:,jpk)
235      ENDIF
236     
237      DO jk = 1, jpkm1           ! set the before scale factors at u- & v-points
238         DO jj = 2, jpjm1
239            DO ji = fs_2, fs_jpim1
240               zvt    = ( fse3t_b(ji  ,jj  ,jk) - fse3t_0(ji  ,jj  ,jk) ) * e1e2t(ji  ,jj  )
241               zvtip1 = ( fse3t_b(ji+1,jj  ,jk) - fse3t_0(ji+1,jj  ,jk) ) * e1e2t(ji+1,jj  )
242               zvtjp1 = ( fse3t_b(ji  ,jj+1,jk) - fse3t_0(ji  ,jj+1,jk) ) * e1e2t(ji  ,jj+1)
243               pe3u_b(ji,jj,jk) = fse3u_0(ji,jj,jk) + 0.5_wp * ( zvt + zvtip1 ) / ( e1u(ji,jj) * e2u(ji,jj) )
244               pe3v_b(ji,jj,jk) = fse3v_0(ji,jj,jk) + 0.5_wp * ( zvt + zvtjp1 ) / ( e1v(ji,jj) * e2v(ji,jj) )
245            END DO
246         END DO
247      END DO
248
249      ! Correct scale factors at locations that have been individually modified in domhgr
250      ! Such modifications break the relationship between e1e2t and e1u*e2u etc. Recompute
251      ! scale factors ignoring the modified metric.
252      !                                                ! =====================
253      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN    ! ORCA R2 configuration
254         !                                             ! =====================
255         IF( nn_cla == 0 ) THEN
256            !
257            ii0 = 139   ;   ii1 = 140        ! Gibraltar Strait (e2u was modified)
258            ij0 = 102   ;   ij1 = 102   
259            DO jk = 1, jpkm1                 ! set the before scale factors at u-points
260               DO jj = mj0(ij0), mj1(ij1)
261                  DO ji = mi0(ii0), mi1(ii1)
262                     zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj)
263                     pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) )
264                  END DO
265               END DO
266            END DO
267            !
268            ii0 = 160   ;   ii1 = 160        ! Bab el Mandeb (e2u and e1v were modified)
269            ij0 =  88   ;   ij1 =  88   
270            DO jk = 1, jpkm1                 ! set the before scale factors at u-points
271               DO jj = mj0(ij0), mj1(ij1)
272                  DO ji = mi0(ii0), mi1(ii1)
273                     zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj)
274                     pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) )
275                  END DO
276               END DO
277            END DO
278            DO jk = 1, jpkm1                 ! set the before scale factors at v-points
279               DO jj = mj0(ij0), mj1(ij1)
280                  DO ji = mi0(ii0), mi1(ii1)
281                     zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj)
282                     pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) )
283                  END DO
284               END DO
285            END DO
286         ENDIF
287
288         ii0 = 145   ;   ii1 = 146        ! Danish Straits (e2u was modified)
289         ij0 = 116   ;   ij1 = 116   
290         DO jk = 1, jpkm1                 ! set the before scale factors at u-points
291            DO jj = mj0(ij0), mj1(ij1)
292               DO ji = mi0(ii0), mi1(ii1)
293                  zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj)
294                  pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) )
295               END DO
296            END DO
297         END DO
298         !
299      ENDIF
300         !                                             ! =====================
301      IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN    ! ORCA R1 configuration
302         !                                             ! =====================
303
304         ii0 = 281   ;   ii1 = 282        ! Gibraltar Strait (e2u was modified)
305         ij0 = 200   ;   ij1 = 200   
306         DO jk = 1, jpkm1                 ! set the before scale factors at u-points
307            DO jj = mj0(ij0), mj1(ij1)
308               DO ji = mi0(ii0), mi1(ii1)
309                  zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj)
310                  pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) )
311               END DO
312            END DO
313         END DO
314
315         ii0 = 314   ;   ii1 = 315        ! Bhosporus Strait (e2u was modified)
316         ij0 = 208   ;   ij1 = 208   
317         DO jk = 1, jpkm1                 ! set the before scale factors at u-points
318            DO jj = mj0(ij0), mj1(ij1)
319               DO ji = mi0(ii0), mi1(ii1)
320                  zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj)
321                  pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) )
322               END DO
323            END DO
324         END DO
325
326         ii0 =  44   ;   ii1 =  44        ! Lombok Strait (e1v was modified)
327         ij0 = 124   ;   ij1 = 125   
328         DO jk = 1, jpkm1                 ! set the before scale factors at v-points
329            DO jj = mj0(ij0), mj1(ij1)
330               DO ji = mi0(ii0), mi1(ii1)
331                  zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj)
332                  pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) )
333               END DO
334            END DO
335         END DO
336
337         ii0 =  48   ;   ii1 =  48        ! Sumba Strait (e1v was modified) [closed from bathy_11 on]
338         ij0 = 124   ;   ij1 = 125   
339         DO jk = 1, jpkm1                 ! set the before scale factors at v-points
340            DO jj = mj0(ij0), mj1(ij1)
341               DO ji = mi0(ii0), mi1(ii1)
342                  zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj)
343                  pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) )
344               END DO
345            END DO
346         END DO
347
348         ii0 =  53   ;   ii1 =  53        ! Ombai Strait (e1v was modified)
349         ij0 = 124   ;   ij1 = 125   
350         DO jk = 1, jpkm1                 ! set the before scale factors at v-points
351            DO jj = mj0(ij0), mj1(ij1)
352               DO ji = mi0(ii0), mi1(ii1)
353                  zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj)
354                  pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) )
355               END DO
356            END DO
357         END DO
358
359         ii0 =  56   ;   ii1 =  56        ! Timor Passage (e1v was modified)
360         ij0 = 124   ;   ij1 = 125   
361         DO jk = 1, jpkm1                 ! set the before scale factors at v-points
362            DO jj = mj0(ij0), mj1(ij1)
363               DO ji = mi0(ii0), mi1(ii1)
364                  zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj)
365                  pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) )
366               END DO
367            END DO
368         END DO
369
370         ii0 =  55   ;   ii1 =  55        ! West Halmahera Strait (e1v was modified)
371         ij0 = 141   ;   ij1 = 142   
372         DO jk = 1, jpkm1                 ! set the before scale factors at v-points
373            DO jj = mj0(ij0), mj1(ij1)
374               DO ji = mi0(ii0), mi1(ii1)
375                  zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj)
376                  pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) )
377               END DO
378            END DO
379         END DO
380
381         ii0 =  58   ;   ii1 =  58        ! East Halmahera Strait (e1v was modified)
382         ij0 = 141   ;   ij1 = 142   
383         DO jk = 1, jpkm1                 ! set the before scale factors at v-points
384            DO jj = mj0(ij0), mj1(ij1)
385               DO ji = mi0(ii0), mi1(ii1)
386                  zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj)
387                  pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) )
388               END DO
389            END DO
390         END DO
391
392         !
393      ENDIF
394      !                                                ! ======================
395      IF( cp_cfg == "orca" .AND. jp_cfg == 05 ) THEN   ! ORCA R05 configuration
396         !                                             ! ======================
397         ii0 = 563   ;   ii1 = 564        ! Gibraltar Strait (e2u was modified)
398         ij0 = 327   ;   ij1 = 327   
399         DO jk = 1, jpkm1                 ! set the before scale factors at u-points
400            DO jj = mj0(ij0), mj1(ij1)
401               DO ji = mi0(ii0), mi1(ii1)
402                  zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj)
403                  pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) )
404               END DO
405            END DO
406         END DO
407         !
408         ii0 = 627   ;   ii1 = 628        ! Bosphore Strait (e2u was modified)
409         ij0 = 343   ;   ij1 = 343   
410         DO jk = 1, jpkm1                 ! set the before scale factors at u-points
411            DO jj = mj0(ij0), mj1(ij1)
412               DO ji = mi0(ii0), mi1(ii1)
413                  zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj)
414                  pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) )
415               END DO
416            END DO
417         END DO
418         !
419         ii0 =  93   ;   ii1 =  94        ! Sumba Strait (e2u was modified)
420         ij0 = 232   ;   ij1 = 232   
421         DO jk = 1, jpkm1                 ! set the before scale factors at u-points
422            DO jj = mj0(ij0), mj1(ij1)
423               DO ji = mi0(ii0), mi1(ii1)
424                  zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj)
425                  pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) )
426               END DO
427            END DO
428         END DO
429         !
430         ii0 = 103   ;   ii1 = 103        ! Ombai Strait (e2u was modified)
431         ij0 = 232   ;   ij1 = 232   
432         DO jk = 1, jpkm1                 ! set the before scale factors at u-points
433            DO jj = mj0(ij0), mj1(ij1)
434               DO ji = mi0(ii0), mi1(ii1)
435                  zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj)
436                  pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) )
437               END DO
438            END DO
439         END DO
440         !
441         ii0 =  15   ;   ii1 =  15        ! Palk Strait (e2u was modified)
442         ij0 = 270   ;   ij1 = 270   
443         DO jk = 1, jpkm1                 ! set the before scale factors at u-points
444            DO jj = mj0(ij0), mj1(ij1)
445               DO ji = mi0(ii0), mi1(ii1)
446                  zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj)
447                  pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) )
448               END DO
449            END DO
450         END DO
451         !
452         ii0 =  87   ;   ii1 =  87        ! Lombok Strait (e1v was modified)
453         ij0 = 232   ;   ij1 = 233   
454         DO jk = 1, jpkm1                 ! set the before scale factors at v-points
455            DO jj = mj0(ij0), mj1(ij1)
456               DO ji = mi0(ii0), mi1(ii1)
457                  zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj)
458                  pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) )
459               END DO
460            END DO
461         END DO
462         !
463         ii0 = 662   ;   ii1 = 662        ! Bab el Mandeb (e1v was modified)
464         ij0 = 276   ;   ij1 = 276   
465         DO jk = 1, jpkm1                 ! set the before scale factors at v-points
466            DO jj = mj0(ij0), mj1(ij1)
467               DO ji = mi0(ii0), mi1(ii1)
468                  zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj)
469                  pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) )
470               END DO
471            END DO
472         END DO
473         !
474      ENDIF
475      ! End of individual corrections to scale factors
476
477      IF( ln_zps ) THEN          ! minimum of the e3t at partial cell level
478         DO jj = 2, jpjm1
479            DO ji = fs_2, fs_jpim1
480               iku = mbku(ji,jj)
481               ikv = mbkv(ji,jj)
482               pe3u_b(ji,jj,iku) = MIN( fse3t_b(ji,jj,iku), fse3t_b(ji+1,jj  ,iku) ) 
483               pe3v_b(ji,jj,ikv) = MIN( fse3t_b(ji,jj,ikv), fse3t_b(ji  ,jj+1,ikv) ) 
484            END DO
485         END DO
486      ENDIF
487
488      pe3u_b(:,:,:) = pe3u_b(:,:,:) - fse3u_0(:,:,:)      ! anomaly to avoid zero along closed boundary/extra halos
489      pe3v_b(:,:,:) = pe3v_b(:,:,:) - fse3v_0(:,:,:)
490      CALL lbc_lnk( pe3u_b(:,:,:), 'U', 1. )               ! lateral boundary conditions
491      CALL lbc_lnk( pe3v_b(:,:,:), 'V', 1. )
492      pe3u_b(:,:,:) = pe3u_b(:,:,:) + fse3u_0(:,:,:)      ! recover the full scale factor
493      pe3v_b(:,:,:) = pe3v_b(:,:,:) + fse3v_0(:,:,:)
494      !
495      IF( nn_timing == 1 )  CALL timing_stop('dom_vvl_2')
496      !
497   END SUBROUTINE dom_vvl_2
498   
499#else
500   !!----------------------------------------------------------------------
501   !!   Default option :                                      Empty routine
502   !!----------------------------------------------------------------------
503CONTAINS
504   SUBROUTINE dom_vvl
505   END SUBROUTINE dom_vvl
506   SUBROUTINE dom_vvl_2(kdum, pudum, pvdum )
507      USE par_kind
508      INTEGER                   , INTENT(in   ) ::   kdum       
509      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pudum, pvdum
510   END SUBROUTINE dom_vvl_2
511#endif
512
513   !!======================================================================
514END MODULE domvvl
Note: See TracBrowser for help on using the repository browser.