Télécharger ensolf.eso

Retour à la liste

Numérotation des lignes :

  1. C ENSOLF SOURCE PV 16/11/26 21:15:43 9205
  2. SUBROUTINE ENSOLF(ICOLAC,IRET,IFORM)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. C=======================================================================
  6. C LECTURE D'UN OBJET MSOLUT SUR LE FICHIER IORES
  7. C
  8. C APPELE PAR : LIPIL
  9. C APPELLE : LFCDIE ENPAPF LFCDES LFCDIM
  10. C ECRIT PAR :FARVACQUE -LENA
  11. C
  12. C=======================================================================
  13. -INC CCOPTIO
  14. -INC SMELEME
  15. -INC SMCHPOI
  16. C**-INC SMCHELM
  17. -INC SMSOLUT
  18. -INC TMCOLAC
  19. C====
  20. SEGMENT/ITBBE1/( ITABE1(NN))
  21. SEGMENT/ITBBE2/( ITABE2(NN))
  22. SEGMENT/ITBBE3/( ITABE3(L3,N3))
  23. SEGMENT/ITAB/(TAB(N1),ITABB(N2))
  24. DIMENSION ILENA(10),ILECBI(2)
  25. C=======================================================================
  26. C
  27. IRET=0
  28. IMEL=0
  29. MSOLUT=0
  30. C READ(IORES,8000,END=1000,ERR=1000) NIPO1,MELEME,L3
  31. NTOTO=3
  32. CALL LFCDIE (IORES,NTOTO,ILENA(1),IRETOU,IFORM)
  33. IF(IRETOU.NE.0) GOTO 1000
  34. NIPO1 =ILENA(1)
  35. ISOMM=ILENA(1)+ILENA(2)+ILENA(3)
  36. IF (ISOMM.EQ.0) GO TO 10
  37. MELEME =ILENA(2)
  38. L3 =ILENA(3)
  39. NIPO=NIPO1+4
  40. SEGINI MSOLUT
  41. MSOLIS(3)=MELEME
  42. C READ(IORES,8001,END=1000,ERR=1000) ITYSOL(1),ITYSOL(2)
  43. NTOTO=2
  44. CALL LFCDIM (IORES,NTOTO,ILECBI,IRETOU,IFORM)
  45. WRITE(ITYSOL,FMT='(2A4)')(ILECBI(IY),IY=1,2)
  46. IF(IRETOU.NE.0) GOTO 1000
  47. NN=2*NIPO1
  48. SEGINI ITBBE1
  49. CALL LFCDIE(IORES,NN,ITABE1,IRETOU,IFORM)
  50. IF(IRETOU.NE.0) GOTO 1000
  51. NN=NIPO1+1
  52. SEGINI ITBBE2
  53. IBBE2=ITBBE2
  54. CALL LFCDIE(IORES,NN,ITABE2,IRETOU,IFORM)
  55. IF(IRETOU.NE.0)GOTO 1000
  56. N3=ITABE2(NN)
  57. SEGINI ITBBE3
  58. L=N3*L3
  59. CALL LFCDIE(IORES,L,ITABE3,IRETOU,IFORM)
  60. IF(IRETOU.NE.0) GOTO1000
  61. DO 1803 III=1,NIPO1
  62. MSOLIT(III+4) = ITABE1(2*III-1)
  63. IF(ITABE1(2*III).EQ.0) GOTO 1803
  64. N=0
  65. SEGINI MSOLEN
  66. MSOLIS(III+4)=MSOLEN
  67. 1803 CONTINUE
  68. C
  69. C ***** CAS DES MODES ET DES SOLUSTAT ET DES PSEUMODES
  70. C
  71. IF(ITYSOL.EQ.'DYNAMIQU') GOTO 1810
  72. N=0
  73. SEGINI MSOLEN
  74. MSOLIS(4)=MSOLEN
  75. ITLAC1=KCOLA(1)
  76. MELEME=ITLAC1.ITLAC(MELEME)
  77. SEGACT MELEME
  78. IF(NUM(/2).NE.1) GOTO 1820
  79. NN=1
  80. SEGINI ITBBE2
  81. IMEL=ITBBE2
  82. ITABE2(1)=NUM(1,1)
  83. 1820 CONTINUE
  84. SEGDES MELEME
  85. GOTO 1849
  86. C
  87. C ***** CAS DES DYNAMIQU
  88. C
  89. 1810 CONTINUE
  90. IF(ITYSOL.NE.'DYNAMIQU') GOTO 1811
  91. SEGINI MSOLRE
  92. MSOLIS(1)=MSOLRE
  93. GOTO 1849
  94. 1811 CONTINUE
  95. C
  96. C******** DANS TOUS LES CAS : LECTURE PAS A PAS ********************
  97. C
  98. 1849 CONTINUE
  99. N1=7
  100. N2=4+NIPO1
  101. SEGINI ITAB
  102. 1898 CONTINUE
  103. CCCC READ(IORES,700,END=1899,ERR=1899) IQUOI
  104. CALL LFCDES (IORES,IQUOI,IRETOU,IFORM)
  105. IF(IRETOU.NE.0) GOTO 1899
  106. C IQUOI=6 FIN DU MSOLUT , IQUOI=1 LECTURE D'UN NOUVEAU PAS
  107. IF(IQUOI.NE.1) GOTO 1899
  108. CALL ENPAPF(MSOLUT,ITAB,ITBBE1,IBBE2,ITBBE3,IMEL,IRETOU,IFORM)
  109. IF(IRETOU.EQ.0) GOTO 1898
  110. C
  111. C ***FIN DE LECTURE DU MSOLUT:ON REGLE LE PB DU MELEME ATTACHE AUX MODE
  112. C
  113. 1899 CONTINUE
  114. C ON SEGACT MSOLUT CAR IL EST DESACTIVE DANS ENPAPF
  115. SEGACT MSOLUT
  116. ITBBE2=IBBE2
  117. SEGSUP ITAB,ITBBE2,ITBBE3
  118. IF(IMEL.EQ.0) GOTO 1897
  119. ITBBE2=IMEL
  120. SEGACT ITBBE2
  121. NBSOUS=0
  122. NBREF=0
  123. NBNN=1
  124. NPAS=ITABE2(/1)
  125. IF(NPAS.EQ.0) GOTO 1000
  126. NBELEM=NPAS
  127. SEGINI MELEME
  128. DO 1896 I=1,NPAS
  129. NUM(1,I)=ITABE2(I)
  130. 1896 CONTINUE
  131. ITYPEL=1
  132. MSOLIS(3)=-MELEME
  133. SEGDES MELEME
  134. C
  135. C **** ECRITURE COMPLETE DES CHPOINTS,MCHELM ... CONTENUS DANS LES
  136. C **** MSOLEN
  137. C
  138. 1897 CONTINUE
  139. ITLAC1=KCOLA(1)
  140. ITLAC2=KCOLA(11)
  141. ITLAC3=KCOLA(2)
  142. ITLAC4=KCOLA(5)
  143. C
  144. DO 4805 II=5,NIPO
  145. IF(MSOLIS(II).EQ.0.OR.MSOLIT(II).EQ.0) GOTO 4805
  146. MSOLEN=MSOLIS(II)
  147. SEGACT MSOLEN
  148. N=ISOLEN(/1)
  149. IF(N.EQ.0) GOTO 1000
  150. III=II-4
  151. IIVA=ITABE1(2*III)
  152. C
  153. C ** MCHPOI ++++++++++++++
  154. IF(MSOLIT(II).NE.2) GOTO 4811
  155. MCHPO1=ITLAC3.ITLAC(IIVA)
  156. SEGACT MCHPO1
  157. NSOUPO=MCHPO1.IPCHP(/1)
  158. DO 4834 ISOU=1,NSOUPO
  159. MSOUP1=MCHPO1.IPCHP(ISOU)
  160. SEGACT MSOUP1
  161. 4834 CONTINUE
  162. DO 4830 J=1,N
  163. IF(ISOLEN(J).EQ.0) GOTO 4830
  164. MCHPOI=ISOLEN(J)
  165. SEGACT MCHPOI
  166. MTYPOI=MCHPO1.MTYPOI
  167. MOCHDE=MCHPO1.MOCHDE
  168. DO 4831 ISOU=1,NSOUPO
  169. MSOUPO=IPCHP(ISOU)
  170. MSOUP1=MCHPO1.IPCHP(ISOU)
  171. SEGACT MSOUPO
  172. NC=NOCOMP(/2)
  173. DO 4832 IC=1,NC
  174. 4832 NOCOMP(IC)=MSOUP1.NOCOMP(IC)
  175. IGEOC=ITLAC1.ITLAC(MSOUP1.IGEOC)
  176. SEGDES MSOUPO
  177. 4831 CONTINUE
  178. SEGDES MCHPOI
  179. 4830 CONTINUE
  180. DO 4833 ISOU=1,NSOUPO
  181. MSOUP1=MCHPO1.IPCHP(ISOU)
  182. SEGDES MSOUP1
  183. 4833 CONTINUE
  184. SEGDES MCHPO1
  185. GOTO 4806
  186. C
  187. 4811 IF(MSOLIT(II).NE.5) GO TO 4812
  188. C MCHAML +++++++++++++++++
  189. MCHEL1=ITLAC4.ITLAC(IIVA)
  190. C* SEGACT MCHEL1
  191. C* NSOU=MCHEL1.IELVAL(/1)
  192. C* DO 4836 J=1,N
  193. C* IF(ISOLEN(J).EQ.0) GOTO 4836
  194. C* MCHELM=ISOLEN(J)
  195. C* SEGACT MCHELM
  196. C* MTYELM=MCHEL1.MTYELM
  197. C* MTYELM=MCHEL1.MTYELM
  198. C* IFOCHE=MCHEL1.IFOCHE
  199. C* IMGCH1=MCHEL1.IMGCH1
  200. C* MOCHEL=MCHEL1.MOCHEL
  201. C* IF (NSOU.EQ.0) GO TO 4840
  202. C* DO 4839 ISOU=1,NSOU
  203. C* INUM(ISOU)=MCHEL1.INUM(ISOU)
  204. C* IAFF(ISOU)=ITLAC2.ITLAC(MCHEL1.IAFF(ISOU))
  205. C* IHARMO(ISOU)=MCHEL1.IHARMO(ISOU)
  206. 4839 CONTINUE
  207. 4840 CONTINUE
  208. C* SEGDES MCHELM
  209. 4836 CONTINUE
  210. C* SEGDES MCHEL1
  211. C
  212. 4812 CONTINUE
  213. 4806 CONTINUE
  214. SEGDES MSOLEN
  215. 4805 CONTINUE
  216. IRET=MSOLUT
  217. IF(IQUOI.NE.6) IRET=-IRET
  218. SEGDES MSOLUT
  219. 1000 CONTINUE
  220. 10 RETURN
  221. END
  222.  
  223.  
  224.  
  225.  

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