C C $Id: rdcluster.F,v 1.3 1998/07/16 16:40:27 jjv5 Exp $ C C------------------------------------------------------------------------ SUBROUTINE RDMAKESUB(IERROR) 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 MAKESUB C NCORE=1 NBUFF1=20 NBUFF2=10 C END_MAKESUB 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 20 atoms AND THE SECOND ONE OF 10 Atoms 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 C-RDC WRITE(IOUT, C-RDC . '(/" CANNOT DO CLUSTER SUBSETTING UNLESS RESIDUES", C-RDC . " 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) = .FALSE. READIT(3) = .FALSE. 100 READ(INPT,FMT='(A80)',END=1000) LINE CALL UPCASE1(LINE,80) IF(INDEX(LINE,'END_MAKECLUST').NE.0)THEN if (.not.readit(1)) then C-RDC WRITE(IOUT, C-RDC . '(/" MISSING NCORE SPECIFICATION OF CLUSTER ", C-RDC . " SUBSETTING PARAMETERS")') ierror = 1 return elseif (.not.readit(2)) then C-RDC WRITE(IOUT, C-RDC . '(/" MISSING NBUFF1 SPECIFICATION OF CLUSTER ", C-RDC . " SUBSETTING PARAMETERS")') ierror = 1 return elseif (.not.readit(3)) then C-RDC WRITE(IOUT, C-RDC . '(/" MISSING NBUFF2 SPECIFICATION OF CLUSTER ", C-RDC . " 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 . natbuff1, natbuff2 if (rdncore.and.noparen) then if (combsub) then C-RDC write(iout,'(/" ERROR: WHEN USING COMBSUB ", C-RDC & "YOU HAVE TO USE THE NCORE=", C-RDC & " ( ... ) SYNTAX")') ierror = 1 return endif ncores = ncores + 1 if (ncores.gt.1) then C-RDC write(iout,'(/" ERROR IN CLUSTER-BASED SUBSETTING: ", C-RDC & /" SOME RESIDUES OCCUR MORE THAN ONCE IN NCORE ", C-RDC & "SPECIFICATION")') ierror = 1 return endif icoreln = nres icorel1(1) = 1 ncore(1) = nncore do i=1,nres icorel(i) = i enddo C-RDC write(iout,'(" NUMBER OF RESIDUES IN EACH CORE = ",i5)') C-RDC & nncore elseif ((.not.combsub).and.(icoreln.ne.nres)) then C-RDC write(iout,'(/" ERROR: NOT ALL RESIDUES HAVE BEEN ", C-RDC & " 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 C-RDC write(iout,'(/" ERROR: THE TOTAL CHARGE ON THE CLUSTER", C-RDC & " GROUPS IS ",I4, " WHICH IS NOT EQUAL", C-RDC & /" TO THE TOTAL CHARGE OF THE SYSTEM (",I4,")")') C-RDC & 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 C-RDC WRITE(IOUT, C-RDC . '(/" IMPROPER USE OF EQUALS SIGN IN CLUSTER", C-RDC . " 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 C-RDC WRITE(IOUT, C-RDC . '(/" NUMBER OF RESIDUES IN CORE EXCEEDS", C-RDC . " TOTAL NUMBER IN STRUCTURE")') IERROR = 1 RETURN elseif (nncore.le.0) then C-RDC write(iout,'(/" NCORE HAS TO BE GREATER THAN 0")') ierror = 1 return ENDIF READIT(1) = .TRUE. if (rdncore.and.noparen) then if (combsub) then C-RDC write(iout,'(/" ERROR: WHEN USING COMBSUB ", C-RDC & "YOU HAVE TO USE THE NCORE=", C-RDC & " ( ... ) SYNTAX")') ierror = 1 return endif ncores = ncores + 1 if (ncores.gt.1) then C-RDC write(iout,'(/" ERROR IN CLUSTER-BASED SUBSETTING: ", C-RDC & /" SOME RESIDUES OCCUR MORE THAN ONCE IN NCORE ", C-RDC & "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 write(iout,'(" NUMBER OF RESIDUES IN EACH CORE = ",i5)') C-RDC & nncore endif rdncore = .true. noparen = .true. ELSEIF(INDEX(LINE(ISTART:ISTOP),'NBUFF1=').NE.0)THEN IF(READIT(2)) GO TO 200 CALL RDNUM(LINE,ISTART,xNATBUFF1,IERROR) NATBUFF1=xNATBUFF1 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),'NBUFF2=').NE.0)THEN IF(READIT(3)) GO TO 200 CALL RDNUM(LINE,ISTART,xNATBUFF2,IERROR) NATBUFF2=xNATBUFF2 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 C-RDC WRITE(IOUT, C-RDC . '(/" IMPROPER USE OF EQUALS SIGN IN CLUSTER", C-RDC . " SUBSETTING PARAMETERS")') RETURN ENDIF istart = 1 goto 201 elseif(line(istart:istart).eq."(") then noparen = .false. if (.not.rdncore) then C-RDC write(iout,'(" ERROR IN CLUSTER PARAMETERS: ", C-RDC & "UNEXPECTED (")') ierror = 1 return else C . make pairlist etc. ncores = ncores + 1 if (ncores.gt.maxsub) then C-RDC write(iout,'(" ERROR: THE NUMBER OF NCORE VALUES ", C-RDC & " 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)) C-RDC write(iout,'(" NUMBER OF RESIDUES IN EACH CORE ", C-RDC & " = ",i5,/" FOR RESIDUES",/,14(1x,i5))') C-RDC & nncore, C-RDC & (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 C-RDC write(iout,'(" ERROR: RESIDUE ",i5, C-RDC & " DOES NOT EXIST")') inum ierror = 1 return endif istart = lstr + 1 n = icoreln + inum - ibeg if (n.gt.nres) then C-RDC write(iout,'(/" ERROR IN CLUSTER-BASED ", C-RDC & "SUBSETTING: ",/" SOME RESIDUES OCCUR ", C-RDC & "MORE THAN ONCE IN NCORE ", C-RDC & "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 C-RDC write(iout,'(" ERROR: RESIDUE ",i5, C-RDC & " DOES NOT EXIST")') ibeg ierror = 1 return endif icoreln = icoreln + 1 if (icoreln.gt.nres) then C-RDC write(iout,'(/" ERROR IN CLUSTER-BASED ", C-RDC & "SUBSETTING: ",/" SOME RESIDUES OCCUR ", C-RDC & "MORE THAN ONCE IN NCORE ", C-RDC & "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 C-RDC write(iout,'(" ERROR IN CLUSTER PARAMETERS: ", C-RDC & "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 C-RDC WRITE(IOUT, C-RDC . '(/" IMPROPER USE OF EQUALS SIGN IN CLUSTER", C-RDC . " SUBSETTING PARAMETERS")') RETURN ENDIF istart = 1 goto 222 endif else IERROR = 1 C-RDC WRITE(IOUT, C-RDC . '(/" UNRECOGNIZED PARAMETER SPECIFICATION: ", C-RDC . 80A1)') (LINE(I:I),I=ISTART,ISTOP) RETURN endif if (prtcore) then if (combsub) then C-RDC write(iout,'(/" ERROR: WHEN USING COMBSUB ", C-RDC & "YOU HAVE TO USE THE NCORE=", C-RDC & " ( ... ) SYNTAX")') ierror = 1 return endif ncores = ncores + 1 if (ncores.gt.1) then C-RDC write(iout,'(/" ERROR IN CLUSTER-BASED SUBSETTING: ", C-RDC & /" SOME RESIDUES OCCUR MORE THAN ONCE IN NCORE ", C-RDC & "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 C-RDC WRITE(IOUT, C-RDC . '(/" END-OF-FILE ENCOUNTERED WHILE READING CLUSTER", C-RDC . " SUBSETTING PARAMETERS")') RETURN 2000 IERROR = 1 C-RDC WRITE(IOUT, C-RDC . '(/" ERROR READING CLUSTER SUBSETTING PARAMETERS")') RETURN END