版块导航: 正在加载中...

登录注册

应《网络安全法》要求，自2017年10月1日起，未进行实名认证将不得使用互联网跟帖服务。为保障您的帐号能够正常使用，请尽快对帐号进行手机号验证，感谢您的理解与支持！

24小时热门版块排行榜

返回列表

本帖产生 1 个程序强帖，点击这里进行查看

当前只显示满足指定条件的回帖，点击这里查看本话题的所有回帖

maomao1210

金虫 (正式写手)

程序强帖: 5
应助: 2 (幼儿园)
金币: 1431.3
散金: 242
红花: 16
沙发: 1
帖子: 991
在线: 441.5小时
虫号: 253215
注册: 2006-05-20
性别: MM
专业: 考古理论

[交流] 【交流】Fortran语言答疑专帖已有46人参与

帖主寄言

其实语言并不是最重要的，形势的载体而已，fortran擅长工程计算，因为工作需要，偶尔用用fortran。在此开贴目的有二：

第一，希望能和大家交流的同时提高和丰富自己；

第二，认识来自五湖四海的朋友。

资料目前还没有整理，有机会整理上传一些。呵呵。

[ Last edited by nono2009 on 2009-11-18 at 10:34 ]

回复此楼

» 本帖已获得的红花（最新10朵）

» 猜你喜欢

请问哪里可以有青B申请的本子可以借鉴一下。已经有4人回复
真诚求助：手里的省社科项目结项要求主持人一篇中文核心，有什么渠道能发核心吗已经有6人回复
孩子确诊有中度注意力缺陷已经有14人回复
三甲基碘化亚砜的氧化反应已经有4人回复
请问下大家为什么这个铃木偶联几乎不反应呢已经有5人回复
请问有评职称，把科研教学业绩算分排序的高校吗已经有5人回复
2025冷门绝学什么时候出结果已经有3人回复
天津工业大学郑柳春团队欢迎化学化工、高分子化学或有机合成方向的博士生和硕士生加入已经有4人回复
康复大学泰山学者周祺惠团队招收博士研究生已经有6人回复
AI论文写作工具：是科研加速器还是学术作弊器？已经有3人回复

1楼2009-05-31 18:15:40

已阅回复此楼关注TA 给TA发消息送TA红花 TA的回帖

RyanHusky

银虫 (初入文坛)

应助: 1 (幼儿园)
金币: 555.1
散金: 15
红花: 1
帖子: 48
在线: 87.6小时
虫号: 2054422
注册: 2012-10-11
性别: GG
专业: 电力系统

★
小木虫: 金币+0.5, 给个红包，谢谢回帖

最近正在编写的一段有关一个小型电网的拓扑搜索计算程序，以下我贴出我编写的拓扑搜索分支程序，请各位大牛多多赐教！
subroutine  PowerSystemParameterGetValue()
use  PowerSystemConstant
use  PowerSystemParameter
use  Comp_TP
implicit none
logical alive
!    PhysicalNodeNum=8
!    GenNum=2
!    Tran2Num=1
!    BreakerNum=2
!    IsolatorNum=2
!    GroundCapacitanceNum=1
!    LoadNum=2
!    BusNum=4
!    LineNum=3

inquire(file="Data/PowerSystemParameter.txt",exist=alive)
if (alive)then
      open(unit=FileId,file='Data/PowerSystemParameter.txt')
      read(FileId,*)PhysicalNodeNum,GenNum,Tran2Num,BreakerNum,IsolatorNum,GroundCapacitanceNum,LoadNum,BusNum,LineNum
      write(*,*)"  Read PowerSystemParameter.txt is OK!"
      close(FileId,status='keep')
else
      write(*,*)"  PowerSystemParameter.txt doesn't exist."
endif

endsubroutine

subroutine  Com_TPAllocate()

use  PowerSystemParameter
use  Comp_TP
implicit none

if (BreakerNum/=0)then
      allocate(TP_Breakers(BreakerNum))
endif
if (IsolatorNum/=0)then
      allocate(TP_Isolators(IsolatorNum))
endif
if (BusNum/=0)then
      allocate(TP_Buss(BusNum))
endif
if (LoadNum/=0)then
      allocate(TP_Loads(LoadNum))
endif
if (GroundCapacitanceNum/=0)then
      allocate(TP_GroundCapacitances(GroundCapacitanceNum))
endif
if (LineNum/=0)then
      allocate(TP_Lines(LineNum))
endif
if (GenNum/=0)then
      allocate(TP_Gens(GenNum))
endif
if (Tran2Num/=0)then
      allocate(TP_Tran2s(Tran2Num))
endif

endsubroutine

!=========================================
! 拓扑分析元件数据初始化
!=========================================

subroutine  NodeInit()
!拓扑搜索赋值
use  PowerSystemConstant
use  PowerSystemParameter
use  Comp_TP
implicit none
integer::i
logical alive
inquire(file="Data/Breaker.txt",exist=alive)
if (alive)then
      open(unit=FileId,file='Data/Breaker.txt')
      do i=1,BreakerNum
         read(FileId,*)TP_Breakers(i).P1,TP_Breakers(i).P2,TP_Breakers(i).isoff
      enddo
      close(FileId,status='keep')
      write(*,*)"  Read Breaker.txt is OK!"
      !write(*,*)TP_Breakers(BreakerNum)
else
      write(*,*)"  Breaker.txt doesn't exist."
endif

inquire(file="Data/Isolator.txt",exist=alive)
if (alive)then
      open(unit=FileId,file='Data/Isolator.txt')
      do i=1,IsolatorNum
         read(FileId,*)TP_Isolators(i).P1,TP_Isolators(i).P2,TP_Isolators(i).isoff
      enddo
      close(FileId,status='keep')
      write(*,*)"  Read Isolator.txt is OK!"
   ! write(*,*)TP_Isolators(IsolatorNum)
else
      write(*,*)"  Isolator.txt doesn't exist."
endif

inquire(file="Data/Bus.txt",exist=alive)
if (alive)then
      open(unit=FileId,file='Data/Bus.txt')
      do i=1,BusNum
         read(FileId,*)TP_Buss(i).Enable,TP_Buss(i).P1
      enddo
      close(FileId,status='keep')
      write(*,*)"  Read Bus.txt is OK!"
   ! write(*,*)TP_Buss(BusNum)
else
      write(*,*)"  Bus.txt doesn't exist."
endif

inquire(file="Data/Load.txt",exist=alive)
if (alive)then
      open(unit=FileId,file='Data/Load.txt')
      do i=1,LoadNum
         read(FileId,*)TP_Loads(i).Enable,TP_Loads(i).P1
      enddo
      close(FileId,status='keep')
      write(*,*)"  Read Load.txt is OK!"
      !write(*,*)TP_Loads(LoadNum)
else
      write(*,*)"  Load.txt doesn't exist."
endif

inquire(file="Data/GroundCapacitance.txt",exist=alive)
if (alive)then
      open(unit=FileId,file='Data/GroundCapacitance.txt')
      do i=1,GroundCapacitanceNum
         read(FileId,*)TP_GroundCapacitances(i).Enable,TP_GroundCapacitances(i).P1
      enddo
      close(FileId,status='keep')
      write(*,*)"  Read GroundCapacitance.txt is OK!"
      !write(*,*)TP_GroundCapacitances(GroundCapacitanceNum)
else
      write(*,*)"  GroundCapacitance.txt doesn't exist."
endif

inquire(file="Data/Generator.txt",exist=alive)
if (alive)then
      open(unit=FileId,file='Data/Generator.txt')
      do i=1,GenNum
         read(FileId,*)TP_Gens(i).Enable,TP_Gens(i).P1,TP_Gens(i).NodeType
      enddo
      close(FileId,status='keep')
      write(*,*)"  Read Generator.txt is OK!"
      !write(*,*)TP_Gens(GenNum)
else
      write(*,*)"  Generator.txt doesn't exist."
endif

inquire(file="Data/Tran2.txt",exist=alive)
if (alive)then
      open(unit=FileId,file='Data/Tran2.txt')
      do i=1,Tran2Num
         read(FileId,*)TP_Tran2s(i).Enable,TP_Tran2s(i).P1,TP_Tran2s(i).P2
      enddo
      close(FileId,status='keep')
      write(*,*)"  Read Tran2.txt is OK!"
      !write(*,*)TP_Tran2s(Tran2Num)
else
      write(*,*)"  Tran2.txt doesn't exist."
endif

inquire(file="Data/Line.txt",exist=alive)
if (alive)then
      open(unit=FileId,file='Data/Line.txt')
      do i=1,LineNum
         read(FileId,*)TP_Lines(i).Enable,TP_Lines(i).P1,TP_Lines(i).P2
      enddo
      close(FileId,status='keep')
      write(*,*)"  Read Line.txt is OK!"
   ! write(*,*)TP_Lines(LineNum)
else
      write(*,*)"  Line.txt doesn't exist."
endif
endsubroutine

!=====================================================
!                全网逻辑节点形成函数
!=====================================================
subroutine GetLogicalNode()
  use  PowerSystemParameter
  use  TopologyAanlysisVars
  use  Comp_TP
  implicit none
  integer(kind=4) i,j,max,min
  !动态开辟物理节点到逻辑节点数组（位于TopologyAanlysisVars模块）内存空间
  allocate(PhyicalToLogicalArray(PhysicalNodeNum))
!数组初始化
  do i=1,PhysicalNodeNum
PhyicalToLogicalArray(i)=i
  enddo

  !隔离开关状态量处理——隔离开关融合
  if (IsolatorNum/=0)then
do i=1,IsolatorNum
      if (TP_Isolators(i).isoff==1)then
         if(PhyicalToLogicalArray(TP_Isolators(i).P1)>PhyicalToLogicalArray(TP_Isolators(i).P2))then
            max=PhyicalToLogicalArray(TP_Isolators(i).P1)
            min=PhyicalToLogicalArray(TP_Isolators(i).P2)
         else
            max=PhyicalToLogicalArray(TP_Isolators(i).P2)
            min=PhyicalToLogicalArray(TP_Isolators(i).P1)
         endif
         PhyicalToLogicalArray(TP_Isolators(i).P1)=min
         PhyicalToLogicalArray(TP_Isolators(i).P2)=min
         if (max/=min)then
            do j=1,PhysicalNodeNum
                  if(PhyicalToLogicalArray(j)==max)then
                     PhyicalToLogicalArray(j)=min
                  elseif(PhyicalToLogicalArray(j)>max)then
                     PhyicalToLogicalArray(j)=PhyicalToLogicalArray(j)-1
                  endif
            enddo
         endif
      endif
enddo
  endif

  !断路器状态量处理——断路器融合
  if (BreakerNum/=0)then
do i=1,BreakerNum
      if (TP_Breakers(i).isoff==1)then
         if(PhyicalToLogicalArray(TP_Breakers(i).P1)>PhyicalToLogicalArray(TP_Breakers(i).P2))then
            max=PhyicalToLogicalArray(TP_Breakers(i).P1)
            min=PhyicalToLogicalArray(TP_Breakers(i).P2)
         else
            max=PhyicalToLogicalArray(TP_Breakers(i).P2)
            min=PhyicalToLogicalArray(TP_Breakers(i).P1)
         endif
         PhyicalToLogicalArray(TP_Breakers(i).P1)=min
         PhyicalToLogicalArray(TP_Breakers(i).P2)=min
         if (max/=min)then
            do j=1,PhysicalNodeNum
                  if(PhyicalToLogicalArray(j)==max)then
                     PhyicalToLogicalArray(j)=min
                  elseif(PhyicalToLogicalArray(j)>max)then
                     PhyicalToLogicalArray(j)=PhyicalToLogicalArray(j)-1
                  endif
            enddo
         endif
      endif
enddo
  endif

  !查找网络逻辑节点最大值

  LogicalNodeNum= PhyicalToLogicalArray(1)
  do i=1,PhysicalNodeNum
if( PhyicalToLogicalArray(i)>LogicalNodeNum)then
      LogicalNodeNum=PhyicalToLogicalArray(i)
endif
  enddo
write(*,*)"逻辑节点数组为:"
  write(*,*)PhyicalToLogicalArray
  write(*,*)"逻辑节点最大值为:"
  write(*,*)LogicalNodeNum

endsubroutine

!================================================================
!                            网络电气岛处理函数
!================================================================
subroutine  GetIsland()
  use  PowerSystemParameter
  use  TopologyAanlysisVars
  use  Comp_TP
  implicit none
  integer(kind=4)::i,j,max,min,SaveIsLandNum
  integer(kind=4)::iTemp,jTemp
  if(LogicalNodeNum/=0)then
allocate(IsLandArray(LogicalNodeNum))
  endif
  if(LogicalNodeNum/=0)then
do i=1,LogicalNodeNum
      IsLandArray(i)=i
enddo
  endif

!输电线路电气岛融合
  if(LineNum/=0)then
do i=1,LineNum
      if(IsLandArray(PhyicalToLogicalArray(TP_Lines(i).P1))>IsLandArray(PhyicalToLogicalArray(TP_Lines(i).P2)))then
      max=IsLandArray(PhyicalToLogicalArray(TP_Lines(i).P1))
      min=IsLandArray(PhyicalToLogicalArray(TP_Lines(i).P2))
      else
      max=IsLandArray(PhyicalToLogicalArray(TP_Lines(i).P2))
      min=IsLandArray(PhyicalToLogicalArray(TP_Lines(i).P1))
      endif
      IsLandArray(PhyicalToLogicalArray(TP_Lines(i).P1))=min
      IsLandArray(PhyicalToLogicalArray(TP_Lines(i).P2))=min
      if(max/=min)then
         do j=1,LogicalNodeNum
            if(IsLandArray(j)==max)then
                  IsLandArray(j)=min
            elseif(IsLandArray(j)>max)then
                  IsLandArray(j)=IsLandArray(j)-1
            endif
         enddo
      endif
enddo
  endif

  !双绕组变压器电气岛融合
  if(Tran2Num/=0)then
do i=1,Tran2Num
      if(IsLandArray(PhyicalToLogicalArray(TP_Tran2s(i).P1))>IsLandArray(PhyicalToLogicalArray(TP_Tran2s(i).P2)))then
      max=IsLandArray(PhyicalToLogicalArray(TP_Tran2s(i).P1))
      min=IsLandArray(PhyicalToLogicalArray(TP_Tran2s(i).P2))
      else
      max=IsLandArray(PhyicalToLogicalArray(TP_Tran2s(i).P2))
      min=IsLandArray(PhyicalToLogicalArray(TP_Tran2s(i).P1))
      endif
      IsLandArray(PhyicalToLogicalArray(TP_Tran2s(i).P1))=min
      IsLandArray(PhyicalToLogicalArray(TP_Tran2s(i).P2))=min
      if(max/=min)then
         do j=1,LogicalNodeNum
            if(IsLandArray(j)==max)then
                  IsLandArray(j)=min
            elseif(IsLandArray(j)>max)then
                  IsLandArray(j)=IsLandArray(j)-1
            endif
         enddo
      endif
enddo
  endif

!===========保留平衡节点所在的电气岛，其他岛不要==================
SaveIsLandNum=0
if(GenNum/=0)then
do i=1,GenNum
      if((TP_Gens(i).Enable==1).and.(TP_Gens(i).NodeType==2))then
         SaveIsLandNum=IsLandArray(PhyicalToLogicalArray(TP_Gens(i).P1))
!          write(*,*)'平衡节点所在岛号'
!          write(*,*)SaveIsLandNum
      exit
      endif
enddo
if(SaveIsLandNum==0)then
      write(*,*) "未设置平衡节点！请先设置平衡节点再运行程序"
endif
endif
if(LogicalNodeNum/=0)then
do i=1,LogicalNodeNum
      if(SaveIsLandNum==IsLandArray(i))then
         IsLandArray(i)=1
      else
         IsLandArray(i)=0
      endif
enddo
endif
!================统计岛上逻辑节点数目==============
NodeNum=0
if(LogicalNodeNum/=0)then
do i=1,LogicalNodeNum
      if(IsLandArray(i)==1)then
         NodeNum=NodeNum+1
      endif
enddo
endif
!===================逻辑节点再排序================

if(NodeNum/=0)then
allocate(IsLandToNodeArray(NodeNum))
allocate(NodeTypeArray(NodeNum))
j=0
do i=1,LogicalNodeNum
      if(IsLandArray(i)==1)then
      j=j+1
      IsLandToNodeArray(j)=i
      NodeTypeArray(j)=0  !节点类型初始化，都为PQ节点0，pv=1，slack=2
      endif
enddo
endif

if(NodeNum/=0)then
do i=1,NodeNum
      do j=1,GenNum
         if((TP_Gens(j).NodeType==2).and.(PhyicalToLogicalArray(TP_Gens(j).P1)==IsLandToNodeArray(i)))then
         NodeTypeArray(i)=2
         elseif((TP_Gens(j).NodeType==1).and.(PhyicalToLogicalArray(TP_Gens(j).P1)==IsLandToNodeArray(i)))then
         NodeTypeArray(i)=1
         endif
      enddo
enddo
endif
!===============节点排序===========
if(NodeNum/=0)then
!==========slack节点排序到最后==============
      do j=1,NodeNum
         if(NodeTypeArray(j)==2)then
         jTemp=NodeTypeArray(j)
         NodeTypeArray(j)= NodeTypeArray(NodeNum)
         NodeTypeArray(NodeNum)=jTemp
         jTemp=IsLandToNodeArray(j)
         IsLandToNodeArray(j)=IsLandToNodeArray(NodeNum)
         IsLandToNodeArray(NodeNum)=jTemp
         endif
      enddo
  !=====================pv节点排序================
do i=1,NodeNum-1
      do j=NodeNum-1,1,-1
      if(i          if((NodeTypeArray(i)==1).and.(NodeTypeArray(j)==0))then
         iTemp=NodeTypeArray(i)
         NodeTypeArray(i)=NodeTypeArray(j)
         NodeTypeArray(j)=iTemp
         iTemp=IsLandToNodeArray(i)
         IsLandToNodeArray(i)=IsLandToNodeArray(j)
         IsLandToNodeArray(j)=iTemp
         endif
      endif
      enddo
enddo
!          i=1
!       do j=1,NodeNum-1
!          if(NodeTypeArray(j)==1)then
!          jTemp=NodeTypeArray(j)
!          NodeTypeArray(j)=NodeTypeArray(NodeNum-i)
!          NodeTypeArray(NodeNum-i)=jTemp
!          jTemp=IsLandToNodeArray(j)
!          IsLandToNodeArray(j)=IsLandToNodeArray(NodeNum-i)
!          IsLandToNodeArray(NodeNum-i)=jTemp
!          i=i+1
!          endif
!       enddo
! enddo
endif
!============排序后的物理节点和电气岛上的逻辑节点对应关系======
if(PhysicalNodeNum/=0)then
allocate(PhyicalToNodeArray(PhysicalNodeNum))
do i=1,PhysicalNodeNum
PhyicalToNodeArray(i)=0
enddo
do i=1,NodeNum
   do j=1,PhysicalNodeNum
         if (IsLandToNodeArray(i)==PhyicalToLogicalArray(j))then
         PhyicalToNodeArray(j)=i
         endif
   enddo
enddo

endif
  write(*,*)"电气岛处理结果如下"
  write(*,*)IsLandArray
  write(*,*)"岛上的逻辑节点编号为："
  write(*,*)IsLandToNodeArray
  write(*,*)"岛上的逻辑节点编号对应的节点类型为："
  write(*,*)NodeTypeArray
  write(*,*)"岛上的逻辑节点数目为："
  write(*,*)NodeNum
  write(*,*)"拓扑搜索的最终成果为："
  write(*,*)PhyicalToNodeArray

endsubroutine

赞一下(3人)

回复此楼

虚怀若谷，深藏若虚。

140楼2012-10-11 15:43:05

已阅回复此楼关注TA 给TA发消息送TA红花 TA的回帖

查看全部 158 个回答

stereochemistry

应助: (幼儿园)
在线:
虫号: 292163

★
小木虫(金币+0.5):给个红包，谢谢回帖交流

你好，最近写程序遇见一个问题，一个对称矩阵想线性存储，请问怎么实现呢？

赞一下(1人)

回复此楼

2楼2009-06-01 12:32:17

已阅回复此楼关注TA 给TA发消息送TA红花 TA的回帖

maomao1210

金虫 (正式写手)

程序强帖: 5
应助: 2 (幼儿园)
金币: 1431.3
散金: 242
红花: 16
沙发: 1
帖子: 991
在线: 441.5小时
虫号: 253215
注册: 2006-05-20
性别: MM
专业: 考古理论

★ ★ ★ ★ ★
wangen994(金币+2,VIP+0):鼓励一下，哈哈 6-4 11:55
gwdavid(金币+3,VIP+0):辛苦了!答疑帖加大奖励力度!;) 6-7 10:32
wangen994(金币+0,VIP+0):请你讲九月份十月份的参与应助的帖子整理附在http://emuch.net/bbs/viewthread.php?tid=1358729&fpage=1后面，以便发放津贴 11-9 19:00

哦。我给你举个例子吧，比如对称矩阵 A[3,3]
                           A(1,1)    A(1,2)    A(1,3)
                           A(2,1)    A(2,2)    A(2,3)
                           A(3,1)    A(3,2)    A(3,3)
只要存储成一个一维数组即可： B(1)=A(1,1),B(2)=A(2,1),B(3)=A(2,2), B(4)=A(3,1),B(5)=A(3,2),B(6)=A(3,3).
还要记住这个：行和列与存储该值的关系为：II=MAX(I,J)*(MAX(I,J)+1)/2+MIN(I,J), 那么B(II)==A(I,J).
不知道我讲的能听懂与否。如果不懂，继续发问。

赞一下(26人)

回复此楼

3楼2009-06-01 12:41:49

已阅回复此楼关注TA 给TA发消息送TA红花 TA的回帖

anbb1009

金虫 (正式写手)

应助: 0 (幼儿园)
金币: 555.6
散金: 100
帖子: 375
在线: 233小时
虫号: 644698
注册: 2008-11-03
专业: 凝聚态物性 II ：电子结构

★
小木虫(金币+0.5):给个红包，谢谢回帖交流

我同意楼上的观点，因为我以前也这样做过，而且效果不错，但顺便问一下：目前fortran中用的最好的求非线性方程一组实根的方法有哪几种,有没有现成的子程序?谢谢

赞一下(1人)

回复此楼

4楼2009-06-05 14:35:16

已阅回复此楼关注TA 给TA发消息送TA红花 TA的回帖

查看全部 158 个回答