Sources Esope | Cast3M

chole4i
C CHOLE4I   SOURCE    MB234859  26/01/26    21:15:06     12460          
C----------------------------------------------------------------------
C Actualise les termes de la ligne LIGN courante, associee au noeud I,
C en calculant les produits entre blocs de valeurs non nulles avec 
C les lignes associees aux noeuds IMIN a (I-1).
C
C Notations :                                               
C -----------                                               
C   LIGN  : Pointeur sur le segment LIGN associe au noeud I
C   I     : Numero du noeud concerne
C   IMIN  : Numero du noeud associe a la premier valeur non nulle
C           du segment LIGN           
C----------------------------------------------------------------------
      SUBROUTINE CHOLE4I(ITHR)
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
-INC SMMATRI
-INC CCHOLE
-INC CCREEL
-INC CCASSIS
      SEGMENT IMMT(NBLIG)
      POINTEUR LILIGN.MILIGN
      NBO=NBOP(ITHR)
C
      DO 100 JBIB=IL2,IL1,-NBTHR
        JBI=JBIB-ITHR+1
        IF (JBI.GT.IL2) GOTO 100
        IF (JBI.LT.IL1) GOTO 100
        IMJBI=IMMT(JBI)
        IF(IMJBI.GT.IDER) GOTO 100
        LIGN=ILIGN(JBI)
CCC     WRITE(*,*) '++++ CHOLE4I LIGNE=',JBI,'DE',MAX(IM,IPER),'A',IDER
        NBG2=LIGN.IPPVV(2)-1
        kidepb=lcara(1,jbi)-1
        lpl=lcara(2,jbi)-kidepb
        lplc=ivpo(2*(nbg2+1))-1
*  decoupage en rondelle pour optimiser la gestion du cache dans les produits scalaires
        iperi=iper
        iprelj=lcara(2,jbi)
        iderlj=lcara(3,jbi)
        na2=iderlj-iprelj+1
        ngm= 8500/na2
C
        itron=1
        do 300 ironda=1,lplc,ngm
          irondb=min(ironda+ngm-1,lplc)
 310      continue
          if (ivpo(2*(itron+1)).le.ironda) then
            itron=itron+1
            goto 310
          endif
          igt1=itron
          irondi=ironda-ivpo(2*itron)+ivpo(2*itron-1)
 311      continue
          if (ivpo(2*(itron+1)).le.irondb) then
            itron=itron+1
            goto 311
          endif
          igt2=itron
          irondf=irondb-ivpo(2*itron)+ivpo(2*itron-1)
*          if (ithr.eq.1)
*    >     write(6,*) 'ironda irondb irondi irondf',
*    >        ironda,irondb,irondi,irondf
*
          IGD=LIGN.IVPO(2*igt1)              
          do 11 ig=igt1,nbg2-1
C
            if(ipno(ivpo(2*ig-1)+kidepb).gt.ider) goto 300
            IGF=LIGN.IVPO(2*(IG+1))-1
            do 10 j=max(IMJBI,iperi,ipno(lign.ivpo(2*ig-1)+kidepb)),
     >       min(ider,ipno(igf-igd+lign.ivpo(2*ig-1)+kidepb))
 
              iprem=lcara(1,j)
              IPPR=LCARA(2,J)
              IDDR=LCARA(3,J)
*  sauver le nouveau debut                      
              if (iddr.lt.irondf+kidepb) then
                iperi=j+1
              endif
*  test si la ligne touche la rondelle
              if (iddr.lt.irondi+kidepb) then
                goto 10
              endif
 
              IND1=MAX(1,IPPR-KIDEPB)
              IND2=IDDR-KIDEPB
              JND1=MASQA(IND1)
              JND2=MASQA(IND2)
              IMSQ1=IMASQ(JND1)
              IMSQ2=IMASQ(JND2)
              IMSQ=IMSQ1
              IF (IMSQ.EQ.0) THEN
                WRITE(*,*) 'erreur interne chole4i 1'
                CALL ERREUR(5)
              ENDIF
*  test si la ligne correspond a un terme a remplir
              if(jnd2-jnd1.gt.1) then
                WRITE(*,*) 'erreur interne chole4i 2'
                CALL ERREUR(5)
              ENDIF
              if(imsq1.lt.0.and.imsq2.lt.0) goto 10
              IF (IMSQ.LT.0) imsq=-imsq
  18          CONTINUE
              IGD1=LIGN.IVPO(2*IMSQ-1)
              IGF1=LIGN.IVPO(2*(IMSQ+1)-1)-1
              if (igd1.gt.ind2) goto 10
              if (igf1.lt.ind1) then
                imsq=imsq+1
                goto 18 
              endif
*  verif supplementaire avec la rondelle ????
              ird1=max(iprem-kidepb,irondi,1)
              ird2=min(iddr-kidepb,irondf)
              jrd1=masqa(ird1)
              jrd2=masqa(ird2)
*             write(6,*) 'jrd1 jrd2',jrd1,jrd2,iprem,kidepb,irondi
              if (imasq(jrd1).gt.0) goto 12
              jr=-imasq(jrd1)
              js= imasq(jrd2)
              if (jr.le.js) goto 12
              GOTO 10
C
  12          CONTINUE
              LIG1=LILIGN.ILIGN(J)
              NBG1=LIG1.IPPVV(2)-1
              NA1 =IDDR-IPPR+1
              CALL CHOLE4(LIGN.IPREL,NA2,NBG2,LIGN.IVPO(1),LIGN.VAL(1),
     &                 LIGN.IMASQ(1),IGT1,IGT2,
     &                 LIG1.IPREL,NA1,NBG1,LIG1.IVPO(1),LIG1.VAL(1),NBO,
     &                 irondi,irondf)
  10        CONTINUE
            IGD=IGF+1
  11      CONTINUE
  300   CONTINUE
CCC     WRITE(*,*) ' SEGMENT APRES CHOLE4',JBI
CCC     segprt,lign
 100  CONTINUE
      NBOP(ITHR)=NBO
      END