C CHAMAT SOURCE CHAT 05/01/12 21:54:52 5004 SUBROUTINE CHAMAT(A,B,NMAX,NPP,N,ICENT2,C1,C2,DEPS,ICAS, . IFLU,ICOD,LFLUAG,KERRE) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) DIMENSION A(NMAX,*),B(*) C C IFLU = 0 ON FLUE AVEC SIGMA ET ON CALCULE SIGMA FINAL C IFLU > 0 ON FLUE AVEC SIGMA-X ET ON CALCULE (SIGMA-X) FINAL C KERRE=0 IBOU2=N NP=NPP IF(NPP.EQ.1) NP=0 NP1=NP+1 IF(ICAS.EQ.2) IBOU2=N/2 DO 32 IC=1,ICAS IP=(IC-1)*IBOU2 FAC=C1*DEPS IDEC=1 IOUT=ICENT2 IF(IFLU.EQ.0) GO TO 8 C 10 FAC=FAC/(1.+FAC) J1=IDEC*N+1+IP IF(NP.EQ.0) GO TO 21 DO 1 I=1,NP IK=I+IP DO 2 J=I,NP JK=J+IP 2 A(IK,JK)=A(IK,JK)+FAC*A(J1,JK) B(IK)=B(IK)+FAC*B(J1) 1 J1=J1+1 21 DO 3 I=NP1,IBOU2 IK=I+IP A(IK,IK)=A(IK,IK)+FAC*A(J1,IK) B(IK)=B(IK)+FAC*B(J1) 3 J1=J1+1 IF(IOUT.EQ.0) GO TO 8 IOUT=0 IDEC=2 FAC=C2*DEPS GO TO 10 8 IF(ICOD.EQ.1) GO TO 32 DO 9 I=NP1,IBOU2 IK=I+IP IF(A(IK,IK).EQ.0.) GO TO 999 9 B(IK)=B(IK)/A(IK,IK) IF(NP.EQ.0) GO TO 22 C C RESOLUTION DE LA MATRICE PLEINE C CALL MINV23(A(IP+1,IP+1),B(IP+1),NMAX,NP,KERRE) IF(KERRE.NE.0) RETURN 22 IF(LFLUAG.NE.0) GO TO 32 FAC=1.+C1*DEPS IOUT=ICENT2 IDEC=1 6 J1=IDEC*N+1+IP IF(NP.EQ.0) GO TO 23 DO 4 I=1,NP IK=I+IP DO 5 J=1,NP JK=J+IP 5 B(J1)=B(J1)-A(J1,JK)*B(JK) B(J1)=B(J1)/FAC 4 J1=J1+1 23 DO 7 I=NP1,IBOU2 IK=I+IP B(J1)=(B(J1)-A(J1,IK)*B(IK))/FAC 7 J1=J1+1 IF(IOUT.EQ.0) GO TO 32 IOUT=0 IDEC=2 FAC=1.+C2*DEPS GO TO 6 32 CONTINUE RETURN 999 KERRE=6 RETURN END