1! 2! Dalton, a molecular electronic structure program 3! Copyright (C) by the authors of Dalton. 4! 5! This program is free software; you can redistribute it and/or 6! modify it under the terms of the GNU Lesser General Public 7! License version 2.1 as published by the Free Software Foundation. 8! 9! This program is distributed in the hope that it will be useful, 10! but WITHOUT ANY WARRANTY; without even the implied warranty of 11! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 12! Lesser General Public License for more details. 13! 14! If a copy of the GNU LGPL v2.1 was not distributed with this 15! code, you can obtain one at https://www.gnu.org/licenses/old-licenses/lgpl-2.1.en.html. 16! 17! 18C 19c /* deck CC_XOPA */ 20*=====================================================================* 21 SUBROUTINE CC_XOPA(WORK,LWORK) 22*---------------------------------------------------------------------* 23* 24* Purpose: direct calculation of first-order transition properties 25* (transition moments and oscillator strengths) 26* for transitions between two excited states with the 27* Coupled Cluster models 28* 29* CCS, CC2, CCSD, CC3 30* 31* and partially with SCF and CIS 32* 33* Written by Christof Haettig winter 2002/2003. 34* 35*=====================================================================* 36 IMPLICIT NONE 37#include "priunit.h" 38#include "cclists.h" 39#include "ccxopainf.h" 40#include "ccsdinp.h" 41#include "dummy.h" 42#include "second.h" 43#include "ccexcinf.h" 44#include "ccorb.h" 45 46* local parameters: 47 CHARACTER*(16) MSGDBG 48 PARAMETER (MSGDBG = '[debug] CC_XOPA> ') 49 50#if defined (SYS_CRAY) 51 REAL ZERO 52#else 53 DOUBLE PRECISION ZERO 54#endif 55 PARAMETER (ZERO = 0.0d0) 56 57 CHARACTER*10 MODEL 58 INTEGER LWORK 59 60#if defined (SYS_CRAY) 61 REAL WORK(LWORK) 62 REAL TIM0, TIM1, TIMF, TIMXE1, TIMXE2 63#else 64 DOUBLE PRECISION WORK(LWORK) 65 DOUBLE PRECISION TIM0, TIM1, TIMF, TIMXE1, TIMXE2 66#endif 67 68 LOGICAL LADD 69 INTEGER NBOPA, MXFTRAN, MXATRAN, MXXTRAN, MXFVEC, MXAVEC, MXXVEC, 70 & NFTRAN, NXE1TRAN, NXE2TRAN, NSTATES, 71 & KRESULT, KFTRAN, KFDOTS, KFCONS, KEND0, LEND0, 72 & KE1TRAN, KE1DOTS, KE1CONS, 73 & KX2TRAN, KX2DOTS, KX2CONS, 74 & IOPT, IORDER, ISYM 75 76* external functions: none 77 78*---------------------------------------------------------------------* 79* print header for second-order property section: 80*---------------------------------------------------------------------* 81 WRITE (LUPRI,'(7(/1X,2A),/)') 82 & '************************************', 83 & '******************************', 84 & '* ', 85 & ' *', 86 & '*<<<<<< OUTPUT FROM COUPLED CLUST', 87 & 'ER LINEAR RESPONSE >>>>>>>*', 88 & '*<<<<<< CALCULATION OF ONE-PHOTON A', 89 & 'BSORPTION STRENGTHS >>>>>>>*', 90 & '*<<<<<< FOR EXCITED TO EXCITED S', 91 & 'TATE TRANSITIONS >>>>>>>*', 92 & '* ', 93 & ' *', 94 & '************************************', 95 & '******************************' 96 97*---------------------------------------------------------------------* 98 IF (.NOT. (CCS .OR. CC2 .OR. CCSD .OR. CC3) ) THEN 99 CALL QUIT('CC_XOPA called for unknown Coupled Cluster.') 100 END IF 101 102* print some debug/info output 103 IF (IPRINT .GT. 10) WRITE(LUPRI,*) 'CC_XOPA Workspace:',LWORK 104 105 TIM0 = SECOND() 106 107*---------------------------------------------------------------------* 108* allocate & initialize work space for property contributions: 109*---------------------------------------------------------------------* 110 ! maximum number of transition moments to compute 111 NBOPA = 2 * NQR2OP * NXQR2ST 112 113 ! number of excited states 114 NSTATES = 0 115 DO ISYM = 1, NSYM 116 NSTATES = NSTATES + NCCEXCI(ISYM,1) 117 END DO 118 119 ! maximum number of transformations or vector calculations 120 ! NSTATES * NQR2OP LE x Eta{X} transformations 121 ! NQR2OP Xi{X} vectors 122 ! 2*NXQR2ST LE x B x RE transformations 123 MXATRAN = NSTATES * NQR2OP 124 MXXTRAN = NQR2OP 125 MXFTRAN = 2*NXQR2ST 126 127 ! maximum number of vectors to dot on 128 ! NSTATES RE vectors dotted on a LE x Eta{X} transformation 129 ! 2*NXQR2ST N2 vectors dotted on a Xi{X} vector 130 ! NQR2OP R1 vectors dotted on a LE x B x RE transformation 131 MXAVEC = NSTATES 132 MXXVEC = 2*NXQR2ST 133 MXFVEC = NQR2OP 134 135 KRESULT = 1 136 KEND0 = KRESULT + NBOPA 137 138 KFTRAN = KEND0 139 KFDOTS = KFTRAN + MXFTRAN * MXDIM_FTRAN 140 KFCONS = KFDOTS + MXFVEC * MXFTRAN 141 KEND0 = KFCONS + MXFVEC * MXFTRAN 142 143 KE1TRAN = KEND0 144 KE1DOTS = KE1TRAN + MXATRAN * MXDIM_XEVEC 145 KE1CONS = KE1DOTS + MXAVEC * MXATRAN 146 KEND0 = KE1CONS + MXAVEC * MXATRAN 147 148 KX2TRAN = KEND0 149 KX2DOTS = KX2TRAN + MXXTRAN * MXDIM_XEVEC 150 KX2CONS = KX2DOTS + MXXVEC * MXXTRAN 151 KEND0 = KX2CONS + MXXVEC * MXXTRAN 152 153 LEND0 = LWORK - KEND0 154 IF (LEND0 .LT. 0) THEN 155 CALL QUIT('Insufficient memory in CC_XOPA. (1)') 156 END IF 157 158 CALL DZERO(WORK(KRESULT),NBOPA) 159 160*---------------------------------------------------------------------* 161* set up lists for F transformations, ETA{O} and Xi{O} vectors: 162*---------------------------------------------------------------------* 163 LADD = .FALSE. 164 165 CALL CCXOPA_SETUP(WORK(KFTRAN),WORK(KFDOTS),WORK(KFCONS), 166 & NFTRAN,MXFTRAN,MXFVEC, 167 & WORK(KE1TRAN),WORK(KE1DOTS),WORK(KE1CONS), 168 & NXE1TRAN,MXATRAN,MXAVEC, 169 & WORK(KX2TRAN),WORK(KX2DOTS),WORK(KX2CONS), 170 & NXE2TRAN,MXXTRAN,MXXVEC, 171 & WORK(KRESULT),NBOPA,LADD,WORK(KEND0),LEND0) 172 173*---------------------------------------------------------------------* 174* calculate F matrix contributions: 175*---------------------------------------------------------------------* 176 TIM1 = SECOND() 177 178 CALL DZERO(WORK(KFCONS),MXFVEC*NFTRAN) 179 180 IOPT = 5 181 CALL CC_FMATRIX(WORK(KFTRAN),NFTRAN,'LE ','RE ',IOPT,'R1 ', 182 & WORK(KFDOTS),WORK(KFCONS),MXFVEC, 183 & WORK(KEND0), LEND0) 184 185 TIMF = SECOND() - TIM1 186 187 IF (NFTRAN.GT.0) WRITE (LUPRI,'(/A,I5,A,F12.2," seconds.")') 188 & ' Time used for',NFTRAN,' F matrix transformations:',TIMF 189 CALL FLSHFO(LUPRI) 190 191*---------------------------------------------------------------------* 192* calculate LE x A{O} x RE contributions: 193*---------------------------------------------------------------------* 194 TIM1 = SECOND() 195 196 CALL DZERO(WORK(KE1CONS),MXAVEC*NXE1TRAN) 197 198 IOPT = 5 199 IORDER = 1 200 CALL CC_XIETA( WORK(KE1TRAN), NXE1TRAN, IOPT, IORDER, 'LE ', 201 & '---',DUMMY,DUMMY, 202 & 'RE ',WORK(KE1DOTS),WORK(KE1CONS), 203 & .FALSE.,MXAVEC, WORK(KEND0), LEND0 ) 204 205 TIMXE1 = SECOND() - TIM1 206 IF (NXE1TRAN.GT.0) WRITE (LUPRI,'(/A,I5,A,F12.2," seconds.")') 207 & ' Time used for',NXE1TRAN,' A{X} matrix transformations:', 208 & TIMXE1 209 CALL FLSHFO(LUPRI) 210 211*---------------------------------------------------------------------* 212* calculate N2 x Xksi{O} vector contributions: 213*---------------------------------------------------------------------* 214 TIM1 = SECOND() 215 216 CALL DZERO(WORK(KX2CONS),MXXVEC*NXE2TRAN) 217 218 IOPT = 5 219 IORDER = 1 220 CALL CC_XIETA( WORK(KX2TRAN), NXE2TRAN, IOPT, IORDER, '---', 221 & 'N2 ',WORK(KX2DOTS),WORK(KX2CONS), 222 & '---',IDUMMY,DUMMY, 223 & .FALSE.,MXXVEC, WORK(KEND0), LEND0 ) 224 225 TIMXE2 = SECOND() - TIM1 226 IF (NXE2TRAN.GT.0) WRITE (LUPRI,'(/A,I5,A,F12.2," seconds.")') 227 & ' Time used for',NXE2TRAN,' O1/X1 vector calculation:',TIMXE2 228 CALL FLSHFO(LUPRI) 229 230*---------------------------------------------------------------------* 231* calculate LE x Xksi{O} vector contributions: 232*---------------------------------------------------------------------* 233! TIM1 = SECOND() 234! 235! if (leomxopa) then 236! CALL DZERO(WORK(KX2CONS),MXXVEC*NXE2TRAN) 237! 238! IOPT = 5 239! IORDER = 1 240! CALL CC_XIETA( WORK(KX2TRAN), NXE2TRAN, IOPT, IORDER, '---', 241! & 'LE ',WORK(KX2DOTS),WORK(KX2CONS), 242! & '---',IDUMMY,DUMMY, 243! & .FALSE.,MXXVEC, WORK(KEND0), LEND0 ) 244! 245! TIMXE2 = SECOND() - TIM1 246! IF (NXE2TRAN.GT.0) WRITE (LUPRI,'(/A,I5,A,F12.2," seconds.")') 247! & '>>> Time used for',NXE2TRAN,' O1/X1 vector calculation:',TIMXE2 248! CALL FLSHFO(LUPRI) 249! end if 250! 251*---------------------------------------------------------------------* 252* collect contributions and sum them up to the final results: 253*---------------------------------------------------------------------* 254 LADD = .TRUE. 255 256 CALL CCXOPA_SETUP(WORK(KFTRAN),WORK(KFDOTS),WORK(KFCONS), 257 & NFTRAN,MXFTRAN,MXFVEC, 258 & WORK(KE1TRAN),WORK(KE1DOTS),WORK(KE1CONS), 259 & NXE1TRAN,MXATRAN,MXAVEC, 260 & WORK(KX2TRAN),WORK(KX2DOTS),WORK(KX2CONS), 261 & NXE2TRAN,MXXTRAN,MXXVEC, 262 & WORK(KRESULT),NBOPA,LADD,WORK(KEND0),LEND0) 263 264*---------------------------------------------------------------------* 265* print timing: 266*---------------------------------------------------------------------* 267 WRITE (LUPRI,'(/A,I4,A,F12.2," seconds.")') ' Total time for', 268 & NBOPA,' quadratic response func.:', SECOND() - TIM0 269 270*---------------------------------------------------------------------* 271* print one-photon absorption properties and return: 272*---------------------------------------------------------------------* 273 CALL CCOPAPRT(WORK(KRESULT),.TRUE.,NQR2OP,NXQR2ST) 274 275 CALL FLSHFO(LUPRI) 276 277 RETURN 278 END 279 280*=====================================================================* 281* END OF SUBROUTINE CC_XOPA * 282*=====================================================================* 283c /* deck ccxopa_setup */ 284*=====================================================================* 285 SUBROUTINE CCXOPA_SETUP(IFTRAN, IFDOTS, FCONS, 286 & NFTRAN, MXFTRAN, MXFVEC, 287 & IEATRAN, IEADOTS, EACONS, 288 & NXE1TRAN,MXATRAN, MXAVEC, 289 & IXE2TRAN,IX2DOTS, X2CONS, 290 & NXE2TRAN,MXXTRAN, MXXVEC, 291 & RESULT, MXOPA, LADD, WORK, LWORK ) 292*---------------------------------------------------------------------* 293* 294* Purpose: set up for CC first-order transition moments 295* - list of B matrix transformations with eigenvectors 296* - list of A{X} matrix transformations with eigenvectors 297* - list of XKSI vector contractions with Nbar multipliers 298* 299* Written by Christof Haettig, Oct 2003 300* 301*=====================================================================* 302 IMPLICIT NONE 303#include "priunit.h" 304#include "cclists.h" 305#include "ccxopainf.h" 306#include "ccroper.h" 307#include "ccexci.h" 308#include "ccsdinp.h" 309#include "ccorb.h" 310 311* local parameters: 312 CHARACTER*(22) MSGDBG 313 PARAMETER (MSGDBG = '[debug] CCXOPA_SETUP> ') 314 LOGICAL LOCDBG 315 PARAMETER (LOCDBG = .FALSE.) 316 317 LOGICAL LADD 318 INTEGER MXOPA,MXFTRAN,MXFVEC,MXATRAN,MXAVEC,MXXTRAN,MXXVEC 319 320 INTEGER IFTRAN(MXDIM_FTRAN,MXFTRAN) 321 INTEGER IFDOTS(MXFVEC,MXFTRAN) 322 INTEGER IEATRAN(MXDIM_XEVEC,MXATRAN) 323 INTEGER IEADOTS(MXAVEC,MXATRAN) 324 INTEGER IXE2TRAN(MXDIM_XEVEC,MXXTRAN) 325 INTEGER IX2DOTS(MXXVEC,MXXTRAN) 326 327 INTEGER NFTRAN, NXE1TRAN, NXE2TRAN, LWORK 328 329#if defined (SYS_CRAY) 330 REAL RESULT(MXOPA) 331 REAL FCONS(MXFVEC,MXFTRAN) 332 REAL EACONS(MXAVEC,MXATRAN) 333 REAL X2CONS(MXXVEC,MXXTRAN) 334 REAL WORK(LWORK) 335 REAL ZERO, SIGN, EIGVI, EIGVF 336 REAL WIAF, WXINIF, WIBF 337#else 338 DOUBLE PRECISION RESULT(MXOPA) 339 DOUBLE PRECISION FCONS(MXFVEC,MXFTRAN) 340 DOUBLE PRECISION EACONS(MXAVEC,MXATRAN) 341 DOUBLE PRECISION X2CONS(MXXVEC,MXXTRAN) 342 DOUBLE PRECISION WORK(LWORK) 343 DOUBLE PRECISION ZERO, SIGN, EIGVI, EIGVF 344 DOUBLE PRECISION WIAF, WXINIF, WIBF 345#endif 346 PARAMETER (ZERO = 0.0D0) 347 348 CHARACTER LABEL*(8) 349 LOGICAL LORX, LPDBS 350 INTEGER ITRAN, I, IRSD, IRSDX, ISTATEI, ISTATEF, ISYMI, ISYMF, 351 & ISTISY, ISTFSY, IOP, IOPER, ISYMO, ISYME, ITURN, 352 & IKAP, MXEAVEC, MXE2VEC, IN2VEC, IR1VEC, MFVEC, 353 & ITMIF, IVEC, NBOPA, IDUM 354 355* external functions: 356 INTEGER IR1TAMP 357 INTEGER IN2AMP 358 359*---------------------------------------------------------------------* 360* initializations: 361*---------------------------------------------------------------------* 362 DO ITRAN = 1, MXATRAN 363 IEATRAN(1,ITRAN) = 0 364 IEATRAN(2,ITRAN) = 0 365 IEATRAN(3,ITRAN) = -1 366 IEATRAN(4,ITRAN) = -1 367 IEATRAN(5,ITRAN) = 0 368 DO IVEC = 1, MXAVEC 369 IEADOTS(IVEC,ITRAN) = 0 370 END DO 371 END DO 372 373 DO ITRAN = 1, MXXTRAN 374 IXE2TRAN(1,ITRAN) = 0 375 IXE2TRAN(2,ITRAN) = 0 376 IXE2TRAN(3,ITRAN) = -1 377 IXE2TRAN(4,ITRAN) = -1 378 IXE2TRAN(5,ITRAN) = 0 379 DO IVEC = 1, MXXVEC 380 IX2DOTS(IVEC,ITRAN) = 0 381 END DO 382 END DO 383 384 DO ITRAN = 1, MXFTRAN 385 DO I = 1, 3 386 IFTRAN(I,ITRAN) = 0 387 END DO 388 DO IVEC = 1, MXFVEC 389 IFDOTS(IVEC,ITRAN) = 0 390 END DO 391 END DO 392 393 NFTRAN = 0 394 NXE1TRAN = 0 395 NXE2TRAN = 0 396 397 NBOPA = 0 398 MFVEC = 0 399 MXE2VEC = 0 400 MXEAVEC = 0 401 402*---------------------------------------------------------------------* 403* start loop over all requested transition moments: 404*---------------------------------------------------------------------* 405 DO IRSDX = 1, 2*NXQR2ST 406 ITURN = 1 + (IRSDX-1)/NXQR2ST 407 IRSD = IRSDX - (ITURN-1)*NXQR2ST 408 409 IF (ITURN.EQ.1) THEN 410 ISTATEI = IQR2ST(IRSD,1) 411 ISTATEF = IQR2ST(IRSD,2) 412 ELSE IF (ITURN.EQ.2) THEN 413 ! switch state indices (and thereby also the sign of the freqs) 414 ! to get the conjugated transition moments 415 ISTATEI = IQR2ST(IRSD,2) 416 ISTATEF = IQR2ST(IRSD,1) 417 ELSE 418 CALL QUIT('Error in CCXOPA_SETUP') 419 END IF 420 421 ISYMI = ISYEXC(ISTATEI) 422 ISYMF = ISYEXC(ISTATEF) 423 ISYME = MULD2H(ISYMI,ISYMF) 424 ISTISY = ISTATEI - ISYOFE(ISYMI) 425 ISTFSY = ISTATEF - ISYOFE(ISYMF) 426 EIGVI = EIGVAL(ISTATEI) 427 EIGVF = EIGVAL(ISTATEF) 428 429 IF (LOCDBG) THEN 430 WRITE(LUPRI,*) 'CCXOPA_SETUP:' 431 WRITE(LUPRI,*) 'ITURN,IRSD:',ITURN,IRSD 432 WRITE(LUPRI,*) 'ISTATEI,ISTATEF:',ISTATEI,ISTATEF 433 WRITE(LUPRI,*) 'ISYMI,ISYMF:',ISYMI,ISYMF 434 WRITE(LUPRI,*) 'ISTISY,ISTFSY:',ISTISY,ISTFSY 435 WRITE(LUPRI,*) 'EIGVI,EIGVF:',EIGVI,EIGVF 436 END IF 437 438 DO IOP = 1, NQR2OP 439 IOPER = IQR2OP(IOP) 440 LORX = .FALSE. 441 ISYMO = ISYOPR(IOPER) 442 LABEL = LBLOPR(IOPER) 443 LPDBS = LPDBSOP(IOPER) 444 IKAP = 0 445 446 IF (LPDBS) CALL QUIT('perturbation-dependent basis sets not '// 447 & 'implemented in CCXOPA_SETUP.') 448 449 IF (ISYMO.EQ.ISYME) THEN 450 451 NBOPA = NBOPA + 1 452 453 IF (NBOPA.GT.MXOPA) THEN 454 CALL QUIT('NBOPA out of range in CCXOPA_SETUP.') 455 END IF 456 457*---------------------------------------------------------------------* 458* in all cases we need LE x A{X} x RE 459*---------------------------------------------------------------------* 460 CALL CC_SETXE('Eta',IEATRAN,IEADOTS,MXATRAN,MXAVEC, 461 & ISTATEI,IOPER,IKAP,0,0,0,ISTATEF,ITRAN,IVEC) 462 NXE1TRAN = MAX(NXE1TRAN,ITRAN) 463 MXEAVEC = MAX(MXEAVEC, IVEC) 464 WIAF = EACONS(IVEC,ITRAN) 465 466*---------------------------------------------------------------------* 467* add N2 * Xksi{X} or LE * B * RE * R1, depending on QR22N1 468*---------------------------------------------------------------------* 469 WXINIF = ZERO 470 WIBF = ZERO 471 472 IF (.NOT.CIS) THEN 473 !if (lskiplineq) then 474 !else 475 IF (QR22N1) THEN 476 IN2VEC=IN2AMP(ISTATEI,-EIGVI,ISYMI,ISTATEF,+EIGVF,ISYMF) 477 CALL CC_SETXE('Xi ',IXE2TRAN,IX2DOTS,MXXTRAN,MXXVEC, 478 & 0,IOPER,IKAP,0,0,0,IN2VEC,ITRAN,IVEC) 479 NXE2TRAN = MAX(NXE2TRAN,ITRAN) 480 MXE2VEC = MAX(MXE2VEC, IVEC) 481 WXINIF = X2CONS(IVEC,ITRAN) 482 ELSE 483 !if (LEOMXOPA) then 484 ! write(lupri,*)'Sonia XOPA: Skip (W_i-W_f) contrib' 485 ! NXE2TRAN = 0 486 ! WXINIF = ZERO 487 !else 488 IR1VEC = IR1TAMP(LABEL,LORX,EIGVI-EIGVF,IDUM) 489 CALL CC_SETF12(IFTRAN,IFDOTS,MXFTRAN,MXFVEC, 490 & ISTATEI,ISTATEF,IR1VEC,ITRAN,IVEC) 491 NFTRAN = MAX(NFTRAN,ITRAN) 492 MFVEC = MAX(MFVEC, IVEC) 493 WIBF = FCONS(IVEC,ITRAN) 494 !end if 495 END IF 496 !end if 497 END IF 498 499*---------------------------------------------------------------------* 500* add contributions together: 501*---------------------------------------------------------------------* 502 IF (LADD) THEN 503 504 ITMIF = (NQR2OP*(IRSD-1) + IOP-1)*2 + ITURN 505 506 RESULT(ITMIF) = WIAF + WXINIF + WIBF 507 508 IF (LOCDBG) THEN 509 WRITE (LUPRI,*) 'ISTATEI, EIGVI:',ISTATEI,EIGVI 510 WRITE (LUPRI,*) 'ISTATEF, EIGVF:',ISTATEF,EIGVF 511 WRITE (LUPRI,*) 'OPERATOR:',LABEL 512 WRITE (LUPRI,*) 'IDX = ',ITMIF 513 WRITE (LUPRI,*) 'L^i A{X} x R^f :',WIAF 514 WRITE (LUPRI,*) 'N^if x Xksi{X}:',WXINIF 515 WRITE (LUPRI,*) 'L^i x B x R^f x R^X:',WIBF 516 WRITE (LUPRI,*) 'Total result:',RESULT(ITMIF) 517 END IF 518 519 END IF 520 521*---------------------------------------------------------------------* 522* end loop over transition moments 523*---------------------------------------------------------------------* 524 525 END IF 526 END DO 527 END DO 528 529 IF (MFVEC.GT.MXFVEC) THEN 530 CALL QUIT('MFVEC has been out of bounds in CCXOPA_SETUP.') 531 ELSE IF (MXEAVEC.GT.MXAVEC) THEN 532 CALL QUIT('MXEAVEC has been out of bounds in CCXOPA_SETUP.') 533 ELSE IF (MXE2VEC.GT.MXXVEC) THEN 534 CALL QUIT('MXE2VEC has been out of bounds in CCXOPA_SETUP.') 535 ELSE IF (NFTRAN.GT.MXFTRAN) THEN 536 CALL QUIT('NFTRAN has been out of bounds in CCXOPA_SETUP.') 537 ELSE IF (NXE1TRAN.GT.MXATRAN) THEN 538 CALL QUIT('NXE1TRAN has been out of bounds in CCXOPA_SETUP.') 539 ELSE IF (NXE2TRAN.GT.MXXTRAN) THEN 540 CALL QUIT('NXE2TRAN has been out of bounds in CCXOPA_SETUP.') 541 END IF 542 543*---------------------------------------------------------------------* 544* print the lists: 545*---------------------------------------------------------------------* 546* general statistics: 547 IF ((.NOT.LADD) .OR. LOCDBG) THEN 548 WRITE(LUPRI,'(/,/3X,A,I3,A)') 'For the requested',NBOPA, 549 & ' transition moments' 550 WRITE(LUPRI,'((8X,A,I3,A))') 551 & ' - ',NFTRAN, ' F matrix transformations with RE vectors', 552 & ' - ',NXE1TRAN,' A{X} matrix transformations with LE vectors', 553 & ' - ',NXE2TRAN,' extra XKSI vector calculations ' 554 WRITE(LUPRI,'(3X,A,/,/)') 'will be performed.' 555 END IF 556 557 IF (LOCDBG) THEN 558 559 ! F matrix transformations: 560 WRITE(LUPRI,*)'List of F matrix transformations:' 561 DO ITRAN = 1, NFTRAN 562 WRITE(LUPRI,'(A,2I5,5X,(25I3,20X))') MSGDBG, 563 & (IFTRAN(I,ITRAN),I=1,2),(IFDOTS(I,ITRAN),I=1,MFVEC) 564 END DO 565 WRITE(LUPRI,*) 566 567 ! LE x A{X} vector calculations: 568 WRITE(LUPRI,*) 'List of A{O} matrix transformations:' 569 DO ITRAN = 1, NXE1TRAN 570 WRITE(LUPRI,'(A,5I5,5X,(25I3,20X))') MSGDBG, 571 & (IEATRAN(I,ITRAN),I=1,5),(IEADOTS(I,ITRAN),I=1,MXEAVEC) 572 END DO 573 WRITE(LUPRI,*) 574 575 ! extra Xi{O} vector calculations: 576 WRITE(LUPRI,*) 'List of extra Xi{O} vector calculations:' 577 DO ITRAN = 1, NXE2TRAN 578 WRITE(LUPRI,'(A,5I5,5X,(25I3,20X))') MSGDBG, 579 & (IXE2TRAN(I,ITRAN),I=1,5),(IX2DOTS(I,ITRAN),I=1,MXE2VEC) 580 END DO 581 WRITE(LUPRI,*) 582 583 END IF 584 585 RETURN 586 END 587 588*---------------------------------------------------------------------* 589* END OF SUBROUTINE CCXOPA_SETUP * 590*---------------------------------------------------------------------* 591