C
C
      SUBROUTINE BASE (NSTOP)
C
C
C     -----------------------------------------------------------
C
C       SUBROUTINE PURPOSE:
C       FORMATION OF BASE SYSTEM.
C
C     -----------------------------------------------------------
C
      INCLUDE 'CMMNW.DAT'
C
C       THE AIRWAY WITH THE LEAST VALUE OF PRODUCT OF R AND Q IS TAKEN
C     AS THE "ROOT" OF THE BASE SYSTEM.
C
      IND=INU(1)
C
C       THE INFORMATION OF BASE SYSTEM IS STORED IN ARRAYS KNO,
C     KJS AND KJF.
C
      KJF(NJ)=JS(IND)
      KJS(NJ-1)=JS(IND)
      JS(IND)=-JS(IND)
      KJF(NJ-1)=JF(IND)
      KNO(NJ-1)=IND
      KNUM=NJ-1
10    DO 30 NUC=2,NB
        IND=INU(NUC)
        IF (JS(IND).LT.0) GO TO 30
        N1=0
        N0=0
        DO 20 K=KNUM,NJ
          IF (JS(IND).EQ.KJF(K)) N0=1
          IF (JF(IND).EQ.KJF(K)) N1=1
20      CONTINUE
        IF ((N1+N0).EQ.1) THEN
          IF (NWTYP(IND).LT.0) THEN
             WRITE (8,100) NO(IND)
             NWTYP(IND)=0
C                  ***
             IF (R(IND).LT.1.E-20) THEN
                WRITE (8,110)
                NSTOP=1
             ENDIF
          ENDIF
          KNUM=KNUM-1
          IF (N0.LE.0) THEN
            KJS(KNUM)=JF(IND)
            KJF(KNUM)=JS(IND)
            KNO(KNUM)=-IND
            JS(IND)=-JS(IND)
          ELSE
            KJS(KNUM)=JS(IND)
            KJF(KNUM)=JF(IND)
            KNO(KNUM)=IND
            JS(IND)=-JS(IND)
          ENDIF
          GO TO 10
        ELSE IF ((N1+N0).GT.1) THEN
          JS(IND)=-JS(IND)
          JF(IND)=-JF(IND)
        ENDIF
30    CONTINUE
      IF (KNUM.NE.1) WRITE (8,*)  'WRONG CONDITION IN SUB. BASE'
      DO 40 K=1,NB
        JS(K)=IABS(JS(K))
40    CONTINUE
C
100   FORMAT (//,1X,'* ATTN *  REGULATOR ',I5,' IN BASE SYSTEM.')
110   FORMAT (/,' * ERR * RESISTANCE OF AIRWAY ',I5,' MUST BE ',
     .       'SPECIFIED.')
C
      RETURN
      END

