sq
',
C + R_1,R_11,R_2,R_22,R_12
IF (ABS(DENOMINATOR).GT.10E-15) THEN
FRCORRVEC_REAL4=NOMINATOR/DENOMINATOR
ELSE
FRCORRVEC_REAL4=0.
END IF
END
***** end of FRCORRVEC_REAL4
***** ------------------------------------------------------------------
***** FCT FRDIVIDE_SAFE
***** ------------------------------------------------------------------
C----
C---- NAME : FRDIVIDE_SAFE
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Mar, 1994 version 0.1 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: Divides NOM/DEN, returns 0 if ABS(DEN)<10E-15. *
* input : NOM, DEN *
*----------------------------------------------------------------------*
REAL FUNCTION FRDIVIDE_SAFE(NOM,DEN)
IMPLICIT NONE
C---- variables passed from/to SBR calling
REAL NOM,DEN
******------------------------------*-----------------------------******
* execution of function *
IF (ABS(DEN).LT.10E-15) THEN
FRDIVIDE_SAFE=0
ELSE
FRDIVIDE_SAFE=NOM/DEN
END IF
END
***** end of FRDIVIDE_SAFE
***** ------------------------------------------------------------------
***** FCT FWRITE_STRING_NUMBERS
***** ------------------------------------------------------------------
C----
C---- NAME : FWRITE_STRING_NUMBERS
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Apr, 1993 version 0.1 *
* changed: Apr, 1993 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
CHARACTER*222 FUNCTION FWRITE_STRING_NUMBERS(L80,ILINE)
IMPLICIT NONE
C---- local variables *
INTEGER ILINE
CHARACTER*222 CHARLINE
LOGICAL L80
******------------------------------*-----------------------------******
C---- write for 80 characters per line
IF (L80.EQV. .TRUE.) THEN
IF ((ILINE.EQ.1).OR.(ILINE.GT.13)) THEN
CHARLINE(1:40) ='....,....1....,....2....,....3....,....4'
CHARLINE(41:80)='....,....5....,....6....,....7....,....8'
ELSEIF (ILINE.EQ.2) THEN
CHARLINE(1:40) ='....,....9....,....10...,....11...,....1'
CHARLINE(41:80)='2...,....13...,....14...,....15...,....1'
ELSEIF (ILINE.EQ.3) THEN
CHARLINE(1:40) ='6...,....17...,....18...,....19...,....2'
CHARLINE(41:80)='0...,....21...,....22...,....23...,....2'
ELSEIF (ILINE.EQ.4) THEN
CHARLINE(1:40) ='4...,....25...,....26...,....27...,....2'
CHARLINE(41:80)='8...,....29...,....30...,....31...,....3'
ELSEIF (ILINE.EQ.5) THEN
CHARLINE(1:40) ='2...,....33...,....34...,....35...,....3'
CHARLINE(41:80)='6...,....37...,....38...,....39...,....4'
ELSEIF (ILINE.EQ.6) THEN
CHARLINE(1:40) ='0...,....41...,....42...,....43...,....4'
CHARLINE(41:80)='4...,....45...,....46...,....47...,....4'
ELSEIF (ILINE.EQ.7) THEN
CHARLINE(1:40) ='8...,....49...,....50...,....51...,....5'
CHARLINE(41:80)='2...,....53...,....54...,....55...,....5'
ELSEIF (ILINE.EQ.8) THEN
CHARLINE(1:40) ='6...,....57...,....58...,....59...,....6'
CHARLINE(41:80)='0...,....61...,....62...,....63...,....6'
ELSEIF (ILINE.EQ.9) THEN
CHARLINE(1:40) ='4...,....65...,....66...,....67...,....6'
CHARLINE(41:80)='8...,....69...,....70...,....71...,....7'
ELSEIF (ILINE.EQ.10) THEN
CHARLINE(1:40) ='2...,....73...,....74...,....75...,....7'
CHARLINE(41:80)='6...,....77...,....78...,....79...,....8'
ELSEIF (ILINE.EQ.11) THEN
CHARLINE(1:40) ='0...,....81...,....82...,....83...,....8'
CHARLINE(41:80)='4...,....85...,....86...,....87...,....8'
ELSEIF (ILINE.EQ.12) THEN
CHARLINE(1:40) ='8...,....89...,....90...,....91...,....9'
CHARLINE(41:80)='2...,....93...,....94...,....95...,....9'
ELSEIF (ILINE.EQ.13) THEN
CHARLINE(1:40) ='6...,....97...,....98...,....99...,....1'
CHARLINE(41:80)='00..,....110..,....120..,....130..,....1'
ELSEIF (ILINE.EQ.14) THEN
CHARLINE(1:40) ='140.,....150..,....160..,....170..,....1'
CHARLINE(41:80)='80..,....190..,....200..,....210..,....2'
ELSEIF (ILINE.EQ.15) THEN
CHARLINE(1:40) ='230.,....240..,....250..,....260..,....2'
CHARLINE(41:80)='70..,....280..,....290..,....300..,....2'
ELSEIF (ILINE.EQ.16) THEN
CHARLINE(1:40) ='310.,....320..,....330..,....340..,....3'
CHARLINE(41:80)='50..,....360..,....370..,....380..,....3'
ELSEIF (ILINE.EQ.17) THEN
CHARLINE(1:40) ='390.,....400..,....410..,....420..,....4'
CHARLINE(41:80)='30..,....440..,....450..,....460..,....4'
ELSEIF (ILINE.EQ.18) THEN
CHARLINE(1:40) ='470.,....480..,....490..,....500..,....5'
CHARLINE(41:80)='10..,....520..,....530..,....540..,....5'
ELSEIF (ILINE.EQ.19) THEN
CHARLINE(1:40) ='550.,....560..,....570..,....580..,....5'
CHARLINE(41:80)='90..,....600..,....610..,....620..,....5'
ELSE
CHARLINE(1:40) ='x0..,....x1...,....x2...,....x3...,....x'
CHARLINE(41:80)='4...,....x5...,....x6...,....x7...,....8'
END IF
C---- write for 60 characters per line
ELSE
IF ((ILINE.EQ.1).OR.(ILINE.GT.18)) THEN
CHARLINE(1:40) ='....,....1....,....2....,....3....,....4'
CHARLINE(41:60)='....,....5....,....6'
ELSEIF (ILINE.EQ.2) THEN
CHARLINE(1:40) ='....,....7....,....8....,....9....,....1'
CHARLINE(41:60)='0...,....11...,....1'
ELSEIF (ILINE.EQ.3) THEN
CHARLINE(1:40) ='2...,....13...,....14...,....15...,....1'
CHARLINE(41:60)='6...,....17...,....1'
ELSEIF (ILINE.EQ.4) THEN
CHARLINE(1:40) ='8...,....19...,....20...,....21...,....2'
CHARLINE(41:60)='2...,....23...,....2'
ELSEIF (ILINE.EQ.5) THEN
CHARLINE(1:40) ='4...,....25...,....26...,....27...,....2'
CHARLINE(41:60)='8...,....29...,....3'
ELSEIF (ILINE.EQ.6) THEN
CHARLINE(1:40) ='0...,....31...,....32...,....33...,....3'
CHARLINE(41:60)='4...,....35...,....3'
ELSEIF (ILINE.EQ.7) THEN
CHARLINE(1:40) ='6...,....37...,....38...,....39...,....4'
CHARLINE(41:60)='0...,....41...,....4'
ELSEIF (ILINE.EQ.8) THEN
CHARLINE(1:40) ='2...,....43...,....44...,....45...,....4'
CHARLINE(41:60)='6...,....47...,....4'
ELSEIF (ILINE.EQ.9) THEN
CHARLINE(1:40) ='8...,....49...,....50...,....51...,....5'
CHARLINE(41:60)='2...,....53...,....5'
ELSEIF (ILINE.EQ.10) THEN
CHARLINE(1:40) ='4...,....55...,....56...,....57...,....5'
CHARLINE(41:60)='8...,....59...,....6'
ELSEIF (ILINE.EQ.11) THEN
CHARLINE(1:40) ='0...,....61...,....62...,....63...,....6'
CHARLINE(41:60)='4...,....65...,....6'
ELSEIF (ILINE.EQ.12) THEN
CHARLINE(1:40) ='6...,....67...,....68...,....69...,....7'
CHARLINE(41:60)='0...,....71...,....7'
ELSEIF (ILINE.EQ.13) THEN
CHARLINE(1:40) ='2...,....73...,....74...,....75...,....7'
CHARLINE(41:60)='6...,....77...,....7'
ELSEIF (ILINE.EQ.14) THEN
CHARLINE(1:40) ='8...,....79...,....80...,....81...,....8'
CHARLINE(41:60)='2...,....83...,....8'
ELSEIF (ILINE.EQ.15) THEN
CHARLINE(1:40) ='4...,....85...,....86...,....87...,....8'
CHARLINE(41:60)='8...,....89...,....9'
ELSEIF (ILINE.EQ.16) THEN
CHARLINE(1:40) ='0...,....91...,....92...,....93...,....9'
CHARLINE(41:60)='4...,....95...,....9'
ELSEIF (ILINE.EQ.17) THEN
CHARLINE(1:40) ='6...,....97...,....98...,....99...,....1'
CHARLINE(41:60)='00..,....110..,....2'
ELSEIF (ILINE.EQ.18) THEN
CHARLINE(1:40) ='120.,....130..,....140..,....150..,....1'
CHARLINE(41:60)='60..,....170..,....8'
ELSEIF (ILINE.EQ.19) THEN
CHARLINE(1:40) ='180.,....190..,....200..,....210..,....2'
CHARLINE(41:60)='20..,....230..,....4'
ELSEIF (ILINE.EQ.20) THEN
CHARLINE(1:40) ='240.,....250..,....260..,....270..,....2'
CHARLINE(41:60)='80..,....290..,....3'
ELSEIF (ILINE.EQ.21) THEN
CHARLINE(1:40) ='300.,....310..,....320..,....330..,....3'
CHARLINE(41:60)='40..,....350..,....6'
ELSEIF (ILINE.EQ.22) THEN
CHARLINE(1:40) ='360.,....370..,....380..,....390..,....4'
CHARLINE(41:60)='00..,....410..,....2'
ELSEIF (ILINE.EQ.23) THEN
CHARLINE(1:40) ='420.,....430..,....440..,....450..,....4'
CHARLINE(41:60)='60..,....470..,....8'
ELSEIF (ILINE.EQ.24) THEN
CHARLINE(1:40) ='480.,....490..,....500..,....510..,....5'
CHARLINE(41:60)='20..,....530..,....4'
ELSEIF (ILINE.EQ.25) THEN
CHARLINE(1:40) ='540.,....550..,....560..,....570..,....5'
CHARLINE(41:60)='80..,....590..,....6'
ELSE
CHARLINE(1:40) ='x0..,....x1...,....x2...,....x3...,....x'
CHARLINE(41:60)='4...,....x5...,....6'
END IF
END IF
FWRITE_STRING_NUMBERS=CHARLINE
END
***** end of FWRITE_STRING_NUMBERS
***** ------------------------------------------------------------------
***** SUB GETCHAR
***** ------------------------------------------------------------------
C----
C---- NAME : GETCHAR
C---- ARG :
C---- DES : prompts for printable (keyboard) characters
C---- DES : Caution: line with '$!' is truncated as comment
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE GETCHAR(KCHAR,CHARARR,CTEXT)
LOGICAL EMPTYSTRING
CHARACTER*222 LINE
CHARACTER*222 CTEXT
CHARACTER CHARARR*(*)
WRITE(*,*)
WRITE(*,*)'================================================='//
+ '=============================='
CALL WRITELINES(CTEXT)
IF(KCHAR.LT.1)THEN
WRITE(*,*)'*** CHARPROMPT: illegal KCHAR',KCHAR
RETURN
ENDIF
10 CONTINUE
WRITE(*,*)
IF(KCHAR.GT.1) THEN
WRITE(*,'(2X,''Enter letter string of length <'',I3)')KCHAR
ELSE
WRITE(*,'(2X,''Enter one letter !'')')
ENDIF
WRITE(*,'(2X,''[CR=default]: '')')
WRITE(*, '(2X,''Default: '',80A1)' ) (CHARARR(K:K),K=1,KCHAR)
LINE=' '
READ(*,'(A80)',ERR=10,END=11) LINE
IF(.NOT.EMPTYSTRING(LINE)) THEN
C ! assuming default values were set outside ....
C...remove comments ( 34535345 !$ comment )
KCOMMENT=INDEX(LINE,'!$')
IF(KCOMMENT.NE.0) LINE(KCOMMENT:80)=' '
DO I=1,80
IF (INDEX(' ABCDEFGHIJKLMNOPQRSTUVWXYZ',LINE(I:I))
+ .EQ.0) THEN
IF (INDEX(' abcdefghijklmnopqrstuvwxyz',LINE(I:I))
+ .EQ.0) THEN
C IF (INDEX('~!@#$%^&*()_+=-{}[]:""|\;,' ,LINE(I:I))
IF (INDEX('~!@#$%^&*()_+=-{}[]:""|;,' ,LINE(I:I))
+ .EQ.0) THEN
IF (INDEX('.?/><1234567890 ',LINE(I:I))
+ .EQ.0) THEN
WRITE(*,
+ '(2X,''*** characters only, not: '',A40)')
+ LINE(1:40)
GO TO 10
ENDIF
ENDIF
ENDIF
ENDIF
ENDDO
READ(LINE,'(80A1)',ERR=10,END=99) (CHARARR(K:K),K=1,KCHAR)
ENDIF
11 WRITE(*,'(2X,A7,60A1)') ' echo: ', (CHARARR(K:K),K=1,KCHAR)
RETURN
99 WRITE(*,*)' CHARPROMPT: END OF LINE DURING READ - check format!'
END
***** end of GETCHAR
***** ------------------------------------------------------------------
***** SUB GET_ARGUMENT
***** ------------------------------------------------------------------
C----
C---- NAME : GET_ARGUMENT
C---- ARG : NUMBER,ARGUMENT
C---- DES : returns the content of x-th argument
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE GET_ARGUMENT(INUMBER,ARGUMENT)
CHARACTER*222 ARGUMENT
INTEGER INUMBER
CALL GETARG(INUMBER,ARGUMENT)
RETURN
END
***** end of GET_ARGUMENT
***** ------------------------------------------------------------------
***** SUB GET_ARG_NUMBER
***** ------------------------------------------------------------------
C----
C---- NAME : GET_ARG_NUMBER
C---- ARG : INUMBER
C---- DES : returns number of arguments
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE GET_ARG_NUMBER(INUMBER)
INTEGER INUMBER,IARGC
INUMBER=0
INUMBER=IARGC()
RETURN
END
***** end of GET_ARG_NUMBER
***** ------------------------------------------------------------------
***** SUB SCHECKPASS
***** ------------------------------------------------------------------
C----
C---- NAME : SCHECKPASS
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Sep, 1992 version 0.1 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
C purpose: Check whether arrays passed between SBRs are cor-*
C -------- rectly passed or not *
C input variables:CHVP1-N,CHVPL *
C output variab.: LERRCHVP,POSERRCHVP *
C-----------------------------------------------------------------------
SUBROUTINE SCHECKPASS(CHVPM,CHVPL,LERRCHVP)
IMPLICIT NONE
C---- local variables *
INTEGER ITER,CHVPM(*),CHVPL
LOGICAL LERRCHVP,LPOSERRCHVP(1:50)
******------------------------------*-----------------------------******
C---- initial check of maximal dimension
IF (CHVPL.GT.10) THEN
WRITE(6,'(T2,A,T10,A)')'***',
+ 'WARNING: SCHECKPASS:number of passed variables not fitting'
END IF
LERRCHVP=.FALSE.
DO ITER=1,CHVPL
LPOSERRCHVP(ITER)=.FALSE.
END DO
DO ITER=1,CHVPL
IF (CHVPM(ITER).NE.ITER) THEN
LPOSERRCHVP(ITER)=.TRUE.
LERRCHVP=.TRUE.
WRITE(6,*)'x.x',iter,' - chvpm=',chvpm(iter)
END IF
END DO
IF (LERRCHVP .EQV. .TRUE.) THEN
WRITE(6,'(T2,A,T10,A)')'***',
+ 'ERROR for SCHECKPASS: variables passed not correct !'
DO ITER=1,CHVPL
IF (LPOSERRCHVP(ITER).EQV. .TRUE.) THEN
WRITE(6,'(T2,A,T10,A,T60,I4)')'***',
+ 'The check detected a fault for variable:',ITER
END IF
END DO
END IF
END
***** end of SCHECKPASS
***** ------------------------------------------------------------------
***** SUB SEVALINFOFILE
***** ------------------------------------------------------------------
C----
C---- NAME : SEVALINFOFILE
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Nov, 1992 version 0.1 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: The information (entropy) for the current output *
* -------- is computed). *
* input variables:NSECELLIB, MATNUMALL *
* output variab.: INFO, NORMINFO *
* called by: SEVALSEC (in lib-prot.f) *
* SBRs calling: functions from lib-comp.f: *
* FRMEAN1,FRVAR1 *
* procedure: Sinfo= ln [ (n!) / prod/s {n(s)!} ] + *
* ---------- - sum /[s] *
* ln [ (m(s)!) / prod/s {m(s,s')!} ] *
* normalization: by: n*ln(3) - ln(n) -ln(2*pi) + *
* + 1.5 ln(3) *
* new formulation according to JuMBo: *
* a(i): number of predicted in structure i *
* b(i): number of observed in structure i *
* A(ij):predicted in j, observed in i *
* sum/i {a(i)ln a(i)} - sum/ij {A(ij)ln A(ij)} *
* I = 1 - -------------------------------------------- *
* N ln N - sum/i {b(i) ln b(i) } *
*----------------------------------------------------------------------*
SUBROUTINE SEVALINFOFILE(KUNIT,NSECELLIB,MAXNSECEL,
+ MATNUMALL,INFO,INFO_INV,LWRITE)
IMPLICIT NONE
C---- passed variables
INTEGER NSECELLIB,KUNIT,MAXNSECEL,
+ MATNUMALL(1:(MAXNSECEL+1),1:(MAXNSECEL+1))
REAL INFO,INFO_INV
C---- local variables *
INTEGER ITSEC,ITSEC2
REAL INTER,SUM,N,NOMINATOR,DENOMINATOR,
+ TERM_AIJ,TERM_PRED,TERM_DSSP,TERM_N
LOGICAL LWRITE
******------------------------------*-----------------------------******
*--------------------- *
* passed variables *
* INFO information as defined in procedure above *
* INFO_INV same as info but now as %of predicted so to speak*
* KUNIT number of unit to write the files upon *
* LWRITE if true the results are written onto the KUNIT *
* MAXNSECEL maximal number of secondary structures for array *
* boundaries *
* MATNUM(i,j) the number of residues in a certain secondary *
* structure, i labels DSSP assignment, i.e. all *
* numbers with i=1 are according to DSSP helices, *
* j labels the prediction. That means, e.g.: *
* MATNUM(1,1) are all DSSP helices predicted to be *
* a helix, MATNUM(1,2) those DSSP helices predicted*
* as strands and MATNUM(1,4) all DSSP helices, resp.
* MATNUM(4,4) all residues predicted. *
* N total number of residues *
* NOMINATOR = TERM_PRED - TERM_AIJ *
* NSECEL number of secondary structure types used *
*--------------------- *
* local variables *
* MUE,NUE,ITSEC,ITSEC2,ITER,ITHISTO,ITFILES iteration variables *
* NOMINATOR = TERM_PRED - TERM_AIJ *
* TERM_AIJ sum/ij of A(ij): number of residues predicted in *
* structure j, observed in i *
* TERM_DSSP sum over residues observed in: H + E + L *
* TERM_N N * ln (N) *
* TERM_PRED sum over residues predicted in: H + E + L *
******------------------------------*-----------------------------******
TERM_N= 0
C---- compute the mixed term: m(s,s2) A(ij)
SUM=0.
DO ITSEC2=1,NSECELLIB
DO ITSEC=1,NSECELLIB
INTER=REAL(MATNUMALL(ITSEC,ITSEC2))
IF (INTER.GT.0) THEN
SUM=SUM+( (INTER+0.5) * LOG(INTER) )
END IF
END DO
END DO
TERM_AIJ=SUM
C---- compute the term of sum over prediction m(s) = pred(i)
SUM=0.
DO ITSEC=1,NSECELLIB
INTER=REAL(MATNUMALL((NSECELLIB+1),ITSEC))
IF (INTER.GT.0) THEN
SUM=SUM+( (INTER+0.5) * LOG(INTER) )
END IF
END DO
TERM_PRED=SUM
C---- compute the term stemming from the data bank n(s) = DSSP(i)
SUM=0.
DO ITSEC=1,NSECELLIB
INTER=REAL(MATNUMALL(ITSEC,(NSECELLIB+1)))
IF (INTER.GT.0) THEN
SUM=SUM+( (INTER+0.5) * LOG(INTER) )
END IF
END DO
TERM_DSSP=SUM
C---- compute the term for all residues
N=REAL(MATNUMALL((NSECELLIB+1),(NSECELLIB+1)))
IF (N.LT.10E15) THEN
TERM_N=N * LOG (N)
ELSE
WRITE(6,'(T2,A,T10,A,T70,F12.1)')'***',
+ 'ERROR for computation of information: N too big=',N
END IF
C--------------------------------------------------
C---- add up all terms -----
C--------------------------------------------------
C---- %observed
NOMINATOR =TERM_PRED - TERM_AIJ
DENOMINATOR=TERM_N - TERM_DSSP
IF (ABS(DENOMINATOR).GT.10E-15) THEN
INFO=1-(NOMINATOR/DENOMINATOR)
ELSE
IF (NOMINATOR.GE.10E15) THEN
INFO=0
ELSE
INFO=10
END IF
END IF
C---- %predicted
NOMINATOR =TERM_DSSP - TERM_AIJ
DENOMINATOR=TERM_N - TERM_PRED
IF (ABS(DENOMINATOR).GT.10E-15) THEN
INFO_INV=1-(NOMINATOR/DENOMINATOR)
ELSE
IF (NOMINATOR.GE.10E15) THEN
INFO_INV=0
ELSE
INFO_INV=10
END IF
END IF
C---- write results onto printer
IF (LWRITE .EQV. .TRUE.) THEN
WRITE(KUNIT,'(T57,A10,F6.3,A9,F6.3,A2)')
+ '| I %obs= ',INFO,', %pred= ',INFO_INV,' |'
WRITE(KUNIT,'(T57,A)')
+ '+-------------------------------+'
WRITE(KUNIT,'(T2,A)')'---'
END IF
END
***** end of SEVALINFOFILE
***** ------------------------------------------------------------------
***** SUB SEVALLEN
***** ------------------------------------------------------------------
C----
C---- NAME : SEVALLEN
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Apr, 1992 version 0.1 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: The lengths and number of the secondary structure*
* -------- elements for a given protein are evaluated. *
* input variables:NSECELLIB,LENGTHLIB,NHISTOLIB,DSSPCHAR,PREDCHAR *
* output variab.: MATLEN,MATLENDIS *
* called by: SEVALSEC (in lib-prot.f) *
* procedure: straightforward *
*----------------------------------------------------------------------*
SUBROUTINE SEVALLEN(NSECELLIB,MAXNSECEL,LENGTHLIB,MAXLENGTH,
+ NHISTOLIB,MAXNHISTO,DSSPCHAR,PREDCHAR,MATLEN,MATLENDIS)
IMPLICIT NONE
C---- local parameter *
LOGICAL LWRT
PARAMETER (LWRT=.FALSE.)
C PARAMETER (LWRT=.TRUE.)
C---- *
C---- variables passed
INTEGER MAXNSECEL,MAXLENGTH,MAXNHISTO,NSECELLIB,
+ LENGTHLIB,NHISTOLIB,MATLEN(1:(MAXNSECEL+1),1:4),
+ MATLENDIS(1:MAXNHISTO,1:(2*MAXNSECEL))
CHARACTER*1 DSSPCHAR(1:MAXLENGTH),PREDCHAR(1:MAXLENGTH)
C---- local variables
INTEGER ITSEC,ITEL,ITHISTO,MUE,IHELP
INTEGER COUNTMUE,COUNTSTR,ELNO,ELLEN(1:2000),
+ ELNOTOT(1:9),ELLENTOT(1:9)
LOGICAL NEWSTR,LHELP
CHARACTER*1 SSCHAR(1:8),CURSTR,ELCHAR(1:2000)
******------------------------------*-----------------------------******
* MUE,NUE,ITSEC,ITSEC2,ITER,ITHISTO,ITFILES iteration variables *
* COUNTMUE counts the number of samples *
* =sum(nue=1,numprottest){numrestest(nue)} *
* COUNTSTR counts the number of secondary elements within *
* each protein, resp. the sum over all proteins *
* CURSTR stores intermediately the name of the currently *
* treate secondary element *
* DSSPCHAR(i) secondary structure according to DSSP for a par- *
* ticular protein *
* ELCHAR(i) one-letter symbol of secondary structure for *
* the i-th element *
* ELDIS(c,h) number of elements of class c with length h *
* ELNO number of secondary elements *
* ELNOTOT(c) distinct number of all elements of class * *
* ELLEN(i) length (number of residues) for element i *
* ELLENTOT(c) summed length of all elements of class * *
* LENGTHLIB current length of protein *
* LWRT if true certain information is written onto prin-*
* ter, e.g. the length distribution *
* MATLEN(i,j) matrix with the lengths of the elements: *
* i=1,4 => H,E,C,all *
* j=1 => number of elements DSSP *
* j=2 => number of elements PRED *
* j=2 => summed length of all elements for DSSP *
* j=2 => summed length of all elements for PRED *
* MATLENDIS(i,j) gives the distribution of the elements *
* i=1,50=> for histogram (lengths 1-50) *
* j=1,3 => H,E,C for DSSP *
* j=4,6 => H,E,C for PRED *
* MAXLENGTH maximal length of current protein allowed *
* MAXNHISTO maximal number of columns for histogram *
* MAXNSECEL maximal number of secondary structures allowed *
* NEWSTR required for ending the summing up of the length *
* of a particular structure *
* NHISTOLIB number of columns for histogram of lenght distri-*
* bution *
* NSECELLIB currently read number of secondary structures *
* NUMFILESREAD number of files to be read *
* NUMPROTLIB number of proteins of particular file read *
* PREDCHAR(i) secondary structure according to prediction for a*
* particular protein *
* SSCHAR(i) character giving the one-letter symbol for i-th *
* secondary structure class *
******------------------------------*-----------------------------******
IF (LWRT .EQV. .TRUE.) THEN
WRITE(6,'(T2,A3,T5,A50,T56,A)')'---',
+ 'computing the lengths of DSSP and PRED elements by',
+ ' SBR SEVALLEN form lib-prot.f'
END IF
C---- check variables passed
IF (LENGTHLIB.GT.MAXLENGTH) THEN
WRITE(6,'(T5,A)')
+ ' The length of the protein passed to SBR SEVALLEN'
WRITE(6,'(T5,A)')
+ ' exceeds the locally allocated array dimensions.'
WRITE(6,'(T5,A,T25,I4,T30,A,T40,I4)')
+ ' Current length: ',LENGTHLIB,' allocated:',MAXLENGTH
WRITE(6,'(T5,A)')' Stopped in SEVALLEN 12-2-92:1'
STOP
END IF
IF (NSECELLIB.GT.MAXNSECEL) THEN
WRITE(6,'(T5,A)')
+ 'The number of secondary structures passed to SBR SEVALLEN'
WRITE(6,'(T5,A)')
+ 'exceeds the locally allocated array dimensions.'
WRITE(6,'(T5,A,T25,I4,T30,A,T40,I4)')
+ ' Current number: ',NSECELLIB,' allocated:',MAXNSECEL
WRITE(6,'(T5,A)')' Stopped in SEVALLEN 12-2-92:2'
STOP
END IF
C---- assign secondary characters
SSCHAR(1)='H'
SSCHAR(2)='E'
SSCHAR(NSECELLIB)='L'
IF (NSECELLIB.EQ.4) THEN
SSCHAR(3)='T'
ELSEIF (NSECELLIB.EQ.5) THEN
SSCHAR(3)='T'
SSCHAR(4)='S'
ELSEIF (NSECELLIB.GT.5) THEN
WRITE(6,'(T5,A)')
+ 'Caution: current version of SEVALLEN distinguishes'
WRITE(6,'(T5,A)')'only five different secondary structures!'
WRITE(6,'(T5,A)')'Stopped in SBR SEVALLEN: 12-2-92:3'
STOP
END IF
C---- to be on the save side: substitute potential blanks by 'L'
DO MUE=1,LENGTHLIB
LHELP=.TRUE.
DO ITSEC=1,(NSECELLIB-1)
IF (LHELP.EQV. .TRUE.
+ .AND.(PREDCHAR(MUE).EQ.SSCHAR(ITSEC))) THEN
LHELP=.FALSE.
END IF
END DO
IF (LHELP .EQV. .TRUE.) THEN
PREDCHAR(MUE)='L'
END IF
END DO
C---- setting initially to zero (explicit as INTEGER*2)
ELNO=0
CALL SISTZ1(ELLEN,2000)
CALL SISTZ1(ELNOTOT,9)
CALL SISTZ1(ELLENTOT,9)
CALL SISTZ2(MATLENDIS,MAXNHISTO,(2*MAXNSECEL))
C--------------------------------------------------
C---- discriminate elements for DSSP -----
C--------------------------------------------------
C---- counting elements and summing up their lengths
COUNTMUE=0
MUE=0
COUNTSTR=0
DO WHILE (MUE.LT.LENGTHLIB)
COUNTSTR=COUNTSTR+1
NEWSTR=.FALSE.
DO WHILE ((MUE.LT.(LENGTHLIB-1)).AND.(.NOT.NEWSTR))
MUE=MUE+1
COUNTMUE=COUNTMUE+1
CURSTR=DSSPCHAR(COUNTMUE)
ELCHAR(COUNTSTR)=CURSTR
ELLEN(COUNTSTR)=ELLEN(COUNTSTR)+1
IF (DSSPCHAR(COUNTMUE+1).NE.CURSTR) THEN
NEWSTR=.TRUE.
END IF
END DO
IF ((NEWSTR.EQV. .FALSE.).AND.(MUE.EQ.(LENGTHLIB-1))) THEN
MUE=MUE+1
COUNTMUE=COUNTMUE+1
CURSTR=DSSPCHAR(COUNTMUE)
ELCHAR(COUNTSTR)=CURSTR
ELLEN(COUNTSTR)=ELLEN(COUNTSTR)+1
ELSEIF (NEWSTR.EQV. .TRUE. .AND.(MUE.EQ.(LENGTHLIB-1))) THEN
MUE=MUE+1
COUNTMUE=COUNTMUE+1
COUNTSTR=COUNTSTR+1
CURSTR=DSSPCHAR(COUNTMUE)
ELCHAR(COUNTSTR)=CURSTR
ELLEN(COUNTSTR)=ELLEN(COUNTSTR)+1
END IF
END DO
ELNO=COUNTSTR
C--------------------------------------------------
C---- compute total number of elements and -----
C---- averaged length for each secondary class ----
C--------------------------------------------------
DO ITEL=1,ELNO
LHELP=.TRUE.
DO ITSEC=1,NSECELLIB
IF ((ELCHAR(ITEL).EQ.SSCHAR(ITSEC)).AND.LHELP) THEN
ELNOTOT(ITSEC)=ELNOTOT(ITSEC)+1
ELLENTOT(ITSEC)=ELLENTOT(ITSEC)+ELLEN(ITEL)
LHELP=.FALSE.
END IF
END DO
END DO
DO ITSEC=1,NSECELLIB
ELNOTOT(NSECELLIB+1)=ELNOTOT(NSECELLIB+1)+ELNOTOT(ITSEC)
ELLENTOT(NSECELLIB+1)=
+ ELLENTOT(NSECELLIB+1)+ELLENTOT(ITSEC)
END DO
DO ITSEC=1,(NSECELLIB+1)
MATLEN(ITSEC,1)=ELNOTOT(ITSEC)
MATLEN(ITSEC,3)=ELLENTOT(ITSEC)
END DO
C--------------------------------------------------
C---- evaluate desired distribution of elements ---
C--------------------------------------------------
DO ITEL=1,ELNO
IF (ELLEN(ITEL).LE.NHISTOLIB) THEN
IHELP=ELLEN(ITEL)
ELSE
IHELP=NHISTOLIB
END IF
LHELP=.TRUE.
DO ITSEC=1,(NSECELLIB-1)
IF (LHELP.EQV. .TRUE. .AND.
+ (ELCHAR(ITEL).EQ.SSCHAR(ITSEC))) THEN
MATLENDIS(IHELP,ITSEC)=MATLENDIS(IHELP,ITSEC)+1
LHELP=.FALSE.
END IF
END DO
IF (LHELP .EQV. .TRUE.) THEN
MATLENDIS(IHELP,NSECELLIB)=MATLENDIS(IHELP,NSECELLIB)+1
END IF
END DO
C---- write desired quantities seperately onto the printer
C---- NOTE: INTERWRTDES is a local parameter, see above
IF (LWRT .EQV. .TRUE.) THEN
WRITE(6,'(T5,A,T20,A,T65,A)')' SEVALLEN:',
+ 'number of DSSP elements for each prot',
+ 'class: length'
WRITE(6,'(T2,A,T15,30I3)')'X.X: LEN ',
+ (ELLEN(ITEL),ITEL=1,ELNO)
IF (NSECELLIB.EQ.3) THEN
WRITE(6,'(T2,A,T15,4I5)')'X.X: NOTOT:',
+ (ELNOTOT(ITSEC),ITSEC=1,NSECELLIB+1)
WRITE(6,'(T2,A,T15,4I5)')' LENTOT:',
+ (ELLENTOT(ITSEC),ITSEC=1,NSECELLIB+1)
ELSEIF (NSECELLIB.EQ.2) THEN
WRITE(6,'(T2,A,T15,2I5)')'X.X: NOTOT:',
+ (ELNOTOT(ITSEC),ITSEC=1,NSECELLIB+1)
WRITE(6,'(T2,A,T15,2I5)')' LENTOT:',
+ (ELLENTOT(ITSEC),ITSEC=1,NSECELLIB+1)
ELSEIF (NSECELLIB.EQ.4) THEN
WRITE(6,'(T2,A,T15,5I5)')'X.X: NOTOT:',
+ (ELNOTOT(ITSEC),ITSEC=1,NSECELLIB+1)
WRITE(6,'(T2,A,T15,5I5)')' LENTOT:',
+ (ELLENTOT(ITSEC),ITSEC=1,NSECELLIB+1)
END IF
WRITE(6,*)
WRITE(6,'(T5,A)')'distribution of DSSP elements'
WRITE(6,'(T2,A2,T5,30I3)')
+ 'H:',(MATLENDIS(ITHISTO,3),ITHISTO=1,30)
IF (NSECELLIB.GT.2) THEN
WRITE(6,'(T2,A2,T5,30I3)')
+ 'E:',(MATLENDIS(ITHISTO,2),ITHISTO=1,30)
END IF
IF (NSECELLIB.GT.3) THEN
WRITE(6,'(T2,A2,T5,30I3)')
+ 'T:',(MATLENDIS(ITHISTO,3),ITHISTO=1,30)
END IF
WRITE(6,'(T2,A2,T5,30I3)')
+ 'C:',(MATLENDIS(ITHISTO,NSECELLIB),ITHISTO=1,30)
END IF
C--------------------------------------------------
C---- discriminate elements for PRED -----
C--------------------------------------------------
C---- setting initially to zero
ELNO=0
CALL SISTZ1(ELLEN,2000)
CALL SISTZ1(ELNOTOT,9)
CALL SISTZ1(ELLENTOT,9)
C---- counting elements and summing up their lengths
COUNTMUE=0
MUE=0
COUNTSTR=0
DO WHILE (MUE.LT.LENGTHLIB)
COUNTSTR=COUNTSTR+1
NEWSTR=.FALSE.
DO WHILE ((MUE.LT.(LENGTHLIB-1)).AND.(NEWSTR.EQV. .FALSE.))
MUE=MUE+1
COUNTMUE=COUNTMUE+1
CURSTR=PREDCHAR(COUNTMUE)
ELCHAR(COUNTSTR)=CURSTR
ELLEN(COUNTSTR)=ELLEN(COUNTSTR)+1
IF (PREDCHAR(COUNTMUE+1).NE.CURSTR) THEN
NEWSTR=.TRUE.
END IF
END DO
IF ((NEWSTR.EQV. .FALSE.).AND.(MUE.EQ.(LENGTHLIB-1))) THEN
MUE=MUE+1
COUNTMUE=COUNTMUE+1
CURSTR=PREDCHAR(COUNTMUE)
ELCHAR(COUNTSTR)=CURSTR
ELLEN(COUNTSTR)=ELLEN(COUNTSTR)+1
ELSEIF (NEWSTR.EQV. .TRUE. .AND.(MUE.EQ.(LENGTHLIB-1))) THEN
MUE=MUE+1
COUNTMUE=COUNTMUE+1
COUNTSTR=COUNTSTR+1
CURSTR=PREDCHAR(COUNTMUE)
ELCHAR(COUNTSTR)=CURSTR
ELLEN(COUNTSTR)=ELLEN(COUNTSTR)+1
END IF
END DO
ELNO=COUNTSTR
C--------------------------------------------------
C---- compute total number of elements and -----
C---- averaged length for each secondary class ----
C--------------------------------------------------
DO ITEL=1,ELNO
LHELP=.TRUE.
DO ITSEC=1,NSECELLIB
IF ((ELCHAR(ITEL).EQ.SSCHAR(ITSEC)).AND.LHELP) THEN
ELNOTOT(ITSEC)=ELNOTOT(ITSEC)+1
ELLENTOT(ITSEC)=ELLENTOT(ITSEC)+ELLEN(ITEL)
LHELP=.FALSE.
END IF
END DO
END DO
DO ITSEC=1,NSECELLIB
ELNOTOT(NSECELLIB+1)=ELNOTOT(NSECELLIB+1)+ELNOTOT(ITSEC)
ELLENTOT(NSECELLIB+1)=
+ ELLENTOT(NSECELLIB+1)+ELLENTOT(ITSEC)
END DO
DO ITSEC=1,(NSECELLIB+1)
MATLEN(ITSEC,2)=ELNOTOT(ITSEC)
MATLEN(ITSEC,4)=ELLENTOT(ITSEC)
END DO
C--------------------------------------------------
C---- evaluate desired distribution of elements ---
C--------------------------------------------------
DO ITEL=1,ELNO
IF (ELLEN(ITEL).LE.NHISTOLIB) THEN
IHELP=ELLEN(ITEL)
ELSE
IHELP=NHISTOLIB
END IF
LHELP=.TRUE.
DO ITSEC=1,(NSECELLIB-1)
IF (LHELP.EQV. .TRUE. .AND.
+ (ELCHAR(ITEL).EQ.SSCHAR(ITSEC))) THEN
MATLENDIS(IHELP,(NSECELLIB+ITSEC))=
+ MATLENDIS(IHELP,(NSECELLIB+ITSEC))+1
LHELP=.FALSE.
END IF
END DO
IF (LHELP .EQV. .TRUE.) THEN
MATLENDIS(IHELP,2*NSECELLIB)=MATLENDIS(IHELP,2*NSECELLIB)+1
END IF
END DO
C---- write desired quantities seperately onto the printer
C---- NOTE: INTERWRTDES is a local parameter, see above
IF (LWRT .EQV. .TRUE.) THEN
WRITE(6,'(T5,A,T20,A,T65,A)')' SEVALLEN:',
+ 'number of predicted elements for each prot',
+ 'class: length'
WRITE(6,'(T2,A,T15,30I3)')'X.X: LEN ',
+ (ELLEN(ITEL),ITEL=1,ELNO)
IF (NSECELLIB.EQ.3) THEN
WRITE(6,'(T2,A,T15,4I5)')'X.X: NOTOT:',
+ (ELNOTOT(ITSEC),ITSEC=1,NSECELLIB+1)
WRITE(6,'(T2,A,T15,4I5)')' LENTOT:',
+ (ELLENTOT(ITSEC),ITSEC=1,NSECELLIB+1)
ELSEIF (NSECELLIB.EQ.2) THEN
WRITE(6,'(T2,A,T15,3I5)')'X.X: NOTOT:',
+ (ELNOTOT(ITSEC),ITSEC=1,NSECELLIB+1)
WRITE(6,'(T2,A,T15,3I5)')' LENTOT:',
+ (ELLENTOT(ITSEC),ITSEC=1,NSECELLIB+1)
ELSEIF (NSECELLIB.EQ.4) THEN
WRITE(6,'(T2,A,T15,5I5)')'X.X: NOTOT:',
+ (ELNOTOT(ITSEC),ITSEC=1,NSECELLIB+1)
WRITE(6,'(T2,A,T15,5I5)')' LENTOT:',
+ (ELLENTOT(ITSEC),ITSEC=1,NSECELLIB+1)
END IF
WRITE(6,*)
WRITE(6,*)' distribution of predicted elements'
WRITE(6,'(T2,A2,T5,30I3)')
+ 'H:',(MATLENDIS(ITHISTO,(NSECELLIB+1)),ITHISTO=1,30)
IF (NSECELLIB.EQ.3) THEN
WRITE(6,'(T2,A2,T5,30I3)')
+ 'E:',(MATLENDIS(ITHISTO,(NSECELLIB+2)),ITHISTO=1,30)
WRITE(6,'(T2,A2,T5,30I3)')
+ 'L:',(MATLENDIS(ITHISTO,(NSECELLIB+3)),ITHISTO=1,30)
ELSEIF (NSECELLIB.EQ.2) THEN
WRITE(6,'(T2,A2,T5,30I3)')
+ 'L:',(MATLENDIS(ITHISTO,(NSECELLIB+2)),ITHISTO=1,30)
ELSEIF (NSECELLIB.EQ.4) THEN
WRITE(6,'(T2,A2,T5,30I3)')
+ 'E:',(MATLENDIS(ITHISTO,(NSECELLIB+2)),ITHISTO=1,30)
WRITE(6,'(T2,A2,T5,30I3)')
+ 'T:',(MATLENDIS(ITHISTO,(NSECELLIB+3)),ITHISTO=1,30)
WRITE(6,'(T2,A2,T5,30I3)')
+ 'L:',(MATLENDIS(ITHISTO,(NSECELLIB+4)),ITHISTO=1,30)
END IF
END IF
END
***** end of SEVALLEN
***** ------------------------------------------------------------------
***** SUB SEVALPO
***** ------------------------------------------------------------------
C----
C---- NAME : SEVALPO
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Apr, 1992 version 0.1 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: The pay-offs of a certain prediction are computed*
* -------- i.e.: MATNUM, asf. *
* input variables:NSECELLIB,LENGTHLIB,DSSPCHAR,PREDCHAR *
* output variab.: MATNUM,MATOFDSSP,MATOFPRED,Q3,SQ,CORR *
* SBRs calling: SEVALQUO: computes MATOF*, Q3, SQ, CORR with *
* -------------- passing MATNUM *
* called by: SEVALSEC (in lib-prot.f) *
*----------------------------------------------------------------------*
SUBROUTINE SEVALPO(NSECELLIB,MAXNSECEL,LENGTHLIB,MAXLENGTH,
+ DSSPCHAR,PREDCHAR,MATNUM,MATQOFDSSP,MATQOFPRED,Q3,SQ,CORR)
IMPLICIT NONE
C---- variables passed
INTEGER MAXNSECEL,MAXLENGTH,NSECELLIB,LENGTHLIB,
+ MATNUM(1:(MAXNSECEL+1),1:(MAXNSECEL+1))
REAL Q3,SQ,CORR(1:MAXNSECEL),
+ MATQOFDSSP(1:MAXNSECEL,1:MAXNSECEL),
+ MATQOFPRED(1:MAXNSECEL,1:MAXNSECEL)
CHARACTER*1 SSCHAR(1:8)
CHARACTER*1 DSSPCHAR(1:MAXLENGTH),PREDCHAR(1:MAXLENGTH)
C---- local variables
INTEGER ITSEC,ITSEC2,MUE,ISUM1,ISUM2
LOGICAL LHELP,LDSSP,LNET
******------------------------------*-----------------------------******
* MUE,ITSEC,ITSEC2 serve as iteration variables *
* CORR(i) correlation for class i, see POTRAIN/TESTCOR *
* DSSPCHAR(i) secondary structure according to DSSP for a par- *
* ticular protein *
* ISUM1,2 help variables required for computing sums *
* LENGTHLIB current length of protein *
* LHELP logical help variable for intermediately check *
* LDSSP,LNET intermediate flags, used for checking whether for*
* a particular residue there is any of the three *
* classes: if not there is a fault *
* MATNUM(i,j) the number of residues in a certain secondary *
* structure, i labels DSSP assignment, i.e. all *
* numbers with i=1 are according to DSSP helices, *
* j labels the prediction. That means, e.g.: *
* MATNUM(1,1) are all DSSP helices predicted to be *
* a helix, MATNUM(1,2) those DSSP helices predicted*
* as strands and MATNUM(1,4) all DSSP helices, resp.
* MATNUM(4,4) all residues predicted. *
* MATNUMALL MATNUM summed over all proteins of all files read*
* MATOFDSSP(i,j) stores according to the same scheme as MATNUM the*
* percentages of residues predicted divided by the *
* numbers of DSSP (note there is no element (4,4) )*
* MATOFPRED(i,j) same as previous but now percentages of prediction
* MAXLENGTH maximal length of current protein allowed *
* MAXNHISTO maximal number of columns for histogram *
* MAXNUMPROT maximal number of proteins per read file *
* MAXNSECEL maximal number of secondary structures allowed *
* NSECELLIB currently read number of secondary structures *
* PREDCHAR(i) secondary structure according to prediction for a*
* particular protein *
* Q3 =properly predicted for all classes/all residues *
* SQ first divide predicted/DSSP in each class then *
* sum all classes and divide by e.g. 3 *
* SSCHAR(i) character giving the one-letter symbol for i-th *
* secondary structure class *
******------------------------------*-----------------------------******
C---- check variables passed
IF (LENGTHLIB.GT.MAXLENGTH) THEN
WRITE(6,'(T5,A)')
+ ' The length of the protein passed to SBR SEVALPO'
WRITE(6,'(T5,A)')
+ ' exceeds the locally allocated array dimensions.'
WRITE(6,'(T5,A,T25,I4,T30,A,T40,I4)')
+ ' Current length: ',LENGTHLIB,' allocated:',MAXLENGTH
WRITE(6,'(T5,A)')' Stopped in SEVALPO 12-2-92:1'
STOP
END IF
IF (NSECELLIB.GT.MAXNSECEL) THEN
WRITE(6,'(T5,A)')
+ 'The number of secondary structures passed to SBR SEVALPO'
WRITE(6,'(T5,A)')
+ 'exceeds the locally allocated array dimensions.'
WRITE(6,'(T5,A,T25,I4,T30,A,T40,I4)')
+ ' Current number: ',NSECELLIB,' allocated:',MAXNSECEL
WRITE(6,'(T5,A)')' Stopped in SEVALPO 12-2-92:2'
STOP
END IF
C---- assign secondary characters
SSCHAR(1)='H'
SSCHAR(2)='E'
SSCHAR(NSECELLIB)='L'
IF (NSECELLIB.EQ.4) THEN
SSCHAR(3)='T'
ELSEIF (NSECELLIB.EQ.5) THEN
SSCHAR(3)='T'
SSCHAR(4)='S'
ELSEIF (NSECELLIB.GT.5) THEN
WRITE(6,'(T5,A)')
+ 'Caution: current version of SEVALPO distinguishes'
WRITE(6,'(T5,A)')'only five different secondary structures!'
WRITE(6,'(T5,A)')'Stopped in SBR SEVALPO: 12-2-92:3'
STOP
END IF
C---- to be on the save side: substitute potential blanks by 'L'
DO MUE=1,LENGTHLIB
LHELP=.TRUE.
DO ITSEC=1,NSECELLIB
IF (PREDCHAR(MUE).EQ.SSCHAR(ITSEC)) THEN
LHELP=.FALSE.
END IF
END DO
IF (LHELP .EQV. .TRUE.) THEN
PREDCHAR(MUE)='L'
END IF
LHELP=.TRUE.
DO ITSEC=1,NSECELLIB
IF (DSSPCHAR(MUE).EQ.SSCHAR(ITSEC)) THEN
LHELP=.FALSE.
END IF
END DO
IF (LHELP .EQV. .TRUE.) THEN
DSSPCHAR(MUE)='L'
END IF
END DO
C---- initialize by setting zero
DO ITSEC=1,(MAXNSECEL+1)
DO ITSEC2=1,(MAXNSECEL+1)
MATNUM(ITSEC,ITSEC2)=0
END DO
END DO
C--------------------------------------------------
C---- new number matrix -----
C--------------------------------------------------
C IF (.TRUE.) THEN
C------- loop over all residues
DO MUE=1,LENGTHLIB
LDSSP=.TRUE.
LNET=.TRUE.
DO ITSEC=1,NSECELLIB
IF (DSSPCHAR(MUE).EQ.SSCHAR(ITSEC)) THEN
LDSSP=.FALSE.
DO ITSEC2=1,NSECELLIB
IF (PREDCHAR(MUE).EQ.SSCHAR(ITSEC2)) THEN
LNET=.FALSE.
MATNUM(ITSEC,ITSEC2)=MATNUM(ITSEC,ITSEC2)+1
END IF
END DO
END IF
END DO
C---------- consistency check
IF (LNET.OR.LDSSP) THEN
WRITE(6,*)'for mue=',mue,' :ldssp',ldssp,
+ ' lnet ',lnet,' with dssp=',
+ dsspchar(mue),' net:',predchar(mue)
END IF
END DO
C------- summing up
DO ITSEC=1,NSECELLIB
DO ITSEC2=1,NSECELLIB
MATNUM(ITSEC,(NSECELLIB+1))=
+ MATNUM(ITSEC,(NSECELLIB+1))+MATNUM(ITSEC,ITSEC2)
MATNUM((NSECELLIB+1),ITSEC)=
+ MATNUM((NSECELLIB+1),ITSEC)+MATNUM(ITSEC2,ITSEC)
END DO
END DO
ISUM1=0
ISUM2=0
DO ITSEC=1,NSECELLIB
ISUM1=ISUM1+MATNUM(ITSEC,(NSECELLIB+1))
ISUM2=ISUM2+MATNUM((NSECELLIB+1),ITSEC)
END DO
C END IF
IF (ISUM1.EQ.ISUM2) THEN
MATNUM((NSECELLIB+1),(NSECELLIB+1))=ISUM1
ELSE
WRITE(6,*)'number for dssp and net not equal!'
WRITE(6,*)'new: evalpo,resp SEVALPO'
WRITE(6,*)'for net:',ISUM2,' for DSSP:',ISUM1
END IF
C---- compute quotients
C =============
CALL SEVALQUO(NSECELLIB,MAXNSECEL,MATNUM,
+ MATQOFDSSP,MATQOFPRED,Q3,SQ,CORR)
C =============
END
***** end of SEVALPO
***** ------------------------------------------------------------------
***** SUB SEVALQUO
***** ------------------------------------------------------------------
C----
C---- NAME : SEVALQUO
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Apr, 1992 version 0.1 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: The pay-offs of a certain prediction are computed*
* -------- i.e.: quotients. *
* input variables:NSECELLIB,MATNUM *
* output variab.: MATOFDSSP,MATOFPRED,Q3,SQ,CORR *
* called by: SEVALSEC (in lib-prot.f): computes MATNUM *
* ---------- SEVALPO: (in lib-prot.f): computes MATNUM *
*----------------------------------------------------------------------*
SUBROUTINE SEVALQUO(NSECELLIB,MAXNSECEL,MATNUM,
+ MATQOFDSSP,MATQOFPRED,Q3,SQ,CORR)
IMPLICIT NONE
C---- variables passed
INTEGER MAXNSECEL,NSECELLIB,
+ MATNUM(1:(MAXNSECEL+1),1:(MAXNSECEL+1))
REAL Q3,SQ,CORR(1:MAXNSECEL)
REAL MATQOFDSSP(1:MAXNSECEL,1:MAXNSECEL)
REAL MATQOFPRED(1:MAXNSECEL,1:MAXNSECEL)
C---- local variables
INTEGER ITSEC,ITSEC2,ITSEC3,ISUM1
INTEGER PRED(1:8),REJ(1:8),OVEREST(1:8),UNDEREST(1:8)
REAL SQRT,DNM,DNM1,DNM2,DNM3,DNM4,CNT,CNT1,CNT2,RSUM
******------------------------------*-----------------------------******
* MUE,ITSEC,ITSEC2,ITSEC3 serve as iteration variables *
* CNT/DNM used for intermediateyly computing a quotient *
* CORR(i) correlation for class i, see POTRAIN/TESTCOR *
* definition (Matthew) *
* pred(i)*rej(i)-underest(i)*overest(i) *
* /sqrt( (pred+under)(pred+over)(rej+under)(rej+over) )*
* LENGTHLIB current length of protein *
* LHELP logical help variable for intermediately check *
* LDSSP,LNET intermediate flags, used for checking whether for*
* a particular residue there is any of the three *
* classes: if not there is a fault *
* MATNUM(i,j) the number of residues in a certain secondary *
* structure, i labels DSSP assignment, i.e. all *
* numbers with i=1 are according to DSSP helices, *
* j labels the prediction. That means, e.g.: *
* MATNUM(1,1) are all DSSP helices predicted to be *
* a helix, MATNUM(1,2) those DSSP helices predicted*
* as strands and MATNUM(1,4) all DSSP helices, resp.
* MATNUM(4,4) all residues predicted. *
* MATNUMALL MATNUM summed over all proteins of all files read*
* MATOFDSSP(i,j) stores according to the same scheme as MATNUM the*
* percentages of residues predicted divided by the *
* numbers of DSSP (note there is no element (4,4) )*
* MATOFPRED(i,j) same as previous but now percentages of prediction
* MAXNHISTO maximal number of columns for histogram *
* MAXNSECEL maximal number of secondary structures allowed *
* NSECELLIB currently read number of secondary structures *
* OVEREST(i) number of wrongly predicted secondary structure *
* elements of class i (perceptron says it is in i *
* but nature say, this is a lie) *
* PRED(i) number of properly predicted secondary structure *
* elements of class i *
* Q3 =properly predicted for all classes/all residues *
* REJ(i) number of properly rejected secondary structure *
* elements of class i (reject: not being i) *
* SQ first divide predicted/DSSP in each class then *
* sum all classes and divide by e.g. 3 *
* UNDEREREST(i) number of wrongly rejected secondary structure *
* elements of class i (perceptron says it is not in*
* i but nature say, this is a lie) *
******------------------------------*-----------------------------******
DNM= 0
CNT= 0
C--------------------------------------------------
C---- compute quotients -----
C--------------------------------------------------
DO ITSEC=1,NSECELLIB
DO ITSEC2=1,NSECELLIB
IF ((MATNUM(ITSEC,(NSECELLIB+1)).NE.0).AND.
+ (MATNUM((NSECELLIB+1),ITSEC2).NE.0)) THEN
MATQOFDSSP(ITSEC,ITSEC2)=
+ 100*MATNUM(ITSEC,ITSEC2)
+ /REAL(MATNUM(ITSEC,(NSECELLIB+1)))
MATQOFPRED(ITSEC,ITSEC2)=
+ 100*MATNUM(ITSEC,ITSEC2)
+ /REAL(MATNUM((NSECELLIB+1),ITSEC2))
ELSEIF ((MATNUM(ITSEC,(NSECELLIB+1)).NE.0).AND.
+ (MATNUM((NSECELLIB+1),ITSEC2).EQ.0)) THEN
MATQOFDSSP(ITSEC,ITSEC2)=
+ 100*MATNUM(ITSEC,ITSEC2)
+ /REAL(MATNUM(ITSEC,(NSECELLIB+1)))
MATQOFPRED(ITSEC,ITSEC2)=0
ELSEIF ((MATNUM(ITSEC,(NSECELLIB+1)).EQ.0).AND.
+ (MATNUM((NSECELLIB+1),ITSEC2).NE.0)) THEN
MATQOFDSSP(ITSEC,ITSEC2)=0
MATQOFPRED(ITSEC,ITSEC2)=
+ 100*MATNUM(ITSEC,ITSEC2)
+ /REAL(MATNUM((NSECELLIB+1),ITSEC2))
END IF
END DO
END DO
ISUM1=0
RSUM=0.
DO ITSEC=1,NSECELLIB
ISUM1=ISUM1+MATNUM(ITSEC,ITSEC)
RSUM=RSUM+MATQOFDSSP(ITSEC,ITSEC)
END DO
IF (MATNUM((NSECELLIB+1),(NSECELLIB+1)).NE.0) THEN
Q3=100*ISUM1/REAL(MATNUM((NSECELLIB+1),(NSECELLIB+1)))
ELSE
Q3=0
END IF
IF (NSECELLIB.NE.0) THEN
SQ=RSUM/REAL(NSECELLIB)
ELSE
SQ=0
END IF
C---- correlation (Matthews)
C---- for helix examples with M(ii) as MATNUM(i,i)
DO ITSEC=1,NSECELLIB
C------- = M(11)
PRED(ITSEC)=MATNUM(ITSEC,ITSEC)
C------- = M(22)+M(23)+M(32)+M(33)
ISUM1=0
DO ITSEC2=1,NSECELLIB
IF (ITSEC2.NE.ITSEC) THEN
DO ITSEC3=1,NSECELLIB
IF (ITSEC3.NE.ITSEC) THEN
ISUM1=ISUM1+MATNUM(ITSEC2,ITSEC3)
END IF
END DO
END IF
END DO
REJ(ITSEC)=ISUM1
C------- = M(12)+M(13)
ISUM1=0
DO ITSEC2=1,NSECELLIB
IF (ITSEC2.NE.ITSEC) THEN
ISUM1=ISUM1+MATNUM(ITSEC,ITSEC2)
END IF
END DO
UNDEREST(ITSEC)=ISUM1
C------- = M(21)+M(31)
ISUM1=0
DO ITSEC2=1,NSECELLIB
IF (ITSEC2.NE.ITSEC) THEN
ISUM1=ISUM1+MATNUM(ITSEC2,ITSEC)
END IF
END DO
OVEREST(ITSEC)=ISUM1
END DO
DO ITSEC=1,NSECELLIB
CNT1=PRED(ITSEC)*REJ(ITSEC)
CNT2=OVEREST(ITSEC)*UNDEREST(ITSEC)
DNM1=REJ(ITSEC)+UNDEREST(ITSEC)
DNM2=REJ(ITSEC)+OVEREST(ITSEC)
DNM3=PRED(ITSEC)+OVEREST(ITSEC)
DNM4=PRED(ITSEC)+UNDEREST(ITSEC)
C------- take care of potential overflow
IF ((DNM1*DNM2*DNM3*DNM4).GT.(10.E18)) THEN
CORR(ITSEC)=0.
ELSE
CNT=REAL(CNT1-CNT2)
DNM=SQRT(REAL(DNM1*DNM2*DNM3*DNM4))
END IF
IF ((ABS(CNT).LE.(10.E-16)).OR.(DNM.GT.(10.E16))) THEN
CORR(ITSEC)=0.
ELSE
CORR(ITSEC)=CNT/DNM
END IF
END DO
END
***** end of SEVALQUO
***** ------------------------------------------------------------------
***** SUB SEVALSEG
***** ------------------------------------------------------------------
C----
C---- NAME : SEVALSEG
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Nov, 1992 version 0.1 *
* changed: Mar, 1993 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: The measures related to segments are computed. *
* input variables:NSECELLIB,MAXNSECEL,NUMRESLIB,MAXNUMRES *
* ----------------DSSPCHAR,PREDCHAR *
* output variab.: NUMSEGOVERL, QSEGFOV *
* called by: SEVALPRED (in lib-prot.f) *
* SBRs calling:
* from lib-prot.f: *
* SSEGBEGIN, SSEGLOV, SSEGSOV, SSEGFOV, STABLESEG *
* procedure: * overlapp NUMSEGOVERL(3/4,ITSEC) ,3=%OBS, 4=%PRED *
* ---------- for H, E, T *
* if overlapp > L/2 *
* for L: *
* if overlapp > 2 *
* * correct: NUMSEGOVERL(5,ITSEC) *
* for L < 5: | L(OBS)-L(PRED) | <= 1 *
* .AND. shift by 1 allowed *
* for 5<=L<10: | L(OBS)-L(PRED) | <= 2 *
* .AND. shift by 2 allowed *
* for L >= 10: | L(OBS)-L(PRED) | <= 3 *
* .AND. shift by 3 allowed *
* * overlapping fraction: QSEGFOV(1/2,ITSEC) *
* number of overlapping residues *
* QSEGFOV(i)= ------------------------------ *
* end (max) - begin (min) *
* where *
* max= maximum (end(pred),end(obs)) *
* min= minimum (beg(pred),beg(obs)) *
*----------------------------------------------------------------------*
SUBROUTINE SEVALSEG(KSEG,LWRITEFILE,PROTNAME,
+ NSECELLIB,MAXNSECEL,NUMRESLIB,MAXNUMRES,CHVP1,
+ DSSPCHAR,PREDCHAR,CHVP2,NUMSEGOVERL,
+ COUNTSEGMAT,QSEGLOV,QSEGSOV,QSEGFOV,DEVNOM,CHVPL)
IMPLICIT NONE
C---- variables/ parameters from calling SBR
INTEGER KSEG,MAXNSECEL,NSECELLIB,MAXNUMRES,NUMRESLIB,
+ CHVPM(1:50),CHVPL,CHVP1,CHVP2,
+ NUMSEGOVERL(1:9,1:(MAXNSECEL+1)),
+ COUNTSEGMAT(1:2,1:(MAXNSECEL+1)),DEVNOM
REAL QSEGFOV(1:2,1:(MAXNSECEL+1)),
+ QSEGLOV(1:2,1:(MAXNSECEL+1)),QSEGSOV(1:2,1:(MAXNSECEL+1))
CHARACTER*1 DSSPCHAR(1:MAXNUMRES),PREDCHAR(1:MAXNUMRES)
CHARACTER*222 PROTNAME
LOGICAL LWRITEFILE
C---- local parameters
INTEGER MAXSEG
PARAMETER (MAXSEG= 5000)
C---- local variables resp. passed to SBRs called
INTEGER MUE,ITSEC,COUNTSEG,ITER
INTEGER NUMCOR(1:2,1:8),
+ POINTDSSP(1:2000),POINTPRED(1:2000),
+ BEGSEGDSSP(1:MAXSEG),ENDSEGDSSP(1:MAXSEG),LENSEGDSSP(1:MAXSEG),
+ BEGSEGPRED(1:MAXSEG),ENDSEGPRED(1:MAXSEG),LENSEGPRED(1:MAXSEG)
LOGICAL LHELP,LWRITE,LERRCHVP
CHARACTER*1 SSCHAR(1:8)
******------------------------------*-----------------------------******
* MUE,ITER serve as iteration variables *
* DEVNOM allowed deviation in nominator : *
* overlapping length + DEVNOM *
* QSEGFOV = --------------------------- *
* common length *
* NUMSEGOVERL(i,j) number of overlapping/correct segments *
* i=1 number of DSSP segments in secondary structure *
* j, for last: sum over all *
* i=2 number of residues in structure i, summed up over*
* all segments (in i=1) *
* i=3 number of predicted segments in class j *
* i=4 number of residues in structure i, summed up over*
* all segments (in i=1) for the prediction *
* i=5 number of overlapping predicted segments related *
* to those being observed. Correct means: *
* overlap >= length of segment / 2, for H, E, T *
* and for loop: at least loop of 2, resp 1, if the*
* DSSP loop is 1. *
* i=6 number of overlapping segments multiplied by *
* length: related to %observed *
* i=7 same as 5, but other way round: %pred! *
* i=8 same as 6, but other way round: %pred! *
* j, for last: sum over all *
* i=9 number of correct segments: *
* L +/- 1, and shift by 1, if L<=5 *
* L +/- 1, and shift by 2, if 510 *
* noted: j, for last: sum over all *
* QSEGLOV(i,j) i=1: %observed *
* i=2: %predicted *
* j=1-4 (helix,strand,loop,3-states) *
* gives the loose overlap (half length overlap) *
* multiplication with length of segment, normali- *
* sation will be done by calling SBR with N=number *
* of all residues in the data set *
* QSEGSOV(i,j) i=1: %observed *
* i=2: %predicted *
* j=1-4 (helix,strand,loop,3-states) *
* gives the strict overlap *
* for L < 5: | L(OBS)-L(PRED) | <= 1 *
* .AND. shift by 1 allowed *
* for 5<=L<10: | L(OBS)-L(PRED) | <= 2 *
* .AND. shift by 2 allowed *
* for L >= 10: | L(OBS)-L(PRED) | <= 3 *
* .AND. shift by 3 allowed *
* multiplication with length of segment, normali- *
* sation will be done by calling SBR with N=number *
* of all residues in the data set *
* QSEGFOV(i,j) i=1: %observed *
* i=2: %predicted *
* j=1-4 (helix,strand,loop,3-states) *
* gives the fractional overlap: *
* overlapping length *
* as given by: ------------------ *
* common length *
* multiplication with length of segment, normali- *
* sation will be done by calling SBR with N=number *
* of all residues in the data set *
* LWRITE variable used, to call subroutines such that the *
* result they compute is written out (true) or not *
******------------------------------*-----------------------------******
C--------------------------------------------------
C---- initial check of variables passed -----
C--------------------------------------------------
IF (CHVPL.NE.2) THEN
WRITE(6,'(T2,A,T10,A)')'***',
+ 'WARNING: SEVALSEG: number of passed variables not fitting'
END IF
CHVPM(1)=CHVP1
CHVPM(2)=CHVP2
C ---------------
CALL SCHECKPASS(CHVPM,CHVPL,LERRCHVP)
C ---------------
IF (LERRCHVP .EQV. .TRUE.) THEN
WRITE(6,'(T2,A,T10,A)')'***',
+ 'ERROR for SEVALSEG: variables passed not correct !'
END IF
C---- check variables passed
IF (NUMRESLIB.GT.MAXNUMRES) THEN
WRITE(6,'(T5,A)')
+ ' The length of the protein passed to SBR SEVALSEG'
WRITE(6,'(T5,A)')
+ ' exceeds the locally allocated array dimensions.'
WRITE(6,'(T5,A,T25,I4,T30,A,T40,I4)')
+ ' Current length: ',NUMRESLIB,' allocated:',MAXNUMRES
WRITE(6,'(T5,A)')' Stopped in SEVALSEG 12-11-92:3'
STOP
END IF
IF (NSECELLIB.GT.MAXNSECEL) THEN
WRITE(6,'(T5,A)')
+ 'The number of secondary structures passed to SBR SEVALSEG'
WRITE(6,'(T5,A)')
+ 'exceeds the locally allocated array dimensions.'
WRITE(6,'(T5,A,T25,I4,T30,A,T40,I4)')
+ ' Current number: ',NSECELLIB,' allocated:',MAXNSECEL
WRITE(6,'(T5,A)')' Stopped in SEVALSEG 12-11-92:4'
STOP
END IF
C---- set zero
* CALL SISTZ2(NUMSEGOVERL,9,(MAXNSECEL+1))
DO ITSEC=1,(NSECELLIB+1)
DO MUE=1,9
NUMSEGOVERL(MUE,ITSEC)=0
END DO
END DO
C--------------------------------------------------
C---- assign secondary characters -----
C--------------------------------------------------
SSCHAR(1)='H'
SSCHAR(2)='E'
SSCHAR(NSECELLIB)='L'
IF (NSECELLIB.EQ.4) THEN
SSCHAR(3)='T'
ELSEIF (NSECELLIB.EQ.5) THEN
SSCHAR(3)='T'
SSCHAR(4)='S'
ELSEIF (NSECELLIB.GT.5) THEN
WRITE(6,'(T5,A)')
+ 'Caution: current version of SEVALSEG distinguishes'
WRITE(6,'(T5,A)')'only five different secondary structures!'
WRITE(6,'(T5,A)')'Stopped in SBR SEVALSEG: 12-11-92:5'
STOP
END IF
C---- to be on the save side: substitute potential blanks by 'L'
DO MUE=1,NUMRESLIB
LHELP=.TRUE.
DO ITSEC=1,(NSECELLIB-1)
IF (LHELP.AND.(PREDCHAR(MUE).EQ.SSCHAR(ITSEC))) THEN
LHELP=.FALSE.
END IF
END DO
IF (LHELP .EQV. .TRUE.) THEN
PREDCHAR(MUE)='L'
END IF
END DO
LWRITE=.FALSE.
IF (LWRITE .EQV. .TRUE.) THEN
WRITE(6,'(T2,A)')'---'
WRITE(6,'(T2,A,T10,A,T60,A7)')'---',
+ 'SEVALSEG: overlapping segments for: ',PROTNAME
END IF
C--------------------------------------------------
C---- storing begin and end of segments -----
C--------------------------------------------------
C----------------------------------------
C---- assign begin and ends for DSSP ----
C----------------------------------------
C ==============
CALL SSEGBEGIN(NUMRESLIB,MAXNUMRES,1,MAXSEG,DSSPCHAR,2,
+ BEGSEGDSSP,ENDSEGDSSP,3,LENSEGDSSP,COUNTSEG,3)
C ==============
C---- store separately number of helices, strands, turns, and loops
DO MUE=1,COUNTSEG
DO ITSEC=1,NSECELLIB
IF (DSSPCHAR(BEGSEGDSSP(MUE)).EQ.SSCHAR(ITSEC)) THEN
NUMSEGOVERL(1,ITSEC)=NUMSEGOVERL(1,ITSEC)+1
NUMSEGOVERL(2,ITSEC)=NUMSEGOVERL(2,ITSEC)+LENSEGDSSP(MUE)
END IF
END DO
END DO
NUMSEGOVERL(1,(NSECELLIB+1))=COUNTSEG
DO ITSEC=1,NSECELLIB
NUMSEGOVERL(2,(NSECELLIB+1))=NUMSEGOVERL(2,(NSECELLIB+1))
+ +NUMSEGOVERL(2,ITSEC)
END DO
C---- consistency check lengths
DO MUE=1,NUMSEGOVERL(1,(NSECELLIB+1))
IF (LENSEGDSSP(MUE).NE.
+ (ENDSEGDSSP(MUE)-BEGSEGDSSP(MUE))+1) THEN
WRITE(6,'(T2,A,T10,A,T50,I4)')'***',
+ 'SEVALSEG: fault for observed segment: ',MUE
END IF
END DO
C---- assign pointers
COUNTSEG=1
DO MUE=1,NUMRESLIB
POINTDSSP(MUE)=COUNTSEG
IF (MUE.EQ.ENDSEGDSSP(COUNTSEG)) THEN
COUNTSEG=COUNTSEG+1
END IF
END DO
C----------------------------------------
C---- assign begin and ends for PRED ----
C----------------------------------------
C ==============
CALL SSEGBEGIN(NUMRESLIB,MAXNUMRES,1,MAXSEG,PREDCHAR,2,
+ BEGSEGPRED,ENDSEGPRED,3,LENSEGPRED,COUNTSEG,3)
C ==============
C---- store separately number of helices, strands, turns, and loops
DO MUE=1,COUNTSEG
DO ITSEC=1,NSECELLIB
IF (PREDCHAR(BEGSEGPRED(MUE)).EQ.SSCHAR(ITSEC)) THEN
NUMSEGOVERL(3,ITSEC)=NUMSEGOVERL(3,ITSEC)+1
NUMSEGOVERL(4,ITSEC)=NUMSEGOVERL(4,ITSEC)+LENSEGPRED(MUE)
END IF
END DO
END DO
NUMSEGOVERL(3,(NSECELLIB+1))=COUNTSEG
DO ITSEC=1,NSECELLIB
NUMSEGOVERL(4,(NSECELLIB+1))=NUMSEGOVERL(4,(NSECELLIB+1))
+ +NUMSEGOVERL(4,ITSEC)
END DO
C---- consistency check: correctly counted?
DO MUE=1,NUMSEGOVERL(3,(NSECELLIB+1))
IF (LENSEGPRED(MUE).NE.
+ (ENDSEGPRED(MUE)-BEGSEGPRED(MUE))+1) THEN
WRITE(6,'(T2,A,T10,A,T50,I4)')'***',
+ 'SEVALSEG: fault for predicted segment: ',MUE
END IF
END DO
C---- assign pointers
COUNTSEG=1
DO MUE=1,NUMRESLIB
POINTPRED(MUE)=COUNTSEG
IF (MUE.EQ.ENDSEGPRED(COUNTSEG)) THEN
COUNTSEG=COUNTSEG+1
END IF
END DO
C--------------------------------------------------
C---- overlapp % observed and % predicted -----
C--------------------------------------------------
C =============
CALL SSEGLOV(NSECELLIB,MAXNSECEL,NUMRESLIB,MAXNUMRES,
+ MAXSEG,1,DSSPCHAR,PREDCHAR,2,LENSEGDSSP,LENSEGPRED,
+ BEGSEGDSSP,ENDSEGDSSP,BEGSEGPRED,ENDSEGPRED,3,
+ NUMSEGOVERL,QSEGLOV,3)
C =============
C--------------------------------------------------
C---- computing correct elements -----
C--------------------------------------------------
C ============
CALL SSEGSOV(NSECELLIB,MAXNSECEL,NUMRESLIB,MAXNUMRES,MAXSEG,1,
+ DSSPCHAR,PREDCHAR,SSCHAR,2,LENSEGDSSP,LENSEGPRED,
+ POINTDSSP,POINTPRED,BEGSEGDSSP,BEGSEGPRED,
+ 3,NUMCOR,NUMSEGOVERL(1,(NSECELLIB+1)),
+ NUMSEGOVERL(3,(NSECELLIB+1)),QSEGSOV,3)
C ============
DO ITSEC=1,NSECELLIB
NUMSEGOVERL(9,ITSEC)=NUMCOR(1,ITSEC)
END DO
DO ITSEC=1,NSECELLIB
NUMSEGOVERL(9,(NSECELLIB+1))=NUMSEGOVERL(9,(NSECELLIB+1))
+ +NUMSEGOVERL(9,ITSEC)
END DO
C--------------------------------------------------
C---- computing overlapping lengths quotients -----
C--------------------------------------------------
C =============
CALL SSEGFOV(NSECELLIB,MAXNSECEL,NUMRESLIB,MAXNUMRES,
+ MAXSEG,1,DSSPCHAR,PREDCHAR,SSCHAR,2,BEGSEGDSSP,
+ BEGSEGPRED,ENDSEGDSSP,ENDSEGPRED,POINTDSSP,POINTPRED,
+ 3,NUMSEGOVERL(1,(NSECELLIB+1)),NUMSEGOVERL(3,(NSECELLIB+1)),
+ COUNTSEGMAT,QSEGFOV,3,DEVNOM)
C =============
C--------------------------------------------------
C---- writing result onto printer -----
C--------------------------------------------------
C---- first: intermediately normalise the quotients
DO ITSEC=1,(NSECELLIB+1)
DO ITER=1,2
IF (NUMSEGOVERL(2*ITER,ITSEC).NE.0) THEN
QSEGLOV(ITER,ITSEC)=100*QSEGLOV(ITER,ITSEC)
+ /REAL(NUMSEGOVERL(2*ITER,ITSEC))
QSEGSOV(ITER,ITSEC)=100*QSEGSOV(ITER,ITSEC)
+ /REAL(NUMSEGOVERL(2*ITER,ITSEC))
QSEGFOV(ITER,ITSEC)=100*QSEGFOV(ITER,ITSEC)
+ /REAL(NUMSEGOVERL(2*ITER,ITSEC))
C------------- search a potential bug/artefact
IF (QSEGLOV(ITER,ITSEC).GT.100) THEN
QSEGLOV(ITER,ITSEC)=0
WRITE(6,'(T2,A,T10,A)')'***',
+ 'ERROR: in Sevalseg: QSEGLOV > 100%,'
WRITE(6,'(T2,A,T10,A,t25,i3,t30,a,t40,i3)')'***',
+ 'for iter=',iter,'itsec=',itsec
END IF
IF (QSEGSOV(ITER,ITSEC).GT.100) THEN
QSEGSOV(ITER,ITSEC)=0
WRITE(6,'(T2,A,T10,A)')'***',
+ 'ERROR: in Sevalseg: QSEGSOV > 100%,'
WRITE(6,'(T2,A,T10,A,t25,i3,t30,a,t40,i3)')'***',
+ 'for iter=',iter,'itsec=',itsec
END IF
IF (QSEGFOV(ITER,ITSEC).GT.100) THEN
QSEGFOV(ITER,ITSEC)=0
WRITE(6,'(T2,A,T10,A)')'***',
+ 'ERROR: in Sevalseg: QSEGFOV > 100%,'
WRITE(6,'(T2,A,T10,A,t25,i3,t30,a,t40,i3)')'***',
+ 'for iter=',iter,'itsec=',itsec
END IF
ELSE
QSEGLOV(ITER,ITSEC)=0
QSEGSOV(ITER,ITSEC)=0
QSEGFOV(ITER,ITSEC)=0
END IF
END DO
END DO
C---- writing result into file FILESEG (should be open!)
IF (LWRITEFILE .EQV. .TRUE.) THEN
C ==============
CALL STABLESEG(KSEG,NSECELLIB,MAXNSECEL,PROTNAME,NUMSEGOVERL,
+ QSEGLOV,QSEGSOV,QSEGFOV,DEVNOM)
C ==============
END IF
END
***** end of SEVALSEG
***** ------------------------------------------------------------------
***** SUB SEXP_NOINBIN_2VEC
***** ------------------------------------------------------------------
C----
C---- NAME : SEXP_NOINBIN_2VEC
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Mar, 1994 version 0.1 *
* changed: dd , 1994 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: Compares the two vectors of projected relative *
* -------- exposure (0-9) for observation and prediction *
* and returns the matrix of number in bins. *
* Definition:
* EXP_NOINBIN(i,j) = N means, for N residues the *
* exposure is: *
* observed in i (=> relative exposure = i*i /100), *
* predicted in j (=> relative exposure = j*j /100).*
* in variables: NUMRESMAX, NUMRES, DSSPBIN, PREDBIN, *
* out variables: EXP_NOINBIN *
* SBRs calling: from lib-unix.f: *
* -------------- SCHECKPASS *
*----------------------------------------------------------------------*
SUBROUTINE SEXP_NOINBIN_2VEC(NUMRESMAX,NUMRES,CHVP1,
+ DSSPBIN,CHVP2,PREDBIN,CHVP3,EXP_NOINBIN,CHVPL)
IMPLICIT NONE
C---- variables passed
INTEGER CHVPM(1:50),CHVPL,CHVP1,CHVP2,CHVP3,
+ NUMRESMAX,NUMRES,EXP_NOINBIN(0:9,0:9)
INTEGER*2 DSSPBIN(1:NUMRESMAX),PREDBIN(1:NUMRESMAX)
C---- local variables *
INTEGER MUE,IT1,IT2
LOGICAL LERRCHVP
******------------------------------*-----------------------------******
*--------------------- *
* passed variables *
*--------------------- *
* LWRITE variable used, to call subroutines such that the *
* result they compute is written out (true) or not *
*--------------------- *
* local variables *
*--------------------- *
* MUE,ITER serve as iteration variables *
******------------------------------*-----------------------------******
C---- defaults
C----------------------------------------------------------------------*
C---- initial check of variables passed -----*
C----------------------------------------------------------------------*
IF (CHVPL.NE.3) THEN
WRITE(6,'(T2,A,T10,A)')'***','WARNING: SEXP_NOINBIN_2VEC: '//
+ 'number of passed variables not fitting'
END IF
CHVPM(1)=CHVP1
CHVPM(2)=CHVP2
CHVPM(3)=CHVP3
C ---------------
CALL SCHECKPASS(CHVPM,CHVPL,LERRCHVP)
C ---------------
IF (LERRCHVP .EQV. .TRUE.) THEN
WRITE(6,'(T2,A,T10,A)')'***',
+ 'ERROR for FDUMMY: variables passed not correct !'
END IF
C----------------------------------------------------------------------*
C---- end of checking variables -----*
C----------------------------------------------------------------------*
C--------------------------------------------------
C----
C--------------------------------------------------
DO IT1=0,9
DO IT2=0,9
EXP_NOINBIN(IT2,IT1)=0
END DO
END DO
DO MUE=1,NUMRES
EXP_NOINBIN(DSSPBIN(MUE),PREDBIN(MUE))=
+ EXP_NOINBIN(DSSPBIN(MUE),PREDBIN(MUE))+1
END DO
END
***** end of SEXP_NOINBIN_2VEC
***** ------------------------------------------------------------------
***** SUB SEXP_NOINSTATES
***** ------------------------------------------------------------------
C----
C---- NAME : SEXP_NOINSTATES
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Nov, 1993 version 0.1 *
* changed: Dec, 1993 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: For a set of numbers of bins (obs,pred), the num-*
* -------- ber of correct ones is returned for three models:*
* 2states: 0-20, 20-100, e.g. 0-4, 5-9 *
* 3states: 0-5, 5-25, 25-100, e.g. 0-2, 3-5, 6-9 *
* 10 : per bin *
* in variables: EXP_NOINBIN, THRESH2, THRESH3A, THRESH3B *
* output variab.: EXP_NO2STATES, EXP_NO3STATES, EXP_NO10STATES *
* --------------- how often occurs: obs = n, pred = m, *
* note: 25 = sum *
*----------------------------------------------------------------------*
SUBROUTINE SEXP_NOINSTATES(EXP_NOINBIN,THRESH2,THRESH3A,
+ THRESH3B,CHVP1,
+ OBS_NO2STATES,OBS_NO3STATES,OBS_NO10STATES,CHVP2,
+ EXP_NO2STATES,EXP_NO3STATES,EXP_NO10STATES,CHVPL)
IMPLICIT NONE
C---- variables passed
INTEGER EXP_NO2STATES(1:3),EXP_NO3STATES(1:4),
+ EXP_NO10STATES(1:11),EXP_NOINBIN(0:9,0:9),
+ OBS_NO2STATES(1:3),OBS_NO3STATES(1:4),OBS_NO10STATES(1:11),
+ THRESH2,THRESH3A,THRESH3B,CHVPM(1:50),CHVPL,CHVP1,CHVP2
C---- local variables
INTEGER ICOUNT,IT1,IT2,ICOUNT2,ICOUNT3
LOGICAL LERRCHVP
******------------------------------*-----------------------------******
******------------------------------*-----------------------------******
C---- default
C----------------------------------------------------------------------*
C---- initial check of variables passed -----*
C----------------------------------------------------------------------*
IF (CHVPL.NE.2) THEN
WRITE(6,'(T2,A,T10,A)')'***','WARNING: SEXP_NOINSTATES: '//
+ 'number of passed variables not fitting'
WRITE(6,'(T2,A,T10,A,T40,4I5)')'***',
+ 'they are: CHVPL: 1,2,3:',CHVPL,CHVP1,CHVP2
STOP
END IF
CHVPM(1)=CHVP1
CHVPM(2)=CHVP2
C ---------------
CALL SCHECKPASS(CHVPM,CHVPL,LERRCHVP)
C ---------------
IF (LERRCHVP .EQV. .TRUE.) THEN
WRITE(6,'(T2,A,T10,A)')'***',
+ 'ERROR for SEXP_NOINSTATES: variables passed not correct !'
END IF
C---- check variables passed
C----------------------------------------------------------------------*
C---- end of checking variables -----*
C----------------------------------------------------------------------*
C--------------------------------------------------
C---- compute number of bins per AA: obs: n, pred m
C--------------------------------------------------
C---- 10 states
ICOUNT=0
ICOUNT2=0
DO IT1=0,9
ICOUNT3=0
DO IT2=0,9
ICOUNT3=ICOUNT3+EXP_NOINBIN(IT1,IT2)
END DO
ICOUNT2=ICOUNT2+ICOUNT3
OBS_NO10STATES(IT1+1)=ICOUNT3
ICOUNT=ICOUNT+EXP_NOINBIN(IT1,IT1)
EXP_NO10STATES(IT1+1)=EXP_NOINBIN(IT1,IT1)
END DO
EXP_NO10STATES(11)=ICOUNT
OBS_NO10STATES(11)=ICOUNT2
C---- 3 states
DO IT1=1,3
EXP_NO3STATES(IT1)=0
END DO
ICOUNT=0
ICOUNT2=0
DO IT1=0,(THRESH3A-1)
ICOUNT3=0
DO IT2=0,9
ICOUNT3=ICOUNT3+EXP_NOINBIN(IT1,IT2)
END DO
ICOUNT2=ICOUNT2+ICOUNT3
DO IT2=0,(THRESH3A-1)
ICOUNT=ICOUNT+EXP_NOINBIN(IT1,IT2)
EXP_NO3STATES(1)=EXP_NO3STATES(1)+EXP_NOINBIN(IT1,IT2)
END DO
END DO
OBS_NO3STATES(1)=ICOUNT2
ICOUNT2=0
DO IT1=THRESH3A,(THRESH3B-1)
ICOUNT3=0
DO IT2=0,9
ICOUNT3=ICOUNT3+EXP_NOINBIN(IT1,IT2)
END DO
ICOUNT2=ICOUNT2+ICOUNT3
DO IT2=THRESH3A,(THRESH3B-1)
ICOUNT=ICOUNT+EXP_NOINBIN(IT1,IT2)
EXP_NO3STATES(2)=EXP_NO3STATES(2)+EXP_NOINBIN(IT1,IT2)
END DO
END DO
OBS_NO3STATES(2)=ICOUNT2
ICOUNT2=0
DO IT1=THRESH3B,9
ICOUNT3=0
DO IT2=0,9
ICOUNT3=ICOUNT3+EXP_NOINBIN(IT1,IT2)
END DO
ICOUNT2=ICOUNT2+ICOUNT3
DO IT2=THRESH3B,9
ICOUNT=ICOUNT+EXP_NOINBIN(IT1,IT2)
EXP_NO3STATES(3)=EXP_NO3STATES(3)+EXP_NOINBIN(IT1,IT2)
END DO
END DO
OBS_NO3STATES(3)=ICOUNT2
EXP_NO3STATES(4)=ICOUNT
ICOUNT=0
DO IT1=1,3
ICOUNT=ICOUNT+OBS_NO3STATES(IT1)
END DO
OBS_NO3STATES(4)=ICOUNT
C---- 2 states
DO IT1=1,2
EXP_NO2STATES(IT1)=0
END DO
ICOUNT=0
ICOUNT2=0
DO IT1=0,(THRESH2-1)
ICOUNT3=0
DO IT2=0,9
ICOUNT3=ICOUNT3+EXP_NOINBIN(IT1,IT2)
END DO
ICOUNT2=ICOUNT2+ICOUNT3
DO IT2=0,(THRESH2-1)
ICOUNT=ICOUNT+EXP_NOINBIN(IT1,IT2)
EXP_NO2STATES(1)=EXP_NO2STATES(1)+EXP_NOINBIN(IT1,IT2)
END DO
END DO
OBS_NO2STATES(1)=ICOUNT2
ICOUNT2=0
DO IT1=THRESH2,9
ICOUNT3=0
DO IT2=0,9
ICOUNT3=ICOUNT3+EXP_NOINBIN(IT1,IT2)
END DO
ICOUNT2=ICOUNT2+ICOUNT3
DO IT2=THRESH2,9
ICOUNT=ICOUNT+EXP_NOINBIN(IT1,IT2)
EXP_NO2STATES(2)=EXP_NO2STATES(2)+EXP_NOINBIN(IT1,IT2)
END DO
END DO
OBS_NO2STATES(2)=ICOUNT2
EXP_NO2STATES(3)=ICOUNT
OBS_NO2STATES(3)=ICOUNT2+OBS_NO2STATES(1)
END
***** end of SEXP_NOINSTATES
***** ------------------------------------------------------------------
***** SUB SFILEOPEN
***** ------------------------------------------------------------------
C----
C---- NAME : SFILEOPEN
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Dec, 1991 version 0.1 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE SFILEOPEN(UNIT,FILENAME,ACTSTATUS,LENGTH,ACTTASK)
IMPLICIT NONE
C---- local function
INTEGER FILEN_STRING
C---- local variables
INTEGER UNIT,LENGTH,IEND
CHARACTER*(*) FILENAME,ACTSTATUS,ACTTASK
CHARACTER*222 CHFILE
******------------------------------*-----------------------------******
C purge blanks from file name
IEND=FILEN_STRING(FILENAME)
CHFILE(1:IEND)=FILENAME(1:IEND)
C---- hack br 2001-01: avoid trouble with LINUX
IF (ACTSTATUS(1:3).EQ.'OLD') THEN
OPEN(UNIT,FILE=CHFILE(1:IEND),STATUS='OLD')
ELSEIF (ACTSTATUS(1:3).EQ.'NEW') THEN
OPEN(UNIT,FILE=CHFILE(1:IEND),STATUS='NEW')
ELSE
OPEN(UNIT,FILE=CHFILE(1:IEND),STATUS='UNKNOWN')
END IF
C---- bullshit to avoid warnings
IF (ACTTASK.EQ.'XX') THEN
CONTINUE
END IF
IF (LENGTH.LT.1) THEN
CONTINUE
END IF
RETURN
END
***** end of SFILEOPEN
***** ------------------------------------------------------------------
***** SUB SILEN_STRING
***** ------------------------------------------------------------------
C----
C---- NAME : SILEN_STRING
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Feb, 1993 version 0.1 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: The length of a given character string is returned
* -------- resp. non-blank begin (ibeg) and end (iend) *
* input: STRING string of CHARACTER*222 *
* output: ibeg,iend *
*----------------------------------------------------------------------*
SUBROUTINE SILEN_STRING(STRING,IBEG,IEND)
C---- variables passing
CHARACTER*222 STRING
C---- local variables
INTEGER ICOUNT,ITER,IBEG,IEND
CHARACTER*222 HSTRING
LOGICAL LHELP
******------------------------------*-----------------------------******
C---- defaults
HSTRING=STRING
ICOUNT=0
LHELP=.TRUE.
DO ITER=1,80
IF (LHELP .EQV. .TRUE.) THEN
IF (HSTRING(ITER:ITER).NE.' ') THEN
IF (ICOUNT.EQ.0) THEN
IBEG=ITER
END IF
ICOUNT=ICOUNT+1
ELSE
IF (ICOUNT.NE.0) THEN
IEND=ITER-1
LHELP=.FALSE.
END IF
END IF
END IF
END DO
IF (ICOUNT.EQ.0) THEN
WRITE(6,'(T2,A,T10,A,A1,A,A1)')'***',
+ 'ERROR: Sbr SILEN_STRING: empty string:','|',STRING,'|'
END IF
END
***** end of SILEN_STRING
***** ------------------------------------------------------------------
***** SUB SINTTOCHAR
***** ------------------------------------------------------------------
C----
C---- NAME : SINTTOCHAR
C---- ARG : IINT,TXT
C---- DES : converts the integer (<100) to a textstring (1:3)
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Nov, 1992 version 0.1 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
C purpose: convertion of INTEGER IINT into a character (*3) *
C input variables:IINT *
C output: TXT *
*----------------------------------------------------------------------*
SUBROUTINE SINTTOCHAR(IINT,TXT)
INTEGER IINT
CHARACTER*3 TXT
************************************************************************
C---- warning
IF (IINT.GE.100) THEN
WRITE(6,'(T2,A,T10,A)')'***',
+ 'ERROR in SINTTOCHAR library lib-comp!'
WRITE(6,'(T2,A,T10,A)')'***',
+ 'The number to be converted must be < 100.'
END IF
C---- convert integer to character
IF (IINT.EQ.1) THEN
TXT=' 1'
ELSEIF (IINT.EQ.2) THEN
TXT=' 2'
ELSEIF (IINT.EQ.3) THEN
TXT=' 3'
ELSEIF (IINT.EQ.4) THEN
TXT=' 4'
ELSEIF (IINT.EQ.5) THEN
TXT=' 5'
ELSEIF (IINT.EQ.6) THEN
TXT=' 6'
ELSEIF (IINT.EQ.7) THEN
TXT=' 7'
ELSEIF (IINT.EQ.8) THEN
TXT=' 8'
ELSEIF (IINT.EQ.9) THEN
TXT=' 9'
ELSEIF (IINT.EQ.10) THEN
TXT=' 10'
ELSEIF (IINT.EQ.11) THEN
TXT=' 11'
ELSEIF (IINT.EQ.12) THEN
TXT=' 12'
ELSEIF (IINT.EQ.13) THEN
TXT=' 13'
ELSEIF (IINT.EQ.14) THEN
TXT=' 14'
ELSEIF (IINT.EQ.15) THEN
TXT=' 15'
ELSEIF (IINT.EQ.16) THEN
TXT=' 16'
ELSEIF (IINT.EQ.17) THEN
TXT=' 17'
ELSEIF (IINT.EQ.18) THEN
TXT=' 18'
ELSEIF (IINT.EQ.19) THEN
TXT=' 19'
ELSEIF (IINT.EQ.20) THEN
TXT=' 20'
ELSEIF (IINT.EQ.21) THEN
TXT=' 21'
ELSEIF (IINT.EQ.22) THEN
TXT=' 22'
ELSEIF (IINT.EQ.23) THEN
TXT=' 23'
ELSEIF (IINT.EQ.24) THEN
TXT=' 24'
ELSEIF (IINT.EQ.25) THEN
TXT=' 25'
ELSEIF (IINT.EQ.26) THEN
TXT=' 26'
ELSEIF (IINT.EQ.27) THEN
TXT=' 27'
ELSEIF (IINT.EQ.28) THEN
TXT=' 28'
ELSEIF (IINT.EQ.29) THEN
TXT=' 29'
ELSEIF (IINT.EQ.30) THEN
TXT=' 30'
ELSEIF (IINT.EQ.31) THEN
TXT=' 31'
ELSEIF (IINT.EQ.32) THEN
TXT=' 32'
ELSEIF (IINT.EQ.33) THEN
TXT=' 33'
ELSEIF (IINT.EQ.34) THEN
TXT=' 34'
ELSEIF (IINT.EQ.35) THEN
TXT=' 35'
ELSEIF (IINT.EQ.36) THEN
TXT=' 36'
ELSEIF (IINT.EQ.37) THEN
TXT=' 37'
ELSEIF (IINT.EQ.38) THEN
TXT=' 38'
ELSEIF (IINT.EQ.39) THEN
TXT=' 39'
ELSEIF (IINT.EQ.40) THEN
TXT=' 40'
ELSEIF (IINT.EQ.41) THEN
TXT=' 41'
ELSEIF (IINT.EQ.42) THEN
TXT=' 42'
ELSEIF (IINT.EQ.43) THEN
TXT=' 43'
ELSEIF (IINT.EQ.44) THEN
TXT=' 44'
ELSEIF (IINT.EQ.45) THEN
TXT=' 45'
ELSEIF (IINT.EQ.46) THEN
TXT=' 46'
ELSEIF (IINT.EQ.47) THEN
TXT=' 47'
ELSEIF (IINT.EQ.48) THEN
TXT=' 48'
ELSEIF (IINT.EQ.49) THEN
TXT=' 49'
ELSEIF (IINT.EQ.50) THEN
TXT=' 50'
ELSEIF (IINT.EQ.51) THEN
TXT=' 51'
ELSEIF (IINT.EQ.52) THEN
TXT=' 52'
ELSEIF (IINT.EQ.53) THEN
TXT=' 53'
ELSEIF (IINT.EQ.54) THEN
TXT=' 54'
ELSEIF (IINT.EQ.55) THEN
TXT=' 55'
ELSEIF (IINT.EQ.56) THEN
TXT=' 56'
ELSEIF (IINT.EQ.57) THEN
TXT=' 57'
ELSEIF (IINT.EQ.58) THEN
TXT=' 58'
ELSEIF (IINT.EQ.59) THEN
TXT=' 59'
ELSEIF (IINT.EQ.60) THEN
TXT=' 60'
ELSEIF (IINT.EQ.61) THEN
TXT=' 61'
ELSEIF (IINT.EQ.62) THEN
TXT=' 62'
ELSEIF (IINT.EQ.63) THEN
TXT=' 63'
ELSEIF (IINT.EQ.64) THEN
TXT=' 64'
ELSEIF (IINT.EQ.65) THEN
TXT=' 65'
ELSEIF (IINT.EQ.66) THEN
TXT=' 66'
ELSEIF (IINT.EQ.67) THEN
TXT=' 67'
ELSEIF (IINT.EQ.68) THEN
TXT=' 68'
ELSEIF (IINT.EQ.69) THEN
TXT=' 69'
ELSEIF (IINT.EQ.70) THEN
TXT=' 70'
ELSEIF (IINT.EQ.71) THEN
TXT=' 71'
ELSEIF (IINT.EQ.72) THEN
TXT=' 72'
ELSEIF (IINT.EQ.73) THEN
TXT=' 73'
ELSEIF (IINT.EQ.74) THEN
TXT=' 74'
ELSEIF (IINT.EQ.75) THEN
TXT=' 75'
ELSEIF (IINT.EQ.76) THEN
TXT=' 76'
ELSEIF (IINT.EQ.77) THEN
TXT=' 77'
ELSEIF (IINT.EQ.78) THEN
TXT=' 78'
ELSEIF (IINT.EQ.79) THEN
TXT=' 79'
ELSEIF (IINT.EQ.80) THEN
TXT=' 80'
ELSEIF (IINT.EQ.81) THEN
TXT=' 81'
ELSEIF (IINT.EQ.82) THEN
TXT=' 82'
ELSEIF (IINT.EQ.83) THEN
TXT=' 83'
ELSEIF (IINT.EQ.84) THEN
TXT=' 84'
ELSEIF (IINT.EQ.85) THEN
TXT=' 85'
ELSEIF (IINT.EQ.86) THEN
TXT=' 86'
ELSEIF (IINT.EQ.87) THEN
TXT=' 87'
ELSEIF (IINT.EQ.88) THEN
TXT=' 88'
ELSEIF (IINT.EQ.89) THEN
TXT=' 89'
ELSEIF (IINT.EQ.90) THEN
TXT=' 90'
ELSEIF (IINT.EQ.91) THEN
TXT=' 91'
ELSEIF (IINT.EQ.92) THEN
TXT=' 92'
ELSEIF (IINT.EQ.93) THEN
TXT=' 93'
ELSEIF (IINT.EQ.94) THEN
TXT=' 94'
ELSEIF (IINT.EQ.95) THEN
TXT=' 95'
ELSEIF (IINT.EQ.96) THEN
TXT=' 96'
ELSEIF (IINT.EQ.97) THEN
TXT=' 97'
ELSEIF (IINT.EQ.98) THEN
TXT=' 98'
ELSEIF (IINT.EQ.99) THEN
TXT=' 99'
END IF
END
***** end of SINTTOCHAR
***** ------------------------------------------------------------------
***** SUB SISTZ1
***** ------------------------------------------------------------------
C----
C---- NAME : SISTZ1
C---- ARG : IVEC,IROW
C---- DES : sets zero a 1-dimensional integer vector (IROW
C---- DES : elements)
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Apr, 1991 version 0.1 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
C purpose: an integer 1-dimensional vector IVEC (IROW) is *
C set to zero for all elements *
C input parameter: IROW *
C input variables: IVEC(integer vector) *
C output variables: IVEC=0 for all elements *
*----------------------------------------------------------------------*
SUBROUTINE SISTZ1(IVEC,IROW)
INTEGER IROW,ITER1
INTEGER IVEC(1:IROW)
DO ITER1=1,IROW
IVEC(ITER1)=0
END DO
END
***** end of SISTZ1
***** ------------------------------------------------------------------
***** SUB SISTZ2
***** ------------------------------------------------------------------
C----
C---- NAME : SISTZ2
C---- ARG : IMAT,IROW,ICOL
C---- DES : sets zero a 2-dimensional integer matrix(IROW,ICOL)
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Jun, 1991 version 0.1 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
C purpose: an integer 2-dimensional matrix IMAT (IROW,ICOL) *
C is set to zero for all elements *
C input parameter: IROW,ICOL *
C input variables: IMAT(integer matrix) *
C output variables: IMAT=0 for all elements *
*----------------------------------------------------------------------*
SUBROUTINE SISTZ2(IMAT,IROW,ICOL)
INTEGER IROW,ICOL,ITROW,ITCOL
INTEGER IMAT(1:IROW,1:ICOL)
DO ITCOL=1,ICOL
DO ITROW=1,IROW
IMAT(ITROW,ITCOL)=0
END DO
END DO
END
***** end of SISTZ2
***** ------------------------------------------------------------------
***** SUB SRMAX1
***** ------------------------------------------------------------------
C----
C---- NAME : SRMAX1
C---- ARG : RVEC,IROW,MAXVAL,MAXPOS
C---- DES : returns the maximal value of the components of the
C---- DES : real
C---- DES : vector RVEC(IROW) = MAXVAL, plus the position of that
C---- DES : value within the vector = MAXPOS
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1992 version 0.1 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
C purpose: computation of maximal value of the elements of *
C a real vector plus return of the position of that*
C value within the vector. *
C input parameter:IROW *
C input variables:RVEC *
C output: MAXVAL,MAXPOS *
*----------------------------------------------------------------------*
SUBROUTINE SRMAX1(RVEC,IROW,MAXVAL,MAXPOS)
INTEGER IROW,MAXPOS,ITER
REAL MAXVAL
REAL RVEC(1:IROW)
MAXVAL=RVEC(1)
MAXPOS=0
DO ITER=1,IROW
IF (MAXVAL.LE.RVEC(ITER)) THEN
MAXVAL=RVEC(ITER)
MAXPOS=ITER
END IF
END DO
C---- check whether one value regarded as maximum or not
IF ((MAXPOS.EQ.0).AND.(MAXVAL.NE.RVEC(1))) THEN
WRITE(6,'(T2,A)')'***'
WRITE(6,'(T2,A)')'***'
WRITE(6,'(T2,A,T10,A)')'***',
+ 'probably an ERROR in library SBR SRMAX1 detected.'
WRITE(6,'(T2,A,T10,A)')'***',
+ 'The subroutine is expected to compute the maximum of a'
WRITE(6,'(T2,A,T10,A)')'***',
+ 'vector but there seems to be none.'
WRITE(6,'(T2,A,T10,A,T45,I5,A)')'***',
+ 'Components are: (with IROW = ',IROW,')'
WRITE(6,'(T2,A,T10,20F5.2)')'***',
+ (RVEC(ITER),ITER=1,IROW)
WRITE(6,'(T2,A,T10,A,T45,F8.5)')'***',
+ 'Maximum is computed to be: ',MAXVAL
WRITE(6,'(T2,A)')'***'
WRITE(6,'(T2,A)')'***'
END IF
END
***** end of SRMAX1
***** ------------------------------------------------------------------
***** SUB SRSORTVEC
***** ------------------------------------------------------------------
C----
C---- NAME : SRSORTVEC
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: May, 1993 version 0.1 *
* changed: May, 1993 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: The components of the real vector VEC are sorted *
* -------- according to their seize. The succession is *
* returned in ISORT. *
* in variables: NROW,NROWMAX,VEC *
* out variables: ISORT *
*----------------------------------------------------------------------*
SUBROUTINE SRSORTVEC(NROW,NROWMAX,CHVP1,RVEC,CHVP2,ISORT,CHVPL)
IMPLICIT NONE
C---- variables passed
INTEGER CHVPM(1:2),CHVPL,CHVP1,CHVP2,
+ NROW,NROWMAX,ISORT(1:NROWMAX)
REAL RVEC(1:NROWMAX)
C---- local variables *
INTEGER ITER,ITER2,POSMAX
REAL HMAX
LOGICAL LERRCHVP,LFOUND(1:1000)
******------------------------------*-----------------------------******
C---- defaults
POSMAX= 0
IF (NROWMAX.GT.1000) THEN
WRITE(6,'(T2,A,T10,A,T50,I6)')'***',
+ 'ERROR in SRSORTVEC: watch out, NROWMAX =',NROWMAX
WRITE(6,'(T2,A,T10,A)')'***',
+ ' however, maximum for logicals LFOUND is 1000!'
END IF
C----------------------------------------------------------------------*
C---- initial check of variables passed -----*
C----------------------------------------------------------------------*
IF (CHVPL.NE.2) THEN
WRITE(6,'(T2,A,T10,A)')'***',
+ 'WARNING: SSEGFOV: number of passed variables not fitting'
END IF
CHVPM(1)=CHVP1
CHVPM(2)=CHVP2
C ---------------
CALL SCHECKPASS(CHVPM,CHVPL,LERRCHVP)
C CALL SCHECKPASS(LERRCHVP,CHVPL,CHVPM)
C ---------------
IF (LERRCHVP .EQV. .TRUE.) THEN
WRITE(6,'(T2,A,T10,A)')'***',
+ 'ERROR for : variables passed not correct !'
END IF
C---- check variables passed
C----------------------------------------------------------------------*
C---- end of checking variables -----*
C----------------------------------------------------------------------*
C---- initialize
DO ITER=1,NROW
LFOUND(ITER)=.FALSE.
END DO
C---- first sweep: look for maximum
HMAX=0
DO ITER=1,NROW
HMAX=MAX(HMAX,RVEC(ITER))
IF (HMAX.EQ.RVEC(ITER)) THEN
POSMAX=ITER
END IF
END DO
ISORT(1)=POSMAX
LFOUND(POSMAX)=.TRUE.
C---- now determine all the others
DO ITER=2,NROW
HMAX= 0
POSMAX=0
DO ITER2=1,NROW
IF (LFOUND(ITER2) .EQV. .FALSE. ) THEN
HMAX=MAX(HMAX,RVEC(ITER2))
IF (HMAX.EQ.RVEC(ITER2)) THEN
POSMAX=ITER2
END IF
END IF
END DO
IF (POSMAX .EQ. 0) THEN
WRITE(6,'(T2,A,T10,A,T60,I3)')'***',
+ 'ERROR: non found in SRSORTVEC for iter=',ITER
END IF
ISORT(ITER)=POSMAX
LFOUND(POSMAX)=.TRUE.
END DO
END
***** end of SRSORTVEC
***** ------------------------------------------------------------------
***** SUB SRSTZ1
***** ------------------------------------------------------------------
C----
C---- NAME : SRSTZ1
C---- ARG : RVECT,IROW
C---- DES : Sets zero a 1-dimens. real vector with the row-length
C---- DES : IROW
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Mar, 1991 version 0.1 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
C purpose: a real vector RVEC is set to zero *
C input parameter: IROW *
C input variables: RVEC(real vector) *
C output variables: RVEC=0. for all elements *
*----------------------------------------------------------------------*
SUBROUTINE SRSTZ1(RVEC,IROW)
REAL RVEC(1:IROW)
DO ITER1=1,IROW
RVEC(ITER1)=0.
END DO
END
***** end of SRSTZ1
***** ------------------------------------------------------------------
***** SUB SRSTZ2
***** ------------------------------------------------------------------
C----
C---- NAME : SRSTZ2
C---- ARG : RMAT,IROW,ICOL
C---- DES : Sets zero a 2-dimensional real matrix with the
C---- DES : row-length
C---- DES : IROW, the column-length ICOL :RMAT(IROW,ICOL)
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Mar, 1991 version 0.1 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
C purpose: a real two dimensional matrix RMAT(rows,columns) is set *
C to zero *
C input parameter: IROW,ICOL *
C input variables: RMAT(real matrix) *
C output variables: RMAT=0. for all elements *
*----------------------------------------------------------------------*
SUBROUTINE SRSTZ2(RMAT,IROW,ICOL)
REAL RMAT(1:IROW,1:ICOL)
DO ITER2=1,ICOL
DO ITER1=1,IROW
RMAT(ITER1,ITER2)=0.
END DO
END DO
END
***** end of SRSTZ2
***** ------------------------------------------------------------------
***** SUB SSEGBEGIN
***** ------------------------------------------------------------------
C----
C---- NAME : SSEGBEGIN
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Nov, 1992 version 0.1 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
C purpose: The begins and ends of the segments are found. *
C input variables:NSECELLIB, MAXNSECEL, NUMRESLIB, MAXNUMRES *
C ----------------RESCHAR, *
C output variab.: BEG, END, LEN, COUNTSEG *
C called by: SEVALSEG (in lib-prot.f) *
C SBRs calling: from lib-unix.f: *
C SCHECKPASS *
*----------------------------------------------------------------------*
SUBROUTINE SSEGBEGIN(NUMRESLIB,MAXNUMRES,
+ CHVP1,MAXSEG,RESCHAR,CHVP2,BEG,END,CHVP3,LEN,
+ COUNTSEG,CHVPL)
IMPLICIT NONE
C---- variables passed
INTEGER MAXNUMRES,NUMRESLIB,MAXSEG,
+ BEG(1:MAXSEG),END(1:MAXSEG),LEN(1:MAXSEG),
+ CHVPL,CHVP1,CHVP2,CHVP3
CHARACTER*1 RESCHAR(1:MAXNUMRES)
C---- local variables *
INTEGER MUE,COUNTRES,COUNTSEG
INTEGER CHVPM(1:50)
LOGICAL LERRCHVP
CHARACTER*1 CURSTR
CURSTR= CHAR(0)
COUNTRES= 0
******------------------------------*-----------------------------******
C MUE,ITER serve as iteration variables *
******------------------------------*-----------------------------******
C---- CHeck passed parameter
IF (CHVPL.NE.3) THEN
WRITE(6,'(T2,A,T10,A)')'***',
+ 'WARNING: SSEGBEGIN: number of passed variables not fitting'
END IF
CHVPM(1)=CHVP1
CHVPM(2)=CHVP2
CHVPM(3)=CHVP3
C ---------------
CALL SCHECKPASS(CHVPM,CHVPL,LERRCHVP)
C ---------------
IF (LERRCHVP .EQV. .TRUE.) THEN
WRITE(6,'(T2,A,T10,A)')'***',
+ 'ERROR for SSEGBEGIN: variables passed not correct !'
END IF
C--------------------------------------------------
C---- storing begin and end of segments -----
C--------------------------------------------------
C---- assign begin and ends for RES
DO MUE=1,NUMRESLIB
IF (MUE.EQ.1) THEN
CURSTR=RESCHAR(1)
BEG(1)=1
COUNTSEG=1
COUNTRES=1
ELSEIF ((MUE.EQ.NUMRESLIB).AND.(RESCHAR(MUE).EQ.CURSTR)) THEN
END(COUNTSEG)=MUE
LEN(COUNTSEG)=COUNTRES+1
ELSEIF ((MUE.EQ.NUMRESLIB).AND.(RESCHAR(MUE).NE.CURSTR)) THEN
END(COUNTSEG)=MUE-1
LEN(COUNTSEG)=COUNTRES
COUNTSEG=COUNTSEG+1
BEG(COUNTSEG)=MUE
END(COUNTSEG)=MUE
LEN(COUNTSEG)=1
ELSEIF (RESCHAR(MUE).EQ.CURSTR) THEN
COUNTRES=COUNTRES+1
ELSE
END(COUNTSEG)=MUE-1
LEN(COUNTSEG)=COUNTRES
COUNTRES=1
CURSTR=RESCHAR(MUE)
COUNTSEG=COUNTSEG+1
BEG(COUNTSEG)=MUE
END IF
END DO
END
***** end of SSEGBEGIN
***** ------------------------------------------------------------------
***** SUB SSEGFOV
***** ------------------------------------------------------------------
C----
C---- NAME : SSEGFOV
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Nov, 1992 version 0.1 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: The quotient of overlapping/ summed length is *
* -------- computed. *
* input variables:NSECELLIB,MAXNSECEL,NUMRESLIB,MAXNUMRES, *
* ----------------DSSPCHAR,PREDCHAR,SSCHAR, *
* BEGSEGDSSP,BEGSEGPRED,ENDSEGDSSP,ENDSEGPRED, *
* POINTDSSP,POINTPRED,NUMSEGDSSP,NUMSEGPRED, *
* output variab.: QSEGAVOV *
* called by: SEVALSEG (in lib-prot.f) *
* SBRs calling: from lib-comp.f: *
* -------------- SISTZ1, SRSTZ2 *
* from lib-unix.f: *
* SCHECKPASS *
* procedure: If two segments overlap (predict and observed) *
* ---------- the quotient of overlapping segment score is given
* by: *
* number of overlapping residues *
* QSEGAVOV(i)= ------------------------------ *
* end (max) - begin (min) *
* where max= maximum (end(pred),end(obs)) *
* min= minimum (beg(pred),beg(obs)) *
*----------------------------------------------------------------------*
SUBROUTINE SSEGFOV(NSECELLIB,MAXNSECEL,NUMRESLIB,MAXNUMRES,
+ MAXSEGPASS,CHVP1,DSSPCHAR,PREDCHAR,SSCHAR,CHVP2,
+ BEGSEGDSSP,BEGSEGPRED,ENDSEGDSSP,ENDSEGPRED,POINTDSSP,
+ POINTPRED,CHVP3,NUMSEGDSSP,NUMSEGPRED,COUNTSEG,
+ QSEGFOV,CHVPL,DEVNOM)
IMPLICIT NONE
C---- variables passed
INTEGER MAXNSECEL,NSECELLIB,MAXNUMRES,NUMRESLIB,DEVNOM,
+ MAXSEGPASS,CHVPM(1:50),CHVPL,CHVP1,CHVP2,CHVP3,
+ COUNTSEG(1:2,1:(MAXNSECEL+1)),NUMSEGDSSP,NUMSEGPRED,
+ POINTPRED(1:MAXNUMRES),POINTDSSP(1:MAXNUMRES),
+ BEGSEGDSSP(1:MAXSEGPASS),BEGSEGPRED(1:MAXSEGPASS),
+ ENDSEGDSSP(1:MAXSEGPASS),ENDSEGPRED(1:MAXSEGPASS)
REAL QSEGFOV(1:2,1:(MAXNSECEL+1))
CHARACTER*1 DSSPCHAR(1:MAXNUMRES),PREDCHAR(1:MAXNUMRES)
CHARACTER*1 SSCHAR(1:8)
C---- local variables *
INTEGER MUE,ITSEC,ITER,ITSEG,IHELP,BEGMUE,MUEFOUND,
+ IMAXOV,IMINOV,INTERCOUNTSEG,MAXDEV
LOGICAL LERRCHVP,LOVER
* CHARACTER*10 TXT1(1:5)
******------------------------------*-----------------------------******
* MUE,ITER serve as iteration variables *
* DEVNOM allowed deviation in nominator : *
* overlapping length + DEVNOM *
* as given by: --------------------------- *
* common length *
* IMINOV =minimal overlapping length (minimal region *
* spanned by both strings) *
* IMAXOV =maximal overlapping length (maximal region *
* spanned by either of the two) *
* QSEGFOV(i,j) i=1: %observed *
* i=2: %predicted *
* j=1-4 (helix,strand,loop,3-states) *
* gives the fractional overlap: *
* overlapping length *
* as given by: ------------------ *
* common length *
* multiplication with length of segment, normali- *
* sation will be done by calling SBR with N=number *
* of all residues in the data set *
* LWRITE variable used, to call subroutines such that the *
* result they compute is written out (true) or not *
******------------------------------*-----------------------------******
C---- defaults
MUEFOUND= 0
C----------------------------------------------------------------------*
C---- initial check of variables passed -----*
C----------------------------------------------------------------------*
IF (CHVPL.NE.3) THEN
WRITE(6,'(T2,A,T10,A)')'***',
+ 'WARNING: SSEGFOV: number of passed variables not fitting'
END IF
CHVPM(1)=CHVP1
CHVPM(2)=CHVP2
CHVPM(3)=CHVP3
C ---------------
CALL SCHECKPASS(CHVPM,CHVPL,LERRCHVP)
C ---------------
IF (LERRCHVP .EQV. .TRUE.) THEN
WRITE(6,'(T2,A,T10,A)')'***',
+ 'ERROR for SSEGFOV: variables passed not correct !'
END IF
C---- check variables passed
IF (NUMRESLIB.GT.MAXNUMRES) THEN
WRITE(6,'(T5,A)')
+ ' The length of the protein passed to SBR SSEGFOV'
WRITE(6,'(T5,A)')
+ ' exceeds the locally allocated array dimensions.'
WRITE(6,'(T5,A,T25,I4,T30,A,T50,I4)')
+ ' Current length: ',NUMRESLIB,' allocated:',MAXNUMRES
WRITE(6,'(T5,A)')' Stopped in SSEGFOV 12-2-92:1'
STOP
END IF
IF (NSECELLIB.GT.MAXNSECEL) THEN
WRITE(6,'(T5,A)')
+ 'The number of secondary structures passed to SBR SSEGFOV'
WRITE(6,'(T5,A)')
+ 'exceeds the locally allocated array dimensions.'
WRITE(6,'(T5,A,T25,I4,T30,A,T40,I4)')
+ ' Current number: ',NSECELLIB,' allocated:',MAXNSECEL
WRITE(6,'(T5,A)')' Stopped in SSEGFOV 12-11-92:2'
STOP
END IF
C----------------------------------------------------------------------*
C---- end of checking variables -----*
C----------------------------------------------------------------------*
C--------------------------------------------------
C---- computing overlapping lengths %obs -----
C--------------------------------------------------
C---- set zero
C -----------
CALL SISTZ2(COUNTSEG,2,(MAXNSECEL+1))
C -----------
CALL SRSTZ2(QSEGFOV,2,(MAXNSECEL+1))
C -----------
DO MUE=1,NUMSEGDSSP
BEGMUE=BEGSEGDSSP(MUE)
LOVER=.FALSE.
DO ITSEC=1,NSECELLIB
IF ((LOVER .EQV. .FALSE.).AND.
+ (DSSPCHAR(BEGMUE).EQ.SSCHAR(ITSEC))) THEN
C------------- search for closest segment predicted
IF (DSSPCHAR(BEGMUE).EQ.PREDCHAR(BEGMUE)) THEN
LOVER=.TRUE.
MUEFOUND=BEGMUE
ELSE
DO ITSEG=1,(ENDSEGDSSP(MUE)-BEGSEGDSSP(MUE))
IF ((LOVER .EQV. .FALSE.) .AND.
+ (DSSPCHAR(BEGMUE+ITSEG)) .EQ.
+ PREDCHAR(BEGMUE+ITSEG)) THEN
LOVER=.TRUE.
MUEFOUND=BEGMUE+ITSEG
END IF
END DO
END IF
IF (LOVER .EQV. .TRUE.) THEN
IHELP=POINTPRED(MUEFOUND)
IMINOV=
+ (-MAX(BEGSEGDSSP(MUE),BEGSEGPRED(IHELP))
+ +MIN(ENDSEGDSSP(MUE),ENDSEGPRED(IHELP))+1)
IMAXOV=
+ (-MIN(BEGSEGDSSP(MUE),BEGSEGPRED(IHELP))
+ +MAX(ENDSEGDSSP(MUE),ENDSEGPRED(IHELP))+1)
C---------------- allow deviation
IF (DEVNOM.EQ.50) THEN
MAXDEV=MIN(IMINOV,
+ INT((ENDSEGDSSP(MUE)-BEGSEGDSSP(MUE)+1)/2.))
ELSEIF (DEVNOM.EQ.100) THEN
MAXDEV=MIN(IMINOV,
+ (ENDSEGDSSP(MUE)-BEGSEGDSSP(MUE)+1))
ELSE
MAXDEV=MIN(IMINOV,DEVNOM)
END IF
DO ITER=1,MAXDEV
IF (IMAXOV.GT.IMINOV) THEN
IMINOV=IMINOV+1
END IF
END DO
C----------------
COUNTSEG(1,ITSEC)=COUNTSEG(1,ITSEC)+1
IF (IMAXOV.GT.0) THEN
QSEGFOV(1,ITSEC)=QSEGFOV(1,ITSEC)
+ +IMINOV/REAL(IMAXOV)
+ *(ENDSEGDSSP(MUE)-BEGSEGDSSP(MUE)+1)
ELSE
WRITE(6,'(T2,A,T10,A,T50,I3)')'***',
+ 'ERROR in SSEGFOV: length=0 for',IMAXOV
WRITE(6,'(T2,A,T10,A,T40,I4,A,T60,A1)')'***',
+ 'for obs seg:',MUE,' which is a: ',
+ SSCHAR(ITSEC)
END IF
ELSE
COUNTSEG(1,ITSEC)=COUNTSEG(1,ITSEC)+1
END IF
END IF
END DO
C------- end of computation for H, E, T
END DO
C---- end of loop over observed segments
C---- normalize with number of respective segments
QSEGFOV(1,(NSECELLIB+1))=0.
INTERCOUNTSEG=0
DO ITSEC=1,NSECELLIB
IF (COUNTSEG(1,ITSEC).NE.0) THEN
QSEGFOV(1,(NSECELLIB+1))=QSEGFOV(1,(NSECELLIB+1))
+ +QSEGFOV(1,ITSEC)
INTERCOUNTSEG=INTERCOUNTSEG+COUNTSEG(1,ITSEC)
C--------------------------------------------------
C---- out now, since normalisation with number of residues
C QSEGFOV(1,ITSEC)=QSEGFOV(1,ITSEC)/REAL(COUNTSEG(1,ITSEC))
C--------------------------------------------------
END IF
END DO
COUNTSEG(1,(NSECELLIB+1))=INTERCOUNTSEG
C--------------------------------------------------
C---- out now, since normalisation with number of residues
C QSEGFOV(1,(NSECELLIB+1))=
C + QSEGFOV(1,(NSECELLIB+1))/REAL(INTERCOUNTSEG)
C--------------------------------------------------
C write(6,*)'x.x lib-x.f'
C write(6,*)'dssp'
C write(6,'(60A1)')(dsspchar(mue),mue=1,numreslib)
C write(6,*)'pred'
C write(6,'(60A1)')(predchar(mue),mue=1,numreslib)
C write(6,'(A,T20,4I5)')'countseg = ',(countseg(1,iter),iter=1,4)
C write(6,'(A,T20,4I5)')'fov=',(int(100*qSEGFOV(1,iter)),iter=1,4)
C---- end computing overlapping lengths %obs -----
C--------------------------------------------------
C--------------------------------------------------
C---- computing overlapping lengths %pred -----
C--------------------------------------------------
DO MUE=1,NUMSEGPRED
BEGMUE=BEGSEGPRED(MUE)
LOVER=.FALSE.
DO ITSEC=1,NSECELLIB
IF ((LOVER .EQV. .FALSE.).AND.
+ (PREDCHAR(BEGMUE).EQ.SSCHAR(ITSEC))) THEN
IF (PREDCHAR(BEGMUE).EQ.DSSPCHAR(BEGMUE)) THEN
LOVER=.TRUE.
MUEFOUND=BEGMUE
ELSE
DO ITSEG=1,(ENDSEGPRED(MUE)-BEGSEGPRED(MUE))
IF ((LOVER .EQV. .FALSE.).AND.
+ (PREDCHAR(BEGMUE+ITSEG).EQ.
+ DSSPCHAR(BEGMUE+ITSEG))) THEN
LOVER=.TRUE.
MUEFOUND=BEGMUE+ITSEG
END IF
END DO
END IF
IF (LOVER .EQV. .TRUE.) THEN
IHELP=POINTDSSP(MUEFOUND)
IMINOV=
+ (-MAX(BEGSEGPRED(MUE),BEGSEGDSSP(IHELP))
+ +MIN(ENDSEGPRED(MUE),ENDSEGDSSP(IHELP))+1)
IMAXOV=
+ (-MIN(BEGSEGPRED(MUE),BEGSEGDSSP(IHELP))
+ +MAX(ENDSEGPRED(MUE),ENDSEGDSSP(IHELP))+1)
C---------------- allow deviation
IF (DEVNOM.EQ.50) THEN
MAXDEV=MIN(IMINOV,
+ INT((ENDSEGPRED(MUE)-BEGSEGPRED(MUE)+1)/2.))
ELSEIF (DEVNOM.EQ.100) THEN
MAXDEV=MIN(IMINOV,
+ (ENDSEGPRED(MUE)-BEGSEGPRED(MUE)+1))
ELSE
MAXDEV=MIN(IMINOV,DEVNOM)
END IF
DO ITER=1,MAXDEV
IF (IMAXOV.GT.IMINOV) THEN
IMINOV=IMINOV+1
END IF
END DO
C----------------
COUNTSEG(2,ITSEC)=COUNTSEG(2,ITSEC)+1
IF (IMAXOV.GT.0) THEN
QSEGFOV(2,ITSEC)=QSEGFOV(2,ITSEC)
+ +IMINOV/REAL(IMAXOV)
+ *(ENDSEGPRED(MUE)-BEGSEGPRED(MUE)+1)
ELSE
WRITE(6,'(T2,A,T10,A,T50,I3)')'***',
+ 'ERROR in SSEGFOV: length=0 for',IMAXOV
WRITE(6,'(T2,A,T10,A,T40,I4,A,T60,A1)')'***',
+ 'for obs seg:',MUE,' which is a: ',
+ SSCHAR(ITSEC)
END IF
ELSE
COUNTSEG(2,ITSEC)=COUNTSEG(2,ITSEC)+1
END IF
END IF
END DO
C------- end of computation for H, E, T
END DO
C---- end of loop over observed segments
C---- normalize with number of respective segments
QSEGFOV(2,(NSECELLIB+1))=0.
INTERCOUNTSEG=0
DO ITSEC=1,NSECELLIB
IF (COUNTSEG(2,ITSEC).NE.0) THEN
QSEGFOV(2,(NSECELLIB+1))=QSEGFOV(2,(NSECELLIB+1))
+ +QSEGFOV(2,ITSEC)
INTERCOUNTSEG=INTERCOUNTSEG+COUNTSEG(2,ITSEC)
C--------------------------------------------------
C---- out now, since normalisation with number of residues
C QSEGFOV(2,ITSEC)=QSEGFOV(2,ITSEC)/REAL(COUNTSEG(2,ITSEC))
C--------------------------------------------------
END IF
END DO
COUNTSEG(2,(NSECELLIB+1))=INTERCOUNTSEG
C--------------------------------------------------
C---- out now, since normalisation with number of residues
C QSEGFOV(2,(NSECELLIB+1))=
C + QSEGFOV(2,(NSECELLIB+1))/REAL(INTERCOUNTSEG)
C--------------------------------------------------
C---- end computing overlapping lengths %obs -----
C--------------------------------------------------
END
***** end of SSEGFOV
***** ------------------------------------------------------------------
***** SUB SSEGLOV
***** ------------------------------------------------------------------
C----
C---- NAME : SSEGLOV
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Nov, 1992 version 0.1 *
* changed: Mar, 1993 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: The measures related to segments are computed. *
* input variables:NSECELLIB,MAXNSECEL,NUMRESLIB,MAXNUMRES *
* ----------------DSSPCHAR,PREDCHAR *
* output variab.: NUMSEGOVERL *
* called by: SEVALPRED (in lib-prot.f) *
* SBRs calling: from lib-comp.f: *
* -------------- SISTZ1, *
* from lib-unix.f: *
* SCHECKPASS *
* from lib-prot.f: *
* SSEGBEGIN, STABLESEG *
* procedure: overlapp NUMSEGOVERL(3/4,ITSEC) ,3=%OBS, 4=%PRED *
* ---------- for H, E, T *
* if overlapp > L/2 *
* for L: *
* if overlapp > 2 *
* correct: NUMSEGOVERL(5,ITSEC) *
* for L < 5: | L(OBS)-L(PRED) | <= 1 *
* .AND. shift by 1 allowed *
* for 5<=L<10: | L(OBS)-L(PRED) | <= 2 *
* .AND. shift by 2 allowed *
* for L >= 10: | L(OBS)-L(PRED) | <= 3 *
* .AND. shift by 3 allowed *
*----------------------------------------------------------------------*
SUBROUTINE SSEGLOV(NSECELLIB,MAXNSECEL,NUMRESLIB,MAXNUMRES,
+ MAXSEGPASS,CHVP1,DSSPCHAR,PREDCHAR,CHVP2,LENSEGDSSP,
+ LENSEGPRED,BEGSEGDSSP,ENDSEGDSSP,BEGSEGPRED,ENDSEGPRED,
+ CHVP3,NUMSEGOVERL,QSEGLOV,CHVPL)
IMPLICIT NONE
C---- variables passed
INTEGER MAXNSECEL,NSECELLIB,MAXNUMRES,NUMRESLIB,MAXSEGPASS,
+ CHVPM(1:50),CHVPL,CHVP1,CHVP2,CHVP3,
+ NUMSEGOVERL(1:9,1:(MAXNSECEL+1)),
+ BEGSEGDSSP(1:MAXSEGPASS),ENDSEGDSSP(1:MAXSEGPASS),
+ LENSEGDSSP(1:MAXSEGPASS),LENSEGPRED(1:MAXSEGPASS),
+ BEGSEGPRED(1:MAXSEGPASS),ENDSEGPRED(1:MAXSEGPASS)
REAL QSEGLOV(1:2,1:(MAXNSECEL+1))
CHARACTER*1 DSSPCHAR(1:MAXNUMRES),PREDCHAR(1:MAXNUMRES)
C---- local variables *
INTEGER MUE,ITSEC,ITOVER,ITER,IHELP,BEGMUE,ENDMUE
LOGICAL LERRCHVP,LOVER
******------------------------------*-----------------------------******
* MUE,ITER serve as iteration variables *
* NUMSEGOVERL(i,j) number of overlapping/correct segments *
* i=1 number of DSSP segments in secondary structure *
* j, for last: sum over all *
* i=2 number of residues in structure i, summed up over*
* all segments (in i=1) *
* i=3 number of predicted segments in class j *
* i=4 number of residues in structure i, summed up over*
* all segments (in i=1) for the prediction *
* i=5 number of overlapping predicted segments related *
* to those being observed. Correct means: *
* overlap >= length of segment / 2, for H, E, T *
* and for loop: at least loop of 2, resp 1, if the*
* DSSP loop is 1. *
* i=6 number of overlapping segments multiplied by *
* length: related to %observed *
* i=7 same as 5, but other way round: %pred! *
* i=8 same as 6, but other way round: %pred! *
* j, for last: sum over all *
* i=9 number of correct segments: *
* L +/- 1, and shift by 1, if L<=5 *
* L +/- 1, and shift by 2, if 510 *
* noted: j, for last: sum over all *
* QSEGLOV(i,j) i=1: %observed *
* i=2: %predicted *
* j=1-4 (helix,strand,loop,3-states) *
* gives the loose overlap (half length overlap) *
* multiplication with length of segment, normali- *
* sation will be done by calling SBR with N=number *
* of all residues in the data set *
* LWRITE variable used, to call subroutines such that the *
* result they compute is written out (true) or not *
******------------------------------*-----------------------------******
C---- initial check of variables passed
IF (CHVPL.NE.3) THEN
WRITE(6,'(T2,A,T10,A)')'***',
+ 'WARNING: SSEGLOV: number of passed variables not fitting'
END IF
CHVPM(1)=CHVP1
CHVPM(2)=CHVP2
CHVPM(3)=CHVP3
C ---------------
CALL SCHECKPASS(CHVPM,CHVPL,LERRCHVP)
C ---------------
IF (LERRCHVP .EQV. .TRUE.) THEN
WRITE(6,'(T2,A,T10,A)')'***',
+ 'ERROR for SSEGLOV: variables passed not correct !'
END IF
C---- check variables passed
IF (NUMRESLIB.GT.MAXNUMRES) THEN
WRITE(6,'(T5,A)')
+ ' The length of the protein passed to SBR SSEGLOV'
WRITE(6,'(T5,A)')
+ ' exceeds the locally allocated array dimensions.'
WRITE(6,'(T5,A,T25,I4,T30,A,T40,I4)')
+ ' Current length: ',NUMRESLIB,' allocated:',MAXNUMRES
WRITE(6,'(T5,A)')' Stopped in SSEGLOV 12-11-92:3'
STOP
END IF
IF (NSECELLIB.GT.MAXNSECEL) THEN
WRITE(6,'(T5,A)')
+ 'The number of secondary structures passed to SBR SSEGLOV'
WRITE(6,'(T5,A)')
+ 'exceeds the locally allocated array dimensions.'
WRITE(6,'(T5,A,T25,I4,T30,A,T40,I4)')
+ ' Current number: ',NSECELLIB,' allocated:',MAXNSECEL
WRITE(6,'(T5,A)')' Stopped in SSEGLOV 12-11-92:4'
STOP
END IF
C---- set zero
C -----------
CALL SRSTZ2(QSEGLOV,2,(MAXNSECEL+1))
C -----------
DO ITER=1,4
DO ITSEC=1,(NSECELLIB+1)
NUMSEGOVERL((4+ITER),ITSEC)=0
END DO
END DO
C--------------------------------------------------
C---- overlapp % observed -----
C--------------------------------------------------
DO MUE=1,NUMSEGOVERL(1,(NSECELLIB+1))
BEGMUE=BEGSEGDSSP(MUE)
ENDMUE=ENDSEGDSSP(MUE)
C----------------------------------------
C------- helix, strand, turn --------
C----------------------------------------
IF ((DSSPCHAR(BEGMUE).EQ.'H').OR.(DSSPCHAR(BEGMUE).EQ.'E').OR.
+ (DSSPCHAR(BEGMUE).EQ.'T')) THEN
LOVER=.TRUE.
IF (INT(LENSEGDSSP(MUE)).LT.2) THEN
WRITE(6,'(T2,A,T10,A,T40,A1,A,T60,I3)')'***',
+ 'segment too short for:',DSSPCHAR(MUE),
+ 'seg no:',MUE
LOVER=.FALSE.
ELSEIF (INT(LENSEGDSSP(MUE)).GT.NUMRESLIB) THEN
WRITE(6,'(T2,A,T10,A,T40,A1,A,T60,I3)')'***',
+ 'segment too long for:',DSSPCHAR(MUE),
+ 'seg no:',MUE
LOVER=.FALSE.
ELSE
C------------- overlapp with N-terminal end of segment?
DO ITOVER=1,INT(LENSEGDSSP(MUE)/2.)
IHELP=BEGMUE+ITOVER-1
IF (LOVER.AND.
+ (PREDCHAR(IHELP).NE.DSSPCHAR(IHELP))) THEN
LOVER=.FALSE.
C------------------- allow H H -> HHH
IF ((IHELP.GT.1).AND.(IHELP.LT.NUMRESLIB)) THEN
IF ((PREDCHAR(IHELP-1).EQ.DSSPCHAR(IHELP)).AND.
+ (PREDCHAR(IHELP+1).EQ.DSSPCHAR(IHELP))) THEN
LOVER=.TRUE.
END IF
END IF
END IF
END DO
END IF
C---------- overlapp with C-terminal end of segment?
IF ((LOVER.EQV. .FALSE.).AND.(LENSEGDSSP(MUE).GT.2).AND.
+ (LENSEGDSSP(MUE).LT.NUMRESLIB)) THEN
LOVER=.TRUE.
DO ITOVER=1,INT(LENSEGDSSP(MUE)/2.)
IHELP=ENDMUE-INT(LENSEGDSSP(MUE)/2.)+ITOVER-1
IF (IHELP.LT.0) THEN
LOVER=.FALSE.
ELSE IF (LOVER.EQV. .TRUE. .AND.(PREDCHAR(IHELP).NE.
+ DSSPCHAR(IHELP))) THEN
LOVER=.FALSE.
C------------------- allow H H -> HHH
IF ((IHELP.GT.1).AND.(IHELP.LT.NUMRESLIB)) THEN
IF ((PREDCHAR(IHELP-1).EQ.DSSPCHAR(IHELP)).AND.
+ (PREDCHAR(IHELP+1).EQ.DSSPCHAR(IHELP))) THEN
LOVER=.TRUE.
END IF
END IF
END IF
END DO
END IF
C---------- overlapped?
IF (LOVER .EQV. .TRUE.) THEN
IF (DSSPCHAR(BEGMUE).EQ.'H') THEN
NUMSEGOVERL(5,1)=NUMSEGOVERL(5,1)+1
NUMSEGOVERL(6,1)=NUMSEGOVERL(6,1)+LENSEGDSSP(MUE)
QSEGLOV(1,1)=QSEGLOV(1,1)+LENSEGDSSP(MUE)
ELSEIF (DSSPCHAR(BEGMUE).EQ.'E') THEN
NUMSEGOVERL(5,2)=NUMSEGOVERL(5,2)+1
NUMSEGOVERL(6,2)=NUMSEGOVERL(6,2)+LENSEGDSSP(MUE)
QSEGLOV(1,2)=QSEGLOV(1,2)+LENSEGDSSP(MUE)
ELSEIF (DSSPCHAR(BEGMUE).EQ.'T') THEN
NUMSEGOVERL(5,3)=NUMSEGOVERL(5,3)+1
NUMSEGOVERL(6,3)=NUMSEGOVERL(6,3)+LENSEGDSSP(MUE)
QSEGLOV(1,3)=QSEGLOV(1,3)+LENSEGDSSP(MUE)
END IF
END IF
C----------------------------------------
C------- loop overlap > 2 --------
C----------------------------------------
ELSEIF (DSSPCHAR(BEGMUE).EQ.'L') THEN
LOVER=.FALSE.
C---------- overlapp with loop anywhere > 2?
IF (LENSEGDSSP(MUE).EQ.1) THEN
IF (PREDCHAR(BEGMUE).EQ.'L') THEN
LOVER=.TRUE.
END IF
ELSEIF (LENSEGDSSP(MUE).EQ.2) THEN
IF (PREDCHAR(BEGMUE).EQ.'L') THEN
LOVER=.TRUE.
ELSEIF ((BEGMUE.LT.NUMRESLIB).AND.
+ (PREDCHAR(BEGMUE+1).EQ.'L')) THEN
LOVER=.TRUE.
END IF
ELSEIF (LENSEGDSSP(MUE).GT.NUMRESLIB) THEN
LOVER=.FALSE.
ELSEIF (ENDMUE.GT.NUMRESLIB) THEN
LOVER=.FALSE.
ELSE
DO ITOVER=BEGMUE,ENDMUE
IF ((LOVER.EQV. .FALSE.).AND.
+ (PREDCHAR(ITOVER).EQ.'L')) THEN
IF (ITOVER.GT.BEGMUE) THEN
IF (PREDCHAR(ITOVER-1).EQ.'L') THEN
LOVER=.TRUE.
END IF
ELSEIF (ITOVER.LT.ENDMUE) THEN
IF (PREDCHAR(ITOVER+1).EQ.'L') THEN
LOVER=.TRUE.
END IF
END IF
END IF
END DO
END IF
C---------- overlapped?
IF (LOVER .EQV. .TRUE.) THEN
NUMSEGOVERL(5,NSECELLIB)=NUMSEGOVERL(5,NSECELLIB)+1
NUMSEGOVERL(6,NSECELLIB)=NUMSEGOVERL(6,NSECELLIB)
+ +LENSEGDSSP(MUE)
QSEGLOV(1,NSECELLIB)=QSEGLOV(1,NSECELLIB)+LENSEGDSSP(MUE)
END IF
END IF
END DO
C---- compute number of all overlapping segments
DO ITSEC=1,NSECELLIB
NUMSEGOVERL(5,(NSECELLIB+1))=NUMSEGOVERL(5,(NSECELLIB+1))
+ +NUMSEGOVERL(5,ITSEC)
NUMSEGOVERL(6,(NSECELLIB+1))=NUMSEGOVERL(6,(NSECELLIB+1))
+ +NUMSEGOVERL(6,ITSEC)
QSEGLOV(1,(NSECELLIB+1))=QSEGLOV(1,(NSECELLIB+1))
+ +QSEGLOV(1,ITSEC)
END DO
C--------------------------------------------------
C---- overlapp % predicted -----
C--------------------------------------------------
DO MUE=1,NUMSEGOVERL(3,(NSECELLIB+1))
BEGMUE=BEGSEGPRED(MUE)
ENDMUE=ENDSEGPRED(MUE)
C----------------------------------------
C------- helix, strand, turn --------
C----------------------------------------
IF ((PREDCHAR(BEGMUE).EQ.'H').OR.
+ (PREDCHAR(BEGMUE).EQ.'E').OR.
+ (PREDCHAR(BEGMUE).EQ.'T')) THEN
LOVER=.TRUE.
IF (INT(LENSEGPRED(MUE)).LT.2) THEN
WRITE(6,'(T2,A,T10,A,T40,A1,A,T60,I3)')'***',
+ 'pred seg too short for:',PREDCHAR(MUE),
+ 'seg no:',MUE
LOVER=.FALSE.
ELSEIF (INT(LENSEGPRED(MUE)).GT.NUMRESLIB) THEN
WRITE(6,'(T2,A,T10,A,T40,A1,A,T60,I3)')'***',
+ 'pred seg too long for:',PREDCHAR(MUE),
+ 'seg no:',MUE
LOVER=.FALSE.
ELSE
C------------- overlapp with N-terminal end of segment?
DO ITOVER=1,INT(LENSEGPRED(MUE)/2.)
IHELP=BEGMUE+ITOVER-1
IF (LOVER.EQV. .TRUE. .AND.(IHELP.LT.NUMRESLIB).AND.
+ (DSSPCHAR(IHELP).NE.PREDCHAR(IHELP))) THEN
LOVER=.FALSE.
C------------------- allow H H -> HHH
IF ((IHELP.GT.1).AND.(IHELP.LT.NUMRESLIB)) THEN
IF ((DSSPCHAR(IHELP-1).EQ.PREDCHAR(IHELP)).AND.
+ (DSSPCHAR(IHELP+1).EQ.PREDCHAR(IHELP))) THEN
LOVER=.TRUE.
END IF
END IF
END IF
END DO
END IF
C---------- overlapp with C-terminal end of segment?
IF ((LOVER.EQV. .FALSE.).AND.(LENSEGPRED(MUE).GT.2).AND.
+ (LENSEGPRED(MUE).LT.NUMRESLIB)) THEN
LOVER=.TRUE.
DO ITOVER=1,INT(LENSEGPRED(MUE)/2.)
IHELP=ENDMUE-INT(LENSEGPRED(MUE)/2.)+ITOVER-1
C---------------- hack 2-06-97
IF ((IHELP.GT.0).AND.(IHELP.LE.NUMRESLIB)) THEN
IF (LOVER.EQV. .TRUE. .AND.(IHELP.GE.1).AND.
+ (IHELP.LE.NUMRESLIB).AND.
+ (PREDCHAR(IHELP).NE.DSSPCHAR(IHELP))) THEN
LOVER=.FALSE.
C------------------- allow H H -> HHH
IF ((IHELP.GT.1).AND.(IHELP.LT.NUMRESLIB)) THEN
IF ((DSSPCHAR(IHELP-1).EQ.
+ PREDCHAR(IHELP)).AND.
+ (DSSPCHAR(IHELP+1).EQ.
+ PREDCHAR(IHELP))) THEN
LOVER=.TRUE.
END IF
END IF
ELSE
LOVER=.FALSE.
END IF
C---------------- hack 2-06-97
ELSE
LOVER=.FALSE.
END IF
END DO
ELSE
LOVER=.FALSE.
END IF
C---------- overlapped?
IF (LOVER .EQV. .TRUE.) THEN
IF (PREDCHAR(BEGMUE).EQ.'H') THEN
NUMSEGOVERL(7,1)=NUMSEGOVERL(7,1)+1
NUMSEGOVERL(8,1)=NUMSEGOVERL(8,1)+LENSEGPRED(MUE)
QSEGLOV(2,1)=QSEGLOV(2,1)+LENSEGPRED(MUE)
ELSEIF (PREDCHAR(BEGMUE).EQ.'E') THEN
NUMSEGOVERL(7,2)=NUMSEGOVERL(7,2)+1
NUMSEGOVERL(8,2)=NUMSEGOVERL(8,2)+LENSEGPRED(MUE)
QSEGLOV(2,2)=QSEGLOV(2,2)+LENSEGPRED(MUE)
ELSEIF (PREDCHAR(BEGMUE).EQ.'T') THEN
NUMSEGOVERL(7,3)=NUMSEGOVERL(7,3)+1
NUMSEGOVERL(8,3)=NUMSEGOVERL(8,3)+LENSEGPRED(MUE)
QSEGLOV(2,3)=QSEGLOV(2,3)+LENSEGPRED(MUE)
END IF
END IF
C----------------------------------------
C------- loop overlap > 2 --------
C----------------------------------------
ELSEIF (PREDCHAR(BEGMUE).EQ.'L') THEN
LOVER=.FALSE.
C---------- overlapp with loop anywhere > 2?
IF (LENSEGPRED(MUE).EQ.1) THEN
IF (DSSPCHAR(BEGMUE).EQ.'L') THEN
LOVER=.TRUE.
END IF
ELSEIF (LENSEGPRED(MUE).EQ.2) THEN
IF (DSSPCHAR(BEGMUE).EQ.'L') THEN
LOVER=.TRUE.
ELSEIF ((BEGMUE.LT.NUMRESLIB).AND.
+ (DSSPCHAR(BEGMUE+1).EQ.'L')) THEN
LOVER=.TRUE.
END IF
ELSEIF (LENSEGPRED(MUE).GT.NUMRESLIB) THEN
LOVER=.FALSE.
ELSE
DO ITOVER=BEGMUE,ENDMUE
IF ((LOVER.EQV. .FALSE.).AND.
+ (PREDCHAR(ITOVER).EQ.'L')) THEN
IF (ITOVER.GT.BEGMUE) THEN
IF (DSSPCHAR(ITOVER-1).EQ.'L') THEN
LOVER=.TRUE.
END IF
ELSEIF (ITOVER.LT.ENDMUE) THEN
IF (DSSPCHAR(ITOVER+1).EQ.'L') THEN
LOVER=.TRUE.
END IF
END IF
END IF
END DO
END IF
C---------- overlapped?
IF (LOVER .EQV. .TRUE.) THEN
NUMSEGOVERL(7,NSECELLIB)=NUMSEGOVERL(7,NSECELLIB)+1
NUMSEGOVERL(8,NSECELLIB)=NUMSEGOVERL(8,NSECELLIB)
+ +LENSEGPRED(MUE)
QSEGLOV(2,NSECELLIB)=
+ QSEGLOV(2,NSECELLIB)+LENSEGPRED(MUE)
END IF
END IF
END DO
C---- compute number of all overlapping segments
DO ITSEC=1,NSECELLIB
NUMSEGOVERL(7,(NSECELLIB+1))=NUMSEGOVERL(7,(NSECELLIB+1))
+ +NUMSEGOVERL(4,ITSEC)
NUMSEGOVERL(8,(NSECELLIB+1))=NUMSEGOVERL(8,(NSECELLIB+1))
+ +NUMSEGOVERL(8,ITSEC)
QSEGLOV(2,(NSECELLIB+1))=QSEGLOV(2,(NSECELLIB+1))
+ +QSEGLOV(2,ITSEC)
END DO
C--------------------------------------------------
C---- end of scanning PRED segments -----
C--------------------------------------------------
END
***** end of SSEGLOV
***** ------------------------------------------------------------------
***** SUB SSEGSOV
***** ------------------------------------------------------------------
C----
C---- NAME : SSEGSOV
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Nov, 1992 version 0.1 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: The number of correctly predicted elements is *
* -------- computed. *
* input variables:NSECELLIB,MAXNSECEL,NUMRESLIB,MAXNUMRES, *
* ----------------DSSPCHAR,PREDCHAR,SSCHAR,LENSEGDSSP,LENSEGPRED, *
* POINTPRED,BEGSEGDSSP,COUNTSEG *
* output variab.: NUMCOR *
* called by: SEVALSEG (in lib-prot.f) *
* SBRs calling: from lib-comp.f: *
* -------------- SISTZ1, *
* from lib-unix.f: *
* SCHECKPASS *
* procedure: correct: NUMSEGOVERL(5,ITSEC) *
* ---------- for L < 5: | L(OBS)-L(PRED) | <= 1 *
* .AND. shift by 1 allowed *
* for 5<=L<10: | L(OBS)-L(PRED) | <= 2 *
* .AND. shift by 2 allowed *
* for L >= 10: | L(OBS)-L(PRED) | <= 3 *
* .AND. shift by 3 allowed *
*----------------------------------------------------------------------*
SUBROUTINE SSEGSOV(NSECELLIB,MAXNSECEL,NUMRESLIB,MAXNUMRES,
+ MAXSEGPASS,CHVP1,DSSPCHAR,PREDCHAR,SSCHAR,CHVP2,
+ LENSEGDSSP,LENSEGPRED,POINTDSSP,POINTPRED,
+ BEGSEGDSSP,BEGSEGPRED,CHVP3,
+ NUMCOR,COUNTSEGDSSP,COUNTSEGPRED,QSEGSOV,CHVPL)
IMPLICIT NONE
C---- variables passed
INTEGER MAXNSECEL,NSECELLIB,MAXNUMRES,NUMRESLIB,
+ MAXSEGPASS,CHVPM(1:50),CHVPL,CHVP1,CHVP2,CHVP3,
+ NUMCOR(1:2,1:8),COUNTSEGDSSP,COUNTSEGPRED,
+ POINTDSSP(1:MAXNUMRES),POINTPRED(1:MAXNUMRES),
+ BEGSEGDSSP(1:MAXSEGPASS),BEGSEGPRED(1:MAXSEGPASS),
+ LENSEGDSSP(1:MAXSEGPASS),LENSEGPRED(1:MAXSEGPASS)
REAL QSEGSOV(1:2,1:(MAXNSECEL+1))
CHARACTER*1 DSSPCHAR(1:MAXNUMRES),PREDCHAR(1:MAXNUMRES)
CHARACTER*1 SSCHAR(1:8)
C---- local variables *
INTEGER MUE,ITSEC,IHELP
LOGICAL LERRCHVP,LOVER
******------------------------------*-----------------------------******
* MUE,ITER serve as iteration variables *
* QSEGSOV(i,j) i=1: %observed *
* i=2: %predicted *
* j=1-4 (helix,strand,loop,3-states) *
* gives the strict overlap *
* for L < 5: | L(OBS)-L(PRED) | <= 1 *
* .AND. shift by 1 allowed *
* for 5<=L<10: | L(OBS)-L(PRED) | <= 2 *
* .AND. shift by 2 allowed *
* for L >= 10: | L(OBS)-L(PRED) | <= 3 *
* .AND. shift by 3 allowed *
* multiplication with length of segment, normali- *
* sation will be done by calling SBR with N=number *
* of all residues in the data set *
* LWRITE variable used, to call subr such that the *
* result they compute is written out (true) or not *
******------------------------------*-----------------------------******
C---- initial check of variables passed
IF (CHVPL.NE.3) THEN
WRITE(6,'(T2,A,T10,A)')'***',
+ 'WARNING: SSEGSOV: number of passed variables not fitting'
END IF
CHVPM(1)=CHVP1
CHVPM(2)=CHVP2
CHVPM(3)=CHVP3
C ---------------
CALL SCHECKPASS(CHVPM,CHVPL,LERRCHVP)
C ---------------
IF (LERRCHVP .EQV. .TRUE.) THEN
WRITE(6,'(T2,A,T10,A)')'***',
+ 'ERROR for SSEGSOV: variables passed not correct !'
END IF
C---- check variables passed
IF (NUMRESLIB.GT.MAXNUMRES) THEN
WRITE(6,'(T5,A)')
+ ' The length of the protein passed to SBR SSEGSOV'
WRITE(6,'(T5,A)')
+ ' exceeds the locally allocated array dimensions.'
WRITE(6,'(T5,A,T25,I4,T30,A,T40,I4)')
+ ' Current length: ',NUMRESLIB,' allocated:',MAXNUMRES
WRITE(6,'(T5,A)')' Stopped in SSEGSOV 12-2-92:1'
STOP
END IF
IF (NSECELLIB.GT.MAXNSECEL) THEN
WRITE(6,'(T5,A)')
+ 'The number of secondary structures passed to SBR SSEGSOV'
WRITE(6,'(T5,A)')
+ 'exceeds the locally allocated array dimensions.'
WRITE(6,'(T5,A,T25,I4,T30,A,T40,I4)')
+ ' Current number: ',NSECELLIB,' allocated:',MAXNSECEL
WRITE(6,'(T5,A)')' Stopped in SSEGSOV 12-11-92:2'
STOP
END IF
C---- set zero
C -----------
CALL SISTZ2(NUMCOR,2,8)
C -----------
CALL SRSTZ2(QSEGSOV,2,(MAXNSECEL+1))
C -----------
C----------------------------------------------------------------------
C---- computing correct elements for %observed -----
C----------------------------------------------------------------------
DO MUE=1,COUNTSEGDSSP
LOVER=.FALSE.
IF (LENSEGDSSP(MUE).LE.2) THEN
IHELP=BEGSEGDSSP(MUE)
IF (PREDCHAR(IHELP).EQ.DSSPCHAR(IHELP)) THEN
LOVER=.TRUE.
END IF
ELSEIF (LENSEGDSSP(MUE).LE.5) THEN
IHELP=BEGSEGDSSP(MUE)
IF ((PREDCHAR(IHELP).EQ.DSSPCHAR(IHELP)).AND.
+ (LENSEGPRED(POINTPRED(IHELP)).LE.
+ (LENSEGDSSP(MUE)+1)).AND.
+ (LENSEGPRED(POINTPRED(IHELP)).GE.
+ (LENSEGDSSP(MUE)-1))) THEN
LOVER=.TRUE.
ELSEIF (IHELP.LT.0) THEN
LOVER=.FALSE.
ELSEIF (IHELP.EQ.1) THEN
IF (PREDCHAR(IHELP).EQ.DSSPCHAR(IHELP)) THEN
LOVER=.TRUE.
ELSE
LOVER=.FALSE.
END IF
ELSEIF (IHELP.EQ.NUMRESLIB) THEN
IF (PREDCHAR(IHELP).EQ.DSSPCHAR(IHELP)) THEN
LOVER=.TRUE.
ELSE
LOVER=.FALSE.
END IF
END IF
IF ((LOVER.EQV. .FALSE.).AND.(IHELP.GT.1)) THEN
IF ( (PREDCHAR(IHELP-1).EQ.DSSPCHAR(IHELP)).AND.
+ (LENSEGPRED(POINTPRED(IHELP-1)).LE.
+ (LENSEGDSSP(MUE)+1)).AND.
+ (LENSEGPRED(POINTPRED(IHELP-1)).GE.
+ (LENSEGDSSP(MUE)-1))) THEN
LOVER=.TRUE.
END IF
END IF
IF ((LOVER.EQV. .FALSE.).AND.(IHELP.LT.NUMRESLIB)) THEN
IF ( (PREDCHAR(IHELP+1).EQ.DSSPCHAR(IHELP)).AND.
+ (LENSEGPRED(POINTPRED(IHELP+1)).LE.
+ (LENSEGDSSP(MUE)+1)).AND.
+ (LENSEGPRED(POINTPRED(IHELP+1)).GE.
+ (LENSEGDSSP(MUE)-1))) THEN
LOVER=.TRUE.
END IF
END IF
ELSEIF (LENSEGDSSP(MUE).LE.10) THEN
IHELP=BEGSEGDSSP(MUE)
IF ( (PREDCHAR(IHELP).EQ.DSSPCHAR(IHELP)).AND.
+ (LENSEGPRED(POINTPRED(IHELP)).LE.
+ (LENSEGDSSP(MUE)+2)).AND.
+ (LENSEGPRED(POINTPRED(IHELP)).GE.
+ (LENSEGDSSP(MUE)-2))) THEN
LOVER=.TRUE.
ELSEIF (IHELP.LT.0) THEN
LOVER=.FALSE.
ELSEIF (IHELP.EQ.1) THEN
IF (PREDCHAR(IHELP).EQ.DSSPCHAR(IHELP)) THEN
LOVER=.TRUE.
ELSE
LOVER=.FALSE.
END IF
END IF
IF ((LOVER.EQV. .FALSE.).AND.(IHELP.GT.1)) THEN
IF ((PREDCHAR(IHELP-1).EQ.DSSPCHAR(IHELP)).AND.
+ (LENSEGPRED(POINTPRED(IHELP-1)).LE.
+ (LENSEGDSSP(MUE)+2)).AND.
+ (LENSEGPRED(POINTPRED(IHELP-1)).GE.
+ (LENSEGDSSP(MUE)-2))) THEN
LOVER=.TRUE.
END IF
END IF
IF ((LOVER.EQV. .FALSE.).AND.(IHELP.GT.2)) THEN
IF ( (PREDCHAR(IHELP-2).EQ.DSSPCHAR(IHELP)).AND.
+ (LENSEGPRED(POINTPRED(IHELP-2)).LE.
+ (LENSEGDSSP(MUE)+2)).AND.
+ (LENSEGPRED(POINTPRED(IHELP-2)).GE.
+ (LENSEGDSSP(MUE)-2))) THEN
LOVER=.TRUE.
END IF
END IF
IF ((LOVER.EQV. .FALSE.).AND.(IHELP.LT.NUMRESLIB)) THEN
IF ( (PREDCHAR(IHELP+1).EQ.DSSPCHAR(IHELP)).AND.
+ (LENSEGPRED(POINTPRED(IHELP+1)).LE.
+ (LENSEGDSSP(MUE)+2)).AND.
+ (LENSEGPRED(POINTPRED(IHELP+1)).GE.
+ (LENSEGDSSP(MUE)-2))) THEN
LOVER=.TRUE.
END IF
END IF
IF ((LOVER.EQV. .FALSE.).AND.(IHELP.LT.(NUMRESLIB-1))) THEN
IF ( (PREDCHAR(IHELP+2).EQ.DSSPCHAR(IHELP)).AND.
+ (LENSEGPRED(POINTPRED(IHELP+2)).LE.
+ (LENSEGDSSP(MUE)+2)).AND.
+ (LENSEGPRED(POINTPRED(IHELP+2)).GE.
+ (LENSEGDSSP(MUE)-2))) THEN
LOVER=.TRUE.
END IF
END IF
ELSEIF (LENSEGDSSP(MUE).GT.NUMRESLIB) THEN
LOVER=.FALSE.
ELSEIF (LENSEGDSSP(MUE).GT.10) THEN
IHELP=BEGSEGDSSP(MUE)
IF ((PREDCHAR(IHELP).EQ.DSSPCHAR(IHELP)).AND.
+ (LENSEGPRED(POINTPRED(IHELP)).LE.
+ (LENSEGDSSP(MUE)+3)).AND.
+ (LENSEGPRED(POINTPRED(IHELP)).GE.
+ (LENSEGDSSP(MUE)-3))) THEN
LOVER=.TRUE.
END IF
IF ((LOVER.EQV. .FALSE.).AND.(IHELP.GT.1)) THEN
IF ( (PREDCHAR(IHELP-1).EQ.DSSPCHAR(IHELP)).AND.
+ (LENSEGPRED(POINTPRED(IHELP-1)).LE.
+ (LENSEGDSSP(MUE)+3)).AND.
+ (LENSEGPRED(POINTPRED(IHELP-1)).GE.
+ (LENSEGDSSP(MUE)-3))) THEN
LOVER=.TRUE.
END IF
END IF
IF ((LOVER.EQV. .FALSE.).AND.(IHELP.GT.2)) THEN
IF ( (PREDCHAR(IHELP-2).EQ.DSSPCHAR(IHELP)).AND.
+ (LENSEGPRED(POINTPRED(IHELP-2)).LE.
+ (LENSEGDSSP(MUE)+3)).AND.
+ (LENSEGPRED(POINTPRED(IHELP-2)).GE.
+ (LENSEGDSSP(MUE)-3))) THEN
LOVER=.TRUE.
END IF
END IF
IF ((LOVER.EQV. .FALSE.).AND.(IHELP.GT.3)) THEN
IF ( (PREDCHAR(IHELP-3).EQ.DSSPCHAR(IHELP)).AND.
+ (LENSEGPRED(POINTPRED(IHELP-3)).LE.
+ (LENSEGDSSP(MUE)+3)).AND.
+ (LENSEGPRED(POINTPRED(IHELP-3)).GE.
+ (LENSEGDSSP(MUE)-3))) THEN
LOVER=.TRUE.
END IF
END IF
IF ((LOVER.EQV. .FALSE.).AND.(IHELP.LT.NUMRESLIB)) THEN
IF ( (PREDCHAR(IHELP+1).EQ.DSSPCHAR(IHELP)).AND.
+ (LENSEGPRED(POINTPRED(IHELP+1)).LE.
+ (LENSEGDSSP(MUE)+3)).AND.
+ (LENSEGPRED(POINTPRED(IHELP+1)).GE.
+ (LENSEGDSSP(MUE)-3))) THEN
LOVER=.TRUE.
END IF
END IF
IF ((LOVER.EQV. .FALSE.).AND.(IHELP.LT.(NUMRESLIB-1))) THEN
IF ( (PREDCHAR(IHELP+2).EQ.DSSPCHAR(IHELP)).AND.
+ (LENSEGPRED(POINTPRED(IHELP+2)).LE.
+ (LENSEGDSSP(MUE)+3)).AND.
+ (LENSEGPRED(POINTPRED(IHELP+2)).GE.
+ (LENSEGDSSP(MUE)-3))) THEN
LOVER=.TRUE.
END IF
END IF
IF ((LOVER.EQV. .FALSE.).AND.(IHELP.LT.(NUMRESLIB-2))) THEN
IF ( (PREDCHAR(IHELP+3).EQ.DSSPCHAR(IHELP)).AND.
+ (LENSEGPRED(POINTPRED(IHELP+3)).LE.
+ (LENSEGDSSP(MUE)+3)).AND.
+ (LENSEGPRED(POINTPRED(IHELP+3)).GE.
+ (LENSEGDSSP(MUE)-3))) THEN
LOVER=.TRUE.
END IF
END IF
END IF
C------- count number of correct elements
IF (LOVER .EQV. .TRUE.) THEN
DO ITSEC=1,NSECELLIB
IF (DSSPCHAR(BEGSEGDSSP(MUE)).EQ.SSCHAR(ITSEC)) THEN
NUMCOR(1,ITSEC)=NUMCOR(1,ITSEC)+1
QSEGSOV(1,ITSEC)=QSEGSOV(1,ITSEC)+LENSEGDSSP(MUE)
END IF
END DO
END IF
END DO
C---- end of loop over observed segments
C--------------------------------------------------
C--------------------------------------------------
C---- compute SOV for NSECELLIB+1 (i.e. all states)
C--------------------------------------------------
DO ITSEC=1,NSECELLIB
QSEGSOV(1,(NSECELLIB+1))=QSEGSOV(1,(NSECELLIB+1))
+ +QSEGSOV(1,ITSEC)
NUMCOR(1,(NSECELLIB+1))=NUMCOR(1,(NSECELLIB+1))
+ +NUMCOR(1,ITSEC)
END DO
C---- end of computation for correct elements as % of observed -----
C----------------------------------------------------------------------
C----------------------------------------------------------------------
C---- computing correct elements for %predicted -----
C----------------------------------------------------------------------
DO MUE=1,COUNTSEGPRED
LOVER=.FALSE.
IF (LENSEGPRED(MUE).LE.5) THEN
IHELP=BEGSEGPRED(MUE)
IF ((PREDCHAR(IHELP).EQ.DSSPCHAR(IHELP)).AND.
+ (LENSEGDSSP(POINTDSSP(IHELP)).LE.
+ (LENSEGPRED(MUE)+1)).AND.
+ (LENSEGDSSP(POINTDSSP(IHELP)).GE.
+ (LENSEGPRED(MUE)-1))) THEN
LOVER=.TRUE.
ELSEIF (IHELP.EQ.1) THEN
IF (PREDCHAR(IHELP).EQ.DSSPCHAR(IHELP)) THEN
LOVER=.TRUE.
ELSE
LOVER=.FALSE.
END IF
END IF
IF ((LOVER.EQV. .FALSE.).AND.(IHELP.GT.1)) THEN
IF ( (PREDCHAR(IHELP-1).EQ.DSSPCHAR(IHELP)).AND.
+ (LENSEGDSSP(POINTDSSP(IHELP-1)).LE.
+ (LENSEGPRED(MUE)+1)).AND.
+ (LENSEGDSSP(POINTDSSP(IHELP-1)).GE.
+ (LENSEGPRED(MUE)-1))) THEN
LOVER=.TRUE.
END IF
END IF
IF ((LOVER.EQV. .FALSE.).AND.(IHELP.LT.NUMRESLIB)) THEN
IF ( (PREDCHAR(IHELP+1).EQ.DSSPCHAR(IHELP)).AND.
+ (LENSEGDSSP(POINTDSSP(IHELP+1)).LE.
+ (LENSEGPRED(MUE)+1)).AND.
+ (LENSEGDSSP(POINTDSSP(IHELP+1)).GE.
+ (LENSEGPRED(MUE)-1))) THEN
LOVER=.TRUE.
END IF
END IF
C---------- correction for short helices/strands
IF ((PREDCHAR(IHELP).EQ.'H').OR.
+ (PREDCHAR(IHELP).EQ.'E')) THEN
LOVER=.FALSE.
END IF
ELSEIF (LENSEGPRED(MUE).LE.10) THEN
IHELP=BEGSEGPRED(MUE)
IF ((PREDCHAR(IHELP).EQ.DSSPCHAR(IHELP)).AND.
+ (LENSEGDSSP(POINTDSSP(IHELP)).LE.
+ (LENSEGPRED(MUE)+2)).AND.
+ (LENSEGDSSP(POINTDSSP(IHELP)).GE.
+ (LENSEGPRED(MUE)-2))) THEN
LOVER=.TRUE.
ELSEIF (IHELP.EQ.1) THEN
IF (PREDCHAR(IHELP).EQ.DSSPCHAR(IHELP)) THEN
LOVER=.TRUE.
ELSE
LOVER=.FALSE.
END IF
END IF
IF ((LOVER.EQV. .FALSE.).AND.(IHELP.GT.1)) THEN
IF ( (PREDCHAR(IHELP-1).EQ.DSSPCHAR(IHELP)).AND.
+ (LENSEGDSSP(POINTDSSP(IHELP-1)).LE.
+ (LENSEGPRED(MUE)+2)).AND.
+ (LENSEGDSSP(POINTDSSP(IHELP-1)).GE.
+ (LENSEGPRED(MUE)-2))) THEN
LOVER=.TRUE.
END IF
END IF
IF ((LOVER.EQV. .FALSE.).AND.(IHELP.GT.2)) THEN
IF ( (PREDCHAR(IHELP-2).EQ.DSSPCHAR(IHELP)).AND.
+ (LENSEGDSSP(POINTDSSP(IHELP-2)).LE.
+ (LENSEGPRED(MUE)+2)).AND.
+ (LENSEGDSSP(POINTDSSP(IHELP-2)).GE.
+ (LENSEGPRED(MUE)-2))) THEN
LOVER=.TRUE.
END IF
END IF
IF ((LOVER.EQV. .FALSE.).AND.(IHELP.LT.NUMRESLIB)) THEN
IF ( (PREDCHAR(IHELP+1).EQ.DSSPCHAR(IHELP)).AND.
+ (LENSEGDSSP(POINTDSSP(IHELP+1)).LE.
+ (LENSEGPRED(MUE)+2)).AND.
+ (LENSEGDSSP(POINTDSSP(IHELP+1)).GE.
+ (LENSEGPRED(MUE)-2))) THEN
LOVER=.TRUE.
END IF
END IF
IF ((LOVER.EQV. .FALSE.).AND.(IHELP.LT.(NUMRESLIB-1))) THEN
IF ( (PREDCHAR(IHELP+2).EQ.DSSPCHAR(IHELP)).AND.
+ (LENSEGDSSP(POINTDSSP(IHELP+2)).LE.
+ (LENSEGPRED(MUE)+2)).AND.
+ (LENSEGDSSP(POINTDSSP(IHELP+2)).GE.
+ (LENSEGPRED(MUE)-2))) THEN
LOVER=.TRUE.
END IF
END IF
ELSEIF (LENSEGPRED(MUE).GT.10) THEN
IHELP=BEGSEGPRED(MUE)
IF ((PREDCHAR(IHELP).EQ.DSSPCHAR(IHELP)).AND.
+ (LENSEGDSSP(POINTDSSP(IHELP)).LE.
+ (LENSEGPRED(MUE)+3)).AND.
+ (LENSEGDSSP(POINTDSSP(IHELP)).GE.
+ (LENSEGPRED(MUE)-3))) THEN
LOVER=.TRUE.
ELSEIF (IHELP.EQ.1) THEN
IF (PREDCHAR(IHELP).EQ.DSSPCHAR(IHELP)) THEN
LOVER=.TRUE.
ELSE
LOVER=.FALSE.
END IF
END IF
IF ((LOVER.EQV. .FALSE.).AND.(IHELP.GT.1)) THEN
IF ( (PREDCHAR(IHELP-1).EQ.DSSPCHAR(IHELP)).AND.
+ (LENSEGDSSP(POINTDSSP(IHELP-1)).LE.
+ (LENSEGPRED(MUE)+3)).AND.
+ (LENSEGDSSP(POINTDSSP(IHELP-1)).GE.
+ (LENSEGPRED(MUE)-3))) THEN
LOVER=.TRUE.
END IF
END IF
IF ((LOVER.EQV. .FALSE.).AND.(IHELP.GT.2)) THEN
IF ( (PREDCHAR(IHELP-2).EQ.DSSPCHAR(IHELP)).AND.
+ (LENSEGDSSP(POINTDSSP(IHELP-2)).LE.
+ (LENSEGPRED(MUE)+3)).AND.
+ (LENSEGDSSP(POINTDSSP(IHELP-2)).GE.
+ (LENSEGPRED(MUE)-3))) THEN
LOVER=.TRUE.
END IF
END IF
IF ((LOVER.EQV. .FALSE.).AND.(IHELP.GT.3)) THEN
IF ( (PREDCHAR(IHELP-3).EQ.DSSPCHAR(IHELP)).AND.
+ (LENSEGDSSP(POINTDSSP(IHELP-3)).LE.
+ (LENSEGPRED(MUE)+3)).AND.
+ (LENSEGDSSP(POINTDSSP(IHELP-3)).GE.
+ (LENSEGPRED(MUE)-3))) THEN
LOVER=.TRUE.
END IF
END IF
IF ((LOVER.EQV. .FALSE.).AND.(IHELP.LT.NUMRESLIB)) THEN
IF ( (PREDCHAR(IHELP+1).EQ.DSSPCHAR(IHELP)).AND.
+ (LENSEGDSSP(POINTDSSP(IHELP+1)).LE.
+ (LENSEGPRED(MUE)+3)).AND.
+ (LENSEGDSSP(POINTDSSP(IHELP+1)).GE.
+ (LENSEGPRED(MUE)-3))) THEN
LOVER=.TRUE.
END IF
END IF
IF ((LOVER.EQV. .FALSE.).AND.(IHELP.LT.(NUMRESLIB-1))) THEN
IF ( (PREDCHAR(IHELP+2).EQ.DSSPCHAR(IHELP)).AND.
+ (LENSEGDSSP(POINTDSSP(IHELP+2)).LE.
+ (LENSEGPRED(MUE)+3)).AND.
+ (LENSEGDSSP(POINTDSSP(IHELP+2)).GE.
+ (LENSEGPRED(MUE)-3))) THEN
LOVER=.TRUE.
END IF
END IF
IF ((LOVER.EQV. .FALSE.).AND.(IHELP.LT.(NUMRESLIB-2))) THEN
IF ( (PREDCHAR(IHELP+3).EQ.DSSPCHAR(IHELP)).AND.
+ (LENSEGDSSP(POINTDSSP(IHELP+3)).LE.
+ (LENSEGPRED(MUE)+3)).AND.
+ (LENSEGDSSP(POINTDSSP(IHELP+3)).GE.
+ (LENSEGPRED(MUE)-3))) THEN
LOVER=.TRUE.
END IF
END IF
END IF
C---- count number of correct elements
IF (LOVER .EQV. .TRUE.) THEN
DO ITSEC=1,NSECELLIB
IF (DSSPCHAR(BEGSEGPRED(MUE)).EQ.SSCHAR(ITSEC)) THEN
NUMCOR(2,ITSEC)=NUMCOR(2,ITSEC)+1
QSEGSOV(2,ITSEC)=QSEGSOV(2,ITSEC)+LENSEGPRED(MUE)
END IF
END DO
END IF
END DO
C---- end of loop over predicted segments
C--------------------------------------------------
C--------------------------------------------------
C---- compute SOV for NSECELLIB+1 (i.e. all states)
C--------------------------------------------------
DO ITSEC=1,NSECELLIB
QSEGSOV(2,(NSECELLIB+1))=QSEGSOV(2,(NSECELLIB+1))
+ +QSEGSOV(2,ITSEC)
NUMCOR(2,(NSECELLIB+1))=NUMCOR(2,(NSECELLIB+1))
+ +NUMCOR(2,ITSEC)
END DO
END
***** end of SSEGSOV
***** ------------------------------------------------------------------
***** SUB STABLEPOLENFILE
***** ------------------------------------------------------------------
C----
C---- NAME : STABLEPOLENFILE
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Nov, 1992 version 0.1 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: The pay-offs of a certain prediction are written *
* -------- as a table onto unit KOUT *
* input variables:NSECELLIB, PROTNAMELIB, NUMRESLIB, TITLE *
* ----------------MATNUM, MATQOFDSSP, MATQOFPRED, INTERQ3, INTERSQ *
* INTERCORR, MATLEN *
* called by: SEVALSEC (in lib-prot.f) *
* calling: SEVALQUO (in lib-prot.f) (if q3,sq=0, mat not) *
*----------------------------------------------------------------------*
SUBROUTINE STABLEPOLENFILE(KUNIT,NSECELLIB,MAXNSECELLIB,
+ PROTNAMELIB,NUMRESLIB,TITLE,MATNUM,MATQOFDSSP,MATQOFPRED,
+ INTERQ3,INTERSQ,INTERCORR,MATLEN)
IMPLICIT NONE
C---- local variables *
INTEGER MAXNSECELLIB
INTEGER ITER,ITSEC,NUMRESLIB,NSECELLIB,IHELP,KUNIT,ICOUNT
INTEGER MATNUM(1:(MAXNSECELLIB+1),1:(MAXNSECELLIB+1))
INTEGER MATLEN(1:(MAXNSECELLIB+1),1:4),IBEG,IEND
REAL MATQOFDSSP(1:MAXNSECELLIB,1:MAXNSECELLIB)
REAL MATQOFPRED(1:MAXNSECELLIB,1:MAXNSECELLIB)
REAL INTERCORR(1:MAXNSECELLIB),INTERQ3,INTERSQ
REAL INTERAVLENGTH(1:8,1:2)
CHARACTER*1 INTERTITLE(1:40)
CHARACTER*222 PROTNAMELIB,INTERNAME
CHARACTER*10 INTERDSSP(1:8)
CHARACTER TITLE*(*)
LOGICAL LFLAG
******------------------------------*-----------------------------******
* ITSEC,ITER iteration variables *
* INTERAVLENGTH(i,k) intermediately store average length of elements
* (required to avoid division by zero) *
* INTERCORR(i) correlation for class i, (Mathews) *
* INTERQ3 =properly predicted for all classes/all residues *
* INTERSQ first divide predicted/DSSP in each class then *
* sum all classes and divide by e.g. 3 *
* INTERTITLE intermediate variable storing a character 40 with*
* the title (potentially truncated) *
* KUNIT =6, or 10, according to whether the table is to *
* be written onto printer or into a file (FILETABLE)
* MATLEN(i,j) matrix with the lengths of the elements: *
* i=1,4 => H,E,C,all *
* j=1 => number of elements DSSP *
* j=2 => number of elements PRED *
* j=2 => summed length of all elements for DSSP *
* j=2 => summed length of all elements for PRED *
* MATNUM(i,j) the number of residues in a certain secondary *
* structure, i labels DSSP assignment, i.e. all *
* numbers with i=1 are according to DSSP helices, *
* j labels the prediction. That means, e.g.: *
* MATNUM(1,1) are all DSSP helices predicted to be *
* a helix, MATNUM(1,2) those DSSP helices predicted*
* as strands and MATNUM(1,4) all DSSP helices, resp.
* MATNUM(4,4) all residues predicted. *
* MATOFDSSP(i,j) stores according to the same scheme as MATNUM the*
* percentages of residues predicted divided by the *
* numbers of DSSP (note there is no element (4,4) )*
* MATOFPRED(i,j) same as previous but now percentages of prediction
* MAXNSECELLIB maximal number of secondary structures allowed *
* NSECELLIB currently read number of secondary structures *
* NUMRESLIB number of residues of protein for current table *
* PROTNAMELIB the name of the protein for current table *
* TITLE title of job which generated the prediction *
******------------------------------*-----------------------------******
IHELP= 0
C----------------------------------------------------------------------
C---- check the size of the quantities passed: -----
C---- if Q3=SQ=0 and MATNUM(i,i) not 0 --> compute newly -----
C----------------------------------------------------------------------
LFLAG=.TRUE.
IF ((INTERQ3.EQ.0.).AND.(INTERSQ.EQ.0.)) THEN
DO ITSEC=1,NSECELLIB
IF (LFLAG.EQV. .TRUE. .AND.(MATNUM(ITSEC,ITSEC).NE.0)) THEN
LFLAG=.FALSE.
END IF
END DO
IF (LFLAG.EQV. .FALSE.) THEN
C =============
CALL SEVALQUO(NSECELLIB,MAXNSECELLIB,MATNUM,MATQOFDSSP,
+ MATQOFPRED,INTERQ3,INTERSQ,INTERCORR)
C =============
END IF
END IF
C----------------------------------------------------------------------
C---- TABLE -----
C----------------------------------------------------------------------
C KUNIT=6
C---- count length of string 'TITLE'
LFLAG=.TRUE.
DO ITER=1,50
IF (LFLAG .EQV. .TRUE.) THEN
IF (TITLE(ITER:ITER).EQ.' ') THEN
LFLAG=.FALSE.
IHELP=ITER
END IF
END IF
END DO
DO ITER=1,IHELP
INTERTITLE(ITER)=TITLE(ITER:ITER)
END DO
DO ITER=(IHELP+1),40
INTERTITLE(ITER)=' '
END DO
C---- length of protein name ok?
CALL SILEN_STRING(PROTNAMELIB,IBEG,IEND)
ICOUNT=IEND-IBEG+1
IF ((ICOUNT+IBEG).LT.7) THEN
INTERNAME(1:ICOUNT+IBEG)=PROTNAMELIB(1:ICOUNT+IBEG)
INTERNAME((ICOUNT+IBEG+1):7)=' '
ELSE
INTERNAME(1:7)=PROTNAMELIB(1:7)
END IF
C---- avoid division by zero!
DO ITER=1,2
DO ITSEC=1,(NSECELLIB+1)
IF (MATLEN(ITSEC,ITER).NE.0) THEN
INTERAVLENGTH(ITSEC,ITER)=
+ MATLEN(ITSEC,(2+ITER))/REAL(MATLEN(ITSEC,ITER))
ELSE
INTERAVLENGTH(ITSEC,ITER)=0
END IF
END DO
END DO
C--------------------------------------------------
C---- write all numbers into a table -----
C--------------------------------------------------
C----------------------------------------
C---- 3 secondary structures -----
C----------------------------------------
IF (NSECELLIB.EQ.3) THEN
C------- header
WRITE(KUNIT,'(T2,A1,16A1,A1,49A1,A1,T70,A)')
+ '+',('-',ITER=1,16),'+',('-',ITER=1,49),'+',
+ '-------------------+'
WRITE(KUNIT,'(T2,A2,A7,A1,I5,T19,A9,40A1,T69,A1,T70,A14,T89,
+ A1)')'| ',INTERNAME,':',NUMRESLIB,'| method:',
+ (INTERTITLE(ITER),ITER=1,40),'|',' segments','|'
WRITE(KUNIT,'(T2,A1,16A1,A1,19A1,A1,17A1,A1,11A1,A1,T70,2A10)')
+ '+',('-',ITER=1,16),'+',('-',ITER=1,19),'+',('-',ITER=1,
+ 17),'+',('-',ITER=1,11),'+',('---------+',ITER=1,2)
WRITE(KUNIT,'(T2,A,T40,A,T57,A1,A,T69,A1,T70,2A10)')
+ '| number of residues with H,E,C |',
+ ' % of DSSP','|',' % of Net','|',' number |',
+ 'av length|'
WRITE(KUNIT,'(T2,A1,A,T12,4A7,3A6,3A4,T70,4A5)')
+ '+','--------+',('------+',ITER=1,(NSECELLIB+1)),
+ ('-----+',ITER=1,NSECELLIB),('---+',ITER=1,NSECELLIB),
+ ('----+',ITER=1,4)
WRITE(KUNIT,'(T2,A10,4A7,3A6,3A4,T70,4A5)')
+ '| |','net H |','net E |','net C |','sum DS|',
+ ' H |',' E |',' C |',' H |',' E |',' C |',
+ 'DSSP|',' Net|','DSSP|',' Net|'
WRITE(KUNIT,'(T2,A1,A,T12,4A7,3A6,3A4,T70,4A5)')
+ '+','--------+',('------+',ITER=1,(NSECELLIB+1)),
+ ('-----+',ITER=1,NSECELLIB),('---+',ITER=1,NSECELLIB),
+ ('----+',ITER=1,4)
C------- number for all secondary elements
INTERDSSP(1)='| DSSP H |'
INTERDSSP(2)='| DSSP E |'
INTERDSSP(3)='| DSSP C |'
DO ITSEC=1,NSECELLIB
WRITE(KUNIT,'(T2,A10,4(I5,A2),3(F5.1,A1),3(I3,A1),
+ T70,2(I4,A1),2(F4.1,A1))')
+ INTERDSSP(ITSEC),(MATNUM(ITSEC,ITER),' |',ITER=1,
+ (NSECELLIB+1)),(MATQOFDSSP(ITSEC,ITER),'|',ITER=1,
+ NSECELLIB),(INT(MATQOFPRED(ITSEC,ITER)),'|',ITER=1,
+ NSECELLIB),(MATLEN(ITSEC,ITER),'|',ITER=1,2),
+ (INTERAVLENGTH(ITSEC,ITER),'|',ITER=1,2)
END DO
C------- sums
WRITE(KUNIT,'(T2,A1,A,T12,4A7,3A6,3A4,T70,4A5)')
+ '+','--------+',('------+',ITER=1,(NSECELLIB+1)),
+ ('-----+',ITER=1,NSECELLIB),'---+','-+-+','---+',
+ ('----+',ITER=1,4)
WRITE(KUNIT,'(T2,A10,4(I5,A2),3A6,2A6,T70,2(I4,A1),2(F4.1,
+ A1))')'| sum Net|',(MATNUM((NSECELLIB+1),ITER),' |',
+ ITER=1,(NSECELLIB+1)),'corH |','corE |','corC |',' Q3 |',
+ ' SQ |',(MATLEN((NSECELLIB+1),ITER),'|',ITER=1,2),
+ (INTERAVLENGTH((NSECELLIB+1),ITER),'|',ITER=1,2)
WRITE(KUNIT,'(T2,A1,36A1,A1,3(F4.2,A2),2(F5.1,A1),T89,A1)')
+ '|',(' ',ITER=1,36),'|',(INTERCORR(ITSEC),' |',ITSEC=1,
+ NSECELLIB),INTERQ3,'|',INTERSQ,'|','|'
WRITE(KUNIT,'(T2,A1,36A1,A1,3A6,2A6,T70,A)')
+ '+',('-',ITER=1,36),'+',('-----+',ITER=1,NSECELLIB),
+ ('*****+',ITER=1,2),'-------------------+'
C----------------------------------------
C---- 4 secondary structures -----
C----------------------------------------
ELSEIF (NSECELLIB.EQ.4) THEN
C------- header
WRITE(KUNIT,'(T2,A1,16A1,A1,50A1,A1,T71,A)')
+ '+',('-',ITER=1,16),'+',('-',ITER=1,50),'+',
+ '-------------------+'
WRITE(KUNIT,'(T2,A2,A7,A1,I5,T19,A9,40A1,T70,A1,T71,A14,T90,
+ A1)')'| ',INTERNAME,':',NUMRESLIB,'| method:',
+ (INTERTITLE(ITER),ITER=1,40),'|',' segments','|'
WRITE(KUNIT,'(T2,A1,16A1,A1,18A1,A2,14A1,A1,14A1,A2,T71,2A10)')
+ '+',('-',ITER=1,16),'+',('-',ITER=1,18),'+-',('-',ITER=1,
+ 14),'+',('-',ITER=1,14),'-+',('---------+',ITER=1,2)
WRITE(KUNIT,'(T2,A,T39,A,T54,A1,A,T70,A1,2A10)')
+ '| number of residues with H,E,T,L |',
+ ' % of DSSP','|',' % of Net','|',' number |',
+ 'av length|'
WRITE(KUNIT,'(T2,A7,5A6,8A4,T71,4A5)')'+-----+',('-----+',
+ ITER=1,(NSECELLIB+1)),('---+',ITER=1,2*NSECELLIB),
+ ('----+',ITER=1,4)
WRITE(KUNIT,'(T2,A7,5A6,8A4,T71,4A5)')
+ '| |','net H|','net E|','net T|','net L|','sum o|',
+ ' H |','E |',' T |',' L |',' H |',' E |',' T |',' L |',
+ 'DSSP|',' Net|','DSSP|',' Net|'
WRITE(KUNIT,'(T2,A7,5A6,8A4,T71,4A5)')'+-----+',('-----+',
+ ITER=1,(NSECELLIB+1)),('---+',ITER=1,2*NSECELLIB),
+ ('----+',ITER=1,4)
C------- number for all secondary elements
INTERDSSP(1)='|obs H|'
INTERDSSP(2)='|obs E|'
INTERDSSP(3)='|obs T|'
INTERDSSP(4)='|obs L|'
DO ITSEC=1,NSECELLIB
WRITE(KUNIT,'(T2,A7,5(I5,A1),8(I3,A1),
+ T71,2(I4,A1),2(F4.1,A1))')
+ INTERDSSP(ITSEC),(MATNUM(ITSEC,ITER),'|',ITER=1,
+ (NSECELLIB+1)),(INT(MATQOFDSSP(ITSEC,ITER)),'|',ITER=1,
+ NSECELLIB),(INT(MATQOFPRED(ITSEC,ITER)),'|',ITER=1,
+ NSECELLIB),(MATLEN(ITSEC,ITER),'|',ITER=1,2),
+ (INTERAVLENGTH(ITSEC,ITER),'|',ITER=1,2)
END DO
C------- sums
WRITE(KUNIT,'(T2,A7,5A6,A32,T71,4A5)')'+-----+',('-----+',
+ ITER=1,(NSECELLIB+1)),'---+--++---++--+--++---++--+---+',
+ ('----+',ITER=1,4)
WRITE(KUNIT,'(T2,A7,5(I5,A1),A1,4A6,A7,
+ T71,2(I4,A1),2(F4.1,A1))')
+ '|sum N|',(MATNUM((NSECELLIB+1),ITER),'|',ITER=1,
+ (NSECELLIB+1)),' ','cor H|','cor E|','cor T|','cor L|',
+ ' Q3 |',(MATLEN((NSECELLIB+1),ITER),'|',ITER=1,2),
+ (INTERAVLENGTH((NSECELLIB+1),ITER),'|',ITER=1,2)
WRITE(KUNIT,'(T2,A1,35A1,A2,4(F5.2,A1),F6.1,A1,T90,A1)')
+ '|',(' ',ITER=1,35),'| ',(INTERCORR(ITSEC),'|',ITSEC=1,
+ NSECELLIB),INTERQ3,'|','|'
WRITE(KUNIT,'(T2,A1,35A1,A2,4A6,A7,T71,A)')
+ '+',('-',ITER=1,35),'+-',('-----+',ITER=1,NSECELLIB),
+ '******+','-------------------+'
END IF
END
***** end of STABLEPOLENFILE
***** ------------------------------------------------------------------
***** SUB STABLESEG
***** ------------------------------------------------------------------
C----
C---- NAME : STABLESEG
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Nov, 1992 version 0.1 *
* changed: Mar, 1993 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: The results of the analysis of overlapping, resp.*
* -------- correct segments is written onto unit KUNIT *
* input variables:KUNIT, NSECELLIB, MAXNSECEL, NUMSEGOVERL *
* called by: SEVALSEG (in lib-prot.f) *
*----------------------------------------------------------------------*
SUBROUTINE STABLESEG(KUNIT,NSECELLIB,MAXNSECEL,
+ PROTNAME,NUMSEGOVERL,QSEGLOV,QSEGSOV,QSEGFOV,DEVNOM)
IMPLICIT NONE
C---- variables passed
INTEGER MAXNSECEL,NSECELLIB,KUNIT,
+ NUMSEGOVERL(1:9,1:(MAXNSECEL+1)),DEVNOM
REAL QSEGLOV(1:2,1:(MAXNSECEL+1)),
+ QSEGSOV(1:2,1:(MAXNSECEL+1)),QSEGFOV(1:2,1:(MAXNSECEL+1))
CHARACTER*222 PROTNAME
C---- local variables *
INTEGER ITER,ITSEC,ICOUNT,IBEG,IEND
REAL*4 ROVERL(1:2,1:10)
CHARACTER*10 TXT1(1:5)
CHARACTER*11 TXTFOV
CHARACTER*7 INTERNAME
******------------------------------*-----------------------------******
* MUE,ITER serve as iteration variables *
* NUMSEGOVERL(i,j) number of overlapping/correct segments *
* i=1 number of DSSP segments in secondary structure *
* j, for last: sum over all *
* i=2 number of residues in structure i, summed up over*
* all segments (in i=1) *
* i=3 number of predicted segments in class j *
* i=4 number of residues in structure i, summed up over*
* all segments (in i=1) for the prediction *
* i=5 number of overlapping predicted segments related *
* to those being observed. Correct means: *
* overlap >= length of segment / 2, for H, E, T *
* and for loop: at least loop of 2, resp 1, if the*
* DSSP loop is 1. *
* i=6 number of overlapping segments multiplied by *
* length: related to %observed *
* i=7 same as 5, but other way round: %pred! *
* i=8 same as 6, but other way round: %pred! *
* j, for last: sum over all *
* i=9 number of correct segments: *
* L +/- 1, and shift by 1, if L<=5 *
* L +/- 1, and shift by 2, if 510 *
* noted: j, for last: sum over all *
* QSEGLOV(i,j) i=1: %observed *
* i=2: %predicted *
* j=1-4 (helix,strand,loop,3-states) *
* gives the loose overlap (half length overlap) *
* multiplication with length of segment, normali- *
* sation will be done by calling SBR with N=number *
* of all residues in the data set *
* QSEGSOV(i,j) i=1: %observed *
* i=2: %predicted *
* j=1-4 (helix,strand,loop,3-states) *
* gives the strict overlap *
* for L < 5: | L(OBS)-L(PRED) | <= 1 *
* .AND. shift by 1 allowed *
* for 5<=L<10: | L(OBS)-L(PRED) | <= 2 *
* .AND. shift by 2 allowed *
* for L >= 10: | L(OBS)-L(PRED) | <= 3 *
* .AND. shift by 3 allowed *
* multiplication with length of segment, normali- *
* sation will be done by calling SBR with N=number *
* of all residues in the data set *
* QSEGFOV(i,j) i=1: %observed *
* i=2: %predicted *
* j=1-4 (helix,strand,loop,3-states) *
* gives the fractional overlap: *
* overlapping length *
* as given by: ------------------ *
* common length *
* multiplication with length of segment, normali- *
* sation will be done by calling SBR with N=number *
* of all residues in the data set *
******------------------------------*-----------------------------******
C--------------------------------------------------
C---- writing the overlapping results -----
C--------------------------------------------------
TXT1(1)='% H'
TXT1(2)='% E'
TXT1(NSECELLIB)='% L'
IF (NSECELLIB.EQ.4) THEN
TXT1(3)='% T'
END IF
TXT1(NSECELLIB+1)='sum'
IF (DEVNOM.EQ.0) THEN
TXTFOV='| Fov0 |'
ELSEIF (DEVNOM.EQ.1) THEN
TXTFOV='| Fov1 |'
ELSEIF (DEVNOM.EQ.2) THEN
TXTFOV='| Fov2 |'
ELSEIF (DEVNOM.EQ.3) THEN
TXTFOV='| Fov3 |'
ELSEIF (DEVNOM.EQ.4) THEN
TXTFOV='| Fov4 |'
ELSEIF (DEVNOM.EQ.50) THEN
TXTFOV='| Fov50% |'
ELSEIF (DEVNOM.EQ.100) THEN
TXTFOV='| Fov100% |'
ELSE
TXTFOV='| frac ov |'
END IF
CALL SILEN_STRING(PROTNAME,IBEG,IEND)
ICOUNT=IEND-IBEG+1
IF ((ICOUNT+IBEG).LT.7) THEN
INTERNAME(1:ICOUNT+IBEG)=PROTNAME(1:ICOUNT+IBEG)
INTERNAME((ICOUNT+IBEG+1):7)=' '
ELSE
INTERNAME(1:7)=PROTNAME(1:7)
END IF
C---- take care about divisions by 0, non weighted measures
DO ITSEC=1,(NSECELLIB+1)
IF (NUMSEGOVERL(1,ITSEC).EQ.0) THEN
ROVERL(1,ITSEC)=0
ELSE
ROVERL(1,ITSEC)=
+ NUMSEGOVERL(5,ITSEC)/REAL(NUMSEGOVERL(1,ITSEC))
END IF
IF (NUMSEGOVERL(3,ITSEC).EQ.0) THEN
ROVERL(2,ITSEC)=0
ELSE
ROVERL(2,ITSEC)=
+ NUMSEGOVERL(7,ITSEC)/REAL(NUMSEGOVERL(3,ITSEC))
END IF
END DO
C--------------------------------------------------
C---- starting a hack!
C---- hack since the %predicted for NSECEL+1 (roverl(2,4)) seems to be
C---- wrong and I dont want to locate the bug:
NUMSEGOVERL(7,(NSECELLIB+1))=0
NUMSEGOVERL(3,(NSECELLIB+1))=0
DO ITSEC=1,NSECELLIB
NUMSEGOVERL(7,(NSECELLIB+1))=NUMSEGOVERL(7,(NSECELLIB+1))+
+ NUMSEGOVERL(7,ITSEC)
NUMSEGOVERL(3,(NSECELLIB+1))=NUMSEGOVERL(3,(NSECELLIB+1))+
+ NUMSEGOVERL(3,ITSEC)
END DO
IF (NUMSEGOVERL(3,(NSECELLIB+1)).EQ.0) THEN
ROVERL(2,ITSEC)=0
ELSE
ROVERL(2,(NSECELLIB+1))=
+ NUMSEGOVERL(7,ITSEC)/REAL(NUMSEGOVERL(3,ITSEC))
END IF
C---- end of hack!
C--------------------------------------------------
WRITE(KUNIT,'(T2,A)')'---'
IF (NSECELLIB.EQ.3) THEN
WRITE(KUNIT,'(T2,A,T10,A11,2A36)')'---','+---------+',
+ ('-----------------------------------+',ITER=1,2)
WRITE(KUNIT,'(T2,A,T10,A2,A7,A2,2A36)')'---',
+ '| ',INTERNAME,' |',
+ ' % of observed overlapping seg. |',
+ ' % of predicted overlapping seg. |'
WRITE(KUNIT,'(T2,A,T10,A11,8(A3,A1,A4,A1))')
+ '---','+---------+',
+ ('-----','+','----','+',ITSEC=1,2*(NSECELLIB+1))
WRITE(KUNIT,'(T2,A,T10,A11,8(A3,A1,A4,A1))')
+ '---','| |',
+ (TXT1(ITSEC),'|','Nobs','|',ITSEC=1,(NSECELLIB+1)),
+ (TXT1(ITSEC),'|','Nprd','|',ITSEC=1,(NSECELLIB+1))
WRITE(KUNIT,'(T2,A,T10,A11,8(A3,A1,A4,A1))')
+ '---','+---------+',
+ ('-----','+','----','+',ITSEC=1,2*(NSECELLIB+1))
WRITE(KUNIT,'(T2,A,T10,A11,8(I3,A1,I4,A1))')
+ '---','| no ov s |',
+ (INT(100*ROVERL(1,ITSEC)),'|',NUMSEGOVERL(1,ITSEC),'|',
+ ITSEC=1,(NSECELLIB+1)),
+ (INT(100*ROVERL(2,ITSEC)),'|',NUMSEGOVERL(3,ITSEC),'|',
+ ITSEC=1,(NSECELLIB+1))
WRITE(KUNIT,'(T2,A,T10,A11,8(I3,A1,I4,A1))')
+ '---','| Lov |',
+ (INT(QSEGLOV(1,ITSEC)),
+ '|',NUMSEGOVERL(2,ITSEC),'|',ITSEC=1,(NSECELLIB+1)),
+ (INT(QSEGLOV(2,ITSEC)),
+ '|',NUMSEGOVERL(4,ITSEC),'|',ITSEC=1,(NSECELLIB+1))
WRITE(KUNIT,'(T2,A,T10,A11,8(A3,A1,A4,A1))')
+ '---','+---------+',
+ ('-----','+','----','+',ITSEC=1,2*(NSECELLIB+1))
WRITE(KUNIT,'(T2,A,T10,A11,2(4(A3,A3,A3)))')
+ '---','| |',
+ ((' ',TXT1(ITSEC),' |',ITSEC=1,(NSECELLIB+1)),ITER=1,2)
WRITE(KUNIT,'(T2,A,T10,A11,8(A7,A2))')'---',
+ '+---------+',('-------','-+',ITSEC=1,2*(NSECELLIB+1))
WRITE(KUNIT,'(T2,A,T10,A11,8(F7.2,A2))')
+ '---','| Sov |',
+ (QSEGSOV(1,ITSEC),' |',ITSEC=1,(NSECELLIB+1)),
+ (QSEGSOV(2,ITSEC),' |',ITSEC=1,(NSECELLIB+1))
WRITE(KUNIT,'(T2,A,T10,A11,8(F7.2,A2))')'---',TXTFOV,
+ ((QSEGFOV(ITER,ITSEC),' |',ITSEC=1,(NSECELLIB+1)),
+ ITER=1,2)
WRITE(KUNIT,'(T2,A,T10,A11,8(A7,A2))')'---','+---------+',
+ ('-------','-+',ITSEC=1,2*(NSECELLIB+1))
ELSEIF (NSECELLIB.EQ.4) THEN
WRITE(KUNIT,'(T2,A,T10,2A40,T90,A1)')'---',
+ ('+---------------------------------------',ITER=1,2),'+'
WRITE(KUNIT,'(T2,A,T10,A,T50,A,T90,A1)')'---',
+ '| % of observed overlapping seg.',
+ '| % of predicted overlapping seg.','|'
WRITE(KUNIT,'(T2,A,T10,A1,2(4(A3,A1,A4,A1),A3,A1))')'---',
+ '+',(('-----','+','----','+',ITSEC=1,NSECELLIB),'---','+',
+ ITER=1,2)
WRITE(KUNIT,'(T2,A,T10,A1,2(4(A3,A1,A4,A1),A3,A1))')'---',
+ '|',(TXT1(ITSEC),'|','Nobs','|',ITSEC=1,NSECELLIB),
+ TXT1(NSECELLIB+1),'|',
+ (TXT1(ITSEC),'|','Nprd','|',ITSEC=1,NSECELLIB),
+ TXT1(NSECELLIB+1),'|'
WRITE(KUNIT,'(T2,A,T10,A1,2(4(A3,A1,A4,A1),A3,A1))')'---',
+ '+',(('-----','+','----','+',ITSEC=1,NSECELLIB),'---','+',
+ ITER=1,2)
WRITE(KUNIT,'(T2,A,T10,A1,2(4(I3,A1,I4,A1),I3,A1),A4)')
+ '---','|',(INT(100*ROVERL(1,ITSEC)),
+ '|',NUMSEGOVERL(1,ITSEC),'|',ITSEC=1,NSECELLIB),
+ INT(100*ROVERL(1,NSECELLIB)),'|',
+ (INT(100*ROVERL(2,ITSEC)),
+ '|',NUMSEGOVERL(3,ITSEC),'|',ITSEC=1,NSECELLIB),
+ INT(100*ROVERL(2,NSECELLIB)),'|',' no '
WRITE(KUNIT,'(T2,A,T10,A1,2(4(I3,A1,I4,A1),I3,A1),A4)')
+ '---','|',(INT(QSEGLOV(1,ITSEC)),
+ '|',NUMSEGOVERL(2,ITSEC),'|',ITSEC=1,NSECELLIB),
+ INT(QSEGLOV(1,(NSECELLIB+1))),'|',
+ (INT(QSEGLOV(2,ITSEC)),
+ '|',NUMSEGOVERL(4,ITSEC),'|',ITSEC=1,NSECELLIB),
+ INT(QSEGLOV(2,(NSECELLIB+1))),'|',' Lov'
WRITE(KUNIT,'(T2,A,T10,A1,2(4(A3,A1,A4,A1),A3,A1))')'---',
+ '+',(('-----','+','----','+',ITSEC=1,NSECELLIB),'---','+',
+ ITER=1,2)
WRITE(KUNIT,'(T2,A,A)')
+ '+-----+-----------------------------+'//
+ '+-----------------------------+'
WRITE(KUNIT,'(T2,A,A)')
+ '| | % H | % E | % T | % L | sum |'//
+ '| % H | % E | % T | % L | sum |'
WRITE(KUNIT,'(T2,A,A)')
+ '+-----+-----+-----+-----+-----+-----+'//
+ '+-----+-----+-----+-----+-----+'
WRITE(KUNIT,'(T2,A7,5(F5.1,A1),A1,5(F5.1,A1))')'|Sov |',
+ (QSEGSOV(1,ITSEC),'|',ITSEC=1,(NSECELLIB+1)),'|',
+ (QSEGSOV(2,ITSEC),'|',ITSEC=1,(NSECELLIB+1))
WRITE(KUNIT,'(T2,A1,A6,A1,5(F5.1,A1),A1,5(F5.1,A1))')
+ '|',TXTFOV(2:7),
+ '|',(QSEGFOV(1,ITSEC),'|',ITSEC=1,(NSECELLIB+1)),'|',
+ (QSEGFOV(2,ITSEC),'|',ITSEC=1,(NSECELLIB+1))
WRITE(KUNIT,'(T2,A,A)')
+ '+-----+-----+-----+-----+-----+-----+'//
+ '+-----+-----+-----+-----+-----+'
END IF
END
***** end of STABLESEG
***** ------------------------------------------------------------------
***** SUB STABLE_EXPNOINBIN
***** ------------------------------------------------------------------
C----
C---- NAME : STABLE_EXPNOINBIN
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Dec, 1993 version 0.1 *
* changed: Feb, 1994 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: For a set of proteins the average relative expo- *
* -------- sure per residue is computed (possibly for DSSP *
* and PRED). *
* in variables: NUMPROT,NUMRES *
* ------------- RESNAME,EXPDSSP,EXPPRED *
* output variab.: EXPDSSP_AV,EXPPRED_AV,EXPDSSP_AVSIGMA,EXPPRED_AVSI
*----------------------------------------------------------------------*
SUBROUTINE STABLE_EXPNOINBIN(KUNIT,CHVP1,EXP_NOINBIN,TXT,CHVPL)
IMPLICIT NONE
C---- variables passed
INTEGER KUNIT,EXP_NOINBIN(0:9,0:9),
+ CHVPM(1:50),CHVPL,CHVP1
CHARACTER*222 TXT
C---- local variables
INTEGER IT1,IT2,SUMDSSP(0:9),SUMPRED(0:9),SUM
REAL RTMP
LOGICAL LERRCHVP
******------------------------------*-----------------------------******
C---- default
C----------------------------------------------------------------------*
C---- initial check of variables passed -----*
C----------------------------------------------------------------------*
IF (CHVPL.NE.1) THEN
WRITE(6,'(T2,A,T10,A)')'***','WARNING: STABLE_EXPNOINBIN: '//
+ 'number of passed variables not fitting'
WRITE(6,'(T2,A,T10,A,T40,4I5)')'***',
+ 'they are: CHVPL: 1,2,3:',CHVPL,CHVP1
STOP
END IF
CHVPM(1)=CHVP1
C ---------------
CALL SCHECKPASS(CHVPM,CHVPL,LERRCHVP)
C CALL SCHECKPASS(LERRCHVP,CHVPL,CHVPM)
C ---------------
IF (LERRCHVP .EQV. .TRUE.) THEN
WRITE(6,'(T2,A,T10,A)')'***',
+ 'ERROR for STABLE_EXPNOINBIN: variables passed not correct !'
END IF
C---- check variables passed
C----------------------------------------------------------------------*
C---- end of checking variables -----*
C----------------------------------------------------------------------*
C--------------------------------------------------
C---- computing percentages/sums
C--------------------------------------------------
SUM=0
DO IT1=0,9
SUMDSSP(IT1)=0
SUMPRED(IT1)=0
DO IT2=0,9
SUMDSSP(IT1)=SUMDSSP(IT1)+EXP_NOINBIN(IT1,IT2)
SUMPRED(IT1)=SUMPRED(IT1)+EXP_NOINBIN(IT2,IT1)
END DO
SUM=SUM+SUMDSSP(IT1)
END DO
C--------------------------------------------------
C---- writing
C--------------------------------------------------
WRITE(KUNIT,'(T2,A)')'---'
WRITE(KUNIT,'(T2,A,T10,A,T40,A20)')'---','numbers per bin for:',
+ TXT
WRITE(KUNIT,'(T2,A)')'---'
WRITE(KUNIT,'(T2,A)')'no in bin'
WRITE(KUNIT,'(T2,A,T11,A1,T13,10I5,A4,A6,A7)')'pred:',
+ '|',(IT2,IT2=0,9),' | ',' SUM',' %DSSP'
WRITE(KUNIT,'(T2,9A1,A1,53A1,A1,16A1)')('-',IT1=1,9),'+',
+ ('-',IT1=1,53),'+',('-',IT1=1,16)
DO IT1=0,9
IF (SUM.NE.0) THEN
RTMP=100*SUMDSSP(IT1)/REAL(SUM)
ELSE
RTMP=0
END IF
WRITE(KUNIT,'(T2,A,T8,I1,T11,A1,T13,10I5,A4,I6,F7.1)')
+ 'DSSP ',IT1,'|',
+ (EXP_NOINBIN(IT1,IT2),IT2=0,9),
+ ' | ',SUMDSSP(IT1),RTMP
END DO
WRITE(KUNIT,'(T2,9A1,A1,53A1,A1,16A1)')('-',IT1=1,9),'+',
+ ('-',IT1=1,53),'+',('-',IT1=1,16)
WRITE(KUNIT,'(T2,A,T11,A1,T13,10I5,A4)')
+ 'PRED SUM','|',(SUMPRED(IT2),IT2=0,9),' | '
WRITE(KUNIT,'(T2,A,T11,A1,T13,10F5.1,A4)')
+ 'PRED %','|',(100*SUMPRED(IT2)/REAL(MIN(1,SUM)),IT2=0,9),
+ ' | '
WRITE(KUNIT,'(T2,9A1,A1,53A1,A1,16A1)')('-',IT1=1,9),'+',
+ ('-',IT1=1,53),'+',('-',IT1=1,16)
WRITE(KUNIT,'(T2,A)')'---'
END
***** end of STABLE_EXPNOINBIN
***** ------------------------------------------------------------------
***** SUB STABLE_EXPSTATES
***** ------------------------------------------------------------------
C----
C---- NAME : STABLE_EXPSTATES
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Mar, 1994 version 0.1 *
* changed: Mar, 1994 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: The percentages of 2state, 3state, 10state *
* -------- exposure accuracy are written for one protein. *
*----------------------------------------------------------------------*
SUBROUTINE STABLE_EXPSTATES(KUNIT,LTOPLINE,LBOTTOMLINE,
+ PROTNAME,CHVP1,EXP_NOINBIN,T2,T3A,T3B,CHVP2,EXP_NO2ST,
+ EXP_NO3ST,CHVP3,EXP_NO10ST,EXP_CORR,CHVPL)
IMPLICIT NONE
C---- variables passed
INTEGER KUNIT,EXP_NO2ST(1:3),EXP_NO3ST(1:4),
+ EXP_NO10ST(1:11),EXP_NOINBIN(0:9,0:9),T2,T3A,T3B,
+ CHVPM(1:50),CHVPL,CHVP1,CHVP2,CHVP3
REAL EXP_CORR
CHARACTER*222 PROTNAME
LOGICAL LTOPLINE,LBOTTOMLINE
C---- local functions
INTEGER FILEN_STRING,FIEXP_NOINBIN_SUM
REAL FRDIVIDE_SAFE
CHARACTER*222 FCUT_SPACES
C---- local variables
INTEGER IT1,IT2,ILEN,
+ NUMRES,TMPT2(1:3),TMPT3(1:4),INUM,ICHECK,ICOUNT
REAL RES2(1:5),RES3(1:7),RES10(1:20),RES10S(1:2)
CHARACTER*222 NAME6
CHARACTER*10 COBS,CPRED
LOGICAL LERRCHVP
******------------------------------*-----------------------------******
C---- default
C----------------------------------------------------------------------*
C---- initial check of variables passed -----*
C----------------------------------------------------------------------*
IF (CHVPL.NE.3) THEN
WRITE(6,'(T2,A,T10,A)')'***','WARNING: STABLE_EXPSTATES'//
+ ': number of passed variables not fitting'
WRITE(6,'(T2,A,T10,A,T40,4I5)')'***',
+ 'they are: CHVPL: 1,2,3:',CHVPL,CHVP1,CHVP2,CHVP3
STOP
END IF
CHVPM(1)=CHVP1
CHVPM(2)=CHVP2
CHVPM(3)=CHVP3
C ---------------
CALL SCHECKPASS(CHVPM,CHVPL,LERRCHVP)
C CALL SCHECKPASS(LERRCHVP,CHVPL,CHVPM)
C ---------------
IF (LERRCHVP .EQV. .TRUE.) THEN
WRITE(6,'(T2,A,T10,A)')'***',
+ 'ERROR for STABLE_EXPSTATES: variables passed not correct !'
END IF
C---- check variables passed
IF ( (T2.LT.0).OR.(T2.GT.10).OR.
+ (T3A.LT.0).OR.(T3A.GT.10).OR.
+ (T3B.LT.0).OR.(T3B.GT.10) ) THEN
WRITE(6,'(T2,A,T10,A)')'***','STABLE_EXPSTATES: '//
+ 'thresholds wrong! '
WRITE(6,'(T2,A,T10,A,T20,i3,a,t30,i3,A,T40,I3)')
+ '***','T2= ',T2,' T3A = ',T3A,' T3B = ',T3B
STOP
END IF
C----------------------------------------------------------------------*
C---- end of checking variables -----*
C----------------------------------------------------------------------*
C---- defaults
COBS='obs'
CPRED='pred'
TMPT2(1)=0
TMPT2(2)=T2
TMPT2(3)=10
TMPT3(1)=0
TMPT3(2)=T3A
TMPT3(3)=T3B
TMPT3(4)=10
C---- cut off spaces:
ILEN=FILEN_STRING(PROTNAME)
IF (ILEN.LT.6) THEN
NAME6(1:ILEN)=FCUT_SPACES(PROTNAME)
NAME6((ILEN+1):6)=' '
ELSE
NAME6(1:6)=FCUT_SPACES(PROTNAME)
END IF
C---- headline
IF (LTOPLINE .EQV. .TRUE.) THEN
WRITE(KUNIT,'(A1,6A1,A2,21A1,A2,29A1,A2,8A1,A2,2(6A1,A2))')
+ '+',('-',IT1=1,6),'-+',('-',IT1=1,21),'-+',
+ ('-',IT1=1,29),'-+',('-',IT1=1,8),'-+',
+ (('-',IT1=1,6),'-+',IT2=1,2)
WRITE(KUNIT,'(A1,A,T9,A1,A5,4A4,A2,A5,6A4,A2,
+ 2A4,A2,A6,A2,A6,A2)')'|','name','|',
+ ' Q2 ',' b%o',' %p',' e%o',' %p',' |',
+ ' Q3 ',' b%o',' %p',' i%o',' %p ',' e%o',
+ ' %p',' |','Q10o',' %p',' |',
+ ' c10 ',' |',' N',' |'
WRITE(KUNIT,'(A1,6A1,A2,21A1,A2,29A1,A2,8A1,A2,2(6A1,A2))')
+ '+',('-',IT1=1,6),'-+',('-',IT1=1,21),'-+',
+ ('-',IT1=1,29),'-+',('-',IT1=1,8),'-+',
+ (('-',IT1=1,6),'-+',IT2=1,2)
END IF
C--------------------------------------------------
C---- computing percentages
C--------------------------------------------------
NUMRES=0
ICHECK=0
DO IT1=1,2
INUM=FIEXP_NOINBIN_SUM(EXP_NOINBIN,TMPT2(IT1),TMPT2(IT1+1),
+ COBS)
NUMRES=NUMRES+INUM
RES2((IT1-1)*2+1)=100*FRDIVIDE_SAFE(REAL(EXP_NO2ST(IT1)),
+ REAL(INUM))
INUM=FIEXP_NOINBIN_SUM(EXP_NOINBIN,TMPT2(IT1),TMPT2(IT1+1),
+ CPRED)
RES2((IT1-1)*2+2)=100*FRDIVIDE_SAFE(REAL(EXP_NO2ST(IT1)),
+ REAL(INUM))
ICHECK=ICHECK+INUM
END DO
RES2(5)=100*FRDIVIDE_SAFE(REAL(EXP_NO2ST(3)),REAL(NUMRES))
C---- consistency check
IF (ICHECK.NE.NUMRES) THEN
WRITE(6,'(T2,A,T10,A)')'***','STABLE_EXPSTATES '//
+ 'ERROR not same number for observed and predicted!'
WRITE(6,'(T2,A,T10,A,T20,I5,A,T40,I5)')'***',
+ 'NUMRES = ',NUMRES,' ICHECK = ',ICHECK
DO IT1=0,9
WRITE(kunit,'(T10,10I5)')(EXP_NOINBIN(IT1,IT2),IT2=0,9)
END DO
STOP
END IF
DO IT1=1,3
INUM=FIEXP_NOINBIN_SUM(EXP_NOINBIN,TMPT3(IT1),TMPT3(IT1+1),
+ COBS)
RES3((IT1-1)*2+1)=100*FRDIVIDE_SAFE(REAL(EXP_NO3ST(IT1)),
+ REAL(INUM))
INUM=FIEXP_NOINBIN_SUM(EXP_NOINBIN,TMPT3(IT1),TMPT3(IT1+1),
+ CPRED)
RES3((IT1-1)*2+2)=100*FRDIVIDE_SAFE(REAL(EXP_NO3ST(IT1)),
+ REAL(INUM))
END DO
RES3(7)=100*FRDIVIDE_SAFE(REAL(EXP_NO3ST(4)),REAL(NUMRES))
RES10S(1)=0
RES10S(2)=0
ICOUNT=0
DO IT1=1,10
INUM=FIEXP_NOINBIN_SUM(EXP_NOINBIN,(IT1-1),IT1,COBS)
RES10((IT1-1)*2+1)=100*FRDIVIDE_SAFE(REAL(EXP_NO10ST(IT1)),
+ REAL(INUM))
RES10S(1)=RES10S(1)+REAL(EXP_NO10ST(IT1))
INUM=FIEXP_NOINBIN_SUM(EXP_NOINBIN,(IT1-1),IT1,CPRED)
RES10((IT1-1)*2+2)=100*FRDIVIDE_SAFE(REAL(EXP_NO10ST(IT1)),
+ REAL(INUM))
RES10S(2)=RES10S(2)+RES10((IT1-1)*2+2)
IF (INUM.GT.0) THEN
ICOUNT=ICOUNT+1
END IF
END DO
RES10S(1)=100*FRDIVIDE_SAFE(RES10S(1),REAL(NUMRES))
RES10S(2)=FRDIVIDE_SAFE(RES10S(2),REAL(ICOUNT))
C--------------------------------------------------
C---- writing percentages
C--------------------------------------------------
WRITE(KUNIT,'(A1,A,T9,A1,F5.1,4I4,A2,F5.1,6I4,A2,
+ 2I4,A2,F6.3,A2,I6,A2)')'|',NAME6,'|',
+ RES2(5),(INT(RES2(IT1)),IT1=1,4),' |',
+ RES3(7),(INT(RES3(IT1)),IT1=1,6),' |',
+ (INT(RES10S(IT1)),IT1=1,2),' |',EXP_CORR,' |',NUMRES,' |'
C--------------------------------------------------
C---- write bottom line?
IF (LBOTTOMLINE .EQV. .TRUE.) THEN
WRITE(KUNIT,'(A1,6A1,A2,21A1,A2,29A1,A2,8A1,A2,2(6A1,A2))')
+ '+',('-',IT1=1,6),'-+',('-',IT1=1,21),'-+',
+ ('-',IT1=1,29),'-+',('-',IT1=1,8),'-+',
+ (('-',IT1=1,6),'-+',IT2=1,2)
END IF
END
***** end of STABLE_EXPSTATES
***** ------------------------------------------------------------------
***** SUB STABLE_QILS
***** ------------------------------------------------------------------
C----
C---- NAME : STABLE_QILS
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Apr, 1993 version 0.1 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: The pay-offs of a certain prediction are written *
* -------- as a table onto unit KUNIT: *
* in variables: NSECEL, MAXNSECEL, KUNIT, NUMRES, PROTNAME, TITLE*
* ------------- MATNUM, MATLEN, NUMSEGOVERL, *
* MATQOFDSSP,MATQOFPRED,Q3,SQ,CORR,INFO,INFO_INV, *
* QSEGLOV,QSEGSOV,QSEGFOV,DEVNOM,CHVPL *
* called by: typically SEVALSEG, resp. Xevalpred *
* SBRs calling: from lib-prot.f: *
* -------------- SEVALQUO, SEVALINFOFILE *
* from lib-unix.f: *
* SCHECKPASS *
* from lib-comp.f: *
* SISTZ1, SRSTZ2, SILEN_STRING *
* from lib-prot.f: *
*----------------------------------------------------------------------*
SUBROUTINE STABLE_QILS(KUNIT,NSECEL,MAXNSECEL,NUMRES,CHVP1,
+ PROTNAME,TITLE,CHVP2,MATNUM,MATLEN,CHVP3,
+ MATQOFDSSP,MATQOFPRED,Q3,SQ,CORR,INFO,INFO_INV,CHVP4,
+ QSEGSOV,QSEGFOV,DEVNOM,CHVPL)
IMPLICIT NONE
C---- variables passed
INTEGER CHVPM(1:50),CHVPL,CHVP1,CHVP2,CHVP3,CHVP4,
+ MAXNSECEL,NSECEL,NUMRES,KUNIT,
+ MATNUM(1:(MAXNSECEL+1),1:(MAXNSECEL+1)),
+ MATLEN(1:(MAXNSECEL+1),1:4),DEVNOM
REAL MATQOFDSSP(1:MAXNSECEL,1:MAXNSECEL),
+ MATQOFPRED(1:MAXNSECEL,1:MAXNSECEL),
+ CORR(1:MAXNSECEL),Q3,SQ,INFO,INFO_INV,
+ QSEGSOV(1:2,1:(MAXNSECEL+1)),QSEGFOV(1:2,1:(MAXNSECEL+1))
CHARACTER*222 TITLE,PROTNAME
C---- local variables *
INTEGER ITER,ITSEC,ILEN,IBEG,IEND,ICOUNT
REAL INTERAVLENGTH(1:8,1:2)
CHARACTER*222 INTERTITLE
CHARACTER*7 INTERNAME
CHARACTER*10 INTERDSSP(1:8)
CHARACTER*11 TXTFOV
LOGICAL LFLAG,LERRCHVP
******------------------------------*-----------------------------******
*--------------------- *
* passed variables *
* KUNIT number of unit to write the files upon *
* MAXNSECEL maximal number of secondary structures for array *
* boundaries *
* NSECEL number of secondary structure types used *
* PROTNAME the name of the chain for which the class is *
* determined *
*--------------------- *
* local variables *
* ITSEC,ITER iteration variables *
* INTERAVLENGTH(i,k) intermediately store average length of elements
* (required to avoid division by zero) *
* CORR(i) correlation for class i, (Mathews) *
* Q3 =properly predicted for all classes/all residues *
* SQ first divide predicted/DSSP in each class then *
* sum all classes and divide by e.g. 3 *
* INTERTITLE intermediate variable storing a character 40 with*
* the title (potentially truncated) *
* KUNIT =6, or 10, according to whether the table is to *
* be written onto printer or into a file (FILETABLE)
* MATLEN(i,j) matrix with the lengths of the elements: *
* i=1,4 => H,E,C,all *
* j=1 => number of elements DSSP *
* j=2 => number of elements PRED *
* j=2 => summed length of all elements for DSSP *
* j=2 => summed length of all elements for PRED *
* MATNUM(i,j) the number of residues in a certain secondary *
* structure, i labels DSSP assignment, i.e. all *
* numbers with i=1 are according to DSSP helices, *
* j labels the prediction. That means, e.g.: *
* MATNUM(1,1) are all DSSP helices predicted to be *
* a helix, MATNUM(1,2) those DSSP helices predicted*
* as strands and MATNUM(1,4) all DSSP helices, resp.
* MATNUM(4,4) all residues predicted. *
* MATOFDSSP(i,j) stores according to the same scheme as MATNUM the*
* percentages of residues predicted divided by the *
* numbers of DSSP (note there is no element (4,4) )*
* MATOFPRED(i,j) same as previous but now percentages of prediction
* MAXNSECEL maximal number of secondary structures allowed *
* NSECEL currently read number of secondary structures *
* NUMRES number of residues of protein for current table *
* PROTNAME the name of the protein for current table *
* QSEGSOV(i,j) i=1: %observed *
* i=2: %predicted *
* j=1-4 (helix,strand,loop,3-states) *
* gives the strict overlap *
* for L < 5: | L(OBS)-L(PRED) | <= 1 *
* .AND. shift by 1 allowed *
* for 5<=L<10: | L(OBS)-L(PRED) | <= 2 *
* .AND. shift by 2 allowed *
* for L >= 10: | L(OBS)-L(PRED) | <= 3 *
* .AND. shift by 3 allowed *
* multiplication with length of segment, normali- *
* sation will be done by calling SBR with N=number *
* of all residues in the data set *
* QSEGFOV(i,j) i=1: %observed *
* i=2: %predicted *
* j=1-4 (helix,strand,loop,3-states) *
* gives the fractional overlap: *
* overlapping length *
* as given by: ------------------ *
* common length *
* multiplication with length of segment, normali- *
* sation will be done by calling SBR with N=number *
* of all residues in the data set *
* TITLE title of job which generated the prediction *
******------------------------------*-----------------------------******
C----------------------------------------------------------------------
C---- check the size of the quantities passed: -----
C---- if Q3=SQ=0 and MATNUM(i,i) not 0 --> compute newly -----
C----------------------------------------------------------------------
IF (CHVPL.NE.4) THEN
WRITE(6,'(T2,A,T10,A)')'***',
+ 'WARNING: SEVALSEG: number of passed variables not fitting'
END IF
CHVPM(1)=CHVP1
CHVPM(2)=CHVP2
CHVPM(3)=CHVP3
CHVPM(4)=CHVP4
C ---------------
CALL SCHECKPASS(CHVPM,CHVPL,LERRCHVP)
C ---------------
IF (LERRCHVP .EQV. .TRUE.) THEN
WRITE(6,'(T2,A,T10,A)')'***',
+ 'ERROR for SEVALSEG: variables passed not correct !'
END IF
C---- check variables passed
IF (NSECEL.GT.MAXNSECEL) THEN
WRITE(6,'(T2,A,T10,A,A)')'***','ERROR: The number of '//
+ 'secondary structures passed to SBR STABLE_QILS'
WRITE(6,'(t2,A,T10,A)')'***',
+ 'exceeds the locally allocated array dimensions.'
WRITE(6,'(T5,A,T25,I4,T30,A,T40,I4)')
+ ' Current number: ',NSECEL,' allocated:',MAXNSECEL
WRITE(6,'(T5,A)')' Stopped at 31-3-93a'
STOP
END IF
C---- end of initially checking consistency of ----
C---- variables passed -----
C--------------------------------------------------
C--------------------------------------------------
C---- if the quotient Q3 passed 0, call SBR -----
C--------------------------------------------------
LFLAG=.TRUE.
IF ((Q3.EQ.0.).AND.(SQ.EQ.0.)) THEN
DO ITSEC=1,NSECEL
IF (LFLAG.EQV. .TRUE. .AND.(MATNUM(ITSEC,ITSEC).NE.0)) THEN
LFLAG=.FALSE.
END IF
END DO
IF (LFLAG.EQV. .FALSE.) THEN
C =============
CALL SEVALQUO(NSECEL,MAXNSECEL,MATNUM,MATQOFDSSP,
+ MATQOFPRED,Q3,SQ,CORR)
C =============
LFLAG=.FALSE.
C ==============
CALL SEVALINFOFILE(6,NSECEL,MAXNSECEL,
+ MATNUM,INFO,INFO_INV,LFLAG)
C ==============
END IF
END IF
C--------------------------------------------------
C---- check length of Protname and Title -----
C--------------------------------------------------
C---- count length of string 'TITLE'
CALL SILEN_STRING(TITLE,IBEG,IEND)
ILEN=IEND-IBEG+1
IF (ILEN.LT.40) THEN
INTERTITLE(1:ILEN)=TITLE(IBEG:IEND)
DO ITER=(ILEN+1),40
INTERTITLE(ITER:ITER)=' '
END DO
ELSE
INTERTITLE(1:40)=TITLE(IBEG:IBEG+39)
END IF
C---- length of protein name ok?
CALL SILEN_STRING(PROTNAME,IBEG,IEND)
ICOUNT=IEND-IBEG+1
IF ((ICOUNT+IBEG).LT.7) THEN
INTERNAME(1:ICOUNT+IBEG)=PROTNAME(1:ICOUNT+IBEG)
INTERNAME((ICOUNT+IBEG+1):7)=' '
ELSE
INTERNAME(1:7)=PROTNAME(1:7)
END IF
C---- assign names for txt used in table
IF (DEVNOM.EQ.0) THEN
TXTFOV='| Fov0 |'
ELSEIF (DEVNOM.EQ.1) THEN
TXTFOV='| Fov1 |'
ELSEIF (DEVNOM.EQ.2) THEN
TXTFOV='| Fov2 |'
ELSEIF (DEVNOM.EQ.3) THEN
TXTFOV='| Fov3 |'
ELSEIF (DEVNOM.EQ.4) THEN
TXTFOV='| Fov4 |'
ELSEIF (DEVNOM.EQ.50) THEN
TXTFOV='| Fov50% |'
C changed 1-8-95
TXTFOV='| SOV |'
ELSEIF (DEVNOM.EQ.100) THEN
TXTFOV='| Fov100% |'
ELSE
TXTFOV='| frac ov |'
END IF
C--------------------------------------------------
C---- check length of Protname and Title -----
C--------------------------------------------------
C---- avoid division by zero for average lengths!
DO ITER=1,2
DO ITSEC=1,(NSECEL+1)
IF (MATLEN(ITSEC,ITER).NE.0) THEN
INTERAVLENGTH(ITSEC,ITER)=
+ MATLEN(ITSEC,(2+ITER))/REAL(MATLEN(ITSEC,ITER))
ELSE
INTERAVLENGTH(ITSEC,ITER)=0
END IF
END DO
END DO
C----------------------------------------------------------------------
C---- TABLE -----
C----------------------------------------------------------------------
C--------------------------------------------------
C---- 3 secondary structures -----
C--------------------------------------------------
IF (NSECEL.EQ.3) THEN
C----------------------------------------
C------- single residue quotients -----
C----------------------------------------
C------- header
WRITE(KUNIT,'(T2,A1,17A1,A1,48A1,A1,T70,A)')
+ '+',('-',ITER=1,17),'+',('-',ITER=1,48),'+',
+ '-------------------+'
WRITE(KUNIT,'(T2,A2,A7,A1,I6,T20,A9,A39,T69,A1,T70,A14,T89,
+ A1)')'| ',INTERNAME,':',NUMRES,'| method:',
+ INTERTITLE,'|',' segments','|'
WRITE(KUNIT,'(T2,A1,17A1,A1,48A1,A1,T70,A)')
+ '+',('-',ITER=1,17),'+',('-',ITER=1,48),'+',
+ '-------------------+'
WRITE(KUNIT,'(T2,A,T40,A,T57,A1,A,T69,A1,T70,2A10)')
+ '| number of residues with H,E,C |',
+ ' % of DSSP','|',' % of Net','|',' number |',
+ 'av length|'
WRITE(KUNIT,'(T2,A1,A,T12,4A7,3A6,3A4,T70,4A5)')
+ '+','--------+',('------+',ITER=1,(NSECEL+1)),
+ ('-----+',ITER=1,NSECEL),('---+',ITER=1,NSECEL),
+ ('----+',ITER=1,4)
WRITE(KUNIT,'(T2,A10,4A7,3A6,3A4,T70,4A5)')
+ '| |','net H |','net E |','net C |','sum DS|',
+ ' H |',' E |',' C |',' H |',' E |',' C |',
+ 'DSSP|',' Net|','DSSP|',' Net|'
WRITE(KUNIT,'(T2,A1,A,T12,4A7,3A6,3A4,T70,4A5)')
+ '+','--------+',('------+',ITER=1,(NSECEL+1)),
+ ('-----+',ITER=1,NSECEL),('---+',ITER=1,NSECEL),
+ ('----+',ITER=1,4)
C------- number for all secondary elements
INTERDSSP(1)='| DSSP H |'
INTERDSSP(2)='| DSSP E |'
INTERDSSP(3)='| DSSP C |'
DO ITSEC=1,NSECEL
WRITE(KUNIT,'(T2,A10,4(I6,A1),3(F5.1,A1),3(I3,A1),
+ T70,2(I4,A1),2(F4.1,A1))')
+ INTERDSSP(ITSEC),
+ (MATNUM(ITSEC,ITER),'|',ITER=1,(NSECEL+1)),
+ (MATQOFDSSP(ITSEC,ITER),'|',ITER=1,NSECEL),
+ (INT(MATQOFPRED(ITSEC,ITER)),'|',ITER=1,NSECEL),
+ (MATLEN(ITSEC,ITER),'|',ITER=1,2),
+ (INTERAVLENGTH(ITSEC,ITER),'|',ITER=1,2)
END DO
C------- sums
WRITE(KUNIT,'(T2,A1,A,T12,4A7,3A6,3A4,T70,4A5)')
+ '+','--------+',('------+',ITER=1,(NSECEL+1)),
+ ('-----+',ITER=1,NSECEL),'---+','-+-+','---+',
+ ('----+',ITER=1,4)
WRITE(KUNIT,'(T2,A10,4(I6,A1),3A6,2A6,T70,2(I4,A1),2(F4.1,
+ A1))')
+ '| sum Net|',
+ (MATNUM((NSECEL+1),ITER),'|',ITER=1,(NSECEL+1)),
+ 'corH |','corE |','corC |',' Q3 |',
+ ' SQ |',(MATLEN((NSECEL+1),ITER),'|',ITER=1,2),
+ (INTERAVLENGTH((NSECEL+1),ITER),'|',ITER=1,2)
WRITE(KUNIT,'(T2,A1,36A1,A1,3(F4.2,A2),2(F5.1,A1),T89,A1)')
+ '|',(' ',ITER=1,36),'|',(CORR(ITSEC),' |',ITSEC=1,
+ NSECEL),Q3,'|',SQ,'|','|'
C WRITE(KUNIT,'(T2,A1,36A1,A1,3A6,2A6,T70,A)')
C + '+',('-',ITER=1,36),'+',('-----+',ITER=1,NSECEL),
C + ('*****+',ITER=1,2),'-------------------+'
WRITE(KUNIT,'(T2,A,A)')
+ '+---------+--------------------------++'//
+ '+---+-----+-----++****+*****+-------------------+'
C------- information
C WRITE(KUNIT,'(T57,A10,F6.3,A9,F6.3,A2)')
C + '| I %obs= ',INFO,', %pred= ',INFO_INV,' |'
C WRITE(KUNIT,'(T57,A)')
C + '+-------------------------------+'
C WRITE(KUNIT,'(T2,A)')'---'
C------- end of single residue stuff ----
C----------------------------------------
C----------------------------------------
C------- segment based measures -----
C----------------------------------------
WRITE(KUNIT,'(T2,A,A)')
+ '| segments| % of observed |'//
+ '| % of predicted | information |'
WRITE(KUNIT,'(T2,A,A)')
+ '+---------+------+------+------+------+'//
+ '+------+------+------+------+---------+---------+'
WRITE(KUNIT,'(T2,A,A)')
+ '| measure | % H | % E | % L | sum |'//
+ '| % H | % E | % L | sum | I %obs | I %pred |'
WRITE(KUNIT,'(T2,A,A)')
+ '+---------+------+------+------+------+'//
+ '+------+------+------+------+---------+---------+'
C commented out 1-8-95
if (1.eq.0) then
WRITE(KUNIT,'(T2,A11,4(F5.1,A2),A1,4(F5.1,A2),
+ T70,2(F6.3,A4))')'| Sov |',
+ (QSEGSOV(1,ITSEC),' |',ITSEC=1,(NSECEL+1)),'|',
+ (QSEGSOV(2,ITSEC),' |',ITSEC=1,(NSECEL+1)),
+ INFO,' |',INFO_INV,' |'
endif
C changed 5.8.95
C WRITE(KUNIT,'(T2,A11,4(F5.1,A2),A1,4(F5.1,A2),
C + T70,2(A5,I3,A2))')TXTFOV,
C + (QSEGFOV(1,ITSEC),' |',ITSEC=1,(NSECEL+1)),'|',
C + (QSEGFOV(2,ITSEC),' |',ITSEC=1,(NSECEL+1)),
C + ' ',INT(100*INFO/0.62),'%|',
C + ' ',INT(100*INFO_INV/0.62),'%|'
WRITE(KUNIT,'(T2,A11,4(F5.1,A2),A1,4(F5.1,A2),
+ T70,2(F4.2,A1,I3,A2))')TXTFOV,
+ (QSEGFOV(1,ITSEC),' |',ITSEC=1,(NSECEL+1)),'|',
+ (QSEGFOV(2,ITSEC),' |',ITSEC=1,(NSECEL+1)),
+ INFO,' ',INT(100*INFO/0.62),'%|',
+ INFO_INV,' ',INT(100*INFO_INV/0.62),'%|'
WRITE(KUNIT,'(T2,A,A)')
+ '+---------+------+------+------+------+'//
+ '+------+------+------+------+---------+---------+'
C--------------------------------------------------
C---- end of 3 secondary structures -----
C--------------------------------------------------
C----------------------------------------
C---- 4 secondary structures -----
C----------------------------------------
ELSEIF (NSECEL.EQ.4) THEN
C------- header
WRITE(KUNIT,'(T2,A1,16A1,A1,50A1,A1,T71,A)')
+ '+',('-',ITER=1,16),'+',('-',ITER=1,50),'+',
+ '-------------------+'
WRITE(KUNIT,'(T2,A2,A7,A1,I5,T19,A9,A40,T70,A1,T71,A14,T90,
+ A1)')'| ',INTERNAME,':',NUMRES,'| method:',
+ INTERTITLE,'|',' segments','|'
WRITE(KUNIT,'(T2,A1,16A1,A1,18A1,A2,14A1,A1,14A1,A2,T71,2A10)')
+ '+',('-',ITER=1,16),'+',('-',ITER=1,18),'+-',('-',ITER=1,
+ 14),'+',('-',ITER=1,14),'-+',('---------+',ITER=1,2)
WRITE(KUNIT,'(T2,A,T39,A,T54,A1,A,T70,A1,2A10)')
+ '| number of residues with H,E,T,L |',
+ ' % of DSSP','|',' % of Net','|',' number |',
+ 'av length|'
WRITE(KUNIT,'(T2,A7,5A6,8A4,T71,4A5)')'+-----+',('-----+',
+ ITER=1,(NSECEL+1)),('---+',ITER=1,2*NSECEL),
+ ('----+',ITER=1,4)
WRITE(KUNIT,'(T2,A7,5A6,8A4,T71,4A5)')
+ '| |','net H|','net E|','net T|','net L|','sum o|',
+ ' H |','E |',' T |',' L |',' H |',' E |',' T |',' L |',
+ 'DSSP|',' Net|','DSSP|',' Net|'
WRITE(KUNIT,'(T2,A7,5A6,8A4,T71,4A5)')'+-----+',('-----+',
+ ITER=1,(NSECEL+1)),('---+',ITER=1,2*NSECEL),
+ ('----+',ITER=1,4)
C------- number for all secondary elements
INTERDSSP(1)='|obs H|'
INTERDSSP(2)='|obs E|'
INTERDSSP(3)='|obs T|'
INTERDSSP(4)='|obs L|'
DO ITSEC=1,NSECEL
WRITE(KUNIT,'(T2,A7,5(I5,A1),8(I3,A1),
+ T71,2(I4,A1),2(F4.1,A1))')
+ INTERDSSP(ITSEC),(MATNUM(ITSEC,ITER),'|',ITER=1,
+ (NSECEL+1)),(INT(MATQOFDSSP(ITSEC,ITER)),'|',ITER=1,
+ NSECEL),(INT(MATQOFPRED(ITSEC,ITER)),'|',ITER=1,
+ NSECEL),(MATLEN(ITSEC,ITER),'|',ITER=1,2),
+ (INTERAVLENGTH(ITSEC,ITER),'|',ITER=1,2)
END DO
C------- sums
WRITE(KUNIT,'(T2,A7,5A6,A32,T71,4A5)')'+-----+',('-----+',
+ ITER=1,(NSECEL+1)),'---+--++---++--+--++---++--+---+',
+ ('----+',ITER=1,4)
WRITE(KUNIT,'(T2,A7,5(I5,A1),A1,4A6,A7,
+ T71,2(I4,A1),2(F4.1,A1))')
+ '|sum N|',(MATNUM((NSECEL+1),ITER),'|',ITER=1,
+ (NSECEL+1)),' ','cor H|','cor E|','cor T|','cor L|',
+ ' Q3 |',(MATLEN((NSECEL+1),ITER),'|',ITER=1,2),
+ (INTERAVLENGTH((NSECEL+1),ITER),'|',ITER=1,2)
WRITE(KUNIT,'(T2,A1,35A1,A2,4(F5.2,A1),F6.1,A1,T90,A1)')
+ '|',(' ',ITER=1,35),'| ',(CORR(ITSEC),'|',ITSEC=1,
+ NSECEL),Q3,'|','|'
C WRITE(KUNIT,'(T2,A1,35A1,A2,4A6,A7,T71,A)')
C + '+',('-',ITER=1,35),'+-',('-----+',ITER=1,NSECEL),
C + '******+','-------------------+'
WRITE(KUNIT,'(T2,A,A)')
+ '+-----+-----------------------------+'//
+ '+-----+-----+-----+-----+******+-------------------+'
WRITE(KUNIT,'(T2,A,A)')
+ '|seg | % of observed |'//
+ '| % of predicted | information |'
WRITE(KUNIT,'(T2,A,A)')
+ '+-----+-----------------------------+'//
+ '+-----------------------------++---------+---------+'
WRITE(KUNIT,'(T2,A,A)')
+ '| | % H | % E | % T | % L | sum |'//
+ '| % H | % E | % T | % L | sum || I %obs | I %pred |'
WRITE(KUNIT,'(T2,A,A)')
+ '+-----+-----+-----+-----+-----+-----+'//
+ '+-----+-----+-----+-----+-----++---------+---------+'
WRITE(KUNIT,'(T2,A7,5(F5.1,A1),A1,5(F5.1,A1),
+ T70,A1,2(F6.3,A4))')'|Sov |',
+ (QSEGSOV(1,ITSEC),'|',ITSEC=1,(NSECEL+1)),'|',
+ (QSEGSOV(2,ITSEC),'|',ITSEC=1,(NSECEL+1)),'|',
+ INFO,' |',INFO_INV,' |'
WRITE(KUNIT,'(T2,A1,A5,A1,5(F5.1,A1),A1,5(F5.1,A1),
+ T70,A1,2(A5,I3,A2))')'|',TXTFOV(3:7),'|',
+ (QSEGFOV(1,ITSEC),'|',ITSEC=1,(NSECEL+1)),'|',
+ (QSEGFOV(2,ITSEC),'|',ITSEC=1,(NSECEL+1)),'|',
+ ' ',INT(100*INFO/0.62),'%|',
+ ' ',INT(100*INFO_INV/0.62),'%|'
WRITE(KUNIT,'(T2,A,A)')
+ '+-----+-----+-----+-----+-----+-----+'//
+ '+-----+-----+-----+-----+-----++---------+---------+'
END IF
WRITE(KUNIT,*)
END
***** end of STABLE_QILS
***** ------------------------------------------------------------------
***** SUB StrPos
***** ------------------------------------------------------------------
C----
C---- NAME : StrPos
C---- ARG :
C---- DES : StrPos(Source,IStart,IStop): Finds the positions of the
C---- DES : first and last non-blank/non-TAB in Source.
C---- DES : IStart=IStop=0 for empty Source
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE StrPos(Source,IStart,IStop)
CHARACTER*222 SOURCE
INTEGER ISTART,ISTOP
ISTART=0
ISTOP=0
DO J=1,LEN(SOURCE)
IF(SOURCE(J:J).NE.' ')THEN
ISTART=J
GOTO 20
ENDIF
ENDDO
RETURN
20 DO J=LEN(SOURCE),1,-1
IF(SOURCE(J:J).NE.' ')THEN
ISTOP=J
RETURN
ENDIF
ENDDO
ISTART=0
ISTOP=0
RETURN
END
***** end of STRPOS
***** ------------------------------------------------------------------
***** SUB WRITELINES
***** ------------------------------------------------------------------
C----
C---- NAME : WRITELINES
C---- ARG :
C---- DES : if 'cstring' contains '/n' (new line) this routine writes
C---- DES : cstring line by line on screen; called by GETINT,GETREAL..
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE WRITELINES(CSTRING)
CHARACTER*222 CSTRING
INTEGER ICUTBEGIN(10),ICUTEND(10)
CALL StrPos(CSTRING,ISTART,ISTOP)
ILINE=1
ICUTBEGIN(ILINE)=1
ICUTEND(ILINE)=ISTOP
DO I=1,ISTOP-1
IF(CSTRING(I:I+1).EQ.'/n')THEN
ILINE=ILINE+1
ICUTBEGIN(ILINE)=I+2
ICUTEND(ILINE-1)=I-1
ICUTEND(ILINE)=ISTOP
ENDIF
ENDDO
DO I=1,ILINE
WRITE(*,*)CSTRING(ICUTBEGIN(I):ICUTEND(I))
ENDDO
RETURN
END
***** end of WRITELINES
C vim:et:ts=2:
profnet-1.0.22/src-phd/lib-sys-MACIBM.f 0000644 0150751 0150751 00000015627 12021362704 016576 0 ustar lkajan lkajan ***** ------------------------------------------------------------------
***** FCT FCTIME_DATE
***** ------------------------------------------------------------------
C----
C---- NAME : FCTIME_DATE
C---- ARG :
C---- DES :
C---- OUT : character*24 'YYYY_MM_DD - hh:mm:ss'
C----
*----------------------------------------------------------------------*
* Burkhard Rost Oct, 2003 version 1.0 *
* EMBL/LION http://www.predictprotein.org/ *
* D-69012 Heidelberg rost@columbia.edu *
* changed: Aug, 2003 version 1.0 *
*----------------------------------------------------------------------*
* purpose: returns date *
* note: machine type dependent: *
* SGI, UNIX, LINUX: absolute unix time *
* IBM: char*8 YYYYMMDD *
* input : NOM, DEN *
*----------------------------------------------------------------------*
CHARACTER*24 FUNCTION FCTIME_DATE()
IMPLICIT NONE
C---- variables passed from/to SBR calling
CHARACTER*24 CTEMP,CTEMP2
******------------------------------*-----------------------------******
* execution of function *
CTEMP=' '
CALL DATE_AND_TIME(CTEMP)
FCTIME_DATE= ' '
FCTIME_DATE(1:4)= CTEMP(1:4)
FCTIME_DATE(5:5)= '_'
FCTIME_DATE(6:7)= CTEMP(5:6)
FCTIME_DATE(8:8)= '_'
FCTIME_DATE(9:10)= CTEMP(7:8)
FCTIME_DATE(11:13)=' - '
FCTIME_DATE(14:15)=CTEMP2(1:2)
FCTIME_DATE(16:16)=':'
FCTIME_DATE(17:18)=CTEMP2(3:4)
FCTIME_DATE(19:19)=':'
FCTIME_DATE(20:21)=CTEMP2(5:6)
END
***** end of FCTIME_DATE
***** ------------------------------------------------------------------
***** FCT FRTIME_SECNDS
***** ------------------------------------------------------------------
C----
C---- NAME : FRTIME_SECNDS
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Oct, 2003 version 1.0 *
* EMBL/LION http://www.predictprotein.org/ *
* D-69012 Heidelberg rost@columbia.edu *
* changed: Aug, 2003 version 1.0 *
*----------------------------------------------------------------------*
* purpose: returns CPU time seconds *
* note: machine type dependent: *
* SGI, UNIX, LINUX: absolute unix time *
* IBM: cputime *
* input : T1: time to start (from previous call for unix) *
*----------------------------------------------------------------------*
REAL FUNCTION FRTIME_SECNDS(T1)
IMPLICIT NONE
C---- variables passed from/to SBR calling
REAL T1
******------------------------------*-----------------------------******
* execution of function *
CALL CPU_TIME(T1)
FRTIME_SECNDS=T1
END
***** end of FRTIME_SECNDS
***** ------------------------------------------------------------------
***** SUB SCFDATE
***** ------------------------------------------------------------------
C----
C---- NAME : SCFDATE
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Dec, 1991 version 0.1 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE SCFDATE(ITERCALL,LOGIWRITE,DATEOLD)
IMPLICIT NONE
CHARACTER*24 ACTDATE,DATEOLD,CTEMP
INTEGER ITER,ITERCALL
LOGICAL LOGIWRITE
C
C ACTDATE=FDATE()
ACTDATE=''
CTEMP=' '
CALL DATE_AND_TIME(CTEMP)
ACTDATE=CTEMP
IF (LOGIWRITE .EQV. .TRUE.) THEN
WRITE(6,*)
WRITE(6,'(T10,7A5)')('-----',ITER=1,7)
WRITE(6,*)
IF (ITERCALL.EQ.2) THEN
WRITE(6,'(T10,A11,A24)')'started: ',DATEOLD
WRITE(6,'(T10,A11,A24)')' ended: ',ACTDATE
ELSE
WRITE(6,'(T10,A11,A24)')' time: ',ACTDATE
END IF
WRITE(6,*)
WRITE(6,'(T10,7A5)')('-----',ITER=1,7)
WRITE(6,*)
END IF
IF (ITERCALL.EQ.1) THEN
DATEOLD=ACTDATE
END IF
END
***** end of SCFDATE
***** ------------------------------------------------------------------
***** SUB SRDTIME
***** ------------------------------------------------------------------
C----
C---- NAME : SRDTIME
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Dec, 1991 version 0.1 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
*** ***
*** ***
*** SUBROUTINE SRDTIME ***
*** ***
*** ***
*----------------------------------------------------------------------*
SUBROUTINE SRDTIME(LOGIWRITE)
IMPLICIT NONE
Cunix
C REAL TIMEARRAYM,TIMEDIFF,DTIME,TIME_TMP
Clinux
REAL TIMEARRAYM(1:2),TIMEDIFF,DTIME,TIME_TMP
INTEGER ITER
LOGICAL LOGIWRITE
C---- br 2003-08-23: bullshit to avoid warning
TIME_TMP= 0.0
Cunix
C TIMEDIFF=DTIME(TIMEARRAYM,TIME_TMP)
C TIMEDIFF=DTIME(TIMEARRAYM)
Clinux
C TIMEDIFF=DTIME(TIMEARRAYM)
Cibm
CALL CPU_TIME(TIMEDIFF)
IF (LOGIWRITE .EQV. .TRUE.) THEN
WRITE(6,*)
WRITE(6,'(T10,7A5)')('-----',ITER=1,7)
WRITE(6,*)
WRITE (6,'(T10,A12,T25,F9.3,A5)')
+ 'total time: ',TIMEDIFF,' sec'
WRITE(6,*)
WRITE(6,'(T10,7A5)')('-----',ITER=1,7)
WRITE(6,*)
END IF
END
***** end of SRDTIME
profnet-1.0.22/src-phd/lib-sys-SGI.f 0000644 0150751 0150751 00000014644 12021362704 016266 0 ustar lkajan lkajan ***** ------------------------------------------------------------------
***** FCT FCTIME_DATE
***** ------------------------------------------------------------------
C----
C---- NAME : FCTIME_DATE
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Oct, 2003 version 1.0 *
* EMBL/LION http://www.predictprotein.org/ *
* D-69012 Heidelberg rost@columbia.edu *
* changed: Aug, 2003 version 1.0 *
*----------------------------------------------------------------------*
* purpose: returns date *
* note: machine type dependent: *
* SGI, UNIX, LINUX: absolute unix time *
* IBM: char*8 YYYYMMDD *
* input : NOM, DEN *
*----------------------------------------------------------------------*
CHARACTER*24 FUNCTION FCTIME_DATE()
IMPLICIT NONE
******------------------------------*-----------------------------******
* execution of function *
C FCTIME_DATE=FDATE()
FCTIME_DATE=''
END
***** end of FCTIME_DATE
***** ------------------------------------------------------------------
***** FCT FRTIME_SECNDS
***** ------------------------------------------------------------------
C----
C---- NAME : FRTIME_SECNDS
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Oct, 2003 version 1.0 *
* EMBL/LION http://www.predictprotein.org/ *
* D-69012 Heidelberg rost@columbia.edu *
* changed: Aug, 2003 version 1.0 *
*----------------------------------------------------------------------*
* purpose: returns CPU time seconds *
* note: machine type dependent: *
* SGI, UNIX, LINUX: absolute unix time *
* IBM: cputime *
* input : NOM, DEN *
*----------------------------------------------------------------------*
REAL FUNCTION FRTIME_SECNDS(T1)
IMPLICIT NONE
C---- variables passed from/to SBR calling
REAL T1
******------------------------------*-----------------------------******
* execution of function *
FRTIME_SECNDS=SECNDS(T1)
END
***** end of FRTIME_SECNDS
***** ------------------------------------------------------------------
***** SUB SCFDATE
***** ------------------------------------------------------------------
C----
C---- NAME : SCFDATE
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Dec, 1991 version 0.1 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE SCFDATE(ITERCALL,LOGIWRITE,DATEOLD)
IMPLICIT NONE
CHARACTER*24 ACTDATE,DATEOLD,CTEMP
INTEGER ITER,ITERCALL
LOGICAL LOGIWRITE
C
C ACTDATE=FDATE()
ACTDATE=''
C ibm
C CTEMP=' '
C CALL DATE_AND_TIME(CTEMP)
C ACTDATE=CTEMP
IF (LOGIWRITE .EQV. .TRUE.) THEN
WRITE(6,*)
WRITE(6,'(T10,7A5)')('-----',ITER=1,7)
WRITE(6,*)
IF (ITERCALL.EQ.2) THEN
WRITE(6,'(T10,A11,A24)')'started: ',DATEOLD
WRITE(6,'(T10,A11,A24)')' ended: ',ACTDATE
ELSE
WRITE(6,'(T10,A11,A24)')' time: ',ACTDATE
END IF
WRITE(6,*)
WRITE(6,'(T10,7A5)')('-----',ITER=1,7)
WRITE(6,*)
END IF
IF (ITERCALL.EQ.1) THEN
DATEOLD=ACTDATE
END IF
END
***** end of SCFDATE
***** ------------------------------------------------------------------
***** SUB SRDTIME
***** ------------------------------------------------------------------
C----
C---- NAME : SRDTIME
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Dec, 1991 version 0.1 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
*** ***
*** ***
*** SUBROUTINE SRDTIME ***
*** ***
*** ***
*----------------------------------------------------------------------*
SUBROUTINE SRDTIME(LOGIWRITE)
IMPLICIT NONE
Cunix
REAL TIMEARRAYM,TIMEDIFF,DTIME,TIME_TMP
Clinux
C REAL TIMEARRAYM(1:2),TIMEDIFF,DTIME,TIME_TMP
INTEGER ITER
LOGICAL LOGIWRITE
C---- br 2003-08-23: bullshit to avoid warning
TIME_TMP= 0.0
Cunix
TIMEDIFF=DTIME(TIMEARRAYM,TIME_TMP)
TIMEDIFF=DTIME(TIMEARRAYM)
Clinux
C TIMEDIFF=DTIME(TIMEARRAYM)
Cibm
C TIMEDIFF=DTIME(TIMEARRAYM)
C CALL CPU_TIME(TIMEDIFF)
IF (LOGIWRITE .EQV. .TRUE.) THEN
WRITE(6,*)
WRITE(6,'(T10,7A5)')('-----',ITER=1,7)
WRITE(6,*)
WRITE (6,'(T10,A12,T25,F9.3,A5)')
+ 'total time: ',TIMEDIFF,' sec'
WRITE(6,*)
WRITE(6,'(T10,7A5)')('-----',ITER=1,7)
WRITE(6,*)
END IF
END
***** end of SRDTIME
profnet-1.0.22/src-phd/lib-sys.f 0000644 0150751 0150751 00000014645 12021362705 015650 0 ustar lkajan lkajan ***** ------------------------------------------------------------------
***** FCT FCTIME_DATE
***** ------------------------------------------------------------------
C----
C---- NAME : FCTIME_DATE
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Oct, 2003 version 1.0 *
* EMBL/LION http://www.predictprotein.org/ *
* D-69012 Heidelberg rost@columbia.edu *
* changed: Aug, 2003 version 1.0 *
*----------------------------------------------------------------------*
* purpose: returns date *
* note: machine type dependent: *
* SGI, UNIX, LINUX: absolute unix time *
* IBM: char*8 YYYYMMDD *
* input : NOM, DEN *
*----------------------------------------------------------------------*
CHARACTER*24 FUNCTION FCTIME_DATE()
IMPLICIT NONE
******------------------------------*-----------------------------******
* execution of function *
C FCTIME_DATE=FDATE()
FCTIME_DATE=''
END
***** end of FCTIME_DATE
***** ------------------------------------------------------------------
***** FCT FRTIME_SECNDS
***** ------------------------------------------------------------------
C----
C---- NAME : FRTIME_SECNDS
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Oct, 2003 version 1.0 *
* EMBL/LION http://www.predictprotein.org/ *
* D-69012 Heidelberg rost@columbia.edu *
* changed: Aug, 2003 version 1.0 *
*----------------------------------------------------------------------*
* purpose: returns CPU time seconds *
* note: machine type dependent: *
* SGI, UNIX, LINUX: absolute unix time *
* IBM: cputime *
* input : NOM, DEN *
*----------------------------------------------------------------------*
REAL FUNCTION FRTIME_SECNDS(T1)
IMPLICIT NONE
C---- variables passed from/to SBR calling
REAL T1
******------------------------------*-----------------------------******
* execution of function *
FRTIME_SECNDS=SECNDS(T1)
END
***** end of FRTIME_SECNDS
***** ------------------------------------------------------------------
***** SUB SCFDATE
***** ------------------------------------------------------------------
C----
C---- NAME : SCFDATE
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Dec, 1991 version 0.1 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE SCFDATE(ITERCALL,LOGIWRITE,DATEOLD)
IMPLICIT NONE
CHARACTER*24 ACTDATE,DATEOLD,CTEMP
INTEGER ITER,ITERCALL
LOGICAL LOGIWRITE
C
C ACTDATE=FDATE()
ACTDATE=''
C ibm
C CTEMP=' '
C CALL DATE_AND_TIME(CTEMP)
C ACTDATE=CTEMP
IF (LOGIWRITE .EQV. .TRUE.) THEN
WRITE(6,*)
WRITE(6,'(T10,7A5)')('-----',ITER=1,7)
WRITE(6,*)
IF (ITERCALL.EQ.2) THEN
WRITE(6,'(T10,A11,A24)')'started: ',DATEOLD
WRITE(6,'(T10,A11,A24)')' ended: ',ACTDATE
ELSE
WRITE(6,'(T10,A11,A24)')' time: ',ACTDATE
END IF
WRITE(6,*)
WRITE(6,'(T10,7A5)')('-----',ITER=1,7)
WRITE(6,*)
END IF
IF (ITERCALL.EQ.1) THEN
DATEOLD=ACTDATE
END IF
END
***** end of SCFDATE
***** ------------------------------------------------------------------
***** SUB SRDTIME
***** ------------------------------------------------------------------
C----
C---- NAME : SRDTIME
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Dec, 1991 version 0.1 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
*** ***
*** ***
*** SUBROUTINE SRDTIME ***
*** ***
*** ***
*----------------------------------------------------------------------*
SUBROUTINE SRDTIME(LOGIWRITE)
IMPLICIT NONE
Cunix
C REAL TIMEARRAYM,TIMEDIFF,DTIME,TIME_TMP
Clinux
REAL TIMEARRAYM(1:2),TIMEDIFF,DTIME,TIME_TMP
INTEGER ITER
LOGICAL LOGIWRITE
C---- br 2003-08-23: bullshit to avoid warning
TIME_TMP= 0.0
Cunix
C TIMEDIFF=DTIME(TIMEARRAYM,TIME_TMP)
C TIMEDIFF=DTIME(TIMEARRAYM)
Clinux
TIMEDIFF=DTIME(TIMEARRAYM)
Cibm
C TIMEDIFF=DTIME(TIMEARRAYM)
C CALL CPU_TIME(TIMEDIFF)
IF (LOGIWRITE .EQV. .TRUE.) THEN
WRITE(6,*)
WRITE(6,'(T10,7A5)')('-----',ITER=1,7)
WRITE(6,*)
WRITE (6,'(T10,A12,T25,F9.3,A5)')
+ 'total time: ',TIMEDIFF,' sec'
WRITE(6,*)
WRITE(6,'(T10,7A5)')('-----',ITER=1,7)
WRITE(6,*)
END IF
END
***** end of SRDTIME
profnet-1.0.22/src-phd/phd.f 0000644 0150751 0150751 00001221515 12021412433 015030 0 ustar lkajan lkajan *----------------------------------------------------------------------*
* FORTRAN code for program PHD *
* (Profile based neural network prediction of secondary *
* structure, solvent accessibility, and transmembrane *
* helices) *
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 0.2 *
*----------------------------------------------------------------------*
* *
* General notes: - The program uses a parameter files (INCLUDE): *
* phdParameter.f.f *
* - Library routines are taken from: *
* lib-phd.f *
* *
* Organisation: (1) main program PHD *
* (2) MAIN_STOP_EMPTYHSSP *
* then all subroutines alphabetically *
* *
* parameters/variables defined in: *
* Doc-code-phd.txt *
* *
* To port it: hard coded is only the path for the *.com file *
* currently: /home/rost/pub *
* or: /home/phd/net (if arg5=server) *
* or: explicitly given in arg6 *
* NOTE: defined in 'iniphd.f', *
* --> grep 'change to port' *
* *
* Input arg: arg1: HSSP file *
* arg2: optional flag if = "mach", then the output *
* (of secondary structure) comes with "# 1" *
* arg3: optional flag if = "whatif", an output file*
* with extension ".whatif" is created, which *
* can be read by e.g. KaleidaGraph *
* arg4: optional flag if *
* = "sec" -> prediction of secondary str. *
* = "exp" -> prediction of exposure *
* = "htm" -> prediction of helical trans- *
* membrane regions *
* default: sec *
* arg5: optional if phd LSERVER=TRUE, default: FALSE
* arg6: specifies the Parameter file to be chosen *
* arg7: optional flag: = "rdb", an output file is *
* written (extension ".rdb") with a format *
* for interchange, i.e. merging the results *
* from sec and exp- predictions *
* arg8: if = DEC or ALPHA, LDEC=TRUE *
* arg9: working directory, default=local *
* arg10: name for .pred file *
* arg11: name for .rdb file *
* arg12: not used *
* *
*----------------------------------------------------------------------*
PROGRAM PHD
C---- include parameter files
INCLUDE 'phdParameter.f'
C---- local variables
INTEGER ITER,MUE,NUMARGUMENTS,IHELP
REAL TIME0,FRTIME_SECNDS
LOGICAL LWRITE
******------------------------------*-----------------------------******
* LDSSPREAD is set true, if there is an observed secondary *
* structure in the HSSP file (then Evaldssp is *
* called and the pay-off table written into the out*
* put) *
* LFILTER controls whether the prediction ought to filterd *
* LOUTBINPROB if true, the probabilities for the assignment of *
* the secondary structures is computed and written *
* into the output. *
* LSERVER if true the name of FILEPRED, FILEOUTPUT are *
* chosen equal to the name of the HSSP file, other-*
* wise according to the name of the protein in the *
* HSSP file. *
* LWRITE controls whether calls of time and date are writ-*
* ten into the printer *
* SECNDS external function returning seconds elapsed since*
* midnight *
******------------------------------*-----------------------------******
C--------------------------------------------------
C---- assigning parameters -----
C--------------------------------------------------
C---- note: now determined by arguments:
LSERVER= .FALSE.
LDEC= .FALSE.
C---- security
FILE_HSSP= ' '
C---- call SRDTIME(CALL,LWRITE) from personal lib-syst.f
LWRITE= .FALSE.
c$$$ CALL SRDTIME(1,LWRITE)
C---- call SCFDATE(1,LWRITE) from personal lib-syst.f
LWRITE= .FALSE.
C CALL SCFDATE(1,LWRITE,STARTDATE)
C---- elapsed time: real: seconds since midnight-supplied arg
TIME0= 0.0
C TIMESTART= SECNDS(TIME0)
C TIMESTART= FRTIME_SECNDS(TIME0)
C--------------------------------------------------
C---- requesting HSSP file name and further
C---- input variables to run program
C--------------------------------------------------
C -------------------
CALL GET_ARG_NUMBER(NUMARGUMENTS)
C -------------------
IF (NUMARGUMENTS.GT.0) THEN
C -------------------
CALL GET_ARGUMENT(1,FILE_HSSP)
C -------------------
CHAR_ARG_READ(1)=FILE_HSSP
ELSE
WRITE(6,'(T2,A)')'---'
WRITE(6,'(T2,70A1)')('-',ITER=1,70)
WRITE(6,'(T2,3A1,T10,A)')('-',ITER=1,3),
+ 'Dear User, Welcome to PredictProtein !'
WRITE(6,'(T2,A)')'---'
WRITE(6,'(T2,3A1,T10,A)')('-',ITER=1,3),
+ 'Please select a HSSP file for the prediction:'
WRITE(6,'(T2,A)')'---'
C ------------
CALL GETCHAR(80,FILE_HSSP,' HSSP file ? ')
C ------------
END IF
IF (NUMARGUMENTS.GE.2) THEN
DO ITER=2,NUMARGUMENTS
C -----------------
CALL GET_ARGUMENT(ITER,CHAR_ARG_READ(ITER))
C -----------------
END DO
END IF
C---- initialise according to input
C ===========
CALL INIPHD(NUMARGUMENTS)
C ===========
C--------------------------------------------------
C---- initialise the parameter names for all
C---- particular jobs (architectures)
C--------------------------------------------------
C ------------
CALL READPAR
C ------------
C---- 21 amino acid names (20+unknown) and solvent into AACODE
C ------------
CALL TRANSAA
C ------------
C--------------------------------------------------
C---- adjust filename for output file -----
C--------------------------------------------------
C--------------------------------------------------
C---- reading sequence from HSSP file -----
C--------------------------------------------------
WRITE(6,'(T2,70A1)')('-',ITER=1,70)
WRITE(6,'(T2,3A1,T10,A,T30,A50)')('-',ITER=1,3),
+ 'Protein from HSSP:',FILE_HSSP
WRITE(6,'(T2,70A1)')('-',ITER=1,70)
WRITE(6,'(T2,A)')'---'
C ---------------
CALL RS_GETHSSP
C ---------------
C stop if no sequence in HSSP
IF (NUMNALIGN(1).EQ.0) THEN
WRITE(6,'(T2,A,T10,60A1)')'***',('*',ITER=1,60)
WRITE(6,'(T2,A,T10,A)')'***',
+ 'ERROR in reading HSSP (?), claimed to be empty (main PHD)'
WRITE(6,'(T2,A,T10,60A1)')'***',('*',ITER=1,60)
STOP
END IF
C--------------------------------------------------
C---- if somehow a fault occurred stop program ----
C--------------------------------------------------
IF (NUMRES.EQ.0) THEN
C ------------------------
CALL MAIN_STOP_EMPTYHSSP
C ------------------------
C!GOTO! !!!!!!!!!
C =========
GOTO 9999
C =========
C!GOTO! !!!!!!!!!
END IF
C--------------------------------------------------
C---- is there a DSSP assignmnet in the HSSP file?
C--------------------------------------------------
IHELP=0
DO MUE=1,NUMRES
IF ((RESSECSTR(MUE).EQ.'H').OR.
+ (RESSECSTR(MUE).EQ.'G').OR.
+ (RESSECSTR(MUE).EQ.'E')) THEN
IHELP=IHELP+1
END IF
END DO
IF ((IHELP.GT.5).AND.(LSERVER.EQV. .FALSE.)) THEN
LDSSPREAD=.TRUE.
ELSE
LDSSPREAD=.FALSE.
END IF
WRITE(6,'(T2,A)')'---'
WRITE(6,'(T2,3A1,T10,A)')('-',ITER=1,3),
+ 'end of reading protein data'
WRITE(6,'(T2,70A1)')('-',ITER=1,70)
WRITE(6,'(T2,A)')'---'
C--------------------------------------------------
C---- loop over all networks -----
C--------------------------------------------------
C ============
CALL NETWORK
C ============
IF (LFILTER .EQV. .TRUE.) THEN
C ===========
CALL FILTER
C ===========
END IF
C--------------------------------------------------
C---- saving data/output file -----
C--------------------------------------------------
C---- convert DSSP (8) -> 3 structure types (lib-prot.f)
IF (LDSSPREAD .EQV. .TRUE.) THEN
WRITE(6,'(T2,A)')'---'
LWRITE=.TRUE.
C =============
CALL EVALDSSP
C =============
WRITE(6,'(T2,A)')'---'
WRITE(6,'(T2,70A1)')('-',ITER=1,70)
WRITE(6,'(T2,A)')'---'
END IF
C ============
CALL CONTENT
C ============
C---- write results into output file
C -----------
CALL DATAOT
C -----------
C---- write results on printer
C -----------
CALL TXTRES
C -----------
C--------------------------------------------------
C---- branch for misread HSSP file -----
C--------------------------------------------------
C!GOTO!!!!!!!!
C ========
9999 CONTINUE
C ========
C!GOTO!!!!!!!!
END
***** end of MAIN
***** ------------------------------------------------------------------
***** SUB MAIN_STOP_EMPTYHSSP
***** ------------------------------------------------------------------
C----
C---- NAME : MAIN_STOP_EMPTYHSSP
C---- ARG :
C---- DES : For an empty HSSP file blabla written
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: For an empty HSSP file blabla written. *
*----------------------------------------------------------------------*
SUBROUTINE MAIN_STOP_EMPTYHSSP
C---- local variables
INTEGER ITER
******------------------------------*-----------------------------******
WRITE(6,'(T2,70A1)')('*',ITER=1,70)
WRITE(6,'(T2,A3)')'***'
WRITE(6,'(T2,3A1,T10,A,T30,A50)')('*',ITER=1,3),
+ 'An error occurred: the adressed HSSP file is empty.'
WRITE(6,'(T2,3A1,T10,A,T30,A50)')('*',ITER=1,3),
+ 'Program has stopped consequently !'
WRITE(6,'(T2,A3)')'***'
WRITE(6,'(T2,3A1,T10,A,T30,A50)')('*',ITER=1,3),
+ 'A potential cause is you mistyped the file name.'
WRITE(6,'(T2,3A1,T10,A,T30,A50)')('*',ITER=1,3),
+ 'Either start the program with: '
WRITE(6,'(T2,3A1,T10,A,T30,A50)')('*',ITER=1,3),
+ '"dir/PredictProtein.MACHINE filename"'
WRITE(6,'(T2,3A1,T10,A,T30,A50)')('*',ITER=1,3),
+ 'or check the path of the file you want to be read.'
WRITE(6,'(T2,A3)')'***'
WRITE(6,'(T2,3A1,T10,A,T30,A50)')('*',ITER=1,3),
+ 'Sorry !'
WRITE(6,'(T2,A3)')'***'
WRITE(6,'(T2,70A1)')('*',ITER=1,70)
END
***** end of MAIN_STOP_EMPTYHSSP
***** ------------------------------------------------------------------
***** SUB BINFIL
***** ------------------------------------------------------------------
C----
C---- NAME : BINFIL
C---- ARG :
C---- DES : Executes the output decision, i.e., actual network
C---- DES : prediction
C---- DES : in terms of binary values (for filtered output).
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: This SBR executes the output decision, i.e. the *
* -------- actual prediciton of the network in terms of *
* binary output values. *
* input: OUTFIL, (THREXP10ST, MAXEXP, EXPCODE) *
* var. read: SSCODE, EXPCODE, MAXEXP, THREXP10ST *
* output: OUTEXPFIL, OUTBINCHARFIL *
* called by: SBR FILTEREXP *
* calling: lib-comp.f: SRSTZ1, SRMAX1 *
*----------------------------------------------------------------------*
SUBROUTINE BINFIL
C---- parameters/global variables
INCLUDE 'phdParameter.f'
C---- local variables
INTEGER MUE,ITOUT,IMAX
REAL OUTLOC(1:(NUMOUTMAX)),RMAX
******------------------------------*-----------------------------******
C--------------------------------------------------
C---- loop over all residues -----
C--------------------------------------------------
DO MUE=1,NUMRES
C -----------
CALL SRSTZ1(OUTLOC,NUMOUTMAX)
C -----------
DO ITOUT=1,NUMOUT
OUTLOC(ITOUT)=OUTFIL(ITOUT,MUE)
END DO
C----------------------------------------
C------- WTO decision
C----------------------------------------
C -----------
CALL SRMAX1(OUTLOC,NUMOUTMAX,RMAX,IMAX)
C -----------
IF (RMAX.EQ.0) THEN
OUTEXPFIL(MUE)=MAXEXP
OUTBINCHARFIL(MUE)='e'
ELSE
OUTEXPFIL(MUE)=THREXP10ST(IMAX)
OUTBINCHARFIL(MUE)=EXPCODE(IMAX)
END IF
C----------------------------------------
C------- end of WTO decision
C----------------------------------------
END DO
C--------------------------------------------------
C---- end of loop over all residues ----
C--------------------------------------------------
END
***** end of BINFIL
***** ------------------------------------------------------------------
***** SUB BINOUT
***** ------------------------------------------------------------------
C----
C---- NAME : BINOUT
C---- ARG :
C---- DES : Executes the output decision, i.e., actual network
C---- DES : prediction
C---- DES : in terms of binary values.
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: This SBR executes the output decision, i.e. the *
* -------- actual prediciton of the network in terms of *
* binary output values. *
* const. passed: NUMRES, NSECEL, NUMOUT, NUMEXP, MODESECSTRON *
* -------------- NUMOUTMAX, *
* var. passed: in: OUTPUT; out: OUTBIN, OUTBINCHAR, OUTEXP *
* var. read: SSCODE, EXPCODE, MAXEXP, THREXP10ST *
* called by: SBR NETWORK *
* calling: lib-comp.f: SRSTZ1, SRMAX1 *
*----------------------------------------------------------------------*
SUBROUTINE BINOUT
C---- parameters/global variables
INCLUDE 'phdParameter.f'
C---- local variables
INTEGER MUE,ITOUT,IMAX
REAL OUTLOC(1:(NUMOUTMAX)),RMAX
******------------------------------*-----------------------------******
C--------------------------------------------------
C---- loop over all residues -----
C--------------------------------------------------
DO MUE=1,NUMRES
C -----------
CALL SRSTZ1(OUTLOC,NUMOUTMAX)
C -----------
DO ITOUT=1,NUMOUT
OUTLOC(ITOUT)=OUTPUT(ITOUT,MUE)
END DO
C----------------------------------------
C------- WTO decision
C----------------------------------------
C -----------
CALL SRMAX1(OUTLOC,NUMOUTMAX,RMAX,IMAX)
C -----------
DO ITOUT=1,NUMOUT
OUTBIN(ITOUT,MUE)=0
END DO
C------------------------------
C------- secondary structure
C------------------------------
IF (MODESECSTRON(1:9).EQ.'SECONDARY') THEN
OUTBIN(IMAX,MUE)=1
OUTBINCHAR(MUE)= SSCODE(IMAX)
OUTBINCHARFIL(MUE)=SSCODE(IMAX)
C------------------------------
C------- exposure
C------------------------------
ELSE
IF (RMAX.EQ.0) THEN
OUTBIN(NUMOUT,MUE)=1
OUTEXP(MUE)= MAXEXP
OUTBINCHAR(MUE)= 'e'
ELSE
OUTBIN(IMAX,MUE)= 1
OUTEXP(MUE)= THREXP10ST(IMAX)
OUTBINCHAR(MUE)= EXPCODE(IMAX)
END IF
END IF
C----------------------------------------
C------- end of WTO decision
C----------------------------------------
END DO
C--------------------------------------------------
C---- end of loop over all residues ----
C--------------------------------------------------
END
***** end of BINOUT
***** ------------------------------------------------------------------
***** SUB CODEIN
***** ------------------------------------------------------------------
C----
C---- NAME : CODEIN
C---- ARG :
C---- DES : The 20 amino acid one letter names (+solvent) are
C---- DES : 'transcribed' into a vector with NCODEUNT components
C---- DES : 0,1.
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: The 20 amino acid one letter names (+solvent) are*
* -------- 'transcribed' into a vector with NCODEUNT *
* components 0,1. *
* input var.: MODEASSCAS, PROFACC, NBIOLOBJ *
* ----------- CODEVECPROF, LOGI_CONS, *_INDEL, *
* output var.: CODEVECTOR *
* exchange var.: to ASSCAS: CODEVECTOR *
* -------------- from : CODEVECPROF *
* called from: ASSCAS *
* procedure: The actual residue ACTRESIDUE taken from SBR *
* --------- ASSCAS is compared with the amino acid code vector
* AACODE(i). In case of being equal the integer *
* number i is transposed into a binary number by *
* NCODEUNT units. *
* for: MODECODEIN='PROFILE' the profiles are given *
* by CODEVECPROF(i), i=1,21, for each residue from *
* all those read from the databank. In ASSCAS the *
* maximum of all these numbers is searched (PROFMAX)
* For the binary approach (MODECODEIN='PROFILE-BIN')
* the following way is used to transmit the integers
* to binaries: *
* nprof in first intervall -> 000 (for PROFACC =4)*
* in second -> 100 *
* in third -> 110 *
* in fourth -> 111 *
*----------------------------------------------------------------------*
SUBROUTINE CODEIN
C---- global parameter *
INCLUDE 'phdParameter.f'
C---- local parameter *
INTEGER LOWEST
PARAMETER (LOWEST= 2)
C---- local variables
INTEGER CHECKNUM,ITER1,ITER2,ITPROF,ITACC
LOGICAL CHECKFLAG(1:NBIOLOBJMAX),LHELP
CHARACTER*1 CHELP
******------------------------------*-----------------------------******
* ITER1,2,ITPROF,ITACC iteration variables *
* ACTRESIDUE gives the one letter name of the actual residue *
* which by calling of CODEIN ought to be translated*
* into a vector with 21 components (one 1, rest 0) *
* alternatively such a vector is given by a binary *
* vector with NCODEUNITS-1 components:2**unit... *
* CODEVECTOR is this translated coding for every amino acid *
* type (for further information, see SR CODEIN). *
* LOWEST for MODECODEIN='PROFILE-BIN': the 000.. vector is*
* used for RESPROF < lowest, the 111.. for > *
* PROFMAX-LOWEST *
******------------------------------*-----------------------------******
C--------------------------------------------------
C---- for alphabetical coding -----
C--------------------------------------------------
IF (MODEASSCAS(ACTCHI).EQ.'ALPHABET') THEN
C------- all lower case letters -> C
CHELP=ACTRESIDUE
IF ((CHELP.EQ.'a').OR.(CHELP.EQ.'b').OR.(CHELP.EQ.'c').OR.
A (CHELP.EQ.'d').OR.(CHELP.EQ.'e').OR.(CHELP.EQ.'f').OR.
B (CHELP.EQ.'g').OR.(CHELP.EQ.'h').OR.(CHELP.EQ.'i').OR.
C (CHELP.EQ.'j').OR.(CHELP.EQ.'k').OR.(CHELP.EQ.'l').OR.
D (CHELP.EQ.'m').OR.(CHELP.EQ.'n').OR.(CHELP.EQ.'o').OR.
E (CHELP.EQ.'p').OR.(CHELP.EQ.'q').OR.(CHELP.EQ.'r').OR.
F (CHELP.EQ.'s').OR.(CHELP.EQ.'t').OR.(CHELP.EQ.'u').OR.
G (CHELP.EQ.'v').OR.(CHELP.EQ.'w').OR.(CHELP.EQ.'y').OR.
H (CHELP.EQ.'x').OR.(CHELP.EQ.'z').OR.(CHELP.EQ.'X')) THEN
ACTRESIDUE='C'
C------- Z -> E
ELSEIF (CHELP.EQ.'Z') THEN
ACTRESIDUE='E'
C------- B -> D
ELSEIF (CHELP.EQ.'B') THEN
ACTRESIDUE='D'
C------- for alignments: . -> E
ELSEIF (CHELP.EQ.'.') THEN
ACTRESIDUE='O'
C------- for alignments: . -> E
ELSEIF (CHELP.EQ.' ') THEN
ACTRESIDUE='U'
WRITE(6,'(T2,A,T10,A,T30,I6,A,T40,A1)')
+ '---','CODEIN for pos:',ACTPOS,'residue =',ACTRESIDUE
C------- for breaks: -> U
ELSEIF (CHELP.EQ.'!') THEN
ACTRESIDUE='U'
END IF
C------- upper case letters
DO ITER1=1,NBIOLOBJ
IF (ACTRESIDUE.EQ.AACODE(ITER1)) THEN
DO ITER2=1,NCODEUNT
CODEVECTOR(ITER2)=REAL(AABIT(ITER1,ITER2))
END DO
CHECKFLAG(ITER1)=.TRUE.
ELSE
CHECKFLAG(ITER1)=.FALSE.
END IF
END DO
C------- consistency check
CHECKNUM=0
DO ITER1=1,NBIOLOBJ
IF (CHECKFLAG(ITER1) .EQV. .TRUE.) THEN
CHECKNUM=CHECKNUM+1
END IF
END DO
IF (CHECKNUM.NE.1) THEN
WRITE(6,*)' FAULT in CODEIN: checknum = ',CHECKNUM
WRITE(6,*)' for residue: ',ACTRESIDUE
STOP
END IF
C--------------------------------------------------
C---- for encoding with profiles -----
C--------------------------------------------------
ELSEIF (MODEASSCAS(ACTCHI).EQ.'PROFILE-BIN') THEN
C change insertion
C IF ((ACTRESIDUE.EQ.'!').OR.(ACTRESIDUE.EQ.'.')) THEN
IF (ACTRESIDUE.EQ.'!') THEN
DO ITPROF=1,(NBIOLOBJ-1)
CODEVECPROF(ITPROF)=0
END DO
CODEVECPROF(ITPROF)=100
END IF
DO ITPROF=1,NBIOLOBJ
LHELP=.TRUE.
C---------- resprof = 0 (+lowest)?
IF (CODEVECPROF(ITPROF).GT.LOWEST) THEN
CODEVECTOR(((ITPROF-1)*(PROFACC-1))+1)=1.
ELSE
LHELP=.FALSE.
DO ITACC=1,(PROFACC-1)
CODEVECTOR(((ITPROF-1)*(PROFACC-1))+ITACC)=0.
END DO
END IF
C---------- profmax (-lowest)?
IF (LHELP .EQV. .TRUE.) THEN
IF (CODEVECPROF(ITPROF).GT.(PROFMAX-LOWEST)) THEN
DO ITACC=1,(PROFACC-1)
CODEVECTOR(((ITPROF-1)*(PROFACC-1))+ITACC)=1.
END DO
LHELP=.FALSE.
ELSE
CODEVECTOR(ITPROF*(PROFACC-1))=0.
END IF
END IF
C---------- in between: sort into intervalls
IF (LHELP .EQV. .TRUE.) THEN
DO ITACC=2,(PROFACC-2)
IF (CODEVECPROF(ITPROF).GT.
+ ((ITACC-1)*PROFINTERV)) THEN
CODEVECTOR((ITPROF-1)*(PROFACC-1)+ITACC)=1.
ELSE
CODEVECTOR((ITPROF-1)*(PROFACC-1)+ITACC)=0.
END IF
END DO
END IF
END DO
C--------------------------------------------------
C---- real profiles -----
C--------------------------------------------------
ELSEIF ( (MODEASSCAS(ACTCHI).EQ.'PROFILE-REAL').OR.
+ LOGI_CONS ) THEN
IF ((ACTRESIDUE.EQ.'!').OR.(ACTRESIDUE.EQ.' ')) THEN
DO ITPROF=1,(NBIOLOBJ-1)
CODEVECPROF(ITPROF)=0
END DO
CODEVECPROF(ITPROF)=100
END IF
DO ITPROF=1,NBIOLOBJ
C---------- resprof = 0 (+lowest)?
IF (CODEVECPROF(ITPROF).GT.LOWEST) THEN
CODEVECTOR(ITPROF)=
+ REAL(CODEVECPROF(ITPROF))/REAL(PROFMAX)
ELSE
CODEVECTOR(ITPROF)=0.
END IF
END DO
ELSE
WRITE(6,*)'CODEIN: wrong mode chosen: MODEASSCAS(ACTCHI)=',
+ MODEASSCAS(ACTCHI)
STOP
END IF
C--------------------------------------------------
C---- end of MODEASSCAS -----
C--------------------------------------------------
END
***** end of CODEIN
***** ------------------------------------------------------------------
***** SUB CODESTR
***** ------------------------------------------------------------------
C----
C---- NAME : CODESTR
C---- ARG :
C---- DES : The NSECEL secondary structures generated by net1 are
C---- DES : 'transcribed' into vectors with NSECEL components 0,1
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: The NSECEL secondary structures generated by net1*
* -------- are 'transcribed' into vectors with NSECEL *
* components 0,1 *
* purpose: The NSECEL secondary structures generated by net1*
* -------- are 'transcribed' into vectors with NSECEL *
* components 0,1 *
* input var.: MODEASSSTR, CASCACC, NSECEL *
* ----------- CODEVECINCASC *
* output var.: CODEVECTOR *
* exchange var.: to ASSSTR: CODEVECTOR *
* -------------- from : CODEVECINCASC *
* called from: ASSSTR *
* procedure: The actual residue ACTSTR is compared to SSCODE *
* --------- if ACTSTR.eq.SSCODE(i), CODEVECTOR(i) is set to 1*
* CODEVECTOR(j), with j=1,NSECEL except i *
*----------------------------------------------------------------------*
SUBROUTINE CODESTR
C---- global parameter *
INCLUDE 'phdParameter.f'
C---- local parameter *
INTEGER LOWEST
PARAMETER (LOWEST= 2)
INTEGER ITSEC,ITACC,INTERMAX,POSMAX,IHELP,ITOUT
LOGICAL INTERFLAG
******------------------------------*-----------------------------******
* ITER1 iteration variable *
* CODEVECTOR is this translated coding for every structure *
* type (for further information, see SR CODEIN). *
* LOWEST for MODECODEIN='PROFILE-BIN': the 000.. vector is*
* used for RESPROF < lowest, the 111.. for > *
* PROFMAX-LOWEST *
******------------------------------*-----------------------------******
POSMAX= 0
C----------------------------------------
C---- real-new 2 --------
C----------------------------------------
IF ( (MODEASSSTR(ACTCHI).EQ.'REAL-OCT').OR.
+ (MODEASSSTR(ACTCHI).EQ.'REAL-CONS').OR.
+ ((.NOT.LOGI_REALINPUT).AND.LOGI_CONS) ) THEN
IF (CODEVECINCASC(NSECEL+1).NE.100) THEN
C----------------------------------------
C---------- secondary part
DO ITSEC=1,NSECEL
C------------- intrj = 0 (+lowest)?
IF (CODEVECINCASC(ITSEC).GT.LOWEST) THEN
CODEVECTOR(((ITSEC-1)*(CASCACC-1))+1)=1.
ELSE
DO ITACC=1,(CASCACC-1)
CODEVECTOR(((ITSEC-1)*(CASCACC-1))+ITACC)=0.
END DO
END IF
C------------- > 100 (-lowest)?
IF (CODEVECINCASC(ITSEC).GT.(100-LOWEST)) THEN
CODEVECTOR(ITSEC*(CASCACC-1))=1.
ELSE
CODEVECTOR(ITSEC*(CASCACC-1))=0.
END IF
C------------- in between: sort into intervalls
DO ITACC=2,(CASCACC-2)
IF ((CODEVECINCASC(ITSEC).GE.
+ ((ITACC-1)*CASCINTERV))) THEN
CODEVECTOR(((ITSEC-1)*(CASCACC-1))+ITACC)=1.
ELSE
CODEVECTOR(((ITSEC-1)*(CASCACC-1))+ITACC)=0.
END IF
END DO
END DO
C----------------------------------------
C---------- no conservation weight
IF (MODEASSSTR(ACTCHI).EQ.'REAL-OCT') THEN
C------------- spacer
DO ITACC=(NSECEL*(CASCACC-1)+1),((NSECEL+1)*(CASCACC-1))
CODEVECTOR(ITACC)=0
END DO
IHELP=(NSECEL+1)*(CASCACC-1)
C----------------------------------------
C---------- conservation weight 1992: H-E-L-cons-spacer
C---------- -----------------
ELSEIF (MODEASSSTR(ACTCHI).EQ.'REAL-CONS') THEN
C------------- spacer = 0
DO ITACC=((NSECEL+1)*(CASCACC-1)+1),
+ ((NSECEL+2)*(CASCACC-1))
CODEVECTOR(ITACC)=0.
END DO
C------------- coding conservation weight with additional
DO ITACC=1,(CASCACC-1)
IF ((ACTCONSWEIGHT.GE.((ITACC-1)*2./(CASCACC-1))).AND.
+ (ACTCONSWEIGHT.LT.(ITACC*2./(CASCACC-1)))) THEN
CODEVECTOR(NSECEL*(CASCACC-1)+ITACC)=1.
ELSE
CODEVECTOR(NSECEL*(CASCACC-1)+ITACC)=0.
END IF
END DO
IHELP=(NSECEL+1)*(CASCACC-1)
C----------------------------------------
C---------- conservation weight 1993: H-E-L-spacer-expos-cons-indel
C---------- -----------------------------
ELSEIF (LOGI_CONS.AND.(.NOT.LOGI_INDEL)) THEN
C------------- spacer
DO ITACC=(NSECEL*(CASCACC-1)+1),((NSECEL+1)*(CASCACC-1))
CODEVECTOR(ITACC)=0
END DO
IHELP=(NSECEL+1)*(CASCACC-1)
C------------- conservation weight new
DO ITACC=1,(CASCACC-1)
IF ((ACTCONSWEIGHT.GE.((ITACC-1)*2.
+ /REAL(CASCACC-1))).AND.
+ (ACTCONSWEIGHT.LT.(ITACC*2./REAL(CASCACC-1)))) THEN
CODEVECTOR(IHELP+ITACC)=1.
ELSE
CODEVECTOR(IHELP+ITACC)=0.
END IF
END DO
IHELP=(NSECEL+2)*(CASCACC-1)
C----------------------------------------
C---------- insertions and deletions number deletions/insertions
ELSEIF (LOGI_CONS.AND.LOGI_INDEL) THEN
C------------- spacer
DO ITACC=(NSECEL*(CASCACC-1)+1),((NSECEL+1)*(CASCACC-1))
CODEVECTOR(ITACC)=0
END DO
IHELP=(NSECEL+1)*(CASCACC-1)
C------------- conservation weight new
DO ITACC=1,(CASCACC-1)
IF (((ACTNDEL/REAL(ACTNALIGN))
+ .GE.((ITACC-1)/REAL(CASCACC-1))).AND.
+ ((ACTNDEL/REAL(ACTNALIGN))
+ .LT.(ITACC*2./REAL(CASCACC-1)))) THEN
CODEVECTOR(IHELP+ITACC)=1.
ELSE
CODEVECTOR(IHELP+ITACC)=0.
END IF
END DO
IHELP=IHELP+(CASCACC-1)
DO ITACC=1,(CASCACC-1)
IF (((ACTNINS/REAL(ACTNALIGN))
+ .GE.((ITACC-1)/REAL(CASCACC-1))).AND.
+ ((ACTNINS/REAL(ACTNALIGN))
+ .LT.(ITACC*2./REAL(CASCACC-1)))) THEN
CODEVECTOR(IHELP+ITACC)=1.
ELSE
CODEVECTOR(IHELP+ITACC)=0.
END IF
END DO
END IF
C------- spacer ?
ELSE
DO ITACC=1,(NSECEL*(CASCACC-1))
CODEVECTOR(ITACC)=0.
END DO
IF (LOGI_CONS .EQV. .TRUE.) THEN
DO ITACC=(NSECEL*(CASCACC-1)+1),((NSECEL+1)*(CASCACC-1))
CODEVECTOR(ITACC)=0.
END DO
DO ITACC=((NSECEL+1)*(CASCACC-1)+1),NCODEUNT
CODEVECTOR(ITACC)=1.
END DO
ELSE
DO ITACC=(NSECEL*(CASCACC-1)+1),((NSECEL+1)*(CASCACC-1))
CODEVECTOR(ITACC)=0.
END DO
DO ITACC=((NSECEL+1)*(CASCACC-1)+1),NCODEUNT
CODEVECTOR(ITACC)=1.
END DO
END IF
END IF
C----------------------------------------
C---- binary : winner takes all ------
C----------------------------------------
ELSEIF (MODEASSSTR(ACTCHI).EQ.'BIN-EXCL') THEN
C------- code secondary structure
IF (CODEVECINCASC(NSECEL+1).NE.100) THEN
INTERMAX=0
INTERFLAG=.TRUE.
DO ITSEC=1,NSECEL
IF (CODEVECINCASC(ITSEC).GT.INTERMAX) THEN
INTERFLAG=.FALSE.
POSMAX=ITSEC
INTERMAX=CODEVECINCASC(ITSEC)
END IF
END DO
C---------- consistency check (one found?)
IF (INTERFLAG .EQV. .TRUE.) THEN
WRITE(6,*)'fault in CODESTR no example regarded as'
WRITE(6,*)'"winner". For test and mue =',
+ ACTPOS,' and the respective outputs:'
WRITE(6,*)'stopped 17-12-91-1b'
STOP
END IF
C---------- winner takes all
DO ITSEC=1,(NSECEL+1)
CODEVECTOR(ITSEC)=0.
END DO
CODEVECTOR(POSMAX)=1.
C------- spacer ?
ELSE
CODEVECTOR(NSECEL+1)=1.
DO ITSEC=1,NSECEL
CODEVECTOR(ITSEC)=0.
END DO
END IF
C----------------------------------------
C---- real-new --------
C----------------------------------------
ELSEIF (MODEASSSTR(ACTCHI).EQ.'REAL-NEW') THEN
IF (CODEVECINCASC(NSECEL+1).NE.100) THEN
DO ITSEC=1,NSECEL
C------------- intrj = 0 (+lowest)?
IF (CODEVECINCASC(ITSEC).GT.LOWEST) THEN
CODEVECTOR(((ITSEC-1)*(CASCACC-1))+1)=1.
ELSE
DO ITACC=1,(CASCACC-1)
CODEVECTOR(((ITSEC-1)*(CASCACC-1))+ITACC)=0.
END DO
END IF
C------------- > 100 (-lowest)?
IF (CODEVECINCASC(ITSEC).GT.(100-LOWEST)) THEN
CODEVECTOR(ITSEC*(CASCACC-1))=1.
ELSE
CODEVECTOR(ITSEC*(CASCACC-1))=0.
END IF
C------------- in between: sort into intervalls
DO ITACC=2,(CASCACC-2)
IF ((CODEVECINCASC(ITSEC).GE.
+ ((ITACC-1)*CASCINTERV))) THEN
CODEVECTOR(((ITSEC-1)*(CASCACC-1))+ITACC)=1.
ELSE
CODEVECTOR(((ITSEC-1)*(CASCACC-1))+ITACC)=0.
END IF
END DO
END DO
C------- spacer ?
ELSE
DO ITACC=1,(NSECEL*(CASCACC-1))
CODEVECTOR(ITACC)=0
END DO
DO ITACC=(NSECEL*(CASCACC-1)+1),((NSECEL+1)*(CASCACC-1))
CODEVECTOR(ITACC)=1
END DO
END IF
C----------------------------------------
C---- real real --------
C----------------------------------------
ELSEIF ( (MODEASSSTR(ACTCHI).EQ.'REAL-REAL').OR.
+ (MODEASSSTR(ACTCHI)(1:3).EQ.'RR-') ) THEN
IF (CODEVECINCASC(NSECEL+1).NE.100) THEN
DO ITOUT=1,NUMOUT
C------------- intrj = 0 (+lowest)?
IF (CODEVECINCASC(ITOUT).GT.LOWEST) THEN
CODEVECTOR(ITOUT)=CODEVECINCASC(ITOUT)/100.
ELSE
CODEVECTOR(ITOUT)=0.
END IF
END DO
C---------- spacer = 0
CODEVECTOR(NUMOUT+1)=0.
IHELP=(NUMOUT+1)
C---------- conservation weight
CODEVECTOR(IHELP+1)=ACTCONSWEIGHT/2.
IHELP=(NUMOUT+2)
C---------- number deletions/insertions
IF (LOGI_INDEL .EQV. .TRUE.) THEN
CODEVECTOR(IHELP+1)=ACTNDEL/MAX(1.,REAL(ACTNALIGN))
CODEVECTOR(IHELP+2)=ACTNINS/MAX(1.,REAL(ACTNALIGN))
END IF
C------- spacer ?
ELSE
DO ITOUT=1,NUMOUT
CODEVECTOR(ITOUT)=0.
END DO
CODEVECTOR(NUMOUT+1)=1.
DO ITOUT=(NUMOUT+2),NCODEUNT
CODEVECTOR(ITOUT)=0.
END DO
END IF
ELSE
WRITE(6,'(T2,A,T10,A)')'***','CODESTR: mode strange!'
WRITE(6,'(T2,A,T10,A)')'***','stopped 6-3-94d'
STOP
END IF
C----------------------------------------
C---- end of modeassstr -------
C----------------------------------------
END
***** end of CODESTR
***** ------------------------------------------------------------------
***** SUB CONTENT
***** ------------------------------------------------------------------
C----
C---- NAME : CONTENT
C---- ARG :
C---- DES : The content in secondary structure, resp. relative
C---- DES : percentage of occurrence per amino acid is computed.
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: The content in secondary structure, resp. relative
* -------- percentage of occurrence per amino acid is *
* computed. *
* input variables:OUTBINCHARFIL, OUTBINCHAR, DSSPCHAR, RESNAME *
* output variab.: CONTPRED,CONTDSSP,CONTAA *
* called by: MAIN *
* calling: lib-comp.f SISTZ1 *
* procedure: See SEVALPO, SEVALQUO, STABLEPO *
*----------------------------------------------------------------------*
SUBROUTINE CONTENT
C---- parameters/global variables
INCLUDE 'phdParameter.f'
C---- local variables
INTEGER MUE,ITAA,COUNT(1:8),ICOUNT,ITSEC
CHARACTER*24 TXTAA
CHARACTER*1 INTERCHAR
******------------------------------*-----------------------------******
C---- default
TXTAA(1:24)='ABCDEFGHIKLMNPQRSTVWXYZU'
C----------------------------------------
C---- computing the content of acids --
C----------------------------------------
DO ITAA=1,24
ICOUNT=0
DO MUE=1,NUMRES
IF (TXTAA(ITAA:ITAA).EQ.RESNAME(MUE)) THEN
ICOUNT=ICOUNT+1
END IF
END DO
CONTAA(ITAA)=100*ICOUNT/REAL(NUMRES)
END DO
C-------------------------------------------------------------
C---- secondary structure prediction -----
C-------------------------------------------------------------
IF (MODESECSTRON(1:9).EQ.'SECONDARY') THEN
C-------------------------------------------
C------- computing the content of pred SS --
C-------------------------------------------
C------- initially set equal content=prediction
C ===========
CALL SISTZ1(COUNT,8)
C ===========
DO MUE=1,NUMRES
IF (LFILTER .EQV. .TRUE.) THEN
INTERCHAR=OUTBINCHARFIL(MUE)
ELSE
INTERCHAR=OUTBINCHAR(MUE)
END IF
IF (INTERCHAR.EQ.'H') THEN
COUNT(1)=COUNT(1)+1
ELSEIF (INTERCHAR.EQ.'E') THEN
COUNT(2)=COUNT(2)+1
ELSEIF ((INTERCHAR.EQ.'L').OR.(INTERCHAR.EQ.' ')) THEN
COUNT(NSECEL)=COUNT(NSECEL)+1
ELSEIF (NSECEL.GT.3) THEN
IF (INTERCHAR.EQ.'T') THEN
COUNT(3)=COUNT(3)+1
END IF
END IF
END DO
DO ITSEC=1,NSECEL
CONTPRED(ITSEC)=100*COUNT(ITSEC)/REAL(NUMRES)
END DO
C-------------------------------------------
C------- computing the content of obs SS --
C-------------------------------------------
IF (LDSSPREAD .EQV. .TRUE.) THEN
C---------- initially set equal content=prediction
C ===========
CALL SISTZ1(COUNT,8)
C ===========
DO MUE=1,NUMRES
INTERCHAR=CONVSECSTR(MUE)
IF (INTERCHAR.EQ.'H') THEN
COUNT(1)=COUNT(1)+1
ELSEIF (INTERCHAR.EQ.'E') THEN
COUNT(2)=COUNT(2)+1
ELSEIF ((INTERCHAR.EQ.'L').OR.(INTERCHAR.EQ.' ')) THEN
COUNT(NSECEL)=COUNT(NSECEL)+1
ELSEIF (NSECEL.GT.3) THEN
IF (INTERCHAR.EQ.'T') THEN
COUNT(3)=COUNT(3)+1
END IF
END IF
END DO
DO ITSEC=1,NSECEL
CONTDSSP(ITSEC)=100*COUNT(ITSEC)/REAL(NUMRES)
END DO
END IF
END IF
C---- end of content -----
C--------------------------------------------------
END
***** end of CONTENT
***** ------------------------------------------------------------------
***** SUB DATAOT
***** ------------------------------------------------------------------
C----
C---- NAME : DATAOT
C---- ARG :
C---- DES : The prediction is written into FILEPRED.
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: The prediction is written into FILEPRED. *
* const. passed: LWHATIF, LRDB, MODESECSTRON *
* var. read: FILEPRED, FILEOUTPUT, FILE_WHATIF, FILE_RDB *
* ext. SBR: SFILEOPEN (lib-unix) *
* called by: MAIN *
* calling: SCOUNT_HYDROPHOB, DATAOT_OUTPUT, *
* -------- DATAOT_WHATIF, DATAOT_RDBSEC,DATAOT_RDBEXP, *
* WRTCONTENT, WRTPRED, WRTEXP, WRTE, WRTF *
*----------------------------------------------------------------------*
SUBROUTINE DATAOT
C---- global parameters *
INCLUDE 'phdParameter.f'
C---- local parameter
INTEGER KOUT
PARAMETER (KOUT= 10)
C---- local function
INTEGER FILEN_STRING
C---- local variables
LOGICAL LWRTOUTPUT
CHARACTER*222 CHFILE
INTEGER IEND
******------------------------------*-----------------------------******
LWRTOUTPUT= .FALSE.
C--------------------------------------------------
C---- write prediction for testing set -----
C--------------------------------------------------
C---- write into fileotpredtest
IEND= FILEN_STRING(FILEPRED)
CHFILE= ' '
CHFILE(1:IEND)= FILEPRED(1:IEND)
CALL SFILEOPEN(KOUT,CHFILE(1:IEND),'UNKNOWN',222,' ')
C write(6,*)'xy filepred=',CHFILE(1:IEND)
C---- general information
C ==================
C CALL WRTHEADER(KOUT)
C ==================
C---- writing content
C ===================
CALL WRTCONTENT(KOUT)
C ===================
C---- write prediction + header
IF (MODESECSTRON(1:9).EQ.'SECONDARY') THEN
C ================
C CALL WRTPRED(6)
CALL WRTPRED(KOUT)
C ================
ELSEIF (MODESECSTRON.EQ.'EXPOSURE') THEN
C ===============
CALL WRTEXP(KOUT)
C ===============
END IF
CALL WRTE(KOUT)
CALL WRTF(KOUT)
C---- for i/o checks:
WRITE(KOUT,'(A3)')'END'
C--------------------------------------------------
C---- search for potential trans-membrane regions -
C--------------------------------------------------
C---- count hydrophobic residues
C =========================
CALL SCOUNT_HYDROPHOB(KOUT)
C =========================
CLOSE(KOUT)
C---- close FILEPRED
C--------------------------------------------------
C---- write real outputs of prediction into file --
C--------------------------------------------------
IF (LWRTOUTPUT .EQV. .TRUE.) THEN
C------- write into fileotpredtest
IEND= FILEN_STRING(FILEOUTPUT)
CHFILE= ' '
CHFILE(1:IEND)=FILEOUTPUT(1:IEND)
CALL SFILEOPEN(KOUT,CHFILE(1:IEND),'UNKNOWN',222,' ')
C CALL SFILEOPEN(KOUT,FILEOUTPUT,'UNKNOWN',222,' ')
C ==================
CALL DATAOT_OUTPUT(KOUT)
C ==================
CLOSE(KOUT)
END IF
C--------------------------------------------------
C---- write format for interchange
C--------------------------------------------------
IF (LRDB .EQV. .TRUE.) THEN
C------- write into fileotpredtest
IEND= FILEN_STRING(FILE_RDB)
CHFILE= ' '
CHFILE(1:IEND)=FILE_RDB(1:IEND)
CALL SFILEOPEN(KOUT,CHFILE(1:IEND),'UNKNOWN',222,' ')
C CALL SFILEOPEN(KOUT,FILE_RDB,'UNKNOWN',222,' ')
IF (MODESECSTRON.EQ.'SECONDARY') THEN
C ==================
CALL DATAOT_RDBSEC(KOUT)
C ==================
ELSEIF (MODESECSTRON.EQ.'EXPOSURE') THEN
C ==================
CALL DATAOT_RDBEXP(KOUT)
C ==================
ELSEIF (MODESECSTRON.EQ.'SECONDARY_HTM') THEN
C ==================
CALL DATAOT_RDBHTM(KOUT)
C ==================
END IF
CLOSE(KOUT)
END IF
END
***** end of DATAOT
***** ------------------------------------------------------------------
***** SUB DATAOT_OUTPUT
***** ------------------------------------------------------------------
C----
C---- NAME : DATAOT_OUTPUT
C---- ARG :
C---- DES : The real values of a prediction are written into a file:
C---- DES : name.OUTPUT
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: The real values of a prediction are written into *
* -------- a file: name.OUTPUT *
* in variables: kunit *
* out variables: OUTPUT(itsec,mue), OUTBINCHAR(mue) *
* called by: DATAOT *
*----------------------------------------------------------------------*
SUBROUTINE DATAOT_OUTPUT(KUNIT)
C---- global parameters *
INCLUDE 'phdParameter.f'
C---- local variables *
INTEGER KUNIT,ITSEC,MUE
CHARACTER*1 INTERCHAR
******------------------------------*-----------------------------******
C---- write real output values
WRITE(KUNIT,'(T10,A,T40,I5)')'number of residues:',NUMRES
WRITE(KUNIT,'(T10,A,T40,I5)')'number of sec str:',NSECEL
IF (NSECEL.EQ.3) THEN
WRITE(KUNIT,'(T10,3A6,T40,A6)')
+ 'out H ','out E ','out L',' WTO '
ELSE
WRITE(KUNIT,'(T10,4A6,T40,I6)')
+ 'out H ','out E ','out T ','out L ',' WTO '
END IF
DO MUE=1,NUMRES
C------- convert loop from blank to "L"
IF ((OUTBINCHAR(MUE).NE.'H').AND.(OUTBINCHAR(MUE).NE.'E').AND.
+ (OUTBINCHAR(MUE).NE.'T')) THEN
INTERCHAR='L'
ELSE
INTERCHAR=OUTBINCHAR(MUE)
END IF
IF (NSECEL.EQ.3) THEN
WRITE(KUNIT,'(T10,3F6.2,T40,A6)')
+ (OUTPUT(ITSEC,MUE),ITSEC=1,NSECEL),INTERCHAR
ELSE
WRITE(KUNIT,'(T10,4F6.2,T40,A6)')
+ (OUTPUT(ITSEC,MUE),ITSEC=1,NSECEL),INTERCHAR
END IF
END DO
END
***** end of DATAOT_OUTPUT
***** ------------------------------------------------------------------
***** SUB DATAOT_RDBSEC
***** ------------------------------------------------------------------
C----
C---- NAME : DATAOT_RDBSEC
C---- ARG :
C---- DES : The prediction is written into a file to merge secondary
C---- DES : structure and exposure prediction by calling perl script.
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: The prediction is written into a file to merge *
* -------- secondary structure and exposure prediction by *
* the perl script calling phd. *
* in variables: KUNIT *
* called by: DATAOT *
*----------------------------------------------------------------------*
SUBROUTINE DATAOT_RDBSEC(KUNIT)
C---- global parameters *
INCLUDE 'phdParameter.f'
INTEGER FILEN_STRING
C---- local variables *
INTEGER KUNIT,ITSEC,MUE,IT
CHARACTER*1 XC,INTERDSSP,INTERPRED
CHARACTER*222 CTMP
******------------------------------*-----------------------------******
C---- default
XC=CHAR(9)
C---- header
WRITE(KUNIT,'(A)')'# Perl-RDB'
WRITE(KUNIT,'(A)')'# '
WRITE(KUNIT,'(A)')'# PHDsec: secondary structure prediction'
CTMP=PROTNAME(1)
WRITE(KUNIT,'(A)')'# '
WRITE(KUNIT,'(A,T19,A)')
+ '# PDBID :',CTMP(1:FILEN_STRING(CTMP))
WRITE(KUNIT,'(A,T19,I5)')'# LENGTH :',NUMRES
WRITE(KUNIT,'(A)')'# NOTATION No : residue number '
WRITE(KUNIT,'(A)')'# NOTATION AA : amino acid one letter code'
IF (LDSSPREAD .EQV. .TRUE.) THEN
WRITE(KUNIT,'(A)')
+ '# NOTATION OHEL : observed secondary structure'
END IF
WRITE(KUNIT,'(A)')
+ '# NOTATION PHEL : predicted secondary structure'
WRITE(KUNIT,'(A)')'# NOTATION PHEL : '//
+ 'H=helix, E=strand, L=non-regular (taken from DSSP)'
WRITE(KUNIT,'(A)')'# NOTATION RI_S : '//
+ 'reliability of secondary structure prediction , 0-9'
WRITE(KUNIT,'(A)')'# NOTATION pH : '//
+ 'probability of predicting helix, 0-9'
WRITE(KUNIT,'(A)')
+ '# NOTATION pE : probability of predicting strand'
WRITE(KUNIT,'(A)')
+ '# NOTATION pL : probability of predicting loop'
WRITE(KUNIT,'(A)')
+ '# NOTATION OtH : network output for helix, 0-100'
WRITE(KUNIT,'(A)')'# NOTATION OtE : network output for strand'
WRITE(KUNIT,'(A)')'# NOTATION OtL : network output for loop'
WRITE(KUNIT,'(A)')'# '
C---- column names and width
IF (LDSSPREAD .EQV. .TRUE.) THEN
WRITE(KUNIT,'(A2,A,A2,A,2(A4,A),A4,3(A,A2),3(A,A3))')
+ 'No',XC,'AA',XC,'OHEL',XC,'PHEL',XC,'RI_S',
+ XC,'pH',XC,'pE',XC,'pL',XC,'OtH',XC,'OtE',XC,'OtL'
WRITE(KUNIT,'(A2,3(A,A1),4(A,A2),3(A,A2))')
+ '4N',(XC,'1',it=1,3),(XC,'1N',IT=1,4),(XC,'3N',IT=1,3)
ELSE
WRITE(KUNIT,'(A2,A,A2,A,A4,A,A4,3(A,A2),3(A,A3))')
+ 'No',XC,'AA',XC,'PHEL',XC,'RI_S',
+ XC,'pH',XC,'pE',XC,'pL',XC,'OtH',XC,'OtE',XC,'OtL'
WRITE(KUNIT,'(A2,2(A,A1),4(A,A2),3(A,A2))')
+ '4N',(XC,'1',it=1,2),(XC,'1N',IT=1,4),(XC,'3N',IT=1,3)
END IF
C---- prediction: number, sequence, DSSP, prediction, Rel, Prob(H,E,L)
DO MUE=1,NUMRES
IF (LDSSPREAD .EQV. .TRUE.) THEN
INTERDSSP=CONVSECSTR(MUE)
ELSE
INTERDSSP='U'
END IF
IF ( (OUTBINCHARFIL(MUE).NE.'H').AND.
+ (OUTBINCHARFIL(MUE).NE.'G').AND.
+ (OUTBINCHARFIL(MUE).NE.'B').AND.
+ (OUTBINCHARFIL(MUE).NE.'E') ) THEN
INTERPRED='L'
ELSE
INTERPRED=OUTBINCHARFIL(MUE)
END IF
IF (LDSSPREAD .EQV. .TRUE.) THEN
WRITE(KUNIT,'(I4,A,A1,A,2(A1,A),I1,3(A,I1),3(A,I3))')MUE,XC,
+ RESNAME(MUE),XC,INTERDSSP,XC,INTERPRED,XC,RELIND(MUE),
+ (XC,OUTBINPROB(ITSEC,MUE),ITSEC=1,NSECEL),
+ (XC,INT(100*OUTPUT(ITSEC,MUE)),ITSEC=1,NSECEL)
ELSE
WRITE(KUNIT,'(I4,A,A1,A,A1,A,I1,3(A,I1),3(A,I3))')MUE,XC,
+ RESNAME(MUE),XC,INTERPRED,XC,RELIND(MUE),
+ (XC,OUTBINPROB(ITSEC,MUE),ITSEC=1,NSECEL),
+ (XC,INT(100*OUTPUT(ITSEC,MUE)),ITSEC=1,NSECEL)
END IF
END DO
END
***** end of DATAOT_RDBSEC
***** ------------------------------------------------------------------
***** SUB DATAOT_RDBEXP
***** ------------------------------------------------------------------
C----
C---- NAME : DATAOT_RDBEXP
C---- ARG :
C---- DES : The prediction is written into a file to merge secondary
C---- DES : structure and exposure prediction by calling perl script.
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: The prediction is written into a file to merge *
* -------- secondary structure and exposure prediction by *
* the perl script calling phd. *
* in variables: KUNIT *
* called by: DATAOT *
*----------------------------------------------------------------------*
SUBROUTINE DATAOT_RDBEXP(KUNIT)
C---- global parameters *
INCLUDE 'phdParameter.f'
C---- local function
INTEGER FILEN_STRING
REAL FR_REXP_TO_EXP,FR_EXP_TO_REXP
CHARACTER*1 FC_REXP_TO_3STCHAR,FC_REXPI_TO_3STCHAR
C---- local variables *
INTEGER KUNIT,ITEXP,MUE,
+ OBSEXP,OBSREXP,PHDEXP,PHDREXP,IT,PHDBINLOC(1:NUMOUTMAX)
CHARACTER*1 XC,OBSCHAR,PHDCHARLOC
CHARACTER*222 CTMP
******------------------------------*-----------------------------******
C---- default
XC=CHAR(9)
C---- header
WRITE(KUNIT,'(A)')'# Perl-RDB'
WRITE(KUNIT,'(A)')
+ '# PHDacc: solvent accessibility prediction'
WRITE(KUNIT,'(A)')'# '
CTMP=PROTNAME(1)
WRITE(KUNIT,'(A,T19,A)')
+ '# PDBID :',CTMP(1:FILEN_STRING(CTMP))
WRITE(KUNIT,'(A,T19,I5)')'# LENGTH :',NUMRES
WRITE(KUNIT,'(A)')'# NOTATION No : residue number '
WRITE(KUNIT,'(A)')'# NOTATION AA : amino acid one letter code'
IF (LDSSPREAD .EQV. .TRUE.) THEN
WRITE(KUNIT,'(A)')'# NOTATION OACC : '//
+ 'observed accessible surface area (from DSSP), 0-300 A'
END IF
WRITE(KUNIT,'(A)')'# NOTATION PACC : '//
+ 'predicted accessible surface area, 0-300 A'
IF (LDSSPREAD .EQV. .TRUE.) THEN
WRITE(KUNIT,'(A)')'# NOTATION OREL : '//
+ 'observed relative accessible surface area, 0-100'
END IF
WRITE(KUNIT,'(A)')'# NOTATION PREL : '//
+ 'predicted relative accessible surface area'
WRITE(KUNIT,'(A)')
+ '# NOTATION RI_A : reliability of accessibility prediction, 0-9'
IF (LDSSPREAD .EQV. .TRUE.) THEN
WRITE(KUNIT,'(A)')'# NOTATION Obie : observed exposure state'
END IF
WRITE(KUNIT,'(A)')'# NOTATION Pbie : predicted exposure state'
WRITE(KUNIT,'(A)')
+ '# NOTATION Pbie : b=buried, i=intermediate, e=exposed'
WRITE(KUNIT,'(A)')'# NOTATION Ot(n): '//
+ 'network output for relative accessibility = n*n%, 0-100'
WRITE(KUNIT,'(A)')'# '
C---- column names and width
IF (LDSSPREAD .EQV. .TRUE.) THEN
WRITE(KUNIT,'(A2,A,A2,7(A,A4),10(A,A2,I1))')
+ 'No',XC,'AA',XC,'OACC',XC,'PACC',XC,'OREL',XC,'PREL',XC,
+ 'RI_A',XC,'Obie',XC,'Pbie',(XC,'Ot',(IT-1),IT=1,10)
WRITE(KUNIT,'(A2,A,A1,4(A,A2),A,A2,2(A,A1),10(A,A3))')
+ '4N',XC,'1',(XC,'3N',IT=1,4),XC,'1N',
+ (XC,'1',IT=1,2),(XC,'3N',IT=1,10)
ELSE
WRITE(KUNIT,'(A2,A,A2,4(A,A4),10(A,A2,I1))')
+ 'No',XC,'AA',XC,'PACC',XC,'PREL',XC,
+ 'RI_A',XC,'Pbie',(XC,'Ot',(IT-1),IT=1,10)
WRITE(KUNIT,'(A2,A,A1,2(A,A2),A,A2,A,A1,10(A,A3))')
+ '4N',XC,'1',(XC,'3N',IT=1,2),XC,'1N',
+ XC,'1',(XC,'3N',IT=1,10)
END IF
C---- prediction: number, sequence, DSSP, prediction, Rel, Prob(H,E,L)
DO MUE=1,NUMRES
IF (LFILTER .EQV. .TRUE.) THEN
PHDREXP=INT(100*OUTEXPFIL(MUE))
PHDEXP=INT(FR_REXP_TO_EXP(OUTEXPFIL(MUE),RESNAME(MUE)))
DO ITEXP=1,NUMOUT
PHDBINLOC(ITEXP)=INT(100*OUTFIL(ITEXP,MUE))
END DO
PHDCHARLOC=OUTBINCHARFIL(MUE)
ELSE
PHDREXP=INT(100*OUTEXP(MUE))
PHDEXP=INT(FR_REXP_TO_EXP(OUTEXP(MUE),RESNAME(MUE)))
DO ITEXP=1,NUMOUT
PHDBINLOC(ITEXP)=INT(100*OUTPUT(ITEXP,MUE))
END DO
PHDCHARLOC=OUTBINCHAR(MUE)
END IF
IF (LDSSPREAD .EQV. .TRUE.) THEN
OBSEXP=RESACC(MUE)
OBSREXP=INT(100*FR_EXP_TO_REXP(OBSEXP,RESNAME(MUE)))
C ------------------
C version: real value (0 - 1)
C OBSCHAR=FC_REXP_TO_3STCHAR(DESEXP(MUE),
C + THREXP3ST(2),THREXP3ST(3))
C version: integer value (0 - 100)
OBSCHAR=FC_REXPI_TO_3STCHAR(INT(100*DESEXP(MUE)),
+ THREXP3STI(2),THREXP3STI(3))
C ------------------
ELSE
OBSEXP= 0
OBSREXP=0
OBSCHAR='U'
END IF
IF (LDSSPREAD .EQV. .TRUE.) THEN
WRITE(KUNIT,'(I4,A,A1,A,4(I3,A),I1,2(A,A1),10(A,I3))')
+ MUE,XC,RESNAME(MUE),XC,OBSEXP,XC,PHDEXP,XC,
+ OBSREXP,XC,PHDREXP,XC,RELIND(MUE),
+ XC,OBSCHAR,XC,PHDCHARLOC,
+ (XC,PHDBINLOC(ITEXP),ITEXP=1,NUMOUT)
ELSE
WRITE(KUNIT,'(I4,A,A1,A,2(I3,A),I1,A,A1,10(A,I3))')
+ MUE,XC,RESNAME(MUE),XC,PHDEXP,XC,
+ PHDREXP,XC,RELIND(MUE),XC,PHDCHARLOC,
+ (XC,PHDBINLOC(ITEXP),ITEXP=1,NUMOUT)
END IF
END DO
END
***** end of DATAOT_RDBEXP
***** ------------------------------------------------------------------
***** SUB DATAOT_RDBHTM
***** ------------------------------------------------------------------
C----
C---- NAME : DATAOT_RDBHTM
C---- ARG :
C---- DES : The prediction is written into a RDB file.
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: The prediction is written into a RDB file. *
* in variables: KUNIT *
* called by: DATAOT *
*----------------------------------------------------------------------*
SUBROUTINE DATAOT_RDBHTM(KUNIT)
C---- global parameters *
INCLUDE 'phdParameter.f'
C---- local functions
INTEGER FILEN_STRING
C---- local variables *
INTEGER KUNIT,ITSEC,MUE,IT
CHARACTER*1 XC,INTERDSSP,INTERPRED
CHARACTER*222 CTMP
******------------------------------*-----------------------------******
C---- default
XC=CHAR(9)
C---- header
WRITE(KUNIT,'(A)')'# Perl-RDB'
WRITE(KUNIT,'(A)')'# '
WRITE(KUNIT,'(A)')'# PHDhtm: prediction of helical '//
+ 'transmembrane regions'
WRITE(KUNIT,'(A)')'# '
CTMP=PROTNAME(1)
WRITE(KUNIT,'(A,T19,A)')
+ '# PDBID :',CTMP(1:FILEN_STRING(CTMP))
WRITE(KUNIT,'(A,T19,I5)')'# LENGTH :',NUMRES
WRITE(KUNIT,'(A)')'# NOTATION No : residue number '
WRITE(KUNIT,'(A)')'# NOTATION AA : amino acid one letter code'
IF (LDSSPREAD .EQV. .TRUE.) THEN
WRITE(KUNIT,'(A)')'# NOTATION OHL : observed transmembrane '//
+ 'helices'
END IF
WRITE(KUNIT,'(A)')
+ '# NOTATION PHL : predicted transmembrane helices'
WRITE(KUNIT,'(A)')'# NOTATION PHL : '//
+ 'H=helical membrane, L=no helical transmembrane'
WRITE(KUNIT,'(A)')'# NOTATION RI_S : '//
+ 'reliability of secondary structure prediction , 0-9'
WRITE(KUNIT,'(A)')'# NOTATION pH : '//
+ 'probability of predicting helix, 0-9'
WRITE(KUNIT,'(A)')
+ '# NOTATION pL : probability of predicting loop'
WRITE(KUNIT,'(A)')
+ '# NOTATION OtH : network output for helix, 0-100'
WRITE(KUNIT,'(A)')'# NOTATION OtL : network output for loop'
WRITE(KUNIT,'(A)')'# '
C---- column names and width
IF (LDSSPREAD .EQV. .TRUE.) THEN
WRITE(KUNIT,'(A2,A,A2,A,2(A4,A),A4,2(A,A2),2(A,A3))')
+ 'No',XC,'AA',XC,'OHL ',XC,'PHL ',XC,'RI_S',
+ XC,'pH',XC,'pL',XC,'OtH',XC,'OtL'
WRITE(KUNIT,'(A2,3(A,A1),3(A,A2),2(A,A2))')
+ '4N',(XC,'1',it=1,3),(XC,'1N',IT=1,3),(XC,'3N',IT=1,2)
ELSE
WRITE(KUNIT,'(A2,A,A2,A,A4,A,A4,2(A,A2),2(A,A3))')
+ 'No',XC,'AA',XC,'PHL ',XC,'RI_S',
+ XC,'pH',XC,'pL',XC,'OtH',XC,'OtL'
WRITE(KUNIT,'(A2,2(A,A1),3(A,A2),2(A,A2))')
+ '4N',(XC,'1',it=1,2),(XC,'1N',IT=1,3),(XC,'3N',IT=1,2)
END IF
C---- prediction: number, sequence, DSSP, prediction, Rel, Prob(H,E,L)
DO MUE=1,NUMRES
IF (LDSSPREAD .EQV. .TRUE.) THEN
INTERDSSP=CONVSECSTR(MUE)
ELSE
INTERDSSP='U'
END IF
IF ( (OUTBINCHARFIL(MUE).NE.'H').AND.
+ (OUTBINCHARFIL(MUE).NE.'G').AND.
+ (OUTBINCHARFIL(MUE).NE.'B').AND.
+ (OUTBINCHARFIL(MUE).NE.'E') ) THEN
INTERPRED='L'
ELSE
INTERPRED=OUTBINCHARFIL(MUE)
END IF
IF (LDSSPREAD .EQV. .TRUE.) THEN
WRITE(KUNIT,'(I4,A,3(A1,A),I1,2(A,I1),2(A,I3))')MUE,XC,
+ RESNAME(MUE),XC,INTERDSSP,XC,INTERPRED,XC,RELIND(MUE),
+ (XC,OUTBINPROB(ITSEC,MUE),ITSEC=1,NSECEL),
+ (XC,INT(100*OUTPUT(ITSEC,MUE)),ITSEC=1,NSECEL)
ELSE
WRITE(KUNIT,'(I4,A,2(A1,A),I1,2(A,I1),2(A,I3))')MUE,XC,
+ RESNAME(MUE),XC,INTERPRED,XC,RELIND(MUE),
+ (XC,OUTBINPROB(ITSEC,MUE),ITSEC=1,NSECEL),
+ (XC,INT(100*OUTPUT(ITSEC,MUE)),ITSEC=1,NSECEL)
END IF
END DO
END
***** end of DATAOT_RDBHTM
***** ------------------------------------------------------------------
***** SUB EVALDSSP
***** ------------------------------------------------------------------
C----
C---- NAME : EVALDSSP
C---- ARG :
C---- DES : The pay-off of the perceptron, i.e. its success is
C---- DES : evaluated
C---- DES : by computing certain measures of quality of the
C---- DES : prediction.
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: The pay-off of the perceptron, i.e. its success *
* -------- is evaluated by computing certain measures of *
* quality of the prediction. *
* called by: MAIN *
* calling: EVALSEC, EVALEXP *
*----------------------------------------------------------------------*
SUBROUTINE EVALDSSP
C---- parameters/global variables
INCLUDE 'phdParameter.f'
C---- local variables
INTEGER MUE
******------------------------------*-----------------------------******
C---------------------------------------------------
C---- convert secondary structure 8 -> 3
C---------------------------------------------------
DO MUE=1,NUMRES
IF (RESSECSTR(MUE).EQ.'G') THEN
CONVSECSTR(MUE)='H'
ELSEIF ((RESSECSTR(MUE).EQ.'I').OR.
+ (RESSECSTR(MUE).EQ.'S').OR.
+ (RESSECSTR(MUE).EQ.'B').OR.
+ (RESSECSTR(MUE).EQ.'T').OR.
+ (RESSECSTR(MUE).EQ.'L')) THEN
CONVSECSTR(MUE)=' '
ELSE
CONVSECSTR(MUE)=RESSECSTR(MUE)
END IF
END DO
C---------------------------------------------------
C---- secondary structure prediction -----
C---------------------------------------------------
IF (MODESECSTRON(1:9).EQ.'SECONDARY') THEN
write(6,*)'--- now entering: EVALSEC'
C ============
CALL EVALSEC
C ============
C---------------------------------------------------
C---- prediction of solvent exposure prediction ---
C---------------------------------------------------
ELSEIF (MODESECSTRON.EQ.'EXPOSURE') THEN
write(6,*)'--- now entering: EVALEXP'
C ============
CALL EVALEXP
C ============
END IF
END
***** end of EVALDSSP
***** ------------------------------------------------------------------
***** SUB EVALSEC
***** ------------------------------------------------------------------
C----
C---- NAME : EVALSEC
C---- ARG :
C---- DES : Secondary structure prediction accuracy.
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: The pay-off of the perceptron, i.e. its success *
* -------- is evaluated by computing certain measures of *
* quality of the prediction *
* input variables:CONVSECSTR, OUTBINCHAR *
* output variab.: MATNUM, MATLEN, MATLENDIS *
* --------------- RMATQOFDSSP, RMATQOFPRED, Q3, SQ, CORR, INFO *
* called by: EVALDSSP *
* calling: lib-prot.f: *
* SEVALPO, SEVALQUO, *
* procedure: See SEVALPO, SEVALQUO, *
*----------------------------------------------------------------------*
SUBROUTINE EVALSEC
C---- parameters/global variables
INCLUDE 'phdParameter.f'
C---- local variables
INTEGER MUE,DEVNOM,NSECEL_LOC
CHARACTER*3 TXT3
LOGICAL LWRITE
******------------------------------*-----------------------------******
* MUE,NUE,ITSEC,ITSEC2,ITER,ITHISTO,ITFILES iteration variables *
* CORR(i) correlation for class i, (Mathews) *
* MATLEN(i,j) matrix with the lengths of the elements: *
* i=1,4 => H,E,C,all *
* j=1 => number of elements DSSP *
* j=2 => number of elements PRED *
* j=2 => summed length of all elements for DSSP *
* j=2 => summed length of all elements for PRED *
* MATLENDIS(i,j) gives the distribution of the elements *
* i=1,50=> for histogram (lengths 1-50) *
* j=1,3 => H,E,C for DSSP *
* j=4,6 => H,E,C for PRED *
* MATNUM(i,j) the number of residues in a certain secondary *
* structure, i labels DSSP assignment, i.e. all *
* numbers with i=1 are according to DSSP helices, *
* j labels the prediction. That means, e.g.: *
* MATNUM(1,1) are all DSSP helices predicted to be *
* a helix,MATNUM(1,2) those DSSP helices predicted *
* as strands and MATNUM(1,4) all DSSP helices,resp.*
* MATNUM(4,4) all residues predicted. *
* RMATQOFDSSP(i,j) stores according to the same scheme as MATNUM *
* the percentages of residues predicted divided by *
* the numbers of DSSP (note no element (4,4) ) *
* RMATQOFPRED(i,j)same as previous but now percentages of prediction
* Q3 =properly predicted for all classes/all residues *
* SQ first divide predicted/DSSP in each class then *
* sum all classes and divide by e.g. 3 *
******------------------------------*-----------------------------******
C---- blow up states for TM prediction
IF (MODESECSTRON.EQ.'SECONDARY_HTM') THEN
NSECEL_LOC=3
ELSE
NSECEL_LOC=NSECEL
END IF
C---- evaluate filtered version
IF (.NOT.LFILTER) THEN
DO MUE=1,NUMRES
OUTBINCHARFIL(MUE)=OUTBINCHAR(MUE)
END DO
END IF
DO MUE=(NUMRES+1),NUMRESMAX
OUTBINCHARFIL(MUE)='x'
CONVSECSTR(MUE)='x'
END DO
C---- evaluating the pay-off numbers
C ============
CALL SEVALPO(NSECEL_LOC,NUMOUTMAX,NUMRES,NUMRESMAX,
+ CONVSECSTR,OUTBINCHARFIL,
+ MATNUM,RMATQOFDSSP,RMATQOFPRED,Q3,SQ,CORR)
C ============
C---- compute lengths of secondary structure elements
C =============
CALL SEVALLEN(NSECEL_LOC,NUMOUTMAX,NUMRES,NUMRESMAX,
+ 50,NHISTOMAX,RESSECSTR,OUTBINCHARFIL,MATLEN,MATLENDIS)
C =============
TITLE(1:8)='jury on '
C ----------------
CALL SINTTOCHAR(NUMNETJURY,TXT3)
C ----------------
TITLE(9:11)=TXT3
TITLE(12:20)='nets. '
LWRITE=.FALSE.
DEVNOM=50
C ==============
IF (MODESECSTRON.EQ.'SECONDARY_HTM') THEN
WRITE(6,*)'--- skip SEVALLEN for htm'
C CALL SEVALSEG(6,LWRITE,PROTNAME(1),
C + NSECEL_LOC,NUMOUTMAX,NUMRES,NUMRESMAX,1,
C + CONVSECSTR,OUTBINCHARFIL,2,NUMSEGOVERL,
C + COUNTSEGMAT,QLOV,QSOV,QFOV,DEVNOM,2)
ELSE
C =============
CALL SEVALSEG(6,LWRITE,PROTNAME(1),
+ NSECEL_LOC,NUMOUTMAX,NUMRES,NUMRESMAX,1,
+ CONVSECSTR,OUTBINCHARFIL,2,NUMSEGOVERL,
+ COUNTSEGMAT,QLOV,QSOV,QFOV,DEVNOM,2)
C ==============
END IF
C---- reconvert 'L' -> ' '
DO MUE=1,NUMRES
IF (OUTBINCHAR(MUE).EQ.'L') THEN
OUTBINCHAR(MUE)=' '
END IF
END DO
END
***** end of EVALSEC
***** ------------------------------------------------------------------
***** SUB EVALEXP
***** ------------------------------------------------------------------
C----
C---- NAME : EVALEXP
C---- ARG :
C---- DES : Solvent accessibility prediction accuracy.
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: Evaluates the prediction of solvent exposure. *
* const. passed: NUMRESMAX, NUMRES, *
* var. passed: in: RESACC, RESNAME, OUTEXP *
* ------------ -> out: DESEXP, DSSPVEC_I2, PREDVEC_I2, *
* EXP_NOINBIN, *
* OBS_NO2ST, *_NO3ST, *_NO10ST, *
* EXP_NO2ST, *_NO3ST, *_NO10ST, EXP_CORR *
* var. read: THREXP2ST, THREXP3ST *
* ext. SBR: lib-prot.f: SEXP_NOINBIN_2VEC, SEXP_NOINSTATES *
* ext. function lib-comp.f: FRCORRVEC_REAL4 *
* ------------- lib-prot.f: FR_EXP_TO_REXP *
* called by: EVALDSSP *
* calling:
*----------------------------------------------------------------------*
SUBROUTINE EVALEXP
C---- parameters/global variables
INCLUDE 'phdParameter.f'
C---- local function
REAL FR_EXP_TO_REXP,FRCORRVEC_REAL4
C---- local variables
INTEGER MUE
******------------------------------*-----------------------------******
C--------------------------------------------------
C---- convert exposure to bins 0-9
C--------------------------------------------------
DO MUE=1,NUMRES
C --------------
DESEXP(MUE)=FR_EXP_TO_REXP(RESACC(MUE),RESNAME(MUE))
C --------------
DSSPVEC_I2(MUE)=INT2(MIN(9.,SQRT(100*DESEXP(MUE))))
IF (LFILTER .EQV. .TRUE.) THEN
PREDVEC_I2(MUE)=INT2(MIN(9.,SQRT(100*OUTEXPFIL(MUE))))
ELSE
PREDVEC_I2(MUE)=INT2(MIN(9.,SQRT(100*OUTEXP(MUE))))
END IF
END DO
C--------------------------------------------------
C---- compute matrix of bin identities
C--------------------------------------------------
C ======================
CALL SEXP_NOINBIN_2VEC(NUMRESMAX,NUMRES,1,
+ DSSPVEC_I2,2,PREDVEC_I2,3,EXP_NOINBIN,3)
C ======================
C--------------------------------------------------
C---- evaluate correct predictions per state
C--------------------------------------------------
C ====================
CALL SEXP_NOINSTATES(EXP_NOINBIN,T2,T3A,T3B,1,
+ OBS_NOIN2ST,OBS_NOIN3ST,OBS_NOIN10ST,2,
+ EXP_NOIN2ST,EXP_NOIN3ST,EXP_NOIN10ST,2)
C ====================
C--------------------------------------------------
C---- evaluate correlation
C--------------------------------------------------
C ---------------
EXP_CORR=FRCORRVEC_REAL4(NUMRESMAX,NUMRES,DESEXP,OUTEXP,1.)
C ---------------
END
***** end of EVALEXP
***** ------------------------------------------------------------------
***** SUB EVALOUTBINPROB
***** ------------------------------------------------------------------
C----
C---- NAME : EVALOUTBINPROB
C---- ARG :
C---- DES : The real output values are used to compute the
C---- DES : probability
C---- DES : of the assignment to either secondary structure.
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: The real output values are used to compute the *
* -------- probability of the assignment to either secondary*
* structure. *
* in variables: OUTPUT *
* out variables: OUTBINPROB *
* called by: NETWORK *
* procedure: The real values are projected onto a grid of 0-9 *
* ---------- OUTBINPROB(i)=ngrid, if: *
* OUTPUT(i) *
* ----------------- > 0.ngrid and < 0.(ngrid-1) *
* sum/i {output(i)} *
*----------------------------------------------------------------------*
SUBROUTINE EVALOUTBINPROB
C---- global parameters *
INCLUDE 'phdParameter.f'
C---- local variables *
INTEGER ITOUT,ITOUT2,MUE,ITGRID
REAL SUM
LOGICAL LFOUND
******------------------------------*-----------------------------******
C--------------------------------------------------
C---- compute probabilities of assignment -----
C--------------------------------------------------
DO MUE=1,NUMRES
C------- compute sum
SUM=0.
DO ITOUT=1,NUMOUT
SUM=SUM+OUTPUT(ITOUT,MUE)
END DO
C------- mind potential division by zero
IF (SUM.LT.0.0001) THEN
SUM=1
DO ITOUT=1,NUMOUT
OUTPUT(ITOUT,MUE)=0
END DO
END IF
C------- now project onto grid:
DO ITOUT=1,NUMOUT
LFOUND=.FALSE.
DO ITGRID=1,10
IF ( (LFOUND.EQV. .FALSE.).AND.
+ ((OUTPUT(ITOUT,MUE)/SUM).GE.((ITGRID-1)/10.)).AND.
+ ((OUTPUT(ITOUT,MUE)/SUM).LE.(ITGRID/10.)) ) THEN
OUTBINPROB(ITOUT,MUE)=ITGRID-1
LFOUND=.TRUE.
END IF
END DO
IF (LFOUND.EQV. .FALSE.) THEN
WRITE(6,'(T2,A,T10,A,T60,I3)')'***',
+ 'ERROR in EVALOUTBINPROB: non found for numout=',
+ NUMOUT
WRITE(6,'(T2,A,T10,A,T16,I5,T25,A,T35,3F5.2,
+ T55,A,T65,F5.2)')'***','mue=',MUE,'OUTPUT:',
+ (OUTPUT(ITOUT2,MUE),ITOUT2=1,NUMOUT),'sum=',SUM
END IF
END DO
END DO
C---- end of loop over mue=1,numres
END
***** end of EVALOUTBINPROB
***** ------------------------------------------------------------------
***** SUB EVALRELIND
***** ------------------------------------------------------------------
C----
C---- NAME : EVALRELIND
C---- ARG :
C---- DES : Computation of reliability indices.
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: Computation of reliability indices. *
* called by: NETWORK *
* calling: EVALRELSEC, EVALRELEXP, EVALRELTM *
*----------------------------------------------------------------------*
SUBROUTINE EVALRELIND(LFILTERLOC)
C---- parameters/global variables
INCLUDE 'phdParameter.f'
C---- local variables
LOGICAL LFILTERLOC
******------------------------------*-----------------------------******
******------------------------------*-----------------------------******
C---------------------------------------------------
C---- secondary structure prediction -----
C---------------------------------------------------
IF (MODESECSTRON.EQ.'SECONDARY') THEN
C ===============
CALL EVALRELSEC
C ===============
C---------------------------------------------------
C---- prediction of solvent exposure prediction ---
C---------------------------------------------------
ELSEIF (MODESECSTRON.EQ.'EXPOSURE') THEN
C ===============
CALL EVALRELEXP(LFILTERLOC)
C ===============
C---------------------------------------------------
C---- prediction of trans-membrane regions ---
C---------------------------------------------------
ELSEIF (MODESECSTRON.EQ.'SECONDARY_HTM') THEN
C ===============
CALL EVALRELHTM(LFILTERLOC)
C ===============
END IF
END
***** end of EVALRELIND
***** ------------------------------------------------------------------
***** SUB EVALRELSEC
***** ------------------------------------------------------------------
C----
C---- NAME : EVALRELSEC
C---- ARG :
C---- DES : Computation of the reliability of the assignment of
C---- DES : secondary
C---- DES : structure according to the real values of the network
C---- DES : output.
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: Computation of the reliability of the assignment *
* -------- of secondary structure according to the real *
* values of the output of a network. *
* in parameter: NSECEL,NUMRESMAX *
* in variables: NUMRES, OUTPUT *
* out variables: MAXPOS, NUMRELIND, RELIND *
* called from: NETWORK *
* SBRs calling: *
* from personal libraries: *
* lib-comp.f: SRMAX1, SISTZ1, SISTZ2, SRSTZ1, *
* lib-unix.f: SFILEOPEN *
*----------------------------------------------------------------------*
SUBROUTINE EVALRELSEC
C---- parameters/global variables
INCLUDE 'phdParameter.f'
C---- local variables
INTEGER MUE,ITSEC,DIFF
INTEGER*2 ITER,INTERMAXPOS
C---- *********
INTEGER*2 MAXPOS(1:NUMRESMAX),SNDMAXPOS
C---- *********
REAL INTERMAXVAL,INTERMAX(1:NUMOUTMAX)
LOGICAL LHELP
******------------------------------*-----------------------------******
C--------------------------------------------------
C---- compute the reliability index (first: maxima)
C--------------------------------------------------
C----------------------------------------
C---- compute positions of maxima -----
C----------------------------------------
DO MUE=1,NUMRES
C security set zero
CALL SRSTZ1(INTERMAX,NUMOUTMAX)
C array -> vector
DO ITSEC=1,NSECEL
INTERMAX(ITSEC)=REAL(OUTPUT(ITSEC,MUE))/100.
END DO
C get maximum
CALL SRMAX1(INTERMAX,NUMOUTMAX,INTERMAXVAL,INTERMAXPOS)
MAXPOS(MUE)=INTERMAXPOS
C get second largest value
INTERMAX(INTERMAXPOS)=0
CALL SRMAX1(INTERMAX,NUMOUTMAX,INTERMAXVAL,INTERMAXPOS)
SNDMAXPOS=INTERMAXPOS
C----------------------------------------
C------- compute reliability index ------
C----------------------------------------
DIFF=INT(100*(OUTPUT(MAXPOS(MUE),MUE)-OUTPUT(SNDMAXPOS,MUE)))
C------- consistency
IF (DIFF.LT.0) THEN
WRITE(6,'(T2,A,T10,A,T60,I5)')'***',
+ 'ERROR IN EVALRELSEC: difference negative =',DIFF
WRITE(6,'(T2,A,T10,A,T20,I3,A,T35,I3,T45,3I4)')'***',
+ 'pos max: ',MAXPOS(MUE),'snd max:',SNDMAXPOS,
+ (OUTPUT(ITSEC,MUE),ITSEC=1,NSECEL)
WRITE(6,'(T2,A,T10,A,T20,I5,A)')'***',
+ 'for mue =',MUE,'stopped 28-10-92-1'
STOP
END IF
C------- search intervalls
IF (DIFF.EQ.0) THEN
RELIND(MUE)=0
ELSEIF (DIFF.GE.90) THEN
RELIND(MUE)=9
ELSE
LHELP=.TRUE.
DO ITER=1,9
IF ((LHELP.EQV. .TRUE.) .AND.
+ (DIFF.GE.((ITER-1)*10)) .AND.
+ (DIFF.LT.(ITER*10))) THEN
RELIND(MUE)=ITER
LHELP=.FALSE.
END IF
END DO
END IF
C------- end of computing reliability ---
C----------------------------------------
END DO
C--------------------------------------------------
C---- end of computation -----
C--------------------------------------------------
END
***** end of EVALRELSEC
***** ------------------------------------------------------------------
***** SUB EVALRELEXP
***** ------------------------------------------------------------------
C----
C---- NAME : EVALRELEXP
C---- ARG :
C---- DES : Computes reliability indices for the exposure prediction.
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: Computes the reliability indices for the *
* -------- prediction of exposure. *
* called by: EVALDSSP *
*----------------------------------------------------------------------*
SUBROUTINE EVALRELEXP(LFILTERLOC)
C---- parameters/global variables
INCLUDE 'phdParameter.f'
C---- local function
INTEGER FIRELIND_2ND3OFF
C---- local variables
INTEGER MUE,ITEXP
REAL OUTLOC(1:(NUMOUTMAX))
LOGICAL LFILTERLOC
******------------------------------*-----------------------------******
C--------------------------------------------------
C---- loop over all residues -----
C--------------------------------------------------
DO MUE=1,NUMRES
C -----------
CALL SRSTZ1(OUTLOC,NUMOUTMAX)
C -----------
IF (LFILTERLOC .EQV. .TRUE.) THEN
DO ITEXP=1,NUMOUT
OUTLOC(ITEXP)=OUTFIL(ITEXP,MUE)
END DO
ELSE
DO ITEXP=1,NUMOUT
OUTLOC(ITEXP)=OUTPUT(ITEXP,MUE)
END DO
END IF
C----------------------------------------
C------- relind
C----------------------------------------
C ----------------
RELIND(MUE)=INT2(FIRELIND_2ND3OFF(NUMOUTMAX,NUMOUT,OUTLOC))
C ----------------
C write(6,*)'xx mue=',mue,' ri=',relind(mue),' fil=',LFILTERLOC
END DO
C--------------------------------------------------
C---- end of loop over all residues ----
C--------------------------------------------------
END
***** end of EVALRELEXP
***** ------------------------------------------------------------------
***** SUB EVALRELHTM
***** ------------------------------------------------------------------
C----
C---- NAME : EVALRELHTM
C---- ARG :
C---- DES : Reliability indices for the transmembrane regions.
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: Computes the reliability indices for the *
* -------- prediction of transmembrane regions. *
* called by: EVALDSSP *
*----------------------------------------------------------------------*
SUBROUTINE EVALRELHTM(LFILTERLOC)
C---- parameters/global variables
INCLUDE 'phdParameter.f'
C---- local function
INTEGER FIRELIND_2ND
C---- local variables
INTEGER MUE,ITEXP
REAL OUTLOC(1:(NUMOUTMAX))
LOGICAL LFILTERLOC
******------------------------------*-----------------------------******
C--------------------------------------------------
C---- loop over all residues -----
C--------------------------------------------------
DO MUE=1,NUMRES
C security: set zero
CALL SRSTZ1(OUTLOC,NUMOUTMAX)
IF (LFILTERLOC .EQV. .TRUE.) THEN
DO ITEXP=1,NUMOUT
OUTLOC(ITEXP)=OUTFIL(ITEXP,MUE)
END DO
ELSE
DO ITEXP=1,NUMOUT
OUTLOC(ITEXP)=OUTPUT(ITEXP,MUE)
END DO
END IF
C----------------------------------------
C------- relind
C----------------------------------------
C ------------
RELIND(MUE)=INT2(FIRELIND_2ND(NUMOUTMAX,NUMOUT,OUTLOC,1.))
C ------------
END DO
C--------------------------------------------------
C---- end of loop over all residues ----
C--------------------------------------------------
END
***** end of EVALRELHTM
***** ------------------------------------------------------------------
***** SUB FILTER
***** ------------------------------------------------------------------
C----
C---- NAME : FILTER
C---- ARG :
C---- DES : The prediction is filtered (see FILTERSEC and
C---- DES : FILTEREXP)
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: The prediction is filtered according to: *
* SECONDARY STRUCTURE prediction *
* for helix of length 1,2: *
* if relindex >=4 -> extend in direction of *
* lowest relindex, until length =3 *
* else -> cut helix (make it 'L') *
* EXPOSURE prediction *
* averages over groups of 3 output units *
* input: OUTBINCHAR, RELIND, OUTPUT *
* output: OUTEXPFIL, OUTFIL, OUTBINCHARFIL *
* called by: MAIN *
* calling: FILTERSEC, FILTEREXP *
*----------------------------------------------------------------------*
SUBROUTINE FILTER
C---- parameters/global variables
INCLUDE 'phdParameter.f'
C---- local variables
LOGICAL LFILTERLOC
******------------------------------*-----------------------------******
C-------------------------------------------------------------
C---- secondary structure prediction -----
C-------------------------------------------------------------
IF (MODESECSTRON.EQ.'SECONDARY') THEN
C ==============
CALL FILTERSEC
C ==============
ELSEIF (MODESECSTRON.EQ.'EXPOSURE') THEN
C ==============
CALL FILTEREXP
C ==============
LFILTERLOC=.TRUE.
C ===============
CALL EVALRELIND(LFILTERLOC)
C ===============
END IF
END
***** end of FILTER
***** ------------------------------------------------------------------
***** SUB FILTERSEC
***** ------------------------------------------------------------------
C----
C---- NAME : FILTERSEC
C---- ARG :
C---- DES : The prediction is filtered according to: for helix of
C---- DES : length 1,2:
C---- DES : if relindex >=4 -> extend in direction of
C---- DES : lowest relindex, until length =3
C---- DES : else -> cut helix (make it 'L')
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: The prediction is filtered according to: *
* -------- for helix of length 1,2: *
* if relindex >=4 -> extend in direction of *
* lowest relindex, until length =3 *
* else -> cut helix (make it 'L') *
* input variables:OUTBINCHAR, RELIND *
* output variab.: OUTBINCHARFIL *
* called by: FILTER *
*----------------------------------------------------------------------*
SUBROUTINE FILTERSEC
C---- parameters/global variables
INCLUDE 'phdParameter.f'
C---- local variables
INTEGER MUE,ITLEN,COUNTLEN
LOGICAL FLAGINTER
******------------------------------*-----------------------------******
C----------------------------------------
C---- applying the filter --------
C----------------------------------------
C---- initially set equal filter=prediction
DO MUE=1,NUMRES
OUTBINCHARFIL(MUE)=OUTBINCHAR(MUE)
END DO
MUE=0
DO WHILE (MUE.LT.NUMRES)
MUE=MUE+1
C------- boundary check
IF (MUE.GT.NUMRES) THEN
WRITE(6,'(T2,A,T10,A)')'***',
+ 'ERROR: FILTERSEC (from phd) max number of samples exceeded!'
WRITE(6,'(T2,A,T10,A,T20,I4,T28,A,T38,I6)')'***',
+ 'mue=',mue,'numres=',numres
STOP
END IF
C------- look for helices
IF (OUTBINCHAR(MUE).EQ.'H') THEN
C---------- measure lengths of helical segments
FLAGINTER=.TRUE.
COUNTLEN=1
DO ITLEN=1,100
IF (FLAGINTER .EQV. .TRUE.) THEN
IF ((MUE.LE.(NUMRES-ITLEN)).AND.
+ (OUTBINCHAR(MUE+ITLEN).EQ.'H')) THEN
COUNTLEN=COUNTLEN+1
ELSE
FLAGINTER=.FALSE.
END IF
END IF
END DO
C---------- helix of length < 3?
IF (COUNTLEN.LT.3) THEN
FLAGINTER=.TRUE.
DO ITLEN=1,COUNTLEN
IF ( (FLAGINTER .EQV. .TRUE.) .AND.
+ (RELIND(MUE+ITLEN-1).GE.4)) THEN
FLAGINTER=.FALSE.
END IF
END DO
C------------- Relind < 4 for all residues -> cut
IF (FLAGINTER .EQV. .TRUE.) THEN
DO ITLEN=1,COUNTLEN
OUTBINCHARFIL(MUE+ITLEN-1)=' '
END DO
C------------- Relind >= 4 for one residue -> elongate!
ELSE
DO ITLEN=1,(3-COUNTLEN)
IF (MUE.LE.(NUMRES-(COUNTLEN+ITLEN))) THEN
C br: hack 2000-05-31: avoid going for 0 ..
IF ( (MUE.GE.2) .AND.
+ ((MUE-ITLEN).GT.0) ) THEN
IF (RELIND(MUE+COUNTLEN-1+ITLEN)
+ .LT.RELIND(MUE-ITLEN)) THEN
OUTBINCHARFIL(MUE+COUNTLEN-1+ITLEN)='H'
COUNTLEN=COUNTLEN+1
ELSE
OUTBINCHARFIL(MUE-ITLEN)='H'
END IF
ELSE
OUTBINCHARFIL(MUE+COUNTLEN-1+ITLEN)='H'
COUNTLEN=COUNTLEN+1
END IF
ELSE
OUTBINCHARFIL(MUE-ITLEN)='H'
END IF
END DO
END IF
END IF
MUE=MUE+COUNTLEN-1
END IF
END DO
C---- end of FILTERSEC -----
C--------------------------------------------------
END
***** end of FILTERSEC
***** ------------------------------------------------------------------
***** SUB FILTEREXP
***** ------------------------------------------------------------------
C----
C---- NAME : FILTEREXP
C---- ARG :
C---- DES : The prediction is filtered according to: averages over
C---- DES : groups of 3 output units
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: Filters the jury decision: averages over 3 *
* -------- nearest output neighbours. *
* input: OUTPUT, *
* in control: NUMRES, NUMOUT, NUMOUTMAX, *
* output: OUTFIL, OUTEXPFIL, OUTBINCHARFIL *
* called by: FILTER *
* calling: SR_FILTER_EXP, BINFIL *
* lib-prot.f: SRSTZ1 *
*----------------------------------------------------------------------*
SUBROUTINE FILTEREXP
C---- parameters/global variables
INCLUDE 'phdParameter.f'
C---- local variables
INTEGER MUE,ITEXP
REAL OUTLOC(1:NUMOUTMAX),OUTLOCFIL(1:NUMOUTMAX)
******------------------------------*-----------------------------******
C--------------------------------------------------
C---- loop over all residues
C--------------------------------------------------
DO MUE=1,NUMRES
DO ITEXP=1,NUMOUT
OUTLOC(ITEXP)=OUTPUT(ITEXP,MUE)
END DO
C------- shift emphasis away from buried, by subtracting
C------- from most buried state (0.04, 0.02 for 0 and 1, if >0.10)
IF (LREDUCE_BURRIED .EQV. .TRUE.) THEN
IF (OUTLOC(1).GT.REDUCE_MINSIZE) THEN
OUTLOC(1)=OUTLOC(1)-REDUCE_STATE0
END IF
IF (OUTLOC(2).GT.REDUCE_MINSIZE) THEN
OUTLOC(2)=OUTLOC(2)-REDUCE_STATE1
END IF
END IF
C -----------
CALL SRSTZ1(OUTLOCFIL,NUMOUTMAX)
C -----------
C------- nearest neighbour average
C ==================
CALL SR_FILTER_EXP(NUMOUTMAX,NUMOUT,OUTLOC,OUTLOCFIL)
C ==================
C------- store filtered output
DO ITEXP=1,NUMOUT
OUTFIL(ITEXP,MUE)=OUTLOCFIL(ITEXP)
END DO
C------- store filtered output
DO ITEXP=1,NUMOUT
OUTFIL(ITEXP,MUE)=OUTLOCFIL(ITEXP)
END DO
END DO
C---- end loop over all residues
C--------------------------------------------------
C--------------------------------------------------
C---- WTO decision -----
C--------------------------------------------------
C ===========
CALL BINFIL
C ===========
END
***** end of FILTEREXP
***** ------------------------------------------------------------------
***** SUB INIPHD
***** ------------------------------------------------------------------
C----
C---- NAME : INIPHD
C---- ARG :
C---- DES : The variables passed when calling phd are interpreted.
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: The variables passed when calling phd are *
* -------- interpreted (many ifs). *
*----------------------------------------------------------------------*
SUBROUTINE INIPHD(NUMARGUMENTS)
C---- include parameter files
INCLUDE 'phdParameter.f'
C---- local function
INTEGER FILEN_STRING
C---- local variables
INTEGER NUMARGUMENTS,LENTMPDIR,ITER,IHELP,IEND,IDIR
CHARACTER*222 TMPDIR,TMPLIST,INTERNAME,TXT80
LOGICAL LDEFAULT,LHELP,LOK,LFILE_PRED_DONE,LFILE_RDB_DONE
******------------------------------*-----------------------------******
C--------------------------------------------------
C---- defaults
C--------------------------------------------------
IEND= 0
LFILE_PRED_DONE=.FALSE.
LFILE_RDB_DONE= .FALSE.
FILEPRED= ' '
FILE_RDB= ' '
FILEOUTPUT= ' '
INTERNAME= ' '
C--------------------------------------------------
C---- arguments passed
C--------------------------------------------------
C LHELP=.FALSE.
LHELP=.TRUE.
IF (LHELP .EQV. .TRUE.) THEN
WRITE(6,'(T2,A3)')'---'
WRITE(6,'(T2,A3,T10,A)')'---',
+ 'Arguments given for calling FORTRAN program phd:'
DO ITER=1,NUMARGUMENTS
WRITE(6,'(A,T10,I3,T15,a1,A,A1)')' --- Arg ',ITER,'|',
+ CHAR_ARG_READ(ITER)(1:FILEN_STRING(CHAR_ARG_READ(ITER))),'|'
END DO
END IF
C--------------------------------------------------
C---- arg 2: read machine readable?
C--------------------------------------------------
IF ( (NUMARGUMENTS.GE.2).AND.
+ ((CHAR_ARG_READ(2).EQ.'MACH').OR.
+ (CHAR_ARG_READ(2).EQ.'mach').OR.
+ (CHAR_ARG_READ(2).EQ.'machine').OR.
+ (CHAR_ARG_READ(2).EQ.'MACHINE').OR.
+ (CHAR_ARG_READ(2).EQ.'MACHINE_READABLE').OR.
+ (CHAR_ARG_READ(2).EQ.'machine_readable')) ) THEN
LMACHINE_READABLE=.TRUE.
ELSE
LMACHINE_READABLE=.FALSE.
END IF
C--------------------------------------------------
C---- arg 3: write WhatIf output?
C--------------------------------------------------
IF ( (NUMARGUMENTS.GE.3).AND.
+ ((CHAR_ARG_READ(3).EQ.'WHATIF').OR.
+ (CHAR_ARG_READ(3).EQ.'WhatIf').OR.
+ (CHAR_ARG_READ(3).EQ.'whatif').OR.
+ (CHAR_ARG_READ(3).EQ.'Whatif').OR.
+ (CHAR_ARG_READ(3).EQ.'KG').OR.
+ (CHAR_ARG_READ(3).EQ.'kg')) ) THEN
LWHATIF=.TRUE.
ELSE
LWHATIF=.FALSE.
END IF
C--------------------------------------------------
C---- arg 4: prediction of exposure, or secondary structure?
C--------------------------------------------------
IF (NUMARGUMENTS.GE.4) THEN
IF ( (CHAR_ARG_READ(4)(1:3).EQ.'exp').OR.
+ (CHAR_ARG_READ(4)(1:3).EQ.'EXP').OR.
+ (CHAR_ARG_READ(4)(1:3).EQ.'acc').OR.
+ (CHAR_ARG_READ(4)(1:3).EQ.'ACC') ) THEN
MODESECSTRON='EXPOSURE'
NSECEL=0
ELSEIF ( (CHAR_ARG_READ(4)(1:3).EQ.'sec').OR.
+ (CHAR_ARG_READ(4)(1:3).EQ.'SEC') ) THEN
MODESECSTRON='SECONDARY'
NSECEL=3
ELSEIF ( (CHAR_ARG_READ(4)(1:3).EQ.'htm').OR.
+ (CHAR_ARG_READ(4)(1:3).EQ.'HTM') ) THEN
MODESECSTRON='SECONDARY_HTM'
NSECEL=2
ELSE
MODESECSTRON='SECONDARY'
NSECEL=3
END IF
ELSE
MODESECSTRON='SECONDARY'
END IF
C--------------------------------------------------
C---- arg 5: user phd -> LSERVER = True
C--------------------------------------------------
IF ( (NUMARGUMENTS.GE.5).AND.
+ ((CHAR_ARG_READ(5).EQ.'server').OR.
+ (CHAR_ARG_READ(5).EQ.'SERVER').OR.
+ (CHAR_ARG_READ(5).EQ.'phd').OR.
+ (CHAR_ARG_READ(5).EQ.'PHD')) ) THEN
LSERVER=.TRUE.
ELSE
LSERVER=.FALSE.
C------- be nice, say hello!
WRITE(6,'(T2,A)')'---'
WRITE(6,'(T2,70A1)')('-',ITER=1,70)
WRITE(6,'(T2,A3,T10,A)')'---',
+ 'Dear User, Welcome to PredictProtein !'
WRITE(6,'(T2,A)')'---'
END IF
C--------------------------------------------------
C---- set environment (change to port)
C--------------------------------------------------
IF (LSERVER .EQV. .TRUE.) THEN
PATH_PARACOM='/home/phd/net/'
ELSE
PATH_PARACOM='/home/rost/pub/'
END IF
LENPATH_PARACOM=FILEN_STRING(PATH_PARACOM)
C--------------------------------------------------
C---- arg 6: arch list -> see below
C----
C---- arg 7: write into interchange formatted file ?
C--------------------------------------------------
IF ( (NUMARGUMENTS.GE.7).AND.
+ ((CHAR_ARG_READ(7).EQ.'RDB').OR.
+ (CHAR_ARG_READ(7).EQ.'rdb').OR.
+ (CHAR_ARG_READ(7).EQ.'TMPRDB').OR.
+ (CHAR_ARG_READ(7).EQ.'tmprdb')) ) THEN
LRDB=.TRUE.
ELSE
LRDB=.FALSE.
END IF
C--------------------------------------------------
C---- arg 8: machine = DEC or ALPHA ?
C--------------------------------------------------
IF ( (NUMARGUMENTS.GE.8).AND.
+ ((CHAR_ARG_READ(8).EQ.'DEC').OR.
+ (CHAR_ARG_READ(8).EQ.'dec').OR.
+ (CHAR_ARG_READ(8).EQ.'ALPHA').OR.
+ (CHAR_ARG_READ(8).EQ.'alpha')) ) THEN
LDEC=.TRUE.
ELSE
LDEC=.FALSE.
END IF
C--------------------------------------------------
C---- arg 6: read list of architectures
C--------------------------------------------------
FILE_ARCHLIST(1:LENPATH_PARACOM)=PATH_PARACOM(1:LENPATH_PARACOM)
LDEFAULT=.FALSE.
LOK=.FALSE.
IF (NUMARGUMENTS.GE.6) THEN
IF (CHAR_ARG_READ(6).EQ.'nov93') THEN
LDEFAULT=.TRUE.
ELSEIF (CHAR_ARG_READ(6).EQ.'cic') THEN
TXT80='Para-cic.com'
ELSEIF (CHAR_ARG_READ(6)(1:7).EQ.'cic-152') THEN
TMPDIR(1:LENPATH_PARACOM)=PATH_PARACOM
TMPDIR((LENPATH_PARACOM+1):(LENPATH_PARACOM+5))='cross/'
LENTMPDIR=LENPATH_PARACOM+5
TMPLIST( 1:12)='Para-cic-152'
TMPLIST(13:13)=CHAR_ARG_READ(6)(8:8)
TMPLIST(14:17)='.com'
LOK=.TRUE.
FILE_ARCHLIST(1:LENTMPDIR)=TMPDIR(1:LENTMPDIR)
FILE_ARCHLIST((LENTMPDIR+1):(LENTMPDIR+17))=TMPLIST(1:17)
ELSEIF (CHAR_ARG_READ(6).EQ.'ind') THEN
TXT80='Para-ind.com'
ELSEIF (CHAR_ARG_READ(6).EQ.'crb') THEN
TXT80='Para-crb.com'
ELSEIF (CHAR_ARG_READ(6)(1:4).EQ.'Para') THEN
FILE_ARCHLIST=CHAR_ARG_READ(6)
LOK=.TRUE.
ELSEIF ( (CHAR_ARG_READ(6)(1:5).EQ.'para:').OR.
+ (CHAR_ARG_READ(6)(1:5).EQ.'para_') ) THEN
FILE_ARCHLIST=' '
IEND=FILEN_STRING(CHAR_ARG_READ(6))
FILE_ARCHLIST=CHAR_ARG_READ(6)(6:IEND)
LOK=.TRUE.
ELSEIF ( CHAR_ARG_READ(6)(1:1).EQ.'/' ) THEN
FILE_ARCHLIST=CHAR_ARG_READ(6)
LOK=.TRUE.
ELSE
LDEFAULT=.TRUE.
END IF
IF (LOK .EQV. .FALSE.) THEN
IHELP=FILEN_STRING(TXT80)
FILE_ARCHLIST((LENPATH_PARACOM+1):(LENPATH_PARACOM+IHELP))=
+ TXT80(1:IHELP)
END IF
ELSE
LDEFAULT=.TRUE.
END IF
C--------------------------------------------------
C---- arg 9-11: working directory and output files
C--------------------------------------------------
IF (NUMARGUMENTS.GE.9) THEN
IDIR=FILEN_STRING(CHAR_ARG_READ(9))
IF (IDIR.GT.3) THEN
PATH_WORK=CHAR_ARG_READ(9)(1:IDIR)
WRITE(6,'(A,T30,A1,A,A1)')' --- working directory ',
+ '"',PATH_WORK(1:FILEN_STRING(PATH_WORK)),'"'
END IF
END IF
IF (NUMARGUMENTS.GE.10) THEN
IDIR=FILEN_STRING(CHAR_ARG_READ(10))
IF (IDIR.GT.3) THEN
FILEPRED=CHAR_ARG_READ(10)(1:IDIR)
LFILE_PRED_DONE=.TRUE.
IEND=FILEN_STRING(FILEPRED)
WRITE(6,'(A,T30,A1,A,A1)')' --- FILEPRED ',
+ '"',FILEPRED(1:IEND),'"'
END IF
END IF
IF (NUMARGUMENTS.GE.11) THEN
IDIR=FILEN_STRING(CHAR_ARG_READ(11))
IF (IDIR.GT.3) THEN
FILE_RDB=CHAR_ARG_READ(11)(1:IDIR)
LFILE_RDB_DONE=.TRUE.
WRITE(6,'(A,T30,A1,A,A1)')' --- FILE_RDB ',
+ '"',FILE_RDB(1:FILEN_STRING(FILE_RDB)),'"'
END IF
END IF
C--------------------------------------------------
C default archictectures
C--------------------------------------------------
C VERSION_SEC=' 4.94_252 '
C VERSION_EXP=' 4.94_252 '
VERSION_SEC=' 5.94_317 '
VERSION_EXP=' 4.94_317 '
VERSION_HTM=' 8.94_69 '
IF (LDEFAULT .EQV. .TRUE.) THEN
IF (MODESECSTRON.EQ.'EXPOSURE') THEN
TXT80='Para-exp-mar94.com'
TXT80='Para-exp-apr94.com'
TXT80='Para-exp317-apr94.com'
ELSEIF (MODESECSTRON.EQ.'SECONDARY_HTM') THEN
TXT80='Para-htm69-aug94.com'
ELSE
TXT80='Para-nov93.com'
TXT80='Para-apr94.com'
TXT80='Para-sec317-may94.com'
END IF
IHELP=FILEN_STRING(TXT80)
FILE_ARCHLIST((LENPATH_PARACOM+1):(LENPATH_PARACOM+IHELP))=
+ TXT80(1:IHELP)
WRITE(6,'(T2,A,T10,A)')'---',
+ 'Read default architecture list for prediction: '
WRITE(6,'(T2,A,T10,A1,A,A1)')'---','|',
+ FILE_ARCHLIST(1:FILEN_STRING(FILE_ARCHLIST)),'|'
ELSEIF ( (FILE_ARCHLIST(1:11).EQ.'Para-exp317').OR.
+ (FILE_ARCHLIST(1:11).EQ.'Para-sec317') ) THEN
VERSION_SEC=' 5.94_317 '
VERSION_EXP=' 5.94_317 '
VERSION_HTM=' 8.94_69 '
END IF
C--------------------------------------------------
C---- adjust filename for output file -----
C--------------------------------------------------
IF (LSERVER .EQV. .FALSE.) THEN
C------- get out chain identifier
LHELP=.TRUE.
DO ITER=1,80
IF (LHELP .EQV. .TRUE.) THEN
IF ( FILE_HSSP(ITER:ITER+2).EQ.'_!_' ) THEN
LHELP=.FALSE.
IEND=ITER-1
END IF
END IF
END DO
IF (LHELP .EQV. .TRUE.) THEN
FILE_HSSP_NOCHAIN=FILE_HSSP
ELSE
FILE_HSSP_NOCHAIN(1:IEND)=FILE_HSSP(1:IEND)
END IF
C------- get unique file id
LHELP=.TRUE.
DO ITER=1,80
IF (LHELP .EQV. .TRUE.) THEN
IF ( (FILE_HSSP(ITER:ITER+3).EQ.'hssp').OR.
+ (FILE_HSSP(ITER:ITER+3).EQ.'Hssp').OR.
+ (FILE_HSSP(ITER:ITER+3).EQ.'HSSP') ) THEN
LHELP=.FALSE.
IEND=ITER-2
END IF
END IF
END DO
C------- pred file
IF (.NOT.LFILE_PRED_DONE) THEN
FILEPRED(1:IEND)=FILE_HSSP(1:IEND)
FILEPRED((IEND+1):(IEND+5))='.pred'
WRITE(6,'(A,T30,A1,A,A1)')' --- FILEPRED ',
+ '"',FILEPRED(1:FILEN_STRING(FILEPRED)),'"'
END IF
C------- *.rdb
IF (LRDB.AND.(.NOT.LFILE_RDB_DONE)) THEN
FILE_RDB=FILE_HSSP(1:IEND)
IF (MODESECSTRON.EQ.'SECONDARY') THEN
FILE_RDB(IEND+1:IEND+7)='.rdbsec'
ELSEIF (MODESECSTRON.EQ.'EXPOSURE') THEN
FILE_RDB(IEND+1:IEND+7)='.rdbexp'
ELSEIF (MODESECSTRON.EQ.'SECONDARY_HTM') THEN
FILE_RDB(IEND+1:IEND+7)='.rdbhtm'
END IF
WRITE(6,'(A,T30,A1,A,A1)')' --- FILE_RDB ',
+ '"',FILE_RDB(1:FILEN_STRING(FILE_RDB)),'"'
END IF
C------- output (into working)
IDIR=FILEN_STRING(PATH_WORK)
IF (IDIR.GT.3) THEN
FILEOUTPUT(1:IDIR)=PATH_WORK(1:IDIR)
ELSE
IDIR=0
END IF
FILEOUTPUT(IDIR+1:IDIR+IEND)=FILE_HSSP(1:IEND)
FILEOUTPUT(IDIR+IEND+1:IDIR+IEND+7) ='.output'
C--------------------------------------------------
C---- for phd on server: read name of HSSP file
C--------------------------------------------------
ELSE
C------- get unique file id
LHELP=.TRUE.
DO ITER=1,222
IF (LHELP .EQV. .TRUE.) THEN
IF (FILE_HSSP(ITER:ITER).NE.'.') THEN
INTERNAME(ITER:ITER)=FILE_HSSP(ITER:ITER)
ELSE
IEND=ITER-1
LHELP=.FALSE.
END IF
END IF
END DO
FILE_HSSP_NOCHAIN=FILE_HSSP
C------- pred file
IF (LFILE_PRED_DONE .EQV. .FALSE.) THEN
FILEPRED(1:IEND)=INTERNAME(1:IEND)
FILEPRED((IEND+1):(IEND+5))='.pred'
END IF
C------- *.rdb
IF ((LRDB .EQV. .TRUE.) .AND. (.NOT.LFILE_RDB_DONE)) THEN
FILE_RDB=FILE_HSSP(1:IEND)
IF (MODESECSTRON.EQ.'SECONDARY') THEN
FILE_RDB(IEND+1:IEND+7)='.rdbsec'
ELSEIF (MODESECSTRON.EQ.'EXPOSURE') THEN
FILE_RDB(IEND+1:IEND+7)='.rdbexp'
ELSEIF (MODESECSTRON.EQ.'SECONDARY_HTM') THEN
FILE_RDB(IEND+1:IEND+7)='.rdbhtm'
END IF
END IF
C------- output (into working)
IDIR=FILEN_STRING(PATH_WORK)
IF (IDIR.GT.3) THEN
FILEOUTPUT(1:IDIR)=PATH_WORK(1:IDIR)
ELSE
IDIR=0
END IF
FILEOUTPUT(IDIR+1:IDIR+IEND)=INTERNAME(1:IEND)
FILEOUTPUT(IDIR+IEND+1:IDIR+IEND+7)='.output'
END IF
C--------------------------------------------------
C---- filter asf
C--------------------------------------------------
IF (MODESECSTRON.EQ.'SECONDARY_HTM') THEN
LFILTER=.FALSE.
ELSE
C LFILTER=.FALSE.
LFILTER=.TRUE.
END IF
LOUTBINPROB=.TRUE.
C--------------------------------------------------
C---- initialise length intervals
C--------------------------------------------------
C---- note: unit i = 1, if length <= split_length(i)
IF (NUNITS_LENGTH.NE.4) THEN
WRITE(6,'(T2,A,T10,A)')'***','ERROR in INIPHD: '//
+ 'currently only for NUNITS_LENGTH = 4 (phdParameter.f) !'
WRITE(6,'(T2,A,T10,A,T40,I5,T50,A)')'***',
+ 'instead it is: ',NUNITS_LENGTH,'stopped 29-12-93-1.'
STOP
ELSE
SPLIT_LENGTH(1)=60
SPLIT_LENGTH(2)=120
SPLIT_LENGTH(3)=240
SPLIT_LENGTH(4)=500
SPLIT_LENGTH(4)=NUMRESMAX
END IF
C---- note: unit i = 1, if distcaps <= split_distcaps(i)
IF (NUNITS_DISTCAPS.NE.4) THEN
WRITE(6,'(T2,A,T10,A)')'***','ERROR in INIPHD: '//
+ 'currently only for NUNITS_DISTCAPS = 4 (phdParameter.f) !'
WRITE(6,'(T2,A,T10,A,T40,I5,T50,A)')'***',
+ 'instead it is: ',NUNITS_DISTCAPS,'stopped 29-12-93-1.'
STOP
ELSE
SPLIT_DISTCAPS(1)=10
SPLIT_DISTCAPS(2)=20
SPLIT_DISTCAPS(3)=30
SPLIT_DISTCAPS(4)=40
SPLIT_DISTCAPS(5)=NUMRESMAX
END IF
C--------------------------------------------------
C---- exposure thresholds and filtering stuff
C--------------------------------------------------
IF (MODESECSTRON.EQ.'EXPOSURE') THEN
MAXEXP=1
DO ITER=1,10
THREXP10ST(ITER)=(ITER-1)*(ITER-1)*MAXEXP/100.
C convert to integer
THREXP10STI(ITER)=INT(100*THREXP10ST(ITER))
END DO
THREXP2ST(1)= 0.
THREXP2ST(2)= (16/100.)*MAXEXP
THREXP2ST(3)= MAXEXP
C convert to integer
DO ITER=1,3
THREXP2STI(ITER)=INT(100*THREXP2ST(ITER))
END DO
THREXP3ST(1)=0.
THREXP3ST(2)=( 9/100.)*MAXEXP
THREXP3ST(3)=( 36/100.)*MAXEXP
THREXP3ST(4)=MAXEXP
C convert to integer
DO ITER=1,4
THREXP3STI(ITER)=INT(100*THREXP3ST(ITER))
END DO
T2= 4
T3A=3
T3B=6
C------- filter variables (reduce the emphasis on states 0 and 1%)
LREDUCE_BURRIED=.TRUE.
LREDUCE_BURRIED=.FALSE.
REDUCE_MINSIZE=0.1
REDUCE_STATE0=0.04
REDUCE_STATE1=0.02
END IF
END
***** end of INIPHD
***** ------------------------------------------------------------------
***** SUB NETWORK
***** ------------------------------------------------------------------
C----
C---- NAME : NETWORK
C---- ARG :
C---- DES : This SBR first executes the networks trigger function by
C---- DES : calling SBR TRIGGER for all architectures. Then, the out-
C---- DES : puts are summed up to finally compute the jury decision.
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: This SBR first executes the networks trigger *
* -------- function by calling SBR TRIGGER for all archi- *
* tectures. Then, the outputs are summed up to *
* finally compute the jury decision. *
* const. passed: NUMRES, NUMOUT, NUMNETSND, NUMNETFST *
* var. passed: in: INPUT, FILEARCHFST, FILEARCHSND *
* ------------ out: OUTPUT, OUTBIN, OUTBINCHAR *
* var. read: NUMIN,NUMHID,NUMOUT,JUNCTION1ST,JUNCTION2ND *
* ---------- NUMINFST, NUMINSND, NCODEUNTSND, NCODEUNT *
* NUMNEIGH, CASCAC* *
* calling: SBR: READARCH, WINDIR, TRIGGER, BINOUT, *
* -------- EVALRELIND, EVALOUTBINPROB *
* lib-comp.f: SRSTZ1 *
* called by: main program *
*----------------------------------------------------------------------*
SUBROUTINE NETWORK
C---- parameters/global variables
INCLUDE 'phdParameter.f'
C---- local parameters
LOGICAL LCHECK_WRITE
PARAMETER (LCHECK_WRITE=.FALSE.)
C PARAMETER (LCHECK_WRITE=.TRUE.)
C---- local variables
INTEGER CHI,MUE,ITOUT,MSTOP
REAL INTEROUT(1:(NUMOUTMAX))
C CHARACTER*24 FDATE
LOGICAL LFILTERLOC
******------------------------------*-----------------------------******
* CHI,MUE,ITSEC,ITOUT: iteration variables *
* CONTROLCHAR controls how the header is to be read: *
* 'FST' -> first network *
* 'SND' -> second network *
* INTEROUT(itout) used to sum up the outputs over all jury networks*
******------------------------------*-----------------------------******
C XDTE=FDATE()
C--------------------------------------------------
C---- loop over all first architectures -----
C--------------------------------------------------
DO CHI=1,NUMNETFST
ACTCHI=CHI
ACTFILE=FILEARCHFST(CHI)
C----------------------------------------
C------- read architecture ACTCHI -----
C----------------------------------------
CONTROLCHAR='FST'
C =============
CALL READARCH
C =============
C------- assign input
C ===========
CALL WINDIR
C ===========
C----------------------------------------
C------- compute output of 1st nets -----
C----------------------------------------
C ============
CALL TRIGGER
C ============
C------- store output in OUTFST
DO MUE=1,NUMRES
DO ITOUT=1,NUMOUT
OUTFST(ITOUT,MUE,CHI)=OUTPUT(ITOUT,MUE)
END DO
C---------- check output
MSTOP=10
IF (LCHECK_WRITE .EQV. .TRUE.) THEN
IF (MUE.LE.MSTOP) THEN
WRITE(6,'(I3,A5,10I4,a5,i3)')MUE,' -> ',
+ (INT(100*OUTPUT(ITOUT,MUE)),ITOUT=1,NUMOUT),
+ ' obs ',RESACC(MUE)
ELSEIF (MUE.EQ.(MSTOP+1)) THEN
WRITE(6,*)'STOPPED IN NETWORK YY'
C STOP
END IF
END IF
END DO
END DO
C--------------------------------------------------
C---- end of loop over all first architectures ----
C--------------------------------------------------
C--------------------------------------------------
C---- loop over all second architectures -----
C--------------------------------------------------
DO CHI=1,NUMNETSND
ACTCHI=CHI
ACTFILE=FILEARCHSND(CHI)
C----------------------------------------
C------- read architecture ACTCHI -----
C----------------------------------------
CONTROLCHAR='SND'
C =============
CALL READARCH
C =============
C----------------------------------------
C------- compute output of 2nd nets -----
C----------------------------------------
C------- assign windows for input
C ===========
CALL WINDIR
C ===========
C------- compute network trigger
C ============
CALL TRIGGER
C ============
C------- store output in OUTSND
DO MUE=1,NUMRES
DO ITOUT=1,NUMOUT
OUTSND(ITOUT,MUE,CHI)=OUTPUT(ITOUT,MUE)
END DO
END DO
END DO
WRITE(6,'(T2,A,T10,A)')'---','end of READARCH'
WRITE(6,'(T2,70A1)')('-',ITOUT=1,70)
WRITE(6,'(T2,A)')'---'
C--------------------------------------------------
C---- end of loop over all second architectures ---
C--------------------------------------------------
C--------------------------------------------------
C---- add up outputs for jury decision -----
C--------------------------------------------------
C----------------------------------------
C---- loop over all residues -----
C----------------------------------------
DO MUE=1,NUMRES
C -----------
CALL SRSTZ1(INTEROUT,NUMOUTMAX)
C -----------
DO ITOUT=1,NUMOUT
C---------- loop over all jury 2ND nets
IF (NUMNETSND.NE.0) THEN
DO CHI=1,NUMNETSND
INTEROUT(ITOUT)=INTEROUT(ITOUT)+OUTSND(ITOUT,MUE,CHI)
END DO
INTEROUT(ITOUT)=INTEROUT(ITOUT)/REAL(NUMNETSND)
C---------- loop over all jury 1ST nets
ELSE
DO CHI=1,NUMNETFST
INTEROUT(ITOUT)=INTEROUT(ITOUT)+OUTFST(ITOUT,MUE,CHI)
END DO
INTEROUT(ITOUT)=INTEROUT(ITOUT)/REAL(NUMNETFST)
END IF
OUTPUT(ITOUT,MUE)=INTEROUT(ITOUT)
END DO
C write(6,'(a,t20,10i3)')'xxx network out',
C + (int(100*output(itout,mue)),itout=1,numout)
END DO
C--------------------------------------------------
C---- end of jury decision -----
C--------------------------------------------------
C--------------------------------------------------
C------- WTO decision -----
C--------------------------------------------------
C ===========
CALL BINOUT
C ===========
C--------------------------------------------------
C---- assigning reliability index -----
C--------------------------------------------------
cxx check exposure
LFILTERLOC=.FALSE.
C ===============
CALL EVALRELIND(LFILTERLOC)
C ===============
C--------------------------------------------------
C---- computing probability of assignment -----
C---- i.e. the 0-9 % values for each outpt unit
C--------------------------------------------------
IF (LOUTBINPROB .EQV. .TRUE.) THEN
C ===================
CALL EVALOUTBINPROB
C ===================
END IF
END
***** end of NETWORK
***** ------------------------------------------------------------------
***** SUB READARCH
***** ------------------------------------------------------------------
C----
C---- NAME : READARCH
C---- ARG :
C---- DES : The data is read from files containing the junctions.
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: The data is read from files containing the *
* -------- junctions. *
* input var.: ACTFILE, ACTCHI, CONTROLPAR *
* note: The parameters and variables are taken from the *
* ----- file parsecstron, see there for further details *
*----------------------------------------------------------------------*
SUBROUTINE READARCH
C---- global parameter *
INCLUDE 'phdParameter.f'
C---- local function
INTEGER FILEN_STRING
C---- local variables
INTEGER ITER,ITER1,IEND
CHARACTER*20 DUMMY20
CHARACTER*3 DUMMY3
LOGICAL LOK
C LOGICAL FL_OTHER
******------------------------------*-----------------------------******
C---- write note into output
IEND= FILEN_STRING(ACTFILE)
WRITE(6,'(T2,A,T10,A,T20,A3,A2,T26,I2,T30,A)')'---',
+ 'READARCH ',CONTROLCHAR(1:3),': ',ACTCHI,ACTFILE(1:IEND)
C---- read file
CALL SFILEOPEN(10,ACTFILE(1:IEND),'OLD',222,'READONLY')
C---- header = 15 lines
DO ITER=1,15
READ(10,*)
END DO
C---- architecture parameters = 11 lines --> 25 so far
IF (CONTROLCHAR.EQ.'FST') THEN
READ(10,'(A20,A20)')DUMMY20,DUMMY20
C LOK=FL_OTHER(XDTE)
Cxxpass LOK=FL_OTHER(XDTE)
LOK=.TRUE.
IF ((DUMMY20(1:5).NE.'FIRST').OR.(LOK .EQV. .FALSE.)) THEN
WRITE(6,'(T2,A,T10,A)')'***',
+ 'ERROR in READARCH for reading in an expected first net'
CLOSE(10)
STOP
END IF
READ(10,*)
READ(10,'(A20,A20)')DUMMY20,MODEASSCAS(ACTCHI)
IF (MODEASSCAS(ACTCHI).EQ.'ALPHABET') THEN
MODEASSCAS(ACTCHI)='PROFILE-REAL'
END IF
ELSE
READ(10,'(A20,A20)')DUMMY20,DUMMY20
IF (DUMMY20(1:6).NE.'SECOND') THEN
WRITE(6,'(T2,A,T10,A)')'***',
+ 'ERROR in READARCH for reading in an expected snd net'
CLOSE(10)
STOP
END IF
READ(10,'(A20,I6)')DUMMY20,CASCACC
READ(10,'(A20,A20)')DUMMY20,MODEASSSTR(ACTCHI)
END IF
READ(10,'(A20,I6)')DUMMY20,NUMIN
READ(10,'(A20,I6)')DUMMY20,NUMHID
READ(10,'(A20,I6)')DUMMY20,NUMOUT
READ(10,'(A20,I6)')DUMMY20,NCODEUNT
READ(10,'(A20,I6)')DUMMY20,NUMNEIGH
READ(10,*)
READ(10,*)
C---- architecture rest
C--------------------------------------------------
C---- unfortunately the new format does not have --
C---- mode DIL, thus the last units (nmach) not --
C---- there --
C--------------------------------------------------
READ(10,*)
DO ITER=1,NUMHID
READ(10,'(10F10.4)')
+ (JUNCTION1ST(ITER1,ITER),ITER1=1,(NUMIN+NUMOUT))
C write(6,'(10F10.4)')
C + (JUNCTION1ST(ITER1,ITER),ITER1=1,(NUMIN+NUMOUT))
END DO
READ(10,*)
DO ITER=1,(NUMHID+NUMOUT)
READ(10,'(10F10.4)')(JUNCTION2ND(ITER,ITER1),ITER1=1,NUMOUT)
C write(6,'(10F10.4)')(JUNCTION2ND(ITER,ITER1),ITER1=1,NUMOUT)
END DO
C---- control
READ(10,'(A3)')dummy3
CLOSE(10)
IF (DUMMY3.NE.'END') THEN
WRITE(6,'(T2,A,T10,A)')'*****',
+ 'ERROR for reading in the architectures, here for:'
WRITE(6,'(T2,A,T10,A,T25,A,T30,A,T40,I4,T45,A,T52,A)')'*****',
+ 'controlchar=',CONTROLCHAR,'actchi=',ACTCHI,'ACTFILE=',
+ ACTFILE
STOP
END IF
END
***** end of READARCH
***** ------------------------------------------------------------------
***** SUB READPAR
***** ------------------------------------------------------------------
C----
C---- NAME : READPAR
C---- ARG :
C---- DES : Reads in the required parameters from the parameter file:
C---- DES : Parameter.com.
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: This SBR reads in the required parameters from *
* -------- the parameter file: Parameter.com. *
* const. passed: NUMNETSND,NUMNETFST *
* var. read: MAXVAR, MAXACC, PROFACC, CASCACC *
* ---------- NUMNETFST,NUMNETSND,NUMNETJURY *
* NCODEUNTFST, NCODEUNTSND(1:NUMNETSND) *
* TRANS2FROM1(1:NUMNETSND), *
* MODEASSCAS(1:NUMNETFST),MODEASSSTR(1:NUMNETSND) *
* FILEPRED,FILEARCHFST(1:FST)/SND(1:SND) *
* ext. SBR: SFILEOPEN (lib-unix) *
* called by: main program *
*----------------------------------------------------------------------*
SUBROUTINE READPAR
C---- include parameter files
INCLUDE 'phdParameter.f'
C---- local function
INTEGER FILEN_STRING
C---- local variables
INTEGER ITER,INTER,IBEG,IEND
CHARACTER*3 DUMMY3
CHARACTER*20 DUMMY20
CHARACTER*222 HC
******------------------------------*-----------------------------******
C---- read parameters from file Parameter.f
cxx
C FILE_ARCHLIST='Para-test.com'
C write(6,*)'xx in READPAR: forced change of parameter file to:'
C write(6,*)'xx ',FILE_ARCHLIST
CALL SFILEOPEN(10,FILE_ARCHLIST,'OLD',222,'READONLY')
C---- header = 14 lines
DO ITER=1,14
READ(10,*)
END DO
C---- paths
READ(10,*)
C READ(10,'(T21,A)')PATH_PRED
READ(10,'(T21,A)')PATH_ARCH
C READ(10,'(T21,A)')PATH_WORK
C---- architecture parameters = 11 lines --> 25 so far
READ(10,*)
READ(10,'(A20,I6)')DUMMY20,MAXVAR
READ(10,'(A20,I6)')DUMMY20,MAXACC
READ(10,'(A20,I6)')DUMMY20,PROFACC
READ(10,'(A20,I6)')DUMMY20,CASCACC
READ(10,'(A20,I6)')DUMMY20,NBIOLOBJ
READ(10,*)
READ(10,'(A20,I6)')DUMMY20,NUMNETFST
READ(10,'(A20,I6)')DUMMY20,NUMNETSND
READ(10,'(A20,I6)')DUMMY20,NUMNETJURY
C >*****
C > TRANS2FROM1(1:NUMNETSND) (20I4)
IF (NUMNETSND.NE.0) THEN
READ(10,*)
READ(10,*)
READ(10,'(20I4)')(TRANS2FROM1(ITER),ITER=1,NUMNETSND)
END IF
C >*****
C > MODEASSCAS(1:NUMNETFST) (row: no. A25)
READ(10,*)
READ(10,*)
DO ITER=1,NUMNETFST
READ(10,'(I10,T21,A)')INTER,MODEASSCAS(ITER)
END DO
C >*****
C > MODEASSSTR(1:NUMNETSND) (row: no. A25)
IF (NUMNETSND.NE.0) THEN
READ(10,*)
READ(10,*)
DO ITER=1,NUMNETSND
READ(10,'(I10,T21,A)')INTER,MODEASSSTR(ITER)
END DO
END IF
C >*****
C > FILEARCHFST(1:NUMNETFST) (row: no. A50)
READ(10,*)
READ(10,*)
DO ITER=1,NUMNETFST
READ(10,'(I10,T21,A)')INTER,FILEARCHFST(ITER)
END DO
C > FILEASND(1:NUMNETSND) (row: no. A50)
IF (NUMNETSND.NE.0) THEN
READ(10,*)
DO ITER=1,NUMNETSND
READ(10,'(I10,T21,A)')INTER,FILEARCHSND(ITER)
END DO
END IF
C---- control
READ(10,'(A3)')DUMMY3
CLOSE(10)
IF (DUMMY3.NE.'END') THEN
WRITE(6,'(T2,A,T10,A,T50,A40)')'*****',
+ 'ERROR for reading in the parameter file ',
+ FILE_ARCHLIST
stop
END IF
C--------------------------------------------------
C---- adding path_arch to file names
C--------------------------------------------------
IF (FILEN_STRING(PATH_ARCH).GT.1) THEN
DO ITER=1,NUMNETFST
HC=PATH_ARCH
IBEG=FILEN_STRING(PATH_ARCH)+1
IEND=IBEG+FILEN_STRING(FILEARCHFST(ITER))-1
HC(IBEG:IEND)=FILEARCHFST(ITER)
FILEARCHFST(ITER)(1:IEND)=HC(1:IEND)
END DO
DO ITER=1,NUMNETSND
HC=PATH_ARCH
IBEG=FILEN_STRING(PATH_ARCH)+1
IEND=IBEG+FILEN_STRING(FILEARCHSND(ITER))-1
HC(IBEG:IEND)=FILEARCHSND(ITER)
FILEARCHSND(ITER)(1:IEND)=HC(1:IEND)
END DO
END IF
C---- bullshit to avoid warning
IF (INTER.GT.1) THEN
CONTINUE
END IF
IF (DUMMY20.EQ.'XX') THEN
CONTINUE
END IF
END
***** end of READPAR
***** ------------------------------------------------------------------
***** SUB RS_GETHSSP
***** ------------------------------------------------------------------
C----
C---- NAME : RS_GETHSSP
C---- ARG :
C---- DES : Reading the protein from an HSSP file: FILE_HSSP
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
* changed: Aug, 2003 version 1.2 *
*----------------------------------------------------------------------*
C purpose: Reading the protein from an HSSP file: FILE_HSSP *
C input parameter:NUMPROTMAX,NUMRESMAX *
C input variable: FILE_HSSP *
C output variable:PROTNAME,RESNAME,NUMRES *
C ----------------POINTBEG,POINTEND,RESSECSTR,RESACC,RESVAR *
C RESPROF *
C Note: Program taken from Reinhard Schneider *
C=======================================================================
C NUMPROT: number of proteins in compressed database
C POINTBEG: pointer to begining of protein
C POINTEND: pointer to end of protein
C PROTNAME Brookhaven Data Bank identifier
C RESNAME: sequential storage for the SEQUENCE
C NOTE: lower case characters are 'C'; lower case of
C HSSP-files (insertions) are converted in RS_GETHSSPBASE
C RESSECSTR: sequential storage for the SECONDARY STRUCTURE
C NOTE: original DSSP definition
C=======================================================================
C CAUTION: RESVAR and RESACC are INTEGER*2
C=======================================================================
C RESACC: solvated residue surface area in A**2
C RESVAR: sequence variability as derived from the nalign
C alignments
C OFFSET: offset of aligned sequence (HSSP-alignment) to PDBSEQ
C=======================================================================
C-----------------------------------------------------------------------
C Reinhard Schneider December, 1991 *
C-----------------------------------------------------------------------
*----------------------------------------------------------------------*
SUBROUTINE RS_GETHSSP
C---- global parameters
INCLUDE 'phdParameter.f'
C---- local parameters and variables
INTEGER KDSSP
C INTEGER MAXRESBASE
C PARAMETER (MAXRESBASE= NUMRESMAX)
PARAMETER (KDSSP= 12)
C INTEGER MAXRES,MAXAA
C
C now defined in parameter file!!
C
C PARAMETER (MAXALIGNS= 3000)
C PARAMETER (MAXALIGNS= 5000)
C PARAMETER (MAXCORE= 500000)
C PARAMETER (MAXCORE= 100000)
C PARAMETER (MAXAA= 20)
C.. Attributes of individual proteins
INTEGER ACCBASE(NUMRESMAX)
INTEGER VARIABILITY(NUMRESMAX)
INTEGER PROFILE(NUMRESMAX,MAXAA)
INTEGER WRT_NINS(NUMRESMAX),WRITENDEL(NUMRESMAX)
C INTEGER WRT_NALIGN(NUMPROTMAX)
INTEGER WRT_NALIGN(MAXALIGNS)
REAL*4 WRT_CONSWEIGHT(NUMRESMAX)
C.. attributes of all proteins
INTEGER PROTBEGIN(MAXALIGNS),PROTEND(0:MAXALIGNS)
CHARACTER CSEQBASE(NUMRESMAX)
CHARACTER CSTRBASE(NUMRESMAX)
CHARACTER*132 CPROTID(MAXALIGNS)
INTEGER NPROT,NCHAINBREAK,NPROTBREAK,
+ OFFSET(MAXALIGNS)
C THRESHOLD for HSSP alignments
C.. LOGICAL
LOGICAL LERROR,LOGIPROFILE,LOGICONSWEIGHT
INTEGER I,J,K,ISTART,ISTOP,LEN,KRESBASE,IPOS
C======================================================================
C need to read HSSP files
C======================================================================
C Reinhard Schneider 1989, BIOcomputing EMBL, D-6900 Heidelberg, FRG
C please report any bug, e-mail (INTERNET):
C schneider@EMBL-Heidelberg.DE
C or sander@EMBL-Heidelberg.DE
C=======================================================================
C INCREASE THE NUMBER OF FOLLOWING THREE PARAMETER IF NECESSARY
C Note: increase also in calling program
C=======================================================================
C maxaligns = maximal number of alignments in a HSSP-file
C maxres= maximal number of residues in a PDB-protein
C maxcore= maximal space for storing the alignments
C=======================================================================
C maxaa= 20 amino acids
C nblocksize= number of alignments in one line
C pdbid= Brookhaven Data Bank identifier
C header,compound,source,author= informations about the PDB-protein
C pdbseq= amino acid sequence of the PDB-protein
C chainid= chain identifier (chain A etc.)
C secstr= DSSP secondary structure summary
C bp1,bp2= beta-bridge partner
C cols= DSSP hydrogen bonding patterns for turns and helices,
C geometrical bend, chirality, one character name of beta-ladder
C and of beta-sheet
C sheetlabel= chain identifier of beta bridge partner
C seqlength= number of amino acids in the PDB-protein
C pdbno= residue number as in PDB file
C nchain= number of different chains in pdbid.DSSP data set
C kchain= number of chains used in HSSP data set
C nalign= number of alignments
C acc= solvated residue surface area in A**2
C emblid= EMBL/SWISSPROT identifier of the alignend protein
C strid= if the 3-D structure of this protein is known, then strid
C (structure ID)is the Protein Data Bank identifier as taken
C from the EMBL/SWISSPROT entry
C protname= one line description of alignend protein
C aliseq= sequential storage for the alignments
C alipointer= points to the beginning of alignment X ( 1>= X <=nalign )
C ifir,ilas= first and last position of the alignment in the test
C protein
C jfir,jlas= first and last position of the alignment in the alignend
C protein
C lali= length of the alignment excluding insertions and deletions
C ngap= number of insertions and deletions in the alignment
C lgap= total length of all insertions and deletions
C lenseq= length of the entire sequence of the alignend protein
C ide= percentage of residue identity of the alignment
C var= sequence variability as derived from the nalign alignments
C seqprof= relative frequency for each of the 20 amino acids
C nocc= number of alignend sequences spanning this position (including
C the test sequence
C ndel= number of sequences with a deletion in the test protein at this
C position
C nins= number of sequences with an insertion in the test protein at
C this position
C LOGIPROFILE if true the profile is written into output file
C entropy= entropy measure of sequence variability at this position
C relent= relative entropy (entropy normalized to the range 0-100)
C=======================================================================
C============================ import ==================================
C attributes of sequence with known structure
CHARACTER*132 PDBID,HEADER,COMPOUND,SOURCE,AUTHOR
CHARACTER PDBSEQ(NUMRESMAX),CHAINID(NUMRESMAX),
+ SECSTR(NUMRESMAX)
C.......LENGHT*7
CHARACTER*7 COLS(NUMRESMAX)
CHARACTER*132 CHAINREMARK
INTEGER SEQLENGTH,NCHAIN,KCHAIN,NALIGN
INTEGER ACC(NUMRESMAX)
C br 2003-08-23: save space
C CHARACTER SHEETLABEL(NUMRESMAX)
C INTEGER BP1(NUMRESMAX),BP2(NUMRESMAX),PDBNO(NUMRESMAX)
CHARACTER SHEETLABEL(1)
INTEGER BP1(1),BP2(1),PDBNO(1)
C br 2003-08-23: end save space
C ATTRIBUTES OF ALIGNED SEQUENCES
CHARACTER*132 EMBLID(MAXALIGNS),STRID(MAXALIGNS),
+ IPROTNAME(MAXALIGNS),ACCNUM(MAXALIGNS),
+ EXCLUDEFLAG(MAXALIGNS)
C br 2003-08-23: save space
C CHARACTER ALISEQ(MAXCORE)
CHARACTER ALISEQ(1)
C br 2003-08-23: end save space
INTEGER ALIPOINTER(MAXALIGNS),
+ IFIR(MAXALIGNS),ILAS(MAXALIGNS),JFIR(MAXALIGNS),
+ JLAS(MAXALIGNS),LALI(MAXALIGNS),NGAP(MAXALIGNS),
+ LGAP(MAXALIGNS),LENSEQ(MAXALIGNS)
REAL IDE(MAXALIGNS),SIM(MAXALIGNS)
C ATTRIBUTES OF PROFILE
INTEGER SEQPROF(NUMRESMAX,MAXAA),
+ NOCC(NUMRESMAX),NDEL(NUMRESMAX),NINS(NUMRESMAX)
REAL CONSWEIGHT(NUMRESMAX)
C br 2003-08-23: save space
C INTEGER VAR(NUMRESMAX),RELENT(NUMRESMAX)
C REAL ENTROPY(NUMRESMAX)
INTEGER VAR(1),RELENT(1)
REAL ENTROPY(1)
C br 2003-08-23: end save space
C br 2003-08-23: save space
C br 2003-08-23: end save space
C.......
LOGICAL LCONSERV,LOLDVERSION
C Compiler bug patch
C write data in loop, because the SUN4 compiler has a limit stacksize of
C 4096 (before it was 8192 MURKS) in a routine(do_u_out, rwrite or w4cp)
C integer NPACK
C parameter (NPACK=1000)
C......
LOGICAL LSCREEN
INTEGER MAXALIGNS_LOC,MAXRES
C=======================================================================
C.... init
MAXRES= NUMRESMAX
MAXALIGNS_LOC= MAXALIGNS
NPROT= 0
NCHAINBREAK= 0
NPROTBREAK= 0
DO I=1,MAXALIGNS_LOC
emblid(i)= ' '
ENDDO
DO I=1,MAXALIGNS
PROTBEGIN(I)= 0
PROTEND(I)= 0
WRT_NALIGN(I)= 0
CPROTID(I)= ' '
OFFSET(I)= 1
ENDDO
DO I=1,NUMRESMAX
CSEQBASE(I)= ' '
CSTRBASE(I)= ' '
ACCBASE(I)= 0
VARIABILITY(I)=0
WRITENDEL(I)= 0
WRT_NINS(I)= 0
ENDDO
PROTEND(0)= -1
C defaults
C FILE_HSSP='/data/hssp/3b5c.hssp'
C ISAFE=10
C lformula=.true.
C lall=.false.
LOGIPROFILE= .TRUE.
LOGICONSWEIGHT= .TRUE.
LOGI_INDEL= .TRUE.
LSCREEN= .FALSE.
C=====================================================================
C======= AND HERE WE GO ==============================================
C=====================================================================
C CALL GETCHAR(80,OUTFILE,' output file ? ')
C CALL GETINT(1,ISAFE,' HSSP-threshold + x percent ?')
C CALL ASK(' including profile information?',LOGIPROFILE)
C CALL ASK(' including conservation weight?',LOGICONSWEIGHT)
CC CALL GETCHAR(80,PROTFILE,' protname ? ')
WRITE(6,'(T2,A,T10,A,T22,A50)')'---','HSSP file',FILE_HSSP
C---- calling SBR for reading
CALL RS_READHSSP(KDSSP,FILE_HSSP,LERROR,
+ MAXRES,MAXALIGNS,MAXCORE,
+ PDBID,HEADER,COMPOUND,SOURCE,AUTHOR,SEQLENGTH,
+ NCHAIN,KCHAIN,CHAINREMARK,NALIGN,
+ EXCLUDEFLAG,EMBLID,STRID,IDE,SIM,
+ IFIR,ILAS,JFIR,JLAS,LALI,NGAP,LGAP,
+ LENSEQ,ACCNUM,IPROTNAME,
+ PDBNO,PDBSEQ,CHAINID,SECSTR,COLS,SHEETLABEL,BP1,BP2,
+ ACC,NOCC,VAR,ALISEQ,ALIPOINTER,
+ SEQPROF,NDEL,NINS,ENTROPY,RELENT,CONSWEIGHT,
+ LCONSERV,LOLDVERSION)
C first PDBSEQ
C-----------------------------------------------------------------------
IF (LERROR .EQV. .TRUE.) THEN
write(6,*)'xx LERROR after read hssp: ',LERROR
ENDIF
KRESBASE=1
IF (LERROR .EQV. .FALSE.) THEN
NPROT=NPROT+1
LEN=SEQLENGTH
IF (KRESBASE+LEN .GT. NUMRESMAX) THEN
WRITE(6,'(T2,A,T10,A,T30,I5)')'***',
+ 'NUMRESMAX OVERFLOW ',KRESBASE+LEN
STOP
ENDIF
CPROTID(NPROT)=PDBID
PROTBEGIN(NPROT)=PROTEND(NPROT-1)+2
PROTEND(NPROT)=PROTBEGIN(NPROT)-1+LEN
KRESBASE=PROTBEGIN(NPROT)
OFFSET(NPROT)=1
WRT_NALIGN(NPROT)=NALIGN
DO K=1,SEQLENGTH
CSEQBASE(KRESBASE)=PDBSEQ(K)
IF (PDBSEQ(K).EQ.' !')NCHAINBREAK=NCHAINBREAK+1
IF (SECSTR(K).EQ. ' ') THEN
CSTRBASE(KRESBASE)='L'
ELSE
CSTRBASE(KRESBASE)=SECSTR(K)
ENDIF
ACCBASE(KRESBASE)=ACC(K)
C VARIABILITY(KRESBASE)=VAR(K)
IF (LOGIPROFILE .EQV. .TRUE.) THEN
DO IPOS=1,MAXAA
PROFILE(KRESBASE,IPOS)=SEQPROF(K,IPOS)
ENDDO
ENDIF
IF (LOGICONSWEIGHT .EQV. .TRUE.) THEN
WRT_CONSWEIGHT(KRESBASE)=CONSWEIGHT(K)
END IF
IF (LOGI_INDEL .EQV. .TRUE.) THEN
WRITENDEL(KRESBASE)=NDEL(K)
WRT_NINS(KRESBASE)=NINS(K)
END IF
KRESBASE=KRESBASE+1
ENDDO
CALL STRPOS(FILE_HSSP,ISTART,ISTOP)
C set '/' between proteins
CSEQBASE(KRESBASE)='/'
CSTRBASE(KRESBASE)='/'
KRESBASE=KRESBASE+1
NPROTBREAK=NPROTBREAK+1
ELSE
WRITE(6,'(T2,A,T10,A,T40,A)')'***',
+ ' ERROR READING FILE_HSSP: ',FILE_HSSP
ENDIF
NPROTBREAK=NPROTBREAK-1
NPROT=NPROT
C.....end.loop over lifi
C....................................................................
CDEBUG.........
C...............................................................
C write data
C...........................
DO I=1,NPROT
PROTNAME(I)=CPROTID(I)
NUMRES=PROTEND(I)-PROTBEGIN(I)+1
NUMNALIGN(I)=WRT_NALIGN(I)
DO J=1,PROTEND(I)
RESNAME(J)=CSEQBASE(J)
RESSECSTR(J)=CSTRBASE(J)
RESACC(J)=ACCBASE(J)
C br 2003-08-23: save space
C RESVAR(J)=VARIABILITY(J)
C br 2003-08-23: end save space
IF (LOGIPROFILE .EQV. .TRUE.) THEN
DO K=1,MAXAA
RESPROF(J,K)=PROFILE(J,K)
END DO
END IF
IF (LOGICONSWEIGHT .EQV. .TRUE.) THEN
RESCONSWEIGHT(J)=WRT_CONSWEIGHT(J)
END IF
IF (LOGI_INDEL .EQV. .TRUE.) THEN
RESNDEL(J)=WRITENDEL(J)
RESNINS(J)=WRT_NINS(J)
END IF
END DO
END DO
C changed 31-1-94 xxzz
NUMNALIGN(1)=WRT_NALIGN(1)
cxx
WRITE(6,'(T2,A,T10,A)')'---',' RS_GETHSSP(final words) got:'
WRITE(6,'(T2,A,T10,A,T25,A50)')'---','protname(50)',CPROTID(1)
WRITE(6,'(T2,A,T10,A,T25,I4,T33,A,T45,I4)')'---',
+ 'length:',NUMRES,'N alis:',WRT_NALIGN(1)
WRITE(6,'(T2,A,T10,A,T25,60A1)')'---',
+ 'sequence',(CSEQBASE(K),K=1,PROTEND(NPROT))
WRITE(6,'(T2,A,T10,A,T25,60A1)')'---',
+ 'structure',(CSTRBASE(K),K=1,PROTEND(NPROT))
WRITE(6,'(T2,A,T10,A,T25,5I10)')'---',
+ 'OFFSET',(OFFSET(K),K=1,NPROT)
IF (LOGIPROFILE.AND.LOGICONSWEIGHT.AND.LOGI_INDEL.AND.
+ LSCREEN) THEN
WRITE(6,'(T2,A,T10,A,T72,4A4)')'-no seq',
+ ' V L I M F W Y G A P S T C H R K Q E N D',
+ 'Cons',' Del',' Ins',' ACC'
DO I=PROTBEGIN(1),PROTEND(1)
WRITE(6,'(T2,I4,T8,A1,T10,20I3,T72,F4.2,2I4,I4)')
+ I,CSEQBASE(I),
+ (PROFILE(I,J),J=1,MAXAA),WRT_CONSWEIGHT(I),
+ WRITENDEL(I),WRT_NINS(I),RESACC(I)
enddo
ENDIF
WRITE(6,'(T2,A,T10,A)')'---',' RS_GETHSSP END(really)'
END
***** end of RS_GETHSSP
***** ------------------------------------------------------------------
***** SUB RS_READHSSP
***** ------------------------------------------------------------------
C----
C---- NAME : RS_READHSSP
C---- ARG :
C---- DES : does it ..
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE RS_READHSSP(IUNIT,FILE_HSSP_LOC,LERROR,
+ MAXRES,MAXALIGNS_LOC,MAXCORE_LOC,
+ PDBID,HEADER,COMPOUND,SOURCE,AUTHOR,SEQLENGTH,
+ NCHAIN,KCHAIN,CHAINREMARK,NALIGN,
+ EXCLUDEFLAG,EMBLID,STRID,IDE,SIM,
+ IFIR,ILAS,JFIR,JLAS,LALI,NGAP,LGAP,
+ LENSEQ,ACCNUM,IPROTNAME,
+ PDBNO,PDBSEQ,CHAINID,SECSTR,COLS,SHEETLABEL,BP1,BP2,
+ ACC,NOCC,VAR,ALISEQ,ALIPOINTER,
+ SEQPROF,NDEL,NINS,ENTROPY,RELENT,CONSWEIGHT,
+ LCONSERV,LOLDVERSION)
C---- global parameters
INCLUDE 'phdParameter.f'
C Reinhard Schneider 1989, BIOcomputing EMBL, D-6900 Heidelberg, FRG
C please report any bug, e-mail (INTERNET):
C schneider@EMBL-Heidelberg.DE
C or sander@EMBL-Heidelberg.DE
C=======================================================================
C INCREASE THE NUMBER OF FOLLOWING THREE PARAMETER IN THE CALLING
C PROGRAM IF NECESSARY
C=======================================================================
C maxaligns = maximal number of alignments in a HSSP-file
C maxres= maximal number of residues in a PDB-protein
C maxcore= maximal space for storing the alignments
C=======================================================================
C maxaa= 20 amino acids
C nblocksize= number of alignments in one line
C pdbid= Brookhaven Data Bank identifier
C header,compound,source,author= informations about the PDB-protein
C pdbseq= amino acid sequence of the PDB-protein
C chainid= chain identifier (chain A etc.)
C secstr= DSSP secondary structure summary
C bp1,bp2= beta-bridge partner
C cols= DSSP hydrogen bonding patterns for turns and helices,
C geometrical bend, chirality, one character name of beta-ladder
C and of beta-sheet
C sheetlabel= chain identifier of beta bridge partner
C seqlength= number of amino acids in the PDB-protein
C pdbno= residue number as in PDB file
C nchain= number of different chains in pdbid.DSSP data set
C kchain= number of chains used in HSSP data set
C nalign= number of alignments
C acc= solvated residue surface area in A**2
C emblid= EMBL/SWISSPROT identifier of the alignend protein
C strid= if the 3-D structure of this protein is known, then strid
C (structure ID)is the Protein Data Bank identifier as taken
C from the EMBL/SWISSPROT entry
C iprotname= one line description of alignend protein
C aliseq= sequential storage for the alignments
C alipointer= points to the beginning of alignment X ( 1>= X <=nalign )
C ifir,ilas= first and last position of the alignment in the test
C protein
C jfir,jlas= first and last position of the alignment in the alignend
C protein
C lali= length of the alignment excluding insertions and deletions
C ngap= number of insertions and deletions in the alignment
C lgap= total length of all insertions and deletions
C lenseq= length of the entire sequence of the alignend protein
C ide= percentage of residue identity of the alignment
C var= sequence variability as derived from the nalign alignments
C seqprof= relative frequency for each of the 20 amino acids
C nocc= number of alignend sequences spanning this position (including
C the test sequence
C ndel= number of sequences with a deletion in the test protein at this
C position
C nins= number of sequences with an insertion in the test protein at
C this position
C entropy= entropy measure of sequence variability at this position
C relent= relative entropy (entropy normalized to the range 0-100)
C consweight= conservation weight
C=======================================================================
C IMPLICIT NONE
C INTEGER NBLOCKSIZE
C PARAMETER (NBLOCKSIZE= 70)
C INTEGER MAXRES,MAXAA
C INTEGER MAXALIGNS,MAXCORE
C PARAMETER (MAXAA= 20)
C============================ import ==================================
C CHARACTER*222 FILE_HSSP_LOC
CHARACTER*(*) FILE_HSSP_LOC
INTEGER IUNIT
LOGICAL LERROR
C attributes of sequence with known structure
C CHARACTER*222 PDBID,HEADER,COMPOUND,SOURCE,AUTHOR
C CHARACTER*(*) PDBID,HEADER,COMPOUND,SOURCE,AUTHOR
CHARACTER*132 PDBID,HEADER,COMPOUND,SOURCE,AUTHOR
CHARACTER PDBSEQ(NUMRESMAX),CHAINID(NUMRESMAX),
+ SECSTR(NUMRESMAX)
C.......length*7
CHARACTER*7 COLS(NUMRESMAX)
CHARACTER*132 CHAINREMARK
C br 2003-08-23: save space
C CHARACTER SHEETLABEL(NUMRESMAX)
CHARACTER SHEETLABEL(1)
CHARACTER SHEETLABEL_NULL
C br 2003-08-23: end save space
INTEGER SEQLENGTH,NCHAIN,KCHAIN,NALIGN
INTEGER ACC(NUMRESMAX)
C br 2003-08-23: save space
C INTEGER BP1(NUMRESMAX),BP2(NUMRESMAX),PDBNO(NUMRESMAX)
INTEGER BP1(1),BP2(1),PDBNO(1)
INTEGER PDBNO_NULL,BP1_NULL,BP2_NULL
C br 2003-08-23: end save space
C attributes of alignend sequences
C CHARACTER*222 EMBLID(MAXALIGNS),STRID(MAXALIGNS),
C + ACCNUM(MAXALIGNS),IPROTNAME(MAXALIGNS),
C + EXCLUDEFLAG(MAXALIGNS)
C CHARACTER*(*) EMBLID(MAXALIGNS),STRID(MAXALIGNS),
C + ACCNUM(MAXALIGNS),IPROTNAME(MAXALIGNS),
C + EXCLUDEFLAG(MAXALIGNS)
CHARACTER*132 EMBLID(MAXALIGNS),STRID(MAXALIGNS),
+ IPROTNAME(MAXALIGNS),ACCNUM(MAXALIGNS),
+ EXCLUDEFLAG(MAXALIGNS)
INTEGER ALIPOINTER(MAXALIGNS),
+ IFIR(MAXALIGNS),ILAS(MAXALIGNS),JFIR(MAXALIGNS),
+ JLAS(MAXALIGNS),LALI(MAXALIGNS),NGAP(MAXALIGNS),
+ LGAP(MAXALIGNS),LENSEQ(MAXALIGNS)
REAL IDE(MAXALIGNS),SIM(MAXALIGNS)
C br 2003-08-23: save space
C CHARACTER ALISEQ(MAXCORE)
CHARACTER ALISEQ(1)
CHARACTER ALISEQ_NULL
C br 2003-08-23: end save space
C attributes of profile
INTEGER SEQPROF(NUMRESMAX,MAXAA),
+ NOCC(NUMRESMAX),NDEL(NUMRESMAX),NINS(NUMRESMAX)
REAL CONSWEIGHT(NUMRESMAX)
C br 2003-08-23: save space
C INTEGER VAR(NUMRESMAX),RELENT(NUMRESMAX)
C REAL ENTROPY(NUMRESMAX)
INTEGER VAR(1),RELENT(1)
INTEGER VAR_NULL,RELENT_NULL
REAL ENTROPY(1)
REAL ENTROPY_NULL
C br 2003-08-23: end save space
C.......
LOGICAL LCONSERV,LOLDVERSION
C=======================================================================
C internal
C INTEGER MAXALIGNS_LOC
C PARAMETER (MAXALIGNS_LOC= 3000)
C PARAMETER (MAXALIGNS_LOC= MAXALIGNS)
C character profileseq*(maxaa)
CHARACTER CTEMP*(NBLOCKSIZE),TEMPNAME*222
CHARACTER*222 LINE
C CHARACTER*20 HSSPRELEASE
CHARACTER CHAINSELECT
LOGICAL LCHAIN,LONG_ID
INTEGER ICHAINBEG,ICHAINEND,NALIGNORG,
+ I,J,K,IPOS,ILEN,NRES,IRES,
+ NBLOCK,IALIGN,IBLOCK,IALI,
+ IBEG,IEND,IPOINTER(MAXALIGNS)
INTEGER MAXCORE_LOC,MAXALIGNS_LOC,MAXRES
INTEGER ITMP
LOGICAL LDEBUG_LOCAL
C order of amino acid symbols in the HSSP sequence profile block
C profileseq='VLIMFWYGAPSTCHRKQEND'
LONG_ID=.FALSE.
LERROR=.FALSE.
C br 2003-08-23: avoid warnings
IBEG=0
IEND=0
J= 0
C used to debug
LDEBUG_LOCAL=.FALSE.
C LDEBUG_LOCAL=.TRUE.
NALIGN=0
CHAINREMARK=' '
DO I=1,MAXALIGNS
IPOINTER(I)=0
ENDDO
LCHAIN=.FALSE.
TEMPNAME(1:)=FILE_HSSP_LOC
I=INDEX(TEMPNAME,'_!_')
IF (I.NE.0) THEN
TEMPNAME(1:)=FILE_HSSP_LOC(1:I-1)
LCHAIN=.TRUE.
READ(FILE_HSSP_LOC(I+3:),'(A1)')CHAINSELECT
WRITE(6,'(T2,A,T10,A,T50,A)')'---',
+ '--- RS_READHSSP: extract the chain: ',chainselect
ENDIF
C CALL RSLIB_OPEN_FILE(IUNIT,TEMPNAME,'OLD,READONLY',LERROR)
C OPEN(IUNIT,FILE=TEMPNAME,STATUS='OLD',READONLY,ERR=99)
C OPEN(IUNIT,FILE=TEMPNAME,STATUS='OLD',ERR=99)
OPEN(IUNIT,FILE=TEMPNAME,ERR=99)
IF (LERROR .EQV. .TRUE.) THEN
WRITE(6,'(A)')'*** ERROR FOR RS_READHSSP: open problem'
GOTO 99
ENDIF
READ(IUNIT,'(A)',ERR=99)LINE
C check if it is a HSSP-file and get the release number for format flags
IF (LINE(1:4).NE.'HSSP') THEN
WRITE(6,'(A)')'*** ERROR FOR RS_READHSSP: is not a HSSP-file'
LERROR=.TRUE.
RETURN
ELSE
I=INDEX(LINE,'VERSION')+7
C HSSPRELEASE=LINE(I:)
LOLDVERSION=.FALSE.
c if (index(hssprelease,'0.9').ne.0)loldversion=.true.
ENDIF
C read in PDBID etc.
DO WHILE(LINE(1:6).NE.'PDBID')
READ(IUNIT,'(A)',ERR=99)LINE
ENDDO
READ(LINE,'(11X,A)',ERR=99)PDBID
DO WHILE(LINE(1:6).NE.'HEADER')
READ(IUNIT,'(A)',ERR=99)LINE
IF (LINE(1:23).EQ.'PARAMETER LONG-ID :YES') THEN
LONG_ID=.TRUE.
ENDIF
ENDDO
READ(LINE ,'(11X,A)',ERR=99)HEADER
READ(IUNIT,'(11X,A)',ERR=99)COMPOUND
READ(IUNIT,'(11X,A)',ERR=99)SOURCE
READ(IUNIT,'(11X,A)',ERR=99)AUTHOR
READ(IUNIT,'(11X,I4)',ERR=99)SEQLENGTH
READ(IUNIT,'(11X,I4)',ERR=99)NCHAIN
KCHAIN=NCHAIN
READ(IUNIT,'(A)',ERR=99)LINE
C IF (LDEBUG_LOCAL .EQV. .TRUE.) WRITE(6,*)'DBG ',LINE
IF (INDEX(LINE,'KCHAIN').NE.0) THEN
READ(LINE,'(11X,I4,A)',ERR=99)KCHAIN,CHAINREMARK
READ(IUNIT,'(11X,I4)',ERR=99)NALIGNORG
ELSE
READ(LINE,'(11X,I4)',ERR=99)NALIGNORG
ENDIF
C if HSSP-file contains no alignments return
IF (NALIGNORG.EQ.0) THEN
WRITE(6,'(T2,A,T10,A)')'---',
+ '--- HSSP-file contains no alignments ***'
CLOSE(IUNIT)
RETURN
ENDIF
C write(6,*)'xx before overflow, Nali=',nalignorg,' len=',
C + seqlength,' kchain=',kchain,' lchain=',lchain
C parameter overflow handling
IF (NALIGNORG.GT.MAXALIGNS) THEN
WRITE(6,'(A)')'-*- HSSP-file contains too many alignments **'
WRITE(6,'(A)')'-*- INCREASE MAXALIGNS in phdParameter.f! '
WRITE(6,'(A,I8,A,I8)')'-*- is=',MAXALIGNS,' want>',NALIGNORG
CLOSE(IUNIT)
LERROR=.TRUE.
RETURN
ENDIF
ITMP=SEQLENGTH+KCHAIN-1
IF (ITMP.GT.NUMRESMAX) THEN
WRITE(6,'(A)')'*** PDB-sequence in HSSP-file too long ***'
WRITE(6,'(A)')'*** INCREASE NUMRESMAX in phdParameter.f***'
WRITE(6,'(A,I8,A,I8)')'-*- is=',NUMRESMAX,' want>',ITMP
CLOSE(IUNIT)
LERROR=.TRUE.
RETURN
ENDIF
C number of sequence positions is number of residues + number of chains
C chain break is indicated by a '!'
NRES=SEQLENGTH+KCHAIN-1
ICHAINBEG=1
ICHAINEND=NRES
IF (LCHAIN .EQV. .TRUE.) THEN
C search for ALIGNMENT-block
DO WHILE (LINE(1:13).NE.'## ALIGNMENTS')
READ(IUNIT,'(A)',ERR=99)LINE
ENDDO
READ(IUNIT,'(A)',ERR=99)LINE
ICHAINBEG=0
ICHAINEND=0
C read till end ; some PDB-chains have DSSP-chain breaks !!
DO I=1,NRES
READ(IUNIT,'(7X,I4,1X,A1)',ERR=99)PDBNO(I),CHAINID(I)
IF (CHAINID(I) .EQ. CHAINSELECT) THEN
IF (ICHAINBEG .EQ. 0) ICHAINBEG=I
ICHAINEND=I
ENDIF
ENDDO
WRITE(6,'(T2,A,T10,I10,I10)')'---',
+ ICHAINBEG,ICHAINEND
REWIND(IUNIT)
ENDIF
SEQLENGTH=ICHAINEND-ICHAINBEG+1
C search for the PROTEINS-block
LINE=' '
DO WHILE(LINE(1:11).NE.'## PROTEINS')
READ(IUNIT,'(A)',ERR=99)LINE
C IF (LDEBUG_LOCAL .EQV. .TRUE.) WRITE(6,*)'DBG PROT=',LINE
ENDDO
READ(IUNIT,'(A)',ERR=99)LINE
LCONSERV=.FALSE.
IF (INDEX(LINE,'%WSIM').NE.0) LCONSERV= .TRUE.
C READ DATA ABOUT THE ALIGNMENTS
IALIGN=1
IF (LDEBUG_LOCAL .EQV. .TRUE.)
+ WRITE(6,'(A,I5,A,L)')'DBG NALI=',NALIGNORG,' long=',LONG_ID
DO I=1,NALIGNORG
C IF (LDEBUG_LOCAL .EQV. .TRUE.) WRITE(6,'(A,I5)')'DBG iali=',I
IF (LONG_ID .EQV. .TRUE.) THEN
C note: read format specified below (line labelled 101)
READ(IUNIT,101,ERR=99)
+ EXCLUDEFLAG(IALIGN),EMBLID(IALIGN)(1:),STRID(IALIGN),
+ IDE(IALIGN),SIM(IALIGN),IFIR(IALIGN),ILAS(IALIGN),
+ JFIR(IALIGN),JLAS(IALIGN),LALI(IALIGN),NGAP(IALIGN),
+ LGAP(IALIGN),LENSEQ(IALIGN),ACCNUM(IALIGN),
+ IPROTNAME(IALIGN)
ELSE
C note: read format specified below (line labelled 100)
READ(IUNIT,100,ERR=99)
+ EXCLUDEFLAG(IALIGN),EMBLID(IALIGN)(1:),STRID(IALIGN),
+ IDE(IALIGN),SIM(IALIGN),IFIR(IALIGN),ILAS(IALIGN),
+ JFIR(IALIGN),JLAS(IALIGN),LALI(IALIGN),NGAP(IALIGN),
+ LGAP(IALIGN),LENSEQ(IALIGN),ACCNUM(IALIGN),
+ IPROTNAME(IALIGN)
END IF
IF (LDEBUG_LOCAL .EQV. .TRUE.) THEN
WRITE(6,'(A,I5,A,F5.2,A,A)')'DBG PROTali(',IALIGN,') ide=',
+ IDE(IALIGN),
+ ' name=',IPROTNAME(IALIGN)
END IF
IF (IFIR(IALIGN) .GE. ICHAINBEG .AND.
+ ILAS(IALIGN) .LE. ICHAINEND) THEN
IPOINTER(I)=IALIGN
IALIGN=IALIGN+1
ENDIF
ENDDO
100 FORMAT(5X,A1,2X,A12,A5,2X,F5.2,1X,F5.2,8(1X,I4),2X,A10,1X,A)
101 FORMAT(5X,A1,2X,A40,A5,2X,F5.2,1X,F5.2,8(1X,I4),2X,A10,1X,A)
NALIGN=IALIGN-1
WRITE(6,'(T2,A,T10,A)')'---',
+ ' RS_READHSSP PROTEINS-block done'
C init pointer ; aliseq contains the alignments (amino acid symbols)
C stored in the following way ; '/' separates alignments
C alignment(x) is stored from:
C aliseq(alipointer(x)) to aliseq(ilas(x)-ifir(x))
C aliseq(1........46/48.........60/62....)
C | | |
C | | |
C pointer pointer pointer
C ali 1 ali 2 ali 3
C init pointer
IPOS=1
DO I=1,NALIGN
C br 2003-08-23 fast and slim
C IF (IPOS.GE.MAXCORE) THEN
C WRITE(6,'(A,I9,A)')
C + ' *** LERROR: INCREASE MAXCORE to >',IPOS,'***'
C STOP
C ENDIF
C end fast and slim br 2003-08-23
ALIPOINTER(I)=IPOS
ILEN=ILAS(I)-IFIR(I)+1
IPOS=IPOS+ILEN
C br 2003-08-23 fast and slim
C ALISEQ(IPOS)='/'
ALISEQ_NULL='/'
C end fast and slim br 2003-08-23
IPOS=IPOS+1
ENDDO
ALIPOINTER(NALIGN+1)=IPOS+1
C number of ALIGNMENTS-blocks
IF (MOD(FLOAT(NALIGNORG),FLOAT(NBLOCKSIZE)).EQ. 0.0) THEN
NBLOCK=NALIGNORG/NBLOCKSIZE
ELSE
NBLOCK=NALIGNORG/NBLOCKSIZE+1
ENDIF
C search for ALIGNMENT-block
DO WHILE (LINE(1:13).NE.'## ALIGNMENTS')
READ(IUNIT,'(A)',ERR=99)LINE
IF (LDEBUG_LOCAL .EQV. .TRUE.) WRITE(6,*)'DBG alinot',LINE
ENDDO
READ(IUNIT,'(A)',ERR=99)LINE
IF (LDEBUG_LOCAL .EQV. .TRUE.) WRITE(6,*)'DBG ',LINE
C loop over ALIGNMENTS-blocks
C ....read in pdbno, chainid, secstr etc.
IALIGN=0
IALI=0
DO IBLOCK=1,NBLOCK
IRES=1
DO I=1,NRES
C BR: 2003-08-23: save space
C READ(IUNIT,200,ERR=99)
C + PDBNO(IRES),CHAINID(IRES),PDBSEQ(IRES),SECSTR(IRES),
C + COLS(IRES),BP1(IRES),BP2(IRES),SHEETLABEL(IRES),
C + ACC(IRES),NOCC(IRES),VAR(IRES),CTEMP
READ(IUNIT,200,ERR=99)
+ PDBNO_NULL,CHAINID(IRES),PDBSEQ(IRES),SECSTR(IRES),
+ COLS(IRES),BP1_NULL,BP2_NULL,SHEETLABEL_NULL,
+ ACC(IRES),NOCC(IRES),VAR_NULL,CTEMP
C end save space br 2003-08-23
200 FORMAT(7X,I4,2(1X,A1),2X,A1,1X,A7,2(I4),A1,I4,2(1X,I4),2X,A)
C.....fill up aliseq
C IF (LDEBUG_LOCAL .EQV. .TRUE.)
C + WRITE(6,*)'DBG IBLOCK=',IBLOCK, ' IRES=',I
IF (I .GE. ICHAINBEG .AND. I .LE. ICHAINEND) THEN
IRES=IRES+1
C br 2003-08-23 fast and slim
C IF (PDBSEQ(I) .NE. '!') THEN
C CALL STRPOS(CTEMP,IBEG,IEND)
C DO IPOS=MAX(IBEG,1),MIN(NBLOCKSIZE,IEND)
C IALI=IALIGN+IPOS
C IF (CTEMP(IPOS:IPOS) .NE. ' ') THEN
C J=ALIPOINTER(IPOINTER(IALI)) +
C + (I-IFIR(IPOINTER(IALI)))
C ALISEQ(J)=CTEMP(IPOS:IPOS)
C ENDIF
C ENDDO
C ENDIF
C end fast and slim br 2003-08-23
ENDIF
ENDDO
IALIGN=IALIGN+NBLOCKSIZE
DO K=1,2
READ(IUNIT,'(A)',ERR=99)LINE
IF (LDEBUG_LOCAL .EQV. .TRUE.) WRITE(6,*)'DBG ',LINE
ENDDO
ENDDO
WRITE(6,'(T2,A,T10,A)')'---',
+ ' RS_READHSSP ALIGNMENTS-block done'
C read in sequence profile, entropy etc.
IRES=1
DO I=1,NRES
C BR 2003-08-23 save space
C READ(IUNIT,300,ERR=99)(SEQPROF(IRES,K),K=1,MAXAA),
C + NOCC(IRES),NDEL(IRES),NINS(IRES),ENTROPY(IRES),
C + RELENT(IRES),CONSWEIGHT(IRES)
READ(IUNIT,300,ERR=99)(SEQPROF(IRES,K),K=1,MAXAA),
+ NOCC(IRES),NDEL(IRES),NINS(IRES),ENTROPY_NULL,
+ RELENT_NULL,CONSWEIGHT(IRES)
C end save space br 2003-08-23
IF (I .GE. ICHAINBEG .AND. I .LE. ICHAINEND) THEN
IRES=IRES+1
ENDIF
ENDDO
300 FORMAT(12X,20(I4),1X,3(1X,I4),1X,F7.3,3X,I4,2X,F4.2)
WRITE(6,'(T2,A,T10,A)')'---',
+ ' RS_READHSSP PROFILE-block done'
IF (LCHAIN .EQV. .TRUE.) THEN
DO I=1,NALIGN
IFIR(I)=IFIR(I)-ICHAINBEG+1
ILAS(I)=ILAS(I)-ICHAINBEG+1
ENDDO
ENDIF
C check if next line (last line in a HSSP-file) contains a '//'
READ(IUNIT,'(A)',ERR=99)LINE
IF ((LINE(1:2).EQ.'//').OR.
+ (LINE(1:13).EQ.'## INSERTION')) THEN
WRITE(6,'(T2,A,T10,A,A50)')'---',
+ ' RS_READHSSP ok(cut 50): ',FILE_HSSP_LOC(1:50)
GOTO 999
ELSE
WRITE(6,'(T2,A,T10,A,A,A,A)')'***',
+ 'ERROR FOR RS_READHSSP: ',FILE_HSSP_LOC,' lastLine=',
+ LINE
GOTO 99
ENDIF
99 WRITE(6,'(A,A)')'**** ERROR FOR RS_READHSSP: READING: ',
+ FILE_HSSP_LOC
LERROR=.TRUE.
NALIGN=0
SEQLENGTH=0
999 CLOSE(IUNIT)
RETURN
END
***** end of RS_READHSSP
***** ------------------------------------------------------------------
***** SUB RSLIB_OPEN_FILE
***** ------------------------------------------------------------------
C----
C---- NAME : RSLIB_OPEN_FILE
C---- ARG :
C---- DES : opening file
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
*----------------------------------------------------------------------*
SUBROUTINE RSLIB_OPEN_FILE(IUNIT,FILENAME,CSTRING,LERROR)
C---- global parameters
INCLUDE 'phdParameter.f'
C IMPLICIT NONE
C input
C CSTATUS: 'old' or 'new' or 'unknown'
C CACCESS: 'append' 'direct'
C FORM: 'formatted' or 'unformatted'
C IRECLEN: record length
C NOTE: after opening a "old" or "unknown" file (no direct acess):
C rewind the file, because some strange compilers put the file
C pointer at the end !
CHARACTER*222 FILENAME,CSTRING
INTEGER IUNIT,IRECLEN
C output: lerror is true if open error
LOGICAL LERROR
C internal
CHARACTER*200 TEMPSTRING,CTEMP
CHARACTER*10 CNUMBER
LOGICAL LRECLEN
LOGICAL LNEW,LAPPEND,LUNKNOWN,
+ LUNFORMATTED,LDIRECT,
+ LOPENDONE,LSILENT
INTEGER LENGTH,I,J,K,IEND
C---- local function
C INTEGER FILEN_STRING
C---- br 2003-08-23: bullshit to avoid warning
IEND=0
C init
TEMPSTRING=' '
LNEW= .FALSE.
LAPPEND= .FALSE.
LRECLEN= .FALSE.
LERROR= .FALSE.
LUNKNOWN= .FALSE.
LUNFORMATTED=.FALSE.
LDIRECT= .FALSE.
LOPENDONE= .FALSE.
LSILENT= .FALSE.
C IRECLEN=137
TEMPSTRING(1:)=CSTRING(1:)
C IEND=FILEN_STRING(CSTRING)
C TEMPSTRING(1:IEND)=CSTRING(1:IEND)
C LENGTH=IEND
TEMPSTRING(1:)=CSTRING(1:)
CNUMBER='0123456789'
LENGTH=LEN(TEMPSTRING)
CALL RSLIB_LOWTOUP(TEMPSTRING,LENGTH)
IF (INDEX(TEMPSTRING,'NEW').NE.0) THEN
LNEW=.TRUE.
ENDIF
IF (INDEX(TEMPSTRING,'UNKNOWN').NE.0) THEN
LUNKNOWN=.TRUE.
ENDIF
IF (INDEX(TEMPSTRING,'UNFORMATTED').NE.0) THEN
LUNFORMATTED=.TRUE.
ENDIF
IF (INDEX(TEMPSTRING,'DIRECT').NE.0) THEN
LDIRECT=.TRUE.
ENDIF
IF (INDEX(TEMPSTRING,'APPEND').NE.0) THEN
LAPPEND=.TRUE.
ENDIF
IF (INDEX(TEMPSTRING,'SILENT').NE.0) THEN
LSILENT=.TRUE.
ENDIF
IF (INDEX(TEMPSTRING,'RECL=').NE.0) THEN
CTEMP=' '
K=INDEX(TEMPSTRING,'RECL=')+5
CTEMP(1:)=TEMPSTRING(K:)
CALL STRPOS(CTEMP,I,J)
C COMMENTED OUT 22-08, searching for problem with ALPHA
C J=I
C DO WHILE(INDEX(CNUMBER,CTEMP(J:J)).NE.0 )
C J=J+1
C ENDDO
C J=J-1
READ(CTEMP(I:J),'(I6)')IRECLEN
LRECLEN=.TRUE.
ENDIF
C IF (LNEW .EQV. .TRUE.) THEN
IF (LNEW) THEN
CALL RSLIB_DEL_OLDFILE(IUNIT,FILENAME)
ENDIF
IF (LNEW .AND. LUNFORMATTED .AND. LDIRECT ) THEN
C IF ( (LNEW .EQV. .TRUE.) .AND. (LUNFORMATTED .EQV .TRUE.) .AND.
C + (LDIRECT .EQV. .TRUE.) THEN
OPEN(IUNIT,FILE=FILENAME,STATUS='NEW',FORM='UNFORMATTED',
+ ACCESS='DIRECT',RECL=IRECLEN,ERR=999)
LOPENDONE=.TRUE.
ELSE IF ((LNEW .EQV. .TRUE.) .AND.
+ (LUNFORMATTED .EQV. .TRUE.) ) THEN
OPEN(IUNIT,FILE=FILENAME,STATUS='NEW',FORM='UNFORMATTED',
+ ERR=999)
LOPENDONE=.TRUE.
ELSE IF ((LNEW .EQV. .TRUE.) .AND.
+ (LUNFORMATTED .EQV. .FALSE.) .AND.
+ (LDIRECT .EQV. .TRUE.)) THEN
OPEN(IUNIT,FILE=FILENAME,ACCESS='DIRECT',STATUS='NEW',
+ FORM='FORMATTED',RECL=IRECLEN,ERR=999)
LOPENDONE=.TRUE.
ELSE IF ((LNEW.EQV. .FALSE.) .AND.
+ (LUNFORMATTED .EQV. .TRUE.) .AND.
+ (LDIRECT .EQV. .TRUE.)) THEN
OPEN(IUNIT,FILE=FILENAME,STATUS='OLD',FORM='UNFORMATTED',
+ ACCESS='DIRECT',RECL=IRECLEN,ERR=999)
LOPENDONE=.TRUE.
ELSE IF ((LNEW .EQV. .FALSE.) .AND.
+ (LUNFORMATTED .EQV. .FALSE.) .AND.
+ (LDIRECT .EQV. .TRUE.)) THEN
OPEN(IUNIT,FILE=FILENAME,STATUS='OLD',FORM='FORMATTED',
+ ACCESS='DIRECT',RECL=IRECLEN,ERR=999)
LOPENDONE=.TRUE.
ELSE IF ((LNEW .EQV. .FALSE.) .AND.
+ (LUNFORMATTED .EQV. .TRUE.)) THEN
OPEN(IUNIT,FILE=FILENAME,STATUS='OLD',FORM='UNFORMATTED',
+ ERR=999)
REWIND(IUNIT)
LOPENDONE=.TRUE.
ELSE IF (LNEW .EQV. .TRUE.) THEN
OPEN(IUNIT,FILE=FILENAME,STATUS='NEW',ERR=999)
REWIND(IUNIT)
LOPENDONE=.TRUE.
C 2003-10 hack xxbr problem with IBM
C ELSE IF ((LUNKNOWN .EQV..TRUE.) .AND.
C + (LAPPEND .EQV. .TRUE.)) THEN
C OPEN(IUNIT,FILE=FILENAME,STATUS='UNKNOWN',ACCESS='APPEND',
C + ERR=999)
C REWIND(IUNIT)
C LOPENDONE=.TRUE.
C ELSE IF ((LNEW .EQV. .FALSE.).AND. (LAPPEND .EQV. .TRUE.)) THEN
C OPEN(IUNIT,FILE=FILENAME,STATUS='OLD',ACCESS='APPEND',ERR=999)
C LOPENDONE=.TRUE.
ELSE IF (LNEW .EQV. .FALSE.) THEN
OPEN(IUNIT,FILE=FILENAME,STATUS='OLD',ERR=999)
REWIND(IUNIT)
LOPENDONE=.TRUE.
ELSE
OPEN(IUNIT,FILE=FILENAME,STATUS='UNKNOWN',ERR=999)
rewind(iunit)
LOPENDONE=.TRUE.
ENDIF
IF (LOPENDONE .EQV. .FALSE.) THEN
WRITE(6,*)' ERROR in RSLIB_OPEN_FILE: file not opened'
WRITE(6,*)' unknown specifier combination !'
STOP
ENDIF
RETURN
999 IF (LSILENT .EQV. .FALSE.) THEN
WRITE(6,*)' ERROR rs_gethssp: open file error for file: '
WRITE(6,*)FILENAME
write(6,*)'lnew=',lnew, ' lunformatted=',lunformatted,
+ ' ldirect=',ldirect, ' lunknown=',lunknown,
+ ' lappend=',lappend
write(6,*)' len=',LENGTH
ENDIF
LERROR=.TRUE.
RETURN
END
***** end of RSLIB_OPEN_FILE
***** ------------------------------------------------------------------
***** SUB RSLIB_DEL_OLDFILE
***** ------------------------------------------------------------------
C----
C---- NAME : RSLIB_DEL_OLDFILE
C---- ARG :
C---- DES : deleting old file
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
*----------------------------------------------------------------------*
SUBROUTINE RSLIB_DEL_OLDFILE(IUNIT,FILENAME)
CHARACTER*222 FILENAME
INTEGER IUNIT
LOGICAL LEXIST,LOPEN
INQUIRE(FILE=FILENAME,OPENED=LOPEN)
IF (LOPEN .EQV. .TRUE.) THEN
CLOSE(IUNIT)
ENDIF
INQUIRE(FILE=FILENAME,EXIST=LEXIST)
IF (LEXIST .EQV. .TRUE.) THEN
OPEN(IUNIT,FILE=FILENAME,STATUS='OLD')
CLOSE(IUNIT,STATUS='DELETE')
ENDIF
END
***** end of RSLIB_DEL_OLDFILE
***** ------------------------------------------------------------------
***** SUB RSLIB_LOWTOUP
***** ------------------------------------------------------------------
C----
C---- NAME : RSLIB_LOWTOUP
C---- ARG :
C---- DES : changing case of string.
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
*----------------------------------------------------------------------*
SUBROUTINE RSLIB_LOWTOUP(STRING,LENGTH)
C changed by RS (speed up)
CHARACTER*222 STRING*(*)
INTEGER LENGTH
DO I=1,LENGTH
IF (STRING(I:I).GE.'a' .AND. STRING(I:I).LE.'z') THEN
STRING(I:I)=CHAR( ICHAR(STRING(I:I))-32 )
ENDIF
ENDDO
RETURN
END
***** end of RSLIB_LOWTOUP
***** ------------------------------------------------------------------
***** SUB SCOUNT_HYDROPHOB
***** ------------------------------------------------------------------
C----
C---- NAME : SCOUNT_HYDROPHOB
C---- ARG :
C---- DES : The number of adjacent hydrophibic residues is counted.
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: The number of adjacent hydrophibic residues is *
* -------- counted. *
* in variables: KUNIT,NUMRES, RESNAME *
* out variables: Potential transmembrane regions: if more than *
* -------------- 15: A, V, F, P, M, I, L adjacent *
* called by: DATAOT *
* SBRs calling: from lib-comp.f: *
* -------------- FILENSTRING *
*----------------------------------------------------------------------*
SUBROUTINE SCOUNT_HYDROPHOB(KUNIT)
C---- include parameter files
INCLUDE 'phdParameter.f'
C---- local variables
INTEGER HCOUNT,MUE,KUNIT,ICOUNT,ITER,
+ BEGSEG(1:20),ENDSEG(1:20)
LOGICAL LHELP,LFOUND
******------------------------------*-----------------------------******
C---- defaults
LFOUND=.FALSE.
MUE=0
ICOUNT=0
DO WHILE (MUE.LT.NUMRES)
HCOUNT=0
LHELP=.TRUE.
DO WHILE((MUE.LT.NUMRES).AND.LHELP)
MUE=MUE+1
IF ((RESNAME(MUE).EQ.'A').OR.(RESNAME(MUE).EQ.'V')
+ .OR.(RESNAME(MUE).EQ.'F').OR.(RESNAME(MUE).EQ.'W')
+ .OR.(RESNAME(MUE).EQ.'M').OR.(RESNAME(MUE).EQ.'Y')
+ .OR.(RESNAME(MUE).EQ.'I').OR.(RESNAME(MUE).EQ.'L')) THEN
HCOUNT=HCOUNT+1
ELSE
LHELP=.FALSE.
END IF
END DO
IF (HCOUNT.GT.15) THEN
ICOUNT=ICOUNT+1
LFOUND=.TRUE.
BEGSEG(ICOUNT)=MUE-HCOUNT
ENDSEG(ICOUNT)=MUE
END IF
END DO
IF (LFOUND .EQV. .TRUE.) THEN
WRITE(KUNIT,'(T2,A,T10,A)')'---',
+ '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
WRITE(KUNIT,'(T2,A)')'---'
WRITE(KUNIT,'(T2,A,T10,A)')'---',
+ 'PHD has been trained only on few membrane proteins.'
WRITE(KUNIT,'(T2,A,T10,A)')'---',
+ 'Consequently, the expected accuracy on these is very low.'
WRITE(KUNIT,'(T2,A,T10,A)')'---',
+ 'The sequence you sent, seems to have transmembrane segments'
WRITE(KUNIT,'(T2,A,T10,A)')'---',
+ '(probably helical) at the residue positions:'
WRITE(KUNIT,'(T2,A)')'---'
DO ITER=1,ICOUNT
WRITE(KUNIT,'(T2,A,T10,A,T20,I3,T25,A,T35,I5,T42,A,
+ T48,I5)')'---','segment',ITER,
+ 'begin:',BEGSEG(ITER),'end:',ENDSEG(ITER)
END DO
WRITE(KUNIT,'(T2,A)')'---'
WRITE(KUNIT,'(T2,A,T10,A)')'---',
+ 'For these positions the prediction of secondary structure as'
IF (ICOUNT.GT.1) THEN
WRITE(KUNIT,'(T2,A,T10,A)')'---',
+ 'given above might be misleading. The segments are '
WRITE(KUNIT,'(T2,A,T10,A)')'---','probably helices!'
ELSE
WRITE(KUNIT,'(T2,A,T10,A)')'---',
+ 'given above is possibly misleading. The segment is '
WRITE(KUNIT,'(T2,A,T10,A)')'---',
+ 'probably a helix!'
END IF
WRITE(KUNIT,'(T2,A)')'---'
WRITE(KUNIT,'(T2,A,T10,A)')'---',
+ '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
WRITE(KUNIT,*)
WRITE(KUNIT,*)
END IF
C----------------------------------------------------------------------*
C---- initial check of variables passed -----*
C----------------------------------------------------------------------*
END
***** end of SCOUNT_HYDROPHOB
***** ------------------------------------------------------------------
***** SUB SR_FILTER_EXP
***** ------------------------------------------------------------------
C----
C---- NAME : SR_FILTER_EXP
C---- ARG :
C---- DES : Computes nearest (3) neighbour averages for real input
C---- DES : vector.
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: computes nearest (3) neighbour averages for *
* -------- real input vector *
* input: OUTPUT(1:numout) *
* output: OUTFIL(1:numout) *
*----------------------------------------------------------------------*
SUBROUTINE SR_FILTER_EXP(NUMOUTMAX,NUMOUT,OUTPUT,OUTFIL)
INTEGER ITEXP,NUMOUTMAX,NUMOUT
REAL OUTPUT(1:NUMOUTMAX),OUTFIL(1:NUMOUTMAX),SUM
************************************************************************
DO ITEXP=1,NUMOUT
IF (ITEXP.EQ.1) THEN
OUTFIL(ITEXP)=(OUTPUT(1)+OUTPUT(2))/2.
ELSEIF (ITEXP.EQ.NUMOUT) THEN
OUTFIL(ITEXP)=(OUTPUT(NUMOUT-1)+OUTPUT(NUMOUT))/2.
ELSE
SUM=0
DO IT=-1,1
SUM=SUM+OUTPUT(ITEXP+IT)
END DO
OUTFIL(ITEXP)=SUM/3.
END IF
END DO
END
***** end of SR_FILTER_EXP
***** ------------------------------------------------------------------
***** SUB TRANSAA
***** ------------------------------------------------------------------
C----
C---- NAME : TRANSAA
C---- ARG :
C---- DES : The 20 amino acid one letter names (+unknown+solvent
C---- DES : +Asx +Glx) are 'transcribed' into a vector with
C---- DES : NCODEUNT components 0,1
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: the 20 amino acid one letter names (+unknown *
* -------- +solvent+Asx+Glx) are 'transcribed' into a vector*
* with NCODEUNT components 0,1 *
* output variable AACODE,AABIT,AAHEX *
* --------------- and: SSCODE *
* external SBR: SIBIT1 (HEXNUM,BITPOW,BITVEC) *
* converts the integer hexadecimal number HEXNUM into an *
* integer vector BITVEC(1:(BITPOW+1)) containing 1/0 only, *
* in such a way that: *
* sum/j=1,(BITPOW+1) [2**(BITVEC(j-1))]=HEXNUM *
* note: 2**BITPOW >= HEXNUM! *
* BITVEC(1) codes 2**0! *
* procedure: a one at position of CODEVECTOR means amino *
* --------- acid *
* 1 --> V (VAL: Valine) *
* 2 --> L (LEU: Leucine) *
* 3 --> I (ILE: Isoleucine) *
* 4 --> M (MET: Methiomine) *
* 5 --> F (PHE: Phenylalamine) *
* 6 --> W (TRP: Tryptophan) *
* 7 --> Y (TYR: Tyrosine) *
* 8 --> G (GLY: Glycine) *
* 9 --> A (ALA: Alanine) *
* 10 --> P (PRO: Proline) *
* 11 --> S (SER: Serine) *
* 12 --> T (THR: Threonine) *
* 13 --> C (CYS: Cysteine) *
* 14 --> H (HIS: Histidine) *
* 15 --> R (ARG: Arginine) *
* 16 --> K (LYS: Lysine) *
* 17 --> Q (GLN: Glutamine) *
* 18 --> E (GLU: Glutamate) *
* 19 --> N (ASN: Aspargine) *
* 20 --> D (ASP: Aspartate) *
* 21 --> U ( : Solvent 'ulterior') *
* 22 --> X ( : unknown) *
* 23 --> B (Asx: D or N) *
* 24 --> Z (Glx: Q or E) *
* SSCODE(1) --> H (helix) = H,I,G *
* SSCODE(2) --> E (sheet) = E, B *
* SSCODE(3) --> C (no pred.) = T, S, ' ' *
* if four classes: *
* SSCODE(3) --> T (turn) = T *
* SSCODE(4) --> C (no pred.) = S, ' ' *
* if five classes: *
* SSCODE(3) --> T (turn) = T *
* SSCODE(4) --> S (bend) = S *
*----------------------------------------------------------------------*
SUBROUTINE TRANSAA
C---- parameters/global variables
INCLUDE 'phdParameter.f'
INTEGER ITER1,ITER2,ITEXP
******------------------------------*-----------------------------******
C AACODE(1)='A',(2)='R',(3)='N',(4)='D',(5)='C'.(6)='Q',(7)='E'
C (8)='G',(9)='H',(10)='I',(11)='L',(12)='K',(13)='M',(14)='F'
C (15)='P',(16)='S',(17)='T',(18)='W',(19)='Y',(20)='V',(21)='X'
C (22)='U'
C---- succession according to HSSP scheme
AACODE(1)='V'
AACODE(2)='L'
AACODE(3)='I'
AACODE(4)='M'
AACODE(5)='F'
AACODE(6)='W'
AACODE(7)='Y'
AACODE(8)='G'
AACODE(9)='A'
AACODE(10)='P'
AACODE(11)='S'
AACODE(12)='T'
AACODE(13)='C'
AACODE(14)='H'
AACODE(15)='R'
AACODE(16)='K'
AACODE(17)='Q'
AACODE(18)='E'
AACODE(19)='N'
AACODE(20)='D'
AACODE(21)='U'
AACODE24='VLIMFWYGAPSTCHRKQENDUXBZ'
AACODE_LOWC='abcdefghijklmnopqrstuvwxyz'
C----
C---- converting to binary vector (profile real)
C----
DO ITER1=1,NBIOLOBJ
DO ITER2=1,NBIOLOBJ
IF (ITER1.EQ.ITER2) THEN
AABIT(ITER1,ITER2)=1
ELSE
AABIT(ITER1,ITER2)=0
END IF
END DO
END DO
C----
C---- encoding the secondary structure elements, i.e. the classes of
C---- secondary structure to be distinguished
C----
IF (NSECEL.EQ.3) THEN
SSCODE(1)='H'
SSCODE(2)='E'
SSCODE(3)=' '
ELSEIF (NSECEL.EQ.4) THEN
SSCODE(1)='H'
SSCODE(2)='E'
SSCODE(3)='T'
SSCODE(4)=' '
ELSEIF (NSECEL.EQ.2) THEN
SSCODE(1)='H'
SSCODE(2)=' '
ELSEIF (NSECEL.EQ.5) THEN
SSCODE(1)='H'
SSCODE(2)='E'
SSCODE(3)='T'
SSCODE(4)='S'
SSCODE(5)=' '
ELSEIF (MODESECSTRON(1:9).EQ.'SECONDARY') THEN
WRITE(6,*)' NSECEL not properly chosen: 3<=NSECEL<=5'
WRITE(6,*)' stopped in TRANSAA, stop 2'
STOP
END IF
C----
C---- coding exposure state names
C----
DO ITEXP=1,10
C version real values (0-1)
C IF (THREXP10ST(ITEXP).LT.THREXP3ST(2)) THEN
C EXPCODE(ITEXP)='b'
C ELSEIF (THREXP10ST(ITEXP).GE.THREXP3ST(3)) THEN
C EXPCODE(ITEXP)='e'
C ELSE
C EXPCODE(ITEXP)='i'
C END IF
C version integer values (0-100)
IF (THREXP10STI(ITEXP).LT.THREXP3STI(2)) THEN
EXPCODE(ITEXP)='b'
ELSEIF (THREXP10STI(ITEXP).GE.THREXP3STI(3)) THEN
EXPCODE(ITEXP)='e'
ELSE
EXPCODE(ITEXP)='i'
END IF
END DO
END
***** end of TRANSAA
***** ------------------------------------------------------------------
***** SUB TRIGGER
***** ------------------------------------------------------------------
C----
C---- NAME : TRIGGER
C---- ARG :
C---- DES : Executes the network trigger function input -->
C---- DES : output,for a particular architecture ACTCHI
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: This SBR executes the network trigger function *
* -------- input --> output,for a particular architecture *
* ACTCHI. *
* const. passed: ACTCHI, ACTFILE, CONTROLCHAR, NUMRES, NSECEL *
* var. passed: in: INPUT, out: OUTPUT *
* var. read: NUMIN,NUMHID,NUMOUT,JUNCTION1ST,JUNCTION2ND *
* ext. SBR: SFILEOPEN (lib-unix) *
* ext. function EXP (should be available) *
* called by: SBR NETWORK *
* calling: SBR READARCH *
*----------------------------------------------------------------------*
SUBROUTINE TRIGGER
C---- parameters/global variables
INCLUDE 'phdParameter.f'
C---- local variables
INTEGER MUE,ITIN,ITHID,ITOUT
REAL INVABW,NEGINVABW,INTERHID
******------------------------------*-----------------------------******
* MUE,ITIN,ITHID,ITOUT: iteration variables *
* INPUT (NUMHID,NUMIN+) input matrix *
* is used *
* INVABW =1/ABW for avoiding too high quantities *
* JUNCTION1ST(j,i) connection of the first layer, i.e. between *
* the input unit j and the hidden one i *
* JUNCTION2ND(j,i) connection of the second layer, i.e. between *
* the hidden unit j and the output one i *
* LOCFIELD the local fields (abbr.: h) are defined by: *
* h(I,MUE )= sum(k,{J(k,i)*s(k,mue))+b(i,mue) *
* NEGINVABW =-INVABW *
* NUMHID number of hidden units: 2**NUMHID > NUMOUT *
* NUMIN number of input units = (WIDTH + LENGTH)*NCODEUNT*
* NUMOUT number of output u. = WIDTH * LENGTH * BITACC *
* OUTPUT(NUMOUT,NUMHID+) output matrix *
******------------------------------*-----------------------------******
C---- cutoffs
INVABW=1./ABW
NEGINVABW=(-1.)*INVABW
C--------------------------------------------------
C---- loop over all residues -----
C--------------------------------------------------
DO MUE=1,NUMRES
C------- compute local fields for hidden unit
DO ITHID=1,NUMHID
LOCFIELD1(ITHID)=0.
DO ITIN=1,NUMIN
IF (INPUT(ITIN,MUE).NE.0.) THEN
LOCFIELD1(ITHID)=LOCFIELD1(ITHID)
+ +JUNCTION1ST(ITIN,ITHID)*INPUT(ITIN,MUE)
END IF
END DO
C---------- threshold units
C DO ITIN=(NUMIN+1),(NUMIN+NSECEL)
DO ITIN=(NUMIN+1),(NUMIN+NUMOUT)
LOCFIELD1(ITHID)=LOCFIELD1(ITHID)+JUNCTION1ST(ITIN,ITHID)
END DO
END DO
C------- compute output
DO ITOUT=1,NUMOUT
LOCFIELD2(ITOUT)=0.
C---------- PARALLEL
C----------
DO ITHID=1,NUMHID
C------------- VECTOR
IF (ABS(LOCFIELD1(ITHID)).LT.INVABW) THEN
INTERHID=(1./(1.+EXP (- LOCFIELD1(ITHID) ) ))
LOCFIELD2(ITOUT)=LOCFIELD2(ITOUT)+
+ (JUNCTION2ND(ITHID,ITOUT)*INTERHID)
ELSEIF (LOCFIELD1(ITHID).LE.NEGINVABW) THEN
INTERHID=0.
ELSEIF (LOCFIELD1(ITHID).GE.INVABW) THEN
LOCFIELD2(ITOUT)=LOCFIELD2(ITOUT)
+ +JUNCTION2ND(ITHID,ITOUT)
INTERHID=1.
ELSE
WRITE(6,'(T2,A,T10,A)')'***',
+ 'ERROR in SBR TRIGGER: wrong assignment for '
WRITE(6,'(T2,A,T10,A)')'***',
+ 'intermediate output!! Stopped at 12-10-92-1'
STOP
END IF
C------------- END VECTOR
END DO
C----------
C---------- END PARALLEL
C---------- threshold units
C DO ITHID=(NUMHID+1),(NUMHID+NSECEL)
DO ITHID=(NUMHID+1),(NUMHID+NUMOUT)
LOCFIELD2(ITOUT)=LOCFIELD2(ITOUT)
+ +JUNCTION2ND(ITHID,ITOUT)
END DO
C---------- output
IF ((ABS(LOCFIELD2(ITOUT)).LT.INVABW).AND.
+ (LOCFIELD2(ITOUT).GT.NEGINVABW)) THEN
OUTPUT(ITOUT,MUE)=1./(1.+ EXP (- LOCFIELD2(ITOUT) ))
ELSEIF (LOCFIELD2(ITOUT).LE.NEGINVABW) THEN
OUTPUT(ITOUT,MUE)=0.
ELSEIF (LOCFIELD2(ITOUT).GE.INVABW) THEN
OUTPUT(ITOUT,MUE)=1.
ELSE
WRITE(6,'(T2,A,T10,A)')'***',
+ 'ERROR in SBR TRIGGER: wrong assignment for output!'
WRITE(6,'(T2,A,T10,A)')'***',
+ 'stopped at 12-10-92-2'
STOP
END IF
END DO
C------- end of loop over output units
END DO
C--------------------------------------------------
C---- end of loop over all residues ----
C--------------------------------------------------
END
***** end of TRIGGER
***** ------------------------------------------------------------------
***** SUB TXTRES
***** ------------------------------------------------------------------
C----
C---- NAME : TXTRES
C---- ARG :
C---- DES : The results of the prediction are written.
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: The results of the prediction are written into *
* -------- the output. *
* control: MODESECSTRON *
* input: NUMRES, NUMNETJURY *
* ------ RESNAME, OUTBINCHAR, PROTNAME *
* external subroutines: TIME,DATE *
*----------------------------------------------------------------------*
SUBROUTINE TXTRES
C---- global parameters *
INCLUDE 'phdParameter.f'
C---- local variables
INTEGER ITER
LOGICAL LHELP
******------------------------------*-----------------------------******
WRITE(6,*)
WRITE(6,'(T20,A)')' **************************************'
WRITE(6,'(T20,A)')' ***** Data of program secstron *****'
WRITE(6,'(T20,A)')' **************************************'
WRITE(6,*)
WRITE(6,*)
WRITE(6,*)
WRITE(6,'(T2,A)')'---'
WRITE(6,'(T2,80A1)')('-',ITER=1,80)
WRITE(6,'(T2,A)')'---'
WRITE(6,'(T2,A)')'---'
C---- call SCFDATE from external lib-syst-unix.f
LHELP=.TRUE.
C CALL SCFDATE(2,LHELP,STARTDATE)
C---- CALL SRDTIME from external lib-syst-unix.f
c$$$ CALL SRDTIME(2,LHELP)
C---- writing header
C =================
C CALL WRTPHDHEADER(6)
C =================
C---- writing content of secondary structure and paper to referee
C ==================
CALL WRTCONTENT(6)
C ==================
WRITE(6,*)
WRITE(6,*)
WRITE(6,'(T10,A,T30,A50)')'Prediction for:',FILE_HSSP
WRITE(6,'(T10,A)')'---------------'
WRITE(6,*)
WRITE(6,*)
IF (MODESECSTRON(1:9).EQ.'SECONDARY') THEN
C ===============
CALL WRTPRED(6)
C ===============
ELSEIF (MODESECSTRON.EQ.'EXPOSURE') THEN
C ==============
CALL WRTEXP(6)
C ==============
END IF
WRITE(6,*)
WRITE(6,*)
WRITE(6,'(T2,A)')'---'
WRITE(6,'(T2,A)')'---'
WRITE(6,'(T2,A,T10,A)')'---',
+ 'Note: prediction has been written into file:'
WRITE(6,'(T2,A,T10,A50)')'---',FILEPRED
WRITE(6,'(T2,A)')'---'
WRITE(6,'(T2,A)')'---'
WRITE(6,'(T2,70A1)')('-',ITER=1,70)
WRITE(6,'(T2,A)')'---'
WRITE(6,'(T2,A)')'---'
END
***** end of TXTRES
***** ------------------------------------------------------------------
***** SUB WINDIR
***** ------------------------------------------------------------------
C----
C---- NAME : WINDIR
C---- ARG :
C---- DES : The input and the desired output for every case are
C---- DES : read and written into INPUT/DESIRED.
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: The input and the desired output for every case *
* -------- are read and written into INPUT/DESIRED. *
* control param.: MODECODEIN, FLAGTRAIN, FLAGTESTNN, *
* --------------- NUMPROTTRAIN/TEST, NUMRESTRAIN/TEST *
* TRAIN/TESTINGSET *
* input parameter:CONTROLCHAR, *
* output param.: *
* input variables:RESPROF, POINTBEG, TRANSLISTTRAIN/TEST *
* output variab.: INPUT,DESIRED,TSTINPUT,TSTCMPRSN *
* for SBR WINCUT: PROFMAX, PROFINTERV, CASCINTERV, CASCACC *
* called from: NETWORK *
* SBRs calling: WINASS, WININCOMPOSITION, WININCOMPOSITION_ALL, *
* -------------- WINDIRINI, WININLENGTH, WININDISTCAPS *
* hierarchy: -> WINDIRINI *
* -> WINASS (assign INPUT, DESIRED, + test) *
* -> WININDIR *
* a) -> WININAA (INPUT=CODEVECTOR for Seq.-Str.) *
* -> CODEIN *
* b) -> WININSTR(INPUT=CODEVECTOR for Str.-Str.) *
* -> CODESTR *
* -> WININCOMPOSTION_ALL *
* -> WININCOMPOSTION *
* -> WININLENGTH *
* -> WININDISTCAPS *
* procedure: For each residue R0, resp. for each object being *
* --------- composed by LENGTHOBJ, NUMNEIGH neighbouring amino
* acids (resp. objects) are written to both sides *
* thus forming a string of 2*NUMNEIGH + 1 residues *
* with residue R0 being in the centre. Each of *
* these residues is encoded by a binary vector of *
* dimension NCODEUNT. This final string of length *
* (2*NUMNEIGH+1)*NCODEUNT represents the INPUT vec-*
* tor for case R0. The corresponding output vector*
* DESIRED simply contains the properties currently *
* to be predicted, e.g. the secondary structure (see
* commentary in parameter file for PREDICTIONTYPE) *
*----------------------------------------------------------------------*
SUBROUTINE WINDIR
C---- global parameters
INCLUDE 'phdParameter.f'
C---- local parameters
LOGICAL LCHECK_WRITE
PARAMETER (LCHECK_WRITE=.FALSE.)
C PARAMETER (LCHECK_WRITE=.TRUE.)
C---- local variables
INTEGER MUE,IT
******------------------------------*-----------------------------******
C--------------------------------------------------
C---- defaults -----
C--------------------------------------------------
C ==============
CALL WINDIRINI
C ==============
C-----------------------------------------------------------------------
C---- assign INPUT/DESIRED for TESTing set------------------------------
C-----------------------------------------------------------------------
C---- loop over all residues for particular protein
DO MUE=1,NUMRES
ACTPOS=MUE
C------- case discrimination according to actual mue, i.e. the
C------- position of the actual central object within the protein
C------- NUMNEIGH < central position <= NUMRES-NUMNEIGH
IF ((NUMNEIGH.LT.MUE).AND.(MUE.LE.(NUMRES-NUMNEIGH))) THEN
CASEDISCR='MIDDLE'
ACTSOLVADDBEG=0
ACTSOLVADDEND=0
ACTSOLVADDEND2=0
C------- NUMNEIGH >= central position <= NUMRES-NUMNEIGH
ELSEIF ((MUE.LE.NUMNEIGH).AND.(MUE.LE.(NUMRES-NUMNEIGH))) THEN
CASEDISCR='ADDBEG'
ACTSOLVADDBEG=NUMNEIGH-MUE+1
ACTSOLVADDEND=0
ACTSOLVADDEND2=0
C------- NUMRES-NUMNEIGH < central position <= NUMRES
ELSEIF ((NUMNEIGH.LT.MUE).AND.(MUE.GT.(NUMRES-NUMNEIGH)).AND.
+ (MUE.LE.NUMRES)) THEN
CASEDISCR='ADDEND'
ACTSOLVADDBEG=0
ACTSOLVADDEND=NUMNEIGH-(NUMRES-MUE)
ACTSOLVADDEND2=0
C------- NUMRES < central position <= NUMRES
ELSEIF ((NUMNEIGH.LT.MUE).AND.(MUE.GT.NUMRES)) THEN
CASEDISCR='ADDEND2'
ACTSOLVADDBEG=0
ACTSOLVADDEND=NUMNEIGH
ACTSOLVADDEND2=-(NUMRES-MUE)
C------- NUMNEIGH >= central position > NUMRES-NUMNEIGH <= NUMRES
ELSEIF ((NUMNEIGH.GE.MUE).AND.(MUE.GT.(NUMRES-NUMNEIGH)).AND.
+ (MUE.LE.NUMRES)) THEN
CASEDISCR='ADDBOTH'
ACTSOLVADDBEG=NUMNEIGH-MUE+1
ACTSOLVADDEND=NUMNEIGH-(NUMRES-MUE)
ACTSOLVADDEND2=0
C------- NUMNEIGH >= central position > NUMRES
ELSEIF ((NUMNEIGH.GE.MUE).AND.(MUE.GT.NUMRES)) THEN
CASEDISCR='ADDBOTH2'
ACTSOLVADDBEG=NUMNEIGH-MUE+1
ACTSOLVADDEND=NUMNEIGH
ACTSOLVADDEND2=-(NUMRES-MUE)
ELSE
WRITE(6,*)' fault in WINCUT, case discrimination'
WRITE(6,*)' name: ',PROTNAME(1)
WRITE(6,*)'length=',NUMRES,' mue=',MUE
STOP
END IF
C------- end of case discrimination
C------- assign INPUT/DESIRED
IF (CASEDISCR.NE.'REJECT') THEN
C ===========
CALL WINASS
C ===========
ELSE
WRITE(6,*)' Fault for casediscrimination, WINCUT'
WRITE(6,*)' training set, stop 1.2'
STOP
END IF
C--------------------------------------------------
C------- add additional unit for amino acid -------
C------- composition -------
C--------------------------------------------------
IF (LOGI_COMPOSITION .EQV. .TRUE.) THEN
C---------- for N-term: compute composition of whole protein
IF (MUE.EQ.1) THEN
C =========================
CALL WININCOMPOSITION_ALL
C =========================
END IF
C---------- compute composition for current window
C =====================
CALL WININCOMPOSITION
C =====================
END IF
C--------------------------------------------------
C------- add additional unit for protein length
C--------------------------------------------------
IF (LOGI_LENGTH .EQV. .TRUE.) THEN
C ================
CALL WININLENGTH
C ================
END IF
C--------------------------------------------------
C------- add additional units for distance to caps
C--------------------------------------------------
IF (LOGI_DISTCAPS .EQV. .TRUE.) THEN
C ==================
CALL WININDISTCAPS
C ==================
END IF
C--------------------------------------------------
C------- control write out! xx
C--------------------------------------------------
IF (LCHECK_WRITE .EQV. .TRUE.) THEN
IF (MUE.GE.17) THEN
WRITE(6,*)MUE
WRITE(6,'(24I3)')
+ (int(100*INPUT(IT,MUE)),IT=1,NUMIN)
END IF
IF (MUE.EQ.27) THEN
WRITE(6,*)'numin=',numin,' out=',numout
STOP
END IF
END IF
END DO
C---- end of loop over mue (residues of protein nue)
C-----------------------------------------------------------------------
C---- end of testing set------------------------------------------------
C-----------------------------------------------------------------------
END
***** end of WINDIR
***** ------------------------------------------------------------------
***** SUB WINDIRINI
***** ------------------------------------------------------------------
C----
C---- NAME : WINDIRINI
C---- ARG :
C---- DES : initialises some of the control variables used throughout
C---- DES : programs called by WINDIR.
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: initialises some of the control variables used *
* -------- throughout programs called by WINDIR *
* const. passed: CONTROLCHAR, MODESECSTRON, MODEASSCAS, MODEASSSTR*
* var. passed: out: LOGI_REALINPUT, *
* ------------ LOGI_COMPOSITION, *_LENGTH, *_DISTCAPS *
* LOGI_CONS, *_INDEL, *
* ACTACC, ACTINTERVALL, *
* BEGUNITS_COMPOSITION, *_LENGTH, *_DISTCAPS *
* PROFMAX, PROFINTERV, CASCINTERV, ACTNALIGN *
* var. read: PROFACC, CASCACC, NBIOLOBJ, NUMNEIGH, NCODEUNT, *
* ---------- NUMRES, RESPROF(mue), NUMNALIGN(nue=1) *
* NUNITS_LENGTH, *_DISTCAPS *
* called by: WINDIR *
*----------------------------------------------------------------------*
SUBROUTINE WINDIRINI
C---- global parameters
INCLUDE 'phdParameter.f'
C---- local variables
INTEGER ADDGLOBAL,MUE,ITPROF
******------------------------------*-----------------------------******
C--------------------------------------------------
C---- is input real ?
C--------------------------------------------------
IF ( ((CONTROLCHAR.EQ.'FST').AND.
+ (MODEASSCAS(ACTCHI).EQ.'PROFILE-BIN')) .OR.
+ ((CONTROLCHAR.EQ.'SND') .AND.
+ (MODEASSSTR(ACTCHI)(1:5).EQ.'REAL-')) ) THEN
LOGI_REALINPUT=.FALSE.
ELSE
LOGI_REALINPUT=.TRUE.
END IF
C---- security check
IF ( (MODESECSTRON.EQ.'EXPOSURE').AND.(CONTROLCHAR.EQ.'SND')) THEN
WRITE(6,*)'*** WINDIRINI: check whether or not it is correct'
WRITE(6,*)'*** to assume by default that 2nd archis are'
WRITE(6,*)'*** not coming with real input!'
STOP
END IF
C--------------------------------------------------
C---- any global information ?
C--------------------------------------------------
LOGI_CONS=.FALSE.
LOGI_INDEL=.FALSE.
LOGI_COMPOSITION=.FALSE.
LOGI_LENGTH=.FALSE.
LOGI_DISTCAPS=.FALSE.
IF (CONTROLCHAR.EQ.'FST') THEN
IF ( (MODEASSCAS(ACTCHI).EQ.'PROFILE-REAL').OR.
+ (MODEASSCAS(ACTCHI).EQ.'ALPHABET') ) THEN
LOGI_CONS=.FALSE.
ELSEIF ( (MODEASSCAS(ACTCHI).EQ.'PROFILE-REAL-CONS').OR.
+ (MODEASSCAS(ACTCHI).EQ.'P-REAL-C') ) THEN
LOGI_CONS=.TRUE.
ELSEIF (MODEASSCAS(ACTCHI).EQ.'P-REAL-CONS-INDEL') THEN
LOGI_CONS=.TRUE.
LOGI_INDEL=.TRUE.
ELSEIF ( (MODEASSCAS(ACTCHI).EQ.'P-REAL-CONS-INCOM').OR.
+ (MODEASSCAS(ACTCHI).EQ.'P-REAL-CIC') ) THEN
LOGI_CONS=.TRUE.
LOGI_INDEL=.TRUE.
LOGI_COMPOSITION=.TRUE.
ELSEIF ( (MODEASSCAS(ACTCHI).EQ.'P-REAL-CONS-COMPO').OR.
+ (MODEASSCAS(ACTCHI).EQ.'P-REAL-CC') ) THEN
LOGI_CONS=.TRUE.
LOGI_COMPOSITION=.TRUE.
ELSEIF (MODEASSCAS(ACTCHI).EQ.'P-REAL-CCLD') THEN
LOGI_CONS=.TRUE.
LOGI_COMPOSITION=.TRUE.
LOGI_LENGTH=.TRUE.
LOGI_DISTCAPS=.TRUE.
ELSEIF (MODEASSCAS(ACTCHI).EQ.'P-REAL-CICLD') THEN
LOGI_CONS=.TRUE.
LOGI_INDEL=.TRUE.
LOGI_COMPOSITION=.TRUE.
LOGI_LENGTH=.TRUE.
LOGI_DISTCAPS=.TRUE.
ELSE
WRITE(6,'(T2,A,T10,A)')'***','WINDIRINI: trouble '//
+ 'initialising LOGI_* !'
WRITE(6,'(T2,A,T10,A)')'***','stopped 6-3-94b'
STOP
END IF
ELSEIF (CONTROLCHAR.EQ.'SND') THEN
IF ( (MODEASSSTR(ACTCHI).EQ.'REAL-CONS').OR.
+ (MODEASSSTR(ACTCHI).EQ.'REAL-CONS93') ) THEN
LOGI_CONS=.TRUE.
ELSEIF (MODEASSSTR(ACTCHI).EQ.'REAL-CONS-INDEL') THEN
LOGI_CONS=.TRUE.
LOGI_INDEL=.TRUE.
ELSEIF ( (MODEASSSTR(ACTCHI).EQ.'REAL-CONS-COMPO').OR.
+ (MODEASSSTR(ACTCHI).EQ.'REAL-CC') ) THEN
LOGI_CONS=.TRUE.
LOGI_COMPOSITION=.TRUE.
ELSEIF (MODEASSSTR(ACTCHI).EQ.'REAL-CCLD') THEN
LOGI_CONS=.TRUE.
LOGI_COMPOSITION=.TRUE.
LOGI_LENGTH=.TRUE.
LOGI_DISTCAPS=.TRUE.
ELSEIF (MODEASSSTR(ACTCHI).EQ.'RR-CCLD') THEN
LOGI_CONS=.TRUE.
LOGI_COMPOSITION=.TRUE.
LOGI_LENGTH=.TRUE.
LOGI_DISTCAPS=.TRUE.
ELSEIF (MODEASSSTR(ACTCHI).NE.'REAL-OCT') THEN
WRITE(6,'(T2,A,T10,A)')'***','WINDIRINI: trouble '//
+ 'initialising LOGI_* !'
WRITE(6,'(T2,A,T10,A,T20,A1,A,A1)')'***',
+ 'MODEASSSTR=','|',MODEASSSTR(ACTCHI),'|'
WRITE(6,'(T2,A,T10,A)')'***','stopped 6-3-94c'
STOP
END IF
ELSE
WRITE(6,'(T2,A,T10,A)')'***','ERROR in WINDIRINI '//
+ 'CONTROLCHAR (or MODEASSCAS/STR) wrong ! 6-2-94a'
STOP
END IF
C--------------------------------------------------
C---- intervalls and accuracy for binary input
C--------------------------------------------------
IF (LOGI_REALINPUT .EQV. .FALSE.) THEN
IF (CONTROLCHAR.EQ.'FST') THEN
ACTACC=PROFACC
ELSE
ACTACC=CASCACC
END IF
ACTINTERVALL=1/MAX(1.,REAL(ACTACC))
END IF
C--------------------------------------------------
C---- begin of global units
C--------------------------------------------------
ADDGLOBAL=0
IF (LOGI_COMPOSITION .EQV. .TRUE.) THEN
BEGUNITS_COMPOSITION=(2*NUMNEIGH+1)*NCODEUNT+1
IF (LOGI_REALINPUT .EQV. .FALSE.) THEN
ADDGLOBAL=NBIOLOBJ*(ACTACC-1)
ELSE
ADDGLOBAL=NBIOLOBJ
END IF
END IF
IF (LOGI_LENGTH .EQV. .TRUE.) THEN
BEGUNITS_LENGTH=(2*NUMNEIGH+1)*NCODEUNT+ADDGLOBAL+1
IF (LOGI_REALINPUT .EQV. .FALSE.) THEN
ADDGLOBAL=ADDGLOBAL+(NUNITS_LENGTH*(ACTACC-1))
ELSE
ADDGLOBAL=ADDGLOBAL+NUNITS_LENGTH
END IF
END IF
IF (LOGI_DISTCAPS .EQV. .TRUE.) THEN
BEGUNITS_DISTCAPS=(2*NUMNEIGH+1)*NCODEUNT+ADDGLOBAL+1
IF (LOGI_REALINPUT .EQV. .FALSE.) THEN
ADDGLOBAL=ADDGLOBAL+(2*NUNITS_DISTCAPS*(ACTACC-1))
+
ELSE
ADDGLOBAL=ADDGLOBAL+2*NUNITS_DISTCAPS
END IF
END IF
C--------------------------------------------------
C---- for the input being a profile: find out -----
C---- maximum -----
C--------------------------------------------------
PROFMAX=0
DO MUE=1,NUMRES
DO ITPROF=1,(NBIOLOBJ-1)
IF (RESPROF(MUE,ITPROF).GT.PROFMAX) THEN
PROFMAX=RESPROF(MUE,ITPROF)
END IF
END DO
END DO
PROFINTERV=REAL(PROFMAX)/REAL(PROFACC-2)
CASCINTERV=100./REAL(CASCACC-2)
ACTNALIGN=NUMNALIGN(1)
END
***** end of WINDIRINI
***** ------------------------------------------------------------------
***** SUB WINASS
***** ------------------------------------------------------------------
C----
C---- NAME : WINASS
C---- ARG :
C---- DES : For a given window (WINCUT) the vectors for the input
C---- DES : and desired output are assigned.
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: For a given window (WINCUT) the vectors for the *
* -------- input and desired output are assigned. *
* control param.: PREDMODE, LENGTHOBJ, *
* --------------- NSECEL, NCODEUNT, NUMNEIGH *
* input parameter:ACTPOS, ACTPOS *
* ----------------ACTSOLVADDBEG, ACTSOLVADDEND2, ACTSOLVADDEND *
* output param.: ACTSTART, ACTRESIDUE, ACTCONSERV, *
* -------------- ACTCONSWEIGHT, ACTPOS, ACTREGION, ACTITER, *
* input variables:RESNAME, RESVAR, RESCONSWEIGHT, *
* output variab.: INPUT, DESIRED, TSTCMPRSN *
* called from: WINCUT *
* SBRs calling: WININDIR, WINOUT *
* procedure: see SBR WINDIR *
*----------------------------------------------------------------------*
SUBROUTINE WINASS
C---- global parameters
INCLUDE 'phdParameter.f'
C---- local variables
INTEGER ITER1,ITAA
LOGICAL LHELP
******------------------------------*-----------------------------******
* MUE,IT* serve as iteration variables *
* IHELP intermediately required variable *
* ACTCASE0 used to memorize the actual case if entering into*
* the loop over the objects *
* ACTPOS0 same as ACTCASE0 for the position *
******------------------------------*-----------------------------******
C--------------------------------------------------
C---- defaults
C--------------------------------------------------
C---- set zero
C -----------
CALL SISTZ1(ACTCOMPOSITION,NBIOLOBJMAX)
C -----------
C--------------------------------------------------
C---- add solvents at begin -----
C--------------------------------------------------
DO ITER1=1,ACTSOLVADDBEG
ACTRESIDUE='U'
C------- fork to distinguish between first and second net
ACTREGION='ADDBEG'
ACTITER=ITER1
ACTSTART=(ITER1-1)*NCODEUNT
C =============
CALL WININDIR
C =============
END DO
C---- sum up for input of amino acid composition
IF (LOGI_COMPOSITION .EQV. .TRUE.) THEN
ACTCOMPOSITION(NBIOLOBJ)=ACTSOLVADDBEG
END IF
C--------------------------------------------------
C---- read NUMNEIGH amino acids before central one-
C--------------------------------------------------
DO ITER1=(ACTSOLVADDBEG+1),NUMNEIGH
ACTRESIDUE=RESNAME(ACTPOS-(NUMNEIGH-ITER1+1))
ACTCONSWEIGHT=
+ RESCONSWEIGHT(ACTPOS-(NUMNEIGH-ITER1+1))
ACTNDEL=RESNDEL(ACTPOS-(NUMNEIGH-ITER1+1))
ACTNINS=RESNINS(ACTPOS-(NUMNEIGH-ITER1+1))
C------- fork to distinguish between first and second net
ACTREGION='BEFORE'
ACTITER=ACTPOS-(NUMNEIGH-ITER1+1)
ACTSTART=(ITER1-1)*NCODEUNT
C =============
CALL WININDIR
C =============
C----------------------------------------
C------- sum up for input of amino acid -
C------- composition -
C----------------------------------------
IF (LOGI_COMPOSITION .EQV. .TRUE.) THEN
LHELP=.TRUE.
DO ITAA=1,(NBIOLOBJ-1)
IF ((LHELP .EQV. .TRUE.) .AND.
+ (ACTRESIDUE.EQ.AACODE(ITAA))) THEN
ACTCOMPOSITION(ITAA)=ACTCOMPOSITION(ITAA)+1
LHELP=.FALSE.
END IF
END DO
END IF
END DO
C---- end of window before central -----
C--------------------------------------------------
C----------------------------------------------------------------------
C---- central 'object' which will be predicted ----
C----------------------------------------------------------------------
ACTRESIDUE=RESNAME(ACTPOS)
ACTCONSWEIGHT=RESCONSWEIGHT(ACTPOS)
ACTNDEL=RESNDEL(ACTPOS)
ACTNINS=RESNINS(ACTPOS)
C---- fork to distinguish between first and second net
ACTREGION='CENTRE'
ACTITER=ACTPOS
ACTSTART=NUMNEIGH*NCODEUNT
C =============
CALL WININDIR
C =============
C----------------------------------------
C---- sum up for input of amino acid ----
C---- composition ----
C----------------------------------------
IF (LOGI_COMPOSITION .EQV. .TRUE.) THEN
LHELP=.TRUE.
DO ITAA=1,(NBIOLOBJ-1)
IF ((LHELP .EQV. .TRUE.) .AND.
+ (ACTRESIDUE.EQ.AACODE(ITAA))) THEN
ACTCOMPOSITION(ITAA)=ACTCOMPOSITION(ITAA)+1
LHELP=.FALSE.
END IF
END DO
END IF
C----------------------------------------------------------------------
C---- end of central objects DESIRED -----
C----------------------------------------------------------------------
C--------------------------------------------------
C---- read NUMNEIGH amino acids after central group
C--------------------------------------------------
DO ITER1=1,(NUMNEIGH-ACTSOLVADDEND)
ACTRESIDUE=RESNAME(ACTPOS+ITER1)
ACTCONSWEIGHT=RESCONSWEIGHT(ACTPOS+ITER1)
ACTNDEL=RESNDEL(ACTPOS+ITER1)
ACTNINS=RESNINS(ACTPOS+ITER1)
C------- fork to distinguish between first and second net
ACTREGION='AFTER'
ACTITER=ACTPOS+ITER1
ACTSTART=(NUMNEIGH+ITER1)*NCODEUNT
C =============
CALL WININDIR
C =============
C----------------------------------------
C------- sum up for input of amino acid -
C------- composition -
C----------------------------------------
IF (LOGI_COMPOSITION .EQV. .TRUE.) THEN
LHELP=.TRUE.
DO ITAA=1,(NBIOLOBJ-1)
IF ((LHELP .EQV. .TRUE.) .AND.
+ (ACTRESIDUE.EQ.AACODE(ITAA))) THEN
ACTCOMPOSITION(ITAA)=ACTCOMPOSITION(ITAA)+1
LHELP=.FALSE.
END IF
END DO
END IF
END DO
C--------------------------------------------------
C---- add solvents at end -----
C--------------------------------------------------
DO ITER1=(NUMNEIGH-ACTSOLVADDEND+1),NUMNEIGH
ACTRESIDUE='U'
C------- fork to distinguish between first and second net
ACTREGION='ADDEND'
ACTITER=(ACTPOS+ITER1)
ACTSTART=(NUMNEIGH+ITER1)*NCODEUNT
C =============
CALL WININDIR
C =============
END DO
C---- sum up for input of amino acid composition
IF (LOGI_COMPOSITION .EQV. .TRUE.) THEN
ACTCOMPOSITION(NBIOLOBJ)=ACTCOMPOSITION(NBIOLOBJ)
+ +ACTSOLVADDEND
END IF
END
***** end of WINASS
***** ------------------------------------------------------------------
***** SUB WININDIR
***** ------------------------------------------------------------------
C----
C---- NAME : WININDIR
C---- ARG :
C---- DES : For a given window position (adding spacer begin,
C---- DES : before
C---- DES : central, after central, adding spacer end) the input
C---- DES : vector
C---- DES : is assigned for exactly that region.
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: For a given window position (adding spacer begin,*
* -------- before central, after central, adding spacer end)*
* the input vector is assigned for exactly that *
* region. *
* control param.: MODEASSCAS, MODEMAIN, NCODEUNT *
* --------------- NBIOLOBJ, NTRAINJURY, NSECEL *
* input parameter:CONTROLCHAR, ACTPOS, ACTPOS *
* ----------------ACTREGION, ACTITER, ACTSTART *
* input variables:RESPROF, RESNAME, RESVAR, RESCONSWEIGHT, *
* ----------------INTRJ, TSTINTRJ *
* from CODEIN: CODEVECTOR *
* CODESTR: CODEVECTOR *
* output variab.: INPUT, TSTINPUT *
* for SBR CODEIN: ACTRESIDUE, CODEVECPROF, CODEVECINCASc *
* called from: WINASS *
* SBRs calling: CODEIN, CODESTR, WININAA, WININSTR *
* procedure: see SBR WINDIR *
*----------------------------------------------------------------------*
SUBROUTINE WININDIR
C---- global parameters
INCLUDE 'phdParameter.f'
C---- local variables
INTEGER ITPROF,ITOUT
CHARACTER*222 TMPASSCAS
******------------------------------*-----------------------------******
C--------------------------------------------------
C---- for first network -----
C--------------------------------------------------
IF (CONTROLCHAR.EQ.'FST') THEN
C----------------------------------------
C------- add solvents at begin/end ------
C----------------------------------------
IF ((ACTREGION.EQ.'ADDBEG').OR.(ACTREGION.EQ.'ADDEND')) THEN
C---------- profile input?
TMPASSCAS=MODEASSCAS(ACTCHI)
IF ((TMPASSCAS(1:7).EQ.'PROFILE').OR.
+ (TMPASSCAS(1:7).EQ.'P-REAL-')) THEN
DO ITPROF=1,(NBIOLOBJ-1)
CODEVECPROF(ITPROF)=0
END DO
CODEVECPROF(NBIOLOBJ)=PROFMAX
END IF
C---------- translating amino acid/profile to input vectors
C ===========
CALL CODEIN
C ===========
C---------- INPUT (resp. TSTINPUT) = CODEVECTOR
C ============
CALL WININAA
C ============
C----------------------------------------
C------- residues before/after/ central -
C----------------------------------------
ELSEIF ((ACTREGION.EQ.'BEFORE').OR.
+ (ACTREGION.EQ.'CENTRE').OR.
+ (ACTREGION.EQ.'AFTER')) THEN
C---------- profile input?
TMPASSCAS=MODEASSCAS(ACTCHI)
IF ((TMPASSCAS(1:7).EQ.'PROFILE').OR.
+ (TMPASSCAS(1:7).EQ.'P-REAL-')) THEN
C change: insertion
C IF ((ACTRESIDUE.EQ.'.').OR.(ACTRESIDUE.EQ.' ')) THEN
IF (ACTRESIDUE.EQ.' ') THEN
DO ITPROF=1,(NBIOLOBJ-1)
CODEVECPROF(ITPROF)=0
END DO
CODEVECPROF(NBIOLOBJ)=PROFMAX
ELSE
DO ITPROF=1,(NBIOLOBJ-1)
CODEVECPROF(ITPROF)=RESPROF(ACTITER,ITPROF)
END DO
CODEVECPROF(NBIOLOBJ)=0
END IF
END IF
C---------- translating amino acid/profile to input vectors
C ===========
CALL CODEIN
C ===========
C---------- INPUT (resp. TSTINPUT) = CODEVECTOR
C ============
CALL WININAA
C ============
ELSE
WRITE(6,'(T2,A,T10,A,T60,A)')'***',
+ 'ERROR WININDIR called with wrong ACTREGION =',ACTREGION
WRITE(6,'(T2,A,T10,A,T60,A)')'***',
+ 'stopped at 23-10-91-1. For CONTROLCHAR=',CONTROLCHAR
STOP
END IF
C--------------------------------------------------
C---- second network, only structure to structure -
C--------------------------------------------------
ELSEIF (CONTROLCHAR.EQ.'SND') THEN
C----------------------------------------
C------- add solvents at begin/end ------
C----------------------------------------
IF ((ACTREGION.EQ.'ADDBEG').OR.(ACTREGION.EQ.'ADDEND')) THEN
DO ITOUT=1,NUMOUT
CODEVECINCASC(ITOUT)=0
END DO
CODEVECINCASC(NUMOUT+1)=100
C---------- translating secondary structure into a vector
C ============
CALL CODESTR
C ============
C---------- INPUT (resp. TSTINPUT) = CODEVECTOR
C =============
CALL WININSTR
C =============
C----------------------------------------
C------- residues before/after/central --
C----------------------------------------
ELSEIF ((ACTREGION.EQ.'BEFORE').OR.(ACTREGION.EQ.'CENTRE').OR.
+ (ACTREGION.EQ.'AFTER')) THEN
DO ITOUT=1,NUMOUT
CODEVECINCASC(ITOUT)=INT(100*OUTFST(ITOUT,ACTITER,
+ TRANS2FROM1(ACTCHI)))
END DO
CODEVECINCASC(NUMOUT+1)=0
IF (ACTPOS.LT.1) THEN
WRITE(6,*)'WININDIR tries to access sample:'
WRITE(6,*)ACTPOS,' stopped: 15-12-91-1'
STOP
END IF
C---------- translating secondary structure into a vector
C ============
CALL CODESTR
C ============
C---------- INPUT (resp. TSTINPUT) = CODEVECTOR
C =============
CALL WININSTR
C =============
ELSE
WRITE(6,'(T2,A,T10,A,T60,A)')'***',
+ 'ERROR WININDIR called with wrong ACTREGION =',ACTREGION
WRITE(6,'(T2,A,T10,A,T60,A)')'***',
+ 'stopped at 23-10-91-2. For CONTROLCHAR=',CONTROLCHAR
STOP
END IF
ELSE
WRITE(6,'(T2,A,T10,A,T60,A)')'***',
+ 'ERROR WININDIR called with wrong CONTROLCHAR =',CONTROLCHAR
WRITE(6,'(T2,A,T10,A,T60,A)')'***',
+ 'stopped at 23-10-91-3. For ACTREGION=',ACTREGION
STOP
END IF
END
***** end of WININDIR
***** ------------------------------------------------------------------
***** SUB WININAA
***** ------------------------------------------------------------------
C----
C---- NAME : WININAA
C---- ARG :
C---- DES : INPUT/TSTINPUT = CODEVECTOR for NCODEUNT units.
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: INPUT/TSTINPUT = CODEVECTOR for NCODEUNT units. *
* control param.: MODEMAIN,LOGICONSWEIGHT *
* --------------- NCODEUNT *
* input parameter:ACTSTART, ACTPOS, ACTCONSWEIGHT *
* input variables:CODEVECTOR *
* output variab.: INPUT,TSTINPUT *
* called from: WINASS *
*----------------------------------------------------------------------*
SUBROUTINE WININAA
C---- global parameters
INCLUDE 'phdParameter.f'
C---- local variables
INTEGER ITER,INTERNCODEUNT
******------------------------------*-----------------------------******
C---- NCODEUNT according to MODEASSCAS:
IF ((LOGI_CONS .EQV. .TRUE.) .AND.
+ (LOGI_INDEL .EQV. .FALSE.)) THEN
INTERNCODEUNT=NCODEUNT-1
ELSEIF ((LOGI_CONS .EQV. .TRUE.) .AND.
+ (LOGI_INDEL.EQV. .TRUE.)) THEN
INTERNCODEUNT=NCODEUNT-3
ELSE
INTERNCODEUNT=NCODEUNT
END IF
C--------------------------------------------------
C---- for binary input -----
C--------------------------------------------------
IF ((MODEASSCAS(ACTCHI).EQ.'ALPHABET').OR.
+ (MODEASSCAS(ACTCHI).EQ.'PROFILE-BIN')) THEN
DO ITER=1,INTERNCODEUNT
INPUT((ACTSTART+ITER),ACTPOS)=INT(CODEVECTOR(ITER))
END DO
C--------------------------------------------------
C---- for real input -----
C--------------------------------------------------
ELSEIF (MODEASSCAS(ACTCHI).EQ.'PROFILE-REAL') THEN
DO ITER=1,INTERNCODEUNT
INPUT((ACTSTART+ITER),ACTPOS)=CODEVECTOR(ITER)
END DO
C--------------------------------------------------
C---- for real input (with conservation weight) ---
C--------------------------------------------------
ELSEIF ((LOGI_CONS .EQV. .TRUE.) .AND.
+ (LOGI_INDEL .EQV. .FALSE.)) THEN
DO ITER=1,INTERNCODEUNT
INPUT((ACTSTART+ITER),ACTPOS)=CODEVECTOR(ITER)
END DO
IF (ACTCONSWEIGHT.LE.2) THEN
INPUT((ACTSTART+NCODEUNT),ACTPOS)=ACTCONSWEIGHT/2.
ELSE
INPUT((ACTSTART+NCODEUNT),ACTPOS)=0
END IF
C--------------------------------------------------
C---- for real input + conservation weight + indels
C--------------------------------------------------
ELSEIF ((LOGI_CONS .EQV. .TRUE.) .AND.
+ (LOGI_INDEL.EQV. .TRUE.)) THEN
DO ITER=1,INTERNCODEUNT
INPUT((ACTSTART+ITER),ACTPOS)=CODEVECTOR(ITER)
END DO
IF (ACTCONSWEIGHT.LE.2) THEN
INPUT((ACTSTART+INTERNCODEUNT+1),ACTPOS)=ACTCONSWEIGHT/2.
ELSE
INPUT((ACTSTART+INTERNCODEUNT+1),ACTPOS)=0
END IF
INPUT((ACTSTART+NCODEUNT-1),ACTPOS)=ACTNDEL/REAL(ACTNALIGN)
INPUT((ACTSTART+NCODEUNT),ACTPOS)=ACTNINS/REAL(ACTNALIGN)
ELSE
WRITE(6,'(T2,A)')'***'
WRITE(6,'(T2,A,T10,A)') '***','ERROR: please ask for help!'
WRITE(6,'(T2,A,T10,A,A)')'***','WININAA: MODEASSCAS not in '//
+ 'appropriate mode! The current choice is:'
WRITE(6,'(T2,A,T10,A,T40,A,T70,I3)')'***',MODEASSCAS(ACTCHI),
+ 'for architecture:',ACTCHI
STOP
END IF
END
***** end of WININAA
***** ------------------------------------------------------------------
***** SUB WININSTR
***** ------------------------------------------------------------------
C----
C---- NAME : WININSTR
C---- ARG :
C---- DES : INPUT/TSTINPUT = CODEVECTOR for NCODEUNT units.
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: INPUT/TSTINPUT = CODEVECTOR for NCODEUNT units. *
* control param.: MODEMAIN,LOGICONSWEIGHT *
* --------------- NCODEUNT *
* input parameter:ACTSTART, ACTPOS, ACTCONSWEIGHT *
* input variables:CODEVECTOR *
* output variab.: INPUT,TSTINPUT *
* called from: WINASS *
*----------------------------------------------------------------------*
SUBROUTINE WININSTR
C---- global parameters
INCLUDE 'phdParameter.f'
C---- local variables
INTEGER ITER
******------------------------------*-----------------------------******
C--------------------------------------------------
C---- for binary input -----
C--------------------------------------------------
IF (LOGI_REALINPUT .EQV. .FALSE.) THEN
DO ITER=1,NCODEUNT
INPUT((ACTSTART+ITER),ACTPOS)=INT(CODEVECTOR(ITER))
END DO
ELSE
DO ITER=1,NCODEUNT
INPUT((ACTSTART+ITER),ACTPOS)=CODEVECTOR(ITER)
END DO
END IF
END
***** end of WININSTR
***** ------------------------------------------------------------------
***** SUB WININCOMPOSITION
***** ------------------------------------------------------------------
C----
C---- NAME : WININCOMPOSITION
C---- ARG :
C---- DES : assign the values to INPUT/TSTINPUT for the unit
C---- DES : coding
C---- DES : for the composition of amino acids.
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: assign the values to INPUT/TSTINPUT for the unit *
* -------- coding for the composition of amino acids. *
* const. passed: LOGI_REALINPUT, CONTROLCHAR, *
* var. passed: out: INPUT *
* var. read: NUMIN, NBIOLOBJ, PROFACC, CASCACC, NUMRES, *
* ---------- ACTCOMPOSITION, CODECOMPOSTION *
* called by: WINDIR *
*----------------------------------------------------------------------*
SUBROUTINE WININCOMPOSITION
C---- global parameters
INCLUDE 'phdParameter.f'
C---- local variables
INTEGER IBEG,IBEG1,ITAA,IHELP,ITACC
REAL HDIFF
******------------------------------*-----------------------------******
C--------------------------------------------------
C---- defaults -----
C--------------------------------------------------
C---- start of coding unit
IBEG=BEGUNITS_COMPOSITION-1
C--------------------------------------------------
C---- for binary input -----
C--------------------------------------------------
IF (LOGI_REALINPUT .EQV. .FALSE.) THEN
DO ITAA=1,NBIOLOBJ
IBEG1=IBEG+((ITAA-1)*(ACTACC-1))
IHELP=2*NUMNEIGH+1
IF (NUMRES.GT.IHELP) THEN
HDIFF=(CODECOMPOSITION(ITAA)-ACTCOMPOSITION(ITAA))
+ /REAL(NUMRES-IHELP)
ELSE
HDIFF=(CODECOMPOSITION(ITAA)-ACTCOMPOSITION(ITAA))
+ /REAL(IHELP)
END IF
DO ITACC=1,(ACTACC-1)
IF (HDIFF.GE.(ITACC*ACTINTERVALL)) THEN
INPUT((IBEG1+ITACC),ACTPOS)=1
ELSE
INPUT((IBEG1+ITACC),ACTPOS)=0
END IF
END DO
END DO
C--------------------------------------------------
C---- for real input -----
C--------------------------------------------------
ELSEIF (LOGI_REALINPUT .EQV. .TRUE.) THEN
IHELP=2*NUMNEIGH+1
DO ITAA=1,NBIOLOBJ
IF (NUMRES.GT.IHELP) THEN
HDIFF=(CODECOMPOSITION(ITAA)-ACTCOMPOSITION(ITAA))
+ /REAL(NUMRES-IHELP)
ELSE
HDIFF=(CODECOMPOSITION(ITAA)-ACTCOMPOSITION(ITAA))
+ /REAL(IHELP)
END IF
INPUT((IBEG+ITAA),ACTPOS)=HDIFF
END DO
ELSE
WRITE(6,'(T2,A,T10,A)')'***','ERROR in WININCOMPOSITION'//
+ ' something wrong with input to SBR!'
STOP
END IF
END
***** end of WININCOMPOSITION
***** ------------------------------------------------------------------
***** SUB WININCOMPOSITION_ALL
***** ------------------------------------------------------------------
C----
C---- NAME : WININCOMPOSITION_ALL
C---- ARG :
C---- DES : Compute amino acid composittion for a particular
C---- DES : protein (nue).
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: Compute the amino acid composittion for a par- *
* -------- ticular protein (nue). *
* input: NUMRES, RESNAME, ACTPOS, *
* ------ AACODE24, AACODE_LOWC, NBIOLOBJ *
* output variab.: CODECOMPOSITION *
* SBRs calling: SISTZ1 (from lib-comp.f) *
* called by: WINDIR *
*----------------------------------------------------------------------*
SUBROUTINE WININCOMPOSITION_ALL
C---- global parameters
INCLUDE 'phdParameter.f'
C---- local variables
INTEGER MUE,ITAA,ITAA2,ITC
CHARACTER*1 HCHAR
LOGICAL LHELP,LHELP2
******------------------------------*-----------------------------******
C--------------------------------------------------
C---- defaults -----
C--------------------------------------------------
ITC= 0
C---- set zero
C -----------
CALL SISTZ1(CODECOMPOSITION,NBIOLOBJMAX)
C -----------
C---- loop over whole protein
DO MUE=1,NUMRES
LHELP=.TRUE.
HCHAR=RESNAME(MUE)
C------- check for usual amino acids
DO ITAA=1,(NBIOLOBJ-1)
IF (LHELP .EQV. .TRUE.) THEN
IF (HCHAR.EQ.AACODE24(ITAA:ITAA)) THEN
CODECOMPOSITION(ITAA)=CODECOMPOSITION(ITAA)+1
LHELP=.FALSE.
END IF
END IF
END DO
C------- check for ends, chain breaks asf
IF (LHELP .EQV. .TRUE.) THEN
IF ((HCHAR.EQ.'!').OR.(HCHAR.EQ.'/').OR.
+ (HCHAR.EQ.'U').OR.(HCHAR.EQ.'O')) THEN
CODECOMPOSITION(NBIOLOBJ)=CODECOMPOSITION(NBIOLOBJ)+1
LHELP=.FALSE.
END IF
END IF
C------- check for small caps = cysteine
IF (LHELP .EQV. .TRUE.) THEN
LHELP2=.TRUE.
DO ITAA=1,(NBIOLOBJ-1)
IF (AACODE24(ITAA:ITAA).EQ.'C') THEN
ITC=ITAA
LHELP2=.FALSE.
END IF
END DO
IF (LHELP2 .EQV. .TRUE.) THEN
STOP ' *** WININCOMPOSITION_ALL: NO C'
END IF
DO ITAA2=1,26
IF ((LHELP .EQV. .TRUE.) .AND.
+ (HCHAR.EQ.AACODE_LOWC(ITAA2:ITAA2))) THEN
CODECOMPOSITION(ITC)=CODECOMPOSITION(ITC)+1
LHELP=.FALSE.
END IF
END DO
END IF
C------- consistency: one found?
IF (LHELP .EQV. .TRUE.) THEN
IF (HCHAR.NE.'.') THEN
WRITE(6,'(T2,A,T10,A)')'***','ERROR in WININ'//
+ 'COMPOSITION_ALL of amino acids:'
WRITE(6,'(T2,A,T10,A,T30,A,T35,A,T45,I4)')
+ '***','no match for:',HCHAR,'prot',1
END IF
CODECOMPOSITION(NBIOLOBJ)=CODECOMPOSITION(NBIOLOBJ)+1
END IF
END DO
END
***** end of WININCOMPOSITION_ALL
***** ------------------------------------------------------------------
***** SUB WININLENGTH
***** ------------------------------------------------------------------
C----
C---- NAME : WININLENGTH
C---- ARG :
C---- DES : Assign the values to INPUT/TSTINPUT for the units
C---- DES : coding for
C---- DES : the length of the protein.
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: assign the values to INPUT/TSTINPUT for the units*
* -------- coding for the length of the protein. *
* const. passed: LOGI_REALINPUT, CONTROLCHAR, ACTPOS *
* var. passed: out: INPUT *
* var. read: SPLIT_LENGTH, BEGUNITS_LENGTH, NUNITS_LENGTH, *
* ---------- NUMRES *
* called by: WINDIR *
*----------------------------------------------------------------------*
SUBROUTINE WININLENGTH
C---- global parameters
INCLUDE 'phdParameter.f'
C---- local variables
INTEGER IBEG,IBEG1,ITLEN,ITACC,INTERV2(1:4)
REAL HDIFF,HINTER
LOGICAL LHELP
******------------------------------*-----------------------------******
C--------------------------------------------------
C---- defaults -----
C--------------------------------------------------
INTERV2(1)=SPLIT_LENGTH(1)
INTERV2(2)=SPLIT_LENGTH(2)-SPLIT_LENGTH(1)
INTERV2(3)=SPLIT_LENGTH(3)-SPLIT_LENGTH(2)
INTERV2(4)=SPLIT_LENGTH(4)-SPLIT_LENGTH(3)
C---- start of coding unit
IBEG=BEGUNITS_LENGTH-1
C---- checks
IF (NUNITS_LENGTH.NE.4) THEN
WRITE(6,'(T2,A,T10,A)')'***','ERROR in WININLENGTH: '//
+ 'currently only for NUNITS_LENGTH = 4 (phdParameter.f) !'
WRITE(6,'(T2,A,T10,A,T40,I5,T50,A)')'***',
+ 'instead it is: ',NUNITS_LENGTH,'stopped 29-12-93-1.'
STOP
END IF
C--------------------------------------------------
C---- for binary input -----
C--------------------------------------------------
IF (LOGI_REALINPUT .EQV. .FALSE.) THEN
C------------------------------
C------- loop over coding units
C------------------------------
LHELP=.TRUE.
DO ITLEN=1,NUNITS_LENGTH
IBEG1=IBEG+((ITLEN-1)*(ACTACC-1))
IF (LHELP .EQV. .TRUE.) THEN
IF (NUMRES.GE.SPLIT_LENGTH(ITLEN)) THEN
HDIFF=1.
ELSE
IF (NUMRES.GT.500) THEN
HDIFF=1.
ELSE
HINTER=REAL(INTERV2(ITLEN)
+ -(SPLIT_LENGTH(ITLEN)-NUMRES))
HDIFF=HINTER/REAL(INTERV2(ITLEN))
END IF
LHELP=.FALSE.
END IF
ELSE
HDIFF=0.
END IF
C---------- translate reals to binary grid
DO ITACC=1,(ACTACC-1)
IF (HDIFF.GE.(ITACC*ACTINTERVALL)) THEN
INPUT((IBEG1+ITACC),ACTPOS)=1
ELSE
INPUT((IBEG1+ITACC),ACTPOS)=0
END IF
END DO
C---------- end translate reals to binary grid
END DO
C------- end loop coding units
C------------------------------
C--------------------------------------------------
C---- for real input -----
C--------------------------------------------------
ELSEIF (LOGI_REALINPUT .EQV. .TRUE.) THEN
LHELP=.TRUE.
DO ITLEN=1,NUNITS_LENGTH
IF (LHELP .EQV. .TRUE.) THEN
IF (NUMRES.GE.SPLIT_LENGTH(ITLEN)) THEN
HDIFF=1.
ELSE
IF (NUMRES.GT.500) THEN
HDIFF=1.
ELSE
HINTER=REAL(INTERV2(ITLEN)
+ -(SPLIT_LENGTH(ITLEN)-NUMRES))
HDIFF=HINTER/REAL(INTERV2(ITLEN))
END IF
LHELP=.FALSE.
END IF
ELSE
HDIFF=0
END IF
INPUT((IBEG+ITLEN),ACTPOS)=HDIFF
END DO
END IF
END
***** end of WININLENGTH
***** ------------------------------------------------------------------
***** SUB WININDISTCAPS
***** ------------------------------------------------------------------
C----
C---- NAME : WININDISTCAPS
C---- ARG :
C---- DES : Assign the values to INPUT/TSTINPUT for the units
C---- DES : coding for
C---- DES : the distance to the caps of the protein.
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: Assign the values to INPUT/TSTINPUT for the units*
* -------- coding for the distance to the caps of the protein
* const. passed: LOGI_REALINPUT, CONTROLCHAR, ACTPOS *
* var. passed: out: INPUT *
* var. read: SPLIT_DISTCAPS, *_DISTCAPS, *_DISTCAPS, *
* ---------- ACTACC, ACTINTERVALL, NUMRES,
* called by: WINDIR *
*----------------------------------------------------------------------*
SUBROUTINE WININDISTCAPS
C---- global parameters
INCLUDE 'phdParameter.f'
C---- local variables
INTEGER IBEGN,IBEGC,IBEG1N,IBEG1C,ITLEN,ITACC
REAL HDIFFN,HDIFFC,HINTER
******------------------------------*-----------------------------******
C--------------------------------------------------
C---- defaults -----
C--------------------------------------------------
C---- start of coding unit
IBEGN=BEGUNITS_DISTCAPS-1
C---- checks
IF (NUNITS_DISTCAPS.NE.4) THEN
WRITE(6,'(T2,A,T10,A)')'***','ERROR in WININDISTCAPS: '//
+ 'currently only for NUNITS_DISTCAPS = 4 (phdParameter.f) !'
WRITE(6,'(T2,A,T10,A,T40,I5,T50,A)')'***',
+ 'instead it is: ',NUNITS_DISTCAPS,'stopped 29-12-93-1.'
STOP
END IF
C--------------------------------------------------
C---- for binary input -----
C--------------------------------------------------
IF (LOGI_REALINPUT .EQV. .FALSE.) THEN
C------------------------------
C------- loop over coding units
C------------------------------
IBEGC=BEGUNITS_DISTCAPS-1+(NUNITS_DISTCAPS*(ACTACC-1))
IBEGN=BEGUNITS_DISTCAPS-1
DO ITLEN=1,NUNITS_DISTCAPS
IBEG1N=IBEGN+((ITLEN-1)*(ACTACC-1))
IBEG1C=IBEGC+((ITLEN-1)*(ACTACC-1))
C---------- N-term cap
IF (ACTPOS.LE.SPLIT_DISTCAPS(ITLEN)) THEN
HINTER=REAL(SPLIT_DISTCAPS(ITLEN)-ACTPOS+1)
HDIFFN=MIN(1.,(HINTER/10.))
ELSE
HDIFFN=0.
END IF
C---------- C-term cap
IF ((NUMRES-ACTPOS).LE.SPLIT_DISTCAPS(ITLEN)) THEN
HDIFFC=1.
HINTER=REAL(SPLIT_DISTCAPS(ITLEN)-(NUMRES-ACTPOS))
HDIFFC=MIN(1.,(HINTER/10.))
ELSE
HDIFFC=0.
END IF
C---------- translate reals to binary grid
DO ITACC=1,(ACTACC-1)
IF (HDIFFN.GE.(ITACC*ACTINTERVALL)) THEN
INPUT((IBEG1N+ITACC),ACTPOS)=1
ELSE
INPUT((IBEG1N+ITACC),ACTPOS)=0
END IF
IF (HDIFFC.GE.(ITACC*ACTINTERVALL)) THEN
INPUT((IBEG1C+ITACC),ACTPOS)=1
ELSE
INPUT((IBEG1C+ITACC),ACTPOS)=0
END IF
END DO
C---------- end translate reals to binary grid
END DO
C------- end loop coding units
C------------------------------
C--------------------------------------------------
C---- for real input -----
C--------------------------------------------------
ELSEIF (LOGI_REALINPUT .EQV. .TRUE.) THEN
IBEGC=(BEGUNITS_DISTCAPS-1)+NUNITS_DISTCAPS
DO ITLEN=1,NUNITS_DISTCAPS
C---------- N-term cap
IF (ACTPOS.LE.SPLIT_DISTCAPS(ITLEN)) THEN
HINTER=REAL(SPLIT_DISTCAPS(ITLEN)-ACTPOS+1)
HDIFFN=MIN(1.,(HINTER/10.))
ELSE
HDIFFN=0.
END IF
C---------- C-term cap
IF ((NUMRES-ACTPOS).LE.SPLIT_DISTCAPS(ITLEN)) THEN
HDIFFC=1.
HINTER=REAL(SPLIT_DISTCAPS(ITLEN)-(NUMRES-ACTPOS))
HDIFFC=MIN(1.,(HINTER/10.))
ELSE
HDIFFC=0.
END IF
INPUT((IBEGN+ITLEN),ACTPOS)=HDIFFN
INPUT((IBEGC+ITLEN),ACTPOS)=HDIFFC
END DO
END IF
END
***** end of WININDISTCAPS
***** ------------------------------------------------------------------
***** SUB WRTBOTHHEADER
***** ------------------------------------------------------------------
C----
C---- NAME : WRTBOTHHEADER
C---- ARG :
C---- DES : Write headers for prediction (sec and acc).
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
*----------------------------------------------------------------------*
SUBROUTINE WRTBOTHHEADER(KUNIT,VERSION,NUMNETJURY,
+ TXT80,IBEG,IEND)
C---- local variables
INTEGER KUNIT,ITER,IEND,IBEG,NUMNETJURY
C CHARACTER*24 FCTIME_DATE
CHARACTER*5 SBEG,SEND
CHARACTER*222 INTERTXT,TXT80(1:30),VERSION
************************************************************************
C---- defaults
SBEG='* '
SEND=' *'
C--------------------------------------------------
C---- write header into prediction output -----
C--------------------------------------------------
CALL WRTF(KUNIT)
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,
+ ' PHD output for your protein:',SEND
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,
+ ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~',SEND
CALL WRTE(KUNIT)
CALL WRTE(KUNIT)
c$$$ WRITE(KUNIT,'(A3,A1,A24,T78,A3)')SBEG,' ',FCTIME_DATE(),SEND
CALL WRTE(KUNIT)
WRITE(KUNIT,'(A3,A11,T18,I4,T25,A35,A10,A2,T78,A3)')SBEG,
+ ' Jury on: ',NUMNETJURY,' different architectures '//
+ '(version ',VERSION,').',SEND
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,' Note: differently trained '//
+ 'architectures, i.e., different versions can',SEND
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,
+ ' result in different predictions.',SEND
CALL WRTE(KUNIT)
CALL WRTF(KUNIT)
CALL WRTE(KUNIT)
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,' About the protein:',SEND
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,' ------------------',SEND
CALL WRTE(KUNIT)
CALL WRTE(KUNIT)
IF (IBEG.LT.1) THEN
WRITE(6,'(T2,A,T10,A)')'***','ERROR in WRTBOTHHEADER'//
+ ' Hssp file HEADER changed? '
END IF
IF (IEND.GT.30) THEN
WRITE(6,'(T2,A,T10,A)')'***','ERROR in WRTBOTHHEADER'//
+ ' Hssp file NALIGN changed? '
END IF
DO ITER=IBEG,IEND
INTERTXT=TXT80(ITER)
WRITE(KUNIT,'(A3,T10,A60,T78,A3)')SBEG,INTERTXT,SEND
IF (INTERTXT(1:6).EQ.'NALIGN') THEN
WRITE(KUNIT,'(A3,T21,A,T78,A3)')SBEG,
+ '(=number of aligned sequences in HSSP file)',SEND
END IF
END DO
CALL WRTE(KUNIT)
CALL WRTF(KUNIT)
CALL WRTE(KUNIT)
END
***** end of WRTBOTHHEADER
***** ------------------------------------------------------------------
***** SUB WRTCONTENT
***** ------------------------------------------------------------------
C----
C---- NAME : WRTCONTENT
C---- ARG :
C---- DES : The content in secondary structure, resp. relative percent.
C---- DES : of occurrence per amino acid is written onto unit KUNIT.
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: The content in secondary structure, resp. relative
* -------- percentage of occurrence per amino acid is *
* written onto unit KUNIT. *
* input variables:CONTPRED,CONTDSSP,CONTAA *
* output variab.: CONTPRED,CONTDSSP,CONTAA *
* called by: TXTRES, DATAOT *
*----------------------------------------------------------------------*
SUBROUTINE WRTCONTENT(KUNIT)
C---- parameters/global variables
INCLUDE 'phdParameter.f'
C---- local variables
INTEGER KUNIT,MUE,ITAA,ICOUNT,ITSEC,
+ ISORT(1:24),ITLINES,IBEG,IEND
REAL HCONTAA(1:24)
CHARACTER*24 TXTAA,TXTCONT
CHARACTER*1 CAA(1:24),TXTSS(1:8)
CHARACTER*3 SBEG,SEND
******------------------------------*-----------------------------******
C---- default
TXTAA(1:24)='ABCDEFGHIKLMNPQRSTVWXYZU'
SBEG='* '
SEND=' *'
IF (MODESECSTRON(1:9).EQ.'SECONDARY') THEN
TXTSS(1)='H'
TXTSS(2)='E'
IF (NSECEL.GT.3) THEN
TXTSS(3)='T'
END IF
TXTSS(NSECEL)='L'
END IF
C-------------------------------------------------------------
C---- secondary structure prediction -----
C-------------------------------------------------------------
C----------------------------------------
C---- header
C----------------------------------------
C---- paper to quote
WRITE(KUNIT,'(80A)')('*',MUE=1,80)
WRITE(KUNIT,'(A3,T78,A3)')SBEG,SEND
WRITE(KUNIT,'(A3,T10,A,T78,A3)')SBEG,
+ 'Publication to reference in reporting results:',SEND
WRITE(KUNIT,'(A3,T10,A,T78,A3)')SBEG,
+ '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~',SEND
WRITE(KUNIT,'(A3,T78,A3)')SBEG,SEND
IF (MODESECSTRON.EQ.'SECONDARY') THEN
WRITE(KUNIT,'(A3,T10,A,T78,A3)')SBEG,
+ 'Rost, Burkhard; Sander, Chris: Prediction of protein '//
+ 'structure',SEND
WRITE(KUNIT,'(A3,T10,A,T78,A3)')SBEG,
+ ' at better than 70% accuracy. J. Mol. Biol., 1993, '//
+ '232, 584-599.',SEND
END IF
IF (MODESECSTRON(1:9).EQ.'SECONDARY') THEN
WRITE(KUNIT,'(A3,T10,A,T78,A3)')SBEG,
+ 'Rost, Burkhard; Sander, Chris: Combining evolutionary '//
+ 'information',SEND
WRITE(KUNIT,'(A3,T10,A,T78,A3)')SBEG,
+ ' and neural networks to predict protein secondary '//
+ 'structure. ',SEND
WRITE(KUNIT,'(A3,T10,A,T78,A3)')SBEG,
+ ' Proteins, 1994, 19, 55-72.',SEND
END IF
IF (MODESECSTRON.EQ.'EXPOSURE') THEN
WRITE(KUNIT,'(A3,T10,A,T78,A3)')SBEG,
+ 'Rost, Burkhard; Sander, Chris: Conservation and '//
+ 'prediction of ',SEND
WRITE(KUNIT,'(A3,T10,A,T78,A3)')SBEG,
+ ' solvent accessibility in protein families. Proteins, '//
+ '1994,',SEND
WRITE(KUNIT,'(A3,T10,A,T78,A3)')SBEG,
+ ' 20, 216-226.',SEND
END IF
IF (MODESECSTRON.EQ.'SECONDARY_HTM') THEN
WRITE(KUNIT,'(A3,T10,A,T78,A3)')SBEG,
+ 'Rost, Burkhard; Casadio, Rita; Fariselli, Piero; '//
+ 'Sander, Chris: ',SEND
WRITE(KUNIT,'(A3,T10,A,T78,A3)')SBEG,
+ ' Prediction of helical transmembrane segments at 75% ',
+ SEND
WRITE(KUNIT,'(A3,T10,A,T78,A3)')SBEG,
+ ' accuracy. Protein Science, 1995, 4, 521-533',
+ SEND
END IF
WRITE(KUNIT,'(A3,T78,A3)')SBEG,SEND
WRITE(KUNIT,'(80A)')('*',MUE=1,80)
WRITE(KUNIT,'(A3,T78,A3)')SBEG,SEND
WRITE(KUNIT,'(A3,T10,A,T78,A3)')
+ SBEG,'Some statistics:',SEND
WRITE(KUNIT,'(A3,T10,A,T78,A3)')
+ SBEG,'~~~~~~~~~~~~~~~~',SEND
WRITE(KUNIT,'(A3,T78,A3)')SBEG,SEND
WRITE(KUNIT,'(A3,T10,A,T78,A3)')SBEG,
+ 'Percentage of amino acids:',SEND
C----------------------------------------
C---- sorting + writing the content of AA
C----------------------------------------
C ==============
CALL SRSORTVEC(24,24,1,CONTAA,2,ISORT,2)
C ==============
ICOUNT=0
DO ITAA=1,24
IF (CONTAA(ISORT(ITAA)).NE.0) THEN
HCONTAA(ITAA)=CONTAA(ISORT(ITAA))
CAA(ITAA)=TXTAA(ISORT(ITAA):ISORT(ITAA))
ICOUNT=ITAA
END IF
END DO
WRITE(KUNIT,'(A3,T78,A3)')SBEG,SEND
WRITE(KUNIT,'(A3,T10,A,T26,5A9)')SBEG,'+--------------+',
+ ('--------+',ITAA=1,MIN(5,ICOUNT))
DO ITLINES=1,(INT((ICOUNT-0.1)/5.)+1)
IBEG=(ITLINES-1)*5+1
IEND=INT(MIN(REAL(IBEG+4),REAL(ICOUNT)))
WRITE(KUNIT,'(A3,T10,A,T25,A1,5(A5,A4))')SBEG,
+ '| AA:','|',(CAA(ITAA),' |',ITAA=IBEG,IEND)
WRITE(KUNIT,'(A3,T10,A,T25,A1,5(A2,F5.1,A2))')SBEG,
+ '| % of AA:','|',(' ',HCONTAA(ITAA),' |',ITAA=IBEG,IEND)
+
WRITE(KUNIT,'(A3,T10,A,T26,5A9)')SBEG,
+ '+--------------+',('--------+',ITAA=IBEG,IEND)
END DO
C----------------------------------------
C---- writing the content of pred SS
C----------------------------------------
WRITE(KUNIT,'(A3,T78,A3)')SBEG,SEND
IF (MODESECSTRON(1:9).EQ.'SECONDARY') THEN
IF (MODESECSTRON.EQ.'SECONDARY') THEN
IF (LDSSPREAD .EQV. .FALSE.) THEN
WRITE(KUNIT,'(A3,T10,A,T78,A3)')SBEG,
+ 'Percentage of secondary structure predicted:',SEND
ELSE
WRITE(KUNIT,'(A3,T10,A,T78,A3)')SBEG,
+ 'Percentage of secondary structure predicted/observed:',SEND
END IF
ELSE
IF (LDSSPREAD .EQV. .FALSE.) THEN
WRITE(KUNIT,'(A3,T10,A,T78,A3)')SBEG,
+ 'Percentage of helical trans-membrane predicted:',SEND
ELSE
WRITE(KUNIT,'(A3,T10,A,T78,A3)')SBEG,
+ 'Percentage of helical trans-membrane predicted/observed:',SEND
END IF
END IF
WRITE(KUNIT,'(A3,T78,A3)')SBEG,SEND
WRITE(KUNIT,'(A3,T10,A,T26,4A9)')SBEG,
+ '+--------------+',('--------+',ITSEC=1,NSECEL)
WRITE(KUNIT,'(A3,T10,A,T25,A1,4(A4,A1,A4))')SBEG,
+ '| SecStr:','|',(' ',TXTSS(ITSEC),' |',ITSEC=1,NSECEL)
WRITE(KUNIT,'(A3,T10,A,T25,A1,4(A2,F5.1,A2))')SBEG,
+ '| % Predicted:','|',(' ',CONTPRED(ITSEC),' |',ITSEC=1,NSECEL)
END IF
C----------------------------------------
C---- writing the content of obs SS --
C----------------------------------------
IF ((LDSSPREAD .EQV. .TRUE.) .AND.
+ (MODESECSTRON(1:9).EQ.'SECONDARY')) THEN
WRITE(KUNIT,'(A3,T10,A,T26,4A9)')SBEG,
+ '+--------------+',('--------+',ITSEC=1,NSECEL)
WRITE(KUNIT,'(A3,T10,A,T25,A1,4(A4,A1,A4))')SBEG,
+ '| SecStr:','|',(' ',TXTSS(ITSEC),' |',ITSEC=1,NSECEL)
WRITE(KUNIT,'(A3,T10,A,T25,A1,4(A2,F5.1,A2))')SBEG,
+ '| % Observed:','|',(' ',CONTDSSP(ITSEC),' |',ITSEC=1,NSECEL)
+
END IF
WRITE(KUNIT,'(A3,T10,A,T26,4A9)')SBEG,
+ '+--------------+',('--------+',ITSEC=1,NSECEL)
C----------------------------------------
C---- assigning class to pred SS
C----------------------------------------
IF (MODESECSTRON.EQ.'SECONDARY') THEN
IF ((CONTPRED(1).GT.45).AND.(CONTPRED(2).LT.5)) THEN
TXTCONT='all-alpha '
ELSEIF ((CONTPRED(1).LT.5).AND.(CONTPRED(2).GT.45)) THEN
TXTCONT='all-beta '
ELSEIF ((CONTPRED(1).GT.30).AND.(CONTPRED(2).GT.20)) THEN
TXTCONT='alpha-beta '
ELSE
TXTCONT='mixed class'
END IF
WRITE(KUNIT,'(A3,T78,A3)')SBEG,SEND
WRITE(KUNIT,'(A3,T10,A,T78,A3)')SBEG,
+ 'According to the following classes:',SEND
WRITE(KUNIT,'(A3,T10,A,T78,A3)')SBEG,
+ 'all-alpha: %H>45 and %E< 5; all-beta : %H<5 and %E>45',SEND
WRITE(KUNIT,'(A3,T10,A,T78,A3)')SBEG,
+ 'alpha-beta : %H>30 and %E>20; mixed: rest,',SEND
WRITE(KUNIT,'(A3,T10,A,T60,A,T78,A3)')SBEG,
+ 'this means that the predicted class is: ',TXTCONT(1:11),SEND
IF (LDSSPREAD .EQV. .TRUE.) THEN
IF ((CONTDSSP(1).GT.45).AND.(CONTDSSP(2).LT.5)) THEN
TXTCONT='all-alpha '
ELSEIF ((CONTDSSP(1).LT.5).AND.(CONTDSSP(2).GT.45)) THEN
TXTCONT='all-beta '
ELSEIF ((CONTDSSP(1).GT.30).AND.(CONTDSSP(2).GT.20)) THEN
TXTCONT='alpha-beta '
ELSE
TXTCONT='mixed class'
END IF
WRITE(KUNIT,'(A3,T10,A,T60,A,T78,A3)')SBEG,
+ 'The class of the observed structure is: ',TXTCONT(1:11),SEND
END IF
END IF
WRITE(KUNIT,'(A3,T78,A3)')SBEG,SEND
WRITE(KUNIT,'(80A)')('*',MUE=1,80)
WRITE(KUNIT,'(A3,T78,A3)')SBEG,SEND
C---- end of content -----
C--------------------------------------------------
END
***** end of WRTCONTENT
***** ------------------------------------------------------------------
***** SUB WRTD
***** ------------------------------------------------------------------
C----
C---- NAME : WRTD
C---- ARG :
C---- DES : write ending lines
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
*----------------------------------------------------------------------*
SUBROUTINE WRTD(K)
INTEGER ITER,K
WRITE(K,'(A3,T78,A3)')'* ',' *'
WRITE(K,'(A3,74A1,T78,A3)')'***',('.',ITER=1,74),'***'
WRITE(K,'(A3,T78,A3)')'* ',' *'
END
***** end of WRTD
***** ------------------------------------------------------------------
***** SUB WRTEXP
***** ------------------------------------------------------------------
C----
C---- NAME : WRTEXP
C---- ARG :
C---- DES : write solvent accessibility prediction.
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
*----------------------------------------------------------------------*
SUBROUTINE WRTEXP(KUNIT)
C---- global parameters *
INCLUDE 'phdParameter.f'
C---- local functions
CHARACTER*222 FWRITE_STRING_NUMBERS
CHARACTER*1 FC_REXP_TO_3STCHAR
INTEGER FILEN_STRING
C---- local variables
INTEGER KUNIT,ITER,ITLINES,ITMUE,MUE,IHELP,IEND,IBEG,
+ OUTEXPLOC(1:80),IPOS
INTEGER*2 DSSPEXPONE(1:80),PREDEXPONE(1:80)
REAL REXP
CHARACTER*5 SBEG,SEND
CHARACTER*6 CHELP6
CHARACTER*222 INTERTXT,TXT80(1:30),VERSION,CHFILE
CHARACTER*1 PREDTXT(1:80),DSSPTXT(1:80)
LOGICAL LWRITE_ACC80,LWRT80
************************************************************************
* SBRs called: WRTBOTHHEADER, WRTEXPHEADER, WRTWARN_NOALI, *
* WRTPOPRED *
************************************************************************
C---- defaults
LWRT80=.FALSE.
SBEG='* '
SEND=' *'
C--------------------------------------------------
C---- read header of HSSP file -----
C--------------------------------------------------
IEND=FILEN_STRING(FILE_HSSP_NOCHAIN)
CHFILE(1:IEND)=FILE_HSSP_NOCHAIN(1:IEND)
C CALL SFILEOPEN(15,CHFILE(1:IEND),'UNKNOWN',222,' ')
C CALL SFILEOPEN(15,FILE_HSSP_NOCHAIN,'OLD',222,'READONLY')
Cyy OPEN (15,FILE=FILE_HSSP_NOCHAIN,STATUS='OLD',READONLY)
OPEN (15,FILE=FILE_HSSP_NOCHAIN,STATUS='OLD')
DO ITER=1,30
READ(15,'(A80)')TXT80(ITER)
END DO
CLOSE(15)
C---- store begin an end of text to be written
DO ITER=1,30
INTERTXT=TXT80(ITER)
IF (INTERTXT(1:6).EQ.'HEADER') THEN
IBEG=ITER
ELSEIF (INTERTXT(1:6).EQ.'NALIGN') THEN
IEND=ITER
END IF
END DO
C----------------------------------------
C---- enough residues in intervall >= 4 ?
C----------------------------------------
IHELP=0
DO MUE=1,NUMRES
IF (RELIND(MUE).GE.4) THEN
IHELP=IHELP+1
END IF
END DO
IF (IHELP.GT.5) THEN
LWRITE_ACC80=.TRUE.
ELSE
LWRITE_ACC80=.FALSE.
END IF
C--------------------------------------------------
C---- write header into prediction output -----
C--------------------------------------------------
VERSION=VERSION_EXP
C ==================
CALL WRTBOTHHEADER(KUNIT,VERSION,NUMNETJURY,TXT80,IBEG,IEND)
C ==================
C ==================
CALL WRTEXPHEADER(KUNIT,LDSSPREAD,LWRITE_ACC80)
C ==================
C--------------------------------------------------
C---- write warning if too few sequences in ali ---
C--------------------------------------------------
IF (NUMNALIGN(1).LE.5) THEN
C ==================
CALL WRTWARN_NOALI(KUNIT,MODESECSTRON)
C ==================
END IF
C--------------------------------------------------
C---- now write the prediction for all -----
C--------------------------------------------------
C---- data
WRITE(KUNIT,'(A3,T10,A,T25,A7,T40,A,T50,I5,T78,A3)')SBEG,
+ 'protein:',PROTNAME(1),'length',NUMRES,SEND
CALL WRTE(KUNIT)
WRITE(KUNIT,*)
C---- strings of 60: for easy evaluation upon look
DO ITLINES=1,(INT((NUMRES-1)/60.)+1)
WRITE(KUNIT,'(T15,A60)')FWRITE_STRING_NUMBERS(LWRT80,ITLINES)
IPOS=(ITLINES-1)*60
IEND=INT(MIN(60.,REAL(NUMRES-IPOS)))
C----------------------------------------
C------- intermediate strings of lenth 60
DO ITMUE=1,INT(MIN(60.,REAL(NUMRES-IPOS)))
C---------- for observed exposure
IF (LDSSPREAD .EQV. .TRUE.) THEN
REXP=DESEXP(IPOS+ITMUE)
IF (REXP.GE.0) THEN
DSSPEXPONE(ITMUE)=INT2(MIN( 9.,
+ SQRT(100*REXP/REAL(MAXEXP)) ))
C ------------------
DSSPTXT(ITMUE)=
+ FC_REXP_TO_3STCHAR(REXP,THREXP3ST(2),THREXP3ST(3))
C ------------------
IF ( (DSSPTXT(ITMUE).EQ.'I').OR.
+ (DSSPTXT(ITMUE).EQ.'i') ) THEN
DSSPTXT(ITMUE)=' '
END IF
ELSE
WRITE(6,'(T2,A,T10,A)')'***',
+ 'ERROR in WRTEXP: desired exposure < 0'
WRITE(6,'(T2,A,T10,A,T30,I6,T40,A,T50,I4)')'***',
+ 'for itmue = ',itmue,'IPOS=',IPOS
END IF
END IF
C---------- for predicted exposure
IF (LFILTER .EQV. .TRUE.) THEN
OUTEXPLOC(ITMUE)=INT(100*OUTEXPFIL(IPOS+ITMUE))
PREDTXT(ITMUE)=OUTBINCHARFIL(IPOS+ITMUE)
ELSE
OUTEXPLOC(ITMUE)=INT(100*OUTEXP(IPOS+ITMUE))
PREDTXT(ITMUE)=OUTBINCHAR(IPOS+ITMUE)
END IF
IF (OUTEXPLOC(ITMUE).GE.0) THEN
PREDEXPONE(ITMUE)=INT2( MIN( 9.,
+ SQRT(REAL(OUTEXPLOC(ITMUE))) ) )
IF ( (PREDTXT(ITMUE).EQ.'I').OR.
+ (PREDTXT(ITMUE).EQ.'i') ) THEN
PREDTXT(ITMUE)=' '
END IF
ELSE
WRITE(6,'(T2,A,T10,A)')'***',
+ 'ERROR in WRTEXP: predicted exposure < 0'
WRITE(6,'(T2,A,T10,A,T30,I6,T40,A,T50,I4)')'***',
+ 'for itmue = ',itmue,'IPOS=',IPOS
END IF
END DO
C------- end of assigning intermediate strings
C----------------------------------------
C------- sequence
WRITE(KUNIT,'(T10,A5,60A1,A1)')'AA |',
+ (RESNAME(ITMUE),ITMUE=(IPOS+1),(IPOS+IEND)),'|'
C------- projection onto 3 states
IF (LDSSPREAD .EQV. .TRUE.) THEN
C---------- secondary structure
WRITE(KUNIT,'(T10,A5,60A1,A1)')'SS |',
+ (CONVSECSTR(ITMUE),ITMUE=(IPOS+1),(IPOS+IEND)),'|'
C---------- observed relative exposure 3states
WRITE(KUNIT,'(A,T10,A5,60A1,A1)')' 3st:','O 3 |',
+ (DSSPTXT(ITMUE),ITMUE=1,IEND),'|'
CHELP6=' '
ELSE
CHELP6=' 3st:'
END IF
WRITE(KUNIT,'(A,T10,A5,60A1,A1)')CHELP6,'P 3 |',
+ (PREDTXT(ITMUE),ITMUE=1,IEND),'|'
C------- detailed 10 states
IF (LDSSPREAD .EQV. .TRUE.) THEN
C---------- observed relative exposure
WRITE(KUNIT,'(A,T10,A5,60I1,A1)')' 10st:','OBS |',
+ (DSSPEXPONE(ITMUE),ITMUE=1,IEND)
CHELP6=' '
ELSE
CHELP6=' 10st:'
END IF
C------- predicted relative exposure
WRITE(KUNIT,'(A,T10,A5,60I1,A1)')CHELP6,'PHD |',
+ (PREDEXPONE(ITMUE),ITMUE=1,IEND)
C------- reliability index
WRITE(KUNIT,'(T10,A5,60I1,A1)')
+ 'Rel |',(RELIND(ITMUE),ITMUE=(IPOS+1),(IPOS+IEND))
C--------------------------------------------------
C---- now write the prediction for 81.9% -----
C--------------------------------------------------
IF (LWRITE_ACC80 .EQV. .TRUE.) THEN
DO ITMUE=1,IEND
IF (RELIND(IPOS+ITMUE).GE.4) THEN
IF (LFILTER .EQV. .TRUE.) THEN
PREDTXT(ITMUE)=OUTBINCHARFIL(IPOS+ITMUE)
ELSE
PREDTXT(ITMUE)=OUTBINCHAR(IPOS+ITMUE)
END IF
ELSE
PREDTXT(ITMUE)='.'
END IF
END DO
WRITE(KUNIT,'(T2,A,T10,A5,60A1,A1)')'subset:',
+ 'SUB |',(PREDTXT(ITMUE),ITMUE=1,IEND),'|'
END IF
WRITE(KUNIT,*)
END DO
C--------------------------------------------------
C---- compute accuracy if DSSP available -----
C--------------------------------------------------
IF (LDSSPREAD .EQV. .TRUE.) THEN
C =============
CALL WRTPOEXP(KUNIT)
C =============
END IF
END
***** end of WRTEXP
***** ------------------------------------------------------------------
***** SUB WRTEXPHEADER
***** ------------------------------------------------------------------
C----
C---- NAME : WRTEXPHEADER
C---- ARG :
C---- DES : write header for solvent accessibility prediction.
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
*----------------------------------------------------------------------*
SUBROUTINE WRTEXPHEADER(KUNIT,LDSSPREAD,LWRITE_ACC80)
C---- local variables
INTEGER KUNIT
CHARACTER*5 SBEG,SEND
LOGICAL LWRITE_ACC80,LDSSPREAD
************************************************************************
C---- defaults
SBEG='* '
SEND=' *'
C--------------------------------------------------
C---- abbreviations used
C--------------------------------------------------
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,' Abbreviations:',SEND
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,' --------------',SEND
CALL WRTE(KUNIT)
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,
+ ' AA: amino acid sequence',SEND
IF (LDSSPREAD .EQV. .TRUE.) THEN
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,
+ ' SS: H=helix, E=extended (sheet), blank=re'//
+ 'st (loop)',SEND
END IF
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,
+ ' 3st: relative solvent accessibility (acc)'//
+ ' in 3 states:', SEND
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,
+ ' b = 0-9%, i = 9-36%, e = 36-100%.',SEND
CALL WRTE(KUNIT)
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,
+ ' PHD: Profile network prediction HeiDelberg',
+ SEND
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,
+ ' Rel: Reliability index of prediction (0-9)',
+ SEND
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,
+ ' O 3: observed relative '//
+ 'acc. in 3 states: B, I, E',SEND
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,' Note: '//
+ 'for convenience a blank is used intermediate (i).',SEND
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,
+ ' P 3: predicted rel. acc. in 3 states',SEND
WRITE(KUNIT,'(A3,T78,A3)')SBEG,SEND
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,
+ ' 10st: relative solvent acc. in 10 states',
+ SEND
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,
+ ' = n corresponds to a relative acc.'//
+ ' of n*n %',SEND
WRITE(KUNIT,'(A3,T78,A3)')SBEG,SEND
C--------------------------------------------------
C---- subset
C--------------------------------------------------
IF (LWRITE_ACC80 .EQV. .TRUE.) THEN
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,
+ ' Subset: SUB: a subset of the prediction, for all '//
+ 'residues with',SEND
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,
+ ' an expected correlation > 0.69 (tab'//
+ 'les in header)',SEND
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,
+ ' Note: for this subset the following '//
+ 'symbols are used:',SEND
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,
+ ' "I": is intermediate (for which above '//
+ '" " is used)',SEND
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,
+ ' ".": means that no prediction is made '//
+ 'for this residue,',SEND
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,
+ ' as the reliability is Rel < 4',SEND
CALL WRTE(KUNIT)
END IF
CALL WRTF(KUNIT)
END
***** end of WRTEXPHEADER
***** ------------------------------------------------------------------
***** SUB WRTE
***** ------------------------------------------------------------------
C----
C---- NAME : WRTE
C---- ARG :
C---- DES : write empty line
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
*----------------------------------------------------------------------*
SUBROUTINE WRTE(K)
INTEGER K
WRITE(K,'(A3,T78,A3)')'* ',' *'
END
***** end of WRTE
***** ------------------------------------------------------------------
***** SUB WRTF
***** ------------------------------------------------------------------
C----
C---- NAME : WRTF
C---- ARG :
C---- DES : write final line
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE WRTF(K)
INTEGER ITER,K
WRITE(K,'(A3,T78,A3)')'* ',' *'
WRITE(K,'(A3,74A1,T78,A3)')'*****',('*',ITER=1,74),'*****'
WRITE(K,'(A3,T78,A3)')'* ',' *'
WRITE(K,'(A3,T78,A3)')'* ',' *'
END
***** end of WRTF
***** ------------------------------------------------------------------
***** SUB WRTPHDHEADER
***** ------------------------------------------------------------------
C----
C---- NAME : WRTPHDHEADER
C---- ARG :
C---- DES : write overall header.
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
*----------------------------------------------------------------------*
SUBROUTINE WRTPHDHEADER(K)
C---- local variables *
INTEGER K
C PARAMETER (KUNIT=6)
CHARACTER*5 SBEG,SEND
************************************************************************
SBEG='* '
SEND=' *'
************************************************************************
C---- write header
CALL WRTF(K)
CALL WRTE(K)
WRITE(K,'(A3,T10,A,T78,A3)')SBEG,'PredictProtein: ',SEND
WRITE(K,'(A3,T10,A,T78,A3)')SBEG,'~~~~~~~~~~~~~~~ ',SEND
CALL WRTE(K)
WRITE(K,'(A3,T10,A,T78,A3)')SBEG,
+ 'Secondary structure prediction by the PHD neural network',SEND
WRITE(K,'(A3,T10,A,T78,A3)')'*** ',
+ '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~',SEND
CALL WRTE(K)
WRITE(K,'(A3,T10,A,T30,A,T78,A3)')SBEG,'Authors:',
+ 'Burkhard Rost & Chris Sander',SEND
WRITE(K,'(A3,T10,A,T30,A,T78,A3)')SBEG,' ',
+ 'EMBL, Heidelberg, FRG',SEND
WRITE(K,'(A3,T10,A,T30,A,T78,A3)')SBEG,' ',
+ 'Meyerhofstrasse 1, 69117 Heidelberg',SEND
WRITE(K,'(A3,T10,A,T30,A,T78,A3)')SBEG,' ',
+ 'Internet: Predict-Help@EMBL-Heidelberg.DE',SEND
CALL WRTE(K)
WRITE(K,'(A3,T10,A,T30,A,T78,A3)')SBEG,'All rights reserved.',
+ ' ',SEND
CALL WRTE(K)
CALL WRTF(K)
CALL WRTE(K)
C---- about the prediction method
CALL WRTE(K)
WRITE(K,'(A3,T6,A,T78,A3)')SBEG,
+ 'About the input to the network',SEND
WRITE(K,'(A3,T6,A,T78,A3)')'*** ',
+ '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~',SEND
CALL WRTE(K)
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,'The prediction is pe',
+ 'rformed by a system of neural networks.',SEND
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,'The input is a multi',
+ 'ple sequence alignment. It is taken from an HSSP ',SEND
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,'file (produced by th',
+ 'e program MaxHom: ',SEND
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,'Sander & Schneider (',
+ '1991) Proteins, Vol.9, pp. 56-68 ',SEND
CALL WRTE(K)
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,'For optimal results ',
+ 'the alignment should contain sequences with varying',SEND
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,'degrees of sequence ',
+ 'similarity relative to the input protein. ',SEND
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,'The following is an ',
+ 'ideal situation:',SEND
CALL WRTE(K)
WRITE(K,'(A3,T6,A,T78,A3)')SBEG,
+ ' +-----------------+----------------------+',SEND
WRITE(K,'(A3,T6,A,T78,A3)')SBEG,
+ ' | sequence: | sequence identity |',SEND
WRITE(K,'(A3,T6,A,T78,A3)')SBEG,
+ ' +-----------------+----------------------+',SEND
WRITE(K,'(A3,T6,A,T78,A3)')SBEG,
+ ' | target sequence | 100 % |',SEND
WRITE(K,'(A3,T6,A,T78,A3)')SBEG,
+ ' | aligned seq. 1 | 90 % |',SEND
WRITE(K,'(A3,T6,A,T78,A3)')SBEG,
+ ' | aligned seq. 2 | 80 % |',SEND
WRITE(K,'(A3,T6,A,T78,A3)')SBEG,
+ ' | ... | ... |',SEND
WRITE(K,'(A3,T6,A,T78,A3)')SBEG,
+ ' | aligned seq. 7 | 30 % |',SEND
WRITE(K,'(A3,T6,A,T78,A3)')SBEG,
+ ' +-----------------+----------------------+',SEND
CALL WRTE(K)
CALL WRTE(K)
CALL WRTE(K)
C---- results: performance accuracy
CALL WRTE(K)
CALL WRTF(K)
WRITE(K,'(A3,T6,A,T78,A3)')SBEG,
+ 'Estimated Accuracy of Prediction',SEND
WRITE(K,'(A3,T6,A,T78,A3)')SBEG,
+ '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~',SEND
CALL WRTE(K)
CALL WRTE(K)
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,'A careful seven-fold',
+ ' cross validation test on some 130 protein chains ',SEND
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,'(about 25,000 residu',
+ 'es) with less than 30% pairwise sequence identity ',SEND
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,'gave the following r',
+ 'esults:',SEND
CALL WRTE(K)
WRITE(K,'(A3,T6,A23,A,T78,A3)')SBEG,' ++================++',
+ '-----------------------------------------+ ',SEND
WRITE(K,'(A3,T6,A23,A,T78,A3)')SBEG,' || Qtotal = 70.8% ||',
+ ' ("overall three state accuracy") | ',SEND
WRITE(K,'(A3,T6,A23,A,T78,A3)')SBEG,' ++================++',
+ '-----------------------------------------+ ',SEND
WRITE(K,'(A3,T6,A,T78,A3)')SBEG,' ',SEND
WRITE(K,'(A3,T6,A23,A,T78,A3)')SBEG,' +------------------',
+ '----------+-----------------------------+ ',SEND
WRITE(K,'(A3,T6,A23,A,T78,A3)')SBEG,' | Qhelix (% of obse',
+ 'rved)=72% | Qhelix (% of predicted)=73% | ',SEND
WRITE(K,'(A3,T6,A23,A,T78,A3)')SBEG,' | Qstrand(% of obse',
+ 'rved)=66% | Qstrand(% of predicted)=60% | ',SEND
WRITE(K,'(A3,T6,A23,A,T78,A3)')SBEG,' | Qloop (% of obse',
+ 'rved)=72% | Qloop (% of predicted)=74% | ',SEND
WRITE(K,'(A3,T6,A23,A,T78,A3)')SBEG,' +------------------',
+ '----------+-----------------------------+ ',SEND
CALL WRTE(K)
CALL WRTE(K)
C---- definitions
CALL WRTD(K)
CALL WRTE(K)
WRITE(K,'(A3,T6,A,T78,A3)')SBEG,
+ 'These percentages are defined by:',SEND
WRITE(K,'(A3,T6,A,T78,A3)')SBEG,
+ '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~',SEND
CALL WRTE(K)
CALL WRTE(K)
WRITE(K,'(A3,T6,A20,A,T78,A3)')SBEG,
+ ' ',
+ 'number of correctly predicted residues ',SEND
WRITE(K,'(A3,T6,A20,A,T78,A3)')SBEG,
+ 'Qtotal = ',
+ '--------------------------------------- (*100)',SEND
WRITE(K,'(A3,T6,A20,A,T78,A3)')SBEG,
+ ' ',
+ ' number of all residues ',SEND
CALL WRTE(K)
CALL WRTE(K)
WRITE(K,'(A3,T6,A20,A,T78,A3)')SBEG,
+ ' ',
+ 'no of res correctly predicted to be in helix ',SEND
WRITE(K,'(A3,T6,A20,A,T78,A3)')SBEG,
+ 'Qhelix (% of obs) = ',
+ '-------------------------------------------- (*100)',SEND
WRITE(K,'(A3,T6,A20,A,T78,A3)')SBEG,
+ ' ',
+ 'no of all res observed to be in helix ',SEND
CALL WRTE(K)
CALL WRTE(K)
WRITE(K,'(A3,T6,A20,A,T78,A3)')SBEG,
+ ' ',
+ 'no of res correctly predicted to be in helix ',SEND
WRITE(K,'(A3,T6,A20,A,T78,A3)')SBEG,
+ 'Qhelix (% of pred)= ',
+ '-------------------------------------------- (*100)',SEND
WRITE(K,'(A3,T6,A20,A,T78,A3)')SBEG,
+ ' ',
+ 'no of all residues predicted to be in helix ',SEND
CALL WRTE(K)
CALL WRTE(K)
C---- single protein chains
CALL WRTD(K)
CALL WRTE(K)
WRITE(K,'(A3,T6,A,T78,A3)')SBEG,
+ 'Averaging over single chains',SEND
WRITE(K,'(A3,T6,A,T78,A3)')SBEG,
+ '~~~~~~~~~~~~~~~~~~~~~~~~~~~~',SEND
CALL WRTE(K)
CALL WRTE(K)
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,'The most reasonable ',
+ 'way to compute the overall accuracies is the above ',SEND
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,'quoted percentage of',
+ ' correctly predicted residues. However, since the ',SEND
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,'user is mainly inter',
+ 'ested in the expected performance of the prediction',SEND
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,'for a particular pro',
+ 'tein, the mean value when averaging over protein ',SEND
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,'chains might be of h',
+ 'elp as well. Computing first the three state ',SEND
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,'accuracy for each pr',
+ 'otein chain, and then averaging over 130 chains ',SEND
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,'yields the following',
+ ' average:',SEND
CALL WRTE(K)
WRITE(K,'(A3,T15,A,T78,A3)')SBEG,
+ '+-------------------------------====--+',SEND
WRITE(K,'(A3,T15,A,T78,A3)')SBEG,
+ '| Qtotal/averaged over chains = 71.0% |',SEND
WRITE(K,'(A3,T15,A,T78,A3)')SBEG,
+ '+-------------------------------====--+',SEND
WRITE(K,'(A3,T15,A,T78,A3)')SBEG,
+ '| standard deviation = 9.3% |',SEND
WRITE(K,'(A3,T15,A,T78,A3)')SBEG,
+ '+-------------------------------------+',SEND
CALL WRTE(K)
CALL WRTE(K)
C---- correlation coefficient
CALL WRTD(K)
CALL WRTE(K)
WRITE(K,'(A3,T6,A,T78,A3)')SBEG,
+ 'Further measures of performance',SEND
WRITE(K,'(A3,T6,A,T78,A3)')SBEG,
+ '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~',SEND
CALL WRTE(K)
CALL WRTE(K)
CALL WRTE(K)
WRITE(K,'(A3,T6,A,T78,A3)')SBEG,
+ 'Matthews correlation coefficient:',SEND
CALL WRTE(K)
CALL WRTE(K)
WRITE(K,'(A3,T15,A,T78,A3)')SBEG,
+ '+---------------------------------------------+',SEND
WRITE(K,'(A3,T15,A,T78,A3)')SBEG,
+ '| Chelix = 0.60, Cstrand = 0.52, Cloop = 0.51 |',
+ SEND
WRITE(K,'(A3,T15,A,T78,A3)')SBEG,
+ '+---------------------------------------------+',SEND
CALL WRTE(K)
CALL WRTE(K)
C---- length distribution
CALL WRTD(K)
CALL WRTE(K)
WRITE(K,'(A3,T6,A,T78,A3)')SBEG,
+ 'Average length of predicted secondary structure segments: ',
+ SEND
CALL WRTE(K)
WRITE(K,'(A3,T15,A,T78,A3)')SBEG,
+ ' +------------+----------+',SEND
WRITE(K,'(A3,T15,A,T78,A3)')SBEG,
+ ' | predicted | observed |',SEND
WRITE(K,'(A3,T15,A,T78,A3)')SBEG,
+ '+-----------+------------+----------+',SEND
WRITE(K,'(A3,T15,A,T78,A3)')SBEG,
+ '| Lhelix = | 9.3 | 9.1 |',SEND
WRITE(K,'(A3,T15,A,T78,A3)')SBEG,
+ '| Lstrand = | 5.0 | 5.1 |',SEND
WRITE(K,'(A3,T15,A,T78,A3)')SBEG,
+ '| Lloop = | 6.0 | 5.8 |',SEND
WRITE(K,'(A3,T15,A,T78,A3)')SBEG,
+ '+-----------+------------+----------+',SEND
CALL WRTE(K)
CALL WRTE(K)
C---- accuracy matrix
CALL WRTD(K)
CALL WRTE(K)
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,'The accuracy matrix ',
+ 'in detail:',SEND
CALL WRTE(K)
WRITE(K,'(A3,T15,A,T78,A3)')SBEG,
+ '+---------------------------------------+',SEND
WRITE(K,'(A3,T15,A,T78,A3)')SBEG,
+ '| number of residues with H, E, L |',SEND
WRITE(K,'(A3,T15,A,T78,A3)')SBEG,
+ '+---------+------+------+------+--------+',SEND
WRITE(K,'(A3,T15,A,T78,A3)')SBEG,
+ '| |net H |net E |net L |sum obs |',SEND
WRITE(K,'(A3,T15,A,T78,A3)')SBEG,
+ '+---------+------+------+------+--------+',SEND
WRITE(K,'(A3,T15,A,T78,A3)')SBEG,
+ '| obs H | 5344 | 582 | 1480 | 7406 |',SEND
WRITE(K,'(A3,T15,A,T78,A3)')SBEG,
+ '| obs E | 482 | 3265 | 1231 | 4978 |',SEND
WRITE(K,'(A3,T15,A,T78,A3)')SBEG,
+ '| obs L | 1445 | 1549 | 7831 | 10825 |',SEND
WRITE(K,'(A3,T15,A,T78,A3)')SBEG,
+ '+---------+------+------+------+--------+',SEND
WRITE(K,'(A3,T15,A,T78,A3)')SBEG,
+ '| sum Net | 7271 | 5396 |10542 | 23209 |',SEND
WRITE(K,'(A3,T15,A,T78,A3)')SBEG,
+ '+---------+------+------+------+--------+',SEND
CALL WRTE(K)
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,'Note: This table is ',
+ 'to be read in the following manner: ',SEND
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,' 5344 of all re',
+ 'sidues predicted to be in helix, were observed to ',SEND
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,' be in helix, 4',
+ '82 however belong to observed strands, 1445 to ',SEND
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,' observed loop ',
+ 'regions. The term "observed" refers to the DSSP ',SEND
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,' assignment of ',
+ 'secondary structure calculated from 3D coordinates ',SEND
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,' of experimenta',
+ 'lly determined structures (Dictionary of Secondary ',SEND
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,' Structure of ',
+ 'Proteins: Kabsch & Sander (1983) Biopolymers, 22, ',SEND
WRITE(K,'(A3,T6,A,T78,A3)')SBEG,' 2577-2637). ',SEND
CALL WRTE(K)
CALL WRTE(K)
C---- reliability
CALL WRTE(K)
CALL WRTF(K)
CALL WRTE(K)
WRITE(K,'(A3,T6,A,T78,A3)')SBEG,
+ 'Position-specific reliability index',SEND
WRITE(K,'(A3,T6,A,T78,A3)')SBEG,
+ '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~',SEND
CALL WRTE(K)
CALL WRTE(K)
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,'The network predicts',
+ ' the three secondary structure types using real ',SEND
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,'numbers from the out',
+ 'put units. The prediction is assigned by choosing ',SEND
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,'the maximal unit ("w',
+ 'inner takes all"). However, the real numbers ',SEND
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,'contain additional i',
+ 'nformation. ',SEND
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,'E.g. the difference ',
+ 'between the maximal and the second largest output ',SEND
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,'unit can be used to ',
+ 'derive a "reliability index". This index is given ',SEND
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,'for each residue alo',
+ 'ng with the prediction. The index is scaled to ',SEND
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,'have values between ',
+ '0 (lowest reliability), and 9 (highest).',SEND
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,'The accuracies (Qtot',
+ ') to be expected for residues with values above a ',SEND
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,'particular value of ',
+ 'the index are given below as well as the fraction ',SEND
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,'of such residues (%r',
+ 'es).:',SEND
CALL WRTE(K)
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,'Note: the data given',
+ ' in the following two tables relates to a test set ',SEND
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,'----- which included',
+ ' four chains of the membrane protein 1prc. The ',SEND
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,' overall accura',
+ 'cy for this set is 70.2% instead of 70.8%. The ',SEND
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,' differences to',
+ ' the set without membrane chains is marginal. ',SEND
CALL WRTE(K)
WRITE(K,'(A3,T6,A7,A,T78,A3)')SBEG,'+------',
+'+-----+-----+-----+-----+-----+-----+-----+-----+-----+-----+',
+ SEND
WRITE(K,'(A3,T6,A7,A,T78,A3)')SBEG,'| index',
+'| 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 |',
+ SEND
WRITE(K,'(A3,T6,A7,A,T78,A3)')SBEG,'| %res ',
+'|100.0| 99.5| 88.6| 76.9| 65.4| 54.0| 42.1| 29.6| 15.5| 3.3|',
+ SEND
WRITE(K,'(A3,T6,A7,A,T78,A3)')SBEG,'+------',
+'+-----+-----+-----+-----+-----+-----+-----+-----+-----+-----+',
+ SEND
WRITE(K,'(A3,T6,A7,A,T78,A3)')SBEG,'| ',
+'| | | | | | | | | | |',
+ SEND
WRITE(K,'(A3,T6,A7,A,T78,A3)')SBEG,'| Qtot ',
+'| 70.2| 70.4| 73.0| 76.0| 78.7| 81.6| 84.6| 87.3| 92.4| 95.5|',
+ SEND
WRITE(K,'(A3,T6,A7,A,T78,A3)')SBEG,'| ',
+'| | | | | | | | | | |',
+ SEND
WRITE(K,'(A3,T6,A7,A,T78,A3)')SBEG,'+------',
+'+-----+-----+-----+-----+-----+-----+-----+-----+-----+-----+',
+ SEND
WRITE(K,'(A3,T6,A7,A,T78,A3)')SBEG,'| H%obs',
+'| 69.0| 69.3| 72.2| 76.0| 79.6| 83.4| 87.2| 91.0| 96.1| 99.2|',
+ SEND
WRITE(K,'(A3,T6,A7,A,T78,A3)')SBEG,'| E%obs',
+'| 63.3| 63.5| 66.4| 69.5| 72.4| 75.9| 78.9| 81.9| 85.5| 79.0|',
+ SEND
WRITE(K,'(A3,T6,A7,A,T78,A3)')SBEG,'| ',
+'| | | | | | | | | | |',
+ SEND
WRITE(K,'(A3,T6,A7,A,T78,A3)')SBEG,'| H%prd',
+'| 72.0| 72.0| 75.1| 78.3| 80.9| 84.0| 87.1| 90.2| 92.9| 94.9|',
+ SEND
WRITE(K,'(A3,T6,A7,A,T78,A3)')SBEG,'| E%prd',
+'| 57.9| 58.5| 61.8| 65.6| 69.1| 73.7| 78.6| 82.6| 89.1| 98.8|',
+ SEND
WRITE(K,'(A3,T6,A7,A,T78,A3)')SBEG,'+------',
+'+-----+-----+-----+-----+-----+-----+-----+-----+-----+-----+',
+ SEND
CALL WRTE(K)
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,'The above table give',
+ 's the cumulative results, e.g. 65.4% of all ',SEND
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,'residues have a reli',
+ 'ability of at least 4. The overall three-state ',SEND
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,'accuracy for this su',
+ 'bset of about two thirds of all residues is 78.5%. ',SEND
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,'For this subset, e.g',
+ '., 79.6% of the observed helices are correctly ',SEND
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,'predicted, and 80.9%',
+ ' of all residues predicted to be in helix are ',SEND
WRITE(K,'(A3,T6,A,T78,A3)')SBEG,'correct. ',SEND
CALL WRTE(K)
CALL WRTD(K)
CALL WRTE(K)
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,'The following table ',
+ 'gives the non-cumulative quantities, i.e. the ',SEND
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,'values per reliabili',
+ 'ty index range. These numbers answer the question:',SEND
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,'how reliable is the ',
+ 'prediction for all residues labeled with the ',SEND
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,'particular index i.',
+ ' ',SEND
CALL WRTE(K)
CALL WRTE(K)
WRITE(K,'(A3,T6,A7,A,T78,A3)')SBEG,'+------',
+'+-----+-----+-----+-----+-----+-----+-----+-----+-----+',
+ SEND
WRITE(K,'(A3,T6,A7,A,T78,A3)')SBEG,'| index',
+'| 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 |',
+ SEND
WRITE(K,'(A3,T6,A7,A,T78,A3)')SBEG,'| %res ',
+'| 10.9| 11.7| 11.5| 11.4| 11.9| 12.4| 14.1| 12.3| 3.2|',
+ SEND
WRITE(K,'(A3,T6,A7,A,T78,A3)')SBEG,'+------',
+'+-----+-----+-----+-----+-----+-----+-----+-----+-----+',
+ SEND
WRITE(K,'(A3,T6,A7,A,T78,A3)')SBEG,'| ',
+'| | | | | | | | | |',
+ SEND
WRITE(K,'(A3,T6,A7,A,T78,A3)')SBEG,'| Qtot ',
+'| 47.0| 51.2| 59.5| 62.3| 70.1| 77.5| 84.0| 91.6| 95.5|',
+ SEND
WRITE(K,'(A3,T6,A7,A,T78,A3)')SBEG,'| ',
+'| | | | | | | | | |',
+ SEND
WRITE(K,'(A3,T6,A7,A,T78,A3)')SBEG,'+------',
+'+-----+-----+-----+-----+-----+-----+-----+-----+-----+',
+ SEND
WRITE(K,'(A3,T6,A7,A,T78,A3)')SBEG,'| H%obs',
+'| 44.3| 44.9| 52.2| 58.4| 67.0| 74.8| 82.3| 94.9| 99.2|',
+ SEND
WRITE(K,'(A3,T6,A7,A,T78,A3)')SBEG,'| E%obs',
+'| 44.1| 48.9| 56.4| 57.9| 66.6| 73.1| 78.6| 86.5| 79.0|',
+ SEND
WRITE(K,'(A3,T6,A7,A,T78,A3)')SBEG,'| ',
+'| | | | | | | | | |',
+ SEND
WRITE(K,'(A3,T6,A7,A,T78,A3)')SBEG,'| H%prd',
+'| 45.3| 50.3| 59.0| 63.0| 69.7| 77.0| 85.2| 92.1| 94.9|',
+ SEND
WRITE(K,'(A3,T6,A7,A,T78,A3)')SBEG,'| E%prd',
+'| 38.2| 42.5| 50.3| 52.0| 60.0| 70.9| 77.1| 87.8| 98.8|',
+ SEND
WRITE(K,'(A3,T6,A7,A,T78,A3)')SBEG,'+------',
+'+-----+-----+-----+-----+-----+-----+-----+-----+-----+',
+ SEND
CALL WRTE(K)
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,'For example, for r',
+ 'esidues with Relindex=5 60% of all predicted beta ',SEND
WRITE(K,'(A3,T6,A,T26,A,T78,A3)')SBEG,'strand residues are ',
+ 'correctly identified. ',SEND
CALL WRTE(K)
CALL WRTF(K)
CALL WRTE(K)
CALL WRTE(K)
END
***** end of WRTPHDHEADER
***** ------------------------------------------------------------------
***** SUB WRTPOEXP
***** ------------------------------------------------------------------
C----
C---- NAME : WRTPOEXP
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
*----------------------------------------------------------------------*
SUBROUTINE WRTPOEXP(KUNIT)
C---- global parameters *
INCLUDE 'phdParameter.f'
C---- local variables
INTEGER KUNIT
CHARACTER*5 SBEG,SEND
CHARACTER*7 INTERPROTNAME
CHARACTER*222 TXT80
LOGICAL LTOPLINE
************************************************************************
* SBRs called: from library: lib-prot.f *
* STABLE_EXPNOINBIN, STABLE_EXPNOINSTATES *
************************************************************************
C---- defaults
SBEG='* '
SEND=' *'
C--------------------------------------------------
C---- read header of HSSP file -----
C--------------------------------------------------
INTERPROTNAME(1:7)=PROTNAME(1)
C---- on printer
CALL WRTF(KUNIT)
CALL WRTE(KUNIT)
WRITE(KUNIT,'(A3,T10,A,T78,A3)')SBEG,
+ 'Performance accuracy of the prediction',SEND
WRITE(KUNIT,'(A3,T10,A,T78,A3)')SBEG,
+ '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~',SEND
CALL WRTE(KUNIT)
CALL WRTE(KUNIT)
C--------------------------------------------------
C---- table for bins
C--------------------------------------------------
TXT80='full protein'
C ======================
CALL STABLE_EXPNOINBIN(KUNIT,1,EXP_NOINBIN,TXT80,1)
C ======================
LTOPLINE=.TRUE.
C ======================
CALL STABLE_EXPSTATES(KUNIT,LTOPLINE,LTOPLINE,INTERPROTNAME,1,
+ EXP_NOINBIN,T2,T3A,T3B,2,
+ EXP_NOIN2ST,EXP_NOIN3ST,3,EXP_NOIN10ST,EXP_CORR,3)
C ======================
CALL WRTE(KUNIT)
CALL WRTE(KUNIT)
END
***** end of WRTPOEXP
***** ------------------------------------------------------------------
***** SUB WRTPOPRED
***** ------------------------------------------------------------------
C----
C---- NAME : WRTPOPRED
C---- ARG :
C---- DES : write prediction accuracy for SEC
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
*----------------------------------------------------------------------*
SUBROUTINE WRTPOPRED(KUNIT)
C---- global parameters *
INCLUDE 'phdParameter.f'
C---- local variables
INTEGER KUNIT,DEVNOM,NSECEL_LOC
CHARACTER*5 SBEG,SEND
CHARACTER*7 INTERPROTNAME
LOGICAL LWRITE,LTABLE_QILS
************************************************************************
* SBRs called: from library: lib-prot.f *
* STABLEPOLENFILE, SEVALINFOFILE *
************************************************************************
C---- defaults
LTABLE_QILS=.TRUE.
DEVNOM=50
SBEG='* '
SEND=' *'
C---- blow up states for TM prediction
IF (MODESECSTRON.EQ.'SECONDARY_HTM') THEN
NSECEL_LOC=3
ELSE
NSECEL_LOC=NSECEL
END IF
C--------------------------------------------------
C---- read header of HSSP file -----
C--------------------------------------------------
INTERPROTNAME(1:7)=PROTNAME(1)
C---- on printer
CALL WRTF(KUNIT)
CALL WRTE(KUNIT)
WRITE(KUNIT,'(A3,T10,A,T78,A3)')SBEG,
+ 'Performance accuracy of the prediction',SEND
WRITE(KUNIT,'(A3,T10,A,T78,A3)')SBEG,
+ '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~',SEND
CALL WRTE(KUNIT)
CALL WRTE(KUNIT)
C---- give only per-residue comparison
IF (LTABLE_QILS .EQV. .FALSE.) THEN
C ====================
CALL STABLEPOLENFILE(KUNIT,NSECEL_LOC,NUMOUTMAX,INTERPROTNAME,
+ MATNUM((NSECEL+1),(NSECEL+1)),TITLE,
+ MATNUM,RMATQOFDSSP,RMATQOFPRED,Q3,SQ,CORR,MATLEN)
C ====================
C------- computing the information (entropy)
LWRITE=.TRUE.
C ==================
CALL SEVALINFOFILE(KUNIT,NSECEL_LOC,NUMOUTMAX,
+ MATNUM,INFO,INFO_INV,LWRITE)
C ==================
C---- give also segment comparison
ELSE
C------- computing the information (entropy)
LWRITE=.FALSE.
C ==================
CALL SEVALINFOFILE(6,NSECEL_LOC,NUMOUTMAX,
+ MATNUM,INFO,INFO_INV,LWRITE)
C ==================
C ================
CALL STABLE_QILS(KUNIT,NSECEL_LOC,NUMOUTMAX,NUMRES,1,
+ INTERPROTNAME,TITLE,2,MATNUM,MATLEN,3,
+ RMATQOFDSSP,RMATQOFPRED,Q3,SQ,CORR,INFO,INFO_INV,4,
+ QSOV,QFOV,DEVNOM,4)
C ================
END IF
CALL WRTE(KUNIT)
CALL WRTE(KUNIT)
END
***** end of WRTPOPRED
***** ------------------------------------------------------------------
***** SUB WRTPRED
***** ------------------------------------------------------------------
C----
C---- NAME : WRTPRED
C---- ARG :
C---- DES : write secondary structure prediction.
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE WRTPRED(KUNIT)
C---- global parameters *
INCLUDE 'phdParameter.f'
C---- local functions
CHARACTER*222 FWRITE_STRING_NUMBERS
INTEGER FILEN_STRING
C---- local variables
INTEGER KUNIT,ITER,ITLINES,MUE1,MUE2,MUE3,MUE4,IHELP,
+ IEND,IBEG,ITSEC,MUE5
CHARACTER*4 CHARMACH1,CHARMACH2
CHARACTER*5 SBEG,SEND
CHARACTER*5 TXT(1:8)
CHARACTER*222 INTERTXT,TXT80(1:30),VERSION,CHFILE,TXT_80
CHARACTER*1 INTEROUTTXT(1:80),INTERDSSPTXT(1:80)
LOGICAL LWRITE_ACC80,LWRT80
************************************************************************
* SBRs called: WRTBOTHHEADER, WRTPREDHEADER, WRTWARN_NOALI, *
* WRTPOPRED *
************************************************************************
C---- br 2003-08-23: bullshit to avoid warning
TXT_80=' '
C---- defaults
LWRT80=.FALSE.
SBEG='* '
SEND=' *'
C--------------------------------------------------
C---- read header of HSSP file -----
C--------------------------------------------------
IEND=FILEN_STRING(FILE_HSSP_NOCHAIN)
CHFILE(1:IEND)=FILE_HSSP_NOCHAIN(1:IEND)
C CALL SFILEOPEN(15,CHFILE(1:IEND),'UNKNOWN',222,' ')
C CALL SFILEOPEN(15,FILE_HSSP_NOCHAIN,'OLD',222,'READONLY')
Cyy OPEN (15,FILE=FILE_HSSP_NOCHAIN,STATUS='OLD',READONLY)
OPEN (15,FILE=FILE_HSSP_NOCHAIN,STATUS='OLD')
DO ITER=1,30
READ(15,'(A80)')TXT80(ITER)
END DO
CLOSE(15)
C---- store begin an end of text to be written
IEND=30
DO ITER=1,30
INTERTXT=TXT80(ITER)
IF (INTERTXT(1:6).EQ.'HEADER') THEN
IBEG=ITER
ELSEIF (INTERTXT(1:6).EQ.'NALIGN') THEN
IEND=ITER
END IF
END DO
C----------------------------------------
C---- enough residues in intervall > 5 ?
C----------------------------------------
IHELP=0
DO MUE1=1,NUMRES
IF (RELIND(MUE1).GE.5) THEN
IHELP=IHELP+1
END IF
END DO
IF ( (IHELP.GT.5).AND.(MODESECSTRON.EQ.'SECONDARY') ) THEN
LWRITE_ACC80=.TRUE.
ELSE
LWRITE_ACC80=.FALSE.
END IF
C--------------------------------------------------
C---- write header into prediction output -----
C--------------------------------------------------
IF (MODESECSTRON.EQ.'SECONDARY') THEN
VERSION=VERSION_SEC
ELSE
VERSION=VERSION_HTM
END IF
C ==================
CALL WRTBOTHHEADER(KUNIT,VERSION,NUMNETJURY,TXT80,IBEG,IEND)
C ==================
C ==================
CALL WRTPREDHEADER(KUNIT,MODESECSTRON,LOUTBINPROB,LWRITE_ACC80)
C ==================
C--------------------------------------------------
C---- write warning if too few sequences in ali ---
C--------------------------------------------------
IF (NUMNALIGN(1).LE.5) THEN
C ===================
CALL WRTWARN_NOALI(KUNIT,MODESECSTRON)
C ===================
END IF
C--------------------------------------------------
C---- now write the prediction for all -----
C--------------------------------------------------
C---- machine readable version of strips?
IF (LMACHINE_READABLE .EQV. .TRUE.) THEN
CHARMACH1='# 1 '
CHARMACH2='# 2 '
ELSE
CHARMACH1=' '
CHARMACH2=' '
END IF
IF (LOUTBINPROB .EQV. .TRUE.) THEN
TXT(1)='prH-|'
TXT(2)='prE-|'
TXT(NSECEL)='prL-|'
IF (NSECEL.EQ.4) THEN
TXT(3)='prT-|'
END IF
END IF
C---- data
WRITE(KUNIT,'(A3,T10,A,T25,A7,T40,A,T50,I5,T78,A3)')SBEG,
+ 'protein:',PROTNAME(1),'length',NUMRES,SEND
CALL WRTE(KUNIT)
WRITE(KUNIT,*)
C---- strings of 80: for easy evaluation upon look
MUE1=0
MUE2=0
MUE3=0
MUE4=0
DO ITLINES=1,(INT(NUMRES/60.)+1)
WRITE(KUNIT,'(A4,T10,A4,T15,A60)')CHARMACH1,' ',
+ FWRITE_STRING_NUMBERS(LWRT80,ITLINES)
IHELP=(ITLINES-1)*60
IEND=MIN(60,(NUMRES-IHELP))
WRITE(KUNIT,'(A4,T10,A5,T15,60A1,A1)')CHARMACH1,'AA |',
+ (RESNAME(MUE1),MUE1=(IHELP+1),(IHELP+IEND)),'|'
C----------------------------------------
C------- observed secondary structure ---
C----------------------------------------
IF (LDSSPREAD .EQV. .TRUE.) THEN
DO MUE4=1,IEND
IF ((RESSECSTR(IHELP+MUE4).EQ.'L').OR.
+ (RESSECSTR(IHELP+MUE4).EQ.'S').OR.
+ (RESSECSTR(IHELP+MUE4).EQ.'T')) THEN
INTERDSSPTXT(MUE4)=' '
ELSE
INTERDSSPTXT(MUE4)=RESSECSTR(IHELP+MUE4)
END IF
END DO
WRITE(KUNIT,'(A4,T10,A5,T15,60A1,A1)')CHARMACH1,'Obs |',
+ (INTERDSSPTXT(MUE4),MUE4=1,IEND),'|'
END IF
C----------------------------------------
C------- prediction -----
C----------------------------------------
IF (LFILTER .EQV. .TRUE.) THEN
DO MUE2=1,IEND
IF (OUTBINCHARFIL(IHELP+MUE2).EQ.'L') THEN
INTEROUTTXT(MUE2)=' '
ELSE
INTEROUTTXT(MUE2)=OUTBINCHARFIL(IHELP+MUE2)
END IF
END DO
WRITE(KUNIT,'(A4,T10,A5,T15,60A1,A1)')CHARMACH1,'PHD |',
+ (INTEROUTTXT(MUE4),MUE4=1,IEND),'|'
ELSE
WRITE(KUNIT,'(A4,T10,A5,T15,60A1,A1)')CHARMACH1,'PHD |',
+ (OUTBINCHAR(MUE2),MUE2=(IHELP+1),(IHELP+IEND)),'|'
END IF
C----------------------------------------
C------- reliability index -----
C----------------------------------------
C------- if because DEC has difficulties with the integer when <60
IF (IEND.EQ.60) THEN
WRITE(KUNIT,'(A4,T10,A5,T15,60I1,A1)')CHARMACH1,'Rel |',
+ (RELIND(MUE3),MUE3=(IHELP+1),(IHELP+IEND)),'|'
ELSE
C---- br 99.01 changed
C TXT_80=' '
C 110 FORMAT(I1)
C DO MUE3=(IHELP+1),(IHELP+IEND)
C WRITE(TXT_80(MUE3:MUE3),110,ERR=19991)RELIND(MUE3)
C END DO
C WRITE(KUNIT,'(A4,T10,A5,T15,A,A1)')CHARMACH1,'Rel |',
C + TXT_80((IHELP+1):(IHELP+IEND)),'|'
C---- br 99.03 changed again, SGI hick-up!!!
WRITE(KUNIT,'(A4,T10,A5,T15,60I1)')CHARMACH1,'Rel |',
+ (RELIND(MUE3),MUE3=(IHELP+1),(IHELP+IEND))
19991 CONTINUE
CCC---------- for DEC
CC IF (LDEC) THEN
CC WRITE(KUNIT,'(A4,T10,A5,T15,60I1)')CHARMACH1,'Rel |',
CC + (RELIND(MUE3),MUE3=(IHELP+1),(IHELP+IEND))
CC ELSE
CCC---------- for others
CC WRITE(KUNIT,'(A4,T10,A5,T15,60I1,A1)')CHARMACH1,'Rel |',
CC + (RELIND(MUE3),MUE3=(IHELP+1),(IHELP+IEND)),'|'
CC END IF
END IF
C----------------------------------------
C------- probabilities -----
C----------------------------------------
IF (LOUTBINPROB .EQV. .TRUE.) THEN
WRITE(KUNIT,'(T2,A)')'detail:'
DO ITSEC=1,NSECEL
WRITE(KUNIT,'(A4,T10,A5,T15,60I1)')CHARMACH2,TXT(ITSEC),
+ (OUTBINPROB(ITSEC,MUE5),MUE5=(IHELP+1),(IHELP+IEND))
END DO
END IF
C--------------------------------------------------
C---- now write the prediction for 81.9% -----
C--------------------------------------------------
IF (LWRITE_ACC80 .EQV. .TRUE.) THEN
DO MUE3=1,IEND
IF (RELIND(IHELP+MUE3).GE.5 .AND.
+ (MUE3.GT.0)) THEN
IF ((OUTBINCHAR(IHELP+MUE3).EQ.'H').OR.
+ (OUTBINCHAR(IHELP+MUE3).EQ.'E')) THEN
INTEROUTTXT(MUE3)=OUTBINCHAR(IHELP+MUE3)
ELSE
INTEROUTTXT(MUE3)='L'
END IF
ELSE
INTEROUTTXT(MUE3)='.'
END IF
END DO
WRITE(KUNIT,'(T2,A,T10,A5,T15,60A1,A1)')'subset:',
+ 'SUB |',(INTEROUTTXT(MUE2),MUE2=1,IEND),'|'
END IF
WRITE(KUNIT,*)
WRITE(KUNIT,*)
END DO
C--------------------------------------------------
C---- compute accuracy if DSSP available -----
C--------------------------------------------------
IF (LDSSPREAD .EQV. .TRUE.) THEN
C ==============
CALL WRTPOPRED(KUNIT)
C ==============
END IF
END
***** end of WRTPRED
***** ------------------------------------------------------------------
***** SUB WRTPREDHEADER
***** ------------------------------------------------------------------
C----
C---- NAME : WRTPREDHEADER
C---- ARG :
C---- DES : write secondary structure prediction header
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
*----------------------------------------------------------------------*
SUBROUTINE WRTPREDHEADER(KUNIT,MODE,LOUTBINPROB,LWRITE_ACC80)
C---- local variables
INTEGER KUNIT
CHARACTER*5 SBEG,SEND
CHARACTER*222 MODE
LOGICAL LOUTBINPROB,LWRITE_ACC80
************************************************************************
C---- defaults
SBEG='* '
SEND=' *'
C--------------------------------------------------
C---- abbreviations used
C--------------------------------------------------
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,' Abbreviations:',SEND
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,' --------------',SEND
CALL WRTE(KUNIT)
IF (MODE.EQ.'SECONDARY') THEN
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,
+ ' secondary structure : H=helix, E=extended (sheet), blank=re'//
+ 'st (loop)',SEND
ELSE
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,
+ ' secondary structure : H=helical trans-membrane regions, L='//
+ 'rest (loop)',SEND
END IF
CALL WRTE(KUNIT)
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,
+ ' AA: amino acid sequence',SEND
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,
+ ' PHD: Profile network prediction HeiDelberg',
+ SEND
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,
+ ' Rel: Reliability index of prediction (0-9)',
+ SEND
CALL WRTE(KUNIT)
IF (LOUTBINPROB .EQV. .TRUE.) THEN
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,
+ ' detail: ',SEND
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,
+ ' prH: ''probability'' for assigning helix',SEND
IF (MODE.EQ.'SECONDARY') THEN
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,
+ ' prE: ''probability'' for assigning strand',
+ SEND
END IF
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,
+ ' prL: ''probability'' for assigning loop',SEND
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,
+ ' note: the ''probabilites'' are scaled to the'//
+ ' interval 0-9, ',SEND
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,
+ ' i.e. prH=5 means, that the signal at'//
+ ' the first',SEND
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,
+ ' output node is 0.5-0.6.',SEND
CALL WRTE(KUNIT)
END IF
IF (LWRITE_ACC80 .EQV. .TRUE.) THEN
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,
+ ' subset:',SEND
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,
+ ' SUB: a subset of the prediction, for all '//
+ 'residues with',SEND
IF (MODE.EQ.'SECONDARY') THEN
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,
+ ' an expected accuracy > 82% (see '//
+ ' tables in header)',SEND
ELSE
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,
+ ' an expected accuracy > 95% (see '//
+ ' tables in header)',SEND
END IF
IF (MODE.EQ.'SECONDARY') THEN
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,
+ ' note: for this subset the following '//
+ 'symbols are used:',SEND
ELSE
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,
+ ' note 1: for this subset the following '//
+ 'symbols are used:',SEND
END IF
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,
+ ' L: is loop (for which above " " is used)',
+ SEND
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,
+ ' ".": means that no prediction is made '//
+ 'for this residue,',SEND
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,
+ ' as the reliability is Rel < 5',SEND
IF (MODE(1:13).EQ.'SECONDARY_HTM') THEN
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,
+ ' note 2: the subset may contain continuous'//
+ ' helical segments,',SEND
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,
+ ' where the row ''PHD'' has loop'//
+ ' loop regions. The',SEND
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,
+ ' reason is that the prediction had'//
+ ' been filtered. ',SEND
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,
+ ' In the row ''SUB'' the non-filtered'//
+ ' prediction is',SEND
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,
+ ' given to indicate that the loop'//
+ ' is probably very',SEND
WRITE(KUNIT,'(A3,A,T78,A3)')SBEG,
+ ' short!',SEND
END IF
CALL WRTE(KUNIT)
END IF
CALL WRTF(KUNIT)
END
***** end of WRTPREDHEADER
***** ------------------------------------------------------------------
***** SUB WRTWARN_NOALI
***** ------------------------------------------------------------------
C----
C---- NAME : WRTWARN_NOALI
C---- ARG :
C---- DES : write warning: no ali existing!
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
*----------------------------------------------------------------------*
SUBROUTINE WRTWARN_NOALI(KUNIT,MODE)
C---- global parameters *
INCLUDE 'phdParameter.f'
C---- local variables
INTEGER KUNIT
CHARACTER*5 SBEG,SEND
CHARACTER*222 MODE
************************************************************************
C---- defaults
SBEG='* '
SEND=' *'
C--------------------------------------------------
C---- write warning if too few sequences in ali ---
C--------------------------------------------------
WRITE(KUNIT,'(A3,T5,A,T78,A3)')SBEG,'WARNING:',SEND
WRITE(KUNIT,'(A3,T5,A,T78,A3)')SBEG,'========',SEND
CALL WRTE(KUNIT)
IF (MODE(1:13).EQ.'SECONDARY_HTM') THEN
WRITE(KUNIT,'(A3,T5,A,T78,A3)')SBEG,
+ 'Expected accuracy is about 94% if, and only if, '//
+ 'the alignment contains',SEND
ELSEIF (MODE(1:9).EQ.'SECONDARY') THEN
WRITE(KUNIT,'(A3,T5,A,T78,A3)')SBEG,
+ 'Expected accuracy is about 72% if, and only if, '//
+ 'the alignment contains',SEND
ELSEIF (MODE(1:8).EQ.'EXPOSURE') THEN
WRITE(KUNIT,'(A3,T5,A,T78,A3)')SBEG,
+ 'Expected correlation is about 0.55 if, and only if, '//
+ 'alignment contains',SEND
END IF
IF (NUMNALIGN(1).EQ.1) THEN
WRITE(KUNIT,'(A3,T5,A,T78,A3)')SBEG,
+ 'sufficient information. For your sequence there '//
+ 'was no homologue in',SEND
WRITE(KUNIT,'(A3,T5,A,T78,A3)')SBEG,
+ 'the current version of Swissprot detected. This '//
+ 'implies that the',SEND
IF (MODE.EQ.'SECONDARY') THEN
WRITE(KUNIT,'(A3,T5,A,T78,A3)')SBEG,
+ 'expected accuracy is about 6-10 percentage'//
+ ' points lower !',SEND
ELSEIF (MODE.EQ.'SECONDARY_HTM') THEN
WRITE(KUNIT,'(A3,T5,A,T78,A3)')SBEG,
+ 'expected accuracy is about 2-5 percentage'//
+ ' points lower !',SEND
ELSEIF (MODE.EQ.'EXPOSURE') THEN
WRITE(KUNIT,'(A3,T5,A,T78,A3)')SBEG,
+ 'expected correlation is about 0.1 lower!',SEND
END IF
ELSE
WRITE(KUNIT,'(A3,T5,A,T78,A3)')SBEG,
+ 'sufficient information. For your sequence there '//
+ 'were not many',SEND
WRITE(KUNIT,'(A3,T5,A,T78,A3)')SBEG,
+ 'homologues in the current version of Swissprot '//
+ 'detected. This ',SEND
WRITE(KUNIT,'(A3,T5,A,T78,A3)')SBEG,
+ 'implies that the expected accuracy is some '//
+ 'percentage points lower !',SEND
END IF
CALL WRTE(KUNIT)
CALL WRTF(KUNIT)
CALL WRTE(KUNIT)
END
***** end of WRTWARN_NOALI
C vim:et:ts=2:
profnet-1.0.22/src-phd/phdParameter.f 0000644 0150751 0150751 00000051546 12021362705 016703 0 ustar lkajan lkajan *----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 0.2 *
*----------------------------------------------------------------------*
************************************************************************
* This file contains the maximal parameters for executing multiple *
* runs of secstron. The specific parameter and variables for a *
* particular run are written in parsecstron resp parcollsec. *
************************************************************************
IMPLICIT NONE
* **** *
**** * ***PARAMETERS*** * ***
* ********** *
* * *
************************************************************************
C--------------------------------------------------
C---- numbers -----
C--------------------------------------------------
C---- -----
C---- -----
C---- -----
C---- architecture of network -----
C---- -----
INTEGER NUMINMAX,NUMOUTMAX,NUMHIDMAX,
+ NUMNEIGHMAX,NBIOLOBJMAX,NCODEUNTMAX,NHISTOMAX
C---- -----
C---- units (global) -----
C---- -----
INTEGER NUNITS_LENGTH,NUNITS_DISTCAPS
C---- -----
C---- reading databank -----
C---- -----
INTEGER NUMPROTMAX,NUMRESMAX
C---- -----
C---- jury decision -----
C---- -----
INTEGER NUMNETMAX,NUMNETFSTMAX,NUMNETSNDMAX
* *
C---- -----
C---- data handling -----
C---- -----
REAL ABW
* *
LOGICAL LDSSP
C---- protein (read hssp)
INTEGER MAXALIGNS,MAXCORE
* *
* *
C---- =================================================================*
* *
C---- ----------------------------------------
PARAMETER (NUMINMAX= 850)
PARAMETER (NUMOUTMAX= 10)
PARAMETER (NUMHIDMAX= 60)
PARAMETER (NUMNEIGHMAX= 21)
PARAMETER (NBIOLOBJMAX= 21)
PARAMETER (NCODEUNTMAX= 63)
PARAMETER (NHISTOMAX= 50)
C---- -------------------------------
* *
C---- ------------------------------------
PARAMETER (NUNITS_LENGTH= 4)
PARAMETER (NUNITS_DISTCAPS= 4)
C---- ------------------------------------
* *
C---- ---------------------------------------
PARAMETER (NUMPROTMAX= 2)
C MAC core-dump for > 4200!
C br 2003-08-23 fixed problem with core dump
C PARAMETER (NUMRESMAX= 4200)
C exe normal
C PARAMETER (NUMRESMAX= 5000)
C exe big
PARAMETER (NUMRESMAX= 9999)
C PARAMETER (NUMRESMAX= 10000)
C---- ---------------------------------------
* *
C---- ---------------------------------------
C for maxhom
C
PARAMETER (MAXALIGNS= 5000)
C br 2003-08-23: no longer relevant
PARAMETER (MAXCORE= 50000)
C PARAMETER (MAXCORE= 1000000)
C PARAMETER (MAXCORE= 3000000)
INTEGER NBLOCKSIZE
PARAMETER (NBLOCKSIZE= 70)
INTEGER MAXAA
PARAMETER (MAXAA= 20)
C---- ---------------------------------------
* *
C---- ---------------------------------------
PARAMETER (NUMNETMAX= 30)
PARAMETER (NUMNETFSTMAX= 15)
PARAMETER (NUMNETSNDMAX= 15)
C---- ---------------------------------------
* *
C---- ---------------------------------------
PARAMETER (ABW= 0.00001)
C---- ---------------------------------------
* *
* *
C---- ---------------------------------------
PARAMETER (LDSSP=.FALSE.)
C---- ---------------------------------------
* *
* *
C---- =================================================================*
************************************************************************
* * *
**** * ***VARIABLES*** * ***
* ********* *
* * *
* *
************************************************************************
C--------------------------------------------------
C---- shared numbers -----
C--------------------------------------------------
C---- -----
C---- environment (path asf) -----
C---- -----
CHARACTER*222 PATH_PARACOM,PATH_ARCH,PATH_WORK,PATH_PRED
INTEGER LENPATH_PARACOM
* *
* *
C---- -----
C---- hssp related variables -----
C---- -----
CHARACTER*222 FILE_HSSP,FILE_HSSP_NOCHAIN
CHARACTER*132 PROTNAME(1:NUMPROTMAX)
* *
CHARACTER*1 RESNAME(1:NUMRESMAX),
+ RESSECSTR(1:NUMRESMAX),CONVSECSTR(1:NUMRESMAX),
+ AACODE(1:NBIOLOBJMAX),SSCODE(1:7),EXPCODE(1:10)
CHARACTER*24 AACODE24
CHARACTER*26 AACODE_LOWC
* *
C br 2003-08-23: save space
C INTEGER RESVAR(1:NUMRESMAX)
INTEGER RESVAR(1:1)
C br 2003-08-23: end save space
INTEGER RESACC(1:NUMRESMAX),
+ RESPROF(1:NUMRESMAX,1:NBIOLOBJMAX),
+ RESNDEL(1:NUMRESMAX),RESNINS(1:NUMRESMAX),
+ NUMNALIGN(1:NUMPROTMAX)
* *
REAL*4 RESCONSWEIGHT(1:NUMRESMAX)
* *
INTEGER POINTBEG(1:NUMPROTMAX),POINTEND(0:NUMPROTMAX),
+ NUMRES,AABIT(1:NBIOLOBJMAX,1:NCODEUNTMAX)
* *
LOGICAL LDSSPREAD
* *
COMMON /ENV1/PATH_PARACOM,PATH_ARCH,PATH_WORK,PATH_PRED
COMMON /ENV2/LENPATH_PARACOM
COMMON /DATAB1A/PROTNAME
COMMON /DATAB1B/FILE_HSSP,FILE_HSSP_NOCHAIN
COMMON /DATAB2/RESNAME,RESSECSTR,CONVSECSTR,AACODE,SSCODE,EXPCODE
COMMON /DATAB2b/AACODE24
COMMON /DATAB2c/AACODE_LOWC
COMMON /DATAB3/RESACC,RESVAR,RESPROF,RESNDEL,RESNINS,NUMNALIGN,
+ POINTBEG,POINTEND,NUMRES,AABIT
COMMON /DATAB4/RESCONSWEIGHT
COMMON /DATAB5/LDSSPREAD
* *
* *
C---- -----
C---- Exposure related variables -----
C---- -----
INTEGER MAXEXP,T2,T3A,T3B
* *
REAL THREXP2ST(1:3),THREXP3ST(1:4),THREXP10ST(1:10)
INTEGER THREXP2STI(1:3),THREXP3STI(1:4),THREXP10STI(1:10)
* *
COMMON /EXP1/MAXEXP,T2,T3A,T3B
COMMON /EXP2/THREXP2ST,THREXP3ST,THREXP10ST
COMMON /EXP3/THREXP2STI,THREXP3STI,THREXP10STI
* *
C---- -----
C---- architecture -----
C---- -----
* *
INTEGER NUMIN,NUMHID,NUMOUT,NUMNEIGH,NBIOLOBJ,NCODEUNT,
+ NUMNETFST,NUMNETSND,NUMNETJURY,MAXVAR,
+ MAXACC,PROFACC,CASCACC,NSECEL
INTEGER TRANS2FROM1(1:NUMNETSNDMAX)
* *
COMMON /COMPARA1/NUMIN,NUMHID,NUMOUT,NUMNEIGH,NBIOLOBJ,NCODEUNT,
+ NUMNETFST,NUMNETSND,NUMNETJURY,MAXVAR,
+ MAXACC,PROFACC,CASCACC,NSECEL
COMMON /COMPARA2/TRANS2FROM1
* *
C--------------------------------------------------
C---- characters/modes being shared -----
C--------------------------------------------------
C---- -----
C---- different modes -----
C---- -----
* *
CHARACTER*222 MODEASSSTR(1:NUMNETSNDMAX),
+ MODEASSCAS(1:NUMNETFSTMAX),MODESECSTRON
* *
CHARACTER*222 FILEPRED,FILEOUTPUT,ACTFILE,
+ FILEARCHFST(1:NUMNETFSTMAX),FILEARCHSND(1:NUMNETSNDMAX),
+ FILE_ARCHLIST,FILE_RDB,FILE_WHATIF,
+ CHAR_ARG_READ(1:222)
* *
COMMON /COMPARA3/MODEASSSTR,MODEASSCAS,MODESECSTRON
COMMON /COMPARA4/FILEPRED,FILEOUTPUT,ACTFILE,
+ FILEARCHFST,FILEARCHSND,FILE_ARCHLIST,FILE_RDB,FILE_WHATIF,
+ CHAR_ARG_READ
C--------------------------------------------------
C---- previous parameters for particular job -----
C---- note: assigned by parset.f -----
C--------------------------------------------------
* *
C---- -----
C---- junctions, biases -----
C---- -----
* *
REAL JUNCTION1ST(1:(NUMINMAX+NUMOUTMAX),1:NUMHIDMAX)
REAL LOCFIELD1(1:NUMHIDMAX)
REAL JUNCTION2ND(1:(NUMHIDMAX+NUMOUTMAX),1:NUMOUTMAX)
REAL LOCFIELD2(1:NUMOUTMAX)
* *
COMMON /TRIGGER3/JUNCTION1ST,JUNCTION2ND
COMMON /TRIGGER4/LOCFIELD1,LOCFIELD2
* *
C---- -----
C---- in/out vectors -----
C---- -----
* *
REAL*4 INPUT(1:(NUMINMAX+NUMOUTMAX),1:NUMRESMAX)
REAL*4 OUTPUT(1:NUMOUTMAX,1:NUMRESMAX),
+ OUTFIL(1:NUMOUTMAX,1:NUMRESMAX),
+ OUTFST(1:NUMOUTMAX,1:NUMRESMAX,1:NUMNETFSTMAX),
+ OUTSND(1:NUMOUTMAX,1:NUMRESMAX,1:NUMNETSNDMAX)
REAL*4 OUTEXP(1:NUMRESMAX),DESEXP(1:NUMRESMAX),
+ OUTEXPFIL(1:NUMRESMAX)
INTEGER*4 OUTBIN(1:NUMOUTMAX,1:NUMRESMAX),
+ OUTBINPROB(1:NUMOUTMAX,1:NUMRESMAX)
* *
CHARACTER*1 OUTBINCHAR(1:NUMRESMAX),OUTBINCHARFIL(1:NUMRESMAX)
* *
* *
COMMON /EXTERN1/INPUT,OUTPUT,OUTFST,OUTSND,OUTEXP,DESEXP,
+ OUTFIL,OUTEXPFIL
COMMON /EXTERN2/OUTBIN,OUTBINPROB
COMMON /EXTERN3/OUTBINCHAR,OUTBINCHARFIL
* *
C---- -----
C---- reliability index -----
C---- -----
* *
INTEGER NUMRELIND(0:9)
INTEGER*2 RELIND(1:NUMRESMAX)
INTEGER*2 DSSPVEC_I2(1:NUMRESMAX),PREDVEC_I2(1:NUMRESMAX)
* *
COMMON /EXTERN4a/NUMRELIND
COMMON /EXTERN4b/RELIND,DSSPVEC_I2,PREDVEC_I2
* *
* *
C---- -----
C---- filtering stuff (exposure) -----
C---- -----
* *
REAL REDUCE_MINSIZE,REDUCE_STATE0,REDUCE_STATE1
LOGICAL LREDUCE_BURRIED
* *
COMMON /FILTER1/REDUCE_MINSIZE,REDUCE_STATE0,REDUCE_STATE1
COMMON /FILTER2/LREDUCE_BURRIED
* *
C---- -----
C---- run time variables -----
C---- -----
* *
CHARACTER*24 STARTDATE,ENDDATE,XDTE
CHARACTER*8 STARTTIME,ENDTIME
* *
REAL TIMEDIFF,TIMEARRAY,TIMESTART,TIMERUN,TIMEEND
* *
COMMON /CLOCK1/STARTDATE,ENDDATE,XDTE,STARTTIME,ENDTIME
COMMON /CLOCK2/TIMEARRAY,TIMEDIFF,TIMESTART,TIMERUN,TIMEEND
* *
* *
C---- -----
C---- pay-off numbers -----
C---- -----
* *
INTEGER MATNUM(1:(NUMOUTMAX+1),1:(NUMOUTMAX+1)),
+ MATLEN(1:(NUMOUTMAX+1),1:4),
+ MATLENDIS(1:NHISTOMAX,1:(2*NUMOUTMAX)),
+ NUMSEGOVERL(1:9,1:(NUMOUTMAX+1)),
+ COUNTSEGMAT(1:2,1:(NUMOUTMAX+1)),
+ EXP_NOINBIN(0:9,0:9),
+ EXP_NOIN2ST(1:3),EXP_NOIN3ST(1:4),EXP_NOIN10ST(1:11),
+ OBS_NOIN2ST(1:3),OBS_NOIN3ST(1:4),OBS_NOIN10ST(1:11)
* *
REAL Q3,SQ,CORR(1:NUMOUTMAX),INFO,INFO_INV,
+ RMATQOFDSSP(1:NUMOUTMAX,1:NUMOUTMAX),
+ RMATQOFPRED(1:NUMOUTMAX,1:NUMOUTMAX),
+ QLOV(1:2,1:(NUMOUTMAX+1)),
+ QSOV(1:2,1:(NUMOUTMAX+1)),QFOV(1:2,1:(NUMOUTMAX+1)),
+ EXP_CORR
* *
* *
CHARACTER*132 TITLE,VERSION_SEC,VERSION_EXP,VERSION_HTM
* *
COMMON /PAYOFF1/MATNUM,MATLEN,MATLENDIS,NUMSEGOVERL,COUNTSEGMAT,
+ EXP_NOINBIN,EXP_NOIN2ST,EXP_NOIN3ST,EXP_NOIN10ST,
+ OBS_NOIN2ST,OBS_NOIN3ST,OBS_NOIN10ST
COMMON /PAYOFF2/Q3,SQ,CORR,RMATQOFDSSP,RMATQOFPRED,INFO,INFO_INV,
+ QLOV,QSOV,QFOV,EXP_CORR
COMMON /PAYOFF3/TITLE,VERSION_SEC,VERSION_EXP,VERSION_HTM
* *
* *
C---- -----
C---- content, asf. -----
C---- -----
* *
REAL CONTPRED(1:NUMOUTMAX),CONTDSSP(1:NUMOUTMAX),CONTAA(1:24)
* *
COMMON /CONT/CONTPRED,CONTDSSP,CONTAA
* *
C---- -----
C---- communication -----
C---- -----
* *
CHARACTER*1 ACTRESIDUE
CHARACTER*15 CASEDISCR,CONTROLCHAR
CHARACTER*25 ACTREGION
* *
INTEGER ACTPOS,ACTSOLVADDBEG,ACTSOLVADDEND,
+ ACTSOLVADDEND2,CODEVECPROF(1:NBIOLOBJMAX),PROFMAX,
+ CODEVECINCASC(1:(NUMOUTMAX+1)),
+ CODECOMPOSITION(1:NBIOLOBJMAX),
+ ACTCOMPOSITION(1:NBIOLOBJMAX),
+ ACTCHI,ACTITER,ACTSTART,ACTNDEL,ACTNINS,ACTNALIGN,ACTACC
* *
INTEGER BEGUNITS_COMPOSITION,
+ BEGUNITS_LENGTH,BEGUNITS_DISTCAPS,
+ SPLIT_LENGTH(1:NUNITS_LENGTH),
+ SPLIT_DISTCAPS(1:(NUNITS_LENGTH+1))
* *
REAL CODEVECTOR(1:NCODEUNTMAX),PROFINTERV,CASCINTERV,
+ ACTCONSWEIGHT,ACTINTERVALL
* *
LOGICAL LOGI_COMPOSITION,LOGI_LENGTH,LOGI_DISTCAPS,
+ LOGI_CONS,LOGI_INDEL,LOGI_REALINPUT
* *
COMMON /CODE1A/ACTRESIDUE
COMMON /CODE1B/CASEDISCR,CONTROLCHAR
COMMON /CODE1C/ACTREGION
COMMON /CODE3/ACTPOS,ACTSOLVADDBEG,ACTSOLVADDEND,ACTSOLVADDEND2,
+ CODEVECPROF,PROFMAX,CODEVECINCASC,
+ CODECOMPOSITION,ACTCOMPOSITION,
+ ACTCHI,ACTITER,ACTSTART,ACTNDEL,ACTNINS,ACTNALIGN,ACTACC
COMMON /CODE4/CODEVECTOR,PROFINTERV,CASCINTERV,ACTCONSWEIGHT,
+ ACTINTERVALL
COMMON /CODE5/BEGUNITS_COMPOSITION,
+ BEGUNITS_LENGTH,BEGUNITS_DISTCAPS,
+ SPLIT_LENGTH,SPLIT_DISTCAPS
COMMON /CODE6/LOGI_COMPOSITION,LOGI_LENGTH,LOGI_DISTCAPS,
+ LOGI_CONS,LOGI_INDEL,LOGI_REALINPUT
* *
C---- -----
C---- controls -----
C---- -----
* *
LOGICAL LSERVER,LFILTER,LDEC,LOUTBINPROB,
+ LMACHINE_READABLE,LWHATIF,LRDB
* *
COMMON /CONTROL/LSERVER,LFILTER,LDEC,LOUTBINPROB,
+ LMACHINE_READABLE,LWHATIF,LRDB
* *
*----------------------------------------------------------------------*
* Parmaters and Common variables for PHD *
*----------------------------------------------------------------------*
profnet-1.0.22/src-phd/phdParameter.f_mac 0000644 0150751 0150751 00000050654 12021362704 017521 0 ustar lkajan lkajan *----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 0.2 *
*----------------------------------------------------------------------*
************************************************************************
* This file contains the maximal parameters for executing multiple *
* runs of secstron. The specific parameter and variables for a *
* particular run are written in parsecstron resp parcollsec. *
************************************************************************
IMPLICIT NONE
* **** *
**** * ***PARAMETERS*** * ***
* ********** *
* * *
************************************************************************
C--------------------------------------------------
C---- numbers -----
C--------------------------------------------------
C---- -----
C---- -----
C---- -----
C---- architecture of network -----
C---- -----
INTEGER NUMINMAX,NUMOUTMAX,NUMHIDMAX,
+ NUMNEIGHMAX,NBIOLOBJMAX,NCODEUNTMAX,NHISTOMAX
C---- -----
C---- units (global) -----
C---- -----
INTEGER NUNITS_LENGTH,NUNITS_DISTCAPS
C---- -----
C---- reading databank -----
C---- -----
INTEGER NUMPROTMAX,NUMRESMAX
C---- -----
C---- jury decision -----
C---- -----
INTEGER NUMNETMAX,NUMNETFSTMAX,NUMNETSNDMAX
* *
C---- -----
C---- data handling -----
C---- -----
REAL ABW
* *
LOGICAL LDSSP
C---- protein (read hssp)
INTEGER MAXALIGNS,MAXCORE
* *
* *
C---- =================================================================*
* *
C---- ----------------------------------------
PARAMETER (NUMINMAX= 850)
PARAMETER (NUMOUTMAX= 10)
PARAMETER (NUMHIDMAX= 60)
PARAMETER (NUMNEIGHMAX= 21)
PARAMETER (NBIOLOBJMAX= 21)
PARAMETER (NCODEUNTMAX= 63)
PARAMETER (NHISTOMAX= 50)
C---- -------------------------------
* *
C---- ------------------------------------
PARAMETER (NUNITS_LENGTH= 4)
PARAMETER (NUNITS_DISTCAPS= 4)
C---- ------------------------------------
* *
C---- ---------------------------------------
PARAMETER (NUMPROTMAX= 2)
PARAMETER (NUMRESMAX= 3000)
C PARAMETER (NUMRESMAX= 5000)
C PARAMETER (NUMRESMAX= 10000)
C---- ---------------------------------------
* *
C---- ---------------------------------------
C for maxhom
C
PARAMETER (MAXALIGNS= 3000)
C PARAMETER (MAXALIGNS= 5000)
PARAMETER (MAXCORE= 500000)
C PARAMETER (MAXCORE= 800000)
C PARAMETER (MAXCORE= 1000000)
INTEGER NBLOCKSIZE
PARAMETER (NBLOCKSIZE= 70)
INTEGER MAXAA
PARAMETER (MAXAA= 20)
C---- ---------------------------------------
* *
C---- ---------------------------------------
PARAMETER (NUMNETMAX= 30)
PARAMETER (NUMNETFSTMAX= 15)
PARAMETER (NUMNETSNDMAX= 15)
C---- ---------------------------------------
* *
C---- ---------------------------------------
PARAMETER (ABW= 0.00001)
C---- ---------------------------------------
* *
* *
C---- ---------------------------------------
PARAMETER (LDSSP=.FALSE.)
C---- ---------------------------------------
* *
* *
C---- =================================================================*
************************************************************************
* * *
**** * ***VARIABLES*** * ***
* ********* *
* * *
* *
************************************************************************
C--------------------------------------------------
C---- shared numbers -----
C--------------------------------------------------
C---- -----
C---- environment (path asf) -----
C---- -----
CHARACTER*222 PATH_PARACOM,PATH_ARCH,PATH_WORK,PATH_PRED
INTEGER LENPATH_PARACOM
* *
* *
C---- -----
C---- hssp related variables -----
C---- -----
CHARACTER*222 FILE_HSSP,FILE_HSSP_NOCHAIN
CHARACTER*132 PROTNAME(1:NUMPROTMAX)
* *
CHARACTER*1 RESNAME(1:NUMRESMAX),
+ RESSECSTR(1:NUMRESMAX),CONVSECSTR(1:NUMRESMAX),
+ AACODE(1:NBIOLOBJMAX),SSCODE(1:7),EXPCODE(1:10)
CHARACTER*24 AACODE24
CHARACTER*26 AACODE_LOWC
* *
INTEGER RESACC(1:NUMRESMAX),
+ RESVAR(1:NUMRESMAX),RESPROF(1:NUMRESMAX,1:NBIOLOBJMAX),
+ RESNDEL(1:NUMRESMAX),RESNINS(1:NUMRESMAX),
+ NUMNALIGN(1:NUMPROTMAX)
* *
REAL*4 RESCONSWEIGHT(1:NUMRESMAX)
* *
INTEGER POINTBEG(1:NUMPROTMAX),POINTEND(0:NUMPROTMAX),
+ NUMRES,AABIT(1:NBIOLOBJMAX,1:NCODEUNTMAX)
* *
LOGICAL LDSSPREAD
* *
COMMON /ENV1/PATH_PARACOM,PATH_ARCH,PATH_WORK,PATH_PRED
COMMON /ENV2/LENPATH_PARACOM
COMMON /DATAB1A/PROTNAME
COMMON /DATAB1B/FILE_HSSP,FILE_HSSP_NOCHAIN
COMMON /DATAB2/RESNAME,RESSECSTR,CONVSECSTR,AACODE,SSCODE,EXPCODE
COMMON /DATAB2b/AACODE24
COMMON /DATAB2c/AACODE_LOWC
COMMON /DATAB3/RESACC,RESVAR,RESPROF,RESNDEL,RESNINS,NUMNALIGN,
+ POINTBEG,POINTEND,NUMRES,AABIT
COMMON /DATAB4/RESCONSWEIGHT
COMMON /DATAB5/LDSSPREAD
* *
* *
C---- -----
C---- Exposure related variables -----
C---- -----
INTEGER MAXEXP,T2,T3A,T3B
* *
REAL THREXP2ST(1:3),THREXP3ST(1:4),THREXP10ST(1:10)
* *
COMMON /EXP1/MAXEXP,T2,T3A,T3B
COMMON /EXP2/THREXP2ST,THREXP3ST,THREXP10ST
* *
C---- -----
C---- architecture -----
C---- -----
* *
INTEGER NUMIN,NUMHID,NUMOUT,NUMNEIGH,NBIOLOBJ,NCODEUNT,
+ NUMNETFST,NUMNETSND,NUMNETJURY,MAXVAR,
+ MAXACC,PROFACC,CASCACC,NSECEL
INTEGER TRANS2FROM1(1:NUMNETSNDMAX)
* *
COMMON /COMPARA1/NUMIN,NUMHID,NUMOUT,NUMNEIGH,NBIOLOBJ,NCODEUNT,
+ NUMNETFST,NUMNETSND,NUMNETJURY,MAXVAR,
+ MAXACC,PROFACC,CASCACC,NSECEL
COMMON /COMPARA2/TRANS2FROM1
* *
C--------------------------------------------------
C---- characters/modes being shared -----
C--------------------------------------------------
C---- -----
C---- different modes -----
C---- -----
* *
CHARACTER*132 MODEASSSTR(1:NUMNETSNDMAX),
+ MODEASSCAS(1:NUMNETFSTMAX),MODESECSTRON
* *
CHARACTER*222 FILEPRED,FILEOUTPUT,ACTFILE,
+ FILEARCHFST(1:NUMNETFSTMAX),FILEARCHSND(1:NUMNETSNDMAX),
+ FILE_ARCHLIST,FILE_RDB,FILE_WHATIF,
+ CHAR_ARG_READ(1:222)
* *
COMMON /COMPARA3/MODEASSSTR,MODEASSCAS,MODESECSTRON
COMMON /COMPARA4/FILEPRED,FILEOUTPUT,ACTFILE,
+ FILEARCHFST,FILEARCHSND,FILE_ARCHLIST,FILE_RDB,FILE_WHATIF,
+ CHAR_ARG_READ
C--------------------------------------------------
C---- previous parameters for particular job -----
C---- note: assigned by parset.f -----
C--------------------------------------------------
* *
C---- -----
C---- junctions, biases -----
C---- -----
* *
REAL JUNCTION1ST(1:(NUMINMAX+NUMOUTMAX),1:NUMHIDMAX)
REAL LOCFIELD1(1:NUMHIDMAX)
REAL JUNCTION2ND(1:(NUMHIDMAX+NUMOUTMAX),1:NUMOUTMAX)
REAL LOCFIELD2(1:NUMOUTMAX)
* *
COMMON /TRIGGER3/JUNCTION1ST,JUNCTION2ND
COMMON /TRIGGER4/LOCFIELD1,LOCFIELD2
* *
C---- -----
C---- in/out vectors -----
C---- -----
* *
REAL*4 INPUT(1:(NUMINMAX+NUMOUTMAX),1:NUMRESMAX)
REAL*4 OUTPUT(1:NUMOUTMAX,1:NUMRESMAX),
+ OUTFIL(1:NUMOUTMAX,1:NUMRESMAX),
+ OUTFST(1:NUMOUTMAX,1:NUMRESMAX,1:NUMNETFSTMAX),
+ OUTSND(1:NUMOUTMAX,1:NUMRESMAX,1:NUMNETSNDMAX)
REAL*4 OUTEXP(1:NUMRESMAX),DESEXP(1:NUMRESMAX),
+ OUTEXPFIL(1:NUMRESMAX)
INTEGER*4 OUTBIN(1:NUMOUTMAX,1:NUMRESMAX),
+ OUTBINPROB(1:NUMOUTMAX,1:NUMRESMAX)
* *
CHARACTER*1 OUTBINCHAR(1:NUMRESMAX),OUTBINCHARFIL(1:NUMRESMAX)
* *
* *
COMMON /EXTERN1/INPUT,OUTPUT,OUTFST,OUTSND,OUTEXP,DESEXP,
+ OUTFIL,OUTEXPFIL
COMMON /EXTERN2/OUTBIN,OUTBINPROB
COMMON /EXTERN3/OUTBINCHAR,OUTBINCHARFIL
* *
C---- -----
C---- reliability index -----
C---- -----
* *
INTEGER NUMRELIND(0:9)
INTEGER*2 RELIND(1:NUMRESMAX)
INTEGER*2 DSSPVEC_I2(1:NUMRESMAX),PREDVEC_I2(1:NUMRESMAX)
* *
COMMON /EXTERN4a/NUMRELIND
COMMON /EXTERN4b/RELIND,DSSPVEC_I2,PREDVEC_I2
* *
* *
C---- -----
C---- filtering stuff (exposure) -----
C---- -----
* *
REAL REDUCE_MINSIZE,REDUCE_STATE0,REDUCE_STATE1
LOGICAL LREDUCE_BURRIED
* *
COMMON /FILTER1/REDUCE_MINSIZE,REDUCE_STATE0,REDUCE_STATE1
COMMON /FILTER2/LREDUCE_BURRIED
* *
C---- -----
C---- run time variables -----
C---- -----
* *
CHARACTER*24 STARTDATE,ENDDATE,XDTE
CHARACTER*8 STARTTIME,ENDTIME
* *
REAL TIMEDIFF,TIMEARRAY,TIMESTART,TIMERUN,TIMEEND
* *
COMMON /CLOCK1/STARTDATE,ENDDATE,XDTE,STARTTIME,ENDTIME
COMMON /CLOCK2/TIMEARRAY,TIMEDIFF,TIMESTART,TIMERUN,TIMEEND
* *
* *
C---- -----
C---- pay-off numbers -----
C---- -----
* *
INTEGER MATNUM(1:(NUMOUTMAX+1),1:(NUMOUTMAX+1)),
+ MATLEN(1:(NUMOUTMAX+1),1:4),
+ MATLENDIS(1:NHISTOMAX,1:(2*NUMOUTMAX)),
+ NUMSEGOVERL(1:9,1:(NUMOUTMAX+1)),
+ COUNTSEGMAT(1:2,1:(NUMOUTMAX+1)),
+ EXP_NOINBIN(0:9,0:9),
+ EXP_NOIN2ST(1:3),EXP_NOIN3ST(1:4),EXP_NOIN10ST(1:11),
+ OBS_NOIN2ST(1:3),OBS_NOIN3ST(1:4),OBS_NOIN10ST(1:11)
* *
REAL Q3,SQ,CORR(1:NUMOUTMAX),INFO,INFO_INV,
+ RMATQOFDSSP(1:NUMOUTMAX,1:NUMOUTMAX),
+ RMATQOFPRED(1:NUMOUTMAX,1:NUMOUTMAX),
+ QLOV(1:2,1:(NUMOUTMAX+1)),
+ QSOV(1:2,1:(NUMOUTMAX+1)),QFOV(1:2,1:(NUMOUTMAX+1)),
+ EXP_CORR
* *
* *
CHARACTER*132 TITLE,VERSION_SEC,VERSION_EXP,VERSION_HTM
* *
COMMON /PAYOFF1/MATNUM,MATLEN,MATLENDIS,NUMSEGOVERL,COUNTSEGMAT,
+ EXP_NOINBIN,EXP_NOIN2ST,EXP_NOIN3ST,EXP_NOIN10ST,
+ OBS_NOIN2ST,OBS_NOIN3ST,OBS_NOIN10ST
COMMON /PAYOFF2/Q3,SQ,CORR,RMATQOFDSSP,RMATQOFPRED,INFO,INFO_INV,
+ QLOV,QSOV,QFOV,EXP_CORR
COMMON /PAYOFF3/TITLE,VERSION_SEC,VERSION_EXP,VERSION_HTM
* *
* *
C---- -----
C---- content, asf. -----
C---- -----
* *
REAL CONTPRED(1:NUMOUTMAX),CONTDSSP(1:NUMOUTMAX),CONTAA(1:24)
* *
COMMON /CONT/CONTPRED,CONTDSSP,CONTAA
* *
C---- -----
C---- communication -----
C---- -----
* *
CHARACTER*1 ACTRESIDUE
CHARACTER*15 CASEDISCR,CONTROLCHAR
CHARACTER*25 ACTREGION
* *
INTEGER ACTPOS,ACTSOLVADDBEG,ACTSOLVADDEND,
+ ACTSOLVADDEND2,CODEVECPROF(1:NBIOLOBJMAX),PROFMAX,
+ CODEVECINCASC(1:(NUMOUTMAX+1)),
+ CODECOMPOSITION(1:NBIOLOBJMAX),
+ ACTCOMPOSITION(1:NBIOLOBJMAX),
+ ACTCHI,ACTITER,ACTSTART,ACTNDEL,ACTNINS,ACTNALIGN,ACTACC
* *
INTEGER BEGUNITS_COMPOSITION,
+ BEGUNITS_LENGTH,BEGUNITS_DISTCAPS,
+ SPLIT_LENGTH(1:NUNITS_LENGTH),
+ SPLIT_DISTCAPS(1:(NUNITS_LENGTH+1))
* *
REAL CODEVECTOR(1:NCODEUNTMAX),PROFINTERV,CASCINTERV,
+ ACTCONSWEIGHT,ACTINTERVALL
* *
LOGICAL LOGI_COMPOSITION,LOGI_LENGTH,LOGI_DISTCAPS,
+ LOGI_CONS,LOGI_INDEL,LOGI_REALINPUT
* *
COMMON /CODE1A/ACTRESIDUE
COMMON /CODE1B/CASEDISCR,CONTROLCHAR
COMMON /CODE1C/ACTREGION
COMMON /CODE3/ACTPOS,ACTSOLVADDBEG,ACTSOLVADDEND,ACTSOLVADDEND2,
+ CODEVECPROF,PROFMAX,CODEVECINCASC,
+ CODECOMPOSITION,ACTCOMPOSITION,
+ ACTCHI,ACTITER,ACTSTART,ACTNDEL,ACTNINS,ACTNALIGN,ACTACC
COMMON /CODE4/CODEVECTOR,PROFINTERV,CASCINTERV,ACTCONSWEIGHT,
+ ACTINTERVALL
COMMON /CODE5/BEGUNITS_COMPOSITION,
+ BEGUNITS_LENGTH,BEGUNITS_DISTCAPS,
+ SPLIT_LENGTH,SPLIT_DISTCAPS
COMMON /CODE6/LOGI_COMPOSITION,LOGI_LENGTH,LOGI_DISTCAPS,
+ LOGI_CONS,LOGI_INDEL,LOGI_REALINPUT
* *
C---- -----
C---- controls -----
C---- -----
* *
LOGICAL LSERVER,LFILTER,LDEC,LOUTBINPROB,
+ LMACHINE_READABLE,LWHATIF,LRDB
* *
COMMON /CONTROL/LSERVER,LFILTER,LDEC,LOUTBINPROB,
+ LMACHINE_READABLE,LWHATIF,LRDB
* *
*----------------------------------------------------------------------*
* Parmaters and Common variables for PHD *
*----------------------------------------------------------------------*
profnet-1.0.22/src-phd/save-para.f 0000644 0150751 0150751 00000047160 12021362705 016143 0 ustar lkajan lkajan *----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 0.2 *
*----------------------------------------------------------------------*
************************************************************************
* This file contains the maximal parameters for executing multiple *
* runs of secstron. The specific parameter and variables for a *
* particular run are written in parsecstron resp parcollsec. *
************************************************************************
IMPLICIT NONE
* **** *
**** * ***PARAMETERS*** * ***
* ********** *
* * *
************************************************************************
C--------------------------------------------------
C---- numbers -----
C--------------------------------------------------
C---- -----
C---- -----
C---- -----
C---- architecture of network -----
C---- -----
INTEGER NUMINMAX,NUMOUTMAX,NUMHIDMAX,
+ NUMNEIGHMAX,NBIOLOBJMAX,NCODEUNTMAX,NHISTOMAX
C---- -----
C---- units (global) -----
C---- -----
INTEGER NUNITS_LENGTH,NUNITS_DISTCAPS
C---- -----
C---- reading databank -----
C---- -----
INTEGER NUMPROTMAX,NUMRESMAX
C---- -----
C---- jury decision -----
C---- -----
INTEGER NUMNETMAX,NUMNETFSTMAX,NUMNETSNDMAX
* *
C---- -----
C---- data handling -----
C---- -----
REAL ABW
* *
LOGICAL LDSSP
* *
* *
C---- =================================================================*
* *
C---- ----------------------------------------
PARAMETER (NUMINMAX= 1000)
PARAMETER (NUMOUTMAX= 10)
PARAMETER (NUMHIDMAX= 60)
PARAMETER (NUMNEIGHMAX= 21)
PARAMETER (NBIOLOBJMAX= 21)
PARAMETER (NCODEUNTMAX= 63)
PARAMETER (NHISTOMAX= 50)
C---- -------------------------------
* *
C---- ------------------------------------
PARAMETER (NUNITS_LENGTH= 4)
PARAMETER (NUNITS_DISTCAPS= 4)
C---- ------------------------------------
* *
C---- ---------------------------------------
PARAMETER (NUMPROTMAX= 1)
PARAMETER (NUMRESMAX= 10000)
C---- ---------------------------------------
* *
C---- ---------------------------------------
PARAMETER (NUMNETMAX= 30)
PARAMETER (NUMNETFSTMAX= 15)
PARAMETER (NUMNETSNDMAX= 15)
C---- ---------------------------------------
* *
C---- ---------------------------------------
PARAMETER (ABW= 0.00001)
C---- ---------------------------------------
* *
* *
C---- ---------------------------------------
PARAMETER (LDSSP=.FALSE.)
C---- ---------------------------------------
* *
* *
C---- =================================================================*
************************************************************************
* * *
**** * ***VARIABLES*** * ***
* ********* *
* * *
* *
************************************************************************
C--------------------------------------------------
C---- shared numbers -----
C--------------------------------------------------
C---- -----
C---- environment (path asf) -----
C---- -----
CHARACTER*132 PATH_PARACOM,PATH_ARCH,PATH_WORK,PATH_PRED
INTEGER LENPATH_PARACOM
* *
* *
C---- -----
C---- hssp related variables -----
C---- -----
CHARACTER*132 FILE_HSSP,FILE_HSSP_NOCHAIN
CHARACTER*132 PROTNAME(1:NUMPROTMAX)
* *
CHARACTER*1 RESNAME(1:NUMRESMAX),
+ RESSECSTR(1:NUMRESMAX),CONVSECSTR(1:NUMRESMAX),
+ AACODE(1:NBIOLOBJMAX),SSCODE(1:7),EXPCODE(1:10)
CHARACTER*24 AACODE24
CHARACTER*26 AACODE_LOWC
* *
INTEGER RESACC(1:NUMRESMAX),
+ RESVAR(1:NUMRESMAX),RESPROF(1:NUMRESMAX,1:NBIOLOBJMAX),
+ RESNDEL(1:NUMRESMAX),RESNINS(1:NUMRESMAX),
+ NUMNALIGN(1:NUMPROTMAX)
* *
REAL*4 RESCONSWEIGHT(1:NUMRESMAX)
* *
INTEGER POINTBEG(1:NUMPROTMAX),POINTEND(0:NUMPROTMAX),
+ NUMRES,AABIT(1:NBIOLOBJMAX,1:NCODEUNTMAX)
* *
LOGICAL LDSSPREAD
* *
COMMON /ENV1/PATH_PARACOM,PATH_ARCH,PATH_WORK,PATH_PRED
COMMON /ENV2/LENPATH_PARACOM
COMMON /DATAB1A/PROTNAME
COMMON /DATAB1B/FILE_HSSP,FILE_HSSP_NOCHAIN
COMMON /DATAB2/RESNAME,RESSECSTR,CONVSECSTR,AACODE,SSCODE,EXPCODE
COMMON /DATAB2b/AACODE24
COMMON /DATAB2c/AACODE_LOWC
COMMON /DATAB3/RESACC,RESVAR,RESPROF,RESNDEL,RESNINS,NUMNALIGN,
+ POINTBEG,POINTEND,NUMRES,AABIT
COMMON /DATAB4/RESCONSWEIGHT
COMMON /DATAB5/LDSSPREAD
* *
* *
C---- -----
C---- Exposure related variables -----
C---- -----
INTEGER MAXEXP,T2,T3A,T3B
* *
REAL THREXP2ST(1:3),THREXP3ST(1:4),THREXP10ST(1:10)
* *
COMMON /EXP1/MAXEXP,T2,T3A,T3B
COMMON /EXP2/THREXP2ST,THREXP3ST,THREXP10ST
* *
C---- -----
C---- architecture -----
C---- -----
* *
INTEGER NUMIN,NUMHID,NUMOUT,NUMNEIGH,NBIOLOBJ,NCODEUNT,
+ NUMNETFST,NUMNETSND,NUMNETJURY,MAXVAR,
+ MAXACC,PROFACC,CASCACC,NSECEL
INTEGER TRANS2FROM1(1:NUMNETSNDMAX)
* *
COMMON /COMPARA1/NUMIN,NUMHID,NUMOUT,NUMNEIGH,NBIOLOBJ,NCODEUNT,
+ NUMNETFST,NUMNETSND,NUMNETJURY,MAXVAR,
+ MAXACC,PROFACC,CASCACC,NSECEL
COMMON /COMPARA2/TRANS2FROM1
* *
C--------------------------------------------------
C---- characters/modes being shared -----
C--------------------------------------------------
C---- -----
C---- different modes -----
C---- -----
* *
CHARACTER*132 MODEASSSTR(1:NUMNETSNDMAX),
+ MODEASSCAS(1:NUMNETFSTMAX),MODESECSTRON
* *
CHARACTER*132 FILEPRED,FILEOUTPUT,ACTFILE,
+ FILEARCHFST(1:NUMNETFSTMAX),FILEARCHSND(1:NUMNETSNDMAX),
+ FILE_ARCHLIST,FILE_RDB,FILE_WHATIF,
+ CHAR_ARG_READ(1:100)
* *
COMMON /COMPARA3/MODEASSSTR,MODEASSCAS,MODESECSTRON
COMMON /COMPARA4/FILEPRED,FILEOUTPUT,ACTFILE,
+ FILEARCHFST,FILEARCHSND,FILE_ARCHLIST,FILE_RDB,FILE_WHATIF,
+ CHAR_ARG_READ
C--------------------------------------------------
C---- previous parameters for particular job -----
C---- note: assigned by parset.f -----
C--------------------------------------------------
* *
C---- -----
C---- junctions, biases -----
C---- -----
* *
REAL JUNCTION1ST(1:(NUMINMAX+NUMOUTMAX),1:NUMHIDMAX)
REAL LOCFIELD1(1:NUMHIDMAX)
REAL JUNCTION2ND(1:(NUMHIDMAX+NUMOUTMAX),1:NUMOUTMAX)
REAL LOCFIELD2(1:NUMOUTMAX)
* *
COMMON /TRIGGER3/JUNCTION1ST,JUNCTION2ND
COMMON /TRIGGER4/LOCFIELD1,LOCFIELD2
* *
C---- -----
C---- in/out vectors -----
C---- -----
* *
REAL*4 INPUT(1:(NUMINMAX+NUMOUTMAX),1:NUMRESMAX)
REAL*4 OUTPUT(1:NUMOUTMAX,1:NUMRESMAX),
+ OUTFIL(1:NUMOUTMAX,1:NUMRESMAX),
+ OUTFST(1:NUMOUTMAX,1:NUMRESMAX,1:NUMNETFSTMAX),
+ OUTSND(1:NUMOUTMAX,1:NUMRESMAX,1:NUMNETSNDMAX)
REAL*4 OUTEXP(1:NUMRESMAX),DESEXP(1:NUMRESMAX),
+ OUTEXPFIL(1:NUMRESMAX)
INTEGER*4 OUTBIN(1:NUMOUTMAX,1:NUMRESMAX),
+ OUTBINPROB(1:NUMOUTMAX,1:NUMRESMAX)
* *
CHARACTER*1 OUTBINCHAR(1:NUMRESMAX),OUTBINCHARFIL(1:NUMRESMAX)
* *
* *
COMMON /EXTERN1/INPUT,OUTPUT,OUTFST,OUTSND,OUTEXP,DESEXP,
+ OUTFIL,OUTEXPFIL
COMMON /EXTERN2/OUTBIN,OUTBINPROB
COMMON /EXTERN3/OUTBINCHAR,OUTBINCHARFIL
* *
C---- -----
C---- reliability index -----
C---- -----
* *
INTEGER NUMRELIND(0:9)
INTEGER*2 RELIND(1:NUMRESMAX)
INTEGER*2 DSSPVEC_I2(1:NUMRESMAX),PREDVEC_I2(1:NUMRESMAX)
* *
COMMON /EXTERN4a/NUMRELIND
COMMON /EXTERN4b/RELIND,DSSPVEC_I2,PREDVEC_I2
* *
* *
C---- -----
C---- filtering stuff (exposure) -----
C---- -----
* *
REAL REDUCE_MINSIZE,REDUCE_STATE0,REDUCE_STATE1
LOGICAL LREDUCE_BURRIED
* *
COMMON /FILTER1/REDUCE_MINSIZE,REDUCE_STATE0,REDUCE_STATE1
COMMON /FILTER2/LREDUCE_BURRIED
* *
C---- -----
C---- run time variables -----
C---- -----
* *
CHARACTER*24 STARTDATE,ENDDATE,XDTE
CHARACTER*8 STARTTIME,ENDTIME
* *
REAL TIMEDIFF,TIMEARRAY,TIMESTART,TIMERUN,TIMEEND
* *
COMMON /CLOCK1/STARTDATE,ENDDATE,XDTE,STARTTIME,ENDTIME
COMMON /CLOCK2/TIMEARRAY,TIMEDIFF,TIMESTART,TIMERUN,TIMEEND
* *
* *
C---- -----
C---- pay-off numbers -----
C---- -----
* *
INTEGER MATNUM(1:(NUMOUTMAX+1),1:(NUMOUTMAX+1)),
+ MATLEN(1:(NUMOUTMAX+1),1:4),
+ MATLENDIS(1:NHISTOMAX,1:(2*NUMOUTMAX)),
+ NUMSEGOVERL(1:9,1:(NUMOUTMAX+1)),
+ COUNTSEGMAT(1:2,1:(NUMOUTMAX+1)),
+ EXP_NOINBIN(0:9,0:9),
+ EXP_NOIN2ST(1:3),EXP_NOIN3ST(1:4),EXP_NOIN10ST(1:11),
+ OBS_NOIN2ST(1:3),OBS_NOIN3ST(1:4),OBS_NOIN10ST(1:11)
* *
REAL Q3,SQ,CORR(1:NUMOUTMAX),INFO,INFO_INV,
+ RMATQOFDSSP(1:NUMOUTMAX,1:NUMOUTMAX),
+ RMATQOFPRED(1:NUMOUTMAX,1:NUMOUTMAX),
+ QLOV(1:2,1:(NUMOUTMAX+1)),
+ QSOV(1:2,1:(NUMOUTMAX+1)),QFOV(1:2,1:(NUMOUTMAX+1)),
+ EXP_CORR
* *
* *
CHARACTER*132 TITLE,VERSION_SEC,VERSION_EXP,VERSION_HTM
* *
COMMON /PAYOFF1/MATNUM,MATLEN,MATLENDIS,NUMSEGOVERL,COUNTSEGMAT,
+ EXP_NOINBIN,EXP_NOIN2ST,EXP_NOIN3ST,EXP_NOIN10ST,
+ OBS_NOIN2ST,OBS_NOIN3ST,OBS_NOIN10ST
COMMON /PAYOFF2/Q3,SQ,CORR,RMATQOFDSSP,RMATQOFPRED,INFO,INFO_INV,
+ QLOV,QSOV,QFOV,EXP_CORR
COMMON /PAYOFF3/TITLE,VERSION_SEC,VERSION_EXP,VERSION_HTM
* *
* *
C---- -----
C---- content, asf. -----
C---- -----
* *
REAL CONTPRED(1:NUMOUTMAX),CONTDSSP(1:NUMOUTMAX),CONTAA(1:24)
* *
COMMON /CONT/CONTPRED,CONTDSSP,CONTAA
* *
C---- -----
C---- communication -----
C---- -----
* *
CHARACTER*1 ACTRESIDUE
CHARACTER*15 CASEDISCR,CONTROLCHAR
CHARACTER*25 ACTREGION
* *
INTEGER ACTPOS,ACTSOLVADDBEG,ACTSOLVADDEND,
+ ACTSOLVADDEND2,CODEVECPROF(1:NBIOLOBJMAX),PROFMAX,
+ CODEVECINCASC(1:(NUMOUTMAX+1)),
+ CODECOMPOSITION(1:NBIOLOBJMAX),
+ ACTCOMPOSITION(1:NBIOLOBJMAX),
+ ACTCHI,ACTITER,ACTSTART,ACTNDEL,ACTNINS,ACTNALIGN,ACTACC
* *
INTEGER BEGUNITS_COMPOSITION,
+ BEGUNITS_LENGTH,BEGUNITS_DISTCAPS,
+ SPLIT_LENGTH(1:NUNITS_LENGTH),
+ SPLIT_DISTCAPS(1:(NUNITS_LENGTH+1))
* *
REAL CODEVECTOR(1:NCODEUNTMAX),PROFINTERV,CASCINTERV,
+ ACTCONSWEIGHT,ACTINTERVALL
* *
LOGICAL LOGI_COMPOSITION,LOGI_LENGTH,LOGI_DISTCAPS,
+ LOGI_CONS,LOGI_INDEL,LOGI_REALINPUT
* *
COMMON /CODE1A/ACTRESIDUE
COMMON /CODE1B/CASEDISCR,CONTROLCHAR
COMMON /CODE1C/ACTREGION
COMMON /CODE3/ACTPOS,ACTSOLVADDBEG,ACTSOLVADDEND,ACTSOLVADDEND2,
+ CODEVECPROF,PROFMAX,CODEVECINCASC,
+ CODECOMPOSITION,ACTCOMPOSITION,
+ ACTCHI,ACTITER,ACTSTART,ACTNDEL,ACTNINS,ACTNALIGN,ACTACC
COMMON /CODE4/CODEVECTOR,PROFINTERV,CASCINTERV,ACTCONSWEIGHT,
+ ACTINTERVALL
COMMON /CODE5/BEGUNITS_COMPOSITION,
+ BEGUNITS_LENGTH,BEGUNITS_DISTCAPS,
+ SPLIT_LENGTH,SPLIT_DISTCAPS
COMMON /CODE6/LOGI_COMPOSITION,LOGI_LENGTH,LOGI_DISTCAPS,
+ LOGI_CONS,LOGI_INDEL,LOGI_REALINPUT
* *
C---- -----
C---- controls -----
C---- -----
* *
LOGICAL LSERVER,LFILTER,LDEC,LOUTBINPROB,
+ LMACHINE_READABLE,LWHATIF,LRDB
* *
COMMON /CONTROL/LSERVER,LFILTER,LDEC,LOUTBINPROB,
+ LMACHINE_READABLE,LWHATIF,LRDB
* *
*----------------------------------------------------------------------*
* Parmaters and Common variables for PHD *
*----------------------------------------------------------------------*
profnet-1.0.22/src-phd/tmp.f 0000644 0150751 0150751 00000001555 12021362704 015061 0 ustar lkajan lkajan program test
CHARACTER*24 FCTIME_DATE
CHARACTER*24 CTEMP
write(6,*)'xx =',FCTIME_DATE()
END
CHARACTER*24 FUNCTION FCTIME_DATE()
IMPLICIT NONE
C---- variables passed from/to SBR calling
CHARACTER*24 CTEMP,CTEMP2
******------------------------------*-----------------------------******
* execution of function *
CTEMP=' '
CALL DATE_AND_TIME(CTEMP,CTEMP2)
FCTIME_DATE= ' '
FCTIME_DATE(1:4)= CTEMP(1:4)
FCTIME_DATE(5:5)= '_'
FCTIME_DATE(6:7)= CTEMP(5:6)
FCTIME_DATE(8:8)= '_'
FCTIME_DATE(9:10)= CTEMP(7:8)
FCTIME_DATE(11:13)=' - '
FCTIME_DATE(14:15)=CTEMP2(1:2)
FCTIME_DATE(16:16)=':'
FCTIME_DATE(17:18)=CTEMP2(3:4)
FCTIME_DATE(19:19)=':'
FCTIME_DATE(20:21)=CTEMP2(5:6)
END
profnet-1.0.22/src-phd/tmp2.f 0000644 0150751 0150751 00000045365 12021362705 015153 0 ustar lkajan lkajan *----------------------------------------------------------------------*
SUBROUTINE RS_READHSSPx(IUNIT,FILE_HSSP_LOC,LERROR,
+ MAXRES,MAXALIGNS_LOC,MAXCORE_LOC,
+ PDBID,HEADER,COMPOUND,SOURCE,AUTHOR,SEQLENGTH,
+ NCHAIN,KCHAIN,CHAINREMARK,NALIGN,
+ EXCLUDEFLAG,EMBLID,STRID,IDE,SIM,
+ IFIR,ILAS,JFIR,JLAS,LALI,NGAP,LGAP,
+ LENSEQ,ACCNUM,IPROTNAME,
+ PDBNO,PDBSEQ,CHAINID,SECSTR,COLS,SHEETLABEL,BP1,BP2,
+ ACC,NOCC,VAR,ALISEQ,ALIPOINTER,
+ SEQPROF,NDEL,NINS,ENTROPY,RELENT,CONSWEIGHT,
+ LCONSERV,LOLDVERSION)
C---- global parameters
INCLUDE 'phdParameter.f'
C Reinhard Schneider 1989, BIOcomputing EMBL, D-6900 Heidelberg, FRG
C please report any bug, e-mail (INTERNET):
C schneider@EMBL-Heidelberg.DE
C or sander@EMBL-Heidelberg.DE
C=======================================================================
C INCREASE THE NUMBER OF FOLLOWING THREE PARAMETER IN THE CALLING
C PROGRAM IF NECESSARY
C=======================================================================
C maxaligns = maximal number of alignments in a HSSP-file
C maxres= maximal number of residues in a PDB-protein
C maxcore= maximal space for storing the alignments
C=======================================================================
C maxaa= 20 amino acids
C nblocksize= number of alignments in one line
C pdbid= Brookhaven Data Bank identifier
C header,compound,source,author= informations about the PDB-protein
C pdbseq= amino acid sequence of the PDB-protein
C chainid= chain identifier (chain A etc.)
C secstr= DSSP secondary structure summary
C bp1,bp2= beta-bridge partner
C cols= DSSP hydrogen bonding patterns for turns and helices,
C geometrical bend, chirality, one character name of beta-ladder
C and of beta-sheet
C sheetlabel= chain identifier of beta bridge partner
C seqlength= number of amino acids in the PDB-protein
C pdbno= residue number as in PDB file
C nchain= number of different chains in pdbid.DSSP data set
C kchain= number of chains used in HSSP data set
C nalign= number of alignments
C acc= solvated residue surface area in A**2
C emblid= EMBL/SWISSPROT identifier of the alignend protein
C strid= if the 3-D structure of this protein is known, then strid
C (structure ID)is the Protein Data Bank identifier as taken
C from the EMBL/SWISSPROT entry
C iprotname= one line description of alignend protein
C aliseq= sequential storage for the alignments
C alipointer= points to the beginning of alignment X ( 1>= X <=nalign )
C ifir,ilas= first and last position of the alignment in the test
C protein
C jfir,jlas= first and last position of the alignment in the alignend
C protein
C lali= length of the alignment excluding insertions and deletions
C ngap= number of insertions and deletions in the alignment
C lgap= total length of all insertions and deletions
C lenseq= length of the entire sequence of the alignend protein
C ide= percentage of residue identity of the alignment
C var= sequence variability as derived from the nalign alignments
C seqprof= relative frequency for each of the 20 amino acids
C nocc= number of alignend sequences spanning this position (including
C the test sequence
C ndel= number of sequences with a deletion in the test protein at this
C position
C nins= number of sequences with an insertion in the test protein at
C this position
C entropy= entropy measure of sequence variability at this position
C relent= relative entropy (entropy normalized to the range 0-100)
C consweight= conservation weight
C=======================================================================
C IMPLICIT NONE
C INTEGER NBLOCKSIZE
C PARAMETER (NBLOCKSIZE= 70)
C INTEGER MAXRES,MAXAA
C INTEGER MAXALIGNS,MAXCORE
C PARAMETER (MAXAA= 20)
C============================ import ==================================
C CHARACTER*222 FILE_HSSP_LOC
CHARACTER*(*) FILE_HSSP_LOC
INTEGER IUNIT
LOGICAL LERROR
C attributes of sequence with known structure
C CHARACTER*222 PDBID,HEADER,COMPOUND,SOURCE,AUTHOR
C CHARACTER*(*) PDBID,HEADER,COMPOUND,SOURCE,AUTHOR
CHARACTER*132 PDBID,HEADER,COMPOUND,SOURCE,AUTHOR
CHARACTER PDBSEQ(NUMRESMAX),CHAINID(NUMRESMAX),
+ SECSTR(NUMRESMAX)
C.......length*7
CHARACTER*7 COLS(NUMRESMAX)
CHARACTER*132 CHAINREMARK
C br 2003-08-23: save space
C CHARACTER SHEETLABEL(NUMRESMAX)
CHARACTER SHEETLABEL(1)
CHARACTER SHEETLABEL_NULL
C br 2003-08-23: end save space
INTEGER SEQLENGTH,NCHAIN,KCHAIN,NALIGN
INTEGER ACC(NUMRESMAX)
C br 2003-08-23: save space
C INTEGER BP1(NUMRESMAX),BP2(NUMRESMAX),PDBNO(NUMRESMAX)
INTEGER BP1(1),BP2(1),PDBNO(1)
INTEGER PDBNO_NULL,BP1_NULL,BP2_NULL
C br 2003-08-23: end save space
C attributes of alignend sequences
C CHARACTER*222 EMBLID(MAXALIGNS),STRID(MAXALIGNS),
C + ACCNUM(MAXALIGNS),IPROTNAME(MAXALIGNS),
C + EXCLUDEFLAG(MAXALIGNS)
C CHARACTER*(*) EMBLID(MAXALIGNS),STRID(MAXALIGNS),
C + ACCNUM(MAXALIGNS),IPROTNAME(MAXALIGNS),
C + EXCLUDEFLAG(MAXALIGNS)
CHARACTER*132 EMBLID(MAXALIGNS),STRID(MAXALIGNS),
+ IPROTNAME(MAXALIGNS),ACCNUM(MAXALIGNS),
+ EXCLUDEFLAG(MAXALIGNS)
INTEGER ALIPOINTER(MAXALIGNS),
+ IFIR(MAXALIGNS),ILAS(MAXALIGNS),JFIR(MAXALIGNS),
+ JLAS(MAXALIGNS),LALI(MAXALIGNS),NGAP(MAXALIGNS),
+ LGAP(MAXALIGNS),LENSEQ(MAXALIGNS)
REAL IDE(MAXALIGNS),SIM(MAXALIGNS)
C br 2003-08-23: save space
C CHARACTER ALISEQ(MAXCORE)
CHARACTER ALISEQ(1)
CHARACTER ALISEQ_NULL
C br 2003-08-23: end save space
C attributes of profile
INTEGER SEQPROF(NUMRESMAX,MAXAA),
+ NOCC(NUMRESMAX),NDEL(NUMRESMAX),NINS(NUMRESMAX)
REAL CONSWEIGHT(NUMRESMAX)
C br 2003-08-23: save space
C INTEGER VAR(NUMRESMAX),RELENT(NUMRESMAX)
C REAL ENTROPY(NUMRESMAX)
INTEGER VAR(1),RELENT(1)
INTEGER VAR_NULL,RELENT_NULL
REAL ENTROPY(1)
REAL ENTROPY_NULL
C br 2003-08-23: end save space
C.......
LOGICAL LCONSERV,LOLDVERSION
C=======================================================================
C internal
C INTEGER MAXALIGNS_LOC
C PARAMETER (MAXALIGNS_LOC= 3000)
C PARAMETER (MAXALIGNS_LOC= MAXALIGNS)
C character profileseq*(maxaa)
CHARACTER CTEMP*(NBLOCKSIZE),TEMPNAME*222
CHARACTER*222 LINE
C CHARACTER*20 HSSPRELEASE
CHARACTER CHAINSELECT
LOGICAL LCHAIN,LONG_ID
INTEGER ICHAINBEG,ICHAINEND,NALIGNORG,
+ I,J,K,IPOS,ILEN,NRES,IRES,
+ NBLOCK,IALIGN,IBLOCK,IALI,
+ IBEG,IEND,IPOINTER(MAXALIGNS)
INTEGER MAXCORE_LOC,MAXALIGNS_LOC,MAXRES
INTEGER ITMP
LOGICAL LDEBUG_LOCAL
C order of amino acid symbols in the HSSP sequence profile block
C profileseq='VLIMFWYGAPSTCHRKQEND'
LERROR=.FALSE.
C br 2003-08-23: avoid warnings
IBEG=0
IEND=0
J= 0
C used to debug
C LDEBUG_LOCAL=.FALSE.
LDEBUG_LOCAL=.TRUE.
C BR 2007/08/22: not sure this is right, was not initialized
LONG_ID=.FALSE.
NALIGN=0
CHAINREMARK=' '
DO I=1,MAXALIGNS
IPOINTER(I)=0
ENDDO
LCHAIN=.FALSE.
TEMPNAME(1:)=FILE_HSSP_LOC
I=INDEX(TEMPNAME,'_!_')
IF (I.NE.0) THEN
TEMPNAME(1:)=FILE_HSSP_LOC(1:I-1)
LCHAIN=.TRUE.
READ(FILE_HSSP_LOC(I+3:),'(A1)')CHAINSELECT
WRITE(6,'(T2,A,T10,A,T50,A)')'---',
+ '--- RS_READHSSP: extract the chain: ',chainselect
ENDIF
C CALL RSLIB_OPEN_FILE(IUNIT,TEMPNAME,'OLD,READONLY',LERROR)
C OPEN(IUNIT,FILE=TEMPNAME,STATUS='OLD',READONLY,ERR=99)
C OPEN(IUNIT,FILE=TEMPNAME,STATUS='OLD',ERR=99)
OPEN(IUNIT,FILE=TEMPNAME,ERR=99)
IF (LERROR .EQV. .TRUE.) THEN
WRITE(6,'(A)')'*** ERROR FOR RS_READHSSP: open problem'
GOTO 99
ENDIF
READ(IUNIT,'(A)',ERR=99)LINE
C check if it is a HSSP-file and get the release number for format flags
IF (LINE(1:4).NE.'HSSP') THEN
WRITE(6,'(A)')'*** ERROR FOR RS_READHSSP: is not a HSSP-file'
LERROR=.TRUE.
RETURN
ELSE
I=INDEX(LINE,'VERSION')+7
C HSSPRELEASE=LINE(I:)
LOLDVERSION=.FALSE.
c if (index(hssprelease,'0.9').ne.0)loldversion=.true.
ENDIF
C read in PDBID etc.
DO WHILE(LINE(1:6).NE.'PDBID')
READ(IUNIT,'(A)',ERR=99)LINE
ENDDO
READ(LINE,'(11X,A)',ERR=99)PDBID
DO WHILE(LINE(1:6).NE.'HEADER')
READ(IUNIT,'(A)',ERR=99)LINE
IF (LINE(1:23).EQ.'PARAMETER LONG-ID :YES') THEN
LONG_ID=.TRUE.
IF (LDEBUG_LOCAL .EQV. .TRUE.)
+ WRITE(6,'(A,A)')'DBG longid LINE=',LINE(1:23)
ENDIF
ENDDO
READ(LINE ,'(11X,A)',ERR=99)HEADER
READ(IUNIT,'(11X,A)',ERR=99)COMPOUND
READ(IUNIT,'(11X,A)',ERR=99)SOURCE
READ(IUNIT,'(11X,A)',ERR=99)AUTHOR
READ(IUNIT,'(11X,I4)',ERR=99)SEQLENGTH
READ(IUNIT,'(11X,I4)',ERR=99)NCHAIN
KCHAIN=NCHAIN
READ(IUNIT,'(A)',ERR=99)LINE
C IF (LDEBUG_LOCAL .EQV. .TRUE.) WRITE(6,*)'DBG ',LINE
IF (INDEX(LINE,'KCHAIN').NE.0) THEN
READ(LINE,'(11X,I4,A)',ERR=99)KCHAIN,CHAINREMARK
READ(IUNIT,'(11X,I4)',ERR=99)NALIGNORG
ELSE
READ(LINE,'(11X,I4)',ERR=99)NALIGNORG
ENDIF
C if HSSP-file contains no alignments return
IF (NALIGNORG.EQ.0) THEN
WRITE(6,'(T2,A,T10,A)')'---',
+ '--- HSSP-file contains no alignments ***'
CLOSE(IUNIT)
RETURN
ENDIF
C write(6,*)'xx before overflow, Nali=',nalignorg,' len=',
C + seqlength,' kchain=',kchain,' lchain=',lchain
C parameter overflow handling
IF (NALIGNORG.GT.MAXALIGNS) THEN
WRITE(6,'(A)')'-*- HSSP-file contains too many alignments **'
WRITE(6,'(A)')'-*- INCREASE MAXALIGNS in phdParameter.f! '
WRITE(6,'(A,I8,A,I8)')'-*- is=',MAXALIGNS,' want>',NALIGNORG
CLOSE(IUNIT)
LERROR=.TRUE.
RETURN
ENDIF
ITMP=SEQLENGTH+KCHAIN-1
IF (ITMP.GT.NUMRESMAX) THEN
WRITE(6,'(A)')'*** PDB-sequence in HSSP-file too long ***'
WRITE(6,'(A)')'*** INCREASE NUMRESMAX in phdParameter.f***'
WRITE(6,'(A,I8,A,I8)')'-*- is=',NUMRESMAX,' want>',ITMP
CLOSE(IUNIT)
LERROR=.TRUE.
RETURN
ENDIF
C number of sequence positions is number of residues + number of chains
C chain break is indicated by a '!'
NRES=SEQLENGTH+KCHAIN-1
ICHAINBEG=1
ICHAINEND=NRES
IF (LCHAIN .EQV. .TRUE.) THEN
C search for ALIGNMENT-block
DO WHILE (LINE(1:13).NE.'## ALIGNMENTS')
READ(IUNIT,'(A)',ERR=99)LINE
ENDDO
READ(IUNIT,'(A)',ERR=99)LINE
ICHAINBEG=0
ICHAINEND=0
C read till end ; some PDB-chains have DSSP-chain breaks !!
DO I=1,NRES
READ(IUNIT,'(7X,I4,1X,A1)',ERR=99)PDBNO(I),CHAINID(I)
IF (CHAINID(I) .EQ. CHAINSELECT) THEN
IF (ICHAINBEG .EQ. 0) ICHAINBEG=I
ICHAINEND=I
ENDIF
ENDDO
WRITE(6,'(T2,A,T10,I10,I10)')'---',
+ ICHAINBEG,ICHAINEND
REWIND(IUNIT)
ENDIF
SEQLENGTH=ICHAINEND-ICHAINBEG+1
C search for the PROTEINS-block
LINE=' '
DO WHILE(LINE(1:11).NE.'## PROTEINS')
READ(IUNIT,'(A)',ERR=99)LINE
C IF (LDEBUG_LOCAL .EQV. .TRUE.) WRITE(6,*)'DBG PROT=',LINE
ENDDO
READ(IUNIT,'(A)',ERR=99)LINE
LCONSERV=.FALSE.
IF (INDEX(LINE,'%WSIM').NE.0) LCONSERV= .TRUE.
C READ DATA ABOUT THE ALIGNMENTS
IALIGN=1
IF (LDEBUG_LOCAL .EQV. .TRUE.)
+ WRITE(6,'(A,I5,A,A)')'DBG NALI=',NALIGNORG,' longid=',LONG_ID
DO I=1,NALIGNORG
IF (LDEBUG_LOCAL .EQV. .TRUE.) WRITE(6,'(A,I5)')'DBG iali=',I
IF (LONG_ID .EQV. .TRUE.) THEN
C note: read format specified below (line labelled 101)
write(6,*)'xxok in long'
READ(IUNIT,101,ERR=99)
+ EXCLUDEFLAG(IALIGN),EMBLID(IALIGN)(1:),STRID(IALIGN),
+ IDE(IALIGN),SIM(IALIGN),IFIR(IALIGN),ILAS(IALIGN),
+ JFIR(IALIGN),JLAS(IALIGN),LALI(IALIGN),NGAP(IALIGN),
+ LGAP(IALIGN),LENSEQ(IALIGN),ACCNUM(IALIGN),
+ IPROTNAME(IALIGN)
write(6,*)'xxok in long after i=',i
ELSE
write(6,*)'xxok in short'
C note: read format specified below (line labelled 100)
READ(IUNIT,100,ERR=99)
+ EXCLUDEFLAG(IALIGN),EMBLID(IALIGN)(1:),STRID(IALIGN),
+ IDE(IALIGN),SIM(IALIGN),IFIR(IALIGN),ILAS(IALIGN),
+ JFIR(IALIGN),JLAS(IALIGN),LALI(IALIGN),NGAP(IALIGN),
+ LGAP(IALIGN),LENSEQ(IALIGN),ACCNUM(IALIGN),
+ IPROTNAME(IALIGN)
END IF
write(6,*)'xxok after endif'
IF (LDEBUG_LOCAL .EQV. .TRUE.) THEN
WRITE(6,'(A,I5,A,F5.2,A,A)')'DBG PROTali(',IALIGN,') ide=',
+ IDE(IALIGN),
+ ' name=',IPROTNAME(IALIGN)
END IF
IF (IFIR(IALIGN) .GE. ICHAINBEG .AND.
+ ILAS(IALIGN) .LE. ICHAINEND) THEN
IPOINTER(I)=IALIGN
IALIGN=IALIGN+1
ENDIF
ENDDO
write(6,*)' xxok after loop'
100 FORMAT(5X,A1,2X,A12,A5,2X,F5.2,1X,F5.2,8(1X,I4),2X,A10,1X,A)
101 FORMAT(5X,A1,2X,A40,A5,2X,F5.2,1X,F5.2,8(1X,I4),2X,A10,1X,A)
NALIGN=IALIGN-1
WRITE(6,'(T2,A,T10,A)')'---',
+ ' RS_READHSSP PROTEINS-block done'
C init pointer ; aliseq contains the alignments (amino acid symbols)
C stored in the following way ; '/' separates alignments
C alignment(x) is stored from:
C aliseq(alipointer(x)) to aliseq(ilas(x)-ifir(x))
C aliseq(1........46/48.........60/62....)
C | | |
C | | |
C pointer pointer pointer
C ali 1 ali 2 ali 3
C init pointer
IPOS=1
DO I=1,NALIGN
C br 2003-08-23 fast and slim
C IF (IPOS.GE.MAXCORE) THEN
C WRITE(6,'(A,I9,A)')
C + ' *** LERROR: INCREASE MAXCORE to >',IPOS,'***'
C STOP
C ENDIF
C end fast and slim br 2003-08-23
ALIPOINTER(I)=IPOS
ILEN=ILAS(I)-IFIR(I)+1
IPOS=IPOS+ILEN
C br 2003-08-23 fast and slim
C ALISEQ(IPOS)='/'
ALISEQ_NULL='/'
C end fast and slim br 2003-08-23
IPOS=IPOS+1
ENDDO
ALIPOINTER(NALIGN+1)=IPOS+1
C number of ALIGNMENTS-blocks
IF (MOD(FLOAT(NALIGNORG),FLOAT(NBLOCKSIZE)).EQ. 0.0) THEN
NBLOCK=NALIGNORG/NBLOCKSIZE
ELSE
NBLOCK=NALIGNORG/NBLOCKSIZE+1
ENDIF
C search for ALIGNMENT-block
DO WHILE (LINE(1:13).NE.'## ALIGNMENTS')
READ(IUNIT,'(A)',ERR=99)LINE
IF (LDEBUG_LOCAL .EQV. .TRUE.) WRITE(6,*)'DBG alinot',LINE
ENDDO
READ(IUNIT,'(A)',ERR=99)LINE
IF (LDEBUG_LOCAL .EQV. .TRUE.) WRITE(6,*)'DBG ',LINE
C loop over ALIGNMENTS-blocks
C ....read in pdbno, chainid, secstr etc.
IALIGN=0
IALI=0
DO IBLOCK=1,NBLOCK
IRES=1
DO I=1,NRES
C BR: 2003-08-23: save space
C READ(IUNIT,200,ERR=99)
C + PDBNO(IRES),CHAINID(IRES),PDBSEQ(IRES),SECSTR(IRES),
C + COLS(IRES),BP1(IRES),BP2(IRES),SHEETLABEL(IRES),
C + ACC(IRES),NOCC(IRES),VAR(IRES),CTEMP
READ(IUNIT,200,ERR=99)
+ PDBNO_NULL,CHAINID(IRES),PDBSEQ(IRES),SECSTR(IRES),
+ COLS(IRES),BP1_NULL,BP2_NULL,SHEETLABEL_NULL,
+ ACC(IRES),NOCC(IRES),VAR_NULL,CTEMP
C end save space br 2003-08-23
200 FORMAT(7X,I4,2(1X,A1),2X,A1,1X,A7,2(I4),A1,I4,2(1X,I4),2X,A)
C.....fill up aliseq
C IF (LDEBUG_LOCAL .EQV. .TRUE.)
C + WRITE(6,*)'DBG IBLOCK=',IBLOCK, ' IRES=',I
IF (I .GE. ICHAINBEG .AND. I .LE. ICHAINEND) THEN
IRES=IRES+1
C br 2003-08-23 fast and slim
C IF (PDBSEQ(I) .NE. '!') THEN
C CALL STRPOS(CTEMP,IBEG,IEND)
C DO IPOS=MAX(IBEG,1),MIN(NBLOCKSIZE,IEND)
C IALI=IALIGN+IPOS
C IF (CTEMP(IPOS:IPOS) .NE. ' ') THEN
C J=ALIPOINTER(IPOINTER(IALI)) +
C + (I-IFIR(IPOINTER(IALI)))
C ALISEQ(J)=CTEMP(IPOS:IPOS)
C ENDIF
C ENDDO
C ENDIF
C end fast and slim br 2003-08-23
ENDIF
ENDDO
IALIGN=IALIGN+NBLOCKSIZE
DO K=1,2
READ(IUNIT,'(A)',ERR=99)LINE
IF (LDEBUG_LOCAL .EQV. .TRUE.) WRITE(6,*)'DBG ',LINE
ENDDO
ENDDO
WRITE(6,'(T2,A,T10,A)')'---',
+ ' RS_READHSSP ALIGNMENTS-block done'
C read in sequence profile, entropy etc.
IRES=1
DO I=1,NRES
C BR 2003-08-23 save space
C READ(IUNIT,300,ERR=99)(SEQPROF(IRES,K),K=1,MAXAA),
C + NOCC(IRES),NDEL(IRES),NINS(IRES),ENTROPY(IRES),
C + RELENT(IRES),CONSWEIGHT(IRES)
READ(IUNIT,300,ERR=99)(SEQPROF(IRES,K),K=1,MAXAA),
+ NOCC(IRES),NDEL(IRES),NINS(IRES),ENTROPY_NULL,
+ RELENT_NULL,CONSWEIGHT(IRES)
C end save space br 2003-08-23
IF (I .GE. ICHAINBEG .AND. I .LE. ICHAINEND) THEN
IRES=IRES+1
ENDIF
ENDDO
300 FORMAT(12X,20(I4),1X,3(1X,I4),1X,F7.3,3X,I4,2X,F4.2)
WRITE(6,'(T2,A,T10,A)')'---',
+ ' RS_READHSSP PROFILE-block done'
IF (LCHAIN .EQV. .TRUE.) THEN
DO I=1,NALIGN
IFIR(I)=IFIR(I)-ICHAINBEG+1
ILAS(I)=ILAS(I)-ICHAINBEG+1
ENDDO
ENDIF
C check if next line (last line in a HSSP-file) contains a '//'
READ(IUNIT,'(A)',ERR=99)LINE
IF ((LINE(1:2).EQ.'//').OR.
+ (LINE(1:13).EQ.'## INSERTION')) THEN
WRITE(6,'(T2,A,T10,A,A50)')'---',
+ ' RS_READHSSP ok(cut 50): ',FILE_HSSP_LOC(1:50)
GOTO 999
ELSE
WRITE(6,'(T2,A,T10,A,A,A,A)')'***',
+ 'ERROR FOR RS_READHSSP: ',FILE_HSSP_LOC,' lastLine=',
+ LINE
GOTO 99
ENDIF
99 WRITE(6,'(A,A)')'**** ERROR FOR RS_READHSSP: READING: ',
+ FILE_HSSP_LOC
LERROR=.TRUE.
NALIGN=0
SEQLENGTH=0
999 CLOSE(IUNIT)
RETURN
END
***** end of RS_READHSSP
profnet-1.0.22/src-phd/x.f 0000644 0150751 0150751 00000000640 12021362704 014522 0 ustar lkajan lkajan LOGICAL LCONSERV,LOLDVERSION
C Compiler bug patch
C write data in loop, because the SUN4 compiler has a limit stacksize of
C 4096 (before it was 8192 MURKS) in a routine(do_u_out, rwrite or w4cp)
C integer NPACK
C parameter (NPACK=1000)
C......
LOGICAL LSCREEN
INTEGER MAXALIGNS_LOC,MAXRES
C=======================================================================
profnet-1.0.22/src/ 0000755 0150751 0150751 00000000000 12021365335 013336 5 ustar lkajan lkajan profnet-1.0.22/src/Doc-lib-nn 0000644 0150751 0150751 00000000000 12021362711 015124 0 ustar lkajan lkajan profnet-1.0.22/src/Doc-nn.txt 0000644 0150751 0150751 00000014552 12021362711 015217 0 ustar lkajan lkajan * ----------------------------------------------------------------------*
*
* organisation and dependence of program, functions, and subroutines
* for nn.f
*
* ------------------------------
* keywords:
* ------------------------------
*
* nn internal subroutines:
* nn external subroutines:
* lib-nn internal subroutines:
* lib-nn external subroutines:
* lib-SGI64 internal subroutines:
*
* ------------------------------
* notations:
* ------------------------------
*
* '-> x' means is calling the following
* '.. self content' means: no subroutine called
*
*
* ----------------------------------------------------------------------*
* ---------------------
* nn internal subroutines:
* ---------------------
*
* MAIN -> GET_ARG_NUMBER,GET_ARGUMENT,SRDTIME,
* -> SCFDATE,ININN,RDPAR,RDIN,RDOUT,RDSAM,
* -> RDJCT,
* -> INIJCT,
* -> INITHRUNT,
* -> NETOUT,
* -> WRTOUT,
* -> WRTJCT,
* -> TRAIN,
* -> WRTSCR,
* -> WRTERR,
* -> WRTYEAH
* TRG1ST .. self-content
* TRG2ND .. self-content
* TRGNORM .. self-content
* ININN -> INIPAR_CON,INIPAR_DEFAULT,INIPAR_ASK,
* -> INIPAR_SWITCH
* INIPAR_ASK -> GETCHAR,GETINT
* INIPAR_CON .. self-content
* INIPAR_DEFAULT .. self-content
* INIPAR_SWITCH -> SCHAR_TO_INT
* INITHRUNT .. self-content
* RDJCT -> SFILEOPEN,RDJCT_HEAD,RDJCT_JCT1,
* -> RDJCT_JCT2,RDJCT_WRT
* RDJCT_HEAD -> RDJCT_CHECK
* RDJCT_JCT1 .. self-content
* RDJCT_JCT2 .. self-content
* RDJCT_CHECK .. self-content
* RDJCT_WRT .. self-content
* RDIN -> SFILEOPEN,RDIN_HEAD,RDIN_DATA,RDIN_WRT
* RDIN_HEAD .. self-content
* RDIN_DATA .. self-content
* RDIN_WRT .. self-content
* RDOUT -> SFILEOPEN,RDOUT_HEAD,RDOUT_DATA,
* -> RDOUT_WRT
* RDOUT_HEAD .. self-content
* RDOUT_DATA .. self-content
* RDOUT_WRT .. self-content
* RDPAR -> SFILEOPEN,RDPAR_I,RDPAR_F,RDPAR_A,
* -> RDPAR_WRT
* RDPAR_I -> RDPAR_ERR
* RDPAR_F .. self-content
* RDPAR_A .. self-content
* RDPAR_ERR .. self-content
* RDPAR_WRT .. self-content
* RDSAM -> SFILEOPEN
* NETOUT -> NETOUT_MUE,NETOUT_BIN,NETOUT_ERR
* NETOUT_MUE .. self-content
* NETOUT_BIN .. self-content
* NETOUT_ERR .. self-content
* TRAIN -> NETOUT,TRAIN_STOP,TRAIN_WRT,
* -> TRAIN_INISWP,TRAIN_INIMUE,
* -> TRAIN_BACKPROP,
* -> WRTOUT,
* -> WRTJCT
* TRAIN_BACKPROP .. self-content
* TRAIN_INIMUE -> SRSTE2,SRSTZ2,NETOUT_MUE
* TRAIN_INISWP -> SRSTZ2
* TRAIN_STOP .. self-content
* TRAIN_WRT .. self-content
* WRTJCT -> SFILEOPEN,WRTHEAD
* WRTOUT -> WRTHEAD,NETOUT_MUE
* WRTERR -> SFILEOPEN
* WRTHEAD -> WRTHEAD_GEN,WRTHEAD_JOB
* WRTHEAD_GEN .. self-content
* WRTHEAD_JOB .. self-content
* WRTSCR -> WRTERR
* WRTYEAH -> SFILEOPEN
*
* ----------------------------------------------------------------------*
* ---------------------
* nn external subroutines:
* ---------------------
*
* call from missing:
* GETCHAR
* GETINT
* GET_ARGUMENT
* GET_ARG_NUMBER
* INIJCT
* SCFDATE
* SCHAR_TO_INT
* SFILEOPEN
* SRDTIME
* SRSTE2
* SRSTZ2
#
*
* ----------------------------------------------------------------------*
* ---------------------
* lib-nn internal subroutines:
* ---------------------
*
* EMPTYSTRING .. self-content
* FILEN_STRING .. self-content
* FILENSTRING .. self-content
* FILENSTRING_ALPHANUMSEN .. self-content
* FRMAX1 .. self-content
* FRMAX2 .. self-content
* GETCHAR -> WRITELINES
* GETINT -> WRITELINES,STRPOS,GETTOKEN,RIGHTADJUST
* GETTOKEN .. self-content
* GET_ARGUMENT -> GETARG
* GET_ARG_NUMBER .. self-content
* RIGHTADJUST .. self-content
* SCFDATE .. self-content
* SFILEOPEN .. self-content
* SCHAR_TO_INT -> SILEN_STRING
* SILEN_STRING .. self-content
* SRSTE2 .. self-content
* SRSTZ2 .. self-content
* STRPOS .. self-content
* WRITELINES -> STRPOS
*
* ----------------------------------------------------------------------*
* ---------------------
* lib-nn external subroutines:
* ---------------------
*
* call from missing:
* GETARG
#
*
* ----------------------------------------------------------------------*
* ---------------------
* lib-SGI64 internal subroutines:
* ---------------------
*
* INIJCT .. self-content
* SRDTIME .. self-content
*
* ----------------------------------------------------------------------*
#
profnet-1.0.22/src/Makefile 0000755 0150751 0150751 00000001654 12021363230 014777 0 ustar lkajan lkajan #=====================================================================
F77 = gfortran
BIN = profnet_prof
#=====================================================================
ARCH = LINUX
FFLAGS := $(FFLAGS) -O2 -Wuninitialized
FFLAGS := $(FFLAGS) -Wall -Wno-unused
#=====================================================================
NN_OBJS := prof.f lib-prof.f lib-sys-$(ARCH).f
SOURCES := $(NN_OBJS) profPar.f
#=====================================================================
all: $(BIN)
#=====================================================================
# Make Neural Network
#=====================================================================
$(BIN): $(SOURCES)
@echo --- making $(BIN)
$(F77) $(CPPFLAGS) $(FFLAGS) $(LDFLAGS) -o $@ $(NN_OBJS)
clean:
rm -f *.o $(BIN)
install:
mkdir -p $(DESTDIR)$(prefix)/bin && \
cp $(BIN) $(DESTDIR)$(prefix)/bin/
.PHONY: all clean install
profnet-1.0.22/src/PROFin.dat 0000644 0150751 0150751 00000323623 12021362712 015132 0 ustar lkajan lkajan * NNin_in file for FORTRAN NN.f (input vectors)
* -----------------------------------------------------------------
* Parameter input for neural network (nn)
* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
* Burkhard Rost, CUBIC NYC / LION Heidelberg
* fax: +1-212-305 3773
* email: rost@columbia.edu
* www: http://cubic.bioc.columbia.edu
* date: May 8, 2002
* acc
* 1st,unb
* mode: tvt
* -----------------------------------------------------------------
* --------------------
* overall: (A,T25,I8)
NUMIN : 385
NUMSAMFILE : 46
* --------------------
* samples: count (A8,I8) NEWLINE 1..NUMIN (25I6)
ITSAM: 1
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 100 25 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 100 25 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 100 25 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 100 25 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 100 25 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 100 25 0 0 0 0 0 0 0 0
0 0 0 0 0 100 0 0 0 0 0 0 0 0 0 50 0 0 0 0 0 0 0 0 0
0 0 0 92 8 0 0 0 0 0 0 0 0 0 41 0 0 0 0 0 0 0 0 0 0
0 0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0 0 0 0 4 0 0 0 0
0 0 0 96 0 0 0 0 0 0 0 0 45 0 0 0 0 0 0 0 0 0 0 0 65
0 0 0 0 19 15 0 0 0 0 0 26 0 0 0 0 0 0 0 0 0 0 0 0 27
19 0 0 4 0 0 0 42 8 0 16 0 0 0 0 15 4 0 0 0 0 0 4 0 73
0 0 0 4 0 0 0 0 0 25 0 0 4 2 10 0 2 0 4 8 10 10 4 13 13
0 4 0 0 2 6 2 76 0 0 0 0 0 0 0 100 100 100 100 0 0 0 0 0 0
0 0 0 0 0 0 55 30 55 30 52 90 52 90 70 11 44 13 85 100 65 64 62 0 0
0 0 0 0 0 0 0 0 0 0
ITSAM: 2
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 100 25 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 100 25 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 100 25 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 100 25 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 100 25 0 0 0 0 0 0 0
0 0 0 0 0 0 100 0 0 0 0 0 0 0 0 0 50 0 0 0 0 0 0 0 0
0 0 0 0 92 8 0 0 0 0 0 0 0 0 0 41 0 0 0 0 0 0 0 0 0
0 0 0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0 0 0 0 4 0 0 0
0 0 0 0 96 0 0 0 0 0 0 0 0 45 0 0 0 0 0 0 0 0 0 0 0
65 0 0 0 0 19 15 0 0 0 0 0 26 0 0 0 0 0 0 0 0 0 0 0 0
27 19 0 0 4 0 0 0 42 8 0 16 0 0 0 0 15 4 0 0 0 0 0 4 0
73 0 0 0 4 0 0 0 0 0 25 0 0 8 8 8 0 0 4 0 0 19 0 4 50
0 0 0 0 0 0 0 0 0 13 0 0 4 2 10 0 2 0 4 8 10 10 4 13 13
0 4 0 0 2 6 2 76 0 0 0 10 0 0 0 100 100 100 100 0 0 0 0 0 0
0 0 0 0 55 30 55 30 52 90 52 90 70 11 44 13 85 100 76 88 56 67 49 0 0
0 0 0 0 0 0 0 0 0 0
ITSAM: 3
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 100 25 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 100 25 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 100 25 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 100 25 0 0 0 0 0 0
0 0 0 0 0 0 0 100 0 0 0 0 0 0 0 0 0 50 0 0 0 0 0 0 0
0 0 0 0 0 92 8 0 0 0 0 0 0 0 0 0 41 0 0 0 0 0 0 0 0
0 0 0 0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0 0 0 0 4 0 0
0 0 0 0 0 96 0 0 0 0 0 0 0 0 45 0 0 0 0 0 0 0 0 0 0
0 65 0 0 0 0 19 15 0 0 0 0 0 26 0 0 0 0 0 0 0 0 0 0 0
0 27 19 0 0 4 0 0 0 42 8 0 16 0 0 0 0 15 4 0 0 0 0 0 4
0 73 0 0 0 4 0 0 0 0 0 25 0 0 8 8 8 0 0 4 0 0 19 0 4
50 0 0 0 0 0 0 0 0 0 13 0 0 0 0 0 0 0 0 0 27 69 0 0 0
0 0 0 0 0 0 0 4 0 35 0 0 4 2 10 0 2 0 4 8 10 10 4 13 13
0 4 0 0 2 6 2 76 0 0 0 20 0 0 0 100 100 100 100 0 0 0 0 0 0
0 0 55 30 55 30 52 90 52 90 70 11 44 13 85 100 76 88 58 40 64 51 68 0 0
0 0 0 0 0 0 0 0 0 0
ITSAM: 4
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 100 25 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 100 25 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 100 25 0 0 0 0 0
0 0 0 0 0 0 0 0 100 0 0 0 0 0 0 0 0 0 50 0 0 0 0 0 0
0 0 0 0 0 0 92 8 0 0 0 0 0 0 0 0 0 41 0 0 0 0 0 0 0
0 0 0 0 0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0 0 0 0 4 0
0 0 0 0 0 0 96 0 0 0 0 0 0 0 0 45 0 0 0 0 0 0 0 0 0
0 0 65 0 0 0 0 19 15 0 0 0 0 0 26 0 0 0 0 0 0 0 0 0 0
0 0 27 19 0 0 4 0 0 0 42 8 0 16 0 0 0 0 15 4 0 0 0 0 0
4 0 73 0 0 0 4 0 0 0 0 0 25 0 0 8 8 8 0 0 4 0 0 19 0
4 50 0 0 0 0 0 0 0 0 0 13 0 0 0 0 0 0 0 0 0 27 69 0 0
0 0 0 0 0 0 0 0 4 0 35 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 96 4 0 0 0 0 0 48 0 0 4 2 10 0 2 0 4 8 10 10 4 13 13
0 4 0 0 2 6 2 76 0 0 0 30 0 0 0 100 100 100 100 0 0 0 0 0 0
55 30 55 30 52 90 52 90 70 11 44 13 85 100 76 88 58 40 0 33 45 48 64 0 0
0 0 0 0 0 0 0 0 0 0
ITSAM: 5
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 100 25 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 100 25 0 0 0 0
0 0 0 0 0 0 0 0 0 100 0 0 0 0 0 0 0 0 0 50 0 0 0 0 0
0 0 0 0 0 0 0 92 8 0 0 0 0 0 0 0 0 0 41 0 0 0 0 0 0
0 0 0 0 0 0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0 0 0 0 4
0 0 0 0 0 0 0 96 0 0 0 0 0 0 0 0 45 0 0 0 0 0 0 0 0
0 0 0 65 0 0 0 0 19 15 0 0 0 0 0 26 0 0 0 0 0 0 0 0 0
0 0 0 27 19 0 0 4 0 0 0 42 8 0 16 0 0 0 0 15 4 0 0 0 0
0 4 0 73 0 0 0 4 0 0 0 0 0 25 0 0 8 8 8 0 0 4 0 0 19
0 4 50 0 0 0 0 0 0 0 0 0 13 0 0 0 0 0 0 0 0 0 27 69 0
0 0 0 0 0 0 0 0 0 4 0 35 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 96 4 0 0 0 0 0 48 0 0 0 0 4 0 0 0 4 0 0 0 12 0
0 0 0 4 0 0 77 0 0 27 0 0 4 2 10 0 2 0 4 8 10 10 4 13 13
0 4 0 0 2 6 2 76 0 0 0 40 0 0 0 100 100 100 100 0 0 0 0 55 30
55 30 52 90 52 90 70 11 44 13 85 100 76 88 58 40 0 33 44 13 60 61 61 0 0
0 0 0 0 0 0 0 0 0 0
ITSAM: 6
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 100 25 0 0 0
0 0 0 0 0 0 0 0 0 0 100 0 0 0 0 0 0 0 0 0 50 0 0 0 0
0 0 0 0 0 0 0 0 92 8 0 0 0 0 0 0 0 0 0 41 0 0 0 0 0
0 0 0 0 0 0 0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0 0 0 0
4 0 0 0 0 0 0 0 96 0 0 0 0 0 0 0 0 45 0 0 0 0 0 0 0
0 0 0 0 65 0 0 0 0 19 15 0 0 0 0 0 26 0 0 0 0 0 0 0 0
0 0 0 0 27 19 0 0 4 0 0 0 42 8 0 16 0 0 0 0 15 4 0 0 0
0 0 4 0 73 0 0 0 4 0 0 0 0 0 25 0 0 8 8 8 0 0 4 0 0
19 0 4 50 0 0 0 0 0 0 0 0 0 13 0 0 0 0 0 0 0 0 0 27 69
0 0 0 0 0 0 0 0 0 0 4 0 35 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 96 4 0 0 0 0 0 48 0 0 0 0 4 0 0 0 4 0 0 0 12
0 0 0 0 4 0 0 77 0 0 27 0 0 0 0 23 0 0 0 0 0 0 0 0 15
42 0 0 0 8 0 12 0 0 6 0 0 4 2 10 0 2 0 4 8 10 10 4 13 13
0 4 0 0 2 6 2 76 0 0 0 50 0 0 0 100 100 100 100 0 0 55 30 55 30
52 90 52 90 70 11 44 13 85 100 76 88 58 40 0 33 44 13 31 15 43 46 33 0 0
0 0 0 0 0 0 0 0 0 0
ITSAM: 7
0 0 0 0 0 0 0 0 0 0 0 100 0 0 0 0 0 0 0 0 0 50 0 0 0
0 0 0 0 0 0 0 0 0 92 8 0 0 0 0 0 0 0 0 0 41 0 0 0 0
0 0 0 0 0 0 0 0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0 0 0
0 4 0 0 0 0 0 0 0 96 0 0 0 0 0 0 0 0 45 0 0 0 0 0 0
0 0 0 0 0 65 0 0 0 0 19 15 0 0 0 0 0 26 0 0 0 0 0 0 0
0 0 0 0 0 27 19 0 0 4 0 0 0 42 8 0 16 0 0 0 0 15 4 0 0
0 0 0 4 0 73 0 0 0 4 0 0 0 0 0 25 0 0 8 8 8 0 0 4 0
0 19 0 4 50 0 0 0 0 0 0 0 0 0 13 0 0 0 0 0 0 0 0 0 27
69 0 0 0 0 0 0 0 0 0 0 4 0 35 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 96 4 0 0 0 0 0 48 0 0 0 0 4 0 0 0 4 0 0 0
12 0 0 0 0 4 0 0 77 0 0 27 0 0 0 0 23 0 0 0 0 0 0 0 0
15 42 0 0 0 8 0 12 0 0 6 0 0 0 0 0 0 15 0 85 0 0 0 0 0
0 0 0 0 0 0 0 0 0 49 0 0 4 2 10 0 2 0 4 8 10 10 4 13 13
0 4 0 0 2 6 2 76 0 0 0 60 0 0 0 100 100 100 90 55 30 55 30 52 90
52 90 70 11 44 13 85 100 76 88 58 40 0 33 44 13 31 15 93 96 65 57 60 0 0
0 0 0 0 0 0 0 0 0 0
ITSAM: 8
0 0 0 0 0 0 0 0 0 0 92 8 0 0 0 0 0 0 0 0 0 41 0 0 0
0 0 0 0 0 0 0 0 0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0 0
0 0 4 0 0 0 0 0 0 0 96 0 0 0 0 0 0 0 0 45 0 0 0 0 0
0 0 0 0 0 0 65 0 0 0 0 19 15 0 0 0 0 0 26 0 0 0 0 0 0
0 0 0 0 0 0 27 19 0 0 4 0 0 0 42 8 0 16 0 0 0 0 15 4 0
0 0 0 0 4 0 73 0 0 0 4 0 0 0 0 0 25 0 0 8 8 8 0 0 4
0 0 19 0 4 50 0 0 0 0 0 0 0 0 0 13 0 0 0 0 0 0 0 0 0
27 69 0 0 0 0 0 0 0 0 0 0 4 0 35 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 96 4 0 0 0 0 0 48 0 0 0 0 4 0 0 0 4 0 0
0 12 0 0 0 0 4 0 0 77 0 0 27 0 0 0 0 23 0 0 0 0 0 0 0
0 15 42 0 0 0 8 0 12 0 0 6 0 0 0 0 0 0 15 0 85 0 0 0 0
0 0 0 0 0 0 0 0 0 0 49 0 0 4 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 92 4 0 41 0 0 4 2 10 0 2 0 4 8 10 10 4 13 13
0 4 0 0 2 6 2 76 0 0 0 70 0 0 0 100 100 100 80 55 30 52 90 52 90
70 11 44 13 85 100 76 88 58 40 0 33 44 13 31 15 93 96 31 15 41 55 53 0 0
0 0 0 0 0 0 0 0 0 0
ITSAM: 9
0 0 0 0 0 0 0 0 0 0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0
0 0 0 4 0 0 0 0 0 0 0 96 0 0 0 0 0 0 0 0 45 0 0 0 0
0 0 0 0 0 0 0 65 0 0 0 0 19 15 0 0 0 0 0 26 0 0 0 0 0
0 0 0 0 0 0 0 27 19 0 0 4 0 0 0 42 8 0 16 0 0 0 0 15 4
0 0 0 0 0 4 0 73 0 0 0 4 0 0 0 0 0 25 0 0 8 8 8 0 0
4 0 0 19 0 4 50 0 0 0 0 0 0 0 0 0 13 0 0 0 0 0 0 0 0
0 27 69 0 0 0 0 0 0 0 0 0 0 4 0 35 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 96 4 0 0 0 0 0 48 0 0 0 0 4 0 0 0 4 0
0 0 12 0 0 0 0 4 0 0 77 0 0 27 0 0 0 0 23 0 0 0 0 0 0
0 0 15 42 0 0 0 8 0 12 0 0 6 0 0 0 0 0 0 15 0 85 0 0 0
0 0 0 0 0 0 0 0 0 0 0 49 0 0 4 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 92 4 0 41 0 0 42 0 8 0 0 0 0 0 31 0 0 19
0 0 0 0 0 0 0 0 0 19 0 0 4 2 10 0 2 0 4 8 10 10 4 13 13
0 4 0 0 2 6 2 76 0 0 0 80 0 0 0 100 100 100 70 52 90 52 90 70 11
44 13 85 100 76 88 58 40 0 33 44 13 31 15 93 96 31 15 76 88 68 52 73 0 0
0 0 0 0 0 0 0 0 0 0
ITSAM: 10
0 0 0 0 4 0 0 0 0 0 0 0 96 0 0 0 0 0 0 0 0 45 0 0 0
0 0 0 0 0 0 0 0 65 0 0 0 0 19 15 0 0 0 0 0 26 0 0 0 0
0 0 0 0 0 0 0 0 27 19 0 0 4 0 0 0 42 8 0 16 0 0 0 0 15
4 0 0 0 0 0 4 0 73 0 0 0 4 0 0 0 0 0 25 0 0 8 8 8 0
0 4 0 0 19 0 4 50 0 0 0 0 0 0 0 0 0 13 0 0 0 0 0 0 0
0 0 27 69 0 0 0 0 0 0 0 0 0 0 4 0 35 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 96 4 0 0 0 0 0 48 0 0 0 0 4 0 0 0 4
0 0 0 12 0 0 0 0 4 0 0 77 0 0 27 0 0 0 0 23 0 0 0 0 0
0 0 0 15 42 0 0 0 8 0 12 0 0 6 0 0 0 0 0 0 15 0 85 0 0
0 0 0 0 0 0 0 0 0 0 0 0 49 0 0 4 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 92 4 0 41 0 0 42 0 8 0 0 0 0 0 31 0 0
19 0 0 0 0 0 0 0 0 0 19 0 0 0 0 0 0 0 0 0 0 0 0 0 0
100 0 0 0 0 0 0 0 0 50 0 0 4 2 10 0 2 0 4 8 10 10 4 13 13
0 4 0 0 2 6 2 76 0 0 0 90 0 0 0 100 100 100 60 52 90 70 11 44 13
85 100 76 88 58 40 0 33 44 13 31 15 93 96 31 15 76 88 52 90 40 56 25 0 0
0 0 0 0 0 0 0 0 0 0
ITSAM: 11
0 0 0 0 0 0 0 0 0 65 0 0 0 0 19 15 0 0 0 0 0 26 0 0 0
0 0 0 0 0 0 0 0 0 27 19 0 0 4 0 0 0 42 8 0 16 0 0 0 0
15 4 0 0 0 0 0 4 0 73 0 0 0 4 0 0 0 0 0 25 0 0 8 8 8
0 0 4 0 0 19 0 4 50 0 0 0 0 0 0 0 0 0 13 0 0 0 0 0 0
0 0 0 27 69 0 0 0 0 0 0 0 0 0 0 4 0 35 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 96 4 0 0 0 0 0 48 0 0 0 0 4 0 0 0
4 0 0 0 12 0 0 0 0 4 0 0 77 0 0 27 0 0 0 0 23 0 0 0 0
0 0 0 0 15 42 0 0 0 8 0 12 0 0 6 0 0 0 0 0 0 15 0 85 0
0 0 0 0 0 0 0 0 0 0 0 0 0 49 0 0 4 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 92 4 0 41 0 0 42 0 8 0 0 0 0 0 31 0
0 19 0 0 0 0 0 0 0 0 0 19 0 0 0 0 0 0 0 0 0 0 0 0 0
0 100 0 0 0 0 0 0 0 0 50 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 100 0 0 0 0 0 0 50 0 0 4 2 10 0 2 0 4 8 10 10 4 13 13
0 4 0 0 2 6 2 76 0 0 0 100 0 0 0 100 100 100 50 70 11 44 13 85 100
76 88 58 40 0 33 44 13 31 15 93 96 31 15 76 88 52 90 0 33 60 44 68 0 0
0 0 0 0 0 0 0 0 0 0
ITSAM: 12
0 0 0 0 0 0 0 0 0 0 27 19 0 0 4 0 0 0 42 8 0 16 0 0 0
0 15 4 0 0 0 0 0 4 0 73 0 0 0 4 0 0 0 0 0 25 0 0 8 8
8 0 0 4 0 0 19 0 4 50 0 0 0 0 0 0 0 0 0 13 0 0 0 0 0
0 0 0 0 27 69 0 0 0 0 0 0 0 0 0 0 4 0 35 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 96 4 0 0 0 0 0 48 0 0 0 0 4 0 0
0 4 0 0 0 12 0 0 0 0 4 0 0 77 0 0 27 0 0 0 0 23 0 0 0
0 0 0 0 0 15 42 0 0 0 8 0 12 0 0 6 0 0 0 0 0 0 15 0 85
0 0 0 0 0 0 0 0 0 0 0 0 0 0 49 0 0 4 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 92 4 0 41 0 0 42 0 8 0 0 0 0 0 31
0 0 19 0 0 0 0 0 0 0 0 0 19 0 0 0 0 0 0 0 0 0 0 0 0
0 0 100 0 0 0 0 0 0 0 0 50 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 100 0 0 0 0 0 0 50 0 0 4 69 0 0 23 0 0 0 4 0 0 0
0 0 0 0 0 0 0 0 0 39 0 0 4 2 10 0 2 0 4 8 10 10 4 13 13
0 4 0 0 2 6 2 76 0 0 0 100 10 0 0 100 100 100 40 44 13 85 100 76 88
58 40 0 33 44 13 31 15 93 96 31 15 76 88 52 90 0 33 85 94 45 58 53 0 0
0 0 0 0 0 0 0 0 0 0
ITSAM: 13
0 0 15 4 0 0 0 0 0 4 0 73 0 0 0 4 0 0 0 0 0 25 0 0 8
8 8 0 0 4 0 0 19 0 4 50 0 0 0 0 0 0 0 0 0 13 0 0 0 0
0 0 0 0 0 27 69 0 0 0 0 0 0 0 0 0 0 4 0 35 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 96 4 0 0 0 0 0 48 0 0 0 0 4 0
0 0 4 0 0 0 12 0 0 0 0 4 0 0 77 0 0 27 0 0 0 0 23 0 0
0 0 0 0 0 0 15 42 0 0 0 8 0 12 0 0 6 0 0 0 0 0 0 15 0
85 0 0 0 0 0 0 0 0 0 0 0 0 0 0 49 0 0 4 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 92 4 0 41 0 0 42 0 8 0 0 0 0 0
31 0 0 19 0 0 0 0 0 0 0 0 0 19 0 0 0 0 0 0 0 0 0 0 0
0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 100 0 0 0 0 0 0 50 0 0 4 69 0 0 23 0 0 0 4 0 0
0 0 0 0 0 0 0 0 0 0 39 0 0 0 4 0 0 0 0 0 12 15 46 0 23
0 0 0 0 0 0 0 0 0 18 0 0 4 2 10 0 2 0 4 8 10 10 4 13 13
0 4 0 0 2 6 2 76 0 0 0 100 20 0 0 100 100 100 30 85 100 76 88 58 40
0 33 44 13 31 15 93 96 31 15 76 88 52 90 0 33 85 94 70 11 60 60 50 0 0
0 0 0 0 0 0 0 0 0 0
ITSAM: 14
8 8 8 0 0 4 0 0 19 0 4 50 0 0 0 0 0 0 0 0 0 13 0 0 0
0 0 0 0 0 0 27 69 0 0 0 0 0 0 0 0 0 0 4 0 35 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 96 4 0 0 0 0 0 48 0 0 0 0 4
0 0 0 4 0 0 0 12 0 0 0 0 4 0 0 77 0 0 27 0 0 0 0 23 0
0 0 0 0 0 0 0 15 42 0 0 0 8 0 12 0 0 6 0 0 0 0 0 0 15
0 85 0 0 0 0 0 0 0 0 0 0 0 0 0 0 49 0 0 4 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 92 4 0 41 0 0 42 0 8 0 0 0 0
0 31 0 0 19 0 0 0 0 0 0 0 0 0 19 0 0 0 0 0 0 0 0 0 0
0 0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 100 0 0 0 0 0 0 50 0 0 4 69 0 0 23 0 0 0 4 0
0 0 0 0 0 0 0 0 0 0 0 39 0 0 0 4 0 0 0 0 0 12 15 46 0
23 0 0 0 0 0 0 0 0 0 18 0 0 0 0 0 0 0 0 0 100 0 0 0 0
0 0 0 0 0 0 0 0 0 50 0 0 4 2 10 0 2 0 4 8 10 10 4 13 13
0 4 0 0 2 6 2 76 0 0 0 100 30 0 0 100 100 100 20 76 88 58 40 0 33
44 13 31 15 93 96 31 15 76 88 52 90 0 33 85 94 70 11 44 26 45 39 38 0 0
0 0 0 0 0 0 0 0 0 0
ITSAM: 15
0 0 0 0 0 0 0 27 69 0 0 0 0 0 0 0 0 0 0 4 0 35 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 96 4 0 0 0 0 0 48 0 0 0 0
4 0 0 0 4 0 0 0 12 0 0 0 0 4 0 0 77 0 0 27 0 0 0 0 23
0 0 0 0 0 0 0 0 15 42 0 0 0 8 0 12 0 0 6 0 0 0 0 0 0
15 0 85 0 0 0 0 0 0 0 0 0 0 0 0 0 0 49 0 0 4 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 92 4 0 41 0 0 42 0 8 0 0 0
0 0 31 0 0 19 0 0 0 0 0 0 0 0 0 19 0 0 0 0 0 0 0 0 0
0 0 0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 100 0 0 0 0 0 0 50 0 0 4 69 0 0 23 0 0 0 4
0 0 0 0 0 0 0 0 0 0 0 0 39 0 0 0 4 0 0 0 0 0 12 15 46
0 23 0 0 0 0 0 0 0 0 0 18 0 0 0 0 0 0 0 0 0 100 0 0 0
0 0 0 0 0 0 0 0 0 0 50 0 0 0 0 0 0 0 0 0 23 12 0 4 57
4 0 0 0 0 0 0 0 0 24 0 3 4 2 10 0 2 0 4 8 10 10 4 13 13
0 4 0 0 2 6 2 76 0 0 0 100 40 0 0 100 100 100 10 58 40 0 33 44 13
31 15 93 96 31 15 76 88 52 90 0 33 85 94 70 11 44 26 55 30 56 61 63 0 0
0 0 0 0 0 0 0 0 0 0
ITSAM: 16
0 0 0 0 0 0 0 0 0 0 0 0 0 0 96 4 0 0 0 0 0 48 0 0 0
0 4 0 0 0 4 0 0 0 12 0 0 0 0 4 0 0 77 0 0 27 0 0 0 0
23 0 0 0 0 0 0 0 0 15 42 0 0 0 8 0 12 0 0 6 0 0 0 0 0
0 15 0 85 0 0 0 0 0 0 0 0 0 0 0 0 0 0 49 0 0 4 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 92 4 0 41 0 0 42 0 8 0 0
0 0 0 31 0 0 19 0 0 0 0 0 0 0 0 0 19 0 0 0 0 0 0 0 0
0 0 0 0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 100 0 0 0 0 0 0 50 0 0 4 69 0 0 23 0 0 0
4 0 0 0 0 0 0 0 0 0 0 0 0 39 0 0 0 4 0 0 0 0 0 12 15
46 0 23 0 0 0 0 0 0 0 0 0 18 0 0 0 0 0 0 0 0 0 100 0 0
0 0 0 0 0 0 0 0 0 0 0 50 0 0 0 0 0 0 0 0 0 23 12 0 4
57 4 0 0 0 0 0 0 0 0 24 0 3 0 0 4 0 0 0 0 0 4 54 35 4
0 0 0 0 0 0 0 0 0 23 0 0 4 2 10 0 2 0 4 8 10 10 4 13 13
0 4 0 0 2 6 2 76 0 0 0 100 50 0 0 100 100 100 0 0 33 44 13 31 15
93 96 31 15 76 88 52 90 0 33 85 94 70 11 44 26 55 30 70 11 44 57 42 0 0
0 0 0 0 0 0 0 0 0 0
ITSAM: 17
0 0 4 0 0 0 4 0 0 0 12 0 0 0 0 4 0 0 77 0 0 27 0 0 0
0 23 0 0 0 0 0 0 0 0 15 42 0 0 0 8 0 12 0 0 6 0 0 0 0
0 0 15 0 85 0 0 0 0 0 0 0 0 0 0 0 0 0 0 49 0 0 4 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 92 4 0 41 0 0 42 0 8 0
0 0 0 0 31 0 0 19 0 0 0 0 0 0 0 0 0 19 0 0 0 0 0 0 0
0 0 0 0 0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 100 0 0 0 0 0 0 50 0 0 4 69 0 0 23 0 0
0 4 0 0 0 0 0 0 0 0 0 0 0 0 39 0 0 0 4 0 0 0 0 0 12
15 46 0 23 0 0 0 0 0 0 0 0 0 18 0 0 0 0 0 0 0 0 0 100 0
0 0 0 0 0 0 0 0 0 0 0 0 50 0 0 0 0 0 0 0 0 0 23 12 0
4 57 4 0 0 0 0 0 0 0 0 24 0 3 0 0 4 0 0 0 0 0 4 54 35
4 0 0 0 0 0 0 0 0 0 23 0 0 0 0 4 8 0 0 0 0 0 0 4 0
4 0 62 0 4 15 0 0 0 13 0 3 4 2 10 0 2 0 4 8 10 10 4 13 13
0 4 0 0 2 6 2 76 0 0 0 100 60 0 0 100 100 90 0 44 13 31 15 93 96
31 15 76 88 52 90 0 33 85 94 70 11 44 26 55 30 70 11 28 5 52 29 49 0 0
0 0 0 0 0 0 0 0 0 0
ITSAM: 18
0 0 23 0 0 0 0 0 0 0 0 15 42 0 0 0 8 0 12 0 0 6 0 0 0
0 0 0 15 0 85 0 0 0 0 0 0 0 0 0 0 0 0 0 0 49 0 0 4 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 92 4 0 41 0 0 42 0 8
0 0 0 0 0 31 0 0 19 0 0 0 0 0 0 0 0 0 19 0 0 0 0 0 0
0 0 0 0 0 0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 100 0 0 0 0 0 0 50 0 0 4 69 0 0 23 0
0 0 4 0 0 0 0 0 0 0 0 0 0 0 0 39 0 0 0 4 0 0 0 0 0
12 15 46 0 23 0 0 0 0 0 0 0 0 0 18 0 0 0 0 0 0 0 0 0 100
0 0 0 0 0 0 0 0 0 0 0 0 0 50 0 0 0 0 0 0 0 0 0 23 12
0 4 57 4 0 0 0 0 0 0 0 0 24 0 3 0 0 4 0 0 0 0 0 4 54
35 4 0 0 0 0 0 0 0 0 0 23 0 0 0 0 4 8 0 0 0 0 0 0 4
0 4 0 62 0 4 15 0 0 0 13 0 3 0 0 0 0 0 0 0 4 12 62 0 12
0 0 0 0 0 12 0 0 0 22 0 0 4 2 10 0 2 0 4 8 10 10 4 13 13
0 4 0 0 2 6 2 76 0 0 0 100 70 0 0 100 100 80 0 31 15 93 96 31 15
76 88 52 90 0 33 85 94 70 11 44 26 55 30 70 11 28 5 58 40 53 61 62 0 0
0 0 0 0 0 0 0 0 100 0
ITSAM: 19
0 0 0 0 15 0 85 0 0 0 0 0 0 0 0 0 0 0 0 0 0 49 0 0 4
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 92 4 0 41 0 0 42 0
8 0 0 0 0 0 31 0 0 19 0 0 0 0 0 0 0 0 0 19 0 0 0 0 0
0 0 0 0 0 0 0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 100 0 0 0 0 0 0 50 0 0 4 69 0 0 23
0 0 0 4 0 0 0 0 0 0 0 0 0 0 0 0 39 0 0 0 4 0 0 0 0
0 12 15 46 0 23 0 0 0 0 0 0 0 0 0 18 0 0 0 0 0 0 0 0 0
100 0 0 0 0 0 0 0 0 0 0 0 0 0 50 0 0 0 0 0 0 0 0 0 23
12 0 4 57 4 0 0 0 0 0 0 0 0 24 0 3 0 0 4 0 0 0 0 0 4
54 35 4 0 0 0 0 0 0 0 0 0 23 0 0 0 0 4 8 0 0 0 0 0 0
4 0 4 0 62 0 4 15 0 0 0 13 0 3 0 0 0 0 0 0 0 4 12 62 0
12 0 0 0 0 0 12 0 0 0 22 0 0 50 12 15 0 0 0 0 0 0 0 4 12
0 0 4 0 0 0 4 0 0 20 0 0 4 2 10 0 2 0 4 8 10 10 4 13 13
0 4 0 0 2 6 2 76 0 0 0 100 80 0 0 100 100 70 0 93 96 31 15 76 88
52 90 0 33 85 94 70 11 44 26 55 30 70 11 28 5 58 40 85 100 58 74 58 0 0
0 0 0 0 0 0 0 0 0 0
ITSAM: 20
4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 92 4 0 41 0 0 42
0 8 0 0 0 0 0 31 0 0 19 0 0 0 0 0 0 0 0 0 19 0 0 0 0
0 0 0 0 0 0 0 0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 100 0 0 0 0 0 0 50 0 0 4 69 0 0
23 0 0 0 4 0 0 0 0 0 0 0 0 0 0 0 0 39 0 0 0 4 0 0 0
0 0 12 15 46 0 23 0 0 0 0 0 0 0 0 0 18 0 0 0 0 0 0 0 0
0 100 0 0 0 0 0 0 0 0 0 0 0 0 0 50 0 0 0 0 0 0 0 0 0
23 12 0 4 57 4 0 0 0 0 0 0 0 0 24 0 3 0 0 4 0 0 0 0 0
4 54 35 4 0 0 0 0 0 0 0 0 0 23 0 0 0 0 4 8 0 0 0 0 0
0 4 0 4 0 62 0 4 15 0 0 0 13 0 3 0 0 0 0 0 0 0 4 12 62
0 12 0 0 0 0 0 12 0 0 0 22 0 0 50 12 15 0 0 0 0 0 0 0 4
12 0 0 4 0 0 0 4 0 0 20 0 0 0 0 0 0 0 0 0 0 0 0 0 0
100 0 0 0 0 0 0 0 0 50 0 0 4 2 10 0 2 0 4 8 10 10 4 13 13
0 4 0 0 2 6 2 76 0 0 0 100 90 0 0 100 100 60 0 31 15 76 88 52 90
0 33 85 94 70 11 44 26 55 30 70 11 28 5 58 40 85 100 52 90 56 31 51 0 0
0 0 0 0 0 0 0 0 0 0
ITSAM: 21
42 0 8 0 0 0 0 0 31 0 0 19 0 0 0 0 0 0 0 0 0 19 0 0 0
0 0 0 0 0 0 0 0 0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 100 0 0 0 0 0 0 50 0 0 4 69 0
0 23 0 0 0 4 0 0 0 0 0 0 0 0 0 0 0 0 39 0 0 0 4 0 0
0 0 0 12 15 46 0 23 0 0 0 0 0 0 0 0 0 18 0 0 0 0 0 0 0
0 0 100 0 0 0 0 0 0 0 0 0 0 0 0 0 50 0 0 0 0 0 0 0 0
0 23 12 0 4 57 4 0 0 0 0 0 0 0 0 24 0 3 0 0 4 0 0 0 0
0 4 54 35 4 0 0 0 0 0 0 0 0 0 23 0 0 0 0 4 8 0 0 0 0
0 0 4 0 4 0 62 0 4 15 0 0 0 13 0 3 0 0 0 0 0 0 0 4 12
62 0 12 0 0 0 0 0 12 0 0 0 22 0 0 50 12 15 0 0 0 0 0 0 0
4 12 0 0 4 0 0 0 4 0 0 20 0 0 0 0 0 0 0 0 0 0 0 0 0
0 100 0 0 0 0 0 0 0 0 50 0 0 0 0 4 0 0 0 0 0 96 0 0 0
0 0 0 0 0 0 0 0 0 44 0 0 4 2 10 0 2 0 4 8 10 10 4 13 13
0 4 0 0 2 6 2 76 0 0 0 100 100 0 0 100 100 50 0 76 88 52 90 0 33
85 94 70 11 44 26 55 30 70 11 28 5 58 40 85 100 52 90 58 40 53 66 46 0 0
0 0 0 0 0 0 0 0 0 0
ITSAM: 22
0 0 0 0 0 0 0 0 0 0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 100 0 0 0 0 0 0 50 0 0 4 69
0 0 23 0 0 0 4 0 0 0 0 0 0 0 0 0 0 0 0 39 0 0 0 4 0
0 0 0 0 12 15 46 0 23 0 0 0 0 0 0 0 0 0 18 0 0 0 0 0 0
0 0 0 100 0 0 0 0 0 0 0 0 0 0 0 0 0 50 0 0 0 0 0 0 0
0 0 23 12 0 4 57 4 0 0 0 0 0 0 0 0 24 0 3 0 0 4 0 0 0
0 0 4 54 35 4 0 0 0 0 0 0 0 0 0 23 0 0 0 0 4 8 0 0 0
0 0 0 4 0 4 0 62 0 4 15 0 0 0 13 0 3 0 0 0 0 0 0 0 4
12 62 0 12 0 0 0 0 0 12 0 0 0 22 0 0 50 12 15 0 0 0 0 0 0
0 4 12 0 0 4 0 0 0 4 0 0 20 0 0 0 0 0 0 0 0 0 0 0 0
0 0 100 0 0 0 0 0 0 0 0 50 0 0 0 0 4 0 0 0 0 0 96 0 0
0 0 0 0 0 0 0 0 0 0 44 0 0 0 0 0 0 0 0 0 8 27 0 19 23
0 0 4 15 0 0 4 0 0 12 0 0 4 2 10 0 2 0 4 8 10 10 4 13 13
0 4 0 0 2 6 2 76 0 0 0 100 100 10 0 100 100 40 0 52 90 0 33 85 94
70 11 44 26 55 30 70 11 28 5 58 40 85 100 52 90 58 40 55 30 59 66 69 0 0
0 0 0 0 0 0 0 0 0 0
ITSAM: 23
0 0 0 0 0 0 0 0 0 0 0 0 0 0 100 0 0 0 0 0 0 50 0 0 4
69 0 0 23 0 0 0 4 0 0 0 0 0 0 0 0 0 0 0 0 39 0 0 0 4
0 0 0 0 0 12 15 46 0 23 0 0 0 0 0 0 0 0 0 18 0 0 0 0 0
0 0 0 0 100 0 0 0 0 0 0 0 0 0 0 0 0 0 50 0 0 0 0 0 0
0 0 0 23 12 0 4 57 4 0 0 0 0 0 0 0 0 24 0 3 0 0 4 0 0
0 0 0 4 54 35 4 0 0 0 0 0 0 0 0 0 23 0 0 0 0 4 8 0 0
0 0 0 0 4 0 4 0 62 0 4 15 0 0 0 13 0 3 0 0 0 0 0 0 0
4 12 62 0 12 0 0 0 0 0 12 0 0 0 22 0 0 50 12 15 0 0 0 0 0
0 0 4 12 0 0 4 0 0 0 4 0 0 20 0 0 0 0 0 0 0 0 0 0 0
0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0 0 4 0 0 0 0 0 96 0
0 0 0 0 0 0 0 0 0 0 0 44 0 0 0 0 0 0 0 0 0 8 27 0 19
23 0 0 4 15 0 0 4 0 0 12 0 0 0 38 8 0 0 0 12 0 15 0 0 15
0 0 4 4 0 0 0 4 0 5 0 0 4 2 10 0 2 0 4 8 10 10 4 13 13
0 4 0 0 2 6 2 76 0 0 0 100 100 20 0 100 100 30 0 0 33 85 94 70 11
44 26 55 30 70 11 28 5 58 40 85 100 52 90 58 40 55 30 78 64 53 40 52 0 0
0 0 100 0 0 0 0 0 0 0
ITSAM: 24
4 69 0 0 23 0 0 0 4 0 0 0 0 0 0 0 0 0 0 0 0 39 0 0 0
4 0 0 0 0 0 12 15 46 0 23 0 0 0 0 0 0 0 0 0 18 0 0 0 0
0 0 0 0 0 100 0 0 0 0 0 0 0 0 0 0 0 0 0 50 0 0 0 0 0
0 0 0 0 23 12 0 4 57 4 0 0 0 0 0 0 0 0 24 0 3 0 0 4 0
0 0 0 0 4 54 35 4 0 0 0 0 0 0 0 0 0 23 0 0 0 0 4 8 0
0 0 0 0 0 4 0 4 0 62 0 4 15 0 0 0 13 0 3 0 0 0 0 0 0
0 4 12 62 0 12 0 0 0 0 0 12 0 0 0 22 0 0 50 12 15 0 0 0 0
0 0 0 4 12 0 0 4 0 0 0 4 0 0 20 0 0 0 0 0 0 0 0 0 0
0 0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0 0 4 0 0 0 0 0 96
0 0 0 0 0 0 0 0 0 0 0 0 44 0 0 0 0 0 0 0 0 0 8 27 0
19 23 0 0 4 15 0 0 4 0 0 12 0 0 0 38 8 0 0 0 12 0 15 0 0
15 0 0 4 4 0 0 0 4 0 5 0 0 0 0 0 0 0 0 0 0 0 0 46 12
42 0 0 0 0 0 0 0 0 26 0 0 4 2 10 0 2 0 4 8 10 10 4 13 13
0 4 0 0 2 6 2 76 0 0 0 100 100 30 0 100 100 20 0 85 94 70 11 44 26
55 30 70 11 28 5 58 40 85 100 52 90 58 40 55 30 78 64 55 30 59 62 52 0 0
0 0 0 0 0 0 0 0 0 0
ITSAM: 25
0 4 0 0 0 0 0 12 15 46 0 23 0 0 0 0 0 0 0 0 0 18 0 0 0
0 0 0 0 0 0 100 0 0 0 0 0 0 0 0 0 0 0 0 0 50 0 0 0 0
0 0 0 0 0 23 12 0 4 57 4 0 0 0 0 0 0 0 0 24 0 3 0 0 4
0 0 0 0 0 4 54 35 4 0 0 0 0 0 0 0 0 0 23 0 0 0 0 4 8
0 0 0 0 0 0 4 0 4 0 62 0 4 15 0 0 0 13 0 3 0 0 0 0 0
0 0 4 12 62 0 12 0 0 0 0 0 12 0 0 0 22 0 0 50 12 15 0 0 0
0 0 0 0 4 12 0 0 4 0 0 0 4 0 0 20 0 0 0 0 0 0 0 0 0
0 0 0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0 0 4 0 0 0 0 0
96 0 0 0 0 0 0 0 0 0 0 0 0 44 0 0 0 0 0 0 0 0 0 8 27
0 19 23 0 0 4 15 0 0 4 0 0 12 0 0 0 38 8 0 0 0 12 0 15 0
0 15 0 0 4 4 0 0 0 4 0 5 0 0 0 0 0 0 0 0 0 0 0 0 46
12 42 0 0 0 0 0 0 0 0 26 0 0 0 0 0 0 0 0 0 69 0 0 0 0
0 0 8 0 0 4 0 19 0 30 0 0 4 2 10 0 2 0 4 8 10 10 4 13 13
0 4 0 0 2 6 2 76 0 0 0 100 100 40 0 100 100 10 0 70 11 44 26 55 30
70 11 28 5 58 40 85 100 52 90 58 40 55 30 78 64 55 30 44 26 59 64 72 0 0
0 0 0 0 0 0 0 0 0 0
ITSAM: 26
0 0 0 0 0 0 0 100 0 0 0 0 0 0 0 0 0 0 0 0 0 50 0 0 0
0 0 0 0 0 0 23 12 0 4 57 4 0 0 0 0 0 0 0 0 24 0 3 0 0
4 0 0 0 0 0 4 54 35 4 0 0 0 0 0 0 0 0 0 23 0 0 0 0 4
8 0 0 0 0 0 0 4 0 4 0 62 0 4 15 0 0 0 13 0 3 0 0 0 0
0 0 0 4 12 62 0 12 0 0 0 0 0 12 0 0 0 22 0 0 50 12 15 0 0
0 0 0 0 0 4 12 0 0 4 0 0 0 4 0 0 20 0 0 0 0 0 0 0 0
0 0 0 0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0 0 4 0 0 0 0
0 96 0 0 0 0 0 0 0 0 0 0 0 0 44 0 0 0 0 0 0 0 0 0 8
27 0 19 23 0 0 4 15 0 0 4 0 0 12 0 0 0 38 8 0 0 0 12 0 15
0 0 15 0 0 4 4 0 0 0 4 0 5 0 0 0 0 0 0 0 0 0 0 0 0
46 12 42 0 0 0 0 0 0 0 0 26 0 0 0 0 0 0 0 0 0 69 0 0 0
0 0 0 8 0 0 4 0 19 0 30 0 0 0 0 0 0 0 0 0 0 0 0 0 0
100 0 0 0 0 0 0 0 0 50 0 0 4 2 10 0 2 0 4 8 10 10 4 13 13
0 4 0 0 2 6 2 76 0 0 0 100 100 50 0 100 100 0 0 44 26 55 30 70 11
28 5 58 40 85 100 52 90 58 40 55 30 78 64 55 30 44 26 52 90 55 50 59 0 0
0 0 0 0 0 0 0 0 0 0
ITSAM: 27
0 0 0 0 0 0 0 23 12 0 4 57 4 0 0 0 0 0 0 0 0 24 0 3 0
0 4 0 0 0 0 0 4 54 35 4 0 0 0 0 0 0 0 0 0 23 0 0 0 0
4 8 0 0 0 0 0 0 4 0 4 0 62 0 4 15 0 0 0 13 0 3 0 0 0
0 0 0 0 4 12 62 0 12 0 0 0 0 0 12 0 0 0 22 0 0 50 12 15 0
0 0 0 0 0 0 4 12 0 0 4 0 0 0 4 0 0 20 0 0 0 0 0 0 0
0 0 0 0 0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0 0 4 0 0 0
0 0 96 0 0 0 0 0 0 0 0 0 0 0 0 44 0 0 0 0 0 0 0 0 0
8 27 0 19 23 0 0 4 15 0 0 4 0 0 12 0 0 0 38 8 0 0 0 12 0
15 0 0 15 0 0 4 4 0 0 0 4 0 5 0 0 0 0 0 0 0 0 0 0 0
0 46 12 42 0 0 0 0 0 0 0 0 26 0 0 0 0 0 0 0 0 0 69 0 0
0 0 0 0 8 0 0 4 0 19 0 30 0 0 0 0 0 0 0 0 0 0 0 0 0
0 100 0 0 0 0 0 0 0 0 50 0 0 0 0 23 0 0 0 0 0 0 0 0 0
0 0 0 77 0 0 0 0 0 23 0 0 4 2 10 0 2 0 4 8 10 10 4 13 13
0 4 0 0 2 6 2 76 0 0 0 100 100 60 0 100 90 0 0 55 30 70 11 28 5
58 40 85 100 52 90 58 40 55 30 78 64 55 30 44 26 52 90 85 100 61 62 43 0 0
0 0 0 0 0 0 0 0 0 0
ITSAM: 28
0 0 4 0 0 0 0 0 4 54 35 4 0 0 0 0 0 0 0 0 0 23 0 0 0
0 4 8 0 0 0 0 0 0 4 0 4 0 62 0 4 15 0 0 0 13 0 3 0 0
0 0 0 0 0 4 12 62 0 12 0 0 0 0 0 12 0 0 0 22 0 0 50 12 15
0 0 0 0 0 0 0 4 12 0 0 4 0 0 0 4 0 0 20 0 0 0 0 0 0
0 0 0 0 0 0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0 0 4 0 0
0 0 0 96 0 0 0 0 0 0 0 0 0 0 0 0 44 0 0 0 0 0 0 0 0
0 8 27 0 19 23 0 0 4 15 0 0 4 0 0 12 0 0 0 38 8 0 0 0 12
0 15 0 0 15 0 0 4 4 0 0 0 4 0 5 0 0 0 0 0 0 0 0 0 0
0 0 46 12 42 0 0 0 0 0 0 0 0 26 0 0 0 0 0 0 0 0 0 69 0
0 0 0 0 0 8 0 0 4 0 19 0 30 0 0 0 0 0 0 0 0 0 0 0 0
0 0 100 0 0 0 0 0 0 0 0 50 0 0 0 0 23 0 0 0 0 0 0 0 0
0 0 0 0 77 0 0 0 0 0 23 0 0 0 0 92 0 0 0 0 0 0 0 0 4
0 4 0 0 0 0 0 0 0 39 0 0 4 2 10 0 2 0 4 8 10 10 4 13 13
0 4 0 0 2 6 2 76 0 0 0 100 100 70 0 100 80 0 0 70 11 28 5 58 40
85 100 52 90 58 40 55 30 78 64 55 30 44 26 52 90 85 100 85 100 61 67 55 0 0
0 0 0 0 0 0 0 0 0 0
ITSAM: 29
0 0 4 8 0 0 0 0 0 0 4 0 4 0 62 0 4 15 0 0 0 13 0 3 0
0 0 0 0 0 0 4 12 62 0 12 0 0 0 0 0 12 0 0 0 22 0 0 50 12
15 0 0 0 0 0 0 0 4 12 0 0 4 0 0 0 4 0 0 20 0 0 0 0 0
0 0 0 0 0 0 0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0 0 4 0
0 0 0 0 96 0 0 0 0 0 0 0 0 0 0 0 0 44 0 0 0 0 0 0 0
0 0 8 27 0 19 23 0 0 4 15 0 0 4 0 0 12 0 0 0 38 8 0 0 0
12 0 15 0 0 15 0 0 4 4 0 0 0 4 0 5 0 0 0 0 0 0 0 0 0
0 0 0 46 12 42 0 0 0 0 0 0 0 0 26 0 0 0 0 0 0 0 0 0 69
0 0 0 0 0 0 8 0 0 4 0 19 0 30 0 0 0 0 0 0 0 0 0 0 0
0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0 0 23 0 0 0 0 0 0 0
0 0 0 0 0 77 0 0 0 0 0 23 0 0 0 0 92 0 0 0 0 0 0 0 0
4 0 4 0 0 0 0 0 0 0 39 0 0 4 12 81 0 0 0 0 0 0 0 0 0
0 0 0 0 4 0 0 0 0 38 0 0 4 2 10 0 2 0 4 8 10 10 4 13 13
0 4 0 0 2 6 2 76 0 0 0 100 100 80 0 100 70 0 0 28 5 58 40 85 100
52 90 58 40 55 30 78 64 55 30 44 26 52 90 85 100 85 100 85 100 66 59 82 0 0
0 0 0 0 0 0 0 0 0 0
ITSAM: 30
0 0 0 0 0 0 0 4 12 62 0 12 0 0 0 0 0 12 0 0 0 22 0 0 50
12 15 0 0 0 0 0 0 0 4 12 0 0 4 0 0 0 4 0 0 20 0 0 0 0
0 0 0 0 0 0 0 0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0 0 4
0 0 0 0 0 96 0 0 0 0 0 0 0 0 0 0 0 0 44 0 0 0 0 0 0
0 0 0 8 27 0 19 23 0 0 4 15 0 0 4 0 0 12 0 0 0 38 8 0 0
0 12 0 15 0 0 15 0 0 4 4 0 0 0 4 0 5 0 0 0 0 0 0 0 0
0 0 0 0 46 12 42 0 0 0 0 0 0 0 0 26 0 0 0 0 0 0 0 0 0
69 0 0 0 0 0 0 8 0 0 4 0 19 0 30 0 0 0 0 0 0 0 0 0 0
0 0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0 0 23 0 0 0 0 0 0
0 0 0 0 0 0 77 0 0 0 0 0 23 0 0 0 0 92 0 0 0 0 0 0 0
0 4 0 4 0 0 0 0 0 0 0 39 0 0 4 12 81 0 0 0 0 0 0 0 0
0 0 0 0 0 4 0 0 0 0 38 0 0 0 0 0 0 0 0 0 0 0 12 77 8
0 0 0 0 0 0 0 4 0 31 0 0 4 2 10 0 2 0 4 8 10 10 4 13 13
0 4 0 0 2 6 2 76 0 0 0 100 100 90 0 100 60 0 0 58 40 85 100 52 90
58 40 55 30 78 64 55 30 44 26 52 90 85 100 85 100 85 100 70 11 61 65 64 0 0
0 0 0 0 0 0 0 0 0 0
ITSAM: 31
50 12 15 0 0 0 0 0 0 0 4 12 0 0 4 0 0 0 4 0 0 20 0 0 0
0 0 0 0 0 0 0 0 0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0 0
4 0 0 0 0 0 96 0 0 0 0 0 0 0 0 0 0 0 0 44 0 0 0 0 0
0 0 0 0 8 27 0 19 23 0 0 4 15 0 0 4 0 0 12 0 0 0 38 8 0
0 0 12 0 15 0 0 15 0 0 4 4 0 0 0 4 0 5 0 0 0 0 0 0 0
0 0 0 0 0 46 12 42 0 0 0 0 0 0 0 0 26 0 0 0 0 0 0 0 0
0 69 0 0 0 0 0 0 8 0 0 4 0 19 0 30 0 0 0 0 0 0 0 0 0
0 0 0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0 0 23 0 0 0 0 0
0 0 0 0 0 0 0 77 0 0 0 0 0 23 0 0 0 0 92 0 0 0 0 0 0
0 0 4 0 4 0 0 0 0 0 0 0 39 0 0 4 12 81 0 0 0 0 0 0 0
0 0 0 0 0 0 4 0 0 0 0 38 0 0 0 0 0 0 0 0 0 0 0 12 77
8 0 0 0 0 0 0 0 4 0 31 0 0 12 0 0 0 0 0 0 62 8 0 12 4
0 0 0 0 0 0 0 4 0 25 0 0 4 2 10 0 2 0 4 8 10 10 4 13 13
0 4 0 0 2 6 2 76 0 0 0 100 100 100 0 100 50 0 0 85 100 52 90 58 40
55 30 78 64 55 30 44 26 52 90 85 100 85 100 85 100 70 11 44 26 68 62 62 0 0
0 0 0 0 0 0 0 0 0 0
ITSAM: 32
0 0 0 0 0 0 0 0 0 0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0
0 4 0 0 0 0 0 96 0 0 0 0 0 0 0 0 0 0 0 0 44 0 0 0 0
0 0 0 0 0 8 27 0 19 23 0 0 4 15 0 0 4 0 0 12 0 0 0 38 8
0 0 0 12 0 15 0 0 15 0 0 4 4 0 0 0 4 0 5 0 0 0 0 0 0
0 0 0 0 0 0 46 12 42 0 0 0 0 0 0 0 0 26 0 0 0 0 0 0 0
0 0 69 0 0 0 0 0 0 8 0 0 4 0 19 0 30 0 0 0 0 0 0 0 0
0 0 0 0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0 0 23 0 0 0 0
0 0 0 0 0 0 0 0 77 0 0 0 0 0 23 0 0 0 0 92 0 0 0 0 0
0 0 0 4 0 4 0 0 0 0 0 0 0 39 0 0 4 12 81 0 0 0 0 0 0
0 0 0 0 0 0 0 4 0 0 0 0 38 0 0 0 0 0 0 0 0 0 0 0 12
77 8 0 0 0 0 0 0 0 4 0 31 0 0 12 0 0 0 0 0 0 62 8 0 12
4 0 0 0 0 0 0 0 4 0 25 0 0 0 0 0 0 0 0 0 15 12 15 27 31
0 0 0 0 0 0 0 0 0 17 0 0 4 2 10 0 2 0 4 8 10 10 4 13 13
0 4 0 0 2 6 2 76 0 0 0 100 100 100 10 100 40 0 0 52 90 58 40 55 30
78 64 55 30 44 26 52 90 85 100 85 100 85 100 70 11 44 26 58 40 61 65 59 0 0
0 0 0 0 0 0 0 0 0 0
ITSAM: 33
0 0 4 0 0 0 0 0 96 0 0 0 0 0 0 0 0 0 0 0 0 44 0 0 0
0 0 0 0 0 0 8 27 0 19 23 0 0 4 15 0 0 4 0 0 12 0 0 0 38
8 0 0 0 12 0 15 0 0 15 0 0 4 4 0 0 0 4 0 5 0 0 0 0 0
0 0 0 0 0 0 0 46 12 42 0 0 0 0 0 0 0 0 26 0 0 0 0 0 0
0 0 0 69 0 0 0 0 0 0 8 0 0 4 0 19 0 30 0 0 0 0 0 0 0
0 0 0 0 0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0 0 23 0 0 0
0 0 0 0 0 0 0 0 0 77 0 0 0 0 0 23 0 0 0 0 92 0 0 0 0
0 0 0 0 4 0 4 0 0 0 0 0 0 0 39 0 0 4 12 81 0 0 0 0 0
0 0 0 0 0 0 0 0 4 0 0 0 0 38 0 0 0 0 0 0 0 0 0 0 0
12 77 8 0 0 0 0 0 0 0 4 0 31 0 0 12 0 0 0 0 0 0 62 8 0
12 4 0 0 0 0 0 0 0 4 0 25 0 0 0 0 0 0 0 0 0 15 12 15 27
31 0 0 0 0 0 0 0 0 0 17 0 0 0 0 0 0 0 0 0 4 0 0 0 50
0 0 0 35 4 0 8 0 0 18 0 0 4 2 10 0 2 0 4 8 10 10 4 13 13
0 4 0 0 2 6 2 76 0 0 0 100 100 100 20 100 30 0 0 58 40 55 30 78 64
55 30 44 26 52 90 85 100 85 100 85 100 70 11 44 26 58 40 55 30 64 64 69 0 0
0 0 0 0 0 0 0 0 0 0
ITSAM: 34
0 0 0 0 0 0 0 8 27 0 19 23 0 0 4 15 0 0 4 0 0 12 0 0 0
38 8 0 0 0 12 0 15 0 0 15 0 0 4 4 0 0 0 4 0 5 0 0 0 0
0 0 0 0 0 0 0 0 46 12 42 0 0 0 0 0 0 0 0 26 0 0 0 0 0
0 0 0 0 69 0 0 0 0 0 0 8 0 0 4 0 19 0 30 0 0 0 0 0 0
0 0 0 0 0 0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0 0 23 0 0
0 0 0 0 0 0 0 0 0 0 77 0 0 0 0 0 23 0 0 0 0 92 0 0 0
0 0 0 0 0 4 0 4 0 0 0 0 0 0 0 39 0 0 4 12 81 0 0 0 0
0 0 0 0 0 0 0 0 0 4 0 0 0 0 38 0 0 0 0 0 0 0 0 0 0
0 12 77 8 0 0 0 0 0 0 0 4 0 31 0 0 12 0 0 0 0 0 0 62 8
0 12 4 0 0 0 0 0 0 0 4 0 25 0 0 0 0 0 0 0 0 0 15 12 15
27 31 0 0 0 0 0 0 0 0 0 17 0 0 0 0 0 0 0 0 0 4 0 0 0
50 0 0 0 35 4 0 8 0 0 18 0 0 0 0 0 0 0 0 0 0 0 0 0 0
100 0 0 0 0 0 0 0 0 50 0 0 4 2 10 0 2 0 4 8 10 10 4 13 13
0 4 0 0 2 6 2 76 0 0 0 100 100 100 30 100 20 0 0 55 30 78 64 55 30
44 26 52 90 85 100 85 100 85 100 70 11 44 26 58 40 55 30 52 90 61 56 66 0 0
0 0 0 0 0 0 0 0 0 0
ITSAM: 35
0 38 8 0 0 0 12 0 15 0 0 15 0 0 4 4 0 0 0 4 0 5 0 0 0
0 0 0 0 0 0 0 0 0 46 12 42 0 0 0 0 0 0 0 0 26 0 0 0 0
0 0 0 0 0 69 0 0 0 0 0 0 8 0 0 4 0 19 0 30 0 0 0 0 0
0 0 0 0 0 0 0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0 0 23 0
0 0 0 0 0 0 0 0 0 0 0 77 0 0 0 0 0 23 0 0 0 0 92 0 0
0 0 0 0 0 0 4 0 4 0 0 0 0 0 0 0 39 0 0 4 12 81 0 0 0
0 0 0 0 0 0 0 0 0 0 4 0 0 0 0 38 0 0 0 0 0 0 0 0 0
0 0 12 77 8 0 0 0 0 0 0 0 4 0 31 0 0 12 0 0 0 0 0 0 62
8 0 12 4 0 0 0 0 0 0 0 4 0 25 0 0 0 0 0 0 0 0 0 15 12
15 27 31 0 0 0 0 0 0 0 0 0 17 0 0 0 0 0 0 0 0 0 4 0 0
0 50 0 0 0 35 4 0 8 0 0 18 0 0 0 0 0 0 0 0 0 0 0 0 0
0 100 0 0 0 0 0 0 0 0 50 0 0 0 0 0 0 0 0 0 0 0 92 0 0
0 0 0 4 0 0 0 4 0 42 0 0 4 2 10 0 2 0 4 8 10 10 4 13 13
0 4 0 0 2 6 2 76 0 0 0 100 100 100 40 100 10 0 0 78 64 55 30 44 26
52 90 85 100 85 100 85 100 70 11 44 26 58 40 55 30 52 90 70 11 65 68 61 0 0
0 0 0 0 0 0 0 0 0 0
ITSAM: 36
0 0 0 0 0 0 0 0 0 0 46 12 42 0 0 0 0 0 0 0 0 26 0 0 0
0 0 0 0 0 0 69 0 0 0 0 0 0 8 0 0 4 0 19 0 30 0 0 0 0
0 0 0 0 0 0 0 0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0 0 23
0 0 0 0 0 0 0 0 0 0 0 0 77 0 0 0 0 0 23 0 0 0 0 92 0
0 0 0 0 0 0 0 4 0 4 0 0 0 0 0 0 0 39 0 0 4 12 81 0 0
0 0 0 0 0 0 0 0 0 0 0 4 0 0 0 0 38 0 0 0 0 0 0 0 0
0 0 0 12 77 8 0 0 0 0 0 0 0 4 0 31 0 0 12 0 0 0 0 0 0
62 8 0 12 4 0 0 0 0 0 0 0 4 0 25 0 0 0 0 0 0 0 0 0 15
12 15 27 31 0 0 0 0 0 0 0 0 0 17 0 0 0 0 0 0 0 0 0 4 0
0 0 50 0 0 0 35 4 0 8 0 0 18 0 0 0 0 0 0 0 0 0 0 0 0
0 0 100 0 0 0 0 0 0 0 0 50 0 0 0 0 0 0 0 0 0 0 0 92 0
0 0 0 0 4 0 0 0 4 0 42 0 0 0 0 0 0 0 0 0 12 4 32 36 0
0 0 12 0 0 0 4 0 0 16 0 0 4 2 10 0 2 0 4 8 10 10 4 13 13
0 4 0 0 2 6 2 76 0 0 0 100 100 100 50 100 0 0 0 55 30 44 26 52 90
85 100 85 100 85 100 70 11 44 26 58 40 55 30 52 90 70 11 44 26 59 61 58 0 0
0 0 0 0 0 0 0 0 0 0
ITSAM: 37
0 0 0 0 0 0 0 69 0 0 0 0 0 0 8 0 0 4 0 19 0 30 0 0 0
0 0 0 0 0 0 0 0 0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0 0
23 0 0 0 0 0 0 0 0 0 0 0 0 77 0 0 0 0 0 23 0 0 0 0 92
0 0 0 0 0 0 0 0 4 0 4 0 0 0 0 0 0 0 39 0 0 4 12 81 0
0 0 0 0 0 0 0 0 0 0 0 0 4 0 0 0 0 38 0 0 0 0 0 0 0
0 0 0 0 12 77 8 0 0 0 0 0 0 0 4 0 31 0 0 12 0 0 0 0 0
0 62 8 0 12 4 0 0 0 0 0 0 0 4 0 25 0 0 0 0 0 0 0 0 0
15 12 15 27 31 0 0 0 0 0 0 0 0 0 17 0 0 0 0 0 0 0 0 0 4
0 0 0 50 0 0 0 35 4 0 8 0 0 18 0 0 0 0 0 0 0 0 0 0 0
0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0 0 0 0 0 0 0 0 0 92
0 0 0 0 0 4 0 0 0 4 0 42 0 0 0 0 0 0 0 0 0 12 4 32 36
0 0 0 12 0 0 0 4 0 0 16 0 0 0 0 0 0 0 0 0 28 0 4 4 0
0 0 0 0 0 0 8 56 0 28 0 0 4 2 10 0 2 0 4 8 10 10 4 13 13
0 4 0 0 2 6 2 76 0 0 0 100 100 100 60 90 0 0 0 44 26 52 90 85 100
85 100 85 100 70 11 44 26 58 40 55 30 52 90 70 11 44 26 19 0 57 48 66 0 0
0 0 0 0 0 0 0 0 0 0
ITSAM: 38
0 0 0 0 0 0 0 0 0 0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0
0 23 0 0 0 0 0 0 0 0 0 0 0 0 77 0 0 0 0 0 23 0 0 0 0
92 0 0 0 0 0 0 0 0 4 0 4 0 0 0 0 0 0 0 39 0 0 4 12 81
0 0 0 0 0 0 0 0 0 0 0 0 0 4 0 0 0 0 38 0 0 0 0 0 0
0 0 0 0 0 12 77 8 0 0 0 0 0 0 0 4 0 31 0 0 12 0 0 0 0
0 0 62 8 0 12 4 0 0 0 0 0 0 0 4 0 25 0 0 0 0 0 0 0 0
0 15 12 15 27 31 0 0 0 0 0 0 0 0 0 17 0 0 0 0 0 0 0 0 0
4 0 0 0 50 0 0 0 35 4 0 8 0 0 18 0 0 0 0 0 0 0 0 0 0
0 0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0 0 0 0 0 0 0 0 0
92 0 0 0 0 0 4 0 0 0 4 0 42 0 0 0 0 0 0 0 0 0 12 4 32
36 0 0 0 12 0 0 0 4 0 0 16 0 0 0 0 0 0 0 0 0 28 0 4 4
0 0 0 0 0 0 0 8 56 0 28 0 0 0 8 0 0 0 4 84 0 0 0 0 0
0 4 0 0 0 0 0 0 0 38 0 0 4 2 10 0 2 0 4 8 10 10 4 13 13
0 4 0 0 2 6 2 76 0 0 0 100 100 100 70 80 0 0 0 52 90 85 100 85 100
85 100 70 11 44 26 58 40 55 30 52 90 70 11 44 26 19 0 78 64 62 68 62 0 0
0 0 0 0 0 0 0 0 0 0
ITSAM: 39
0 0 23 0 0 0 0 0 0 0 0 0 0 0 0 77 0 0 0 0 0 23 0 0 0
0 92 0 0 0 0 0 0 0 0 4 0 4 0 0 0 0 0 0 0 39 0 0 4 12
81 0 0 0 0 0 0 0 0 0 0 0 0 0 4 0 0 0 0 38 0 0 0 0 0
0 0 0 0 0 0 12 77 8 0 0 0 0 0 0 0 4 0 31 0 0 12 0 0 0
0 0 0 62 8 0 12 4 0 0 0 0 0 0 0 4 0 25 0 0 0 0 0 0 0
0 0 15 12 15 27 31 0 0 0 0 0 0 0 0 0 17 0 0 0 0 0 0 0 0
0 4 0 0 0 50 0 0 0 35 4 0 8 0 0 18 0 0 0 0 0 0 0 0 0
0 0 0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0 0 0 0 0 0 0 0
0 92 0 0 0 0 0 4 0 0 0 4 0 42 0 0 0 0 0 0 0 0 0 12 4
32 36 0 0 0 12 0 0 0 4 0 0 16 0 0 0 0 0 0 0 0 0 28 0 4
4 0 0 0 0 0 0 0 8 56 0 28 0 0 0 8 0 0 0 4 84 0 0 0 0
0 0 4 0 0 0 0 0 0 0 38 0 0 0 0 0 0 0 0 0 0 14 68 0 5
0 0 0 0 0 9 0 5 0 26 0 0 4 2 10 0 2 0 4 8 10 10 4 13 13
0 4 0 0 2 6 2 76 0 0 0 100 100 100 80 70 0 0 0 85 100 85 100 85 100
70 11 44 26 58 40 55 30 52 90 70 11 44 26 19 0 78 64 58 40 59 62 53 0 0
0 0 0 0 0 0 0 0 0 0
ITSAM: 40
0 0 92 0 0 0 0 0 0 0 0 4 0 4 0 0 0 0 0 0 0 39 0 0 4
12 81 0 0 0 0 0 0 0 0 0 0 0 0 0 4 0 0 0 0 38 0 0 0 0
0 0 0 0 0 0 0 12 77 8 0 0 0 0 0 0 0 4 0 31 0 0 12 0 0
0 0 0 0 62 8 0 12 4 0 0 0 0 0 0 0 4 0 25 0 0 0 0 0 0
0 0 0 15 12 15 27 31 0 0 0 0 0 0 0 0 0 17 0 0 0 0 0 0 0
0 0 4 0 0 0 50 0 0 0 35 4 0 8 0 0 18 0 0 0 0 0 0 0 0
0 0 0 0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0 0 0 0 0 0 0
0 0 92 0 0 0 0 0 4 0 0 0 4 0 42 0 0 0 0 0 0 0 0 0 12
4 32 36 0 0 0 12 0 0 0 4 0 0 16 0 0 0 0 0 0 0 0 0 28 0
4 4 0 0 0 0 0 0 0 8 56 0 28 0 0 0 8 0 0 0 4 84 0 0 0
0 0 0 4 0 0 0 0 0 0 0 38 0 0 0 0 0 0 0 0 0 0 14 68 0
5 0 0 0 0 0 9 0 5 0 26 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 17 0 67 0 0 17 0 0 22 0 0 4 2 10 0 2 0 4 8 10 10 4 13 13
0 4 0 0 2 6 2 76 0 0 0 100 100 100 90 60 0 0 0 85 100 85 100 70 11
44 26 58 40 55 30 52 90 70 11 44 26 19 0 78 64 58 40 31 15 59 46 66 0 0
0 0 0 0 0 0 0 0 0 0
ITSAM: 41
4 12 81 0 0 0 0 0 0 0 0 0 0 0 0 0 4 0 0 0 0 38 0 0 0
0 0 0 0 0 0 0 0 12 77 8 0 0 0 0 0 0 0 4 0 31 0 0 12 0
0 0 0 0 0 62 8 0 12 4 0 0 0 0 0 0 0 4 0 25 0 0 0 0 0
0 0 0 0 15 12 15 27 31 0 0 0 0 0 0 0 0 0 17 0 0 0 0 0 0
0 0 0 4 0 0 0 50 0 0 0 35 4 0 8 0 0 18 0 0 0 0 0 0 0
0 0 0 0 0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0 0 0 0 0 0
0 0 0 92 0 0 0 0 0 4 0 0 0 4 0 42 0 0 0 0 0 0 0 0 0
12 4 32 36 0 0 0 12 0 0 0 4 0 0 16 0 0 0 0 0 0 0 0 0 28
0 4 4 0 0 0 0 0 0 0 8 56 0 28 0 0 0 8 0 0 0 4 84 0 0
0 0 0 0 4 0 0 0 0 0 0 0 38 0 0 0 0 0 0 0 0 0 0 14 68
0 5 0 0 0 0 0 9 0 5 0 26 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 17 0 67 0 0 17 0 0 22 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 100 25 0 0 4 2 10 0 2 0 4 8 10 10 4 13 13
0 4 0 0 2 6 2 76 0 0 0 100 100 100 100 50 0 0 0 85 100 70 11 44 26
58 40 55 30 52 90 70 11 44 26 19 0 78 64 58 40 31 15 0 0 55 72 57 0 0
0 0 0 0 0 0 0 0 0 0
ITSAM: 42
0 0 0 0 0 0 0 0 0 12 77 8 0 0 0 0 0 0 0 4 0 31 0 0 12
0 0 0 0 0 0 62 8 0 12 4 0 0 0 0 0 0 0 4 0 25 0 0 0 0
0 0 0 0 0 15 12 15 27 31 0 0 0 0 0 0 0 0 0 17 0 0 0 0 0
0 0 0 0 4 0 0 0 50 0 0 0 35 4 0 8 0 0 18 0 0 0 0 0 0
0 0 0 0 0 0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0 0 0 0 0
0 0 0 0 92 0 0 0 0 0 4 0 0 0 4 0 42 0 0 0 0 0 0 0 0
0 12 4 32 36 0 0 0 12 0 0 0 4 0 0 16 0 0 0 0 0 0 0 0 0
28 0 4 4 0 0 0 0 0 0 0 8 56 0 28 0 0 0 8 0 0 0 4 84 0
0 0 0 0 0 4 0 0 0 0 0 0 0 38 0 0 0 0 0 0 0 0 0 0 14
68 0 5 0 0 0 0 0 9 0 5 0 26 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 17 0 67 0 0 17 0 0 22 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 100 25 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 100 25 0 0 4 2 10 0 2 0 4 8 10 10 4 13 13
0 4 0 0 2 6 2 76 0 0 0 100 100 100 100 40 0 0 0 70 11 44 26 58 40
55 30 52 90 70 11 44 26 19 0 78 64 58 40 31 15 0 0 0 0 55 56 44 0 0
0 0 0 0 0 0 0 0 0 0
ITSAM: 43
12 0 0 0 0 0 0 62 8 0 12 4 0 0 0 0 0 0 0 4 0 25 0 0 0
0 0 0 0 0 0 15 12 15 27 31 0 0 0 0 0 0 0 0 0 17 0 0 0 0
0 0 0 0 0 4 0 0 0 50 0 0 0 35 4 0 8 0 0 18 0 0 0 0 0
0 0 0 0 0 0 0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0 0 0 0
0 0 0 0 0 92 0 0 0 0 0 4 0 0 0 4 0 42 0 0 0 0 0 0 0
0 0 12 4 32 36 0 0 0 12 0 0 0 4 0 0 16 0 0 0 0 0 0 0 0
0 28 0 4 4 0 0 0 0 0 0 0 8 56 0 28 0 0 0 8 0 0 0 4 84
0 0 0 0 0 0 4 0 0 0 0 0 0 0 38 0 0 0 0 0 0 0 0 0 0
14 68 0 5 0 0 0 0 0 9 0 5 0 26 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 17 0 67 0 0 17 0 0 22 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 100 25 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 100 25 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 100 25 0 0 4 2 10 0 2 0 4 8 10 10 4 13 13
0 4 0 0 2 6 2 76 0 0 0 100 100 100 100 30 0 0 0 44 26 58 40 55 30
52 90 70 11 44 26 19 0 78 64 58 40 31 15 0 0 0 0 0 0 49 36 37 0 0
0 0 0 0 0 0 0 0 0 0
ITSAM: 44
0 0 0 0 0 0 0 15 12 15 27 31 0 0 0 0 0 0 0 0 0 17 0 0 0
0 0 0 0 0 0 4 0 0 0 50 0 0 0 35 4 0 8 0 0 18 0 0 0 0
0 0 0 0 0 0 0 0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0 0 0
0 0 0 0 0 0 92 0 0 0 0 0 4 0 0 0 4 0 42 0 0 0 0 0 0
0 0 0 12 4 32 36 0 0 0 12 0 0 0 4 0 0 16 0 0 0 0 0 0 0
0 0 28 0 4 4 0 0 0 0 0 0 0 8 56 0 28 0 0 0 8 0 0 0 4
84 0 0 0 0 0 0 4 0 0 0 0 0 0 0 38 0 0 0 0 0 0 0 0 0
0 14 68 0 5 0 0 0 0 0 9 0 5 0 26 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 17 0 67 0 0 17 0 0 22 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 100 25 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 100 25 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 100 25 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 100 25 0 0 4 2 10 0 2 0 4 8 10 10 4 13 13
0 4 0 0 2 6 2 76 0 0 0 100 100 100 100 20 0 0 0 58 40 55 30 52 90
70 11 44 26 19 0 78 64 58 40 31 15 0 0 0 0 0 0 0 0 52 68 65 0 0
0 0 0 0 0 0 0 0 0 0
ITSAM: 45
0 0 0 0 0 0 0 4 0 0 0 50 0 0 0 35 4 0 8 0 0 18 0 0 0
0 0 0 0 0 0 0 0 0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0 0
0 0 0 0 0 0 0 92 0 0 0 0 0 4 0 0 0 4 0 42 0 0 0 0 0
0 0 0 0 12 4 32 36 0 0 0 12 0 0 0 4 0 0 16 0 0 0 0 0 0
0 0 0 28 0 4 4 0 0 0 0 0 0 0 8 56 0 28 0 0 0 8 0 0 0
4 84 0 0 0 0 0 0 4 0 0 0 0 0 0 0 38 0 0 0 0 0 0 0 0
0 0 14 68 0 5 0 0 0 0 0 9 0 5 0 26 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 17 0 67 0 0 17 0 0 22 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 100 25 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 100 25 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 100 25 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 100 25 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 100 25 0 0 4 2 10 0 2 0 4 8 10 10 4 13 13
0 4 0 0 2 6 2 76 0 0 0 100 100 100 100 10 0 0 0 55 30 52 90 70 11
44 26 19 0 78 64 58 40 31 15 0 0 0 0 0 0 0 0 0 0 50 52 64 0 0
0 0 0 0 0 0 0 0 0 0
ITSAM: 46
0 0 0 0 0 0 0 0 0 0 0 0 100 0 0 0 0 0 0 0 0 50 0 0 0
0 0 0 0 0 0 0 0 92 0 0 0 0 0 4 0 0 0 4 0 42 0 0 0 0
0 0 0 0 0 12 4 32 36 0 0 0 12 0 0 0 4 0 0 16 0 0 0 0 0
0 0 0 0 28 0 4 4 0 0 0 0 0 0 0 8 56 0 28 0 0 0 8 0 0
0 4 84 0 0 0 0 0 0 4 0 0 0 0 0 0 0 38 0 0 0 0 0 0 0
0 0 0 14 68 0 5 0 0 0 0 0 9 0 5 0 26 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 17 0 67 0 0 17 0 0 22 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 100 25 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 100 25 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 100 25 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 100 25 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 100 25 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 100 25 0 0 4 2 10 0 2 0 4 8 10 10 4 13 13
0 4 0 0 2 6 2 76 0 0 0 100 100 100 100 0 0 0 0 52 90 70 11 44 26
19 0 78 64 58 40 31 15 0 0 0 0 0 0 0 0 0 0 0 0 51 34 37 0 0
0 0 0 0 0 0 0 0 0 0
//
profnet-1.0.22/src/RUN-special 0000644 0150751 0150751 00000000102 12021362711 015327 0 ustar lkajan lkajan prof.SGI64 switch 385 55 10 46 100 PROFin.dat PROFacc_tst.jct none profnet-1.0.22/src/ReadMe-mac 0000644 0150751 0150751 00000000331 12021362711 015144 0 ustar lkajan lkajan # gnu
g77 -o prof.MAC -O3 prof.f lib-prof.f lib-sys-MAC.f
/usr/local/bin -o prof.MACINTEL -O3 prof.f lib-prof.f lib-sys-LINUX.f
# ibm
/opt/ibmcmp/xlf/8.1/bin/f77 -o prof.IBM -O3 prof.f lib-prof.f lib-sys-MACIBM.f
profnet-1.0.22/src/compile_macintel.csh 0000755 0150751 0150751 00000000433 12021362711 017337 0 ustar lkajan lkajan # gnu gfortran compiler - only on INTEL MAC
echo "--- now PROF: "
echo "/usr/local/bin -o prof.MACINTEL -O3 prof.f lib-prof.f lib-sys-LINUX.f"
#/usr/local/bin -o prof.MACINTEL -O3 prof.f lib-prof.f lib-sys-LINUX.f
/usr/bin/f77 -o prof.MACINTEL -O3 prof.f lib-prof.f lib-sys-LINUX.f
profnet-1.0.22/src/lib-LINUX.f 0000644 0150751 0150751 00000022021 12021362711 015140 0 ustar lkajan lkajan ***** ------------------------------------------------------------------
***** FCT FCTIME_DATE
***** ------------------------------------------------------------------
C----
C---- NAME : FCTIME_DATE
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Oct, 2003 version 1.0 *
* EMBL/LION http://www.predictprotein.org/ *
* D-69012 Heidelberg rost@columbia.edu *
* changed: Aug, 2003 version 1.0 *
*----------------------------------------------------------------------*
* purpose: returns date *
* note: machine type dependent: *
* SGI, UNIX, LINUX: absolute unix time *
* IBM: char*8 YYYYMMDD *
* input : NOM, DEN *
*----------------------------------------------------------------------*
CHARACTER*24 FUNCTION FCTIME_DATE()
IMPLICIT NONE
******------------------------------*-----------------------------******
* execution of function *
C FCTIME_DATE=FDATE()
FCTIME_DATE=''
END
***** end of FCTIME_DATE
***** ------------------------------------------------------------------
***** FCT FRTIME_SECNDS
***** ------------------------------------------------------------------
C----
C---- NAME : FRTIME_SECNDS
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Oct, 2003 version 1.0 *
* EMBL/LION http://www.predictprotein.org/ *
* D-69012 Heidelberg rost@columbia.edu *
* changed: Aug, 2003 version 1.0 *
*----------------------------------------------------------------------*
* purpose: returns CPU time seconds *
* note: machine type dependent: *
* SGI, UNIX, LINUX: absolute unix time *
* IBM: cputime *
* input : NOM, DEN *
*----------------------------------------------------------------------*
REAL FUNCTION FRTIME_SECNDS(T1)
IMPLICIT NONE
C---- variables passed from/to SBR calling
REAL T1
******------------------------------*-----------------------------******
* execution of function *
FRTIME_SECNDS=SECNDS(T1)
END
***** end of FRTIME_SECNDS
***** ------------------------------------------------------------------
***** SUB INIJCT
***** ------------------------------------------------------------------
C----
C---- NAME : INIJCT
C---- ARG :
C---- DES : Generation of the initial couplings and biases of
C---- DES : the network. Options:
C---- DES : RANDOM : locfield (i,j,TIMEST=0) = [-/+diceintervall]
C---- DES : with equal distribution
C---- IN p: NUMSAM,NUMIN,NUMHID,NUMOUT, DICESEED
C---- IN v: JCT1ST,JCT2ND,BIAS1ST,BIAS2ND
C---- OUT : setting of JCT1ST, JCT2ND
C---- FROM : MAIN
C---- CALL2:
C---- LIB : RAN(SEED), creates random numbers between 0 and *
C---- LIB+ : 1 (1 excluded, 0 included), it is called by com-*
C---- LIB+ : piling with -lV77, each call initializes next *
C---- LIB+ : seed, according to: seed=6909*seed+mod(2**32) *
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: June, 1998 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE INIJCT
C---- global parameters and variables
INCLUDE 'profPar.f'
C---- local variables
INTEGER I,J,NUMHIDFIRST,NUMHIDLAST
Cunix
C REAL RAN,DICE1,DICE2,DICEINTERVX
Clinux
REAL RAND,DICE1,DICE2,DICEINTERVX
******------------------------------*-----------------------------******
* I,J serve as iteration variables *
* DICE1,2 =RAN(DICESEED1),i.e. random number between 0,1*
* NUMHIDFIRST number of units in the first hidden layer *
* NUMHIDLAST number of units in the last hidden layer *
******------------------------------*-----------------------------******
DICEINTERVX=DICEITRVL
C---- ------------------------------------------------------------------
C---- first layer junctions
C---- ------------------------------------------------------------------
DICESEED1=DICESEED+DICESEED_ADDJCT
IF (NUMLAYERS.EQ.1) THEN
NUMHIDFIRST=NUMOUT
NUMHIDLAST=0
ELSE
NUMHIDFIRST=NUMHID
NUMHIDLAST=NUMHID
END IF
C---- loop over hidden units
DO I=1,NUMHIDFIRST
C------- junctions (loop over input units)
DO J=1,NUMIN
C---------- generating random numbers from [0,1)
Cunix
C DICE1= RAN(DICESEED1)
C DICE2= RAN(DICESEED1)
Clinux
DICE1= RAND(DICESEED1)
DICE2= RAND(DICESEED1)
IF (DICE1.LT.0.5) THEN
JCT1ST(J,I)= (-1.)*DICEINTERVX*DICE2
ELSE
JCT1ST(J,I)= DICEINTERVX*DICE2
END IF
END DO
C------- thresholds (resp. biases)
C------- generating random numbers from [0,1)
Cunix
C DICE1= RAN(DICESEED1)
C DICE2= RAN(DICESEED1)
Clinux
DICE1= RAND(DICESEED1)
DICE2= RAND(DICESEED1)
IF (DICE1.LT.0.5) THEN
JCT1ST((NUMIN+1),I)=
+ (-1.)*DICEINTERVX*DICE2
ELSE
JCT1ST((NUMIN+1),I)=DICEINTERVX*DICE2
END IF
END DO
C---- ------------------------------------------------------------------
C---- last layer junctions
C---- ------------------------------------------------------------------
DO I=1,NUMOUT
C------- junctions
DO J=1,NUMHIDLAST
C---------- generating random numbers from [0,1)
Cunix
C DICE1= RAN(DICESEED1)
C DICE2= RAN(DICESEED1)
Clinux
DICE1= RAND(DICESEED1)
DICE2= RAND(DICESEED1)
IF (DICE1.LT.0.5) THEN
JCT2ND(J,I)=(-1.)*DICEINTERVX*DICE2
ELSE
JCT2ND(J,I)=DICEINTERVX*DICE2
END IF
END DO
C------- thresholds (resp. biases)
C------- generating random numbers from [0,1)
Cunix
C DICE1= RAN(DICESEED1)
C DICE2= RAN(DICESEED1)
Clinux
DICE1= RAND(DICESEED1)
DICE2= RAND(DICESEED1)
IF (DICE1.LT.0.5) THEN
JCT2ND((NUMHID+1),I)=(-1.)*DICEINTERVX*DICE2
ELSE
JCT2ND((NUMHID+1),I)=DICEINTERVX*DICE2
END IF
END DO
END
***** end of INIJCT
***** ------------------------------------------------------------------
***** SUB SRDTIME
***** ------------------------------------------------------------------
C----
C---- NAME : SRDTIME
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Dec, 1991 version 0.1 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
*** ***
*** ***
*** SUBROUTINE SRDTIME ***
*** ***
*** ***
*----------------------------------------------------------------------*
SUBROUTINE SRDTIME(LOGIWRITE)
IMPLICIT NONE
Cunix
C REAL TIMEARRAYM,TIMEDIFF,DTIME,TIME_TMP
Clinux
REAL TIMEARRAYM(1:2),TIMEDIFF,DTIME
INTEGER ITER
LOGICAL LOGIWRITE
Cunix
C TIMEDIFF=DTIME(TIMEARRAYM,TIME_TMP)
Clinux
TIMEDIFF=DTIME(TIMEARRAYM)
C TIMEDIFF= TIMEDIFFX(1)
IF (LOGIWRITE) THEN
WRITE(6,*)
WRITE(6,'(T10,7A5)')('-----',ITER=1,7)
WRITE(6,*)
WRITE (6,'(T10,A12,T25,F9.3,A5)')
+ 'total time: ',TIMEDIFF,' sec'
WRITE(6,*)
WRITE(6,'(T10,7A5)')('-----',ITER=1,7)
WRITE(6,*)
END IF
END
***** end of SRDTIME
profnet-1.0.22/src/lib-prof.f 0000755 0150751 0150751 00000113343 12021362712 015223 0 ustar lkajan lkajan
***** ------------------------------------------------------------------
***** FCT EMPTYSTRING
***** ------------------------------------------------------------------
C----
C---- NAME : EMPTYSTRING
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
FUNCTION EMPTYSTRING(STRING)
LOGICAL EMPTYSTRING
CHARACTER STRING*(*)
EMPTYSTRING=.TRUE.
DO I=1,LEN(STRING)
IF(STRING(I:I).NE.' ') THEN
EMPTYSTRING=.FALSE.
RETURN
ENDIF
ENDDO
RETURN
END
***** end of EMPTYSTRING
***** ------------------------------------------------------------------
***** FCT FILEN_STRING
***** ------------------------------------------------------------------
C----
C---- NAME : FILEN_STRING
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Feb, 1993 version 0.1 *
* changed: Oct, 1994 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: The length of a given character string is returned
* input: STRING string of character*80 *
* output: LEN length of string without blanks *
*----------------------------------------------------------------------*
INTEGER FUNCTION FILEN_STRING(STRING)
C---- variables passing
CHARACTER STRING*(*)
C---- local variables
INTEGER ITER,ITER2,COUNT,COUNTBEF,NCHAR
CHARACTER*456 CHECK
LOGICAL LHELP,LHELP2
******------------------------------*-----------------------------******
C---- defaults
CHECK(1:52)=
+ 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
CHECK(53:73)='1234567890-._/+=:!~*,'
NCHAR=73
LHELP=.TRUE.
COUNT=0
COUNTBEF=0
DO ITER=1,456
IF (LHELP) THEN
LHELP2=.FALSE.
DO ITER2=1,NCHAR
IF ((.NOT.LHELP2).AND.
+ STRING(ITER:ITER).EQ.CHECK(ITER2:ITER2)) THEN
LHELP2=.TRUE.
COUNT=COUNT+1
END IF
END DO
IF (.NOT.LHELP2) THEN
IF ( (COUNT.EQ.0).AND.(STRING(ITER:ITER).eq.' ') ) THEN
COUNTBEF=COUNTBEF+1
ELSE
LHELP=.FALSE.
FILEN_STRING=ITER-1-COUNTBEF
END IF
END IF
END IF
END DO
IF (COUNT.NE.FILEN_STRING) THEN
WRITE(6,'(T2,A)')'-!-'
WRITE(6,'(T2,A,T10,A)')'-!-','WARNING FILEN_STRING:'//
+ 'two different results.'
WRITE(6,'(T2,A,T10,A,T20,I5,T30,A,T40,I5,T50,A,T60,A1,A,A1)')
+ '-!-','first = ',FILEN_STRING,
+ 'count: ',count,'for: ','|',STRING(1:COUNT),'|'
WRITE(6,'(T2,A)')'-!-'
END IF
FILEN_STRING=COUNT
END
***** end of FILEN_STRING
***** ------------------------------------------------------------------
***** FCT FILENSTRING
***** ------------------------------------------------------------------
C----
C---- NAME : FILENSTRING
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Feb, 1993 version 0.1 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: The length of a given character string is returned
* input: STRING string of character*80 *
* output: LEN length of string without blanks *
*----------------------------------------------------------------------*
INTEGER FUNCTION FILENSTRING(STRING)
C---- variables passing
CHARACTER STRING*(*)
C CHARACTER*(*) STRING
C CHARACTER*456 STRING
C---- local variables
INTEGER ICOUNT,ITER
LOGICAL LHELP
******------------------------------*-----------------------------******
C---- defaults
ICOUNT=0
LHELP=.TRUE.
DO ITER=1,80
IF (LHELP.AND.(STRING(ITER:ITER).NE.' ')) THEN
ICOUNT=ICOUNT+1
ELSE
LHELP=.FALSE.
END IF
END DO
FILENSTRING=ICOUNT
END
***** end of FILENSTRING
***** ------------------------------------------------------------------
***** FCT FILENSTRING_ALPHANUMSEN
***** ------------------------------------------------------------------
C----
C---- NAME : FILENSTRING_ALPHANUMSEN
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Feb, 1993 version 0.1 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: The length of a given character string is returned
* -------- (only numbers 0-9, letters a-z, A-Z, and the fol-*
* lowing symbols are allowed: '.','-','_'. *
* input: STRING string of character*80 *
* output: LEN length of string without blanks *
*----------------------------------------------------------------------*
INTEGER FUNCTION FILENSTRING_ALPHANUMSEN(STRING)
C---- variables passing
CHARACTER STRING*(*)
C---- local variables
INTEGER ICOUNT,ITER
LOGICAL LHELP,LLETTER,LREST
******------------------------------*-----------------------------******
C---- defaults
ICOUNT=0
LHELP=.TRUE.
DO ITER=1,80
IF (LHELP) THEN
LLETTER=.FALSE.
LREST=.FALSE.
IF ((STRING(ITER:ITER).EQ.'A').OR.
+ (STRING(ITER:ITER).EQ.'B').OR.
+ (STRING(ITER:ITER).EQ.'C').OR.
+ (STRING(ITER:ITER).EQ.'D').OR.
+ (STRING(ITER:ITER).EQ.'E').OR.
+ (STRING(ITER:ITER).EQ.'F').OR.
+ (STRING(ITER:ITER).EQ.'G').OR.
+ (STRING(ITER:ITER).EQ.'H').OR.
+ (STRING(ITER:ITER).EQ.'I').OR.
+ (STRING(ITER:ITER).EQ.'J').OR.
+ (STRING(ITER:ITER).EQ.'K').OR.
+ (STRING(ITER:ITER).EQ.'L').OR.
+ (STRING(ITER:ITER).EQ.'M').OR.
+ (STRING(ITER:ITER).EQ.'N').OR.
+ (STRING(ITER:ITER).EQ.'O').OR.
+ (STRING(ITER:ITER).EQ.'P').OR.
+ (STRING(ITER:ITER).EQ.'Q').OR.
+ (STRING(ITER:ITER).EQ.'R').OR.
+ (STRING(ITER:ITER).EQ.'S').OR.
+ (STRING(ITER:ITER).EQ.'T')) THEN
LLETTER=.TRUE.
END IF
IF (.NOT.LLETTER) THEN
IF ((STRING(ITER:ITER).EQ.'U').OR.
+ (STRING(ITER:ITER).EQ.'V').OR.
+ (STRING(ITER:ITER).EQ.'W').OR.
+ (STRING(ITER:ITER).EQ.'X').OR.
+ (STRING(ITER:ITER).EQ.'Y').OR.
+ (STRING(ITER:ITER).EQ.'Z').OR.
+ (STRING(ITER:ITER).EQ.'a').OR.
+ (STRING(ITER:ITER).EQ.'b').OR.
+ (STRING(ITER:ITER).EQ.'c').OR.
+ (STRING(ITER:ITER).EQ.'d').OR.
+ (STRING(ITER:ITER).EQ.'e').OR.
+ (STRING(ITER:ITER).EQ.'f').OR.
+ (STRING(ITER:ITER).EQ.'g').OR.
+ (STRING(ITER:ITER).EQ.'h').OR.
+ (STRING(ITER:ITER).EQ.'i').OR.
+ (STRING(ITER:ITER).EQ.'j')) THEN
LLETTER=.TRUE.
END IF
END IF
IF (.NOT.LLETTER) THEN
IF ((STRING(ITER:ITER).EQ.'k').OR.
+ (STRING(ITER:ITER).EQ.'l').OR.
+ (STRING(ITER:ITER).EQ.'m').OR.
+ (STRING(ITER:ITER).EQ.'n').OR.
+ (STRING(ITER:ITER).EQ.'o').OR.
+ (STRING(ITER:ITER).EQ.'p').OR.
+ (STRING(ITER:ITER).EQ.'q').OR.
+ (STRING(ITER:ITER).EQ.'r').OR.
+ (STRING(ITER:ITER).EQ.'s').OR.
+ (STRING(ITER:ITER).EQ.'t').OR.
+ (STRING(ITER:ITER).EQ.'u').OR.
+ (STRING(ITER:ITER).EQ.'v').OR.
+ (STRING(ITER:ITER).EQ.'w').OR.
+ (STRING(ITER:ITER).EQ.'x').OR.
+ (STRING(ITER:ITER).EQ.'y').OR.
+ (STRING(ITER:ITER).EQ.'z')) THEN
LLETTER=.TRUE.
END IF
END IF
IF (.NOT.LLETTER) THEN
IF ((STRING(ITER:ITER).EQ.'1').OR.
+ (STRING(ITER:ITER).EQ.'2').OR.
+ (STRING(ITER:ITER).EQ.'3').OR.
+ (STRING(ITER:ITER).EQ.'4').OR.
+ (STRING(ITER:ITER).EQ.'5').OR.
+ (STRING(ITER:ITER).EQ.'6').OR.
+ (STRING(ITER:ITER).EQ.'7').OR.
+ (STRING(ITER:ITER).EQ.'8').OR.
+ (STRING(ITER:ITER).EQ.'9').OR.
+ (STRING(ITER:ITER).EQ.'0').OR.
+ (STRING(ITER:ITER).EQ.'.').OR.
+ (STRING(ITER:ITER).EQ.'-').OR.
+ (STRING(ITER:ITER).EQ.'_').OR.
+ (STRING(ITER:ITER).EQ.'*')) THEN
LREST=.TRUE.
END IF
END IF
IF (LLETTER.OR.LREST) THEN
ICOUNT=ICOUNT+1
ELSE
LHELP=.FALSE.
END IF
END IF
END DO
FILENSTRING_ALPHANUMSEN=ICOUNT
END
***** end of FILENSTRING_ALPHANUMSEN
***** ------------------------------------------------------------------
***** FCT FRMAX1
***** ------------------------------------------------------------------
C----
C---- NAME : FRMAX1
C---- ARG : RVEC,IROW
C---- DES : computes the maximal value of all elements of the real
C---- DES : vector RVEC(IROW):
C---- DES : result = max/i [RVEC(i)]
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: May, 1991 version 0.1 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: computation of maximal value of the elements of *
* a real vector *
* input parameter:IROW *
* input variables:RVEC *
* output: result = max/j [ RVEC1(j)] *
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
*----------------------------------------------------------------------*
REAL FUNCTION FRMAX1(RVEC,IROW)
INTEGER IROW
REAL RESULT
REAL RVEC(1:IROW)
RESULT=0.
DO ITER=1,IROW
RESULT=MAX(RESULT,RVEC(ITER))
END DO
FRMAX1=RESULT
END
***** end of FRMAX1
***** ------------------------------------------------------------------
***** FCT FRMAX2
***** ------------------------------------------------------------------
C----
C---- NAME : FRMAX2
C---- ARG : RMAT,IROW,ICOL
C---- DES : computes the maximal value of all elements of the real
C---- DES : matrix RMAT(IROW,ICOL):
C---- DES : result = max/i,j [RVEC(i,j)]
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1991 version 0.1 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: computation of maximal value of the elements of *
* a real matrix *
* input parameter:IROW, ICOL *
* input variables:RMAT *
* output: result = max/i,j [ RMAT(i,j)] *
*----------------------------------------------------------------------*
REAL FUNCTION FRMAX2(RMAT,IROW,ICOL)
INTEGER IROW,ICOL,ITROW,ITCOL
REAL RESULT,MAX
REAL RMAT(1:IROW,1:ICOL)
RESULT=0.
DO ITCOL=1,ICOL
DO ITROW=1,IROW
RESULT=MAX(RESULT,RMAT(ITROW,ITCOL))
END DO
END DO
FRMAX2=RESULT
END
***** end of FRMAX2
***** ------------------------------------------------------------------
***** SUB GETCHAR
***** ------------------------------------------------------------------
C----
C---- NAME : GETCHAR
C---- ARG :
C---- DES : prompts for printable (keyboard) characters
C---- DES : Caution: line with '$!' is truncated as comment
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE GETCHAR(KCHAR,CHARARR,CTEXT)
LOGICAL EMPTYSTRING
CHARACTER*80 LINE
CHARACTER*(*) CTEXT
CHARACTER CHARARR*(*)
WRITE(*,*)
WRITE(*,*)'================================================='//
+ '=============================='
CALL WRITELINES(CTEXT)
IF(KCHAR.LT.1)THEN
WRITE(*,*)'*** CHARPROMPT: illegal KCHAR',KCHAR
RETURN
ENDIF
10 CONTINUE
WRITE(*,*)
IF(KCHAR.GT.1) THEN
WRITE(*,'(2X,''Enter letter string of length <'',I3)')KCHAR
ELSE
WRITE(*,'(2X,''Enter one letter !'')')
ENDIF
WRITE(*,'(2X,''[CR=default]: '')')
WRITE(*, '(2X,''Default: '',80A1)' ) (CHARARR(K:K),K=1,KCHAR)
LINE=' '
READ(*,'(A80)',ERR=10,END=11) LINE
IF(.NOT.EMPTYSTRING(LINE)) THEN
C ! assuming default values were set outside ....
C...remove comments ( 34535345 !$ comment )
KCOMMENT=INDEX(LINE,'!$')
IF(KCOMMENT.NE.0) LINE(KCOMMENT:80)=' '
DO I=1,80
***** ------------------------------------------------------------------
IF (INDEX(' ABCDEFGHIJKLMNOPQRSTUVWXYZ',LINE(I:I)).EQ.
+ 0) THEN
IF (INDEX(' abcdefghijklmnopqrstuvwxyz',LINE(I:I)).EQ.
+ 0) THEN
C IF (INDEX('~!@#$%^&*()_+=-{}[]:""|\;,' ,LINE(I:I)).EQ.
IF (INDEX('~!@#$%^&*()_+=-{}[]:""|;,' ,LINE(I:I)).EQ.
+ 0) THEN
IF (INDEX('.?/><1234567890 ',LINE(I:I)).
+ EQ.0) THEN
WRITE(*,
+ '(2X,''*** characters only, not: '',A40)')
+ LINE(1:40)
GO TO 10
ENDIF
ENDIF
ENDIF
ENDIF
ENDDO
READ(LINE,'(80A1)',ERR=10,END=99) (CHARARR(K:K),K=1,KCHAR)
ENDIF
11 WRITE(*,'(2X,A7,60A1)') ' echo: ', (CHARARR(K:K),K=1,KCHAR)
RETURN
99 WRITE(*,*)' CHARPROMPT: END OF LINE DURING READ - check format!'
END
***** end of GETCHAR
***** ------------------------------------------------------------------
***** SUB GETINT
***** ------------------------------------------------------------------
C----
C---- NAME : GETINT
C---- ARG :
C---- DES : For interactive use via terminal.
C---- DES : Prompts for KINT integers from input unit *.
C---- DES : Returns new values in INTNUM.
C---- DES : Offers previous values as default.
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
*----------------------------------------------------------------------*
SUBROUTINE GETINT(KINT,INTNUM,CTEXT)
INTEGER LINELEN
PARAMETER(LINELEN=80)
CHARACTER*(LINELEN) LINE
CHARACTER*(*) CTEXT
INTEGER INTNUM
LOGICAL EMPTYSTRING
INTEGER NUMSTART
CHARACTER*20 CTEMP
WRITE(*,*)
WRITE(*,*)'===================================================='//
+ '==========================='
CALL WRITELINES(CTEXT)
IF(KINT.LT.1.OR.KINT.GT.100) THEN
WRITE(*,*)'*** INTPROMPT: KINT no good',KINT
RETURN
ENDIF
10 WRITE(*,*)
WRITE(*,'(2X,''Default: '',I10)') INTNUM
IF(KINT.GT.1) THEN
WRITE(*,'(2X,''Enter'',I3,'' integers [CR=default]: '')')KINT
ELSE
WRITE(*,'(2X,''Enter one integer [CR=default]: '')')
ENDIF
LINE=' '
READ(*,'(A80)',ERR=10,END=11) LINE
IF(.NOT.EMPTYSTRING(LINE)) THEN
C...remove comments ( 34535345 !$ comment )
KCOMMENT=INDEX(LINE,' !$')
IF(KCOMMENT.NE.0) LINE(KCOMMENT:linelen)=' '
C.. check for legal string
DO I=1,linelen
IF(INDEX(' ,+-0123456789',LINE(I:I)).EQ.0) THEN
WRITE(*,'(2X,''*** not an integer: '',A40)') LINE(1:40)
GO TO 10
ENDIF
ENDDO
CALL StrPos(LINE,IStart,IStop)
C terminate line by comma for ND-100
C LINE=LINE(1:IStop)//','
CUG READ(LINE(IStart:IStop),'(i)',ERR=10,END=11)
Cug + (INTNUM(K),K=1,KINT)
CUG
CALL GETTOKEN(LINE,LINELEN,1,NUMSTART,CTEMP)
CALL RIGHTADJUST(CTEMP,20)
READ(CTEMP,'(I20)') INTNUM
ENDIF
11 WRITE(*,'(2X,'' echo:'',I10)') INTNUM
RETURN
END
***** end of GETINT
***** ------------------------------------------------------------------
***** SUB GETTOKEN
***** ------------------------------------------------------------------
C----
C---- NAME : GETTOKEN
C---- ARG :
C---- DES : returns the itokens token of cstring in ctoken. firstpos is
C---- DES : position in cstring at which substring ctoken starts
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE GETTOKEN(CSTRING,LEN,ITOKEN,FIRSTPOS,CTOKEN)
c Implicit None
C Import
INTEGER LEN, ITOKEN
CHARACTER*(*) CSTRING
C Export
INTEGER FIRSTPOS
CHARACTER*(*) CTOKEN
C Internal
INTEGER IPOS, THISTOKEN, TPOS
LOGICAL FINISHED, INSIDE
CTOKEN = ' '
TPOS = 0
FINISHED = .FALSE.
IF ( CSTRING(1:1) .EQ. ' ' ) THEN
THISTOKEN = 0
INSIDE = .FALSE.
ELSE
THISTOKEN = 1
INSIDE = .TRUE.
FIRSTPOS = 1
IF ( THISTOKEN .EQ. ITOKEN ) THEN
TPOS = TPOS + 1
CTOKEN(TPOS:TPOS) = CSTRING(1:1)
ENDIF
ENDIF
IPOS = 2
DO WHILE ( IPOS .LE. LEN .AND. .NOT. FINISHED )
IF ( CSTRING(IPOS:IPOS) .EQ. ' ' ) THEN
IF ( INSIDE ) THEN
INSIDE = .FALSE.
IF ( THISTOKEN .EQ. ITOKEN ) FINISHED = .TRUE.
ENDIF
ELSE
IF ( .NOT. INSIDE ) THEN
INSIDE = .TRUE.
FIRSTPOS = IPOS
THISTOKEN = THISTOKEN + 1
ENDIF
IF ( THISTOKEN .EQ. ITOKEN ) THEN
TPOS = TPOS + 1
CTOKEN(TPOS:TPOS) = CSTRING(IPOS:IPOS)
ENDIF
ENDIF
IPOS = IPOS + 1
ENDDO
RETURN
END
***** end of GETTOKEN
***** ------------------------------------------------------------------
***** SUB GET_ARGUMENT
***** ------------------------------------------------------------------
C----
C---- NAME : GET_ARGUMENT
C---- ARG : NUMBER,ARGUMENT
C---- DES : returns the content of x-th argument
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE GET_ARGUMENT(INUMBER,ARGUMENT)
CHARACTER*(*) ARGUMENT
INTEGER INUMBER
CALL GETARG(INUMBER,ARGUMENT)
RETURN
END
***** end of GET_ARGUMENT
***** ------------------------------------------------------------------
***** SUB GET_ARG_NUMBER
***** ------------------------------------------------------------------
C----
C---- NAME : GET_ARG_NUMBER
C---- ARG : INUMBER
C---- DES : returns number of arguments
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE GET_ARG_NUMBER(INUMBER)
INTEGER INUMBER,IARGC
INUMBER=0
INUMBER=IARGC()
RETURN
END
***** end of GET_ARG_NUMBER
***** ------------------------------------------------------------------
***** SUB RightADJUST
***** ------------------------------------------------------------------
C----
C---- NAME : RightADJUST
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE RightADJUST(STRING,NLEN)
CHARACTER*(*) STRING
INTEGER NLEN
C...find position of last non-blank
IF (NLEN.LT.1) RETURN
L=NLEN
DO WHILE(STRING(L:L).EQ.' '.AND.L.GT.1)
L=L-1
ENDDO
IF (L.LT.NLEN) THEN
C..L is position of last non-blank
STRING(NLEN-L+1:NLEN)=STRING(1:L)
C.C..fill rest with blanks from 1 to NLEN-L
DO IL=1,NLEN-L
STRING(IL:IL)=' '
ENDDO
ENDIF
RETURN
END
***** end of RIGHTADJUST
***** ------------------------------------------------------------------
***** SUB SCFDATE
***** ------------------------------------------------------------------
C----
C---- NAME : SCFDATE
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Dec, 1991 version 0.1 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE SCFDATE(CALL,LOGIWRITE,DATEOLD)
IMPLICIT NONE
CHARACTER*24 ACTDATE,DATEOLD
INTEGER CALL,ITER
LOGICAL LOGIWRITE
C ACTDATE=FDATE()
ACTDATE=''
IF (LOGIWRITE) THEN
WRITE(6,*)
WRITE(6,'(T10,7A5)')('-----',ITER=1,7)
WRITE(6,*)
IF (CALL.EQ.2) THEN
WRITE(6,'(T10,A11,A24)')'started: ',DATEOLD
WRITE(6,'(T10,A11,A24)')' ended: ',ACTDATE
ELSE
WRITE(6,'(T10,A11,A24)')' time: ',ACTDATE
END IF
WRITE(6,*)
WRITE(6,'(T10,7A5)')('-----',ITER=1,7)
WRITE(6,*)
END IF
IF (CALL.EQ.1) THEN
DATEOLD=ACTDATE
END IF
END
***** end of SCFDATE
***** ------------------------------------------------------------------
***** SUB SFILEOPEN
***** ------------------------------------------------------------------
C----
C---- NAME : SFILEOPEN
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Dec, 1991 version 0.1 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE SFILEOPEN(UNIT,FILENAME,ACTSTATUS,LENGTH,ACTTASK)
IMPLICIT NONE
C---- local function
INTEGER FILEN_STRING
C---- local variables
INTEGER UNIT,LENGTH,IEND
CHARACTER*(*) FILENAME,ACTSTATUS,ACTTASK
CHARACTER*456 CHFILE
******------------------------------*-----------------------------******
C purge blanks from file name
IEND=FILEN_STRING(FILENAME)
CHFILE(1:IEND)=FILENAME(1:IEND)
C OPEN(UNIT,FILE=FILENAME,STATUS=ACTSTATUS)
OPEN(UNIT,FILE=CHFILE(1:IEND),STATUS=ACTSTATUS)
C---- bullshit to avoid warnings
IF (ACTTASK.EQ.'XX') THEN
CONTINUE
END IF
IF (LENGTH.LT.1) THEN
CONTINUE
END IF
RETURN
END
***** end of SFILEOPEN
***** ------------------------------------------------------------------
***** SUB SCHAR_TO_INT
***** ------------------------------------------------------------------
C----
C---- NAME : SCHAR_TO_INT
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Mar, 1993 version 0.1 *
* changed: Apr, 1993 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: The character CHAR is converted to an integer. *
* in variables: CHAR *
* out variables: INUM *
* SBRs calling: from lib-comp.f: *
* -------------- SILEN_STRING(STRING,IBEG,IEND) *
* procedure: be careful '-1' or 'a1' might produce errors *
* ----------
*----------------------------------------------------------------------*
SUBROUTINE SCHAR_TO_INT(CHAR,INUM)
IMPLICIT NONE
C---- variables passed
INTEGER INUM
CHARACTER CHAR*(*)
C---- local variables *
INTEGER ITER,ITER2,IBEG,IEND,ILEN,SUM,PROD
******------------------------------*-----------------------------******
C---- defaults
C---- determine non-blank length of character CHAR
C =================
CALL SILEN_STRING(CHAR,IBEG,IEND)
C =================
ILEN=IEND-IBEG+1
C---- loop over length:
SUM=0
DO ITER=1,ILEN
PROD=1
DO ITER2=1,(ILEN-ITER)
PROD=10*PROD
END DO
IF (CHAR(ITER:ITER).EQ.'1') THEN
SUM=SUM+PROD
ELSEIF (CHAR(ITER:ITER).EQ.'2') THEN
SUM=SUM+PROD*2
ELSEIF (CHAR(ITER:ITER).EQ.'3') THEN
SUM=SUM+PROD*3
ELSEIF (CHAR(ITER:ITER).EQ.'4') THEN
SUM=SUM+PROD*4
ELSEIF (CHAR(ITER:ITER).EQ.'5') THEN
SUM=SUM+PROD*5
ELSEIF (CHAR(ITER:ITER).EQ.'6') THEN
SUM=SUM+PROD*6
ELSEIF (CHAR(ITER:ITER).EQ.'7') THEN
SUM=SUM+PROD*7
ELSEIF (CHAR(ITER:ITER).EQ.'8') THEN
SUM=SUM+PROD*8
ELSEIF (CHAR(ITER:ITER).EQ.'9') THEN
SUM=SUM+PROD*9
END IF
END DO
INUM=SUM
END
***** end of SCHAR_TO_INT
***** ------------------------------------------------------------------
***** SUB SILEN_STRING
***** ------------------------------------------------------------------
C----
C---- NAME : SILEN_STRING
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Feb, 1993 version 0.1 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
* purpose: The length of a given character string is returned
* -------- resp. non-blank begin (ibeg) and end (iend) *
* input: STRING string of character*80 *
* output: ibeg,iend *
*----------------------------------------------------------------------*
SUBROUTINE SILEN_STRING(STRING,IBEG,IEND)
C---- variables passing
CHARACTER STRING*(*)
C---- local variables
INTEGER ICOUNT,ITER,IBEG,IEND
CHARACTER*80 HSTRING
LOGICAL LHELP
******------------------------------*-----------------------------******
C---- defaults
HSTRING=STRING
ICOUNT=0
LHELP=.TRUE.
DO ITER=1,80
IF (LHELP) THEN
IF (HSTRING(ITER:ITER).NE.' ') THEN
IF (ICOUNT.EQ.0) THEN
IBEG=ITER
END IF
ICOUNT=ICOUNT+1
ELSE
IF (ICOUNT.NE.0) THEN
IEND=ITER-1
LHELP=.FALSE.
END IF
END IF
END IF
END DO
IF (ICOUNT.EQ.0) THEN
WRITE(6,'(T2,A,T10,A,A1,A,A1)')'***',
+ 'ERROR: Sbr SILEN_STRING: empty string:','|',STRING,'|'
END IF
END
***** end of SILEN_STRING
***** ------------------------------------------------------------------
***** SUB SRSTE2
***** ------------------------------------------------------------------
C----
C---- NAME : SRSTE2
C---- ARG : RMAT1,RMAT2,IROW,ICOL
C---- DES : sets real matrix RMAT1(IROW,ICOL)=
C---- DES : real matrix RMAT2(IROW,ICOL)
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Mar, 1991 version 0.1 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
C purpose: the 2-dimensional real matrix RMAT1(rows,columns) is set*
C equal to the 2-D real one RMAT2 *
C input parameter: IROW,ICOL *
C input variables: RMAT1(real matrix) , RMAT2 *
C output variables: RMAT1(i,j)=RMAT2(i,j) for all i,j *
*----------------------------------------------------------------------*
SUBROUTINE SRSTE2(RMAT1,RMAT2,IROW,ICOL)
REAL RMAT1(1:IROW,1:ICOL)
REAL RMAT2(1:IROW,1:ICOL)
DO ITER2=1,ICOL
DO ITER1=1,IROW
RMAT1(ITER1,ITER2)=RMAT2(ITER1,ITER2)
END DO
END DO
END
***** end of SRSTE2
***** ------------------------------------------------------------------
***** SUB SRSTZ2
***** ------------------------------------------------------------------
C----
C---- NAME : SRSTZ2
C---- ARG : RMAT,IROW,ICOL
C---- DES : Sets zero a 2-dimensional real matrix with the
C---- DES : row-length
C---- DES : IROW, the column-length ICOL :RMAT(IROW,ICOL)
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Mar, 1991 version 0.1 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
C purpose: a real two dimensional matrix RMAT(rows,columns) is set *
C to zero *
C input parameter: IROW,ICOL *
C input variables: RMAT(real matrix) *
C output variables: RMAT=0. for all elements *
*----------------------------------------------------------------------*
SUBROUTINE SRSTZ2(RMAT,IROW,ICOL)
REAL RMAT(1:IROW,1:ICOL)
DO ITER2=1,ICOL
DO ITER1=1,IROW
RMAT(ITER1,ITER2)=0.
END DO
END DO
END
***** end of SRSTZ2
***** ------------------------------------------------------------------
***** SUB StrPos
***** ------------------------------------------------------------------
C----
C---- NAME : StrPos
C---- ARG :
C---- DES : StrPos(Source,IStart,IStop): Finds the positions of the
C---- DES : first and last non-blank/non-TAB in Source.
C---- DES : IStart=IStop=0 for empty Source
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE StrPos(Source,IStart,IStop)
CHARACTER*(*) Source
INTEGER ISTART,ISTOP
ISTART=0
ISTOP=0
DO J=1,LEN(SOURCE)
IF(SOURCE(J:J).NE.' ')THEN
ISTART=J
GOTO 20
ENDIF
ENDDO
RETURN
20 DO J=LEN(SOURCE),1,-1
IF(SOURCE(J:J).NE.' ')THEN
ISTOP=J
RETURN
ENDIF
ENDDO
ISTART=0
ISTOP=0
RETURN
END
***** end of STRPOS
***** ------------------------------------------------------------------
***** SUB WRITELINES
***** ------------------------------------------------------------------
C----
C---- NAME : WRITELINES
C---- ARG :
C---- DES : if 'cstring' contains '/n' (new line) this routine writes
C---- DES : cstring line by line on screen; called by GETINT,GETREAL..
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE WRITELINES(CSTRING)
CHARACTER*(*) CSTRING
INTEGER ICUTBEGIN(10),ICUTEND(10)
CALL StrPos(CSTRING,ISTART,ISTOP)
ILINE=1
ICUTBEGIN(ILINE)=1
ICUTEND(ILINE)=ISTOP
DO I=1,ISTOP-1
IF(CSTRING(I:I+1).EQ.'/n')THEN
ILINE=ILINE+1
ICUTBEGIN(ILINE)=I+2
ICUTEND(ILINE-1)=I-1
ICUTEND(ILINE)=ISTOP
ENDIF
ENDDO
DO I=1,ILINE
WRITE(*,*)CSTRING(ICUTBEGIN(I):ICUTEND(I))
ENDDO
RETURN
END
***** end of WRITELINES
profnet-1.0.22/src/lib-sys-ALPHA.f 0000644 0150751 0150751 00000021755 12021362711 015717 0 ustar lkajan lkajan ***** ------------------------------------------------------------------
***** FCT FCTIME_DATE
***** ------------------------------------------------------------------
C----
C---- NAME : FCTIME_DATE
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Oct, 2003 version 1.0 *
* EMBL/LION http://www.predictprotein.org/ *
* D-69012 Heidelberg rost@columbia.edu *
* changed: Aug, 2003 version 1.0 *
*----------------------------------------------------------------------*
* purpose: returns date *
* note: machine type dependent: *
* SGI, UNIX, LINUX: absolute unix time *
* IBM: char*8 YYYYMMDD *
* input : NOM, DEN *
*----------------------------------------------------------------------*
CHARACTER*24 FUNCTION FCTIME_DATE()
IMPLICIT NONE
******------------------------------*-----------------------------******
* execution of function *
C FCTIME_DATE=FDATE()
FCTIME_DATE=''
END
***** end of FCTIME_DATE
***** ------------------------------------------------------------------
***** FCT FRTIME_SECNDS
***** ------------------------------------------------------------------
C----
C---- NAME : FRTIME_SECNDS
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Oct, 2003 version 1.0 *
* EMBL/LION http://www.predictprotein.org/ *
* D-69012 Heidelberg rost@columbia.edu *
* changed: Aug, 2003 version 1.0 *
*----------------------------------------------------------------------*
* purpose: returns CPU time seconds *
* note: machine type dependent: *
* SGI, UNIX, LINUX: absolute unix time *
* IBM: cputime *
* input : NOM, DEN *
*----------------------------------------------------------------------*
REAL FUNCTION FRTIME_SECNDS(T1)
IMPLICIT NONE
C---- variables passed from/to SBR calling
REAL T1
******------------------------------*-----------------------------******
* execution of function *
FRTIME_SECNDS=SECNDS(T1)
END
***** end of FRTIME_SECNDS
***** ------------------------------------------------------------------
***** SUB INIJCT
***** ------------------------------------------------------------------
C----
C---- NAME : INIJCT
C---- ARG :
C---- DES : Generation of the initial couplings and biases of
C---- DES : the network. Options:
C---- DES : RANDOM : locfield (i,j,TIMEST=0) = [-/+diceintervall]
C---- DES : with equal distribution
C---- IN p: NUMSAM,NUMIN,NUMHID,NUMOUT, DICESEED
C---- IN v: JCT1ST,JCT2ND,BIAS1ST,BIAS2ND
C---- OUT : setting of JCT1ST, JCT2ND
C---- FROM : MAIN
C---- CALL2:
C---- LIB : RAN(SEED), creates random numbers between 0 and *
C---- LIB+ : 1 (1 excluded, 0 included), it is called by com-*
C---- LIB+ : piling with -lV77, each call initializes next *
C---- LIB+ : seed, according to: seed=6909*seed+mod(2**32) *
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: June, 1998 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE INIJCT
C---- global parameters and variables
INCLUDE 'profPar.f'
C---- local variables
INTEGER I,J,NUMHIDFIRST,NUMHIDLAST
Cunix
REAL RAN,DICE1,DICE2,DICEINTERVX
Clinux
C REAL RAND,DICE1,DICE2,DICEINTERVX
******------------------------------*-----------------------------******
* I,J serve as iteration variables *
* DICE1,2 =RAN(DICESEED1),i.e. random number between 0,1*
* NUMHIDFIRST number of units in the first hidden layer *
* NUMHIDLAST number of units in the last hidden layer *
******------------------------------*-----------------------------******
DICEINTERVX=DICEITRVL
C---- ------------------------------------------------------------------
C---- first layer junctions
C---- ------------------------------------------------------------------
DICESEED1=DICESEED+DICESEED_ADDJCT
IF (NUMLAYERS.EQ.1) THEN
NUMHIDFIRST=NUMOUT
NUMHIDLAST=0
ELSE
NUMHIDFIRST=NUMHID
NUMHIDLAST=NUMHID
END IF
C---- loop over hidden units
DO I=1,NUMHIDFIRST
C------- junctions (loop over input units)
DO J=1,NUMIN
C---------- generating random numbers from [0,1)
Cunix
DICE1= RAN(DICESEED1)
DICE2= RAN(DICESEED1)
Clinux
C DICE1= RAND(DICESEED1)
C DICE2= RAND(DICESEED1)
IF (DICE1.LT.0.5) THEN
JCT1ST(J,I)= (-1.)*DICEINTERVX*DICE2
ELSE
JCT1ST(J,I)= DICEINTERVX*DICE2
END IF
END DO
C------- thresholds (resp. biases)
C------- generating random numbers from [0,1)
Cunix
DICE1= RAN(DICESEED1)
DICE2= RAN(DICESEED1)
Clinux
C DICE1= RAND(DICESEED1)
C DICE2= RAND(DICESEED1)
IF (DICE1.LT.0.5) THEN
JCT1ST((NUMIN+1),I)=
+ (-1.)*DICEINTERVX*DICE2
ELSE
JCT1ST((NUMIN+1),I)=DICEINTERVX*DICE2
END IF
END DO
C---- ------------------------------------------------------------------
C---- last layer junctions
C---- ------------------------------------------------------------------
DO I=1,NUMOUT
C------- junctions
DO J=1,NUMHIDLAST
C---------- generating random numbers from [0,1)
Cunix
DICE1= RAN(DICESEED1)
DICE2= RAN(DICESEED1)
Clinux
C DICE1= RAND(DICESEED1)
C DICE2= RAND(DICESEED1)
IF (DICE1.LT.0.5) THEN
JCT2ND(J,I)=(-1.)*DICEINTERVX*DICE2
ELSE
JCT2ND(J,I)=DICEINTERVX*DICE2
END IF
END DO
C------- thresholds (resp. biases)
C------- generating random numbers from [0,1)
Cunix
DICE1= RAN(DICESEED1)
DICE2= RAN(DICESEED1)
Clinux
C DICE1= RAND(DICESEED1)
C DICE2= RAND(DICESEED1)
IF (DICE1.LT.0.5) THEN
JCT2ND((NUMHID+1),I)=(-1.)*DICEINTERVX*DICE2
ELSE
JCT2ND((NUMHID+1),I)=DICEINTERVX*DICE2
END IF
END DO
END
***** end of INIJCT
***** ------------------------------------------------------------------
***** SUB SRDTIME
***** ------------------------------------------------------------------
C----
C---- NAME : SRDTIME
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Dec, 1991 version 0.1 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
*** ***
*** ***
*** SUBROUTINE SRDTIME ***
*** ***
*** ***
*----------------------------------------------------------------------*
SUBROUTINE SRDTIME(LOGIWRITE)
IMPLICIT NONE
Cunix
REAL TIMEARRAYM,TIMEDIFF,DTIME,TIME_TMP
Clinux
C REAL TIMEARRAYM(1:2),TIMEDIFF,DTIME
INTEGER ITER
LOGICAL LOGIWRITE
Cunix
TIMEDIFF=DTIME(TIMEARRAYM,TIME_TMP)
Clinux
C TIMEDIFF=DTIME(TIMEARRAYM)
IF (LOGIWRITE) THEN
WRITE(6,*)
WRITE(6,'(T10,7A5)')('-----',ITER=1,7)
WRITE(6,*)
WRITE (6,'(T10,A12,T25,F9.3,A5)')
+ 'total time: ',TIMEDIFF,' sec'
WRITE(6,*)
WRITE(6,'(T10,7A5)')('-----',ITER=1,7)
WRITE(6,*)
END IF
END
***** end of SRDTIME
profnet-1.0.22/src/lib-sys-LINUX.f 0000755 0150751 0150751 00000014322 12021362712 015765 0 ustar lkajan lkajan ***** ------------------------------------------------------------------
***** SUB INIJCT
***** ------------------------------------------------------------------
C----
C---- NAME : INIJCT
C---- ARG :
C---- DES : Generation of the initial couplings and biases of
C---- DES : the network. Options:
C---- DES : RANDOM : locfield (i,j,TIMEST=0) = [-/+diceintervall]
C---- DES : with equal distribution
C---- IN p: NUMSAM,NUMIN,NUMHID,NUMOUT, DICESEED
C---- IN v: JCT1ST,JCT2ND,BIAS1ST,BIAS2ND
C---- OUT : setting of JCT1ST, JCT2ND
C---- FROM : MAIN
C---- CALL2:
C---- LIB : RAN(SEED), creates random numbers between 0 and *
C---- LIB+ : 1 (1 excluded, 0 included), it is called by com-*
C---- LIB+ : piling with -lV77, each call initializes next *
C---- LIB+ : seed, according to: seed=6909*seed+mod(2**32) *
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: June, 1998 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE INIJCT
C---- global parameters and variables
INCLUDE 'profPar.f'
C---- local variables
INTEGER I,J,NUMHIDFIRST,NUMHIDLAST
Cunix
C REAL RAN,DICE1,DICE2,DICEINTERVX
Clinux
REAL RAND,DICE1,DICE2,DICEINTERVX
******------------------------------*-----------------------------******
* I,J serve as iteration variables *
* DICE1,2 =RAN(DICESEED1),i.e. random number between 0,1*
* NUMHIDFIRST number of units in the first hidden layer *
* NUMHIDLAST number of units in the last hidden layer *
******------------------------------*-----------------------------******
DICEINTERVX=DICEITRVL
C---- ------------------------------------------------------------------
C---- first layer junctions
C---- ------------------------------------------------------------------
DICESEED1=DICESEED+DICESEED_ADDJCT
IF (NUMLAYERS.EQ.1) THEN
NUMHIDFIRST=NUMOUT
NUMHIDLAST=0
ELSE
NUMHIDFIRST=NUMHID
NUMHIDLAST=NUMHID
END IF
C---- loop over hidden units
DO I=1,NUMHIDFIRST
C------- junctions (loop over input units)
DO J=1,NUMIN
C---------- generating random numbers from [0,1)
Cunix
C DICE1= RAN(DICESEED1)
C DICE2= RAN(DICESEED1)
Clinux
DICE1= RAND(DICESEED1)
DICE2= RAND(DICESEED1)
IF (DICE1.LT.0.5) THEN
JCT1ST(J,I)= (-1.)*DICEINTERVX*DICE2
ELSE
JCT1ST(J,I)= DICEINTERVX*DICE2
END IF
END DO
C------- thresholds (resp. biases)
C------- generating random numbers from [0,1)
Cunix
C DICE1= RAN(DICESEED1)
C DICE2= RAN(DICESEED1)
Clinux
DICE1= RAND(DICESEED1)
DICE2= RAND(DICESEED1)
IF (DICE1.LT.0.5) THEN
JCT1ST((NUMIN+1),I)=
+ (-1.)*DICEINTERVX*DICE2
ELSE
JCT1ST((NUMIN+1),I)=DICEINTERVX*DICE2
END IF
END DO
C---- ------------------------------------------------------------------
C---- last layer junctions
C---- ------------------------------------------------------------------
DO I=1,NUMOUT
C------- junctions
DO J=1,NUMHIDLAST
C---------- generating random numbers from [0,1)
Cunix
C DICE1= RAN(DICESEED1)
C DICE2= RAN(DICESEED1)
Clinux
DICE1= RAND(DICESEED1)
DICE2= RAND(DICESEED1)
IF (DICE1.LT.0.5) THEN
JCT2ND(J,I)=(-1.)*DICEINTERVX*DICE2
ELSE
JCT2ND(J,I)=DICEINTERVX*DICE2
END IF
END DO
C------- thresholds (resp. biases)
C------- generating random numbers from [0,1)
Cunix
C DICE1= RAN(DICESEED1)
C DICE2= RAN(DICESEED1)
Clinux
DICE1= RAND(DICESEED1)
DICE2= RAND(DICESEED1)
IF (DICE1.LT.0.5) THEN
JCT2ND((NUMHID+1),I)=(-1.)*DICEINTERVX*DICE2
ELSE
JCT2ND((NUMHID+1),I)=DICEINTERVX*DICE2
END IF
END DO
END
***** end of INIJCT
***** ------------------------------------------------------------------
***** SUB SRDTIME
***** ------------------------------------------------------------------
C----
C---- NAME : SRDTIME
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Dec, 1991 version 0.1 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
*** ***
*** ***
*** SUBROUTINE SRDTIME ***
*** ***
*** ***
*----------------------------------------------------------------------*
SUBROUTINE SRDTIME(LOGIWRITE)
IMPLICIT NONE
Cunix
C REAL TIMEARRAYM,TIMEDIFF,DTIME,TIME_TMP
Clinux
REAL TIMEARRAYM(1:2),TIMEDIFF,DTIME
INTEGER ITER
LOGICAL LOGIWRITE
Cunix
C TIMEDIFF=DTIME(TIMEARRAYM,TIME_TMP)
Clinux
TIMEDIFF=DTIME(TIMEARRAYM)
C TIMEDIFF= TIMEDIFFX(1)
IF (LOGIWRITE) THEN
WRITE(6,*)
WRITE(6,'(T10,7A5)')('-----',ITER=1,7)
WRITE(6,*)
WRITE (6,'(T10,A12,T25,F9.3,A5)')
+ 'total time: ',TIMEDIFF,' sec'
WRITE(6,*)
WRITE(6,'(T10,7A5)')('-----',ITER=1,7)
WRITE(6,*)
END IF
END
***** end of SRDTIME
profnet-1.0.22/src/lib-sys-MAC.f 0000644 0150751 0150751 00000014322 12021362712 015463 0 ustar lkajan lkajan ***** ------------------------------------------------------------------
***** SUB INIJCT
***** ------------------------------------------------------------------
C----
C---- NAME : INIJCT
C---- ARG :
C---- DES : Generation of the initial couplings and biases of
C---- DES : the network. Options:
C---- DES : RANDOM : locfield (i,j,TIMEST=0) = [-/+diceintervall]
C---- DES : with equal distribution
C---- IN p: NUMSAM,NUMIN,NUMHID,NUMOUT, DICESEED
C---- IN v: JCT1ST,JCT2ND,BIAS1ST,BIAS2ND
C---- OUT : setting of JCT1ST, JCT2ND
C---- FROM : MAIN
C---- CALL2:
C---- LIB : RAN(SEED), creates random numbers between 0 and *
C---- LIB+ : 1 (1 excluded, 0 included), it is called by com-*
C---- LIB+ : piling with -lV77, each call initializes next *
C---- LIB+ : seed, according to: seed=6909*seed+mod(2**32) *
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: June, 1998 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE INIJCT
C---- global parameters and variables
INCLUDE 'profPar.f'
C---- local variables
INTEGER I,J,NUMHIDFIRST,NUMHIDLAST
Cunix
C REAL RAN,DICE1,DICE2,DICEINTERVX
Clinux
REAL RAND,DICE1,DICE2,DICEINTERVX
******------------------------------*-----------------------------******
* I,J serve as iteration variables *
* DICE1,2 =RAN(DICESEED1),i.e. random number between 0,1*
* NUMHIDFIRST number of units in the first hidden layer *
* NUMHIDLAST number of units in the last hidden layer *
******------------------------------*-----------------------------******
DICEINTERVX=DICEITRVL
C---- ------------------------------------------------------------------
C---- first layer junctions
C---- ------------------------------------------------------------------
DICESEED1=DICESEED+DICESEED_ADDJCT
IF (NUMLAYERS.EQ.1) THEN
NUMHIDFIRST=NUMOUT
NUMHIDLAST=0
ELSE
NUMHIDFIRST=NUMHID
NUMHIDLAST=NUMHID
END IF
C---- loop over hidden units
DO I=1,NUMHIDFIRST
C------- junctions (loop over input units)
DO J=1,NUMIN
C---------- generating random numbers from [0,1)
Cunix
C DICE1= RAN(DICESEED1)
C DICE2= RAN(DICESEED1)
Clinux
DICE1= RAND(DICESEED1)
DICE2= RAND(DICESEED1)
IF (DICE1.LT.0.5) THEN
JCT1ST(J,I)= (-1.)*DICEINTERVX*DICE2
ELSE
JCT1ST(J,I)= DICEINTERVX*DICE2
END IF
END DO
C------- thresholds (resp. biases)
C------- generating random numbers from [0,1)
Cunix
C DICE1= RAN(DICESEED1)
C DICE2= RAN(DICESEED1)
Clinux
DICE1= RAND(DICESEED1)
DICE2= RAND(DICESEED1)
IF (DICE1.LT.0.5) THEN
JCT1ST((NUMIN+1),I)=
+ (-1.)*DICEINTERVX*DICE2
ELSE
JCT1ST((NUMIN+1),I)=DICEINTERVX*DICE2
END IF
END DO
C---- ------------------------------------------------------------------
C---- last layer junctions
C---- ------------------------------------------------------------------
DO I=1,NUMOUT
C------- junctions
DO J=1,NUMHIDLAST
C---------- generating random numbers from [0,1)
Cunix
C DICE1= RAN(DICESEED1)
C DICE2= RAN(DICESEED1)
Clinux
DICE1= RAND(DICESEED1)
DICE2= RAND(DICESEED1)
IF (DICE1.LT.0.5) THEN
JCT2ND(J,I)=(-1.)*DICEINTERVX*DICE2
ELSE
JCT2ND(J,I)=DICEINTERVX*DICE2
END IF
END DO
C------- thresholds (resp. biases)
C------- generating random numbers from [0,1)
Cunix
C DICE1= RAN(DICESEED1)
C DICE2= RAN(DICESEED1)
Clinux
DICE1= RAND(DICESEED1)
DICE2= RAND(DICESEED1)
IF (DICE1.LT.0.5) THEN
JCT2ND((NUMHID+1),I)=(-1.)*DICEINTERVX*DICE2
ELSE
JCT2ND((NUMHID+1),I)=DICEINTERVX*DICE2
END IF
END DO
END
***** end of INIJCT
***** ------------------------------------------------------------------
***** SUB SRDTIME
***** ------------------------------------------------------------------
C----
C---- NAME : SRDTIME
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Dec, 1991 version 0.1 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
*** ***
*** ***
*** SUBROUTINE SRDTIME ***
*** ***
*** ***
*----------------------------------------------------------------------*
SUBROUTINE SRDTIME(LOGIWRITE)
IMPLICIT NONE
Cunix
C REAL TIMEARRAYM,TIMEDIFF,DTIME,TIME_TMP
Clinux
REAL TIMEARRAYM(1:2),TIMEDIFF,DTIME
INTEGER ITER
LOGICAL LOGIWRITE
Cunix
C TIMEDIFF=DTIME(TIMEARRAYM,TIME_TMP)
Clinux
TIMEDIFF=DTIME(TIMEARRAYM)
C TIMEDIFF= TIMEDIFFX(1)
IF (LOGIWRITE) THEN
WRITE(6,*)
WRITE(6,'(T10,7A5)')('-----',ITER=1,7)
WRITE(6,*)
WRITE (6,'(T10,A12,T25,F9.3,A5)')
+ 'total time: ',TIMEDIFF,' sec'
WRITE(6,*)
WRITE(6,'(T10,7A5)')('-----',ITER=1,7)
WRITE(6,*)
END IF
END
***** end of SRDTIME
profnet-1.0.22/src/lib-sys-MACIBM.f 0000644 0150751 0150751 00000023635 12021362711 016021 0 ustar lkajan lkajan ***** ------------------------------------------------------------------
***** FCT FCTIME_DATE
***** ------------------------------------------------------------------
C----
C---- NAME : FCTIME_DATE
C---- ARG :
C---- DES :
C---- OUT : character*24 'YYYY_MM_DD - hh:mm:ss'
C----
*----------------------------------------------------------------------*
* Burkhard Rost Oct, 2003 version 1.0 *
* EMBL/LION http://www.predictprotein.org/ *
* D-69012 Heidelberg rost@columbia.edu *
* changed: Aug, 2003 version 1.0 *
*----------------------------------------------------------------------*
* purpose: returns date *
* note: machine type dependent: *
* SGI, UNIX, LINUX: absolute unix time *
* IBM: char*8 YYYYMMDD *
* input : NOM, DEN *
*----------------------------------------------------------------------*
CHARACTER*24 FUNCTION FCTIME_DATE()
IMPLICIT NONE
C---- variables passed from/to SBR calling
CHARACTER*24 CTEMP,CTEMP2
******------------------------------*-----------------------------******
* execution of function *
CTEMP=' '
CALL DATE_AND_TIME(CTEMP)
FCTIME_DATE= ' '
FCTIME_DATE(1:4)= CTEMP(1:4)
FCTIME_DATE(5:5)= '_'
FCTIME_DATE(6:7)= CTEMP(5:6)
FCTIME_DATE(8:8)= '_'
FCTIME_DATE(9:10)= CTEMP(7:8)
FCTIME_DATE(11:13)=' - '
FCTIME_DATE(14:15)=CTEMP2(1:2)
FCTIME_DATE(16:16)=':'
FCTIME_DATE(17:18)=CTEMP2(3:4)
FCTIME_DATE(19:19)=':'
FCTIME_DATE(20:21)=CTEMP2(5:6)
END
***** end of FCTIME_DATE
***** ------------------------------------------------------------------
***** FCT FRTIME_SECNDS
***** ------------------------------------------------------------------
C----
C---- NAME : FRTIME_SECNDS
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Oct, 2003 version 1.0 *
* EMBL/LION http://www.predictprotein.org/ *
* D-69012 Heidelberg rost@columbia.edu *
* changed: Aug, 2003 version 1.0 *
*----------------------------------------------------------------------*
* purpose: returns CPU time seconds *
* note: machine type dependent: *
* SGI, UNIX, LINUX: absolute unix time *
* IBM: cputime *
* input : T1: time to start (from previous call for unix) *
*----------------------------------------------------------------------*
REAL FUNCTION FRTIME_SECNDS(T1)
IMPLICIT NONE
C---- variables passed from/to SBR calling
REAL T1
******------------------------------*-----------------------------******
* execution of function *
CALL CPU_TIME(T1)
FRTIME_SECNDS=T1
END
***** end of FRTIME_SECNDS
***** ------------------------------------------------------------------
***** SUB INIJCT
***** ------------------------------------------------------------------
C----
C---- NAME : INIJCT
C---- ARG :
C---- DES : Generation of the initial couplings and biases of
C---- DES : the network. Options:
C---- DES : RANDOM : locfield (i,j,TIMEST=0) = [-/+diceintervall]
C---- DES : with equal distribution
C---- IN p: NUMSAM,NUMIN,NUMHID,NUMOUT, DICESEED
C---- IN v: JCT1ST,JCT2ND,BIAS1ST,BIAS2ND
C---- OUT : setting of JCT1ST, JCT2ND
C---- FROM : MAIN
C---- CALL2:
C---- LIB : RAN(SEED), creates random numbers between 0 and *
C---- LIB+ : 1 (1 excluded, 0 included), it is called by com-*
C---- LIB+ : piling with -lV77, each call initializes next *
C---- LIB+ : seed, according to: seed=6909*seed+mod(2**32) *
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: June, 1998 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE INIJCT
C---- global parameters and variables
INCLUDE 'profPar.f'
C---- local variables
INTEGER I,J,NUMHIDFIRST,NUMHIDLAST
Cunix
C REAL RAN,DICE1,DICE2,DICEINTERVX
Clinux
REAL RAND,DICE1,DICE2,DICEINTERVX
******------------------------------*-----------------------------******
* I,J serve as iteration variables *
* DICE1,2 =RAN(DICESEED1),i.e. random number between 0,1*
* NUMHIDFIRST number of units in the first hidden layer *
* NUMHIDLAST number of units in the last hidden layer *
******------------------------------*-----------------------------******
DICEINTERVX=DICEITRVL
C---- ------------------------------------------------------------------
C---- first layer junctions
C---- ------------------------------------------------------------------
DICESEED1=DICESEED+DICESEED_ADDJCT
IF (NUMLAYERS.EQ.1) THEN
NUMHIDFIRST=NUMOUT
NUMHIDLAST=0
ELSE
NUMHIDFIRST=NUMHID
NUMHIDLAST=NUMHID
END IF
C---- loop over hidden units
DO I=1,NUMHIDFIRST
C------- junctions (loop over input units)
DO J=1,NUMIN
C---------- generating random numbers from [0,1)
Cunix
C DICE1= RAN(DICESEED1)
C DICE2= RAN(DICESEED1)
Clinux
C DICE1= RAND(DICESEED1)
C DICE2= RAND(DICESEED1)
Cibm
CALL RANDOM_NUMBER(DICE1)
CALL RANDOM_NUMBER(DICE2)
IF (DICE1.LT.0.5) THEN
JCT1ST(J,I)= (-1.)*DICEINTERVX*DICE2
ELSE
JCT1ST(J,I)= DICEINTERVX*DICE2
END IF
END DO
C------- thresholds (resp. biases)
C------- generating random numbers from [0,1)
Cunix
C DICE1= RAN(DICESEED1)
C DICE2= RAN(DICESEED1)
Clinux
C DICE1= RAND(DICESEED1)
C DICE2= RAND(DICESEED1)
Cibm
CALL RANDOM_NUMBER(DICE1)
CALL RANDOM_NUMBER(DICE2)
IF (DICE1.LT.0.5) THEN
JCT1ST((NUMIN+1),I)=
+ (-1.)*DICEINTERVX*DICE2
ELSE
JCT1ST((NUMIN+1),I)=DICEINTERVX*DICE2
END IF
END DO
C---- ------------------------------------------------------------------
C---- last layer junctions
C---- ------------------------------------------------------------------
DO I=1,NUMOUT
C------- junctions
DO J=1,NUMHIDLAST
C---------- generating random numbers from [0,1)
Cunix
C DICE1= RAN(DICESEED1)
C DICE2= RAN(DICESEED1)
Clinux
C DICE1= RAND(DICESEED1)
C DICE2= RAND(DICESEED1)
Cibm
CALL RANDOM_NUMBER(DICE1)
CALL RANDOM_NUMBER(DICE2)
IF (DICE1.LT.0.5) THEN
JCT2ND(J,I)=(-1.)*DICEINTERVX*DICE2
ELSE
JCT2ND(J,I)=DICEINTERVX*DICE2
END IF
END DO
C------- thresholds (resp. biases)
C------- generating random numbers from [0,1)
Cunix
C DICE1= RAN(DICESEED1)
C DICE2= RAN(DICESEED1)
Clinux
C DICE1= RAND(DICESEED1)
C DICE2= RAND(DICESEED1)
Cibm
CALL RANDOM_NUMBER(DICE1)
CALL RANDOM_NUMBER(DICE2)
IF (DICE1.LT.0.5) THEN
JCT2ND((NUMHID+1),I)=(-1.)*DICEINTERVX*DICE2
ELSE
JCT2ND((NUMHID+1),I)=DICEINTERVX*DICE2
END IF
END DO
END
***** end of INIJCT
***** ------------------------------------------------------------------
***** SUB SRDTIME
***** ------------------------------------------------------------------
C----
C---- NAME : SRDTIME
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Dec, 1991 version 0.1 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
*** ***
*** ***
*** SUBROUTINE SRDTIME ***
*** ***
*** ***
*----------------------------------------------------------------------*
SUBROUTINE SRDTIME(LOGIWRITE)
IMPLICIT NONE
Cunix
C REAL TIMEARRAYM,TIMEDIFF,DTIME,TIME_TMP
Clinux
REAL TIMEARRAYM(1:2),TIMEDIFF,DTIME,TIME_TMP
INTEGER ITER
LOGICAL LOGIWRITE
Cunix
C TIMEDIFF=DTIME(TIMEARRAYM,TIME_TMP)
Clinux
CC TIMEDIFF= TIMEDIFFX(1)
C TIMEDIFF=DTIME(TIMEARRAYM)
Cibm
CALL CPU_TIME(TIMEDIFF)
IF (LOGIWRITE) THEN
WRITE(6,*)
WRITE(6,'(T10,7A5)')('-----',ITER=1,7)
WRITE(6,*)
WRITE (6,'(T10,A12,T25,F9.3,A5)')
+ 'total time: ',TIMEDIFF,' sec'
WRITE(6,*)
WRITE(6,'(T10,7A5)')('-----',ITER=1,7)
WRITE(6,*)
END IF
END
***** end of SRDTIME
profnet-1.0.22/src/lib-sys-MACINTEL.f 0000644 0150751 0150751 00000014322 12021362712 016257 0 ustar lkajan lkajan ***** ------------------------------------------------------------------
***** SUB INIJCT
***** ------------------------------------------------------------------
C----
C---- NAME : INIJCT
C---- ARG :
C---- DES : Generation of the initial couplings and biases of
C---- DES : the network. Options:
C---- DES : RANDOM : locfield (i,j,TIMEST=0) = [-/+diceintervall]
C---- DES : with equal distribution
C---- IN p: NUMSAM,NUMIN,NUMHID,NUMOUT, DICESEED
C---- IN v: JCT1ST,JCT2ND,BIAS1ST,BIAS2ND
C---- OUT : setting of JCT1ST, JCT2ND
C---- FROM : MAIN
C---- CALL2:
C---- LIB : RAN(SEED), creates random numbers between 0 and *
C---- LIB+ : 1 (1 excluded, 0 included), it is called by com-*
C---- LIB+ : piling with -lV77, each call initializes next *
C---- LIB+ : seed, according to: seed=6909*seed+mod(2**32) *
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: June, 1998 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE INIJCT
C---- global parameters and variables
INCLUDE 'profPar.f'
C---- local variables
INTEGER I,J,NUMHIDFIRST,NUMHIDLAST
Cunix
C REAL RAN,DICE1,DICE2,DICEINTERVX
Clinux
REAL RAND,DICE1,DICE2,DICEINTERVX
******------------------------------*-----------------------------******
* I,J serve as iteration variables *
* DICE1,2 =RAN(DICESEED1),i.e. random number between 0,1*
* NUMHIDFIRST number of units in the first hidden layer *
* NUMHIDLAST number of units in the last hidden layer *
******------------------------------*-----------------------------******
DICEINTERVX=DICEITRVL
C---- ------------------------------------------------------------------
C---- first layer junctions
C---- ------------------------------------------------------------------
DICESEED1=DICESEED+DICESEED_ADDJCT
IF (NUMLAYERS.EQ.1) THEN
NUMHIDFIRST=NUMOUT
NUMHIDLAST=0
ELSE
NUMHIDFIRST=NUMHID
NUMHIDLAST=NUMHID
END IF
C---- loop over hidden units
DO I=1,NUMHIDFIRST
C------- junctions (loop over input units)
DO J=1,NUMIN
C---------- generating random numbers from [0,1)
Cunix
C DICE1= RAN(DICESEED1)
C DICE2= RAN(DICESEED1)
Clinux
DICE1= RAND(DICESEED1)
DICE2= RAND(DICESEED1)
IF (DICE1.LT.0.5) THEN
JCT1ST(J,I)= (-1.)*DICEINTERVX*DICE2
ELSE
JCT1ST(J,I)= DICEINTERVX*DICE2
END IF
END DO
C------- thresholds (resp. biases)
C------- generating random numbers from [0,1)
Cunix
C DICE1= RAN(DICESEED1)
C DICE2= RAN(DICESEED1)
Clinux
DICE1= RAND(DICESEED1)
DICE2= RAND(DICESEED1)
IF (DICE1.LT.0.5) THEN
JCT1ST((NUMIN+1),I)=
+ (-1.)*DICEINTERVX*DICE2
ELSE
JCT1ST((NUMIN+1),I)=DICEINTERVX*DICE2
END IF
END DO
C---- ------------------------------------------------------------------
C---- last layer junctions
C---- ------------------------------------------------------------------
DO I=1,NUMOUT
C------- junctions
DO J=1,NUMHIDLAST
C---------- generating random numbers from [0,1)
Cunix
C DICE1= RAN(DICESEED1)
C DICE2= RAN(DICESEED1)
Clinux
DICE1= RAND(DICESEED1)
DICE2= RAND(DICESEED1)
IF (DICE1.LT.0.5) THEN
JCT2ND(J,I)=(-1.)*DICEINTERVX*DICE2
ELSE
JCT2ND(J,I)=DICEINTERVX*DICE2
END IF
END DO
C------- thresholds (resp. biases)
C------- generating random numbers from [0,1)
Cunix
C DICE1= RAN(DICESEED1)
C DICE2= RAN(DICESEED1)
Clinux
DICE1= RAND(DICESEED1)
DICE2= RAND(DICESEED1)
IF (DICE1.LT.0.5) THEN
JCT2ND((NUMHID+1),I)=(-1.)*DICEINTERVX*DICE2
ELSE
JCT2ND((NUMHID+1),I)=DICEINTERVX*DICE2
END IF
END DO
END
***** end of INIJCT
***** ------------------------------------------------------------------
***** SUB SRDTIME
***** ------------------------------------------------------------------
C----
C---- NAME : SRDTIME
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Dec, 1991 version 0.1 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
*** ***
*** ***
*** SUBROUTINE SRDTIME ***
*** ***
*** ***
*----------------------------------------------------------------------*
SUBROUTINE SRDTIME(LOGIWRITE)
IMPLICIT NONE
Cunix
C REAL TIMEARRAYM,TIMEDIFF,DTIME,TIME_TMP
Clinux
REAL TIMEARRAYM(1:2),TIMEDIFF,DTIME
INTEGER ITER
LOGICAL LOGIWRITE
Cunix
C TIMEDIFF=DTIME(TIMEARRAYM,TIME_TMP)
Clinux
TIMEDIFF=DTIME(TIMEARRAYM)
C TIMEDIFF= TIMEDIFFX(1)
IF (LOGIWRITE) THEN
WRITE(6,*)
WRITE(6,'(T10,7A5)')('-----',ITER=1,7)
WRITE(6,*)
WRITE (6,'(T10,A12,T25,F9.3,A5)')
+ 'total time: ',TIMEDIFF,' sec'
WRITE(6,*)
WRITE(6,'(T10,7A5)')('-----',ITER=1,7)
WRITE(6,*)
END IF
END
***** end of SRDTIME
profnet-1.0.22/src/lib-sys-SGI64.f 0000644 0150751 0150751 00000021755 12021362712 015667 0 ustar lkajan lkajan ***** ------------------------------------------------------------------
***** FCT FCTIME_DATE
***** ------------------------------------------------------------------
C----
C---- NAME : FCTIME_DATE
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Oct, 2003 version 1.0 *
* EMBL/LION http://www.predictprotein.org/ *
* D-69012 Heidelberg rost@columbia.edu *
* changed: Aug, 2003 version 1.0 *
*----------------------------------------------------------------------*
* purpose: returns date *
* note: machine type dependent: *
* SGI, UNIX, LINUX: absolute unix time *
* IBM: char*8 YYYYMMDD *
* input : NOM, DEN *
*----------------------------------------------------------------------*
CHARACTER*24 FUNCTION FCTIME_DATE()
IMPLICIT NONE
******------------------------------*-----------------------------******
* execution of function *
C FCTIME_DATE=FDATE()
FCTIME_DATE=''
END
***** end of FCTIME_DATE
***** ------------------------------------------------------------------
***** FCT FRTIME_SECNDS
***** ------------------------------------------------------------------
C----
C---- NAME : FRTIME_SECNDS
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Oct, 2003 version 1.0 *
* EMBL/LION http://www.predictprotein.org/ *
* D-69012 Heidelberg rost@columbia.edu *
* changed: Aug, 2003 version 1.0 *
*----------------------------------------------------------------------*
* purpose: returns CPU time seconds *
* note: machine type dependent: *
* SGI, UNIX, LINUX: absolute unix time *
* IBM: cputime *
* input : NOM, DEN *
*----------------------------------------------------------------------*
REAL FUNCTION FRTIME_SECNDS(T1)
IMPLICIT NONE
C---- variables passed from/to SBR calling
REAL T1
******------------------------------*-----------------------------******
* execution of function *
FRTIME_SECNDS=SECNDS(T1)
END
***** end of FRTIME_SECNDS
***** ------------------------------------------------------------------
***** SUB INIJCT
***** ------------------------------------------------------------------
C----
C---- NAME : INIJCT
C---- ARG :
C---- DES : Generation of the initial couplings and biases of
C---- DES : the network. Options:
C---- DES : RANDOM : locfield (i,j,TIMEST=0) = [-/+diceintervall]
C---- DES : with equal distribution
C---- IN p: NUMSAM,NUMIN,NUMHID,NUMOUT, DICESEED
C---- IN v: JCT1ST,JCT2ND,BIAS1ST,BIAS2ND
C---- OUT : setting of JCT1ST, JCT2ND
C---- FROM : MAIN
C---- CALL2:
C---- LIB : RAN(SEED), creates random numbers between 0 and *
C---- LIB+ : 1 (1 excluded, 0 included), it is called by com-*
C---- LIB+ : piling with -lV77, each call initializes next *
C---- LIB+ : seed, according to: seed=6909*seed+mod(2**32) *
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: June, 1998 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE INIJCT
C---- global parameters and variables
INCLUDE 'profPar.f'
C---- local variables
INTEGER I,J,NUMHIDFIRST,NUMHIDLAST
Cunix
REAL RAN,DICE1,DICE2,DICEINTERVX
Clinux
C REAL RAND,DICE1,DICE2,DICEINTERVX
******------------------------------*-----------------------------******
* I,J serve as iteration variables *
* DICE1,2 =RAN(DICESEED1),i.e. random number between 0,1*
* NUMHIDFIRST number of units in the first hidden layer *
* NUMHIDLAST number of units in the last hidden layer *
******------------------------------*-----------------------------******
DICEINTERVX=DICEITRVL
C---- ------------------------------------------------------------------
C---- first layer junctions
C---- ------------------------------------------------------------------
DICESEED1=DICESEED+DICESEED_ADDJCT
IF (NUMLAYERS.EQ.1) THEN
NUMHIDFIRST=NUMOUT
NUMHIDLAST=0
ELSE
NUMHIDFIRST=NUMHID
NUMHIDLAST=NUMHID
END IF
C---- loop over hidden units
DO I=1,NUMHIDFIRST
C------- junctions (loop over input units)
DO J=1,NUMIN
C---------- generating random numbers from [0,1)
Cunix
DICE1= RAN(DICESEED1)
DICE2= RAN(DICESEED1)
Clinux
C DICE1= RAND(DICESEED1)
C DICE2= RAND(DICESEED1)
IF (DICE1.LT.0.5) THEN
JCT1ST(J,I)= (-1.)*DICEINTERVX*DICE2
ELSE
JCT1ST(J,I)= DICEINTERVX*DICE2
END IF
END DO
C------- thresholds (resp. biases)
C------- generating random numbers from [0,1)
Cunix
DICE1= RAN(DICESEED1)
DICE2= RAN(DICESEED1)
Clinux
C DICE1= RAND(DICESEED1)
C DICE2= RAND(DICESEED1)
IF (DICE1.LT.0.5) THEN
JCT1ST((NUMIN+1),I)=
+ (-1.)*DICEINTERVX*DICE2
ELSE
JCT1ST((NUMIN+1),I)=DICEINTERVX*DICE2
END IF
END DO
C---- ------------------------------------------------------------------
C---- last layer junctions
C---- ------------------------------------------------------------------
DO I=1,NUMOUT
C------- junctions
DO J=1,NUMHIDLAST
C---------- generating random numbers from [0,1)
Cunix
DICE1= RAN(DICESEED1)
DICE2= RAN(DICESEED1)
Clinux
C DICE1= RAND(DICESEED1)
C DICE2= RAND(DICESEED1)
IF (DICE1.LT.0.5) THEN
JCT2ND(J,I)=(-1.)*DICEINTERVX*DICE2
ELSE
JCT2ND(J,I)=DICEINTERVX*DICE2
END IF
END DO
C------- thresholds (resp. biases)
C------- generating random numbers from [0,1)
Cunix
DICE1= RAN(DICESEED1)
DICE2= RAN(DICESEED1)
Clinux
C DICE1= RAND(DICESEED1)
C DICE2= RAND(DICESEED1)
IF (DICE1.LT.0.5) THEN
JCT2ND((NUMHID+1),I)=(-1.)*DICEINTERVX*DICE2
ELSE
JCT2ND((NUMHID+1),I)=DICEINTERVX*DICE2
END IF
END DO
END
***** end of INIJCT
***** ------------------------------------------------------------------
***** SUB SRDTIME
***** ------------------------------------------------------------------
C----
C---- NAME : SRDTIME
C---- ARG :
C---- DES :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: Dec, 1991 version 0.1 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
*** ***
*** ***
*** SUBROUTINE SRDTIME ***
*** ***
*** ***
*----------------------------------------------------------------------*
SUBROUTINE SRDTIME(LOGIWRITE)
IMPLICIT NONE
Cunix
REAL TIMEARRAYM,TIMEDIFF,DTIME,TIME_TMP
Clinux
C REAL TIMEARRAYM(1:2),TIMEDIFF,DTIME
INTEGER ITER
LOGICAL LOGIWRITE
Cunix
TIMEDIFF=DTIME(TIMEARRAYM,TIME_TMP)
Clinux
C TIMEDIFF=DTIME(TIMEARRAYM)
IF (LOGIWRITE) THEN
WRITE(6,*)
WRITE(6,'(T10,7A5)')('-----',ITER=1,7)
WRITE(6,*)
WRITE (6,'(T10,A12,T25,F9.3,A5)')
+ 'total time: ',TIMEDIFF,' sec'
WRITE(6,*)
WRITE(6,'(T10,7A5)')('-----',ITER=1,7)
WRITE(6,*)
END IF
END
***** end of SRDTIME
profnet-1.0.22/src/make.ALPHA 0000644 0150751 0150751 00000000637 12021362712 015024 0 ustar lkajan lkajan #HOME-PATH = /home/rost
ARCH = ALPHA
EXE = prof.$(ARCH)
#=====================================================================
LDFLAGS = -O3 -C
FFLAGS = -O4
#=====================================================================
O= prof.o lib-prof.o lib-sys-$(ARCH).o
$(EXE): $O
f77 $(FFLAGS) -o $(EXE) ${LDFLAGS} $O
prof.o: profPar.f
profnet-1.0.22/src/make.LINUX 0000644 0150751 0150751 00000001265 12021362710 015072 0 ustar lkajan lkajan HOME-PATH = /home/rost
#=====================================================================
EXENAME = prof.$(ARCH)
F77 = f77
#F77 = /usr/pub/pgi/linux86/bin/pgf77
CC = cc
#LDFLAGS =
#=====================================================================
#LIB-PROF = lib-prof
#LIB-SYS = lib-$(ARCH)
#=====================================================================
FFLAGS = -O3 -C
#LIB-FLAGS = -O3 -c
#=====================================================================
O= prof.o lib-prof.o lib-sys-$(ARCH).o
$(EXENAME): $O $(OLIBS)
$(F77) -o $(EXENAME) ${FFLAGS} $O
prof.o : profPar.f
profnet-1.0.22/src/make.LINUX-pgi 0000644 0150751 0150751 00000001502 12021362711 015642 0 ustar lkajan lkajan HOME-PATH = /home/rost
#=====================================================================
EXENAME = prof.$(ARCH)
#F77 = f77
F77 = /usr/pub/pgi/linux86/bin/pgf77
CC = cc
LDFLAGS =
#=====================================================================
LIB-PROF = lib-prof
LIB-SYS = lib-$(ARCH)
#=====================================================================
OLIBS = $(LIB-PROF).o \
$(LIB-SYS).o
#=====================================================================
#FFLAGS=-C -g3
FFLAGS = -O3
LIB-FLAGS = -O3 -c
#=====================================================================
O= prof.f lib-prof.f lib-sys-$(ARCH).f
$(EXENAME): $O
$(F77) -o $(EXENAME) ${FFLAGS} $O
prof.o : profPar.f
profnet-1.0.22/src/make.MAC 0000644 0150751 0150751 00000001332 12021362710 014566 0 ustar lkajan lkajan HOME-PATH = /home/rost
#=====================================================================
EXENAME = prof.$(ARCH)
F77 = g77
#F77 = /usr/local/bin/g77
#F77 = /usr/pub/pgi/linux86/bin/pgf77
CC = cc
#LDFLAGS =
#=====================================================================
#LIB-PROF = lib-prof
#LIB-SYS = lib-sys-$(ARCH)
#=====================================================================
FFLAGS = -O3 -C
#LIB-FLAGS = -O3 -c
#=====================================================================
O= prof.o lib-prof.o lib-sys-$(ARCH).o
$(EXENAME): $O $(OLIBS)
$(F77) -o $(EXENAME) ${FFLAGS} $O
prof.o : profPar.f
profnet-1.0.22/src/make.MACIBM 0000644 0150751 0150751 00000001404 12021362712 015120 0 ustar lkajan lkajan HOME-PATH = /home/rost
#=====================================================================
EXENAME = prof.$(ARCH)
F77 = /opt/ibmcmp/xlf/8.1/bin/f77
#F77 = g77
#F77 = /usr/local/bin/g77
#F77 = /usr/pub/pgi/linux86/bin/pgf77
CC = cc
#LDFLAGS =
#=====================================================================
#LIB-PROF = lib-prof
#LIB-SYS = lib-sys-$(ARCH)
#=====================================================================
FFLAGS = -O3 -C
#LIB-FLAGS = -O3 -c
#=====================================================================
O= prof.o lib-prof.o lib-sys-$(ARCH).o
$(EXENAME): $O $(OLIBS)
$(F77) -o $(EXENAME) ${FFLAGS} $O
prof.o : profPar.f
profnet-1.0.22/src/make.MACINTEL 0000644 0150751 0150751 00000001333 12021362710 015363 0 ustar lkajan lkajan HOME-PATH = /home/rost
#=====================================================================
EXENAME = prof.$(ARCH)
#F77 = g77
F77 = /usr/local/bin/g77
#F77 = /usr/pub/pgi/linux86/bin/pgf77
#CC = cc
#LDFLAGS =
#=====================================================================
#LIB-PROF = lib-prof
#LIB-SYS = lib-sys-$(ARCH)
#=====================================================================
FFLAGS = -O3 -C
#LIB-FLAGS = -O3 -c
#=====================================================================
O= prof.o lib-prof.o lib-sys-$(ARCH).o
$(EXENAME): $O $(OLIBS)
$(F77) -o $(EXENAME) ${FFLAGS} $O
prof.o : profPar.f
profnet-1.0.22/src/make.SGI32 0000644 0150751 0150751 00000002731 12021362712 014763 0 ustar lkajan lkajan #!/usr/sbin/smake
#
HOME-PATH = /home/rost
#=====================================================================
EXENAME = prof.$(ARCH)
F77 = f77
CC = cc
LDFLAGS =
#=====================================================================
LIB-PROF = lib-prof
LIB-SYS = lib-$(ARCH)
#=====================================================================
OLIBS = $(LIB-PROF).o \
$(LIB-SYS).o
#=====================================================================
#FFLAGS=-C -O3 -c -extend_source -nocpp -Olimit=4000
#FFLAGS=-C -g3 -Olimit 2000
#FFLAGS=-C -temp=/usr/tmp/
FFLAGS=-C -O2 -Olimit 4000
LIB-FLAGS = -O2 -c -extend_source -nocpp -Olimit 15000
#=====================================================================
O= prof.o lib-prof.o lib-sys-$(ARCH).o
$(EXENAME): $O $(OLIBS)
$(F77) -o $(EXENAME) ${FFLAGS} $O
prof.o : profPar.f
lib-$(ARCH).o : profPar.f
#========================================================================
# old
#libs: $(OLIBS)
#$(LIBDIR)/$(LIB-UNIX).o: $(LIBPATH)/$(LIB-UNIX).f
# $(F77) $(LIB-FLAGS) $(LIBPATH)/$(LIB-UNIX).f
# \mv $(LIB-UNIX).o $(LIBDIR)/$(LIB-UNIX).o
#
#$(LIBDIR)/$(LIB-COMP).o: $(LIBPATH)/$(LIB-COMP).f
# $(F77) $(LIB-FLAGS) $(LIBPATH)/$(LIB-COMP).f
# \mv $(LIB-COMP).o $(LIBDIR)/$(LIB-COMP).o
#
#$(LIBDIR)/$(LIB-PROT).o: $(LIBPATH)/$(LIB-PROT).f
# $(F77) $(LIB-FLAGS) $(LIBPATH)/$(LIB-PROT).f
# \mv $(LIB-PROT).o $(LIBDIR)/$(LIB-PROT).o
profnet-1.0.22/src/make.SGI64 0000644 0150751 0150751 00000001677 12021362710 014776 0 ustar lkajan lkajan #!/usr/sbin/smake
#
#HOME-PATH = /home/rost
#=====================================================================
ARCH = SGI64
EXENAME = prof.$(ARCH)
F77 = f77
#CC = cc
#LDFLAGS =
#=====================================================================
LIB-PROF = lib-prof
LIB-SYS = lib-$(ARCH)
#=====================================================================
OLIBS = $(LIB-PROF).o \
$(LIB-SYS).o
#=====================================================================
#FFLAGS=-C -O3 -c -extend_source -nocpp
#FFLAGS=-C -g3
#FFLAGS=-C -temp=/usr/tmp/
#FFLAGS=-C -O2
FFLAGS = -O3 -C -64
LIB-FLAGS = -O3 -c -64
#=====================================================================
O= prof.o lib-prof.o lib-sys-$(ARCH).o
$(EXENAME): $O $(OLIBS)
$(F77) -o $(EXENAME) ${FFLAGS} $O
prof.o : profPar.f
lib-$(ARCH).o : profPar.f
profnet-1.0.22/src/make.SGI64_no64 0000644 0150751 0150751 00000001244 12021362711 015633 0 ustar lkajan lkajan #!/usr/sbin/smake
#
#HOME-PATH = /home/rost
#=====================================================================
ARCH = SGI64
EXENAME = prof.$(ARCH)
F77 = f77
LDFLAGS =
#=====================================================================
#FFLAGS=-C -O3 -c -extend_source -nocpp
#FFLAGS=-C -g3
#FFLAGS=-C -temp=/usr/tmp/
#FFLAGS=-C -O2
FFLAGS = -O3 -C
LIB-FLAGS = -O3 -c
#=====================================================================
O= prof.o lib-prof.o lib-sys-$(ARCH).o
$(EXENAME): $O $(OLIBS)
$(F77) $(FFLAGS) -o $(EXENAME) ${LIB-FLAGS} $O
nn.o : profPar.f
lib-$(ARCH).o : profPar.f
profnet-1.0.22/src/prof.f 0000755 0150751 0150751 00000420713 12021362711 014460 0 ustar lkajan lkajan *----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* CUBIC/LION http://cubic.bioc.columbia.edu *
* Columbia University rost@columbia.edu *
* changed: June, 1998 version 0.2 *
*----------------------------------------------------------------------*
***** ------------------------------------------------------------------
***** internal navigation:
*****
***** MAIN PROF
***** -> main program
***** FUNCTIONS fff
***** -> sorted alphabetically
***** SUBROUTINES sss
***** -> sorted alphabetically
*****
***** for further details: Doc-prof.txt
*****
***** ------------------------------------------------------------------
***** ------------------------------------------------------------------
***** MAIN PROF
***** ------------------------------------------------------------------
PROGRAM PROF
C---- include parameter files
INCLUDE 'profPar.f'
C---- local variables
INTEGER ITER,STPTMP
INTEGER FILEN_STRING
C REAL TIME0
REAL SECNDS,FRTIME_SECNDS
C CHARACTER*80 INTERFILEBANK
CHARACTER*456 HC
LOGICAL LWRITE,LERR,LBIN
******------------------------------*-----------------------------******
* LWRITE controls whether calls of time and date are written*
* into the printer *
* SECNDS external function returning seconds elapsed since *
* midnight *
******------------------------------*-----------------------------******
C---- ------------------------------------------------------------------
C---- input (getting started)
C---- ------------------------------------------------------------------
C----
C---- command line
C----
C get number of command line argumentss
CALL GET_ARG_NUMBER(NUMARGUMENTS)
C too many arguments?
IF (NUMARGUMENTS.GT.NUMARG_MAX) THEN
WRITE(6,'(T2,A,T10,A)')'***',
+ 'ERROR: PROF too many cmd line args'
STOP
END IF
C get command line arguments
DO ITER=1,NUMARGUMENTS
CALL GET_ARGUMENT(ITER,PASSED_ARGC(ITER))
END DO
* *
C----
C---- general stuff for CPU time
C----
C run time
TIMEFLAG=.FALSE.
C call SRDTIME(LWRITE) from personal lib-syst.f
LWRITE=.FALSE.
CALL SRDTIME(LWRITE)
C call SCFDATE(1,LWRITE) from personal lib-syst.f
LWRITE=.FALSE.
CALL SCFDATE(1,LWRITE,STARTDATE)
C elapsed time: real: seconds since midnight-supplied arg
C TIME0=0.0
C TIMESTART=SECNDS(TIME0)
C--- commented out 2007_08_22 (BR problem with MAC intel g77)
C TIMESTART= FRTIME_SECNDS(TIME0)
LERR=.TRUE.
LBIN=.TRUE.
C----
C---- initialise parameters and read command line
C----
CALL INIPROF
C----
C---- read files
C----
C read parameters
IF (LOGI_RDPAR) THEN
CALL RDPAR
END IF
C read input vectors
IF (LOGI_RDIN) THEN
CALL RDIN
END IF
C read output vectors
IF (LOGI_RDOUT) THEN
CALL RDOUT
END IF
C read succession of training
IF (STPSWPMAX.GT.0) THEN
CALL RDSAM
END IF
C read junctions (only if training from tabula rasa)
IF (FILEIN_JCT(1:3).NE.'NEW') THEN
CALL RDJCT
ELSE
CALL INIJCT
C CALL WRTJCT(10,FILEOUT_JCT(1))
END IF
C ini threshold units
CALL INITHRUNT
C security
IF (BITACC.EQ.0) THEN
WRITE(6,'(A)')'*** ERROR MAIN BITACC MAY NOT be zero'
STOP '*** ERROR MAIN BITACC not set'
END IF
C---- ------------------------------------------------------------------
C---- network training, or triggering
C---- ------------------------------------------------------------------
C---- ------------------------------
C---- network switch only
IF (STPSWPMAX.EQ.0) THEN
C---- 1st: Lerr, 2nd: Lbin, 3rd: stp
IF (LOGI_SWITCH) THEN
LERR=.FALSE.
LBIN=.FALSE.
ELSE
LERR=.TRUE.
LBIN=.TRUE.
END IF
CALL NETOUT(LERR,LBIN,1)
C---- stp=1 for all
CALL WRTOUT(10,FILEOUT_OUT(1),1,1)
IF (.NOT.LOGI_SWITCH) THEN
CALL WRTJCT(10,FILEOUT_JCT(1))
END IF
C---- ------------------------------
C---- training
ELSE
C------- optimized online training
IF (NUMLAYERS.EQ.2) THEN
C **********
CALL TRAIN
C **********
ELSE
WRITE(6,*)'*** TRAINPERC not yet implemented'
STOP
C **************
C CALL TRAINPERC
C **************
END IF
END IF
C---- ------------------------------------------------------------------
C---- output
C---- ------------------------------------------------------------------
* *
C---- write results onto printer
IF (.NOT.LOGI_SWITCH) THEN
IF (STPSWPMAX.EQ.0) STPTMP=1
IF (STPSWPMAX.GT.0) STPTMP=STPINFCNT
CALL WRTSCR(STPTMP)
CALL WRTERR(10,FILEOUT_ERR,STPTMP)
CALL WRTYEAH(10,FILEOUT_YEAH)
ELSEIF (LOGI_DEBUG .AND.
+ FILEOUT_OUT(1)(1:4).NE.'none') THEN
WRITE(6,'(A,A)')
+ '--- PROF finished fine! FILEOUT=',
+ FILEOUT_OUT(1)(1:FILEN_STRING(FILEOUT_OUT(1)))
END IF
END
***** end of PROF
***** ------------------------------------------------------------------
***** FUNCTIONS fff
***** ------------------------------------------------------------------
***** ------------------------------------------------------------------
***** FCT TRG1ST
***** ------------------------------------------------------------------
C----
C---- NAME : TRG1ST
C---- ARG : x
C---- DES : This sigmoid function works as a trigger generating in
C---- DES : layer l an output between 0 and 1 from the input (local
C---- DES : filed) of the previous layer (l-1). Thus TRG1ST
C---- DES : determins the state of the 'neurons' in layer l.
C---- DES :
C---- DES : The particular choice (any monotonically increasing
C---- DES : function that can be differentiated will do) is:
C---- DES : TRG1ST (x) = 1./ (1.+exp(-x))
C---- DES : the derivation is given by:
C---- DES : f''(x)=f(x)*( 1-f(x) ) ]
C---- IN : input parameters are the 'local fields'
C---- FROM :
C----
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* CUBIC/LION http://cubic.bioc.columbia.edu *
* Columbia University rost@columbia.edu *
* changed: Mar, 1994 version 0.1 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
REAL FUNCTION TRG1ST (X)
IF (X.LT.-50) THEN
TRG1ST=0.
ELSEIF (X.GT.50) THEN
TRG1ST=1.
ELSE
TRG1ST = 1./ ( 1. + EXP (-X) )
END IF
END
***** end of TRG1ST
***** ------------------------------------------------------------------
***** SUB TRG2ND
***** ------------------------------------------------------------------
C----
C---- NAME : TRG2ND
C---- ARG : X
C---- DES : see TRG1ST
C----
* procedure:
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* CUBIC/LION http://cubic.bioc.columbia.edu *
* Columbia University rost@columbia.edu *
* changed: Mar, 1994 version 0.1 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
REAL FUNCTION TRG2ND (X)
IF (X.LT.-50) THEN
TRG2ND=0.
ELSEIF (X.GT.50) THEN
TRG2ND=1.
ELSE
TRG2ND = 1./ ( 1. + EXP (-X) )
END IF
END
***** end of TRG2ND
***** ------------------------------------------------------------------
***** FCT TRGNORM
***** ------------------------------------------------------------------
C----
C---- NAME : TRGNORM
C---- ARG :
C---- DES : The normal trigger function f(h(i)) with df/dh(j)
C---- DES : =0 is substituted by a function containing the sum
C---- DES : over all output fields as a normalization
C----
C---- NOTE : f''(h)=f(h)( 1-f(h) )
C---- NOTE : i.e., the same as for TRG1ST, and TRG2ND
C----
* procedure:
*----------------------------------------------------------------------*
* Burkhard Rost Aug, 1998 version 1.0 *
* CUBIC/LION http://cubic.bioc.columbia.edu *
* Columbia University rost@columbia.edu *
* changed: Mar, 1994 version 0.1 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
REAL FUNCTION TRGNORM (X)
INCLUDE 'profPar.f'
INTEGER ITOUT
REAL X,HELPSUM
HELPSUM=0.
IF (NUMLAYERS.EQ.1) THEN
DO ITOUT=1,NUMOUT
HELPSUM=EXP(FLD1ST(ITOUT))
END DO
ELSE
WRITE(6,*)' NUMLAYERS>1 not yet implemented for TRGNORM'
STOP
END IF
TRGNORM=(1./HELPSUM)*EXP(X)
END
***** end of TRGNORM
***** ------------------------------------------------------------------
***** SUBROUTINES sss
***** ------------------------------------------------------------------
***** ------------------------------------------------------------------
***** SUB INIPROF
***** ------------------------------------------------------------------
C----
C---- NAME : INIPROF
C---- ARG :
C---- DES : Parameters (numbers, characters, flags) for executing a
C---- DES : particular PROF job are initially assigned.
C---- IN : PASSED_ARGC (common)
C---- OUT : setting of initial defaults
C---- FROM : MAIN
C---- CALL2: INIPAR_CON, INIPAR_DEFAULT, INIPAR_ASK
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* CUBIC/LION http://cubic.bioc.columbia.edu *
* Columbia University rost@columbia.edu *
* changed: June, 1998 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE INIPROF
C---- include parameter files
INCLUDE 'profPar.f'
C---- local functions
C INTEGER FILEN_STRING
C---- local variables
INTEGER IT
C LOGICAL LTEST,LTESTTRN
LOGICAL LHELP,LERROR
CHARACTER*456 ARG1,ARG2
******------------------------------*-----------------------------******
C---- get help?
LHELP=.FALSE.
LERROR=.FALSE.
IF (NUMARGUMENTS.LT.1) THEN
LERROR=.TRUE.
ELSEIF ((NUMARGUMENTS.EQ.1).AND.
+ (INDEX(PASSED_ARGC(1),'help').NE.0)) THEN
LHELP=.TRUE.
END IF
IF (LERROR) THEN
WRITE(6,'(A,T5,A)')'---','start program with:'
WRITE(6,'(A,T5,A)')'---',' exe [help]'
WRITE(6,'(A,T5,A)')'---','or: exe fPar'
WRITE(6,'(A,T5,A)')'---','or: exe [inter] '
WRITE(6,'(A,T5,A)')'---',' (will bring up dialog)'
STOP
ELSEIF (LHELP) THEN
WRITE(6,'(A,T5,A)')'---','start the program with:'
WRITE(6,'(A,T5,A)')'---',' exe [inter] '
WRITE(6,'(A,T5,A)')'---',' (will bring up dialog)'
WRITE(6,'(A,T5,A)')'---',' '
WRITE(6,'(A,T5,A)')'---','or: exe filePar '
WRITE(6,'(A,T5,A)')'---',' filePar = file with input'//
+ ' parameters (also gives fileIn, fileOut)'
WRITE(6,'(A,T5,A)')'---',' '
WRITE(6,'(A,T5,A)')'---','or: exe switch AND_following_args'
WRITE(6,'(A,T5,A)')'---',' '
WRITE(6,'(A,T5,A)')'---',' 1: "switch"'
WRITE(6,'(A,T5,A)')'---',' 2: number of input units'
WRITE(6,'(A,T5,A)')'---',' 3: number of hidden units'
WRITE(6,'(A,T5,A)')'---',' 4: number of output units'
WRITE(6,'(A,T5,A)')'---',' 5: number of samples'
WRITE(6,'(A,T5,A)')'---',' 6: bitacc (typically 100)'
WRITE(6,'(A,T5,A)')'---',' 7: file with input vectors'
WRITE(6,'(A,T5,A)')'---',' 8: file with junctions'
WRITE(6,'(A,T5,A)')'---',' 9: file with output of PROF'
WRITE(6,'(A,T5,A)')'---',' ="none" -> no file written'
WRITE(6,'(A,T5,A)')'---',' 10: optional=dbg'
WRITE(6,'(A,T5,A)')'---',' NOTES:'
WRITE(6,'(A,T5,A)')'---',' - 1st MUST be "switch"!'
WRITE(6,'(A,T5,A)')'---',' - tested only with 2 layers!'
WRITE(6,'(A,T5,A)')'---',' '
WRITE(6,'(A,T5,A)')'---','SORRY no further help, yet!'
STOP
END IF
C---- usually untouched constants
CALL INIPAR_CON
C---- handle the arguments passed to program
DO IT=(NUMARGUMENTS+1),NUMARG_MAX
PASSED_ARGC(IT)='UNK'
END DO
C---- --------------------------------------------------
C---- initialising according to input read
ARG1=PASSED_ARGC(1)
IF (NUMARGUMENTS.GT.1) ARG2=PASSED_ARGC(1)
C---- ask for input
IF ((ARG1(1:5).EQ.'INTER').OR.(ARG1(1:5).EQ.'inter')) THEN
CALL INIPAR_DEFAULT
LOGI_INTERACTIVE=.TRUE.
CALL INIPAR_ASK
C---- ask for input
ELSE IF ((ARG1(1:6).EQ.'switch').OR.(ARG1(1:6).EQ.'switch')) THEN
CALL INIPAR_DEFAULT
LOGI_SWITCH= .TRUE.
CALL INIPAR_SWITCH
C---- read input from files
ELSE
FILEIN_PAR= ARG1
LOGI_RDPAR= .TRUE.
LOGI_RDIN= .TRUE.
LOGI_RDOUT= .TRUE.
IF (NUMARGUMENTS.GT.1 .AND. ARG2(1:3).EQ.'dbg') THEN
LOGI_DEBUG= .TRUE.
END IF
END IF
C---- end of initialising the main stuff
C---- --------------------------------------------------
* *
END
***** end of INIPROF
***** ------------------------------------------------------------------
***** SUB INIPAR_ASK
***** ------------------------------------------------------------------
C----
C---- NAME : INIPAR_ASK
C---- ARG :
C---- DES : Asking for input parameters
C---- DES :
C---- IN :
C---- FROM : INIPROF
C---- CALL2:
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* CUBIC/LION http://cubic.bioc.columbia.edu *
* Columbia University rost@columbia.edu *
* changed: June, 1998 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE INIPAR_ASK
C---- include parameter files
INCLUDE 'profPar.f'
INTEGER IH(1:2)
CHARACTER*456 FILETMP
******------------------------------*-----------------------------******
CALL GETCHAR(80,PATH_ARCH,' path of architectures ? ')
CALL GETCHAR(80,FILEIN_PAR,' parameter file? (`i` if interactive')
IF ((INDEX(FILEIN_PAR,'i').NE.0) .OR.
+ (INDEX(FILEIN_PAR,'I').NE.0) ) THEN
LOGI_RDPAR= .TRUE.
ELSE
WRITE(6,*)'*** missing ini.f: ask for parameters'
STOP
END IF
CALL GETCHAR(80,FILETMP,' input file? (`i` if interactive')
IF ((FILETMP(1:1).EQ.'i').OR.(FILETMP(1:1).EQ.'I')) THEN
LOGI_RDIN= .TRUE.
ELSE
WRITE(6,*)'*** missing ini.f: ask for input data'
STOP
END IF
CALL GETCHAR(80,FILETMP,' output file? (`i` if interactive')
IF ((FILETMP(1:1).EQ.'i').OR.(FILETMP(1:1).EQ.'I')) THEN
LOGI_RDOUT= .TRUE.
ELSE
WRITE(6,*)'*** missing ini.f: ask for parameters'
STOP
END IF
C CALL ASK(' realinput ? ',LOGI_REALINPUT)
C IH(1)=INT(MAXQ3*100)
C CALL GETINT(1,IH(1),' 100 * MAXQ3 (i.e. for 0.95 give 95) ')
IH(1)=STPINF
CALL GETINT(1,IH(1),' STPINF ')
STPINF=IH(1)
IH(1)=STPMAX
CALL GETINT(1,IH(1),' STPMAX ')
STPMAX=IH(1)
IH(1)=STPSWPMAX
CALL GETINT(1,IH(1),' STPSWPMAX ')
STPSWPMAX=IH(1)
IH(1)=INT(EPSILON*100)
CALL GETINT(1,IH(1),' 100 * EPSILON ')
EPSILON=IH(1)/100.
IH(1)=INT(ALPHA*100)
CALL GETINT(1,IH(1),' 100 * ALPHA ')
ALPHA=IH(1)/100.
IH(1)=INT(TEMPERATURE*100)
CALL GETINT(1,IH(1),' 100 * TEMPERATURE ')
TEMPERATURE=INT(IH(1)/100.)
END
***** end of INIPAR_ASK
***** ------------------------------------------------------------------
***** SUB INIPAR_CON
***** ------------------------------------------------------------------
C----
C---- NAME : INIPAR_CON
C---- ARG :
C---- DES : Initialising constants that are usually not touched
C---- IN :
C---- FROM : INIPROF
C---- CALL2:
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* CUBIC/LION http://cubic.bioc.columbia.edu *
* Columbia University rost@columbia.edu *
* changed: June, 1998 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE INIPAR_CON
C---- include parameter files
INCLUDE 'profPar.f'
******------------------------------*-----------------------------******
C---- --------------------------------------------------
* Various numerical constants
C---- number of layers
NUMLAYERS= 2
C---- grids ...
BITACC= 1
C (if out outbin=0)
ERRBINACC= 0.2
C---- end, bias asf.
ERRBIAS= 0.0
C ERRBIAS= 0.05
ERRSTOP= 0.005
ERRBINSTOP= 0.95
THRESHOUT= 0.5
DICEITRVL= 0.1
C---- random number generation
DICESEED= 100025
DICESEED_ADDJCT= 0
DICESEED_ADDTRN= 0
ABW= 10E-10
C ABW= 0.00001
MAXCPUTIME= 1000000.
TIMEOUT= 300.
C---- --------------------------------------------------
* Various flags and names
C---- modes
TRGTYPE= '1/(1+EXP(-X))'
TRNTYPE= 'ONLINE'
ERRTYPE= 'DELTASQ'
C ERRTYPE= 'LN(1-DELTASQ)'
C---- temporary output
LOGI_TMPWRTOUT= .FALSE.
LOGI_TMPWRTJB= .FALSE.
C----
LOGI_TRANSLATE(0)=.FALSE.
LOGI_TRANSLATE(1)=.TRUE.
C---- ------------------------------
C ------------
C alternatives
C ------------
C TRGTYPE='EXP(X(I))/SUM(J,EXP(X(J)))'
C TRNTYPE='BATCH'
C ERRTYPE='LN(1-DELTASQ)'
C---- ---------------------------------------------------
* *
END
***** end of INIPAR_CON
***** ------------------------------------------------------------------
***** SUB INIPAR_DEFAULT
***** ------------------------------------------------------------------
C----
C---- NAME : INIPAR_DEFAULT
C---- ARG :
C---- DES : Initialising constants
C---- IN :
C---- FROM : INIPROF
C---- CALL2:
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* CUBIC/LION http://cubic.bioc.columbia.edu *
* Columbia University rost@columbia.edu *
* changed: June, 1998 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE INIPAR_DEFAULT
C---- include parameter files
INCLUDE 'profPar.f'
C---- local functions
C INTEGER FILEN_STRING
******------------------------------*-----------------------------******
C---- --------------------------------------------------
C---- set path for architecture files
PATH_ARCH=' '
LENPATH_ARCH= 1
C---- --------------------------------------------------
C---- architecture
C---- number of hidden units
NUMHID= 15
C---- number of layers (now <= 2)
NUMLAYERS= 2
C---- --------------------------------------------------
C---- end, cycles asf
C---- cycles and info per cycle
C G M T
C---- number of steps before write
STPINF= 40000
C---- maximal number of steps
STPMAX= 200000
C---- maximal number of sweeps
C---- STPMAX < NPATTERN*STSWPMAX
STPSWPMAX= 200
C---- --------------------------------------------------
C---- speed
C---- learning speed
EPSILON= 0.05
C---- momentum
ALPHA= 0.20
C---- speed reduction
TEMPERATURE= 1.00
C---- --------------------------------------------------
C---- flags
LOGI_INTERACTIVE= .FALSE.
LOGI_SWITCH= .FALSE.
LOGI_DEBUG= .FALSE.
C input files
LOGI_RDPAR= .FALSE.
LOGI_RDIN= .FALSE.
LOGI_RDOUT= .FALSE.
END
***** end of INIPAR_DEFAULT
***** ------------------------------------------------------------------
***** SUB INIPAR_SWITCH
***** ------------------------------------------------------------------
C----
C---- NAME : INIPAR_SWITCH
C---- ARG :
C---- DES : switch mode: input to fortran script MUST be:
C---- DES : arg 1= "switch" keyword!
C---- DES : arg 2= number of input units
C---- DES : arg 3= number of hidden units
C---- DES : arg 4= number of output units
C---- DES : arg 5= number of samples
C---- DES : arg 6= bitacc (is typically 100)
C---- DES : arg 7= file with input vectors
C---- DES : arg 8= file with junctions
C---- DES : arg 9= file with output of PROF
C---- DES : if = 'none' no output file written
C---- DES : arg 10= optional if set: debug mode
C---- DES :
C---- IN : PASSED_ARGC(it) GLOBAL (profPar.f)
C---- FROM : INIPROF
C---- CALL2:
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* CUBIC/LION http://cubic.bioc.columbia.edu *
* Columbia University rost@columbia.edu *
* changed: June, 1998 version 0.2 *
* changed: Dec, 1999 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE INIPAR_SWITCH
C---- include parameter files
INCLUDE 'profPar.f'
INTEGER FILEN_STRING
INTEGER IT,IH(1:10),CTNUM
CHARACTER*456 FILETMP,VARIN
CHARACTER*20 CTMP
******------------------------------*-----------------------------******
C----
C---- set defaults for SWITCH mode (1)
C----
NUMFILEIN_IN= 1
NUMFILEIN_OUT= 0
NUMFILEOUT_OUT=1
C
STPSWPMAX= 0
C
LOGI_RDPAR= .FALSE.
LOGI_RDIN= .TRUE.
LOGI_RDOUT= .FALSE.
LOGI_RDINWRT= .FALSE.
LOGI_RDJCTWRT= .FALSE.
C
BITACC= 100
C----
C---- get integers (argument 2-5)
C----
DO IT=2,6
CALL SCHAR_TO_INT(PASSED_ARGC(IT),IH(IT))
END DO
NUMIN= IH(2)
NUMHID=IH(3)
NUMOUT=IH(4)
NUMSAM=IH(5)
BITACC=IH(6)
C----
C---- set dependent defaults for SWITCH mode (2)
C----
NUMLAYERS= 2
IF (NUMHID.EQ.0) NUMLAYERS=1
C----
C---- get file names
C----
CTNUM=6
VARIN= PASSED_ARGC(CTNUM+1)
FILEIN_IN(1)= VARIN(1:FILEN_STRING(VARIN))
VARIN= PASSED_ARGC(CTNUM+2)
FILEIN_JCT= VARIN(1:FILEN_STRING(VARIN))
VARIN= PASSED_ARGC(CTNUM+3)
FILEOUT_OUT(1)= VARIN(1:FILEN_STRING(VARIN))
C----
C---- debug mode?
C----
IF (NUMARGUMENTS.GE.(CTNUM+4)) THEN
LOGI_DEBUG= .TRUE.
END IF
C---- ------------------------------------------------------------------
C---- write what we got
C---- ------------------------------------------------------------------
IF (LOGI_DEBUG) THEN
CTMP=' '
CTMP='--- INIPAR_SWITCH: '
WRITE(6,'(A,T20,A,T35,I8)')CTMP,'NUMIN', NUMIN
WRITE(6,'(A,T20,A,T35,I8)')CTMP,'NUMHID', NUMHID
WRITE(6,'(A,T20,A,T35,I8)')CTMP,'NUMOUT', NUMOUT
WRITE(6,'(A,T20,A,T35,I8)')CTMP,'NUMLAYERS',NUMLAYERS
C----
WRITE(6,'(A,T20,A,T35,I8)')CTMP,'NUMSAM', NUMSAM
C----
WRITE(6,'(A,T20,A,T35,I8)')CTMP,'NUMFILEIN_IN', NUMFILEIN_IN
WRITE(6,'(A,T20,A,T35,I8)')CTMP,'NUMFILEIN_OUT', NUMFILEIN_OUT
WRITE(6,'(A,T20,A,T35,I8)')CTMP,'NUMFILEOUT_OUT',NUMFILEOUT_OUT
WRITE(6,'(A,T20,A,T35,I8)')CTMP,'NUMFILEOUT_JCT',NUMFILEOUT_JCT
C----
DO IT=1,NUMFILEIN_IN
WRITE(6,'(A,T20,A,T35,I4,A1,A)')CTMP,'FILEIN_IN',IT,' ',
+ FILEIN_IN(IT)(1:FILEN_STRING(FILEIN_IN(IT)))
END DO
WRITE(6,'(A,T20,A,T40,A)')CTMP,
+ 'FILEIN_JCT',FILEIN_JCT(1:FILEN_STRING(FILEIN_JCT))
DO IT=1,NUMFILEOUT_OUT
WRITE(6,'(A,T20,A,T35,I4,A1,A)')CTMP,'FILEOUT_OUT',IT,' ',
+ FILEOUT_OUT(IT)(1:FILEN_STRING(FILEOUT_OUT(IT)))
END DO
END IF
END
***** end of INIPAR_SWITCH
***** ------------------------------------------------------------------
***** SUB INITHRUNT
***** ------------------------------------------------------------------
C----
C---- NAME : INITHRUNT
C---- ARG :
C---- DES : the additional input/hidden units for writing the
C---- DES : thresholds/biases as parts of the junctions.
C---- IN : NUMSAM,NUMIN,NUMHID/1,NUMSAM
C---- OUT : INPUT(NUMIN+1,MUE),
C---- OUT : OUTHID(HID+1,MUE),OUTHID1(HID1+1,MUE)
C---- FROM : MAIN
C---- CALL2:
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* CUBIC/LION http://cubic.bioc.columbia.edu *
* Columbia University rost@columbia.edu *
* changed: June, 1998 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE INITHRUNT
C---- global parameters and variables
INCLUDE 'profPar.f'
C---- local variables
INTEGER MUE
******------------------------------*-----------------------------******
C---- NUMLAYERS=1 -----
IF (NUMLAYERS.EQ.1) THEN
DO MUE=1,NUMSAM
INPUT((NUMIN+1),MUE)=INT2(BITACC)
END DO
C---- NUMLAYERS=2 -----
ELSEIF (NUMLAYERS.EQ.2) THEN
DO MUE=1,NUMSAM
INPUT((NUMIN+1),MUE)=INT2(BITACC)
OUTHID((NUMHID+1))=1.
END DO
END IF
END
***** end of INITHRUNT
***** ------------------------------------------------------------------
***** SUB RDJCT
***** ------------------------------------------------------------------
C----
C---- NAME : RDJCT
C---- ARG :
C---- DES : Architecture read from file
C---- IN :
C---- FROM : MAIN
C---- CALL2: RDJCT_HEAD, RDJCT_JCT1, RDJCT_JCT2, RDJCT_WRT
C---- LIB : SFILEOPEN
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* CUBIC/LION http://cubic.bioc.columbia.edu *
* Columbia University rost@columbia.edu *
* changed: June, 1998 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE RDJCT
C---- include parameter files
INCLUDE 'profPar.f'
C---- local function
INTEGER FILEN_STRING
C---- local variables *
CHARACTER*80 HC,MREAD
LOGICAL LDONE,LREAD
******------------------------------*-----------------------------******
C message onto screen
C WRITE(6,'(A)')'--- '
IF (.NOT. LOGI_SWITCH .OR. LOGI_DEBUG) THEN
WRITE(6,'(A,T16,A)')'--- RDjct file=',
+ FILEIN_JCT(1:FILEN_STRING(FILEIN_JCT))
END IF
C----
C---- read file with junctions
C----
CALL SFILEOPEN(10,FILEIN_JCT,'OLD',456,'READONLY')
LDONE=.FALSE.
DO WHILE (.NOT.LDONE)
LREAD=.FALSE.
READ(10,'(A9)',END=2057)HC
C---- terminate reading
IF (HC(1:2).EQ.'//') THEN
LDONE=.TRUE.
LREAD=.FALSE.
ELSEIF (HC(1:9).EQ.'* overall') THEN
LREAD=.FALSE.
MREAD='H'
ELSEIF (HC(1:9).EQ.'* jct 1st') THEN
LREAD=.FALSE.
MREAD='1'
ELSEIF (HC(1:9).EQ.'* jct 2nd') THEN
LREAD=.FALSE.
MREAD='2'
ELSEIF (HC(1:1).NE.'*') THEN
BACKSPACE 10
LREAD=.TRUE.
ELSE
LREAD=.FALSE.
END IF
C----
C header (numin,numsam,numsamfile)
C----
IF (LREAD.AND.(MREAD.EQ.'H')) THEN
CALL RDJCT_HEAD
ELSEIF (LREAD.AND.(MREAD.EQ.'1')) THEN
CALL RDJCT_JCT1
ELSEIF (LREAD.AND.(MREAD.EQ.'2')) THEN
CALL RDJCT_JCT2
ELSEIF (LREAD) THEN
WRITE(6,'(A,T10,A,A,A)')'***',
+ 'ERROR RDJCT MREAD not recognised:',MREAD,':'
STOP '*** RDJCT: left due to error in reading inJct'
END IF
END DO
2057 CONTINUE
CLOSE(10)
C----
C header (numin,numsam,numsamfile)
C----
C control write
IF (LOGI_RDJCTWRT) THEN
CALL RDJCT_WRT
END IF
END
***** end of RDJCT
***** ------------------------------------------------------------------
***** SUB RDJCT_HEAD
***** ------------------------------------------------------------------
C----
C---- NAME : RDJCT_HEAD
C---- ARG :
C---- DES : reading and checking header of file with input vec
C---- IN :
C---- FROM : RDJCT
C---- CALL2:
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* CUBIC/LION http://cubic.bioc.columbia.edu *
* Columbia University rost@columbia.edu *
* changed: June, 1998 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE RDJCT_HEAD
C---- include parameter files
INCLUDE 'profPar.f'
C---- local function
INTEGER FILEN_STRING
C---- local variables
INTEGER VARIN,IT,NUMINLOC,NUMHIDLOC,NUMOUTLOC
CHARACTER*80 HC,VARINC,MODEPREDLOC,MODENETLOC,MODEJOBLOC,
+ MODEINLOC,MODEOUTLOC
LOGICAL LERROR
******------------------------------*-----------------------------******
LERROR=.FALSE.
C----
C---- loop over 3 INTEGERS: NUMIN, NUMHID, NUMOUT
C----
DO IT=1,3
READ(10,'(A20,T25,I8)')HC,VARIN
IF (HC(1:5).EQ.'NUMIN') THEN
NUMINLOC=VARIN
ELSEIF (HC(1:6).EQ.'NUMHID') THEN
NUMHIDLOC=VARIN
ELSEIF (HC(1:6).EQ.'NUMOUT') THEN
NUMOUTLOC=VARIN
ELSE
WRITE(6,'(T2,A,T10,A,A,A)')'***',
+ 'ERROR RDJCT_HEAD I HC not recognised:',HC,':'
LERROR=.TRUE.
END IF
END DO
C----
C---- loop over modes: MODEPRED, MODENET, MODEJOB, MODEIN,
C----
DO IT=1,5
READ(10,'(A20,T25,A)')HC,VARINC
IF (INDEX(HC,'MODEPRED').NE.0) THEN
MODEPREDLOC=VARINC(1:FILEN_STRING(VARINC))
ELSEIF (INDEX(HC,'MODENET') .NE.0) THEN
MODENETLOC=VARINC(1:FILEN_STRING(VARINC))
ELSEIF (INDEX(HC,'MODEJOB') .NE.0) THEN
MODEJOBLOC=VARINC(1:FILEN_STRING(VARINC))
ELSEIF (INDEX(HC,'MODEIN') .NE.0) THEN
MODEINLOC=VARINC(1:FILEN_STRING(VARINC))
ELSEIF (INDEX(HC,'MODEOUT') .NE.0) THEN
MODEOUTLOC=VARINC(1:FILEN_STRING(VARINC))
ELSE
WRITE(6,'(T2,A,T10,A,A,A)')'***',
+ 'ERROR RDJCT_HEAD A HC not recognised:',HC,':'
LERROR=.TRUE.
END IF
END DO
C----
C---- error check (consistency with file.para)
C----
CALL RDJCT_CHECK(NUMINLOC,NUMHIDLOC,NUMOUTLOC,
+ MODEPREDLOC,MODENETLOC,MODEJOBLOC,MODEINLOC,MODEOUTLOC)
C----
C error -> back
C----
IF (LERROR) THEN
WRITE(6,'(T2,A,T10,A)')'***',
+ 'RDJCT_HEAD: reading header of input vectors'
STOP '*** RDJCT_HEAD: left due to error in reading inJct'
END IF
END
***** end of RDJCT_HEAD
***** ------------------------------------------------------------------
***** SUB RDJCT_JCT1
***** ------------------------------------------------------------------
C----
C---- NAME : RDJCT_JCT1
C---- ARG :
C---- DES : reading and checking JCT1 of architecture
C---- IN :
C---- FROM : RDJCT
C---- CALL2:
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* CUBIC/LION http://cubic.bioc.columbia.edu *
* Columbia University rost@columbia.edu *
* changed: June, 1998 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE RDJCT_JCT1
C---- include parameter files
INCLUDE 'profPar.f'
C---- local variables
INTEGER ITHID,ITIN
******------------------------------*-----------------------------******
DO ITHID=1,NUMHID
C---- WRITE(6,'(I4,A,I4,A,I4)')ITHID,' OF ',NUMHID,' 1:',(NUMIN+1)
READ(10,'(10F10.4)')
+ (JCT1ST(ITIN,ITHID),ITIN=1,(NUMIN+1))
END DO
END
***** end of RDJCT_JCT1
***** ------------------------------------------------------------------
***** SUB RDJCT_JCT2
***** ------------------------------------------------------------------
C----
C---- NAME : RDJCT_JCT2
C---- ARG :
C---- DES : reading and checking JCT2 of architecture
C---- IN :
C---- FROM : RDJCT
C---- CALL2:
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* CUBIC/LION http://cubic.bioc.columbia.edu *
* Columbia University rost@columbia.edu *
* changed: June, 1998 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE RDJCT_JCT2
C---- include parameter files
INCLUDE 'profPar.f'
C---- local variables
INTEGER ITHID,ITOUT
******------------------------------*-----------------------------******
DO ITHID=1,(NUMHID+1)
READ(10,'(10F10.4)')(JCT2ND(ITHID,ITOUT),ITOUT=1,NUMOUT)
END DO
END
***** end of RDJCT_JCT2
***** ------------------------------------------------------------------
***** SUB RDJCT_CHECK
***** ------------------------------------------------------------------
C----
C---- NAME : RDJCT_CHECK
C---- ARG :
C---- DES : compares parameters read from JCT and PAR
C---- IN :
C---- FROM : RDJCT_HEAD
C----
*----------------------------------------------------------------------*
* Burkhard Rost Oct, 1998 version 1.0 *
* CUBIC/LION http://cubic.bioc.columbia.edu *
* Columbia University rost@columbia.edu *
* changed: Oct, 1998 version 0.1 *
*----------------------------------------------------------------------*
SUBROUTINE RDJCT_CHECK(NUMINLOC,NUMHIDLOC,NUMOUTLOC,
+ MODEPREDLOC,MODENETLOC,MODEJOBLOC,MODEINLOC,MODEOUTLOC)
C---- include parameter files
INCLUDE 'profPar.f'
C---- variables passed
INTEGER NUMINLOC,NUMHIDLOC,NUMOUTLOC
CHARACTER*80 MODEPREDLOC,MODENETLOC,MODEJOBLOC,
+ MODEINLOC,MODEOUTLOC
C---- local variables *
LOGICAL LERROR,LWARN
******------------------------------*-----------------------------******
LERROR= .FALSE.
LWARN= .FALSE.
C----
C---- archictecture (NUMIN,NUMHID,NUMOUT)
C----
IF (NUMINLOC.NE.NUMIN) THEN
WRITE(6,'(T2,A,T10,A,I6,A,I6)')'***',
+ 'ERROR RDJCT_CHECK: NUMIN para=',
+ NUMIN,' file_jct=',NUMINLOC
LERROR=.TRUE.
END IF
IF (NUMHIDLOC.NE.NUMHID) THEN
WRITE(6,'(T2,A,T10,A,I6,A,I6)')'***',
+ 'ERROR RDJCT_CHECK: NUMHID para=',
+ NUMHID,' file_jct=',NUMHIDLOC
LERROR=.TRUE.
END IF
IF (NUMOUTLOC.NE.NUMOUT) THEN
WRITE(6,'(T2,A,T10,A,I6,A,I6)')'***',
+ 'ERROR RDJCT_CHECK: NUMOUT para=',
+ NUMOUT,' file_jct=',NUMOUTLOC
LERROR=.TRUE.
END IF
C----
C---- modes
C----
IF (LOGI_SWITCH.EQV..FALSE.) THEN
IF (MODEPREDLOC.NE.MODEPRED) THEN
WRITE(6,'(T2,A,T10,A,A,A,A)')'***',
+ 'ERROR RDJCT_CHECK: MODEPRED para=',
+ MODEPRED,' file_jct=',MODEPREDLOC
LERROR=.TRUE.
END IF
IF (MODENETLOC .NE.MODENET) THEN
WRITE(6,'(T2,A,T10,A,A,A,A)')'***',
+ 'ERROR RDJCT_CHECK: MODENET para=',
+ MODENET,' file_jct=',MODENETLOC
LERROR=.TRUE.
END IF
IF (MODEJOBLOC .NE.MODEJOB) THEN
WRITE(6,'(T2,A,T10,A,A,A,A)')'***',
+ 'ERROR RDJCT_CHECK: MODEJOB para=',
+ MODEJOB,' file_jct=',MODEJOBLOC
LERROR=.TRUE.
END IF
IF (MODEINLOC .NE.MODEIN) THEN
WRITE(6,'(T2,A,T10,A,A,A,A)')'***',
+ 'ERROR RDJCT_CHECK: MODEIN para=',
+ MODEIN,' file_jct=',MODEINLOC
LERROR=.TRUE.
END IF
IF (MODEOUTLOC .NE.MODEOUT) THEN
WRITE(6,'(T2,A,T10,A,A,A,A)')'***',
+ 'ERROR RDJCT_CHECK: MODEOUT para=',
+ MODEOUT,' file_jct=',MODEOUTLOC
LERROR=.TRUE.
END IF
END IF
C----
C error -> back
C----
IF (LERROR) THEN
WRITE(6,'(T2,A,T10,A)')'***',
+ 'RDJCT_CHECK: reading header of input vectors'
STOP '*** RDJCT_HEAD: left due to error in reading inJct'
END IF
END
***** end of RDJCT_CHECK
***** ------------------------------------------------------------------
***** SUB RDJCT_WRT
***** ------------------------------------------------------------------
C----
C---- NAME : RDJCT_WRT
C---- ARG :
C---- DES : writes the architecture read
C---- IN :
C---- FROM : RDJCT
C---- CALL2:
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* CUBIC/LION http://cubic.bioc.columbia.edu *
* Columbia University rost@columbia.edu *
* changed: June, 1998 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE RDJCT_WRT
C---- include parameter files
INCLUDE 'profPar.f'
C---- local variables
INTEGER ITIN,ITHID,ITOUT,KUNIT
CHARACTER*80 CTMP,CTMP2
******------------------------------*-----------------------------******
C----
C WRITE(6,'(A)')'--- '
KUNIT=6
CTMP='--- RDjct: '
CTMP2='--------------------------------------------------'
WRITE(KUNIT,'(A,T16,A50)')CTMP,CTMP2
WRITE(KUNIT,'(A,T16,A)')CTMP,'Architecture vectors read:'
C----
C---- 1st layer
C----
WRITE(KUNIT,'(A,T16,A)')CTMP,' '
WRITE(KUNIT,'(A,T16,A,I8)')CTMP,'JCT1: col=1..NUMHID =',NUMHID
WRITE(KUNIT,'(A,T16,A,I8)')CTMP,'JCT1: row=1..NUMIN+ =',(NUMIN+1)
DO ITHID=1,NUMHID
WRITE(KUNIT,'(10F10.4)')(JCT1ST(ITIN,ITHID),ITIN=1,(NUMIN+1))
END DO
C----
C---- 2nd layer
C----
WRITE(KUNIT,'(A,T16,A)')CTMP,' '
WRITE(KUNIT,'(A,T16,A,I8)')CTMP,'JCT2: col=1..NUMHID+=',(NUMHID+1)
WRITE(KUNIT,'(A,T16,A,I8)')CTMP,'JCT2: row=1..NUMHID =',NUMOUT
DO ITHID=1,(NUMHID+1)
WRITE(KUNIT,'(10F10.4)')(JCT2ND(ITHID,ITOUT),ITOUT=1,NUMOUT)
END DO
WRITE(KUNIT,'(A,T16,A,T35)')CTMP,'end of reading architecture'
IF (KUNIT.NE.6) THEN
CLOSE(KUNIT)
END IF
END
***** end of RDJCT_WRT
***** ------------------------------------------------------------------
***** SUB RDIN
***** ------------------------------------------------------------------
C----
C---- NAME : RDIN
C---- ARG :
C---- DES : Reads the protein input from file
C---- IN :
C---- FROM : MAIN
C---- CALL2: RDIN_HEAD, RDIN_DATA, RDIN_WRT
C---- LIB : SFILEOPEN
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* CUBIC/LION http://cubic.bioc.columbia.edu *
* Columbia University rost@columbia.edu *
* changed: June, 1998 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE RDIN
C---- include parameter files
INCLUDE 'profPar.f'
C---- local function
INTEGER FILEN_STRING
C---- local variables
INTEGER ITFILE,CNTTOT,CNTRD,NUMINLOC,NUMSAMLOC
CHARACTER*80 HC,MREAD
LOGICAL LDONE,LREAD
******------------------------------*-----------------------------******
C message onto screen
C WRITE(6,'(A)')'--- '
CNTTOT=0
C----
C---- loop over input files
C----
DO ITFILE=1,NUMFILEIN_IN
C message onto screen
IF (.NOT. LOGI_SWITCH .OR. LOGI_DEBUG) THEN
C WRITE(6,'(A,T16,A)')'--- RDin file=',
C + FILEIN_IN(ITFILE)(1:FILEN_STRING(FILEIN_IN(ITFILE)))
WRITE(6,'(A,T16,A)')'--- RDin',
+ FILEIN_IN(ITFILE)(1:FILEN_STRING(FILEIN_IN(ITFILE)))
END IF
C read
CALL SFILEOPEN(10,FILEIN_IN(ITFILE),'OLD',456,'READONLY')
LDONE=.FALSE.
DO WHILE (.NOT.LDONE)
LREAD=.FALSE.
READ(10,'(A9)',END=4057)HC
C terminate reading
IF (HC(1:2).EQ.'//') THEN
LDONE=.TRUE.
LREAD=.FALSE.
ELSEIF (HC(1:9).EQ.'* overall') THEN
LREAD=.FALSE.
MREAD='H'
ELSEIF (HC(1:9).EQ.'* samples') THEN
LREAD=.FALSE.
MREAD='D'
ELSEIF (HC(1:1).NE.'*') THEN
BACKSPACE 10
LREAD=.TRUE.
ELSE
LREAD=.FALSE.
END IF
C----
C header (numin,numsam,numsamfile)
C----
IF (LREAD.AND.(MREAD.EQ.'H')) THEN
CALL RDIN_HEAD(NUMINLOC,NUMSAMLOC)
ELSEIF (LREAD.AND.(MREAD.EQ.'D')) THEN
CALL RDIN_DATA(CNTRD,NUMINLOC)
CNTTOT=CNTTOT+CNTRD
IF (CNTTOT.GT.NUMSAM) THEN
WRITE(6,'(A,T10,A,A,I8,A,I8)')'***','ERROR RDIN ',
+ ' NUMSAM=',NUMSAM,' already CNTTOT=',CNTTOT
STOP '*** RDIN: left due to error in reading inIn'
END IF
ELSEIF (LREAD) THEN
WRITE(6,'(A,T10,A,A,A)')'***',
+ 'ERROR RDIN MREAD not recognised:',MREAD,':'
STOP '*** RDIN: left due to error in reading inIn'
END IF
END DO
4057 CONTINUE
CLOSE(10)
END DO
C end of loop over input files
C---- ------------------------------
C----
C number of samples ok?
C----
IF (CNTTOT.NE.NUMSAM) THEN
WRITE(6,'(A,T10,A,I6,A,I6)')'***',
+ 'ERROR RDin: NUMSAM (from para)=',NUMSAM,
+ ' NUMSAM read (from filein)=',CNTTOT
STOP '*** RDIN: left due to error in read inIn'
END IF
C----
C control write
C----
IF (LOGI_RDINWRT) THEN
CALL RDIN_WRT
END IF
END
***** end of RDIN
***** ------------------------------------------------------------------
***** SUB RDIN_HEAD(NUMINLOC,NUMSAMLOC)
***** ------------------------------------------------------------------
C----
C---- NAME : RDIN_HEAD(NUMINLOC,NUMSAMLOC)
C---- ARG :
C---- DES : reading and checking header of file with input vec
C---- IN :
C---- FROM : RDIN
C---- CALL2:
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* CUBIC/LION http://cubic.bioc.columbia.edu *
* Columbia University rost@columbia.edu *
* changed: June, 1998 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE RDIN_HEAD(NUMINLOC,NUMSAMLOC)
C---- include parameter files
INCLUDE 'profPar.f'
C---- local variables
INTEGER VARIN,NUMINLOC,NUMSAMLOC,IT
CHARACTER*80 HC
LOGICAL LERROR
******------------------------------*-----------------------------******
LERROR=.FALSE.
C loop over 3 variables
DO IT=1,2
READ(10,'(A20,T25,I8)')HC,VARIN
IF (HC(1:5) .EQ.'NUMIN') THEN
NUMINLOC=VARIN
ELSEIF (HC(1:10).EQ.'NUMSAMFILE') THEN
NUMSAMFILE=VARIN
ELSE
WRITE(6,'(A,T10,A,A,A)')'***',
+ 'ERROR RDIN_HEAD HC not recognised:',HC,':'
LERROR=.TRUE.
END IF
END DO
C----
C---- check
C----
IF (NUMIN.NE.NUMINLOC) THEN
WRITE(6,'(A,T10,A,A,I8,A,I8)')'***','ERROR RDIN_HEAD ',
+ ' NUMIN=',NUMIN,' NUMINLOC=',NUMINLOC
LERROR=.TRUE.
END IF
C IF (NUMSAM.NE.NUMSAMLOC) THEN
C WRITE(6,'(A,T10,A,A,I8,A,I8)')'***','ERROR RDIN_HEAD ',
C + ' NUMSAM=',NUMSAM,' NUMSAMLOC=',NUMSAMLOC
C LERROR=.TRUE.
C END IF
IF (LERROR) THEN
WRITE(6,'(T2,A,T10,A)')'***',
+ 'RDIN_HEAD: reading header of input vectors'
STOP '*** RDIN_HEAD: left due to error in reading inIn'
END IF
END
***** end of RDIN_HEAD
***** ------------------------------------------------------------------
***** SUB RDIN_DATA(CNTRD,NUMINLOC)
***** ------------------------------------------------------------------
C----
C---- NAME : RDIN_DATA(CNTRD,NUMINLOC)
C---- ARG :
C---- DES : reading and checking DATA of file with input vec
C---- IN :
C---- FROM : RDIN
C---- CALL2:
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* CUBIC/LION http://cubic.bioc.columbia.edu *
* Columbia University rost@columbia.edu *
* changed: June, 1998 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE RDIN_DATA(CNTRD,NUMINLOC)
C---- include parameter files
INCLUDE 'profPar.f'
C---- local variables
INTEGER ITSAMRD,ITSAM,ITIN,CNTRD,NUMINLOC
CHARACTER*80 HC
******------------------------------*-----------------------------******
CNTRD=0
C---- loop over all samples in local file
DO ITSAM=1,NUMSAMFILE
READ(10,'(A8,I8)')HC,ITSAMRD
READ(10,'(25I6)')(INPUT(ITIN,ITSAMRD),ITIN=1,NUMINLOC)
CNTRD=CNTRD+1
END DO
END
***** end of RDIN_DATA
***** ------------------------------------------------------------------
***** SUB RDIN_WRT
***** ------------------------------------------------------------------
C----
C---- NAME : RDIN_WRT
C---- ARG :
C---- DES : writes the input vectors read
C---- IN :
C---- FROM : RDIN
C---- CALL2:
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* CUBIC/LION http://cubic.bioc.columbia.edu *
* Columbia University rost@columbia.edu *
* changed: June, 1998 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE RDIN_WRT
C---- include parameter files
INCLUDE 'profPar.f'
C---- local variables
INTEGER ITSAM,ITIN
CHARACTER*80 CTMP,CTMP2
******------------------------------*-----------------------------******
C----
C WRITE(6,'(A)')'--- '
CTMP='--- RDin: '
CTMP2='--------------------------------------------------'
WRITE(6,'(A,T16,A50)')CTMP,CTMP2
WRITE(6,'(A,T16,A)')CTMP,'Input vectors read:'
C----
C---- integers
C----
WRITE(6,'(A,T16,A)')CTMP,' '
WRITE(6,'(A,T16,A,T35,I8)')CTMP,'NUMIN',NUMIN
WRITE(6,'(A,T16,A,T35,I8)')CTMP,'NUMSAM',NUMSAM
C----
C---- vectors
C----
WRITE(6,'(A,T16,A)')CTMP,' '
DO ITSAM=1,NUMSAM
WRITE(6,'(A,T16,A10,I6,A3)')CTMP,'ITSAM=',ITSAM,' : '
WRITE(6,'(25I4)')(INPUT(ITIN,ITSAM),ITIN=1,NUMIN)
END DO
WRITE(6,'(A,T16,A,T35)')CTMP,'end of reading input vectors'
END
***** end of RDIN_WRT
***** ------------------------------------------------------------------
***** SUB RDOUT
***** ------------------------------------------------------------------
C----
C---- NAME : RDOUT
C---- ARG :
C---- DES : Reads the protein input from file
C---- IN :
C---- FROM : MAIN
C---- CALL2:
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* CUBIC/LION http://cubic.bioc.columbia.edu *
* Columbia University rost@columbia.edu *
* changed: June, 1998 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE RDOUT
C---- include parameter files
INCLUDE 'profPar.f'
C---- local function
INTEGER FILEN_STRING
C---- local variables *
INTEGER ITFILE,CNTTOT,CNTRD
Cxx
INTEGER COUNT_CLASS(1:10),ITOUT,ITSAM
Cxx
CHARACTER*80 HC,MREAD
LOGICAL LDONE,LREAD
******------------------------------*-----------------------------******
C message onto screen
C WRITE(6,'(A)')'--- '
CNTTOT=0
C----
C---- loop over input files
C----
DO ITFILE=1,NUMFILEIN_OUT
C message onto screen
C WRITE(6,'(A,T16,A)')'--- RDout file=',
C + FILEIN_OUT(ITFILE)(1:FILEN_STRING(FILEIN_OUT(ITFILE)))
WRITE(6,'(A,T16,A)')'--- RDout',
+ FILEIN_OUT(ITFILE)(1:FILEN_STRING(FILEIN_OUT(ITFILE)))
C read
CALL SFILEOPEN(10,FILEIN_OUT(ITFILE),'OLD',456,'READONLY')
LDONE=.FALSE.
DO WHILE (.NOT.LDONE)
LREAD=.FALSE.
READ(10,'(A9)',END=3057)HC
C terminate reading
IF (HC(1:2).EQ.'//') THEN
LDONE=.TRUE.
LREAD=.FALSE.
ELSEIF (HC(1:9).EQ.'* overall') THEN
LREAD=.FALSE.
MREAD='H'
ELSEIF (HC(1:9).EQ.'* samples') THEN
LREAD=.FALSE.
MREAD='D'
ELSEIF (HC(1:1).NE.'*') THEN
BACKSPACE 10
LREAD=.TRUE.
ELSE
LREAD=.FALSE.
END IF
C----
C header (numin,numsam,numsamfile)
C----
IF (LREAD.AND.(MREAD.EQ.'H')) THEN
CALL RDOUT_HEAD
ELSEIF (LREAD.AND.(MREAD.EQ.'D')) THEN
CALL RDOUT_DATA(CNTRD)
CNTTOT=CNTTOT+CNTRD
IF (CNTTOT.GT.NUMSAM) THEN
WRITE(6,'(A,T10,A,A,I8,A,I8)')'***','ERROR RDOUT ',
+ ' NUMSAM=',NUMSAM,' already CNTTOT=',CNTTOT
STOP '*** RDOUT: left due to error in reading inOut'
END IF
ELSEIF (LREAD) THEN
WRITE(6,'(A,T10,A,A,A)')'***',
+ 'ERROR RDOUT MREAD not recognised:',MREAD,':'
STOP '*** RDOUT: left due to error in reading inOut'
END IF
END DO
3057 CONTINUE
CLOSE(10)
END DO
C end of loop over input files
C---- ------------------------------
C---- write stat
DO ITOUT=1,NUMOUT
COUNT_CLASS(ITOUT)=0
END DO
DO ITSAM=1,NUMSAM
DO ITOUT=1,NUMOUT
IF (OUTDES(ITOUT,ITSAM).GT.0) THEN
COUNT_CLASS(ITOUT)=COUNT_CLASS(ITOUT)+1
END IF
END DO
END DO
IF (.FALSE.) THEN
WRITE(6,*)'xx stat on class'
DO ITOUT=1,NUMOUT
WRITE(6,'(A,I8,A,F6.1,A,I8)')
+ 'xx stat i=',ITOUT,
+ ' perc=',(100*COUNT_CLASS(ITOUT))/REAL(NUMSAM),
+ ' num=', COUNT_CLASS(ITOUT)
END DO
END IF
C control write
IF (LOGI_RDOUTWRT) THEN
CALL RDOUT_WRT
END IF
END
***** end of RDOUT
***** ------------------------------------------------------------------
***** SUB RDOUT_HEAD
***** ------------------------------------------------------------------
C----
C---- NAME : RDOUT_HEAD
C---- ARG :
C---- DES : reading and checking header of file with input vec
C---- IN :
C---- FROM : RDOUT
C---- CALL2:
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* CUBIC/LION http://cubic.bioc.columbia.edu *
* Columbia University rost@columbia.edu *
* changed: June, 1998 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE RDOUT_HEAD
C---- include parameter files
INCLUDE 'profPar.f'
C---- local variables
INTEGER VARIN,NUMOUTLOC,NUMSAMLOC,IT
CHARACTER*80 HC
LOGICAL LERROR
******------------------------------*-----------------------------******
LERROR=.FALSE.
C loop over 3 variables
DO IT=1,2
READ(10,'(A20,T25,I8)')HC,VARIN
IF (HC(1:6) .EQ.'NUMOUT') THEN
NUMOUTLOC=VARIN
ELSEIF (HC(1:10).EQ.'NUMSAMFILE') THEN
NUMSAMFILE=VARIN
ELSE
WRITE(6,'(T2,A,T10,A,A,A)')'***',
+ 'ERROR RDOUT_HEAD HC not recognised:',HC,':'
LERROR=.TRUE.
END IF
END DO
C----
C---- check DATA read
C----
IF (NUMOUT.NE.NUMOUTLOC) THEN
WRITE(6,'(A,T10,A,A,I8,A,I8)')'***','ERROR RDOUT_HEAD ',
+ ' NUMOUT=',NUMOUT,' NUMOUTLOC=',NUMOUTLOC
LERROR=.TRUE.
END IF
C IF (NUMSAM.NE.NUMSAMLOC) THEN
C WRITE(6,'(A,T10,A,A,I8,A,I8)')'***','ERROR RDOUT_HEAD ',
C + ' NUMSAM=',NUMSAM,' NUMSAMLOC=',NUMSAMLOC
C LERROR=.TRUE.
C END IF
IF (LERROR) THEN
WRITE(6,'(T2,A,T10,A)')'***',
+ 'RDOUT_HEAD: reading header of input vectors'
STOP '*** RDOUT_HEAD: left due to error in reading inIn'
END IF
END
***** end of RDOUT_HEAD
***** ------------------------------------------------------------------
***** SUB RDOUT_DATA(CNTRD)
***** ------------------------------------------------------------------
C----
C---- NAME : RDOUT_DATA(CNTRD)
C---- ARG :
C---- DES : reading and checking DATA of file with input vec
C---- IN :
C---- FROM : RDOUT
C---- CALL2:
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* CUBIC/LION http://cubic.bioc.columbia.edu *
* Columbia University rost@columbia.edu *
* changed: June, 1998 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE RDOUT_DATA(CNTRD)
C---- include parameter files
INCLUDE 'profPar.f'
C---- local variables
INTEGER ITSAMRD,ITSAM,ITOUT,CNTRD
CHARACTER*80 HC
******------------------------------*-----------------------------******
CNTRD=0
C---- loop over all samples in local file
DO ITSAM=1,NUMSAMFILE
READ(10,'(I8,A1,25I6)')ITSAMRD,HC,
+ (OUTDES(ITOUT,ITSAMRD),ITOUT=1,NUMOUT)
CNTRD=CNTRD+1
END DO
END
***** end of RDOUT_DATA
***** ------------------------------------------------------------------
***** SUB RDOUT_WRT
***** ------------------------------------------------------------------
C----
C---- NAME : RDOUT_WRT
C---- ARG :
C---- DES : writes the input vectors read
C---- IN :
C---- FROM : RDOUT
C---- CALL2:
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* CUBIC/LION http://cubic.bioc.columbia.edu *
* Columbia University rost@columbia.edu *
* changed: June, 1998 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE RDOUT_WRT
C---- include parameter files
INCLUDE 'profPar.f'
C---- local variables
INTEGER ITSAM,ITOUT
CHARACTER*80 CTMP,CTMP2
******------------------------------*-----------------------------******
C----
C WRITE(6,'(A)')'--- '
CTMP='--- RDout: '
CTMP2='--------------------------------------------------'
WRITE(6,'(A,T16,A50)')CTMP,CTMP2
WRITE(6,'(A,T16,A)')CTMP,'Output vectors read:'
C----
C---- integers
C----
WRITE(6,'(A,T16,A)')CTMP,' '
WRITE(6,'(A,T16,A,T35,I8)')CTMP,'NUMOUT',NUMOUT
WRITE(6,'(A,T16,A,T35,I8)')CTMP,'NUMSAM',NUMSAM
C----
C---- vectors
C----
WRITE(6,'(A,T16,A)')CTMP,' '
DO ITSAM=1,NUMSAM
WRITE(6,'(A,T16,I8,A3,25I4)')CTMP,ITSAM,' : ',
+ (OUTDES(ITOUT,ITSAM),ITOUT=1,NUMOUT)
END DO
WRITE(6,'(A,T16,A,T35)')CTMP,'end of reading output vectors'
END
***** end of RDOUT_WRT
***** ------------------------------------------------------------------
***** SUB RDPAR
***** ------------------------------------------------------------------
C----
C---- NAME : RDPAR
C---- ARG :
C---- DES : Reads the architecture specifica parameters from
C---- DES : perl (profWrt.pl) generated file
C---- IN :
C---- FROM : MAIN
C---- CALL2: RDPAR_WRT, RDPAR_I,_F,_A
C---- LIB : SFILEOPEN
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* CUBIC/LION http://cubic.bioc.columbia.edu *
* Columbia University rost@columbia.edu *
* changed: June, 1998 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE RDPAR
C---- include parameter files
INCLUDE 'profPar.f'
C---- local function
INTEGER FILEN_STRING
C---- local variables
CHARACTER*456 HC,MREAD
LOGICAL LDONE,LREAD
******------------------------------*-----------------------------******
C message onto screen
C WRITE(6,'(A)')'--- '
WRITE(6,'(A,T16,A)')'--- RDpar file=',
+ FILEIN_PAR(1:FILEN_STRING(FILEIN_PAR))
C---- read parameters from file PROF_InPar
CALL SFILEOPEN(10,FILEIN_PAR,'OLD',456,'READONLY')
LDONE=.FALSE.
DO WHILE (.NOT.LDONE)
LREAD=.FALSE.
C>>>>>>> GOTO END
READ(10,'(A3)',END=15047)HC
C------- terminate reading
IF (HC(1:2).EQ.'//') THEN
LDONE=.TRUE.
LREAD=.FALSE.
ELSEIF (HC(1:3).EQ.'* I') THEN
LREAD=.FALSE.
MREAD='I'
ELSEIF (HC(1:3).EQ.'* F') THEN
LREAD=.FALSE.
MREAD='F'
ELSEIF (HC(1:3).EQ.'* A') THEN
LREAD=.FALSE.
MREAD='A'
ELSEIF (HC(1:1).NE.'*') THEN
BACKSPACE 10
LREAD=.TRUE.
ELSE
LREAD=.FALSE.
END IF
IF (LREAD) THEN
IF (MREAD.EQ.'I') THEN
CALL RDPAR_I
ELSEIF (MREAD.EQ.'F') THEN
CALL RDPAR_F
ELSEIF (MREAD.EQ.'A') THEN
CALL RDPAR_A
ELSE
WRITE(6,'(A,T10,A,A,A)')'***',
+ 'ERROR RDPAR MREAD not recognised:',MREAD,':'
STOP '*** RDPAR: left due to error in reading inPar'
END IF
END IF
END DO
15047 CONTINUE
CLOSE(10)
* *
C---- control write
IF (LOGI_RDPARWRT) THEN
CALL RDPAR_WRT
END IF
END
***** end of RDPAR
***** ------------------------------------------------------------------
***** SUB RDPAR_I
***** ------------------------------------------------------------------
C----
C---- NAME : RDPAR_I
C---- ARG :
C---- DES : reading and interpreting one line with I8 input
C---- IN :
C---- FROM :
C---- CALL2: RDPAR
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* CUBIC/LION http://cubic.bioc.columbia.edu *
* Columbia University rost@columbia.edu *
* changed: June, 1998 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE RDPAR_I
C---- include parameter files
INCLUDE 'profPar.f'
C---- local variables
INTEGER VARIN
CHARACTER*80 HC
CHARACTER*456 CHAR_RD
******------------------------------*-----------------------------******
C---- read
READ(10,'(A20,T25,I8)')HC,VARIN
C---- ------------------------------
C---- interpret
IF (HC(1:5) .EQ.'NUMIN') THEN
NUMIN=VARIN
CALL RDPAR_ERR('NUMIN ',VARIN)
ELSEIF (HC(1:6) .EQ.'NUMHID') THEN
NUMHID=VARIN
CALL RDPAR_ERR('NUMHID ',VARIN)
ELSEIF (HC(1:6) .EQ.'NUMOUT') THEN
NUMOUT=VARIN
CALL RDPAR_ERR('NUMOUT ',VARIN)
ELSEIF (HC(1:9) .EQ.'NUMLAYERS') THEN
NUMLAYERS=VARIN
ELSEIF (HC(1:6) .EQ.'NUMSAM') THEN
NUMSAM=VARIN
CALL RDPAR_ERR('NUMSAM ',VARIN)
C----
C---- number of files
C----
ELSEIF (HC(1:12).EQ.'NUMFILEIN_IN') THEN
NUMFILEIN_IN=VARIN
CALL RDPAR_ERR(HC // ' ',VARIN)
ELSEIF (HC(1:13).EQ.'NUMFILEIN_OUT') THEN
NUMFILEIN_OUT=VARIN
CALL RDPAR_ERR(HC // ' ',VARIN)
ELSEIF (HC(1:14).EQ.'NUMFILEOUT_OUT') THEN
NUMFILEOUT_OUT=VARIN
CALL RDPAR_ERR(HC // ' ',VARIN)
ELSEIF (HC(1:14).EQ.'NUMFILEOUT_JCT') THEN
NUMFILEOUT_JCT=VARIN
CALL RDPAR_ERR(HC // ' ',VARIN)
C----
C---- training times
C----
ELSEIF (HC(1:9) .EQ.'STPSWPMAX') THEN
STPSWPMAX=VARIN
CALL RDPAR_ERR('STPSWPMAX ',VARIN)
ELSEIF (HC(1:6) .EQ.'STPMAX') THEN
STPMAX=VARIN
CALL RDPAR_ERR('STPMAX ',VARIN)
ELSEIF (HC(1:6) .EQ.'STPINF') THEN
STPINF=VARIN
CALL RDPAR_ERR('STPINF ',VARIN)
ELSEIF (HC(1:6) .EQ.'BITACC') THEN
BITACC=VARIN
ELSEIF (HC(1:10).EQ.'ERRBINSTOP') THEN
ERRBINSTOP=VARIN
C----
C---- miscellaneous
C----
ELSEIF (HC(1:8) .EQ.'DICESEED') THEN
DICESEED=VARIN
ELSEIF (HC(1:15).EQ.'DICESEED_ADDJCT') THEN
DICESEED_ADDJCT=VARIN
ELSEIF (HC(1:15).EQ.'DICESEED_ADDTRN') THEN
DICESEED_ADDTRN=VARIN
C----
C---- logicals
C----
ELSEIF (HC(1:13) .EQ.'LOGI_RDPARWRT') THEN
LOGI_RDPARWRT=LOGI_TRANSLATE(VARIN)
ELSEIF (HC(1:13) .EQ.'LOGI_RDINWRT') THEN
LOGI_RDINWRT=LOGI_TRANSLATE(VARIN)
ELSEIF (HC(1:13) .EQ.'LOGI_RDOUTWRT') THEN
LOGI_RDOUTWRT=LOGI_TRANSLATE(VARIN)
ELSEIF (HC(1:13) .EQ.'LOGI_RDJCTWRT') THEN
LOGI_RDJCTWRT=LOGI_TRANSLATE(VARIN)
C----
C---- unrecognised
C----
ELSE
WRITE(6,'(A,T10,A,A,I8)')'***',
+ 'RDPAR_I: no interpretation of',HC,VARIN
STOP '*** RDPAR_I: left due to error in reading inPar'
END IF
END
***** end of RDPAR_I
***** ------------------------------------------------------------------
***** SUB RDPAR_F
***** ------------------------------------------------------------------
C----
C---- NAME : RDPAR_F
C---- ARG :
C---- DES : reading and interpreting one line with F12.3 input
C---- IN :
C---- FROM :
C---- CALL2: RDPAR
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* CUBIC/LION http://cubic.bioc.columbia.edu *
* Columbia University rost@columbia.edu *
* changed: June, 1998 version 0.2 *
*----------------------------------------------------------------------*
SUBROUTINE RDPAR_F
C---- include parameter files
INCLUDE 'profPar.f'
C---- local variables
REAL VARIN
CHARACTER*80 HC
******------------------------------*-----------------------------******
C---- read
READ(10,'(A20,T25,F15.6)')HC,VARIN
C---- ------------------------------
C---- interpret
IF (HC(1:7) .EQ.'EPSILON') THEN
EPSILON=VARIN
ELSEIF (HC(1:5) .EQ.'ALPHA') THEN
ALPHA=VARIN
ELSEIF (HC(1:11).EQ.'TEMPERATURE') THEN
TEMPERATURE=VARIN
C----
ELSEIF (HC(1:7) .EQ.'ERRSTOP') THEN
ERRSTOP=VARIN
ELSEIF (HC(1:7) .EQ.'ERRBIAS') THEN
ERRBIAS=VARIN
ELSEIF (HC(1:10).EQ.'ERRBINACC') THEN
ERRBINACC=VARIN
C----
ELSEIF (HC(1:10).EQ.'THRESHOUT') THEN
THRESHOUT=VARIN
ELSEIF (HC(1:10).EQ.'DICEITRVL') THEN
DICEITRVL=VARIN
C----
C---- unrecognised
C----
ELSE
WRITE(6,'(A,T10,A,A,I8)')'***',
+ '*** RDPAR_F: no interpretation of',HC,VARIN
STOP '*** RDPAR_F: left due to error in reading inPar'
END IF
END
***** end of RDPAR_F
***** ------------------------------------------------------------------
***** SUB RDPAR_A
***** ------------------------------------------------------------------
C----
C---- NAME : RDPAR_A
C---- ARG :
C---- DES : reading and interpreting one line with A456 input
C---- DES :
C---- IN :
C---- FROM : RDPAR
C---- CALL2:
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* CUBIC/LION http://cubic.bioc.columbia.edu *
* Columbia University rost@columbia.edu *
* changed: June, 1998 version 0.2 *
*----------------------------------------------------------------------*
SUBROUTINE RDPAR_A
C---- include parameter files
INCLUDE 'profPar.f'
C---- local function
C CHARACTER*80 FCUT_SPACES
INTEGER FILEN_STRING
C---- local variables
INTEGER IT
CHARACTER*456 VARIN,HC2
CHARACTER*80 HC
LOGICAL LERROR
******------------------------------*-----------------------------******
LERROR=.FALSE.
C---- read
READ(10,'(A20,T25,A)')HC,VARIN
HC2=VARIN(1:FILEN_STRING(VARIN))
VARIN=' '
VARIN=HC2
C---- ------------------------------
C---- interpret
C----
C---- modes
IF (HC(1:7) .EQ.'TRNTYPE') THEN
TRNTYPE=VARIN(1:FILEN_STRING(VARIN))
IF ((TRNTYPE.NE.'BATCH').AND.(TRNTYPE.NE.'ONLINE')) THEN
WRITE(6,'(A,T10,A,A)')'***',
+ 'RDPAR_A: TRNTYPE=[BATCH|ONLINE], is=',VARIN
LERROR=.TRUE.
END IF
ELSEIF (HC(1:7) .EQ.'TRGTYPE') THEN
TRGTYPE=VARIN(1:FILEN_STRING(VARIN))
IF ((TRGTYPE.NE.'SIG').AND.(TRGTYPE.NE.'LOG')) THEN
WRITE(6,'(A,T10,A,A)')'***',
+ 'RDPAR_A: TRGTYPE=[SIG|LOG], is=',VARIN
LERROR=.TRUE.
END IF
ELSEIF (HC(1:7) .EQ.'ERRTYPE') THEN
ERRTYPE=VARIN
IF ( (ERRTYPE(1:7) .NE.'DELTASQ').AND.
+ (ERRTYPE(1:12).NE.'LN_1-DELTASQ')) THEN
WRITE(6,'(A,T10,A,A)')'***',
+ 'RDPAR_A: ERRTYPE=[DELTASQ|LN_1-DELTASQ], is=',
+ VARIN
LERROR=.TRUE.
END IF
ELSEIF (HC(1:8) .EQ.'MODEPRED') THEN
MODEPRED=VARIN(1:FILEN_STRING(VARIN))
ELSEIF (HC(1:7) .EQ.'MODENET') THEN
MODENET=VARIN(1:FILEN_STRING(VARIN))
ELSEIF (HC(1:6) .EQ.'MODEIN') THEN
MODEIN=VARIN(1:FILEN_STRING(VARIN))
ELSEIF (HC(1:7) .EQ.'MODEOUT') THEN
MODEOUT=VARIN(1:FILEN_STRING(VARIN))
ELSEIF (HC(1:7) .EQ.'MODEJOB') THEN
MODEJOB=VARIN(1:FILEN_STRING(VARIN))
C----
C---- input files
C----
ELSEIF (HC(1:9) .EQ.'FILEIN_IN') THEN
FILEIN_IN(1)=VARIN(1:FILEN_STRING(VARIN))
DO IT=2,NUMFILEIN_IN
C---------- read again
READ(10,'(A20,T25,A)')HC,FILEIN_IN(IT)
IF (HC(1:9).NE.'FILEIN_IN') THEN
WRITE(6,'(A,T10,A,A,A,A)')'***',
+ 'RDPAR_A:loop read filein_in, is',
+ HC,' V=',VARIN
LERROR=.TRUE.
END IF
END DO
ELSEIF (HC(1:10).EQ.'FILEIN_OUT') THEN
FILEIN_OUT(1)=VARIN(1:FILEN_STRING(VARIN))
DO IT=2,NUMFILEIN_OUT
C---------- read again
READ(10,'(A20,T25,A)')HC,FILEIN_OUT(IT)
IF (HC(1:10).NE.'FILEIN_OUT') THEN
WRITE(6,'(A,T10,A,A,A,A)')'***',
+ 'RDPAR_A:loop read filein_OUT, is',
+ HC,' V=',VARIN
LERROR=.TRUE.
END IF
END DO
ELSEIF (HC(1:10).EQ.'FILEIN_JCT') THEN
FILEIN_JCT=VARIN(1:FILEN_STRING(VARIN))
ELSEIF (HC(1:10).EQ.'FILEIN_SAM') THEN
FILEIN_SAM=VARIN(1:FILEN_STRING(VARIN))
C----
C---- output files
C----
ELSEIF (HC(1:11).EQ.'FILEOUT_OUT') THEN
FILEOUT_OUT(1)=VARIN
DO IT=2,NUMFILEOUT_OUT
C---------- read again
READ(10,'(A20,T25,A)')HC,FILEOUT_OUT(IT)
IF (HC(1:11).NE.'FILEOUT_OUT') THEN
WRITE(6,'(A,T10,A,A,A,A)')'***',
+ 'RDPAR_A:loop read FILEOUT_OUT, is',
+ HC,' V=',VARIN
LERROR=.TRUE.
END IF
END DO
ELSEIF (HC(1:11).EQ.'FILEOUT_JCT') THEN
FILEOUT_JCT(1)=VARIN
DO IT=2,NUMFILEOUT_JCT
C---------- read again
READ(10,'(A20,T25,A)')HC,FILEOUT_JCT(IT)
IF (HC(1:11).NE.'FILEOUT_JCT') THEN
WRITE(6,'(A,T10,A,A,A,A)')'***',
+ 'RDPAR_A:loop read FILEOUT_JCT, is',
+ HC,' V=',VARIN
LERROR=.TRUE.
END IF
END DO
ELSEIF (HC(1:11).EQ.'FILEOUT_ERR') THEN
FILEOUT_ERR=VARIN(1:FILEN_STRING(VARIN))
ELSEIF (HC(1:12).EQ.'FILEOUT_YEAH') THEN
FILEOUT_YEAH=VARIN(1:FILEN_STRING(VARIN))
C----
C---- unrecognised
C----
ELSE
WRITE(6,'(A,T10,A,A,A,A)')'***',
+ 'RDPAR_A: no interpretation of: hc= (',HC,
+ '), var=(',VARIN,')'
STOP '*** RDPAR_A: left due to error in reading inPar'
END IF
* *
C---- --------------------------------------------------
C---- error while reading?
IF (LERROR) THEN
WRITE(6,'(A,T10,A)')'***',
+ 'RDPAR_A: succession of parameters wrong'
STOP '*** RDPAR_A: left due to error in reading inPar'
END IF
END
***** end of RDPAR_A
***** ------------------------------------------------------------------
***** SUB RDPAR_ERR
***** ------------------------------------------------------------------
C----
C---- NAME : RDPAR_ERR
C---- ARG : CHAR,VARIN
C---- DES : checks some typical errors of the parameter file read
C----
* purpose: T
* in: character indicating which variable is currently
* in: treated
* out:
* called by: READPAR_I,READPAR_F,READPAR_A
* calling:
* lib:
* procedure:
*----------------------------------------------------------------------*
* Burkhard Rost Sep, 1999 version 1.0 *
* CUBIC http://www.columbia.edu *
* New York rost@columbia.edu *
* changed: Sep, 1999 version 0.1 *
*----------------------------------------------------------------------*
SUBROUTINE RDPAR_ERR(CHAR_RD,VARIN)
C---- include parameter files
INCLUDE 'profPar.f'
C---- variables passed
CHARACTER*456 CHAR_RD
INTEGER VARIN
C---- local parameters
C---- local variables *
******------------------------------*-----------------------------******
* *
******------------------------------*-----------------------------******
C---- ------------------------------------------------------------------
C----
C---- ------------------------------------------------------------------
IF (CHAR_RD(1:6) .EQ. 'NUMIN ' .AND.
+ NUMIN .GT. NUMIN_MAX) THEN
WRITE(6,'(A,T10,A,I8,A,I8)')'***',
+ 'RDPAR_ERR: NUMIN read=',NUMIN,' NUMIN_MAX=',NUMIN_MAX
STOP '*** RDPAR_ERR: left due to error in RDPAR_I'
ELSEIF (CHAR_RD(1:7) .EQ. 'NUMHID ' .AND.
+ NUMHID .GT. NUMHID_MAX) THEN
WRITE(6,'(A,T10,A,I8,A,I8)')'***',
+ 'RDPAR_ERR: NUMHID read=',NUMHID,' NUMHID_MAX=',NUMHID_MAX
STOP '*** RDPAR_ERR: left due to error in RDPAR_I'
ELSEIF (CHAR_RD(1:7) .EQ. 'NUMOUT ' .AND.
+ NUMOUT .GT. NUMOUT_MAX) THEN
WRITE(6,'(A,T10,A,I8,A,I8)')'***',
+ 'RDPAR_ERR: NUMOUT read=',NUMOUT,' NUMOUT_MAX=',NUMOUT_MAX
STOP '*** RDPAR_ERR: left due to error in RDPAR_I'
ELSEIF (CHAR_RD(1:7) .EQ. 'NUMSAM ' .AND.
+ NUMSAM .GT. NUMSAM_MAX) THEN
WRITE(6,'(A,T10,A,I8,A,I8)')'***',
+ 'RDPAR_ERR: NUMSAM read=',NUMSAM,' NUMSAM_MAX=',NUMSAM_MAX
STOP '*** RDPAR_ERR: left due to error in RDPAR_I'
ELSEIF (CHAR_RD(1:7) .EQ. 'NUMFILE' .AND.
+ VARIN .GT. NUMFILES_MAX) THEN
WRITE(6,'(A,T10,A,I8,A,I8)')'***',
+ 'RDPAR_ERR: NUMFILE* read=',VARIN,' NUMFILE_MAX=',
+ NUMFILES_MAX
STOP '*** RDPAR_ERR: left due to error in RDPAR_I'
ELSEIF (CHAR_RD(1:9) .EQ. 'STPSWPMAX' .AND.
+ VARIN .GT. STPSWPMAX_MAX) THEN
WRITE(6,'(A,T10,A,I8,A,I8)')'***',
+ 'RDPAR_ERR: STPSWPMAX read=',VARIN,' STPSWPMAX_MAX=',
+ STPSWPMAX_MAX
STOP '*** RDPAR_ERR: left due to error in RDPAR_I'
ELSEIF (CHAR_RD(1:6) .EQ. 'STPMAX' .AND.
+ VARIN .GT. STPMAX_MAX) THEN
WRITE(6,'(A,T10,A,I8,A,I8)')'***',
+ 'RDPAR_ERR: STPMAX read=',VARIN,' STPMAX_MAX=',
+ STPMAX_MAX
STOP '*** RDPAR_ERR: left due to error in RDPAR_I'
ELSEIF (CHAR_RD(1:6) .EQ. 'STPINF' .AND.
+ VARIN .GT. STPMAX_MAX) THEN
WRITE(6,'(A,T10,A,I8,A,I8)')'***',
+ 'RDPAR_ERR: STPINF read=',VARIN,' STPMAX_MAX=',
+ STPMAX_MAX
STOP '*** RDPAR_ERR: left due to error in RDPAR_I'
END IF
END
***** end of RDPAR_ERR
***** ------------------------------------------------------------------
***** SUB RDPAR_WRT
***** ------------------------------------------------------------------
C----
C---- NAME : RDPAR_WRT
C---- ARG :
C---- DES : reading and interpreting one line with F12.3 input
C---- IN :
C---- FROM : RDPAR
C---- CALL2:
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* CUBIC/LION http://cubic.bioc.columbia.edu *
* Columbia University rost@columbia.edu *
* changed: June, 1998 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE RDPAR_WRT
C---- include parameter files
INCLUDE 'profPar.f'
C---- local function
INTEGER FILEN_STRING
C---- local variables
INTEGER IT
CHARACTER*80 CTMP,CTMP2
******------------------------------*-----------------------------******
C----
CTMP='--- RDpar: '
CTMP2='--------------------------------------------------'
C WRITE(6,'(A)')'--- '
WRITE(6,'(A,T16,A50)')CTMP,CTMP2
WRITE(6,'(A,T16,A)')CTMP,'Parameters read:'
C----
C---- integers
C----
WRITE(6,'(A,T16,A)')CTMP,' '
WRITE(6,'(A,T16,A,T35,I8)')CTMP,'NUMIN',NUMIN
WRITE(6,'(A,T16,A,T35,I8)')CTMP,'NUMHID',NUMHID
WRITE(6,'(A,T16,A,T35,I8)')CTMP,'NUMOUT',NUMOUT
WRITE(6,'(A,T16,A,T35,I8)')CTMP,'NUMLAYERS',NUMLAYERS
C----
WRITE(6,'(A,T16,A,T35,I8)')CTMP,'NUMSAM',NUMSAM
C----
WRITE(6,'(A,T16,A,T35,I8)')CTMP,'NUMFILEIN_IN',NUMFILEIN_IN
WRITE(6,'(A,T16,A,T35,I8)')CTMP,'NUMFILEIN_OUT',NUMFILEIN_OUT
WRITE(6,'(A,T16,A,T35,I8)')CTMP,'NUMFILEOUT_OUT',NUMFILEOUT_OUT
WRITE(6,'(A,T16,A,T35,I8)')CTMP,'NUMFILEOUT_JCT',NUMFILEOUT_JCT
C----
WRITE(6,'(A,T16,A,T35,I8)')CTMP,'STPSWPMAX',STPSWPMAX
WRITE(6,'(A,T16,A,T35,I8)')CTMP,'STPMAX',STPMAX
WRITE(6,'(A,T16,A,T35,I8)')CTMP,'STPINF',STPINF
WRITE(6,'(A,T16,A,T35,I8)')CTMP,'ERRBINSTOP',ERRBINSTOP
C----
C---- reals
C----
WRITE(6,'(A,T16,A)')CTMP,' '
WRITE(6,'(A,T16,A,T35,F15.6)')CTMP,'EPSILON',EPSILON
WRITE(6,'(A,T16,A,T35,F15.6)')CTMP,'ALPHA',ALPHA
WRITE(6,'(A,T16,A,T35,F15.6)')CTMP,'TEMPERATURE',TEMPERATURE
C----
WRITE(6,'(A,T16,A,T35,F15.6)')CTMP,'ERRSTOP',ERRSTOP
WRITE(6,'(A,T16,A,T35,F15.6)')CTMP,'ERRBIAS',ERRBIAS
C----
C---- characters
C----
WRITE(6,'(A,T16,A)')CTMP,' '
WRITE(6,'(A,T16,A,T35,A)')CTMP,
+ 'TRNTYPE',TRNTYPE(1:FILEN_STRING(TRNTYPE))
WRITE(6,'(A,T16,A,T35,A)')CTMP,
+ 'TRGTYPE',TRGTYPE(1:FILEN_STRING(TRGTYPE))
WRITE(6,'(A,T16,A,T35,A)')CTMP,
+ 'ERRTYPE',ERRTYPE(1:FILEN_STRING(ERRTYPE))
WRITE(6,'(A,T16,A,T35,A)')CTMP,
+ 'MODEPRED',MODEPRED(1:FILEN_STRING(MODEPRED))
WRITE(6,'(A,T16,A,T35,A)')CTMP,
+ 'MODENET',MODENET(1:FILEN_STRING(MODENET))
WRITE(6,'(A,T16,A,T35,A)')CTMP,
+ 'MODEIN',MODEIN(1:FILEN_STRING(MODEIN))
WRITE(6,'(A,T16,A,T35,A)')CTMP,
+ 'MODEJOB',MODEJOB(1:FILEN_STRING(MODEJOB))
C----
C---- files
C----
DO IT=1,NUMFILEIN_IN
WRITE(6,'(A,T16,A,T30,I4,A1,A)')CTMP,'FILEIN_IN',IT,' ',
+ FILEIN_IN(IT)(1:FILEN_STRING(FILEIN_IN(IT)))
END DO
DO IT=1,NUMFILEIN_OUT
WRITE(6,'(A,T16,A,T30,I4,A1,A)')CTMP,'FILEIN_OUT',IT,' ',
+ FILEIN_OUT(IT)(1:FILEN_STRING(FILEIN_OUT(IT)))
END DO
WRITE(6,'(A,T16,A,T35,A)')CTMP,
+ 'FILEIN_JCT',FILEIN_JCT(1:FILEN_STRING(FILEIN_JCT))
WRITE(6,'(A,T16,A,T35,A)')CTMP,
+ 'FILEIN_SAM',FILEIN_SAM(1:FILEN_STRING(FILEIN_SAM))
DO IT=1,NUMFILEOUT_OUT
WRITE(6,'(A,T16,A,T30,I4,A1,A)')CTMP,'FILEOUT_OUT',IT,' ',
+ FILEOUT_OUT(IT)(1:FILEN_STRING(FILEOUT_OUT(IT)))
END DO
DO IT=1,NUMFILEOUT_JCT
WRITE(6,'(A,T16,A,T30,I4,A1,A)')CTMP,'FILEOUT_JCT',IT,' ',
+ FILEOUT_JCT(IT)(1:FILEN_STRING(FILEOUT_JCT(IT)))
END DO
WRITE(6,'(A,T16,A,T35,A)')CTMP,
+ 'FILEOUT_ERR',FILEOUT_ERR(1:FILEN_STRING(FILEOUT_ERR))
WRITE(6,'(A,T16,A,T35,A)')CTMP,
+ 'FILEOUT_YEAH',FILEOUT_YEAH(1:FILEN_STRING(FILEOUT_YEAH))
WRITE(6,'(A,T16,A,T35)')CTMP,'end of reading parameters'
END
***** end of RDPAR_WRT
***** ------------------------------------------------------------------
***** SUB RDSAM
***** ------------------------------------------------------------------
C----
C---- NAME : RDSAM
C---- ARG :
C---- DES : reads the succession of samples
C---- IN :
C---- FROM : MAIN
C---- CALL2:
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* CUBIC/LION http://cubic.bioc.columbia.edu *
* Columbia University rost@columbia.edu *
* changed: June, 1998 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE RDSAM
C---- include parameter files
INCLUDE 'profPar.f'
C---- local function
INTEGER FILEN_STRING
C---- local variables *
INTEGER IT,STPMAXLOC,VARIN
CHARACTER*80 HC,MREAD
LOGICAL LDONE,LREAD
******------------------------------*-----------------------------******
C message onto screen
C WRITE(6,'(A)')'--- '
WRITE(6,'(A,T16,A)')'--- RDsam file=',
+ FILEIN_SAM(1:FILEN_STRING(FILEIN_SAM))
C---- read parameters from file PROF_InPar
CALL SFILEOPEN(10,FILEIN_SAM,'OLD',456,'READONLY')
LDONE=.FALSE.
DO WHILE (.NOT.LDONE)
LREAD=.FALSE.
READ(10,'(A3)',END=6067)HC
C------- terminate reading
IF (HC(1:2).EQ.'//') THEN
LDONE=.TRUE.
LREAD=.FALSE.
ELSEIF (HC(1:3).EQ.'* o') THEN
LREAD=.FALSE.
MREAD='H'
ELSEIF (HC(1:3).EQ.'* p') THEN
LREAD=.FALSE.
MREAD='D'
ELSEIF (HC(1:1).NE.'*') THEN
BACKSPACE 10
LREAD=.TRUE.
ELSE
LREAD=.FALSE.
END IF
IF (LREAD) THEN
IF (MREAD.EQ.'H') THEN
READ(10,'(A20,T25,I8)',END=6067)HC,VARIN
STPMAXLOC=VARIN
IF (HC(1:6).NE.'STPMAX') THEN
WRITE(6,'(A,T10,A,A)')'***',
+ 'ERROR RDSAM not NUMSAM:',HC
STOP '*** RDSAM: left due to error in reading inSam'
ELSEIF (STPMAXLOC.LT.STPMAX) THEN
WRITE(6,'(A,T10,A,I8,A,I8)')'***',
+ 'ERROR RDSAM STPMAXLOC=',STPMAXLOC,
+ ' STPMAX=',STPMAX
Cxx STOP '*** RDPAR: left due to error in reading inSam'
END IF
ELSEIF (MREAD.EQ.'D') THEN
READ(10,'(25I8)',END=6067)(PICKSAM(IT),IT=1,STPMAXLOC)
Cxx READ(10,'(25I8)',END=6067)(PICKSAM(IT),IT=1,STPMAX)
LDONE=.TRUE.
ELSE
WRITE(6,'(A,T10,A,A,A)')'***',
+ 'ERROR RDSAM MREAD not recognised:',MREAD,':'
STOP '*** RDPAR: left due to error in reading inPar'
END IF
END IF
END DO
6067 CONTINUE
CLOSE(10)
END
***** end of RDSAM
***** ------------------------------------------------------------------
***** SUB NETOUT(LERR,LBIN,STP)
***** ------------------------------------------------------------------
C----
C---- NAME : NETOUT
C---- ARG : LERR,LBIN,STP
C---- DES : executes network NETOUT function input --> output
C---- IN : logicals : do error? do error bin?, current step
C---- FROM : MAIN, TRAIN
C---- CALL2: NETOUT_MUE, NETOUT_BIN, NETOUT_ERR
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* CUBIC/LION http://cubic.bioc.columbia.edu *
* Columbia University rost@columbia.edu *
* changed: June, 1998 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE NETOUT(LERR,LBIN,STP)
C---- parameters/global variables
INCLUDE 'profPar.f'
C---- local variables
INTEGER MUE,STP,ITOUT
LOGICAL LBIN,LERR
******------------------------------*-----------------------------******
* INPUT (NUMHID,NUMIN+) input matrix *
* is used *
* INVABW =1/ABW for avoiding too high quantities *
* FLD the local fields (abbr.: h) are defined by: *
* h(I,MUE )= sum(k,{J(k,i)*s(k,mue))+b(i,mue) *
* NEGINVABW =-INVABW *
******------------------------------*-----------------------------******
C---- cutoffs
INVABW=1./ABW
NEGINVABW=(-1.)*INVABW
* *
C---- --------------------------------------------------
C---- loop over all samples (residues)
C---- --------------------------------------------------
DO MUE=1,NUMSAM
C----
C---- this burns CPU! network input-> output
C----
CALL NETOUT_MUE(MUE)
C WRITE(6,'(A,I5,A,3I4,A,3I4)')'dbg: NETOUT mue=',MUE,
C + ' out=',(INT(100*OUTPUT(ITOUT)),ITOUT=1,NUMOUT),
C + ' des=',(OUTDES(ITOUT,MUE),ITOUT=1,NUMOUT)
C WRITE(6,'(A,I5,A,3I4)')'dbg: NETOUT mue=',MUE,
C + ' out=',(INT(100*OUTPUT(ITOUT)),ITOUT=1,NUMOUT)
C----
C---- this HAS burned CPU! network input-> output
C----
C winner-take-all decision
IF (LBIN) THEN
CALL NETOUT_BIN(MUE)
END IF
C compile network error
IF (LERR) THEN
CALL NETOUT_ERR(MUE,STP)
END IF
END DO
C WRITE(6,*)'yy err=',err(stp),' bin=',errbin(stp)
END
***** end of NETOUT
***** ------------------------------------------------------------------
***** SUB NETOUT_MUE
***** ------------------------------------------------------------------
C----
C---- NAME : NETOUT_MUE
C---- ARG : MUE
C---- DES : executes network NETOUT function input --> output
C---- DES : for one pattern
C---- IN : number of current pattern
C---- FROM : NETOUT, TRAIN, WRTOUT
C---- CALL2:
C----
C---- IN GLOBAL : INPUT, JCT1st, JCT2ND, NUMHID,*IN,*OUT,BITACC,
C---- OUT GLOBAL : OUTPUT, FLD1st, FLD2nd
C----
C---- *********************
C---- NOTE : heavy in terms of CPU
C---- *********************
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* CUBIC/LION http://cubic.bioc.columbia.edu *
* Columbia University rost@columbia.edu *
* changed: June, 1998 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE NETOUT_MUE(MUE)
C---- global parameters and variables
INCLUDE 'profPar.f'
C---- local variables *
INTEGER MUE,ITHID,ITIN,ITOUT
******------------------------------*-----------------------------******
C----
C---- compute local fields for hidden unit
C----
DO ITHID=1,NUMHID
FLD1ST(ITHID)=0.
DO ITIN=1,NUMIN
IF (INPUT(ITIN,MUE).NE.0.) THEN
FLD1ST(ITHID)=FLD1ST(ITHID)
+ +JCT1ST(ITIN,ITHID)*INPUT(ITIN,MUE)
END IF
END DO
C rescale with BITACC
FLD1ST(ITHID)=FLD1ST(ITHID)/REAL(BITACC)
C threshold units
FLD1ST(ITHID)=FLD1ST(ITHID)+JCT1ST((NUMIN+1),ITHID)
END DO
C----
C---- compute value of hidden units
C----
C VECTOR
DO ITHID=1,NUMHID
IF ( ABS(FLD1ST(ITHID)).LT.INVABW) THEN
OUTHID(ITHID)=(1./(1.+EXP (- FLD1ST(ITHID) ) ))
ELSEIF (FLD1ST(ITHID).LE.NEGINVABW) THEN
OUTHID(ITHID)=0.
ELSEIF (FLD1ST(ITHID).GE.INVABW) THEN
OUTHID(ITHID)=1.
ELSE
WRITE(6,'(T2,A,T10,A,I8)')'***',
+ 'ERROR in NETOUT_MUE: wrong assignment MUE=',MUE
WRITE(6,'(T2,A,T10,A)')'***',
+ 'intermediate output!! Stopped at 12-10-92-1'
STOP '*** NETOUT_MUE: left due to error (FLD1ST wrong)'
END IF
END DO
C END VECTOR
C----
C---- compute local field for second layer
C----
DO ITOUT=1,NUMOUT
FLD2ND(ITOUT)=0.
C PARALLEL
DO ITHID=1,NUMHID
IF (OUTHID(ITHID).GT.ABW) THEN
FLD2ND(ITOUT)=FLD2ND(ITOUT)+
+ (JCT2ND(ITHID,ITOUT)*OUTHID(ITHID))
END IF
END DO
C END PARALLEL
C threshold unit
FLD2ND(ITOUT)=FLD2ND(ITOUT)+JCT2ND((NUMHID+1),ITOUT)
END DO
C----
C---- compute output
C----
DO ITOUT=1,NUMOUT
IF ((ABS(FLD2ND(ITOUT)).LT.INVABW).AND.
+ (FLD2ND(ITOUT).GT.NEGINVABW)) THEN
OUTPUT(ITOUT)=1./(1.+ EXP (- FLD2ND(ITOUT) ))
ELSEIF (FLD2ND(ITOUT).LE.NEGINVABW) THEN
OUTPUT(ITOUT)=0.
ELSEIF (FLD2ND(ITOUT).GE.INVABW) THEN
OUTPUT(ITOUT)=1.
ELSE
WRITE(6,'(T2,A,T10,A,I8)')'***',
+ 'ERROR in NETOUT_MUE: output wrong assigned, MUE=',MUE
WRITE(6,'(T2,A,T10,A)')'***','stopped at 12-10-92-2'
STOP '*** NETOUT_OUT: left due to error (FLD2ND wrong)'
END IF
END DO
END
***** end of NETOUT_MUE
***** ------------------------------------------------------------------
***** SUB NETOUT_BIN
***** ------------------------------------------------------------------
C----
C---- NAME : NETOUT_BIN
C---- ARG : MUE
C---- DES : winner-take-all decision, only maximal unit will be
C---- DES : set to 1
C---- IN : number of current pattern
C---- FROM : NETOUT, TRAIN
C---- CALL2:
C---- LIB : FRMAX1
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* CUBIC/LION http://cubic.bioc.columbia.edu *
* Columbia University rost@columbia.edu *
* changed: June, 1998 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE NETOUT_BIN(MUE)
C---- global parameters and variables
INCLUDE 'profPar.f'
C---- local functions
REAL FRMAX1
C---- local variables
INTEGER MUE,ITOUT
REAL HELPMAX
******------------------------------*-----------------------------******
C----
C---- the winner takes it all
C----
OUTWIN(MUE)=0
IF (NUMOUT.EQ.1) THEN
IF (OUTPUT(1).GT.THRESHOUT) THEN
OUTWIN(MUE)=1
END IF
ELSE
C security: set zero
DO ITOUT=(NUMOUT+1),NUMOUT_MAX
OUTPUT(ITOUT)=0
END DO
C find max
HELPMAX=FRMAX1(OUTPUT,NUMOUT_MAX)
C which unit
DO ITOUT=1,NUMOUT
IF (OUTPUT(ITOUT).EQ.HELPMAX) THEN
OUTWIN(MUE)=INT2(ITOUT)
END IF
END DO
END IF
* *
C----
C---- at least one bin = 1 ?
C----
IF ((OUTWIN(MUE).EQ.0).AND.(NUMOUT.GT.1)) THEN
WRITE(6,'(T2,A,T10,A,I8)')'***',
+ 'ERROR NETOUT_BIN no winner, mue=',mue
WRITE(6,'(T2,A,T10,10F5.2)')'***',
+ (OUTPUT(ITOUT),ITOUT=1,NUMOUT)
STOP '*** NETOUT_BIN: left due to error (no winner)'
END IF
END
***** end of NETOUT_BIN
***** ------------------------------------------------------------------
***** SUB NETOUT_ERR
***** ------------------------------------------------------------------
C----
C---- NAME : NETOUT_ERR
C---- ARG : MUE,STP
C---- DES : compiles the current error committed by the NN
C---- IN : number of current pattern, number of current step
C---- OUT : ERR(STP), OKBIN(STP), ERRBIN(STP)
C---- note : additive, initialised for first pattern
C----
C---- FROM : NETOUT, TRAIN
C---- CALL2:
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* CUBIC/LION http://cubic.bioc.columbia.edu *
* Columbia University rost@columbia.edu *
* changed: June, 1998 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE NETOUT_ERR(MUE,STP)
C---- global parameters and variables
INCLUDE 'profPar.f'
C---- local variables *
INTEGER ITOUT,MUE,STP
REAL DELTA,RHELP
******------------------------------*-----------------------------******
C----
C---- setting zero for first pattern
C----
IF (MUE.EQ.1) THEN
ERR(STP)=0.
OKBIN(STP)=0
ERRBIN(STP)=100
END IF
C----
C---- error per sample
C----
C real error
RHELP=0.0
DO ITOUT=1,NUMOUT
DELTA=OUTPUT(ITOUT)-(OUTDES(ITOUT,MUE)/BITACC)
IF ( ABS(DELTA).GT.ABW) THEN
RHELP=RHELP+(DELTA)**2
END IF
END DO
C binary error
IF (NUMOUT.EQ.1) THEN
IF (((OUTDES(1,MUE).EQ.0).AND.
+ (OUTPUT(1).LT.ERRBINACC)).OR.
+ ((OUTDES(1,MUE).EQ.BITACC).AND.
+ (OUTPUT(1).GT.(1-ERRBINACC)))) THEN
OKBIN(STP)=OKBIN(STP)+1
END IF
ELSE
POSWIN=OUTWIN(MUE)
IF (((OUTPUT(POSWIN).LT.ERRBINACC).AND.
+ (OUTDES(POSWIN,MUE).EQ.0)).OR.
+ ((OUTPUT(POSWIN).GT.(1-ERRBINACC)).AND.
+ (OUTDES(POSWIN,MUE).EQ.BITACC))) THEN
OKBIN(STP)=OKBIN(STP)+1
END IF
END IF
C total error
ERR(STP)=ERR(STP)+RHELP
C----
C---- scaling error for last sample
C----
IF (MUE.EQ.NUMSAM) THEN
C ERR(STP)=(1./REAL(NUMSAM))*(1./REAL(NUMOUT))*ERR(STP)
ERR(STP)=(1./REAL(NUMSAM))*(1./REAL(NUMOUT))*ERR(STP)
ERRBIN(STP)=100*(1.-(OKBIN(STP)/REAL(NUMSAM)))
END IF
END
***** end of NETOUT_ERR
***** ------------------------------------------------------------------
***** SUB TRAIN
***** ------------------------------------------------------------------
C----
C---- NAME : TRAIN
C---- ARG :
C---- DES : optimized version of error back-prop training
C---- IN :
C---- FROM : MAIN
C---- CALL2: TRAIN_BACKPROP
C---- CALL2: TRAIN_INIMUE -> NETOUT_MUE, lib: SRSTE2, SRSTZ2
C---- CALL2: TRAIN_INISWP -> lib: STRSTZ2
C---- CALL2: TRAIN_STOP
C---- CALL2: TRAIN_WRT
C---- CALL2: NETOUT -> NETOUT_MUE|BIN|ERR
C---- CALL2: WRTJCT -> lib: SFILEOPEN, WRTHEAD
C---- CALL2: WRTOUT -> NETOUT_MUE, WRTHEAD, lib: SFILEOPEN
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* CUBIC/LION http://cubic.bioc.columbia.edu *
* Columbia University rost@columbia.edu *
* changed: June, 1998 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE TRAIN
C---- global parameters and variables
INCLUDE 'profPar.f'
C---- local variables
INTEGER MUE,ITIN,ITHID,ITOUT
REAL DELTA(1:NUMOUT_MAX),FACDELTA(1:NUMOUT_MAX)
REAL*4 RHELP,VECSUM
CHARACTER*80 CTMP,CTMP2
LOGICAL LERR,LBIN,LSTOP,LCONT
******------------------------------*-----------------------------******
LERR=.TRUE.
LBIN=.TRUE.
CTMP='--- TRAIN: '
CTMP2='--------------------------------------------------'
C writing into header (arrived at OTRNON asf)
WRITE(6,'(A15,A50)')CTMP,CTMP2
WRITE(6,'(A15)')CTMP
WRITE(6,'(A15,A)')CTMP,'----------------'
WRITE(6,'(A15,A)')CTMP,'arrived in TRAIN'
WRITE(6,'(A15,A)')CTMP,'----------------'
WRITE(6,'(A15)')CTMP
C initialise 1: check training accuracy asf.
CALL NETOUT(LERR,LBIN,STPNOW)
CALL TRAIN_STOP(LSTOP,STPNOW,CTMP)
CALL TRAIN_WRT(CTMP,0,0)
IF (LSTOP) THEN
C never enter the while !
LCONT= .FALSE.
ELSE
C ini for first sweep (stpswp)
LCONT= .TRUE.
STPSWPNOW=1
STPNOW= 0
END IF
C-----------------------------------------------------------------------
C---- THE LOOP: by intrinsic time scale: STPNOW
C---- intrinsic time scale given by training set
C-----------------------------------------------------------------------
DO WHILE ((STPSWPNOW.LE.STPSWPMAX) .AND.
+ (STPNOW.LE.STPMAX) .AND. LCONT)
C---- (0) PDJCT1ST,PDJCT2ND,DJCT1ST,DJCT1ST == 0
C---- (n) count up (STPNOW,STPSWPNOW,STPINFNOW)
CALL TRAIN_INISWP(CTMP)
C---- end learning after STPMAX steps
IF (STPNOW.GT.STPMAX) THEN
STPSWPNOW=STPSWPMAX
STPNOW= STPNOW-1
LCONT= .FALSE.
ELSE
MUE=PICKSAM(STPNOW)
IF (MUE .EQ.0) THEN
WRITE(6,*)'*** ERROR TRAIN: (MUE=0) STPNOW=',STPNOW
STOP
ENDIF
C---- set OUTPUT for current MUE
CALL TRAIN_INIMUE(MUE)
C---- here goes THE thing
CALL TRAIN_BACKPROP(MUE)
END IF
C------- write info about how far things have come
IF (STPINFNOW.EQ.STPINF) THEN
STPINFNOW=0
STPINFCNT=STPINFCNT+1
C---------- network input -> output
CALL NETOUT(LERR,LBIN,STPINFCNT)
C---------- write onto screen
CALL TRAIN_WRT(CTMP,STPINFCNT,STPNOW)
C---------- write the current output into file
CALL WRTOUT(10,FILEOUT_OUT(STPINFCNT),STPINFCNT,STPNOW)
C---------- write current junctions into file
CALL WRTJCT(10,FILEOUT_JCT(STPINFCNT))
C---------- error low enough?
CALL TRAIN_STOP(LSTOP,STPNOW,CTMP)
C---------- terminate!
IF (LSTOP) THEN
LCONT= .FALSE.
END IF
END IF
C------- end of one back-prop step
END DO
C---- end of loop over STPSWP (i.e. all samples)
C-----------------------------------------------------------------------
IF (STPSWPNOW.GE.STPSWPMAX) THEN
WRITE(6,'(A15,A,I8,A,I8)')CTMP,'end reached for STSWPNOW=',
+ STPSWPNOW,' >= STPSWPMAX=',STPSWPMAX
END IF
IF (STPNOW.GE.STPMAX) THEN
WRITE(6,'(A15,A,I8,A,I8)')CTMP,'end reached for STNOW=',
+ STPNOW,' >= STPMAX=',STPMAX
END IF
END
***** end of TRAIN
***** ------------------------------------------------------------------
***** SUB TRAIN_BACKPROP
***** ------------------------------------------------------------------
C----
C---- NAME : TRAIN_BACKPROP
C---- ARG : MUE
C---- DES : optimized version of error back-prop training
C---- IN : current pattern MUE
C---- FROM : TRAIN
C---- CALL2:
C----
* procedure: back-prop algorithm
*
* d(i) = desired output for unit i (1..numout=N2)
* o(i) = output for unit i (1..numout=N2)
* h(j) = hidden output for unit j (1..numhid=N1)
* s(k) = input for unit k (1..numin=N0)
*
* J1 : junction between hidden and input
* J2 : junction between output and hidden
*
* f(x) = 1 / (1 + e^(-x)) sigmoid
* df/dx = f ( 1 - f) (df/dx)
*
*
* N1+1
* o(i) = f ( SUM J2(ij)* f ( h(j) ) )
* j
*
* N0+1
* h(j) = f ( SUM J1(jk) * s(k) )
* k
* N2
* E = SUM ( o(i) - d(i) ) **2
* i
*
* DELTA(i) = o(i) - d(i)
*
* +--- is f' ---+
* dE | |
* ------- = DELTA(i) * o(i)*(1-o(i)) * h(j)
* dJ2(ij)
* +--- is f' ---+
* dE | |
* ------- = s(k) * h(j)*(1-h(j)) * VECSUM(j)
* dJ1(jk)
* N2
* VECSUM(j) = SUM J2(ij) * o(i)*(1-o(i)) * DELTA(i)
* i
* dE DELTA(i)
* E -> ln ( 1 - E ) => ---- -> -----------------
* dJ 1 - DELTA(i)**2
*
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* CUBIC/LION http://cubic.bioc.columbia.edu *
* Columbia University rost@columbia.edu *
* changed: June, 1998 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE TRAIN_BACKPROP(MUE)
C---- global parameters and variables
INCLUDE 'profPar.f'
C---- local variables *
INTEGER MUE,ITIN,ITHID,ITOUT
REAL DELTA(1:NUMOUT_MAX),FACDELTA(1:NUMOUT_MAX),DIFF
REAL*4 RHELP,VECSUM
CHARACTER*80 CTMP,CTMP2
LOGICAL LERR,LBIN,LSTOP,LCONT
* *
******------------------------------*-----------------------------******
* FACDELTA the factor of 'all deltas', i.e.: *
* FACDELTA= f''(out)*(out-des), or corresponding *
* quantity for algorithms other than sigmoid *
* MOMENTUM intermediately required variable storing the *
* 'momentum' = alpha * olddeljunc *
* STPINFCNT counts the steps of learning up to each STPINFth *
* one and is set zero then *
* DELTA for particular i,mue: output(i,mue)-desired(i,mue) *
* PDELJCT1st/2nd stores the changes from the last TIME *
******------------------------------*-----------------------------******
C---- ------------------------------------------------------------------
C---- prefactors for changing junctions
C----
C---- i=1,numout:
C---- DELTA(i)= [ OUT(i) - OUTDES(i) ]
C---- FACDELTA(i)= DELTA(i) * OUT(i) * (1-OUT(i))
C---- where:
C---- OUT*(1-OUT)= derivative of sigmoid!
C---- ------------------------------------------------------------------
DO ITOUT=1,NUMOUT
IF (ERRBIAS.EQ.0.) THEN
DELTA(ITOUT)=OUTPUT(ITOUT)-(OUTDES(ITOUT,MUE)/REAL(BITACC))
ELSE
IF (OUTDES(ITOUT,MUE).EQ.BITACC) THEN
DELTA(ITOUT)= ERRBIAS+OUTPUT(ITOUT)-1.
ELSE
DELTA(ITOUT)=-ERRBIAS
+ +OUTPUT(ITOUT)-(OUTDES(ITOUT,MUE)/REAL(BITACC))
END IF
END IF
C------- different for E = ln (1 -deltasq)
C---- note: not activated to speed up!!
Csleep IF (ERRTYPE(1:12).EQ.'LN_1-DELTASQ') THEN
DIFF= 1 - ( DELTA(ITOUT)*DELTA(ITOUT) )
C IF (ABS(DIFF).LT.10E-8) THEN
IF (ABS(DIFF).LT.ABW) THEN
DELTA(ITOUT)=1.
ELSE
DELTA(ITOUT)=DELTA(ITOUT)/DIFF
END IF
Csleep END IF
C------- final factors
FACDELTA(ITOUT)=
+ DELTA(ITOUT) * OUTPUT(ITOUT)*(1.-(OUTPUT(ITOUT)))
C------- setting FACDELTA to zero, if below threshold ABW
C IF (ABS(FACDELTA(ITOUT)).LT.10E-10) THEN
IF (ABS(FACDELTA(ITOUT)).LT.ABW) THEN
FACDELTA(ITOUT)=0.
END IF
END DO
C---- end of prefactors for output units
C---- ------------------------------------------------------------------
C---- changes for last layer
C----
C---- i=1,numout; k=1,numhid+1
C---- DJ2(k,i)=-1 * epsilon * FACDELTA(i) * OUTHID(k)
C---- + alpha * previousDJ2(k,i)
C---- ------------------------------------------------------------------
DO ITOUT=1,NUMOUT
RHELP=(-1) * EPSILON * FACDELTA(ITOUT)
DO ITHID=1,(NUMHID+1)
C---------- momentum
IF ( (ALPHA.GT.0).AND.
+ (ABS(PDJCT2ND(ITHID,ITOUT)).GT.ABW)) THEN
DJCT2ND(ITHID,ITOUT)=RHELP*OUTHID(ITHID)
+ + ALPHA*PDJCT2ND(ITHID,ITOUT)
ELSE
DJCT2ND(ITHID,ITOUT)=RHELP*OUTHID(ITHID)
END IF
END DO
END DO
C---- ------------------------------------------------------------------
C---- changes for first layer
C----
C---- k=1,numhid; m=1,numin+1
C---- DJ1(m,k)=-1 * epsilon * J2(k,i) * FACDELTA(i)
C---- * OUTHID(k) * (1-OUTHID(k)) * INPUT(m)
C---- + alpha * previousDJ1(k,m)
C----
C----
C---- ------------------------------------------------------------------
DO ITHID=1,NUMHID
VECSUM=0.
DO ITOUT=1,NUMOUT
IF (FACDELTA(ITOUT).NE.0.) THEN
VECSUM=VECSUM+(JCT2ND(ITHID,ITOUT)*FACDELTA(ITOUT))
END IF
END DO
VECSUM=VECSUM*(-1)*EPSILON*OUTHID(ITHID)*(1.-OUTHID(ITHID))
DO ITIN=1,(NUMIN+1)
C---------- momentum
IF ( (ALPHA.GT.0).AND.
+ (ABS(PDJCT1ST(ITIN,ITHID)).GT.ABW)) THEN
DJCT1ST(ITIN,ITHID)=
+ VECSUM*(INPUT(ITIN,MUE)/REAL(BITACC))
+ + ALPHA*PDJCT1ST(ITIN,ITHID)
ELSE
DJCT1ST(ITIN,ITHID)=
+ VECSUM*(INPUT(ITIN,MUE)/REAL(BITACC))
END IF
END DO
END DO
C---- ------------------------------
C---- update junctions for MUE
C---- ------------------------------
C first layer
DO ITHID=1,NUMHID
DO ITIN=1,(NUMIN+1)
IF (ABS(DJCT1ST(ITIN,ITHID)).GT.ABW) THEN
JCT1ST(ITIN,ITHID)=
+ JCT1ST(ITIN,ITHID)+DJCT1ST(ITIN,ITHID)
END IF
END DO
END DO
C second layer
DO ITOUT=1,NUMOUT
DO ITHID=1,(NUMHID+1)
IF (ABS(DJCT1ST(ITHID,ITOUT)).GT.ABW) THEN
JCT2ND(ITHID,ITOUT)=
+ JCT2ND(ITHID,ITOUT)+DJCT2ND(ITHID,ITOUT)
END IF
END DO
END DO
C---- ------------------------------------------------------------------
C---- end of back-propagation for SAMPLE MUE
C---- ------------------------------------------------------------------
END
***** end of TRAIN_BACKPROP
***** ------------------------------------------------------------------
***** SUB TRAIN_INIMUE
***** ------------------------------------------------------------------
C----
C---- NAME : TRAIN_INIMUE
C---- ARG : MUE
C---- DES : initialises DJ1, DJ2,
C---- IN :
C---- FROM : TRAIN
C---- CALL2:
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* CUBIC/LION http://cubic.bioc.columbia.edu *
* Columbia University rost@columbia.edu *
* changed: June, 1998 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE TRAIN_INIMUE(MUE)
C---- global parameters and variables
INCLUDE 'profPar.f'
C---- local variables *
INTEGER MUE
******------------------------------*-----------------------------******
C---- setting previous changes to olddel
IF ((ALPHA.GT.0).AND.((EPSILON/ALPHA).LE.10)) THEN
CALL SRSTE2(PDJCT1ST,DJCT1ST,(NUMIN_MAX+1),NUMHID_MAX)
CALL SRSTE2(PDJCT2ND,DJCT1ST,(NUMHID_MAX+1),NUMOUT_MAX)
END IF
C---- setting deltaJ to 0
IF (STPNOW.GT.1) THEN
CALL SRSTZ2(DJCT1ST,(NUMIN_MAX+1),NUMHID_MAX)
CALL SRSTZ2(DJCT1ST,(NUMHID_MAX+1),NUMOUT_MAX)
END IF
C---- call trigger
CALL NETOUT_MUE(MUE)
END
***** end of TRAIN_INIMUE
***** ------------------------------------------------------------------
***** SUB TRAIN_INISWP
***** ------------------------------------------------------------------
C----
C---- NAME : TRAIN_INISWP
C---- ARG : CTMP
C---- DES :
C---- IN :
C---- FROM :
C---- CALL2:
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* CUBIC/LION http://cubic.bioc.columbia.edu *
* Columbia University rost@columbia.edu *
* changed: June, 1998 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE TRAIN_INISWP(CTMP)
C---- global parameters and variables
INCLUDE 'profPar.f'
C---- local variables *
CHARACTER*80 CTMP
******------------------------------*-----------------------------******
C---- for first step set deltaJ and previous deltaJ to zero
IF (STPNOW.EQ.0) THEN
CALL SRSTZ2(PDJCT1ST,(NUMIN_MAX+1),NUMHID_MAX)
CALL SRSTZ2(PDJCT2ND,(NUMHID_MAX+1),NUMOUT_MAX)
CALL SRSTZ2(DJCT1ST,(NUMIN_MAX+1),NUMHID_MAX)
CALL SRSTZ2(DJCT1ST,(NUMHID_MAX+1),NUMOUT_MAX)
WRITE(6,'(A15,A)')CTMP,'First cycle PDJ, DJ: all set to zero'
END IF
C---- count up
STPNOW= STPNOW+1
STPINFNOW= STPINFNOW+1
C---- count up STPSWPNOW ?
IF (STPSWPNOW*NUMSAM .LE. STPNOW) THEN
STPSWPNOW=STPSWPNOW+1
END IF
END
***** end of TRAIN_INISWP
***** ------------------------------------------------------------------
***** SUB TRAIN_STOP(LSTOP,STPLOC,CTMP)
***** ------------------------------------------------------------------
C----
C---- NAME : TRAIN_STOP(LSTOP,STPLOC,CTMP)
C---- ARG :
C---- DES : checks whether stop condition reached
C---- IN :
C---- FROM : TRAIN
C---- CALL2:
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* CUBIC/LION http://cubic.bioc.columbia.edu *
* Columbia University rost@columbia.edu *
* changed: June, 1998 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE TRAIN_STOP(LSTOP,STPLOC,CTMP)
C---- global parameters and variables
INCLUDE 'profPar.f'
C---- local variables
INTEGER STPLOC,ITER
CHARACTER*80 CTMP
LOGICAL LSTOP
******------------------------------*-----------------------------******
LSTOP=.FALSE.
IF ( (ERR(STPINFCNT).LE.ERRSTOP).OR.
+ (ERRBIN(STPINFCNT).LE.ERRBINSTOP) ) THEN
WRITE(6,'(A15)')CTMP
WRITE(6,'(A15,60A1)')CTMP,('-',ITER=1,60)
WRITE(6,'(A15,A,I8)')CTMP,
+ 'stop condition reached in stpinfcnt=',STPINFCNT
IF (ERR(STPINFCNT).LE.ERRSTOP) THEN
WRITE(6,'(A15,A,F10.4,A,F10.4)')CTMP,
+ 'REAL ERROR:',ERR(STPINFCNT),' < ',ERRSTOP
ELSE
WRITE(6,'(A15,A,F8.2,A,F8.2)')CTMP,
+ 'BIN ERROR:',ERRBIN(STPINFCNT),' < ',ERRBINSTOP
END IF
WRITE(6,'(A15,A6,A2,I8,A,A2,F10.4,A,F10.4)')CTMP,
+ 'STP ',': ',STPLOC, ' ERR ',': ',ERR(STPINFCNT),
+ ' ERRSTOP :',ERRSTOP
WRITE(6,'(A15,A6,A2,I8,A,A2,F8.2,A,F8.2)')CTMP,
+ 'STPINF',': ',STPINFCNT,' ERRBIN',': ',ERRBIN(STPINFCNT),
+ ' ERRBINSTOP:',ERRBINSTOP
LSTOP=.TRUE.
END IF
END
***** end of TRAIN_STOP
***** ------------------------------------------------------------------
***** SUB TRAIN_WRT(CTMP,STPINFLOC,STPLOC,STPMAX,STPSWPNOW,STPSWPMAX)
***** ------------------------------------------------------------------
C----
C---- NAME : TRAIN_WRT(CTMP,STPINF,STPNOW,STPMAX,STPSWPNOW,STPSWPMAX)
C---- ARG :
C---- DES : write current accuracy onto screen
C---- IN : CTMP begin of line to write
C---- IN : STPINF number of times all information about accuracy
C---- IN : has been written so far (including current step)
C---- IN : STPNOW current step
C---- IN : STPMAX maximal number of steps allowed (then stop!)
C---- IN : STPSWPNOW number of sweeps (one sweep = once through
C---- IN : ALL patterns)
C---- IN : STPSWPMAX maximal number of sweeps allowed (then stop!)
C---- IN :
C---- FROM : TRAIN
C---- CALL2:
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* CUBIC/LION http://cubic.bioc.columbia.edu *
* Columbia University rost@columbia.edu *
* changed: June, 1998 version 0.2 *
* changed: Aug, 1998 version 1.0 *
* changed: Sep, 1999 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE TRAIN_WRT(CTMP,STPINFLOC,STPLOC)
C---- global parameters and variables
INCLUDE 'profPar.f'
C---- local variables
INTEGER STPINFLOC,STPLOC,STPINFMAXLOC,
+ STPSWPNOWLOC,STPSWPMAXLOC
CHARACTER*(*) CTMP
******------------------------------*-----------------------------******
C----
C---- current accuracy (err,errbin, asf)
C----
WRITE(6,'(A15,A)')CTMP,'--------------------'
WRITE(6,'(A15,A)')CTMP,'accuracy: '
C WRITE(6,'(A15,4(A,I8))')CTMP,
C + 'STPSWP',STPSWPNOWLOC,' max=',STPSWPMAXLOC,
C + 'STPINF',STPINFLOC,' max=',STPMAXLOC
WRITE(6,'(A15,A6,A2,I8,A,A2,F10.4)')CTMP,
+ 'STP ',': ',STPLOC, ' ERR ',': ',ERR(STPINFLOC)
WRITE(6,'(A15,A6,A2,I8,A,A2,F8.2)')CTMP,
+ 'STPINF',': ',STPINFLOC,' ERRBIN',': ',ERRBIN(STPINFLOC)
END
***** end of TRAIN_WRT
***** ------------------------------------------------------------------
***** SUB WRTJCT(KUNIT,FILE)
***** ------------------------------------------------------------------
C----
C---- NAME : WRTJCT(KUNIT,FILE)
C---- ARG :
C---- DES : writes the current architecture
C---- IN :
C---- FROM : MAIN
C---- CALL2: WRTHEAD
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* CUBIC/LION http://cubic.bioc.columbia.edu *
* Columbia University rost@columbia.edu *
* changed: June, 1998 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE WRTJCT(KUNIT,FILE)
C---- include parameter files
INCLUDE 'profPar.f'
C---- local function
INTEGER FILEN_STRING
C---- local variables
INTEGER ITIN,ITHID,ITOUT,KUNIT
CHARACTER*(*) FILE
******------------------------------*-----------------------------******
C---- open file
IF (KUNIT.NE.6) THEN
CALL SFILEOPEN(KUNIT,FILE,'UNKNOWN',456,' ')
END IF
C----
C---- header tag
C----
WRITE(KUNIT,'(A2,A20,A)')'* ',
+ 'PROFout_jct ',
+ 'file from FORTRAN PROF.f (junctions)'
C----
C---- header blabla
C----
CALL WRTHEAD(KUNIT)
C----
C---- header numbers
C----
WRITE(KUNIT,'(A2,A)')'* ','--------------------'
WRITE(KUNIT,'(A2,A)')'* ','overall: (A,T25,I8)'
WRITE(KUNIT,'(A,A2,T25,I8)')'NUMIN',': ',NUMIN
WRITE(KUNIT,'(A,A2,T25,I8)')'NUMHID',': ',NUMHID
WRITE(KUNIT,'(A,A2,T25,I8)')'NUMOUT',': ',NUMOUT
C----
WRITE(KUNIT,'(A,A2,T25,A)')
+ 'MODEPRED',': ',MODEPRED(1:FILEN_STRING(MODEPRED))
WRITE(KUNIT,'(A,A2,T25,A)')
+ 'MODENET',': ', MODENET(1:FILEN_STRING(MODENET))
WRITE(KUNIT,'(A,A2,T25,A)')
+ 'MODEJOB',': ', MODEJOB(1:FILEN_STRING(MODEJOB))
WRITE(KUNIT,'(A,A2,T25,A)')
+ 'MODEIN',': ', MODEIN(1:FILEN_STRING(MODEIN))
WRITE(KUNIT,'(A,A2,T25,A)')
+ 'MODEOUT',': ', MODEOUT(1:FILEN_STRING(MODEOUT))
C----
C---- 1st layer
C----
WRITE(KUNIT,'(A2,A)')'* ','--------------------'
WRITE(KUNIT,'(A2,A)')'* ',
+ 'jct 1st layer: row=numhid (10F10.4), col=(numin+1)'
C jct1st
DO ITHID=1,NUMHID
WRITE(KUNIT,'(10F10.4)')
+ (JCT1ST(ITIN,ITHID),ITIN=1,(NUMIN+1))
END DO
C----
C---- 2nd layer
C----
WRITE(KUNIT,'(A2,A)')'* ','--------------------'
WRITE(KUNIT,'(A2,A)')'* ',
+ 'jct 2nd layer: row=numhid+1 (10F10.4), col=numout'
C jct2nd
DO ITHID=1,(NUMHID+1)
WRITE(KUNIT,'(10F10.4)')(JCT2ND(ITHID,ITOUT),ITOUT=1,NUMOUT)
END DO
C----
C---- control end
C----
IF (KUNIT.NE.6) THEN
WRITE(KUNIT,'(A2)')'//'
CLOSE(KUNIT)
END IF
END
***** end of WRTJCT
***** ------------------------------------------------------------------
***** SUB WRTOUT(KUNIT,FILE,STPINFLOC,STPLOC)
***** ------------------------------------------------------------------
C----
C---- NAME : WRTOUT(KUNIT,FILE,STPINFLOC,STPLOC)
C---- ARG :
C---- DES : writes the input vectors read
C---- IN :
C---- FROM : TRAIN, MAIN
C---- CALL2: WRTHEAD, NETOUT_MUE
C---- LIB : SFILEOPEN
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* CUBIC/LION http://cubic.bioc.columbia.edu *
* Columbia University rost@columbia.edu *
* changed: June, 1998 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE WRTOUT(KUNIT,FILE,STPINFLOC,STPLOC)
C---- include parameter files
INCLUDE 'profPar.f'
C---- local function
INTEGER FILEN_STRING
C---- local variables
INTEGER ITSAM,ITOUT,KUNIT,STPINFLOC,STPLOC,KUNITX
CHARACTER*(*) FILE
CHARACTER*80 CTMP
LOGICAL LOGI_WRTFILE
******------------------------------*-----------------------------******
LOGI_WRTFILE= .TRUE.
KUNITX= KUNIT
C----
C---- write to screen if FILE='none'
C----
IF (FILE(1:4).EQ.'none'.OR.FILE(1:4).EQ.'NONE') THEN
LOGI_WRTFILE= .FALSE.
KUNITX=6
END IF
C---- open file
IF (KUNITX.NE.6) THEN
OPEN(KUNITX,FILE=FILE(1:FILEN_STRING(FILE)))
END IF
CTMP='--- WRTOUT: '
C----
C---- header tag
C----
IF (LOGI_WRTFILE .EQV. .TRUE. ) THEN
WRITE(KUNITX,'(A2,A20,A)')'* ',
+ 'PROFout_out ',
+ 'file from FORTRAN PROF.f (output)'
ELSE
WRITE(KUNITX,'(A2,A)')'* ',
+ 'Copyright: Burkhard Rost rost@columbia.edu'
WRITE(KUNITX,'(A2,A)')'* ','NEURAL NETWORK output syntax: '
WRITE(KUNITX,'(A2,A,A)')'* ',
+ 'residue_number(I8) SPACE(A1) output values (100I4)'
END IF
C----
C---- header blabla
C----
IF (LOGI_WRTFILE) THEN
CALL WRTHEAD(KUNITX)
END IF
C----
C---- header numbers
C----
IF (LOGI_WRTFILE) THEN
WRITE(KUNITX,'(A2,A)')'* ','--------------------'
WRITE(KUNITX,'(A2,A)')'* ','overall: (A,T25,I8)'
WRITE(KUNITX,'(A,A2,T25,I8)')'NUMOUT', ': ',NUMOUT
WRITE(KUNITX,'(A,A2,T25,I8)')'NUMSAM', ': ',NUMSAM
C----
WRITE(KUNITX,'(A,A2,T25,A)')
+ 'MODEPRED',': ',MODEPRED(1:FILEN_STRING(MODEPRED))
WRITE(KUNITX,'(A,A2,T25,A)')
+ 'MODENET',': ',MODENET(1:FILEN_STRING(MODENET))
WRITE(KUNITX,'(A,A2,T25,A)')
+ 'MODEIN',': ',MODEIN(1:FILEN_STRING(MODEIN))
WRITE(KUNITX,'(A,A2,T25,A)')
+ 'MODEJOB',': ',MODEJOB(1:FILEN_STRING(MODEJOB))
C----
C---- current accuracy (err,errbin, asf)
C----
WRITE(KUNITX,'(A2,A)')'* ','--------------------'
WRITE(KUNITX,'(A2,A)')'* ','accuracy: (A,T25,I8)'
WRITE(KUNITX,'(A,A2,T25,I8)') 'STPINF',': ',STPINFLOC
WRITE(KUNITX,'(A,A2,T25,I8)') 'STP', ': ',STPLOC
WRITE(KUNITX,'(A,A2,T25,F8.4)')'ERRBIN',': ',ERRBIN(STPINFLOC)
WRITE(KUNITX,'(A,A2,T25,F8.4)')'ERR', ': ',ERR(STPINFLOC)
C----
C---- output vectors
C----
WRITE(KUNITX,'(A2,A)')'* ','--------------------'
WRITE(KUNITX,'(A2,A)')'* ','out vec: (I8,A1,100I4)'
END IF
C---- yy tmp beg
C IF (KUNITX.NE.6) THEN
C WRITE(6,'(A15,A8,10(I2,A3,A3))')CTMP,'yy mue',
C + (ITOUT,'o ',' d',ITOUT=1,NUMOUT)
C END IF
C---- yy tmp end
DO ITSAM=1,NUMSAM
CALL NETOUT_MUE(ITSAM)
WRITE(KUNITX,'(I8,A1,100I4)')ITSAM,' ',
+ (INT(BITACC*OUTPUT(ITOUT)),ITOUT=1,NUMOUT)
C---- yy tmp beg
C WRITE(6,'(A15,I8,10(I4,I4))')CTMP,ITSAM,
C + (INT(BITACC*OUTPUT(ITOUT)),OUTDES(ITOUT,ITSAM),
C + ITOUT=1,NUMOUT)
C---- yy tmp end
END DO
IF (KUNITX.NE.6) THEN
CLOSE(KUNITX)
END IF
END
***** end of WRTOUT
***** ------------------------------------------------------------------
***** SUB WRTERR
***** ------------------------------------------------------------------
C----
C---- NAME : WRTERR
C---- ARG : KUNIT,FILE,STPTMP
C---- DES : writes the history of the error propagation
C---- IN : unit, file-to-write, last step
C---- FROM : MAIN, WRTSCR
C---- CALL2:
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* CUBIC/LION http://cubic.bioc.columbia.edu *
* Columbia University rost@columbia.edu *
* changed: June, 1998 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE WRTERR(KUNIT,FILE,STPTMP)
C---- include parameter files
INCLUDE 'profPar.f'
C---- local variables *
INTEGER IT,KUNIT,STPTMP
CHARACTER*(*) FILE
CHARACTER XC,CTAB
******------------------------------*-----------------------------******
C---- spacer
CTAB=CHAR(9)
XC=CTAB
C---- open file
IF (KUNIT.NE.6) THEN
CALL SFILEOPEN(KUNIT,FILE,'UNKNOWN',456,' ')
END IF
C----
C---- header
IF (KUNIT.NE.6) THEN
C---- header tag
WRITE(KUNIT,'(A)')'# Perl-RDB'
WRITE(KUNIT,'(A2,A,T25,A)')'# ',
+ 'PROFout_err','file from FORTRAN PROF.f (error)'
C---- number of steps executed
WRITE(KUNIT,'(A2,A,T25,I5)')'# ','PARA: STPINF =',STPTMP
END IF
C---- names
WRITE(KUNIT,'(A5,A,A8,A,A8,A,A8)')
+ 'NO',XC,'STEP',XC,'ERROR',XC,'ERRBIN'
C---- formats
IF (KUNIT.NE.6) THEN
WRITE(KUNIT,'(A5,A,A8,A,A8,A,A8)')
+ '5N',XC,'8N',XC,'8.4F',XC,'8.4F'
END IF
C----
C---- data (history of error)
C----
IF (STPTMP.EQ.0) THEN
WRITE(KUNIT,'(I5,A,I8,A,F8.4,A,F8.4)')
+ 0,XC,(0),XC,ERR(0),XC,ERRBIN(0)
ELSE
DO IT=1,STPTMP
WRITE(KUNIT,'(I5,A,I8,A,F8.4,A,F8.4)')
+ IT,XC,(IT*STPINF),XC,ERR(IT),XC,ERRBIN(IT)
END DO
END IF
IF (KUNIT.NE.6) THEN
CLOSE(KUNIT)
END IF
END
***** end of WRTERR
***** ------------------------------------------------------------------
***** SUB WRTHEAD
***** ------------------------------------------------------------------
C----
C---- NAME : WRTHEAD
C---- ARG : KUNIT
C---- DES : write header for files
C---- IN :
C---- FROM : MAIN, WRTOUT, WRTJCT, WRTSCREEN
C---- CALL2:
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* CUBIC/LION http://cubic.bioc.columbia.edu *
* Columbia University rost@columbia.edu *
* changed: June, 1998 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE WRTHEAD(KUNIT)
C---- include parameter files
INCLUDE 'profPar.f'
C---- local variables *
INTEGER KUNIT
******------------------------------*-----------------------------******
* *
C general information (address asf)
CALL WRTHEAD_GEN(KUNIT)
C specific information
CALL WRTHEAD_JOB(KUNIT)
END
***** end of WRTHEAD
***** ------------------------------------------------------------------
***** SUB WRTHEAD_GEN
***** ------------------------------------------------------------------
C----
C---- NAME : WRTHEAD_GEN
C---- ARG : KUNIT
C---- DES : writes address asf onto KUNIT
C---- IN :
C---- FROM : WRTHEAD
C---- CALL2:
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* CUBIC/LION http://cubic.bioc.columbia.edu *
* Columbia University rost@columbia.edu *
* changed: June, 1998 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE WRTHEAD_GEN(KUNIT)
C---- local function
C---- local variables
INTEGER KUNIT
CHARACTER*80 CTMP
******------------------------------*-----------------------------******
CTMP='* '
C header
WRITE(KUNIT,'(A5)')CTMP
C title
WRITE(KUNIT,'(A5,A)')CTMP,'-------------------------------'
WRITE(KUNIT,'(A5,A)')CTMP,'Output from neural network (PROF)'
WRITE(KUNIT,'(A5,A)')CTMP,'-------------------------------'
WRITE(KUNIT,'(A5,A)')CTMP,' '
C address
WRITE(KUNIT,'(A5,A)')CTMP,
+ 'author: Burkhard Rost, Columbia Univ NYC / LION Heidelberg'
WRITE(KUNIT,'(A5,A)')CTMP,'fax: +1-212-305-7932'
WRITE(KUNIT,'(A5,A)')CTMP,'email: rost@columbia.edu'
WRITE(KUNIT,'(A5,A)')CTMP,
+ 'www: http://cubic.bioc.columbia.edu/'
WRITE(KUNIT,'(A5,A)')CTMP,' '
WRITE(KUNIT,'(A5,A)')CTMP,'All rights reserved.'
WRITE(KUNIT,'(A5,A)')CTMP,' '
C date
C WRITE(KUNIT,'(A5,A7,A24)')CTMP,'date: ',FDATE()
WRITE(KUNIT,'(A5,A7,A24)')CTMP,'date: ',''
WRITE(KUNIT,'(A5)')CTMP
END
***** end of WRTHEAD_GEN
***** ------------------------------------------------------------------
***** SUB WRTHEAD_JOB
***** ------------------------------------------------------------------
C----
C---- NAME : WRTHEAD_JOB
C---- ARG : KUNIT
C---- DES : writes specific details about current job
C---- IN :
C---- FROM : WRTHEAD
C---- CALL2:
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* CUBIC/LION http://cubic.bioc.columbia.edu *
* Columbia University rost@columbia.edu *
* changed: June, 1998 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE WRTHEAD_JOB(KUNIT)
C---- include parameter files
INCLUDE 'profPar.f'
C---- local function
INTEGER FILEN_STRING
C---- local variables
INTEGER KUNIT
CHARACTER*80 CTMP
******------------------------------*-----------------------------******
CTMP='* '
WRITE(KUNIT,'(A5)')CTMP
C modes
WRITE(KUNIT,'(A5,A,T35,A)')CTMP,
+ 'MODEPRED',MODEPRED(1:FILEN_STRING(MODEPRED))
WRITE(KUNIT,'(A5,A,T35,A)')CTMP,
+ 'MODENET',MODENET(1:FILEN_STRING(MODENET))
WRITE(KUNIT,'(A5,A,T35,A)')CTMP,
+ 'MODEIN',MODEIN(1:FILEN_STRING(MODEIN))
WRITE(KUNIT,'(A5,A,T35,A)')CTMP,
+ 'MODEJOB',MODEJOB(1:FILEN_STRING(MODEJOB))
C training, trigger, and error type
WRITE(KUNIT,'(A5,A,T35,3(A10,A1))')CTMP,'TRN-, TRG-, ERRTYPE',
+ TRNTYPE(1:FILEN_STRING(TRNTYPE)),',',
+ TRGTYPE(1:FILEN_STRING(TRGTYPE)),',',
+ ERRTYPE(1:FILEN_STRING(ERRTYPE)),' '
C architecture
WRITE(KUNIT,'(A5,A,T35,3(I8,A1))')CTMP,'NUMIN, -HID, -OUT',
+ NUMIN,',',NUMHID,',',NUMOUT,' '
C samples asf
WRITE(KUNIT,'(A5,A,T35,I8)')CTMP,'NUMSAM',NUMSAM
WRITE(KUNIT,'(A5,A,T35,3(I8,A1))')CTMP,'STPSWPMAX, -MAX, -INF',
+ STPSWPMAX,',',STPMAX,',',STPINF,' '
WRITE(KUNIT,'(A5,A,T35,I8,A1,F8.4)')CTMP,'ERRBINSTOP, -STOP',
+ ERRBINSTOP,',',ERRSTOP
C training
WRITE(KUNIT,'(A5,A,T35,3(F8.4,A1))')CTMP,'EPSILON, ALPHA, TEMP',
+ EPSILON,',',ALPHA,',',TEMPERATURE,' '
WRITE(KUNIT,'(A5)')CTMP
END
***** end of WRTHEAD_JOB
***** ------------------------------------------------------------------
***** SUB WRTSCR
***** ------------------------------------------------------------------
C----
C---- NAME : WRTSCR
C---- ARG : STPTMP
C---- DES : writes control output onto screen
C---- IN : last step
C---- FROM : MAIN
C---- CALL2:
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* CUBIC/LION http://cubic.bioc.columbia.edu *
* Columbia University rost@columbia.edu *
* changed: June, 1998 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE WRTSCR(STPTMP)
C---- include parameter files
INCLUDE 'profPar.f'
C---- params
INTEGER STPTMP
C---- local function
INTEGER FILEN_STRING
C---- local variables
INTEGER IT
CHARACTER*80 CTMP,CTMP2
******------------------------------*-----------------------------******
CTMP= '--- WRTscr: '
CTMP2='--------------------------------------------------'
WRITE(6,'(A15,A50)') CTMP,CTMP2
WRITE(6,'(A15)') CTMP
WRITE(6,'(A15,A)') CTMP,'Final results of PROF'
WRITE(6,'(A15,A)') CTMP,'-------------------'
WRITE(6,'(A15)') CTMP
C WRITE(6,'(A15,A24)') CTMP,FDATE()
WRITE(6,'(A15,A24)') CTMP,''
WRITE(6,'(A15)') CTMP
C----
C---- header numbers
C----
WRITE(6,'(A15,A)') CTMP,'--------------------'
WRITE(6,'(A15,A)') CTMP,'overall: (A,T25,I8)'
WRITE(6,'(A15,A,T35,I8)') CTMP,'NUMIN', NUMIN
WRITE(6,'(A15,A,T35,I8)') CTMP,'NUMHID', NUMHID
WRITE(6,'(A15,A,T35,I8)') CTMP,'NUMOUT', NUMOUT
WRITE(6,'(A15,A,T35,I8)') CTMP,'NUMSAM', NUMSAM
WRITE(6,'(A15)') CTMP
C----
WRITE(6,'(A15,A,T35,I8)') CTMP,'STPSWPMAX',STPSWPMAX
WRITE(6,'(A15,A,T35,I8)') CTMP,'STPMAX', STPMAX
WRITE(6,'(A15,A,T35,I8)') CTMP,'STPINF', STPINF
WRITE(6,'(A15)') CTMP
C----
C---- reals
C----
WRITE(6,'(A15,A)') CTMP,' '
WRITE(6,'(A15,A,T35,F15.6)')CTMP,'EPSILON', EPSILON
WRITE(6,'(A15,A,T35,F15.6)')CTMP,'ALPHA', ALPHA
WRITE(6,'(A15,A,T35,F15.6)')CTMP,'TEMPERATURE',TEMPERATURE
WRITE(6,'(A15)') CTMP
C----
WRITE(6,'(A15,A,T35,I8)') CTMP,'ERRBINSTOP', ERRBINSTOP
WRITE(6,'(A15,A,T35,F15.6)')CTMP,'ERRSTOP', ERRSTOP
WRITE(6,'(A15)') CTMP
C----
C---- characters
C----
WRITE(6,'(A15,A)') CTMP,' '
WRITE(6,'(A15,A,T35,A)') CTMP,'TRNTYPE',
+ TRNTYPE(1:FILEN_STRING(TRNTYPE))
WRITE(6,'(A15,A,T35,A)') CTMP,'TRGTYPE',
+ TRGTYPE(1:FILEN_STRING(TRGTYPE))
WRITE(6,'(A15,A,T35,A)') CTMP,'ERRTYPE',
+ ERRTYPE(1:FILEN_STRING(ERRTYPE))
WRITE(6,'(A15)') CTMP
WRITE(6,'(A15,A,T35,A)') CTMP,'MODEPRED',
+ MODEPRED(1:FILEN_STRING(MODEPRED))
WRITE(6,'(A15,A,T35,A)') CTMP,'MODENET',
+ MODENET(1:FILEN_STRING(MODENET))
WRITE(6,'(A15,A,T35,A)') CTMP,'MODEIN',
+ MODEIN(1:FILEN_STRING(MODEIN))
WRITE(6,'(A15,A,T35,A)') CTMP,'MODEJOB',
+ MODEJOB(1:FILEN_STRING(MODEJOB))
C----
C---- files
C----
DO IT=1,NUMFILEIN_IN
WRITE(6,'(A15,A,T30,I4,A1,A)')CTMP,'FILEIN_IN',IT,' ',
+ FILEIN_IN(IT)(1:FILEN_STRING(FILEIN_IN(IT)))
END DO
DO IT=1,NUMFILEIN_OUT
WRITE(6,'(A15,A,T30,I4,A1,A)')CTMP,'FILEIN_OUT',IT,' ',
+ FILEIN_OUT(IT)(1:FILEN_STRING(FILEIN_OUT(IT)))
END DO
WRITE(6,'(A15,A,T35,A)')CTMP,
+ 'FILEIN_JCT',FILEIN_JCT(1:FILEN_STRING(FILEOUT_JCT))
C DO IT=1,NUMFILEOUT_OUT
DO IT=1,STPTMP
WRITE(6,'(A15,A,T30,I4,A1,A)')CTMP,'FILEOUT_OUT',IT,' ',
+ FILEOUT_OUT(IT)(1:FILEN_STRING(FILEOUT_OUT(IT)))
END DO
C DO IT=1,NUMFILEOUT_JCT
DO IT=1,STPTMP
WRITE(6,'(A15,A,T30,I4,A1,A)')CTMP,'FILEOUT_JCT',IT,' ',
+ FILEOUT_JCT(IT)(1:FILEN_STRING(FILEOUT_JCT(IT)))
END DO
WRITE(6,'(A15,A,T35)')CTMP,'end of reading parameters'
C----
C---- error history
C----
CALL WRTERR(6,'STDOUT',STPTMP)
C----
C---- current accuracy (err,errbin, asf)
C----
WRITE(6,'(A15,A)') CTMP,'--------------------'
WRITE(6,'(A15,A)') CTMP,'accuracy: '
WRITE(6,'(A15,A6,A2,I8,A,A2,F8.4)')CTMP,
+ 'STP ',': ',STPNOW, ' ERR ',': ',ERR(STPINFCNT)
WRITE(6,'(A15,A6,A2,I8,A,A2,F8.4)')CTMP,
+ 'STPINF',': ',STPINFCNT,' ERRBIN',': ',ERRBIN(STPINFCNT)
C----
WRITE(6,'(A15)') CTMP
WRITE(6,'(A15,A50)') CTMP,CTMP2
END
***** end of WRTSCR
***** ------------------------------------------------------------------
***** SUB WRTYEAH
***** ------------------------------------------------------------------
C----
C---- NAME : WRTYEAH
C---- ARG : KUNIT,FILE
C---- DES : writes specific details about current job
C---- IN :
C---- FROM : MAIN
C---- CALL2:
C----
*----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* CUBIC/LION http://cubic.bioc.columbia.edu *
* Columbia University rost@columbia.edu *
* changed: June, 1998 version 0.2 *
* changed: Aug, 1998 version 1.0 *
*----------------------------------------------------------------------*
SUBROUTINE WRTYEAH(KUNIT,FILE)
C---- include parameter files
INCLUDE 'profPar.f'
C---- local function
INTEGER FILEN_STRING
C---- local variables
INTEGER KUNIT
CHARACTER*(*) FILE
CHARACTER*80 CTMP
******------------------------------*-----------------------------******
C---- open file
IF (KUNIT.NE.6) THEN
CALL SFILEOPEN(KUNIT,FILE,'UNKNOWN',456,' ')
END IF
C---- write
CTMP='--- WRTYEAH '
WRITE(KUNIT,'(A5)')CTMP
WRITE(KUNIT,'(A,T16,A)')CTMP,'everything seems fine! HAPPY??'
C---- close file
IF (KUNIT.NE.6) THEN
CLOSE(KUNIT)
END IF
END
***** end of WRTYEAH
C---- vim:et:
profnet-1.0.22/src/profPar.f 0000644 0150751 0150751 00000021655 12021362711 015122 0 ustar lkajan lkajan *----------------------------------------------------------------------*
* Burkhard Rost May, 1998 version 0.1 *
* EMBL/LION http://www.embl-heidelberg.de/~rost/ *
* D-69012 Heidelberg rost@embl-heidelberg.de *
* changed: June, 1998 version 0.2 *
*----------------------------------------------------------------------*
***** ------------------------------------------------------------------
***** nnPar.f
***** ------------------------------------------------------------------
* This file contains the parameters and variables for a particular *
* run of program nn.f *
C---- ------------------------------------------------------------------
IMPLICIT NONE
C---- ------------------------------------------------------------------
C---- PARAMETERS
C---- ------------------------------------------------------------------
C---- number of command line arguments
INTEGER NUMARG_MAX
C---- architecture of network
INTEGER NUMIN_MAX,NUMOUT_MAX,NUMHID_MAX
C---- I/O-vectors (maximal number of sam)
INTEGER NUMSAM_MAX
C---- error-back-propagation steps
INTEGER STPSWPMAX_MAX,STPMAX_MAX
C---- number of input/output files
INTEGER NUMFILES_MAX
*---- ------------------------------------------------- *
C G M T
C lkajan: Tune these to the particular network in question - understand
C lkajan: what it needs.
C lkajan: The below numbers are the values used by prof as in
C lkajan: prof{sec,acc}:
PARAMETER (NUMIN_MAX= 800)
C lkajan: The below number of 10000 is suitable for a method that
C lkajan: presents a sample for each amino acids of a protein because
C lkajan: we do not encounter a protein longer than 10000AA very often.
PARAMETER (NUMSAM_MAX= 10000)
PARAMETER (NUMHID_MAX= 100)
PARAMETER (NUMOUT_MAX= 10)
PARAMETER (NUMFILES_MAX= 2)
PARAMETER (STPSWPMAX_MAX= 5)
C lkajan: STPMAX_MAX somehow controls the number of input vectors that can
C lkajan: be evaluated in one go. There is a simple integer array that gets
C lkajan: allocated to STPMAX_MAX size.
PARAMETER (STPMAX_MAX= 5)
PARAMETER (NUMARG_MAX= 500)
C G M T
*---- ------------------------------------------------- *
C---- tab
C CHARACTER CTAB
C PARAMETER (CTAB=CHAR(9))
C---- ------------------------------------------------------------------
C---- CONSTANTS
C---- ------------------------------------------------------------------
C---- architecture
INTEGER NUMLAYERS,NUMIN,NUMOUT,NUMHID,JCT_MAX,BITACC
C---- back-propagation
INTEGER STPSWPMAX,STPMAX,STPINF,ERRBINSTOP
REAL TEMPERATURE,EPSILON,ALPHA,
+ ERRBIAS,DICEITRVL,ERRSTOP,ERRBINACC
CHARACTER*456 TRNTYPE,ERRTYPE,TRGTYPE
C---- data handling
INTEGER DICESEED,DICESEED1,DICESEED_ADDJCT,DICESEED_ADDTRN
REAL ABW,INVABW,NEGINVABW,MAXCPUTIME,TIMEOUT
C---- input/output
LOGICAL LOGI_RDPAR,LOGI_RDIN,LOGI_RDOUT,LOGI_SCREEN,
+ LOGI_RDPARWRT,LOGI_RDINWRT,LOGI_RDOUTWRT,
+ LOGI_RDJCTWRT,LOGI_TMPWRTOUT,LOGI_TMPWRTJB
C---- general
LOGICAL LOGI_TRANSLATE(0:1)
C for information, only!
CHARACTER*80 MODEPRED,MODENET,MODEIN,MODEOUT,MODEJOB
*---- ------------------------------------------------- *
COMMON /CON_ARCH/NUMLAYERS,NUMIN,NUMOUT,NUMHID,JCT_MAX,BITACC
COMMON /CON_PROP1/TEMPERATURE,EPSILON,ALPHA,
+ ERRBIAS,DICEITRVL,ERRSTOP,ERRBINACC
COMMON /CON_PROP2/TRNTYPE,ERRTYPE,TRGTYPE
COMMON /CON_PROP3/STPSWPMAX,STPMAX,STPINF,ERRBINSTOP
COMMON /CON_DATA1/DICESEED,DICESEED1,
+ DICESEED_ADDJCT,DICESEED_ADDTRN
COMMON /CON_DATA2/ABW,INVABW,NEGINVABW,MAXCPUTIME,TIMEOUT
COMMON /CON_IO1/LOGI_RDPAR,LOGI_RDIN,LOGI_RDOUT,LOGI_SCREEN,
+ LOGI_RDPARWRT,LOGI_RDINWRT,LOGI_RDOUTWRT,
+ LOGI_RDJCTWRT,LOGI_TMPWRTOUT,LOGI_TMPWRTJB
COMMON /CON_GEN1/LOGI_TRANSLATE
COMMON /CON_GEN2/MODEPRED,MODENET,MODEIN,MODEOUT,MODEJOB
C---- ------------------------------------------------------------------
C---- VARIABLES
C---- ------------------------------------------------------------------
C---- main program
INTEGER LENPATH_ARCH
CHARACTER*456 PATH_ARCH
COMMON /MAIN1/LENPATH_ARCH
COMMON /MAIN2/PATH_ARCH
C---- managing command line input
INTEGER NUMARGUMENTS
CHARACTER*456 PASSED_ARGC(1:NUMARG_MAX)
LOGICAL LOGI_INTERACTIVE,LOGI_SWITCH,LOGI_DEBUG
COMMON /INUMARGC/PASSED_ARGC
COMMON /INUMARGI/NUMARGUMENTS
COMMON /INUMARGL/LOGI_INTERACTIVE,LOGI_SWITCH,LOGI_DEBUG
C---- input files
INTEGER NUMFILEIN_IN,NUMFILEIN_OUT
CHARACTER*456 FILEIN_PAR,FILEIN_JCT,FILEIN_SAM,
+ FILEIN_IN(1:NUMFILES_MAX),FILEIN_OUT(1:NUMFILES_MAX)
C---- output files
INTEGER NUMFILEOUT_JCT,NUMFILEOUT_OUT
CHARACTER*456 FILEOUT_OUT(1:NUMFILES_MAX),
+ FILEOUT_JCT(1:NUMFILES_MAX),
+ FILEOUT_ERR,FILEOUT_YEAH
COMMON /FILE1/FILEIN_PAR,FILEIN_IN,FILEIN_OUT,FILEIN_JCT,
+ FILEIN_SAM,FILEOUT_OUT,FILEOUT_JCT,
+ FILEOUT_ERR,FILEOUT_YEAH
COMMON /FILE2/NUMFILEIN_IN,NUMFILEIN_OUT,
+ NUMFILEOUT_JCT,NUMFILEOUT_OUT
*---- ------------------------------------------------- *
C---- input vectors
INTEGER NUMSAM,NUMSAMFILE,MAXINPUT,POSWIN
INTEGER*2 INPUT(1:(NUMIN_MAX+1),1:NUMSAM_MAX),
+ OUTDES(1:NUMOUT_MAX,1:NUMSAM_MAX),
+ OUTWIN(1:NUMSAM_MAX)
REAL*4 OUTPUT(1:NUMOUT_MAX)
COMMON /INVEC1/NUMSAM,NUMSAMFILE,MAXINPUT,POSWIN
COMMON /INVEC2/INPUT,OUTDES,OUTWIN
COMMON /INVEC3/OUTPUT
*---- ------------------------------------------------- *
C---- junctions
C---- for NUMLAYERS=1
C REAL JCT1ST(1:(NUMIN_MAX+1),1:NUMOUT_MAX),
C + DJCT1ST(1:(NUMIN_MAX+1),1:NUMOUT_MAX),
C + PDJCT1ST(1:(NUMIN_MAX+1),1:NUMOUT_MAX),
C + FLD1ST(1:NUMOUT_MAX)
C---- for NUMLAYERS=2
REAL JCT1ST(1:(NUMIN_MAX+1),1:NUMHID_MAX),
+ DJCT1ST(1:(NUMIN_MAX+1),1:NUMHID_MAX),
+ PDJCT1ST(1:(NUMIN_MAX+1),1:NUMHID_MAX),
+ FLD1ST(1:NUMHID_MAX)
REAL OUTHID(1:(NUMHID_MAX+1)),
+ JCT2ND(1:(NUMHID_MAX+1),1:NUMOUT_MAX),
+ DJCT2ND(1:(NUMHID_MAX+1),1:NUMOUT_MAX),
+ PDJCT2ND(1:(NUMHID_MAX+1),1:NUMOUT_MAX),
+ FLD2ND(1:NUMOUT_MAX)
COMMON /ARCHJ/JCT1ST,DJCT1ST,PDJCT1ST,FLD1ST,OUTHID,
+ JCT2ND,DJCT2ND,PDJCT2ND,FLD2ND
*---- ------------------------------------------------- *
C---- back-propagation
INTEGER STPSWPNOW,STPNOW,STPINFNOW,STPINFCNT,
+ PICKSAM(1:STPMAX_MAX),OKBIN(0:(STPSWPMAX_MAX+1))
REAL ERR(0:(STPSWPMAX_MAX+1)),
+ ERRBIN(0:(STPSWPMAX_MAX+1))
COMMON /PROP4/STPSWPNOW,STPNOW,STPINFNOW,STPINFCNT,PICKSAM,OKBIN
COMMON /PROP5/ERR,ERRBIN
*---- ------------------------------------------------- *
C---- interpretations
REAL THRESHOUT
COMMON /MEANING1/THRESHOUT
*---- ------------------------------------------------- *
C---- time
CHARACTER*24 STARTDATE,ENDDATE
CHARACTER*8 STARTTIME,ENDTIME
REAL TIMEDIFF,TIMEARRAY,TIMESTART,TIMERUN,TIMEEND
LOGICAL TIMEFLAG
COMMON /CLOCK1/STARTDATE,ENDDATE,STARTTIME,ENDTIME
COMMON /CLOCK2/TIMEARRAY,TIMEDIFF,TIMESTART,TIMERUN,TIMEEND
COMMON /CLOCK3/TIMEFLAG
* *
*---- ------------------------------------------------- *
C---- garbage variables in order to spare memory space (eqUIVALENCE..)
LOGICAL GARBAGEFLAG(1:(NUMSAM_MAX+100))
COMMON /FLAG1/GARBAGEFLAG
C---- ------------------------------------------------------------------
***** end of nnPar
profnet-1.0.22/src/tmp.f 0000644 0150751 0150751 00000000575 12021362711 014307 0 ustar lkajan lkajan program tmp
character*24 actdate,fdate
INTEGER DATE_TIME
character*10 big(3)
C ACTDATE=FDATE()
ACTDATE=''
write(6,*)'xx act=',actdate
call DATE_and_time(big(1),big(2),big(3),date_time)
write(6,*)'xx 1=',big(1)
write(6,*)'xx 2=',big(2)
write(6,*)'xx 3=',big(3)
write(6,*)'xx d=',date_time
end
profnet-1.0.22/AUTHORS 0000644 0150751 0150751 00000001054 12021362710 013611 0 ustar lkajan lkajan Authors:
Burkhard Rost
Bug fixes and enhancements by Laszlo Kajan and Guy Yachdav
Copyright:
Copyright 1998-2011 by Burkhard Rost EMBL, CUBIC (Columbia University, NY, USA) and LION Biosciences (Heidelberg, DE)
Copyright 2009-2011 by Laszlo Kajan Technical University Munich (Munich, DE)
Copyright 2009-2011 by Guy Yachdav CUBIC (Columbia University, NY, USA) and Technical University Munich (Munich, DE)
profnet-1.0.22/COPYING 0000644 0150751 0150751 00000104513 12021362710 013600 0 ustar lkajan lkajan GNU GENERAL PUBLIC LICENSE
Version 3, 29 June 2007
Copyright (C) 2007 Free Software Foundation, Inc.
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
The GNU General Public License is a free, copyleft license for
software and other kinds of works.
The licenses for most software and other practical works are designed
to take away your freedom to share and change the works. By contrast,
the GNU General Public License is intended to guarantee your freedom to
share and change all versions of a program--to make sure it remains free
software for all its users. We, the Free Software Foundation, use the
GNU General Public License for most of our software; it applies also to
any other work released this way by its authors. You can apply it to
your programs, too.
When we speak of free software, we are referring to freedom, not
price. Our General Public Licenses are designed to make sure that you
have the freedom to distribute copies of free software (and charge for
them if you wish), that you receive source code or can get it if you
want it, that you can change the software or use pieces of it in new
free programs, and that you know you can do these things.
To protect your rights, we need to prevent others from denying you
these rights or asking you to surrender the rights. Therefore, you have
certain responsibilities if you distribute copies of the software, or if
you modify it: responsibilities to respect the freedom of others.
For example, if you distribute copies of such a program, whether
gratis or for a fee, you must pass on to the recipients the same
freedoms that you received. You must make sure that they, too, receive
or can get the source code. And you must show them these terms so they
know their rights.
Developers that use the GNU GPL protect your rights with two steps:
(1) assert copyright on the software, and (2) offer you this License
giving you legal permission to copy, distribute and/or modify it.
For the developers' and authors' protection, the GPL clearly explains
that there is no warranty for this free software. For both users' and
authors' sake, the GPL requires that modified versions be marked as
changed, so that their problems will not be attributed erroneously to
authors of previous versions.
Some devices are designed to deny users access to install or run
modified versions of the software inside them, although the manufacturer
can do so. This is fundamentally incompatible with the aim of
protecting users' freedom to change the software. The systematic
pattern of such abuse occurs in the area of products for individuals to
use, which is precisely where it is most unacceptable. Therefore, we
have designed this version of the GPL to prohibit the practice for those
products. If such problems arise substantially in other domains, we
stand ready to extend this provision to those domains in future versions
of the GPL, as needed to protect the freedom of users.
Finally, every program is threatened constantly by software patents.
States should not allow patents to restrict development and use of
software on general-purpose computers, but in those that do, we wish to
avoid the special danger that patents applied to a free program could
make it effectively proprietary. To prevent this, the GPL assures that
patents cannot be used to render the program non-free.
The precise terms and conditions for copying, distribution and
modification follow.
TERMS AND CONDITIONS
0. Definitions.
"This License" refers to version 3 of the GNU General Public License.
"Copyright" also means copyright-like laws that apply to other kinds of
works, such as semiconductor masks.
"The Program" refers to any copyrightable work licensed under this
License. Each licensee is addressed as "you". "Licensees" and
"recipients" may be individuals or organizations.
To "modify" a work means to copy from or adapt all or part of the work
in a fashion requiring copyright permission, other than the making of an
exact copy. The resulting work is called a "modified version" of the
earlier work or a work "based on" the earlier work.
A "covered work" means either the unmodified Program or a work based
on the Program.
To "propagate" a work means to do anything with it that, without
permission, would make you directly or secondarily liable for
infringement under applicable copyright law, except executing it on a
computer or modifying a private copy. Propagation includes copying,
distribution (with or without modification), making available to the
public, and in some countries other activities as well.
To "convey" a work means any kind of propagation that enables other
parties to make or receive copies. Mere interaction with a user through
a computer network, with no transfer of a copy, is not conveying.
An interactive user interface displays "Appropriate Legal Notices"
to the extent that it includes a convenient and prominently visible
feature that (1) displays an appropriate copyright notice, and (2)
tells the user that there is no warranty for the work (except to the
extent that warranties are provided), that licensees may convey the
work under this License, and how to view a copy of this License. If
the interface presents a list of user commands or options, such as a
menu, a prominent item in the list meets this criterion.
1. Source Code.
The "source code" for a work means the preferred form of the work
for making modifications to it. "Object code" means any non-source
form of a work.
A "Standard Interface" means an interface that either is an official
standard defined by a recognized standards body, or, in the case of
interfaces specified for a particular programming language, one that
is widely used among developers working in that language.
The "System Libraries" of an executable work include anything, other
than the work as a whole, that (a) is included in the normal form of
packaging a Major Component, but which is not part of that Major
Component, and (b) serves only to enable use of the work with that
Major Component, or to implement a Standard Interface for which an
implementation is available to the public in source code form. A
"Major Component", in this context, means a major essential component
(kernel, window system, and so on) of the specific operating system
(if any) on which the executable work runs, or a compiler used to
produce the work, or an object code interpreter used to run it.
The "Corresponding Source" for a work in object code form means all
the source code needed to generate, install, and (for an executable
work) run the object code and to modify the work, including scripts to
control those activities. However, it does not include the work's
System Libraries, or general-purpose tools or generally available free
programs which are used unmodified in performing those activities but
which are not part of the work. For example, Corresponding Source
includes interface definition files associated with source files for
the work, and the source code for shared libraries and dynamically
linked subprograms that the work is specifically designed to require,
such as by intimate data communication or control flow between those
subprograms and other parts of the work.
The Corresponding Source need not include anything that users
can regenerate automatically from other parts of the Corresponding
Source.
The Corresponding Source for a work in source code form is that
same work.
2. Basic Permissions.
All rights granted under this License are granted for the term of
copyright on the Program, and are irrevocable provided the stated
conditions are met. This License explicitly affirms your unlimited
permission to run the unmodified Program. The output from running a
covered work is covered by this License only if the output, given its
content, constitutes a covered work. This License acknowledges your
rights of fair use or other equivalent, as provided by copyright law.
You may make, run and propagate covered works that you do not
convey, without conditions so long as your license otherwise remains
in force. You may convey covered works to others for the sole purpose
of having them make modifications exclusively for you, or provide you
with facilities for running those works, provided that you comply with
the terms of this License in conveying all material for which you do
not control copyright. Those thus making or running the covered works
for you must do so exclusively on your behalf, under your direction
and control, on terms that prohibit them from making any copies of
your copyrighted material outside their relationship with you.
Conveying under any other circumstances is permitted solely under
the conditions stated below. Sublicensing is not allowed; section 10
makes it unnecessary.
3. Protecting Users' Legal Rights From Anti-Circumvention Law.
No covered work shall be deemed part of an effective technological
measure under any applicable law fulfilling obligations under article
11 of the WIPO copyright treaty adopted on 20 December 1996, or
similar laws prohibiting or restricting circumvention of such
measures.
When you convey a covered work, you waive any legal power to forbid
circumvention of technological measures to the extent such circumvention
is effected by exercising rights under this License with respect to
the covered work, and you disclaim any intention to limit operation or
modification of the work as a means of enforcing, against the work's
users, your or third parties' legal rights to forbid circumvention of
technological measures.
4. Conveying Verbatim Copies.
You may convey verbatim copies of the Program's source code as you
receive it, in any medium, provided that you conspicuously and
appropriately publish on each copy an appropriate copyright notice;
keep intact all notices stating that this License and any
non-permissive terms added in accord with section 7 apply to the code;
keep intact all notices of the absence of any warranty; and give all
recipients a copy of this License along with the Program.
You may charge any price or no price for each copy that you convey,
and you may offer support or warranty protection for a fee.
5. Conveying Modified Source Versions.
You may convey a work based on the Program, or the modifications to
produce it from the Program, in the form of source code under the
terms of section 4, provided that you also meet all of these conditions:
a) The work must carry prominent notices stating that you modified
it, and giving a relevant date.
b) The work must carry prominent notices stating that it is
released under this License and any conditions added under section
7. This requirement modifies the requirement in section 4 to
"keep intact all notices".
c) You must license the entire work, as a whole, under this
License to anyone who comes into possession of a copy. This
License will therefore apply, along with any applicable section 7
additional terms, to the whole of the work, and all its parts,
regardless of how they are packaged. This License gives no
permission to license the work in any other way, but it does not
invalidate such permission if you have separately received it.
d) If the work has interactive user interfaces, each must display
Appropriate Legal Notices; however, if the Program has interactive
interfaces that do not display Appropriate Legal Notices, your
work need not make them do so.
A compilation of a covered work with other separate and independent
works, which are not by their nature extensions of the covered work,
and which are not combined with it such as to form a larger program,
in or on a volume of a storage or distribution medium, is called an
"aggregate" if the compilation and its resulting copyright are not
used to limit the access or legal rights of the compilation's users
beyond what the individual works permit. Inclusion of a covered work
in an aggregate does not cause this License to apply to the other
parts of the aggregate.
6. Conveying Non-Source Forms.
You may convey a covered work in object code form under the terms
of sections 4 and 5, provided that you also convey the
machine-readable Corresponding Source under the terms of this License,
in one of these ways:
a) Convey the object code in, or embodied in, a physical product
(including a physical distribution medium), accompanied by the
Corresponding Source fixed on a durable physical medium
customarily used for software interchange.
b) Convey the object code in, or embodied in, a physical product
(including a physical distribution medium), accompanied by a
written offer, valid for at least three years and valid for as
long as you offer spare parts or customer support for that product
model, to give anyone who possesses the object code either (1) a
copy of the Corresponding Source for all the software in the
product that is covered by this License, on a durable physical
medium customarily used for software interchange, for a price no
more than your reasonable cost of physically performing this
conveying of source, or (2) access to copy the
Corresponding Source from a network server at no charge.
c) Convey individual copies of the object code with a copy of the
written offer to provide the Corresponding Source. This
alternative is allowed only occasionally and noncommercially, and
only if you received the object code with such an offer, in accord
with subsection 6b.
d) Convey the object code by offering access from a designated
place (gratis or for a charge), and offer equivalent access to the
Corresponding Source in the same way through the same place at no
further charge. You need not require recipients to copy the
Corresponding Source along with the object code. If the place to
copy the object code is a network server, the Corresponding Source
may be on a different server (operated by you or a third party)
that supports equivalent copying facilities, provided you maintain
clear directions next to the object code saying where to find the
Corresponding Source. Regardless of what server hosts the
Corresponding Source, you remain obligated to ensure that it is
available for as long as needed to satisfy these requirements.
e) Convey the object code using peer-to-peer transmission, provided
you inform other peers where the object code and Corresponding
Source of the work are being offered to the general public at no
charge under subsection 6d.
A separable portion of the object code, whose source code is excluded
from the Corresponding Source as a System Library, need not be
included in conveying the object code work.
A "User Product" is either (1) a "consumer product", which means any
tangible personal property which is normally used for personal, family,
or household purposes, or (2) anything designed or sold for incorporation
into a dwelling. In determining whether a product is a consumer product,
doubtful cases shall be resolved in favor of coverage. For a particular
product received by a particular user, "normally used" refers to a
typical or common use of that class of product, regardless of the status
of the particular user or of the way in which the particular user
actually uses, or expects or is expected to use, the product. A product
is a consumer product regardless of whether the product has substantial
commercial, industrial or non-consumer uses, unless such uses represent
the only significant mode of use of the product.
"Installation Information" for a User Product means any methods,
procedures, authorization keys, or other information required to install
and execute modified versions of a covered work in that User Product from
a modified version of its Corresponding Source. The information must
suffice to ensure that the continued functioning of the modified object
code is in no case prevented or interfered with solely because
modification has been made.
If you convey an object code work under this section in, or with, or
specifically for use in, a User Product, and the conveying occurs as
part of a transaction in which the right of possession and use of the
User Product is transferred to the recipient in perpetuity or for a
fixed term (regardless of how the transaction is characterized), the
Corresponding Source conveyed under this section must be accompanied
by the Installation Information. But this requirement does not apply
if neither you nor any third party retains the ability to install
modified object code on the User Product (for example, the work has
been installed in ROM).
The requirement to provide Installation Information does not include a
requirement to continue to provide support service, warranty, or updates
for a work that has been modified or installed by the recipient, or for
the User Product in which it has been modified or installed. Access to a
network may be denied when the modification itself materially and
adversely affects the operation of the network or violates the rules and
protocols for communication across the network.
Corresponding Source conveyed, and Installation Information provided,
in accord with this section must be in a format that is publicly
documented (and with an implementation available to the public in
source code form), and must require no special password or key for
unpacking, reading or copying.
7. Additional Terms.
"Additional permissions" are terms that supplement the terms of this
License by making exceptions from one or more of its conditions.
Additional permissions that are applicable to the entire Program shall
be treated as though they were included in this License, to the extent
that they are valid under applicable law. If additional permissions
apply only to part of the Program, that part may be used separately
under those permissions, but the entire Program remains governed by
this License without regard to the additional permissions.
When you convey a copy of a covered work, you may at your option
remove any additional permissions from that copy, or from any part of
it. (Additional permissions may be written to require their own
removal in certain cases when you modify the work.) You may place
additional permissions on material, added by you to a covered work,
for which you have or can give appropriate copyright permission.
Notwithstanding any other provision of this License, for material you
add to a covered work, you may (if authorized by the copyright holders of
that material) supplement the terms of this License with terms:
a) Disclaiming warranty or limiting liability differently from the
terms of sections 15 and 16 of this License; or
b) Requiring preservation of specified reasonable legal notices or
author attributions in that material or in the Appropriate Legal
Notices displayed by works containing it; or
c) Prohibiting misrepresentation of the origin of that material, or
requiring that modified versions of such material be marked in
reasonable ways as different from the original version; or
d) Limiting the use for publicity purposes of names of licensors or
authors of the material; or
e) Declining to grant rights under trademark law for use of some
trade names, trademarks, or service marks; or
f) Requiring indemnification of licensors and authors of that
material by anyone who conveys the material (or modified versions of
it) with contractual assumptions of liability to the recipient, for
any liability that these contractual assumptions directly impose on
those licensors and authors.
All other non-permissive additional terms are considered "further
restrictions" within the meaning of section 10. If the Program as you
received it, or any part of it, contains a notice stating that it is
governed by this License along with a term that is a further
restriction, you may remove that term. If a license document contains
a further restriction but permits relicensing or conveying under this
License, you may add to a covered work material governed by the terms
of that license document, provided that the further restriction does
not survive such relicensing or conveying.
If you add terms to a covered work in accord with this section, you
must place, in the relevant source files, a statement of the
additional terms that apply to those files, or a notice indicating
where to find the applicable terms.
Additional terms, permissive or non-permissive, may be stated in the
form of a separately written license, or stated as exceptions;
the above requirements apply either way.
8. Termination.
You may not propagate or modify a covered work except as expressly
provided under this License. Any attempt otherwise to propagate or
modify it is void, and will automatically terminate your rights under
this License (including any patent licenses granted under the third
paragraph of section 11).
However, if you cease all violation of this License, then your
license from a particular copyright holder is reinstated (a)
provisionally, unless and until the copyright holder explicitly and
finally terminates your license, and (b) permanently, if the copyright
holder fails to notify you of the violation by some reasonable means
prior to 60 days after the cessation.
Moreover, your license from a particular copyright holder is
reinstated permanently if the copyright holder notifies you of the
violation by some reasonable means, this is the first time you have
received notice of violation of this License (for any work) from that
copyright holder, and you cure the violation prior to 30 days after
your receipt of the notice.
Termination of your rights under this section does not terminate the
licenses of parties who have received copies or rights from you under
this License. If your rights have been terminated and not permanently
reinstated, you do not qualify to receive new licenses for the same
material under section 10.
9. Acceptance Not Required for Having Copies.
You are not required to accept this License in order to receive or
run a copy of the Program. Ancillary propagation of a covered work
occurring solely as a consequence of using peer-to-peer transmission
to receive a copy likewise does not require acceptance. However,
nothing other than this License grants you permission to propagate or
modify any covered work. These actions infringe copyright if you do
not accept this License. Therefore, by modifying or propagating a
covered work, you indicate your acceptance of this License to do so.
10. Automatic Licensing of Downstream Recipients.
Each time you convey a covered work, the recipient automatically
receives a license from the original licensors, to run, modify and
propagate that work, subject to this License. You are not responsible
for enforcing compliance by third parties with this License.
An "entity transaction" is a transaction transferring control of an
organization, or substantially all assets of one, or subdividing an
organization, or merging organizations. If propagation of a covered
work results from an entity transaction, each party to that
transaction who receives a copy of the work also receives whatever
licenses to the work the party's predecessor in interest had or could
give under the previous paragraph, plus a right to possession of the
Corresponding Source of the work from the predecessor in interest, if
the predecessor has it or can get it with reasonable efforts.
You may not impose any further restrictions on the exercise of the
rights granted or affirmed under this License. For example, you may
not impose a license fee, royalty, or other charge for exercise of
rights granted under this License, and you may not initiate litigation
(including a cross-claim or counterclaim in a lawsuit) alleging that
any patent claim is infringed by making, using, selling, offering for
sale, or importing the Program or any portion of it.
11. Patents.
A "contributor" is a copyright holder who authorizes use under this
License of the Program or a work on which the Program is based. The
work thus licensed is called the contributor's "contributor version".
A contributor's "essential patent claims" are all patent claims
owned or controlled by the contributor, whether already acquired or
hereafter acquired, that would be infringed by some manner, permitted
by this License, of making, using, or selling its contributor version,
but do not include claims that would be infringed only as a
consequence of further modification of the contributor version. For
purposes of this definition, "control" includes the right to grant
patent sublicenses in a manner consistent with the requirements of
this License.
Each contributor grants you a non-exclusive, worldwide, royalty-free
patent license under the contributor's essential patent claims, to
make, use, sell, offer for sale, import and otherwise run, modify and
propagate the contents of its contributor version.
In the following three paragraphs, a "patent license" is any express
agreement or commitment, however denominated, not to enforce a patent
(such as an express permission to practice a patent or covenant not to
sue for patent infringement). To "grant" such a patent license to a
party means to make such an agreement or commitment not to enforce a
patent against the party.
If you convey a covered work, knowingly relying on a patent license,
and the Corresponding Source of the work is not available for anyone
to copy, free of charge and under the terms of this License, through a
publicly available network server or other readily accessible means,
then you must either (1) cause the Corresponding Source to be so
available, or (2) arrange to deprive yourself of the benefit of the
patent license for this particular work, or (3) arrange, in a manner
consistent with the requirements of this License, to extend the patent
license to downstream recipients. "Knowingly relying" means you have
actual knowledge that, but for the patent license, your conveying the
covered work in a country, or your recipient's use of the covered work
in a country, would infringe one or more identifiable patents in that
country that you have reason to believe are valid.
If, pursuant to or in connection with a single transaction or
arrangement, you convey, or propagate by procuring conveyance of, a
covered work, and grant a patent license to some of the parties
receiving the covered work authorizing them to use, propagate, modify
or convey a specific copy of the covered work, then the patent license
you grant is automatically extended to all recipients of the covered
work and works based on it.
A patent license is "discriminatory" if it does not include within
the scope of its coverage, prohibits the exercise of, or is
conditioned on the non-exercise of one or more of the rights that are
specifically granted under this License. You may not convey a covered
work if you are a party to an arrangement with a third party that is
in the business of distributing software, under which you make payment
to the third party based on the extent of your activity of conveying
the work, and under which the third party grants, to any of the
parties who would receive the covered work from you, a discriminatory
patent license (a) in connection with copies of the covered work
conveyed by you (or copies made from those copies), or (b) primarily
for and in connection with specific products or compilations that
contain the covered work, unless you entered into that arrangement,
or that patent license was granted, prior to 28 March 2007.
Nothing in this License shall be construed as excluding or limiting
any implied license or other defenses to infringement that may
otherwise be available to you under applicable patent law.
12. No Surrender of Others' Freedom.
If conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License. If you cannot convey a
covered work so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you may
not convey it at all. For example, if you agree to terms that obligate you
to collect a royalty for further conveying from those to whom you convey
the Program, the only way you could satisfy both those terms and this
License would be to refrain entirely from conveying the Program.
13. Use with the GNU Affero General Public License.
Notwithstanding any other provision of this License, you have
permission to link or combine any covered work with a work licensed
under version 3 of the GNU Affero General Public License into a single
combined work, and to convey the resulting work. The terms of this
License will continue to apply to the part which is the covered work,
but the special requirements of the GNU Affero General Public License,
section 13, concerning interaction through a network will apply to the
combination as such.
14. Revised Versions of this License.
The Free Software Foundation may publish revised and/or new versions of
the GNU General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
Each version is given a distinguishing version number. If the
Program specifies that a certain numbered version of the GNU General
Public License "or any later version" applies to it, you have the
option of following the terms and conditions either of that numbered
version or of any later version published by the Free Software
Foundation. If the Program does not specify a version number of the
GNU General Public License, you may choose any version ever published
by the Free Software Foundation.
If the Program specifies that a proxy can decide which future
versions of the GNU General Public License can be used, that proxy's
public statement of acceptance of a version permanently authorizes you
to choose that version for the Program.
Later license versions may give you additional or different
permissions. However, no additional obligations are imposed on any
author or copyright holder as a result of your choosing to follow a
later version.
15. Disclaimer of Warranty.
THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
16. Limitation of Liability.
IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
SUCH DAMAGES.
17. Interpretation of Sections 15 and 16.
If the disclaimer of warranty and limitation of liability provided
above cannot be given local legal effect according to their terms,
reviewing courts shall apply local law that most closely approximates
an absolute waiver of all civil liability in connection with the
Program, unless a warranty or assumption of liability accompanies a
copy of the Program in return for a fee.
END OF TERMS AND CONDITIONS
How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to the public, the best way to achieve this is to make it
free software which everyone can redistribute and change under these terms.
To do so, attach the following notices to the program. It is safest
to attach them to the start of each source file to most effectively
state the exclusion of warranty; and each file should have at least
the "copyright" line and a pointer to where the full notice is found.
Copyright (C)
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see .
Also add information on how to contact you by electronic and paper mail.
If the program does terminal interaction, make it output a short
notice like this when it starts in an interactive mode:
Copyright (C)
This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the appropriate
parts of the General Public License. Of course, your program's commands
might be different; for a GUI interface, you would use an "about box".
You should also get your employer (if you work as a programmer) or school,
if any, to sign a "copyright disclaimer" for the program, if necessary.
For more information on this, and how to apply and follow the GNU GPL, see
.
The GNU General Public License does not permit incorporating your program
into proprietary programs. If your program is a subroutine library, you
may consider it more useful to permit linking proprietary applications with
the library. If this is what you want to do, use the GNU Lesser General
Public License instead of this License. But first, please read
.
profnet-1.0.22/ChangeLog 0000644 0150751 0150751 00000007570 12021415647 014334 0 ustar lkajan lkajan profnet (1.0.22) unstable; urgency=low
* Removed -fbounds-check from all Makefiles in order to fix the 'Actual
string length is shorter than the declared one' issue.
-- Laszlo Kajan Tue, 04 Sep 2012 14:06:13 +0200
profnet (1.0.21) unstable; urgency=low
* fixed ERRBINSTOP REAL issue
-- Laszlo Kajan Tue, 21 Jun 2011 16:14:12 +0200
profnet (1.0.20)
* enhanced man page
* added GPL v3 as COPYING
* fixed unused LOGIUNK issue
* removed -Werror gfortran argument
* fixed INTEGER(4) to INTEGER(2) warnings, mostly with INT2() conversion
-- Laszlo Kajan Tue, 14 Jun 2011 12:49:12 +0200
profnet (1.0.19)
* added profnet_chop
-- Laszlo Kajan Wed, 12 May 2010 19:57:07 +0200
profnet (1.0.18)
* corrected NUMIN-comment for norsnet
* added metadisorder (MD)
-- Laszlo Kajan Wed, 17 Mar 2010 14:50:50 +0100
profnet (1.0.17)
* added profnet_isis
-- Laszlo Kajan Fri, 26 Feb 2010 11:23:20 +0100
profnet (1.0.16)
* added 'patch' target
* added profnet_con network for profcon
-- Laszlo Kajan Tue, 23 Feb 2010 10:51:46 +0100
profnet (1.0.15)
* prof for norsnet is the same as for bval - there should be only one. Now at least both are the same here.
-- Laszlo Kajan Wed, 17 Feb 2010 11:41:07 +0100
profnet (1.0.14)
* Burkhard recommended to change RDATE to a simple empty (initialized) string ''
-- Laszlo Kajan Thu, 11 Feb 2010 12:25:05 +0100
profnet (1.0.13)
* Increased STPMAX_MAX to 100000 for profnet_snapfun
* Corrected FDATE calls for phd
* Removed src-phd/mat
* Replaced uninitialized string FDATE with call to FDATE() funtion
-- Laszlo Kajan Wed, 10 Feb 2010 13:21:15 +0100
profnet (1.0.12)
* added phd1994 man page
* initialized variables instead of -finit-local-zero
-- Laszlo Kajan Tue, 05 Jan 2010 18:04:58 +0100
profnet (1.0.11)
* norsnet added
* prof added (profsec, profacc). Notably phd is a different source unrelated to this set.
* many updates incorporated from profphd's prof_nn sources
* renamed sources nn* to prof*
-- Laszlo Kajan Fri, 18 Dec 2009 13:56:10 +0100
profnet (1.0.10)
* profnet_bval magic understood: broken code that checked if NUMIN was
<= NUMIN_MAX allowed Avner to get away with loading 209 input nodes
to a space for 194
* NUMIN_MAX bug fixed in common source but that fix breaks profbval so
that one is still made with required bug in place. Attempts to get
profbval perform with the fixed code failed, a retraining of the
network is recommended.
-- Laszlo Kajan Thu, 17 Dec 2009 18:14:45 +0100
profnet (1.0.8)
* snap -> snapfun (Yana suggested new name)
-- Laszlo Kajan Thu, 10 Dec 2009 14:20:29 +0100
profnet (1.0.7)
* added profnet_snap
-- Guy Yachdav Thu, 10 Dec 2009 09:04:30 +0100
profnet (1.0.5)
* commited new version of source files that make profnet produce the correct predictions
-- Guy Yachdav Tue, 08 Dec 2009 16:12:16 +0100
profnet (1.0.4)
* commited new version of source files that make profnet produce the correct predictions
-- Guy Yachdav Tue, 08 Dec 2009 16:12:16 +0100
profnet (1.0.3)
* man page change to include command line options.
-- Guy Yachdav Wed, 02 Dec 2009 11:58:14 +0100
profnet (1.0.2)
* man page change to include command line options.
-- Guy Yachdav Sun, 29 Nov 2009 18:14:50 +0100
profnet (1.0.1)
* Compiles cleanly
-- Guy Yachdav Mon, 30 Nov 2009 16:00:19 +0100
profnet (1.0.0)
* Initial version.
-- Guy Yachdav Sun, 29 Nov 2009 18:14:50 +0100
profnet-1.0.22/Makefile 0000644 0150751 0150751 00000007352 12021367476 014226 0 ustar lkajan lkajan PACKAGE := profnet
VERSION := 1.0.22
DISTDIR := $(PACKAGE)-$(VERSION)
SRCDIR := src
NET := bval chop con isis md norsnet prof snapfun
NETDIR := $(addsuffix _dir,$(NET))
NETDIFF := $(addprefix diff-,$(NET))
NETPATCH := $(NET:%=%_dir/patch_stamp)
NETPATCHNEW := $(addsuffix .patch.new,$(NET))
NETDISTCLEAN := $(addprefix distclean-,$(NET))
NETINSTALL := $(addprefix install-,$(NET))
MAN1POD := profnet.pod
MAN1GZ := $(MAN1POD:%.pod=%.1.gz)
all: net man phd
net: $(NET)
diff: $(NETDIFF)
$(NETDIFF) : diff-% : %.patch.new
$(NETPATCHNEW): %.patch.new :
if [ -d $*_dir ]; then \
diff -ruN -x '.*.swp' -x 'profnet*' -x .svn src $*_dir > $@ || true; \
fi
$(NETDIR) : %_dir :
mkdir -p $@ && rsync -avC src/. ./$@/.
%_dir/patch_stamp: | %_dir
patch -p 1 -E -d $*_dir < $*.patch && touch $@
patch: $(NETPATCH)
$(NET) : % : | %_dir/patch_stamp
$(MAKE) -C $@_dir
$(NETINSTALL) : install-% :
mkdir -p $(DESTDIR)$(prefix)/bin && \
cp -a $*_dir/profnet_$* \
$(DESTDIR)$(prefix)/bin/
mkdir -p $(DESTDIR)$(prefix)/share/man/man1 && cp $(MAN1GZ) $(DESTDIR)$(prefix)/share/man/man1/profnet_$*.1.gz
phd:
$(MAKE) -C src-phd
install-phd:
$(MAKE) -C src-phd install
mkdir -p $(DESTDIR)$(prefix)/share/man/man1 && cp $(MAN1GZ) $(DESTDIR)$(prefix)/share/man/man1/profphd_net.1.gz
rm -f $(DESTDIR)$(prefix)/share/man/man1/phd1994.1.gz && ln -s profphd_net.1.gz $(DESTDIR)$(prefix)/share/man/man1/phd1994.1.gz
install: $(NETINSTALL) install-phd
man: $(MAN1GZ) $(MAN3:%.pod=%.3.gz)
$(MAN1GZ) : %.1.gz : %.pod
pod2man -c 'User Commands' -r "$(VERSION)-$(RGVERSION)" $< | gzip -c > $@
help:
@echo "Rules:"
@echo "all* - build all"
@echo "net - make all network binaries"
@echo "$(NET) -"
@echo " make a specific network binary"
@echo "diff - prepare patch files for profnet varieties"
@echo "$(NETDIFF) -"
@echo " make a specific network variety patch"
@echo " A diff is run between the src dir - the base network - and the"
@echo " variety given. This prepares a patch file with .patch.new extension"
@echo " that can me renamed to .patch. Network varieties are obtained by"
@echo " applying the appropriate .patch file to the base network in src."
@echo " Importantly only these patch files are distributed with this package,"
@echo " the network variety directories (e.g. snapfun_dir) are used only for"
@echo " building the binary. Preserve your updates to the base version"
@echo " by preparing and updating the appropriate patch file."
@echo "$(NETDISTCLEAN) -"
@echo " distclean a specific network variety"
@echo "clean"
@echo "dist"
@echo "distclean"
@echo "man - make all manual pages"
@echo "install - install all"
@echo "$(NETINSTALL) -"
@echo " install a specific variety to \$$DESTDIR\$$prefix"
@echo "install-phd - install profphd_net"
@echo "patch - patch and prepare all for compilation"
@echo "phd - make profphd_net"
@echo
@echo "Variables:"
@echo " Meaning and purpose not clear any more."
@echo "DESTDIR - install to DESTDIR"
@echo "prefix - common installation prefix for all files"
@echo " use prefix=$$HOME to build for personal use"
distclean: clean $(NETDISTCLEAN)
rm -rf\
$(DISTDIR) \
$(DISTDIR).tar.gz
$(NETDISTCLEAN) : distclean-% :
rm -rf $*_dir
dist: $(DISTDIR)
tar -ch -f - "$(DISTDIR)" | gzip -c >$(DISTDIR).tar.gz
rm -rf $(DISTDIR)
$(DISTDIR): distclean
rm -rf $(DISTDIR) && mkdir -p $(DISTDIR) && \
rsync -avC \
--exclude /*-stamp \
--exclude .*.swp \
--exclude debian \
AUTHORS \
ChangeLog \
COPYING \
Makefile \
$(PACKAGE).spec \
src \
src-phd \
*.patch \
*.pod \
$(DISTDIR)/;
clean:
$(MAKE) -C src clean
$(MAKE) -C src-phd clean
rm -f *.[0123456789].gz
.PHONY: all clean diff install-phd man net patch phd $(NET) $(NETDIFF) $(NETDISTCLEAN) $(NETPATCHNEW)
# vim:ai:
profnet-1.0.22/bval.patch 0000644 0150751 0150751 00000013523 12021363354 014517 0 ustar lkajan lkajan diff -ruN -x '.*.swp' -x 'profnet*' -x .svn src/Makefile bval_dir/Makefile
--- src/Makefile 2010-02-10 17:55:33.923514458 +0100
+++ bval_dir/Makefile 2010-02-23 10:38:31.247646372 +0100
@@ -1,9 +1,9 @@
#=====================================================================
F77 = gfortran
-BIN = profnet_prof
+BIN = profnet_bval
#=====================================================================
ARCH = LINUX
FFLAGS := $(FFLAGS) -O2 -Wuninitialized
FFLAGS := $(FFLAGS) -Wall -Wno-unused
#=====================================================================
NN_OBJS := prof.f lib-prof.f lib-sys-$(ARCH).f
diff -ruN -x '.*.swp' -x 'profnet*' -x .svn src/prof.f bval_dir/prof.f
--- src/prof.f 2010-02-11 12:59:41.891647105 +0100
+++ bval_dir/prof.f 2010-02-23 10:38:31.367649047 +0100
@@ -1850,45 +1850,45 @@
C---- interpret
IF (HC(1:5) .EQ.'NUMIN') THEN
NUMIN=VARIN
- CALL RDPAR_ERR('NUMIN ',VARIN)
+ CALL RDPAR_ERR('NUMIN',VARIN)
ELSEIF (HC(1:6) .EQ.'NUMHID') THEN
NUMHID=VARIN
- CALL RDPAR_ERR('NUMHID ',VARIN)
+ CALL RDPAR_ERR('NUMHID',VARIN)
ELSEIF (HC(1:6) .EQ.'NUMOUT') THEN
NUMOUT=VARIN
- CALL RDPAR_ERR('NUMOUT ',VARIN)
+ CALL RDPAR_ERR('NUMOUT',VARIN)
ELSEIF (HC(1:9) .EQ.'NUMLAYERS') THEN
NUMLAYERS=VARIN
ELSEIF (HC(1:6) .EQ.'NUMSAM') THEN
NUMSAM=VARIN
- CALL RDPAR_ERR('NUMSAM ',VARIN)
+ CALL RDPAR_ERR('NUMSAM',VARIN)
C----
C---- number of files
C----
ELSEIF (HC(1:12).EQ.'NUMFILEIN_IN') THEN
NUMFILEIN_IN=VARIN
- CALL RDPAR_ERR(HC // ' ',VARIN)
+ CALL RDPAR_ERR(HC,VARIN)
ELSEIF (HC(1:13).EQ.'NUMFILEIN_OUT') THEN
NUMFILEIN_OUT=VARIN
- CALL RDPAR_ERR(HC // ' ',VARIN)
+ CALL RDPAR_ERR(HC,VARIN)
ELSEIF (HC(1:14).EQ.'NUMFILEOUT_OUT') THEN
NUMFILEOUT_OUT=VARIN
- CALL RDPAR_ERR(HC // ' ',VARIN)
+ CALL RDPAR_ERR(HC,VARIN)
ELSEIF (HC(1:14).EQ.'NUMFILEOUT_JCT') THEN
NUMFILEOUT_JCT=VARIN
- CALL RDPAR_ERR(HC // ' ',VARIN)
+ CALL RDPAR_ERR(HC,VARIN)
C----
C---- training times
C----
ELSEIF (HC(1:9) .EQ.'STPSWPMAX') THEN
STPSWPMAX=VARIN
- CALL RDPAR_ERR('STPSWPMAX ',VARIN)
+ CALL RDPAR_ERR('STPSWPMAX',VARIN)
ELSEIF (HC(1:6) .EQ.'STPMAX') THEN
STPMAX=VARIN
- CALL RDPAR_ERR('STPMAX ',VARIN)
+ CALL RDPAR_ERR('STPMAX',VARIN)
ELSEIF (HC(1:6) .EQ.'STPINF') THEN
STPINF=VARIN
- CALL RDPAR_ERR('STPINF ',VARIN)
+ CALL RDPAR_ERR('STPINF',VARIN)
ELSEIF (HC(1:6) .EQ.'BITACC') THEN
BITACC=VARIN
ELSEIF (HC(1:10).EQ.'ERRBINSTOP') THEN
@@ -2176,23 +2176,19 @@
C---- ------------------------------------------------------------------
C----
C---- ------------------------------------------------------------------
- IF (CHAR_RD(1:6) .EQ. 'NUMIN ' .AND.
- + NUMIN .GT. NUMIN_MAX) THEN
+ IF (CHAR_RD .EQ. 'NUMIN' .AND. NUMIN .GT. NUMIN_MAX) THEN
WRITE(6,'(A,T10,A,I8,A,I8)')'***',
+ 'RDPAR_ERR: NUMIN read=',NUMIN,' NUMIN_MAX=',NUMIN_MAX
STOP '*** RDPAR_ERR: left due to error in RDPAR_I'
- ELSEIF (CHAR_RD(1:7) .EQ. 'NUMHID ' .AND.
- + NUMHID .GT. NUMHID_MAX) THEN
+ ELSEIF (CHAR_RD .EQ. 'NUMHID' .AND. NUMHID .GT. NUMHID_MAX) THEN
WRITE(6,'(A,T10,A,I8,A,I8)')'***',
+ 'RDPAR_ERR: NUMHID read=',NUMHID,' NUMHID_MAX=',NUMHID_MAX
STOP '*** RDPAR_ERR: left due to error in RDPAR_I'
- ELSEIF (CHAR_RD(1:7) .EQ. 'NUMOUT ' .AND.
- + NUMOUT .GT. NUMOUT_MAX) THEN
+ ELSEIF (CHAR_RD .EQ. 'NUMOUT' .AND. NUMOUT .GT. NUMOUT_MAX) THEN
WRITE(6,'(A,T10,A,I8,A,I8)')'***',
+ 'RDPAR_ERR: NUMOUT read=',NUMOUT,' NUMOUT_MAX=',NUMOUT_MAX
STOP '*** RDPAR_ERR: left due to error in RDPAR_I'
- ELSEIF (CHAR_RD(1:7) .EQ. 'NUMSAM ' .AND.
- + NUMSAM .GT. NUMSAM_MAX) THEN
+ ELSEIF (CHAR_RD .EQ. 'NUMSAM' .AND. NUMSAM .GT. NUMSAM_MAX) THEN
WRITE(6,'(A,T10,A,I8,A,I8)')'***',
+ 'RDPAR_ERR: NUMSAM read=',NUMSAM,' NUMSAM_MAX=',NUMSAM_MAX
STOP '*** RDPAR_ERR: left due to error in RDPAR_I'
diff -ruN -x '.*.swp' -x 'profnet*' -x .svn src/profPar.f bval_dir/profPar.f
--- src/profPar.f 2010-02-23 10:17:25.315661972 +0100
+++ bval_dir/profPar.f 2010-02-23 10:38:31.375656536 +0100
@@ -30,17 +30,17 @@
C lkajan: Tune these to the particular network in question - understand
C lkajan: what it needs.
-C lkajan: The below numbers are the values used by prof as in
-C lkajan: prof{sec,acc}:
- PARAMETER (NUMIN_MAX= 800)
-C lkajan: The below number of 10000 is suitable for a method that
-C lkajan: presents a sample for each amino acids of a protein because
-C lkajan: we do not encounter a protein longer than 10000AA very often.
- PARAMETER (NUMSAM_MAX= 10000)
- PARAMETER (NUMHID_MAX= 100)
- PARAMETER (NUMOUT_MAX= 10)
- PARAMETER (NUMFILES_MAX= 2)
- PARAMETER (STPSWPMAX_MAX= 5)
+ PARAMETER (NUMIN_MAX= 194)
+C lkajan: We need the big number for NUMSAM_MAX to make up for the
+C lkajan: under-defined NUMIN_MAX (194 instead of 209).
+C lkajan: Same for NUMHID_MAX.
+C lkajan: PARAMETER (NUMSAM_MAX= 822700)
+ PARAMETER (NUMSAM_MAX= 40000)
+ PARAMETER (NUMHID_MAX= 500)
+ PARAMETER (NUMOUT_MAX= 2)
+ PARAMETER (NUMFILES_MAX= 336)
+ PARAMETER (STPSWPMAX_MAX= 200)
+C lkajan: PARAMETER (STPMAX_MAX= 99999999)
C lkajan: STPMAX_MAX somehow controls the number of input vectors that can
C lkajan: be evaluated in one go. There is a simple integer array that gets
C lkajan: allocated to STPMAX_MAX size.
profnet-1.0.22/chop.patch 0000644 0150751 0150751 00000000741 12021362712 014517 0 ustar lkajan lkajan diff -ruN -x '.*.swp' -x 'profnet*' -x .svn src/Makefile chop_dir/Makefile
--- src/Makefile 2010-02-10 17:55:33.923514458 +0100
+++ chop_dir/Makefile 2010-05-12 20:05:09.819459484 +0200
@@ -1,6 +1,6 @@
#=====================================================================
F77 = gfortran
-BIN = profnet_prof
+BIN = profnet_chop
#=====================================================================
ARCH = LINUX
FFLAGS := -O3 -fbounds-check -Wuninitialized
profnet-1.0.22/con.patch 0000644 0150751 0150751 00000003600 12021362710 014340 0 ustar lkajan lkajan diff -ruN -x '.*.swp' -x 'profnet*' -x .svn src/Makefile con_dir/Makefile
--- src/Makefile 2010-02-10 17:55:33.923514458 +0100
+++ con_dir/Makefile 2010-02-23 10:48:22.263658539 +0100
@@ -1,6 +1,6 @@
#=====================================================================
F77 = gfortran
-BIN = profnet_prof
+BIN = profnet_con
#=====================================================================
ARCH = LINUX
FFLAGS := -O3 -fbounds-check -Wuninitialized
diff -ruN -x '.*.swp' -x 'profnet*' -x .svn src/profPar.f con_dir/profPar.f
--- src/profPar.f 2010-02-23 10:17:25.315661972 +0100
+++ con_dir/profPar.f 2010-02-23 10:47:35.907691244 +0100
@@ -32,19 +32,20 @@
C lkajan: what it needs.
C lkajan: The below numbers are the values used by prof as in
C lkajan: prof{sec,acc}:
- PARAMETER (NUMIN_MAX= 800)
+ PARAMETER (NUMIN_MAX= 767)
C lkajan: The below number of 10000 is suitable for a method that
C lkajan: presents a sample for each amino acids of a protein because
C lkajan: we do not encounter a protein longer than 10000AA very often.
- PARAMETER (NUMSAM_MAX= 10000)
+ PARAMETER (NUMSAM_MAX= 310000)
PARAMETER (NUMHID_MAX= 100)
PARAMETER (NUMOUT_MAX= 10)
- PARAMETER (NUMFILES_MAX= 2)
- PARAMETER (STPSWPMAX_MAX= 5)
+ PARAMETER (NUMFILES_MAX= 336)
+ PARAMETER (STPSWPMAX_MAX= 200)
C lkajan: STPMAX_MAX somehow controls the number of input vectors that can
C lkajan: be evaluated in one go. There is a simple integer array that gets
C lkajan: allocated to STPMAX_MAX size.
- PARAMETER (STPMAX_MAX= 5)
+C PARAMETER (STPMAX_MAX= 99999999) seems unreasonably high
+ PARAMETER (STPMAX_MAX= 1000000)
PARAMETER (NUMARG_MAX= 500)
C G M T
profnet-1.0.22/isis.patch 0000644 0150751 0150751 00000003636 12021362710 014541 0 ustar lkajan lkajan diff -ruN -x '.*.swp' -x 'profnet*' -x .svn src/Makefile isis_dir/Makefile
--- src/Makefile 2010-02-10 17:55:33.923514458 +0100
+++ isis_dir/Makefile 2010-02-26 11:22:10.199787414 +0100
@@ -1,6 +1,6 @@
#=====================================================================
F77 = gfortran
-BIN = profnet_prof
+BIN = profnet_isis
#=====================================================================
ARCH = LINUX
FFLAGS := -O3 -fbounds-check -Wuninitialized
diff -ruN -x '.*.swp' -x 'profnet*' -x .svn src/profPar.f isis_dir/profPar.f
--- src/profPar.f 2010-02-23 10:17:25.315661972 +0100
+++ isis_dir/profPar.f 2010-02-26 11:20:32.863648133 +0100
@@ -32,19 +32,23 @@
C lkajan: what it needs.
C lkajan: The below numbers are the values used by prof as in
C lkajan: prof{sec,acc}:
+C PARAMETER (NUMIN_MAX= 270)
PARAMETER (NUMIN_MAX= 800)
C lkajan: The below number of 10000 is suitable for a method that
C lkajan: presents a sample for each amino acids of a protein because
C lkajan: we do not encounter a protein longer than 10000AA very often.
- PARAMETER (NUMSAM_MAX= 10000)
+ PARAMETER (NUMSAM_MAX= 422700)
+C PARAMETER (NUMHID_MAX= 50)
PARAMETER (NUMHID_MAX= 100)
PARAMETER (NUMOUT_MAX= 10)
+C PARAMETER (NUMFILES_MAX= 336)
PARAMETER (NUMFILES_MAX= 2)
- PARAMETER (STPSWPMAX_MAX= 5)
+ PARAMETER (STPSWPMAX_MAX= 200)
C lkajan: STPMAX_MAX somehow controls the number of input vectors that can
C lkajan: be evaluated in one go. There is a simple integer array that gets
C lkajan: allocated to STPMAX_MAX size.
- PARAMETER (STPMAX_MAX= 5)
+C PARAMETER (STPMAX_MAX= 99999999)
+ PARAMETER (STPMAX_MAX= 1000000)
PARAMETER (NUMARG_MAX= 500)
C G M T
profnet-1.0.22/md.patch 0000644 0150751 0150751 00000013773 12021363617 014204 0 ustar lkajan lkajan diff -ruN -x '.*.swp' -x 'profnet*' -x .svn src/Makefile md_dir/Makefile
--- src/Makefile 2010-02-10 17:55:33.923514458 +0100
+++ md_dir/Makefile 2010-02-23 10:38:31.247646372 +0100
@@ -1,9 +1,9 @@
#=====================================================================
F77 = gfortran
-BIN = profnet_prof
+BIN = profnet_md
#=====================================================================
ARCH = LINUX
FFLAGS := $(FFLAGS) -O2 -Wuninitialized
FFLAGS := $(FFLAGS) -Wall -Wno-unused
#=====================================================================
NN_OBJS := prof.f lib-prof.f lib-sys-$(ARCH).f
diff -ruN -x '.*.swp' -x 'profnet*' -x .svn src/prof.f md_dir/prof.f
--- src/prof.f 2010-02-11 12:59:41.891647105 +0100
+++ md_dir/prof.f 2010-02-23 10:38:31.367649047 +0100
@@ -1850,45 +1850,45 @@
C---- interpret
IF (HC(1:5) .EQ.'NUMIN') THEN
NUMIN=VARIN
- CALL RDPAR_ERR('NUMIN ',VARIN)
+ CALL RDPAR_ERR('NUMIN',VARIN)
ELSEIF (HC(1:6) .EQ.'NUMHID') THEN
NUMHID=VARIN
- CALL RDPAR_ERR('NUMHID ',VARIN)
+ CALL RDPAR_ERR('NUMHID',VARIN)
ELSEIF (HC(1:6) .EQ.'NUMOUT') THEN
NUMOUT=VARIN
- CALL RDPAR_ERR('NUMOUT ',VARIN)
+ CALL RDPAR_ERR('NUMOUT',VARIN)
ELSEIF (HC(1:9) .EQ.'NUMLAYERS') THEN
NUMLAYERS=VARIN
ELSEIF (HC(1:6) .EQ.'NUMSAM') THEN
NUMSAM=VARIN
- CALL RDPAR_ERR('NUMSAM ',VARIN)
+ CALL RDPAR_ERR('NUMSAM',VARIN)
C----
C---- number of files
C----
ELSEIF (HC(1:12).EQ.'NUMFILEIN_IN') THEN
NUMFILEIN_IN=VARIN
- CALL RDPAR_ERR(HC // ' ',VARIN)
+ CALL RDPAR_ERR(HC,VARIN)
ELSEIF (HC(1:13).EQ.'NUMFILEIN_OUT') THEN
NUMFILEIN_OUT=VARIN
- CALL RDPAR_ERR(HC // ' ',VARIN)
+ CALL RDPAR_ERR(HC,VARIN)
ELSEIF (HC(1:14).EQ.'NUMFILEOUT_OUT') THEN
NUMFILEOUT_OUT=VARIN
- CALL RDPAR_ERR(HC // ' ',VARIN)
+ CALL RDPAR_ERR(HC,VARIN)
ELSEIF (HC(1:14).EQ.'NUMFILEOUT_JCT') THEN
NUMFILEOUT_JCT=VARIN
- CALL RDPAR_ERR(HC // ' ',VARIN)
+ CALL RDPAR_ERR(HC,VARIN)
C----
C---- training times
C----
ELSEIF (HC(1:9) .EQ.'STPSWPMAX') THEN
STPSWPMAX=VARIN
- CALL RDPAR_ERR('STPSWPMAX ',VARIN)
+ CALL RDPAR_ERR('STPSWPMAX',VARIN)
ELSEIF (HC(1:6) .EQ.'STPMAX') THEN
STPMAX=VARIN
- CALL RDPAR_ERR('STPMAX ',VARIN)
+ CALL RDPAR_ERR('STPMAX',VARIN)
ELSEIF (HC(1:6) .EQ.'STPINF') THEN
STPINF=VARIN
- CALL RDPAR_ERR('STPINF ',VARIN)
+ CALL RDPAR_ERR('STPINF',VARIN)
ELSEIF (HC(1:6) .EQ.'BITACC') THEN
BITACC=VARIN
ELSEIF (HC(1:10).EQ.'ERRBINSTOP') THEN
@@ -2176,23 +2176,19 @@
C---- ------------------------------------------------------------------
C----
C---- ------------------------------------------------------------------
- IF (CHAR_RD(1:6) .EQ. 'NUMIN ' .AND.
- + NUMIN .GT. NUMIN_MAX) THEN
+ IF (CHAR_RD .EQ. 'NUMIN' .AND. NUMIN .GT. NUMIN_MAX) THEN
WRITE(6,'(A,T10,A,I8,A,I8)')'***',
+ 'RDPAR_ERR: NUMIN read=',NUMIN,' NUMIN_MAX=',NUMIN_MAX
STOP '*** RDPAR_ERR: left due to error in RDPAR_I'
- ELSEIF (CHAR_RD(1:7) .EQ. 'NUMHID ' .AND.
- + NUMHID .GT. NUMHID_MAX) THEN
+ ELSEIF (CHAR_RD .EQ. 'NUMHID' .AND. NUMHID .GT. NUMHID_MAX) THEN
WRITE(6,'(A,T10,A,I8,A,I8)')'***',
+ 'RDPAR_ERR: NUMHID read=',NUMHID,' NUMHID_MAX=',NUMHID_MAX
STOP '*** RDPAR_ERR: left due to error in RDPAR_I'
- ELSEIF (CHAR_RD(1:7) .EQ. 'NUMOUT ' .AND.
- + NUMOUT .GT. NUMOUT_MAX) THEN
+ ELSEIF (CHAR_RD .EQ. 'NUMOUT' .AND. NUMOUT .GT. NUMOUT_MAX) THEN
WRITE(6,'(A,T10,A,I8,A,I8)')'***',
+ 'RDPAR_ERR: NUMOUT read=',NUMOUT,' NUMOUT_MAX=',NUMOUT_MAX
STOP '*** RDPAR_ERR: left due to error in RDPAR_I'
- ELSEIF (CHAR_RD(1:7) .EQ. 'NUMSAM ' .AND.
- + NUMSAM .GT. NUMSAM_MAX) THEN
+ ELSEIF (CHAR_RD .EQ. 'NUMSAM' .AND. NUMSAM .GT. NUMSAM_MAX) THEN
WRITE(6,'(A,T10,A,I8,A,I8)')'***',
+ 'RDPAR_ERR: NUMSAM read=',NUMSAM,' NUMSAM_MAX=',NUMSAM_MAX
STOP '*** RDPAR_ERR: left due to error in RDPAR_I'
diff -ruN -x '.*.swp' -x 'profnet*' -x .svn src/profPar.f md_dir/profPar.f
--- src/profPar.f 2010-02-23 10:17:25.315661972 +0100
+++ md_dir/profPar.f 2010-02-23 10:38:31.375656536 +0100
@@ -30,21 +30,21 @@
C lkajan: Tune these to the particular network in question - understand
C lkajan: what it needs.
-C lkajan: The below numbers are the values used by prof as in
-C lkajan: prof{sec,acc}:
- PARAMETER (NUMIN_MAX= 800)
-C lkajan: The below number of 10000 is suitable for a method that
-C lkajan: presents a sample for each amino acids of a protein because
-C lkajan: we do not encounter a protein longer than 10000AA very often.
- PARAMETER (NUMSAM_MAX= 10000)
- PARAMETER (NUMHID_MAX= 100)
- PARAMETER (NUMOUT_MAX= 10)
- PARAMETER (NUMFILES_MAX= 2)
- PARAMETER (STPSWPMAX_MAX= 5)
+ PARAMETER (NUMIN_MAX= 194)
+C lkajan: We need the big number for NUMSAM_MAX to make up for the
+C lkajan: under-defined NUMIN_MAX (194 instead of 699).
+C lkajan: Same for NUMHID_MAX.
+C lkajan: PARAMETER (NUMSAM_MAX= 822700)
+ PARAMETER (NUMSAM_MAX= 160000)
+ PARAMETER (NUMHID_MAX= 500)
+ PARAMETER (NUMOUT_MAX= 2)
+ PARAMETER (NUMFILES_MAX= 336)
+ PARAMETER (STPSWPMAX_MAX= 200)
+C lkajan: PARAMETER (STPMAX_MAX= 99999999)
C lkajan: STPMAX_MAX somehow controls the number of input vectors that can
C lkajan: be evaluated in one go. There is a simple integer array that gets
C lkajan: allocated to STPMAX_MAX size.
- PARAMETER (STPMAX_MAX= 5)
+ PARAMETER (STPMAX_MAX= 1000000)
PARAMETER (NUMARG_MAX= 500)
C G M T
profnet-1.0.22/norsnet.patch 0000644 0150751 0150751 00000013550 12021364514 015262 0 ustar lkajan lkajan diff -ruN -x '.*.swp' -x 'profnet*' -x .svn src/Makefile norsnet_dir/Makefile
--- src/Makefile 2010-02-10 17:55:33.923514458 +0100
+++ norsnet_dir/Makefile 2010-02-23 10:38:31.339646898 +0100
@@ -1,9 +1,9 @@
#=====================================================================
F77 = gfortran
-BIN = profnet_prof
+BIN = profnet_norsnet
#=====================================================================
ARCH = LINUX
FFLAGS := $(FFLAGS) -O2 -Wuninitialized
FFLAGS := $(FFLAGS) -Wall -Wno-unused
#=====================================================================
NN_OBJS := prof.f lib-prof.f lib-sys-$(ARCH).f
diff -ruN -x '.*.swp' -x 'profnet*' -x .svn src/prof.f norsnet_dir/prof.f
--- src/prof.f 2010-02-11 12:59:41.891647105 +0100
+++ norsnet_dir/prof.f 2010-02-23 10:38:31.371648007 +0100
@@ -1850,45 +1850,45 @@
C---- interpret
IF (HC(1:5) .EQ.'NUMIN') THEN
NUMIN=VARIN
- CALL RDPAR_ERR('NUMIN ',VARIN)
+ CALL RDPAR_ERR('NUMIN',VARIN)
ELSEIF (HC(1:6) .EQ.'NUMHID') THEN
NUMHID=VARIN
- CALL RDPAR_ERR('NUMHID ',VARIN)
+ CALL RDPAR_ERR('NUMHID',VARIN)
ELSEIF (HC(1:6) .EQ.'NUMOUT') THEN
NUMOUT=VARIN
- CALL RDPAR_ERR('NUMOUT ',VARIN)
+ CALL RDPAR_ERR('NUMOUT',VARIN)
ELSEIF (HC(1:9) .EQ.'NUMLAYERS') THEN
NUMLAYERS=VARIN
ELSEIF (HC(1:6) .EQ.'NUMSAM') THEN
NUMSAM=VARIN
- CALL RDPAR_ERR('NUMSAM ',VARIN)
+ CALL RDPAR_ERR('NUMSAM',VARIN)
C----
C---- number of files
C----
ELSEIF (HC(1:12).EQ.'NUMFILEIN_IN') THEN
NUMFILEIN_IN=VARIN
- CALL RDPAR_ERR(HC // ' ',VARIN)
+ CALL RDPAR_ERR(HC,VARIN)
ELSEIF (HC(1:13).EQ.'NUMFILEIN_OUT') THEN
NUMFILEIN_OUT=VARIN
- CALL RDPAR_ERR(HC // ' ',VARIN)
+ CALL RDPAR_ERR(HC,VARIN)
ELSEIF (HC(1:14).EQ.'NUMFILEOUT_OUT') THEN
NUMFILEOUT_OUT=VARIN
- CALL RDPAR_ERR(HC // ' ',VARIN)
+ CALL RDPAR_ERR(HC,VARIN)
ELSEIF (HC(1:14).EQ.'NUMFILEOUT_JCT') THEN
NUMFILEOUT_JCT=VARIN
- CALL RDPAR_ERR(HC // ' ',VARIN)
+ CALL RDPAR_ERR(HC,VARIN)
C----
C---- training times
C----
ELSEIF (HC(1:9) .EQ.'STPSWPMAX') THEN
STPSWPMAX=VARIN
- CALL RDPAR_ERR('STPSWPMAX ',VARIN)
+ CALL RDPAR_ERR('STPSWPMAX',VARIN)
ELSEIF (HC(1:6) .EQ.'STPMAX') THEN
STPMAX=VARIN
- CALL RDPAR_ERR('STPMAX ',VARIN)
+ CALL RDPAR_ERR('STPMAX',VARIN)
ELSEIF (HC(1:6) .EQ.'STPINF') THEN
STPINF=VARIN
- CALL RDPAR_ERR('STPINF ',VARIN)
+ CALL RDPAR_ERR('STPINF',VARIN)
ELSEIF (HC(1:6) .EQ.'BITACC') THEN
BITACC=VARIN
ELSEIF (HC(1:10).EQ.'ERRBINSTOP') THEN
@@ -2176,23 +2176,19 @@
C---- ------------------------------------------------------------------
C----
C---- ------------------------------------------------------------------
- IF (CHAR_RD(1:6) .EQ. 'NUMIN ' .AND.
- + NUMIN .GT. NUMIN_MAX) THEN
+ IF (CHAR_RD .EQ. 'NUMIN' .AND. NUMIN .GT. NUMIN_MAX) THEN
WRITE(6,'(A,T10,A,I8,A,I8)')'***',
+ 'RDPAR_ERR: NUMIN read=',NUMIN,' NUMIN_MAX=',NUMIN_MAX
STOP '*** RDPAR_ERR: left due to error in RDPAR_I'
- ELSEIF (CHAR_RD(1:7) .EQ. 'NUMHID ' .AND.
- + NUMHID .GT. NUMHID_MAX) THEN
+ ELSEIF (CHAR_RD .EQ. 'NUMHID' .AND. NUMHID .GT. NUMHID_MAX) THEN
WRITE(6,'(A,T10,A,I8,A,I8)')'***',
+ 'RDPAR_ERR: NUMHID read=',NUMHID,' NUMHID_MAX=',NUMHID_MAX
STOP '*** RDPAR_ERR: left due to error in RDPAR_I'
- ELSEIF (CHAR_RD(1:7) .EQ. 'NUMOUT ' .AND.
- + NUMOUT .GT. NUMOUT_MAX) THEN
+ ELSEIF (CHAR_RD .EQ. 'NUMOUT' .AND. NUMOUT .GT. NUMOUT_MAX) THEN
WRITE(6,'(A,T10,A,I8,A,I8)')'***',
+ 'RDPAR_ERR: NUMOUT read=',NUMOUT,' NUMOUT_MAX=',NUMOUT_MAX
STOP '*** RDPAR_ERR: left due to error in RDPAR_I'
- ELSEIF (CHAR_RD(1:7) .EQ. 'NUMSAM ' .AND.
- + NUMSAM .GT. NUMSAM_MAX) THEN
+ ELSEIF (CHAR_RD .EQ. 'NUMSAM' .AND. NUMSAM .GT. NUMSAM_MAX) THEN
WRITE(6,'(A,T10,A,I8,A,I8)')'***',
+ 'RDPAR_ERR: NUMSAM read=',NUMSAM,' NUMSAM_MAX=',NUMSAM_MAX
STOP '*** RDPAR_ERR: left due to error in RDPAR_I'
diff -ruN -x '.*.swp' -x 'profnet*' -x .svn src/profPar.f norsnet_dir/profPar.f
--- src/profPar.f 2010-02-23 10:17:25.315661972 +0100
+++ norsnet_dir/profPar.f 2010-02-23 10:38:31.379648791 +0100
@@ -30,17 +30,17 @@
C lkajan: Tune these to the particular network in question - understand
C lkajan: what it needs.
-C lkajan: The below numbers are the values used by prof as in
-C lkajan: prof{sec,acc}:
- PARAMETER (NUMIN_MAX= 800)
-C lkajan: The below number of 10000 is suitable for a method that
-C lkajan: presents a sample for each amino acids of a protein because
-C lkajan: we do not encounter a protein longer than 10000AA very often.
- PARAMETER (NUMSAM_MAX= 10000)
- PARAMETER (NUMHID_MAX= 100)
- PARAMETER (NUMOUT_MAX= 10)
- PARAMETER (NUMFILES_MAX= 2)
- PARAMETER (STPSWPMAX_MAX= 5)
+ PARAMETER (NUMIN_MAX= 194)
+C lkajan: We need the big number for NUMSAM_MAX to make up for the
+C lkajan: under-defined NUMIN_MAX (194 instead of 416).
+C lkajan: Same for NUMHID_MAX.
+C lkajan: PARAMETER (NUMSAM_MAX= 822700)
+ PARAMETER (NUMSAM_MAX= 40000)
+ PARAMETER (NUMHID_MAX= 500)
+ PARAMETER (NUMOUT_MAX= 2)
+ PARAMETER (NUMFILES_MAX= 336)
+ PARAMETER (STPSWPMAX_MAX= 200)
+C lkajan: PARAMETER (STPMAX_MAX= 99999999)
C lkajan: STPMAX_MAX somehow controls the number of input vectors that can
C lkajan: be evaluated in one go. There is a simple integer array that gets
C lkajan: allocated to STPMAX_MAX size.
profnet-1.0.22/prof.patch 0000644 0150751 0150751 00000000000 12021362710 014516 0 ustar lkajan lkajan profnet-1.0.22/profnet.pod 0000644 0150751 0150751 00000003613 12021362702 014726 0 ustar lkajan lkajan =head1 NAME
profnet_* - neural network implementations in Fortran
=head1 SYNOPSIS
profnet_* [OPTION|filePar]
=head1 DESCRIPTION
profnet_* binaries are neural network implementations in Fortran. Due to the original design of the code, a specific binary is compiled for each particular network architecture, changing certain constants in the source code. Therefore, there is a binary for every network architecture used. Note: certain array structures are intentionally indexed out of bounds in some of the binaries.
Note:
This binary should only be used to run with pre-made training data, do not try to use it to train your network as it will produce undesired results. It was made to be used I as part of wrapping (dependent) packages and not as a standalone neural network program.
=head1 OPTIONS
This list is not exhaustive.
=over
=item filePar
file with input parameters (also gives fileIn, fileOut)
=item 1
"switch"
=item 2
number of input units
=item 3
number of hidden units
=item 4
number of output units
=item 5
number of samples
=item 6
bitacc (typically 100)
=item 7
file with input vectors
=item 8
file with junctions
=item 9
file with output of NN ("none" -> no file written)
=item 10
optional=dbg
=item [inter]
will bring up dialog
=back
=head1 NOTES
1st MUST be "switch"!
tested only with 2 layers!
=head1 AUTHOR
Burkhard Rost
Bug fixes and enhancements by Laszlo Kajan and Guy Yachdav
=head1 COPYRIGHT AND LICENSE
Copyright 1998-2011 by Burkhard Rost EMBL, CUBIC (Columbia University, NY, USA) and LION Biosciences (Heidelberg, DE)
Copyright 2009-2011 by Laszlo Kajan Technical University Munich (Munich, DE)
Copyright 2009-2011 by Guy Yachdav CUBIC (Columbia University, NY, USA) and Technical University Munich (Munich, DE)
profnet-1.0.22/profnet.spec 0000644 0150751 0150751 00000007510 12021362710 015075 0 ustar lkajan lkajan Summary: neural network architectures for Rost Lab prediction methods
Name: profnet
Version: 1.0.20
Release: 1
License: GPL
Group: Applications/Science
Source: ftp://rostlab.org/%{name}/%{name}-%{version}.tar.gz
URL: http://rostlab.org/
BuildRoot: %{_tmppath}/%{name}-%{version}-root
BuildRequires: gcc-gfortran, rsync
%define common_desc Profnet is a component of the prediction methods that make up the \
Predict Protein service by the lab of Burkhard Rost. It provides the neural \
network component to a variety of predictors that perform protein feature \
prediction directly from sequence. This neural network implementation has \
to be compiled for every different network architecture.
%description
%{common_desc}
%package bval
Summary: neural network architecture for profbval
Group: Applications/Science
%description bval
%{common_desc}
.
This package contains the neural network architecture for profbval.
%package chop
Summary: neural network architecture for profchop
Group: Applications/Science
%description chop
%{common_desc}
.
This package contains the neural network architecture for profchop.
%package con
Summary: neural network architecture for profcon
Group: Applications/Science
%description con
%{common_desc}
.
This package contains the neural network architecture for profcon.
%package isis
Summary: neural network architecture for profisis
Group: Applications/Science
%description isis
%{common_desc}
.
This package contains the neural network architecture for profisis.
%package md
Summary: neural network architecture for metadisorder
Group: Applications/Science
%description md
%{common_desc}
.
This package contains the neural network architecture for metadisorder.
%package norsnet
Summary: neural network architecture for norsnet
Group: Applications/Science
%description norsnet
%{common_desc}
.
This package contains the neural network architecture for norsnet.
%package prof
Summary: neural network architecture for profacc
Group: Applications/Science
%description prof
%{common_desc}
.
This package contains the neural network architecture for profacc.
%package snapfun
Summary: neural network architecture for snapfun
Group: Applications/Science
%description snapfun
%{common_desc}
.
This package contains the neural network architecture for snapfun.
%package phdnet
Summary: neural network architecture for profphd
Group: Applications/Science
%description phdnet
%{common_desc}
.
This package contains the neural network architecture for profphd.
%prep
%setup -q
%build
make prefix=%{_prefix}
%install
rm -rf $RPM_BUILD_ROOT
make DESTDIR=%{buildroot} prefix=%{_prefix} install
%clean
rm -rf $RPM_BUILD_ROOT
%files
%defattr(-,root,root)
%doc AUTHORS
%doc COPYING
%files bval
%defattr(-,root,root)
%doc AUTHORS
%doc COPYING
%{_bindir}/profnet_bval
%{_mandir}/*/profnet_bval*
%files chop
%defattr(-,root,root)
%doc AUTHORS
%doc COPYING
%{_bindir}/profnet_chop
%{_mandir}/*/profnet_chop*
%files con
%defattr(-,root,root)
%doc AUTHORS
%doc COPYING
%{_bindir}/profnet_con
%{_mandir}/*/profnet_con*
%files isis
%defattr(-,root,root)
%doc AUTHORS
%doc COPYING
%{_bindir}/profnet_isis
%{_mandir}/*/profnet_isis*
%files md
%defattr(-,root,root)
%doc AUTHORS
%doc COPYING
%{_bindir}/profnet_md
%{_mandir}/*/profnet_md*
%files norsnet
%defattr(-,root,root)
%doc AUTHORS
%doc COPYING
%{_bindir}/profnet_norsnet
%{_mandir}/*/profnet_norsnet*
%files prof
%defattr(-,root,root)
%doc AUTHORS
%doc COPYING
%{_bindir}/profnet_prof
%{_mandir}/*/profnet_prof*
%files snapfun
%defattr(-,root,root)
%doc AUTHORS
%doc COPYING
%{_bindir}/profnet_snapfun
%{_mandir}/*/profnet_snapfun*
%files phdnet
%defattr(-,root,root)
%doc AUTHORS
%doc COPYING
%{_bindir}/profphd_net
%{_bindir}/phd1994
%{_mandir}/*/profphd_net*
%{_mandir}/*/phd1994*
%changelog
* Fri Jun 17 2011 Laszlo Kajan - 1.0.rg1-1
- First rpm package
profnet-1.0.22/snapfun.patch 0000644 0150751 0150751 00000006114 12021365171 015242 0 ustar lkajan lkajan diff -ruN -x '.*.swp' -x 'profnet*' -x .svn src/Makefile snapfun_dir/Makefile
--- src/Makefile 2010-02-10 17:55:33.923514458 +0100
+++ snapfun_dir/Makefile 2010-02-23 10:38:31.391656287 +0100
@@ -1,6 +1,6 @@
#=====================================================================
F77 = gfortran
-BIN = profnet_prof
+BIN = profnet_snapfun
#=====================================================================
ARCH = LINUX
FFLAGS := $(FFLAGS) -O2 -Wuninitialized
diff -ruN -x '.*.swp' -x 'profnet*' -x .svn src/Makefile.orig snapfun_dir/Makefile.orig
--- src/Makefile.orig 1970-01-01 01:00:00.000000000 +0100
+++ snapfun_dir/Makefile.orig 2010-02-23 10:38:31.395653152 +0100
@@ -0,0 +1,29 @@
+#=====================================================================
+F77 = gfortran
+BIN = profnet_prof
+#=====================================================================
+ARCH = LINUX
+FFLAGS := -O3 -fbounds-check -Wuninitialized
+FFLAGS := $(FFLAGS) -Wall -Wno-unused
+#=====================================================================
+all: $(BIN)
+
+#=====================================================================
+# Make Neural Network
+#=====================================================================
+
+NN_OBJS=prof.f lib-prof.f lib-sys-$(ARCH).f
+
+$(BIN): $(NN_OBJS)
+ @echo --- making $(BIN)
+ $(F77) -o $@ $(FFLAGS) $(NN_OBJS)
+
+clean:
+ rm -f *.o $(BIN)
+
+install:
+ mkdir -p $(DESTDIR)$(prefix)/bin && \
+ cp $(BIN) $(DESTDIR)$(prefix)/bin/
+
+.PHONY: all clean install
+
diff -ruN -x '.*.swp' -x 'profnet*' -x .svn src/profPar.f snapfun_dir/profPar.f
--- src/profPar.f 2010-02-23 10:17:25.315661972 +0100
+++ snapfun_dir/profPar.f 2010-02-23 10:38:31.399648899 +0100
@@ -32,20 +32,20 @@
C lkajan: what it needs.
C lkajan: The below numbers are the values used by prof as in
C lkajan: prof{sec,acc}:
- PARAMETER (NUMIN_MAX= 800)
+ PARAMETER (NUMIN_MAX= 900)
C lkajan: The below number of 10000 is suitable for a method that
C lkajan: presents a sample for each amino acids of a protein because
C lkajan: we do not encounter a protein longer than 10000AA very often.
- PARAMETER (NUMSAM_MAX= 10000)
- PARAMETER (NUMHID_MAX= 100)
- PARAMETER (NUMOUT_MAX= 10)
- PARAMETER (NUMFILES_MAX= 2)
- PARAMETER (STPSWPMAX_MAX= 5)
+ PARAMETER (NUMSAM_MAX= 100000)
+ PARAMETER (NUMHID_MAX= 50)
+ PARAMETER (NUMOUT_MAX= 2)
+ PARAMETER (NUMFILES_MAX= 336)
+ PARAMETER (STPSWPMAX_MAX= 400)
C lkajan: STPMAX_MAX somehow controls the number of input vectors that can
C lkajan: be evaluated in one go. There is a simple integer array that gets
C lkajan: allocated to STPMAX_MAX size.
- PARAMETER (STPMAX_MAX= 5)
- PARAMETER (NUMARG_MAX= 500)
+ PARAMETER (STPMAX_MAX= 100000)
+ PARAMETER (NUMARG_MAX= 400)
C G M T
*---- ------------------------------------------------- *