1 : C CHAMAT SOURCE CHAT 05/01/12 21:54:52 5004 2 : SUBROUTINE CHAMAT(A,B,NMAX,NPP,N,ICENT2,C1,C2,DEPS,ICAS, 3 : . IFLU,ICOD,LFLUAG,KERRE) 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8(A-H,O-Z) 6 : DIMENSION A(NMAX,*),B(*) 7 : C 8 : C IFLU = 0 ON FLUE AVEC SIGMA ET ON CALCULE SIGMA FINAL 9 : C IFLU > 0 ON FLUE AVEC SIGMA-X ET ON CALCULE (SIGMA-X) FINAL 10 : C 11 : KERRE=0 12 : IBOU2=N 13 : NP=NPP 14 : IF(NPP.EQ.1) NP=0 15 : NP1=NP+1 16 : IF(ICAS.EQ.2) IBOU2=N/2 17 : DO 32 IC=1,ICAS 18 : IP=(IC-1)*IBOU2 19 : FAC=C1*DEPS 20 : IDEC=1 21 : IOUT=ICENT2 22 : IF(IFLU.EQ.0) GO TO 8 23 : C 24 : 10 FAC=FAC/(1.+FAC) 25 : J1=IDEC*N+1+IP 26 : IF(NP.EQ.0) GO TO 21 27 : DO 1 I=1,NP 28 : IK=I+IP 29 : DO 2 J=I,NP 30 : JK=J+IP 31 : 2 A(IK,JK)=A(IK,JK)+FAC*A(J1,JK) 32 : B(IK)=B(IK)+FAC*B(J1) 33 : 1 J1=J1+1 34 : 21 DO 3 I=NP1,IBOU2 35 : IK=I+IP 36 : A(IK,IK)=A(IK,IK)+FAC*A(J1,IK) 37 : B(IK)=B(IK)+FAC*B(J1) 38 : 3 J1=J1+1 39 : IF(IOUT.EQ.0) GO TO 8 40 : IOUT=0 41 : IDEC=2 42 : FAC=C2*DEPS 43 : GO TO 10 44 : 8 IF(ICOD.EQ.1) GO TO 32 45 : DO 9 I=NP1,IBOU2 46 : IK=I+IP 47 : IF(A(IK,IK).EQ.0.) GO TO 999 48 : 9 B(IK)=B(IK)/A(IK,IK) 49 : IF(NP.EQ.0) GO TO 22 50 : C 51 : C RESOLUTION DE LA MATRICE PLEINE 52 : C 52 : CALL MINV23(A(IP+1,IP+1),B(IP+1),NMAX,NP,KERRE) 53 : IF(KERRE.NE.0) RETURN 54 : 22 IF(LFLUAG.NE.0) GO TO 32 55 : FAC=1.+C1*DEPS 56 : IOUT=ICENT2 57 : IDEC=1 58 : 6 J1=IDEC*N+1+IP 59 : IF(NP.EQ.0) GO TO 23 60 : DO 4 I=1,NP 61 : IK=I+IP 62 : DO 5 J=1,NP 63 : JK=J+IP 64 : 5 B(J1)=B(J1)-A(J1,JK)*B(JK) 65 : B(J1)=B(J1)/FAC 66 : 4 J1=J1+1 67 : 23 DO 7 I=NP1,IBOU2 68 : IK=I+IP 69 : B(J1)=(B(J1)-A(J1,IK)*B(IK))/FAC 70 : 7 J1=J1+1 71 : IF(IOUT.EQ.0) GO TO 32 72 : IOUT=0 73 : IDEC=2 74 : FAC=1.+C2*DEPS 75 : GO TO 6 76 : 32 CONTINUE 77 : RETURN 78 : 999 KERRE=6 79 : RETURN 80 : END 81 :
© Cast3M 2003 - All rights reserved.
Disclaimer