1.パラメータ設定(F-Basic)
　データ形式は、         x1     y1
                               x2     y2
                               x3     y3
                                ・　　・
                                ・　　・
                                ・　　・

　となります。ｘ と ｙ のデータ間はスペースで区切ってください。
　ファイル名は、「***.ｔｘｔ」か「***.dat」にしてください。
　10個までのピークをフィッティングすることができます。ただし、1つのパラメータに対し5点程度のデータ点が必要です。
　"Curve"でプロファイル関数を選択してください。
　"FWHM"で各ピークの半値幅(FWHM)を同じ(Unity)したり可変(Variable)にしたりすることができます。

　初期値によって計算結果が異なります。
　フィッティングが失敗しても、再度、同じファイルを開くと、前回の初期値を覚えています。
　"Option"で初期値をリセットすることができます。

　"Background"でバックグランドを、固定(Fixed)、一定(Constant)、1次多項式(1st order)、2次多項式(2nd order)の中から選べます。
　バックグランドは負になりません。

2.プロファイルフィッティング計算(Fortran 90)

3.フィッティング結果表示(F-Basic)
　計算結果の数値は、右クリックのコピーで他のアプリケーションプログラムにペーストすることができます。
　計算結果のパラメータは、"Save Parameters"で「***.log」ファイルに保存されます。
  log ファイルは、同じファイルを何回もフィッティングしても上書きしないで付け加えられます。
　"Save Curves"でプロファイル曲線データが「***.fit n」ファイルに保存されます。（n=> 0: total, 1: Peak1, 2: Peak2, ・・・）

　R-Factor(Reliability factor) は、あくまでも目安です。
　ピーク分離がうまくいかないときは、バックグランドを固定にして再度フィッティングしてください。
　Pseud Voigt Function（非対称ピーク） は、それぞれのピーク位置が近いプロファイルの分離には適しません。
　データファイルの最後のデータの次の行にスペースや他のデータがあるとファイルを読み込めません。

　　　　ガウス型
 
 

　　　ローレンツ型

   変形ローレンツ型（ガウス型とローレンツ型の中間）
 

　　　Pseudo Voigt 関数（非対称プロファイル）

ファイルを開いて初期値を設定します。"Start"で計算開始！半値幅が自動で識別できないときは曲線を描きません。

初期値のプロファイルのグラフ。

計算結果。#1はピーク1で、#2はピーク2です。Xc, Ycは、それぞれのピーク・センターの位置とピークの高さです。

計算結果のグラフ。

declare sub DISPLAY_OPENING edecl ()
declare sub DISPLAY_GRAPH edecl ()
declare sub DISPLAY_CURVE edecl ()
declare sub OPEN_ON edecl ()
declare sub EXIT_ON edecl ()

declare sub BUTTON11_ON edecl ()    ' nP (Down)
declare sub BUTTON12_ON edecl ()    ' nP (Up)
declare sub BUTTON13_ON edecl ()    ' nS (Down)
declare sub BUTTON14_ON edecl ()    ' nS (Up)

declare sub HSCROLL21_CHANGE edecl ()
declare sub HSCROLL22_CHANGE edecl ()
declare sub HSCROLL23_CHANGE edecl ()
declare sub HSCROLL24_CHANGE edecl ()
declare sub HSCROLL31_CHANGE edecl ()
declare sub HSCROLL32_CHANGE edecl ()
declare sub HSCROLL33_CHANGE edecl ()

declare sub C_GAUSS_ON edecl ()
declare sub C_LORENTZ_ON edecl ()
declare sub C_SQR_LOR_ON edecl ()
declare sub C_PSD_VOIGT_ON edecl ()

declare sub BG_FIX_On edecl ()
declare sub BG_CONST_ON edecl ()
declare sub BG_1ST_ON edecl ()
declare sub BG_2ND_ON edecl ()

declare sub FWHM_UNI_On edecl ()
declare sub FWHM_VAR_On edecl ()
declare sub BUTTON1_ON edecl ()
declare sub PARA_RESET_ON edecl ()
declare sub SET_CALC_PARA_On edecl ()

declare function R_FACTOR edecl ()
declare function CALC_CURVE edecl (XX,J)
declare function CALC_BG edecl (XX)
'-----------------------------------
' 変数定義
'-----------------------------------
var shared FILENAME as string
var shared EDIT1 as object
var shared FORM2 as object       ' Opening window
var shared FORM3 as object       ' Graph window
var shared TEXT01 as object      ' Status Curve Type         (NC)
var shared TEXT02 as object      ' Status BG Type            (NBG)
var shared TEXT03 as object      ' Status FWHM               (FLG)
var shared TEXT11 as object      ' Set Total Peak number     (NP)
var shared TEXT12 as object      ' Set Selected Peak number  (NS)
var shared TEXT21 as object      ' Set Peak Position         P(NS,2)
var shared TEXT22 as object      ' Set Peak Height           P(NS,1)
var shared TEXT23 as object      ' Set FWHM(L)               P(NS,3)
var shared TEXT24 as object      ' Set BG
var shared TEXT31 as object      ' Set FWHM(R)               P(NS,4)
var shared TEXT32 as object      ' Set Eta(L)                P(NS,5)
var shared TEXT33 as object      ' Set Eta(R)                P(NS,6)

var shared HSCROLL21 as object
var shared HSCROLL22 as object
var shared HSCROLL23 as object
var shared HSCROLL24 as object
var shared HSCROLL31 as object  ' Set FWHM(R)               P(NS,4)
var shared HSCROLL32 as object  ' Set Eta(L)                P(NS,5)
var shared HSCROLL33 as object  ' Set Eta(R)                P(NS,6)

var shared XMIN, YMIN, XMAX, YMAX
var shared ND as integer,NC as integer, NP as integer
var shared NBG as integer, NS as integer, FLG as integer
var shared BG, MAX, HALF, XC, FWHM
var shared X(5000),Y(5000),P(11,6), P0(11,6), P1(11,6)
var shared RF_OLD, F$
'-------------------------------
  PARAMETER_SET
  DISPLAY_OPENING
  while 1
    WAITEVENT
  wend
end
'********************************************************
sub DISPLAY_OPENING () ' オープニング表示
'********************************************************
  SETMOUSEPOINTER 2
  FORM2.CREATEWINDOW "FORM2", -1
  TS=time
  do
    if time=TS+2 then exit do
  loop
  FORM2.DESTROYWINDOW
  SETMOUSEPOINTER 0
end sub
'**************************
sub MAINFORM_START ()      '  初期化処理
'**************************
  EDIT1.SETWINDOWTEXT ""
  EDIT1.SHOWWINDOW -1
end sub
'***********************
sub SETTITLE()      '      フォームのキャプション設定
'***********************
  SETWINDOWTEXT FILENAME
end sub
'****************************************
sub OPEN_ON()      '       ファイルを開く
'****************************************
  if CHECKOBJECT(FORM3) then
    FORM3.DESTROYWINDOW
  end if
  open "NiceFit_File_set.para" for input as #2
    line input #2, DR$
    line input #2, FI$
    line input #2, EX$
  close #2
'------------------------------
  if CHECKFILE then exit sub
  FI0$=DR$+"*"+EX$
  F$ = WINOPENDLG( "", FI0$, "データファイル(*.DAT);テキストファイル(*.TXT);すべてのファイル(*.*)", 0 )
  if F$=chr$(&H1B) then exit sub
  SETMOUSEPOINTER 2
  FFN = freefile
  open F$ for bininp as #FFN
    R$=space$(lof(FFN))
    fread #FFN, R$
  close #FFN
  EDIT1.SETWINDOWTEXT R$
'----------------------
  M=len(F$)
  EX$=right$(F$,4)
  for I=M to 1 step -1
    Q$=mid$(F$,I,1)
    if Q$="\" then exit for
  next I
  DR$=left$(F$,I)
  FI$=mid$(F$,I+1,M-I-4)
  open "NiceFit_File_set.para" for create as #1
    print #1, DR$
    print #1, FI$
    print #1, EX$
  close #1
'-----------------------------
  XMIN=10000.0: XMAX=-10000.0
  YMIN=10000.0: YMAX=-10000.0
  open F$ for input as #FFN
    ND=0
    while not eof(FFN)
      ND=ND+1
      input #FFN, X(ND), Y(ND)
      ifXMIN>X(ND) then XMIN=X(ND)
      ifYMIN>Y(ND) then YMIN=Y(ND)
      if XMAX<X(ND) then XMAX=X(ND)
      if YMAX<Y(ND) then YMAX=Y(ND)
    wend
  close #FFN
  BG=YMIN: MAX=YMAX
 YMIN=0:YMAX=YMAX*1.2
 '------------------------------
  SETMOUSEPOINTER 0
  FILENAME = F$
  SETTITLE
'------------------------------
  if not(CHECKOBJECT(FORM3)) then
    FORM3.CREATEWINDOW "FORM3", -1
    FWHM_CALC
'   ---------------
    for I=1 to NP
      for J=1 to 6
        P(I,J)=P0(I,J)
      next J
    next I
    RF0=R_FACTOR()
'   ---------------
    for I=1 to NP
      P(I,1)=(MAX-BG)/NP
      P(I,2)=XC
      P(I,3)=FWHM/NP
      P(I,4)=FWHM/NP
    next I
    P(NP+1,0)=BG
'   ----------------
    ifR_FACTOR()>RF0 then
      for I=1 to NP
        for J=1 to 6
          P(I,J)=P0(I,J)
        next J
      next I
    end if
  end if
  DISPLAY_GRAPH
end sub
'**********************************
sub DISPLAY_GRAPH ()
'**********************************
  FORM3.cls 0
  FORM3.view(100,40)-(600,413),13,3
  FORM3.window(XMIN,YMIN)-(XMAX,YMAX)
  FORM3.locate 13, 0: FORM3.print F$
  FORM3.locate 12,22: FORM3.print XMIN
  FORM3.locate 69,22: FORM3.print XMAX
  FORM3.locate  4,21: FORM3.print YMIN
  FORM3.locate  4, 1: FORM3.print YMAX
  R=(XMAX-XMIN)/6.0/ND

  for I=1 to ND
'    FORM3.print I,X(I),Y(I)
    FORM3.pset(X(I),Y(I)),3
    FORM3.circle(X(I),Y(I)),R,3,(YMAX-YMIN)/(XMAX-XMIN)*1.4,,,f
  next I
'-----------------------------------
  TEXT21.SETWINDOWTEXT str$(P(NS,2))
  TEXT22.SETWINDOWTEXT str$(P(NS,1))
  ifFWHM>0 then
    TEXT23.SETWINDOWTEXT str$(P(NS,3))
    for I=1 to NP
      if I=NS then CN=5 else CN=3
      if NC=4 then J=4 else J=3
      FORM3.line(P(I,2)-P(I,3)/2.0,P(I,1)/2.0+BG)-(P(I,2)+P(I,J)/2.0,P(I,1)/2.0+BG),,CN,,dot
      FORM3.line(P(I,2),BG)-(P(I,2),BG+P(I,1)),,CN,,dot
    next I
    FORM3.line(XMIN,BG)-(XMAX,BG),,3,,dot
    FORM3.locate 56, 1: FORM3.print "FWHM"
    FORM3.locate 64, 1: FORM3.print FWHM
    FORM3.locate 56, 2: FORM3.print "R-factor"
    FORM3.locate 64, 2: FORM3.print R_FACTOR();"%"
    FORM3.locate 38,22: FORM3.print XC
    DISPLAY_CURVE
  end if
  if NC=4 then
    TEXT31.SETWINDOWTEXT str$(P(NS,4))
    TEXT32.SETWINDOWTEXT str$(P(NS,5))
    TEXT33.SETWINDOWTEXT str$(P(NS,6))
  end if
end sub
'************************
sub FWHM_CALC()
'************************
  HALF=(MAX+BG)/2.0
  J=1
  while HALF>=Y(J)
    J=J+1
  wend
  JX1=J
  if Y(JX1)=Y(JX1-1) then
    FWHM=-1
    exit sub
  end if
'---------------------
  J=ND
  while HALF>=Y(J)
    J=J-1
  wend
  JX2=J+1

  J=JX1
  while HALF<Y(J)
    J=J+1
  wend

  ifJ<>JX2 or Y(JX2)=Y(JX2-1) then
    FWHM=-1
    exit sub
  end if
'-------------------------------------------------------------------
  XHF1=(X(JX1)-X(JX1-1))/(Y(JX1)-Y(JX1-1))*(HALF-Y(JX1-1)) + X(JX1-1)
  XHF2=(X(JX2)-X(JX2-1))/(Y(JX2)-Y(JX2-1))*(HALF-Y(JX2-1)) + X(JX2-1)
  FWHM=XHF2-XHF1
  if FWHM<0 then FWHM=-1
  XC=(XHF1+XHF2)/2.0
end sub
'*****************************
sub DISPLAY_CURVE()
'*****************************
  DX=(XMAX-XMIN)/100.0
  for J=1 to NP
    if J=NS then CN=5 else CN=3
    XX=XMIN
    FORM3.pset (XX,CALC_BG(XX)+CALC_CURVE(XX,J)),CN
    while XX<XMAX
      XX=XX+DX
      FORM3.line -(XX,CALC_BG(XX)+CALC_CURVE(XX,J)),,CN
    wend
  next J
'-----------------------------------------------
  XX=XMIN
  while XX<XMAX
    YT=CALC_BG(XX)
    for J=1 to NP
      YT=YT+CALC_CURVE(XX,J)
    next J
    if XX=XMIN then
      FORM3.pset (XX,YT),3
    else
      FORM3.line -(XX,YT),,3
    end if
    XX=XX+DX
  wend
end sub
'*****************************
function R_FACTOR()
'*****************************
  RF1=0.0: RF2=0.0
  for I=1 to ND
    XOBS=X(I)
    YCAL=CALC_BG(XOBS)
    for J=1 to NP
      YCAL = YCAL + CALC_CURVE(XOBS,J)
    next J
    RF1 = RF1 + abs(abs(YCAL)-abs(Y(I)))
    RF2 = RF2 + abs(Y(I))
  next I
  R_FACTOR=RF1/RF2*100.0
end function
'***************************
function CALC_CURVE(XOBS,I)
'***************************
  W=(XOBS-P(I,2))/P(I,3)
  select case NC
    case 1
      CALC_CURVE = P(I,1)*exp(-4.0*log(2.0)*W*W)
    case 2
      CALC_CURVE = P(I,1)/(1.0+4.0*W*W)
    case 3
      CALC_CURVE = P(I,1)/(1.0+4.0*(sqr(2.0)-1.0)*W*W)/(1.0+4.0*(sqr(2.0)-1.0)*W*W)
    case 4
      if XOBS < P(I,2) then
        W =( XOBS-P(I,2) )/P(I,3)
        ETA=P(I,5)
      else if XOBS > =P(I,2) then
        W =( XOBS-P(I,2) )/P(I,4)
        ETA=P(I,6)
      end if
      Z1 = P(I,1)*exp(-4.0*log(2.0)*W*W)
      Z2 = P(I,1)/(1.0+4.0*W*W)
      CALC_CURVE  = ETA*Z1 + (1-ETA)*Z2
  end select
end function
'*****************************
function CALC_BG(XOBS)
'*****************************
  YBG=0.0
  select case NBG
    case -1
      YBG=BG
    case 0
      YBG=P(NP+1,0)
    case 1
      YBG=P(NP+1,0) + P(NP+1,1)*XOBS
    case 2
      YBG=P(NP+1,0) + P(NP+1,1)*XOBS + P(NP+1,2)*XOBS*XOBS
  end select
  CALC_BG=YBG
end function
'**********************
sub C_GAUSS_ON()
'**********************
  NC=1
  TEXT01.SETWINDOWTEXT "Gaussian"
  if CHECKOBJECT(FORM3) then
    DISPLAY_GRAPH
    TEXT31.SETWINDOWTEXT "Voigt"
    TEXT32.SETWINDOWTEXT "Voigt"
    TEXT33.SETWINDOWTEXT "Voigt"
  end if
end sub
'************************
sub C_LORENTZ_ON()
'************************
  NC=2
  TEXT01.SETWINDOWTEXT "Lorentzian"
  if CHECKOBJECT(FORM3) then
    DISPLAY_GRAPH
    TEXT31.SETWINDOWTEXT "Voigt"
    TEXT32.SETWINDOWTEXT "Voigt"
    TEXT33.SETWINDOWTEXT "Voigt"
  end if
end sub
'************************
sub C_SQR_LOR_ON()
'************************
  NC=3
  TEXT01.SETWINDOWTEXT "Squared Lorentzian"
  if CHECKOBJECT(FORM3) then
    DISPLAY_GRAPH
    TEXT31.SETWINDOWTEXT "Voigt"
    TEXT32.SETWINDOWTEXT "Voigt"
    TEXT33.SETWINDOWTEXT "Voigt"
  end if
end sub
'**************************
sub C_PSD_VOIGT_ON()
'**************************
  NC=4
  TEXT01.SETWINDOWTEXT "Pseudo Voigt"
  for I=1 to NP
    if P(I,3)<=0 then
      P(I,3)=FWHM
    end if

    if P(I,4)<=0 then
      P(I,4)=P(I,3)
    end if
  next I
  if CHECKOBJECT(FORM3) then
    DISPLAY_GRAPH
    TEXT31.SETWINDOWTEXT str$(P(NS,4))
    TEXT32.SETWINDOWTEXT str$(P(NS,5))
    TEXT33.SETWINDOWTEXT str$(P(NS,6))
  end if
end sub
'**************
sub BG_FIX_On()
'**************
  NBG=-1
  TEXT02.SETWINDOWTEXT "Fixed"
end sub
'****************
sub BG_CONST_ON()
'****************
  NBG=0
  TEXT02.SETWINDOWTEXT "Constant"
end sub
'**************
sub BG_1ST_ON()
'**************
  NBG=1
  TEXT02.SETWINDOWTEXT "1st order"
end sub
'*****************************
sub BG_2ND_On()
'*****************************
  NBG=2
  TEXT02.SETWINDOWTEXT "2nd order"
end sub
'****************
sub FWHM_UNI_On()
'****************
  FLG=1
  TEXT03.SETWINDOWTEXT "Unity"
  if CHECKOBJECT(FORM3) then
    for I=1 to NP
      P(I,3)=P(NS,3)
    next I
    DISPLAY_GRAPH
  end if
end sub
'****************
sub FWHM_VAR_On()
'****************
  FLG=-1
  TEXT03.SETWINDOWTEXT "Variable"
end sub
'***************************************
sub BUTTON11_ON() ' nP (down)
'***************************************
  if NP>=2 then
    SETDLGCHECK "RADIO11", 1
    SETDLGCHECK "RADIO12", 0
    NP=NP-1
    TEXT11.SETWINDOWTEXT str$(NP)
    ifNS>NP then
      NS=NP
      TEXT12.SETWINDOWTEXT str$(NS)
    end if

    if CHECKOBJECT(FORM3) then
      DISPLAY_GRAPH
    end if
  end if
end sub
'***************************************
sub BUTTON12_ON() ' nP (up)
'***************************************
  if NP<=9 then
    SETDLGCHECK "RADIO11", 1
    SETDLGCHECK "RADIO12", 0

    NP=NP+1
    TEXT11.SETWINDOWTEXT str$(NP)

    if P(NP,1)<=0 then
      P(NP,1)=(MAX-BG)/NP
    end if

    if P(NP,2)<XMIN or XMAX<P(NP,2) then
      P(I,2)=XC
    end if
 
    if P(NP,3)<=0 then
      P(NP,3)=P(NP-1,3)
    end if

    if P(NP,4)<=0 then
      P(NP,4)=P(NP,3)
    end if

    if CHECKOBJECT(FORM3) then
      DISPLAY_GRAPH
    end if
  end if
end sub
'**************************************
sub BUTTON13_ON()   ' nS (down)
'**************************************
  if NS>=2 then
    SETDLGCHECK "RADIO11", 0
    SETDLGCHECK "RADIO12", 1
    NS=NS-1
    TEXT12.SETWINDOWTEXT str$(NS)

    if CHECKOBJECT(FORM3) then
      DISPLAY_GRAPH
    end if
  end if
end sub
'*************************************
sub BUTTON14_ON()  ' nS (up)
'*************************************
  if NS<NP then
    SETDLGCHECK "RADIO11", 0
    SETDLGCHECK "RADIO12", 1
    NS=NS+1
    TEXT12.SETWINDOWTEXT str$(NS)

    if CHECKOBJECT(FORM3) then
      DISPLAY_GRAPH
    end if
  end if
end sub
'****************************************
sub HSCROLL21_CHANGE() ' Set Peak Position
'****************************************
  SETDLGCHECK "RADIO21", 1
  SETDLGCHECK "RADIO22", 0
  SETDLGCHECK "RADIO23", 0
  SETDLGCHECK "RADIO24", 0
  SETDLGCHECK "RADIO31", 0
  SETDLGCHECK "RADIO32", 0
  SETDLGCHECK "RADIO33", 0
  NR=val(right$(GETDLGRADIOSELECT( "RADIO21" ),2))
  if CHECKOBJECT(FORM3) then
    if NR=21 then
      FACT=100.0/(XMAX-XMIN)
      HSCROLL21.SETSCROLLRANGE XMIN*FACT,XMAX*FACT
      P(NS,2)=HSCROLL21.GETSCROLLPOS/FACT
      TEXT21.SETWINDOWTEXT str$(P(NS,2))
    end if
    DISPLAY_GRAPH
  end if
end sub
'**************************************
sub HSCROLL22_CHANGE() ' Set Peak Height
'**************************************
  SETDLGCHECK "RADIO21", 0
  SETDLGCHECK "RADIO22", 1
  SETDLGCHECK "RADIO23", 0
  SETDLGCHECK "RADIO24", 0
  SETDLGCHECK "RADIO31", 0
  SETDLGCHECK "RADIO32", 0
  SETDLGCHECK "RADIO33", 0
  NR=val(right$(GETDLGRADIOSELECT( "RADIO22" ),2))
  if CHECKOBJECT(FORM3) then
    if NR=22 then
      FACT=100.0/(YMAX-YMIN)
      HSCROLL22.SETSCROLLRANGE 0.0,YMAX*FACT
      P(NS,1)=HSCROLL22.GETSCROLLPOS/FACT
      TEXT22.SETWINDOWTEXT str$(P(NS,1))
    end if
    DISPLAY_GRAPH
  end if
end sub
'*************************************
sub HSCROLL23_CHANGE() ' Set FWHM(L)
'*************************************
  SETDLGCHECK "RADIO21", 0
  SETDLGCHECK "RADIO22", 0
  SETDLGCHECK "RADIO23", 1
  SETDLGCHECK "RADIO24", 0
  SETDLGCHECK "RADIO31", 0
  SETDLGCHECK "RADIO32", 0
  SETDLGCHECK "RADIO33", 0
  NR=val(right$(GETDLGRADIOSELECT( "RADIO23" ),2))
  if CHECKOBJECT(FORM3) then
    if NR=23 then
      FACT=100.0/(XMAX-XMIN)
      HSCROLL23.SETSCROLLRANGE 0.0,(XMAX-XMIN)*FACT
      W=HSCROLL23.GETSCROLLPOS/FACT
      ifW>0 then
        P(NS,3)=W
        if FLG=1 then
          for I=1 to NP
            P(I,3)=W
          next I
        end if
        TEXT23.SETWINDOWTEXT str$(P(NS,3))
      end if
    end if
    DISPLAY_GRAPH
  end if
end sub
'*****************************
sub HSCROLL24_CHANGE() ' Set BG
'*****************************
  SETDLGCHECK "RADIO21", 0
  SETDLGCHECK "RADIO22", 0
  SETDLGCHECK "RADIO23", 0
  SETDLGCHECK "RADIO24", 1
  SETDLGCHECK "RADIO31", 0
  SETDLGCHECK "RADIO32", 0
  SETDLGCHECK "RADIO33", 0
  NR=val(right$(GETDLGRADIOSELECT( "RADIO24" ),2))
  if CHECKOBJECT(FORM3) then
    if NR=24 then
      FACT=500.0/(YMAX-YMIN)
      HSCROLL24.SETSCROLLRANGE 0.0,YMAX*FACT
      BG=HSCROLL24.GETSCROLLPOS/FACT
      P(NP+1,0)=BG
      TEXT24.SETWINDOWTEXT str$(BG)
    end if
    DISPLAY_GRAPH
  end if
end sub
'*************************************
sub HSCROLL31_CHANGE() ' Set FWHM(R)
'*************************************
  if NC=4 then
    SETDLGCHECK "RADIO21", 0
    SETDLGCHECK "RADIO22", 0
    SETDLGCHECK "RADIO23", 0
    SETDLGCHECK "RADIO24", 0
    SETDLGCHECK "RADIO31", 1
    SETDLGCHECK "RADIO32", 0
    SETDLGCHECK "RADIO33", 0
    NR=val(right$(GETDLGRADIOSELECT( "RADIO31" ),2))
    if CHECKOBJECT(FORM3) then
      if NR=31 then
       FACT=100.0/(XMAX-XMIN)
        HSCROLL31.SETSCROLLRANGE 0.0,(XMAX-XMIN)*FACT
        W=HSCROLL31.GETSCROLLPOS/FACT
        ifW>0 then
          P(NS,4)=W
          if FLG=1 then
            for I=1 to NP
              P(I,4)=W
            next I
          end if
          TEXT31.SETWINDOWTEXT str$(P(NS,4))
        end if
      end if
      DISPLAY_GRAPH
    end if
  end if
end sub
'*************************************
sub HSCROLL32_CHANGE() ' Set Eta(L)
'*************************************
  if NC=4 then
    SETDLGCHECK "RADIO21", 0
    SETDLGCHECK "RADIO22", 0
    SETDLGCHECK "RADIO23", 0
    SETDLGCHECK "RADIO24", 0
    SETDLGCHECK "RADIO31", 0
    SETDLGCHECK "RADIO32", 1
    SETDLGCHECK "RADIO33", 0
    NR=val(right$(GETDLGRADIOSELECT( "RADIO32" ),2))
    if CHECKOBJECT(FORM3) then
      if NR=32 then
        HSCROLL32.SETSCROLLRANGE 0.0,10.0
        P(NS,5)=HSCROLL32.GETSCROLLPOS/10.0
        if FLG=1 then
          for I=1 to NP
            P(I,5)=P(NS,5)
          next I
        end if
        TEXT32.SETWINDOWTEXT str$(P(NS,5))
      end if
      DISPLAY_GRAPH
    end if
  end if
end sub
'*************************************
sub HSCROLL33_CHANGE() ' Set Eta(R)
'*************************************
  if NC=4 then
    SETDLGCHECK "RADIO21", 0
    SETDLGCHECK "RADIO22", 0
    SETDLGCHECK "RADIO23", 0
    SETDLGCHECK "RADIO24", 0
    SETDLGCHECK "RADIO31", 0
    SETDLGCHECK "RADIO32", 0
    SETDLGCHECK "RADIO33", 1
    NR=val(right$(GETDLGRADIOSELECT( "RADIO32" ),2))
    if CHECKOBJECT(FORM3) then
      if NR=33 then
        HSCROLL33.SETSCROLLRANGE 0.0,10.0
        P(NS,6)=HSCROLL33.GETSCROLLPOS/10.0
        if FLG=1 then
          for I=1 to NP
            P(I,6)=P(NS,6)
          next I
        end if
        TEXT33.SETWINDOWTEXT str$(P(NS,6))
      end if
      DISPLAY_GRAPH
    end if
  end if
end sub
'****************
sub BUTTON1_ON()
'****************
  if CHECKOBJECT(FORM3) then
    open "Nice_Fit_para.doc" for create as #1
      print #1, R_FACTOR(), FLG
      print #1, ND, NP, NBG, NC      ' number of Data points, number of peaks
                                     ' BG type, Curve type
      print #1, BG
      for I=1 to NP
        if NC=4 then
          print #1, P(I,1), P(I,2), P(I,3), P(I,4), P(I,5), P(I,6)
        else
          print #1, P(I,1), P(I,2), P(I,3)
        end if
      next I
      for I=1 to ND
        print #1, X(I),Y(I)
      next I
   close #1
   end
  end if
end sub
'*******************
sub PARA_RESET_On()
'*******************
  if CHECKOBJECT(FORM3) then
    for I=1 to NP
      for J=1 to 6
        P(I,J)=P0(I,J)
      next J
    next
    DISPLAY_GRAPH
  end if
end sub
'*********************
sub SET_CALC_PARA_On()
'*********************
  if CHECKOBJECT(FORM3) then
    for I=1 to NP
      for J=1 to 6
        P(I,J)=P1(I,J)
      next J
    next
    DISPLAY_GRAPH
  end if
end sub
'**************************
sub EXIT_ON()              '  終了
'**************************
  if CHECKFILE then exit sub
  end
end sub
'*****************************
sub PARAMETER_SET()
'*****************************
  FILENAME = "(UNTIL)"
  NP=1
  NBG=-1
  NC=1
  NS=1
  FLG=1
 
  open "Nice_Fit_para.doc" for input as #1
    input #1, RF_OLD, FLG
    input #1, ND, NP, NBG, NC      ' number of Data points, number of peaks
                                     ' BG type, Curve type
    input #1, BG
    for I=1 to NP
      if NC=4 then
        input #1, P0(I,1), P0(I,2), P0(I,3), P0(I,4), P0(I,5), P0(I,6)
      else
        input #1, P0(I,1), P0(I,2), P0(I,3)
      end if
    next I
  close #1
'-----------------------------------------------
  open "Nice_Fit_calc.doc" for input as #1
    input #1, RF_OLD, FLG
    input #1, ND, NP, NBG, NC      ' number of Data points, number of peaks
                                     ' BG type, Curve type
    input #1, BG
'   -----------------
'   Input Parameters
'   -----------------
    if NC=4 then
      select case FLG
        case 1   '------------------Pseudo Voigt & FWHM (Unity)
          NCEF=2*NP+4
        case -1   '-----------------Pseudo Voigt & FWHM (Variable)
          NCEF=6*NP
      end select
    else
      select case FLG
        case 1    '-----------------Non Pseudo-Voigt & FWHM (Unity)
          NCEF=2*NP+1
        case -1   '-----------------Non Pseudo-Voigt & FWHM (Variable)
          NCEF=3*NP
      end select
    end if
 
    for I=1 to NCEF
      input #1, PP
    next I
    if NBG>=0 then input #1, BG0
    if NBG>=1 then input #1, BG1
    if NBG>=2 then input #1, BG2
'   ------------------
'   Fitted Parameters
'   ------------------
    if NC=4 then
      select case FLG
        case 1   '------------------Pseudo Voigt & FWHM (UNITY)
          for I=1 to NP
            for J=1 to 2
              input #1, P1(I,J), DP
            next J
          next I
          input #1, P1(1,3), DP    ' FWHM (Left)
          input #1, P1(1,4), DP    ' FWHM (Right)
          input #1, P1(1,5), DP    ' η (Left)
          input #1, P1(1,6), DP    ' η (Right)
          for I=1 to NP
            P1(I,3)=P1(1,3)
            P1(I,4)=P1(1,4)
            P1(I,5)=P1(1,5)
            P1(I,6)=P1(1,6)
          next I
        case -1   '-----------------Pseudo Voigt & FWHM (Variable)
          for I=1 to NP
            for J=1 to 6
              input #1, P1(I,J), DP
             next J
          next I
      end select
    else
      select case FLG
        case 1    '-----------------Non Pseudo-Voigt & FWHM (Unity)
          for I=1 to NP
            for J=1 to 2
              input #1, P1(I,J), DP
            next J
          next I
          input #1, P1(1,3)
          for I=1 to NP
            P1(I,3)=P1(1,3)
          next I
        case -1   '-----------------Non Pseudo-Voigt & FWHM (Variable)
          for I=1 to NP
            for J=1 to 3
              input #1, P1(I,J), DP
            next J
          next I
      end select
    end if
  close #1
'----------------------------------
  EDIT1.ATTACH GETDLGITEM("edit1")
  TEXT01.ATTACH GETDLGITEM("TEXT01")
  TEXT02.ATTACH GETDLGITEM("TEXT02")
  TEXT11.ATTACH GETDLGITEM("TEXT11")
  TEXT12.ATTACH GETDLGITEM("TEXT12")
  TEXT21.ATTACH GETDLGITEM("TEXT21")
  TEXT22.ATTACH GETDLGITEM("TEXT22")
  TEXT23.ATTACH GETDLGITEM("TEXT23")
  TEXT24.ATTACH GETDLGITEM("TEXT24")
  TEXT03.ATTACH GETDLGITEM("TEXT03")
  TEXT31.ATTACH GETDLGITEM("TEXT31")
  TEXT32.ATTACH GETDLGITEM("TEXT32")
  TEXT33.ATTACH GETDLGITEM("TEXT33")
  HSCROLL21.ATTACH GETDLGITEM("HSCROLL21")
  HSCROLL22.ATTACH GETDLGITEM("HSCROLL22")
  HSCROLL23.ATTACH GETDLGITEM("HSCROLL23")
  HSCROLL24.ATTACH GETDLGITEM("HSCROLL24")
  HSCROLL31.ATTACH GETDLGITEM("HSCROLL31")
  HSCROLL32.ATTACH GETDLGITEM("HSCROLL32")
  HSCROLL33.ATTACH GETDLGITEM("HSCROLL33")
  TEXT11.SETWINDOWTEXT str$(NP)
  TEXT12.SETWINDOWTEXT str$(NS)
  select case NC
    case 1
      TEXT01.SETWINDOWTEXT "Gaussian"
    case 2
      TEXT01.SETWINDOWTEXT "Lorentzian"
    case 3
      TEXT01.SETWINDOWTEXT "Squared Lorentzian"
    case 4
      TEXT01.SETWINDOWTEXT "Pseudo Voigt"
  end select

  select case NBG
    case -1
      TEXT02.SETWINDOWTEXT "Fixed"
    case 0
      TEXT02.SETWINDOWTEXT "Constant"
    case 1
      TEXT02.SETWINDOWTEXT "1st order"
    case 2
      TEXT02.SETWINDOWTEXT "2nd order"
  end select
 
  select case FLG
    case 1
      TEXT03.SETWINDOWTEXT "Unity"
    case -1
      TEXT03.SETWINDOWTEXT "Variable"
  end select
'---------------------------------------
  TEXT11.SETWINDOWTEXT str$(NP)
  TEXT12.SETWINDOWTEXT str$(NS)
  TEXT21.SETWINDOWTEXT str$(P0(NS,2))
  TEXT22.SETWINDOWTEXT str$(P0(NS,1))
  ifP0(NS,3)>0 then
    TEXT23.SETWINDOWTEXT str$(P0(NS,3))
  end if
  TEXT24.SETWINDOWTEXT str$(BG)
  if NC=4 then
    TEXT31.SETWINDOWTEXT str$(P0(NS,4))
    TEXT32.SETWINDOWTEXT str$(P0(NS,5))
    TEXT33.SETWINDOWTEXT str$(P0(NS,6))
  end if
end sub

  for I=1 to ND
'    FORM3.print I,X(I),Y(I)
    FORM3.pset(X(I),Y(I)),3
    FORM3.line(X(I),Y(I)-EB)-(X(I),Y(I)+EB),,3
    FORM3.line(X(I)-R,Y(I)-EB)-(X(I)+R,Y(I)-EB),,3
    FORM3.line(X(I)-R,Y(I)+EB)-(X(I)+R,Y(I)+EB),,3
    FORM3.circle(X(I),Y(I)),R,3,(YMAX-YMIN)/(XMAX-XMIN)*1.4,,,f
'    FORM3.circle(X(I),FIT(I)),R,5,(YMAX-YMIN)/(XMAX-XMIN)*1.4,,,f
  next I
'-----------------------------------
  for I=1 to NP
    CN=I+3
    if NC=4 then J=4 else J=3
    XBG=P(I,2)
    BGC=CALC_BG(XBG)
    FORM3.line(P(I,2)-P(I,3)/2.0,P(I,1)/2.0+BGC)-(P(I,2)+P(I,J)/2.0,P(I,1)/2.0+BGC),,CN,,dot
    FORM3.line(P(I,2),BGC)-(P(I,2),BGC+P(I,1)),,CN,,dot
  next I
  FORM3.locate 50, 0: FORM3.print "R-factor(old)"
  FORM3.locate 64, 0: FORM3.print RF_OLD;"%"
  FORM3.locate 50, 1: FORM3.print "R-factor(new)"
  FORM3.locate 64, 1: FORM3.print R_FACTOR();"%"
  DISPLAY_CURVE
  DISPLAY_BG
end sub
'*****************************
sub DISPLAY_CURVE()
'*****************************
  DX=(XMAX-XMIN)/100.0
  for J=1 to NP
    CN=J+3
    XX=XMIN
    FORM3.pset (XX,CALC_BG(XX)+CALC_CURVE(XX,J)),CN
    while XX<XMAX
      XX=XX+DX
      FORM3.line -(XX,CALC_BG(XX)+CALC_CURVE(XX,J)),,CN
    wend
  next J
'-----------------------------------------------
  XX=XMIN
  while XX<XMAX
    YT=CALC_BG(XX)
    for J=1 to NP
      YT=YT+CALC_CURVE(XX,J)
    next J
    if XX=XMIN then
      FORM3.pset (XX,YT),3
    else
      FORM3.line -(XX,YT),,3
    end if
    XX=XX+DX
  wend
end sub
'**************************
sub DISPLAY_BG()
'**************************
  DX=(XMAX-XMIN)/100.0
  select case NBG
    case -1
      FORM3.line (XMIN,BG)-(XMAX,BG),,3
    case 0
      FORM3.line (XMIN,P(NP+1,0))-(XMAX,P(NP+1,0)),,3
    case 1
      Y0=P(NP+1,0) + P(NP+1,1)*XMIN
      Y1=P(NP+1,0) + P(NP+1,1)*XMAX
      FORM3.line (XMIN,Y0)-(XMAX,Y1),,3
    case 2
      XX=XMIN
      Y0=P(NP+1,0) + P(NP+1,1)*XMIN + P(NP+1,2)*XX*XX
      FORM3.pset (XX,YY),3
      while XX<XMAX
        XX=XX+DX
        YY=P(NP+1,0)+P(NP+1,1)*XX + P(NP+1,2)*XX*XX
        FORM3.line -(XX,YY),,3
      wend
  end select
end sub
'*****************************
function R_FACTOR()
'*****************************
  RF1=0.0: RF2=0.0
  for I=1 to ND
    XOBS=X(I)
    YCAL=CALC_BG(XOBS)
    for J=1 to NP
      YCAL = YCAL + CALC_CURVE(XOBS,J)
    next J
    RF1 = RF1 + abs(abs(YCAL)-abs(Y(I)))
    RF2 = RF2 + abs(Y(I))
  next I
  R_FACTOR=RF1/RF2*100.0
end function
'***************************
function CALC_CURVE(XOBS,I)
'***************************
  W=(XOBS-P(I,2))/P(I,3)
  select case NC
    case 1
      CALC_CURVE = P(I,1)*exp(-4.0*log(2.0)*W*W)
    case 2
      CALC_CURVE = P(I,1)/(1.0+4.0*W*W)
    case 3
      CALC_CURVE = P(I,1)/(1.0+4.0*(sqr(2.0)-1.0)*W*W)/(1.0+4.0*(sqr(2.0)-1.0)*W*W)
    case 4
      if XOBS < P(I,2) then
        W =( XOBS-P(I,2) )/P(I,3)
        ETA=P(I,5)
      else if XOBS > =P(I,2) then
        W =( XOBS-P(I,2) )/P(I,4)
        ETA=P(I,6)
      end if
      Z1 = P(I,1)*exp(-4.0*log(2.0)*W*W)
      Z2 = P(I,1)/(1.0+4.0*W*W)
      CALC_CURVE  = ETA*Z1 + (1-ETA)*Z2
  end select
end function
'*****************************
function CALC_BG(XOBS)
'*****************************
  YBG=0.0
  select case NBG
    case -1
      YBG=BG
    case 0
      YBG=P(NP+1,0)
    case 1
      YBG=P(NP+1,0) + P(NP+1,1)*XOBS
    case 2
      YBG=P(NP+1,0) + P(NP+1,1)*XOBS + P(NP+1,2)*XOBS*XOBS
  end select
  CALC_BG=YBG
end function
'**************************
sub EXIT_ON()              '  終了
'**************************
  if CHECKFILE then exit sub
  end
end sub
'***************
sub SAVE_CV_On()
'***************
  DX=(XMAX-XMIN)/100.0
  for J=1 to NP
    open DR$+FI$+".fit"+str$(J) for create as #3
      XX=XMIN
      while XX<=XMAX
        YY = CALC_BG(XX) + CALC_CURVE(XX,J)
        print #3, XX, YY
        XX=XX+DX
      wend
    close #3
  next J
'-----------------------------------------------
  open DR$+FI$+".fit 0" for create as #3
    XX=XMIN
    while XX<=XMAX
      YY=CALC_BG(XX)
      for J=1 to NP
        YY = YY + CALC_CURVE(XX,J)
      next J
      print #3, XX, YY
      XX=XX+DX
    wend
  close #3
end sub
'***************
sub SAVE_PA_On()
'***************
  if FLG_LOG$="0" then
    open DR$+FI$+".log" for append as #1
      print #1, E$
    close #1
  end if
  FLG_LOG$="1"
end sub
'******************
sub PARAMETER_SET()
'******************
  EDIT1.ATTACH GETDLGITEM("edit1")
  TEXT01.ATTACH GETDLGITEM("TEXT01")
  TEXT02.ATTACH GETDLGITEM("TEXT02")
  TEXT03.ATTACH GETDLGITEM("TEXT03")
  EDIT1.SETWINDOWTEXT ""
  EDIT1.SHOWWINDOW -1
  FLG_LOG$="0"
'-----------------------------------
  open "NiceFit_File_set.para" for input as #2
    line input #2, DR$
    line input #2, FI$
    line input #2, EX$
  close #2

  FILENAME = DR$+FI$+EX$
  SETTITLE
'-------------------------------------------
  open "Nice_Fit_calc.doc" for input as #1
    input #1, RF_OLD, FLG
    input #1, ND, NP, NBG, NC      ' number of Data points, number of peaks
                                     ' BG type, Curve type
    input #1, BG
  E$="-----------------------------------"+chr$(13,10)
  select case NC
    case 1
      TEXT01.SETWINDOWTEXT "Gaussian"
      E$=E$+" Gaussian ("
    case 2
      TEXT01.SETWINDOWTEXT "Lorentzian"
      E$=E$+" Lorentzian ("
    case 3
      TEXT01.SETWINDOWTEXT "Squared Lorentzian"
      E$=E$+" Squared Lorentzian ("
    case 4
      TEXT01.SETWINDOWTEXT "Pseudo Voigt"
      E$=E$+" Pseudo Voigt ("
  end select

  select case NBG
    case -1
      TEXT02.SETWINDOWTEXT "Fixed"
      E$=E$+"BG: Fixed"
    case 0
      TEXT02.SETWINDOWTEXT "Constant"
      E$=E$+"BG: Const"
    case 1
      TEXT02.SETWINDOWTEXT "1st order"
      E$=E$+"BG: 1st"
    case 2
      TEXT02.SETWINDOWTEXT "2nd order"
      E$=E$+"BG: 2nd"
  end select
 
  select case FLG
    case 1
      TEXT03.SETWINDOWTEXT "Unity"
      E$=E$+" / FWHM: Unity )"+chr$(13,10)
    case -1
      TEXT03.SETWINDOWTEXT "Variable"
      E$=E$+" / FWHM: Variable )"+chr$(13,10)
  end select
'   -----------------
'   Input Parameters
'   -----------------
    E$=E$+"----- Input Parameters ---------------"+chr$(13,10)
    if NC=4 then
      select case FLG
        case 1   '------------------Pseudo Voigt & FWHM (Unity)
          for I=1 to NP
            for J=1 to 2
              input #1, P0(I,J)
              select case J
                case 1
                  PK$=" Yc          "
                case 2
                  PK$=" Xc          "
              end select
              E$=E$+"#"+ str$(I)+PK$+str$(P0(I,J))+chr$(13,10)
            next J
          next I
          input #1, P0(1,3)    ' FWHM (Left)
          input #1, P0(1,4)    ' FWHM (Right)
          input #1, P0(1,5)    ' η (Left)
          input #1, P0(1,6)    ' η (Right)
          E$=E$+" FWHM(Left)  "+str$(P0(1,3))+chr$(13,10)
          E$=E$+" FWHM(Right) "+str$(P0(1,4))+chr$(13,10)
          E$=E$+"  η (Left)  "+str$(P0(1,5))+chr$(13,10)
          E$=E$+"  η (Right) "+str$(P0(1,6))+chr$(13,10)
        case -1   '-----------------Pseudo Voigt & FWHM (Variable)
          for I=1 to NP
            for J=1 to 6
              input #1, P0(I,J)
              select case J
                case 1
                  PK$=" Yc          "
                case 2
                  PK$=" Xc          "
                case 3
                  PK$=" FWHM(Left)  "
                case 4
                  PK$=" FWHM(Right) "
                case 5
                  PK$="  η (Left)  "
                case 6
                  PK$="  η (Right) "
              end select
              E$=E$+"#"+ str$(I)+PK$+str$(P0(I,J))+chr$(13,10)
            next J
          next I
      end select
    else
      select case FLG
        case 1    '-----------------Non Pseudo-Voigt & FWHM (Unity)
          for I=1 to NP
            for J=1 to 2
              input #1, P0(I,J)
              select case J
                case 1
                  PK$=" Yc          "
                case 2
                  PK$=" Xc          "
              end select
              E$=E$+"#"+ str$(I)+PK$+str$(P0(I,J))+chr$(13,10)
            next J
          next I
          input #1, P0(1,3)
          E$=E$+" FWHM         "+str$(P0(1,3))+chr$(13,10)
        case -1   '-----------------Non Pseudo-Voigt & FWHM (Variable)
          for I=1 to NP
            for J=1 to 3
              input #1, P0(I,J)
              select case J
                case 1
                  PK$=" Yc         "
                case 2
                  PK$=" Xc         "
                case 3
                  PK$=" FWHM       "
              end select
              E$=E$+"#"+ str$(I)+PK$+str$(P0(I,J))+chr$(13,10)
            next J
          next I
      end select
    end if
    E$=E$+" BackGround "+str$(BG)+chr$(13,10)

    if NBG>=0 then input #1, P0(NP+1,0)
    if NBG>=1 then input #1, P0(NP+1,1)
    if NBG>=2 then input #1, P0(NP+1,2)
'   ------------------
'   Fitted Parameters
'   ------------------
    E$=E$+"----- Fitted Parameters ---------------"+chr$(13,10)
    if NC=4 then
      select case FLG
        case 1   '------------------Pseudo Voigt & FWHM (UNITY)
          for I=1 to NP
            for J=1 to 2
              input #1, P(I,J), DP(I,J)
              select case J
                case 1
                  PK$=" Yc          "
                case 2
                  PK$=" Xc          "
              end select
              E$=E$+"#"+ str$(I)+PK$+str$(P(I,J))+" ± "+str$(DP(I,J))+ chr$(13,10)
            next J
          next I
          input #1, P(1,3), DP(1,3)    ' FWHM (Left)
          input #1, P(1,4), DP(1,4)    ' FWHM (Right)
          input #1, P(1,5), DP(1,5)    ' η (Left)
          input #1, P(1,6), DP(1,6)    ' η (Right)
          E$=E$+" FWHM(Left)  "+str$(P(1,3))+" ± "+str$(DP(1,3))+chr$(13,10)
          E$=E$+" FWHM(Right) "+str$(P(1,4))+" ± "+str$(DP(1,4))+chr$(13,10)
          E$=E$+" averageFWHM "+str$((P(1,3)+P(1,4))/2.0)+" ± "+str$((DP(1,3)+DP(1,4))/2.0)+chr$(13,10)
          E$=E$+"  η (Left)  "+str$(P(1,5))+" ± "+str$(DP(1,5))+chr$(13,10)
          E$=E$+"  η (Right) "+str$(P(1,6))+" ± "+str$(DP(1,6))+chr$(13,10)
          for I=1 to NP
            P(I,3)=P(1,3)
            P(I,4)=P(1,4)
            P(I,5)=P(1,5)
            P(I,6)=P(1,6)
          next I
        case -1   '-----------------Pseudo Voigt & FWHM (Variable)
          for I=1 to NP
            for J=1 to 6
              input #1, P(I,J), DP(I,J)
              select case J
                case 1
                  PK$=" Yc          "
                case 2
                  PK$=" Xc          "
                case 3
                  PK$=" FWHM(Left)  "
                case 4
                  PK$=" FWHM(Right) "
                case 5
                  PK$="  η (Left)  "
                case 6
                  PK$="  η (Right) "
              end select
              E$=E$+"#"+ str$(I)+PK$+str$(P(I,J))+" ± "+str$(DP(I,J))+chr$(13,10)
            next J
            E$=E$+"#"+ str$(I)+" averageFWHM "+str$((P(I,3)+P(I,4))/2.0)+" ± "+str$((DP(I,3)+DP(I,4))/2.0)+chr$(13,10)
          next I
      end select
    else
      select case FLG
        case 1    '-----------------Non Pseudo-Voigt & FWHM (Unity)
          for I=1 to NP
            for J=1 to 2
              input #1, P(I,J), DP(I,J)
              select case J
                case 1
                  PK$=" Yc          "
                case 2
                  PK$=" Xc          "
              end select
              E$=E$+"#"+ str$(I)+PK$+str$(P(I,J))+" ± "+str$(DP(I,J))+chr$(13,10)
            next J
          next I
          input #1, P(1,3), DP(1,3)
          E$=E$+" FWHM         "+str$(P(1,3))+" ± "+str$(DP(1,3))+chr$(13,10)
          for I=1 to NP
            P(I,3)=P(1,3)
          next I
        case -1   '-----------------Non Pseudo-Voigt & FWHM (Variable)
          for I=1 to NP
            for J=1 to 3
              input #1, P(I,J), DP(I,J)
              select case J
                case 1
                  PK$=" Yc         "
                case 2
                  PK$=" Xc         "
                case 3
                  PK$=" FWHM       "
              end select
              E$=E$+"#"+ str$(I)+PK$+str$(P(I,J))+" ± "+str$(DP(I,J))+chr$(13,10)
            next J
          next I
      end select
    end if
    if NBG>=0 then
      input #1, P(NP+1,0), DP(NP+1,0)
      E$=E$+" BG (const.) "+str$(P(NP+1,0))+" ± "+str$(DP(NP+1,0))+chr$(13,10)
    end if
    if NBG>=1 then
      input #1, P(NP+1,1), DP(NP+1,1)
      E$=E$+" BG ( 1st  ) "+str$(P(NP+1,1))+" ± "+str$(DP(NP+1,1))+chr$(13,10)
    end if
    if NBG>=2 then
     input #1, P(NP+1,2), DP(NP+1,2)
      E$=E$+" BG ( 2nd  ) "+str$(P(NP+1,2))+" ± "+str$(DP(NP+1,2))+chr$(13,10)
    end if
'   ----------------------------------------------
    input #1, EB      ' Error Bar
    input #1, CHISQ   ' χ^2
    E$=E$+" χ^2        "+str$(CHISQ)+chr$(13,10)
'-------------------------------------------------
    XMIN=10000.0: XMAX=-10000.0
    YMIN=10000.0: YMAX=-10000.0
    for I=1 to ND
      input #1, X(I), Y(I), FIT(I)
      ifYMIN>Y(I) then YMIN=Y(I)
      if YMAX<Y(I) then YMAX=Y(I)
    next I
  close #1
  EDIT1.SETWINDOWTEXT E$
'----------------------------------
  MAX=YMAX
 YMIN=0:YMAX=YMAX*1.2
  XMIN=X(1): XMAX=X(ND)
  if not(CHECKOBJECT(FORM3)) then
    FORM3.CREATEWINDOW "FORM3", -1
  end if
  DISPLAY_GRAPH
end sub

Back to ABE

Back to Department of Materials Science and Engineering

Last Modified: April 1, 2009