Télécharger restri.eso

Retour à la liste

Numérotation des lignes :

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

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