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.
mpp_tam.F90 in branches/TAM_V3_0/NEMOTAM/OPATAM_SRC – NEMO

source: branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/mpp_tam.F90 @ 2587

Last change on this file since 2587 was 2587, checked in by vidard, 13 years ago

refer to ticket #798
File size: 7.9 KB
Line 
1#if defined key_mpp_mpi
2#if defined key_sp
3#define mpivar mpi_real
4#else
5#define mpivar mpi_double_precision
6#endif
7#endif
8MODULE mpp_tam
9   !!======================================================================
10   !!                       ***  MODULE mpp_tam  ***
11   !! NEMOTAM: Various MPP support routines
12   !!======================================================================
13
14   !!----------------------------------------------------------------------
15   !! mpp_sum_reals       : Sum an array of reals from all processors
16   !! mpp_global_or,      : Do an op operation
17   !! mpp_global_max_real : Som
18   !!----------------------------------------------------------------------
19   !! * Modules used   
20   USE par_kind, ONLY : &   ! Precision variables
21      & wp
22   USE par_oce, ONLY : &    ! Ocean parameters
23      & jpnij
24   USE dom_oce, ONLY : &    ! Ocean space and time domain variables
25      & nproc, &
26      & jpiglo, &
27      & jpjglo, &
28      & jpi, &
29      & jpj, &
30      & nldi, &
31      & nldj, &
32      & nlei, &
33      & nlej, &
34      & mig, &
35      & mjg
36#if defined key_mpp_mpi
37   USE lib_mpp, ONLY : &    ! MPP library
38      & mpi_comm_opa
39#endif
40   
41   IMPLICIT NONE
42
43   !! * Routine accessibility
44   PRIVATE
45
46   PUBLIC &
47      & mpp_sum_reals,      &
48      & mpp_global_or,      &
49      & mpp_global_max_real, &
50      & mpp_global_max_real2
51
52CONTAINS
53
54   SUBROUTINE mpp_sum_reals( pvalin, pvalout, kn )
55      !!----------------------------------------------------------------------
56      !!               ***  ROUTINE mpp_sum_integers ***
57      !!         
58      !! ** Purpose : Sum all elements of a real array
59      !!
60      !! ** Method  : MPI all reduce.
61      !!
62      !! ** Action  : This does only work for MPI.
63      !!              It does not work for SHMEM.
64      !!
65      !! References : http://www.mpi-forum.org
66      !!
67      !! History :
68      !!        !  07-07  (K. Mogensen)  Original code
69      !!----------------------------------------------------------------------
70
71      !! * Arguments
72      INTEGER :: &
73         & kn 
74      REAL(wp), DIMENSION(kn), INTENT(IN) :: &
75         & pvalin
76      REAL(wp), DIMENSION(kn), INTENT(OUT) :: &
77         & pvalout
78
79#if defined key_mpp_mpi
80      !! * Local declarations
81      INTEGER :: &
82         & ierr
83#     include <mpif.h>
84
85      !-----------------------------------------------------------------------
86      ! Call the MPI library to find the sum across processors
87      !-----------------------------------------------------------------------
88      CALL mpi_allreduce( pvalin, pvalout, kn, mpivar, mpi_sum, &
89         &                mpi_comm_opa, ierr )
90#elif defined key_mpp_shmem
91#error "Only MPI support for MPP in NEMOVAR"
92#else
93
94      !-----------------------------------------------------------------------
95      ! For no-MPP just return input values
96      !-----------------------------------------------------------------------
97      pvalout(:) = pvalin(:)
98#endif
99   END SUBROUTINE mpp_sum_reals
100
101   SUBROUTINE mpp_global_or( ldval )
102      !!----------------------------------------------------------------------
103      !!               ***  ROUTINE mpp_global_or ***
104      !!         
105      !! ** Purpose : Apply the "or" operation for all elements in
106      !!              a global (jpiglo,jpjglo) array across processors
107      !!
108      !! ** Method  : MPI allreduce
109      !!
110      !! ** Action  : This does only work for MPI.
111      !!              It does not work for SHMEM.
112      !!
113      !! References : http://www.mpi-forum.org
114      !!
115      !! History :
116      !!        !  08-01  (K. Mogensen)  Original code
117      !!----------------------------------------------------------------------
118
119      !! * Arguments
120      LOGICAL, DIMENSION(jpiglo,jpjglo), INTENT(INOUT) :: &
121         & ldval
122      !! * Local declarations
123      INTEGER :: &
124         & ierr
125#if defined key_mpp_mpi
126#include <mpif.h>
127      LOGICAL, DIMENSION(:,:), ALLOCATABLE :: &
128         & llcp
129
130      ! Copy data for input to MPI
131
132      ALLOCATE( &
133         & llcp(jpiglo,jpjglo) &
134         & )
135      llcp(:,:) = ldval(:,:)
136
137      ! Call the MPI library to find the coast lines globally
138
139      CALL mpi_allreduce( llcp, ldval, jpiglo*jpjglo, mpi_logical, &
140         &                mpi_lor, mpi_comm_opa, ierr )
141
142      DEALLOCATE( &
143         & llcp &
144         & )
145
146#elif defined key_mpp_shmem
147#error "Only MPI support for MPP in NEMOVAR"
148#endif
149     
150   END SUBROUTINE mpp_global_or
151
152   SUBROUTINE mpp_global_max_real( zin, zout )
153      !!----------------------------------------------------------------------
154      !!               ***  ROUTINE mpp_global_max_real ***
155      !!         
156      !! ** Purpose : Copy a local zin array to a global array and
157      !!              apply the "max" operation for all elements in
158      !!              a global (jpiglo,jpjglo) array across processors
159      !!
160      !! ** Method  : MPI allreduce
161      !!
162      !! ** Action  : This does only work for MPI.
163      !!              It does not work for SHMEM.
164      !!
165      !! References : http://www.mpi-forum.org
166      !!
167      !! History :
168      !!        !  08-01  (K. Mogensen)  Original code
169      !!----------------------------------------------------------------------
170
171      !! * Arguments
172      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: &
173         & zin
174      REAL(wp), DIMENSION(jpiglo,jpjglo), INTENT(OUT) :: &
175         & zout
176      !! * Local declarations
177      INTEGER :: &
178         & ierr
179#if defined key_mpp_mpi
180#include <mpif.h>
181      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: &
182         & zcp
183      INTEGER :: &
184         & ji, &
185         & jj
186     
187      ! Copy data for input to MPI
188
189      ALLOCATE( &
190         & zcp(jpiglo,jpjglo) &
191         & )
192      zcp(:,:) = 0.0
193      DO jj = nldj, nlej
194         DO ji = nldi, nlei
195            zcp(mig(ji),mjg(jj)) = zin(ji,jj)
196         ENDDO
197      ENDDO
198
199      ! Call the MPI library to find the coast lines globally
200
201      CALL mpi_allreduce( zcp, zout, jpiglo*jpjglo, mpivar, &
202         &                mpi_max, mpi_comm_opa, ierr )
203
204      DEALLOCATE( &
205         & zcp &
206         & )
207
208#elif defined key_mpp_shmem
209#error "Only MPI support for MPP in NEMOVAR"
210#else
211      zout(:,:) = zin(:,:)
212#endif
213     
214   END SUBROUTINE mpp_global_max_real
215
216
217   SUBROUTINE mpp_global_max_real2( zin, zout )
218      !!----------------------------------------------------------------------
219      !!               ***  ROUTINE mpp_global_max_real2 ***
220      !!         
221      !! ** Purpose : Copy a local zin array to a global array and
222      !!              apply the "max" operation for all elements in
223      !!              a global (jpiglo,jpjglo) array across processors
224      !!
225      !! ** Method  : MPI allreduce
226      !!
227      !! ** Action  : This does only work for MPI.
228      !!              It does not work for SHMEM.
229      !!
230      !! References : http://www.mpi-forum.org
231      !!
232      !! History :
233      !!        !  08-01  (K. Mogensen)  Original code
234      !!----------------------------------------------------------------------
235
236      !! * Arguments
237      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: &
238         & zin
239      REAL(wp), DIMENSION(jpiglo,jpjglo), INTENT(OUT) :: &
240         & zout
241      !! * Local declarations
242      INTEGER :: &
243         & ierr
244#if defined key_mpp_mpi
245#include <mpif.h>
246      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: &
247         & zcp
248      INTEGER :: &
249         & ji, &
250         & jj
251     
252      ! Copy data for input to MPI
253
254      ALLOCATE( &
255         & zcp(jpiglo,jpjglo) &
256         & )
257      zcp(:,:) = -1e+38
258      DO jj = nldj, nlej
259         DO ji = nldi, nlei
260            zcp(mig(ji),mjg(jj)) = zin(ji,jj)
261         ENDDO
262      ENDDO
263
264      ! Call the MPI library to find the coast lines globally
265
266      CALL mpi_allreduce( zcp, zout, jpiglo*jpjglo, mpivar, &
267         &                mpi_max, mpi_comm_opa, ierr )
268
269      DEALLOCATE( &
270         & zcp &
271         & )
272
273#elif defined key_mpp_shmem
274#error "Only MPI support for MPP in NEMOVAR"
275#else
276      zout(:,:) = zin(:,:)
277#endif
278     
279   END SUBROUTINE mpp_global_max_real2
280   
281END MODULE mpp_tam
Note: See TracBrowser for help on using the repository browser.