Sources Esope | Cast3M

chamat
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