SUBROUTINE FORMGP
      
      USE WINTERACTER
      USE BLK1MOD
      include 'd.inc'
      
      CHARACTER*47 MESSAGE

      DATA MESSAGE /'Enter Group Number'/
      
      DATA ITIME/0/
      
!     SWITCH TO GROUP ACTIVITY

      IF(IQSW(1) .EQ. 1) IQSW(1)=2
      IF(IQSW(2) .EQ. 1) IQSW(2)=2


!     IF FIRST TIME ASK TO LOAD FILE OR SET GROUPS = 1

      if(ITIME .EQ. 0) THEN
!     ALLOCATE ARRAY SIZES

        IF(.NOT. ALLOCATED(IGRPNUM)) THEN
          ALLOCATE (IGRPNUM(25,MAXE),MAXENT(25))
          CALL TOPAR
        ENDIF
        ISW=2
        ITIME=1
      ELSE
        CALL TOPAR
      ENDIF


!     ASSIGN A NUMBER TO THE NEW GROUP

      call wdialogload(IDD_GETINT)
      ierr=infoerror(1)

      CALL WDialogSelect(IDD_GETINT)
      ierr=infoerror(1)

      CALL WDialogPutString(IDF_STRING1,MESSAGE)
      CALL WDialogPutInteger(IDF_INTEGER1,ISW)

      CALL WDialogShow(-1,-1,0,Modal)
      ierr=infoerror(1)
!  Branch depending on type of message.
!
      DO
        IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN

          CALL WDialogGetInteger(IDF_INTEGER1,ISW)
          GO TO 200
        ENDIF
      ENDDO

  200 CONTINUE

      CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'Do you wish add these elements to the current group?'//&
                           CHAR(13)//' ','ADD ELEMENTS?')

!   If answer 'No', start afresh
!
      IF (WInfoDialog(4).EQ.2) then

!     STORE GROUP NUMBERS STARTING AT 1

        DO K=1,NEFL
          IGRPNUM(ISW,K)=NEFLAG(K)
        ENDDO
        MAXENT(ISW)=NEFL
      ELSE
!
!     FOR EACH ELEMENT SEARCH FIRST IF NOT FOUND ADD TO THE END

        DO K=1,NEFL
          DO J=1,MAXENT(ISW)
            IF(NEFLAG(K) .EQ. IGRPNUM(ISW,J)) GO TO 240
          ENDDO
          MAXENT(ISW)=MAXENT(ISW)+1
          IGRPNUM(ISW,MAXENT(ISW))=NEFLAG(K)
  240     CONTINUE
        ENDDO      
      ENDIF
  
!       REMOVE FROM OLD LIST 
      DO I=1,25
        IF(I .NE. ISW) THEN
          DO J=1,MAXENT(I)
            DO K=1,NEFL
              IF(NEFLAG(K) .EQ. IGRPNUM(I,J)) THEN
                IGRPNUM(I,J)=0
                GO TO 260  
              ENDIF
            ENDDO
  260       CONTINUE
          ENDDO
          JT=0
          LIMIT=MAXENT(I)
          J=0
  270     J=J+1
  275     IF(J+JT .LE. LIMIT) THEN
            IF(IGRPNUM(I,J+JT) .EQ. 0) THEN
              JT=JT+1
              GO TO 275
            ENDIF
            IGRPNUM(I,J)=IGRPNUM(I,J+JT)  
            GO TO 270
          ENDIF
          DO J=MAXENT(I),MAXENT(I)+1-JT,-1
            IGRPNUM(I,J)=0
          ENDDO
          MAXENT(I)=MAXENT(I)-JT
        ENDIF
      ENDDO
      
      CALL TOSER
      
      RETURN
      END

      SUBROUTINE TOSER
      USE BLK1MOD
      DO I=1,25
        DO J=1,MAXENT(I)
          IGRPSER(IGRPNUM(I,J))=I
        ENDDO
      ENDDO
      RETURN
      END      
      
      SUBROUTINE TOPAR
      USE BLK1MOD
        
      MAXENT=0
      IGRPNUM=0
        
      DO K=1,NE
        I=IGRPSER(K)
        MAXENT(I)=MAXENT(I)+1
        IGRPNUM(I,MAXENT(I))=K
      ENDDO
      RETURN
      END