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

Last change on this file since 4691 was 4481, checked in by maronga, 5 years ago

Bugfix for copyright updates in document_changes; copyright update applied to all files

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