C C $Id: rdcluster.F,v 1.3 1998/07/16 16:40:27 jjv5 Exp $ C C------------------------------------------------------------------------ SUBROUTINE RDCLUSTER(IERROR,j) C C READS IN PARAMETERS FOR CLUSTER SUBSETTING: C C NCORE = NUMBER OF RESIDUES IN CORE OF EACH SUBSYSTEM. C DBUFF1 = THICKNESS OF FIRST (INNER) BUFFER LAYER. C DBUFF2 = THICKNESS OF SECOND (OUTER) BUFFER LAYER. C C FOR A SYSTEM WITH NCORE=1, DBUFF1=4.0 AND DBUFF2=3.0, THE C FORMAT OF THE INPUT WOULD BE: C C CLUSTER C NCORE=1 DBUFF1=4.0 DBUFF2=3.0 C END_CLUSTER C C C FOR A SYSTEM OF 10 RESIDUES IN WHICH CORES OF 2 RESIDUES WOULD C BE BUILD FROM RESIDUE 1, 3, 4, 5 AND 7 AND CORES OF 1 RESIDUE C WOULD BE BUILD FROM RESIDUE 2, 6, 8, 9 AND 10, WITH THE FIRST C BUFFER LAYER OF 4.0 A AND THE SECOND ONE OF 2.0 A THE INPUT C WOULD BE: C C CLUSTER C NCORE=2 (1 3-5 7) C NCORE=1 (2 6 8-10) C DBUFF1=4.0 DBUFF2=2.0 C END_CLUSTER C C C CLUSTSUB CAN ALSO BE USED TOGETHER WITH A SPLIT-FERMI ENERGY CALCULATION, C FOR USE IN AN ENERGY DECOMPOSITION STUDY ETC. THE SYNTAX WOULD THEN BE C C CLUSTER C NCORE=2 (1 3-5 7) [1] C NCORE=1 (2 6 8-10) [0] C DBUFF1=4.0 DBUFF2=2.0 C END_CLUSTER C C MEANING THAT THE CHARGE ON RESIDUES 1 + 3 + 4 + 5 + 7 IS +1, THE CHARGE ON C RESIDUES 2 + 6 + 8 + 9 + 10 IS ZERO. NOTE THAT THIS IS ONLY MEANINGFULL C WHEN THE KEYWORD 'NO-OVERLAP' IS SPECIFIED. C C THE ERROR FLAG IS SET TO ONE IF ANY ERRORS ARE ENCOUNTERED WHILE C READING THIS INFORMATION. C IMPLICIT DOUBLE PRECISION (A-H,O-Z) #include "divcon.dim" #include "divcon.h" C C LOCAL: C CHARACTER LINE*80 LOGICAL READIT(3), rdncore, int, min, range, prtcore, noparen, & first, float dimension icore(maxres) C CC------------------------------------------------------------------CC C C C-RDC WRITE(IOUT,'(//" CLUSTER SUBSETTING PARAMETERS:", C-RDC & /" -----------------------------"/)') C C RETURN WITH AN ERROR IF THE USER HAS NOT DEFINED RESIDUES. C IF(NRES.EQ.0)THEN IERROR = 1 WRITE(IOUT, . '(/" CANNOT DO CLUSTER SUBSETTING UNLESS RESIDUES", . " ARE DEFINED")') RETURN ENDIF C do i=1,maxsub nelecef(i) = 0 enddo itch = 0 range = .false. noparen = .false. rdncore = .false. prtcore = .false. icoreln = 0 ncores = 0 READIT(1) = .FALSE. READIT(2) = .TRUE. READIT(3) = .TRUE. 100 j = j + 1 c 100 READ(INPT,FMT='(A80)',END=1000) LINE line = options2(j) CALL UPCASE1(LINE,80) IF(INDEX(LINE,'END_CLUSTER').NE.0)THEN if (.not.readit(1)) then WRITE(IOUT, . '(/" MISSING NCORE SPECIFICATION OF CLUSTER ", . " SUBSETTING PARAMETERS")') ierror = 1 return elseif (.not.readit(2)) then WRITE(IOUT, . '(/" MISSING DBUFF1 SPECIFICATION OF CLUSTER ", . " SUBSETTING PARAMETERS")') ierror = 1 return elseif (.not.readit(3)) then WRITE(IOUT, . '(/" MISSING DBUFF2 SPECIFICATION OF CLUSTER ", . " SUBSETTING PARAMETERS")') ierror = 1 return endif C-RDC WRITE(IOUT, C-RDC . '(" THICKNESS OF FIRST BUFFER REGION =",F6.2, C-RDC . /" THICKNESS OF SECOND BUFFER REGION =",F6.2)') C-RDC . dcbuff1, dcbuff2 if (rdncore.and.noparen) then if (combsub) then write(iout,'(/" ERROR: WHEN USING COMBSUB ", & "YOU HAVE TO USE THE NCORE=", & " ( ... ) SYNTAX")') ierror = 1 return endif ncores = ncores + 1 if (ncores.gt.1) then write(iout,'(/" ERROR IN CLUSTER-BASED SUBSETTING: ", & /" SOME RESIDUES OCCUR MORE THAN ONCE IN NCORE ", & "SPECIFICATION")') ierror = 1 return endif ! icoreln = nres ! icorel1(1) = 1 ! ncore(1) = nncore ! do i=1,nres ! icorel(i) = i ! enddo ! write(iout,'(" NUMBER OF RESIDUES IN EACH CORE = ",i5)') ! & nncore elseif ((.not.combsub).and.(icoreln.ne.nres)) then write(iout,'(/" ERROR: NOT ALL RESIDUES HAVE BEEN ", & " ASSIGNED A NCORE VALUE")') ierror = 1 endif ! if (setch) then !! IICHG = INDEX(KEYWRD,'CHARGE=') !! IF(IICHG.EQ.0)THEN !! CHG = 0.0D0 !! ELSE !! CALL RDNUM(KEYWRD,IICHG,CHG,IERR) !! ENDIF ! nchg = netcharge ! if (itch.ne.nchg) then ! write(iout,'(/" ERROR: THE TOTAL CHARGE ON THE CLUSTER", ! & " GROUPS IS ",I4, " WHICH IS NOT EQUAL", ! & /" TO THE TOTAL CHARGE OF THE SYSTEM (",I4,")")') ! & itch, nchg ! ierror = 1 ! return ! endif ! if (prtsub) then ! do i=1,ncores ! write(iout,'(" FORCE TOTAL CHARGE OF ",I4, ! & " ON CLUSTER GROUP ",I4)') ! & nelecef(i), i ! enddo ! endif ! endif ! icorel1(ncores+1) = icoreln + 1 return ELSE C C LOOK FOR PARAMETERS. C CALL WDJOIN(LINE,80,'=',IERROR) IF(IERROR.NE.0)THEN WRITE(IOUT, . '(/" IMPROPER USE OF EQUALS SIGN IN CLUSTER", . " SUBSETTING PARAMETERS")') RETURN ENDIF C ISTART = 1 200 CALL RDWORD(LINE,ISTART,ISTOP) prtcore = .false. C C IF THERE ARE NO MORE WORDS LEFT ON THIS LINE, GO BACK AND C READ ANOTHER LINE. C IF(ISTART.EQ.0) GO TO 100 C IF(INDEX(LINE(ISTART:ISTOP),'NCORE=').NE.0)THEN ! CALL RDNUM(LINE,ISTART,XCORE,IERROR) ! IF(IERROR.NE.0) GO TO 2000 ! NNCORE = XCORE IF(NNCORE.GT.NRES)THEN WRITE(IOUT, . '(/" NUMBER OF RESIDUES IN CORE EXCEEDS", . " TOTAL NUMBER IN STRUCTURE")') IERROR = 1 RETURN elseif (nncore.le.0) then write(iout,'(/" NCORE HAS TO BE GREATER THAN 0")') ierror = 1 return ENDIF READIT(1) = .TRUE. if (rdncore.and.noparen) then if (combsub) then write(iout,'(/" ERROR: WHEN USING COMBSUB ", & "YOU HAVE TO USE THE NCORE=", & " ( ... ) SYNTAX")') ierror = 1 return endif ncores = ncores + 1 if (ncores.gt.1) then write(iout,'(/" ERROR IN CLUSTER-BASED SUBSETTING: ", & /" SOME RESIDUES OCCUR MORE THAN ONCE IN NCORE ", & "SPECIFICATION")') ierror = 1 return endif C . make the pairlist etc. (this always has to be the first C . and only ncore) icoreln = nres icorel1(1) = 1 do i=1,nres icorel(i) = i enddo ncore(1) = nncore C-RDC if (prtsub) then C-RDC write(iout,'(" NUMBER OF RESIDUES IN EACH CORE = ",i5)') C-RDC & nncore C-RDC endif endif rdncore = .true. noparen = .true. ! ELSEIF(INDEX(LINE(ISTART:ISTOP),'DBUFF1=').NE.0)THEN ! IF(READIT(2)) GO TO 200 ! CALL RDNUM(LINE,ISTART,DCBUFF1,IERROR) ! IF(IERROR.NE.0) GO TO 2000 ! READIT(2) = .TRUE. ! if (rdncore.and.noparen) prtcore = .true. ! rdncore = .false. ! noparen = .true. ! ELSEIF(INDEX(LINE(ISTART:ISTOP),'DBUFF2=').NE.0)THEN ! IF(READIT(3)) GO TO 200 ! CALL RDNUM(LINE,ISTART,DCBUFF2,IERROR) ! IF(IERROR.NE.0) GO TO 2000 ! READIT(3) = .TRUE. ! if (rdncore.and.noparen) prtcore = .true. ! rdncore = .false. ! noparen = .true. ! elseif(line(istart:istart).eq."[") then ! setch = .true. ! istart = istart + 1 ! 201 if (istart.le.80) then ! if (line(istart:istart).eq."]") then ! istart = istart + 1 ! goto 200 ! else ! call whatis1i(line(istart:istart),int) ! if (int) then ! call iatoimp(line, istart, lstr, inum, ierror) ! nelecef(ncores) = inum ! itch = itch + inum ! istart = lstr + 1 ! goto 201 ! else ! istart = istart + 1 ! goto 201 ! endif ! endif ! endif ! read(inpt,fmt='(A80)',end=1000) line ! call upcase1(line,80) ! CALL WDJOIN(LINE,80,'=',IERROR) ! IF(IERROR.NE.0)THEN ! WRITE(IOUT, ! . '(/" IMPROPER USE OF EQUALS SIGN IN CLUSTER", ! . " SUBSETTING PARAMETERS")') ! RETURN ! ENDIF ! istart = 1 ! goto 201 ! elseif(line(istart:istart).eq."(") then ! noparen = .false. ! if (.not.rdncore) then ! write(iout,'(" ERROR IN CLUSTER PARAMETERS: ", ! & "UNEXPECTED (")') ! ierror = 1 ! return ! else !C . make pairlist etc. ! ncores = ncores + 1 ! if (ncores.gt.maxsub) then ! write(iout,'(" ERROR: THE NUMBER OF NCORE VALUES ", ! & " EXCEEDS THE MAXIMUM NUMBER OF SUBSYSTEMS.")') ! ierror = 1 ! return ! endif ! ncore(ncores) = nncore ! first = .true. ! !C . read stuff until a ) is encountered. ! istart = istart+1 ! 222 if (istart.le.80) then ! if (line(istart:istart).eq.')') then ! istart = istart + 1 ! !C . sorting is needed in neighbors parameters ! ii0 = icorel1(ncores) ! ii1 = icoreln-ii0+1 ! call bsort1(ii1,icorel(ii0)) ! write(iout,'(" NUMBER OF RESIDUES IN EACH CORE ", ! & " = ",i5,/" FOR RESIDUES",/,14(1x,i5))') ! & nncore, ! & (icorel(i), i=icorel1(ncores),icoreln) ! !C . read other words ! goto 200 ! ! endif ! ! call whatis2(line(istart:istart), int, min) ! if (int) then ! if (range) then ! call iatoi(line, istart, lstr, inum, ierror) ! if (ierror.ne.0) return ! if (inum.gt.nres) then ! write(iout,'(" ERROR: RESIDUE ",i5, ! & " DOES NOT EXIST")') inum ! ierror = 1 ! return ! endif ! istart = lstr + 1 ! n = icoreln + inum - ibeg ! if (n.gt.nres) then ! write(iout,'(/" ERROR IN CLUSTER-BASED ", ! & "SUBSETTING: ",/" SOME RESIDUES OCCUR ", ! & "MORE THAN ONCE IN NCORE ", ! & "SPECIFICATION")') ! ierror = 1 ! return ! endif ! do i=ibeg+1,inum ! icoreln = icoreln + 1 ! icorel(icoreln) = i ! enddo ! range= .false. ! goto 222 ! else ! call iatoi(line, istart, lstr, ibeg, ierror) ! if (ierror.ne.0) return ! if (ibeg.gt.nres) then ! write(iout,'(" ERROR: RESIDUE ",i5, ! & " DOES NOT EXIST")') ibeg ! ierror = 1 ! return ! endif ! icoreln = icoreln + 1 ! if (icoreln.gt.nres) then ! write(iout,'(/" ERROR IN CLUSTER-BASED ", ! & "SUBSETTING: ",/" SOME RESIDUES OCCUR ", ! & "MORE THAN ONCE IN NCORE ", ! & "SPECIFICATION")') ! ierror = 1 ! return ! endif ! if (first) then ! icorel1(ncores) = icoreln ! first = .false. ! endif ! icorel(icoreln) = ibeg ! istart = lstr + 1 ! goto 222 ! endif ! elseif (min) then ! if (range) then ! write(iout,'(" ERROR IN CLUSTER PARAMETERS: ", ! & "UNEXPECTED -")') ! ierror = 1 ! return ! else ! istart = istart + 1 ! range = .true. ! goto 222 ! endif ! else ! istart = istart + 1 ! goto 222 ! endif ! endif ! read(inpt,fmt='(A80)',end=1000) line ! call upcase1(line,80) ! CALL WDJOIN(LINE,80,'=',IERROR) ! IF(IERROR.NE.0)THEN ! WRITE(IOUT, ! . '(/" IMPROPER USE OF EQUALS SIGN IN CLUSTER", ! . " SUBSETTING PARAMETERS")') ! RETURN ! ENDIF ! ! istart = 1 ! goto 222 ! endif else IERROR = 1 WRITE(IOUT, . '(/" UNRECOGNIZED PARAMETER SPECIFICATION: ", . 80A1)') (LINE(I:I),I=ISTART,ISTOP) RETURN endif if (prtcore) then if (combsub) then write(iout,'(/" ERROR: WHEN USING COMBSUB ", & "YOU HAVE TO USE THE NCORE=", & " ( ... ) SYNTAX")') ierror = 1 return endif ncores = ncores + 1 if (ncores.gt.1) then write(iout,'(/" ERROR IN CLUSTER-BASED SUBSETTING: ", & /" SOME RESIDUES OCCUR MORE THAN ONCE IN NCORE ", & "SPECIFICATION")') ierror = 1 return endif icoreln = nres icorel1(1) = 1 do i=1,nres icorel(i) = i enddo ncore(1) = nncore C-RDC write(iout,'(" NUMBER OF RESIDUES IN EACH CORE = ",i5)') C-RDC & nncore endif C C GO BACK AND TRY TO READ ANOTHER WORD IN THIS LINE, UNLESS ALL C WORDS HAVE BEEN READ. C ISTART = ISTOP + 1 if (istart.gt.80) then goto 100 else goto 200 endif C ENDIF 1000 IERROR = 1 WRITE(IOUT, . '(/" END-OF-FILE ENCOUNTERED WHILE READING CLUSTER", . " SUBSETTING PARAMETERS")') RETURN 2000 IERROR = 1 WRITE(IOUT, . '(/" ERROR READING CLUSTER SUBSETTING PARAMETERS")') RETURN END