Télécharger evsolu.eso

Retour à la liste

Numérotation des lignes :

  1. C EVSOLU SOURCE BP208322 17/07/25 21:15:08 9518
  2. SUBROUTINE EVSOLU(ICOUL)
  3. C=======================================================================
  4. C OPTION SOLU DE L'OPERATEUR EVOL (CONSTRUCTION DE COURBES)
  5. C
  6. C.1.EVOLUTION D'UN DDL DANS L'OBJET SOLUTION:
  7. C MEVOL = EVOL COUL SOLU MSOLUT TYPE PT1 COMP (INSTANTS) ;
  8. C ---- ---- ---- ----
  9. C
  10. C.2.EVOLUTION DE PLUSIEURS DDL DANS L'OBJET SOLUTION:
  11. C MEVOL = EVOL COUL SOLU MSOLUT TYPE CHP1 (INSTANTS) ;
  12. C ---- ---- ----
  13. C
  14. C.3.EVOLUTION DE LA CONTRIBUTION MODALE RELATIVE AU MODE MOD1:
  15. C MEVOL = EVOL COUL SOLU MSOLUT TYPE MOD1 ALFA (INSTANTS);
  16. C ---- ---- ---- ----
  17. C
  18. C.4.EVOLUTION D'UNE VARIABLE DE LIAISON RELATIVE A LA LIAISON MAT1:
  19. C MEVOL = EVOL COUL SOLU MSOLUT LIAI MAT1 COMP (INSTANTS) ;
  20. C ---- ---- ---- ----
  21. C
  22. C.5.EVOLUTION D'UNE INCONNUE DE LIAISON RELATIVE A LA LIAISON MAT1:
  23. C MEVOL = EVOL COUL SOLU MSOLUT TYPE MAT1 COMP (INSTANTS);
  24. C ---- ---- ---- ----
  25. C
  26. C COUL : COULEUR (FACULTATIVE)
  27. C MEVOL : OBJET DE TYPE EVOLUTION
  28. C MSOLUT : OBJET SOLUTION
  29. C TYPE : MOT CLE:TYPE DE LA VARIABLE (DEPL,VITE,ACCE,LIAI..)
  30. C COMP : NOM DE LA COMPOSANTE CHOISIE
  31. C INSTANTS: PROCEDURE FACULTATIVE POUR CHOISIR LES CAS DE SORTIE
  32. C PROGX :OBJET LISTREEL, LISTE DES TEMPS A SORTIR
  33. C LECTC :OBJET LISTENTI, LISTE DES CAS A SORTIR
  34. C RIEN :L'OBJET EVOLUTION PORTE SUR TOUS LES CAS PRESENTS
  35. C DANS LE MSOLUT
  36. C
  37. C PT1 : POINT OU MELEME A EXTRAIRE
  38. C CHP1 : CHPOINT CONTENANT LES POINTS ET DDL (FABRIQUE PAR
  39. C EXEMPLE PAR MANU CHPO )
  40. C MOD1 : OBJET MSOLUT (MODE OU SOLUSTAT...)
  41. C MAT1 : OBJET ATTACHE.
  42. C
  43. C LES OBJETS PT1,MOD1,MAT1 SERVENT A REPERER DANS LES CHAMPS
  44. C CHOISIS, LE(S) POINT(S) QUI INTERESSENT L'EVOLUTION.
  45. C
  46. C CREATION : 16/10/85, FARVACQUE
  47. C MODIFS : 2015, bp ajout du titre de la LEGEnde
  48. C
  49. C=======================================================================
  50. IMPLICIT INTEGER(I-N)
  51. LOGICAL L0,L1
  52. REAL*8 X0,X1
  53. CHARACTER*4 CHAR0,CHAR1
  54. CHARACTER*8 CTYP
  55. -INC CCOPTIO
  56. -INC SMSOLUT
  57. -INC SMTABLE
  58. -INC SMEVOLL
  59. -INC SMATTAC
  60. -INC SMELEME
  61. -INC SMCHPOI
  62. SEGMENT NUMOO
  63. INTEGER NUMO(N),KLIST(N)
  64. CHARACTER*4 NUDDL(N)
  65. ENDSEGMENT
  66. CHARACTER*72 TI,MTIT1
  67. * CHARACTER*4 MCHA,NOMCO
  68. CHARACTER*72 MCHA,NOMCO
  69. CHARACTER*8 ITYPE
  70. CHARACTER*8 ITYP1
  71. CHARACTER*4 MOTIT1(1)
  72. DATA MOTIT1/'LEGE'/
  73.  
  74. C LECTURE OPTIONNELLE DU TITRE DE LA SOUS EVOLUTION DE LA COURBE (LEGE) :
  75. MTIT1=' '
  76. ITIT1=0
  77. CALL LIRMOT(MOTIT1,1,ITIT1,0)
  78. IF(ITIT1.EQ.1) THEN
  79. CALL LIRCHA(MTIT1,1,IRETOU)
  80. IF(IERR.NE.0) RETURN
  81. ENDIF
  82.  
  83. C------TYPE DU PROCHAIN OBJET A LIRE----(TABLE OU SOLUTION)
  84. CALL QUETYP (CTYP,1,IRETOU)
  85. IF (IERR.NE.0) RETURN
  86.  
  87. C --- ON LIT LE NOM DU CHAMP A TRAITER ET LE NOM DE LA COMPOSANTE
  88. CALL LIRCHA(MCHA,1,IRETOU)
  89. IF(IERR.NE.0) GOTO 5000
  90. LCHALU=IRETOU
  91. CALL LIRCHA(NOMCO,0,IRETOU)
  92. IF(IRETOU.EQ.0) NOMCO=' '
  93. LCOLU=IRETOU
  94. C
  95. IF (CTYP(1:5).EQ.'TABLE') THEN
  96. ISTA=0
  97. CALL LIRTAB ('RESULTAT_DYNE',ISTA,1,IRETOU)
  98. IF (IERR.NE.0) GOTO 5000
  99. ENDIF
  100. C--------------
  101. C
  102. IF (CTYP(1:8).EQ.'SOLUTION') THEN
  103. CALL LIROBJ('SOLUTION',KSOLU,1,IRETOU)
  104. IF(IERR.NE.0) GOTO 5000
  105. MSOLUT=KSOLU
  106. ENDIF
  107. C-----ON LIT EVENTUELLEMENT LA LISTE DES PAS DE TEMPS OU DE CAS ---
  108. IPX=0
  109. ITOUS=0
  110. ILX=0
  111. CALL LIROBJ('LISTREEL',IPX,0,IRETOU)
  112. IF(IRETOU.EQ.0) CALL LIROBJ('LISTENTI',ILX,0,IRETOU)
  113. IF(IRETOU.EQ.0) ITOUS=1
  114. C----------------------------------------------------------
  115. C *** ON VA CHERCHER LE CHAMP MCHA DANS LE MSOLUT
  116. C
  117. IF (CTYP(1:8).EQ.'SOLUTION') THEN
  118. SEGACT MSOLUT
  119. MOTERR(1:8)= ITYSOL
  120. CALL CHRCHA(MCHA,MOTERR(1:8),ICHA,ISOLIT)
  121. IF(ICHA.EQ.0) THEN
  122. MOTERR(1:8)='SOLUTION'
  123. MOTERR(9:26)=ITYSOL
  124. MOTERR(30:38)=MCHA
  125. CALL ERREUR(235)
  126. C ERREUR DANS LE TYPE DE CHAMP
  127. GOTO 5000
  128. ENDIF
  129. MSOLEN=MSOLIS(ICHA)
  130. IF(MSOLEN.EQ.0) THEN
  131. MOTERR(1:8)='SOLUTION'
  132. MOTERR(9:26)=ITYSOL
  133. MOTERR(30:38)=MCHA
  134. CALL ERREUR(235)
  135. C CE TYPE DE CHAMP EST VIDE DANS LE MSOLUT
  136. GOTO 5000
  137. ENDIF
  138. C
  139. C **** VERIFS DE COMPATIBILITE IPX,ILX, MSOLUT... EN RETOUR :
  140. C **** DANS IPX LE LISTREEL A METTRE DANS IPROGX
  141. C **** DANS ILEX LE LISTENTI QUI CONTIENT LES NUMERO DES CHAMPS
  142. C
  143. IF(MSOLIS(1).EQ.0)GOTO 600
  144. IBOS=MSOLUT
  145. CALL VERIDY(IBOS,IPX,ICHA,ITOUS,ILEX,ITYP1)
  146. MSOLUT=IBOS
  147. SEGACT MSOLUT
  148. IF(IERR.NE.0) GOTO 5000
  149. GOTO 700
  150. 600 CONTINUE
  151. IF(MSOLIS(3).EQ.0) GOTO601
  152. IBOS=MSOLUT
  153. CALL VERIMO(IBOS,ILX,ICHA,ITOUS,ILEX,IPX,ITYP1)
  154. IF(IERR.NE.0) GOTO 5000
  155. MSOLUT=IBOS
  156. SEGACT MSOLUT
  157. GOTO 700
  158. 601 CONTINUE
  159. MOTERR(1:8)='SOLUTION'
  160. MOTERR(9:16)=ITYSOL
  161. CALL ERREUR(131)
  162. C NON DISPONIBLE
  163. GOTO 5000
  164. C
  165. 700 IF( MSOLIT(ICHA).NE.2) GOTO 1002
  166. SEGDES MSOLUT
  167. ENDIF
  168. C--------------------------------------------
  169. C---CAS D UN OBJET DE TYPE TABLE ------------
  170. IF (CTYP(1:5).EQ.'TABLE') THEN
  171. ICHA =0
  172. MTAB1=ISTA
  173. LBO=0
  174. I0=1
  175. IRET1=0
  176. C --- ON PREND LA PREMIERE TABLE (PAS DE TEMPS 1)
  177. CALL ACCTAB (ISTA ,'ENTIER',I0,X0,CHAR0,L0,IRET0,
  178. 1 'TABLE',I1,X1,CHAR1,L1,IRET1)
  179. IBOBO=IRET1
  180. CALL CHTCHA (MCHA,LCHALU,IBOBO,ICHA )
  181. IF(ICHA.EQ.0) THEN
  182. MOTERR(1:8)='TABLE'
  183. MOTERR(9:26)=MCHA(1:8)
  184. MOTERR(30:38)=MCHA
  185. CALL ERREUR(235)
  186. C ERREUR DANS LE TYPE DE CHAMP
  187. GOTO 5000
  188. ENDIF
  189. C **** VERIFS DE COMPATIBILITE IPX,ILX, MTABLE... EN RETOUR :
  190. C **** DANS IPX LE LISTREEL A METTRE DANS IPROGX
  191. C **** DANS ILEX LE LISTENTI QUI CONTIENT LES NUMERO DES CHAMPS
  192. CALL VERITA(ISTA,IPX,ICHA,ITOUS,ILEX,ITYP1)
  193. IF(IERR.NE.0) GOTO 5000
  194. ENDIF
  195. C **** LA SORTIE PORTE SUR DES CHPOINTS. ON FABRIQUE NUMOO LE TABLEAU
  196. C *** DE SORTIE: LECTURE D'UN POINT OU D'UN MATTAC OU D'UN MODE OU
  197. C **** D'UN CHPOINT OU D'UN MELEME
  198. C
  199. CALL LIROBJ('POINT ',IRET,0,IRETOU)
  200. IF(IRETOU.NE.0) THEN
  201. ITYPE='POINT'
  202. GOTO 10
  203. ENDIF
  204. CALL LIROBJ('MAILLAGE',IRET,0,IRETOU)
  205. IF(IRETOU.NE.0) THEN
  206. ITYPE='MAILLAGE'
  207. GOTO 10
  208. ENDIF
  209. CALL LIROBJ('CHPOINT ',IRET,0,IRETOU)
  210. IF(IRETOU.NE.0) THEN
  211. ITYPE='CHPOINT'
  212. GOTO 10
  213. ENDIF
  214. CALL LIROBJ('ATTACHE ',IRET,0,IRETOU)
  215. IF(IRETOU.NE.0) THEN
  216. ITYPE='ATTACHE'
  217. GOTO 10
  218. ENDIF
  219. CALL LIROBJ('SOLUTION',IRET,0,IRETOU)
  220. IF(IRETOU.NE.0) THEN
  221. ITYPE='SOLUTION'
  222. GOTO 10
  223. ENDIF
  224. CALL LIRTAB('BASE_MODALE',IRET,0,IRETOU)
  225. IF(IRETOU.NE.0) THEN
  226. ITYPE='TABLE '
  227. GOTO 10
  228. ENDIF
  229. C
  230. CALL ERREUR(248)
  231. C ON NE TROUVE PAS LE SUPPORT QUI CONTIENT LES POINTS
  232. GOTO 5000
  233. C
  234. 10 CONTINUE
  235. CALL EVNUMO(ITYPE,IRET,NOMCO,IBOO)
  236. IF(IERR.NE.0) GOTO 5000
  237. C
  238. C *** FABRICATION DU( OU DES) PROG CORRESPONDANT AU TABLEAU NUMOO
  239. C *** ET AUX INSTANTS ILEX (ILEX EST TUE DANS EVOL1)
  240. C
  241. CALL EVOL1(IBOO,ILEX)
  242. NUMOO=IBOO
  243. IF(IERR.NE.0) GOTO 5000
  244. GOTO 3000
  245. C
  246. C *** LA SORTIE PORTE SUR DES CHAMELEM
  247. C
  248. 1002 CONTINUE
  249. C OPTION NON DISPONIBLE
  250. CALL ERREUR(19)
  251. GOTO 5000
  252. C
  253. 3000 CONTINUE
  254. C
  255. C *** INITIALISATION DE MEVOLL
  256. C
  257. N=NUMO(/1)
  258. SEGINI MEVOLL
  259. ITYEVO='REEL'
  260. TI(1:72)=TITREE
  261. IEVTEX=TI
  262. DO 2080 I=1,NUMO(/1)
  263. SEGINI KEVOLL
  264. TYPX='LISTREEL'
  265. TYPY='LISTREEL'
  266. IPROGX=IPX
  267. IPROGY=KLIST(I)
  268. NOMEVX=ITYP1
  269. NOMEVY(1:4)=MCHA
  270. WRITE(NOMEVY(5:8),FMT='(I4)') NUMO(I)
  271. NOMEVY(9:12)=NUDDL(I)
  272. c KEVTEX=TI
  273. IF(ITIT1.EQ.0) MTIT1(1:12)=NOMEVY(1:12)
  274. KEVTEX=MTIT1
  275. NUMEVX=ICOUL
  276. NUMEVY='REEL'
  277. SEGDES KEVOLL
  278. IEVOLL(I)=KEVOLL
  279. 2080 CONTINUE
  280. SEGDES MEVOLL
  281. SEGSUP NUMOO
  282. CALL ECROBJ('EVOLUTIO',MEVOLL)
  283. 5000 CONTINUE
  284. RETURN
  285. END
  286.  
  287.  
  288.  
  289.  
  290.  

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