Выбор k * k подмассива из массива p * p * n в Фортране - PullRequest
Новая
       32

Выбор k * k подмассива из массива p * p * n в Фортране

2 голосов
/ 27 января 2010

У меня есть массив p p n в Фортране, и я хочу извлечь k * k-подмассив из этого большего массива. Я пытался так, но не уверен, что это работает: 

do i=1,p
     vp(i)=i
end do
help=y(1:p,t)*vp
do t = 1, n
  A(1:k,1:k,t) = B(pack(help,help>0), pack(help,help>0), t)
end do

где y содержит значения 0 и 1, 1, означающие, что строка / столбец должна быть подмассивом. Работает ли это, и если нет, то как это же можно архивировать? Спасибо.

Ответы [ 4 ]

0 голосов
/ 07 июня 2013

Да, это должно работать, и вам даже не нужен цикл do t = ... 

  program main
  integer,dimension(3,3,2):: a
  integer,dimension(4,4,2):: b
  integer,dimension(4):: y
  integer,dimension(4):: idx
  integer:: i,j,k

  y = (/ 1 , 0 , 1 , 1 /)
  idx = (/ (i,i=1,4) /)
  b(:,:,:)=reshape((/((((i+10*j+100*k),i=1,4),j=1,4),k=1,2)/),(/4,4,2/))
  a(:,:,:) = b( pack(idx,y>0) , pack(idx,y>0) , :)

  print '(A2/,(4I4))','b=',b
  print '(A2/,(3I4))','a=',a

  end

скомпилированный с gfortran 4.2.3 правильно дает мне 

b=
 111 112 113 114
 121 122 123 124
 131 132 133 134
 141 142 143 144
 211 212 213 214
 221 222 223 224
 231 232 233 234
 241 242 243 244
a=
 111 113 114
 131 133 134
 141 143 144
 211 213 214
 231 233 234
 241 243 244

Вы также можете использовать 

  k = count( y> 0)
  a(1:k,1:k,:) = b( pack(idx,y>0) , pack(idx,y>0) , :)

Или подумайте, используя LOGICAL .true. и .false. вместо 1 и 0 ... 

  program main
  integer,dimension(3,3,2):: a
  integer,dimension(4,4,2):: b
  logical,dimension(4):: y
  integer,dimension(4):: idx
  integer:: i,j,k

  idx = (/ (i,i=1,4) /)
  y = idx /= 2
  b(:,:,:)=reshape((/((((i+10*j+100*k),i=1,4),j=1,4),k=1,2)/),(/4,4,2/))

  k = count( y )
  a(1:k,1:k,:) = b( pack(idx,y) , pack(idx,y) , :)

  print '(A2/,(4I4))','b=',b
  print '(A2/,(3I4))','a=',a

  end
0 голосов
/ 28 января 2010

Решение второе: использование операций с массивами на уровне векторов (массив 1D) - замените основной цикл на: 

ia = 0
do ib=1, Bdim
  if (good_row (ib)) then
     ia = ia + 1
     A (ia,:) = pack (B(ib,:), good_col)
  end if
end do

Решение третье, полностью с использованием операций с массивами: 

program test

integer, parameter :: Adim = 2
integer, parameter :: Bdim = 3
integer, dimension (Adim,Adim) :: A
integer, dimension (Bdim,Bdim) :: B
logical, dimension (Bdim,Bdim) :: mask
integer :: i, j

mask (1,:) = [.false., .true., .true.]
mask (2,:) = .false.
mask (3,:) = [.false., .true., .true.]


do i=1, Bdim
   do j=1, Bdim
      B (i,j) = i + i*j**2  ! test values
   end do
end do

do i=1, Bdim
   write (*, *) (B (i, j), j=1, Bdim)
end do

A  = reshape ( pack (B, mask), [Adim, Adim] )

write (*, *)
do i=1, Adim
   write (*, *) (A (i, j), j=1, Adim)
end do

stop
end program test
0 голосов
/ 28 января 2010

Не уверен, полезны ли вам эти фрагменты не-кода, но;

  • Не забывайте особенности секционирования массива в Fortran.

  • Не забывайте, что вы можете использовать векторные индексы для получения разделов массива, например, вы можете выбрать элементы вектора v следующим образом:

    v ((/ 1, 3, 6, 5, 10 /))

Векторная подписка может применяться к массивам с рангом, превышающим 1. Мне было бы больно думать, как таким образом определить ваши требования к подписке, но вы можете попробовать это.

0 голосов
/ 27 января 2010

Если я понимаю, что вы хотите сделать, вот пример программы, которая извлекает выбранные столбцы и строки, но не использует много обозначений массива. 

program test

integer, parameter :: Adim = 2
integer, parameter :: Bdim = 3
integer, dimension (Adim,Adim) :: A
integer, dimension (Bdim,Bdim) :: B
logical, dimension (Bdim) :: good_row = [.true., .false., .true.]
logical, dimension (Bdim) :: good_col = [.false., .true., .true.]
integer :: i, j, ia, ja, ib, jb


if (count (good_row) /= Adim  .or.  count (good_col) /= Adim) then
   write (*, *) 'selection arrays not setup correctly.'
   stop
end if

do i=1, Bdim
   do j=1, Bdim
      B (i,j) = i + i*j**2  ! test values
   end do
end do

do i=1, Bdim
   write (*, *) (B (i, j), j=1, Bdim)
end do

ia = 0
do ib=1, Bdim
  if (good_row (ib)) then
     ia = ia + 1
     ja = 0
     do jb=1, Bdim
        if (good_col (jb)) then
           ja = ja + 1
           !write (*, *) ia, ja, ib, jb
           A(ia,ja) = B(ib,jb)
        end if
     end do
  end if
end do

write (*, *)
do i=1, Adim
   write (*, *) (A (i, j), j=1, Adim)
end do

stop
end program test
...