Branch data 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 : 741 : 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 [ + + ]: 741 : 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 : 685 : nullify(copy)
169 : : end if
170 : :
171 : 741 : 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 [ - + ]: 342561 : 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 [ + + ]: 342561 : il=lbound(xval,DIM=1); iu=ubound(xval,DIM=1)
958 [ + + + - : 1027683 : ABI_MALLOC(copy,(il:iu))
+ - + + -
+ - + -
+ ]
959 [ + + ]: 8170068 : copy(:)=xval(:)
960 : :
961 : 342561 : 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 [ - + ]: 38298 : 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 [ + - ]: 38298 : il1=lbound(xval,DIM=1); iu1=ubound(xval,DIM=1)
986 [ + - ]: 38298 : il2=lbound(xval,DIM=2); iu2=ubound(xval,DIM=2)
987 [ - + + - : 153192 : ABI_MALLOC(copy,(il1:iu1,il2:iu2))
- + + - +
- + - - +
- + - + ]
988 [ + + + + ]: 41348737 : copy(:,:)=xval(:,:)
989 : :
990 : 38298 : 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 [ - + ]: 31921 : 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 [ + - ]: 31921 : il1=lbound(xval,DIM=1); iu1=ubound(xval,DIM=1)
1015 [ + + ]: 31921 : il2=lbound(xval,DIM=2); iu2=ubound(xval,DIM=2)
1016 [ + - ]: 31921 : il3=lbound(xval,DIM=3); iu3=ubound(xval,DIM=3)
1017 [ - + + - : 159605 : ABI_MALLOC(copy,(il1:iu1,il2:iu2,il3:iu3))
+ + + - -
+ + - + -
+ + - + -
+ - + ]
1018 [ + + + + : 6071536 : copy(:,:,:)=xval(:,:,:)
+ + ]
1019 : :
1020 : 31921 : 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 [ - + ]: 297000 : 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 [ + + ]: 297000 : il=lbound(xval,DIM=1); iu=ubound(xval,DIM=1)
1107 [ + + + - : 891000 : ABI_MALLOC(copy,(il:iu))
+ - + + -
+ - + -
+ ]
1108 [ + + ]: 23624530 : copy(:)=xval(:)
1109 : :
1110 : 297000 : 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 [ - + ]: 407968 : 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 [ + + ]: 407968 : il1=lbound(xval,DIM=1); iu1=ubound(xval,DIM=1)
1135 [ + + ]: 407968 : il2=lbound(xval,DIM=2); iu2=ubound(xval,DIM=2)
1136 [ + + + - : 1631872 : ABI_MALLOC(copy,(il1:iu1,il2:iu2))
+ + + - +
- + + - +
- + - + ]
1137 [ + + + + ]: 74303999 : copy(:,:)=xval(:,:)
1138 : :
1139 : 407968 : 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 [ - + ]: 128843 : 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 [ + + ]: 128843 : il1=lbound(xval,DIM=1); iu1=ubound(xval,DIM=1)
1164 [ + + ]: 128843 : il2=lbound(xval,DIM=2); iu2=ubound(xval,DIM=2)
1165 [ + + ]: 128843 : il3=lbound(xval,DIM=3); iu3=ubound(xval,DIM=3)
1166 [ + + + - : 644215 : ABI_MALLOC(copy,(il1:iu1,il2:iu2,il3:iu3))
+ + + - +
+ + - + -
+ + - + -
+ - + ]
1167 [ + + + + : 199434587 : copy(:,:,:)=xval(:,:,:)
+ + ]
1168 : :
1169 : 128843 : 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 [ - + ]: 4289 : 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 [ + + ]: 4289 : il1=lbound(xval,DIM=1); iu1=ubound(xval,DIM=1)
1194 [ + - ]: 4289 : il2=lbound(xval,DIM=2); iu2=ubound(xval,DIM=2)
1195 [ + - ]: 4289 : il3=lbound(xval,DIM=3); iu3=ubound(xval,DIM=3)
1196 [ + - ]: 4289 : il4=lbound(xval,DIM=4); iu4=ubound(xval,DIM=4)
1197 [ + + + - : 25734 : ABI_MALLOC(copy,(il1:iu1,il2:iu2,il3:iu3,il4:iu4))
- + + - -
+ + - - +
+ - + - +
+ - + - +
- + ]
1198 [ + + + + : 141764116 : copy(:,:,:,:)=xval(:,:,:,:)
+ + + + ]
1199 : :
1200 : 4289 : 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 [ - + ]: 12535 : 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 [ + - ]: 12535 : il1=lbound(xval,DIM=1); iu1=ubound(xval,DIM=1)
1225 [ + - ]: 12535 : il2=lbound(xval,DIM=2); iu2=ubound(xval,DIM=2)
1226 [ + - ]: 12535 : il3=lbound(xval,DIM=3); iu3=ubound(xval,DIM=3)
1227 [ + + ]: 12535 : il4=lbound(xval,DIM=4); iu4=ubound(xval,DIM=4)
1228 [ + - ]: 12535 : il5=lbound(xval,DIM=5); iu5=ubound(xval,DIM=5)
1229 [ - + + - : 87745 : ABI_MALLOC(copy,(il1:iu1,il2:iu2,il3:iu3,il4:iu4,il5:iu5))
- + + - -
+ + - + +
+ - - + +
- + - + +
- + - + -
+ ]
1230 [ + + + + : 1702644 : copy(:,:,:,:,:)=xval(:,:,:,:,:)
+ + + + +
+ ]
1231 : :
1232 : 12535 : 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 [ - + ]: 6932 : 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 [ + - ]: 6932 : il=lbound(xval,DIM=1); iu=ubound(xval,DIM=1)
1559 [ - + + - : 20796 : ABI_MALLOC(copy,(il:iu))
+ - + - -
+ - + -
+ ]
1560 [ + + ]: 15752 : copy(:)=xval(:)
1561 : :
1562 : 6932 : 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 : 16 : 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 [ + - ]: 16 : if (associated(xval)) then
1725 : : #if defined HAVE_FC_ISO_C_BINDING
1726 [ + + ]: 48 : shp=shape(xval)
1727 [ + + + - ]: 48 : if (product(shp)>0) then
1728 : 16 : ham_ptr=c_loc(xval(1,1))
1729 [ + + ]: 48 : 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 : 16 : 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 : 16 : 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 [ + - ]: 16 : if (associated(xval)) then
1857 : : #if defined HAVE_FC_ISO_C_BINDING
1858 [ + + ]: 32 : shp=shape(xval)
1859 [ + + + - ]: 32 : if (product(shp)>0) then
1860 : 16 : ham_ptr=c_loc(xval(1))
1861 [ + + ]: 32 : 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 : 16 : 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 : 24 : 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 [ + - ]: 24 : if (associated(xval)) then
1901 : : #if defined HAVE_FC_ISO_C_BINDING
1902 [ + + ]: 72 : shp=shape(xval)
1903 [ + + + + ]: 72 : if (product(shp)>0) then
1904 : 8 : ham_ptr=c_loc(xval(1,1))
1905 [ + + ]: 24 : 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 : 24 : 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 : 16 : 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 [ + - ]: 16 : if (associated(xval)) then
1945 : : #if defined HAVE_FC_ISO_C_BINDING
1946 [ + + ]: 64 : shp=shape(xval)
1947 [ + + + - ]: 64 : if (product(shp)>0) then
1948 : 16 : ham_ptr=c_loc(xval(1,1,1))
1949 [ + + ]: 64 : 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 : 16 : 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 : 24 : 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 [ + - ]: 24 : if (associated(xval)) then
1989 : : #if defined HAVE_FC_ISO_C_BINDING
1990 [ + + ]: 120 : shp=shape(xval)
1991 [ + + + - ]: 120 : if (product(shp)>0) then
1992 : 24 : ham_ptr=c_loc(xval(1,1,1,1))
1993 [ + + ]: 120 : 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 : 24 : 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 : 16 : 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 [ - + ]: 16 : if (associated(xval)) then
2033 : : #if defined HAVE_FC_ISO_C_BINDING
2034 [ # # ]: 0 : shp=shape(xval)
2035 [ # # # # ]: 0 : if (product(shp)>0) then
2036 : 0 : ham_ptr=c_loc(xval(1,1,1,1,1))
2037 [ # # ]: 0 : 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 : 16 : nullify(copy)
2046 : : end if
2047 : :
2048 : 16 : end subroutine addr_copy_dp5d
2049 : : !!***
2050 : :
2051 : : END MODULE m_copy
2052 : : !!***
|
