SUBROUTINE G_LOC_OPEIGR(C0,C2,SC0,NSTATE,MAPFUL,MAPCOL,DDMAT,
     *                  SCR,LSCR,NOP1,NOP2)

C     ==--------------------------------------------------------------==
      IMPLICIT NONE
      include 'system.h'
      include 'spin.inc'
      include 'ddip.inc'
      include 'g_loc.inc'
C     Arguments
      INTEGER    NSTATE,MAPFUL(2,*),MAPCOL(NGWMAX,*),LSCR,NOP1,NOP2
      COMPLEX*16 C0(2*NGW,*),C2(2*NGW,*),SC0(2*NGWS,*),SCR(LSCR),
     *           DDMAT(NSTATE,*)

C     Variables
      COMPLEX*16 C2F(2*NGWS,*)
      POINTER    (IP_C2F,C2F)
#ifdef PARALLEL
      COMPLEX*16 C2S(2*LENBK,*),SC0S(2*LENBK,*)
      POINTER    (IP_C2S,C2S),(IP_SC0S,SC0S)
      INTEGER    IP,NN,N1,NGGP,IGII
#endif
      INTEGER    I,II,IG,LENGTH
      CHARACTER*30 TAG
C     ==--------------------------------------------------------------==
      CALL GIVE_SCR_OPEIGR(LENGTH,TAG,NSTATE)
      CALL TEST_SCR('OPEIGR','LENGTH',LSCR,LENGTH)
      CALL GET_ADDR(IP_C2F,C2(1,1))
      CALL AZZERO(DDMAT,2*NSTATE*NSTATE)
      IF(STATE_ALL) THEN
#ifdef PARALLEL
        CALL GET_ADDR(IP_C2S,C2(1,1))
        CALL GET_ADDR(IP_SC0S,SC0(1,1))
        DO IP=1,NPROC
          NN=NST12(IP-1,2)-NST12(IP-1,1)+1
          N1=NST12(IP-1,1)
          CALL DCOPY(2*2*NGW*NN,C0(1,N1),1,C2S(1,IP),1)
        ENDDO

        CALL MY_TRANS(C2S,SC0S,16*2*LENBK,1)
        NN=NST12(MEPOS,2)-NST12(MEPOS,1)+1
        DO IP=1,NPROC
          NGGP = SPARM(3,IP-1)
          IGII = 0
          DO II=1,NN
            DO IG=1,NGGP
              IGII=IGII+1
              C2F(MAPCOL(IG,IP)     ,II) = SC0S(IGII     ,IP)
              C2F(MAPCOL(IG,IP)+NGWS,II) = SC0S(IGII+NGGP,IP)
            ENDDO
            IGII = IGII+NGGP
          ENDDO
        ENDDO
#else
        CALL DCOPY(2*2*NGW*NSTATE,C0,1,C2F,1)
#endif
      ELSE
        CALL DCOPY(2*2*NGW*NSTATE,C0,1,C2F,1)
      ENDIF

      IF(STATE_ALL) THEN
        DO I=NST12(MEPOS,1),NST12(MEPOS,2)
          II=I-NST12(MEPOS,1)+1
          CALL AZZERO(SCR,2*NGG1*NGG2*NGG3)

          DO IG=1,NGWS
            SCR(MAPFUL(1,IG))=C2F(IG     ,II)
            SCR(MAPFUL(2,IG))=C2F(IG+NGWS,II)
          ENDDO
          CALL OPAPP(SCR,NGG1,NGG2,NGG3,NOP1)
          CALL OPAPP(SCR,NGG1,NGG2,NGG3,NOP2)
          DO IG=1,NGWS
            SC0(IG     ,II) = SCR(MAPFUL(1,IG))
            SC0(IG+NGWS,II) = SCR(MAPFUL(2,IG))
          ENDDO
            SC0(1+NGWS,II)  = DCMPLX(0.0D0,0.0D0)
        ENDDO
#ifdef PARALLEL
        NN=NST12(MEPOS,2)-NST12(MEPOS,1)+1
        DO IP=1,NPROC
          NGGP = SPARM(3,IP-1)
          IGII = 0
          DO II=1,NN
            DO IG=1,NGGP
              IGII=IGII+1
              C2S(IGII     ,IP) = SC0(MAPCOL(IG,IP)     ,II)
              C2S(IGII+NGGP,IP) = SC0(MAPCOL(IG,IP)+NGWS,II)
            ENDDO
            IGII=IGII+NGGP
          ENDDO
        ENDDO
        CALL MY_TRANS(C2S,SC0S,16*2*LENBK,1)
        DO IP=1,NPROC
          NN=NST12(IP-1,2)-NST12(IP-1,1)+1
          N1=NST12(IP-1,1)
          CALL DCOPY(2*2*NGW*NN,SC0S(1,IP),1,C2(1,N1),1)
        ENDDO
#else
        CALL DCOPY(2*2*NGW*NSTATE,SC0,1,C2,1)
#endif
      ELSE
        DO II = 1,NSTATE
          CALL AZZERO(SCR,2*NGG1*NGG2*NGG3)

          DO IG=1,NGWS
            SCR(MAPFUL(1,IG))=C2F(IG     ,II)
            SCR(MAPFUL(2,IG))=C2F(IG+NGWS,II)
          ENDDO
          CALL OPAPP(SCR,NGG1,NGG2,NGG3,NOP1)
          CALL OPAPP(SCR,NGG1,NGG2,NGG3,NOP2)
          DO IG=1,NGWS
            SC0(IG     ,II) = SCR(MAPFUL(1,IG))
            SC0(IG+NGWS,II) = SCR(MAPFUL(2,IG))
          ENDDO
            SC0(1+NGWS,II)  = DCMPLX(0.0D0,0.0D0)
        ENDDO

        CALL DCOPY(2*2*NGW*NSTATE,SC0,1,C2,1)

      ENDIF

      CALL ZGEMM('C','N',NSTATE,NSTATE,2*NGW,DCMPLX(1.D0,0.D0),
     *             C0,2*NGW,C2,2*NGW,DCMPLX(0.D0,0.D0),DDMAT,NSTATE)

      CALL GLOSUM(2*NSTATE*NSTATE,DDMAT)

      RETURN
      END