← Back to branch summary

~reducedmodelling/fluidity/ROM_Non-intrusive-ann

« back to all changes in this revision

Viewing changes to femtools/Reference_count_quadrature_type.F90

  • Committer: fangf at ac
  • Date: 2012-11-06 12:21:31 UTC
  • mto: This revision was merged to the branch mainline in revision 3989.
  • Revision ID: fangf@imperial.ac.uk-20121106122131-u2zvt7fxc1r3zeou
updated

Show diffs side-by-side

added added

removed removed

Lines of Context:
femtools/Reference_count_quadrature_type.F90
 
1
  subroutine addref_quadrature_type(object)
 
2
    !!< Increment the reference count of object creating a new reference
 
3
    !!< counter if needed.
 
4
    type(quadrature_type), intent(inout), target :: object
 
5
    integer, save :: id = 0
 
6
 
 
7
    if (associated(object%refcount)) then
 
8
       ! Reference count already exists, just increment it.
 
9
       object%refcount%count=object%refcount%count+1
 
10
       
 
11
    else
 
12
       id = id + 1
 
13
       object%refcount=>new_refcount("&
 
14
            &quadrature_type", object%name)
 
15
       object%refcount%id = id
 
16
    end if
 
17
    
 
18
  end subroutine addref_quadrature_type
 
19
  
 
20
  subroutine incref_quadrature_type(object)
 
21
    !!< Increment the reference count of object. If there are no references
 
22
    !!< then error.
 
23
    type(quadrature_type), intent(in), target :: object
 
24
    integer, pointer :: ptr !! Dummy pointer to evade compilers which
 
25
    !! don't understand the rules for intent.
 
26
 
 
27
    if (.not.associated(object%refcount)) then
 
28
       FLAbort ("Attempt to incref quadrature_type "//trim(object%name)//" which has no references")
 
29
    end if
 
30
       
 
31
    ! Reference count already exists, just increment it.
 
32
    ptr=>object%refcount%count
 
33
    ptr=ptr+1
 
34
 
 
35
  end subroutine incref_quadrature_type  
 
36
  
 
37
  subroutine decref_quadrature_type(object)
 
38
    !!< Decrement the reference count on object. If the reference count drops
 
39
    !!< to 0 deallocate the refcount as a hint to the calling routine that
 
40
    !!< the object can safely be deallocated.
 
41
    type(quadrature_type), intent(inout) :: object
 
42
    
 
43
    if (.not.associated(object%refcount)) then
 
44
       ! No refcount. Just exit
 
45
       return
 
46
    end if
 
47
 
 
48
    object%refcount%count=object%refcount%count-1
 
49
 
 
50
    if (object%refcount%count<=0) then
 
51
 
 
52
       if (object%refcount%count<0) then
 
53
          ! Warn for negative reference count
 
54
          ewrite(0,'(a, i0)') "Reference count of &
 
55
               &quadrature_type "//trim(object%name)//&
 
56
               " is ", object%refcount%count
 
57
          FLAbort("that should never happen.")
 
58
       end if
 
59
 
 
60
       object%refcount%prev%next=>object%refcount%next
 
61
       if (associated(object%refcount%next)) then
 
62
          object%refcount%next%prev=>object%refcount%prev
 
63
       end if
 
64
       
 
65
       deallocate(object%refcount)
 
66
       
 
67
    end if
 
68
 
 
69
  end subroutine decref_quadrature_type
 
70
 
 
71
  pure function has_references_quadrature_type(object) result (has_references)
 
72
    !!< Return true if there are any references to object
 
73
    type(quadrature_type), intent(in) :: object
 
74
    logical :: has_references
 
75
    
 
76
    has_references=associated(object%refcount)
 
77
 
 
78
  end function has_references_quadrature_type
 
79