BMWRTA.FORT11

      SUBROUTINE FENTRY(IJJJ1,IJJJ2,IJJJ3)
c*******************************************************************
c Moved to PSI distribution disk on 020389 - clj.
c*******************************************************************
      DOUBLE PRECISION G(30,3),X(30,3),ZETA
      PARAMETER (LTEXT=1200)
      CHARACTER LABEL*80,OPTION*4,TEXT(LTEXT)*80,TEXT2(30)*16
 1000 FORMAT(A4)
 1002 FORMAT(I5)
 1004 FORMAT(A80)
 1006 FORMAT(4F20.10)
 1008 FORMAT(5X,I5)
 1010 FORMAT(A16)
 1012 FORMAT(A16,3F16.12)
 1014 FORMAT(3F16.12)
      IIN=11
      IOUT=40
C  READ GEOMETRY AND GRADIENTS FROM FILE11.
 1    READ(IIN,1000,END=3) OPTION
      GO TO 1
 3    BACKSPACE IIN
      BACKSPACE IIN
      READ(IIN,1002) NA
      IF(NA.GT.0) GO TO 5
      GO TO 3
  5   DO  7  I=1,NA
  7   READ(IIN,1006,END=100) ZETA,(X(I,J),J=1,3)
      DO  9  I=1,NA
  9   READ(IIN,1006,END=100) ZETA,(G(I,J),J=1,3)
C  READ NA AND TEXT FROM BMAT FILE.
 11   READ(IOUT,1000,END=100) OPTION
      IF(OPTION.EQ.'CARD') THEN
            BACKSPACE IOUT
            READ(IOUT,1008) NA
            GO TO 13
      END IF
      GO TO 11
 13   READ(IOUT,1000,END=100) OPTION
      IF(OPTION(1:1).EQ.' ') GO TO 15
      GO TO 13
 15   BACKSPACE IOUT
      DO 17  I=1,NA
 17   READ(IOUT,1010,END=100) TEXT2(I)
      DO 19  I=1,NA
 19   READ(IOUT,1000,END=100) OPTION
      K=1
 21   CONTINUE
          IF ( K .GT. LTEXT ) THEN
              WRITE(6,*) 'BMWRTG: ERROR: THE TEXT BUFFER IS TOO SMALL,'
              WRITE(6,*) '        INCREASE LTEXT TO THE FILE LENGTH.'
              WRITE(6,*) 'BMWRTG: ABORTING.'
              STOP
          ENDIF
          READ(IOUT,1004,END=23)TEXT(K)
          K=K+1
          GO TO 21
C   WRITE COORDINATES,GRADIENTS, AND TEXT INTO BMAT FILE.
 23   DO 25  I=1,K+2*NA
 25   BACKSPACE IOUT
      DO 27  I=1,NA
 27   WRITE(IOUT,1012) TEXT2(I),(X(I,J),J=1,3)
      DO 29  I=1,NA
 29   WRITE(IOUT,1014) (G(I,J),J=1,3)
      DO 31  I=1,K-1
 31   WRITE(IOUT,1004) TEXT(I)
 100  CONTINUE
      END