source: CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_StringLinkedList.F90 @ 4775

Last change on this file since 4775 was 4775, checked in by aclsce, 4 years ago
  • Imported oasis3-mct from Cerfacs svn server (not suppotred anymore).

The version has been extracted from ​https://oasis3mct.cerfacs.fr/svn/branches/OASIS3-MCT_2.0_branch/oasis3-mct@1818
File size: 15.5 KB
Line 
1!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
3!BOP -------------------------------------------------------------------
4!
5! !MODULE: m_StringLinkedList - A linked-list of String
6!
7! !DESCRIPTION:
8!
9! !INTERFACE:
10
11    module m_StringLinkedList
12      use m_String,only : String
13      implicit none
14      private   ! except
15
16      public :: StringLinkedList        ! The class data structure
17
18                ! o An object of a StringLinkedList should be defined
19                !   as a pointer of a StringLinkedList.  It is often
20                !   represented by a pointer to the head-node of the
21                !   linked-list.
22                !
23                ! o A node in a StringLinkedList is specificed by a
24                !   reference pointer.  A reference pointer is a
25                !   logical reference of a node in the list.  However,
26                !   it does not physically point to that node.  In
27                !   fact, a reference pointer normally references to
28                !   the node physically pointed by the pointer in the
29                !   node physically pointed by the reference pointer,
30                !
31                !       [this] -> [..|next] -> [..|next]
32                !
33                !   where the last node is the logically referenced
34                !   node.
35
36      public :: StringLinkedList_init   ! constructor
37      public :: StringLinkedList_clean  ! destructor
38
39                ! A _clean() action will reset a StringLinkedList to its
40                ! pre-_init() status.
41
42      public :: StringLinkedList_insert ! grower, insert a node
43      public :: StringLinkedList_delete ! ungrower, delete a node
44
45                ! Both procedures processing the node through a given
46                ! reference pointer.  The reference pointer will not
47                ! be modified directly through either _insert() or
48                ! _delete().  It is the pointer in the node physically
49                ! pointed by a reference pointer got modified.  Also,
50                ! the node logically referenced by the reference
51                ! pointer is either the new node for an _insert(), and
52                ! the removed node for a _delete().
53
54      public :: StringLinkedList_eol    ! inquirer, is an end-node?
55
56                ! An end-of-list situation occurs when the reference
57                ! pointer is logically referencing to the end-node or
58                ! beyond.  Note that an end-node links to itself.
59
60      public :: StringLinkedList_next   ! iterator, go to the next node.
61
62      public :: StringLinkedList_count  ! counter
63     
64                ! Count the number of nodes from this reference pointer,
65                ! starting from and including the logical node but
66                ! excluding the end-node.
67
68      public :: StringLinkedList_get    ! fetcher
69
70                ! Get the value logically referenced by a reference
71                ! pointer.  Return EOL if the referenced node is an
72                ! EOL().  The reference pointer will be iterated to
73                ! the next node if the referenced node is not an EOL.
74
75    type StringLinkedList
76      type(String) :: str
77      type(StringLinkedList),pointer :: next
78    end type StringLinkedList
79
80    interface StringLinkedList_init  ; module procedure &
81        init_
82    end interface
83
84    interface StringLinkedList_clean ; module procedure &
85        clean_
86    end interface
87
88    interface StringLinkedList_insert; module procedure &
89        insertc_,       &       ! insert a CHARACTER(len=*) argument
90        inserts_                ! insert a String argument
91    end interface
92
93    interface StringLinkedList_delete; module procedure &
94        delete_
95    end interface
96
97    interface StringLinkedList_eol   ; module procedure &
98        eol_
99    end interface
100
101    interface StringLinkedList_next  ; module procedure &
102        next_
103    end interface
104
105    interface StringLinkedList_count ; module procedure &
106        count_
107    end interface
108
109    interface StringLinkedList_get   ; module procedure &
110        getc_,          &       ! get as a CHARACTER(len=*)
111        gets_                   ! get as a String
112    end interface
113
114! !REVISION HISTORY:
115!       16Feb00 - Jing Guo <guo@dao.gsfc.nasa.gov>
116!               - initial prototype/prolog/code
117!EOP ___________________________________________________________________
118
119  character(len=*),parameter :: myname='MCT(MPEU)::m_StringLinkedList'
120
121!   Examples:
122!
123!   1) Creating a first-in-first-out linked-list,
124!
125!       type(StringLinkedList),pointer :: head,this
126!       character(len=80) :: aline
127!
128!       call StringLinkedList_init(head)
129!       this => head
130!       do
131!         read(*,'(a)',iostat=ier) aline
132!         if(ier/=0) exit
133!         call StringLinkedList_insert(trim(aline),this)
134!         call StringLinkedList_next(this)
135!       end do
136!
137!   2) Creating a last-in-first-out linked-list,  Note that the only
138!     difference from Example (1) is without a call to
139!     StringLinkedList_next().
140!
141!       type(StringLinkedList),pointer :: head,this
142!       character(len=80) :: aline
143!
144!       call StringLinkedList_init(head)
145!       this => head
146!       do
147!         read(*,'(a)',iostat=ier) aline
148!         if(ier/=0) exit
149!         call StringLinkedList_insert(trim(aline),this)
150!       end do
151!
152
153contains
154!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
155!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
156!BOP -------------------------------------------------------------------
157!
158! !IROUTINE: init_ - initialize a StringLinkedList from a pointer
159!
160! !DESCRIPTION:
161!
162! !INTERFACE:
163
164    subroutine init_(head)
165      use m_die, only : die
166      use m_mall,only : mall_ison,mall_ci
167      implicit none
168      type(StringLinkedList),pointer :: head    ! (out) a list
169
170! !REVISION HISTORY:
171!       22Feb00 - Jing Guo <guo@dao.gsfc.nasa.gov>
172!               - initial prototype/prolog/code
173!EOP ___________________________________________________________________
174
175  character(len=*),parameter :: myname_=myname//'::init_'
176  type(StringLinkedList),pointer :: tail
177  integer :: ier
178
179        ! Two special nodes are needed for a linked-list, according to
180        ! Robert Sedgewick (Algorithms, QA76.6.S435, page 21).
181        !
182        ! It seems only _head_ will be needed for external references.
183        ! Node _tail_ will be used to denote an end-node.
184
185  allocate(head,tail,stat=ier)
186        if(ier/=0) call die(myname_,'allocate()',ier)
187
188        if(mall_ison()) call mall_ci(2,myname)  ! for two nodes
189
190  head%next => tail
191  tail%next => tail
192
193  nullify(tail)
194
195end subroutine init_
196
197!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
198!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
199!BOP -------------------------------------------------------------------
200!
201! !IROUTINE: insertc_ - insert before the logically referenced node
202!
203! !DESCRIPTION:
204!
205! !INTERFACE:
206
207    subroutine insertc_(cstr,this)
208      use m_String,only : String_init
209      use m_mall,  only : mall_ison,mall_ci
210      use m_die,   only : die
211      implicit none
212      character(len=*),intent(in) :: cstr ! a new entry
213      type(StringLinkedList),pointer :: this ! (in) a node
214
215! !REVISION HISTORY:
216!       16Feb00 - Jing Guo <guo@dao.gsfc.nasa.gov>
217!               - initial prototype/prolog/code
218!EOP ___________________________________________________________________
219
220  character(len=*),parameter :: myname_=myname//'::insertc_'
221  type(StringLinkedList),pointer :: tmpl
222  integer :: ier
223
224        ! Create a memory cell for the new entry of StringLinkedList
225
226  allocate(tmpl,stat=ier)
227        if(ier/=0) call die(myname_,'allocate()',ier)
228
229        if(mall_ison()) call mall_ci(1,myname)  ! for one nodes
230
231        ! Store the data
232
233  call String_init(tmpl%str,cstr)
234
235        ! Rebuild the links, if the List was not empty
236
237  tmpl%next => this%next
238  this%next => tmpl
239
240        ! Clean the working pointer
241
242  nullify(tmpl)
243
244end subroutine insertc_
245
246!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
247!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
248!BOP -------------------------------------------------------------------
249!
250! !IROUTINE: inserts_ - insert before the logically referenced node
251!
252! !DESCRIPTION:
253!
254! !INTERFACE:
255
256    subroutine inserts_(str,this)
257      use m_String,only : String,String_init
258      use m_mall,  only : mall_ison,mall_ci
259      use m_die,   only : die
260      implicit none
261      type(String),intent(in)  :: str   ! a new entry
262      type(StringLinkedList),pointer :: this ! (in) a node
263
264! !REVISION HISTORY:
265!       16Feb00 - Jing Guo <guo@dao.gsfc.nasa.gov>
266!               - initial prototype/prolog/code
267!EOP ___________________________________________________________________
268
269  character(len=*),parameter :: myname_=myname//'::inserts_'
270  type(StringLinkedList),pointer :: tmpl
271  integer :: ier
272
273        ! Create a memory cell for the new entry of StringLinkedList
274
275  allocate(tmpl,stat=ier)
276        if(ier/=0) call die(myname_,'allocate()',ier)
277
278        if(mall_ison()) call mall_ci(1,myname)  ! for one nodes
279
280        ! Store the data
281
282  call String_init(tmpl%str,str)
283
284        ! Rebuild the links, if the List was not empty
285
286  tmpl%next => this%next
287  this%next => tmpl
288
289        ! Clean the working pointer, if it mean anyting
290
291  nullify(tmpl)
292
293end subroutine inserts_
294
295!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
296!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
297!BOP -------------------------------------------------------------------
298!
299! !IROUTINE: delete_ - delete the logically referenced node
300!
301! !DESCRIPTION:
302!
303! !INTERFACE:
304
305    subroutine delete_(this)
306      use m_String,only : String_clean
307      use m_mall,  only : mall_ison,mall_co
308      use m_die,   only : die
309      implicit none
310      type(StringLinkedList),pointer :: this ! (in) a node
311
312! !REVISION HISTORY:
313!       17Feb00 - Jing Guo <guo@dao.gsfc.nasa.gov>
314!               - initial prototype/prolog/code
315!EOP ___________________________________________________________________
316
317  character(len=*),parameter :: myname_=myname//'::delete_'
318  type(StringLinkedList),pointer :: tmpl
319  integer :: ier
320
321  tmpl => this%next%next                ! hold the next target
322  call String_clean(this%next%str)      ! remove the next storage
323
324        if(mall_ison()) call mall_co(1,myname)  ! removing one node
325
326  deallocate(this%next,stat=ier)        ! Clean memory gabage
327        if(ier/=0) call die(myname_,'deallocate()',ier)
328
329        ! Skip the current target.  Rebuild the link to the target
330        ! of the current target.
331
332  this%next => tmpl
333
334        ! Clean the working pointer, if it mean anything
335
336  nullify(tmpl)
337end subroutine delete_
338
339!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
340!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
341!BOP -------------------------------------------------------------------
342!
343! !IROUTINE: eol_ - if the logically referenced node is an end-node
344!
345! !DESCRIPTION:
346!
347! !INTERFACE:
348
349    function eol_(this)
350      implicit none
351      type(StringLinkedList),pointer :: this ! (in) a node
352      logical :: eol_           ! returned value
353
354! !REVISION HISTORY:
355!       23Feb00 - Jing Guo <guo@dao.gsfc.nasa.gov>
356!               - initial prototype/prolog/code
357!EOP ___________________________________________________________________
358
359  character(len=*),parameter :: myname_=myname//'::eol_'
360
361  eol_=associated(this%next,this%next%next)
362end function eol_
363
364!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
365!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
366!BOP -------------------------------------------------------------------
367!
368! !IROUTINE: next_ - point a reference pointer to the next node
369!
370! !DESCRIPTION:
371!
372! !INTERFACE:
373
374    subroutine next_(this)
375      implicit none
376      type(StringLinkedList),pointer :: this ! (inout) a node
377
378! !REVISION HISTORY:
379!       23Feb00 - Jing Guo <guo@dao.gsfc.nasa.gov>
380!               - initial prototype/prolog/code
381!EOP ___________________________________________________________________
382
383  character(len=*),parameter :: myname_=myname//'::next_'
384
385  this => this%next
386
387end subroutine next_
388
389!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
390!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
391!BOP -------------------------------------------------------------------
392!
393! !IROUTINE: count_ - count the number of nodes
394!
395! !DESCRIPTION:
396!
397! !INTERFACE:
398
399    function count_(this)
400      implicit none
401      type(StringLinkedList),pointer :: this ! (in) a node
402      integer :: count_         ! returned value
403
404! !REVISION HISTORY:
405!       24Feb00 - Jing Guo <guo@dao.gsfc.nasa.gov>
406!               - initial prototype/prolog/code
407!EOP ___________________________________________________________________
408
409  character(len=*),parameter :: myname_=myname//'::count_'
410  type(StringLinkedList),pointer :: tmpl
411
412  tmpl => this
413
414  count_=0
415  do while(.not.eol_(tmpl))
416    count_=count_+1
417    call next_(tmpl)
418  end do
419
420  nullify(tmpl)
421end function count_
422
423!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
424!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
425!BOP -------------------------------------------------------------------
426!
427! !IROUTINE: getc_ - get the logically referenced value as CHARACTERs
428!
429! !DESCRIPTION:
430!
431! !INTERFACE:
432
433    subroutine getc_(this,cstr,eol)
434      use m_String,only : String
435      use m_String,only : String_init
436      use m_String,only : String_clean
437      use m_String,only : char
438      implicit none
439      type(StringLinkedList),pointer :: this ! (inout) a node
440      character(len=*),intent(out) :: cstr ! the referenced value
441      logical         ,intent(out) :: eol  ! if the node is an end-node
442
443! !REVISION HISTORY:
444!       17Feb00 - Jing Guo <guo@dao.gsfc.nasa.gov>
445!               - initial prototype/prolog/code
446!EOP ___________________________________________________________________
447
448  character(len=*),parameter :: myname_=myname//'::getc_'
449  type(String) :: str
450
451  call gets_(this,str,eol)
452
453  if(.not.eol) then
454    cstr=char(str)
455    call String_clean(str)
456  endif
457
458end subroutine getc_
459
460!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
461!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
462!BOP -------------------------------------------------------------------
463!
464! !IROUTINE: gets_ - get the logically referenced value as a String
465!
466! !DESCRIPTION:
467!
468! !INTERFACE:
469
470    subroutine gets_(this,str,eol)
471      use m_String,only : String
472      use m_String,only : String_init
473      implicit none
474      type(StringLinkedList),pointer :: this ! (inout) a node
475      type(String),intent(out) :: str  ! the referenced value
476      logical     ,intent(out) :: eol  ! if the node is an end-node
477
478! !REVISION HISTORY:
479!       17Feb00 - Jing Guo <guo@dao.gsfc.nasa.gov>
480!               - initial prototype/prolog/code
481!EOP ___________________________________________________________________
482
483  character(len=*),parameter :: myname_=myname//'::gets_'
484
485  eol=eol_(this)
486  if(.not.eol) then
487    call String_init(str,this%next%str)
488    call next_(this)
489  endif
490
491end subroutine gets_
492
493!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
494!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
495!BOP -------------------------------------------------------------------
496!
497! !IROUTINE: clean_ - clean the whole object from this point
498!
499! !DESCRIPTION:
500!
501! !INTERFACE:
502
503    subroutine clean_(head,stat)
504      use m_die,only : die,perr
505      use m_mall,only : mall_ison,mall_co
506      implicit none
507      type(StringLinkedList),pointer :: head ! (inout) a head-node
508      integer,optional,intent(out) :: stat ! return status
509
510! !REVISION HISTORY:
511!       17Feb00 - Jing Guo <guo@dao.gsfc.nasa.gov>
512!               - initial prototype/prolog/code
513!EOP ___________________________________________________________________
514
515  character(len=*),parameter :: myname_=myname//'::clean_'
516  integer :: ier
517  logical :: err
518
519  if(present(stat)) stat=0
520
521        ! Verify if the pointer is valid
522
523  err=.not.associated(head)
524  if(.not.err) err=.not.associated(head%next)
525
526        if(err) then
527          call perr(myname_,'Attempting to clean an uninitialized list')
528          if(.not.present(stat)) call die(myname_)
529          stat=-1
530          return
531        endif
532
533        ! Clean the rest before delete the current one.
534
535  do
536    if(eol_(head)) exit
537    call delete_(head)
538  end do
539
540        if(mall_ison()) call mall_co(2,myname)  ! remove two nodes
541
542  deallocate(head%next,stat=ier)
543  if(ier==0) deallocate(head,stat=ier)
544        if(ier/=0) then
545          call perr(myname_,'deallocate()',ier)
546          if(.not.present(stat)) call die(myname_)
547          stat=-1
548          return
549        endif
550
551end subroutine clean_
552
553end module m_StringLinkedList
Note: See TracBrowser for help on using the repository browser.