marray_base.f90
Go to the documentation of this file.
1!#############################################################################
2!# #
3!# fosite - 3D hydrodynamical simulation program #
4!# module: marray_base.f90 #
5!# #
6!# Copyright (C) 2018-2024 #
7!# Tobias Illenseer <tillense@astrophysik.uni-kiel.de> #
8!# #
9!# This program is free software; you can redistribute it and/or modify #
10!# it under the terms of the GNU General Public License as published by #
11!# the Free Software Foundation; either version 2 of the License, or (at #
12!# your option) any later version. #
13!# #
14!# This program is distributed in the hope that it will be useful, but #
15!# WITHOUT ANY WARRANTY; without even the implied warranty of #
16!# MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE, GOOD TITLE or #
17!# NON INFRINGEMENT. See the GNU General Public License for more #
18!# details. #
19!# #
20!# You should have received a copy of the GNU General Public License #
21!# along with this program; if not, write to the Free Software #
22!# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. #
23!# #
24!#############################################################################
29!----------------------------------------------------------------------------!
35!----------------------------------------------------------------------------!
37 IMPLICIT NONE
38 !--------------------------------------------------------------------------!
39 PRIVATE
42 INTEGER, SAVE :: igmin,igmax
43 INTEGER, SAVE :: jgmin,jgmax
44 INTEGER, SAVE :: kgmin,kgmax
45 INTEGER, SAVE :: inum,jnum,knum
46 LOGICAL, SAVE :: idx_init = .false.
50 INTEGER :: imin,imax
51 INTEGER :: jmin,jmax
52 INTEGER :: kmin,kmax
53 LOGICAL, POINTER, CONTIGUOUS :: &
54 mask1d(:) => null(), &
55 mask2d(:,:) => null(), &
56 mask3d(:,:,:) => null()
57 CONTAINS
59 PROCEDURE :: init => init_selection
60 PROCEDURE :: assignselection
61 PROCEDURE :: cuboid
62 PROCEDURE :: everything
63 PROCEDURE :: destroy_selection
64 generic :: ASSIGNMENT (=) => assignselection
67 END TYPE selection_base
70 INTEGER :: rank = -1,dims(2) = 0
71 REAL, POINTER, CONTIGUOUS :: data1d(:) => null()
72 REAL, POINTER, CONTIGUOUS :: data2d(:,:) => null()
73 REAL, POINTER, CONTIGUOUS :: data3d(:,:,:) => null()
74 REAL, POINTER, CONTIGUOUS :: data4d(:,:,:,:) => null()
75 REAL, POINTER, CONTIGUOUS :: data5d(:,:,:,:,:) => null()
76 CONTAINS
77 PROCEDURE :: init
78 PROCEDURE :: assignpointers
79 PROCEDURE :: remapbounds_0
80 PROCEDURE :: remapbounds_1
81 PROCEDURE :: remapbounds_2
82 generic :: remapbounds => remapbounds_0, remapbounds_1, remapbounds_2
83 PROCEDURE :: assignmarray_0
84 PROCEDURE :: assignmarray_1
85 PROCEDURE :: assignmarray_2
86 PROCEDURE :: assignmarray_3
87 PROCEDURE :: assignmarray_4
88 PROCEDURE :: assignmarray_5
89 generic :: ASSIGNMENT (=) => assignmarray_0 , assignmarray_1, assignmarray_2, &
91 PROCEDURE :: shapesmatch
92 generic :: OPERATOR(.match.) => shapesmatch
93 PROCEDURE :: addmarray_0
94 PROCEDURE :: addmarray_1
95 PROCEDURE :: addmarray_2
96 PROCEDURE :: addmarray_3
97 PROCEDURE :: addmarray_4
98 PROCEDURE :: addmarray_5
99 generic :: OPERATOR (+) => addmarray_0, addmarray_1, addmarray_2, &
101 PROCEDURE :: multmarray_0
102 PROCEDURE :: multmarray_1
103 PROCEDURE :: multmarray_2
104 PROCEDURE :: multmarray_3
105 PROCEDURE :: multmarray_4
106 PROCEDURE :: multmarray_5
107 generic :: OPERATOR (*) => multmarray_0, multmarray_1, multmarray_2, &
109 PROCEDURE :: crossproduct_0
110 generic :: OPERATOR (.x.) => crossproduct_0
111 PROCEDURE :: destroy
112 final :: finalize
113 END TYPE
114 INTERFACE marray_base
115 MODULE PROCEDURE createmarray
116 END INTERFACE
117 INTERFACE selection_base
118 MODULE PROCEDURE createselection
119 END INTERFACE
120 !--------------------------------------------------------------------------!
121 PUBLIC :: marray_base, &
125
126 CONTAINS
127
129 FUNCTION createmarray(m,n) RESULT(new_ma)
130 IMPLICIT NONE
131 !-------------------------------------------------------------------!
132 TYPE(marray_base) :: new_ma
133 INTEGER, OPTIONAL, INTENT(IN) :: m,n
134 !-------------------------------------------------------------------!
135 INTEGER :: err
136 !-------------------------------------------------------------------!
137 IF (new_ma%Init(m,n)) return ! immediately return if successful
138 ! something went wrong
139#ifdef DEBUG
140 print *,"ERROR in marray_base::CreateMArray: marray initialization failed"
141 stop 1
142#endif
143 END FUNCTION createmarray
144
146 FUNCTION init(this,m,n) RESULT(success)
147 !-------------------------------------------------------------------!
148 CLASS(marray_base), INTENT(INOUT) :: this
149 INTEGER, OPTIONAL, INTENT(IN) :: m,n
150 !-------------------------------------------------------------------!
151 LOGICAL :: success
152 INTEGER :: err
153 !-------------------------------------------------------------------!
154#if DEBUG > 2
155 print *,"DEBUG INFO in marray_base::Init: marray initialization"
156#endif
157 success = .false.
158 IF (.NOT.idx_init) return ! with success == .false.
159 ! check input parameter
160 ! ATTENTION: m=0 and n=0 is permitted to allow for creation of empty
161 ! mesh_arrays which is required, e.g., during initialization of compounds
162 IF (PRESENT(m)) THEN
163 IF (m.LT.0) THEN
164#ifdef DEBUG
165 print *,"ERROR in marray_base::Init: 1st dimension of mesh array should be >= 0"
166#endif
167 return ! with success == .false.
168 END IF
169 this%DIMS(1) = m
170 IF (PRESENT(n)) THEN
171 IF (n.LT.0) THEN
172#ifdef DEBUG
173 print *,"ERROR in marray_base::Init: 2nd dimension of mesh array should be >= 0"
174#endif
175 return ! with success == .false.
176 END IF
177 this%DIMS(2) = n
178 this%RANK = 2
179 ELSE
180 this%DIMS(2) = 1
181 this%RANK = 1
182 END IF
183 ELSE
184 this%DIMS(:) = 1
185 this%RANK = 0
186 END IF
187
188 IF (.NOT.ASSOCIATED(this%data1d)) THEN
189#if DEBUG > 2
190 print '(A,I2,A,2(I4))'," creating marray with rank ",this%RANK," and dimensions ",this%DIMS(1:2)
191#endif
192 ! allocate memory for data1d array
193 ALLOCATE(this%data1d(inum*jnum*knum*this%DIMS(1)*this%DIMS(2)),stat=err)
194 IF (err.NE.0) THEN
195#ifdef DEBUG
196 print *,"ERROR in marray_base::Init: memory allocation failed for data1d array"
197#endif
198 return ! with success == .false.
199 ELSE
200#if DEBUG > 2
201 print *,"DEBUG INFO in marray_base::Init: memory allocated for data1d, size=",SIZE(this%data1d)
202#endif
203
204 END IF
205 ELSE
206 IF (SIZE(this%data1d).NE.inum*jnum*knum*this%DIMS(1)*this%DIMS(2)) THEN
207#ifdef DEBUG
208 print *,"ERROR in marray_base::Init: data1d array size mismatch"
209#endif
210 return ! with success == .false.
211 END IF
212 END IF
213 ! assign the 2d,3d,... pointers
214 IF (SIZE(this%data1d).GT.0) THEN ! do not try pointer assignment with zero-size data1d array
215 IF (.NOT.this%AssignPointers()) return ! pointer assignment failed -> return immediately
216 END IF
217 ! report success
218 success=.true.
219 END FUNCTION init
220
224 SUBROUTINE initmeshproperties(igmin_,igmax_,jgmin_,jgmax_,kgmin_,kgmax_)
225 IMPLICIT NONE
226 !-------------------------------------------------------------------!
227 INTEGER, INTENT(IN) :: igmin_,igmax_,jgmin_,jgmax_,kgmin_,kgmax_
228 !-------------------------------------------------------------------!
229 IF (.NOT.idx_init) THEN
230 igmin = igmin_
231 igmax = igmax_
232 jgmin = jgmin_
233 jgmax = jgmax_
234 kgmin = kgmin_
235 kgmax = kgmax_
236 inum = igmax-igmin+1
237 jnum = jgmax-jgmin+1
238 knum = kgmax-kgmin+1
239 idx_init = .true.
240 END IF
241 END SUBROUTINE initmeshproperties
242
247 IMPLICIT NONE
248 !-------------------------------------------------------------------!
249 IF (idx_init) THEN
250 idx_init = .false.
251 END IF
252 END SUBROUTINE closemeshproperties
253
255 FUNCTION assignpointers(this) RESULT(success)
256 IMPLICIT NONE
257 !------------------------------------------------------------------------!
258 CLASS(marray_base),INTENT(INOUT) :: this
259 LOGICAL :: success
260 !------------------------------------------------------------------------!
261#if DEBUG > 2
262 print *,"DEBUG INFO in marray_base::AssignPointers: assign 2d,3d,... pointers"
263#endif
264 success=.false.
265 IF (.NOT.ASSOCIATED(this%data1d)) return
266 ! assign pointers depending on rank
267 IF (SIZE(this%data1d).GT.0) THEN ! exclude initialized but empty marrays (see compounds)
268 SELECT CASE(this%RANK)
269 CASE(0)
270 this%data2d(1:inum*jnum,kgmin:kgmax) => this%data1d
271 this%data3d(igmin:igmax,jgmin:jgmax,kgmin:kgmax) => this%data1d
272 this%data4d(igmin:igmax,jgmin:jgmax,kgmin:kgmax,1:1) => this%data1d
273 this%data5d(igmin:igmax,jgmin:jgmax,kgmin:kgmax,1:1,1:1) => this%data1d
274 CASE(1)
275 this%data2d(1:inum*jnum*knum,1:this%DIMS(1)) => this%data1d
276 this%data3d(1:inum*jnum,kgmin:kgmax,1:this%DIMS(1)) => this%data1d
277 this%data4d(igmin:igmax,jgmin:jgmax,kgmin:kgmax,1:this%DIMS(1)) => this%data1d
278 this%data5d(igmin:igmax,jgmin:jgmax,kgmin:kgmax,1:this%DIMS(1),1:1) => this%data1d
279 CASE(2)
280 this%data2d(1:inum*jnum*knum*this%DIMS(1),1:this%DIMS(2)) => this%data1d
281 this%data3d(1:inum*jnum*knum,1:this%DIMS(1),1:this%DIMS(2)) => this%data1d
282 this%data4d(1:inum*jnum,kgmin:kgmax,1:this%DIMS(1),1:this%DIMS(2)) => this%data1d
283 this%data5d(igmin:igmax,jgmin:jgmax,kgmin:kgmax,1:this%DIMS(1),1:this%DIMS(2)) => this%data1d
284 CASE DEFAULT
285#ifdef DEBUG
286 print *,"ERROR in marray_base::AssignPointers: rank must be in {0,1,2}"
287#endif
288 return ! wrong rank
289 END SELECT
290 END IF
291 ! report success
292 success=.true.
293 END FUNCTION assignpointers
294
301 FUNCTION remapbounds_0(this,array) RESULT(ptr)
302 IMPLICIT NONE
303 !------------------------------------------------------------------------!
304 CLASS(marray_base) :: this
305 REAL, DIMENSION(IGMIN:,JGMIN:,KGMIN:), TARGET :: array
306 !------------------------------------------------------------------------!
307 REAL, DIMENSION(:,:,:), POINTER :: ptr
308 !------------------------------------------------------------------------!
309 INTENT(IN) :: array
310 !------------------------------------------------------------------------!
311 ptr => array
312 END FUNCTION remapbounds_0
313
315 FUNCTION remapbounds_1(this,array) RESULT(ptr)
316 IMPLICIT NONE
317 !------------------------------------------------------------------------!
318 CLASS(marray_base) :: this
319 REAL, DIMENSION(IGMIN:,JGMIN:,KGMIN:,:), TARGET &
320 :: array
321 !------------------------------------------------------------------------!
322 REAL, DIMENSION(:,:,:,:), POINTER :: ptr
323 !------------------------------------------------------------------------!
324 INTENT(IN) :: array
325 !------------------------------------------------------------------------!
326 ptr => array
327 END FUNCTION remapbounds_1
328
330 FUNCTION remapbounds_2(this,array) RESULT(ptr)
331 IMPLICIT NONE
332 !------------------------------------------------------------------------!
333 CLASS(marray_base) :: this
334 REAL, DIMENSION(IGMIN:,JGMIN:,KGMIN:,:,:), TARGET &
335 :: array
336 !------------------------------------------------------------------------!
337 REAL, DIMENSION(:,:,:,:,:), POINTER :: ptr
338 !------------------------------------------------------------------------!
339 INTENT(IN) :: array
340 !------------------------------------------------------------------------!
341 ptr => array
342 END FUNCTION remapbounds_2
343
345 SUBROUTINE assignmarray_0(this,ma)
346 IMPLICIT NONE
347 !------------------------------------------------------------------------!
348 CLASS(marray_base),INTENT(INOUT) :: this
349 CLASS(marray_base),INTENT(IN) :: ma
350 !------------------------------------------------------------------------!
351#if !defined(__GFORTRAN__) || (defined(__GFORTRAN__) && __GNUC__ >= 13)
352 INTEGER :: err
353#endif
354 LOGICAL :: LHS_initialized
355 !------------------------------------------------------------------------!
356#if DEBUG > 2
357 print *,"DEBUG INFO in marray_base::AssignMArray_0: marray assignment"
358#endif
359 IF (.NOT.ASSOCIATED(ma%data1d).OR.ma%rank.LT.0) THEN
360#ifdef DEBUG
361 print *,"ERROR in marray_base::AssignMArray_0: rhs of assignment not initialized"
362#endif
363 return
364 END IF
365
366 ! allways copy rank & shape
367 this%RANK = ma%RANK
368 this%DIMS(:) = ma%DIMS(:)
369 ! check whether lhs is already initialized
370 lhs_initialized = ASSOCIATED(this%data1d)
371 ! lhs of assignment uninitialized -> initialize new mesh array
372 ! ATTENTION: finalization of derived types works different for
373 ! GNU Fortran version < 13 , hence to prevent memory leaks, one has to point
374 ! the data1d array of the lhs (this%data1d) to the already associated
375 ! data1d array of the rhs (ma%data1d).
376 ! Other compilers, e.g., ifort (intel) & nfort (NEC) require allocation
377 ! of memory for new data1d array on the lhs, because ma on the rhs
378 ! is finalized on exit and the data1d array is deallocated
379#if !defined(__GFORTRAN__) || (defined(__GFORTRAN__) && __GNUC__ > 12)
380 ! all compilers except for gfortran version < 13
381 IF (.NOT.lhs_initialized) THEN
382 ALLOCATE(this%data1d,source=ma%data1d,stat=err)
383 IF (err.NE.0) THEN
384#ifdef DEBUG
385 print *,"ERROR in marray_base::AssignMArray_0: marray initialization failed"
386#endif
387 RETURN
388#if DEBUG > 2
389 ELSE
390 print *,"DEBUG INFO in marray_base::AssignMArray_0: memory allocated for data1d, size=",SIZE(this%data1d)
391#endif
392 END IF
393 END IF
394#else
395 ! only gfortran < 13
396 IF (lhs_initialized) THEN
397#endif
398 IF (.NOT.(this.match.ma)) THEN
399#ifdef DEBUG
400 print *,"ERROR in marray_base::AssignMArray_0: shape mismatch"
401#endif
402 RETURN
403 END IF
404 IF (SIZE(this%data1d).NE.SIZE(ma%data1d)) THEN
405#ifdef DEBUG
406 print *,"ERROR in marray_base::AssignMArray_0: size mismatch"
407#endif
408 RETURN
409 END IF
410 ! copy data
411 this%data1d(:) = ma%data1d(:)
412#ifdef __GFORTRAN__
413#if __GNUC__ < 13
414 ELSE
415 ! pointer assignment: only gfortran < 13
416 this%data1d => ma%data1d
417 END IF
418#else
419 ! only gfortran >= 13
420 IF (.NOT.lhs_initialized) THEN
421 ! destroy LHS explicitely if LHS was not initialized and ma is of derived class
422 SELECT TYPE(ma)
423 TYPE IS(marray_base) ! do nothing
424 CLASS DEFAULT
425 CALL ma%Destroy()
426 END SELECT
427 END IF
428#endif
429#endif __GFORTRAN__
430 IF (.NOT.this%AssignPointers()) THEN
431#ifdef DEBUG
432 print *,"ERROR in marray_base::AssignMArray_0: pointer reassignment failed"
433#endif
434 RETURN
435 END IF
436 END SUBROUTINE assignmarray_0
437
439#ifndef DEBUG
440 PURE &
441#endif
442 SUBROUTINE assignmarray_1(this,a)
443 IMPLICIT NONE
444 !------------------------------------------------------------------------!
445 CLASS(marray_base),INTENT(INOUT) :: this
446 REAL, DIMENSION(:), INTENT(IN) :: a
447 !------------------------------------------------------------------------!
448#if DEBUG > 2
449 print *,"DEBUG INFO in marray_base::AssignMArray_1: assigning 1D Fortran array"
450#endif
451#ifdef DEBUG
452 IF (SIZE(this%data1d).NE.SIZE(a)) THEN
453 print *,"ERROR in marray_base::AssignMArray_1: size mismatch ",SIZE(this%data1d)," != ",SIZE(a)
454 stop 1
455 END IF
456#endif
457 this%data1d(:) = a(:)
458 END SUBROUTINE assignmarray_1
459
461#ifndef DEBUG
462 PURE &
463#endif
464 SUBROUTINE assignmarray_2(this,a)
465 IMPLICIT NONE
466 !------------------------------------------------------------------------!
467 CLASS(marray_base),INTENT(INOUT) :: this
468 REAL, DIMENSION(:,:), INTENT(IN) :: a
469 !------------------------------------------------------------------------!
470#if DEBUG > 2
471 print *,"DEBUG INFO in marray_base::AssignMArray_2: assigning 2D Fortran array"
472#endif
473#ifdef DEBUG
474 IF (.NOT.all(shape(this%data2d).EQ.shape(a))) THEN
475 print *,"ERROR in marray_base::AssignMArray_2: shape mismatch"
476 stop 1
477 END IF
478#endif
479 this%data2d(:,:) = a(:,:)
480 END SUBROUTINE assignmarray_2
481
483#ifndef DEBUG
484 PURE &
485#endif
486 SUBROUTINE assignmarray_3(this,a)
487 IMPLICIT NONE
488 !------------------------------------------------------------------------!
489 CLASS(marray_base),INTENT(INOUT) :: this
490 REAL, DIMENSION(:,:,:), INTENT(IN) :: a
491 !------------------------------------------------------------------------!
492#if DEBUG > 2
493 print *,"DEBUG INFO in marray_base::AssignMArray_3: assigning 3D Fortran array"
494#endif
495#ifdef DEBUG
496 IF (.NOT.all(shape(this%data3d).EQ.shape(a))) THEN
497 print *,"ERROR in marray_base::AssignMArray_3: shape mismatch"
498 stop 1
499 END IF
500#endif
501 this%data3d(:,:,:) = a(:,:,:)
502 END SUBROUTINE assignmarray_3
503
505#ifndef DEBUG
506 PURE &
507#endif
508 SUBROUTINE assignmarray_4(this,a)
509 IMPLICIT NONE
510 !------------------------------------------------------------------------!
511 CLASS(marray_base),INTENT(INOUT) :: this
512 REAL, DIMENSION(:,:,:,:), INTENT(IN) :: a
513 !------------------------------------------------------------------------!
514#if DEBUG > 2
515 print *,"DEBUG INFO in marray_base::AssignMArray_4: assigning 4D Fortran array"
516#endif
517#ifdef DEBUG
518 IF (.NOT.all(shape(this%data4d).EQ.shape(a))) THEN
519 print *,"ERROR in marray_base::AssignMArray_4: shape mismatch"
520 stop 1
521 END IF
522#endif
523 this%data4d(:,:,:,:) = a(:,:,:,:)
524 END SUBROUTINE assignmarray_4
525
527#ifndef DEBUG
528 PURE &
529#endif
530 SUBROUTINE assignmarray_5(this,a)
531 IMPLICIT NONE
532 !------------------------------------------------------------------------!
533 CLASS(marray_base),INTENT(INOUT) :: this
534 REAL, DIMENSION(:,:,:,:,:), INTENT(IN) :: a
535 !------------------------------------------------------------------------!
536#if DEBUG > 2
537 print *,"DEBUG INFO in marray_base::AssignMArray_5: assigning 5D Fortran array"
538#endif
539#ifdef DEBUG
540 IF (.NOT.all(shape(this%data5d).EQ.shape(a))) THEN
541 print *,"ERROR in marray_base::AssignMArray_5: shape mismatch"
542 stop 1
543 END IF
544#endif
545 this%data5d(:,:,:,:,:) = a(:,:,:,:,:)
546 END SUBROUTINE assignmarray_5
547
548 PURE FUNCTION shapesmatch(this,that) RESULT(res)
549 IMPLICIT NONE
550 !------------------------------------------------------------------------!
551 CLASS(marray_base),INTENT(IN) :: this, that
552 !------------------------------------------------------------------------!
553 LOGICAL :: res
554 !------------------------------------------------------------------------!
555 res = (this%rank.EQ.that%rank).AND.all(this%dims(:).EQ.that%dims(:))
556 END FUNCTION shapesmatch
557
559#ifndef DEBUG
560 PURE &
561#endif
562 FUNCTION addmarray_0(this,that) RESULT(data1d)
563 IMPLICIT NONE
564 !------------------------------------------------------------------------!
565 CLASS(marray_base),INTENT(IN) :: this,that
566 REAL, DIMENSION(SIZE(this%data1d)) :: data1d
567 !------------------------------------------------------------------------!
568#if DEBUG > 2
569 print *,"DEBUG INFO in marray_base::AddMArray_0: adding 2 marrays"
570#endif
571#ifdef DEBUG
572 IF (.NOT.ASSOCIATED(this%data1d)) THEN
573 print *,"ERROR in marray_base::AddMArray_0: 1nd argument not initialized"
574 stop 1
575 END IF
576 IF (.NOT.ASSOCIATED(that%data1d)) THEN
577 print *,"ERROR in marray_base::AddMArray_0: 2nd argument not initialized"
578 stop 1
579 END IF
580 IF (.NOT.(this.match.that)) THEN
581 print *,"ERROR in marray_base::AddMArray_0: shape mismatch"
582 stop 1
583 END IF
584#endif
585 data1d(:) = this%data1d(:) + that%data1d(:)
586 END FUNCTION addmarray_0
587
589#ifndef DEBUG
590 PURE &
591#endif
592 FUNCTION addmarray_1(this,a) RESULT(b)
593 IMPLICIT NONE
594 !------------------------------------------------------------------------!
595 CLASS(marray_base),INTENT(IN) :: this
596 REAL, DIMENSION(:),INTENT(IN) :: a
597 REAL, DIMENSION(SIZE(this%data1d)) :: b
598 !------------------------------------------------------------------------!
599#if DEBUG > 2
600 print *,"DEBUG INFO in marray_base::AddMArray_1: adding marray to 1d Fortran array"
601#endif
602#ifdef DEBUG
603 IF (SIZE(this%data1d).NE.SIZE(a)) THEN
604 print *,"ERROR in marray_base::AddMArray_1: size mismatch"
605 stop 1
606 END IF
607#endif
608 b(:) = this%data1d(:) + a(:)
609 END FUNCTION addmarray_1
610
612#ifndef DEBUG
613 PURE &
614#endif
615 FUNCTION addmarray_2(this,a) RESULT(b)
616 IMPLICIT NONE
617 !------------------------------------------------------------------------!
618 CLASS(marray_base),INTENT(IN) :: this
619 REAL, DIMENSION(SIZE(this%data2d,1),SIZE(this%data2d,2)),INTENT(IN) :: a
620 REAL, DIMENSION(SIZE(this%data2d,1),SIZE(this%data2d,2)) :: b
621 !------------------------------------------------------------------------!
622#if DEBUG > 2
623 print *,"DEBUG INFO in marray_base::AddMArray_2: adding marray to 2d Fortran array"
624#endif
625#ifdef DEBUG
626 IF (.NOT.all(shape(this%data2d).EQ.shape(a))) THEN
627 print *,"ERROR in marray_base::AddMArray_2: shape mismatch"
628 stop 1
629 END IF
630#endif
631 b(:,:) = this%data2d(:,:) + a(:,:)
632 END FUNCTION addmarray_2
633
635#ifndef DEBUG
636 PURE &
637#endif
638 FUNCTION addmarray_3(this,a) RESULT(b)
639 IMPLICIT NONE
640 !------------------------------------------------------------------------!
641 CLASS(marray_base),INTENT(IN) :: this
642 REAL, DIMENSION(:,:,:), INTENT(IN) :: a
643 REAL, DIMENSION(SIZE(this%data3d,1),SIZE(this%data3d,2),SIZE(this%data3d,3)) :: b
644 !------------------------------------------------------------------------!
645#if DEBUG > 2
646 print *,"DEBUG INFO in marray_base::AddMArray_3: adding marray to 3d Fortran array"
647#endif
648#ifdef DEBUG
649 IF (.NOT.all(shape(this%data3d).EQ.shape(a))) THEN
650 print *,"ERROR in marray_base::AddMArray_3: shape mismatch"
651 stop 1
652 END IF
653#endif
654 b(:,:,:) = this%data3d(:,:,:) + a(:,:,:)
655 END FUNCTION addmarray_3
656
658#ifndef DEBUG
659 PURE &
660#endif
661 FUNCTION addmarray_4(this,a) RESULT(b)
662 IMPLICIT NONE
663 !------------------------------------------------------------------------!
664 CLASS(marray_base),INTENT(IN) :: this
665 REAL, DIMENSION(:,:,:,:),INTENT(IN) :: a
666 REAL, DIMENSION(SIZE(this%data4d,1),SIZE(this%data4d,2),SIZE(this%data4d,3), & SIZE(this%data4d,4)) :: b
667 !------------------------------------------------------------------------!
668#if DEBUG > 2
669 print *,"DEBUG INFO in marray_base::AddMArray_4: adding marray to 4d Fortran array"
670#endif
671#ifdef DEBUG
672 IF (.NOT.all(shape(this%data4d).EQ.shape(a))) THEN
673 print *,"ERROR in marray_base::AddMArray_4: shape mismatch"
674 stop 1
675 END IF
676#endif
677 b(:,:,:,:) = this%data4d(:,:,:,:) + a(:,:,:,:)
678 END FUNCTION addmarray_4
679
681#ifndef DEBUG
682 PURE &
683#endif
684 FUNCTION addmarray_5(this,a) RESULT(b)
685 IMPLICIT NONE
686 !------------------------------------------------------------------------!
687 CLASS(marray_base),INTENT(IN) :: this
688 REAL, DIMENSION(:,:,:,:,:),INTENT(IN) :: a
689 REAL, DIMENSION(SIZE(this%data5d,1),SIZE(this%data5d,2),SIZE(this%data5d,3), & SIZE(this%data5d,4),SIZE(this%data5d,5)) :: b
690 !------------------------------------------------------------------------!
691#if DEBUG > 2
692 print *,"DEBUG INFO in marray_base::AddMArray_5: adding marray to 5d Fortran array"
693#endif
694#ifdef DEBUG
695 IF (.NOT.all(shape(this%data5d).EQ.shape(a))) THEN
696 print *,"ERROR in marray_base::AddMArray_5: shape mismatch"
697 stop 1
698 END IF
699#endif
700 b(:,:,:,:,:) = this%data5d(:,:,:,:,:) + a(:,:,:,:,:)
701 END FUNCTION addmarray_5
702
704#ifndef DEBUG
705 PURE &
706#endif
707 FUNCTION multmarray_0(this,that) RESULT(data1d)
708 IMPLICIT NONE
709 !------------------------------------------------------------------------!
710 CLASS(marray_base),INTENT(IN) :: this
711 CLASS(marray_base), INTENT(IN) :: that
712 REAL, DIMENSION(SIZE(this%data1d)) :: data1d
713 !------------------------------------------------------------------------!
714#if DEBUG > 2
715 print *,"DEBUG INFO in marray_base::MultMArray_0: multiply 2 marrays"
716#endif
717#ifdef DEBUG
718 IF (.NOT.ASSOCIATED(this%data1d)) THEN
719 print *,"ERROR in marray_base::MultMArray_0: 1nd argument not initialized"
720 END IF
721 IF (.NOT.ASSOCIATED(that%data1d)) THEN
722 print *,"ERROR in marray_base::MultMArray_0: 2nd argument not initialized"
723 END IF
724 IF (.NOT.(this.match.that)) THEN
725 print *,"ERROR in marray_base::MultMArray_0: shape mismatch"
726 END IF
727#endif
728 data1d(:) = this%data1d(:) * that%data1d(:)
729 END FUNCTION multmarray_0
730
732#ifndef DEBUG
733 PURE &
734#endif
735 FUNCTION multmarray_1(this,a) RESULT(b)
736 IMPLICIT NONE
737 !------------------------------------------------------------------------!
738 CLASS(marray_base),INTENT(IN) :: this
739 REAL, DIMENSION(:),INTENT(IN) :: a
740 REAL, DIMENSION(SIZE(this%data1d)) :: b
741 !------------------------------------------------------------------------!
742#if DEBUG > 2
743 print *,"DEBUG INFO in marray_base::MultMArray_1: multiply marray with 1d Fortran array"
744#endif
745#ifdef DEBUG
746 IF (SIZE(this%data1d).NE.SIZE(a)) THEN
747 print *,"ERROR in marray_base::MultMArray_1: size mismatch"
748 stop 1
749 END IF
750#endif
751 b(:) = this%data1d(:) * a(:)
752 END FUNCTION multmarray_1
753
755#ifndef DEBUG
756 PURE &
757#endif
758 FUNCTION multmarray_2(this,a) RESULT(b)
759 IMPLICIT NONE
760 !------------------------------------------------------------------------!
761 CLASS(marray_base),INTENT(IN) :: this
762 REAL, DIMENSION(:,:),INTENT(IN) :: a
763 REAL, DIMENSION(SIZE(this%data2d,1),SIZE(this%data2d,2)) :: b
764 !------------------------------------------------------------------------!
765#if DEBUG > 2
766 print *,"DEBUG INFO in marray_base::MultMArray_2: multiply marray with 2d Fortran array"
767#endif
768#ifdef DEBUG
769 IF (.NOT.all(shape(this%data2d).EQ.shape(a))) THEN
770 print *,"ERROR in marray_base::MultMArray_2: shape mismatch"
771 stop 1
772 END IF
773#endif
774 b(:,:) = this%data2d(:,:) * a(:,:)
775 END FUNCTION multmarray_2
776
778#ifndef DEBUG
779 PURE &
780#endif
781 FUNCTION multmarray_3(this,a) RESULT(b)
782 IMPLICIT NONE
783 !------------------------------------------------------------------------!
784 CLASS(marray_base),INTENT(IN) :: this
785 REAL, DIMENSION(:,:,:),INTENT(IN) :: a
786 REAL, DIMENSION(SIZE(this%data3d,1),SIZE(this%data3d,2),SIZE(this%data3d,3)) :: b
787 !------------------------------------------------------------------------!
788#if DEBUG > 2
789 print *,"DEBUG INFO in marray_base::MultMArray_3: multiply marray with 3d Fortran array"
790#endif
791#ifdef DEBUG
792 IF (.NOT.all(shape(this%data3d).EQ.shape(a))) THEN
793 print *,"ERROR in marray_base::MultMArray_3: shape mismatch"
794 stop 1
795 END IF
796#endif
797 b(:,:,:) = this%data3d(:,:,:) * a(:,:,:)
798 END FUNCTION multmarray_3
799
801#ifndef DEBUG
802 PURE &
803#endif
804 FUNCTION multmarray_4(this,a) RESULT(b)
805 IMPLICIT NONE
806 !------------------------------------------------------------------------!
807 CLASS(marray_base),INTENT(IN) :: this
808 REAL, DIMENSION(:,:,:,:),INTENT(IN) :: a
809 REAL, DIMENSION(SIZE(this%data4d,1),SIZE(this%data4d,2),SIZE(this%data4d,3), & SIZE(this%data4d,4)) :: b
810 !------------------------------------------------------------------------!
811#if DEBUG > 2
812 print *,"DEBUG INFO in marray_base::MultMArray_4: multiply marray with 4d Fortran array"
813#endif
814#ifdef DEBUG
815 IF (.NOT.all(shape(this%data4d).EQ.shape(a))) THEN
816 print *,"ERROR in marray_base::MultMArray_4: shape mismatch"
817 stop 1
818 END IF
819#endif
820 b(:,:,:,:) = this%data4d(:,:,:,:) * a(:,:,:,:)
821 END FUNCTION multmarray_4
822
824#ifndef DEBUG
825 PURE &
826#endif
827 FUNCTION multmarray_5(this,a) RESULT(b)
828 IMPLICIT NONE
829 !------------------------------------------------------------------------!
830 CLASS(marray_base),INTENT(IN) :: this
831 REAL, DIMENSION(:,:,:,:,:),INTENT(IN) :: a
832 REAL, DIMENSION(SIZE(this%data5d,1),SIZE(this%data5d,2),SIZE(this%data5d,3), & SIZE(this%data5d,4),SIZE(this%data5d,5)) :: b
833 !------------------------------------------------------------------------!
834#if DEBUG > 2
835 print *,"DEBUG INFO in marray_base::MultMArray_5: multiply marray with 5d Fortran array"
836#endif
837#ifdef DEBUG
838 IF (.NOT.all(shape(this%data5d).EQ.shape(a))) THEN
839 print *,"ERROR in marray_base::MultMArray_5: shape mismatch"
840 stop 1
841 END IF
842#endif
843 b(:,:,:,:,:) = this%data5d(:,:,:,:,:) * a(:,:,:,:,:)
844 END FUNCTION multmarray_5
845
848#ifndef DEBUG
849 PURE &
850#endif
851 FUNCTION crossproduct_0(this,that) RESULT(data2d)
852 !------------------------------------------------------------------------!
853 CLASS(marray_base),INTENT(IN) :: this
854 CLASS(marray_base), INTENT(IN) :: that
855 REAL, DIMENSION(SIZE(this%data2d,DIM=1),3) :: data2d
856 !------------------------------------------------------------------------!
857#if DEBUG > 2
858 print *,"DEBUG INFO in marray_base::CrossProduct_0: compute cross product of two 3D vector like marrays"
859#endif
860#ifdef DEBUG
861 IF (.NOT.ASSOCIATED(this%data1d)) THEN
862 print *,"ERROR in marray_base::CrossProduct_0: 1nd argument not initialized"
863 END IF
864 IF (.NOT.ASSOCIATED(that%data1d)) THEN
865 print *,"ERROR in marray_base::CrossProduct_0: 2nd argument not initialized"
866 END IF
867#endif
868 IF (.NOT.(this.match.that)) THEN
869#ifdef DEBUG
870 print *,"ERROR in marray_base::CrossProduct_0: shape mismatch"
871#endif
872 RETURN
873 END IF
874 IF (this%DIMS(this%RANK).NE.3) THEN
875#ifdef DEBUG
876 print *,"ERROR in marray_base::CrossProduct_0: not a 3D vector"
877#endif
878 RETURN
879 END IF
880 data2d(:,1) = axb1(this%data2d(:,2),this%data2d(:,3),that%data2d(:,2),that%data2d(:,3))
881 data2d(:,2) = axb1(this%data2d(:,3),this%data2d(:,1),that%data2d(:,3),that%data2d(:,1))
882 data2d(:,3) = axb1(this%data2d(:,1),this%data2d(:,2),that%data2d(:,1),that%data2d(:,2))
883
884 CONTAINS
885 ELEMENTAL FUNCTION axb1(a2,a3,b2,b3)
886 IMPLICIT NONE
887 !------------------------------------------------------------------------!
888 REAL, INTENT(IN) :: a2,a3,b2,b3
889 REAL :: axb1
890 !------------------------------------------------------------------------!
891 axb1 = a2*b3 - a3*b2
892 END FUNCTION axb1
893 END FUNCTION crossproduct_0
894
897 SUBROUTINE destroy(this,called_from_finalize)
898 IMPLICIT NONE
899 !-------------------------------------------------------------------!
900 CLASS(marray_base) :: this
901 LOGICAL, OPTIONAL :: called_from_finalize
902 !-------------------------------------------------------------------!
903#if DEBUG > 2
904 WRITE(*,'(A)',advance='NO') " DEBUG INFO in marray_base::Destroy called"
905 IF (PRESENT(called_from_finalize)) THEN
906 IF (called_from_finalize) WRITE(*,'(A)') " from Finalize"
907 END IF
908#endif
909 IF (ASSOCIATED(this%data1d)) THEN
910#if DEBUG > 2
911 print *,"DEBUG INFO in marray_base::Destroy: deallocating data1d, size=",SIZE(this%data1d)
912#endif
913 DEALLOCATE(this%data1d)
914 END IF
915 NULLIFY(this%data1d,this%data2d,this%data3d,this%data4d,this%data5d)
916 this%rank =-1
917 this%dims(:) = 0
918 END SUBROUTINE destroy
919
920 SUBROUTINE finalize(this)
921 IMPLICIT NONE
922 !-------------------------------------------------------------------!
923 TYPE(marray_base) :: this
924 !-------------------------------------------------------------------!
925#if DEBUG > 2
926 print *,"DEBUG INFO in marray_base::Finalize called"
927#endif
928 CALL this%Destroy(.true.)
929 END SUBROUTINE finalize
930
931 FUNCTION createselection(idx) RESULT(new_sel)
932 IMPLICIT NONE
933 !-------------------------------------------------------------------!
934 TYPE(selection_base) :: new_sel
935 INTEGER, OPTIONAL :: idx(6)
936 !-------------------------------------------------------------------!
937 INTEGER :: err
938 !-------------------------------------------------------------------!
939 IF (new_sel%Init(idx)) return ! immediately return if successful
940#ifdef DEBUG
941 print *,"ERROR in selection_base::CreateSelection: initialization failed"
942 stop 1
943#endif
944 END FUNCTION createselection
945
947 FUNCTION init_selection(this,idx) RESULT(success)
948 !-------------------------------------------------------------------!
949 CLASS(selection_base), INTENT(INOUT) :: this
950 INTEGER, OPTIONAL :: idx(6)
951 !-------------------------------------------------------------------!
952 LOGICAL :: success
953 INTEGER :: err
954 !-------------------------------------------------------------------!
955#if DEBUG > 2
956 print *,"DEBUG INFO in marray_base::Init_selection: selection initialization"
957#endif
958 success = .false.
959 IF (.NOT.idx_init) return ! with success == .false.
960 ! allocate 1D mask array
961 ALLOCATE(this%mask1d(1:inum*jnum*knum),stat=err)
962 IF (err.NE.0) THEN
963#ifdef DEBUG
964 print *,"ERROR in marray_base::Init_selection: memory allocation failed"
965#endif
966 return ! with success == .false.
967 END IF
968 ! set 2D & 3D pointers
969 this%mask2d(1:inum*jnum,kgmin:kgmax) => this%mask1d
970 this%mask3d(igmin:igmax,jgmin:jgmax,kgmin:kgmax) => this%mask1d
971 IF (PRESENT(idx)) THEN
972 CALL this%Cuboid(idx(1),idx(2),idx(3),idx(4),idx(5),idx(6))
973 ELSE
974 CALL this%Everything()
975 END IF
976 ! report success
977 success=.true.
978 END FUNCTION init_selection
979
981 SUBROUTINE assignselection(this,sel)
982 IMPLICIT NONE
983 !------------------------------------------------------------------------!
984 CLASS(selection_base),INTENT(INOUT) :: this
985 CLASS(selection_base),INTENT(IN) :: sel
986 !------------------------------------------------------------------------!
987#if DEBUG > 2
988 print *,"DEBUG INFO in marray_base::AssignSelection: selection assignment"
989#endif
990 IF (.NOT.ASSOCIATED(sel%mask1d)) THEN
991#ifdef DEBUG
992 print *,"ERROR in marray_base::AssignSelection: rhs of assignment not initialized"
993#endif
994 return
995 END IF
996
997 IF (.NOT.ASSOCIATED(this%mask1d)) THEN
998 ! lhs of assignment uninitialized -> initialize new selection
999 ! ATTENTION: finalization of derived types works different for
1000 ! GNU Fortran, hence to prevent memory leaks, one has to point
1001 ! the mask1d array of the lhs (this%mask1d) to the already associated
1002 ! mask1d array of the rhs (ma%mask1d).
1003 ! Other compilers, e.g., ifort (intel) & nfort (NEC) require generation
1004 ! of a new selection with mask1d array which is destroyed on exit.
1005#if defined(__GFORTRAN__) && __GNUC__ < 13
1006 this%imin = sel%imin
1007 this%imax = sel%imax
1008 this%jmin = sel%jmin
1009 this%jmax = sel%jmax
1010 this%kmin = sel%kmin
1011 this%kmax = sel%kmax
1012 this%mask1d => sel%mask1d
1013 ! set 2D & 3D pointers
1014 this%mask2d(1:inum*jnum,kgmin:kgmax) => this%mask1d
1015 this%mask3d(igmin:igmax,jgmin:jgmax,kgmin:kgmax) => this%mask1d
1016 ! immediately return
1017 return
1018#else
1019 IF (.NOT.this%Init((/sel%imin,sel%imax,sel%jmin,sel%jmax,sel%kmin,sel%kmax/))) THEN
1020#ifdef DEBUG
1021 print *,"ERROR in marray_base::AssignSelection: initialization failed"
1022#endif
1023 return
1024 END IF
1025#endif
1026 ELSE
1027 this%imin = sel%imin
1028 this%imax = sel%imax
1029 this%jmin = sel%jmin
1030 this%jmax = sel%jmax
1031 this%kmin = sel%kmin
1032 this%kmax = sel%kmax
1033 END IF
1034 IF (.NOT.SIZE(this%mask1d).EQ.SIZE(sel%mask1d)) THEN
1035#ifdef DEBUG
1036 print *,"ERROR in marray_base::AssignSelection: size mismatch"
1037#endif
1038 return
1039 END IF
1040 ! copy data
1041 this%mask1d(:) = sel%mask1d(:)
1042 END SUBROUTINE assignselection
1043
1044 SUBROUTINE cuboid(this,imin,imax,jmin,jmax,kmin,kmax)
1045 IMPLICIT NONE
1046 !-------------------------------------------------------------------!
1047 CLASS(selection_base) :: this
1048 INTEGER, INTENT(IN) :: imin,imax,jmin,jmax,kmin,kmax
1049 !-------------------------------------------------------------------!
1050 INTEGER :: i,j,k
1051 !-------------------------------------------------------------------!
1052 this%imin = min(max(imin,igmin),igmax)
1053 this%imax = max(min(imax,igmax),igmin)
1054 this%jmin = min(max(jmin,jgmin),jgmax)
1055 this%jmax = max(min(jmax,jgmax),jgmin)
1056 this%kmin = min(max(kmin,kgmin),kgmax)
1057 this%kmax = max(min(kmax,kgmax),kgmin)
1058 DO k=kgmin,kgmax
1059 DO j=jgmin,jgmax
1060 DO i=igmin,igmax
1061 IF ((i.GE.this%imin.AND.i.LE.this%imax).AND. &
1062 (j.GE.this%jmin.AND.j.LE.this%jmax).AND. &
1063 (k.GE.this%kmin.AND.k.LE.this%kmax)) THEN
1064 this%mask3d(i,j,k) = .true.
1065 ELSE
1066 this%mask3d(i,j,k) = .false.
1067 END IF
1068 END DO
1069 END DO
1070 END DO
1071 END SUBROUTINE cuboid
1072
1073 SUBROUTINE everything(this)
1074 IMPLICIT NONE
1075 !-------------------------------------------------------------------!
1076 CLASS(selection_base) :: this
1077 !-------------------------------------------------------------------!
1078 this%imin = igmin
1079 this%imax = igmax
1080 this%jmin = jgmin
1081 this%jmax = jgmax
1082 this%kmin = kgmin
1083 this%imax = kgmax
1084 this%mask1d(:) = .true.
1085 END SUBROUTINE everything
1086
1088 SUBROUTINE destroy_selection(this)
1089 IMPLICIT NONE
1090 !-------------------------------------------------------------------!
1091 CLASS(selection_base) :: this
1092 !-------------------------------------------------------------------!
1093 IF (ASSOCIATED(this%mask1d)) DEALLOCATE(this%mask1d)
1094 NULLIFY(this%mask2d,this%mask3d)
1095 END SUBROUTINE destroy_selection
1096
1098 SUBROUTINE destructor_selection(this)
1099 IMPLICIT NONE
1100 !-------------------------------------------------------------------!
1101 TYPE(selection_base) :: this
1102 !-------------------------------------------------------------------!
1103 CALL this%Destroy_selection()
1104 END SUBROUTINE destructor_selection
1105
1106END MODULE marray_base_mod
1107
elemental real function axb1(a2, a3, b2, b3)
base class for mesh arrays
Definition: marray_base.f90:36
type(selection_base) function createselection(idx)
subroutine destructor_selection(this)
actual destructor of selection_base
subroutine assignmarray_3(this, a)
assign 3D fortran array to mesh array
subroutine cuboid(this, imin, imax, jmin, jmax, kmin, kmax)
real function, dimension(size(this%data2d, 1), size(this%data2d, 2)) addmarray_2(this, a)
add 2D fortran array and mesh array
type(marray_base) function createmarray(m, n)
constructor for mesh arrays
real function, dimension(size(this%data1d)) multmarray_1(this, a)
multiply 1D fortran array and mesh arrays
subroutine, public closemeshproperties
unsets global mesh properties
real function, dimension(size(this%data4d, 1), size(this%data4d, 2), size(this%data4d, 3), size(this%data4d, 4)) addmarray_4(this, a)
add 4D fortran array and mesh array
subroutine assignmarray_5(this, a)
assign 5D fortran array to mesh array
logical function assignpointers(this)
assign pointers of different shapes to the 1D data
real function, dimension(size(this%data1d)) addmarray_0(this, that)
add 2 mesh arrays
integer, save igmin
Definition: marray_base.f90:42
integer, save knum
array sizes
Definition: marray_base.f90:45
logical, save idx_init
init status
Definition: marray_base.f90:46
real function, dimension(:,:,:,:), pointer remapbounds_1(this, array)
remap lower bounds in the first 3 dimensions of rank 1 mesh arrays
subroutine assignselection(this, sel)
assigns one selection to another selection
real function, dimension(:,:,:), pointer remapbounds_0(this, array)
remap lower bounds in the first 3 dimensions of rank 0 mesh arrays
subroutine, public initmeshproperties(igmin_, igmax_, jgmin_, jgmax_, kgmin_, kgmax_)
sets global mesh properties
real function, dimension(size(this%data5d, 1), size(this%data5d, 2), size(this%data5d, 3), size(this%data5d, 4), size(this%data5d, 5)) addmarray_5(this, a)
add 5D fortran array and mesh array
integer, save inum
Definition: marray_base.f90:45
real function, dimension(size(this%data1d)) addmarray_1(this, a)
add 1D fortran array and mesh array
integer, save jnum
Definition: marray_base.f90:45
real function, dimension(size(this%data2d, 1), size(this%data2d, 2)) multmarray_2(this, a)
multiply 2D fortran array and mesh arrays
subroutine assignmarray_4(this, a)
assign 4D fortran array to mesh array
real function, dimension(size(this%data3d, 1), size(this%data3d, 2), size(this%data3d, 3)) addmarray_3(this, a)
add 3D fortran array and mesh array
integer, save igmax
1st dim
Definition: marray_base.f90:42
real function, dimension(size(this%data4d, 1), size(this%data4d, 2), size(this%data4d, 3), size(this%data4d, 4)) multmarray_4(this, a)
multiply 4D fortran array and mesh arrays
real function, dimension(size(this%data1d)) multmarray_0(this, that)
multiply 2 mesh arrays
logical function init(this, m, n)
basic initialization of mesh array class
subroutine finalize(this)
real function, dimension(size(this%data5d, 1), size(this%data5d, 2), size(this%data5d, 3), size(this%data5d, 4), size(this%data5d, 5)) multmarray_5(this, a)
multiply 5D fortran array and mesh arrays
integer, save kgmin
Definition: marray_base.f90:44
real function, dimension(size(this%data3d, 1), size(this%data3d, 2), size(this%data3d, 3)) multmarray_3(this, a)
multiply 3D fortran array and mesh arrays
integer, save jgmax
2nd dim
Definition: marray_base.f90:43
subroutine destroy_selection(this)
destructor of all selection classes
subroutine everything(this)
real function, dimension(:,:,:,:,:), pointer remapbounds_2(this, array)
remap lower bounds in the first 3 dimensions of rank 2 mesh arrays
logical function init_selection(this, idx)
basic initialization of selection
pure logical function shapesmatch(this, that)
integer, save kgmax
3rd dim
Definition: marray_base.f90:44
subroutine assignmarray_2(this, a)
assign 2D fortran array to mesh array
subroutine assignmarray_0(this, ma)
assigns one mesh array to another mesh array
integer, save jgmin
Definition: marray_base.f90:43
subroutine destroy(this, called_from_finalize)
basic destructor of mesh arrays - this is called automatically if deallocate is invoked
real function, dimension(size(this%data2d, dim=1), 3) crossproduct_0(this, that)
compute outer (vector) product of 2 marrays works only, if last dimension has size 3!
subroutine assignmarray_1(this, a)
assign 1D fortran array to mesh array
basic mesh array class
Definition: marray_base.f90:69
type for selecting parts of an marray
Definition: marray_base.f90:48