PROGRAM DAT2POP
C  -----------------------------------------------------------------
C
C    Conversion from BINGSS ab.dat file to a GES POP file
C    Copyright 1994 Bo Sundman, S Fries and H L Lukas
C
C    This program is free software: you can redistribute it and/or modify
C    it under the terms of the GNU General Public License as published by
C    the Free Software Foundation version 3 of the License
C
C    This program is distributed in the hope that it will be useful,
C    but WITHOUT ANY WARRANTY; without even the implied warranty of
C    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
C    GNU General Public License for more details.
C
C    You should have received a copy of the GNU General Public License
C    along with this program.  If not, see <http://www.gnu.org/licenses/>.
C
C    Contact through http://www.computational-thermodynamics.mpg.de
C
C-----------------------------------------------------------------------
C...program version
      PARAMETER (PROVER=1.3)
      INTEGER ITU(4),NTOT(3),I,J,L03,N03,NTYP,NPHA,ITU1,ITU2,ITU3,ITU4,
     &NTYPOLD,NPHAOLD,STATTTAB 
      REAL*8 W,DW,T,DT,TT,DTT,X(6)
      CHARACTER LABEL*2,ZEILE*72,CHR*1,LABELOLD*2
      CHARACTER*40 SYS, NAMED, NAMEP, NAMEC
      CHARACTER*4 DAT,POP
      CHARACTER PHASE(30)*12,EL1*2,EL2*2,FUNA*6,FUNB*6,FUNC*6
      CHARACTER LINE1*72,CH3*3,CH2*2,FUNT*6,LABAR(50)*2
      CHARACTER*12 EL1HR,EL2HR,EL2MUR,HMPH
      DIMENSION LPH(30),WLAB(50)
      LOGICAL FUNCPM,NOFLUSH,FUNPH1,FUNPH2,FUNDH,FUNDS,FUNDLT,FUNTRF
      LOGICAL LINE2,FUNSSS
C
    1 FORMAT ('  Enter system name (like cumg): ')
    2 FORMAT (24I3)
    3 FORMAT ('$',A2)
    4 FORMAT (4I2)
    5 FORMAT (2I2)
    6 FORMAT (F9.1,F7.1)
    7 FORMAT (F7.2,F5.2)
    8 FORMAT (A,1X,A,1X,F8.3,1X,F10.8,1X,F10.8,1X,F10.8)
    9 FORMAT (A,1X,A,1X,F8.3,1X,F4.1,1X,F10.8,1X,F10.8)
   11 FORMAT ('$',A72)
   10 FORMAT (A2,6I2,F9.1,F7.1,2(F7.2,F5.2),8P,2F9.0)
   20 FORMAT (T2,8P,4F9.0)
   30 FORMAT (A2,6I2)
   40 FORMAT (A72)
   50 FORMAT (A1)
   60 FORMAT (8X,'Last value found in file 03 (*.dat) = No.',I5/8X,
     &A14,F9.0,F7.0,2(F7.1,F5.1),2F9.6/9X,4F9.6)
 2500 FORMAT ('$',/,'$---------------------------NOT IMPLEMENTED YET')
 2600 FORMAT ('$===================================================='/
     &        '$----NTYP=',I2,', NPHA=',I2,', TABLE=',I6/
     &        '$====================================================')
C
  270 FORMAT ('ENTER_SYMBOL CONSTANT P0=101325')
  280 FORMAT ('CREATE_NEW_EQUILIBRIUM @@,1')
  281 FORMAT ('CREATE_NEW_EQUILIBRIUM ',I4,' 1')
  290 FORMAT ('CHANGE_STATUS PHASE ',A,1X,A,1X,A,'=FIX 1')
  291 FORMAT ('CHANGE_STATUS PHASE ',A,'=FIX 1')
  292 FORMAT ('CHANGE_STATUS PHASE @3,@4=FIX 1') 
  293 FORMAT ('CHANGE_STATUS PHASE @3=FIX 1')
  294 FORMAT ('CHANGE_STATUS PHASE ',A,' ',A,'=FIX 1')
  295 FORMAT ('CHANGE_STATUS PHASE ',A,' ',A,'=ENT 1')
 298  FORMAT ('LABEL A@2')
 299  FORMAT ('LABEL A',A)
  300 FORMAT ('SET_CONDITION P=P0')
  302 FORMAT ('SET_CONDITION T=@5,P=P0')
C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  303 FORMAT ('SET_CONDITION P=P0 N=1 T=',F8.3,' X(',A,')=',F9.6)
C<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  304 FORMAT ('SET_CONDITION T=',F8.3)
  305 FORMAT ('SET_CONDITION P=P0, X(',A,')=',F9.6)
  306 FORMAT ('SET_CONDITION X(',A,')=',F9.6)
  307 FORMAT ('SET_CONDITION T=@6,P=P0')
 308  FORMAT ('SET_CONDITION P=P0,T=@8,X(',A,')=@10')
  309 FORMAT ('SET_CONDITION P=P0, X(@3,',A,')=@8')
C
  310 FORMAT ('EXPERIMENT T=',F8.3,':',1PE8.2)
  312 FORMAT ('EXPERIMENT X(@3,',A,')=@7:@8')
  316 FORMAT ('EXPERIMENT T=@5:@6')
C
  320 FORMAT ('SET_ALT_COND X(@?,',A,')=@?:@?')
C
  330 FORMAT ('TABLE_HEAD ',I7)
  332 FORMAT ('TABLE_VALUES')
  340 FORMAT ('TABLE_END')
  350 FORMAT ('$ phase    phase   temperature  xphase        dx    
     & xphase')
  360 FORMAT ('$ phase    phase    temp      error     xphase       xpha
     &se')
C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  365 FORMAT ('$   phase_1     phase_2',7X,
     &'  amount   error   temp   x_gross xphas1 xphas2')
C<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  370 FORMAT ('SAVE_WORKSPACES')
  950 FORMAT (' FILE 03 (EXPERIMENTAL VALUES) BAD IN LINE',I4,', VALUE'
     &,I4)
  960 FORMAT (' THE COMBINATION NTYP =',I3,' AND NPHA =',I3,
     &' IS NOT PROGRAMMED OR MEANINGLESS')
  970 FORMAT (' FILE 03 (EXPERIMENTAL VALUES) BAD IN LINE',I4,', VALUE'
     &,I4,' internal')
  980 FORMAT ('$-------------------------------------------------------
     &',/,'$FILE POP(PARROT) CONVERTED FROM FILE DAT(LUKAS) version ',
     &F3.1,/,
     &'$------------------------------------------------------')
  985 FORMAT ('$Instructions:',/,'$  The number of the phases should be
     &',/,'$   changed to their names. The name of the element
     &',/,'$  for which the composition is given should also be edited.'
     &,/,'$   The fields to be edited are marked with "?".'/,'$')
  990 FORMAT ('ENTER_SYMBOL CONSTANT P0=101325')   
C
      WRITE(*,717)PROVER
 717  FORMAT(/' This is a program to convert BINGSS "dat" files',
     & ' with experimental data'/' to POP files to be used in',
     & ' the parrot module of Thermo-Calc.'/
     & '          Version ',F3.1,' 981111'//' The BINGSS file',
     & ' is usually named after the system like cumg.dat for Cu-Mg,'/
     & ' the output file will have the same name but extension .POP'//
     & ' As the experimental data file can be very large parrot may',
     & ' have to'/' split them on different blocks and you will be',
     & ' asked for the'/' MAXIMUM NUMBER OF EQUILIBRIA IN EACH BLOCK'/
     & ' and the program will automatically divide the output file',
     & ' in blocks'/' separated by a flush command. If you do not',
     & ' know how many'/' blocks then give a large number,',
     & ' 1000 or so. When you compile'/' the experimental file',
     & ' into parrot you may get an overflow message'/' when you have',
     & ' exceeded the number of equilibria for a block.'/' Then you',
     & ' know the number to use.'//
     & ' You can assign an initial weight to each label'//
     & ' IMPORTANT: Note that you must have a "coe" file with the same',
     & ' name'/' as the "dat" file but with the extension ".coe"'/
     & ' in order to convert phase numbers to names etc.'/)
      FUNA='FUNCAA'
      FUNCPM=.FALSE.
      FUNDLT=.FALSE.
      FUNTRF=.FALSE.
      FUNPH1=.FALSE.
      FUNPH2=.FALSE.
      FUNDH=.FALSE.
      FUNDS=.FALSE.
      NOFLUSH=.FALSE.
      TEMPH=0.0D0
      TEMPMU=0.0D0
      WRITE(*,1)
      READ(*,'(A)') SYS
      DAT='.dat'
      POP='.POP'
      NAMED = SYS
      I=INDEX(NAMED,'.')
      IF(I.LE.0) THEN
         I=LENS(NAMED)+1
      ENDIF
C      DO 65 I=1,8
C      IF (NAMED(I:I) .EQ. ' ') GOTO 80
C   65 CONTINUE
   80 NAMED(I:) = DAT
      NAMEP = SYS
      NAMEP(I:) = POP
      NAMEC = SYS
      NAMEC(I:) = '.coe'
C...first read phases and components from SYS.coe
C      write(*,*)named,namep,namec
      WRITE(*,*)'Reading phase names from ',NAMEC
      OPEN(21,FILE=NAMEC,ACCESS='SEQUENTIAL',STATUS='OLD')
      CALL RDATF(LINE1)
      READ(LINE1,9903)NP,NT,EL1,EL2,NPREF1,NPREF2,NTU,IMAT,TMAX
      IF(NTU.GT.9) THEN
         CALL RDATF(LINE1)
      ENDIF
      NRTOT=NPREF1+NPREF2
      DO 84 J=1,NRTOT
         CALL RDATF(LINE1)
         READ(LINE1,9904)NBR
         DO 83 I=1,NBR
	    CALL RDATF(LINE1)
            IF(NTU.LE.4) GOTO 83
	    CALL RDATF(LINE1)
            IF(NTU.LE.9) GOTO 83
	    CALL RDATF(LINE1)
 83      CONTINUE
 84   CONTINUE
      NPH=0
 85   NPH=NPH+1
      CALL RDATF(LINE1)
      PHASE(NPH)=' '
      READ(LINE1,9906)NRL,PHASE(NPH),NMAG
      IF(NRL.EQ.0) GOTO 89
      CALL CHKPHN(PHASE(NPH))
      LPH(NPH)=LENS(PHASE(NPH))
      IF(NPH.GE.NP) GOTO 89
      NNN=NRL+NMAG
      DO 87 I=1,NNN
         CALL RDATF(LINE1)
87    CONTINUE
      GOTO 85
 9903 FORMAT(2I3,1X,2A2,4I3,F8.2)
 9904 FORMAT(I3)
 9906 FORMAT(I3,A12,14X,I3)
C
 89   CLOSE(21)
      NPH=NPH-1
      NPHX=NPH+2
      WRITE(*,*)'Number of equilibria in each block (max 1000)'
      READ(*,*)IFLUSH
C      WRITE(*,*)'Element 1: ',EL1,' Element 2: ',EL2
C      WRITE(*,*)NPH,(PHASE(I),I=1,NPH)
      OPEN(UNIT=03,FILE=NAMED,ACCESS='SEQUENTIAL',STATUS='OLD')
      OPEN(UNIT=13,FILE=NAMEP,ACCESS='SEQUENTIAL',STATUS='UNKNOWN')
      I=INDEX(NAMEP,'.')
      NAMEC(I:)='.exp '
      OPEN(UNIT=23,FILE=NAMEC,ACCESS='SEQUENTIAL',STATUS='UNKNOWN')
      WRITE(23,7714)NAMED(1:I)
 7714 FORMAT('$ Experimental data file output of ',A/
     &       '$'/'PROLOG 1'/'XSCALE 0 1'/'YSCALE 500 2500'/
     &       'XTEXT MOLE FRACTION'/'YTEXT T (K)'/
     &       '$'/'PROLOG 2'/'XSCALE 0 1'/'YSCALE -1E5 0'/
     &       'XTEXT MOLE FRACTION'/'YTEXT ENTHALPY (J)'/
     &       '$'/'PROLOG 3'/'XSCALE 0 1'/'YSCALE -1E5 0'/
     &       'XTEXT MOLE FRACTION'/'YTEXT CHEMICAL POTENTIAL (J)')
      JSYMB1=0
      JSYMB2=0
      JSYMB3=0
      YPOS1=1.0
      YPOS2=1.0
      YPOS3=1.0
      KSYMB=0
C...label with weights
      NLABAR=0
      WRITE(*,7715)
 7715 FORMAT(' Give a label for equilibria with weight different from',
     &       ' unity.'/' Finish with an empty line.')
 7716 WRITE(*,*)'Label'
      READ(*,7717)LABEL
 7717 FORMAT(A)
      IF(LABEL.NE.'  ') THEN
         NLABAR=NLABAR+1
         LABAR(NLABAR)=LABEL
         WRITE(*,*)'Weight for this label'
         READ(*,*)WLAB(NLABAR)
         GOTO 7716
      ENDIF
C
      WRITE(*,7718)NAMEC(1:I+5)
 7718 FORMAT(/' This program will automatically create a file ',A/
     & ' for plotting the experimental data. The data are divided',
     & ' into 3 datasets.'/' Dataset 1 is most phase diagram data,'/
     & ' Dataset 2 is enthalpy data and'/' Dataset 3 is chemical',
     & ' potentials.'/)
C...some initializations
      ITABNO=1
      ISTTAB=0
C-----------------------------------------------------------------------
C---- Formatted input of file 03
      ITU1=0
      LLL=0
      L03=0
      WRITE (13,980)PROVER
      WRITE (13,985)
      WRITE (13,990)
      NOT=0
  100 READ (03,40,END=9999,ERR=900) ZEILE
      READ (ZEILE,50,ERR=920) CHR
      IF (CHR.EQ.'$') THEN
         WRITE(13,1716)ZEILE
1716     FORMAT(A)
         GOTO 100
      ENDIF
      READ (ZEILE,10,ERR=920)
     &LABEL,(ITU(I),I=1,4),NTYP,NPHA,W,DW,T,DT,TT,DTT,X(1),X(2)
      IF(LABEL(1:1).EQ.' ') THEN
         LABEL(1:1)=LABEL(2:2)
         LABEL(2:2)=' '
      ENDIF
      LINE2=.FALSE.
      IF (NTYP.EQ.0.AND.NPHA.EQ.0) GOTO 9999
C...cases without second line jump to 140
      IF( NPHA.EQ.1) GOTO 140
      IF( (NTYP.EQ.4 .OR. NTYP.EQ.3 .OR. NTYP.EQ.9 .OR. NTYP.EQ.10)
     &      .AND. NPHA.EQ.2) GOTO 140
C...read second line
      LINE2=.TRUE.
  130 READ (03,20,END=900,ERR=900) (X(I),I=3,6)
 131  CONTINUE
C
C...Check if end_table
140   CONTINUE
      L03=L03+1
      IF(MOD(L03,100).EQ.0) WRITE(*,*)'line number ',L03
      IF(NTYP.NE.NTYPOLD .OR. LABEL.NE.LABELOLD) THEN
         IF(ISTTAB.NE.0) WRITE(13,*)'TABLE_END'
         ISTTAB=0
         TTOLD=0.0D0
         ITU2OLD=0
         X1OLD=5.0
      ENDIF
145   CONTINUE
C      IF(L03.GE.IFLUSH .AND. .NOT.NOFLUSH) THEN
      IF(ITABNO-LLL.GE.IFLUSH .AND. .NOT.NOFLUSH) THEN
         IF(ISTTAB.EQ.0) THEN
            WRITE(13,142)
142         FORMAT(' FLUSH'/' ENTER CONSTANT P0=1E5')
         ELSE
            WRITE(13,143)
143         FORMAT(' TABLE_END'/'FLUSH'/' ENTER CONSTANT P0=1E5')
            ISTTAB=0
         ENDIF
C         LLL=LLL+L03
         LLL=ITABNO
         WRITE(*,*)'Flushed at equilibrium ',ITABNO
         L03=0
         FUNCPM=.FALSE.
         FUNPH1=.FALSE.
         FUNPH2=.FALSE.
         FUNTRF=.FALSE.
         FUNDLT=.FALSE.
         FUNDH=.FALSE.
         FUNDS=.FALSE.
	 NTYPOLD=0
      ENDIF
      IF(ISTTAB.NE.0) NOFLUSH=.FALSE.
      NTYPOLD=NTYP
      ASSW=-10.0D0
      DO 7817 I=1,NLABAR
         IF(LABEL.EQ.LABAR(I)) ASSW=ABS(WLAB(I))
 7817 CONTINUE
      LABELOLD=LABEL
      WRITE(13,1717)ZEILE
1717  FORMAT('$',A)
      IF(LINE2) WRITE(13,132)(X(I),I=3,6)
  132 FORMAT ('$ ',8P,4F10.0)
C
C...switch to handle different types
      CONTINUE
      IF (NTYP.EQ.1 .OR. NTYP.EQ.2) GOTO 6000
C.....NPHOLD must be reset if not type 1 or 2
      NPHOLD=0
      IF (NTYP.EQ.3 .OR. NTYP.EQ.4 .OR. 
     &   (NTYP.GE.9 .AND. NTYP.LE.12)) THEN
C........ENTALPY OR ENTROPY OF FORMATION OR MIXING
	 IF(NPHA.EQ.1 .AND. (NTYP.EQ.3 .OR. NTYP.EQ.9)) GOTO 4000
	 IF(NPHA.EQ.1) THEN
	    WRITE(*,*)'CAN NOT HANDLE NPHA=1 AND NTYP=4,10,11 OR 12'
	    NOT=NOT+1
	    GOTO 100
	 ENDIF
C........INITIAL AND FINAL COMPOSITION THE SAME
         IF(NPHA.EQ.2 .AND. (NTYP.EQ.3 .OR. NTYP.EQ.9)) GOTO 4700
         IF(NPHA.EQ.2) GOTO 5000
         IF(X(3).LT.1D-8 .AND. ABS(X(5)-1.0D0).LT.1D-8) GOTO 4000
         IF(NTYP.EQ.4  .OR. NTYP.EQ.10) GOTO 4500
         IF(NTYP.EQ.11 .OR. NTYP.EQ.12) GOTO 4500
C........PARTIAL ENTHALPY OR ENTROPY
C         write(*,*)X(1),x(5),itu(1),itu(2)
         IF(X(1).LT.0.05 .AND. ABS(X(5)-1.0).LT.1.D-8 .AND.
     &      ITU(1).EQ.ITU(2)) GOTO 4100
	 IF(X(1).LT.0.05 .AND. X(5).LT.1.0D-8 .AND.
     &      ITU(1).EQ.ITU(2)) GOTO 4200
C........WE HAVE TO CALCULATE 3 DIFFERENT EQUILIBRIA
         GOTO 4500
      ENDIF
      IF(NTYP.EQ.5) GOTO 3000
C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
C     IF(NTYP.EQ.7 .OR. NTYP.EQ.13) THEN
C        WRITE(*,*)'CANNOT HANDLE NTYP=7 and 13'
CXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
      IF(NTYP.EQ.7) GOTO 2800
      IF(NTYP.EQ.13) THEN
         WRITE(*,*)'CANNOT HANDLE NTYP=13'
C<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
         NOT=NOT+1
         GOTO 100
      ENDIF
C
      IF (NTYP.EQ.6.OR.NTYP.EQ.8) THEN
         IF(NPHA.EQ.3) GOTO 1000
C.........congruent transformation
	 IF(ABS(X(3)-X(1)).LT.1D-8) GOTO 1500
         IF(NPHA.EQ.2) GOTO 2000
      ENDIF
C
      NOT=NOT+1
      write(*,9900)NTYP,NPHA
 9900 FORMAT(' Cannot handle NTYP=',I2,' and NPHA=',I2)
      DO 141 I=3,6
 141  X(I)=0.
      WRITE (13,11) ZEILE
      GOTO 100
  810 FORMAT (' File 03 (*.dat) missing or empty')
C-----------------------------------------------------------------------
C     Error messages
  900 GOTO 9999
  920 GOTO 9999
C
C----------------------- Three phase equilibrium ------------------
1000  CONTINUE
      IF(ISTTAB.NE.0) THEN
         WRITE(13,*)'TAB_END'
         ISTTAB=0
      ENDIF
      WRITE(13,2600)NTYP,NPHA,1000
      WRITE(13,281)ITABNO
      ITABNO=ITABNO+1
      IF(ITU(1).EQ.ITU(2)) THEN
         PHASE(NPHX)=PHASE(ITU(2))
         KK=LENS(PHASE(NPHX))
         IF(KK.EQ.0 .OR. KK.EQ.LEN(PHASE(NPHX))) KK=LEN(PHASE(NPHX))-1
         PHASE(NPHX)(KK:)='#2'
         ITU(2)=NPHX
      ELSEIF(ITU(1).EQ.ITU(3) .OR. ITU(2).EQ.ITU(3)) THEN
         PHASE(NPHX)=PHASE(ITU(3))
         KK=LENS(PHASE(NPHX))
         IF(KK.EQ.0 .OR. KK.EQ.LEN(PHASE(NPHX))) KK=LEN(PHASE(NPHX))-1
         PHASE(NPHX)(KK:)='#2'
         ITU(3)=NPHX
      ENDIF
      WRITE(13,290)PHASE(ITU(1)),PHASE(ITU(2)),PHASE(ITU(3))
      WRITE(13,300)
      WRITE(13,310) T,DT
1013  FORMAT(' SET_ALL_START_VALUES ',F9.2,' Y')
      WRITE(13,1014)PHASE(ITU(1))(1:LENS(PHASE(ITU(1)))),
     &                           EL2(1:LENS(EL2)),X(1),X(2),
     &              PHASE(ITU(2))(1:LENS(PHASE(ITU(2)))),
     &                           EL2(1:LENS(EL2)),X(3),X(4),
     &              PHASE(ITU(3))(1:LENS(PHASE(ITU(3)))),
     &                           EL2(1:LENS(EL2)),X(5),X(6)
 1014 FORMAT(' SET_ALT_COND X(',A,',',A,')=',F9.6,':',F8.6,
     &                   ' X(',A,',',A,')=',F9.6,':',F8.6/
     &       ' SET_ALT_COND X(',A,',',A,')=',F9.6,':',F8.6)
      WRITE (13,1013)T
      WRITE(13,299)LABEL
      IF(ASSW.GT.-1.0D0) WRITE(13,*)'SET_WEIGHT ',ASSW,' ,, '
      GOTO 100
C----------------------------------------------------------------
C.....CONGRUENT TRANSFORMNATION
 1500 CONTINUE
      IF(ISTTAB.NE.0) THEN
         WRITE(13,*)'TAB_END'
         ISTTAB=0
      ENDIF
      WRITE (13,2600)NTYP,NPHA,1500
      WRITE (13,281)ITABNO
      ITABNO=ITABNO+1
      WRITE (13,294)PHASE(ITU(1)),PHASE(ITU(2))
      WRITE (13,300)
      WRITE(13,1510)PHASE(ITU(1))(1:LPH(ITU(1))),EL2(1:LENS(EL2)),
     &              PHASE(ITU(2))(1:LPH(ITU(2))),EL2(1:LENS(EL2))
1510  FORMAT(' SET_CONDITION X(',A,',',A,')-X(',A,',',A,')=0')
      WRITE (13,310)T,DT
      WRITE(13,1015)PHASE(ITU(1))(1:LENS(PHASE(ITU(1)))),
     &                           EL2(1:LENS(EL2)),X(1),X(2)
 1015 FORMAT(' SET_ALT_COND X(',A,',',A,')=',F9.6,':',F8.6)
      WRITE (13,1013)T
      WRITE(13,299)LABEL
      IF(ASSW.GT.-1.0D0) WRITE(13,*)'SET_WEIGHT ',ASSW,' ,, '
      GOTO 100
C------------------------Two phase field NTYP=6 or 8
 2000 CONTINUE
      IF(ISTTAB.NE.0) GOTO 2030
      ISTTAB=2000
      IF(KSYMB.NE.1) THEN
         WRITE(23,4400)1
 4400    FORMAT('BLOCKEND'/'$'/'DATASET ',I1)
      ELSE
         WRITE(23,4401)
 4401    FORMAT('BLOCKEND'/'$')
      ENDIF
      KSYMB=1
      JSYMB1=JSYMB1+1
      IF(JSYMB1.GT.20) THEN
         WRITE(*,*)'Too many different symbols, reusing same'
         JSYMB1=0
      ENDIF
      IF(JSYMB1.GT.9) THEN
         WRITE(23,4402)YPOS1,JSYMB1,LABEL,T,JSYMB1
 4402    FORMAT('CLIP OFF'/' 1.1 ',F5.2,' MANS',I2,'''',A,2X,F9.2/
     &          'CLIP ON'/'BLOCK X=C1; Y=C2; GOC=C3,WAMS',I2)
      ELSE
         WRITE(23,4403)YPOS1,JSYMB1,LABEL,T,JSYMB1
 4403    FORMAT('CLIP OFF'/' 1.1 ',F5.2,'  MANS',I1,'''',A,2X,F9.2/
     &          'CLIP ON'/'BLOCK X=C1; Y=C2; GOC=C3,WAMS',I1)
      ENDIF
      YPOS1=YPOS1-0.05
      WRITE (13,2600)NTYP,NPHA,2000
      WRITE (13,330)ITABNO
      WRITE (13,280)
      WRITE (13,292)
      IF(NTYP.EQ.8) THEN
         WRITE(13,3090)EL2
3090     FORMAT ('SET_CONDITION P=P0, X(@3,',A,')=@7')
         WRITE (13,316)
         WRITE (13,1013)T
      ELSE
         WRITE (13,302)
         WRITE (13,312)EL2
         WRITE (13,*)'SET_ALL_START_VALUES Y'
      ENDIF
      WRITE(13,1016)EL2(1:LENS(EL2))
 1016 FORMAT(' SET_ALT_COND X(@4,',A,')=@9:@8')
      IF(ASSW.GT.-1.0D0) WRITE(13,*)'SET_WEIGHT ',ASSW,' ,, '
      WRITE(13,298)
      WRITE (13,332)
      WRITE (13,350)
 2030 IF(ITU(1).EQ.ITU(2)) THEN
         PHASE(NPHX)=PHASE(ITU(2))
         KK=LENS(PHASE(NPHX))
         IF(KK.EQ.0 .OR. KK.EQ.LEN(PHASE(NPHX))) KK=LEN(PHASE(NPHX))-1
         PHASE(NPHX)(KK:)='#2'
         ITU(2)=NPHX
      ENDIF
      WRITE (13,2031)LABEL,PHASE(ITU(1)),PHASE(ITU(2)),
     &               T,DT,X(1),X(2),X(3)
 2031 FORMAT('1 ',A,2(1X,A),1X,F9.2,1X,F7.1,3F9.6)
      WRITE(23,4405)X(1),T
 4405 FORMAT(1X,F9.6,5X,F9.2)
      ITABNO=ITABNO+1
      GOTO 100
C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
C------------------------ Phase amount NTYP=7
 2800 CONTINUE
      IF(ISTTAB.NE.0) WRITE(13,*)'TAB_END'
      ISTTAB=2800
      WRITE (13,2600)NTYP,NPHA,2800
      WRITE (13,281)ITABNO
      ITABNO=ITABNO+1
      WRITE (13,295)PHASE(ITU(1)),PHASE(ITU(2))
      WRITE (13,303)T,EL2(1:LENS(EL2)),X(1)
      WRITE (13,*)'SET_ALL_START_VALUES Y'
      IF(ITU(1).EQ.ITU(2)) THEN
         PHASE(NPHX)=PHASE(ITU(2))
         KK=LENS(PHASE(NPHX))
         IF(KK.EQ.0 .OR. KK.EQ.LEN(PHASE(NPHX))) KK=LEN(PHASE(NPHX))-1
         PHASE(NPHX)(KK:)='#2'
         ITU(2)=NPHX
      ENDIF
      WRITE (13,2821)FUNA,PHASE(ITU(2))(1:LPH(ITU(2))),EL2(1:LENS(EL2)),
     &  X(1),PHASE(ITU(2))(1:LPH(ITU(2))),EL2(1:LENS(EL2)),
     &  PHASE(ITU(1))(1:LPH(ITU(1))),EL2(1:LENS(EL2))
C23456789.123456789.123456789.123456789.123456789.123456789.123456789.12
 2821 FORMAT ('ENTER FUNCTION ',A,'='/
     &'(X(',A,',',A,')-',F9.6,')/'/'(X(',A,',',A,')-X(',A,',',A,'));')
      WRITE (13,2822) FUNA,W,DW
 2822 FORMAT (' EXPERIMENT ',A,'= ',F9.6,':',F6.4)
C added line below and changed continuation line of format above 
      CALL FNIC(FUNA)
      IF(ASSW.GT.-1.0D0) WRITE(13,*)'SET_WEIGHT ',ASSW,' ,, '
C 2830 CONTINUE
C      WRITE (13,2831)LABEL,PHASE(ITU(1)),PHASE(ITU(2)),
C     &          W,DW,T,X(1),X(3),X(5)
C 2831 FORMAT (1X,A2,1X,A12,1X,A12,1X,F9.6,F7.4,F8.2,F9.6,2F7.4)
C      ITABNO=ITABNO+1
      GOTO 100
C<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
C---------------- type 5, 2 equilibria
 3000 CONTINUE
      IF(ISTTAB.NE.0) WRITE(13,*)'TAB_END'
      ISTTAB=0
      WRITE (13,2600)NTYP,NPHA,3000
      WRITE (13,281)ITABNO
      ITABNO=ITABNO+1
      IF(NPHA.EQ.3) THEN
         WRITE(13,291)PHASE(ITU(1))
         WRITE(13,305)EL2,X(1)
         WRITE(13,3009)FUNA
3009     FORMAT(' ENTER VARIABLE ',A,'=HM;')
         KPHA=ITU(2)
      ELSE
         WRITE(13,294)PHASE(ITU(1)),PHASE(ITU(2))
         WRITE(13,300)
         WRITE(13,3010)FUNA,X(1),
     &                 PHASE(ITU(1))(1:LPH(ITU(1))),EL2(1:LENS(EL2)),
     &                 PHASE(ITU(2))(1:LPH(ITU(2))),EL2(1:LENS(EL2)),
     &                 PHASE(ITU(1))(1:LPH(ITU(1))),EL2(1:LENS(EL2)),
     &                 PHASE(ITU(2))(1:LPH(ITU(2))),
     &                 PHASE(ITU(2))(1:LPH(ITU(2))),EL2(1:LENS(EL2)),
     &            X(1),PHASE(ITU(2))(1:LPH(ITU(2))),EL2(1:LENS(EL2)),
     &                 PHASE(ITU(1))(1:LPH(ITU(1))),EL2(1:LENS(EL2)),
     &                 PHASE(ITU(1))(1:LPH(ITU(1)))
 3010    FORMAT('ENTER VARIABLE ',A,'=(',F9.6,'-X(',A,',',A,'))/'/
     &                    '(X(',A,',',A,')-X(',A,',',A,'))*HM(',A,')+'/
     &                    '(X(',A,',',A,')-',F9.6,')/'/
     &                    '(X(',A,',',A,')-X(',A,',',A,'))*HM(',A,');')
         KPHA=ITU(4)
      ENDIF
      WRITE(13,304)T
      FUNB=FUNA
      CALL FNIC(FUNA)
C...second equilibrium
      WRITE(13,281)ITABNO
      ITABNO=ITABNO+1
      WRITE(13,294)PHASE(KPHA),PHASE(ITU(3))
      WRITE(13,300)
      WRITE(13,304)TT
      WRITE(13,3011)FUNA,FUNB,X(1),
     &                 PHASE(KPHA)(1:LPH(KPHA)),EL2(1:LENS(EL2)),
     &                 PHASE(ITU(3))(1:LPH(ITU(3))),EL2(1:LENS(EL2)),
     &                 PHASE(KPHA)(1:LPH(KPHA)),EL2(1:LENS(EL2)),
     &                 PHASE(ITU(3))(1:LPH(ITU(3))),
     &                 PHASE(ITU(3))(1:LPH(ITU(3))),EL2(1:LENS(EL2)),
     &            X(1),PHASE(ITU(3))(1:LPH(ITU(3))),EL2(1:LENS(EL2)),
     &                 PHASE(KPHA)(1:LPH(KPHA)),EL2(1:LENS(EL2)),
     &                 PHASE(KPHA)(1:LPH(KPHA))
C23456789.123456789.123456789.123456789.123456789.123456789.123456789.123456789
 3011 FORMAT('ENTER FUNCTION ',A,'=',A,'-(',F9.6,'-X(',A,',',A,'))/'/
     &                     '(X(',A,',',A,')-X(',A,',',A,'))*HM(',A,')-'/
     &                     '(X(',A,',',A,')-',F9.6,')/'/
     &                     '(X(',A,',',A,')-X(',A,',',A,'))*HM(',A,');')
      WRITE(13,3020)FUNA,W,DW
 3020 FORMAT(' EXPERIMENT ',A,'=',F9.2,':',F6.1)
      CALL FNIC(FUNA)
      IF(ASSW.GT.-1.0D0) WRITE(13,*)'SET_WEIGHT ',ASSW,' ,, '
      GOTO 100
C-----------------Enthalpy or entropy of formation
4000  IF(ISTTAB.EQ.4000) GOTO 4030
C
      IF(KSYMB.NE.2) THEN
         WRITE(23,4400)2
      ELSE
         WRITE(23,4401)
      ENDIF
      KSYMB=2
      IF(TEMPH.EQ.0.0D0) THEN
         TEMPH=T
         HMPH=PHASE(ITU(1))
         EL1HR=PHASE(ITU(1))
         IF(ITU(2).NE.0) EL1HR=PHASE(ITU(2))
         EL2HR=PHASE(ITU(1))
         IF(ITU(3).NE.0) EL2HR=PHASE(ITU(3))
      ENDIF
      JSYMB2=JSYMB2+1
      IF(JSYMB2.GT.20) THEN
         WRITE(*,*)'Too many different symbols, reusing same'
         JSYMB2=0
      ENDIF
      IF(JSYMB2.GT.9) THEN
         WRITE(23,4402)YPOS2,JSYMB2,LABEL,T,JSYMB2
      ELSE
         WRITE(23,4403)YPOS2,JSYMB2,LABEL,T,JSYMB2
      ENDIF
      YPOS2=YPOS2-0.05
      ISTTAB=4000
      WRITE(13,2600)NTYP,NPHA,4000
      WRITE(13,330)ITABNO
      WRITE(13,280)
      WRITE(13,293)
      WRITE(13,308)EL2
      IF(NTYP.EQ.4 .OR. NTYP.EQ.10) THEN
         IT1=8
      ELSE
         IT1=7
      ENDIF
      IF(NTYP.EQ.3 .OR. NTYP.EQ.9) THEN
         IT2=7
      ELSE
         IT2=8
      ENDIF
      WRITE(13,7790)EL1,4,IT1
      WRITE(13,7790)EL2,5,IT2
7790  FORMAT(' SET_REFERENCE_STATE ',A,' @',I1,' @',I1,' 1E5')
      IF(NTYP.EQ.3 .OR. NTYP.EQ.4 .OR. NTYP.EQ.12) THEN
         WRITE(13,7791)
7791     FORMAT(' EXPERIMENT HMR=@6:@7')
      ELSE
         WRITE(13,7792)
7792     FORMAT(' EXPERIMENT SMR=@6:@7')
      ENDIF
      IF(ASSW.GT.-1.0D0) WRITE(13,*)'SET_WEIGHT ',ASSW,' ,, '
      WRITE(13,298)
      WRITE(13,332)
4030  IREF1=ITU(1)
      IREF2=ITU(1)
      IF(ITU(2).NE.0) IREF1=ITU(2)
      IF(ITU(3).NE.0) IREF2=ITU(3)
      WRITE(13,4031)LABEL,PHASE(ITU(1)),PHASE(IREF1),PHASE(IREF2),
     &              W,DW,T,TT,X(1)
4031  FORMAT('1 ',A,3(1X,A8),1X,F9.2,1X,F7.1,2(F9.2),F9.6)
      WRITE(23,4415)X(1),W
 4415 FORMAT(1X,F9.6,5X,F9.2)
      ITABNO=ITABNO+1
      GOTO 100
C-------------------- PARTIAL ENTHALPY
4100  CONTINUE
      IF(ISTTAB.NE.0) THEN
         WRITE(13,*)'TAB_END'
         ISTTAB=0
      ENDIF
      WRITE(13,2600)NTYP,NPHA,4100
C...partial enthalpy of element 2
      WRITE (13,281)ITABNO
      ITABNO=ITABNO+1
      WRITE (13,291)PHASE(ITU(2))
      WRITE(13,7765)EL1,PHASE(ITU(2))
      WRITE(13,7765)EL2,PHASE(ITU(3))
 7765 FORMAT(' SET_REFERENCE_STATE ',A,' ',A,' * 1E5')
      WRITE(13,300)
      XXX=X(3)*(1.0D0-X(1)/2)+X(5)*X(1)/2
      WRITE(13,306)EL2,XXX
      WRITE(13,304)T
      IF(.NOT.FUNPH2) THEN
         WRITE(13,8116)EL2,EL2
8116     FORMAT(' ENTER VARIABLE FUNPH2=MUR(',A,')-T*MUR(',A,').T;')
         FUNPH2=.TRUE.
      ENDIF
      WRITE(13,8117)W/X(1),DW/X(1)
 8117 FORMAT(' EXPERIMENT FUNPH2=',1PE14.7,':',1PE14.8)
      WRITE(13,299)LABEL
      IF(ASSW.GT.-1.0D0) WRITE(13,*)'SET_WEIGHT ',ASSW,' ,, '
      GOTO 100
C
C...partial enthalpy of element 1
4200  CONTINUE
      write(*,*)'Please check equilibrium ',ITABNO
C      write(*,*)X(1),x(5),itu(1),itu(2),W,DW
      IF(ISTTAB.NE.0) THEN
         WRITE(13,*)'TAB_END'
         ISTTAB=0
      ENDIF
      WRITE(13,2600)NTYP,NPHA,4200
      WRITE (13,281)ITABNO
      ITABNO=ITABNO+1
      WRITE (13,291)PHASE(ITU(2))
      WRITE(13,7765)EL1,PHASE(ITU(2))
      WRITE(13,7765)EL2,PHASE(ITU(3))
      WRITE(13,300)
      XXX=X(3)*(1.0D0-X(1)/2)+X(5)*X(1)/2
      WRITE(13,306)EL2,XXX
      WRITE(13,304)T
      IF(.NOT.FUNPH1) THEN
         WRITE(13,8118)EL1,EL1
8118     FORMAT(' ENTER VARIABLE FUNPH1=MUR(',A,')-T*MUR(',A,').T;')
         FUNPH1=.TRUE.
      ENDIF
      WRITE(13,8119)W/X(1),DW/X(1)
 8119 FORMAT(' EXPERIMENT FUNPH1=',1PE14.7,':',1PE14.8)
      WRITE(13,299)LABEL
      IF(ASSW.GT.-1.0D0) WRITE(13,*)'SET_WEIGHT ',ASSW,' ,, '
      GOTO 100
C
C...three equilibria needed
4500  CONTINUE
      IF(ISTTAB.NE.0) THEN
         WRITE(13,*)'TAB_END'
         ISTTAB=0
      ENDIF
      WRITE(13,2600)NTYP,NPHA,4500
      WRITE (13,281)ITABNO
      ITABNO=ITABNO+1
      CH2='HM'
      IF(NTYP.EQ.9 .OR. NTYP.EQ.11 .OR. NTYP.EQ.11) CH2='SM'
      WRITE (13,291)PHASE(ITU(2))
      WRITE(13,300)
      WRITE(13,306)EL2,X(3)
      IF(NTYP.EQ.3 .OR. NTYP.EQ.9 .OR. NTYP.EQ.11 .OR. NTYP.EQ.12) THEN
         WRITE(13,304)T
      ELSE
         WRITE(13,304)TT
      ENDIF
      WRITE(13,8100)CH2,1,CH2
8100  FORMAT(' ENTER VARIABLE REF',A,I1,'=',A,';')
C...SECOND EQ
      WRITE (13,281)ITABNO
      ITABNO=ITABNO+1
      WRITE (13,291)PHASE(ITU(3))
      WRITE(13,300)
      WRITE(13,306)EL2,X(5)
      IF(NTYP.EQ.3 .OR. NTYP.EQ.9) THEN
         WRITE(13,304)T
      ELSE
         WRITE(13,304)TT
      ENDIF
      WRITE(13,8100)CH2,2,CH2
C....THIRD EQ
      WRITE (13,281)ITABNO
      ITABNO=ITABNO+1
      WRITE (13,291)PHASE(ITU(1))
      WRITE(13,300)
      XXX=(1.D0-X(1))*X(3)+X(1)*X(5)
      WRITE(13,306)EL2,XXX
      WRITE(13,304)T
      IF(NTYP.EQ.9 .OR. NTYP.EQ.11 .OR. NTYP.EQ.11) THEN
         WRITE(13,8120)FUNA,CH2,X(1)-1.0,CH2,-X(1),CH2
8120     FORMAT(' ENTER FUNCTION ',A,'=',A,
     &           F8.6,'*REF',A,'1',F8.6,'*REF',A,'2;')
      ELSE
         WRITE(13,8120)FUNA,CH2,X(1)-1.0,CH2,-X(1),CH2
      ENDIF
      WRITE(13,8130)FUNA,W,DW
8130  FORMAT(' EXPERIMENT ',A,'=',1PE14.7,':',1PE14.8)
      WRITE(13,299)LABEL
      CALL FNIC(FUNA)
      IF(ASSW.GT.-1.0D0) WRITE(13,*)'SET_WEIGHT ',ASSW,' ,, '
      GOTO 100
C
C...ENTHALPY OF TRANSFORMATION
C
4700  CONTINUE
      TT=T
      GOTO 5005
C
C-------------------- ENTHALPY DIFFERENCES OR HEAT CAPACITIES
 5000 IF(ITU(1).EQ.ITU(2) .AND. (T-TT).LT.0.1*TT) GOTO 5500
      IF(ABS(TT-TTOLD).GT.1 .OR. ABS(X1OLD-X(1)).GT.1E-7 .OR.
     &   ITU2OLD.NE.ITU(2) .OR. ISTTAB.NE.5000) THEN
         WRITE(13,*)'TAB_END'
         ISTTAB=0
      ENDIF
 5005 IF(ISTTAB.EQ.5000) GOTO 5030
      ISTTAB=5000
      NOFLUSH=.TRUE.
      TTOLD=TT
      ITU2OLD=ITU(2)
      X1OLD=X(1)
C.....REFERENCE STATE
      WRITE(13,2600)NTYP,NPHA,5000
      WRITE(13,281)ITABNO
      ITABNO=ITABNO+1
      WRITE(13,291)PHASE(ITU(2))
      WRITE(13,305)EL2,X(1)
      WRITE(13,304)TT
      IF(NTYP.EQ.3 .OR. NTYP.EQ.4 .OR. NTYP.EQ.12) THEN
         WRITE(13,7728)
7728     FORMAT(' ENTER VARIABLE REFH=HM;')
         IF(.NOT.FUNDH) THEN
            WRITE(13,7730)
7730        FORMAT(' ENTER FUNCTION DIFFH=HM-REFH;')
            FUNDH=.TRUE.
         ENDIF
      ELSE
         WRITE(13,7729)
7729     FORMAT(' ENTER VARIABLE REFS=SM;')
         IF(.NOT.FUNDS) THEN
            WRITE(13,7731)
7731        FORMAT(' ENTER FUNCTION DIFFS=SM-REFS;')
            FUNDS=.TRUE.
         ENDIF
      ENDIF
C.....NOW THE TABLE
      WRITE(13,330)ITABNO
      WRITE(13,280)
      WRITE(13,293)
      WRITE(13,306)EL2,X(1)	
      WRITE(13,307)
      IF(NTYP.EQ.3 .OR. NTYP.EQ.4 .OR. NTYP.EQ.12) THEN
         WRITE(13,7740)'H'
      ELSE
         WRITE(13,7740)'S'
      ENDIF
7740  FORMAT(' EXPERIMENT DIFF',A1,'=@4:@5')
      IF(ASSW.GT.-1.0D0) WRITE(13,*)'SET_WEIGHT ',ASSW,' ,, '
      WRITE(13,298)
      WRITE(13,332)
 5030 CONTINUE
      WRITE(13,5031)LABEL,PHASE(ITU(1)),W,DW,T,X(1)
5031  FORMAT('1 ',A,1X,A,1X,F9.2,1X,F7.1,F9.2,1X,F9.6)
      ITABNO=ITABNO+1
      GOTO 100
C-------------------------------Heat capacity----------------
 5500 CONTINUE
      IF(ISTTAB.EQ.5500) GOTO 5530
      ISTTAB=5500
      IF(FUNCPM) GOTO 7751
      WRITE(13,2600)NTYP,NPHA,5500
      WRITE(13,*)'$ --- this equilibrium just to enter the variable CPM'
      WRITE(13,281)ITABNO
      ITABNO=ITABNO+1
      WRITE(13,291)PHASE(ITU(2))
      WRITE(13,305)EL2,X(1)
      WRITE(13,304)TT
         WRITE(13,7750)
7750     FORMAT(' ENTER VARIABLE CPM=HM.T;')
	 FUNCPM=.TRUE.
C.....NOW THE TABLE
 7751 WRITE(13,330)ITABNO
      WRITE(13,280)
      WRITE(13,293)
      WRITE(13,306)EL2,X(1)	
      WRITE(13,307)
      WRITE(13,7760)
7760  FORMAT(' EXPERIMENT CPM=@4:@5')
      IF(ASSW.GT.-1.0D0) WRITE(13,*)'SET_WEIGHT ',ASSW,' ,, '
      WRITE(13,298)
      WRITE(13,332)
5530  WRITE(13,5031)LABEL,PHASE(ITU(1)),W/(T-TT),DW/(T-TT),(T+TT)/2,X(1)
      ITABNO=ITABNO+1
      GOTO 100
C------------------------------Chemical potential
 6000 CONTINUE
      IF(NPHA.EQ.NPHOLD .AND. ISTTAB.EQ.6000) GOTO 6030
      IF(KSYMB.NE.3) THEN
         WRITE(23,4400)3
      ELSE
         WRITE(23,4401)
      ENDIF
      KSYMB=3
      IF(NTYP.NE.1 .AND. TEMPMU.EQ.0.0D0) THEN
         TEMPMU=T
         NPREF=ITU(1)
         IF(NPHA.EQ.2) THEN
            IF(ITU(3).NE.0) NPREF=ITU(3)
            KPHA=ITU(2)
         ELSE
            IF(ITU(2).NE.0) NPREF=ITU(2)
            KPHA=ITU(1)
         ENDIF
         EL2MUR=PHASE(NPREF)
      ENDIF
      JSYMB3=JSYMB3+1
      IF(JSYMB3.GT.20) THEN
         WRITE(*,*)'Too many different symbols, reusing same'
         JSYMB3=0
      ENDIF
      IF(JSYMB3.GT.9) THEN
         WRITE(23,4402)YPOS3,JSYMB3,LABEL,T,JSYMB3
      ELSE
         WRITE(23,4403)YPOS3,JSYMB3,LABEL,T,JSYMB3
      ENDIF
      YPOS3=YPOS3-0.05
      ISTTAB=6000
      NPHOLD=NPHA
      WRITE(13,2600)NTYP,NPHA,6000
      WRITE(13,330)ITABNO
      WRITE(13,280)
      NPREF=ITU(1)
      IF(NPHA.EQ.1) THEN
         WRITE(13,293)
         WRITE(13,7764)EL2
 7764    FORMAT('SET_CONDITION X(@3,',A,')=@9')
      ELSE
         WRITE(13,292)
         IF(ITU(3).NE.0) NPREF=ITU(3)
      ENDIF
      WRITE(13,7763)
 7763 FORMAT ('SET_CONDITION P=P0 T=@8')
      IF(NTYP.EQ.1) THEN
         WRITE(13,7770)EL1,EL1
      ELSE
         WRITE(13,7770)EL2,EL2
      ENDIF
7770  FORMAT(' EXPERIMENT MUR(',A,')=@6:@7'/
     &        'SET_REFERENCE_STATE ',A,' @5 * 1E5')
      IF(ASSW.GT.-1.0D0) WRITE(13,*)'SET_WEIGHT ',ASSW,' ,, '
      WRITE(13,298)
      WRITE (13,*)'SET_ALL_START_VALUES Y'
      WRITE(13,332)
 6030 NPREF=ITU(1)
      IF(NPHA.EQ.2) THEN
         IF(ITU(3).NE.0) NPREF=ITU(3)
         KPHA=ITU(2)
      ELSE
         IF(ITU(2).NE.0) NPREF=ITU(2)
         KPHA=ITU(1)
      ENDIF
      WRITE(13,7780)LABEL,PHASE(ITU(1)),PHASE(KPHA),PHASE(NPREF),
     &                 W,DW,T,X(1),X(3)
7780  FORMAT('1 ',A,3(1X,A8),1X,F11.2,1X,F7.1,F9.2,2F9.6)
      WRITE(23,4425)X(1),W
 4425 FORMAT(1X,F9.6,5X,F11.2)
      ITABNO=ITABNO+1
      GOTO 100
C----------------- 
 9999 IF (ISTTAB.NE.0) WRITE (13,340)
      WRITE(13,370)
      write(*,9998)NOT
 9998 FORMAT(' Number of unprocessed lines are ',I5)
      CLOSE(3)
      CLOSE(13)
      IF(KSYMB.NE.0) WRITE(23,*)'BLOCKEND'
      CLOSE(23)
C...create command file for phase diagram and H and MU
      I=INDEX(NAMEP,'.')
      NAMEP(I:)='_cal.TCM '
      OPEN(UNIT=24,FILE=NAMEP,ACCESS='SEQUENTIAL',STATUS='UNKNOWN')
      WRITE(*,4429)NAMEP(1:I+8)
 4429 FORMAT(/' A template to calculate diagrams is written on ',A/)
      L2=LENS(EL2)
      WRITE(24,4430)EL2(1:L2),NAMEP(1:I-1),EL2(1:L2),NAMEC
 4430 FORMAT('@@'/'@@ Command file to calculate PD, H and MU'/'@@'/
     &     'go par'/'edit'/'read,,'/'back'/'go p-3'/'rei'/
     &     'set-axis-var 1 X(',A,') 0 1,,,'/
     &     'set-axis-var 2 T 300 3000 25'/
     &     'save ',A,'_pd Y'/'map'/'post'/
     &     'set-dia-ax x m-f ',A/'set-dia-ax y T'/'app-exp Y ',A,' 1'/
     &     '1'/'s-p-f'/'@?Plotformat?'/'plot,,'/'back')
      IF(TEMPH.GT.0) WRITE(24,4431)EL2,EL2HR,EL1,EL1HR,TEMPH,
     &               NAMEP(1:I-1),EL2(1:L2),HMPH(1:LENS(HMPH)),TEMPH
 4431 FORMAT('@& '/'@@ Calculate enthalpy curve '/'read,,'/
     &     'set-axis-var 2 none'/'set-ref-state ',A,' ',A,' * 1E5'/
     &     'set-ref-state ',A,' ',A,' * 1E5'/
     &     'set-cond T=',F9.2/'c-e'/'save ',A,'_h Y'/'step,,,'/'post'/
     &     'set-dia-ax x m-f ',A/'set-dia-ax y HMR(',A,')'/
     &     'app-exp Y,, 2'/'2'/'set-title T=',F9.2/'plot,,'/'back')
      IF(TEMPMU.GT.0) WRITE(24,4432)EL2,EL2MUR,TEMPMU,NAMEP(1:I-1),
     &                              EL2,EL2(1:L2),TEMPMU
 4432 FORMAT('@& '/'@@ Calculate chem.pot curve '/'read,,'/
     &     'set-ref-state ',A,' ',A,' * 1E5'/
     &     'set-cond T=',F9.2/'c-e'/'save ',A,' Y'/'step,,,'/'post'/
     &     'set-dia-ax x m-f ',A/'set-dia-ax y mur(',A,')'/
     &     'app-exp Y,,3'/'3'/'set-title T=',F9.2/'plot,,'/'back')
      WRITE(24,*)'set-inter'
      CLOSE(24)
      END

      SUBROUTINE CHKPHN(NAME)
      CHARACTER NAME*(*),CH1*1
      CALL CAPSON(NAME)
C...convert illegal characters to _
      K=LENS(NAME)
 10   M=INDEX(NAME,' ')
      IF(M.GT.0 .AND. M.LT.K) THEN
         NAME(M:M)='_'
         GOTO 10
      ENDIF
      DO 20 I=1,K
         CH1=NAME(I:I)
         IF(.NOT.((CH1.GE.'A' .AND. CH1.LE.'Z') .OR.
     &            (CH1.GE.'0' .AND. CH1.LE.'9'))) NAME(I:I)='_'
 20   CONTINUE
      IF(NAME(1:1).LT.'A' .OR. NAME(1:1).GT.'Z') NAME(1:1)='Q'
 900  RETURN
      END

      SUBROUTINE RDATF(LINE)
C...reads next line bypassing comment lines
      CHARACTER LINE*(*)
10    READ(21,20)LINE
20    FORMAT(A)
      IF(LINE(1:1).EQ.'$') GOTO 10
      RETURN
      END

      SUBROUTINE FNIC(FUNA)
      CHARACTER FUNA*6,CH1*1
      CH1=FUNA(6:6)
      IF(CH1.LT.'Z') THEN
         FUNA(6:6)=CHAR(ICHAR(CH1)+1)
      ELSE
         FUNA(5:5)=CHAR(ICHAR(FUNA(5:5))+1)
         FUNA(6:6)='A'
      ENDIF
      RETURN
      END

      SUBROUTINE CAPSON(STR)
      CHARACTER STR*(*)
      ID=ICHAR('A')-ICHAR('a')
      DO 20 I=1,LEN(STR)
        IF(STR(I:I).GE.'a') STR(I:I)=CHAR(ICHAR(STR(I:I))+ID)
20    CONTINUE
      RETURN
      END

      INTEGER FUNCTION LENS(STR)
      CHARACTER STR*(*)
      K=LEN(STR)
10    IF(STR(K:K).GT.' ') GOTO 800
      K=K-1
      IF(K.GT.0) GOTO 10
800   LENS=K
      RETURN
      END