Bonjour à tous,

Voila cela fait un moment que j’essaye de convertir le code suivant en VB mais là je commence à m’arracher les cheveux, je ne comprend plus ( je découvre Fortran!).
En faite? tout ce passe plutôt bien jusqu’à l’appelle de fonction "dot()" qui permet de faire un simple produit de vecteur!
Mais je comprend pas comment il fait pour boucler avec an() qu'il dimensionne à 1?
et l'or de l’appelle il a en paramètre un valeur au lieu d'un vecteur?


voila le bout de code qui me désespère:
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
	real*8 function dot(an,bn,n)
C
C     CALCUL DU PRODUIT DES VECTEURS AN ET BN
C
	implicit none
	integer*4 i,n
      real*8 an(1),bn(1)
C
      dot=0.0
	do i=1,n
		dot=dot+an(i)*bn(i)
	enddo
 
C
      return
	end
Si par bonheur vous pouviez m’éclairer de vos lumières ça me sortirait des ténèbres Fortran!

Par avance merci de votre aide.


Le code de l'ensemble:

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
	subroutine activecol (neq,jdiag,an,bn,nrhs)
C
      implicit none
C
C
      integer*4 neq,nrhs
	integer*4 jdiag(0:*)
	real*8 an(*),bn(*)
	real*8 oa , ob , diag
      allocatable oa(:),ob(:),diag(:)
 
	integer*4 jr,i,ii,k,iad,j,lac,jd,jh,is,ie,id,ih,ir,jad
	real*8 dot,d,rhsmax
C
C     RESOLUTION DE AN SOUS LA FORME AN=UT*D*U,REDUCTION DE BN
C
 
        allocate ( diag(neq),ob(neq*nrhs),oa(jdiag(neq)))
 
      jr=0
c
c	Conditionnement de la matrice AN ( diagonale a 1 )
c
 
      do i=1,neq
		ii = jdiag(i)
		diag(i) = sqrt(abs(an(ii)))
      	do k=1,nrhs
			iad=(k-1)*neq+i
			ob(iad)=bn(iad)
		enddo
	enddo
 
 
      do i=1,jdiag(neq)
              oa(i)=an(i)
      enddo
 
      do i=1,neq
      	ii = jdiag(i)
		do k=1,nrhs
			bn(i+(k-1)*neq)=bn(i+(k-1)*neq)/diag(i)
		enddo
		j=0
		if (i.ne.1) j=jdiag(i-1)
		j=j+1
		do k=j,ii
			lac=i+k-ii
			an(k) = an(k)/(diag(i)*diag(lac))
		enddo
	enddo
 
c
c	Fin du conditionnement - Debut de la factorisation Ut*D*U
c
	do j=1,neq
     		jd=jdiag(j)
		jh=jd-jr
		is=j-jh+2
		if (jh.gt.2) then
			ie = j-1
			k = jr+2
			id = jdiag(is-1)
 
C     REDUCTION DES COEFFICIENTS NON DIAGONAUX
 
			do i=is,ie
				ir=id
				id=jdiag(i)
				ih=min(id-ir-1,i-is+1)
				if(ih.gt.0) an(k) = an(k)-dot(an(k-ih),an(id-ih),ih)
				k=k+1
			enddo
		endif	
 
C     REDUCTION DES COEFFICIENTS DIAGONAUX
 
		if(jh.ge.2) then
			ir=jr+1
			ie=jd-1
			k=j-jd
			do i=ir,ie
				id=jdiag(k+i)
				if (abs(an(id)).le.1.d-10) then
					print *,'Systeme singulier - ligne =',j
				endif
				d=an(i)
				an(i)=an(i)/an(id)
				an(jd)=an(jd)-d*an(i)
			enddo
 
C     REDUCTION DU SECOND MEMBRE
 
			do iad=1,nrhs
				bn(j+(iad-1)*neq)=bn(j+(iad-1)*neq)
     &                  -dot(an(jr+1),bn(is-1+(iad-1)*neq),jh-1)
			enddo
		endif
		jr=jd
	enddo
 
C     DIVISION PAR LES PIVOTS DIAGONAUX
 
	do i=1,neq
		id=jdiag(i)
		if (abs(an(id)).gt.1.d-10) then
			do iad=1,nrhs
				bn(i+(iad-1)*neq)=bn(i+(iad-1)*neq)/an(id)
			enddo
		endif
	enddo
 
c        print 812,(an(jdiag(id)),id=1,neq)
c812     format('Pivots de resolution :',10f7.4,/,10(1x,13f7.4,/))
 
C     SUBSTITUTION ARRIERE
 
        do iad=1,nrhs
          j=neq
          jd=jdiag(j)
 
		do ii=1,neq
			d=bn(j+(iad-1)*neq)
			j=j-1
			jr=jdiag(j)
			if((jd-jr).gt.1) then
				is=j-jd+jr+2
				k=jr-is+1
				do i=is,j
					bn(i+(iad-1)*neq)=bn(i+(iad-1)*neq)-an(i+k)*d
				enddo
			endif
			jd=jr
		enddo
 
          do i=1,neq
			bn(i+(iad-1)*neq)=bn(i+(iad-1)*neq)/diag(i)
		enddo
 
        enddo
c
c       Verifications
c
          rhsmax=0.d0
          do iad=1,nrhs
            jad=(iad-1)*neq
            do i=1,neq
 
                do j=jdiag(i-1)+1,jdiag(i)
                k=i-jdiag(i)+j
 
                ob(i+jad)=ob(i+jad)-oa(j)*bn(k+jad)
                enddo
 
                if(i.lt.neq)then
 
                do j=i+1,neq
                k=jdiag(j)-j+i
                if(k.gt.jdiag(j-1)) then
                ob(i+jad)=ob(i+jad)-oa(k)*bn(j+jad)
                endif
                enddo
 
                endif
 
                rhsmax=max(rhsmax,abs(ob(i+jad)))
        enddo
c        if(rhsmax.ge.1.d-07) then
c        print *,'Precision ',rhsmax,' RHS ',iad
c        endif
 
        enddo
 
	do i=1,jdiag(neq)
		an(i) = oa(i)
	enddo
 
        deallocate (diag,ob,oa)
	return
	end
 
	real*8 function dot(an,bn,n)
C
C     CALCUL DU PRODUIT DES VECTEURS AN ET BN
C
	implicit none
	integer*4 i,n
      real*8 an(1),bn(1)
C
      dot=0.0
	do i=1,n
		dot=dot+an(i)*bn(i)
	enddo
 
C
      return
	end