fortran 作业10
作业10 <br/>
question2
PROGRAM A10Q2
IMPLICIT NONE
INTEGER::n,i,j, prime, check
INTEGER, DIMENSION(:), ALLOCATABLE :: items
INTEGER, DIMENSION(:), ALLOCATABLE :: nozItems
DO
PRINT *,''
PRINT *,'Enter a number for finding the prime: '
READ *,n;
ALLOCATE (items(n),nozItems(n));
DO i=2,n
items(i)=i
END DO
prime= 2
DO WHILE (prime<=n**0.5)
DO i=prime+1,n
IF (MOD(items(i),prime)==0) THEN
items(i)=0
END IF
END DO
prime = prime + 1
DO WHILE (items(prime)==0 .AND. prime <n**0.5)
prime = prime + 1
END DO
END DO
j=1
DO i=2,n
IF (items(i)/=0) THEN
nozItems(j)=items(i)
j=j+1
END IF
END DO
write(6,1) (nozItems(i),i=1,j-1)
1 format(3x,10i7/)
DEALLOCATE (items,nozItems);
END DO
END PROGRAM A10Q2
fortran 作业9
A9Q1
PROGRAM A9Q1
IMPLICIT NONE
CHARACTER(len =300):: string
INTEGER :: m, n
DO
PRINT *, "ENTER INTEGER NUMBER (N):"
READ *, n
PRINT *, "ENTER MAXIMUM NUMBER OF CHARACTER (M): "
READ *, m
IF (( m .EQ. 0) .and. (n .EQ. 0)) STOP
string = " "
PRINT *,"Result: ", Convert(n, string, m)
PRINT *,"String format: ", string
END DO
CONTAINS
INTEGER FUNCTION Convert(n, t, m)
CHARACTER(len=300), INTENT(INOUT) :: t
INTEGER, INTENT(INOUT) :: m, n
CHARACTER(200) :: buffer
INTEGER :: i, pos !- keeps the position
REAL :: r
r = n * 1.0
IF (r .NE. 0) THEN
!- finding the number of digits of n
r = LOG(r) / LOG(10.0)
convert = FLOOR(r)+1
!- writing the integer n into a seies of characters
write(buffer,"(I15)") n
IF (m .GE. convert) THEN
DO i = 1,Convert
read (buffer, *) t(i:i)
pos = INDEX(buffer, t(i:i))
buffer(pos : pos)=" "
END DO
ELSE
DO i = 1, m
t(i:i)="*"
END DO
Convert = m
END IF
ELSE
t = "0"
Convert = m
END IF
END FUNCTION
END PROGRAM
A9Q2
program A9Q2
IMPLICIT NONE
! DECLARING VARIABLES
INTEGER, DIMENSION(:,:), ALLOCATABLE :: A
INTEGER :: i, j
INTEGER :: size, check, m, k, totalSum, result
DO
PRINT *, "ENTER SIZE OF THE MATRIX (OR 0 to EXIT PROGRAM):"
READ *, size
IF (size .eq. 0 .or. size .eq. 0) STOP
IF (size .lt. 0 .or. size .lt. 0) THEN
PRINT *, "NEGATIVE NUMBER OF ELEMENTS"
ELSE
ALLOCATE(A(size, size))
PRINT *, "Enter values in matrix: "
READ *, (A(i,1:size), i=1,size)
PRINT *, "Testing Matrix is: "
totalSum = 0
DO i = 1,size
PRINT "(5X,15I5)", A(i,1:size)
END DO
PRINT *, "ENTER THE STARTING AND ENDING PATH : "
READ *, m, k
result = ShortestPath(A, size, m, k)
DEALLOCATE(A)
END IF
END DO
CONTAINS
! Shortest path function will find the value
! and find the sequence of shortest path
INTEGER FUNCTION ShortestPath (A,n,m,k)
INTEGER, DIMENSION(n,n), INTENT(IN) :: A
INTEGER, DIMENSION(n) :: B
INTEGER, DIMENSION(n) :: C
INTEGER, INTENT(IN) :: n, m, k
INTEGER :: i, j, o, temp
! GET THE TOTAL SUM OF A
totalSum = 0
DO i = 1, size
DO j = 1, size
totalSum = totalSum + A(i, j)
END DO
END DO
! INTILIZE B[1] = 0
B(1) = 0
DO i = 2, size
B(i) = totalSum + 1
END DO
DO o = 1, SIZE
DO i = 2, size
DO j = 1, SIZE
IF (A(i, j) .NE. 0) THEN
! GET THE MINIMUM VALUE OF AFTER ADDING A every row
! with B array value
! and update the B array value depending on their
! minimum value
IF (j .EQ. 1) THEN
B(i) = min(A(i, j) + B(j), A(i, j+1) + B(j+1))
ELSE
B(i) = min(B(i), A(i, j) + B(j))
END IF
END IF
END DO
END DO
END DO
! USE FOR GETTING THE ARRAY INDEX
DO i = 1, size
C(i) = i
END DO
! ORDER THE ARRAY AND GET THEIR
DO i = 1, size
DO j = i + 1, size
IF (B(C(j)) < B(C(i))) THEN
temp = C(i)
C(i) = C(j)
C(j) = temp
END IF
END DO
END DO
PRINT *,"Shortest Path value", B(k)
PRINT *,"Shortest Path from m to k is: ", C
ShortestPath = B(k)
END FUNCTION ShortestPath
end program A9Q2fortran 作业8
作业8
Question 1
PROGRAM GREATESTCOMMONDIVISOR
! -----------------------------------------------------------------------------
! this a program which read a pair of integer numbers and uses GCD(a,b) to find
! the greatest common divisor for each pair until a pair of zeros is entered
! indicate the end of data
! -----------------------------------------------------------------------------
IMPLICIT NONE
! Declaring variables
INTEGER :: b, result
INTEGER, DIMENSION(:), ALLOCATABLE :: A
INTEGER :: i, j, k, size, check
DO
! read two positive number
PRINT *, "ENTER ARRAY SIZE: (O TO STOP THE PROGRAM)"
READ *, size
IF(size .eq. 0) THEN
PRINT *, "PROGRAM EXIT"
EXIT
ELSE IF(size .lt. 0) THEN
PRINT *, "ARRAY INDEX NEVER BE NEGATIVE."
ELSE
ALLOCATE(A(size), STAT=check)
PRINT *, "ENTER ARRAY VALUES: "
READ *, A
result = A(1)
DO i = 2, size
result = GCD2(A(i), result)
END DO
PRINT *, result;
DEALLOCATE(A)
END IF
END DO
CONTAINS
INTEGER RECURSIVE FUNCTION GCD2(m, n) RESULT(res)
IMPLICIT NONE
INTEGER, INTENT(IN) :: m, n
! temp will used for swaping value
if (m == 0) THEN
res = n
ELSE
res = gcd2(MOD(n,m), m)
END IF
END FUNCTION GCD2
END PROGRAM GREATESTCOMMONDIVISOR
question2
PROGRAM CyclicGraphs1
!---------------------------------------------------------------------------
! Directed graph is entered as adjacency lists (using a char variable) and
! represented as an adjacency matrix to find the shortest cycle for a node
!---------------------------------------------------------------------------
IMPLICIT NONE
CHARACTER(80) :: X
INTEGER, DIMENSION(:,:), ALLOCATABLE :: A
INTEGER :: i,j,k,m,n,check, count
LOGICAL :: connected
connected = .false.
DO
PRINT *, "enter n (or 0 to stop):"
READ *, n
IF (n .eq. 0) STOP
IF (n .lt. 0) THEN
PRINT *, "incorrect value of n"
ELSE
ALLOCATE (A(n,n),STAT=check)
IF (check .ne. 0) THEN
PRINT *, "unsuccessful ALLOCATE"
ELSE
A = 0
PRINT *, "enter the graph, node after node:"
DO i = 1,n
READ "(A)", X
READ (X,*) j
m = INDEX(X,':')
DO WHILE (m .gt. 0)
X(m:m) = ' '
READ (X(m:),*) j
A(i,j) = 1
m = INDEX(X, ',')
END DO
END DO
END IF
! print the adjacent matrix
PRINT *, "the adjacency matrix is: "
DO i = 1,n
PRINT "(5X,15I5)", A(i,1:n)
END DO
! call the logical function Conn
connected = CONN(A, n)
IF (connected) THEN
PRINT *, "This graph is strongly connected."
ELSE
PRINT *, "This graph is not strongly connected."
END IF
END IF
END DO
CONTAINS
LOGICAL FUNCTION CONN(A,n)
INTEGER, DIMENSION(n, n), INTENT(IN) :: A
INTEGER, INTENT(IN) :: n
INTEGER :: i, j, k, count
LOGICAL :: strong
strong = .false.
DO i = 1, n
count = 0
! check every column for single node and looking for 1
DO j = 1, n
IF (A(i, j) == 1) THEN
count = count + 1
END IF
END DO
! check every row for single node and looking for 1
DO k = 1, n
IF (A(k, i) == 1) THEN
count = count + 1
END IF
END DO
! if the counting value is size - 1 then we will sure that
! it can travarse every nodes
IF (count == n - 1) THEN
strong = .true.
END IF
END DO
CONN = strong
END FUNCTION CONN
END PROGRAM CyclicGraphs1fortran 作业7
question1
!------------------------------------------------------------------------
! The fortran subroutine CSRorCSC(R,C,V, n, nz) which converts
! the CSR representation of a sparse matrix to its CSC representation
!-------------------------------------------------------------------------
! Also a program which enters a sparse matrix (in the COO format) and
! creates its CSR Representation, invokes the CSRorCSC Subroutine and
! output the result.
!-------------------------------------------------------------------------
PROGRAM A7Q1
IMPLICIT NONE
! DECLARE VARIABLES
INTEGER, DIMENSION(:,:), ALLOCATABLE :: A
INTEGER, DIMENSION(3) :: B
INTEGER :: i, j, size, m, n, check, k, rowIndex, loop, columnIndex, temp
INTEGER :: zero, nonzero
! R, C, V
INTEGER, DIMENSION(:), ALLOCATABLE :: D
INTEGER, DIMENSION(:), ALLOCATABLE :: R
INTEGER, DIMENSION(:), ALLOCATABLE :: C
INTEGER, DIMENSION(:), ALLOCATABLE :: V
INTEGER, DIMENSION(:), ALLOCATABLE :: R1
INTEGER, DIMENSION(:), ALLOCATABLE :: C1
INTEGER, DIMENSION(:), ALLOCATABLE :: V1
! GET THE SPARSE MATRIX IN COO FORMAT
DO
PRINT *, "ENTER THE (SIZE OF MATRIX) m and n (OR 0 0 to END): "
READ *, m ,n
IF (m .eq. 0 .or. n .eq. 0) STOP
IF (m .lt. 0 .or. n .lt. 0) THEN
PRINT *, "NEGATIVE NUMBER OF ELEMENTS: "
ELSE
! ALLOCATE THE ARRAY A
ALLOCATE(A(m,n))
PRINT "(1X, 'ENTER THE MATRIX VALUES OF A', I3, '*', I3, ' ELEMENTS:')", m, n
READ *, ((A(i, j), i = 1, m), j = 1, n)
! DISPLAY USER INPUT (LATER WE WILL USE THE FORMATTING.)
PRINT *, "COO FORMAT : "
DO i = 1,m
PRINT "(5X,15I5)", A(i,1:n)
END DO
! CSRorCSC FORMAT
size = 1
DO i = 1, m
DO j = i, n
IF (A(i, j) /= 0) THEN
size = size + 1
END IF
END DO
END DO
PRINT *, size ! 8 for demo sparse matrix
! ALLOCATING R, C, V
ALLOCATE(D(m), STAT = check)
ALLOCATE(R(size), STAT = check)
ALLOCATE(C(size), STAT = check)
ALLOCATE(V(size), STAT = check)
ALLOCATE(C1(m), STAT = check)
ALLOCATE(R1(size), STAT = check)
ALLOCATE(V1(size), STAT = check)
! GETTING THE R,C,V FOR CSR
k = 1
rowIndex = 0
nonzero = 0
zero = 0
DO i = 1, m
DO j = 1, n
IF (A(i, j) /= 0) THEN
R(k) = i
rowIndex = rowIndex + 1
C(k) = j
V(k) = A(i, j)
k = k + 1
END IF
END DO
D(i) = rowIndex
END DO
PRINT *, "CSR FORMAT: "
PRINT *, "R: ", D
PRINT *, "C: ", C
PRINT *, "V: ", V
CALL CSRorCSC(R, C, V, size, nonzero);
END IF
END DO
CONTAINS
SUBROUTINE CSRorCSC (R,C,V,n,nz)
INTEGER, DIMENSION(n), INTENT(INOUT) :: R
INTEGER, DIMENSION(n), INTENT(INOUT) :: C
INTEGER, DIMENSION(n), INTENT(INOUT) :: V
INTEGER, INTENT(IN) :: n, nz
PRINT *, "CSC FORMAT: "
!-------------------------------------------------
columnIndex = 0
k = 1
DO i = 1, m
DO j = 1, size
IF(i .eq. C(j)) THEN
V1(k) = V(j)
columnIndex = columnIndex + 1
R1(k) = R(j)
k = k + 1
END IF
END DO
C1(i) = columnIndex
END DO
PRINT *,"C: ", C1
PRINT *,"R: ", R1
PRINT *,"V: ", V1
PRINT *, "CSR FORMAT: "
!-------------------------------------------------
rowIndex = 0
k = 1
DO i = 1, m
DO j = 1, size
IF(i .eq. R(j)) THEN
V(k) = V1(j)
rowIndex = rowIndex + 1
R(k) = R1(j)
k = k + 1
END IF
END DO
D(i) = rowIndex
END DO
PRINT *,"R: ", D
PRINT *,"C: ", C
PRINT *,"V: ", V
END SUBROUTINE CSRorCSC
END PROGRAM A7Q1
question2
PROGRAM A7Q2
IMPLICIT NONE
INTEGER, DIMENSION(:), ALLOCATABLE :: R1,C1,V1,R2,C2,V2,R3,C3,V3
INTEGER ::n,nz1,nz2,n3,myresult
n=-1
nz1=-1
nz2=-1
n3=-1
DO WHILE (n<1) !-- Keeps asking for positive array size
PRINT *, "Enter the size of matrix n*n, n: "
READ *, n
END DO
DO WHILE ((nz1<1).or.(nz1.gt.(n*n))) !-- nz1 should be less than n*n
PRINT *, "For matrix 1 enter the number of non-zero elements , nz1: "
READ *, nz1
END DO
DO WHILE ((nz2<0).or.(nz2.gt.(n*n))) !-- nz1 should be less than n*n
PRINT *, "For matrix 2 enter the number of non-zero elements , nz2: "
READ *, nz2
END DO
DO WHILE (n3<0) !-- Keeps asking for positive array size
PRINT *, "For matrix 3 enter your estimation, n3: "
READ *, n3
END DO
ALLOCATE(R1(n),R2(n),R3(n))
ALLOCATE(C1(nz1),C2(nz2),C3(n3))
ALLOCATE(V1(nz1),V2(nz2),V3(n3))
!-Reading matrices
PRINT *," ========== Enter matrices in CSR format ==========="
PRINT *,"For matrix 1, enter row index: "
READ *, R1
PRINT *,"For matrix 1, enter column index: "
READ *, C1
PRINT *,"For matrix 1, enter value array: "
READ *, V1
PRINT *,"For matrix 2, enter row index: "
READ *, R2
PRINT *,"For matrix 2, enter column index: "
READ *, C2
PRINT *,"For matrix 2, enter value array: "
READ *, V2
PRINT *," ========== The result in CSR format ==========="
myresult=SparseAdd(R1,C1,V1,R2,C2,V2,R3,C3,V3,n,nz1,nz2,n3)
IF (myresult.gt.0) THEN
PRINT *," The matrix C row index is:",R3
PRINT *," The matrix C column index is:", C3(1:myresult)
PRINT *," The matrix C value array is:", V3(1:myresult)
ELSE IF(myresult.eq.0) THEN
PRINT *," The matrix C has no none-zero element"
ELSE
PRINT *," The matrix C is too small for the result"
END IF
DEALLOCATE(R1,C1,V1,R2,C2,V2,R3,C3,V3)
CONTAINS
!-- the main function
INTEGER FUNCTION SparseAdd(R1,C1,V1,R2,C2,V2,R3,C3,V3,n,nz1,nz2,n3)
INTEGER, DIMENSION(:), INTENT(INOUT)::R3,C3,V3
INTEGER, DIMENSION(:), INTENT(INOUT)::R1,C1,V1,R2,C2,V2
INTEGER, DIMENSION(n,n)::BigC3 !-- a n*n matrix which stores the whole matrix C
INTEGER, DIMENSION(nz1)::RCOO1 !-- Row index for matrix 1 in COO format
INTEGER, DIMENSION(nz2)::RCOO2 !-- Row index for matrix 2 in COO format
INTEGER, DIMENSION(n3)::RCOO3 !-- Row index for matrix 3 in COO format
INTEGER, INTENT(IN):: n,nz1,nz2,n3
INTEGER :: i,j,k
SparseAdd=0
R3=0
C3=0
V3=0
!-- Converting CSR format to COO to add them
CALL CSRtoCOO(RCOO1,R1,n,nz1)
CALL CSRtoCOO(RCOO2,R2,n,nz2)
BigC3=0
!-- Adding two matrices to make BigC3 which is a 2D matrix
DO i=1, nz1
BigC3(RCOO1(i),C1(i))=BigC3(RCOO1(i),C1(i))+ V1(i)
END DO
DO i=1, nz2
BigC3(RCOO2(i),C2(i))=BigC3(RCOO2(i),C2(i))+ V2(i)
END DO
!-- Checking to see if none-zero elements of BigC3 exceeds n3 or not
DO i=1,n
Do j=1,n
IF (BigC3(i,j).ne.0) SparseAdd=SparseAdd+1
END DO
END DO
IF (SparseAdd.le.n3) THEN
!- Making CSR out of BigC3
!-- Forming R
DO i=1,n
IF(i.ne.1) R3(i)=R3(i-1)
Do j=1,n
IF (BigC3(i,j).ne.0) R3(i)=R3(i)+1
END DO
END DO
!-- Creating C3
k=0
DO i=1,n
DO j=1,n
IF (BigC3(i,j).ne.0) THEN
k=k+1
C3(k)=j
END IF
END DO
END DO
!-- Producing V3
k=0
DO i=1,n
DO j=1,n
IF (BigC3(i,j).ne.0) THEN
k=k+1
V3(k)=BigC3(i,j)
END IF
END DO
END DO
ELSE
SparseAdd=-1
END IF
END FUNCTION SparseAdd
!-------------------------------------------------------
!-- helper subroutine to convert CSR to COO
SUBROUTINE CSRtoCOO(RowCOO,RowCSR,n,nz)
INTEGER, DIMENSION(:), INTENT(INOUT) :: RowCOO,RowCSR
INTEGER, INTENT(IN):: n ,nz
INTEGER :: i, j, b
DO j=1,n
IF (j==1) THEN
b=1
ELSE
b=RowCSR(j-1)+1
END IF
DO i = b, RowCSR(j)
RowCOO(i)=j
END DO
END DO
END SUBROUTINE CSRtoCOO
END PROGRAM A7Q2
fortran 作业7
作业6
Question1
!------------------------------------------------------------------------
! The fortran subroutine CSRorCSC(R,C,V, n, nz) which converts
! the CSR representation of a sparse matrix to its CSC representation
!-------------------------------------------------------------------------
! Also a program which enters a sparse matrix (in the COO format) and
! creates its CSR Representation, invokes the CSRorCSC Subroutine and
! output the result.
!-------------------------------------------------------------------------
PROGRAM A7Q1
IMPLICIT NONE
! DECLARE VARIABLES
INTEGER, DIMENSION(:,:), ALLOCATABLE :: A
INTEGER, DIMENSION(3) :: B
INTEGER :: i, j, size, m, n, check, k, rowIndex
! R, C, V
INTEGER, DIMENSION(:), ALLOCATABLE :: DUMMY
INTEGER, DIMENSION(:), ALLOCATABLE :: R
INTEGER, DIMENSION(:), ALLOCATABLE :: C
INTEGER, DIMENSION(:), ALLOCATABLE :: V
! GET THE SPARSE MATRIX IN COO FORMAT
DO
PRINT *, "ENTER THE (SIZE OF MATRIX) m and n (OR 0 0 to END): "
READ *, m ,n
IF (m .eq. 0 .or. n .eq. 0) STOP
IF (m .lt. 0 .or. n .lt. 0) THEN
PRINT *, "NEGATIVE NUMBER OF ELEMENTS: "
ELSE
! ALLOCATE THE ARRAY A
ALLOCATE(A(m,n))
PRINT "(1X, 'ENTER THE MATRIX VALUES OF A', I3, '*', I3, ' ELEMENTS:')", m, n
READ *, ((A(i, j), i = 1, m), j = 1, n)
! DISPLAY USER INPUT (LATER WE WILL USE THE FORMATTING.)
PRINT *, "COO FORMAT : "
DO i = 1,m
PRINT "(5X,15I5)", A(i,1:n)
END DO
! CSRorCSC FORMAT
size = 1
DO i = 1, m
DO j = i, n
IF (A(i, j) /= 0) THEN
size = size + 1
END IF
END DO
END DO
PRINT *, size ! 8 for demo sparse matrix
! ALLOCATING R, C, V
ALLOCATE(DUMMY(size), STAT = check)
ALLOCATE(R(m), STAT = check)
ALLOCATE(C(size), STAT = check)
ALLOCATE(V(size), STAT = check)
! GETTING THE R,C,V FOR CSR
k = 1
rowIndex = 0
DO i = 1, m
DO j = 1, n
IF (A(i, j) /= 0) THEN
DUMMY(k) = i
rowIndex = rowIndex + 1
C(k) = j
V(k) = A(i, j)
k = k + 1
END IF
END DO
R(i) = rowIndex
END DO
PRINT *, "CSR FORMAT: "
PRINT *, "R: ", DUMMY
PRINT *, "R: ", R
PRINT *, "C: ", C
PRINT *, "V: ", V
END IF
END DO
END PROGRAM A7Q1fortran 作业6
question1
PROGRAM A6Q2
!-------------------------------------------------
! finding order depending on the array index
!-------------------------------------------------
IMPLICIT NONE
INTEGER, DIMENSION(:), ALLOCATABLE :: A
INTEGER :: n, check, result
PRINT *, "ENTER THE ARRAY SIZE (n) : "
READ *, n
DO
IF (n .EQ. 0) EXIT
IF (n .LT. 0) THEN
PRINT *, "ARRAY CANNOT BE NEGATIVE"
ELSE
ALLOCATE(A(n), STAT=check)
PRINT *, "ENTER ARRAY ELEMENTS : "
READ *, A
result = FindOrder(A, n)
PRINT *, "Order depending on Array index: ", A
DEALLOCATE(A)
END IF
END DO
CONTAINS
INTEGER FUNCTION FindOrder(A, n)
INTEGER, DIMENSION(:), INTENT(INOUT) :: A
INTEGER, INTENT(IN) :: n
INTEGER, DIMENSION(n) :: temp
INTEGER :: i,j
DO i = 1, n
! here we check temp array have any value at index i
! if the index of i greater than index of i great that temp index item
! we move the item to next index
IF ((temp(A(i)) .gt. 0) .and. (i .gt. temp(A(i))) ) THEN
!PRINT *, "checking"
temp(A(i) + 1) = i
ELSE
temp(A(i)) = i
END IF
END DO
A = temp
END FUNCTION FindOrder
END PROGRAM A6Q2
question2
! -----------------------------------------------------
! FINDING THE NEXT PERMUTATION.
!------------------------------------------------------
PROGRAM A6Q2
IMPLICIT NONE
INTEGER, DIMENSION(:), ALLOCATABLE :: A
INTEGER :: n, check
PRINT *, "ENTER THE ARRAY SIZE (n) : "
READ *, n
DO
IF (n .EQ. 0) EXIT
IF (n .LT. 0) THEN
PRINT *, "ARRAY CANNOT BE NEGATIVE"
ELSE
ALLOCATE(A(n), STAT=check)
PRINT *, "ENTER ARRAY ELEMENTS : "
READ *, A
PRINT *, "PERMUTATION SEQUENCE :"
CALL NextPerm(A,n)
DEALLOCATE(A)
END IF
END DO
CONTAINS
SUBROUTINE NextPerm(A, n)
INTEGER, INTENT(IN) :: A(:)
INTEGER, INTENT(IN) :: n
INTEGER :: i, j, l, reminder
INTEGER :: idx(size(A,1)), stride(size(A,1))
l = size(A,1)
!PRINT *, l
stride(1) = 1
DO i = 2, l
stride(i) = stride(i-1)*l
END DO ! i
DO i = 0,l ** l-1
reminder = i
DO j=l,1,-1
idx(j) = reminder / stride(j)
reminder = reminder - idx(j) * stride(j)
END DO ! j
PRINT *, A(idx + 1)
END DO ! i
END SUBROUTINE
END PROGRAM A6Q2
fortran Assignment5
Assignment5
Question2
PROGRAM A5Q2
IMPLICIT NONE
! DECLARING VARIABLES
INTEGER, DIMENSION(:,:), ALLOCATABLE :: As
INTEGER, DIMENSION(3):: B
INTEGER :: i, n, j, k, temp, counter, rounder, result
DO
PRINT *, "ENTER m and n (OR 0 0 to END):"
READ *, n
IF (n .eq. 0 .or. n .eq. 0) STOP
IF (n .lt. 0 .or. n .lt. 0) THEN
PRINT *, "NEGATIVE NUMBER OF ELEMENTS"
ELSE IF(n .gt. 15 .or. n .gt. 15) THEN
PRINT *, "TO LARGE ARRAY. "
ELSE
ALLOCATE(As(n,n))
PRINT *, "Enter the array values"
READ *, (As(i,1:n), i=1,n)
! INITIALIZE VALUE
temp = 1
rounder = 1
result = BLOCKS(As, n, B)
END IF
END DO
CONTAINS
! BLOCK FUNCTION WILL FIND THE DIAGONAL BLOCKS
! FROM M*N MATRIX
INTEGER FUNCTION BLOCKS(A, n, B)
INTEGER, DIMENSION(n, n), INTENT(IN) :: A
INTEGER, INTENT(IN) :: n
INTEGER, DIMENSION(3), INTENT(INOUT) :: B
DO j = temp, n
counter = 0
DO k = temp, n
if(A(j,k).ne.0) THEN
counter = counter + 1
CYCLE
else
EXIT
END IF
END DO
if (counter .ne. 0) THEN
B(rounder) = counter
rounder = rounder + 1
end if
!print *, "counter", counter
temp = k
!print *, "temp", temp
IF(temp.eq.n) EXIT
END DO
PRINT *, B
END FUNCTION BLOCKS
END PROGRAM A5Q2
assignment5
PROGRAM A5Q1
!--------------------------------------------------------------------------
! Merge two array into and overlapping each other
! Depending on array range
!--------------------------------------------------------------------------
IMPLICIT NONE
! DECLARING VARIABLES
INTEGER, DIMENSION(:), ALLOCATABLE :: X
INTEGER, DIMENSION(:), ALLOCATABLE :: Y
INTEGER :: i, j, k, ArraySize, check, result
DO
! get the array size from the user
PRINT *, "ENTER THE NUMBER OF ELEMENTS IN ARRAY (OR 0 TO CLOSE.)"
READ *, ArraySize
! 0 FOR CLOSE
! LESS THAN 0 FOR WARNING
IF (ArraySize .EQ. 0) EXIT
IF (ArraySize .LT. 0) THEN
PRINT *, "NEGAIVE NUMBER OF ELEMENTS"
ELSE
! ALLOCATING ARRAY OF X AND Y
ALLOCATE(X(ArraySize), STAT=check)
ALLOCATE(Y(ArraySize), STAT=check)
IF (check .NE. 0) THEN
PRINT "(1X, 'enter the values of X ', I3, ' elements: ')", ArraySize
READ *, X
PRINT "(1X, 'Enter the values of Y ', I3, ' elements: ')", ArraySize
READ *, Y
PRINT "(1X, 'DATA OF X: ', 15I5)", X
PRINT "(1X, 'DATA OF Y: ', 15I5)", Y
result = MergeOverlap(X, Y, ArraySize)
! DEALLOCATING ARRAY
DEALLOCATE(X, Y)
END IF
END IF
END DO
CONTAINS
INTEGER FUNCTION MergeOverlap(X, Y, n)
INTEGER, DIMENSION (:), INTENT(INOUT) :: X
INTEGER, DIMENSION (:), INTENT(INOUT) :: Y
INTEGER, INTENT(IN) :: n
INTEGER :: i, j, k, xk, yk, tempx, tempy, num
! CHECK THE CONDITION
num = SIZE(X)
DO i = 1, num - 1
DO j = i + 1, num
! xi ≤ xj ∧ xj ≤ yi ∨ xj ≤ xi ∧ xi ≤ yj
IF ( (X(i) .LE. X(j)) .AND. (X(j) .LE. Y(i)) .OR. (X(j) .LE. X(i)) .AND. (X(i) .LE. Y(j))) THEN
! get the first item of xi, xj and yi, yj
IF(i == 1) THEN
xk = Min( X(i), X(j))
yk = Max( Y(i), Y(j))
ELSE
xk = Min( xk, X(j))
yk = Max( yk, Y(j))
END IF
END IF
END DO
END DO
PRINT *, "Overlapping", xk, yk
END FUNCTION MergeOverlap
END PROGRAM A5Q1fortran 作业4
作业4问题：1
question2
PROGRAM assignment4Question2
IMPLICIT NONE
INTEGER, DIMENSION (:, :), ALLOCATABLE :: Ad
INTEGER, DIMENSION (15, 15) :: As
INTEGER :: i, j, m, n, check
INTEGER :: result
DO
PRINT *, "ENTER m and n (OR 0 0 to END):"
READ *, m, n
IF (m .eq. 0 .or. n .eq. 0) STOP
IF (m .lt. 0 .or. n .lt. 0) THEN
PRINT *, "NEGATIVE NUMBER OF ELEMENTS"
ELSE IF(m .gt. 15 .or. n .gt. 15) THEN
PRINT *, "TO LARGE ARRAY. "
ELSE
PRINT "(1X, 'ENTER THE VALUES A', I3, '*', I3, ' ELEMENTS:')", m, n
READ *, ((As(i, j), i = 1, m), j = 1, n)
result = COUNTBLOB(As, m, n)
PRINT *, "NUMBER OF BLOBS :", result
END IF
END DO
CONTAINS
INTEGER FUNCTION COUNTBLOB(A, m, n)
INTEGER, DIMENSION (m, n) :: A
INTEGER, INTENT(IN) :: m, n
INTEGER :: count, item
! check the first section
IF (A(1,2) == 0 .or. A(2,1) == 0) THEN
IF (A(1,1) /= 0) THEN
count = count + 1;
END IF
END IF
IF (A(1,n-1)==0 .or. A(2,n)==0) THEN
IF (A(1,n)/=0) THEN
count=count+1;
END IF
END IF
IF (A(m-1,1)==0 .or. A(m,2)==0) THEN
IF (A(m,1)/=0) THEN
count=count+1;
END IF
END IF
IF (A(m,n-1)==0 .or. A(m-1,n)==0) THEN
IF (A(m,n)/=0) THEN
count=count+1;
END IF
END IF
! CHECK SECTION 2
DO j = 2, n-1
IF (A(1,j) /= 0) THEN
IF (A(1,j-1) == 0) THEN
item = item + 1;
END IF
IF (A(1,j+1)==0) THEN
item = item + 1;
END IF
IF (A(2,j)==0) THEN
item = item + 1;
END IF
IF (item == 2) THEN
count = count + 1;
END IF
END IF
item = 0;
END DO
DO j = 2, n - 1
IF (A(m,j) /= 0) THEN
IF (A(m,j-1) == 0) THEN
item = item + 1;
END IF
IF (A(m,j+1) == 0) THEN
item = item + 1;
END IF
IF (A(m-1,j) == 0) THEN
item = item + 1;
END IF
IF (item == 2) THEN
count = count + 1;
END IF
END IF
item = 0;
END DO
DO i = 2, m - 1
IF (A(i,1) /= 0) THEN
IF (A(i-1,1) == 0) THEN
item = item + 1;
END IF
IF (A(i + 1, 1) == 0) THEN
item = item + 1;
END IF
IF (A(i,2) == 0) THEN
item = item + 1;
END IF
IF (item == 2) THEN
count=count+1;
END IF
END IF
item = 0;
END DO
DO i = 2, m - 1
IF (A(i,n) /= 0) THEN
IF (A(i-1,n) == 0) THEN
item = item + 1;
END IF
IF (A(i+1,n)==0) THEN
item = item + 1;
END IF
IF (A(i,n-1)==0) THEN
item = item + 1;
END IF
IF (item == 2) THEN
count = count + 1;
END IF
END IF
item = 0;
END DO
! CHECK SECTION 3
DO i = 2, m - 1
DO j = 2, n - 1
IF (A(i,j) /= 0) THEN
IF (A(i+1,j) == 0) THEN
item = item + 1;
END IF
IF (A(i-1,j) == 0) THEN
item = item + 1;
END IF
IF (A(i,j+1) == 0) THEN
item = item +1;
END IF
IF (A(i,j-1) == 0) THEN
item = item + 1;
END IF
IF (item == 3) THEN
count = count + 1;
END IF
item = 0;
END IF
END DO
END DO
! GETTING THE NUMBER OF BLOBs
result = count/2;
COUNTBLOB = result
END FUNCTION COUNTBLOB
END PROGRAM assignment4Question2
a4q1
PROGRAM ORDERING
!-------------------------------------------------------
! An example of Allocatable array and selection sort as
! a subroutine (with an INOUT parameters)
!---------------------------------------------------------
IMPLICIT NONE
! declaring variable
INTEGER, DIMENSION(:), ALLOCATABLE :: Aone
INTEGER :: k, check, result
DO
PRINT *, "Enter the number of elements (OR 0 TO STOP):"
READ *, k
IF (k .eq. 0) STOP
IF (k .lt. 0) THEN
PRINT *, "negative number of elements"
ELSE
! allocating array
ALLOCATE(Aone(k), STAT = check)
IF (check .ne. 0) THEN
PRINT "(1X, 'enter the values of', I3,' elements: ')", k
READ *, Aone
PRINT "(1X, 'data:', 15I5)", Aone
result = CountSeq(Aone, k)
PRINT *, "RESULT:", result
! deallocating array
DEALLOCATE(Aone)
END IF
END IF
END DO
CONTAINS
! AN IMPLEMENTATION OF CountSeq
INTEGER FUNCTION CountSeq(A, k)
INTEGER, DIMENSION (:), INTENT (INOUT) :: A
INTEGER, INTENT(IN) :: k
INTEGER :: count = 0, currItem, nextItem, i, zero = 0
CHARACTER*3 :: state
! CHECK EVERY ITEM IS 0 THEN CLOSE
DO i = 1, k - 1
IF (A(i) .eq. 0) THEN
zero = zero + 1
END IF
END DO
! IF ALL ELEMENTS ARE 0 THEN CLOSE
IF (zero /= k) THEN
DO i = 1, k - 1
currItem = A(i)
nextItem = A(i + 1)
IF (A(i + 1) .eq. currItem) THEN
state = 'oke'
! if the previous item not equal to next time, greater than and the state is increasing
! it will change the state to increment and increment the weakly increasing
ELSE IF (A(i + 1) .gt. A(i) .and. currItem .ne. nextItem .and. (state /= 'inc')) THEN
count = count + 1
state = 'inc'
! if the previous item not equal to next time, less than and the state is increasing
! it will change the state to increment and increment the weakly decreasing
ELSE IF(A(i + 1) .lt. A(i) .and. currItem .ne. nextItem .and. (state /= 'dec')) THEN
count = count + 1
state = 'dec'
END IF
! set the final result
CountSeq = count
END DO
ELSE
PRINT *, "PROGRAM CLOSE"
END IF
END FUNCTION CountSeq
END PROGRAM ORDERINGfortran Assignment3
Assignment3
question2
!-----------------------------------------------------------------------------------------------------
! This Fortran program finds the root of a function f(x) = x^3 + 2x^2 + x + 1 using the Secant Method
! where limits is the number of iteration steps can be no-convergent when the initial value a and b
! are not so close.
! it will also display the number o iteration used for finding the solution.
!-----------------------------------------------------------------------------------------------------
PROGRAM SECANTMETHOD
IMPLICIT NONE
! Declare variables
REAL*8 ::a, b, eps, result
INTEGER :: iter = 0, limit
DO
! getting the value of a, b, eps, limits
PRINT *, "----------------------------------------------------------------------------"
PRINT *, "Please enter the value of a, b, eps and limit with spaces/commas"
READ *, a, b, eps, limit
IF (a .eq. 0 .and. b .eq. 0) THEN
PRINT *, "PROGRAM EXIT!!!"
EXIT
ELSE
! the secant method will the find the approximate root uses
! two intial values a and b which are "close" to the solution.
result = SECANT(a, b, eps, iter, limit)
PRINT *, "RESULT: ", result
END IF
END DO
CONTAINS
! this secant function finds the approximate root uses two intial value of a and b
! and each itteration step an approximation x to the solution determine by the
! secant line
REAL*8 FUNCTION SECANT(a, b, eps, iter, limit)
REAL*8 :: a, b, x
INTEGER :: counter = 0
REAL*8, INTENT (IN) :: eps
INTEGER, INTENT(IN) :: limit, iter
! if the absoulate difference is less than eps # EXIT
DO WHILE(abs(a - b) > eps)
counter = counter + 1
IF (limit .eq. counter) THEN
PRINT *, "Result Not Found!! "
PRINT *, "Number of tires: ", limit
PRINT *, "Last Result is: "
EXIT
END IF
IF ( f(b) .eq. f(a)) THEN
b = b + 1
END IF
! to find the x we have to draw a stright line betwen the a and b
x = b - ((b - a) * f(b)) / (f(b) - f(a))
a = b
b = x
END DO
IF (iter .lt. limit) THEN
PRINT *, "Number of tires: ", counter
END IF
SECANT = a
END FUNCTION SECANT
! the testing function is f(x) = x^3 + 2x^2 + x + 1
REAL*8 FUNCTION f(x)
REAL*8, INTENT(IN) :: x
f = (x * x * x) - (2 * x * x) + x + 1
END FUNCTION f
END PROGRAM SECANTMETHOD
question1
PROGRAM expFunction1
IMPLICIT NONE
REAL :: x, y, z
! declare the value of the 2
x = -2.0
PRINT *, x, exp(x)
DO WHILE (x .lt. 6.25)
y = exp(x)
z = myexp(x)
PRINT "(1X, F7.3, 2F12.6, 2(1PE13.5))", x, y, z, y, z
x = x + 0.5
END DO
CONTAINS
REAL FUNCTION myexp(x)
REAL, INTENT(IN) :: x
REAL :: approx, sum, sum_prev, counter
approx = x
counter = 1.0
sum_prev = 0.0
sum = x
DO WHILE (sum .ne. sum_prev)
sum_prev = sum
counter = counter + 1.0
approx = -(approx * (x / counter))
sum = sum + approx
END DO
myexp = sum
END FUNCTION myexp
END PROGRAM expFunction1fortran 作业2
作业2 <br/>问题：1
assignment 2
PROGRAM SQRTofPositiveNumber
! -------------------------------------------------------------------------
! This program finds an apporximation of the square Root using mysqrt
! function. mysqrt function reads consecutive values a and prints a its
! approximated square root utill a negative values of a is entered
! -------------------------------------------------------------------------
IMPLICIT NONE
! Declare variable
REAL :: start, close, step
REAL :: temp, mysqrtx
PRINT *, "Enter starting, ending, and number of steps: "
READ (*, *) start, close, step
temp = start
DO
! Stop when start value > end value
IF ( temp > close) EXIT
! find the square root with mysqrt(temp)
mysqrtx = mysqrt(temp)
! display the result
PRINT *, mysqrtx
! move on the next value
temp = temp + step
END DO
CONTAINS
!-------------------------------------------------------------------
! mysqrt finds an apporximation of the square root. If the input
! the process continues until the difference b/w two consecutive
! values of x is sufficiently small
!-------------------------------------------------------------------
REAL FUNCTION mysqrt(value)
IMPLICIT NONE
! Declare local variable
REAL, INTENT(IN) :: value
REAL :: X, Xi
REAL, PARAMETER :: Tolerance = 0.00001
! input value is 0 return 0
IF (value == 0.0) THEN
mysqrt = 0.0
ELSE
X = abs(value)
DO
! follow the equation
! Xi + 1 = 0.5 (Xi + a/Xi)
Xi = 0.5 * (X + value/X)
IF (abs(X - Xi) < Tolerance) EXIT
! Swap the new item Xi
X = Xi
END DO
mysqrt = Xi
END IF
END FUNCTION mysqrt
END PROGRAM SQRTofPositiveNumber
question_1
PROGRAM GREATESTCOMMONDIVISOR
! -----------------------------------------------------------------------------
! this a program which read a pair of integer numbers and uses GCD(a,b) to find
! the greatest common divisor for each pair until a pair of zeros is entered
! indicate the end of data
! -----------------------------------------------------------------------------
IMPLICIT NONE
! Declaring variables
INTEGER :: a, b, result
DO
! read two positive number
PRINT *, "Enter two(positive) integer number : "
READ(*, *) a, b
IF(a .eq. 0 .and. b .eq. 0) THEN
PRINT *, "Program Exit"
STOP
ELSE IF(b .eq. 0) THEN
! when b = 0 then GCD(a, b) = a
result = a
PRINT *, "The greatest commoin divisor is : ", result
ELSE
! GCD(a, b) will find the greatest common divisor
result = GCD(a, b)
PRINT *, "The greatest common divisor is: ", result
END IF
END DO
CONTAINS
! GCD(a,b) is a fortran function, which finds and returns the greatest
! common divisor of a and b.
INTEGER FUNCTION GCD(a, b)
INTEGER :: a, b
! temp will be used for swap
INTEGER :: temp, reminder
! will swaped if a < b
IF (a < b) then
temp = a
a = b
b = temp
END IF
DO
! when a <= b, calculate the reminder
! if reminder is 0, the GCD = b
reminder = MOD(a, b)
IF (reminder == 0) EXIT
a = b
b = reminder
END DO
GCD = b
END FUNCTION GCD
END PROGRAM GREATESTCOMMONDIVISOR