24小时热门版块排行榜    

查看: 454  |  回复: 2
当前只显示满足指定条件的回帖,点击这里查看本话题的所有回帖

songjunann

铜虫 (小有名气)

[求助] 求助一个调用程序的问题,谢谢

如下程序,能否在主程序里面这么调用:
Call slvasi(a,b,b,idiag, neq, 1,ierr)
我觉得,有两个b很有问题,但是别人给我的一个大程序就是这么干的,我也不知道如何在大程序里面改,先问问这种调用有问题吗(如没有,我也就放过去了,呵呵)? 非常感谢


subroutine slvasi (a,b,x,mdiag,neq,key,ierr)
cc-begin
c-----------------------------------------------------------------------
c
c     call slvasi (a,b,x,mdiag,neq,key,ierr)
c
c     usage : in-core non-symmetric system
c     =====
c
c
c     purpose
c     -------
c
c     to solve a linear system of equations [a] [x] = , where a
c     is total stiffness matrix
c
cc-doc
c     input arguments
c     ---------------
c
c     a       = vector containing total stiffness matrix.
c     b       = load vector of length neq (see note 1).
c     mdiag   = vector of length neq which contains the position
c               of the diagonal element in the total stiffness
c               matrix.(outputted by diag)
c     neq     = number of equations.
c     key     = operation control key :
c
c               key = 1  perform lu factorisation of a and solve ax = b.
c               key = 2  perform lu factorisation of a only.
c               key = 3  reduction of load vector b and back
c                        substitution to obtain solution x (see note 2).
c     output arguments
c     ----------------
c
c     x       = solution vector of length neq (see note 1).
c     ierr    = error flag (see note 5).
c
c     reference
c     ---------
c
c     LSD / FEM   Version 2.
c     A Library for Software Development in the Finite Element Method
c     Technical Report 85-3, Department of Computer Science
c     The Hebrew University of Jerusalem.
c
c     notes
c     -----
c
c     1.  the vectors b and x can occupy the same storage space i.e. on
c         output b will contain the solution.
c
c     2.  if key = 3 , slvasi must have previously been called with
c         key = 1 or 2. slvasi can be called repeatedly with key = 3,
c         providing a, mdiag and length are not changed.
c
c     3.  slvasi uses the library-supplied function dot(x,y,n) which
c         calculates the inner (dot,scalar) product of the vectors x,y
c         of length n.
c
c     4.  the subroutine slvasi can be used independently of the package
c         presented here. the sole requirement of slvasi is the vectors
c         a,b,mdiag and length written in the described format.
c
c     5.  ierr = 0  execution successfull
c              = n  a zero pivot was encountered on row n during lu
c                   factorisation. factorisation aborted.
c
c-----------------------------------------------------------------------
cc-end
c
      implicit real*8 (a-h,o-z)
      dimension a(*),b(*),x(*),mdiag(*)
c
c
      ierr = 0
      if (key .eq. 3) go to 50
c
c     loop on rows of matrix
c
      mdi = 0
      do 40  i = 1,neq
         mdim  = mdi
         mdi   = mdiag(i)
         lengli= (mdi - mdim - 1)/2
         lengui= mdi - 1 - mdim - lengli
         lowli = i - lengli
         lowui = i - lengui
         loci0 = mdi - lengui - i
         loc0i = mdi - i
         im    = i - 1
         ifj   = min0 (lowui,lowli)
         ilj   = im
         if (ifj .gt. ilj) go to 30
         jj    = ifj - 1
         mdj   = 0
         if (ifj .gt. 1) mdj = mdiag(jj)
c
c        loop on columns.
c
         do 20  j = ifj,ilj
            mdjm  =  mdj
            mdj   =  mdiag(j)
            lenglj=  (mdj - mdjm - 1)/2
            lenguj=  mdj - 1 - mdjm - lenglj
            lowlj =  j - lenglj
            lowuj =  j - lenguj
            if (lowli .gt. j) go to 10
c
c           compute l(i,j)
c
            k       = max0 (lowli,lowuj)
            lockj   = mdj - j + k
            locij   = loci0 + j
            locik   = loci0 + k
            a(locij)= (a(locij) - dot(a(locik),a(lockj),j-k))/a(mdj)
c
c           compute u(j,i)
c
   10       if (lowui .gt. j) go to 20
            k     = max0 (lowui,lowlj)
            locji = loc0i + j
            locki = loc0i + k
            locjk = mdj - lenguj - j + k
            a(locji) = a(locji) - dot(a(locjk),a(locki),j-k)
   20    continue
c
c        compute u(i,i)
c
   30    k      = max0 (lowli,lowui)
         locik  = loci0 + k
         locki  = loc0i + k
         a(mdi) = a(mdi) - dot(a(locik),a(locki),i-k)
         if (a(mdi) .eq. 0.) go to 100
         if (key .eq. 2) go to 40
c
c        reduce b if key = 1
c
         locik = loci0 + lowli
         x(i)  = b(i) - dot (a(locik),x(lowli),i-lowli)
   40 continue
      if (key .eq. 2) return
      go to 70
c
c     reduce b if key = 3
c
   50 mdi   = 0
      do 60 i = 1,neq
         mdim = mdi
         mdi  = mdiag(i)
         lengli= (mdi - mdim - 1)/2
         lowli = i - lengli
         locik = mdim + 1
         x(i)  = b(i) - dot(a(locik),x(lowli),i-lowli)
   60 continue
c
c     back substitution
c
70   ii   = neq
      mdim = mdiag(neq)
      im   = neq
      do 90 ll = 1,neq
         i     = im
         im    = im - 1
         mdi   = mdim
         ii    = ii - 1
         mdim  = 0
         if (i .ne. 1) mdim = mdiag(ii)
         lengli = (mdi - mdim - 1)/2
         lengui = mdi - 1 - mdim - lengli
         lowui  = i - lengui
         x(i)   = x(i)/a(mdi)
         if (lowui .gt.  im) go to 90
         locij  = mdi - lengui
         do 80 j = lowui,im
            x(j) = x(j) - a(locij)*x(i)
            locij= locij + 1
   80    continue
   90 continue
      return
c
c     zero pivot
c
  100 ierr = i
      merf = 100*ierr
      call erfac (4hslva,merf)
      end
回复此楼
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

snoopyzhao

至尊木虫 (职业作家)

【答案】应助回帖


dubo(金币+1): 欢迎讨论 2011-09-18 14:44:03
songjunann(金币+10): 恩,谢谢,我也注意到这个了,只是不确定 2011-09-18 14:57:30
这样做没有什么问题,如果这么调用后,返回值将使得 b 发生变化,从程序来看,这不会有什么问题。但是,如果你想 b 在调用这个子程后不要发生变化,就不能那么调用……

看程序中,有一句话:
c     notes
c     -----
c
c     1.  the vectors b and x can occupy the same storage space i.e. on
c         output b will contain the solution.
3楼2011-09-18 13:31:12
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖
查看全部 3 个回答

锐利的碎片

木虫 (正式写手)

star watcher

【答案】应助回帖


jjdg(金币+1): 感谢你的解释 2011-09-18 12:41:33
songjunann(金币+10): xiexie 2011-09-19 09:57:41
应该没什么问题,两个b是因为subroutine slvasi (a,b,x,mdiag,neq,key,ierr) 里x是返回值,如果要把返回的x赋值给b可以这么写。
2楼2011-09-18 10:59:29
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖
最具人气热帖推荐 [查看全部] 作者 回/看 最后发表
[公派出国] 售SCI一区文章,我:8 O5 51O 54,科目齐全 +3 5lbyq5wrhb 2026-02-07 3/150 2026-02-08 03:05 by vs90ilomwc
[考博] 售SCI一区文章,我:8 O5 51O 54,科目齐全 +3 5lbyq5wrhb 2026-02-07 3/150 2026-02-08 02:52 by vs90ilomwc
[论文投稿] 售SCI一区文章,我:8 O5 51O 54,科目齐全 +3 3rkserf6qr 2026-02-07 4/200 2026-02-08 02:45 by vs90ilomwc
[硕博家园] 售SCI一区文章,我:8 O5 51O 54,科目齐全 +5 2h7du0nuhk 2026-02-07 5/250 2026-02-08 02:27 by vs90ilomwc
[考博] 售SCI一区文章,我:8 O5 51O 54,科目齐全 +5 2h7du0nuhk 2026-02-07 5/250 2026-02-08 02:25 by vs90ilomwc
[硕博家园] 售SCI一区文章,我:8 O5 51O 54,科目齐全 +4 2h7du0nuhk 2026-02-07 5/250 2026-02-08 02:12 by vs90ilomwc
[考博] 售SCI一区文章,我:8 O5 51O 54,科目齐全 +4 2h7du0nuhk 2026-02-07 6/300 2026-02-08 02:07 by vs90ilomwc
[教师之家] 售SCI一区文章,我:8 O5 51O 54,科目齐全 +4 2h7du0nuhk 2026-02-07 6/300 2026-02-08 02:05 by vs90ilomwc
[找工作] 售SCI一区文章,我:8 O5 51O 54,科目齐全 +4 2h7du0nuhk 2026-02-07 6/300 2026-02-08 01:46 by vs90ilomwc
[公派出国] 售SCI一区文章,我:8 O5 51O 54,科目齐全 +4 2h7du0nuhk 2026-02-07 7/350 2026-02-08 01:45 by vs90ilomwc
[考博] 售SCI一区文章,我:8 O5 51O 54,科目齐全 +4 2h7du0nuhk 2026-02-07 7/350 2026-02-08 01:32 by vs90ilomwc
[教师之家] 售SCI一区文章,我:8 O5 51O 54,科目齐全 +4 2h7du0nuhk 2026-02-07 7/350 2026-02-08 01:26 by vs90ilomwc
[教师之家] 有院领导为了换新车,用横向课题经费买了俩车 +7 瞬息宇宙 2026-02-04 7/350 2026-02-07 21:47 by tfang
[有机交流] 酰胺脱乙酰基 10+5 chibby 2026-02-03 12/600 2026-02-07 19:29 by 江东闲人
[基金申请] 同年申请2项不同项目,第1个项目里不写第2个项目的信息,可以吗 +4 hitsdu 2026-02-06 4/200 2026-02-07 13:07 by jurkat.1640
[基金申请] 有时候真觉得大城市人没有县城人甚至个体户幸福 +9 苏东坡二世 2026-02-04 10/500 2026-02-07 12:37 by 小毛球
[考博] 天津大学招2026.09的博士生,欢迎大家推荐交流(博导是本人) +4 a793625982 2026-02-05 5/250 2026-02-07 10:57 by a793625982
[公派出国] CSC & MSCA 博洛尼亚大学能源材料课题组博士/博士后招生|MSCA经费充足、排名优 +4 雨念 2026-02-01 6/300 2026-02-06 23:32 by MelissaPon
[基金申请] 面上项目申报 +3 Tide man 2026-02-01 3/150 2026-02-05 22:56 by god_tian
[教师之家] 遇见不省心的家人很难过 +18 otani 2026-02-03 22/1100 2026-02-04 11:06 by tangmnt
信息提示
请填处理意见