Télécharger la plaquette Cast3M


fr en

Télécharger shole3i.eso

Retour à la liste

Numérotation des lignes : 

shole3i

  1. C SHOLE3I   SOURCE    MB234859  26/01/26    21:15:14     12460          
  2. C----------------------------------------------------------------------
  3. C     Construire le squelette d'une LIGN
  4. C
  5. C Entrees :                                                 
  6. C ---------                                                 
  7. C   LIGN  : Pointeur sur le segment LIGN associe au noeud I
  8. C   I     : Numero du noeud concerne
  9. C   IMIN  : Numero du noeud associe a la premier valeur non nulle
  10. C           du segment LIGN           
  11. C           
  12. C Sortie  :                                                 
  13. C ---------                                                 
  14. C   LIGN  : Pointeur sur le segment LIGN associe au noeud I ou le
  15. C           tableau VAL a ete actualise
  16. C----------------------------------------------------------------------
  17.       SUBROUTINE SHOLE3I(ITHR)
  18. C
  19.       IMPLICIT INTEGER(I-N)
  20.       IMPLICIT REAL*8 (A-H,O-Z)
  21. -INC SMMATRI
  22. -INC CCHOLE
  23.       POINTEUR LILIGN.MILIGN
  24.       SEGMENT IMMT(NBLIG)
  25. C
  26.       DO 100 JBIB=IL2,IL1,-NBTHR
  27.         JBI=JBIB-ITHR+1
  28.         IF (JBI.GT.IL2) GOTO 100
  29.         IF (JBI.LT.IL1) GOTO 100
  30.         LIGN=LILIGN.ILIGN(JBI)
  31.         LPL=IPPVV(2)-IPPVV(1)
  32.         KIDEPB=IPREL-LPL
  33. C       kidep : dernier terme non nul avant le terme courant de la ligne lign
  34.         KIDEPN=IVPO(1)
  35.         KIDEP=KIDEPB+KIDEPN
  36. C       WRITE(*,*)'LIGNE',JBI,KIDEP,KIDEPB,KIDEPN,IPPVV(2),IPPVV(1),LPL
  37.         DO 10 J=MAX(IPER,IMMT(JBI)),IDER
  38.           IPPR=LCARA(2,J)
  39.           IDDR=LCARA(3,J)
  40. CC        WRITE(*,*) 'LIGNE ',J,LCARA(1,J),KIDEP,KIDEPB,IPPR,IDDR,MASDIM
  41.           IF (IDDR.LT.KIDEPB) GOTO 10
  42.           IF (KIDEP.LT.LCARA(1,J)) THEN
  43.             IMSQ=IMASQ(MASQA(IPPR-KIDEPB))
  44.             IF (IMSQ.EQ.0) THEN
  45.               WRITE(*,*) 'erreur interne shole3i'
  46.               CALL ERREUR(5) 
  47.             ENDIF
  48.             IF (IMSQ.LT.0) THEN
  49.               IDEB=-IMSQ
  50.             ELSE
  51.               IDEB=MASQB(IMSQ)+MASQD(IPPR-KIDEPB)-1
  52.             ENDIF 
  53.             IF (IDEB.GT.(IDDR-KIDEPB)) GOTO 10
  54.           ENDIF
  55.           LIG1=MILIGN.ILIGN(J)
  56.           NBG1=LIG1.IPPVV(2)-1
  57.           CALL SHOLE3(IPREL,IDERL,LPL,KIDEPN,IMASQ(1),
  58.      &                IPPR ,IDDR ,NBG1,LIG1.IVPO(1))
  59.           LIGN.IVPO(1)=KIDEPN
  60.           KIDEP=KIDEPB+KIDEPN
  61.   10    CONTINUE
  62. C       WRITE(*,*)'SHOLE3I LIGNE=',JBI,'DE',IPER,'A',IDER,J,NBG1,KIDEPN
  63. C       segprt,lign
  64.   100 CONTINUE
  65.       END
  66.  
  67.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales