source: branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/DIA/diaprod.F90 @ 7993

Last change on this file since 7993 was 7993, checked in by frrh, 3 years ago

Merge in missing revisions 6428:2477 inclusive and 6482 from nemo_v3_6_STABLE
branch. In ptic, this includes the fix for restartability of runoff fields in coupled
models. Evolution of coupled models will therefor be affected.

These changes donot affect evolution of the current stand-alone NEMO-CICE GO6
standard configuration.

Work and testing documented in Met Office GMED ticket 320.

File size: 9.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   !!----------------------------------------------------------------------
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 iom_put( "ut", z3d )                  ! product of temperature and zonal velocity at U points
99      ENDIF
100
101      IF( iom_use("vt") .OR. iom_use("sopht_vt") ) THEN
102         z3d(:,:,:) = 0.e0 
103         DO jk = 1, jpkm1
104            DO jj = 2, jpjm1
105               DO ji = fs_2, fs_jpim1   ! vector opt.
106                  z3d(ji,jj,jk) = vn(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) )
107               END DO
108            END DO
109         END DO
110         CALL iom_put( "vt", z3d )                  ! product of temperature and meridional velocity at V points
111         DO jk = 1, jpkm1
112            DO jj = 2, jpjm1
113               DO ji = fs_2, fs_jpim1   ! vector opt.
114                  z3d(ji,jj,jk) = z3d(ji,jj,jk) * fse3v(ji,jj,jk) * e1v(ji,jj)
115               END DO
116            END DO
117         END DO
118         IF(ln_diaptr) CALL dia_ptr_ohst_components( jp_tem, 'vts', z3d)
119      ENDIF
120
121      IF( iom_use("wt") ) THEN
122         z3d(:,:,:) = 0.e0 
123         DO jj = 2, jpjm1
124            DO ji = fs_2, fs_jpim1   ! vector opt.
125               z3d(ji,jj,1) = wn(ji,jj,1) * tsn(ji,jj,1,jp_tem)
126            END DO
127         END DO
128         DO jk = 2, jpkm1
129            DO jj = 2, jpjm1
130               DO ji = fs_2, fs_jpim1   ! vector opt.
131                  z3d(ji,jj,jk) = wn(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk-1,jp_tem) + tsn(ji,jj,jk,jp_tem) )
132               END DO
133            END DO
134         END DO
135         CALL iom_put( "wt", z3d )                  ! product of temperature and vertical velocity at W points
136      ENDIF
137
138      IF( iom_use("us") ) THEN
139         z3d(:,:,:) = 0.e0 
140         DO jk = 1, jpkm1
141            DO jj = 2, jpjm1
142               DO ji = fs_2, fs_jpim1   ! vector opt.
143                  z3d(ji,jj,jk) = un(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) )
144               END DO
145            END DO
146         END DO
147         CALL iom_put( "us", z3d )                  ! product of salinity and zonal velocity at U points
148      ENDIF
149
150      IF( iom_use("vs") .OR. iom_use("sopst_vs") ) THEN
151         z3d(:,:,:) = 0.e0 
152         DO jk = 1, jpkm1
153            DO jj = 2, jpjm1
154               DO ji = fs_2, fs_jpim1   ! vector opt.
155                  z3d(ji,jj,jk) = vn(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj+1,jk,jp_sal) )
156               END DO
157            END DO
158         END DO
159         CALL iom_put( "vs", z3d )                  ! product of salinity and meridional velocity at V points
160         DO jk = 1, jpkm1
161            DO jj = 2, jpjm1
162               DO ji = fs_2, fs_jpim1   ! vector opt.
163                  z3d(ji,jj,jk) = z3d(ji,jj,jk) * fse3v(ji,jj,jk) * e1v(ji,jj)
164               END DO
165            END DO
166         END DO
167         IF(ln_diaptr) CALL dia_ptr_ohst_components( jp_sal, 'vts', z3d)
168      ENDIF
169
170      IF( iom_use("ws") ) THEN
171         z3d(:,:,:) = 0.e0 
172         DO jj = 2, jpjm1
173            DO ji = fs_2, fs_jpim1   ! vector opt.
174               z3d(ji,jj,1) = wn(ji,jj,1) * tsn(ji,jj,1,jp_sal)
175            END DO
176         END DO
177         DO jk = 2, jpkm1
178            DO jj = 2, jpjm1
179               DO ji = fs_2, fs_jpim1   ! vector opt.
180                  z3d(ji,jj,jk) = wn(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk-1,jp_sal) + tsn(ji,jj,jk,jp_sal) )
181               END DO
182            END DO
183         END DO
184         CALL iom_put( "ws", z3d )                  ! product of salinity and vertical velocity at W points
185      ENDIF
186
187      IF( iom_use("urhop") ) THEN
188         z3d(:,:,:) = 0.e0 
189         DO jk = 1, jpkm1
190            DO jj = 2, jpjm1
191               DO ji = fs_2, fs_jpim1   ! vector opt.
192                  z3d(ji,jj,jk) = un(ji,jj,jk) * 0.5 * ( zrhop(ji,jj,jk) + zrhop(ji+1,jj,jk) )
193               END DO
194            END DO
195         END DO
196         CALL iom_put( "urhop", z3d )                  ! product of density and zonal velocity at U points
197      ENDIF
198
199      IF( iom_use("vrhop") ) THEN
200         z3d(:,:,:) = 0.e0 
201         DO jk = 1, jpkm1
202            DO jj = 2, jpjm1
203               DO ji = fs_2, fs_jpim1   ! vector opt.
204                  z3d(ji,jj,jk) = vn(ji,jj,jk) * 0.5 * ( zrhop(ji,jj,jk) + zrhop(ji,jj+1,jk) )
205               END DO
206            END DO
207         END DO
208         CALL iom_put( "vrhop", z3d )                  ! product of density and meridional velocity at V points
209      ENDIF
210
211      IF( iom_use("wrhop") ) THEN
212         z3d(:,:,:) = 0.e0 
213         DO jj = 2, jpjm1
214            DO ji = fs_2, fs_jpim1   ! vector opt.
215               z3d(ji,jj,1) = wn(ji,jj,1) * zrhop(ji,jj,1)
216            END DO
217         END DO
218         DO jk = 2, jpkm1
219            DO jj = 2, jpjm1
220               DO ji = fs_2, fs_jpim1   ! vector opt.
221                  z3d(ji,jj,jk) = wn(ji,jj,jk) * 0.5 * ( zrhop(ji,jj,jk-1) + zrhop(ji,jj,jk) )
222               END DO
223            END DO
224         END DO
225         CALL iom_put( "wrhop", z3d )                  ! product of density and vertical velocity at W points
226      ENDIF
227
228      !
229      CALL wrk_dealloc( jpi , jpj      , z2d )
230      CALL wrk_dealloc( jpi , jpj, jpk , z3d )
231      CALL wrk_dealloc( jpi , jpj, jpk , zrhop )
232      !
233      IF( nn_timing == 1 )   CALL timing_stop('dia_prod')
234      !
235   END SUBROUTINE dia_prod
236#else
237   !!----------------------------------------------------------------------
238   !!   Default option :                                         NO diaprod
239   !!----------------------------------------------------------------------
240   LOGICAL, PUBLIC, PARAMETER :: lk_diaprod = .FALSE.   ! coupled flag
241CONTAINS
242   SUBROUTINE dia_prod( kt )   ! Empty routine
243      INTEGER ::   kt
244      WRITE(*,*) 'dia_prod: You should not have seen this print! error?', kt
245   END SUBROUTINE dia_prod
246#endif
247   !!======================================================================
248END MODULE diaprod
Note: See TracBrowser for help on using the repository browser.