DSTRB.F
References to this file elsewhere.
1 !-----------------------------------------------------------------------
2 SUBROUTINE DSTRB(ARRAYG,ARRAYL,LGS,LGE,LLS,LLE,L1 &
3 &, IDS,IDE,JDS,JDE,KDS,KDE &
4 &, IMS,IME,JMS,JME,KMS,KME &
5 &, ITS,ITE,JTS,JTE,KTS,KTE)
6 !-----------------------------------------------------------------------
7 ! DSTRB DISTRIBUTES THE ELEMENTS OF REAL GLOBAL ARRAY ARRG TO THE
8 ! REAL LOCAL ARRAYS ARRL. LG IS THE VERTICAL DIMENSION OF THE
9 ! GLOBAL ARRAY. LL IS THE VERTICAL DIMENSION OF THE LOCAL ARRAY.
10 ! L1 IS THE SPECIFIC LEVEL OF ARRL THAT IS BEING FILLED DURING
11 ! THIS CALL (PERTINENT WHEN LG=1 AND LL>1).
12 !-----------------------------------------------------------------------
13 USE MODULE_EXT_INTERNAL
14 !-----------------------------------------------------------------------
15 IMPLICIT NONE
16 !-----------------------------------------------------------------------
17 INCLUDE "mpif.h"
18 !-----------------------------------------------------------------------
19 !***
20 !*** ARGUMENT VARIABLES
21 !***
22 INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE &
23 &, IMS,IME,JMS,JME,KMS,KME &
24 &, ITS,ITE,JTS,JTE,KTS,KTE
25 INTEGER,INTENT(IN) :: L1,LGE,LGS,LLE,LLS
26 !
27 REAL,DIMENSION(IDS:IDE,LGS:LGE,JDS:JDE),INTENT(IN) :: ARRAYG
28 REAL,DIMENSION(IMS:IME,LLS:LLE,JMS:JME),INTENT(OUT) :: ARRAYL
29 !-----------------------------------------------------------------------
30 !***
31 !*** LOCAL VARIABLES
32 !***
33 REAL,ALLOCATABLE,DIMENSION(:) :: ARRAYX
34 !
35 INTEGER :: I,IEND,IPE,IRECV,IRTN,ISEND,ISTART,J,JEND,JSTART,KNT &
36 &, L,MPI_COMM_COMP,NUMVALS,MYPE,NPES
37 INTEGER,DIMENSION(4) :: LIMITS
38 INTEGER,DIMENSION(MPI_STATUS_SIZE) :: ISTAT
39 !-----------------------------------------------------------------------
40 !***********************************************************************
41 !-----------------------------------------------------------------------
42 !
43 !*** GET OUR TASK ID AND THE COMMUNICATOR
44 !
45 CALL WRF_GET_MYPROC(MYPE)
46 CALL WRF_GET_DM_COMMUNICATOR(MPI_COMM_COMP)
47 CALL WRF_GET_NPROC(NPES)
48 !
49 !*** INITIALIZE THE OUTPUT ARRAY
50 !
51 DO J=JMS,JME
52 DO L=LLS,LLE
53 DO I=IMS,IME
54 ARRAYL(I,L,J)=0.
55 ENDDO
56 ENDDO
57 ENDDO
58 !
59 !-----------------------------------------------------------------------
60 !*** TASK 0 FILLS ITS OWN LOCAL DOMAIN THEN PARCELS OUT ALL THE OTHER
61 !*** PIECES TO THE OTHER TASKS.
62 !-----------------------------------------------------------------------
63 !
64 tasks : IF(MYPE==0)THEN
65 !
66 IF(LGE==LGS)THEN
67 DO J=JTS,JTE
68 DO I=ITS,ITE
69 ARRAYL(I,L1,J)=ARRAYG(I,LGS,J)
70 ENDDO
71 ENDDO
72 !
73 ELSE
74 !
75 DO J=JTS,JTE
76 DO L=LGS,LGE
77 DO I=ITS,ITE
78 ARRAYL(I,L,J)=ARRAYG(I,L,J)
79 ENDDO
80 ENDDO
81 ENDDO
82 ENDIF
83 !
84 !*** TASK 0 NEEDS THE LIMITS FROM EACH OF THE OTHER TASKS AND THEN
85 !*** SENDS OUT THE APPROPRIATE PIECE OF THE GLOBAL ARRAY.
86 !
87 DO IPE=1,NPES-1
88 !
89 CALL MPI_RECV(LIMITS,4,MPI_INTEGER,IPE,IPE,MPI_COMM_COMP &
90 &, ISTAT,IRECV)
91 ISTART=LIMITS(1)
92 IEND=LIMITS(2)
93 JSTART=LIMITS(3)
94 JEND=LIMITS(4)
95 !
96 NUMVALS=(IEND-ISTART+1)*(JEND-JSTART+1)*(LGE-LGS+1)
97 ALLOCATE(ARRAYX(NUMVALS),STAT=I)
98
99 KNT=0
100 !
101 DO J=JSTART,JEND
102 DO L=LGS,LGE
103 DO I=ISTART,IEND
104 KNT=KNT+1
105 ARRAYX(KNT)=ARRAYG(I,L,J)
106 ENDDO
107 ENDDO
108 ENDDO
109 !
110 CALL MPI_SEND(ARRAYX,KNT,MPI_REAL,IPE,IPE,MPI_COMM_COMP,ISEND)
111 !
112 DEALLOCATE(ARRAYX)
113 !
114 ENDDO
115 !
116 !-----------------------------------------------------------------------
117 !*** ALL OTHER TASKS TELL TASK 0 WHAT THEIR HORIZONTAL LIMITS ARE AND
118 !*** RECEIVE THEIR PIECE OF THE GLOBAL ARRAY FROM TASK 0.
119 !-----------------------------------------------------------------------
120 !
121 ELSE
122 !
123 LIMITS(1)=ITS
124 LIMITS(2)=ITE
125 LIMITS(3)=JTS
126 LIMITS(4)=JTE
127 !
128 CALL MPI_SEND(LIMITS,4,MPI_INTEGER,0,MYPE,MPI_COMM_COMP,ISEND)
129 !
130 NUMVALS=(ITE-ITS+1)*(JTE-JTS+1)*(LGE-LGS+1)
131 ALLOCATE(ARRAYX(NUMVALS),STAT=I)
132 !
133 CALL MPI_RECV(ARRAYX,NUMVALS,MPI_REAL,0,MYPE,MPI_COMM_COMP &
134 &, ISTAT,IRECV)
135 !
136 KNT=0
137 IF(LGE==LGS)THEN
138 DO J=JTS,JTE
139 DO I=ITS,ITE
140 KNT=KNT+1
141 ARRAYL(I,L1,J)=ARRAYX(KNT)
142 ENDDO
143 ENDDO
144 ELSE
145 DO J=JTS,JTE
146 DO L=LGS,LGE
147 DO I=ITS,ITE
148 KNT=KNT+1
149 ARRAYL(I,L,J)=ARRAYX(KNT)
150 ENDDO
151 ENDDO
152 ENDDO
153 ENDIF
154 !
155 DEALLOCATE(ARRAYX)
156 !
157 !-----------------------------------------------------------------------
158 !
159 ENDIF tasks
160 !
161 !-----------------------------------------------------------------------
162 CALL MPI_BARRIER(MPI_COMM_COMP,IRTN)
163 !-----------------------------------------------------------------------
164 !
165 END SUBROUTINE DSTRB
166 !
167 !-----------------------------------------------------------------------