/[MITgcm]/MITgcm/eesupp/src/scatter_vector.F
ViewVC logotype

Contents of /MITgcm/eesupp/src/scatter_vector.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.3 - (show annotations) (download)
Sat Nov 5 00:51:07 2005 UTC (18 years, 7 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint58l_post, checkpoint58e_post, mitgcm_mapl_00, checkpoint58u_post, checkpoint58r_post, checkpoint57y_post, checkpoint58g_post, checkpoint57x_post, checkpoint58n_post, checkpoint58x_post, checkpoint58t_post, checkpoint58h_post, checkpoint58w_post, checkpoint58j_post, checkpoint57y_pre, checkpoint58q_post, checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f, checkpoint59a, checkpoint59c, checkpoint59b, checkpoint59, checkpoint58, checkpoint58f_post, checkpoint58d_post, checkpoint58c_post, checkpoint58a_post, checkpoint58i_post, checkpoint58o_post, checkpoint57z_post, checkpoint58y_post, checkpoint58k_post, checkpoint58v_post, checkpoint58s_post, checkpoint58p_post, checkpoint58b_post, checkpoint58m_post
Changes since 1.2: +0 -4 lines
move local commom bloc /GlobalLo/ in EESUPPORT.h

1 #include "CPP_OPTIONS.h"
2
3 SUBROUTINE SCATTER_VECTOR( length, global, local, myThid )
4 C Scatter elements of a 2-D array from mpi process 0 to all processes.
5 IMPLICIT NONE
6 #include "SIZE.h"
7 #include "EEPARAMS.h"
8 #include "EESUPPORT.h"
9 C mythid - thread number for this instance of the routine.
10 C global,local - working arrays used to transfer 2-D fields
11 INTEGER mythid
12 INTEGER length
13 Real*8 global(length*nPx*nPy)
14 _RL local(length)
15
16 INTEGER iG,jG,lG, l
17 #ifdef ALLOW_USE_MPI
18 _RL temp(length)
19 INTEGER istatus(MPI_STATUS_SIZE), ierr
20 INTEGER isource, itag, npe
21 INTEGER lbuff
22 #endif /* ALLOW_USE_MPI */
23
24 C-- Make everyone wait except for master thread.
25 _BARRIER
26 _BEGIN_MASTER( myThid )
27
28 #ifndef ALLOW_USE_MPI
29
30 DO l=1,length
31 iG=1+(myXGlobalLo-1)/sNx ! Kludge until unstructered tiles
32 jG=1+(myYGlobalLo-1)/sNy ! Kludge until unstructered tiles
33 lG= (jG-1)*nPx*length + (iG-1)*length + l
34 local(l) = global(lG)
35 ENDDO
36
37 #else /* ALLOW_USE_MPI */
38
39 lbuff = length
40 isource = 0
41 itag = 0
42
43 IF( mpiMyId .EQ. 0 ) THEN
44
45 C-- Process 0 fills-in its local data
46 npe = 0
47 iG=mpi_myXGlobalLo(npe+1)/sNx+1
48 jG=mpi_myYGlobalLo(npe+1)/sNy+1
49 DO l=1,length
50 lG= (jG-1)*nPx*length + (iG-1)*length + l
51 local(l) = global(lG)
52 ENDDO
53
54 C-- Process 0 sends local arrays to all other processes
55 DO npe = 1, numberOfProcs-1
56 iG = mpi_myXGlobalLo(npe+1)/sNx+1
57 jG = mpi_myYGlobalLo(npe+1)/sNy+1
58 DO l=1,length
59 lG= (jG-1)*nPx*length + (iG-1)*length + l
60 temp(l) = global(lG)
61 ENDDO
62 CALL MPI_SEND (temp, lbuff, MPI_DOUBLE_PRECISION,
63 & npe, itag, MPI_COMM_MODEL, ierr)
64 ENDDO
65
66 ELSE
67
68 C-- All proceses except 0 receive local array from process 0
69 CALL MPI_RECV (local, lbuff, MPI_DOUBLE_PRECISION,
70 & isource, itag, MPI_COMM_MODEL, istatus, ierr)
71
72 ENDIF
73
74 #endif /* ALLOW_USE_MPI */
75
76 _END_MASTER( myThid )
77 _BARRIER
78
79 C-- Fill in edges.
80 cph _EXCH_XY_R8( local, myThid )
81
82 RETURN
83 END

  ViewVC Help
Powered by ViewVC 1.1.22