Télécharger la plaquette Cast3M


fr en

Télécharger fillp1.eso

Retour à la liste

Numérotation des lignes : 

fillp1

  1. C FILLP1    SOURCE    PV        21/01/21    21:15:25     10862          
  2.       SUBROUTINE FILLP1 (ICOLAC,IMAX)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8(A-H,O-Z)
  5. C=======================================================================
  6. C
  7. C        ON COMPLETE LA PILE DE MELEME
  8. C                         IMAX : NUMERO MAX DE POINT
  9. C
  10. C    ECRIT PAR FARVACQUE -REPRIS PAR LENA
  11. C    APPELE PAR SAUVV
  12. C    APPELLE : AJOUN  SNOM2 REPERT
  13. C=======================================================================
  14.  
  15. -INC PPARAM
  16. -INC CCOPTIO
  17. -INC SMELEME
  18. -INC TMCOLAC
  19.       SEGMENT ILISBB
  20.            INTEGER ILISOB(MLON)
  21.       ENDSEGMENT
  22.       CHARACTER*8 CTYP
  23.       DIMENSION ILENA(10)
  24.       DATA CTYP/'MAILLAGE'/
  25.       iun=1
  26. C
  27. C
  28. C  **** ON PREND TOUS LES MELEME DONT TOUS LES NOEUDS SONT INFERIEURS
  29. C  **** A IMAX . IL Y EN A IMAX2
  30. C
  31.       SEGACT ICOLAC
  32.       ILISSE=ILISSG
  33.       SEGACT ILISSE*MOD
  34.       CALL LISTOB(CTYP,MLON,ILENA,0)
  35.       SEGINI ILISBB
  36.       CALL LISTOB(CTYP,N,ILISOB,1)
  37. C      CALL REPERT (CTYP  ,N)
  38.       IF (N.EQ.0) GO TO 100
  39.       ICO=KCOLA(1)
  40.       ITLACC =KCOLA (1)
  41.       DO 200 M=1,N
  42.       MELEME=ILISOB(M)
  43. C      CALL LIROBJ(CTYP,MELEME,1,IRETOU)
  44.       IF(IERR.NE.0) RETURN
  45.       CALL SNOM2 (MELEME,ITLACC,IRET)
  46.       IF (IRET.GT.0) GOTO 200
  47. C --- LE MELEME N EST PAS DANS LA PILE
  48. C --- ON REGARDE SI SES NUMEROS SONT .LE.IMAX
  49.       SEGACT MELEME
  50. C
  51.       IPT1=MELEME
  52.       NTOTO=LISOUS(/1)
  53.       KRET=0
  54.       IF(NTOTO.NE.0) GOTO 53
  55.       CALL TESTNU (MELEME,IMAX,IRET)
  56.       KRET=IRET
  57.       GO TO 54
  58.    53 CONTINUE
  59.       DO 52 JJ=1,NTOTO
  60.       MELEME=IPT1.LISOUS(JJ)
  61.       CALL TESTNU (MELEME,IMAX,IRET)
  62.       KRET=KRET+IRET
  63.  52   CONTINUE
  64.   54  MELEME=IPT1
  65.       IF(KRET.NE.0) GOTO 51
  66. C --- CE MELEME A SES NUM INFERIEURS OU EGAL A IMAX
  67. C --- ON LE RAJOUTE DANS LA PILE 1
  68. C --- AINSI QUE SES LISOUS ET LISREF
  69.       IVA=IPT1
  70.       CALL AJOUN (ITLACC,IVA,ILISSE,iun)
  71. C
  72.       SEGACT MELEME
  73.       IF(LISOUS(/1).EQ.0) GO TO 58
  74.       DO 59 I=1,LISOUS(/1)
  75.       IVA=LISOUS(I)
  76.       CALL AJOUN(ITLACC,IVA,ILISSE,iun)
  77. C     LISOUS(I)=IVA
  78.  59   CONTINUE
  79.  58   IF(LISREF(/1).EQ.0) GOTO 64
  80.       DO 61 I=1,LISREF(/1)
  81.       IVA=LISREF(I)
  82.       CALL AJOUN(ITLACC,IVA,ILISSE,iun)
  83. C     LISREF(I)=IVA
  84.  61   CONTINUE
  85.  64   SEGDES MELEME
  86.  51   CONTINUE
  87. C-----------------ATTENTION Y A T IL PLUSIEURS NIVEAUX DE LISTREF
  88. C-----------------SI OUI OBLIGATION DE REFAIRE UN PASSAGE DANS FILLPI
  89.  200  CONTINUE
  90. C
  91.  100  CONTINUE
  92.       SEGSUP ILISBB
  93. *      SEGDES ILISSE
  94.       SEGDES ICOLAC
  95.       RETURN
  96.       END
  97.  
  98.  
  99.  
  100.  
  101.  
  102.  
  103.  
  104.  
  105.  
  106.  

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