1C ----------------------------------------------------------------------- 2C INPUT reads the input file *.nml 3C Developed by A.Rossi, C.Planas and G.Fiorentini 4C 5C Copyright (C) 2010-2014 European Commission 6C 7C This file is part of Program DMM 8C 9C DMM is free software developed at the Joint Research Centre of the 10C European Commission: you can redistribute it and/or modify it under 11C the terms of the GNU General Public License as published by 12C the Free Software Foundation, either version 3 of the License, or 13C (at your option) any later version. 14C 15C DMM is distributed in the hope that it will be useful, 16C but WITHOUT ANY WARRANTY; without even the implied warranty of 17C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18C GNU General Public License for more details. 19C 20C You should have received a copy of the GNU General Public License 21C along with DMM. If not, see <http://www.gnu.org/licenses/>. 22C ----------------------------------------------------------------------- 23 SUBROUTINE input(FILEIN,NMLNAME,PATH,ny,nz,nx,nu,d,nv,ns, 24 1 nstot,np,nf,INFOS,seed,thin,burnin,simulrec,sampler, 25 2 datasim,dllname,check,estimation,nt,pdftheta,hyptheta, 26 3 hypS,T,obs,Ssampler,hbl,MargLik) 27 28C INCLUDE 'iosdef.for' 29 INTEGER IERR 30C INPUT 31 CHARACTER*200 FILEIN 32C OUTPUT 33 NAMELIST /ssm/ nx,nu,d,nv,dllname,check,estimation 34 INTEGER nx,nu,d(2),nv 35 CHARACTER*200 dllname 36 CHARACTER*1 check 37 CHARACTER*2 estimation 38 39 NAMELIST /S1/ dynS1,matS1,ns1,hypS1 40 NAMELIST /S2/ dynS2,matS2,ns2,hypS2 41 NAMELIST /S3/ dynS3,matS3,ns3,hypS3 42 NAMELIST /S4/ dynS4,matS4,ns4,hypS4 43 NAMELIST /S5/ dynS5,matS5,ns5,hypS5 44 NAMELIST /S6/ dynS6,matS6,ns6,hypS6 45 CHARACTER*1 dynS1,dynS2,dynS3,dynS4,dynS5,dynS6, 46 1 matS1(6),matS2(6),matS3(6),matS4(6),matS5(6),matS6(6) 47 INTEGER ns1,ns2,ns3,ns4,ns5,ns6 48 DOUBLE PRECISION hypS1(50,50),hypS2(50,50),hypS3(50,50), 49 1 hypS4(50,50),hypS5(50,50),hypS6(50,50),hypS(50,50,6) 50 51 NAMELIST /mcmc/ seed,thin,burnin,simulrec,sampler, 52 1 Ssampler,hbl,marglik 53 INTEGER seed,thin,burnin,simulrec,hbl 54 CHARACTER*1 MargLik 55 CHARACTER*2 sampler 56 CHARACTER*3 Ssampler 57 58 NAMELIST /prior/ nt,pdftheta,hyptheta 59 INTEGER nt 60 DOUBLE PRECISION hyptheta(4,200) 61 CHARACTER*2 pdftheta(200) 62 63 NAMELIST /dataset/ T,ny,nz,nf,datasim,obs 64 INTEGER T,ny,nz,nf 65 DOUBLE PRECISION obs(30000) 66 CHARACTER*1 datasim 67 68C OUTPUT not in the namelist 69 INTEGER ns(6),INFOS(9,6),IMAX(1),np(3),nstot,IND 70 CHARACTER*200 NMLNAME,PATH 71 72C LOCALS 73 CHARACTER*3 IC 74 CHARACTER*200 STR 75 INTEGER I,J,K,IFAIL 76 INTEGER, ALLOCATABLE:: nstateS(:) 77 CHARACTER*1, ALLOCATABLE:: matS(:,:),dynS(:) 78 79C IDENTIFY the PATH and NAME of the .NML INPUT FILE 80 I = SCAN(FILEIN,'\', BACK = .TRUE.) 81 IF((I.LE.0).OR.(I.GE.200)) THEN 82 NMLNAME = FILEIN 83 PATH = '' 84 ELSE 85 NMLNAME = FILEIN(I+1:200) 86 PATH = FILEIN(1:I) 87 ENDIF 88 I = SCAN(NMLNAME,'.', BACK = .TRUE.) 89 NMLNAME = NMLNAME(1:I-1) 90 91C FIND namelist ssm 92 OPEN(1,File=TRIM(FILEIN), ACCESS='SEQUENTIAL', 93 1 STATUS='OLD',IOSTAT=IERR, ERR=5000) 94 IFAIL = -1 95 DO WHILE (.NOT.EOF(1)) 96 READ(1,'(A)') STR 97 IF (INDEX(STR,'&ssm').GT.0) IFAIL = 0 98 ENDDO 99 CLOSE(1) 100 IF (IFAIL.EQ.-1) THEN 101 TYPE *, ' Namelist ssm not found' 102 TYPE *, ' Program aborting' 103 PAUSE 104 RETURN 105 ENDIF 106 107C READ namelist ssm 108 ns1=0 109 ns2=0 110 ns3=0 111 ns4=0 112 ns5=0 113 ns6=0 114 OPEN(1,File=TRIM(FILEIN), ACCESS='SEQUENTIAL') 115 nx = -1 116 nu = -1 117 d(:) = -1 118 nv = 0 119 dllname = '' 120 check = 'N' 121 estimation = 'BA' 122 READ(1,NML=ssm,END=5001,ERR=5001) 123 IF (nx.LE.0) THEN 124 TYPE *, ' Check nx in namelist ssm' 125 TYPE *, ' Program aborting' 126 PAUSE 127 STOP 128 ENDIF 129 IF(nu.LE.0) THEN 130 TYPE *, ' Check nu in namelist ssm' 131 TYPE *, ' Program aborting' 132 PAUSE 133 STOP 134 ENDIF 135 IF((d(1).LT.0).OR.(d(2).LT.0).OR.(d(2).GT.nx)) THEN 136 TYPE *, ' Check d in namelist ssm' 137 TYPE *, ' Program aborting' 138 PAUSE 139 STOP 140 ENDIF 141 IF((nv.LT.0).OR.(nv.GT.6)) THEN 142 TYPE *, ' Check nv in namelist ssm' 143 TYPE *, ' Program aborting' 144 PAUSE 145 STOP 146 ENDIF 147 IF(dllname.EQ.'') THEN 148 TYPE *, ' Check dllname in namelist ssm' 149 TYPE *, ' Program aborting' 150 PAUSE 151 STOP 152 ENDIF 153 CLOSE(1) 154 IF ((estimation.NE.'ML').AND.(estimation.NE.'ml').AND. 155 & (estimation.NE.'Ml').AND.(estimation.NE.'mL').AND. 156 & (estimation.NE.'BA').AND.(estimation.NE.'ba').AND. 157 & (estimation.NE.'Ba').AND.(estimation.NE.'bA')) THEN 158 estimation = 'BA' 159 ENDIF 160 161 IF (nv.GT.0) THEN 162C FIND namelist S1 163 OPEN(1,File=TRIM(FILEIN), ACCESS='SEQUENTIAL') 164 IFAIL = -1 165 DO WHILE (.NOT.EOF(1)) 166 READ(1,'(A)') STR 167 IF (INDEX(STR,'&S1').GT.0) IFAIL = 0 168 ENDDO 169 CLOSE(1) 170 IF (IFAIL.EQ.-1) THEN 171 TYPE *, ' Namelist S1 not found' 172 TYPE *, ' Program aborting' 173 PAUSE 174 RETURN 175 ENDIF 176 177C READ namelist S1 178 OPEN(1,File=TRIM(FILEIN), ACCESS='SEQUENTIAL') 179 dynS1 = '-' 180 ns1 = -1 181 hypS1(:,:) = 1 182 matS1(:) = '-' 183 READ(1,NML=S1,END=5002,ERR=5002) 184 185 IF ((dynS1.NE.'I').AND.(dynS1.NE.'M'))THEN 186 TYPE *, ' Check dynS1 in namelist S1' 187 TYPE *, ' Program aborting' 188 PAUSE 189 STOP 190 ENDIF 191 192 IF (ns1.LT.2) THEN 193 TYPE *, ' Check ns1 in namelist S1' 194 TYPE *, ' Program aborting' 195 PAUSE 196 STOP 197 ENDIF 198 199 IF (dynS1.EQ.'I') THEN 200 DO J = 1,ns1 201 IF (hypS1(J,1).LE.0) THEN 202 TYPE *, ' Check hypS1 in namelist S1' 203 TYPE *, ' Program aborting' 204 PAUSE 205 STOP 206 ENDIF 207 ENDDO 208 ELSEIF (dynS1.EQ.'M') THEN 209 DO J = 1,ns1 210 DO K = 1,ns1 211 IF (hypS1(J,K).LE.0) THEN 212 TYPE *, ' Check hypS1 in namelist S1' 213 TYPE *, ' Program aborting' 214 PAUSE 215 STOP 216 ENDIF 217 ENDDO 218 ENDDO 219 ENDIF 220 221 IF ((matS1(1).EQ.'-').OR.((matS1(1).NE.'a') 222 # .AND.(matS1(1).NE.'H').AND.(matS1(1).NE.'G') 223 # .AND.(matS1(1).NE.'c').AND.(matS1(1).NE.'F') 224 # .AND.(matS1(1).NE.'R'))) THEN 225 TYPE *, ' Check matS1 in namelist S1' 226 TYPE *, ' Program aborting' 227 PAUSE 228 STOP 229 ENDIF 230 DO I = 2,6 231 IF ((matS1(I).NE.'-').AND.(matS1(I).NE.'a') 232 # .AND.(matS1(I).NE.'H').AND.(matS1(I).NE.'G') 233 # .AND.(matS1(I).NE.'c').AND.(matS1(I).NE.'F') 234 # .AND.(matS1(I).NE.'R')) THEN 235 TYPE *, ' Check matS1 in namelist S1' 236 TYPE *, ' Program aborting' 237 PAUSE 238 STOP 239 ENDIF 240 ENDDO 241 ENDIF 242 CLOSE(1) 243 244 IF (nv.GT.1) THEN 245C FIND namelist S2 246 OPEN(1,File=TRIM(FILEIN), ACCESS='SEQUENTIAL') 247 IFAIL = -1 248 DO WHILE (.NOT.EOF(1)) 249 READ(1,'(A)') STR 250 IF (INDEX(STR,'&S2').GT.0) IFAIL = 0 251 ENDDO 252 CLOSE(1) 253 IF (IFAIL.EQ.-1) THEN 254 TYPE *, ' Namelist S2 not found' 255 TYPE *, ' Program aborting' 256 PAUSE 257 RETURN 258 ENDIF 259C READ namelist S2 260 OPEN(1,File=TRIM(FILEIN), ACCESS='SEQUENTIAL') 261 dynS2 = '-' 262 ns2 = -1 263 hypS2(:,:) = 1 ! Uniform 264 matS2(:) = '-' 265 READ(1,NML=S2,END=5003,ERR=5003) 266 267 IF ((dynS2.NE.'I').AND.(dynS2.NE.'M'))THEN 268 TYPE *, ' Check dynS2 in namelist S2' 269 TYPE *, ' Program aborting' 270 PAUSE 271 STOP 272 ENDIF 273 274 IF (ns2.LT.2) THEN 275 TYPE *, ' Check ns2 in namelist S2' 276 TYPE *, ' Program aborting' 277 PAUSE 278 STOP 279 ENDIF 280 281 IF (dynS2.EQ.'I') THEN 282 DO J = 1,ns2 283 IF (hypS2(J,1).LE.0) THEN 284 TYPE *, ' Check hypS2 in namelist S2' 285 TYPE *, ' Program aborting' 286 PAUSE 287 STOP 288 ENDIF 289 ENDDO 290 ELSEIF (dynS2.EQ.'M') THEN 291 DO J = 1,ns2 292 DO K = 1,ns2 293 IF (hypS2(J,K).LE.0) THEN 294 TYPE *, ' Check hypS2 in namelist S2' 295 TYPE *, ' Program aborting' 296 PAUSE 297 STOP 298 ENDIF 299 ENDDO 300 ENDDO 301 ENDIF 302 I = 1 303 IF ((matS2(I).EQ.'-').OR.((matS2(I).NE.'a') 304 # .AND.(matS2(I).NE.'H').AND.(matS2(I).NE.'G') 305 # .AND.(matS2(I).NE.'c').AND.(matS2(I).NE.'F') 306 # .AND.(matS2(I).NE.'R'))) THEN 307 TYPE *, ' Check matS2 in namelist S2' 308 TYPE *, ' Program aborting' 309 PAUSE 310 STOP 311 ENDIF 312 DO I = 2,6 313 IF ((matS2(I).NE.'-').AND.(matS2(I).NE.'a') 314 # .AND.(matS2(I).NE.'H').AND.(matS2(I).NE.'G') 315 # .AND.(matS2(I).NE.'c').AND.(matS2(I).NE.'F') 316 # .AND.(matS2(I).NE.'R')) THEN 317 PAUSE 318 TYPE *, ' Check matS2 in namelist S2' 319 TYPE *, ' Program aborting' 320 STOP 321 ENDIF 322 ENDDO 323 ENDIF 324 CLOSE(1) 325 326 IF (nv.GT.2) THEN 327C FIND namelist S3 328 OPEN(1,File=TRIM(FILEIN), ACCESS='SEQUENTIAL') 329 IFAIL = -1 330 DO WHILE (.NOT.EOF(1)) 331 READ(1,'(A)') STR 332 IF (INDEX(STR,'&S3').GT.0) IFAIL = 0 333 ENDDO 334 CLOSE(1) 335 IF (IFAIL.EQ.-1) THEN 336 TYPE *, ' Namelist S3 not found' 337 TYPE *, ' Program aborting' 338 PAUSE 339 RETURN 340 ENDIF 341 342C READ namelist S3 343 OPEN(1,File=TRIM(FILEIN), ACCESS='SEQUENTIAL') 344 dynS3 = '-' 345 ns3 = -1 346 hypS3(:,:) = 1 347 matS3(:) = '-' 348 READ(1,NML=S3,END=5004,ERR=5004) 349 350 IF ((dynS3.NE.'I').AND.(dynS3.NE.'M'))THEN 351 TYPE *, ' Check dynS3 in namelist S3' 352 TYPE *, ' Program aborting' 353 PAUSE 354 STOP 355 ENDIF 356 357 IF (ns3.LT.2) THEN 358 TYPE *, ' Check ns3 in namelist S3' 359 TYPE *, ' Program aborting' 360 PAUSE 361 STOP 362 ENDIF 363 364 IF (dynS3.EQ.'I') THEN 365 DO J = 1,ns3 366 IF (hypS3(J,1).LE.0) THEN 367 TYPE *, ' Check hypS3 in namelist S3' 368 TYPE *, ' Program aborting' 369 PAUSE 370 STOP 371 ENDIF 372 ENDDO 373 ELSEIF (dynS3.EQ.'M') THEN 374 DO J = 1,ns3 375 DO K = 1,ns3 376 IF (hypS3(J,K).LE.0) THEN 377 TYPE *, ' Check hypS3 in namelist S3' 378 TYPE *, ' Program aborting' 379 PAUSE 380 STOP 381 ENDIF 382 ENDDO 383 ENDDO 384 ENDIF 385 386 IF ((matS3(1).EQ.'-').OR.((matS3(1).NE.'a') 387 # .AND.(matS3(1).NE.'H').AND.(matS3(1).NE.'G') 388 # .AND.(matS3(1).NE.'c').AND.(matS3(1).NE.'F') 389 # .AND.(matS3(1).NE.'R'))) THEN 390 TYPE *, ' Check matS3 in namelist S3' 391 TYPE *, ' Program aborting' 392 PAUSE 393 STOP 394 ENDIF 395 DO I = 2,6 396 IF ((matS3(I).NE.'-').AND.(matS3(I).NE.'a') 397 # .AND.(matS3(I).NE.'H').AND.(matS3(I).NE.'G') 398 # .AND.(matS3(I).NE.'c').AND.(matS3(I).NE.'F') 399 # .AND.(matS3(I).NE.'R')) THEN 400 TYPE *, ' Check matS3 in namelist S3' 401 TYPE *, ' Program aborting' 402 PAUSE 403 STOP 404 ENDIF 405 ENDDO 406 ENDIF 407 CLOSE(1) 408 409 IF (nv.GT.3) THEN 410C FIND namelist S4 411 OPEN(1,File=TRIM(FILEIN), ACCESS='SEQUENTIAL') 412 IFAIL = -1 413 DO WHILE (.NOT.EOF(1)) 414 READ(1,'(A)') STR 415 IF (INDEX(STR,'&S4').GT.0) IFAIL = 0 416 ENDDO 417 CLOSE(1) 418 IF (IFAIL.EQ.-1) THEN 419 TYPE *, ' Namlist S4 not found' 420 TYPE *, ' Program aborting' 421 PAUSE 422 RETURN 423 ENDIF 424 425C READ namelist S4 426 OPEN(1,File=TRIM(FILEIN), ACCESS='SEQUENTIAL') 427 dynS4 = '-' 428 ns4 = -1 429 hypS4(:,:) = 1 430 matS4(:) = '-' 431 READ(1,NML=S4,END=5005,ERR=5005) 432 433 IF ((dynS4.NE.'I').AND.(dynS4.NE.'M'))THEN 434 TYPE *, ' Check dynS4 in namelist S4' 435 TYPE *, ' Program aborting' 436 PAUSE 437 STOP 438 ENDIF 439 440 IF (ns4.LT.2) THEN 441 TYPE *, ' Check ns4 in namelist S4' 442 TYPE *, ' Program aborting' 443 PAUSE 444 STOP 445 ENDIF 446 447 IF (dynS4.EQ.'I') THEN 448 DO J = 1,ns4 449 IF (hypS4(J,1).LE.0) THEN 450 TYPE *, ' Check hypS4 in namelist S4' 451 TYPE *, ' Program aborting' 452 PAUSE 453 STOP 454 ENDIF 455 ENDDO 456 ELSEIF (dynS4.EQ.'M') THEN 457 DO J = 1,ns4 458 DO K = 1,ns4 459 IF (hypS4(J,K).LE.0) THEN 460 TYPE *, ' Check hypS4 in namelist S4' 461 TYPE *, ' Program aborting' 462 PAUSE 463 STOP 464 ENDIF 465 ENDDO 466 ENDDO 467 ENDIF 468 469 IF ((matS4(1).EQ.'-').OR.((matS4(1).NE.'a') 470 # .AND.(matS4(1).NE.'H').AND.(matS4(1).NE.'G') 471 # .AND.(matS4(1).NE.'c').AND.(matS4(1).NE.'F') 472 # .AND.(matS4(1).NE.'R'))) THEN 473 TYPE *, ' Check matS4 in namelist S4' 474 TYPE *, ' Program aborting' 475 PAUSE 476 STOP 477 ENDIF 478 DO I = 2,6 479 IF ((matS4(I).NE.'-').AND.(matS4(I).NE.'a') 480 # .AND.(matS4(I).NE.'H').AND.(matS4(I).NE.'G') 481 # .AND.(matS4(I).NE.'c').AND.(matS4(I).NE.'F') 482 # .AND.(matS4(I).NE.'R')) THEN 483 TYPE *, ' Check matS4 in namelist S4' 484 TYPE *, ' Program aborting' 485 PAUSE 486 STOP 487 ENDIF 488 ENDDO 489 ENDIF 490 CLOSE(1) 491 492 IF (nv.GT.4) THEN 493C FIND namelist S5 494 OPEN(1,File=TRIM(FILEIN), ACCESS='SEQUENTIAL') 495 IFAIL = -1 496 DO WHILE (.NOT.EOF(1)) 497 READ(1,'(A)') STR 498 IF (INDEX(STR,'&S5').GT.0) IFAIL = 0 499 ENDDO 500 CLOSE(1) 501 IF (IFAIL.EQ.-1) THEN 502 TYPE *, ' Namlist S5 not found' 503 TYPE *, ' Program aborting' 504 PAUSE 505 RETURN 506 ENDIF 507 508C READ namelist S5 509 OPEN(1,File=TRIM(FILEIN), ACCESS='SEQUENTIAL') 510 dynS5 = '-' 511 ns5 = -1 512 hypS5(:,:) = 1 513 matS5(:) = '-' 514 READ(1,NML=S5,END=5006,ERR=5006) 515 516 IF ((dynS5.NE.'I').AND.(dynS5.NE.'M'))THEN 517 TYPE *, ' Check dynS5 in namelist S5' 518 TYPE *, ' Program aborting' 519 PAUSE 520 STOP 521 ENDIF 522 523 IF (ns5.LT.2) THEN 524 TYPE *, ' Check ns5 in namelist S5' 525 TYPE *, ' Program aborting' 526 PAUSE 527 STOP 528 ENDIF 529 530 IF (dynS5.EQ.'I') THEN 531 DO J = 1,ns5 532 IF (hypS5(J,1).LE.0) THEN 533 TYPE *, ' Check hypS5 in namelist S5' 534 TYPE *, ' Program aborting' 535 PAUSE 536 STOP 537 ENDIF 538 ENDDO 539 ELSEIF (dynS5.EQ.'M') THEN 540 DO J = 1,ns5 541 DO K = 1,ns5 542 IF (hypS5(J,K).LE.0) THEN 543 TYPE *, ' Check hypS5 in namelist S5' 544 TYPE *, ' Program aborting' 545 PAUSE 546 STOP 547 ENDIF 548 ENDDO 549 ENDDO 550 ENDIF 551 552 IF ((matS5(1).EQ.'-').OR.((matS5(1).NE.'a') 553 # .AND.(matS5(1).NE.'H').AND.(matS5(1).NE.'G') 554 # .AND.(matS5(1).NE.'c').AND.(matS5(1).NE.'F') 555 # .AND.(matS5(1).NE.'R'))) THEN 556 TYPE *, ' Check matS5 in namelist S5' 557 TYPE *, ' Program aborting' 558 PAUSE 559 STOP 560 ENDIF 561 DO I = 2,6 562 IF ((matS5(I).NE.'-').AND.(matS5(I).NE.'a') 563 # .AND.(matS5(I).NE.'H').AND.(matS5(I).NE.'G') 564 # .AND.(matS5(I).NE.'c').AND.(matS5(I).NE.'F') 565 # .AND.(matS5(I).NE.'R')) THEN 566 TYPE *, ' Check matS5 in namelist S5' 567 TYPE *, ' Program aborting' 568 PAUSE 569 STOP 570 ENDIF 571 ENDDO 572 ENDIF 573 CLOSE(1) 574 575 IF (nv.GT.5) THEN 576C FIND namelist S6 577 OPEN(1,File=TRIM(FILEIN), ACCESS='SEQUENTIAL') 578 IFAIL = -1 579 DO WHILE (.NOT.EOF(1)) 580 READ(1,'(A)') STR 581 IF (INDEX(STR,'&S6').GT.0) IFAIL = 0 582 ENDDO 583 CLOSE(1) 584 IF (IFAIL.EQ.-1) THEN 585 TYPE *, ' Namlist S6 not found' 586 TYPE *, ' Program aborting' 587 PAUSE 588 RETURN 589 ENDIF 590 591C READ namelist S6 592 OPEN(1,File=TRIM(FILEIN), ACCESS='SEQUENTIAL') 593 dynS6 = '-' 594 ns6 = -1 595 hypS6(:,:) = 1 596 matS6(:) = '-' 597 READ(1,NML=S6,END=5007,ERR=5007) 598 599 IF ((dynS6.NE.'I').AND.(dynS6.NE.'M'))THEN 600 TYPE *, ' Check dynS6 in namelist S6' 601 TYPE *, ' Program aborting' 602 PAUSE 603 STOP 604 ENDIF 605 606 IF (ns6.LT.2) THEN 607 TYPE *, ' Check ns6 in namelist S6' 608 TYPE *, ' Program aborting' 609 PAUSE 610 STOP 611 ENDIF 612 613 IF (dynS6.EQ.'I') THEN 614 DO J = 1,ns6 615 IF (hypS6(J,1).LE.0) THEN 616 TYPE *, ' Check hypS6 in namelist S6' 617 TYPE *, ' Program aborting' 618 PAUSE 619 STOP 620 ENDIF 621 ENDDO 622 ELSEIF (dynS6.EQ.'M') THEN 623 DO J = 1,ns6 624 DO K = 1,ns6 625 IF (hypS6(J,K).LE.0) THEN 626 TYPE *, ' Check hypS6 in namelist S6' 627 TYPE *, ' Program aborting' 628 PAUSE 629 STOP 630 ENDIF 631 ENDDO 632 ENDDO 633 ENDIF 634 635 IF ((matS6(1).EQ.'-').OR.((matS6(1).NE.'a') 636 # .AND.(matS6(1).NE.'H').AND.(matS6(1).NE.'G') 637 # .AND.(matS6(1).NE.'c').AND.(matS6(1).NE.'F') 638 # .AND.(matS6(1).NE.'R'))) THEN 639 TYPE *, ' Check matS6 in namelist S6' 640 TYPE *, ' Program aborting' 641 PAUSE 642 STOP 643 ENDIF 644 DO I = 2,6 645 IF ((matS6(I).NE.'-').AND.(matS6(I).NE.'a') 646 # .AND.(matS6(I).NE.'H').AND.(matS6(I).NE.'G') 647 # .AND.(matS6(I).NE.'c').AND.(matS6(I).NE.'F') 648 # .AND.(matS6(I).NE.'R')) THEN 649 TYPE *, ' Check matS6 in namelist S6' 650 TYPE *, ' Program aborting' 651 PAUSE 652 STOP 653 ENDIF 654 ENDDO 655 ENDIF 656 CLOSE(1) 657 658C FIND namelist prior 659 OPEN(1,File=TRIM(FILEIN), ACCESS='SEQUENTIAL') 660 IFAIL = -1 661 DO WHILE (.NOT.EOF(1)) 662 READ(1,'(A)') STR 663 IF (INDEX(STR,'&prior').GT.0) IFAIL = 0 664 ENDDO 665 CLOSE(1) 666 IF (IFAIL.EQ.-1) THEN 667 TYPE *, ' Namelist prior not found' 668 TYPE *, ' Program aborting' 669 PAUSE 670 RETURN 671 ENDIF 672C READ namelist prior 673 OPEN(1,File=TRIM(FILEIN), ACCESS='SEQUENTIAL') 674 nt = 0 675 pdftheta(:) = ' ' 676 hyptheta(:,:) = -1 677 READ(1,NML = prior,END=5008,ERR=5008) 678 IF (nt.LE.0) THEN 679 TYPE *, ' Check nt in namelist prior' 680 TYPE *, ' Program aborting' 681 PAUSE 682 STOP 683 ENDIF 684 IF (nt.GT.200) THEN 685 TYPE *, ' nt is too large ' 686 TYPE *, ' Program aborting' 687 PAUSE 688 STOP 689 ENDIF 690 IF (estimation.EQ.'BA') THEN 691 DO I = 1,nt 692 WRITE(IC,'(I3)') I 693 IF ((pdftheta(I).NE.'BE').AND.(pdftheta(I).NE.'NT').AND. 694 # (pdftheta(I).NE.'IG')) THEN 695 TYPE *, ' Check pdftheta('//IC//') in namelist prior' 696 TYPE *, ' Program aborting' 697 PAUSE 698 STOP 699 ENDIF 700 IF (hyptheta(3,I).GT.hyptheta(4,I)) THEN 701 TYPE *, ' Check hyptheta('//IC//') in namelist prior' 702 TYPE *, ' Program aborting' 703 PAUSE 704 STOP 705 ENDIF 706 IF (pdftheta(I).EQ.'BE') THEN 707 IF (hyptheta(3,I).LT.hyptheta(4,I)) THEN 708 IF ((hyptheta(1,I).LE.0.).OR.(hyptheta(2,I).LE.0.).OR. 709 # (hyptheta(3,I).GT.hyptheta(4,I))) THEN 710 TYPE *, ' Check hyptheta('//IC//') in namelist prior' 711 TYPE *, ' Program aborting' 712 PAUSE 713 STOP 714 ENDIF 715 ENDIF 716 ELSEIF (pdftheta(I).EQ.'NT') THEN 717 IF (hyptheta(3,I).LT.hyptheta(4,I)) THEN 718 IF ((hyptheta(2,I).LE.0.).OR.(hyptheta(3,I).GT.hyptheta(4,I))) 719 # THEN 720 TYPE *, ' Check hyptheta('//IC//') in namelist prior' 721 TYPE *, ' Program aborting' 722 PAUSE 723 STOP 724 ENDIF 725 ENDIF 726 ELSEIF (pdftheta(I).EQ.'IG') THEN 727 IF (hyptheta(3,I).LT.hyptheta(4,I)) THEN 728 IF ((hyptheta(1,I).LE.0.).OR.(hyptheta(2,I).LE.0.).OR. 729 # (hyptheta(3,I).GT.hyptheta(4,I)).OR.(hyptheta(3,I).LT.0.))THEN 730 TYPE *, ' Check hyptheta('//IC//') in namelist prior' 731 TYPE *, ' Program aborting' 732 PAUSE 733 STOP 734 ENDIF 735 ENDIF 736 ENDIF 737 ENDDO 738 ELSE 739 DO I = 1,nt ! ML check 740 WRITE(IC,'(I3)') I 741 IF (hyptheta(3,I).GT.hyptheta(4,I)) THEN 742 TYPE *, ' Check hyptheta('//IC//') in namelist prior' 743 TYPE *, ' Program aborting' 744 PAUSE 745 STOP 746 ENDIF 747 ENDDO 748 ENDIF 749 CLOSE(1) 750 751C FIND namelist mcmc 752 OPEN(1,File=TRIM(FILEIN), ACCESS='SEQUENTIAL') 753 IFAIL = -1 754 DO WHILE (.NOT.EOF(1)) 755 READ(1,'(A)') STR 756 IF (INDEX(STR,'&mcmc').GT.0) IFAIL = 0 757 ENDDO 758 CLOSE(1) 759 IF (IFAIL.EQ.-1) THEN 760 TYPE *, ' Namelist mcmc not found' 761 TYPE *, ' Program aborting' 762 PAUSE 763 RETURN 764 ENDIF 765 766C READ namelist mcmc 767 OPEN(1,File=TRIM(FILEIN), ACCESS='SEQUENTIAL') 768 seed = 0 769 thin = 1 770 burnin = 1000 771 simulrec = 5000 772 sampler = 'SL' 773 Ssampler = 'GCK' 774 hbl = 1 775 MargLik = 'N' 776 READ(1,NML=mcmc,END=5009,ERR=5009) 777 IF ((seed.LT.0).OR.(seed.GT.999)) THEN 778 TYPE *, ' Check seed in namelist mcmc' 779 TYPE *, ' Program aborting' 780 PAUSE 781 STOP 782 ENDIF 783 IF (thin.LT.1) THEN 784 TYPE *, ' Check thin in namelist mcmc' 785 TYPE *, ' Program aborting' 786 PAUSE 787 STOP 788 ENDIF 789 IF (burnin.LE.0) THEN 790 TYPE *, ' Check burnin in namelist mcmc' 791 TYPE *, ' Program aborting' 792 PAUSE 793 STOP 794 ENDIF 795 IF (simulrec.LE.1) THEN 796 TYPE *, ' Check simulrec in namelist mcmc' 797 TYPE *, ' Program aborting' 798 PAUSE 799 STOP 800 ENDIF 801 IF ((sampler.NE.'SL').AND.(sampler.NE.'MH')) THEN 802 TYPE *, ' Check sampler in namelist mcmc' 803 TYPE *, ' Program aborting' 804 PAUSE 805 STOP 806 ENDIF 807 808c IF ((Ssampler.NE.'GCK').AND.(Ssampler.NE.'AMH') 809c # .AND.(Ssampler.NE.'MH ')) THEN 810c TYPE *, ' Check Ssampler in namelist mcmc' 811c TYPE *, ' Program aborting' 812c PAUSE 813c STOP 814c ENDIF 815c IF ((hbl.GT.1).AND.(Ssampler.EQ.'GCK')) THEN 816c TYPE *, ' Check hbl in namelist mcmc' 817c TYPE *, ' Program aborting' 818c PAUSE 819c STOP 820c ENDIF 821 822 CLOSE(1) 823 824C FIND namelist dataset 825 OPEN(1,File=TRIM(FILEIN), ACCESS='SEQUENTIAL') 826 IFAIL = -1 827 DO WHILE (.NOT.EOF(1)) 828 READ(1,'(A)') STR 829 IF (INDEX(STR,'&dataset').GT.0) IFAIL = 0 830 ENDDO 831 CLOSE(1) 832 IF (IFAIL.EQ.-1) THEN 833 TYPE *, ' Namelist dataset not found' 834 TYPE *, ' Program aborting' 835 PAUSE 836 RETURN 837 ENDIF 838C READ namelist dataset 839 OPEN(1,File=TRIM(FILEIN), ACCESS='SEQUENTIAL') 840 ny = -1 841 nz = -1 842 nf = 0 843 datasim = 'N' 844 READ(1,NML=dataset,END=5010,ERR=5010) 845 IF ((T.LE.0).OR.(T.GT.3000)) THEN 846 TYPE *, ' Check T in namelist dataset (T<=3000)' 847 TYPE *, ' Program aborting' 848 PAUSE 849 STOP 850 ENDIF 851 IF (ny.LE.0) THEN 852 TYPE *, ' Check ny in namelist dataset' 853 TYPE *, ' Program aborting' 854 PAUSE 855 STOP 856 ENDIF 857 IF (nz.LT.0) THEN 858 TYPE *, ' Check nz in namelist dataset' 859 TYPE *, ' Program aborting' 860 PAUSE 861 STOP 862 ENDIF 863 IF (nf.LT.0) THEN 864 TYPE *, ' Check nf in namelist dataset' 865 TYPE *, ' Program aborting' 866 PAUSE 867 STOP 868 ENDIF 869 IF (T.LT.hbl) THEN 870 TYPE *, ' Check hbl in namelist mcmc (hbl > T)' 871 TYPE *, ' Program aborting' 872 PAUSE 873 STOP 874 ENDIF 875 IF ((datasim.NE.'N').AND.(datasim.NE.'n').AND. 876 & (datasim.NE.'y').AND.(datasim.NE.'Y')) THEN 877 datasim = 'N' 878 ENDIF 879 880 CLOSE(1) 881 882C ----------------------------------------------------------------------- 883C ASSIGN discrete latent variables: INFOS (9 x nv) 884C by cols: S1,S2,...,SNV; with nv <=6 885C by row: the 1st contains the # of matrices affected by Si 886C the 2nd-3rd etc point to c (1),H (2),G (3),a (4),F (5),R (6) 887C the 8-th row contains the # of states 888C the 9-th row spec. the dynamic of Sj (0-deterministic,1=Indep,2=Markov) 889C nstot: total # of states i.e. ns1 x ns2 x ...x nsv 890C np(1): total # of psi parameters 891C np(2): total # of idependent PSI-Dirichlet vectors 892C np(3): max # of hyperparameters for psi 893C ----------------------------------------------------------------------- 894 INFOS(:,:) = 0 895 INFOS(8,:) = 1 ! number of states 896 ns(:) = 1 897 np(:) = 0 898 IF (nv.GT.0) THEN 899 ALLOCATE(matS(6,6),dynS(6),nstateS(6)) 900 matS(:,1) = matS1(:) 901 matS(:,2) = matS2(:) 902 matS(:,3) = matS3(:) 903 matS(:,4) = matS4(:) 904 matS(:,5) = matS5(:) 905 matS(:,6) = matS6(:) 906 hypS(:,:,1) = hypS1(:,:) 907 hypS(:,:,2) = hypS2(:,:) 908 hypS(:,:,3) = hypS3(:,:) 909 hypS(:,:,4) = hypS4(:,:) 910 hypS(:,:,5) = hypS5(:,:) 911 hypS(:,:,6) = hypS6(:,:) 912 dynS(1) = dynS1 913 dynS(2) = dynS2 914 dynS(3) = dynS3 915 dynS(4) = dynS4 916 dynS(5) = dynS5 917 dynS(6) = dynS6 918 nstateS(1) = ns1 919 nstateS(2) = ns2 920 nstateS(3) = ns3 921 nstateS(4) = ns4 922 nstateS(5) = ns5 923 nstateS(6) = ns6 924 IMAX = MAXLOC(nstateS(1:nv)) 925 np(2) = 0 926 np(3) = nstateS(IMAX(1)) 927 DO 50 J = 1,nv 928 K = 0 929 DO 40 I = 1,6 930 IF(matS(I,J).EQ.'c') THEN 931 K = K + 1 932 IND = 1 933 INFOS(K+1,J) = IND ! Matrices affected by SJ 934 ENDIF 935 IF(matS(I,J).EQ.'H') THEN 936 K = K + 1 937 IND = 2 938 INFOS(K+1,J) = IND 939 ENDIF 940 IF(matS(I,J).EQ.'G') THEN 941 K = K + 1 942 IND = 3 943 INFOS(K+1,J) = IND 944 ENDIF 945 IF(matS(I,J).EQ.'a') THEN 946 K = K + 1 947 IND = 4 948 INFOS(K+1,J) = IND 949 ENDIF 950 IF(matS(I,J).EQ.'F') THEN 951 K = K + 1 952 IND = 5 953 INFOS(K+1,J) = IND 954 ENDIF 955 IF(matS(I,J).EQ.'R') THEN 956 K = K + 1 957 IND = 6 958 INFOS(K+1,J) = IND 959 ENDIF 96040 CONTINUE 961 INFOS(1,J) = K ! # of matrix affected by SJ 962 INFOS(8,J) = nstateS(J) ! # of states for SJ 963 IF (dynS(J).EQ.'I') THEN 964 INFOS(9,J) = 1 ! dynamics for Sj 965 np(2) = np(2) + 1 966 np(1) = np(1) + nstateS(J)-1 967 ELSEIF (dynS(J).EQ.'M') THEN 968 INFOS(9,J) = 2 969 np(2) = np(2) + nstateS(J) 970 np(1) = np(1) + (nstateS(J)-1)*nstateS(J) 971 ENDIF 97250 CONTINUE 973 974 DO 60 I = 1,nv 975 DO 60 J = 1,INFOS(1,I) 97660 ns(INFOS(J+1,I)) = INFOS(8,I) 977 nstot = PRODUCT(INFOS(8,1:nv)) ! total # of states 978 979 DEALLOCATE(matS,dynS,nstateS) 980 ENDIF 981 982 GO TO 7777 983 9845000 TYPE *,'Input file not found' 985 TYPE *,'Program aborting' 986 PAUSE 987 STOP 988 9895001 TYPE *,'Input error in namelist ssm' 990 TYPE *,'Program aborting' 991 PAUSE 992 STOP 9935002 TYPE *,'Input error in namelist S1 ' 994 TYPE *,'Program aborting' 995 PAUSE 996 STOP 9975003 TYPE *,'Input error in namelist S2 ' 998 TYPE *,'Program aborting' 999 PAUSE 1000 STOP 10015004 TYPE *,'Input error in namelist S3 ' 1002 TYPE *,'Program aborting' 1003 PAUSE 1004 STOP 10055005 TYPE *,'Input error in namelist S4 ' 1006 TYPE *,'Program aborting' 1007 PAUSE 1008 STOP 10095006 TYPE *,'Input error in namelist S5 ' 1010 TYPE *,'Program aborting' 1011 PAUSE 1012 STOP 10135007 TYPE *,'Input error in namelist S6 ' 1014 TYPE *,'Program aborting' 1015 PAUSE 1016 STOP 10175008 TYPE *,'Input error in namelist prior' 1018 TYPE *,'Program aborting' 1019 PAUSE 1020 STOP 10215009 TYPE *,'Input error in namelist mcmc' 1022 TYPE *,'Program aborting' 1023 PAUSE 1024 STOP 10255010 TYPE *,'Input error in namelist dataset' 1026 TYPE *,'Program aborting' 1027 PAUSE 1028 STOP 1029 10307777 RETURN 1031 END 1032