C PROTEIN DATA BANK SOURCE CODE BLDKIT BLDKIT 3 C AUTHOR. E.ABOLA BLDKIT 4 C ENTRY DATE. 7/80 SUPPORTED BLDKIT 5 C LAST REVISION. 2/84 BLDKIT21 C PURPOSE. MODEL BUILDER*S KIT BLDKIT 7 C LANGUAGE. FORTRAN IV BLDKIT 8 C BLDKIT 9 C BLDKIT10 C BLDKIT11 C BLDKIT12 PROGRAM BLDKIT(INPUT,OUTPUT,TAPE1,TAPE2,TAPE3,TAPE5=INPUT,TAPE6=OUBLDKIT13 1TPUT) BLDKIT14 C BLDKIT15 C WRITTEN BY - BLDKIT16 C ENRIQUE E. ABOLA BLDKIT17 C CHEMISTRY DEPARTMENT BLDKIT18 C BROOKHAVEN NATIONAL LABORATORY BLDKIT19 C UPTON,N.Y. 11973 U.S.A. BLDKIT20 C BLDKIT21 C THE PROTEIN DATA BANK IS FUNDED BY THE NATIONAL SCIENCE FOUNDATIONBLDKIT22 C UNDER GRANT PCM 77-16811. BLDKIT23 C BLDKIT24 C THE USE OF A LIBRARY OF VECTOR MANIPULATION ROUTINES WRITTEN BY BLDKIT25 C LAWRENCE C. ANDREWS IS GRATEFULLY ACKNOWLEDGED. BLDKIT26 C BLDKIT27 C PLEASE NOTIFY THE PROTEIN DATA BANK OF ANY DIFFICULTIES BLDKIT28 C ENCOUNTERED IN USING THIS PROGRAM. BLDKIT29 C BLDKIT30 C BLDKIT12 C CORRECTION. DELETE TWO DUPLICATE RECORDS. 05-MAY-82. BLDKIT13 C BLDKIT14 C BLDKIT22 C CORRECTION. DELETE SPECIAL CHARACTERS. 02-FEB-84. BLDKIT23 C BLDKIT24 C BLDKIT31 C PURPOSE- BLDKIT32 C BLDKIT33 C BLDKIT(BUILDER*S KIT) PRODUCES A CONVENIENTLY FORMATTED LISTING BLDKIT25 C OF THE ATOMIC COORDINATES OF A PROTEIN DATA BANK ENTRY. ALONG BLDKIT35 C WITH THE PROGRAMS BENDER AND DIHDRL, BLDKIT IS SUPPLIED BY THE BLDKIT36 C PROTEIN DATA BANK TO AID ITS USERS IN CONSTRUCTING MOLECULAR BLDKIT37 C MODELS. BLDKIT38 C BLDKIT39 C SEVERAL OPTIONS ARE PROVIDED WHICH ALLOW THE USE OF THE PROGRAM BLDKIT40 C FOR A VARIETY OF MODEL BUILDING KITS. BLDKIT41 C THESE OPTIONS ARE, BLDKIT42 C 1. CHOICE OF SCALE BLDKIT43 C 2. CHOICE OF ORIGIN BLDKIT44 C 3. CHOICE OF ORIENTATION BLDKIT45 C 4. SEGMENTATION WHICH ALLOWS THE USER TO LIST ONLY THOSE BLDKIT46 C COORDINATES NEEDED TO BUILD A PARTIAL MODEL (E.G. ONLY BLDKIT47 C THOSE RESIDUES INVOLVED IN A BINDING SITE). BLDKIT48 C BLDKIT49 C I/O FILES BLDKIT50 C BLDKIT51 C SYMBOLIC LOGICAL DESCRIPTION BLDKIT52 C DESIGNATION UNIT BLDKIT53 C BLDKIT54 C IPDB TAPE1 PROTEIN DATA BANK ENTRIES BLDKIT55 C ITAPE2 TAPE2 SCRATCH FILE USED AS AN OVERFLOW BLDKIT56 C FILE FOR THE COMMON AREA BLDKIT57 C INTBUF BLDKIT58 C ITAPE3 TAPE3 SCRATCH FILE USED AS AN OVERFLOW BLDKIT59 C FILE FOR THE COMMON AREA BLDKIT60 C REALBF BLDKIT61 C INPT TAPE5 INPUT FILE FROM CARD READER BLDKIT62 C LPTR TAPE6 OUTPUT FILE TO BE PRINTED BLDKIT63 C BLDKIT64 C INPUT PARAMETERS ON FILE INPT BLDKIT65 C BLDKIT66 C INPUT RECORD 1 FORMAT(2I5,A4) BLDKIT67 C BLDKIT68 C COL. NO. NAME DESCRIPTION BLDKIT69 C BLDKIT70 C 1-5 ITOTFL TOTAL NUMBER OF DATA PARTITIONS IN BLDKIT71 C IPDB TO BE PROCESSED (BLANK OR BLDKIT72 C ZERO DEFAULTS TO ONE) BLDKIT73 C BLDKIT74 C 6-10 NFILE NUMBER OF PARTITIONS TO SKIP BEFORE BLDKIT75 C PROCESSING BLDKIT76 C .LT. 0 POSITION THE FILE IPDB IN THE BLDKIT77 C PARTITION WITH THE HEADER NAME GIVEN BLDKIT78 C IN IFLNAM BLDKIT79 C .EQ. 0 START PROCESSING FROM CURRENT FILE BLDKIT80 C POSITION BLDKIT81 C .GT. 0 SKIP NFILE FILE MARKS BEFORE BLDKIT82 C PROCESSING BLDKIT83 C BLDKIT84 C 11-15 IFLNAM FOUR CHARACTER CODE FOUND IN THE BLDKIT85 C HEADER RECORD OF THE PARTITION FROM BLDKIT86 C WHICH PROCESSING IS TO BEGIN. BLDKIT87 C BLDKIT88 C IF ITOTFL IS GREATER THAN ONE THE PROGRAM ASSUMES THAT ALL BLDKIT89 C THE FILES TO BE READ SHARE THE SAME PARAMETER CARDS. BLDKIT90 C BLDKIT91 C INPUT RECORD 2 FORMAT(I5) BLDKIT92 C BLDKIT93 C 1-5 NSEG NUMBER OF SEGMENTS TO BE GENERATED BLDKIT94 C BLDKIT95 C INPUT RECORD 2A FORMAT(I5,4X,A1,4I5) ONE RECORD FOR EACH SEGMENT BLDKIT96 C BLDKIT97 C 1-5 ISGBEG(1,I) BEGINNING RESIDUE NUMBER FOR BLDKIT98 C SEGMENT I. BLDKIT99 C 10 ISGBEG(2,I) BEGINNING CHAIN INDICATOR FOR BLDKI100 C SEGMENT I BLDKI101 C 11-15 ISGEND(I) ENDING SEQUENCE NUMBER FOR SEGMENT I BLDKI102 C 16-20 IBKBNE(I) ATOMS TO BE INCLUDED BLDKI103 C = 0 INCLUDE ALL ATOMS (DEFAULT) BLDKI104 C = 1 INCLUDE ONLY N,CA,C,O ATOMS BLDKI105 C 21-25 INCBET(I) IS USED ONLY IF IBKBNE IS 1 BLDKI106 C = 0 DO NOT INCLUDE CB ATOM BLDKI107 C = 1 INCLUDE CB ATOM BLDKI108 C 26-30 INCHET(I) READ/NO READ HETATM RECORDS BLDKI109 C = 0 PROCESS HETATM RECORDS BLDKI110 C = 1 DO NOT PROCESS HETATM RECORDS BLDKI111 C BLDKI112 C INPUT RECORD 3 FORMAT(I5) BLDKI113 C BLDKI114 C 1-5 IUSSCL SETS THE KIND OF SCALING TO BE DONE BLDKI115 C = 0 USE 12.5 MM./ANG.(DEFAULT) BLDKI116 C = 1 10.0 MM./ANG. BLDKI117 C = 2 20.0 MM./ANG. BLDKI118 C = 3 USER SUPPLIED SCALE BLDKI119 C BLDKI120 C INPUT RECORD 3A FORMAT(F10.5) BLDKI121 C BLDKI122 C 1-10 SCALE SCALE VALUE TO BE USED BLDKI123 C THIS RECORD IS NEEDED IF IUSSCL BLDKI124 C IS SET TO 3. BLDKI125 C BLDKI126 C INPUT RECORD 4 FORMAT(I5) BLDKI127 C BLDKI128 C 1-5 IORG BLDKI129 C = 0 CHOOSE THE ORIGIN AT THE BLDKI130 C CENTER OF MASS(DEFAULT) BLDKI131 C = 1 CHOOSE THE ORIGIN EMPLOYED IN THE BLDKI132 C PROTEIN DATA BANK ENTRY BLDKI133 C = 2 ORIGIN TO BE SUPPLIED BY THE USER BLDKI134 C BLDKI135 C INPUT RECORD 4A FORMAT(3F10.5) BLDKI136 C BLDKI137 C 1-10 XCOM THESE ARE THE COORDINATES TO BE USED BLDKI138 C 11-20 YCOM AS ORIGIN IN THE PRINTOUT. THIS BLDKI139 C 21-30 ZCOM RECORD IS NEEDED IF IORG IS SET TO 2. BLDKI140 C BLDKI141 C INPUT RECORD 5 FORMAT(I5) BLDKI142 C BLDKI143 C 1-5 IROT SPECIFIES THE ORIENTATION TO BE USED BLDKI144 C =0 USE THE PROTEIN DATA BANK ENTRY BLDKI145 C ORIENTATION (DEFAULT). BLDKI146 C IDENTITY MATRIX IS USED. BLDKI147 C =1 APPLY A TRANSFORMATION USING THE BLDKI148 C EULERIAN ANGLES IN THE NEXT RECORD. BLDKI149 C USES THE CONVENTION OF GOLDSTEIN, BLDKI150 C CLASSICAL MECHANICS PP. 107-109. BLDKI151 C THIS CONVENTION IS EXPLAINED BELOW. BLDKI152 C =2 APPLY A TRANSFORMATION USING THE BLDKI153 C SPHERICAL-POLAR ANGLES AND THE BLDKI154 C ROTATION ANGLE KAPPA. BLDKI155 C THESE ANGLES ARE SUPPLIED IN THE BLDKI156 C NEXT RECORD. BLDKI157 C SEE EXPLANATION BELOW FOR THE BLDKI158 C CONVENTION USED. BLDKI159 C =3 APPLY THE TRANSFORMATION SPECIFIED BLDKI160 C BY A ROTATION ABOUT A VECTOR. BLDKI161 C TWO POINTS ALONG THIS VECTOR AND BLDKI162 C THE ROTATION ANGLE ARE GIVEN IN THE BLDKI163 C NEXT RECORDS. BLDKI164 C =4 APPLY THE TRANSFORMATION SPECIFIED BLDKI165 C BY A USER SUPPLIED MATRIX. BLDKI166 C THIS MATRIX IS GIVEN IN THE NEXT BLDKI167 C RECORD. BLDKI168 C =5 APPLY THE TRANSFORMATION SPECIFIED BLDKI169 C BY DEFINING A PLANE GIVEN BY THREE BLDKI170 C POINTS. THE NORMAL TO THIS PLANE BLDKI171 C WILL BE THE Z-AXIS. BLDKI172 C BLDKI173 C INPUT RECORD 5A FORMAT(3F10.5) BLDKI174 C BLDKI175 C 1-10 ANGLX THIS RECORD IS REQUIRED IF IROT IS BLDKI176 C 11-20 ANGLY SET TO 1 OR 2. BLDKI177 C 21-30 ANGLZ ANGLX,ANGLY AND ANGLZ REFER EITHER BLDKI178 C TO THE EULERIAN ALPHA, BETA AND GAMMA BLDKI179 C ANGLES OR THE SPHERICAL-POLAR ANGLES BLDKI180 C PHI AND PSI AND ROTATION ANGLE KAPPA, BLDKI181 C RESPECTIVELY (ANGLES ARE IN DEGREES). BLDKI182 C BLDKI183 C INPUT RECORDS 5B FORMAT(3F10.5) BLDKI184 C BLDKI185 C RECORDS 5BI AND 5BII THESE RECORDS ARE REQUIRED IF IROT IS BLDKI186 C SET TO 3. BLDKI187 C BLDKI188 C 1-10 XINP(I) XYZ-COORDINATES OF TWO POINTS BLDKI189 C 11-20 YINP(I) ALONG THE ROTATION AXIS. BLDKI190 C 21-30 ZINP(I) ONE POINT PER RECORD. BLDKI191 C BLDKI192 C RECORD 5BIII BLDKI193 C BLDKI194 C 1-10 ANGLZ ROTATION ANGLE K BLDKI195 C BLDKI196 C INPUT RECORDS 5C FORMAT(3F10.5) BLDKI197 C BLDKI198 C RECORDS 5CI,5CII,5CIII BLDKI199 C BLDKI200 C 1-10 ROT(I,1) THESE RECORDS ARE REQUIRED IF IROT IS BLDKI201 C 11-20 ROT(I,2) SET TO 4. BLDKI202 C 21-30 ROT(I,3) USER SUPPLIED MATRIX GIVEN IN BLDKI203 C ROW ORDER, ONE RECORD PER ROW. BLDKI204 C BLDKI205 C INPUT RECORDS 5D FORMAT(3F10.5) BLDKI206 C BLDKI207 C RECORDS 5DI,5DII AND 5DIII BLDKI208 C BLDKI209 C 1-10 XINP(I) THIS RECORD IS REQUIRED IF IROT IS BLDKI210 C 11-20 YINP(I) SET TO 5. BLDKI211 C 21-30 ZINP(I) USER DEFINED PLANE GIVEN BY THREE BLDKI212 C POINTS, EACH POINT IS GIVEN IN A BLDKI213 C SEPARATE RECORD. BLDKI214 C BLDKI215 C INPUT RECORD 6 FORMAT(3I5) BLDKI216 C BLDKI217 C 1-10 IBIAS(1) BY SETTING TO 1 FORCES X TO BE .GT.0 BLDKIT26 C 11-20 IBIAS(2) BY SETTING TO 1 FORCES X TO BE .GT.0 BLDKIT27 C 21-30 IBIAS(3) BY SETTING TO 1 FORCES X TO BE .GT.0 BLDKIT28 C BLDKI221 C DEFAULT OPTIONS- BLDKI222 C BLDKI223 C BY SUPPLYING 7 BLANK CARDS THE FOLLOWING OPTIONS ARE CHOSEN BLDKI224 C BLDKI225 C 1. PROCESS ONE DATA PARTITION BLDKI226 C 2. PROCESS FROM CURRENT FILE POSITION BLDKI227 C 3. GENERATE ONE SEGMENT BLDKI228 C 4. BEGIN PROCESSING AT THE START OF THE ENTRY AND INCLUDE ALL BLDKI229 C ATOM AND HETATM RECORDS BLDKI230 C 5. USE THE SCALE 12.5 BLDKI231 C 6. USE THE CENTER OF MASS COORDINATES AS ORIGIN BLDKI232 C 7. APPLY AN IDENTITY MATRIX OF TRANSFORMATION BLDKI233 C 8. DO NOT APPLY ANY BIAS BLDKI234 C BLDKI235 C BLDKI236 C OUTPUT BLDKI237 C BLDKI238 C FOR EACH DATA BANK ENTRY PROCESSED A SUMMARY OF OPTIONS BLDKI239 C CHOSEN ARE PRINTED ON PAGE 0. THE NEXT PAGE WILL CONTAIN BLDKI240 C THE ENTRY IDENTIFYING INFORMATION. FOLLOWING PAGES WILL BLDKI241 C CONTAIN A LISTING OF THE SCALED AND TRANSFORMED COORDINATES BLDKI242 C GROUPED IN SEGMENTS AND WITHIN EACH SEGMENT GROUPED BLDKI243 C BY RESIDUE NAME. BLDKI244 C A SUMMARY OF THE LISTING IS GIVEN AT THE END OF THE BLDKI245 C COORDINATE TABLE. THIS INCLUDES BLDKI246 C 1. NUMBER OF RESIDUES PROCESSED BLDKI247 C 2. NUMBER OF ATOMIC COORDINATES PROCESSED BLDKI248 C 3. CENTER OF MASS COORDINATES UNTRANSFORMED AND UNSCALED BLDKI249 C 4. MAXIMUM AND MINIMUM TRANSFORMED AND SCALED COORDINATES BLDKI250 C 5. SUMMARY OF RESIDUE OCCURENCES GIVING THE TOTAL NUMBER BLDKI251 C OF OCCURENCES OF EACH RESIDUE, THE RESIDUE NAME AND BLDKI252 C THE SEQUENCE NUMBERS WHERE THEY OCCUR IN THE ENTRY. BLDKI253 C BLDKI254 C CONVENTIONS USED FOR SPECIFYING ANGULAR DIRECTIONS BLDKI255 C AND ROTATIONS- BLDKI256 C BLDKI257 C THE EULERIAN ANGLES ARE DEFINED AS THREE SUCCESSIVE ANGLES OF BLDKI258 C ROTATION. THE SEQUENCE WILL BE STARTED BY ROTATING THE INITIAL BLDKI259 C SYSTEM OF AXES XYZ, BY AN ANGLE ALPHA ABOUT THE Z AXIS, AND BLDKI260 C THEN ROTATING ABOUT THE NEW X AXIS COUNTERCLOCKWISE BY BETA AND BLDKI261 C LASTLY ABOUT THE NEW Z AXIS COUNTERCLOCKWISE BY GAMMA. BLDKI262 C THIS CONVENTION COULD EASILY BE CHANGED BY MODIFYING THE BLDKI263 C SUBROUTINE EULER. INSTRUCTIONS ON HOW TO DO THIS ARE PROVIDED BLDKI264 C IN THE SUBROUTINE. BLDKI265 C BLDKI266 C THE SPHERICAL POLAR ANGLES PHI AND PSI DEFINE A DIRECTION ABOUT BLDKI267 C WHICH ONE ROTATES COUNTERCLOCKWISE BY KAPPA. PHI IS MEASURED BLDKI268 C FROM THE CARTESIAN X-AXIS TO THE PROJECTION OF THE VECTOR BLDKI269 C DIRECTION X-Y PLANE. PSI IS MEASURED AS THE ANGLE BETWEEN THE BLDKI270 C Z-AXIS AND THE VECTOR. BOTH ANGLES ARE MEASURED POSITIVE GOING BLDKI271 C COUNTERCLOCKWISE. BLDKI272 C BLDKI273 C BLDKI274 C PROGRAM MODIFICATIONS- BLDKI275 C BLDKI276 C TO HELP SPEED UP THE EXECUTION OF THIS PROGRAM TWO BUFFERS ARE BLDKI277 C MAINTAINED IN THE FOLLOWING SUBROUTINES BLDKI278 C BLDKI279 C 1. BLDWRK BLDKI280 C 2. SETUPB BLDKI281 C 3. BUFOUT BLDKI282 C 4. BUFIN BLDKI283 C 5. PRNOUT BLDKI284 C BLDKI285 C THESE BUFFERS ARE THE COMMON AREAS REALBF AND INTBF. BLDKI286 C BY INCREASING THE DIMENSION OF THE ARRAYS RLIST AND ILIST AND BY BLDKI287 C SETTING THE VALUE OF MAXBUF TO THIS NEW DIMENSION ONE CAN BLDKI288 C REDUCE THE NUMBER OF READS AND WRITES TO THE SCRATCH FILES BLDKI289 C AND EFFECTIVELY SPEED UP EXECUTION OF THE PROGRAM. BLDKI290 C BLDKI291 C THE SUMMARY LISTING ON RESIDUE OCCURENCES WILL NOT BE PRINTED BLDKI292 C FOR ENTRIES WITH MORE THAN 500 RESIDUES. TO ENABLE THE PRINTING BLDKI293 C OF THIS SUMMARY, THE VALUE OF MAXRES MUST BE MODIFIED IN THE BLDKI294 C SUBROUTINES PRNOUT AND COLSUM. THE DIMENSIONS OF THE VARIABLES BLDKI295 C ITMP1, ITMP2 AND ISEQNM MUST THEN BE SET TO THE VALUE OF MAXRES. BLDKI296 C BLDKI297 C MACHINE DEPENDENCIES BLDKI298 C BLDKI299 C THIS PROGRAM MUST HANDLE CHARACTERS STORED IN A WORD. AN ATTEMPT BLDKI300 C WAS MADE TO HAVE A LIMIT OF FOUR CHARACTERS PER WORD. TYPICALLY BLDKI301 C A RECORD IS READ IN 20A4 FORMAT AND IDENTIFIED. SUBSEQUENTLY BLDKI302 C IT IS ENCODED INTO A LINE IN 8A10 FORMAT THAT CAN BE DECODED BLDKI303 C USING THE APPROPRIATE FORMAT. THE ARRAY *LINE* IS ALWAYS USED BLDKI304 C FOR THIS PURPOSE. BLDKI305 C FOR COMPUTERS WITH ENCODE/DECODE CAPABILITY ONLY THE DIMENSION OF BLDKI306 C *LINE* AND A FORMAT STATEMENT NEED BE CHANGED. FOR THOSE WITHOUT BLDKI307 C THIS CAPABILITY, THE LINE CAN BE WRITTEN ON A SCRATCH FILE AND BLDKI308 C REREAD. BLDKI309 C THE FOLLOWING SUBROUTINES USE THE ENCODE/DECODE FACILITY OF THE BLDKI310 C CDC MACHINE BLDKI311 C 1. NTRPRT BLDKI312 C 2. PRNTXT BLDKI313 C BLDKI314 C EVERY READ STATEMENT IN THIS PROGRAM IS FOLLOWED BY THE TEST BLDKI315 C IF ( EOF(IPDB)) S1, S2 BLDKI316 C THE PROGRAM JUMPS TO STATEMENT S1 IF AN END OF FILE HAS BEEN BLDKI317 C ENCOUNTERED AFTER A READ ON FILE IPDB AND TO STATEMENT S2 BLDKI318 C OTHERWISE. BLDKI319 C THE EOF TESTING PERFORMED IS UNIQUE FOR CDC MACHINES AND MAY NEED BLDKI320 C REVISION TO THE MORE COMMON FORM OF BLDKI321 C READ(INPT,1000,END=500) IBUF BLDKI322 C BLDKI323 C THIS EOF TESTING IS USED IN THE FOLLOWING ROUTINES BLDKI324 C 1. MAIN PROGRAM BLDKI325 C 2. GETREC BLDKI326 C BLDKI327 C ALL VARIABLES THAT ARE USED TO STORE CHARACTERS ARE DEFAULTED BLDKI328 C TO BE OF INTEGER TYPE. EACH ROUTINE WILL CONTAIN A LIST OF THESE BLDKI329 C VARIABLES AS PART OF THE HEADER INFORMATION. BLDKI330 C BLDKI331 C THE ARITHMETIC STATEMENT FUNCTION IDEN(I,J) IS USED TO COMPARE BLDKI332 C ALPHANUMERIC VARIABLES. BLDKI333 C BLDKI334 C THE PRESENT ROUTINE IS THE MAIN CONTROLLER FOR THE PROGRAM BLDKI335 C BLDKIT. BLDKI336 C THE FILE IPDB IS POSITIONED PROPERLY BY THIS ROUTINE. BLDKI337 C BLDKI338 C THE FOLLOWING VARIABLES ARE USED TO STORE CHARACTERS BLDKI339 C ISGBEG,IFLNAM,IBUF BLDKI340 C BLDKI341 DIMENSION TRLVEC(3), ROT(3,3) BLDKI342 DIMENSION IBUF(20), IBIAS(3) BLDKI343 DIMENSION ISGEND(25), INCHET(25) BLDKI344 DIMENSION IBKBNE(25), INCBET(25), ISGBEG(2,25) BLDKI345 C BLDKI346 COMMON /PARMS/ NSEG,IBKBNE,INCBET,ISGBEG,ISGEND,INCHET,SCALE,IUSCOBLDKI347 1M,XCOM,YCOM,ZCOM,ROT,TRLVEC,IBIAS BLDKI348 C BLDKI349 C GET THE INPUT PARAMETERS BLDKI350 C BLDKI351 10 CALL PARMRD (ITOTFL,NFILE,IFLNAM) BLDKI352 C BLDKI353 IF (ITOTFL.LT.0) GO TO 40 BLDKI354 IF (NFILE.LT.0) GO TO 20 BLDKI355 IF (NFILE.EQ.0) GO TO 30 BLDKI356 C BLDKI357 C POSITION TAPE AFTER SKIPPING NFILE TAPE MARKS BLDKI358 C BLDKI359 CALL SKIPFL (NFILE,IER) BLDKI360 IF (IER.NE.0) GO TO 40 BLDKI361 GO TO 30 BLDKI362 C BLDKI363 C POSITION TAPE BY FILENAME BLDKI364 C BLDKI365 20 CALL POSNAM (IFLNAM,IER,IBUF,JCODE) BLDKI366 IF (IER.NE.0) GO TO 40 BLDKI367 CALL PRNTXT (IBUF,JCODE) BLDKI368 GO TO 30 BLDKI369 C BLDKI370 30 DO 35 J = 1,ITOTFL BLDKI371 CALL BLDWRK(IER) BLDKI372 IF (IER.NE.0) GO TO 40 BLDKI373 35 CONTINUE BLDKI374 GO TO 10 BLDKI375 C BLDKI376 40 STOP BLDKI377 END BLDKI378 SUBROUTINE PARMRD (ITOTFL,NFILE,IFLNAM) BLDKI379 C BLDKI380 C THIS ROUTINE READS IN ALL THE REQUIRED PARAMETERS BLDKI381 C BLDKI382 C THE FOLLOWING VARIABLES ARE USED TO STORE CHARACTERS BLDKI383 C ISGBEG,IBLANK,ITITLE,IFMT1,I2 BLDKI384 C BLDKI385 DIMENSION X1(3), X2(3), X3(3) BLDKI386 DIMENSION WRK(3,3) BLDKI387 DIMENSION IBIAS(3) BLDKI388 DIMENSION IFMT1(6,2) BLDKI389 DIMENSION ISGBEG(2,25), ISGEND(25) BLDKI390 DIMENSION IBKBNE(25), INCBET(25), INCHET(25) BLDKI391 DIMENSION TRLVEC(3), ROT(3,3), XINP(3), YINP(3), ZINP(3) BLDKI392 C BLDKI393 C THE COMMON AREA PARMS IS USED TO TRANSMIT PARAMETERS TO THE BLDKI394 C REST OF THE PROGRAM BLDKI395 C BLDKI396 COMMON /PARMS/ NSEG,IBKBNE,INCBET,ISGBEG,ISGEND,INCHET,SCALE,IUSCOBLDKI397 1M,XCOM,YCOM,ZCOM,ROT,TRLVEC,IBIAS BLDKI398 C BLDKI399 DATA INPT/5/,LPTR/6/,RD/.017453/ BLDKI400 DATA IBLANK/1H /,ITITLE/4H / BLDKI401 DATA (IFMT1(I,1),I=1,2)/4HBACK,4HBONE/ BLDKI402 DATA (IFMT1(I,2),I=1,2)/4H ,4H ALL/ BLDKI403 DATA (IFMT1(I,1),I=3,4)/4H D,4HO / BLDKI404 DATA (IFMT1(I,2),I=3,4)/4H DO ,4HNOT / BLDKI405 DATA (IFMT1(I,1),I=5,6)/4HPROC,4HESS / BLDKI406 DATA (IFMT1(I,2),I=5,6)/4HIGNO,4HRE / BLDKI407 C BLDKI408 IDEN(I,J)=I-J BLDKI409 C BLDKI410 ITOTFL=-1 BLDKI411 C BLDKI412 C RESET PARAMETERS TO THEIR DEFAULT VALUES BLDKI413 C BLDKI414 CALL SETUPB BLDKI415 IPAGE=0 BLDKI416 CALL NEWPAG (ITITLE,IPAGE) BLDKI417 C BLDKI418 C GET THE FILE POSITIONING PARAMETERS BLDKI419 C BLDKI420 READ (INPT,370) ITOTFL,NFILE,IFLNAM BLDKI421 IF (EOF(INPT)) 365,10 BLDKI422 C BLDKI423 10 IF (ITOTFL.LT.0) GO TO 360 BLDKI424 C BLDKI425 C READ IN HOW MANY SEGMENTS TO BE GENERATED BLDKI426 C BLDKI427 READ (INPT,370) NSEG BLDKI428 C BLDKI429 IF (NSEG.EQ.0) NSEG=1 BLDKI430 C BLDKI431 C FOR EACH SEGMENT THE USER MUST DEFINE THE ATOMS TO BE INCLUDED, BLDKI432 C THE BEGINNING AND ENDING SEQUENCE NUMBERS BLDKI433 C BLDKI434 DO 20 I=1,NSEG BLDKI435 READ (INPT,380) I1,I2,I3,I4,I5,I6 BLDKI436 IF (I1.NE.0) ISGBEG(1,I)=I1 BLDKI437 IF (IDEN(I2,IBLANK).NE.0) ISGBEG(2,I)=I2 BLDKI438 IF (I3.NE.0) ISGEND(I)=I3 BLDKI439 IF (I4.NE.0) IBKBNE(I)=I4 BLDKI440 IF (I5.NE.0) INCBET(I)=I5 BLDKI441 IF (I6.NE.0) INCHET(I)=I6 BLDKI442 20 CONTINUE BLDKI443 C BLDKI444 C FIND WHICH SCALE IS TO BE USED BLDKI445 C BLDKI446 READ (INPT,370) IUSSCL BLDKI447 C BLDKI448 IF (IUSSCL.NE.0) GO TO 30 BLDKI449 C BLDKI450 C SCALE HAS BEEN SET TO DEFAULT VALUE OF 12.5 BLDKI451 C BLDKI452 GO TO 70 BLDKI453 C BLDKI454 30 IF (IUSSCL.NE.1) GO TO 40 BLDKI455 SCALE=10.0 BLDKI456 GO TO 70 BLDKI457 C BLDKI458 40 IF (IUSSCL.NE.2) GO TO 50 BLDKI459 SCALE=20.0 BLDKI460 GO TO 70 BLDKI461 C BLDKI462 50 IF (IUSSCL.NE.3) GO TO 60 BLDKI463 C BLDKI464 C READ IN USER SUPPLIED SCALE IF IUSSCL=3 BLDKI465 C BLDKI466 READ (INPT,400) SCALE BLDKI467 GO TO 70 BLDKI468 C BLDKI469 C VALUE FOR IUSSCL PROVIDED IS NOT ALLOWED BLDKI470 C BLDKI471 60 WRITE (LPTR,410) BLDKI472 GO TO 70 BLDKI473 C BLDKI474 C DETERMINE WHICH ORIGIN IS TO BE USED BLDKI475 C BLDKI476 70 READ (INPT,370) IORG BLDKI477 C BLDKI478 IF (IORG.NE.0) GO TO 80 BLDKI479 C BLDKI480 C DEFAULT HAS BEEN CHOSEN USE COM BLDKI481 C BLDKI482 GO TO 110 BLDKI483 C BLDKI484 80 IF (IORG.NE.1) GO TO 90 BLDKI485 IUSCOM=1 BLDKI486 GO TO 110 BLDKI487 C BLDKI488 90 IF (IORG.NE.2) GO TO 100 BLDKI489 READ (INPT,400) XCOM,YCOM,ZCOM BLDKI490 IUSCOM=2 BLDKI491 GO TO 110 BLDKI492 C BLDKI493 C THE VALUE PROVIDED FOR IORG IS NOT ALLOWED BLDKI494 C COM WILL BE USED BLDKI495 C BLDKI496 100 WRITE (LPTR,420) BLDKI497 IUSCOM=0 BLDKI498 GO TO 110 BLDKI499 C BLDKI500 C READ REORIENTATION DIRECTIVES BLDKI501 C BLDKI502 110 READ (INPT,370) IROT BLDKI503 C BLDKI504 IF (IROT.NE.0) GO TO 120 BLDKI505 C BLDKI506 C DEFAULT IDENTITY MATRIX WILL BE USED BLDKI507 C BLDKI508 GO TO 190 BLDKI509 C BLDKI510 120 IF (IROT.GT.2) GO TO 140 BLDKI511 C BLDKI512 READ (INPT,400) ANGLX,ANGLY,ANGLZ BLDKI513 IF (IROT.NE.1) GO TO 130 BLDKI514 CALL EULER (ANGLX,ANGLY,ANGLZ,WRK) BLDKI515 CALL TRNSPZ (WRK,ROT) BLDKI516 GO TO 190 BLDKI517 C BLDKI518 130 CALL SPHROT (ANGLX,ANGLY,ANGLZ,ROT) BLDKI519 GO TO 190 BLDKI520 C BLDKI521 140 IF (IROT.NE.3) GO TO 150 BLDKI522 READ (INPT,400) XINP(1),YINP(1),ZINP(1) BLDKI523 READ (INPT,400) XINP(2),YINP(2),ZINP(2) BLDKI524 READ (INPT,400) ANGLZ BLDKI525 X1(1)=XINP(1) BLDKI526 X1(2)=YINP(1) BLDKI527 X1(3)=ZINP(1) BLDKI528 X2(1)=XINP(2) BLDKI529 X2(2)=YINP(2) BLDKI530 X2(3)=ZINP(2) BLDKI531 OMEGA=ANGLZ*RD BLDKI532 CALL GENROT (X1,X2,OMEGA,WRK,TRLVEC) BLDKI533 CALL TRNSPZ (WRK,ROT) BLDKI534 GO TO 190 BLDKI535 C BLDKI536 150 IF (IROT.NE.4) GO TO 160 BLDKI537 READ (INPT,430) ((ROT(I,J),J=1,3),I=1,3) BLDKI538 GO TO 190 BLDKI539 C BLDKI540 160 IF (IROT.NE.5) GO TO 180 BLDKI541 DO 170 I=1,3 BLDKI542 170 READ (INPT,400) XINP(I),YINP(I),ZINP(I) BLDKI543 X1(1)=XINP(1) BLDKI544 X1(2)=YINP(1) BLDKI545 X1(3)=ZINP(1) BLDKI546 X2(1)=XINP(2) BLDKI547 X2(2)=YINP(2) BLDKI548 X2(3)=ZINP(2) BLDKI549 X3(1)=XINP(3) BLDKI550 X3(2)=YINP(3) BLDKI551 X3(3)=ZINP(3) BLDKI552 CALL NEWORN (X1,X2,X3,WRK) BLDKI553 CALL TRNSPZ (WRK,ROT) BLDKI554 GO TO 190 BLDKI555 C BLDKI556 C VALUE PROVIDED FOR IROT IS NOT ALLOWED BLDKI557 C NO REORIENTATION WILL BE DONE BLDKI558 C BLDKI559 180 WRITE (LPTR,440) BLDKI560 GO TO 190 BLDKI561 C BLDKI562 C DETERMINE IF ANY BIAS SHOULD BE APPLIED BLDKI563 C BLDKI564 190 READ (INPT,390) IBIAS BLDKI565 IF (EOF(INPT)) 365,200 BLDKI566 C BLDKI567 C WRITE OUT A SUMMARY OF THE INPUT PARAMETERS BLDKI568 C BLDKI569 200 WRITE (LPTR,450) BLDKI570 WRITE (LPTR,460) NSEG BLDKI571 DO 270 I=1,NSEG BLDKI572 WRITE (LPTR,470) I,ISGBEG(1,I),ISGEND(I) BLDKI573 C BLDKI574 C DETERMINE WHICH FORMAT IS TO BE USED BLDKI575 C BLDKI576 IF (IBKBNE(I).LE.0) GO TO 210 BLDKI577 I1=1 BLDKI578 GO TO 220 BLDKI579 210 I1=2 BLDKI580 I2=1 BLDKI581 GO TO 240 BLDKI582 C BLDKI583 220 IF (INCBET(I).LE.0) GO TO 230 BLDKI584 I2=1 BLDKI585 GO TO 240 BLDKI586 230 I2=2 BLDKI587 GO TO 240 BLDKI588 C BLDKI589 240 IF (INCHET(I).NE.0) GO TO 250 BLDKI590 I3=1 BLDKI591 GO TO 260 BLDKI592 250 I3=2 BLDKI593 GO TO 260 BLDKI594 C BLDKI595 260 WRITE (LPTR,480) IFMT1(1,I1),IFMT1(2,I1),IFMT1(3,I2),IFMT1(4,I2),IBLDKI596 1FMT1(5,I3),IFMT1(6,I3) BLDKI597 C BLDKI598 C BLDKI599 270 CONTINUE BLDKI600 C BLDKI601 C BLDKI602 WRITE (LPTR,490) SCALE BLDKI603 C BLDKI604 C BLDKI605 IF (IORG.NE.0) GO TO 280 BLDKI606 WRITE (LPTR,500) BLDKI607 GO TO 300 BLDKI608 C BLDKI609 280 IF (IORG.NE.1) GO TO 290 BLDKI610 WRITE (LPTR,510) BLDKI611 GO TO 300 BLDKI612 C BLDKI613 290 IF (IORG.NE.2) GO TO 300 BLDKI614 WRITE (LPTR,520) XCOM,YCOM,ZCOM BLDKI615 C BLDKI616 300 IF (IROT.NE.1) GO TO 310 BLDKI617 WRITE (LPTR,530) ANGLX,ANGLY,ANGLZ BLDKI618 GO TO 350 BLDKI619 C BLDKI620 310 IF (IROT.NE.2) GO TO 320 BLDKI621 WRITE (LPTR,540) ANGLX,ANGLY,ANGLZ BLDKI622 GO TO 350 BLDKI623 C BLDKI624 320 IF (IROT.NE.3) GO TO 330 BLDKI625 WRITE (LPTR,550) ANGLZ,XINP(1),YINP(1),ZINP(1),XINP(2),YINP(2),ZINBLDKI626 1P(2) BLDKI627 GO TO 350 BLDKI628 C BLDKI629 330 IF (IROT.NE.4) GO TO 340 BLDKI630 WRITE (LPTR,560) BLDKI631 GO TO 350 BLDKI632 C BLDKI633 340 IF (IROT.NE.5) GO TO 350 BLDKI634 WRITE (LPTR,570) (XINP(I),YINP(I),ZINP(I),I=1,3) BLDKI635 GO TO 350 BLDKI636 C BLDKI637 350 WRITE (LPTR,580) ((ROT(I,J),J=1,3),I=1,3) BLDKI638 C BLDKI639 C TRANSPOSE THE MATRIX BLDKI640 C THIS IS DONE SINCE THE PROGRAM PACKAGE VECTOR DOES ARRAY BLDKI641 C OPERATIONS ASSUMING A ROWWISE STORAGE RATHER THAN THE NORMAL BLDKI642 C COLUMNWISE BLDKI643 C BLDKI644 CALL TRNSPZ (ROT,WRK) BLDKI645 CALL CPYMAT (WRK,ROT) BLDKI646 C BLDKI647 WRITE (LPTR,590) IBIAS BLDKI648 360 RETURN BLDKI649 C BLDKI650 C END OF FILE ON FILE INPT ABORT THE JOB BLDKI651 C BLDKI652 365 ITOTFL = -1 BLDKI653 RETURN BLDKI654 C BLDKI655 370 FORMAT (2I5,A4) BLDKI656 380 FORMAT (I5,4X,A1,4I5) BLDKI657 390 FORMAT (16I5) BLDKI658 400 FORMAT (8F10.5) BLDKI659 410 FORMAT (52H0ERROR IN IUSSCL,DEFAULT SCALE OF 12.5 IS TO BE USED) BLDKI660 420 FORMAT (33H0 ERROR IN IORG, COM WILL BE USED) BLDKI661 430 FORMAT (3F10.5) BLDKI662 440 FORMAT (39H0 ERROR IN IROT,IDENTITY MATRIX IS USED) BLDKI663 450 FORMAT (30H0 SUMMARY OF INPUT PARAMETERS ) BLDKI664 460 FORMAT (37H0 NUMBER OF SEGMENTS TO BE GENERATED ,2X,I5) BLDKI665 470 FORMAT (13H0 FOR SEGMENT,2X,I5,2X,8HSTART AT,2X,I5,2X,7H END AT,2XBLDKI666 1,I5) BLDKI667 480 FORMAT (9X,3HUSE,2A4,7H ATOMS,,2A4,14HINCLUDE C-BETA,5H AND ,2A4,1BLDKI668 12H HET RECORDS) BLDKI669 490 FORMAT (15H0 USE THE SCALE,2X,F10.4,2X,6HMM/ANG) BLDKI670 500 FORMAT (46H0 USE THE CENTER OF MASS COORDINATES AS ORIGIN) BLDKI671 510 FORMAT (27H0 USE THE PDB ENTRY ORIGIN ) BLDKI672 520 FORMAT (36H0 USER SUPPLIED ORIGIN IN ANG. UNITS,/,10X,3F8.3) BLDKI673 530 FORMAT (47H0 ROTATE THE MOLECULE USING THE EULERIAN ANGLES,/,10X,3BLDKI674 1F8.2) BLDKI675 540 FORMAT (32H0 USE THE SPHERICAL POLAR ANGLES,/,10X,3F8.3) BLDKI676 550 FORMAT (12H0 ROTATE BY ,F8.2,25H DEGREES ABOUT THE VECTOR,/,10X,3FBLDKI677 18.3,3H - ,3F8.3) BLDKI678 560 FORMAT (37H0 USER SUPPLIED TRANSFORMATION MATRIX) BLDKI679 570 FORMAT (54H0 MAKE PARALLEL TO THE X-Y PLANE THE PLANE DEFINED BY ,BLDKI680 1/,3(10X,3F10.5,/)) BLDKI681 580 FORMAT (31H0 USE THE TRANSFORMATION MATRIX,/,3(10X,3F10.5,/)) BLDKI682 590 FORMAT (60H ADD A BIAS TO THE COORDINATES IF THEIR MIN IS NEGATIVBLDKI683 1E,USE,/,10X,I2,1H*,4HXMIN,2X,I2,1H*,4HYMIN,2X,I2,1H*,4HZMIN) BLDKI684 END BLDKI685 SUBROUTINE SETUPB BLDKI686 C BLDKI687 C THIS ROUTINE RESETS PARAMETERS IN PARMS TO THEIR DEFAULT VALUES BLDKI688 C BLDKI689 C BLDKI690 C TO SPEED UP THE PROGRAM INCREASE THE DIMENSIONS OF ILIST AND BLDKI691 C RLIST AND SET THE VALUE OF MAXBUF TO THIS NEW DIMENSION. BLDKI692 C BLDKI693 C BLDKI694 C THE FOLLOWING VARIABLES ARE USED TO STORE CHARACTERS BLDKI695 C ISGBEG,IBLANK BLDKI696 C BLDKI697 C NOTE THAT THE ARRAY ILIST IS USED TO STORE CHARACTERS AND BLDKI698 C INTEGERS AND IT IS THEREFORE NECESSARY TO ENSURE THAT THE BLDKI699 C ELEMENTS OF THIS ARRAY CAN BE USED TO STORE UP TO 4 CHARACTERS BLDKI700 C BLDKI701 DIMENSION ILIST(100), RLIST(100) BLDKI702 DIMENSION ISGBEG(2,25), ISGEND(25) BLDKI703 DIMENSION TRLVEC(3), ROT(3,3), IBIAS(3) BLDKI704 DIMENSION IBKBNE(25), INCBET(25), INCHET(25) BLDKI705 C BLDKI706 COMMON /PARMS/ NSEG,IBKBNE,INCBET,ISGBEG,ISGEND,INCHET,SCALE,IUSCOBLDKI707 1M,XCOM,YCOM,ZCOM,ROT,TRLVEC,IBIAS BLDKI708 C BLDKI709 COMMON /REALBF/ RLIST BLDKI710 COMMON /INTBUF/ ILIST BLDKI711 DATA IBLANK/1H / BLDKI712 DATA MAXBUF/100/ BLDKI713 C BLDKI714 DO 10 I=1,25 BLDKI715 IBKBNE(I)=0 BLDKI716 INCBET(I)=0 BLDKI717 ISGBEG(1,I)=-5000 BLDKI718 ISGBEG(2,I)=IBLANK BLDKI719 ISGEND(I)=5000 BLDKI720 INCHET(I) = 0 BLDKI721 10 CONTINUE BLDKI722 C BLDKI723 SCALE=12.5 BLDKI724 IUSCOM=0 BLDKI725 XCOM=0.0 BLDKI726 YCOM=0.0 BLDKI727 ZCOM=0.0 BLDKI728 DO 30 I=1,3 BLDKI729 TRLVEC(I)=0.0 BLDKI730 IBIAS(I)=0 BLDKI731 DO 30 J=1,3 BLDKI732 IF (I.NE.J) GO TO 20 BLDKI733 ROT(I,J)=1.0 BLDKI734 GO TO 30 BLDKI735 20 ROT(I,J)=0.0 BLDKI736 30 CONTINUE BLDKI737 C BLDKI738 DO 40 J=1,MAXBUF BLDKI739 ILIST(J)=0 BLDKI740 40 RLIST(J)=0.0 BLDKI741 RETURN BLDKI742 END BLDKI743 SUBROUTINE NEWORN (X,Y,Z,ROT) BLDKI744 C BLDKI745 C THIS ROUTINE DETERMINES AN ORIENTATION MATRIX TO REDEFINE BLDKI746 C THE COORDINATE SYSTEM TO ONE SPECIFIED BY A PLANE AND ITS BLDKI747 C NORMAL BLDKI748 C BLDKI749 DIMENSION X(3), Y(3), Z(3), ROT(9) BLDKI750 DIMENSION V1(3), V2(3), V3(3) BLDKI751 C BLDKI752 CALL VECDIF (X,Y,V1) BLDKI753 CALL VECDIF (X,Z,V2) BLDKI754 CALL UNIT (V1,X) BLDKI755 CALL UNIT (V2,Y) BLDKI756 CALL CROSS (X,Y,V3) BLDKI757 CALL UNIT (V3,Z) BLDKI758 CALL CROSS (Z,X,Y) BLDKI759 CALL MAT (ROT,X,Y,Z) BLDKI760 C BLDKI761 RETURN BLDKI762 END BLDKI763 SUBROUTINE CALCOM (IDIR) BLDKI764 C BLDKI765 C THIS ROUTINE CALCULATES THE CENTER OF MASS COORDINATES BLDKI766 C IDIR =0 RESET ATOM COUNT NUMBER BLDKI767 C =1 ACCUMULATE SUMS TO DETERMINE C.O.M. BLDKI768 C =2 CALCULATE THE C.O.M. AND DEPOSIT THE RESULTS IN THE BLDKI769 C COMMON ARRAY PARMS. BLDKI770 C BLDKI771 C THE FOLLOWING VARIABLES ARE USED TO STORE CHARACTERS BLDKI772 C NRESCR,NCHNCR,INSCCR,NAMECR,NALTCR BLDKI773 C ISGBEG BLDKI774 C BLDKI775 DIMENSION IBKBNE(25), INCBET(25), INCHET(25) BLDKI776 DIMENSION ISGBEG(2,25), ISGEND(25) BLDKI777 DIMENSION TRLVEC(3), ROT(3,3), IBIAS(3) BLDKI778 DIMENSION NSERCR(100), NAMECR(100), NALTCR(100) BLDKI779 DIMENSION ATMXCR(100), ATMYCR(100), ATMZCR(100) BLDKI780 C BLDKI781 COMMON /CURRES/ NALLCR,NRESCR,NCHNCR,NSEQCR,INSCCR,NSERCR,NAMECR,NBLDKI782 1ALTCR,ATMXCR,ATMYCR,ATMZCR BLDKI783 C BLDKI784 COMMON /PARMS/ NSEG,IBKBNE,INCBET,ISGBEG,ISGEND,INCHET,SCALE,IUSCOBLDKI785 1M,XCOM,YCOM,ZCOM,ROT,TRLVEC,IBIAS BLDKI786 C BLDKI787 COMMON /COMLCL/ FTOT BLDKI788 C BLDKI789 IF (IDIR.NE.0) GO TO 10 BLDKI790 FTOT=0.0 BLDKI791 GO TO 10 BLDKI792 C BLDKI793 10 IF (IDIR.EQ.2) GO TO 30 BLDKI794 C BLDKI795 DO 20 J=1,NALLCR BLDKI796 XCOM=XCOM+ATMXCR(J) BLDKI797 YCOM=YCOM+ATMYCR(J) BLDKI798 20 ZCOM=ZCOM+ATMZCR(J) BLDKI799 IDIR=1 BLDKI800 C BLDKI801 FTOT=FTOT+FLOAT(NALLCR) BLDKI802 GO TO 40 BLDKI803 C BLDKI804 30 XCOM=XCOM/FTOT BLDKI805 YCOM=YCOM/FTOT BLDKI806 ZCOM=ZCOM/FTOT BLDKI807 GO TO 40 BLDKI808 C BLDKI809 40 RETURN BLDKI810 END BLDKI811 SUBROUTINE BLDWRK (IER) BLDKI812 C BLDKI813 C THIS ROUTINE IS THE MAIN WORK LOOP FOR THE PROGRAM BLDKIT BLDKI814 C BLDKI815 C THE FOLLOWING VARIABLES ARE USED TO STORE CHARACTERS BLDKI816 C NRESCR,NCHNCR,INSCCR,NAMECR,NALTCR BLDKI817 C ISGBEG,IFINI,IDSET,IBUF,INCATM BLDKI818 C NAME27,NALT27,NRES27,NCHN27,INSC27 BLDKI819 C BLDKI820 DIMENSION IBUF(20) BLDKI821 DIMENSION INCATM(20) BLDKI822 DIMENSION XMIN(3), XMAX(3) BLDKI823 DIMENSION TRLVEC(3), ROT(3,3), IBIAS(3) BLDKI824 DIMENSION IBKBNE(25), INCBET(25), INCHET(25) BLDKI825 DIMENSION ISGBEG(2,25), ISGEND(25) BLDKI826 DIMENSION NSERCR(100), NAMECR(100), NALTCR(100) BLDKI827 DIMENSION ATMXCR(100), ATMYCR(100), ATMZCR(100) BLDKI828 C BLDKI829 COMMON /HEADER/ IDSET BLDKI830 C BLDKI831 COMMON /ATOM/ NSER27,NAME27,NALT27,NRES27,NCHN27,NSEQ27,INSC27,ATMBLDKI832 1X27,ATMY27,ATMZ27,OCPN27,TEMP27 BLDKI833 C BLDKI834 COMMON /CURRES/ NALLCR,NRESCR,NCHNCR,NSEQCR,INSCCR,NSERCR,NAMECR,NBLDKI835 1ALTCR,ATMXCR,ATMYCR,ATMZCR BLDKI836 C BLDKI837 COMMON /PARMS/ NSEG,IBKBNE,INCBET,ISGBEG,ISGEND,INCHET,SCALE,IUSCOBLDKI838 1M,XCOM,YCOM,ZCOM,ROT,TRLVEC,IBIAS BLDKI839 C BLDKI840 DATA IHEAD/1/,IAUTHR/4/,IENDD/31/ BLDKI841 DATA IFINI/4HFINI/,IENDB/-50/,IYES/0/ BLDKI842 DATA INEND/1/,IBEFRE/3/,IAFTER/2/,IDONE/2/ BLDKI843 C BLDKI844 IDEN(I,J)=I-J BLDKI845 C BLDKI846 C INITIALIZE COUNTERS AND CONDITIONS BLDKI847 C BLDKI848 IACCML=0 BLDKI849 KEY1=1 BLDKI850 KEY2=1 BLDKI851 ISG=1 BLDKI852 IRC=0 BLDKI853 NINC=0 BLDKI854 ISTATE=0 BLDKI855 DO 10 I=1,3 BLDKI856 XMIN(I)=5000. BLDKI857 10 XMAX(I)=-5000. BLDKI858 C BLDKI859 C SET THE ATOM NAME DISCRIMINATE LIST BLDKI860 C BLDKI861 JHET=INCHET(ISG) BLDKI862 IF (IBKBNE(ISG).EQ.IYES) GO TO 20 BLDKI863 CALL SETATM (NINC,INCATM,INCBET(ISG)) BLDKI864 GO TO 20 BLDKI865 C BLDKI866 C READ A PDB RECORD AND IF IT IS A RESIDUE ACCUMULATE ALL THE BLDKI867 C ATOMS IN IT BEFORE RETURNING BLDKI868 C BLDKI869 20 CALL GETRES (ISTATE,NINC,INCATM,IBUF,JCODE,JHET) BLDKI870 IF (ISTATE.NE.IDONE) GO TO 60 BLDKI871 C BLDKI872 C CHECK TO SEE IF THIS RESIDUE IS IN THIS SEGMENT BLDKI873 C BLDKI874 CALL INLIST (NCHNCR,NSEQCR,ISGBEG,ISGEND,ISG,ILS) BLDKI875 C BLDKI876 IF (ILS.EQ.IBEFRE) GO TO 100 BLDKI877 IF (ILS.EQ.IAFTER) GO TO 50 BLDKI878 C BLDKI879 C CALCULATE THE C.O.M. IF IT IS REQUIRED BLDKI880 C BLDKI881 IF (IUSCOM.EQ.IYES) CALL CALCOM (IACCML) BLDKI882 C BLDKI883 C DO AN INITIAL TRANSFORMATION AS DEFINED BY ROT AND TRLVEC. BLDKI884 C A FINAL TRANSFORMATION TO ACCOUNT FOR ANY CHANGES IN THE BLDKI885 C ORIGIN WILL BE DONE BEFORE PRINT OUT BLDKI886 C BLDKI887 DO 30 J=1,NALLCR BLDKI888 30 CALL TRANSF (ATMXCR(J),ATMYCR(J),ATMZCR(J),XMIN,XMAX,ROT,TRLVEC) BLDKI889 C BLDKI890 C ACCUMULATE THE RESIDUES IN A BUFFER BLDKI891 C BLDKI892 CALL BUFOUT (KEY1,KEY2) BLDKI893 NSEROL=NSERCR(NALLCR) BLDKI894 C BLDKI895 IF (ILS.NE.INEND) GO TO 100 BLDKI896 C BLDKI897 C SET THE ATOM DISCRIMINATE LIST FOR THE NEXT SEGMENT BLDKI898 C BLDKI899 ISG=ISG+1 BLDKI900 IF (ISG.GT.NSEG) GO TO 100 BLDKI901 NINC=0 BLDKI902 IF (IBKBNE(ISG).EQ.IYES) GO TO 40 BLDKI903 CALL SETATM (NINC,INCATM,INCBET(ISG)) BLDKI904 40 JHET=INCHET(ISG) BLDKI905 GO TO 100 BLDKI906 C BLDKI907 50 ISG=ISG+1 BLDKI908 GO TO 100 BLDKI909 C BLDKI910 C RECORD READ WAS NOT AN ATOM CARD BLDKI911 C BLDKI912 60 IF (JCODE.NE.IHEAD) GO TO 70 BLDKI913 CALL NTRPRT (IBUF,JCODE) BLDKI914 GO TO 70 BLDKI915 C BLDKI916 70 IF (IABS(JCODE).GT.IAUTHR) GO TO 80 BLDKI917 CALL PRNTXT (IBUF,JCODE) BLDKI918 GO TO 80 BLDKI919 C BLDKI920 C CHECK FOR END OF ENTRY BLDKI921 C BLDKI922 80 IF (.NOT.(JCODE.EQ.IENDB.OR.JCODE.EQ.IHEAD.AND.IDSET.EQ.IFINI)) GOBLDKI923 1 TO 90 BLDKI924 IER=3 BLDKI925 IRC=2 BLDKI926 GO TO 100 BLDKI927 C BLDKI928 90 IF (JCODE.NE.IENDD) GO TO 100 BLDKI929 IER=0 BLDKI930 IRC=1 BLDKI931 GO TO 100 BLDKI932 C BLDKI933 100 IF (IRC.EQ.0.AND.ISG.LE.NSEG) GO TO 20 BLDKI934 C BLDKI935 C MAKE SURE GETRES IS DONE BLDKI936 C BLDKI937 C IF IRC=0 THEN GETRES MUST HAVE TERMINATED NORMALLY BLDKI938 C BLDKI939 IF (IRC.EQ.0) GO TO 120 BLDKI940 C BLDKI941 C AN END OR END OF DATA BANK HAS CAUSED TERMINATION BLDKI942 C MAKE SURE THE LAST ATOM WAS COMPLETED BLDKI943 C BLDKI944 IF (NSEROL.EQ.NSERCR(NALLCR)) GO TO 120 BLDKI945 IF (IUSCOM.EQ.IYES) CALL CALCOM (IACCML) BLDKI946 DO 110 J=1,NALLCR BLDKI947 110 CALL TRANSF (ATMXCR(J),ATMYCR(J),ATMZCR(J),XMIN,XMAX,ROT,TRLVEC) BLDKI948 CALL BUFOUT (KEY1,KEY2) BLDKI949 C BLDKI950 120 IF (IUSCOM.NE.IYES) GO TO 130 BLDKI951 C BLDKI952 C IF THE C.O.M. IS REQUIRED DIRECT CALCOM TO DEPOSIT THEM BLDKI953 C IN THE COMMON AREA PARMS BLDKI954 C BLDKI955 IACCML=2 BLDKI958 CALL CALCOM (IACCML) BLDKI959 GO TO 130 BLDKI960 C BLDKI961 C PRINT THE MODEL BLDKI962 C BLDKI963 130 CALL PRNOUT (XMIN,XMAX) BLDKI964 RETURN BLDKI965 END BLDKI966 SUBROUTINE TRANSF (X,Y,Z,XMIN,XMAX,ROT,TRL) BLDKI967 C BLDKI968 C THIS ROUTINE TRANSFORMS THE COORDINATES BLDKI969 C X,Y,Z CONTAIN THE COORDINATES ON INPUT BLDKI970 C AND THE TRANSFORMED SET ON OUTPUT BLDKI971 C XMIN MINIMUM VALUES FOR X,Y AND Z BLDKI972 C XMAX MAXIMUM VALUES FOR X,Y AND Z BLDKI973 C ROT TRANSFORMATION MATRIX BLDKI974 C TRLVEC TRANSLATION VECTOR BLDKI975 C BLDKI976 DIMENSION ROT(3,3), TRL(3), X1(3), X2(3) BLDKI977 DIMENSION XMIN(3), XMAX(3) BLDKI978 C BLDKI979 CALL VEC (X1,X,Y,Z) BLDKI980 CALL VECMUL (X1,ROT,X2) BLDKI981 CALL VECSUM (X2,TRL,X1) BLDKI982 C BLDKI983 DO 10 J=1,3 BLDKI984 10 CALL MAXMIN (XMIN(J),XMAX(J),X1(J)) BLDKI985 C BLDKI986 CALL UNVEC (X1,X,Y,Z) BLDKI987 RETURN BLDKI988 END BLDKI989 SUBROUTINE MAXMIN (WMIN,WMAX,W) BLDKI990 C BLDKI991 C CALCULATE XMIN AND XMAX BLDKI992 C BLDKI993 WMIN=AMIN1(WMIN,W) BLDKI994 WMAX=AMAX1(WMAX,W) BLDKI995 RETURN BLDKI996 END BLDKI997 SUBROUTINE INLIST (NCHN,NSEQ,IBEG,IEND,I,IRC) BLDKI998 C BLDKI999 C THIS ROUTINE CHECKS WHETHER THE RESIDUE GIVEN BY NSEQ IS IN THE BLDK1000 C CURRENT SEGMENT BLDK1001 C BLDK1002 C THE FOLLOWING VARIABLES ARE USED TO STORE CHARACTERS BLDK1003 C IBEG,NCHN,IBLANK BLDK1004 C BLDK1005 DIMENSION IBEG(2,25), IEND(25) BLDK1006 C BLDK1007 DATA IBLANK/1H / BLDK1008 C BLDK1009 IDEN(I,J)=I-J BLDK1010 C BLDK1011 IRC=3 BLDK1012 IF (IDEN(NCHN,IBEG(2,I)).EQ.0.OR.IDEN(IBEG(2,I),IBLANK).EQ.0) GO TBLDK1013 1O 10 BLDK1014 IRC=3 BLDK1015 GO TO 40 BLDK1016 C BLDK1017 10 IF (.NOT.(NSEQ.LT.IBEG(1,I))) GO TO 20 BLDK1018 IRC=3 BLDK1019 GO TO 40 BLDK1020 C BLDK1021 20 IF (.NOT.((NSEQ.GE.IBEG(1,I)).AND.(NSEQ.LE.IEND(I)))) GO TO 30 BLDK1022 IRC=0 BLDK1023 IF (NSEQ.EQ.IEND(I)) IRC=1 BLDK1024 GO TO 40 BLDK1025 C BLDK1026 30 IF (.NOT.(NSEQ.GT.IEND(I))) GO TO 40 BLDK1027 IRC=2 BLDK1028 GO TO 40 BLDK1029 C BLDK1030 40 RETURN BLDK1031 END BLDK1032 SUBROUTINE SETATM (NINC,INCATM,IBET) BLDK1033 C BLDK1034 C THIS ROUTINE LOADS THE ARRAY INCATM WITH BLDK1035 C THE ATOM NAMES TO BE USED. BLDK1036 C BLDK1037 C THE FOLLOWING VARIABLES ARE USED TO STORE CHARACTERS BLDK1038 C INCATM,IBONE BLDK1039 C BLDK1040 DIMENSION INCATM(20) BLDK1041 DIMENSION IBONE(5) BLDK1042 C BLDK1043 DATA IBONE/4H CA ,4H C ,4H N ,4H O ,4H CB / BLDK1044 C BLDK1045 NINC=4 BLDK1046 DO 10 I=1,4 BLDK1047 10 INCATM(I)=IBONE(I) BLDK1048 C BLDK1049 IF (IBET.EQ.0) GO TO 20 BLDK1050 NINC=5 BLDK1051 INCATM(NINC)=IBONE(5) BLDK1052 GO TO 20 BLDK1053 C BLDK1054 20 RETURN BLDK1055 END BLDK1056 SUBROUTINE PRNOUT (XMIN,XMAX) BLDK1057 C BLDK1058 C THIS ROUTINE PRODUCES THE FINAL OUTPUT FOR BUILDER*S KIT BLDKIT29 C BLDK1060 C TO SPEED UP THE PROGRAM INCREASE THE DIMENSIONS OF ILIST AND BLDK1061 C RLIST BLDK1062 C BLDK1063 C THE FOLLOWING VARIABLES ARE USED TO STORE CHARACTERS BLDK1064 C NRESCR,NCHNCR,INSCCR,NAMECR,NALTCR BLDK1065 C ISGBEG,NRESTB,IDSET,ITMP2 BLDK1066 C BLDK1067 C NOTE THAT THE ARRAY ILIST IS USED TO STORE CHARACTERS AND BLDK1068 C INTEGERS AND IT IS THEREFORE NECESSARY TO ENSURE THAT THE BLDK1069 C ELEMENTS OF THIS ARRAY CAN BE USED TO STORE UP TO 4 CHARACTERS BLDK1070 C BLDK1071 DIMENSION IBKBNE(25), INCBET(25), ISGBEG(2,25), ISGEND(25) BLDK1072 DIMENSION XMIN(3), XMAX(3) BLDK1073 DIMENSION ITMP1(500),ITMP2(500) BLDK1074 DIMENSION X1(3), X2(3) BLDK1075 DIMENSION ILIST(100), RLIST(100) BLDK1076 DIMENSION NRESTB(30), ISEQNM(500,3), NTOTNM(30) BLDK1077 DIMENSION NSERCR(100), NAMECR(100), NALTCR(100) BLDK1078 DIMENSION ATMXCR(100), ATMYCR(100), ATMZCR(100) BLDK1079 DIMENSION INCHET(25), TRLVEC(3), ROT(3,3), IBIAS(3) BLDK1080 C BLDK1081 COMMON /REALBF/ RLIST BLDK1082 COMMON /INTBUF/ ILIST BLDK1083 COMMON /HEADER/ IDSET BLDK1084 COMMON /CURRES/ NALLCR,NRESCR,NCHNCR,NSEQCR,INSCCR,NSERCR,NAMECR,NBLDK1085 1ALTCR,ATMXCR,ATMYCR,ATMZCR BLDK1086 COMMON /PARMS/ NSEG,IBKBNE,INCBET,ISGBEG,ISGEND,INCHET,SCALE,IUSCOBLDK1087 1M,XCOM,YCOM,ZCOM,ROT,TRLVEC,IBIAS BLDK1088 COMMON /SUMARY/ NTOT,NTOTRS,NTOTNM,NRSDIF,NRESTB,ISEQNM BLDK1089 C BLDK1090 DATA INEND/1/,LPTR/6/ BLDK1091 DATA MAXLIN/60/ BLDK1092 DATA MAXRES /500/ BLDK1093 C BLDK1094 IPAGE=1 BLDK1095 INIT=0 BLDK1096 KEY1=1 BLDK1097 KEY2=1 BLDK1098 CALL NEWPAG (IDSET,IPAGE) BLDK1099 LINENO=6 BLDK1100 ISG=1 BLDK1101 C BLDK1102 C BLDK1103 CALL VEC (X1,XCOM,YCOM,ZCOM) BLDK1104 CALL VECMUL (X1,ROT,X2) BLDK1105 C BLDK1106 CALL VECDIF (XMIN,X2,X1) BLDK1107 CALL CONMUL (X1,SCALE,XMIN) BLDK1108 C BLDK1109 CALL VECDIF (XMAX,X2,X1) BLDK1110 CALL CONMUL (X1,SCALE,XMAX) BLDK1111 C BLDK1112 C ADD BIASING INFORMATION BLDK1113 C BLDK1114 DO 20 I=1,3 BLDK1115 IF (IBIAS(I).EQ.0) GO TO 20 BLDK1116 IF (XMIN(I).LT.0.) GO TO 10 BLDK1117 C BLDK1118 C WE DO NOT NEED TO BIAS BLDK1119 C BLDK1120 IBIAS(I)=0 BLDK1121 GO TO 20 BLDK1122 C BLDK1123 10 IBIAS(I)=-IBIAS(I) BLDK1124 GO TO 20 BLDK1125 C BLDK1126 20 CONTINUE BLDK1127 C BLDK1128 WRITE (LPTR,160) ISG BLDK1129 CALL NEWLIN (IDSET,LINENO,IPAGE) BLDK1130 CALL NEWLIN (IDSET,LINENO,IPAGE) BLDK1131 C BLDK1132 C THIS LOOP PRODUCES THE LIST OF TRANSFORMED BLDK1133 C COORDINATES IN A CONVENIENT FORMAT BLDK1134 C BLDK1135 C READ THE ATOM LIST FROM THE BUFFERS BLDK1136 C BLDK1137 30 CALL BUFIN (KEY1,KEY2) BLDK1138 IF (KEY1.LT.0) GO TO 100 BLDK1139 C BLDK1140 C SEE IF WE HAVE TO GENERATE A NEW SEGMENT HEADER BLDK1141 C BLDK1142 40 CALL INLIST (NCHNCR,NSEQCR,ISGBEG,ISGEND,ISG,IRC) BLDK1143 C BLDK1144 IF (IRC.LE.INEND) GO TO 50 BLDK1145 C BLDK1146 C GENERATE A NEW SEGMENT HEADER BLDK1147 C BLDK1148 ISG=ISG+1 BLDK1149 LINENO=61 BLDK1150 CALL NEWLIN (IDSET,LINENO,IPAGE) BLDK1151 WRITE (LPTR,160) ISG BLDK1152 CALL NEWLIN (IDSET,LINENO,IPAGE) BLDK1153 CALL NEWLIN (IDSET,LINENO,IPAGE) BLDK1154 GO TO 40 BLDK1155 C BLDK1156 C DO THE FINAL TRANSFORMATION ON THE COORDINATES BLDK1157 C BLDK1158 50 DO 60 J=1,NALLCR BLDK1159 ATMXCR(J)=(ATMXCR(J)-X2(1))*SCALE+XMIN(1)*FLOAT(IBIAS(1)) BLDK1160 ATMYCR(J)=(ATMYCR(J)-X2(2))*SCALE+XMIN(2)*FLOAT(IBIAS(2)) BLDK1161 ATMZCR(J)=(ATMZCR(J)-X2(3))*SCALE+XMIN(3)*FLOAT(IBIAS(3)) BLDK1162 60 CONTINUE BLDK1163 C BLDK1164 C MAKE SURE THAT THE WHOLE RESIDUE WILL FIT IN THE REMAINING BLDK1165 C SPACE IN THE CURRENT PAGE BLDK1166 C BLDK1167 IF (.NOT.((LINENO+5+NALLCR).GT.60)) GO TO 70 BLDK1168 LINENO=61 BLDK1169 CALL NEWLIN (IDSET,LINENO,IPAGE) BLDK1170 GO TO 70 BLDK1171 C BLDK1172 70 WRITE (LPTR,170) NRESCR,NCHNCR,NSEQCR,INSCCR BLDK1173 DO 80 J=1,5 BLDK1174 80 CALL NEWLIN (IDSET,LINENO,IPAGE) BLDK1175 C BLDK1176 DO 90 J=1,NALLCR BLDK1177 WRITE (LPTR,180) NAMECR(J),NALTCR(J),ATMXCR(J),ATMYCR(J),ATMZCR(J)BLDK1178 CALL NEWLIN (IDSET,LINENO,IPAGE) BLDK1179 90 CONTINUE BLDK1180 C BLDK1181 C ACCUMULATE INFORMATION REQUIRED TO DO A SUMMARY BLDK1182 C LIST BLDK1183 C BLDK1184 CALL COLSUM (INIT) BLDK1185 GO TO 30 BLDK1186 C BLDK1187 C WRITE OUT A SUMMARY OF THE PRINTED LIST BLDK1188 C BLDK1189 100 CONTINUE BLDK1190 LINENO=MAXLIN+1 BLDK1191 CALL NEWLIN (IDSET,LINENO,IPAGE) BLDK1192 C BLDK1193 WRITE (LPTR,190) NTOTRS BLDK1194 WRITE (LPTR,200) NTOT BLDK1195 WRITE (LPTR,210) XCOM,YCOM,ZCOM BLDK1196 WRITE (LPTR,220) (XMIN(I),I=1,3),(XMAX(I),I=1,3) BLDK1197 C BLDK1198 C WRITE OUT A LIST OF RESIDUE OCCURENCES BLDK1199 C BLDK1200 C IF THERE ARE MORE THAN MAXRES RESIDUES BYPASS THE PRINTOUT BLDK1201 C OF THE SUMMARY LIST. BLDK1202 C BLDK1203 IF (NTOTRS .GT. MAXRES ) GO TO 155 BLDK1204 C BLDK1205 LINENO=MAXLIN+1 BLDK1206 CALL NEWLIN (IDSET,LINENO,IPAGE) BLDK1207 WRITE (LPTR,230) BLDK1208 CALL NEWLIN (IDSET,LINENO,IPAGE) BLDK1209 CALL NEWLIN (IDSET,LINENO,IPAGE) BLDK1210 CALL NEWLIN (IDSET,LINENO,IPAGE) BLDK1211 DO 150 I=1,NRSDIF BLDK1212 K=0 BLDK1213 J=0 BLDK1214 K1=NTOTNM(I) BLDK1215 110 J=J+1 BLDK1216 IF (J.GT.NTOTRS.OR.K.GT.NTOTNM(I)) GO TO 120 BLDK1217 IF (ISEQNM(J,1).NE.I) GO TO 110 BLDK1218 K=K+1 BLDK1219 C BLDK1220 ITMP1(K)=ISEQNM(J,2) BLDK1221 ITMP2(K)=ISEQNM(J,3) BLDK1222 GO TO 110 BLDK1223 C BLDK1224 C FIND OUT HOW MANY LINES OF OUTPUT ARE NEEDED BLDK1225 C BLDK1226 120 NDIVE=NTOTNM(I)/8+2 BLDK1227 IF ((NDIVE+LINENO).LE.MAXLIN) GO TO 130 BLDK1228 LINENO=MAXLIN+1 BLDK1229 CALL NEWLIN (IDSET,LINENO,IPAGE) BLDK1230 GO TO 130 BLDK1231 C BLDK1232 130 WRITE (LPTR,240) NTOTNM(I),NRESTB(I),(ITMP1(K),ITMP2(K),K=1,K1) BLDK1233 DO 140 J=1,NDIVE BLDK1234 140 CALL NEWLIN (IDSET,LINENO,IPAGE) BLDK1235 GO TO 150 BLDK1236 150 CONTINUE BLDK1237 C BLDK1238 C WRITE AN END OF FILE ON LPTR BEFORE RETURNING, THIS WILL BLDK1239 C HANDLE THE CASE OF MULTIFILE RUNS BLDK1240 C BLDK1241 155 ENDFILE LPTR BLDK1242 RETURN BLDK1243 C BLDK1244 160 FORMAT (29X,7HSEGMENT,2X,I5,/) BLDK1245 170 FORMAT (//,10X,A3,1X,A1,1X,I4,A1,//) BLDK1246 180 FORMAT (10X,A4,2X,A1,3X,3(F10.1,5X)) BLDK1247 190 FORMAT (32H0 TOTAL NUMBER OF RESIDUES READ ,I5) BLDK1248 200 FORMAT (29H0 TOTAL NUMBER OF ATOMS READ ,I5) BLDK1249 210 FORMAT (56H0 CENTER OF MASS COORDINATES IN UNTRANSFORMED ANGS. UNIBLDK1250 1T,/,10X,3F8.3) BLDK1251 220 FORMAT (56H0 MINIMUM AND MAXIMIM TRANSFORMED AND SCALED COORDINATEBLDK1252 1S,/,5X,17H(XMIN,YMIN,ZMIN) ,2X,3F10.1,/,5X,17H(XMAX,YMAX,ZMAX) ,2XBLDK1253 2,3F10.1) BLDK1254 230 FORMAT (31H0 SUMMARY OF RESIDUE OCCURENCES,/,1X,5HTOTAL,2X,3HRES,5BLDK1255 1X,16HSEQUENCE NUMBERS,/) BLDK1256 240 FORMAT (/,1X,I5,2X,A3,5X,8(I4,A1,2X),/,(16X,8(I4,A1,2X))) BLDK1257 END BLDK1258 SUBROUTINE COLSUM (INIT) BLDK1259 C BLDK1260 C THIS ROUTINE ACCUMULATES ALL THE INFORMATION BLDK1261 C TO BE PRINTED OUT AS A SUMMARY OF A RUN. BLDK1262 C THESE VARIABLES ARE STORED IN THE COMMON AREA SUMARY. BLDK1263 C BLDK1264 C THE FOLLOWING VARIABLES ARE USED TO STORE CHARACTERS BLDK1265 C NRESCR,NCHNCR,INSCCR,NAMECR,NALTCR BLDK1266 C NRESTB,IBLANK BLDK1267 C BLDK1268 DIMENSION NRESTB(30), ISEQNM(500,3), NTOTNM(30) BLDK1269 DIMENSION NSERCR(100), NAMECR(100), NALTCR(100) BLDK1270 DIMENSION ATMXCR(100), ATMYCR(100), ATMZCR(100) BLDK1271 C BLDK1272 COMMON /CURRES/ NALLCR,NRESCR,NCHNCR,NSEQCR,INSCCR,NSERCR,NAMECR,NBLDK1273 1ALTCR,ATMXCR,ATMYCR,ATMZCR BLDK1274 C BLDK1275 COMMON /SUMARY/ NTOT,NTOTRS,NTOTNM,NRSDIF,NRESTB,ISEQNM BLDK1276 C BLDK1277 DATA IBLANK/3H / BLDK1278 DATA MAXRES /500/ BLDK1279 C BLDK1280 IDEN(I,J)=I-J BLDK1281 C BLDK1282 IF (INIT.NE.0) GO TO 20 BLDK1283 INIT=1 BLDK1284 NTOT=0 BLDK1285 NTOTRS=0 BLDK1286 NRSDIF=0 BLDK1287 DO 10 J=1,30 BLDK1288 NTOTNM(J)=0 BLDK1289 10 NRESTB(J)=IBLANK BLDK1290 GO TO 20 BLDK1291 C BLDK1292 20 NTOT=NTOT+NALLCR BLDK1293 NTOTRS=NTOTRS+1 BLDK1294 IF ( NTOTRS .GT. MAXRES ) GO TO 60 BLDK1295 C BLDK1296 IF (NRSDIF.LE.0) GO TO 40 BLDK1297 C BLDK1298 DO 30 J=1,NRSDIF BLDK1299 IF (IDEN(NRESCR,NRESTB(J)).EQ.0) GO TO 50 BLDK1300 30 CONTINUE BLDK1301 C BLDK1302 C HAVE NOT FOUND THIS RESIDUE IN NRESTB BLDK1303 C BLDK1304 40 NRSDIF=NRSDIF+1 BLDK1305 NRESTB(NRSDIF)=NRESCR BLDK1306 J=NRSDIF BLDK1307 GO TO 50 BLDK1308 C BLDK1309 50 NTOTNM(J)=NTOTNM(J)+1 BLDK1310 ISEQNM(NTOTRS,1)=J BLDK1311 ISEQNM(NTOTRS,2)=NSEQCR BLDK1312 ISEQNM(NTOTRS,3)=INSCCR BLDK1313 GO TO 60 BLDK1314 C BLDK1315 60 RETURN BLDK1316 END BLDK1317 SUBROUTINE BUFIN (KEY1,KEY2) BLDK1318 C BLDK1319 C THIS ROUTINE LOADS CURRES WITH THE CONTENTS OF BUFFER BLDK1320 C BLDK1321 C TO SPEED UP THE PROGRAM INCREASE THE DIMENSIONS OF ILIST AND BLDK1322 C RLIST. BLDK1323 C THE FOLLOWING VARIABLES ARE USED TO STORE CHARACTERS BLDK1324 C NRESCR,NCHNCR,INSCCR,NAMECR,NALTCR BLDK1325 C BLDK1326 C NOTE THAT THE ARRAY ILIST IS USED TO STORE CHARACTERS AND BLDK1327 C INTEGERS AND IT IS THEREFORE NECESSARY TO ENSURE THAT THE BLDK1328 C ELEMENTS OF THIS ARRAY CAN BE USED TO STORE UP TO 4 CHARACTERS BLDK1329 C BLDK1330 DIMENSION NSERCR(100), NAMECR(100), NALTCR(100) BLDK1331 DIMENSION ATMXCR(100), ATMYCR(100), ATMZCR(100) BLDK1332 DIMENSION RLIST(100), ILIST(100) BLDK1333 C BLDK1334 COMMON /CURRES/ NALLCR,NRESCR,NCHNCR,NSEQCR,INSCCR,NSERCR,NAMECR,NBLDK1335 1ALTCR,ATMXCR,ATMYCR,ATMZCR BLDK1336 C BLDK1337 COMMON /REALBF/ RLIST BLDK1338 COMMON /INTBUF/ ILIST BLDK1339 C BLDK1340 EQUIVALENCE (ILIST(1),NENTRY), (ILIST(2),INTOVF), (ILIST(3),IRLOVFBLDK1341 1) BLDK1342 EQUIVALENCE (ILIST(4),IOUTOF) BLDK1343 C BLDK1344 DATA ITAPE2/2/,ITAPE3/3/ BLDK1345 C BLDK1346 IF (NENTRY.EQ.0) GO TO 80 BLDK1347 C BLDK1348 IOUTOF=IOUTOF+1 BLDK1349 C BLDK1350 C MAKE SURE WE STILL HAVE SOMETHING TO READ BLDK1351 C BLDK1352 IF (IOUTOF.LE.NENTRY) GO TO 10 BLDK1353 KEY1=-1 BLDK1354 GO TO 80 BLDK1355 C BLDK1356 C FIRST TIME INTO ROUTINE REWIND BUFFER TAPES BLDK1357 C BLDK1358 10 IF (IOUTOF.NE.1) GO TO 20 BLDK1359 END FILE ITAPE2 BLDK1360 END FILE ITAPE3 BLDK1361 REWIND ITAPE2 BLDK1362 REWIND ITAPE3 BLDK1363 KEY1=5 BLDK1364 KEY2=1 BLDK1365 GO TO 20 BLDK1366 C BLDK1367 C SEE IF WE HAVE TO READ FROM DISK BLDK1368 C BLDK1369 20 IF (IOUTOF.GE.INTOVF) GO TO 40 BLDK1370 C BLDK1371 C DATA IS IN-CORE FOR INTEGER BUFFER BLDK1372 C BLDK1373 NALLCR=ILIST(KEY1) BLDK1374 NRESCR=ILIST(KEY1+1) BLDK1375 NCHNCR=ILIST(KEY1+2) BLDK1376 NSEQCR=ILIST(KEY1+3) BLDK1377 INSCCR=ILIST(KEY1+4) BLDK1378 KEY1=KEY1+5 BLDK1379 C BLDK1380 DO 30 J=1,NALLCR BLDK1381 NSERCR(J)=ILIST(KEY1) BLDK1382 NAMECR(J)=ILIST(KEY1+1) BLDK1383 NALTCR(J)=ILIST(KEY1+2) BLDK1384 KEY1=KEY1+3 BLDK1385 30 CONTINUE BLDK1386 GO TO 50 BLDK1387 C BLDK1388 C READ FROM DISK BLDK1389 C BLDK1390 40 READ (ITAPE2) NALLCR,NRESCR,NCHNCR,NSEQCR,INSCCR BLDK1391 READ (ITAPE2) (NSERCR(J),NAMECR(J),NALTCR(J),J=1,NALLCR) BLDK1392 GO TO 50 BLDK1393 C BLDK1394 50 IF (IOUTOF.GE.IRLOVF) GO TO 70 BLDK1395 C BLDK1396 C DATA IS IN-CORE FOR REAL BUFFER BLDK1397 C BLDK1398 DO 60 J=1,NALLCR BLDK1399 ATMXCR(J)=RLIST(KEY2) BLDK1400 ATMYCR(J)=RLIST(KEY2+1) BLDK1401 ATMZCR(J)=RLIST(KEY2+2) BLDK1402 KEY2=KEY2+3 BLDK1403 60 CONTINUE BLDK1404 GO TO 80 BLDK1405 C BLDK1406 70 READ (ITAPE3) (ATMXCR(J),ATMYCR(J),ATMZCR(J),J=1,NALLCR) BLDK1407 GO TO 80 BLDK1408 C BLDK1409 80 RETURN BLDK1410 END BLDK1411 SUBROUTINE BUFOUT (KEY1,KEY2) BLDK1412 C BLDK1413 C THIS ROUTINE MAINTAINS A BUFFER LIST FOR CURRES. BLDK1414 C TWO BUFFER AREAS ARE MAINTAINED, ONE FOR REAL NUMBERS BLDK1415 C AND THE OTHER FOR INTEGERS. BLDK1416 C BLDK1417 C TO SPEED UP THE PROGRAM INCREASE THE DIMENSIONS OF ILIST AND BLDK1418 C RLIST. BLDK1419 C SET THE VALUE OF MAXBUF TO THIS NEW DIMENSION. BLDK1420 C BLDK1421 C THE FOLLOWING VARIABLES ARE USED TO STORE CHARACTERS BLDK1422 C NRESCR,NCHNCR,INSCCR,NAMECR,NALTCR BLDK1423 C BLDK1424 C NOTE THAT THE ARRAY ILIST IS USED TO STORE CHARACTERS AND BLDK1425 C INTEGERS AND IT IS THEREFORE NECESSARY TO INSURE THAT THE BLDK1426 C ELEMENTS OF THIS ARRAY CAN BE USED TO STORE UP TO 4 CHARACTERS BLDK1427 C BLDK1428 DIMENSION RLIST(100), ILIST(100) BLDK1429 DIMENSION NSERCR(100), NAMECR(100), NALTCR(100) BLDK1430 DIMENSION ATMXCR(100), ATMYCR(100), ATMZCR(100) BLDK1431 C BLDK1432 COMMON /CURRES/ NALLCR,NRESCR,NCHNCR,NSEQCR,INSCCR,NSERCR,NAMECR,NBLDK1433 1ALTCR,ATMXCR,ATMYCR,ATMZCR BLDK1434 C BLDK1435 COMMON /REALBF/ RLIST BLDK1436 COMMON /INTBUF/ ILIST BLDK1437 C BLDK1438 EQUIVALENCE (ILIST(1),NENTRY), (ILIST(2),INTOVF), (ILIST(3),IRLOVFBLDK1439 1) BLDK1440 EQUIVALENCE (ILIST(4),IOUTOF) BLDK1441 C BLDK1442 DATA MAXBUF/100/,ITAPE2/2/,ITAPE3/3/ BLDK1443 C BLDK1444 IF (KEY1.NE.1) GO TO 10 BLDK1445 C BLDK1446 C INITIAL ENTRY INTO ROUTINE BLDK1447 C BLDK1448 KEY1=5 BLDK1449 KEY2=1 BLDK1450 NENTRY=0 BLDK1451 INTOVF=9999999 BLDK1452 IRLOVF=9999999 BLDK1453 IOUTOF=0 BLDK1454 REWIND ITAPE2 BLDK1455 REWIND ITAPE3 BLDK1456 GO TO 10 BLDK1457 C BLDK1458 C WRITE OUT THE INTEGER LIST BLDK1459 C SEE HOW MUCH ROOM WE NEED FOR THIS ENTRY BLDK1460 C BLDK1461 10 NENTRY=NENTRY+1 BLDK1462 INEED=3*NALLCR+5 BLDK1463 IF ((KEY1+INEED).GT.MAXBUF) GO TO 30 BLDK1464 C BLDK1465 C WE HAVE ENOUGH ROOM IN CORE BLDK1466 C BLDK1467 ILIST(KEY1)=NALLCR BLDK1468 ILIST(KEY1+1)=NRESCR BLDK1469 ILIST(KEY1+2)=NCHNCR BLDK1470 ILIST(KEY1+3)=NSEQCR BLDK1471 ILIST(KEY1+4)=INSCCR BLDK1472 KEY1=KEY1+5 BLDK1473 C BLDK1474 DO 20 J=1,NALLCR BLDK1475 ILIST(KEY1)=NSERCR(J) BLDK1476 ILIST(KEY1+1)=NAMECR(J) BLDK1477 ILIST(KEY1+2)=NALTCR(J) BLDK1478 KEY1=KEY1+3 BLDK1479 20 CONTINUE BLDK1480 GO TO 50 BLDK1481 C BLDK1482 C WE HAVE TO WRITE THIS ENTRY IN THE SCRATCH FILE BLDK1483 C BLDK1484 30 IF (INTOVF.LT.9999999) GO TO 40 BLDK1485 INTOVF=NENTRY BLDK1486 GO TO 40 BLDK1487 C BLDK1488 C BLDK1489 40 WRITE (ITAPE2) NALLCR,NRESCR,NCHNCR,NSEQCR,INSCCR BLDK1490 WRITE (ITAPE2) (NSERCR(J),NAMECR(J),NALTCR(J),J=1,NALLCR) BLDK1491 KEY1=KEY1+INEED BLDK1492 GO TO 50 BLDK1493 C BLDK1494 C WRITE OUT THE REAL PART OF CURRES BLDK1495 C BLDK1496 50 INEED=3*NALLCR BLDK1497 IF ((KEY2+INEED).GT.MAXBUF) GO TO 70 BLDK1498 C BLDK1499 C WE HAVE ENOUGH ROOM BLDK1500 C BLDK1501 DO 60 J=1,NALLCR BLDK1502 RLIST(KEY2)=ATMXCR(J) BLDK1503 RLIST(KEY2+1)=ATMYCR(J) BLDK1504 RLIST(KEY2+2)=ATMZCR(J) BLDK1505 KEY2=KEY2+3 BLDK1506 60 CONTINUE BLDK1507 GO TO 90 BLDK1508 C BLDK1509 C BLDK1510 70 IF (IRLOVF.LT.9999999) GO TO 80 BLDK1511 IRLOVF=NENTRY BLDK1512 GO TO 80 BLDK1513 C BLDK1514 80 WRITE (ITAPE3) (ATMXCR(J),ATMYCR(J),ATMZCR(J),J=1,NALLCR) BLDK1515 KEY2=KEY2+INEED BLDK1516 GO TO 90 BLDK1517 C BLDK1518 90 RETURN BLDK1519 END BLDK1520 SUBROUTINE EULER (ALP,BET,GAM,ROT) BLDK1521 C BLDK1522 C THIS ROUTINE RETURNS THE MATRIX OF TRANSFORMATION AS BLDK1523 C SPECIFIED BY THE EULERIAN ANGLES ALP,BET,GAM BLDK1524 C BLDK1525 C BLDK1526 C TO USE A DIFFERENT CONVENTION ALL THAT IS REQUIRED IS TO BLDK1527 C REORDER THE CALLS TO ROTMAT, USING THE ORDER SPECIFIED BY THE BLDK1528 C NEW CONVENTION. BLDK1529 C FOR EXAMPLE, TO USE THE CONVENTION, BLDK1530 C 1. ROTATE ABOUT Z BLDK1531 C 2. THEN ROTATE ABOUT NEW Y BLDK1532 C 3. THEN ROTATE ABOUT NEWEST Z BLDK1533 C USE THE FOLLOWING CODE BLDK1534 C BLDK1535 C CALL ROTMAT(AXIS(1),ALP,T1) BLDK1536 C CALL ROTMAT(AXIS(2),BET,T2) BLDK1537 C CALL MATMUL(T2,T1,ROT) BLDK1538 C CALL ROTMAT(AXIS(1),GAM,T1) BLDK1539 C CALL MATMUL(T1,ROT,T2) BLDK1540 C CALL CPYMAT(T2,ROT) BLDK1541 C BLDK1542 DIMENSION ROT(9), T1(9), T2(9) BLDK1543 DIMENSION AXIS(5) BLDK1544 C BLDK1545 DATA AXIS/0.0,0.0,1.0,0.0,0.0/ BLDK1546 DATA RAD/0.017453/ BLDK1547 C BLDK1548 ALP=ALP*RAD BLDK1549 BET=BET*RAD BLDK1550 GAM=GAM*RAD BLDK1551 C BLDK1552 C ROTATE ABOUT Z BLDK1553 C BLDK1554 CALL ROTMAT (AXIS(1),ALP,T1) BLDK1555 C BLDK1556 C ROTATE ABOUT NEW X BLDK1557 C BLDK1558 CALL ROTMAT (AXIS(3),BET,T2) BLDK1559 C BLDK1560 C CONCATENATE MATRICES BLDK1561 C BLDK1562 CALL MATMUL (T2,T1,ROT) BLDK1563 C BLDK1564 C ROTATE ABOUT NEWEST Z AXIS BLDK1565 C BLDK1566 CALL ROTMAT (AXIS(1),GAM,T1) BLDK1567 C BLDK1568 C CONCATENATE WITH THE EARLIER OPERATION BLDK1569 C BLDK1570 CALL MATMUL (T1,ROT,T2) BLDK1571 CALL CPYMAT (T2,ROT) BLDK1572 RETURN BLDK1573 END BLDK1574 SUBROUTINE GENROT (V1,V2,ANG,AMAT,TRAN) BLDK1575 DIMENSION X(3), Y(3) BLDK1576 CALL VECDIF (V1,V2,X) BLDK1577 CALL ROTMAT (X,ANG,AMAT) BLDK1578 CALL VECMUL (V1,AMAT,Y) BLDK1579 CALL VECDIF (V1,Y,TRAN) BLDK1580 RETURN BLDK1581 END BLDK1582 SUBROUTINE VECDIF (X,Y,Z) BLDK1583 C ----SUBTRACT TWO VECTORS AND RETURN THE RESULT IN Z BLDK1584 DIMENSION X(3), Y(3), Z(3) BLDK1585 DO 10 I=1,3 BLDK1586 Z(I)=X(I)-Y(I) BLDK1587 10 CONTINUE BLDK1588 RETURN BLDK1589 END BLDK1590 SUBROUTINE ROTMAT (V,ANG,AMAT) BLDK1591 C ----SUBROUTINE TO RETURN A ROTATION MATRIX GIVEN A VECTOR AND AN ABLDK1592 C OF ROTATION ABOUT THE VECTOR BLDK1593 C ***EXAMPLE OF USE*** BLDK1594 C TO ROTATE VECTORS A(1),A(4),A(7) IN A RIGHT-HANDED SENSE ABOUT BLDK1595 C THE VECTOR F-G BLDK1596 C CALL VECDIF(G,F,P) BLDK1597 C CALL ROTMAT (P,ANG,AMAT) BLDK1598 C DO 1000 I=1,9,3 BLDK1599 C CALL VECDIF (A(I),F,X) BLDK1600 C CALL VECMUL (X,AMAT,Y) BLDK1601 C CALL VECSUM (Y,F,A(I)) BLDK1602 C 1000 CONTINUE BLDK1603 DIMENSION X(3) BLDK1604 DIMENSION V(3) BLDK1605 DIMENSION AXIS(5) BLDK1606 DIMENSION AMAT(9), BMAT(9) BLDK1607 DATA AXIS/0.0,0.0,1.0,0.0,0.0/ BLDK1608 SINANG=SIN(ANG) BLDK1609 COSANG=COS(ANG) BLDK1610 J=4 BLDK1611 CALL UNIT (V,X) BLDK1612 DO 10 I=1,9,3 BLDK1613 J=J-1 BLDK1614 CALL SUBROT (X,AXIS(J),SINANG,COSANG,BMAT(I)) BLDK1615 10 CONTINUE BLDK1616 CALL TRNSPZ (BMAT,AMAT) BLDK1617 RETURN BLDK1618 END BLDK1619 SUBROUTINE VECMUL (X,UB,H) BLDK1620 C ----MULTIPLY A VECTOR TIMES A MATRIX AND RETURN BLDK1621 C THE NEW VECTOR IN H BLDK1622 DIMENSION UB(9) BLDK1623 DIMENSION H(3), X(3) BLDK1624 J=0 BLDK1625 DO 10 I=1,9,3 BLDK1626 J=J+1 BLDK1627 H(J)=DOT(UB(I),X) BLDK1628 10 CONTINUE BLDK1629 RETURN BLDK1630 END BLDK1631 SUBROUTINE UNIT (X,Y) BLDK1632 C ----RETURN A VECTOR Y WHICH IS THE DIRECTION COSINES OF X BLDK1633 DIMENSION X(3), Y(3) BLDK1634 D=AMAG(X) BLDK1635 IF (D-1.0E-10) 20,20,10 BLDK1636 10 D=1.0/D BLDK1637 CALL CONMUL (X,D,Y) BLDK1638 20 RETURN BLDK1639 END BLDK1640 FUNCTION AMAG (X) BLDK1641 C ----GET AND RETURN THE MAGNITUDE OF A VECTOR X BLDK1642 DIMENSION X(3) BLDK1643 AMAG=DOT(X,X) BLDK1644 AMAG=SQRT(AMAG) BLDK1645 RETURN BLDK1646 END BLDK1647 FUNCTION DOT (X,Y) BLDK1648 C ----COMPUTE AND RETURN THE DOT PRODUCT OF X AND Y BLDK1649 DIMENSION X(3), Y(3) BLDK1650 DOT=0.0 BLDK1651 DO 10 I=1,3 BLDK1652 DOT=DOT+X(I)*Y(I) BLDK1653 10 CONTINUE BLDK1654 RETURN BLDK1655 END BLDK1656 SUBROUTINE SUBROT (V,AXIS,SINANG,COSANG,ROW) BLDK1657 DIMENSION V(3) BLDK1658 DIMENSION X(3), Y(3) BLDK1659 CALL CROSS (V,AXIS,X) BLDK1660 IF (AMAG(X)-1.0E-8) 20,20,10 BLDK1661 10 CALL CROSS (X,V,Y) BLDK1662 CALL CONMUL (X,SINANG,X) BLDK1663 CALL CONMUL (Y,COSANG,Y) BLDK1664 CALL VECSUM (X,Y,X) BLDK1665 F=DOT(V,AXIS) BLDK1666 CALL CONMUL (V,F,Y) BLDK1667 CALL VECSUM (X,Y,ROW) BLDK1668 C ----THIS CALL TO UNIT IS ONLY TO REMOVE ROUNDING ERRORS BLDK1669 CALL UNIT (ROW,ROW) BLDK1670 GO TO 30 BLDK1671 20 CALL CPYVEC (AXIS,ROW) BLDK1672 30 RETURN BLDK1673 END BLDK1674 SUBROUTINE CROSS (X,Y,Z) BLDK1675 C ----COMPUTE Z = X CROSS Y BLDK1676 DIMENSION X(3), Y(3), Z(3) BLDK1677 Z(1)=X(2)*Y(3)-Y(2)*X(3) BLDK1678 Z(2)=-X(1)*Y(3)+Y(1)*X(3) BLDK1679 Z(3)=X(1)*Y(2)-Y(1)*X(2) BLDK1680 RETURN BLDK1681 END BLDK1682 SUBROUTINE VECSUM (X,Y,Z) BLDK1683 C ----ADD TWO VECTORS AND RETURN THE SUM IN Z BLDK1684 DIMENSION X(3), Y(3), Z(3) BLDK1685 DO 10 I=1,3 BLDK1686 Z(I)=X(I)+Y(I) BLDK1687 10 CONTINUE BLDK1688 RETURN BLDK1689 END BLDK1690 SUBROUTINE CPYVEC (X,Y) BLDK1691 C ----COPY A VECTOR X INTO A VECTOR Y BLDK1692 DIMENSION X(3), Y(3) BLDK1693 DO 10 I=1,3 BLDK1694 Y(I)=X(I) BLDK1695 10 CONTINUE BLDK1696 RETURN BLDK1697 END BLDK1698 SUBROUTINE TRNSPZ (A,B) BLDK1699 C ----PUT THE TRANSPOSE OF A INTO B BLDK1700 DIMENSION A(9), B(9) BLDK1701 J=0 BLDK1702 DO 10 I=1,9,3 BLDK1703 J=J+1 BLDK1704 CALL UNVEC (A(I),B(J),B(J+3),B(J+6)) BLDK1705 10 CONTINUE BLDK1706 RETURN BLDK1707 END BLDK1708 SUBROUTINE CPYMAT (A,B) BLDK1709 C ----COPY MATRIX A INTO MATRIX B BLDK1710 DIMENSION A(9), B(9) BLDK1711 DO 10 I=1,9,3 BLDK1712 CALL CPYVEC (A(I),B(I)) BLDK1713 10 CONTINUE BLDK1714 RETURN BLDK1715 END BLDK1716 SUBROUTINE CONMUL (X,A,Y) BLDK1717 C ----MULTIPLY A VECTOR TIMES A SCALAR BLDK1718 DIMENSION X(3), Y(3) BLDK1719 DO 10 I=1,3 BLDK1720 Y(I)=A*X(I) BLDK1721 10 CONTINUE BLDK1722 RETURN BLDK1723 END BLDK1724 SUBROUTINE MAT (AMAT,A,B,C) BLDK1725 DIMENSION AMAT(9) BLDK1726 CALL CPYVEC (A,AMAT(1)) BLDK1727 CALL CPYVEC (B,AMAT(4)) BLDK1728 CALL CPYVEC (C,AMAT(7)) BLDK1729 RETURN BLDK1730 END BLDK1731 SUBROUTINE VEC (X,A,B,C) BLDK1732 C ----COMPOSE A VECTOR X FROM THREE SCALARS BLDK1733 DIMENSION X(3) BLDK1734 X(1)=A BLDK1735 X(2)=B BLDK1736 X(3)=C BLDK1737 RETURN BLDK1738 END BLDK1739 SUBROUTINE UNVEC (X,F,G,H) BLDK1740 C ----RETURN THE VECTOR COMPONENTS AS SCALARS BLDK1741 DIMENSION X(3) BLDK1742 F=X(1) BLDK1743 G=X(2) BLDK1744 H=X(3) BLDK1745 RETURN BLDK1746 END BLDK1747 SUBROUTINE SPHROT (PHI,PSI,OME,ROT) BLDK1748 C BLDK1749 DIMENSION ROT(3,3) BLDK1750 C BLDK1751 DATA RAD/.017453/ BLDK1752 CPHI=COS(PHI*RAD) BLDK1753 CPSI=COS(PSI*RAD) BLDK1754 CKAP=COS(OME*RAD) BLDK1755 SPHI=SIN(PHI*RAD) BLDK1756 SPSI=SIN(PSI*RAD) BLDK1757 SKAP=SIN(OME*RAD) BLDK1758 CDIF=1.0-CKAP BLDK1759 C BLDK1760 ROT(1,1)=CKAP+CDIF*(CPHI**2)*(SPSI**2) BLDK1761 ROT(2,1)=CDIF*SPHI*CPHI*(SPSI**2)-SKAP*CPSI BLDK1762 ROT(3,1)=CDIF*CPSI*SPSI*CPHI+SPSI*SPHI*SKAP BLDK1763 C BLDK1764 ROT(1,2)=CDIF*SPHI*CPHI*(SPHI**2)+CPSI*SKAP BLDK1765 ROT(2,2)=CKAP+(SPHI**2)*(SPSI**2)*CDIF BLDK1766 ROT(3,2)=CPSI*SPSI*SPHI*CDIF-CPHI*SPSI*SKAP BLDK1767 C BLDK1768 ROT(1,3)=CPHI*SPSI*CPSI*CDIF-SPHI*SPSI*SKAP BLDK1769 ROT(2,3)=SPHI*SPSI*CPSI*CDIF+CPHI*SPSI*SKAP BLDK1770 ROT(3,3)=CKAP+(CPSI**2)*CDIF BLDK1771 C BLDK1772 RETURN BLDK1773 END BLDK1774 SUBROUTINE GETREC (IBUF,JCODE) BLDK1775 C BLDK1776 C ROUTINE NAME GETREC BLDK1777 C THIS ROUTINE READS A RECORD FROM THE INPUT FILE IPDB. BLDK1778 C AND ASSIGNS AN INTEGER CODE TO JCODE DEPENDING ON RECORD TYPE BLDK1779 C BLDK1780 C BLDK1781 C PRESENT CODE RECOGNIZES 27 RECORD TYPES BLDK1782 C JCODE IS SET TO -999 FOR UNRECOGNIZED RECORD TYPES BLDK1783 C AND TO -100 FOR END OF FILE BLDK1784 C AND TO -50 FOR DOUBLE END OF FILE BLDK1785 C BLDK1786 C THE FOLLOWING VARIABLES ARE USED TO STORE CHARACTERS BLDK1787 C IBUF,ITYP,IATOM,IHET,IREMA BLDK1788 C BLDK1789 C BLDK1790 DIMENSION IBUF(20) BLDK1791 DIMENSION ITYP(27) BLDK1792 DIMENSION NTYP(27) BLDK1793 C BLDK1794 COMMON /GTRLCL/ IEOF BLDK1795 C BLDK1796 C BLDK1797 DATA ITYP/4HHEAD,4HCOMP,4HSOUR,4HAUTH,4HJRNL,4HREMA,4HFTNO,4HHET ,BLDK1798 14HHELI,4HSHEE,4HTURN,4HSITE,4HCRYS,4HORIG,4HSCAL,4HMTRI,4HATOM,4HTBLDK1799 2ER ,4HCONE,4HMAST,4HEND ,4HSEQR,4HSSBO,4HFORM,4HTVEC,4HHETA,4HSIGABLDK1800 3/ BLDK1801 C BLDK1802 DATA NTYP/1,2,3,4,5,6,7,8,9,10,11,12,13,15,19,23,27,28,29,30,31,32BLDK1803 1,33,34,35,36,37/ BLDK1804 C BLDK1805 DATA IPDB/1/,ISTART/0/ BLDK1806 C BLDK1807 DATA IATOM/4HATOM/,IHET/4HHETA/,IREMA/4HREMA/ BLDK1808 C BLDK1809 IDEN(I,J)=I-J BLDK1810 C BLDK1811 IF (ISTART.NE.0) GO TO 10 BLDK1812 IEOF=0 BLDK1813 ISTART=1 BLDK1814 GO TO 10 BLDK1815 C BLDK1816 10 NUNIQT=27 BLDK1817 JCODE=-999 BLDK1818 C BLDK1819 C BLDK1820 READ (IPDB,110) IBUF BLDK1821 IF (EOF(IPDB)) 80,20 BLDK1822 C BLDK1823 C THESE IF STATEMENTS ARE FOR SPEED UP PURPOSES BLDK1824 C SINCE THE MAJORITY OF CARDS WILL BE ONE OF THESE BLDK1825 C BLDK1826 20 IEOF=0 BLDK1827 C BLDK1828 C CHECK FOR ATOM TYPE BLDK1829 C BLDK1830 IF (IDEN(IBUF(1),IATOM).NE.0) GO TO 30 BLDK1831 JCODE=NTYP(17) BLDK1832 GO TO 100 BLDK1833 C BLDK1834 C CHECK FOR REMARK BLDK1835 C BLDK1836 30 IF (IDEN(IBUF(1),IREMA).NE.0) GO TO 40 BLDK1837 JCODE=NTYP(6) BLDK1838 GO TO 100 BLDK1839 C BLDK1840 C CHECK FOR HET TYPE BLDK1841 C BLDK1842 40 IF (IDEN(IBUF(1),IHET).NE.0) GO TO 50 BLDK1843 JCODE=NTYP(26) BLDK1844 GO TO 100 BLDK1845 C BLDK1846 50 DO 60 I=1,NUNIQT BLDK1847 IF (IDEN(IBUF(1),ITYP(I)).EQ.0) GO TO 70 BLDK1848 60 CONTINUE BLDK1849 C BLDK1850 C COULD NOT FIND RECORD TYPE BLDK1851 GO TO 100 BLDK1852 C BLDK1853 70 JCODE=NTYP(I) BLDK1854 GO TO 100 BLDK1855 C BLDK1856 C BLDK1857 80 IEOF=IEOF+1 BLDK1858 IF (IEOF.LT.2) GO TO 90 BLDK1859 JCODE=-50 BLDK1860 GO TO 100 BLDK1861 C BLDK1862 C BLDK1863 90 JCODE=-100 BLDK1864 GO TO 100 BLDK1865 C BLDK1866 C BLDK1867 100 RETURN BLDK1868 C BLDK1869 C BLDK1870 C BLDK1871 110 FORMAT (20A4) BLDK1872 END BLDK1873 SUBROUTINE SKIPFL (NFILE,IER) BLDK1874 C BLDK1875 C THIS ROUTINE POSITIONS THE INPUT FILE IPDB BY SKIPPING NFILE BLDK1876 C TAPE MARKS. BLDK1877 C ROUTINE CHECKS FOR END OF DATA BASE TWO WAYS, EITHER BY A BLDK1878 C JCODE=-50 FOR DOUBLE END OF FILE OR BY A HEADER CARD WITH A FOUR BLDK1879 C LETTER CODE FINI. BLDK1880 C THIS ROUTINE COMMUNICATES WITH NTRPRT AND THUS REQUIRES THE COMMONBLDK1881 C BLOCK HEADER BLDK1882 C BLDK1883 C THE FOLLOWING VARIABLES ARE USED TO STORE CHARACTERS BLDK1884 C IBUF,IDSET,IFINI BLDK1885 C BLDK1886 DIMENSION IBUF(20) BLDK1887 COMMON /HEADER/ IDSET BLDK1888 C BLDK1889 C BLDK1890 DATA ITERM/-50/,IHEAD/1/,IEND/31/,IENDFL/-100/ BLDK1891 DATA IFINI/4HFINI/,IATOM/27/,LPTR/6/ BLDK1892 C BLDK1893 IDEN(I,J)=I-J BLDK1894 C BLDK1895 IER=0 BLDK1896 IEOF=0 BLDK1897 I=1 BLDK1898 C BLDK1899 10 CALL GETREC (IBUF,JCODE) BLDK1900 C BLDK1901 IF (JCODE.EQ.IATOM) GO TO 60 BLDK1902 C BLDK1903 IF (JCODE.NE.IHEAD) GO TO 20 BLDK1904 CALL NTRPRT (IBUF,JCODE) BLDK1905 IF (IDEN(IDSET,IFINI).EQ.0) GO TO 70 BLDK1906 GO TO 60 BLDK1907 C BLDK1908 20 IF (JCODE.NE.IEND) GO TO 30 BLDK1909 IEOF=1 BLDK1910 GO TO 40 BLDK1911 C BLDK1912 30 IF (JCODE.NE.IENDFL) GO TO 50 BLDK1913 IF (IEOF.EQ.0) GO TO 40 BLDK1914 IEOF=0 BLDK1915 GO TO 60 BLDK1916 C BLDK1917 40 I=I+1 BLDK1918 IF (I.GT.NFILE) GO TO 80 BLDK1919 GO TO 60 BLDK1920 C BLDK1921 50 IF (JCODE.NE.ITERM) GO TO 60 BLDK1922 GO TO 70 BLDK1923 C BLDK1924 60 GO TO 10 BLDK1925 C BLDK1926 C BLDK1927 70 IER=3 BLDK1928 WRITE (LPTR,90) BLDK1929 C BLDK1930 80 RETURN BLDK1931 C BLDK1932 C BLDK1933 90 FORMAT (43H0END OF DATA BASE HAS BEEN REACHED---SKIPFL) BLDK1934 END BLDK1935 SUBROUTINE POSNAM (IFLNAM,IER,IBUF,JCODE) BLDK1936 C BLDK1937 C THIS ROUTINE IS USED TO POSITION FILE IPDB BY NAME. BLDK1938 C BLDK1939 C THE FOLLOWING VARIABLES ARE USED TO STORE CHARACTERS BLDK1940 C IBUF,IFLNAM,IFINI BLDK1941 C BLDK1942 C PARAMETERS PASSED TO/FROM CALLING PROGRAM BLDK1943 C IFLNAM FOUR CHARACTER PROTEIN DATA BANK ENTRY NAME BLDK1944 C IER ERROR CODE, ZERO FOR NO ERROR, NON-ZERO OTHERWISE BLDK1945 C IBUF CONTENTS OF A RECORD FROM IPDB BLDK1946 C JCODE INTEGER GIVING THE RECORD TYPE BLDK1947 C BLDK1948 DIMENSION IBUF(20) BLDK1949 C BLDK1950 COMMON /HEADER/ IDSET BLDK1951 C BLDK1952 DATA IFINI/4HFINI/,ITERM/-50/,IHEAD/1/ BLDK1953 DATA LPTR/6/ BLDK1954 C BLDK1955 IDEN(I,J)=I-J BLDK1956 C BLDK1957 IER=0 BLDK1958 C BLDK1959 10 CALL GETREC (IBUF,JCODE) BLDK1960 C BLDK1961 C TEST FOR END OF DATA BASE BLDK1962 C BLDK1963 IF (JCODE.NE.ITERM) GO TO 20 BLDK1964 GO TO 30 BLDK1965 C BLDK1966 C BLDK1967 20 IF (JCODE.NE.IHEAD) GO TO 10 BLDK1968 CALL NTRPRT (IBUF,JCODE) BLDK1969 IF (IDEN(IDSET,IFINI).EQ.0) GO TO 30 BLDK1970 IF (IDEN(IDSET,IFLNAM).EQ.0) GO TO 40 BLDK1971 GO TO 10 BLDK1972 C BLDK1973 C ERROR SINKS BLDK1974 C BLDK1975 30 IER=3 BLDK1976 WRITE (LPTR,50) BLDK1977 GO TO 40 BLDK1978 C BLDK1979 C BLDK1980 40 RETURN BLDK1981 C BLDK1982 C BLDK1983 50 FORMAT (53H0ERROR IN POSNAM--- END OF DATA BASE HAS BEEN REACHED) BLDK1984 END BLDK1985 SUBROUTINE NTRPRT (IBUF,JCODE) BLDK1986 C BLDK1987 C THIS ROUTINE DECODES A RECORD TYPE AND STORES THE PERTINENT BLDK1988 C VARIABLES IN A NAMED COMMON AREA BLDK1989 C EACH RECORD TYPE WILL BE GIVEN A NAMED COMMON AREA BLDK1990 C BLDK1991 C REC. NO. TYPE JCODE BLDK1992 C 1 HEADER 1 BLDK1993 C 2 COMPND 2 BLDK1994 C 3 SOURCE 3 BLDK1995 C 4 AUTHOR 4 BLDK1996 C 5 JRNL 5 BLDK1997 C 6 REMARK 6 BLDK1998 C 7 FTNOTE 7 BLDK1999 C 8 HET 8 BLDK2000 C 9 HELIX 9 BLDK2001 C 10 SHEET 10 BLDK2002 C 11 TURN 11 BLDK2003 C 12 SITE 12 BLDK2004 C 13 CRYST,CRYST1 13 BLDK2005 C 14 ORIGX,ORIGX1,ORIGX2,ORIGX3 15 BLDK2006 C 15 SCALE,SCALE1,SCALE2,SCALE3 19 BLDK2007 C 16 MTRIX,MTRIX1,MTRIX2,MTRIX3 23 BLDK2008 C 17 ATOM 27 BLDK2009 C 18 TER 28 BLDK2010 C 19 CONECT 29 BLDK2011 C 20 MASTER 30 BLDK2012 C 21 END 31 BLDK2013 C 22 SEQRES 32 BLDK2014 C 23 SSBOND 33 BLDK2015 C 24 FORMUL 34 BLDK2016 C 25 TVECT 35 BLDK2017 C 26 HETATM 36 BLDK2018 C 27 SIGATM 37 BLDK2019 C BLDK2020 C BLDK2021 C NAMING CONVENTION USED BLDK2022 C VARIABLE NAMES BLDK2023 C DEFAULT VARIABLE TYPE IS USED BLDK2024 C FIRST FOUR LETTERS ARE USER MNEMONICS BLDK2025 C LAST TWO INDICATE RECORD TYPE BLDK2026 C FOUR CHARACTERS STORED PER VARIABLE BLDK2027 C BLDK2028 C BLDK2029 C THIS ROUTINE WILL EXPAND IN THE FUTURE TO HANDLE OTHER RECORD BLDK2030 C TYPES BLDK2031 C BLDK2032 C MNEMONICS USED BLDK2033 C SERIAL NUMBER - NSER BLDK2034 C ATOM NAME - NAME BLDK2035 C ALTERNATE LOCATOR - NALT BLDK2036 C RESIDUE NAME - NRES BLDK2037 C CHAIN ID - NCHN BLDK2038 C RESIDUE SEQ. - NSEQ BLDK2039 C INSERTION CODE - INSC BLDK2040 C BLDK2041 C THE FOLLOWING VARIABLES ARE USED TO STORE CHARACTERS BLDK2042 C IBUF,LINE,IDSET BLDK2043 C NAME27,NALT27,NRES27,NCHN27,INSC27 BLDK2044 C BLDK2045 C BLDK2046 DIMENSION IBUF(20) BLDK2047 DIMENSION LINE(8) BLDK2048 C BLDK2049 COMMON /ATOM/ NSER27,NAME27,NALT27,NRES27,NCHN27,NSEQ27,INSC27,ATMBLDK2050 1X27,ATMY27,ATMZ27,OCPN27,TEMP27 BLDK2051 C BLDK2052 COMMON /HEADER/ IDSET BLDK2053 C BLDK2054 DATA IHEAD/1/,IATOM/27/ BLDK2055 C BLDK2056 C THIS DATA STATEMENT IS NEEDED WHEN FILE ISCR IS USED FOR ENCODE BLDK2057 C BLDK2058 C DATA ISCR/3/ BLDK2059 C BLDK2060 C BLDK2061 NTYPS=37 BLDK2062 C BLDK2063 IF (JCODE.GT.NTYPS) GO TO 40 BLDK2064 C BLDK2065 C JCODE = 27 ATOM RECORD TYPE BLDK2066 C BLDK2067 IF (JCODE.NE.IATOM) GO TO 10 BLDK2068 C BLDK2069 C BLDK2070 C THE FOLLOWING STATEMENTS SIMULATE AN ENCODE/DECODE SEQUENCE BLDK2071 C BLDK2072 C REWIND ISCR BLDK2073 C WRITE(ISCR,80) (IBUF(I),I=1,20) BLDK2074 C REWIND ISCR BLDK2075 C READ(ISCR,50) NSER27,NAME27,NALT27,NRES27,NCHN27, BLDK2076 C . NSEQ27,INSC27,ATMX27,ATMY27,ATMZ27, BLDK2077 C . OCPN27,TEMP27 BLDK2078 C BLDK2079 ENCODE (80,80,LINE(1) )(IBUF(I),I=1,20) BLDK2080 DECODE (80,50,LINE(1) )NSER27,NAME27,NALT27,NRES27,NCHN27,NSEQ27,IBLDK2081 1NSC27,ATMX27,ATMY27,ATMZ27,OCPN27,TEMP27 BLDK2082 GO TO 30 BLDK2083 C BLDK2084 C JCODE = 1 HEADER TYPE OF RECORD BLDK2085 C BLDK2086 10 IF (JCODE.NE.IHEAD) GO TO 20 BLDK2087 C BLDK2088 C BLDK2089 C THE FOLLOWING STATEMENTS SIMULATE AN ENCODE/DECODE SEQUENCE BLDK2090 C BLDK2091 C REWIND ISCR BLDK2092 C WRITE(ISCR,80) (IBUF(I),I=1,20) BLDK2093 C REWIND ISCR BLDK2094 C READ(ISCR, 60) IDSET BLDK2095 C BLDK2096 ENCODE (80,80,LINE(1) )(IBUF(I),I=1,20) BLDK2097 DECODE (80,60,LINE(1) )IDSET BLDK2098 GO TO 30 BLDK2099 C BLDK2100 C BLDK2101 20 GO TO 30 BLDK2102 C BLDK2103 C BLDK2104 30 RETURN BLDK2105 C BLDK2106 C BLDK2107 40 WRITE (6,70) BLDK2108 RETURN BLDK2109 C BLDK2110 C BLDK2111 C BLDK2112 50 FORMAT (6X,I5,1X,A4,A1,A3,1X,A1,I4,A1,3X,3F8.3,2F6.2,1X,I3) BLDK2113 60 FORMAT (62X,A4) BLDK2114 70 FORMAT (27H ERROR IN NTRPRT,.GT. NTYPS) BLDK2115 80 FORMAT (20A4) BLDK2116 END BLDK2117 SUBROUTINE PRNTXT (IBUF,JCODE) BLDK2118 C BLDK2119 C THIS ROUTINE HANDLES TEXT PRINTOUT BLDK2120 C THE PROGRAM HANDLES THE FOLLOWING RECORD TYPES DIFFERENTLY BLDK2121 C A) HEADER PRINTS ONLY DATE AND ENTRY CODE BLDK2122 C FOR THE FOLLOWING RECORD TYPES, AN APPROPRIATE HEADER AND THE BLDK2123 C CONTENTS OF THE BUFFER FROM COLUMN 11 IS PRINTED. BLDK2124 C COMPND BLDK2125 C SOURCE BLDK2126 C AUTHOR BLDK2127 C BLDK2128 C FOR OTHER RECORD TYPES THE WHOLE BUFFER IS PRINTED, SHIFTED BY 1 BLDK2129 C COLUMN SPACE. BLDK2130 C BLDK2131 C THE FOLLOWING VARIABLES ARE USED TO STORE CHARACTERS BLDK2132 C IBUF,IDATE,LINE,INTRY BLDK2133 C BLDK2134 C PARAMETERS PASSED TO/FROM CALLING PROGRAM BLDK2135 C IBUF CONTENTS OF AN IPDB RECORD TO BE PRINTED BLDK2136 C JCODE INTEGER GIVING THE RECORD TYPE BLDK2137 C BLDK2138 C BLDK2139 DIMENSION IBUF(20) BLDK2140 DIMENSION IDATE(3) BLDK2141 DIMENSION LINE(8) BLDK2142 C BLDK2143 COMMON /TXTCNT/ NCMPD,NSRCE,NAUTHR BLDK2144 C BLDK2145 C BLDK2146 C THIS DATA STATEMENT IS NEEDED WHEN USING FILE ISCR FOR ENCODE BLDK2147 C BLDK2148 C DATA ISCR/3/ BLDK2149 C BLDK2150 DATA IBEGIN/1/ BLDK2151 DATA IHEAD/1/ BLDK2152 DATA IJRNL/5/ BLDK2153 DATA LPTR/6/ BLDK2154 DATA ICMPD/2/,ISRCE/3/,IAUTH/4/ BLDK2155 C BLDK2156 C BLDK2157 IF (JCODE.GT.IJRNL) GO TO 50 BLDK2158 IF (JCODE.NE.IHEAD) GO TO 10 BLDK2159 C BLDK2160 C HEADER TYPE OF RECORD BLDK2161 C BLDK2162 C BLDK2163 C THE FOLLOWING STATEMENTS SIMULATE AN ENCODE/DECODE SEQUENCE BLDK2164 C BLDK2165 C REWIND ISCR BLDK2166 C WRITE(ISCR,100 ) (IBUF(I),I=1,20) BLDK2167 C REWIND ISCR BLDK2168 C READ(ISCR,110 ) IDATE,INTRY BLDK2169 C BLDK2170 ENCODE (80,100,LINE(1) )(IBUF(I),I=1,20) BLDK2171 DECODE (80,110,LINE(1) )IDATE,INTRY BLDK2172 WRITE (LPTR,120) INTRY,IDATE BLDK2173 C BLDK2174 C INITIALIZE RECORD TYPE COUNTS BLDK2175 C BLDK2176 NCMPD=IBEGIN BLDK2177 NSRCE=IBEGIN BLDK2178 NAUTHR=IBEGIN BLDK2179 GO TO 60 BLDK2180 C BLDK2181 10 CONTINUE BLDK2182 C BLDK2183 C SHIFT THE OUTPUT SO AS NOT TO WRITE THE RECORD TYPE BLDK2184 C BLDK2185 C THE FOLLOWING STATEMENTS SIMULATE AN ENCODE/DECODE SEQUENCE BLDK2186 C BLDK2187 C REWIND ISCR BLDK2188 C WRITE(ISCR,100 ) (IBUF(I),I=1,20) BLDK2189 C REWIND ISCR BLDK2190 C READ(ISCR,130 ) (IBUF(I),I=1,15) BLDK2191 C BLDK2192 ENCODE (80,100,LINE(1) )(IBUF(I),I=1,20) BLDK2193 DECODE (80,130,LINE(1) )(IBUF(I),I=1,15) BLDK2194 IF (JCODE.NE.ICMPD) GO TO 20 BLDK2195 IF (NCMPD.GT.1) GO TO 40 BLDK2196 NCMPD=2 BLDK2197 WRITE (LPTR,70) BLDK2198 GO TO 40 BLDK2199 20 IF (JCODE.NE.ISRCE) GO TO 30 BLDK2200 IF (NSRCE.GT.1) GO TO 40 BLDK2201 NSRCE=2 BLDK2202 WRITE (LPTR,80) BLDK2203 GO TO 40 BLDK2204 30 IF (JCODE.NE.IAUTH) GO TO 40 BLDK2205 IF (NAUTHR.GT.1) GO TO 40 BLDK2206 NAUTHR=2 BLDK2207 WRITE (LPTR,90) BLDK2208 GO TO 40 BLDK2209 40 CONTINUE BLDK2210 WRITE (LPTR,140) (IBUF(I),I=1,15) BLDK2211 GO TO 60 BLDK2212 C BLDK2213 C ALL OTHER RECORD TYPES,JUST PRINT THE ENTIRE BUFFER BLDK2214 C BLDK2215 50 WRITE (LPTR,150) (IBUF(I),I=1,20) BLDK2216 GO TO 60 BLDK2217 C BLDK2218 C BLDK2219 60 RETURN BLDK2220 C BLDK2221 C BLDK2222 C BLDK2223 70 FORMAT (5H0FOR-) BLDK2224 80 FORMAT (8H0SOURCE-) BLDK2225 90 FORMAT (14H0DEPOSITED BY-) BLDK2226 100 FORMAT (20A4) BLDK2227 110 FORMAT (50X,2A4,A2,2X,A4) BLDK2228 120 FORMAT (25H1PROTEIN DATA BANK ENTRY ,A4,9H DATED ,2A4,A2) BLDK2229 130 FORMAT (10X,15A4) BLDK2230 140 FORMAT (1X,15A4) BLDK2231 150 FORMAT (1X,20A4) BLDK2232 END BLDK2233 SUBROUTINE NEWPAG (ITITLE,IPAGE) BLDK2234 C BLDK2235 C THIS ROUTINE IS CALLED TO WRITE OUT A NEW PAGE BLDK2236 C BLDK2237 C THE FOLLOWING VARIABLES ARE USED TO STORE CHARACTERS BLDK2238 C ITITLE,IBLANK BLDK2239 C BLDK2240 DATA LPTR/6/,IBLANK/1H / BLDK2241 C BLDK2242 C BLDK2243 WRITE (LPTR,10) ITITLE,IPAGE BLDK2244 C BLDK2245 C SKIP TWO LINES BLDK2246 C BLDK2247 WRITE (LPTR,20) IBLANK BLDK2248 C BLDK2249 RETURN BLDK2250 C BLDK2251 C BLDK2252 10 FORMAT (1H1,26HPROTEIN DATA BANK ENTRY ,A4,38X,4HPAGE,I5) BLDK2253 20 FORMAT (1H0,A1) BLDK2254 END BLDK2255 SUBROUTINE NEWLIN (ITITLE,LINENO,IPAGE) BLDK2256 C BLDK2257 C THIS ROUTINE IS USED TO CONTROL PAGINATION. BLDK2258 C THIS ROUTINE SHOULD BE CALLED ONCE FOR EVERY OUTPUT TO LPTR. BLDK2259 C BLDK2260 DATA MAXLIN/60/ BLDK2261 C BLDK2262 C BLDK2263 LINENO=LINENO+1 BLDK2264 IF (LINENO.LT.MAXLIN) GO TO 10 BLDK2265 IPAGE=IPAGE+1 BLDK2266 CALL NEWPAG (ITITLE,IPAGE) BLDK2267 LINENO=6 BLDK2268 GO TO 10 BLDK2269 C BLDK2270 C BLDK2271 10 RETURN BLDK2272 END BLDK2273 SUBROUTINE GETRES (IRC,NINC,INCATM,IBUF,JCODE,JHET) BLDK2274 C BLDK2275 C THIS ROUTINE COLLECTS ATOMS AND FORMS A COMPLETE RESIDUE BLDK2276 C A COMPLETE RESIDUE IS DEFINED AS HAVING IDENTICAL CODES IN THE BLDK2277 C FOLLOWING FIELDS BLDK2278 C 1) RESIDUE NAME BLDK2279 C 2) RESIDUE SEQUENCE NUMBER BLDK2280 C 3) CHAIN NAME BLDK2281 C 4) INSERT CODE BLDK2282 C BLDK2283 C BLDK2284 C IRC IS THE RETURN CODE BLDK2285 C IRC = 0 FOR INITIAL ENTRY TO ROUTINE,MUST BE SET BY CALLING PGM. BLDK2286 C IRC = 1 IBUF CONTAINS A NON-ATOM RECORD TYPE,JCODE HAS THE REC TYPBLDK2287 C IRC = 2 COMPLETED A RESIDUE IT IS IN CURRES BLDK2288 C BLDK2289 C NINC NUMBER OF ATOM NAMES FOUND IN INCATM THAT ARE TO BLDK2290 C BE INCLUDED IN ACCUMULATING THE RESIDUE, ALL OTHERS BLDK2291 C ARE IGNORED. WHEN THIS IS SET TO ZERO, GETRES WILL BLDK2292 C INCLUDE ALL THE ATOMS IN A RESIDUE. BLDK2293 C INCATM ARRAY CONTAINING ATOM NAMES, GETRES WILL ACCUMULATE BLDK2294 C ONLY THESE ATOMS. BLDK2295 C IBUF CONTENTS OF A RECORD FROM IPDB BLDK2296 C JCODE INTEGER GIVING THE RECORD TYPE BLDK2297 C JHET FLAG TO INDICATE WHETHER HETATMS ARE TO BE PROCESSED BLDK2298 C OR NOT. BLDK2299 C JHET = 0 PROCESS HETATM BLDK2300 C JHET = 1 DO NOT PROCESS HETATM BLDK2301 C BLDK2302 C THE FOLLOWING VARIABLES ARE USED TO STORE CHARACTERS BLDK2303 C IBUF,INCATM BLDK2304 C NAME27,NALT27,NRES27,NCHN27,INSC27 BLDK2305 C NRESCR,NCHNCR,INSCCR,NAMECR,NALTCR BLDK2306 C NAMEOL,NALTOL,NRESOL,NCHNOL,INSCOL BLDK2307 C BLDK2308 C BLDK2309 C NEW ATOM CARDS ARE ASSUMED TO HAVE BEEN DEPOSITED IN COMMON AREA BLDK2310 C NAMED ATOM BY THE ROUTINE NTRPRT BLDK2311 C BLDK2312 DIMENSION IBUF(20) BLDK2313 DIMENSION INCATM(20) BLDK2314 DIMENSION NSERCR(100), NAMECR(100), NALTCR(100) BLDK2315 DIMENSION ATMXCR(100), ATMYCR(100), ATMZCR(100) BLDK2316 C BLDK2317 COMMON /ATOM/ NSER27,NAME27,NALT27,NRES27,NCHN27,NSEQ27,INSC27,ATMBLDK2318 1X27,ATMY27,ATMZ27,OCPN27,TEMP27 BLDK2319 C BLDK2320 COMMON /CURRES/ NALLCR,NRESCR,NCHNCR,NSEQCR,INSCCR,NSERCR,NAMECR,NBLDK2321 1ALTCR,ATMXCR,ATMYCR,ATMZCR BLDK2322 C BLDK2323 COMMON /OLDRES/ NSEROL,NAMEOL,NALTOL,NRESOL,NCHNOL,NSEQOL,INSCOL,ABLDK2324 1TMXOL,ATMYOL,ATMZOL BLDK2325 C BLDK2326 COMMON /RESLCL/ INOL BLDK2327 C BLDK2328 DATA IATOM/27/ BLDK2329 DATA IYES/0/,IHET/36/ BLDK2330 C BLDK2331 IDEN(I,J)=I-J BLDK2332 C BLDK2333 IF (IRC.NE.0) GO TO 10 BLDK2334 INOL=0 BLDK2335 NALLCR=0 BLDK2336 GO TO 20 BLDK2337 C BLDK2338 10 IF (INOL.NE.1) GO TO 20 BLDK2339 INOL=0 BLDK2340 NALLCR=1 BLDK2341 CALL PUSHCR (NRESOL,NCHNOL,NSEQOL,INSCOL,NSEROL,NAMEOL,NALTOL,ATMXBLDK2342 1OL,ATMYOL,ATMZOL) BLDK2343 GO TO 20 BLDK2344 C BLDK2345 20 CALL GETREC (IBUF,JCODE) BLDK2346 C BLDK2347 IF ((JCODE.EQ.IATOM).OR.(JCODE.EQ.IHET.AND.JHET.EQ.IYES)) GO TO 30BLDK2348 C BLDK2349 IRC=1 BLDK2350 GO TO 90 BLDK2351 C BLDK2352 30 JCODE=27 BLDK2353 CALL NTRPRT (IBUF,JCODE) BLDK2354 C BLDK2355 C CHECK WHETHER WE WANT THIS ATOM BLDK2356 C BLDK2357 IF (NINC.EQ.0) GO TO 50 BLDK2358 C BLDK2359 DO 40 J=1,NINC BLDK2360 IF (IDEN(NAME27,INCATM(J)).EQ.0) GO TO 50 BLDK2361 40 CONTINUE BLDK2362 GO TO 80 BLDK2363 C BLDK2364 50 IF (NALLCR.LE.0) GO TO 70 BLDK2365 IF (IDEN(NRES27,NRESCR).NE.0) GO TO 60 BLDK2366 IF (IDEN(NSEQ27,NSEQCR).NE.0) GO TO 60 BLDK2367 IF (IDEN(NCHN27,NCHNCR).NE.0) GO TO 60 BLDK2368 IF (IDEN(INSC27,INSCCR).NE.0) GO TO 60 BLDK2369 GO TO 70 BLDK2370 C BLDK2371 60 IRC=2 BLDK2372 INOL=1 BLDK2373 CALL PUSHOL (NSER27,NAME27,NALT27,NRES27,NCHN27,NSEQ27,INSC27,ATMXBLDK2374 127,ATMY27,ATMZ27) BLDK2375 GO TO 90 BLDK2376 C BLDK2377 70 NALLCR=NALLCR+1 BLDK2378 CALL PUSHCR (NRES27,NCHN27,NSEQ27,INSC27,NSER27,NAME27,NALT27,ATMXBLDK2379 127,ATMY27,ATMZ27) BLDK2380 GO TO 80 BLDK2381 C BLDK2382 80 GO TO 20 BLDK2383 C BLDK2384 90 RETURN BLDK2385 END BLDK2386 SUBROUTINE PUSHCR (NRES,NCHN,NSEQ,INSC,NSER,NAME,NALT,ATMX,ATMY,ATBLDK2387 1MZ) BLDK2388 C BLDK2389 C THIS ROUTINE DEPOSITS VALUES FOR THE VARIABLES IN THE COMMON BLDK2390 C AREA CURRES. BLDK2391 C BLDK2392 C THE FOLLOWING VARIABLES ARE USED TO STORE CHARACTERS BLDK2393 C NRES,NCHN,INSC,NAME,NALT BLDK2394 C NRESCR,NCHNCR,INSCCR,NAMECR,NALTCR BLDK2395 C BLDK2396 DIMENSION NSERCR(100), NAMECR(100), NALTCR(100) BLDK2397 DIMENSION ATMXCR(100), ATMYCR(100), ATMZCR(100) BLDK2398 C BLDK2399 COMMON /CURRES/ NALLCR,NRESCR,NCHNCR,NSEQCR,INSCCR,NSERCR,NAMECR,NBLDK2400 1ALTCR,ATMXCR,ATMYCR,ATMZCR BLDK2401 C BLDK2402 C BLDK2403 NRESCR=NRES BLDK2404 NCHNCR=NCHN BLDK2405 NSEQCR=NSEQ BLDK2406 INSCCR=INSC BLDK2407 NSERCR(NALLCR)=NSER BLDK2408 NAMECR(NALLCR)=NAME BLDK2409 NALTCR(NALLCR)=NALT BLDK2410 ATMXCR(NALLCR)=ATMX BLDK2411 ATMYCR(NALLCR)=ATMY BLDK2412 ATMZCR(NALLCR)=ATMZ BLDK2413 RETURN BLDK2414 END BLDK2415 SUBROUTINE PUSHOL (NSER,NAME,NALT,NRES,NCHN,NSEQ,INSC,ATMX,ATMY,ATBLDK2416 1MZ) BLDK2417 C BLDK2418 C THIS ROUTINE DEPOSITS VALUES FOR THE VARIABLES IN THE COMMON BLDK2419 C AREA OLDRES BLDK2420 C BLDK2421 C THE FOLLOWING VARIABLES ARE USED TO STORE CHARACTERS BLDK2422 C NAME,NALT,NRES,NCHN,INSC BLDK2423 C NAMEOL,NALTOL,NRESOL,NCHNOL,INSCOL BLDK2424 C BLDK2425 C BLDK2426 COMMON /OLDRES/ NSEROL,NAMEOL,NALTOL,NRESOL,NCHNOL,NSEQOL,INSCOL,ABLDK2427 1TMXOL,ATMYOL,ATMZOL BLDK2428 C BLDK2429 NSEROL=NSER BLDK2430 NAMEOL=NAME BLDK2431 NALTOL=NALT BLDK2432 NRESOL=NRES BLDK2433 NCHNOL=NCHN BLDK2434 NSEQOL=NSEQ BLDK2435 INSCOL=INSC BLDK2436 ATMXOL=ATMX BLDK2437 ATMYOL=ATMY BLDK2438 ATMZOL=ATMZ BLDK2439 C BLDK2440 RETURN BLDK2441 END BLDK2442 SUBROUTINE MATMUL (A,B,C) BLDK2443 C----MULTIPLY TWO MATRICIES BLDK2444 COMMON /VECCOM/ X(12) BLDK2445 DIMENSION A(9), B(9), C(9) BLDK2446 C----GET THE TRANSPOSE OF B INTO X BLDK2447 CALL TRNSPZ (B,X) BLDK2448 IJ = 0 BLDK2449 DO 2000 I=1,9,3 BLDK2450 DO 2000 J=1,9,3 BLDK2451 IJ = IJ + 1 BLDK2452 C(IJ) = DOT(A(I),X(J)) BLDK2453 2000 CONTINUE BLDK2454 RETURN BLDK2455 END BLDK2456