1 |
|
|
MODULE SUMPLATB_MOD |
2 |
|
|
CONTAINS |
3 |
|
|
SUBROUTINE SUMPLATB(KDGSA,KDGL,KPROCA,KLOENG,LDSPLIT,& |
4 |
|
|
&KMEDIAP,KRESTM,KINDIC,KLAST) |
5 |
|
|
|
6 |
|
|
!**** *SUMPLATB * - Routine to initialize parallel environment |
7 |
|
|
|
8 |
|
|
! Purpose. |
9 |
|
|
! -------- |
10 |
|
|
|
11 |
|
|
|
12 |
|
|
!** Interface. |
13 |
|
|
! ---------- |
14 |
|
|
! *CALL* *SUMPLATB * |
15 |
|
|
|
16 |
|
|
! Explicit arguments - input : |
17 |
|
|
! -------------------- |
18 |
|
|
! KDGSA -first latitude (grid-space) |
19 |
|
|
! (may be different from NDGSAG) |
20 |
|
|
! KDGL -last latitude |
21 |
|
|
! KPROCA -number of processors in A direction |
22 |
|
|
! KLOENG -actual number of longitudes per latitude. |
23 |
|
|
! LDSPLIT -true for latitudes shared between sets |
24 |
|
|
|
25 |
|
|
! Explicit arguments - output: |
26 |
|
|
! -------------------- |
27 |
|
|
! KMEDIAP -mean number of grid points per PE |
28 |
|
|
! KRESTM -number of PEs with one extra point |
29 |
|
|
! KINDIC -intermediate quantity for 'sumplat' |
30 |
|
|
! KLAST -intermediate quantity for 'sumplat' |
31 |
|
|
|
32 |
|
|
! Implicit arguments : |
33 |
|
|
! -------------------- |
34 |
|
|
|
35 |
|
|
|
36 |
|
|
! Method. |
37 |
|
|
! ------- |
38 |
|
|
! See documentation |
39 |
|
|
|
40 |
|
|
! Externals. NONE. |
41 |
|
|
! ---------- |
42 |
|
|
|
43 |
|
|
! Reference. |
44 |
|
|
! ---------- |
45 |
|
|
! ECMWF Research Department documentation of the IFS |
46 |
|
|
|
47 |
|
|
! Author. |
48 |
|
|
! ------- |
49 |
|
|
! K. YESSAD (after old version of sumplat.F). |
50 |
|
|
|
51 |
|
|
! Modifications. |
52 |
|
|
! -------------- |
53 |
|
|
! Original : 98-12-07 |
54 |
|
|
! ------------------------------------------------------------------ |
55 |
|
|
|
56 |
|
|
|
57 |
|
|
USE PARKIND1 ,ONLY : JPIM ,JPRB |
58 |
|
|
|
59 |
|
|
USE ABORT_TRANS_MOD |
60 |
|
|
|
61 |
|
|
IMPLICIT NONE |
62 |
|
|
|
63 |
|
|
|
64 |
|
|
! * DUMMY: |
65 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: KDGSA |
66 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: KDGL |
67 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: KPROCA |
68 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: KLOENG(KDGSA:KDGL) |
69 |
|
|
LOGICAL,INTENT(IN) :: LDSPLIT |
70 |
|
|
INTEGER(KIND=JPIM),INTENT(OUT) :: KMEDIAP |
71 |
|
|
INTEGER(KIND=JPIM),INTENT(OUT) :: KRESTM |
72 |
|
|
INTEGER(KIND=JPIM),INTENT(OUT) :: KINDIC(KPROCA) |
73 |
|
|
INTEGER(KIND=JPIM),INTENT(OUT) :: KLAST(KPROCA) |
74 |
|
|
|
75 |
|
|
! * LOCAL: |
76 |
|
|
INTEGER(KIND=JPIM) :: IPP1(KPROCA),ILAST1(KPROCA) |
77 |
|
|
INTEGER(KIND=JPIM) :: IPP(KPROCA) |
78 |
|
|
INTEGER(KIND=JPIM) :: IFIRST(KPROCA) |
79 |
|
|
|
80 |
|
|
! LOCAL INTEGER SCALARS |
81 |
|
|
INTEGER(KIND=JPIM) :: ICOMP, IGL, IMAXI, IMAXIOL, IMEDIA, ITOT, JA, JGL,& |
82 |
|
|
&ILAST,IREST,ILIMIT,IFRST |
83 |
|
|
LOGICAL :: LLDONE |
84 |
|
|
|
85 |
|
|
! ----------------------------------------------------------------- |
86 |
|
|
|
87 |
|
|
!* 1. COMPUTATION OF KMEDIAP, KRESTM, KINDIC, KLAST. |
88 |
|
|
! ---------------------------------------------- |
89 |
|
|
|
90 |
|
|
! * Computation of KMEDIAP and KRESTM. |
91 |
|
|
|
92 |
|
|
IMEDIA = SUM(KLOENG(KDGSA:KDGL)) |
93 |
|
|
KMEDIAP = IMEDIA / KPROCA |
94 |
|
|
IF (KMEDIAP < KLOENG(KDGL/2)) THEN |
95 |
|
|
CALL ABORT_TRANS ('SUMPLATB: KPROCA TOO BIG FOR THIS RESOLUTION') |
96 |
|
|
ENDIF |
97 |
|
|
KRESTM = IMEDIA - KMEDIAP * KPROCA |
98 |
|
|
IF (KRESTM > 0) KMEDIAP = KMEDIAP + 1 |
99 |
|
|
|
100 |
|
|
! * Computation of intermediate quantities KINDIC and KLAST |
101 |
|
|
|
102 |
|
|
IF (LDSPLIT) THEN |
103 |
|
|
|
104 |
|
|
IREST = 0 |
105 |
|
|
ILAST =0 |
106 |
|
|
DO JA=1,KPROCA |
107 |
|
|
IF (JA <= KRESTM .OR. KRESTM == 0) THEN |
108 |
|
|
ICOMP = KMEDIAP |
109 |
|
|
ELSE |
110 |
|
|
ICOMP = KMEDIAP - 1 |
111 |
|
|
ENDIF |
112 |
|
|
ITOT = IREST |
113 |
|
|
IGL = ILAST+1 |
114 |
|
|
DO JGL=IGL,KDGL |
115 |
|
|
ILAST = JGL |
116 |
|
|
IF(ITOT+KLOENG(JGL) < ICOMP) THEN |
117 |
|
|
ITOT = ITOT+KLOENG(JGL) |
118 |
|
|
ELSEIF(ITOT+KLOENG(JGL) == ICOMP) THEN |
119 |
|
|
IREST = 0 |
120 |
|
|
KLAST(JA) = JGL |
121 |
|
|
KINDIC(JA) = 0 |
122 |
|
|
EXIT |
123 |
|
|
ELSE |
124 |
|
|
IREST = KLOENG(JGL) -(ICOMP-ITOT) |
125 |
|
|
KLAST(JA) = JGL |
126 |
|
|
KINDIC(JA) = JGL |
127 |
|
|
EXIT |
128 |
|
|
ENDIF |
129 |
|
|
ENDDO |
130 |
|
|
ENDDO |
131 |
|
|
|
132 |
|
|
ELSE |
133 |
|
|
|
134 |
|
|
KINDIC(:) = 0 |
135 |
|
|
|
136 |
|
|
IMAXI = KMEDIAP-1 |
137 |
|
|
IMAXIOL = HUGE(IMAXIOL) |
138 |
|
|
DO |
139 |
|
|
ILIMIT = IMAXI |
140 |
|
|
IMAXI = 0 |
141 |
|
|
IFRST = KDGL |
142 |
|
|
ILAST1(:) = 0 |
143 |
|
|
IPP1(:) = 0 |
144 |
|
|
DO JA=KPROCA,1,-1 |
145 |
|
|
IGL = IFRST |
146 |
|
|
LATS:DO JGL=IGL,1,-1 |
147 |
|
|
IF (IPP1(JA) < ILIMIT .OR. JA == 1) THEN |
148 |
|
|
IFRST = JGL-1 |
149 |
|
|
IPP1(JA) = IPP1(JA) + KLOENG(JGL) |
150 |
|
|
IF(ILAST1(JA) == 0) ILAST1(JA) = JGL |
151 |
|
|
ELSE |
152 |
|
|
EXIT LATS |
153 |
|
|
ENDIF |
154 |
|
|
ENDDO LATS |
155 |
|
|
IMAXI = MAX (IMAXI,IPP1(JA)) |
156 |
|
|
ENDDO |
157 |
|
|
IF(IMAXI >= IMAXIOL) EXIT |
158 |
|
|
KLAST(:) = ILAST1(:) |
159 |
|
|
IPP(:) = IPP1(:) |
160 |
|
|
IMAXIOL = IMAXI |
161 |
|
|
ENDDO |
162 |
|
|
|
163 |
|
|
! make the distribution more uniform |
164 |
|
|
! ---------------------------------- |
165 |
|
|
|
166 |
|
|
IFIRST(1) = 0 |
167 |
|
|
IF (KLAST(1) > 0) IFIRST(1) = 1 |
168 |
|
|
DO JA=2,KPROCA |
169 |
|
|
IF (IPP(JA) > 0) THEN |
170 |
|
|
IFIRST(JA) = KLAST(JA-1)+1 |
171 |
|
|
ELSE |
172 |
|
|
IFIRST(JA) = 0 |
173 |
|
|
ENDIF |
174 |
|
|
ENDDO |
175 |
|
|
|
176 |
|
|
LLDONE = .FALSE. |
177 |
|
|
DO WHILE( .NOT.LLDONE ) |
178 |
|
|
LLDONE = .TRUE. |
179 |
|
|
|
180 |
|
|
DO JA=1,KPROCA-1 |
181 |
|
|
IF (IPP(JA) > IPP(JA+1)) THEN |
182 |
|
|
IF (IPP(JA)-IPP(JA+1) > IPP(JA+1) + 2 *& |
183 |
|
|
&KLOENG(KLAST(JA)) -IPP(JA) ) THEN |
184 |
|
|
IPP(JA) = IPP(JA) - KLOENG(KLAST(JA)) |
185 |
|
|
IPP(JA+1) = IPP(JA+1) + KLOENG(KLAST(JA)) |
186 |
|
|
IF (KLAST(JA+1) == 0) KLAST(JA+1) = KLAST(JA) |
187 |
|
|
IFIRST(JA+1) = KLAST(JA) |
188 |
|
|
KLAST(JA) = KLAST(JA) - 1 |
189 |
|
|
IF (KLAST(JA) == 0) IFIRST(JA) = 0 |
190 |
|
|
LLDONE = .FALSE. |
191 |
|
|
ENDIF |
192 |
|
|
ELSE |
193 |
|
|
IF( IFIRST(JA+1) > 0 )THEN |
194 |
|
|
IF (IPP(JA+1)-IPP(JA) >= IPP(JA) + 2 *& |
195 |
|
|
&KLOENG(IFIRST(JA+1)) -IPP(JA+1) ) THEN |
196 |
|
|
IPP(JA) = IPP(JA) + KLOENG(IFIRST(JA+1)) |
197 |
|
|
IPP(JA+1) = IPP(JA+1) - KLOENG(IFIRST(JA+1)) |
198 |
|
|
KLAST(JA) = IFIRST(JA+1) |
199 |
|
|
IF (IFIRST(JA) == 0) IFIRST(JA) = KLAST(JA) |
200 |
|
|
IF (KLAST(JA+1) == KLAST(JA)) THEN |
201 |
|
|
KLAST(JA+1) = 0 |
202 |
|
|
IFIRST(JA+1) = 0 |
203 |
|
|
ELSE |
204 |
|
|
IFIRST(JA+1) = IFIRST(JA+1) + 1 |
205 |
|
|
ENDIF |
206 |
|
|
LLDONE = .FALSE. |
207 |
|
|
ENDIF |
208 |
|
|
ENDIF |
209 |
|
|
ENDIF |
210 |
|
|
ENDDO |
211 |
|
|
ENDDO |
212 |
|
|
|
213 |
|
|
ENDIF |
214 |
|
|
|
215 |
|
|
END SUBROUTINE SUMPLATB |
216 |
|
|
END MODULE SUMPLATB_MOD |