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

Last change on this file since 1882 was 1310, checked in by raasch, 10 years ago

update of GPL copyright

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