aboutsummaryrefslogtreecommitdiff
path: root/favorites.f90
diff options
context:
space:
mode:
Diffstat (limited to 'favorites.f90')
-rw-r--r--favorites.f9022
1 files changed, 12 insertions, 10 deletions
diff --git a/favorites.f90 b/favorites.f90
index d1ba7d1..f51a753 100644
--- a/favorites.f90
+++ b/favorites.f90
@@ -187,7 +187,7 @@ contains
implicit none
integer, intent(in)::unit_number
- type(favorite), dimension(:), allocatable::faves
+ type(favorite), dimension(:), pointer::faves
character(80)::temp
integer::n, i
@@ -250,10 +250,10 @@ contains
implicit none
integer::find_favorite
- type(favorite), dimension(:), allocatable, intent(in)::faves
+ type(favorite), dimension(:), intent(in), pointer::faves
character(*), intent(in)::link
- if(.not. allocated(faves)) then
+ if(.not. associated(faves)) then
find_favorite = -1
else
do find_favorite = 1, size(faves)
@@ -272,17 +272,17 @@ contains
subroutine add_favorite(faves, link, name)
implicit none
- type(favorite), dimension(:), intent(inout), allocatable::faves
+ type(favorite), dimension(:), intent(inout), pointer::faves
character(*), intent(in)::link
character(*), intent(in)::name
character(8)::now
integer::n
- type(favorite), dimension(:), allocatable::holding
+ type(favorite), dimension(:), pointer::holding
n = -1
- if(.not. allocated(faves)) then
+ if(.not. associated(faves)) then
n = 1
allocate(faves(1))
@@ -290,16 +290,17 @@ contains
else if(find_favorite(faves, link) < 0) then
n = size(faves)
- allocate(holding(n))
- holding = faves
+ holding => faves
- deallocate(faves)
+ faves => null()
allocate(faves(n+1))
faves(1:n) = holding
n = n + 1
+ deallocate(holding)
+
end if
if(n > 0) then
@@ -315,7 +316,7 @@ contains
subroutine remove_favorite(faves, link)
implicit none
- type(favorite), dimension(:), intent(inout), allocatable::faves
+ type(favorite), dimension(:), intent(inout), pointer::faves
character(*), intent(in)::link
integer::i, n
@@ -331,6 +332,7 @@ contains
else
n = size(faves)
+
allocate(holding(n-1))
if(i > 1) then
holding(1:i-1) = faves(1:i-1)