source: palm/trunk/UTIL/check_pegrid.f90 @ 2696

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

Merge of branch palm4u into trunk

  • Property svn:keywords set to Id
File size: 5.3 KB
Line 
1 PROGRAM check_pegrid
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: check_pegrid.f90 2696 2017-12-14 17:12:51Z kanani $
28!
29! 1046 2012-11-09 14:38:45Z maronga
30! code put under GPL (PALM 3.9)
31!
32! Description:
33! -------------
34! Ueberpruefung der Konsistenz von Prozessortopologie und gewaehlten Feldgrenzen
35!------------------------------------------------------------------------------!
36
37    IMPLICIT NONE
38
39    CHARACTER (LEN=1) ::  char = ''
40    INTEGER ::  i, j, k, maximum_grid_level, mg_levels_x, mg_levels_y,        &
41                mg_levels_z, numprocs, numproc_sqr, nx, nxanz, ny, nyanz, nz, &
42                pdims(2)
43
44!
45!-- Prozessoranzahl abfragen
46    PRINT*, '*** Anzahl der verfuegbaren PE''s:'
47    READ (*,*)  numprocs
48
49!
50!-- Prozessortopologie bestimmen
51    numproc_sqr = SQRT( REAL( numprocs ) )
52    pdims(1)    = MAX( numproc_sqr , 1 )
53    DO  WHILE ( MOD( numprocs , pdims(1) ) /= 0 )
54       pdims(1) = pdims(1) - 1
55    ENDDO
56    pdims(2) = numprocs / pdims(1)
57
58!
59!-- Prozessortopologie ausgeben
60    PRINT*, ' '
61    PRINT*, '*** berechnetes Prozessorgitter: (',pdims(1),',',pdims(2),')'
62
63!
64!-- Evtl. Uebersteuerung der Prozessortopologie durch den Benutzer
65    PRINT*, ' '
66    PRINT*, '*** soll dieses Prozessorgitter benutzt werden? (y/n/<return>=y)'
67    READ (*,'(A1)')  char
68    IF ( char /= 'y'  .AND.  char /= 'Y'  .AND.  char /= '' )  THEN
69       DO
70          PRINT*, ' '
71          PRINT*, '*** Bitte Prozessoranzahl in x- und y-Richtung angeben:'
72          READ (*,*)  pdims(1), pdims(2)
73          IF ( pdims(1)*pdims(2) == numprocs )  EXIT
74          PRINT*, '+++ berechnete Prozessoranzahl (', pdims(1)*pdims(2), &
75                  ') stimmt nicht mit vorgegebener Anzahl'
76          PRINT*, '    (', numprocs, ') ueberein!'
77       ENDDO
78    ENDIF
79
80!
81!-- Gitterpunktanzahl abfragen
82    PRINT*, ' '
83    PRINT*, ' '
84    PRINT*, '*** bitte nx, ny und nz angeben:'
85    READ (*,*)  nx, ny, nz
86
87!
88!-- Pruefung, ob sich Gitterpunkte in x-Richtung glatt aufteilen lassen
89    IF ( MOD( nx+1 , pdims(1) ) /= 0 )  THEN
90       PRINT*,'+++ x-Richtung:  Gitterpunktanzahl (',nx+1,') ist kein ganz-'
91       PRINT*,'                 zahliges Vielfaches der Prozessoranzahl (',&
92                                &pdims(1),')'
93       STOP
94    ELSE
95       nxanz  = ( nx + 1 ) / pdims(1)
96    ENDIF
97
98!
99!-- Pruefung, ob sich Gitterpunkte in y-Richtung glatt aufteilen lassen
100    IF ( MOD( ny+1 , pdims(2) ) /= 0 )  THEN
101       PRINT*,'+++ y-Richtung:  Gitterpunktanzahl (',ny+1,') ist kein ganz-'
102       PRINT*,'                 zahliges Vielfaches der Prozessoranzahl (',&
103                                &pdims(2),')'
104       STOP
105    ELSE
106       nyanz  = ( ny + 1 ) / pdims(2)
107    ENDIF
108
109    PRINT*, ''
110    PRINT*, '*** Anzahl der Gitterpunkte in x- und y-Richtung je PE: (', &
111            nxanz,',',nyanz,')'
112
113!
114!-- Pruefen der Gitterpunktanzahl bzgl. Transposition
115    IF ( MOD( nz , pdims(1) ) /= 0 )  THEN
116       PRINT*,'+++ Transposition z --> x:'
117       PRINT*,'    nz=',nz,' ist kein ganzzahliges Vielfaches von pdims(1)=', &
118              &pdims(1)
119       PRINT*, ''
120       STOP
121    ENDIF
122    IF ( MOD( nx+1 , pdims(2) ) /= 0 )  THEN
123       PRINT*,'+++ Transposition x --> y:'
124       PRINT*,'    nx+1=',nx+1,' ist kein ganzzahliges Vielfaches von ',&
125              &'pdims(2)=',pdims(2)
126       PRINT*, ''
127       STOP
128    ENDIF
129    IF ( MOD( ny+1 , pdims(1) ) /= 0 )  THEN
130       PRINT*,'+++ Transposition y --> z:'
131       PRINT*,'    ny+1=',ny+1,' ist kein ganzzahliges Vielfaches von ',&
132              &'pdims(1)=',pdims(1)
133       PRINT*, ''
134       STOP
135    ENDIF
136
137!
138!-- Moegliche Anzahl von Gitterniveaus im Falle der Benutzung des
139!-- Mehrgitterverfahrens berechnen und die Gitterpunktanzahl des groebsten
140!-- Gitters ausgeben
141    mg_levels_x = 1
142    mg_levels_y = 1
143    mg_levels_z = 1
144
145    i = nxanz
146    DO WHILE ( MOD( i, 2 ) == 0  .AND.  i /= 2 )
147       i = i / 2
148       mg_levels_x = mg_levels_x + 1
149    ENDDO
150
151    j = nyanz
152    DO WHILE ( MOD( j, 2 ) == 0  .AND.  j /= 2 )
153       j = j / 2
154       mg_levels_y = mg_levels_y + 1
155    ENDDO
156
157    k = nz
158    DO WHILE ( MOD( k, 2 ) == 0  .AND.  k /= 2 )
159       k = k / 2
160       mg_levels_z = mg_levels_z + 1
161    ENDDO
162
163    maximum_grid_level = MIN( mg_levels_x, mg_levels_y, mg_levels_z )
164    i = nxanz / 2**(maximum_grid_level-1) 
165    j = nyanz / 2**(maximum_grid_level-1)
166    k = nz    / 2**(maximum_grid_level-1)
167
168    PRINT*, '    Anzahl der moeglichen Gitterniveaus: ', maximum_grid_level
169    PRINT*, '    Anz. Gitterpunkte auf groebstem Gitter (x,y,z): (', i, ',', &
170                 j,',',k,')'
171    PRINT*, ''
172
173 END PROGRAM check_pegrid
Note: See TracBrowser for help on using the repository browser.