
      PROGRAM CHECKLIST                       
      CHARACTER COMPID(72),LINE(148)          
      CHARACTER*8 ATOM(200),FTYPE(13),ELEMT(86)
      INTEGER FIRSTCH(40),FWIDTH(40),CN(200),CONTNT(13),ATNO(86)       
      INTEGER F000,NELEC(13)                                           
      REAL PERCT(13),MASS(13),MU
      COMMON/MODELC/COMPID,ATOM,FTYPE                                  
      COMMON/MODEL/NATOM,NR,NT,NTYPE,NFTYPE(200),P(3,200),              0008.000
     .CN,SOF(200),UIJ(6,200),EP(3,200),ESOF(200),EUIJ(6,200),           0009.000
     .WAVEL,CELL(6),ECELL(6),R(24,3,4),T(3,4),ICENT,                    0010.000
     .SFAC(14,13),CONTNT,SCALE(4),ETA,NQ,EXTNCT                         0011.000
      DIMENSION ATWT(86)                                                0012.000
      DATA ELEMT/'H','LI','BE','B','C','N','O','F','NA','MG',           0013.000
     *'AL','SI','P','S','CL','K','CA','SC','TI','V','CR','MN',          0014.000
     *'FE','CO','NI','CU','ZN','GA','GE','AS','SE','BR','RB',           0015.000
     *'SR','Y','ZR','NB','MO','TC','RU','RH','PD','AG','CD',            0016.000
     *'IN','SN','SB','TE','I','CS','BA','LA','CE','PR','ND',            0017.000
     *'PM','SM','EU','GD','TB','DY','HO','ER','TM','YB','LU',           0018.000
     *'HF','TA','W','RE','OS','IR','PT','AU','HG','TL','PB',            0019.000
     *'BI','PO','AT','FR','RA','AC','TH','PA','U'/                      0020.000
      DATA ATNO/1,3,4,5,6,7,8,9,11,12,13,14,15,16,17,19,20,21           0021.000
     *,22,23,24,25,26,27,28,29,30,31,32,33,34,35,37,38,39,40,41         0022.000
     *,42,43,44,45,46,47,48,49,50,51,52,53,55,56,57,58,59,60,61,62      0023.000
     *,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81         0024.000
     *,82,83,84,85,87,88,89,90,91,92/                                   0025.000
      DATA ATWT/1.008,6.941,9.012,10.811,12.011,14.007,15.999,18.998,   0026.000
     *22.990,24.305,26.982,28.086,30.974,32.060,35.453,39.098,40.08, 
     *44.956,          
     *47.88,50.942,51.996,54.938,55.847,58.933,58.69,63.546,65.38,69.72
     *,72.59,74.922,78.96,79.904,85.468,87.62,88.906,91.22,92.906,95.94,
     *98.0,101.07,102.906,106.42,107.868,112.41,114.82,118.69,121.75,
     *127.6,                  
     *126.905,132.905,137.33,138.906,140.12,140.908,144.24,145.0,150.36,
     *151.96,157.25,158.924,162.5,164.93,167.26,168.934,173.04,174.967,
     *178.49,180.948,183.85,186.207,190.2,192.22,195.08,196.967,200.59,
     *204.383,207.2,208.98,209.0,210.0,223.0,226.025,227.029,232.038,  
     *231.036,238.029/
      DATA AVNO/.6023/                                                  0038.000
      DATA F/57.295779/
      DATA F2/64.98216/
      CALL MDLIN(7)                                                     0039.000
      F000=0                                                            0040.000
      FWT=0.0                                                           0041.000
      IZ=NR*NT                                                          0042.000
      IF(ICENT.EQ.0) IZ=IZ*2                                            0043.000
      DO 1 I=1,NTYPE                                                    0044.000
      DO 1 J=1,86                                                       0045.000
      IF(FTYPE(I).EQ.ELEMT(J)) THEN                                     0046.000
      NELEC(I)=CONTNT(I)*ATNO(J)                                        0047.000
      MASS(I)=FLOAT(CONTNT(I))*ATWT(J)                                  0048.000
      F000=F000+NELEC(I)                                                0049.000
      FWT=FWT+MASS(I)                                                   0050.000
      ENDIF                                                             0051.000
1     CONTINUE                                                          0052.000
      DO 2 I=1,NTYPE                                                    0053.000
2     PERCT(I)=MASS(I)/FWT                                              0054.000
      FWT=FWT/IZ                                                        0055.000
      U=CELL(1)                                                         0056.000
      V=CELL(2)                                                         0057.000
      W=CELL(3)                                                         0058.000
      COSALP=CELL(4)                                                    0059.000
      COSBET=CELL(5)                                                    0060.000
      COSGAM=CELL(6)                                                    0061.000
      SINALP=SQRT(1.-COSALP*COSALP)                                     0062.000
      SINBET=SQRT(1.-COSBET*COSBET)                                     0063.000
      SINGAM=SQRT(1.-COSGAM*COSGAM)                                     0064.000
      Q=(COSALP-COSBET*COSGAM)/SINGAM                                   0065.000
      PZ=SINBET*SINBET-Q*Q                                              0066.000
      PZ=SQRT(PZ)                                                       0067.000
      VOL=U*V*W*SQRT(1.-COSALP**2-COSBET**2-COSGAM**2+                  0068.000
     12.*COSALP*COSBET*COSGAM)                                          0069.000
      PZ=(U*V*W/VOL)**2                                                 0070.000
      EVOL=VOL*SQRT((ECELL(1)/U)**2+(ECELL(2)/V)**2+(ECELL(3)/W)**2+    0071.000
     1(PZ*(-COSALP      +COSBET*COSGAM)*ECELL(4))**2+(PZ*(-COSBET      +0072.000
     2COSALP*COSGAM)*ECELL(5))**2+(PZ*(-COSGAM      +COSALP*COSBET)*    0073.000
     3ECELL(6))**2)                                                     0074.000
      MU=0
      DO 200 I=1,NTYPE
200   MU=MU+CONTNT(I)*SFAC(12,I)
      MU=MU/VOL
      DENS=(FWT*IZ)/(VOL*AVNO)                                          0075.000
      WRITE(6,105)
105   FORMAT(25X,'CRYSTAL DATA TABLE  for  ')
      WRITE(6,110) COMPID
110   FORMAT(25X,72A1/) 
      WRITE(6,111)
111   FORMAT(25X, 'Cell Constants')
      ALPHA=F*ACOS(CELL(4))
      BETA=F*ACOS(CELL(5))
      GAMMA=F*ACOS(CELL(6))
      WRITE(6,106) U,ECELL(1),ALPHA,F2*ECELL(4)
      WRITE(6,107) V,ECELL(2),BETA,F2*ECELL(5)
      WRITE(6,108) W,ECELL(3),GAMMA,F2*ECELL(6)
      WRITE(6,103) VOL,EVOL
      WRITE(6,100) FWT                                                  0076.000
100   FORMAT(/10X,'Formula weight of asymmetric unit = ',F8.2/)         
      WRITE(6,101) DENS                                                 0078.000
101   FORMAT(10X,'Crystal density = ',F5.3,' g/cc'/)            
      WRITE(6,102) F000,MU                                            
102   FORMAT(10X,'F(000) = ',I5,6X,'Linear absorption coeff = ',F7.2,
     .' cm-1'/)                                           
106   FORMAT(10X,'a = ',F7.4,'(',F6.4,')',5X,' alpha = ',F7.3,'(',F4.2
     .,')')
107   FORMAT(10X,'b = ',F7.4,'(',F6.4,')',5X,'  beta = ',F7.3,'(',F4.2
     .,')')
108   FORMAT(10X,'c = ',F7.4,'(',F6.4,')',5X,' gamma = ',F7.3,'(',F4.2
     .,')')
103   FORMAT(15X,'Volume = ',F8.2,'(',F4.2,') Cubic Angstroms')  
      DO 3 I=1,NTYPE                                                    
3     PERCT(I)=PERCT(I)*100                                             0084.100
      WRITE(6,109)
109   FORMAT(20X,'Percentage weight of each element'/)
      WRITE(6,104)   (FTYPE(I),PERCT(I),I=1,NTYPE)       
104   FORMAT(3(10X,A2, 5X,F6.2,'%')) 
      STOP                                                              0087.000
      END                                                               0088.000
