C
C=======================================================================
C
      SUBROUTINE INV_MAT_MS(JE,TAU)
C
C   This subroutine stores the multiple scattering matrix and computes 
C     the scattering path operator TAU^{j 0} exactly, without explicitely 
C     using the inverse matrix.
C
C                           (Photoelectron case)
C
C                                         Last modified : 28 Mar 2007
C
      USE DIM_MOD
C
      USE COOR_MOD
      USE INIT_L_MOD
      USE TRANS_MOD

C      PARAMETER(NLTWO=2*NL_M)
C
      COMPLEX*16 HL1(0:2*NL_M),SM(LINMAX*NATCLU_M,LINMAX*NATCLU_M)
      COMPLEX*16 IN(LINMAX*NATCLU_M,LINMAX)
      COMPLEX*16 SUM_L,ONEC,IC,ZEROC
      COMPLEX*16 YLM(0:2*NL_M,-2*NL_M:2*NL_M),TLJ,TLK,EXPKJ
C
      COMPLEX TAU(LINMAX,LINFMAX,NATCLU_M)
C
      REAL*8 PI,ATTKJ,GNT(0:N_GAUNT),XKJ,YKJ,ZKJ,RKJ,ZDKJ,KRKJ
C
      INTEGER IPIV(LINMAX*NATCLU_M)
C
      CHARACTER*1 CH
C
      DATA PI /3.1415926535898D0/
C
      ONEC=(1.D0,0.D0)
      IC=(0.D0,1.D0)
      ZEROC=(0.D0,0.D0)
      IBESS=3
      CH='N'
C
C  Construction of the multiple scattering matrix MS = (I-GoT). 
C    Elements are stored using a linear index LINJ representing 
C    (J,LJ)
C
      JLIN=0
      DO JTYP=1,N_PROT
        NBTYPJ=NATYP(JTYP)
        LMJ=LMAX(JTYP,JE)
        DO JNUM=1,NBTYPJ
          JATL=NCORR(JNUM,JTYP)
          XJ=SYM_AT(1,JATL)
          YJ=SYM_AT(2,JATL)
          ZJ=SYM_AT(3,JATL)
C
          DO LJ=0,LMJ
            ILJ=LJ*LJ+LJ+1
            TLJ=DCMPLX(TL(LJ,1,JTYP,JE))
            DO MJ=-LJ,LJ
              INDJ=ILJ+MJ
              JLIN=JLIN+1
C
              KLIN=0
              DO KTYP=1,N_PROT
                NBTYPK=NATYP(KTYP)
                LMK=LMAX(KTYP,JE)
                DO KNUM=1,NBTYPK
                  KATL=NCORR(KNUM,KTYP)
                  IF(KATL.NE.JATL) THEN
                    XKJ=DBLE(SYM_AT(1,KATL)-XJ)
                    YKJ=DBLE(SYM_AT(2,KATL)-YJ)
                    ZKJ=DBLE(SYM_AT(3,KATL)-ZJ)
                    RKJ=DSQRT(XKJ*XKJ+YKJ*YKJ+ZKJ*ZKJ)
                    KRKJ=DBLE(VK(JE))*RKJ
                    ATTKJ=DEXP(-DIMAG(DCMPLX(VK(JE)))*RKJ)
                    EXPKJ=(XKJ+IC*YKJ)/RKJ
                    ZDKJ=ZKJ/RKJ
                    CALL SPH_HAR2(2*NL_M,ZDKJ,EXPKJ,YLM,LMJ+LMK)
                    CALL BESPHE2(LMJ+LMK+1,IBESS,KRKJ,HL1)
                  ENDIF
C
                  DO LK=0,LMK
                    ILK=LK*LK+LK+1
                    L_MIN=ABS(LK-LJ)
                    L_MAX=LK+LJ
                    TLK=DCMPLX(TL(LK,1,KTYP,JE))
                    DO MK=-LK,LK
                      INDK=ILK+MK
                      KLIN=KLIN+1
                      SM(KLIN,JLIN)=ZEROC
                      SUM_L=ZEROC
                      IF(KATL.NE.JATL) THEN
                        CALL GAUNT2(LK,MK,LJ,MJ,GNT)
C
                        DO L=L_MIN,L_MAX,2
                          M=MJ-MK
                          IF(ABS(M).LE.L) THEN
                            SUM_L=SUM_L+(IC**L)*HL1(L)*
     1                                   YLM(L,M)*GNT(L)
                          ENDIF
                        ENDDO
                        SUM_L=SUM_L*ATTKJ*4.D0*PI*IC
                      ELSE
                        SUM_L=ZEROC
                      ENDIF
C
                      IF(KLIN.EQ.JLIN) THEN
                         SM(KLIN,JLIN)=ONEC-TLK*SUM_L
                         IF(JTYP.EQ.1) THEN
                            IN(KLIN,JLIN)=ONEC
                         ENDIF
                      ELSE
                         SM(KLIN,JLIN)=-TLK*SUM_L
                         IF(JTYP.EQ.1) THEN
                            IN(KLIN,JLIN)=ZEROC
                         ENDIF
                      ENDIF
C
                    ENDDO
                  ENDDO
C
                ENDDO
              ENDDO
C
            ENDDO
          ENDDO
C
        ENDDO
      ENDDO
C
      LW2=(LMAX(1,JE)+1)*(LMAX(1,JE)+1)
C
C   Partial inversion of the multiple scattering matrix MS and 
C     multiplication by T : the LAPACK subroutine performing 
C
C                          A * x = b
C
C     is used where b is the block column corresponding to 
C     the absorber 0 in the identity matrix. x is then TAU^{j 0}.
C
      CALL ZGETRF(JLIN,JLIN,SM,LINMAX*NATCLU_M,IPIV,INFO1)
      IF(INFO1.NE.0) THEN
         WRITE(6,*) '     --->  INFO1 =',INFO1
      ELSE
        CALL ZGETRS(CH,JLIN,LW2,SM,LINMAX*NATCLU_M,IPIV,
     1              IN,LINMAX*NATCLU_M,INFO)
      ENDIF
C
C   Storage of the Tau matrix
C
      JLIN=0
      DO JTYP=1,N_PROT
        NBTYPJ=NATYP(JTYP)
        LMJ=LMAX(JTYP,JE) 
        DO JNUM=1,NBTYPJ
          JATL=NCORR(JNUM,JTYP)
C
          DO LJ=0,LMJ
            ILJ=LJ*LJ+LJ+1
            TLJ=DCMPLX(TL(LJ,1,JTYP,JE))
            DO MJ=-LJ,LJ
              INDJ=ILJ+MJ
              JLIN=JLIN+1
C
              KLIN=0
              DO KTYP=1,N_PROT
                NBTYPK=NATYP(KTYP)
                LMK=LMAX(KTYP,JE)
                DO KNUM=1,NBTYPK
                  KATL=NCORR(KNUM,KTYP)
C
                  DO LK=0,LMK
                    ILK=LK*LK+LK+1
                    DO MK=-LK,LK
                      INDK=ILK+MK
                      KLIN=KLIN+1
                      IF((JATL.EQ.1).AND.(LJ.LE.LF2)) THEN
                        TAU(INDK,INDJ,KATL)=CMPLX(IN(KLIN,JLIN)*TLJ)
                      ENDIF
                    ENDDO
                  ENDDO
C
                ENDDO
              ENDDO
C
            ENDDO
          ENDDO
C
        ENDDO
      ENDDO
C
      RETURN
C
      END

