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