1 PROGRAM QST2F 2 3C----------------------------------------------------------------------- 4C 5C NSSDC/CDF Quick Start Test Program (FORTRAN interface). 6C 7C Version 1.11, 10-Sep-96, Hughes STX. 8C 9C Modification history: 10C 11C V1.0 24-Jan-91, J Love Original version (for CDF V2.0). 12C V1.1 11-Jan-91, J Love Fixed problem with "max_rec" from 13C CDF_INQUIRE and added CDF_INQUIRE 14C call after CDF_CREATE. 15C V1.2 7-Mar-91, J Love Modified output display. 16C V1.3 27-May-91, J Love Changed for CDF V2.1 enhancements. 17C V1.4 25-Jun-91, J Love Renamed CDF for portability. 18C V1.5 16-Jul-91, J Love Declaration of CDF_var_num and 19C CDF_attr_num now in 'cdf.inc'. 20C V1.6 26-Sep-91, J Love Modified for IBM-RS6000 port. 21C V1.7 20-May-92, J Love CDF V2.2. 22C V1.8 9-Aug-93, J Love CDF V2.4. 23C V1.8a 22-Feb-94, J Love Limited lines to 72 columns or less. 24C V1.9 22-Jun-94, J Love Renamed CDF to `TEST'. 25C V1.10 20-Dec-94, J Love CDF V2.5. 26C V1.11 10-Sep-96, J Love CDF V2.6. 27C V1.12 27-May-05, J Liu CDF V3.1. 28C 29C----------------------------------------------------------------------- 30 INCLUDE 'CDFDF.INC' 31 INCLUDE 'CDFDVF.INC' 32 INCLUDE 'CDFDVF2.INC' 33 INCLUDE 'CDFDVF3.INC' 34 35 INTEGER*4 N_DIMS 36 PARAMETER (N_DIMS = 2) 37 38 INTEGER*4 DIM_1_SIZE 39 PARAMETER (DIM_1_SIZE = 2) 40 INTEGER*4 DIM_2_SIZE 41 PARAMETER (DIM_2_SIZE = 3) 42 43 INTEGER*4 CDF_ID 44 INTEGER*4 STATUS 45 INTEGER*4 ENCODING 46 INTEGER*4 MAJORITY 47 INTEGER*4 NUM_DIMS 48 INTEGER*4 DIM_SIZES(N_DIMS) 49 INTEGER*4 VAR_DATA_TYPE 50 INTEGER*4 VAR_DATA_TYPE_OUT 51 INTEGER*4 VAR_NUM_ELEMENTS 52 INTEGER*4 VAR_NUM_ELEMENTS_OUT 53 INTEGER*4 VAR_NUM_OUT 54 INTEGER*4 VAR_VALUES(DIM_1_SIZE,DIM_2_SIZE) 55 INTEGER*4 INDICES(N_DIMS) 56 INTEGER*4 REC_NUM 57 INTEGER*4 VAR_VALUE_OUT 58 INTEGER*4 REC_START 59 INTEGER*4 REC_COUNT 60 INTEGER*4 REC_INTERVAL 61 INTEGER*4 COUNTS(N_DIMS) 62 INTEGER*4 INTERVALS(N_DIMS) 63 INTEGER*4 VAR_BUFFER_OUT(DIM_1_SIZE,DIM_2_SIZE) 64 INTEGER*4 ATTR_NUM_OUT 65 INTEGER*4 ENTRY_NUM 66 INTEGER*4 NUM_ENTRIES_OUT 67 INTEGER*4 ATTRSCOPE 68 INTEGER*4 ATTRSCOPE_OUT 69 INTEGER*4 ENTRY_DATA_TYPE 70 INTEGER*4 ENTRY_DATA_TYPE_OUT 71 INTEGER*4 ENTRY_NUM_ELEMENTS 72 INTEGER*4 ENTRY_NUM_ELEMENTS_OUT 73 INTEGER*4 ENTRY_VALUE 74 INTEGER*4 ENTRY_VALUE_OUT 75 INTEGER*4 ENCODING_OUT 76 INTEGER*4 MAJORITY_OUT 77 INTEGER*4 NUM_DIMS_OUT 78 INTEGER*4 DIM_SIZES_OUT(N_DIMS) 79 INTEGER*4 MAX_REC_OUT 80 INTEGER*4 NUM_VARS_OUT 81 INTEGER*4 NUM_ATTRS_OUT 82 INTEGER*4 RELEASE 83 INTEGER*4 VERSION 84 INTEGER*4 START 85 INTEGER*4 I 86 INTEGER*4 LAST_CHAR 87C ! last character in "copyright" 88C ! (before padding blanks begin) 89 90 INTEGER*4 X1, X2, X 91 92 INTEGER*4 VAR_REC_VARIANCE 93 INTEGER*4 VAR_REC_VARIANCE_OUT 94 INTEGER*4 VAR_DIM_VARIANCES(N_DIMS) 95 INTEGER*4 VAR_DIM_VARIANCES_OUT(N_DIMS) 96 97 CHARACTER VARNAME*(CDF_VAR_NAME_LEN) 98 CHARACTER NEW_VARNAME*(CDF_VAR_NAME_LEN) 99 CHARACTER VARNAME_OUT*(CDF_VAR_NAME_LEN) 100 CHARACTER ATTRNAME*(CDF_ATTR_NAME_LEN) 101 CHARACTER NEW_ATTRNAME*(CDF_ATTR_NAME_LEN) 102 CHARACTER ATTRNAME_OUT*(CDF_ATTR_NAME_LEN) 103 CHARACTER COPYRIGHT_TEXT*(CDF_COPYRIGHT_LEN) 104 CHARACTER ERRORTEXT*(CDF_STATUSTEXT_LEN) 105 CHARACTER CDFNAME*(CDF_PATHNAME_LEN) 106 107 CHARACTER LF*1 108 109 INTEGER*4 YEAR, MONTH, DAY, HOUR, MINUTE, SECOND, MSEC 110 INTEGER*4 YEAR_OUT, MONTH_OUT, DAY_OUT, 111 . HOUR_OUT, MINUTE_OUT, SECOND_OUT, MSEC_OUT 112 REAL*8 EPOCH, EPOCH_OUT 113 CHARACTER EPSTRING*(EPOCH_STRING_LEN), 114 . EPSTRING1*(EPOCH1_STRING_LEN), 115 . EPSTRING2*(EPOCH2_STRING_LEN), 116 . EPSTRING3*(EPOCH3_STRING_LEN) 117 CHARACTER EPSTRING_TRUE*(EPOCH_STRING_LEN), 118 . EPSTRING1_TRUE*(EPOCH1_STRING_LEN), 119 . EPSTRING2_TRUE*(EPOCH2_STRING_LEN), 120 . EPSTRING3_TRUE*(EPOCH3_STRING_LEN) 121 122 DATA ENCODING/NETWORK_ENCODING/ 123 DATA MAJORITY/COL_MAJOR/ 124 DATA NUM_DIMS/N_DIMS/ 125 DATA DIM_SIZES/DIM_1_SIZE,DIM_2_SIZE/ 126 DATA VAR_DATA_TYPE/CDF_INT4/ 127 DATA VAR_NUM_ELEMENTS/1/ 128 DATA VAR_REC_VARIANCE/VARY/ 129 DATA VAR_DIM_VARIANCES/N_DIMS * VARY/ 130 DATA REC_NUM/1/ 131 DATA VAR_VALUES/1,2,3,4,5,6/ 132 DATA REC_START/1/ 133 DATA REC_COUNT/1/ 134 DATA REC_INTERVAL/1/ 135 DATA COUNTS/DIM_1_SIZE,DIM_2_SIZE/ 136 DATA INTERVALS/N_DIMS * 1/ 137 DATA ENTRY_NUM/1/ 138 DATA ATTRSCOPE/GLOBAL_SCOPE/ 139 DATA ENTRY_DATA_TYPE/CDF_INT4/ 140 DATA ENTRY_NUM_ELEMENTS/1/ 141 DATA ENTRY_VALUE/1/ 142 143 DATA CDFNAME(1:4)/'TEST'/ 144 DATA VARNAME(1:4)/'VAR1'/ 145 DATA NEW_VARNAME(1:4)/'VAR2'/ 146 DATA ATTRNAME(1:5)/'ATTR1'/ 147 DATA NEW_ATTRNAME(1:5)/'ATTR2'/ 148 149 DATA YEAR/1994/, MONTH/10/, DAY/13/, 150 . HOUR/12/, MINUTE/0/, SECOND/0/, MSEC/0/ 151 DATA EPSTRING_TRUE/'13-Oct-1994 12:00:00.000'/, 152 . EPSTRING1_TRUE/'19941013.5000000'/, 153 . EPSTRING2_TRUE/'19941013120000'/, 154 . EPSTRING3_TRUE/'1994-10-13T12:00:00.000Z'/ 155 156C----------------------------------------------------------------------- 157C NUL-terminate character strings. 158C----------------------------------------------------------------------- 159 160 CDFNAME(5:5) = CHAR(0) 161 VARNAME(5:5) = CHAR(0) 162 NEW_VARNAME(5:5) = CHAR(0) 163 ATTRNAME(6:6) = CHAR(0) 164 NEW_ATTRNAME(6:6) = CHAR(0) 165 166C----------------------------------------------------------------------- 167C Display test title. 168C----------------------------------------------------------------------- 169 170 WRITE (6,100) 171 100 FORMAT (' ','Testing Standard/FORTRAN interface...') 172 173C----------------------------------------------------------------------- 174C Create CDF. 175C----------------------------------------------------------------------- 176 177 CALL CDF_CREATE (CDFNAME, NUM_DIMS, DIM_SIZES, ENCODING, 178 . MAJORITY, CDF_ID, STATUS) 179 180 IF (STATUS .LT. CDF_OK) THEN 181 IF (STATUS .EQ. CDF_EXISTS) THEN 182 CALL CDF_OPEN (CDFNAME, CDF_ID, STATUS) 183 IF (STATUS .LT. CDF_OK) 184 . CALL QUIT_CDF (STATUS, '1.0') 185 186 CALL CDF_DELETE (CDF_ID, STATUS) 187 IF (STATUS .LT. CDF_OK) 188 . CALL QUIT_CDF (STATUS, '1.1') 189 190 CALL CDF_CREATE (CDFNAME, NUM_DIMS, DIM_SIZES, 191 . ENCODING, MAJORITY, CDF_ID, 192 . STATUS) 193 IF (STATUS .LT. CDF_OK) 194 . CALL QUIT_CDF (STATUS, '1.2') 195 ELSE 196 CALL QUIT_CDF (STATUS, '1.3') 197 END IF 198 END IF 199 200C----------------------------------------------------------------------- 201C Create variable. 202C----------------------------------------------------------------------- 203 CALL CDF_VAR_CREATE (CDF_ID, VARNAME, VAR_DATA_TYPE, 204 . VAR_NUM_ELEMENTS, VAR_REC_VARIANCE, 205 . VAR_DIM_VARIANCES, VAR_NUM_OUT, 206 . STATUS) 207 IF (STATUS .LT. CDF_OK) CALL QUIT_CDF (STATUS, '2.0') 208 209C----------------------------------------------------------------------- 210C Close CDF. 211C----------------------------------------------------------------------- 212 213 CALL CDF_CLOSE (CDF_ID, STATUS) 214 IF (STATUS .LT. CDF_OK) CALL QUIT_CDF (STATUS, '3.0') 215 216C----------------------------------------------------------------------- 217C Reopen CDF. 218C----------------------------------------------------------------------- 219 220 CALL CDF_OPEN (CDFNAME, CDF_ID, STATUS) 221 IF (STATUS .LT. CDF_OK) CALL QUIT_CDF (STATUS, '4.0') 222 223C----------------------------------------------------------------------- 224C Delete CDF. 225C----------------------------------------------------------------------- 226 227 CALL CDF_DELETE (CDF_ID, STATUS) 228 IF (STATUS .LT. CDF_OK) CALL QUIT_CDF (STATUS, '5.0') 229 230C----------------------------------------------------------------------- 231C Create CDF again (previous delete will allow this). 232C----------------------------------------------------------------------- 233 234 CALL CDF_CREATE (CDFNAME, NUM_DIMS, DIM_SIZES, ENCODING, 235 . MAJORITY, CDF_ID, STATUS) 236 IF (STATUS .LT. CDF_OK) CALL QUIT_CDF (STATUS, '6.0') 237 238C----------------------------------------------------------------------- 239C Inquire CDF (added for V1.1). 240C----------------------------------------------------------------------- 241 242 CALL CDF_INQUIRE (CDF_ID, NUM_DIMS_OUT, DIM_SIZES_OUT, 243 . ENCODING_OUT, MAJORITY_OUT, 244 . MAX_REC_OUT, NUM_VARS_OUT, 245 . NUM_ATTRS_OUT, STATUS) 246 IF (STATUS .LT. CDF_OK) CALL QUIT_CDF (STATUS, '6a.0') 247 248 IF (NUM_DIMS_OUT .NE. NUM_DIMS) 249 . CALL QUIT_CDF (STATUS, '6a.1') 250 251 DO X = 1, N_DIMS 252 IF (DIM_SIZES_OUT(X) .NE. DIM_SIZES(X)) 253 . CALL QUIT_CDF (STATUS, '6a.2') 254 END DO 255 256 IF (ENCODING_OUT .NE. ENCODING) 257 . CALL QUIT_CDF (STATUS, '6a.3') 258 IF (MAJORITY_OUT .NE. MAJORITY) 259 . CALL QUIT_CDF (STATUS, '6a.4') 260 IF (MAX_REC_OUT .NE. 0) CALL QUIT_CDF (STATUS, '6a.5') 261 IF (NUM_VARS_OUT .NE. 0) CALL QUIT_CDF (STATUS, '6a.6') 262 IF (NUM_ATTRS_OUT .NE. 0) CALL QUIT_CDF (STATUS, '6a.7') 263 264C----------------------------------------------------------------------- 265C Create variable. 266C----------------------------------------------------------------------- 267 268 CALL CDF_VAR_CREATE (CDF_ID, VARNAME, VAR_DATA_TYPE, 269 . VAR_NUM_ELEMENTS, VAR_REC_VARIANCE, 270 . VAR_DIM_VARIANCES, VAR_NUM_OUT, 271 . STATUS) 272 IF (STATUS .LT. CDF_OK) CALL QUIT_CDF (STATUS, '7.0') 273 274C----------------------------------------------------------------------- 275C PUT to variable. 276C----------------------------------------------------------------------- 277 278 DO X1 = 1, DIM_1_SIZE 279 DO X2 = 1, DIM_2_SIZE 280 INDICES(1) = X1 281 INDICES(2) = X2 282 CALL CDF_VAR_PUT (CDF_ID, CDF_VAR_NUM(CDF_ID,VARNAME), 283 . REC_NUM, INDICES, VAR_VALUES(X1,X2), 284 . STATUS) 285 IF (STATUS .LT. CDF_OK) 286 . CALL QUIT_CDF (STATUS, '8.0') 287 END DO 288 END DO 289 290C----------------------------------------------------------------------- 291C GET from the variable. 292C----------------------------------------------------------------------- 293 294 DO X1 = 1, DIM_1_SIZE 295 DO X2 = 1, DIM_2_SIZE 296 INDICES(1) = X1 297 INDICES(2) = X2 298 CALL CDF_VAR_GET (CDF_ID, CDF_VAR_NUM(CDF_ID,VARNAME), 299 . REC_NUM, INDICES, VAR_VALUE_OUT, 300 . STATUS) 301 IF (STATUS .LT. CDF_OK) 302 . CALL QUIT_CDF (STATUS, '9.0') 303 304 IF (VAR_VALUE_OUT .NE. VAR_VALUES(X1,X2)) 305 . CALL QUIT_CDF (STATUS, '9.1') 306 END DO 307 END DO 308 309C----------------------------------------------------------------------- 310C HyperPUT to the variable. 311C----------------------------------------------------------------------- 312 313 DO X1 = 1, DIM_1_SIZE 314 DO X2 = 1, DIM_2_SIZE 315 VAR_VALUES(X1,X2) = -VAR_VALUES(X1,X2) 316 END DO 317 END DO 318 319 INDICES(1) = 1 320 INDICES(2) = 1 321 322 CALL CDF_VAR_HYPER_PUT (CDF_ID, 323 . CDF_VAR_NUM(CDF_ID,VARNAME), 324 . REC_START, REC_COUNT, REC_INTERVAL, 325 . INDICES, COUNTS, INTERVALS, 326 . VAR_VALUES, STATUS) 327 IF (STATUS .LT. CDF_OK) CALL QUIT_CDF (STATUS, '10.0') 328 329C----------------------------------------------------------------------- 330C HyperGET from variable. 331C----------------------------------------------------------------------- 332 333 CALL CDF_VAR_HYPER_GET (CDF_ID, 334 . CDF_VAR_NUM(CDF_ID,VARNAME), 335 . REC_START, REC_COUNT, REC_INTERVAL, 336 . INDICES, COUNTS, INTERVALS, 337 . VAR_BUFFER_OUT, STATUS) 338 IF (STATUS .LT. CDF_OK) CALL QUIT_CDF (STATUS, '11.0') 339 340 DO X1 = 1, DIM_1_SIZE 341 DO X2 = 1, DIM_2_SIZE 342 IF (VAR_BUFFER_OUT(X1,X2) .NE. VAR_VALUES(X1,X2)) 343 . CALL QUIT_CDF (STATUS, '11.1') 344 END DO 345 END DO 346 347C----------------------------------------------------------------------- 348C Create attribute. 349C----------------------------------------------------------------------- 350 351 CALL CDF_ATTR_CREATE (CDF_ID, ATTRNAME, ATTRSCOPE, 352 . ATTR_NUM_OUT, STATUS) 353 IF (STATUS .LT. CDF_OK) CALL QUIT_CDF (STATUS, '12.0') 354 355C----------------------------------------------------------------------- 356C PUT to attribute. 357C----------------------------------------------------------------------- 358 359 CALL CDF_ATTR_PUT (CDF_ID, CDF_ATTR_NUM(CDF_ID,ATTRNAME), 360 . ENTRY_NUM, ENTRY_DATA_TYPE, 361 . ENTRY_NUM_ELEMENTS, ENTRY_VALUE, 362 . STATUS) 363 IF (STATUS .LT. CDF_OK) CALL QUIT_CDF (STATUS, '13.0') 364 365C----------------------------------------------------------------------- 366C GET from attribute. 367C----------------------------------------------------------------------- 368 369 CALL CDF_ATTR_GET (CDF_ID, CDF_ATTR_NUM(CDF_ID,ATTRNAME), 370 . ENTRY_NUM, ENTRY_VALUE_OUT, 371 . STATUS) 372 IF (STATUS .LT. CDF_OK) CALL QUIT_CDF (STATUS, '14.0') 373 374 IF (ENTRY_VALUE_OUT .NE. ENTRY_VALUE) 375 . CALL QUIT_CDF (STATUS, '14.1') 376 377C----------------------------------------------------------------------- 378C Get CDF documentation. 379C----------------------------------------------------------------------- 380 381 CALL CDF_DOC (CDF_ID, VERSION, RELEASE, 382 . COPYRIGHT_TEXT, STATUS) 383 IF (STATUS .LT. CDF_OK) CALL QUIT_CDF (STATUS, '15.0') 384 385C WRITE (6,101) VERSION, RELEASE 386C 101 FORMAT (' ','CDF V',I1,'.',I1) 387C ! V1.2 388 LAST_CHAR = CDF_COPYRIGHT_LEN 389 DO WHILE (COPYRIGHT_TEXT(LAST_CHAR:LAST_CHAR) .EQ. ' ') 390 LAST_CHAR = LAST_CHAR - 1 391 END DO 392 393 LF = CHAR(10) 394 395 START = 1 396 DO I = 1, LAST_CHAR 397 IF (COPYRIGHT_TEXT(I:I) .EQ. LF) THEN 398C WRITE (6,301) COPYRIGHT_TEXT(START:I-1) 399C 301 FORMAT (' ',A) 400 START = I + 1 401 END IF 402 END DO 403 404C----------------------------------------------------------------------- 405C Inquire CDF. 406C----------------------------------------------------------------------- 407 408 CALL CDF_INQUIRE (CDF_ID, NUM_DIMS_OUT, DIM_SIZES_OUT, 409 . ENCODING_OUT, MAJORITY_OUT, 410 . MAX_REC_OUT, NUM_VARS_OUT, 411 . NUM_ATTRS_OUT, STATUS) 412 IF (STATUS .LT. CDF_OK) CALL QUIT_CDF (STATUS, '16.0') 413 414 IF (NUM_DIMS_OUT .NE. NUM_DIMS) 415 . CALL QUIT_CDF (STATUS, '16.1') 416 417 DO X = 1, N_DIMS 418 IF (DIM_SIZES_OUT(X) .NE. DIM_SIZES(X)) 419 . CALL QUIT_CDF (STATUS, '16.2') 420 END DO 421 422 IF (ENCODING_OUT .NE. ENCODING) 423 . CALL QUIT_CDF (STATUS, '16.3') 424 IF (MAJORITY_OUT .NE. MAJORITY) 425 . CALL QUIT_CDF (STATUS, '16.4') 426 IF (MAX_REC_OUT .NE. 1) CALL QUIT_CDF (STATUS, '16.5') 427C ! V1.1 428 IF (NUM_VARS_OUT .NE. 1) CALL QUIT_CDF (STATUS, '16.6') 429 IF (NUM_ATTRS_OUT .NE. 1) CALL QUIT_CDF (STATUS, '16.7') 430 431C----------------------------------------------------------------------- 432C Rename variable. 433C----------------------------------------------------------------------- 434 435 CALL CDF_VAR_RENAME (CDF_ID, CDF_VAR_NUM(CDF_ID,VARNAME), 436 . NEW_VARNAME, STATUS) 437 IF (STATUS .LT. CDF_OK) CALL QUIT_CDF (STATUS, '17.0') 438 439C----------------------------------------------------------------------- 440C Inquire variable. 441C----------------------------------------------------------------------- 442 443 CALL CDF_VAR_INQUIRE (CDF_ID, 444 . CDF_VAR_NUM(CDF_ID,NEW_VARNAME), 445 . VARNAME_OUT, VAR_DATA_TYPE_OUT, 446 . VAR_NUM_ELEMENTS_OUT, 447 . VAR_REC_VARIANCE_OUT, 448 . VAR_DIM_VARIANCES_OUT, STATUS) 449 IF (STATUS .LT. CDF_OK) CALL QUIT_CDF (STATUS, '18.0') 450 451 IF (VARNAME_OUT .NE. NEW_VARNAME(1:4)) 452 . CALL QUIT_CDF (STATUS, '18.1') 453 IF (VAR_DATA_TYPE_OUT .NE. VAR_DATA_TYPE) 454 . CALL QUIT_CDF (STATUS, '18.2') 455 IF (VAR_NUM_ELEMENTS_OUT .NE. VAR_NUM_ELEMENTS) 456 . CALL QUIT_CDF (STATUS, '18.3') 457 IF (VAR_REC_VARIANCE_OUT .NE. VAR_REC_VARIANCE) 458 . CALL QUIT_CDF (STATUS, '18.4') 459 460 DO X = 1, N_DIMS 461 IF (VAR_DIM_VARIANCES_OUT(X) .NE. VAR_DIM_VARIANCES(X)) 462 . CALL QUIT_CDF (STATUS, '18.5') 463 END DO 464 465C----------------------------------------------------------------------- 466C Close variable. 467C----------------------------------------------------------------------- 468 469 CALL CDF_VAR_CLOSE (CDF_ID, 470 . CDF_VAR_NUM(CDF_ID,NEW_VARNAME), 471 . STATUS) 472 IF (STATUS .LT. CDF_OK) CALL QUIT_CDF (STATUS, '19.0') 473 474C----------------------------------------------------------------------- 475C Rename attribute. 476C----------------------------------------------------------------------- 477 478 CALL CDF_ATTR_RENAME (CDF_ID, 479 . CDF_ATTR_NUM(CDF_ID,ATTRNAME), 480 . NEW_ATTRNAME, STATUS) 481 IF (STATUS .LT. CDF_OK) CALL QUIT_CDF (STATUS, '20.0') 482 483C----------------------------------------------------------------------- 484C Inquire attribute. 485C----------------------------------------------------------------------- 486 487 CALL CDF_ATTR_INQUIRE (CDF_ID, 488 . CDF_ATTR_NUM(CDF_ID,NEW_ATTRNAME), 489 . ATTRNAME_OUT, ATTRSCOPE_OUT, 490 . NUM_ENTRIES_OUT, STATUS) 491 IF (STATUS .LT. CDF_OK) CALL QUIT_CDF (STATUS, '22.0') 492 493 IF (ATTRNAME_OUT .NE. NEW_ATTRNAME(1:5)) 494 . CALL QUIT_CDF (STATUS, '22.1') 495 IF (ATTRSCOPE_OUT .NE. ATTRSCOPE) 496 . CALL QUIT_CDF (STATUS, '22.2') 497 IF (NUM_ENTRIES_OUT .NE. 1) 498 . CALL QUIT_CDF (STATUS, '22.3') 499 500C----------------------------------------------------------------------- 501C Inquire attribute entry. 502C----------------------------------------------------------------------- 503 504 CALL CDF_ATTR_ENTRY_INQUIRE (CDF_ID, 505 . CDF_ATTR_NUM(CDF_ID,NEW_ATTRNAME), 506 . ENTRY_NUM, 507 . ENTRY_DATA_TYPE_OUT, 508 . ENTRY_NUM_ELEMENTS_OUT, 509 . STATUS) 510 IF (STATUS .LT. CDF_OK) CALL QUIT_CDF (STATUS, '23.0') 511 512 IF (ENTRY_DATA_TYPE_OUT .NE. ENTRY_DATA_TYPE) 513 . CALL QUIT_CDF (STATUS, '23.1') 514 IF (ENTRY_NUM_ELEMENTS_OUT .NE. ENTRY_NUM_ELEMENTS) 515 . CALL QUIT_CDF (STATUS, '23.2') 516 517C----------------------------------------------------------------------- 518C Get error text. 519C----------------------------------------------------------------------- 520 521 CALL CDF_ERROR (CDF_OK, ERRORTEXT, STATUS) 522 523 LAST_CHAR = CDF_ERRTEXT_LEN 524 DO WHILE (ERRORTEXT(LAST_CHAR:LAST_CHAR) .EQ. ' ') 525 LAST_CHAR = LAST_CHAR - 1 526 END DO 527 528C WRITE (6,103) ERRORTEXT(1:LAST_CHAR) 529C 103 FORMAT (/,' ',A,/) 530 531C----------------------------------------------------------------------- 532C Close CDF. 533C----------------------------------------------------------------------- 534 535 CALL CDF_CLOSE (CDF_ID, STATUS) 536 IF (STATUS .LT. CDF_OK) CALL QUIT_CDF (STATUS, '24.0') 537 538C----------------------------------------------------------------------- 539C Test EPOCH routines. 540C----------------------------------------------------------------------- 541 542 CALL COMPUTE_EPOCH (YEAR, MONTH, DAY, HOUR, MINUTE, SECOND, 543 . MSEC, EPOCH) 544 545 CALL ENCODE_EPOCH (EPOCH, EPSTRING) 546 IF (EPSTRING .NE. EPSTRING_TRUE) CALL QUIT_EPOCH ('30.0') 547 548 CALL PARSE_EPOCH (EPSTRING, EPOCH_OUT) 549 IF (EPOCH_OUT .NE. EPOCH) CALL QUIT_EPOCH ('30.1') 550 551 CALL ENCODE_EPOCH1 (EPOCH, EPSTRING1) 552 IF (EPSTRING1 .NE. EPSTRING1_TRUE) CALL QUIT_EPOCH ('30.2') 553 554 CALL PARSE_EPOCH1 (EPSTRING1, EPOCH_OUT) 555 IF (EPOCH_OUT .NE. EPOCH) CALL QUIT_EPOCH ('30.3') 556 557 CALL ENCODE_EPOCH2 (EPOCH, EPSTRING2) 558 IF (EPSTRING2 .NE. EPSTRING2_TRUE) CALL QUIT_EPOCH ('30.4') 559 560 CALL PARSE_EPOCH2 (EPSTRING2, EPOCH_OUT) 561 IF (EPOCH_OUT .NE. EPOCH) CALL QUIT_EPOCH ('30.5') 562 563 CALL ENCODE_EPOCH3 (EPOCH, EPSTRING3) 564 IF (EPSTRING3 .NE. EPSTRING3_TRUE) CALL QUIT_EPOCH ('30.6') 565 566 CALL PARSE_EPOCH3 (EPSTRING3, EPOCH_OUT) 567 IF (EPOCH_OUT .NE. EPOCH) CALL QUIT_EPOCH ('30.7') 568 569 CALL EPOCH_BREAKDOWN (EPOCH, YEAR_OUT, MONTH_OUT, DAY_OUT, 570 . HOUR_OUT, MINUTE_OUT, SECOND_OUT, 571 . MSEC_OUT) 572 IF (YEAR_OUT .NE. YEAR) CALL QUIT_EPOCH ('32.1') 573 IF (MONTH_OUT .NE. MONTH) CALL QUIT_EPOCH ('32.2') 574 IF (DAY_OUT .NE. DAY) CALL QUIT_EPOCH ('32.3') 575 IF (HOUR_OUT .NE. HOUR) CALL QUIT_EPOCH ('32.4') 576 IF (MINUTE_OUT .NE. MINUTE) CALL QUIT_EPOCH ('32.5') 577 IF (SECOND_OUT .NE. SECOND) CALL QUIT_EPOCH ('32.6') 578 IF (MSEC_OUT .NE. MSEC) CALL QUIT_EPOCH ('32.7') 579 580C----------------------------------------------------------------------- 581 582 END 583 584C----------------------------------------------------------------------- 585C QUIT_CDF. Abort test early due to CDF error. 586C----------------------------------------------------------------------- 587 588 SUBROUTINE QUIT_CDF (STATUS, WHERE) 589 INTEGER*4 STATUS 590 CHARACTER WHERE*(*) 591 WRITE (6,401) WHERE 592 401 FORMAT (' ', 'Aborting at ', A, '...') 593 IF (STATUS .LT. 0) THEN 594 WRITE (6,501) STATUS 595 501 FORMAT (' ', 'CDF status code: ', I5) 596 ENDIF 597 WRITE (6,404) 598 404 FORMAT (' ','...test aborted') 599 STOP 600 END 601 602C----------------------------------------------------------------------- 603C QUIT_EPOCH. Abort test early due to EPOCH error. 604C----------------------------------------------------------------------- 605 606 SUBROUTINE QUIT_EPOCH (WHERE) 607 CHARACTER WHERE*(*) 608 WRITE (6,402) WHERE 609 402 FORMAT (' ', 'Aborting at ', A, '...test aborted') 610 STOP 611 END 612