Télécharger evsolu.eso

Retour à la liste

Numérotation des lignes :

  1. C EVSOLU SOURCE BP208322 15/05/12 21:15:07 8530
  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)= ITYSOL
  123. MOTERR(9:12)=MCHA
  124. CALL ERREUR(235)
  125. C ERREUR DANS LE TYPE DE CHAMP
  126. GOTO 5000
  127. ENDIF
  128. MSOLEN=MSOLIS(ICHA)
  129. IF(MSOLEN.EQ.0) THEN
  130. MOTERR(1:8)= ITYSOL
  131. MOTERR(9:12)=MCHA
  132. CALL ERREUR(235)
  133. C CE TYPE DE CHAMP EST VIDE DANS LE MSOLUT
  134. GOTO 5000
  135. ENDIF
  136. C
  137. C **** VERIFS DE COMPATIBILITE IPX,ILX, MSOLUT... EN RETOUR :
  138. C **** DANS IPX LE LISTREEL A METTRE DANS IPROGX
  139. C **** DANS ILEX LE LISTENTI QUI CONTIENT LES NUMERO DES CHAMPS
  140. C
  141. IF(MSOLIS(1).EQ.0)GOTO 600
  142. IBOS=MSOLUT
  143. CALL VERIDY(IBOS,IPX,ICHA,ITOUS,ILEX,ITYP1)
  144. MSOLUT=IBOS
  145. SEGACT MSOLUT
  146. IF(IERR.NE.0) GOTO 5000
  147. GOTO 700
  148. 600 CONTINUE
  149. IF(MSOLIS(3).EQ.0) GOTO601
  150. IBOS=MSOLUT
  151. CALL VERIMO(IBOS,ILX,ICHA,ITOUS,ILEX,IPX,ITYP1)
  152. IF(IERR.NE.0) GOTO 5000
  153. MSOLUT=IBOS
  154. SEGACT MSOLUT
  155. GOTO 700
  156. 601 CONTINUE
  157. MOTERR(1:8)='SOLUTION'
  158. MOTERR(9:16)=ITYSOL
  159. CALL ERREUR(131)
  160. C NON DISPONIBLE
  161. GOTO 5000
  162. C
  163. 700 IF( MSOLIT(ICHA).NE.2) GOTO 1002
  164. SEGDES MSOLUT
  165. ENDIF
  166. C--------------------------------------------
  167. C---CAS D UN OBJET DE TYPE TABLE ------------
  168. IF (CTYP(1:5).EQ.'TABLE') THEN
  169. ICHA =0
  170. MTAB1=ISTA
  171. LBO=0
  172. I0=1
  173. IRET1=0
  174. C --- ON PREND LA PREMIERE TABLE (PAS DE TEMPS 1)
  175. CALL ACCTAB (ISTA ,'ENTIER',I0,X0,CHAR0,L0,IRET0,
  176. 1 'TABLE',I1,X1,CHAR1,L1,IRET1)
  177. IBOBO=IRET1
  178. CALL CHTCHA (MCHA,LCHALU,IBOBO,ICHA )
  179. IF(ICHA.EQ.0) THEN
  180. MOTERR(1:8)= MCHA(1:8)
  181. MOTERR(9:12)=MCHA
  182. CALL ERREUR(235)
  183. C ERREUR DANS LE TYPE DE CHAMP
  184. GOTO 5000
  185. ENDIF
  186. C **** VERIFS DE COMPATIBILITE IPX,ILX, MTABLE... EN RETOUR :
  187. C **** DANS IPX LE LISTREEL A METTRE DANS IPROGX
  188. C **** DANS ILEX LE LISTENTI QUI CONTIENT LES NUMERO DES CHAMPS
  189. CALL VERITA(ISTA,IPX,ICHA,ITOUS,ILEX,ITYP1)
  190. IF(IERR.NE.0) GOTO 5000
  191. ENDIF
  192. C **** LA SORTIE PORTE SUR DES CHPOINTS. ON FABRIQUE NUMOO LE TABLEAU
  193. C *** DE SORTIE: LECTURE D'UN POINT OU D'UN MATTAC OU D'UN MODE OU
  194. C **** D'UN CHPOINT OU D'UN MELEME
  195. C
  196. CALL LIROBJ('POINT ',IRET,0,IRETOU)
  197. IF(IRETOU.NE.0) THEN
  198. ITYPE='POINT'
  199. GOTO 10
  200. ENDIF
  201. CALL LIROBJ('MAILLAGE',IRET,0,IRETOU)
  202. IF(IRETOU.NE.0) THEN
  203. ITYPE='MAILLAGE'
  204. GOTO 10
  205. ENDIF
  206. CALL LIROBJ('CHPOINT ',IRET,0,IRETOU)
  207. IF(IRETOU.NE.0) THEN
  208. ITYPE='CHPOINT'
  209. GOTO 10
  210. ENDIF
  211. CALL LIROBJ('ATTACHE ',IRET,0,IRETOU)
  212. IF(IRETOU.NE.0) THEN
  213. ITYPE='ATTACHE'
  214. GOTO 10
  215. ENDIF
  216. CALL LIROBJ('SOLUTION',IRET,0,IRETOU)
  217. IF(IRETOU.NE.0) THEN
  218. ITYPE='SOLUTION'
  219. GOTO 10
  220. ENDIF
  221. CALL LIRTAB('BASE_MODALE',IRET,0,IRETOU)
  222. IF(IRETOU.NE.0) THEN
  223. ITYPE='TABLE '
  224. GOTO 10
  225. ENDIF
  226. C
  227. CALL ERREUR(248)
  228. C ON NE TROUVE PAS LE SUPPORT QUI CONTIENT LES POINTS
  229. GOTO 5000
  230. C
  231. 10 CONTINUE
  232. CALL EVNUMO(ITYPE,IRET,NOMCO,IBOO)
  233. IF(IERR.NE.0) GOTO 5000
  234. C
  235. C *** FABRICATION DU( OU DES) PROG CORRESPONDANT AU TABLEAU NUMOO
  236. C *** ET AUX INSTANTS ILEX (ILEX EST TUE DANS EVOL1)
  237. C
  238. CALL EVOL1(IBOO,ILEX)
  239. NUMOO=IBOO
  240. IF(IERR.NE.0) GOTO 5000
  241. GOTO 3000
  242. C
  243. C *** LA SORTIE PORTE SUR DES CHAMELEM
  244. C
  245. 1002 CONTINUE
  246. C OPTION NON DISPONIBLE
  247. CALL ERREUR(19)
  248. GOTO 5000
  249. C
  250. 3000 CONTINUE
  251. C
  252. C *** INITIALISATION DE MEVOLL
  253. C
  254. N=NUMO(/1)
  255. SEGINI MEVOLL
  256. ITYEVO='REEL'
  257. TI(1:72)=TITREE
  258. IEVTEX=TI
  259. DO 2080 I=1,NUMO(/1)
  260. SEGINI KEVOLL
  261. TYPX='LISTREEL'
  262. TYPY='LISTREEL'
  263. IPROGX=IPX
  264. IPROGY=KLIST(I)
  265. NOMEVX=ITYP1
  266. NOMEVY(1:4)=MCHA
  267. WRITE(NOMEVY(5:8),FMT='(I4)') NUMO(I)
  268. NOMEVY(9:12)=NUDDL(I)
  269. c KEVTEX=TI
  270. IF(ITIT1.EQ.0) MTIT1(1:12)=NOMEVY(1:12)
  271. KEVTEX=MTIT1
  272. NUMEVX=ICOUL
  273. NUMEVY='REEL'
  274. SEGDES KEVOLL
  275. IEVOLL(I)=KEVOLL
  276. 2080 CONTINUE
  277. SEGDES MEVOLL
  278. SEGSUP NUMOO
  279. CALL ECROBJ('EVOLUTIO',MEVOLL)
  280. 5000 CONTINUE
  281. RETURN
  282. END
  283.  
  284.  
  285.  
  286.  

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