File: /nfs/home/0/users/jenkins/mfix.git/model/des/des_linked_list_funcs_mod.f

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
2     !  Module name: DES_LINKED_LIST_FUNCS_MOD                              !
3     !                                                                      !
4     !                                                                      !
5     !  Reviewer: R. Garg                                  Date: 19-Mar-14  !
6     !                                                                      !
7     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
8     
9     
10     
11     
12           MODULE DES_LINKED_LIST_FUNCS
13     
14     
15           CONTAINS
16     
17           SUBROUTINE merge_part_lists(newlist, baselist)
18           USE des_linked_list_data, only : particle
19     
20           IMPLICIT NONE
21           TYPE(PARTICLE), POINTER  :: newlist, baselist
22     
23           TYPE(particle), pointer :: part
24     
25           if(.not.associated(newlist)) then
26              !do nothing
27              return
28           endif
29     
30           If(.not.associated(baselist)) then
31              !just point the baselist to newlist
32              baselist => newlist
33           else
34              nullify(part)
35              part => baselist
36              DO WHILE (ASSOCIATED(part%next))
37                 part => part%next
38              ENDDO
39     
40              part%next => newlist
41              newlist%prev => part
42           endif
43     
44           END SUBROUTINE merge_part_lists
45     
46           SUBROUTINE DEALLOC_PART_LIST(LIST_NAME)
47           USE des_linked_list_data, only : particle
48     
49           IMPLICIT NONE
50     
51           TYPE(PARTICLE), POINTER  :: LIST_NAME, part => NULL(), part_old => NULL()
52     
53           IF(.not.associated(list_name)) return !do nothing
54     
55           part =>  list_name
56     
57           DO WHILE (ASSOCIATED(part))
58              part_old => part
59              part => part%next
60              DEALLOCATE(part_old)
61           enddo
62           RETURN
63           END SUBROUTINE DEALLOC_PART_LIST
64           SUBROUTINE GEN_AND_ADD_TO_PART_LIST(LIST_NAME, PHASE, POS, VEL,RAD, DENS, STATWT)
65           USE discretelement, only : dimn
66           USE des_linked_list_data, only : particle
67     
68           IMPLICIT NONE
69     
70           TYPE(PARTICLE), POINTER  :: LIST_NAME
71           INTEGER, INTENT(IN) ::  PHASE
72           double precision, INTENT(IN), DIMENSION(DIMN) :: POS, VEL
73           double precision, INTENT(IN) :: RAD, DENS, STATWT
74     
75           TYPE(PARTICLE), POINTER  :: NEW_PART => NULL()
76     
77           ALLOCATE(NEW_PART)
78     
79           NEW_PART%M = PHASE
80           NEW_PART%INDOMAIN = .true.
81     
82           NEW_PART%POSITION(1:DIMN) = POS(1:DIMN)
83           NEW_PART%VELOCITY(1:DIMN) = VEL(1:DIMN)
84           NEW_PART%STATWT = STATWT
85     
86           NEW_PART%RAD = RAD
87           NEW_PART%DENS = DENS
88           NEW_PART%STATWT = STATWT
89     
90           IF(.NOT.ASSOCIATED(LIST_NAME)) THEN !FIRST ENTRY
91              LIST_NAME => NEW_PART  !make the new entry as head
92           ELSE
93              NEW_PART%NEXT => LIST_NAME
94              LIST_NAME%PREV => NEW_PART
95              LIST_NAME =>  NEW_PART
96           END IF
97           END SUBROUTINE GEN_AND_ADD_TO_PART_LIST
98     
99     
100           SUBROUTINE ADD_TO_PART_LIST(NEW, BASE)
101           USE discretelement, only : dimn
102           USE des_linked_list_data, only : particle
103     
104           IMPLICIT NONE
105     
106           !New entry in the linked list
107           TYPE(PARTICLE), POINTER  :: NEW
108     
109           !Baseline linked list
110           TYPE(PARTICLE), POINTER  :: BASE
111           IF(.NOT.ASSOCIATED(BASE)) THEN !FIRST ENTRY
112              BASE => NEW
113           ELSE
114              NEW%NEXT => BASE
115              BASE%PREV => NEW
116              BASE =>  NEW
117           END IF
118     
119           END SUBROUTINE ADD_TO_PART_LIST
120     
121           SUBROUTINE REMOVE_PART_LLIST(PART)
122           USE discretelement, only : dimn
123           USE des_linked_list_data, only : particle
124           IMPLICIT NONE
125           LOGICAL :: DELETION
126           TYPE(PARTICLE), POINTER  :: PART
127           TYPE(PARTICLE), POINTER  :: RIGHT, LEFT
128     
129           !CALL INIT_ERR_MSG("REMOVE_PART_LLIST IN MOD DES_LINKED_LIST_DATA")
130     
131           RIGHT => PART%NEXT
132           LEFT => PART%PREV
133           DELETION = .false.
134     
135           IF(.NOT.ASSOCIATED(LEFT).AND.(.NOT.ASSOCIATED(RIGHT))) THEN
136              !this is the only particle in the list
137              DELETION  = .true.
138           ELSEIF(.NOT.ASSOCIATED(LEFT)) THEN !LEFT BORDERING POINT, PREVIOUS NULL PTR
139              !ONLY CORRECT THE PREV POINTER FOR RIGHT ENTRY
140              RIGHT%PREV => NULL()
141              DELETION = .TRUE.
142           ELSEIF(.NOT.ASSOCIATED(RIGHT)) THEN !RIGHT BORDERING POINT, PREVIOUS NULL PTR
143              !ONLY CORRECT THE NEXT POINTER FOR LEFT ENTRY
144              LEFT%NEXT => NULL()
145              DELETION = .TRUE.
146           ELSE
147              RIGHT%PREV => LEFT
148              LEFT%NEXT => RIGHT
149              DELETION = .TRUE.
150           END IF
151           IF (DELETION) THEN
152              DEALLOCATE(PART)
153           ENDIF
154           END SUBROUTINE REMOVE_PART_LLIST
155     
156           END MODULE DES_LINKED_LIST_FUNCS
157