Sources Esope | Cast3M

shole3i
C SHOLE3I   SOURCE    PV090527  26/01/30    21:15:34     12465          
C----------------------------------------------------------------------
C     Construire le squelette d'une LIGN
C
C Entrees :                                                 
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           
C Sortie  :                                                 
C ---------                                                 
C   LIGN  : Pointeur sur le segment LIGN associe au noeud I ou le
C           tableau VAL a ete actualise
C----------------------------------------------------------------------
      SUBROUTINE SHOLE3I(ITHR)
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
-INC SMMATRI
-INC CCHOLE
      POINTEUR LILIGN.MILIGN
      SEGMENT IMMT(NBLIG)
      segment iligns(nnoe)
C
      DO 100 JBIB=IL2,IL1,-NBTHR
        JBI=JBIB-ITHR+1
        IF (JBI.GT.IL2) GOTO 100
        IF (JBI.LT.IL1) GOTO 100
        LIGN=LILIGN.ILIGN(JBI)
        LPL=IPPVV(2)-IPPVV(1)
        KIDEPB=IPREL-LPL
C       kidep : dernier terme non nul avant le terme courant de la ligne lign
        KIDEPN=IVPO(1)
        KIDEP=KIDEPB+KIDEPN
C       WRITE(*,*)'LIGNE',JBI,KIDEP,KIDEPB,KIDEPN,IPPVV(2),IPPVV(1),LPL
        DO 10 J=MAX(IPER,IMMT(JBI)),IDER
          IPPR=LCARA(2,J)
          IDDR=LCARA(3,J)
CC        WRITE(*,*) 'LIGNE ',J,LCARA(1,J),KIDEP,KIDEPB,IPPR,IDDR,MASDIM
          IF (IDDR.LT.KIDEPB) GOTO 10
          IF (KIDEP.LT.LCARA(1,J)) THEN
            IMSQ=IMASQ(MASQA(IPPR-KIDEPB))
            IF (IMSQ.EQ.0) THEN
              WRITE(*,*) 'erreur interne shole3i'
              CALL ERREUR(5) 
            ENDIF
            IF (IMSQ.LT.0) THEN
              IDEB=-IMSQ
            ELSE
              IDEB=MASQB(IMSQ)+MASQD(IPPR-KIDEPB)-1
            ENDIF 
            IF (IDEB.GT.(IDDR-KIDEPB)) GOTO 10
          ENDIF
          LIG1=iligns(J)
          if (lig1.eq.0) lig1=milign.ilign(j)
          NBG1=LIG1.IPPVV(2)-1
          CALL SHOLE3(IPREL,IDERL,LPL,KIDEPN,IMASQ(1),
     &                IPPR ,IDDR ,NBG1,LIG1.IVPO(1))
          LIGN.IVPO(1)=KIDEPN
          KIDEP=KIDEPB+KIDEPN
  10    CONTINUE
C       WRITE(*,*)'SHOLE3I LIGNE=',JBI,'DE',IPER,'A',IDER,J,NBG1,KIDEPN
C       segprt,lign
  100 CONTINUE
      END