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

source: NEMO/branches/UKMO/NEMO_4.0_GO8_package/src/OCE/DIA/diaprod.F90 @ 11110

Last change on this file since 11110 was 11110, checked in by davestorkey, 5 years ago

UKMO/NEMO_4.0_GO8_package branch: Enable product diagnostics uT, vT, wS etc. (as in GO6 package branch).
File size: 8.6 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("urhop") ) 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) = un(ji,jj,jk) * 0.5 * ( zrhop(ji,jj,jk) + zrhop(ji+1,jj,jk) )
171               END DO
172            END DO
173         END DO
174         CALL iom_put( "urhop", z3d )                  ! product of density and zonal velocity at U points
175      ENDIF
176
177      IF( iom_use("vrhop") ) THEN
178         z3d(:,:,:) = 0.e0 
179         DO jk = 1, jpkm1
180            DO jj = 2, jpjm1
181               DO ji = fs_2, fs_jpim1   ! vector opt.
182                  z3d(ji,jj,jk) = vn(ji,jj,jk) * 0.5 * ( zrhop(ji,jj,jk) + zrhop(ji,jj+1,jk) )
183               END DO
184            END DO
185         END DO
186         CALL iom_put( "vrhop", z3d )                  ! product of density and meridional velocity at V points
187      ENDIF
188
189      IF( iom_use("wrhop") ) THEN
190         z3d(:,:,:) = 0.e0 
191         DO jj = 2, jpjm1
192            DO ji = fs_2, fs_jpim1   ! vector opt.
193               z3d(ji,jj,1) = wn(ji,jj,1) * zrhop(ji,jj,1)
194            END DO
195         END DO
196         DO jk = 2, jpkm1
197            DO jj = 2, jpjm1
198               DO ji = fs_2, fs_jpim1   ! vector opt.
199                  z3d(ji,jj,jk) = wn(ji,jj,jk) * 0.5 * ( zrhop(ji,jj,jk-1) + zrhop(ji,jj,jk) )
200               END DO
201            END DO
202         END DO
203         CALL iom_put( "wrhop", z3d )                  ! product of density and vertical velocity at W points
204      ENDIF
205
206      !
207      DEALLOCATE( z2d, z3d, zrhop )
208      !
209      IF( ln_timing )   CALL timing_stop('dia_prod')
210      !
211   END SUBROUTINE dia_prod
212#else
213   !!----------------------------------------------------------------------
214   !!   Default option :                                         NO diaprod
215   !!----------------------------------------------------------------------
216   LOGICAL, PUBLIC, PARAMETER :: lk_diaprod = .FALSE.   ! coupled flag
217CONTAINS
218   SUBROUTINE dia_prod( kt )   ! Empty routine
219      INTEGER ::   kt
220      WRITE(*,*) 'dia_prod: You should not have seen this print! error?', kt
221   END SUBROUTINE dia_prod
222#endif
223   !!======================================================================
224END MODULE diaprod
Note: See TracBrowser for help on using the repository browser.