Sources Esope | Cast3M

chole5
C CHOLE5    SOURCE    MB234859  26/01/26    21:15:07     12460          
C----------------------------------------------------------------------
C         Finaliser les lignes inconnues du noeud courant LIGN
C
C Entrees :                                                 
C ---------                                                 
C   LIG5 : Pointeur sur segment LIGN a traiter.
C   IDDL : Numero de l'inconnue du noeud courant que l'on traite
C   DAAG : Tableau contenant pour chaque ddl la valeur de l'inverse du 
C          terme diagonal
C   NCOL : Nombre de colonne sur lesquelles s'etend le premier ddl du
C          noeud courant
C                                                           
C Sortie  :                                                 
C ---------                                                 
C   LIG5 : Pointeur sur segment LIGN finalise              
C----------------------------------------------------------------------
      FUNCTION CHOLE5(LIG5,IDDL,DAAG,NCOL)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
-INC SMMATRI
-INC SMRIGID
-INC CCHOLE
-INC CCREEL
      POINTEUR LIG5.LIGN
      DIMENSION DAAG(*)
C
      xmatri=matric
      nbnnma=nbnnmc
C
C     Debut et fin des blocs de valeurs pour l'inconnue IDDL
      IDEBB=LIG5.IPPVV(IDDL)
      IFINB=LIG5.IPPVV(IDDL+1)
      NBLOC=IFINB-IDEBB
      ICDEB1=LIG5.IVPO(2*IDEBB-1)
C
C     Colonne a partir de laquelle sont remplies les valeurs
      ICOL=LIG5.IPREL-NCOL+1
      INMA=NBNNMA-ICOL+1
C
C     Colonne du terme diagonal pour l'inconnue IDDL
      IDIA=LIG5.IPREL-1+IDDL
C
      IF (IDDL.EQ.1) GOTO 13
C
C     Completer les termes manquants pour l'inconnue courante
      IDEBV=LIG5.IVPO(2*(IFINB-1))
      IIND1=IDIA-NBNNMA
      DO 10 IDDLJ=1,IDDL-1
        IDDL1=LIG5.IPPVV(IDDLJ)
        IDDL2=LIG5.IPPVV(IDDL)
        IVALJ=IDEBV+IDDLJ-1
        IIND2=LIG5.IPREL+IDDLJ-1-NBNNMA
        P=0.D0
        DO 11 IT2=1,NBLOC
          IPOS1=LIG5.IVPO(2*IDDL1)
          IPOS2=LIG5.IVPO(2*(IDDL1+1))
          LOND=IPOS2-IPOS1
          ICDEB=LIG5.IVPO(2*IDDL2-1)
          IF (ICDEB-ICDEB1+1.GT.INMA) GOTO 11
          ICFIN=ICDEB-ICDEB1+LOND
          LOND=MIN(LOND,LOND-ICFIN+INMA)
          IF (IT2.EQ.NBLOC) LOND=LOND-1
          IF (LOND.LE.0) GOTO 11
          IPOS2=LIG5.IVPO(2*IDDL2)
          IF (IPOS2.EQ.IVALJ) GOTO 11
          P=P+DDOTPV(LOND,LIG5.VAL(IPOS1),LIG5.VAL(IPOS2))
          IDDL1=IDDL1+1
          IDDL2=IDDL2+1
 11     CONTINUE
C       WRITE(*,*) 'P=',P,LIG5.VAL(IVALJ),(LIG5.VAL(IVALJ)-P)
        LIG5.VAL(IVALJ)=LIG5.VAL(IVALJ)-P
        IF (XMATRI.NE.0.AND.IIND1.GE.1.AND.IIND2.GE.1) THEN
          RE(IIND1,IIND2,1)=LIG5.VAL(IVALJ)
          RE(IIND2,IIND1,1)=LIG5.VAL(IVALJ)
        ENDIF
 10   CONTINUE
C
 13   CONTINUE
C
C     Diviser chaque terme par la valeur du terme diagonal
      VALD=0.D0
      DO 1 IBL=IDEBB,IFINB-1
        IVDEB=LIG5.IVPO(2*IBL)
        IVFIN=LIG5.IVPO(2*(IBL+1))-1
        ICDEB=LIG5.IVPO(2*IBL-1)
        JCOL=ICOL+ICDEB-ICDEB1
CCC     IF (JCOL.GT.NBNNMA) GOTO 1
        JCOLV=JCOL-IVDEB
        ICFI2=MIN(JCOL+IVFIN-IVDEB+1,NBNNMA)
        IVFI2=MIN(IVFIN,IVDEB+ICFI2-JCOL)
        IF (JCOLV+IVFI2.EQ.IDIA) IVFI2=IVFI2-1
        DO 2 IV1=IVDEB,IVFI2
          VALK=LIG5.VAL(IV1)
C         WRITE(*,*)'VALK', VALK,DAAG(JCOL)
          IF (VALK.EQ.0) GOTO 4
          AUX=VALK*DAAG(JCOLV+IV1)
          VALD=VALD+(AUX*VALK)
          LIG5.VAL(IV1)=AUX
 4        CONTINUE
 2      CONTINUE
 1    CONTINUE
C
C     Terme diagonal
      CHOLE5=-VALD
      END