OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sms_fsa_inv.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "sms_c.inc"
#include "task_c.inc"
#include "timeri_c.inc"
#include "units_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine sms_check (timers, nodft, nodlt, iadk, jdik, diag_k, lt_k, iadi, jdii, lt_i, itask, itab, iad_elem, fr_elem, fr_sms, fr_rms, list_sms, list_rms, ams_work)
subroutine sms_fsa_invh (nnzm, iadm, jdim, diag_m, lt_m, nndft0, nndft1, itask, diag_inv)
subroutine get_subsp_sms (iadm, jdim, diag_m, lt_m, nc, iada, jdia, diag_a, lt_a, jm, nndft0, nndft1)
subroutine sms_pcg1 (nddl, iadk, jdik, diag_k, lt_k, r, isp)

Function/Subroutine Documentation

◆ get_subsp_sms()

subroutine get_subsp_sms ( integer, dimension(*) iadm,
integer, dimension(*) jdim,
diag_m,
lt_m,
integer nc,
integer, dimension(*) iada,
integer, dimension(*) jdia,
diag_a,
lt_a,
integer, dimension(*) jm,
integer nndft0,
integer nndft1 )

Definition at line 436 of file sms_fsa_inv.F.

439C-----------------------------------------------
440C I m p l i c i t T y p e s
441C-----------------------------------------------
442#include "implicit_f.inc"
443C-----------------------------------------------
444C D u m m y A r g u m e n t s
445C-----------------------------------------------
446 INTEGER IADM(*), JDIM(*), IADA(*), JDIA(*)
447 INTEGER NC , JM(*), NNDFT0, NNDFT1
448 my_real
449 . lt_a(*),diag_a(*),
450 . diag_m(*) ,lt_m(*)
451C-----------------------------------------------
452C External function
453C-----------------------------------------------
454 INTEGER INTAB0
455 EXTERNAL intab0
456C-----------------------------------------------
457C L o c a l V a r i a b l e s
458C-----------------------------------------------
459 INTEGER I,J,K,JJ,NNZA,N,K0
460C--------------------------------------------
461 nnza=0
462 iada(1)=1
463#include "vectorize.inc"
464 DO i=1,nc
465 j=jm(i)
466C
467 diag_a(i)=diag_m(j)
468 DO k=iadm(j),iadm(j+1)-1
469 jj=jdim(k)
470 n=intab0(nc,jm,jj)
471 IF (n>0) THEN
472 nnza=nnza+1
473 jdia(nnza)=n
474 lt_a(nnza)=lt_m(k)
475 ENDIF
476 ENDDO
477C
478 iada(i+1)=nnza+1
479 ENDDO
480 CALL ind_lt2ln(nc,iada ,jdia ,lt_a, nnza )
481C
482 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
intab0
integer function intab0(nic, ic, n)
Definition imp_fsa_inv.F:509
ind_lt2ln
subroutine ind_lt2ln(nddl, iadk, jdik, lt_k, maxl)
Definition imp_fsa_inv.F:1285

◆ sms_check()

subroutine sms_check ( type(timer_), intent(inout) timers,
integer nodft,
integer nodlt,
integer, dimension(*) iadk,
integer, dimension(*) jdik,
diag_k,
lt_k,
integer, dimension(*) iadi,
integer, dimension(*) jdii,
lt_i,
integer itask,
integer, dimension(*) itab,
integer, dimension(2,*) iad_elem,
integer, dimension(*) fr_elem,
integer, dimension(nspmd+1) fr_sms,
integer, dimension(nspmd+1) fr_rms,
integer, dimension(*) list_sms,
integer, dimension(*) list_rms,
type(ams_work_), intent(inout) ams_work )

Definition at line 44 of file sms_fsa_inv.F.

48C-----------------------------------------------
49C M o d u l e s
50C-----------------------------------------------
51 USE timer_mod
52 USE message_mod
53 USE ams_work_mod
54 USE my_alloc_mod
55C-----------------------------------------------
56C I m p l i c i t T y p e s
57C-----------------------------------------------
58#include "implicit_f.inc"
59C-----------------------------------------------
60C C o m m o n B l o c k s
61C-----------------------------------------------
62#include "com01_c.inc"
63#include "com04_c.inc"
64#include "sms_c.inc"
65#include "task_c.inc"
66#include "timeri_c.inc"
67#include "units_c.inc"
68C-----------------------------------------------
69C D u m m y A r g u m e n t s
70C-----------------------------------------------
71 TYPE(TIMER_), INTENT(INOUT) :: TIMERS
72 INTEGER NODFT, NODLT,
73 . IADK(*), JDIK(*), IADI(*), JDII(*),
74 . ITASK, ITAB(*), IAD_ELEM(2,*), FR_ELEM(*),
75 . FR_SMS(NSPMD+1), FR_RMS(NSPMD+1),
76 . LIST_SMS(*), LIST_RMS(*)
77C REAL
78 my_real
79 . diag_k(*), lt_k(*), lt_i(*)
80
81 TYPE(AMS_WORK_), INTENT(INOUT) :: AMS_WORK
82C-----------------------------------------------
83C L o c a l V a r i a b l e s
84C-----------------------------------------------
85 INTEGER ITAG(NUMNOD)
86C
87 INTEGER I, J, K, L, NOD, IBID, IERR, IMIN,
88 . NNZMFT, NNZMLT
89 my_real
90 . lmin
91 my_real
92 . cs1(2)
93 REAL FLMIN
94C-----------------------------------------------
95 IF(ispmd==0.AND.itask==0)THEN
96 WRITE(istdo,2001)
97 WRITE(iout,2001)
98 END IF
99C machine precision minimum -simple
100 IF(itask==0)THEN
101 CALL floatmin(cs1(1),cs1(2),flmin)
102 p_mach_sms = two*sqrt(flmin)
103 IF (nspmd > 1)CALL spmd_max_s(p_mach_sms)
104 END IF
105C-----------------------------------------------
106C [K]:matrice de masse complete
107C [M]:factorized sparse approximated inverse Lt D L
108C------------------------------------------
109 ams_work%check%NNZM = nnz_sms
110C
111 IF (imon>0.AND.itask==0) CALL startime(timers,32)
112C
113 IF(itask==0)THEN
114 CALL my_alloc(ams_work%CHECK%IADM,numnod+1)
115 CALL my_alloc(ams_work%CHECK%JADM,numnod+1)
116 CALL my_alloc(ams_work%CHECK%KADM,numnod)
117 CALL my_alloc(ams_work%CHECK%ISORTND,numnod)
118 CALL my_alloc(ams_work%CHECK%INVND,numnod)
119 ENDIF
120C ----- approx. (by each colonne of L_T) inverse ---------
121C ----- utilise d'abord la place de [M] pour la matrice assemblee ---------
122 IF (nspmd==1) THEN
123 ams_work%check%NNDFT0=0
124 ams_work%check%NNDFT1=numnod
125C----------------------
126 CALL my_barrier
127C---------------------
128 DO nod=nodft,nodlt
129 ams_work%check%ISORTND(nod)=nod
130 END DO
131 ELSEIF(itask==0)THEN
132 CALL spmd_nndft_sms(
133 1 fr_sms ,fr_rms,list_sms,list_rms,iad_elem,
134 2 fr_elem,ams_work%check%NNDFT0,ams_work%check%NNDFT1,
135 * ams_work%check%ISORTND)
136 ENDIF
137C----------------------
138 CALL my_barrier
139C---------------------
140 DO k=nodft,nodlt
141 nod = ams_work%check%ISORTND(k)
142 ams_work%CHECK%INVND(nod) = k
143 END DO
144C-----
145 DO nod=nodft,nodlt
146 ams_work%check%KADM(nod)=iadk(nod+1)-iadk(nod)
147 END DO
148C----------------------
149 CALL my_barrier
150C---------------------
151 IF(itask==0)THEN
152C
153 IF (nspmd > 1) THEN
154 CALL spmd_nnz_sms(
155 1 fr_sms ,fr_rms,list_sms,list_rms,iad_elem,
156 2 fr_elem,ams_work%check%NNZM ,iadk ,ams_work%CHECK%KADM )
157 END IF
158C
159 CALL my_alloc(ams_work%CHECK%DIAG_M,numnod)
160 CALL my_alloc(ams_work%CHECK%LT_M,ams_work%CHECK%NNZM)
161 CALL my_alloc(ams_work%CHECK%JDIM,ams_work%CHECK%NNZM)
162 CALL my_alloc(ams_work%CHECK%DIAG_INV,numnod)
163 ENDIF
164C---------------------
165 IF(itask==0)THEN
166 ams_work%CHECK%IADM(1)=1
167 DO i=1,numnod
168 ams_work%CHECK%IADM(i+1)=ams_work%CHECK%IADM(i)+ams_work%CHECK%KADM(ams_work%CHECK%ISORTND(i))
169 END DO
170 END IF
171C----------------------
172 CALL my_barrier
173C---------------------
174 nnzmft=itask*ams_work%CHECK%NNZM/nthread+1
175 nnzmlt=(itask+1)*ams_work%CHECK%NNZM/nthread
176 ams_work%CHECK%JDIM(nnzmft:nnzmlt)=0
177C----------------------
178 CALL my_barrier
179C---------------------
180C M triee 1 ... NNDFT0 ... NNDFT1 ... NUMNOD
181 DO i=nodft,nodlt
182 nod=ams_work%CHECK%ISORTND(i)
183 ams_work%CHECK%DIAG_M(i) = diag_k(nod)
184 l=ams_work%CHECK%IADM(i)
185 DO j=iadk(nod),iadk(nod+1)-1
186 k=ams_work%CHECK%INVND(jdik(j))
187 IF(k < i) THEN
188 ams_work%CHECK%JDIM(l)=k
189 ams_work%CHECK%LT_M(l)=lt_k(j)
190 l = l + 1
191 END IF
192 ENDDO
193 ams_work%CHECK%KADM(i)=l
194 ENDDO
195C----------------------
196 CALL my_barrier
197C---------------------
198C M <- termes des processeurs voisins
199 IF (itask == 0 .AND. nspmd > 1) THEN
200 CALL spmd_exchm_sms(
201 1 fr_sms ,fr_rms,list_sms,list_rms,iad_elem,
202 2 fr_elem,iadk ,jdik ,lt_k ,ams_work%CHECK%KADM ,
203 3 ams_work%CHECK%JDIM ,ams_work%CHECK%LT_M ,ams_work%CHECK%INVND )
204 END IF
205C----------------------
206C M compactage
207 IF(itask==0)THEN
208 CALL my_alloc(ams_work%CHECK%LT_M2,ams_work%CHECK%NNZM)
209 CALL my_alloc(ams_work%CHECK%JDIM2,ams_work%CHECK%NNZM)
210 ENDIF
211C----------------------
212 CALL my_barrier
213C---------------------
214 DO i=nodft,nodlt
215 ams_work%CHECK%KADM(i)=0
216 DO k=ams_work%CHECK%IADM(i),ams_work%CHECK%IADM(i+1)-1
217 j = ams_work%CHECK%JDIM(k)
218 IF(j/=0) itag(j) = 0
219 END DO
220 DO k=ams_work%CHECK%IADM(i),ams_work%CHECK%IADM(i+1)-1
221 j = ams_work%CHECK%JDIM(k)
222 IF(j/=0) THEN
223 IF(itag(j)==0)THEN
224 ams_work%CHECK%KADM(i) = ams_work%CHECK%KADM(i) + 1
225 itag(j) = k
226 END IF
227 END IF
228 END DO
229 END DO
230C----------------------
231 CALL my_barrier
232C---------------------
233 IF(itask==0)THEN
234 ams_work%CHECK%JADM(1)=1
235 DO i=1,numnod
236 ams_work%CHECK%JADM(i+1)=ams_work%CHECK%JADM(i)+ams_work%CHECK%KADM(i)
237 END DO
238 END IF
239C----------------------
240 CALL my_barrier
241C---------------------
242 DO i=nodft,nodlt
243 ams_work%CHECK%KADM(i)=ams_work%CHECK%JADM(i)
244 DO k=ams_work%CHECK%IADM(i),ams_work%CHECK%IADM(i+1)-1
245 j = ams_work%CHECK%JDIM(k)
246 IF(j/=0) itag(j) = 0
247 END DO
248 DO k=ams_work%CHECK%IADM(i),ams_work%CHECK%IADM(i+1)-1
249 j = ams_work%CHECK%JDIM(k)
250 IF(j/=0) THEN
251 IF(itag(j)==0)THEN
252 ams_work%CHECK%JDIM2(ams_work%CHECK%KADM(i)) = j
253 ams_work%CHECK%LT_M2(ams_work%CHECK%KADM(i)) = ams_work%CHECK%LT_M(k)
254 itag(j) = ams_work%CHECK%KADM(i)
255 ams_work%CHECK%KADM(i) = ams_work%CHECK%KADM(i) + 1
256 ELSE
257 ams_work%CHECK%LT_M2(itag(j)) = ams_work%CHECK%LT_M2(itag(j)) + ams_work%CHECK%LT_M(k)
258 END IF
259 END IF
260 END DO
261 END DO
262C----------------------
263 CALL my_barrier
264C---------------------
265 CALL sms_fsa_invh(ams_work%CHECK%NNZM ,ams_work%CHECK%JADM ,ams_work%CHECK%JDIM2 ,
266 * ams_work%CHECK%DIAG_M, ams_work%CHECK%LT_M2, ams_work%CHECK%NNDFT0,
267 * ams_work%CHECK%NNDFT1,itask ,ams_work%CHECK%DIAG_INV)
268C----------------------
269 CALL my_barrier
270C---------------------
271 IF (itask == 0) THEN
272C-------
273 DO i=1,ams_work%CHECK%NNDFT0
274 ams_work%CHECK%DIAG_INV(i) = zero
275 ENDDO
276C-------
277 lmin=ep20
278 DO i=ams_work%CHECK%NNDFT0+1,numnod
279 IF(ams_work%CHECK%DIAG_INV(i) < lmin)THEN
280 lmin=ams_work%CHECK%DIAG_INV(i)
281 imin=itab(ams_work%CHECK%ISORTND(i))
282 END IF
283 END DO
284 IF (nspmd > 1) THEN
285 CALL spmd_glob_lmin(lmin,imin)
286 END IF
287C-------
288 IF(ispmd==0.AND.itask==0)THEN
289 IF(lmin<em06)THEN
290 WRITE(istdo,3001) imin,lmin
291 WRITE(iout,3001) imin,lmin
292 ELSE
293 WRITE(istdo,4001)
294 WRITE(iout,4001)
295 END IF
296 END IF
297 END IF
298C
299 IF (imon>0.AND.itask==0) CALL stoptime(timers,32)
300C----------------------
301 CALL my_barrier
302C---------------------
303 IF(itask==0)THEN
304 DEALLOCATE(ams_work%CHECK%IADM)
305 DEALLOCATE(ams_work%CHECK%JADM)
306 DEALLOCATE(ams_work%CHECK%KADM)
307 DEALLOCATE(ams_work%CHECK%ISORTND)
308 DEALLOCATE(ams_work%CHECK%INVND)
309 DEALLOCATE(ams_work%CHECK%DIAG_M)
310 DEALLOCATE(ams_work%CHECK%LT_M)
311 dEALLOCATE(ams_work%CHECK%JDIM)
312 DEALLOCATE(ams_work%CHECK%LT_M2)
313 DEALLOCATE(ams_work%CHECK%JDIM2)
314 DEALLOCATE(ams_work%CHECK%DIAG_INV)
315 END IF
316C--------------------------------------------
317 2001 FORMAT(' ... RUNNING DIAGNOSIS')
318 3001 FORMAT(
319 .' ** WARNING : RADIOSS DETECTED A SEVERE ISSUE',/
320 .' PLEASE CHECK THE MODEL, ESPECIALLY KINEMATIC CONDITIONS',/
321 .' ISSUE MAY OCCUR NEARBY OR ON ENTITY LINKED ',/
322 .' TO NODE ID =',i10/
323 .' (MINIMUM DIAGONAL TERM OF FSAI = ',1pg20.14,')')
324 4001 FORMAT(' ** INFO : COULD NOT IDENTIFY THE ISSUE')
325 RETURN
spmd_max_s
subroutine spmd_max_s(s)
Definition imp_spmd.F:1195
message_mod
Definition message_mod.F:1249
floatmin
void floatmin(int *a, int *b, float *flm)
Definition precision.c:71
sms_fsa_invh
subroutine sms_fsa_invh(nnzm, iadm, jdim, diag_m, lt_m, nndft0, nndft1, itask, diag_inv)
Definition sms_fsa_inv.F:344
spmd_nndft_sms
subroutine spmd_nndft_sms(fr_sms, fr_rms, list_sms, list_rms, iad_elem, fr_elem, nndft0, nndft1, isortnd)
Definition spmd_sms.F:686
spmd_glob_lmin
subroutine spmd_glob_lmin(lmin, imin)
Definition spmd_sms.F:555
spmd_nnz_sms
subroutine spmd_nnz_sms(fr_sms, fr_rms, list_sms, list_rms, iad_elem, fr_elem, nnzm, iadk, kadm)
Definition spmd_sms.F:784
spmd_exchm_sms
subroutine spmd_exchm_sms(fr_sms, fr_rms, list_sms, list_rms, iad_elem, fr_elem, iadk, jdik, lt_k, kadm, jdim, lt_m, invnd)
Definition spmd_sms.F:924
my_barrier
subroutine my_barrier
Definition machine.F:31
startime
subroutine startime(event, itask)
Definition timer.F:93
stoptime
subroutine stoptime(event, itask)
Definition timer.F:135

◆ sms_fsa_invh()

subroutine sms_fsa_invh ( integer nnzm,
integer, dimension(*) iadm,
integer, dimension(*) jdim,
diag_m,
lt_m,
integer nndft0,
integer nndft1,
integer itask,
diag_inv )

Definition at line 342 of file sms_fsa_inv.F.

344C-----------------------------------------------
345C M o d u l e s
346C-----------------------------------------------
347 USE message_mod
348C-----------------------------------------------
349C I m p l i c i t T y p e s
350C-----------------------------------------------
351#include "implicit_f.inc"
352#include "comlock.inc"
353C-----------------------------------------------
354C C o m m o n B l o c k s
355C-----------------------------------------------
356#include "com04_c.inc"
357C-----------------------------------------------
358C D u m m y A r g u m e n t s
359C-----------------------------------------------
360 INTEGER NNZM , IADM(*), JDIM(*),
361 . NNDFT0 ,NNDFT1,ITASK
362C REAL
363 my_real
364 . diag_m(*), lt_m(*), diag_inv(*)
365C-----------------------------------------------
366C L o c a l V a r i a b l e s
367C-----------------------------------------------
368C--- M->A^-1 LT_M strictly lower in m.c.r.s. format
369 INTEGER I,J,K,M,N,NC,MAX_L,IERR,I_CHK,IER1,
370 . JM(NUMNOD+1)
371 INTEGER, DIMENSION(:),ALLOCATABLE :: IADA, JDIA
372 my_real,
373 . DIMENSION(:),ALLOCATABLE :: diag_a, lt_a, mj
374C-----------------------------
375 IF ((nndft0+1)>numnod) RETURN
376C
377 ALLOCATE(iada(numnod+1),diag_a(numnod),mj(numnod),stat=ier1)
378 ALLOCATE(lt_a(nnzm),jdia(nnzm),stat=ierr)
379
380 IF ((ierr+ier1)/=0) THEN
381 CALL ancmsg(msgid=19,anmode=aninfo,
382 . c1='FOR FSAI')
383 CALL arret(2)
384 ENDIF
385C
386C Boucle parallele dynamique SMP
387C
388!$OMP DO SCHEDULE(DYNAMIC,1)
389 DO i=nndft0+1,numnod
390
391 IF(diag_m(i)==zero) THEN
392 diag_inv(i)=ep20
393 cycle
394 END IF
395
396 CALL sp_stat0(i ,iadm ,jdim ,nc ,jm )
397 CALL get_subsp_sms(iadm ,jdim ,diag_m ,lt_m ,nc ,
398 . iada ,jdia ,diag_a ,lt_a ,jm ,
399 . nndft0,nndft1)
400 DO j=1,nc-1
401 mj(j)=zero
402 ENDDO
403 mj(nc)=one
404C
405 IF (nc>10000) THEN
406 CALL sms_pcg1(nc ,iada ,jdia ,diag_a ,lt_a ,
407 2 mj ,ierr )
408C
409 ELSE
410C
411 max_l=1+(nc*(nc-1))/2
412 CALL imp_fsai(nc ,iada ,jdia ,diag_a ,lt_a ,
413 . max_l ,mj )
414C
415 ENDIF
416C------------filtrage----Diagonal est dans LT_M (last one)--
417 diag_inv(i)=mj(nc)
418 ENDDO
419
420!$OMP END DO
421C
422 DEALLOCATE(iada,diag_a,mj)
423 DEALLOCATE(lt_a,jdia)
424C
425 RETURN
sp_stat0
subroutine sp_stat0(il, iadk, jdik, nc, jm)
Definition imp_fsa_inv.F:35
imp_fsai
subroutine imp_fsai(n, iada, jdia, diag_a, lt_a, maxa, mj)
Definition imp_fsa_inv.F:267
sms_pcg1
subroutine sms_pcg1(nddl, iadk, jdik, diag_k, lt_k, r, isp)
Definition sms_fsa_inv.F:495
get_subsp_sms
subroutine get_subsp_sms(iadm, jdim, diag_m, lt_m, nc, iada, jdia, diag_a, lt_a, jm, nndft0, nndft1)
Definition sms_fsa_inv.F:439
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
arret
subroutine arret(nn)
Definition arret.F:87

◆ sms_pcg1()

subroutine sms_pcg1 ( integer nddl,
integer, dimension(*) iadk,
integer, dimension(*) jdik,
diag_k,
lt_k,
r,
integer isp )

Definition at line 492 of file sms_fsa_inv.F.

495C-----------------------------------------------
496C I m p l i c i t T y p e s
497C-----------------------------------------------
498#include "implicit_f.inc"
499C-----------------------------------------------
500#include "sms_c.inc"
501C-----------------------------------------------
502C D u m m y A r g u m e n t s
503C-----------------------------------------------
504C----------resol [K]{X}={F}, K stored as diagonal + lt ---------
505 INTEGER NDDL ,IADK(*) ,JDIK(*)
506C REAL
507 my_real
508 . diag_k(*), lt_k(*) , r(*)
509C-----------------------------------------------
510C L o c a l V a r i a b l e s
511C-----------------------------------------------
512 INTEGER I,J,IT,IP,NLIM,ND,ISTOP,ISP,IBID
513 my_real
514 . s , r2, r02, alpha, beta, g0, g1, rr, tols, toln, tols2
515 my_real
516 . x(nddl) ,p(nddl) ,z(nddl) ,y(nddl),diag_m(nddl)
517 my_real
518 . eps_m
519C--------------INITIALISATION--------------------------
520 nlim=max(nddl,2)
521
522 tols=sqrt(p_mach_sms)
523 eps_m = p_mach_sms
524
525 it=0
526C-------------IT=0--------
527C------X(I)=ZERO--------
528 DO i=1,nddl
529 x(i) = zero
530 diag_m(i)=one/max(em20,diag_k(i))
531 ENDDO
532 CALL mav_lt(
533 1 nddl ,ibid ,iadk ,jdik ,diag_k,
534 2 lt_k ,x ,z )
535 DO i=1,nddl
536 r(i) = r(i)-z(i)
537 ENDDO
538 DO i=1,nddl
539 z(i) = r(i) *diag_m(i)
540 ENDDO
541 DO i=1,nddl
542 p(i) = z(i)
543 ENDDO
544 CALL produt_v0(nddl,r,z,g0)
545 CALL mav_lt(
546 1 nddl ,ibid ,iadk ,jdik ,diag_k,
547 2 lt_k ,p ,y )
548 CALL produt_v0(nddl,p,y,s)
549 alpha = g0/s
550 tols2=tols*tols
551
552 CALL produt_v0(nddl,r,r,r02)
553 r2 =r02
554 IF (r02==zero) GOTO 200
555 toln=r02*tols2
556C-------pour etre coherent avec lanzos for linear
557 it=1
558 DO i=1,nddl
559 x(i) = x(i) + alpha*p(i)
560 r(i) = r(i) - alpha*y(i)
561 ENDDO
562 DO i=1,nddl
563 z(i) = r(i) *diag_m(i)
564 ENDDO
565 CALL produt_v0(nddl,r,z,g1)
566 beta=g1/g0
567 CALL produt_v0(nddl,r,r,r2)
568C
569 g0 = g1
570
571 IF (it>=nlim) THEN
572 istop = 0
573 ELSEIF (r2<=toln) THEN
574 istop = 0
575 ELSE
576 istop = 1
577 ENDIF
578
579 DO WHILE (istop==1)
580 DO i=1,nddl
581 p(i) = z(i) + beta*p(i)
582 ENDDO
583 CALL mav_lt(
584 1 nddl ,ibid ,iadk ,jdik ,diag_k,
585 2 lt_k ,p ,y )
586 CALL produt_v0(nddl,p,y,s)
587 alpha=g0/s
588 DO i=1,nddl
589 x(i) = x(i) + alpha*p(i)
590 r(i) = r(i) - alpha*y(i)
591 ENDDO
592 DO i=1,nddl
593 z(i) = r(i) *diag_m(i)
594 ENDDO
595 CALL produt_v0(nddl,r,z,g1)
596 beta=g1/g0
597 g0 = g1
598 CALL produt_v0(nddl,r,r,r2)
599
600 IF (it>=nlim) THEN
601 istop = 0
602 ELSEIF (r2<=toln) THEN
603 istop = 0
604 ELSE
605 istop = 1
606 ENDIF
607
608 it = it +1
609 ENDDO
610 200 CONTINUE
611 IF(it>=nlim)THEN
612 isp =-1
613 ELSE
614 isp = 0
615 ENDIF
616C RR = SQRT(R2/R02)
617C WRITE(*,1002)IT,RR
618C--------X->R--------
619 DO i=1,nddl
620 r(i) = x(i)
621 ENDDO
622C--------------------------------------------
623 1002 FORMAT(3x,'TOTAL C.G. ITERATION=',i8,5x,
624 . ' RELATIVE RESIDUAL NORM=',e11.4)
625 1003 FORMAT(5x,
626 . '---WARNING : THE ITERATION LIMIT NUMBER WAS REACHED',
627 . 1x,'IN FSAI')
628 RETURN
alpha
#define alpha
Definition eval.h:35
max
#define max(a, b)
Definition macros.h:21
produt_v0
subroutine produt_v0(nddl, x, y, r)
Definition produt_v.F:944
mav_lt
subroutine mav_lt(nddl, nnz, iadl, jdil, diag_k, lt_k, v, w)
Definition produt_v.F:340