Télécharger resnua.eso

Retour à la liste

Numérotation des lignes :

  1. C RESNUA SOURCE PV 16/11/26 21:16:21 9205
  2. SUBROUTINE RESNUA (ICOLAC,ITLACC,IMAX1)
  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 SMNUAGE
  19. -INC TMCOLAC
  20. C
  21. CHARACTER*8 CTYP
  22.  
  23. C
  24. C
  25. C *********************** NUAGE *********************************
  26. DO 1101 IEL=1,IMAX1
  27. MNUAGE=ITLAC(IEL)
  28. IF (MNUAGE.EQ.0) GO TO 1101
  29. SEGACT MNUAGE
  30. NVAR=NUAPOI(/1)
  31. DO 1 I= 1,NVAR
  32. CTYP =NUATYP(I)
  33. IF(CTYP.EQ.'FLOTTANT'.OR.CTYP.EQ.'LOGIQUE '.OR.
  34. $ CTYP.EQ.'ENTIER '.OR.CTYP.EQ.'MOT ') GO TO 1
  35. CALL TYPFIL (CTYP,J)
  36. IF(J.EQ.0) GO TO 5
  37. ITLAC1=KCOLA(J)
  38. NUAVIN=NUAPOI(I)
  39. SEGACT NUAVIN*MOD
  40. DO 2 K=1,NUAINT(/1)
  41. IVA=NUAINT(K)
  42. NUAINT(K)=ITLAC1.ITLAC(IVA)
  43. 2 CONTINUE
  44. SEGDES NUAVIN
  45. 1 CONTINUE
  46. SEGDES MNUAGE
  47. 1101 CONTINUE
  48. RETURN
  49. 5 CONTINUE
  50. MOTERR(1:8)=CTYP
  51. CALL ERREUR (336)
  52. RETURN
  53. END
  54.  
  55.  
  56.  
  57.  
  58.  
  59.  
  60.  
  61.  
  62.  

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