Télécharger manuri.eso

Retour à la liste

Numérotation des lignes :

  1. C MANURI SOURCE BP208322 14/12/17 21:15:02 8323
  2. SUBROUTINE MANURI
  3. ************************************************************************
  4. *
  5. * M A N U R I
  6. * -----------
  7. *
  8. * SOUS-PROGRAMME ASSOCIE A L'OPTION "RIGIDITE" DE L'OPERATEUR
  9. * "MANUEL".
  10. *
  11. * FONCTION:
  12. * ---------
  13. *
  14. * CREER, EN LISANT EXPLICITEMENT SES COMPOSANTS, UN OBJET 'RIGIDITE'
  15. * DANS LEQUEL TOUTES LES MATRICES DE RIGIDITE ELEMENTAIRES SONT LES
  16. * MEMES.
  17. * CAS PARTICULIER FREQUENT: LA 'RIGIDITE' S'APPUIE SUR UN SEUL
  18. * ELEMENT GEOMETRIQUE ET ELLE NE CONTIENDRA QU'UNE SEULE MATRICE
  19. * ELEMENTAIRE.
  20. *
  21. * PHRASE D'APPEL (EN GIBIANE):
  22. * ----------------------------
  23. *
  24. * AA = MANUEL RIGIDITE (BB) CC <DD> ('DUAL' <FF>) ('ANTI') <EE> ;
  25. *
  26. * LES PARENTHESES INDIQUANT DES OPERANDES FACULTATIFS ET LES
  27. * CROCHETS DES OPERANDES POUVANT ETRE REPETES.
  28. *
  29. * OPERANDES ET RESULTATS:
  30. * -----------------------
  31. *
  32. * BB 'MOT ' SOUS-TYPE DE LA 'RIGIDITE' QUE L'ON CREE.
  33. * CE SOUS-TYPE S'ECRIVANT SUR 8 CARACTERES, ET
  34. * UN 'MOT' NE COMPORTANT ACTUELLEMENT QUE 4
  35. * CARACTERES, ON DOIT PROVISOIREMENT FOURNIR
  36. * NON PAS 1 MAIS 2 MOTS "BB1" ET "BB2".
  37. * CC 'MAILLAGE' SUPPORT GEOMETRIQUE.
  38. * DD 'LISTMOTS' CONTIENT LES NOMS DES COMPOSANTES POUR UN
  39. * NOEUD D'UN ELEMENT DE "CC".
  40. * SI TOUS LES NOEUDS D'UN MEME ELEMENT DE "CC"
  41. * N'ONT PAS LES MEMES COMPOSANTES, ON DONNE
  42. * PLUSIEURS 'LISTMOTS' (PLUS PRECISEMENT
  43. * AUTANT DE 'LISTMOTS' QU'IL Y A DE NOEUDS
  44. * PAR ELEMENT).
  45. C+PP
  46. C ILS PEUVENT ETRE CONTENUS DANS UNE TABLE
  47. C (IDEM POUR FF)
  48. C+PP
  49. * FF 'LISTMOTS' CONTIENT LES NOMS DES INCONNUES DUALES
  50. * AUTANT DE 'LISTMOTS' QUE POUR LES INCONNUES
  51. * EE 'LISTREEL' SI 1 SEUL "EE" EST FOURNI:
  52. * IL CONTIENT TOUS LES TERMES DU TRIANGLE
  53. * INFERIEUR DE LA MATRICE ELEMENTAIRE, LIGNE
  54. * PAR LIGNE.
  55. * SI PLUSIEURS "EE" SONT FOURNIS:
  56. * IL DOIT Y AVOIR AUTANT DE 'LISTREEL' QU'IL
  57. * Y A DE LIGNES DANS LA MATRICE ELEMENTAIRE,
  58. * LE N-IEME 'LISTREEL' DECRIVANT LA N-IEME
  59. * LIGNE DE LA MATRICE DU BORD GAUCHE JUSQU'A
  60. * LA DIAGONALE.
  61. * AA 'RIGIDITE' OBJET CREE.
  62. *
  63. * EXEMPLE D'ENTREE DE LA MATRICE ELEMENTAIRE:
  64. *
  65. * | A B C |
  66. * | B D E |
  67. * | C E F |
  68. *
  69. * PEUT ETRE DONNEE PAR: (PROG A B D C E F)
  70. * OU BIEN PAR: (PROG A) (PROG B D) (PROG C E F)
  71. *
  72. * "PROG" ETANT L'OPERATEUR DE CREATION D'UN 'LISTREEL'.
  73. *
  74. * LEXIQUE: (ORDRE ALPHABETIQUE)
  75. * --------
  76. *
  77. * IPELEM ENTIER POINTEUR DU SUPPORT GEOMETRIQUE "CC".
  78. * IPRIGI ENTIER POINTEUR DE LA 'RIGIDITE' "AA".
  79. * LETYPE ENTIER SOUS-TYPE DE L'OBJET 'RIGIDITE' (CONTIENT UNE
  80. * CHAINE DE CARACTERES).
  81. * MTEMP3 SEGMENT CONTIENT LE(S) POINTEUR(S) DU (DES) 'LISTMOTS'
  82. * "DD".
  83. * MTEMP4 SEGMENT CONTIENT LE(S) POINTEUR(S) DU (DES) 'LISTREEL'
  84. * "EE".
  85. *
  86. * SOUS-PROGRAMMES APPELES:
  87. * ------------------------
  88. *
  89. * ECRIRE, LIRE, LIRMO8, MANUR1.
  90. *
  91. * REMARQUES:
  92. * ----------
  93. *
  94. * ACTUELLEMENT, L'OBJET 'MAILLAGE' "CC" DOIT CONTENIR DES ELEMENTS
  95. * GEOMETRIQUES TOUS DE MEME TYPE.
  96. *
  97. * AUTEUR, DATE DE CREATION:
  98. * -------------------------
  99. *
  100. * PASCAL MANIGOT 19 FEVRIER 1985
  101. * Lionel VIVAN 12 juin 1991, ajout du mot clé ANTI
  102. * Michel BULIK 29 novembre 1995, ajout du mot clé QUEL
  103. * Stephane Gounand 08 mai 2011, ajout de la syntaxe MANU RIGI
  104. * CHPO1 permettant de créer une rigidité
  105. * diagonale
  106. * Benoit Prabel 16 fevrier 2012 : ajout des options COLOnnes
  107. * et LIGNes pour la syntaxe avec un chpoint
  108. * + possibilité rigidité vide
  109. * Benoit Prabel 02/07/2014 : ajout de la lecture d'un LISTCHPO
  110. *
  111. * LANGAGE:
  112. * --------
  113. *
  114. * ESOPE + FORTRAN77 + EXTENSION: CARACTERES MIS DANS DES ENTIERS
  115. *
  116. ************************************************************************
  117. *
  118. IMPLICIT INTEGER(I-N)
  119. -INC CCOPTIO
  120. -INC SMRIGID
  121. C+PP
  122. -INC SMTABLE
  123. CHARACTER*8 TYPOBJ,CH0,CH1
  124. REAL*8 X0,X1
  125. INTEGER I1
  126. LOGICAL L0,L1
  127. C+PP
  128. *
  129. SEGMENT /MTEMP3/ (ILMOTS(0)),MTEM3.MTEMP3
  130. SEGMENT /MTEMP4/ (ILREEL(0))
  131. *
  132. PARAMETER (INFINI = 9999)
  133. *
  134. CHARACTER*8 LETYPE,CTYP
  135. CHARACTER*4 MODUA(1),MOTYP(2),MOMOT(1)
  136. CHARACTER*4 MOCLE(3)
  137. *
  138. DATA MODUA(1) /'DUAL'/
  139. DATA MOTYP(1),MOTYP(2) /'ANTI','QUEL'/
  140. DATA MOMOT(1) /'TYPE'/
  141. DATA MOCLE(1),MOCLE(2),MOCLE(3) /'DIAG','COLO','LIGN'/
  142. C
  143. c
  144. C=== Syntaxe b : Rig1 = MANU RIGI (mocle) CHPO1 (...) ====================
  145. c
  146. *
  147. * -- LECTURE EVENTUELLE DU MOT CLE : DIAG ou COLO ou LIGN ... --
  148. *
  149. ICLE = 0
  150. CALL LIRMOT(MOCLE,3,ICLE,0)
  151. if(iimpi.ge.1) write(IOIMP,*) 'ICLE=',ICLE
  152. *
  153. * -- LECTURE DU CHPOINT ? --
  154. *
  155. IF (ICLE.NE.0) THEN
  156. c cas ou on a lu DIAG, COLO ou LIGN
  157. CALL LIROBJ('CHPOINT ',MCHPOI,1,IRET)
  158. IF (IERR.NE.0) RETURN
  159. ELSE
  160. c si aucun mot clé, ...
  161. c ... mais présence d'un chpoint, option DIAG par défaut
  162. CALL QUETYP(CTYP,0,IRETOU)
  163. IF (IRETOU.EQ.0) THEN
  164. c CALL ERREUR(533)
  165. c si rien du tout, CREATION D'UNE RIGIDITE VIDE
  166. NRIGEL=0
  167. segini,MRIGID
  168. IPRIGI=MRIGID
  169. MTYMAT='MANUELLE'
  170. IFORIG= IFOMOD
  171. ICHOLE = 0
  172. IMGEO1 = 0
  173. IMGEO2 = 0
  174. IFORIG = 0
  175. c ISUPEQ,JRCOND,JRDEPP,JRDEPD = 0
  176. c JRELIM,JRGARD,JRTOT,IMLAG = 0
  177. c IPROFO,IVECRI = 0
  178. segdes,MRIGID
  179. CALL ECROBJ ('RIGIDITE',IPRIGI)
  180. RETURN
  181. ENDIF
  182. IF(CTYP.EQ.'CHPOINT ') THEN
  183. ICLE = 1
  184. CALL LIROBJ(CTYP,MCHPOI,1,IRET)
  185. IF (IERR.NE.0) RETURN
  186. ENDIF
  187. c ... mais présence d'un listchpo, matrice colonne pleine
  188. IF(CTYP.EQ.'LISTCHPO') THEN
  189. ICLE = 4
  190. CALL LIROBJ(CTYP,MLCHPO,1,IRET)
  191. IF (IERR.NE.0) RETURN
  192. c lit-on une rigidite "modele" avec un mvecri ?
  193. CALL LIROBJ('RIGIDITE',IPRIG1,0,IRET)
  194. IF (IERR.NE.0) RETURN
  195. IF(IRET.NE.0) THEN
  196. MRIGID=IPRIG1
  197. SEGACT,MRIGID
  198. if(IVECRI.eq.0) then
  199. write(ioimp,*) 'pour l instant, IVECRI doit etre non nul !'
  200. call erreur(21)
  201. endif
  202. IVEC1 = IVECRI
  203. SEGDES,MRIGID
  204. ELSE
  205. c lit-on un maillage de POI1 support des chpoints
  206. c (de composante ALFA seulement)?
  207. CALL LIROBJ('MAILLAGE',IPT1,0,IRET)
  208. ICLE = 5
  209. ENDIF
  210. ENDIF
  211. ENDIF
  212. *
  213. * -- CREATION RIGIDITE DEPUIS UN CHPOINT (ou une listchpo) --
  214. *
  215. IF (ICLE.NE.0) THEN
  216. IF (ICLE.eq.1) THEN
  217. c rigidite diagonale
  218. CALL KOPDIR(MCHPOI,MRIGID)
  219. ELSEIF (ICLE.le.3) THEN
  220. c rigidite colonne ou ligne
  221. CALL RICOLO(MCHPOI,ICLE,MRIGID)
  222. ELSEIF (ICLE.eq.4) THEN
  223. c rigidite colonne pleine depuis une listchpo
  224. CALL RICOL2(MLCHPO,ICLE,MRIGID,IVEC1)
  225. ELSEIF (ICLE.eq.5) THEN
  226. c rigidite colonne pleine depuis une listchpo
  227. CALL RICOL1(MLCHPO,ICLE,MRIGID,IPT1)
  228. ELSE
  229. CALL ERREUR(19)
  230. ENDIF
  231. IF (IERR.NE.0) RETURN
  232. CALL ECROBJ('RIGIDITE',MRIGID)
  233. RETURN
  234. ENDIF
  235. c
  236. c
  237. C=== Syntaxe a : Rig1 = MANU RIGI (TYPE mot1) GEO1 LMOT1 (...) LREEL1 ====
  238. c
  239. *
  240. * -- LECTURE DU SOUS-TYPE DE LA "RIGIDITE" A CREER --
  241. *
  242. ITYP = 0
  243. CALL LIRMOT(MOMOT,1,ITYP,0)
  244. IF(ITYP.EQ.1) THEN
  245. ICODE = 1
  246. CALL LIRCHA (LETYPE,ICODE,IRETOU)
  247. IF (IERR .NE. 0) RETURN
  248. ELSE
  249. C ... Si on n'a rien trouvé, on met les blancs dedans,
  250. C sinon il y a des cochonneries ...
  251. LETYPE=' '
  252. ENDIF
  253. *
  254. * -- LECTURE DU SUPPORT GEOMETRIQUE --
  255. *
  256. CALL LIROBJ('POINT ',KPOINT,0,IRETOU)
  257. IF(IRETOU.NE.0) THEN
  258. CALL CRELEM(KPOINT)
  259. IPELEM=KPOINT
  260. ELSE
  261. ICODE = 1
  262. CALL LIROBJ ('MAILLAGE',IPELEM,ICODE,IRETOU)
  263. IF (IERR .NE. 0) RETURN
  264. ENDIF
  265. *
  266. * -- LECTURE DU (OU DES) "LISTMOTS" CONTENANT LES NOMS DES
  267. * COMPOSANTES DES NOEUDS D'UN ELEMENT DU SUPPORT GEOMETRIQUE --
  268. *
  269. SEGINI,MTEMP3
  270. IINCO=MTEMP3
  271. C+PP
  272. CALL LIROBJ ('TABLE',MTABLE,0,IRETOU)
  273. IF (IRETOU.EQ.1)THEN
  274. DO IE1=1,INFINI
  275. TYPOBJ=' '
  276. CALL ACCTAB(MTABLE,'ENTIER',IE1,X0,CH0,L0,IOBIN,
  277. $ TYPOBJ ,I1 ,X1,CH1,L1,IPLMOT)
  278. IF (TYPOBJ .EQ. 'LISTMOTS')THEN
  279. ILMOTS(**) = IPLMOT
  280. ELSE
  281. IF (IE1 .EQ. 1)THEN
  282. CALL ERREUR(314)
  283. SEGSUP MTEMP3
  284. RETURN
  285. ENDIF
  286. * --> SORTIE DE BOUCLE N.100
  287. GOTO 102
  288. ENDIF
  289. ENDDO
  290. ENDIF
  291. C+PP
  292. ICODE = 1
  293. DO 100 IB100=1,INFINI
  294. CALL LIROBJ ('LISTMOTS',IPLMOT,ICODE,IRETOU)
  295. IF(IERR.NE.0) THEN
  296. SEGSUP MTEMP3
  297. RETURN
  298. ENDIF
  299. IF (IRETOU .EQ. 1) THEN
  300. ILMOTS(**) = IPLMOT
  301. ELSE
  302. * --> SORTIE DE BOUCLE N.100
  303. GOTO 102
  304. END IF
  305. ICODE = 0
  306. 100 CONTINUE
  307. * END DO
  308. 102 CONTINUE
  309. SEGDES,MTEMP3
  310. *
  311. * -- LECTURE DU (OU DES) "LISTMOTS" CONTENANT LES NOMS DES
  312. * DUALES
  313. *
  314. IDUAL=0
  315. CALL LIRMOT(MODUA,1,IDU,0)
  316. IF (IDU.EQ.0) GOTO 400
  317. SEGINI,MTEM3
  318. C+PP
  319. CALL LIROBJ ('TABLE',MTABLE,0,IRETOU)
  320. IF (IRETOU.EQ.1)THEN
  321. DO IE1=1,INFINI
  322. TYPOBJ=' '
  323. CALL ACCTAB(MTABLE,'ENTIER',IE1,X0,CH0,L0,IOBIN,
  324. $ TYPOBJ ,I1 ,X1,CH1,L1,IPLMOT)
  325. IF (TYPOBJ .EQ. 'LISTMOTS')THEN
  326. MTEM3.ILMOTS(**) = IPLMOT
  327. ELSE
  328. IF (IE1 .EQ. 1)THEN
  329. CALL ERREUR(314)
  330. SEGSUP MTEMP3,MTEM3
  331. RETURN
  332. ENDIF
  333. GOTO 302
  334. ENDIF
  335. ENDDO
  336. ENDIF
  337. C+PP
  338. ICODE = 1
  339. DO 300 IB300=1,INFINI
  340. CALL LIROBJ ('LISTMOTS',IPLMOT,ICODE,IRETOU)
  341. IF(IERR.NE.0) THEN
  342. SEGSUP MTEMP3,MTEM3
  343. RETURN
  344. ENDIF
  345. IF (IRETOU .EQ. 1) THEN
  346. MTEM3.ILMOTS(**) = IPLMOT
  347. ELSE
  348. GOTO 302
  349. END IF
  350. ICODE = 0
  351. 300 CONTINUE
  352. 302 CONTINUE
  353.  
  354. SEGACT MTEMP3
  355. IF (ILMOTS(/1).NE.MTEM3.ILMOTS(/1)) THEN
  356. SEGSUP MTEMP3
  357. SEGSUP MTEM3
  358. CALL ERREUR(730)
  359. RETURN
  360. ENDIF
  361. IDUAL=MTEM3
  362. SEGDES MTEM3
  363. SEGDES MTEMP3
  364. *
  365. * Lecture du mot clé 'ANTI' ou 'QUEL'
  366. *
  367. 400 CONTINUE
  368. IAN = 0
  369. CALL LIRMOT(MOTYP,2,IAN,0)
  370. IANTI = IAN
  371. *
  372. * -- LECTURE DU (OU DES) "LISTREEL" CONTENANT LA MATRICE
  373. * ELEMENTAIRE DE RIGIDITE --
  374. *
  375. 500 CONTINUE
  376. SEGINI,MTEMP4
  377. ICODE = 1
  378. DO 200 IB200=1,INFINI
  379. CALL LIROBJ ('LISTREEL',IPLREE,ICODE,IRETOU)
  380. IF(IERR.NE.0) THEN
  381. SEGSUP MTEMP3,MTEM3
  382. SEGSUP MTEMP4
  383. RETURN
  384. ENDIF
  385. IF (IRETOU .EQ. 1) THEN
  386. ILREEL(**) = IPLREE
  387. ELSE
  388. * --> SORTIE DE BOUCLE N.200
  389. GOTO 202
  390. END IF
  391. ICODE = 0
  392. 200 CONTINUE
  393. * END DO
  394. 202 CONTINUE
  395. SEGDES,MTEMP4
  396. *
  397. * -- CREATION DE LA "RIGIDITE" --
  398. *
  399. CALL MANUR1 (LETYPE,IPELEM,IINCO,IDUAL,MTEMP4,IPRIGI,IANTI)
  400. IF (IERR .NE. 0) RETURN
  401. *
  402. * SUPPRESSION DES SEGMENTS DE TRAVAIL:
  403. MTEMP3=IINCO
  404. SEGSUP MTEMP3
  405. IF (IDUAL.NE.0) THEN
  406. MTEMP3=IDUAL
  407. SEGSUP MTEMP3
  408. ENDIF
  409. SEGSUP,MTEMP4
  410. *
  411. CALL ECROBJ ('RIGIDITE',IPRIGI)
  412. *
  413. END
  414.  
  415.  
  416.  
  417.  
  418.  
  419.  
  420.  
  421.  
  422.  

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