A More Elaborate Example

Taking the sample program as a basis, let us expand it to illustrate the sort of features to expect in CCSL. Suppose we have data which describe a crystallographic structure, and we want to generate indices as above, but then to take an asymmetric unit full of reflections, sort them in ascending order of $\sin\theta/\lambda$, and list them with calculated structure factors.

The expanded program below uses in addition from CCSL:

crystallographic routines

LATABS - is it a lattice absence?
FCALC - form a complex structure factor
ISPABS - is it a space group absence?

utility routines

VCTMOD - vector length (for $\sin\theta/\lambda$)
INDFLO - convert integers into real numbers
SORTX - sort real numbers in ascending order
ERRMES - send an error message if necessary

input (setting-up ) routines

ATOPOS - read a set of atomic positions
SETFOR - read a set of form factors
SETANI - read anisotropic temperature factors

There are more declarations at the head of the program. The FUNCTION FCALC is COMPLEX, so both it and the variable to which the program sets it must be declared COMPLEX. ISPCE and ISTAR must be declared CHARACTER *1.

ISPABS and LATABS are LOGICAL FUNCTIONs, and must be so declared. SORTX sorts within arrays in store, so these must be DIMENSIONed.

The following, then, is the larger example main program. It should by now be fairly clear to the reader what the various parts of it are, and how they fit together.

      COMPLEX FC,FCALC
      LOGICAL NOMORE,ISPABS,LATABS
      DIMENSION H(3),K(3,1000),SINTH(1000),IPNT(1000)
      COMMON /IOUNIT/LPT,ITI,ITO,IPLO,LUNI,IOUT
      CHARACTER *1 ISPCE,ISTAR
      DATA ISPCE,ISTAR/' ','*'/
C
      CALL PREFIN('GETSF')
      WRITE (ITO,2002)
2002  FORMAT (' Value of sin theta/lambda max? ')
      READ (ITI,1000) S
1000  FORMAT (F10.4)
      CALL SYMOP
      CALL OPSYM(1)
      CALL OPSYM(2)
      CALL RECIP
      CALL ATOPOS
      CALL SETFOR
      CALL SETANI
      CALL SYMUNI
      WRITE (LPT,2000)
2000  FORMAT (////'  Sorted structure factors - * indicates space',
     1 'group absence:'/'     No.    h   k   l    Mult     s',
     2'            A            B          FcMod')
      CALL SETGEN(S)
C COMPLAIN AND STOP IF THERE WERE ERRORS IN THE INPUT
      CALL ERRMES(0,0,' to GETSF')
      NSUM=0
      N=0
   1  CALL GETGEN(H,NOMORE)
      IF (NOMORE) GO TO 2
      IF (LATABS(H)) GO TO 1
      MULT=MULBOX(H)
      IF (MULT .EQ. 0) GO TO 1
      N=N+1
      NSUM=NSUM+MULT
      SINTH(N)=VCTMOD(0.5,H,2)
      CALL INDFIX(H,K(1,N))
      GO TO 1
C
C SORT THE ARRAY IPNT, SO THAT IT POINTS TO THE ELEMENTS 
C OF SINTH IN SEQUENCE:  
   2  CALL SORTX(SINTH,IPNT,N)
      DO 3 I=1,N
      J=IPNT(I)
      CALL INDFLO(H,K(1,J))
      FC=FCALC(H)
      A=REAL(FC)
      B=AIMAG(FC)
      FCMOD=SQRT(A*A+B*B)
      IC=ISPCE
      IF (ISPABS(H)) IC=ISTAR
      M=MULBOX(H)
      WRITE (LPT,2001) IC,I,(K(L,J),L=1,3),M,SINTH(J),A,B,FCMOD
2001  FORMAT (' ',A1,I5,2X,3I4,2X,I5,F10.5,3X,3F12.5)
   3  CONTINUE
      WRITE (LPT,100)  NSUM,S
 100  FORMAT (/'  Total number of reflections inside sphere',
     1'=',I4/' S max=',F10.4)
      STOP
      END

The initial dialogue which has been given as a WRITE and a READ statement for simplicity could be more elegantly rendered as:

      CALL ASK('Value of sin theta/lambda max?')
      CALL RDREAL(S,1,IP,80,IE)

because the routine ASK puts out the given message on the screen, and reads in a line from the keyboard ready for routine RDREAL to read the value of S.

Similarly, the WRITE statement with FORMAT 2000 could be replaced by:

      CALL CENTRE(LPT,4,'Sorted structure factors - * indicates '//
     1 'space group absence;',80)
      CALL MESS(LPT,0,'    No.    h   k   l    Mult     s'//
     2 '            A            B          FcMod')