"Fossies" - the Fresh Open Source Software Archive

Member "netcdf-fortran-4.4.5/nf_test/tst_io.f90" (31 Jan 2019, 6933 Bytes) of package /linux/misc/netcdf-fortran-4.4.5.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Fortran 90 source code syntax highlighting (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file. For more information about "tst_io.f90" see the Fossies "Dox" file reference documentation.

    1 ! Copyright 2007, UCAR/Unidata. See netcdf/COPYRIGHT file for copying
    2 ! and redistribution conditions.
    3 
    4 ! This program tests io times with large files (> 4 GB) in
    5 ! netCDF-4. This is user-contributed code.
    6 
    7 ! $Id: tst_io.f90,v 1.7 2009/02/17 13:17:18 ed Exp $
    8 program tst_io
    9   use netcdf ! access to netcdf module
   10   implicit none
   11   integer, parameter :: prsz1 = 50, prsz2 = 50, &
   12        prsz3 = 50, prsz4 = 50, repct = 10
   13   integer :: i1, i2, i3, i4, j, k, ticksPerSec
   14   real :: psr
   15   integer :: clockRate
   16   integer :: start, now, wrint1, ncint1, wrint2, ncint2, &
   17        wrint3, ncint3, iosb, iosn, size
   18   real, dimension (prsz1, prsz2, prsz3, prsz4) :: x
   19   character(len = *), parameter :: nclFilenm1 = 'tst_io1.nc', &
   20        nclFilenm2 = 'tst_io2.nc', nclFilenm3 = 'tst_io3.nc', &
   21        nclFilenm4 = 'tst_io4.nc', nclFilenm5 = 'tst_io5.nc', &
   22        nclFilenm6 = 'tst_io6.nc', nclFilenm7 = 'tst_io7.nc', &
   23        nclFilenm8 = 'tst_io8.nc', nclFilenm9 = 'tst_io9.nc', &
   24        nclFilenm10 = 'tst_io10.nc', nclFilenm11 = 'tst_io11.nc'
   25   ! needed for netcdf
   26   integer :: ncid, x1id, x2id, x3id, x4id, vrid
   27   integer :: vrids, vridt, vridu, vridv, vridw, vridx, vridy, vridz
   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)
   45 5 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
   54 1 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
   69 2 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, x, 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)
  106 3 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, x, 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);
  121 4 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, s, prsz1, prsz2, prsz3, prsz4, &
  125 !        x1id, x2id, x3id, x4id, NF90_CLOBBER, 20)
  126 !   call setupNetCDF (nclFilenm4, ncid, vridt, t, prsz1, prsz2, prsz3, prsz4, &
  127 !        x1id, x2id, x3id, x4id, NF90_CLOBBER, 30)
  128 !   call setupNetCDF (nclFilenm5, ncid, vridu, u, prsz1, prsz2, prsz3, prsz4, &
  129 !        x1id, x2id, x3id, x4id, NF90_CLOBBER, 40)
  130 !   call setupNetCDF (nclFilenm6, ncid, vridv, v, prsz1, prsz2, prsz3, prsz4, &
  131 !        x1id, x2id, x3id, x4id, NF90_CLOBBER, 50)
  132 !   call setupNetCDF (nclFilenm7, ncid, vridw, w, prsz1, prsz2, prsz3, prsz4, &
  133 !        x1id, x2id, x3id, x4id, NF90_CLOBBER, 60)
  134 !   call setupNetCDF (nclFilenm8, ncid, vridx, x, prsz1, prsz2, prsz3, prsz4, &
  135 !        x1id, x2id, x3id, x4id, NF90_CLOBBER, 70)
  136 !   call setupNetCDF (nclFilenm9, ncid, vridy, y, prsz1, prsz2, prsz3, prsz4, &
  137 !        x1id, x2id, x3id, x4id, NF90_CLOBBER, 80)
  138 !   call setupNetCDF (nclFilenm10, ncid, vridz, z, 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 
  154 contains
  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, vrnam, 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     real, dimension (d1, d2, d3, d4), intent (in) :: vrnam
  172 
  173     call check (NF90_CREATE (fn, stat, nc), deb + 1)
  174     call check (NF90_DEF_DIM(nc, "d1", d1, do1), deb + 2)
  175     call check (NF90_DEF_DIM(nc, "d2", d2, do2), deb + 3)
  176     call check (NF90_DEF_DIM(nc, "d3", d3, do3), deb + 4)
  177     call check (NF90_DEF_DIM(nc, "d4", d4, do4), deb + 5)
  178 
  179     dimids = (/ do1, do2, do3, do4 /)
  180     call check (NF90_DEF_VAR(nc, "data", NF90_REAL, dimids, vr), deb + 6)
  181     call check (NF90_ENDDEF (nc), deb + 7)
  182 
  183   end subroutine setupNetCDF
  184 
  185 end program tst_io