Télécharger restch.eso

Retour à la liste

Numérotation des lignes :

  1. C RESTCH SOURCE PV 16/11/26 21:16:23 9205
  2. SUBROUTINE RESTCH (ICOLAC,ITLACC,IMAX1,IDEB)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C=======================================================================
  6. C RESTAURATION DES POINTEURS
  7. C
  8. C APPELE PAR RESTPI
  9. C APPELLE : ERREUR
  10. C=======================================================================
  11. C TABLEAU KCOLA :
  12. C 1 MELEME 2 CHPOIN 3 MRIGID 4 MCHAFF 5 MCHELM 6 MCLSTR
  13. C 7 MELSTR 8 MSOLUT 9 MSTRUC 10 11 MAFFEC 12 MSOSTU
  14. C 13 IMATRI 14 MJONCT 15 MATTAC 16 MMATRI 17 MDEFOR 18 MLREEL
  15. C 19 MLENTI 20 MCHARG 21 MODELE 22 MEVOLL 23 MSUPER
  16. C=======================================================================
  17. -INC CCOPTIO
  18. -INC SMCHPOI
  19. -INC TMCOLAC
  20. C
  21. C **************************CHPOINT*********************************
  22. 6002 CONTINUE
  23. ITLAC1=KCOLA(1)
  24. DO 1101 IEL=IDEB,IMAX1
  25. MCHPOI=ITLAC(IEL)
  26. IF (MCHPOI.EQ.0) GO TO 1101
  27. SEGACT MCHPOI
  28. NSOUPO=IPCHP(/1)
  29. IJK=IPCHP(/1)
  30. IF (IJK.EQ.0) GO TO 10
  31. DO 1103 ISOU=1,NSOUPO
  32. MSOUPO=IPCHP(ISOU)
  33. IF (MSOUPO.EQ.0) GO TO 1103
  34. SEGACT MSOUPO*MOD
  35. IVA=ABS(IGEOC)
  36. nnb=itlac1.itlac(/1)
  37. * IF (IVA.NE.0) IGEOC=ITLAC1.ITLAC(IVA) MILL 3 / 9 / 92
  38. IF (IVA.NE.0) IGEOC=ITLAC1.ITLAC(IVA)
  39. * IF (IGEOC.LT.0) IGEOC=ITLAC1.ITLAC(IVA)
  40. SEGDES MSOUPO
  41. 1103 CONTINUE
  42. 10 SEGDES MCHPOI
  43. 1101 CONTINUE
  44. GOTO 1098
  45. C***********************************************************************
  46. 1098 CONTINUE
  47. C
  48. RETURN
  49. END
  50.  
  51.  
  52.  
  53.  
  54.  
  55.  
  56.  
  57.  
  58.  
  59.  
  60.  

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