"Fossies" - the Fresh Open Source Software Archive

Member "netcdf-fortran-4.4.5/nf03_test/f03test.F" (31 Jan 2019, 45089 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 77 source code syntax highlighting (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file.

    1 !********************************************************************
    2 !   Copyright 1993, UCAR/Unidata
    3 !   See netcdf/COPYRIGHT file for copying and redistribution conditions.
    4 !   $Id: ftest.F,v 1.11 2009/01/25 14:33:45 ed Exp $
    5 !********************************************************************
    6 
    7 #include "nfconfig.inc"
    8 
    9 !
   10 !     program to test the netCDF-2 Fortran API
   11 !
   12       program ftest
   13 
   14       use netcdf_f03
   15 
   16 !     name of first test cdf
   17       character*31 name
   18 !     name of second test cdf
   19       character*31 name2
   20       
   21 !     Returned error code.
   22       integer iret 
   23 !     netCDF ID
   24       integer ncid
   25 !     ID of dimension lat
   26       integer  latdim
   27 !     ID of dimension lon
   28       integer londim
   29 !     ID of dimension level
   30       integer leveldim
   31 !     ID of dimension time
   32       integer timedim
   33 !     ID of dimension len
   34       integer lendim
   35 
   36 !     Count the errors.
   37       integer nfails
   38 
   39 !     variable used to control error-handling behavior
   40       integer ncopts
   41       integer dimsiz(MAXNCDIM)
   42 !      allowable roundoff 
   43       common /dims/timedim, latdim, londim, leveldim, lendim,
   44      + dimsiz
   45       data name/'test.nc'/
   46       data name2/'copy.nc'/
   47 
   48       print *, ''
   49       print *,'*** Testing netCDF-2 Fortran 77 API.'
   50 
   51 100   format(' *** testing ', a, ' ...')
   52 !     set error-handling to verbose and non-fatal
   53       ncopts = NCVERBOS
   54       call ncpopt(ncopts)
   55 
   56 !     This will be a count of how many failures we experience.
   57       nfails = 0
   58 
   59 !     create a netCDF named 'test.nc'
   60       write(*,100) 'nccre'
   61       ncid = nccre(name, NCCLOB, iret)
   62       if (ncid .eq. -1) then nfails = nfails + 1
   63 
   64 !     test ncddef
   65       write(*,100) 'ncddef'
   66       call tncddef(ncid, nfails)
   67 
   68 !     test ncvdef
   69       write(*,100) 'ncvdef'
   70       call tncvdef(ncid, nfails)
   71 
   72 !     test ncapt
   73       write(*, 100) 'ncapt, ncaptc'
   74       call tncapt(ncid, nfails)
   75 
   76 !     close 'test.nc'
   77       write(*, 100) 'ncclos'
   78       call ncclos(ncid, iret)
   79       if (ncid .eq. -1) then nfails = nfails + 1
   80 
   81 !     test ncvpt1
   82       write(*, 100) 'ncvpt1'
   83       call tncvpt1(name, nfails)
   84 
   85 !     test ncvgt1
   86       write(*, 100) 'ncvgt1'
   87       call tncvgt1(name, nfails)
   88 
   89 !     test ncvpt
   90       write(*, 100) 'ncvpt'
   91       call tncvpt(name, nfails)
   92 
   93 !     test ncinq
   94       write(*, 100) 'ncopn, ncinq, ncdinq, ncvinq, ncanam, ncainq'
   95       call tncinq(name, nfails)
   96 
   97 !     test ncvgt
   98       write(*, 100) 'ncvgt, ncvgtc'
   99       call tncvgt(name, nfails)
  100 
  101 !     test ncagt
  102       write(*, 100) 'ncagt, ncagtc'
  103       call tncagt(name, nfails)
  104 
  105 !     test ncredf
  106       write(*, 100) 'ncredf, ncdren, ncvren, ncaren, ncendf'
  107       call tncredf(name, nfails)
  108 
  109       call tncinq(name, nfails)
  110 
  111 !     test ncacpy
  112       write(*, 100) 'ncacpy'
  113       call tncacpy(name, name2, nfails)
  114 
  115 !     test ncadel
  116       write(*, 100) 'ncadel'
  117       call tncadel(name2, nfails)
  118 
  119 !     test fill values
  120       write(*, 100) 'fill values'
  121       call tfills(nfails)
  122 
  123       print *,'Total number of failures: ', nfails
  124       if (nfails .ne. 0) stop 2
  125 
  126       print *,'*** SUCCESS!'
  127 
  128       end
  129 !
  130 !     subroutine to test ncacpy
  131 !
  132       subroutine tncacpy(iname, oname, nfails)
  133       use netcdf_f03
  134       character*31 iname, oname
  135       integer ndims, nvars, natts, recdim, iret
  136       character*31 vname, attnam
  137       integer attype, attlen
  138       integer vartyp, nvdims, vdims(MAXVDIMS), nvatts
  139       integer lenstr
  140 !     existing netCDF id
  141       integer incdf
  142 !     netCDF id of the output netCDF file to which the attribute
  143 !     will be copied
  144       integer outcdf
  145 
  146       integer mattlen
  147       parameter (mattlen = 80)
  148       character*80 charval
  149       doubleprecision doubval(2)
  150       real flval(2)
  151       integer lngval(2)
  152       NCSHORT_T shval(2)
  153       integer i, j, k
  154       character*31 varnam, attname(2,7), gattnam(2)
  155       NCBYTE_T bytval(2)
  156       common /atts/attname, gattnam
  157       NCSHORT_T svalidrg(2)
  158       real rvalidrg(2)
  159       integer lvalidrg(2)
  160       doubleprecision dvalidrg(2)
  161       NCBYTE_T bvalidrg(2)
  162       character*31 gavalue(2), cavalue(2)
  163       real epsilon
  164 
  165       data bvalidrg/-127,127/
  166       data svalidrg/-100,100/
  167       data lvalidrg/0,360/
  168       data rvalidrg/0.0, 5000.0/
  169       data dvalidrg/0D0,500D0/
  170       data gavalue/'NWS', '88/10/25 12:00:00'/
  171       data cavalue/'test string', 'a'/
  172       data lenstr/80/   
  173       data epsilon /.000001/
  174 
  175       incdf = ncopn(iname, NCNOWRIT, iret)
  176       if (iret .ne. 0) nfails = nfails + 1
  177 
  178       outcdf = nccre(oname, NCCLOB, iret)
  179       if (iret .ne. 0) nfails = nfails + 1
  180 
  181       call tncddef(outcdf, nfails)
  182       call tncvdef(outcdf, nfails)
  183       call ncinq (incdf, ndims, nvars, natts, recdim, iret)
  184       if (iret .ne. 0) nfails = nfails + 1
  185       do 5 j = 1, natts
  186          call ncanam (incdf, NCGLOBAL, j, attnam, iret)
  187          if (iret .ne. 0) nfails = nfails + 1
  188          call ncacpy (incdf, NCGLOBAL, attnam, outcdf, NCGLOBAL, iret)
  189          if (iret .ne. 0) nfails = nfails + 1
  190  5    continue
  191       do 10 i = 1, nvars
  192          call ncvinq (incdf, i, vname, vartyp, nvdims,
  193      +        vdims, nvatts, iret)
  194          if (iret .ne. 0) nfails = nfails + 1
  195          do 20 k = 1, nvatts
  196             call ncanam (incdf, i, k, attnam, iret)
  197             if (iret .ne. 0) nfails = nfails + 1
  198             call ncacpy (incdf, i, attnam, outcdf, i, iret)
  199             if (iret .ne. 0) nfails = nfails + 1
  200  20      continue
  201  10   continue
  202 !     
  203 !     get global attributes first
  204 !     
  205       do 100 i = 1, natts
  206          call ncanam (outcdf, NCGLOBAL, i, attnam, iret)
  207          if (iret .ne. 0) nfails = nfails + 1
  208          call ncainq (outcdf, NCGLOBAL, attnam, attype, attlen,
  209      +        iret)
  210          if (iret .ne. 0) nfails = nfails + 1
  211          if (attlen .gt. mattlen) then
  212             write (*,*) 'global attribute too big!', attlen, mattlen
  213             stop 2
  214          else if (attype .eq. NCBYTE) then
  215             call ncagt (outcdf, NCBYTE, attnam, bytval, iret)
  216             if (iret .ne. 0) nfails = nfails + 1
  217          else if (attype .eq. NCCHAR) then
  218             call ncagtc (outcdf, NCGLOBAL, attnam, charval, 
  219      +           lenstr, iret)
  220             if (iret .ne. 0) nfails = nfails + 1
  221             if (attnam .ne. gattnam(i)) write(*,*) 'error in ncagt G'
  222             if (charval .ne. gavalue(i))
  223      + write(*,*) 'error in ncagt G2', lenstr, charval, gavalue(i)
  224                   charval = ' '
  225          else if (attype .eq. NCSHORT) then
  226             call ncagt (outcdf, NCGLOBAL, attnam, shval, iret)
  227             if (iret .ne. 0) nfails = nfails + 1
  228          else if (attype .eq. NCLONG) then
  229             call ncagt (outcdf, NCGLOBAL, attnam, lngval, iret)            
  230             if (iret .ne. 0) nfails = nfails + 1
  231          else if (attype .eq. NCFLOAT) then
  232             call ncagt (outcdf, NCGLOBAL, attnam, flval, iret)
  233             if (iret .ne. 0) nfails = nfails + 1
  234          else 
  235             call ncagt (outcdf, NCGLOBAL, attnam, doubval,iret)          
  236             if (iret .ne. 0) nfails = nfails + 1
  237          end if
  238  100   continue
  239 !
  240 !     get variable attributes
  241 !
  242       do 200 i = 1, nvars
  243          call ncvinq (outcdf, i, varnam, vartyp, nvdims, vdims,
  244      +                nvatts, iret)
  245          if (iret .ne. 0) nfails = nfails + 1
  246          do 250 j = 1, nvatts
  247             call ncanam (outcdf, i, j, attnam, iret)
  248             if (iret .ne. 0) nfails = nfails + 1
  249             call ncainq (outcdf, i, attnam, attype, attlen,
  250      +                   iret)
  251             if (iret .ne. 0) nfails = nfails + 1
  252             if (attlen .gt. mattlen) then
  253                write (*,*) 'variable ', i,  'attribute too big !'
  254                stop 2
  255             else 
  256                if (attype .eq. NCBYTE) then
  257                   call ncagt (outcdf, i, attnam, bytval, 
  258      +                 iret)
  259                   if (iret .ne. 0) nfails = nfails + 1
  260                   if (attnam .ne. attname(j,i))
  261      +               write(*,*) 'error in ncagt BYTE N'
  262                   if (bytval(j) .ne. bvalidrg(j)) write(*,*)
  263      + 'ncacpy: byte ', bytval(j), ' .ne. ', bvalidrg(j)
  264                else if (attype .eq. NCCHAR) then
  265                   call ncagtc (outcdf, i, attnam, charval, 
  266      +                 lenstr, iret)
  267                   if (iret .ne. 0) nfails = nfails + 1
  268                   if (attnam .ne. attname(j,i)) 
  269      +               write(*,*) 'error in ncagt CHAR N'
  270                   if (charval .ne. cavalue(j)) 
  271      +               write(*,*) 'error in ncagt'
  272                   charval = ' '
  273                else if (attype .eq. NCSHORT) then
  274                   call ncagt (outcdf, i, attnam, shval, 
  275      +                 iret)  
  276                   if (iret .ne. 0) nfails = nfails + 1
  277                   if (attnam .ne. attname(j,i)) 
  278      +               write(*,*) 'error in ncagt SHORT N'
  279                   if (shval(j) .ne. svalidrg(j)) then
  280                      write(*,*) 'error in ncagt SHORT'
  281                   end if
  282                else if (attype .eq. NCLONG) then
  283                   call ncagt (outcdf, i, attnam, lngval, 
  284      +                 iret)
  285                   if (iret .ne. 0) nfails = nfails + 1
  286                   if (attnam .ne. attname(j,i)) 
  287      +               write(*,*) 'error in ncagt LONG N'
  288                   if (lngval(j) .ne. lvalidrg(j)) 
  289      +               write(*,*) 'error in ncagt LONG'
  290                else if (attype .eq. NCFLOAT) then
  291                   call ncagt (outcdf, i, attnam, flval, 
  292      +                 iret)            
  293                   if (iret .ne. 0) nfails = nfails + 1
  294                   if (attnam .ne. attname(j,i)) 
  295      +               write(*,*) 'error in ncagt FLOAT N'
  296                   if (flval(j) .ne. rvalidrg(j)) 
  297      +               write(*,*) 'error in ncagt FLOAT'
  298                else if (attype .eq. NCDOUBLE) then
  299                   call ncagt (outcdf, i, attnam, doubval,
  300      +                 iret)          
  301                   if (iret .ne. 0) nfails = nfails + 1
  302                   if (attnam .ne. attname(j,i)) 
  303      +               write(*,*) 'error in ncagt DOUBLE N'
  304                   if ( abs(doubval(j) - dvalidrg(j)) .gt. epsilon)
  305      + write(*,*) 'error in ncagt DOUBLE'
  306                end if
  307             end if
  308  250     continue
  309  200   continue
  310       call ncclos(incdf, iret)
  311       if (iret .ne. 0) nfails = nfails + 1
  312       call ncclos(outcdf, iret)
  313       if (iret .ne. 0) nfails = nfails + 1
  314       return
  315       end
  316 
  317 
  318       
  319 !     
  320 !     subroutine to test ncadel
  321 !
  322       subroutine tncadel (cdfname, nfails)
  323       use netcdf_f03
  324       character*31 cdfname
  325       
  326       integer  bid, sid, lid, fid, did, cid, chid
  327       common /vars/bid, sid, lid, fid, did, cid, chid
  328       integer ncid, iret, i, j
  329       integer ndims, nvars, natts, recdim
  330       integer vartyp, nvdims, vdims(MAXVDIMS), nvatts
  331       character*31 varnam, attnam
  332 
  333       ncid = ncopn(cdfname, NCWRITE, iret)
  334       if (iret .ne. 0) nfails = nfails + 1
  335 !     put cdf in define mode
  336       call ncredf (ncid,iret)
  337       if (iret .ne. 0) nfails = nfails + 1
  338 !     get number of global attributes
  339       call ncinq (ncid, ndims, nvars, natts, recdim, iret)
  340       if (iret .ne. 0) nfails = nfails + 1
  341       do 10 i = natts, 1, -1
  342 !     get name of global attribute
  343          call ncanam (ncid, NCGLOBAL, i, attnam, iret)
  344          if (iret .ne. 0) nfails = nfails + 1
  345 !     delete global attribute
  346          call ncadel (ncid, NCGLOBAL, attnam, iret)
  347          if (iret .ne. 0) nfails = nfails + 1
  348  10   continue
  349 
  350       do 100 i = 1, nvars
  351 !     get number of variable attributes
  352          call ncvinq (ncid, i, varnam, vartyp, nvdims, vdims,
  353      +        nvatts, iret)
  354          if (iret .ne. 0) nfails = nfails + 1
  355          do 200 j = nvatts, 1, -1
  356             call ncanam (ncid, i, j, attnam, iret)
  357             if (iret .ne. 0) nfails = nfails + 1
  358             call ncadel (ncid, i, attnam, iret)
  359             if (iret .ne. 0) nfails = nfails + 1
  360  200     continue
  361  100  continue
  362       call ncinq (ncid, ndims, nvars, natts, recdim, iret)
  363       if (iret .ne. 0) nfails = nfails + 1
  364       if (natts .ne. 0) write(*,*) 'error in ncadel'
  365 !     put netCDF into data mode
  366       call ncendf (ncid, iret)
  367       if (iret .ne. 0) nfails = nfails + 1
  368       call ncclos (ncid, iret)
  369       if (iret .ne. 0) nfails = nfails + 1
  370       return
  371       end
  372 
  373 !
  374 !     subroutine to test ncagt and ncagtc
  375 
  376       subroutine tncagt(cdfname, nfails)
  377       use netcdf_f03
  378       character*31 cdfname
  379             
  380 !     maximum length of an attribute
  381       integer mattlen
  382       parameter (mattlen = 80)
  383       integer ncid, ndims, nvars, natts, recdim
  384       integer bid, sid, lid, fid, did, cid, chid
  385       common /vars/bid, sid, lid, fid, did, cid, chid
  386       integer i, j
  387       integer attype, attlen, lenstr, iret
  388       character*31 attnam
  389       character*80 charval
  390       doubleprecision doubval(2)
  391       real flval(2)
  392       integer lngval(2)
  393       NCSHORT_T shval(2)
  394       NCBYTE_T bytval(2)
  395       integer vartyp, nvdims, vdims(MAXVDIMS), nvatts
  396 
  397       character*31 varnam, attname(2,7), gattnam(2)
  398       common /atts/attname, gattnam
  399       NCSHORT_T svalidrg(2)
  400       real rvalidrg(2)
  401       integer lvalidrg(2)
  402       doubleprecision dvalidrg(2)
  403       NCBYTE_T bvalidrg(2)
  404       character*31 gavalue(2), cavalue(2)
  405       real epsilon
  406 
  407       data bvalidrg/-127,127/
  408       data svalidrg/-100,100/
  409       data lvalidrg/0,360/
  410       data rvalidrg/0.0, 5000.0/
  411       data dvalidrg/0D0,500D0/
  412       data gavalue/'NWS', '88/10/25 12:00:00'/
  413       data cavalue/'test string', 'a'/
  414       data lenstr/80/   
  415       data epsilon /.000001/
  416       
  417       ncid = ncopn (cdfname, NCNOWRIT, iret)
  418       if (iret .ne. 0) nfails = nfails + 1
  419       call ncinq (ncid, ndims, nvars, natts, recdim, iret)
  420       if (iret .ne. 0) nfails = nfails + 1
  421 !     
  422 !     get global attributes first
  423 !     
  424       do 10 i = 1, natts
  425 !     get name of attribute
  426          call ncanam (ncid, NCGLOBAL, i, attnam, iret)
  427          if (iret .ne. 0) nfails = nfails + 1
  428 !     get attribute type and length
  429          call ncainq (ncid, NCGLOBAL, attnam, attype, attlen,
  430      +        iret)
  431          if (iret .ne. 0) nfails = nfails + 1
  432          if (attlen .gt. mattlen) then
  433             write (*,*) 'global attribute too big!'
  434             stop 2
  435          else if (attype .eq. NCBYTE) then
  436             call ncagt (ncid, NCBYTE, attnam, bytval, iret)
  437             if (iret .ne. 0) nfails = nfails + 1
  438          else if (attype .eq. NCCHAR) then
  439             call ncagtc (ncid, NCGLOBAL, attnam, charval, 
  440      +           lenstr, iret)
  441             if (iret .ne. 0) nfails = nfails + 1
  442             if (attnam .ne. gattnam(i)) write(*,*) 'error in ncagt'
  443             if (charval .ne. gavalue(i)) write(*,*) 'error in ncagt'
  444             charval = '                                        '
  445          else if (attype .eq. NCSHORT) then
  446             call ncagt (ncid, NCGLOBAL, attnam, shval, iret) 
  447             if (iret .ne. 0) nfails = nfails + 1
  448          else if (attype .eq. NCLONG) then
  449             call ncagt (ncid, NCGLOBAL, attnam, lngval, iret)            
  450             if (iret .ne. 0) nfails = nfails + 1
  451          else if (attype .eq. NCFLOAT) then
  452             call ncagt (ncid, NCGLOBAL, attnam, flval, iret)
  453             if (iret .ne. 0) nfails = nfails + 1
  454          else 
  455             call ncagt (ncid, NCGLOBAL, attnam, doubval,iret)          
  456             if (iret .ne. 0) nfails = nfails + 1
  457          end if
  458  10   continue
  459 
  460 !
  461 !     get variable attributes
  462 !
  463       do 20 i = 1, nvars
  464          call ncvinq (ncid, i, varnam, vartyp, nvdims, vdims,
  465      +                nvatts, iret)
  466          if (iret .ne. 0) nfails = nfails + 1
  467          do 25 j = 1, nvatts
  468             call ncanam (ncid, i, j, attnam, iret)
  469             if (iret .ne. 0) nfails = nfails + 1
  470             call ncainq (ncid, i, attnam, attype, attlen,
  471      +                   iret)
  472             if (iret .ne. 0) nfails = nfails + 1
  473             if (attlen .gt. mattlen) then
  474                write (*,*) 'variable ', i,  'attribute too big !'
  475                stop 2
  476             else 
  477                if (attype .eq. NCBYTE) then
  478                   call ncagt (ncid, i, attnam, bytval, 
  479      +                 iret)
  480                   if (iret .ne. 0) nfails = nfails + 1
  481                   if (attnam .ne. attname(j,i)) 
  482      +               write(*,*) 'error in ncagt BYTE name'
  483                   if (bytval(j) .ne. bvalidrg(j)) write(*,*)
  484      + 'ncacpy: byte ', bytval(j), ' .ne. ', bvalidrg(j)
  485                else if (attype .eq. NCCHAR) then
  486                   call ncagtc (ncid, i, attnam, charval, 
  487      +                 lenstr, iret)
  488                   if (iret .ne. 0) nfails = nfails + 1
  489                   if (attnam .ne. attname(j,i)) 
  490      +               write(*,*) 'error in ncagt CHAR name'
  491                   if (charval .ne. cavalue(j)) 
  492      +               write(*,*) 'error in ncagt CHAR name'
  493                  charval = '                                        '
  494                else if (attype .eq. NCSHORT) then
  495                   call ncagt (ncid, i, attnam, shval, 
  496      +                 iret)  
  497                   if (iret .ne. 0) nfails = nfails + 1
  498                   if (attnam .ne. attname(j,i)) 
  499      +               write(*,*) 'error in ncagt SHORT name'
  500                   if (shval(j) .ne. svalidrg(j)) then
  501                      write(*,*) 'error in ncagt SHORT'
  502                   end if
  503                else if (attype .eq. NCLONG) then
  504                   call ncagt (ncid, i, attnam, lngval, 
  505      +                 iret)
  506                   if (iret .ne. 0) nfails = nfails + 1
  507                   if (attnam .ne. attname(j,i)) 
  508      +               write(*,*) 'error in ncagt LONG name'
  509                   if (lngval(j) .ne. lvalidrg(j)) 
  510      +               write(*,*) 'error in ncagt LONG'
  511                else if (attype .eq. NCFLOAT) then
  512                   call ncagt (ncid, i, attnam, flval, 
  513      +                 iret)            
  514                   if (iret .ne. 0) nfails = nfails + 1
  515                   if (attnam .ne. attname(j,i)) 
  516      +               write(*,*) 'error in ncagt FLOAT name'
  517                   if (flval(j) .ne. rvalidrg(j)) 
  518      +               write(*,*) 'error in ncagt FLOAT'
  519                else if (attype .eq. NCDOUBLE) then
  520                   call ncagt (ncid, i, attnam, doubval,
  521      +                 iret)          
  522                   if (iret .ne. 0) nfails = nfails + 1
  523                   if (attnam .ne. attname(j,i)) 
  524      +               write(*,*) 'error in ncagt DOUBLE name'
  525                   if ( abs(doubval(j) - dvalidrg(j)) .gt. epsilon)
  526      + write(*,*) 'error in ncagt DOUBLE'
  527                end if
  528             end if
  529  25      continue
  530  20   continue
  531       call ncclos(ncid, iret)
  532       if (iret .ne. 0) nfails = nfails + 1
  533       return
  534       end
  535 !
  536 !     subroutine to test ncapt
  537 !
  538       subroutine tncapt (ncid, nfails)
  539       use netcdf_f03
  540       integer ncid, iret
  541 
  542 ! attribute vectors
  543       NCSHORT_T svalidrg(2)
  544       real rvalidrg(2)
  545       integer lvalidrg(2)
  546       doubleprecision dvalidrg(2)
  547       NCBYTE_T bvalidrg(2)
  548 
  549 !     variable ids
  550       integer  bid, sid, lid, fid, did, cid, chid
  551       common /vars/bid, sid, lid, fid, did, cid, chid
  552 
  553 ! assign attributes
  554       
  555 !
  556 !     byte
  557 !
  558       
  559       bvalidrg(1) = -127
  560       bvalidrg(2) =  127
  561       call ncapt (ncid, bid, 'validrange', NCBYTE, 2,
  562      +bvalidrg, iret)
  563       if (iret .ne. 0) nfails = nfails + 1
  564 
  565 !
  566 !     short
  567 !
  568 
  569       svalidrg(1) = -100
  570       svalidrg(2) = 100
  571       call ncapt (ncid, sid, 'validrange', NCSHORT, 2, 
  572      +svalidrg, iret)
  573       if (iret .ne. 0) nfails = nfails + 1
  574 
  575 !
  576 !     long
  577 !
  578 
  579       lvalidrg(1) = 0
  580       lvalidrg(2) = 360
  581       call ncapt (ncid, lid, 'validrange', NCLONG, 2,
  582      +lvalidrg, iret)
  583       if (iret .ne. 0) nfails = nfails + 1
  584       
  585 !
  586 !     float
  587 !
  588 
  589       rvalidrg(1) = 0.0
  590       rvalidrg(2) = 5000.0
  591       call ncapt (ncid, fid, 'validrange', NCFLOAT, 2,
  592      +rvalidrg, iret)
  593       if (iret .ne. 0) nfails = nfails + 1
  594 
  595 !
  596 !     double
  597 !
  598 
  599       dvalidrg(1) = 0D0
  600       dvalidrg(2) = 500D0
  601       call ncapt (ncid, did, 'validrange', NCDOUBLE, 2,
  602      +dvalidrg, iret)
  603       if (iret .ne. 0) nfails = nfails + 1
  604 
  605 !
  606 !     global
  607 !
  608 
  609       call ncaptc (ncid, NCGLOBAL, 'source', NCCHAR, 3, 
  610      +'NWS', iret)
  611       if (iret .ne. 0) nfails = nfails + 1
  612       call ncaptc (ncid, NCGLOBAL, 'basetime', NCCHAR, 17, 
  613      +'88/10/25 12:00:00', iret)
  614       if (iret .ne. 0) nfails = nfails + 1
  615 
  616 !
  617 !     char
  618 !
  619 
  620       call ncaptc (ncid, chid, 'longname', NCCHAR, 11,
  621      +'test string', iret)
  622       if (iret .ne. 0) nfails = nfails + 1
  623 
  624       call ncaptc (ncid, chid, 'id', NCCHAR, 1,
  625      +'a', iret)
  626       if (iret .ne. 0) nfails = nfails + 1
  627 
  628       return
  629       end
  630 
  631 !
  632 !     initialize variables in labelled common blocks
  633 !
  634       block data
  635       common /cdims/ dimnam
  636       common /dims/timedim, latdim, londim, leveldim, lendim,
  637      + dimsiz
  638       common /varn/varnam
  639       common /atts/attname, gattnam
  640       integer  latdim, londim, leveldim, timedim, lendim
  641 
  642 !     should include 'netcdf.inc' for MAXNCDIM, but it has EXTERNAL
  643 !     declaration, which is not permitted in a BLOCK DATA unit.
  644 
  645       integer dimsiz(1024)
  646       character*31 dimnam(1024)
  647       character*31 varnam(7)
  648       character*31 attname(2,7)
  649       character*31 gattnam(2)
  650 
  651       data dimnam /'time', 'lat', 'lon', 'level',
  652      + 'length', 1019*'0'/
  653       data dimsiz /4, 5, 5, 4, 80, 1019*0/
  654       data varnam/'bytev', 'shortv', 'longv', 'floatv', 'doublev', 
  655      + 'chv', 'cv'/
  656       
  657       data attname/'validrange', '0', 'validrange', '0', 'validrange',
  658      + '0', 'validrange', '0', 'validrange', '0', 'longname', 'id',
  659      + '0', '0'/
  660       data gattnam/'source','basetime'/
  661       end
  662 
  663 
  664 !
  665 !     subroutine to test ncddef
  666 !
  667 
  668       subroutine tncddef(ncid, nfails)
  669       use netcdf_f03
  670       integer ncid
  671 
  672 !     sizes of dimensions of 'test.nc' and 'copy.nc'
  673       integer  ndims
  674       parameter(ndims=5)
  675 ! dimension ids
  676       integer  latdim, londim, leveldim, timedim, lendim
  677       integer iret
  678 !     function to define a netCDF dimension
  679       integer dimsiz(MAXNCDIM)
  680       character*31 dimnam(MAXNCDIM)
  681       
  682       common /dims/timedim, latdim, londim, leveldim, lendim,
  683      + dimsiz
  684       common /cdims/ dimnam
  685 
  686 ! define dimensions
  687       timedim = ncddef(ncid, dimnam(1), NCUNLIM, iret)
  688       if (iret .ne. 0) nfails = nfails + 1
  689       latdim = ncddef(ncid, dimnam(2), dimsiz(2), iret)
  690       if (iret .ne. 0) nfails = nfails + 1
  691       londim = ncddef(ncid, dimnam(3), dimsiz(3), iret)
  692       if (iret .ne. 0) nfails = nfails + 1
  693       leveldim = ncddef(ncid, dimnam(4), dimsiz(4), iret)
  694       if (iret .ne. 0) nfails = nfails + 1
  695       lendim = ncddef(ncid, dimnam(5), dimsiz(5), iret)
  696       if (iret .ne. 0) nfails = nfails + 1
  697       return
  698       end
  699 !
  700 !     subroutine to test ncinq, ncdinq, ncdid, ncvinq, ncanam
  701 !     and ncainq
  702 !
  703       subroutine tncinq(cdfname, nfails)
  704       use netcdf_f03
  705       character*31 cdfname
  706 
  707 !     netCDF id
  708       integer ncid
  709 !     returned number of dimensions
  710       integer ndims
  711 !     returned number of variables
  712       integer nvars
  713 !     returned number of global attributes
  714       integer natts
  715 !     returned id of the unlimited dimension
  716       integer recdim
  717 !     returned error code
  718       integer iret
  719 !     returned name of record dimension
  720       character*31 recnam
  721 !     returned size of record dimension
  722       integer recsiz
  723 !     loop control variables
  724       integer i, j, k
  725 !     returned size of dimension
  726       integer dsize
  727 !     returned dimension ID
  728       integer dimid
  729 !     returned dimension name
  730       character*31 dname
  731 !     returned variable name
  732       character*31 vname
  733 !     returned attribute name
  734       character*31 attnam
  735 !     returned netCDF datatype of variable
  736       integer vartyp
  737 !     returned number of variable dimensions
  738       integer nvdims
  739 !     returned number of variable attributes
  740       integer nvatts
  741 !     returned vector of nvdims dimension IDS corresponding to the
  742 !     variable dimensions
  743       integer vdims(MAXNCDIM)
  744 !     returned attribute length
  745       integer attlen
  746 !     returned attribute type
  747       integer attype
  748       character*31 dimnam(MAXNCDIM)
  749       character*31 varnam(7)
  750       character*31 attname(2,7)
  751       character*31 gattnam(2)
  752       integer vdlist(5,7), vtyp(7), vndims(7), vnatts(7)
  753       integer attyp(2,7),atlen(2,7),gattyp(2),gatlen(2)
  754       integer timedim,latdim,londim,leveldim,lendim
  755       integer dimsiz(MAXNCDIM)
  756       common /dims/timedim, latdim, londim, leveldim, lendim,
  757      + dimsiz
  758       common /varn/varnam
  759       common /atts/attname, gattnam
  760       common /cdims/ dimnam
  761 
  762       data vdlist/1,0,0,0,0,1,0,0,0,0,2,0,0,0,0,4,3,2,1,0,4,3,2,1,0,
  763      + 5,1,0,0,0,1,0,0,0,0/
  764       data vtyp/NCBYTE, NCSHORT, NCLONG, NCFLOAT, NCDOUBLE, NCCHAR,
  765      + NCCHAR/
  766       data vndims/1,1,1,4,4,2,1/
  767       data vnatts/1,1,1,1,1,2,0/
  768       data attyp/NCBYTE, 0, NCSHORT, 0, NCLONG, 0, NCFLOAT, 0,
  769      + NCDOUBLE, 0, NCCHAR, NCCHAR, 0, 0/
  770       data atlen/2,0,2,0,2,0,2,0,2,0,11,1, 0, 0/
  771       data gattyp/NCCHAR,NCCHAR/
  772       data gatlen/3,17/
  773 
  774       ncid = ncopn (cdfname, NCNOWRIT, iret)
  775       call ncinq (ncid, ndims, nvars, natts, recdim, iret)
  776       if (iret .ne. 0) nfails = nfails + 1
  777       if (ndims .ne. 5) write(*,*) 'error in ncinq or ncddef'
  778       if (nvars .ne. 7) write(*,*) 'error in ncinq or ncvdef'
  779       if (natts .ne. 2) write(*,*) 'error in ncinq or ncapt'
  780       call ncdinq (ncid, recdim, recnam, recsiz, iret)
  781       if (iret .ne. 0) nfails = nfails + 1
  782       if (recnam .ne. 'time') write(*,*) 'error: bad recdim from ncinq'
  783 !
  784 !     dimensions
  785 !
  786       do 10 i = 1, ndims
  787          call ncdinq (ncid, i, dname, dsize, iret)
  788          if (iret .ne. 0) nfails = nfails + 1
  789          if (dname .ne. dimnam(i)) 
  790      +      write(*,*) 'error in ncdinq or ncddef, dname=', dname
  791          if (dsize .ne. dimsiz(i)) 
  792      +      write(*,*) 'error in ncdinq or ncddef, dsize=',dsize
  793          dimid = ncdid (ncid, dname, iret)
  794          if (dimid .ne. i) write(*,*)
  795      +      'error in ncdinq or ncddef, dimid=', dimid
  796  10   continue
  797 !
  798 !     variables
  799 !
  800       do 30 i = 1, nvars
  801          call ncvinq (ncid, i, vname, vartyp, nvdims,
  802      +        vdims, nvatts, iret)
  803          if (iret .ne. 0) nfails = nfails + 1
  804          if (vname .ne. varnam(i)) 
  805      +      write(*,*) 'error: from ncvinq, wrong name returned: ', 
  806      +         vname, ' .ne. ', varnam(i)
  807          if (vartyp .ne. vtyp(i)) 
  808      +      write(*,*) 'error: from ncvinq, wrong type returned: ', 
  809      +         vartyp, ' .ne. ', vtyp(i)
  810          if (nvdims .ne. vndims(i)) 
  811      +      write(*,*) 'error: from ncvinq, wrong num dims returned: ', 
  812      +         vdims, ' .ne. ', vndims(i)
  813          do 35 j = 1, nvdims
  814             if (vdims(j) .ne. vdlist(j,i)) 
  815      +         write(*,*) 'error: from ncvinq wrong dimids: ',
  816      +            vdims(j), ' .ne. ', vdlist(j,i)
  817  35      continue
  818          if (nvatts .ne. vnatts(i)) 
  819      +      write(*,*) 'error in ncvinq or ncvdef'
  820 !
  821 !     attributes
  822 !
  823          do 45 k = 1, nvatts
  824             call ncanam (ncid, i, k, attnam, iret)
  825             if (iret .ne. 0) nfails = nfails + 1
  826             call ncainq (ncid, i, attnam, attype, attlen, iret)
  827             if (iret .ne. 0) nfails = nfails + 1
  828             if (attnam .ne. attname(k,i)) 
  829      +         write(*,*) 'error in ncanam or ncapt'
  830             if (attype .ne. attyp(k,i)) 
  831      +         write(*,*) 'error in ncainq or ncapt'
  832             if (attlen .ne. atlen(k,i)) 
  833      +         write(*,*) 'error in ncainq or ncapt'
  834  45      continue
  835  30   continue
  836       do 40 i = 1, natts
  837          call ncanam (ncid, NCGLOBAL, i, attnam, iret)
  838          if (iret .ne. 0) nfails = nfails + 1
  839          call ncainq (ncid, NCGLOBAL, attnam, attype, attlen, iret)
  840          if (iret .ne. 0) nfails = nfails + 1
  841          if (attnam .ne. gattnam(i)) 
  842      +      write(*,*) 'error in ncanam or ncapt'
  843          if (attype .ne. gattyp(i)) 
  844      +      write(*,*) 'error in ncainq or ncapt'
  845          if (attlen .ne. gatlen(i)) 
  846      +      write(*,*) 'error in ncainq or ncapt'
  847  40   continue
  848       call ncclos(ncid, iret)
  849       if (iret .ne. 0) nfails = nfails + 1
  850       return
  851       end
  852       
  853       
  854       
  855 !     subroutine to test ncredf, ncdren, ncvren, ncaren, and 
  856 !     ncendf
  857 
  858       subroutine tncredf(cdfname, nfails)
  859       use netcdf_f03
  860       character*31 cdfname
  861       character*31 attname(2,7)
  862       character*31 gattnam(2)
  863       common /atts/attname, gattnam
  864       common /cdims/ dimnam
  865       character*31 dimnam(MAXNCDIM)
  866       character*31 varnam(7)
  867       common /varn/varnam
  868       integer ncid, iret, latid, varid
  869 
  870       dimnam(2) = 'latitude'
  871       varnam(4) = 'realv'
  872       attname(1,6) = 'stringname'
  873       gattnam(1) = 'agency'
  874       ncid = ncopn(cdfname, NCWRITE, iret)
  875       if (iret .ne. 0) nfails = nfails + 1
  876       call ncredf(ncid, iret)
  877       if (iret .ne. 0) nfails = nfails + 1
  878       latid = ncdid(ncid, 'lat', iret)
  879       call ncdren(ncid, latid, 'latitude', iret)
  880       if (iret .ne. 0) nfails = nfails + 1
  881       varid = ncvid(ncid, 'floatv', iret)
  882       call ncvren(ncid, varid, 'realv', iret)
  883       if (iret .ne. 0) nfails = nfails + 1
  884       varid = ncvid(ncid, 'chv', iret)
  885       if (iret .ne. 0) nfails = nfails + 1
  886       call ncaren(ncid, varid, 'longname', 'stringname', iret)
  887       if (iret .ne. 0) nfails = nfails + 1
  888       call ncaren(ncid, NCGLOBAL, 'source', 'agency', iret)
  889       if (iret .ne. 0) nfails = nfails + 1
  890       call ncendf(ncid, iret)
  891       if (iret .ne. 0) nfails = nfails + 1
  892       call ncclos(ncid, iret)
  893       if (iret .ne. 0) nfails = nfails + 1
  894       return
  895       end
  896 !     
  897 !     subroutine to test ncvdef
  898 !
  899 
  900       subroutine tncvdef(ncid, nfails)
  901       use netcdf_f03
  902       integer ncid
  903 
  904 !     function to define a netCDF variable
  905       integer dimsiz(MAXNCDIM)
  906       integer  latdim, londim, leveldim, timedim, lendim
  907       common /dims/timedim, latdim, londim, leveldim, lendim, 
  908      + dimsiz
  909 
  910 ! variable ids
  911       integer  bid, sid, lid, fid, did, cid, chid
  912       common /vars/bid, sid, lid, fid, did, cid, chid
  913 
  914 ! variable shapes
  915       integer  bdims(1), fdims(4), ddims(4), ldims(1), sdims(1) 
  916       integer chdims(2), cdims(1)
  917 
  918       integer iret
  919 !
  920 ! define variables
  921 !
  922 !     byte
  923 ! 
  924       bdims(1) = timedim
  925       bid = ncvdef(ncid, 'bytev', NCBYTE, 1, bdims, iret)
  926       if (iret .ne. 0) nfails = nfails + 1
  927 !
  928 !     short
  929 !
  930       sdims(1) = timedim
  931       sid = ncvdef (ncid, 'shortv', NCSHORT, 1, sdims, iret)
  932       if (iret .ne. 0) nfails = nfails + 1
  933 !
  934 !     long
  935 !
  936       ldims(1) = latdim
  937       lid = ncvdef (ncid, 'longv', NCLONG, 1, ldims, iret)
  938       if (iret .ne. 0) nfails = nfails + 1
  939 !
  940 !     float
  941 !
  942       fdims(4) = timedim
  943       fdims(1) = leveldim
  944       fdims(2) = londim
  945       fdims(3) = latdim
  946       fid = ncvdef (ncid, 'floatv', NCFLOAT, 4, fdims, iret)
  947       if (iret .ne. 0) nfails = nfails + 1
  948 !
  949 !     double
  950 !
  951       ddims(4) = timedim
  952       ddims(1) = leveldim
  953       ddims(2) = londim
  954       ddims(3) = latdim
  955       did = ncvdef (ncid, 'doublev', NCDOUBLE, 4, ddims, iret)
  956       if (iret .ne. 0) nfails = nfails + 1
  957 !
  958 !     char
  959 !
  960       chdims(2) = timedim
  961       chdims(1) = lendim
  962       chid = ncvdef (ncid, 'chv', NCCHAR, 2, chdims, iret)
  963       if (iret .ne. 0) nfails = nfails + 1
  964 
  965       cdims(1) = timedim
  966       cid = ncvdef (ncid, 'cv', NCCHAR, 1, cdims, iret)
  967       if (iret .ne. 0) nfails = nfails + 1
  968 
  969 
  970       return
  971       end
  972 
  973 
  974 !    
  975 !     subroutine to test ncvgt and ncvgtc
  976 !
  977       subroutine tncvgt(cdfname, nfails)
  978       use netcdf_f03
  979       character*31 cdfname
  980 
  981       integer ndims, times, lats, lons, levels, lenstr
  982       parameter (times=4, lats=5, lons=5, levels=4)
  983 
  984       integer start(4), count(4)
  985       integer ncid, iret, i, m
  986       integer  latdim, londim, leveldim, timedim, lendim
  987       integer dimsiz(MAXNCDIM)
  988       common /dims/timedim, latdim, londim, leveldim, lendim,
  989      + dimsiz
  990 
  991       integer bid, sid, lid, fid, did, cid, chid
  992       common /vars/bid, sid, lid, fid, did, cid, chid
  993       integer itime, ilev, ilat, ilon
  994 
  995 !     arrays of data values to be read
  996       NCBYTE_T barray(times), byval(times)
  997       NCSHORT_T sarray(times), shval(times)
  998       integer larray(lats)
  999       real farray(levels, lats, lons, times)
 1000       doubleprecision darray(levels, lats, lons, times)
 1001 !     character array of data values to be read
 1002       character*31 string
 1003       character*31 varnam
 1004       integer nvars, natts, recdim
 1005       integer vartyp, nvdims, vdims(MAXVDIMS), nvatts
 1006 
 1007       data start/1,1,1,1/
 1008       data count/levels, lats, lons, times/
 1009       data byval /97, 98, 99, 100/
 1010       data shval /10, 11, 12, 13/
 1011 
 1012       ncid = ncopn (cdfname, NCWRITE, iret)
 1013       if (iret .ne. 0) nfails = nfails + 1
 1014 !     get number of variables in netCDF
 1015       call ncinq (ncid, ndims, nvars, natts, recdim, iret)
 1016       if (iret .ne. 0) nfails = nfails + 1
 1017       do 5 m = 1, nvars-1
 1018 !     get variable name, datatype, number of dimensions
 1019 !     vector of dimension ids, and number of variable attributes
 1020          call ncvinq (ncid, m, varnam, vartyp, nvdims, vdims,
 1021      +                nvatts, iret)
 1022          if (iret .ne. 0) nfails = nfails + 1
 1023          if (vartyp .eq. NCBYTE) then
 1024 !
 1025 !     byte
 1026 !
 1027             count(1) = times
 1028             call ncvgt (ncid, m, start, count, barray, iret)
 1029             if (iret .ne. 0) nfails = nfails + 1
 1030             do 10 i = 1, times
 1031                if (barray(i) .ne. byval(i)) then 
 1032                   write(*,*) 'ncvgt of bytes, got ', barray(i), ' .ne. '
 1033      +                       , byval(i)
 1034                end if
 1035  10         continue
 1036          else if (vartyp .eq. NCSHORT) then
 1037 !
 1038 !     short
 1039 !
 1040             count(1) = times
 1041             call ncvgt (ncid, m, start, count, sarray, iret)
 1042             if (iret .ne. 0) nfails = nfails + 1
 1043             do 20 i = 1, times
 1044                if (sarray(i) .ne. shval(i)) then 
 1045                   write(*,*) 'ncvgt of short, got ', sarray(i), ' .ne. '
 1046      +                       , shval(i)
 1047                end if
 1048  20         continue
 1049          else if (vartyp .eq. NCLONG) then
 1050 !     
 1051 !     long
 1052 !
 1053             count(1) = lats
 1054             call ncvgt (ncid, m, start, count, larray, iret)
 1055             if (iret .ne. 0) nfails = nfails + 1
 1056             do 30 i = 1, lats
 1057                if (larray(i) .ne. 1000) then 
 1058                   write(*,*) 'long error in ncvgt'
 1059                end if
 1060  30         continue
 1061          else if (vartyp .eq. NCFLOAT) then
 1062 !     
 1063 !     float
 1064 !
 1065             count(1) = levels
 1066             call ncvgt (ncid, m, start, count, farray, iret)
 1067             if (iret .ne. 0) nfails = nfails + 1
 1068             i = 0
 1069             do 40 itime = 1,times
 1070                do 41 ilon = 1, lons
 1071                   do 42 ilat = 1, lats
 1072                      do 43 ilev = 1, levels
 1073                         i = i + 1
 1074                         if (farray(ilev, ilat, ilon, itime) .ne.
 1075      + real(i)) then
 1076                            write (*,*) 'float error in ncvgt'
 1077                         end if
 1078  43         continue
 1079  42         continue
 1080  41         continue
 1081  40         continue
 1082          else if (vartyp .eq. NCDOUBLE) then
 1083 !
 1084 !     double
 1085 !
 1086             count(1) = levels
 1087             call ncvgt (ncid, m, start, count, darray, iret)
 1088             if (iret .ne. 0) nfails = nfails + 1
 1089             i = 0
 1090             do 50 itime = 1, times
 1091                do 51 ilon = 1, lons
 1092                   do 52 ilat = 1, lats
 1093                      do 53 ilev = 1, levels
 1094                         i = i + 1
 1095                         if (darray(ilev, ilat, ilon, itime) .ne.
 1096      +                       real (i)) then
 1097                            write(*,*) 'double error in ncvgt:', i,
 1098      +              darray(ilev, ilat, ilon, itime), '.ne.', 
 1099      +              real (i)
 1100                         end if
 1101  53         continue
 1102  52         continue
 1103  51         continue
 1104  50         continue
 1105          else 
 1106 !     
 1107 !     char
 1108 !
 1109             count(1) = 3
 1110             count(2) = 4
 1111             lenstr = 31
 1112             call ncvgtc (ncid, m, start, count, string, lenstr, iret)
 1113             if (iret .ne. 0) nfails = nfails + 1
 1114             if (string .ne. 'testhikin of') then 
 1115                write(*,*) 'error in ncvgt, returned string =', string
 1116             end if
 1117          end if
 1118  5    continue
 1119       call ncclos(ncid, iret)
 1120       if (iret .ne. 0) nfails = nfails + 1
 1121       return
 1122       end
 1123 
 1124       
 1125       subroutine tncvgt1(cdfname, nfails)
 1126       use netcdf_f03
 1127       character*31 cdfname
 1128 
 1129       integer ncid, iret
 1130       integer  latdim, londim, leveldim, timedim, lendim
 1131       integer dimsiz(MAXNCDIM)
 1132       common /dims/timedim, latdim, londim, leveldim, lendim,
 1133      + dimsiz
 1134 
 1135       integer bindx(1), sindx(1), lindx(1), findx(4), dindx(4), cindx(1)
 1136 
 1137       integer bid, sid, lid, fid, did, cid, chid
 1138       common /vars/bid, sid, lid, fid, did, cid, chid
 1139 
 1140       NCBYTE_T bvalue
 1141       NCSHORT_T svalue
 1142       integer lvalue
 1143       real fvalue
 1144       doubleprecision dvalue
 1145       character*1 c
 1146       real epsilon
 1147       doubleprecision onethird
 1148 
 1149       data epsilon /.000001/
 1150       data lindx/1/, bindx/1/, sindx/1/, findx/1,1,1,1/
 1151      +dindx/1,1,1,1/, cindx/1/
 1152       data onethird/0.3333333333D0/
 1153       
 1154       ncid = ncopn (cdfname, NCNOWRIT, iret)
 1155       if (iret .ne. 0) nfails = nfails + 1
 1156 !
 1157 !     test ncvgt1 for byte
 1158 !
 1159       call ncvgt1 (ncid, bid, bindx, bvalue, iret)
 1160       if (iret .ne. 0) nfails = nfails + 1
 1161       if (bvalue .ne. ichar('z')) write(*,*) 'error in ncvgt1 byte:',
 1162      + bvalue, ' .ne.', ichar('z')
 1163 !
 1164 !     test ncvgt1 for short
 1165 !
 1166       call ncvgt1 (ncid, sid, sindx, svalue, iret)
 1167       if (iret .ne. 0) nfails = nfails + 1
 1168       if (svalue .ne. 10) write(*,*) 'error in ncvgt1 short:',
 1169      + svalue, ' .ne.', 10
 1170 !     
 1171 !     test ncvgt1 for long
 1172 !
 1173       call ncvgt1 (ncid, lid, lindx, lvalue, iret)
 1174       if (iret .ne. 0) nfails = nfails + 1
 1175       if (lvalue .ne. 1000) write(*,*) 'error in ncvgt1 long:',
 1176      + lvalue,  ' .ne.', 1000
 1177 !
 1178 !     test ncvgt1 for float
 1179 !
 1180       call ncvgt1 (ncid, fid, findx, fvalue, iret)
 1181       if (iret .ne. 0) nfails = nfails + 1
 1182       if (abs(fvalue - 3.14159) .gt. epsilon) 
 1183      +   write(*,*) 'error in ncvgt 1 float:', fvalue, 
 1184      +      ' not close to', 3.14159
 1185 !
 1186 !     test ncvgt1 for double
 1187 !
 1188       call ncvgt1 (ncid, did, dindx, dvalue, iret)
 1189       if (iret .ne. 0) nfails = nfails + 1
 1190       if (abs(dvalue - onethird) .gt. epsilon) write(*,*)
 1191      + 'error in ncvgt1 double:', dvalue, ' not close to',
 1192      +     onethird
 1193 !
 1194 !     test ncvg1c for char
 1195 !
 1196       call ncvg1c (ncid, cid, cindx, c, iret)
 1197       if (iret .ne. 0) nfails = nfails + 1
 1198       if (c .ne. 'a') write(*,*) 'error in ncvg1c'
 1199       call ncclos(ncid, iret)
 1200       if (iret .ne. 0) nfails = nfails + 1
 1201       return
 1202       end
 1203 
 1204       
 1205       
 1206 !
 1207 !     subroutine to test ncvpt and ncvptc
 1208 !
 1209       subroutine tncvpt(cdfname, nfails)
 1210       use netcdf_f03
 1211       character*31 cdfname
 1212 
 1213 !     size of dimensions
 1214       integer times, lats, lons, levels
 1215       parameter (times=4, lats=5, lons=5, levels=4)
 1216 
 1217       integer ncid, iret
 1218 !     loop control variables
 1219       integer itime, ilev, ilon, ilat, i
 1220       integer  latdim, londim, leveldim, timedim, lendim
 1221       integer dimsiz(MAXNCDIM)
 1222       common /dims/timedim, latdim, londim, leveldim, lendim,
 1223      + dimsiz
 1224       integer lenstr
 1225       integer bid, sid, lid, fid, did, cid, chid
 1226       common /vars/bid, sid, lid, fid, did, cid, chid
 1227 
 1228 !     vector of integers specifying the corner of the  hypercube
 1229 !     where the first of the data values will be written
 1230       integer start(4)
 1231 !     vector of integers specifying the edge lengths from the
 1232 !     corner of the hypercube where the first of the data values
 1233 !     will be written
 1234       integer count(4)
 1235 
 1236 !     arrays of data values to be written
 1237       NCBYTE_T barray(times)
 1238       NCSHORT_T sarray(times)
 1239       integer larray(lats)
 1240       real farray(levels, lats, lons, times)
 1241       doubleprecision darray(levels, lats, lons, times)
 1242       character*31 string
 1243 
 1244       data start/1,1,1,1/
 1245       data count/levels, lats, lons, times/
 1246       data barray /97, 98, 99, 100/
 1247       data sarray /10, 11, 12, 13/
 1248 
 1249       ncid = ncopn (cdfname, NCWRITE, iret)
 1250       if (iret .ne. 0) nfails = nfails + 1
 1251 
 1252 !
 1253 !     byte
 1254 !
 1255       count(1) = times
 1256       call ncvpt (ncid, bid, start, count, barray, iret)
 1257       if (iret .ne. 0) nfails = nfails + 1
 1258 !
 1259 !     short
 1260 !
 1261       count(1) = times
 1262       call ncvpt (ncid, sid, start, count, sarray, iret)
 1263       if (iret .ne. 0) nfails = nfails + 1
 1264 !
 1265 !     long
 1266 !
 1267       do 30 i = 1,lats
 1268          larray(i) = 1000
 1269  30   continue
 1270       count(1) = lats
 1271       call ncvpt (ncid, lid, start, count, larray, iret)
 1272       if (iret .ne. 0) nfails = nfails + 1
 1273 
 1274 !
 1275 !     float
 1276 !
 1277       i = 0
 1278       do 40 itime = 1,times
 1279          do 41 ilon = 1, lons
 1280             do 42 ilat = 1, lats
 1281                do 43 ilev = 1, levels
 1282                   i = i + 1
 1283                   farray(ilev, ilat, ilon, itime) = real (i)
 1284  43   continue
 1285  42   continue
 1286  41   continue
 1287  40   continue
 1288       count(1) = levels
 1289       call ncvpt (ncid, fid, start, count, farray, iret)
 1290       if (iret .ne. 0) nfails = nfails + 1
 1291 
 1292 !
 1293 !     double
 1294 !
 1295       i = 0
 1296       do 50 itime = 1, times
 1297          do 51 ilon = 1, lons
 1298             do 52 ilat = 1, lats
 1299                do 53 ilev = 1, levels
 1300                   i = i + 1
 1301                   darray(ilev, ilat, ilon, itime) = real (i)
 1302  53   continue
 1303  52   continue
 1304  51   continue
 1305  50   continue
 1306       count(1) = levels
 1307       call ncvpt (ncid, did, start, count, darray, iret)
 1308       if (iret .ne. 0) nfails = nfails + 1
 1309 
 1310 !
 1311 !     char
 1312 !
 1313       start(1) = 1
 1314       start(2) = 1
 1315       count(1) = 4
 1316       count(2) = 4
 1317       lenstr = 31       
 1318       string = 'testthiskind of '
 1319       call ncvptc (ncid, chid,start, count, string, lenstr, iret)
 1320       if (iret .ne. 0) nfails = nfails + 1
 1321 
 1322       call ncclos(ncid, iret)
 1323       if (iret .ne. 0) nfails = nfails + 1
 1324 
 1325       return
 1326       end
 1327 
 1328 
 1329       subroutine tncvpt1(cdfname, nfails)
 1330       use netcdf_f03
 1331       character*31 cdfname
 1332 
 1333 
 1334       integer iret, ncid
 1335       integer  latdim, londim, leveldim, timedim, lendim
 1336       integer dimsiz(MAXNCDIM)
 1337       common /dims/timedim, latdim, londim, leveldim, lendim, 
 1338      + dimsiz
 1339 
 1340       integer bindx(1), sindx(1), lindx(1), findx(4), dindx(4), cindx(1)
 1341 
 1342       integer lvalue
 1343       NCSHORT_T svalue
 1344       NCBYTE_T bvalue
 1345       doubleprecision onethird
 1346       integer bid, sid, lid, fid, did, cid, chid
 1347       common /vars/bid, sid, lid, fid, did, cid, chid
 1348       data lindx/1/, bindx/1/, sindx/1/, findx/1,1,1,1/
 1349      +dindx/1,1,1,1/, cindx/1/
 1350       data lvalue /1000/
 1351       data svalue/10/
 1352       data onethird/0.3333333333D0/
 1353 
 1354       bvalue = ichar('z')
 1355       
 1356       ncid = ncopn (cdfname, NCWRITE, iret)
 1357       if (iret .ne. 0) nfails = nfails + 1
 1358 
 1359 !
 1360 !     test ncvpt1 for byte
 1361 !
 1362       call ncvpt1 (ncid, bid, bindx, bvalue, iret)
 1363       if (iret .ne. 0) nfails = nfails + 1
 1364 
 1365 !
 1366 !     test ncvpt1 for short
 1367 !
 1368       call ncvpt1 (ncid, sid, sindx, svalue, iret)
 1369       if (iret .ne. 0) nfails = nfails + 1
 1370 
 1371 !     
 1372 !     test ncvpt1 for long
 1373 !
 1374       call ncvpt1 (ncid, lid, lindx, lvalue, iret)
 1375       if (iret .ne. 0) nfails = nfails + 1
 1376 
 1377 !
 1378 !     test ncvpt1 for float
 1379 !
 1380       call ncvpt1 (ncid, fid, findx, 3.14159, iret)
 1381       if (iret .ne. 0) nfails = nfails + 1
 1382 
 1383 !
 1384 !     test ncvpt1 for double
 1385 !
 1386       call ncvpt1 (ncid, did, dindx, onethird, iret)
 1387       if (iret .ne. 0) nfails = nfails + 1
 1388 
 1389 !
 1390 !     test ncvp1c for char
 1391 !
 1392       call ncvp1c (ncid, cid, cindx, 'a', iret)
 1393       if (iret .ne. 0) nfails = nfails + 1
 1394 
 1395       call ncclos (ncid, iret)
 1396       if (iret .ne. 0) nfails = nfails + 1
 1397 
 1398       return
 1399       end
 1400 
 1401 !
 1402 ! subroutine to test default fill values
 1403 !
 1404       subroutine tfills(nfails)
 1405       use netcdf_f03
 1406       integer ncid
 1407       integer bid, sid, lid, fid, did
 1408       integer ix(1)
 1409       integer l
 1410       NCSHORT_T s
 1411       doubleprecision d
 1412       real f
 1413       NCBYTE_T b
 1414 
 1415       ncid = NCOPN('fills.nc', NCNOWRIT, iret)
 1416       if (iret .ne. 0) nfails = nfails + 1
 1417 
 1418       bid = ncvid(ncid, 'b', iret)
 1419       if (iret .ne. 0) nfails = nfails + 1
 1420 
 1421       sid = ncvid(ncid, 's', iret)
 1422       if (iret .ne. 0) nfails = nfails + 1
 1423 
 1424       lid = ncvid(ncid, 'l', iret)
 1425       if (iret .ne. 0) nfails = nfails + 1
 1426 
 1427       fid = ncvid(ncid, 'f', iret)
 1428       if (iret .ne. 0) nfails = nfails + 1
 1429 
 1430       did = ncvid(ncid, 'd', iret)
 1431       if (iret .ne. 0) nfails = nfails + 1
 1432 
 1433 
 1434       ix(1) = 2
 1435       call ncvgt1(ncid, bid, ix, b, iret)
 1436       if (iret .ne. 0) nfails = nfails + 1
 1437 
 1438       call ncvgt1(ncid, sid, ix, s, iret)
 1439       if (iret .ne. 0) nfails = nfails + 1
 1440 
 1441       call ncvgt1(ncid, lid, ix, l, iret)
 1442       if (iret .ne. 0) nfails = nfails + 1
 1443 
 1444       call ncvgt1(ncid, fid, ix, f, iret)
 1445       if (iret .ne. 0) nfails = nfails + 1
 1446 
 1447       call ncvgt1(ncid, did, ix, d, iret)
 1448       if (iret .ne. 0) nfails = nfails + 1
 1449 
 1450 
 1451       if (b .ne. FILBYTE) write(*,*) 'error in byte fill value'
 1452       if (d .ne. FILDOUB) write(*,*) 'error in double fill value'
 1453       if (f .ne. FILFLOAT) write(*,*) 'error in float fill value'
 1454       if (l .ne. FILLONG) write(*,*) 'error in long fill value'
 1455       if (s .ne. FILSHORT) write(*,*) 'error in short fill value'
 1456 
 1457       return
 1458       end