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