1! Copyright 2007-2019, UCAR/Unidata. See netcdf/COPYRIGHT file for 2! copying and redistribution conditions. 3 4! This program tests io times with large files (> 4 GB) in 5! netCDF-4. This is user-contributed code. This test creates a bunch 6! of fort.* output files. 7 8! Ed Hartnett, 2007 9program f90tst_io 10 use netcdf ! access to netcdf module 11 implicit none 12 integer, parameter :: prsz1 = 50, prsz2 = 50, & 13 prsz3 = 50, prsz4 = 50, repct = 10 14 integer :: i1, i2, i3, i4, ticksPerSec 15 real :: psr 16 integer :: clockRate 17 integer :: start, now, wrint1, ncint1, wrint2, ncint2, & 18 wrint3, iosb, size 19 real, dimension (prsz1, prsz2, prsz3, prsz4) :: x 20 character(len = *), parameter :: nclFilenm1 = 'f90tst_io1.nc', & 21 nclFilenm2 = 'f90tst_io2.nc', nclFilenm3 = 'f90tst_io3.nc', & 22 nclFilenm4 = 'f90tst_io4.nc', nclFilenm5 = 'f90tst_io5.nc', & 23 nclFilenm6 = 'f90tst_io6.nc', nclFilenm7 = 'f90tst_io7.nc', & 24 nclFilenm8 = 'f90tst_io8.nc', nclFilenm9 = 'f90tst_io9.nc', & 25 nclFilenm10 = 'f90tst_io10.nc', nclFilenm11 = 'f90tst_io11.nc' 26 ! needed for netcdf 27 integer :: ncid, x1id, x2id, x3id, x4id, vrid 28 29 psr = 1.7/real(prsz1) 30 31 print *, "Starting data initialization." 32 size = (prsz1 * prsz2 * prsz3 * prsz4 )/ 250000 33 do i1 = 1, prsz1 34 do i2 = 1, prsz2 35 do i3 = 1, prsz3 ! Jackson Pollock it is not 36 do i4 = 1, prsz4 37 x(i1, i2, i3, i4) = sin(i1*psr)*(0.5 + cos(i2*psr))+(psr/i3)+ i4/(10.0*prsz4) 38 enddo 39 enddo 40 enddo 41 enddo 42 call system_clock(start, ticksPerSec) 43 clockRate = 1000/ticksPerSec 44 print 5, size, 1000.0/real(ticksPerSec) 455 format("Array sizes =", i4, "MB. Clock resolution = ", f6.3, " ms."/) 46 47 ! First the binary writes 48 call system_clock(start, ticksPerSec) 49 write(1, iostat = iosb) x 50 call system_clock(now) 51 wrint1 = now - start 52 call check (iosb, 1) 53 print 1, size, "MB","binary write = ", wrint1 * clockRate 541 format("Time for", i5, a, a26, i6, " msec. ") 55 56 call system_clock(start) 57 do i1 = 1, repct 58 rewind (2, iostat = iosb) 59 call check (iosb, 2) 60 write(2, iostat = iosb) x 61 call check (iosb, 3) 62 enddo 63 call system_clock(now) 64 wrint2 = now - start 65 call check (iosb, 4) 66 close(2, iostat = iosb) 67 call check (iosb, 5) 68 print 2, size, "MB", repct, " binary rewind/writes = ", wrint2 * clockRate 692 format("Time for", i5, a, i3, a23, i6," msec. ", a, i6) 70 close(1, iostat = iosb) 71 72 call system_clock(start) 73 write(13, iostat = iosb) x 74 call check (iosb, 6) 75 write(14, iostat = iosb) x 76 call check (iosb, 7) 77 write(15, iostat = iosb) x 78 call check (iosb, 8) 79 write(16, iostat = iosb) x 80 call check (iosb, 9) 81 write(17, iostat = iosb) x 82 call check (iosb, 10) 83 write(18, iostat = iosb) x 84 call check (iosb, 11) 85 write(19, iostat = iosb) x 86 call check (iosb, 12) 87 write(20, iostat = iosb) x 88 call check (iosb, 13) 89 call system_clock(now) 90 wrint3 = now - start 91 print 2, size, "MB", 8, " binary file writes = ", wrint3 * clockRate 92 do i1 = 1, 8 93 close(12 + i1, iostat = iosb) 94 call check (iosb, 14) 95 enddo 96 97 ! Next the netCDF writes 98 call setupNetCDF (nclFilenm1, ncid, vrid, prsz1, prsz2, prsz3, prsz4, & 99 x1id, x2id, x3id, x4id, NF90_CLOBBER, 20) 100 call system_clock(start) 101 call check (NF90_PUT_VAR(ncid, vrid, x), 18) 102 call system_clock(now) 103 ncint1 = now - start 104 print 3, size, "MB"," netcdf write = ", ncint1 * clockRate, & 105 real(ncint1)/real (wrint1) 1063 format("Time for", i5, a, a25, i7, " msec. Spd ratio = ", f5.2) 107 108 call check (NF90_CLOSE(ncid), 14) 109 110 call system_clock(start) 111 do i1 = 1, repct 112 call setupNetCDF (nclFilenm1, ncid, vrid, prsz1, prsz2, prsz3, prsz4, & 113 x1id, x2id, x3id, x4id, NF90_CLOBBER, 130) 114 call check (NF90_PUT_VAR(ncid, vrid, x), 23 + i1) 115 call check (NF90_CLOSE(ncid), 15) 116 enddo 117 call system_clock(now) 118 ncint2 = now - start 119 print 4, size, repct, " repeated netcdf writes = ", ncint2 * clockRate, & 120 real(ncint2)/real(wrint2); 1214 format("Time for", i5, "MB", i3, a22, i7, " msec. Spd ratio = ", f5.2) 122 123! call system_clock(start) 124! call setupNetCDF (nclFilenm3, ncid, vrids, prsz1, prsz2, prsz3, prsz4, & 125! x1id, x2id, x3id, x4id, NF90_CLOBBER, 20) 126! call setupNetCDF (nclFilenm4, ncid, vridt, prsz1, prsz2, prsz3, prsz4, & 127! x1id, x2id, x3id, x4id, NF90_CLOBBER, 30) 128! call setupNetCDF (nclFilenm5, ncid, vridu, prsz1, prsz2, prsz3, prsz4, & 129! x1id, x2id, x3id, x4id, NF90_CLOBBER, 40) 130! call setupNetCDF (nclFilenm6, ncid, vridv, prsz1, prsz2, prsz3, prsz4, & 131! x1id, x2id, x3id, x4id, NF90_CLOBBER, 50) 132! call setupNetCDF (nclFilenm7, ncid, vridw, prsz1, prsz2, prsz3, prsz4, & 133! x1id, x2id, x3id, x4id, NF90_CLOBBER, 60) 134! call setupNetCDF (nclFilenm8, ncid, vridx, prsz1, prsz2, prsz3, prsz4, & 135! x1id, x2id, x3id, x4id, NF90_CLOBBER, 70) 136! call setupNetCDF (nclFilenm9, ncid, vridy, prsz1, prsz2, prsz3, prsz4, & 137! x1id, x2id, x3id, x4id, NF90_CLOBBER, 80) 138! call setupNetCDF (nclFilenm10, ncid, vridz, prsz1, prsz2, prsz3, prsz4, & 139! x1id, x2id, x3id, x4id, NF90_CLOBBER, 90) 140! call check (NF90_PUT_VAR(ncid, vrids, s), 118) 141! call check (NF90_PUT_VAR(ncid, vridt, t), 119) 142! call check (NF90_PUT_VAR(ncid, vridu, u), 120) 143! call check (NF90_PUT_VAR(ncid, vridv, v), 121) 144! call check (NF90_PUT_VAR(ncid, vridw, w), 122) 145! call check (NF90_PUT_VAR(ncid, vridx, x), 123) 146! call check (NF90_PUT_VAR(ncid, vridy, y), 124) 147! call check (NF90_PUT_VAR(ncid, vridz, z), 125) 148! call system_clock(now) 149! ncint3 = now - start 150! call check (NF90_CLOSE(ncid), 16) 151! print 4, size, 8, " netcdf file writes = ", ncint3 * clockRate, & 152! real(ncint3)/real(wrint3); 153 154contains 155 subroutine check (st, n) ! checks the return error code 156 integer, intent (in) :: st, n 157 if ((n < 10.and.st /= 0).or.(n > 10.and.st /= NF90_noerr))then 158 print *, "I/O error at", n, " status = ", st 159 stop 2 160 endif 161 end subroutine check 162 163 subroutine setupNetCDF(fn, nc, vr, d1, d2, d3, d4, do1, do2, & 164 do3, do4, stat, deb) 165 integer, intent(in) :: d1, d2, d3, d4, stat, deb 166 integer, intent(out) :: do1, do2, do3, do4, vr 167 integer, intent(inout) :: nc 168 integer, dimension(4) :: dimids (4) 169 170 character(len = *), intent(in) :: fn 171 172 call check (NF90_CREATE (fn, stat, nc), deb + 1) 173 call check (NF90_DEF_DIM(nc, "d1", d1, do1), deb + 2) 174 call check (NF90_DEF_DIM(nc, "d2", d2, do2), deb + 3) 175 call check (NF90_DEF_DIM(nc, "d3", d3, do3), deb + 4) 176 call check (NF90_DEF_DIM(nc, "d4", d4, do4), deb + 5) 177 178 dimids = (/ do1, do2, do3, do4 /) 179 call check (NF90_DEF_VAR(nc, "data", NF90_REAL, dimids, vr), deb + 6) 180 call check (NF90_ENDDEF (nc), deb + 7) 181 182 end subroutine setupNetCDF 183 184end program f90tst_io 185