Title                  :ONEDISANL
Keywords               :CTEM, DISOLOCATIONS
Computer               :DEC VAX 11/730-785, DEC PDP 11/2-11/73
Operating System       :VAXVMS, RT-11
Programming Language   :Fortran IV
Hardware Requirements  :None
Author(s)              :R. J. Holton 
Correspondence Address :Argonne Nat. Lab, Electron Microscopy Center,Bldg 212
                       :Materials Science Division, Argonne, Illinois 60439,
Abstract:

ONEDISANL is a modified version of the original ONEDIS program developed
by the group of A.K. Head, P. Humble, L.M. Clarebrough, A.J. Morton and
C.T. Forwood at CSIRO Division of Tribophysics, University of Melbourne, 
Autralia for calculating disolcation images for the TEM. This version
modifies only their output algorithms for output to a serial data file rather
than overprinting upon a line printer. Using the included program (IMOUT) 
this can then be displayed as a randomized dither pattern on a DEC LA100 or 
LA50 printer
-------------------------------------------------------------------------------

                       
Title                  :ONEDISANL
Keywords               :CTEM, DISOLOCATIONS
Computer               :DEC VAX 11/730-785, DEC PDP 11/2-11/73
Operating System       :VAXVMS, RT-11
Programming Language   :Fortran IV
Hardware Requirements  :None
Author(s)              :R. J. Holton 
Correspondence Address :Argonne Nat. Lab, Electron Microscopy Center,Bldg 212
                       :Materials Science Division, Argonne, Illinois 60439,
DOCUMENTATION:

ONEDISANL is a modified version of the original ONEDIS program developed
by the group of A.K. Head, P. Humble, L.M. Clarebrough, A.J. Morton and
C.T. Forwood at CSIRO Division of Tribophysics, University of Melbourne, 
Autralia for calculating disolcation images for the TEM. This version
modifies only their output algorithms for output to a serial data file rather
than overprinting upon a line printer. Using the included program (IMOUT) 
this can then be displayed as a randomized dither pattern on a DEC LA100 or 
LA50 printer.


Extensive documentation for the ONEDIS program can be found in the book:

Computed Electron Micrographs and Defect Identification
A.K. Head, P. Humble, L.M. Clarebrough, A.J. Morton and C.T. Forwood
CSIRO Division of Tribophysics
University of Melbourne, Autralia

1973 Noth Holland Publishing Co.


Compilation Procedure: RT11 

FORTRAN/NOSWAP/NOLINENUMBERS  ONEDIS,ANCALC,NEWTON,DERIV,RKM,HALFTN
FORTRAN/NOSWAP/NOLINENUMBERS  PUTBLK,IRANDM

R LINK
WD:ONEDIS,TM:=RD:ONEDIS,RD:ANCALC,RD:NEWTON,RD:DERIV/C
RD:RKM,RD:HALFTN,RD:PUTBLK,RD:IRANDM
^C

TEST DATA.

C11,C12,C44, TITLE, ANANOMOLOUS ABSORPTION, BURGERS VECTOR,LINEDIRECTION,
DIFFRACTING VECTOR,BEAM DIRECTION,FOIL NORMAL,W, THICK,
       
1.291      1.097     0.824         BETA BRASS                          0.09
 1 1 1/1 -3 5 5 -1-2 1  1 1 3  0 1 3 0.7 3.0 0.0 3.0 1   TEST MICROGRAPH
 
Output Results: (image intensity written as an integer [0-36] 131points/row)

TOF:
 CSIRO ONEDIS      BETA BRASS  CIJ = 1.29,1.10,0.82  L,W = 2.71,1.25  1 1 1/1B

 -3 5 5U  -1-2 1G   1 1 3BD   0 1 3FN  W=0.70  TH=3.00  THBD=3.15  ANO=-0.09

30303030302929292928282828282727272727272626262626262525252524242423232323222222

22222221212121212121212020202020191919191818181817171717171716161616161616161616

16161616161616161616151515151515151515151515151515161616161717171818181819191919

202020202020212121 0 0

30303030302929292928282828282727272727272626262626252525252424242423232323222222

22212121212121212120202020202019191919181818181717171716161616161616161616161616

16161616161616161615151515151515151515151515151515151616161717171718181819191919

202020202020202121 0 0

31303030303029292928282828282727272727272626262626252525252424242323232322222222

21212121212121212020202020201919191918181817171717161616161616161616161616161616

16161616161616161515151515151514141414141414151515151516161617171718181819191919

202020202020202121 0 0

31313030303029292928282828272727272727272626262626252525252424242323232222222221

21212121212120202020202020191919191818181717171716161616161515151515151516161616

16161616161616151515151515151414141414141414141415151515161616171718181818191919

192020202020202121 0 0

31313130303029292929282828272727272727272626262626252525252424242323222222222121

21212120202020202020202019191919181818171717171616161515151515151515151515151515

16161616161615151515151515141414141414141414141414151515161616171717181818191919

192020202020202021 0 0

31313130303030292929282828272727272727272626262626252525252424232323222222212121

21202020202020202020201919191918181818171716161616151515151515151515151515151515

15151616161515151515151514141414141414141414141414141515151616171717181818191919

192020202020202021 0 0

31313131303030292929282828272727272727272626262626252525242424232322222221212120

20202020202020202019191919191918181817171716161515151515141414141414141515151515

15151515151515151515151514141414141313131313131414141415151616161717181818191919

192020202020202021 0 0

31313131313030292929282828272727272727272626262626252525242424232322222121212020

20202020191919191919191919191818181717171616151515151414141414141414141414151515

15151515151515151515151414141414131313131313131314141415151516161717181818191919

202020202020202121 0 0

32313131313030292929282828272727272727272626262626252525242423232222212121202020

19191919191919191919191919181818181717161615151514141414141313141414141414141515

15151515151515151515151414141413131313131313131313141414151516161717181818191919

202020202020202121 0 0

32323131313030302929282828272727272727272626262626252525242423232222212120201919

19191919191919191919191918181818171716161615151414141313131313131313141414141515

15151515161515151515151414141413131313131313131313131414151515161717181818191919

202020202020212121 0 0

32323231313130302929282827272727272727272726262626252525242423222221212020191919

19181818181819191919191818181817171716161515141414131313131313131313131414141415

15151516161616151515151514141413131313131213131313131314141515161617181818191920

202020202021212121 0 0

32323232313130302929282827272727272727272726262626262525242323222121202019191818

18181818181818181818181818181817171616151515141413131312121212121313131314141415

15151516161616161515151514141413131313121212121213131314141515161617181819191920

202020212121212121 0 0

32323232313130302929282827272727272727272727262626262525242323222120201919181818

17171718181818181818181818181817171616151514141313131212121212121213131314141415

15151616161616161615151514141413131312121212121212131313141415161617181819192020

202021212121212121 0 0

32323232323130302928282727272727262727272727272626262524242322212120191818181717

17171717171818181818181818181817171616151514131312121212121212121212131313141415

15151616161616161616151515141413131312121212121212121313141415161617181819192020

202121212121212121 0 0

33333232323130302928282727272626262727272727272626262524232322212019181817171616

16161617171718181818181818181817171616151414131312121111111111111212121313141415

15151616161616161616161515141413131312121212121212121313131415151617181819192020

212121212121212121 0 0

33333332323130302928282727262626262627272727272726262524232221201918171716161616

15161616171717181818181818181817171616151414131212111111111111111112121313141415

15161616171717171616161515151414131312121212121212121213131415151617181819202021

212122222222222222 0 0

33333332323130302928272726262626262627272727272726252524232220191817161615151515

15151516161717181818191919181818171616151413131212111111101010111111121213131415

15161617171717171716161615151414131312121211111111121212131414151617181819202121

212222222222222222 0 0

33333332323130292828272626262626262627272727272726252423222120181716151514141414

14141515161717181819191919191818171616151413131211111010101010101111121213131415

15161717171717171717171616151414131312121111111111111212131314151617181819202121

222222232322222222 0 0

33333333323130292827262625252526262627272827272726252423212018171615141413131313

13141515161717181919191919191918181716151413121211111010101010101011111213141415

16161717181818181817171616151514131312121111111111111112121314151617181920202122

222323232323232222 0 0

33333333323130292827262525252526262727272828272726252322201917161414131212121212

13141415161718191920202020201919181716151413121111101010 9 910101011111213141515

16171718181819181818171716151514131312121111111010111111121313141516181920212222

232324242423232322 0 0

33333332323129282726252524252526262728282828272625242220191715141312111111111112

1313141516171819202021212120201918171615141312111010 9 9 9 9 9101011121213141516

17171819191919191918181716151514131312111110101010101011111213141516171920212223

232424242424242323 0 0

33333332313029272625242424242526272728282828272624222119171513121111101010101112

13141516171819202121222121212019181716141312111110 9 9 9 9 9 9101011121314151617

1818191920202020191918171615151413121211101010 9 9 91010111212131516171920212223

242425252524242323 0 0

3333333231292826252423232324252627282929282726242320181614131110 9 9 9 9 9101112

131416171820212122222322222120191816151412111010 9 9 9 9 9 9 9101112131415161718

192020212121212020191817161514131312111010 9 9 9 9 9 9 9101112131416171820212223

242525252525242423 0 0

323232312928262423222222232426272829292928262522201815131110 9 8 7 7 7 8 9101112

14151718202122232424242322212018171514131110 9 9 8 8 8 8 8 9 9101112131416171819

2021222222222121201918171615141312111010 9 8 8 8 8 8 8 8 91011121315171820212224

252526262625252423 0 0

30303029272523212020202223252728303030282725221917141210 8 7 6 5 5 6 6 7 8 91113

141618202223242425252423222119171614121110 9 8 7 7 7 7 7 8 8 9101112131516181920

222223232323222120191817151413121110 9 9 8 7 7 6 6 6 6 7 7 8 9111214161819212223

252526262626252524 0 0

2727272523211817161819212426293031302927252219161310 8 6 4 4 3 3 3 4 5 6 7 91113

15171921222425252625242322201816141210 9 8 7 6 6 6 6 6 6 6 7 8 91011131416181921

222323232323222120191716151412111010 9 8 7 6 5 5 4 4 4 4 5 6 8 91113151719202223

242526262626262524 0 0

222222191714121213151821242729303029272422181511 8 6 3 2 1 1 1 1 1 2 3 5 6 8 911

1416182022232425252423222018151311 9 8 7 5 5 4 4 4 4 4 4 5 5 6 7 8 9101214161819

2122232322222120181716151413121110 9 8 7 5 4 3 2 1 1 1 2 2 4 5 7 911131618202123

242526262727262625 0 0

16151512 9 7 6 8101417212426282828262521181511 8 4 2 1 1 1 1 1 1 1 1 2 3 4 6 7 9

11131517192122232322211918151311 8 7 5 4 3 3 3 3 3 3 3 3 3 3 3 4 4 6 7 911131516

18192020202019181615141312111010 9 8 7 6 4 3 2 1 1 1 1 1 1 1 2 4 6 9121416182022

232425262727272727 0 0

 8 7 7 4 1 2 3 6 913162023252727272523201713 9 6 3 1 1 1 1 1 1 1 1 1 1 1 3 4 5 7

 91113151718202021202018161412 9 7 5 4 3 2 2 2 2 2 2 2 2 2 2 2 2 2 3 4 6 8101214

161718181918171615141312111010 9 8 8 7 6 4 3 1 1 1 1 1 1 1 1 1 2 4 7101215171921

232425262727282828 0 0

 4 2 1 1 1 3 5 9121518212426282828272522191612 9 6 3 1 1 1 1 1 1 1 1 2 3 4 6 7 8

1012131517192021222221201917151210 9 7 6 5 4 4 4 4 4 4 4 4 4 4 4 4 5 5 7 8101214

16171819201919181817151514131212111110 9 8 6 4 3 1 1 1 1 1 1 1 2 4 6 91114161921

222425262728292930 0 0

 6 3 1 2 2 4 71013161922252628282927262320161310 6 4 2 1 1 1 1 1 1 2 3 4 5 6 8 9

1113141618202122232222211917151311 9 8 7 6 5 5 5 5 5 5 5 5 5 5 5 5 6 6 8 9111315

16181920202020191817161515141313121110 9 8 7 5 3 2 1 1 1 1 1 1 3 5 7101215171921

232425272828293030 0 0

 1 1 2 3 4 6 811141821242728292928262421181411 8 5 3 1 1 1 1 1 1 1 1 2 3 5 7 811

13151719212324242423222018161311 9 7 5 4 3 3 2 2 2 2 2 3 3 3 4 5 6 8101214161819

2122222222212018171514131110 9 8 7 6 5 4 3 2 1 1 1 1 1 1 3 5 7 91214171921232425

262627272727272728 0 0

 1 1 1 3 5 8111417202325272828272522191613 9 6 4 1 1 1 1 1 1 1 1 1 1 1 3 5 81113

16182122232424232119171512 9 7 5 3 1 1 1 1 1 1 1 1 1 1 1 2 4 5 81012151719202222

2221211917151311 9 7 5 4 2 1 1 1 1 1 1 1 1 1 1 1 1 3 5 8101315182021232324232323

222121202021222325 0 0

 1 1 1 1 4 71014172022242525252321181512 9 6 4 2 1 1 1 1 1 1 1 1 1 1 2 4 7101215

1819212222212018161310 7 5 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 6 8111416181920202019

17151310 7 5 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 4 6 91214171820202120191817151312

101010111315172022 0 0

 1 1 1 1 1 4 7101316182021212120191716141210 8 6 5 3 2 1 1 1 1 1 1 1 3 5 7101315

17181919191817141210 8 5 3 2 1 1 1 1 1 1 1 1 1 1 1 1 2 4 6 911131617181818171614

11 9 6 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 5 7101214161819191917161411 9 6 4 2 1

 1 1 2 5 710141720 0 0

 1 1 1 1 1 1 2 5 8101214161718181818181818171615141210 9 7 5 4 3 3 3 4 5 6 81012

1415161616151413121110 9 8 7 7 6 6 5 5 5 4 4 4 4 4 5 6 7 91012131515161515141210

 8 6 4 2 1 1 1 1 1 1 1 1 1 1 2 3 3 5 6 7 9111314161718181816151310 7 4 1 1 1 1 1

 1 1 1 1 4 8111518 0 0

 1 1 1 1 1 1 1 1 2 4 6 9111315161819212223232323222019161412 9 8 6 5 4 4 5 6 7 8

 91011121213131313131414141515151514141312111010 9 9 9 9 910111112121212121110 9

 7 7 6 5 5 5 5 6 7 7 8 910101111121213131415161617171716151311 8 5 2 1 1 1 1 1 1

 1 1 1 1 2 6101317 0 0

 1 1 1 1 1 1 1 1 1 1 2 4 7 9121417202224262728282827252320171411 9 7 5 4 3 4 4 4

 5 6 7 8 91012131415171819202122222121201917161413111010 9 9 9 9 9 9 9 9 9 9 8 8

 8 8 8 9 910111314151617171718181717171717171717161615141210 8 5 2 1 1 1 1 1 1 1

 1 1 1 1 1 5 91316 0 0

 1 1 1 1 1 1 1 1 1 1 1 2 4 71013161922252729313132302927252219151210 7 5 4 3 3 3

 3 4 5 6 7 910121416182022232525262626242321201715141211 9 9 8 8 7 7 7 7 7 7 8 8

 8 9101112141517181921212222222121201919181717161514131110 8 5 3 1 1 1 1 1 1 1 1

 1 1 1 1 1 5 81215 0 0

 1 1 1 1 1 1 1 1 1 1 1 1 3 5 81114172124272931323333323028252319161310 8 6 4 3 3

 3 3 4 5 6 7 911131518202224262728282827262523201816141210 9 8 7 6 6 6 6 6 7 7 8

 8 91112131517182021232324242423232221191817161514131210 8 6 4 2 1 1 1 1 1 1 1 1

 1 1 1 1 1 5 81115 0 0

 1 1 1 1 1 1 1 1 1 1 1 1 2 4 7101316192326293133333333333129262320171411 8 7 5 4

 3 3 3 4 5 7 81012151719222426282930302929272523211816141210 9 8 7 6 6 6 6 6 6 7

 8 910121315171820222324252525242322212019171615141211 9 8 6 4 2 1 1 1 1 1 1 1 1

 1 1 1 1 1 5 81114 0 0

 1 1 1 1 1 1 1 1 1 1 1 1 1 4 6 9121518212528313333333333333229262320171411 9 7 6

 5 4 4 4 5 6 7 91114161821232628293031313129282623211916141210 9 7 6 6 6 5 5 6 6

 7 8 9111214161819212223242525252423222119181715141211 9 8 6 4 2 1 1 1 1 1 1 1 1

 1 1 1 1 2 5 81114 0 0

 3 3 2 1 1 1 1 1 1 1 1 1 2 3 5 811141721242730323333333333333229262320171412 9 8

 6 6 5 5 5 6 7 9101315182023252729313232323130282623211816141110 8 7 6 6 5 5 5 6

 6 7 810111315161820222324252525252423222019171614131110 8 6 5 3 1 1 1 1 1 1 1 1

 1 1 1 1 3 5 81113 0 0

 5 4 4 3 2 1 1 1 1 1 1 1 2 4 5 8101316202326303233333333333333312926232016141110

 8 7 6 6 6 6 7 9101214172022252729313233333231302825232018151311 9 8 6 6 5 5 5 5

 5 6 7 9101213151719212224242525252424222120181715131210 9 7 6 4 2 1 1 1 1 1 1 1

 1 1 1 1 3 6 81113 0 0

 7 6 5 4 3 2 2 1 1 1 1 2 2 4 5 8101316192326293233333333333333323027242118161311

 9 8 7 7 6 7 7 910121417192224272931323333333231292724221917141210 8 7 6 5 5 5 5

 5 6 7 8 9111314161820222324252525252423222119181614131110 8 7 5 4 2 1 1 1 1 1 1

 1 1 1 2 4 6 81113 0 0

 8 7 6 5 4 3 3 2 2 2 2 2 3 4 6 8101316192326293133333333333333333128262320171513

11 9 8 8 7 8 8 910121417192224272931323333333332302825232018151311 9 7 6 5 5 5 5

 5 6 6 7 9101214161820212324252526252524232120191715141211 9 8 6 5 4 2 2 1 1 1 1

 1 1 2 3 5 7 91113 0 0

 8 8 7 6 5 4 4 3 3 3 3 3 4 5 7 9111416192225293133333333333333333229272421181614

1211 9 9 8 9 9101113151719222426293032333333333230282624211816141110 8 7 6 5 5 5

 5 6 6 7 810121315171921222425252626252424222119181615131210 9 7 6 5 4 3 2 2 1 1

 2 2 3 4 6 7 91113 0 0

 9 8 7 7 6 5 4 4 3 3 4 4 5 6 7 9111417192225283133333333333333333230272522201715

13121110 91010111213151719222426283032333333333230282624221917141210 9 8 6 6 5 5

 5 6 6 7 81011131517192022232525262626252423222019171614131110 9 7 6 5 4 4 3 3 3

 3 4 4 5 7 8101113 0 0

 9 9 8 7 6 6 5 5 4 4 5 5 6 7 810121417202225283032333333333333333230282523211816

14131211111111121314161819222426283031323333323130282724222017151311 9 8 7 7 6 6

 6 6 7 8 9101113151718202223242526262625252322212018171514121110 9 7 6 6 5 4 4 4

 4 5 5 6 7 9101213 0 0

10 9 8 8 7 7 6 6 5 5 6 6 7 8 911131517202225273032333333333333333230282624211918

1614131312121213141516182022242527293031323232313028262422201816141210 9 8 7 7 7

 6 7 7 8 910121315171820212324252526262525242322201918161513121110 9 8 7 6 6 5 5

 5 6 6 7 8 9111213 0 0

1010 9 8 8 7 7 7 6 7 7 7 8 91012131518202225272931323333333333333230282624222019

171615141313131414161718202223252728293031313130292826242220181614131110 9 8 8 7

 7 8 8 9101112131516182021222424252526252524232221201817161413121110 9 8 7 7 6 6

 6 7 7 8 910111214 0 0

1110 9 9 8 8 8 8 7 7 8 8 9101112141618202224262830323333333333323130282725232120

18171615141414151516171820212325262729293030302929272624232119171514121110 9 9 8

 8 8 9 910111214151618192122232425252525252424232120191816151413121110 9 8 8 8 8

 7 8 8 91010111314 0 0

11111010 9 9 9 8 8 8 9 910111213141618202224262829313232333333323130282725242220

1918171615151516161717192021232425262828292929282827262423211918161413121110 9 9

 9 9 9101112131415171819212223242525252525242423222120181716151413121110 9 9 9 9

 8 9 9101011121314 0 0

111111101010 9 9 9 9 91011111214151618202224252729303132323232313130282726242321

20191817161616161617181920212223252627272828282827262524232120181715141312111010

10101011111213141517181920222323242525252524242322212019181716151413121110101010

 91010101112121314 0 0

12121111101010101010101111121314151718202123252628293031313131313029282726252322

21201918171717171717181920212223242526262727272727262524232120191716151413121111

11111111121313141517181920212223242425252524242322212119181716151413131211111110

101011111112131415 0 0

12121211111111111111111112131314161718202123242627282930303131303029282726252422

21201919181817171718181920212122232425262626262626252524232220191817161514131212

12121212131314151617181920212223232424242424242323222120191817161514131312121111

111111121213131415 0 0

13121212121211111111121212131415161718202122242526272829303030302929282726252423

22212019181818181818181919202122232324252526262625252424232221201817161515141313

13131313131414151617181920212222232424242424242323222120191817171615141413131212

121212121313141415 0 0

13131312121212121212121313141415161718192122232426272828292929292928282726252423

22212020191918181818181919202121222324242525252525252423232221201918171615151414

13131314141415151617181920212122232324242424242323222120201918171616151414131313

131313131314141515 0 0

13131313131212121213131313141515161718192022232425262727282829282828272726252423

22212120191918181818191919202021222223232424242424242423232221201918181716151515

14141414141515161617181920202122232323242424232323222121201918181716151514141413

131313131414151516 0 0

14141313131313131313131314141516161718192021222324252627272828282827272626252423

22222120201919191818191919202021212222232324242424242423232221202019181717161615

15151515151516161717181920202122222323232323232323222221202019181717161515151414

141414141415151516 0 0

99

EOF:


-------------------------------------------------------------------------------

               
Title                  :ONEDISANL
Keywords               :CTEM, DISOLOCATIONS
Computer               :DEC VAX 11/730-785, DEC PDP 11/2-11/73
Operating System       :VAXVMS, RT-11
Programming Language   :Fortran IV
Hardware Requirements  :None
Author(s)              :R. J. Holton 
Correspondence Address :Argonne Nat. Lab, Electron Microscopy Center,Bldg 212
                       :Materials Science Division, Argonne, Illinois 60439,
SOURCE CODE:

THIS IS A COMBINATION OF THE ORIGINAL ONEDIS SOURCE CODE AND THE MODIFIED
OUTPUT ROUTINE UTILIZED AT ANL

      PROGRAM ONEDIS
      DIMENSION LB(3),LU(3),LG(3),LBM(3),LFN(3),IY(15),IZ(26),BD(3),
     1 GD(3),BM(3),FN(3),FNX(3),DCX(3,3),DR(3),UR(3,3),UI(3,3),DI(3),
     2 VR(3,3),VI(3,3),CB(3),CU(3),CG(3),CBM(3),CFN(3),TB(155),
     3 TEMPY(8),FX(80,4),MARKS(2),IFILE(8)
      COMMON/RKMDRV/CN(30),X,X1,Y(8),ERROR,SKIP,Q,D(8),ANO
      COMMON/ANCNEW/NEW,ZR,ZI,QR(7),QI(7),KRASH,C11,C12,C44,DC(3,3),
     1 C(6,6),PR(3),PI(3),AR(3,3),AI(3,3),ELR(3,3),ELI(3,3),EMR(3,3),
     2 EMI(3,3),B(3,3),H(3,3)
      COMMON/DATA/NP(3),NQ(3),MM(3),NN(3),L1(6),L2(6),L3(3,3),PY,MR,
     +            MW,MOF
      DATA NP/2,3,1/,NQ/3,1,2/,MM/1,6,5/,NN/6,2,4/,L1/1,2,3,2,3,1/
      DATA L2/1,2,3,3,1,2/,L3/1,6,5,6,2,4,5,4,3/,PY/3.1415926536/
      DATA MR/2/,MW/7/
      DATA MARKS/' ','D'/
7     WRITE (7,1)
1     FORMAT (1X,'Enter input data file name: ',$)
      CALL ASSIGN(MR,DUMMY,-1,'OLD')
10    READ(MR,20)C11,C12,C44,IY,ANO
C     WRITE (6,*) C11,C12,C44,ANO
20    FORMAT(3F10.0,15A1,25X,F9.0)
      IF(C11)30,30,40
30    STOP
40    CONTINUE
1233  WRITE(7,1235) 
1235  FORMAT(' ','Output to a (F)ile, (L)A-100, or (P)eritek? ',$)
      READ(5,1236) IANS
1236  FORMAT(A1)
      IF (IANS .EQ. 'F') GOTO 1299
      IF (IANS .EQ. 'L') GOTO 1255
      IF (IANS .NE. 'P') GOTO 1233
      IDEV = 0
      ITV = 0
      GOTO 1300
1255  NESC = 27
      WRITE(6,1234) NESC
1234  FORMAT(' ',A1,'P1q')
      IDEV = -1
      GOTO 1300
1299  WRITE (7,11)
11    FORMAT(' ENTER RT-11 OUTPUT DATA FILE NAME: ',$)
      IDEV = 3
      CALL ASSIGN(IDEV,DUMMY,-1,'NEW','CC')
1300  READ(MR,50)LB,LD,LU,LG,LBM,LFN,W,THICK,START,FINISH,LPR,IZ
C     WRITE (6,*) LB,LD,LU,LG,LBM,LFN,W,THICK,START,FINISH,LPR
50    FORMAT(3I2,1X,I1,1X,3I2,1X,3I2,1X,3I2,1X,3I2,4F4.0,I2,26A1)
C     NTIME=ITIME(X)
      CN(14)=2.0*W
C     IF(LD)70,60,70
C60   LD=1
      IF (LD .EQ. 0) LD = 1
C70   IF(ANO)90,80,90
C80   ANO=0.1
      IF (ANO .EQ. 0.0) ANO = 0.1
90    ANO=-ANO
C     IF(FINISH)120,100,120
C100  IF(START)120,110,120
C110  START=0.0
      IF (FINISH .NE. 0.0) GOTO 120
      IF (START .NE. 0.0) GOTO 120
      START = 0.0
      FINISH=THICK
C120  IF(FINISH-START)130,130,150
120   IF (FINISH .GT. START) GOTO 150
130   WRITE(MW,140)
      GO TO 810
140   FORMAT(/,/,20H START AFTER FINISH   ,/,/)
C150  IF(LPR)170,160,170
C160  LPR=1
150   IF (LPR .EQ. 0) LPR = 1
C170  IF(LFN(1)**2+LFN(2)**2+LFN(3)**2)200,180,200
      IF(LFN(1)**2+LFN(2)**2+LFN(3)**2 .NE. 0) GOTO 200
180   DO 190 J=1,3
190   LFN(J)=LBM(J)
200   DO 205 J=1,3
      CB(J)=FLOAT(LB(J))/FLOAT(LD)
      CU(J)=LU(J)
      CG(J)=LG(J)
      CBM(J)=LBM(J)
205   CFN(J)=LFN(J)
      DO 210 J=1,3
      DC(3,J)=CU(J)
      K=NP(J)
      L=NQ(J)
210   DC(1,J)=CBM(K)*CU(L)-CBM(L)*CU(K)
      DO 220 J=1,3
      K=NP(J)
      L=NQ(J)
220   DC(2,J)=DC(3,K)*DC(1,L)-DC(3,L)*DC(1,K)
      DO 270 J=1,3
      Z=0.0
      DO 230 K=1,3
230   Z=Z+DC(J,K)**2
C     IF(Z-0.0001)240,240,260
      IF (Z .GT. 0.0001) GOTO 260
240   WRITE(MW,250)
250   FORMAT(/,/,16H BEAM PARALLEL U  ,/,/)
      GO TO 810
260   Z=1.0/SQRT(Z)
      DO 270 K=1,3
270   DC(J,K)=DC(J,K)*Z
      DO 280 J=1,3
      DCX(1,J)=-DC(1,J)
280   DCX(2,J)=-CBM(J)
      DO 285 J=1,3
      K=NP(J)
      L=NQ(J)
285   DCX(3,J)=DCX(1,K)*DCX(2,L)-DCX(1,L)*DCX(2,K)
      DO 300 J=1,3
      Z=0.0
      DO 290 K=1,3
290   Z=Z+DCX(J,K)**2
      Z=1.0/SQRT(Z)
      DO 300 K=1,3
300   DCX(J,K)=DCX(J,K)*Z
      DO 310 J=1,3
      BD(J)=0.0
      GD(J)=0.0
      BM(J)=0.0
      FN(J)=0.0
      FNX(J)=0.0
      DO 310 K=1,3
      BD(J)=BD(J)+DC(J,K)*CB(K)
      BM(J)=BM(J)+DC(J,K)*CBM(K)
      FN(J)=FN(J)+DC(J,K)*CFN(K)
      FNX(J)=FNX(J)+DCX(J,K)*CFN(K)
310   GD(J)=GD(J)+DC(J,K)*CG(K)
C     IF (LBM(1)*LG(1)+LBM(2)*LG(2)+LBM(3)*LG(3))320,340,320
      IF (LBM(1)*LG(1)+LBM(2)*LG(2)+LBM(3)*LG(3).EQ.0)GOTO 340
320   WRITE(MW,330)
330   FORMAT(/,/,19H BEAM NOT PERP TO G   ,/,/)
      GO TO 810
340   Z=SQRT(FN(1)**2+FN(2)**2+FN(3)**2)
      X=SQRT(BM(1)**2+BM(2)**2+BM(3)**2)
      DO 350 J=1,3
      BM(J)=BM(J)/X
350   FN(J)=FN(J)/Z
      FNBM=0.0
      DO 360 J=1,3
360   FNBM=FNBM+FN(J)*BM(J)
C     IF(FN(3))370,370,390
      IF (FN(3) .GT. 0.0) GOTO 390
370   WRITE(MW,380)
380   FORMAT(/,/,29H U AND FOIL NORMAL NOT ACUTE  ,/,/)
      GO TO 810
390   CONTINUE
C     IF(FNBM)400,400,420
      IF (FNBM .GT. 0.0) GOTO 420
400   WRITE(MW,410)
410   FORMAT(/,/,32H FOIL NORMAL AND BEAM NOT ACUTE  ,/,/)
      GO TO 810
420   CONTINUE
      CALL ANCALC
      IF(KRASH.NE.0)GOTO 810
430   CONTINUE
      DO 440 J=1,3
      DR(J)=0.0
      DI(J)=0.0
      DO 440 K=1,3
      DR(J)=DR(J)+GD(K)*AR(K,J)
440   DI(J)=DI(J)+GD(K)*AI(K,J)
      DO 450 J=1,3
      Z=DR(J)
      DR(J)=Z*PR(J)-DI(J)*PI(J)
450   DI(J)=Z*PI(J)+DI(J)*PR(J)
      DO 460 JA=1,3
      DO 460 L=1,3
      UR(JA,L)=0.0
      UI(JA,L)=0.0
      DO 460 J=1,3
      UR(JA,L)=UR(JA,L)+EMR(JA,J)*H(J,L)
460   UI(JA,L)=UI(JA,L)+EMI(JA,J)*H(J,L)
      DO 470 JA=1,3
      DO 470 L=1,3
      VR(JA,L)=DR(JA)*UR(JA,L)-DI(JA)*UI(JA,L)
470   VI(JA,L)=DR(JA)*UI(JA,L)+DI(JA)*UR(JA,L)
      DO 480 JA=1,3
      DO 480 L=1,3
480   UR(JA,L)=VR(JA,L)*PR(JA)+VI(JA,L)*PI(JA)
      DO 490 J=1,3
      CN(J+6)=PR(J)
      CN(J+9)=PI(J)**2
      CN(J)=0.0
      CN(J+3)=0.0
      DO 490 L=1,3
      CN(J)=CN(J)+VR(J,L)*BD(L)
490   CN(J+3)=CN(J+3)+UR(J,L)*BD(L)
      GO TO (500,510,520,530,540,550,560,570,580),LPR
500   BLACK=0.313
      WHITE=1.154
      GO TO 590
510   BLACK=0.129
      WHITE=1.253
      GO TO 590
520   BLACK=0.058
      WHITE=1.340
      GO TO 590
530   BLACK=0.397
      WHITE=1.462
      GO TO 590
540   BLACK=0.191
      WHITE=1.866
      GO TO 590
550   BLACK=0.098
      WHITE=2.280
      GO TO 590
560   BLACK=0.259
      WHITE=0.959
      GO TO 590
570   BLACK=0.089
      WHITE=0.869
      GO TO 590
580   BLACK=0.035
      WHITE=0.809
590   NROWS = 128		!MUST BE EVEN
      NCOLS = 155		!MUST BE ODD
      HCPI = 132.
      VCPI = 72.
      ROWS = NROWS
      COLS = NCOLS
      NEND = (NCOLS - 1) / 2
      NEND2 = 2 * NEND
      CALL HALFTN(NCOLS,TB,MARK,BLACK,WHITE,-1,IDEV)
      CALL HALFTN(NCOLS,TB,MARK,BLACK,WHITE,0,IDEV)
C
C
C   TEMPORARY MODIFICATION FOR NUMERICAL CHECKS
C
C     SEE PAGE 340 FROM DEFECTS IN CRYSTALLINE SOLIDS
C
C      WRITE (MW,591)
C591   FORMAT (/,/)
C      WRITE (MW,592) ((DC(I,J),J=1,3),I=1,3)
C592   FORMAT (/,1X,3F10.5)
C      WRITE (MW,591)
CC     WRITE (MW,592) (CN(I),I=1,12)
C      WRITE (MW,592) CN(1),CN(2),CN(3),CN(4),CN(5),CN(6),CN(7),CN(8),
C     + CN(9),CN(10),CN(11),CN(12)
C
C
C
C     END  OF MODIFICATION
C
C
C      WRITE(MW,600)
C600   FORMAT(1H1)
      THBM=THICK/FNBM
      TBP=PY*THBM
      FRACTN=(FINISH-START)/THICK
C     DELT=FRACTN*TBP/64.0
      DELT=FRACTN*TBP/((COLS-1.0)/2.0)
      WL=THICK*FRACTN*BM(2)/FN(3)
C     WW=59.0*10.0*WL/(6.0*128.0)
      WW = (ROWS-1.0)*HCPI*WL / (VCPI*(COLS-1.0))
C     DELW = PY * WW / 59.0
      DELW = PY * WW / (ROWS - 1.0)
605   CN(29)=1000.0
      X=0.0
      Q=0.0
      ERROR=0.0001
      DO 610 JK=1,8
610   Y(JK)=0.0
      Y(1)=1.0
      X1=DELT
      CALL RKM
      X1=TBP
      CALL RKM
      BACK=Y(1)**2+Y(2)**2
C     DO 800 JC=1, 60
      DO 800 JC=1,NROWS
C     CN(15)=(FLOAT(JC)-30.5)*DELW
      CN(15)=(FLOAT(JC)-((ROWS/2.0)+0.5))*DELW
      CN(29)=CN(15)/BM(2)
      X=-PY*FINISH/FNBM-(CN(15)*FNX(1)/FNX(2))
      SURFAC=X+TBP
      DO 620 JK=1,8
620   Y(JK)=0.0
      Y(1)=1.0
      Y(7)=1.0
      X1=X
      IFLAG=0
C     DO 680 JT=1,64
      DO 680 JT=1,NEND
      X1=X1+DELT
C     IF(X1-SURFAC)670,640,640
      IF (X1 .LT. SURFAC) GOTO 670
C640  IF(IFLAG)670,650,670
640   IF (IFLAG .NE. 0) GOTO 670
650   XX1=X1
      X1=SURFAC
      IFLAG=1
      CALL RKM
      DO 660 JK=1,8
660   TEMPY(JK)=Y(JK)
      X1=XX1
670   CALL RKM
      DNR=Y(1)*Y(7)-Y(2)*Y(8)-Y(3)*Y(5)+Y(4)*Y(6)
      DNI=Y(1)*Y(8)+Y(2)*Y(7)-Y(3)*Y(6)-Y(4)*Y(5)
      DNN=1.0/(DNR**2+DNI**2)
      FX(JT,1)=DNN*(Y(7)*DNR+Y(8)*DNI)
      FX(JT,2)=DNN*(Y(8)*DNR-Y(7)*DNI)
      FX(JT,3)=-DNN*(Y(3)*DNR+Y(4)*DNI)
      FX(JT,4)=DNN*(Y(3)*DNI-Y(4)*DNR)
680   CONTINUE
C     IF(IFLAG)720,690,720
      IF (IFLAG .NE. 0) GOTO 720
690   X1=SURFAC
      CALL RKM
700   DO 710 JK=1,8
710   TEMPY(JK)=Y(JK)
720   X=SURFAC
      DO 730 JK=1,8
730   Y(JK)=TEMPY(JK)
      X1=X
C     DO 760 JM=1,64
      DO 760 JM=1,NEND
      X1=X1+DELT
      CALL RKM
      TT=(FX(JM,1)*Y(1)-FX(JM,2)*Y(2)+FX(JM,3)*Y(5)-FX(JM,4)*Y(6))**2
     1 +(FX(JM,1)*Y(2)+FX(JM,2)*Y(1)+FX(JM,3)*Y(6)+FX(JM,4)*Y(5))**2
760   TB(2*JM+1)=TT/BACK
      TB(1)=(TEMPY(1)**2+TEMPY(2)**2)/BACK
C     DO 770 JZ=2,128,2
      DO 770 JZ=2,NEND2,2
770   TB(JZ)=0.5*(TB(JZ-1)+TB(JZ+1))
      MARK=MARKS(1)
C     IF((JC-30)*(JC-31))790,780,790
C780  MARK=MARKS(2)
      IF(JC.EQ.(NROWS/2) .OR. JC.EQ.((NROWS/2)+1) ) MARK = MARKS(2)
790   CALL HALFTN(NCOLS,TB,MARK,BLACK,WHITE,1,IDEV)
800   CONTINUE
C      IF (ITV .EQ. 1) GOTO 810
C      ITV = 1
C      WW = WWTV
C      DELW = DELWTV
810   WRITE (MW,805)IY,C11,C12,C44,WL,WW,LB,LD,LU,LG,LBM,LFN,W,THICK,TH
     +BM,ANO
805   FORMAT (' CSIRO ONEDIS ',15A1,2X,'CIJ = ',F4.2,',',F4.2,',',F4.2,
     + 2X,'L,W = ',F4.2,',',F4.2,2X,3I2,'/',I1,'B'/' ',3I2,'U',2X,3I2,'G
     +',2X,3I2,'BD',2X,3I2,'FN',2X,'W=',F4.2,2X,'TH=',F4.2,2X,'THBD=',
     + F4.2,2X,'ANO=',F5.2)
C      GOTO 605
C     TIME=(ITIME(X)-TIME)/1000.0
C     NTIME = (FLOAT(ITIME(X)) * 26.04166) / 1000.0
C810   TIME = 0.0
C      WRITE(MW,820)C11,C12,C44,IY,TIME,WL,WW,START,FINISH,ANO
C820   FORMAT(14H TRIROPHYSICS F5.2,4HC11 F5.2,4HC12 F5.2,4HC44 15A1,
C     1 F6.1,5H SECS F6.2,3H WL F6.2,3H WW F5.2,6H STRT F5.2,5H FIN ,
C     2 F6.3,5H ANO  )
C      WRITE(MW,830)LB,LD,LU,LG,LBM,LFN,W,THICK,THBM,BACK,IZ
C830   FORMAT(1H  ,3I2,1H/I1,5HB    3I2,5HU    3I2,5HG    3I2,5HBD   3I2,
C     1 2HFNF7.3,1HWF7.3,2HTHF7.3,4HTHBDF9.3,4HBACK26A1)
C      WRITE(MW,840)BLACK,WHITE
C840   FORMAT(28H PROGRAM ONEDIS  GREY SCALE F5.3,7H BLACK F5.3,6H WHITE)
C      WRITE (MOF,850)
C850   FORMAT('99')
       IF (IDEV .LT. 0) WRITE(6,8235) NESC
8235   FORMAT(' ','-',A1,'\')
       IF (IDEV .GT. 0) CALL CLOSE(3)
       GO TO 10
       END
      SUBROUTINE ANCALC
      DIMENSION D(6,6), DR(3,3),DI(3,3),G(9),E(9)
      COMMON/DATA/NP(3),NQ(3),MM(3),NN(3),L1(6),L2(6),L3(3,3),PY,MR,MW
      COMMON/ANCNEW/NEW,ZR,ZI,QR(7),QI(7),KRASH,C11,C12,C44,DC(3,3),
     1 C(6,6),PR(3),PI(3),AR(3,3),AI(3,3),ELR(3,3),ELI(3,3),EMR(3,3),
     2 EMI(3,3),B(3,3),H(3,3)
      DO 30  JA=1,6
      DO 30  JB=1,6
30    D(JA,JB)=0.0
      D(1,1)=C11/C44
      D(2,2)=D(1,1)
      D(3,3)=D(1,1)
      D(1,2)=C12/C44
      D(2,1)=D(1,2)
      D(2,3)=D(1,2)
      D(3,2)=D(1,2)
      D(1,3)=D(1,2)
      D(3,1)=D(1,2)
      D(4,4)=1.0
      D(5,5)=1.0
      D(6,6)=1.0
      DO 34 M=1,6
      I=L1(M)
      J=L2(M)
      DO 34 N=1,M
      K=L1(N)
      L=L2(N)
      X=0.0
      DO 33 LP=1,3
      Y=0.0
      DO 32 LQ=1,3
      LT=L3(LP,LQ)
32    Y=Y+DC(J,LQ)*
     1   (DC(K,1)*(DC(L,1)*D(LT,1)+DC(L,2)*D(LT,6)+DC(L,3)*D(LT,5))
     2   +DC(K,2)*(DC(L,1)*D(LT,6)+DC(L,2)*D(LT,2)+DC(L,3)*D(LT,4))
     3   +DC(K,3)*(DC(L,1)*D(LT,5)+DC(L,2)*D(LT,4)+DC(L,3)*D(LT,3)))
33    X=X+DC(I,LP)*Y
      C(M,N)=X
34    C(N,M)=X
      G(1)=C(5,5)
      G(2)=2.0*C(4,5)
      G(3)=C(4,4)
      G(4)=C(6,6)
      G(5)=2.0*C(2,6)
      G(6)=C(2,2)
      G(7)=C(1,1)
      G(8)=2.0*C(1,6)
      G(9)=C(6,6)
      E(1)=C(5,6)
      E(2)=C(2,5)+C(4,6)
      E(3)=C(2,4)
      E(4)=C(1,5)
      E(5)=C(5,6)+C(1,4)
      E(6)=C(4,6)
      E(7)=C(1,6)
      E(8)=C(6,6)+C(1,2)
      E(9)=C(2,6)
      DO 50 KP=1,7
      QR(KP)=0.0
50    QI(KP)=0.0
      DO 51 KQ=1,3
      DO 51 KR=1,3
      DO 51 KS=1,3
      KT=KQ+KR+KS-2
51    QR(KT)=QR(KT)+G(KQ)*G(KR+3)*G(KS+6)+2.0*E(KQ)*E(KR+3)*E(KS+6)-
     1 E(KQ)*E(KR)*G(KS+6)-E(KQ+3)*E(KR+3)*G(KS+3)-E(KQ+6)*E(KR+6)*G(KS)
      DO 52 KP=1,7
52    QR(KP)=QR(KP)/QR(7)
      KRASH=0
      NEW=7
      ZR=0.1
      ZI=1.0
      CALL NEWTON
      IF(KRASH.NE.0)GOTO 69
61    PR(1)=ZR
      PI(1)=ABS(ZI)
      ZI=-ZI
      CALL NEWTON
      IF(KRASH.NE.0)GOTO 69
62    ZR=0.5
      ZI=0.9
      CALL NEWTON
      IF(KRASH.NE.0)GOTO 69
63    PR(2)=ZR
      PI(2)=ABS(ZI)
      ZI=-ZI
      CALL NEWTON
      IF(KRASH.NE.0)GOTO 69
64    ZR=-ZR
      CALL NEWTON
      IF(KRASH.NE.0)GOTO 69
65    PR(3)=ZR
      PI(3)=ABS(ZI)
      ZR=-C(4,5)/C(4,4)
      ZI=SQRT(ABS(C(4,4)*C(5,5)-C(4,5)**2))/C(4,4)
      DO 67 N=1,2
      IF((ZR-PR(N))**2*(ZI-PI(N))**2.GE.(ZR-PR(N+1))**2-(ZI-PI(N+1))**2)
     &  GOTO 67
66    Z=PR(N)
      PR(N)=PR(N+1)
      PR(N+1)=Z
      Z=PI(N)
      PI(N)=PI(N+1)
      PI(N+1)=Z
67    CONTINUE
      GO TO 74
69    IF (KRASH .LT. 0) GOTO 70
      WRITE(MW,73)
      GO TO 99
70    WRITE(MW,71)
      GO TO 99
71    FORMAT(/,/,11H NOCONVERGE,/,/)
73    FORMAT(/,/,9H REALROOT,/,/)
74    CONTINUE
      DO 80 K=1,3
      I=NP(K)
      L=NQ(K)
      PRK=PR(K)
      PIK=PI(K)
      SQR=PRK**2-PIK**2
      SQI=2.0*PRK*PIK
      DR(1,1)=C(1,1)+PRK*2.0*C(1,6)+SQR*C(6,6)
      DR(2,2)=C(6,6)+PRK*2.0*C(2,6)+SQR*C(2,2)
      DR(3,3)=C(5,5)+PRK*2.0*C(4,5)+SQR*C(4,4)
      DR(1,2)=C(1,6)+PRK*(C(1,2)+C(6,6))+SQR*C(2,6)
      DR(2,3)=C(5,6)+PRK*(C(4,6)+C(2,5))+SQR*C(2,4)
      DR(3,1)=C(1,5)+PRK*(C(1,4)+C(5,6))+SQR*C(4,6)
      DR(2,1)=DR(1,2)
      DR(3,2)=DR(2,3)
      DR(1,3)=DR(3,1)
      DI(1,1)=PIK*2.0*C(1,6)+SQI*C(6,6)
      DI(2,2)=PIK*2.0*C(2,6)+SQI*C(2,2)
      DI(3,3)=PIK*2.0*C(4,5)+SQI*C(4,4)
      DI(1,2)=PIK*(C(1,2)+C(6,6))+SQI*C(2,6)
      DI(2,3)=PIK*(C(4,6)+C(2,5))+SQI*C(2,4)
      DI(3,1)=PIK*(C(1,4)+C(5,6))+SQI*C(4,6)
      DI(2,1)=DI(1,2)
      DI(3,2)=DI(2,3)
      DI(1,3)=DI(3,1)
      DO 80 J=1,3
      M=NP(J)
      N=NQ(J)
      AR(J,K)=DR(I,M)*DR(L,N)-DI(I,M)*DI(L,N)-DR(I,N)*DR(L,M)+DI(I,N)*
     1 DI(L,M)
80    AI(J,K)=DR(I,M)*DI(L,N)+DI(I,M)*DR(L,N)-DR(I,N)*DI(L,M)-DI(I,N)*
     1 DR(L,M)
      DO 82 J=1,3
      NJ=NN(J)
      DO 82 K=1,3
      XR=0.0
      XI=0.0
      DO 81 L=1,3
      NL=NN(L)
      ML=MM(L)
      YR=C(NJ,ML)+C(NJ,NL)*PR(K)
      YI=C(NJ,NL)*PI(K)
      XR=XR+YR*AR(L,K)-YI*AI(L,K)
81    XI=XI+YI*AR(L,K)+YR*AI(L,K)
      ELR(J,K)=XR
82    ELI(J,K)=XI
      DO 83 J=1,3
      J1=NP(J)
      J2=NQ(J)
      DO 83 K=1,3
      K1=NP(K)
      K2=NQ(K)
      EMR(K,J) = ELR(J1,K1)*ELR(J2,K2) -ELI(J1,K1)*ELI(J2,K2)
     1           -ELR(J1,K2)*ELR(J2,K1)+ELI(J1,K2)*ELI(J2,K1)
83    EMI(K,J) = ELR(J1,K1)*ELI(J2,K2) +ELI(J1,K1)*ELR(J2,K2)
     1           -ELR(J1,K2)*ELI(J2,K1) -ELI(J1,K2)*ELR(J2,K1)
      DELR=0.0
      DELI=0.0
      DO 84 J=1,3
      DELR = DELR  +ELR(3,J)*EMR(J,3)  -ELI(3,J)*EMI(J,3)
84    DELI = DELI  +ELR(3,J)*EMI(J,3)  +ELI(3,J)*EMR(J,3)
      AUMR = DELR/(DELR**2+DELI**2)
      AUMI=-DELI/(DELR**2+DELI**2)
      DO 85 J=1,3
      DO 85 K=1,3
      X = EMR(J,K)*AUMR -EMI(J,K)*AUMI
      EMI(J,K) = EMR(J,K)*AUMI +EMI(J,K)*AUMR
85    EMR(J,K) = X
      DO 86 I=1,3
      DO 86 J=1,3
      B(I,J)=0.0
      DO 86 K=1,3
86    B(I,J)=B(I,J) -AR(I,K)*EMI(K,J) -AI(I,K)*EMR(K,J)
      DO 87 I=1,3
      I1=NP(I)
      I2=NQ(I)
      DO 87 J=1,3
      J1=NP(J)
      J2=NQ(J)
87    H(I,J) =  B(I1,J1)*B(I2,J2) -B(I1,J2)*B(I2,J1)
      DEL=B(3,1)*H(3,1)+B(3,2)*H(3,2)+B(3,3)*H(3,3)
      DO 88 I=1,3
      DO 88 J=1,3
88    H(I,J)=H(I,J)/DEL
99    RETURN
      END
      SUBROUTINE NEWTON
      COMMON/ANCNEW/NEW,ZR,ZI,QR(7),QI(7),KRASH
      KONVRG=0
      DO 6 KOUNT =1,70
      XR=0.0
      XI=0.0
      YR=0.0
      YI=0.0
      DO 3 J=1,NEW
      TR=ZR*YR-ZI*YI+XR
      YI=ZR*YI+ZI*YR+XI
      YR=TR
      M=NEW+1-J
      TR=ZR*XR-ZI*XI+QR(M)
      TI=ZR*XI+ZI*XR+QI(M)
      IF (KONVRG .EQ. 0) GOTO 2
1     QR(M)=XR
      QI(M)=XI
2     XR=TR
3     XI=TI
      IF (KONVRG .NE. 0) GOTO 7
4     F=1.0/(YR**2+YI**2)
      TR=F*(XR*YR+XI*YI)
      TI=F*(XI*YR-XR*YI)
      ZR=ZR-TR
      ZI=ZI-TI
C      IF((TR**2+TI**2)/(ZR**2+ZI**2)-0.1E-11)5,5,6
      IF ( (TR**2+TI**2)/(ZR**2+ZI**2) .LE. 0.1E-11 ) KONVRG = 1
C5     KONVRG=1
6     CONTINUE
      KRASH=-70
      GO TO 10
7     IF(ABS(ZR) .GT. 100000.0*ABS(ZI)) KRASH = NEW
C8     KRASH=NEW
9     NEW=NEW-1
10    RETURN
      END
      SUBROUTINE DERIV
      COMMON/RKMDRV/CN(30),X,X1,Y(8),ERROR,SKIP,Q,D(8),ANO
      IF (SKIP .NE. 0) GOTO 3
      IF (X .EQ. 0) X = .0000000001
2     R=CN(29)/X
      BETA=CN(14)+((R*CN(1)+CN(4))/((R+CN(7))**2+CN(10))+(R*CN(2)+
     1  CN(5))/((R+CN(8))**2+CN(11))+(R*CN(3)+CN(6))/((R+CN(9))**2+
     2  CN(12)))/X
3     Z=ANO*(Y(1)+Y(3))
      D(1)=Z-Y(4)
      D(3)=-BETA*Y(4)+Z-Y(2)
      Z=ANO*(Y(2)+Y(4))
      D(2)=Z+Y(3)
      D(4)=BETA*Y(3)+Z+Y(1)
      Z=ANO*(Y(5)+Y(7))
      D(5)=Z-Y(8)
      D(7)=-BETA*Y(8)+Z-Y(6)
      Z=ANO*(Y(6)+Y(8))
      D(6)=Z+Y(7)
      D(8)=BETA*Y(7)+Z+Y(5)
      RETURN
      END
      SUBROUTINE RKM
      DIMENSION YT(8),DT(8,3)
      COMMON/RKMDRV/CN(30),X,X1,Y(8),ERROR,SKIP,Q,D(8),ANO
      LAST=0
      IF (Q .NE. 0.0) GOTO 16
1     Q=X1-X
      SKIP=0.0
      Q15=0.0
      ERHIGH=ERROR*5.0
      ERLOW=ERHIGH*0.03125
2     LAST=1
      Q1=Q
      Q=X1-X
3     XT=X
      DO 4 M=1,8
4     YT(M)=Y(M)
5     IF (Q*1.5 .EQ. Q15) GOTO 7
6     Q2 = Q * .5
      Q3 = Q * .3333333333333
      Q4=4.0*Q3
      Q6 = Q * .1666666666667
      Q15=Q*1.5
7     CALL DERIV
      DO 8 M=1,8
      DT(M,1)=Q3*D(M)
8     Y(M)=DT(M,1)+YT(M)
      X=X+Q3
      CALL DERIV
      DO 9 M=1,8
9     Y(M)=Q6*D(M)+0.5*DT(M,1)+YT(M)
      SKIP=1.0
      CALL DERIV
      SKIP=0.0
      DO 10 M=1,8
      DT(M,2)=Q15*D(M)
10    Y(M)=0.375*DT(M,1)+0.25*DT(M,2)+YT(M)
      X=XT+Q2
      CALL DERIV
      DO 11 M=1,8
      DT(M,1)=Q4*D(M)+DT(M,1)
11    Y(M)=1.5*DT(M,1)-DT(M,2)+YT(M)
      X=XT+Q
      CALL DERIV
      DOUBLE=2.0
      DO 14 M=1,8
      DT(M,3)=Q6*D(M)
      TEST=ABS(DT(M,1)-DT(M,2)-DT(M,3))
      IF (TEST .GT. ERHIGH) GOTO 18
      IF (TEST .GE. ERLOW) DOUBLE = 1.0
14    CONTINUE
      DO 15 M=1,8
15    Y(M)=0.5*DT(M,1)+DT(M,3)+YT(M)
      Q=DOUBLE*Q
      IF (LAST .NE. 0) GOTO 20
16    IF ( (X1-X) .GT. Q ) GOTO 3
      GOTO 2
18    Q = Q * .5
      LAST=0
      DO 19 M=1,8
19    Y(M)=YT(M)
      X=XT
      GO TO 6
20    IF (Q .LT. Q1) Q = Q1
22    RETURN
      END
      SUBROUTINE HALFTN(N,ARRAY,MARK,BLACK,WHITE,JUMP,IFILE)
C  THIS SUBROUTINE OUTPUTS ONE LINE OF AN IMAGE.
C IBM VERSION FOR SUPERPROG.FROM MIKE O'K IN U.K.,1980 (J.C.H.S)
      INTEGER FILE
      DIMENSION ARRAY(157),JRAY(157)
      INTEGER RANX1, RANX2
      ISCLE = 36
      MW=7
C  JUMP TO SET RANGE, WRITE SCALE, OUTPUT IMAGE LINE
      IF(JUMP)190,160,10
C  OUTPUT IMAGE LINE
C  CHECK VALUE OF N
   10 IF(N*(N-157))40,20,20
   20 WRITE(MW,1200)N
      GO TO 230
C  BRANCH TO OUTPUT TO LA100, PERITEC, OR FILE
40    IF (IFILE) 42,230,900 
42    WRITE (6,41)
41    FORMAT (' ','-')
C  FIND STARTING AND FINISHING COLUMNS TO CENTRE IMAGE LINE
      IF (JS .LE. 1) GOTO 31
C      DO 31 J = 1, (JS - 1)
C      CALL PUTBLK (0)
31    CONTINUE
C  LOOP OVER INTENSITIES IN LINE
      DO 130 J=JS,JF
      K=J-JS+1
C  SCALE INTENSITIES TO MATCH SYMBOL TABLE
      IOUT= ISCLE - ((ARRAY(K)-DARK)*SCALE)  
C  CHECK FOR VALUES OUT-OF-RANGE
      IF(IOUT.LT.0)IOUT=0
      IF(IOUT.GT.ISCLE)IOUT=ISCLE
      CALL PUTBLK( IOUT )
130   CONTINUE
160   CONTINUE
      GO TO 230
C  OUTPUT TO FILE
900   IF (JS .LE. 1) GOTO 931
      DO 931 J = 1, (JS - 1)
      JRAY(J) = 0
931    CONTINUE
C  LOOP OVER INTENSITIES IN LINE
      DO 9130 J=JS,JF
      K=J-JS+1
C  SCALE INTENSITIES TO MATCH SYMBOL TABLE
      IOUT= ISCLE - ((ARRAY(K)-DARK)*SCALE)  
C  CHECK FOR VALUES OUT-OF-RANGE
      IF(IOUT.LT.0)IOUT=0
      IF(IOUT.GT.ISCLE)IOUT=ISCLE
      JRAY(J) = IOUT
9130   CONTINUE
      WRITE(IFILE,9140) (JRAY(J),J=1,55)
      WRITE(IFILE,9140) (JRAY(J),J=56,110)
      WRITE(IFILE,9140) (JRAY(J),J=111,JF)
9140  FORMAT(' ',55I2)
      GO TO 230
C  SET RANGE
  190 DARK=BLACK
      BRITE=WHITE
      RANGE =BRITE-DARK
      IF(ABS(RANGE).GT.1E-08) GO TO 50
      WRITE(MW,1500) RANGE
      GO TO 230
50    SCALE = FLOAT(ISCLE)/RANGE
      JS=(158-N)/2
      JF=(156+N)/2
      RANX1 = 0
      RANX2 = 0
      DO 200 NN = 1, 200
      I = IRANDM(1,2)
200   CONTINUE
      IF (IFILE .GT. 0) WRITE(IFILE,201) (JF - 110)
201   FORMAT (' ','035555',I2)
 1200 FORMAT(23H N IS WRONG, AND EQUALS,I15,/)
 1500 FORMAT(39H0INTENSITY RANGE LT 1.0E-8 AND EQUAL TO,E8.1,/)
  230 RETURN
      END
	SUBROUTINE PUTBLK (TONE)
C
	INTEGER TONE
C
C	THIS SUBROUTINE OUTPUTS TO LOGICAL DEVICE PRNT ONE BLOCK
C	FOR A HALFTONE IMAGE.  TONE IS A INTEGER FROM 0 TO 36 (THUS
C	THERE ARE 37 DIFFERENT TONES TO THE GREYSCALE), WHERE 0 IS  
C	WHITE AND 36 IS BLACK.  THE ROUTINE RANDOMLY SELECTS WHICH
C	POINTS WITHIN THE BLOCK ARE TO BE PRINTED.
C	PRNT SHOULD EITHER BE AN LA100 PRINTER, OR A SEQUENTIAL ACCESS
C	FILE THAT WILL LATER BE OUTPUT TO AN LA100 PRINTER.
C
C	AUTHOR:  R. HOLTON,  ARGONNE NATIONAL LABORATORY, 8-84
C
	INTEGER
     &	CLEAR,		!ORIGINAL SETTING OF ALL POINTS IN THE BLOCK
     &	FILL,		!SETTING OF THOSE POINTS RANDOMLY SELECTED
     &	POINTS,		!NUMBER OF CLEAR POINTS LEFT
     &	HALF,		!HALF OF THE TOTAL NUMBER OF POINTS
     &	SELECT,		!WHICH CLEAR POINT TO FILL
     &	LOC,		!POINT TO CHECK IF FILL OR CLEAR
     &	BOX(6,6),	!THE BLOCK TO BE OUTPUT (6 COLUMNS, 6 ROWS)
     &	ARRAY(36),	!LINEAR ARRAY EQUIVALENCED WITH BOX
     &	NCOLS,		!NUMBER OF COLUMNS (CURRENTLY 6)
     &	NROWS,		!NUMBER OF ROWS (CURRENTLY 6...LIMITED BY LA100)
     &	FINISH,		!TERMINATING VALUE FOR LOOP
     &	PRNT,		!LOGICAL UNIT FOR OUTPUT...CURRENTLY LOGICAL UNIT 6
     &	WIRES		!ONE VERTICAL COLUMN IN OUTPUT FORMAT
C
	EQUIVALENCE (ARRAY,BOX)
C
	PRNT = 6
	NCOLS = 6
	NROWS = 6
	POINTS = NROWS * NCOLS
	HALF = POINTS / 2
C
	IF (TONE .GT. 0) GOTO 20
		WRITE(PRNT,10)
10		FORMAT(' ',6('?'))
		GOTO 140
C
20	IF (TONE .LT. POINTS) GOTO 40
		WRITE(PRNT,30)
30		FORMAT(' ',6('~')) 
		GOTO 140
C
40	IF (TONE .GE. HALF) GOTO 50
		CLEAR = 0
		FILL = 1
		FINISH = (POINTS - TONE) + 1
		GOTO 60
C	ELSE
50		CLEAR = 1
		FILL = 0
		FINISH = TONE + 1
C
60	DO 70  J = 1,POINTS
		ARRAY(J) = CLEAR
70		CONTINUE
C
	DO 100  J = POINTS ,FINISH, -1
		SELECT = IRANDM(1,J)
		LOC = 0
		DO 90  K = 1, SELECT
80			LOC = LOC + 1
			IF (ARRAY(LOC) .EQ. FILL) GOTO 80
90			CONTINUE
		ARRAY(LOC) = FILL
100		CONTINUE
C
	DO 130  J = 1, NCOLS
		WIRES = 63
		DO 110  K = 1, NROWS
			WIRES = WIRES + BOX(J,K)*2**(K-1)
110			CONTINUE
C
		WRITE(PRNT,120) WIRES
120		FORMAT(' ',A1)
130		CONTINUE
C
140	RETURN
	END
	FUNCTION IRANDM (LOW, HIGH)
C
	INTEGER LOW, HIGH
C
C	THIS FUNCTION RETURNS A RANDOM INTEGER UNIFORMLY DISTRIBUTED
C	FROM LOW TO HIGH.
C
C	NOTE THAT THIS PROGRAM MAKE A CALL TO A RANDOM NUMBER GENERATOR.
C
	INTEGER RANX1, RANX2
	COMMON /IRANX /RANX1, RANX2
C	
	IF (LOW .GE. HIGH) GOTO 99
C
	IRANDM = IFIX((HIGH - LOW + 1) * RAN(RANX1,RANX2)) + LOW
	RETURN
C
99	IRANDM = LOW
	RETURN
	END
	SUBROUTINE SETBLK (TONE, BLOCK)
C
	INTEGER TONE
	BYTE BLOCK(6)
C
C	THIS SUBROUTINE RETURNS ONE 6 BY 6 BLOCK IN LA100 FORMAT 
C	FOR A HALFTONE IMAGE.  TONE IS A INTEGER FROM 0 TO 36 (THUS
C	THERE ARE 37 DIFFERENT TONES TO THE GREYSCALE), WHERE 0 IS  
C	WHITE AND 36 IS BLACK.  THE ROUTINE RANDOMLY SELECTS WHICH
C	POINTS WITHIN THE BLOCK ARE TO BE PRINTED.
C
C	AUTHOR:  R. HOLTON,  ARGONNE NATIONAL LABORATORY, 8-84
C
	INTEGER
     &	CLEAR,		! ORIGINAL SETTING OF ALL POINTS IN THE BLOCK
     &	FILL,		! SETTING OF THOSE POINTS RANDOMLY SELECTED
     &	POINTS,		! NUMBER OF CLEAR POINTS LEFT
     &	HALF,		! HALF OF THE TOTAL NUMBER OF POINTS
     &	SELECT,		! WHICH CLEAR POINT TO FILL
     &	LOC,		! POINT TO CHECK IF FILL OR CLEAR
     &	BOX(6,6),	! THE BLOCK TO BE OUTPUT (6 COLUMNS, 6 ROWS)
     &	ARRAY(36),	! LINEAR ARRAY EQUIVALENCED WITH BOX
     &	NCOLS,		! NUMBER OF COLUMNS (CURRENTLY 6)
     &	NROWS,		! NUMBER OF ROWS (CURRENTLY 6...LIMITED BY LA100)
     &	FINISH		! TERMINATING VALUE FOR LOOP
C
	EQUIVALENCE (ARRAY,BOX)
C
	NCOLS = 6
	NROWS = 6
	POINTS = NCOLS * NROWS
	HALF = POINTS / 2
C
	IF (TONE .GE. 0) GOTO 20
		TONE = 0
		GOTO 40
C
20	IF (TONE .LE. POINTS) GOTO 30
		TONE = POINTS
		GOTO 50
C
30	IF (TONE .GE. HALF) GOTO 50
40		CLEAR = 0
		FILL = 1
		FINISH = (POINTS - TONE) + 1
		GOTO 60
C	ELSE
50		CLEAR = 1
		FILL = 0
		FINISH = TONE + 1
C
60	DO 70  J = 1,POINTS
		ARRAY(J) = CLEAR
70		CONTINUE
C
	IF (FINISH .GT. POINTS) GOTO 140
C
	DO 100  J = POINTS ,FINISH, -1
		SELECT = IRANDM(1,J)
		LOC = 0
		DO 90  K = 1, SELECT
80			LOC = LOC + 1
			IF (ARRAY(LOC) .EQ. FILL) GOTO 80
90			CONTINUE
		ARRAY(LOC) = FILL
100		CONTINUE
C
	DO 130  J = 1, NCOLS
		BLOCK(J) = 63
		DO 110  K = 1, NROWS
			BLOCK(J) = BLOCK(J) + BOX(J,K)*2**(K-1)
110			CONTINUE
C
130		CONTINUE
C
140	RETURN
	END
	
	
	==============================================================
	
	
	THIS IS THE OUTPUT PROGRAM WHICH WILL PRINT THE RESULTING DATA
	FILE OUT ONTO AN LA100 OR LA50 PRINTER
	
	
	        PROGRAM IMOUT
C
        INTEGER NCHAR(9), BUFFER(132)
C
        DATA NESC /27/
C
        WRITE(7,10)
10      FORMAT(' Enter the name of the file to be displayed: ',$)
        CALL ASSIGN (3,DUMMY,-1,'OLD',80)
        DO 15 J = 1,150
        K = IRANDM(1,2)
15      CONTINUE
        READ(3,20) NRECS,(NCHAR(J),J=1,NRECS)
20      FORMAT (1X,10I2)
C       WRITE(7,22) NRECS, (NCHAR(J),J=1,NRECS)
C22     FORMAT(' ',10(2X,I2))
        WRITE(6,25) NESC
25      FORMAT(' ',A1,'P1q')
30      WRITE(6,35)
35      FORMAT (' ','-')
        DO 60 K = 1,NRECS
        READ(3,40,END=90) (BUFFER(J),J=1,NCHAR(K))
40      FORMAT(1X,132I2)
        DO 50 L = 1,NCHAR(K)
        CALL PUTBLK(BUFFER(L))
50      CONTINUE
60      CONTINUE
        GOTO 30
C
90      WRITE (6,100) NESC
100     FORMAT (' ','-',A1,'\')
        CALL EXIT
        END

        SUBROUTINE PUTBLK (TONE)
C
        INTEGER TONE
C
C       THIS SUBROUTINE OUTPUTS TO LOGICAL DEVICE PRNT ONE BLOCK
C       FOR A HALFTONE IMAGE.  TONE IS A INTEGER FROM 0 TO 36 (THUS
C       THERE ARE 37 DIFFERENT TONES TO THE GREYSCALE), WHERE 0 IS  
C       WHITE AND 36 IS BLACK.  THE ROUTINE RANDOMLY SELECTS WHICH
C       POINTS WITHIN THE BLOCK ARE TO BE PRINTED.
C       PRNT SHOULD EITHER BE AN LA100 PRINTER, OR A SEQUENTIAL ACCESS
C       FILE THAT WILL LATER BE OUTPUT TO AN LA100 PRINTER.
C
C       AUTHOR:  R. HOLTON,  ARGONNE NATIONAL LABORATORY, 8-84
C
        INTEGER
     &  CLEAR,          !ORIGINAL SETTING OF ALL POINTS IN THE BLOCK
     &  FILL,           !SETTING OF THOSE POINTS RANDOMLY SELECTED
     &  POINTS,         !NUMBER OF CLEAR POINTS LEFT
     &  HALF,           !HALF OF THE TOTAL NUMBER OF POINTS
     &  SELECT,         !WHICH CLEAR POINT TO FILL
     &  LOC,            !POINT TO CHECK IF FILL OR CLEAR
     &  BOX(6,6),       !THE BLOCK TO BE OUTPUT (6 COLUMNS, 6 ROWS)
     &  ARRAY(36),      !LINEAR ARRAY EQUIVALENCED WITH BOX
     &  NCOLS,          !NUMBER OF COLUMNS (CURRENTLY 6)
     &  NROWS,          !NUMBER OF ROWS (CURRENTLY 6...LIMITED BY LA100)
     &  FINISH,         !TERMINATING VALUE FOR LOOP
     &  PRNT,           !LOGICAL UNIT FOR OUTPUT...CURRENTLY LOGICAL UNIT 6
     &  WIRES           !ONE VERTICAL COLUMN IN OUTPUT FORMAT
C
        EQUIVALENCE (ARRAY,BOX)
C
        PRNT = 6
        NCOLS = 6
        NROWS = 6
        POINTS = NROWS * NCOLS
        HALF = POINTS / 2
C
        IF (TONE .GT. 0) GOTO 20
                WRITE(PRNT,10)
10              FORMAT(' ',6('?'))
                GOTO 140
C
20      IF (TONE .LT. POINTS) GOTO 40
                WRITE(PRNT,30)
30              FORMAT(' ',6('~')) 
                GOTO 140
C
40      IF (TONE .GE. HALF) GOTO 50
                CLEAR = 0
                FILL = 1
                FINISH = (POINTS - TONE) + 1
                GOTO 60
C       ELSE
50              CLEAR = 1
                FILL = 0
                FINISH = TONE + 1
C
60      DO 70  J = 1,POINTS
                ARRAY(J) = CLEAR
70              CONTINUE
C
        DO 100  J = POINTS ,FINISH, -1
                SELECT = IRANDM(1,J)
                LOC = 0
                DO 90  K = 1, SELECT
80                      LOC = LOC + 1
                        IF (ARRAY(LOC) .EQ. FILL) GOTO 80
90                      CONTINUE
                ARRAY(LOC) = FILL
100             CONTINUE
C
        DO 130  J = 1, NCOLS
                WIRES = 63
                DO 110  K = 1, NROWS
                        WIRES = WIRES + BOX(J,K)*2**(K-1)
110                     CONTINUE
C
                WRITE(PRNT,120) WIRES
120             FORMAT(' ',A1)
130             CONTINUE
C
140     RETURN
        END

        FUNCTION IRANDM (LOW, HIGH)
C
        INTEGER LOW, HIGH
C
C       THIS FUNCTION RETURNS A RANDOM INTEGER UNIFORMLY DISTRIBUTED
C       FROM LOW TO HIGH.
C
C       NOTE THAT THIS PROGRAM MAKE A CALL TO A RANDOM NUMBER GENERATOR.
C
        INTEGER RANX1, RANX2
        COMMON /IRANX /RANX1, RANX2
C       
        IF (LOW .GE. HIGH) GOTO 99
C
        IRANDM = IFIX((HIGH - LOW + 1) * RAN(RANX1,RANX2)) + LOW
        RETURN
C
99      IRANDM = LOW
        RETURN
        END
        
        
        ==============END OF CODE =================