| [1] | 1 | PROGRAM compare_palm_logs |
|---|
| 2 | |
|---|
| 3 | !------------------------------------------------------------------------------! |
|---|
| [2696] | 4 | ! This file is part of the PALM model system. |
|---|
| [1046] | 5 | ! |
|---|
| [2696] | 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. |
|---|
| [1046] | 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 | ! |
|---|
| [4481] | 18 | ! Copyright 1997-2020 Leibniz Universitaet Hannover |
|---|
| [2696] | 19 | !------------------------------------------------------------------------------! |
|---|
| [1046] | 20 | ! |
|---|
| 21 | ! Current revisions: |
|---|
| [1] | 22 | ! ----------------- |
|---|
| [2716] | 23 | ! |
|---|
| 24 | ! |
|---|
| [1] | 25 | ! Former revisions: |
|---|
| 26 | ! ----------------- |
|---|
| [2716] | 27 | ! $Id: compare_palm_logs.f90 4481 2020-03-31 18:55:54Z oliver.maas $ |
|---|
| 28 | ! Corrected "Former revisions" section |
|---|
| [1] | 29 | ! |
|---|
| [2716] | 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 | ! |
|---|
| [1047] | 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 | ! |
|---|
| [1] | 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 | ! |
|---|
| [480] | 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 | ! |
|---|
| [1] | 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 |
|---|
| 190 | loop: DO k = k1(1), k2(1) |
|---|
| 191 | loop1: 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 |
|---|
| 233 | loop2: 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 |
|---|
| 274 | loop3: 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 | |
|---|
| 293 | 100 PRINT*, '*** end of data on file "', TRIM( filename(1) ), '"' |
|---|
| 294 | PRINT*, '*** files seem to be identical' |
|---|
| 295 | PRINT*, ' ' |
|---|
| 296 | ENDDO |
|---|
| 297 | |
|---|
| 298 | STOP |
|---|
| 299 | |
|---|
| 300 | 900 PRINT*,'+++ unexpected end on file "', TRIM( filename(2) ), '"' |
|---|
| 301 | STOP |
|---|
| 302 | 901 PRINT*,'+++ unexpected end on file "', TRIM( filename(1) ), '"' |
|---|
| 303 | PRINT*,' while reading indices' |
|---|
| 304 | STOP |
|---|
| 305 | 902 PRINT*,'+++ unexpected end on file "', TRIM( filename(2) ), '"' |
|---|
| 306 | PRINT*,' while reading indices' |
|---|
| 307 | STOP |
|---|
| 308 | 903 PRINT*,'+++ unexpected end on file "', TRIM( filename(1) ), '"' |
|---|
| 309 | PRINT*,' while reading array data' |
|---|
| 310 | STOP |
|---|
| 311 | 904 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 | |
|---|
