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_crs.F90 in branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM – NEMO

source: branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl_crs.F90 @ 6772

Last change on this file since 6772 was 6772, checked in by cbricaud, 8 years ago

clean in coarsening branch
File size: 7.0 KB
Line 
1MODULE domvvl_crs
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   !!            3.3  !  2011-10  (M. Leclair) totally rewrote domvvl:
9   !!                                          vvl option includes z_star and z_tilde coordinates
10   !!----------------------------------------------------------------------
11   !!   'key_vvl'                              variable volume
12   !!----------------------------------------------------------------------
13   !!----------------------------------------------------------------------
14   !!   dom_vvl_init     : define initial vertical scale factors, depths and column thickness
15   !!   dom_vvl_sf_nxt   : Compute next vertical scale factors
16   !!   dom_vvl_sf_swp   : Swap vertical scale factors and update the vertical grid
17   !!   dom_vvl_interpol : Interpolate vertical scale factors from one grid point to another
18   !!   dom_vvl_rst      : read/write restart file
19   !!   dom_vvl_ctl      : Check the vvl options
20   !!   dom_vvl_orca_fix : Recompute some area-weighted interpolations of vertical scale factors
21   !!                    : to account for manual changes to e[1,2][u,v] in some Straits
22   !!----------------------------------------------------------------------
23   !! * Modules used
24!   USE oce             ! ocean dynamics and tracers
25   USE crs             ! ocean space and time domain
26   USE sbc_oce         ! ocean surface boundary condition
27   USE in_out_manager  ! I/O manager
28   USE iom             ! I/O manager library
29   USE restart         ! ocean restart
30   USE lib_mpp         ! distributed memory computing library
31   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
32   USE wrk_nemo        ! Memory allocation
33   USE timing          ! Timing
34   USE crslbclnk
35
36   IMPLICIT NONE
37   PRIVATE
38
39   !! * Routine accessibility
40   PUBLIC  dom_vvl_interpol_crs   ! called by dynnxt.F90
41
42   !                                                                                            ! conservation: not used yet
43
44   !! * Module variables
45!#  include "domzgr_substitute.h90"
46!#  include "vectopt_loop_substitute.h90"
47   !!----------------------------------------------------------------------
48   !! NEMO/OPA 3.3 , NEMO-Consortium (2010)
49   !! $Id: domvvl.F90 4998 2014-12-22 16:16:45Z mocavero $
50   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
51   !!----------------------------------------------------------------------
52
53CONTAINS
54
55   SUBROUTINE dom_vvl_interpol_crs( pe3_in, pe3_out, pout )
56      !!---------------------------------------------------------------------
57      !!                  ***  ROUTINE dom_vvl__interpol  ***
58      !!
59      !! ** Purpose :   interpolate scale factors from one grid point to another
60      !!
61      !! ** Method  :   e3_out = e3_0 + interpolation(e3_in - e3_0)
62      !!                - horizontal interpolation: grid cell surface averaging
63      !!                - vertical interpolation: simple averaging
64      !!----------------------------------------------------------------------
65      !! * Arguments
66      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT( in    ) ::  pe3_in     ! input e3 to be interpolated
67      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT( inout ) ::  pe3_out    ! output interpolated e3
68      CHARACTER(LEN=*), INTENT( in )                    ::  pout       ! grid point of out scale factors
69      !                                                                !   =  'U', 'V', 'W, 'F', 'UW' or 'VW'
70      !! * Local declarations
71      INTEGER ::   ji, jj, jk                                          ! dummy loop indices
72      REAL(wp)::   zz 
73      !!----------------------------------------------------------------------
74      IF( nn_timing == 1 )  CALL timing_start('dom_vvl_interpol')
75         !
76      SELECT CASE ( pout )
77         !               ! ------------------------------------- !
78      CASE( 'U' )        ! interpolation from T-point to U-point !
79         !               ! ------------------------------------- !
80         ! horizontal surface weighted interpolation
81         DO jk = 1, jpk
82            DO jj = 1, jpj_crs-1
83               DO ji = 1, jpi_crs-1   ! vector opt.
84                  zz=1._wp/(e1u_crs(ji,jj)*e2u_crs(ji,jj))
85                  pe3_out(ji,jj,jk) = 0.5_wp * umask_crs(ji,jj,jk) * zz                                           &
86                     &                       * (   e1t_crs(ji  ,jj) * e2t_crs(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0_crs(ji  ,jj,jk) )     &
87                     &                           + e1t_crs(ji+1,jj) * e2t_crs(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0_crs(ji+1,jj,jk) ) )
88               END DO
89            END DO
90         END DO
91         !
92         ! boundary conditions
93         CALL crs_lbc_lnk( pe3_out(:,:,:), 'U', 1._wp )
94         pe3_out(:,:,:) = pe3_out(:,:,:) + e3u_0_crs(:,:,:)
95         !               ! ------------------------------------- !
96      CASE( 'V' )        ! interpolation from T-point to V-point !
97         !               ! ------------------------------------- !
98         ! horizontal surface weighted interpolation
99         DO jk = 1, jpk
100            DO jj = 1, jpj_crs
101               DO ji = 1, jpi_crs   ! vector opt.
102                  zz=1._wp/(e1v_crs(ji,jj)*e2v_crs(ji,jj))
103                  pe3_out(ji,jj,jk) = 0.5_wp * vmask_crs(ji,jj,jk) * zz                                               &
104                     &                       * (   e1t_crs(ji,jj  ) * e2t_crs(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) )     &
105                     &                           + e1t_crs(ji,jj+1) * e2t_crs(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) )
106               END DO
107            END DO
108         END DO
109         !
110         ! boundary conditions
111         CALL crs_lbc_lnk( pe3_out(:,:,:), 'V', 1._wp )
112         pe3_out(:,:,:) = pe3_out(:,:,:) + e3v_0_crs(:,:,:)
113         !               ! ------------------------------------- !
114      CASE( 'W' )        ! interpolation from T-point to W-point !
115         !               ! ------------------------------------- !
116         ! vertical simple interpolation
117         pe3_out(:,:,1) = e3w_0_crs(:,:,1) + pe3_in(:,:,1) - e3t_0_crs(:,:,1)
118         ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing
119         DO jk = 2, jpk
120            pe3_out(:,:,jk) = e3w_0_crs(:,:,jk) + ( 1.0_wp - 0.5_wp * tmask_crs(:,:,jk) ) * ( pe3_in(:,:,jk-1) - e3t_0_crs(:,:,jk-1) )   &
121               &                                +            0.5_wp * tmask_crs(:,:,jk)   * ( pe3_in(:,:,jk  ) - e3t_0_crs(:,:,jk  ) )
122         END DO
123      END SELECT
124      !
125
126      IF( nn_timing == 1 )  CALL timing_stop('dom_vvl_interpol')
127
128   END SUBROUTINE dom_vvl_interpol_crs
129
130
131   !!======================================================================
132END MODULE domvvl_crs
133
134
135
Note: See TracBrowser for help on using the repository browser.