1#ifndef __LINE__ 2#define __LINE__ 0 3#endif 4 subroutine tce_input(rtdb) 5! 6! $Id$ 7! 8! Input parser for TCE module for various many-electron theories. 9! Also sets default values for input parameters. 10! Modified from tddft/tddft_input.F by So Hirata Oct, 2002. 11! 12! TCE 13! [(DFT||HF||SCF) default HF] 14! [FREEZE [[core] (atomic || <integer nfzc default 0>)] 15! [virtual <integer nfzv default 0>]] 16! [(LCCD||CCD||CCSD||LCCSD||CCSDT||CCSDTQ|| 17! CCSD(T)||CCSD[T]||QCISD||CISD||CISDT||CISDTQ|| 18! MBPT2||MBPT3||MBPT4||MP2||MP3||MP4|| \ 19! CR-CCSD(T)||CR-CCSD[T]||LR-CCSD(T)||LR-CCSD(TQ)||CCSD(2)_T||CCSD(2)|| 20! CCSDT(2)_Q) default CCSD] 21! [THRESH <double thresh default 1e-6>] 22! [MAXITER <integer maxiter default 100>] 23! [PRINT (none||low||medium||high||debug)] 24! [IO (fortran||eaf||ga||sf||replicated||dra||ga_eaf) default ga] 25! [DIIS <integer diis default 5>] 26! [EOMSOL <integer default 1 >] 27! [DIIS2 <integer diis default 5>] 28! [DIIS3 <integer diis default 5>] 29! [NROOTS <integer nroots default 0>] 30! [TARGET <integer target default 1>] 31! [TARGETSYM <character targetsym default 'none'>] 32! [SYMMETRY] 33! [DIPOLE] 34! [TILESIZE <no default (automatically adjusted)>] 35! [FRAGMENT <default -1 (off)>] 36! [(NO)FOCK <logical recompf default .true.>] 37! [ACTIVE_OA <default 0>] 38! [ACTIVE_OB <default 0>] 39! [ACTIVE_VA <default 0>] 40! [ACTIVE_VB <default 0>] 41! [T3A_LVL <default 0>] 42! END 43! 44! TASK TCE ENERGY 45! 46! ... or ... 47! 48! UCCSDT or UCC or UCCSD(T) etc. 49! [(DFT||HF||SCF) default HF] 50! [FREEZE [[core] (atomic || <integer nfzc default 0>)] 51! [virtual <integer nfzv default 0>]] 52! [THRESH <double thresh default 1e-6>] 53! [MAXITER <integer maxiter default 100>] 54! [PRINT (none||low||medium||high||debug)] 55! [IO (fortran||c||ga||sf||replicated) default ga] 56! [DIIS <integer diis default 5>] 57! [NROOTS <integer nroots default 0>] 58! [TARGET <integer target default 1>] 59! [TARGETSYM <character targetsym default 'none'>] 60! [SYMMETRY] 61! [DIPOLE] 62! [TILESIZE <no default (automatically adjusted)>] 63! [FRAGMENT <default -1 (off)>] 64! [(NO)FOCK <logical recompf default .true.>] 65! [ACTIVE_OA <default 0>] 66! [ACTIVE_OB <default 0>] 67! [ACTIVE_VA <default 0>] 68! [ACTIVE_VB <default 0>] 69! END 70! 71! TASK UCCSDT ENERGY 72! 73! ... etc. 74! 75 implicit none 76#include "inp.fh" 77#include "rtdb.fh" 78#include "mafdecls.fh" 79#include "errquit.fh" 80#include "stdio.fh" 81 integer rtdb 82 character*20 test 83 integer maxiter 84 character*10 model 85 character*10 model2e 86 character*10 module 87 double precision thresh 88 double precision maxdiff ! new 89 character*10 ioalgchar 90 integer ioalg 91 integer reference 92 integer diis,diis2,diis3 93 integer eomsol 94! --- level shift -- 95 double precision zlshift,zlshiftl,zlshift2(2),zlshift3(2) 96! ------------------ 97 integer nroots 98 integer target 99 integer tilesize 100 integer fragment 101 character*4 targetsym 102 logical symmetry 103 logical left 104! --- density matrix 105 logical idens 106 character*256 file_densmat 107!<-d3p975 108 integer multipole 109 logical recompf 110 character*10 perturbative 111 character*10 ccsd_var 112 integer oactive(2) 113 integer vactive(2) 114 integer numact 115! --- ccsd_act/eomccsd_act --- 116 integer uact,oact 117 double precision emin_act,emax_act 118! --- 4 index transform. --- 119 integer maxs,ichopx,i4im,idiskx 120! --- EOM solver 121 integer hbard 122 123! --- TCE_CUDA 124 integer icuda 125!kbn --- EA/IPCCSD 126#ifdef EACCSD 127 logical eaccsd 128#endif 129#ifdef IPCCSD 130 logical ipccsd 131#endif 132 133! 134! ------------------------------------- 135! What input block are we dealing with? 136! ------------------------------------- 137! 138 if (.not.rtdb_cget(rtdb,'tce:module',1,module)) 139 1 call errquit('tce_input: failed reading from rtdb',0, 140 2 RTDB_ERR) 141! 142! ------------------ 143! Set default values 144! ------------------ 145! 146! DFT, HF, or SCF (reference wavefunction) 147! 148 reference=1 149 if (.not.rtdb_put(rtdb,'tce:reference',mt_int,1,reference)) 150 1 call errquit('tce_input: failed writing to rtdb',0, 151 2 RTDB_ERR) 152! 153! FREEZE (frozen cores/virtuals) 154! 155! no action is taken 156! 157! MODEL (the name of CC model requested) 158! 159! no action is taken 160! 161! THRESH (convergence threshold for Davidson iteration) 162! 163 thresh=1.0d-7 164 if (.not.rtdb_put(rtdb,'tce:thresh',mt_dbl,1,thresh)) 165 1 call errquit('tce_input: failed writing to rtdb',0, 166 2 RTDB_ERR) 167! 168! LEVEL SHIFT (for singles and doubles) 169! 170 zlshift=0.0d0 171 if (.not.rtdb_put(rtdb,'tce:zlshift',mt_dbl,1,zlshift)) 172 1 call errquit('tce_input: failed writing to rtdb',0, 173 2 RTDB_ERR) 174 zlshiftl=0.0d0 175 if (.not.rtdb_put(rtdb,'tce:zlshiftl',mt_dbl,1,zlshiftl)) 176 1 call errquit('tce_input: failed writing to rtdb',0, 177 2 RTDB_ERR) 178 zlshift2(1)=0.0d0 179 zlshift2(2)=0.0d0 180 if (.not.rtdb_put(rtdb,'tce:zlshift2',mt_dbl,2,zlshift2)) 181 1 call errquit('tce_input: failed writing to rtdb',0, 182 2 RTDB_ERR) 183 zlshift3(1)=0.0d0 184 zlshift3(2)=0.0d0 185 if (.not.rtdb_put(rtdb,'tce:zlshift3',mt_dbl,2,zlshift3)) 186 1 call errquit('tce_input: failed writing to rtdb',0, 187 2 RTDB_ERR) 188! 189! MAXITER (the maximum number of Davidson iterations) 190! 191 maxiter=100 192 if (.not.rtdb_put(rtdb,'tce:maxiter',mt_int,1,maxiter)) 193 1 call errquit('tce_input: failed writing to rtdb',0, 194 2 RTDB_ERR) 195! 196! IO (I/O method, 0 = Fortran Direct Access, 197! 1 = C Low-Level I/O, 198! 2 = GA Library, 199! 3 = SF library, 200! 4 = Replicated C Low-Level I/O) 201! 202 ioalg=2 203 if (.not.rtdb_put(rtdb,'tce:ioalg',mt_int,1,ioalg)) 204 1 call errquit('tce_input: failed writing to rtdb',0, 205 2 RTDB_ERR) 206! 207! DIIS (the vector space size in DIIS) 208! 209 diis=5 210 if (.not.rtdb_put(rtdb,'tce:diis',mt_int,1,diis)) 211 1 call errquit('tce_input: failed writing to rtdb',0, 212 2 RTDB_ERR) 213 diis2=5 214 if (.not.rtdb_put(rtdb,'tce:diis2',mt_int,1,diis2)) 215 1 call errquit('tce_input: failed writing to rtdb',0, 216 2 RTDB_ERR) 217 diis3=5 218 if (.not.rtdb_put(rtdb,'tce:diis3',mt_int,1,diis3)) 219 1 call errquit('tce_input: failed writing to rtdb',0, 220 2 RTDB_ERR) 221! 222! EOMCC SOLVER 223! 224 eomsol=1 225 if (.not.rtdb_put(rtdb,'tce:eoms',mt_int,1,eomsol)) 226 1 call errquit('tce_input: failed writing to rtdb',0, 227 2 RTDB_ERR) 228! 229! DIMENSION OF THE EOM ITERATIVE SPACE 230! 231 hbard=500 232 if (.not.rtdb_put(rtdb,'tce:hbard',mt_int,1,hbard)) 233 1 call errquit('tce_input: failed writing to rtdb',0, 234 2 RTDB_ERR) 235! 236! NROOTS (the number of excited state roots) 237! 238 nroots=0 239 if (.not.rtdb_put(rtdb,'tce:nroots',mt_int,1,nroots)) 240 1 call errquit('tce_input: failed writing to rtdb',0, 241 2 RTDB_ERR) 242! 243! 2e STORAGE 244! 245 model2e='default' 246 if (.not.rtdb_cput(rtdb,'tce:model2e',1,model2e)) 247 1 call errquit('tce_input: failed writing to rtdb',0, 248 2 RTDB_ERR) 249! 250! 4ind. transfromation 251! 252 maxs=30 253 if (.not.rtdb_put(rtdb,'tce:maxs',mt_int,1,maxs)) 254 1 call errquit('tce_input: failed writing to rtdb',0, 255 2 RTDB_ERR) 256! 257 ichopx=1 258 if (.not.rtdb_put(rtdb,'tce:ichopx',mt_int,1,ichopx)) 259 1 call errquit('tce_input: failed writing to rtdb',0, 260 2 RTDB_ERR) 261! 262 i4im=1 263 if (.not.rtdb_put(rtdb,'tce:i4im',mt_int,1,i4im)) 264 1 call errquit('tce_input: failed writing to rtdb',0, 265 2 RTDB_ERR) 266! 267 idiskx=0 268 if (.not.rtdb_put(rtdb,'tce:idiskx',mt_int,1,idiskx)) 269 1 call errquit('tce_input: failed writing to rtdb',0, 270 2 RTDB_ERR) 271! 272! TARGET (the target excited state for, e.g., geometry optimization) 273! 274 target=1 275 if (.not.rtdb_put(rtdb,'tce:target',mt_int,1,target)) 276 1 call errquit('tce_input: failed writing to rtdb',0, 277 2 RTDB_ERR) 278! 279! TARGETSYM (the irrep of the target excited state) 280! 281 targetsym='none' 282 if (.not.rtdb_cput(rtdb,'tce:targetsym',1,targetsym)) 283 1 call errquit('tce_input: failed writing to rtdb',0, 284 2 RTDB_ERR) 285! 286! SYMMETRY (restricts the roots to have the TARGETSYM irrep) 287! 288 symmetry=.false. 289 if (.not.rtdb_put(rtdb,'tce:symmetry',mt_log,1,symmetry)) 290 1 call errquit('tce_input: failed writing to rtdb',0, 291 2 RTDB_ERR) 292! 293! IDENS (one particle reduced density matrix) 294! 295 idens=.false. 296 if (.not.rtdb_put(rtdb,'tce:densmat',mt_log,1,idens)) 297 1 call errquit('tce_input: failed writing to rtdb',0, 298 1 rtdb_err) 299! 300! DIPOLE (dipole moments & dipole transition moments) 301! 302 left=.false. 303 if (.not.rtdb_put(rtdb,'tce:left',mt_log,1,left)) 304 1 call errquit('tce_input: failed writing to rtdb',0, 305 2 RTDB_ERR) 306! 307! MULTIPOLE LMAX (multipole moments highest angular momentum) 308! 309 multipole=0 310 if (.not.rtdb_put(rtdb,'tce:multipole',mt_int,1,multipole)) 311 1 call errquit('tce_input: failed writing to rtdb',0, 312 2 RTDB_ERR) 313! 314! FRAGMENT (fragment MO calculations) 315! 316 fragment=-1 317 if (.not.rtdb_put(rtdb,'tce:fragment',mt_int,1,fragment)) 318 1 call errquit('tce_input: failed writing to rtdb',0, 319 2 RTDB_ERR) 320! 321! (NO)FOCK (recompute fock for, e.g., DFT, ROHF refs) 322! 323 recompf=.true. 324 if (.not.rtdb_put(rtdb,'tce:recompf',mt_log,1,recompf)) 325 1 call errquit('tce_input: failed writing to rtdb',0, 326 2 RTDB_ERR) 327! 328! ACTIVE_OA,OB (Number of active occupied orbitals) 329! 330 oactive(1)=0 331 if (.not.rtdb_put(rtdb,'tce:active_oa',mt_int,1,oactive(1))) 332 1 call errquit('tce_input: failed writing to rtdb',0, 333 2 RTDB_ERR) 334 oactive(2)=0 335 if (.not.rtdb_put(rtdb,'tce:active_ob',mt_int,1,oactive(2))) 336 1 call errquit('tce_input: failed writing to rtdb',0, 337 2 RTDB_ERR) 338! 339! ccsd_act/eomccsd_act 340! 341 oact=0 342 if (.not.rtdb_put(rtdb,'tce:oact',mt_int,1,oact)) 343 1 call errquit('tce_input: failed writing to rtdb',0, 344 2 RTDB_ERR) 345 uact=0 346 if (.not.rtdb_put(rtdb,'tce:uact',mt_int,1,uact)) 347 1 call errquit('tce_input: failed writing to rtdb',0, 348 2 RTDB_ERR) 349! 350 emin_act=0.0d0 351 if (.not.rtdb_put(rtdb,'tce:eactmin',mt_dbl,1,emin_act)) 352 1 call errquit('tce_input: rtdb eactmin problem',0, 353 2 RTDB_ERR) 354 emax_act=0.0d0 355 if (.not.rtdb_put(rtdb,'tce:eactmax',mt_dbl,1,emax_act)) 356 1 call errquit('tce_input: rtdb eactmax problem',0, 357 2 RTDB_ERR) 358! 359! ACTIVE_VA,VB (Number of active virtual orbitals) 360! 361 vactive(1)=0 362 if (.not.rtdb_put(rtdb,'tce:active_va',mt_int,1,vactive(1))) 363 1 call errquit('tce_input: failed writing to rtdb',0, 364 2 RTDB_ERR) 365 vactive(2)=0 366 if (.not.rtdb_put(rtdb,'tce:active_vb',mt_int,1,vactive(2))) 367 1 call errquit('tce_input: failed writing to rtdb',0, 368 2 RTDB_ERR) 369! 370! ACTIVE EXCITATION LEVEL (number of active orbitals in T3) 371! 372 numact=0 373 if (.not.rtdb_put(rtdb,'tce:act_excit_lvl',mt_int,1,numact)) 374 1 call errquit('tce_input: failed writing to rtdb',0, 375 2 RTDB_ERR) 376! 377! ---------- 378! Read input 379! ---------- 380! 381 10 if (.not. inp_read()) 382 1 call errquit('tce_input: failed reading input',0, 383 2 RTDB_ERR) 384 if (.not. inp_a(test)) 385 1 call errquit('tce_input: failed reading keyword',0, 386 2 RTDB_ERR) 387! 388! DFT, HF, or SCF (reference wavefunction) 389! 390 if (inp_compare(.false.,test,'dft')) then 391 reference=0 392 if (.not.rtdb_put(rtdb,'tce:reference',mt_int,1,reference)) 393 1 call errquit('tce_input: failed writing to rtdb',0, 394 2 RTDB_ERR) 395 else if (inp_compare(.false.,test,'hf')) then 396 reference=1 397 if (.not.rtdb_put(rtdb,'tce:reference',mt_int,1,reference)) 398 1 call errquit('tce_input: failed writing to rtdb',0, 399 2 RTDB_ERR) 400 else if (inp_compare(.false.,test,'scf')) then 401 reference=1 402 if (.not.rtdb_put(rtdb,'tce:reference',mt_int,1,reference)) 403 1 call errquit('tce_input: failed writing to rtdb',0, 404 2 RTDB_ERR) 405! 406! FREEZE (frozen cores/virtuals) 407! 408 else if (inp_compare(.false.,test,'freeze')) then 409 call freeze_input(rtdb,'tce') 410! 411! STORAGE OF 2-e INTEGRALS 412! 413 else if (inp_compare(.false.,test,'2eorb')) then 414 if (module.eq.'tce') then 415 model2e='2eorb' 416 if (.not.rtdb_cput(rtdb,'tce:model2e',1,model2e)) 417 1 call errquit('tce_input: failed writing to rtdb',0, 418 2 RTDB_ERR) 419 else 420 call errquit('tce_input: multiple theory inputs',0, 421 1 INPUT_ERR) 422 endif 423 else if (inp_compare(.false.,test,'2espin')) then 424 if (module.eq.'tce') then 425 model2e='2espin' 426 if (.not.rtdb_cput(rtdb,'tce:model2e',1,model2e)) 427 1 call errquit('tce_input: failed writing to rtdb',0, 428 2 RTDB_ERR) 429 else 430 call errquit('tce_input: multiple theory inputs',0, 431 1 INPUT_ERR) 432 endif 433! 434! MODEL (the name of theory requested) 435! 436 else if (inp_compare(.false.,test,'multi')) then 437 if (module.eq.'tce') then 438 model='multi' 439 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 440 1 call errquit('tce_input: failed writing to rtdb',0, 441 2 RTDB_ERR) 442 else 443 call errquit('tce_input: multiple theory inputs',0, 444 2 INPUT_ERR) 445 endif 446 else if (inp_compare(.false.,test,'eionly')) then 447 if (module.eq.'tce') then 448 model='eionly' 449 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 450 1 call errquit('tce_input: failed writing to rtdb',0, 451 2 RTDB_ERR) 452 else 453 call errquit('tce_input: multiple theory inputs',0, 454 2 INPUT_ERR) 455 endif 456 else if (inp_compare(.false.,test,'ccd')) then 457 if (module.eq.'tce') then 458 model='ccd' 459 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 460 1 call errquit('tce_input: failed writing to rtdb',0, 461 2 RTDB_ERR) 462 else 463 call errquit('tce_input: multiple theory inputs',0, 464 2 INPUT_ERR) 465 endif 466 else if (inp_compare(.false.,test,'lccd')) then 467 if (module.eq.'tce') then 468 model='lccd' 469 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 470 1 call errquit('tce_input: failed writing to rtdb',0, 471 2 RTDB_ERR) 472 else 473 call errquit('tce_input: multiple theory inputs',0, 474 1 INPUT_ERR) 475 endif 476 else if (inp_compare(.false.,test,'ccsd')) then 477 if (module.eq.'tce') then 478 model='ccsd' 479 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 480 1 call errquit('tce_input: failed writing to rtdb',0, 481 2 RTDB_ERR) 482 else 483 call errquit('tce_input: multiple theory inputs',0, 484 1 INPUT_ERR) 485 endif 486! ccsd_act/eomccsd_act 487 else if (inp_compare(.false.,test,'ccsd_act')) then 488 if (module.eq.'tce') then 489 model='ccsd_act' 490 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 491 1 call errquit('tce_input: failed writing to rtdb',0, 492 2 RTDB_ERR) 493 else 494 call errquit('tce_input: multiple theory inputs',0, 495 1 INPUT_ERR) 496 endif 497 else if (inp_compare(.false.,test,'lccsd')) then 498 if (module.eq.'tce') then 499 model='lccsd' 500 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 501 1 call errquit('tce_input: failed writing to rtdb',0, 502 2 RTDB_ERR) 503 else 504 call errquit('tce_input: multiple theory inputs',0, 505 1 INPUT_ERR) 506 endif 507 else if (inp_compare(.false.,test,'lccsd(t)')) then 508 if (module.eq.'tce') then 509 model='lccsd' 510 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 511 1 call errquit('tce_input: failed writing to rtdb',0, 512 2 RTDB_ERR) 513 perturbative='(t)' 514 if (.not.rtdb_cput(rtdb,'tce:perturbative',1,perturbative)) 515 1 call errquit('tce_input: failed writing to rtdb',0, 516 2 RTDB_ERR) 517 else 518 call errquit('tce_input: multiple theory inputs',0, 519 1 INPUT_ERR) 520 endif 521 else if (inp_compare(.false.,test,'cr-lccsd(t)')) then 522 if (module.eq.'tce') then 523 model='lccsd' 524 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 525 1 call errquit('tce_input: failed writing to rtdb',0, 526 2 RTDB_ERR) 527 perturbative='cr_(t)' 528 if (.not.rtdb_cput(rtdb,'tce:perturbative',1,perturbative)) 529 1 call errquit('tce_input: failed writing to rtdb',0, 530 2 RTDB_ERR) 531 else 532 call errquit('tce_input: multiple theory inputs',0, 533 1 INPUT_ERR) 534 endif 535! ccsd_act/eomccsd_act 536 else if (inp_compare(.false.,test,'crsd(t)ac')) then 537 if (module.eq.'tce') then 538 model='ccsd_act' 539 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 540 1 call errquit('tce_input: failed writing to rtdb',0, 541 2 RTDB_ERR) 542 perturbative='cr_(t)a' 543 if (.not.rtdb_cput(rtdb,'tce:perturbative',1,perturbative)) 544 1 call errquit('tce_input: failed writing to rtdb',0, 545 2 RTDB_ERR) 546 else 547 call errquit('tce_input: multiple theory inputs',0, 548 1 INPUT_ERR) 549 endif 550 else if (inp_compare(.false.,test,'ccsdta')) then 551 if (module.eq.'tce') then 552 model='ccsdta' 553 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 554 1 call errquit('tce_input: failed writing to rtdb',0, 555 2 RTDB_ERR) 556 else 557 call errquit('tce_input: multiple theory inputs',0, 558 1 INPUT_ERR) 559 endif 560 else if (inp_compare(.false.,test,'ccsdt')) then 561 if (module.eq.'tce') then 562 model='ccsdt' 563 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 564 1 call errquit('tce_input: failed writing to rtdb',0, 565 2 RTDB_ERR) 566 else 567 call errquit('tce_input: multiple theory inputs',0, 568 1 INPUT_ERR) 569 endif 570 else if (inp_compare(.false.,test,'ccsdtq')) then 571 if (module.eq.'tce') then 572 model='ccsdtq' 573 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 574 1 call errquit('tce_input: failed writing to rtdb',0, 575 2 RTDB_ERR) 576 else 577 call errquit('tce_input: multiple theory inputs',0, 578 1 INPUT_ERR) 579 endif 580 else if (inp_compare(.false.,test,'cc2')) then 581 if (module.eq.'tce') then 582 model='ccsd' 583 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 584 1 call errquit('tce_input: failed writing to rtdb',0, 585 2 RTDB_ERR) 586 ccsd_var='cc2' 587 if (.not.rtdb_cput(rtdb,'tce:ccsdvar',1,ccsd_var)) 588 1 call errquit('tce_input: failed writing to rtdb',0, 589 2 RTDB_ERR) 590 else 591 call errquit('tce_input: multiple theory inputs',0, 592 1 INPUT_ERR) 593 endif 594 else if (inp_compare(.false.,test,'lr-ccsd')) then 595 if (module.eq.'tce') then 596 model='ccsd' 597 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 598 1 call errquit('tce_input: failed writing to rtdb',0, 599 2 RTDB_ERR) 600 ccsd_var='lr-ccsd' 601 if (.not.rtdb_cput(rtdb,'tce:ccsdvar',1,ccsd_var)) 602 1 call errquit('tce_input: failed writing to rtdb',0, 603 2 RTDB_ERR) 604 else 605 call errquit('tce_input: multiple theory inputs',0, 606 1 INPUT_ERR) 607 endif 608 else if (inp_compare(.false.,test,'ccsd(t)')) then 609 if (module.eq.'tce') then 610 model='ccsd' 611 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 612 1 call errquit('tce_input: failed writing to rtdb',0, 613 2 RTDB_ERR) 614 perturbative='(t)' 615 if (.not.rtdb_cput(rtdb,'tce:perturbative',1,perturbative)) 616 1 call errquit('tce_input: failed writing to rtdb',0, 617 2 RTDB_ERR) 618 else 619 call errquit('tce_input: multiple theory inputs',0, 620 1 INPUT_ERR) 621 endif 622 else if (inp_compare(.false.,test,'ccsd[t]')) then 623 if (module.eq.'tce') then 624 model='ccsd' 625 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 626 1 call errquit('tce_input: failed writing to rtdb',0, 627 2 RTDB_ERR) 628 perturbative='[t]' 629 if (.not.rtdb_cput(rtdb,'tce:perturbative',1,perturbative)) 630 1 call errquit('tce_input: failed writing to rtdb',0, 631 2 RTDB_ERR) 632 else 633 call errquit('tce_input: multiple theory inputs',0, 634 1 INPUT_ERR) 635 endif 636 else if (inp_compare(.false.,test,'qcisd(t)')) then 637 if (module.eq.'tce') then 638 model='qcisd' 639 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 640 1 call errquit('tce_input: failed writing to rtdb',0, 641 2 RTDB_ERR) 642 perturbative='(t)' 643 if (.not.rtdb_cput(rtdb,'tce:perturbative',1,perturbative)) 644 1 call errquit('tce_input: failed writing to rtdb',0, 645 2 RTDB_ERR) 646 else 647 call errquit('tce_input: multiple theory inputs',0, 648 1 INPUT_ERR) 649 endif 650 else if (inp_compare(.false.,test,'cr-qcisd(t)')) then 651 if (module.eq.'tce') then 652 model='qcisd' 653 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 654 1 call errquit('tce_input: failed writing to rtdb',0, 655 2 RTDB_ERR) 656 perturbative='cr_(t)' 657 if (.not.rtdb_cput(rtdb,'tce:perturbative',1,perturbative)) 658 1 call errquit('tce_input: failed writing to rtdb',0, 659 2 RTDB_ERR) 660 else 661 call errquit('tce_input: multiple theory inputs',0, 662 1 INPUT_ERR) 663 endif 664! 665! 666! 667 else if (inp_compare(.false.,test,'lambda-ccsd(t)')) then 668 if (module.eq.'tce') then 669 model='ccsd' 670 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 671 1 call errquit('tce_input: failed writing to rtdb',0, 672 2 RTDB_ERR) 673 perturbative='lambda(t)' 674 if (.not.rtdb_cput(rtdb,'tce:perturbative',1,perturbative)) 675 1 call errquit('tce_input: failed writing to rtdb',0, 676 2 RTDB_ERR) 677 left=.true. 678 if (.not.rtdb_put(rtdb,'tce:left',mt_log,1,left)) 679 1 call errquit('tce_input: failed writing to rtdb',0, 680 2 RTDB_ERR) 681 else 682 call errquit('tce_input: multiple theory inputs',0, 683 1 INPUT_ERR) 684 endif 685! else if (inp_compare(.false.,test,'lambda-ccsd[t]')) then 686! if (module.eq.'tce') then 687! model='ccsd' 688! if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 689! 1 call errquit('tce_input: failed writing to rtdb',0, 690! 2 RTDB_ERR) 691! perturbative='lambda[t]' 692! if (.not.rtdb_cput(rtdb,'tce:perturbative',1,perturbative)) 693! 1 call errquit('tce_input: failed writing to rtdb',0, 694! 2 RTDB_ERR) 695! left=.true. 696! if (.not.rtdb_put(rtdb,'tce:left',mt_log,1,left)) 697! 1 call errquit('tce_input: failed writing to rtdb',0, 698! 2 RTDB_ERR) 699! else 700! call errquit('tce_input: multiple theory inputs',0, 701! 1 INPUT_ERR) 702! endif 703! 704! 705! 706 else if (inp_compare(.false.,test,'cr-ccsd(t)')) then 707 if (module.eq.'tce') then 708 model='ccsd' 709 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 710 1 call errquit('tce_input: failed writing to rtdb',0, 711 2 RTDB_ERR) 712 perturbative='cr_(t)' 713 if (.not.rtdb_cput(rtdb,'tce:perturbative',1,perturbative)) 714 1 call errquit('tce_input: failed writing to rtdb',0, 715 2 RTDB_ERR) 716 else 717 call errquit('tce_input: multiple theory inputs',0, 718 1 INPUT_ERR) 719 endif 720 else if (inp_compare(.false.,test,'lr-ccsd(t)')) then 721 if (module.eq.'tce') then 722 model='ccsd' 723 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 724 1 call errquit('tce_input: failed writing to rtdb',0, 725 2 RTDB_ERR) 726 perturbative='lr_(t)' 727 if (.not.rtdb_cput(rtdb,'tce:perturbative',1,perturbative)) 728 1 call errquit('tce_input: failed writing to rtdb',0, 729 2 RTDB_ERR) 730 else 731 call errquit('tce_input: multiple theory inputs',0, 732 1 INPUT_ERR) 733 endif 734 else if (inp_compare(.false.,test,'creomsd(t)')) then 735 if (module.eq.'tce') then 736 model='ccsd' 737 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 738 1 call errquit('tce_input: failed writing to rtdb',0, 739 2 RTDB_ERR) 740 perturbative='creom_(t)' 741 if (.not.rtdb_cput(rtdb,'tce:perturbative',1,perturbative)) 742 1 call errquit('tce_input: failed writing to rtdb',0, 743 2 RTDB_ERR) 744 else 745 call errquit('tce_input: multiple theory inputs',0, 746 1 INPUT_ERR) 747 endif 748! ccsd_act/eomccsd-act 749 else if (inp_compare(.false.,test,'creom(t)ac')) then 750 if (module.eq.'tce') then 751 model='ccsd_act' 752 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 753 1 call errquit('tce_input: failed writing to rtdb',0, 754 2 RTDB_ERR) 755 perturbative='creom(t)a' 756 if (.not.rtdb_cput(rtdb,'tce:perturbative',1,perturbative)) 757 1 call errquit('tce_input: failed writing to rtdb',0, 758 2 RTDB_ERR) 759 else 760 call errquit('tce_input: multiple theory inputs',0, 761 1 INPUT_ERR) 762 endif 763 else if (inp_compare(.false.,test,'r-creom1(t)')) then 764 if (module.eq.'tce') then 765 model='ccsd' 766 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 767 1 call errquit('tce_input: failed writing to rtdb',0, 768 2 RTDB_ERR) 769 perturbative='emb1' 770 if (.not.rtdb_cput(rtdb,'tce:perturbative',1,perturbative)) 771 1 call errquit('tce_input: failed writing to rtdb',0, 772 2 RTDB_ERR) 773 else 774 call errquit('tce_input: multiple theory inputs',0, 775 1 INPUT_ERR) 776 endif 777 else if (inp_compare(.false.,test,'r-creom2(t)')) then 778 if (module.eq.'tce') then 779 model='ccsd' 780 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 781 1 call errquit('tce_input: failed writing to rtdb',0, 782 2 RTDB_ERR) 783 perturbative='emb2' 784 if (.not.rtdb_cput(rtdb,'tce:perturbative',1,perturbative)) 785 1 call errquit('tce_input: failed writing to rtdb',0, 786 2 RTDB_ERR) 787 else 788 call errquit('tce_input: multiple theory inputs',0, 789 1 INPUT_ERR) 790 endif 791 else if (inp_compare(.false.,test,'lr-ccsd(tq)-1')) then 792 if (module.eq.'tce') then 793 model='ccsd' 794 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 795 1 call errquit('tce_input: failed writing to rtdb',0, 796 2 RTDB_ERR) 797 perturbative='lr_(tq1)' 798 if (.not.rtdb_cput(rtdb,'tce:perturbative',1,perturbative)) 799 1 call errquit('tce_input: failed writing to rtdb',0, 800 2 RTDB_ERR) 801 else 802 call errquit('tce_input: multiple theory inputs',0, 803 1 INPUT_ERR) 804 endif 805 else if (inp_compare(.false.,test,'lr-ccsd(tq)-1p')) then 806 if (module.eq.'tce') then 807 model='ccsd' 808 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 809 1 call errquit('tce_input: failed writing to rtdb',0, 810 2 RTDB_ERR) 811 perturbative='lr_(tq1p)' 812 if (.not.rtdb_cput(rtdb,'tce:perturbative',1,perturbative)) 813 1 call errquit('tce_input: failed writing to rtdb',0, 814 2 RTDB_ERR) 815 else 816 call errquit('tce_input: multiple theory inputs',0, 817 1 INPUT_ERR) 818 endif 819 else if (inp_compare(.false.,test,'cr-ccsd[t]')) then 820 if (module.eq.'tce') then 821 model='ccsd' 822 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 823 1 call errquit('tce_input: failed writing to rtdb',0, 824 2 RTDB_ERR) 825 perturbative='cr_[t]' 826 if (.not.rtdb_cput(rtdb,'tce:perturbative',1,perturbative)) 827 1 call errquit('tce_input: failed writing to rtdb',0, 828 2 RTDB_ERR) 829 else 830 call errquit('tce_input: multiple theory inputs',0, 831 1 INPUT_ERR) 832 endif 833 else if (inp_compare(.false.,test,'ccsd(2)_t')) then 834 if (module.eq.'tce') then 835 model='ccsd' 836 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 837 1 call errquit('tce_input: failed writing to rtdb',0, 838 2 RTDB_ERR) 839 perturbative='2_t' 840 if (.not.rtdb_cput(rtdb,'tce:perturbative',1,perturbative)) 841 1 call errquit('tce_input: failed writing to rtdb',0, 842 2 RTDB_ERR) 843 left=.true. 844 if (.not.rtdb_put(rtdb,'tce:left',mt_log,1,left)) 845 1 call errquit('tce_input: failed writing to rtdb',0, 846 2 RTDB_ERR) 847 else 848 call errquit('tce_input: multiple theory inputs',0, 849 1 INPUT_ERR) 850 endif 851 else if (inp_compare(.false.,test,'ccsd(2)')) then 852 if (module.eq.'tce') then 853 model='ccsd' 854 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 855 1 call errquit('tce_input: failed writing to rtdb',0, 856 2 RTDB_ERR) 857 perturbative='2_tq' 858 if (.not.rtdb_cput(rtdb,'tce:perturbative',1,perturbative)) 859 1 call errquit('tce_input: failed writing to rtdb',0, 860 2 RTDB_ERR) 861 left=.true. 862 if (.not.rtdb_put(rtdb,'tce:left',mt_log,1,left)) 863 1 call errquit('tce_input: failed writing to rtdb',0, 864 2 RTDB_ERR) 865 else 866 call errquit('tce_input: multiple theory inputs',0, 867 1 INPUT_ERR) 868 endif 869 else if (inp_compare(.false.,test,'ccsdt(2)_q')) then 870 if (module.eq.'tce') then 871 model='ccsdt' 872 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 873 1 call errquit('tce_input: failed writing to rtdb',0, 874 2 RTDB_ERR) 875 perturbative='2_q' 876 if (.not.rtdb_cput(rtdb,'tce:perturbative',1,perturbative)) 877 1 call errquit('tce_input: failed writing to rtdb',0, 878 2 RTDB_ERR) 879 left=.true. 880 if (.not.rtdb_put(rtdb,'tce:left',mt_log,1,left)) 881 1 call errquit('tce_input: failed writing to rtdb',0, 882 2 RTDB_ERR) 883 else 884 call errquit('tce_input: multiple theory inputs',0, 885 1 INPUT_ERR) 886 endif 887 else if (inp_compare(.false.,test,'qcisd')) then 888 if (module.eq.'tce') then 889 model='qcisd' 890 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 891 1 call errquit('tce_input: failed writing to rtdb',0, 892 2 RTDB_ERR) 893 else 894 call errquit('tce_input: multiple theory inputs',0, 895 1 INPUT_ERR) 896 endif 897 else if (inp_compare(.false.,test,'cis')) then 898 if (module.eq.'tce') then 899 model='cis' 900 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 901 1 call errquit('tce_input: failed writing to rtdb',0, 902 1 rtdb_err) 903 else 904 call errquit('tce_input: multiple theory inputs',0, 905 1 input_err) 906 end if 907 else if (inp_compare(.false.,test,'cisd')) then 908 if (module.eq.'tce') then 909 model='cisd' 910 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 911 1 call errquit('tce_input: failed writing to rtdb',0, 912 2 RTDB_ERR) 913 else 914 call errquit('tce_input: multiple theory inputs',0, 915 1 INPUT_ERR) 916 endif 917 else if (inp_compare(.false.,test,'cisdt')) then 918 if (module.eq.'tce') then 919 model='cisdt' 920 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 921 1 call errquit('tce_input: failed writing to rtdb',0, 922 2 RTDB_ERR) 923 else 924 call errquit('tce_input: multiple theory inputs',0, 925 1 INPUT_ERR) 926 endif 927 else if (inp_compare(.false.,test,'cisdtq')) then 928 if (module.eq.'tce') then 929 model='cisdtq' 930 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 931 1 call errquit('tce_input: failed writing to rtdb',0, 932 2 RTDB_ERR) 933 else 934 call errquit('tce_input: multiple theory inputs',0, 935 1 INPUT_ERR) 936 endif 937 else if (inp_compare(.false.,test,'mbpt2')) then 938 if (module.eq.'tce') then 939 model='mbpt2' 940 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 941 1 call errquit('tce_input: failed writing to rtdb',0, 942 2 RTDB_ERR) 943 else 944 call errquit('tce_input: multiple theory inputs',0, 945 1 INPUT_ERR) 946 endif 947 else if (inp_compare(.false.,test,'mbpt3')) then 948 if (module.eq.'tce') then 949 model='mbpt3' 950 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 951 1 call errquit('tce_input: failed writing to rtdb',0, 952 2 RTDB_ERR) 953 else 954 call errquit('tce_input: multiple theory inputs',0, 955 1 INPUT_ERR) 956 endif 957 else if (inp_compare(.false.,test,'mbpt4')) then 958 if (module.eq.'tce') then 959 model='mbpt4' 960 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 961 1 call errquit('tce_input: failed writing to rtdb',0, 962 2 RTDB_ERR) 963 else 964 call errquit('tce_input: multiple theory inputs',0, 965 1 INPUT_ERR) 966 endif 967 else if (inp_compare(.false.,test,'mbpt4(sdq)')) then 968 if (module.eq.'tce') then 969 model='mbpt4sdq' 970 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 971 1 call errquit('tce_input: failed writing to rtdb',0, 972 2 RTDB_ERR) 973 else 974 call errquit('tce_input: multiple theory inputs',0, 975 1 INPUT_ERR) 976 endif 977 else if (inp_compare(.false.,test,'mbpt4sdq(t)')) then 978 if (module.eq.'tce') then 979 model='mbpt4sdq_t' 980 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 981 1 call errquit('tce_input: failed writing to rtdb',0, 982 2 RTDB_ERR) 983 else 984 call errquit('tce_input: multiple theory inputs',0, 985 1 INPUT_ERR) 986 endif 987 else if (inp_compare(.false.,test,'mp2')) then 988 if (module.eq.'tce') then 989 model='mbpt2' 990 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 991 1 call errquit('tce_input: failed writing to rtdb',0, 992 2 RTDB_ERR) 993 else 994 call errquit('tce_input: multiple theory inputs',0, 995 1 INPUT_ERR) 996 endif 997 else if (inp_compare(.false.,test,'mp3')) then 998 if (module.eq.'tce') then 999 model='mbpt3' 1000 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 1001 1 call errquit('tce_input: failed writing to rtdb',0, 1002 2 RTDB_ERR) 1003 else 1004 call errquit('tce_input: multiple theory inputs',0, 1005 1 INPUT_ERR) 1006 endif 1007 else if (inp_compare(.false.,test,'mp4sdq')) then 1008 if (module.eq.'tce') then 1009 model='mbpt4sdq' 1010 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 1011 1 call errquit('tce_input: failed writing to rtdb',0, 1012 2 RTDB_ERR) 1013 else 1014 call errquit('tce_input: multiple theory inputs',0, 1015 1 INPUT_ERR) 1016 endif 1017 else if (inp_compare(.false.,test,'mp4sdq(t)')) then 1018 if (module.eq.'tce') then 1019 model='mbpt4sdq_t' 1020 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 1021 1 call errquit('tce_input: failed writing to rtdb',0, 1022 2 RTDB_ERR) 1023 else 1024 call errquit('tce_input: multiple theory inputs',0, 1025 1 INPUT_ERR) 1026 endif 1027 else if (inp_compare(.false.,test,'mp4')) then 1028 if (module.eq.'tce') then 1029 model='mbpt4' 1030 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 1031 1 call errquit('tce_input: failed writing to rtdb',0, 1032 2 RTDB_ERR) 1033 else 1034 call errquit('tce_input: multiple theory inputs',0, 1035 1 INPUT_ERR) 1036 endif 1037 1038#ifdef MRCC_METHODS 1039!kbn mrcc-r-1 -3 1040! BWCCSD 1041 else if (inp_compare(.false.,test,'bwccsd')) then 1042 if (module.eq.'tce') then 1043 model='bwccsd' 1044 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 1045 1 call errquit('tce_input: failed writing to rtdb',0, 1046 2 RTDB_ERR) 1047 if (.not.rtdb_put(rtdb,'tce:mrcc',mt_int,1,1)) 1048 1 call errquit('tce_input: failed writing to rtdb',0, 1049 2 RTDB_ERR) 1050 else 1051 call errquit('tce_input: multiple theory inputs',0, 1052 1 INPUT_ERR) 1053 endif 1054 else if (inp_compare(.false.,test,'mkccsd')) then 1055! MkCCSD 1056 if (module.eq.'tce') then 1057 model='mkccsd' 1058 if (.not.rtdb_cput(rtdb,'tce:model',1,model)) 1059 1 call errquit('tce_input: failed writing to rtdb',0, 1060 2 RTDB_ERR) 1061 if (.not.rtdb_put(rtdb,'tce:mrcc',mt_int,1,1)) 1062 1 call errquit('tce_input: failed writing to rtdb',0, 1063 2 RTDB_ERR) 1064 else 1065 call errquit('tce_input: multiple theory inputs',0, 1066 1 INPUT_ERR) 1067 endif 1068#endif 1069 1070! 1071! THRESH (convergence threshold for Davidson iteration) 1072! 1073 else if (inp_compare(.false.,test,'thresh')) then 1074 if (.not.inp_f(thresh)) then 1075 write(LuOut,*) 'tce_input: thresh value not found; ', 1076 1 'default value of 1e-6 will be used' 1077 thresh=1.0d-6 1078 endif 1079 if (.not.rtdb_put(rtdb,'tce:thresh',mt_dbl,1,thresh)) 1080 1 call errquit('tce_input: failed writing to rtdb',0, 1081 2 RTDB_ERR) 1082! 1083! LEVEL SHIFT 1084! 1085 else if (inp_compare(.false.,test,'lshift')) then 1086 if (.not.inp_f(zlshift)) then 1087 write(LuOut,*) 'tce_input: lshift value not found; ', 1088 1 'default value of 0.0d0 will be used' 1089 zlshift=0.0d0 1090 endif 1091 if (.not.rtdb_put(rtdb,'tce:zlshift',mt_dbl,1,zlshift)) 1092 1 call errquit('tce_input: failed writing to rtdb',0, 1093 2 RTDB_ERR) 1094 else if (inp_compare(.false.,test,'lshiftl')) then 1095 if (.not.inp_f(zlshiftl)) then 1096 write(LuOut,*) 'tce_input: lshiftl value not found; ', 1097 1 'default value of 0.0d0 will be used' 1098 zlshiftl=0.0d0 1099 endif 1100 if (.not.rtdb_put(rtdb,'tce:zlshiftl',mt_dbl,1,zlshiftl)) 1101 1 call errquit('tce_input: failed writing to rtdb',0, 1102 2 RTDB_ERR) 1103 else if (inp_compare(.false.,test,'lshift2')) then 1104 if (.not.inp_f(zlshift2(1))) then 1105 write(LuOut,*) 'tce_input: lshift2(1) value not found; ', 1106 1 'default value of 0.0d0 will be used' 1107 zlshift2(1)=0.0d0 1108 endif 1109 if (.not.inp_f(zlshift2(2))) then 1110 write(LuOut,*) 'tce_input: lshift2(2) value not found; ', 1111 1 'default value of 0.0d0 will be used' 1112 zlshift2(2)=0.0d0 1113 endif 1114 if (.not.rtdb_put(rtdb,'tce:zlshift2',mt_dbl,2,zlshift2)) 1115 1 call errquit('tce_input: failed writing to rtdb',0, 1116 2 RTDB_ERR) 1117 else if (inp_compare(.false.,test,'lshift3')) then 1118 if (.not.inp_f(zlshift3(1))) then 1119 write(LuOut,*) 'tce_input: lshift3(1) value not found; ', 1120 1 'default value of 0.0d0 will be used' 1121 zlshift3(1)=0.0d0 1122 endif 1123 if (.not.inp_f(zlshift3(2))) then 1124 write(LuOut,*) 'tce_input: lshift3(2) value not found; ', 1125 1 'default value of 0.0d0 will be used' 1126 zlshift3(2)=0.0d0 1127 endif 1128 if (.not.rtdb_put(rtdb,'tce:zlshift3',mt_dbl,2,zlshift3)) 1129 1 call errquit('tce_input: failed writing to rtdb',0, 1130 2 RTDB_ERR) 1131 1132! 1133! TCE_CUDA Number of CUDA devices per node 1134! 1135 else if (inp_compare(.false.,test,'cuda')) then 1136 if (.not.inp_i(icuda)) 1137 1 call errquit('tce_input: no icuda',0,INPUT_ERR) 1138 if (.not.rtdb_put(rtdb,'tce:cuda',mt_int,1,icuda)) 1139 1 call errquit('tce_input: failed writing to rtdb',0, 1140 2 RTDB_ERR) 1141 1142! 1143! MAXITER (the maximum number of Davidson iterations) 1144! 1145 else if (inp_compare(.false.,test,'maxiter')) then 1146 if (.not.inp_i(maxiter)) then 1147 write(LuOut,*) 'tce_input: maxiter value not found; ', 1148 1 'default value of 100 will be used' 1149 maxiter=100 1150 endif 1151 if (.not.rtdb_put(rtdb,'tce:maxiter',mt_int,1,maxiter)) 1152 1 call errquit('tce_input: failed writing to rtdb',0, 1153 2 RTDB_ERR) 1154! 1155! IOALGORITHM (I/O method) 1156! 1157 else if (inp_compare(.false.,test,'io')) then 1158 if (.not.inp_a(ioalgchar)) then 1159 write(LuOut,*) 'tce_input: ioalgorithm value not found; ', 1160 1 'default GA fully incore algorithm will be used' 1161 ioalg=2 1162 else 1163 if (ioalgchar.eq.'fortran') then 1164 ioalg=0 1165 else if (ioalgchar.eq.'eaf') then 1166 ioalg=1 1167 else if (ioalgchar.eq.'ga') then 1168 ioalg=2 1169 else if (ioalgchar.eq.'sf') then 1170 ioalg=3 1171 else if (ioalgchar.eq.'replicated') then 1172 ioalg=4 1173 else if (ioalgchar.eq.'dra') then 1174 ioalg=5 1175 else if (ioalgchar.eq.'ga_eaf') then 1176 ioalg=6 1177 endif 1178 endif 1179 if (.not.rtdb_put(rtdb,'tce:ioalg',mt_int,1,ioalg)) 1180 1 call errquit('tce_input: failed writing to rtdb',0, 1181 2 RTDB_ERR) 1182! 1183! EOMCC SOLVER 1184! 1185 else if (inp_compare(.false.,test,'eomsol')) then 1186 if (.not.inp_i(eomsol)) then 1187 write(LuOut,*) 'tce_input: eomsol value not found; ', 1188 1 'default value of 1 will be used' 1189 eomsol=1 1190 endif 1191 if (.not.rtdb_put(rtdb,'tce:eoms',mt_int,1,eomsol)) 1192 1 call errquit('tce_input: failed writing to rtdb',0, 1193 2 RTDB_ERR) 1194! 1195! DIIS (the vector space size in DIIS) 1196! 1197 else if (inp_compare(.false.,test,'diis')) then 1198 if (.not.inp_i(diis)) then 1199 write(LuOut,*) 'tce_input: diis value not found; ', 1200 1 'default value of 5 will be used' 1201 diis=5 1202 endif 1203 if (.not.rtdb_put(rtdb,'tce:diis',mt_int,1,diis)) 1204 1 call errquit('tce_input: failed writing to rtdb',0, 1205 2 RTDB_ERR) 1206 else if (inp_compare(.false.,test,'diis2')) then 1207 if (.not.inp_i(diis2)) then 1208 write(LuOut,*) 'tce_input: diis2 value not found; ', 1209 1 'default value of 5 will be used' 1210 diis2=5 1211 endif 1212 if (.not.rtdb_put(rtdb,'tce:diis2',mt_int,1,diis2)) 1213 1 call errquit('tce_input: failed writing to rtdb',0, 1214 2 RTDB_ERR) 1215 else if (inp_compare(.false.,test,'diis3')) then 1216 if (.not.inp_i(diis3)) then 1217 write(LuOut,*) 'tce_input: diis3 value not found; ', 1218 1 'default value of 5 will be used' 1219 diis3=5 1220 endif 1221 if (.not.rtdb_put(rtdb,'tce:diis3',mt_int,1,diis3)) 1222 1 call errquit('tce_input: failed writing to rtdb',0, 1223 2 RTDB_ERR) 1224! 1225! DIMENSION OF EOMCC ITERATIVE SPACE 1226! 1227 else if (inp_compare(.false.,test,'hbard')) then 1228 if (.not.inp_i(hbard)) then 1229 write(LuOut,*) 'tce_input: hbard value not found; ', 1230 1 'default value of 500 will be used' 1231 hbard=500 1232 endif 1233 if (.not.rtdb_put(rtdb,'tce:hbard',mt_int,1,hbard)) 1234 1 call errquit('tce_input: failed writing to rtdb',0, 1235 2 RTDB_ERR) 1236! 1237! NROOTS (the number of excited state root) 1238! 1239 else if (inp_compare(.false.,test,'nroots')) then 1240 if (.not.inp_i(nroots)) then 1241 write(LuOut,*) 'tce_input: nroots value not found; ', 1242 1 'default value of 0 will be used' 1243 nroots=0 1244 endif 1245 if (.not.rtdb_put(rtdb,'tce:nroots',mt_int,1,nroots)) 1246 1 call errquit('tce_input: failed writing to rtdb',0, 1247 2 RTDB_ERR) 1248! 1249!kbn EACCSD 1250#ifdef EACCSD 1251 else if (inp_compare(.false.,test,'eaccsd')) then 1252 eaccsd=.true. 1253 if (.not.rtdb_put(rtdb,'tce:eaccsd',mt_log,1,eaccsd)) 1254 1 call errquit('tce_input: failed writing to rtdb',0, 1255 2 RTDB_ERR) 1256#endif 1257! 1258!kbn IPCCSD 1259#ifdef IPCCSD 1260 else if (inp_compare(.false.,test,'ipccsd')) then 1261 ipccsd=.true. 1262 if (.not.rtdb_put(rtdb,'tce:ipccsd',mt_log,1,ipccsd)) 1263 1 call errquit('tce_input: failed writing to rtdb',0, 1264 2 RTDB_ERR) 1265#endif 1266! 1267! MAXDIFF (for EOM codes) 1268! 1269 else if (inp_compare(.false.,test,'maxdiff')) then 1270 if (.not.inp_f(maxdiff)) then 1271! write(LuOut,*) 'tce_input: maxdiff value not found; ', 1272! 1 'default value of 1e-6 will be used' 1273 maxdiff=0.5d0 1274 endif 1275 if (.not.rtdb_put(rtdb,'tce:maxdiff',mt_dbl,1,maxdiff)) 1276 1 call errquit('tce_input: failed writing to rtdb',0, 1277 2 RTDB_ERR) 1278! 1279! 2e STORAGE 1280! 1281 else if (inp_compare(.false.,test,'attilesize')) then 1282 if (.not.inp_i(maxs)) then 1283 write(LuOut,*) 'tce_input: attilesize value not found; ', 1284 1 'default value of 30 will be used' 1285 maxs=30 1286 endif 1287 if (.not.rtdb_put(rtdb,'tce:maxs',mt_int,1,maxs)) 1288 1 call errquit('tce_input: failed writing to rtdb',0, 1289 2 RTDB_ERR) 1290! 1291 else if (inp_compare(.false.,test,'split')) then 1292 if (.not.inp_i(ichopx)) then 1293 write(LuOut,*) 'tce_input: split value not found; ', 1294 1 'default value of 1 will be used' 1295 ichopx=1 1296 endif 1297 if (.not.rtdb_put(rtdb,'tce:ichopx',mt_int,1,ichopx)) 1298 1 call errquit('tce_input: failed writing to rtdb',0, 1299 2 RTDB_ERR) 1300! 1301 else if (inp_compare(.false.,test,'2emet')) then 1302 if (.not.inp_i(i4im)) then 1303 write(LuOut,*) 'tce_input: 2emet value not found; ', 1304 1 'default value of 1 will be used' 1305 i4im=1 1306 endif 1307 if (.not.rtdb_put(rtdb,'tce:i4im',mt_int,1,i4im)) 1308 1 call errquit('tce_input: failed writing to rtdb',0, 1309 2 RTDB_ERR) 1310! 1311 else if (inp_compare(.false.,test,'idiskx')) then 1312 if (.not.inp_i(idiskx)) then 1313 write(LuOut,*) 'tce_input: idiskx value not found; ', 1314 1 'default value of 0 will be used' 1315 idiskx=0 1316 endif 1317 if (.not.rtdb_put(rtdb,'tce:idiskx',mt_int,1,idiskx)) 1318 1 call errquit('tce_input: failed writing to rtdb',0, 1319 2 RTDB_ERR) 1320! 1321! TARGET (the target excited state for, e.g., geometry optimization) 1322! 1323 else if (inp_compare(.false.,test,'target')) then 1324 if (.not.inp_i(target)) then 1325 write(LuOut,*) 'tce_input: target value not found; ', 1326 1 'default value of 1 will be used' 1327 target=1 1328 endif 1329 if (target.gt.nroots) call errquit 1330 1 ('tce_input: an illegal value for target',target,INPUT_ERR) 1331 if (.not.rtdb_put(rtdb,'tce:target',mt_int,1,target)) 1332 1 call errquit('tce_input: failed writing to rtdb',0, 1333 2 RTDB_ERR) 1334! 1335! TARGETSYM (the symmetry of the target excited state) 1336! 1337 else if (inp_compare(.false.,test,'targetsym')) then 1338 if (.not.inp_a(targetsym)) then 1339 write(LuOut,*) 'tce_input: targetsym value not found; ', 1340 1 'no symmetry information will be used in specifying target' 1341 targetsym='none' 1342 endif 1343 if (.not.rtdb_cput(rtdb,'tce:targetsym',1,targetsym)) 1344 1 call errquit('tce_input: failed writing to rtdb',0, 1345 2 RTDB_ERR) 1346! 1347! SYMMETRY (restricts the roots to have the TARGETSYM irrep) 1348! 1349 else if (inp_compare(.false.,test,'symmetry')) then 1350 symmetry=.true. 1351 if (.not.rtdb_put(rtdb,'tce:symmetry',mt_log,1,symmetry)) 1352 1 call errquit('tce_input: failed writing to rtdb',0, 1353 2 RTDB_ERR) 1354! 1355! IDENS (one particle reduced density matrix) 1356! 1357 else if (inp_compare(.false.,test,'densmat')) then 1358 idens=.true. 1359 left =.true. 1360 if (.not.rtdb_put(rtdb,'tce:left',mt_log,1,left)) 1361 1 call errquit('tce_input: failed writing to rtdb',0, 1362 2 RTDB_ERR) 1363 if (.not.rtdb_put(rtdb,'tce:densmat',mt_log,1,idens)) 1364 1 call errquit('tce_input: failed writing to rtdb',0, 1365 2 RTDB_ERR) 1366 if (.not.inp_a(file_densmat)) then 1367 call util_file_name('densmat', .false.,.false.,file_densmat) 1368 endif 1369 if (.not.rtdb_cput(rtdb,'tce:file_densmat',1,file_densmat)) 1370 1 call errquit('tce_input: rtdb_cput failed - file_densmat',0, 1371 1 RTDB_ERR) 1372! 1373! MULTIPOLE (multipole moments) 1374! 1375 else if (inp_compare(.false.,test,'multipole')) then 1376 left=.true. 1377 if (.not.rtdb_put(rtdb,'tce:left',mt_log,1,left)) 1378 1 call errquit('tce_input: failed writing to rtdb',0, 1379 2 RTDB_ERR) 1380 if (.not.inp_i(multipole)) then 1381 write(LuOut,*) 'tce_input: multipole value not found; ', 1382 1 'all available multipoles (L=1,2,3) will be calculated' 1383 multipole=3 1384 endif 1385 if (.not.rtdb_put(rtdb,'tce:multipole',mt_int,1,multipole)) 1386 1 call errquit('tce_input: failed writing to rtdb',0, 1387 2 RTDB_ERR) 1388! 1389! DIPOLE (dipole moments & dipole transition moments) 1390! QUADRUPOLE (quadrupole moments & quadrupole transition moments) 1391! OCTUPOLE (octupole moments & octupole transition moments) 1392! 1393 else if (inp_compare(.false.,test,'dipole')) then 1394 left=.true. 1395 if (.not.rtdb_put(rtdb,'tce:left',mt_log,1,left)) 1396 1 call errquit('tce_input: failed writing to rtdb',0, 1397 2 RTDB_ERR) 1398 multipole=max(multipole,1) 1399 if (.not.rtdb_put(rtdb,'tce:multipole',mt_int,1,multipole)) 1400 1 call errquit('tce_input: failed writing to rtdb',0, 1401 2 RTDB_ERR) 1402 else if (inp_compare(.false.,test,'quadrupole')) then 1403 left=.true. 1404 if (.not.rtdb_put(rtdb,'tce:left',mt_log,1,left)) 1405 1 call errquit('tce_input: failed writing to rtdb',0, 1406 2 RTDB_ERR) 1407 multipole=max(multipole,2) 1408 if (.not.rtdb_put(rtdb,'tce:multipole',mt_int,1,multipole)) 1409 1 call errquit('tce_input: failed writing to rtdb',0, 1410 2 RTDB_ERR) 1411 else if (inp_compare(.false.,test,'octupole')) then 1412 left=.true. 1413 if (.not.rtdb_put(rtdb,'tce:left',mt_log,1,left)) 1414 1 call errquit('tce_input: failed writing to rtdb',0, 1415 2 RTDB_ERR) 1416 multipole=max(multipole,3) 1417 if (.not.rtdb_put(rtdb,'tce:multipole',mt_int,1,multipole)) 1418 1 call errquit('tce_input: failed writing to rtdb',0, 1419 2 RTDB_ERR) 1420! 1421! PROPERTY INPUT SUB-BLOCK 1422! 1423 else if (inp_compare(.false.,test,'tceprop')) then 1424 call tce_prop_input(rtdb) 1425! 1426! TILESIZE (the maximum tile size) 1427! 1428 else if (inp_compare(.false.,test,'tilesize')) then 1429 if (.not.inp_i(tilesize)) 1430 1 call errquit('tce_input: no tilesize given',0,INPUT_ERR) 1431 if (.not.rtdb_put(rtdb,'tce:tilesize',mt_int,1,tilesize)) 1432 1 call errquit('tce_input: failed writing to rtdb',0, 1433 2 RTDB_ERR) 1434! 1435! FRAGMENT (if excited state calc, give an atom in an excited fragment) 1436! 1437 else if (inp_compare(.false.,test,'fragment')) then 1438 if (.not.inp_i(fragment)) then 1439 write(LuOut,*) 'tce_input: fragment value not found; ', 1440 1 'default value of 0 will be used' 1441 fragment=0 1442 endif 1443 if (.not.rtdb_put(rtdb,'tce:fragment',mt_int,1,fragment)) 1444 1 call errquit('tce_input: failed writing to rtdb',0, 1445 2 RTDB_ERR) 1446! 1447! (NO)FOCK (recompute fock for, e.g., DFT, ROHF refs) 1448! 1449 else if (inp_compare(.false.,test,'fock')) then 1450 recompf=.true. 1451 if (.not.rtdb_put(rtdb,'tce:recompf',mt_log,1,recompf)) 1452 1 call errquit('tce_input: failed writing to rtdb',0, 1453 2 RTDB_ERR) 1454 else if (inp_compare(.false.,test,'nofock')) then 1455 recompf=.false. 1456 if (.not.rtdb_put(rtdb,'tce:recompf',mt_log,1,recompf)) 1457 1 call errquit('tce_input: failed writing to rtdb',0, 1458 2 RTDB_ERR) 1459! 1460! ccsd_act/eomccsd_act 1461! 1462 else if (inp_compare(.false.,test,'oact')) then 1463 if (.not.inp_i(oact)) 1464 1 call errquit('tce_input: no oact given',0,INPUT_ERR) 1465 if (.not.rtdb_put(rtdb,'tce:oact',mt_int,1,oact)) 1466 1 call errquit('tce_input: failed writing to rtdb',0, 1467 2 RTDB_ERR) 1468 else if (inp_compare(.false.,test,'uact')) then 1469 if (.not.inp_i(uact)) 1470 1 call errquit('tce_input: no uact given',0,INPUT_ERR) 1471 if (.not.rtdb_put(rtdb,'tce:uact',mt_int,1,uact)) 1472 1 call errquit('tce_input: failed writing to rtdb',0, 1473 2 RTDB_ERR) 1474! 1475 else if (inp_compare(.false.,test,'emin_act')) then 1476 if (.not.inp_f(emin_act)) 1477 1 call errquit('tce_input: no emin_act given',0,INPUT_ERR) 1478 if (.not.rtdb_put(rtdb,'tce:eactmin',mt_dbl,1,emin_act)) 1479 1 call errquit('tce_input: failed writing to rtdb',0, 1480 2 RTDB_ERR) 1481 else if (inp_compare(.false.,test,'emax_act')) then 1482 if (.not.inp_f(emax_act)) 1483 1 call errquit('tce_input: no emax_act given',0,INPUT_ERR) 1484 if (.not.rtdb_put(rtdb,'tce:eactmax',mt_dbl,1,emax_act)) 1485 1 call errquit('tce_input: failed writing to rtdb',0, 1486 2 RTDB_ERR) 1487! 1488! ACTIVE_OA (Number of active occupied orbitals) 1489! 1490 else if (inp_compare(.false.,test,'active_oa')) then 1491 if (.not.inp_i(oactive(1))) 1492 1 call errquit('tce_input: no active_oa given',0,INPUT_ERR) 1493 if (.not.rtdb_put(rtdb,'tce:active_oa',mt_int,1,oactive(1))) 1494 1 call errquit('tce_input: failed writing to rtdb',0, 1495 2 RTDB_ERR) 1496! 1497! ACTIVE_OB (Number of active occupied orbitals) 1498! 1499 else if (inp_compare(.false.,test,'active_ob')) then 1500 if (.not.inp_i(oactive(2))) 1501 1 call errquit('tce_input: no active_ob given',0,INPUT_ERR) 1502 if (.not.rtdb_put(rtdb,'tce:active_ob',mt_int,1,oactive(2))) 1503 1 call errquit('tce_input: failed writing to rtdb',0, 1504 2 RTDB_ERR) 1505! 1506! ACTIVE_VA (Number of active virtual orbitals) 1507! 1508 else if (inp_compare(.false.,test,'active_va')) then 1509 if (.not.inp_i(vactive(1))) 1510 1 call errquit('tce_input: no active_va given',0,INPUT_ERR) 1511 if (.not.rtdb_put(rtdb,'tce:active_va',mt_int,1,vactive(1))) 1512 1 call errquit('tce_input: failed writing to rtdb',0, 1513 2 RTDB_ERR) 1514! 1515! ACTIVE_VB (Number of active virtual orbitals) 1516! 1517 else if (inp_compare(.false.,test,'active_vb')) then 1518 if (.not.inp_i(vactive(2))) 1519 1 call errquit('tce_input: no active_vb given',0,INPUT_ERR) 1520 if (.not.rtdb_put(rtdb,'tce:active_vb',mt_int,1,vactive(2))) 1521 1 call errquit('tce_input: failed writing to rtdb',0, 1522 2 RTDB_ERR) 1523! 1524! ACTIVE_EXCIT_LVL (T3 active excitation level) 1525! 1526 else if (inp_compare(.false.,test,'t3a_lvl')) then 1527 if (.not.inp_i(numact)) 1528 1 call errquit('tce_input: no t3a_lvl given',0,INPUT_ERR) 1529 if (.not.rtdb_put(rtdb,'tce:act_excit_lvl',mt_int,1,numact)) 1530 1 call errquit('tce_input: failed writing to rtdb',0, 1531 2 RTDB_ERR) 1532 1533 else if (inp_compare(.false.,test,'tcc_spaces')) then 1534 if (.not.rtdb_put(rtdb,'tce:ltcc',mt_log,1,.true.)) 1535 1 call errquit('tce_input: failed writing to rtdb',0, 1536 2 RTDB_ERR) 1537 1538! 1539! PRINT 1540! 1541 else if (inp_compare(.false.,test,'print')) then 1542 call util_print_input(rtdb,'tce') 1543! 1544! END 1545! 1546 else if (inp_compare(.false.,test,'end')) then 1547 goto 20 1548 else 1549 call errquit('tce_input: unknown directive',0,INPUT_ERR) 1550 endif 1551 goto 10 1552! 1553! ------ 1554! Return 1555! ------ 1556! 1557 20 return 1558 end 1559! 1560! This is the TCE property input block ("tceprop") 1561! 1562 subroutine tce_prop_input(rtdb) 1563! 1564 implicit none 1565#include "inp.fh" 1566#include "rtdb.fh" 1567#include "mafdecls.fh" 1568#include "errquit.fh" 1569#include "stdio.fh" 1570 integer rtdb 1571 integer n_a,k_a,l_a 1572 integer n_b,k_b,l_b 1573 integer n_c,k_c,l_c 1574 integer n_i,k_i,l_i 1575 integer i,icount 1576 character*10 module 1577 character*20 test 1578 character*20 beta_opt 1579 character*20 gamm_opt 1580 character*20 disp_opt 1581 character*20 beta_type 1582 character*20 gamm_type 1583 character*20 disp_type 1584 logical lineresp ! T(1) response equations - real frequency 1585 logical leftresp ! L(1) response equations 1586 logical quadresp ! T(2) response equations 1587 logical status 1588! 1589 lineresp = .false. 1590 leftresp = .false. 1591 quadresp = .false. 1592! 1593! ------------------------------------- 1594! What input block are we dealing with? 1595! ------------------------------------- 1596! 1597 if (.not.rtdb_cget(rtdb,'tce:module',1,module)) then 1598 call errquit('tce_prop_input: line ',__LINE__,RTDB_ERR) 1599 endif 1600! 1601! ---------- 1602! Read input 1603! ---------- 1604! 1605 100 if (.not. inp_read()) then 1606 call errquit('tce_prop_input: line ',__LINE__,RTDB_ERR) 1607 endif 1608 if (.not. inp_a(test)) then 1609 call errquit('tce_prop_input: line ',__LINE__,RTDB_ERR) 1610 endif 1611! 1612! POLARIZABILITY 1613! 1614 if (inp_compare(.false.,test,'polarizability').or. 1615 1 inp_compare(.false.,test,'polar').or. 1616 2 inp_compare(.false.,test,'alpha')) then 1617 lineresp = .true. 1618! 1619! HYPERPOLARIZABILITY 1620! 1621 elseif (inp_compare(.false.,test,'hyperpolarizability').or. 1622 1 inp_compare(.false.,test,'hyperpolar').or. 1623 2 inp_compare(.false.,test,'beta')) then 1624 lineresp = .true. 1625 leftresp = .true. 1626 if (.not.inp_a(beta_opt)) then 1627 beta_type = 'static' 1628 else 1629 if (inp_compare(.false.,beta_opt,'shg')) then 1630 beta_type = 'SHG' 1631 elseif (inp_compare(.false.,beta_opt,'or')) then 1632 beta_type = 'OR' 1633 elseif (inp_compare(.false.,beta_opt,'eope')) then 1634 beta_type = 'EOPE' 1635 else 1636 call errquit('tce_prop_input: invalid option for beta', 1637 1 __LINE__,RTDB_ERR) 1638 endif 1639 endif 1640! 1641! SECOND HYPERPOLARIZABILITY 1642! 1643 elseif (inp_compare(.false.,test,'cubicpolarizability').or. 1644 1 inp_compare(.false.,test,'cubicpolar').or. 1645 2 inp_compare(.false.,test,'gamma')) then 1646 lineresp = .true. 1647 leftresp = .true. 1648 quadresp = .true. 1649 if (.not.inp_a(gamm_opt)) then 1650 gamm_type = 'static' 1651 else 1652 if (inp_compare(.false.,gamm_opt,'thg')) then 1653 gamm_type = 'THG' 1654 elseif (inp_compare(.false.,gamm_opt,'efish')) then 1655 gamm_type = 'EFISH' 1656 elseif (inp_compare(.false.,gamm_opt,'dfwm')) then 1657 gamm_type = 'DFWM' 1658 elseif (inp_compare(.false.,gamm_opt,'oke')) then 1659 gamm_type = 'OKE' 1660 elseif (inp_compare(.false.,gamm_opt,'cars')) then 1661 gamm_type = 'CARS' 1662 else 1663 call errquit('tce_prop_input: invalid option for gamma', 1664 1 __LINE__,RTDB_ERR) 1665 endif 1666 endif 1667! 1668! AFREQ (omega for polarizability) 1669! 1670 elseif (inp_compare(.false.,test,'afreq')) then 1671 lineresp = .true. 1672 if (inp_i(n_a)) then 1673 if (.not.ma_push_get(mt_dbl,n_a,'afreq',l_a, 1674 1 k_a)) then 1675 call errquit('tce_prop_input: ma_push_get',__LINE__,MA_ERR) 1676 endif 1677 icount = 0 1678 do i = 0, n_a-1 1679 status = inp_f(dbl_mb(k_a+i)) 1680 if (status) then 1681 icount = icount+1 1682 else 1683 write(6,'(a,a,i4,a)') 1684 1 'Response property input found ', 1685 2 'fewer frequencies than expected, only ',icount, 1686 3 'will be used' 1687 n_a = icount 1688 if (icount.eq.0) then 1689 if (.not.ma_pop_stack(l_a)) then 1690 call errquit('tce_prop_input: ma_pop_stack',__LINE__, 1691 1 MA_ERR) 1692 endif 1693 endif 1694 goto 300 1695 endif 1696 enddo 1697 else 1698 n_a = 1 1699 if (.not.ma_push_get(mt_dbl,n_a,'afreq',l_a,k_a)) then 1700 call errquit('tce_prop_input: ma_push_get',__LINE__,MA_ERR) 1701 endif 1702 dbl_mb(k_a) = 0.0d0 1703 endif 1704 300 continue 1705! 1706! BFREQ (omega for first hyperpolarizability) 1707! 1708 elseif (inp_compare(.false.,test,'bfreq')) then 1709 lineresp = .true. 1710 leftresp = .true. 1711 if (inp_i(n_b)) then 1712 if (.not.ma_push_get(mt_dbl,n_b,'bfreq',l_b, 1713 1 k_b)) then 1714 call errquit('tce_prop_input: ma_push_get',__LINE__,MA_ERR) 1715 endif 1716 icount = 0 1717 do i = 0, n_b-1 1718 status = inp_f(dbl_mb(k_b+i)) 1719 if (status) then 1720 icount = icount+1 1721 else 1722 write(6,'(a,a,i4,a)') 1723 1 'Response property input found ', 1724 2 'fewer frequencies than expected, only ',icount, 1725 3 'will be used' 1726 n_b = icount 1727 if (icount.eq.0) then 1728 if (.not.ma_pop_stack(l_b)) then 1729 call errquit('tce_prop_input: ma_pop_stack',__LINE__, 1730 1 MA_ERR) 1731 endif 1732 endif 1733 goto 400 1734 endif 1735 enddo 1736 else 1737 n_b = 1 1738 if (.not.ma_push_get(mt_dbl,n_b,'bfreq',l_b,k_b)) then 1739 call errquit('tce_prop_input: ma_push_get',__LINE__,MA_ERR) 1740 endif 1741 dbl_mb(k_b) = 0.0d0 1742 endif 1743 400 continue 1744! 1745! CFREQ (omega for second hyperpolarizability) 1746! 1747 elseif (inp_compare(.false.,test,'cfreq')) then 1748 lineresp = .true. 1749 leftresp = .true. 1750 quadresp = .true. 1751 if (inp_i(n_c)) then 1752 if (.not.ma_push_get(mt_dbl,n_c,'cfreq',l_c, 1753 1 k_c)) then 1754 call errquit('tce_prop_input: ma_push_get',__LINE__,MA_ERR) 1755 endif 1756 icount = 0 1757 do i = 0, n_b-1 1758 status = inp_f(dbl_mb(k_c+i)) 1759 if (status) then 1760 icount = icount+1 1761 else 1762 write(6,'(a,a,i4,a)') 1763 1 'Response property input found ', 1764 2 'fewer frequencies than expected, only ',icount, 1765 3 'will be used' 1766 n_c = icount 1767 if (icount.eq.0) then 1768 if (.not.ma_pop_stack(l_c)) then 1769 call errquit('tce_prop_input: ma_pop_stack',__LINE__, 1770 1 MA_ERR) 1771 endif 1772 endif 1773 goto 500 1774 endif 1775 enddo 1776 else 1777 n_c = 1 1778 if (.not.ma_push_get(mt_dbl,n_c,'cfreq',l_c,k_c)) then 1779 call errquit('tce_prop_input: ma_push_get',__LINE__,MA_ERR) 1780 endif 1781 dbl_mb(k_c) = 0.0d0 1782 endif 1783 500 continue 1784! 1785! END 1786! 1787 else if (inp_compare(.false.,test,'end')) then 1788 goto 200 1789 else 1790 call errquit('tce_prop_input: unknown directive',0,INPUT_ERR) 1791 endif 1792 goto 100 1793 200 return 1794! 1795! ------------------- 1796! Push values to RTDB 1797! ------------------- 1798! 1799 if (.not.rtdb_put(rtdb,'tce:lineresp',mt_log,1,lineresp)) then 1800 call errquit('tce_prop_input: rtdb_put',__LINE__,RTDB_ERR) 1801 endif 1802 if (.not.rtdb_put(rtdb,'tce:leftresp',mt_log,1,leftresp)) then 1803 call errquit('tce_prop_input: rtdb_put',__LINE__,RTDB_ERR) 1804 endif 1805! 1806! ------ 1807! Return 1808! ------ 1809! 1810 end 1811 1812