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
|
||
|