1C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
2C  Copyright by The HDF Group.                                               *
3C  Copyright by the Board of Trustees of the University of Illinois.         *
4C  All rights reserved.                                                      *
5C                                                                            *
6C  This file is part of HDF.  The full HDF copyright notice, including       *
7C  terms governing use, modification, and redistribution, is contained in    *
8C  the COPYING file, which can be found at the root of the source code       *
9C  distribution tree, or in https://support.hdfgroup.org/ftp/HDF/releases/.  *
10C  If you do not have access to either file, you may request a copy from     *
11C  help@hdfgroup.org.                                                        *
12C * * * * * * * * *  * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
13C
14C $Id$
15C
16      subroutine tanfilef (number_failed)
17C
18C
19C  Test program:
20C                Writes file labels and descriptions in a file.
21C                Reads the  labels and descriptions from the file
22C
23C  Input file:  none
24C  Output files: tdfanflF.hdf
25C
26C  Possible bug:  When reading in a label, we have to give it a
27C                 length that is one greater than MAXLEN_LAB. This
28C                 may be due to a bug in dfan.c in DFANIgetann().
29C
30
31      implicit none
32      include 'fortest.inc'
33
34      integer number_failed
35      character*20 myname
36      parameter (myname = 'anfile')
37
38      integer ret
39      integer ISFIRST, NOFIRST, MAXLEN_LAB, MAXLEN_DESC
40      integer fid
41
42      character*35 lab1, lab2
43      character*35 templab
44      character*100 desc1, desc2, tempstr
45      character*64 TESTFILE
46      character*1 CR
47
48      call ptestban('Testing', myname)
49      ISFIRST = 1
50      NOFIRST = 0
51      number_failed = 0
52      TESTFILE = 'tdfanflF.hdf'
53      CR = char(10)
54      MAXLEN_LAB = 35
55      MAXLEN_DESC = 100
56
57      lab1 = 'File label #1: aaa'
58      lab2 = 'File label #2: bbbbbb'
59      desc1 = 'File descr #1: This is a test file annotation'
60      desc2 = 'File descr #2: One more test ...'
61
62      call MESSAGE(VERBO_HI, '****** Write file labels *******')
63      fid = hopen(TESTFILE, DFACC_CREATE, 0)
64      call VRFY(fid, 'hopen', number_failed)
65      ret = daafid(fid, lab1)
66      call VRFY(ret, 'daafid', number_failed)
67
68      ret = daafid(fid, lab2)
69      call VRFY(ret, 'daafid', number_failed)
70
71      call MESSAGE(VERBO_HI, '****** Write file descriptions *******')
72      ret = daafds(fid, desc1, len(desc1))
73      call VRFY(ret, 'daafds', number_failed)
74
75      ret = daafds(fid, desc2, len(desc2))
76      call VRFY(ret, 'daafds', number_failed)
77
78      ret = hclose(fid)
79      call VRFY(ret, 'hclose', number_failed)
80
81      call MESSAGE(VERBO_HI,
82     +    '****** Read length of the first file label ****')
83      fid = hopen(TESTFILE, DFACC_READ, 0)
84      call VRFY(fid, 'hopen-read', number_failed)
85      ret = dagfidl(fid, ISFIRST)
86      call VRFY(ret, 'dagfidl', number_failed)
87      call checklen(ret, lab1,  'label'  )
88
89      call MESSAGE(VERBO_HI, '******...followed by the label *****')
90      ret = dagfid(fid, templab, MAXLEN_LAB, ISFIRST)
91
92      call VRFY(ret, 'dagfid', number_failed)
93      call checklab(lab1, templab, ret, 'label')
94
95      call MESSAGE(VERBO_HI,
96     +    '****** Read length of the second file label ****')
97      ret = dagfidl(fid, NOFIRST)
98      call VRFY(ret, 'dagfidl', number_failed)
99      call checklen(ret, lab2, 'label')
100
101      call MESSAGE(VERBO_HI, '******...followed by the label *****')
102      ret = dagfid(fid, templab, MAXLEN_LAB, NOFIRST)
103      call VRFY(ret, 'dagfid', number_failed)
104      call checklab(lab2, templab, ret, 'label')
105
106      call MESSAGE(VERBO_HI,
107     +    '****** Read length of the first file description ****')
108      ret = dagfdsl(fid, ISFIRST)
109      call VRFY(ret, 'dagfdsl', number_failed)
110      call checklen(ret, desc1, 'description' )
111
112      call MESSAGE(VERBO_HI,
113     +    '******...followed by the description *****')
114      ret = dagfds(fid, tempstr, MAXLEN_DESC, ISFIRST)
115      call VRFY(ret, 'dagfds', number_failed)
116      call checkann(desc1, tempstr, ret, 'description')
117
118      call MESSAGE(VERBO_HI,
119     +    '****** Read length of the second file description ****')
120      ret = dagfdsl(fid, NOFIRST)
121      call VRFY(ret, 'dagfdsl', number_failed)
122      call checklen(ret, desc2, 'description' )
123
124      call MESSAGE(VERBO_HI,
125     +    '******...followed by the description *****')
126      ret = dagfds(fid, tempstr, MAXLEN_DESC, NOFIRST)
127      call VRFY(ret, 'dagfds', number_failed)
128      call checkann(desc2, tempstr, ret, 'description')
129
130      ret = hclose(fid)
131      call VRFY(ret, 'hclose', number_failed)
132
133      if (number_failed .eq. 0) then
134         call MESSAGE(VERBO_HI,
135     +    '***** ALL DFANFILE TESTS SUCCESSFUL ******')
136      else
137         print *, '********', number_failed, ' TESTS FAILED'
138      endif
139
140
141      return
142      end
143
144
145C*********************************************
146C
147C  checklen
148C
149C*********************************************
150
151      subroutine checklen(ret, oldstr, type)
152      implicit none
153      character*(*) type, oldstr
154      integer ret
155
156      integer oldlen
157
158      oldlen = len(oldstr)
159      if (ret .ge. 0 .and.  ret .ne. oldlen) then
160          print *, 'Length of ', type, ' is ', len(oldstr),
161     *             ' instead of ', ret
162      endif
163      return
164      end
165
166C***********************************************
167C
168C  checkann
169C
170C***********************************************
171
172      subroutine checkann(oldstr, newstr, ret, type)
173      implicit none
174      character*90  oldstr, newstr
175      character*(*) type
176      integer ret
177
178
179      if (ret .ge. 0 .and. oldstr .ne. newstr) then
180          print *, type, ' is incorrect.'
181          print *, ' It should be <', oldstr, '>'
182          print *, ' instead of   <', newstr, '>'
183      endif
184      return
185      end
186
187C***********************************************
188C
189C  checklab
190C
191C***********************************************
192
193      subroutine checklab(oldstr, newstr, ret, type)
194      implicit none
195      character*30  oldstr, newstr
196      character*(*) type
197      integer ret
198
199
200      if (ret .ge. 0 .and. oldstr .ne. newstr) then
201          print *, type, ' is incorrect.'
202          print *, ' It should be <', oldstr, '>'
203          print *, ' instead of   <', newstr, '>'
204      endif
205      return
206      end
207