! Fortran Example-4: Pointer variables and Linked lists
* Pointer Example:
! INTEGER TARGET:: X=4,Y=8
! Integer abc
! INTEGER POINTER :: P1, P2
! P1 => X
! Print *, P1 ! Implicit dereferencing as 4 is output
! P2 => P1 ! P2 points to X as well so
! "print *, P2" will output 4 as well
! P2 => Y ! Now P2 points to Y
! P2 = P1 ! same as Y=X
! p1 => abc ! Illegal as abc is not of 'target' attribute
Module LinkedList
Implicit None ! Implicit declaration not to be allowed
! That is, all variables must be declared before their use
Type Request ! Derived type to record transaction data
integer :: Machine
integer :: Customer
character(len=8) :: date
! same as character*8 :: date
character(len=4) :: Time
integer :: Amount
Type(Request), Pointer :: Next
End type Request
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This module contains subprograms to manipulate the linked list
! representing outstanding transaction requests
contains
Subroutine Init(Head,Tail)
Type(Request), Pointer :: Head, Tail
Nullify(Head, Tail) ! No successors to them yet.
End subroutine Init
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Subroutine Add(New, Head, Tail)
! Add a new item to the end of the list
Type(Request), Pointer :: New, Head, Tail
if (Associated(Head)) then !List not empty.
Tail%next => New
Nullify (New%Next) ! Make sure this new one is last one.
Tail => New ! Reconfirming above
else ! else List empty
Head => New
Tail => New
Nullify (New%Next)
end if
End Subroutine Add
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Subroutine Delete (head, tail, first)
! Return the pointer to the first list item and
! remove it from the list.
Type(Request), Pointer :: head, tail, first
First => Head ! Return it whether it is null or not
if (Associated(Head)) then ! List not empty so check if
! it has more than one item.
if (Associated(Head%Next)) then ! At least two items
Head => Head%Next ! Last remains the same
else
Nullify (Head, Tail) ! Both become null
end if
else ! List empty now
Nullify(Head) ! Redundant
end if
End subroutine Delete
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Subroutine List (head)
! List contents of the list onto "FOR123.DAT"
Type(Request), Pointer :: Head
Type(Request), Pointer :: Current
write(123,*)
write(123,*), "Pending Request List"
write(123,*)
if (.NOT.(Associated(Head))) then
write(123,*), "LIST IS EMPTY NOW"
else
Current => Head
Do While (Associated(Current))
write(123,*) Current%Machine, Current%Customer,
1 Current%Date, Current%Time, Current%Amount
Current => Current%Next
! if (.NOT.(Associated(Current))) Exit
End do
end if
End subroutine List
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
End Module LinkedList
Program Bank
Use LinkedList ! For this to work, the wanted module
! needs to be compiled with no error
Implicit None
Integer m
Integer :: I=11, J=111
Integer :: X=1000
Type(Request), Pointer :: Head,Tail,Item,First
Call Init(Head,Tail) ! Initialize empty list.
! Loop to add six items to the list
Do M=1,6
Call Make (i,j,x,item)
Call Add (item,head,tail)
Call List(Head)
end do
! Loop to remove seven items from the list
Do m=1,7
Nullify(First) !Just to make sure that it is null.
Call Delete (Head,Tail,First)
if (associated(First)) then
write(123,*)
write(123,*) "REQUEST TO BE PROCESSED IS:"
write(123,*) first%Machine, First%Customer, First%Amount
print *
print *, "REQUEST TO BE PROCESSED IS:"
print *, first%Machine, First%Customer, First%Amount
end if
Call List(Head)
end do
Contains
Subroutine Make (I,J,X,Item)
! Subroutine for simulating input requests
Integer , intent(inout) :: I,J,X
Type(Request), pointer :: Item
Integer Err ! Local variable
! Create a new transaction record by way of a pointer var.
Allocate (Item, Stat=Err)
!Check if it was successfully created
if (Err /= 0) then
print *, "MACHINE OUT OF MEMORY:::"
stop
end if
! Else define new record fields
item%Machine = I
Item%Customer = J
Item%Date = "10012002"
Item%Time = '1135'
Item%Amount = X
I = mod (4*I+100,333)
J = mod (5*J+20,444)
X = mod (3*X+110,2555)
End subroutine make
End program Bank
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
PROGRAM OUTPUTS
---------------
Pending Request List
11 111 100120021135 1000
Pending Request List
11 111 100120021135 1000
144 131 100120021135 555
Pending Request List
11 111 100120021135 1000
144 131 100120021135 555
10 231 100120021135 1775
Pending Request List
11 111 100120021135 1000
144 131 100120021135 555
10 231 100120021135 1775
140 287 100120021135 325
Pending Request List
11 111 100120021135 1000
144 131 100120021135 555
10 231 100120021135 1775
140 287 100120021135 325
327 123 100120021135 1085
Pending Request List
11 111 100120021135 1000
144 131 100120021135 555
10 231 100120021135 1775
140 287 100120021135 325
327 123 100120021135 1085
76 191 100120021135 810
REQUEST TO BE PROCESSED IS:
11 111 1000
Pending Request List
144 131 100120021135 555
10 231 100120021135 1775
140 287 100120021135 325
327 123 100120021135 1085
76 191 100120021135 810
REQUEST TO BE PROCESSED IS:
144 131 555
Pending Request List
10 231 100120021135 1775
140 287 100120021135 325
327 123 100120021135 1085
76 191 100120021135 810
REQUEST TO BE PROCESSED IS:
10 231 1775
Pending Request List
140 287 100120021135 325
327 123 100120021135 1085
76 191 100120021135 810
REQUEST TO BE PROCESSED IS:
140 287 325
Pending Request List
327 123 100120021135 1085
76 191 100120021135 810
REQUEST TO BE PROCESSED IS:
327 123 1085
Pending Request List
76 191 100120021135 810
REQUEST TO BE PROCESSED IS:
76 191 810
Pending Request List
LIST IS EMPTY NOW
Pending Request List
LIST IS EMPTY NOW