C....*...1.........2.........3.........4.........5.........6.........7.*
C     AFC      5/30/74
C
C     PURPOSE
C     CONSTRUCT A FORMAT CODE FOR PRINTING REAL DATA.
C
C     USAGE
C     CALL AFC(A,FC,IW,IS)
C
C     ARGUMENTS
C     A  - VARIABLE OR CONSTANT TO BE PRINTED
C          REAL*8
C     FC - FORMAT CODE STORED WITH ONE LEADING AND ONE TRAILING BLANK
C          IN AN 8 BYTE CHARACTER STRING.
C          CHARACTER*8
C     IW - NUMBER OF CHARACTERS THE PRINTED DATA IS TO OCCUPY.  MUST
C          BE LESS THAN 99.
C          INTEGER*4
C     IS - NUMBER OF SIGNIFICANT DIGITS DESIRED
C          INTEGER*4
C
C     REMARK
C     AFC WILL ATTEMPT TO RETURN ' FIW.ID ' WHERE ID IS ADJUSTED TO
C     PRINT A WITH IS SIGNIFICANT DIGITS.  FAILING THIS, AFC WILL
C     RETURN ' EIW.IS ' IF VALID OR ' E 7.0  ' IF INVALID.
C     IF A=0.E0 OR A=0.D0 AFC WILL RETURN ' FIW.00 '.
C
C
      SUBROUTINE AFC(A,FC,IW,IS)
      IMPLICIT REAL*8 (A-H,O-Z)
      save
      CHARACTER*1 ZFC(8),DIGIT(10),RFC(8),E
      CHARACTER*8 FC,CFC
      EQUIVALENCE (RFC(1),CFC)
      DATA ZFC   /' ','F',' ',' ','.',' ',' ',' '/
      DATA DIGIT /'0','1','2','3','4','5','6','7','8','9'/
      DATA E     /'E'/
      DO 5 I=1,8
5     RFC(I)=ZFC(I)
      IF(IW.GT.99) GO TO 20
      IF(IW.LE.0)  GO TO 20
      ID=0
      IF(A.EQ.0.E0) GO TO 7
      AL=DLOG10(ABS(A))
      IC=AL
      ISD=IS
      ID=ISD-IC-1
      IF(AL.LT.0.E0) ID=ID+1
      IF(ID.LT.0) ID=0
      IF(ID.GT.IW-2) GO TO 10
      IF((IC.GT.0).AND.(IW-2-ID.LT.IC)) GO TO 10
7     CONTINUE
      IWTENS=IW/10
      IWUNIT=IW-IWTENS*10
      IDTENS=ID/10
      IDUNIT=ID-IDTENS*10
      RFC(3)=DIGIT(IWTENS+1)
      RFC(4)=DIGIT(IWUNIT+1)
      RFC(6)=DIGIT(IDTENS+1)
      RFC(7)=DIGIT(IDUNIT+1)
      FC=CFC
      RETURN
C     SPECIEFIED F FORMAT CODE CANNOT BE CONSTRUCTED. E FORMAT CODE IS
C     SUBSTITUTED.
10    IF(IW-ISD.LT.7) GO TO 20
      ID=ISD
      IWTENS=IW/10
      IWUNIT=IW-IWTENS*10
      IDTENS=ID/10
      IDUNIT=ID-IDTENS*10
      RFC(2)=E
      RFC(3)=DIGIT(IWTENS+1)
      RFC(4)=DIGIT(IWUNIT+1)
      RFC(6)=DIGIT(IDTENS+1)
      RFC(7)=DIGIT(IDUNIT+1)
      FC=CFC
      RETURN
C     NEITHER AN F NOR AN E FORMAT CODE CAN BE CONSTRUCTED
20    IF((IW.LE.99).AND.(IW.GE.7)) GO TO 30
      RFC(2)=E
      RFC(4)=DIGIT(7+1)
      RFC(6)=DIGIT(0+1)
      FC=CFC
      RETURN
30    ID=IW-7
      IWTENS=IW/10
      IWUNIT=IW-IWTENS*10
      IDTENS=ID/10
      IDUNIT=ID-IDTENS*10
      RFC(2)=E
      RFC(3)=DIGIT(IWTENS+1)
      RFC(4)=DIGIT(IWUNIT+1)
      RFC(6)=DIGIT(IDTENS+1)
      RFC(7)=DIGIT(IDUNIT+1)
      FC=CFC
      RETURN
      END