不定数量的多重循环简单实现
不定数量的多重循环简单实现
要点概览
- 目的
- 实现不定数量的多重(层)循环
- 循环层数可以是1到n
- 不同层的循环数可以是不同的
- 运行环境
- windows系统：64位win7
- fotran编译器：mingw gfortran
- 注意/思路：
- 降维给出包含全部遍历的数组
- 递归代替循环实现遍历
多重循环是很简单的事情，c中多写几个for就可以了。fortran给出几重do和end do也OK。
比如三种循环:
do i=1,ni
do j=1,nj
do k=1,nk
write(*,*) 'code block for each ijk=',i,j,k
end do
end do
end do可以看到当已知循环的层数的时候，写出多重循环结构就可以了。而且遍历数可以利用输入参数随意改变。
但是当循环的层数不定的时候，有没有办法给出可变的多重循环结构呢？
答案显然是有的，有一种比较直接的解决思路就是递归。而另一种则是利用数组写出所有遍历情况的循环变量值列表，
做多重循环等价于利用这些循环变量值列表做计算，下面分别展开说明:
利用遍历情况数组给出的不定数量多重循环
这里给出了模块，全局变量nergodic是遍历状态的总数，数组vergodic则记录所有遍历状态的循环变量取值。
给出两个子程序，差异在于对于输入参数处理得到的多重循环的内外顺序不同。即循环结构是根据输入的循环变量顺序从外到内还是从内到外。
其中mloopasrcsv的结果是模拟递归的多重循环内外顺序，即第一个变量在最外层，最后一个变量在最内层。
而mloopdiff的结果是第一个变量在最内层，最后一个变量在最外层。
module multiloop
integer::nergodic !多层循环的遍历总数
integer,allocatable::vergodic(:,:) !记录所有遍历的循环变量取值
contains
!每一重循环的数量可能不同，可能相同,模拟递归的内外层顺序。
!第一个变量在最外层，最后一个变量在最内层，因为最后一个变量先变化
!输入参数:
!nvars_ml，多重循环的层数
!vmaxs_ml(nvars_ml)，多重循环各层的循环变量的最大取值构成的数组
subroutine mloopasrcsv(nvars_ml,vmaxs_ml)
implicit none
integer::nvars_ml !循环的层数
integer::vmaxs_ml(nvars_ml) !给出各层循环的循环变量最大值列表
integer::ndims,ndim
integer::i,j,k,ii
integer,allocatable::array(:,:)
ndims=1
do i=1,nvars_ml
ndims=ndims*vmaxs_ml(i)
end do
allocate(array(ndims,nvars_ml))
if(allocated(vergodic)) then
deallocate(vergodic)
allocate(vergodic(ndims,nvars_ml))
else
allocate(vergodic(ndims,nvars_ml))
end if
array=0
ndim=1
do k=1,nvars_ml!将多重循环的所有循环变量的遍历值写入2维数组中，第一维是遍历数，第二维记录对应每一遍历数的训练变量
!一个循环变量一个循环变量的填
if(k==1) then !第一个循环变量填入第二维第一个位置
do i=1,vmaxs_ml(nvars_ml)
array(i,:)=(/(1,ii=2,nvars_ml),i/)
end do
ndim=ndim*vmaxs_ml(nvars_ml)
else if(kthen !接下来的循环变量，填入第二个位置，前面位置的信息采用复制信息
do j=1,vmaxs_ml(nvars_ml-k+1)
do i=1,ndim
array((j-1)*ndim+i,:)=(/(1,ii=k+1,nvars_ml),j,array(i,nvars_ml-k+2:nvars_ml)/)
end do
end do
ndim=ndim*vmaxs_ml(nvars_ml-k+1)
else
do j=1,vmaxs_ml(1)
do i=1,ndim
array((j-1)*ndim+i,:)=(/j,array(i,2:nvars_ml)/)
end do
end do
end if
end do
do i=1,ndims
write(*,*) i,'th code block for each vars are',array(i,:)
end do
nergodic=ndims
vergodic=array
write(*,*) 'total number for ergodic',nergodic
end subroutine
!每一重循环的数量可能不同，可能相同
!第一个变量在最内层，最后一个变量在最外层，因为第一个变量先变化
!输入参数:
!nvars_ml，多重循环的层数
!vmaxs_ml(nvars_ml)，多重循环各层的循环变量的最大取值构成的数组
subroutine mloopdiff(nvars_ml,vmaxs_ml)
implicit none
integer::nvars_ml !循环的层数
integer::vmaxs_ml(nvars_ml) !给出各层循环的循环变量最大值列表
integer::ndims,ndim
integer::i,j,k,ii
integer,allocatable::array(:,:)
ndims=1
do i=1,nvars_ml
ndims=ndims*vmaxs_ml(i)
end do
allocate(array(ndims,nvars_ml))
if(allocated(vergodic)) then
deallocate(vergodic)
allocate(vergodic(ndims,nvars_ml))
else
allocate(vergodic(ndims,nvars_ml))
end if
array=0
ndim=1
do k=1,nvars_ml!将多重循环的所有循环变量的遍历值写入2维数组中，第一维是遍历数，第二维记录对应每一遍历数的训练变量
!一个循环变量一个循环变量的填
if(k==1) then !第一个循环变量填入第二维第一个位置
do i=1,vmaxs_ml(k)
array(i,:)=(/i,(1,ii=2,nvars_ml)/)
end do
ndim=ndim*vmaxs_ml(k)
else if(kthen !接下来的循环变量，填入第二个位置，前面位置的信息采用复制信息
do j=1,vmaxs_ml(k)
do i=1,ndim
array((j-1)*ndim+i,:)=(/array(i,1:k-1),j,(1,ii=k+1,nvars_ml)/)
end do
end do
ndim=ndim*vmaxs_ml(k)
else
do j=1,vmaxs_ml(k)
do i=1,ndim
array((j-1)*ndim+i,:)=(/array(i,1:k-1),j/)
end do
end do
end if
end do
do i=1,ndims
write(*,*) i,'th code block for each vars are',array(i,:)
end do
nergodic=ndims
vergodic=array
write(*,*) 'total number for ergodic',nergodic
end subroutine
end module 利用递归给出的不定数量多重循环
递归可以表示一种递进的结构，因此可以用来表示多重循环。假设当前处于递归深度1，针对该深度做循环并保存对应该深度的循环层的循环变量的值，并进入下一层的递归，处理对应下一层的循环层。这就是利用递归表示的不定数量多重循环的思路。这里给出模块，其中mlooprcsv是对输入参数和递归程序的封装，mloopinner是真正的递归程序。
module multiloop2
integer::nergodic
contains
!递归实现多重循环的包装程序，使其与非递归方法输入参数一致
!输入参数:
!nvars_ml，多重循环的层数
!vmaxs_ml(nvars_ml)，多重循环各层的循环变量的最大取值构成的数组
subroutine mlooprcsv(nvars_ml,vmaxs_ml)
integer::nvars_ml,vmaxs_ml(nvars_ml)
integer::d,sn !d为当前递归深度，snbeg为遍历过程当前状态的序号
integer,allocatable::vnow(:) !vnow为遍历过程当前状态的各循环变量的值
sn=0
d=1
allocate(vnow(nd))
vnow=1
call mloopinner(d,nvars_ml,vnow,vmaxs_ml,sn)
deallocate(vnow)
end subroutine
!递归实现多重循环遍历，注意循环各层的内外关系
!输入参数:
!d，为当前递归深度，表示多重循环的第d层
!nd，为总的递归深度，即总的多重循环层数
!vnow，为当前状态的循环变量值列表
!vend，为各层循环循环变量的最大值
!sn，为当前状态的序号，即遍历序数
recursive subroutine mloopinner(d,nd,vnow,vend,sn)
implicit none
integer::d,nd,sn
integer::vnow(nd),vend(nd)
integer::i
if (d==nd) then
do i=1,vend(nd)
vnow(d)=i
sn=sn+1
write(*,*) sn,'th code block for each vars are',vnow(:)
end do
else if(dand. d>0) then
do i=1,vend(d)
vnow(d)=i
call mloopinner(d+1,nd,vnow,vend,sn)
end do
else
write(*,*) 'error!'
end if
nergodic=sn
if(d==1) then !最外层结束后输出遍历总数
write(*,*) 'total number for ergodic',nergodic
end if
end subroutine
end module 小结
做两个函数，测试上述函数:
subroutine testb()
use multiloop
implicit none
integer::nd,i
integer,allocatable::vend(:)
nd=3
allocate(vend(nd))
vend=(/2,3,4/)
call mloopdiff(nd,vend)
call mloopasrcsv(nd,vend)
deallocate(vend)
nd=1
allocate(vend(nd))
vend=(/10/)
call mloopdiff(nd,vend)
deallocate(vend)
end subroutine
subroutine testc()
use multiloop2
implicit none
integer::nd,i
integer,allocatable::vend(:)
nd=3
allocate(vend(nd))
vend=(/2,3,4/)
call mlooprcsv(nd,vend)
deallocate(vend)
nd=1
allocate(vend(nd))
vend=(/10/)
call mlooprcsv(nd,vend)
deallocate(vend)
end subroutine结果为:
===========================================
compile the f90 file with mpich2_gfortran
===========================================
===========================================
Run the executable file
===========================================
1th code block for each vars are 1 1 1
2th code block for each vars are 2 1 1
3th code block for each vars are 1 2 1
4th code block for each vars are 2 2 1
5th code block for each vars are 1 3 1
6th code block for each vars are 2 3 1
7th code block for each vars are 1 1 2
8th code block for each vars are 2 1 2
9th code block for each vars are 1 2 2
10th code block for each vars are 2 2 2
11th code block for each vars are 1 3 2
12th code block for each vars are 2 3 2
13th code block for each vars are 1 1 3
14th code block for each vars are 2 1 3
15th code block for each vars are 1 2 3
16th code block for each vars are 2 2 3
17th code block for each vars are 1 3 3
18th code block for each vars are 2 3 3
19th code block for each vars are 1 1 4
20th code block for each vars are 2 1 4
21th code block for each vars are 1 2 4
22th code block for each vars are 2 2 4
23th code block for each vars are 1 3 4
24th code block for each vars are 2 3 4
total number for ergodic 24
1th code block for each vars are 1 1 1
2th code block for each vars are 1 1 2
3th code block for each vars are 1 1 3
4th code block for each vars are 1 1 4
5th code block for each vars are 1 2 1
6th code block for each vars are 1 2 2
7th code block for each vars are 1 2 3
8th code block for each vars are 1 2 4
9th code block for each vars are 1 3 1
10th code block for each vars are 1 3 2
11th code block for each vars are 1 3 3
12th code block for each vars are 1 3 4
13th code block for each vars are 2 1 1
14th code block for each vars are 2 1 2
15th code block for each vars are 2 1 3
16th code block for each vars are 2 1 4
17th code block for each vars are 2 2 1
18th code block for each vars are 2 2 2
19th code block for each vars are 2 2 3
20th code block for each vars are 2 2 4
21th code block for each vars are 2 3 1
22th code block for each vars are 2 3 2
23th code block for each vars are 2 3 3
24th code block for each vars are 2 3 4
total number for ergodic 24
1th code block for each vars are 1
2th code block for each vars are 2
3th code block for each vars are 3
4th code block for each vars are 4
5th code block for each vars are 5
6th code block for each vars are 6
7th code block for each vars are 7
8th code block for each vars are 8
9th code block for each vars are 9
10th code block for each vars are 10
total number for ergodic 10
1th code block for each vars are 1 1 1
2th code block for each vars are 1 1 2
3th code block for each vars are 1 1 3
4th code block for each vars are 1 1 4
5th code block for each vars are 1 2 1
6th code block for each vars are 1 2 2
7th code block for each vars are 1 2 3
8th code block for each vars are 1 2 4
9th code block for each vars are 1 3 1
10th code block for each vars are 1 3 2
11th code block for each vars are 1 3 3
12th code block for each vars are 1 3 4
13th code block for each vars are 2 1 1
14th code block for each vars are 2 1 2
15th code block for each vars are 2 1 3
16th code block for each vars are 2 1 4
17th code block for each vars are 2 2 1
18th code block for each vars are 2 2 2
19th code block for each vars are 2 2 3
20th code block for each vars are 2 2 4
21th code block for each vars are 2 3 1
22th code block for each vars are 2 3 2
23th code block for each vars are 2 3 3
24th code block for each vars are 2 3 4
total number for ergodic 24
1th code block for each vars are 1
2th code block for each vars are 2
3th code block for each vars are 3
4th code block for each vars are 4
5th code block for each vars are 5
6th code block for each vars are 6
7th code block for each vars are 7
8th code block for each vars are 8
9th code block for each vars are 9
10th code block for each vars are 10
total number for ergodic 10
请按任意键继续. . .
显然上述函数实现了不定数量的多重循环功能。
参考资料
无
ps:
好久不用fortran有些生疏了，突然发现fortran的动态数组有点像python的列表了，竟然不需要分配内存也可以使用的。
这是挺有意思的事情，看下面的示例:
subroutine testa()
integer,allocatable::sa(:)
integer::sb(2)
integer::sc
sa=(/1,2/) !动态数组完全不需要分配内存了。
write(*,*) sa
sb=(/1,2/)
write(*,*) sb
!sc=(/1,2/) !错误，标量不能赋值为矢量
!write(*,*) sc
sa=(/1,2,3/)
write(*,*) sa
!sb=(/1,2,3/) !错误，固定数组形状不符
!write(*,*) sb
sa=[1,2,3,4]
write(*,*) sa
sa=(/1,1/) !这里看出来sa变了，sa似乎有点类似python中的对象名了。
write(*,*) sa(:)
do i=1,4
write(*,*) sa(i)
end do
deallocate(sa)
allocate(sa(5)) !当前面一句不给出时，错误，因为给一个已经分配的数组再分配内存
sa=[1,2,3,4,5]
write(*,*) sa
sa=[1,2,3,4,5,6]
write(*,*) sa
end subroutine通过sa，sb，sc的比较可以发现，sa作为一个动态数组，可以不需要分配内存就直接赋值使用。而且换一个赋值语句增加数组长度仍然可以使用。
从分配内存操作的表现看，赋值命令(//)或[]自带内存分配和释放功能，当sa已经赋值为一个数组后，再次使用赋值命令，其中自带内存释放和分配。
当赋值后，手动使用allocate出错表明，此时数组已经分配内存，因此要手动再分配就需要将其先释放出来。
history：
v1.0 20180329 完成基本内容