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.
depth_e3.F90 in trunk/NEMOGCM/NEMO/OPA_SRC/DOM – NEMO

source: trunk/NEMOGCM/NEMO/OPA_SRC/DOM/depth_e3.F90 @ 7753

Last change on this file since 7753 was 7753, checked in by mocavero, 7 years ago

Reverting trunk to remove OpenMP

File size: 7.5 KB
Line 
1MODULE depth_e3
2   !!======================================================================
3   !!                       ***  MODULE  depth_e3  ***
4   !!
5   !! zgr : vertical coordinate system
6   !!======================================================================
7   !! History :  4.0  ! 2016-11  (S. Flavoni, G. Madec)  Original code
8   !!----------------------------------------------------------------------
9
10   !!----------------------------------------------------------------------
11   !!   depth_to_e3   : use the depth of t- and w-points to calculate e3t & e3w
12   !!                   (generic interface for 1D and 3D fields)
13   !!   e3_to_depth   : use e3t & e3w to calculate the depth of t- and w-points
14   !!                   (generic interface for 1D and 3D fields)
15   !!---------------------------------------------------------------------
16   USE oce               ! ocean variables
17   USE dom_oce           ! ocean domain
18   !
19   USE in_out_manager    ! I/O manager
20   USE lbclnk            ! ocean lateral boundary conditions (or mpp link)
21   USE lib_mpp           ! distributed memory computing library
22   USE wrk_nemo          ! Memory allocation
23   USE timing            ! Timing
24
25   IMPLICIT NONE
26   PRIVATE
27 
28   INTERFACE depth_to_e3
29      MODULE PROCEDURE depth_to_e3_1d, depth_to_e3_3d
30   END INTERFACE
31
32   INTERFACE e3_to_depth
33      MODULE PROCEDURE e3_to_depth_1d, e3_to_depth_3d
34   END INTERFACE
35
36   PUBLIC   depth_to_e3        ! called by usrdef_zgr
37   PUBLIC   e3_to_depth        ! called by domzgr.F90
38     
39   !! * Substitutions
40#  include "vectopt_loop_substitute.h90"
41   !!----------------------------------------------------------------------
42   !! NEMO/OPA 4.0 , NEMO Consortium (2016)
43   !! $Id$
44   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
45   !!----------------------------------------------------------------------
46CONTAINS             
47
48   SUBROUTINE depth_to_e3_1d( pdept_1d, pdepw_1d, pe3t_1d, pe3w_1d )
49      !!---------------------------------------------------------------------
50      !!              ***  ROUTINE depth_to_e3_1d  ***
51      !!
52      !! ** Purpose :   compute e3t & e3w scale factors from t- & w-depths of model levels
53      !!
54      !! ** Method  :   The scale factors are given by the discrete derivative
55      !!              of the depth:
56      !!                               e3w(jk) = dk[ dept_1d ]
57      !!                               e3t(jk) = dk[ depw_1d ]
58      !!              with, at top and bottom :
59      !!                      e3w( 1 ) = 2 * ( dept( 1 ) - depw( 1 ) )
60      !!                      e3t(jpk) = 2 * ( dept(jpk) - depw(jpk) )   
61      !!
62      !! ** Action  : - pe3t_1d , pe3w_1d  : scale factors at T- and W-levels (m)
63      !!----------------------------------------------------------------------
64      REAL(wp), DIMENSION(:), INTENT(in   ) ::   pdept_1d, pdepw_1d   ! depths          [m]
65      REAL(wp), DIMENSION(:), INTENT(  out) ::   pe3t_1d , pe3w_1d    ! e3.=dk[depth]   [m]
66      !
67      INTEGER  ::   jk           ! dummy loop indices
68      !!----------------------------------------------------------------------
69      !
70      ! use pdep. at w- and t-points to compute e3. (e3. = dk[depth])
71      !
72      pe3w_1d( 1 ) = 2._wp * ( pdept_1d(1) - pdepw_1d(1) ) 
73      DO jk = 1, jpkm1
74         pe3w_1d(jk+1) = pdept_1d(jk+1) - pdept_1d(jk) 
75         pe3t_1d(jk  ) = pdepw_1d(jk+1) - pdepw_1d(jk) 
76      END DO
77      pe3t_1d(jpk) = 2._wp * ( pdept_1d(jpk) - pdepw_1d(jpk) )
78      !
79   END SUBROUTINE depth_to_e3_1d
80   
81     
82   SUBROUTINE depth_to_e3_3d( pdept_3d, pdepw_3d, pe3t_3d, pe3w_3d )
83      !!---------------------------------------------------------------------
84      !!              ***  ROUTINE depth_to_e3_3d  ***
85      !!
86      !! ** Purpose :   compute e3t & e3w scale factors from t- & w-depths of model levels
87      !!
88      !! ** Method  :   The scale factors are given by the discrete derivative
89      !!              of the depth:
90      !!                               e3w(jk) = dk[ dept_1d ]
91      !!                               e3t(jk) = dk[ depw_1d ]
92      !!              with, at top and bottom :
93      !!                      e3w( 1 ) = 2 * ( dept( 1 ) - depw( 1 ) )
94      !!                      e3t(jpk) = 2 * ( dept(jpk) - depw(jpk) )   
95      !!
96      !! ** Action  : - pe3t_1d , pe3w_1d  : scale factors at T- and W-levels (m)
97      !!----------------------------------------------------------------------
98      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pdept_3d, pdepw_3d   ! depth           [m]
99      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   pe3t_3d , pe3w_3d    ! e3.=dk[depth]   [m]
100      !
101      INTEGER  ::   jk           ! dummy loop indices
102      !!----------------------------------------------------------------------     
103      pe3w_3d(:,:, 1 ) = 2._wp * ( pdept_3d(:,:,1) - pdepw_3d(:,:,1) ) 
104      DO jk = 1, jpkm1
105         pe3w_3d(:,:,jk+1) = pdept_3d(:,:,jk+1) - pdept_3d(:,:,jk) 
106         pe3t_3d(:,:,jk  ) = pdepw_3d(:,:,jk+1) - pdepw_3d(:,:,jk) 
107      END DO
108      pe3t_3d(:,:,jpk) = 2._wp * ( pdept_3d(:,:,jpk) - pdepw_3d(:,:,jpk) )   
109      !
110   END SUBROUTINE depth_to_e3_3d
111
112
113   SUBROUTINE e3_to_depth_1d( pe3t_1d, pe3w_1d, pdept_1d, pdepw_1d )
114      !!---------------------------------------------------------------------
115      !!              ***  ROUTINE e3_to_depth_1d  ***
116      !!
117      !! ** Purpose :   compute t- & w-depths of model levels from e3t & e3w scale factors
118      !!
119      !! ** Method  :   The t- & w-depth are given by the summation of e3w & e3t, resp.
120      !!
121      !! ** Action  : - pe3t_1d, pe3w_1d : scale factor of t- and w-point (m)
122      !!----------------------------------------------------------------------
123      REAL(wp), DIMENSION(:), INTENT(in   ) ::   pe3t_1d , pe3w_1d    ! vert. scale factors   [m]
124      REAL(wp), DIMENSION(:), INTENT(  out) ::   pdept_1d, pdepw_1d   ! depth = SUM( e3 )     [m]
125      !
126      INTEGER  ::   jk           ! dummy loop indices
127      !!----------------------------------------------------------------------
128      !
129      pdepw_1d(1) = 0.0_wp
130      pdept_1d(1) = 0.5_wp * pe3w_1d(1)
131      DO jk = 2, jpk
132         pdepw_1d(jk) = pdepw_1d(jk-1) + pe3t_1d(jk-1) 
133         pdept_1d(jk) = pdept_1d(jk-1) + pe3w_1d(jk  ) 
134      END DO
135      !
136   END SUBROUTINE e3_to_depth_1d
137   
138     
139   SUBROUTINE e3_to_depth_3d( pe3t_3d, pe3w_3d, pdept_3d, pdepw_3d )
140      !!---------------------------------------------------------------------
141      !!              ***  ROUTINE e3_to_depth_3d  ***
142      !!
143      !! ** Purpose :   compute t- & w-depths of model levels from e3t & e3w scale factors
144      !!
145      !! ** Method  :   The t- & w-depth are given by the summation of e3w & e3t, resp.
146      !!
147      !! ** Action  : - pe3t_1d, pe3w_1d : scale factor of t- and w-point (m)
148      !!----------------------------------------------------------------------
149      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pe3t_3d , pe3w_3d    ! vert. scale factors   [m]
150      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   pdept_3d, pdepw_3d   ! depth = SUM( e3 )     [m]
151      !
152      INTEGER  ::   jk           ! dummy loop indices
153      !!----------------------------------------------------------------------     
154      !
155      pdepw_3d(:,:,1) = 0.0_wp
156      pdept_3d(:,:,1) = 0.5_wp * pe3w_3d(:,:,1)
157      DO jk = 2, jpk
158         pdepw_3d(:,:,jk) = pdepw_3d(:,:,jk-1) + pe3t_3d(:,:,jk-1) 
159         pdept_3d(:,:,jk) = pdept_3d(:,:,jk-1) + pe3w_3d(:,:,jk  ) 
160      END DO
161      !
162   END SUBROUTINE e3_to_depth_3d
163
164   !!======================================================================
165END MODULE depth_e3
Note: See TracBrowser for help on using the repository browser.