Télécharger la plaquette Cast3M


fr en

Télécharger hatstr.eso

Retour à la liste

Numérotation des lignes : 

hatstr

  1. C HATSTR    SOURCE    PV        17/12/05    21:16:26     9646           
  2.       SUBROUTINE HATSTR (ICOLAC)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8(A-H,O-Z)
  5. C-----------------------------------------------------------------------
  6. C
  7. C   BUT  :VA A LA PECHE DES CHAPEAUX DES OBJETS SOSTU
  8. C         DEJA CONTENUS DANS LES PILES
  9. C LOGIQUE:
  10. C       ON SE POINTE SUR LA PILE 9 DES STRUCT
  11. C       ON CREE LA TABLE DES OBJETS DU TYPE DE CETTE PILE
  12. C       ON TESTE SI LE POINTEUR DE L OBJET EST DANS LA PILE
  13. C       SI OUI, ON PASSE A  L OBJET SUIVANT.
  14. C       SI NON
  15. C       SI L ENSEMBLE DES POINTEURS SOSTU EST CONTENU DANS LA PILE 12
  16. C       ALORS ON RAJOUTE L OBJET DANS LA PILE 9, CE QUI OBLIGE A UN
  17. C       RAPPEL DE FILLPI
  18. C
  19. C   PROGRAMME PAR :  FARVACQUE-REPRIS PAR LENA
  20. C   APPELE PAR    :  SAUV
  21. C   APPELLE       :     SORT7   SORT8  ERREUR  REPERT
  22. C
  23. C=======================================================================
  24. C  TABLEAU KCOLA :
  25. C    1  MELEME  2 CHPOIN  3 MRIGID  4 MCHAFF  5 MCHELM  6 MCLSTR
  26. C    7  MELSTR  8 MSOLUT  9 MSTRUC 10 MTABLE 11 MAFFEC 12 MSOSTU
  27. C   13  IMATRI 14 MJONCT 15 MATTAC 16 MMATRI 17 MDEFOR 18 MLREEL
  28. C   19  MLENTI 20 MCHARG 21 MODELE 22 MEVOLL
  29. C=======================================================================
  30. C
  31. -INC SMSTRUC
  32.  
  33. -INC PPARAM
  34. -INC CCOPTIO
  35. -INC TMCOLAC
  36.       SEGMENT ILISBB
  37.         INTEGER ILISOB(MLON)
  38.       ENDSEGMENT
  39.       DIMENSION IBID(1)
  40. C
  41.       CHARACTER*(8) ITYPE
  42. C
  43.       SEGACT ICOLAC
  44.       ILISSE=ILISSG
  45.       SEGACT ILISSE*MOD
  46. C
  47. C
  48. C     **************************** MSTRUC ET MSOSTU*********************
  49. C-----ON SE POINTE SUR LA PILE DES SOSTU
  50.       ITLAC1=KCOLA(12)
  51.       IMAX1=ITLAC1.ITLAC(/1)
  52.       IF(IMAX1.EQ.0) GO TO 598
  53. C
  54. C     LA PILE DES SOSTU  N EST PAS VIDE-------------------------------
  55.       ITYPE='STRUCTUR'
  56.       IFILE=0
  57.       CALL TYPFIL (ITYPE,IFILE)
  58.       IF (IFILE.LE.0) GO TO 598
  59.       ITLACC=KCOLA(IFILE)
  60.       CALL LISTOB(ITYPE,MLON,IBID,0)
  61.       SEGINI ILISBB
  62.       CALL LISTOB(ITYPE,N,ILISOB,1)
  63. C      CALL REPERT (ITYPE,N)
  64.       IF (N.EQ.0) GO TO 599
  65. C
  66.       DO 1500 I   =1,N
  67.       MSTRUC=ILISOB(I)
  68. C      CALL LIROBJ(ITYPE,MSTRUC,1,IRETOU)
  69.       IF(IERR.EQ.0) RETURN
  70.       CALL SNOM2(MSTRUC,ITLACC,IRET)
  71.       IF(IRET.NE.0) GOTO 1500
  72.       SEGACT MSTRUC
  73.       NSOU=LISTRU(/1)
  74.       CALL SORT8(LISTRU,NSOU,ITLAC1.ITLAC,IMAX1,IRET)
  75.       SEGDES MSTRUC
  76.       IF(IRET.EQ.1) GOTO 1500
  77.       CALL AJOUN (ITLACC,MSTRUC,ILISSE,1)
  78.  1500 CONTINUE
  79.   599 CONTINUE
  80.       SEGSUP ILISBB
  81.   598 CONTINUE
  82. *      SEGDES ICOLAC,ILISSE
  83.       RETURN
  84.       END
  85.  
  86.  
  87.  
  88.  
  89.  
  90.  
  91.  
  92.  
  93.  
  94.  
  95.  
  96.  

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