1module testa_init 2 use definekind 3 interface init_7d 4 module procedure init_7d_i4 5 module procedure init_7d_i8 6 module procedure init_7d_r4 7 module procedure init_7d_r8 8 module procedure init_7d_c4 9 module procedure init_7d_c8 10 end interface 11 12contains 13 14 subroutine init_7d_i4(a,b,alb,aub,blb,bub,aoff,boff) 15 integer(kind=i4), pointer :: a(:,:,:,:,:,:,:) 16 integer(kind=i4), pointer :: b(:,:,:,:,:,:,:) 17 integer alb(7),aub(7),blb(7),bub(7) 18 integer aoff, boff 19 integer i1,i2,i3,k4,i5,i6,i7 20 integer j 21 j = aoff 22 do i7 = alb(7),aub(7) 23 do i6 = alb(6),aub(6) 24 do i5 = alb(5),aub(5) 25 do k4 = alb(4),aub(4) 26 do i3 = alb(3),aub(3) 27 do i2 = alb(2),aub(2) 28 do i1 = alb(1),aub(1) 29 a(i1,i2,i3,k4,i5,i6,i7) = j 30 j = j + 1 31 enddo 32 enddo 33 enddo 34 enddo 35 enddo 36 enddo 37 enddo 38 j = boff 39 do i7 = blb(7),bub(7) 40 do i6 = blb(6),bub(6) 41 do i5 = blb(5),bub(5) 42 do k4 = blb(4),bub(4) 43 do i3 = blb(3),bub(3) 44 do i2 = blb(2),bub(2) 45 do i1 = blb(1),bub(1) 46 b(i1,i2,i3,k4,i5,i6,i7) = j 47 j = j + 1 48 enddo 49 enddo 50 enddo 51 enddo 52 enddo 53 enddo 54 enddo 55 return 56 end subroutine init_7d_i4 57 58 subroutine init_7d_i8(a,b,alb,aub,blb,bub,aoff,boff) 59 integer(kind=i8), pointer :: a(:,:,:,:,:,:,:) 60 integer(kind=i8), pointer :: b(:,:,:,:,:,:,:) 61 integer alb(7),aub(7),blb(7),bub(7) 62 integer aoff, boff 63 integer i1,i2,i3,k4,i5,i6,i7 64 integer(kind=i8) :: j 65 j = aoff 66 do i7 = alb(7),aub(7) 67 do i6 = alb(6),aub(6) 68 do i5 = alb(5),aub(5) 69 do k4 = alb(4),aub(4) 70 do i3 = alb(3),aub(3) 71 do i2 = alb(2),aub(2) 72 do i1 = alb(1),aub(1) 73 a(i1,i2,i3,k4,i5,i6,i7) = j 74 j = j + 1 75 enddo 76 enddo 77 enddo 78 enddo 79 enddo 80 enddo 81 enddo 82 j = boff 83 do i7 = blb(7),bub(7) 84 do i6 = blb(6),bub(6) 85 do i5 = blb(5),bub(5) 86 do k4 = blb(4),bub(4) 87 do i3 = blb(3),bub(3) 88 do i2 = blb(2),bub(2) 89 do i1 = blb(1),bub(1) 90 b(i1,i2,i3,k4,i5,i6,i7) = j 91 j = j + 1 92 enddo 93 enddo 94 enddo 95 enddo 96 enddo 97 enddo 98 enddo 99 return 100 end subroutine init_7d_i8 101 102 subroutine init_7d_r4(a,b,alb,aub,blb,bub,aoff,boff) 103 real(kind=r4), pointer :: a(:,:,:,:,:,:,:) 104 real(kind=r4), pointer :: b(:,:,:,:,:,:,:) 105 integer alb(7),aub(7),blb(7),bub(7) 106 integer aoff, boff 107 integer i1,i2,i3,k4,i5,i6,i7 108 integer(kind=i4) :: j 109 j = aoff 110 do i7 = alb(7),aub(7) 111 do i6 = alb(6),aub(6) 112 do i5 = alb(5),aub(5) 113 do k4 = alb(4),aub(4) 114 do i3 = alb(3),aub(3) 115 do i2 = alb(2),aub(2) 116 do i1 = alb(1),aub(1) 117 a(i1,i2,i3,k4,i5,i6,i7) = float(j) 118 j = j + 1 119 enddo 120 enddo 121 enddo 122 enddo 123 enddo 124 enddo 125 enddo 126 j = boff 127 do i7 = blb(7),bub(7) 128 do i6 = blb(6),bub(6) 129 do i5 = blb(5),bub(5) 130 do k4 = blb(4),bub(4) 131 do i3 = blb(3),bub(3) 132 do i2 = blb(2),bub(2) 133 do i1 = blb(1),bub(1) 134 b(i1,i2,i3,k4,i5,i6,i7) = float(j) 135 j = j + 1 136 enddo 137 enddo 138 enddo 139 enddo 140 enddo 141 enddo 142 enddo 143 return 144 end subroutine init_7d_r4 145 146 subroutine init_7d_r8(a,b,alb,aub,blb,bub,aoff,boff) 147 real(kind=r8), pointer :: a(:,:,:,:,:,:,:) 148 real(kind=r8), pointer :: b(:,:,:,:,:,:,:) 149 integer alb(7),aub(7),blb(7),bub(7) 150 integer aoff, boff 151 integer i1,i2,i3,k4,i5,i6,i7 152 integer(kind=i4) :: j 153 j = aoff 154 do i7 = alb(7),aub(7) 155 do i6 = alb(6),aub(6) 156 do i5 = alb(5),aub(5) 157 do k4 = alb(4),aub(4) 158 do i3 = alb(3),aub(3) 159 do i2 = alb(2),aub(2) 160 do i1 = alb(1),aub(1) 161 a(i1,i2,i3,k4,i5,i6,i7) = dble(j) 162 j = j + 1 163 enddo 164 enddo 165 enddo 166 enddo 167 enddo 168 enddo 169 enddo 170 j = boff 171 do i7 = blb(7),bub(7) 172 do i6 = blb(6),bub(6) 173 do i5 = blb(5),bub(5) 174 do k4 = blb(4),bub(4) 175 do i3 = blb(3),bub(3) 176 do i2 = blb(2),bub(2) 177 do i1 = blb(1),bub(1) 178 b(i1,i2,i3,k4,i5,i6,i7) = dble(j) 179 j = j + 1 180 enddo 181 enddo 182 enddo 183 enddo 184 enddo 185 enddo 186 enddo 187 return 188 end subroutine init_7d_r8 189 190 subroutine init_7d_c4(a,b,alb,aub,blb,bub,aoff,boff) 191 complex(kind=c4), pointer :: a(:,:,:,:,:,:,:) 192 complex(kind=c4), pointer :: b(:,:,:,:,:,:,:) 193 integer alb(7),aub(7),blb(7),bub(7) 194 integer aoff, boff 195 integer i1,i2,i3,k4,i5,i6,i7 196 integer(kind=i4) :: j 197 j = aoff 198 do i7 = alb(7),aub(7) 199 do i6 = alb(6),aub(6) 200 do i5 = alb(5),aub(5) 201 do k4 = alb(4),aub(4) 202 do i3 = alb(3),aub(3) 203 do i2 = alb(2),aub(2) 204 do i1 = alb(1),aub(1) 205 a(i1,i2,i3,k4,i5,i6,i7) = cmplx(j,j,c4) 206 j = j + 1 207 enddo 208 enddo 209 enddo 210 enddo 211 enddo 212 enddo 213 enddo 214 j = boff 215 do i7 = blb(7),bub(7) 216 do i6 = blb(6),bub(6) 217 do i5 = blb(5),bub(5) 218 do k4 = blb(4),bub(4) 219 do i3 = blb(3),bub(3) 220 do i2 = blb(2),bub(2) 221 do i1 = blb(1),bub(1) 222 b(i1,i2,i3,k4,i5,i6,i7) = cmplx(j,j,c4) 223 j = j + 1 224 enddo 225 enddo 226 enddo 227 enddo 228 enddo 229 enddo 230 enddo 231 return 232 end subroutine init_7d_c4 233 234 subroutine init_7d_c8(a,b,alb,aub,blb,bub,aoff,boff) 235 complex(kind=c8), pointer :: a(:,:,:,:,:,:,:) 236 complex(kind=c8), pointer :: b(:,:,:,:,:,:,:) 237 integer alb(7),aub(7),blb(7),bub(7) 238 integer aoff,boff 239 integer i1,i2,i3,k4,i5,i6,i7 240 integer(kind=i4) :: j 241 j = aoff 242 do i7 = alb(7),aub(7) 243 do i6 = alb(6),aub(6) 244 do i5 = alb(5),aub(5) 245 do k4 = alb(4),aub(4) 246 do i3 = alb(3),aub(3) 247 do i2 = alb(2),aub(2) 248 do i1 = alb(1),aub(1) 249 a(i1,i2,i3,k4,i5,i6,i7) = cmplx(j,j,c8) 250 j = j + 1 251 enddo 252 enddo 253 enddo 254 enddo 255 enddo 256 enddo 257 enddo 258 j = boff 259 do i7 = blb(7),bub(7) 260 do i6 = blb(6),bub(6) 261 do i5 = blb(5),bub(5) 262 do k4 = blb(4),bub(4) 263 do i3 = blb(3),bub(3) 264 do i2 = blb(2),bub(2) 265 do i1 = blb(1),bub(1) 266 b(i1,i2,i3,k4,i5,i6,i7) = cmplx(j,j,c8) 267 j = j + 1 268 enddo 269 enddo 270 enddo 271 enddo 272 enddo 273 enddo 274 enddo 275 return 276 end subroutine init_7d_c8 277 end module testa_init 278