WeixiangYan/CodeTransOcean huggingface dataset:
Task: String comparison







Python: fun compare(a, b):
    print("\n$a is of type ${typeof(a)} and $b is of type ${typeof(b)}")
    if a < b: print("$a is strictly less than $b")
    if a <= b: print("$a is less than or equal to $b")
    if a >  b: print("$a is strictly greater than $b")
    if a >= b: print("$a is greater than or equal to $b")
    if a == b: print("$a is equal to $b")
    if a != b: print("$a is not equal to $b")
    if a is b: print("$a has object identity with $b")
    if a is not b: print("$a has negated object identity with $b")

compare("YUP", "YUP")
compare('a', 'z')
compare("24", "123")
compare(24, 123)
compare(5.0, 5)




Fortran:       PRINT 42,N
   42 FORMAT (14HThe answer is ,I9)
Task: Pascal matrix generation








VB: Option Base 1
Private Function pascal_upper(n As Integer)
    Dim res As Variant: ReDim res(n, n)
    For j = 1 To n
        res(1, j) = 1
    Next j
    For i = 2 To n
        res(i, 1) = 0
        For j = 2 To i
            res(j, i) = res(j, i - 1) + res(j - 1, i - 1)
        Next j
        For j = i + 1 To n
            res(j, i) = 0
        Next j
    Next i
    pascal_upper = res
End Function
 
Private Function pascal_symmetric(n As Integer)
    Dim res As Variant: ReDim res(n, n)
    For i = 1 To n
        res(i, 1) = 1
        res(1, i) = 1
    Next i
    For i = 2 To n
        For j = 2 To n
            res(i, j) = res(i - 1, j) + res(i, j - 1)
        Next j
    Next i
    pascal_symmetric = res
End Function

Private Sub pp(m As Variant)
    For i = 1 To UBound(m)
        For j = 1 To UBound(m, 2)
            Debug.Print Format(m(i, j), "@@@");
        Next j
        Debug.Print
    Next i
End Sub

Public Sub main()
    Debug.Print "=== Pascal upper matrix ==="
    pp pascal_upper(5)
    Debug.Print "=== Pascal lower matrix ==="
    pp WorksheetFunction.Transpose(pascal_upper(5))
    Debug.Print "=== Pascal symmetrical matrix ==="
    pp pascal_symmetric(5)
End Sub



Fortran: module pascal

implicit none

contains
    function pascal_lower(n) result(a)
        integer :: n, i, j
        integer, allocatable :: a(:, :)
        allocate(a(n, n))
        a = 0
        do i = 1, n
            a(i, 1) = 1
        end do
        do i = 2, n
            do j = 2, i
                a(i, j) = a(i - 1, j) + a(i - 1, j - 1)
            end do
        end do
    end function
    
    function pascal_upper(n) result(a)
        integer :: n, i, j
        integer, allocatable :: a(:, :)
        allocate(a(n, n))
        a = 0
        do i = 1, n
            a(1, i) = 1
        end do
        do i = 2, n
            do j = 2, i
                a(j, i) = a(j, i - 1) + a(j - 1, i - 1)
            end do
        end do
    end function

    function pascal_symmetric(n) result(a)
        integer :: n, i, j
        integer, allocatable :: a(:, :)
        allocate(a(n, n))
        a = 0
        do i = 1, n
            a(i, 1) = 1
            a(1, i) = 1
        end do
        do i = 2, n
            do j = 2, n
                a(i, j) = a(i - 1, j) + a(i, j - 1)
            end do
        end do
    end function

    subroutine print_matrix(a)
        integer :: a(:, :)
        integer :: n, i
        n = ubound(a, 1)
        do i = 1, n
            print *, a(i, :)
        end do
    end subroutine
end module

program ex_pascal
    use pascal
    implicit none
    integer :: n
    integer, allocatable :: a(:, :)
    print *, "Size?"
    read *, n
    print *, "Lower Pascal Matrix"
    a = pascal_lower(n)
    call print_matrix(a)
    print *, "Upper Pascal Matrix"
    a = pascal_upper(n)
    call print_matrix(a)
    print *, "Symmetric Pascal Matrix"
    a = pascal_symmetric(n)
    call print_matrix(a)
end program
Task: Long year








VB: Public Sub Main() 
  
  For y As Integer = 2000 To 2100 
    If isLongYear(y) Then Print y, 
  Next
  
End 

Function p(y As Integer) As Integer 
  
  Return (y + (y \ 4) - (y \ 100) + (y \ 400)) Mod 7 
  
End Function 

Function isLongYear(y As Integer) As Boolean 
  
  If p(y) = 4 Then Return True 
  If p(y - 1) = 3 Then Return True 
  Return False 
  
End Function



Fortran: program longyear
    use iso_fortran_env, only: output_unit, input_unit
    implicit none

    integer             :: start, ende, i, counter
    integer, parameter  :: line_break=10

    write(output_unit,*) "Enter beginning of interval"
    read(input_unit,*) start
    write(output_unit,*) "Enter end of interval"
    read(input_unit,*) ende

    if (start>=ende) error stop "Last year must be after first year

    counter = 0
    do i = start, ende
        if (is_long_year(i)) then
            write(output_unit,'(I0,x)', advance="no") i
            counter = counter + 1
            if (modulo(counter,line_break) == 0) write(output_unit,*)
        end if
    end do
contains
    pure function p(year)
        integer, intent(in) :: year
        integer             :: p

        p = modulo(year + year/4 - year/100 + year/400, 7)
    end function p

    pure function is_long_year(year)
        integer, intent(in) :: year
        logical             :: is_long_year

        is_long_year = p(year) == 4 .or. p(year-1) == 3
    end function is_long_year
end program longyear
Task: Validate International Securities Identification Number








VB: 

buf=buf&test("US0378331005")&vbCrLf
buf=buf&test("US0373831005")&vbCrLf
buf=buf&test("U50378331005")&vbCrLf
buf=buf&test("US03378331005")&vbCrLf
buf=buf&test("AU0000XVGZA3")&vbCrLf
buf=buf&test("AU0000VXGZA3")&vbCrLf
buf=buf&test("FR0000988040")&vbCrLf
msgbox buf,,"Validate International Securities Identification Number"

function test(cc)
	dim err,c,r,s,i1,i2
	if len(cc)=12 then
		for i=1 to len(cc)
			p=instr("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ",mid(cc,i,1))
			if p<>0 then c=c&(p-1) else err=1
		next 
		for i=1 to 2
			if instr("ABCDEFGHIJKLMNOPQRSTUVWXYZ",mid(cc,i,1))=0 then err=1 
		next 
		if err=0 then
			for i=len(c) to 1 step -1
				r=r&mid(c,i,1)
			next 
			for i=1 to len(r) step 2
				i1=i1+cint(mid(r,i,1))
			next 
			for i=2 to len(r) step 2
				ii=cint(mid(r,i,1))*2
				if ii>=10 then ii=ii-9
				i2=i2+ii
			next 
			s=cstr(i1+i2)
			if mid(s,len(s),1)="0" then
				msg="valid"
			else
				msg="invalid ??1"
			end if
		else
			msg="invalid ??2"
		end if
	else
		msg="invalid ??3"
	end if
	test=cc&" "&msg
end function 



Fortran: program isin
    use ctype
    implicit none
    character(20) :: test(7) = ["US0378331005        ", &
                                "US0373831005        ", &
                                "U50378331005        ", &
                                "US03378331005       ", &
                                "AU0000XVGZA3        ", &
                                "AU0000VXGZA3        ", &
                                "FR0000988040        "]
    print *, check_isin(test)
contains
    elemental logical function check_isin(a)
        character(*), intent(in) :: a
        integer :: s(24)
        integer :: i, j, k, n, v

        check_isin = .false.

        n = len_trim(a)
        if (n /= 12) return
        
        
        j = 0
        do i = 1, n
            k = iachar(a(i:i))
            if (k >= 48 .and. k <= 57) then
                if (i < 3) return
                k = k - 48
                j = j + 1
                s(j) = k
            else if (k >= 65 .and. k <= 90) then
                if (i == 12) return
                k = k - 65 + 10
                j = j + 1
                s(j) = k / 10
                j = j + 1
                s(j) = mod(k, 10)
            else
                return
            end if
        end do

        
        v = 0
        do i = j - 1, 1, -2
            k = 2 * s(i)
            if (k > 9) k = k - 9
            v = v + k
        end do
        do i = j, 1, -2
            v = v + s(i)
        end do
        
        check_isin = 0 == mod(v, 10)
    end function
end program
Task: Kahan summation








VB: Module Module1

    Function KahanSum(ParamArray fa As Single()) As Single
        Dim sum = 0.0F
        Dim c = 0.0F
        For Each f In fa
            Dim y = f - c
            Dim t = sum + y
            c = (t - sum) - y
            sum = t
        Next
        Return sum
    End Function

    Function Epsilon() As Single
        Dim eps = 1.0F
        While 1.0F + eps <> 1.0F
            eps /= 2.0F
        End While
        Return eps
    End Function

    Sub Main()
        Dim a = 1.0F
        Dim b = Epsilon()
        Dim c = -b
        Console.WriteLine("Epsilon      = {0}", b)
        Console.WriteLine("(a + b) + c  = {0}", (a + b) + c)
        Console.WriteLine("Kahan sum    = {0}", KahanSum(a, b, c))
    End Sub

End Module



Fortran:       FUNCTION SUMC(A,N)
COMPENSATED SUMMATION. C WILL NOT STAY ZERO, DESPITE MATHEMATICS.
       DIMENSION A(12345)
        S = 0.0
        C = 0.0
        DO 1 I = 1,N
          Y = A(I) - C
          T = S + Y
          C = (T - S) - Y
          S = T
    1   CONTINUE
        SUMC = S
      END
      DIMENSION A(3)
      A(1) = 10000.0
      A(2) = 3.14159
      A(3) = 2.71828
      TYPE 1, A(1) + A(2) + A(3)
      TYPE 1, SUMC(A,3)
    1 FORMAT (6HSUM = ,F12.1)
      END
Task: Two identical strings








VB: Imports System.Console
Module Module1
  Sub Main()
    Dim p, c, k, lmt as integer : p = 2 : lmt = 1000
    For n As Integer = 1 to lmt
      p += If(n >= p, p, 0) : k = n + n * p
      If k > lmt Then Exit For Else c += 1
      Write("{0,3} ({1,-10})  {2}", k, Convert.ToString( k, 2),
          If(c Mod 5 = 0, vbLf, ""))
    Next : WriteLine(vbLf + "Found {0} numbers whose base 2 representation is the concatenation of two identical binary strings.", c)
  End Sub
End Module



Fortran:       program IdentStr
          implicit none
          integer n, concat, bits
          
          n = 1
  100     if (concat(n) .lt. 1000) then
              write (*,'(I3,2X,I11)') concat(n), bits(concat(n))
              n = n + 1
              goto 100
          end if
          stop
      end

C     Concatenate binary representation of number with itself      
      integer function concat(num)
          integer num, sl, sr
          sl = num
          sr = num
  100     if (sr .gt. 0) then
              sl = sl * 2
              sr = sr / 2
              goto 100
          end if
          concat = num + sl
      end

C     Calculate binary representation of number
      integer function bits(num)
          integer num, n, bx
          n = num
          bits = 0
          bx = 1
  100     if (n .gt. 0) then
              bits = bits + bx * mod(n,2)
              bx = bx * 10
              n = n / 2
              goto 100
          end if
      end
Task: Verify distribution uniformity_Chi-squared test








VB: Private Function Test4DiscreteUniformDistribution(ObservationFrequencies() As Variant, Significance As Single) As Boolean
    
    Dim Total As Long, Ei As Long, i As Integer
    Dim ChiSquared As Double, DegreesOfFreedom As Integer, p_value As Double
    Debug.Print "[1] ""Data set:"" ";
    For i = LBound(ObservationFrequencies) To UBound(ObservationFrequencies)
        Total = Total + ObservationFrequencies(i)
        Debug.Print ObservationFrequencies(i); " ";
    Next i
    DegreesOfFreedom = UBound(ObservationFrequencies) - LBound(ObservationFrequencies)
    
    Ei = Total / (DegreesOfFreedom + 1)
    For i = LBound(ObservationFrequencies) To UBound(ObservationFrequencies)
        ChiSquared = ChiSquared + (ObservationFrequencies(i) - Ei) ^ 2 / Ei
    Next i
    p_value = 1 - WorksheetFunction.ChiSq_Dist(ChiSquared, DegreesOfFreedom, True)
    Debug.Print
    Debug.Print "   Chi-squared test for given frequencies"
    Debug.Print "X-squared ="; ChiSquared; ", ";
    Debug.Print "df ="; DegreesOfFreedom; ", ";
    Debug.Print "p-value = "; Format(p_value, "0.0000")
    Test4DiscreteUniformDistribution = p_value > Significance
End Function
Public Sub test()
    Dim O() As Variant
    O = [{199809,200665,199607,200270,199649}]
    Debug.Print "[1] ""Uniform? "; Test4DiscreteUniformDistribution(O, 0.05); """"
    O = [{522573,244456,139979,71531,21461}]
    Debug.Print "[1] ""Uniform? "; Test4DiscreteUniformDistribution(O, 0.05); """"
End Sub



Fortran: module gsl_mini_bind_m

    use iso_c_binding
    implicit none
    private

    public :: p_value

    interface
        function gsl_cdf_chisq_q(x, nu) bind(c, name='gsl_cdf_chisq_Q')
            import
            real(c_double), value :: x
            real(c_double), value :: nu
            real(c_double) :: gsl_cdf_chisq_q
        end function gsl_cdf_chisq_q
    end interface

contains

    
    real function p_value(x, df)
        real, intent(in) :: x
        integer, intent(in) :: df

        p_value = real(gsl_cdf_chisq_q(real(x, c_double), real(df, c_double)))

    end function p_value

end module gsl_mini_bind_m
Task: CSV to HTML translation








VB: Public Sub CSV_TO_HTML()
    input_ = "Character,Speech\n" & _
        "The multitude,The messiah! Show us the messiah!\n" & _
        "Brians mother,<angry>Now you listen here! He
            "he
        "The multitude,Who are you?\n" & _
        "Brians mother,I
        "The multitude,Behold his mother! Behold his mother!"
     
    Debug.Print "<table>" & vbCrLf & "<tr><td>"
    For i = 1 To Len(input_)
        Select Case Mid(input_, i, 1)
            Case "\"
                If Mid(input_, i + 1, 1) = "n" Then
                    Debug.Print "</td></tr>" & vbCrLf & "<tr><td>";
                    i = i + 1
                Else
                    Debug.Print Mid(input_, i, 1);
                End If
            Case ",": Debug.Print "</td><td>";
            Case "<": Debug.Print "&lt;";
            Case ">": Debug.Print "&gt;";
            Case "&": Debug.Print "&amp;";
            Case Else: Debug.Print Mid(input_, i, 1);
        End Select
    Next i
    Debug.Print "</td></tr>" & vbCrLf & "</table>"
End Sub



Fortran:       SUBROUTINE CSVTEXT2HTML(FNAME,HEADED)	
Converts without checking field counts, or noting special characters.
       CHARACTER*(*) FNAME	
       LOGICAL HEADED		
       INTEGER MANY		
       PARAMETER (MANY=666)	
       CHARACTER*(MANY) ALINE	
       INTEGER MARK(0:MANY + 1)	
       INTEGER I,L,N		
       CHARACTER*2 WOT(2)	
       PARAMETER (WOT = (/"th","td"/))	
       INTEGER IT		
       INTEGER KBD,MSG,IN		
       COMMON /IOUNITS/ KBD,MSG,IN	
        OPEN(IN,FILE=FNAME,STATUS="OLD",ACTION="READ",ERR=661)	
        WRITE (MSG,1)			
    1   FORMAT ("<Table border=1>")	
        MARK(0) = 0		
        N = 0			

   10   READ (IN,11,END = 20) L,ALINE(1:MIN(L,MANY))	
   11   FORMAT (Q,A)		
        N = N + 1		
        IF (L.GT.MANY) THEN	
          WRITE (MSG,12) N,L,MANY	
   12     FORMAT ("Line ",I0," has length ",I0,"
          L = MANY			
        END IF			
        IF (N.EQ.1 .AND. HEADED) THEN	
          WRITE (MSG,*) "<tHead>"	
          IT = 1			
         ELSE				
          IT = 2			
        END IF			
        NCOLS = 0		
        DO I = 1,L		
          IF (ICHAR(ALINE(I:I)).EQ.ICHAR(",")) THEN	
            NCOLS = NCOLS + 1		
            MARK(NCOLS) = I		
          END IF			
        END DO			
        NCOLS = NCOLS + 1	
        MARK(NCOLS) = L + 1	
        WRITE (MSG,13)		
     1   (WOT(IT),				
     2    ALINE(MARK(I - 1) + 1:MARK(I) - 1),	
     3    WOT(IT),				
     4    I = 1,NCOLS),			
     5   "/tr"			
   13   FORMAT (" <tr>",666("<",A,">",A,"</",A,">"))	
        IF (N.EQ.1 .AND. HEADED) WRITE (MSG,*) "</tHead>"	
        GO TO 10		

   20   CLOSE (IN)		
        WRITE (MSG,21)		
   21   FORMAT ("</Table>")	
       RETURN			
Confusions.
  661   WRITE (MSG,*) "Can't open file ",FNAME	
      END			

      INTEGER KBD,MSG,IN
      COMMON /IOUNITS/ KBD,MSG,IN
      KBD = 5	
      MSG = 6	
      IN = 10	

      CALL CSVTEXT2HTML("Text.csv",.FALSE.)	
      WRITE (MSG,*)
      CALL CSVTEXT2HTML("Text.csv",.TRUE.)	
      END
Task: Pythagorean triples








VB: Dim total As Variant, prim As Variant, maxPeri As Variant
Private Sub newTri(s0 As Variant, s1 As Variant, s2 As Variant)
    Dim p As Variant
    p = CDec(s0) + CDec(s1) + CDec(s2)
    If p <= maxPeri Then
        prim = prim + 1
        total = total + maxPeri \ p
        newTri s0 + 2 * (-s1 + s2), 2 * (s0 + s2) - s1, 2 * (s0 - s1 + s2) + s2
        newTri s0 + 2 * (s1 + s2), 2 * (s0 + s2) + s1, 2 * (s0 + s1 + s2) + s2
        newTri -s0 + 2 * (s1 + s2), 2 * (-s0 + s2) + s1, 2 * (-s0 + s1 + s2) + s2
      End If
End Sub
Public Sub Program_PythagoreanTriples()
    maxPeri = CDec(100)
    Do While maxPeri <= 10000000#
        prim = CDec(0)
        total = CDec(0)
        newTri 3, 4, 5
        Debug.Print "Up to "; maxPeri; ": "; total; " triples, "; prim; " primitives."
        maxPeri = maxPeri * 10
    Loop
End Sub



Fortran: module triples
  implicit none
  
  integer :: max_peri, prim, total
  integer :: u(9,3) = reshape((/ 1, -2, 2,  2, -1, 2,  2, -2, 3, &
                                 1,  2, 2,  2,  1, 2,  2,  2, 3, &
                                -1,  2, 2, -2,  1, 2, -2,  2, 3 /), &
                                (/ 9, 3 /))
                                
contains

recursive subroutine new_tri(in)
  integer, intent(in) :: in(:)
  integer :: i
  integer :: t(3), p

  p = sum(in)
  if (p > max_peri) return

  prim = prim + 1
  total = total + max_peri / p
  do i = 1, 3
    t(1) = sum(u(1:3, i) * in)
    t(2) = sum(u(4:6, i) * in)
    t(3) = sum(u(7:9, i) * in)
    call new_tri(t);
  end do
end subroutine new_tri
end module triples

program Pythagorean
  use triples
  implicit none

  integer :: seed(3) = (/ 3, 4, 5 /)
  
  max_peri = 10
  do
    total = 0
    prim = 0
    call new_tri(seed)
    write(*, "(a, i10, 2(i10, a))") "Up to", max_peri, total, " triples",  prim, " primitives"
    if(max_peri == 100000000) exit
    max_peri = max_peri * 10
  end do
end program Pythagorean
Task: Call a foreign-language function








VB:   Declare Function CreateFileW Lib "Kernel32" (FileName As WString, DesiredAccess As Integer, ShareMode As Integer, SecurityAttributes As Integer, _
        CreateDisposition As Integer, Flags As Integer, Template As Integer) As Integer
  Declare Function WriteFile Lib "Kernel32" (fHandle As Integer, writeData As Ptr, numOfBytes As Integer, ByRef numOfBytesWritten As Integer, _
        overlapped As Ptr) As Boolean
  Declare Function GetLastError Lib "Kernel32" () As Integer
  Declare Function CloseHandle Lib "kernel32" (hObject As Integer) As Boolean
  
  Const FILE_SHARE_READ = &h00000001
  Const FILE_SHARE_WRITE = &h00000002
  Const OPEN_EXISTING = 3
  
  Dim fHandle As Integer = CreateFileW("C:\foo.txt", 0,  FILE_SHARE_READ Or FILE_SHARE_WRITE, 0, OPEN_EXISTING, 0, 0)
  If fHandle > 0 Then
    Dim mb As MemoryBlock = "Hello, World!"
    Dim bytesWritten As Integer
    If Not WriteFile(fHandle, mb, mb.Size, bytesWritten, Nil) Then
      MsgBox("Error Number: " + Str(GetLastError))
    End If
    Call CloseHandle(fHandle)
  Else
    MsgBox("Error Number: " + Str(GetLastError))
  End If



Fortran: module c_api
    use iso_c_binding
    implicit none

    interface
        function strdup(ptr) bind(C)
            import c_ptr
            type(c_ptr), value :: ptr
            type(c_ptr) :: strdup
        end function
    end interface
    
    interface
        subroutine free(ptr) bind(C)
            import c_ptr
            type(c_ptr), value :: ptr
        end subroutine
    end interface
    
    interface
        function puts(ptr) bind(C)
            import c_ptr, c_int
            type(c_ptr), value :: ptr
            integer(c_int) :: puts
        end function
    end interface
end module

program c_example
    use c_api
    implicit none

    character(20), target :: str = "Hello, World
    type(c_ptr) :: ptr
    integer(c_int) :: res
    
    ptr = strdup(c_loc(str))
    
    res = puts(c_loc(str))
    res = puts(ptr)
    
    print *, transfer(c_loc(str), 0_c_intptr_t), &
             transfer(ptr, 0_c_intptr_t)
    call free(ptr)
end program
Task: Extensible prime generator








VB: Option Explicit

Sub Main()
Dim Primes() As Long, n As Long, temp$
Dim t As Single
    t = Timer
    
    n = 133218295 
    Primes = ListPrimes(n)
    Debug.Print "For N = " & Format(n, "#,##0") & ", execution time : " & _
        Format(Timer - t, "0.000 s") & ", " & _
        Format(UBound(Primes) + 1, "#,##0") & " primes numbers."
    
    
    For n = 0 To 19
        temp = temp & ", " & Primes(n)
    Next
    Debug.Print "First twenty primes : "; Mid(temp, 3)
    
    n = 0: temp = vbNullString
    Do While Primes(n) < 100
        n = n + 1
    Loop
    Do While Primes(n) < 150
        temp = temp & ", " & Primes(n)
        n = n + 1
    Loop
    Debug.Print "Primes between 100 and 150 : " & Mid(temp, 3)
    
    Dim ccount As Long
    n = 0
    Do While Primes(n) < 7700
        n = n + 1
    Loop
    Do While Primes(n) < 8000
        ccount = ccount + 1
        n = n + 1
    Loop
    Debug.Print "Number of primes between 7,700 and 8,000 : " & ccount
    
    n = 1
    Do While n <= 100000
        n = n * 10
        Debug.Print "The " & n & "th prime: "; Format(Primes(n - 1), "#,##0")
    Loop
    Debug.Print "VBA has a limit in array
    Debug.Print "With my computer, the limit for an array of Long is : 133 218 295"
    Debug.Print "The last prime I could find is the : " & _
        Format(UBound(Primes), "#,##0") & "th, Value : " & _
        Format(Primes(UBound(Primes)), "#,##0")
End Sub

Function ListPrimes(MAX As Long) As Long()
Dim t() As Boolean, L() As Long, c As Long, s As Long, i As Long, j As Long
    ReDim t(2 To MAX)
    ReDim L(MAX \ 2)
    s = Sqr(MAX)
    For i = 3 To s Step 2
        If t(i) = False Then
            For j = i * i To MAX Step i
                t(j) = True
            Next
        End If
    Next i
    L(0) = 2
    For i = 3 To MAX Step 2
        If t(i) = False Then
            c = c + 1
            L(c) = i
        End If
    Next i
    ReDim Preserve L(c)
    ListPrimes = L
End Function



Fortran:       DO WHILE(F*F <= LST)         
      DO WHILE(F <= LST/F)                      
      DO WHILE(F <= (IST + 2*(SBITS - 1))/F)    
      DO WHILE(F <= IST/F + (MOD(IST,F) + 2*(SBITS - 1))/F)
Task: Gray code








VB: Function Encoder(ByVal n)
    Encoder = n Xor (n \ 2)
End Function

Function Decoder(ByVal n)
    Dim g : g = 0
    Do While n > 0
       g = g Xor n
       n = n \ 2
    Loop
    Decoder = g
End Function


Function Dec2bin(ByVal n, ByVal length)
    Dim i, strbin : strbin = ""
    For i = 1 to 5
        strbin = (n Mod 2) & strbin
        n = n \ 2
    Next
    Dec2Bin = strbin
End Function

WScript.StdOut.WriteLine("Binary -> Gray Code -> Binary")
For i = 0 to 31
    encoded = Encoder(i)
    decoded = Decoder(encoded)
    WScript.StdOut.WriteLine(Dec2Bin(i, 5) & " -> " & Dec2Bin(encoded, 5) & " -> " & Dec2Bin(decoded, 5))
Next



Fortran:       PROGRAM GRAY
      IMPLICIT NONE
      INTEGER IGRAY,I,J,K
      CHARACTER*5 A,B,C
      DO 10 I=0,31
      J=IGRAY(I,1)
      K=IGRAY(J,-1)
      CALL BINARY(A,I,5)
      CALL BINARY(B,J,5)
      CALL BINARY(C,K,5)
      PRINT 99,I,A,B,C,K
   10 CONTINUE
   99 FORMAT(I2,3H : ,A5,4H => ,A5,4H => ,A5,3H : ,I2)
      END

      FUNCTION IGRAY(N,D)
      IMPLICIT NONE
      INTEGER D,K,N,IGRAY
      IF(D.LT.0) GO TO 10
      IGRAY=IEOR(N,ISHFT(N,-1))
      RETURN
   10 K=N
      IGRAY=0
   20 IGRAY=IEOR(IGRAY,K)
      K=K/2
      IF(K.NE.0) GO TO 20
      END

      SUBROUTINE BINARY(S,N,K)
      IMPLICIT NONE
      INTEGER I,K,L,N
      CHARACTER*(*) S
      L=LEN(S)
      DO 10 I=0,K-1
C The following line may replace the next block-if,
C on machines using ASCII code :
C     S(L-I:L-I)=CHAR(48+IAND(1,ISHFT(N,-I)))
C On EBCDIC machines, use 240 instead of 48.
      IF(BTEST(N,I)) THEN
      S(L-I:L-I)='1'
      ELSE
      S(L-I:L-I)='0'
      END IF
   10 CONTINUE
      S(1:L-K)=''
      END
Task: Flow-control structures








VB:   Sub bar2()
      Dim x = 0
      GoTo label
      x = 5
label:
      Console.WriteLine(x)
  End Sub



Fortran:       ...
      ASSIGN 1101 to WHENCE   
      GO TO 1000              
 1101 CONTINUE                
      ... 
      ASSIGN 1102 to WHENCE   
      GO TO 1000              
 1102 CONTINUE                
      ...
Common code, far away.
 1000 do something            
      GO TO WHENCE