source: palm/tags/release-4.0/UTIL/find_palm_config.f90 @ 4239

Last change on this file since 4239 was 1310, checked in by raasch, 11 years ago

update of GPL copyright

  • Property svn:keywords set to Id
File size: 11.8 KB
Line 
1 PROGRAM find_palm_config
2
3!------------------------------------------------------------------------------!
4! This file is part of PALM.
5!
6! PALM is free software: you can redistribute it and/or modify it under the terms
7! of the GNU General Public License as published by the Free Software Foundation,
8! either version 3 of the License, or (at your option) any later version.
9!
10! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
13!
14! You should have received a copy of the GNU General Public License along with
15! PALM. If not, see <http://www.gnu.org/licenses/>.
16!
17! Copyright 1997-2014  Leibniz Universitaet Hannover
18!--------------------------------------------------------------------------------!
19!
20! Current revisions:
21! -----------------
22!
23! Former revisions:
24! -----------------
25! $Id: find_palm_config.f90 1310 2014-03-14 08:01:56Z suehring $
26!
27! 1046 2012-11-09 14:38:45Z maronga
28! code put under GPL (PALM 3.9)
29!
30!
31! Description:
32! -------------
33! Find possible configurations for given processor and grid point numbers
34!------------------------------------------------------------------------------!
35
36    IMPLICIT NONE
37
38    CHARACTER (LEN=1) ::  char = ''
39    INTEGER ::  count = 0, i, ii(1), j, k, maximum_grid_level, mg_levels_x, &
40                mg_levels_y, mg_levels_z, n, numprocs, numprocs_max,        &
41                numprocs_min, nx, nxanz, nx_max, nx_min, ny, nyanz, ny_max, &
42                ny_min, nz, nz_max, nz_min, pdims(2)
43    INTEGER ::  numnx(10000), numpr(10000)
44    LOGICAL ::  cubic_domain = .FALSE., found, found_once = .FALSE., &
45                one_d_decomp = .FALSE., quadratic_domain_xy = .FALSE.
46    REAL    ::  grid_ratio, grid_ratio_new, maximum_grid_ratio, tolerance, &
47                tolerance_nx, tolerance_ny, tolerance_nz
48    REAL    ::  gridratio(10000)
49
50    TYPE configuration
51       REAL               ::  grid_ratio
52       INTEGER            ::  numprocs, pdims_1, pdims_2, nx, ny, nz, nxanz, &
53                              nyanz, grid_levels, nx_mg, ny_mg, nz_mg
54    END TYPE configuration
55
56    TYPE(configuration), DIMENSION(10000) ::  config
57
58!
59!-- Ask number of processors available
60    PRINT*, '*** number of PEs available + allowed tolerance:'
61    READ (*,*)  numprocs, tolerance
62    IF ( tolerance < 0.0 )  THEN
63       numprocs_max = numprocs
64       numprocs_min = numprocs * ( 1.0 + tolerance )
65    ELSE
66       numprocs_max = numprocs * ( 1.0 + tolerance )
67       numprocs_min = numprocs * ( 1.0 - tolerance )
68    ENDIF
69
70!
71!-- Ask for 1D-decomposition
72    PRINT*, ' '
73    PRINT*, ' '
74    PRINT*, '*** shall a 1d-decomposition along x be used (y/n)?'
75    READ (*,*)  char
76    IF ( char == 'y' )  one_d_decomp = .TRUE.
77
78!
79!-- Ask for quadratic domain
80    PRINT*, ' '
81    PRINT*, ' '
82    PRINT*, '*** shall a quadratic domain along x and y be used (y/n)?'
83    READ (*,*)  char
84    IF ( char == 'y' )  THEN
85       quadratic_domain_xy = .TRUE.
86       PRINT*, ' '
87       PRINT*, ' '
88       PRINT*, '*** shall also grid points along z be equal to x and y (y/n)?'
89       READ (*,*)  char
90       IF ( char == 'y' )  cubic_domain = .TRUE.
91    ENDIF
92
93!
94!-- Read number of gridpoints in each direction
95    PRINT*, ' '
96    PRINT*, ' '
97    PRINT*, '*** please type nx + allowed tolerance:'
98    READ (*,*)  nx, tolerance_nx
99    IF ( tolerance_nx < 0.0 )  THEN
100       nx_max = nx
101       nx_min = nx * ( 1.0 + tolerance_nx )
102    ELSE
103       nx_max = nx * ( 1.0 + tolerance_nx )
104       nx_min = nx * ( 1.0 - tolerance_nx )
105    ENDIF
106    IF ( quadratic_domain_xy )  THEN
107       ny           = nx
108       tolerance_ny = tolerance_nx
109    ELSE
110       PRINT*, '*** please type ny + allowed tolerance:'
111       READ (*,*)  ny, tolerance_ny
112    ENDIF
113    IF ( tolerance_ny < 0.0 )  THEN
114       ny_max = ny
115       ny_min = ny * ( 1.0 + tolerance_ny )
116    ELSE
117       ny_max = ny * ( 1.0 + tolerance_ny )
118       ny_min = ny * ( 1.0 - tolerance_ny )
119    ENDIF
120    IF ( cubic_domain )  THEN
121       nz           = nx
122       tolerance_nz = tolerance_nx
123    ELSE
124       PRINT*, '*** please type nz + allowed tolerance:'
125       READ (*,*)  nz, tolerance_nz
126    ENDIF
127    IF ( tolerance_nz < 0.0 )  THEN
128       nz_max = nz
129       nz_min = nz * ( 1.0 + tolerance_nz )
130    ELSE
131       nz_max = nz * ( 1.0 + tolerance_nz )
132       nz_min = nz * ( 1.0 - tolerance_nz )
133    ENDIF
134
135!
136!-- Read maximum gridpoint-ratio for which results shall be printed
137    PRINT*, ' '
138    PRINT*, '*** please type maximum subdomain gridpoint-ratio'
139    PRINT*, '    ( ABS( nx_sub / ny_sub - 1.0 ) ) for which results shall be'
140    PRINT*, '    printed'
141    READ (*,*)  maximum_grid_ratio
142
143!
144!-- Loop over allowed numbers of processors
145g:  DO  n = numprocs_max, numprocs_min, -1
146
147!
148!--    Set initial configuration
149       numprocs   = n
150       pdims(1)   = numprocs + 1
151       pdims(2)   = 1
152
153!
154!--    Looking for practicable virtual processor grids
155p:     DO  WHILE ( pdims(1) > 1 )
156
157          pdims(1) = pdims(1) - 1
158
159!
160!--       Create the virtual PE-grid topology
161          IF ( MOD( numprocs , pdims(1) ) /= 0 )  THEN
162             CYCLE p
163          ELSE
164             IF ( one_d_decomp  .AND.  pdims(1) < numprocs )  CYCLE g
165          ENDIF
166          pdims(2) = numprocs / pdims(1)
167
168      xn: DO  nx = nx_min, nx_max
169!
170!--          Proof, if grid points in x-direction can be distributed without
171!--          rest to the processors in x- and y-direction
172             IF ( MOD(nx+1, pdims(1)) /= 0 .OR. &
173                  MOD(nx+1, pdims(2)) /= 0 )  CYCLE xn
174             nxanz  = ( nx + 1 ) / pdims(1)
175
176         yn: DO  ny = ny_min, ny_max
177!
178!--             Eventually exit in case of non quadratic domains
179                IF ( quadratic_domain_xy  .AND.  ny /= nx )  CYCLE yn
180!
181!--             Proof, if grid points in y-direction can be distributed without
182!--             rest to the processors in x- and y-direction
183                IF ( MOD( ny+1 , pdims(2) ) /= 0 .OR. &
184                     MOD( ny+1, pdims(1) ) /= 0 )  CYCLE yn
185                nyanz  = ( ny + 1 ) / pdims(2)
186
187                grid_ratio = ABS( REAL( nxanz ) / REAL( nyanz ) - 1.0 )
188
189            zn: DO  nz = nz_min, nz_max
190!
191!--                Eventually exit in case of non cubic domains
192                   IF ( cubic_domain  .AND.  nz /= nx )  CYCLE zn
193!
194!--                Proof, if grid points in z-direction can be distributed
195!--                without rest to the processors in x-direction
196                   IF ( MOD( nz, pdims(1) ) /= 0  .AND.  .NOT. one_d_decomp ) &
197                   THEN
198                      CYCLE zn
199                   ENDIF
200
201!
202!--                Store configuration found
203                   IF ( grid_ratio < maximum_grid_ratio )  THEN
204                      found = .TRUE.
205                      count = count + 1
206                      config(count)%grid_ratio = grid_ratio
207                      config(count)%numprocs   = numprocs
208                      config(count)%pdims_1    = pdims(1)
209                      config(count)%pdims_2    = pdims(2)
210                      config(count)%nx         = nx
211                      config(count)%ny         = ny
212                      config(count)%nz         = nz
213                      config(count)%nxanz      = nxanz
214                      config(count)%nyanz      = nyanz
215                      IF ( count == 10000 )  THEN
216                         PRINT*, '+++ more than 10000 configurations'
217                         EXIT g
218                      ENDIF
219                   ENDIF
220
221                   IF ( one_d_decomp )  CYCLE yn
222
223                ENDDO zn
224
225             ENDDO yn
226
227          ENDDO xn
228
229       ENDDO p
230
231    ENDDO g
232
233    IF ( .NOT. found )  THEN
234       PRINT*, ' '
235       PRINT*, '+++ No valid processor grid found for the given number of'
236       PRINT*, '    processors and gridpoints'
237       STOP
238    ENDIF
239
240!
241!-- Calculate number of possible grid levels and gridpoints of the coarsest grid
242!-- used by the multigrid method
243    DO  n = 1, count
244       mg_levels_x = 1
245       mg_levels_y = 1
246       mg_levels_z = 1
247
248       i =  config(n)%nxanz
249       DO WHILE ( MOD( i, 2 ) == 0  .AND.  i /= 2 )
250          i = i / 2
251          mg_levels_x = mg_levels_x + 1
252       ENDDO
253
254       j =  config(n)%nyanz
255       DO WHILE ( MOD( j, 2 ) == 0  .AND.  j /= 2 )
256          j = j / 2
257          mg_levels_y = mg_levels_y + 1
258       ENDDO
259
260       k =  config(n)%nz
261       DO WHILE ( MOD( k, 2 ) == 0  .AND.  k /= 2 )
262          k = k / 2
263          mg_levels_z = mg_levels_z + 1
264       ENDDO
265
266       maximum_grid_level = MIN( mg_levels_x, mg_levels_y, mg_levels_z )
267       config(n)%grid_levels = maximum_grid_level
268       config(n)%nx_mg = config(n)%nxanz / 2**(maximum_grid_level-1) 
269       config(n)%ny_mg = config(n)%nyanz / 2**(maximum_grid_level-1)
270       config(n)%nz_mg = config(n)%nz    / 2**(maximum_grid_level-1)
271    ENDDO
272
273!
274!-- Print the configurations computed above
275    PRINT*, ' '
276    PRINT*, ' '
277    PRINT*, '*** print out results in ascending grid-ratio order (y/n)?'
278    READ (*,*)  char
279    IF ( char == 'y' )  THEN
280       gridratio = 10000.0
281       gridratio(1:count) = config(1:count)%grid_ratio
282       WRITE ( *, * )  ' '
283       WRITE ( *, * )  'Possible configurations found:'
284       WRITE ( *, * )  'sorted in ascending grid-ratio order'
285       WRITE ( *, 100 )
286       DO
287          ii = MINLOC( gridratio )
288          i = ii(1)
289          IF ( gridratio(i) /= 10000.0 )  THEN
290             WRITE ( *, 101 ) &
291                config(i)%grid_ratio, config(i)%numprocs, config(i)%pdims_1, &
292                config(i)%pdims_2, config(i)%nx, config(i)%ny, config(i)%nz, &
293                config(i)%nxanz, config(i)%nyanz, config(i)%grid_levels,     &
294                config(i)%nx_mg, config(i)%ny_mg, config(i)%nz_mg
295             gridratio(i) = 10000.0
296          ELSE
297             EXIT
298          ENDIF
299       ENDDO
300    ENDIF
301
302    PRINT*, ' '
303    PRINT*, ' '
304    PRINT*, '*** print out results in descending PE order (y/n)?'
305    READ (*,*)  char
306    IF ( char == 'y' )  THEN
307       numpr = 0
308       numpr(1:count) = config(1:count)%numprocs
309       WRITE ( *, * )  ' '
310       WRITE ( *, * )  'Possible configurations found:'
311       WRITE ( *, * )  'sorted after number of PEs'
312       WRITE ( *, 100 )
313       DO
314          ii = MAXLOC( numpr )
315          i = ii(1)
316          IF ( numpr(i) /= 0 )  THEN
317             WRITE ( *, 101 ) &
318                config(i)%grid_ratio, config(i)%numprocs, config(i)%pdims_1, &
319                config(i)%pdims_2, config(i)%nx, config(i)%ny, config(i)%nz, &
320                config(i)%nxanz, config(i)%nyanz, config(i)%grid_levels,     &
321                config(i)%nx_mg, config(i)%ny_mg, config(i)%nz_mg
322             numpr(i) = 0
323          ELSE
324             EXIT
325          ENDIF
326       ENDDO
327    ENDIF
328
329    PRINT*, ' '
330    PRINT*, ' '
331    PRINT*, '*** print out results in descending grid size order (y/n)?'
332    READ (*,*)  char
333    IF ( char == 'y' )  THEN
334       numnx = 0
335       DO  i = 1, count
336          numnx(i) = config(i)%nx * config(i)%ny * config(i)%nz
337       ENDDO
338       WRITE ( *, * )  ' '
339       WRITE ( *, * )  'Possible configurations found:'
340       WRITE ( *, * )  'sorted after grid size'
341       WRITE ( *, 100 )
342       DO
343          ii = MAXLOC( numnx )
344          i = ii(1)
345          IF ( numnx(i) /= 0 )  THEN
346             WRITE ( *, 101 ) &
347                config(i)%grid_ratio, config(i)%numprocs, config(i)%pdims_1, &
348                config(i)%pdims_2, config(i)%nx, config(i)%ny, config(i)%nz, &
349                config(i)%nxanz, config(i)%nyanz, config(i)%grid_levels,     &
350                config(i)%nx_mg, config(i)%ny_mg, config(i)%nz_mg
351             numnx(i) = 0
352          ELSE
353             EXIT
354          ENDIF
355       ENDDO
356    ENDIF
357
358100 FORMAT('ratio  PEs   PE-grid      nx   ny   nz   subdomain  grid_levels  ', &
359           'coarsest subd.')
360101 FORMAT(F4.2,2X,I4,' (',I4,',',I4,')',2X,I4,1X,I4,1X,I4,'  (',I4,',',I4,')', &
361           5X,I2,7X,'(',I3,',',I3,',',I3,')')
362
363 END PROGRAM find_palm_config
Note: See TracBrowser for help on using the repository browser.