OpenCMISS-Iron Internal API Documentation
domain_mappings.f90
Go to the documentation of this file.
1 
43 
45 MODULE domain_mappings
46 
47  USE base_routines
48  USE comp_environment
49  USE input_output
50  USE iso_varying_string
51  USE kinds
52  USE lists
53  USE strings
54  USE types
55 
56 #include "macros.h"
57 
58 
59  IMPLICIT NONE
60 
61  PRIVATE
62 
63  !Module parameters
64 
68  INTEGER(INTG), PARAMETER :: domain_local_internal=1
69  INTEGER(INTG), PARAMETER :: domain_local_boundary=2
70  INTEGER(INTG), PARAMETER :: domain_local_ghost=3
72 
73  !Module types
74 
75  !Module variables
76 
77  !Interfaces
78 
79  PUBLIC domain_local_internal,domain_local_boundary,domain_local_ghost
80 
81  PUBLIC domain_mappings_mapping_finalise,domain_mappings_mapping_initialise,domain_mappings_mapping_global_initialise, &
82  & domain_mappings_global_to_local_get,domain_mappings_local_from_global_calculate
83 
84 CONTAINS
85 
86  !
87  !================================================================================================================================
88  !
89 
91  SUBROUTINE domain_mappings_adjacent_domain_finalise(ADJACENT_DOMAIN,ERR,ERROR,*)
92 
93  !Argument variables
94  TYPE(domain_adjacent_domain_type) :: ADJACENT_DOMAIN
95  INTEGER(INTG), INTENT(OUT) :: ERR
96  TYPE(varying_string), INTENT(OUT) :: ERROR
97  !Local Variables
98 
99  enters("DOMAIN_MAPPINGS_ADJACENT_DOMAIN_FINALISE",err,error,*999)
100 
101  IF(ALLOCATED(adjacent_domain%LOCAL_GHOST_SEND_INDICES)) DEALLOCATE(adjacent_domain%LOCAL_GHOST_SEND_INDICES)
102  IF(ALLOCATED(adjacent_domain%LOCAL_GHOST_RECEIVE_INDICES)) DEALLOCATE(adjacent_domain%LOCAL_GHOST_RECEIVE_INDICES)
103  adjacent_domain%NUMBER_OF_SEND_GHOSTS=0
104  adjacent_domain%NUMBER_OF_RECEIVE_GHOSTS=0
105  adjacent_domain%DOMAIN_NUMBER=0
106 
107  exits("DOMAIN_MAPPINGS_ADJACENT_DOMAIN_FINALISE")
108  RETURN
109 999 errorsexits("DOMAIN_MAPPINGS_ADJACENT_DOMAIN_FINALISE",err,error)
110  RETURN 1
111  END SUBROUTINE domain_mappings_adjacent_domain_finalise
112 
113  !
114  !================================================================================================================================
115  !
116 
118  SUBROUTINE domain_mappings_adjacent_domain_initialise(ADJACENT_DOMAIN,ERR,ERROR,*)
119 
120  !Argument variables
121  TYPE(domain_adjacent_domain_type) :: ADJACENT_DOMAIN
122  INTEGER(INTG), INTENT(OUT) :: ERR
123  TYPE(varying_string), INTENT(OUT) :: ERROR
124  !Local Variables
125 
126  enters("DOMAIN_MAPPINGS_ADJACENT_DOMAIN_INITIALISE",err,error,*999)
127 
128  adjacent_domain%NUMBER_OF_SEND_GHOSTS=0
129  adjacent_domain%NUMBER_OF_RECEIVE_GHOSTS=0
130  adjacent_domain%DOMAIN_NUMBER=0
131 
132  exits("DOMAIN_MAPPINGS_ADJACENT_DOMAIN_INITIALISE")
133  RETURN
134 999 errorsexits("DOMAIN_MAPPINGS_ADJACENT_DOMAIN_INITIALISE",err,error)
135  RETURN 1
136  END SUBROUTINE domain_mappings_adjacent_domain_initialise
137 
138  !
139  !================================================================================================================================
140  !
141 
143  SUBROUTINE domain_mappings_global_to_local_get(DOMAIN_MAPPING,GLOBAL_NUMBER,LOCAL_EXISTS,LOCAL_NUMBER,ERR,ERROR,*)
144 
145  !Argument variables
146  TYPE(domain_mapping_type), POINTER :: DOMAIN_MAPPING
147  INTEGER(INTG), INTENT(IN) :: GLOBAL_NUMBER
148  LOGICAL, INTENT(OUT) :: LOCAL_EXISTS
149  INTEGER(INTG), INTENT(OUT) :: LOCAL_NUMBER
150  INTEGER(INTG), INTENT(OUT) :: ERR
151  TYPE(varying_string), INTENT(OUT) :: ERROR
152  !Local Variables
153  TYPE(varying_string) :: LOCAL_ERROR
154 
155  enters("DOMAIN_MAPPINGS_GLOBAL_TO_LOCAL_GET",err,error,*999)
156 
157  local_exists=.false.
158  local_number=0
159  IF(ASSOCIATED(domain_mapping)) THEN
160  IF(global_number>=1.AND.global_number<=domain_mapping%NUMBER_OF_GLOBAL) THEN
161  IF(domain_mapping%GLOBAL_TO_LOCAL_MAP(global_number)%DOMAIN_NUMBER(1)== &
162  & computational_environment%MY_COMPUTATIONAL_NODE_NUMBER) THEN
163  local_number=domain_mapping%GLOBAL_TO_LOCAL_MAP(global_number)%LOCAL_NUMBER(1)
164  local_exists=.true.
165  ENDIF
166  ELSE
167  local_error="The specified global number of "//trim(number_to_vstring(global_number,"*",err,error))// &
168  & " is invalid. The number must be between 1 and "// &
169  & trim(number_to_vstring(domain_mapping%NUMBER_OF_GLOBAL,"*",err,error))//"."
170  CALL flagerror(local_error,err,error,*999)
171  ENDIF
172  ELSE
173  CALL flagerror("Domain mapping is not associated.",err,error,*999)
174  ENDIF
175 
176  exits("DOMAIN_MAPPINGS_GLOBAL_TO_LOCAL_GET")
177  RETURN
178 999 errorsexits("DOMAIN_MAPPINGS_GLOBAL_TO_LOCAL_GET",err,error)
179  RETURN 1
180  END SUBROUTINE domain_mappings_global_to_local_get
181 
182  !
183  !================================================================================================================================
184  !
185 
187  SUBROUTINE domain_mappings_local_from_global_calculate(DOMAIN_MAPPING,ERR,ERROR,*)
188 
189  !Argument variables
190  TYPE(domain_mapping_type), POINTER :: DOMAIN_MAPPING
191  INTEGER(INTG), INTENT(OUT) :: ERR
192  TYPE(varying_string), INTENT(OUT) :: ERROR
193  !Local Variables
194  INTEGER(INTG) :: domain_idx,domain_idx2,domain_no,domain_no2,global_number,idx,local_number,local_number2,NUMBER_INTERNAL, &
195  & NUMBER_BOUNDARY,NUMBER_GHOST,my_computational_node_number,MY_DOMAIN_INDEX,TEMP,NUMBER_OF_ADJACENT_DOMAINS, &
196  & RECEIVE_FROM_DOMAIN,DUMMY_ERR,NUMBER_OF_GHOST_RECEIVE,NUMBER_OF_GHOST_SEND,local_type,COUNT, &
197  & TOTAL_NUMBER_OF_ADJACENT_DOMAINS
198  INTEGER(INTG), ALLOCATABLE :: ADJACENT_DOMAIN_MAP(:),ADJACENT_DOMAINS(:,:),SEND_LIST(:),RECEIVE_LIST(:)
199  LOGICAL :: OWNED_BY_ALL,SEND_GLOBAL
200  TYPE(list_ptr_type), ALLOCATABLE :: GHOST_SEND_LISTS(:),GHOST_RECEIVE_LISTS(:)
201  TYPE(varying_string) :: LOCAL_ERROR,DUMMY_ERROR
202 
203  enters("DOMAIN_MAPPINGS_LOCAL_FROM_GLOBAL_CALCULATE",err,error,*999)
204 
205  IF(ASSOCIATED(domain_mapping)) THEN
206  my_computational_node_number=computational_node_number_get(err,error)
207  IF(err/=0) GOTO 999
208 
209  !Calculate local to global maps from global to local map
210  ALLOCATE(domain_mapping%NUMBER_OF_DOMAIN_LOCAL(0:domain_mapping%NUMBER_OF_DOMAINS-1),stat=err)
211  IF(err/=0) CALL flagerror("Could not allocate number of domain local.",err,error,*999)
212  domain_mapping%NUMBER_OF_DOMAIN_LOCAL=0
213 
214  ALLOCATE(domain_mapping%NUMBER_OF_DOMAIN_GHOST(0:domain_mapping%NUMBER_OF_DOMAINS-1),stat=err)
215  IF(err/=0) CALL flagerror("Could not allocate number of domain ghost.",err,error,*999)
216 
217  domain_mapping%NUMBER_OF_DOMAIN_GHOST=0
218  number_internal=0 ! counters for my computational node
219  number_boundary=0
220  number_ghost=0
221 
222  ALLOCATE(adjacent_domains(0:domain_mapping%NUMBER_OF_DOMAINS-1,0:domain_mapping%NUMBER_OF_DOMAINS-1),stat=err)
223  IF(err/=0) CALL flagerror("Could not allocate adjacent domains.",err,error,*999)
224  adjacent_domains=0
225 
226  ! loop over global elements
227  DO global_number=1,domain_mapping%NUMBER_OF_GLOBAL
228  !-------- If necessary, reset global domain index so that my computational node is in the first index position ------------
229  !find out current domain index of my computational node
230  my_domain_index=1
231  DO domain_idx=2,domain_mapping%GLOBAL_TO_LOCAL_MAP(global_number)%NUMBER_OF_DOMAINS
232  domain_no=domain_mapping%GLOBAL_TO_LOCAL_MAP(global_number)%DOMAIN_NUMBER(domain_idx)
233  IF(domain_no==my_computational_node_number) THEN
234  my_domain_index=domain_idx
235  EXIT
236  ENDIF
237  ENDDO !domain_idx
238 
239  !if necessary, swap the data structure at the current domain index for my computational node with domain index 1
240  IF(my_domain_index/=1) THEN
241  !Swap domain index in the global to local map, 1 <-> MY_DOMAIN_INDEX
242  temp=domain_mapping%GLOBAL_TO_LOCAL_MAP(global_number)%LOCAL_NUMBER(1)
243  domain_mapping%GLOBAL_TO_LOCAL_MAP(global_number)%LOCAL_NUMBER(1) = &
244  & domain_mapping%GLOBAL_TO_LOCAL_MAP(global_number)%LOCAL_NUMBER(my_domain_index)
245  domain_mapping%GLOBAL_TO_LOCAL_MAP(global_number)%LOCAL_NUMBER(my_domain_index) = temp
246 
247  temp=domain_mapping%GLOBAL_TO_LOCAL_MAP(global_number)%DOMAIN_NUMBER(1)
248  domain_mapping%GLOBAL_TO_LOCAL_MAP(global_number)%DOMAIN_NUMBER(1) = &
249  & domain_mapping%GLOBAL_TO_LOCAL_MAP(global_number)%DOMAIN_NUMBER(my_domain_index)
250  domain_mapping%GLOBAL_TO_LOCAL_MAP(global_number)%DOMAIN_NUMBER(my_domain_index) = temp
251 
252  temp=domain_mapping%GLOBAL_TO_LOCAL_MAP(global_number)%LOCAL_TYPE(1)
253  domain_mapping%GLOBAL_TO_LOCAL_MAP(global_number)%LOCAL_TYPE(1) = &
254  & domain_mapping%GLOBAL_TO_LOCAL_MAP(global_number)%LOCAL_TYPE(my_domain_index)
255  domain_mapping%GLOBAL_TO_LOCAL_MAP(global_number)%LOCAL_TYPE(my_domain_index) = temp
256  ENDIF
257 
258  !set the global adjacent_domains array to 1 for domains that share the current element
259  DO domain_idx=1,domain_mapping%GLOBAL_TO_LOCAL_MAP(global_number)%NUMBER_OF_DOMAINS
260  domain_no=domain_mapping%GLOBAL_TO_LOCAL_MAP(global_number)%DOMAIN_NUMBER(domain_idx)
261  DO domain_idx2=1,domain_mapping%GLOBAL_TO_LOCAL_MAP(global_number)%NUMBER_OF_DOMAINS
262  domain_no2=domain_mapping%GLOBAL_TO_LOCAL_MAP(global_number)%DOMAIN_NUMBER(domain_idx2)
263  adjacent_domains(domain_no,domain_no2)=1
264  ENDDO !domain_idx2
265  ENDDO !domain_idx
266 
267  !loop over domains where current element is
268  DO domain_idx=1,domain_mapping%GLOBAL_TO_LOCAL_MAP(global_number)%NUMBER_OF_DOMAINS
269  domain_no=domain_mapping%GLOBAL_TO_LOCAL_MAP(global_number)%DOMAIN_NUMBER(domain_idx)
270  local_type=domain_mapping%GLOBAL_TO_LOCAL_MAP(global_number)%LOCAL_TYPE(domain_idx)
271  !increment counter of total ghost/local elements per domain
272  IF(local_type==domain_local_ghost) THEN
273  domain_mapping%NUMBER_OF_DOMAIN_GHOST(domain_no)=domain_mapping%NUMBER_OF_DOMAIN_GHOST(domain_no)+1
274  ELSE
275  domain_mapping%NUMBER_OF_DOMAIN_LOCAL(domain_no)=domain_mapping%NUMBER_OF_DOMAIN_LOCAL(domain_no)+1
276  ENDIF
277 
278  !increment counter of internal, boundary and ghost elements on my domain
279  IF(domain_no==my_computational_node_number) THEN
280  SELECT CASE(local_type)
281  CASE(domain_local_internal)
282  number_internal=number_internal+1
283  CASE(domain_local_boundary)
284  number_boundary=number_boundary+1
285  CASE(domain_local_ghost)
286  number_ghost=number_ghost+1
287  CASE DEFAULT
288  local_error="The domain local type of "//trim(number_to_vstring(domain_mapping%GLOBAL_TO_LOCAL_MAP( &
289  & global_number)%LOCAL_TYPE(domain_idx),"*",err,error))//" is invalid."
290  CALL flagerror(local_error,err,error,*999)
291  END SELECT
292  ENDIF
293  ENDDO !domain_idx
294  ENDDO !global_number
295 
296  !!TODO: move adjacent domains calculation back to where the global to local array is set up????
297  !count number of adjacent domains for my domain and in total
298  number_of_adjacent_domains=0
299  total_number_of_adjacent_domains=0
300  DO domain_no=0,domain_mapping%NUMBER_OF_DOMAINS-1
301  DO domain_no2=0,domain_mapping%NUMBER_OF_DOMAINS-1
302  IF(domain_no/=domain_no2) THEN
303  IF(adjacent_domains(domain_no,domain_no2)>0) THEN
304  total_number_of_adjacent_domains=total_number_of_adjacent_domains+1
305  IF(domain_no==my_computational_node_number) number_of_adjacent_domains=number_of_adjacent_domains+1
306  ENDIF
307  ENDIF
308  ENDDO !domain_no2
309  ENDDO !domain_no
310 
311  ALLOCATE(domain_mapping%ADJACENT_DOMAINS_PTR(0:domain_mapping%NUMBER_OF_DOMAINS),stat=err)
312  IF(err/=0) CALL flagerror("Could not allocate adjacent domains ptr.",err,error,*999)
313  ALLOCATE(domain_mapping%ADJACENT_DOMAINS_LIST(total_number_of_adjacent_domains),stat=err)
314  IF(err/=0) CALL flagerror("Could not allocate adjacent domains list.",err,error,*999)
315 
316  ! store the adjacent domains for a domain in ADJACENT_DOMAINS_LIST starting at index COUNT and store the starting index COUNT in ADJACENT_DOMAINS_PTR
317  ! the adjacent domains for a domain are then ADJACENT_DOMAINS_LIST(ADJACENT_DOMAINS_PTR(domain) : ADJACENT_DOMAINS_PTR(domain+1))
318  count=1
319  DO domain_no=0,domain_mapping%NUMBER_OF_DOMAINS-1
320  domain_mapping%ADJACENT_DOMAINS_PTR(domain_no)=count
321  DO domain_no2=0,domain_mapping%NUMBER_OF_DOMAINS-1
322  IF(domain_no/=domain_no2) THEN
323  IF(adjacent_domains(domain_no,domain_no2)>0) THEN
324  domain_mapping%ADJACENT_DOMAINS_LIST(count)=domain_no2
325  count=count+1
326  ENDIF
327  ENDIF
328  ENDDO !domain_no2
329  ENDDO !domain_no
330 
331  domain_mapping%ADJACENT_DOMAINS_PTR(domain_mapping%NUMBER_OF_DOMAINS)=count
332  DEALLOCATE(adjacent_domains)
333 
334  !compute domain list for my computational node
335  ALLOCATE(domain_mapping%DOMAIN_LIST(number_internal+number_boundary+number_ghost),stat=err)
336  IF(err/=0) CALL flagerror("Could not allocate domain map domain list.",err,error,*999)
337  ALLOCATE(domain_mapping%LOCAL_TO_GLOBAL_MAP(number_internal+number_boundary+number_ghost),stat=err)
338  IF(err/=0) CALL flagerror("Could not allocate domain map local to global list.",err,error,*999)
339 
340  !set constants
341  domain_mapping%TOTAL_NUMBER_OF_LOCAL=number_internal+number_boundary+number_ghost
342  domain_mapping%NUMBER_OF_LOCAL=number_internal+number_boundary
343  domain_mapping%NUMBER_OF_INTERNAL=number_internal
344  domain_mapping%NUMBER_OF_BOUNDARY=number_boundary
345  domain_mapping%NUMBER_OF_GHOST=number_ghost
346  domain_mapping%INTERNAL_START=1
347  domain_mapping%INTERNAL_FINISH=number_internal
348  domain_mapping%BOUNDARY_START=number_internal+1
349  domain_mapping%BOUNDARY_FINISH=number_internal+number_boundary
350  domain_mapping%GHOST_START=number_internal+number_boundary+1
351  domain_mapping%GHOST_FINISH=number_internal+number_boundary+number_ghost
352 
353  ! adjacent_domains maps a domain index (index between 1 and DOMAIN_MAPPING%NUMBER_OF_ADJACENT_DOMAINS) to the domain number
354  ALLOCATE(domain_mapping%ADJACENT_DOMAINS(number_of_adjacent_domains),stat=err)
355  IF(err/=0) CALL flagerror("Could not allocate adjacent domains.",err,error,*999)
356  domain_mapping%NUMBER_OF_ADJACENT_DOMAINS=number_of_adjacent_domains
357 
358  ! adjacent_domain_map maps a domain number back to its index (index between 1 and DOMAIN_MAPPING%NUMBER_OF_ADJACENT_DOMAINS)
359  ALLOCATE(adjacent_domain_map(0:domain_mapping%NUMBER_OF_DOMAINS-1),stat=err)
360  IF(err/=0) CALL flagerror("Could not allocate adjacent domain map.",err,error,*999)
361 
362  ! ghost_send_lists contains a list for each adjacent domain with elements in my domain (by local element numbers) that will be sent to that foreign domain
363  ALLOCATE(ghost_send_lists(domain_mapping%NUMBER_OF_ADJACENT_DOMAINS),stat=err)
364  IF(err/=0) CALL flagerror("Could not allocate ghost send list.",err,error,*999)
365 
366  ! ghost_receive_lists contains a list for each adjacent domain and contains the local numbers of ghost elements that can be received from that foreign domain
367  ALLOCATE(ghost_receive_lists(domain_mapping%NUMBER_OF_ADJACENT_DOMAINS),stat=err)
368  IF(err/=0) CALL flagerror("Could not allocate ghost recieve list.",err,error,*999)
369 
370  ! set adjacent domains data structures and initialize ghost send and receive lists
371  ! loop over adjacent domains of my computational node
372  DO domain_idx=1,domain_mapping%NUMBER_OF_ADJACENT_DOMAINS
373  ! set variables to 0
374  CALL domain_mappings_adjacent_domain_initialise(domain_mapping%ADJACENT_DOMAINS(domain_idx),err,error,*999)
375 
376  ! get number of current adjacent domain
377  domain_no= &
378  & domain_mapping%ADJACENT_DOMAINS_LIST(domain_mapping%ADJACENT_DOMAINS_PTR(my_computational_node_number)+domain_idx-1)
379 
380  ! set number in adjacent_domains and adjacent_domain_map
381  domain_mapping%ADJACENT_DOMAINS(domain_idx)%DOMAIN_NUMBER=domain_no
382  adjacent_domain_map(domain_no)=domain_idx
383 
384  ! initialize send and receive lists for ghosts
385  NULLIFY(ghost_send_lists(domain_idx)%PTR)
386  CALL list_create_start(ghost_send_lists(domain_idx)%PTR,err,error,*999)
387  CALL list_data_type_set(ghost_send_lists(domain_idx)%PTR,list_intg_type,err,error,*999)
388  CALL list_initial_size_set(ghost_send_lists(domain_idx)%PTR,max(domain_mapping%NUMBER_OF_GHOST,1),err,error,*999)
389  CALL list_create_finish(ghost_send_lists(domain_idx)%PTR,err,error,*999)
390 
391  NULLIFY(ghost_receive_lists(domain_idx)%PTR)
392  CALL list_create_start(ghost_receive_lists(domain_idx)%PTR,err,error,*999)
393  CALL list_data_type_set(ghost_receive_lists(domain_idx)%PTR,list_intg_type,err,error,*999)
394  CALL list_initial_size_set(ghost_receive_lists(domain_idx)%PTR,max(domain_mapping%NUMBER_OF_GHOST,1),err,error,*999)
395  CALL list_create_finish(ghost_receive_lists(domain_idx)%PTR,err,error,*999)
396  ENDDO !domain_idx
397 
398  number_internal=0
399  number_boundary=0
400  number_ghost=0
401 
402  ! loop over global elements
403  DO global_number=1,domain_mapping%NUMBER_OF_GLOBAL
404  send_global=.false.
405 
406  ! set RECEIVE_FROM_DOMAIN and SEND_GLOBAL
407  ! if element is on multiple domains
408  IF(domain_mapping%GLOBAL_TO_LOCAL_MAP(global_number)%NUMBER_OF_DOMAINS>1) THEN
409 
410  !Check if we have a special case where the global number is owned by all domains e.g., as in a constant field
411  IF(domain_mapping%GLOBAL_TO_LOCAL_MAP(global_number)%NUMBER_OF_DOMAINS==domain_mapping%NUMBER_OF_DOMAINS) THEN
412  owned_by_all=.true.
413 
414  ! check if the element is an internal element on all domains
415  DO domain_idx=1,domain_mapping%GLOBAL_TO_LOCAL_MAP(global_number)%NUMBER_OF_DOMAINS
416  local_type=domain_mapping%GLOBAL_TO_LOCAL_MAP(global_number)%LOCAL_TYPE(domain_idx)
417  owned_by_all=owned_by_all.AND.local_type==domain_local_internal
418  ENDDO !domain_idx
419  ELSE
420  owned_by_all=.false.
421  ENDIF
422 
423  ! if the element is not owned by all domains
424  IF(.NOT.owned_by_all) THEN
425  receive_from_domain=-1
426 
427  ! loop over the domains where the current element is present
428  DO domain_idx=1,domain_mapping%GLOBAL_TO_LOCAL_MAP(global_number)%NUMBER_OF_DOMAINS
429  domain_no=domain_mapping%GLOBAL_TO_LOCAL_MAP(global_number)%DOMAIN_NUMBER(domain_idx)
430  local_type=domain_mapping%GLOBAL_TO_LOCAL_MAP(global_number)%LOCAL_TYPE(domain_idx)
431 
432  IF(local_type/=domain_local_ghost) THEN
433  IF(domain_no==my_computational_node_number) send_global=.true.
434  IF(receive_from_domain==-1) THEN
435  receive_from_domain=domain_no
436  ELSE
437  local_error="Invalid domain mapping. Global number "//trim(number_to_vstring(global_number,"*",err,error))// &
438  & " is owned by domain number "//trim(number_to_vstring(receive_from_domain,"*",err,error))// &
439  & " as well as domain number "//trim(number_to_vstring(domain_no,"*",err,error))//"."
440  CALL flagerror(local_error,err,error,*999)
441  ENDIF
442  ENDIF
443  ENDDO !domain_idx
444 
445  IF(receive_from_domain==-1) THEN
446  local_error="Invalid domain mapping. Global number "//trim(number_to_vstring(global_number,"*",err,error))// &
447  & " is not owned by any domain."
448  CALL flagerror(local_error,err,error,*999)
449  ENDIF
450  ENDIF
451  ENDIF
452 
453  ! loop over domains of current element
454  DO domain_idx=1,domain_mapping%GLOBAL_TO_LOCAL_MAP(global_number)%NUMBER_OF_DOMAINS
455  domain_no=domain_mapping%GLOBAL_TO_LOCAL_MAP(global_number)%DOMAIN_NUMBER(domain_idx)
456  local_number=domain_mapping%GLOBAL_TO_LOCAL_MAP(global_number)%LOCAL_NUMBER(domain_idx)
457  local_type=domain_mapping%GLOBAL_TO_LOCAL_MAP(global_number)%LOCAL_TYPE(domain_idx)
458 
459  IF(domain_no==my_computational_node_number) THEN
460  ! set local number
461  domain_mapping%LOCAL_TO_GLOBAL_MAP(local_number)=global_number
462 
463  ! set entry of current element in domain_list
464  SELECT CASE(domain_mapping%GLOBAL_TO_LOCAL_MAP(global_number)%LOCAL_TYPE(domain_idx))
465  CASE(domain_local_internal)
466  number_internal=number_internal+1
467  domain_mapping%DOMAIN_LIST(number_internal)=local_number
468  CASE(domain_local_boundary)
469  number_boundary=number_boundary+1
470  domain_mapping%DOMAIN_LIST(domain_mapping%INTERNAL_FINISH+number_boundary)=local_number
471  CASE(domain_local_ghost)
472  number_ghost=number_ghost+1
473  domain_mapping%DOMAIN_LIST(domain_mapping%BOUNDARY_FINISH+number_ghost)=local_number
474 
475  ! add local number of ghost element to receive list of domain from which to receive
476  CALL list_item_add(ghost_receive_lists(adjacent_domain_map(receive_from_domain))%PTR,local_number,err,error,*999)
477  CASE DEFAULT
478  local_error="The domain local type of "//trim(number_to_vstring(domain_mapping%GLOBAL_TO_LOCAL_MAP( &
479  & global_number)%LOCAL_TYPE(domain_idx),"*",err,error))//" is invalid."
480  CALL flagerror(local_error,err,error,*999)
481  END SELECT
482 
483  ELSE IF(send_global.AND.local_type==domain_local_ghost) THEN
484  local_number2=domain_mapping%GLOBAL_TO_LOCAL_MAP(global_number)%LOCAL_NUMBER(1) !The local number for this node
485  CALL list_item_add(ghost_send_lists(adjacent_domain_map(domain_no))%PTR,local_number2,err,error,*999)
486  ENDIF
487  ENDDO !domain_idx
488  ENDDO !global_number
489 
490  ! loop over adjacent domains
491  DO domain_idx=1,domain_mapping%NUMBER_OF_ADJACENT_DOMAINS
492 
493  ! transfer the ghost_send_list for adjacent domain to LOCAL_GHOST_SEND_INDICES
494  CALL list_remove_duplicates(ghost_send_lists(domain_idx)%PTR,err,error,*999)
495  CALL list_detach_and_destroy(ghost_send_lists(domain_idx)%PTR,number_of_ghost_send,send_list,err,error,*999)
496 
497  ALLOCATE(domain_mapping%ADJACENT_DOMAINS(domain_idx)%LOCAL_GHOST_SEND_INDICES(number_of_ghost_send),stat=err)
498  IF(err/=0) CALL flagerror("Could not allocate local ghost send inidices.",err,error,*999)
499 
500  domain_mapping%ADJACENT_DOMAINS(domain_idx)%LOCAL_GHOST_SEND_INDICES(1:number_of_ghost_send)= &
501  & send_list(1:number_of_ghost_send)
502 
503  domain_mapping%ADJACENT_DOMAINS(domain_idx)%NUMBER_OF_SEND_GHOSTS=number_of_ghost_send
504  DEALLOCATE(send_list)
505 
506  ! transfer the ghost_receive_lists for the current adjacent domain to LOCAL_GHOST_RECEIVE_INDICES
507  CALL list_remove_duplicates(ghost_receive_lists(domain_idx)%PTR,err,error,*999)
508  CALL list_detach_and_destroy(ghost_receive_lists(domain_idx)%PTR,number_of_ghost_receive,receive_list,err,error,*999)
509 
510  ALLOCATE(domain_mapping%ADJACENT_DOMAINS(domain_idx)%LOCAL_GHOST_RECEIVE_INDICES(number_of_ghost_receive),stat=err)
511  IF(err/=0) CALL flagerror("Could not allocate local ghost receive inidices.",err,error,*999)
512 
513  domain_mapping%ADJACENT_DOMAINS(domain_idx)%LOCAL_GHOST_RECEIVE_INDICES(1:number_of_ghost_receive)= &
514  & receive_list(1:number_of_ghost_receive)
515 
516  domain_mapping%ADJACENT_DOMAINS(domain_idx)%NUMBER_OF_RECEIVE_GHOSTS=number_of_ghost_receive
517  DEALLOCATE(receive_list)
518 
519  ENDDO !domain_idx
520 
521  DEALLOCATE(adjacent_domain_map)
522  DEALLOCATE(ghost_send_lists)
523  DEALLOCATE(ghost_receive_lists)
524 
525  IF(diagnostics1) THEN
526  CALL write_string(diagnostic_output_type,"Domain mappings:",err,error,*999)
527  CALL write_string_value(diagnostic_output_type," Number of domains = ",domain_mapping%NUMBER_OF_DOMAINS,err,error,*999)
528  CALL write_string_value(diagnostic_output_type," Number of global = ",domain_mapping%NUMBER_OF_GLOBAL,err,error,*999)
529  CALL write_string_value(diagnostic_output_type," Number of local = ",domain_mapping%NUMBER_OF_LOCAL,err,error,*999)
530  CALL write_string_value(diagnostic_output_type," Total number of local = ",domain_mapping%TOTAL_NUMBER_OF_LOCAL, &
531  & err,error,*999)
532  CALL write_string(diagnostic_output_type," Domain numbers:",err,error,*999)
533  CALL write_string_vector(diagnostic_output_type,1,1,domain_mapping%NUMBER_OF_DOMAINS,8,8,domain_mapping% &
534  & number_of_domain_local,'(" Number of domain local :",8(X,I10))','(26X,8(X,I10))',err,error,*999)
535  CALL write_string_vector(diagnostic_output_type,1,1,domain_mapping%NUMBER_OF_DOMAINS,8,8,domain_mapping% &
536  & number_of_domain_ghost,'(" Number of domain ghost :",8(X,I10))','(26X,8(X,I10))',err,error,*999)
537  CALL write_string(diagnostic_output_type," Domain list:",err,error,*999)
538  CALL write_string_value(diagnostic_output_type," Number of internal = ",domain_mapping%NUMBER_OF_INTERNAL,err,error,*999)
539  CALL write_string_value(diagnostic_output_type," Number of boundary = ",domain_mapping%NUMBER_OF_BOUNDARY,err,error,*999)
540  CALL write_string_value(diagnostic_output_type," Number of ghost = ",domain_mapping%NUMBER_OF_GHOST,err,error,*999)
541  CALL write_string_value(diagnostic_output_type," Internal start = ",domain_mapping%INTERNAL_START,err,error,*999)
542  CALL write_string_value(diagnostic_output_type," Internal finish = ",domain_mapping%INTERNAL_FINISH,err,error,*999)
543  CALL write_string_value(diagnostic_output_type," Boundary start = ",domain_mapping%BOUNDARY_START,err,error,*999)
544  CALL write_string_value(diagnostic_output_type," Boundary finish = ",domain_mapping%BOUNDARY_FINISH,err,error,*999)
545  CALL write_string_value(diagnostic_output_type," Ghost start = ",domain_mapping%GHOST_START,err,error,*999)
546  CALL write_string_value(diagnostic_output_type," Ghost finish = ",domain_mapping%GHOST_FINISH,err,error,*999)
547  CALL write_string_vector(diagnostic_output_type,domain_mapping%INTERNAL_START,1,domain_mapping%INTERNAL_FINISH,8,8, &
548  & domain_mapping%DOMAIN_LIST,'(" Internal list :",8(X,I10))','(19X,8(X,I10))',err,error,*999)
549  CALL write_string_vector(diagnostic_output_type,domain_mapping%BOUNDARY_START,1,domain_mapping%BOUNDARY_FINISH,8,8, &
550  & domain_mapping%DOMAIN_LIST,'(" Boundary list :",8(X,I10))','(19X,8(X,I10))',err,error,*999)
551  CALL write_string_vector(diagnostic_output_type,domain_mapping%GHOST_START,1,domain_mapping%GHOST_FINISH,8,8, &
552  & domain_mapping%DOMAIN_LIST,'(" Ghost list :",8(X,I10))','(19X,8(X,I10))',err,error,*999)
553  CALL write_string(diagnostic_output_type," Local to global map:",err,error,*999)
554  DO idx=1,domain_mapping%TOTAL_NUMBER_OF_LOCAL
555  CALL write_string_value(diagnostic_output_type," Local index : ",idx,err,error,*999)
556  CALL write_string_value(diagnostic_output_type," Global index = ",domain_mapping%LOCAL_TO_GLOBAL_MAP(idx), &
557  & err,error,*999)
558  ENDDO !idx
559  CALL write_string(diagnostic_output_type," Global to local map:",err,error,*999)
560  DO idx=1,domain_mapping%NUMBER_OF_GLOBAL
561  CALL write_string_value(diagnostic_output_type," Global idx : ",idx,err,error,*999)
562  CALL write_string_value(diagnostic_output_type," Number of domains = ", &
563  & domain_mapping%GLOBAL_TO_LOCAL_MAP(idx)%NUMBER_OF_DOMAINS,err,error,*999)
564  CALL write_string_vector(diagnostic_output_type,1,1,domain_mapping%GLOBAL_TO_LOCAL_MAP(idx)% &
565  & number_of_domains,8,8,domain_mapping%GLOBAL_TO_LOCAL_MAP(idx)%LOCAL_NUMBER, &
566  & '(" Local number :",8(X,I10))','(21X,8(X,I10))',err,error,*999)
567  CALL write_string_vector(diagnostic_output_type,1,1,domain_mapping%GLOBAL_TO_LOCAL_MAP(idx)% &
568  & number_of_domains,8,8,domain_mapping%GLOBAL_TO_LOCAL_MAP(idx)%DOMAIN_NUMBER, &
569  & '(" Domain number :",8(X,I10))','(21X,8(X,I10))',err,error,*999)
570  CALL write_string_vector(diagnostic_output_type,1,1,domain_mapping%GLOBAL_TO_LOCAL_MAP(idx)% &
571  & number_of_domains,8,8,domain_mapping%GLOBAL_TO_LOCAL_MAP(idx)%LOCAL_TYPE, &
572  & '(" Local type :",8(X,I10))','(21X,8(X,I10))',err,error,*999)
573  ENDDO !ne
574  CALL write_string(diagnostic_output_type," Adjacent domains:",err,error,*999)
575  CALL write_string_value(diagnostic_output_type," Number of adjacent domains = ", &
576  & domain_mapping%NUMBER_OF_ADJACENT_DOMAINS,err,error,*999)
577  CALL write_string_vector(diagnostic_output_type,1,1,domain_mapping%NUMBER_OF_DOMAINS+1,8,8, &
578  & domain_mapping%ADJACENT_DOMAINS_PTR,'(" Adjacent domains ptr :",8(X,I5))','(27X,8(X,I5))',err,error,*999)
579  IF(domain_mapping%NUMBER_OF_ADJACENT_DOMAINS>0) THEN
580  CALL write_string_vector(diagnostic_output_type,1,1,domain_mapping%ADJACENT_DOMAINS_PTR( &
581  & domain_mapping%NUMBER_OF_DOMAINS)-1,8,8,domain_mapping%ADJACENT_DOMAINS_LIST, &
582  '(" Adjacent domains list :",8(X,I5))','(27X,8(X,I5))',err,error,*999)
583  DO domain_idx=1,domain_mapping%NUMBER_OF_ADJACENT_DOMAINS
584  CALL write_string_value(diagnostic_output_type," Adjacent domain idx : ",domain_idx,err,error,*999)
585  CALL write_string_value(diagnostic_output_type," Domain number = ", &
586  & domain_mapping%ADJACENT_DOMAINS(domain_idx)%DOMAIN_NUMBER,err,error,*999)
587  CALL write_string_value(diagnostic_output_type," Number of send ghosts = ", &
588  & domain_mapping%ADJACENT_DOMAINS(domain_idx)%NUMBER_OF_SEND_GHOSTS,err,error,*999)
589  CALL write_string_vector(diagnostic_output_type,1,1,domain_mapping%ADJACENT_DOMAINS(domain_idx)% &
590  & number_of_send_ghosts,8,8,domain_mapping%ADJACENT_DOMAINS(domain_idx)%LOCAL_GHOST_SEND_INDICES, &
591  & '(" Local send ghost indices :",8(X,I10))','(39X,8(X,I10))',err,error,*999)
592  CALL write_string_value(diagnostic_output_type," Number of receive ghosts = ", &
593  & domain_mapping%ADJACENT_DOMAINS(domain_idx)%NUMBER_OF_RECEIVE_GHOSTS,err,error,*999)
594  CALL write_string_vector(diagnostic_output_type,1,1,domain_mapping%ADJACENT_DOMAINS(domain_idx)% &
595  & number_of_receive_ghosts,8,8,domain_mapping%ADJACENT_DOMAINS(domain_idx)%LOCAL_GHOST_RECEIVE_INDICES, &
596  & '(" Local receive ghost indices :",8(X,I10))','(39X,8(X,I10))',err,error,*999)
597  ENDDO !domain_idx
598  ENDIF
599  ENDIF
600 
601  ELSE
602  CALL flagerror("Domain mapping is not associated.",err,error,*999)
603  ENDIF
604 
605  exits("DOMAIN_MAPPINGS_LOCAL_FROM_GLOBAL_CALCULATE")
606  RETURN
607 999 IF(ALLOCATED(send_list)) DEALLOCATE(send_list)
608  IF(ALLOCATED(receive_list)) DEALLOCATE(receive_list)
609  IF(ALLOCATED(adjacent_domain_map)) DEALLOCATE(adjacent_domain_map)
610  IF(ALLOCATED(adjacent_domains)) DEALLOCATE(adjacent_domains)
611  IF(ALLOCATED(ghost_send_lists)) THEN
612  DO domain_idx=1,SIZE(ghost_send_lists)
613  IF(ASSOCIATED(ghost_send_lists(domain_idx)%PTR)) &
614  & CALL list_destroy(ghost_send_lists(domain_idx)%PTR,dummy_err,dummy_error,*998)
615  ENDDO ! domain_idx
616 998 DEALLOCATE(ghost_send_lists)
617  ENDIF
618  IF(ALLOCATED(ghost_receive_lists)) THEN
619  DO domain_idx=1,SIZE(ghost_receive_lists)
620  IF(ASSOCIATED(ghost_receive_lists(domain_idx)%PTR)) &
621  & CALL list_destroy(ghost_receive_lists(domain_idx)%PTR,dummy_err,dummy_error,*997)
622  ENDDO ! domain_idx
623 997 DEALLOCATE(ghost_receive_lists)
624  ENDIF
625  errorsexits("DOMAIN_MAPPINGS_LOCAL_FROM_GLOBAL_CALCULATE",err,error)
626  RETURN 1
627 
628  END SUBROUTINE domain_mappings_local_from_global_calculate
629 
630  !
631  !================================================================================================================================
632  !
633 
635  SUBROUTINE domain_mappings_mapping_finalise(DOMAIN_MAPPING,ERR,ERROR,*)
636 
637  !Argument variables
638  TYPE(domain_mapping_type), POINTER :: DOMAIN_MAPPING
639  INTEGER(INTG), INTENT(OUT) :: ERR
640  TYPE(varying_string), INTENT(OUT) :: ERROR
641  !Local Variables
642  INTEGER(INTG) :: idx
643 
644  enters("DOMAIN_MAPPINGS_MAPPING_FINALISE",err,error,*999)
645 
646  IF(ASSOCIATED(domain_mapping)) THEN
647  IF(ALLOCATED(domain_mapping%NUMBER_OF_DOMAIN_LOCAL)) DEALLOCATE(domain_mapping%NUMBER_OF_DOMAIN_LOCAL)
648  IF(ALLOCATED(domain_mapping%NUMBER_OF_DOMAIN_GHOST)) DEALLOCATE(domain_mapping%NUMBER_OF_DOMAIN_GHOST)
649  IF(ALLOCATED(domain_mapping%DOMAIN_LIST)) DEALLOCATE(domain_mapping%DOMAIN_LIST)
650  IF(ALLOCATED(domain_mapping%LOCAL_TO_GLOBAL_MAP)) DEALLOCATE(domain_mapping%LOCAL_TO_GLOBAL_MAP)
651  IF(ALLOCATED(domain_mapping%GLOBAL_TO_LOCAL_MAP)) THEN
652  DO idx=1,SIZE(domain_mapping%GLOBAL_TO_LOCAL_MAP,1)
653  CALL domain_mappings_mapping_global_finalise(domain_mapping%GLOBAL_TO_LOCAL_MAP(idx),err,error,*999)
654  ENDDO !idx
655  DEALLOCATE(domain_mapping%GLOBAL_TO_LOCAL_MAP)
656  ENDIF
657  IF(ALLOCATED(domain_mapping%ADJACENT_DOMAINS_PTR)) DEALLOCATE(domain_mapping%ADJACENT_DOMAINS_PTR)
658  IF(ALLOCATED(domain_mapping%ADJACENT_DOMAINS_LIST)) DEALLOCATE(domain_mapping%ADJACENT_DOMAINS_LIST)
659  IF(ALLOCATED(domain_mapping%ADJACENT_DOMAINS)) THEN
660  DO idx=1,SIZE(domain_mapping%ADJACENT_DOMAINS,1)
661  CALL domain_mappings_adjacent_domain_finalise(domain_mapping%ADJACENT_DOMAINS(idx),err,error,*999)
662  ENDDO !idx
663  DEALLOCATE(domain_mapping%ADJACENT_DOMAINS)
664  ENDIF
665  DEALLOCATE(domain_mapping)
666  ENDIF
667 
668  exits("DOMAIN_MAPPINGS_MAPPING_FINALISE")
669  RETURN
670 999 errorsexits("DOMAIN_MAPPINGS_MAPPING_FINALISE",err,error)
671  RETURN 1
672  END SUBROUTINE domain_mappings_mapping_finalise
673 
674  !
675  !================================================================================================================================
676  !
677 
679  SUBROUTINE domain_mappings_mapping_global_finalise(MAPPING_GLOBAL_MAP,ERR,ERROR,*)
680 
681  !Argument variables
682  TYPE(domain_global_mapping_type) :: MAPPING_GLOBAL_MAP
683  INTEGER(INTG), INTENT(OUT) :: ERR
684  TYPE(varying_string), INTENT(OUT) :: ERROR
685  !Local Variables
686 
687  enters("DOMAIN_MAPPINGS_MAPPING_GLOBAL_FINALISE",err,error,*999)
688 
689  IF(ALLOCATED(mapping_global_map%LOCAL_NUMBER)) DEALLOCATE(mapping_global_map%LOCAL_NUMBER)
690  IF(ALLOCATED(mapping_global_map%DOMAIN_NUMBER)) DEALLOCATE(mapping_global_map%DOMAIN_NUMBER)
691  IF(ALLOCATED(mapping_global_map%LOCAL_TYPE)) DEALLOCATE(mapping_global_map%LOCAL_TYPE)
692 
693  exits("DOMAIN_MAPPINGS_MAPPING_GLOBAL_FINALISE")
694  RETURN
695 999 errorsexits("DOMAIN_MAPPINGS_MAPPING_GLOBAL_FINALISE",err,error)
696  RETURN 1
697 
698  END SUBROUTINE domain_mappings_mapping_global_finalise
699 
700  !
701  !================================================================================================================================
702  !
703 
705  SUBROUTINE domain_mappings_mapping_global_initialise(MAPPING_GLOBAL_MAP,ERR,ERROR,*)
706 
707  !Argument variables
708  TYPE(domain_global_mapping_type) :: MAPPING_GLOBAL_MAP
709  INTEGER(INTG), INTENT(OUT) :: ERR
710  TYPE(varying_string), INTENT(OUT) :: ERROR
711  !Local Variables
712 
713  enters("DOMAIN_MAPPINGS_MAPPING_GLOBAL_INITIALISE",err,error,*999)
714 
715  mapping_global_map%NUMBER_OF_DOMAINS=0
716 
717  exits("DOMAIN_MAPPINGS_MAPPING_GLOBAL_INITIALISE")
718  RETURN
719 999 errorsexits("DOMAIN_MAPPINGS_MAPPING_GLOBAL_INITIALISE",err,error)
720  RETURN 1
721 
722  END SUBROUTINE domain_mappings_mapping_global_initialise
723 
724  !
725  !================================================================================================================================
726  !
727 
729  SUBROUTINE domain_mappings_mapping_initialise(DOMAIN_MAPPING,NUMBER_OF_DOMAINS,ERR,ERROR,*)
730 
731  !Argument variables
732  TYPE(domain_mapping_type), POINTER :: DOMAIN_MAPPING
733  INTEGER(INTG), INTENT(IN) :: NUMBER_OF_DOMAINS
734  INTEGER(INTG), INTENT(OUT) :: ERR
735  TYPE(varying_string), INTENT(OUT) :: ERROR
736  !Local Variables
737  TYPE(varying_string) :: LOCAL_ERROR
738 
739  enters("DOMAIN_MAPPINGS_MAPPING_INITIALISE",err,error,*999)
740 
741  IF(ASSOCIATED(domain_mapping)) THEN
742  IF(number_of_domains>0) THEN
743  domain_mapping%TOTAL_NUMBER_OF_LOCAL=0
744  domain_mapping%NUMBER_OF_LOCAL=0
745  domain_mapping%NUMBER_OF_GLOBAL=0
746  domain_mapping%NUMBER_OF_DOMAINS=number_of_domains
747  domain_mapping%NUMBER_OF_INTERNAL=0
748  domain_mapping%NUMBER_OF_BOUNDARY=0
749  domain_mapping%NUMBER_OF_GHOST=0
750  domain_mapping%INTERNAL_START=0
751  domain_mapping%INTERNAL_FINISH=0
752  domain_mapping%BOUNDARY_START=0
753  domain_mapping%BOUNDARY_FINISH=0
754  domain_mapping%GHOST_START=0
755  domain_mapping%GHOST_FINISH=0
756  domain_mapping%NUMBER_OF_ADJACENT_DOMAINS=0
757  ELSE
758  local_error="The specified number of domains of "//trim(number_to_vstring(number_of_domains,"*",err,error))// &
759  & " is invalid. The number of domains must be > 0."
760  CALL flagerror(local_error,err,error,*999)
761  ENDIF
762  ENDIF
763 
764  exits("DOMAIN_MAPPINGS_MAPPING_INITIALISE")
765  RETURN
766 999 errorsexits("DOMAIN_MAPPINGS_MAPPING_INITIALISE",err,error)
767  RETURN 1
768  END SUBROUTINE domain_mappings_mapping_initialise
769 
770  !
771  !================================================================================================================================
772  !
773 
774 END MODULE domain_mappings
base_routines::enters
subroutine, public enters(NAME, ERR, ERROR,)
Records the entry into the named procedure and initialises the error code.
Definition: base_routines.f90:363
input_output::write_string_value
Write a string followed by a value to a given output stream.
Definition: input_output.f90:86
strings::number_to_vstring
Converts a number to its equivalent varying string representation.
Definition: strings.f90:161
domain_mappings::domain_local_boundary
integer(intg), parameter, public domain_local_boundary
The domain item is on the boundary of the domain.
Definition: domain_mappings.f90:69
strings
This module contains all string manipulation and transformation routines.
Definition: strings.f90:45
domain_mappings::domain_mappings_mapping_global_finalise
subroutine domain_mappings_mapping_global_finalise(MAPPING_GLOBAL_MAP, ERR, ERROR,)
Finalises the global mapping in the given domain mappings.
Definition: domain_mappings.f90:680
lists::list_intg_type
integer(intg), parameter, public list_intg_type
Integer data type for a list.
Definition: lists.f90:67
iso_varying_string
This module provides an iso_varying_string module, conformant to the API specified in ISO/IEC 1539-2:...
Definition: iso_varying_string.f90:62
lists::list_remove_duplicates
subroutine, public list_remove_duplicates(LIST, ERR, ERROR,)
Removes duplicate entries from a list. A side effect of this is that the list is sorted.
Definition: lists.f90:2648
iso_varying_string::varying_string
Definition: iso_varying_string.f90:75
domain_mappings::domain_local_ghost
integer(intg), parameter, public domain_local_ghost
The domain item is ghosted from another domain.
Definition: domain_mappings.f90:70
lists::list_detach_and_destroy
Detaches the list values from a list and returns them as a pointer to a array of base type before des...
Definition: lists.f90:113
base_routines::exits
subroutine, public exits(NAME)
Records the exit out of the named procedure.
Definition: base_routines.f90:504
types
This module contains all type definitions in order to avoid cyclic module references.
Definition: types.f90:70
input_output::write_string
Write a string to a given output stream.
Definition: input_output.f90:74
base_routines
This module contains all the low-level base routines e.g., all debug, control, and low-level communic...
Definition: base_routines.f90:45
domain_mappings::domain_mappings_adjacent_domain_finalise
subroutine domain_mappings_adjacent_domain_finalise(ADJACENT_DOMAIN, ERR, ERROR,)
Finalises the adjacent domain and deallocates all memory for a domain mapping.
Definition: domain_mappings.f90:92
domain_mappings::domain_mappings_local_from_global_calculate
subroutine, public domain_mappings_local_from_global_calculate(DOMAIN_MAPPING, ERR, ERROR,)
Calculates the domain mappings local map from a domain mappings global map.
Definition: domain_mappings.f90:188
iso_varying_string::trim
Definition: iso_varying_string.f90:204
lists::list_create_finish
subroutine, public list_create_finish(LIST, ERR, ERROR,)
Finishes the creation of a list created with LIST_CREATE_START.
Definition: lists.f90:419
comp_environment
This module contains all computational environment variables.
Definition: computational_environment.f90:46
domain_mappings
This module handles all domain mappings routines.
Definition: domain_mappings.f90:45
base_routines::my_computational_node_number
integer(intg), save my_computational_node_number
The computational rank for this node.
Definition: base_routines.f90:149
comp_environment::computational_environment
type(computational_environment_type), target, public computational_environment
The computational environment the program is running in.
Definition: computational_environment.f90:125
domain_mappings::domain_local_internal
integer(intg), parameter, public domain_local_internal
The domain item is internal to the domain.
Definition: domain_mappings.f90:68
types::domain_global_mapping_type
Contains the local information for a global mapping number for a domain mapping.
Definition: types.f90:896
domain_mappings::domain_mappings_mapping_initialise
subroutine, public domain_mappings_mapping_initialise(DOMAIN_MAPPING, NUMBER_OF_DOMAINS, ERR, ERROR,)
Initialises the mapping for a domain mappings mapping.
Definition: domain_mappings.f90:730
types::domain_adjacent_domain_type
Contains the information on an adjacent domain to a domain in a domain mapping.
Definition: types.f90:887
base_routines::diagnostics1
logical, save, public diagnostics1
.TRUE. if level 1 diagnostic output is active in the current routine
Definition: base_routines.f90:153
domain_mappings::domain_mappings_mapping_finalise
subroutine, public domain_mappings_mapping_finalise(DOMAIN_MAPPING, ERR, ERROR,)
Finalises the mapping for a domain mappings mapping and deallocates all memory.
Definition: domain_mappings.f90:636
input_output::write_string_vector
Write a string followed by a vector to a specified output stream.
Definition: input_output.f90:290
base_routines::diagnostic_output_type
integer(intg), parameter, public diagnostic_output_type
Diagnostic output type.
Definition: base_routines.f90:67
domain_mappings::domain_mappings_global_to_local_get
subroutine, public domain_mappings_global_to_local_get(DOMAIN_MAPPING, GLOBAL_NUMBER, LOCAL_EXISTS, LOCAL_NUMBER, ERR, ERROR,)
Returns the local number, if it exists on the rank, for the specifed global number.
Definition: domain_mappings.f90:144
lists::list_create_start
subroutine, public list_create_start(LIST, ERR, ERROR,)
Starts the creation of a list and returns a pointer to the created list.
Definition: lists.f90:486
types::domain_mapping_type
Contains information on the domain mappings (i.e., local and global numberings).
Definition: types.f90:904
lists::list_item_add
Adds an item to the end of a list.
Definition: lists.f90:133
domain_mappings::domain_mappings_mapping_global_initialise
subroutine, public domain_mappings_mapping_global_initialise(MAPPING_GLOBAL_MAP, ERR, ERROR,)
Finalises the global mapping in the given domain mappings.
Definition: domain_mappings.f90:706
domain_mappings::domain_mappings_adjacent_domain_initialise
subroutine domain_mappings_adjacent_domain_initialise(ADJACENT_DOMAIN, ERR, ERROR,)
Initialise the adjacent domain for a domain mapping.
Definition: domain_mappings.f90:119
lists
Implements lists of base types.
Definition: lists.f90:46
lists::list_data_type_set
subroutine, public list_data_type_set(LIST, DATA_TYPE, ERR, ERROR,)
Sets/changes the data type for a list.
Definition: lists.f90:579
lists::list_destroy
subroutine, public list_destroy(LIST, ERR, ERROR,)
Destroys a list.
Definition: lists.f90:622
base_routines::flagerror
Flags an error condition.
Definition: base_routines.f90:240
types::list_ptr_type
Buffer type to allow arrays of pointers to a list.
Definition: types.f90:108
lists::list_initial_size_set
subroutine, public list_initial_size_set(LIST, INITIAL_SIZE, ERR, ERROR,)
Sets/changes the initial size for a list.
Definition: lists.f90:863
comp_environment::computational_node_number_get
integer(intg) function, public computational_node_number_get(ERR, ERROR)
Returns the number/rank of the computational nodes.
Definition: computational_environment.f90:640
kinds
This module contains all kind definitions.
Definition: kinds.f90:45
input_output
This module handles all formating and input and output.
Definition: input_output.f90:45