Note Program to add numbers continuously while showing as if done on paper
set talk off
set color to g/n, bg/r,g/b
set status off
do_again = "Y"
do while upper(do_again) = "Y"
clear 
sumis = 0
tobeadded = 1
Do while tobeadded <> 0
  Input "   Enter the number to add, or enter 0: " to tobeadded
  sumis = sumis + tobeadded
  if tobeadded <> 0
    ??  "                                        ",tobeadded
  endif
Enddo
??      "                                        ","-------------"
?       "   The required sum is:                 ",sumis
?
wait "   Do another summation [Y,N]? " to do_again
Enddo
Return





Note Program to check whether a given number is prime or not
clear
set talk off
Input "    Enter the number to be checked: " to number
?
divisor = 2
Do while divisor <= sqrt(number)
 dividend = (number / divisor)
 If dividend = int(dividend)
   ?"    The number is not prime!"
   ?   
   ?"   ",ltrim(str(number)), "=", ltrim(str(dividend)), "x", ;
   ltrim(str(divisor))
   divisor = sqrt(number) + 1
 Endif
 divisor = divisor + 1
Enddo
If divisor <> sqrt (number) + 2
 ?"    The number is prime!"
Endif




Note Program to calculate internuclear potential energy of H2+ ion gr. level
*  (Is being given to M.Sc. Chemistry Final yr. (Phys. Ch. Spl.) students in 
*  Cotton College as one of their practical experiments.)
CLEAR
SET TALK OFF
SET ALTERNATE TO RES
SET DECIMALS TO 5
SET FIXED ON
SET STATUS OFF
SET ALTERNATE ON
TEXT

  Internuclear potential energy (electronic energy including internuclear
     repulsion) for hydrogen molecular monovalent cation ground state
 (Calculation of the same for the first excited states is too error-prone)

  Formulae used (Ira N. Levine, Chap: 13  Section: MO theory of H2+ ion):


  Overlap integral    Sab = (1 + k*R + k*k*R*R/3) * exp((-1)*k*R)

  Coulomb integral    Haa = 0.5*k*k - k - 1/R + (k+1/R) * exp((-2)*k*R)

  Resonance Integral  Hab = (-0.5)*k*k*Sab - k*(2-k)*(1+k*R)*exp((-1)*k*R)

  Internuclear Potn.  U   = (Haa + Hab)/(1 + Sab) + 1/R
  (Electronic energy)

  Value of the orbital exponent k for each value of R is obtained as the
  optimum value that gives the lowest value of U (variation theorem).

  The results of this work will be stored in RES.TXT in this folder.

ENDTEXT
SET ALTERNATE OFF
wait "  Would you include values of Sab, Haa, Hab & U in RES.TXT [Y,N]? ";
to openness
@ 1,0 clear
R = 0.2
SET ALTERNATE ON
If upper(openness) = "Y"
TEXT


 Internuclear  Orbital     Overlap    Coulomb     Resonance  Electronic
   Distance    Exponent    Integral   Integral    Integral    Energy U

ENDTEXT
Else
TEXT


       Internuclear       Orbital
        distance R       Exponent k     

ENDTEXT
Endif
SET ALTERNATE OFF
DO WHILE R <= 10.1
k = 0.1
EP_MIN = 1000
DO WHILE k <= 2
  NUME = k*k - k - 1/R + (1+k*R)*EXP((-2)*k*R)/R + k*(k-2)*(1+k*R) ;
  *EXP((-1)*k*R)
  DENO = 1 + EXP((-1)*k*R)*(1+k*R+k*k*R*R/3)
  EP = (-0.5)*k*k + NUME/DENO + 1/R
  IF EP < EP_MIN
    k_min = k
    EP_MIN = EP
  ENDIF
  k = k + 0.01
ENDDO
k = k_min - 0.01
k_lim = k_min + 0.01
DO WHILE k <= k_lim
  NUME = k*k - k - 1/R + (1 + k*R)*EXP((-2)*k*R)/R + k*(k-2)*(1 + k*R) ;
  *EXP((-1)*k*R)
  DENO = 1 + EXP((-1)*k*R)*(1 + k*R + k*k*R*R/3)
  EP = (-0.5)*k*k + NUME/DENO + 1/R
  IF EP < EP_MIN
    k_min = k
    EP_MIN = EP
  ENDIF
  k = k + 0.0001
ENDDO
k = k_min
EP = EP_MIN
Sab = (1 + k*R + k*k*R*R/3) * exp((-1)*k*R)
Haa = 0.5*k*k - k - 1/R + (k+1/R) * exp((-2)*k*R)
Hab = (-0.5)*k*k*Sab - k*(2-k)*(1+k*R) * exp((-1)*k*R)
U = (Haa + Hab)/(1 + Sab) + 1/R
SET ALTERNATE ON
If upper(openness) = "Y"
?str(R,10,5),str(k,11,5),str(Sab,11,5),str(Haa,11,5),str(Hab,11,5),str(U,11,5)
Else
?R,k
Endif
SET ALTERNATE OFF
R = R + 0.2
ENDDO
SET ALTERNATE ON
?
SET ALTERNATE OFF
CLEAR ALL
QUIT





Note Program to get the numbers 1 to 700 continuously in a file Oneto700.txt
set talk off
n = 1
set alte to oneto700
set alte on
do while n < 706
?str(n,9)
??str(n+1,9)
??str(n+2,9)
??str(n+3,9)
??str(n+4,9)
??str(n+5,9)
??str(n+6,9)
??str(n+7,9)
??str(n+8,9)
??str(n+9,9)
?
?
n = n + 10
enddo
set alternate off
close alternate






Note Program to find EMI for a loan from Housing Develop. Fin. Corp. (India)
SET TALK OFF
set decimals to 5
?
input"Enter amount of loan : "to AMLOAN
?
input"Enter p.c. rate of loan : "to PCRATE
?
input"Enter no. of years : "to YEARS
FACTOR = 1.0 + PCRATE/100.0
FINAMT = AMLOAN * ( FACTOR ** YEARS)
EYI = FINAMT * ( FACTOR - 1.0)/ ( FACTOR ** YEARS - 1.0 )
EMI = EYI/12
set decimals to 2
?
?"The equated monthly installment is :",EMI






Note Program to form a word from characters pressed till Space pressed
set talk off
clear
@ 3,0 clear
?"   Type a letter to form the word (Press Space to exit):"
store  "" to letter, word
do while asc(letter) <>  32
  @ 5,0 clear
  wait word to letter
  word = stuff (word, len(word)+1,1,letter)
  if asc(letter) = 127
    word = left(word,len(word)-2)
  endif
enddo
clear
@ 5,0 say " "
?"   The word formed is:", word





Note Program to start dBase III Plus with a proper, convenient setting
Note Can be added to the beginning of a dBase III Plus program file
SET ECHO OFF
SET CENTURY ON
SET CONFIRM ON
SET COLOR ON
SET COLOR TO G/N,BG/R,G/B
SET DATE BRITISH
SET DECIMALS TO 2
SET DELETED OFF
SET ESCAPE ON 
SET EXACT OFF
SET HELP OFF
SET HISTORY TO 100
SET INTENSITY ON
SET MARGIN TO 0
SET MENUS ON
SET PATH TO C:\,C:\WS4_FULL
SET PRINT OFF
SET SAFETY ON
SET STATUS ON 
SET STEP OFF
SET TALK ON
SET TYPEAHEAD TO 100
ASSIST






Note Program to get the real roots of a quadratic equation
clear
set talk off
input "  Enter value of A : " to a
?
input "  Enter value of B : " to b
?
input "  Enter value of C : " to c
?
if b*b >= 4*a*c
  x1 = (-b + sqrt(b*b - 4*a*c))/(2*a)
  x2 = (-b - sqrt(b*b - 4*a*c))/(2*a)
  ?
  ?"  The values of X are:",x1,"     and",x2
else
  ?
  ?"  No real roots exist!"
endif





Note Program to display the ASCII characters in a text file Ascii.txt
set talk off
set alternate to ascii
set alternate on
clear
n = 30
s0 = space(0)
do while n < 231
  ?str(n+1,3),s0,chr(n+1),chr(n+2),chr(n+3),chr(n+4),chr(n+5),space(1)
  ??str(n+6,3),s0,chr(n+6),chr(n+7),chr(n+8),chr(n+9),chr(n+10),space(1)
  ??str(n+11,3),s0,chr(n+11),chr(n+12),chr(n+13),chr(n+14),chr(n+15),space(1)
  ??str(n+16,3),s0,chr(n+16),chr(n+17),chr(n+18),chr(n+19),chr(n+20),space(1)
  ??str(n+21,3),s0,chr(n+21),chr(n+22),chr(n+23),chr(n+24),chr(n+25)
  ?
  n = n + 25
enddo
set alternate off
close alternate




Note  Checks speed for Mathematical calculation. Better run in dBase. 
CLEAR
SET TALK OFF
SET DECIMALS TO 5
SET FIXED ON
R = 0.2
TEXT
   Checking processor-speed of the Computer for mathematical calculations!

        Wait till the appearence of the line "Calculation is Over!"
ENDTEXT
SET TALK OFF
TIME1 = TIME()
DATE1 = DATE()
?CHR(7)
?"        "
DO WHILE R < 12
k = 0.1
EP_MIN = 1000
DO WHILE k <= 2
  NUME = k*k - k - 1/R + (1+k*R)*EXP((-2)*k*R)/R + k*(k-2)*(1+k*R) ;
  *EXP((-1)*k*R)
  DENO = 1 + EXP((-1)*k*R)*(1+k*R+k*k*R*R/3)
  EP = (-0.5)*k*k + NUME/DENO + 1/R
  IF EP < EP_MIN
    k_min = k
    EP_MIN = EP
  ENDIF
  k = k + 0.01
ENDDO
k = k_min - 0.01
k_lim = k_min + 0.01
DO WHILE k <= k_lim
  NUME = k*k - k - 1/R + (1 + k*R)*EXP((-2)*k*R)/R + k*(k-2)*(1 + k*R) ;
  *EXP((-1)*k*R)
  DENO = 1 + EXP((-1)*k*R)*(1 + k*R + k*k*R*R/3)
  EP = (-0.5)*k*k + NUME/DENO + 1/R
  IF EP < EP_MIN
    k_min = k
    EP_MIN = EP
  ENDIF
  k = k + 0.0001
ENDDO
k = k_min
EP = EP_MIN
Sab = (1 + k*R + k*k*R*R/3) * exp((-1)*k*R)
Haa = 0.5*k*k - k - 1/R + (k+1/R) * exp((-2)*k*R)
Hab = (-0.5)*k*k*Sab - k*(2-k)*(1+k*R) * exp((-1)*k*R)
U = (Haa + Hab)/(1 + Sab) + 1/R
R = R + 0.2
??"."
ENDDO
DATE2 = DATE()
TIME2 = TIME()
?CHR(7)
TIME_S = TIME1
TIME_F = TIME2
S1 = VAL(TIME1)*3600
TIME1 = RIGHT(TIME1,5)
S1 = S1 + VAL(TIME1)*60
TIME1 = RIGHT(TIME1,2)
S1 = S1 + VAL(TIME1)
S2 = VAL(TIME2)*3600
TIME2 = RIGHT(TIME2,5)
S2 = S2 + VAL(TIME2)*60
TIME2 = RIGHT(TIME2,2)
S2 = S2 + VAL(TIME2)
DIFF_S = (DATE2 - DATE1)*86400 + (S2 - S1)
TEXT


        Calculation is Over!

ENDTEXT
?"        Starting Date and Time :",DATE1,TIME_S  
?
?"        Finishing Date and Time:",DATE2,TIME_F  
?
?"        Time taken in seconds:",STR(DIFF_S)
return