portedportable, not yet portedexecuted, not portableexecutable, not hit by this run
| 1 | ! This file is part of MOM6, the Modular Ocean Model version 6. | |
| 2 | ! See the LICENSE file for licensing information. | |
| 3 | ! SPDX-License-Identifier: Apache-2.0 | |
| 4 | ||
| 5 | !> Convenience functions for safely allocating memory without | |
| 6 | !! accidentally reallocating pointer and causing memory leaks. | |
| 7 | module MOM_safe_alloc | |
| 8 | ||
| 9 | implicit none ; private | |
| 10 | ||
| 11 | public safe_alloc_ptr, safe_alloc_alloc | |
| 12 | ||
| 13 | !> Allocate a pointer to a 1-d, 2-d or 3-d array | |
| 14 | interface safe_alloc_ptr | |
| 15 | module procedure safe_alloc_ptr_3d_3arg, safe_alloc_ptr_3d_6arg, safe_alloc_ptr_2d_2arg | |
| 16 | module procedure safe_alloc_ptr_3d, safe_alloc_ptr_2d, safe_alloc_ptr_1d | |
| 17 | end interface safe_alloc_ptr | |
| 18 | ||
| 19 | !> Allocate a 2-d or 3-d allocatable array | |
| 20 | interface safe_alloc_alloc | |
| 21 | module procedure safe_alloc_allocatable_3d, safe_alloc_allocatable_2d | |
| 22 | module procedure safe_alloc_allocatable_3d_6arg | |
| 23 | end interface safe_alloc_alloc | |
| 24 | ||
| 25 | ! This combined interface might work with a later version of Fortran, but | |
| 26 | ! it fails with the gnu F90 compiler. | |
| 27 | ! | |
| 28 | ! interface safe_alloc | |
| 29 | ! module procedure safe_alloc_ptr_3d_2arg, safe_alloc_ptr_2d_2arg | |
| 30 | ! module procedure safe_alloc_ptr_3d, safe_alloc_ptr_2d, safe_alloc_ptr_1d | |
| 31 | ! module procedure safe_alloc_allocatable_3d, safe_alloc_allocatable_2d | |
| 32 | ! end interface safe_alloc | |
| 33 | ||
| 34 | contains | |
| 35 | ||
| 36 | !> Allocate a pointer to a 1-d array | |
| 37 | 0 | subroutine safe_alloc_ptr_1d(ptr, i1, i2) |
| 38 | real, dimension(:), pointer :: ptr !< A pointer to allocate | |
| 39 | integer, intent(in) :: i1 !< The size of the array, or its starting index if i2 is present | |
| 40 | integer, optional, intent(in) :: i2 !< The ending index of the array | |
| 41 | 0 | if (.not.associated(ptr)) then |
| 42 | 0 | if (present(i2)) then |
| 43 | 0 | allocate(ptr(i1:i2), source=0.0) |
| 44 | else | |
| 45 | 0 | allocate(ptr(i1), source=0.0) |
| 46 | endif | |
| 47 | endif | |
| 48 | 0 | end subroutine safe_alloc_ptr_1d |
| 49 | ||
| 50 | !> Allocate a pointer to a 2-d array based on its dimension sizes | |
| 51 | 0 | subroutine safe_alloc_ptr_2d_2arg(ptr, ni, nj) |
| 52 | real, dimension(:,:), pointer :: ptr !< A pointer to allocate | |
| 53 | integer, intent(in) :: ni !< The size of the 1st dimension of the array | |
| 54 | integer, intent(in) :: nj !< The size of the 2nd dimension of the array | |
| 55 | 0 | if (.not.associated(ptr)) then |
| 56 | 0 | allocate(ptr(ni,nj), source=0.0) |
| 57 | endif | |
| 58 | 0 | end subroutine safe_alloc_ptr_2d_2arg |
| 59 | ||
| 60 | !> Allocate a pointer to a 3-d array based on its dimension sizes | |
| 61 | 0 | subroutine safe_alloc_ptr_3d_3arg(ptr, ni, nj, nk) |
| 62 | real, dimension(:,:,:), pointer :: ptr !< A pointer to allocate | |
| 63 | integer, intent(in) :: ni !< The size of the 1st dimension of the array | |
| 64 | integer, intent(in) :: nj !< The size of the 2nd dimension of the array | |
| 65 | integer, intent(in) :: nk !< The size of the 3rd dimension of the array | |
| 66 | 0 | if (.not.associated(ptr)) then |
| 67 | 0 | allocate(ptr(ni,nj,nk), source=0.0) |
| 68 | endif | |
| 69 | 0 | end subroutine safe_alloc_ptr_3d_3arg |
| 70 | ||
| 71 | !> Allocate a pointer to a 2-d array based on its index starting and ending values | |
| 72 | 6 | subroutine safe_alloc_ptr_2d(ptr, is, ie, js, je) |
| 73 | real, dimension(:,:), pointer :: ptr !< A pointer to allocate | |
| 74 | integer, intent(in) :: is !< The start index to allocate for the 1st dimension | |
| 75 | integer, intent(in) :: ie !< The end index to allocate for the 1st dimension | |
| 76 | integer, intent(in) :: js !< The start index to allocate for the 2nd dimension | |
| 77 | integer, intent(in) :: je !< The end index to allocate for the 2nd dimension | |
| 78 | 6 | if (.not.associated(ptr)) then |
| 79 | 52638 | allocate(ptr(is:ie,js:je), source=0.0) |
| 80 | endif | |
| 81 | 6 | end subroutine safe_alloc_ptr_2d |
| 82 | ||
| 83 | !> Allocate a pointer to a 3-d array based on its index starting and ending values | |
| 84 | 4 | subroutine safe_alloc_ptr_3d(ptr, is, ie, js, je, nk) |
| 85 | real, dimension(:,:,:), pointer :: ptr !< A pointer to allocate | |
| 86 | integer, intent(in) :: is !< The start index to allocate for the 1st dimension | |
| 87 | integer, intent(in) :: ie !< The end index to allocate for the 1st dimension | |
| 88 | integer, intent(in) :: js !< The start index to allocate for the 2nd dimension | |
| 89 | integer, intent(in) :: je !< The end index to allocate for the 2nd dimension | |
| 90 | integer, intent(in) :: nk !< The size to allocate for the 3rd dimension | |
| 91 | 4 | if (.not.associated(ptr)) then |
| 92 | 2697092 | allocate(ptr(is:ie,js:je,nk), source=0.0) |
| 93 | endif | |
| 94 | 4 | end subroutine safe_alloc_ptr_3d |
| 95 | ||
| 96 | !> Allocate a pointer to a 3-d array based on its index starting and ending values | |
| 97 | 0 | subroutine safe_alloc_ptr_3d_6arg(ptr, is, ie, js, je, ks, ke) |
| 98 | real, dimension(:,:,:), pointer :: ptr !< A pointer to allocate | |
| 99 | integer, intent(in) :: is !< The start index to allocate for the 1st dimension | |
| 100 | integer, intent(in) :: ie !< The end index to allocate for the 1st dimension | |
| 101 | integer, intent(in) :: js !< The start index to allocate for the 2nd dimension | |
| 102 | integer, intent(in) :: je !< The end index to allocate for the 2nd dimension | |
| 103 | integer, intent(in) :: ks !< The start index to allocate for the 3rd dimension | |
| 104 | integer, intent(in) :: ke !< The end index to allocate for the 3rd dimension | |
| 105 | 0 | if (.not.associated(ptr)) then |
| 106 | 0 | allocate(ptr(is:ie,js:je,ks:ke), source=0.0) |
| 107 | endif | |
| 108 | 0 | end subroutine safe_alloc_ptr_3d_6arg |
| 109 | ||
| 110 | ||
| 111 | !> Allocate a 2-d allocatable array based on its index starting and ending values | |
| 112 | 3 | subroutine safe_alloc_allocatable_2d(ptr, is, ie, js, je) |
| 113 | real, dimension(:,:), allocatable :: ptr !< An allocatable array to allocate | |
| 114 | integer, intent(in) :: is !< The start index to allocate for the 1st dimension | |
| 115 | integer, intent(in) :: ie !< The end index to allocate for the 1st dimension | |
| 116 | integer, intent(in) :: js !< The start index to allocate for the 2nd dimension | |
| 117 | integer, intent(in) :: je !< The end index to allocate for the 2nd dimension | |
| 118 | 3 | if (.not.allocated(ptr)) then |
| 119 | 26319 | allocate(ptr(is:ie,js:je), source=0.0) |
| 120 | endif | |
| 121 | 3 | end subroutine safe_alloc_allocatable_2d |
| 122 | ||
| 123 | !> Allocate a 3-d allocatable array based on its index starting and ending values | |
| 124 | !! and k-index size | |
| 125 | 0 | subroutine safe_alloc_allocatable_3d(ptr, is, ie, js, je, nk) |
| 126 | real, dimension(:,:,:), allocatable :: ptr !< An allocatable array to allocate | |
| 127 | integer, intent(in) :: is !< The start index to allocate for the 1st dimension | |
| 128 | integer, intent(in) :: ie !< The end index to allocate for the 1st dimension | |
| 129 | integer, intent(in) :: js !< The start index to allocate for the 2nd dimension | |
| 130 | integer, intent(in) :: je !< The end index to allocate for the 2nd dimension | |
| 131 | integer, intent(in) :: nk !< The size to allocate for the 3rd dimension | |
| 132 | 0 | if (.not.allocated(ptr)) then |
| 133 | 0 | allocate(ptr(is:ie,js:je,nk), source=0.0) |
| 134 | endif | |
| 135 | 0 | end subroutine safe_alloc_allocatable_3d |
| 136 | ||
| 137 | !> Allocate a 3-d allocatable array based on its 6 index starting and ending values | |
| 138 | 0 | subroutine safe_alloc_allocatable_3d_6arg(ptr, is, ie, js, je, ks, ke) |
| 139 | real, dimension(:,:,:), allocatable :: ptr !< An allocatable array to allocate | |
| 140 | integer, intent(in) :: is !< The start index to allocate for the 1st dimension | |
| 141 | integer, intent(in) :: ie !< The end index to allocate for the 1st dimension | |
| 142 | integer, intent(in) :: js !< The start index to allocate for the 2nd dimension | |
| 143 | integer, intent(in) :: je !< The end index to allocate for the 2nd dimension | |
| 144 | integer, intent(in) :: ks !< The start index to allocate for the 3rd dimension | |
| 145 | integer, intent(in) :: ke !< The end index to allocate for the 3rd dimension | |
| 146 | 0 | if (.not.allocated(ptr)) then |
| 147 | 0 | allocate(ptr(is:ie,js:je,ks:ke), source=0.0) |
| 148 | endif | |
| 149 | 0 | end subroutine safe_alloc_allocatable_3d_6arg |
| 150 | ||
| 151 | end module MOM_safe_alloc |