1 |
|
|
MODULE SUMP_TRANS_MOD |
2 |
|
|
CONTAINS |
3 |
|
|
SUBROUTINE SUMP_TRANS |
4 |
|
|
|
5 |
|
|
! Set up distributed environment for the transform package (part 2) |
6 |
|
|
|
7 |
|
|
USE PARKIND1 ,ONLY : JPIM ,JPRB |
8 |
|
|
|
9 |
|
|
USE TPM_GEN |
10 |
|
|
USE TPM_DIM |
11 |
|
|
USE TPM_GEOMETRY |
12 |
|
|
USE TPM_DISTR |
13 |
|
|
|
14 |
|
|
USE SUWAVEDI_MOD |
15 |
|
|
USE PE2SET_MOD |
16 |
|
|
USE SUMPLATF_MOD |
17 |
|
|
USE SUMPLAT_MOD |
18 |
|
|
USE SUSTAONL_MOD |
19 |
|
|
USE MYSENDSET_MOD |
20 |
|
|
USE MYRECVSET_MOD |
21 |
|
|
USE EQ_REGIONS_MOD |
22 |
|
|
|
23 |
|
|
IMPLICIT NONE |
24 |
|
|
|
25 |
|
|
INTEGER(KIND=JPIM) :: JM,JMLOC |
26 |
|
|
INTEGER(KIND=JPIM) :: JGL,IGL,IPLAT,ISENDSET,IRECVSET,JML,IPOS,IM |
27 |
|
|
INTEGER(KIND=JPIM) :: I1,I2,I3,IAUX0,IAUX1,JA1 |
28 |
|
|
INTEGER(KIND=JPIM) :: IGPTOT,IMEDIAP,IRESTM,JA,JB,IOFF |
29 |
|
|
INTEGER(KIND=JPIM),ALLOCATABLE :: IGPTOTL(:,:) |
30 |
|
|
|
31 |
|
|
LOGICAL :: LLP1,LLP2 |
32 |
|
|
|
33 |
|
|
! ------------------------------------------------------------------ |
34 |
|
|
|
35 |
|
|
|
36 |
|
|
LLP1 = NPRINTLEV>0 |
37 |
|
|
LLP2 = NPRINTLEV>1 |
38 |
|
|
IF(LLP1) WRITE(NOUT,*) '=== ENTER ROUTINE SUMP_TRANS ===' |
39 |
|
|
|
40 |
|
|
ALLOCATE(D%NULTPP(NPRTRNS)) |
41 |
|
|
IF(LLP2)WRITE(NOUT,9) 'D%NULTPP ',SIZE(D%NULTPP ),SHAPE(D%NULTPP ) |
42 |
|
|
ALLOCATE(D%NPTRLS(NPRTRNS)) |
43 |
|
|
IF(LLP2)WRITE(NOUT,9) 'D%NPTRLS ',SIZE(D%NPTRLS ),SHAPE(D%NPTRLS ) |
44 |
|
|
ALLOCATE(D%NPROCL(R%NDGL)) |
45 |
|
|
IF(LLP2)WRITE(NOUT,9) 'D%NPROCL ',SIZE(D%NPROCL ),SHAPE(D%NPROCL ) |
46 |
|
|
|
47 |
|
|
CALL SUMPLATF(R%NDGL,NPRTRNS,MYSETW,D%NULTPP,D%NPROCL,D%NPTRLS) |
48 |
|
|
D%NDGL_FS = D%NULTPP(MYSETW) |
49 |
|
|
|
50 |
|
|
! Help arrays for spectral to fourier space transposition |
51 |
|
|
ALLOCATE(D%NLTSGTB (NPRTRNS+1)) |
52 |
|
|
IF(LLP2)WRITE(NOUT,9) 'D%NLTSGTB ',SIZE(D%NLTSGTB),SHAPE(D%NLTSGTB) |
53 |
|
|
ALLOCATE(D%NLTSFTB (NPRTRNS+1)) |
54 |
|
|
IF(LLP2)WRITE(NOUT,9) 'D%NLTSFTB ',SIZE(D%NLTSFTB),SHAPE(D%NLTSFTB) |
55 |
|
|
ALLOCATE(D%NSTAGT0B(NPRTRNS+1)) |
56 |
|
|
IF(LLP2)WRITE(NOUT,9) 'D%NSTAGT0B ',SIZE(D%NSTAGT0B),SHAPE(D%NSTAGT0B) |
57 |
|
|
ALLOCATE(D%NSTAGT1B(NPRTRNS+1)) |
58 |
|
|
IF(LLP2)WRITE(NOUT,9) 'D%NSTAGT1B ',SIZE(D%NSTAGT1B),SHAPE(D%NSTAGT1B) |
59 |
|
|
ALLOCATE(D%MSTABF (NPRTRNS+1)) |
60 |
|
|
IF(LLP2)WRITE(NOUT,9) 'D%MSTABF ',SIZE(D%MSTABF),SHAPE(D%MSTABF) |
61 |
|
|
|
62 |
|
|
D%NLTSGTB(:) = 0 |
63 |
|
|
DO JGL=1,D%NDGL_FS |
64 |
|
|
IGL = D%NPTRLS(MYSETW)+JGL-1 |
65 |
|
|
DO JM=0,G%NMEN(IGL) |
66 |
|
|
D%NLTSGTB(D%NPROCM(JM)) = D%NLTSGTB(D%NPROCM(JM))+1 |
67 |
|
|
ENDDO |
68 |
|
|
ENDDO |
69 |
|
|
DO JA=1,NPRTRW |
70 |
|
|
IPLAT = 0 |
71 |
|
|
DO JGL=1,D%NULTPP(JA) |
72 |
|
|
IGL = D%NPTRLS(JA)+JGL-1 |
73 |
|
|
DO JM=1,D%NUMP |
74 |
|
|
IF(IGL > R%NDGNH-G%NDGLU(D%MYMS(JM)) .AND. IGL <= R%NDGNH+G%NDGLU(D%MYMS(JM))) THEN |
75 |
|
|
IPLAT = IPLAT + 1 |
76 |
|
|
ENDIF |
77 |
|
|
ENDDO |
78 |
|
|
ENDDO |
79 |
|
|
D%NLTSFTB(JA) = IPLAT |
80 |
|
|
ENDDO |
81 |
|
|
|
82 |
|
|
DO JA=1,NPRTRW-1 |
83 |
|
|
ISENDSET = MYSENDSET(NPRTRW,MYSETW,JA) |
84 |
|
|
IRECVSET = MYRECVSET(NPRTRW,MYSETW,JA) |
85 |
|
|
D%MSTABF(IRECVSET) = ISENDSET |
86 |
|
|
ENDDO |
87 |
|
|
D%MSTABF(MYSETW) = MYSETW |
88 |
|
|
|
89 |
|
|
ALLOCATE(D%NPNTGTB0(0:R%NSMAX,D%NDGL_FS)) |
90 |
|
|
IF(LLP2)WRITE(NOUT,9) 'D%NPNTGTB0 ',SIZE(D%NPNTGTB0 ),SHAPE(D%NPNTGTB0 ) |
91 |
|
|
ALLOCATE(D%NPNTGTB1(D%NUMP,R%NDGL)) |
92 |
|
|
IF(LLP2)WRITE(NOUT,9) 'D%NPNTGTB1 ',SIZE(D%NPNTGTB1 ),SHAPE(D%NPNTGTB1 ) |
93 |
|
|
|
94 |
|
|
DO JA=1,NPRTRW |
95 |
|
|
IPOS = 0 |
96 |
|
|
DO JGL=1,D%NULTPP(MYSETW) |
97 |
|
|
IGL = D%NPTRLS(MYSETW) + JGL - 1 |
98 |
|
|
DO JML=D%NPTRMS(JA),D%NPTRMS(JA)+D%NUMPP(JA)-1 |
99 |
|
|
IM = D%NALLMS(JML) |
100 |
|
|
IF (IM <= G%NMEN(IGL)) THEN |
101 |
|
|
D%NPNTGTB0(IM,JGL) = IPOS |
102 |
|
|
IPOS = IPOS+1 |
103 |
|
|
ELSE |
104 |
|
|
D%NPNTGTB0(IM,JGL) = -99 |
105 |
|
|
ENDIF |
106 |
|
|
ENDDO |
107 |
|
|
ENDDO |
108 |
|
|
ENDDO |
109 |
|
|
|
110 |
|
|
DO JA=1,NPRTRW |
111 |
|
|
IPOS = 0 |
112 |
|
|
DO JGL=1,D%NULTPP(JA) |
113 |
|
|
IGL = D%NPTRLS(JA) + JGL - 1 |
114 |
|
|
DO JM=1,D%NUMP |
115 |
|
|
IM = D%MYMS(JM) |
116 |
|
|
IF (IM <= G%NMEN(IGL)) THEN |
117 |
|
|
D%NPNTGTB1(JM,IGL) = IPOS |
118 |
|
|
IPOS = IPOS+1 |
119 |
|
|
ELSE |
120 |
|
|
D%NPNTGTB1(JM,IGL) = -99 |
121 |
|
|
ENDIF |
122 |
|
|
ENDDO |
123 |
|
|
ENDDO |
124 |
|
|
ENDDO |
125 |
|
|
|
126 |
|
|
IAUX0 = 0 |
127 |
|
|
IAUX1 = 0 |
128 |
|
|
DO JA=1,NPRTRNS-1 |
129 |
|
|
I1 = MYSENDSET(NPRTRNS,MYSETW,JA) |
130 |
|
|
I2 = MYRECVSET(NPRTRNS,MYSETW,JA) |
131 |
|
|
DO JA1=1,NPRTRNS-1 |
132 |
|
|
IF(MYSENDSET(NPRTRNS,MYSETW,JA1) == I2) I3 =MYRECVSET(NPRTRNS,MYSETW,JA1) |
133 |
|
|
ENDDO |
134 |
|
|
IAUX0 = MAX(D%NLTSFTB(I1),D%NLTSGTB(I2),IAUX0) |
135 |
|
|
IAUX1 = MAX(D%NLTSGTB(I2),D%NLTSFTB(I3),IAUX1) |
136 |
|
|
ENDDO |
137 |
|
|
IAUX0 = MAX(D%NLTSGTB(MYSETW),IAUX0) |
138 |
|
|
IAUX1 = MAX(D%NLTSGTB(MYSETW),IAUX1) |
139 |
|
|
DO JA=1,NPRTRNS+1 |
140 |
|
|
D%NSTAGT0B(JA) = (JA-1)*IAUX0 |
141 |
|
|
D%NSTAGT1B(JA) = (JA-1)*IAUX1 |
142 |
|
|
ENDDO |
143 |
|
|
D%NLENGT0B = IAUX0*NPRTRNS |
144 |
|
|
D%NLENGT1B = IAUX1*NPRTRNS |
145 |
|
|
|
146 |
|
|
! GRIDPOINT SPACE |
147 |
|
|
|
148 |
|
|
ALLOCATE(D%NFRSTLAT(N_REGIONS_NS)) |
149 |
|
|
IF(LLP2)WRITE(NOUT,9) 'D%NFRSTLAT ',SIZE(D%NFRSTLAT ),SHAPE(D%NFRSTLAT ) |
150 |
|
|
ALLOCATE(D%NLSTLAT(N_REGIONS_NS)) |
151 |
|
|
IF(LLP2)WRITE(NOUT,9) 'D%NLSTLAT ',SIZE(D%NLSTLAT ),SHAPE(D%NLSTLAT ) |
152 |
|
|
ALLOCATE(D%NPTRLAT(R%NDGL)) |
153 |
|
|
IF(LLP2)WRITE(NOUT,9) 'D%NPTRLAT ',SIZE(D%NPTRLAT ),SHAPE(D%NPTRLAT ) |
154 |
|
|
ALLOCATE(D%NPTRFRSTLAT(N_REGIONS_NS)) |
155 |
|
|
IF(LLP2)WRITE(NOUT,9) 'D%NPTRFRSTLAT',SIZE(D%NPTRFRSTLAT),SHAPE(D%NPTRFRSTLAT) |
156 |
|
|
ALLOCATE(D%NPTRLSTLAT(N_REGIONS_NS)) |
157 |
|
|
IF(LLP2)WRITE(NOUT,9)'D%NPTRLSTLAT',SIZE(D%NPTRLSTLAT),SHAPE(D%NPTRLSTLAT) |
158 |
|
|
ALLOCATE(D%LSPLITLAT(R%NDGL)) |
159 |
|
|
IF(LLP2)WRITE(NOUT,9) 'D%LSPLITLAT',SIZE(D%LSPLITLAT),SHAPE(D%LSPLITLAT) |
160 |
|
|
|
161 |
|
|
|
162 |
|
|
CALL SUMPLAT(R%NDGL,NPROC,N_REGIONS_NS,MY_REGION_NS,D%LSPLIT,LEQ_REGIONS,& |
163 |
|
|
&D%NFRSTLAT,D%NLSTLAT,D%NFRSTLOFF,D%NPTRLAT,& |
164 |
|
|
&D%NPTRFRSTLAT,D%NPTRLSTLAT,D%NPTRFLOFF,& |
165 |
|
|
&IMEDIAP,IRESTM,D%LSPLITLAT) |
166 |
|
|
|
167 |
|
|
D%NDGL_GP = D%NLSTLAT(MY_REGION_NS)-D%NFRSTLOFF |
168 |
|
|
|
169 |
|
|
IF (LLP1) THEN |
170 |
|
|
WRITE(NOUT,FMT='(/'' OUTPUT FROM ROUTINE SUMPLAT: ''/)') |
171 |
|
|
WRITE(NOUT,FMT='('' D%NULTPP '')') |
172 |
|
|
WRITE(NOUT,FMT='(20(1X,I4))') D%NULTPP(1:NPRTRNS) |
173 |
|
|
WRITE(NOUT,FMT='('' D%NPROCL '')') |
174 |
|
|
WRITE(NOUT,FMT='(20(1X,I4))') D%NPROCL(1:R%NDGL) |
175 |
|
|
WRITE(NOUT,FMT='('' D%NFRSTLAT '')') |
176 |
|
|
WRITE(NOUT,FMT='(20(1X,I4))') D%NFRSTLAT(1:N_REGIONS_NS) |
177 |
|
|
WRITE(NOUT,FMT='('' D%NLSTLAT '')') |
178 |
|
|
WRITE(NOUT,FMT='(20(1X,I4))') D%NLSTLAT(1:N_REGIONS_NS) |
179 |
|
|
WRITE(NOUT,FMT='('' D%NFRSTLOFF D%NPTRFLOFF '')') |
180 |
|
|
WRITE(NOUT,FMT='(2(1X,I6))') D%NFRSTLOFF, D%NPTRFLOFF |
181 |
|
|
WRITE(NOUT,FMT='('' D%NPTRLAT '')') |
182 |
|
|
WRITE(NOUT,FMT='(20(1X,I4))') D%NPTRLAT(1:R%NDGL) |
183 |
|
|
WRITE(NOUT,FMT='('' D%LSPLITLAT '')') |
184 |
|
|
WRITE(NOUT,FMT='(50(1X,L1))') D%LSPLITLAT(1:R%NDGL) |
185 |
|
|
WRITE(NOUT,FMT='('' D%NPTRFRSTLAT '')') |
186 |
|
|
WRITE(NOUT,FMT='(20(1X,I4))') D%NPTRFRSTLAT(1:N_REGIONS_NS) |
187 |
|
|
WRITE(NOUT,FMT='('' D%NPTRLSTLAT '')') |
188 |
|
|
WRITE(NOUT,FMT='(20(1X,I4))') D%NPTRLSTLAT(1:N_REGIONS_NS) |
189 |
|
|
WRITE(NOUT,FMT='(/)') |
190 |
|
|
ENDIF |
191 |
|
|
ALLOCATE(D%NSTA(R%NDGL+N_REGIONS_NS-1,N_REGIONS_EW)) |
192 |
|
|
IF(LLP2)WRITE(NOUT,9) 'D%NSTA ',SIZE(D%NSTA ),SHAPE(D%NSTA ) |
193 |
|
|
ALLOCATE(D%NONL(R%NDGL+N_REGIONS_NS-1,N_REGIONS_EW)) |
194 |
|
|
IF(LLP2)WRITE(NOUT,9) 'D%NONL ',SIZE(D%NONL ),SHAPE(D%NONL ) |
195 |
|
|
|
196 |
|
|
CALL SUSTAONL(IMEDIAP,IRESTM) |
197 |
|
|
|
198 |
|
|
! IGPTOTL is the number of grid points in each individual processor |
199 |
|
|
ALLOCATE(IGPTOTL(N_REGIONS_NS,N_REGIONS_EW)) |
200 |
|
|
IGPTOTL(:,:)=0 |
201 |
|
|
|
202 |
|
|
DO JA=1,N_REGIONS_NS |
203 |
|
|
DO JB=1,N_REGIONS(JA) |
204 |
|
|
IGPTOT = 0 |
205 |
|
|
DO JGL=D%NPTRFRSTLAT(JA),D%NPTRLSTLAT(JA) |
206 |
|
|
IGPTOT = IGPTOT+D%NONL(JGL,JB) |
207 |
|
|
ENDDO |
208 |
|
|
IGPTOTL(JA,JB) = IGPTOT |
209 |
|
|
ENDDO |
210 |
|
|
ENDDO |
211 |
|
|
D%NGPTOT = IGPTOTL(MY_REGION_NS,MY_REGION_EW) |
212 |
|
|
D%NGPTOTMX = MAXVAL(IGPTOTL) |
213 |
|
|
D%NGPTOTG = SUM(IGPTOTL) |
214 |
|
|
ALLOCATE(D%NGPTOTL(N_REGIONS_NS,N_REGIONS_EW)) |
215 |
|
|
IF(LLP2)WRITE(NOUT,9) 'D%NGPTOTL ',SIZE(D%NGPTOTL ),SHAPE(D%NGPTOTL ) |
216 |
|
|
D%NGPTOTL(:,:) = IGPTOTL(:,:) |
217 |
|
|
|
218 |
|
|
ALLOCATE(D%NSTAGTF(D%NDGL_FS)) |
219 |
|
|
IF(LLP2)WRITE(NOUT,9) 'D%NSTAGTF ',SIZE(D%NSTAGTF ),SHAPE(D%NSTAGTF ) |
220 |
|
|
IOFF = 0 |
221 |
|
|
DO JGL=1,D%NDGL_FS |
222 |
|
|
D%NSTAGTF(JGL) = IOFF |
223 |
|
|
IGL = D%NPTRLS(MYSETW) + JGL - 1 |
224 |
|
|
IOFF = IOFF + G%NLOEN(IGL)+3 |
225 |
|
|
ENDDO |
226 |
|
|
D%NLENGTF = IOFF |
227 |
|
|
|
228 |
|
|
DEALLOCATE(IGPTOTL) |
229 |
|
|
|
230 |
|
|
! ------------------------------------------------------------------ |
231 |
|
|
9 FORMAT(1X,'ARRAY ',A10,' ALLOCATED ',8I8) |
232 |
|
|
|
233 |
|
|
END SUBROUTINE SUMP_TRANS |
234 |
|
|
END MODULE SUMP_TRANS_MOD |
235 |
|
|
|
236 |
|
|
|