Télécharger ensolf.eso

Retour à la liste

Numérotation des lignes :

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

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