| 1 | C------------------------------------------------------------------------------ |
|---|
| 2 | C NeXus - Neutron & X-ray Common Data Format |
|---|
| 3 | C |
|---|
| 4 | C Application Program Interface (Fortran 77) |
|---|
| 5 | C |
|---|
| 6 | C Copyright (C) 1997-2002 Freddie Akeroyd, Mark Koennecke |
|---|
| 7 | C |
|---|
| 8 | C This library is free software; you can redistribute it and/or |
|---|
| 9 | C modify it under the terms of the GNU Lesser General Public |
|---|
| 10 | C License as published by the Free Software Foundation; either |
|---|
| 11 | C version 2 of the License, or (at your option) any later version. |
|---|
| 12 | C |
|---|
| 13 | C This library is distributed in the hope that it will be useful, |
|---|
| 14 | C but WITHOUT ANY WARRANTY; without even the implied warranty of |
|---|
| 15 | C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
|---|
| 16 | C Lesser General Public License for more details. |
|---|
| 17 | C |
|---|
| 18 | C You should have received a copy of the GNU Lesser General Public |
|---|
| 19 | C License along with this library; if not, write to the Free Software |
|---|
| 20 | C Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA |
|---|
| 21 | C |
|---|
| 22 | C For further information, see <http://www.nexusformat.org> |
|---|
| 23 | C |
|---|
| 24 | C $Id$ |
|---|
| 25 | C------------------------------------------------------------------------------ |
|---|
| 26 | |
|---|
| 27 | C------------------------------------------------------------------------------ |
|---|
| 28 | C Doxygen comments follow |
|---|
| 29 | C for help, see: http://www.stack.nl/~dimitri/doxygen/docblocks.html#fortranblocks |
|---|
| 30 | C |
|---|
| 31 | !> \mainpage Fortan 77 NeXus API |
|---|
| 32 | !! |
|---|
| 33 | !! The Fortran routines have the same names and argument lists as the |
|---|
| 34 | !! corresponding C routines, which they call using wrappers. Some extra |
|---|
| 35 | !! routines for handling input/output of character data and attributes |
|---|
| 36 | !! have been added. Care must be taken to ensure enough space is allocated |
|---|
| 37 | !! for the input/output operations being performed. |
|---|
| 38 | !! |
|---|
| 39 | !! It is necessary to reverse the order of indices in multidimensional |
|---|
| 40 | !! arrays, compared to an equivalent C program, so that data are stored in |
|---|
| 41 | !! the same order in the NeXus file. |
|---|
| 42 | !! |
|---|
| 43 | !! Any program using the F77 API needs to include the following line near |
|---|
| 44 | !! the top in order to define the required constants (NXHANDLESIZE, |
|---|
| 45 | !! NXLINKSIZE, etc.): |
|---|
| 46 | !! |
|---|
| 47 | !! include 'NAPIF.INC' |
|---|
| 48 | !! |
|---|
| 49 | !! Use this table to convert from the C data types listed with each routine to the F77 data types: |
|---|
| 50 | !! |
|---|
| 51 | !! ========================== ================================================ |
|---|
| 52 | !! C FORTRAN 77 |
|---|
| 53 | !! ========================== ================================================ |
|---|
| 54 | !! int a, int* a INTEGER A |
|---|
| 55 | !! char* a CHARACTER*(*) A |
|---|
| 56 | !! NXhandle a, NXhandle* a INTEGER A(NXHANDLESIZE) |
|---|
| 57 | !! NXstatus INTEGER |
|---|
| 58 | !! int[] a INTEGER A(*) |
|---|
| 59 | !! void* a REAL A(*) or DOUBLE A(*) or INTEGER A(*) |
|---|
| 60 | !! NXlink a, NXlink* a INTEGER A(NXLINKSIZE) |
|---|
| 61 | !! ========================== ================================================ |
|---|
| 62 | !< |
|---|
| 63 | C------------------------------------------------------------------------------ |
|---|
| 64 | |
|---|
| 65 | |
|---|
| 66 | |
|---|
| 67 | !> Return length of a string, ignoring trailing blanks |
|---|
| 68 | !< |
|---|
| 69 | INTEGER FUNCTION TRUELEN(STRING) |
|---|
| 70 | CHARACTER*(*) STRING |
|---|
| 71 | DO TRUELEN=LEN(STRING),1,-1 |
|---|
| 72 | IF (STRING(TRUELEN:TRUELEN) .NE. ' ' .AND. |
|---|
| 73 | & STRING(TRUELEN:TRUELEN) .NE. CHAR(0) ) RETURN |
|---|
| 74 | ENDDO |
|---|
| 75 | TRUELEN = 0 |
|---|
| 76 | END |
|---|
| 77 | |
|---|
| 78 | !> Convert FORTRAN string STRING into NULL terminated C string ISTRING |
|---|
| 79 | !< |
|---|
| 80 | SUBROUTINE EXTRACT_STRING(ISTRING, LENMAX, STRING) |
|---|
| 81 | CHARACTER*(*) STRING |
|---|
| 82 | INTEGER I,ILEN,TRUELEN,LENMAX |
|---|
| 83 | INTEGER*1 ISTRING(LENMAX) |
|---|
| 84 | EXTERNAL TRUELEN |
|---|
| 85 | ILEN = TRUELEN(STRING) |
|---|
| 86 | IF (ILEN .GE. LENMAX) THEN |
|---|
| 87 | WRITE(6,9000) LENMAX, ILEN+1 |
|---|
| 88 | RETURN |
|---|
| 89 | ENDIF |
|---|
| 90 | DO I=1,ILEN |
|---|
| 91 | ISTRING(I) = ICHAR(STRING(I:I)) |
|---|
| 92 | ENDDO |
|---|
| 93 | ISTRING(ILEN+1) = 0 |
|---|
| 94 | RETURN |
|---|
| 95 | 9000 FORMAT('NeXus(NAPIF/EXTRACT_STRING): String too long -', |
|---|
| 96 | + 'buffer needs increasing from ', i4,' to at least ',i4) |
|---|
| 97 | END |
|---|
| 98 | |
|---|
| 99 | !> Convert NULL terminated C string ISTRING to FORTRAN string STRING |
|---|
| 100 | !< |
|---|
| 101 | SUBROUTINE REPLACE_STRING(STRING, ISTRING) |
|---|
| 102 | INTEGER*1 ISTRING(*) |
|---|
| 103 | CHARACTER*(*) STRING |
|---|
| 104 | INTEGER I |
|---|
| 105 | STRING = ' ' |
|---|
| 106 | DO I=1,LEN(STRING) |
|---|
| 107 | IF (ISTRING(I) .EQ. 0) RETURN |
|---|
| 108 | STRING(I:I) = CHAR(ISTRING(I)) |
|---|
| 109 | ENDDO |
|---|
| 110 | IF (ISTRING(LEN(STRING)+1) .NE. 0) WRITE(6,9010) LEN(STRING) |
|---|
| 111 | RETURN |
|---|
| 112 | 9010 FORMAT('NeXus(NAPIF/REPLACE_STRING): String truncated - ', |
|---|
| 113 | + 'buffer needs to be > ', I4) |
|---|
| 114 | END |
|---|
| 115 | |
|---|
| 116 | !> Wrapper routines for NXAPI interface |
|---|
| 117 | !< |
|---|
| 118 | INTEGER FUNCTION NXOPEN(FILENAME, ACCESS_METHOD, FILEID) |
|---|
| 119 | CHARACTER*(*) FILENAME |
|---|
| 120 | INTEGER*1 IFILENAME(256) |
|---|
| 121 | INTEGER ACCESS_METHOD |
|---|
| 122 | INTEGER FILEID(*),NXIFOPEN |
|---|
| 123 | EXTERNAL NXIFOPEN |
|---|
| 124 | CALL EXTRACT_STRING(IFILENAME, 256, FILENAME) |
|---|
| 125 | NXOPEN = NXIFOPEN(IFILENAME, ACCESS_METHOD, FILEID) |
|---|
| 126 | END |
|---|
| 127 | |
|---|
| 128 | INTEGER FUNCTION NXCLOSE(FILEID) |
|---|
| 129 | INTEGER FILEID(*),NXIFCLOSE |
|---|
| 130 | EXTERNAL NXIFCLOSE |
|---|
| 131 | NXCLOSE = NXIFCLOSE(FILEID) |
|---|
| 132 | END |
|---|
| 133 | |
|---|
| 134 | INTEGER FUNCTION NXFLUSH(FILEID) |
|---|
| 135 | INTEGER FILEID(*), NXIFFLUSH |
|---|
| 136 | EXTERNAL NXIFFLUSH |
|---|
| 137 | NXFLUSH = NXIFFLUSH(FILEID) |
|---|
| 138 | END |
|---|
| 139 | |
|---|
| 140 | INTEGER FUNCTION NXMAKEGROUP(FILEID, VGROUP, NXCLASS) |
|---|
| 141 | INTEGER FILEID(*),NXIMAKEGROUP |
|---|
| 142 | CHARACTER*(*) VGROUP, NXCLASS |
|---|
| 143 | INTEGER*1 IVGROUP(256), INXCLASS(256) |
|---|
| 144 | EXTERNAL NXIMAKEGROUP |
|---|
| 145 | CALL EXTRACT_STRING(IVGROUP, 256, VGROUP) |
|---|
| 146 | CALL EXTRACT_STRING(INXCLASS, 256, NXCLASS) |
|---|
| 147 | NXMAKEGROUP = NXIMAKEGROUP(FILEID, IVGROUP, INXCLASS) |
|---|
| 148 | END |
|---|
| 149 | |
|---|
| 150 | INTEGER FUNCTION NXOPENGROUP(FILEID, VGROUP, NXCLASS) |
|---|
| 151 | INTEGER FILEID(*),NXIOPENGROUP |
|---|
| 152 | CHARACTER*(*) VGROUP, NXCLASS |
|---|
| 153 | INTEGER*1 IVGROUP(256), INXCLASS(256) |
|---|
| 154 | EXTERNAL NXIOPENGROUP |
|---|
| 155 | CALL EXTRACT_STRING(IVGROUP, 256, VGROUP) |
|---|
| 156 | CALL EXTRACT_STRING(INXCLASS, 256, NXCLASS) |
|---|
| 157 | NXOPENGROUP = NXIOPENGROUP(FILEID, IVGROUP, INXCLASS) |
|---|
| 158 | END |
|---|
| 159 | |
|---|
| 160 | INTEGER FUNCTION NXOPENPATH(FILEID, PATH) |
|---|
| 161 | INTEGER FILEID(*),NXIOPENPATH |
|---|
| 162 | CHARACTER*(*) PATH |
|---|
| 163 | INTEGER*1 IPATH(256) |
|---|
| 164 | EXTERNAL NXIOPENPATH |
|---|
| 165 | CALL EXTRACT_STRING(IPATH, 256, PATH) |
|---|
| 166 | NXOPENPATH = NXIOPENPATH(FILEID, IPATH) |
|---|
| 167 | END |
|---|
| 168 | |
|---|
| 169 | INTEGER FUNCTION NXGETPATH(FILEID, PATH) |
|---|
| 170 | INTEGER FILEID(*),NXIGETPATH, NXIFGETPATH |
|---|
| 171 | CHARACTER*(*) PATH |
|---|
| 172 | INTEGER*1 IPATH(1024) |
|---|
| 173 | INTEGER PLEN |
|---|
| 174 | EXTERNAL NXIFGETPATH |
|---|
| 175 | PLEN = 1024 |
|---|
| 176 | NXGETPATH = NXIFGETPATH(FILEID,IPATH,PLEN) |
|---|
| 177 | CALL REPLACE_STRING(PATH,IPATH) |
|---|
| 178 | END |
|---|
| 179 | |
|---|
| 180 | INTEGER FUNCTION NXOPENGROUPPATH(FILEID, PATH) |
|---|
| 181 | INTEGER FILEID(*),NXIOPENGROUPPATH |
|---|
| 182 | CHARACTER*(*) PATH |
|---|
| 183 | INTEGER*1 IPATH(256) |
|---|
| 184 | EXTERNAL NXIOPENGROUPPATH |
|---|
| 185 | CALL EXTRACT_STRING(IPATH, 256, PATH) |
|---|
| 186 | NXOPENGROUPPATH = NXIOPENGROUPPATH(FILEID, IPATH) |
|---|
| 187 | END |
|---|
| 188 | |
|---|
| 189 | INTEGER FUNCTION NXCLOSEGROUP(FILEID) |
|---|
| 190 | INTEGER FILEID(*),NXICLOSEGROUP |
|---|
| 191 | EXTERNAL NXICLOSEGROUP |
|---|
| 192 | NXCLOSEGROUP = NXICLOSEGROUP(FILEID) |
|---|
| 193 | END |
|---|
| 194 | |
|---|
| 195 | INTEGER FUNCTION NXMAKEDATA(FILEID, LABEL, DATATYPE, RANK, DIM) |
|---|
| 196 | INTEGER FILEID(*), DATATYPE, RANK, DIM(*), NXIFMAKEDATA |
|---|
| 197 | CHARACTER*(*) LABEL |
|---|
| 198 | INTEGER*1 ILABEL(256) |
|---|
| 199 | EXTERNAL NXIFMAKEDATA |
|---|
| 200 | CALL EXTRACT_STRING(ILABEL, 256, LABEL) |
|---|
| 201 | NXMAKEDATA = NXIFMAKEDATA(FILEID, ILABEL, DATATYPE, RANK, DIM) |
|---|
| 202 | END |
|---|
| 203 | |
|---|
| 204 | INTEGER FUNCTION NXCOMPMAKEDATA(FILEID, LABEL, DATATYPE, RANK, |
|---|
| 205 | & DIM, COMPRESSION_TYPE, CHUNK) |
|---|
| 206 | INTEGER FILEID(*), DATATYPE, RANK, DIM(*) |
|---|
| 207 | INTEGER COMPRESSION_TYPE, CHUNK(*) |
|---|
| 208 | INTEGER NXIFCOMPMAKEDATA |
|---|
| 209 | CHARACTER*(*) LABEL |
|---|
| 210 | INTEGER*1 ILABEL(256) |
|---|
| 211 | EXTERNAL NXIFMAKEDATA |
|---|
| 212 | CALL EXTRACT_STRING(ILABEL, 256, LABEL) |
|---|
| 213 | NXCOMPMAKEDATA = NXIFCOMPMAKEDATA(FILEID, ILABEL, DATATYPE, |
|---|
| 214 | & RANK, DIM, COMPRESSION_TYPE, CHUNK) |
|---|
| 215 | END |
|---|
| 216 | |
|---|
| 217 | INTEGER FUNCTION NXOPENDATA(FILEID, LABEL) |
|---|
| 218 | INTEGER FILEID(*),NXIOPENDATA |
|---|
| 219 | CHARACTER*(*) LABEL |
|---|
| 220 | INTEGER*1 ILABEL(256) |
|---|
| 221 | EXTERNAL NXIOPENDATA |
|---|
| 222 | CALL EXTRACT_STRING(ILABEL, 256, LABEL) |
|---|
| 223 | NXOPENDATA = NXIOPENDATA(FILEID, ILABEL) |
|---|
| 224 | END |
|---|
| 225 | |
|---|
| 226 | INTEGER FUNCTION NXSETNUMBERFORMAT(FILEID, ITYPE, FORMAT) |
|---|
| 227 | INTEGER FILEID(*),NXISETNUMBERFORMAT,ITYPE |
|---|
| 228 | CHARACTER*(*) FORMAT |
|---|
| 229 | INTEGER*1 ILABEL(256) |
|---|
| 230 | EXTERNAL NXISETNUMBERFORMAT |
|---|
| 231 | CALL EXTRACT_STRING(ILABEL, 256, FORMAT) |
|---|
| 232 | NXSETNUMBERFORMAT = NXISETNUMBERFORMAT(FILEID, ITYPE, ILABEL) |
|---|
| 233 | END |
|---|
| 234 | |
|---|
| 235 | INTEGER FUNCTION NXCOMPRESS(FILEID, COMPR_TYPE) |
|---|
| 236 | INTEGER FILEID(*),NXIFCOMPRESS,COMPR_TYPE |
|---|
| 237 | EXTERNAL NXIFCOMPRESS |
|---|
| 238 | NXCOMPRESS = NXIFCOMPRESS(FILEID, COMPR_TYPE) |
|---|
| 239 | END |
|---|
| 240 | |
|---|
| 241 | INTEGER FUNCTION NXCLOSEDATA(FILEID) |
|---|
| 242 | INTEGER FILEID(*),NXICLOSEDATA |
|---|
| 243 | EXTERNAL NXICLOSEDATA |
|---|
| 244 | NXCLOSEDATA = NXICLOSEDATA(FILEID) |
|---|
| 245 | END |
|---|
| 246 | |
|---|
| 247 | INTEGER FUNCTION NXGETDATA(FILEID, DATA) |
|---|
| 248 | INTEGER FILEID(*), DATA(*), NXIGETDATA |
|---|
| 249 | EXTERNAL NXIGETDATA |
|---|
| 250 | NXGETDATA = NXIGETDATA(FILEID, DATA) |
|---|
| 251 | END |
|---|
| 252 | |
|---|
| 253 | INTEGER FUNCTION NXGETCHARDATA(FILEID, DATA) |
|---|
| 254 | INTEGER FILEID(*), NXIGETDATA |
|---|
| 255 | CHARACTER*(*) DATA |
|---|
| 256 | INTEGER NX_ERROR,NX_IDATLEN |
|---|
| 257 | PARAMETER(NX_ERROR=0,NX_IDATLEN=1024) |
|---|
| 258 | INTEGER*1 IDATA(NX_IDATLEN) |
|---|
| 259 | EXTERNAL NXIGETDATA |
|---|
| 260 | C *** We need to zero IDATA as GETDATA doesn't NULL terminate character data, |
|---|
| 261 | C *** and so we would get "buffer not big enough" messages from REPLACE_STRING |
|---|
| 262 | DO I=1,NX_IDATLEN |
|---|
| 263 | IDATA(I) = 0 |
|---|
| 264 | ENDDO |
|---|
| 265 | NXGETCHARDATA = NXIGETDATA(FILEID, IDATA) |
|---|
| 266 | IF (NXGETCHARDATA .NE. NX_ERROR) THEN |
|---|
| 267 | CALL REPLACE_STRING(DATA, IDATA) |
|---|
| 268 | ENDIF |
|---|
| 269 | END |
|---|
| 270 | |
|---|
| 271 | INTEGER FUNCTION NXGETSLAB(FILEID, DATA, START, SIZE) |
|---|
| 272 | INTEGER FILEID(*), DATA(*), START(*), SIZE(*) |
|---|
| 273 | INTEGER NX_MAXRANK, NX_OK |
|---|
| 274 | PARAMETER(NX_MAXRANK=32,NX_OK=1) |
|---|
| 275 | INTEGER RANK, DIM(NX_MAXRANK), DATATYPE, I |
|---|
| 276 | INTEGER CSTART(NX_MAXRANK), CSIZE(NX_MAXRANK) |
|---|
| 277 | INTEGER NXIGETSLAB, NXGETINFO |
|---|
| 278 | EXTERNAL NXIGETSLAB |
|---|
| 279 | NXGETSLAB = NXGETINFO(FILEID, RANK, DIM, DATATYPE) |
|---|
| 280 | IF (NXGETSLAB .NE. NX_OK) RETURN |
|---|
| 281 | DO I = 1, RANK |
|---|
| 282 | CSTART(I) = START(RANK-I+1) - 1 |
|---|
| 283 | CSIZE(I) = SIZE(RANK-I+1) |
|---|
| 284 | ENDDO |
|---|
| 285 | NXGETSLAB = NXIGETSLAB(FILEID, DATA, CSTART, CSIZE) |
|---|
| 286 | END |
|---|
| 287 | |
|---|
| 288 | INTEGER FUNCTION NXGETATTR(FILEID, NAME, DATA, DATALEN, TYPE) |
|---|
| 289 | INTEGER FILEID(*),DATA(*),DATALEN,TYPE |
|---|
| 290 | CHARACTER*(*) NAME |
|---|
| 291 | INTEGER*1 INAME(256) |
|---|
| 292 | INTEGER NXIGETATTR |
|---|
| 293 | EXTERNAL NXIGETATTR |
|---|
| 294 | CALL EXTRACT_STRING(INAME, 256, NAME) |
|---|
| 295 | NXGETATTR = NXIGETATTR(FILEID, INAME, DATA, DATALEN, TYPE) |
|---|
| 296 | END |
|---|
| 297 | |
|---|
| 298 | INTEGER FUNCTION NXGETCHARATTR(FILEID, NAME, DATA, |
|---|
| 299 | + DATALEN, TYPE) |
|---|
| 300 | INTEGER MAX_DATALEN,NX_ERROR |
|---|
| 301 | INTEGER FILEID(*), DATALEN, TYPE |
|---|
| 302 | PARAMETER(MAX_DATALEN=1024,NX_ERROR=0) |
|---|
| 303 | CHARACTER*(*) NAME, DATA |
|---|
| 304 | INTEGER*1 IDATA(MAX_DATALEN) |
|---|
| 305 | INTEGER*1 INAME(256) |
|---|
| 306 | INTEGER NXIGETATTR |
|---|
| 307 | EXTERNAL NXIGETATTR |
|---|
| 308 | CALL EXTRACT_STRING(INAME, 256, NAME) |
|---|
| 309 | IF (DATALEN .GE. MAX_DATALEN) THEN |
|---|
| 310 | WRITE(6,9020) DATALEN, MAX_DATALEN |
|---|
| 311 | NXGETCHARATTR=NX_ERROR |
|---|
| 312 | RETURN |
|---|
| 313 | ENDIF |
|---|
| 314 | NXGETCHARATTR = NXIGETATTR(FILEID, INAME, IDATA, DATALEN, TYPE) |
|---|
| 315 | IF (NXGETCHARATTR .NE. NX_ERROR) THEN |
|---|
| 316 | CALL REPLACE_STRING(DATA, IDATA) |
|---|
| 317 | ENDIF |
|---|
| 318 | RETURN |
|---|
| 319 | 9020 FORMAT('NXgetattr: asked for attribute size ', I4, |
|---|
| 320 | + ' with buffer size only ', I4) |
|---|
| 321 | END |
|---|
| 322 | |
|---|
| 323 | INTEGER FUNCTION NXPUTDATA(FILEID, DATA) |
|---|
| 324 | INTEGER FILEID(*), DATA(*), NXIPUTDATA |
|---|
| 325 | EXTERNAL NXIPUTDATA |
|---|
| 326 | NXPUTDATA = NXIPUTDATA(FILEID, DATA) |
|---|
| 327 | END |
|---|
| 328 | |
|---|
| 329 | INTEGER FUNCTION NXPUTCHARDATA(FILEID, DATA) |
|---|
| 330 | INTEGER FILEID(*), NXIPUTDATA |
|---|
| 331 | CHARACTER*(*) DATA |
|---|
| 332 | INTEGER*1 IDATA(1024) |
|---|
| 333 | EXTERNAL NXIPUTDATA |
|---|
| 334 | CALL EXTRACT_STRING(IDATA, 1024, DATA) |
|---|
| 335 | NXPUTCHARDATA = NXIPUTDATA(FILEID, IDATA) |
|---|
| 336 | END |
|---|
| 337 | |
|---|
| 338 | INTEGER FUNCTION NXPUTSLAB(FILEID, DATA, START, SIZE) |
|---|
| 339 | INTEGER FILEID(*), DATA(*), START(*), SIZE(*) |
|---|
| 340 | INTEGER NX_MAXRANK,NX_OK |
|---|
| 341 | PARAMETER(NX_MAXRANK=32,NX_OK=1) |
|---|
| 342 | INTEGER RANK, DIM(NX_MAXRANK), DATATYPE, I |
|---|
| 343 | INTEGER CSTART(NX_MAXRANK), CSIZE(NX_MAXRANK) |
|---|
| 344 | INTEGER NXIPUTSLAB, NXGETINFO |
|---|
| 345 | EXTERNAL NXIPUTSLAB |
|---|
| 346 | NXPUTSLAB = NXGETINFO(FILEID, RANK, DIM, DATATYPE) |
|---|
| 347 | IF (NXPUTSLAB .NE. NX_OK) RETURN |
|---|
| 348 | DO I = 1, RANK |
|---|
| 349 | CSTART(I) = START(RANK-I+1) - 1 |
|---|
| 350 | CSIZE(I) = SIZE(RANK-I+1) |
|---|
| 351 | ENDDO |
|---|
| 352 | NXPUTSLAB = NXIPUTSLAB(FILEID, DATA, CSTART, CSIZE) |
|---|
| 353 | END |
|---|
| 354 | |
|---|
| 355 | INTEGER FUNCTION NXPUTATTR(FILEID, NAME, DATA, DATALEN, TYPE) |
|---|
| 356 | INTEGER FILEID(*), DATA(*), DATALEN, TYPE |
|---|
| 357 | CHARACTER*(*) NAME |
|---|
| 358 | INTEGER*1 INAME(256) |
|---|
| 359 | INTEGER NXIFPUTATTR |
|---|
| 360 | EXTERNAL NXIFPUTATTR |
|---|
| 361 | CALL EXTRACT_STRING(INAME, 256, NAME) |
|---|
| 362 | NXPUTATTR = NXIFPUTATTR(FILEID, INAME, DATA, DATALEN, TYPE) |
|---|
| 363 | END |
|---|
| 364 | |
|---|
| 365 | INTEGER FUNCTION NXPUTCHARATTR(FILEID, NAME, DATA, |
|---|
| 366 | + DATALEN, TYPE) |
|---|
| 367 | INTEGER FILEID(*), DATALEN, TYPE |
|---|
| 368 | CHARACTER*(*) NAME, DATA |
|---|
| 369 | INTEGER*1 INAME(256) |
|---|
| 370 | INTEGER*1 IDATA(1024) |
|---|
| 371 | INTEGER NXIFPUTATTR |
|---|
| 372 | EXTERNAL NXIFPUTATTR |
|---|
| 373 | CALL EXTRACT_STRING(INAME, 256, NAME) |
|---|
| 374 | CALL EXTRACT_STRING(IDATA, 1024, DATA) |
|---|
| 375 | NXPUTCHARATTR = NXIFPUTATTR(FILEID, INAME, IDATA, DATALEN, TYPE) |
|---|
| 376 | END |
|---|
| 377 | |
|---|
| 378 | INTEGER FUNCTION NXGETINFO(FILEID, RANK, DIM, DATATYPE) |
|---|
| 379 | INTEGER FILEID(*), RANK, DIM(*), DATATYPE |
|---|
| 380 | INTEGER I, J, NXIGETINFO, NX_CHAR |
|---|
| 381 | EXTERNAL NXIGETINFO |
|---|
| 382 | NXGETINFO = NXIGETINFO(FILEID, RANK, DIM, DATATYPE) |
|---|
| 383 | C *** Reverse dimension array as C is ROW major, FORTRAN column major |
|---|
| 384 | DO I = 1, RANK/2 |
|---|
| 385 | J = DIM(I) |
|---|
| 386 | DIM(I) = DIM(RANK-I+1) |
|---|
| 387 | DIM(RANK-I+1) = J |
|---|
| 388 | ENDDO |
|---|
| 389 | END |
|---|
| 390 | |
|---|
| 391 | INTEGER FUNCTION NXGETNEXTENTRY(FILEID, NAME, CLASS, DATATYPE) |
|---|
| 392 | INTEGER FILEID(*), DATATYPE |
|---|
| 393 | CHARACTER*(*) NAME, CLASS |
|---|
| 394 | INTEGER*1 INAME(256), ICLASS(256) |
|---|
| 395 | INTEGER NXIGETNEXTENTRY |
|---|
| 396 | EXTERNAL NXIGETNEXTENTRY |
|---|
| 397 | NXGETNEXTENTRY = NXIGETNEXTENTRY(FILEID, INAME, ICLASS, DATATYPE) |
|---|
| 398 | CALL REPLACE_STRING(NAME, INAME) |
|---|
| 399 | CALL REPLACE_STRING(CLASS, ICLASS) |
|---|
| 400 | END |
|---|
| 401 | |
|---|
| 402 | INTEGER FUNCTION NXGETNEXTATTR(FILEID, PNAME, ILENGTH, ITYPE) |
|---|
| 403 | INTEGER FILEID(*), ILENGTH, ITYPE, NXIGETNEXTATTR |
|---|
| 404 | CHARACTER*(*) PNAME |
|---|
| 405 | INTEGER*1 IPNAME(1024) |
|---|
| 406 | EXTERNAL NXIGETNEXTATTR |
|---|
| 407 | NXGETNEXTATTR = NXIGETNEXTATTR(FILEID, IPNAME, ILENGTH, ITYPE) |
|---|
| 408 | CALL REPLACE_STRING(PNAME, IPNAME) |
|---|
| 409 | END |
|---|
| 410 | |
|---|
| 411 | INTEGER FUNCTION NXGETGROUPID(FILEID, LINK) |
|---|
| 412 | INTEGER FILEID(*), LINK(*), NXIGETGROUPID |
|---|
| 413 | EXTERNAL NXIGETGROUPID |
|---|
| 414 | NXGETGROUPID = NXIGETGROUPID(FILEID, LINK) |
|---|
| 415 | END |
|---|
| 416 | |
|---|
| 417 | INTEGER FUNCTION NXGETDATAID(FILEID, LINK) |
|---|
| 418 | INTEGER FILEID(*), LINK(*), NXIGETDATAID |
|---|
| 419 | EXTERNAL NXIGETDATAID |
|---|
| 420 | NXGETDATAID = NXIGETDATAID(FILEID, LINK) |
|---|
| 421 | END |
|---|
| 422 | |
|---|
| 423 | INTEGER FUNCTION NXMAKELINK(FILEID, LINK) |
|---|
| 424 | INTEGER FILEID(*), LINK(*), NXIMAKELINK |
|---|
| 425 | EXTERNAL NXIMAKELINK |
|---|
| 426 | NXMAKELINK = NXIMAKELINK(FILEID, LINK) |
|---|
| 427 | END |
|---|
| 428 | |
|---|
| 429 | INTEGER FUNCTION NXMAKENAMEDLINK(FILEID, PNAME, LINK) |
|---|
| 430 | INTEGER FILEID(*), LINK(*), NXIMAKELINK |
|---|
| 431 | CHARACTER*(*) PNAME |
|---|
| 432 | INTEGER*1 INAME(256) |
|---|
| 433 | EXTERNAL NXIMAKENAMEDLINK |
|---|
| 434 | CALL EXTRACT_STRING(INAME,256,PNAME) |
|---|
| 435 | NXMAKENAMEDLINK = NXIMAKENAMEDLINK(FILEID, INAME, LINK) |
|---|
| 436 | END |
|---|
| 437 | |
|---|
| 438 | INTEGER FUNCTION NXOPENSOURCEGROUP(FILEID) |
|---|
| 439 | INTEGER FILEID(*),NXIOPENSOURCEGROUP |
|---|
| 440 | EXTERNAL NXIOPENSOURCEGROUP |
|---|
| 441 | NXOPENSOURCEGROUP = NXIOPENSOURCEGROUP(FILEID) |
|---|
| 442 | END |
|---|
| 443 | |
|---|
| 444 | LOGICAL FUNCTION NXSAMEID(FILEID, LINK1, LINK2) |
|---|
| 445 | INTEGER FILEID(*), LINK1(*), LINK2(*), NXISAMEID, STATUS |
|---|
| 446 | EXTERNAL NXISAMEID |
|---|
| 447 | STATUS = NXISAMEID(FILEID, LINK1, LINK2) |
|---|
| 448 | IF (STATUS .EQ. 1) THEN |
|---|
| 449 | NXSAMEID = .TRUE. |
|---|
| 450 | ELSE |
|---|
| 451 | NXSAMEID = .FALSE. |
|---|
| 452 | ENDIF |
|---|
| 453 | END |
|---|
| 454 | |
|---|
| 455 | INTEGER FUNCTION NXGETGROUPINFO(FILEID, NUM, NAME, CLASS) |
|---|
| 456 | INTEGER FILEID(*), NUM, NXIGETGROUPINFO |
|---|
| 457 | CHARACTER*(*) NAME, CLASS |
|---|
| 458 | INTEGER*1 INAME(256), ICLASS(256) |
|---|
| 459 | EXTERNAL NXIGETGROUPINFO |
|---|
| 460 | NXGETGROUPINFO = NXIGETGROUPINFO(FILEID, NUM, INAME, ICLASS) |
|---|
| 461 | CALL REPLACE_STRING(NAME, INAME) |
|---|
| 462 | CALL REPLACE_STRING(CLASS, ICLASS) |
|---|
| 463 | END |
|---|
| 464 | |
|---|
| 465 | INTEGER FUNCTION NXINITGROUPDIR(FILEID) |
|---|
| 466 | INTEGER FILEID(*), NXIINITGROUPDIR |
|---|
| 467 | EXTERNAL NXIINITGROUPDIR |
|---|
| 468 | NXINITGROUPDIR = NXIINITGROUPDIR(FILEID) |
|---|
| 469 | END |
|---|
| 470 | |
|---|
| 471 | INTEGER FUNCTION NXGETATTRINFO(FILEID, NUM) |
|---|
| 472 | INTEGER FILEID(*), NUM, NXIGETATTRINFO |
|---|
| 473 | EXTERNAL NXIGETATTRINFO |
|---|
| 474 | NXGETATTRINFO = NXIGETATTRINFO(FILEID, NUM) |
|---|
| 475 | END |
|---|
| 476 | |
|---|
| 477 | INTEGER FUNCTION NXINITATTRDIR(FILEID) |
|---|
| 478 | INTEGER FILEID(*), NXIINITATTRDIR |
|---|
| 479 | EXTERNAL NXIINITATTRDIR |
|---|
| 480 | NXINITATTRDIR = NXIINITATTRDIR(FILEID) |
|---|
| 481 | END |
|---|
| 482 | |
|---|
| 483 | INTEGER FUNCTION NXISEXTERNALGROUP(FILEID, VGROUP, NXCLASS, NXURL) |
|---|
| 484 | INTEGER FILEID(*),NXIISEXTERNALGROUP, LENGTH |
|---|
| 485 | CHARACTER*(*) VGROUP, NXCLASS, NXURL |
|---|
| 486 | INTEGER*1 IVGROUP(256), INXCLASS(256), INXURL(256) |
|---|
| 487 | EXTERNAL NXIISEXTERNALGROUP |
|---|
| 488 | LENGTH = 256 |
|---|
| 489 | CALL EXTRACT_STRING(IVGROUP, 256, VGROUP) |
|---|
| 490 | CALL EXTRACT_STRING(INXCLASS, 256, NXCLASS) |
|---|
| 491 | NXISEXTERNALGROUP = NXIISEXTERNALGROUP(FILEID, IVGROUP, INXCLASS, |
|---|
| 492 | & INXURL,LENGTH) |
|---|
| 493 | CALL REPLACE_STRING(NXURL, INXURL) |
|---|
| 494 | END |
|---|
| 495 | |
|---|
| 496 | |
|---|
| 497 | INTEGER FUNCTION NXINQUIREFILE(FILEID, NXFILE) |
|---|
| 498 | INTEGER FILEID(*),NXIINQUIREFILE, LENGTH |
|---|
| 499 | CHARACTER*(*) NXFILE |
|---|
| 500 | INTEGER*1 INXFILE (1024) |
|---|
| 501 | EXTERNAL NXIINQUIREFILE |
|---|
| 502 | LENGTH = 1023 |
|---|
| 503 | NXINQUIREFILE = NXIINQUIREFILE(FILEID,INXFILE, 1023) |
|---|
| 504 | CALL REPLACE_STRING(NXFILE, INXFILE) |
|---|
| 505 | END |
|---|
| 506 | |
|---|
| 507 | INTEGER FUNCTION NXLINKEXTERNAL(FILEID, VGROUP, NXCLASS, NXURL) |
|---|
| 508 | INTEGER FILEID(*),NXILINKEXTERNAL |
|---|
| 509 | CHARACTER*(*) VGROUP, NXCLASS, NXURL |
|---|
| 510 | INTEGER*1 IVGROUP(256), INXCLASS(256), INXURL(1024) |
|---|
| 511 | EXTERNAL NXILINKEXTERNAL |
|---|
| 512 | CALL EXTRACT_STRING(IVGROUP, 256, VGROUP) |
|---|
| 513 | CALL EXTRACT_STRING(INXCLASS, 256, NXCLASS) |
|---|
| 514 | CALL EXTRACT_STRING(INXURL, 1023, NXURL) |
|---|
| 515 | NXLINKEXTERNAL = NXILINKEXTERNAL(FILEID, IVGROUP,INXCLASS, |
|---|
| 516 | & INXURL) |
|---|
| 517 | END |
|---|
| 518 | |
|---|
