Télécharger la plaquette Cast3M


fr en

Télécharger minv3d.eso

Retour à la liste

Numérotation des lignes : 

minv3d

  1. C MINV3D    SOURCE    PV090527  23/01/27    21:15:52     11574          
  2.         SUBROUTINE MINV3D(ngf,A,AI,B,X,IPZERO,n,err1,affiche)
  3.  
  4. c       inverse d une matrice carree
  5. c   ************************************************************************
  6.        implicit real*8 (a-h,o-z)
  7.        implicit integer (i-n)
  8.  
  9.        integer ngf,n,err1
  10.        real*8 a(ngf,ngf+1),b(ngf),x(ngf),ai(ngf,ngf+1)
  11.        integer ipzero(ngf)
  12.        logical affiche
  13.  
  14.        integer i,j
  15.        real*8 test
  16.        logical verif,affiche_local
  17.  
  18.        affiche_local=affiche
  19.  
  20.        if (affiche_local) then
  21.             print*,'On est dans minv3d'
  22.             verif=.true.
  23.        else
  24.             verif=.false.
  25.        end if            
  26.  
  27.  
  28.        do i=1,n
  29. c           second membre        
  30.             do j=1,n
  31.                 if(j.eq.i) then
  32.                     b(j)=1.d0
  33.                 else
  34.                     b(j)=0.d0
  35.                 end if
  36.             end do
  37.  
  38. c           calcul colonne i            
  39.             call gaus3d(n,a,x,b,ngf,err1,ipzero)
  40.  
  41. c           placement colonne i dans ai            
  42.             if(err1.ne.1) then
  43.                 do j=1,n
  44.                     ai(j,i)=x(j)
  45.                 end do
  46.             else
  47.                 print*,'Pb d inversion de A dans Matinv3d'
  48.                 return
  49.             end if
  50.  
  51.        end do
  52.  
  53. c      verif
  54.        if(verif.or.affiche) then
  55.             do i=1,n
  56.                 do j=1,n
  57.                     test=0.d0
  58.                     do k=1,n
  59.                         test=test+a(i,k)*ai(k,j)
  60.                     end do
  61.                     write(*,'(1x,e10.3)',advance='no') test 
  62.                 end do
  63.                 write(*,'(1X,A9,I3)') 'fin ligne',i  
  64.             end do
  65.        end if
  66.  
  67.        RETURN
  68.        END
  69. C **********************************************************************
  70.  
  71.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales