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

source: trunk/NEMO/OPA_SRC/DOM/domvvl.F90 @ 1499

Last change on this file since 1499 was 1438, checked in by rblod, 15 years ago

Merge VVL branch with the trunk (act II), see ticket #429
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 7.5 KB
RevLine 
[592]1MODULE domvvl
2   !!======================================================================
3   !!                       ***  MODULE domvvl   ***
4   !! Ocean :
5   !!======================================================================
[1438]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
[592]8   !!----------------------------------------------------------------------
[1438]9#if defined key_vvl
[592]10   !!----------------------------------------------------------------------
11   !!   'key_vvl'                              variable volume
12   !!----------------------------------------------------------------------
[1438]13   !!   dom_vvl     : defined coefficients to distribute ssh on each layers
[592]14   !!----------------------------------------------------------------------
15   USE oce             ! ocean dynamics and tracers
16   USE dom_oce         ! ocean space and time domain
[888]17   USE sbc_oce         ! surface boundary condition: ocean
18   USE phycst          ! physical constants
[592]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
23   IMPLICIT NONE
24   PRIVATE
25
[1438]26   PUBLIC dom_vvl        ! called by domain.F90
[592]27
[1438]28   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   ee_t, ee_u, ee_v, ee_f   !: ???
[592]29
[1438]30   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   mut, muu, muv, muf   !: ???
31
[592]32   REAL(wp), DIMENSION(jpk) ::   r2dt               ! vertical profile time-step, = 2 rdttra
33      !                                             ! except at nit000 (=rdttra) if neuler=0
34
35   !! * Substitutions
36#  include "domzgr_substitute.h90"
37#  include "vectopt_loop_substitute.h90"
38   !!----------------------------------------------------------------------
[1438]39   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)
[888]40   !! $Id$
[592]41   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
42   !!----------------------------------------------------------------------
43
44CONTAINS       
45
[1438]46   SUBROUTINE dom_vvl
[592]47      !!----------------------------------------------------------------------
[1438]48      !!                ***  ROUTINE dom_vvl  ***
[592]49      !!                   
50      !! ** Purpose :  compute coefficients muX at T-U-V-F points to spread
51      !!               ssh over the whole water column (scale factors)
52      !!
53      !!----------------------------------------------------------------------
[1438]54      INTEGER  ::   ji, jj, jk
55      REAL(wp) ::   zcoefu, zcoefv, zcoeff
[592]56      !!----------------------------------------------------------------------
57
58      IF(lwp)   THEN
59         WRITE(numout,*)
[1438]60         WRITE(numout,*) 'dom_vvl : Variable volume activated'
61         WRITE(numout,*) '~~~~~~~~  compute coef. used to spread ssh over each layers'
[592]62      ENDIF
63
64#if defined key_zco  ||  defined key_dynspg_rl
65      CALL ctl_stop( 'dom_vvl_ini : options key_zco/key_dynspg_rl are incompatible with variable volume option key_vvl')
66#endif
67
[1438]68      fsdept(:,:,:) = gdept (:,:,:)
69      fsdepw(:,:,:) = gdepw (:,:,:)
70      fsde3w(:,:,:) = gdep3w(:,:,:)
71      fse3t (:,:,:) = e3t   (:,:,:)
72      fse3u (:,:,:) = e3u   (:,:,:)
73      fse3v (:,:,:) = e3v   (:,:,:)
74      fse3f (:,:,:) = e3f   (:,:,:)
75      fse3w (:,:,:) = e3w   (:,:,:)
76      fse3uw(:,:,:) = e3uw  (:,:,:)
77      fse3vw(:,:,:) = e3vw  (:,:,:)
[592]78
79      ! mu computation
[1438]80      ! --------------
81      ! define ee_t, u, v and f as in sigma coordinate (ee_t = 1/ht, ...)
82      ee_t(:,:) = fse3t_0(:,:,1)        ! Lower bound : thickness of the first model level
83      ee_u(:,:) = fse3u_0(:,:,1)
84      ee_v(:,:) = fse3v_0(:,:,1)
85      ee_f(:,:) = fse3f_0(:,:,1)
86      DO jk = 2, jpkm1                   ! Sum of the masked vertical scale factors
87         ee_t(:,:) = ee_t(:,:) + fse3t_0(:,:,jk) * tmask(:,:,jk)
88         ee_u(:,:) = ee_u(:,:) + fse3u_0(:,:,jk) * umask(:,:,jk)
89         ee_v(:,:) = ee_v(:,:) + fse3v_0(:,:,jk) * vmask(:,:,jk)
90         DO jj = 1, jpjm1                      ! f-point : fmask=shlat at coasts, use the product of umask
91            ee_f(:,jj) = ee_f(:,jj) + fse3f_0(:,jj,jk) *  umask(:,jj,jk) * umask(:,jj+1,jk)
[592]92         END DO
[1438]93      END DO 
94      !                                  ! Compute and mask the inverse of the local depth at T, U, V and F points
95      ee_t(:,:) = 1. / ee_t(:,:) * tmask(:,:,1)
96      ee_u(:,:) = 1. / ee_u(:,:) * umask(:,:,1)
97      ee_v(:,:) = 1. / ee_v(:,:) * vmask(:,:,1)
98      DO jj = 1, jpjm1                         ! f-point case fmask cannot be used
99         ee_f(:,jj) = 1. / ee_f(:,jj) * umask(:,jj,1) * umask(:,jj+1,1)
[592]100      END DO
[1438]101      CALL lbc_lnk( ee_f, 'F', 1. )       ! lateral boundary condition on ee_f
102      !
103      DO jk = 1, jpk
104         mut(:,:,jk) = ee_t(:,:) * tmask(:,:,jk)   ! at T levels
105         muu(:,:,jk) = ee_u(:,:) * umask(:,:,jk)   ! at T levels
106         muv(:,:,jk) = ee_v(:,:) * vmask(:,:,jk)   ! at T levels
107      END DO
108      DO jk = 1, jpk
109         DO jj = 1, jpjm1                      ! f-point : fmask=shlat at coasts, use the product of umask
110               muf(:,jj,jk) = ee_f(:,jj) * umask(:,jj,jk) * umask(:,jj+1,jk)   ! at T levels
[592]111         END DO
[1438]112         muf(:,jpj,jk) = 0.e0
[592]113      END DO
[1438]114      CALL lbc_lnk( muf, 'F', 1. )       ! lateral boundary condition on ee_f
[592]115
116
[1438]117      ! Reference ocean depth at U- and V-points
118      hu_0(:,:) = 0.e0   
119      hv_0(:,:) = 0.e0
120      DO jk = 1, jpk
121         hu_0(:,:) = hu_0(:,:) + fse3u_0(:,:,jk) * umask(:,:,jk)
122         hv_0(:,:) = hv_0(:,:) + fse3v_0(:,:,jk) * vmask(:,:,jk)
123      END DO
[592]124
[1438]125      ! before and now Sea Surface Height at u-, v-, f-points
[592]126      DO jj = 1, jpjm1
[1438]127         DO ji = 1, jpim1
128            zcoefu = 0.5  * umask(ji,jj,1) / ( e1u(ji,jj) * e2u(ji,jj) )
129            zcoefv = 0.5  * vmask(ji,jj,1) / ( e1v(ji,jj) * e2v(ji,jj) )
130            zcoeff = 0.25 * umask(ji,jj,1) * umask(ji,jj+1,1)
131            sshu_b(ji,jj) = zcoefu * ( e1t(ji  ,jj) * e2t(ji  ,jj) * sshb(ji  ,jj)     &
132               &                     + e1t(ji+1,jj) * e2t(ji+1,jj) * sshb(ji+1,jj) )   
133            sshv_b(ji,jj) = zcoefv * ( e1t(ji,jj  ) * e2t(ji,jj  ) * sshb(ji,jj  )     &
134               &                     + e1t(ji,jj+1) * e2t(ji,jj+1) * sshb(ji,jj+1) )   
135            sshf_b(ji,jj) = zcoeff * ( sshb(ji  ,jj) + sshb(ji  ,jj+1)                 &
136               &                     + sshb(ji+1,jj) + sshb(ji+1,jj+1) )               
137            sshu_n(ji,jj) = zcoefu * ( e1t(ji  ,jj) * e2t(ji  ,jj) * sshn(ji  ,jj)     &
138               &                     + e1t(ji+1,jj) * e2t(ji+1,jj) * sshn(ji+1,jj) )   
139            sshv_n(ji,jj) = zcoefv * ( e1t(ji,jj  ) * e2t(ji,jj  ) * sshn(ji,jj  )     & 
140               &                     + e1t(ji,jj+1) * e2t(ji,jj+1) * sshn(ji,jj+1) )     
141            sshf_n(ji,jj) = zcoeff * ( sshn(ji  ,jj) + sshn(ji  ,jj+1)                 &
142               &                     + sshn(ji+1,jj) + sshn(ji+1,jj+1) )               
[592]143         END DO
144      END DO
145      ! Boundaries conditions
[1438]146      CALL lbc_lnk( sshu_b, 'U', 1. )   ;   CALL lbc_lnk( sshu_n, 'U', 1. )
147      CALL lbc_lnk( sshv_b, 'V', 1. )   ;   CALL lbc_lnk( sshv_n, 'V', 1. )
148      CALL lbc_lnk( sshf_b, 'F', 1. )   ;   CALL lbc_lnk( sshf_n, 'F', 1. )
149      !
[592]150   END SUBROUTINE dom_vvl
151
152#else
153   !!----------------------------------------------------------------------
154   !!   Default option :                                      Empty routine
155   !!----------------------------------------------------------------------
[1438]156CONTAINS
[592]157   SUBROUTINE dom_vvl
158   END SUBROUTINE dom_vvl
159#endif
160
161   !!======================================================================
162END MODULE domvvl
Note: See TracBrowser for help on using the repository browser.