1*=====================================================================*
2       SUBROUTINE CC_SETK11(IKTRAN,IKDOTS,MXTRAN,MXVEC,
3     &                      IZETVA,IZETVB,ITAMPC,ITRAN,IVEC)
4*---------------------------------------------------------------------*
5*
6*    Purpose: set up list of K matrix transformations
7*             assumes that bar{T^A} and bar{T^B} members of the same list
8*
9*             IKTRAN - list of K matrix transformations
10*             IKDOTS - list of vectors it should be dottet on
11*
12*             MXTRAN - maximum list dimension
13*             MXVEC  - maximum second dimension for IBDOTS
14*
15*             IZETVA - index of lagrangian multiplier vector A
16*             IZETVB - index of lagrangian multiplier vector B
17*             ITAMPC - index of amplitude vector C
18*
19*             ITRAN - index in IKTRAN list
20*             IVEC  - second index in IKDOTS list
21*
22*    CCMM JK+OC, modified version of CC_SETB11
23*
24*=====================================================================*
25      IMPLICIT NONE
26
27#include "priunit.h"
28      INTEGER MXVEC, MXTRAN
29      INTEGER IKTRAN(3,MXTRAN)
30      INTEGER IKDOTS(MXVEC,MXTRAN)
31
32      LOGICAL LFND
33      INTEGER IZETVA, IZETVB, ITAMPC
34      INTEGER ITRAN, IVEC
35      INTEGER IZETV, I, IDX
36
37* statement  functions:
38      LOGICAL LBTST, LBEND
39      INTEGER IB, IA
40      LBTST(ITRAN,IA,IB) =
41     &      ( IKTRAN(1,ITRAN).EQ.IA .AND. IKTRAN(2,ITRAN).EQ.IB ) .OR.
42     &      ( IKTRAN(1,ITRAN).EQ.IB .AND. IKTRAN(2,ITRAN).EQ.IA )
43      LBEND(ITRAN) = ITRAN.GT.MXTRAN .OR.
44     &   (IKTRAN(1,ITRAN)+IKTRAN(2,ITRAN)).LE.0
45
46*---------------------------------------------------------------------*
47* set up list of K matrix transformations
48*---------------------------------------------------------------------*
49      ITRAN = 1
50      LFND = LBTST(ITRAN,IZETVA,IZETVB)
51
52      DO WHILE ( .NOT. (LFND.OR.LBEND(ITRAN)) )
53       ITRAN = ITRAN + 1
54       LFND = LBTST(ITRAN,IZETVA,IZETVB)
55      END DO
56
57      IF (.NOT.LFND) THEN
58        IKTRAN(1,ITRAN) = IZETVA
59        IKTRAN(2,ITRAN) = IZETVB
60        IKTRAN(3,ITRAN) = 0
61        IZETV = ITAMPC
62      ELSE
63        IF (LFND) IZETV = ITAMPC
64      END IF
65
66      IVEC = 1
67      DO WHILE (IKDOTS(IVEC,ITRAN).NE.IZETV .AND.
68     &           IKDOTS(IVEC,ITRAN).NE.0 .AND. IVEC.LE.MXVEC)
69        IVEC = IVEC + 1
70      END DO
71
72      IKDOTS(IVEC,ITRAN) = IZETV
73
74*---------------------------------------------------------------------*
75      IF (IVEC.GT.MXVEC .OR. ITRAN.GT.MXTRAN) THEN
76        WRITE (LUPRI,*) 'IVEC :',IVEC
77        WRITE (LUPRI,*) 'ITRAN:',ITRAN
78        WRITE (LUPRI,*) 'IZETVA,IZETVB:',IZETVA,IZETVB
79        IDX = 1
80        DO WHILE ( .NOT. LBEND(IDX) )
81          WRITE(LUPRI,'(A,3I5,5X,(12I5,20X))') 'CC_SETK11>',
82     &       (IKTRAN(I,IDX),I=1,3),(IKDOTS(I,IDX),I=1,MXVEC)
83          IDX = IDX + 1
84        END DO
85        CALL FLSHFO(LUPRI)
86        CALL QUIT('Overflow error in CC_SETK11.')
87      END IF
88
89      RETURN
90      END
91
92
93