diff --git a/sources/io.F90 b/sources/io.F90 index b673e4a..0611dbc 100644 --- a/sources/io.F90 +++ b/sources/io.F90 @@ -1023,8 +1023,8 @@ module io integer(kind=4) :: lun = 104 integer(kind=8) :: digest, bytes, pbytes, ubytes - character(len=16) :: hfield, hchild, hface, hedge, hcorner, hbound - character(len=16) :: hids, harray, hseed, hforce + integer(kind=8) :: hfield, hchild, hface, hedge, hcorner, hbound + integer(kind=8) :: hids, hseed, hforce integer(kind=8), dimension(:) , allocatable :: hprim, hcons integer(kind=4), dimension(:) , allocatable :: ids @@ -1153,31 +1153,31 @@ module io il = index(line, 'digest="') + 8 iu = index(line(il:), '"') + il - 2 - read(line(il:iu), fmt = *) hfield + call digest_integer(line(il:iu), hfield) case('children') il = index(line, 'digest="') + 8 iu = index(line(il:), '"') + il - 2 - read(line(il:iu), fmt = *) hchild + call digest_integer(line(il:iu), hchild) case('faces') il = index(line, 'digest="') + 8 iu = index(line(il:), '"') + il - 2 - read(line(il:iu), fmt = *) hface + call digest_integer(line(il:iu), hface) case('edges') il = index(line, 'digest="') + 8 iu = index(line(il:), '"') + il - 2 - read(line(il:iu), fmt = *) hedge + call digest_integer(line(il:iu), hedge) case('corners') il = index(line, 'digest="') + 8 iu = index(line(il:), '"') + il - 2 - read(line(il:iu), fmt = *) hcorner + call digest_integer(line(il:iu), hcorner) case('bounds') il = index(line, 'digest="') + 8 iu = index(line(il:), '"') + il - 2 - read(line(il:iu), fmt = *) hbound + call digest_integer(line(il:iu), hbound) case('forcing') il = index(line, 'digest="') + 8 iu = index(line(il:), '"') + il - 2 - read(line(il:iu), fmt = *) hforce + call digest_integer(line(il:iu), hforce) end select end if end if @@ -1224,18 +1224,15 @@ module io access = 'stream') read(lun) fields close(lun) - call digest_integer(hfield, digest) - call check_digest(loc, fname, transfer(fields, 1_1, bytes), & - digest, dtype) + call check_digest(loc, fname, transfer(fields, 1_1, bytes), hfield, dtype) write(fname,"(a,'metablock_children.bin')") trim(dname) bytes = size(transfer(children, [ 0_1 ]), kind=8) open(newunit = lun, file = fname, form = 'unformatted', & access = 'stream') read(lun) children close(lun) - call digest_integer(hchild, digest) - call check_digest(loc, fname, transfer(children, 1_1, bytes), & - digest, dtype) + call check_digest(loc, fname, & + transfer(children, 1_1, bytes), hchild, dtype) #if NDIMS == 3 bytes = size(transfer(faces, [ 0_1 ]), kind=8) write(fname,"(a,'metablock_faces.bin')") trim(dname) @@ -1243,9 +1240,7 @@ module io access = 'stream') read(lun) faces close(lun) - call digest_integer(hface, digest) - call check_digest(loc, fname, transfer(faces, 1_1, bytes), & - digest, dtype) + call check_digest(loc, fname, transfer(faces, 1_1, bytes), hface, dtype) #endif /* NDIMS == 3 */ bytes = size(transfer(edges, [ 0_1 ]), kind=8) write(fname,"(a,'metablock_edges.bin')") trim(dname) @@ -1253,27 +1248,22 @@ module io access = 'stream') read(lun) edges close(lun) - call digest_integer(hedge, digest) - call check_digest(loc, fname, transfer(edges, 1_1, bytes), & - digest, dtype) + call check_digest(loc, fname, transfer(edges, 1_1, bytes), hedge, dtype) bytes = size(transfer(corners, [ 0_1 ]), kind=8) write(fname,"(a,'metablock_corners.bin')") trim(dname) open(newunit = lun, file = fname, form = 'unformatted', & access = 'stream') read(lun) corners close(lun) - call digest_integer(hcorner, digest) - call check_digest(loc, fname, transfer(corners, 1_1, bytes), & - digest, dtype) + call check_digest(loc, fname, & + transfer(corners, 1_1, bytes), hcorner, dtype) bytes = size(transfer(bounds, [ 0_1 ]), kind=8) write(fname,"(a,'metablock_bounds.bin')") trim(dname) open(newunit = lun, file = fname, form = 'unformatted', & access = 'stream') read(lun) bounds close(lun) - call digest_integer(hbound, digest) - call check_digest(loc, fname, transfer(bounds, 1_1, bytes), & - digest, dtype) + call check_digest(loc, fname, transfer(bounds, 1_1, bytes), hbound, dtype) l = 0 pmeta => list_meta @@ -1361,9 +1351,8 @@ module io access = 'stream') read(lun) fcoefs close(lun) - call digest_integer(hforce, digest) - call check_digest(loc, fname, transfer(fcoefs, 1_1, bytes), & - digest, dtype) + call check_digest(loc, fname, & + transfer(fcoefs, 1_1, bytes), hforce, dtype) end if else call print_message(loc, "The number of forcing modes does not match!") @@ -1406,15 +1395,11 @@ module io case('ids') il = index(line, 'digest="') + 8 iu = index(line(il:), '"') + il - 2 - read(line(il:iu), fmt = *) hids - case('arrays') - il = index(line, 'digest="') + 8 - iu = index(line(il:), '"') + il - 2 - read(line(il:iu), fmt = *) harray + call digest_integer(line(il:iu), hids) case('seeds') il = index(line, 'digest="') + 8 iu = index(line(il:), '"') + il - 2 - read(line(il:iu), fmt = *) hseed + call digest_integer(line(il:iu), hseed) end select if (index(sname, 'prim') > 0) then read(sname(7:), fmt = *) l @@ -1458,9 +1443,8 @@ module io access = 'stream') read(lun) ids close(lun) - call digest_integer(hids, digest) - call check_digest(loc, fname, transfer(ids, 1_1, bytes), & - digest, dtype) + call check_digest(loc, fname, & + transfer(ids, 1_1, bytes), hids, dtype) pbytes = size(transfer(array(:,:,:,:,1), [ 0_1 ]), kind=8) ubytes = size(transfer(array(:,:,:,:,:), [ 0_1 ]), kind=8) @@ -1535,9 +1519,8 @@ module io access = 'stream') read(lun) seeds close(lun) - call digest_integer(hseed, digest) - call check_digest(loc, fname, transfer(seeds, 1_1, bytes), & - digest, dtype) + call check_digest(loc, fname, & + transfer(seeds, 1_1, bytes), hseed, dtype) call set_seeds(lnseeds, seeds(:,:), .false.) if (allocated(seeds)) deallocate(seeds) @@ -1570,7 +1553,7 @@ module io case('seeds') il = index(line, 'digest="') + 8 iu = index(line(il:), '"') + il - 2 - read(line(il:iu), fmt = *) hseed + call digest_integer(line(il:iu), hseed) end select end if end if @@ -1591,9 +1574,8 @@ module io access = 'stream') read(lun) seeds close(lun) - call digest_integer(hseed, digest) - call check_digest(loc, fname, transfer(seeds, 1_1, bytes), & - digest, dtype) + call check_digest(loc, fname, & + transfer(seeds, 1_1, bytes), hseed, dtype) call set_seeds(lnseeds, seeds(:,:), .false.) if (allocated(seeds)) deallocate(seeds) @@ -1671,15 +1653,11 @@ module io case('ids') il = index(line, 'digest="') + 8 iu = index(line(il:), '"') + il - 2 - read(line(il:iu), fmt = *) hids - case('arrays') - il = index(line, 'digest="') + 8 - iu = index(line(il:), '"') + il - 2 - read(line(il:iu), fmt = *) harray + call digest_integer(line(il:iu), hids) case('seeds') il = index(line, 'digest="') + 8 iu = index(line(il:), '"') + il - 2 - read(line(il:iu), fmt = *) hseed + call digest_integer(line(il:iu), hseed) end select end if end if @@ -1712,9 +1690,8 @@ module io access = 'stream') read(lun) ids close(lun) - call digest_integer(hids, digest) - call check_digest(loc, fname, transfer(ids, 1_1, bytes), & - digest, dtype) + call check_digest(loc, fname, & + transfer(ids, 1_1, bytes), hids, dtype) bytes = size(transfer(array(:,:,:,:,1), [ 0_1 ]), kind=8) @@ -1788,9 +1765,8 @@ module io access = 'stream') read(lun) seeds close(lun) - call digest_integer(hseed, digest) - call check_digest(loc, fname, transfer(seeds, 1_1, bytes), & - digest, dtype) + call check_digest(loc, fname, & + transfer(seeds, 1_1, bytes), hseed, dtype) call set_seeds(lnseeds, seeds(:,:), .false.) if (allocated(seeds)) deallocate(seeds) @@ -1811,9 +1787,7 @@ module io access = 'stream') read(lun) seeds close(lun) - call digest_integer(hseed, digest) - call check_digest(loc, fname, transfer(seeds, 1_1, bytes), & - digest, dtype) + call check_digest(loc, fname, transfer(seeds, 1_1, bytes), hseed, dtype) call set_seeds(lnseeds, seeds(:,:), .false.) if (allocated(seeds)) deallocate(seeds)