Télécharger ricolo.eso

Retour à la liste

Numérotation des lignes :

  1. C RICOLO SOURCE BP208322 15/06/22 21:21:57 8543
  2. C
  3. SUBROUTINE RICOLO(MCHPOI,ICLE,MRIGID)
  4.  
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. IMPLICIT INTEGER (I-N)
  7.  
  8. C***********************************************************************
  9. C NOM : RICOLO
  10. C DESCRIPTION : Transforme un CHPOINT MCHPOI en matrice colonne MRIGID
  11. C En pratique on fait plein de matrices carrées 2x2
  12. C LANGAGE : ESOPE
  13. C
  14. C AUTEUR, DATE, MODIF :
  15. C 16/02/2012, Benoit Prabel : creation
  16. C
  17. C ... merci de compléter les evolutions futures ...
  18. C
  19. C***********************************************************************
  20. C ENTREES : MCHPOI (+ autres lectures internes a ricolo)
  21. C ENTREES/SORTIES :
  22. C SORTIES : MRIGID
  23. C***********************************************************************
  24.  
  25. -INC CCOPTIO
  26. -INC SMRIGID
  27. -INC SMCHPOI
  28. -INC SMELEME
  29. -INC CCHAMP
  30. -INC SMLMOTS
  31.  
  32. CHARACTER*4 MODUAL,MOPRIM
  33. CHARACTER*4 MOSYM(3),MOOPT(2)
  34. CHARACTER*4 MOMOT(1)
  35. CHARACTER*8 LETYPE
  36. DATA MOSYM/'SYME','ANTI','QUEL'/
  37. DATA MOOPT/'PRIM','DUAL'/
  38. DATA MOMOT(1) /'TYPE'/
  39. LOGICAL fldiag
  40.  
  41. c***********************************************************************
  42. c Executable statements
  43. c***********************************************************************
  44.  
  45. c======================================================================c
  46. c RECUPERATION DES AUTRES OBJETS d ENTREE ET VERIFICATION DES DONNEES
  47.  
  48. c colonne ou ligne = seuls choix possibles
  49. IF(ICLE.ne.2.and.ICLE.ne.3) THEN
  50. write(IOIMP,*) 'VALEUR DE ICLE ERRONNEE =',ICLE
  51. & ,' LORS DE L APPEL A RICOLO ERRONNE'
  52. CALL ERREUR(21)
  53. ENDIF
  54.  
  55. c symetrique, antisymetrique ou quelconque (syme par defaut)
  56. ISYM = 0
  57. CALL LIRMOT(MOSYM,3,ISYM,0)
  58. if(ISYM.eq.0) ISYM=1
  59.  
  60. * LECTURE DU SUPPORT GEOMETRIQUE (1 seul point admis pour l instant)
  61. CALL LIROBJ('POINT ',KPOINT,1,IRETOU)
  62. IF(IRETOU.EQ.0) CALL ERREUR(20)
  63. IF(IERR.NE.0) RETURN
  64. c CALL CRELEM(KPOINT)
  65. c IPELEM=KPOINT
  66.  
  67. * LECTURE DU NOM DU PRIMAL/DUAL (selon option colonne/ligne )
  68. * ASSOCIE A KPOINT + deduction de l'autre
  69. idd1=0
  70. c option colonne : on cherche l inconnue primale
  71. IF(ICLE.eq.2) THEN
  72. CALL LIRMOT(NOMDD,LNOMDD,idd1,0)
  73. if (idd1.ne.0) then
  74. MOPRIM=NOMDD(idd1)
  75. MODUAL=NOMDU(idd1)
  76. c si mot clé 'DUAL' + nom du dual alors MODUAL prend ce nom-la
  77. CALL LIRMOT(MOOPT(2),1,IOPT,0)
  78. if(iopt.ne.0) then
  79. CALL LIRCHA(MODUAL,1,IRETOU)
  80. IF(IERR.NE.0) RETURN
  81. endif
  82. else
  83. CALL LIRCHA(MOPRIM,1,IRETOU)
  84. CALL LIRMOT(MOOPT(2),1,IOPT,0)
  85. if(iopt.ne.0) then
  86. CALL LIRCHA(MODUAL,1,IRETOU)
  87. IF(IERR.NE.0) RETURN
  88. else
  89. MODUAL=MOPRIM
  90. write(IOIMP,*) 'Attention vous utilisez l inconnue PRIMale '
  91. $ ,MOPRIM,' non définie dans NOMDD du bdata...'
  92. write(IOIMP,*) 'On utilise ',MODUAL,' comme DUALe associee'
  93. endif
  94. endif
  95. ENDIF
  96. c option ligne : on cherche l inconnue duale
  97. IF(ICLE.eq.3) THEN
  98. CALL LIRMOT(NOMDU,LNOMDU,idd1,0)
  99. if (idd1.ne.0) then
  100. MOPRIM=NOMDD(idd1)
  101. MODUAL=NOMDU(idd1)
  102. c si mot clé 'PRIM' + nom du primal alors MOPRIM prend ce nom-la
  103. CALL LIRMOT(MOOPT(1),1,IOPT,0)
  104. if(iopt.ne.0) then
  105. CALL LIRCHA(MOPRIM,1,IRETOU)
  106. IF(IERR.NE.0) RETURN
  107. endif
  108. else
  109. CALL LIRCHA(MODUAL,1,IRETOU)
  110. CALL LIRMOT(MOOPT(1),1,IOPT,0)
  111. if(iopt.ne.0) then
  112. CALL LIRCHA(MOPRIM,1,IRETOU)
  113. IF(IERR.NE.0) RETURN
  114. else
  115. MOPRIM=MODUAL
  116. write(IOIMP,*) 'Attention vous utilisez l inconnue DUALe '
  117. $ ,MODUAL,' non définie dans NOMDU du bdata...'
  118. write(IOIMP,*) 'On utilise ',MOPRIM,' comme PRIMale associee'
  119. endif
  120. endif
  121. ENDIF
  122. if(iimpi.ge.1)write(IOIMP,*)'ICLE,PRIMAL,DUAL',ICLE,MOPRIM,MODUAL
  123. IF(IERR.NE.0) RETURN
  124.  
  125.  
  126. MLMOT1=0
  127. MLMOT2=0
  128. CALL LIROBJ('LISTMOTS',MLMOT1,0,IRETOU)
  129. IF(MLMOT1.ne.0) THEN
  130. CALL LIROBJ('LISTMOTS',MLMOT2,1,IRETOU)
  131. IF(IERR.NE.0) RETURN
  132. segact,MLMOT1,MLMOT2
  133. NLMOT1=MLMOT1.MOTS(/2)
  134. NLMOT2=MLMOT2.MOTS(/2)
  135. ENDIF
  136.  
  137.  
  138. c======================================================================c
  139. C TRAVAIL SUR LE CHPOINT
  140.  
  141. SEGACT MCHPOI
  142. NSOUPO = IPCHP(/1)
  143. C On compte le nombre de matrices à générer
  144. NRIGEL=0
  145. DO ISOUPO = 1, NSOUPO
  146. MSOUPO = IPCHP(ISOUPO)
  147. SEGACT MSOUPO
  148. NC=NOCOMP(/2)
  149. NRIGEL=NRIGEL+NC
  150. SEGDES MSOUPO
  151. ENDDO
  152. SEGINI MRIGID
  153. * BP 01/04/2014 ajout d'un type a la rigidite (recopie de manuri.eso)
  154. * -- LECTURE DU SOUS-TYPE DE LA "RIGIDITE" A CREER --
  155. ITYP = 0
  156. CALL LIRMOT(MOMOT,1,ITYP,0)
  157. IF(ITYP.EQ.1) THEN
  158. ICODE = 1
  159. CALL LIRCHA (LETYPE,ICODE,IRETOU)
  160. IF (IERR .NE. 0) RETURN
  161. ELSE
  162. C ... Si on n'a rien trouvé, on met un sous type par defaut dedans
  163. IF(ICLE.eq.2) LETYPE='COLONNE '
  164. IF(ICLE.eq.3) LETYPE='LIGNE '
  165. ENDIF
  166. MTYMAT=LETYPE
  167. C
  168. IRIG=0
  169. C====> BOUCLE SUR LES ZONES DU CHPOINT ======================
  170. DO ISOUPO = 1, NSOUPO
  171. if(iimpi.ge.2) write(IOIMP,*)' Sous-zone',ISOUPO,'/',NSOUPO
  172. MSOUPO = IPCHP(ISOUPO)
  173. SEGACT MSOUPO
  174. NC=NOCOMP(/2)
  175. MELEME=IGEOC
  176. SEGACT MELEME
  177. NBEL=NUM(/2)
  178. c Le meleme d un chpoint est constitué de poi1 (=elements a 1 noeud)
  179. c creation d une geometrie IPT1 avec KPOINT + IGEOC (=> 1+1=2 noeuds)
  180. NBNN=2
  181. NBSOUS=0
  182. NBREF=0
  183. NBELEM=NBEL
  184. SEGINI,IPT1
  185. IPT1.ITYPEL=28
  186. Jdiag = 0
  187. DO JEL=1,NBEL
  188. IPT1.NUM(1,JEL)=KPOINT
  189. IPT1.NUM(2,JEL)=NUM(1,JEL)
  190. * on repere une eventuelle diagonale
  191. if(IPT1.NUM(1,JEL).eq.IPT1.NUM(2,JEL)) Jdiag=JEL
  192. ENDDO
  193. c fin de fabrication de IPT1
  194. SEGDES,MELEME,IPT1
  195. MPOVAL=IPOVAL
  196. SEGACT MPOVAL
  197.  
  198. C ---> BOUCLE SUR LES COMPOSANTES ---------
  199. DO IC=1,NC
  200.  
  201. IRIG=IRIG+1
  202. if(iimpi.ge.2)
  203. & write(IOIMP,*)' Composante',IC,'/',NC,' -> rigidite ',IRIG
  204.  
  205. c ---infos generales---
  206. COERIG(IRIG)=1.D0
  207. IRIGEL(1,IRIG)=IPT1
  208. IRIGEL(5,IRIG)=NIFOUR
  209. IRIGEL(7,IRIG)=ISYM-1
  210. NLIGRP=2
  211. NLIGRD=2
  212.  
  213. c ---segment DESCRipteur---
  214. SEGINI DESCR
  215. LISINC(1)=MOPRIM
  216. LISDUA(1)=MODUAL
  217. NOELEP(1)=1
  218. NOELED(1)=1
  219. NOELEP(2)=2
  220. NOELED(2)=2
  221.  
  222. * -Cas colonne : on a un chpoint de dual : il faut retrouver le primal
  223. IF(ICLE.eq.2) THEN
  224.  
  225. idd2=0
  226. c cas ou on a fourni MLMOT1 et MLMOT2
  227. IF(MLMOT1.ne.0) THEN
  228. CALL PLACE(MLMOT1.MOTS,NLMOT1,idd2,NOCOMP(IC))
  229. IF (idd2.NE.0) THEN
  230. LISINC(2)=MLMOT2.MOTS(idd2)
  231. ELSE
  232. write(IOMIP,*) 'On ne trouve pas ',NOCOMP(IC),
  233. $ ' dans le listmot ',MLMOT1
  234. call erreur(488)
  235. ENDIF
  236. c cas ou cherche la correspondance
  237. ELSE
  238. CALL PLACE(NOMDU,LNOMDU,idd2,NOCOMP(IC))
  239. IF (idd2.NE.0) THEN
  240. LISINC(2)=NOMDD(idd2)
  241. ELSE
  242. LISINC(2)=NOCOMP(IC)
  243. write(IOIMP,*) 'Attention le chpoint utilise la duale '
  244. $ ,NOCOMP(IC),' non definie dans NOMDU du bdata...'
  245. write(IOIMP,*) 'On utilise ',NOCOMP(IC)
  246. $ ,' comme primale associee'
  247. ENDIF
  248. ENDIF
  249. LISDUA(2)=NOCOMP(IC)
  250.  
  251. * -Cas ligne : on a un chpoint de primal : il faut retrouver le dual
  252. ELSE
  253.  
  254. idd2=0
  255. c cas ou on a fourni MLMOT1 et MLMOT2
  256. IF(MLMOT1.ne.0) THEN
  257. CALL PLACE(MLMOT1.MOTS,NLMOT1,idd2,NOCOMP(IC))
  258. IF (idd2.NE.0) THEN
  259. LISDUA(2)=MLMOT2.MOTS(idd2)
  260. ELSE
  261. write(IOMIP,*) 'On ne trouve pas ',NOCOMP(IC),
  262. $ ' dans le listmot ',MLMOT1
  263. call erreur(488)
  264. ENDIF
  265. c cas ou cherche la correspondance
  266. ELSE
  267. CALL PLACE(NOMDD,LNOMDD,idd2,NOCOMP(IC))
  268. IF (idd2.NE.0) THEN
  269. LISDUA(2)=NOMDU(idd2)
  270. ELSE
  271. LISDUA(2)=NOCOMP(IC)
  272. write(IOIMP,*) 'Attention le chpoint utilise la primale '
  273. $ ,NOCOMP(IC),' non definie dans NOMDD du bdata...'
  274. write(IOIMP,*) 'On utilise ',NOCOMP(IC)
  275. $ ,' comme duale associee'
  276. ENDIF
  277. ENDIF
  278. LISINC(2)=NOCOMP(IC)
  279.  
  280. ENDIF
  281.  
  282. if(iimpi.ge.2) then
  283. write(IOIMP,*)' LISINC = ',(LISINC(iou),iou=1,2)
  284. write(IOIMP,*)' LISDUA = ',(LISDUA(iou),iou=1,2)
  285. endif
  286. c debut du test pour savoir si on se situe sur une diagonale
  287. fldiag = LISINC(1).eq.LISINC(2).and.LISDUA(1).eq.LISDUA(2)
  288. SEGDES DESCR
  289. IRIGEL(3,IRIG)=DESCR
  290.  
  291. c ---matrice XMATRI proprement dite ---
  292. NELRIG=NBEL
  293. SEGINI XMATRI
  294. c -cas symetrique (cas par defaut)
  295. IF(ISYM.le.1) THEN
  296. DO JEL=1,NBEL
  297. c RE(1,1,JEL)=0.D0
  298. RE(1,2,JEL)=VPOCHA(JEL,IC)
  299. RE(2,1,JEL)=VPOCHA(JEL,IC)
  300. c RE(2,2,JEL)=0.D0
  301. ENDDO
  302. c petite correction pour ne pas remplir 2 fois la meme case !
  303. c (=cas de la diagonale)
  304. c rem : inutile dans les cas antisymetrique et quelconque
  305. if(Jdiag.ne.0.and.fldiag) then
  306. RE(1,1,Jdiag)=VPOCHA(Jdiag,IC)
  307. RE(1,2,Jdiag)=0.D0
  308. RE(2,1,Jdiag)=0.D0
  309. RE(2,2,Jdiag)=0.D0
  310. endif
  311. ENDIF
  312. c -cas antisymetrique
  313. IF(ISYM.eq.2) THEN
  314. IF(ICLE.eq.2) THEN
  315. DO JEL=1,NBEL
  316. c RE(1,1,JEL)=0.D0
  317. RE(1,2,JEL)=-1.D0*VPOCHA(JEL,IC)
  318. RE(2,1,JEL)=VPOCHA(JEL,IC)
  319. c RE(2,2,JEL)=0.D0
  320. ENDDO
  321. ELSE
  322. DO JEL=1,NBEL
  323. c RE(1,1,JEL)=0.D0
  324. RE(1,2,JEL)=VPOCHA(JEL,IC)
  325. RE(2,1,JEL)=-1.D0*VPOCHA(JEL,IC)
  326. c RE(2,2,JEL)=0.D0
  327. ENDDO
  328. ENDIF
  329. ENDIF
  330. c -cas quelconque
  331. IF(ISYM.eq.3) THEN
  332. IF(ICLE.eq.2) THEN
  333. DO JEL=1,NBEL
  334. c RE(1,1,JEL)=0.D0
  335. c RE(1,2,JEL)=0.D0
  336. RE(2,1,JEL)=VPOCHA(JEL,IC)
  337. c RE(2,2,JEL)=0.D0
  338. ENDDO
  339. ELSE
  340. DO JEL=1,NBEL
  341. c RE(1,1,JEL)=0.D0
  342. RE(1,2,JEL)=VPOCHA(JEL,IC)
  343. c RE(2,1,JEL)=0.D0
  344. c RE(2,2,JEL)=0.D0
  345. ENDDO
  346. ENDIF
  347. ENDIF
  348. if(iimpi.ge.2) then
  349. write(IOIMP,*)' RE(1,:) = ',(RE(1,iou),iou=1,2)
  350. write(IOIMP,*)' RE(2,:) = ',(RE(2,iou),iou=1,2)
  351. endif
  352. SEGDES XMATRI
  353. IRIGEL(4,IRIG)=XMATRI
  354.  
  355.  
  356. ENDDO
  357. C <--- FIN DE BOUCLE SUR LES COMPOSANTES ---------
  358. SEGDES MPOVAL
  359. SEGDES MSOUPO
  360.  
  361. ENDDO
  362. C<==== FIN DE BOUCLE SUR LES ZONES DU CHPOINT ======================
  363. SEGDES MRIGID
  364. SEGDES MCHPOI
  365.  
  366. IF(MLMOT1.ne.0) THEN
  367. segdes,MLMOT1,MLMOT2
  368. ENDIF
  369.  
  370. c***********************************************************************
  371. C Normal termination
  372. c***********************************************************************
  373.  
  374. RETURN
  375.  
  376.  
  377. c***********************************************************************
  378. c End of subroutine
  379. c***********************************************************************
  380.  
  381. END
  382.  
  383.  
  384.  
  385.  
  386.  
  387.  
  388.  
  389.  
  390.  

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