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.
dotprodfld.F90 in branches/2012/dev_r3604_LEGI8_TAM/NEMOGCM/NEMO/OPATAM_SRC – NEMO

source: branches/2012/dev_r3604_LEGI8_TAM/NEMOGCM/NEMO/OPATAM_SRC/dotprodfld.F90 @ 3640

Last change on this file since 3640 was 3640, checked in by pabouttier, 10 years ago

Missing allocation/deallocation in TAM routines - See ticket #1013

  • Property svn:executable set to *
File size: 3.2 KB
Line 
1MODULE dotprodfld
2   !!======================================================================
3   !!                       ***  MODULE dotprodfld ***
4   !! NEMOVAR dotprodfld : Computes dot prodoct for 3D and 2D fields
5   !!======================================================================
6   !!
7   !!----------------------------------------------------------------------
8   !!     dot_product     : Computes the dot_product for two 3D/2D fields
9   !!----------------------------------------------------------------------
10   !! * Modules used
11   USE par_kind
12   USE dom_oce, ONLY :       &
13      & nldi,                &
14      & nldj,                &
15      & nlei,                &
16      & nlej
17   USE par_oce       , ONLY: & ! Ocean space and time domain variables
18      & jpi,                 &
19      & jpj,                 &
20      & jpk
21
22   USE lib_fortran
23
24   IMPLICIT NONE
25
26   !! * Routine accessibility
27   PRIVATE
28
29   PUBLIC &
30      & dot_product
31
32   !! * Interfaces
33
34   INTERFACE dot_product
35      MODULE PROCEDURE dot_product_3d
36      MODULE PROCEDURE dot_product_2d
37   END INTERFACE
38
39CONTAINS
40
41   FUNCTION dot_product_3d( pvec1, pvec2 )
42      !!----------------------------------------------------------------------
43      !!               ***  ROUTINE dot_product_3d  ***
44      !!
45      !! ** Purpose : Computes the dot_product for two 3D fields
46      !!
47      !! ** Method  : Use the mppsum module
48      !!
49      !! ** Action  :
50      !!
51      !! References :
52      !!
53      !! History :
54      !!        !  07-08  (K. Mogensen)  Original code
55      !!----------------------------------------------------------------------
56      !! * Function return
57      REAL(wp) dot_product_3d
58      !! * Arguments
59      REAL(wp), INTENT(IN), DIMENSION(jpi,jpj,jpk) :: &
60         & pvec1, &     ! 3D fields to compute dot_product of
61         & pvec2
62      !! * Local declarations
63
64      dot_product_3d = glob_sum( &
65         &                       PACK( pvec1(nldi:nlei,nldj:nlej,:),.TRUE.) * &
66         &                       PACK( pvec2(nldi:nlei,nldj:nlej,:),.TRUE.),  &
67         &                       (nlei-nldi+1) * (nlej-nldj+1) * jpk )
68
69   END FUNCTION dot_product_3d
70
71   FUNCTION dot_product_2d( pvec1, pvec2 )
72      !!----------------------------------------------------------------------
73      !!               ***  ROUTINE dot_product_2d  ***
74      !!
75      !! ** Purpose : Computes the dot_product for two 2D fields
76      !!
77      !! ** Method  : Use the mppsum module
78      !!
79      !! ** Action  :
80      !!
81      !! References :
82      !!
83      !! History :
84      !!        !  07-08  (K. Mogensen)  Original code
85      !!----------------------------------------------------------------------
86      !! * Function return
87      REAL(wp) dot_product_2d
88      !! * Arguments
89      REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: &
90         & pvec1, &     ! 2D fields to compute dot_product of
91         & pvec2
92
93      dot_product_2d = glob_sum( &
94         &                       PACK( pvec1(nldi:nlei,nldj:nlej),.TRUE.) * &
95         &                       PACK( pvec2(nldi:nlei,nldj:nlej),.TRUE.),  &
96         &                       (nlei-nldi+1) * (nlej-nldj+1) )
97
98   END FUNCTION dot_product_2d
99
100END MODULE dotprodfld
Note: See TracBrowser for help on using the repository browser.