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

source: branches/UKMO/dev_r5518_GO6_package_OMP/NEMOGCM/NEMO/OPA_SRC/DIA/diaprod.F90 @ 9176

Last change on this file since 9176 was 9176, checked in by andmirek, 6 years ago

#2001: OMP directives

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