Télécharger restch.eso

Retour à la liste

Numérotation des lignes :

  1. C RESTCH SOURCE CB215821 17/04/24 21:15:12 9418
  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) GOTO 1101
  27. SEGACT MCHPOI
  28. NSOUPO=IPCHP(/1)
  29. IJK=IPCHP(/1)
  30. IF (IJK.EQ.0) THEN
  31. SEGDES MCHPOI
  32. GOTO 1101
  33. ENDIF
  34. DO 1103 ISOU=1,NSOUPO
  35. MSOUPO=IPCHP(ISOU)
  36. IF (MSOUPO.EQ.0) GOTO 1103
  37. SEGACT MSOUPO*MOD
  38. IVA=ABS(IGEOC)
  39. IF (IGEOC .LT. 0) IGEOC=ITLAC1.ITLAC(IVA)
  40. SEGDES MSOUPO
  41. 1103 CONTINUE
  42. 10 SEGDES MCHPOI
  43. 1101 CONTINUE
  44. C***********************************************************************
  45. C
  46. RETURN
  47. END
  48.  
  49.  
  50.  

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