C                                                                       00010000
C                THIS PROGRAM INTEGRATES                                00020002
C THE DIFFERENTIAL CROSS SECTION IN THE CM-SYSTEM (RESULT OF COULEX     00030002
C PROGRAMM) NO FEEDING FROM HIGHER LYING STATES IS INCLUDED             00040002
C FINAL RESULTS ARE GIVEN IN BARN                                       00050002
C                                                                       00060000
C         >>>>>>> FOR PROJECTILE EXCITATION <<<<<<<                     00070000
C         >>>>>>> OR FOR TARGET  EXCITATION <<<<<<<                     00080000
C                                                                       00090000
C THE NUCLEAR LEVELS ARE NOT ONLY POPULATED BY COULOMB EXCITATION       00100000
C BUT ALSO BY CONVERSION AND GAMMA TRANSITIONS CASCADING DOWN           00110000
C HIGHER STATES                                                         00120000
C                                                                       00130000
C THE FORMULAS ARE TAKEN FROM A.WINTHER AND J.DE BOER,                  00140000
C "COULOMB EXCITATION",P. 310-314                                       00150000
C AND D.SCHWALM ET AL., NUCL.PHYSICS A192 (1972) 449-495                00160000
C                                                                       00170000
C THE PROGRAM IS COMPUTED BY                                            00180000
C                              HANS-JUERGEN WOLLERSHEIM                 00190000
C                              NUCLEAR PHYSICS GROUP 2                  00200000
C                     GESELLSCHAFT FUER SCHWERIONENFORSCHUNG MBH        00210000
C                              POSTFACH 110541                          00220000
C                              6100 DARMSTADT 11                        00230000
C                              WEST GERMANY                             00240000
C                                                                       00250000
C                              GSI-DARMSTADT 8.12.88                    00260000
C                                                                       00270000
C **********************************************************************00280000
C >>>>>>>>>>  ONLY E1-,E2-,E3- AND M1-TRANSITIONS ARE POSSIBLE <<<<<<<<<00290000
C **********************************************************************00300000
C             MAX. NUMBER OF STATES = 35                                00310000
C             MAX. NUMBER OF POSSIBLE TRANSITIONS = 199                 00320000
C **********************************************************************00330000
C                                                                       00340000
C                   COULEX - CALCULATION :                              00350000
C                   --------------------                                00360000
C SCATTERING ANGLE IN THE CM-SYSTEM : THETA (1) > THETA (2)             00370000
C                                                                       00380000
C THE NEW COULOMB EXCITATION PROGRAM FROM A.LELL HAS TO BE USED, THERE  00390000
C THE MATRIX-ELEMENTS FOR ELECTRIC MULTIPOLES ARE NOT MULTIPLIED WITH   00400000
C                    >>>> (I ** L)<<<<                                  00410000
C                 ("COULOMB EXCITATION" P.310)                          00420000
C IN THE FOLLOWING GAMMA-DECAY PROGRAM THE E2- AND E3-MATRIXELEMENTS    00430000
C ARE MULTIPLIED WITH (I ** 2).                                         00440000
C IF ONE USES ANOTHER COULOMB EXCITATION PROGRAM IN WHICH THE E2- AND   00450000
C E3-MATRIXELEMENTS ARE MULTIPLIED WITH (I ** L),ONE HAS TO CHANGE THE  00460000
C SIGN OF THESE MATRIXELEMENTS                                          00470000
C                                                                       00480000
C **********************************************************************00490000
C                                                                       00500000
C                        SUBROUTINES :                                  00510000
C                        -----------                                    00520000
C    ANGPAR , FK , FCT , RACAHI , CLEBI , FIT , SPLINE , DQTFG , DQG8   00530000
C SUBROUTINE FIT AND SPLINE ARE PUBLISHED BY                            00540000
C                                    HAGER+SELTZER NUCL.DATA A4,1-235   00550000
C SUBROUTINE DQTFG AND DQG8 ARE FROM THE MATH.LIB. OF THE IBM (GSI)     00560000
C                                                                       00570000
C **********************************************************************00580000
C                                                                       00590000
C                **** INPUT OF THE DATA ****                            00600000
C                     -----------------                                 00610000
C DATA CARD #1                                                          00620000
C ------------                                                          00630000
C I11,I12,I13,I14,I15,I16,I17,I18,I19,I20,I21,I22,I23,I24,I25           00640000
C                                                       FORMAT(15(1XI1))00650000
C >>>> OUTPUT AND INPUT CONTROLS <<<<                                   00660000
C                                                                       00670000
C ALL OUTPUT CONTROLS ARE FIXED-POINT NUMBERS TAKING THE VALUES 1 OR 0  00680000
C ACCORDING TO WHETHER THE OUTPUT IN  QUESTION IS DESIRED OR NOT        00690000
C EXCEPTION : I22 = 0,1,2,3,4,5 ; I24 = 0,1,>1                          00700000
C                                                                       00710000
C I11=OUTPUT OF THE CONVERSION COEFFICIENTS (E2,M1,E1,E3)               00720000
C I12=POSSIBLE DECAYS OF A STATE                                        00730000
C I13=HN (LIFETIME OF THE STATE)       "COULOMB EXCITATION" P.311 (48)  00740000
C I14=GK(N,M)                          "COULOMB EXCITATION" P.311 (47)  00750000
C I15=FK(N,M)                          "COULOMB EXCITATION" P.311 (46)  00760000
C I16=ANG(K,KK)+FEEDING                "COULOMB EXCITATION" P.311 (45)  00770000
C I17=SPIN(N),SPIN(K),W(N,K)           "COULOMB EXCITATION" P.311 (44)  00780000
C I18=SPIN(N),SPIN(K),DS(N,K)          "COULOMB EXCITATION" P.314 (58)  00790000
C I19=GAMMA-RAY ANGULAR DISTRIBUTION TT=0,180,5 VGAMMA=0.0 AND PI=3.14  00800000
C I20=GAMMA-RAY ANGULAR DISTRIBUTION PLOTT-OUTPUT                       00810000
C I21=EXCITATION PROBABILITIES, CM-CROSS SECTIONS, AND                  00820000
C     ANGULAR DISTRIBUTION TENSORS                                      00830000
C I22=1 INPUT OF FINITE SOLID-ANGLE CORRECTION FOR THE GE(LI)-DETECTOR  00840000
C I22=2 F.SOLID-ANGLE CORR. + INPUT OF THE DEORIENTATION CORRECTION     00850000
C I22=3 F.SOLID-ANGLE CORR. + DEORIENTATION CORRECTION (SCHERER-BLUME)  00860000
C I22=4 F.SOLID-ANGLE CORR. + DEORIENTATION CORRECTION (ABRAGAM-POUND)  00870000
C I22=5 F.SOLID-ANGLE CORR. + G2=0.96304-0.08579*ALOG(TAU)              00880000
C I23=INPUT OF M1-MATRIXELEMENTS AND M1-CONVERSION COEFFICIENTS         00890000
C I24=CALCULATION OF THE GAMMA-RAY ANGULAR DISTRIBUTION IN A COORDINATE 00900000
C     SYSTEM FOR WHICH THE EXCITED NUCLEUS IS AT REST                   00910000
C >>> I24=1 <<<                                                         00920000
C     INPUT OF THE POLAR ANGLE ( TT ) AND THE AZIMUTHAL ANGLE (VGAMMA)  00930000
C     OF THE GAMMA - DETECTOR IN THE LABORATORY COORDINATE SYSTEM       00940000
C >>> I24>1 <<<                                                         00950000
C     INPUT OF THE POLAR ANGLE ( TT ) AND THE AZIMUTHAL ANGLE (VGAMMA)  00960000
C     OF THE GAMMA - DETECTOR IN THE REST-COORDINATE SYSTEM             00970000
C I25=CALCULATION FOR PROJECTILE EXCITATION                             00980000
C                                                                       00990000
C DATA CARD #2 TO #8 INPUT FOR HAGER+SELTZER INTERPOLATION PROGRAM      01000000
C ------------------                                                    01010000
C CONVERSION COEFFICIENTS ARE CALCULATED FOR E1-,E2-,E3-,M1-TRANSITIONS 01020000
C                                                                       01030000
C NCC = NUMBER OF VALUES GIVEN IN EACH CASE (K,L,M) IN THE TABLE        01040000
C CCE1 = LOWEST TABULATED ENERGY OF SUBSHELL TO BE INTERPOLATED, EXCEPT 01050000
C        FOR L OR M SHELLS IN WHICH CASE E1 = -1.0                      01060000
C CCE2 = LOWEST TABULATED ENERGY OF THE K,L2,M5 SUBSHELLS FOR THE       01070000
C        INTERPOLATION IN THE K, L, M SHELLS,RESPECTIVELY               01080000
C CC MIN = MIN. GAMMA-ENERGY GIVEN IN THE TABLE OF THE                  01090000
C          CONVERSION COEFFICIENTS                                      01100000
C CC MAX = MAX. GAMMA-ENERGY GIVEN IN THE TABLE OF THE                  01110000
C          CONVERSION COEFFICIENTS                                      01120000
C                                                                       01130000
C EXAMPLE :                                                             01140000
C                                                                       01150000
C FOR K-SHELL: CCE1,CCE1,CCE1,CCKMAX (K-SHELL)      (CCE1=CCE2=CCKMIN)  01160000
C FOR L-SHELL: -1. ,CCE2 (L2),CCLMIN (TOTAL L-),CCLMAX (TOTAL L-SHELL)  01170000
C FOR M-SHELL: -1. ,CCE2 (M5),CCMMIN (TOTAL M-),CCMMAX (TOTAL M-SHELL)  01180000
C                                                                       01190000
C ALPHA = LIST OF CONVERSION COEFFICIENTS FROM THE TABLE                01200000
C                                                                       01210000
C        >>>> IF E1- AND E3-TRANSITIONS ARE POSSIBLE <<<<               01220000
C    LIST OF CONVERSION COEFFICIENTS IN THE FOLLOWING SEQUENCE :        01230000
C           A. ELECTRIC (1. E1-,2. E2-,3. E3-) AND                      01240000
C           B. MAGNETIC (4. M1-) TRANSITIONS                            01250000
C  INPUT OF CONVERSION COEFFICIENTS FOR M1-TRANSITIONS ONLY IN          01260000
C             CONNECTION WITH >>> I23 = 1 <<<                           01270000
C  USE ALWAYS DATA CARD #2 TO #8 FOR THE DIFFERENT TRANSITIONS          01280000
C                                                                       01290000
C DATA CARD #2                                                          01300000
C ------------                                                          01310000
C NCCK,NCCL,NCCM                                    FORMAT(3I5)         01320000
C DATA CARD #3                                                          01330000
C ------------                                                          01340000
C CCE1K,CCE2K,CCKMIN,CCKMAX   (MULTIPOLE)           FORMAT(4E10.3)      01350000
C DATA CARD #4                                                          01360000
C ------------                                                          01370000
C CCE1L,CCE2L,CCLMIN,CCLMAX   (MULTIPOLE)               "    "          01380000
C DATA CARD #5                                                          01390000
C ------------                                                          01400000
C CCE1M,CCE2M,CCMMIN,CCMMAX   (MULTIPOLE)               "    "          01410000
C DATA CARD #6 + FOLLOWING DATA CARDS                                   01420000
C ------------                                                          01430000
C (ALPHAK(I),I=1,NCCK)        (MULTIPOLE)           READ(5,*)           01440000
C DATA CARD #7 + FOLLOWING DATA CARDS                                   01450000
C ------------                                                          01460000
C (ALPHAL(I),I=1,NCCL)        (MULTIPOLE)               "               01470000
C DATA CARD #8 + FOLLOWING DATA CARDS                                   01480000
C ------------                                                          01490000
C (ALPHAM(I),I=1,NCCM)        (MULTIPOLE)               "               01500000
C                                                                       01510000
C DATA CARD #9 + FOLLOWING DATA CARDS                                   01520000
C ------------                                                          01530000
C IXYZ,JXYZ,MM1(IXYZ,JXYZ)                          FORMAT(2I5,F10.3)   01540000
C                                                                       01550000
C INPUT OF M1-MATRIXELEMENTS ONLY IN CONNECTION WITH >>> I23 = 1 <<<    01560000
C                    AND DATA CARD #9                                   01570000
C                                                                       01580000
C EACH CARD CONTAINS THE INFORMATION ABOUT THE NUMBER OF THE NUCLEAR    01590000
C STATE : IXYZ (INITIAL-), JXYZ (FINAL-STATE), AND THE M1-MATRIX -      01600000
C ELEMENT                                                               01610000
C THE NUMBER OF THE NUCLEAR STATE IS IDENTICAL WITH THE ONE IN THE      01620000
C COULEX-CALCULATION                                                    01630000
C IF ( IXYZ.EQ.0 ) END OF INPUT FOR M1-MATRIXELEMENTS                   01640000
C                                                                       01650000
C DATA CARD #10                                                         01660000
C -------------                                                         01670000
C TT,VGAMMA,VI1,VI2,K1LAB                           FORMAT(4F10.3,1I2)  01680000
C                                                                       01690000
C TT     =  POLAR ANGLE OF THE GAMMA - DETECTOR      (IN DEGREE)        01700000
C VGAMMA =  AZIMUTHAL ANGLE OF THE GAMMA - DETECTOR  (IN DEGREE)        01710000
C VI1 AND VI2 ARE THE AZIMUTHAL ANGLES OF THE PARTICLE DETECTOR         01720000
C VI1    =  LOWER BOUNDARY OF THE PARTICLE DETECTOR  (IN DEGREE)        01730000
C VI2    =  UPPER BOUNDARY OF THE PARTICLE DETECTOR  (IN DEGREE)        01740000
C K1LAB  =  SPECIFY THE NUMBER OF THE STATE,FOR WHICH THE TRANSFORMATION01750000
C           FROM THE CM-SYSTEM TO THE LAB-SYSTEM IS DONE                01760000
C IF >>> I24=0 OR 1 <<<                                                 01770000
C     INPUT OF THE POLAR ANGLE ( TT ) AND THE AZIMUTHAL ANGLE (VGAMMA)  01780000
C     OF THE GAMMA - DETECTOR IN THE LABORATORY COORDINATE SYSTEM       01790000
C IF >>> I24>1 <<<                                                      01800000
C     INPUT OF THE POLAR ANGLE ( TT ) AND THE AZIMUTHAL ANGLE (VGAMMA)  01810000
C     OF THE GAMMA - DETECTOR IN THE REST-COORDINATE SYSTEM             01820000
C                                                                       01830000
C                                                                       01840000
C DATA CARD #11                                                         01850000
C -------------                                                         01860000
C (Q(I),I=1,5,2)                                    FORMAT(3F10.3)      01870000
C                                                                       01880000
C INPUT OF THE FINITE SOLID-ANGLE CORRECTION FOR THE GE(LI)-DETECTOR    01890000
C ONLY IN CONNECTION WITH >>> I22 = 1 <<< AND DATA CARD #11             01900000
C                                                                       01910000
C FINITE SOLID-ANGLE CORRECTION FOR THE GE(LI)-DETECTOR                 01920000
C ASSUMPTION : Q0,Q2,Q4 ARE INDEPENDENT FROM THE GAMMA-ENERGY           01930000
C D.C.CAMP AND A.L.VAN LEHN NUCLEAR INSTRUMENTS AND METHODS 76 (1969),  01940000
C P.192-240                                                             01950000
C J.BARRETTE,G.LAMOUREUX,S.MONARO NUCLEAR INSTRUMENTS AND METHODS 93    01960000
C (1971), P.1-11                                                        01970000
C                                                                       01980000
C DATA CARD #11A                                                        01990000
C --------------                                                        02000000
C IXYZ,QGS(3,IXYZ),QGS(5,IXYZ)                     FORMAT(1I5,2F10.3)   02010000
C                                                                       02020000
C DATA CARD #11B                                                        02030000
C --------------                                                        02040000
C AJ,GZA,TAUC,H0(IN)                                                    02050000
C                                                                       02060000
C IF >>> I22 = 2 <<< DATA CARD #11 + DATA CARD #11A                     02070000
C INPUT OF DEORIENTATION CORRECTION FOR THE GAMMA-RAY ANGULAR           02080000
C                   DISTRIBUTION                                        02090000
C LARGE MAGNETIC HYPERFINE FIELDS ACT IN HIGHLY IONIZED AND EXCITED     02100000
C HEAVY IONS.THE ATTENUATION FACTORS G2 AND G4 CAN BE CALCULATED        02110000
C USING THE SCHERER-BLUME THEORY OR ABRAGAM-POUND THEORY                02120000
C                                                                       02130000
C EACH CARD CONTAINS THE INFORMATION ABOUT THE NUMBER OF THE NUCLEAR    02140000
C STATE : IXYZ , AND THE ATTENUATION - COEFFICIENTS :                   02150000
C            G2=QGS(3,IXYZ) G4=QGS(5,IXYZ)                              02160000
C                                                                       02170000
C THE NUMBER OF THE NUCLEAR STATE IS IDENTICAL WITH THE ONE IN THE      02180000
C COULEX-CALCULATION                                                    02190000
C IF ( IXYZ.EQ.0 ) END OF INPUT FOR ATTENUATION - COEFFICIENTS          02200000
C                                                                       02210000
C IF >>> I22 = 3 <<< DATA CARD #11 + DATA CARD #11B                     02220000
C DEORIENTATION CORRECTION FOR THE GAMMA-RAY ANGULAR DISTRIBUTION       02230000
C            USING THE SCHERER-BLUME THEORY                             02240000
C                                                                       02250000
C  AJ = ATOMIC SPIN                                                     02260000
C  GZA = G-FACTOR                                                       02270000
C  TAUC = REORIENTATION TIME IN VACUUM (PSEC)                           02280000
C  H0 = MAGNETIC HYPERFINE FIELD (MEGA GAUSS)                           02290000
C                                                                       02300000
C IF >>> I22 = 4 <<< DATA CARD #11 + DATA CARD #11B                     02310000
C DEORIENTATION CORRECTION FOR THE GAMMA-RAY ANGULAR DISTRIBUTION       02320000
C            USING THE ABRAGAM-POUND THEORY                             02330000
C                                                                       02340000
C  AJ = ATOMIC SPIN                                                     02350000
C  GZA = G-FACTOR                                                       02360000
C  TAUC = REORIENTATION TIME IN VACUUM (PSEC)                           02370000
C  H0 = MAGNETIC HYPERFINE FIELD (MEGA GAUSS)                           02380000
C                                                                       02390000
C DATA CARD #12                                                         02400000
C -------------                                                         02410000
C MZAHL,NORM                                        FORMAT(2I5)         02420000
C                                                                       02430000
C  MZAHL = NUMBER OF THETA - INTEGRATIONS FOR THE PROJECTILE ANGULAR    02440000
C          DISTRIBUTION                                                 02450000
C  NORM  = POS.VALUE: NUMBER OF THE GAMMA-TRANSITION ON WHICH ALL OTHER 02460000
C                     GAMMA-YIELDS ARE NORMALIZED                       02470000
C        = NEG.VALUE: NORMALIZED ON THE RUTHERFORD CROSS SECTION        02480000
C                                                                       02490000
C  EXAMPLE :                                                            02500000
C         NORM=0 FOR THE LAST POSSIBLE TRANSITION IN THE GAMMA CASCADE  02510000
C         NORM=1 FOR THE ONE BEFORE IN THE GAMMA CASCADE  E.T.C.        02520000
C                    NORM=0 FOR THE 2-->0 TRANSITION                    02530000
C  THE SEQUENCE OF THE GAMMA TRANSITIONS IS GIVEN FOR OUTPUT CONTROL    02540000
C  I17=1 OR I18=1                                                       02550000
C                                                                       02560000
C DATA CARD #13 + FOLLOWING DATA CARDS                                  02570000
C -------------                                                         02580000
C XA,XE                                             FORMAT(2F10.2)      02590000
C                                                                       02600000
C  XA,XE = SCATTERING ANGLE OF THE PROJECTILS IN THE CM - SYSTEM        02610000
C          INTEGRATION FROM XE TO XA (XA > XE)                          02620000
C                                                                       02630000
C  THE DIFFERENTIAL CROSS SECTION IS TRANSFORMED INTO THE LAB - SYSTEM  02640000
C  AND THE INTEGRATION IS DONE FOR THE SCATTERING ANGLE OF THE          02650000
C  PROJECTILE OR TARGET NUCLEUS IN THE LAB SYSTEM                       02660000
C  EXAMPLE:                                                             02670000
C  THETA(LAB-RECOIL NUCLEUS) = ( 180. - THETA(CM-PROJECTILE) ) / 2.     02680000
C                                                                       02690000
C **********************************************************************02700000
      REAL ME,MM1,MEE2                                                  02710000
      INTEGER OUAMP,OUPROW,OUXI,OUPSI                                   02720000
      INTEGER OUANG0,OUANG1,OUANG2,OUANG3                               02730000
      COMMON/C1/ E(35),SPIN(35),EE(35),MEE2(35,35),MM1(35,35),NMAX      02740000
      COMMON/C2/ ALPHA1(35,35),ALPHA2(35,35),ANG(35,5,5)                02750000
      COMMON/C12/ ALPHE1(35,35),ALPHE3(35,35),DELTA1(199)               02760000
      COMMON/C3/ I11,I12,I13,I14,I15,I16,I17,I18,I19,I20,I21,I22,I23,I2402770000
     1,I25                                                              02780000
      COMMON/C4/ Z1,Z2,A1,A2,EP,THETAP,QG(5,35),QGS(5,35),IPAR(35)      02790000
      COMMON/C14/ AJ,GZA,TAUC,H0(35)                                    02800000
C **********************************************************************02810000
C   >>>> FOR THE HAGER AND SELTZER INTERPOLATION PROGRAM  <<<<          02820000
C **********************************************************************02830000
      COMMON/C5/ ALPHAK(23,4),ALPHAL(23,4),ALPHAM(23,4),NCCK,NCCL,NCCM  02840000
      COMMON/C6/ CCE1K(4),CCE2K(4),CCE1L(4),CCE2L(4),CCE1M(4),CCE2M(4)  02850000
      COMMON/C8/ ITHETA                                                 02860000
      COMMON/C9/  CCKMIN(4),CCLMIN(4),CCMMIN(4)                         02870000
      COMMON/C19/ CCKMAX(4),CCLMAX(4),CCMMAX(4)                         02880000
C **********************************************************************02890000
      COMMON/RUTH/SIGLAB                                                02900000
      COMMON/C10/ VGAMMA,Q(5),ME(35,35,4),IITRAN(199),IFTRAN(199)       02910000
      DIMENSION AA(35),W(35,35),AYY(199,199),BYY(199,199)               02920000
      DIMENSION DS(199),AXX(199),YE(199),XX(199)                        02930000
      DIMENSION YY(199),ZZ(199),AAXX(199),XXX(199),SINLAB(199)          02940000
      DIMENSION P(35),DSIG(35),CROSSN(199)                              02950000
      DIMENSION RUTHER(199),BRUTH(199)                                  02960000
C **********************************************************************02970000
      open (5,file='INPUTang')
      open (6,file='OUTPUT')
      open (17,file='anggro')
C                                                                       02980000
C >>>> OUTPUT AND INPUT CONTROLS <<<<                                   02990000
C                                                                       03000000
      READ(5,52) I11,I12,I13,I14,I15,I16,I17,I18,I19,I20,I21,I22,I23,I2403010000
     1,I25                                                              03020000
  52  FORMAT(15(1X,I1))                                                 03030000
C **********************************************************************03040000
C                                                                       03050000
C               >>>> INPUT FROM COULEX-PROGRAM <<<<                     03060000
C                                                                       03070000
C          THE FIRST PART OF THIS PROGRAM - INPUT OF DATA -             03080000
C              IS TAKEN FROM A DISK >>>> READ(17) <<<<                  03090000
C                                                                       03100000
C **********************************************************************03110000
C                                                                       03120000
      READ(17,8000) Z1,A1,Z2,A2,EP,QPAR                                 03130000
 8000 FORMAT(6F10.3)
C                                                                       03140000
C Z1 = CHARGE NUMBER OF THE PROJECTILE                                  03150000
C A1 = MASS OF THE PROJECTILE IN A.M.U.                                 03160000
C Z2 = CHARGE NUMBER OF THE TARGET NUCLEUS                              03170000
C A2 = MASS OF THE TARGET NUCLEUS IN A.M.U.                             03180000
C EP = LABORATORY ENERGY OF THE PROJECTILE IN MEV                       03190000
C QPAR = E1-POLARISATION                                                03200000
C                                                                       03210000
      IF(I25.EQ.0) GOTO 1000                                            03220000
      Z1P=Z2                                                            03230000
      A1P=A2                                                            03240000
      EP=EP*A2/A1                                                       03250000
      Z2=Z1                                                             03260000
      A2=A1                                                             03270000
      Z1=Z1P                                                            03280000
      A1=A1P                                                            03290000
C                                                                       03300000
 1000 READ(17,8001) NMAX                                                03310000
 8001 FORMAT(I10)
C                                                                       03320000
C NMAX = NUMBER OF NUCLEAR STATES                                       03330000
C                                                                       03340000
      DO 7001 IWOLLE=1,NMAX                                             03350000
      READ(17,8002) SPIN(IWOLLE),E(IWOLLE),IPAR(IWOLLE)                 03360000
 8002 FORMAT(2F10.3,I10)
 7001 CONTINUE                                                          03370000
C                                                                       03380000
C SPIN(N) = SPIN QUANTUM NUMBER OF THE N-TH NUCLEAR STATE               03390000
C E(N) = EXCITATION ENERGY OF THE N-TH NUCLEAR STATE IN MEV             03400000
C IPAR(N) = PARITY OF THE N-TH NUCLEAR STATE                            03410000
C        IPAR = 1 POSITIVE PARITY, IPAR=-1 NEGATIVE PARITY              03420000
C                                                                       03430000
      READ(17,8003) INTERV,NCM,EMMAX,XIMAX,ACCUR,NTIME                  03440000
 8003 FORMAT(2I10,3F10.5,I10)
C                                                                       03450000
C OUTPUT CONTROLS FOR THE COULEX CALCULATION                            03460000
C                                                                       03470000
      READ(17,8004) OUXI,OUPSI,OUAMP,OUPROW,OUANG0,OUANG1,OUANG2,OUANG3 03480000
 8004 FORMAT(8I10)
C                                                                       03490000
C OUTPUT CONTROLS FOR THE COULEX CALCULATION                            03500000
C                                                                       03510000
      DO 7003 IME14=1,4                                                 03520000
      DO 7002 IWOLLE=1,NMAX                                             03530000
      READ(17,8005) (ME(IWOLLE,IW,IME14),IW=1,NMAX)                     03540000
 8005 FORMAT(10F10.3)
C                                                                       03550000
C INPUT OF THE E1-,E2-,E3-, AND E4-MATRIX                               03560000
C                                                                       03570000
      IF(IME14.NE.4) GOTO 7002                                          03580000
      DO 7004 IW=1,NMAX                                                 03590000
      IF(ABS(ME(IWOLLE,IW,4)).GT.0.0) IME4=1                            03600000
 7004 CONTINUE                                                          03610000
 7002 CONTINUE                                                          03620000
 7003 CONTINUE                                                          03630000
C                                                                       03640000
      READ(17,8006) THETA                                               03650000
 8006 FORMAT(F10.3)
C                                                                       03660000
C THETA = SCATTERING ANGLE OF THE PROJECTILE (IN DEGREE) IN THE         03670000
C         CENTER-OF-MASS SYSTEM                                         03680000
C                                                                       03690000
      WRITE(6,430)                                                      03700000
  430 FORMAT(54H1DE BOER - WINTHER MULTIPLE COULOMB EXCITATION PROGRAM, 03710000
     12X,27HFOR LAMBDA  1 , 2 , 3 AND 4)                                03720000
      WRITE(6,431) Z1,A1,EP                                             03730000
  431 FORMAT(32H0PROJECTILE CHARGE NUMBER  Z1 = ,F6.2,14H,  MASS  A1 = ,03740000
     1F8.3,23HAMU,  LAB ENERGY  EP = ,F8.3,3HMEV)                       03750000
      WRITE(6,434) THETA                                                03760000
  434 FORMAT(52H0SCATTERING ANGLE IN CENTER OF MASS SYSTEM  THETA = ,F7.03770000
     12,8H DEGREES)                                                     03780000
      WRITE(6,437) Z2,A2                                                03790000
  437 FORMAT(28H0TARGET CHARGE NUMBER  Z2 = ,F6.2,14H,  MASS  A2 = ,F8.303800000
     1,3HAMU/)                                                          03810000
      WRITE(6,438)                                                      03820000
  438 FORMAT(11X,'NO.',5X,'  SPIN   ',3X,' ENERGY    PARITY ( POS.=1 /  03830000
     1NEG.=-1 )'/)                                                      03840000
      NE1E3=0                                                           03850000
C                                                                       03860000
C     NE1E3 = 1 IF NEGATIVE PARITY STATES ARE INCLUDED IN THE COULEX-   03870000
C     CALCULATION ===> OUTPUT OF E1- AND E3-MATRIX                      03880000
C                                                                       03890000
      DO 7175 I175=1,NMAX                                               03900000
      IF(IPAR(I175).LT.0) NE1E3=1                                       03910000
 7175 WRITE(6,7176) I175,SPIN(I175),E(I175),IPAR(I175)                  03920000
 7176 FORMAT(10X,I3,7X,F5.1,4X,F9.4,2X,I5)                              03930000
      WRITE(6,7177) QPAR                                                03940000
 7177 FORMAT(1X/1X,'E1-POLARISATION,QPAR = ',F8.4/)                     03950000
      WRITE(6,442)                                                      03960000
  442 FORMAT(84H0PERFORMANCE CONTROLS  NMAX,   INTERV,   NCM,   EMMAX,  03970000
     1 XIMAX,     ACCUR,     NTIME)                                     03980000
      WRITE(6,443)NMAX,INTERV,NCM,EMMAX,XIMAX,ACCUR,NTIME               03990000
  443 FORMAT(1H0,19X,I6,2X,2I8,2F9.2,F13.7,I9)                          04000000
      WRITE(6,444)                                                      04010000
  444 FORMAT(81H0OUTPUT CONTROLS       OUXI, OUPSI, OUAMP, OUPROW, OUANG04020000
     10, OUANG1, OUANG2, OUANG3)                                        04030000
      WRITE(6,445) OUXI,OUPSI,OUAMP,OUPROW,OUANG0,OUANG1,OUANG2,OUANG3  04040000
  445 FORMAT(1H0,17X,3I7,5I8)                                           04050000
      WRITE(6,43)                                                       04060000
   43 FORMAT(67H0MULTIPOLE MATRIX ELEMENTS IN BARNS**(LAM/2) , READ FROM04070000
     1 DATA CARDS)                                                      04080000
C                                                                       04090000
C THE SIGN OF THE MATRIXELEMENT FOR ELECTRIC MULTIPOLES HAS TO BE       04100000
C CHANGED, IF ONE USES THE NEW COULOMB EXCITATION PROGRAM FROM A.LELL   04110000
C THE MATRIX-ELEMENTS FOR ELECTRIC MULTIPOLES ARE NOT MULTIPLIED WITH   04120000
C (I ** L) IN THIS COULOMB EXCITATION PROGRAMM                          04130000
C ("COULOMB EXCITATION" P.310)                                          04140000
C THE CHANGE OF THE SIGN IS ONLY DONE FOR THE E2- AND E3-MATRIXELEMENTS 04150000
C                                                                       04160000
      DO 50 N=1,NMAX                                                    04170000
      DO 51 M=1,NMAX                                                    04180000
      MEE2(N,M)=-ME(N,M,2)                                              04190000
      ME(N,M,3)=-ME(N,M,3)                                              04200000
  51  CONTINUE                                                          04210000
  50  CONTINUE                                                          04220000
C                                                                       04230000
C **********************************************************************04240000
C            >>>> END OF INPUT DATA FROM COULEX <<<<                    04250000
C **********************************************************************04260000
C                                                                       04270000
C >>>> OUTPUT AND INPUT CONTROLS <<<<                                   04280000
C      -------------------------                                        04290000
      WRITE(6,53)                                                       04300000
  53  FORMAT(1H0,1X,'I11 I12 I13 I14 I15 I16 I17 I18 I19 I20 I21 I22 I2304310000
     1 I24 I25'/)                                                       04320000
      WRITE(6,54) I11,I12,I13,I14,I15,I16,I17,I18,I19,I20,I21,I22,I23,I204330000
     14,I25                                                             04340000
  54  FORMAT(15(2X,I2)/)                                                04350000
C                                                                       04360000
C      >>>> INPUT FOR HAGER+SELTZER INTERPOLATION PROGRAM <<<<          04370000
C  CONVERSION COEFFICIENTS ARE CALCULATED FOR E1-,E2-,E3-TRANSITIONS    04380000
C                                                                       04390000
      IF(NE1E3.EQ.0) GOTO 500                                           04400000
C                                                                       04410000
      MULT=1                                                            04420000
      GOTO 501                                                          04430000
  500 MULT=2                                                            04440000
  501 READ(5,100) NCCK,NCCL,NCCM                                        04450000
  100 FORMAT(3I5)                                                       04460000
      READ(5,101) CCE1K(MULT),CCE2K(MULT),CCKMIN(MULT),CCKMAX(MULT)     04470000
      READ(5,101) CCE1L(MULT),CCE2L(MULT),CCLMIN(MULT),CCLMAX(MULT)     04480000
      READ(5,101) CCE1M(MULT),CCE2M(MULT),CCMMIN(MULT),CCMMAX(MULT)     04490000
  101 FORMAT(4E10.3)                                                    04500000
      READ(5,*) (ALPHAK(I,MULT),I=1,NCCK)                               04510000
      READ(5,*) (ALPHAL(I,MULT),I=1,NCCL)                               04520000
      READ(5,*) (ALPHAM(I,MULT),I=1,NCCM)                               04530000
      IF(NE1E3.EQ.0) GOTO 502                                           04540000
      IF(MULT.EQ.1) GOTO 503                                            04550000
      IF(MULT.EQ.2) GOTO 504                                            04560000
      GOTO 502                                                          04570000
  503 MULT=2                                                            04580000
      GOTO 501                                                          04590000
  504 MULT=3                                                            04600000
      GOTO 501                                                          04610000
  502 IF(I23.EQ.0.OR.MULT.EQ.4) GOTO 511                                04620000
      MULT=4                                                            04630000
      GOTO 501                                                          04640000
  511 CONTINUE                                                          04650000
C                                                                       04660000
C M1-MATRIXELEMENTS : M1(SPIN(INITIAL) --> SPIN(FINAL)) = 0.0           04670000
C                                                                       04680000
      DO 551 I=1,NMAX                                                   04690000
      DO 552 J=1,NMAX                                                   04700000
      MM1(I,J)=0.0                                                      04710000
 552  CONTINUE                                                          04720000
 551  CONTINUE                                                          04730000
C                                                                       04740000
      IF(I23.EQ.0) GOTO 5432                                            04750000
C                                                                       04760000
C      >>>> INPUT OF M1-MATRIXELEMENTS <<<<                             04770000
C IXYZ (INITIAL-),JXYZ (FINAL-STATE),XYZ (M1-MATRIX ELEMENT)            04780000
C IF ( IXYZ.EQ.0 ) END OF INPUT FOR M1-MATRIXELEMENTS                   04790000
C                                                                       04800000
  55  READ(5,56) IXYZ,JXYZ,XYZ                                          04810000
  56  FORMAT(2I5,F10.3)                                                 04820000
      IF(IXYZ.EQ.0) GOTO 5432                                           04830000
      MM1(IXYZ,JXYZ)=XYZ                                                04840000
      GOTO 55                                                           04850000
 5432 CONTINUE                                                          04860000
C                                                                       04870000
C OUTPUT >>> E1-MATRIX <<<                                              04880000
C                                                                       04890000
      IF(NE1E3.NE.1) GOTO 5434                                          04900000
      WRITE(6,5435)                                                     04910000
 5435 FORMAT(1H0,1X,'ME1(N,M)'/)                                        04920000
      DO 5436 I=1,NMAX                                                  04930000
 5436 WRITE(6,59) (ME(I,J,1),J=1,NMAX)                                  04940000
  59  FORMAT(1X,10F8.3)                                                 04950000
C                                                                       04960000
C OUTPUT >>> E2-MATRIX <<<                                              04970000
C                                                                       04980000
 5434 WRITE(6,57)                                                       04990000
  57  FORMAT(1H0,1X,'ME2(N,M)'/)                                        05000000
      DO 58 I=1,NMAX                                                    05010000
  58  WRITE(6,59) (MEE2(I,J),J=1,NMAX)                                  05020000
C                                                                       05030000
C OUTPUT >>> E3-MATRIX <<<                                              05040000
C                                                                       05050000
      IF(NE1E3.NE.1) GOTO 5437                                          05060000
      WRITE(6,5438)                                                     05070000
 5438 FORMAT(1H0,1X,'ME3(N,M)'/)                                        05080000
      DO 5439 I=1,NMAX                                                  05090000
 5439 WRITE(6,59) (ME(I,J,3),J=1,NMAX)                                  05100000
 5437 CONTINUE                                                          05110000
C                                                                       05120000
C OUTPUT >>> E4-MATRIX <<<                                              05130000
C                                                                       05140000
      IF(IME4.NE.1) GOTO 5443                                           05150000
      WRITE(6,5441)                                                     05160000
 5441 FORMAT(1H0,1X,'ME4(N,M)'/)                                        05170000
      DO 5442 I=1,NMAX                                                  05180000
 5442 WRITE(6,59) (ME(I,J,4),J=1,NMAX)                                  05190000
 5443 CONTINUE                                                          05200000
C                                                                       05210000
C OUTPUT >>> M1-MATRIX <<<                                              05220000
C                                                                       05230000
      IF(I23.EQ.0) GOTO 5433                                            05240000
      WRITE(6,60)                                                       05250000
  60  FORMAT(1H0,1X,'MM1(N,M)'/)                                        05260000
      DO 61 I=1,NMAX                                                    05270000
  61  WRITE(6,59) (MM1(I,J),J=1,NMAX)                                   05280000
 5433 CONTINUE                                                          05290000
C                                                                       05300000
C TOTAL M1-CONVERSION COEFFICIENT:ALPHA(SPIN(INITIAL)-->SPIN(FINAL))=0.005310000
C                                                                       05320000
      DO 661 I=1,NMAX                                                   05330000
      DO 662 J=1,NMAX                                                   05340000
      ALPHA1(I,J)=0.0                                                   05350000
 662  CONTINUE                                                          05360000
 661  CONTINUE                                                          05370000
      MMAX=0                                                            05380000
C                                                                       05390000
C THE COMPLETE ANGULAR DISTRIBUTION IS CALCULATED ONLY FOR              05400000
C THE FIRST SCATTERING ANGLE : MMAX = 1                                 05410000
C     -----                                                             05420000
      IF(I19.EQ.1) MMAX=1                                               05430000
C                                                                       05440000
      READ(5,67) TT,VGAMMA,VI1,VI2,K1LAB                                05450000
  67  FORMAT(4F10.3,2I2)                                                05460000
C                                                                       05470000
C TT     =  POLAR ANGLE OF THE GAMMA - DETECTOR      (IN DEGREE)        05480000
C VGAMMA =  AZIMUTHAL ANGLE OF THE GAMMA - DETECTOR  (IN DEGREE)        05490000
C VI1 AND VI2 ARE THE AZIMUTHAL ANGLES OF THE PARTICLE DETECTOR         05500000
C VI1    =  LOWER BOUNDARY OF THE PARTICLE DETECTOR  (IN DEGREE)        05510000
C VI2    =  UPPER BOUNDARY OF THE PARTICLE DETECTOR  (IN DEGREE)        05520000
C K1LAB  =  SPECIFY THE NUMBER OF THE STATE,FOR WHICH THE TRANSFORMATION05530000
C           FROM THE CM-SYSTEM TO THE LAB-SYSTEM IS DONE                05540000
C                                                                       05550000
      IF(I24.GT.1) WRITE(6,72)                                          05560000
  72  FORMAT(1X/1X,'ANGLE OF THE GE(LI)-DETECTOR IN THE REST-SYSTEM :') 05570000
      WRITE(6,68) TT,VGAMMA,VI1,VI2,NMAX,K1LAB                          05580000
  68  FORMAT(1X/1X,'THETA = ',F8.2,1X,'VGAMMA = ',F8.2//                05590000
     11X,'VI1 = ',F8.2,1X,'VI2 = ',F8.2//                               05600000
     21X,'NUMBER OF TENSORS + 1 (FOR EVERY SCATTERING ANGLE) = ',I2//   05610000
     31X,'TRANSFORMATION FROM THE CM- TO THE LAB-SYSTEM ',              05620000
     4'(INDEX OF THE STATE) = ',I2/)                                    05630000
C                                                                       05640000
      VGAMMA=VGAMMA*3.1415926/180.                                      05650000
C ----------------------------------------------------------------------05660000
C                                                                       05670000
C INPUT OF THE FINITE SOLID-ANGLE CORRECTION FOR THE GE(LI)-DETECTOR    05680000
C                                                                       05690000
      IF(I22.EQ.0) GOTO 1807                                            05700000
C                                                                       05710000
      DO 123 IXYZ=1,35                                                  05720000
      DO 124 JXYZ=1,35                                                  05730000
      QG(1,IXYZ)=1.                                                     05740000
      QG(3,IXYZ)=1.                                                     05750000
      QG(5,IXYZ)=1.                                                     05760000
      QGS(1,IXYZ)=1.                                                    05770000
      QGS(3,IXYZ)=1.                                                    05780000
      QGS(5,IXYZ)=1.                                                    05790000
  124 CONTINUE                                                          05800000
  123 CONTINUE                                                          05810000
C                                                                       05820000
      READ(5,1808) (Q(IH),IH=1,5,2)                                     05830000
 1808 FORMAT(3F10.3)                                                    05840000
C                                                                       05850000
C FINITE SOLID-ANGLE CORRECTION FOR THE GE(LI)-DETECTOR                 05860000
C ASSUMPTION : Q0,Q2,Q4 ARE INDEPENDENT FROM THE GAMMA-ENERGY           05870000
C                                                                       05880000
      WRITE(6,1809) (Q(IH),IH=1,5,2)                                    05890000
 1809 FORMAT(1H0,1X,'FINITE SOLIDE-ANGLE CORRECTION FOR THE GE(LI)-DETEC05900000
     1TOR'/1X,' Q0 = ',F10.4,' Q2 = ',F10.4,' Q4 = ',F10.4/)            05910000
C                                                                       05920000
C >>>> INPUT FOR THE DEORIENTATION CORRECTION <<<<                      05930000
C                                                                       05940000
      IF(I22.EQ.2) GOTO 121                                             05950000
      IF(I22.EQ.3.OR.I22.EQ.4) GOTO 126                                 05960000
C                                                                       05970000
      GOTO 1807                                                         05980000
  121 READ(5,122) IXYZ,XYZ1,XYZ2                                        05990000
  122 FORMAT(1I5,2F10.3)                                                06000000
C                                                                       06010000
C IXYZ (NUMBER OF NUCLEAR STATE),XYZ1 (G2 - ATTENUATION - COEFFICIENT), 06020000
C XYZ2 (G4 - ATTENUATION - COEFFICIENT)                                 06030000
C IF ( IXYZ.EQ.0 ) END OF INPUT FOR ATTENUATION - COEFFICIENTS          06040000
C                                                                       06050000
      IF(IXYZ.EQ.0) GOTO 1807                                           06060000
      QGS(1,IXYZ)=1.                                                    06070000
      QGS(3,IXYZ)=XYZ1                                                  06080000
      QGS(5,IXYZ)=XYZ2                                                  06090000
      WRITE(6,125) IXYZ,QGS(1,IXYZ),QGS(3,IXYZ),QGS(5,IXYZ)             06100000
  125 FORMAT(1X,'ATTENUATION COEFFICIENTS #',I2,' G0 = ',F6.3,' G2 = '  06110000
     1,F6.3,' G4 = ',F6.3)                                              06120000
      GOTO 121                                                          06130000
  126 DO 132 IN=2,NMAX                                                  06140000
      READ(5,127) AJ,GZA,TAUC,H0(IN)                                    06150000
  127 FORMAT(2F10.3,2E10.3)                                             06160000
C                                                                       06170000
C  AJ = ATOMIC SPIN                                                     06180000
C  GZA = G-FACTOR                                                       06190000
C  TAUC = REORIENTATION TIME IN VACUUM (PSEC)                           06200000
C  H0 = MAGNETIC HYPERFINE FIELD (MEGA GAUSS)                           06210000
C                                                                       06220000
      ALAMD2=2.*((AJ+1.)/AJ)*((4789.44*GZA*H0(IN))**2)*TAUC*1.E-12      06230000
      IF(I22.EQ.3) WRITE(6,128) AJ,GZA,TAUC,H0(IN)                      06240000
  128 FORMAT(1X,' CALCULATION OF THE ATTENUATION COEFFICIENTS > GK < U  06250000
     1SING THE SCHERER-BLUME THEORY'//1X,'ATOMIC SPIN = ',F3.1,2X,'G-FAC06260000
     2TOR = ',F5.2,2X,'REORIENTATION TIME = ',E10.3,' (PSEC) ',2X,'MAGN.06270000
     3FIELD = ',E10.3,' (MEGA GAUSS)'/)                                 06280000
      IF(I22.EQ.4) WRITE(6,130) AJ,GZA,TAUC,H0(IN),ALAMD2               06290000
  130 FORMAT(1X,' CALCULATION OF THE ATTENUATION COEFFICIENTS > GK < U  06300000
     1SING THE ABRAGAM-POUND THEORY'//1X,'ATOMIC SPIN = ',F3.1,2X,'G-FAC06310000
     2TOR = ',F5.2,2X,'REORIENTATION TIME = ',E10.3,' (PSEC) ',2X,'MAGN.06320000
     3FIELD = ',E10.3,' (MEGA GAUSS)'/2X,' LAMDA2 = ',E10.3,            06330000
     4' (1/PSEC)'/)                                                     06340000
      H0(IN)=H0(IN)*1.E+6                                               06350000
      TAUC=TAUC*1.E-12                                                  06360000
  132 CONTINUE                                                          06370000
 1807 CONTINUE                                                          06380000
C ----------------------------------------------------------------------06390000
C                                                                       06400000
C THETAP = THETA (SCATTERING ANGLE IN THE CM-SYSTEM)                    06410000
C                                                                       06420000
      THETAP=THETA                                                      06430000
      ITHETA=0                                                          06440000
      I=0                                                               06450000
  80  ITHETA=ITHETA+1                                                   06460000
      I=I+1                                                             06470000
      DO 83 J=2,NMAX                                                    06480000
      DO 84 J1=1,5,2                                                    06490000
      DO 85 J2=1,5                                                      06500000
      ANG(J,J1,J2)=0.0                                                  06510000
  85  CONTINUE                                                          06520000
  84  CONTINUE                                                          06530000
  83  CONTINUE                                                          06540000
C                                                                       06550000
C INPUT OF THE ANGULAR DISTRIBUTION TENSORS FROM THE DISK >>READ(17)<<  06560000
C                                                                       06570000
      IF(I21.EQ.0) GOTO 1805                                            06580000
      WRITE(6,1010)                                                     06590000
 1010 FORMAT(2X,'ANG(0,0)   ANG(2,2)   ANG(2,1)   ANG(2,0)   ANG(4,4) ' 06600000
     1,'  ANG(4,3)   ANG(4,2)   ANG(4,1)   ANG(4,0)'/)                  06610000
 1805 DO 6 J=2,NMAX                                                     06620000
      READ(17,8007) ((ANG(J,J1,J2),J2=1,J1),J1=1,5,2)                   06630000
 8007 FORMAT(1X,9E12.4)
C                                                                       06640000
      P(J)=ANG(J,1,1)                                                   06650000
C                                                                       06660000
      IF(I21.EQ.0) GOTO 1806                                            06670000
      WRITE(6,1030) ANG(J,1,1),ANG(J,3,3),ANG(J,3,2),ANG(J,3,1),        06680000
     1ANG(J,5,5),ANG(J,5,4),ANG(J,5,3),ANG(J,5,2),ANG(J,5,1)            06690000
 1030 FORMAT(9(1X,E10.4))                                               06700000
 1806 CONTINUE                                                          06710000
   6  CONTINUE                                                          06720000
C                                                                       06730000
C THETAP = SCATTERING ANGLE OF THE PROJECTILES IN THE CM - SYSTEM       06740000
C          FOR WHICH THE ANGULAR DISTRIBUTION TENSORS ARE CALCULATED    06750000
C                                                                       06760000
      WRITE(6,1301) THETAP                                              06770000
 1301 FORMAT(1H0,'THETAP = ',F10.2/)                                    06780000
C                                                                       06790000
CCC   IF(I21.EQ.0) GOTO 1800                                            06800003
      PSUM=0.0                                                          06810000
      DO 1801 J=2,NMAX                                                  06820000
      PSUM=PSUM+P(J)                                                    06830000
C                                                                       06840000
C CALCULATION OF THE RUTHERFORD CROSS SECTION  (IN BARNS/STERADIAN)     06850000
C                                                                       06860000
      VF1=((1.+A1/A2)*Z1*Z2/EP)**2                                      06870000
      VF2=SQRT(EP/(EP-(1.+A1/A2)*E(J)))                                 06880000
      DSR=1.2958E-3*VF1*VF2*(1./SIN(THETAP*3.1415926/(180.*2.))**4)     06890000
C                                                                       06900000
 1801 DSIG(J)=P(J)*DSR                                                  06910000
      P(1)=1.-PSUM                                                      06920000
      VF1=((1.+A1/A2)*Z1*Z2/EP)**2                                      06930000
      VF2=SQRT(EP/(EP-(1.+A1/A2)*E(1)))                                 06940000
      DSR=1.2958E-3*VF1*VF2*(1./SIN(THETAP*3.1415926/(180.*2.))**4)     06950000
C                                                                       06960000
C CALCULATION OF THE CM - CROSS SECTION (IN BARNS/STERADIAN)            06970000
C                                                                       06980000
      DSIG(1)=P(1)*DSR                                                  06990000
      WRITE(6,1802)                                                     07000000
 1802 FORMAT(1H0,1X,'LEVEL INDEX',6X,'EXCITATION',6X,'CM CROSS SECTION'/07010000
     117X,'PROBABILITIES',5X,'BARNS/STERADIAN'//                        07020000
     26X,'N',15X,'P(N)',13X,'DSIG(N)')                                  07030000
      DO 1803 J=1,NMAX                                                  07040000
 1803 WRITE(6,1804) J,P(J),DSIG(J)                                      07050000
 1804 FORMAT(5X,I2,11X,E11.4,7X,E11.4)                                  07060000
C1800 CONTINUE                                                          07070003
C                                                                       07080000
C SUBROUTINE FOR CALCULATION OF THE DOUBLE DIFFERENTIAL CROSS SECTION   07090000
C INCLUDING THE INTEGRATION OVER THE FINAL PARTICLE DETECTOR            07100000
C (AZIMUTHAL-ANGLE)                                                     07110000
C                                                                       07120000
CCC   CALL ANGPAR(TT,VI1,VI2,DS,LAUF,SINLAB)                            07130003
C                                                                       07140000
      THET=THETAP*3.1415926/180.                                        07150000
      DO 90 K1=1,NMAX                                                   07160003
C                                                                       07170000
C AXX = THETA (CM. ANGLE OF PROJECTILE)                                 07180000
C                                                                       07190000
      AXX(I)=THETAP                                                     07200004
      AAXX(I)=THET                                                      07210004
C                                                                       07220000
  90  AYY(I,K1)=DSIG(K1)*SIN(THET)                                      07230003
C                                                                       07240000
      IF(MMAX.EQ.1) GOTO 82                                             07250000
C                                                                       07260000
C INPUT OF THE NEXT SCATTERING ANGLE IN THE CM-SYSTEM                   07270000
C              ----                                                     07280000
      READ(17,8006) THETAP                                              07290000
      IF(THETAP.LT.0.0001) GOTO 82                                      07300000
      GOTO 80                                                           07310000
C **********************************************************************07320000
  82  CONTINUE                                                          07330000
      MMAX=ITHETA                                                       07340000
      WRITE(6,81) MMAX                                                  07350000
  81  FORMAT(1H0,1X,'MAX. NUMBER OF SCATTERING ANGLES -THETA- =',I3/)   07360000
C                                                                       07370000
C OUTPUT >>> E2-CONVERSION COEFFICIENTS <<<                             07380000
C                                                                       07390000
      IF(I11.EQ.0) GOTO 103                                             07400000
      WRITE(6,62)                                                       07410000
  62  FORMAT(1H0,1X,'CONVERSION-COEFFICIENTS - E2 -'/)                  07420000
      DO 63 IME=1,NMAX                                                  07430000
  63  WRITE(6,64) (ALPHA2(IME,JME),JME=1,NMAX)                          07440000
  64  FORMAT(1X,10F8.3)                                                 07450000
C                                                                       07460000
C OUTPUT >>> M1-CONVERSION COEFFICIENTS <<<                             07470000
C                                                                       07480000
      IF(I23.EQ.0) GOTO 5440                                            07490000
      WRITE(6,65)                                                       07500000
  65  FORMAT(1H0,1X,'CONVERSION COEFFICIENTS - M1 -'/)                  07510000
      DO 104 IMM=1,NMAX                                                 07520000
 104  WRITE(6,64) (ALPHA1(IMM,JMM),JMM=1,NMAX)                          07530000
 5440 IF(NE1E3.EQ.0) GOTO 103                                           07540000
C                                                                       07550000
C OUTPUT >>> E1-CONVERSION COEFFICIENTS <<<                             07560000
C                                                                       07570000
      WRITE(6,508)                                                      07580000
 508  FORMAT(1H0,1X,'CONVERSION-COEFFICIENTS - E1 -'/)                  07590000
      DO 505 IME=1,NMAX                                                 07600000
 505  WRITE(6,64) (ALPHE1(IME,JME),JME=1,NMAX)                          07610000
C                                                                       07620000
C OUTPUT >>> E3-CONVERSION COEFFICIENTS <<<                             07630000
C                                                                       07640000
      WRITE(6,506)                                                      07650000
 506  FORMAT(1H0,1X,'CONVERSION-COEFFICIENTS - E3 -'/)                  07660000
      DO 507 IME=1,NMAX                                                 07670000
 507  WRITE(6,64) (ALPHE3(IME,JME),JME=1,NMAX)                          07680000
 103  CONTINUE                                                          07690000
C                                                                       07700000
C FOR A COMPLETE ANGULAR DISTRIBUTION :  I19 = 1                        07710000
C OR A CALCULATION INCLUDING ONLY ONE SCATTERING ANGLE                  07720000
C THE INTEGRATION OVER THE PARTICLE-DETECTOR IS NOT POSSIBLE            07730000
C                                                                       07740000
      IF(I19.EQ.1) GOTO 1900                                            07750000
      IF(MMAX.EQ.1) GOTO 1900                                           07760000
C                                                                       07770000
      READ(5,5100) MZAHL,NORM                                           07780000
 5100 FORMAT(2I5)                                                       07790000
C                                                                       07800000
C  MZAHL = NUMBER OF THETA - INTEGRATIONS FOR THE PROJECTILE ANGULAR    07810000
C          DISTRIBUTION                                                 07820000
C  NORM  = POS.VALUE: NUMBER OF THE GAMMA-TRANSITION ON WHICH ALL OTHER 07830000
C                     GAMMA-YIELDS ARE NORMALIZED                       07840000
C        = NEG.VALUE: NORMALIZED ON THE RUTHERFORD CROSS SECTION        07850000
C                                                                       07860000
      IF(NORM.GE.0) WRITE(6,5110) MZAHL,NORM                            07870000
 5110 FORMAT(1H0,1X,'NUMBER OF THETA-INTEGRATIONS = ',I3/               07880000
     11X,'NUMBER OF THE TRANSITION FOR THE NORMALIZATION = ',I3/)       07890000
      IF(NORM.LT.0) WRITE(6,5111) MZAHL,NORM                            07900000
 5111 FORMAT(1H0,1X,'NUMBER OF THETA-INTEGRATIONS = ',I3/               07910000
     11X,'NORMALIZED TO THE RUTHERFORD CROSS SECTION = ',I3/)           07920000
C ----------------------------------------------------------------------07930000
      DO 7654 JZAHL=1,MZAHL                                             07940000
      READ(5,1302) XA,XE                                                07950000
 1302 FORMAT(2F10.2)                                                    07960000
C                                                                       07970000
C  XA,XE = SCATTERING ANGLE OF THE PROJECTILS IN THE CM - SYSTEM        07980000
C          INTEGRATION FROM XE TO XA (XA > XE)                          07990000
C                                                                       08000000
      WRITE(6,1303) XA,XE                                               08010000
      WRITE(20,1303) XA,XE                                              08020000
 1303 FORMAT(1X,'INTEGRATION FROM ',F10.2,' TO ',F10.2/)                08030000
      DO 91 K1=1,MMAX                                                   08040000
      K2=K1+1                                                           08050000
      IF(AXX(K1).GT.XA.AND.AXX(K2).LT.XA) GOTO 92                       08060000
      IF(AXX(K1).EQ.XA) GOTO 92                                         08070000
      GOTO 93                                                           08080000
C                                                                       08090000
C LINEAR INTERPOLATION AT THE BOUNDARIES OF THE PARTICLE DETECTOR       08100000
C                                                                       08110000
  92  DO 94 K3=1,NMAX                                                   08120004
  94  BYY(1,K3)=(AYY(K2,K3)-AYY(K1,K3))*(XA-AXX(K1))/                   08130000
     1(AXX(K2)-AXX(K1))+AYY(K1,K3)                                      08140000
C     WRITE(6,705) XA,(BYY(1,K3),K3=1,LAUF)                             08150000
 705  FORMAT(1X,11E10.4)                                                08160000
      GOTO 91                                                           08170000
  93  IF(AXX(K1).GT.XE.AND.AXX(K2).LT.XE) GOTO 95                       08180000
      IF(AXX(K1).EQ.XE) GOTO 95                                         08190000
      GOTO 91                                                           08200000
C                                                                       08210000
C LINEAR INTERPOLATION AT THE BOUNDARIES OF THE PARTICLE DETECTOR       08220000
C                                                                       08230000
  95  DO 96 K3=1,NMAX                                                   08240004
  96  YE(K3)=(AYY(K2,K3)-AYY(K1,K3))*(XE-AXX(K1))/                      08250000
     1(AXX(K2)-AXX(K1))+AYY(K1,K3)                                      08260000
C     WRITE(6,705) XE,(YE(K3),K3=1,LAUF)                                08270000
  91  CONTINUE                                                          08280000
C                                                                       08290000
C XXX = THETA (CM. ANGLE OF PROJECTILE)                                 08300000
C                                                                       08310000
      XXX(1)=XA                                                         08320000
C                                                                       08330000
      XX(1)=XA*3.1415926/180.                                           08340004
C                                                                       08350000
 1003 I=2                                                               08360000
      DO 97 K1=1,MMAX                                                   08370000
      IF(AXX(K1).GT.XA) GOTO 97                                         08380000
      IF(AXX(K1).LT.XE) GOTO 98                                         08390000
      XXX(I)=AXX(K1)                                                    08400000
      XX(I)=AAXX(K1)                                                    08410000
      DO 99 K2=1,NMAX                                                   08420004
  99  BYY(I,K2)=AYY(K1,K2)                                              08430000
      I=I+1                                                             08440000
  97  CONTINUE                                                          08450000
  98  XXX(I)=XE                                                         08460000
C                                                                       08470000
      XX(I)=XE*3.1415926/180.                                           08480004
 1005 DO 700 K2=1,NMAX                                                  08490004
 700  BYY(I,K2)=YE(K2)                                                  08500000
C ----------------------------------------------------------------------08510000
      DO 701 K2=1,NMAX                                                  08520004
      DO 702 I1=1,I                                                     08530000
      YY(I1)=BYY(I1,K2)                                                 08540000
 702  CONTINUE                                                          08550000
C                                                                       08560000
C SUBROUTINE FOR THE INTEGRATION OVER THE PARTICLE-DETECTOR             08570000
C (THETAP)                                                              08580000
C                                                                       08590000
      CALL DQTFG(XX,YY,ZZ,I)                                            08600000
      CROSSN(K2)=ZZ(I)*(VI2-VI1)/57.2958                                08610004
      WRITE(6,706) K2,CROSSN(K2)                                        08620004
 706  FORMAT(1X,'LEVEL # = ',I2,' CROSS-SECTION (BARN)=',E15.8)         08630004
 701  CONTINUE                                                          08640000
7654  CONTINUE                                                          08650000
1900  STOP                                                              08660000
      END                                                               08670000
      SUBROUTINE DQTFG(X,Y,Z,NDIM)                                      08680000
C                                                                       08690000
C     ..................................................................08700000
C                                                                       08710000
C     PURPOSE                                                           08720000
C        TO COMPUTE THE VECTOR OF INTEGRAL VALUES FOR A GIVEN           08730000
C        GENERAL TABLE OF ARGUMENT AND FUNCTION VALUES.                 08740000
C                                                                       08750000
C     USAGE                                                             08760000
C        CALL DQTFG(X,Y,Z,NDIM)                                         08770000
C                                                                       08780000
C     DESCRIPTION OF PARAMETERS                                         08790000
C        X      - DOUBLE PRECISION INPUT VECTOR OF ARGUMENT VALUES.     08800000
C        Y      - DOUBLE PRECISION INPUT VECTOR OF FUNCTION VALUES.     08810000
C        Z      - RESULTING DOUBLE PRECISION VECTOR OF INTEGRAL         08820000
C                 VALUES. Z MAY BE IDENTICAL WITH X OR Y.               08830000
C        NDIM   - THE DIMENSION OF VECTORS X,Y,Z.                       08840000
C                                                                       08850000
C     REMARKS                                                           08860000
C        NO ACTION IN CASE NDIM LESS THAN 1.                            08870000
C                                                                       08880000
C     SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED                     08890000
C        NONE                                                           08900000
C                                                                       08910000
C     METHOD                                                            08920000
C        BEGINNING WITH Z(1)=0. EVALUATION OF VECTOR Z IS DONE BY       08930000
C        MEANS OF TRAPEZOIDAL RULE (SECOND ORDER FORMULA).              08940000
C        FOR REFERENCE, SEE                                             08950000
C        F.B.HILDEBRAND, INTRODUCTION TO NUMERICAL ANALYSIS,            08960000
C        MCGRAW-HILL, NEW YORK/TORONTO/LONDON, 1956, PP.75.             08970000
C                                                                       08980000
C     ..................................................................08990000
C                                                                       09000000
      DIMENSION X(1),Y(1),Z(1)                                          09010000
c      DOUBLE PRECISION X,Y,Z,SUM1,SUM2                                  09020000
C                                                                       09030000
      SUM2=0.E0                                                         09040000
      IF(NDIM-1)4,3,1                                                   09050000
C                                                                       09060000
C     INTEGRATION LOOP                                                  09070000
    1 DO 2 I=2,NDIM                                                     09080000
      SUM1=SUM2                                                         09090000
      SUM2=SUM2+.5E0*(X(I)-X(I-1))*(Y(I)+Y(I-1))                        09100000
    2 Z(I-1)=SUM1                                                       09110000
    3 Z(NDIM)=SUM2                                                      09120000
    4 RETURN                                                            09130000
      END                                                               09140000
