source: palm/tags/release-5.0/UTIL/find_palm_config.f90 @ 4383

Last change on this file since 4383 was 2696, checked in by kanani, 4 years ago

Merge of branch palm4u into trunk

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