C.......................................................................
C     SUB COPY_FIELD
      SUBROUTINE COPY_FIELD(CIN,COUT,IFIELD,MAXFIELD)

c	implicit none
      CHARACTER*(*) CIN(*),COUT
      INTEGER IFIELD,MAXFIELD
C internal
      INTEGER IBEG,IEND

      IF (IFIELD+1 .GT. MAXFIELD) THEN
         CALL STRPOS(CIN(IFIELD),IBEG,IEND)
         WRITE(*,*)'**** NO VALUE GIVEN FOR: ',CIN(IFIELD)(IBEG:IEND)
      ELSE
         CALL STRPOS(CIN(IFIELD+1),IBEG,IEND)
         IF (IEND .GE. 1) THEN
            COUT=CIN(IFIELD+1)(IBEG:IEND)
	    IFIELD=IFIELD+2
         ENDIF
      ENDIF
      RETURN
      END
C     END COPY_FIELD
C.......................................................................

C.......................................................................
C     SUB CALC_PROFILE
      SUBROUTINE CALC_PROFILE(MAXSQ,MAXAA,MAXSTRSTATES,MAXIOSTATES,
     +     NSTRSTATES_1,NIOSTATES_1,NSTRSTATES_2,
     +     NIOSTATES_2,
     +     SCALE_FACTOR,LOG_BASE,SIGMA,BETA,
     +     NRES,NALIGN,
     +     AL_EXCLUDEFLAG,AL_IFIRST,AL_ILAST,
     +     SEQBUFFER,ISEQPOINTER,NTRANS,TRANS,
     +     SEQ_WEIGHT,OPEN_1,ELONG_1,
     +     GAPOPEN_1,
     +     GAPELONG_1,SIMORG,SIMMETRIC_1) 
      
      INTEGER NSTRSTATES_1,NIOSTATES_1,NSTRSTATES_2,NIOSTATES_2
c	common/strstates/ nstrstates_1,niostates_1,nstrstates_2,
c     +                    niostates_2
C import
      INTEGER MAXSQ,MAXAA,NRES,NALIGN,NTRANS
      REAL SCALE_FACTOR,LOG_BASE
      REAL SIGMA,BETA
      INTEGER AL_IFIRST(*),AL_ILAST(*),ISEQPOINTER(*)
      CHARACTER SEQBUFFER(*)
      CHARACTER TRANS*(*),AL_EXCLUDEFLAG(*)
      REAL SEQ_WEIGHT(*),OPEN_1,ELONG_1,GAPOPEN_1(*),
     +     GAPELONG_1(*)
      REAL SIMORG(NTRANS,NTRANS,MAXSTRSTATES,MAXIOSTATES,
     +     MAXSTRSTATES,MAXIOSTATES)
C export
      REAL SIMMETRIC_1(MAXSQ,NTRANS)
C internal
      INTEGER MAXTRANS
      PARAMETER (MAXTRANS=26)
      INTEGER IRES,IALIGN,I,J
      REAL FREQUENCY(MAXTRANS)
      REAL BTOD,BTON,ZTOE,ZTOQ
      REAL XOCC,XINS,XDEL
      CHARACTER C1
      
      REAL SIM_COPY(MAXTRANS,MAXTRANS)
      REAL INV(MAXTRANS,MAXTRANS)
      INTEGER INDX(MAXTRANS)
      REAL PROB_I(MAXTRANS)

C================

CAUTION: pass the following values from outside
CAUTION only for BLOSUM
c	scale_factor = 0.5
c	log_base = 2.0

c	scale_factor = 1.0
c	log_base = 10.0

c	beta=1.0 ; sigma=1.0

C 'B' and 'Z' are assigned as well to the acid as to the amide form
C with respect to their frequency in EMBL/SWISSPROT 21.0
      BTOD=0.524
      BTON=0.445
      ZTOE=0.626
      ZTOQ=0.407
      ILEN=LEN(TRANS)

      WRITE(*,*)'calc_profile'

C check if MAXHOM tries do more than we implemented here :-)
      IF (NTRANS .GT. MAXTRANS) THEN
         WRITE(*,*)' WARNING: NTRANS GT MAXTRANS'
         WRITE(*,*)' update routine: calc_profile !!!'
         STOP
      ENDIF
      IF (NSTRSTATES_1 .GT. 1 .OR. NIOSTATES_1 .GT. 1 .OR.
     +     NSTRSTATES_2 .GT. 1 .OR. NIOSTATES_2 .GT. 1) THEN
         WRITE(*,*)' WARNING: routine calc_profile not'
         WRITE(*,*)' working with STR and/or I/O dependent'
         WRITE(*,*)' metrices, update routine !!!'
         STOP
      ENDIF
C copy "simorg" in "sim_copy" so "simorg" will be unchanged !
      DO I=1,NTRANS 
         DO J=1,NTRANS 
            SIM_COPY(I,J)= SIMORG(I,J,1,1,1,1)
         ENDDO
      ENDDO
C scale metric if necessary
      DO I=1,MAXTRANS 
         DO J=1,MAXTRANS 
            SIM_COPY(I,J)=SIM_COPY(I,J) * SCALE_FACTOR
         ENDDO
      ENDDO
C de-log the matrix to get the ( P(i,j) / ( P(i) * P(j) ) )
      DO I=1,MAXTRANS
         DO J=1,MAXTRANS 
            SIM_COPY(I,J)= LOG_BASE ** SIM_COPY(I,J)
         ENDDO
      ENDDO
C build diagonal matrix
      DO I=1,NTRANS
         DO J=1,NTRANS 
            INV(I,J)=0.0 
         ENDDO
         INV(I,I) =1.0
      ENDDO
C invert matrix
C NOTE: sim_copy gets changed
      CALL LUDCMP(SIM_COPY,MAXAA,MAXTRANS,INDX,D)
      DO I=1,MAXAA
         CALL LUBKSB(SIM_COPY,MAXAA,MAXTRANS,INDX,INV(1,I))
      ENDDO
C normalize to 1.0 to get the P(i)
      DO I=1,MAXAA
         SUM=0.0
         DO J=1,MAXAA 
            SUM= SUM + INV(I,J) 
         ENDDO
         PROB_I(I)=SUM
         DO J=1,MAXAA 
            INV(I,J)=INV(I,J) /SUM 
         ENDDO
C check
         SUM=0.0
         DO J=1,MAXAA 
            SUM= SUM + INV(I,J)
         ENDDO
         CALL CHECKREALEQUALITY(SUM,1.0,0.002,'sum','calc_profile')
      ENDDO
C restore sim_copy (changed by matrix inverse)
      DO I=1,MAXTRANS 
         DO J=1,MAXTRANS 
            SIM_COPY(I,J)= SIMORG(I,J,1,1,1,1)
         ENDDO
      ENDDO
C scale metric
      DO I=1,MAXTRANS 
         DO J=1,MAXTRANS 
            SIM_COPY(I,J)=SIM_COPY(I,J) * SCALE_FACTOR
         ENDDO
      ENDDO
C de-log the matrix and multiply by P(i) to get the conditional probabilities:
C  ( P(i,j) | P(j) )
      DO I=1,MAXTRANS
         DO J=1,MAXTRANS 
            SIM_COPY(I,J)= ( LOG_BASE ** SIM_COPY(I,J) ) * PROB_I(I)
         ENDDO
      ENDDO
C check sum rule
      DO J=1,MAXAA
         SIM=0.0
         DO I=1,MAXAA
            SIM = SIM + SIM_COPY(I,J)
         ENDDO
c	   write(*,*)'sum P(i,j) | P(j): ',j,sim
         CALL CHECKREALEQUALITY(SIM,1.0,0.002,'sim','calc_profile')
      ENDDO
C     calculate sequence profile
      DO IRES=1,NRES  
         XOCC=0.0 
         XINS=0.0 
         XDEL=0.0
         DO I=1,MAXTRANS 
            FREQUENCY(I)=0.0
         ENDDO
         DO IALIGN=1,NALIGN
            IF (IRES .GE. AL_IFIRST(IALIGN) .AND. 
     +           IRES .LE. AL_ILAST(IALIGN)
     +           .AND. AL_EXCLUDEFLAG(IALIGN) .EQ. ' ') THEN
               C1=SEQBUFFER( ISEQPOINTER(IALIGN) + 
     +              IRES-AL_IFIRST(IALIGN) )
C if lower case character: insertions
               IF (C1 .GE. 'a' .AND. C1 .LE. 'z') THEN
                  C1=CHAR( ICHAR(C1)-32 )
                  XINS=XINS + SEQ_WEIGHT(IALIGN)
               ENDIF
               IF (C1 .NE. '.') THEN
                  XOCC=XOCC + SEQ_WEIGHT(IALIGN)
                  IF (INDEX('BZ',C1).EQ.0) THEN
                     I=INDEX(TRANS,C1)
                     IF (I .LE. 0 .OR. I .GT. ILEN) THEN
                        WRITE(*,*)' GETFREQUENCY: UNKNOWN RES : ',C1
                     ELSE
                        FREQUENCY(I)=FREQUENCY(I) + SEQ_WEIGHT(IALIGN)
                     ENDIF
                  ELSE IF (C1 .EQ. 'B') THEN
                     WRITE(*,*)' GETFREQUENCY: convert B'
                     I=INDEX(TRANS,'D')
                     J=INDEX(TRANS,'N')
                     FREQUENCY(I)=FREQUENCY(I)+(BTOD*SEQ_WEIGHT(IALIGN))
                     FREQUENCY(J)=FREQUENCY(J)+(BTON*SEQ_WEIGHT(IALIGN))
                  ELSE IF (C1 .EQ. 'Z') THEN
                     WRITE(*,*)' GETFREQUENCY: convert Z'
                     I=INDEX(TRANS,'E')
                     J=INDEX(TRANS,'Q')
                     FREQUENCY(I)=FREQUENCY(I)+(ZTOE*SEQ_WEIGHT(IALIGN))
                     FREQUENCY(J)=FREQUENCY(J)+(ZTOQ*SEQ_WEIGHT(IALIGN))
	          ENDIF
               ELSE 
C if '.' : deletion
		  XDEL=XDEL+ SEQ_WEIGHT(IALIGN)
               ENDIF
            ENDIF
         ENDDO	
C======================
C profile
         SUM= 0.0 
         DO I=1,MAXAA 
            SUM = SUM + FREQUENCY(I) 
         ENDDO
         IF (SUM .NE. 0.0) THEN
            DO I=1,MAXAA 
               FREQUENCY(I)= FREQUENCY(I) / SUM 
            ENDDO
C check sum rule for frequencies
            X=0.0 
            DO I=1,MAXAA 
               X = X + FREQUENCY(I) 
            ENDDO
            CALL CHECKREALEQUALITY(X,1.0,0.002,'freq','calc_profile')
C smooth the profile
C sigma: smooth dependent on the number of alignments
C beta:  mixing of the two models (expected <--> observed)
            SMOOTH= ( SUM / (SUM +SIGMA)) * BETA
C do for each of the AA types in a row
            DO I=1,MAXAA

               SIM=0.0
C sum up the conditional probabilities 
               DO J=1,MAXAA
                  SIM = SIM + ( FREQUENCY(J) * SIM_COPY(I,J) )
               ENDDO
C add the observed frequencies and smooth
               SIMMETRIC_1(IRES,I)=( (1-SMOOTH) * SIM) + 
     +              (SMOOTH * FREQUENCY(I) )
C divide by the expected probability
               SIMMETRIC_1(IRES,I)=SIMMETRIC_1(IRES,I)/PROB_I(I)
c	        simmetric_1(ires,i)= frequency(i) /prob_i(i)
C log-odd
               IF (SIMMETRIC_1(IRES,I) .LE. 10E-3) THEN
                  SIMMETRIC_1(IRES,I)=10E-3
               ENDIF
               SIMMETRIC_1(IRES,I)=LOG10 ( SIMMETRIC_1(IRES,I) )



c	        write(*,*)ires,trans(i:i),sum,frequency(i),
c     +                    sim,smooth,simmetric_1(ires,i)
C gap-weights 
               GAPOPEN_1(IRES) =OPEN_1  / (1.0 + ((XINS+XDEL)/SUM)) 
               GAPELONG_1(IRES)=ELONG_1 / (1.0 + ((XINS+XDEL)/SUM)) 
            ENDDO
         ELSE
            WRITE(*,*)'CALC_PROFILE: position not occupied !'
            C1=SEQBUFFER( ISEQPOINTER(1)+IRES-AL_IFIRST(1) )
            WRITE(*,*)'  sequence symbol of first sequence: ',c1
            WRITE(*,*)'  set profile row to 0.0'
            DO I=1,MAXAA 
               SIMMETRIC_1(IRES,I)=0.0 
            ENDDO
            GAPOPEN_1(IRES) = 0.0 
            GAPELONG_1(IRES)= 0.0
         ENDIF
      ENDDO
C set value for chain breaks etc... to 0.0
C later there are refilled in MAXHOM (like "!" = -200.0)
      IX=INDEX(TRANS,'X')
      IB=INDEX(TRANS,'B')
      IZ=INDEX(TRANS,'Z')
      I1=INDEX(TRANS,'!')
      I2=INDEX(TRANS,'-')
      DO IRES=1,NRES  
         SIMMETRIC_1(IRES,IX)=0.0
         SIMMETRIC_1(IRES,IB)=0.0
         SIMMETRIC_1(IRES,IZ)=0.0
         SIMMETRIC_1(IRES,I1)=0.0
         SIMMETRIC_1(IRES,I2)=0.0
      ENDDO

      RETURN
      END
C     END CALC_PROFILE
C.......................................................................

C.......................................................................
C     SUB HSSP
      SUBROUTINE HSSP(NALIGN,CHAINREMARK)
C write  XX.HSSP files using alignment-data      RS 1988/89
      IMPLICIT NONE
      INCLUDE 'maxhom.param'
      INCLUDE 'maxhom.common'
C import
      INTEGER NALIGN
      CHARACTER*(*) CHAINREMARK
C internal
c	character*1   csq_1_array(maxsq)
      CHARACTER     CTEMP*128,HSSPFILE*200,CDATE*9
      CHARACTER*132 HSSPLINE,DATABASE,CPARAMETER(10)
      REAL RMIN,RMAX
      REAL RELEASE
      INTEGER NPARALINE,NRES,LRES,NENTRIES,NRESIDUE
      INTEGER I,J,ISTART,ISTOP
c initialize
      DO I=1,NALIGN 
         AL_EXCLUDEFLAG(I)=' '
      ENDDO
      DO J=1,MAXSQ
         DO I=1,MAXPROFAA 
            AL_SEQPROF(J,I)=0
         ENDDO
      ENDDO
      DO J=1,MAXSQ
         AL_VARIABILITY(J)=0 
         AL_ENTROPY(J)=0
         NOCC_1(J)=0 
         AL_NDELETION(J)=0 
         AL_NINS(J)=0
      ENDDO
C HSSP release note
      WRITE(HSSPLINE,'(A)')'HSSP       HOMOLOGY DERIVED SECONDARY'//
     +     ' STRUCTURE OF PROTEINS , VERSION 1.0 1991'
C get swissprot release
      CALL SWISSPROTRELEASE(KREL,RELNOTES,RELEASE,NENTRIES,NRESIDUE)
      WRITE(DATABASE,'(A,F4.1,A,I6,A)')'SEQBASE    RELEASE ',release,
     +     ' OF EMBL/SWISS-PROT WITH ',nentries,' SEQUENCES'
c get actual date
      CDATE=' '
      CALL GETDATE (CDATE)
C get GCG-metric file and scale between 0.0 and 1.0
      RMIN=0.0 
      RMAX=1.0
      CALL GETSIMMETRIC(NTRANS,TRANS,MAXSTRSTATES,MAXIOSTATES,
     +     NSTRSTATES_1,NIOSTATES_1,NSTRSTATES_2,
     +     NIOSTATES_2,CSTRSTATES,CIOSTATES,
     +     IORANGE,KSIM,METRIC_HSSP_VAR,SIMORG)
      IF (NSTRSTATES_1 .NE. 1 .OR. NIOSTATES_1 .NE. 1) THEN
         WRITE(*,*)'**** ERROR: NSTRSTATES_1 OR NIOSTATES_1 .GT. 1'
         WRITE(*,*)'CHANGE CALC_VAR ROUTINE'
      ENDIF
      CALL SCALEMETRIC(NTRANS,TRANS,MAXSTRSTATES,MAXIOSTATES,
     +     SIMORG,RMIN,RMAX,0.0,0.0)
C write alignment parameter in CPARAMETER (passed to HSSPHEADER)
      NPARALINE=1
      WRITE(CPARAMETER(NPARALINE),'(A,F4.1,A,F4.1)')
     +     ' SMIN: ',SMIN,'  SMAX: ',SMAX
      NPARALINE=NPARALINE+1
	
      IF (OPENWEIGHT_ANSWER .EQ. 'PROFILE' ) THEN
         WRITE(CPARAMETER(NPARALINE),'(A,A)')
     +        ' gap-open: profile',' gap-elongation: profile'
      ELSE
         WRITE(CPARAMETER(NPARALINE),'(A,F4.1,A,F4.1)')
     +    ' gap-open: ',gapopen_1(1),' gap-elongation: ',gapelong_1(1)
      ENDIF
      IF (LPROFILE_1 .OR. LPROFILE_2) THEN
         NPARALINE=NPARALINE+1
         WRITE(CPARAMETER(NPARALINE),'(A,A)')
     +	      '  profile from : ',name_1(1:100)
      ENDIF
      NPARALINE=NPARALINE+1
      IF (LCONSERV_1 .OR. LCONSERV_2 .OR. LCONSIMPORT) THEN
         WRITE(CPARAMETER(NPARALINE),'(A)')
     +        '  conservation weights: YES'
      ELSE
         WRITE(CPARAMETER(NPARALINE),'(A)')
     +        '  conservation weights: NO'
      ENDIF
      NPARALINE=NPARALINE+1
      IF (LINSERT_1) THEN
         WRITE(CPARAMETER(NPARALINE),'(A)')
     +        'InDels in secondary structure allowed: YES'  
      ELSE
         WRITE(CPARAMETER(NPARALINE),'(A)')
     +        'InDels in secondary structure allowed: NO'
      ENDIF
      NPARALINE=NPARALINE+1
      CALL CONCAT_STRINGS('  alignments sorted according to : ',
     +     CSORTMODE,CPARAMETER(NPARALINE) )
        
      IF (LHSSP_LONG_ID .EQV. .TRUE.) THEN
         NPARALINE=NPARALINE+1
         CALL CONCAT_STRINGS('  LONG-ID : ',
     +        HSSP_FORMAT_ANSWER,CPARAMETER(NPARALINE) )
      ENDIF

      IF (HSSP_ANSWER .EQ. 'YES') THEN
         CALL CONCAT_STRINGS(HSSPID_1,'.hssp',HSSPFILE)
      ELSE
         HSSPFILE=HSSP_ANSWER
      ENDIF
      BRKID_1=HSSPID_1(1:4)
C
      IF (.NOT. LDSSP_1 ) THEN
         NRES=N1 
         LRES=N1
	 HEADER_1=NAME_1(1:40)
	 COMPND_1=' ' 
         SOURCE_1=' ' 
         AUTHOR_1=' '
      ELSE
	 NRES=N1 
         LRES=NRES-NCHAINUSED+1
      ENDIF

      DO I=1,N1 
         CSQ_1_ARRAY(I)=CSQ_1(I:I) 
      ENDDO
      CALL CALC_VAR(NALIGN,NRES,CSQ_1_ARRAY,AL_HOM,
     +     AL_IFIRST,AL_ILAST,ISEQPOINTER,
     +     SEQBUFFER,AL_EXCLUDEFLAG,MAXSTRSTATES,MAXIOSTATES,
     +     NTRANS,TRANS,SIMORG,AL_VARIABILITY)
      CALL CALC_PROF(MAXSQ,MAXPROFAA,NRES,CSQ_1_ARRAY,NALIGN,
     +     AL_EXCLUDEFLAG,AL_HOM,AL_IFIRST,
     +     AL_ILAST,SEQBUFFER,ISEQPOINTER,TRANS,AL_SEQPROF,
     +     NOCC_1,AL_NDELETION,AL_NINS,AL_ENTROPY,AL_RELENT)
      
      IF (CHAINREMARK .NE. ' ') THEN
         CTEMP=' '
         I=INDEX(CHAINREMARK,'!')
         IF (I .NE. 0) THEN	
            WRITE(CTEMP,'(A)')CHAINREMARK(I+2:)
         ENDIF
         CHAINREMARK=' '
         CALL STRPOS(CTEMP,ISTART,ISTOP)
         WRITE(CHAINREMARK,'(A)')CTEMP(1:ISTOP)
      ENDIF
      CALL HSSPHEADER(KHSSP,HSSPFILE,HSSPLINE,HSSPID_1,CDATE,DATABASE,
     +     CPARAMETER,NPARALINE,ISOSIGFILE,ISAFE,LFORMULA,
     +     HEADER_1,COMPND_1,SOURCE_1,AUTHOR_1,LRES,
     +     NCHAIN_1,NCHAINUSED,CHAINREMARK,NALIGN)
      CALL WRITE_HSSP(KHSSP,MAXSQ,NALIGN,NRES,AL_EMBLPID,
     +     AL_PDB_POINTER,AL_ACCESSION,AL_HOM,AL_SIM,
     +     AL_IFIRST,AL_ILAST,AL_JFIRST,AL_JLAST,AL_HOMLEN,
     +     AL_NGAP,AL_LGAP,AL_LSEQ_2,AL_COMPOUND,
     +     ISEQPOINTER,SEQBUFFER,PDBNO_1,CHAINID_1,
     +     CSQ_1_ARRAY,STRUC_1,COLS_1,BP1_1,BP2_1,
     +     SHEETLABEL_1,NSURF_1,NOCC_1,AL_VARIABILITY,
     +     AL_SEQPROF,AL_NDELETION,AL_NINS,AL_ENTROPY,
     +     AL_RELENT,CONSWEIGHT_1,INSNUMBER,INSALI,
     +     INSPOINTER,INSLEN,INSBEG_1,INSBEG_2,INSBUFFER,
     +     ISOLEN,ISOIDE,NSTEP,LFORMULA,LALL,ISAFE,
     +     AL_EXCLUDEFLAG,LCONSERV_1,LHSSP_LONG_ID)
	RETURN
        END
C     END HSSP
C.......................................................................

C.......................................................................
C     SUB READ_FILENAME
      SUBROUTINE READ_FILENAME(KUNIT,FILENAME,LENDFILE,LERROR)
      
      CHARACTER*(*) FILENAME
      INTEGER KUNIT
      LOGICAL LENDFILE,LERROR
      
      LENDFILE=.FALSE. 
      LERROR=.FALSE.
      FILENAME=' '
      READ(KUNIT,'(A)',END=100,ERR=200)FILENAME
      RETURN
 100  LENDFILE=.TRUE.
      RETURN
 200  LERROR=.TRUE.
      RETURN
      END
C     END READ_FILENAME
C.......................................................................

C.......................................................................
C     SUB RECEIVE_RESULTS_FROM_NODE
      SUBROUTINE RECEIVE_RESULTS_FROM_NODE(NALIGN)
C import
      INCLUDE 'maxhom.param'
      INCLUDE 'maxhom.common'
C export
      INTEGER NALIGN
C local for each node
c   	integer irecpoi(maxaligns),ifilepoi(maxaligns)
c   	real    alisortkey(maxaligns),len2_orig(maxaligns)
C internal
      INTEGER IWORKER,IALIGN,IBEG,IEND
      INTEGER IALIGN_GOOD_ALL
C receive result from nodes and store in GLOBAL space 
      ILINK=1 
      LOGSTRING=' '

      IALIGN_GOOD_ALL = IALIGN_GOOD

      WRITE(*,*)' receive results: nalign nworker ', nalign,
     +     NWORKER,IALIGN_GOOD
      CALL FLUSH_UNIT(6)

c	msgtype=idtop
      DO IWORKER=1,NWORKER
         MSGTYPE=4000 
         ILINK=IWORKER
         CALL MP_RECEIVE_DATA(MSGTYPE,LINK(ILINK))
         CALL MP_GET_INT4(MSGTYPE,LINK(ILINK),IALIGN,N_ONE)
         CALL MP_GET_INT4(MSGTYPE,LINK(ILINK),IALIGN_GOOD,
     +        N_ONE)

         IALIGN_GOOD_ALL = IALIGN_GOOD_ALL + IALIGN_GOOD

         WRITE(*,*)ILINK,' IALIGN/GOOD/GOOD_ALL',
     +        IALIGN,IALIGN_GOOD,IALIGN_GOOD_ALL
         CALL FLUSH_UNIT(6)
         IF (IALIGN .GT. 0) THEN
            MSGTYPE=5000
            IBEG=NALIGN 
            IEND=NALIGN+IALIGN-1
            IF (IEND .GT. MAXALIGNS) THEN
               WRITE(*,*)'FATAL ERROR: MAXALIGNS OVERFLOW, INCREASE !!'
               CALL FLUSH_UNIT(6)
               STOP
            ENDIF
            CALL MP_RECEIVE_DATA(MSGTYPE,LINK(ILINK))
            CALL MP_GET_REAL4(MSGTYPE,LINK(ILINK),
     +           ALISORTKEY(IBEG),IALIGN)
            CALL MP_GET_INT4(MSGTYPE,LINK(ILINK),
     +           IRECPOI(IBEG),IALIGN)
            CALL MP_GET_INT4(MSGTYPE,LINK(ILINK),
     +           IFILEPOI(IBEG),IALIGN)
            NALIGN=NALIGN+IALIGN
            WRITE(LOGSTRING,'(A,4(I6))')' pid / done : ',
     +           IWORKER,IALIGN
         ELSE
            WRITE(LOGSTRING,'(A,I6,I6)')'nothing found: ',
     +           IWORKER,IALIGN
         ENDIF
         CALL LOG_FILE(KLOG,LOGSTRING,0)
         CALL FLUSH_UNIT(6)
      ENDDO
      NALIGN=NALIGN-1
      IALIGN_GOOD=IALIGN_GOOD_ALL
      WRITE(*,*)' total done : ',nalign,ialign_good
      CALL FLUSH_UNIT(6)
      RETURN
      END
C     END RECEIVE_RESULTS_FROM_NODE
C.......................................................................

C.......................................................................
C     SUB SEND_ALI_REQUEST
      SUBROUTINE SEND_ALI_REQUEST(IWORKER,IRECORD,IMSGTAG,CHECKVAL) 
      IMPLICIT NONE
      INCLUDE 'maxhom.param'
      INCLUDE 'maxhom.common'
c input
      INTEGER IWORKER,IRECORD,IMSGTAG
      REAL CHECKVAL
      MSGTYPE=6000
      
      CALL MP_INIT_SEND()
      CALL MP_PUT_INT4(MSGTYPE,IWORKER,IRECORD,N_ONE)
      CALL MP_PUT_INT4(MSGTYPE,IWORKER,IMSGTAG,N_ONE)
      CALL MP_PUT_REAL4(MSGTYPE,IWORKER,CHECKVAL,N_ONE)
      CALL MP_SEND_DATA(MSGTYPE,LINK(IWORKER))
      
      RETURN
      END
C     END SEND_ALI_REQUEST
C.......................................................................

C.......................................................................
C     SUB SEND_JOBS
C get "ready" signal from node and send "nfile" jobs

      SUBROUTINE SEND_JOBS(LH1,LH2,NFILE,NALIGN,NENTRIES,
     +     NAMINO_ACIDS)
C import
      IMPLICIT NONE
      INCLUDE 'maxhom.param'
      INCLUDE 'maxhom.common'
      INTEGER NFILE,NENTRIES,NAMINO_ACIDS
c import
      REAL      LH1(0:MAXMAT)
      INTEGER*2 LH2(0:MAXTRACE)
c	real lh(0:maxmat*2)
C internal
      INTEGER IFLAG
c       integer inix
      INTEGER IFILE,JFILE,ISET,ILINK,I,NALIGN,IALIGN,IFIRST_ROUND
      INTEGER NRECORD,IPOINTER

      INTEGER IDONE(MAXPROC)

c        integer ipos,nsplit,isplit
c        logical lendbase,ldb_read_one

      LOGICAL LERROR,LENDFILE
      CHARACTER*80 FILENAME
C init
      FILENAME=' '
      JFILE=0 
      ILINK=1 
      MSGTYPE=0
      DO I=1,MAXPROC 
         IDONE(I)=0 
      ENDDO
      NALIGN=1 
      IALIGN=0
      IFILE=1 
      IFIRST_ROUND=0
      NRECORD=0 
      ISET=0 
      IPOINTER=1
      IALIGN_GOOD=0

c        ldb_read_one=.false.


c$$$        if (ldb_read_one .eqv. .true.) THEN
c$$$	   nbuffer_len = 6 + len(name_2) + len(compnd_2) + 
c$$$     +                len(ACCESSION_2) + len(pdbref_2)
c$$$           lfirst_scan=.false.
c$$$           nsplit=namino_acids / (nworker +1)
c$$$
c$$$	   iset=0 ; isplit=0
c$$$
c$$$           do while( ifile .le. nfile)
c$$$              lendbase=.false.
c$$$	      call open_sw_data_file(kbase,ifile,split_db_data,
c$$$     +                               split_db_path)
c$$$c              write(*,*)ifile,nseq_warm_start,isplit,nsplit
c$$$c              call flush_unit(6)
c$$$
c$$$	      do while(lendbase .eqv. .false.)
c$$$               call get_swiss_entry(maxsq,kbase,lbinary,n2in,
c$$$     +                          name_2,compnd_2,
c$$$     +                          ACCESSION_2,pdbref_2,csq_2,lendbase)
c$$$
c$$$                 if (lendbase .eqv. .false.) THEN
c$$$                    IF ( (ipointer + nbuffer_len + n2in) .gt. 
c$$$     +                maxdatabase_buffer) THEN
c$$$                      write(*,*)' **** FATAL ERROR ****'
c$$$                      write(*,*)' database_buffer overflow increase'
c$$$                      write(*,*)' dimension of MAXDATABASE_BUFFER'
c$$$                      STOP
c$$$                    endif
c$$$                    write(cbuffer_line(1:),'(i6,a,a,a,a)')
c$$$     +                n2in,name_2,
c$$$     +                compnd_2,ACCESSION_2,pdbref_2
c$$$                    do ipos=1,nbuffer_len
c$$$                      cdatabase_buffer(ipointer)=
c$$$     +                                cbuffer_line(ipos:ipos)
c$$$                      ipointer=ipointer+1
c$$$                    enddo
c$$$                    do ipos=1,n2in
c$$$                       cdatabase_buffer(ipointer)=csq_2(ipos:ipos)
c$$$                       ipointer=ipointer+1
c$$$                    enddo   
c$$$                    isplit=isplit+n2in 
c$$$                    nseq_warm_start=nseq_warm_start+1
c$$$                    if ( (isplit .ge. nsplit) .and. 
c$$$     +                   (iset .le. nworker) ) then
c$$$                       iset=iset+1 ; ipointer=ipointer-1
c$$$                       write(*,'(a,i6,i8,i10,i8)')
c$$$     +                    'internal buffer: ',iset,nseq_warm_start,
c$$$     +                    ipointer,isplit
c$$$                       call flush_unit(6)
c$$$
c$$$                       msgtype=8000 ; ilink=iset
c$$$                       call mp_init_send()
c$$$                       call mp_put_int4(msgtype,ilink,ipointer,n_one)
c$$$                       call mp_put_int4(msgtype,ilink,nseq_warm_start,
c$$$     +                                  n_one)
c$$$                       call mp_send_data(msgtype,link(ilink))
c$$$                       msgtype=9000
c$$$                       call mp_init_send()
c$$$                       call mp_put_string_array(msgtype,ilink,
c$$$     +                                     cdatabase_buffer,ipointer)
c$$$                       call mp_send_data(msgtype,link(ilink))
c$$$                       ipointer=1 ; nseq_warm_start=0 ; isplit=0
c$$$                    endif
c$$$                 else 
c$$$                    close(kbase) ; ifile=ifile+1
c$$$                 endif    
c$$$              enddo   
c$$$           enddo
c$$$           msgtype=10000 
c$$$           call mp_init_send()
c$$$           call mp_put_int4(msgtype,ilink,ipointer,n_one)
c$$$           call mp_cast(nworker,msgtype,link(1))
c$$$        endif   

      CALL GET_CPU_TIME('time init:',IDPROC,
     +     ITIME_OLD,ITIME_NEW,TOTAL_TIME,LOGSTRING)
      CALL LOG_FILE(KLOG,LOGSTRING,2)
      IPOINTER=1

      IF (LISTOFSEQ_2 .EQV. .FALSE.) THEN
         IF (LFIRST_SCAN .EQV. .TRUE.) THEN
            DO WHILE (IFILE .LE. NFILE )
               MSGTYPE=2000 
               ILINK=-1
c	        call mp_receive_data(msgtype,ilink)
c	        call mp_get_int4(msgtype,ilink,ilink,n_one)

C first test for messages
               CALL MP_PROBE(MSGTYPE,IFLAG)
C if no communication is necessary do some "real" work
               IF ( IFLAG.EQ.0 .AND. IFILE .GE. NWORKSET*MAXQUEUE) THEN
                  WRITE(LOGSTRING,*)' file to host: ',ifile
                  CALL LOG_FILE(KLOG,LOGSTRING,1)
                  CALL HOST_INTERFACE(LH1,LH2,IFILE,FILENAME,IALIGN,
     +                 NRECORD,IPOINTER)
                  IFILE=IFILE+1
                  IFIRST_ROUND=1
c we have to fill the work-queue
               ELSE
                  MSGTYPE=2000 
                  CALL MP_RECEIVE_DATA(MSGTYPE,ILINK)
                  CALL MP_GET_INT4(MSGTYPE,ILINK,ILINK,N_ONE)
                  CALL MP_INIT_SEND()
C when we communicate the fist time, we fill the queue
                  IF (IFIRST_ROUND .EQ. 0) THEN
                     ISET=ISET+1
                     JFILE=ISET
                     DO I=1,MAXQUEUE
c                    write(*,'(a,i4,a,i4)')' file: ',jfile,' to: ',ilink
c                    call flush_unit(6)
                        MSGTYPE=3000
                        CALL MP_PUT_INT4(MSGTYPE,ILINK,JFILE,N_ONE)
                        JFILE=JFILE+NWORKSET
                        IFILE=IFILE+1
                     ENDDO   
                     CALL MP_SEND_DATA(MSGTYPE,LINK(ILINK))
C send one file-pointer to refill the work-queue
                  ELSE
c                  write(*,'(a,i4,a,i4)')' file: ',ifile,' to: ',ilink
c                  call flush_unit(6)
                     MSGTYPE=3000
                     CALL MP_PUT_INT4(MSGTYPE,ILINK,IFILE,N_ONE)
                     IFILE=IFILE+1
                     CALL MP_SEND_DATA(MSGTYPE,LINK(ILINK))
                  ENDIF
               ENDIF
            ENDDO
            LFIRST_SCAN=.FALSE.
C now tell everybody that the work is done
            ISET=0
            DO WHILE (ISET .LT. NWORKSET)
               MSGTYPE=2000 
               ILINK=-1
               CALL MP_RECEIVE_DATA(MSGTYPE,ILINK)
               CALL MP_GET_INT4(MSGTYPE,ILINK,ILINK,N_ONE)
               IF (IDONE(ILINK) .EQ. 0) THEN
c                   write(*,'(a,i4)')' last from: ',ilink ; call flush_unit(6)
                  ISET=ISET+1
                  IDONE(ILINK)=1
                  MSGTYPE=3000 
                  IFILE=-1
                  CALL MP_INIT_SEND()
                  CALL MP_PUT_INT4(MSGTYPE,ILINK,IFILE,N_ONE)
                  CALL MP_SEND_DATA(MSGTYPE,LINK(ILINK))
c                else
c                   write(*,'(a,i4)')' collect dead message: ',ilink
c                   call flush_unit(6)
               ENDIF
            ENDDO

            WRITE(LOGSTRING,'(a,i6,i8,i10)')'internal buffer: ',
     +           IDPROC,NSEQ_WARM_START,IPOINTER
            CALL LOG_FILE(KLOG,LOGSTRING,1)
         ELSE
            CALL HOST_INTERFACE(LH1,LH2,IFILE,FILENAME,IALIGN,
     +           NRECORD,IPOINTER)
         ENDIF
      ELSE
C ===================================================================
C list of filenames
C ===================================================================
         IFILE=0


         WRITE(*,*)' load work queue: ',ilink
         LENDFILE=.FALSE. 
         LERROR=.FALSE.
         DO ILINK=1,NWORKSET
            DO I=1,MAXQUEUE_LIST
               IF ( (LENDFILE .EQV. .FALSE.) .AND. 
     +              (LERROR .EQV. .FALSE. ) ) THEN
                  CALL READ_FILENAME(KLIS2,FILENAME,LENDFILE,
     +                 LERROR)
               ENDIF
               IF ( (LENDFILE .EQV. .TRUE.) .OR. 
     +              (LERROR .EQV. .TRUE. ) ) THEN
                  FILENAME='STOP'
               ENDIF
               WRITE(*,'(A,A,A,I4)')'file: ',filename(1:50),
     +              ' to: ',ILINK
               CALL FLUSH_UNIT(6)
               MSGTYPE=9000
               CALL MP_INIT_SEND()
               CALL MP_PUT_STRING(MSGTYPE,ILINK,FILENAME,
     +              LEN(FILENAME))
               CALL MP_SEND_DATA(MSGTYPE,LINK(ILINK))
               IF ( (LENDFILE .EQV. .TRUE.) .OR. 
     +              (LERROR .EQV. .TRUE. ) ) THEN
                  GOTO 500
               ENDIF
               IFILE=IFILE+1
            ENDDO
         ENDDO

         DO WHILE (.TRUE. )
            MSGTYPE=2000 
            ILINK=-1
C first test for messages
            CALL MP_PROBE(MSGTYPE,IFLAG)
C if no communication is necessary do some "real" work
c              IF ( iflag .eq. 0 ) THEN
c                 ifirst_round=1

c              IF ( iflag .eq. 0 .and. 
c     +            ifile .ge. (nworkset * maxqueue_list) ) THEN
c                 ifirst_round=1
c                 call read_filename(klis2,filename,lendfile,lerror)
c                 IF (lendfile .eqv. .true. .or. lerror .eqv. .true.) THEN
c                    filename='STOP'
c                          goto 500
c                 endif
c                 write(logstring,*)' host is working on file: ',ifile
c                 call log_file(klog,logstring,1)
c                 call host_interface(lh1,lh2,ifile,filename,ialign,
c     +                              nrecord,ipointer)
c                 ifile=ifile+1
c we have to fill the work-queue
c              else
            MSGTYPE=2000 
            CALL MP_RECEIVE_DATA(MSGTYPE,ILINK)
            CALL MP_GET_INT4(MSGTYPE,ILINK,ILINK,N_ONE)
            CALL MP_INIT_SEND()
C send one file-pointer to refill the work-queue
c                 if (ifirst_round .ne. 0) then
            CALL READ_FILENAME(KLIS2,FILENAME,LENDFILE,LERROR)
            IF ( (LENDFILE .EQV. .TRUE.)  .OR. 
     +           ( LERROR .EQV. .TRUE.) ) THEN
               FILENAME='STOP'
               GOTO 500
            ENDIF
            WRITE(*,'(A,I4)')FILENAME(1:50),ILINK
            CALL FLUSH_UNIT(6)

            MSGTYPE=3000
            CALL MP_PUT_STRING(MSGTYPE,ILINK,FILENAME,
     +           LEN(FILENAME))
            CALL MP_SEND_DATA(MSGTYPE,LINK(ILINK))
            IFILE=IFILE+1
C when we communicate the fist time, we fill the queue
c                 else  
c                 endif
c              endif   
         ENDDO
c           lfirst_scan=.false.
C now tell everybody that the work is done
 500     ISET=0
         DO WHILE (ISET .LT. NWORKSET)
            MSGTYPE=2000 
            ILINK=-1
            CALL MP_RECEIVE_DATA(MSGTYPE,ILINK)
            CALL MP_GET_INT4(MSGTYPE,ILINK,ILINK,N_ONE)
            IF (IDONE(ILINK) .EQ. 0) THEN
               WRITE(*,'(a,i4)')' last from: ',ilink
               CALL FLUSH_UNIT(6)
               ISET=ISET+1 
               IDONE(ILINK)=1
               MSGTYPE=3000 
               FILENAME='STOP'
               CALL MP_INIT_SEND()
               CALL MP_PUT_STRING(MSGTYPE,ILINK,FILENAME,
     +              LEN(FILENAME))
               CALL MP_SEND_DATA(MSGTYPE,LINK(ILINK))
c                else
c                   write(*,'(a,i4)')' collect dead message: ',ilink
c                   call flush_unit(6)
            ENDIF
         ENDDO
      ENDIF
      NALIGN=NALIGN+IALIGN
      WRITE(LOGSTRING,*)' host processed: ',nseq_warm_start,
     +     IALIGN_GOOD
      CALL LOG_FILE(KLOG,LOGSTRING,1)
      RETURN
      END
C     END SEND_JOBS
C.......................................................................

C.......................................................................
C     SUB SETCONSERVATION
      SUBROUTINE SETCONSERVATION(METRIC_FILENAME)
C 1. set conservation weights to 1.0
C 2. rescale matrix for the 22 amino residues such that the sum over
C    the matrix is 0.0 (or near)
C this matrix is used to calculate the conservation weights (SIMCONSERV)
c	implicit none
      INCLUDE 'maxhom.param'
      INCLUDE 'maxhom.common'
C import
      CHARACTER*(*) METRIC_FILENAME

C internal
      INTEGER    NACID
      PARAMETER (NACID=22)
      INTEGER I,J
      REAL XLOW,XHIGH,XMAX,XMIN,XFACTOR,SUMMAT

C
      DO I=1,MAXSQ 
         CONSWEIGHT_1(I)=1.0
      ENDDO
      LFIRSTWEIGHT=.TRUE.
C get metric
      CALL GETSIMMETRIC(NTRANS,TRANS,MAXSTRSTATES,MAXIOSTATES,
     +     NSTRSTATES_1,NIOSTATES_1,NSTRSTATES_2,
     +     NIOSTATES_2,CSTRSTATES,CIOSTATES,
     +     IORANGE,KSIM,METRIC_FILENAME,SIMORG)
c rescale matrix that the sum over matrix is +- 0.0 
      XLOW=0.0 
      XHIGH=0.0
      XMAX=1.0 
      XMIN=-1.0 
      XFACTOR=100.0
	
C (re)store original values in simconserv()
 20   DO J=1,NTRANS 
         DO I=1,NTRANS
            SIMCONSERV(I,J)=SIMORG(I,J,1,1,1,1) 
         ENDDO
      ENDDO
c scale with xmin/xmax
      CALL SCALEINTERVAL(SIMCONSERV,NTRANS**2,XMIN,XMAX,XLOW,XHIGH)
C RESEt the values for 'X' '!' and '-'
      I=INDEX(TRANS,'X')
      DO J=1,NTRANS
         SIMCONSERV(I,J)=0.0 
         SIMCONSERV(J,I)=0.0
      ENDDO
      I=INDEX(TRANS,'!')
      DO J=1,NTRANS
         SIMCONSERV(I,J)=0.0 
         SIMCONSERV(J,I)=0.0
      ENDDO
      I=INDEX(TRANS,'-')
      DO J=1,NTRANS
         SIMCONSERV(I,J)=0.0 
         SIMCONSERV(J,I)=0.0
      ENDDO
      I=INDEX(TRANS,'.')
      DO J=1,NTRANS
         SIMCONSERV(I,J)=0.0 
         SIMCONSERV(J,I)=0.0
      ENDDO
C calculate sum over matrix (22 amino acids) after scaling
      SUMMAT=0.0
      DO I=1,NACID 
         DO J=1,NACID
            SUMMAT=SUMMAT+SIMCONSERV(I,J)
         ENDDO
      ENDDO
cd	write(*,*)' sum: ',summat,xmin
c check sum=0.0 (+- 0.01) ; if not xmin=xmin/2 ; scale again
      IF (SUMMAT .GT. 0.01) THEN
         XMIN=XMIN+(XMIN/XFACTOR)
      ELSE IF (SUMMAT .LT. -0.01) THEN
         XMIN=XMIN-(XMIN/XFACTOR)
      ELSE
         WRITE(*,*)' SETCONSERVATION: sum over matrix: ',summat
         WRITE(*,*)'                  smin is : ',xmin
c	  kdeb=45
c	  call open_file(kdeb,'DEBUG.X','NEW',lerror)
c          do i=1,ntrans        
c	   write(kdeb,'(a,26(f5.2))')trans(i:i),
c     +                (simconserv(i,j),j=1,ntrans)
c          enddo
c	  write(kdeb,*)'sum over matrix: ',summat
c	  write(kdeb,*)'min,max: ',xmin,xmax
c	  close(kdeb)
         RETURN
      ENDIF
      GOTO 20	
      END
C     END SETCONSERVATION
C.......................................................................

C.......................................................................
C     SUB SINGLE_SEQ_WEIGHTS
      SUBROUTINE SINGLE_SEQ_WEIGHTS(NALIGN,SEQBUFFER,
     +     ISEQPOINTER,AL_IFIRST,AL_ILAST,MODE,WEIGHTS)
c
c     input: hssp alignments
c       w0 -- eigenvalue iteration weights x(i) 
c       w1 -- squared eigenvectors x(i)**2
c       w2 -- sum of distances w(i)=SUM(dist(i,j))
c       w3 -- exponential weight w(i)=1/SUM(exp(-dist(i,j)/dmean))
c
      IMPLICIT NONE
C import
      INTEGER NALIGN
      INTEGER AL_IFIRST(*),AL_ILAST(*),ISEQPOINTER(*)
      CHARACTER SEQBUFFER(*)
      CHARACTER MODE*(*)
C export
      REAL WEIGHTS(*)
c
      INTEGER MAXALIGNS,MAXSTEP
      PARAMETER (MAXALIGNS=300)
      PARAMETER(MAXSTEP=100)
      REAL TOLERANCE
      PARAMETER(TOLERANCE=0.00001)
      REAL DIST(MAXALIGNS,MAXALIGNS)
c	real sim_table(maxaligns,maxaligns)
c	integer maxaa
c	real sel_press,xpower,xtemp1,xtemp2
      REAL WTEMP(MAXALIGNS)
c	real vtemp(maxaligns,maxaligns)
c
      INTEGER STEP
      CHARACTER A1,A2
      INTEGER LENGTH,NPOS
      INTEGER I,J,K,K0,K1,KPOS
      REAL X,S,DMEAN

c	maxaa=19

      I=LEN(MODE)
      CALL LOWTOUP(MODE,I)
      IF (NALIGN .GT. MAXALIGNS) THEN
         WRITE(*,*)' maxaligns overflow in single_seq_weight'
         STOP
      ENDIF

      DO I=1,NALIGN
         WEIGHTS(I)=1.0
      ENDDO
      IF (NALIGN .LE. 1) THEN
         WRITE(*,*)' SINGLE_SEQ_WEIGHT: no alignments !'
         RETURN
      ENDIF
C calculate distance/identity table
      WRITE(*,*)' calculate distance table...'
      DO I=1,NALIGN
         DIST(I,I)=0.0
c	   sim_table(i,i)=1.0
         DO J=I+1,NALIGN
            LENGTH=0
            NPOS=0
            K0=MAX(AL_IFIRST(I),AL_IFIRST(J))
            K1=MIN(AL_ILAST(I),AL_ILAST(J))
            KPOS=ISEQPOINTER(I) + K0 - AL_IFIRST(I)
            DO K=K0,K1
               NPOS=NPOS+1
               A1= SEQBUFFER(KPOS)
               A2= SEQBUFFER(KPOS)
               KPOS=KPOS+1
               IF (A1.EQ.A2) LENGTH=LENGTH+1
               IF (A1 .GE. 'a' .OR. A2 .GE. 'a') THEN
                  IF (A1 .GE. 'a' ) THEN
                     A1=CHAR( ICHAR(A1)-32 )
                  ENDIF
                  IF (A2 .GE. 'a' ) THEN
                     A2=CHAR( ICHAR(A2)-32 )
                  ENDIF
                  IF (A1.EQ.A2) LENGTH=LENGTH+1
               ENDIF

c	         IF (a1 .ge. 'a' .and. a1 .le. 'z') THEN
c	           a1=char( ichar(a1)-32 )
c	         endif
c	         IF (a2 .ge. 'a' .and. a2 .le. 'z') THEN
c	           a2=char( ichar(a2)-32 )
c	         endif

            END DO
            DIST(I,J)= 1- (FLOAT(LENGTH)/MAX(1.0,FLOAT(NPOS)) )
c	      sim_table(i,j)=float(length)/max(1.0,float(npos))
c	      dist(i,j)= 1.00 - sim_table(i,j)
            DIST(J,I)=DIST(I,J)
c              sim_table(j,i)=sim_table(i,j)
         END DO
      END DO
c	write(*,*) ' distances: '
c	do i=1,nalign
c	   write(*,'(26i3)') (nint(100*dist(j,i)),j=1,nalign)
c	end do
c
      IF (INDEX(MODE,'MAT'). NE. 0 ) THEN 
         WRITE(*,*)' weight mode MAT NOT active '
         STOP
c	  write(*,*)' preparing identity matrix...'
c	  sel_press=0.5
c	  xpower= 1.0 / (1.0 - sel_press + (1.0/maxaa) )
c	  xtemp1= 1.0 + (1.0 / (maxaa * (1.0 - sel_press) ) )
c	  xtemp2= 1.0 / (maxaa * (1-sel_press) )
c	  do i=1,nalign ; do j=1,nalign
c             sim_table(i,j) = ( sim_table(i,j) * xtemp1 - xtemp2 )
c	     IF (sim_table(i,j) .le. tolerance) THEN
c	       write(*,*)'set sim_table to tolerance ',i,j
c               sim_table(i,j) = tolerance
c	     endif
c             sim_table(i,j) = sim_table(i,j) **xpower
c	  enddo ; enddo
c	  write(*,*)' calculate singular value decomposition...'
c          call svdcmp(sim_table,nalign,nalign,maxaligns,maxaligns,wtemp,
c     +                vtemp)
c	  write(*,*)' calculate matrix invers...'
c	  do i=1,nalign
c	     if (wtemp(i) .le. 0.0001) THEN
c                x=0.0
c	     else
c                x= 1/wtemp(i)
c	     endif
c	     do j=1,nalign
c                sim_table(i,j) = vtemp(i,j) * x * sim_table(i,j)
c	        weights(i) = weights(i) + sim_table(i,j)
c	     enddo
c	  enddo
c=======================================================================
c     calculate one-sequence weights from a distance matrix
c     step 0: w(k)    = 1 / N * sum[dist(k,length)]
c     step i: w(k)(i) = 1 / NORM * sum[dist(k,l) * w(length)(i-1)]
c     iterate until sum[|w(k)(i)-w(k)(i-1)|] < tolerance
c=======================================================================
c  eigenvector iteration 
c=======================================================================
      ELSE IF (INDEX(MODE,'EIGEN')  .NE. 0 .OR. 
     +        INDEX(MODE,'SQUARE') .NE. 0) THEN
         DO I=1,NALIGN
            WTEMP(I)=1.0/NALIGN
         END DO
         STEP=0
 10      STEP=STEP+1
         X=0.0
         DO I=1,NALIGN
            WEIGHTS(I)=0.0
            DO J=1,NALIGN
               WEIGHTS(I) = WEIGHTS(I) + WTEMP(J) * DIST(I,J)
            END DO
            X=X+WEIGHTS(I)
         END DO
         S=0.0
         DO I=1,NALIGN
            S = S +(WTEMP(I)-WEIGHTS(I)/X) * (WTEMP(I)-WEIGHTS(I)/X)
            WTEMP(I)=WEIGHTS(I)/X
         END DO
         S=SQRT(S/NALIGN)
         IF ((STEP .LT. MAXSTEP) .AND. (S .GT. TOLERANCE)) GOTO 10
         WRITE(*,'(A,I5,A,F10.4)')' WEIGHTS AT STEP:', STEP,
     +        ' DIFFERENCE: ',S
         WRITE(*,'(13F6.3)') (NALIGN*WTEMP(I),I=1,NALIGN)
      ENDIF
c=======================================================================
c                           weights(i)=wtemp(i)**2
c=======================================================================
      IF (INDEX(MODE,'SQUARE') .NE. 0) THEN
         S=0.0
         DO I=1,NALIGN
            WEIGHTS(I)=WTEMP(I) * WTEMP(I)
            S=S+WEIGHTS(I)
         END DO
         DO I=1,NALIGN
            WEIGHTS(I)=WEIGHTS(I)/S
         END DO
         WRITE(*,*) ' squared weights '
         WRITE(*,'(13F6.3)') (NALIGN*WEIGHTS(I),I=1,NALIGN)
c=======================================================================
c                  weights(i)=SUM(dist(i,j))
c=======================================================================
      ELSE IF (INDEX(MODE,'SUM') .NE. 0) THEN
         S=0.0
         DO I=1,NALIGN
            WEIGHTS(I)=0.0
            DO J=1,NALIGN
               WEIGHTS(I)=WEIGHTS(I) + DIST(I,J)
            END DO
            S=S+WEIGHTS(I)
         END DO
         DO I=1,NALIGN
            WEIGHTS(I)=WEIGHTS(I)/S
         END DO
         WRITE(*,*) ' summed distance weights '
         WRITE(*,'(13F6.3)') (NALIGN*WEIGHTS(I),I=1,NALIGN)
c=======================================================================
c               weights(i)=1/SUM(exp(-dist(i,j)/dmean))
c=======================================================================
      ELSE IF (INDEX(MODE,'EXP') .NE. 0) THEN
         S=0.0
         DO I=1,NALIGN
            DO J=I+1,NALIGN
               S=S+DIST(I,J)
            END DO
         END DO
         DMEAN=S/NALIGN/(NALIGN-1)*2
         DO I=1,NALIGN
            S=0.0
            DO J=1,NALIGN
               S=S+EXP(-DIST(I,J)/DMEAN)
            END DO
            IF (S.GT.0.0) THEN
               WEIGHTS(I)=1/S
            ELSE
               WRITE(*,*)  ' warning: s=0 in weights '
               WEIGHTS(I)=1.0
            END IF
         END DO
c normalize to 1.0
         S=0.0
         DO I=1,NALIGN
            S=S+WEIGHTS(I)
         END DO
         DO I=1,NALIGN
            WEIGHTS(I)=WEIGHTS(I)/S
         END DO
         WRITE(*,*) ' exponential distance weights '
         WRITE(*,'(13F6.3)') (NALIGN*WEIGHTS(I),I=1,NALIGN)
      ENDIF
 
      RETURN
      END
C     end single_seq_weight
C.......................................................................

C.......................................................................
C     SUB SVDCMP
      SUBROUTINE SVDCMP(A,M,N,MP,NP,W,V)
      PARAMETER (NMAX=2000)
      DIMENSION A(MP,NP),W(NP),V(NP,NP),RV1(NMAX)
        
      L=0
      nm=0
      G=0.0
      SCALE=0.0
      ANORM=0.0
      IF (m .gt. nmax) THEN
         write(*,*)'***ERROR: dim. overflow for RV1 in SVDCMP'
         STOP
      endif
      DO 25 I=1,N
         L=I+1
         RV1(I)=SCALE*G
         G=0.0
         S=0.0
         SCALE=0.0
         IF (I.LE.M) THEN
	    DO 11 K=I,M
               SCALE=SCALE+ABS(A(K,I))
 11         CONTINUE
            IF (SCALE.NE.0.0) THEN
               DO 12 K=I,M
                  A(K,I)=A(K,I)/SCALE
                  S=S+A(K,I)*A(K,I)
 12            CONTINUE
               F=A(I,I)
               G=-SIGN(SQRT(S),F)
               H=F*G-S
               A(I,I)=F-G
               IF (I.NE.N) THEN
                  DO 15 J=L,N
                     S=0.0
                     DO 13 K=I,M
                        S=S+A(K,I)*A(K,J)
 13                  CONTINUE
                     F=S/H
                     DO 14 K=I,M
                        A(K,J)=A(K,J)+F*A(K,I)
 14                  CONTINUE
 15               CONTINUE
               ENDIF
               DO 16 K= I,M
                  A(K,I)=SCALE*A(K,I)
 16            CONTINUE
            ENDIF
         ENDIF
         W(I)=SCALE *G
         G=0.0
         S=0.0
         SCALE=0.0
         IF ((I.LE.M).AND.(I.NE.N)) THEN
            DO 17 K=L,N
               SCALE=SCALE+ABS(A(I,K))
 17         CONTINUE
            IF (SCALE.NE.0.0) THEN
               DO 18 K=L,N
                  A(I,K)=A(I,K)/SCALE
                  S=S+A(I,K)*A(I,K)
 18            CONTINUE
               F=A(I,L)
               G=-SIGN(SQRT(S),F)
               H=F*G-S
               A(I,L)=F-G
               DO 19 K=L,N
                  RV1(K)=A(I,K)/H
 19            CONTINUE
               IF (I.NE.M) THEN
                  DO 23 J=L,M
                     S=0.0
                     DO 21 K=L,N
                        S=S+A(J,K)*A(I,K)
 21                  CONTINUE
                     DO 22 K=L,N
                        A(J,K)=A(J,K)+S*RV1(K)
 22                  CONTINUE
 23               CONTINUE
               ENDIF
               DO 24 K=L,N
                  A(I,K)=SCALE*A(I,K)
 24            CONTINUE
            ENDIF
         ENDIF
         ANORM=MAX(ANORM,(ABS(W(I))+ABS(RV1(I))))
 25   CONTINUE
      DO 32 I=N,1,-1
         IF (I.LT.N) THEN
            IF (G.NE.0.0) THEN
               DO 26 J=L,N
                  V(J,I)=(A(I,J)/A(I,L))/G
 26            CONTINUE
               DO 29 J=L,N
                  S=0.0
                  DO 27 K=L,N
                     S=S+A(I,K)*V(K,J)
 27               CONTINUE
                  DO 28 K=L,N
                     V(K,J)=V(K,J)+S*V(K,I)
 28               CONTINUE
 29            CONTINUE
            ENDIF
            DO 31 J=L,N
               V(I,J)=0.0
               V(J,I)=0.0
 31         CONTINUE
         ENDIF
         V(I,I)=1.0
         G=RV1(I)
         L=I
 32   CONTINUE
      DO 39 I=N,1,-1
         L=I+1
         G=W(I)
         IF (I.LT.N) THEN
            DO 33 J=L,N
               A(I,J)=0.0
 33         CONTINUE
         ENDIF
         IF (G.NE.0.0) THEN
            G=1.0/G
            IF (I.NE.N) THEN
               DO 36 J=L,N
                  S=0.0
                  DO 34 K=L,M
                     S=S+A(K,I)*A(K,J)
 34               CONTINUE
                  F=(S/A(I,I))*G
                  DO 35 K=I,M
                     A(K,J)=A(K,J)+F*A(K,I)
 35               CONTINUE
 36            CONTINUE
            ENDIF
            DO 37 J=I,M
               A(J,I)=A(J,I)*G
 37         CONTINUE
         ELSE
            DO 38 J= I,M
               A(J,I)=0.0
 38         CONTINUE
         ENDIF
         A(I,I)=A(I,I)+1.0
 39   CONTINUE
      DO 49 K=N,1,-1
         DO 48 ITS=1,30
            DO 41 L=K,1,-1
               NM=L-1
               IF ((ABS(RV1(L))+ANORM).EQ.ANORM)  GOTO 2
               IF ((ABS(W(NM))+ANORM).EQ.ANORM)  GOTO 1
 41         CONTINUE
 1          C=0.0
            S=1.0
            DO 43 I=L,K
               F=S*RV1(I)
               IF ((ABS(F)+ANORM).NE.ANORM) THEN
                  G=W(I)
                  H=SQRT(F*F+G*G)
                  W(I)=H
                  H=1.0/H
                  C= (G*H)
                  S=-(F*H)
                  DO 42 J=1,M
                     Y=A(J,NM)
                     Z=A(J,I)
                     A(J,NM)=(Y*C)+(Z*S)
                     A(J,I)=-(Y*S)+(Z*C)
 42               CONTINUE
               ENDIF
 43         CONTINUE
 2          Z=W(K)
            IF (L.EQ.K) THEN
               IF (Z.LT.0.0) THEN
                  W(K)=-Z
                  DO 44 J=1,N
                     V(J,K)=-V(J,K)
 44               CONTINUE
               ENDIF
               GOTO 3
            ENDIF
            IF (ITS.EQ.30) PAUSE 'No convergence in 30 iterations'
            X=W(L)
            NM=K-1
            Y=W(NM)
            G=RV1(NM)
            H=RV1(K)
            F=((Y-Z)*(Y+Z)+(G-H)*(G+H))/(2.0*H*Y)
            G=SQRT(F*F+1.0)
            F=((X-Z)*(X+Z)+H*((Y/(F+SIGN(G,F)))-H))/X
            C=1.0
            S=1.0
            DO 47 J=L,NM
               I=J+1
               G=RV1(I)
               Y=W(I)
               H=S*G
               G=C*G
               Z=SQRT(F*F+H*H)
               RV1(J)=Z
               C=F/Z
               S=H/Z
               F= (X*C)+(G*S)
               G=-(X*S)+(G*C)
               H=Y*S
               Y=Y*C
               DO 45 NM=1,N
                  X=V(NM,J)
                  Z=V(NM,I)
                  V(NM,J)= (X*C)+(Z*S)
                  V(NM,I)=-(X*S)+(Z*C)
 45            CONTINUE
               Z=SQRT(F*F+H*H)
               W(J)=Z
               IF (Z.NE.0.0) THEN
                  Z=1.0/Z
                  C=F*Z
                  S=H*Z
               ENDIF
               F= (C*G)+(S*Y)
               X=-(S*G)+(C*Y)
               DO 46 NM=1,M
                  Y=A(NM,J)
                  Z=A(NM,I)
                  A(NM,J)= (Y*C)+(Z*S)
                  A(NM,I)=-(Y*S)+(Z*C)
 46            CONTINUE
 47         CONTINUE
            RV1(L)=0.0
            RV1(K)=F
            W(K)=X
 48      CONTINUE
 3       CONTINUE
 49   CONTINUE
      RETURN
      END
C     END SVDCMP 
C.......................................................................

C.......................................................................
C     SUB WRITE_HISTO
      SUBROUTINE WRITE_HISTO(KHISTO,HISTOFILE,NALIGN,SORTVAL)

c	implicit none
C import
      INTEGER KHISTO,NALIGN
      REAL SORTVAL(*)
      CHARACTER*(*) HISTOFILE
C internal
c	integer maxbin,maxlen
c	parameter (maxbin=100,maxlen=80)
c	integer i,ibin,nbin(maxbin),maxpop,minpop,iend
c	character line*(maxlen),mark
      LOGICAL LERROR

c	mark='*'
c	do i=1,maxlen ; line(i:i)=mark ; enddo
c	do i=1,maxbin ; nbin(i)=0 ; enddo

      CALL OPEN_FILE(KHISTO,HISTOFILE,'NEW',LERROR)
c	do i=1,nalign
c          ibin=nint( sortval(i) / sortval(nalign) * maxbin)
c	  IF (ibin .le. 0) THEN
c	    ibin=1
c	  else IF (ibin .gt. maxbin) THEN
c	    ibin=maxbin
c	  endif
c          nbin(ibin)=nbin(ibin)+1
c	enddo
c
c	maxpop=-1 ; minpop=1000000
c	do i=1,maxbin
c           IF (nbin(i) .gt. maxpop)maxpop=nbin(i)
c           IF (nbin(i) .lt. minpop)minpop=nbin(i)
c	enddo
      WRITE(KHISTO,'(A,I6)')  ' number of scores: ',nalign
      WRITE(KHISTO,'(A,F7.2)')' minimal scores:   ',sortval(1)
      WRITE(KHISTO,'(A,F7.2)')' maximum scores:   ',sortval(nalign)
      WRITE(KHISTO,'(A)')'_________________________________________'//
     +     '_____________________________________________'
c	do i=1,maxbin
c	   iend=nint( (float(nbin(i)) / float(maxpop)) * float(maxlen) )
c	   IF (iend .gt.0 ) THEN
c             write(khisto,'(i5,a,a)')nbin(i),' |',line(1:iend)
c	   else
c             write(khisto,'(i5,a)')nbin(i),' |'
c           endif
c	enddo
c	write(khisto,*)
      WRITE(KHISTO,'(A)')' values: '
      DO I=1,NALIGN
         WRITE(KHISTO,'(I5,2X,F7.2)')I,SORTVAL(I)
      ENDDO

      CLOSE(KHISTO)

      RETURN
      END
C     END WRITE_HISTO
C.......................................................................

C.......................................................................
C     SUB WRITE_MAXHOM_COM
      SUBROUTINE WRITE_MAXHOM_COM(CFILTER)

c	implicit none
      INCLUDE 'maxhom.param'
      INCLUDE 'maxhom.common'
      CHARACTER*(*) CFILTER
c internal
      INTEGER OPTCUT,LENFILENAME,IBEG,IEND,I,J,JBEG,JEND
      CHARACTER COMMANDFILE*80,COMEXT*4,OUTLINE*80,LINE*35
      CHARACTER COMMENTLINE*80
      LOGICAL LERROR
C init
      OUTLINE=' '
      OPTCUT=110

      COMMENTLINE='$!==========================================='//
     +     '============================'
      COMEXT='.csh'

      LENFILENAME=INDEX(NAME1_ANSWER,'!')-1
      IF (LENFILENAME .LE. 0)LENFILENAME=LEN(NAME1_ANSWER)
      CALL GETPIDCODE(NAME1_ANSWER(1:LENFILENAME),HSSPID_1)
      CALL LOWTOUP(COMMANDFILE_ANSWER,80)

      CALL STRPOS(HSSPID_1,IBEG,IEND)
      IF (CFILTER .EQ. ' ') THEN
         COMMANDFILE(1:)=HSSPID_1(IBEG:IEND)//'_maxhom'//comext
      ELSE
         COMMANDFILE(1:)=HSSPID_1(IBEG:IEND)//'_hssp'//comext
      ENDIF
      CALL OPEN_FILE(KCOM,COMMANDFILE,'NEW',LERROR)

C=======================================================================
C UNIX c-shell script
C=======================================================================
      COMMENTLINE='#==========================================='//
     +     '============================'
      WRITE(KCOM,'(A)')'#! /bin/csh'
      WRITE(KCOM,'(A)')COMMENTLINE
      IF (CFILTER .EQ. ' ') THEN
         WRITE(KCOM,'(A)')'# command file to run MAXHOM'
      ELSE
         WRITE(KCOM,'(A)')'# command file to run a PRE-FILTERED MAXHOM'
      ENDIF
      WRITE(KCOM,'(A)')'goto set_enviroment'
      WRITE(KCOM,'(A)')'start:'
      WRITE(KCOM,'(A)')COMMENTLINE
      WRITE(KCOM,'(A)')'# This .csh file writes a temporary '//
     +     'command file ("MAXHOM_"process_id".temp")'
      WRITE(KCOM,'(A)')'# containing the answers to the MAXHOM '//
     +     'questions.'
      WRITE(KCOM,'(A)')COMMENTLINE

C===================================================================

      IF (CFILTER .NE.' ') THEN
C get sequence 1 
         CALL STRPOS(NAME1_ANSWER,I,J)
         IF (LISTOFSEQ_1) THEN
	    WRITE(KCOM,'(A)')'# LOOP OVER FILENAMES IN LIST'
	    WRITE(KCOM,'(A)')
     +          'foreach filename ( "`cat '//NAME1_ANSWER(I:J)//'`" )'  
         ELSE
	    WRITE(KCOM,'(A)')'set filename = '//NAME1_ANSWER(I:J)  
         ENDIF
C get identifier
         WRITE(KCOM,'(A)')COMMENTLINE
         WRITE(KCOM,'(A)')'# GET IDENTIFIER'
         WRITE(KCOM,'(A)')COMMENTLINE
         WRITE(KCOM,'(A)')'   set name1 = $filename:r'
         WRITE(KCOM,'(A)')'   set name2 = $name1:t'
C convertseq
         WRITE(KCOM,'(A)')COMMENTLINE
         WRITE(KCOM,'(A)')'# CONVERT ALL FORMATS TO FASTA'
         WRITE(KCOM,'(A)')'   echo $filename    >   MAXHOM_$$.temp'
         WRITE(KCOM,'(A)')'   echo "F"          >>  MAXHOM_$$.temp'
         WRITE(KCOM,'(A)')'   echo "N"          >>  MAXHOM_$$.temp'
         WRITE(KCOM,'(A)')'   echo $name2".y"   >>  MAXHOM_$$.temp'
         WRITE(KCOM,'(A)')'   echo "N"          >>  MAXHOM_$$.temp'
         IF (CONVERTSEQ_EXE .NE. ' ') THEN
	    CALL STRPOS(CONVERTSEQ_EXE,IBEG,IEND)
	    WRITE(KCOM,'(A)')'   echo "run convert_seq"'
	    WRITE(KCOM,'(A,A,A)')
     +        '   ',CONVERTSEQ_EXE(IBEG:IEND),
     +        '  < MAXHOM_$$.temp >& /dev/null'
         ELSE
            STOP ' ERROR: CONVERTSEQ_EXE UNDEFINED '
         ENDIF
         WRITE(KCOM,'(A)')'   rm MAXHOM_$$.temp'
C run FASTA
         IF (CFILTER .EQ. 'FASTA') THEN
            WRITE(KCOM,'(A)')'   echo $name2".y"   >   MAXHOM_$$.temp'
            WRITE(KCOM,'(A)')'   echo "S"          >>  MAXHOM_$$.temp'
            WRITE(KCOM,'(A)')'   echo "1"          >>  MAXHOM_$$.temp'
            WRITE(KCOM,'(A)')'   echo "fasta.x_"$$ >>  MAXHOM_$$.temp'
            WRITE(KCOM,'(A)')'   echo "2000"       >>  MAXHOM_$$.temp'
            WRITE(KCOM,'(A)')'   echo " "          >>  MAXHOM_$$.temp'
            WRITE(KCOM,'(A)')'   echo "yes"        >>  MAXHOM_$$.temp'
            WRITE(KCOM,'(A)')'   echo " "          >>  MAXHOM_$$.temp'
            IF (FASTA_EXE .NE. ' ') THEN
               CALL STRPOS(FASTA_EXE,IBEG,IEND)
               WRITE(KCOM,'(A,A,A)')'   ',FASTA_EXE(IBEG:IEND),
     +              ' -b 2000 -d 2000 -o < MAXHOM_$$.temp > fasta.x_$$'
            ELSE
               STOP ' ERROR: FASTA_EXE UNDEFINED '
            ENDIF
            WRITE(KCOM,'(A)')'   rm MAXHOM_$$.temp'
            WRITE(KCOM,'(A)')'   rm $name2".y"'
C get filter.list
            WRITE(KCOM,'(A)')COMMENTLINE
            WRITE(KCOM,'(A)')'# EXTRACT POSSIBL HITS FROM FASTA-OUTPUT'
            WRITE(KCOM,'(A)')' echo "fasta.x_"$$ >  MAXHOM_$$.temp'
            WRITE(KCOM,'(A)')' echo "filter.list_"$$ >> MAXHOM_$$.temp'
            I=ISAFE-5
            IF (I.GT.0) THEN
               WRITE(OUTLINE,'(A,I2)')'FORMULA+',I
            ELSE IF (I.EQ.0) THEN
               WRITE(OUTLINE,'(A)')'FORMULA'
            ELSE
               WRITE(OUTLINE,'(A,I2)')'FORMULA-',ABS(I)
            ENDIF
            CALL STRPOS(OUTLINE,I,J)
	    WRITE(KCOM,'(A)')'   echo "'//OUTLINE(I:J)//
     +           '"  >> MAXHOM_$$.temp'
	    WRITE(KCOM,'(A,I5,A)')'   echo "',OPTCUT,
     +           '"  >> MAXHOM_$$.temp'
	    WRITE(KCOM,'(A)')'   echo "distance"   >>  MAXHOM_$$.temp'
	    IF (FILTER_FASTA_EXE .NE. ' ') THEN
               CALL STRPOS(FILTER_FASTA_EXE,IBEG,IEND)
               WRITE(KCOM,'(A,A,A)')'   ',FILTER_FASTA_EXE(IBEG:IEND),
     +              '  <  MAXHOM_$$.temp'
	    ELSE
               STOP ' ERROR: FILTER_FASTA_EXE UNDEFINED '
	    ENDIF
	    WRITE(KCOM,'(A)')'   rm MAXHOM_$$.temp'
	    WRITE(KCOM,'(A)')'   rm fasta.x_$$'
C rename output files if wanted
	    IF (STRIPFILE_ANSWER.NE.'NO') THEN
               STRIPFILE_ANSWER='$name2"_strip.x"'
            ENDIF
	    IF (long_output_ANSWER.NE.'NO') THEN
               LONG_OUTPUT_ANSWER='$name2"_long.x"'
            ENDIF
	    IF (PLOTFILE_ANSWER.NE.'NO') THEN
               PLOTFILE_ANSWER='$name2"_trace.x"'
            ENDIF
C run BLASTP
         ELSE IF (CFILTER .EQ. 'BLASTP') THEN
	    IF (BLASTP_EXE .NE. ' ') THEN
               CALL STRPOS(BLASTP_EXE,IBEG,IEND)
               WRITE(KCOM,'(A)')'   echo "run blastp"'
               WRITE(KCOM,'(A,A,A)')'   ',BLASTP_EXE(IBEG:IEND),
     +              ' swiss $name2".y" B=2000 > blast.x_$$'
	    ELSE
               STOP ' ERROR: BLASTP_EXE UNDEFINED '
	    ENDIF
	    WRITE(KCOM,'(A)')'   rm MAXHOM_$$.temp'
	    WRITE(KCOM,'(A)')'   rm $name2".y"'
	    write(kcom,'(a)')commentline
	    WRITE(KCOM,'(A)')'# EXTRACT HITS FROM BLASTP-OUTPUT'
	    IF (FILTER_BLASTP_EXE .NE. ' ') THEN
               CALL STRPOS(FILTER_BLASTP_EXE,IBEG,IEND)
               CALL STRPOS(sw_current,jBEG,jEND)
               WRITE(KCOM,'(A,A,A,A,A)')'   ',
     +              FILTER_BLASTP_EXE(IBEG:IEND),' ',
     +              sw_current(jbeg:jend),
     +              ' <  blast.x_$$ > filter.list_$$'
               write(kcom,'(a)')'   rm blast.x_$$'
	    ELSE
               STOP ' ERROR: FILTER_BLASTP_EXE UNDEFINED '
	    ENDIF
         ENDIF
      ENDIF
C call MAXHOM 
      LINE='"            >> MAXHOM_$$.temp  ' 
      write(kcom,'(a)')commentline
      WRITE(KCOM,'(A)')'# --------  finally call MAXHOM     -------'
      write(kcom,'(a)')commentline
      WRITE(KCOM,'(A)')'   echo "COMMAND NO" >  MAXHOM_$$.temp'
      WRITE(KCOM,'(A)')'   echo "BATCH" >>  MAXHOM_$$.temp'
      WRITE(KCOM,'(A)')'   echo "PID: "$$    >>  MAXHOM_$$.temp'
      IF (CFILTER .NE. ' ') THEN
         WRITE(KCOM,'(A)')'   echo "SEQ_1 "$filename >> MAXHOM_$$.temp'
         WRITE(KCOM,'(A)')
     +        '   echo "SEQ_2 filter.list_"$$ >> MAXHOM_$$.temp'
      ELSE
         CALL STRPOS(NAME1_ANSWER,I,J)
         WRITE(KCOM,'(A)')'   echo "SEQ_1 '//NAME1_ANSWER(I:J)//LINE
         CALL STRPOS(NAME2_ANSWER,I,J)
         WRITE(KCOM,'(A)')'   echo "SEQ_2 '//NAME2_ANSWER(I:J)//LINE
      ENDIF
      CALL STRPOS(PROFILE_ANSWER,I,J)
      WRITE(KCOM,'(A)')'   echo "2_PROFILES '//
     +                   PROFILE_ANSWER(I:J)//LINE
      CALL STRPOS(METRIC_ANSWER,I,J)
      WRITE(KCOM,'(A)')'   echo "METRIC '//METRIC_ANSWER(I:J)//LINE

      CALL STRPOS(NORM_PROFILE_ANSWER,I,J)
      WRITE(KCOM,'(A)')'   echo "NORM_PROFILE '//
     +     NORM_PROFILE_ANSWER(I:J)//LINE
      CALL STRPOS(PROFILE_EPSILON_ANSWER,I,J)
      WRITE(KCOM,'(A)')'   echo "MEAN_PROFILE '//
     +     PROFILE_EPSILON_ANSWER(I:J)//LINE
      CALL STRPOS(PROFILE_GAMMA_ANSWER,I,J)
      WRITE(KCOM,'(A)')'   echo "FACTOR_GAPS '//
     +     PROFILE_GAMMA_ANSWER(I:J)//LINE
      CALL STRPOS(SMIN_ANSWER,I,J)
      WRITE(KCOM,'(A)')'   echo "SMIN '//SMIN_ANSWER(I:J)//LINE
      CALL STRPOS(SMAX_ANSWER,I,J)
      WRITE(KCOM,'(A)')'   echo "SMAX '//SMAX_ANSWER(I:J)//LINE
      CALL STRPOS(OPENWEIGHT_ANSWER,I,J)
      WRITE(KCOM,'(A)')'   echo "GAP_OPEN '//
     +     OPENWEIGHT_ANSWER(I:J)//LINE
      CALL STRPOS(ELONGWEIGHT_ANSWER,I,J)
      WRITE(KCOM,'(A)')'   echo "GAP_ELONG '//
     +     ELONGWEIGHT_ANSWER(I:J)//LINE
      CALL STRPOS(WEIGHT1_ANSWER,I,J)
      WRITE(KCOM,'(A)')'   echo "WEIGHT1 '//WEIGHT1_ANSWER(I:J)//LINE
      CALL STRPOS(WEIGHT2_ANSWER,I,J)
      WRITE(KCOM,'(A)')'   echo "WEIGHT2 '//WEIGHT2_ANSWER(I:J)//LINE
      CALL STRPOS(WAY3_ANSWER,I,J)
      WRITE(KCOM,'(A)')'   echo "WAY3_ALIGN '//
     +     WAY3_ANSWER(I:J)//LINE
      CALL STRPOS(INDEL_ANSWER_1,I,J)
      WRITE(KCOM,'(A)')'   echo "INDEL_1 '//
     +     INDEL_ANSWER_1(I:J)//LINE
      CALL STRPOS(INDEL_ANSWER_2,I,J)
      WRITE(KCOM,'(A)')'   echo "INDEL_2 '//
     +     INDEL_ANSWER_2(I:J)//LINE
      CALL STRPOS(BACKWARD_ANSWER,I,J)
      WRITE(KCOM,'(A)')'   echo "RELIABILITY '//
     +     BACKWARD_ANSWER(I:J)//LINE
      CALL STRPOS(FILTER_ANSWER,I,J)
      WRITE(KCOM,'(A)')'   echo "FILTER_RANGE '//
     +     FILTER_ANSWER(I:J)//LINE
      CALL STRPOS(NBEST_ANSWER,I,J)
      WRITE(KCOM,'(A)')'   echo "NBEST '//NBEST_ANSWER(I:J)//LINE
      CALL STRPOS(NGLOBALHITS_ANSWER,I,J)
      WRITE(KCOM,'(A)')'   echo "MAXALIGN '//
     +     NGLOBALHITS_ANSWER(I:J)//LINE
      CALL STRPOS(THRESHOLD_ANSWER,I,J)
      WRITE(KCOM,'(A)')'   echo "THRESHOLD '//
     +     THRESHOLD_ANSWER(I:J)//LINE
      CALL STRPOS(SORTMODE_ANSWER,I,J)
      WRITE(KCOM,'(A)')'   echo "SORT '//SORTMODE_ANSWER(I:J)//LINE
      CALL STRPOS(HSSP_ANSWER,I,J)
      WRITE(KCOM,'(A)')'   echo "HSSP '//HSSP_ANSWER(I:J)//LINE
      CALL STRPOS(SAMESEQ_ANSWER,I,J)
      WRITE(KCOM,'(A)')'   echo "SAME_SEQ_SHOW '//
     +     SAMESEQ_ANSWER(I:J)//LINE
      CALL STRPOS(COMPARE_ANSWER,I,J)
      WRITE(KCOM,'(A)')'   echo "SUPERPOS '//COMPARE_ANSWER(I:J)//LINE
      CALL STRPOS(PDBPATH_ANSWER,I,J)
      WRITE(KCOM,'(A)')'   echo "PDB_PATH '//PDBPATH_ANSWER(I:J)//LINE
      CALL STRPOS(PROFILEOUT_ANSWER,I,J)
      WRITE(KCOM,'(A)')'   echo "PROFILE_OUT '//
     +     PROFILEOUT_ANSWER(I:J)//LINE
      CALL STRPOS(STRIPFILE_ANSWER,I,J)
      IF (INDEX(STRIPFILE_ANSWER,'$name2').NE.0) THEN
         WRITE(KCOM,'(A)')'   echo "STRIP_OUT "'//
     +        STRIPFILE_ANSWER(I:J)//
     +        '     >> MAXHOM_$$.temp'
      ELSE
         WRITE(KCOM,'(A)')'   echo "STRIP_OUT '//
     +        STRIPFILE_ANSWER(I:J)//LINE
      ENDIF
      CALL STRPOS(long_output_ANSWER,I,J)
      IF (INDEX(long_output_ANSWER,'$name2').ne.0) THEN
         WRITE(KCOM,'(A)')'   echo "LONG_OUT "'//
     +        long_output_ANSWER(I:J)//
     +        '     >> MAXHOM_$$.temp'
      ELSE
         WRITE(KCOM,'(A)')'   echo "LONG_OUT '//
     +        long_output_ANSWER(I:J)//LINE
      ENDIF
      
      CALL STRPOS(PLOTFILE_ANSWER,I,J)
      IF (INDEX(PLOTFILE_ANSWER,'$name2').ne.0) THEN
         WRITE(KCOM,'(A)')'   echo "DOT_PLOT "'//PLOTFILE_ANSWER(I:J)//
     +        '      >> MAXHOM_$$.temp'
      ELSE
         WRITE(KCOM,'(A)')'   echo "DOT_PLOT '//
     +        PLOTFILE_ANSWER(I:J)//LINE
         WRITE(KCOM,'(A)')'   echo "RUN"      >> MAXHOM_$$.temp'
      ENDIF
      WRITE(KCOM,'(A)')'   maxhom -nopar < MAXHOM_$$.temp'
CALT	WRITE(KCOM,'(A)')'   $snice maxhom < MAXHOM_$$.temp'
      WRITE(KCOM,'(A)')'   rm MAXHOM_$$.temp'
      CALL STRPOS(COREFILE,IBEG,IEND)
      WRITE(KCOM,'(A,A,A)')'   rm ',COREFILE(IBEG:IEND),'$$'
      WRITE(KCOM,'(A)')'   rm filter.list_$$'
      IF (CFILTER .NE. ' ' .AND. LISTOFSEQ_1) THEN
         WRITE(KCOM,'(A)')'end'
      ENDIF
      WRITE(KCOM,'(A)')'exit'
      
      WRITE(KCOM,'(A)')COMMENTLINE
      WRITE(KCOM,'(A)')'set_enviroment:'
      WRITE(KCOM,'(A)')'nohup'
      WRITE(KCOM,'(A)')'alias rm ''rm -f'''
      WRITE(KCOM,'(A)')'goto start'
      WRITE(KCOM,'(A)')COMMENTLINE
      
      CLOSE(KCOM)
C======================================================================
      WRITE(*,*)'****************************************************'
      CALL STRPOS(COMMANDFILE,IBEG,IEND)
      WRITE(*,*)' wrote command file to: ',commandfile(ibeg:iend)
      IF (CMACHINE .EQ. 'VMS' ) THEN
         WRITE(*,*)'now submit this command file to a batch queue'
      ELSE
         CALL CHANGE_MODE(COMMANDFILE,'+x',i)
         WRITE(*,*)'to execute this file type: '
         IF (I .NE. 0) THEN
            WRITE(*,'(A,A)')'chmod +x ',COMMANDFILE(IBEG:IEND)
         ENDIF
         WRITE(*,'(2X,A,A)')COMMANDFILE(IBEG:IEND),' > /dev/null &'
      ENDIF
      WRITE(*,*)'****************************************************'

      RETURN
      END
C     END WRITE_MAXHOM_COM
C.......................................................................

