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

Last change on this file since 555 was 1, checked in by raasch, 15 years ago

Initial repository layout and content

File size: 4.4 KB
Line 
1 PROGRAM check_pegrid
2
3!-------------------------------------------------------------------------------!
4! Beschreibung:
5! -------------
6! Ueberpruefung der Konsistenz von Prozessortopologie und gewaehlten Feldgrenzen
7!-------------------------------------------------------------------------------!
8
9    IMPLICIT NONE
10
11    CHARACTER (LEN=1) ::  char = ''
12    INTEGER ::  i, j, k, maximum_grid_level, mg_levels_x, mg_levels_y,        &
13                mg_levels_z, numprocs, numproc_sqr, nx, nxanz, ny, nyanz, nz, &
14                pdims(2)
15
16!
17!-- Prozessoranzahl abfragen
18    PRINT*, '*** Anzahl der verfuegbaren PE''s:'
19    READ (*,*)  numprocs
20
21!
22!-- Prozessortopologie bestimmen
23    numproc_sqr = SQRT( REAL( numprocs ) )
24    pdims(1)    = MAX( numproc_sqr , 1 )
25    DO  WHILE ( MOD( numprocs , pdims(1) ) /= 0 )
26       pdims(1) = pdims(1) - 1
27    ENDDO
28    pdims(2) = numprocs / pdims(1)
29
30!
31!-- Prozessortopologie ausgeben
32    PRINT*, ' '
33    PRINT*, '*** berechnetes Prozessorgitter: (',pdims(1),',',pdims(2),')'
34
35!
36!-- Evtl. Uebersteuerung der Prozessortopologie durch den Benutzer
37    PRINT*, ' '
38    PRINT*, '*** soll dieses Prozessorgitter benutzt werden? (y/n/<return>=y)'
39    READ (*,'(A1)')  char
40    IF ( char /= 'y'  .AND.  char /= 'Y'  .AND.  char /= '' )  THEN
41       DO
42          PRINT*, ' '
43          PRINT*, '*** Bitte Prozessoranzahl in x- und y-Richtung angeben:'
44          READ (*,*)  pdims(1), pdims(2)
45          IF ( pdims(1)*pdims(2) == numprocs )  EXIT
46          PRINT*, '+++ berechnete Prozessoranzahl (', pdims(1)*pdims(2), &
47                  ') stimmt nicht mit vorgegebener Anzahl'
48          PRINT*, '    (', numprocs, ') ueberein!'
49       ENDDO
50    ENDIF
51
52!
53!-- Gitterpunktanzahl abfragen
54    PRINT*, ' '
55    PRINT*, ' '
56    PRINT*, '*** bitte nx, ny und nz angeben:'
57    READ (*,*)  nx, ny, nz
58
59!
60!-- Pruefung, ob sich Gitterpunkte in x-Richtung glatt aufteilen lassen
61    IF ( MOD( nx+1 , pdims(1) ) /= 0 )  THEN
62       PRINT*,'+++ x-Richtung:  Gitterpunktanzahl (',nx+1,') ist kein ganz-'
63       PRINT*,'                 zahliges Vielfaches der Prozessoranzahl (',&
64                                &pdims(1),')'
65       STOP
66    ELSE
67       nxanz  = ( nx + 1 ) / pdims(1)
68    ENDIF
69
70!
71!-- Pruefung, ob sich Gitterpunkte in y-Richtung glatt aufteilen lassen
72    IF ( MOD( ny+1 , pdims(2) ) /= 0 )  THEN
73       PRINT*,'+++ y-Richtung:  Gitterpunktanzahl (',ny+1,') ist kein ganz-'
74       PRINT*,'                 zahliges Vielfaches der Prozessoranzahl (',&
75                                &pdims(2),')'
76       STOP
77    ELSE
78       nyanz  = ( ny + 1 ) / pdims(2)
79    ENDIF
80
81    PRINT*, ''
82    PRINT*, '*** Anzahl der Gitterpunkte in x- und y-Richtung je PE: (', &
83            nxanz,',',nyanz,')'
84
85!
86!-- Pruefen der Gitterpunktanzahl bzgl. Transposition
87    IF ( MOD( nz , pdims(1) ) /= 0 )  THEN
88       PRINT*,'+++ Transposition z --> x:'
89       PRINT*,'    nz=',nz,' ist kein ganzzahliges Vielfaches von pdims(1)=', &
90              &pdims(1)
91       PRINT*, ''
92       STOP
93    ENDIF
94    IF ( MOD( nx+1 , pdims(2) ) /= 0 )  THEN
95       PRINT*,'+++ Transposition x --> y:'
96       PRINT*,'    nx+1=',nx+1,' ist kein ganzzahliges Vielfaches von ',&
97              &'pdims(2)=',pdims(2)
98       PRINT*, ''
99       STOP
100    ENDIF
101    IF ( MOD( ny+1 , pdims(1) ) /= 0 )  THEN
102       PRINT*,'+++ Transposition y --> z:'
103       PRINT*,'    ny+1=',ny+1,' ist kein ganzzahliges Vielfaches von ',&
104              &'pdims(1)=',pdims(1)
105       PRINT*, ''
106       STOP
107    ENDIF
108
109!
110!-- Moegliche Anzahl von Gitterniveaus im Falle der Benutzung des
111!-- Mehrgitterverfahrens berechnen und die Gitterpunktanzahl des groebsten
112!-- Gitters ausgeben
113    mg_levels_x = 1
114    mg_levels_y = 1
115    mg_levels_z = 1
116
117    i = nxanz
118    DO WHILE ( MOD( i, 2 ) == 0  .AND.  i /= 2 )
119       i = i / 2
120       mg_levels_x = mg_levels_x + 1
121    ENDDO
122
123    j = nyanz
124    DO WHILE ( MOD( j, 2 ) == 0  .AND.  j /= 2 )
125       j = j / 2
126       mg_levels_y = mg_levels_y + 1
127    ENDDO
128
129    k = nz
130    DO WHILE ( MOD( k, 2 ) == 0  .AND.  k /= 2 )
131       k = k / 2
132       mg_levels_z = mg_levels_z + 1
133    ENDDO
134
135    maximum_grid_level = MIN( mg_levels_x, mg_levels_y, mg_levels_z )
136    i = nxanz / 2**(maximum_grid_level-1) 
137    j = nyanz / 2**(maximum_grid_level-1)
138    k = nz    / 2**(maximum_grid_level-1)
139
140    PRINT*, '    Anzahl der moeglichen Gitterniveaus: ', maximum_grid_level
141    PRINT*, '    Anz. Gitterpunkte auf groebstem Gitter (x,y,z): (', i, ',', &
142                 j,',',k,')'
143    PRINT*, ''
144
145 END PROGRAM check_pegrid
Note: See TracBrowser for help on using the repository browser.