      SUBROUTINE GKAM1B(USETD,SCR1,SCR2,PHIDH,PHIDH1,MODES,CORE,
     1  LHSET,NOUE,SCR3)
C
      INTEGER       USET,USETD,PHIDH,PHIDH1,SCR1,SCR2
      INTEGER MCB(7),SYSBUF,CORE
      INTEGER SCR3
      DIMENSION CORE(1)
C
      COMMON  /SYSTEM/ SYSBUF
      COMMON  /PATX/LC,N1,N2,N3,USET
      COMMON  /BITPOS/UM,UO,UR,USG,USB,UL,UA,UF,US,UN,UG,UE,UP,UNE,UFE,
     1UD
      COMMON  /ZBLPKX/A(4),II
      COMMON  /PARMEG/ IA(7),IA11(7),IA12(7),IA21(7),IA22(7),LCORE,IRULE
C
C ----------------------------------------------------------------------
C
      LHSET =LHSET  + NOUE
C
C     BUILD  MERGE  VECTOR
C
      USET = USETD
      LC  = KORSZ(CORE(MODES))
      LCORE = LC
      CALL  CALCV(SCR1,UD,UA,UE,CORE(MODES))
C
C     BUILD  EXE  IDENTY   MATRIX
C
      NZ = LC-SYSBUF
      CALL GOPEN(SCR2,CORE(NZ+1),1)
      CALL MAKMCB(MCB,SCR2,NOUE,6,1)
      A(1) = 1.0
      DO 10 I=1,NOUE
      CALL BLDPK(1,1,SCR2,0,0)
      II = I
      CALL ZBLPKI
      CALL BLDPKN(SCR2,0,MCB)
   10 CONTINUE
      CALL  CLOSE(SCR2, 1)
      CALL WRTTRL ( MCB )
C
C     SET  UP  FOR  MERGE
C
      IRULE =0
      IA22(1)= SCR2
      CALL RDTRL(IA22)
      IA(1) = PHIDH
      IA(2)= LHSET
      IA(3) =  N1+N2+N3
      IA(4) =  2
      IA(5) = 1
      IA21 (1) = 0
      IA12 (1) = 0
      IA11 (1) = PHIDH1
      CALL MAKMCB(CORE(MODES),SCR3,LHSET,2,1)
      CALL RDTRL (IA11)
C
C     BUILD  VECTOR IN CORE
C
      CALL GOPEN(SCR3,CORE(NZ+1),1)
      CALL BLDPK(1,1,SCR3,0,0)
      II = MODES -1
      DO 20 I=1,NOUE
      II = II+1
      CALL ZBLPKI
   20 CONTINUE
      CALL BLDPKN( SCR3, 0, CORE(MODES) )
      CALL CLOSE(SCR3,1)
      CALL WRTTRL(CORE(MODES))
      CALL MERGE(SCR3,SCR1,CORE(MODES))
      CALL WRTTRL( IA )
      RETURN
      END
