Line data Source code
1 : !!****m* ABINIT/m_copy
2 : !! NAME
3 : !! m_copy
4 : !!
5 : !! FUNCTION
6 : !! This module provides a generic interface used to copy pointers:
7 : !! deep_copy: used to return a deep copy of pointers. The procedure is useful if data types
8 : !! with several pointers have to be copied.
9 : !! addr_copy: used to copy the address contained in a pointer
10 : !!
11 : !! COPYRIGHT
12 : !! Copyright (C) 2008-2026 ABINIT group (MG,MT)
13 : !! This file is distributed under the terms of the
14 : !! GNU General Public License, see ~abinit/COPYING
15 : !! or http://www.gnu.org/copyleft/gpl.txt .
16 : !!
17 : !! NOTES
18 : !! * The intent for pointer arguments is not specified since
19 : !! we have to conform to the F90 specifications. However xval is IN while copy is OUT
20 : !!
21 : !! * copy is a pointer and is supposed to be *not allocated*.
22 : !! If the value to be copied points to null(), also the copy will be nullified.
23 : !!
24 : !! * On the alloc_copy routine:
25 : !! Since copy is INTENT(OUT), if the associated actual argument is
26 : !! currently allocated, the actual argument is deallocated on procedure invocation so that the dummy
27 : !! argument has an allocation status of not currently allocated.
28 : !!
29 : !! SOURCE
30 :
31 : #if defined HAVE_CONFIG_H
32 : #include "config.h"
33 : #endif
34 :
35 : #include "abi_common.h"
36 :
37 : MODULE m_copy
38 :
39 : use, intrinsic :: iso_c_binding
40 : use defs_basis, only : dp, sp
41 : use m_abicore
42 :
43 : implicit none
44 :
45 : private
46 :
47 : public :: deep_copy ! Performs deep copy of two pointers
48 : public :: alloc_copy ! Allocate an allocable array and copy data. See notes in alloc_copy_int1d
49 : public :: addr_copy ! Performs a bitwise copy of a pointer (copy address)
50 :
51 : interface deep_copy
52 : module procedure deep_copy_int0d
53 : module procedure deep_copy_int1d
54 : module procedure deep_copy_int2d
55 : module procedure deep_copy_int3d
56 : module procedure deep_copy_int4d
57 : module procedure deep_copy_rdp0d
58 : module procedure deep_copy_rdp1d
59 : module procedure deep_copy_rdp2d
60 : module procedure deep_copy_rdp3d
61 : module procedure deep_copy_rdp4d
62 : module procedure deep_copy_csp0d
63 : module procedure deep_copy_csp1d
64 : module procedure deep_copy_csp2d
65 : module procedure deep_copy_csp3d
66 : module procedure deep_copy_csp4d
67 : module procedure deep_copy_cdp0d
68 : module procedure deep_copy_cdp1d
69 : module procedure deep_copy_cdp2d
70 : module procedure deep_copy_cdp3d
71 : module procedure deep_copy_cdp4d
72 : module procedure deep_copy_log0d
73 : module procedure deep_copy_log1d
74 : module procedure deep_copy_log2d
75 : module procedure deep_copy_log3d
76 : module procedure deep_copy_log4d
77 : !module procedure deep_copy_ch1d !Does not work on XLF, do not use it for the time being.
78 : end interface deep_copy
79 :
80 : interface alloc_copy
81 : module procedure alloc_copy_int1d
82 : module procedure alloc_copy_int2d
83 : module procedure alloc_copy_int3d
84 : module procedure alloc_copy_int4d_1b
85 : module procedure alloc_copy_int4d
86 : module procedure alloc_copy_rdp1d
87 : module procedure alloc_copy_rdp2d
88 : module procedure alloc_copy_rdp3d
89 : module procedure alloc_copy_rdp4d
90 : module procedure alloc_copy_rdp5d
91 : module procedure alloc_copy_rdp6d
92 : module procedure alloc_copy_csp1d
93 : module procedure alloc_copy_csp2d
94 : module procedure alloc_copy_csp3d
95 : module procedure alloc_copy_csp4d
96 : module procedure alloc_copy_cdp1d
97 : module procedure alloc_copy_cdp2d
98 : module procedure alloc_copy_cdp3d
99 : module procedure alloc_copy_cdp4d
100 : module procedure alloc_copy_log1d
101 : module procedure alloc_copy_log2d
102 : module procedure alloc_copy_log3d
103 : module procedure alloc_copy_log4d
104 : end interface alloc_copy
105 :
106 : interface addr_copy
107 : module procedure addr_copy_int1d
108 : module procedure addr_copy_int2d
109 : module procedure addr_copy_int3d
110 : module procedure addr_copy_int4d
111 : module procedure addr_copy_dp1d
112 : module procedure addr_copy_dp2d
113 : module procedure addr_copy_dp3d
114 : module procedure addr_copy_dp4d
115 : module procedure addr_copy_dp5d
116 : end interface addr_copy
117 :
118 : CONTAINS !===========================================================
119 : !!***
120 :
121 : !!****f* m_copy/deep_copy_int0d
122 : !! NAME
123 : !! deep_copy_int0d
124 : !!
125 : !! FUNCTION
126 : !! Performs a deep copy of a pointer.
127 : !!
128 : !! SOURCE
129 :
130 0 : subroutine deep_copy_int0d(xval,copy)
131 :
132 : !Arguments ------------------------------------
133 : integer,intent(in) :: xval
134 : integer,intent(out) :: copy
135 : ! *********************************************************************
136 :
137 0 : copy=xval
138 :
139 0 : end subroutine deep_copy_int0d
140 : !!***
141 :
142 : !----------------------------------------------------------------------
143 :
144 : !!****f* m_copy/deep_copy_int1d
145 : !! NAME
146 : !! deep_copy_int1d
147 : !!
148 : !! FUNCTION
149 : !! Performs a deep copy of a pointer.
150 : !!
151 : !! SOURCE
152 :
153 736 : subroutine deep_copy_int1d(xval,copy)
154 :
155 : !Arguments ------------------------------------
156 : integer,pointer :: xval(:)
157 : integer,pointer :: copy(:)
158 :
159 : !Local variables-------------------------------
160 : integer :: il,iu
161 : ! *********************************************************************
162 :
163 736 : if (associated(xval)) then
164 100 : il=lbound(xval,DIM=1); iu=ubound(xval,DIM=1)
165 168 : ABI_MALLOC(copy,(il:iu))
166 218 : copy(:)=xval(:)
167 : else
168 680 : nullify(copy)
169 : end if
170 :
171 736 : end subroutine deep_copy_int1d
172 : !!***
173 :
174 : !----------------------------------------------------------------------
175 :
176 : !!****f* m_copy/deep_copy_int2d
177 : !! NAME
178 : !! deep_copy_int2d
179 : !!
180 : !! FUNCTION
181 : !! Performs a deep copy of a pointer.
182 : !!
183 : !! SOURCE
184 :
185 0 : subroutine deep_copy_int2d(xval,copy)
186 :
187 : !Arguments ------------------------------------
188 : integer,pointer :: xval(:,:)
189 : integer,pointer :: copy(:,:)
190 :
191 : !Local variables-------------------------------
192 : integer :: il1,iu1,il2,iu2
193 : ! *********************************************************************
194 :
195 0 : if (associated(xval)) then
196 0 : il1=lbound(xval,DIM=1); iu1=ubound(xval,DIM=1)
197 0 : il2=lbound(xval,DIM=2); iu2=ubound(xval,DIM=2)
198 0 : ABI_MALLOC(copy,(il1:iu1,il2:iu2))
199 0 : copy(:,:)=xval(:,:)
200 : else
201 0 : nullify(copy)
202 : end if
203 :
204 0 : end subroutine deep_copy_int2d
205 : !!***
206 :
207 : !----------------------------------------------------------------------
208 :
209 : !!****f* m_copy/deep_copy_int3d
210 : !! NAME
211 : !! deep_copy_int3d
212 : !!
213 : !! FUNCTION
214 : !! Performs a deep copy of a pointer.
215 : !!
216 : !! SOURCE
217 :
218 0 : subroutine deep_copy_int3d(xval,copy)
219 :
220 : !Arguments ------------------------------------
221 : integer,pointer :: xval(:,:,:)
222 : integer,pointer :: copy(:,:,:)
223 :
224 : !Local variables-------------------------------
225 : integer :: il1,iu1,il2,iu2,il3,iu3
226 : ! *********************************************************************
227 :
228 0 : if (associated(xval)) then
229 0 : il1=lbound(xval,DIM=1); iu1=ubound(xval,DIM=1)
230 0 : il2=lbound(xval,DIM=2); iu2=ubound(xval,DIM=2)
231 0 : il3=lbound(xval,DIM=3); iu3=ubound(xval,DIM=3)
232 0 : ABI_MALLOC(copy,(il1:iu1,il2:iu2,il3:iu3))
233 0 : copy(:,:,:)=xval(:,:,:)
234 : else
235 0 : nullify(copy)
236 : end if
237 :
238 0 : end subroutine deep_copy_int3d
239 : !!***
240 :
241 : !----------------------------------------------------------------------
242 :
243 : !!****f* m_copy/deep_copy_int4d
244 : !! NAME
245 : !! deep_copy_int4d
246 : !!
247 : !! FUNCTION
248 : !! Performs a deep copy of a pointer.
249 : !!
250 : !! SOURCE
251 :
252 0 : subroutine deep_copy_int4d(xval,copy)
253 :
254 : !Arguments ------------------------------------
255 : integer,pointer :: xval(:,:,:,:)
256 : integer,pointer :: copy(:,:,:,:)
257 :
258 : !Local variables-------------------------------
259 : integer :: il1,iu1,il2,iu2,il3,iu3,il4,iu4
260 : ! *********************************************************************
261 :
262 0 : if (associated(xval)) then
263 0 : il1=lbound(xval,DIM=1); iu1=ubound(xval,DIM=1)
264 0 : il2=lbound(xval,DIM=2); iu2=ubound(xval,DIM=2)
265 0 : il3=lbound(xval,DIM=3); iu3=ubound(xval,DIM=3)
266 0 : il4=lbound(xval,DIM=4); iu4=ubound(xval,DIM=4)
267 0 : ABI_MALLOC(copy,(il1:iu1,il2:iu2,il3:iu3,il4:iu4))
268 0 : copy(:,:,:,:)=xval(:,:,:,:)
269 : else
270 0 : nullify(copy)
271 : end if
272 :
273 0 : end subroutine deep_copy_int4d
274 : !!***
275 :
276 : !----------------------------------------------------------------------
277 :
278 : !!****f* m_copy/deep_copy_rdp0d
279 : !! NAME
280 : !! deep_copy_rdp0d
281 : !!
282 : !! FUNCTION
283 : !! Performs a deep copy of a pointer.
284 : !!
285 : !! SOURCE
286 :
287 0 : subroutine deep_copy_rdp0d(xval,copy)
288 :
289 : !Arguments ------------------------------------
290 : real(dp),intent(in) :: xval
291 : real(dp),intent(out) :: copy
292 : ! *********************************************************************
293 0 : copy=xval
294 :
295 0 : end subroutine deep_copy_rdp0d
296 : !!***
297 :
298 : !----------------------------------------------------------------------
299 :
300 : !!****f* m_copy/deep_copy_rdp1d
301 : !! NAME
302 : !! deep_copy_rdp1d
303 :
304 : !! FUNCTION
305 : !! Performs a deep copy of a pointer.
306 : !!
307 : !! SOURCE
308 :
309 0 : subroutine deep_copy_rdp1d(xval,copy)
310 :
311 : !Arguments ------------------------------------
312 : real(dp),pointer :: xval(:)
313 : real(dp),pointer :: copy(:)
314 :
315 : !Local variables-------------------------------
316 : integer :: il,iu
317 : ! *********************************************************************
318 :
319 0 : if (associated(xval)) then
320 0 : il=lbound(xval,DIM=1); iu=ubound(xval,DIM=1)
321 0 : ABI_MALLOC(copy,(il:iu))
322 0 : copy(:)=xval(:)
323 : else
324 0 : nullify(copy)
325 : end if
326 :
327 0 : end subroutine deep_copy_rdp1d
328 : !!***
329 :
330 : !----------------------------------------------------------------------
331 :
332 : !!****f* m_copy/deep_copy_rdp2d
333 : !! NAME
334 : !! deep_copy_rdp2d
335 : !!
336 : !! FUNCTION
337 : !! Performs a deep copy of a pointer.
338 : !!
339 : !! SOURCE
340 :
341 0 : subroutine deep_copy_rdp2d(xval,copy)
342 :
343 : !Arguments ------------------------------------
344 : real(dp),pointer :: xval(:,:)
345 : real(dp),pointer :: copy(:,:)
346 :
347 : !Local variables-------------------------------
348 : integer :: il1,iu1,il2,iu2
349 : ! *********************************************************************
350 :
351 0 : if (associated(xval)) then
352 0 : il1=lbound(xval,DIM=1); iu1=ubound(xval,DIM=1)
353 0 : il2=lbound(xval,DIM=2); iu2=ubound(xval,DIM=2)
354 0 : ABI_MALLOC(copy,(il1:iu1,il2:iu2))
355 0 : copy(:,:)=xval(:,:)
356 : else
357 0 : nullify(copy)
358 : end if
359 :
360 0 : end subroutine deep_copy_rdp2d
361 : !!***
362 :
363 : !----------------------------------------------------------------------
364 :
365 : !!****f* m_copy/deep_copy_rdp3d
366 : !! NAME
367 : !! deep_copy_rdp3d
368 : !!
369 : !! FUNCTION
370 : !! Performs a deep copy of a pointer.
371 : !!
372 : !! SOURCE
373 :
374 0 : subroutine deep_copy_rdp3d(xval,copy)
375 :
376 : !Arguments ------------------------------------
377 : real(dp),pointer :: xval(:,:,:)
378 : real(dp),pointer :: copy(:,:,:)
379 :
380 : !Local variables-------------------------------
381 : integer :: il1,iu1,il2,iu2,il3,iu3
382 : ! *********************************************************************
383 :
384 0 : if (associated(xval)) then
385 0 : il1=lbound(xval,DIM=1); iu1=ubound(xval,DIM=1)
386 0 : il2=lbound(xval,DIM=2); iu2=ubound(xval,DIM=2)
387 0 : il3=lbound(xval,DIM=3); iu3=ubound(xval,DIM=3)
388 0 : ABI_MALLOC(copy,(il1:iu1,il2:iu2,il3:iu3))
389 0 : copy(:,:,:)=xval(:,:,:)
390 : else
391 0 : nullify(copy)
392 : end if
393 :
394 0 : end subroutine deep_copy_rdp3d
395 : !!***
396 :
397 : !----------------------------------------------------------------------
398 :
399 : !!****f* m_copy/deep_copy_rdp4d
400 : !! NAME
401 : !! deep_copy_rdp4d
402 : !!
403 : !! FUNCTION
404 : !! Performs a deep copy of a pointer.
405 : !!
406 : !! SOURCE
407 :
408 0 : subroutine deep_copy_rdp4d(xval,copy)
409 :
410 : !Arguments ------------------------------------
411 : real(dp),pointer :: xval(:,:,:,:)
412 : real(dp),pointer :: copy(:,:,:,:)
413 :
414 : !Local variables-------------------------------
415 : integer :: il1,iu1,il2,iu2,il3,iu3,il4,iu4
416 : ! *********************************************************************
417 :
418 0 : if (associated(xval)) then
419 0 : il1=lbound(xval,DIM=1); iu1=ubound(xval,DIM=1)
420 0 : il2=lbound(xval,DIM=2); iu2=ubound(xval,DIM=2)
421 0 : il3=lbound(xval,DIM=3); iu3=ubound(xval,DIM=3)
422 0 : il4=lbound(xval,DIM=4); iu4=ubound(xval,DIM=4)
423 0 : ABI_MALLOC(copy,(il1:iu1,il2:iu2,il3:iu3,il4:iu4))
424 0 : copy(:,:,:,:)=xval(:,:,:,:)
425 : else
426 0 : nullify(copy)
427 : end if
428 :
429 0 : end subroutine deep_copy_rdp4d
430 : !!***
431 :
432 : !----------------------------------------------------------------------
433 :
434 : !!****f* m_copy/deep_copy_csp0d
435 : !! NAME
436 : !! deep_copy_csp0d
437 : !!
438 : !! FUNCTION
439 : !! Performs a deep copy of a pointer.
440 : !!
441 : !! SOURCE
442 :
443 0 : subroutine deep_copy_csp0d(xval,copy)
444 :
445 : !Arguments ------------------------------------
446 : complex(sp),intent(in) :: xval
447 : complex(sp),intent(out) :: copy
448 : ! *********************************************************************
449 0 : copy=xval
450 :
451 0 : end subroutine deep_copy_csp0d
452 : !!***
453 :
454 : !----------------------------------------------------------------------
455 :
456 : !!****f* m_copy/deep_copy_csp1d
457 : !! NAME
458 : !! deep_copy_csp1d
459 : !!
460 : !! FUNCTION
461 : !! Performs a deep copy of a pointer.
462 : !!
463 : !! SOURCE
464 :
465 0 : subroutine deep_copy_csp1d(xval,copy)
466 :
467 : !Arguments ------------------------------------
468 : complex(sp),pointer :: xval(:)
469 : complex(sp),pointer :: copy(:)
470 :
471 : !Local variables-------------------------------
472 : integer :: il,iu
473 : ! *********************************************************************
474 :
475 0 : if (associated(xval)) then
476 0 : il=lbound(xval,DIM=1); iu=ubound(xval,DIM=1)
477 0 : ABI_MALLOC(copy,(il:iu))
478 0 : copy(:)=xval(:)
479 : else
480 0 : nullify(copy)
481 : end if
482 :
483 0 : end subroutine deep_copy_csp1d
484 : !!***
485 :
486 : !----------------------------------------------------------------------
487 :
488 : !!****f* m_copy/deep_copy_csp2d
489 : !! NAME
490 : !! deep_copy_csp2d
491 : !!
492 : !! FUNCTION
493 : !! Performs a deep copy of a pointer.
494 : !!
495 : !! SOURCE
496 :
497 0 : subroutine deep_copy_csp2d(xval,copy)
498 :
499 : !Arguments ------------------------------------
500 : complex(sp),pointer :: xval(:,:)
501 : complex(sp),pointer :: copy(:,:)
502 :
503 : !Local variables-------------------------------
504 : integer :: il1,iu1,il2,iu2
505 : ! *********************************************************************
506 :
507 0 : if (associated(xval)) then
508 0 : il1=lbound(xval,DIM=1); iu1=ubound(xval,DIM=1)
509 0 : il2=lbound(xval,DIM=2); iu2=ubound(xval,DIM=2)
510 0 : ABI_MALLOC(copy,(il1:iu1,il2:iu2))
511 0 : copy(:,:)=xval(:,:)
512 : else
513 0 : nullify(copy)
514 : end if
515 :
516 0 : end subroutine deep_copy_csp2d
517 : !!***
518 :
519 : !----------------------------------------------------------------------
520 :
521 : !!****f* m_copy/deep_copy_csp3d
522 : !! NAME
523 : !! deep_copy_csp3d
524 : !!
525 : !! FUNCTION
526 : !! Performs a deep copy of a pointer.
527 : !!
528 : !! SOURCE
529 :
530 0 : subroutine deep_copy_csp3d(xval,copy)
531 :
532 : !Arguments ------------------------------------
533 : complex(sp),pointer :: xval(:,:,:)
534 : complex(sp),pointer :: copy(:,:,:)
535 :
536 : !Local variables-------------------------------
537 : integer :: il1,iu1,il2,iu2,il3,iu3
538 : ! *********************************************************************
539 :
540 0 : if (associated(xval)) then
541 0 : il1=lbound(xval,DIM=1); iu1=ubound(xval,DIM=1)
542 0 : il2=lbound(xval,DIM=2); iu2=ubound(xval,DIM=2)
543 0 : il3=lbound(xval,DIM=3); iu3=ubound(xval,DIM=3)
544 0 : ABI_MALLOC(copy,(il1:iu1,il2:iu2,il3:iu3))
545 0 : copy(:,:,:)=xval(:,:,:)
546 : else
547 0 : nullify(copy)
548 : end if
549 :
550 0 : end subroutine deep_copy_csp3d
551 : !!***
552 :
553 : !----------------------------------------------------------------------
554 :
555 : !!****f* m_copy/deep_copy_csp4d
556 : !! NAME
557 : !! deep_copy_csp4d
558 : !!
559 : !! FUNCTION
560 : !! Performs a deep copy of a pointer.
561 : !!
562 : !! SOURCE
563 :
564 0 : subroutine deep_copy_csp4d(xval,copy)
565 :
566 : !Arguments ------------------------------------
567 : complex(sp),pointer :: xval(:,:,:,:)
568 : complex(sp),pointer :: copy(:,:,:,:)
569 :
570 : !Local variables-------------------------------
571 : integer :: il1,iu1,il2,iu2,il3,iu3,il4,iu4
572 : ! *********************************************************************
573 :
574 0 : if (associated(xval)) then
575 0 : il1=lbound(xval,DIM=1); iu1=ubound(xval,DIM=1)
576 0 : il2=lbound(xval,DIM=2); iu2=ubound(xval,DIM=2)
577 0 : il3=lbound(xval,DIM=3); iu3=ubound(xval,DIM=3)
578 0 : il4=lbound(xval,DIM=4); iu4=ubound(xval,DIM=4)
579 0 : ABI_MALLOC(copy,(il1:iu1,il2:iu2,il3:iu3,il4:iu4))
580 0 : copy(:,:,:,:)=xval(:,:,:,:)
581 : else
582 0 : nullify(copy)
583 : end if
584 :
585 0 : end subroutine deep_copy_csp4d
586 : !!***
587 :
588 : !----------------------------------------------------------------------
589 :
590 : !!****f* m_copy/deep_copy_cdp0d
591 : !! NAME
592 : !! deep_copy_cdp0d
593 : !!
594 : !! FUNCTION
595 : !! Performs a deep copy of a pointer.
596 : !!
597 : !! SOURCE
598 :
599 0 : subroutine deep_copy_cdp0d(xval,copy)
600 :
601 : !Arguments ------------------------------------
602 : complex(dp),intent(in) :: xval
603 : complex(dp),intent(out) :: copy
604 : ! *********************************************************************
605 0 : copy=xval
606 :
607 0 : end subroutine deep_copy_cdp0d
608 : !!***
609 :
610 : !----------------------------------------------------------------------
611 :
612 : !!****f* m_copy/deep_copy_cdp1d
613 : !! NAME
614 : !! deep_copy_cdp1d
615 : !!
616 : !! FUNCTION
617 : !! Performs a deep copy of a pointer.
618 : !!
619 : !! SOURCE
620 :
621 0 : subroutine deep_copy_cdp1d(xval,copy)
622 :
623 : !Arguments ------------------------------------
624 : complex(dp),pointer :: xval(:)
625 : complex(dp),pointer :: copy(:)
626 :
627 : !Local variables-------------------------------
628 : integer :: il,iu
629 : ! *********************************************************************
630 :
631 0 : if (associated(xval)) then
632 0 : il=lbound(xval,DIM=1); iu=ubound(xval,DIM=1)
633 0 : ABI_MALLOC(copy,(il:iu))
634 0 : copy(:)=xval(:)
635 : else
636 0 : nullify(copy)
637 : end if
638 :
639 0 : end subroutine deep_copy_cdp1d
640 : !!***
641 :
642 : !----------------------------------------------------------------------
643 :
644 : !!****f* m_copy/deep_copy_cdp2d
645 : !! NAME
646 : !! deep_copy_cdp2d
647 : !!
648 : !! FUNCTION
649 : !! Performs a deep copy of a pointer.
650 : !!
651 : !! SOURCE
652 :
653 0 : subroutine deep_copy_cdp2d(xval,copy)
654 :
655 : !Arguments ------------------------------------
656 : complex(dp),pointer :: xval(:,:)
657 : complex(dp),pointer :: copy(:,:)
658 :
659 : !Local variables-------------------------------
660 : integer :: il1,iu1,il2,iu2
661 : ! *********************************************************************
662 :
663 0 : if (associated(xval)) then
664 0 : il1=lbound(xval,DIM=1); iu1=ubound(xval,DIM=1)
665 0 : il2=lbound(xval,DIM=2); iu2=ubound(xval,DIM=2)
666 0 : ABI_MALLOC(copy,(il1:iu1,il2:iu2))
667 0 : copy(:,:)=xval(:,:)
668 : else
669 0 : nullify(copy)
670 : end if
671 :
672 0 : end subroutine deep_copy_cdp2d
673 : !!***
674 :
675 : !----------------------------------------------------------------------
676 :
677 : !!****f* m_copy/deep_copy_cdp3d
678 : !! NAME
679 : !! deep_copy_cdp3d
680 : !!
681 : !! FUNCTION
682 : !! Performs a deep copy of a pointer.
683 : !!
684 : !! SOURCE
685 :
686 0 : subroutine deep_copy_cdp3d(xval,copy)
687 :
688 : !Arguments ------------------------------------
689 : complex(dp),pointer :: xval(:,:,:)
690 : complex(dp),pointer :: copy(:,:,:)
691 :
692 : !Local variables-------------------------------
693 : integer :: il1,iu1,il2,iu2,il3,iu3
694 : ! *********************************************************************
695 :
696 0 : if (associated(xval)) then
697 0 : il1=lbound(xval,DIM=1); iu1=ubound(xval,DIM=1)
698 0 : il2=lbound(xval,DIM=2); iu2=ubound(xval,DIM=2)
699 0 : il3=lbound(xval,DIM=3); iu3=ubound(xval,DIM=3)
700 0 : ABI_MALLOC(copy,(il1:iu1,il2:iu2,il3:iu3))
701 0 : copy(:,:,:)=xval(:,:,:)
702 : else
703 0 : nullify(copy)
704 : end if
705 :
706 0 : end subroutine deep_copy_cdp3d
707 : !!***
708 :
709 : !----------------------------------------------------------------------
710 :
711 : !!****f* m_copy/deep_copy_cdp4d
712 : !! NAME
713 : !! deep_copy_cdp4d
714 : !!
715 : !! FUNCTION
716 : !! Performs a deep copy of a pointer.
717 : !!
718 : !! SOURCE
719 :
720 0 : subroutine deep_copy_cdp4d(xval,copy)
721 :
722 : !Arguments ------------------------------------
723 : complex(dp),pointer :: xval(:,:,:,:)
724 : complex(dp),pointer :: copy(:,:,:,:)
725 :
726 : !Local variables-------------------------------
727 : integer :: il1,iu1,il2,iu2,il3,iu3,il4,iu4
728 : ! *********************************************************************
729 :
730 0 : if (associated(xval)) then
731 0 : il1=lbound(xval,DIM=1); iu1=ubound(xval,DIM=1)
732 0 : il2=lbound(xval,DIM=2); iu2=ubound(xval,DIM=2)
733 0 : il3=lbound(xval,DIM=3); iu3=ubound(xval,DIM=3)
734 0 : il4=lbound(xval,DIM=4); iu4=ubound(xval,DIM=4)
735 0 : ABI_MALLOC(copy,(il1:iu1,il2:il2,il3:iu3,il4:iu4))
736 0 : copy(:,:,:,:)=xval(:,:,:,:)
737 : else
738 0 : nullify(copy)
739 : end if
740 :
741 0 : end subroutine deep_copy_cdp4d
742 : !!***
743 :
744 : !----------------------------------------------------------------------
745 :
746 : !!****f* m_copy/deep_copy_ch1d
747 : !! NAME
748 : !! deep_copy_ch1d
749 : !!
750 : !! FUNCTION
751 : !! Performs a deep copy of a pointer.
752 : !!
753 : !! NOTES
754 : !! This routine segfaults on XLF, disabled for the time being
755 : !! Should test whether passing slen fixes the problem
756 : !!
757 : !! SOURCE
758 :
759 : subroutine deep_copy_ch1d(xval,copy,slen)
760 :
761 : !Arguments ------------------------------------
762 : integer,intent(in) :: slen
763 : character(len=slen),pointer :: xval(:)
764 : character(len=slen),pointer :: copy(:)
765 :
766 : !Local variables-------------------------------
767 : integer :: il,iu
768 : ! *********************************************************************
769 :
770 : if (associated(xval)) then
771 : il=lbound(xval,DIM=1); iu=ubound(xval,DIM=1)
772 : ABI_MALLOC(copy,(il:iu))
773 : copy(:)=xval(:)
774 : else
775 : nullify(copy)
776 : end if
777 :
778 : end subroutine deep_copy_ch1d
779 : !!***
780 :
781 : !!****f* m_copy/deep_copy_log0d
782 : !! NAME
783 : !! deep_copy_log0d
784 : !!
785 : !! FUNCTION
786 : !! Performs a deep copy of a pointer.
787 : !!
788 : !! SOURCE
789 :
790 0 : subroutine deep_copy_log0d(xval,copy)
791 :
792 : !Arguments ------------------------------------
793 : logical,intent(in) :: xval
794 : logical,intent(out) :: copy
795 : ! *********************************************************************
796 :
797 0 : copy=xval
798 :
799 0 : end subroutine deep_copy_log0d
800 : !!***
801 :
802 : !----------------------------------------------------------------------
803 :
804 : !!****f* m_copy/deep_copy_log1d
805 : !! NAME
806 : !! deep_copy_log1d
807 : !!
808 : !! FUNCTION
809 : !! Performs a deep copy of a pointer.
810 : !!
811 : !! SOURCE
812 :
813 0 : subroutine deep_copy_log1d(xval,copy)
814 :
815 : !Arguments ------------------------------------
816 : logical,pointer :: xval(:)
817 : logical,pointer :: copy(:)
818 :
819 : !Local variables-------------------------------
820 : integer :: il,iu
821 : ! *********************************************************************
822 :
823 0 : if (associated(xval)) then
824 0 : il=lbound(xval,DIM=1); iu=ubound(xval,DIM=1)
825 0 : ABI_MALLOC(copy,(il:iu))
826 0 : copy(:)=xval(:)
827 : else
828 0 : nullify(copy)
829 : end if
830 :
831 0 : end subroutine deep_copy_log1d
832 : !!***
833 :
834 : !----------------------------------------------------------------------
835 :
836 : !!****f* m_copy/deep_copy_log2d
837 : !! NAME
838 : !! deep_copy_log2d
839 : !!
840 : !! FUNCTION
841 : !! Performs a deep copy of a pointer.
842 : !!
843 : !! SOURCE
844 :
845 0 : subroutine deep_copy_log2d(xval,copy)
846 :
847 : !Arguments ------------------------------------
848 : logical,pointer :: xval(:,:)
849 : logical,pointer :: copy(:,:)
850 :
851 : !Local variables-------------------------------
852 : integer :: il1,iu1,il2,iu2
853 : ! *********************************************************************
854 :
855 0 : if (associated(xval)) then
856 0 : il1=lbound(xval,DIM=1); iu1=ubound(xval,DIM=1)
857 0 : il2=lbound(xval,DIM=2); iu2=ubound(xval,DIM=2)
858 0 : ABI_MALLOC(copy,(il1:iu1,il2:iu2))
859 0 : copy(:,:)=xval(:,:)
860 : else
861 0 : nullify(copy)
862 : end if
863 :
864 0 : end subroutine deep_copy_log2d
865 : !!***
866 :
867 : !----------------------------------------------------------------------
868 :
869 : !!****f* m_copy/deep_copy_log3d
870 : !! NAME
871 : !! deep_copy_log3d
872 : !!
873 : !! FUNCTION
874 : !! Performs a deep copy of a pointer.
875 : !!
876 : !! SOURCE
877 :
878 0 : subroutine deep_copy_log3d(xval,copy)
879 :
880 : !Arguments ------------------------------------
881 : logical,pointer :: xval(:,:,:)
882 : logical,pointer :: copy(:,:,:)
883 :
884 : !Local variables-------------------------------
885 : integer :: il1,iu1,il2,iu2,il3,iu3
886 : ! *********************************************************************
887 :
888 0 : if (associated(xval)) then
889 0 : il1=lbound(xval,DIM=1); iu1=ubound(xval,DIM=1)
890 0 : il2=lbound(xval,DIM=2); iu2=ubound(xval,DIM=2)
891 0 : il3=lbound(xval,DIM=3); iu3=ubound(xval,DIM=3)
892 0 : ABI_MALLOC(copy,(il1:iu1,il2:iu2,il3:iu3))
893 0 : copy(:,:,:)=xval(:,:,:)
894 : else
895 0 : nullify(copy)
896 : end if
897 :
898 0 : end subroutine deep_copy_log3d
899 : !!***
900 :
901 : !----------------------------------------------------------------------
902 :
903 : !!****f* m_copy/deep_copy_log4d
904 : !! NAME
905 : !! deep_copy_log4d
906 : !!
907 : !! FUNCTION
908 : !! Performs a deep copy of a pointer.
909 : !!
910 : !! SOURCE
911 :
912 0 : subroutine deep_copy_log4d(xval,copy)
913 :
914 : !Arguments ------------------------------------
915 : logical,pointer :: xval(:,:,:,:)
916 : logical,pointer :: copy(:,:,:,:)
917 :
918 : !Local variables-------------------------------
919 : integer :: il1,iu1,il2,iu2,il3,iu3,il4,iu4
920 : ! *********************************************************************
921 :
922 0 : if (associated(xval)) then
923 0 : il1=lbound(xval,DIM=1); iu1=ubound(xval,DIM=1)
924 0 : il2=lbound(xval,DIM=2); iu2=ubound(xval,DIM=2)
925 0 : il3=lbound(xval,DIM=3); iu3=ubound(xval,DIM=3)
926 0 : il4=lbound(xval,DIM=4); iu4=ubound(xval,DIM=4)
927 0 : ABI_MALLOC(copy,(il1:iu1,il2:iu2,il3:iu3,il4:iu4))
928 0 : copy(:,:,:,:)=xval(:,:,:,:)
929 : else
930 0 : nullify(copy)
931 : end if
932 :
933 0 : end subroutine deep_copy_log4d
934 : !!***
935 :
936 : !----------------------------------------------------------------------
937 :
938 : !!****f* m_copy/alloc_copy_int1d
939 : !! NAME
940 : !! alloc_copy_int1d
941 : !!
942 : !! FUNCTION
943 : !! Performs a copy of an array.
944 : !!
945 : !! SOURCE
946 :
947 339351 : subroutine alloc_copy_int1d(xval,copy)
948 :
949 : !Arguments ------------------------------------
950 : integer,intent(in) :: xval(:)
951 : integer,allocatable,intent(out) :: copy(:)
952 :
953 : !Local variables-------------------------------
954 : integer :: il,iu
955 : ! *********************************************************************
956 :
957 339351 : il=lbound(xval,DIM=1); iu=ubound(xval,DIM=1)
958 1018053 : ABI_MALLOC(copy,(il:iu))
959 8117998 : copy(:)=xval(:)
960 :
961 339351 : end subroutine alloc_copy_int1d
962 : !!***
963 :
964 : !----------------------------------------------------------------------
965 :
966 : !!****f* m_copy/alloc_copy_int2d
967 : !! NAME
968 : !! alloc_copy_int2d
969 : !!
970 : !! FUNCTION
971 : !! Performs a copy of an array.
972 : !!
973 : !! SOURCE
974 :
975 37968 : subroutine alloc_copy_int2d(xval,copy)
976 :
977 : !Arguments ------------------------------------
978 : integer,intent(in) :: xval(:,:)
979 : integer,allocatable,intent(out) :: copy(:,:)
980 :
981 : !Local variables-------------------------------
982 : integer :: il1,iu1,il2,iu2
983 : ! *********************************************************************
984 :
985 37968 : il1=lbound(xval,DIM=1); iu1=ubound(xval,DIM=1)
986 37968 : il2=lbound(xval,DIM=2); iu2=ubound(xval,DIM=2)
987 151872 : ABI_MALLOC(copy,(il1:iu1,il2:iu2))
988 41334391 : copy(:,:)=xval(:,:)
989 :
990 37968 : end subroutine alloc_copy_int2d
991 : !!***
992 :
993 : !----------------------------------------------------------------------
994 :
995 : !!****f* m_copy/alloc_copy_int3d
996 : !! NAME
997 : !! alloc_copy_int3d
998 : !!
999 : !! FUNCTION
1000 : !! Performs a copy of an array.
1001 : !!
1002 : !! SOURCE
1003 :
1004 31625 : subroutine alloc_copy_int3d(xval,copy)
1005 :
1006 : !Arguments ------------------------------------
1007 : integer,intent(in) :: xval(:,:,:)
1008 : integer,allocatable,intent(out) :: copy(:,:,:)
1009 :
1010 : !Local variables-------------------------------
1011 : integer :: il1,iu1,il2,iu2,il3,iu3
1012 : ! *********************************************************************
1013 :
1014 31625 : il1=lbound(xval,DIM=1); iu1=ubound(xval,DIM=1)
1015 31625 : il2=lbound(xval,DIM=2); iu2=ubound(xval,DIM=2)
1016 31625 : il3=lbound(xval,DIM=3); iu3=ubound(xval,DIM=3)
1017 158125 : ABI_MALLOC(copy,(il1:iu1,il2:iu2,il3:iu3))
1018 6031596 : copy(:,:,:)=xval(:,:,:)
1019 :
1020 31625 : end subroutine alloc_copy_int3d
1021 : !!***
1022 :
1023 : !----------------------------------------------------------------------
1024 :
1025 : !!****f* m_copy/alloc_copy_int4d_1b
1026 : !! NAME
1027 : !! alloc_copy_int4d_1b
1028 : !!
1029 : !! FUNCTION
1030 : !! Performs a copy of an array.
1031 : !!
1032 : !! SOURCE
1033 :
1034 0 : subroutine alloc_copy_int4d_1b(xval, copy)
1035 :
1036 : !Arguments ------------------------------------
1037 : integer(c_int8_t),intent(in) :: xval(:,:,:,:)
1038 : integer(c_int8_t),allocatable,intent(out) :: copy(:,:,:,:)
1039 :
1040 : !Local variables-------------------------------
1041 : integer :: il1,iu1,il2,iu2,il3,iu3,il4,iu4
1042 : ! *********************************************************************
1043 :
1044 0 : il1=lbound(xval,DIM=1); iu1=ubound(xval,DIM=1)
1045 0 : il2=lbound(xval,DIM=2); iu2=ubound(xval,DIM=2)
1046 0 : il3=lbound(xval,DIM=3); iu3=ubound(xval,DIM=3)
1047 0 : il4=lbound(xval,DIM=4); iu4=ubound(xval,DIM=4)
1048 0 : ABI_MALLOC(copy,(il1:iu1,il2:iu2,il3:iu3,il4:iu4))
1049 0 : copy(:,:,:,:)=xval(:,:,:,:)
1050 :
1051 0 : end subroutine alloc_copy_int4d_1b
1052 : !!***
1053 :
1054 : !----------------------------------------------------------------------
1055 :
1056 : !!****f* m_copy/alloc_copy_int4d
1057 : !! NAME
1058 : !! alloc_copy_int4d
1059 : !!
1060 : !! FUNCTION
1061 : !! Performs a copy of an array.
1062 : !!
1063 : !! SOURCE
1064 :
1065 0 : subroutine alloc_copy_int4d(xval, copy)
1066 :
1067 : !Arguments ------------------------------------
1068 : integer,intent(in) :: xval(:,:,:,:)
1069 : integer,allocatable,intent(out) :: copy(:,:,:,:)
1070 :
1071 : !Local variables-------------------------------
1072 : integer :: il1,iu1,il2,iu2,il3,iu3,il4,iu4
1073 : ! *********************************************************************
1074 :
1075 0 : il1=lbound(xval,DIM=1); iu1=ubound(xval,DIM=1)
1076 0 : il2=lbound(xval,DIM=2); iu2=ubound(xval,DIM=2)
1077 0 : il3=lbound(xval,DIM=3); iu3=ubound(xval,DIM=3)
1078 0 : il4=lbound(xval,DIM=4); iu4=ubound(xval,DIM=4)
1079 0 : ABI_MALLOC(copy,(il1:iu1,il2:iu2,il3:iu3,il4:iu4))
1080 0 : copy(:,:,:,:)=xval(:,:,:,:)
1081 :
1082 0 : end subroutine alloc_copy_int4d
1083 : !!***
1084 :
1085 : !----------------------------------------------------------------------
1086 :
1087 : !!****f* m_copy/alloc_copy_rdp1d
1088 : !! NAME
1089 : !! alloc_copy_rdp1d
1090 : !!
1091 : !! FUNCTION
1092 : !! Performs a copy of an array.
1093 : !!
1094 : !! SOURCE
1095 :
1096 294222 : subroutine alloc_copy_rdp1d(xval,copy)
1097 :
1098 : !Arguments ------------------------------------
1099 : real(dp),intent(in) :: xval(:)
1100 : real(dp),allocatable,intent(out) :: copy(:)
1101 :
1102 : !Local variables-------------------------------
1103 : integer :: il,iu
1104 : ! *********************************************************************
1105 :
1106 294222 : il=lbound(xval,DIM=1); iu=ubound(xval,DIM=1)
1107 882666 : ABI_MALLOC(copy,(il:iu))
1108 23420689 : copy(:)=xval(:)
1109 :
1110 294222 : end subroutine alloc_copy_rdp1d
1111 : !!***
1112 :
1113 : !----------------------------------------------------------------------
1114 :
1115 : !!****f* m_copy/alloc_copy_rdp2d
1116 : !! NAME
1117 : !! alloc_copy_rdp2d
1118 : !!
1119 : !! FUNCTION
1120 : !! Performs a copy of an array.
1121 : !!
1122 : !! SOURCE
1123 :
1124 403775 : subroutine alloc_copy_rdp2d(xval,copy)
1125 :
1126 : !Arguments ------------------------------------
1127 : real(dp),intent(in) :: xval(:,:)
1128 : real(dp),allocatable,intent(out) :: copy(:,:)
1129 :
1130 : !Local variables-------------------------------
1131 : integer :: il1,iu1,il2,iu2
1132 : ! *********************************************************************
1133 :
1134 403775 : il1=lbound(xval,DIM=1); iu1=ubound(xval,DIM=1)
1135 403775 : il2=lbound(xval,DIM=2); iu2=ubound(xval,DIM=2)
1136 1615100 : ABI_MALLOC(copy,(il1:iu1,il2:iu2))
1137 73962568 : copy(:,:)=xval(:,:)
1138 :
1139 403775 : end subroutine alloc_copy_rdp2d
1140 : !!***
1141 :
1142 : !----------------------------------------------------------------------
1143 :
1144 : !!****f* m_copy/alloc_copy_rdp3d
1145 : !! NAME
1146 : !! alloc_copy_rdp3d
1147 : !!
1148 : !! FUNCTION
1149 : !! Performs a copy of an array.
1150 : !!
1151 : !! SOURCE
1152 :
1153 127666 : subroutine alloc_copy_rdp3d(xval,copy)
1154 :
1155 : !Arguments ------------------------------------
1156 : real(dp),intent(in) :: xval(:,:,:)
1157 : real(dp),allocatable,intent(out) :: copy(:,:,:)
1158 :
1159 : !Local variables-------------------------------
1160 : integer :: il1,iu1,il2,iu2,il3,iu3
1161 : ! *********************************************************************
1162 :
1163 127666 : il1=lbound(xval,DIM=1); iu1=ubound(xval,DIM=1)
1164 127666 : il2=lbound(xval,DIM=2); iu2=ubound(xval,DIM=2)
1165 127666 : il3=lbound(xval,DIM=3); iu3=ubound(xval,DIM=3)
1166 638330 : ABI_MALLOC(copy,(il1:iu1,il2:iu2,il3:iu3))
1167 198822767 : copy(:,:,:)=xval(:,:,:)
1168 :
1169 127666 : end subroutine alloc_copy_rdp3d
1170 : !!***
1171 :
1172 : !----------------------------------------------------------------------
1173 :
1174 : !!****f* m_copy/alloc_copy_rdp4d
1175 : !! NAME
1176 : !! alloc_copy_rdp4d
1177 : !!
1178 : !! FUNCTION
1179 : !! Performs a copy of an array.
1180 : !!
1181 : !! SOURCE
1182 :
1183 4256 : subroutine alloc_copy_rdp4d(xval,copy)
1184 :
1185 : !Arguments ------------------------------------
1186 : real(dp),intent(in) :: xval(:,:,:,:)
1187 : real(dp),allocatable,intent(out) :: copy(:,:,:,:)
1188 :
1189 : !Local variables-------------------------------
1190 : integer :: il1,iu1,il2,iu2,il3,iu3,il4,iu4
1191 : ! *********************************************************************
1192 :
1193 4256 : il1=lbound(xval,DIM=1); iu1=ubound(xval,DIM=1)
1194 4256 : il2=lbound(xval,DIM=2); iu2=ubound(xval,DIM=2)
1195 4256 : il3=lbound(xval,DIM=3); iu3=ubound(xval,DIM=3)
1196 4256 : il4=lbound(xval,DIM=4); iu4=ubound(xval,DIM=4)
1197 25536 : ABI_MALLOC(copy,(il1:iu1,il2:iu2,il3:iu3,il4:iu4))
1198 140138631 : copy(:,:,:,:)=xval(:,:,:,:)
1199 :
1200 4256 : end subroutine alloc_copy_rdp4d
1201 : !!***
1202 :
1203 : !----------------------------------------------------------------------
1204 :
1205 : !!****f* m_copy/alloc_copy_rdp5d
1206 : !! NAME
1207 : !! alloc_copy_rdp5d
1208 : !!
1209 : !! FUNCTION
1210 : !! Performs a copy of an array.
1211 : !!
1212 : !! SOURCE
1213 :
1214 12425 : subroutine alloc_copy_rdp5d(xval,copy)
1215 :
1216 : !Arguments ------------------------------------
1217 : real(dp),intent(in) :: xval(:,:,:,:,:)
1218 : real(dp),allocatable,intent(out) :: copy(:,:,:,:,:)
1219 :
1220 : !Local variables-------------------------------
1221 : integer :: il1,iu1,il2,iu2,il3,iu3,il4,iu4,il5,iu5
1222 : ! *********************************************************************
1223 :
1224 12425 : il1=lbound(xval,DIM=1); iu1=ubound(xval,DIM=1)
1225 12425 : il2=lbound(xval,DIM=2); iu2=ubound(xval,DIM=2)
1226 12425 : il3=lbound(xval,DIM=3); iu3=ubound(xval,DIM=3)
1227 12425 : il4=lbound(xval,DIM=4); iu4=ubound(xval,DIM=4)
1228 12425 : il5=lbound(xval,DIM=5); iu5=ubound(xval,DIM=5)
1229 86975 : ABI_MALLOC(copy,(il1:iu1,il2:iu2,il3:iu3,il4:iu4,il5:iu5))
1230 1702424 : copy(:,:,:,:,:)=xval(:,:,:,:,:)
1231 :
1232 12425 : end subroutine alloc_copy_rdp5d
1233 : !!***
1234 :
1235 : !----------------------------------------------------------------------
1236 :
1237 : !!****f* m_copy/alloc_copy_rdp6d
1238 : !! NAME
1239 : !! alloc_copy_rdp6d
1240 : !!
1241 : !! FUNCTION
1242 : !! Performs a copy of an array.
1243 : !!
1244 : !! SOURCE
1245 :
1246 0 : subroutine alloc_copy_rdp6d(xval,copy)
1247 :
1248 : !Arguments ------------------------------------
1249 : real(dp),intent(in) :: xval(:,:,:,:,:,:)
1250 : real(dp),allocatable,intent(out) :: copy(:,:,:,:,:,:)
1251 :
1252 : !Local variables-------------------------------
1253 : integer :: il1,iu1,il2,iu2,il3,iu3,il4,iu4,il5,iu5,il6,iu6
1254 : ! *********************************************************************
1255 :
1256 0 : il1=lbound(xval,DIM=1); iu1=ubound(xval,DIM=1)
1257 0 : il2=lbound(xval,DIM=2); iu2=ubound(xval,DIM=2)
1258 0 : il3=lbound(xval,DIM=3); iu3=ubound(xval,DIM=3)
1259 0 : il4=lbound(xval,DIM=4); iu4=ubound(xval,DIM=4)
1260 0 : il5=lbound(xval,DIM=5); iu5=ubound(xval,DIM=5)
1261 0 : il6=lbound(xval,DIM=6); iu6=ubound(xval,DIM=6)
1262 0 : ABI_MALLOC(copy,(il1:iu1,il2:iu2,il3:iu3,il4:iu4,il5:iu5,il6:iu6))
1263 0 : copy(:,:,:,:,:,:)=xval(:,:,:,:,:,:)
1264 :
1265 0 : end subroutine alloc_copy_rdp6d
1266 : !!***
1267 :
1268 : !----------------------------------------------------------------------
1269 :
1270 : !!****f* m_copy/alloc_copy_csp1d
1271 : !! NAME
1272 : !! alloc_copy_csp1d
1273 : !!
1274 : !! FUNCTION
1275 : !! Performs a copy of an array.
1276 : !!
1277 : !! SOURCE
1278 :
1279 0 : subroutine alloc_copy_csp1d(xval,copy)
1280 :
1281 : !Arguments ------------------------------------
1282 : complex(sp),intent(in) :: xval(:)
1283 : complex(sp),allocatable,intent(out) :: copy(:)
1284 :
1285 : !Local variables-------------------------------
1286 : integer :: il,iu
1287 : ! *********************************************************************
1288 :
1289 0 : il=lbound(xval,DIM=1); iu=ubound(xval,DIM=1)
1290 0 : ABI_MALLOC(copy,(il:iu))
1291 0 : copy(:)=xval(:)
1292 :
1293 0 : end subroutine alloc_copy_csp1d
1294 : !!***
1295 :
1296 : !----------------------------------------------------------------------
1297 :
1298 : !!****f* m_copy/alloc_copy_csp2d
1299 : !! NAME
1300 : !! alloc_copy_csp2d
1301 : !!
1302 : !! FUNCTION
1303 : !! Performs a copy of an array.
1304 : !!
1305 : !! SOURCE
1306 :
1307 0 : subroutine alloc_copy_csp2d(xval,copy)
1308 :
1309 : !Arguments ------------------------------------
1310 : complex(sp),intent(in) :: xval(:,:)
1311 : complex(sp),allocatable,intent(out) :: copy(:,:)
1312 :
1313 : !Local variables-------------------------------
1314 : integer :: il1,iu1,il2,iu2
1315 : ! *********************************************************************
1316 :
1317 0 : il1=lbound(xval,DIM=1); iu1=ubound(xval,DIM=1)
1318 0 : il2=lbound(xval,DIM=2); iu2=ubound(xval,DIM=2)
1319 0 : ABI_MALLOC(copy,(il1:iu1,il2:iu2))
1320 0 : copy(:,:)=xval(:,:)
1321 :
1322 0 : end subroutine alloc_copy_csp2d
1323 : !!***
1324 :
1325 : !----------------------------------------------------------------------
1326 :
1327 : !!****f* m_copy/alloc_copy_csp3d
1328 : !! NAME
1329 : !! alloc_copy_csp3d
1330 : !!
1331 : !! FUNCTION
1332 : !! Performs a copy of an array.
1333 : !!
1334 : !! SOURCE
1335 :
1336 0 : subroutine alloc_copy_csp3d(xval,copy)
1337 :
1338 : !Arguments ------------------------------------
1339 : complex(sp),intent(in) :: xval(:,:,:)
1340 : complex(sp),allocatable,intent(out) :: copy(:,:,:)
1341 :
1342 : !Local variables-------------------------------
1343 : integer :: il1,iu1,il2,iu2,il3,iu3
1344 : ! *********************************************************************
1345 :
1346 0 : il1=lbound(xval,DIM=1); iu1=ubound(xval,DIM=1)
1347 0 : il2=lbound(xval,DIM=2); iu2=ubound(xval,DIM=2)
1348 0 : il3=lbound(xval,DIM=3); iu3=ubound(xval,DIM=3)
1349 0 : ABI_MALLOC(copy,(il1:iu1,il2:iu2,il3:iu3))
1350 0 : copy(:,:,:)=xval(:,:,:)
1351 :
1352 0 : end subroutine alloc_copy_csp3d
1353 : !!***
1354 :
1355 : !----------------------------------------------------------------------
1356 :
1357 : !!****f* m_copy/alloc_copy_csp4d
1358 : !! NAME
1359 : !! alloc_copy_csp4d
1360 : !!
1361 : !! FUNCTION
1362 : !! Performs a copy of an array.
1363 : !!
1364 : !! SOURCE
1365 :
1366 0 : subroutine alloc_copy_csp4d(xval,copy)
1367 :
1368 : !Arguments ------------------------------------
1369 : complex(sp),intent(in) :: xval(:,:,:,:)
1370 : complex(sp),allocatable,intent(out) :: copy(:,:,:,:)
1371 :
1372 : !Local variables-------------------------------
1373 : integer :: il1,iu1,il2,iu2,il3,iu3,il4,iu4
1374 : ! *********************************************************************
1375 :
1376 0 : il1=lbound(xval,DIM=1); iu1=ubound(xval,DIM=1)
1377 0 : il2=lbound(xval,DIM=2); iu2=ubound(xval,DIM=2)
1378 0 : il3=lbound(xval,DIM=3); iu3=ubound(xval,DIM=3)
1379 0 : il4=lbound(xval,DIM=4); iu4=ubound(xval,DIM=4)
1380 0 : ABI_MALLOC(copy,(il1:iu1,il2:iu2,il3:iu3,il4:iu4))
1381 0 : copy(:,:,:,:)=xval(:,:,:,:)
1382 :
1383 0 : end subroutine alloc_copy_csp4d
1384 : !!***
1385 :
1386 : !----------------------------------------------------------------------
1387 :
1388 : !!****f* m_copy/alloc_copy_cdp1d
1389 : !! NAME
1390 : !! alloc_copy_cdp1d
1391 : !!
1392 : !! FUNCTION
1393 : !! Performs a copy of an array.
1394 : !!
1395 : !! SOURCE
1396 :
1397 9 : subroutine alloc_copy_cdp1d(xval,copy)
1398 :
1399 : !Arguments ------------------------------------
1400 : complex(dp),intent(in) :: xval(:)
1401 : complex(dp),allocatable,intent(out) :: copy(:)
1402 :
1403 : !Local variables-------------------------------
1404 : integer :: il,iu
1405 : ! *********************************************************************
1406 :
1407 9 : il=lbound(xval,DIM=1); iu=ubound(xval,DIM=1)
1408 27 : ABI_MALLOC(copy,(il:iu))
1409 91 : copy(:)=xval(:)
1410 :
1411 9 : end subroutine alloc_copy_cdp1d
1412 : !!***
1413 :
1414 : !----------------------------------------------------------------------
1415 :
1416 : !!****f* m_copy/alloc_copy_cdp2d
1417 : !! NAME
1418 : !! alloc_copy_cdp2d
1419 : !!
1420 : !! FUNCTION
1421 : !! Performs a copy of an array.
1422 : !!
1423 : !! SOURCE
1424 :
1425 2088 : subroutine alloc_copy_cdp2d(xval,copy)
1426 :
1427 : !Arguments ------------------------------------
1428 : complex(dp),intent(in) :: xval(:,:)
1429 : complex(dp),allocatable,intent(out) :: copy(:,:)
1430 :
1431 : !Local variables-------------------------------
1432 : integer :: il1,iu1,il2,iu2
1433 : ! *********************************************************************
1434 :
1435 2088 : il1=lbound(xval,DIM=1); iu1=ubound(xval,DIM=1)
1436 2088 : il2=lbound(xval,DIM=2); iu2=ubound(xval,DIM=2)
1437 8352 : ABI_MALLOC(copy,(il1:iu1,il2:iu2))
1438 1827960 : copy(:,:)=xval(:,:)
1439 :
1440 2088 : end subroutine alloc_copy_cdp2d
1441 : !!***
1442 :
1443 : !----------------------------------------------------------------------
1444 :
1445 : !!****f* m_copy/alloc_copy_cdp3d
1446 : !! NAME
1447 : !! alloc_copy_cdp3d
1448 : !!
1449 : !! FUNCTION
1450 : !! Performs a copy of an array.
1451 : !!
1452 : !! SOURCE
1453 :
1454 0 : subroutine alloc_copy_cdp3d(xval,copy)
1455 :
1456 : !Arguments ------------------------------------
1457 : complex(dp),intent(in) :: xval(:,:,:)
1458 : complex(dp),allocatable,intent(out) :: copy(:,:,:)
1459 :
1460 : !Local variables-------------------------------
1461 : integer :: il1,iu1,il2,iu2,il3,iu3
1462 : ! *********************************************************************
1463 :
1464 0 : il1=lbound(xval,DIM=1); iu1=ubound(xval,DIM=1)
1465 0 : il2=lbound(xval,DIM=2); iu2=ubound(xval,DIM=2)
1466 0 : il3=lbound(xval,DIM=3); iu3=ubound(xval,DIM=3)
1467 0 : ABI_MALLOC(copy,(il1:iu1,il2:iu2,il3:iu3))
1468 0 : copy(:,:,:)=xval(:,:,:)
1469 :
1470 0 : end subroutine alloc_copy_cdp3d
1471 : !!***
1472 :
1473 : !----------------------------------------------------------------------
1474 :
1475 : !!****f* m_copy/alloc_copy_cdp4d
1476 : !! NAME
1477 : !! alloc_copy_cdp4d
1478 : !!
1479 : !! FUNCTION
1480 : !! Performs a copy of an array.
1481 : !!
1482 : !! SOURCE
1483 :
1484 0 : subroutine alloc_copy_cdp4d(xval,copy)
1485 :
1486 : !Arguments ------------------------------------
1487 : complex(dp),intent(in) :: xval(:,:,:,:)
1488 : complex(dp),allocatable,intent(out) :: copy(:,:,:,:)
1489 :
1490 : !Local variables-------------------------------
1491 : integer :: il1,iu1,il2,iu2,il3,iu3,il4,iu4
1492 : ! *********************************************************************
1493 :
1494 0 : il1=lbound(xval,DIM=1); iu1=ubound(xval,DIM=1)
1495 0 : il2=lbound(xval,DIM=2); iu2=ubound(xval,DIM=2)
1496 0 : il3=lbound(xval,DIM=3); iu3=ubound(xval,DIM=3)
1497 0 : il4=lbound(xval,DIM=4); iu4=ubound(xval,DIM=4)
1498 0 : ABI_MALLOC(copy,(il1:iu1,il2:il2,il3:iu3,il4:iu4))
1499 0 : copy(:,:,:,:)=xval(:,:,:,:)
1500 :
1501 0 : end subroutine alloc_copy_cdp4d
1502 : !!***
1503 :
1504 : !----------------------------------------------------------------------
1505 :
1506 : !!****f* m_copy/alloc_copy_ch1d
1507 : !! NAME
1508 : !! alloc_copy_ch1d
1509 : !!
1510 : !! FUNCTION
1511 : !! Performs a copy of an array.
1512 : !!
1513 : !! NOTES
1514 : !! This routine segfaults on XLF, disabled for the time being
1515 : !! Should test whether passing slen fixes the problem
1516 : !!
1517 : !! SOURCE
1518 :
1519 : subroutine alloc_copy_ch1d(xval,copy,slen)
1520 :
1521 : !Arguments ------------------------------------
1522 : integer,intent(in) :: slen
1523 : character(len=slen),intent(in) :: xval(:)
1524 : character(len=slen),allocatable,intent(out) :: copy(:)
1525 :
1526 : !Local variables-------------------------------
1527 : integer :: il,iu
1528 : ! *********************************************************************
1529 :
1530 : il=lbound(xval,DIM=1); iu=ubound(xval,DIM=1)
1531 : ABI_MALLOC(copy,(il:iu))
1532 : copy(:)=xval(:)
1533 :
1534 : end subroutine alloc_copy_ch1d
1535 : !!***
1536 :
1537 : !----------------------------------------------------------------------
1538 :
1539 : !!****f* m_copy/alloc_copy_log1d
1540 : !! NAME
1541 : !! alloc_copy_log1d
1542 : !!
1543 : !! FUNCTION
1544 : !! Performs a copy of an array.
1545 : !!
1546 : !! SOURCE
1547 :
1548 6870 : subroutine alloc_copy_log1d(xval,copy)
1549 :
1550 : !Arguments ------------------------------------
1551 : logical,intent(in) :: xval(:)
1552 : logical,allocatable,intent(out) :: copy(:)
1553 :
1554 : !Local variables-------------------------------
1555 : integer :: il,iu
1556 : ! *********************************************************************
1557 :
1558 6870 : il=lbound(xval,DIM=1); iu=ubound(xval,DIM=1)
1559 20610 : ABI_MALLOC(copy,(il:iu))
1560 15582 : copy(:)=xval(:)
1561 :
1562 6870 : end subroutine alloc_copy_log1d
1563 : !!***
1564 :
1565 : !----------------------------------------------------------------------
1566 :
1567 : !!****f* m_copy/alloc_copy_log2d
1568 : !! NAME
1569 : !! alloc_copy_log2d
1570 : !!
1571 : !! FUNCTION
1572 : !! Performs a copy of an array.
1573 : !!
1574 : !! SOURCE
1575 :
1576 0 : subroutine alloc_copy_log2d(xval,copy)
1577 :
1578 : !Arguments ------------------------------------
1579 : logical,intent(in) :: xval(:,:)
1580 : logical,allocatable,intent(out) :: copy(:,:)
1581 :
1582 : !Local variables-------------------------------
1583 : integer :: il1,iu1,il2,iu2
1584 : ! *********************************************************************
1585 :
1586 0 : il1=lbound(xval,DIM=1); iu1=ubound(xval,DIM=1)
1587 0 : il2=lbound(xval,DIM=2); iu2=ubound(xval,DIM=2)
1588 0 : ABI_MALLOC(copy,(il1:iu1,il2:iu2))
1589 0 : copy(:,:)=xval(:,:)
1590 :
1591 0 : end subroutine alloc_copy_log2d
1592 : !!***
1593 :
1594 : !----------------------------------------------------------------------
1595 :
1596 : !!****f* m_copy/alloc_copy_log3d
1597 : !! NAME
1598 : !! alloc_copy_log3d
1599 : !!
1600 : !! FUNCTION
1601 : !! Performs a copy of an array.
1602 : !!
1603 : !! SOURCE
1604 :
1605 0 : subroutine alloc_copy_log3d(xval,copy)
1606 :
1607 : !Arguments ------------------------------------
1608 : logical,intent(in) :: xval(:,:,:)
1609 : logical,allocatable,intent(out) :: copy(:,:,:)
1610 :
1611 : !Local variables-------------------------------
1612 : integer :: il1,iu1,il2,iu2,il3,iu3
1613 : ! *********************************************************************
1614 :
1615 0 : il1=lbound(xval,DIM=1); iu1=ubound(xval,DIM=1)
1616 0 : il2=lbound(xval,DIM=2); iu2=ubound(xval,DIM=2)
1617 0 : il3=lbound(xval,DIM=3); iu3=ubound(xval,DIM=3)
1618 0 : ABI_MALLOC(copy,(il1:iu1,il2:iu2,il3:iu3))
1619 0 : copy(:,:,:)=xval(:,:,:)
1620 :
1621 0 : end subroutine alloc_copy_log3d
1622 : !!***
1623 :
1624 : !----------------------------------------------------------------------
1625 :
1626 : !!****f* m_copy/alloc_copy_log4d
1627 : !! NAME
1628 : !! alloc_copy_log4d
1629 : !!
1630 : !! FUNCTION
1631 : !! Performs a copy of an array.
1632 : !!
1633 : !! SOURCE
1634 :
1635 0 : subroutine alloc_copy_log4d(xval,copy)
1636 :
1637 : !Arguments ------------------------------------
1638 : logical,intent(in) :: xval(:,:,:,:)
1639 : logical,allocatable,intent(out) :: copy(:,:,:,:)
1640 :
1641 : !Local variables-------------------------------
1642 : integer :: il1,iu1,il2,iu2,il3,iu3,il4,iu4
1643 : ! *********************************************************************
1644 :
1645 0 : il1=lbound(xval,DIM=1); iu1=ubound(xval,DIM=1)
1646 0 : il2=lbound(xval,DIM=2); iu2=ubound(xval,DIM=2)
1647 0 : il3=lbound(xval,DIM=3); iu3=ubound(xval,DIM=3)
1648 0 : il4=lbound(xval,DIM=4); iu4=ubound(xval,DIM=4)
1649 0 : ABI_MALLOC(copy,(il1:iu1,il2:iu2,il3:iu3,il4:iu4))
1650 0 : copy(:,:,:,:)=xval(:,:,:,:)
1651 :
1652 0 : end subroutine alloc_copy_log4d
1653 : !!***
1654 :
1655 : !----------------------------------------------------------------------
1656 :
1657 : !!****f* m_copy/addr_copy_int1d
1658 : !! NAME
1659 : !! addr_copy_int1d
1660 : !!
1661 : !! FUNCTION
1662 : !! Performs a bitwise copy of a pointer.
1663 : !!
1664 : !! SOURCE
1665 :
1666 0 : subroutine addr_copy_int1d(xval,copy)
1667 :
1668 : !Arguments ------------------------------------
1669 : integer,pointer :: xval(:)
1670 : integer,pointer :: copy(:)
1671 :
1672 : !Local variables-------------------------------
1673 : #if defined HAVE_FC_ISO_C_BINDING
1674 : integer :: shp(1)
1675 : type(C_PTR) :: ham_ptr
1676 : #endif
1677 :
1678 : ! *********************************************************************
1679 :
1680 0 : if (associated(xval)) then
1681 : #if defined HAVE_FC_ISO_C_BINDING
1682 0 : shp=shape(xval)
1683 0 : if (product(shp)>0) then
1684 0 : ham_ptr=c_loc(xval(1))
1685 0 : call c_f_pointer(ham_ptr,copy,shp)
1686 : else
1687 0 : ABI_MALLOC(copy,(0))
1688 : end if
1689 : #else
1690 : copy=transfer(xval,copy)
1691 : #endif
1692 : else
1693 0 : nullify(copy)
1694 : end if
1695 :
1696 0 : end subroutine addr_copy_int1d
1697 : !!***
1698 :
1699 : !----------------------------------------------------------------------
1700 :
1701 : !!****f* m_copy/addr_copy_int2d
1702 : !! NAME
1703 : !! addr_copy_int2d
1704 : !!
1705 : !! FUNCTION
1706 : !! Performs a bitwise copy of a pointer.
1707 : !!
1708 : !! SOURCE
1709 :
1710 2716 : subroutine addr_copy_int2d(xval,copy)
1711 :
1712 : !Arguments ------------------------------------
1713 : integer,pointer :: xval(:,:)
1714 : integer,pointer :: copy(:,:)
1715 :
1716 : !Local variables-------------------------------
1717 : #if defined HAVE_FC_ISO_C_BINDING
1718 : integer :: shp(2)
1719 : type(C_PTR) :: ham_ptr
1720 : #endif
1721 :
1722 : ! *********************************************************************
1723 :
1724 2716 : if (associated(xval)) then
1725 : #if defined HAVE_FC_ISO_C_BINDING
1726 8148 : shp=shape(xval)
1727 8148 : if (product(shp)>0) then
1728 2716 : ham_ptr=c_loc(xval(1,1))
1729 8148 : call c_f_pointer(ham_ptr,copy,shp)
1730 : else
1731 0 : ABI_MALLOC(copy,(0,0))
1732 : end if
1733 : #else
1734 : copy=transfer(xval,copy)
1735 : #endif
1736 : else
1737 0 : nullify(copy)
1738 : end if
1739 :
1740 2716 : end subroutine addr_copy_int2d
1741 : !!***
1742 :
1743 : !----------------------------------------------------------------------
1744 :
1745 : !!****f* m_copy/addr_copy_int3d
1746 : !! NAME
1747 : !! addr_copy_int3d
1748 : !!
1749 : !! FUNCTION
1750 : !! Performs a bitwise copy of a pointer.
1751 : !!
1752 : !! SOURCE
1753 :
1754 0 : subroutine addr_copy_int3d(xval,copy)
1755 :
1756 : !Arguments ------------------------------------
1757 : integer,pointer :: xval(:,:,:)
1758 : integer,pointer :: copy(:,:,:)
1759 :
1760 : !Local variables-------------------------------
1761 : #if defined HAVE_FC_ISO_C_BINDING
1762 : integer :: shp(3)
1763 : type(C_PTR) :: ham_ptr
1764 : #endif
1765 :
1766 : ! *********************************************************************
1767 :
1768 0 : if (associated(xval)) then
1769 : #if defined HAVE_FC_ISO_C_BINDING
1770 0 : shp=shape(xval)
1771 0 : if (product(shp)>0) then
1772 0 : ham_ptr=c_loc(xval(1,1,1))
1773 0 : call c_f_pointer(ham_ptr,copy,shp)
1774 : else
1775 0 : ABI_MALLOC(copy,(0,0,0))
1776 : end if
1777 : #else
1778 : copy=transfer(xval,copy)
1779 : #endif
1780 : else
1781 0 : nullify(copy)
1782 : end if
1783 :
1784 0 : end subroutine addr_copy_int3d
1785 : !!***
1786 :
1787 : !----------------------------------------------------------------------
1788 :
1789 : !!****f* m_copy/addr_copy_int4d
1790 : !! NAME
1791 : !! addr_copy_int4d
1792 : !!
1793 : !! FUNCTION
1794 : !! Performs a bitwise copy of a pointer.
1795 : !!
1796 : !! SOURCE
1797 :
1798 0 : subroutine addr_copy_int4d(xval,copy)
1799 :
1800 : !Arguments ------------------------------------
1801 : integer,pointer :: xval(:,:,:,:)
1802 : integer,pointer :: copy(:,:,:,:)
1803 :
1804 : !Local variables-------------------------------
1805 : #if defined HAVE_FC_ISO_C_BINDING
1806 : integer :: shp(4)
1807 : type(C_PTR) :: ham_ptr
1808 : #endif
1809 :
1810 : ! *********************************************************************
1811 :
1812 0 : if (associated(xval)) then
1813 : #if defined HAVE_FC_ISO_C_BINDING
1814 0 : shp=shape(xval)
1815 0 : if (product(shp)>0) then
1816 0 : ham_ptr=c_loc(xval(1,1,1,1))
1817 0 : call c_f_pointer(ham_ptr,copy,shp)
1818 : else
1819 0 : ABI_MALLOC(copy,(0,0,0,0))
1820 : end if
1821 : #else
1822 : copy=transfer(xval,copy)
1823 : #endif
1824 : else
1825 0 : nullify(copy)
1826 : end if
1827 :
1828 0 : end subroutine addr_copy_int4d
1829 : !!***
1830 :
1831 : !----------------------------------------------------------------------
1832 :
1833 : !!****f* m_copy/addr_copy_dp1d
1834 : !! NAME
1835 : !! addr_copy_dp1d
1836 : !!
1837 : !! FUNCTION
1838 : !! Performs a bitwise copy of a pointer.
1839 : !!
1840 : !! SOURCE
1841 :
1842 2716 : subroutine addr_copy_dp1d(xval,copy)
1843 :
1844 : !Arguments ------------------------------------
1845 : real(dp),pointer :: xval(:)
1846 : real(dp),pointer :: copy(:)
1847 :
1848 : !Local variables-------------------------------
1849 : #if defined HAVE_FC_ISO_C_BINDING
1850 : integer :: shp(1)
1851 : type(C_PTR) :: ham_ptr
1852 : #endif
1853 :
1854 : ! *********************************************************************
1855 :
1856 2716 : if (associated(xval)) then
1857 : #if defined HAVE_FC_ISO_C_BINDING
1858 5432 : shp=shape(xval)
1859 5432 : if (product(shp)>0) then
1860 2716 : ham_ptr=c_loc(xval(1))
1861 5432 : call c_f_pointer(ham_ptr,copy,shp)
1862 : else
1863 0 : ABI_MALLOC(copy,(0))
1864 : end if
1865 : #else
1866 : copy=transfer(xval,copy)
1867 : #endif
1868 : else
1869 0 : nullify(copy)
1870 : end if
1871 :
1872 2716 : end subroutine addr_copy_dp1d
1873 : !!***
1874 :
1875 : !----------------------------------------------------------------------
1876 :
1877 : !!****f* m_copy/addr_copy_dp2d
1878 : !! NAME
1879 : !! addr_copy_dp2d
1880 : !!
1881 : !! FUNCTION
1882 : !! Performs a bitwise copy of a pointer.
1883 : !!
1884 : !! SOURCE
1885 :
1886 4074 : subroutine addr_copy_dp2d(xval,copy)
1887 :
1888 : !Arguments ------------------------------------
1889 : real(dp),pointer :: xval(:,:)
1890 : real(dp),pointer :: copy(:,:)
1891 :
1892 : !Local variables-------------------------------
1893 : #if defined HAVE_FC_ISO_C_BINDING
1894 : integer :: shp(2)
1895 : type(C_PTR) :: ham_ptr
1896 : #endif
1897 :
1898 : ! *********************************************************************
1899 :
1900 4074 : if (associated(xval)) then
1901 : #if defined HAVE_FC_ISO_C_BINDING
1902 12222 : shp=shape(xval)
1903 12222 : if (product(shp)>0) then
1904 4058 : ham_ptr=c_loc(xval(1,1))
1905 12174 : call c_f_pointer(ham_ptr,copy,shp)
1906 : else
1907 16 : ABI_MALLOC(copy,(0,0))
1908 : end if
1909 : #else
1910 : copy=transfer(xval,copy)
1911 : #endif
1912 : else
1913 0 : nullify(copy)
1914 : end if
1915 :
1916 4074 : end subroutine addr_copy_dp2d
1917 : !!***
1918 :
1919 : !----------------------------------------------------------------------
1920 :
1921 : !!****f* m_copy/addr_copy_dp3d
1922 : !! NAME
1923 : !! addr_copy_dp3d
1924 : !!
1925 : !! FUNCTION
1926 : !! Performs a bitwise copy of a pointer.
1927 : !!
1928 : !! SOURCE
1929 :
1930 2716 : subroutine addr_copy_dp3d(xval,copy)
1931 :
1932 : !Arguments ------------------------------------
1933 : real(dp),pointer :: xval(:,:,:)
1934 : real(dp),pointer :: copy(:,:,:)
1935 :
1936 : !Local variables-------------------------------
1937 : #if defined HAVE_FC_ISO_C_BINDING
1938 : integer :: shp(3)
1939 : type(C_PTR) :: ham_ptr
1940 : #endif
1941 :
1942 : ! *********************************************************************
1943 :
1944 2716 : if (associated(xval)) then
1945 : #if defined HAVE_FC_ISO_C_BINDING
1946 10864 : shp=shape(xval)
1947 10864 : if (product(shp)>0) then
1948 2716 : ham_ptr=c_loc(xval(1,1,1))
1949 10864 : call c_f_pointer(ham_ptr,copy,shp)
1950 : else
1951 0 : ABI_MALLOC(copy,(0,0,0))
1952 : end if
1953 : #else
1954 : copy=transfer(xval,copy)
1955 : #endif
1956 : else
1957 0 : nullify(copy)
1958 : end if
1959 :
1960 2716 : end subroutine addr_copy_dp3d
1961 : !!***
1962 :
1963 : !----------------------------------------------------------------------
1964 :
1965 : !!****f* m_copy/addr_copy_dp4d
1966 : !! NAME
1967 : !! addr_copy_dp4d
1968 : !!
1969 : !! FUNCTION
1970 : !! Performs a bitwise copy of a pointer.
1971 : !!
1972 : !! SOURCE
1973 :
1974 4074 : subroutine addr_copy_dp4d(xval,copy)
1975 :
1976 : !Arguments ------------------------------------
1977 : real(dp),pointer :: xval(:,:,:,:)
1978 : real(dp),pointer :: copy(:,:,:,:)
1979 :
1980 : !Local variables-------------------------------
1981 : #if defined HAVE_FC_ISO_C_BINDING
1982 : integer :: shp(4)
1983 : type(C_PTR) :: ham_ptr
1984 : #endif
1985 :
1986 : ! *********************************************************************
1987 :
1988 4074 : if (associated(xval)) then
1989 : #if defined HAVE_FC_ISO_C_BINDING
1990 20370 : shp=shape(xval)
1991 20370 : if (product(shp)>0) then
1992 4074 : ham_ptr=c_loc(xval(1,1,1,1))
1993 20370 : call c_f_pointer(ham_ptr,copy,shp)
1994 : else
1995 0 : ABI_MALLOC(copy,(0,0,0,0))
1996 : end if
1997 : #else
1998 : copy=transfer(xval,copy)
1999 : #endif
2000 : else
2001 0 : nullify(copy)
2002 : end if
2003 :
2004 4074 : end subroutine addr_copy_dp4d
2005 : !!***
2006 :
2007 : !----------------------------------------------------------------------
2008 :
2009 : !!****f* m_copy/addr_copy_dp5d
2010 : !! NAME
2011 : !! addr_copy_dp5d
2012 : !!
2013 : !! FUNCTION
2014 : !! Performs a bitwise copy of a pointer.
2015 : !!
2016 : !! SOURCE
2017 :
2018 2716 : subroutine addr_copy_dp5d(xval,copy)
2019 :
2020 : !Arguments ------------------------------------
2021 : real(dp),pointer :: xval(:,:,:,:,:)
2022 : real(dp),pointer :: copy(:,:,:,:,:)
2023 :
2024 : !Local variables-------------------------------
2025 : #if defined HAVE_FC_ISO_C_BINDING
2026 : integer :: shp(5)
2027 : type(C_PTR) :: ham_ptr
2028 : #endif
2029 :
2030 : ! *********************************************************************
2031 :
2032 2716 : if (associated(xval)) then
2033 : #if defined HAVE_FC_ISO_C_BINDING
2034 8868 : shp=shape(xval)
2035 8868 : if (product(shp)>0) then
2036 1478 : ham_ptr=c_loc(xval(1,1,1,1,1))
2037 8868 : call c_f_pointer(ham_ptr,copy,shp)
2038 : else
2039 0 : ABI_MALLOC(copy,(0,0,0,0,0))
2040 : end if
2041 : #else
2042 : copy=transfer(xval,copy)
2043 : #endif
2044 : else
2045 1238 : nullify(copy)
2046 : end if
2047 :
2048 2716 : end subroutine addr_copy_dp5d
2049 : !!***
2050 :
2051 : END MODULE m_copy
2052 : !!***
|
