1 SUBROUTINE DPRCSN(ICHAR2,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS, 2 1 IBUGD2,IFOUND,IERROR) 3C 4C PURPOSE--DEFINE AND SET THE HERSHEY CHARACTER SET COORDINATES 5C FOR ROMAN COMPLEX SCRIPT NUMERIC. 6C WRITTEN BY--JAMES J. FILLIBEN 7C STATISTICAL ENGINEERING DIVISION 8C CENTER FOR APPLIED MATHEMATICS 9C NATIONAL BUREAU OF STANDARDS 10C WASHINGTON, D. C. 20234 11C PHONE--301-921-3651 12C NOTE--DATAPLOT IS A REGISTERED TRADEMARK 13C OF THE NATIONAL BUREAU OF STANDARDS. 14C LANGUAGE--ANSI FORTRAN (1977) 15C VERSION NUMBER--87/4 16C ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MARCH 1981. 17C UPDATED --MAY 1982. 18C UPDATED --MARCH 1987. 19C 20C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- 21C 22 CHARACTER*4 ICHAR2 23 CHARACTER*4 IOP 24 CHARACTER*4 IBUGD2 25 CHARACTER*4 IFOUND 26 CHARACTER*4 IERROR 27C 28C--------------------------------------------------------------------- 29C 30 DIMENSION IOP(*) 31 DIMENSION X(*) 32 DIMENSION Y(*) 33C 34C--------------------------------------------------------------------- 35C 36 INCLUDE 'DPCOP2.INC' 37C 38C-----START POINT----------------------------------------------------- 39C 40 IFOUND='NO' 41 IERROR='NO' 42C 43 NUMCO=1 44 ISTART=1 45 ISTOP=1 46 NC=1 47C 48C ****************************************** 49C ** TREAT THE ROMAN SIMPLEX UPPER CASE ** 50C ** HERSHEY CHARACTER SET CASE ** 51C ****************************************** 52C 53C 54 IF(IBUGD2.EQ.'OFF')GOTO90 55 WRITE(ICOUT,999) 56 999 FORMAT(1X) 57 CALL DPWRST('XXX','BUG ') 58 WRITE(ICOUT,51) 59 51 FORMAT('***** AT THE BEGINNING OF DPRCSN--') 60 CALL DPWRST('XXX','BUG ') 61 WRITE(ICOUT,52)ICHAR2 62 52 FORMAT('ICHAR2 = ',A4) 63 CALL DPWRST('XXX','BUG ') 64 WRITE(ICOUT,59)IBUGD2,IFOUND,IERROR 65 59 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4) 66 CALL DPWRST('XXX','BUG ') 67 90 CONTINUE 68C 69C ************************************************** 70C ** STEP 1-- ** 71C ** SEARCH FOR THE INPUT CHARACTER(S). ** 72C ** MAP THE CHARACTER(S) INTO A NUMERIC VALUE. ** 73C ************************************************** 74C 75 CALL DPCHNU(ICHAR2,ICHARN,IBUGD2,IFOUND) 76 IF(IFOUND.EQ.'NO')GOTO9000 77C 78 IF(ICHARN.LE.9)GOTO1010 79 GOTO1019 80 1010 CONTINUE 81 CALL DRCSN1(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS, 82 1IBUGD2,IFOUND,IERROR) 83 GOTO9000 84 1019 CONTINUE 85C 86 IF(ICHARN.GE.10)GOTO1020 87 GOTO1029 88 1020 CONTINUE 89 CALL DRCSN2(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS, 90 1IBUGD2,IFOUND,IERROR) 91 GOTO9000 92 1029 CONTINUE 93C 94 IFOUND='NO' 95 GOTO9000 96C 97C ***************** 98C ** STEP 90-- ** 99C ** EXIT ** 100C ***************** 101C 102 9000 CONTINUE 103 IF(IBUGD2.EQ.'OFF')GOTO9090 104 WRITE(ICOUT,999) 105 CALL DPWRST('XXX','BUG ') 106 WRITE(ICOUT,9011) 107 9011 FORMAT('***** AT THE END OF DPRCSN--') 108 CALL DPWRST('XXX','BUG ') 109 WRITE(ICOUT,9012)IBUGD2,IFOUND,IERROR 110 9012 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4) 111 CALL DPWRST('XXX','BUG ') 112 WRITE(ICOUT,9013)ICHAR2,ICHARN 113 9013 FORMAT('ICHAR2,ICHARN = ',A4,I8) 114 CALL DPWRST('XXX','BUG ') 115 WRITE(ICOUT,9014)ISTART,ISTOP,NC,NUMCO 116 9014 FORMAT('ISTART,ISTOP,NC,NUMCO = ',4I8) 117 CALL DPWRST('XXX','BUG ') 118 IF(NUMCO.GE.1.AND.NUMCO.LE.1000)GOTO9019 119 DO9015I=1,NUMCO 120 WRITE(ICOUT,9016)I,IOP(I),X(I),Y(I) 121 9016 FORMAT('I,IOP(I),X(I),Y(I) = ',I8,2X,A4,2F10.2) 122 CALL DPWRST('XXX','BUG ') 123 9015 CONTINUE 124 9019 CONTINUE 125 WRITE(ICOUT,9021)IXMINS,IXMAXS,IXDELS 126 9021 FORMAT('IXMINS,IXMAXS,IXDELS = ',3I8) 127 CALL DPWRST('XXX','BUG ') 128 9090 CONTINUE 129C 130 RETURN 131 END 132 SUBROUTINE DPRCSU(ICHAR2,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS, 133 1IBUGD2,IFOUND,IERROR) 134C 135C PURPOSE--DEFINE AND SET THE HERSHEY CHARACTER SET COORDINATES 136C FOR ROMAN COMPLEX SCRIPT UPPER CASE. 137C WRITTEN BY--JAMES J. FILLIBEN 138C STATISTICAL ENGINEERING DIVISION 139C CENTER FOR APPLIED MATHEMATICS 140C NATIONAL BUREAU OF STANDARDS 141C WASHINGTON, D. C. 20234 142C PHONE--301-921-3651 143C NOTE--DATAPLOT IS A REGISTERED TRADEMARK 144C OF THE NATIONAL BUREAU OF STANDARDS. 145C LANGUAGE--ANSI FORTRAN (1977) 146C VERSION NUMBER--87/4 147C ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MARCH 1981. 148C UPDATED --MAY 1982. 149C UPDATED --MARCH 1987. 150C 151C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- 152C 153 CHARACTER*4 ICHAR2 154 CHARACTER*4 IOP 155 CHARACTER*4 IBUGD2 156 CHARACTER*4 IFOUND 157 CHARACTER*4 IERROR 158C 159C--------------------------------------------------------------------- 160C 161 DIMENSION IOP(*) 162 DIMENSION X(*) 163 DIMENSION Y(*) 164C 165C--------------------------------------------------------------------- 166C 167 INCLUDE 'DPCOP2.INC' 168C 169C-----START POINT----------------------------------------------------- 170C 171 IFOUND='NO' 172 IERROR='NO' 173C 174 NUMCO=1 175 ISTART=1 176 ISTOP=1 177 NC=1 178C 179C ****************************************** 180C ** TREAT THE ROMAN SIMPLEX UPPER CASE ** 181C ** HERSHEY CHARACTER SET CASE ** 182C ****************************************** 183C 184C 185 IF(IBUGD2.EQ.'OFF')GOTO90 186 WRITE(ICOUT,999) 187 999 FORMAT(1X) 188 CALL DPWRST('XXX','BUG ') 189 WRITE(ICOUT,51) 190 51 FORMAT('***** AT THE BEGINNING OF DPRCSU--') 191 CALL DPWRST('XXX','BUG ') 192 WRITE(ICOUT,52)ICHAR2 193 52 FORMAT('ICHAR2 = ',A4) 194 CALL DPWRST('XXX','BUG ') 195 WRITE(ICOUT,59)IBUGD2,IFOUND,IERROR 196 59 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4) 197 CALL DPWRST('XXX','BUG ') 198 90 CONTINUE 199C 200C ************************************************** 201C ** STEP 1-- ** 202C ** SEARCH FOR THE INPUT CHARACTER(S). ** 203C ** MAP THE CHARACTER(S) INTO A NUMERIC VALUE. ** 204C ************************************************** 205C 206 CALL DPCHAL(ICHAR2,ICHARN,IBUGD2,IFOUND) 207 IF(IFOUND.EQ.'NO')GOTO9000 208C 209 IF(ICHARN.LE.6)GOTO1010 210 GOTO1019 211 1010 CONTINUE 212 CALL DRCSU1(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS, 213 1IBUGD2,IFOUND,IERROR) 214 GOTO9000 215 1019 CONTINUE 216C 217 IF(7.LE.ICHARN.AND.ICHARN.LE.13)GOTO1020 218 GOTO1029 219 1020 CONTINUE 220 CALL DRCSU2(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS, 221 1IBUGD2,IFOUND,IERROR) 222 GOTO9000 223 1029 CONTINUE 224C 225 IF(14.LE.ICHARN.AND.ICHARN.LE.20)GOTO1030 226 GOTO1039 227 1030 CONTINUE 228 CALL DRCSU3(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS, 229 1IBUGD2,IFOUND,IERROR) 230 GOTO9000 231 1039 CONTINUE 232C 233 IF(ICHARN.GE.21)GOTO1040 234 GOTO1049 235 1040 CONTINUE 236 CALL DRCSU4(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS, 237 1IBUGD2,IFOUND,IERROR) 238 GOTO9000 239 1049 CONTINUE 240C 241 IFOUND='NO' 242 GOTO9000 243C 244C ***************** 245C ** STEP 90-- ** 246C ** EXIT ** 247C ***************** 248C 249 9000 CONTINUE 250 IF(IBUGD2.EQ.'OFF')GOTO9090 251 WRITE(ICOUT,999) 252 CALL DPWRST('XXX','BUG ') 253 WRITE(ICOUT,9011) 254 9011 FORMAT('***** AT THE END OF DPRCSU--') 255 CALL DPWRST('XXX','BUG ') 256 WRITE(ICOUT,9012)IBUGD2,IFOUND,IERROR 257 9012 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4) 258 CALL DPWRST('XXX','BUG ') 259 WRITE(ICOUT,9013)ICHAR2,ICHARN 260 9013 FORMAT('ICHAR2,ICHARN = ',A4,I8) 261 CALL DPWRST('XXX','BUG ') 262 WRITE(ICOUT,9014)ISTART,ISTOP,NC,NUMCO 263 9014 FORMAT('ISTART,ISTOP,NC,NUMCO = ',4I8) 264 CALL DPWRST('XXX','BUG ') 265 IF(NUMCO.GE.1.AND.NUMCO.LE.1000)GOTO9019 266 DO9015I=1,NUMCO 267 WRITE(ICOUT,9016)I,IOP(I),X(I),Y(I) 268 9016 FORMAT('I,IOP(I),X(I),Y(I) = ',I8,2X,A4,2F10.2) 269 CALL DPWRST('XXX','BUG ') 270 9015 CONTINUE 271 9019 CONTINUE 272 WRITE(ICOUT,9021)IXMINS,IXMAXS,IXDELS 273 9021 FORMAT('IXMINS,IXMAXS,IXDELS = ',3I8) 274 CALL DPWRST('XXX','BUG ') 275 9090 CONTINUE 276C 277 RETURN 278 END 279 SUBROUTINE DPRCU(ICHAR2,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS, 280 1IBUGD2,IFOUND,IERROR) 281C 282C PURPOSE--DEFINE AND SET THE HERSHEY CHARACTER SET COORDINATES 283C FOR ROMAN COMPLEX UPPER CASE. 284C WRITTEN BY--JAMES J. FILLIBEN 285C STATISTICAL ENGINEERING DIVISION 286C CENTER FOR APPLIED MATHEMATICS 287C NATIONAL BUREAU OF STANDARDS 288C WASHINGTON, D. C. 20234 289C PHONE--301-921-3651 290C NOTE--DATAPLOT IS A REGISTERED TRADEMARK 291C OF THE NATIONAL BUREAU OF STANDARDS. 292C LANGUAGE--ANSI FORTRAN (1977) 293C VERSION NUMBER--87/4 294C ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MARCH 1981. 295C UPDATED --MAY 1982. 296C UPDATED --MARCH 1987. 297C 298C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- 299C 300 CHARACTER*4 ICHAR2 301 CHARACTER*4 IOP 302 CHARACTER*4 IBUGD2 303 CHARACTER*4 IFOUND 304 CHARACTER*4 IERROR 305C 306C--------------------------------------------------------------------- 307C 308 DIMENSION IOP(*) 309 DIMENSION X(*) 310 DIMENSION Y(*) 311C 312C--------------------------------------------------------------------- 313C 314 INCLUDE 'DPCOP2.INC' 315C 316C-----START POINT----------------------------------------------------- 317C 318 IFOUND='NO' 319 IERROR='NO' 320C 321 NUMCO=1 322 ISTART=1 323 ISTOP=1 324 NC=1 325C 326C ****************************************** 327C ** TREAT THE ROMAN SIMPLEX UPPER CASE ** 328C ** HERSHEY CHARACTER SET CASE ** 329C ****************************************** 330C 331C 332 IF(IBUGD2.EQ.'OFF')GOTO90 333 WRITE(ICOUT,999) 334 999 FORMAT(1X) 335 CALL DPWRST('XXX','BUG ') 336 WRITE(ICOUT,51) 337 51 FORMAT('***** AT THE BEGINNING OF DPRCU--') 338 CALL DPWRST('XXX','BUG ') 339 WRITE(ICOUT,52)ICHAR2 340 52 FORMAT('ICHAR2 = ',A4) 341 CALL DPWRST('XXX','BUG ') 342 WRITE(ICOUT,59)IBUGD2,IFOUND,IERROR 343 59 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4) 344 CALL DPWRST('XXX','BUG ') 345 90 CONTINUE 346C 347C ************************************************** 348C ** STEP 1-- ** 349C ** SEARCH FOR THE INPUT CHARACTER(S). ** 350C ** MAP THE CHARACTER(S) INTO A NUMERIC VALUE. ** 351C ************************************************** 352C 353 CALL DPCHAL(ICHAR2,ICHARN,IBUGD2,IFOUND) 354 IF(IFOUND.EQ.'NO')GOTO9000 355C 356 IF(ICHARN.LE.14)GOTO1010 357 GOTO1019 358 1010 CONTINUE 359 CALL DRCU1(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS, 360 1IBUGD2,IFOUND,IERROR) 361 GOTO9000 362 1019 CONTINUE 363C 364 IF(ICHARN.GE.15)GOTO1020 365 GOTO1029 366 1020 CONTINUE 367 CALL DRCU2(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS, 368 1IBUGD2,IFOUND,IERROR) 369 GOTO9000 370 1029 CONTINUE 371C 372 IFOUND='NO' 373 GOTO9000 374C 375C ***************** 376C ** STEP 90-- ** 377C ** EXIT ** 378C ***************** 379C 380 9000 CONTINUE 381 IF(IBUGD2.EQ.'OFF')GOTO9090 382 WRITE(ICOUT,999) 383 CALL DPWRST('XXX','BUG ') 384 WRITE(ICOUT,9011) 385 9011 FORMAT('***** AT THE END OF DPRCU--') 386 CALL DPWRST('XXX','BUG ') 387 WRITE(ICOUT,9012)IBUGD2,IFOUND,IERROR 388 9012 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4) 389 CALL DPWRST('XXX','BUG ') 390 WRITE(ICOUT,9013)ICHAR2,ICHARN 391 9013 FORMAT('ICHAR2,ICHARN = ',A4,I8) 392 CALL DPWRST('XXX','BUG ') 393 WRITE(ICOUT,9014)ISTART,ISTOP,NC,NUMCO 394 9014 FORMAT('ISTART,ISTOP,NC,NUMCO = ',4I8) 395 CALL DPWRST('XXX','BUG ') 396 IF(NUMCO.GE.1.AND.NUMCO.LE.1000)GOTO9019 397 DO9015I=1,NUMCO 398 WRITE(ICOUT,9016)I,IOP(I),X(I),Y(I) 399 9016 FORMAT('I,IOP(I),X(I),Y(I) = ',I8,2X,A4,2F10.2) 400 CALL DPWRST('XXX','BUG ') 401 9015 CONTINUE 402 9019 CONTINUE 403 WRITE(ICOUT,9021)IXMINS,IXMAXS,IXDELS 404 9021 FORMAT('IXMINS,IXMAXS,IXDELS = ',3I8) 405 CALL DPWRST('XXX','BUG ') 406 9090 CONTINUE 407C 408 RETURN 409 END 410 SUBROUTINE DPRDL(ICHAR2,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS, 411 1IBUGD2,IFOUND,IERROR) 412C 413C PURPOSE--DEFINE AND SET THE HERSHEY CHARACTER SET COORDINATES 414C FOR ROMAN DUPLEX LOWER CASE. 415C WRITTEN BY--JAMES J. FILLIBEN 416C STATISTICAL ENGINEERING DIVISION 417C CENTER FOR APPLIED MATHEMATICS 418C NATIONAL BUREAU OF STANDARDS 419C WASHINGTON, D. C. 20234 420C PHONE--301-921-3651 421C NOTE--DATAPLOT IS A REGISTERED TRADEMARK 422C OF THE NATIONAL BUREAU OF STANDARDS. 423C LANGUAGE--ANSI FORTRAN (1977) 424C VERSION NUMBER--87/4 425C ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MARCH 1981. 426C UPDATED --MAY 1982. 427C UPDATED --MARCH 1987. 428C 429C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- 430C 431 CHARACTER*4 ICHAR2 432 CHARACTER*4 IOP 433 CHARACTER*4 IBUGD2 434 CHARACTER*4 IFOUND 435 CHARACTER*4 IERROR 436C 437C--------------------------------------------------------------------- 438C 439 DIMENSION IOP(*) 440 DIMENSION X(*) 441 DIMENSION Y(*) 442C 443C--------------------------------------------------------------------- 444C 445 INCLUDE 'DPCOP2.INC' 446C 447C-----START POINT----------------------------------------------------- 448C 449 IFOUND='NO' 450 IERROR='NO' 451C 452 NUMCO=1 453 ISTART=1 454 ISTOP=1 455 NC=1 456C 457C ****************************************** 458C ** TREAT THE ROMAN SIMPLEX UPPER CASE ** 459C ** HERSHEY CHARACTER SET CASE ** 460C ****************************************** 461C 462C 463 IF(IBUGD2.EQ.'OFF')GOTO90 464 WRITE(ICOUT,999) 465 999 FORMAT(1X) 466 CALL DPWRST('XXX','BUG ') 467 WRITE(ICOUT,51) 468 51 FORMAT('***** AT THE BEGINNING OF DPRDL--') 469 CALL DPWRST('XXX','BUG ') 470 WRITE(ICOUT,52)ICHAR2 471 52 FORMAT('ICHAR2 = ',A4) 472 CALL DPWRST('XXX','BUG ') 473 WRITE(ICOUT,59)IBUGD2,IFOUND,IERROR 474 59 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4) 475 CALL DPWRST('XXX','BUG ') 476 90 CONTINUE 477C 478C ************************************************** 479C ** STEP 1-- ** 480C ** SEARCH FOR THE INPUT CHARACTER(S). ** 481C ** MAP THE CHARACTER(S) INTO A NUMERIC VALUE. ** 482C ************************************************** 483C 484 CALL DPCHAL(ICHAR2,ICHARN,IBUGD2,IFOUND) 485 IF(IFOUND.EQ.'NO')GOTO9000 486C 487 IF(ICHARN.LE.11)GOTO1010 488 GOTO1019 489 1010 CONTINUE 490 CALL DRDL1(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS, 491 1IBUGD2,IFOUND,IERROR) 492 GOTO9000 493 1019 CONTINUE 494C 495 IF(12.LE.ICHARN.AND.ICHARN.LE.24)GOTO1020 496 GOTO1029 497 1020 CONTINUE 498 CALL DRDL2(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS, 499 1IBUGD2,IFOUND,IERROR) 500 GOTO9000 501 1029 CONTINUE 502C 503 IF(ICHARN.GE.25)GOTO1030 504 GOTO1039 505 1030 CONTINUE 506 CALL DRDL3(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS, 507 1IBUGD2,IFOUND,IERROR) 508 GOTO9000 509 1039 CONTINUE 510C 511 IFOUND='NO' 512 GOTO9000 513C 514C ***************** 515C ** STEP 90-- ** 516C ** EXIT ** 517C ***************** 518C 519 9000 CONTINUE 520 IF(IBUGD2.EQ.'OFF')GOTO9090 521 WRITE(ICOUT,999) 522 CALL DPWRST('XXX','BUG ') 523 WRITE(ICOUT,9011) 524 9011 FORMAT('***** AT THE END OF DPRDL--') 525 CALL DPWRST('XXX','BUG ') 526 WRITE(ICOUT,9012)IBUGD2,IFOUND,IERROR 527 9012 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4) 528 CALL DPWRST('XXX','BUG ') 529 WRITE(ICOUT,9013)ICHAR2,ICHARN 530 9013 FORMAT('ICHAR2,ICHARN = ',A4,I8) 531 CALL DPWRST('XXX','BUG ') 532 WRITE(ICOUT,9014)ISTART,ISTOP,NC,NUMCO 533 9014 FORMAT('ISTART,ISTOP,NC,NUMCO = ',4I8) 534 CALL DPWRST('XXX','BUG ') 535 IF(NUMCO.GE.1.AND.NUMCO.LE.1000)GOTO9019 536 DO9015I=1,NUMCO 537 WRITE(ICOUT,9016)I,IOP(I),X(I),Y(I) 538 9016 FORMAT('I,IOP(I),X(I),Y(I) = ',I8,2X,A4,2F10.2) 539 CALL DPWRST('XXX','BUG ') 540 9015 CONTINUE 541 9019 CONTINUE 542 WRITE(ICOUT,9021)IXMINS,IXMAXS,IXDELS 543 9021 FORMAT('IXMINS,IXMAXS,IXDELS = ',3I8) 544 CALL DPWRST('XXX','BUG ') 545 9090 CONTINUE 546C 547 RETURN 548 END 549 SUBROUTINE DPRDN(ICHAR2,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS, 550 1IBUGD2,IFOUND,IERROR) 551C 552C PURPOSE--DEFINE AND SET THE HERSHEY CHARACTER SET COORDINATES 553C FOR ROMAN DUPLEX NUMERIC. 554C WRITTEN BY--JAMES J. FILLIBEN 555C STATISTICAL ENGINEERING DIVISION 556C CENTER FOR APPLIED MATHEMATICS 557C NATIONAL BUREAU OF STANDARDS 558C WASHINGTON, D. C. 20234 559C PHONE--301-921-3651 560C NOTE--DATAPLOT IS A REGISTERED TRADEMARK 561C OF THE NATIONAL BUREAU OF STANDARDS. 562C LANGUAGE--ANSI FORTRAN (1977) 563C VERSION NUMBER--87/4 564C ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MARCH 1981. 565C UPDATED --MAY 1982. 566C UPDATED --MARCH 1987. 567C 568C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- 569C 570 CHARACTER*4 ICHAR2 571 CHARACTER*4 IOP 572 CHARACTER*4 IBUGD2 573 CHARACTER*4 IFOUND 574 CHARACTER*4 IERROR 575C 576C--------------------------------------------------------------------- 577C 578 DIMENSION IOP(*) 579 DIMENSION X(*) 580 DIMENSION Y(*) 581C 582C--------------------------------------------------------------------- 583C 584 INCLUDE 'DPCOP2.INC' 585C 586C-----START POINT----------------------------------------------------- 587C 588 IFOUND='NO' 589 IERROR='NO' 590C 591 NUMCO=1 592 ISTART=1 593 ISTOP=1 594 NC=1 595C 596C ****************************************** 597C ** TREAT THE ROMAN SIMPLEX UPPER CASE ** 598C ** HERSHEY CHARACTER SET CASE ** 599C ****************************************** 600C 601C 602 IF(IBUGD2.EQ.'OFF')GOTO90 603 WRITE(ICOUT,999) 604 999 FORMAT(1X) 605 CALL DPWRST('XXX','BUG ') 606 WRITE(ICOUT,51) 607 51 FORMAT('***** AT THE BEGINNING OF DPRDN--') 608 CALL DPWRST('XXX','BUG ') 609 WRITE(ICOUT,52)ICHAR2 610 52 FORMAT('ICHAR2 = ',A4) 611 CALL DPWRST('XXX','BUG ') 612 WRITE(ICOUT,59)IBUGD2,IFOUND,IERROR 613 59 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4) 614 CALL DPWRST('XXX','BUG ') 615 90 CONTINUE 616C 617C ************************************************** 618C ** STEP 1-- ** 619C ** SEARCH FOR THE INPUT CHARACTER(S). ** 620C ** MAP THE CHARACTER(S) INTO A NUMERIC VALUE. ** 621C ************************************************** 622C 623 CALL DPCHNU(ICHAR2,ICHARN,IBUGD2,IFOUND) 624 IF(IFOUND.EQ.'NO')GOTO9000 625C 626 IF(ICHARN.LE.8)GOTO1010 627 GOTO1019 628 1010 CONTINUE 629 CALL DRDN1(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS, 630 1IBUGD2,IFOUND,IERROR) 631 GOTO9000 632 1019 CONTINUE 633C 634 IF(ICHARN.GE.9)GOTO1020 635 GOTO1029 636 1020 CONTINUE 637 CALL DRDN2(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS, 638 1IBUGD2,IFOUND,IERROR) 639 GOTO9000 640 1029 CONTINUE 641C 642 IFOUND='NO' 643 GOTO9000 644C 645C ***************** 646C ** STEP 90-- ** 647C ** EXIT ** 648C ***************** 649C 650 9000 CONTINUE 651 IF(IBUGD2.EQ.'OFF')GOTO9090 652 WRITE(ICOUT,999) 653 CALL DPWRST('XXX','BUG ') 654 WRITE(ICOUT,9011) 655 9011 FORMAT('***** AT THE END OF DPRDN--') 656 CALL DPWRST('XXX','BUG ') 657 WRITE(ICOUT,9012)IBUGD2,IFOUND,IERROR 658 9012 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4) 659 CALL DPWRST('XXX','BUG ') 660 WRITE(ICOUT,9013)ICHAR2,ICHARN 661 9013 FORMAT('ICHAR2,ICHARN = ',A4,I8) 662 CALL DPWRST('XXX','BUG ') 663 WRITE(ICOUT,9014)ISTART,ISTOP,NC,NUMCO 664 9014 FORMAT('ISTART,ISTOP,NC,NUMCO = ',4I8) 665 CALL DPWRST('XXX','BUG ') 666 IF(NUMCO.GE.1.AND.NUMCO.LE.1000)GOTO9019 667 DO9015I=1,NUMCO 668 WRITE(ICOUT,9016)I,IOP(I),X(I),Y(I) 669 9016 FORMAT('I,IOP(I),X(I),Y(I) = ',I8,2X,A4,2F10.2) 670 CALL DPWRST('XXX','BUG ') 671 9015 CONTINUE 672 9019 CONTINUE 673 WRITE(ICOUT,9021)IXMINS,IXMAXS,IXDELS 674 9021 FORMAT('IXMINS,IXMAXS,IXDELS = ',3I8) 675 CALL DPWRST('XXX','BUG ') 676 9090 CONTINUE 677C 678 RETURN 679 END 680 SUBROUTINE DPRDS(ICHAR2,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS, 681 1IBUGD2,IFOUND,IERROR) 682C 683C PURPOSE--DEFINE AND SET THE HERSHEY CHARACTER SET COORDINATES 684C FOR ROMAN DUPLEX SYMBOLS. 685C WRITTEN BY--JAMES J. FILLIBEN 686C STATISTICAL ENGINEERING DIVISION 687C CENTER FOR APPLIED MATHEMATICS 688C NATIONAL BUREAU OF STANDARDS 689C WASHINGTON, D. C. 20234 690C PHONE--301-921-3651 691C NOTE--DATAPLOT IS A REGISTERED TRADEMARK 692C OF THE NATIONAL BUREAU OF STANDARDS. 693C LANGUAGE--ANSI FORTRAN (1977) 694C VERSION NUMBER--87/4 695C ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MARCH 1981. 696C UPDATED --MARCH 1982. 697C UPDATED --MARCH 1987. 698C UPDATED --MAY 1982. 699C 700C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- 701C 702 CHARACTER*4 ICHAR2 703 CHARACTER*4 IOP 704 CHARACTER*4 IBUGD2 705 CHARACTER*4 IFOUND 706 CHARACTER*4 IERROR 707C 708C--------------------------------------------------------------------- 709C 710 DIMENSION IOP(*) 711 DIMENSION X(*) 712 DIMENSION Y(*) 713C 714C--------------------------------------------------------------------- 715C 716 INCLUDE 'DPCOP2.INC' 717C 718C-----START POINT----------------------------------------------------- 719C 720 IFOUND='NO' 721 IERROR='NO' 722C 723 NUMCO=1 724 ISTART=1 725 ISTOP=1 726 NC=1 727C 728C ****************************************** 729C ** TREAT THE ROMAN SIMPLEX UPPER CASE ** 730C ** HERSHEY CHARACTER SET CASE ** 731C ****************************************** 732C 733C 734 IF(IBUGD2.EQ.'OFF')GOTO90 735 WRITE(ICOUT,999) 736 999 FORMAT(1X) 737 CALL DPWRST('XXX','BUG ') 738 WRITE(ICOUT,51) 739 51 FORMAT('***** AT THE BEGINNING OF DPRDS--') 740 CALL DPWRST('XXX','BUG ') 741 WRITE(ICOUT,52)ICHAR2 742 52 FORMAT('ICHAR2 = ',A4) 743 CALL DPWRST('XXX','BUG ') 744 WRITE(ICOUT,59)IBUGD2,IFOUND,IERROR 745 59 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4) 746 CALL DPWRST('XXX','BUG ') 747 90 CONTINUE 748C 749C ************************************************** 750C ** STEP 1-- ** 751C ** SEARCH FOR THE INPUT CHARACTER(S). ** 752C ** MAP THE CHARACTER(S) INTO A NUMERIC VALUE. ** 753C ************************************************** 754C 755 CALL DPCHSY(ICHAR2,ICHARN,IBUGD2,IFOUND) 756 IF(IFOUND.EQ.'NO')GOTO9000 757C 758 IF(ICHARN.LE.9)GOTO1010 759 GOTO1019 760 1010 CONTINUE 761 CALL DRDS1(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS, 762 1IBUGD2,IFOUND,IERROR) 763 GOTO9000 764 1019 CONTINUE 765C 766 IF(ICHARN.GE.10)GOTO1020 767 GOTO1029 768 1020 CONTINUE 769 CALL DRDS2(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS, 770 1IBUGD2,IFOUND,IERROR) 771 GOTO9000 772 1029 CONTINUE 773C 774 IFOUND='NO' 775 GOTO9000 776C 777C ***************** 778C ** STEP 90-- ** 779C ** EXIT ** 780C ***************** 781C 782 9000 CONTINUE 783 IF(IBUGD2.EQ.'OFF')GOTO9090 784 WRITE(ICOUT,999) 785 CALL DPWRST('XXX','BUG ') 786 WRITE(ICOUT,9011) 787 9011 FORMAT('***** AT THE END OF DPRDS--') 788 CALL DPWRST('XXX','BUG ') 789 WRITE(ICOUT,9012)IBUGD2,IFOUND,IERROR 790 9012 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4) 791 CALL DPWRST('XXX','BUG ') 792 WRITE(ICOUT,9013)ICHAR2,ICHARN 793 9013 FORMAT('ICHAR2,ICHARN = ',A4,I8) 794 CALL DPWRST('XXX','BUG ') 795 WRITE(ICOUT,9014)ISTART,ISTOP,NC,NUMCO 796 9014 FORMAT('ISTART,ISTOP,NC,NUMCO = ',4I8) 797 CALL DPWRST('XXX','BUG ') 798 IF(NUMCO.GE.1.AND.NUMCO.LE.1000)GOTO9019 799 DO9015I=1,NUMCO 800 WRITE(ICOUT,9016)I,IOP(I),X(I),Y(I) 801 9016 FORMAT('I,IOP(I),X(I),Y(I) = ',I8,2X,A4,2F10.2) 802 CALL DPWRST('XXX','BUG ') 803 9015 CONTINUE 804 9019 CONTINUE 805 WRITE(ICOUT,9021)IXMINS,IXMAXS,IXDELS 806 9021 FORMAT('IXMINS,IXMAXS,IXDELS = ',3I8) 807 CALL DPWRST('XXX','BUG ') 808 9090 CONTINUE 809C 810 RETURN 811 END 812 SUBROUTINE DPRDU(ICHAR2,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS, 813 1IBUGD2,IFOUND,IERROR) 814C 815C PURPOSE--DEFINE AND SET THE HERSHEY CHARACTER SET COORDINATES 816C FOR ROMAN DUPLEX UPPER CASE. 817C WRITTEN BY--JAMES J. FILLIBEN 818C STATISTICAL ENGINEERING DIVISION 819C CENTER FOR APPLIED MATHEMATICS 820C NATIONAL BUREAU OF STANDARDS 821C WASHINGTON, D. C. 20234 822C PHONE--301-921-3651 823C NOTE--DATAPLOT IS A REGISTERED TRADEMARK 824C OF THE NATIONAL BUREAU OF STANDARDS. 825C LANGUAGE--ANSI FORTRAN (1977) 826C VERSION NUMBER--87/4 827C ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MARCH 1981. 828C UPDATED --MAY 1982. 829C UPDATED --MARCH 1987. 830C 831C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- 832C 833 CHARACTER*4 ICHAR2 834 CHARACTER*4 IOP 835 CHARACTER*4 IBUGD2 836 CHARACTER*4 IFOUND 837 CHARACTER*4 IERROR 838C 839C--------------------------------------------------------------------- 840C 841 DIMENSION IOP(*) 842 DIMENSION X(*) 843 DIMENSION Y(*) 844C 845C--------------------------------------------------------------------- 846C 847 INCLUDE 'DPCOP2.INC' 848C 849C-----START POINT----------------------------------------------------- 850C 851 IFOUND='NO' 852 IERROR='NO' 853C 854 NUMCO=1 855 ISTART=1 856 ISTOP=1 857 NC=1 858C 859C ****************************************** 860C ** TREAT THE ROMAN SIMPLEX UPPER CASE ** 861C ** HERSHEY CHARACTER SET CASE ** 862C ****************************************** 863C 864C 865 IF(IBUGD2.EQ.'OFF')GOTO90 866 WRITE(ICOUT,999) 867 999 FORMAT(1X) 868 CALL DPWRST('XXX','BUG ') 869 WRITE(ICOUT,51) 870 51 FORMAT('***** AT THE BEGINNING OF DPRDU--') 871 CALL DPWRST('XXX','BUG ') 872 WRITE(ICOUT,52)ICHAR2 873 52 FORMAT('ICHAR2 = ',A4) 874 CALL DPWRST('XXX','BUG ') 875 WRITE(ICOUT,59)IBUGD2,IFOUND,IERROR 876 59 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4) 877 CALL DPWRST('XXX','BUG ') 878 90 CONTINUE 879C 880C ************************************************** 881C ** STEP 1-- ** 882C ** SEARCH FOR THE INPUT CHARACTER(S). ** 883C ** MAP THE CHARACTER(S) INTO A NUMERIC VALUE. ** 884C ************************************************** 885C 886 CALL DPCHAL(ICHAR2,ICHARN,IBUGD2,IFOUND) 887 IF(IFOUND.EQ.'NO')GOTO9000 888C 889 IF(ICHARN.LE.14)GOTO1010 890 GOTO1019 891 1010 CONTINUE 892 CALL DRDU1(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS, 893 1IBUGD2,IFOUND,IERROR) 894 GOTO9000 895 1019 CONTINUE 896C 897 IF(ICHARN.GE.15)GOTO1020 898 GOTO1029 899 1020 CONTINUE 900 CALL DRDU2(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS, 901 1IBUGD2,IFOUND,IERROR) 902 GOTO9000 903 1029 CONTINUE 904C 905 IFOUND='NO' 906 GOTO9000 907C 908C ***************** 909C ** STEP 90-- ** 910C ** EXIT ** 911C ***************** 912C 913 9000 CONTINUE 914 IF(IBUGD2.EQ.'OFF')GOTO9090 915 WRITE(ICOUT,999) 916 CALL DPWRST('XXX','BUG ') 917 WRITE(ICOUT,9011) 918 9011 FORMAT('***** AT THE END OF DPRDU--') 919 CALL DPWRST('XXX','BUG ') 920 WRITE(ICOUT,9012)IBUGD2,IFOUND,IERROR 921 9012 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4) 922 CALL DPWRST('XXX','BUG ') 923 WRITE(ICOUT,9013)ICHAR2,ICHARN 924 9013 FORMAT('ICHAR2,ICHARN = ',A4,I8) 925 CALL DPWRST('XXX','BUG ') 926 WRITE(ICOUT,9014)ISTART,ISTOP,NC,NUMCO 927 9014 FORMAT('ISTART,ISTOP,NC,NUMCO = ',4I8) 928 CALL DPWRST('XXX','BUG ') 929 IF(NUMCO.GE.1.AND.NUMCO.LE.1000)GOTO9019 930 DO9015I=1,NUMCO 931 WRITE(ICOUT,9016)I,IOP(I),X(I),Y(I) 932 9016 FORMAT('I,IOP(I),X(I),Y(I) = ',I8,2X,A4,2F10.2) 933 CALL DPWRST('XXX','BUG ') 934 9015 CONTINUE 935 9019 CONTINUE 936 WRITE(ICOUT,9021)IXMINS,IXMAXS,IXDELS 937 9021 FORMAT('IXMINS,IXMAXS,IXDELS = ',3I8) 938 CALL DPWRST('XXX','BUG ') 939 9090 CONTINUE 940C 941 RETURN 942 END 943 SUBROUTINE DPREAD(IFROW1,IFROW2,IFCOL1,IFCOL2,ISKIP,INTINF, 944 1 IMACRO,IMACNU,IMACCS,IMALEV,IOSW,ICREAF,NCREAF, 945 1 IREARW,ICOMCH,ICOMSW, 946 1 IUNFOF,IUNFNR,IUNFMC,NUMRCM, 947 1 IFCOLL,IFCOLU, 948 1 IANSLO,ILOOST,ILOOLI,IREPCH, 949 1 IBUGS2,IBUGQ,ISUBRO,IFOUND,IERROR) 950CCCCC MAY 1990. ADD ICOMCH, ICOMSW TO CALL LIST 951CCCCC APRIL, 1995. ADD IUNFOF, IYNFNR, IUNFMC TO CALL LIST 952CCCCC MARCH, 1996. ADD IMALEV TO CALL LIST 953CCCCC FEBRUARY 2003. ADD NUMRCM TO CALL LIST 954CCCCC JANUARY 2015. ADD "LOOP" ARGUMENTS 955C 956C PURPOSE--READ IN THE VALUES OF A VARIABLE. THE DATA IS LISTED 957C ACROSS A LINE IMAGE. (E.G., X(1) Y(1) Z(1) ETC.) 958C THE DATA IS READ FORM A MASS STORAGE FILE 959C OR (IF NO FILE GIVEN) FROM THE DEFAULT INPUT UNIT 960C (WHICH WILL BE THE TERMINAL). 961C ASSUMPTION--THE INPUT FILE ALREADY EXISTS; (THAT IS, DATAPLOT 962C WILL AUTOMATICALLY OPEN THE FILE 963C VIA (ON THE UNIVAC 1108), BY AN @ASG,AX ...) 964C BUT WILL NOT AUTOMATICALLY CREATE THE FILE 965C VIA (ON THE UNIVAC 1108), BY AN @ASG,UP ...)) 966C ASSUMPTION--THE COMPUTER SYSTEM IS SUCH THAT EQUATING THE FILE NAME 967C TO THE FORTRAN NUMERIC DESIGNATION OF 31 (OR HOWEVER 968C THE VARIABLE IREANU IS DEFINED IN INITFO) IS 969C PERMISSIBLE. 970C NOTE--INPUT FOR THE READ COMMAND MAY POTENTIALLY 971C COME FROM 2 DIFFERENT SOURCES-- 972C 1) THE TERMINAL ITSELF; 973C 2) A FILE; 974C DIFFERENT SYSTEMS ALLOW DIFFERENT COMBINATIONS OF THE ABOVE. 975C ALL SYSTEMS WILL ALLOW INPUT FROM THER TERMINAL ITSELF; 976C MOST SYSTEMS WILL ALLOW INPUT FROM A FILE; 977C NOTE--ICOMCH = THE ALLOWABLE COMMENT CHARACTER 978C ICOMSW = THE COMMENT CHARACTER FLAG/SWITCH (ON/OFF) 979C WRITTEN BY--JAMES J. FILLIBEN 980C STATISTICAL ENGINEERING DIVISION 981C INFORMATION TECHNOLOGY LABORATORY 982C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 983C GAITHERSBURG, MD 20899-8980 984C PHONE--301-975-2855 985C NOTE--DATAPLOT IS A REGISTERED TRADEMARK 986C OF THE NATIONAL BUREAU OF STANDARDS. 987C LANGUAGE--ANSI FORTRAN (1977) 988C VERSION NUMBER--82/7 989C ORIGINAL VERSION--DECEMBER 1977. 990C UPDATED --JANUARY 1978. 991C UPDATED --FEBRUARY 1978. 992C UPDATED --MAY 1978. 993C UPDATED --JULY 1978. 994C UPDATED --NOVEMBER 1978. 995C UPDATED --NOVEMBER 1980. 996C UPDATED --JANUARY 1981. 997C UPDATED --JUNE 1981. 998C UPDATED --NOVEMBER 1981. 999C UPDATED --JANUARY 1982. 1000C UPDATED --MARCH 1982. 1001C UPDATED --MAY 1982. 1002C UPDATED --DECEMBER 1985. 1003C UPDATED --SEPTEMBER 1987. (READ MATRIX) 1004C UPDATED --FEBRUARY 1988. DEACT. COL. LIM. IF READ NON-FILE) 1005C UPDATED --JUNE 1988. (CORRECT DOUBLE ENTRY BY READ FUNCT 1006C UPDATED --DECEMBER 1988. CORRECT BOMB ON 2ND READ PARAMETER 1007C UPDATED --MAY 1989. FIX IRIS PROBLEM--LOOP MAX & CPUMAX 1008C UPDATED --MAY 1990. CHECK FOR COMMENT CHARACTER (UNIX) 1009C UPDATED --MAY 1990. ERROR CHECK FOR FORMATTED READ 1010C UPDATED --JUNE 1990. FIX FORMATTED READ/1 LINE BUG 1011C UPDATED --JULY 1990. UPDATED WRITE/FORMAT STATEMENT 1012C UPDATED --JULY 1990. BUG/TRACE PRINT OF ICOMCH/FL 1013C UPDATED --JULY 1990. COMMENT CHECK BUG FIXED 1014C UPDATED --JULY 1990. RENAME ICOMFL TO ICOMSW 1015C UPDATED --JULY 1993. FIX MATRIX READ (ALAN) 1016C UPDATED --JULY 1993. FIX BOMB IF GOOD READ AFTER 1017C READ NON-EXISTENT FILE 1018C UPDATED --MARCH 1994. FIX BUG WHERE DELETE AND 1019C RETAIN WIPED OUT PARAMETERS 1020C CREATED VIA READ PARAMETER 1021C UPDATED --APRIL 1995. SUPPORT FOR UNFORMATTED READ 1022C UPDATED --SEPTEMBER 1995. ROW LIMITS & BLANK LINES PROBLEM 1023C UPDATED --MARCH 1996. FIX BUG WHERE TERMINAL READ 1024C NESTED WITHIN A MACRO 1025C UPDATED --APRIL 1996. FOR READ STRING, IGNORE SET 1026C READ FORMAT 1027C UPDATED --OCTOBER 1997. SUPPORT "SKIP AUTOMATIC", 1028C READ UNTIL FIND "----" 1029C UPDATED --NOVEMBER 1998. READ MORE THAN 100 VARIABLES 1030C (MAKE PARAMETER SETTABLE) 1031C UPDATED --DECEMBER 1999. READ ROWID 1032C UPDATED --MARCH 2001. FIX BUGS: 1033C A) UPDATE LIMIT ON MAX COLUMNS 1034C B) OFFSET FOR UNFORMATTED READ 1035C C) MAX FOR ROW LIMITS 1036C UPDATED --JULY 2002. SUPPORT FOR QUOTES ON 1037C FILE NAMES. 1038C UPDATED --FEBRUARY 2003. UP MAXIMUM NUMBER OF 1039C CHARACTERS READ FROM ONE 1040C RECORD OF DATA FILE (MAKE 1041C SETTABLE TO PARAMETER) 1042C UPDATED --FEBRUARY 2003. AUTOMATICALLY DETERMINE 1043C NUMBER OF VARIABLES IF NO 1044C LIST GIVEN. 1045C UPDATED --JUNE 2003. HANDLE HYPHENS INSIDE OF QUOTED 1046C FILE NAMES CORRECTLY. 1047C UPDATED --JULY 2003. BUG WHEN FILE NAME < 80 1048C CHARACTERS, BUT COMMAND LINE 1049C > 80 CHARACTERS 1050C UPDATED --AUGUST 2003. QUOTES ON FILE NAMES 1051C AUTOMATIC FOR READ 1052C UPDATED --JANUARY 2004. IF AUTOMATICALLY DETERMINE 1053C VARIABLE LIST, CHECK FIRST 1054C LINE FOR VARIABLE LIST 1055C UPDATED --JANUARY 2004. SOME RECODING FOR BETTER 1056C CLARITY 1057C UPDATED --JANUARY 2004. HANDLE CHARACTER DATA 1058C UPDATED --OCTOBER 2004. WHEN READING VARIABLES, IF 1059C NUMBER OF ITEMS IS GREATER 1060C THAN NUMBER OF ITEMS READ, 1061C PAD WITH "MISSING VALUE" 1062C (BASED ON VALUE OF IREAPD) 1063C UPDATED --OCTOBER 2004. SET READ SUBSET 1064C <PACK/DISPERSE> <PACK/DISPERSE> 1065C UPDATED --DECEMBER 2004. IF GUI RUNNING (SET GUI), THEN 1066C DO NOT ALLOW TERMINAL READ 1067C UPDATED --DECEMBER 2007. > 100 COLUMNS FOR MATRIX 1068C UPDATED --MARCH 2008. ADD: 1069C READ MATRIX TO VARIABLE FILE.DAT 1070C Z ROWID COLID 1071C UPDATED --MARCH 2008. ADD: 1072C READ STACKED VARIABLE FILE.DAT 1073C Z GROUPID <VARI-LIST> 1074C UPDATED --MARCH 2008. ADD: 1075C READ IMAGE TO VARIABLE FILE.DAT 1076C Z ROWID COLID 1077C READ IMAGE TO VARIABLE FILE.DAT 1078C RED BLUE GREEN ROWID COLID 1079C UPDATED --APRIL 2009. ADD "IDATMV" TO DPREAL CALL 1080C UPDATED --APRIL 2009. WHEN READING IMAGES, CHECK 1081C FOR DATAPLOT DIRECTORIES TO 1082C MATCH FILE NAME 1083C UPDATED --JULY 2009. ALLOW "Y1 TO Y1" (USEFUL FOR 1084C MACROS WHERE THE NUMBER OF 1085C VARIABLES NOT KNOWN IN ADVANCE) 1086C UPDATED --JULY 2014. ADDITIONAL IMAGE TYPES FROM 1087C GD LIBRARY (BMP, WBMP, WEBP, 1088C TGA, TIF, XPM) 1089C UPDATED --OCTOBER 2014. SOME TWEAKS FOR CASE WHEN NO 1090C VARIABLE NAMES GIVEN ON READ 1091C COMMAND 1092C UPDATED --NOVEMBER 2014. READ FROM SYSTEM CLIPBOARD 1093C (OS/COMPILER DEPENDENT) 1094C SUPPORTED FOR READING A LIST OF 1095C VARIABLES OR FOR READING A 1096C STRING 1097C UPDATED --JANUARY 2015. IF HAVE READ FROM TERMINAL WHILE 1098C IN LOOP, READ FROM SAVED LOOP 1099C COMMANDS RATHER THAN STANDARD 1100C INPUT (OR MACRO FILE) 1101C UPDATED --MARCH 2015. CALL LIST TO DPINFU 1102C UPDATED --JUNE 2016. CALL LIST TO DPREAL 1103C UPDATED --MARCH 2017. CHECK FOR "," WHEN READING 1104C VARIABLE NAMES FROM FIRST LINE 1105C UPDATED --JUNE 2018. CORRECT HANDLING OF CHARACTER 1106C DATA WITH " TO " SYNTAX 1107C UPDATED --JUNE 2018. IF ERROR ENCOUNTERED IN DPREAL, 1108C STOP PROCESSING 1109C UPDATED --JUNE 2018. SET CONVERT CHARACTER 1110C CATEGORICAL 1111C (AUTOMATICALLY CONVERT 1112C CHARACTER DATA TO NUMERIC 1113C CATEGORICAL VARIABLE) 1114C UPDATED --SEPTEMBER 2018. ROW READ OPTION 1115C UPDATED --DECEMBER 2018. READ1/READ2/READ3 OPTIONS 1116C UPDATED --APRIL 2019. SET READ ASTERISK IGNORE 1117C UPDATED --JUNE 2019. RAISED MAXIMUM NUMBER OF 1118C CHARACTER VARIABLES TO 50 1119C UPDATED --JUNE 2019. INITIALIZE IRWLC3 TO 0 1120C UPDATED --JULY 2019. TWEAK SCRATCH SPACE 1121C UPDATED --SEPTEMBER 2019. ALLOWS CHARACTER VARIABLES FROM 1122C TERMINAL READ 1123C UPDATED --OCTOBER 2019. IF FILE EXTENSION IS ".csv" OR 1124C ".CSV", AUTOMATICALLY SET READ 1125C DELIMITER TO "," 1126C UPDATED --FEBRUARY 2020. READ EXCEL OPTION (THIS WILL USE 1127C PYTHON (Pandas) TO READ THE 1128C EXCEL FILE TO "dpst1f.dat"), 1129C READ COMMAND WILL THEN READ 1130C "dpst1f.dat". 1131C UPDATED --FEBRUARY 2020. FOR "READ CLIPBOARD", CHECK IF 1132C "CLIPBOARD" ARGUMENT IS ACTUALLY 1133C A FILE NAME 1134C 1135C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- 1136C 1137 CHARACTER*4 IMACRO 1138 CHARACTER*12 IMACCS 1139 CHARACTER*4 ILOOST 1140 CHARACTER*1 IREPCH 1141C 1142 CHARACTER*80 ICREAF 1143C 1144 CHARACTER*4 IOSW 1145 CHARACTER*4 IREARW 1146 CHARACTER*4 IGRPA2 1147 CHARACTER*4 ICFLAG 1148 CHARACTER*4 IBUGS2 1149 CHARACTER*4 IBUGQ 1150 CHARACTER*4 ISUBRO 1151 CHARACTER*4 IFOUND 1152 CHARACTER*4 IERROR 1153C 1154 CHARACTER*4 ICASEQ 1155 CHARACTER*4 ICASEA 1156 CHARACTER*4 IEND 1157 CHARACTER*4 IH1 1158 CHARACTER*4 IH2 1159 CHARACTER*4 ISUBN1 1160 CHARACTER*4 ISUBN2 1161 CHARACTER*4 ISTEPN 1162 CHARACTER*4 IFMFLG 1163 CHARACTER*4 ICRFLG 1164C 1165 CHARACTER*4 ICASRE 1166 CHARACTER*4 ICASR2 1167 CHARACTER*4 ICASR3 1168 CHARACTER*4 ICASR4 1169 CHARACTER*4 IOFILE 1170 CHARACTER*4 IOTERM 1171 CHARACTER*4 IREAD2 1172 CHARACTER*4 IFILQ2 1173C 1174 INCLUDE 'DPCOPA.INC' 1175C 1176CCCCC CHARACTER*80 IFILE 1177 CHARACTER (LEN=MAXFNC) :: IFILE 1178 CHARACTER*12 ISTAT 1179 CHARACTER*12 IFORM 1180 CHARACTER*12 IACCES 1181 CHARACTER*12 IPROT 1182 CHARACTER*12 ICURST 1183 CHARACTER*4 IENDFI 1184 CHARACTER*4 IREWIN 1185 CHARACTER*4 ISUBN0 1186 CHARACTER*4 IERRFI 1187C 1188 CHARACTER*9999 ISTR 1189 CHARACTER*20 IFRMT 1190 CHARACTER*20 IFRMT2 1191 CHARACTER*20 IFRMT3 1192 CHARACTER*4 IOP 1193 CHARACTER*4 IOPEN 1194 CHARACTER*8 IACC 1195C 1196CCCCC CHARACTER*80 IFILE1 1197 CHARACTER (LEN=MAXFNC) :: IFILE1 1198 CHARACTER*12 ISTAT1 1199 CHARACTER*12 IFORM1 1200 CHARACTER*12 IACCE1 1201 CHARACTER*12 IPROT1 1202 CHARACTER*12 ICURS1 1203 CHARACTER*4 IERRF1 1204 CHARACTER*4 IENDF1 1205 CHARACTER*4 IREWI1 1206C 1207CCCCC CHARACTER*80 IFILE2 1208 CHARACTER (LEN=MAXFNC) :: IFILE2 1209 CHARACTER*12 ISTAT2 1210 CHARACTER*12 IFORM2 1211 CHARACTER*12 IACCE2 1212 CHARACTER*12 IPROT2 1213 CHARACTER*12 ICURS2 1214 CHARACTER*4 IERRF2 1215 CHARACTER*4 IENDF2 1216 CHARACTER*4 IREWI2 1217C 1218CCCCC CHARACTER*80 IFILE3 1219 CHARACTER (LEN=MAXFNC) :: IFILE3 1220 CHARACTER*12 ISTAT3 1221 CHARACTER*12 IFORM3 1222 CHARACTER*12 IACCE3 1223 CHARACTER*12 IPROT3 1224 CHARACTER*12 ICURS3 1225 CHARACTER*4 IERRF3 1226 CHARACTER*4 IENDF3 1227 CHARACTER*4 IREWI3 1228C 1229CCCCC CHARACTER*80 IFILE4 1230 CHARACTER (LEN=MAXFNC) :: IFILE4 1231 CHARACTER*12 ISTAT4 1232 CHARACTER*12 IFORM4 1233 CHARACTER*12 IACCE4 1234 CHARACTER*12 IPROT4 1235 CHARACTER*12 ICURS4 1236 CHARACTER*4 IERRF4 1237 CHARACTER*4 IENDF4 1238 CHARACTER*4 IREWI4 1239C 1240CCCCC CHARACTER*80 IFILE5 1241 CHARACTER (LEN=MAXFNC) :: IFILE5 1242 CHARACTER*12 ISTAT5 1243 CHARACTER*12 IFORM5 1244 CHARACTER*12 IACCE5 1245 CHARACTER*12 IPROT5 1246 CHARACTER*12 ICURS5 1247 CHARACTER*4 IERRF5 1248 CHARACTER*4 IENDF5 1249 CHARACTER*4 IREWI5 1250C 1251 COMMON/FILTMP/IFILE1, ISTAT1, IFORM1, IACCE1, IPROT1, ICURS1, 1252 1 IERRF1, IENDF1, IREWI1, 1253 1 IFILE2, ISTAT2, IFORM2, IACCE2, IPROT2, ICURS2, 1254 1 IERRF2, IENDF2, IREWI2, 1255 1 IFILE3, ISTAT3, IFORM3, IACCE3, IPROT3, ICURS3, 1256 1 IERRF3, IENDF3, IREWI3, 1257 1 IFILE4, ISTAT4, IFORM4, IACCE4, IPROT4, ICURS4, 1258 1 IERRF4, IENDF4, IREWI4, 1259 1 IFILE5, ISTAT5, IFORM5, IACCE5, IPROT5, ICURS5, 1260 1 IERRF5, IENDF5, IREWI5 1261C 1262CCCCC CHARACTER*80 FTEMP 1263 CHARACTER (LEN=MAXFNC) :: FTEMP 1264C 1265 CHARACTER*4 ISTRZ2(8) 1266C 1267CCCCC CHARACTER*255 ICANS 1268 CHARACTER (LEN=MAXSTR) :: ICANS 1269 CHARACTER*4 IHLEFT 1270 CHARACTER*4 IHLEF2 1271 CHARACTER*4 NEWNAM 1272 CHARACTER*8 IVBASE 1273 CHARACTER*8 IVBASV 1274 CHARACTER*8 IVTEMP 1275 CHARACTER*4 IRTYPE 1276CCCCC CHARACTER*255 ISTRZZ 1277 CHARACTER (LEN=MAXSTR) :: ISTRZZ 1278C 1279 CHARACTER*4 ICASTO 1280 CHARACTER*4 IHMAT1 1281 CHARACTER*4 IHMAT2 1282 CHARACTER*80 IAJUNK 1283 CHARACTER*4 ICOMCH 1284 CHARACTER*4 ICOMSW 1285 CHARACTER*4 LINETY 1286 CHARACTER*4 IEXIST 1287 CHARACTER*4 IEXCEL 1288 CHARACTER*4 ITYPEZ 1289 CHARACTER*80 ISNAME 1290 CHARACTER*80 ISARGL 1291C 1292 INCLUDE 'DPCOZZ.INC' 1293 INCLUDE 'DPCOZI.INC' 1294 INCLUDE 'DPCOZC.INC' 1295C 1296CCCCC NOVEMBER 1998. DEFINE MAXRDV TO DEFINE MAXIMUM NUMBER OF 1297CCCCC VARIABLES. 1298C 1299CCCCC MARCH 2001. UP LIMIT (MATRICES IN PARTICULAR CAN HAVE MORE) 1300CCCCC PARAMETER(MAXRDV=250) 1301CCCCC PARAMETER(MAXRDV=1000) 1302 PARAMETER(MAXRDV=2048) 1303 PARAMETER(MAXCHV=50) 1304C 1305 INTEGER IADE(200) 1306 INTEGER IFCOLL(*) 1307 INTEGER IFCOLU(*) 1308 INTEGER ITYPE(MAXRDV) 1309 INTEGER NIV(MAXRDV) 1310 INTEGER IEN(MAXRDV) 1311 INTEGER IECOL2(MAXRDV) 1312 INTEGER IFSTA2(MAXRDV) 1313 INTEGER IFSTO2(MAXRDV) 1314 INTEGER IXCATN(MAXCHV) 1315 INTEGER IECOLC(MAXCHV) 1316 INTEGER IENC(MAXCHV) 1317 DIMENSION X0CAT(MAXCHV) 1318 DIMENSION PVAL(MAXRDV) 1319C 1320CCCCC THE FOLLOWING LINES ADDED FEBRUARY 2003. 1321C 1322 CHARACTER*4 IVRLST 1323 CHARACTER*4 IECASE(MAXRDV) 1324 CHARACTER*4 IVLIST(MAXRDV) 1325 CHARACTER*4 IVLIS2(MAXRDV) 1326 CHARACTER*4 IASAVE(MAXRDV) 1327 CHARACTER*4 ICLIST(MAXRDV) 1328 CHARACTER*4 ICLIS2(MAXRDV) 1329C 1330 CHARACTER*4 JVNAM1(MAXRDV) 1331 CHARACTER*4 JPNAM1(MAXRDV) 1332 CHARACTER*4 JMNAM1(MAXRDV) 1333 CHARACTER*4 JFNAM1(MAXRDV) 1334 CHARACTER*4 JUNAM1(MAXRDV) 1335 CHARACTER*4 JENAM1(MAXRDV) 1336C 1337 CHARACTER*4 JVNAM2(MAXRDV) 1338 CHARACTER*4 JPNAM2(MAXRDV) 1339 CHARACTER*4 JMNAM2(MAXRDV) 1340 CHARACTER*4 JFNAM2(MAXRDV) 1341 CHARACTER*4 JUNAM2(MAXRDV) 1342 CHARACTER*4 JENAM2(MAXRDV) 1343C 1344 CHARACTER*24 IXC(MAXCHV) 1345 CHARACTER*24 IXCAT(1000,MAXCHV) 1346 CHARACTER*4 ISTOR1(MAXRCL) 1347 CHARACTER*4 ISTOR2(MAXRCL) 1348 CHARACTER*4 ISTOR3(MAXRCL) 1349 CHARACTER*4 IB(MAXRCL) 1350C 1351 CHARACTER*4 IANSLO(MAXCIL,MAXLIL) 1352C 1353C-----COMMON---------------------------------------------------------- 1354C 1355 INCLUDE 'DPCOHK.INC' 1356 INCLUDE 'DPCODA.INC' 1357 INCLUDE 'DPCOFO.INC' 1358 INCLUDE 'DPCOF2.INC' 1359 INCLUDE 'DPCOHO.INC' 1360 INCLUDE 'DPCOST.INC' 1361CCCCC MARCH 2001. ADD FOLLOWING LINE 1362 INCLUDE 'DPCOMC.INC' 1363C 1364 DIMENSION XSCRT(3*MAXOBW) 1365 DIMENSION X0(MAXRDV) 1366C 1367 EQUIVALENCE (GARBAG(IGARB1),X0(1)) 1368 EQUIVALENCE (GARBAG(IGARB2),X0CAT(1)) 1369 EQUIVALENCE (GARBAG(IGARB3),XSCRT(1)) 1370C 1371 EQUIVALENCE (IGARBG(IIGAR1),ITYPE(1)) 1372 EQUIVALENCE (IGARBG(IIGAR1+1000),NIV(1)) 1373 EQUIVALENCE (IGARBG(IIGAR1+3000),IEN(1)) 1374 EQUIVALENCE (IGARBG(IIGAR1+5000),IECOL2(1)) 1375 EQUIVALENCE (IGARBG(IIGAR1+7000),IFSTA2(1)) 1376 EQUIVALENCE (IGARBG(IIGAR1+9000),IFSTO2(1)) 1377 EQUIVALENCE (IGARBG(IIGAR1+11000),IADE(1)) 1378 EQUIVALENCE (IGARBG(IIGAR1+13000),IECOLC(1)) 1379 EQUIVALENCE (IGARBG(IIGAR1+15000),IENC(1)) 1380C 1381 EQUIVALENCE (CGARBG(1),IECASE(1)) 1382 EQUIVALENCE (CGARBG(20000),IVLIST(1)) 1383 EQUIVALENCE (CGARBG(40000),IVLIS2(1)) 1384 EQUIVALENCE (CGARBG(60000),IASAVE(1)) 1385 EQUIVALENCE (CGARBG(80000),ICLIST(1)) 1386 EQUIVALENCE (CGARBG(100000),ICLIS2(1)) 1387 EQUIVALENCE (CGARBG(120000),JVNAM1(1)) 1388 EQUIVALENCE (CGARBG(130000),JPNAM1(1)) 1389 EQUIVALENCE (CGARBG(140000),JMNAM1(1)) 1390 EQUIVALENCE (CGARBG(150000),JFNAM1(1)) 1391 EQUIVALENCE (CGARBG(160000),JUNAM1(1)) 1392 EQUIVALENCE (CGARBG(170000),JENAM1(1)) 1393 EQUIVALENCE (CGARBG(180000),JVNAM2(1)) 1394 EQUIVALENCE (CGARBG(190000),JPNAM2(1)) 1395 EQUIVALENCE (CGARBG(200000),JMNAM2(1)) 1396 EQUIVALENCE (CGARBG(210000),JFNAM2(1)) 1397 EQUIVALENCE (CGARBG(220000),JUNAM2(1)) 1398 EQUIVALENCE (CGARBG(230000),JENAM2(1)) 1399 EQUIVALENCE (CGARBG(240000),ISTOR1(1)) 1400 EQUIVALENCE (CGARBG(300000),ISTOR2(1)) 1401 EQUIVALENCE (CGARBG(360000),ISTOR3(1)) 1402 EQUIVALENCE (CGARBG(420000),IB(1)) 1403 EQUIVALENCE (CGARBG(600000),IXC(1)) 1404 EQUIVALENCE (CGARBG(800000),IXCAT(1,1)) 1405C 1406C-----COMMON VARIABLES (GENERAL)-------------------------------------- 1407C 1408 INCLUDE 'DPCOP2.INC' 1409C 1410C-----START POINT----------------------------------------------------- 1411C 1412 ISUBN1='DPRE' 1413 ISUBN2='AD ' 1414 IFOUND='YES' 1415 IERROR='NO' 1416 ICASRE='-999' 1417 ICASR2='-999' 1418 IOFILE='-999' 1419 IOTERM='-999' 1420 IFILQ2=IFILQU 1421 IFILQU='ON' 1422 IREAD2=IREADL 1423 IEXCEL='OFF' 1424 IVBASV=' ' 1425C 1426 ICASR3='0' 1427 IF(ICOM2.EQ.'1 ')ICASR3='1' 1428 IF(ICOM2.EQ.'2 ')ICASR3='2' 1429 IF(ICOM2.EQ.'3 ')ICASR3='3' 1430C 1431 MAXCP1=MAXCOL+1 1432 MAXCP2=MAXCOL+2 1433 MAXCP3=MAXCOL+3 1434 MAXCP4=MAXCOL+4 1435 MAXCP5=MAXCOL+5 1436 MAXCP6=MAXCOL+6 1437 IMNVAR=-1 1438 IMXVAR=-1 1439 IFLGSV=0 1440 ISKPSV=ISKIP 1441 NUMDSV=0 1442 INEXT=0 1443 ICOL=0 1444 J=0 1445 JM1=0 1446 ILINE=0 1447 ILAST=0 1448 IRWLC2=0 1449 NXCSAV=0 1450 ICNTCH=0 1451 IERR=0 1452C 1453CCCCC FEBRUARY 2003: ADD FOLLOWING LINE. 1454CCCCC IF NO VARIABLE LIST GIVEN, THEN TWO CASES: 1455CCCCC 1) IF SKIP AUTOMATIC ON, THEN READ PREVIOUS LINE TO 1456CCCCC DETERMINE VARIABLE LIST. 1457CCCCC 2) IF SKIP AUTOMATIC OFF, THEN READ FIRST LINE TO 1458CCCCC DETERMINE NUMBER OF VARIABLES. NAME THEM X1, X2, ETC. 1459C 1460 IVRLST='YES' 1461 DO15I=1,MAXRDV 1462 IASAVE(I)=' ' 1463 IVLIST(I)=' ' 1464 IVLIS2(I)=' ' 1465 ITYPE(I)=0 1466 JVNAM1(I)=' ' 1467 JVNAM2(I)=' ' 1468 JPNAM1(I)=' ' 1469 JPNAM2(I)=' ' 1470 JMNAM1(I)=' ' 1471 JMNAM2(I)=' ' 1472 JFNAM1(I)=' ' 1473 JFNAM2(I)=' ' 1474 JUNAM1(I)=' ' 1475 JUNAM2(I)=' ' 1476 JENAM1(I)=' ' 1477 JENAM2(I)=' ' 1478 15 CONTINUE 1479 DO13I=1,MAXCHV 1480 IXC(I)=' ' 1481 ICLIST(I)=' ' 1482 ICLIS2(I)=' ' 1483 IECOLC(I)=0 1484 IENC(I)=0 1485 DO14J=1,1000 1486 IXCAT(J,I)=' ' 1487 14 CONTINUE 1488 IXCATN(I)=0 1489 X0CAT(I)=0.0 1490 13 CONTINUE 1491 IGRPA2=IGRPAU 1492C 1493CCCCC THE FOLLOWING LINE WAS INSERTED MAY 1989 1494CCCCC MARCH 2001. SET VALUE TO MAX INTEGER 1495CCCCC IBILLI=10**9 1496 IBILLI=I1MACH(9) 1497 I2=0 1498 NUMVRD=0 1499 NUMPRD=0 1500 NUMFRD=0 1501 MAXN2=MAXCHF 1502 AFROW2=IFROW2 1503 IMATC1=(-999) 1504 IMATNR=(-999) 1505 IMATNC=(-999) 1506 LINETY='-999' 1507 NCALL=0 1508 NCOLS=0 1509 NROWZ=0 1510 NCOLZ=0 1511 ITOTZ=0 1512 IMAGFL=-99 1513 IMAGTY=-99 1514 IMAGCO=1 1515 IMAGSH=0 1516 IRWLC3=0 1517C 1518C *************************** 1519C ** TREAT THE READ CASE ** 1520C *************************** 1521C 1522CCCCC NOVEMBER 1998. DEFINE MAXRDV TO DEFINE MAXIMUM NUMBER OF 1523CCCCC VARIABLES. 1524C 1525 MAXV2=MAXRDV 1526 MAXP2=MAXRDV 1527 MAXM2=MAXRDV 1528 MAXF2=MAXRDV 1529 MAXU2=MAXRDV 1530 MAXE2=MAXRDV 1531C 1532 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')THEN 1533 WRITE(ICOUT,999) 1534 999 FORMAT(1X) 1535 CALL DPWRST('XXX','BUG ') 1536 WRITE(ICOUT,51) 1537 51 FORMAT('***** AT THE BEGINNING OF DPREAD--') 1538 CALL DPWRST('XXX','BUG ') 1539 WRITE(ICOUT,52)IFROW1,AFROW2,IFCOL1,IFCOL2,NUMRCM 1540 52 FORMAT('IFROW1,AFROW2,IFCOL1,IFCOL2,NUMRCM = ',I8,2X,E15.7,3I8) 1541 CALL DPWRST('XXX','BUG ') 1542 WRITE(ICOUT,54)IRD,IRD2,ISKIP,IBUGS2,IBUGQ,IOSW 1543 54 FORMAT('IRD,IRD2,ISKIP,IBUGS2,IBUGQ,IOSW = ',3I8,2X,2(A4,2X),A4) 1544 CALL DPWRST('XXX','BUG ') 1545 WRITE(ICOUT,56)IMACRO,IMACNU,IMACCS 1546 56 FORMAT('IMACRO,IMACNU,IMACCS = ',A4,I8,2X,A12) 1547 CALL DPWRST('XXX','BUG ') 1548 WRITE(ICOUT,63)IBUGS2,ISUBRO,IERROR,ICASR3,IWIDTH 1549 63 FORMAT('IBUGS2,ISUBRO,IERROR,ICASR3,IWIDTH = ',4(A4,2X),I8) 1550 CALL DPWRST('XXX','BUG ') 1551 IF(IWIDTH.GE.1)THEN 1552 WRITE(ICOUT,65)(IANSLC(I),I=1,MIN(100,IWIDTH)) 1553 65 FORMAT('(IANSLC(I),I=1,IWIDTH) = ',100A1) 1554 CALL DPWRST('XXX','BUG ') 1555 ENDIF 1556 WRITE(ICOUT,72)IREANA(1:80) 1557 72 FORMAT('IREANA = ',A80) 1558 CALL DPWRST('XXX','BUG ') 1559 WRITE(ICOUT,73)IREANU,IREAST,IREAFO,IREAAC,IREAFO,IREACS 1560 73 FORMAT('IREANU,IREAST,IREAFO,IREAAC,IREAFO,IREACS = ', 1561 1 I8,5(1X,A12)) 1562 CALL DPWRST('XXX','BUG ') 1563 WRITE(ICOUT,82)NUMNAM,N2,MAXN2,NCREAF 1564 82 FORMAT('NUMNAM,N2,MAXN2,NCREAF = ',4I8) 1565 CALL DPWRST('XXX','BUG ') 1566 IF(NCREAF.GE.1)THEN 1567 WRITE(ICOUT,85)(ICREAF(I:I),I=1,NCREAF) 1568 85 FORMAT('(ICREAF(I:I),I=1,NCREAF) = ',80A1) 1569 CALL DPWRST('XXX','BUG ') 1570 ENDIF 1571 WRITE(ICOUT,87)IREARW,ICOMCH,ICOMSW 1572 87 FORMAT('IREARW,ICOMCH,ICOMSW = ',2(A4,2X),A4) 1573 CALL DPWRST('XXX','BUG ') 1574 ENDIF 1575C 1576C ******************************************************* 1577C ** STEP 1-- ** 1578C ** CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS. ** 1579C ******************************************************* 1580C 1581 ISTEPN='1' 1582 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ') 1583 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) 1584C 1585 IF(NUMARG.LT.1)THEN 1586 IERROR='YES' 1587 GOTO8800 1588 ENDIF 1589C 1590C ***************************************** 1591C ** STEP 1B-- ** 1592C ** DETERMINE THE TYPE OF READ CASE-- ** 1593C ** 1) VARIABLE ** 1594C ** 2) PARAMETER ** 1595C ** 3) FUNCTION (= STRING) ** 1596C ** 4) MATRIX ** 1597C ** 5) MATRIX TO VARIABLE ** 1598C ** 6) STACKED VARIABLE ** 1599C ** 7) IMAGE ** 1600C ** 8) IMAGE TO VARIABLE ** 1601C ** 9) CLIPBOARD ** 1602C ** 10) STRING CLIPBOARD ** 1603C ** 11) ROW READ ** 1604C ** 12) EXCEL ** 1605C ***************************************** 1606C 1607 ICASRE='VARI' 1608 IF(ICASR3.NE.'0')THEN 1609 IF(IHARG(1).EQ.'STRI')THEN 1610 ICASR4='STRI' 1611 ICASRE='LINE' 1612 ELSEIF(IHARG(1).EQ.'NUME')THEN 1613 ICASR4='NUME' 1614 ICASRE='LINE' 1615 ELSE 1616 WRITE(ICOUT,999) 1617 CALL DPWRST('XXX','BUG ') 1618 WRITE(ICOUT,211) 1619 CALL DPWRST('XXX','BUG ') 1620 WRITE(ICOUT,101)ICASR3 1621 101 FORMAT(' FOR READ',A1,' CASE, THE FIRST ARGUMENT') 1622 CALL DPWRST('XXX','BUG ') 1623 WRITE(ICOUT,103) 1624 103 FORMAT(' MUST BE EITHER STRING OR ', 1625 1 'NUMERIC .') 1626 CALL DPWRST('XXX','BUG ') 1627 WRITE(ICOUT,105)IHARG(1) 1628 105 FORMAT(' THE FIRST ARGUMENT IS ',A4) 1629 CALL DPWRST('XXX','BUG ') 1630 IERROR='YES' 1631 GOTO9000 1632 ENDIF 1633 GOTO150 1634 ELSEIF(IHARG(1).EQ.'PARA'.AND.IHARG2(1).EQ.'METE')THEN 1635 ICASRE='PARA' 1636 ELSEIF(IHARG(1).EQ.'FUNC'.AND.IHARG2(1).EQ.'TION' .AND. 1637 1 IHARG(2).EQ.'CLIP' .AND. IHARG2(2).EQ.'BOAR')THEN 1638 ICASRE='CFUN' 1639 ELSEIF(IHARG(1).EQ.'STRI'.AND.IHARG2(1).EQ.'NG ' .AND. 1640 1 IHARG(2).EQ.'CLIP' .AND. IHARG2(2).EQ.'BOAR')THEN 1641 ICASRE='CFUN' 1642 ELSEIF(IHARG(1).EQ.'FUNC'.AND.IHARG2(1).EQ.'TION')THEN 1643 ICASRE='FUNC' 1644 ELSEIF(IHARG(1).EQ.'STRI'.AND.IHARG2(1).EQ.'NG')THEN 1645 ICASRE='FUNC' 1646 ELSEIF(IHARG(1).EQ.'CLIP'.AND.IHARG2(1).EQ.'BOAR')THEN 1647C 1648C CHECK IF ARGUMENT IS A FILE NAME STARTING WITH 1649C "CLIPBOARD. 1650C 1651 IWORD=2 1652 IOFILE='NO' 1653 CALL DPFILE(IANSLC,IWIDTH,IWORD,IOFILE,IBUGS2,ISUBRO,IERROR) 1654 IF(IOFILE.EQ.'NO')ICASRE='CLIP' 1655 ELSEIF(IHARG(1).EQ.'ROW '.AND.IHARG2(1).EQ.' ' .AND. 1656 1 IHARG(2).NE.'LABE')THEN 1657 ICASRE='ROWR' 1658 ELSEIF(IHARG(1).EQ.'MATR'.AND.IHARG2(1).EQ.'IX')THEN 1659 IF(IHARG(2).EQ.'TO ' .AND. IHARG(3).EQ.'VARI')THEN 1660 ICASRE='MATZ' 1661 ELSE 1662 ICASRE='MATR' 1663 ENDIF 1664 ELSEIF(IHARG(1).EQ.'EXCE'.AND.IHARG2(1).EQ.'L ')THEN 1665 IEXCEL='ON' 1666 ISHIFT=1 1667 CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG, 1668 1 IBUGS2,IERROR) 1669 ENDIF 1670C 1671 IF(IHARG(1).EQ.'PNG' .AND. IHARG(2).EQ.'IMAG')THEN 1672 ISHIFT=1 1673 CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG, 1674 1 IBUGS2,IERROR) 1675 IMAGTY=2 1676 ELSEIF((IHARG(1).EQ.'JPG' .OR. IHARG(1).EQ.'JPEG') .AND. 1677 1 IHARG(2).EQ.'IMAG')THEN 1678 ISHIFT=1 1679 CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG, 1680 1 IBUGS2,IERROR) 1681 IMAGTY=1 1682 ELSEIF((IHARG(1).EQ.'GIF' .OR. IHARG(1).EQ.'GIFF') .AND. 1683 1 IHARG(2).EQ.'IMAG')THEN 1684 ISHIFT=1 1685 CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG, 1686 1 IBUGS2,IERROR) 1687 IMAGTY=3 1688 ELSEIF(IHARG(1).EQ.'BMP' .AND. IHARG(2).EQ.'IMAG')THEN 1689 ISHIFT=1 1690 CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG, 1691 1 IBUGS2,IERROR) 1692 IMAGTY=4 1693 ELSEIF(IHARG(1).EQ.'WBMP' .AND. IHARG(2).EQ.'IMAG')THEN 1694 ISHIFT=1 1695 CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG, 1696 1 IBUGS2,IERROR) 1697 IMAGTY=5 1698 ELSEIF(IHARG(1).EQ.'WEBP' .AND. IHARG(2).EQ.'IMAG')THEN 1699 ISHIFT=1 1700 CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG, 1701 1 IBUGS2,IERROR) 1702 IMAGTY=6 1703 ELSEIF(IHARG(1).EQ.'TGA' .AND. IHARG(2).EQ.'IMAG')THEN 1704 ISHIFT=1 1705 CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG, 1706 1 IBUGS2,IERROR) 1707 IMAGTY=7 1708 ELSEIF((IHARG(1).EQ.'TIF' .OR. IHARG(1).EQ.'TIFF') .AND. 1709 1 IHARG(2).EQ.'IMAG')THEN 1710 ISHIFT=1 1711 CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG, 1712 1 IBUGS2,IERROR) 1713 IMAGTY=8 1714 ELSEIF(IHARG(1).EQ.'XPM' .AND. IHARG(2).EQ.'IMAG')THEN 1715 ISHIFT=1 1716 CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG, 1717 1 IBUGS2,IERROR) 1718 IMAGTY=9 1719 ENDIF 1720C 1721 IF(IHARG(1).EQ.'IMAG'.AND.IHARG2(1).EQ.'E')THEN 1722 IF(IHARG(2).EQ.'TO ' .AND. IHARG(3).EQ.'VARI')THEN 1723 ICASRE='IMAZ' 1724 ELSE 1725 ICASRE='IMAG' 1726 IF(IHARG(2).EQ.'RED')THEN 1727 IMAGCO=1 1728 IMAGSH=1 1729 ELSEIF(IHARG(2).EQ.'GREE')THEN 1730 IMAGCO=2 1731 IMAGSH=1 1732 ELSEIF(IHARG(3).EQ.'BLUE')THEN 1733 IMAGCO=3 1734 IMAGSH=1 1735 ELSE 1736 IMAGCO=1 1737 IMAGSH=0 1738 ENDIF 1739 ENDIF 1740 ENDIF 1741C 1742 IF(IHARG(1).EQ.'ROW '.AND.IHARG2(1).EQ.' '.AND. 1743 1 IHARG(2).EQ.'LABE'.AND.IHARG2(2).EQ.'LS')ICASRE='ROWI' 1744 IF(IHARG(1).EQ.'ROW '.AND.IHARG2(1).EQ.' '.AND. 1745 1 IHARG(2).EQ.'LABE'.AND.IHARG2(2).EQ.'L ')ICASRE='ROWI' 1746C 1747 IF(IHARG(1).EQ.'STAC'.AND.IHARG2(1).EQ.'K ')THEN 1748 IF(IHARG(2).EQ.'VARI'.AND.IHARG2(2).EQ.'ABLE')THEN 1749 ICASRE='STAC' 1750 ENDIF 1751 ENDIF 1752 IF(IHARG(1).EQ.'STAC'.AND.IHARG2(1).EQ.'KED ')THEN 1753 IF(IHARG(2).EQ.'VARI'.AND.IHARG2(2).EQ.'ABLE')THEN 1754 ICASRE='STAC' 1755 ENDIF 1756 ENDIF 1757C 1758 150 CONTINUE 1759 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')THEN 1760 WRITE(ICOUT,155)ICASRE 1761 155 FORMAT('ICASRE = ',A4) 1762 CALL DPWRST('XXX','BUG ') 1763 ENDIF 1764C 1765C ****************************************************** 1766C ** STEP 2A-- ** 1767C ** DETERMINE THE TYPE OF READ CASE-- ** 1768C ** 1) FROM TERMINAL; ** 1769C ** 2) FROM FILE; ** 1770C ** NOTE--IOTERM WILL = 'YES' ONLY IN EXPLICIT ** 1771C ** TERMINAL CASE ** 1772C ** (THAT IS, ONLY WHEN INPUT IOSW ** 1773C ** = 'TERM') ** 1774C ** NOTE--IOFILE WILL = 'YES' ONLY IN FILE CASE. ** 1775C ** NOTE--IMAGE READ ONLY SUPPORTED FOR FILE CASE. ** 1776C ****************************************************** 1777C 1778 ISTEPN='2A' 1779 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ') 1780 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) 1781C 1782 IWORD=2 1783 IF(ICASRE.EQ.'LINE')IWORD=3 1784 IF(ICASRE.EQ.'PARA')IWORD=3 1785 IF(ICASRE.EQ.'FUNC')IWORD=3 1786 IF(ICASRE.EQ.'MATR')IWORD=3 1787 IF(ICASRE.EQ.'ROWR')IWORD=3 1788 IF(ICASRE.EQ.'MATZ')IWORD=5 1789 IF(ICASRE.EQ.'IMAG')IWORD=3 + IMAGSH 1790 IF(ICASRE.EQ.'IMAZ')IWORD=5 1791 IF(ICASRE.EQ.'STAC')IWORD=4 1792 IF(IEXCEL.EQ.'ON')IWORD=3 1793 IF(ICASRE.EQ.'ROWI')THEN 1794 IWORD=4 1795 IF(NUMARG.LE.2)THEN 1796 IOFILE='NO' 1797 GOTO202 1798 ENDIF 1799 ELSEIF(ICASRE.EQ.'CLIP' .OR. ICASRE.EQ.'CFUN')THEN 1800 IOFILE='NO' 1801 GOTO202 1802 ENDIF 1803C 1804 CALL DPFILE(IANSLC,IWIDTH,IWORD, 1805 1 IOFILE,IBUGS2,ISUBRO,IERROR) 1806 IF(IERROR.EQ.'YES')GOTO9000 1807C 1808 IF(IEXCEL.EQ.'ON' .AND. IOFILE.EQ.'NO')THEN 1809 WRITE(ICOUT,999) 1810 CALL DPWRST('XXX','BUG ') 1811 WRITE(ICOUT,211) 1812 CALL DPWRST('XXX','BUG ') 1813 WRITE(ICOUT,191) 1814 191 FORMAT(' THE READ EXCEL COMMAND REQUIRES A FILE NAME ', 1815 1 'TO BE SPECIFIED.') 1816 CALL DPWRST('XXX','BUG ') 1817 WRITE(ICOUT,999) 1818 CALL DPWRST('XXX','BUG ') 1819 IERROR='YES' 1820 GOTO9000 1821 ENDIF 1822C 1823 202 CONTINUE 1824C 1825 IOTERM='NO' 1826 IF(IOFILE.EQ.'NO'.AND.IOSW.EQ.'TERM')IOTERM='YES' 1827C 1828C JANUARY 2015. CHECK IF "LOOP" IS ACTIVE WHEN READING 1829C FROM TERMINAL. 1830C 1831 IF(IOFILE.EQ.'NO' .AND. ILOOST.EQ.'EXEC')THEN 1832 IF(IOSW.NE.'TERM')IOTERM='LOOP' 1833 ENDIF 1834C 1835CCCCC DECEMBER 2004. IF GUI RUNNING, DO NOT ALLOW TERMINAL READ. 1836C 1837 IF(ICASRE.EQ.'LINE' .AND. IOFILE.EQ.'NO ')THEN 1838 WRITE(ICOUT,999) 1839 CALL DPWRST('XXX','BUG ') 1840 WRITE(ICOUT,211) 1841 CALL DPWRST('XXX','BUG ') 1842 WRITE(ICOUT,213) 1843 CALL DPWRST('XXX','BUG ') 1844 WRITE(ICOUT,205) 1845 205 FORMAT(' ARE NOT PERMITTED FOR THE READ1/READ2/READ3 ', 1846 1 'CASES.') 1847 CALL DPWRST('XXX','BUG ') 1848 WRITE(ICOUT,999) 1849 CALL DPWRST('XXX','BUG ') 1850 IERROR='YES' 1851 GOTO9000 1852 ELSEIF(IOFILE.EQ.'NO' .AND. IGUIFL.EQ.'ON')THEN 1853 WRITE(ICOUT,999) 1854 CALL DPWRST('XXX','BUG ') 1855 WRITE(ICOUT,211) 1856 211 FORMAT('***** ERROR FROM READ--') 1857 CALL DPWRST('XXX','BUG ') 1858 WRITE(ICOUT,213) 1859 213 FORMAT(' TERMINAL READS (I.E., READ WITH NO FILE NAME ', 1860 1 'SPECIFIED)') 1861 CALL DPWRST('XXX','BUG ') 1862 WRITE(ICOUT,215) 1863 215 FORMAT(' ARE NOT PERMITTED WHEN RUNNING DATAPLOT FROM ', 1864 1 'THE GRAPHICAL USER INTERFACE)') 1865 CALL DPWRST('XXX','BUG ') 1866 WRITE(ICOUT,999) 1867 CALL DPWRST('XXX','BUG ') 1868 WRITE(ICOUT,217) 1869 217 FORMAT(' ALTERNATIVELY, YOU CAN DO ONE OF THE FOLLOWING:') 1870 CALL DPWRST('XXX','BUG ') 1871 WRITE(ICOUT,219) 1872 219 FORMAT(' 1) YOU CAN ENTER THE DATA DIRECTLY FROM THE ', 1873 1 'DATASHEET.') 1874 CALL DPWRST('XXX','BUG ') 1875 WRITE(ICOUT,221) 1876 221 FORMAT(' 2) FROM THE COMMAND LINE WINDOW, YOU CAN USE ', 1877 1 'THE DATA COMMAND AS FOLLOWS') 1878 CALL DPWRST('XXX','BUG ') 1879 WRITE(ICOUT,223) 1880 223 FORMAT(' LET Y = DATA value1 value2 ...') 1881 CALL DPWRST('XXX','BUG ') 1882 WRITE(ICOUT,225) 1883 225 FORMAT(' 3) THE FIRST TWO METHODS ARE USEFUL FOR SMALL ', 1884 1 'AMOUNTS OF DATA.') 1885 CALL DPWRST('XXX','BUG ') 1886 WRITE(ICOUT,227) 1887 227 FORMAT(' FOR MORE THAN A FEW DATA POINTS, IT IS ', 1888 1 'RECOMMENDED THAT YOU') 1889 CALL DPWRST('XXX','BUG ') 1890 WRITE(ICOUT,229) 1891 229 FORMAT(' CREATE THE DATA IN AN ASCII FILE AND THEN') 1892 CALL DPWRST('XXX','BUG ') 1893 WRITE(ICOUT,231) 1894 231 FORMAT(' READ THE DATA FROM THAT FILE.') 1895 CALL DPWRST('XXX','BUG ') 1896 IERROR='YES' 1897 GOTO9000 1898 ENDIF 1899C 1900 IF(IOFILE.EQ.'NO' .AND. 1901 1 (ICASRE.EQ.'IMAZ' .OR. ICASRE.EQ.'IMAG'))THEN 1902 WRITE(ICOUT,999) 1903 CALL DPWRST('XXX','BUG ') 1904 WRITE(ICOUT,211) 1905 CALL DPWRST('XXX','BUG ') 1906 WRITE(ICOUT,241) 1907 241 FORMAT(' AN IMAGE READ REQUIRES THAT A FILE NAME BE ', 1908 1 'SPECIFIED.') 1909 CALL DPWRST('XXX','BUG ') 1910 WRITE(ICOUT,242) 1911 242 FORMAT(' NO FILE NAME WAS GIVEN ON THE READ COMMAND.') 1912 CALL DPWRST('XXX','BUG ') 1913 WRITE(ICOUT,999) 1914 CALL DPWRST('XXX','BUG ') 1915 IERROR='YES' 1916 GOTO9000 1917 ENDIF 1918C 1919C 1920C ************************************* 1921C ** STEP 2B-- ** 1922C ** IF HAVE THE FILE INPUT CASE-- ** 1923C ** COPY OVER VARIABLES ** 1924C ************************************* 1925C 1926 ISTEPN='2B' 1927 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ') 1928 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) 1929C 1930 IF(IOFILE.EQ.'YES')THEN 1931C 1932 IOUNIT=IREANU 1933 IFILE=IREANA 1934 ISTAT=IREAST 1935 IFORM=IREAFO 1936 IACCES=IREAAC 1937 IPROT=IREAPR 1938 ICURST=IREACS 1939C 1940 ISUBN0='READ' 1941 IERRFI='NO' 1942C 1943 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')THEN 1944 WRITE(ICOUT,1183)IOUNIT,ISUBN0,IERRFI 1945 1183 FORMAT('IOUNIT,ISUBN0,IERRFI = ',I8,A4,2X,A4) 1946 CALL DPWRST('XXX','BUG ') 1947 WRITE(ICOUT,1184)IFILE(1:80) 1948 1184 FORMAT('IFILE = ',A80) 1949 CALL DPWRST('XXX','BUG ') 1950 WRITE(ICOUT,1185)ISTAT,IFORM,IACCES,IPROT,ICURST 1951 1185 FORMAT('ISTAT,IFORM,IACCES,IPROT,ICURST = ',4(A12,2X),A12) 1952 CALL DPWRST('XXX','BUG ') 1953 ENDIF 1954C 1955 ENDIF 1956C 1957C *********************************************** 1958C ** STEP 2C-- ** 1959C ** IF HAVE THE FILE INPUT CASE-- ** 1960C ** CHECK TO SEE IF THE READ FILE MAY EXIST ** 1961C *********************************************** 1962C 1963 ISTEPN='2C' 1964 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ') 1965 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) 1966C 1967 IF(IOFILE.EQ.'YES')THEN 1968C 1969 IF(ISTAT.EQ.'NONE')THEN 1970 IERROR='YES' 1971 WRITE(ICOUT,999) 1972 CALL DPWRST('XXX','BUG ') 1973 WRITE(ICOUT,1211) 1974 1211 FORMAT('***** IMPLEMENTATION ERROR IN DPREAD--') 1975 CALL DPWRST('XXX','BUG ') 1976 WRITE(ICOUT,1212) 1977 1212 FORMAT(' THE DESIRED READING CANNOT BE CARRIED OUT') 1978 CALL DPWRST('XXX','BUG ') 1979 WRITE(ICOUT,1214) 1980 1214 FORMAT(' BECAUSE THE INTERNAL VARIABLE IREAST WHICH') 1981 CALL DPWRST('XXX','BUG ') 1982 WRITE(ICOUT,1215) 1983 1215 FORMAT(' ALLOWS SUCH READING HAS BEEN SET TO NONE') 1984 CALL DPWRST('XXX','BUG ') 1985 WRITE(ICOUT,1217)ISTAT,IREAST 1986 1217 FORMAT('ISTAT,IREAST = ',A12,2X,A12) 1987 CALL DPWRST('XXX','BUG ') 1988 WRITE(ICOUT,1218) 1989 1218 FORMAT(' ALL READING MUST BE DONE DIRECTLY FROM ', 1990 1 'THE TERMINAL') 1991 CALL DPWRST('XXX','BUG ') 1992 GOTO9000 1993 ENDIF 1994 ENDIF 1995C 1996C ************************************* 1997C ** STEP 2D-- ** 1998C ** IF HAVE THE FILE INPUT CASE-- ** 1999C ** EXTRACT THE FILE NAME ** 2000C ************************************* 2001C 2002 ISTEPN='2D' 2003 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ') 2004 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) 2005C 2006 IF(IOFILE.EQ.'YES')THEN 2007C 2008 DO1310I=1,MAXSTR 2009 ICANS(I:I)=IANSLC(I)(1:1) 2010 1310 CONTINUE 2011C 2012 ISTART=1 2013 ISTOP=IWIDTH 2014 IWORD=2 2015 IF(ICASRE.EQ.'PARA')IWORD=3 2016 IF(ICASRE.EQ.'FUNC')IWORD=3 2017 IF(ICASRE.EQ.'MATR')IWORD=3 2018 IF(ICASRE.EQ.'ROWR')IWORD=3 2019 IF(ICASRE.EQ.'MATZ')IWORD=5 2020 IF(ICASRE.EQ.'IMAG')IWORD=3 + IMAGSH 2021 IF(ICASRE.EQ.'IMAZ')IWORD=5 2022 IF(ICASRE.EQ.'ROWI')IWORD=4 2023 IF(ICASRE.EQ.'STAC')IWORD=4 2024 IF(IEXCEL.EQ.'ON')IWORD=3 2025 CALL DPEXWO(ICANS,ISTART,ISTOP,IWORD, 2026 1 ICOL1,ICOL2,IFILE,NCFILE, 2027 1 IBUGS2,ISUBRO,IERROR) 2028C 2029 IF(IEXCEL.EQ.'ON')THEN 2030C 2031 IOP='OPEN' 2032 IFLG11=0 2033 IFLG21=0 2034 IFLG31=0 2035 IFLAG4=0 2036 IFLAG5=1 2037 CALL DPAUFI(IOP,IFLG11,IFLG21,IFLG31,IFLAG4,IFLAG5, 2038 1 IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5, 2039 1 IBUGS2,ISUBRO,IERROR) 2040 IF(IERROR.EQ.'YES')GOTO9000 2041 WRITE(IOUNI5,'(A256)')IFILE(1:256) 2042 WRITE(IOUNI5,'(A8)')IEXCSH 2043 IF(IEXCR1.LE.IEXCR2)THEN 2044 IF(IEXCR1.GE.1)THEN 2045 IVAL1=IEXCR1 2046 IVAL2=IEXCR2 2047 ELSE 2048 IVAL1=-1 2049 IVAL2=-1 2050 ENDIF 2051 WRITE(IOUNI5,'(I8)')IVAL1 2052 WRITE(IOUNI5,'(I8)')IVAL2 2053 ELSE 2054 IF(IEXCR2.GE.1)THEN 2055 IVAL1=IEXCR2 2056 IVAL2=IEXCR1 2057 ELSE 2058 IVAL1=-1 2059 IVAL2=-1 2060 ENDIF 2061 WRITE(IOUNI5,'(I8)')IVAL1 2062 WRITE(IOUNI5,'(I8)')IVAL2 2063 ENDIF 2064 IF(IEXCC1.LE.IEXCC2)THEN 2065 IF(IEXCC1.GE.1)THEN 2066 IVAL1=IEXCC1 2067 IVAL2=IEXCC2 2068 ELSE 2069 IVAL1=-1 2070 IVAL2=-1 2071 ENDIF 2072 WRITE(IOUNI5,'(I8)')IVAL1 2073 WRITE(IOUNI5,'(I8)')IVAL2 2074 ELSE 2075 IF(IEXCC2.GE.1)THEN 2076 IVAL1=IEXCC2 2077 IVAL2=IEXCC1 2078 ELSE 2079 IVAL1=-1 2080 IVAL2=-1 2081 ENDIF 2082 WRITE(IOUNI5,'(I8)')IVAL1 2083 WRITE(IOUNI5,'(I8)')IVAL2 2084 ENDIF 2085 IOP='CLOS' 2086 CALL DPAUFI(IOP,IFLG11,IFLG21,IFLG31,IFLAG4,IFLAG5, 2087 1 IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5, 2088 1 IBUGS2,ISUBRO,IERROR) 2089 IF(IERROR.EQ.'YES')GOTO9000 2090C 2091 ITYPEZ='PYTH' 2092 ISNAME='read_excel.py' 2093 IWIDZZ=13 2094 ISARGL=' ' 2095 NCARG=0 2096 CALL DPEXR2(ITYPEZ,ISNAME,IWIDZZ,ISARGL,NCARG, 2097 1 IBUGS2,ISUBRO,IFOUND,IERROR) 2098 IF(IERROR.EQ.'YES')GOTO9000 2099 IFOUND='YES' 2100C 2101 IFILE=' ' 2102 IFILE='dpst1f.dat' 2103 NCFILE=10 2104 IFOUND='YES' 2105 IREADL=',' 2106 ISKIP=1 2107C 2108 ENDIF 2109C 2110 IF(NCFILE.LT.1)THEN 2111 IERROR='YES' 2112 WRITE(ICOUT,999) 2113 CALL DPWRST('XXX','BUG ') 2114 WRITE(ICOUT,211) 2115 CALL DPWRST('XXX','BUG ') 2116 WRITE(ICOUT,1342) 2117 1342 FORMAT(' A USER FILE NAME IS REQUIRED IN THE READ') 2118 CALL DPWRST('XXX','BUG ') 2119 WRITE(ICOUT,1344) 2120 1344 FORMAT(' COMMAND (FOR EXAMPLE, READ CALIB.DAT X Y Z)') 2121 CALL DPWRST('XXX','BUG ') 2122 WRITE(ICOUT,1345) 2123 1345 FORMAT(' BUT NONE WAS GIVEN HERE.') 2124 CALL DPWRST('XXX','BUG ') 2125 WRITE(ICOUT,1346) 2126 1346 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') 2127 CALL DPWRST('XXX','BUG ') 2128 IF(IWIDTH.GE.1)THEN 2129 WRITE(ICOUT,1347)(IANSLC(I),I=1,MIN(100,IWIDTH)) 2130 1347 FORMAT(' ',100A1) 2131 CALL DPWRST('XXX','BUG ') 2132 WRITE(ICOUT,999) 2133 CALL DPWRST('XXX','BUG ') 2134 GOTO9000 2135 ENDIF 2136C 2137C 2019/10: CHECK FOR ".csv" OR ".CSV" EXTENSION. IF FOUND, SET 2138C READ DELIMITER TO ",". 2139 ELSEIF(NCFILE.GE.4)THEN 2140 IF(IFILE(NCFILE-3:NCFILE).EQ.'.csv' .OR. 2141 1 IFILE(NCFILE-3:NCFILE).EQ.'.CSV')THEN 2142 IREADL=',' 2143 ENDIF 2144 ENDIF 2145C 2146 ENDIF 2147C 2148C ************************************* 2149C ** STEP 2E-- ** 2150C ** IF HAVE THE FILE INPUT CASE-- ** 2151C ** OPEN THE FILE ** 2152C ************************************* 2153C 2154 ISTEPN='2E' 2155 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ') 2156 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) 2157C 2158CCCCC NOTE: FOR THE "IMAGE" CASE, THE FILE OPEN IS HANDLED 2159CCCCC BY THE "GD.C" CODE. 2160CCCCC 2161CCCCC HOWEVER, WE DO NEED TO PERFORM A SEARCH OF THE 2162CCCCC DATAPLOT DIRECTORIES AND LOOK FOR UPPER/LOWER 2163CCCCC CASE ISSUES AS WE DO WITH OTHER FILES. CALL 2164CCCCC DPINF3 TO SEE IF FILE EXISTS BEFORE CALL GD 2165CCCCC LIBRARY. 2166C 2167 IF(IOFILE.EQ.'YES' .AND. ICASRE.NE.'IMAG' .AND. 2168 1 ICASRE.NE.'IMAZ')THEN 2169C 2170 IREWIN='ON' 2171 ICRFLG='ROW' 2172 IF(NCREAF.GT.0.AND.IOFILE.EQ.'YES')THEN 2173 IF(ICREAF(1:5).EQ.'(UNFO'.AND.ICASRE.EQ.'VARI')THEN 2174 IFORM='UNFORMATTED' 2175 IFMFLG='ON' 2176 IF(ICREAF(13:16).EQ.'COLU')ICRFLG='COLU' 2177 IF(ICREAF(1:5).EQ.'(COLU')ICRFLG='COLU' 2178 ELSEIF(ICREAF(1:5).EQ.'(UNFO'.AND.ICASRE.EQ.'MATR')THEN 2179 IF(IUNFMC.GT.0)THEN 2180 IFORM='UNFORMATTED' 2181 IFMFLG='ON' 2182 ELSE 2183 WRITE(ICOUT,999) 2184 CALL DPWRST('XXX','BUG ') 2185 WRITE(ICOUT,211) 2186 CALL DPWRST('XXX','BUG ') 2187 WRITE(ICOUT,1442) 2188 CALL DPWRST('XXX','BUG ') 2189 WRITE(ICOUT,1443) 2190 CALL DPWRST('XXX','BUG ') 2191 WRITE(ICOUT,1444) 2192 CALL DPWRST('XXX','BUG ') 2193 IERROR='YES' 2194 GOTO9000 2195 ENDIF 2196 ELSE 2197 IFORM='FORMATTED' 2198 IFMFLG='OFF' 2199 ENDIF 2200 ELSE 2201 IFORM='FORMATTED' 2202 IFMFLG='OFF' 2203 ENDIF 2204 1442 FORMAT(' FOR UNFORMATTED READS OF MATRICES, THE ', 2205 1 ' FOLLOWING COMMAND IS REQUIRED:') 2206 1443 FORMAT(' SET UNFORMATTED COLUMNS <VALUE>') 2207 1444 FORMAT(' WHERE <VALUE> IS THE NUMBER OF COLUMNS IN THE ', 2208 1 'MATRTIX.') 2209C 2210 IF(IREACS(1:4).EQ.'CLOS') 2211 1 CALL DPOPFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST, 2212 1 IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR) 2213 IF(IERRFI.EQ.'YES')GOTO9090 2214 IF(IREACS(1:4).EQ.'CLOS')IREACS='OPEN' 2215C 2216 ELSEIF(IOFILE.EQ.'YES' .AND. 2217 1 (ICASRE.EQ.'IMAG' .OR. ICASRE.EQ.'IMAZ'))THEN 2218C 2219 CALL DPINF3(IFILE,FTEMP,IEXIST, 2220 1 ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR) 2221 IF(IEXIST.EQ.'NO')THEN 2222 WRITE(ICOUT,1501) 2223 CALL DPWRST('XXX','BUG ') 2224 WRITE(ICOUT,1561) 2225 1561 FORMAT(' UNABLE TO FIND THE IMAGE FILE.') 2226 CALL DPWRST('XXX','BUG ') 2227 WRITE(ICOUT,1563)IFILE(1:80) 2228 1563 FORMAT(' FILE NAME: ',A80) 2229 CALL DPWRST('XXX','BUG ') 2230 WRITE(ICOUT,999) 2231 CALL DPWRST('XXX','BUG ') 2232 IERROR='YES' 2233 GOTO9090 2234 ELSE 2235 IFILE=FTEMP 2236 ENDIF 2237C 2238 IF(IMAGTY.LT.1 .OR. IMAGTY.GT.9)THEN 2239 DO1560I=MAXSTR,1,-1 2240 IF(IFILE(I:I).NE.' ')THEN 2241 NLAST=I 2242 GOTO1569 2243 ENDIF 2244 1560 CONTINUE 2245 NLAST=0 2246 1569 CONTINUE 2247 IF(NLAST.LT.4)THEN 2248 WRITE(ICOUT,1501) 2249 CALL DPWRST('XXX','BUG ') 2250 WRITE(ICOUT,1571) 2251 1571 FORMAT(' UNABLE TO DETERMINE THE IMAGE TYPE.') 2252 CALL DPWRST('XXX','BUG ') 2253 WRITE(ICOUT,999) 2254 CALL DPWRST('XXX','BUG ') 2255 IERROR='YES' 2256 GOTO9000 2257 ENDIF 2258 IF(IFILE(NLAST-2:NLAST).EQ.'JPG')THEN 2259 IMAGTY=1 2260 ELSEIF(IFILE(NLAST-2:NLAST).EQ.'jpg')THEN 2261 IMAGTY=1 2262 ELSEIF(IFILE(NLAST-3:NLAST).EQ.'JPEG')THEN 2263 IMAGTY=1 2264 ELSEIF(IFILE(NLAST-3:NLAST).EQ.'jpeg')THEN 2265 IMAGTY=1 2266 ELSEIF(IFILE(NLAST-2:NLAST).EQ.'PNG')THEN 2267 IMAGTY=2 2268 ELSEIF(IFILE(NLAST-2:NLAST).EQ.'png')THEN 2269 IMAGTY=2 2270 ELSEIF(IFILE(NLAST-2:NLAST).EQ.'GIF')THEN 2271 IMAGTY=3 2272 ELSEIF(IFILE(NLAST-2:NLAST).EQ.'gif')THEN 2273 IMAGTY=3 2274 ELSEIF(IFILE(NLAST-3:NLAST).EQ.'GIFF')THEN 2275 IMAGTY=3 2276 ELSEIF(IFILE(NLAST-3:NLAST).EQ.'giff')THEN 2277 IMAGTY=3 2278 ELSEIF(IFILE(NLAST-2:NLAST).EQ.'BMP')THEN 2279 IMAGTY=4 2280 ELSEIF(IFILE(NLAST-2:NLAST).EQ.'bmp')THEN 2281 IMAGTY=4 2282 ELSEIF(IFILE(NLAST-3:NLAST).EQ.'WBMP')THEN 2283 IMAGTY=5 2284 ELSEIF(IFILE(NLAST-3:NLAST).EQ.'wbmp')THEN 2285 IMAGTY=5 2286 ELSEIF(IFILE(NLAST-3:NLAST).EQ.'WEBP')THEN 2287 IMAGTY=6 2288 ELSEIF(IFILE(NLAST-3:NLAST).EQ.'webp')THEN 2289 IMAGTY=6 2290 ELSEIF(IFILE(NLAST-2:NLAST).EQ.'TGA')THEN 2291 IMAGTY=7 2292 ELSEIF(IFILE(NLAST-2:NLAST).EQ.'tga')THEN 2293 IMAGTY=7 2294 ELSEIF(IFILE(NLAST-3:NLAST).EQ.'TIFF')THEN 2295 IMAGTY=8 2296 ELSEIF(IFILE(NLAST-3:NLAST).EQ.'tiff')THEN 2297 IMAGTY=8 2298 ELSEIF(IFILE(NLAST-2:NLAST).EQ.'TIF')THEN 2299 IMAGTY=8 2300 ELSEIF(IFILE(NLAST-2:NLAST).EQ.'tif')THEN 2301 IMAGTY=8 2302 ELSEIF(IFILE(NLAST-2:NLAST).EQ.'XPM')THEN 2303 IMAGTY=9 2304 ELSEIF(IFILE(NLAST-2:NLAST).EQ.'xpm')THEN 2305 IMAGTY=9 2306 ELSE 2307 WRITE(ICOUT,1501) 2308 CALL DPWRST('XXX','BUG ') 2309 WRITE(ICOUT,1571) 2310 CALL DPWRST('XXX','BUG ') 2311 WRITE(ICOUT,999) 2312 CALL DPWRST('XXX','BUG ') 2313 IERROR='YES' 2314 GOTO9000 2315 ENDIF 2316 ENDIF 2317C 2318 NCFILE=MAXSTR 2319 DO1581I=NCFILE,1,-1 2320 IF(IFILE(I:I).NE.' ')THEN 2321 NCFILE=I 2322 GOTO1589 2323 ENDIF 2324 1581 CONTINUE 2325 1589 CONTINUE 2326 DO1590I=1,NCFILE 2327 CALL DPCOAN(IFILE(I:I),IJUNK) 2328 IADE(I)=IJUNK 2329 1590 CONTINUE 2330 IADE(NCFILE+1)=0 2331C 2332 IXSIZE=0 2333 IYSIZE=0 2334 IERR=0 2335#ifdef HAVE_GD 2336 CALL GDLOAD(IMAGTY,IXSIZE,IYSIZE,IADE,IERR) 2337#endif 2338 IF(IERR.EQ.1)THEN 2339 WRITE(ICOUT,1501) 2340 1501 FORMAT('***** ERROR IN READING IMAGE--') 2341 CALL DPWRST('XXX','BUG ') 2342 WRITE(ICOUT,1503) 2343 1503 FORMAT(' UNABLE TO OPEN THE IMAGE FILE.') 2344 CALL DPWRST('XXX','BUG ') 2345 WRITE(ICOUT,999) 2346 CALL DPWRST('XXX','BUG ') 2347 IERROR='YES' 2348 GOTO9090 2349 ELSEIF(IERR.EQ.2)THEN 2350 WRITE(ICOUT,1501) 2351 CALL DPWRST('XXX','BUG ') 2352 WRITE(ICOUT,1513) 2353 1513 FORMAT(' UNABLE TO LOAD THE IMAGE FILE. THE MOST') 2354 CALL DPWRST('XXX','BUG ') 2355 WRITE(ICOUT,1514) 2356 1514 FORMAT(' LIKELY CAUSE IS THAT THE FILE IS NOT OF THE') 2357 CALL DPWRST('XXX','BUG ') 2358 WRITE(ICOUT,1515) 2359 1515 FORMAT(' EXPECTED TYPE. THE EXPECTED TYPE IS:') 2360 CALL DPWRST('XXX','BUG ') 2361 IF(IMAGTY.EQ.1)THEN 2362 WRITE(ICOUT,1516) 2363 1516 FORMAT(' JPG') 2364 CALL DPWRST('XXX','BUG ') 2365 ELSEIF(IMAGTY.EQ.2)THEN 2366 WRITE(ICOUT,1517) 2367 1517 FORMAT(' PNG') 2368 CALL DPWRST('XXX','BUG ') 2369 ELSEIF(IMAGTY.EQ.3)THEN 2370 WRITE(ICOUT,1518) 2371 1518 FORMAT(' GIF') 2372 CALL DPWRST('XXX','BUG ') 2373 ENDIF 2374 WRITE(ICOUT,999) 2375 CALL DPWRST('XXX','BUG ') 2376 IERROR='YES' 2377 GOTO9090 2378 ELSEIF(IERR.EQ.3)THEN 2379 WRITE(ICOUT,1501) 2380 CALL DPWRST('XXX','BUG ') 2381 WRITE(ICOUT,1523) 2382 1523 FORMAT(' THE IMAGE READ CAPABILITY IS NOT CURRENTLY') 2383 CALL DPWRST('XXX','BUG ') 2384 WRITE(ICOUT,1525) 2385 1525 FORMAT(' IMPLEMENTED FOR THIS INSTALLATION.') 2386 CALL DPWRST('XXX','BUG ') 2387 WRITE(ICOUT,999) 2388 CALL DPWRST('XXX','BUG ') 2389 IERROR='YES' 2390 GOTO9090 2391 ENDIF 2392C 2393 ENDIF 2394C 2395C ****************************************** 2396C ** STEP 2F-- ** 2397C ** FOR THE 2 CASES-- ** 2398C ** 1) TERMINAL INPUT; ** 2399C ** 2) FILE INPUT; ** 2400C ** DEFINE THE INPUT READ UNIT NUMBER, ** 2401C ** AND OTHER VARIABLES NEEDED ** 2402C ** FOR UPCOMING READS. ** 2403C ****************************************** 2404C 2405 ISTEPN='2F' 2406 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ') 2407 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) 2408C 2409 IRD2=IRD 2410 IF(IMACCS.EQ.'OPEN'.OR.IMALEV.GE.1)THEN 2411 IRD2=IMACNU 2412 ENDIF 2413 IF(IOFILE.EQ.'YES')IRD2=IREANU 2414 IF(IOTERM.EQ.'YES')IRD2=IRD 2415 IF(ICASRE.EQ.'CLIP')IRD2=IRD 2416C 2417 IOUNIT=IRD2 2418C 2419C ***************************************** 2420C ** STEP 3-- ** 2421C ** CHECK TO SEE THE TYPE CASE-- ** 2422C ** 1) UNQUALIFIED (THAT IS, FULL); ** 2423C ** 2) SUBSET; OR ** 2424C ** 3) FOR. ** 2425C ***************************************** 2426C 2427 ISTEPN='3' 2428 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ') 2429 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) 2430C 2431 ICASEQ='FULL' 2432 ILOCQ=NUMARG+1 2433 IF(NUMARG.LT.1)GOTO390 2434 DO300J=1,NUMARG 2435 J1=J 2436 IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET ')THEN 2437 ICASEQ='SUBS' 2438 ILOCQ=J1 2439 GOTO390 2440 ELSEIF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT ')THEN 2441 ICASEQ='SUBS' 2442 ILOCQ=J1 2443 GOTO390 2444 ELSEIF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.' ')THEN 2445 ICASEQ='FOR' 2446 ILOCQ=J1 2447 GOTO390 2448 ENDIF 2449 300 CONTINUE 2450 390 CONTINUE 2451C 2452 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')THEN 2453 WRITE(ICOUT,391)NUMARG,ILOCQ 2454 391 FORMAT('NUMARG,ILOCQ = ',2I8) 2455 CALL DPWRST('XXX','BUG ') 2456 ENDIF 2457C 2458C ****************************************************** 2459C ** STEP 4-- ** 2460C ** DETERMINE THE TYPE AND NUMBER OF ITEMS ** 2461C ** TO BE READ . ** 2462C ** NUMALL = TOTAL NUMBER OF READ ITEMS ** 2463C ** (AS DETERMINED BY INCLUDING ONLY ALL ** 2464C ** BEFORE 'SUBSET' OR 'EXCEPT' OR 'FOR') ** 2465C ** NUMV = NUMBER OF VARIABLES TO BE READ ; ** 2466C ** NUMP = NUMBER OF PARAMETERS TO BE READ ; ** 2467C ** NUMM = NUMBER OF MODELS TO BE READ ** 2468C ** (SHOULD = 0 OR 1) ** 2469C ** NUMF = NUMBER OF FUNCTIONS TO BE READ ** 2470C ** NUMU = NUMBER OF UNKNOWNS TO BE READ ; ** 2471C ** NUME = TOTAL NUMBER OF READ ITEMS ** 2472C ** (SHOULD = NUMALL); ** 2473C ****************************************************** 2474C 2475 ISTEPN='4' 2476 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ') 2477 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) 2478C 2479 IV=0 2480 IP=0 2481 IM=0 2482 IF=0 2483 IU=0 2484 IE=0 2485C 2486 JMIN=1 2487 IF(IOFILE.EQ.'NO'.AND.ICASRE.EQ.'PARA')JMIN=2 2488 IF(IOFILE.EQ.'NO'.AND.ICASRE.EQ.'FUNC')JMIN=2 2489 IF(IOFILE.EQ.'NO'.AND.ICASRE.EQ.'MATR')JMIN=2 2490 IF(IOFILE.EQ.'NO'.AND.ICASRE.EQ.'MATZ')JMIN=4 2491 IF(IOFILE.EQ.'NO'.AND.ICASRE.EQ.'IMAG')JMIN=2 2492 IF(IOFILE.EQ.'NO'.AND.ICASRE.EQ.'IMAZ')JMIN=4 2493 IF(IOFILE.EQ.'NO'.AND.ICASRE.EQ.'ROWI')JMIN=3 2494 IF(IOFILE.EQ.'NO'.AND.ICASRE.EQ.'STAC')JMIN=3 2495 IF(IOFILE.EQ.'YES')JMIN=2 2496 IF(IOFILE.EQ.'YES'.AND.ICASRE.EQ.'PARA')JMIN=3 2497 IF(IOFILE.EQ.'YES'.AND.ICASRE.EQ.'FUNC')JMIN=3 2498 IF(IOFILE.EQ.'YES'.AND.ICASRE.EQ.'MATR')JMIN=3 2499 IF(IOFILE.EQ.'YES'.AND.ICASRE.EQ.'MATZ')JMIN=5 2500 IF(IOFILE.EQ.'YES'.AND.ICASRE.EQ.'IMAG')JMIN=3 2501 IF(IOFILE.EQ.'YES'.AND.ICASRE.EQ.'IMAZ')JMIN=5 2502 IF(IOFILE.EQ.'YES'.AND.ICASRE.EQ.'ROWI')JMIN=4 2503 IF(IOFILE.EQ.'YES'.AND.ICASRE.EQ.'STAC')JMIN=4 2504 IF(ICASRE.EQ.'CLIP' .OR. ICASRE.EQ.'CFUN')THEN 2505 JMIN=2 2506 IF(ICASRE.EQ.'CFUN')JMIN=3 2507 IOFILE='NO' 2508 ENDIF 2509C 2510CCCCC JULY 2002: QUOTED FILE NAMES MAY CONTAIN SPACES. 2511CCCCC DETERMINE HOW MANY ARGUMENTS FILE NAME MAY CONTAIN. 2512CCCCC JUNE 2003: UPDATE TO INCLUDE HYPHENS AS WELL AS SPACES. 2513C 2514 IF(IOFILE.EQ.'YES' .AND. IFILE(1:1).EQ.'"')THEN 2515 DO421I=MAXSTR,1,-1 2516 IF(IFILE(I:I).NE.' ')THEN 2517 ILAST=I 2518 GOTO424 2519 ENDIF 2520 421 CONTINUE 2521 424 CONTINUE 2522 ICOUNT=0 2523 ISPAC=0 2524 DO426I=1,ILAST 2525 IF((IFILE(I:I).EQ.' '.OR.IFILE(I:I).EQ.'-') .AND. 2526 1 ISPAC.EQ.0)THEN 2527 ISPAC=1 2528 ICOUNT=ICOUNT+1 2529 ELSEIF((IFILE(I:I).NE.' '.AND.IFILE(I:I).NE.'-') .AND. 2530 1 ISPAC.EQ.1)THEN 2531 ISPAC=0 2532 ENDIF 2533 426 CONTINUE 2534 JMIN=JMIN+ICOUNT 2535 ENDIF 2536C 2537 JMAX=ILOCQ-1 2538 IF(ICASRE.EQ.'ROWI')JMAX=JMIN 2539 IF(ICASRE.EQ.'MATR')THEN 2540 JMAX=JMIN+MAXCOM-1 2541 IF(JMAX.GT.JMIN+MAXRDV-1)JMAX=JMIN+MAXRDV-1 2542 IHMAT1=IHARG(JMIN) 2543 IHMAT2=IHARG2(JMIN) 2544 ELSEIF(ICASRE.EQ.'MATZ')THEN 2545 JMAX=JMIN+2 2546 ELSEIF(ICASRE.EQ.'IMAZ')THEN 2547 JMAX=JMIN+4 2548 ELSEIF(ICASRE.EQ.'STAC')THEN 2549 JMAX=JMIN+1 2550 ELSEIF(ICASRE.EQ.'ROWR')THEN 2551 JMAX=JMIN+1 2552 ENDIF 2553C 2554 IVALMA=0 2555 NUMALL=0 2556 NUMALL=JMAX-JMIN+1 2557 IF(ICASRE.EQ.'CLIP'.AND.NUMALL.LE.0)IVRLST='NO' 2558 IF(ICASRE.EQ.'VARI'.AND.NUMALL.LE.0)IVRLST='NO' 2559C 2560 ISTEPN='4A' 2561 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')THEN 2562 CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) 2563 WRITE(ICOUT,403)ICASRE,IVRLST,JMIN,JMAX,NUMALL 2564 403 FORMAT('ICASRE,IVRLST,JMIN,JMAX,NUMALL = ',2(A4,2X),3I8) 2565 CALL DPWRST('XXX','BUG ') 2566 ENDIF 2567C 2568 IF(IVRLST.EQ.'NO' .AND. ICASRE.EQ.'VARI' .AND. 2569 1 IOTERM.NE.'LOOP')THEN 2570C 2571C SKIP AUTOMATIC CASE: 2572C 2573C 1. IF IAVANM = FILE, THEN RETRIEVE VARIABLE LIST FROM LINE JUST 2574C BEFORE THE "----". 2575C 2576C 2. IF IAVANM <> FILE, THEN USE AUTOMATIC VARIABLE NAMES (BASE 2577C WILL BE DETERMINED BY IAVABN). 2578C 2579 IF(ISKIP.EQ.-1.AND.IOFILE.EQ.'YES'.AND. 2580 1 (ICASRE.NE.'IMAG' .AND. ICASRE.NE.'IMAZ'))THEN 2581C 2582 ISTEPN='4B' 2583 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ') 2584 1 CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) 2585C 2586C CASE 1: RETRIEVE VARIABLE LIST FROM THE FILE 2587C 2588 IF(IAVANM.EQ.'FILE')THEN 2589C 2590C STEP 1: READ UNTIL "---" FOUND 2591C 2592 DO4578I=1,MAXOBV 2593 ILINE=I 2594 NUMCHA=-1 2595 CALL DPREFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST, 2596 1 IA,NUMCHA,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR) 2597C 2598 IF(IERROR.EQ.'YES')GOTO8800 2599 IF(IA(1).EQ.'E'.AND.IA(2).EQ.'O'.AND.IA(3).EQ.'F'.AND. 2600 1 NUMCHA.EQ.3)THEN 2601 REWIND IOUNIT 2602 GOTO8800 2603 ELSEIF(IA(1).EQ.'-'.AND.IA(2).EQ.'-'.AND.IA(3).EQ.'-'.AND. 2604 1 IA(4).EQ.'-')THEN 2605 GOTO4581 2606 ELSE 2607 DO4511J=1,MAXRDV 2608 IASAVE(J)=IA(J) 2609 4511 CONTINUE 2610 ENDIF 2611 4578 CONTINUE 2612 4581 CONTINUE 2613 ISKIP=ILINE 2614C 2615C STEP 2: EXTRACT THE VARIABLE NAMES 2616C 2617 IF(ILINE.GT.1)THEN 2618 IFRST=0 2619 ILAST=0 2620 INEW=0 2621 IVAR=0 2622 NTEMP=255 2623 CALL DPUPPE(IASAVE,NTEMP,IASAVE,IBUGS2,IERROR) 2624 DO4583J=1,NTEMP 2625 IF(IASAVE(J)(1:1).EQ.' ' .OR. IASAVE(J)(1:1).EQ.',')THEN 2626 IF(INEW.EQ.1)THEN 2627 IVAR=IVAR+1 2628 ILAST=J 2629 NCHAR=ILAST-IFRST+1 2630 DO4585K=1,MIN(4,NCHAR) 2631 IVLIST(IVAR)(K:K)=IASAVE(IFRST+K-1)(1:1) 2632 4585 CONTINUE 2633 IF(NCHAR.GE.5)THEN 2634 DO4587K=5,MIN(8,NCHAR) 2635 IVLIS2(IVAR)(K-4:K-4)=IASAVE(IFRST+K-1)(1:1) 2636 4587 CONTINUE 2637 ENDIF 2638 INEW=0 2639 ENDIF 2640 ELSE 2641 ILAST=J 2642 IF(INEW.EQ.0)THEN 2643 INEW=1 2644 IFRST=J 2645 ENDIF 2646 ENDIF 2647 4583 CONTINUE 2648 REWIND IOUNIT 2649 JMIN=1 2650 JMAX=IVAR 2651 ENDIF 2652C 2653C CASE 2: USE AUTOMATIC VARIABLE NAMES 2654C 2655 ELSEIF(IAVANM.EQ.'AUTO')THEN 2656C 2657 ISTEPN='4C' 2658 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ') 2659 1 CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) 2660C 2661 DO6578I=1,MAXOBV 2662 ILINE=I 2663 NUMCHA=-1 2664 CALL DPREFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST, 2665 1 IA,NUMCHA,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR) 2666C 2667 IF(IERROR.EQ.'YES')GOTO8800 2668 IF(IA(1).EQ.'E'.AND.IA(2).EQ.'O'.AND.IA(3).EQ.'F'.AND. 2669 1 NUMCHA.EQ.3)THEN 2670 REWIND IOUNIT 2671 GOTO8800 2672 ELSEIF(IA(1).EQ.'-'.AND.IA(2).EQ.'-'.AND.IA(3).EQ.'-'.AND. 2673 1 IA(4).EQ.'-')THEN 2674 GOTO6581 2675 ELSE 2676 DO6511J=1,255 2677 IASAVE(J)=IA(J) 2678 6511 CONTINUE 2679 ENDIF 2680 6578 CONTINUE 2681 6581 CONTINUE 2682 ISKIP=ILINE 2683 MINCO2=1 2684 MAXCO2=NUMRCM 2685 IFCOL3=IFCOL1 2686 IFCOL4=IFCOL2 2687 NUMLRD=0 2688C 2689 NCBASE=0 2690 DO54590II=8,1,-1 2691 IF(IAVABN(II:II).NE.' ')THEN 2692 NCBASE=II 2693 GOTO54599 2694 ENDIF 269554590 CONTINUE 269654599 CONTINUE 2697C 2698 5592 CONTINUE 2699 DO5597I=1,MAXRCL 2700 ISTOR1(I)=' ' 2701 ISTOR2(I)=' ' 2702 ISTOR3(I)=' ' 2703 IB(I)=' ' 2704 5597 CONTINUE 2705 CALL DPREAL(IRD2,IFCOL3,IFCOL4,MINCO2,MAXCO2, 2706 1 X0,NUMDPL,IFLGSV, 2707 1 IXC,NXC, 2708 1 ICASRE,IFUNC2,N2,MAXN2, 2709 1 IMACRO,IMACNU,IMACCS, 2710 1 IANSLC,IWIDTH,IREACS,ISTOR1,ISTOR2,IEND,NUMLRD, 2711 1 IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST, 2712 1 ICOMCH,ICOMSW,LINETY,IGRPA2, 2713 1 IFCOLL,IFCOLU,ITYPE,NCOLS,NCALL, 2714 1 IREADL,IDATDL,ITIMDL,IRDIPA,PREAMV, 2715 1 MAXRDV,MAXCHV,IFIETY, 2716 1 IDECPT,IDATMV,IDATNN, 2717 1 IREACD,IREACM,IREADS,IREAPM,IREAMC,ITABNC, 2718 1 IREAAS,IREAPC, 2719 1 IB, 2720 1 IOTERM,IANSLO,MAXLIL,MAXCIL,ILOOST,ILOOLI, 2721 1 IREPCH,IMALEV, 2722 1 IERRFI,IBUGS2,ISUBRO,IERROR) 2723 IF(IERROR.EQ.'YES')GOTO9000 2724 IF(LINETY.EQ.'BLAN')GOTO5592 2725 NUMLRD=0 2726 IF(NUMDPL.GT.0)THEN 2727C 2728 IF(IMNVAR.LT.0)IMNVAR=NUMDPL 2729 IF(IMXVAR.LT.0)IMXVAR=NUMDPL 2730 IF(NUMDPL.LT.IMNVAR)IMNVAR=NUMDPL 2731 IF(NUMDPL.GT.IMXVAR)IMXVAR=NUMDPL 2732 DO5593J=1,NUMDPL 2733 IF(NCBASE.LE.0)THEN 2734 IVLIST(J)='COL ' 2735 IVLIS2(J)=' ' 2736 NCBASE=3 2737 ELSE 2738 IVLIST(J)=IAVABN(1:4) 2739 IVLIS2(J)=IAVABN(5:8) 2740 ENDIF 2741 NCSTAR=NCBASE+1 2742 NCSTOP=NCBASE+J 2743 IF(NCSTOP.GT.8)THEN 2744 NDIFF=NCSTOP-8 2745 NCSTAR=NCSTAR-NDIFF 2746 ENDIF 2747 IVTEMP(1:4)=IVLIST(J) 2748 IVTEMP(5:8)=IVLIS2(J) 2749 IF(J.LE.9)THEN 2750 WRITE(IVTEMP(NCSTAR:NCSTAR),'(I1)')J 2751 ELSEIF(J.LE.99)THEN 2752 WRITE(IVTEMP(NCSTAR:NCSTAR+1),'(I2)')J 2753 ELSEIF(J.LE.999)THEN 2754 WRITE(IVTEMP(NCSTAR:NCSTAR+2),'(I3)')J 2755 ELSEIF(J.LE.9999)THEN 2756 WRITE(IVTEMP(NCSTAR:NCSTAR+3),'(I4)')J 2757 ELSE 2758 WRITE(IVTEMP(NCSTAR:NCSTAR+4),'(I5)')J 2759 ENDIF 2760 IVLIST(J)(1:4)=IVTEMP(1:4) 2761 IVLIS2(J)(1:4)=IVTEMP(5:8) 2762 5593 CONTINUE 2763 ENDIF 2764 REWIND IOUNIT 2765 NCALL=0 2766 NCOLS=0 2767 JMIN=1 2768 JMAX=NUMDPL 2769 ENDIF 2770C 2771C SKIP AUTOMATIC OFF CASE 2772C 2773C 1) SET COLUMN LIMITS, ROW LIMITS 2774C 2) SKIP OVER HEADER LINES (IF NEEDED) 2775C 3) READ SINGLE LINE OF DATA 2776C 4) DETERMINE NUMBER OF COLUMNS OF DATA IN THAT LINE 2777C 5) SET VARIABLE NAMES TO X1, ..., Xk 2778C (2014/10: THE IAVABN VARIABLE SPECIFIES THE DEFAULT FOR THE 2779C VARIABLE NAMES, THE DEFUALT IS NOW COL1, COL2, ETC.) 2780C 2781C IF IVARLA="ON", FIRST LINE READ SHOULD BE VARIABLE NAMES 2782C 2783C 6) REWIND THE FILE 2784C 2785 ELSEIF(IOFILE.EQ.'YES' .AND. ICASRE.NE.'IMAG' .AND. 2786 1 ICASRE.NE.'IMAZ')THEN 2787C 2788C STEP 1: SKIP HEADER LINES 2789C 2790 IF(ISKIP.GE.0)THEN 2791 IFRMIN=IFROW1 2792 IFRMAX=IFROW1+ISKIP 2793 IF(IFRMAX.LT.IFRMIN)IFRMAX=IFRMIN 2794 MINCO2=1 2795 MAXCO2=NUMRCM 2796 IFCOL3=IFCOL1 2797 IFCOL4=IFCOL2 2798 IF(IFRMIN.LT.IFRMAX)THEN 2799 DO4591IFROW=IFRMIN,IFRMAX-1 2800 ILINE=IFROW 2801 NUMCHA=-1 2802 CALL DPREFI( 2803 1 IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST, 2804 1 IA,NUMCHA, 2805 1 ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR) 2806 2807 IF(IA(1).NE.'-'.OR.IA(2).NE.'-'.OR.IA(3).NE.'-'.OR. 2808 1 IA(4).NE.'-')THEN 2809 DO4513J=1,255 2810 IASAVE(J)=IA(J) 2811 4513 CONTINUE 2812 ENDIF 2813 4591 CONTINUE 2814 ENDIF 2815C 2816C STEP 2A: READ FIRST LINE OF DATA FILE TO DETERMINE NUMBER OF 2817C VARIABLES 2818C 2819 IF(IVARLA.EQ.'OFF' .AND. IAVANM.EQ.'AUTO')THEN 2820 NUMLRD=0 2821C 2822 NCBASE=0 2823 DO44590II=8,1,-1 2824 IF(IAVABN(II:II).NE.' ')THEN 2825 NCBASE=II 2826 GOTO44599 2827 ENDIF 282844590 CONTINUE 282944599 CONTINUE 2830C 2831 4592 CONTINUE 2832 DO4597I=1,MAXRCL 2833 ISTOR1(I)=' ' 2834 ISTOR2(I)=' ' 2835 ISTOR3(I)=' ' 2836 IB(I)=' ' 2837 4597 CONTINUE 2838 CALL DPREAL(IRD2,IFCOL3,IFCOL4,MINCO2,MAXCO2, 2839 1 X0,NUMDPL,IFLGSV, 2840 1 IXC,NXC, 2841 1 ICASRE,IFUNC2,N2,MAXN2, 2842 1 IMACRO,IMACNU,IMACCS, 2843 1 IANSLC,IWIDTH,IREACS,ISTOR1,ISTOR2,IEND,NUMLRD, 2844 1 IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST, 2845 1 ICOMCH,ICOMSW,LINETY,IGRPA2, 2846 1 IFCOLL,IFCOLU,ITYPE,NCOLS,NCALL, 2847 1 IREADL,IDATDL,ITIMDL,IRDIPA,PREAMV, 2848 1 MAXRDV,MAXCHV,IFIETY, 2849 1 IDECPT,IDATMV,IDATNN, 2850 1 IREACD,IREACM,IREADS,IREAPM,IREAMC,ITABNC, 2851 1 IREAAS,IREAPC, 2852 1 IB, 2853 1 IOTERM,IANSLO,MAXLIL,MAXCIL,ILOOST,ILOOLI, 2854 1 IREPCH,IMALEV, 2855 1 IERRFI,IBUGS2,ISUBRO,IERROR) 2856 IF(IERROR.EQ.'YES')GOTO9000 2857 IF(LINETY.EQ.'BLAN')GOTO4592 2858 NUMLRD=0 2859 IF(NUMDPL.GT.0)THEN 2860C 2861 IF(IMNVAR.LT.0)IMNVAR=NUMDPL 2862 IF(IMXVAR.LT.0)IMXVAR=NUMDPL 2863 IF(NUMDPL.LT.IMNVAR)IMNVAR=NUMDPL 2864 IF(NUMDPL.GT.IMXVAR)IMXVAR=NUMDPL 2865 DO4593J=1,NUMDPL 2866 IF(NCBASE.LE.0)THEN 2867 IVLIST(J)='COL ' 2868 IVLIS2(J)=' ' 2869 NCBASE=3 2870 ELSE 2871 IVLIST(J)=IAVABN(1:4) 2872 IVLIS2(J)=IAVABN(5:8) 2873 ENDIF 2874 NCSTAR=NCBASE+1 2875 NCSTOP=NCBASE+J 2876 IF(NCSTOP.GT.8)THEN 2877 NDIFF=NCSTOP-8 2878 NCSTAR=NCSTAR-NDIFF 2879 ENDIF 2880 IVTEMP(1:4)=IVLIST(J) 2881 IVTEMP(5:8)=IVLIS2(J) 2882 IF(J.LE.9)THEN 2883 WRITE(IVTEMP(NCSTAR:NCSTAR),'(I1)')J 2884 ELSEIF(J.LE.99)THEN 2885 WRITE(IVTEMP(NCSTAR:NCSTAR+1),'(I2)')J 2886 ELSEIF(J.LE.999)THEN 2887 WRITE(IVTEMP(NCSTAR:NCSTAR+2),'(I3)')J 2888 ELSEIF(J.LE.9999)THEN 2889 WRITE(IVTEMP(NCSTAR:NCSTAR+3),'(I4)')J 2890 ELSE 2891 WRITE(IVTEMP(NCSTAR:NCSTAR+4),'(I5)')J 2892 ENDIF 2893 IVLIST(J)(1:4)=IVTEMP(1:4) 2894 IVLIS2(J)(1:4)=IVTEMP(5:8) 2895 4593 CONTINUE 2896 ENDIF 2897 REWIND IOUNIT 2898 NCALL=0 2899 NCOLS=0 2900 JMIN=1 2901 JMAX=NUMDPL 2902C 2903C STEP 2B: VARIABLE NAMES READ FROM LAST HEADER LINE (OR 2904C NEXT TO LAST LINE IF LAST LINE STARTS WITH 2905C "----"). 2906C 2907 ELSEIF(IVARLA.EQ.'OFF' .AND. IAVANM.EQ.'FILE')THEN 2908 IF(ILINE.GT.1)THEN 2909 IFRST=0 2910 ILAST=0 2911 INEW=0 2912 IVAR=0 2913 NTEMP=255 2914 CALL DPUPPE(IASAVE,NTEMP,IASAVE,IBUGS2,IERROR) 2915 DO5583J=1,NTEMP 2916 IF(IASAVE(J)(1:1).EQ.' '.OR.IASAVE(J)(1:1).EQ.',')THEN 2917 IF(INEW.EQ.1)THEN 2918 IVAR=IVAR+1 2919 ILAST=J 2920 NCHAR=ILAST-IFRST+1 2921 DO5585K=1,MIN(4,NCHAR) 2922 IVLIST(IVAR)(K:K)=IASAVE(IFRST+K-1)(1:1) 2923 5585 CONTINUE 2924 IF(NCHAR.GE.5)THEN 2925 DO5587K=5,MIN(8,NCHAR) 2926 IVLIS2(IVAR)(K-4:K-4)=IASAVE(IFRST+K-1)(1:1) 2927 5587 CONTINUE 2928 ENDIF 2929 INEW=0 2930 ENDIF 2931 ELSE 2932 ILAST=J 2933 IF(INEW.EQ.0)THEN 2934 INEW=1 2935 IFRST=J 2936 ENDIF 2937 ENDIF 2938 5583 CONTINUE 2939 REWIND IOUNIT 2940 JMIN=1 2941 JMAX=IVAR 2942 ENDIF 2943C 2944C STEP 3: CASE WHERE VARIABLE NAMES ON FIRST LINE 2945C 2946C 2017/03: CHECK FOR "," AS SEPARATOR IN ADDITION 2947C TO SPACE CHARACTER. 2948C 2949 ELSEIF(IVARLA.EQ.'ON')THEN 2950 NUMCHA=-1 2951 CALL DPREFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST, 2952 1 IASAVE,NUMCHA,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR) 2953 IF(IERROR.EQ.'YES')GOTO8800 2954C 2955 IFRST=0 2956 ILAST=0 2957 INEW=0 2958 IVAR=0 2959 CALL DPUPPE(IASAVE,255,IASAVE,IBUGS2,IERROR) 2960 DO34583J=1,255 2961 IF(IASAVE(J)(1:1).EQ.' ' .OR. IASAVE(J)(1:1).EQ.',')THEN 2962 IF(INEW.EQ.1)THEN 2963 IVAR=IVAR+1 2964 ILAST=J 2965 NCHAR=ILAST-IFRST+1 2966 DO34585K=1,MIN(4,NCHAR) 2967 IVLIST(IVAR)(K:K)=IASAVE(IFRST+K-1)(1:1) 296834585 CONTINUE 2969 IF(NCHAR.GE.5)THEN 2970 DO34587K=5,MIN(8,NCHAR) 2971 IVLIS2(IVAR)(K-4:K-4)=IASAVE(IFRST+K-1)(1:1) 297234587 CONTINUE 2973 ENDIF 2974 INEW=0 2975 ENDIF 2976 ELSE 2977 ILAST=J 2978 IF(INEW.EQ.0)THEN 2979 INEW=1 2980 IFRST=J 2981 ENDIF 2982 ENDIF 298334583 CONTINUE 2984C 2985 JMIN=1 2986 JMAX=IVAR 2987 ENDIF 2988C 2989 ENDIF 2990 ENDIF 2991 ENDIF 2992C 2993 IF(JMIN.GT.JMAX)GOTO4290 2994 IF(ICASRE.EQ.'ROWI')GOTO4290 2995C 2996C JANUARY 2004. THE DPREAL ROUTINE CAN NOW RETURN CHARACTER AS 2997C WELL AS NUMERIC DATA. FOR THE VARIABLE READ CASE, READ FIRST 2998C LINE OF FILE TO EXTRACT THE TYPES FOR EACH OF THE VARIABLES. 2999C FOLLOWING CONDITIONS NEED TO APPLY: 3000C 3001C 1. THIS IS THE VARIABLE (AS OPPOSSED TO STRING, PARAMETER, MATRIX) 3002C READ CASE. 3003C 3004C 2. THE CONVERT CHARACTER CASE IS SET TO CHARACTER (AS OPPOSSED 3005C TO IGNORE OR ERROR). THIS IS DETERMINED BY VALUE OF IGRPAU. 3006C 3007C 3. THE READ IS FROM FILE RATHER THAN THE KEYBOARD. FOR THE 3008C KEYBOARD READ CASE, IGRPAU IS SET TO IGNORE. 3009C 3010C 2019/09: ALLOW READING OF CHARACTER DATA FROM TERMINAL. PRIMARY 3011C ISSUE IS THAT FIRST LINE IS READ TO DETERMINE THE 3012C TYPE OF EACH FIELD. FOR TERMINAL READ, CANNOT DO A 3013C FILE REWIND, SO NEED TO SAVE THE FIRST LINE FOR 3014C SUBSEQUENT USE. 3015C 3016C 4. IF A SET READ FORMAT HAS BEEN SET, NO CHARACTER DATA WILL 3017C BE READ. 3018C 3019C 5. FOR NOW, READ CLIPBOARD WILL ONLY SUPPORT READING OF NUMERIC 3020C VAIRABLES. 3021C 3022 ICFLAG='YES' 3023 IF(IGRPAU.NE.'CHAR' .AND. IGRPAU.NE.'CATE')ICFLAG='NO' 3024CCCCC IF(IOFILE.NE.'YES')ICFLAG='NO' 3025 IF(ICASRE.NE.'VARI')ICFLAG='NO' 3026 IF(NCREAF.GT.0)ICFLAG='NO' 3027 IF(ICASRE.EQ.'MATR')ICFLAG='NO' 3028 IF(ICASRE.EQ.'MATZ')ICFLAG='NO' 3029 IF(ICASRE.EQ.'IMAG')ICFLAG='NO' 3030 IF(ICASRE.EQ.'IMAZ')ICFLAG='NO' 3031 IF(ICASRE.EQ.'CLIP')ICFLAG='NO' 3032 IF(ICASRE.EQ.'ROWR')ICFLAG='NO' 3033 IFLGSV=0 3034C 3035 IF(ICFLAG.EQ.'YES')THEN 3036C 3037C 2018/07: CHECK IF ONE OF THE COLUMNS IS DESIGNATED TO 3038C BE A ROW LABEL. 3039C 3040 IRWLC2=-1 3041 IF(IRWLCO.GE.1)THEN 3042 IRWLC2=IRWLCO 3043 ENDIF 3044C 3045 MINCO2=1 3046 MAXCO2=NUMRCM 3047 IFCOL3=IFCOL1 3048 IFCOL4=IFCOL2 3049C 3050C SKIP AUTOMATIC CASE: NEED TO READ UNTIL "----" FOUND 3051C 3052 IF(ISKIP.EQ.-1)THEN 3053 DO17382IFROW=1,MAXOBV 3054 NUMCHA=-1 3055 CALL DPREFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST, 3056 1 IA,NUMCHA, 3057 1 ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR) 3058 IF(IERROR.EQ.'YES')THEN 3059 IGRPA2='IGNO' 3060 ICFLAG='NO' 3061 GOTO17399 3062 ELSEIF(IA(1).EQ.'E'.AND.IA(2).EQ.'O'.AND.IA(3).EQ.'F'.AND. 3063 1 NUMCHA.EQ.3)THEN 3064 IGRPA2='IGNO' 3065 ICFLAG='NO' 3066 GOTO17399 3067 ELSEIF(IA(1).EQ.'-'.AND.IA(2).EQ.'-'.AND.IA(3).EQ.'-'.AND. 3068 1 IA(4).EQ.'-')THEN 3069 GOTO17391 3070 ENDIF 307117382 CONTINUE 3072 ELSE 3073 ITEMP=IFROW1+ISKIP-1 3074 IF(ITEMP.GT.0)THEN 3075 DO17380IFROW=1,ITEMP 3076 NUMCHA=-1 3077 IF(IOTERM.EQ.'LOOP')THEN 3078 ILOOLI=ILOOLI+1 3079 ELSE 3080 CALL DPREFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES, 3081 1 IPROT,ICURST,IA,NUMCHA, 3082 1 ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR) 3083 IF(IERROR.EQ.'YES')THEN 3084 IGRPA2='IGNO' 3085 ICFLAG='NO' 3086 GOTO17399 3087 ENDIF 3088 IF(IA(1).EQ.'E'.AND.IA(2).EQ.'O'.AND.IA(3).EQ.'F'.AND. 3089 1 NUMCHA.EQ.3)THEN 3090 IGRPA2='IGNO' 3091 ICFLAG='NO' 3092 GOTO17399 3093 ENDIF 3094 ENDIF 309517380 CONTINUE 3096 ENDIF 3097 ENDIF 3098C 309917391 CONTINUE 3100 NCALL=0 3101 NCOLS=0 3102 CALL DPREAL(IRD2,IFCOL3,IFCOL4,MINCO2,MAXCO2,X0,NUMDPL,IFLGSV, 3103 1 IXC,NXC, 3104 1 ICASRE,IFUNC2,N2,MAXN2, 3105 1 IMACRO,IMACNU,IMACCS, 3106 1 IANSLC,IWIDTH,IREACS,ISTOR1,ISTOR2,IEND,NUMLRD, 3107 1 IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST, 3108 1 ICOMCH,ICOMSW,LINETY,IGRPA2, 3109 1 IFCOLL,IFCOLU,ITYPE,NCOLS,NCALL, 3110 1 IREADL,IDATDL,ITIMDL,IRDIPA,PREAMV, 3111 1 MAXRDV,MAXCHV,IFIETY, 3112 1 IDECPT,IDATMV,IDATNN, 3113 1 IREACD,IREACM,IREADS,IREAPM,IREAMC,ITABNC, 3114 1 IREAAS,IREAPC, 3115 1 IB, 3116 1 IOTERM,IANSLO,MAXLIL,MAXCIL,ILOOST,ILOOLI, 3117 1 IREPCH,IMALEV, 3118 1 IERRFI,IBUGS2,ISUBRO,IERROR) 3119C 3120C 2019/04: CHECK FOR BLANK LINE BEFORE ERROR 3121C 3122 IF(LINETY.EQ.'BLAN')GOTO17391 3123 IF(IERROR.EQ.'YES')GOTO9000 3124C 3125 IF(IMNVAR.LT.0)IMNVAR=NUMDPL 3126 IF(IMXVAR.LT.0)IMXVAR=NUMDPL 3127 IF(NUMDPL.LT.IMNVAR)IMNVAR=NUMDPL 3128 IF(NUMDPL.GT.IMXVAR)IMXVAR=NUMDPL 3129C 3130 IF(NXC.LE.0)THEN 3131 ICFLAG='NO' 3132 IGRPA2='IGNO' 3133 GOTO17399 3134 ENDIF 3135C 313617399 CONTINUE 3137 IF(IOFILE.EQ.'YES')THEN 3138 REWIND(IOUNIT) 3139 IFLGSV=0 3140 ELSE 3141 IFLGSV=1 3142 ENDIF 3143 NCALL=0 3144 NCOLS=0 3145 ENDIF 3146C 3147 ICNTNU=0 3148 ICNTCH=0 3149 ICOUNT=0 3150 IISKIP=0 3151C 3152 IF(ICASRE.EQ.'CLIP' .AND. IVRLST.EQ.'NO')GOTO4290 3153C 3154 DO4200J=JMIN,JMAX 3155C 3156 IF(IISKIP.EQ.1)THEN 3157 IISKIP=0 3158 GOTO4200 3159 ENDIF 3160C 3161 IF(ICFLAG.EQ.'NO' .OR. ICFLAG.EQ.'OFF')THEN 3162 ICOUNT=ICOUNT+1 3163 ENDIF 3164C 3165 IF(IVRLST.EQ.'NO')THEN 3166 IH1=IVLIST(J) 3167 IH2=IVLIS2(J) 3168 ELSE 3169 IH1=IHARG(J) 3170 IH2=IHARG2(J) 3171 ENDIF 3172C 3173C ********** 3174C THE FOLLOWING 5 LINES OF CODE IS FOR READ MATRIX. 3175C IT ALLOWS COLUMN VECTOR NAMES TO BE FORMED 3176C FROM THE BASE MATRIX NAME 3177C BY THE APPENDING OF NUMBERS 1, 2, 3, ... 3178C SEPTEMBER 1987 3179C ********** 3180C 3181 IF(ICASRE.EQ.'MATR')THEN 3182 IVALMA=IVALMA+1 3183 CALL DPAPN2(IHMAT1,IHMAT2,IVALMA, 3184 1 IH1,IH2,IBUGS2,ISUBRO,IERROR) 3185 ENDIF 3186C 3187C *************** 3188C THE FOLLOWING CODE ALLOWS THE TO KEYWORD 3189C TO BE ACTIVATED, AS IN 3190C READ FILE.EXT Y1 TO Y10 3191C DECEMBER 1986 3192C *************** 3193C 3194 ICASTO='OFF' 3195 IF(IH1.EQ.'TO ')THEN 3196 ICASTO='ON' 3197 JM1=J-1 3198 JP1=J+1 3199 CALL DPEXTL(IHARG(JM1),IHARG2(JM1),IHARG(JP1),IHARG2(JP1), 3200 1 KNUMB,IVAL1,IVAL2,IBUGS2,ISUBRO,IERROR) 3201C 3202 IF(IVAL1.EQ.IVAL2)THEN 3203 IISKIP=1 3204 GOTO4200 3205 ENDIF 3206C 3207 IVA1P1=IVAL1+1 3208 IVA2M1=IVAL2-1 3209 IF(IVA1P1.GT.IVA2M1)GOTO4200 3210 IVAL=IVAL1 3211 ELSE 3212 IF(ICFLAG.EQ.'YES')THEN 3213 ICOUNT=ICOUNT+1 3214 ENDIF 3215 GOTO4219 3216 ENDIF 3217 4215 CONTINUE 3218 IVAL=IVAL+1 3219CCCCC ICOUNT=ICOUNT+1 3220 IF(ICFLAG.EQ.'YES')THEN 3221 IF(IVAL.GT.IVAL2)GOTO4200 3222CCCCC IF(IVAL.GE.IVAL2)GOTO4200 3223 ELSE 3224 IF(IVAL.GE.IVAL2)GOTO4200 3225 ENDIF 3226C 3227 CALL DPAPNU(IHARG(JM1),IHARG2(JM1),KNUMB,IVAL, 3228 1 IH1,IH2,IBUGS2,ISUBRO,IERROR) 3229 4219 CONTINUE 3230C 3231C JANUARY 2004: CHECK WHETHER NAME SHOULD BE ADDED TO 3232C REGULAR NAME LIST OR CHARACTER VARIABLE NAME LIST. 3233C 3234 IF(ICFLAG.EQ.'YES')THEN 3235C 3236 IF(ITYPE(ICOUNT).EQ.1)THEN 3237 ICNTCH=ICNTCH+1 3238 IF(ICNTCH.GT.MAXCHV)GOTO4200 3239 IFLGRL=0 3240 IF(IRWLC2.EQ.ICOUNT)THEN 3241 IRWLC3=ICNTCH 3242 IFLGRL=1 3243 ENDIF 3244 ICLIST(ICNTCH)=IH1 3245 ICLIS2(ICNTCH)=IH2 3246C 3247C 2018/07: CHECK IF THIS IS A PREVIOUSLY DEFINED NAME IF 3248C "CATEGORICAL" OPTION IS SET. ONLY VARIABLE 3249C NAME IS ALLOWED. OTHERWISE, REPORT AN ERROR. 3250C 3251 IF(IGRPAU.EQ.'CATE' .AND. IFLGRL.EQ.0)THEN 3252 DO42300II=1,NUMNAM 3253 I2=II 3254 IF(IH1.EQ.IHNAME(I2).AND.IH2.EQ.IHNAM2(I2))THEN 3255 IF(IUSE(I2).NE.'V')THEN 3256 WRITE(ICOUT,999) 3257 CALL DPWRST('XXX','BUG ') 3258 WRITE(ICOUT,211) 3259 CALL DPWRST('XXX','BUG ') 3260 WRITE(ICOUT,42320) 326142320 FORMAT(' WHEN USING THE SET CONVERT ', 3262 1 'CHARACTER CATEGORICAL COMMAND,') 3263 CALL DPWRST('XXX','BUG ') 3264 WRITE(ICOUT,42350) 326542350 FORMAT(' THE REQUESTED NAME PREVIOUSLY ', 3266 1 'EXISTS, BUT NOT AS A VARIABLE.') 3267 CALL DPWRST('XXX','BUG ') 3268 WRITE(ICOUT,4317) 3269 CALL DPWRST('XXX','BUG ') 3270 IERROR='YES' 3271 GOTO8800 3272 ELSE 3273 IECOLC(ICNTCH)=IVALUE(I2) 3274 GOTO42301 3275 ENDIF 3276 ENDIF 327742300 CONTINUE 3278 IECOLC(ICNTCH)=-1 327942301 CONTINUE 3280 ENDIF 3281C 3282 IF(ICASTO.EQ.'ON')THEN 3283 IF(IVAL.GE.IVAL2)GOTO4200 3284 GOTO4215 3285 ELSE 3286 GOTO4200 3287 ENDIF 3288 ELSE 3289 ICNTNU=ICNTNU+1 3290 ENDIF 3291 ENDIF 3292C 3293 ICASEA=' ' 3294 DO4300I=1,NUMNAM 3295 I2=I 3296 IF(IH1.EQ.IHNAME(I).AND.IH2.EQ.IHNAM2(I))THEN 3297 IF(IUSE(I).EQ.'V')THEN 3298 ICASEA='V' 3299 IV=IV+1 3300 IF(IV.GT.MAXV2)GOTO4370 3301 JVNAM1(IV)=IH1 3302 JVNAM2(IV)=IH2 3303 NIV(IV)=IN(I2) 3304C 3305 IF(ICASRE.EQ.'VARI' .OR. ICASRE.EQ.'CLIP')GOTO4370 3306 WRITE(ICOUT,999) 3307 CALL DPWRST('XXX','BUG ') 3308 WRITE(ICOUT,211) 3309 CALL DPWRST('XXX','BUG ') 3310 WRITE(ICOUT,4312) 3311 4312 FORMAT(' A NAME IN THE LIST OF VARIABLES TO BE ', 3312 1 'READ INCLUDED THE') 3313 CALL DPWRST('XXX','BUG ') 3314 WRITE(ICOUT,4315) 3315 4315 FORMAT(' NAME OF A PREVIOUSLY-DEFINED PARAMETER OR ', 3316 1 'FUNCTION.') 3317 CALL DPWRST('XXX','BUG ') 3318 WRITE(ICOUT,4316)IH1,IH2 3319 4316 FORMAT(' THE NAME OF THE PARAMETER OR FUNCTION WAS ', 3320 1 2A4,' .') 3321 CALL DPWRST('XXX','BUG ') 3322 WRITE(ICOUT,4317) 3323 4317 FORMAT(' NO READ WAS CARRIED OUT.') 3324 CALL DPWRST('XXX','BUG ') 3325 IERROR='YES' 3326 GOTO8800 3327C 3328 ELSEIF(IUSE(I).EQ.'P')THEN 3329 ICASEA='P' 3330 IP=IP+1 3331 IF(IP.GT.MAXP2)GOTO4370 3332 JPNAM1(IP)=IH1 3333 JPNAM2(IP)=IH2 3334 PVAL(IP)=VALUE(I2) 3335C 3336 IF(ICASRE.EQ.'PARA')GOTO4370 3337 WRITE(ICOUT,999) 3338 CALL DPWRST('XXX','BUG ') 3339 WRITE(ICOUT,211) 3340 CALL DPWRST('XXX','BUG ') 3341 WRITE(ICOUT,4322) 3342 4322 FORMAT(' A NAME IN THE LIST OF PARAMETERS TO BE ', 3343 1 'READ INCLUDED THE') 3344 CALL DPWRST('XXX','BUG ') 3345 WRITE(ICOUT,4325) 3346 4325 FORMAT(' NAME OF A PREVIOUSLY-DEFINED VARIABLE OR ', 3347 1 'FUNCTION.') 3348 CALL DPWRST('XXX','BUG ') 3349 WRITE(ICOUT,4326)IH1,IH2 3350 4326 FORMAT(' THE NAME OF THE VARIABLE OR FUNCTION WAS ', 3351 1 2A4,' .') 3352 CALL DPWRST('XXX','BUG ') 3353 WRITE(ICOUT,4317) 3354 CALL DPWRST('XXX','BUG ') 3355 IERROR='YES' 3356 GOTO8800 3357C 3358 ELSEIF(IUSE(I).EQ.'M')THEN 3359 ICASEA='M' 3360 IM=IM+1 3361 IF(IM.GT.MAXM2)GOTO4370 3362 JMNAM1(IM)=IH1 3363 JMNAM2(IM)=IH2 3364C 3365 WRITE(ICOUT,999) 3366 CALL DPWRST('XXX','BUG ') 3367 WRITE(ICOUT,211) 3368 CALL DPWRST('XXX','BUG ') 3369 WRITE(ICOUT,4332) 3370 4332 FORMAT(' A NAME IN THE LIST OF VARIABLES TO BE READ') 3371 CALL DPWRST('XXX','BUG ') 3372 WRITE(ICOUT,4335) 3373 4335 FORMAT(' INCLUDED THE NAME OF A PREVIOUSLY-DEFINED ', 3374 1 'MODEL.') 3375 CALL DPWRST('XXX','BUG ') 3376 WRITE(ICOUT,4336)IH1,IH2 3377 4336 FORMAT(' THE NAME OF THE MODEL WAS ',2A4,' .') 3378 CALL DPWRST('XXX','BUG ') 3379 WRITE(ICOUT,4317) 3380 CALL DPWRST('XXX','BUG ') 3381 IERROR='YES' 3382 GOTO8800 3383C 3384 ELSEIF(IUSE(I).EQ.'F')THEN 3385 ICASEA='F' 3386 IF=IF+1 3387 IF(IF.GT.MAXF2)GOTO4370 3388 JFNAM1(IF)=IH1 3389 JFNAM2(IF)=IH2 3390 IFSTA2(IF)=IVSTAR(I2) 3391 IFSTO2(IF)=IVSTOP(I2) 3392C 3393 IF(ICASRE.EQ.'FUNC' .OR. ICASRE.EQ.'CFUN')GOTO4370 3394 WRITE(ICOUT,999) 3395 CALL DPWRST('XXX','BUG ') 3396 WRITE(ICOUT,211) 3397 CALL DPWRST('XXX','BUG ') 3398 WRITE(ICOUT,4342) 3399 4342 FORMAT(' A NAME IN THE LIST OF FUNCTIONS (= ', 3400 1 'STRINGS)') 3401 CALL DPWRST('XXX','BUG ') 3402 WRITE(ICOUT,4344) 3403 4344 FORMAT(' TO BE READ INCLUDED THE NAME OF A ') 3404 CALL DPWRST('XXX','BUG ') 3405 WRITE(ICOUT,4345) 3406 4345 FORMAT(' PREVIOUSLY-DEFINED VARIABLE OR PARAMETER.') 3407 CALL DPWRST('XXX','BUG ') 3408 WRITE(ICOUT,4346)IH1,IH2 3409 4346 FORMAT(' THE NAME OF THE VARIABLE OR PARAMETER WAS ', 3410 1 2A4,' .') 3411 CALL DPWRST('XXX','BUG ') 3412 WRITE(ICOUT,4317) 3413 CALL DPWRST('XXX','BUG ') 3414 IERROR='YES' 3415 GOTO8800 3416C 3417 ENDIF 3418 ENDIF 3419 4300 CONTINUE 3420C 3421 ICASEA='U' 3422 IU=IU+1 3423 IF(IU.GT.MAXU2)GOTO4370 3424 JUNAM1(IU)=IH1 3425 JUNAM2(IU)=IH2 3426 GOTO4370 3427C 3428 4370 CONTINUE 3429 IE=IE+1 3430 IF(IE.GT.MAXE2)THEN 3431 WRITE(ICOUT,999) 3432 CALL DPWRST('XXX','BUG ') 3433 WRITE(ICOUT,211) 3434 CALL DPWRST('XXX','BUG ') 3435 WRITE(ICOUT,4382) 3436 4382 FORMAT(' THE NUMBER OF NAMES IN THE READ COMMAND HAS') 3437 CALL DPWRST('XXX','BUG ') 3438 WRITE(ICOUT,4384)MAXE2 3439 4384 FORMAT(' JUST EXCEEDED THE ALLOWABLE MAXIMUM (',I5,')') 3440 CALL DPWRST('XXX','BUG ') 3441 IERROR='YES' 3442 GOTO8800 3443 ENDIF 3444C 3445 JENAM1(IE)=IH1 3446 JENAM2(IE)=IH2 3447 IECASE(IE)='NEW' 3448 IF(ICASEA.EQ.'V')IECASE(IE)='OLD' 3449 IECOL2(IE)=-1 3450 IF(ICASEA.EQ.'V')IECOL2(IE)=IVALUE(I2) 3451 IF(ICASEA.EQ.'P')IECASE(IE)='OLD' 3452 IF(ICASEA.EQ.'F')IECASE(IE)='OLD' 3453C 3454 IF(ICASTO.EQ.'ON')GOTO4215 3455C 3456 4200 CONTINUE 3457 4290 CONTINUE 3458C 3459CCCCC FEBRUARY 2003: IF NO VARIABLES GIVEN, THEN WILL 3460CCCCC DETERMINE AUTOMATICALLY LATER ON. 3461C 3462 NUMV=IV 3463 NUMP=IP 3464 NUMM=IM 3465 NUMF=IF 3466 NUMU=IU 3467 NUME=IE 3468C 3469 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')THEN 3470 WRITE(ICOUT,4411)NUMALL,NUMV,NUMP,NUMM,NUMF,NUMU,NUME 3471 4411 FORMAT('NUMALL,NUMV,NUMP,NUMM,NUMF,NUMU,NUME = ',7I6) 3472 CALL DPWRST('XXX','BUG ') 3473 WRITE(ICOUT,999) 3474 CALL DPWRST('XXX','BUG ') 3475 WRITE(ICOUT,4412) 3476 4412 FORMAT('I,JVNAM1(I),JVNAM2(I),JPNAM1(I),JPNAM2(I), 3477 1 JMNAM1(I),JMNAM2(I),JFNAM1(I),JFNAM2(I),JUNAM1(I),JUNAM2(I)') 3478 CALL DPWRST('XXX','BUG ') 3479 DO4420I=1,15 3480 WRITE(ICOUT,4421)I,JVNAM1(I),JVNAM2(I),JPNAM1(I),JPNAM2(I), 3481 1 JMNAM1(I),JMNAM2(I),JFNAM1(I),JFNAM2(I),JUNAM1(I),JUNAM2(I) 3482 4421 FORMAT(I8,5X,2A4,1X,2A4,1X,2A4,1X,2A4,1X,2A4) 3483 CALL DPWRST('XXX','BUG ') 3484 4420 CONTINUE 3485 ENDIF 3486C 3487C *************************************************** 3488C ** STEP 5-- ** 3489C ** CHECK FOR A VALID NUMBER ** 3490C ** (1 TO 100) OF VARIABLES TO BE READ ** 3491C ** (NOTE--THIS DOES NOT INCLUDE PARAMETERS ** 3492C ** OR MODELS IN THE ABOVE COUNT-- ** 3493C ** ONLY VARIABLES.) ** 3494C ** CHECK FOR A VALID NUMBER ** 3495C ** (0 TO 100) OF CONSTANTS TO BE READ . ** 3496C ** CHECK FOR A VALID NUMBER ** 3497C ** (0 TO 100) OF MODELS TO BE READ . ** 3498C ** CHECK FOR A VALID NUMBER ** 3499C ** (0 TO 100) OF FUNCTIONS TO BE READ . ** 3500C ** CHECK FOR A VALID NUMBER ** 3501C ** (1 TO 100) OF UNKNOWNS TO BE READ . ** 3502C *************************************************** 3503C 3504 IF(ICASRE.EQ.'CLIP' .AND. IVRLST.EQ.'NO')GOTO7001 3505C 3506 IF(NUMV.LT.0 .OR. NUMV.GT.MAXV2)THEN 3507C 3508 WRITE(ICOUT,211) 3509 CALL DPWRST('XXX','BUG ') 3510 WRITE(ICOUT,512) 3511 512 FORMAT(' FOR A READ, THE NUMBER OF VARIABLES (NOT ', 3512 1 'COUNTING') 3513 CALL DPWRST('XXX','BUG ') 3514 WRITE(ICOUT,514)MAXV2 3515 514 FORMAT(' PARAMETERS OR MODELS) MUST BE AT MOST ',I8,' .') 3516 CALL DPWRST('XXX','BUG ') 3517 WRITE(ICOUT,515) 3518 515 FORMAT(' SUCH WAS NOT THE CASE HERE. THE SPECIFIED') 3519 CALL DPWRST('XXX','BUG ') 3520 WRITE(ICOUT,517)NUMV 3521 517 FORMAT(' NUMBER OF VARIABLES TO BE READ WAS ',I8) 3522 CALL DPWRST('XXX','BUG ') 3523 WRITE(ICOUT,518)MAXV2 3524 518 FORMAT(' NOTE--ONLY THE FIRST ',I8,' VARIABLES WILL BE ', 3525 1 'READ.') 3526 CALL DPWRST('XXX','BUG ') 3527 WRITE(ICOUT,520) 3528 520 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') 3529 CALL DPWRST('XXX','BUG ') 3530 IF(IWIDTH.GE.1)THEN 3531 WRITE(ICOUT,521)(IANSLC(I),I=1,MIN(80,IWIDTH)) 3532 521 FORMAT(80A1) 3533 CALL DPWRST('XXX','BUG ') 3534 ENDIF 3535 ENDIF 3536C 3537 IF(NUMP.LT.0 .OR. NUMP.GT.MAXP2)THEN 3538C 3539 WRITE(ICOUT,211) 3540 CALL DPWRST('XXX','BUG ') 3541 WRITE(ICOUT,532) 3542 532 FORMAT(' FOR A READ, THE NUMBER OF PARAMETERS ') 3543 CALL DPWRST('XXX','BUG ') 3544 WRITE(ICOUT,534)MAXP2 3545 534 FORMAT(' (CONSTANTS) MUST BE AT MOST ',I8,' ;') 3546 CALL DPWRST('XXX','BUG ') 3547 WRITE(ICOUT,535) 3548 535 FORMAT(' SUCH WAS NOT THE CASE HERE. THE SPECIFIED') 3549 CALL DPWRST('XXX','BUG ') 3550 WRITE(ICOUT,537)NUMP 3551 537 FORMAT(' NUMBER OF PARAMETERS TO BE READ WAS ',I8) 3552 CALL DPWRST('XXX','BUG ') 3553 WRITE(ICOUT,538)MAXP2 3554 538 FORMAT(' NOTE--ONLY THE FIRST ',I8,' PARAMETERS WILL ', 3555 1 'BE READ.') 3556 CALL DPWRST('XXX','BUG ') 3557 WRITE(ICOUT,520) 3558 CALL DPWRST('XXX','BUG ') 3559 IF(IWIDTH.GE.1)THEN 3560 WRITE(ICOUT,521)(IANSLC(I),I=1,MIN(80,IWIDTH)) 3561 CALL DPWRST('XXX','BUG ') 3562 ENDIF 3563 ENDIF 3564C 3565 IF(NUMM.LT.0 .OR. NUMM.GT.MAXM2)THEN 3566C 3567 WRITE(ICOUT,211) 3568 CALL DPWRST('XXX','BUG ') 3569 WRITE(ICOUT,553) 3570 553 FORMAT(' FOR A READ, THE NUMBER OF MODELS MUST BE AT') 3571 CALL DPWRST('XXX','BUG ') 3572 WRITE(ICOUT,555)MAXM2 3573 555 FORMAT(' MOST ',I8,' . SUCH WAS NOT THE CASE HERE;') 3574 CALL DPWRST('XXX','BUG ') 3575 WRITE(ICOUT,556)NUMM 3576 556 FORMAT(' THE SPECIFIED NUMBER OF MODELS TO BE READ WAS ', 3577 1 I8) 3578 CALL DPWRST('XXX','BUG ') 3579 WRITE(ICOUT,558)MAXM2 3580 558 FORMAT(' NOTE--ONLY THE FIRST ',I8,' MODELS WILL BE ', 3581 1 'READ.') 3582 CALL DPWRST('XXX','BUG ') 3583 WRITE(ICOUT,520) 3584 CALL DPWRST('XXX','BUG ') 3585 IF(IWIDTH.GE.1)THEN 3586 WRITE(ICOUT,521)(IANSLC(I),I=1,MIN(80,IWIDTH)) 3587 CALL DPWRST('XXX','BUG ') 3588 ENDIF 3589 ENDIF 3590C 3591 IF(NUMF.LT.0 .OR. NUMF.GT.MAXF2)THEN 3592C 3593 WRITE(ICOUT,211) 3594 CALL DPWRST('XXX','BUG ') 3595 WRITE(ICOUT,572) 3596 572 FORMAT(' FOR A READ, THE NUMBER OF FUNCTIONS MUST BE AT') 3597 CALL DPWRST('XXX','BUG ') 3598 WRITE(ICOUT,575)MAXF2 3599 575 FORMAT(' MOST ',I8,' . SUCH WAS NOT THE CASE HERE;') 3600 CALL DPWRST('XXX','BUG ') 3601 WRITE(ICOUT,576)NUMF 3602 576 FORMAT(' THE SPECIFIED NUMBER OF FUNCTIONS TO BE READ ', 3603 1 'WAS ',I8) 3604 CALL DPWRST('XXX','BUG ') 3605 WRITE(ICOUT,578)MAXF2 3606 578 FORMAT(' NOTE--ONLY THE FIRST ',I8,' FUNCTIONS WILL BE ', 3607 1 'READ.') 3608 CALL DPWRST('XXX','BUG ') 3609 WRITE(ICOUT,520) 3610 CALL DPWRST('XXX','BUG ') 3611 IF(IWIDTH.GE.1)THEN 3612 WRITE(ICOUT,521)(IANSLC(I),I=1,MIN(80,IWIDTH)) 3613 CALL DPWRST('XXX','BUG ') 3614 ENDIF 3615 ENDIF 3616C 3617 IF(NUMU.LT.0 .OR. NUMU.GT.MAXU2)THEN 3618C 3619 WRITE(ICOUT,211) 3620 CALL DPWRST('XXX','BUG ') 3621 WRITE(ICOUT,612) 3622 612 FORMAT(' FOR A READ, THE NUMBER OF UNKNOWNS MUST BE AT') 3623 CALL DPWRST('XXX','BUG ') 3624 WRITE(ICOUT,614)MAXU2 3625 614 FORMAT(' MUST BE AT MOST ',I8,'; SUCH WAS NOT THE CASE ', 3626 1 'HERE.') 3627 CALL DPWRST('XXX','BUG ') 3628 WRITE(ICOUT,617)NUMU 3629 617 FORMAT(' THE SPECIFIED NUMBER OF UNKNOWNS TO BE READ WAS ', 3630 1 I8) 3631 CALL DPWRST('XXX','BUG ') 3632 WRITE(ICOUT,618)MAXU2 3633 618 FORMAT(' NOTE--ONLY THE FIRST ',I8,' UNKNOWNS WILL BE ', 3634 1 'READ.') 3635 CALL DPWRST('XXX','BUG ') 3636 WRITE(ICOUT,520) 3637 CALL DPWRST('XXX','BUG ') 3638 IF(IWIDTH.GE.1)THEN 3639 WRITE(ICOUT,521)(IANSLC(I),I=1,MIN(80,IWIDTH)) 3640 CALL DPWRST('XXX','BUG ') 3641 ENDIF 3642C 3643 ENDIF 3644C 3645 IF(ICASRE.EQ.'MATZ' .AND. NUME.NE.3)THEN 3646C 3647 WRITE(ICOUT,211) 3648 CALL DPWRST('XXX','BUG ') 3649 WRITE(ICOUT,632) 3650 632 FORMAT(' FOR THE READ MATRIX TO VARIABLES CASE, THE') 3651 CALL DPWRST('XXX','BUG ') 3652 WRITE(ICOUT,633) 3653 633 FORMAT(' NUMBER OF VARIABLES TO BE READ MUST BE EXACTLY') 3654 CALL DPWRST('XXX','BUG ') 3655 WRITE(ICOUT,635) 3656 635 FORMAT(' THREE. SUCH WAS NOT THE CASE HERE; THE ', 3657 1 'SPECIFIED') 3658 CALL DPWRST('XXX','BUG ') 3659 WRITE(ICOUT,517)NUMV 3660 CALL DPWRST('XXX','BUG ') 3661 WRITE(ICOUT,520) 3662 CALL DPWRST('XXX','BUG ') 3663 IF(IWIDTH.GE.1)THEN 3664 WRITE(ICOUT,521)(IANSLC(I),I=1,MIN(80,IWIDTH)) 3665 CALL DPWRST('XXX','BUG ') 3666 ENDIF 3667 IERROR='YES' 3668 GOTO9000 3669 ENDIF 3670C 3671 IF(ICASRE.EQ.'STAC' .AND. NUME.NE.2)THEN 3672C 3673 WRITE(ICOUT,211) 3674 CALL DPWRST('XXX','BUG ') 3675 WRITE(ICOUT,642) 3676 642 FORMAT(' FOR THE READ STACK VARIABLES CASE, THE') 3677 CALL DPWRST('XXX','BUG ') 3678 WRITE(ICOUT,643) 3679 643 FORMAT(' NUMBER OF VARIABLES TO BE READ MUST BE EXACTLY') 3680 CALL DPWRST('XXX','BUG ') 3681 WRITE(ICOUT,645) 3682 645 FORMAT(' TWO. SUCH WAS NOT THE CASE HERE; THE ', 3683 1 'SPECIFIED') 3684 CALL DPWRST('XXX','BUG ') 3685 WRITE(ICOUT,517)NUMV 3686 CALL DPWRST('XXX','BUG ') 3687 WRITE(ICOUT,520) 3688 CALL DPWRST('XXX','BUG ') 3689 IF(IWIDTH.GE.1)THEN 3690 WRITE(ICOUT,521)(IANSLC(I),I=1,MIN(80,IWIDTH)) 3691 CALL DPWRST('XXX','BUG ') 3692 ENDIF 3693 IERROR='YES' 3694 GOTO9000 3695 ENDIF 3696C 3697 IF(ICASRE.EQ.'IMAZ')THEN 3698 IF(NUME.NE.3 .AND. NUME.NE.5)THEN 3699C 3700 WRITE(ICOUT,211) 3701 CALL DPWRST('XXX','BUG ') 3702 WRITE(ICOUT,652) 3703 652 FORMAT(' FOR THE READ IMAGE TO VARIABLES CASE, ', 3704 1 'THE') 3705 CALL DPWRST('XXX','BUG ') 3706 WRITE(ICOUT,653) 3707 653 FORMAT(' NUMBER OF VARIABLES TO BE READ MUST BE ', 3708 1 'EITHER THREE OR') 3709 CALL DPWRST('XXX','BUG ') 3710 WRITE(ICOUT,655) 3711 655 FORMAT(' FIVE. SUCH WAS NOT THE CASE HERE; THE ', 3712 1 'SPECIFIED') 3713 CALL DPWRST('XXX','BUG ') 3714 WRITE(ICOUT,517)NUMV 3715 CALL DPWRST('XXX','BUG ') 3716 WRITE(ICOUT,520) 3717 CALL DPWRST('XXX','BUG ') 3718 IF(IWIDTH.GE.1)THEN 3719 WRITE(ICOUT,521)(IANSLC(I),I=1,MIN(80,IWIDTH)) 3720 CALL DPWRST('XXX','BUG ') 3721 ENDIF 3722 IERROR='YES' 3723 GOTO9000 3724 ENDIF 3725 ENDIF 3726C 3727 IF(ICASRE.EQ.'IMAG')THEN 3728 IF(NUME.NE.1 .AND. NUME.NE.3)THEN 3729C 3730 WRITE(ICOUT,211) 3731 CALL DPWRST('XXX','BUG ') 3732 WRITE(ICOUT,662) 3733 662 FORMAT(' FOR THE READ IMAGE CASE, THE NUMBER OF') 3734 CALL DPWRST('XXX','BUG ') 3735 WRITE(ICOUT,663) 3736 663 FORMAT(' VARIABLES TO BE READ MUST BE EITHER ONE OR') 3737 CALL DPWRST('XXX','BUG ') 3738 WRITE(ICOUT,665) 3739 665 FORMAT(' THREE. SUCH WAS NOT THE CASE HERE; THE ', 3740 1 'SPECIFIED') 3741 CALL DPWRST('XXX','BUG ') 3742 WRITE(ICOUT,517)NUMV 3743 CALL DPWRST('XXX','BUG ') 3744 WRITE(ICOUT,520) 3745 CALL DPWRST('XXX','BUG ') 3746 IF(IWIDTH.GE.1)THEN 3747 WRITE(ICOUT,521)(IANSLC(I),I=1,MIN(80,IWIDTH)) 3748 CALL DPWRST('XXX','BUG ') 3749 ENDIF 3750 IERROR='YES' 3751 GOTO9000 3752 ENDIF 3753 ENDIF 3754C 3755 IF(ICASRE.EQ.'ROWR')THEN 3756C 3757 IF(IOFILE.EQ.'YES')THEN 3758 IF(NUMARG.GE.3)THEN 3759 IVBASE(1:4)=IHARG(3)(1:4) 3760 IVBASE(5:8)=IHARG2(3)(1:4) 3761 NUME=1 3762 ELSE 3763 NUME=0 3764 ENDIF 3765 ELSE 3766 IF(NUMARG.GE.2)THEN 3767 IVBASE(1:4)=IHARG(2)(1:4) 3768 IVBASE(5:8)=IHARG2(2)(1:4) 3769 NUME=1 3770 ELSE 3771 NUME=0 3772 ENDIF 3773 ENDIF 3774C 3775 IF(NUME.LT.1)THEN 3776C 3777 WRITE(ICOUT,211) 3778 CALL DPWRST('XXX','BUG ') 3779 WRITE(ICOUT,666) 3780 666 FORMAT(' FOR THE ROW READ CASE, THE NUMBER OF') 3781 CALL DPWRST('XXX','BUG ') 3782 WRITE(ICOUT,667) 3783 667 FORMAT(' VARIABLES TO BE READ MUST BE ONE.') 3784 CALL DPWRST('XXX','BUG ') 3785 WRITE(ICOUT,668) 3786 668 FORMAT(' SUCH WAS NOT THE CASE HERE; THE SPECIFIED') 3787 CALL DPWRST('XXX','BUG ') 3788 WRITE(ICOUT,517)NUMV 3789 CALL DPWRST('XXX','BUG ') 3790 WRITE(ICOUT,520) 3791 CALL DPWRST('XXX','BUG ') 3792 IF(IWIDTH.GE.1)THEN 3793 WRITE(ICOUT,521)(IANSLC(I),I=1,MIN(80,IWIDTH)) 3794 CALL DPWRST('XXX','BUG ') 3795 ENDIF 3796 IERROR='YES' 3797 GOTO9000 3798 ENDIF 3799 ENDIF 3800C 3801 IF(ICASRE.NE.'ROWI' .AND. NUME.LT.1 .AND. ICNTCH.LT.1)THEN 3802 WRITE(ICOUT,999) 3803 CALL DPWRST('XXX','BUG ') 3804 WRITE(ICOUT,211) 3805 CALL DPWRST('XXX','BUG ') 3806 WRITE(ICOUT,4452) 3807 4452 FORMAT(' NO VARIABLE NAMES WERE PROVIDED IN THE READ ', 3808 1 'STATEMENT,') 3809 CALL DPWRST('XXX','BUG ') 3810 WRITE(ICOUT,4453) 3811 4453 FORMAT(' HENCE NO READ WAS CARRIED OUT. ILLUSTRATIVE ', 3812 1 'EXAMPLE TO') 3813 CALL DPWRST('XXX','BUG ') 3814 WRITE(ICOUT,4455) 3815 4455 FORMAT(' DEMONSTRATE THE PROPER FORM FOR THE READ ', 3816 1 'COMMAND--') 3817 CALL DPWRST('XXX','BUG ') 3818 WRITE(ICOUT,4456) 3819 4456 FORMAT(' SUPPOSE THE ANALYST WISHES TO READ DATA FROM ', 3820 1 'FILE CALIB.') 3821 CALL DPWRST('XXX','BUG ') 3822 WRITE(ICOUT,4458) 3823 4458 FORMAT(' INTO THE INTERNAL VARIABLES Y, X1, AND X2;') 3824 CALL DPWRST('XXX','BUG ') 3825 WRITE(ICOUT,4459) 3826 4459 FORMAT(' THIS IS DONE BY ENTERING THE COMMAND') 3827 CALL DPWRST('XXX','BUG ') 3828 WRITE(ICOUT,4460) 3829 4460 FORMAT(' READ CALIB. Y X1 X2') 3830 CALL DPWRST('XXX','BUG ') 3831 IERROR='YES' 3832 GOTO8800 3833 ENDIF 3834C 3835C ******************************************************* 3836C ** STEP 6-- ** 3837C ** THOSE NAMES WHICH ARE OF THE UNKNOWN CATEGORY ** 3838C ** WILL BECOME FUTURE VARIABLES/PARAMETERS/FUNCTIONS.* 3839C ** ASSIGN THESE VARIABLES TO THE NEXT AVAILABLE ** 3840C ** COLUMNS, AND UPDATE THE NAME TABLE ACCORDINGLY. ** 3841C ******************************************************* 3842C 3843 IF(NUME.GT.0 .AND. ICASRE.NE.'ROWR')THEN 3844 INAM=NUMNAM 3845 IF(ICASRE.EQ.'VARI')ICOL=NUMCOL 3846 IF(ICASRE.EQ.'STAC')ICOL=NUMCOL 3847 IF(ICASRE.EQ.'MATZ')ICOL=NUMCOL 3848 IF(ICASRE.EQ.'IMAZ')ICOL=NUMCOL 3849 IF(ICASRE.EQ.'CLIP')ICOL=NUMCOL 3850 DO700IE=1,NUME 3851 IF(ICASRE.EQ.'VARI'.AND.IECASE(IE).EQ.'OLD')GOTO700 3852 IF(ICASRE.EQ.'PARA'.AND.IECASE(IE).EQ.'OLD')GOTO700 3853 IF(ICASRE.EQ.'FUNC'.AND.IECASE(IE).EQ.'OLD')GOTO700 3854 IF(ICASRE.EQ.'CFUN'.AND.IECASE(IE).EQ.'OLD')GOTO700 3855 IF(ICASRE.EQ.'MATR'.AND.IECASE(IE).EQ.'OLD')GOTO700 3856 IF(ICASRE.EQ.'MATZ'.AND.IECASE(IE).EQ.'OLD')GOTO700 3857 IF(ICASRE.EQ.'IMAG'.AND.IECASE(IE).EQ.'OLD')GOTO700 3858 IF(ICASRE.EQ.'IMAZ'.AND.IECASE(IE).EQ.'OLD')GOTO700 3859 IF(ICASRE.EQ.'STAC'.AND.IECASE(IE).EQ.'OLD')GOTO700 3860 IF(ICASRE.EQ.'CLIP'.AND.IECASE(IE).EQ.'OLD')GOTO700 3861 IF(ICASRE.EQ.'VARI'.AND.IECOL2(IE).GE.1)GOTO700 3862 IF(ICASRE.EQ.'STAC'.AND.IECOL2(IE).GE.1)GOTO700 3863 IF(ICASRE.EQ.'MATR')GOTO700 3864 INAM=INAM+1 3865 IF(ICASRE.EQ.'VARI')ICOL=ICOL+1 3866 IF(ICASRE.EQ.'STAC')ICOL=ICOL+1 3867 IF(ICASRE.EQ.'MATZ')ICOL=ICOL+1 3868 IF(ICASRE.EQ.'IMAZ')ICOL=ICOL+1 3869 IF(ICASRE.EQ.'CLIP')ICOL=ICOL+1 3870C 3871 IF(INAM.GT.MAXNAM)THEN 3872 WRITE(ICOUT,999) 3873 CALL DPWRST('XXX','BUG ') 3874 WRITE(ICOUT,211) 3875 CALL DPWRST('XXX','BUG ') 3876 WRITE(ICOUT,712) 3877 712 FORMAT(' THE NUMBER OF NAMES (VARIABLES + PARAMETERS') 3878 CALL DPWRST('XXX','BUG ') 3879 WRITE(ICOUT,714) 3880 714 FORMAT(' + FUNCTIONS HAS JUST EXCEEDED THE MAXIMUM ', 3881 1 'SIZE') 3882 CALL DPWRST('XXX','BUG ') 3883 WRITE(ICOUT,715)MAXNAM 3884 715 FORMAT(' (',I5,') OF THE INTERNAL NAME TABLE.') 3885 CALL DPWRST('XXX','BUG ') 3886 IERROR='YES' 3887 GOTO8800 3888 ENDIF 3889C 3890 IF(ICASRE.NE.'PARA' .AND. ICASRE.NE.'FUNC' .AND. 3891 1 ICASRE.NE.'CFUN' .AND. ICASRE.NE.'ROWI' .AND. 3892 1 ICOL.GT.MAXCOL)THEN 3893 WRITE(ICOUT,999) 3894 CALL DPWRST('XXX','BUG ') 3895 WRITE(ICOUT,211) 3896 CALL DPWRST('XXX','BUG ') 3897 WRITE(ICOUT,722) 3898 722 FORMAT(' THE NUMBER OF COLUMNS IN THE INTERNAL ', 3899 1 'DATAPLOT DATA') 3900 CALL DPWRST('XXX','BUG ') 3901 WRITE(ICOUT,724)MAXCOL 3902 724 FORMAT(' ARRAY HAS JUST EXCEEDED THE ALLOWABLE ', 3903 1 'MAXIMUM (',I5,')') 3904 CALL DPWRST('XXX','BUG ') 3905 IERROR='YES' 3906 GOTO8800 3907 ENDIF 3908C 3909 IHNAME(INAM)=JENAM1(IE) 3910 IHNAM2(INAM)=JENAM2(IE) 3911 IF(ICASRE.EQ.'PARA')IUSE(INAM)='P' 3912 IF(ICASRE.EQ.'FUNC')IUSE(INAM)='F' 3913 IF(ICASRE.EQ.'CFUN')IUSE(INAM)='F' 3914 IF(ICASRE.EQ.'VARI' .OR. ICASRE.EQ.'MATZ' .OR. 3915 1 ICASRE.EQ.'STAC' .OR. ICASRE.EQ.'IMAZ' .OR. 3916 1 ICASRE.EQ.'CLIP')THEN 3917 IUSE(INAM)='V' 3918 IVALUE(INAM)=ICOL 3919 IECOL2(IE)=ICOL 3920 IN(INAM)=0 3921 ENDIF 3922 700 CONTINUE 3923 NUMNAM=INAM 3924 IF(ICASRE.EQ.'VARI' .OR. ICASRE.EQ.'MATZ' .OR. 3925 1 ICASRE.EQ.'STAC' .OR. ICASRE.EQ.'IMAZ' .OR. 3926 1 ICASRE.EQ.'CLIP')NUMCOL=ICOL 3927C 3928C 2018/07: IF CONVERTING CHARACTER DATA TO CATEGORICAL DATA, 3929C ADD NUMERIC VARIABLE NAMES TO NAME TABLE. 3930C 3931 IF(IGRPAU.EQ.'CATE' .AND. ICNTCH.GT.0 .AND. 3932 1 IRWLC3.NE.ICNTCH)THEN 3933 DO70000IE=1,ICNTCH 3934 IF(IECOLC(IE).GE.1)GOTO70000 3935 INAM=INAM+1 3936 ICOL=ICOL+1 3937C 3938 IF(INAM.GT.MAXNAM)THEN 3939 WRITE(ICOUT,999) 3940 CALL DPWRST('XXX','BUG ') 3941 WRITE(ICOUT,211) 3942 CALL DPWRST('XXX','BUG ') 3943 WRITE(ICOUT,712) 3944 CALL DPWRST('XXX','BUG ') 3945 WRITE(ICOUT,714) 3946 CALL DPWRST('XXX','BUG ') 3947 WRITE(ICOUT,715)MAXNAM 3948 CALL DPWRST('XXX','BUG ') 3949 IERROR='YES' 3950 GOTO8800 3951 ENDIF 3952C 3953 IF(ICOL.GT.MAXCOL)THEN 3954 WRITE(ICOUT,999) 3955 CALL DPWRST('XXX','BUG ') 3956 WRITE(ICOUT,211) 3957 CALL DPWRST('XXX','BUG ') 3958 WRITE(ICOUT,722) 3959 CALL DPWRST('XXX','BUG ') 3960 WRITE(ICOUT,724)MAXCOL 3961 CALL DPWRST('XXX','BUG ') 3962 IERROR='YES' 3963 GOTO8800 3964 ENDIF 3965C 3966 IHNAME(INAM)=ICLIST(IE) 3967 IHNAM2(INAM)=ICLIS2(IE) 3968 IUSE(INAM)='V' 3969 IVALUE(INAM)=ICOL 3970 IECOLC(IE)=ICOL 3971 IN(INAM)=0 397270000 CONTINUE 3973 NUMNAM=INAM 3974 NUMCOL=ICOL 3975 ENDIF 3976 ENDIF 3977C 3978 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')THEN 3979 WRITE(ICOUT,999) 3980 CALL DPWRST('XXX','BUG ') 3981 WRITE(ICOUT,791)NUMNAM,NUMCOL,NUMNAM,ICASRE 3982 791 FORMAT('NUMNAM,NUMCOL,NUMNAM,ICASRE = ',3I8,2X,A4) 3983 CALL DPWRST('XXX','BUG ') 3984 ENDIF 3985C 3986C ******************************************************** 3987C ** STEP 7-- ** 3988C ** FIRST, BRANCH TO THE APPROPRIATE SUBCASE ** 3989C ** (DEPENDING ON WHETHER UNQUALIFIED, SUBSET OR FOR);** 3990C ** THE DETERMINE THE LENGTH OF THE LONGEST ** 3991C ** VARIABLE TO BE READ IN ; ** 3992C ** THEN READ IN THE VARIABLES ** 3993C ** THAT WERE SPECIFIED. ** 3994C ******************************************************** 3995C 3996 7001 CONTINUE 3997C 3998 ISTEPN='7' 3999 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ') 4000 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) 4001C 4002 MAXNRD=MAXN 4003 IF(IREASB.EQ.'P-P ')ICASEQ='FULL' 4004 IF(ICASEQ.EQ.'SUBS')THEN 4005 NIOLD=MAXNRD 4006 CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR) 4007 NQ2=NIOLD 4008 ELSEIF(ICASEQ.EQ.'FOR')THEN 4009 NIOLD=MAXNRD 4010 CALL DPFOR(NIOLD,NFOR,IROW1,IROWN, 4011 1 NLOCAL,ILOCS,NS,IBUGQ,IERROR) 4012 NQ2=NFOR 4013 ELSE 4014 DO7315I=1,MAXNRD 4015 ISUB(I)=1 4016 7315 CONTINUE 4017 NQ2=MAXNRD 4018 ENDIF 4019C 4020C ******************************************* 4021C ** STEP 8-- ** 4022C ** IF A DATA ROW MINIMUM EXISTS AND SO ** 4023C ** OUR ATTENTION IS FOCUSED ONLY ON ** 4024C ** CERTAIN ROWS OF THE DATA FILE, ** 4025C ** THEN GO DOWN TO THE FIRST SUCH ROW ** 4026C ** IN THE FILE. ** 4027C ******************************************* 4028C 4029 ISTEPN='8' 4030 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ') 4031 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) 4032C 4033 IF(IFMFLG.EQ.'ON' .OR. IFROW1.LE.1 .OR. ICASRE.EQ.'IMAZ' .OR. 4034 1 ICASRE.EQ.'IMAG' .OR. ICASRE.EQ.'CLIP' .OR. 4035 1 ICASRE.EQ.'CFUN')GOTO7369 4036 IFRMIN=1 4037 IFRMAX=IFROW1-1 4038 IF(IFRMIN.GT.IFRMAX)GOTO7369 4039 MINCO2=1 4040 MAXCO2=NUMRCM 4041 IF(IRD2.EQ.IRD)MAXCO2=255 4042 IFCOL3=IFCOL1 4043 IFCOL4=IFCOL2 4044C THE FOLLOWING 2 LINES WERE INSERTED FEBRUARY 1988 4045C TO "TURN OFF" THE COLUMN LIMITS IF READING FROM A NON-FILE 4046C (THAT IS, IF READING FROM THE TERMINAL OR WITHIN A MACRO). 4047 IF(IOFILE.EQ.'NO')THEN 4048 IFCOL3=MINCO2 4049 IFCOL4=MAXCO2 4050 ENDIF 4051 IF(IRD2.EQ.IRD.AND.IFCOL4.GT.MAXCO2)IFCOL4=MAXCO2 4052C 4053 DO7360IFROW=IFRMIN,IFRMAX 4054 IF(IOFILE.EQ.'NO')THEN 4055 READ(IRD2,7361,END=7363,ERR=7363)IJUNK 4056 7361 FORMAT(A1) 4057 ELSEIF(IOFILE.EQ.'YES')THEN 4058 NUMCHA=-1 4059 CALL DPREFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST, 4060 1 IA,NUMCHA, 4061 1 ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR) 4062 IF(IERROR.EQ.'YES')GOTO8800 4063 IF(IA(1).EQ.'E'.AND.IA(2).EQ.'O'.AND.IA(3).EQ.'F'.AND. 4064 1 NUMCHA.EQ.3)GOTO7363 4065 ENDIF 4066 GOTO7360 4067C 4068 7363 CONTINUE 4069 WRITE(ICOUT,999) 4070 CALL DPWRST('XXX','BUG ') 4071 WRITE(ICOUT,211) 4072 CALL DPWRST('XXX','BUG ') 4073 WRITE(ICOUT,7365) 4074 7365 FORMAT(' END OF FILE ENCOUNTERED WHILE SKIPPING OVER', 4075 1 'HEADER LINES.') 4076 CALL DPWRST('XXX','BUG ') 4077 WRITE(ICOUT,7367) 4078 7367 FORMAT(' NOTE SKIP AND ROW LIMITS SETTINGS--') 4079 CALL DPWRST('XXX','BUG ') 4080 WRITE(ICOUT,7368)ISKIP,IFROW1,AFROW2 4081 7368 FORMAT(' ISKIP,IFROW1,IFROW2 = ',2I8,2X,G15.7) 4082 CALL DPWRST('XXX','BUG ') 4083 IERROR='YES' 4084 GOTO8800 4085C 4086 7360 CONTINUE 4087 7369 CONTINUE 4088C 4089C ******************************************* 4090C ** STEP 9-- ** 4091C ** IN ADDITION, IF HEADER (= NON-DATA) ** 4092C ** LINES EXIST WHICH ARE TO BE SKIPPED ** 4093C ** OVER IN THE READ, DO SO HERE. ** 4094C ******************************************* 4095C 4096 ISTEPN='9' 4097 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ') 4098 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) 4099C 4100 IF(IFMFLG.EQ.'ON' .OR. IOFILE.EQ.'NO' .OR. ICASRE.EQ.'IMAZ' .OR. 4101 1 ICASRE.EQ.'IMAG' .OR. ICASRE.EQ.'CLIP' .OR. 4102 1 ICASRE.EQ.'CFUN')GOTO7389 4103C 4104 IF(IFEEDB.EQ.'ON')THEN 4105 WRITE(ICOUT,999) 4106 CALL DPWRST('XXX','BUG ') 4107 IF(IFROW1.LE.1)THEN 4108 WRITE(ICOUT,7371) 4109 7371 FORMAT('THE NUMBER OF HEADER LINES') 4110 CALL DPWRST('XXX','BUG ') 4111 ELSEIF(IFROW1.GE.2)THEN 4112 WRITE(ICOUT,7372) 4113 7372 FORMAT('THE NUMBER OF (ADDITIONAL) HEADER LINES') 4114 CALL DPWRST('XXX','BUG ') 4115 ENDIF 4116 WRITE(ICOUT,7373)ISKIP 4117 7373 FORMAT(' BEING SKIPPED = ',I6) 4118 CALL DPWRST('XXX','BUG ') 4119 ENDIF 4120C 4121CCCCC OCTOBER 1997. SUPPORT "SKIP AUTOMATIC", DENOTED BY ISKIP = -1. 4122CCCCC READ UNTIL FIND "----". IF "----" IS NOT FOUND, REWIND THE 4123CCCCC FILE, AND START READ FROM LINE 1. ALSO, IF READING FROM 4124CCCCC THE TERMINAL, THEN THIS OPTION DOESN'T MAKE SENSE, SO 4125CCCCC ASSUME ISKIP = 0 IN THIS CASE. 4126C 4127 IF(ISKIP.EQ.-1.AND.IOFILE.EQ.'YES'.AND. 4128 1 ICASRE(1:3).NE.'IMA')THEN 4129 IFRMIN=1 4130 MINCO2=1 4131 MAXCO2=NUMRCM 4132 IF(IRD2.EQ.IRD)MAXCO2=255 4133 IFCOL3=IFCOL1 4134 IFCOL4=IFCOL2 4135 IF(IRD2.EQ.IRD.AND.IFCOL4.GT.MAXCO2)IFCOL4=MAXCO2 4136 DO7378I=1,50000 4137 NUMCHA=-1 4138 CALL DPREFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST, 4139 1 IA,NUMCHA,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR) 4140C 4141 IF(IERROR.EQ.'YES')GOTO8800 4142 IF(IA(1).EQ.'-'.AND.IA(2).EQ.'-'.AND.IA(3).EQ.'-'.AND. 4143 1 IA(4).EQ.'-')THEN 4144 GOTO7389 4145 ENDIF 4146 IF(NUMCHA.GE.5)THEN 4147 DO7379LL=1,NUMCHA-3 4148 IF(IA(LL).EQ.'-'.AND.IA(LL+1).EQ.'-'.AND. 4149 1 IA(LL+2).EQ.'-'.AND.IA(LL+3).EQ.'-')THEN 4150 GOTO7389 4151 ENDIF 4152 7379 CONTINUE 4153 ENDIF 4154 IF(IA(1).EQ.'E'.AND.IA(2).EQ.'O'.AND.IA(3).EQ.'F'.AND. 4155 1 NUMCHA.EQ.3)THEN 4156 REWIND IOUNIT 4157 GOTO7389 4158 ENDIF 4159 7378 CONTINUE 4160 ENDIF 4161C 4162 IF(ISKIP.LE.0)GOTO7389 4163 IFRMIN=IFROW1 4164 IFRMAX=IFROW1+ISKIP-1 4165 IF(IFRMIN.GT.IFRMAX)GOTO7389 4166 MINCO2=1 4167 MAXCO2=NUMRCM 4168 IF(IRD2.EQ.IRD)MAXCO2=255 4169 IFCOL3=IFCOL1 4170 IFCOL4=IFCOL2 4171C THE FOLLOWING 2 LINES WERE INSERTED FEBRUARY 1988 4172C TO "TURN OFF" THE COLUMN LIMITS IF READING FROM A NON-FILE 4173C (THAT IS, IF READING FROM THE TERMINAL OR WITHIN A MACRO). 4174 IF(IOFILE.EQ.'NO')THEN 4175 IFCOL3=MINCO2 4176 IFCOL4=MAXCO2 4177 ENDIF 4178 IF(IRD2.EQ.IRD.AND.IFCOL4.GT.MAXCO2)IFCOL4=MAXCO2 4179 DO7380IFROW=IFRMIN,IFRMAX 4180 IF(IOFILE.EQ.'NO')THEN 4181 READ(IRD2,7382,END=7383)IJUNK 4182 7382 FORMAT(A1) 4183 ELSEIF(IOFILE.EQ.'YES')THEN 4184 NUMCHA=-1 4185 CALL DPREFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST, 4186 1 IA,NUMCHA, 4187 1 ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR) 4188 IF(IERROR.EQ.'YES')GOTO8800 4189 IF(IA(1).EQ.'E'.AND.IA(2).EQ.'O'.AND.IA(3).EQ.'F'.AND. 4190 1 NUMCHA.EQ.3)GOTO7383 4191 ENDIF 4192 GOTO7380 4193C 4194 7383 CONTINUE 4195 WRITE(ICOUT,999) 4196 CALL DPWRST('XXX','BUG ') 4197 WRITE(ICOUT,211) 4198 CALL DPWRST('XXX','BUG ') 4199 WRITE(ICOUT,7385) 4200 7385 FORMAT(' END OF FILE ENCOUNTERED WHILE SKIPPING OVER ', 4201 1 'HEADER') 4202 CALL DPWRST('XXX','BUG ') 4203 WRITE(ICOUT,7387) 4204 7387 FORMAT(' LINES. NOTE SKIP AND ROW LIMITS SETTINGS--') 4205 CALL DPWRST('XXX','BUG ') 4206 WRITE(ICOUT,7388)ISKIP,IFROW1,AFROW2 4207 7388 FORMAT(' ISKIP,IFROW1,AFROW2 = ',2I8,2X,E15.7) 4208 CALL DPWRST('XXX','BUG ') 4209 IERROR='YES' 4210 GOTO8800 4211C 4212 7380 CONTINUE 4213 7389 CONTINUE 4214C 4215C ************************ 4216C ** STEP 10-- ** 4217C ** READ IN THE DATA ** 4218C ************************ 4219C 4220C 4221 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')THEN 4222 ISTEPN='10' 4223 CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) 4224 WRITE(ICOUT,999) 4225 CALL DPWRST('XXX','BUG ') 4226 WRITE(ICOUT,7210)NUME,IRD,IRD2,IFLGSV,IB(1),IB(2) 4227 7210 FORMAT('NUME,IRD,IRD2,IFLGSV,IB(1),IB(2),IB(2) = ',4I8,2(2X,A4)) 4228 CALL DPWRST('XXX','BUG ') 4229 ENDIF 4230C 4231C 2019/09: DON'T INITIALIZE IB IF READING FIRST LINE WITH 4232C POSSIBLY CHARACTER DATA FROM THE TERMINAL. 4233C 4234 IF(IFLGSV.EQ.0)THEN 4235 DO7260I=1,MAXRCL 4236 ISTOR1(I)=' ' 4237 ISTOR2(I)=' ' 4238 ISTOR3(I)=' ' 4239 IB(I)=' ' 4240 7260 CONTINUE 4241 ELSE 4242 DO7261I=1,MAXRCL 4243 ISTOR1(I)=' ' 4244 ISTOR2(I)=' ' 4245 ISTOR3(I)=' ' 4246 7261 CONTINUE 4247 ENDIF 4248C 4249 IF(NUME.GT.0)THEN 4250 DO7300I=1,NUME 4251 IEN(I)=0 4252 7300 CONTINUE 4253 ENDIF 4254C 4255 MINCO2=1 4256 MAXCO2=NUMRCM 4257 IF(IRD2.EQ.IRD)MAXCO2=255 4258 IFCOL3=IFCOL1 4259 IFCOL4=IFCOL2 4260C THE FOLLOWING 2 LINES WERE INSERTED FEBRUARY 1988 4261C TO "TURN OFF" THE COLUMN LIMITS IF READING FROM A NON-FILE 4262C (THAT IS, IF READING FROM THE TERMINAL OR WITHIN A MACRO). 4263 IF(IOFILE.EQ.'NO')THEN 4264 IFCOL3=MINCO2 4265 IFCOL4=MAXCO2 4266 ENDIF 4267 IF(IRD2.EQ.IRD.AND.IFCOL4.GT.MAXCO2)IFCOL4=MAXCO2 4268C 4269 I=0 4270 IIN=0 4271 NUMLRD=0 4272 IENDTY=1 4273CCCCC THE FOLLOWING LINE WAS ADDED JUNE 1990 4274CCCCC TO FIX FORMATTED READ YIELDING ONLY 1 LINE JUNE 1990 4275 IEND='NO' 4276 IF(ISKIP.GE.0)THEN 4277 IFRMIN=IFROW1+ISKIP 4278 IF(ICASEQ.EQ.'FOR')IFRMIN=IFROW1+ISKIP+IROW1-1 4279 ELSE 4280 IFRMIN=1 4281 IF(ICASEQ.EQ.'FOR')IFRMIN=IROW1 4282 ENDIF 4283C 4284CCCCC OCTOBER 2004: ACCOUNT FOR SUBSET/FOR CLAUSE LIMITS 4285C 4286 IFRMAX=IFROW2 4287 IF(ICASEQ.EQ.'FOR')THEN 4288 IFRMAX=MIN(IFROW2,IROWN) 4289 ENDIF 4290C 4291 IF(ICASRE.EQ.'PARA' .OR. ICASRE.EQ.'FUNC')IFRMAX=IFRMIN 4292 IF(IHOST1.EQ.'CDC'.AND.IFRMAX.GT.130000)IFRMAX=130000 4293 IF(IFRMAX.GE.IBILLI)IFRMAX=IBILLI 4294 IF(IFRMIN.GT.IFRMAX)GOTO7470 4295CCCCC APRIL 1995. CHECK FOR UNFORMATTED READ CASE. 4296CCCCC INITIAL IMPLEMENTATION ONLY APPLIES TO VARIABLES (NOT 4297CCCCC STRINGS, FUNCTIONS, MATRICES). 4298CCCCC 1) THE FOLLOWING COMMAND: 4299CCCCC SET UNFORMATTED COLUMNS <N> 4300CCCCC SPECIFIES THE NUMBER OF COLUMNS WHEN READING A MATRIX 4301CCCCC 2) UNFORMATTED READ ASSUMES A "SQUARE MATRIX" OF NUMBERS 4302CCCCC CONTAINING ONLY REAL NUMBERS WAS WRITTEN (THAT IS, ASSUME 4303CCCCC A SINGLE WRITE PERFORMED, NOT A MIXTURE OF DIFFERENT TYPES 4304CCCCC ETC.). THE FOLLOWING 2 COMMANDS PROVIDE A LIMITED AMOUNT 4305CCCCC OF FLEXIBILITY: 4306CCCCC SET UNFORMATTED OFFSET <VALUE> 4307CCCCC SET UNFORMATTED RECORDS <VALUE> 4308CCCCC THE FIRST COMMAND SPECIFIES THE NUMBER OF DATA VALUES TO 4309CCCCC SKIP AT THE BEGINING OF THE FILE. THE SECOND COMMAND 4310CCCCC SPECIFIES THE NUMBER OF DATA VALUES TO READ. 4311CCCCC 3) THERE ARE ESSENTIALLY 2 WAYS TO CREATE THE UNFORMATTED 4312CCCCC FILE. FOR EXAMPLE, ASSUME WRITING 10,000 ROWS OF VARIABLES 4313CCCCC X AND Y. THEN CAN WRITE AS: 4314CCCCC A) WRITE(IUNIT) X,Y 4315CCCCC B) WRITE(IUNIT) (X(I),Y(I),I=1,N) 4316CCCCC THE DISTINCTION IS THAT (A) WRITES ALL OF X AND THEN ALL OF 4317CCCCC Y WHEREAS (B) WRITES X(1), Y(1), X(2), Y(2), ..., X(N), Y(N). 4318CCCCC INITIAL IMPLEMENTATION ASSUMES (B) SINCE THIS CORRESPONDS 4319CCCCC TO DATAPLOT'S STORING BY COLUMN. THE 4320CCCCC "SET READ UNFORMATTED-COLUMNWISE" COMMAND SPECIFIES THAT 4321CCCCC METHOD (A) WAS USED TO CREATE THE FILE. 4322CCCCC DATAPLOT WILL READ ENTIRE UNFORMATTED FILE INTO "XSCRT" 4323CCCCC ARRAY. IT WILL CHECK HOW MANY DATA VALUES WERE READ. IT THEN 4324CCCCC DIVIDES THIS BY NUMBER OF VARIABLES TO BE READ. THE DO7400 4325CCCCC LOOP BELOW THEN EXTRACTS EACH ROW OF DATA FROM THIS XSCRT 4326CCCCC ARRAY. 4327C 4328 IF(IFMFLG.EQ.'ON'.AND.ICASRE.NE.'IMAZ'.AND.ICASRE.NE.'IMAG')THEN 4329C 4330 IF(IUNFOF.GT.2*MAXOBV)THEN 4331 WRITE(ICOUT,999) 4332 CALL DPWRST('XXX','BUG ') 4333 WRITE(ICOUT,11212)IUNFOF,2*MAXOBW 433411212 FORMAT('****** ERROR: OFFSET OF ',I8,' IS GREATER THAN ', 4335 1 'MAXIMUM ALLOWED OF ',I8) 4336 CALL DPWRST('XXX','BUG ') 4337 ENDIF 4338C 4339 DO11002JJ=1,3*MAXOBW 4340 XSCRT(JJ)=CPUMIN 434111002 CONTINUE 4342C 4343 IF(ICASRE.EQ.'MATR')NUME=IUNFMC 4344C 4345CCCCC JULY 1996. SGI DOESN'T READ IF XSCRT DIMENSIONED BIGGER 4346CCCCC THAN NUMBER OF DATA POINTS IN FILE. USER MAY NEED TO SPECIFY 4347CCCCC THE COMMAND "SET UNFORMATTED RECORDS <N>". 4348C 4349 IF(IUNFNR.GT.0)THEN 4350 READ(IRD2,ERR=11080,END=11090,IOSTAT=JSTATS) 4351 1 (XSCRT(LL),LL=1,IUNFNR+IUNFOF) 4352 ELSE 4353 READ(IRD2,ERR=11080,END=11090,IOSTAT=JSTATS)XSCRT 4354 ENDIF 4355 GOTO11090 4356C 435711080 CONTINUE 4358 WRITE(ICOUT,999) 4359 CALL DPWRST('XXX','BUG ') 4360 WRITE(ICOUT,11081)JSTATS 436111081 FORMAT('****** ERROR TRYING TO READ AN UNFORMATTED FILE, ', 4362 1 'STATUS NUMBER = ',I8,'.') 4363 CALL DPWRST('XXX','BUG ') 4364 GOTO11090 4365C 436611090 CONTINUE 4367 NSTOP=MAXOBW+IUNFOF 4368 IF(IUNFNR.GT.0)NSTOP=IUNFNR+IUNFOF 4369 DO11100JJ=NSTOP,1,-1 4370 NPTS=JJ 4371 IF(XSCRT(JJ).NE.CPUMIN)GOTO11109 437211100 CONTINUE 4373 WRITE(ICOUT,999) 4374 CALL DPWRST('XXX','BUG ') 4375 WRITE(ICOUT,11111) 437611111 FORMAT('****** ERROR: NO DATA FOUND IN THE UNFORMATTED FILE.') 4377 CALL DPWRST('XXX','BUG ') 4378 GOTO9000 437911109 CONTINUE 4380 NPTS=NPTS-IUNFOF 4381 IFRMIN=1 4382 IFRMAX=NPTS/NUME 4383C 4384CCCCC OCTOBER 2014. CHECK FOR READ FROM CLIPBOARD CASE. 4385CCCCC DATAPLOT WILL READ ALL VALUES IN THE CLIPBORARD TO 4386CCCCC THE "XSCRT" ARRAY. IT WILL RETURN HOW MANY DATA 4387CCCCC VALUES WERE READ. IT THEN DIVIDES THIS BY NUMBER 4388CCCCC OF VARIABLES TO BE READ. THE DO7400 LOOP BELOW 4389CCCCC THEN EXTRACTS EACH ROW OF DATA FROM THIS XSCRT 4390CCCCC ARRAY. 4391C 4392 ELSE IF(ICASRE.EQ.'CLIP')THEN 4393C 4394 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')THEN 4395 WRITE(ICOUT,11203) 439611203 FORMAT('BEFORE CALL DPCLIP') 4397 CALL DPWRST('XXX','BUG ') 4398 ENDIF 4399C 4400 IRTYPE='VARI' 4401 MAXVAL=3*MAXOBW 4402 NUMETT=NUME 4403 ISKIPT=ISKIP 4404 IF(ICLISK.EQ.'OFF')ISKIPT=0 4405 CALL DPCLIP(XSCRT,MAXVAL,NPTS,NUMETT,NUMVLN,PREAMV,ISKIPT, 4406 1 IGRPAU, 4407 1 IVLIST,IVLIS2,IAVANM,MAXRDV, 4408 1 IRTYPE,ISTRZZ,NCSTR,IEOF, 4409 1 IBUGS2,ISUBRO,IERROR) 4410C 4411 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')THEN 4412 WRITE(ICOUT,11205)NPTS,NUMETT,IERROR 441311205 FORMAT('AFTER CALL DPCLIP: NPTS,NUMETT,IERROR = ',2I10,2X,A4) 4414 CALL DPWRST('XXX','BUG ') 4415 ENDIF 4416C 4417 IF(NPTS.LE.0 .OR. IERROR.EQ.'YES')GOTO9000 4418C 4419 IF(NUME.EQ.0 .AND. NUMETT.GT.0)THEN 4420 NUME=NUMETT 4421 NUMVRD=NUMETT 4422 ICOL=NUMCOL 4423 INAM=NUMNAM 4424 IV=0 4425 IU=0 4426 IE=0 4427C 4428 NCBASE=0 4429 DO58590II=8,1,-1 4430 IF(IAVABN(II:II).NE.' ')THEN 4431 NCBASE=II 4432 GOTO58599 4433 ENDIF 443458590 CONTINUE 443558599 CONTINUE 4436C 4437 DO5893J=1,NUMETT 4438 IF(IAVANM.EQ.'FILE')THEN 4439 IVTEMP(1:4)=IVLIST(J)(1:4) 4440 IVTEMP(5:8)=IVLIS2(J)(1:4) 4441 DO5895JJ=1,8 4442 CALL DPCOAN(IVTEMP(JJ:JJ),IVALT) 4443 IF(IVALT.GE.97 .AND. IVALT.LE.122)THEN 4444 IVALT=IVALT-32 4445 CALL DPCONA(IVALT,IVTEMP(JJ:JJ)) 4446 ENDIF 4447 5895 CONTINUE 4448 ELSE 4449 IF(NCBASE.LE.0)THEN 4450 IVTEMP(1:4)='COL ' 4451 NCBASE=3 4452 ELSE 4453 IVTEMP(1:4)=IAVABN(1:4) 4454 IVTEMP(5:8)=IAVABN(5:8) 4455 ENDIF 4456 NCSTAR=NCBASE+1 4457 NCSTOP=NCBASE+J 4458 IF(NCSTOP.GT.8)THEN 4459 NDIFF=NCSTOP-8 4460 NCSTAR=NCSTAR-NDIFF 4461 ENDIF 4462 IF(J.LE.9)THEN 4463 WRITE(IVTEMP(NCSTAR:NCSTAR),'(I1)')J 4464 ELSEIF(J.LE.99)THEN 4465 WRITE(IVTEMP(NCSTAR:NCSTAR+1),'(I2)')J 4466 ELSEIF(J.LE.999)THEN 4467 WRITE(IVTEMP(NCSTAR:NCSTAR+2),'(I3)')J 4468 ELSEIF(J.LE.9999)THEN 4469 WRITE(IVTEMP(NCSTAR:NCSTAR+3),'(I4)')J 4470 ELSE 4471 WRITE(IVTEMP(NCSTAR:NCSTAR+4),'(I5)')J 4472 ENDIF 4473 ENDIF 4474C 4475C CHECK AGAINST VARIABLE LIST. NOTE THAT READ CLIPBOARD IS 4476C CURRENTLY RESRICTED TO READING VARIABLES (I.E., NO STRINGS, 4477C PARAMETERS, OR MATRICES). 4478C 4479 ICASEA=' ' 4480 DO5810I=1,NUMNAM 4481 I2=I 4482 IF(IVTEMP(1:4).EQ.IHNAME(I)(1:4).AND. 4483 1 IVTEMP(5:8).EQ.IHNAM2(I)(1:4))THEN 4484 IF(IUSE(I).EQ.'V')THEN 4485 ICASEA='V' 4486 IV=IV+1 4487 IF(IV.GT.MAXV2)THEN 4488 WRITE(ICOUT,999) 4489 CALL DPWRST('XXX','BUG ') 4490 WRITE(ICOUT,211) 4491 CALL DPWRST('XXX','BUG ') 4492 WRITE(ICOUT,5512) 4493 5512 FORMAT(' THE NUMBER OF VARIABLES DETECTED ', 4494 1 'FROM THE READ CLIPBOARD COMMAND HAS') 4495 CALL DPWRST('XXX','BUG ') 4496 WRITE(ICOUT,5514)MAXV2 4497 5514 FORMAT(' EXCEEDED THE MAXIMUM OF ',I10) 4498 CALL DPWRST('XXX','BUG ') 4499 IERROR='YES' 4500 GOTO8800 4501 ENDIF 4502 JVNAM1(IV)=IVTEMP(1:4) 4503 JVNAM2(IV)=IVTEMP(5:8) 4504 NIV(IV)=IN(I2) 4505 GOTO5870 4506 ELSE 4507 WRITE(ICOUT,999) 4508 CALL DPWRST('XXX','BUG ') 4509 WRITE(ICOUT,211) 4510 CALL DPWRST('XXX','BUG ') 4511 WRITE(ICOUT,4312) 4512 CALL DPWRST('XXX','BUG ') 4513 WRITE(ICOUT,4315) 4514 CALL DPWRST('XXX','BUG ') 4515 WRITE(ICOUT,4316)IVTEMP(1:4),IVTEMP(5:8) 4516 CALL DPWRST('XXX','BUG ') 4517 WRITE(ICOUT,4317) 4518 CALL DPWRST('XXX','BUG ') 4519 IERROR='YES' 4520 GOTO8800 4521 ENDIF 4522 ENDIF 4523 5810 CONTINUE 4524C 4525 ICASEA='U' 4526 IU=IU+1 4527 IF(IU.GT.MAXU2)GOTO5870 4528 JUNAM1(IU)=IVTEMP(1:4) 4529 JUNAM2(IU)=IVTEMP(5:8) 4530 GOTO5870 4531C 4532 5870 CONTINUE 4533 IE=IE+1 4534 IF(IE.GT.MAXE2)THEN 4535 WRITE(ICOUT,999) 4536 CALL DPWRST('XXX','BUG ') 4537 WRITE(ICOUT,211) 4538 CALL DPWRST('XXX','BUG ') 4539 WRITE(ICOUT,4382) 4540 CALL DPWRST('XXX','BUG ') 4541 WRITE(ICOUT,4384)MAXE2 4542 CALL DPWRST('XXX','BUG ') 4543 IERROR='YES' 4544 GOTO8800 4545 ENDIF 4546C 4547 JENAM1(IE)=IVTEMP(1:4) 4548 JENAM2(IE)=IVTEMP(5:8) 4549 IF(ICASEA.EQ.'V')THEN 4550 IECASE(IE)='OLD' 4551 IECOL2(IE)=IVALUE(I2) 4552 ELSE 4553 IECASE(IE)='NEW' 4554C 4555 INAM=INAM+1 4556 IF(INAM.GT.MAXNAM)THEN 4557 WRITE(ICOUT,999) 4558 CALL DPWRST('XXX','BUG ') 4559 WRITE(ICOUT,211) 4560 CALL DPWRST('XXX','BUG ') 4561 WRITE(ICOUT,712) 4562 CALL DPWRST('XXX','BUG ') 4563 WRITE(ICOUT,714) 4564 CALL DPWRST('XXX','BUG ') 4565 WRITE(ICOUT,715)MAXNAM 4566 CALL DPWRST('XXX','BUG ') 4567 IERROR='YES' 4568 GOTO8800 4569 ENDIF 4570C 4571 ICOL=ICOL+1 4572 IF(ICOL.GT.MAXCOL)THEN 4573 WRITE(ICOUT,999) 4574 CALL DPWRST('XXX','BUG ') 4575 WRITE(ICOUT,211) 4576 CALL DPWRST('XXX','BUG ') 4577 WRITE(ICOUT,722) 4578 CALL DPWRST('XXX','BUG ') 4579 WRITE(ICOUT,724)MAXCOL 4580 CALL DPWRST('XXX','BUG ') 4581 IERROR='YES' 4582 GOTO8800 4583 ENDIF 4584C 4585 IF(IECASE(IE).EQ.'NEW')THEN 4586 IHNAME(INAM)=JENAM1(IE) 4587 IHNAM2(INAM)=JENAM2(IE) 4588 IUSE(INAM)='V' 4589 IVALUE(INAM)=ICOL 4590 IN(INAM)=0 4591 IECOL2(IE)=ICOL 4592 ENDIF 4593C 4594 ENDIF 4595C 4596 5893 CONTINUE 4597 NUMV=IV 4598 NUMU=IU 4599 NUME=IE 4600 NUMCOL=ICOL 4601 NUMNAM=INAM 4602C 4603 ENDIF 4604C 4605CCCCC OCTOBER 2014. CHECK FOR READ STRING FROM CLIPBOARD CASE. 4606C 4607 ELSE IF(ICASRE.EQ.'CFUN')THEN 4608C 4609 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')THEN 4610 WRITE(ICOUT,11203) 4611 CALL DPWRST('XXX','BUG ') 4612 ENDIF 4613C 4614 ISTRZZ=' ' 4615 IRTYPE='STRI' 4616 MAXVAL=3*MAXOBW 4617 NUMETT=0 4618 IEOF=0 4619C 4620C LOOP THROUGH STRINGS 4621C 4622 DO11301II=1,NUME 4623 ISKIPT=ISKIP 4624 IF(ICLISK.EQ.'OFF')ISKIPT=0 4625 ISKIPT=ISKIPT+II-1 4626 CALL DPCLIP(XSCRT,MAXVAL,NPTS,NUMETT,NUMVLN,PREAMV,ISKIPT, 4627 1 IGRPAU, 4628 1 IVLIST,IVLIS2,IAVANM,MAXRDV, 4629 1 IRTYPE,ISTRZZ,NCSTR,IEOF, 4630 1 IBUGS2,ISUBRO,IERROR) 4631C 4632 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')THEN 4633 WRITE(ICOUT,11305)NCSTR,ISTRZZ 463411305 FORMAT('NCSTR,ISTRZZ = ',I5,255A1) 4635 CALL DPWRST('XXX','BUG ') 4636 ENDIF 4637C 4638 IF(NCSTR.LE.0)THEN 4639 ISTRZZ='NULL' 4640 NCSTR=4 4641 ENDIF 4642C 4643 DO77801KK=1,NCSTR 4644 IFUNC2(KK)=' ' 4645 IFUNC2(KK)(1:1)=ISTRZZ(KK:KK) 464677801 CONTINUE 4647C 4648 CALL DPUPPE(IFUNC2,NCSTR,IFUNC3,IBUGS2,IERROR) 4649 ISTART=IFCOL1 4650 ISTOP=N2 4651 IH1=JENAM1(II) 4652 IH2=JENAM2(II) 4653 DO77820J=1,NUMNAM 4654 IF(IUSE(J).EQ.'F'.AND. 4655 1 IHNAME(J).EQ.IH1.AND.IHNAM2(J).EQ.IH2)THEN 4656 NEWNAM='NO' 4657 IF(IECASE(II).EQ.'NEW')NEWNAM='YES' 4658 ILISTL=J 4659C 4660 CALL DPINFU(IFUNC3,NCSTR,IHNAME,IHNAM2,IUSE,IN, 4661 1 IVSTAR,IVSTOP, 4662 1 NUMNAM,IANSLC,IWIDTH,IH1,IH2,ILISTL, 4663 1 NEWNAM,MAXNME, 4664 1 IFUNC,NUMCHF,MAXCHF,IBUGS2,IERROR) 4665C 4666 IF(NEWNAM.EQ.'YES'.AND.IERROR.EQ.'NO')NUMNAM=NUMNAM-1 4667C 4668 ENDIF 466977820 CONTINUE 467011301 CONTINUE 4671C 4672 GOTO7900 4673C 4674 ENDIF 4675C 4676CCCCC OCTOBER 2004: SUBSET/FOR/EXPECT CLAUSES ON READ HAVE SOME 4677CCCCC AMBIGUITY. THAT IS, DOES THE SUBSET REFER TO THE LINES THAT 4678CCCCC ARE READ FROM THE FILE OR DOES THE SUBSET REFER TO HOW THE 4679CCCCC DATA ARE SAVED IN THE OUTPUT VECTORS. WE ADDRESS THIS WITH 4680CCCCC THE COMMAND 4681CCCCC 4682CCCCC SET READ SUBSET <PACK/DISPERSE> <PACK/DISPERSE> 4683CCCCC 4684CCCCC THE FIRST SETTING SPECIFIES HOW THE DATA FILE IS HANDLED 4685CCCCC (PACK MEANS SUBSET/FOR CLAUSE DOES NOT APPLY TO LINES IN 4686CCCCC FILE WHILE DISPERSE MEANS THAT IT DOES). LIKEWISE, THE SECOND 4687CCCCC SETTING SPECIFIES HOW THE SUBSET/FOR CLAUSE APPLIES TO THE 4688CCCCC OUTPUT VARIABLES (PACK MEANS SUBSET IGNORED ON OUTPUT VECTOR, 4689CCCCC DISPERSE MEAMS THAT IT DOES). THESE SETTINGS ARE CODED AS 4690CCCCC "P-D", "P-P", "D-P", "D-D". THE DEFAULT IS "P-D" (I.E., 4691CCCCC THE SUBSET APPLIES TO THE OUTPUT VECTORS, BUT NOT THE INPUT 4692CCCCC FILE). FOR EXAMPLE, THE COMMAND 4693CCCCC 4694CCCCC READ X FOR I = 1 2 10 4695CCCCC 4696CCCCC X P-D P-P D-P D-D 4697CCCCC =========================================== 4698CCCCC 1 1 1 1 1 4699CCCCC 2 0 2 3 0 4700CCCCC 3 2 3 5 3 4701CCCCC 4 0 4 7 0 4702CCCCC 5 3 5 9 5 4703CCCCC 6 0 - - 0 4704CCCCC 7 4 - - 7 4705CCCCC 8 0 - - 0 4706CCCCC 9 5 - - 9 4707CCCCC 10 0 - - 0 4708C 4709C 4710 IF(ICASRE.EQ.'IMAZ' .OR. ICASRE.EQ.'IMAG')THEN 4711 IFRMIN=1 4712 IFRMAX=IYSIZE 4713 ENDIF 4714C 4715 IF(ICASRE.EQ.'CLIP')THEN 4716 IFRMIN=1 4717CCCCC IFRMAX=NPTS/NUME 4718CCCCC IREM=MOD(NPTS,NUME) 4719 IFRMAX=NPTS/NUMVLN 4720 IREM=MOD(NPTS,NUMVLN) 4721 IF(IREM.GT.0)IFRMAX=IFRMAX+1 4722 ENDIF 4723C 4724 NCALL=0 4725 I=0 4726 IMAXRW=IFRMAX-IFRMIN+1 4727 DO7400IFROW=IFRMIN,IFRMAX 4728C 4729 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')THEN 4730 WRITE(ICOUT,7401)IFROW,IMNVAR,IMXVAR 4731 7401 FORMAT('AT 7400: IFROW,IMNVAR,IMXVAR = ',3I8) 4732 CALL DPWRST('XXX','BUG ') 4733 ENDIF 4734C 4735 IF(ICASRE.EQ.'IMAZ' .OR. ICASRE.EQ.'IMAG')THEN 4736 NUMLRD=NUMLRD+1 4737 IROWXX=IFROW 4738 IRED=1 4739 IGREEN=1 4740 IBLUE=1 4741 DO74001JJ=1,IXSIZE 4742 ICOLXX=JJ 4743 IXTEMP=ICOLXX 4744CCCCC IYTEMP=IROWXX 4745 IYTEMP=IYSIZE - IROWXX 4746#ifdef HAVE_GD 4747 CALL GDPIXE(IXTEMP,IYTEMP,IRED,IGREEN,IBLUE) 4748#endif 4749 X0(ICOLXX)=REAL(IRED) 4750 X0(IXSIZE + ICOLXX)=REAL(IGREEN) 4751 X0(2*IXSIZE + ICOLXX)=REAL(IBLUE) 475274001 CONTINUE 4753 NUMDPL=3*IXSIZE 4754 GOTO7440 4755 ENDIF 4756C 4757 IIN=IIN+1 4758 IF(ISUB(IIN).NE.1 .AND. ICASRE.NE.'CLIP')THEN 4759 IF(IREASB(1:1).EQ.'D')THEN 4760 IF(IREASB(3:3).EQ.'D')THEN 4761 I=I+1 4762 ENDIF 4763 NUMCHA=-1 4764 CALL DPREFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST, 4765 1 IA,NUMCHA,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR) 4766 IF(IA(1).EQ.'E'.AND.IA(2).EQ.'O'.AND.IA(3).EQ.'F'.AND. 4767 1 NUMCHA.EQ.3)THEN 4768 REWIND IOUNIT 4769 IENDTY=1 4770 GOTO7490 4771 ENDIF 4772 GOTO7400 4773 ENDIF 4774 ENDIF 4775C 4776 IF(ICASRE.NE.'CLIP' .AND. NCREAF.LE.0 .OR. ICASRE.EQ.'FUNC' .OR. 4777 1 ICASRE.EQ.'ROWI')THEN 4778 NXCSAV=NXC 4779 CALL DPREAL(IRD2,IFCOL3,IFCOL4,MINCO2,MAXCO2,X0,NUMDPL,IFLGSV, 4780 1 IXC,NXC, 4781 1 ICASRE,IFUNC2,N2,MAXN2, 4782 1 IMACRO,IMACNU,IMACCS, 4783 1 IANSLC,IWIDTH,IREACS,ISTOR1,ISTOR2,IEND,NUMLRD, 4784 1 IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST, 4785 1 ICOMCH,ICOMSW,LINETY,IGRPA2, 4786 1 IFCOLL,IFCOLU,ITYPE,NCOLS,NCALL, 4787 1 IREADL,IDATDL,ITIMDL,IRDIPA,PREAMV, 4788 1 MAXRDV,MAXCHV,IFIETY, 4789 1 IDECPT,IDATMV,IDATNN, 4790 1 IREACD,IREACM,IREADS,IREAPM,IREAMC,ITABNC, 4791 1 IREAAS,IREAPC, 4792 1 IB, 4793 1 IOTERM,IANSLO,MAXLIL,MAXCIL,ILOOST,ILOOLI, 4794 1 IREPCH,IMALEV, 4795 1 IERRFI,IBUGS2,ISUBRO,IERROR) 4796C 4797 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')THEN 4798 WRITE(ICOUT,7402)LINETY,IEND,IERROR,NUMDPL 4799 7402 FORMAT('AFTER DPREAL: LINETY,IEND,IERROR,NUMDPL = ', 4800 1 3(A4,2X),I8) 4801 CALL DPWRST('XXX','BUG ') 4802 ENDIF 4803C 4804 IF(LINETY.EQ.'BLAN')GOTO7400 4805 IF(IERROR.EQ.'YES')GOTO9000 4806 IF(ICASRE.NE.'ROWR' .AND. IEND.EQ.'NO')THEN 4807 IF(IMNVAR.EQ.-1)THEN 4808 IMNVAR=NUMDPL 4809 ELSE 4810 IF(NUMDPL.LT.IMNVAR)IMNVAR=NUMDPL 4811 ENDIF 4812 IF(NUMDPL.GT.IMXVAR)IMXVAR=NUMDPL 4813 ENDIF 4814C 4815 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')THEN 4816 WRITE(ICOUT,7403)IMNVAR,IMXVAR 4817 7403 FORMAT('IMNVAR,IMXVAR = ',2I8) 4818 CALL DPWRST('XXX','BUG ') 4819 ENDIF 4820C 4821 NUMLRD=NUMLRD+1 4822 NCALL=NCALL+1 4823C 4824C HANDLE "ROW READ" SEPARATELY 4825C 4826 IF(ICASRE.EQ.'ROWR')THEN 4827C 4828 IF(IEND.EQ.'YES')THEN 4829 IVBASE=IVBASV 4830 NUMDPL=NUMDSV 4831 NUMLRD=NUMLRD-1 4832 GOTO8800 4833 ENDIF 4834C 4835 IF(IOFILE.EQ.'YES')THEN 4836 IVBASE(1:4)=IHARG(3)(1:4) 4837 IVBASE(5:8)=IHARG2(3)(1:4) 4838 ELSE 4839 IVBASE(1:4)=IHARG(2)(1:4) 4840 IVBASE(5:8)=IHARG2(2)(1:4) 4841 ENDIF 4842 IVLAST=8 4843 DO22111LL=8,1,-1 4844 IF(IVBASE(LL:LL).NE.' ')THEN 4845 IVLAST=LL 4846 GOTO22119 4847 ENDIF 484822111 CONTINUE 4849 IVLAST=1 4850 IVBASE='X' 485122119 CONTINUE 4852 IF(NUMDPL.GT.0)THEN 4853 IF(NUMLRD.LE.9)THEN 4854 IF(IVLAST.GT.7)IVLAST=7 4855 WRITE(IVBASE(IVLAST+1:IVLAST+1),'(I1)')NUMLRD 4856 ELSEIF(NUMLRD.LE.99)THEN 4857 IF(IVLAST.GT.6)IVLAST=6 4858 WRITE(IVBASE(IVLAST+1:IVLAST+2),'(I2)')NUMLRD 4859 ELSEIF(NUMLRD.LE.999)THEN 4860 IF(IVLAST.GT.5)IVLAST=5 4861 WRITE(IVBASE(IVLAST+1:IVLAST+3),'(I3)')NUMLRD 4862 ELSEIF(NUMLRD.LE.9999)THEN 4863 IF(IVLAST.GT.4)IVLAST=4 4864 WRITE(IVBASE(IVLAST+1:IVLAST+4),'(I4)')NUMLRD 4865 ELSEIF(NUMLRD.LE.99999)THEN 4866 IF(IVLAST.GT.3)IVLAST=3 4867 WRITE(IVBASE(IVLAST+1:IVLAST+5),'(I5)')NUMLRD 4868 ENDIF 4869 ENDIF 4870C 4871 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')THEN 4872 WRITE(ICOUT,22101)NUMLRD,NUMDPL,IVLAST,IVBASE 487322101 FORMAT('NUMLRD,NUMDPL,IVLAST,IVBASE = ',3I6,2X,A8) 4874 CALL DPWRST('XXX','BUG ') 4875 ENDIF 4876C 4877 DO55810I=1,NUMNAM 4878 I2=I 4879C 4880C PRE-EXISTING VARIABLE NAME FOUND 4881C 4882 IF(IVBASE(1:4).EQ.IHNAME(I)(1:4).AND. 4883 1 IVBASE(5:8).EQ.IHNAM2(I)(1:4))THEN 4884 IF(IUSE(I).EQ.'V')THEN 4885 ICASEA='V' 4886 ICOL=IVALUE(I2) 4887 GOTO55870 4888 ELSE 4889 WRITE(ICOUT,999) 4890 CALL DPWRST('XXX','BUG ') 4891 WRITE(ICOUT,211) 4892 CALL DPWRST('XXX','BUG ') 4893 WRITE(ICOUT,4312) 4894 CALL DPWRST('XXX','BUG ') 4895 WRITE(ICOUT,4315) 4896 CALL DPWRST('XXX','BUG ') 4897 WRITE(ICOUT,4316)IVBASE(1:4),IVBASE(5:8) 4898 CALL DPWRST('XXX','BUG ') 4899 WRITE(ICOUT,44317) 490044317 FORMAT(' THIS ROW WILL BE SKIPPED.') 4901 CALL DPWRST('XXX','BUG ') 4902 IERROR='YES' 4903 GOTO7400 4904 ENDIF 4905 ENDIF 490655810 CONTINUE 4907C 4908 NUMNAM=NUMNAM+1 4909 I2=NUMNAM 4910 IF(NUMNAM.GT.MAXNME)THEN 4911 WRITE(ICOUT,999) 4912 CALL DPWRST('XXX','BUG ') 4913 WRITE(ICOUT,211) 4914 CALL DPWRST('XXX','BUG ') 4915 WRITE(ICOUT,712) 4916 CALL DPWRST('XXX','BUG ') 4917 WRITE(ICOUT,714) 4918 CALL DPWRST('XXX','BUG ') 4919 WRITE(ICOUT,715)MAXNME 4920 CALL DPWRST('XXX','BUG ') 4921 NUMNAM=NUMNAM-1 4922 IVBASE=IVBASV 4923 NUMDPL=NUMDSV 4924 NUMLRD=NUMLRD-1 4925 IERROR='YES' 4926 GOTO8800 4927 ENDIF 4928C 4929 NUMCOL=NUMCOL+1 4930 ICOL=NUMCOL 4931 IF(ICOL.GT.MAXCOL)THEN 4932 WRITE(ICOUT,999) 4933 CALL DPWRST('XXX','BUG ') 4934 WRITE(ICOUT,211) 4935 CALL DPWRST('XXX','BUG ') 4936 WRITE(ICOUT,722) 4937 CALL DPWRST('XXX','BUG ') 4938 WRITE(ICOUT,724)MAXCOL 4939 CALL DPWRST('XXX','BUG ') 4940 NUMCOL=NUMCOL-1 4941 IERROR='YES' 4942 IVBASE=IVBASV 4943 NUMDPL=NUMDSV 4944 NUMLRD=NUMLRD-1 4945 GOTO8800 4946 ENDIF 4947C 4948 IHNAME(NUMNAM)=IVBASE(1:4) 4949 IHNAM2(NUMNAM)=IVBASE(5:8) 4950C 495155870 CONTINUE 4952C 4953 IF(NUMDPL.GT.MAXN)THEN 4954 NUMDPL=MAXN 4955 WRITE(ICOUT,44318)NUMLRD,MAXN 495644318 FORMAT('ROW READ: FOR LINE ',I6,' THE NUMBER ', 4957 1 'OF VALUES TRUNCATED AT ',I10) 4958 CALL DPWRST('XXX','BUG ') 4959 ENDIF 4960C 4961 DO55880II=1,NUMDPL 4962 IJ=MAXN*(ICOL-1)+II 4963 IF(ICOL.LE.MAXCOL)V(IJ)=X0(II) 4964 IF(ICOL.EQ.MAXCP1)PRED(I)=X0(II) 4965 IF(ICOL.EQ.MAXCP2)RES(I)=X0(II) 4966 IF(ICOL.EQ.MAXCP3)YPLOT(I)=X0(II) 4967 IF(ICOL.EQ.MAXCP4)XPLOT(I)=X0(II) 4968 IF(ICOL.EQ.MAXCP5)X2PLOT(I)=X0(II) 4969 IF(ICOL.EQ.MAXCP6)TAGPLO(I)=X0(II) 497055880 CONTINUE 4971 IUSE(I2)='V' 4972 IVALUE(I2)=ICOL 4973 IN(I2)=NUMDPL 4974C 4975 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')THEN 4976 WRITE(ICOUT,55802)NUMLRD,NUMDPL,IVLAST,IVBASE 497755802 FORMAT('I2,ICOL,IUSE(I2),IVALUE(I2),IN(I2) = ', 4978 1 2I10,I6,2X,A8) 4979 CALL DPWRST('XXX','BUG ') 4980 ENDIF 4981C 4982 IF(IFEEDB.EQ.'ON' .AND. NUMLRD.EQ.1)THEN 4983CCCCC IF(IFEEDB.EQ.'ON')THEN 4984 WRITE(ICOUT,999) 4985 CALL DPWRST('XXX','BUG ') 4986 WRITE(ICOUT,55805)NUMLRD,IVBASE,NUMDPL 498755805 FORMAT('ROW READ: ROW ',I10,' READ AS ',A8,' WITH ',I10, 4988 1 ' OBSERVATIONS READ') 4989 CALL DPWRST('XXX','BUG ') 4990 ENDIF 4991C 4992 IVBASV=IVBASE 4993 NUMDSV=NUMDPL 4994 GOTO7400 4995 ENDIF 4996C 4997C IF CHARACTER DATA ENCOUNTERED, WRITE IT TO FILE 4998C 4999C 2019/09: WRITE RESULTS TO "dpst2f.dat" INITIALLY. 5000C 5001 IF(NXC.GT.0 .AND. 5002 1 (IGRPAU.EQ.'CHAR' .OR. IGRPAU.EQ.'CATE'))THEN 5003 IF(NUMLRD.EQ.1)THEN 5004C 5005CCCCC IOUNI2=IZCHNU 5006CCCCC IFILE2=IZCHNA 5007CCCCC ISTAT2=IZCHST 5008CCCCC IFORM2=IZCHFO 5009CCCCC IACCE2=IZCHAC 5010CCCCC IPROT2=IZCHPR 5011CCCCC ICURS2=IZCHCS 5012C 5013CCCCC ISUBN0='READ' 5014CCCCC IERRFI='NO' 5015CCCCC CALL DPOPFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2, 5016CCCCC1 ICURS2, 5017CCCCC1 IREWI2,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR) 5018CCCCC IF(IERROR.EQ.'YES')GOTO9000 5019C 5020 IOP='OPEN' 5021 IFLG11=0 5022 IFLG21=1 5023 IFLG31=0 5024 IFLAG4=0 5025 IFLAG5=0 5026 CALL DPAUFI(IOP,IFLG11,IFLG21,IFLG31,IFLAG4,IFLAG5, 5027 1 IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5, 5028 1 IBUGS2,ISUBRO,IERROR) 5029 IF(IERRFI.EQ.'YES')GOTO9000 5030C 5031 IZCHCS=ICURS2 5032C 5033 WRITE(IOUNI2,'(I8)')NXC 5034 DO27810ICNT=1,MIN(NXC,MAXCHV) 5035 WRITE(IOUNI2,'(A4,A4)')ICLIST(ICNT),ICLIS2(ICNT) 503627810 CONTINUE 5037 ENDIF 5038 WRITE(IOUNI2,'(20(A24,1X))')(IXC(J)(1:24),J=1,NXC) 5039C 5040C IF "SET CONVERT CHARACTER CATEGORICAL" GIVEN, THEN 5041C CREATE A NUMERIC VARIABLE AS WELL. 5042C 5043 IF(IGRPAU.EQ.'CATE')THEN 5044 DO27820J=1,NXC 5045 NTEMP=IXCATN(J) 5046 IF(NTEMP.LT.1)THEN 5047 IXCATN(J)=1 5048 IXCAT(1,J)(1:24)=IXC(J)(1:24) 5049 X0CAT(J)=1.0 5050 ELSE 5051 DO27830II=1,NTEMP 5052 IF(IXC(J)(1:24).EQ.IXCAT(II,J)(1:24))THEN 5053 X0CAT(J)=REAL(II) 5054 GOTO27820 5055 ENDIF 505627830 CONTINUE 5057 NTEMP2=IXCATN(J) 5058 IF(NTEMP2.GE.1000)THEN 5059 X0CAT(J)=-1.0 5060 ELSE 5061 IXCATN(J)=IXCATN(J)+1 5062 IXCAT(IXCATN(J),J)(1:24)=IXC(J)(1:24) 5063 X0CAT(J)=REAL(IXCATN(J)) 5064 ENDIF 5065 ENDIF 506627820 CONTINUE 5067 ENDIF 5068C 5069 ENDIF 5070 ELSEIF(IFMFLG.EQ.'ON')THEN 5071C 5072 NUMLRD=NUMLRD+1 5073 IF(IUNFNR.GT.0.AND.NUMLRD*NUME.GT.IUNFNR)GOTO7400 5074 NUMDPL=NUME 5075 IF(ICRFLG.EQ.'ROW')THEN 5076 IPTR1=(NUMLRD-1)*NUME+1+IUNFOF 5077 IPTR2=IPTR1+NUME-1 5078 ICOUNT=0 5079 DO17415JJ=IPTR1,IPTR2 5080 ICOUNT=ICOUNT+1 5081 X0(ICOUNT)=XSCRT(JJ) 508217415 CONTINUE 5083 ELSE 5084 IPTR1=NUMLRD+IUNFOF 5085 IPTR2=IFRMAX 5086 DO17515JJ=1,NUME 5087 ICOUNT=IPTR1+(JJ-1)*IPTR2 5088 X0(JJ)=XSCRT(ICOUNT) 508917515 CONTINUE 5090 ENDIF 5091 ELSEIF(ICASRE.EQ.'CLIP')THEN 5092C 5093 NUMLRD=NUMLRD+1 5094 NUMDPL=NUME 5095C 5096C 2020/02: SET POINTER BASED ON MANY VALUES READ FROM 5097C CLIPBOARD RATHER THAN THE NUMBER OF VARIABLES 5098C USER REQUESTED. 5099C 5100CCCCC IPTR1=(NUMLRD-1)*NUME+1 5101 IPTR1=(NUMLRD-1)*NUMVLN+1 5102 IPTR2=IPTR1+NUME-1 5103 ICOUNT=0 5104 DO27415JJ=IPTR1,IPTR2 5105 ICOUNT=ICOUNT+1 5106 IF(ICOUNT.LE.NUMVLN)THEN 5107 X0(ICOUNT)=XSCRT(JJ) 5108 ELSE 5109 X0(ICOUNT)=PREAMV 5110 ENDIF 511127415 CONTINUE 5112 ELSE 5113 NUMLRD=NUMLRD+1 5114 NUMDPL=NUME 5115 IF(ICOMSW.EQ.'ON')THEN 5116 7417 CONTINUE 5117 READ(IRD2,'(A80)',END=7480)IAJUNK 5118 IF(IAJUNK(1:1).EQ.ICOMCH(1:1))GOTO7417 5119 BACKSPACE(UNIT=IRD2,IOSTAT=IOS,ERR=7413) 5120 GOTO7415 5121 7413 CONTINUE 5122 WRITE(ICOUT,743) 5123 743 FORMAT('ERROR TRYING TO BACKSPACE FILE ON FORMATTED READ') 5124 CALL DPWRST('XXX','BUG ') 5125 GOTO7417 5126 ENDIF 5127 READ(IRD2,ICREAF,END=7480,ERR=7480)(X0(K),K=1,NUME) 5128 GOTO7415 5129 ENDIF 5130C 5131 7415 CONTINUE 5132 IF(IERROR.EQ.'YES')GOTO8800 5133 IF(IFROW.EQ.IFRMIN .AND.ICASRE.NE.'CLIP')THEN 5134 DO7425K=1,132 5135 ISTOR3(K)=ISTOR2(K) 5136 7425 CONTINUE 5137 GOTO7430 5138 ENDIF 5139 IF(IEND.EQ.'YES')GOTO7480 5140C 5141 7430 CONTINUE 5142 I=I+1 5143C 5144 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')THEN 5145 WRITE(ICOUT,999) 5146 CALL DPWRST('XXX','BUG ') 5147 WRITE(ICOUT,7431) 5148 7431 FORMAT('***** FROM THE MIDDLE OF DPREAD--') 5149 CALL DPWRST('XXX','BUG ') 5150 AFRMAX=IFRMAX 5151 WRITE(ICOUT,7432)IFROW,IFRMIN,AFRMAX,IBUGS2,ISUBRO 5152 7432 FORMAT('IFROW,IFRMIN,AFRMAX,IBUGS2,ISUBRO = ',2I8,E15.7, 5153 1 2X,A4,2X,A4) 5154 CALL DPWRST('XXX','BUG ') 5155 WRITE(ICOUT,7433)I,ISUB(I),NUME,IBUGS2,ISUBRO 5156 7433 FORMAT('I,ISUB(I),NUME,IBUGS2,ISUBRO = ',3I8,2X,A4,2X,A4) 5157 CALL DPWRST('XXX','BUG ') 5158 WRITE(ICOUT,7434)MAXN,MAXCOL,MAXCP1,MAXCP2 5159 7434 FORMAT('MAXN,MAXCOL,MAXCP1,MAXCP2 = ',4I8) 5160 CALL DPWRST('XXX','BUG ') 5161 WRITE(ICOUT,7435)X0(1),X0(2),X0(3) 5162 7435 FORMAT('X0(1),X0(2),X0(3) = ',3E15.7) 5163 CALL DPWRST('XXX','BUG ') 5164 WRITE(ICOUT,7436)IECOL2(1),IECOL2(2),IECOL2(3) 5165 7436 FORMAT('IECOL2(1),IECOL2(2),IECOL2(3) = ',3I8) 5166 CALL DPWRST('XXX','BUG ') 5167 WRITE(ICOUT,7437)IEN(1),IEN(2),IEN(3) 5168 7437 FORMAT('IEN(1),IEN(2),IEN(3) = ',3I8) 5169 CALL DPWRST('XXX','BUG ') 5170 WRITE(ICOUT,7438)ICASRE,NUMVRD,NUMPRD,NUMFRD 5171 7438 FORMAT('ICASRE,NUMVRD,NUMPRD,NUMFRD = ',A4,3I8) 5172 CALL DPWRST('XXX','BUG ') 5173 ENDIF 5174C 5175CCCCC OCTOBER 2004: IS OUTPUT VECTOR PACKED OR DISPERSED? 5176C 5177 IF(I.GT.MAXN .OR. I.GT.IMAXRW)GOTO7480 5178 IJUNK=I 5179 IF(IREASB(3:3).EQ.'P' .AND. IREASB(1:1).EQ.'D')IJUNK=IIN 5180 IF(ISUB(IJUNK).EQ.1)THEN 5181 GOTO7440 5182 ELSE 5183 IF(IREASB(3:3).EQ.'D')THEN 5184 GOTO7430 5185 ELSE 5186 GOTO7400 5187 ENDIF 5188 ENDIF 5189C 5190 7440 CONTINUE 5191 IF(ICASRE.EQ.'PARA')THEN 5192 NUMPRD=NUME 5193 GOTO7400 5194 ELSEIF(ICASRE.EQ.'FUNC')THEN 5195 NUMFRD=NUME 5196 GOTO7400 5197 ELSEIF(ICASRE.EQ.'MATZ')THEN 5198C 5199C IMPLEMENT THE "MATRIX TO VARIABLES" CASE. THE 5200C FIRST VARIABLE WILL CONTAIN THE MATRIX VALUES, 5201C THE SECOND VARIABLE WILL CONTAIN THE ROW-ID, AND 5202C THE THIRD VARIABLE WILL CONTAIN THE COLUMN-ID. 5203C 5204 NROWZ=NROWZ+1 5205 NCOLZ=0 5206 IE2=0 5207 IF(NUMDPL.LE.0)GOTO17448 5208 DO17445IE=1,NUMDPL 5209 IE2=IE 5210 Z0=X0(IE) 5211C 5212C COLUMN 1: DATA VALUES 5213C 5214 NCOLZ=NCOLZ+1 5215 ITOTZ=ITOTZ+1 5216C 5217 IF(ITOTZ.GT.MAXN)THEN 5218 WRITE(ICOUT,17481) 521917481 FORMAT('****** ERROR IN DPREAD--READ MATRIX TO ', 5220 1 'VARIABLES') 5221 CALL DPWRST('XXX','BUG ') 5222 WRITE(ICOUT,17482)NROWZ 522317482 FORMAT(' IN ROW ',I10,' OF THE DATA MATRIX,') 5224 CALL DPWRST('XXX','BUG ') 5225 WRITE(ICOUT,17483)MAXN 522617483 FORMAT(' THE MAXIMUM ROW SIZE ',I10, 5227 1 ' EXCEEDED.') 5228 CALL DPWRST('XXX','BUG ') 5229 WRITE(ICOUT,17484) 523017484 FORMAT(' NO ADDITIONAL DATA WILL BE READ.') 5231 CALL DPWRST('XXX','BUG ') 5232 IERROR='YES' 5233 GOTO7490 5234 ENDIF 5235C 5236 ICOLVJ=IECOL2(1) 5237 IJ=MAXN*(ICOLVJ-1)+ITOTZ 5238 IF(ICOLVJ.LE.MAXCOL)V(IJ)=Z0 5239 IF(ICOLVJ.EQ.MAXCP1)PRED(I)=Z0 5240 IF(ICOLVJ.EQ.MAXCP2)RES(I)=Z0 5241 IF(ICOLVJ.EQ.MAXCP3)YPLOT(I)=Z0 5242 IF(ICOLVJ.EQ.MAXCP4)XPLOT(I)=Z0 5243 IF(ICOLVJ.EQ.MAXCP5)X2PLOT(I)=Z0 5244 IF(ICOLVJ.EQ.MAXCP6)TAGPLO(I)=Z0 5245 IEN(1)=ITOTZ 5246C 5247C COLUMN 2: ROW-ID 5248C 5249 Z0=REAL(NROWZ) 5250 ICOLVJ=IECOL2(2) 5251 IJ=MAXN*(ICOLVJ-1)+ITOTZ 5252 IF(ICOLVJ.LE.MAXCOL)V(IJ)=Z0 5253 IF(ICOLVJ.EQ.MAXCP1)PRED(I)=Z0 5254 IF(ICOLVJ.EQ.MAXCP2)RES(I)=Z0 5255 IF(ICOLVJ.EQ.MAXCP3)YPLOT(I)=Z0 5256 IF(ICOLVJ.EQ.MAXCP4)XPLOT(I)=Z0 5257 IF(ICOLVJ.EQ.MAXCP5)X2PLOT(I)=Z0 5258 IF(ICOLVJ.EQ.MAXCP6)TAGPLO(I)=Z0 5259 IEN(2)=ITOTZ 5260C 5261C COLUMN 3: COLUMN-ID 5262C 5263 Z0=REAL(NCOLZ) 5264 ICOLVJ=IECOL2(3) 5265 IJ=MAXN*(ICOLVJ-1)+ITOTZ 5266 IF(ICOLVJ.LE.MAXCOL)V(IJ)=Z0 5267 IF(ICOLVJ.EQ.MAXCP1)PRED(I)=Z0 5268 IF(ICOLVJ.EQ.MAXCP2)RES(I)=Z0 5269 IF(ICOLVJ.EQ.MAXCP3)YPLOT(I)=Z0 5270 IF(ICOLVJ.EQ.MAXCP4)XPLOT(I)=Z0 5271 IF(ICOLVJ.EQ.MAXCP5)X2PLOT(I)=Z0 5272 IF(ICOLVJ.EQ.MAXCP6)TAGPLO(I)=Z0 5273 IEN(3)=ITOTZ 5274C 527517445 CONTINUE 5276 NUMVRD=3 5277 GOTO7400 527817448 CONTINUE 5279 GOTO7490 5280C 5281 ELSEIF(ICASRE.EQ.'IMAZ')THEN 5282C 5283C IMPLEMENT THE "IMAGE TO VARIABLES" CASE. THE 5284C FIRST VARIABLE WILL CONTAIN THE RED COMPONENT, 5285C THE SECOND VARIABLE WILL CONTAIN THE GREEN COMPONENT, 5286C AND THE THIRD VARIABLE WILL CONTAIN THE BLUE COMPONENT. 5287C NOTE THAT ONE ROW OF THE IMAGE IS READ, SO THERE WILL 5288C BE 3*IXSIZE DATA POINTS (NOTE THAT ALL THE RED COMPONENT 5289C VALUES ARE STORED, THEN ALL THE GREEN, THEN ALL THE BLUE). 5290C 5291C IF THREE VARIABLES WERE GIVEN, COLUMN 1 IS THE RED 5292C COMPONENT (I.E., GREY SCALE), COLUMNS 2 IS THE COLUMN-ID, 5293C AND COLUMN 3 IS THE ROW-ID. IF FIVE VARIABLES WERE GIVEN, 5294C COLUMN 1 IS THE RED COMPONENT, COLUMN 2 IS THE GREEN 5295C COMPONENT, COLUMN 3 IS THE BLUE COMPONENT, COLUMN 4 IS THE 5296C COLUMN-ID, AND COLUMN 5 IS THE ROW-ID. 5297C 5298 NROWZ=NROWZ+1 5299 NCOLZ=0 5300 IE2=0 5301 IF(NUMDPL.LE.0)GOTO17548 5302 NLAST=NUMDPL/3 5303 DO17545IE=1,NLAST 5304 IE2=IE 5305 ZR=X0(IE) 5306 ZG=X0(IXSIZE + IE) 5307 ZB=X0(2*IXSIZE + IE) 5308C 5309C COLUMN 1: RED COMPONENT 5310C 5311 NCOLZ=NCOLZ+1 5312 ITOTZ=ITOTZ+1 5313C 5314 IF(ITOTZ.GT.MAXN)THEN 5315 WRITE(ICOUT,17581) 531617581 FORMAT('****** ERROR IN DPREAD--READ IMAGE TO ', 5317 1 'VARIABLES') 5318 CALL DPWRST('XXX','BUG ') 5319 WRITE(ICOUT,17582)NROWZ 532017582 FORMAT(' IN ROW ',I10,' OF THE DATA IMAGE,') 5321 CALL DPWRST('XXX','BUG ') 5322 WRITE(ICOUT,17583)MAXN 532317583 FORMAT(' THE MAXIMUM ROW SIZE ',I10, 5324 1 ' EXCEEDED.') 5325 CALL DPWRST('XXX','BUG ') 5326 WRITE(ICOUT,17584) 532717584 FORMAT(' NO ADDITIONAL DATA WILL BE READ.') 5328 CALL DPWRST('XXX','BUG ') 5329 IERROR='YES' 5330 GOTO7490 5331 ENDIF 5332C 5333C COLUMN 1: RED COMPONENT 5334C 5335 ICOLVJ=IECOL2(1) 5336 IJ=MAXN*(ICOLVJ-1)+ITOTZ 5337 IF(ICOLVJ.LE.MAXCOL)V(IJ)=ZR 5338 IF(ICOLVJ.EQ.MAXCP1)PRED(I)=ZR 5339 IF(ICOLVJ.EQ.MAXCP2)RES(I)=ZR 5340 IF(ICOLVJ.EQ.MAXCP3)YPLOT(I)=ZR 5341 IF(ICOLVJ.EQ.MAXCP4)XPLOT(I)=ZR 5342 IF(ICOLVJ.EQ.MAXCP5)X2PLOT(I)=ZR 5343 IF(ICOLVJ.EQ.MAXCP6)TAGPLO(I)=ZR 5344 IEN(1)=ITOTZ 5345C 5346 IF(NUME.EQ.5)THEN 5347C 5348C COLUMN 2: GREEN COMPONENT 5349C 5350 ICOLVJ=IECOL2(2) 5351 IJ=MAXN*(ICOLVJ-1)+ITOTZ 5352 IF(ICOLVJ.LE.MAXCOL)V(IJ)=ZG 5353 IF(ICOLVJ.EQ.MAXCP1)PRED(I)=ZG 5354 IF(ICOLVJ.EQ.MAXCP2)RES(I)=ZG 5355 IF(ICOLVJ.EQ.MAXCP3)YPLOT(I)=ZG 5356 IF(ICOLVJ.EQ.MAXCP4)XPLOT(I)=ZG 5357 IF(ICOLVJ.EQ.MAXCP5)X2PLOT(I)=ZG 5358 IF(ICOLVJ.EQ.MAXCP6)TAGPLO(I)=ZG 5359 IEN(2)=ITOTZ 5360C 5361C COLUMN 3: BLUE COMPONENT 5362C 5363 ICOLVJ=IECOL2(3) 5364 IJ=MAXN*(ICOLVJ-1)+ITOTZ 5365 IF(ICOLVJ.LE.MAXCOL)V(IJ)=ZB 5366 IF(ICOLVJ.EQ.MAXCP1)PRED(I)=ZB 5367 IF(ICOLVJ.EQ.MAXCP2)RES(I)=ZB 5368 IF(ICOLVJ.EQ.MAXCP3)YPLOT(I)=ZB 5369 IF(ICOLVJ.EQ.MAXCP4)XPLOT(I)=ZB 5370 IF(ICOLVJ.EQ.MAXCP5)X2PLOT(I)=ZB 5371 IF(ICOLVJ.EQ.MAXCP6)TAGPLO(I)=ZB 5372 IEN(3)=ITOTZ 5373C 5374 INEXT=4 5375 ELSE 5376 INEXT=2 5377 ENDIF 5378C 5379C COLUMN 2 OR 4: ROW-ID 5380C 5381 Z0=REAL(NROWZ) 5382 ICOLVJ=IECOL2(INEXT) 5383 IJ=MAXN*(ICOLVJ-1)+ITOTZ 5384 IF(ICOLVJ.LE.MAXCOL)V(IJ)=Z0 5385 IF(ICOLVJ.EQ.MAXCP1)PRED(I)=Z0 5386 IF(ICOLVJ.EQ.MAXCP2)RES(I)=Z0 5387 IF(ICOLVJ.EQ.MAXCP3)YPLOT(I)=Z0 5388 IF(ICOLVJ.EQ.MAXCP4)XPLOT(I)=Z0 5389 IF(ICOLVJ.EQ.MAXCP5)X2PLOT(I)=Z0 5390 IF(ICOLVJ.EQ.MAXCP6)TAGPLO(I)=Z0 5391 IEN(INEXT)=ITOTZ 5392 INEXT=INEXT+1 5393C 5394C COLUMN 3 OR 5: COLUMN-ID 5395C 5396 Z0=REAL(NCOLZ) 5397 ICOLVJ=IECOL2(INEXT) 5398 IJ=MAXN*(ICOLVJ-1)+ITOTZ 5399 IF(ICOLVJ.LE.MAXCOL)V(IJ)=Z0 5400 IF(ICOLVJ.EQ.MAXCP1)PRED(I)=Z0 5401 IF(ICOLVJ.EQ.MAXCP2)RES(I)=Z0 5402 IF(ICOLVJ.EQ.MAXCP3)YPLOT(I)=Z0 5403 IF(ICOLVJ.EQ.MAXCP4)XPLOT(I)=Z0 5404 IF(ICOLVJ.EQ.MAXCP5)X2PLOT(I)=Z0 5405 IF(ICOLVJ.EQ.MAXCP6)TAGPLO(I)=Z0 5406 IEN(INEXT)=ITOTZ 5407C 540817545 CONTINUE 5409 NUMVRD=INEXT 5410 GOTO7400 541117548 CONTINUE 5412 GOTO7490 5413C 5414 ELSEIF(ICASRE.EQ.'STAC')THEN 5415C 5416C IMPLEMENT THE "STACK VARIABLES" CASE. THE 5417C FIRST VARIABLE WILL CONTAIN THE RESPONSE VALUES 5418C AND THE SECOND VARIABLE WILL CONTAIN A GROUP-ID 5419C VARIABLE. 5420C 5421 NROWZ=NROWZ+1 5422 NCOLZ=0 5423 IE2=0 5424 IF(NUMDPL.LE.0)GOTO18448 5425 DO18445IE=1,NUMDPL 5426 IE2=IE 5427 Z0=X0(IE) 5428C 5429C COLUMN 1: DATA VALUES 5430C 5431 NCOLZ=NCOLZ+1 5432 ITOTZ=ITOTZ+1 5433C 5434 IF(ITOTZ.GT.MAXN)THEN 5435 WRITE(ICOUT,18481) 543618481 FORMAT('****** ERROR IN DPREAD--READ STACK ', 5437 1 'VARIABLES') 5438 CALL DPWRST('XXX','BUG ') 5439 WRITE(ICOUT,18482)NROWZ 544018482 FORMAT(' IN ROW ',I10,' OF THE DATA MATRIX,') 5441 CALL DPWRST('XXX','BUG ') 5442 WRITE(ICOUT,18483)MAXN 544318483 FORMAT(' THE MAXIMUM ROW SIZE ',I10, 5444 1 ' EXCEEDED.') 5445 CALL DPWRST('XXX','BUG ') 5446 WRITE(ICOUT,18484) 544718484 FORMAT(' NO ADDITIONAL DATA WILL BE READ.') 5448 CALL DPWRST('XXX','BUG ') 5449 IERROR='YES' 5450 GOTO7490 5451 ENDIF 5452C 5453 ICOLVJ=IECOL2(1) 5454 IJ=MAXN*(ICOLVJ-1)+ITOTZ 5455 IF(ICOLVJ.LE.MAXCOL)V(IJ)=Z0 5456 IF(ICOLVJ.EQ.MAXCP1)PRED(I)=Z0 5457 IF(ICOLVJ.EQ.MAXCP2)RES(I)=Z0 5458 IF(ICOLVJ.EQ.MAXCP3)YPLOT(I)=Z0 5459 IF(ICOLVJ.EQ.MAXCP4)XPLOT(I)=Z0 5460 IF(ICOLVJ.EQ.MAXCP5)X2PLOT(I)=Z0 5461 IF(ICOLVJ.EQ.MAXCP6)TAGPLO(I)=Z0 5462 IEN(1)=ITOTZ 5463C 5464C COLUMN 2: GROUP-ID 5465C 5466 Z0=REAL(NCOLZ) 5467 ICOLVJ=IECOL2(2) 5468 IJ=MAXN*(ICOLVJ-1)+ITOTZ 5469 IF(ICOLVJ.LE.MAXCOL)V(IJ)=Z0 5470 IF(ICOLVJ.EQ.MAXCP1)PRED(I)=Z0 5471 IF(ICOLVJ.EQ.MAXCP2)RES(I)=Z0 5472 IF(ICOLVJ.EQ.MAXCP3)YPLOT(I)=Z0 5473 IF(ICOLVJ.EQ.MAXCP4)XPLOT(I)=Z0 5474 IF(ICOLVJ.EQ.MAXCP5)X2PLOT(I)=Z0 5475 IF(ICOLVJ.EQ.MAXCP6)TAGPLO(I)=Z0 5476 IEN(2)=ITOTZ 5477C 547818445 CONTINUE 5479 NUMVRD=2 5480 GOTO7400 548118448 CONTINUE 5482 GOTO7490 5483C 5484 ELSEIF(ICASRE.EQ.'MATR')THEN 5485C 5486C -----BEGIN MATRIX COPY----- 5487C IHMAT1 = FIRST HALF OF MATRIX NAME 5488C IHMAT2 = SECOND HALF OF MATRIX NAME 5489C INAMMA = NAME INDEX FOR MATRIX 5490C IMATC1 = FIRST COLUMN OF THE MATRIX 5491C IMATNR = NUMBER OF ROWS IN THE MATRIX 5492C IMATNC = NUMBER OF COLUMNS IN THE NATRIX 5493C 5494 IF(NUMLRD.EQ.1)THEN 5495C 5496 INAM=NUMNAM 5497 ICOL=NUMCOL 5498C 5499 INAM=INAM+1 5500 ICOL=ICOL+1 5501C 5502 INAMMA=INAM 5503 IMATC1=ICOL 5504C 5505 IHNAME(INAMMA)=IHMAT1 5506 IHNAM2(INAMMA)=IHMAT2 5507 IUSE(INAMMA)='M' 5508 IVALUE(INAMMA)=ICOL 5509 IN(INAMMA)=0 5510 IVALU2(INAMMA)=ICOL+NUMDPL-1 5511 IMATNC=NUMDPL 5512 NUMNAM=INAM 5513 NUMCOL=ICOL 5514C 5515 ICOL=ICOL-1 5516 IF(NUMDPL.GT.0)THEN 5517 DO7452IE=1,NUMDPL 5518 INAM=INAM+1 5519 ICOL=ICOL+1 5520 IHNAME(INAM)=JENAM1(IE) 5521 IHNAM2(INAM)=JENAM2(IE) 5522 IUSE(INAM)='V' 5523 IVALUE(INAM)=ICOL 5524 IN(INAM)=0 5525 IECOL2(IE)=ICOL 5526 IF(IBUGS2.EQ.'ON')THEN 5527 WRITE(ICOUT,7453)IE,IECOL2(IE),NUMDPL,INAM,NUMNAM 5528 7453 FORMAT('IE,IECOL2(IE),NUMDPL,INAM,NUMNAM = ',5I8) 5529 CALL DPWRST('XXX','BUG ') 5530 ENDIF 5531 7452 CONTINUE 5532 NUMNAM=INAM 5533 NUMCOL=ICOL 5534 ENDIF 5535 ENDIF 5536C 5537 IE2=0 5538 IMATNR=0 5539 IF(NUMDPL.GT.0)THEN 5540 DO7455IE=1,NUMDPL 5541 IE2=IE 5542 Z0=X0(IE) 5543 IF(IBUGS2.EQ.'ON')THEN 5544 WRITE(ICOUT,7456)IE,IECOL2(IE),NUMDPL,INAM,NUMNAM 5545 7456 FORMAT('IE,IECOL2(IE),NUMDPL,INAM,NUMNAM = ',5I8) 5546 CALL DPWRST('XXX','BUG ') 5547 ENDIF 5548 ICOLVJ=IECOL2(IE) 5549 IJ=MAXN*(ICOLVJ-1)+I 5550 IF(ICOLVJ.LE.MAXCOL)V(IJ)=Z0 5551 IF(ICOLVJ.EQ.MAXCP1)PRED(I)=Z0 5552 IF(ICOLVJ.EQ.MAXCP2)RES(I)=Z0 5553 IF(ICOLVJ.EQ.MAXCP3)YPLOT(I)=Z0 5554 IF(ICOLVJ.EQ.MAXCP4)XPLOT(I)=Z0 5555 IF(ICOLVJ.EQ.MAXCP5)X2PLOT(I)=Z0 5556 IF(ICOLVJ.EQ.MAXCP6)TAGPLO(I)=Z0 5557 IEN(IE)=I 5558 IN(INAM)=I 5559 IN(INAMMA)=I 5560 IMATNR=I 5561 7455 CONTINUE 5562 NUMVRD=IE2 5563 GOTO7400 5564 ENDIF 5565 NUMVRD=IE2-1 5566 GOTO7400 5567C 5568C -----END MATRIX COPY----- 5569C 5570 ELSEIF(ICASRE.EQ.'IMAG')THEN 5571C 5572C IMAGE TO MATRIX (NOTE: CURRENTLY ONLY ONE COMPONENT 5573C AT A TIME CAN BE READ, SO NEED TO DO SOMETHING LIKE 5574C 5575C READ IMAGE RED FILE.DAT RED 5576C READ IMAGE GREEN FILE.DAT GREEN 5577C READ IMAGE BLUE FILE.DAT BLUE 5578C 5579C IN ORDER TO READ ALL COMPONENTS INTO SEPARATE MATRICES. 5580C 5581C -----BEGIN MATRIX COPY----- 5582C IHMAT1 = FIRST HALF OF MATRIX NAME 5583C IHMAT2 = SECOND HALF OF MATRIX NAME 5584C INAMMA = NAME INDEX FOR MATRIX 5585C IMATC1 = FIRST COLUMN OF THE MATRIX 5586C IMATNR = NUMBER OF ROWS IN THE MATRIX 5587C IMATNC = NUMBER OF COLUMNS IN THE NATRIX 5588C 5589 IF(NUMLRD.EQ.1)THEN 5590C 5591 NUMDPL=NUMDPL/3 5592C 5593 INAM=NUMNAM 5594 ICOL=NUMCOL 5595C 5596 INAM=INAM+1 5597 ICOL=ICOL+1 5598C 5599 INAMMA=INAM 5600 IMATC1=ICOL 5601C 5602 IHNAME(INAMMA)=IHMAT1 5603 IHNAM2(INAMMA)=IHMAT2 5604 IUSE(INAMMA)='M' 5605 IVALUE(INAMMA)=ICOL 5606 IN(INAMMA)=0 5607 IVALU2(INAMMA)=ICOL+NUMDPL-1 5608 IMATNC=NUMDPL 5609 NUMNAM=INAM 5610 NUMCOL=ICOL 5611C 5612 ICOL=ICOL-1 5613 IF(NUMDPL.GT.0)THEN 5614 DO7552IE=1,NUMDPL 5615 INAM=INAM+1 5616 ICOL=ICOL+1 5617 IHNAME(INAM)=JENAM1(IE) 5618 IHNAM2(INAM)=JENAM2(IE) 5619 IUSE(INAM)='V' 5620 IVALUE(INAM)=ICOL 5621 IN(INAM)=0 5622 IECOL2(IE)=ICOL 5623 IF(IBUGS2.EQ.'ON')THEN 5624 WRITE(ICOUT,7553)IE,IECOL2(IE),NUMDPL,INAM,NUMNAM 5625 7553 FORMAT('IE,IECOL2(IE),NUMDPL,INAM,NUMNAM = ',5I8) 5626 CALL DPWRST('XXX','BUG ') 5627 ENDIF 5628 7552 CONTINUE 5629 NUMNAM=INAM 5630 NUMCOL=ICOL 5631 ENDIF 5632 ENDIF 5633C 5634 IE2=0 5635 IMATNR=0 5636 IF(NUMDPL.GT.0)THEN 5637 DO7555IE=1,NUMDPL 5638 IE2=IE 5639 IF(IMAGCO.EQ.1)THEN 5640 Z0=X0(IE) 5641 ELSEIF(IMAGCO.EQ.2)THEN 5642 Z0=X0(IXSIZE + IE) 5643 ELSEIF(IMAGCO.EQ.3)THEN 5644 Z0=X0(2*IXSIZE + IE) 5645 ENDIF 5646 IF(IBUGS2.EQ.'ON')THEN 5647 WRITE(ICOUT,7556)IE,IECOL2(IE),NUMDPL,INAM,NUMNAM 5648 7556 FORMAT('IE,IECOL2(IE),NUMDPL,INAM,NUMNAM = ',5I8) 5649 CALL DPWRST('XXX','BUG ') 5650 ENDIF 5651 ICOLVJ=IECOL2(IE) 5652 IJ=MAXN*(ICOLVJ-1)+I 5653 IF(ICOLVJ.LE.MAXCOL)V(IJ)=Z0 5654 IF(ICOLVJ.EQ.MAXCP1)PRED(I)=Z0 5655 IF(ICOLVJ.EQ.MAXCP2)RES(I)=Z0 5656 IF(ICOLVJ.EQ.MAXCP3)YPLOT(I)=Z0 5657 IF(ICOLVJ.EQ.MAXCP4)XPLOT(I)=Z0 5658 IF(ICOLVJ.EQ.MAXCP5)X2PLOT(I)=Z0 5659 IF(ICOLVJ.EQ.MAXCP6)TAGPLO(I)=Z0 5660 IEN(IE)=I 5661 IN(INAM)=I 5662 IN(INAMMA)=I 5663 IMATNR=I 5664 7555 CONTINUE 5665 NUMVRD=IE2 5666 GOTO7400 5667 ENDIF 5668 NUMVRD=IE2-1 5669 GOTO7400 5670C 5671 ELSEIF(ICASRE.EQ.'ROWI')THEN 5672 IF(I.GT.MAXN)GOTO7480 5673 IROWLB(I)=' ' 5674 IF(ISUB(I).NE.1)GOTO7400 5675 ILEN=24 5676 IF(N2.LT.ILEN)ILEN=N2 5677 DO7442KK=1,ILEN 5678 IROWLB(I)(KK:KK)=IFUNC2(KK)(1:1) 56797442 CONTINUE 5680 GOTO7400 5681 ENDIF 5682C 5683C OCTOBER 2004. IF NUMBER OF REQUESTED ITEMS IS GREATER THAN 5684C NUMBER OF ITEMS ON THE LINE, PAD WITH MISSING 5685C VALUE (PREAMV). 5686C 5687C THE SET READ PAD MISSING COLUMNS COMMANDS 5688C DETERMINES WHETHER WE PAD OR USE THE PREVIOUS 5689C BEHAVIOR (I.E., IN SOME CASES, A MISSING COLUMN 5690C MAY INDICATE AN ERROR). 5691C 5692 IE2=0 5693 IF(NUME.LE.0)THEN 5694 NUMVRD=IE2-1 5695 GOTO7450 5696 ENDIF 5697 DO7445IE=1,NUME 5698C 5699 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')THEN 5700 WRITE(ICOUT,7404)NUMDPL,IE,IREAPD 5701 7404 FORMAT('AT 7445: NUMDPL,IE,IREAPD = ',2I8,2X,A4) 5702 CALL DPWRST('XXX','BUG ') 5703 ENDIF 5704C 5705 IE2=IE 5706 IF(IREAPD.EQ.'OFF')THEN 5707 IF(IE2.GT.NUMDPL)THEN 5708 NUMVRD=NUMDPL 5709 WRITE(ICOUT,7446)IFROW,NUME,NUMDPL 5710 7446 FORMAT('****** WARNING AT LINE ',I10,': ',I5, 5711 1 ' VALUES READ, BUT ',I5,' VALUES WERE EXPECTED.') 5712 CALL DPWRST('XXX','BUG ') 5713CCCCC GOTO7450 5714 Z0=PREAMV 5715 ELSE 5716 Z0=X0(IE) 5717 ENDIF 5718 ELSE 5719 IF(IE2.GT.NUMDPL)THEN 5720 Z0=PREAMV 5721 ELSE 5722 Z0=X0(IE) 5723 ENDIF 5724 ENDIF 5725 ICOLVJ=IECOL2(IE) 5726 IJ=MAXN*(ICOLVJ-1)+I 5727C 5728 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')THEN 5729 WRITE(ICOUT,7406)ICOLVJ,IJ,Z0 5730 7406 FORMAT('AT 7445: ICOLVJ,IJ,Z0 = ',2I8,G15.7) 5731 CALL DPWRST('XXX','BUG ') 5732 ENDIF 5733C 5734 IF(ICOLVJ.LE.MAXCOL)V(IJ)=Z0 5735 IF(ICOLVJ.EQ.MAXCP1)PRED(I)=Z0 5736 IF(ICOLVJ.EQ.MAXCP2)RES(I)=Z0 5737 IF(ICOLVJ.EQ.MAXCP3)YPLOT(I)=Z0 5738 IF(ICOLVJ.EQ.MAXCP4)XPLOT(I)=Z0 5739 IF(ICOLVJ.EQ.MAXCP5)X2PLOT(I)=Z0 5740 IF(ICOLVJ.EQ.MAXCP6)TAGPLO(I)=Z0 5741 IEN(IE)=I 5742 7445 CONTINUE 5743 NUMVRD=IE2 5744C 5745C 2018/07: IF REQUESED, SAVE CHARACTER DATA AS CATEGORICAL NUMERIC 5746C DATA 5747C 5748 7450 CONTINUE 5749 IF(IGRPAU.EQ.'CATE' .AND. NXC.GT.0)THEN 5750 DO7558IE=1,NXC 5751 IF(IE.NE.IRWLC3)THEN 5752 Z0=X0CAT(IE) 5753 ICOLVJ=IECOLC(IE) 5754 IJ=MAXN*(ICOLVJ-1)+I 5755 IF(ICOLVJ.LE.MAXCOL)V(IJ)=Z0 5756 IF(ICOLVJ.EQ.MAXCP1)PRED(I)=Z0 5757 IF(ICOLVJ.EQ.MAXCP2)RES(I)=Z0 5758 IF(ICOLVJ.EQ.MAXCP3)YPLOT(I)=Z0 5759 IF(ICOLVJ.EQ.MAXCP4)XPLOT(I)=Z0 5760 IF(ICOLVJ.EQ.MAXCP5)X2PLOT(I)=Z0 5761 IF(ICOLVJ.EQ.MAXCP6)TAGPLO(I)=Z0 5762 IENC(IE)=I 5763 ELSE 5764 IROWLB(I)=IXC(IE)(1:24) 5765 ENDIF 5766 7558 CONTINUE 5767 ELSEIF(IGRPAU.EQ.'CHAR' .AND. IRWLC3.GT.0)THEN 5768 IROWLB(I)=IXC(IRWLC3)(1:24) 5769 ENDIF 5770C 5771 7400 CONTINUE 5772 7470 CONTINUE 5773 IENDTY=2 5774 GOTO7490 5775C 5776 7480 CONTINUE 5777C 5778 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')THEN 5779 WRITE(ICOUT,7481)NUME 5780 7481 FORMAT('AT 7480: ERROR OR END OF FILE FOR FORMATTED READ, ', 5781 1 'NUME = ',I8,'.') 5782 CALL DPWRST('XXX','BUG ') 5783 DO7485K=1,NUME 5784 WRITE(ICOUT,7487)K,X0(K) 5785 7487 FORMAT('K, X0(K) = ',I8,2X,G15.7) 5786 CALL DPWRST('XXX','BUG ') 5787 7485 CONTINUE 5788 ENDIF 5789C 5790 IENDTY=1 5791 NUMLRD=NUMLRD-1 5792 GOTO7490 5793C 5794 7490 CONTINUE 5795C 5796C ***************************** 5797C ** STEP 11-- ** 5798C ** UPDATE THE NAME TABLE ** 5799C ***************************** 5800C 5801 ISTEPN='11' 5802 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ') 5803 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) 5804C 5805 IF(ICASRE.EQ.'PARA')THEN 5806 ISTEPN='7700' 5807 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ') 5808 1 CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) 5809 IF(NUMPRD.GT.0)THEN 5810 DO7710IE=1,NUMPRD 5811 IH1=JENAM1(IE) 5812 IH2=JENAM2(IE) 5813 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')THEN 5814 WRITE(ICOUT,7711)IE,JENAM1(IE),JENAM2(IE),X0(IE) 5815 7711 FORMAT('IE,JENAM1(IE),JENAM2(IE),X0(IE) = ', 5816 1 I8,2X,2A4,E15.7) 5817 CALL DPWRST('XXX','BUG ') 5818 ENDIF 5819 DO7720J=1,NUMNAM 5820 IF(IUSE(J).EQ.'P'.AND. 5821 1 IHNAME(J).EQ.IH1.AND.IHNAM2(J).EQ.IH2)THEN 5822 IECOL2(IE)=J 5823 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')THEN 5824 WRITE(ICOUT,7731)IE,J,IECOL2(IE),X0(IE) 5825 7731 FORMAT('IE,J,IECOL2(IE),X0(IE) = ',3I8,E15.7) 5826 CALL DPWRST('XXX','BUG ') 5827 ENDIF 5828 VALUE(J)=X0(IE) 5829 IVALUE(J)=INT(VALUE(J)) 5830CCCCC FOLLOWING LINE ADDED SO THAT DELETE AND RETAIN WILL NOT 5831CCCCC DELETE PARAMETER CREATED VIA READ PARAMETER. MARCH 1994. 5832 IN(J)=1 5833 ENDIF 5834 7720 CONTINUE 5835 7710 CONTINUE 5836 ENDIF 5837 GOTO7900 5838 ELSEIF(ICASRE.EQ.'FUNC')THEN 5839C 5840 ISTEPN='7800' 5841 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ') 5842 1 CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) 5843C 5844 IF(NUMFRD.GT.0)THEN 5845 CALL DPUPPE(IFUNC2,N2,IFUNC3,IBUGS2,IERROR) 5846 ISTART=IFCOL1 5847 ISTOP=N2 5848 DO7810IE=1,NUMFRD 5849 IH1=JENAM1(IE) 5850 IH2=JENAM2(IE) 5851 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')THEN 5852 WRITE(ICOUT,7811)IE,JENAM1(IE),JENAM2(IE),IECASE(IE) 5853 7811 FORMAT('IE,JENAM1(IE),JENAM2(IE),IECASE(IE) = ', 5854 1 I8,2X,2A4,2X,A4) 5855 CALL DPWRST('XXX','BUG ') 5856 ENDIF 5857 DO7820J=1,NUMNAM 5858 IF(IUSE(J).EQ.'F'.AND. 5859 1 IHNAME(J).EQ.IH1.AND.IHNAM2(J).EQ.IH2)THEN 5860 IECOL2(IE)=J 5861 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')THEN 5862 WRITE(ICOUT,7826)IE,J 5863 7826 FORMAT('IE,J = ',2I8) 5864 CALL DPWRST('XXX','BUG ') 5865 ENDIF 5866 IHLEFT=IH1 5867 IHLEF2=IH2 5868 NEWNAM='NO' 5869 IF(IECASE(IE).EQ.'NEW')NEWNAM='YES' 5870 ILISTL=J 5871C 5872 IF(NUMFRD.EQ.1)THEN 5873 IF(N2.LE.0)GOTO7832 5874 ICOL1=1 5875 ICOL2=N2 5876 IF(ICOL2.GT.ICOL1+N2-1)ICOL2=ICOL1+N2-1 5877 I2=0 5878 DO7831I=ICOL1,ICOL2 5879 I2=I2+1 5880 IFUNC3(I2)=IFUNC2(I2) 5881 7831 CONTINUE 5882 7832 CONTINUE 5883 N3=I2 5884C 5885 ELSE 5886 IWORD=IE 5887 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')THEN 5888 WRITE(ICOUT,7841)ICOL1,ICOL2,ISTART,ISTOP,N2,N3, 5889 1 IE,IWORD 5890 7841 FORMAT('ICOL1,ICOL2,ISTART,ISTOP,N2,N3,IE,IWORD = ', 5891 1 8I8) 5892 CALL DPWRST('XXX','BUG ') 5893 ENDIF 5894 CALL DPEXW2(IFUNC2,N2,ISTART,ISTOP,IWORD, 5895 1 ICOL1,ICOL2,IFUNC3,N3, 5896 1 IBUGS2,ISUBRO,IERROR) 5897 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')THEN 5898 WRITE(ICOUT,7841)ICOL1,ICOL2,ISTART,ISTOP,N2,N3, 5899 1 IE,IWORD 5900 CALL DPWRST('XXX','BUG ') 5901 ENDIF 5902 ENDIF 5903C 5904 CALL DPINFU(IFUNC3,N3,IHNAME,IHNAM2,IUSE,IN, 5905 1 IVSTAR,IVSTOP, 5906 1 NUMNAM,IANSLC,IWIDTH,IHLEFT,IHLEF2,ILISTL, 5907 1 NEWNAM,MAXNME, 5908 1 IFUNC,NUMCHF,MAXCHF,IBUGS2,IERROR) 5909C 5910 IF(NEWNAM.EQ.'YES'.AND.IERROR.EQ.'NO')NUMNAM=NUMNAM-1 5911C 5912 ENDIF 5913 7820 CONTINUE 5914 7810 CONTINUE 5915 ENDIF 5916 GOTO7900 5917C 5918 ELSEIF(ICASRE.EQ.'ROWI')THEN 5919 GOTO7900 5920 ELSE 5921C 5922 ISTEPN='7600' 5923 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')THEN 5924 CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) 5925 WRITE(ICOUT,7601)ICASRE,NUMVRD,NUMNAM,NUME,NXC 5926 7601 FORMAT('ICASRE,NUMVRD,NUMNAM,NUME,NXC = ',A4,4I8) 5927 CALL DPWRST('XXX','BUG ') 5928 ENDIF 5929C 5930C UPDATE NUMERIC VARIABLES 5931C 5932 IF(NUMVRD.GT.0)THEN 5933 DO7610IE=1,NUMVRD 5934 N=IEN(IE) 5935 ICOLVJ=IECOL2(IE) 5936 DO7620J=1,NUMNAM 5937 IF(IUSE(J).EQ.'V'.AND.IVALUE(J).EQ.ICOLVJ)THEN 5938 IUSE(J)='V' 5939 IVALUE(J)=ICOLVJ 5940 IF(N.GT.IN(J))IN(J)=N 5941 IVSTAR(J)=MAXN*(ICOLVJ-1)+1 5942 IVSTOP(J)=MAXN*(ICOLVJ-1)+N 5943 ENDIF 5944 7620 CONTINUE 5945 7610 CONTINUE 5946 ENDIF 5947C 5948 NUMVRP=NUMVRD+1 5949 IF(ICASRE.EQ.'MATR')GOTO7690 5950 IF(NUMVRP.GT.NUME)GOTO7690 5951 DO7650IE=NUMVRP,NUME 5952 IEREV=NUME-IE+NUMVRP 5953 IF(IECASE(IEREV).EQ.'NEW')THEN 5954 INAM=NUMNAM 5955 IHNAME(INAM)=' ' 5956 IHNAM2(INAM)=' ' 5957 IUSE(INAM)=' ' 5958 IVALUE(INAM)=0 5959 IN(INAM)=0 5960 NUMNAM=NUMNAM-1 5961 NUMCOL=NUMCOL-1 5962 ENDIF 5963 7650 CONTINUE 5964 7690 CONTINUE 5965C 5966C UPDATE CHARACTER VARIABLES CONVERTED TO CATEGORICAL VARIABLES 5967C 5968 IF(IGRPAU.EQ.'CATE' .AND. NXCSAV.GE.1)THEN 5969 DO77610IE=1,NXCSAV 5970 IF(IRWLC3.EQ.IE)GOTO77610 5971 N=IENC(IE) 5972 ICOLVJ=IECOLC(IE) 5973 DO77620J=1,NUMNAM 5974 IF(IUSE(J).EQ.'V'.AND.IVALUE(J).EQ.ICOLVJ)THEN 5975 IUSE(J)='V' 5976 IVALUE(J)=ICOLVJ 5977 IF(N.GT.IN(J))IN(J)=N 5978 IVSTAR(J)=MAXN*(ICOLVJ-1)+1 5979 IVSTOP(J)=MAXN*(ICOLVJ-1)+N 5980 ENDIF 598177620 CONTINUE 598277610 CONTINUE 5983 ENDIF 5984C 5985 GOTO7900 5986 ENDIF 5987C 5988 7900 CONTINUE 5989C 5990C ************************************* 5991C ** STEP 12-- ** 5992C ** WRITE OUT SUMMARY INFORMATION ** 5993C ** ABOUT THE FILE THAT WAS READ ** 5994C ************************************* 5995C 5996 ISTEPN='12' 5997 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ') 5998 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) 5999C 6000C 2014/10: SAVE FOLLOWING AS INTERNAL PARAMETERS: 6001C 6002C 1) ISKIP = NUMBER OF HEADER LINES SKIPPED 6003C 2) NUMLRD = NUMBER OF LINES READ 6004C 3) NUMVRD = NUMBER OF VARIABLES READ 6005C 6006C WRITE INDIVIDUAL VARIABLE NAMES TO: ZZZV1 - ZZZVK 6007C 6008 IH1='ISKI' 6009 IH2='P ' 6010 VALUE0=REAL(ISKIP) 6011 CALL DPADDP(IH1,IH2,VALUE0,IHOST1,ISUBN0, 6012 1 IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM, 6013 1 IANS,IWIDTH,IBUGS2,IERROR) 6014C 6015 IH1='NUML' 6016 IH2='RD ' 6017 VALUE0=REAL(NUMLRD) 6018 CALL DPADDP(IH1,IH2,VALUE0,IHOST1,ISUBN0, 6019 1 IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM, 6020 1 IANS,IWIDTH,IBUGS2,IERROR) 6021C 6022 IH1='NUMV' 6023 IH2='RD ' 6024 VALUE0=REAL(NUMVRD) 6025 CALL DPADDP(IH1,IH2,VALUE0,IHOST1,ISUBN0, 6026 1 IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM, 6027 1 IANS,IWIDTH,IBUGS2,IERROR) 6028C 6029 IF(NUMVRD.GT.0)THEN 6030 DO12001II=1,NUMVRD 6031 IH1='ZZZV' 6032 IH2=' ' 6033 IF(II.LE.9)THEN 6034 WRITE(IH2(1:1),'(I1)')II 6035 ELSEIF(II.LE.99)THEN 6036 WRITE(IH2(1:2),'(I2)')II 6037 ELSEIF(II.LE.999)THEN 6038 WRITE(IH2(1:3),'(I3)')II 6039 ELSEIF(II.LE.9999)THEN 6040 WRITE(IH2(1:4),'(I4)')II 6041 ELSE 6042 GOTO12001 6043 ENDIF 6044C 6045 DO12003JJ=1,8 6046 ISTRZ2(JJ)=' ' 604712003 CONTINUE 6048 ISTRZ2(1)(1:1)=JENAM1(II)(1:1) 6049 ISTRZ2(2)(1:1)=JENAM1(II)(2:2) 6050 ISTRZ2(3)(1:1)=JENAM1(II)(3:3) 6051 ISTRZ2(4)(1:1)=JENAM1(II)(4:4) 6052 ISTRZ2(5)(1:1)=JENAM2(II)(1:1) 6053 ISTRZ2(6)(1:1)=JENAM2(II)(2:2) 6054 ISTRZ2(7)(1:1)=JENAM2(II)(3:3) 6055 ISTRZ2(8)(1:1)=JENAM2(II)(4:4) 6056 NCHART=1 6057 DO12005JJ=8,1,-1 6058 IF(ISTRZ2(JJ)(1:1).NE.' ')THEN 6059 NCHART=JJ 6060 GOTO12009 6061 ENDIF 606212005 CONTINUE 606312009 CONTINUE 6064C 6065 NEWNAM='YES' 6066 DO12011JJ=1,NUMNAM 6067 IF(IH1.EQ.IHNAME(JJ) .AND. IH2.EQ.IHNAM2(JJ))THEN 6068 NEWNAM='OLD' 6069 ILISTL=JJ 6070 GOTO12019 6071 ENDIF 607212011 CONTINUE 607312019 CONTINUE 6074 IF(NEWNAM.EQ.'YES')ILISTL=NUMNAM+1 6075 CALL DPINFU(ISTRZ2,NCHART,IHNAME,IHNAM2,IUSE,IN, 6076 1 IVSTAR,IVSTOP, 6077 1 NUMNAM,IANS,IWIDTH,IH1,IH2,ILISTL, 6078 1 NEWNAM,MAXNME, 6079 1 IFUNC,NUMCHF,MAXCHF,IBUGS2,IERROR) 6080C 608112001 CONTINUE 6082 ENDIF 6083C 6084 IF(IFEEDB.EQ.'ON')THEN 6085 WRITE(ICOUT,999) 6086 CALL DPWRST('XXX','BUG ') 6087 WRITE(ICOUT,8000) 6088 8000 FORMAT('INPUT DATA FILE SUMMARY INFORMATION--') 6089 CALL DPWRST('XXX','BUG ') 6090 WRITE(ICOUT,8001)IRD2 6091 8001 FORMAT('INPUT UNIT DEVICE NUMBER = ',I8) 6092 CALL DPWRST('XXX','BUG ') 6093 WRITE(ICOUT,8002)IFCOL3,IFCOL4 6094 8002 FORMAT('INPUT FILE COLUMN LIMITS = ',I8,4X,I8) 6095 CALL DPWRST('XXX','BUG ') 6096 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')THEN 6097 WRITE(ICOUT,1111)AFROW2 6098 1111 FORMAT('AFROW2 = ',E15.7) 6099 CALL DPWRST('XXX','BUG ') 6100 ENDIF 6101 IF(IFROW2.EQ.INTINF)THEN 6102 WRITE(ICOUT,8003)IFROW1 6103 8003 FORMAT('INPUT FILE ROW LIMITS = ',I8,4X,'INFINITY') 6104 CALL DPWRST('XXX','BUG ') 6105 ELSEIF(IFROW2.NE.INTINF)THEN 6106 WRITE(ICOUT,8004)IFROW1,IFROW2 6107 8004 FORMAT('INPUT FILE ROW LIMITS = ',I8,4X,I8) 6108 CALL DPWRST('XXX','BUG ') 6109 ENDIF 6110 WRITE(ICOUT,8005)ISKIP 6111 8005 FORMAT('NUMBER OF HEADER LINES SKIPPED = ',I8) 6112 CALL DPWRST('XXX','BUG ') 6113 WRITE(ICOUT,8006)NUMLRD 6114 8006 FORMAT('NUMBER OF DATA LINES READ = ',I8) 6115 CALL DPWRST('XXX','BUG ') 6116 IF(NUMVRD.GE.1)THEN 6117 WRITE(ICOUT,8007)NUMVRD 6118 8007 FORMAT('NUMBER OF VARIABLES READ = ',I8) 6119 CALL DPWRST('XXX','BUG ') 6120 ENDIF 6121 IF(NUMPRD.GE.1)THEN 6122 WRITE(ICOUT,8008)NUMPRD 6123 8008 FORMAT('NUMBER OF PARAMETERS READ = ',I8) 6124 CALL DPWRST('XXX','BUG ') 6125 ENDIF 6126 IF(NUMFRD.GE.1)THEN 6127 WRITE(ICOUT,8009)NUMFRD 6128 8009 FORMAT('NUMBER OF FUNCTIONS/STRINGS READ = ',I8) 6129 CALL DPWRST('XXX','BUG ') 6130 ENDIF 6131 IF(NCREAF.LE.0)THEN 6132C 6133 IFRST=IFCOL3 6134 IF(IFRST+240-1.GE.IFCOL4)THEN 6135 ILAST=IFCOL4 6136 ELSE 6137 ILAST=IFRST+240-1 6138 ENDIF 6139C 6140 IF(ICASRE.NE.'CLIP')THEN 6141 WRITE(ICOUT,8011) 6142 8011 FORMAT('THE SCANNED REGION OF THE FIRST DATA LINE READ ', 6143 1 '(TO A MAXIMUM OF 240 CHARACTERS) = ') 6144 CALL DPWRST('XXX','BUG ') 6145 WRITE(ICOUT,8012)(ISTOR3(J),J=IFRST,MIN(240,ILAST)) 6146 8012 FORMAT(240A1) 6147 CALL DPWRST('XXX','BUG ') 6148 WRITE(ICOUT,8013) 6149 8013 FORMAT('THE SCANNED REGION OF THE LAST DATA LINE READ ', 6150 1 '(TO A MAXIMUM OF 240 CHARACTERS) = ') 6151 CALL DPWRST('XXX','BUG ') 6152 IF(IENDTY.EQ.1)THEN 6153 WRITE(ICOUT,8014)(ISTOR1(J),J=IFRST,MIN(240,ILAST)) 6154 CALL DPWRST('XXX','BUG ') 6155 ELSEIF(IENDTY.EQ.2)THEN 6156 WRITE(ICOUT,8014)(ISTOR2(J),J=IFRST,MIN(240,ILAST)) 6157 8014 FORMAT(240A1) 6158 CALL DPWRST('XXX','BUG ') 6159 ENDIF 6160 ENDIF 6161 ENDIF 6162 ENDIF 6163C 6164C ********************************************* 6165C ** STEP 13-- ** 6166C ** PRINT OUT SUMMARY INFORMATION ** 6167C ** VARIABLES/PARAMETERS/FUNCTIONS ** 6168C ** THAT WERE READ IN. ** 6169C ********************************************* 6170C 6171 IF(ICASRE.EQ.'PARA')THEN 6172 IF(IFEEDB.EQ.'ON')THEN 6173 WRITE(ICOUT,999) 6174 CALL DPWRST('XXX','BUG ') 6175 WRITE(ICOUT,8201) 6176 8201 FORMAT('PARAMETER VALUE') 6177 CALL DPWRST('XXX','BUG ') 6178C 6179 DO8210IE=1,NUME 6180 IH1=JENAM1(IE) 6181 IH2=JENAM2(IE) 6182 DO8220I=1,NUMNAM 6183 I2=I 6184 IF(IH1.EQ.IHNAME(I).AND.IH2.EQ.IHNAM2(I))THEN 6185 WRITE(ICOUT,8226)IH1,IH2,VALUE(I2) 6186 8226 FORMAT(A4,A4,4X,E15.7) 6187 CALL DPWRST('XXX','BUG ') 6188 ENDIF 6189 8220 CONTINUE 6190 8210 CONTINUE 6191 ENDIF 6192C 6193 ELSEIF(ICASRE.EQ.'FUNC' .OR. ICASRE.EQ.'CFUN')THEN 6194 IF(IFEEDB.EQ.'ON')THEN 6195 WRITE(ICOUT,999) 6196 CALL DPWRST('XXX','BUG ') 6197 WRITE(ICOUT,8301) 6198 8301 FORMAT('FUNCTION (= STRING) CONTENT') 6199 CALL DPWRST('XXX','BUG ') 6200C 6201 DO8310IE=1,NUME 6202 IH1=JENAM1(IE) 6203 IH2=JENAM2(IE) 6204 DO8320I=1,NUMNAM 6205 I2=I 6206 IF(IH1.EQ.IHNAME(I).AND.IH2.EQ.IHNAM2(I))THEN 6207 JMIN=IVSTAR(I2) 6208 JMAX=IVSTOP(I2) 6209 WRITE(ICOUT,8326)IH1,IH2,(IFUNC(J),J=JMIN,JMAX) 6210 8326 FORMAT(A4,A4,10X,80A1) 6211 CALL DPWRST('XXX','BUG ') 6212 ENDIF 6213 8320 CONTINUE 6214 8310 CONTINUE 6215 ENDIF 6216C 6217 ELSEIF(ICASRE.EQ.'MATR')THEN 6218 IF(IFEEDB.EQ.'ON')THEN 6219 WRITE(ICOUT,999) 6220 CALL DPWRST('XXX','BUG ') 6221 WRITE(ICOUT,8401)IHMAT1,IHMAT2,IMATNR 6222 8401 FORMAT(' MATRIX ',A4,A4,'-- ',I8,' ROWS') 6223 CALL DPWRST('XXX','BUG ') 6224 WRITE(ICOUT,8402)IMATNC 6225 8402 FORMAT(' ',4X,4X,'-- ',I8,' COLUMNS') 6226 CALL DPWRST('XXX','BUG ') 6227 WRITE(ICOUT,999) 6228 CALL DPWRST('XXX','BUG ') 6229 WRITE(ICOUT,8404) 6230 8404 FORMAT(' VARIABLES COLUMN OBS/VARIABLE') 6231 CALL DPWRST('XXX','BUG ') 6232 WRITE(ICOUT,8405) 6233 8405 FORMAT('(= COLUMN VECTORS)') 6234 CALL DPWRST('XXX','BUG ') 6235C 6236 DO8410IE=1,NUME 6237 IH1=JENAM1(IE) 6238 IH2=JENAM2(IE) 6239 DO8420I=1,NUMNAM 6240 I2=I 6241 IF(IH1.EQ.IHNAME(I).AND.IH2.EQ.IHNAM2(I))THEN 6242 WRITE(ICOUT,8426)IH1,IH2,IVALUE(I2),IN(I2) 6243 8426 FORMAT(8X,A4,A4,1X,I8,5X,I8) 6244 CALL DPWRST('XXX','BUG ') 6245 ENDIF 6246 8420 CONTINUE 6247 8410 CONTINUE 6248 ENDIF 6249 ELSEIF(ICASRE.EQ.'ROWI')THEN 6250 CONTINUE 6251 ELSE 6252C 6253 IF(IFEEDB.EQ.'ON')THEN 6254 WRITE(ICOUT,999) 6255 CALL DPWRST('XXX','BUG ') 6256 WRITE(ICOUT,8101) 6257 8101 FORMAT('VARIABLE COLUMN OBS/VARIABLE') 6258 CALL DPWRST('XXX','BUG ') 6259C 6260 DO8110IE=1,NUME 6261 IH1=JENAM1(IE) 6262 IH2=JENAM2(IE) 6263 DO8120I=1,NUMNAM 6264 I2=I 6265 IF(IH1.EQ.IHNAME(I).AND.IH2.EQ.IHNAM2(I))THEN 6266 WRITE(ICOUT,8126)IH1,IH2,IVALUE(I2),IN(I2) 6267 8126 FORMAT(A4,A4,1X,I8,5X,I8) 6268 CALL DPWRST('XXX','BUG ') 6269 ENDIF 6270 8120 CONTINUE 6271 8110 CONTINUE 6272 ENDIF 6273 GOTO8800 6274 ENDIF 6275C 6276C *************************************** 6277C ** STEP 88-- ** 6278C ** FOR THE FILE CASE, ** 6279C ** CLOSE THE FILE. ** 6280C *************************************** 6281C 6282 8800 CONTINUE 6283 ISTEPN='88' 6284 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ') 6285 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) 6286C 6287 IF(IOFILE.EQ.'YES'.AND.ICURST.EQ.'OPEN')GOTO8810 6288 GOTO8890 6289 8810 CONTINUE 6290 IENDFI='OFF' 6291 IREWIN='ON' 6292 IF(IREARW.EQ.'ON')THEN 6293 CALL DPCLFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST, 6294 1 IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR) 6295 IREACS='CLOSED' 6296 ENDIF 6297 8890 CONTINUE 6298C 6299 IF(IFEEDB.EQ.'ON' .AND. ICASRE.EQ.'ROWR')THEN 6300 WRITE(ICOUT,55805)NUMLRD,IVBASE,NUMDPL 6301 CALL DPWRST('XXX','BUG ') 6302 WRITE(ICOUT,999) 6303 CALL DPWRST('XXX','BUG ') 6304 ENDIF 6305C 6306C ****************************************** 6307C ** STEP 89-- ** 6308C ** IF THE MACRO STATUS IS OPEN ** 6309C ** THEN CHANGE IDEV FROM READ TO MACR ** 6310C ****************************************** 6311C 6312CCCCC IF(IMACST.EQ.'OPFI')IDEV='MACR' 6313CCCCC IF(IMACCS.EQ.'OPEN')IDEV='MACR' 6314C 6315C ***************** 6316C ** STEP 90-- ** 6317C ** EXIT ** 6318C ***************** 6319C 6320 9000 CONTINUE 6321C 6322 IREADL=IREAD2 6323 ISKIP=ISKPSV 6324C 6325C 2019/09: IF CHARACTER DATA WAS READ, DO THE FOLLOWING: 6326C 6327C 1. IF CHARACTER VARIABLES ARE IN "OVERWRITE" MODE, THEN 6328C 6329C A. CLOSE AND REOPEN "dpst2f.dat". 6330C 6331C B. OPEN THE CHARACTER DATA FILE ("dpzchf.dat" BY DEFAULT). 6332C 6333C C. LOOP TRHOUGH AND WRITE CONTENTS OF "dpst2f.dat" TO 6334C THE CHARACTER DATA FILE. ADD THE NUMBER OF LINES 6335C FOR EACH VARIABLE. 6336C 6337C 2. IF CHARACTER VARIABLES ARE IN "APPEND" MODE, THEN 6338C 6339C A. CLOSE AND REOPEN "dpst2f.dat". 6340C 6341C B. OPEN THE CHARACTER DATA FILE. 6342C 6343C C. OPEN THE TEMPORARY FILE "dpst5f.dat". 6344C 6345C C. LOOP THROUGH AND APPEND CONTENTS OF "dpzchf.dat" 6346C AND "dpst2f.dat" AND WRITE TO "dpst5f.dat". 6347C 6348C D. COPY "dpst5f.dat" TO "dpzchf.dat". 6349C 6350 IF(IZCHCS.EQ.'OPEN')THEN 6351C 6352C CHECK IF CHARACTER VARIABLE FILE EXISTS. IF NOT, THEN USE 6353C "OVERWRITE" METHOD. 6354C 6355 IFILE4=IZCHNA 6356 ISUBN0='READ' 6357 IERRFI='NO' 6358 CALL DPINFI(IFILE4,IEXIST,IOPEN,IACC,ISUBN0,IBUGS2, 6359 1 ISUBRO,IERROR) 6360C 6361 IF(ISTRVA.EQ.'OVER' .OR. IEXIST.EQ.'NO')THEN 6362C 6363C STEP 1: CLOSE AND REOPEN "dpst2f.dat" FILE 6364C 6365 IOP='CLOS' 6366 IFLG11=0 6367 IFLG21=1 6368 IFLG31=0 6369 IFLAG4=0 6370 IFLAG5=0 6371 CALL DPAUFI(IOP,IFLG11,IFLG21,IFLG31,IFLAG4,IFLAG5, 6372 1 IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5, 6373 1 IBUGS2,ISUBRO,IERROR) 6374 IOP='OPEN' 6375 CALL DPAUFI(IOP,IFLG11,IFLG21,IFLG31,IFLAG4,IFLAG5, 6376 1 IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5, 6377 1 IBUGS2,ISUBRO,IERROR) 6378C 6379C STEP 2: OPEN THE CHARACTER DATA FILE 6380C 6381 IOUNI4=IZCHNU 6382 IFILE4=IZCHNA 6383 ISTAT4=IZCHST 6384 IFORM4=IZCHFO 6385 IACCE4=IZCHAC 6386 IPROT4=IZCHPR 6387 ICURS4=IZCHCS 6388C 6389 ISUBN0='READ' 6390 IERRFI='NO' 6391 CALL DPOPFI(IOUNI4,IFILE4,ISTAT4,IFORM4,IACCE4,IPROT4,ICURS4, 6392 1 IREWI4,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR) 6393C 6394C STEP 3: UPDATE THE CONTENTS OF THE CHARACTER DATA FILE 6395C 6396 READ(IOUNI2,*,ERR=9047,END=9047)IVAR 6397 WRITE(IOUNI4,'(I8)')IVAR 6398C 6399 DO9041KK=1,IVAR 6400 ISTR=' ' 6401 READ(IOUNI2,'(A8)',ERR=9047,END=9047)ISTR(1:8) 6402 WRITE(IOUNI4,'(A8,I10)')ISTR(1:8),NUMLRD 6403 9041 CONTINUE 6404C 6405 IFRMT=' ' 6406 IFRMT='(A )' 6407 NTEMP=25*IVAR 6408 IF(NTEMP.GT.9999)THEN 6409 WRITE(ICOUT,999) 6410 CALL DPWRST('XXX','BUG ') 6411 WRITE(ICOUT,211) 6412 CALL DPWRST('XXX','BUG ') 6413 WRITE(ICOUT,9042) 6414 9042 FORMAT(' MAXIMUM NUMBER OF CHARACTER VARIABLES ', 6415 1 'EXCEEDED.') 6416 CALL DPWRST('XXX','BUG ') 6417 IERROR='YES' 6418 GOTO9049 6419 ENDIF 6420 WRITE(IFRMT(3:6),'(I4)')NTEMP 6421 DO9043KK=1,NUMLRD 6422 ISTR=' ' 6423 READ(IOUNI2,IFRMT,ERR=9047,END=9047)ISTR(1:NTEMP) 6424 WRITE(IOUNI4,IFRMT)ISTR(1:NTEMP) 6425 9043 CONTINUE 6426 GOTO9049 6427C 6428 9047 CONTINUE 6429 WRITE(ICOUT,999) 6430 CALL DPWRST('XXX','BUG ') 6431 WRITE(ICOUT,211) 6432 CALL DPWRST('XXX','BUG ') 6433 WRITE(ICOUT,9048) 6434 9048 FORMAT(' ERROR IN CREATING CHARACTER VARIABLE FILE.') 6435 CALL DPWRST('XXX','BUG ') 6436 IERROR='YES' 6437C 6438C STEP 4: CLOSE THE CHARACTER DATA FILE AND "dpst2f.dat" 6439C 6440 9049 CONTINUE 6441 CALL DPCLFI(IOUNI4,IFILE4,ISTAT4,IFORM4,IACCE4,IPROT4,ICURS4, 6442 1 IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR) 6443 IZCHCS='CLOSED' 6444C 6445 IOP='CLOS' 6446 CALL DPAUFI(IOP,IFLG11,IFLG21,IFLG31,IFLAG4,IFLAG5, 6447 1 IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5, 6448 1 IBUGS2,ISUBRO,IERROR) 6449C 6450 ELSE 6451C 6452C STEP 1: CLOSE AND REOPEN "dpst2f.dat" FILE, ALSO OPEN 6453C "dpst5f.dat" 6454C 6455 IOP='CLOS' 6456 IFLG11=0 6457 IFLG21=1 6458 IFLG31=0 6459 IFLAG4=0 6460 IFLAG5=0 6461 CALL DPAUFI(IOP,IFLG11,IFLG21,IFLG31,IFLAG4,IFLAG5, 6462 1 IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5, 6463 1 IBUGS2,ISUBRO,IERROR) 6464 IOP='OPEN' 6465 IFLAG5=1 6466 CALL DPAUFI(IOP,IFLG11,IFLG21,IFLG31,IFLAG4,IFLAG5, 6467 1 IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5, 6468 1 IBUGS2,ISUBRO,IERROR) 6469C 6470C STEP 2: OPEN THE CHARACTER DATA FILE 6471C 6472 IOUNI4=IZCHNU 6473 IFILE4=IZCHNA 6474 ISTAT4=IZCHST 6475 IFORM4=IZCHFO 6476 IACCE4=IZCHAC 6477 IPROT4=IZCHPR 6478 ICURS4=IZCHCS 6479C 6480 ISUBN0='READ' 6481 IERRFI='NO' 6482 CALL DPOPFI(IOUNI4,IFILE4,ISTAT4,IFORM4,IACCE4,IPROT4,ICURS4, 6483 1 IREWI4,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR) 6484C 6485C STEP 3: UPDATE THE CONTENTS OF THE CHARACTER DATA FILE 6486C 6487 READ(IOUNI2,*,ERR=9057,END=9057)IVAR1 6488 READ(IOUNI4,*,ERR=9057,END=9057)IVAR2 6489 IVAR=IVAR1 + IVAR2 6490 WRITE(IOUNI5,'(I8)')IVAR 6491C 6492C OLD DATA 6493C 6494 MXROW1=-1 6495 DO9051KK=1,IVAR2 6496 READ(IOUNI4,'(2A4,I10)',ERR=9057,END=9057)JVNAM1(KK), 6497 1 JVNAM2(KK),NIV(KK) 6498 IF(NIV(KK).GT.MXROW1)MXROW1=NIV(KK) 6499 WRITE(IOUNI5,'(2A4,I10)')JVNAM1(KK),JVNAM2(KK),NIV(KK) 6500 9051 CONTINUE 6501C 6502C NEW DATA 6503C 6504 MXROW2=NUMLRD 6505 DO9061KK=1,IVAR1 6506 IROW=IVAR1+KK 6507 READ(IOUNI2,'(2A4)',ERR=9057,END=9057)JVNAM1(IROW), 6508 1 JVNAM2(IROW) 6509 NIV(IROW)=NUMLRD 6510 WRITE(IOUNI5,'(2A4,I10)')JVNAM1(IROW),JVNAM2(IROW),NIV(IROW) 6511 9061 CONTINUE 6512C 6513 NTEMP1=25*IVAR1 6514 NTEMP2=25*IVAR2 6515 NTEMP=NTEMP1+NTEMP2 6516 IF(NTEMP.GT.9999)THEN 6517 WRITE(ICOUT,999) 6518 CALL DPWRST('XXX','BUG ') 6519 WRITE(ICOUT,211) 6520 CALL DPWRST('XXX','BUG ') 6521 WRITE(ICOUT,9052) 6522 9052 FORMAT(' MAXIMUM NUMBER OF CHARACTER VARIABLES ', 6523 1 'EXCEEDED.') 6524 CALL DPWRST('XXX','BUG ') 6525 IERROR='YES' 6526 GOTO9059 6527 ENDIF 6528C 6529 IFRMT=' ' 6530 IFRMT='(A )' 6531 WRITE(IFRMT(3:6),'(I4)')NTEMP2 6532 IFRMT2=' ' 6533 IFRMT2='(A )' 6534 WRITE(IFRMT2(3:6),'(I4)')NTEMP1 6535 IFRMT3=' ' 6536 IFRMT3='(A )' 6537 WRITE(IFRMT3(3:6),'(I4)')NTEMP 6538C 6539 DO9053KK=1,MAX(MXROW1,MXROW2) 6540 ISTR=' ' 6541 IF(KK.LE.MXROW1 .AND. KK.LE.MXROW2)THEN 6542 READ(IOUNI4,IFRMT,ERR=9057,END=9057)ISTR(1:NTEMP2) 6543 READ(IOUNI2,IFRMT2,ERR=9057,END=9057) 6544 1 ISTR(NTEMP2+1:NTEMP1+NTEMP2) 6545 WRITE(IOUNI5,IFRMT3)ISTR(1:NTEMP) 6546 ELSEIF(KK.GT.MXROW1 .AND.KK.LE.MXROW2)THEN 6547 READ(IOUNI2,IFRMT2,ERR=9057,END=9057) 6548 1 ISTR(NTEMP2+1:NTEMP1+NTEMP2) 6549 WRITE(IOUNI5,IFRMT3)ISTR(1:NTEMP) 6550 ELSEIF(KK.LE.MXROW1 .AND.KK.GT.MXROW2)THEN 6551 READ(IOUNI4,IFRMT,ERR=9057,END=9057)ISTR(1:NTEMP2) 6552 ISTR(NTEMP2+1:NTEMP1+NTEMP2)=' ' 6553 WRITE(IOUNI5,IFRMT3)ISTR(1:NTEMP) 6554 ENDIF 6555 9053 CONTINUE 6556 GOTO9059 6557C 6558 9057 CONTINUE 6559 WRITE(ICOUT,999) 6560 CALL DPWRST('XXX','BUG ') 6561 WRITE(ICOUT,211) 6562 CALL DPWRST('XXX','BUG ') 6563 WRITE(ICOUT,9058) 6564 9058 FORMAT(' ERROR IN CREATING CHARACTER VARIABLE FILE.') 6565 CALL DPWRST('XXX','BUG ') 6566 IERROR='YES' 6567C 6568C STEP 4: CLOSE THE CHARACTER DATA FILE AND "dpst2f.dat" 6569C 6570 9059 CONTINUE 6571 CALL DPCLFI(IOUNI4,IFILE4,ISTAT4,IFORM4,IACCE4,IPROT4,ICURS4, 6572 1 IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR) 6573 IZCHCS='CLOSED' 6574C 6575 IOP='CLOS' 6576 CALL DPAUFI(IOP,IFLG11,IFLG21,IFLG31,IFLAG4,IFLAG5, 6577 1 IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5, 6578 1 IBUGS2,ISUBRO,IERROR) 6579C 6580C STEP 5: COPY "dpst5f.dat" TO CHARACTER VARIABLE FILE 6581C 6582 CALL COPYFI(IFILE5,IFILE4,IBUGS2,ISUBRO,IERROR) 6583C 6584 ENDIF 6585 GOTO9090 6586 ENDIF 6587C 6588 IF(ICASRE.EQ.'IMAZ' .OR. ICASRE.EQ.'IMAG')THEN 6589#ifdef HAVE_GD 6590 CALL GDUNLO() 6591#endif 6592 ENDIF 6593C 6594 9090 CONTINUE 6595C 6596 IFILQU=IFILQ2 6597C 6598 IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')THEN 6599 WRITE(ICOUT,999) 6600 CALL DPWRST('XXX','BUG ') 6601 WRITE(ICOUT,9011) 6602 9011 FORMAT('***** AT THE END OF DPREAD--') 6603 CALL DPWRST('XXX','BUG ') 6604 WRITE(ICOUT,9012)IFROW1,IFCOL1,IFCOL2,AFROW2,ICASRE 6605 9012 FORMAT('IFROW1,IFCOL1,IFCOL2,AFROW2,ICASRE = ', 6606 1 3I8,2X,E15.7,2X,A4) 6607 CALL DPWRST('XXX','BUG ') 6608 WRITE(ICOUT,9015)IFOUND,IERROR 6609 9015 FORMAT('IFOUND,IERROR = ',A4,2X,A4) 6610 CALL DPWRST('XXX','BUG ') 6611 WRITE(ICOUT,9016)NUMVRD,NUMPRD,NUMFRD 6612 9016 FORMAT('NUMVRD,NUMPRD,NUMFRD = ',3I8) 6613 CALL DPWRST('XXX','BUG ') 6614 WRITE(ICOUT,9017)IMACRO,IMACNU,IMACCS 6615 9017 FORMAT('IMACRO,IMACNU,IMACCS = ',A4,I8,2X,A12) 6616 CALL DPWRST('XXX','BUG ') 6617 WRITE(ICOUT,9019)IOSW,IOFILE,IOTERM,IRD,IRD2,IOUNIT 6618 9019 FORMAT('IOSW,IOFILE,IOTERM,IRD,IRD2,IOUNIT = ',3(A4,2X),3I8) 6619 CALL DPWRST('XXX','BUG ') 6620 WRITE(ICOUT,9022)IFILE(1:80) 6621 9022 FORMAT('IFILE = ',A80) 6622 CALL DPWRST('XXX','BUG ') 6623 WRITE(ICOUT,9023)ISTAT,IFORM,IACCES,IPROT,ICURST 6624 9023 FORMAT('ISTAT,IFORM,IACCES,IPROT,ICURST =',5(1X,A12)) 6625 CALL DPWRST('XXX','BUG ') 6626 WRITE(ICOUT,9028)IENDFI,IREWIN,ISUBN0,IERRFI,NUMNAM 6627 9028 FORMAT('IENDFI,IREWIN,ISUBN0,IERRFI,NUMNAM = ',3(A4,1X),A12,I8) 6628 CALL DPWRST('XXX','BUG ') 6629 WRITE(ICOUT,9031)N2,MAXN2,N3,NCREAF 6630 9031 FORMAT('N2,MAXN2,N3,NCREAF = ',4I8) 6631 CALL DPWRST('XXX','BUG ') 6632 WRITE(ICOUT,9032)(IFUNC2(I),I=1,100) 6633 9032 FORMAT('(IFUNC2(I),I=1,100) = ',100A1) 6634 CALL DPWRST('XXX','BUG ') 6635 WRITE(ICOUT,9033)(IFUNC3(I),I=1,100) 6636 9033 FORMAT('(IFUNC3(I),I=1,100) = ',100A1) 6637 CALL DPWRST('XXX','BUG ') 6638 WRITE(ICOUT,9036)IHMAT1,IHMAT2,INAMMA,IMATC1,IMATNR,IMATNC 6639 9036 FORMAT('IHMAT1,IHMAT2,INAMMA,IMATC1,IMATNR,IMATNC = ', 6640 1 A4,2X,A4,2X,4I8) 6641 CALL DPWRST('XXX','BUG ') 6642 IF(NCREAF.GE.1)THEN 6643 WRITE(ICOUT,9038)(ICREAF(I:I),I=1,NCREAF) 6644 9038 FORMAT('(ICREAF(I:I),I=1,NCREAF) = ',80A1) 6645 CALL DPWRST('XXX','BUG ') 6646 ENDIF 6647 WRITE(ICOUT,9039)IREARW,ICOMCH,ICOMSW 6648 9039 FORMAT('IREARW,ICOMCH,ICOMSW = ',2(A4,2X),A4) 6649 CALL DPWRST('XXX','BUG ') 6650 ENDIF 6651C 6652 RETURN 6653 END 6654