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_GO6_package/NEMOGCM/NEMO/OPA_SRC/DIA – NEMO

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

Last change on this file since 6491 was 6491, checked in by davestorkey, 8 years ago

Commit remaining changes to UKMO/r5518_GO6_package branch from following branches:
UKMO/dev_r5021_nn_etau_revision@6238
UKMO/dev_r5107_mld_zint@5534
UKMO/dev_r5107_eorca025_closea@6390
UKMO/restart_datestamp@5539
UKMO/icebergs_latent_heat@5821
UKMO/icebergs_restart_single_file_corrected@6480
UKMO/product_diagnostics@5971
UKMO/antarctic_partial_slip@5961
Custom merge into /branches/UKMO/dev_r5518_GO6_package/NEMOGCM: r5961 cf. r5958 of /branches/UKMO/antarctic_partial_slip/NEMOGCM@6490

Custom merge into /branches/UKMO/dev_r5518_GO6_package/NEMOGCM: r6349 cf. r5962 of /branches/UKMO/product_diagnostics/NEMOGCM@6490

Custom merge into /branches/UKMO/dev_r5518_GO6_package/NEMOGCM: r6480 cf. r6479 of /branches/UKMO/icebergs_restart_single_file_corrected/NEMOGCM@6490

Custom merge into /branches/UKMO/dev_r5518_GO6_package/NEMOGCM: r5986 cf. r5852 of /branches/UKMO/icebergs_restart_single_file/NEMOGCM@6490

Custom merge into /branches/UKMO/dev_r5518_GO6_package/NEMOGCM: r5821 cf. r5808 of /branches/UKMO/icebergs_latent_heat/NEMOGCM@6490
File size: 9.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
28   IMPLICIT NONE
29   PRIVATE
30
31   PUBLIC   dia_prod                 ! routines called by step.F90
32
33   !! * Substitutions
34#  include "zdfddm_substitute.h90"
35#  include "domzgr_substitute.h90"
36#  include "vectopt_loop_substitute.h90"
37   !!----------------------------------------------------------------------
38   !! NEMO/OPA 3.4 , NEMO Consortium (2012)
39   !! $Id $
40   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
41   !!----------------------------------------------------------------------
42CONTAINS
43
44   SUBROUTINE dia_prod( kt )
45      !!---------------------------------------------------------------------
46      !!                  ***  ROUTINE dia_prod  ***
47      !!                   
48      !! ** Purpose :   Write out product diagnostics (uT, vS etc.)
49      !!
50      !! ** Method  :  use iom_put
51      !!               Product diagnostics are not thickness-weighted in this routine.
52      !!               They should be thickness-weighted using XIOS if key_vvl is set.
53      !!----------------------------------------------------------------------
54      !!
55      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
56      !!
57      INTEGER                      ::   ji, jj, jk              ! dummy loop indices
58      REAL(wp)                     ::   zztmp, zztmpx, zztmpy   !
59      !!
60      REAL(wp), POINTER, DIMENSION(:,:)   :: z2d      ! 2D workspace
61      REAL(wp), POINTER, DIMENSION(:,:,:) :: z3d      ! 3D workspace
62      REAL(wp), POINTER, DIMENSION(:,:,:) :: zrhop    ! potential density
63      !!----------------------------------------------------------------------
64      !
65      IF( nn_timing == 1 )   CALL timing_start('dia_prod')
66      !
67      CALL wrk_alloc( jpi , jpj      , z2d )
68      CALL wrk_alloc( jpi , jpj, jpk , z3d )
69      CALL wrk_alloc( jpi , jpj, jpk , zrhop )
70      !
71
72      IF( iom_use("urhop") .OR. iom_use("vrhop") .OR. iom_use("wrhop") &
73#if ! defined key_diaar5
74     &  .OR. iom_use("rhop") &
75#endif
76     & ) THEN
77         CALL eos( tsn, z3d, zrhop )                 ! now in situ and potential density
78         zrhop(:,:,:) = zrhop(:,:,:)-1000.e0         ! reference potential density to 1000 to avoid precision issues in rhop2 calculation
79         zrhop(:,:,jpk) = 0._wp
80#if ! defined key_diaar5
81         CALL iom_put( 'rhop', zrhop )
82#else
83         ! If key_diaar5 set then there is already an iom_put call to output rhop.
84         ! Really should be a standard diagnostics option?
85#endif
86      ENDIF
87
88      IF( iom_use("ut") ) THEN
89         z3d(:,:,:) = 0.e0 
90         DO jk = 1, jpkm1
91            DO jj = 2, jpjm1
92               DO ji = fs_2, fs_jpim1   ! vector opt.
93                  z3d(ji,jj,jk) = un(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) )
94               END DO
95            END DO
96         END DO
97         CALL iom_put( "ut", z3d )                  ! product of temperature and zonal velocity at U points
98      ENDIF
99
100      IF( iom_use("vt") ) THEN
101         z3d(:,:,:) = 0.e0 
102         DO jk = 1, jpkm1
103            DO jj = 2, jpjm1
104               DO ji = fs_2, fs_jpim1   ! vector opt.
105                  z3d(ji,jj,jk) = vn(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) )
106               END DO
107            END DO
108         END DO
109         CALL iom_put( "vt", z3d )                  ! product of temperature and meridional velocity at V points
110      ENDIF
111
112      IF( iom_use("wt") ) THEN
113         z3d(:,:,:) = 0.e0 
114         DO jj = 2, jpjm1
115            DO ji = fs_2, fs_jpim1   ! vector opt.
116               z3d(ji,jj,1) = wn(ji,jj,1) * tsn(ji,jj,1,jp_tem)
117            END DO
118         END DO
119         DO jk = 2, jpkm1
120            DO jj = 2, jpjm1
121               DO ji = fs_2, fs_jpim1   ! vector opt.
122                  z3d(ji,jj,jk) = wn(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk-1,jp_tem) + tsn(ji,jj,jk,jp_tem) )
123               END DO
124            END DO
125         END DO
126         CALL iom_put( "wt", z3d )                  ! product of temperature and vertical velocity at W points
127      ENDIF
128
129      IF( iom_use("us") ) THEN
130         z3d(:,:,:) = 0.e0 
131         DO jk = 1, jpkm1
132            DO jj = 2, jpjm1
133               DO ji = fs_2, fs_jpim1   ! vector opt.
134                  z3d(ji,jj,jk) = un(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) )
135               END DO
136            END DO
137         END DO
138         CALL iom_put( "us", z3d )                  ! product of salinity and zonal velocity at U points
139      ENDIF
140
141      IF( iom_use("vs") ) 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) = vn(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj+1,jk,jp_sal) )
147               END DO
148            END DO
149         END DO
150         CALL iom_put( "vs", z3d )                  ! product of salinity and meridional velocity at V points
151      ENDIF
152
153      IF( iom_use("ws") ) THEN
154         z3d(:,:,:) = 0.e0 
155         DO jj = 2, jpjm1
156            DO ji = fs_2, fs_jpim1   ! vector opt.
157               z3d(ji,jj,1) = wn(ji,jj,1) * tsn(ji,jj,1,jp_sal)
158            END DO
159         END DO
160         DO jk = 2, jpkm1
161            DO jj = 2, jpjm1
162               DO ji = fs_2, fs_jpim1   ! vector opt.
163                  z3d(ji,jj,jk) = wn(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk-1,jp_sal) + tsn(ji,jj,jk,jp_sal) )
164               END DO
165            END DO
166         END DO
167         CALL iom_put( "ws", z3d )                  ! product of salinity and vertical velocity at W points
168      ENDIF
169
170      IF( iom_use("urhop") ) THEN
171         z3d(:,:,:) = 0.e0 
172         DO jk = 1, jpkm1
173            DO jj = 2, jpjm1
174               DO ji = fs_2, fs_jpim1   ! vector opt.
175                  z3d(ji,jj,jk) = un(ji,jj,jk) * 0.5 * ( zrhop(ji,jj,jk) + zrhop(ji+1,jj,jk) )
176               END DO
177            END DO
178         END DO
179         CALL iom_put( "urhop", z3d )                  ! product of density and zonal velocity at U points
180      ENDIF
181
182      IF( iom_use("vrhop") ) THEN
183         z3d(:,:,:) = 0.e0 
184         DO jk = 1, jpkm1
185            DO jj = 2, jpjm1
186               DO ji = fs_2, fs_jpim1   ! vector opt.
187                  z3d(ji,jj,jk) = vn(ji,jj,jk) * 0.5 * ( zrhop(ji,jj,jk) + zrhop(ji,jj+1,jk) )
188               END DO
189            END DO
190         END DO
191         CALL iom_put( "vrhop", z3d )                  ! product of density and meridional velocity at V points
192      ENDIF
193
194      IF( iom_use("wrhop") ) THEN
195         z3d(:,:,:) = 0.e0 
196         DO jj = 2, jpjm1
197            DO ji = fs_2, fs_jpim1   ! vector opt.
198               z3d(ji,jj,1) = wn(ji,jj,1) * zrhop(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) = wn(ji,jj,jk) * 0.5 * ( zrhop(ji,jj,jk-1) + zrhop(ji,jj,jk) )
205               END DO
206            END DO
207         END DO
208         CALL iom_put( "wrhop", z3d )                  ! product of density and vertical velocity at W points
209      ENDIF
210
211      !
212      CALL wrk_dealloc( jpi , jpj      , z2d )
213      CALL wrk_dealloc( jpi , jpj, jpk , z3d )
214      CALL wrk_dealloc( jpi , jpj, jpk , zrhop )
215      !
216      IF( nn_timing == 1 )   CALL timing_stop('dia_prod')
217      !
218   END SUBROUTINE dia_prod
219#else
220   !!----------------------------------------------------------------------
221   !!   Default option :                                         NO diaprod
222   !!----------------------------------------------------------------------
223   LOGICAL, PUBLIC, PARAMETER :: lk_diaprod = .FALSE.   ! coupled flag
224CONTAINS
225   SUBROUTINE dia_prod( kt )   ! Empty routine
226      INTEGER ::   kt
227      WRITE(*,*) 'dia_prod: You should not have seen this print! error?', kt
228   END SUBROUTINE dia_prod
229#endif
230   !!======================================================================
231END MODULE diaprod
Note: See TracBrowser for help on using the repository browser.