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 PPARAM
  120. -INC CCOPTIO
  121. -INC SMRIGID
  122. C+PP
  123. -INC SMTABLE
  124. CHARACTER*8 TYPOBJ,CH0,CH1
  125. REAL*8 X0,X1
  126. INTEGER I1
  127. LOGICAL L0,L1
  128. C+PP
  129. *
  130. SEGMENT /MTEMP3/ (ILMOTS(0)),MTEM3.MTEMP3
  131. SEGMENT /MTEMP4/ (ILREEL(0))
  132. *
  133. PARAMETER (INFINI = 9999)
  134. *
  135. CHARACTER*8 LETYPE,CTYP
  136. CHARACTER*4 MODUA(1),MOTYP(2),MOMOT(1)
  137. CHARACTER*4 MOCLE(3)
  138. *
  139. DATA MODUA(1) /'DUAL'/
  140. DATA MOTYP(1),MOTYP(2) /'ANTI','QUEL'/
  141. DATA MOMOT(1) /'TYPE'/
  142. DATA MOCLE(1),MOCLE(2),MOCLE(3) /'DIAG','COLO','LIGN'/
  143. C
  144. c
  145. C=== Syntaxe b : Rig1 = MANU RIGI (mocle) CHPO1 (...) ====================
  146. c
  147. *
  148. * -- LECTURE EVENTUELLE DU MOT CLE : DIAG ou COLO ou LIGN ... --
  149. *
  150. ICLE = 0
  151. CALL LIRMOT(MOCLE,3,ICLE,0)
  152. if(iimpi.ge.1) write(IOIMP,*) 'ICLE=',ICLE
  153. *
  154. * -- LECTURE DU CHPOINT ? --
  155. *
  156. IF (ICLE.NE.0) THEN
  157. c cas ou on a lu DIAG, COLO ou LIGN
  158. CALL LIROBJ('CHPOINT ',MCHPOI,1,IRET)
  159. IF (IERR.NE.0) RETURN
  160. ELSE
  161. c si aucun mot clé, ...
  162. c ... mais présence d'un chpoint, option DIAG par défaut
  163. CALL QUETYP(CTYP,0,IRETOU)
  164. IF (IRETOU.EQ.0) THEN
  165. c CALL ERREUR(533)
  166. c si rien du tout, CREATION D'UNE RIGIDITE VIDE
  167. NRIGEL=0
  168. segini,MRIGID
  169. IPRIGI=MRIGID
  170. MTYMAT='MANUELLE'
  171. IFORIG= IFOMOD
  172. ICHOLE = 0
  173. IMGEO1 = 0
  174. IMGEO2 = 0
  175. IFORIG = 0
  176. c ISUPEQ,JRCOND,JRDEPP,JRDEPD = 0
  177. c JRELIM,JRGARD,JRTOT,IMLAG = 0
  178. c IPROFO,IVECRI = 0
  179. segdes,MRIGID
  180. CALL ECROBJ ('RIGIDITE',IPRIGI)
  181. RETURN
  182. ENDIF
  183. IF(CTYP.EQ.'CHPOINT ') THEN
  184. ICLE = 1
  185. CALL LIROBJ(CTYP,MCHPOI,1,IRET)
  186. IF (IERR.NE.0) RETURN
  187. ENDIF
  188. c ... mais présence d'un listchpo, matrice colonne pleine
  189. IF(CTYP.EQ.'LISTCHPO') THEN
  190. ICLE = 4
  191. CALL LIROBJ(CTYP,MLCHPO,1,IRET)
  192. IF (IERR.NE.0) RETURN
  193. c lit-on une rigidite "modele" avec un mvecri ?
  194. CALL LIROBJ('RIGIDITE',IPRIG1,0,IRET)
  195. IF (IERR.NE.0) RETURN
  196. IF(IRET.NE.0) THEN
  197. MRIGID=IPRIG1
  198. SEGACT,MRIGID
  199. if(IVECRI.eq.0) then
  200. write(ioimp,*) 'pour l instant, IVECRI doit etre non nul !'
  201. call erreur(21)
  202. endif
  203. IVEC1 = IVECRI
  204. SEGDES,MRIGID
  205. ELSE
  206. c lit-on un maillage de POI1 support des chpoints
  207. c (de composante ALFA seulement)?
  208. CALL LIROBJ('MAILLAGE',IPT1,0,IRET)
  209. ICLE = 5
  210. ENDIF
  211. ENDIF
  212. ENDIF
  213. *
  214. * -- CREATION RIGIDITE DEPUIS UN CHPOINT (ou une listchpo) --
  215. *
  216. IF (ICLE.NE.0) THEN
  217. IF (ICLE.eq.1) THEN
  218. c rigidite diagonale
  219. CALL KOPDIR(MCHPOI,MRIGID)
  220. ELSEIF (ICLE.le.3) THEN
  221. c rigidite colonne ou ligne
  222. CALL RICOLO(MCHPOI,ICLE,MRIGID)
  223. ELSEIF (ICLE.eq.4) THEN
  224. c rigidite colonne pleine depuis une listchpo
  225. CALL RICOL2(MLCHPO,ICLE,MRIGID,IVEC1)
  226. ELSEIF (ICLE.eq.5) THEN
  227. c rigidite colonne pleine depuis une listchpo
  228. CALL RICOL1(MLCHPO,ICLE,MRIGID,IPT1)
  229. ELSE
  230. CALL ERREUR(19)
  231. ENDIF
  232. IF (IERR.NE.0) RETURN
  233. CALL ECROBJ('RIGIDITE',MRIGID)
  234. RETURN
  235. ENDIF
  236. c
  237. c
  238. C=== Syntaxe a : Rig1 = MANU RIGI (TYPE mot1) GEO1 LMOT1 (...) LREEL1 ====
  239. c
  240. *
  241. * -- LECTURE DU SOUS-TYPE DE LA "RIGIDITE" A CREER --
  242. *
  243. ITYP = 0
  244. CALL LIRMOT(MOMOT,1,ITYP,0)
  245. IF(ITYP.EQ.1) THEN
  246. ICODE = 1
  247. CALL LIRCHA (LETYPE,ICODE,IRETOU)
  248. IF (IERR .NE. 0) RETURN
  249. ELSE
  250. C ... Si on n'a rien trouvé, on met les blancs dedans,
  251. C sinon il y a des cochonneries ...
  252. LETYPE=' '
  253. ENDIF
  254. *
  255. * -- LECTURE DU SUPPORT GEOMETRIQUE --
  256. *
  257. CALL LIROBJ('POINT ',KPOINT,0,IRETOU)
  258. IF(IRETOU.NE.0) THEN
  259. CALL CRELEM(KPOINT)
  260. IPELEM=KPOINT
  261. ELSE
  262. ICODE = 1
  263. CALL LIROBJ ('MAILLAGE',IPELEM,ICODE,IRETOU)
  264. IF (IERR .NE. 0) RETURN
  265. ENDIF
  266. *
  267. * -- LECTURE DU (OU DES) "LISTMOTS" CONTENANT LES NOMS DES
  268. * COMPOSANTES DES NOEUDS D'UN ELEMENT DU SUPPORT GEOMETRIQUE --
  269. *
  270. SEGINI,MTEMP3
  271. IINCO=MTEMP3
  272. C+PP
  273. CALL LIROBJ ('TABLE',MTABLE,0,IRETOU)
  274. IF (IRETOU.EQ.1)THEN
  275. DO IE1=1,INFINI
  276. TYPOBJ=' '
  277. CALL ACCTAB(MTABLE,'ENTIER',IE1,X0,CH0,L0,IOBIN,
  278. $ TYPOBJ ,I1 ,X1,CH1,L1,IPLMOT)
  279. IF (TYPOBJ .EQ. 'LISTMOTS')THEN
  280. ILMOTS(**) = IPLMOT
  281. ELSE
  282. IF (IE1 .EQ. 1)THEN
  283. CALL ERREUR(314)
  284. SEGSUP MTEMP3
  285. RETURN
  286. ENDIF
  287. * --> SORTIE DE BOUCLE N.100
  288. GOTO 102
  289. ENDIF
  290. ENDDO
  291. ENDIF
  292. C+PP
  293. ICODE = 1
  294. DO 100 IB100=1,INFINI
  295. CALL LIROBJ ('LISTMOTS',IPLMOT,ICODE,IRETOU)
  296. IF(IERR.NE.0) THEN
  297. SEGSUP MTEMP3
  298. RETURN
  299. ENDIF
  300. IF (IRETOU .EQ. 1) THEN
  301. ILMOTS(**) = IPLMOT
  302. ELSE
  303. * --> SORTIE DE BOUCLE N.100
  304. GOTO 102
  305. END IF
  306. ICODE = 0
  307. 100 CONTINUE
  308. * END DO
  309. 102 CONTINUE
  310. SEGDES,MTEMP3
  311. *
  312. * -- LECTURE DU (OU DES) "LISTMOTS" CONTENANT LES NOMS DES
  313. * DUALES
  314. *
  315. IDUAL=0
  316. CALL LIRMOT(MODUA,1,IDU,0)
  317. IF (IDU.EQ.0) GOTO 400
  318. SEGINI,MTEM3
  319. C+PP
  320. CALL LIROBJ ('TABLE',MTABLE,0,IRETOU)
  321. IF (IRETOU.EQ.1)THEN
  322. DO IE1=1,INFINI
  323. TYPOBJ=' '
  324. CALL ACCTAB(MTABLE,'ENTIER',IE1,X0,CH0,L0,IOBIN,
  325. $ TYPOBJ ,I1 ,X1,CH1,L1,IPLMOT)
  326. IF (TYPOBJ .EQ. 'LISTMOTS')THEN
  327. MTEM3.ILMOTS(**) = IPLMOT
  328. ELSE
  329. IF (IE1 .EQ. 1)THEN
  330. CALL ERREUR(314)
  331. SEGSUP MTEMP3,MTEM3
  332. RETURN
  333. ENDIF
  334. GOTO 302
  335. ENDIF
  336. ENDDO
  337. ENDIF
  338. C+PP
  339. ICODE = 1
  340. DO 300 IB300=1,INFINI
  341. CALL LIROBJ ('LISTMOTS',IPLMOT,ICODE,IRETOU)
  342. IF(IERR.NE.0) THEN
  343. SEGSUP MTEMP3,MTEM3
  344. RETURN
  345. ENDIF
  346. IF (IRETOU .EQ. 1) THEN
  347. MTEM3.ILMOTS(**) = IPLMOT
  348. ELSE
  349. GOTO 302
  350. END IF
  351. ICODE = 0
  352. 300 CONTINUE
  353. 302 CONTINUE
  354.  
  355. SEGACT MTEMP3
  356. IF (ILMOTS(/1).NE.MTEM3.ILMOTS(/1)) THEN
  357. SEGSUP MTEMP3
  358. SEGSUP MTEM3
  359. CALL ERREUR(730)
  360. RETURN
  361. ENDIF
  362. IDUAL=MTEM3
  363. SEGDES MTEM3
  364. SEGDES MTEMP3
  365. *
  366. * Lecture du mot clé 'ANTI' ou 'QUEL'
  367. *
  368. 400 CONTINUE
  369. IAN = 0
  370. CALL LIRMOT(MOTYP,2,IAN,0)
  371. IANTI = IAN
  372. *
  373. * -- LECTURE DU (OU DES) "LISTREEL" CONTENANT LA MATRICE
  374. * ELEMENTAIRE DE RIGIDITE --
  375. *
  376. 500 CONTINUE
  377. SEGINI,MTEMP4
  378. ICODE = 1
  379. DO 200 IB200=1,INFINI
  380. CALL LIROBJ ('LISTREEL',IPLREE,ICODE,IRETOU)
  381. IF(IERR.NE.0) THEN
  382. SEGSUP MTEMP3,MTEM3
  383. SEGSUP MTEMP4
  384. RETURN
  385. ENDIF
  386. IF (IRETOU .EQ. 1) THEN
  387. ILREEL(**) = IPLREE
  388. ELSE
  389. * --> SORTIE DE BOUCLE N.200
  390. GOTO 202
  391. END IF
  392. ICODE = 0
  393. 200 CONTINUE
  394. * END DO
  395. 202 CONTINUE
  396. SEGDES,MTEMP4
  397. *
  398. * -- CREATION DE LA "RIGIDITE" --
  399. *
  400. CALL MANUR1 (LETYPE,IPELEM,IINCO,IDUAL,MTEMP4,IPRIGI,IANTI)
  401. IF (IERR .NE. 0) RETURN
  402. *
  403. * SUPPRESSION DES SEGMENTS DE TRAVAIL:
  404. MTEMP3=IINCO
  405. SEGSUP MTEMP3
  406. IF (IDUAL.NE.0) THEN
  407. MTEMP3=IDUAL
  408. SEGSUP MTEMP3
  409. ENDIF
  410. SEGSUP,MTEMP4
  411. *
  412. CALL ECROBJ ('RIGIDITE',IPRIGI)
  413. *
  414. END
  415.  
  416.  
  417.  
  418.  
  419.  
  420.  
  421.  
  422.  
  423.  

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