source: palm/trunk/UTIL/compare_palm_logs.f90 @ 1046

Last change on this file since 1046 was 1046, checked in by maronga, 11 years ago

put scripts and utilities under GPL

  • Property svn:keywords set to Id
File size: 11.0 KB
Line 
1 PROGRAM compare_palm_logs
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-2012  Leibniz University Hannover
18!--------------------------------------------------------------------------------!
19!
20! Current revisions:
21! -----------------
22! code put under GPL (PALM 3.9)
23! name of data-directories are read from input
24!
25! Former revisions:
26! -----------------
27! $Id: compare_palm_logs.f90 1046 2012-11-09 14:38:45Z maronga $
28!
29! Description:
30! ------------
31! This routine compares the log files from two different PALM runs.
32!
33! This routine must be compiled with:
34! decalpha:
35!    f95 -cpp -fast -r8
36! IBM-Regatta:
37!    xlf95 -qsuffix=cpp=f90 -qrealsize=8 -q64 -qmaxmem=-1 -Q -O3
38! IMUK:
39!    ifort compare...f90 -o compare...x
40!    -cpp -axW -r8 -nbs -Vaxlib
41! NEC-SX6:
42!    sxf90 compare...f90 -o compare...x
43!    -C hopt -Wf '-A idbl4'
44!------------------------------------------------------------------------------!
45
46    IMPLICIT NONE
47
48!
49!-- Local variables
50    CHARACTER (LEN=5) ::  id_char
51    CHARACTER (LEN=80), DIMENSION(2)  ::  directory, log_message
52    CHARACTER (LEN=100), DIMENSION(2) ::  filename
53
54    INTEGER ::  count=0, i, id, i1(2), i2(2), j, j1(2), j2(2), k, k1(2), k2(2), &
55                n_err, n_files(2)
56
57    LOGICAL ::  found
58
59    REAL    ::  simtime(2)
60
61    INTEGER, DIMENSION(:,:),   ALLOCATABLE ::  array_2d_i_1, array_2d_i_2
62
63    REAL, DIMENSION(:,:),   ALLOCATABLE ::  array_2d_1, array_2d_2
64    REAL, DIMENSION(:,:,:), ALLOCATABLE ::  array_1, array_2
65
66
67!
68!-- Read the two data-directories to be compared
69    PRINT*, '*** please enter name of first data-directory:'
70    READ ( *, * )  directory(1)
71    directory(1) = TRIM( directory(1) ) // '/'
72
73    PRINT*, '*** please enter name of second data-directory:'
74    READ ( *, * )  directory(2)
75    directory(2) = TRIM( directory(2) ) // '/'
76
77!
78!-- Check, if file from PE0 exists on directory 1. Stop, if it does not exist.
79    n_files(1) = 0
80
81    WRITE (id_char,'(''_'',I4.4)')  n_files(1)
82    INQUIRE ( FILE=TRIM( directory(1) )//id_char, EXIST=found )
83!
84!-- Find out the number of files (equal to the number of PEs which
85!-- have been used in PALM) and open them
86    DO  WHILE ( found )
87
88       OPEN ( n_files(1)+100, FILE=TRIM( directory(1) )//id_char, &
89              FORM='UNFORMATTED' )
90       n_files(1) = n_files(1) + 1
91       WRITE (id_char,'(''_'',I4.4)')  n_files(1)
92       INQUIRE ( FILE=TRIM( directory(1) )//id_char, EXIST=found )
93
94    ENDDO
95
96    IF ( n_files(1) == 0 )  THEN
97       PRINT*, '+++ no file _0000 in directory "', TRIM( directory(1) ), '"'
98       STOP
99    ELSE
100       PRINT*, '*** directory "', TRIM( directory(1) ), '": ', n_files(1), &
101               ' files found'
102    ENDIF
103
104!
105!-- Same for the second directory
106    n_files(2) = 0
107
108    WRITE (id_char,'(''_'',I4.4)')  n_files(2)
109    INQUIRE ( FILE=TRIM( directory(2) )//id_char, EXIST=found )
110
111    DO  WHILE ( found )
112
113       OPEN ( n_files(2)+200, FILE=TRIM( directory(2) )//id_char, &
114              FORM='UNFORMATTED' )
115       n_files(2) = n_files(2) + 1
116       WRITE (id_char,'(''_'',I4.4)')  n_files(2)
117       INQUIRE ( FILE=TRIM( directory(2) )//id_char, EXIST=found )
118
119    ENDDO
120
121!
122!-- Number of files must be identical
123    IF ( n_files(1) /= n_files(2) )  THEN
124       PRINT*, '+++ file number mismatch'
125       PRINT*, '    ', TRIM( directory(1) ), ': ', n_files(1), ' files'
126       PRINT*, '    ', TRIM( directory(2) ), ': ', n_files(2), ' files'
127       STOP
128    ENDIF
129
130!
131!-- Compare the data file by file
132    DO  id = 0, n_files(1)-1
133
134       count = 0
135
136       WRITE (filename(1),'(A,''_'',I4.4)')  TRIM( directory(1) ), id
137       WRITE (filename(2),'(A,''_'',I4.4)')  TRIM( directory(2) ), id
138
139       PRINT*, '*** comparing files "', TRIM( filename(1) ),'" "', &
140               TRIM( filename(2) ), '"'
141       DO
142          PRINT*,' '
143          READ ( id+100, END=100 )  log_message(1)
144          PRINT*,'    --- ', TRIM( log_message(1) )
145          READ ( id+200, END=900 )  log_message(2)
146
147          IF ( TRIM( log_message(1) ) /= TRIM( log_message(2) ) )  THEN
148             PRINT*,'    +++ log message on file 2 does not match:'
149             PRINT*,'        ', TRIM( log_message(2) )
150          ENDIF
151
152          count = count + 1
153          IF ( log_message(1)(1:2) == '3d' )  THEN
154             PRINT*,'    *** reading 3d array'
155             READ ( id+100, END=901 )  simtime(1), i1(1), i2(1), j1(1), j2(1), &
156                                       k1(1), k2(1)
157             PRINT*,'        time=', simtime(1)
158             PRINT*,'        array size=(',i1(1),':',i2(1), &
159                                       ',',j1(1),':',j2(1),',',k1(1),':',k2(1),')'
160             READ ( id+200, END=902 )  simtime(2), i1(2), i2(2), j1(2), j2(2), &
161                                       k1(2), k2(2)
162             IF ( simtime(1) /= simtime(2) .OR. i1(1) /= i1(2) .OR. &
163                  i2(1) /= i2(2) .OR. j1(1) /= j1(2) .OR. j2(1) /= j2(2) .OR. &
164                  k1(1) /= k1(2) .OR. k2(1) /= k2(2) )  THEN
165                PRINT*,'    +++ time/indices on file 2 does not match:'
166                PRINT*,'        time=', simtime(2)
167                PRINT*,'        array size=(',i1(2),':', &
168                                i2(2), ',',j1(2),':',j2(2),',',k1(2),':',k2(2),')'
169                STOP
170             ENDIF
171
172             ALLOCATE( array_1(i1(1):i2(1),j1(1):j2(1),k1(1):k2(1)), &
173                       array_2(i1(2):i2(2),j1(2):j2(2),k1(2):k2(2)) )
174
175             READ ( id+100, END=903 )  array_1
176             READ ( id+200, END=904 )  array_2
177
178             n_err = 0
179loop:        DO  k = k1(1), k2(1)
180loop1:           DO  j = j1(1), j2(1)
181                   DO  i = i1(1), i2(1)
182                      IF ( array_1(i,j,k) /= array_2(i,j,k) )  THEN
183                         PRINT*,'+++ data mismatch on element (',i,',',j,',',k,')'
184                         PRINT*,'    array_1: ', array_1(i,j,k)
185                         PRINT*,'    array_2: ', array_2(i,j,k)
186                         n_err = n_err + 1
187                         IF ( n_err > 5 )  EXIT loop
188                      ENDIF
189                   ENDDO
190                ENDDO loop1
191             ENDDO loop
192
193             DEALLOCATE( array_1, array_2 )
194
195          ELSEIF ( log_message(1)(1:2) == '2d' )  THEN
196             PRINT*,'    *** reading 2d array'
197             READ ( id+100, END=901 )  simtime(1), i1(1), i2(1), j1(1), j2(1)
198             PRINT*,'        time=', simtime(1)
199             PRINT*,'        array size=(',i1(1),':',i2(1), &
200                                       ',',j1(1),':',j2(1),')'
201             READ ( id+200, END=902 )  simtime(2), i1(2), i2(2), j1(2), j2(2)
202             IF ( simtime(1) /= simtime(2) .OR. i1(1) /= i1(2) .OR. &
203                  i2(1) /= i2(2) .OR. j1(1) /= j1(2) .OR. j2(1) /= j2(2) )  THEN
204                PRINT*,'    +++ time/indices on file 2 does not match:'
205                PRINT*,'        time=', simtime(2)
206                PRINT*,'        array size=(',i1(2),':', &
207                                i2(2), ',',j1(2),':',j2(2),')'
208             ENDIF
209
210             ALLOCATE( array_2d_1(i1(1):i2(1),j1(1):j2(1)), &
211                       array_2d_2(i1(2):i2(2),j1(2):j2(2)) )
212
213             READ ( id+100, END=903 )  array_2d_1
214             READ ( id+200, END=904 )  array_2d_2
215
216             IF ( i1(1) /= i1(2) )  i1(1) = i1(2)
217             IF ( i2(1) /= i2(2) )  i2(1) = i2(2)
218             IF ( j1(1) /= j1(2) )  j1(1) = j1(2)
219             IF ( j2(1) /= j2(2) )  j2(1) = j2(2)
220
221             n_err = 0
222loop2:       DO  j = j1(1), j2(1)
223                DO  i = i1(1), i2(1)
224                   IF ( array_2d_1(i,j) /= array_2d_2(i,j) )  THEN
225                      PRINT*,'+++ data mismatch on element (',i,',',j,')'
226                      PRINT*,'    array_1: ', array_2d_1(i,j)
227                      PRINT*,'    array_2: ', array_2d_2(i,j)
228                      n_err = n_err + 1
229                      IF ( n_err > 5 )  EXIT loop2
230                   ENDIF
231                ENDDO
232             ENDDO loop2
233
234             DEALLOCATE( array_2d_1, array_2d_2 )
235
236          ELSE
237             PRINT*,'    *** reading 2d int array'
238             READ ( id+100, END=901 )  simtime(1), i1(1), i2(1), j1(1), j2(1)
239             PRINT*,'        time=', simtime(1)
240             PRINT*,'        array size=(',i1(1),':',i2(1), &
241                                       ',',j1(1),':',j2(1),')'
242             READ ( id+200, END=902 )  simtime(2), i1(2), i2(2), j1(2), j2(2)
243             IF ( simtime(1) /= simtime(2) .OR. i1(1) /= i1(2) .OR. &
244                  i2(1) /= i2(2) .OR. j1(1) /= j1(2) .OR. j2(1) /= j2(2) )  THEN
245                PRINT*,'    +++ time/indices on file 2 does not match:'
246                PRINT*,'        time=', simtime(2)
247                PRINT*,'        array size=(',i1(2),':', &
248                                i2(2), ',',j1(2),':',j2(2),')'
249             ENDIF
250
251             ALLOCATE( array_2d_i_1(i1(1):i2(1),j1(1):j2(1)), &
252                       array_2d_i_2(i1(2):i2(2),j1(2):j2(2)) )
253
254             READ ( id+100, END=903 )  array_2d_i_1
255             READ ( id+200, END=904 )  array_2d_i_2
256
257             IF ( i1(1) /= i1(2) )  i1(1) = i1(2)
258             IF ( i2(1) /= i2(2) )  i2(1) = i2(2)
259             IF ( j1(1) /= j1(2) )  j1(1) = j1(2)
260             IF ( j2(1) /= j2(2) )  j2(1) = j2(2)
261
262             n_err = 0
263loop3:       DO  j = j1(1), j2(1)
264                DO  i = i1(1), i2(1)
265                   IF ( array_2d_i_1(i,j) /= array_2d_i_2(i,j) )  THEN
266                      PRINT*,'+++ data mismatch on element (',i,',',j,')'
267                      PRINT*,'    array_1: ', array_2d_i_1(i,j)
268                      PRINT*,'    array_2: ', array_2d_i_2(i,j)
269                      n_err = n_err + 1
270                      IF ( n_err > 5 )  EXIT loop3
271                   ENDIF
272                ENDDO
273             ENDDO loop3
274
275             DEALLOCATE( array_2d_i_1, array_2d_i_2 )
276
277          ENDIF
278
279!          IF ( count > 8 )  STOP
280       ENDDO
281
282100    PRINT*, '*** end of data on file "', TRIM( filename(1) ), '"'
283       PRINT*, '*** files seem to be identical'
284       PRINT*, ' '
285    ENDDO
286
287    STOP
288
289900 PRINT*,'+++ unexpected end on file "', TRIM( filename(2) ), '"'
290    STOP
291901 PRINT*,'+++ unexpected end on file "', TRIM( filename(1) ), '"'
292    PRINT*,'    while reading indices'
293    STOP
294902 PRINT*,'+++ unexpected end on file "', TRIM( filename(2) ), '"'
295    PRINT*,'    while reading indices'
296    STOP
297903 PRINT*,'+++ unexpected end on file "', TRIM( filename(1) ), '"'
298    PRINT*,'    while reading array data'
299    STOP
300904 PRINT*,'+++ unexpected end on file "', TRIM( filename(2) ), '"'
301    PRINT*,'    while reading array data'
302    STOP
303
304 END PROGRAM compare_palm_logs
305
306
307
Note: See TracBrowser for help on using the repository browser.