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.
diaprod.F90 in NEMO/branches/UKMO/NEMO_4.0.1_GO8_package/src/OCE/DIA – NEMO

source: NEMO/branches/UKMO/NEMO_4.0.1_GO8_package/src/OCE/DIA/diaprod.F90 @ 11717

Last change on this file since 11717 was 11717, checked in by davestorkey, 4 years ago

UKMO/NEMO_4.0.1_GO8_package: copy over changes from NEMO_4.0_GO8_package branch.

File size: 10.4 KB
Line 
1MODULE diaprod
2! Requires key_iom_put
3# if defined key_iomput
4   !!======================================================================
5   !!                     ***  MODULE  diaprod  ***
6   !! Ocean diagnostics :  write ocean product diagnostics
7   !!=====================================================================
8   !! History :  3.4  ! 2012  (D. Storkey)  Original code
9   !!            4.0  ! 2019  (D. Storkey)
10   !!----------------------------------------------------------------------
11
12   !!----------------------------------------------------------------------
13   !!   dia_prod      : calculate and write out product diagnostics
14   !!----------------------------------------------------------------------
15   USE oce             ! ocean dynamics and tracers
16   USE dom_oce         ! ocean space and time domain
17   USE domvvl          ! for thickness weighted diagnostics if key_vvl
18   USE eosbn2          ! equation of state  (eos call)
19   USE phycst          ! physical constants
20   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
21   USE in_out_manager  ! I/O manager
22   USE iom
23   USE ioipsl
24   USE lib_mpp         ! MPP library
25   USE timing          ! preformance summary
26
27   IMPLICIT NONE
28   PRIVATE
29
30   PUBLIC   dia_prod                 ! routines called by step.F90
31
32   !! * Substitutions
33#  include "vectopt_loop_substitute.h90"
34   !!----------------------------------------------------------------------
35   !! NEMO/OPA 3.4 , NEMO Consortium (2012)
36   !! $Id$
37   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
38   !!----------------------------------------------------------------------
39CONTAINS
40
41   SUBROUTINE dia_prod( kt )
42      !!---------------------------------------------------------------------
43      !!                  ***  ROUTINE dia_prod  ***
44      !!                   
45      !! ** Purpose :   Write out product diagnostics (uT, vS etc.)
46      !!
47      !! ** Method  :  use iom_put
48      !!               Product diagnostics are not thickness-weighted in this routine.
49      !!               They should be thickness-weighted using XIOS if key_vvl is set.
50      !!----------------------------------------------------------------------
51      !!
52      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
53      !!
54      INTEGER                      ::   ji, jj, jk              ! dummy loop indices
55      REAL(wp)                     ::   zztmp, zztmpx, zztmpy   !
56      !!
57      REAL(wp), POINTER, DIMENSION(:,:)   :: z2d      ! 2D workspace
58      REAL(wp), POINTER, DIMENSION(:,:,:) :: z3d      ! 3D workspace
59      REAL(wp), POINTER, DIMENSION(:,:,:) :: zrhop    ! potential density
60      !!----------------------------------------------------------------------
61      !
62      IF( ln_timing )   CALL timing_start('dia_prod')
63      !
64      ALLOCATE( z2d(jpi,jpj), z3d(jpi,jpj,jpk), zrhop(jpi,jpj,jpk) )
65      !
66
67      IF( iom_use("urhop") .OR. iom_use("vrhop") .OR. iom_use("wrhop") &
68#if ! defined key_diaar5
69     &  .OR. iom_use("rhop") &
70#endif
71     & ) THEN
72         CALL eos( tsn, z3d, zrhop )                 ! now in situ and potential density
73         zrhop(:,:,:) = zrhop(:,:,:)-1000.e0         ! reference potential density to 1000 to avoid precision issues in rhop2 calculation
74         zrhop(:,:,jpk) = 0._wp
75#if ! defined key_diaar5
76         CALL iom_put( 'rhop', zrhop )
77#else
78         ! If key_diaar5 set then there is already an iom_put call to output rhop.
79         ! Really should be a standard diagnostics option?
80#endif
81      ENDIF
82
83      IF( iom_use("ut") ) THEN
84         z3d(:,:,:) = 0.e0 
85         DO jk = 1, jpkm1
86            DO jj = 2, jpjm1
87               DO ji = fs_2, fs_jpim1   ! vector opt.
88                  z3d(ji,jj,jk) = un(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) )
89               END DO
90            END DO
91         END DO
92         CALL iom_put( "ut", z3d )                  ! product of temperature and zonal velocity at U points
93      ENDIF
94
95      IF( iom_use("vt") ) THEN
96         z3d(:,:,:) = 0.e0 
97         DO jk = 1, jpkm1
98            DO jj = 2, jpjm1
99               DO ji = fs_2, fs_jpim1   ! vector opt.
100                  z3d(ji,jj,jk) = vn(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) )
101               END DO
102            END DO
103         END DO
104         CALL iom_put( "vt", z3d )                  ! product of temperature and meridional velocity at V points
105      ENDIF
106
107      IF( iom_use("wt") ) THEN
108         z3d(:,:,:) = 0.e0 
109         DO jj = 2, jpjm1
110            DO ji = fs_2, fs_jpim1   ! vector opt.
111               z3d(ji,jj,1) = wn(ji,jj,1) * tsn(ji,jj,1,jp_tem)
112            END DO
113         END DO
114         DO jk = 2, jpkm1
115            DO jj = 2, jpjm1
116               DO ji = fs_2, fs_jpim1   ! vector opt.
117                  z3d(ji,jj,jk) = wn(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk-1,jp_tem) + tsn(ji,jj,jk,jp_tem) )
118               END DO
119            END DO
120         END DO
121         CALL iom_put( "wt", z3d )                  ! product of temperature and vertical velocity at W points
122      ENDIF
123
124      IF( iom_use("us") ) THEN
125         z3d(:,:,:) = 0.e0 
126         DO jk = 1, jpkm1
127            DO jj = 2, jpjm1
128               DO ji = fs_2, fs_jpim1   ! vector opt.
129                  z3d(ji,jj,jk) = un(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) )
130               END DO
131            END DO
132         END DO
133         CALL iom_put( "us", z3d )                  ! product of salinity and zonal velocity at U points
134      ENDIF
135
136      IF( iom_use("vs") ) THEN
137         z3d(:,:,:) = 0.e0 
138         DO jk = 1, jpkm1
139            DO jj = 2, jpjm1
140               DO ji = fs_2, fs_jpim1   ! vector opt.
141                  z3d(ji,jj,jk) = vn(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj+1,jk,jp_sal) )
142               END DO
143            END DO
144         END DO
145         CALL iom_put( "vs", z3d )                  ! product of salinity and meridional velocity at V points
146      ENDIF
147
148      IF( iom_use("ws") ) THEN
149         z3d(:,:,:) = 0.e0 
150         DO jj = 2, jpjm1
151            DO ji = fs_2, fs_jpim1   ! vector opt.
152               z3d(ji,jj,1) = wn(ji,jj,1) * tsn(ji,jj,1,jp_sal)
153            END DO
154         END DO
155         DO jk = 2, jpkm1
156            DO jj = 2, jpjm1
157               DO ji = fs_2, fs_jpim1   ! vector opt.
158                  z3d(ji,jj,jk) = wn(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk-1,jp_sal) + tsn(ji,jj,jk,jp_sal) )
159               END DO
160            END DO
161         END DO
162         CALL iom_put( "ws", z3d )                  ! product of salinity and vertical velocity at W points
163      ENDIF
164
165      IF( iom_use("uv") ) THEN
166         z3d(:,:,:) = 0.e0 
167         DO jk = 1, jpkm1
168            DO jj = 2, jpjm1
169               DO ji = fs_2, fs_jpim1   ! vector opt.
170                  z3d(ji,jj,jk) = 0.25 * ( un(ji-1,jj,jk) + un(ji,jj,jk) ) * ( vn(ji,jj-1,jk) + vn(ji,jj,jk) ) 
171               END DO
172            END DO
173         END DO
174         CALL iom_put( "uv", z3d )                  ! product of zonal velocity and meridional velocity at T points
175      ENDIF
176
177      IF( iom_use("uw") ) THEN
178         z3d(:,:,:) = 0.e0 
179         DO jj = 2, jpjm1
180            DO ji = fs_2, fs_jpim1   ! vector opt.
181               z3d(ji,jj,1) = 0.5 * ( wn(ji,jj,1) + wn(ji+1,jj,1) ) * un(ji,jj,1) 
182            END DO
183         END DO
184         DO jk = 2, jpkm1
185            DO jj = 2, jpjm1
186               DO ji = fs_2, fs_jpim1   ! vector opt.
187                  z3d(ji,jj,jk) = 0.25 * ( wn(ji,jj,jk) + wn(ji+1,jj,jk) ) * ( un(ji,jj,jk-1) + un(ji,jj,jk) ) 
188               END DO
189            END DO
190         END DO
191         CALL iom_put( "uw", z3d )                  ! product of zonal velocity and vertical velocity at UW points
192      ENDIF
193
194      IF( iom_use("vw") ) THEN
195         z3d(:,:,:) = 0.e0 
196         DO jj = 2, jpjm1
197            DO ji = fs_2, fs_jpim1   ! vector opt.
198               z3d(ji,jj,1) = 0.5 * ( wn(ji,jj,1) + wn(ji,jj+1,1) ) * vn(ji,jj,1) 
199            END DO
200         END DO
201         DO jk = 2, jpkm1
202            DO jj = 2, jpjm1
203               DO ji = fs_2, fs_jpim1   ! vector opt.
204                  z3d(ji,jj,jk) = 0.25 * ( wn(ji,jj,jk) + wn(ji,jj+1,jk) ) * ( vn(ji,jj,jk-1) + vn(ji,jj,jk) ) 
205               END DO
206            END DO
207         END DO
208         CALL iom_put( "vw", z3d )                  ! product of meriodional velocity and vertical velocity at VW points
209      ENDIF
210
211      IF( iom_use("urhop") ) THEN
212         z3d(:,:,:) = 0.e0 
213         DO jk = 1, jpkm1
214            DO jj = 2, jpjm1
215               DO ji = fs_2, fs_jpim1   ! vector opt.
216                  z3d(ji,jj,jk) = un(ji,jj,jk) * 0.5 * ( zrhop(ji,jj,jk) + zrhop(ji+1,jj,jk) )
217               END DO
218            END DO
219         END DO
220         CALL iom_put( "urhop", z3d )                  ! product of density and zonal velocity at U points
221      ENDIF
222
223      IF( iom_use("vrhop") ) THEN
224         z3d(:,:,:) = 0.e0 
225         DO jk = 1, jpkm1
226            DO jj = 2, jpjm1
227               DO ji = fs_2, fs_jpim1   ! vector opt.
228                  z3d(ji,jj,jk) = vn(ji,jj,jk) * 0.5 * ( zrhop(ji,jj,jk) + zrhop(ji,jj+1,jk) )
229               END DO
230            END DO
231         END DO
232         CALL iom_put( "vrhop", z3d )                  ! product of density and meridional velocity at V points
233      ENDIF
234
235      IF( iom_use("wrhop") ) THEN
236         z3d(:,:,:) = 0.e0 
237         DO jj = 2, jpjm1
238            DO ji = fs_2, fs_jpim1   ! vector opt.
239               z3d(ji,jj,1) = wn(ji,jj,1) * zrhop(ji,jj,1)
240            END DO
241         END DO
242         DO jk = 2, jpkm1
243            DO jj = 2, jpjm1
244               DO ji = fs_2, fs_jpim1   ! vector opt.
245                  z3d(ji,jj,jk) = wn(ji,jj,jk) * 0.5 * ( zrhop(ji,jj,jk-1) + zrhop(ji,jj,jk) )
246               END DO
247            END DO
248         END DO
249         CALL iom_put( "wrhop", z3d )                  ! product of density and vertical velocity at W points
250      ENDIF
251
252      !
253      DEALLOCATE( z2d, z3d, zrhop )
254      !
255      IF( ln_timing )   CALL timing_stop('dia_prod')
256      !
257   END SUBROUTINE dia_prod
258#else
259   !!----------------------------------------------------------------------
260   !!   Default option :                                         NO diaprod
261   !!----------------------------------------------------------------------
262   LOGICAL, PUBLIC, PARAMETER :: lk_diaprod = .FALSE.   ! coupled flag
263CONTAINS
264   SUBROUTINE dia_prod( kt )   ! Empty routine
265      INTEGER ::   kt
266      WRITE(*,*) 'dia_prod: You should not have seen this print! error?', kt
267   END SUBROUTINE dia_prod
268#endif
269   !!======================================================================
270END MODULE diaprod
Note: See TracBrowser for help on using the repository browser.