714b8ae84d
- Fixed many things in DIFRAC subsystem:
* Recoded tcentr.f etc so that the course centering will work and will not
go into an endless loop.
* fixed boundary overwrites which occurred when yesno or alfnum where
uset to get a single character and several were given.
* Addeded documentation for DIFRAC
- Added tcl-files which support the WWW status system
57 lines
2.1 KiB
Fortran
57 lines
2.1 KiB
Fortran
C-----------------------------------------------------------------------
|
|
C Input from the existing cell
|
|
C-----------------------------------------------------------------------
|
|
SUBROUTINE CINPUT (IOUT,PRIM,ANPRIM,TRANSF)
|
|
INCLUDE 'COMDIF'
|
|
DIMENSION A(3),ALP(3),SYS(7),TRANS(3,3,7),AA(3,3),PRIM(3),
|
|
$ ANPRIM(3),TRANSF(3,3),H(3,3)
|
|
CHARACTER CATMOD*1,SYS*1,LINE*80
|
|
DATA SYS/'P','A','B','C','I','F','R'/
|
|
DATA TRANS/ 1, 0, 0, 0, 1, 0, 0, 0, 1, 1, 0, 0, 0,.5,.5,
|
|
$ 0, 0, 1, .5, 0,.5, 0, 1, 0, 0, 0, 1, .5,.5, 0,
|
|
$ 0, 1, 0, 0, 0, 1, .5,.5,.5, 0, 1, 0, 0, 0, 1,
|
|
$ .5,.5, 0, 0,.5,.5, .5, 0,.5,
|
|
$ .666667, .333333, .333333,
|
|
$ -.333333, .333333, .333333,
|
|
$ -.333333, -.666667, .333333/
|
|
RADEG = 180./3.141593
|
|
DO 100 I = 1,3
|
|
A(I) = AP(I)
|
|
ALP(I) = RADEG*ATAN2(SANG(I),CANG(I))
|
|
100 CONTINUE
|
|
110 WRITE (COUT,10000)
|
|
CALL ALFNUM (LINE)
|
|
CATMOD = LINE(1:1)
|
|
IF (CATMOD .EQ. ' ') CATMOD = 'P'
|
|
READ (CATMOD,11000) ATMOD
|
|
WRITE (COUT,12000) A,ALP,CATMOD
|
|
CALL GWRITE (IOUT,' ')
|
|
DO 120 I = 1,7
|
|
IF (CATMOD .EQ. SYS(I)) GO TO 130
|
|
120 CONTINUE
|
|
GO TO 110
|
|
C-----------------------------------------------------------------------
|
|
C CRAP is a dummy floating argument
|
|
C-----------------------------------------------------------------------
|
|
130 CALL MATRIX(A,ALP,AA,CRAP,'ORTHOG')
|
|
DO 140 N = 1,3
|
|
CALL MATRIX(AA,TRANS(1,N,I),H(1,N),CRAP,'MATVEC')
|
|
140 CONTINUE
|
|
DO 150 N = 1,3
|
|
CALL MATRIX(AA,TRANS(1,N,I),PRIM(N),CRAP,'LENGTH')
|
|
J = MOD(N,3) + 1
|
|
K = 6 - N - J
|
|
CALL MATRIX(H(1,J),H(1,K),COSNG,CRAP,'SCALPR')
|
|
ANPRIM(N) = ACOS(COSNG)*RADEG
|
|
150 CONTINUE
|
|
DO 160 N = 1,3
|
|
DO 160 NN = 1,3
|
|
TRANSF(NN,N) = TRANS(N,NN,I)
|
|
160 CONTINUE
|
|
CALL BURGER(IOUT,PRIM,ANPRIM,TRANSF)
|
|
RETURN
|
|
10000 FORMAT (' Lattice Type (P) ? ',$)
|
|
11000 FORMAT (A1)
|
|
12000 FORMAT (' Input Cell:',F8.3,5F10.3/12X,'Lattice Type ',A)
|
|
END
|