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/04/08    21:15:02     12509          
  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.       SEGMENT IMMT(NBLIG)
  24.       SEGMENT ILR
  25.         integer ILIGR(NNOE)
  26.       ENDSEGMENT
  27.       POINTEUR ILIGNS.ILR
  28. C
  29.       DO 100 JBIB=IL2,IL1,-NBTHR
  30.         JBI=JBIB-ITHR+1
  31.         IF (JBI.GT.IL2) GOTO 100
  32.         IF (JBI.LT.IL1) GOTO 100
  33.         LIGN=ILIGNS.ILIGR(JBI)
  34.         LPL=IPPVV(2)-IPPVV(1)
  35.         KIDEPB=IPREL-LPL
  36. C       kidep : dernier terme non nul avant le terme courant de la ligne lign
  37.         KIDEPN=IVPO(1)
  38.         KIDEP=KIDEPB+KIDEPN
  39. C       WRITE(*,*)'LIGNE',JBI,KIDEP,KIDEPB,KIDEPN,IPPVV(2),IPPVV(1),LPL
  40.         DO 10 J=MAX(IPER,IMMT(JBI)),IDER
  41.           IPPR=LCARA(2,J)
  42.           IDDR=LCARA(3,J)
  43. CC        WRITE(*,*) 'LIGNE ',J,LCARA(1,J),KIDEP,KIDEPB,IPPR,IDDR,MASDIM
  44.           IF (IDDR.LT.KIDEPB) GOTO 10
  45.           IF (KIDEP.LT.LCARA(1,J)) THEN
  46.             IMSQ=IMASQ(MASQA(IPPR-KIDEPB))
  47.             IF (IMSQ.EQ.0) THEN
  48.               WRITE(*,*) 'erreur interne shole3i'
  49.               CALL ERREUR(5) 
  50.             ENDIF
  51.             IF (IMSQ.LT.0) THEN
  52.               IDEB=-IMSQ
  53.             ELSE
  54.               IDEB=MASQB(IMSQ)+MASQD(IPPR-KIDEPB)-1
  55.             ENDIF 
  56.             IF (IDEB.GT.(IDDR-KIDEPB)) GOTO 10
  57.           ENDIF
  58.           LIG1=ILIGNS.ILIGR(J)
  59.           IF (LIG1.EQ.0) LIG1=MILIGN.ILIGN(J)
  60.           NBG1=LIG1.IPPVV(2)-1
  61.           CALL SHOLE3(IPREL,IDERL,LPL,KIDEPN,IMASQ(1),
  62.      &                IPPR ,IDDR ,NBG1,LIG1.IVPO(1))
  63.           LIGN.IVPO(1)=KIDEPN
  64.           KIDEP=KIDEPB+KIDEPN
  65.   10    CONTINUE
  66. C       WRITE(*,*)'SHOLE3I LIGNE=',JBI,'DE',IPER,'A',IDER,J,NBG1,KIDEPN
  67. C       segprt,lign
  68.   100 CONTINUE
  69.       END
  70.  
  71.  
  72.  

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