126 lines
4.3 KiB
Fortran
126 lines
4.3 KiB
Fortran
C-----------------------------------------------------------------------
|
|
C Space group routine printing
|
|
C-----------------------------------------------------------------------
|
|
SUBROUTINE SGPRNT (SPG,JRT,LAUENO,NAXIS,NCENT,LCENT,NSYM,NPOL,CEN,
|
|
$ NCV,LPT)
|
|
CHARACTER COUT*132
|
|
COMMON /IOUASC/ COUT(20)
|
|
DIMENSION SPG(10),JRT(3,4,25),CEN(3,4),NCVT(7),CENV(3,6),NSYS(14)
|
|
CHARACTER*3 POLAR(8)
|
|
CHARACTER*4 LTYP(3,7),SYST(3,8),LAUE(2,14)
|
|
CHARACTER*1 NAX(3),NC(2)
|
|
CHARACTER CHKL(3)*2,CTEM*4,OUTL(3)*20
|
|
DATA CHKL/'+h','+k','+l'/
|
|
DATA LTYP/' Pr','imit','ive ',
|
|
$ ' A-C','ente','red ',' B-C','ente','red ',
|
|
$ ' C-C','ente','red ',' I-C','ente','red ',
|
|
$ ' F-C','ente','red ',' R-C','ente','red '/
|
|
DATA SYST/'Tric','lini','c ','Mono','clin','ic ',
|
|
$ 'Orth','orho','mbic','Tetr','agon','al ',
|
|
$ 'Rhom','bohe','dral','Trig','onal',' ',
|
|
$ 'Hexa','gona','l ','Cubi','c ',' '/
|
|
DATA LAUE/'1bar',' ','2/m ',' ','mmm ',' ','4/m ',' ',
|
|
$ '4/mm','m ','3bar',' ','3bar',' M ','3bar',' ',
|
|
$ '3bar','m 1 ','3bar','1 m ','6/m ',' ','6/mm','m ',
|
|
$ 'M 3 ',' ','M 3 ','M '/
|
|
DATA POLAR/'x','y','x y','z','x z','y z','xyz','111'/
|
|
DATA NAX/'a','b','c'/
|
|
DATA NSYS/1,2,3,4,4,5,5,6,6,6,7,7,8,8/
|
|
DATA NC/'A',' '/
|
|
DATA NCVT/1,2,2,2,2,4,3/
|
|
DATA CENV/ 0,0.5,0.5, 0.5,0,0.5, 0.5,0.5,0, 0.5,0.5,0.5,
|
|
$ 0.3333333,0.6666667,0.6666667,0.6666667,0.3333333,0.3333333/
|
|
NCV = NCVT(LCENT)
|
|
MULT = NCV*NSYM*(NCENT + 1)
|
|
LSYS = NSYS(LAUENO)
|
|
DO 90 I = 1,3
|
|
CEN(I,1) = 0.0
|
|
OUTL(I) = ' '
|
|
90 CONTINUE
|
|
IF (NCV .LE. 1) GO TO 110
|
|
J = LCENT - 1
|
|
IF (LCENT .EQ. 6) J = 1
|
|
IF (LCENT .EQ. 7) J = 5
|
|
DO 100 I = 2,NCV
|
|
CEN(1,I) = CENV(1,J)
|
|
CEN(2,I) = CENV(2,J)
|
|
CEN(3,I) = CENV(3,J)
|
|
J = J + 1
|
|
100 CONTINUE
|
|
110 CONTINUE
|
|
NPX = 1
|
|
NPY = 2
|
|
NPZ = 4
|
|
NPXYZ = 0
|
|
NPYXZ = 1
|
|
DO 120 I = 1,NSYM
|
|
IF (JRT(1,1,I) .LE. 0) NPX = 0
|
|
IF (JRT(2,2,I) .LE. 0) NPY = 0
|
|
IF (JRT(3,3,I) .LE. 0) NPZ = 0
|
|
IF (JRT(1,3,I) .GT. 0) NPXYZ = 8
|
|
IF (JRT(1,3,I) .LT. 0) NPYXZ = 0
|
|
120 CONTINUE
|
|
NPOL = (NPX + NPY + NPZ + NPXYZ*NPYXZ)*(1 - NCENT)
|
|
IF (LPT .LT. 0) RETURN
|
|
WRITE (COUT,10000) SPG,NC(NCENT + 1),
|
|
$ LTYP(1,LCENT),LTYP(2,LCENT),LTYP(3,LCENT),
|
|
$ SYST(1,LSYS),SYST(2,LSYS),SYST(3,LSYS),
|
|
$ LAUE(1,LAUENO),LAUE(2,LAUENO),MULT
|
|
CALL GWRITE (LPT,' ')
|
|
IF (NAXIS .GT. 0) THEN
|
|
WRITE (COUT,11000) NAX(NAXIS)
|
|
CALL GWRITE (LPT,' ')
|
|
ENDIF
|
|
IF (NPOL .GT. 0) THEN
|
|
WRITE (COUT,12000) POLAR(NPOL)
|
|
CALL GWRITE (LPT,' ')
|
|
ENDIF
|
|
WRITE (COUT,13000)
|
|
CALL GWRITE (LPT,' ')
|
|
KI = 0
|
|
KL = 2
|
|
IF (LAUENO .GT. 5) KL = 3
|
|
DO 140 I = 1,NSYM
|
|
KI = KI + 1
|
|
DO 135 J = 1,3
|
|
L = 1
|
|
CTEM = ' '
|
|
DO 130 K = 1,3
|
|
IF (JRT(K,J,I) .NE. 0) THEN
|
|
CTEM(L:L+1) = CHKL(K)
|
|
IF (JRT(K,J,I) .EQ. -1) CTEM(L:L) = '-'
|
|
L = L + 2
|
|
ENDIF
|
|
130 CONTINUE
|
|
IF (CTEM(1:1) .EQ. '+') CTEM(1:1) = ' '
|
|
MC = L - 1
|
|
M = 1 + 6*(J - 1) + 4 - MC
|
|
OUTL(KI)(M:M+MC-1) = CTEM(1:MC)
|
|
135 CONTINUE
|
|
IF (KI .EQ. KL) THEN
|
|
WRITE (COUT,15000) (OUTL(K),K = 1,KL)
|
|
CALL GWRITE (LPT,' ')
|
|
KI = 0
|
|
DO 137 K = 1,3
|
|
OUTL(K) = ' '
|
|
137 CONTINUE
|
|
ENDIF
|
|
140 CONTINUE
|
|
IF (LAUENO .EQ. 1) THEN
|
|
WRITE (COUT,15000) (OUTL(I),I = 1,3)
|
|
CALL GWRITE (LPT,' ')
|
|
ENDIF
|
|
WRITE (COUT,14000)
|
|
CALL GWRITE (LPT,' ')
|
|
RETURN
|
|
10000 FORMAT (/' Space Group ',10A1/
|
|
$ ' The Space Group is ',A1,'Centric',6A4,
|
|
$ ' Laue Symmetry ',2A4/
|
|
$ ' Multiplicity of a General Site is',I4)
|
|
11000 FORMAT (' The Unique Axis is ',A1)
|
|
12000 FORMAT (' The location of the origin is arbitrary in ',A3)
|
|
13000 FORMAT (/' Space-group Equivalent Reflections are:')
|
|
14000 FORMAT (' Friedel Reflections are the -,-,- of these.'/'%')
|
|
15000 FORMAT (5X,3(A20,3X))
|
|
END
|