Télécharger ecsolu.eso

Retour à la liste

Numérotation des lignes :

  1. C ECSOLU SOURCE PV 11/03/08 21:15:31 6888
  2. SUBROUTINE ECSOLU(IRET,jentet)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. CHARACTER*8 MOSINU(2)
  6. CHARACTER*19 MROTA , MROTP
  7. CHARACTER*24 MROTS
  8. CHARACTER*22 MTRAN , MTRAP
  9. CHARACTER*27 MTRAS
  10. CHARACTER*1 CHAR
  11. LOGICAL LOGIN, LOGRE
  12. C=======================================================================
  13. C ECRITURE D UN OBJET SOLUTION .
  14. C ITY : 1 MODE 2 SOLUSTAT 3 DYNAMIQU
  15. C
  16. C ECRIT PAR FARVACQUE
  17. C APPELLE ECCHPO,PRCHEL
  18. C=======================================================================
  19. -INC CCOPTIO
  20. -INC SMELEME
  21. -INC SMSOLUT
  22. -INC SMLREEL
  23. DATA MOSINU/'SINUS ','COSINUS '/
  24. DATA MROTA/'ROTATION D ENSEMBLE'/
  25. DATA MROTP/'VITESSE DE ROTATION'/
  26. DATA MROTS/'ACCELERATION DE ROTATION'/
  27. DATA MTRAN/'TRANSLATION D ENSEMBLE'/
  28. DATA MTRAP/'VITESSE DE TRANSLATION'/
  29. DATA MTRAS/'ACCELERATION DE TRANSLATION'/
  30. C
  31. MSOLUT=IRET
  32. SEGACT MSOLUT
  33. INTERR(1)=MSOLUT
  34. NSOLUT=MSOLIS(/1)
  35. IF(NSOLUT.EQ.0) THEN
  36. CALL ERREUR(-71)
  37. RETURN
  38. ENDIF
  39. IF(ITYSOL.NE.'MODE ') GOTO 1
  40. ITY=1
  41. MELEME=MSOLIS(3)
  42. SEGACT MELEME
  43. NNN=NUM(/2)
  44. SEGDES MELEME
  45. INTERR(2)=NNN
  46. CALL ERREUR(-72)
  47. GOTO 30
  48. 1 IF(ITYSOL.NE.'SOLUSTAT'.AND.ITYSOL.NE.'PSEUMODE')GOTO 2
  49. ITY=2
  50. MELEME=MSOLIS(3)
  51. SEGACT MELEME
  52. NNN=NUM(/2)
  53. SEGDES MELEME
  54. INTERR(2)=NNN
  55. IF(ITYSOL.EQ.'SOLUSTAT') CALL ERREUR(-73)
  56. IF(ITYSOL.EQ.'PSEUMODE') CALL ERREUR(-74)
  57. GOTO 30
  58. 2 IF(ITYSOL.NE.'DYNAMIQU')GOTO 3
  59. ITY=3
  60. MSOLRE=MSOLIS(1)
  61. SEGACT MSOLRE
  62. NNN=SOLRE(/1)
  63. INTERR(2)=NNN
  64. CALL ERREUR(-75)
  65. GOTO 30
  66. 3 CONTINUE
  67. 30 CONTINUE
  68. C
  69. C
  70. GOTO (1100,1200,1300),ITY
  71. C
  72. C ************ MODES ******************************************
  73. 1100 CONTINUE
  74. IBO=MSOLUT
  75. CALL ECMODE(IBO)
  76. MSOLUT=IBO
  77. SEGACT MSOLUT
  78. DO 1101 INNN=1,NNN
  79. INTERR(1)=INNN
  80. CALL ERREUR(-76)
  81. DO 1102 IS=4,NSOLUT
  82. IF(MSOLIS(IS).EQ.0) GOTO 1102
  83. MSOLEN=MSOLIS(IS)
  84. IF(INNN.EQ.1) SEGACT MSOLEN
  85. II=ISOLEN(INNN)
  86. IF(II.EQ.0) GOTO 1150
  87. GOTO(1150,1150,1150,1106,1103,1104,1105,1150,1150,1150),IS
  88. 1106 CONTINUE
  89. MMODE=II
  90. SEGACT MMODE
  91. REAERR(1)=FMMODD(1)
  92. REAERR(2)=FMMODD(2)
  93. REAERR(3)=FMMODD(3)
  94. REAERR(4)=FMMODD(4)
  95. REAERR(5)=FMMODD(5)
  96. INTERR(1)=IMMODD(1)
  97. IF(IMMODD(3).NE.0) INTERR(2)=IMMODD(2)
  98. IF(IMMODD(3).EQ.0) THEN
  99. CALL ERREUR(-77)
  100. ELSE
  101. IF(IMMODD(2).NE.0) THEN
  102. MOTERR(1:8)=MOSINU(IMMODD(3))
  103. ELSE
  104. MOTERR(1:8)= ' '
  105. ENDIF
  106. CALL ERREUR(-78)
  107. ENDIF
  108. SEGDES MMODE
  109. GOTO 1150
  110. 1103 CONTINUE
  111. CALL ERREUR(-79)
  112. CALL ECCHPO(II,jentet)
  113. GOTO 1150
  114. 1104 CONTINUE
  115. CALL ERREUR(-80)
  116. * CALL PRCHEL(II,jentet)
  117. GOTO 1150
  118. 1105 CONTINUE
  119. CALL ERREUR(-81)
  120. * CALL PRCHEL(II,jentet)
  121. GOTO 1150
  122. 1150 CONTINUE
  123. IF(INNN.EQ.NNN) SEGDES MSOLEN
  124. 1102 CONTINUE
  125. 1101 CONTINUE
  126. GOTO 2000
  127. C
  128. C
  129. C *************************** SOLUTIONS STATIQUES **********************
  130. 1200 CONTINUE
  131. DO 1201 INNN=1,NNN
  132. INTERR(1)=INNN
  133. IF(ITYSOL.EQ.'SOLUSTAT') CALL ERREUR(-82)
  134. IF(ITYSOL.EQ.'PSEUMODE') CALL ERREUR(-83)
  135. IF(MSOLIS(10).EQ.0) GOTO 1206
  136. MSOLEN=MSOLIS(10)
  137. IF(INNN.EQ.1) SEGACT MSOLEN
  138. II=ISOLEN(INNN)
  139. IF(INNN.EQ.NNN) SEGDES MSOLEN
  140. IF(II.EQ.0) GOTO 1206
  141. INTERR(1)=II
  142. CALL ERREUR(-84)
  143. 1206 NSOLU1=NSOLUT-1
  144. DO 1202 IS=4,NSOLU1
  145. IF(MSOLIS(IS).EQ.0) GOTO 1202
  146. MSOLEN=MSOLIS(IS)
  147. IF(INNN.EQ.1) SEGACT MSOLEN
  148. II=ISOLEN(INNN)
  149. IF(II.EQ.0) GOTO 1250
  150. GOTO(1250,1250,1250,1250,1203,1204,1205,1250,1250),IS
  151. 1203 CONTINUE
  152. CALL ERREUR(-79)
  153. CALL ECCHPO(II,jentet)
  154. GOTO 1250
  155. 1204 CONTINUE
  156. CALL ERREUR(-80)
  157. * CALL PRCHEL(II,jentet)
  158. GOTO 1250
  159. 1205 CONTINUE
  160. CALL ERREUR(-81)
  161. * CALL PRCHEL(II,jentet)
  162. GOTO 1250
  163. 1250 CONTINUE
  164. IF(INNN.EQ.NNN) SEGDES MSOLEN
  165. 1202 CONTINUE
  166. 1201 CONTINUE
  167. GOTO 2000
  168. C
  169. C *************************** DYNAMIQUE ********************************
  170. 1300 CONTINUE
  171. DO 1301 INNN=1,NNN
  172. REAERR(1)=SOLRE(INNN)
  173. CALL ERREUR(-85)
  174. DO 1302 IS=5,NSOLUT
  175. IF(MSOLIS(IS).EQ.0) GOTO 1302
  176. MSOLEN=MSOLIS(IS)
  177. IF(INNN.EQ.1) SEGACT MSOLEN
  178. II=ISOLEN(INNN)
  179. IF(II.EQ.0) GOTO 1350
  180. GOTO (1350,1350,1350,1350,1305,1306,1307,1308,1309,1310,
  181. *1311,1312,1350,1314),IS
  182. 1305 CONTINUE
  183. CALL ERREUR(-79)
  184. CALL ECCHPO(II,jentet)
  185. GOTO 1350
  186. 1306 CONTINUE
  187. CALL ERREUR(-80)
  188. * CALL PRCHEL(II,jentet)
  189. GOTO 1350
  190. 1307 CONTINUE
  191. CALL ERREUR(-81)
  192. * CALL PRCHEL(II,jentet)
  193. GOTO 1350
  194. 1308 CONTINUE
  195. CALL ERREUR(-86)
  196. CALL ECCHPO(II,jentet)
  197. GOTO 1350
  198. 1309 CONTINUE
  199. CALL ERREUR(-87)
  200. CALL ECCHPO(II,jentet)
  201. GOTO 1350
  202. 1310 CONTINUE
  203. CALL ERREUR(-88)
  204. CALL ECCHPO(II,jentet)
  205. GOTO 1350
  206. 1311 CONTINUE
  207. CALL ERREUR(-89)
  208. CALL ECROBJ('TABLE ',II)
  209. CALL INDETA
  210. CALL LIROBJ('TABLE ',LISTIND,1,IRETOU)
  211. I = 1
  212. 333 CONTINUE
  213. IGEO1 = 0
  214. CALL ACCTAB(LISTIND,'ENTIER ',I ,XVA,CHAR,LOGIN,IOBIN,
  215. * 'MAILLAGE',IVAL,XVA,CHAR,LOGRE,IGEO1)
  216. IF(IGEO1.EQ.0) GOTO 444
  217. CALL ACCTAB(II,'MAILLAGE',IVA,XVA,CHAR,LOGIN,IGEO1,
  218. * 'TABLE ',IVA,XVA,CHAR,LOGIN,ITAB1)
  219. CALL ACCTAB(ITAB1,'MOT ',IVA,XVA,MROTA,LOGIN,IOBIN,
  220. * 'LISTREEL',IVA,XVA,CHAR ,LOGIN,IVEC1)
  221. CALL ACCTAB(ITAB1,'MOT ',IVA,XVA,MROTP,LOGIN,IOBIN,
  222. * 'LISTREEL',IVA,XVA,CHAR ,LOGIN,IVEC2)
  223. CALL ACCTAB(ITAB1,'MOT ',IVA,XVA,MROTS,LOGIN,IOBIN,
  224. * 'LISTREEL',IVA,XVA,CHAR ,LOGIN,IVEC3)
  225. CALL ERREUR(-90)
  226. MLREE1 = IVEC1
  227. MLREE2 = IVEC2
  228. MLREE3 = IVEC3
  229. SEGACT MLREE1,MLREE2,MLREE3
  230. DO 1401 I = 1,IDIM
  231. ILIGN = ( I - 1 ) * IDIM + 1
  232. JLIGN = ILIGN + IDIM - 1
  233. WRITE(IOIMP,1402) ( MLREE1.PROG(J) , J = ILIGN,JLIGN)
  234. 1402 FORMAT(2X,F9.6,2X,F9.6,2X,F9.6)
  235. 1401 CONTINUE
  236. CALL ERREUR(-91)
  237. DO 1404 I = 1,IDIM
  238. ILIGN = ( I - 1 ) * IDIM + 1
  239. JLIGN = ILIGN + IDIM - 1
  240. WRITE(IOIMP,1405) ( MLREE2.PROG(J) , J = ILIGN,JLIGN)
  241. 1405 FORMAT(9X,E12.5,2X,E12.5,2X,E12.5)
  242. 1404 CONTINUE
  243. CALL ERREUR(-92)
  244. 1406 FORMAT(35X,A24)
  245. DO 1407 I = 1,IDIM
  246. ILIGN = ( I - 1 ) * IDIM + 1
  247. JLIGN = ILIGN + IDIM - 1
  248. WRITE(IOIMP,1408) ( MLREE3.PROG(J) , J = ILIGN,JLIGN)
  249. 1408 FORMAT(23X,E12.5,2X,E12.5,2X,E12.5)
  250. 1407 CONTINUE
  251. SEGDES MLREE1,MLREE2,MLREE3
  252. I = I + 1
  253. GOTO 333
  254. 444 CONTINUE
  255. GOTO 1350
  256. 1312 CONTINUE
  257. CALL ECROBJ('TABLE ',II)
  258. CALL INDETA
  259. CALL LIROBJ('TABLE ',LISTIND,1,IRETOU)
  260. I = 1
  261. 555 CONTINUE
  262. IGEO1 = 0
  263. CALL ACCTAB(LISTIND,'ENTIER ',I ,XVA,CHAR,LOGIN,IOBIN,
  264. * 'MAILLAGE',IVAL,XVA,CHAR,LOGRE,IGEO1)
  265. IF(IGEO1.EQ.0) GOTO 666
  266. CALL ACCTAB(II,'MAILLAGE',IVA,XVA,CHAR,LOGIN,IGEO1,
  267. * 'TABLE ',IVA,XVA,CHAR,LOGIN,ITAB1)
  268. CALL ACCTAB(ITAB1,'MOT ',IVA,XVA,MTRAN,LOGIN,IOBIN,
  269. * 'LISTREEL',IVA,XVA,CHAR ,LOGIN,IVEC1)
  270. CALL ACCTAB(ITAB1,'MOT ',IVA,XVA,MTRAP,LOGIN,IOBIN,
  271. * 'LISTREEL',IVA,XVA,CHAR ,LOGIN,IVEC2)
  272. CALL ACCTAB(ITAB1,'MOT ',IVA,XVA,MTRAS,LOGIN,IOBIN,
  273. * 'LISTREEL',IVA,XVA,CHAR ,LOGIN,IVEC3)
  274. MLREE1 = IVEC1
  275. MLREE2 = IVEC2
  276. MLREE3 = IVEC3
  277. SEGACT MLREE1,MLREE2,MLREE3
  278. CALL ERREUR(-93)
  279. 1409 FORMAT(/,6X,A22)
  280. WRITE(IOIMP,1410) (MLREE1.PROG(J) , J = 1,IDIM)
  281. 1410 FORMAT(2X,E12.5,2X,E12.5,2X,E12.5)
  282. CALL ERREUR(-94)
  283. 1411 FORMAT(18X,A22)
  284. WRITE(IOIMP,1412) ( MLREE2.PROG(J) , J = ILIGN,JLIGN)
  285. 1412 FORMAT(9X,E12.5,2X,E12.5,2X,E12.5)
  286. CALL ERREUR(-95)
  287. WRITE(IOIMP,1414) ( MLREE3.PROG(J) , J = ILIGN,JLIGN)
  288. 1414 FORMAT(23X,E12.5,2X,E12.5,2X,E12.5)
  289. SEGDES MLREE1,MLREE2,MLREE3
  290. I = I + 1
  291. GOTO 555
  292. 666 CONTINUE
  293. GOTO 1350
  294. 1314 CONTINUE
  295. CALL ERREUR(-96)
  296. CALL PRVECT(II,jentet)
  297. GOTO 1350
  298. 1350 CONTINUE
  299. IF(INNN.EQ.NNN) SEGDES MSOLEN
  300. 1302 CONTINUE
  301. 1301 CONTINUE
  302. SEGDES MSOLRE
  303. GOTO 2000
  304. C
  305. C
  306. 2000 CONTINUE
  307. SEGDES MSOLUT
  308. RETURN
  309. END
  310.  
  311.  
  312.  
  313.  

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