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 branches/UKMO/dev_r5518_fix_diag_bitcomp/NEMOGCM/NEMO/OPA_SRC/DIA – NEMO

source: branches/UKMO/dev_r5518_fix_diag_bitcomp/NEMOGCM/NEMO/OPA_SRC/DIA/diaprod.F90 @ 9502

Last change on this file since 9502 was 9502, checked in by frrh, 6 years ago

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