Télécharger restri.eso

Retour à la liste

Numérotation des lignes :

  1. C RESTRI SOURCE PV 17/12/05 21:17:17 9646
  2. SUBROUTINE RESTRI (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=======================================================================
  10. C TABLEAU KCOLA :
  11. C 1 MELEME 2 CHPOIN 3 MRIGID 4 MCHAFF 5 MCHELM 6 MCLSTR
  12. C 7 MELSTR 8 MSOLUT 9 MSTRUC 10 11 MAFFEC 12 MSOSTU
  13. C 13 IMATRI 14 MJONCT 15 MATTAC 16 MMATRI 17 MDEFOR 18 MLREEL
  14. C 19 MLENTI 20 MCHARG 21 MODELE 22 MEVOLL 23 MSUPER
  15. C=======================================================================
  16. -INC CCOPTIO
  17. -INC SMRIGID
  18. -INC TMCOLAC
  19. C ***********************MRIGID*************************************
  20. 6003 CONTINUE
  21. ITLAC1=KCOLA(1)
  22. ITLAC2=KCOLA(13)
  23. ITLAC3=KCOLA(16)
  24. ITLAC4=KCOLA(3)
  25. ITLAC5=KCOLA(10)
  26. ITLAC6=KCOLA(2)
  27.  
  28. DO 1202 IEL=IDEB,IMAX1
  29. MRIGID=ITLAC(IEL)
  30. IF (MRIGID.EQ.0) GO TO 1202
  31. SEGACT MRIGID*MOD
  32. NRIGEL=IRIGEL(/2)
  33. IF(IMGEO1.EQ.0) GOTO 1204
  34. IMGEOD=IMGEO1
  35. SEGACT IMGEOD*MOD
  36. DO 1205 I=1,IMGEOR(/1)
  37. IVA=ABS(IMGEOR(I))
  38. * IMGEOR(I)=ITLAC1.ITLAC(IVA) MILL 3/ 9 / 92
  39. IF(IMGEOR(I).LT.0) IMGEOR(I)=ITLAC1.ITLAC(IVA)
  40. 1205 CONTINUE
  41. SEGDES IMGEOD
  42. 1204 CONTINUE
  43. IF(IVECRI.EQ.0) GO TO 1208
  44. MVECRI=IVECRI
  45. SEGACT MVECRI*MOD
  46. DO 1209 I=1,MELZON(/1)
  47. IVA=ABS(MELZON(I))
  48. IF(MELZON(I).LT.0) MELZON(I)=ITLAC1.ITLAC(IVA)
  49. 1209 CONTINUE
  50. SEGDES MVECRI
  51. 1208 CONTINUE
  52. IF (IMGEO2.LT.0) IMGEO2=ITLAC6.ITLAC(ABS(IMGEO2))
  53.  
  54. C ... Le pointeur ICHOLE dans le fichier de sauvegarde est nul
  55. C (MMATRI non sauvé) ou positif (voir SORTRI, EXARIG et WRPIL) ...
  56. C ... On laisse .NE. (et non .GT.) et le ABS au cas où quelqu'un
  57. C miodifiait la sortie ...
  58. IVA=ICHOLE
  59. * IF(IVA .NE.0) ICHOLE=ITLAC3.ITLAC(ABS(IVA))
  60. ichole=abs(iva)
  61.  
  62. IVA=ISUPEQ
  63. IF(IVA.NE.0) ISUPEQ=ITLAC5.ITLAC(IVA)
  64. DO 1203 IR=1,NRIGEL
  65. IVA=ABS(IRIGEL(1,IR))
  66. * IRIGEL(1,IR)=ITLAC1.ITLAC(IVA) MILL 3 / 9 / 92
  67. IF(IRIGEL(1,IR).LT.0) IRIGEL(1,IR)=ITLAC1.ITLAC(IVA)
  68.  
  69. IVA=ABS(IRIGEL(2,IR))
  70. * IF(IVA.NE.0) IRIGEL(2,IR)=ITLAC1.ITLAC(IVA)
  71. IF(IRIGEL(2,IR).LT.0) IRIGEL(2,IR)=ITLAC1.ITLAC(IVA)
  72. if(ionive.lt.18.or.ionive.ge.20) then
  73. IVA=ABS(IRIGEL(4,IR))
  74. ** write (6,*) ' restri iva ',iva
  75. * IRIGEL(4,IR)=ITLAC2.ITLAC(IVA)
  76. IF(IRIGEL(4,IR).LT.0) IRIGEL(4,IR)=ITLAC2.ITLAC(IVA)
  77. xmatri=irigel(4,ir)
  78. * segact xmatri
  79. ** write (6,*) 'restri xmatri ',xmatri,re(/1),re(/2),re(/3)
  80.  
  81. endif
  82. 1203 CONTINUE
  83. iva=abs(jrcond)
  84. if (iva.ne.0) jrcond=itlac4.itlac(iva)
  85. iva=abs(jrdepp)
  86. if (iva.ne.0) jrdepp=itlac4.itlac(iva)
  87. iva=abs(jrdepd)
  88. if (iva.ne.0) jrdepd=itlac4.itlac(iva)
  89. iva=abs(jrelim)
  90. if (iva.ne.0) jrelim=itlac4.itlac(iva)
  91. iva=abs(jrgard)
  92. if (iva.ne.0) jrgard=itlac4.itlac(iva)
  93. iva=abs(jrtot)
  94. if (iva.ne.0) jrtot =itlac4.itlac(iva)
  95. iva=abs(imlag)
  96. if (iva.ne.0) imlag =itlac1.itlac(iva)
  97. SEGDES MRIGID
  98.  
  99. 1202 CONTINUE
  100. GOTO 1098
  101. C***********************************************************************
  102. 1098 CONTINUE
  103. C*********************************************************************
  104. RETURN
  105. END
  106.  
  107.  
  108.  
  109.  

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