"Fossies" - the Fresh Open Source Software Archive

Member "netcdf-fortran-4.4.5/nf_test/tst_types2.f90" (31 Jan 2019, 8063 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_types2.f90" see the Fossies "Dox" file reference documentation.

    1 !     This is part of the netCDF package.
    2 !     Copyright 2008 University Corporation for Atmospheric Research/Unidata.
    3 !     See COPYRIGHT file for conditions of use.
    4 
    5 !     This program tests netCDF-4 int64 types from fortran 90.
    6 
    7 !     $Id: tst_types2.f90,v 1.2 2009/01/25 14:33:44 ed Exp $
    8 
    9 program tst_types2
   10   use typeSizes
   11   use netcdf
   12   implicit none
   13   
   14   ! This is the name of the data file we will create.
   15   character (len = *), parameter :: FILE_NAME = "tst_types2.nc"
   16   
   17   integer :: ncid, varid1, varid2, varid3, varid4, varid5, varid6, varid7
   18   integer :: dimid1, dimid2, dimid3, dimid4, dimid5, dimid6, dimid7
   19   integer :: dimids1(1), dimids2(2), dimids3(3), dimids4(4), dimids5(5), dimids6(6), dimids7(7)
   20   integer :: i1, i2, i3, i4, i5, i6, i7
   21   integer, parameter :: DLEN = 2
   22   integer (kind = EightByteInt) :: data1_in(DLEN), data1_out(DLEN)
   23   integer (kind = EightByteInt) :: data2_in(DLEN, DLEN), data2_out(DLEN, DLEN)
   24   integer (kind = EightByteInt) :: data3_in(DLEN, DLEN, DLEN), data3_out(DLEN, DLEN, DLEN)
   25   integer (kind = EightByteInt) :: data4_in(DLEN, DLEN, DLEN, DLEN), data4_out(DLEN, DLEN, DLEN, DLEN)
   26   integer (kind = EightByteInt) :: data5_in(DLEN, DLEN, DLEN, DLEN, DLEN), data5_out(DLEN, DLEN, DLEN, DLEN, DLEN)
   27   integer (kind = EightByteInt) :: data6_in(DLEN, DLEN, DLEN, DLEN, DLEN, DLEN), data6_out(DLEN, DLEN, DLEN, DLEN, DLEN, DLEN)
   28   integer (kind = EightByteInt) :: data7_in(DLEN, DLEN, DLEN, DLEN, DLEN, DLEN, DLEN), &
   29        data7_out(DLEN, DLEN, DLEN, DLEN, DLEN, DLEN, DLEN)
   30   integer (kind = EightByteInt), parameter :: REALLY_BIG = 9223372036854775807_EightByteInt
   31 
   32   print *, ''
   33   print *,'*** Testing netCDF-4 64-bit integer types from Fortran 90.'
   34 
   35   do i1 = 1, DLEN
   36      data1_out(i1) = REALLY_BIG
   37   end do
   38   do i2 = 1, DLEN
   39      do i1 = 1, DLEN
   40         data2_out(i1, i2) = REALLY_BIG - i1 - i2
   41      end do
   42   end do
   43   do i3 = 1, DLEN
   44      do i2 = 1, DLEN
   45         do i1 = 1, DLEN
   46            data3_out(i1, i2, i3) = REALLY_BIG - i1 - i2 - i3
   47         end do
   48      end do
   49   end do
   50   do i4 = 1, DLEN
   51      do i3 = 1, DLEN
   52         do i2 = 1, DLEN
   53            do i1 = 1, DLEN
   54               data4_out(i1, i2, i3, i4) = REALLY_BIG - i1 - i2 - i3 - i4
   55            end do
   56         end do
   57      end do
   58   end do
   59   do i5 = 1, DLEN
   60      do i4 = 1, DLEN
   61         do i3 = 1, DLEN
   62            do i2 = 1, DLEN
   63               do i1 = 1, DLEN
   64                  data5_out(i1, i2, i3, i4, i5) = REALLY_BIG - i1 - i2 - i3 - i4 - i5
   65               end do
   66            end do
   67         end do
   68      end do
   69   end do
   70   do i6 = 1, DLEN
   71      do i5 = 1, DLEN
   72         do i4 = 1, DLEN
   73            do i3 = 1, DLEN
   74               do i2 = 1, DLEN
   75                  do i1 = 1, DLEN
   76                     data6_out(i1, i2, i3, i4, i5, i6) = REALLY_BIG - i1 - i2 - i3 - i4 - i5 - i6
   77                  end do
   78               end do
   79            end do
   80         end do
   81      end do
   82   end do
   83   do i7 = 1, DLEN
   84      do i6 = 1, DLEN
   85         do i5 = 1, DLEN
   86            do i4 = 1, DLEN
   87               do i3 = 1, DLEN
   88                  do i2 = 1, DLEN
   89                     do i1 = 1, DLEN
   90                        data7_out(i1, i2, i3, i4, i5, i6, i7) = REALLY_BIG - i1 - i2 - i3 - i4 - i5 - i6 - i7
   91                     end do
   92                  end do
   93               end do
   94            end do
   95         end do
   96      end do
   97   end do
   98   
   99   ! Create the netCDF file. 
  100   call check(nf90_create(FILE_NAME, nf90_netcdf4, ncid))
  101 
  102   ! Define dimensions.
  103   call check(nf90_def_dim(ncid, "d1", DLEN, dimid1))
  104   call check(nf90_def_dim(ncid, "d2", DLEN, dimid2))
  105   call check(nf90_def_dim(ncid, "d3", DLEN, dimid3))
  106   call check(nf90_def_dim(ncid, "d4", DLEN, dimid4))
  107   call check(nf90_def_dim(ncid, "d5", DLEN, dimid5))
  108   call check(nf90_def_dim(ncid, "d6", DLEN, dimid6))
  109   call check(nf90_def_dim(ncid, "d7", DLEN, dimid7))
  110 
  111   ! Create some int64 variables, from 1 to 7D.
  112   dimids1(1) = dimid1
  113   call check(nf90_def_var(ncid, "v1", nf90_int64, dimids1, varid1))
  114   dimids2(1) = dimid1
  115   dimids2(2) = dimid2
  116   call check(nf90_def_var(ncid, "v2", nf90_int64, dimids2, varid2))
  117   dimids3(1) = dimid1
  118   dimids3(2) = dimid2
  119   dimids3(3) = dimid3
  120   call check(nf90_def_var(ncid, "v3", nf90_int64, dimids3, varid3))
  121   dimids4(1) = dimid1
  122   dimids4(2) = dimid2
  123   dimids4(3) = dimid3
  124   dimids4(4) = dimid4
  125   call check(nf90_def_var(ncid, "v4", nf90_int64, dimids4, varid4))
  126   dimids5(1) = dimid1
  127   dimids5(2) = dimid2
  128   dimids5(3) = dimid3
  129   dimids5(4) = dimid4
  130   dimids5(5) = dimid5
  131   call check(nf90_def_var(ncid, "v5", nf90_int64, dimids5, varid5))
  132   dimids6(1) = dimid1
  133   dimids6(2) = dimid2
  134   dimids6(3) = dimid3
  135   dimids6(4) = dimid4
  136   dimids6(5) = dimid5
  137   dimids6(6) = dimid6
  138   call check(nf90_def_var(ncid, "v6", nf90_int64, dimids6, varid6))
  139   dimids7(1) = dimid1
  140   dimids7(2) = dimid2
  141   dimids7(3) = dimid3
  142   dimids7(4) = dimid4
  143   dimids7(5) = dimid5
  144   dimids7(6) = dimid6
  145   dimids7(7) = dimid7
  146   call check(nf90_def_var(ncid, "v7", nf90_int64, dimids7, varid7))
  147 
  148   ! Write some large integers.
  149   call check(nf90_put_var(ncid, varid1, data1_out))
  150   call check(nf90_put_var(ncid, varid2, data2_out))
  151   call check(nf90_put_var(ncid, varid3, data3_out))
  152   call check(nf90_put_var(ncid, varid4, data4_out))
  153   call check(nf90_put_var(ncid, varid5, data5_out))
  154   call check(nf90_put_var(ncid, varid6, data6_out))
  155   call check(nf90_put_var(ncid, varid7, data7_out))
  156 
  157   ! Close the file. 
  158   call check(nf90_close(ncid))
  159 
  160   ! Reopen the netCDF file. 
  161   call check(nf90_open(FILE_NAME, 0, ncid))
  162 
  163   ! Read in the large numbers.
  164   call check(nf90_get_var(ncid, varid1, data1_in))
  165   call check(nf90_get_var(ncid, varid2, data2_in))
  166   call check(nf90_get_var(ncid, varid3, data3_in))
  167   call check(nf90_get_var(ncid, varid4, data4_in))
  168   call check(nf90_get_var(ncid, varid5, data5_in))
  169   call check(nf90_get_var(ncid, varid6, data6_in))
  170   call check(nf90_get_var(ncid, varid7, data7_in))
  171 
  172   ! Check the values for correctness.
  173   do i1 = 1, DLEN
  174      if (data1_in(i1) .ne. data1_out(i1)) stop 2
  175   end do
  176   do i2 = 1, DLEN
  177      do i1 = 1, DLEN
  178         if (data2_in(i1, i2) .ne. data2_out(i1, i2)) stop 2
  179      end do
  180   end do
  181   do i3 = 1, DLEN
  182      do i2 = 1, DLEN
  183         do i1 = 1, DLEN
  184            if (data3_in(i1, i2, i3) .ne. data3_out(i1, i2, i3)) stop 2
  185         end do
  186      end do
  187   end do
  188   do i4 = 1, DLEN
  189      do i3 = 1, DLEN
  190         do i2 = 1, DLEN
  191            do i1 = 1, DLEN
  192               if (data4_in(i1, i2, i3, i4) .ne. &
  193                    data4_out(i1, i2, i3, i4)) stop 2
  194            end do
  195         end do
  196      end do
  197   end do
  198   do i5 = 1, DLEN
  199      do i4 = 1, DLEN
  200         do i3 = 1, DLEN
  201            do i2 = 1, DLEN
  202               do i1 = 1, DLEN
  203                  if (data5_in(i1, i2, i3, i4, i5) .ne. &
  204                       data5_out(i1, i2, i3, i4, i5)) stop 2
  205               end do
  206            end do
  207         end do
  208      end do
  209   end do
  210   do i6 = 1, DLEN
  211      do i5 = 1, DLEN
  212         do i4 = 1, DLEN
  213            do i3 = 1, DLEN
  214               do i2 = 1, DLEN
  215                  do i1 = 1, DLEN
  216                     if (data6_in(i1, i2, i3, i4, i5, i6) .ne. &
  217                          data6_out(i1, i2, i3, i4, i5, i6)) stop 2
  218                  end do
  219               end do
  220            end do
  221         end do
  222      end do
  223   end do
  224   do i7 = 1, DLEN
  225      do i6 = 1, DLEN
  226         do i5 = 1, DLEN
  227            do i4 = 1, DLEN
  228               do i3 = 1, DLEN
  229                  do i2 = 1, DLEN
  230                     do i1 = 1, DLEN
  231                        if (data7_in(i1, i2, i3, i4, i5, i6, i7) .ne. &
  232                             data7_out(i1, i2, i3, i4, i5, i6, i7)) stop 2
  233                     end do
  234                  end do
  235               end do
  236            end do
  237         end do
  238      end do
  239   end do
  240 
  241   ! Close the file. 
  242   call check(nf90_close(ncid))
  243   
  244   print *,'*** SUCCESS!'
  245 
  246 !     This subroutine handles errors by printing an error message and
  247 !     exiting with a non-zero status.
  248 contains
  249   subroutine check(status)
  250     integer, intent ( in) :: status
  251     
  252     if(status /= nf90_noerr) then 
  253       print *, trim(nf90_strerror(status))
  254       stop 2
  255     end if
  256   end subroutine check  
  257 
  258 end program tst_types2
  259