//JOB(ERCC07,STEPHENS,T=200,L=10000) //OPTIONS(QUOTES,OPT) //ALGOL 'COMMENT' *************** * * * ALGG044 * * * *************** ; 'BEGIN' 'INTEGER' DV1,DIN,DV2,MT1,I,J,NAT; 'REAL' PI,ANGLE,A; 'ARRAY' CELL[1:6],NN,MM[1:3,1:3],TITLE[1:200], INDEX[1:20]; 'BOOLEAN' 'ARRAY' KEY[1:20]; 'COMMENT' INPUT/OUTPUT PROCEDURES; 'REAL' 'PROCEDURE' READ; 'EXTERNAL'READ1900; 'PROCEDURE' WRITE TEXT(STRING); 'STRING' STRING; 'EXTERNAL'; 'PROCEDURE' CRDTXT; 'BEGIN' 'INTEGER' I,J; TRY AGAIN : INSYMBOL(98,'('*')',I); 'IF' I = 1 'THEN' 'BEGIN' NEXTSYM : INSYMBOL (98,'('*ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789()+-;')',J); 'IF' J = 1 'THEN' 'GOTO' OUT; OUTSYMBOL (99,'('*ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789()+-;')',J); 'GOTO' NEXTSYM 'END' 'ELSE' 'GOTO' TRYAGAIN; OUT : 'END' PROCEDURE CRDTXT; 'COMMENT' END OF INPUT/OUTPUT PROCEDURES; 'INTEGER' 'PROCEDURE' INBASICSYMBOL(D); 'VALUE' D; 'INTEGER' D; 'BEGIN' 'INTEGER' CHAR; AGAIN: INSYMBOL(98, '('0123456789_ABCDEFGHIJKLMNOPQRSTUVWXYZ()+-:.,#*;/')', CHAR); 'IF' CHAR=-10 'THEN' 'GOTO' AGAIN; CHAR := 'IF' CHAR >= 1 'AND' CHAR < 11 'THEN' CHAR-1 'ELSE' 'IF' CHAR > 11 'AND' CHAR < 38 'THEN' CHAR 'ELSE' 'IF' CHAR = -32 'THEN' 158 'ELSE' 'IF' CHAR = 38 'THEN' 132 'ELSE' 'IF' CHAR = 39 'THEN' 148 'ELSE' 'IF' CHAR = 40 'THEN' 193 'ELSE' 'IF' CHAR = 41 'THEN' 209 'ELSE' 'IF' CHAR = 42 'THEN' 185 'ELSE' 'IF' CHAR = 43 'THEN' 011 'ELSE' 'IF' CHAR = 44 'THEN' 166 'ELSE' 'IF' CHAR = 45 'THEN' 210 'ELSE' 'IF' CHAR = 46 'THEN' 160 'ELSE' 'IF' CHAR = 47 'THEN' 152 'ELSE' 'IF' CHAR = 48 'THEN' 161 'ELSE' 210; INBASICSYMBOL := CHAR 'END' PROCEDURE INBASICSYMBOL; 'PROCEDURE' OUTBASICSYMBOL(D,CHAR); 'VALUE' D,CHAR; 'INTEGER' D,CHAR; 'BEGIN' CHAR := 'IF' CHAR >= 0 'AND' CHAR < 10 'THEN' CHAR+1 'ELSE' 'IF' CHAR > 11 'AND' CHAR < 38 'THEN' CHAR 'ELSE' 'IF' CHAR = 158 'THEN' -32 'ELSE' 'IF' CHAR = 132 'THEN' 38 'ELSE' 'IF' CHAR = 148 'THEN' 39 'ELSE' 'IF' CHAR = 193 'THEN' 40 'ELSE' 'IF' CHAR = 209 'THEN' 41 'ELSE' 'IF' CHAR = 185 'THEN' 42 'ELSE' 'IF' CHAR = 011 'THEN' 43 'ELSE' 'IF' CHAR = 166 'THEN' 44 'ELSE' 'IF' CHAR = 210 'THEN' 45 'ELSE' 'IF' CHAR = 160 'THEN' 46 'ELSE' 'IF' CHAR = 152 'THEN' 47 'ELSE' 'IF' CHAR = 161 'THEN' 48 'ELSE' 45; OUTSYMBOL(99, '('0123456789_ABCDEFGHIJKLMNOPQRSTUVWXYZ()+-:.,#*;/')', CHAR); 'END' PROCEDURE OUTBASICSYMBOL; 'PROCEDURE' PACKTHREE(X); 'REAL' X; 'BEGIN' 'INTEGER' I,J; 'INTEGER' 'ARRAY' SYM[-2:4]; SYM[-2] := SYM[-1] := SYM[0] := 158; 'FOR' I := 1 'STEP' 1 'UNTIL' 4 'DO' 'BEGIN' IN: SYM[I] := INBASICSYMBOL (DIN); 'IF' SYM[1] = 158 'OR' SYM[1] = 209 'OR' SYM[1] = 152 'THEN' 'GOTO' IN; 'IF' SYM[I] # 132 'AND' SYM[I] # 158 'AND' SYM[I] # 209 'THEN' 'GOTO' NEXT; 'FOR' J := 3 'STEP' -1 'UNTIL' 1 'DO' SYM[J] := SYM[I+J-4]; 'GOTO' FORMX; NEXT: 'END' LINE 25, ; FORMX : I := 256*(256*SYM[1]+SYM[2])+SYM[3]; X := I; 'END' PROCEDURE PACKTHREE; 'PROCEDURE' FORMINTEGER(X,FAILURE); 'REAL' X; 'LABEL' FAILURE; 'BEGIN' 'INTEGER' Y,I,SYMBOL; Y := 0; 'FOR' I := 1 'STEP' 1 'UNTIL' 3 'DO' 'BEGIN' IN: SYMBOL := INBASICSYMBOL (DIN); 'IF' SYMBOL = 158 'THEN' 'GOTO' IN; 'IF' SYMBOL = 148 'THEN' 'GOTO' OUT; 'IF' SYMBOL > 9 'THEN' 'BEGIN' NEWLINES(2); WRITETEXT('('PUNCHING ERROR IN BRACKETED INTEGER ')'); OUTBASICSYMBOL(DIN,SYMBOL); 'GOTO' FAILURE; 'END' LINE 44, ; Y := Y*10+SYMBOL 'END' LINE 46, ; NEWLINES(2); WRITETEXT('('BRACKETED INTEGER TOO LARGE')'); 'GOTO' FAILURE; OUT: X := Y; 'END' LINE 50, OF FORM INTEGER; 'PROCEDURE' ORTHG(CELL,MATRIX); 'VALUE' CELL; 'ARRAY' CELL,MATRIX; 'BEGIN' 'REAL' ONE; MATRIX[1,2] := MATRIX[1,3] := MATRIX[2,3] := 0.0; MATRIX[3,3] := CELL[3]; MATRIX[3,2] := CELL[2]*COS(CELL[4]); MATRIX[3,1] := CELL[1]*COS(CELL[5]); MATRIX[2,2] := CELL[2]*SIN(CELL[4]); ONE := (COS(CELL[6])-COS(CELL[5])*COS(CELL[4]))/SIN(CE LL[4]); MATRIX[2,1] := ONE*CELL[1]; MATRIX[1,1] := CELL[1]*SQRT(SIN(CELL[5])**2-ONE**2); 'END' LINE 64, PROCEDURE ORTHOG; 'PROCEDURE' INVERSE(MATRIX,INV); 'VALUE' MATRIX; 'ARRAY' MATRIX,INV; 'BEGIN' 'INTEGER' I; INV[1,2] := INV[1,3] := INV[2,3] := 0.0; 'FOR' I := 1 'STEP' 1 'UNTIL' 3 'DO' INV[I,I] := 1.0/MATRIX[I,I]; INV[2,1] := -MATRIX[2,1]/(MATRIX[1,1]*MATRIX[2,2]); INV[3,1] := -MATRIX[3,1]/(MATRIX[1,1]*MATRIX[3,3])+M ATRIX[2,1]*MATRIX[3,2] /(MATRIX[1,1]*MATRIX[2,2]*MATRIX[3,3]); INV[3,2] := -MATRIX[3,2]/(MATRIX[2,2]*MATRIX[3,3]); 'END' LINE 76, PROCEDURE INVERSE; 'COMMENT' PROGRAM STARTS HERE; DIN := 20; DV1 := DV2 := 30; PI := 3.141 592 6536; ANGLE := 180/PI; 'COMMENT' PDS AGAIN NEWPAGE; CAPTION: 'FOR' I := 1 'STEP' 1 'UNTIL' 200 'DO' 'BEGIN' J := INBASICSYMBOL(DIN); TITLE[I] := J; 'IF' J = 152 'THEN' 'GOTO' UNITCELL; 'IF' I = 200 'THEN' 'GOTO' FAILURE; 'END' LINE 90, ; UNITCELL: 'FOR' I := 1 'STEP' 1 'UNTIL' 3 'DO' CELL[I] := READ; 'FOR' I := 4 'STEP' 1 'UNTIL' 6 'DO' CELL[I] := READ/ANGLE; ORTHG(CELL,NN); INVERSE(NN,MM); DATA: 'FOR' I := 1 'STEP' 1 'UNTIL' 4 'DO' INDEX[I] := READ; NAT := INDEX[1]; 'FOR' I := 2 'STEP' 1 'UNTIL' 4 'DO' KEY[I-1] := IND EX[I] > 0.5; 'BEGIN' 'ARRAY' CH[1:NAT,1:2],X[1:NAT,1:3],VIB[1:NAT,0:6],SIG MA[1:NAT,1:3],CORR[1:NAT,1:3]; SFTAPE : 'FOR' I := 1,2 'DO' J := READ; 'FOR' I := 1 'STEP' 1 'UNTIL' J 'DO' A := READ; KEY[20] := READ > 0.5; 'FOR' I := 1 'STEP' 1 'UNTIL' NAT 'DO' 'BEGIN' PACKTHREE(CH[I,1]); FORMINTEGER(CH[I,2],FAILURE); 'FOR' J := 1 'STEP' 1 'UNTIL' 3 'DO' X[I,J] := READ; 'IF' 'NOT' KEY[1] 'THEN' 'GOTO' EXIT; A := READ; 'IF' A > 0.5 'AND' A < 1.5 'THEN' 'GOTO' ANISO; 'FOR' J := 1 'STEP' 1 'UNTIL' 6 'DO' VIB[I,J] := -999; VIB[I,0] := READ; 'GOTO' EXIT; ANISO: 'FOR' J := 1 'STEP' 1 'UNTIL' 6 'DO' VIB[I,J] := READ; VIB[I,0] := -999; 'IF' KEY[20] 'THEN' A := READ; EXIT: 'END' LINE 119, ; 'IF' READ < 998 'THEN' 'GOTO' FAILURE; SDEVS: 'IF' 'NOT' KEY[2] 'THEN' 'GOTO' LOAD; 'FOR' I := 1 'STEP' 1 'UNTIL' NAT 'DO' 'FOR' J := 1 'STEP' 1 'UNTIL' 3 'DO' SIGMA[I,J] := READ; 'IF' READ < 998 'THEN' 'GOTO' FAILURE; CORRELN: 'IF' 'NOT' KEY[3] 'THEN' 'GOTO' LOAD; 'IF' INDEX[4] > 3.5 'THEN' 'BEGIN' 'FOR' I := 1 'STEP' 1 'UNTIL' NAT 'DO' 'FOR' J := 3 'STEP' -1 'UNTIL' 1 'DO' CORR[I, J] := READ; 'END' LINE 130, 'ELSE' 'BEGIN' 'INTEGER' ROW; 'IF' INDEX[4] < 1.5 'THEN' ROW := 3 'ELSE' 'IF' I NDEX[4] < 2.5 'THEN' ROW := 2 'ELSE' ROW := 1; 'FOR' I := 1 'STEP' 1 'UNTIL' NAT 'DO' 'BEGIN' 'FOR' J := 1 'STEP' 1 'UNTIL' 3 'DO' CORR[I, J] := 0.0; CORR[I,ROW] := READ; 'END' LINE 140, ; 'END' LINE 141, ; 'IF' READ < 998 'THEN' 'GOTO' FAILURE; LOAD: 'BEGIN' 'BOOLEAN' AXESORTHOGONAL,RESTRICTIONS; 'REAL' DMAX,AMAX,C,B,ALPHA,BETA,GAMMA,PIBYTWO,RADIAN,T,S,D; 'INTEGER' I,J,K,L,M,N,CKEY,KEY1,KEY2,KEY3,FORM1,FORM2,LT, CC,P,LP,SN,Z,NUM; 'INTEGER' 'ARRAY' C1[1:27,1:3]; 'ARRAY' TEST[1:30,1:3],F,G[1:3],C2[1:27,1:3]; 'PROCEDURE' OUTEQUIVALENTPOSITIONS (DOUT,SYMNO,VECTOR); 'VALUE' DOUT,SYMNO; 'INTEGER' DOUT,SYMNO; 'ARRAY' VECTOR; 'BEGIN' 'INTEGER' I; 'PROCEDURE' OUTCOORDINATE (DOUT,A1,A2,A3,T); 'VALUE' DOUT,A1,A2,A3,T; 'INTEGER' DOUT; 'REAL' A1,A2,A3,T; 'BEGIN' 'ARRAY' OUT[1:3]; 'INTEGER' J,K,F; OUT[1] := A1; OUT[2] := A2; OUT[3] := A3; 'IF' T # 0 'THEN' 'BEGIN' K := ENTIER(12*T+0.5); 'FOR' J := 6, 4, 3, 2, 1 'DO' 'IF' ABS(K/J-K'/'J) < 0.000 000 1 'THEN' 'GOTO' NUMBER; NUMBER : PRINT(K/J,4,0); OUTBASICSYMBOL (DOUT,161); PRINT(12/J,1,0); 'END' LINE 175, ; 'FOR' J := 1 'STEP' 1 'UNTIL' 3 'DO' 'BEGIN' 'IF' OUT[J] = 0 'THEN' 'GOTO' EXIT; SPACES(1); 'IF' OUT[J] > 0 'THEN' OUTBASICSYMBOL (DOUT ,193) 'ELSE' OUTBASICSYMBOL (DOUT,209); SPACES(1); 'IF' ABS(OUT[J]) # 1 'THEN' PRINT(ABS(OUT[J]),1,0); OUTBASICSYMBOL(DOUT,J+34); EXIT: 'END' LINE 186, ; 'END' LINE 187, PROCEDURE OUT COORDINATE; NEWLINES(2); WRITETEXT('('EQUIVALENT POSITION NUMBER')'); PRINT(SYMNO,3,0); SPACES(5); 'FOR' I := 1 'STEP' 1 'UNTIL' 3 'DO' 'BEGIN' OUTCOORDINATE(DOUT,VECTOR[3*I-2],VECTOR[3*I-1], VECTOR[3*I],VECTOR[9+I]); 'IF' I # 3 'THEN' WRITETEXT('(',')'); 'END' LINE 194, ; 'END' LINE 196, PROCEDURE OUT EQUIVALENT POSITIONS; 'PROCEDURE' SKIPCHAR(DIN,CHAR); 'VALUE' DIN,CHAR; 'INTEGER' DIN,CHAR; 'BEGIN' 'INTEGER' SYMBOL; IN: SYMBOL := INBASICSYMBOL (DIN); 'IF' SYMBOL # CHAR 'THEN' 'GOTO' IN; 'END' LINE 204, PROCEDURE SKIP CHAR; 'PROCEDURE' ORTHOGONALISE (INVECTOR,OUTVECTOR,MATRIX,MOD E); 'VALUE' INVECTOR,MATRIX,MODE; 'BOOLEAN' MODE; 'ARRAY' INVECTOR,OUTVECTOR,MATRIX; 'BEGIN' 'PROCEDURE' AXESONLY (INVECTOR,OUTVECTOR,MATRIX); 'VALUE' INVECTOR,MATRIX; 'ARRAY' INVECTOR,OUTVECTOR,MATRIX; 'BEGIN' 'INTEGER' NUMB; 'FOR' NUMB := 1 'STEP' 1 'UNTIL' 3 'DO' OUTVECTOR[NUMB] := INVECTOR[NUMB]*MATRIX[NUM B,NUMB]; 'END' LINE 217, PROCEDURE AXES ONLY; 'PROCEDURE' FULLMATRIX (INVECTOR,OUTVECTOR,MATRIX); 'VALUE' INVECTOR,MATRIX; 'ARRAY' INVECTOR,OUTVECTOR,MATRIX; 'BEGIN' 'INTEGER' NUMB; 'FOR' NUMB := 1 'STEP' 1 'UNTIL' 3 'DO' OUTVECTOR[NUMB] := INVECTOR [1]*MATRIX[NUMB, 1]+INVECTOR [2]*MATRIX[NUMB,2]+INVECTOR [3]*MATRIX[NUM B,3]; 'END' LINE 226, PROCEDURE FULL MATRIX; 'IF' MODE 'THEN' AXESONLY (INVECTOR,OUTVECTOR,MATRI X) 'ELSE' FULLMATRIX (INVECTOR,OUTVECTOR,MATRIX); 'END' LINE 229, PROCEDURE ORTHOGONALISE; 'PROCEDURE' OUTNAME(DOUT,FDEV,A,B,FAILURE); 'VALUE' A,B,DOUT,FDEV; 'INTEGER' DOUT,FDEV; 'REAL' A,B; 'LABEL' FAILURE; 'BEGIN' 'INTEGER' Y,I,F,SPACESS; 'INTEGER' 'ARRAY' SYMBOL[1:3]; Y := A; SPACESS := 0; 'FOR' I := 3 'STEP' -1 'UNTIL' 1 'DO' 'BEGIN' F := Y'/'256; SYMBOL[I] := Y-256*F; Y := F; 'END' LINE 245, ; 'FOR' I := 1 'STEP' 1 'UNTIL' 3 'DO' 'BEGIN' 'IF' SYMBOL[I] = 158 'THEN' SPACESS := SPACESS+1 'ELSE' OUTBASICSYMBOL(DOUT,SYMBOL[I]) 'END'; Y := B; 'FOR' I := 2 'STEP' -1 'UNTIL' 1 'DO' 'BEGIN' F := Y'/'10; SYMBOL[I] := Y-10*F; Y := F; 'END' LINE 254, ; 'IF' Y # 0 'THEN' 'BEGIN' NEWLINES(2); WRITETEXT('('INTEGER FOR OUTPUT GREATER THAN 999')'); 'GOTO' FAILURE; 'END' LINE 259, ; OUTBASICSYMBOL(DOUT,132); F := 0; 'FOR' I := 1 'STEP' 1 'UNTIL' 2 'DO' 'BEGIN' 'IF' F = 0 'AND' SYMBOL[I] = 0 'THEN' 'BEGIN' SPACESS := SPACESS+1; 'GOTO' NEXT; 'END' LINE 268, ; OUTBASICSYMBOL (DOUT,SYMBOL[I]); F := 1; NEXT: 'END' LINE 272, ; OUTBASICSYMBOL (DOUT,148); SPACES(SPACESS); 'END' LINE 275, PROCEDURE OUT NAME; 'PROCEDURE' OUTSYMMETRY (DOUT,SYM,CELL,NO); 'VALUE' DOUT,SYM,NO; 'INTEGER' DOUT,SYM,NO; 'INTEGER' 'ARRAY' CELL; 'BEGIN' 'INTEGER' I; PRINT(SYM,2,0); SPACES(3); OUTBASICSYMBOL (DOUT,132); 'FOR' I := 1 'STEP' 1 'UNTIL' 3 'DO' 'BEGIN' PRINT(CELL[NO,I],2,0); 'IF' I # 3 'THEN' OUTBASICSYMBOL (DOUT,166); 'END' LINE 288, ; OUTBASICSYMBOL (DOUT,148); 'END' LINE 290, PROCEDURE OUT SYMMETRY; 'PROCEDURE' INEQUIVPOS(DIN,DOUT,VECTOR,FAILURE); 'VALUE' DIN,DOUT; 'INTEGER' DIN,DOUT; 'ARRAY' VECTOR; 'LABEL' FAILURE; 'BEGIN' 'INTEGER' I; 'BOOLEAN' SEMICOLON; 'PROCEDURE' COORDINATE(A1,A2,A3,T,TERMN); 'REAL' A1,A2,A3,T; 'BOOLEAN' TERMN; 'BEGIN' 'INTEGER' CHARA,CHARB,NUM,SIG; 'REAL' NUMBER; 'BOOLEAN' FIRST; A1 := A2 := A3 := T := 0.0; FIRST := 'TRUE'; SETSIG: SIG := 1; NUM := 0; CLEARB: CHARB := 0; NEXT: CHARA := INBASICSYMBOL(DIN); 'GOTO' 'IF' CHARA = 158 'OR' CHARA = 160 'OR' CHARA = 174 'THEN' NEXT 'ELSE' 'IF' CHARA = 193 'OR' CHARA = 20 9 'THEN' SIGNS 'ELSE' 'IF' CHARA <= 9 'THEN' DIGITS 'ELSE' 'IF' CHARA = 35 'OR' CHARA = 36 'OR' CHARA = 37 'THEN' XYZ 'ELSE' 'IF' CHARA = 161 'THEN' SLASH 'ELSE' TERMINA TOR; DIGITS: CHARB := CHARB*10+CHARA; FIRST := 'FALSE'; 'GOTO' NEXT; SLASH: NUM := CHARB; 'GOTO' CLEARB; XYZ: NUMBER := 'IF' NUM # 0 'THEN' SIG*NUM/CHARB 'ELSE' 'IF' CHARB # 0 'THEN' SIG*CHARB 'ELSE' SIG; 'IF' CHARA = 35 'THEN' A1 := NUMBER 'ELSE' 'IF' CHARA = 36 'THEN' A2 := NUMBER 'ELSE' A3 := NUMBER; 'GOTO' SETSIG; SIGNS: 'IF' FIRST 'THEN' 'BEGIN' SIG := 'IF' CHARA = 193 'THEN' +1 'ELSE' -1 ; FIRST := 'FALSE' 'END' LINE 331, ; 'IF' CHARB # 0 'THEN' 'BEGIN' T := 'IF' NUM # 0 'THEN' SIG*NUM/CHARB 'ELSE' SIG*CHARB; SIG := 'IF' CHARA = 193 'THEN' +1 'ELSE' -1 'END' LINE 336, ; NUM := 0; 'GOTO' CLEARB; TERMINATOR: 'IF' CHARA # 166 'AND' CHARA # 152 'THEN' 'BEGIN' NEWLINES(2); WRITETEXT('('WRONG TERMINATOR')'); 'END'; TERMN := CHARA = 152; 'IF' NUM # 0 'OR' CHARB # 0 'THEN' T := 'IF' NUM # 0 'THEN' SIG*NUM/CHARB 'ELSE' SIG*CHARB 'END' LINE 344, PROCEDURE COORDINATE; 'FOR' I := 0, 1, 2 'DO' 'BEGIN' COORDINATE(VECTOR[3*I+1],VECTOR[3*I+2],VECTOR[ 3*I+3],VECTOR[10+I],SEMICOLON); 'IF' SEMICOLON 'AND' I # 2 'OR' 'NOT' SEMICO LON 'AND' I = 2 'THEN' 'BEGIN' NEWLINES(2); WRITETEXT('('EQUIVALENT POSITIONS ARE OUT OF PHASE')'); 'GOTO' FAILURE 'END' LINE 352, 'END' LINE 353, 'END' LINE 354, PROCEDURE IN EQUIV POS; 'PROCEDURE' SORT (N,T,P,IN); 'VALUE' N,T,P; 'INTEGER' N,T,P; 'REAL' 'ARRAY' IN; 'BEGIN' 'INTEGER' H,I,J,FLAG; 'REAL' C; 'FOR' J := 1 'STEP' 1 'UNTIL' ENTIER (N/2) 'DO' 'BEGIN' FLAG := 0; 'FOR' I := J+1 'STEP' 1 'UNTIL' N-J+1 'DO' 'BEGIN' 'IF' IN [I,P] > IN [I-1,P] 'THEN' 'GOTO' L1; FLAG := 1; 'FOR' H := 1 'STEP' 1 'UNTIL' T 'DO' 'BEGIN' C := IN [I,H]; IN [I,H] := IN [I-1,H]; IN [I-1,H] := C; 'END' LINE 396, ; L1: 'IF' IN [N-I+1,P] < IN [N-I+2,P] 'THEN' 'GOTO' L2; FLAG := 1; 'FOR' H := 1 'STEP' 1 'UNTIL' T 'DO' 'BEGIN' C := IN[N-I+1,H]; IN [N-I+1,H] := IN [N-I+2,H]; IN [N-I+2,H] := C; 'END' LINE 404, ; L2: 'END' LINE 406, ; 'IF' FLAG = 0 'THEN' 'GOTO' FINISH; 'END' LINE 408, ; FINISH: 'END' LINE 410, PROCEDURE SORT; PIBYTWO := PI/2; RADIAN := PI/180; 'FOR' I := 1 'STEP' 1 'UNTIL' 200 'DO' 'BEGIN' J := ENTIER(TITLE[I]+0.5); 'IF' J = 152 'THEN' 'GOTO' UNITCELL; OUTBASICSYMBOL(DV2,J); 'END' LINE 418, ; UNITCELL: A := CELL[1]; B := CELL[2]; C := CELL[3]; ALPHA := CELL[4]; BETA := CELL[5]; GAMMA := CELL[6]; DMAX := READ; AMAX := READ; SKIPCHAR (DIN,160); 'IF' AMAX > DMAX 'OR' DMAX > 10 'THEN' 'BEGIN' NEWLINES(2); WRITETEXT('('D MAX OR A MAX INAPPROPRIATE')'); 'GOTO' END; 'END' LINE 432, ; DMAX := DMAX**2; NUM := 0; RESTRICTIONS := 'FALSE'; ENTER: I := INBASICSYMBOL (DIN); 'IF' I = 158 'THEN' 'GOTO' ENTER; 'IF' I = 25 'THEN' 'GOTO' NEXT 'ELSE' 'IF' I = 29 'THEN' 'BEGIN' NUM := READ; 'IF' NUM > 30 'THEN' 'BEGIN' NEWLINES(2); WRITETEXT('('TOO MANY RESTRICTIONS')'); 'GOTO' END; 'END' LINE 445, ; RESTRICTIONS := 'TRUE'; 'FOR' J := 1 'STEP' 1 'UNTIL' NUM 'DO' 'BEGIN' PACKTHREE(TEST[J,1]); PACKTHREE(TEST[J,2]); TEST[J,3] := READ**2; SKIPCHAR (DIN,160); 'END' LINE 453, ; 'GOTO' ENTER; 'END' LINE 455, 'ELSE' 'BEGIN' NEWLINES(2); WRITETEXT('('NUMBER OF CELLS NOT SPECIFIED')'); 'GOTO' END; 'END' LINE 460, ; NEXT : CKEY := READ; 'IF' CKEY # 0 'AND' CKEY # 1 'AND' CKEY # 27 'THEN' 'BEGIN' NEWLINES(2); WRITETEXT('('WRONG NUMBER OF CELLS')'); 'GOTO' END; 'END' LINE 466, ; 'IF' CKEY > 0.5 'THEN' 'GOTO' LATTICE; LT := CC := P := Z := 1; 'GOTO' EVALUATEMATRICES; LATTICE : LT := READ; CC := READ; P := READ; Z := P*CC; EVALUATEMATRICES: 'BEGIN' 'ARRAY' R[1:Z,1:12],AA[1:12]; 'IF' CKEY > 0.5 'THEN' 'BEGIN' 'FOR' I := 1 'STEP' 1 'UNTIL' P 'DO' 'BEGIN' INEQUIVPOS(DIN,DV1,AA,END); 'FOR' J := 1 'STEP' 1 'UNTIL' 12 'DO' R [I,J] := AA[J]; 'END' LINE 484, ; 'END' LINE 485, 'ELSE' 'BEGIN' 'FOR' I := 1 'STEP' 1 'UNTIL' 12 'DO' R[1 ,I] := 0.0; R[1,1] := R[1,5] := R[1,9] := +1; 'END' LINE 490, ; KEY1 := KEY2 := KEY3 := 0; PRNT : I := INBASICSYMBOL(DIN); 'IF' I = 152 'OR' I = 158 'OR' I = 160 'THEN' 'GOTO' PRNT 'ELSE' 'IF' I = 16 'THEN' 'GOTO' CPRFINISHED 'ELSE' 'IF' I = 27 'THEN' 'BEGIN' KEY1 := 1; SKIPCHAR (DIN,160); 'GOTO' PRNT; 'END' LINE 500, 'ELSE' 'IF' I = 26 'THEN' 'BEGIN' KEY2 := 1; SKIPCHAR (DIN,160); 'GOTO' PRNT; 'END' LINE 506, 'ELSE' 'IF' I = 30 'THEN' 'BEGIN' KEY3 := 1; SKIPCHAR (DIN,160); 'GOTO' PRNT; 'END' LINE 512, 'ELSE' 'BEGIN' NEWLINES(2); WRITETEXT('('OPTIONAL OUTPUT INSTRUCTIONS NOT UNDERSTOOD')'); 'GOTO' END; 'END' LINE 517, ; CPRFINISHED: AXESORTHOGONAL := ABS(PIBYTWO-ALPHA) < 0.000 000 1 'AND' ABS(PIBYTWO-BETA) < 0.000 000 1 'AND' ABS(PIBYTWO-GAMMA) < 0.000 000 1 ; 'IF' AXESORTHOGONAL 'THEN' 'BEGIN' NN[1,1] := A; NN[2,2] := B; NN[3,3] := C; NN[1,2] := NN[1,3] := NN[2,1] := NN[2,3] := NN[3,1] := NN[3,2] := 0.0; 'END' LINE 526, 'ELSE' 'BEGIN' NN[1,1] := A*SQRT((SIN(BETA))**2-((COS(GAMMA)-COS( ALPHA)*COS(BETA)) /SIN(ALPHA))**2); NN[2,1] := A*(COS(GAMMA)-COS(ALPHA)*COS(BETA))/SIN (ALPHA); NN[2,2] := B*SIN(ALPHA); NN[3,1] := A*COS(BETA); NN[3,2] := B*COS(ALPHA); NN[3,3] := C; 'END' LINE 537, ; 'IF' CC > 1.5 'THEN' 'BEGIN' 'FOR' I := 1 'STEP' 1 'UNTIL' P 'DO' 'FOR' J := 1 'STEP' 1 'UNTIL' 12 'DO' R [P+I,J] := -R[I,J]; 'END' LINE 542, ; LP := ('IF' LT <= 4 'THEN' LT-1 'ELSE' 1); SN := Z*(LP+1); 'BEGIN' 'ARRAY' TT[0:LP,1:3]; TT[0,1] := TT[0,2] := TT[0,3] := 0.0; 'IF' LP = 0 'THEN' 'GOTO' GENERATE; 'IF' LT = 2 'THEN' 'GOTO' ILATTICE 'ELSE' 'IF' LT = 3 'THEN' 'GOTO' RLATTICE 'ELSE' 'IF' LT = 4 'THEN' 'GOTO' FLATTICE 'ELSE' 'IF' LT = 5 'THEN' 'GOTO' ALATTICE 'ELSE' 'IF' LT = 6 'THEN' 'GOTO' BLATTICE 'ELSE' 'IF' LT = 7 'THEN' 'GOTO' CLATTICE 'ELSE' 'BEGIN' NEWLINES(2); WRITETEXT('('LATTICE NUMBER WRONG')'); 'GOTO' END; 'END' LINE 556, ; ILATTICE : TT[1,1] := TT[1,2] := TT[1,3] := 0.5; 'GOTO' GENERATE; RLATTICE : TT[1,1] := TT[2,2] := TT[2,3] := 1/3; TT[1,2] := TT[1,3] := TT[2,1] := 2/3; 'GOTO' GENERATE; FLATTICE : TT[1,1] := TT[2,2] := TT[3,3] := 0.0; TT[1,2] := TT[1,3] := TT[2,1] := TT[2,3] := TT[3,1] := TT[3,2] := 0.5; 'GOTO' GENERATE; ALATTICE : TT[1,1] := 0.0; TT[1,2] := TT[1,3] := 0.5; 'GOTO' GENERATE; BLATTICE : TT[1,2] := 0.0; TT[1,1] := TT[1,3] := 0.5; 'GOTO' GENERATE; CLATTICE : TT[1,3] := 0.0; GENERATE: 'BEGIN' 'ARRAY' Y[1:NAT,1:SN,1:3]; 'FOR' I := 0 'STEP' 1 'UNTIL' LP 'DO' 'FOR' J := 1 'STEP' 1 'UNTIL' Z 'DO' 'FOR' K := 1 'STEP' 1 'UNTIL' NAT 'DO' 'FOR' L := 1 'STEP' 1 'UNTIL' 3 'DO' Y[K,J+Z*I,L] := R[J,3*L-2]*X[K,1]+ R[J,3*L-1]*X[K,2]+R[J, 3*L]*X[K,3]+R[J,9+L]+TT[I,L]; 'FOR' I := 1 'STEP' 1 'UNTIL' SN 'DO' 'FOR' J := 1 'STEP' 1 'UNTIL' NAT 'DO' 'BEGIN' 'FOR' K := 1 'STEP' 1 'UNTIL' 3 'DO' F[K] := Y[J,I,K]; ORTHOGONALISE(F,G,NN,AXESORTHOGONAL); 'FOR' K := 1 'STEP' 1 'UNTIL' 3 'DO' Y[J,I,K] := G[K]; 'END' LINE 587, ; 'IF' CKEY < 1.5 'THEN' 'BEGIN' C1[1,1] := C1[1,2] := C1[1,3] := 0.0; CKEY := 1; 'GOTO' JUMP; 'END' LINE 593, ; I := 1; 'FOR' J := 1, 2, 3, 10, 11, 12, 19, 20, 21 'DO' C1[J,I] := 0; 'FOR' J := 4, 5, 6, 13, 14, 15, 22, 23, 24 'DO' C1[J,I] := +1; 'FOR' J := 7, 8, 9, 16, 17, 18, 25, 26, 27 'DO' C1[J,I] := -1; I := 2; 'FOR' J := 1, 4, 7, 10, 13, 16, 19, 22, 25 'DO' C1[J,I] := 0; 'FOR' J := 2, 5, 8, 11, 14, 17, 20, 23, 26 'DO' C1[J,I] := +1; 'FOR' J := 3, 6, 9, 12, 15, 18, 21, 24, 27 'DO' C1[J,I] := -1; I := 3; 'FOR' J := 1 'STEP' 1 'UNTIL' 9 'DO' C1 [J,I] := 0; 'FOR' J := 10 'STEP' 1 'UNTIL' 18 'DO' C1[J,I] := +1; 'FOR' J := 19 'STEP' 1 'UNTIL' 27 'DO' C1[J,I] := -1; JUMP: 'FOR' I := 1 'STEP' 1 'UNTIL' CKEY 'DO' 'BEGIN' 'FOR' J := 1 'STEP' 1 'UNTIL' 3 'DO' F[J] := C1[I,J]; ORTHOGONALISE(F,G,NN,AXESORTHOGONAL); 'FOR' J := 1 'STEP' 1 'UNTIL' 3 'DO' C2[I,J] := G[J]; 'END' LINE 611, ; 'IF' KEY1 < 0.5 'THEN' 'GOTO' OUTORTHOG; NEWLINES(3); SPACES(2); WRITETEXT('('A = ')'); PRINT(A,2,4); SPACES(2); WRITETEXT('('ANGSTROMS')'); SPACES(8); WRITETEXT('('ALPHA = ')'); PRINT(ALPHA*ANGLE,3,2); SPACES(2); WRITETEXT('('DEGREES')'); NEWLINES(2); SPACES(2); WRITETEXT('('B = ')'); PRINT(B,2,4); SPACES(2); WRITETEXT('('ANGSTROMS')'); SPACES(8); WRITETEXT('('BETA = ')'); PRINT(BETA*ANGLE,3,2); SPACES(2); WRITETEXT('('DEGREES')'); NEWLINES(2); SPACES(2); WRITETEXT('('C = ')'); PRINT(C,2,4); SPACES(2); WRITETEXT('('ANGSTROMS')'); SPACES(8); WRITETEXT('('GAMMA = ')'); PRINT(GAMMA*ANGLE,3,2); SPACES(2); WRITETEXT('('DEGREES')'); NEWLINES(5); 'FOR' I := 0 'STEP' 1 'UNTIL' LP 'DO' 'FOR' J := 1 'STEP' 1 'UNTIL' Z 'DO' 'BEGIN' 'FOR' K := 1 'STEP' 1 'UNTIL' 9 'DO' AA[K] := R[J,K]; 'FOR' K := 1 'STEP' 1 'UNTIL' 3 'DO' AA[9+K] := R[J,9+K] + TT[I,K]; SPACES(2); OUTEQUIVALENT POSITIONS(DV2,J+Z*I,AA); 'END' LINE 634, ; NEWPAGE; NEWLINES(2); SPACES(2); WRITETEXT('('FRACTIONAL COORDINATES')'); NEWLINES(2); 'FOR' I := 1 'STEP' 1 'UNTIL' NAT 'DO' 'BEGIN' SPACES(4); OUTNAME (DV2,DV1,CH[I,1],CH[I,2],END); 'FOR' J := 1 'STEP' 1 'UNTIL' 3 'DO' PRINT(X[I,J],6,5); NEWLINES(1); 'END' LINE 643, ; OUTORTHOG: 'IF' KEY2 < 0.5 'THEN' 'GOTO' BEGIN; NEWPAGE; NEWLINES(2); SPACES(2); WRITETEXT('('ORTHOGONAL COORDINATES')'); NEWLINES(2); 'FOR' I := 1 'STEP' 1 'UNTIL' NAT 'DO' 'BEGIN' SPACES(4); OUTNAME (DV2,DV1,CH[I,1],CH[I,2],END); 'FOR' J := 1 'STEP' 1 'UNTIL' 3 'DO' PRINT(X[I,J],8,4); NEWLINES(1); 'END' LINE 654, ; BEGIN: 'FOR' I := 1 'STEP' 1 'UNTIL' NAT 'DO' 'BEGIN' 'INTEGER' COUNT; 'ARRAY' RES[1:500,1:(7+KEY3)]; COUNT := 0; 'FOR' J := 1 'STEP' 1 'UNTIL' CKEY 'DO' 'FOR' K := ('IF' KEY3 > 0.5 'AND' J = 1 'THEN' 2 'ELSE' 1) 'STEP' 1 'UNTIL' SN 'DO' 'FOR' L := 1 'STEP' 1 'UNTIL' NAT 'DO' 'BEGIN' 'FOR' M := 1 'STEP' 1 'UNTIL' 3 'DO' F[M] := Y[L,K,M]+C2[J,M]-Y[I,1,M ]; S := F[1]**2+F[2]**2+F[3]**2; D := DMAX; 'IF' 'NOT' RESTRICTIONS 'THEN' 'GOTO' OUT; 'BEGIN' 'BOOLEAN' CHECK1,CHECK2; 'FOR' M := 1 'STEP' 1 'UNTIL' NU M 'DO' 'FOR' N := 1 'STEP' 1 'UNTIL' 2 'DO' 'BEGIN' CHECK1 := ABS(CH[I,1]-TEST[M,N]) < 0.1; CHECK2 := ABS(CH[L,1]-TEST[M,( 'IF' N = 1 'THEN' 2 'ELSE' 1)]) < 0.1; 'IF' CHECK1 'AND' CHECK2 'THEN' D := TEST[M,3]; 'END' LINE 680, ; 'END' LINE 681, TESTING BLOCK; OUT: 'IF' S > D 'OR' S = 0 'THEN' 'GOTO' NOTREQUIRED; COUNT := COUNT+1; 'IF' COUNT = 500 'THEN' 'BEGIN' NEWLINES(2); WRITETEXT('('TOO MANY BOND LENGTHS ASKED FOR')'); 'END'; RES[COUNT,1] := L; RES[COUNT,2] := K; RES[COUNT,3] := J; 'FOR' M := 4 'STEP' 1 'UNTIL' 6 'DO' RES[COUNT,M] := F[M-3]; RES[COUNT,7] := SQRT(S); NOTREQUIRED: 'END' LINE 692, ; SORT(COUNT,(7+KEY3),7,RES); 'COMMENT' PDS AGAIN NEWPAGE; NEWLINES(2); SPACES(2); WRITETEXT('('ATOM A')'); SPACES(6); WRITETEXT('('ATOM B')'); SPACES(5); WRITETEXT('('EP')'); SPACES(6); WRITETEXT('('CELL')'); SPACES(6); WRITETEXT('('A-B ANGSTROMS')'); NEWLINES(2); 'FOR' J := 1 'STEP' 1 'UNTIL' COUNT 'DO' 'BEGIN' SPACES(2); OUTNAME (DV2,DV1,CH[I,1],CH[I,2],END); SPACES(5); OUTNAME (DV2,DV1,CH[RES[J,1],1],CH[RE S[J,1],2],END); SPACES(4); OUTSYMMETRY (DV2,RES[J,2],C1,RES[J,3]) ; SPACES(2); PRINT(RES[J,7],5,4); NEWLINES(1); 'END' LINE 703, ; 'IF' AMAX # 0 'AND' COUNT > 1.5 'THEN' 'BEGIN' 'COMMENT' PDS AGAIAN; 'GOTO' SKIP OPUT; NEWLINES(2); SPACES(2); WRITETEXT('('ATOM A')'); SPACES(4); WRITETEXT('('EP')'); SPACES(6); WRITETEXT('('CELL')'); SPACES(13); WRITETEXT('('ATOM B')'); SPACES(7); WRITETEXT('('ATOM C')'); SPACES(3); WRITETEXT('('EP')'); SPACES(6); WRITETEXT('('CELL')'); SPACES(6); WRITETEXT('('ANGLE ABC')'); NEWLINES(2); 'FOR' J := 1 'STEP' 1 'UNTIL' COUNT 'DO' 'FOR' K := J+1 'STEP' 1 'UNTIL' C OUNT 'DO' 'BEGIN' 'IF' RES[J,7] > AMAX 'OR' RES[K,7 ] > AMAX 'THEN' 'GOTO' ONEMORE; T := (RES[J,4]*RES[K,4]+RES[J,5]* RES[K,5]+RES[J,6]*RES[K, 6])/(RES[J,7]*RES[K,7]); 'IF' T = 0 'THEN' 'BEGIN' T := 90.0; 'GOTO' CASE; 'END' LINE 718, 'ELSE' 'IF' T >= +1 'THEN' 'BEGIN' T := 0.0; 'GOTO' CASE; 'END' LINE 723, 'ELSE' 'IF' T <= -1 'THEN' 'BEGIN' T := 180.0; 'GOTO' CASE; 'END' LINE 728, ; T := ARCTAN(SQRT(1-T**2)/T)*ANGLE; 'IF' T < 0 'THEN' T := 180.0+T; CASE : SPACES(2); OUTNAME(DV2,DV1,CH[RES[J,1],1],CH[RES[J,1],2],END); SPACES(3); OUTSYMMETRY (DV2,RES[J,2],C1,RES[J,3 ]); SPACES(10); OUTNAME (DV2,DV1,CH[I,1],CH[I,2],EN D); SPACES(6); OUTNAME (DV2,DV1,CH[RES[K,1],1],CH [RES[K,1],2],END); SPACES(2); OUTSYMMETRY (DV2,RES[K,2],C1,RES[K,3 ]); PRINT(T,7,2); NEWLINES(1); ONEMORE: 'END' LINE 740, ANGLE CALCULATION; SKIPOPUT: 'END' LINE 741, ANGLE SEARCHING LOOP; 'END' LINE 742, LOOP THROUGH ATOM LIST; 'END' LINE 743, CELL COORDINATE BLOCK; 'END' LINE 744, BLOCK LATTICE TYPE; 'END' LINE 745, BLOCK EQUIVALENT POSITIONS; END: 'GOTO' TERMINATE; 'END' LINE 747, DBXA161 BLOCK 'END' LINE 748, ARRAY BLOCK; FAILURE: TERMINATE: 'END' //RUN J.G.SIME DIDPS BOND LENGTH DATA; 19.715 4.946 14.448 90 103.25 90 9 1 0 0 1 0 0 I(1) 0.0473 0.9360 0.1823 0 0.339 S(1) 0.2500 0.1405 0.0000 0 0.260 O(1) 0.2110 -0.0232 -0.0769 0 0.208 C(1) 0.1982 0.3511 0.0404 0 0.205 C(2) 0.1344 0.4208 -0.0135 0 0.243 C(3) 0.0966 0.6192 0.0342 0 0.328 C(4) 0.1123 0.6864 0.1258 0 0.327 C(5) 0.1666 0.6090 0.1722 0 0.477 C(6) 0.1922 0.4266 0.1325 0 0.345 999 3.5 3.5 *NUMBER OF CELLS (27) 2 2 2 X, Y, Z; 1/2-X, -Y, 1/2+Z; *END DESTROY(Y44)