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.3_GO8_package/src/OCE/DIA – NEMO

source: NEMO/branches/UKMO/NEMO_4.0.3_GO8_package/src/OCE/DIA/diaprod.F90 @ 15695

Last change on this file since 15695 was 15695, checked in by davestorkey, 2 years ago

Fix duplicate iom_put calls for rhop.
File size: 10.1 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") ) THEN
68         CALL eos( tsn, z3d, zrhop )                 ! now in situ and potential density
69         zrhop(:,:,:) = zrhop(:,:,:)-1000.e0         ! reference potential density to 1000 to avoid precision issues in rhop2 calculation
70         zrhop(:,:,jpk) = 0._wp
71      ENDIF
72
73      IF( iom_use("ut") ) THEN
74         z3d(:,:,:) = 0.e0 
75         DO jk = 1, jpkm1
76            DO jj = 2, jpjm1
77               DO ji = fs_2, fs_jpim1   ! vector opt.
78                  z3d(ji,jj,jk) = un(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) )
79               END DO
80            END DO
81         END DO
82         CALL iom_put( "ut", z3d )                  ! product of temperature and zonal velocity at U points
83      ENDIF
84
85      IF( iom_use("vt") ) THEN
86         z3d(:,:,:) = 0.e0 
87         DO jk = 1, jpkm1
88            DO jj = 2, jpjm1
89               DO ji = fs_2, fs_jpim1   ! vector opt.
90                  z3d(ji,jj,jk) = vn(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) )
91               END DO
92            END DO
93         END DO
94         CALL iom_put( "vt", z3d )                  ! product of temperature and meridional velocity at V points
95      ENDIF
96
97      IF( iom_use("wt") ) THEN
98         z3d(:,:,:) = 0.e0 
99         DO jj = 2, jpjm1
100            DO ji = fs_2, fs_jpim1   ! vector opt.
101               z3d(ji,jj,1) = wn(ji,jj,1) * tsn(ji,jj,1,jp_tem)
102            END DO
103         END DO
104         DO jk = 2, jpkm1
105            DO jj = 2, jpjm1
106               DO ji = fs_2, fs_jpim1   ! vector opt.
107                  z3d(ji,jj,jk) = wn(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk-1,jp_tem) + tsn(ji,jj,jk,jp_tem) )
108               END DO
109            END DO
110         END DO
111         CALL iom_put( "wt", z3d )                  ! product of temperature and vertical velocity at W points
112      ENDIF
113
114      IF( iom_use("us") ) THEN
115         z3d(:,:,:) = 0.e0 
116         DO jk = 1, jpkm1
117            DO jj = 2, jpjm1
118               DO ji = fs_2, fs_jpim1   ! vector opt.
119                  z3d(ji,jj,jk) = un(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) )
120               END DO
121            END DO
122         END DO
123         CALL iom_put( "us", z3d )                  ! product of salinity and zonal velocity at U points
124      ENDIF
125
126      IF( iom_use("vs") ) THEN
127         z3d(:,:,:) = 0.e0 
128         DO jk = 1, jpkm1
129            DO jj = 2, jpjm1
130               DO ji = fs_2, fs_jpim1   ! vector opt.
131                  z3d(ji,jj,jk) = vn(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj+1,jk,jp_sal) )
132               END DO
133            END DO
134         END DO
135         CALL iom_put( "vs", z3d )                  ! product of salinity and meridional velocity at V points
136      ENDIF
137
138      IF( iom_use("ws") ) THEN
139         z3d(:,:,:) = 0.e0 
140         DO jj = 2, jpjm1
141            DO ji = fs_2, fs_jpim1   ! vector opt.
142               z3d(ji,jj,1) = wn(ji,jj,1) * tsn(ji,jj,1,jp_sal)
143            END DO
144         END DO
145         DO jk = 2, jpkm1
146            DO jj = 2, jpjm1
147               DO ji = fs_2, fs_jpim1   ! vector opt.
148                  z3d(ji,jj,jk) = wn(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk-1,jp_sal) + tsn(ji,jj,jk,jp_sal) )
149               END DO
150            END DO
151         END DO
152         CALL iom_put( "ws", z3d )                  ! product of salinity and vertical velocity at W points
153      ENDIF
154
155      IF( iom_use("uv") ) THEN
156         z3d(:,:,:) = 0.e0 
157         DO jk = 1, jpkm1
158            DO jj = 2, jpjm1
159               DO ji = fs_2, fs_jpim1   ! vector opt.
160                  z3d(ji,jj,jk) = 0.25 * ( un(ji-1,jj,jk) + un(ji,jj,jk) ) * ( vn(ji,jj-1,jk) + vn(ji,jj,jk) ) 
161               END DO
162            END DO
163         END DO
164         CALL iom_put( "uv", z3d )                  ! product of zonal velocity and meridional velocity at T points
165      ENDIF
166
167      IF( iom_use("uw") ) THEN
168         z3d(:,:,:) = 0.e0 
169         DO jj = 2, jpjm1
170            DO ji = fs_2, fs_jpim1   ! vector opt.
171               z3d(ji,jj,1) = 0.5 * ( wn(ji,jj,1) + wn(ji+1,jj,1) ) * un(ji,jj,1) 
172            END DO
173         END DO
174         DO jk = 2, jpkm1
175            DO jj = 2, jpjm1
176               DO ji = fs_2, fs_jpim1   ! vector opt.
177                  z3d(ji,jj,jk) = 0.25 * ( wn(ji,jj,jk) + wn(ji+1,jj,jk) ) * ( un(ji,jj,jk-1) + un(ji,jj,jk) ) 
178               END DO
179            END DO
180         END DO
181         CALL iom_put( "uw", z3d )                  ! product of zonal velocity and vertical velocity at UW points
182      ENDIF
183
184      IF( iom_use("vw") ) THEN
185         z3d(:,:,:) = 0.e0 
186         DO jj = 2, jpjm1
187            DO ji = fs_2, fs_jpim1   ! vector opt.
188               z3d(ji,jj,1) = 0.5 * ( wn(ji,jj,1) + wn(ji,jj+1,1) ) * vn(ji,jj,1) 
189            END DO
190         END DO
191         DO jk = 2, jpkm1
192            DO jj = 2, jpjm1
193               DO ji = fs_2, fs_jpim1   ! vector opt.
194                  z3d(ji,jj,jk) = 0.25 * ( wn(ji,jj,jk) + wn(ji,jj+1,jk) ) * ( vn(ji,jj,jk-1) + vn(ji,jj,jk) ) 
195               END DO
196            END DO
197         END DO
198         CALL iom_put( "vw", z3d )                  ! product of meriodional velocity and vertical velocity at VW points
199      ENDIF
200
201      IF( iom_use("urhop") ) THEN
202         z3d(:,:,:) = 0.e0 
203         DO jk = 1, jpkm1
204            DO jj = 2, jpjm1
205               DO ji = fs_2, fs_jpim1   ! vector opt.
206                  z3d(ji,jj,jk) = un(ji,jj,jk) * 0.5 * ( zrhop(ji,jj,jk) + zrhop(ji+1,jj,jk) )
207               END DO
208            END DO
209         END DO
210         CALL iom_put( "urhop", z3d )                  ! product of density and zonal velocity at U points
211      ENDIF
212
213      IF( iom_use("vrhop") ) THEN
214         z3d(:,:,:) = 0.e0 
215         DO jk = 1, jpkm1
216            DO jj = 2, jpjm1
217               DO ji = fs_2, fs_jpim1   ! vector opt.
218                  z3d(ji,jj,jk) = vn(ji,jj,jk) * 0.5 * ( zrhop(ji,jj,jk) + zrhop(ji,jj+1,jk) )
219               END DO
220            END DO
221         END DO
222         CALL iom_put( "vrhop", z3d )                  ! product of density and meridional velocity at V points
223      ENDIF
224
225      IF( iom_use("wrhop") ) THEN
226         z3d(:,:,:) = 0.e0 
227         DO jj = 2, jpjm1
228            DO ji = fs_2, fs_jpim1   ! vector opt.
229               z3d(ji,jj,1) = wn(ji,jj,1) * zrhop(ji,jj,1)
230            END DO
231         END DO
232         DO jk = 2, jpkm1
233            DO jj = 2, jpjm1
234               DO ji = fs_2, fs_jpim1   ! vector opt.
235                  z3d(ji,jj,jk) = wn(ji,jj,jk) * 0.5 * ( zrhop(ji,jj,jk-1) + zrhop(ji,jj,jk) )
236               END DO
237            END DO
238         END DO
239         CALL iom_put( "wrhop", z3d )                  ! product of density and vertical velocity at W points
240      ENDIF
241
242      !
243      DEALLOCATE( z2d, z3d, zrhop )
244      !
245      IF( ln_timing )   CALL timing_stop('dia_prod')
246      !
247   END SUBROUTINE dia_prod
248#else
249   !!----------------------------------------------------------------------
250   !!   Default option :                                         NO diaprod
251   !!----------------------------------------------------------------------
252   LOGICAL, PUBLIC, PARAMETER :: lk_diaprod = .FALSE.   ! coupled flag
253CONTAINS
254   SUBROUTINE dia_prod( kt )   ! Empty routine
255      INTEGER ::   kt
256      WRITE(*,*) 'dia_prod: You should not have seen this print! error?', kt
257   END SUBROUTINE dia_prod
258#endif
259   !!======================================================================
260END MODULE diaprod
Note: See TracBrowser for help on using the repository browser.