Télécharger lirnas.eso

Retour à la liste

Numérotation des lignes :

  1. C LIRNAS SOURCE CB215821 17/02/21 21:15:01 9317
  2. SUBROUTINE LIRNAS
  3.  
  4. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  5. C
  6. C BUT: Lecture des données au format NASTRAN sous forme de
  7. C fichier NAS (ASCII). Les données sont logées dans une table
  8. C qui est renvoyée comme résultat.
  9. C
  10. C Auteur : Clément BERTHINIER
  11. C Mai 2016
  12. C
  13. C Liste des Corrections :
  14. C CB215821 : Ajout des cartes de PROPERTY lors de la lecture
  15. C CB215821 : Correction d'un MELEME mal defini
  16. C CB215821 : Sur SEMT2, si une chaine de caractere contient le retour
  17. C chariot, le READ sort sur ERR=
  18. C
  19. C Appelé par : LIREFI
  20. C
  21. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  22.  
  23.  
  24. IMPLICIT INTEGER(I-N)
  25. IMPLICIT REAL*8 (A-H,O-Z)
  26.  
  27.  
  28. C Déclarations
  29. CHARACTER*256 FicNAS
  30. CHARACTER*80 LIGNE,COLO80
  31. CHARACTER*17 COLO17
  32. CHARACTER*16 COLO16
  33. CHARACTER*9 COLO9
  34. CHARACTER*8 COLO8
  35. CHARACTER*4 COLO4
  36.  
  37. LOGICAL BEGIN, PRECID
  38.  
  39. C Unite logique du fichier d'impression au format .nas et nom du fichier
  40. PARAMETER (IUNAS=68)
  41.  
  42. C Définition des COMMON utiles
  43. -INC CCOPTIO
  44. -INC CCREEL
  45. -INC SMCOORD
  46. -INC CCGEOME
  47. -INC SMELEME
  48. -INC TMTRAV
  49. -INC SMTABLE
  50.  
  51. C Déclaration de tableaux
  52.  
  53. PARAMETER (NBFLO=3 )
  54. REAL*8 XFL(NBFLO )
  55.  
  56. PARAMETER (NBGEO1=32 )
  57. PARAMETER (NBSY =6 )
  58. PARAMETER (NBCART=20 )
  59. PARAMETER (NPROPE=3 )
  60. CHARACTER*8 GETYPE(NBGEO1+NBSY+NBCART),PROTYP(NPROPE)
  61. INTEGER NONLUE(NBGEO1+NBSY+NBCART)
  62. CHARACTER*4 ELCAS1(NBGEO1)
  63. CHARACTER*4 ELCAS2(NBGEO1)
  64.  
  65. C IELEQ1 : Place dans NOMS des elements equivalents dans Cast3M d'ordre 1
  66. C IELEQ2 : Place dans NOMS des elements equivalents dans Cast3M d'ordre 2
  67. C NBNOE1 : Nombre de noeuds pour l'element concerne d'ordre 1
  68. C NBNOE2 : Nombre de noeuds pour l'element concerne d'ordre 2
  69. INTEGER IELEQ1(NBGEO1)
  70. INTEGER IELEQ2(NBGEO1)
  71. INTEGER NBNOE1(NBGEO1)
  72. INTEGER NBNOE2(NBGEO1)
  73.  
  74.  
  75. PARAMETER (NBGEO2=15)
  76. INTEGER IORDCO(NBGEO2*20)
  77. CHARACTER*4 CTYPE(NBGEO2)
  78.  
  79. C Liste des CARACTERES RECONNUS pour détecter les CR et LF
  80. CHARACTER*76 CARAOK
  81. DATA CARAOK /'0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOP
  82. &QRSTUVWXYZ+-/*=.,:;=?&_#'/
  83.  
  84. C Liste des mots clés en début de ligne d'un fichier .nas
  85. DATA GETYPE / 'GRID ','GRID* ',
  86. & 'RBE2 ','RBE2* ','RBE3 ','RBE3* ',
  87. & 'CTRIA3 ','CTRIA3* ',
  88. & 'CTRIA6 ','CTRIA6* ',
  89. & 'CQUAD4 ','CQUAD4* ',
  90. & 'CQUAD8 ','CQUAD8* ',
  91. & 'CTETRA ','CTETRA* ',
  92. & 'CPYRA ','CPYRA* ',
  93. & 'CPENTA ','CPENTA* ',
  94. & 'CHEXA ','CHEXA* ',
  95. & 'CBAR ','CBAR* ','CBEAM ','CBEAM* ',
  96. & 'CONM2 ','CONM2* ','RBAR ','RBAR* ',
  97. & 'CELAS2 ','CELAS2* ',
  98. & 'CORD2R ','CORD2R* ','CORD2C ','CORD2C* ',
  99. & 'CORD2S ','CORD2S* ',
  100. & 'SPC ','SPC* ','SPCD ','SPCD* ',
  101. & 'LOAD ','LOAD* ','PLOAD ','PLOAD* ',
  102. & 'PLOAD1 ','PLOAD1* ','PLOAD2 ','PLOAD2* ',
  103. & 'PLOAD4 ','PLOAD4* ','FORCE ','FORCE* ',
  104. & 'MOMENT ','MOMENT* ','TEMP ','TEMP* ' /
  105.  
  106. DATA PROTYP / 'PROD ','PSHELL ','PSOLID ' /
  107.  
  108. C Elements equivalents dans Cast3M
  109. DATA ELCAS1 / 'POI1','POI1',
  110. & 'SEG2','SEG2',
  111. & 'SEG3','SEG3',
  112. & 'TRI3','TRI3',
  113. & 'TRI6','TRI6',
  114. & 'QUA4','QUA4',
  115. & 'QUA8','QUA8',
  116. & 'TET4','TET4',
  117. & 'PYR5','PYR5',
  118. & 'PRI6','PRI6',
  119. & 'CUB8','CUB8',
  120. & 'SEG2','SEG2',
  121. & 'SEG2','SEG2',
  122. & 'POI1','POI1',
  123. & 'SEG2','SEG2',
  124. & 'SEG2','SEG2' /
  125.  
  126. C Elements alternatifs equivalents dans Cast3M (Meme nom entre ordre 1 et ordre 2)
  127. C pour les éléments CTETRA, CPYRA, CPENTA, CHEXA
  128. DATA ELCAS2 / 'POI1','POI1',
  129. & 'SEG2','SEG2',
  130. & 'SEG3','SEG3',
  131. & 'TRI3','TRI3',
  132. & 'TRI6','TRI6',
  133. & 'QUA4','QUA4',
  134. & 'QUA8','QUA8',
  135. & 'TE10','TE10',
  136. & 'PY13','PY13',
  137. & 'PR15','PR15',
  138. & 'CU20','CU20',
  139. & 'SEG2','SEG2',
  140. & 'SEG2','SEG2',
  141. & 'POI1','POI1',
  142. & 'SEG2','SEG2',
  143. & 'SEG2','SEG2' /
  144.  
  145. C Le nombre de noeuds est lu dans NBNNE(i) (bdata.eso)
  146. C 'i' est l''index de l''élément de Cast3M dans NOMS (bdata.eso)
  147.  
  148. C Data indiquant le nom de l'element auquel correspond IORDCO
  149. DATA CTYPE /
  150. & 'POI1',
  151. & 'SEG2',
  152. & 'SEG3',
  153. & 'TRI3',
  154. & 'TRI6',
  155. & 'QUA4',
  156. & 'QUA8',
  157. & 'TET4',
  158. & 'TE10',
  159. & 'PYR5',
  160. & 'PY13',
  161. & 'PRI6',
  162. & 'PR15',
  163. & 'CUB8',
  164. & 'CU20' /
  165.  
  166.  
  167. C Data permettrant de mettre le bon ordre dans la connectivité des éléments
  168. C Le facteur 20 de ce DATA vient du fait que l'élément le plus
  169. C Complexe a une connectivité à 20 éléments (CU20 ou HEXA 2nd Ordre)
  170. DATA IORDCO /
  171. & 1,0,0,0 ,0,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 , POI1
  172. & 1,2,0,0 ,0,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 , SEG2
  173. & 3,1,2,0 ,0,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 , SEG3
  174. & 1,2,3,0 ,0,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 , TRI3
  175. & 1,4,2,5 ,3,6 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 , TRI6
  176. & 1,2,3,4 ,0,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 , QUA4
  177. & 1,5,2,6 ,3,7 ,4 ,8 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 , QUA8
  178. & 1,2,3,4 ,0,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 , TET4
  179. & 1,5,2,6 ,3,7 ,8 ,9 ,10,4 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 , TE10
  180. & 1,2,3,4 ,5,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 , PYR5
  181. & 2,7,3,8 ,4,9 ,1 ,6 ,11,12,13,10,5 ,0 ,0 ,0 ,0,0 ,0,0 , PY13
  182. & 1,2,3,4 ,5,6 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 , PRI6
  183. & 1,7,2,8 ,3,9 ,10,11,12,4 ,13,5 ,14,6 ,15,0 ,0,0 ,0,0 , PR15
  184. & 1,2,3,4 ,5,6 ,7 ,8 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 , CUB8
  185. & 1,9,2,10,3,11,4 ,12,13,14,15,16,5 ,17,6 ,18,7,19,8,20 / CU20
  186.  
  187.  
  188. C***********************************************************************
  189. C Définition des différents segments et de leur contenu
  190. C***********************************************************************
  191. C Enregistrement des POINTS du MODELE
  192. SEGMENT MLINOE
  193. C JGNOLU : ID du noeud lu dans le fichier
  194. C ICORNO : Correspondance depuis la numérotation lue vers la numérotation LOCALE des noeuds
  195. C ISYSTE : Entier valant 0 pour le systeme global et l'ID du systeme sinon
  196. C XCOLU : FLOTTANTS indiquant les coordonnées non transformées par les systèmes
  197. INTEGER ICORNO(JGNOLU)
  198. INTEGER ISYSTE(JGNOLU)
  199. REAL*8 XCOLU (3,JGNOLU)
  200. ENDSEGMENT
  201.  
  202. C Enregistrement des ELEMENTS du MODELE
  203. SEGMENT MLIELE
  204. C JGELLO : ID de l''élément dans la numérotation LOCALE
  205. C JGELLU : ID de l''élément lu dans le fichier
  206. C JELCON : Nombre total connectivité lues
  207. C IELCON : Ou aller lire le début de la connectivité dans MLIELE.ICONTO
  208. C IELNBN : Nombre de noeuds de connectivité à lire dans MLIELE.ICONTO
  209. C IELTYP : Type de l''élément lu pour Cast3M
  210. C IDPROP : ID de la propriété
  211. C IRBE2 : Code du bloquage pour RBE2
  212. C ICONTO : Tableau dans lequel sont placées toutes les connectivités les unes après les autres
  213. C ICOREL : Correspondance depuis la numérotation LOCALE vers la numérotation lue des ELEMENTS
  214. INTEGER IELCON(JGELLU)
  215. INTEGER IELNBN(JGELLU)
  216. INTEGER IELTYP(JGELLU)
  217. INTEGER IDPROP(JGELLU)
  218. INTEGER IRBE2 (JGELLU)
  219. INTEGER ICONTO(JELCON)
  220. INTEGER ICOREL(JGELLO)
  221. ENDSEGMENT
  222.  
  223. C Enregistrement des PROPERTY du MODELE
  224. SEGMENT MPROP
  225. C NBPROP : Nombre de Property dans le MODELE
  226. C ICOPRO : Correspondance entre le numéro d''ordre de lecture et l''ID de la propriete lue
  227. C ITYPRO : Type de MELEME presents dans la Property (taille de NOMS est spécifiée maximum égale à 100 dans CCGEOME.INC)
  228. C IMELSI : Pointeur MELEME SIMPLE du TYPE en question
  229. C NBELPR : Nombre d''element a mesure qu''ils sont triés (à la fin)
  230. C IMELCO : Pointeur MELEME COMPLEXE
  231. INTEGER ICOPRO(NBPROP)
  232. INTEGER ITYPRO(100,NBPROP)
  233. INTEGER IMELSI(100,NBPROP)
  234. INTEGER NBELPR(100,NBPROP)
  235. INTEGER IMELCO(NBPROP)
  236. ENDSEGMENT
  237.  
  238. C Enregistrement des SYSTEME du MODELE
  239. SEGMENT MSYSTE
  240. C JGSYST : Nombre de systemes dans le MODELE
  241. C ITYSYS : Type du systeme 1 Cartesien, 2 Cylindrique, 3 Spherique
  242. C IDSYST : Tableau contenant les ID des systemes dans l''ordre de lecture
  243. C INOSYS : Numéro des 4 noeuds du systeme dans la numérotation absolue de Cast3M
  244. C SYSCOR : 12 Coordonnees des noeuds du systeme 9 suffisent les 3 dernières sont calculées par produit vectoriel
  245. C SCOOR2 : matrice de passage du repère local au repere global
  246. INTEGER IDSYST(JGSYST)
  247. INTEGER ITYSYS(JGSYST)
  248. INTEGER INOSYS(4,JGSYST)
  249. REAL*8 SYSCOR(12,JGSYST)
  250. REAL*8 SCOOR2(9,JGSYST)
  251. ENDSEGMENT
  252.  
  253. C Enregistrement des RBE2 (Rigid Body)
  254. SEGMENT MRBE2
  255. C JGRBE2 : Nombre de RBE2 de type differents dans le MODELE
  256. C NELRBE : Tableau indiquant combient de RBE de ce type il faut creer
  257. C IBLRBE : Code du bloquage pour ce RBE2
  258. C IMELRB : Pointeur MELEME SIMPLE du TYPE en question
  259. INTEGER NELRBE(JGRBE2)
  260. INTEGER IBLRBE(JGRBE2)
  261. INTEGER IMELRB(JGRBE2)
  262. ENDSEGMENT
  263.  
  264. C Enregistrement des SPC (Blocages)
  265. SEGMENT MSPC
  266. C JGSPC : Nombre de SPC dans le MODELE
  267. C NBSDIF : Nombre d''ID de SPC
  268. C IDSPC : ID lue pour ce SPC
  269. C ILISPC : Liste des ID de SPC differents
  270. C NBESPC : nombre d''elements PO1I dans cet ID de SPC
  271. C INOSPC : ID lue du noeud pour ce SPC
  272. C IBLOLU : Code du blocage pour ce SPC
  273. C IHASHS : HashCode (numero unique) du code du blocage
  274. C ICOSPC : Correspondance entre le numéro du SPC et la position de son ID dans liste ILISPC
  275. C XSPC : Flottant lue pour ce SPC
  276. C IMELSP : Pointeur MELEME SIMPLE pour cet ID de SPC
  277. INTEGER IDSPC (JGSPC )
  278. INTEGER ILISPC(NBSDIF)
  279. INTEGER NBESPC(NBSDIF)
  280. INTEGER INOSPC(JGSPC )
  281. INTEGER IBLOLU(JGSPC )
  282. INTEGER IHASHS(JGSPC )
  283. INTEGER ICOSPC(JGSPC )
  284. REAL*8 XSPC (JGSPC )
  285. INTEGER IMELSP(NBSDIF)
  286. ENDSEGMENT
  287.  
  288. C Enregistrement des TEMPERATURES
  289. SEGMENT MTEMP
  290. C JGTEMP : Nombre de TEMPERATURE dans le MODELE
  291. C NBTDIF : Nombre d''ID de TEMPERATURE
  292. C IDTEMP : ID lue pour cette TEMPERATURE
  293. C ILITEM : Liste des ID de TEMPERATURE differentes
  294. C NBETEM : nombre d''elements PO1I dans cet ID de TEMPERATURE
  295. C INOTEM : ID lue du noeud pour cet ID de TEMPERATURE
  296. C ICOTEM : Correspondance entre le numéro de la carte TEMPERATURE et la position de son ID dans liste ILITEM
  297. C XTEMP : Flottant lue pour la TEMPERATURE
  298. INTEGER IDTEMP(JGTEMP )
  299. INTEGER ILITEM(NBTDIF)
  300. INTEGER NBETEM(NBTDIF)
  301. INTEGER INOTEM(JGTEMP )
  302. INTEGER ICOTEM(JGTEMP )
  303. REAL*8 XTEMP (JGTEMP )
  304. ENDSEGMENT
  305.  
  306. C Enregistrement des FORCES
  307. SEGMENT MFORCE
  308. C JGFORC : Nombre de FORCES dans le MODELE
  309. C NBFDIF : Nombre d''ID de FORCES
  310. C IDFORC : ID lue pour cette FORCES
  311. C ILIFOR : Liste des ID de FORCES differentes
  312. C NBEFOR : nombre d''elements PO1I dans cet ID de FORCES
  313. C INOFOR : ID lue du noeud pour cet ID de FORCES
  314. C ICOFOR : Correspondance entre le numéro de la carte FORCES et la position de son ID dans liste ILIFOR
  315. C XFORCE : Flottants lus pour la FORCES
  316. INTEGER IDFORC(JGFORC)
  317. INTEGER ILIFOR(NBFDIF)
  318. INTEGER NBEFOR(NBFDIF)
  319. INTEGER INOFOR(JGFORC)
  320. INTEGER ICOFOR(JGFORC)
  321. REAL*8 XFORCE(3,JGFORC)
  322. ENDSEGMENT
  323.  
  324.  
  325. C Enregistrement des MOMENTS
  326. SEGMENT MMOMEN
  327. C JGMOME : Nombre de MOMENTS dans le MODELE
  328. C NBMDIF : Nombre d''ID de MOMENTS
  329. C IDMOME : ID lue pour cette MOMENTS
  330. C ILIMOM : Liste des ID de MOMENTS differentes
  331. C NBEMOM : nombre d''elements PO1I dans cet ID de MOMENTS
  332. C INOMOM : ID lue du noeud pour cet ID de MOMENTS
  333. C ICOMOM : Correspondance entre le numéro de la carte MOMENTS et la position de son ID dans liste ILIFOR
  334. C XMOMEN : Flottants lus pour la MOMENTS
  335. INTEGER IDMOME(JGMOME)
  336. INTEGER ILIMOM(NBMDIF)
  337. INTEGER NBEMOM(NBMDIF)
  338. INTEGER INOMOM(JGMOME)
  339. INTEGER ICOMOM(JGMOME)
  340. REAL*8 XMOMEN(3,JGMOME)
  341. ENDSEGMENT
  342.  
  343. C***********************************************************************
  344. C Début du programme
  345. C***********************************************************************
  346. C Création de la table VIDE de sortie
  347. M=0
  348. SEGINI,MTABLE
  349.  
  350. C Initialisation des Segments
  351. NBNPTS = 0
  352. NELTOT = 0
  353. NBCONN = 0
  354. NBSYST = 0
  355. NBRBE2 = 0
  356. NBSPC = 0
  357. NBTEMP = 0
  358. NBFORC = 0
  359. NBMOME = 0
  360.  
  361. INCJGN = 50 C Incrément de NOEUD
  362. INCJGE = 50 C Incrément d' ELEMENT
  363. INCJCO = 50 C Incrément de CONNECTIVITE
  364. INCJSY = 50 C Incrément de SYSTEME
  365. INCJGR = 50 C Incrément de RBE2 de type different
  366. INCSPC = 50 C Incrément de SPC
  367. INCTEM = 50 C Incrément de TEMPERATURE
  368. INCFOR = 50 C Incrément de FORCES
  369. INCMOM = 50 C Incrément de MOMENTS
  370.  
  371. JGNOLO=INCJGN
  372. JGNOLU=INCJGN
  373. SEGINI,MLINOE
  374.  
  375. JGELLU=INCJGE
  376. JGELLO=INCJGE
  377. JELCON=INCJCO
  378. SEGINI,MLIELE
  379.  
  380. NBPROP = 0
  381. SEGINI,MPROP
  382.  
  383. JGSYST = 0
  384. SEGINI,MSYSTE
  385.  
  386. JGRBE2 = 0
  387. SEGINI,MRBE2
  388.  
  389. JGSPC = 0
  390. NBSDIF = 0
  391. SEGINI,MSPC
  392.  
  393. JGTEMP = 0
  394. NBTDIF = 0
  395. SEGINI,MTEMP
  396.  
  397. JGFORC = 0
  398. NBFDIF = 0
  399. SEGINI,MFORCE
  400.  
  401. JGMOME = 0
  402. NBMDIF = 0
  403. SEGINI,MMOMEN
  404.  
  405. NBLIGN = 0
  406. BEGIN = .FALSE.
  407. PRECID = .FALSE.
  408.  
  409. C Remplissage de IELEQ1, IELEQ2, NBNOE1, NBNOE2
  410. DO 9 INDICE = 1, NBGEO1
  411. COLO4=ELCAS1(INDICE)
  412. CALL PLACE(NOMS,100,IRETO3,COLO4)
  413. IELEQ1(INDICE)=IRETO3
  414. NBNOE1(INDICE)=NBNNE(IRETO3)
  415.  
  416. COLO4=ELCAS2(INDICE)
  417. CALL PLACE(NOMS,100,IRETO3,COLO4)
  418. IELEQ2(INDICE)=IRETO3
  419. NBNOE2(INDICE)=NBNNE(IRETO3)
  420. 9 CONTINUE
  421.  
  422. C Mise à zéro de NONLUE
  423. DO INDICE=1,NBGEO1+NBSY+NBCART
  424. NONLUE(INDICE)=0
  425. ENDDO
  426.  
  427.  
  428. C Lecture des arguments : Nom du fichier à lire (toto.nas)
  429. CALL LIRCHA(FicNAS,1,IRETO1)
  430. IF (IERR.NE.0) RETURN
  431.  
  432. C Par defaut, Erreur Cast3M numero 424
  433. C Erreur 424 : Problème %i1 en ouvrant le fichier : %m1:40
  434. iOK=424
  435. L=LEN(FicNAS)
  436. MOTERR(1:L)=FicNAS(1:L)
  437. INTERR(1)=0
  438.  
  439. C Ouverture du fichier .nas
  440. CLOSE(UNIT=IUNAS,ERR=991)
  441. OPEN (UNIT=IUNAS,STATUS='OLD',FILE=FicNAS(1:L),
  442. & IOSTAT=IOS,FORM='FORMATTED')
  443.  
  444. C Traitement des erreurs d'ouverture des fichiers
  445. IF (IOS.NE.0) THEN
  446. INTERR(1)=IOS
  447. C IF (DEBCB) THEN
  448. C WRITE(IOIMP,*) 'Fichier introuvable : ',FicNAS
  449. C ENDIF
  450. CALL ERREUR(424)
  451. RETURN
  452. ELSE
  453. C IF (DEBCB) THEN
  454. C WRITE(IOIMP,*) 'Ouverture OK du fichier NAS'
  455. C ENDIF
  456.  
  457. C Changement de dimension (si necessaire)
  458. iOK=0
  459. IDIMI=IDIM
  460. IDIMF=3
  461. IF (IDIMF.NE.IDIMI) THEN
  462. CALL ECRENT(IDIMF)
  463. CALL ECRCHA('DIME')
  464. CALL OPTION(1)
  465. IF (IERR.NE.0) THEN
  466. CALL ERREUR(IERR)
  467. RETURN
  468. ENDIF
  469. WRITE(IOIMP,*) ' '
  470. WRITE(IOIMP,*) ' Passage en DIMEnsion 3'
  471. WRITE(IOIMP,*) ' '
  472. ENDIF
  473. ENDIF
  474. idimp1=IDIM+1
  475. NBANC=XCOOR(/1)/(IDIM+1)
  476. NBPTS=NBANC+JGNOLO
  477. SEGADJ,MCOORD
  478.  
  479. 10 CONTINUE
  480. C Lecture de la ligne complete (80 caracteres)
  481. 1000 FORMAT(A80)
  482. READ(IUNAS,1000,ERR=990,END=100) LIGNE
  483. ITLIGN = 80
  484. CALL LENCHA(LIGNE,ITLIGN)
  485. INDXE=INDEX(CARAOK,LIGNE(ITLIGN:ITLIGN))
  486. IF (INDXE .EQ. 0) LIGNE(ITLIGN:ITLIGN)=' '
  487. NBLIGN = NBLIGN + 1
  488. C IF (DEBCB) THEN
  489. C WRITE(IOIMP,*),NBLIGN,LIGNE
  490. C ENDIF
  491.  
  492. C Detection de la ligne BEGIN BULK
  493. IF (LIGNE(1:10) .EQ. 'BEGIN BULK') THEN
  494. C WRITE(IOIMP,*),'BEGIN BULK, LIGNE',NBLIGN
  495. BEGIN=.TRUE.
  496. GOTO 100
  497. ENDIF
  498. GOTO 10
  499.  
  500. 100 CONTINUE
  501.  
  502. C Cas ou BEGIN BULK n'a pas ete lu...
  503. IF (BEGIN .EQV. .FALSE.) THEN
  504. CALL ERREUR(21)
  505. RETURN
  506. ENDIF
  507.  
  508. C***********************************************************************
  509. C Lecture des cartes NASTRAN dans le fichier
  510. C***********************************************************************
  511. C Boucle "infinie" sur la lecture des lignes
  512. 11 CONTINUE
  513. C Acquisition d''une nouvelle ligne
  514. READ(IUNAS,1000,ERR=990,END=990) LIGNE
  515. CALL LENCHA(LIGNE,ITLIGN)
  516. INDXE=INDEX(CARAOK,LIGNE(ITLIGN:ITLIGN))
  517. IF (INDXE .EQ. 0) LIGNE(ITLIGN:ITLIGN)=' '
  518. NBLIGN = NBLIGN + 1
  519.  
  520. C Premiere lettre de la ligne
  521. IF ((LIGNE(1:1) .EQ. ' ') .OR. (LIGNE(1:1) .EQ. '$')) GOTO 11
  522.  
  523. C Premier mot de la ligne
  524. IDEB = 1
  525. IFIN = MIN(IDEB + 8 - 1,ITLIGN)
  526. COLO8=LIGNE(IDEB:IFIN)
  527.  
  528. IRETO1 = 0
  529. C Recherche dans le DATA des PROPERTY
  530. CALL PLACE(PROTYP,NPROPE ,IRETO1,COLO8)
  531. IF (IRETO1 .NE. 0) THEN
  532. WRITE(IOIMP,*) 'PROPERTY non traitee : ',PROTYP(IRETO1)
  533. GOTO 11
  534. ENDIF
  535.  
  536. IRETO1 = 0
  537. IRETO2 = 0
  538. C Recherche dans le DATA des éléments géométriques
  539. CALL PLACE(GETYPE,NBGEO1+NBSY+NBCART,IRETO1 ,COLO8)
  540. IF (IRETO1 .EQ. 0) GOTO 11
  541.  
  542. 12 CONTINUE
  543.  
  544. C Lecture simple ou double precision
  545. IF ((MOD(IRETO1,2)) .EQ. 0) THEN
  546. PRECID = .TRUE.
  547. NCOLOL = 4
  548. LCOL = LEN(COLO16)
  549. C PRINT *,'Lecture en double precision ',GETYPE(IRETO1)
  550. ELSE
  551. PRECID = .FALSE.
  552. NCOLOL = 8
  553. LCOL = LEN(COLO8)
  554. C PRINT *,'Lecture en simple precision ',GETYPE(IRETO1)
  555. ENDIF
  556.  
  557. IDEB = 8 + 1
  558. IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
  559.  
  560. C Cas des POINTS
  561. IF ((IRETO1 .EQ. 1) .OR. (IRETO1 .EQ. 2)) THEN
  562. C PRINT *,':',GETYPE(IRETO1),':',LIGNE(IDEB:IFIN),':',IDEB
  563. READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) IDLU
  564. IF (IOSTA1 .NE. 0) THEN
  565. moterr ='READ (IOSTAT)'
  566. interr(1) = IOSTA1
  567. CALL ERREUR(873)
  568. RETURN
  569. ENDIF
  570.  
  571. C PRINT *,'ID Noeud :',IDLU
  572. NBNPTS = NBNPTS + 1
  573.  
  574. C Ajustement des SEGMENTS MLINOE et MCOORD
  575. IF( NBNPTS .GT. JGNOLO) THEN
  576. INCJGN = 2 * INCJGN
  577. JGNOLO = JGNOLO + INCJGN
  578. NBPTS = JGNOLO + NBANC
  579. SEGADJ,MLINOE,MCOORD
  580. C PRINT * ,'MLINOE Ajustement intermediaire'
  581. ENDIF
  582.  
  583. IF(IDLU.GT.JGNOLU) THEN
  584. INCJGN = 2 * INCJGN
  585. JGNOLU = IDLU + INCJGN
  586. SEGADJ,MLINOE
  587. ENDIF
  588. MLINOE.ICORNO(IDLU) =NBNPTS
  589.  
  590. C Lecture d''un ID de systeme local (COLONNE 2)
  591. IDEB = IFIN + 1
  592. IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
  593. READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSSY1) IDSYS
  594. IF (IOSSY1 .NE. 0) IDSYS = 0
  595. MLINOE.ISYSTE(IDLU) = IDSYS
  596.  
  597. C Lecture des Coordonnees
  598. DO IFLOT=1,3
  599. IF ((IFLOT .EQ.3) .AND. (PRECID)) THEN
  600. C Lecture de la ligne suivante
  601. READ(IUNAS,1000,ERR=990,END=990) LIGNE
  602. CALL LENCHA(LIGNE,ITLIGN)
  603. INDXE=INDEX(CARAOK,LIGNE(ITLIGN:ITLIGN))
  604. IF (INDXE .EQ. 0) LIGNE(ITLIGN:ITLIGN)=' '
  605. NBLIGN = NBLIGN + 1
  606. IDEB = 8 + 1
  607. IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
  608. ELSE
  609. IDEB = IFIN + 1
  610. IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
  611. ENDIF
  612.  
  613. C Correction à la volée d'une caractéristique du format .nas le 'E' n'est pas toujours mis pour les puissances négatives
  614. IF (PRECID) THEN
  615. COLO16= LIGNE(IDEB:IFIN)
  616. COLO17= COLO16//' '
  617. IF(COLO16(1:1).EQ.'-')THEN
  618. IADD = 1
  619. ELSE
  620. IADD = 0
  621. ENDIF
  622.  
  623. DO 16 ICHARA = 1+IADD, LCOL
  624. IF((COLO16(ICHARA:ICHARA).EQ.'-').AND.
  625. & (COLO16(ICHARA-1:ICHARA-1).NE.'e').AND.
  626. & (COLO16(ICHARA-1:ICHARA-1).NE.'E').AND.
  627. & (COLO16(ICHARA-1:ICHARA-1).NE.'d').AND.
  628. & (COLO16(ICHARA-1:ICHARA-1).NE.'D').AND.
  629. & (COLO16(ICHARA-1:ICHARA-1).NE.' '))THEN
  630. COLO17 =COLO16(1:ICHARA-1)//'E-'//
  631. & COLO16(ICHARA+1:LCOL)
  632. C PRINT*, 'Nouvelle COLO17 : ',COLO17
  633. ENDIF
  634. 16 CONTINUE
  635.  
  636. READ(COLO17,*,ERR=11,IOSTAT=IOSTA1) Flot1
  637. IF (IOSTA1 .NE. 0) THEN
  638. moterr ='READ (IOSTAT)'
  639. interr(1) = IOSTA1
  640. CALL ERREUR(873)
  641. RETURN
  642. ENDIF
  643.  
  644. ELSE
  645. COLO8 = LIGNE(IDEB:IFIN)
  646. COLO9 = COLO8//' '
  647. IF(COLO8(1:1).EQ.'-')THEN
  648. IADD = 1
  649. ELSE
  650. IADD = 0
  651. ENDIF
  652.  
  653. DO 15 ICHARA = 1+IADD, LCOL
  654. IF((COLO8(ICHARA:ICHARA).EQ.'-').AND.
  655. & (COLO8(ICHARA-1:ICHARA-1).NE.'e').AND.
  656. & (COLO8(ICHARA-1:ICHARA-1).NE.'E').AND.
  657. & (COLO8(ICHARA-1:ICHARA-1).NE.'d').AND.
  658. & (COLO8(ICHARA-1:ICHARA-1).NE.'D').AND.
  659. & (COLO8(ICHARA-1:ICHARA-1).NE.' '))THEN
  660. COLO9 =COLO8(1:ICHARA-1)//'E-'//COLO8(ICHARA+1:LCOL)
  661. C PRINT *, 'Nouvelle COLO9 : ',COLO9
  662. ENDIF
  663. 15 CONTINUE
  664.  
  665. READ(COLO9,*,ERR=11,IOSTAT=IOSTA1) Flot1
  666. IF (IOSTA1 .NE. 0) THEN
  667. moterr ='READ (IOSTAT)'
  668. interr(1) = IOSTA1
  669. CALL ERREUR(873)
  670. RETURN
  671. ENDIF
  672. ENDIF
  673.  
  674. j=(NBANC+NBNPTS-1)*idimp1
  675. MCOORD.XCOOR(j+IFLOT) =Flot1
  676. MLINOE.XCOLU(IFLOT,IDLU)=Flot1
  677. C PRINT *,IDLU,Flot1
  678. ENDDO
  679.  
  680. CC Lecture d''un ID de systeme local (COLONNE 2 de la LIGNE 2)
  681. C IDEB = IFIN + 1
  682. C IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
  683. C READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSSY2) IDSYS2
  684. C IF (IOSSY2 .EQ. 0) THEN
  685. C IF ((IOSSY1 .EQ. 0) .AND. (IDSYS .NE. IDSYS2)) THEN
  686. CC Lecture de 2 systemes differents pour ce noeud
  687. C WRITE(IOIMP,*) '2 systeme different pour le noeud',IDLU
  688. C CALL ERREUR(21)
  689. C RETURN
  690. C ENDIF
  691. C
  692. CC PRINT *, IDLU, 'Systeme ID :',IDSYS2,'COLONNE 2 LIGNE 2'
  693. C MLINOE.ISYSTE(IDLU) = IDSYS2
  694. C IDSYS = IDSYS2
  695. C ENDIF
  696.  
  697. C Conversion à la volée des coordonnées en fonction du type de repère
  698. IF (IDSYS .NE. 0) THEN
  699. DO NUMSYS=1,NBSYST
  700. IF(MSYSTE.IDSYST(NUMSYS) .EQ. IDSYS) GOTO 160
  701. ENDDO
  702. WRITE(IOIMP,*) 'On n''a pas lu le repere d''ID:',IDSYS
  703. CALL ERREUR(21)
  704. RETURN
  705.  
  706. 160 CONTINUE
  707. ITYPES = MSYSTE.ITYSYS(NUMSYS)
  708. C PRINT *,'Type de repere', ITYPES, NUMSYS
  709. XFL(1) = REAL(0.D0)
  710. XFL(2) = REAL(0.D0)
  711. XFL(3) = REAL(0.D0)
  712. j=(NBANC+NBNPTS-1)*idimp1
  713. IF (ITYPES .EQ. 1) THEN
  714. C Transformation Cartesienne
  715. C Le X lu devient mon Y
  716. XLU=MCOORD.XCOOR(j+1)
  717. MCOORD.XCOOR(j+1)=MCOORD.XCOOR(j+2)
  718. MCOORD.XCOOR(j+2)=XLU
  719.  
  720. ELSEIF (ITYPES .EQ. 2) THEN
  721. C Transformation Cylindrique
  722. C Passage en Cartesien Local X', Y', Z'
  723. RFLO = MCOORD.XCOOR(j+1)
  724. TETA = MCOORD.XCOOR(j+2) * (2.D0*XPI) / 360.D0
  725.  
  726. MCOORD.XCOOR(j+1) = RFLO * COS(TETA)
  727. MCOORD.XCOOR(j+2) = -RFLO * SIN(TETA)
  728.  
  729. C Le X calculé devient mon -Z
  730. XLU=MCOORD.XCOOR(j+1)
  731. MCOORD.XCOOR(j+1)=MCOORD.XCOOR(j+3)
  732. MCOORD.XCOOR(j+3)=-XLU
  733.  
  734. ELSEIF (ITYPES .EQ. 3) THEN
  735. C Transformation Spherique
  736. C Passage en Cartesien Local X', Y', Z'
  737. RFLO = MCOORD.XCOOR(j+1)
  738. PHI = MCOORD.XCOOR(j+2) * (2.D0*XPI) / 360.D0
  739. TETA = MCOORD.XCOOR(j+3) * (2.D0*XPI) / 360.D0
  740.  
  741. MCOORD.XCOOR(j+1) = RFLO * SIN(PHI) * COS(TETA)
  742. MCOORD.XCOOR(j+2) = RFLO * SIN(PHI) * SIN(TETA)
  743. MCOORD.XCOOR(j+3) = RFLO * COS(PHI)
  744.  
  745. C Le X calculé devient mon Y
  746. XLU=MCOORD.XCOOR(j+1)
  747. MCOORD.XCOOR(j+1)=MCOORD.XCOOR(j+2)
  748. MCOORD.XCOOR(j+2)=XLU
  749. ELSE
  750. WRITE(IOIMP,*) 'Systeme de type inconnu :',ITYPES
  751. CALL ERREUR(21)
  752. RETURN
  753. ENDIF
  754.  
  755. C Passage en coordonnées X,Y,Z centrées sur le repère Local
  756. DO III=1,3
  757. DO IFLOT=1,3
  758. Flot = MCOORD.XCOOR(j+IFLOT)
  759. INDICE=(III-1)*3 + IFLOT
  760. XFL(III)=XFL(III)+ MSYSTE.SCOOR2(INDICE,NUMSYS)*Flot
  761. C PRINT *,INDICE,SYSCOR(INDICE,NUMSYS),Flot,XFL(III)
  762. ENDDO
  763. ENDDO
  764.  
  765. C Remplacement dans MCOORD
  766. DO IFLOT=1,3
  767. C Translation dans le repere X,Y,Z général & Remplacement dans MCOORD
  768. XFL(IFLOT) = XFL(IFLOT) + MSYSTE.SYSCOR(IFLOT,NUMSYS)
  769. C PRINT *,IFLOT,NUMSYS, MSYSTE.SYSCOR(IFLOT,NUMSYS)
  770. MCOORD.XCOOR(j+IFLOT)=XFL(IFLOT)
  771. ENDDO
  772. ENDIF
  773.  
  774. GOTO 11
  775.  
  776. ELSEIF (IRETO1 .LE. NBGEO1) THEN
  777. IF ((IRETO1 .EQ. 3) .OR. (IRETO1 .EQ. 4)) THEN
  778. C Cas des ELEMENTS RBE2
  779. NELTOT = NELTOT + 1
  780. C Ajustement du segment MLIELE
  781. IF(NELTOT .GT. JGELLO) THEN
  782. INCJGE = 2 * INCJGE
  783. JGELLO = NELTOT + INCJGE
  784. SEGADJ,MLIELE
  785. ENDIF
  786.  
  787. C Lecture du numero d'element
  788. READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) IDLU
  789. IF (IOSTA1 .NE. 0) THEN
  790. moterr ='READ (IOSTAT)'
  791. interr(1) = IOSTA1
  792. CALL ERREUR(873)
  793. RETURN
  794. ENDIF
  795. C PRINT *,' '
  796. C PRINT *,'ELEMENT :',IDLU, GETYPE(IRETO1),NELTOT
  797.  
  798. IF (IDLU .GT. JGELLU) THEN
  799. INCJGE = 2 * INCJGE
  800. JGELLU = IDLU + INCJGE
  801. SEGADJ,MLIELE
  802. ENDIF
  803.  
  804. C Enregistrement de la correspondance
  805. MLIELE.ICOREL(NELTOT)= IDLU
  806. MLIELE.IELTYP(IDLU) = IELEQ1(IRETO1)
  807.  
  808. IDEB = IFIN + 1
  809. IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
  810.  
  811. C Lecture du Noeud Maitre
  812. C PRINT *,'LIGNE(IDEB:IFIN):',LIGNE(IDEB:IFIN),':'
  813. READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) INOEMA
  814. IF (IOSTA1 .NE. 0) THEN
  815. moterr ='READ (IOSTAT)'
  816. interr(1) = IOSTA1
  817. CALL ERREUR(873)
  818. RETURN
  819. ENDIF
  820. C Enregistrer ou débute la lecture de la connectivité
  821. MLIELE.IELCON(IDLU)=NBCONN+1
  822. NBCONN = NBCONN + 1
  823.  
  824. C Ajustement du segment MLIELE
  825. IF (NBCONN .GT. JELCON) THEN
  826. INCJCO = 2 * INCJCO
  827. JELCON = NBCONN + INCJCO
  828. SEGADJ,MLIELE
  829. ENDIF
  830. MLIELE.ICONTO(NBCONN)=INOEMA
  831. MLIELE.IELNBN(IDLU) =MLIELE.IELNBN(IDLU) + 1
  832.  
  833. IDEB = IFIN + 1
  834. IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
  835.  
  836. C Lecture du code de bloquage
  837. C PRINT *,'LIGNE(IDEB:IFIN):',LIGNE(IDEB:IFIN),':'
  838. READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) IBLOQ
  839. IF (IOSTA1 .NE. 0) THEN
  840. moterr ='READ (IOSTAT)'
  841. interr(1) = IOSTA1
  842. CALL ERREUR(873)
  843. RETURN
  844. ENDIF
  845. MLIELE.IRBE2(IDLU)=IBLOQ
  846.  
  847. NBRBE2=NBRBE2 + 1
  848.  
  849. IF (NBRBE2 .GT. JGRBE2) THEN
  850. INCJGR = 2 * INCJGR
  851. JGRBE2 = JGRBE2 + INCJGR
  852. SEGADJ,MRBE2
  853. ENDIF
  854. MRBE2.IBLRBE(NBRBE2) = IBLOQ
  855. MLIELE.IDPROP(IDLU) = NBRBE2
  856.  
  857. C Lecture de la connectivite
  858. C PRINT *, 'IBLOQ',IBLOQ,NBRBE2
  859. NUMCOL = 3
  860. 170 CONTINUE
  861. IRETO2 = 0
  862. NUMCOL = NUMCOL + 1
  863. IDEB = IFIN + 1
  864. IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
  865. C PRINT *,MLIELE.IELNBN(IDLU)+1,':',LIGNE(IDEB:IFIN),':'
  866. READ(LIGNE(IDEB:IFIN),*,ERR=170,IOSTAT=IOSTA1) INOELU
  867. IF (IOSTA1 .NE. 0) GOTO 11
  868.  
  869. NBCONN = NBCONN + 1
  870.  
  871. C Ajustement du segment MLIELE
  872. IF (NBCONN .GT. JELCON) THEN
  873. INCJCO = 2 * INCJCO
  874. JELCON = NBCONN + INCJCO
  875. SEGADJ,MLIELE
  876. ENDIF
  877.  
  878. C Enregistrer la connectivité de l'élément et le nombre de noeuds
  879. MLIELE.ICONTO(NBCONN)= INOELU
  880. MLIELE.IELNBN(IDLU) = MLIELE.IELNBN(IDLU) + 1
  881. MRBE2.NELRBE(NBRBE2) = MRBE2.NELRBE(NBRBE2) + 1
  882.  
  883. IF (NUMCOL .EQ. NCOLOL) THEN
  884.  
  885. C Lecture d'une nouvelle ligne pour savoir si on continue a lire
  886. READ(IUNAS,1000,ERR=990,END=990) LIGNE
  887. C PRINT * ,'Nouvelle ligne : NBLIGN,'
  888. CALL LENCHA(LIGNE,ITLIGN)
  889. INDXE=INDEX(CARAOK,LIGNE(ITLIGN:ITLIGN))
  890. IF (INDXE .EQ. 0) LIGNE(ITLIGN:ITLIGN)=' '
  891. NBLIGN = NBLIGN + 1
  892.  
  893. C Premiere lettre de la ligne
  894. IF ((LIGNE(1:1).EQ.' ') .OR. (LIGNE(1:1).EQ.'$')) GOTO 11
  895.  
  896. C Premier mot de la ligne
  897. COLO8=LIGNE(1:8)
  898.  
  899. IRETO2=0
  900. C Recherche dans le DATA des PROPERTY
  901. CALL PLACE(PROTYP,NPROPE ,IRETO2,COLO8)
  902. IF (IRETO2 .NE. 0) THEN
  903. WRITE(IOIMP,*) 'PROPERTY non traitee : ',PROTYP(IRETO1)
  904. GOTO 11
  905. ENDIF
  906.  
  907. IRETO2=0
  908. C Recherche dans le DATA des éléments géométriques
  909. CALL PLACE(GETYPE,NBGEO1,IRETO2,COLO8)
  910. IF (IRETO2.NE.0) GOTO 12
  911.  
  912. IFIN = 8
  913. NUMCOL = 0
  914. ENDIF
  915. GOTO 170
  916.  
  917. ELSEIF ((IRETO1 .EQ. 5) .OR. (IRETO1 .EQ. 6)) THEN
  918. C Cas des ELEMENTS RBE3
  919. IF (NONLUE(IRETO1) .EQ. 0) THEN
  920. WRITE(IOIMP,*) 'Elements non traites : ',GETYPE(IRETO1)
  921. NONLUE(IRETO1)=1
  922. ENDIF
  923.  
  924. ELSEIF ((IRETO1 .GE. 27) .AND. (IRETO1 .LE. 32)) THEN
  925. C Cas des ELEMENTS RBAR, CELAS2
  926. IF (NONLUE(IRETO1) .EQ. 0) THEN
  927. WRITE(IOIMP,*) 'Elements non traites : ',GETYPE(IRETO1)
  928. NONLUE(IRETO1)=1
  929. ENDIF
  930.  
  931. ELSE
  932. C Cas des ELEMENTS Classiques
  933. NELTOT = NELTOT + 1
  934. C Ajustement du segment MLIELE
  935. IF(NELTOT .GT. JGELLO) THEN
  936. INCJGE = 2 * INCJGE
  937. JGELLO = NELTOT + INCJGE
  938. SEGADJ,MLIELE
  939. ENDIF
  940.  
  941. C Lecture du numero d'element
  942. C PRINT *,'LIGNE(IDEB:IFIN):',LIGNE(IDEB:IFIN),':'
  943. READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) IDLU
  944. IF (IOSTA1 .NE. 0) THEN
  945. moterr ='READ (IOSTAT)'
  946. interr(1) = IOSTA1
  947. CALL ERREUR(873)
  948. RETURN
  949. ENDIF
  950.  
  951. C PRINT *,' '
  952. C PRINT *,'ELEMENT :',IDLU, GETYPE(IRETO1),NELTOT
  953.  
  954. IF (IDLU .GT. JGELLU) THEN
  955. INCJGE = 2 * INCJGE
  956. JGELLU = IDLU + INCJGE
  957. SEGADJ,MLIELE
  958. ENDIF
  959.  
  960. C Enregistrement de la correspondance
  961. MLIELE.ICOREL(NELTOT)= IDLU
  962.  
  963. IDEB = IFIN + 1
  964. IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
  965.  
  966. C Lecture de la Property à laquelle appartient l'élément
  967. C PRINT *,'LIGNE(IDEB:IFIN):',LIGNE(IDEB:IFIN),':'
  968. READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) IPLU
  969. IF (IOSTA1 .NE. 0) THEN
  970. moterr ='READ (IOSTAT)'
  971. interr(1) = IOSTA1
  972. CALL ERREUR(873)
  973. RETURN
  974. ENDIF
  975. MLIELE.IDPROP(IDLU)=IPLU
  976.  
  977. C Ajustement du SEGMENT MPROP
  978. DO IP=1,NBPROP
  979. IF (MPROP.ICOPRO(IP) .EQ. IPLU) GOTO 190
  980. ENDDO
  981. NBPROP = NBPROP + 1
  982. IP = NBPROP
  983. SEGADJ, MPROP
  984. C PRINT *,'NBR PROP =',NBPROP,IPLU
  985. SEGADJ,MLIELE
  986. MPROP.ICOPRO(NBPROP) = IPLU
  987. 190 CONTINUE
  988.  
  989. C Lecture de la connectivite
  990. NUMCOL = 2
  991. C Enregistrer ou débute la lecture de la connectivité
  992. MLIELE.IELCON(IDLU)=NBCONN+1
  993. 200 CONTINUE
  994. IRETO2 = 0
  995. NUMCOL = NUMCOL + 1
  996. IDEB = IFIN + 1
  997. IFIN = IDEB + LCOL - 1
  998. C PRINT *,MLIELE.IELNBN(IDLU)+1,':',LIGNE(IDEB:IFIN),':'
  999. READ(LIGNE(IDEB:IFIN),*,ERR=200,IOSTAT=IOSTA1) INOELU
  1000. IF (IOSTA1 .NE. 0) GOTO 13
  1001.  
  1002. NBCONN = NBCONN + 1
  1003.  
  1004. C Ajustement du segment MLIELE
  1005. IF (NBCONN .GT. JELCON) THEN
  1006. INCJCO = 2 * INCJCO
  1007. JELCON = NBCONN + INCJCO
  1008. SEGADJ,MLIELE
  1009. ENDIF
  1010.  
  1011. C Enregistrer la connectivité de l'élément et le nombre de noeuds
  1012. MLIELE.ICONTO(NBCONN)=INOELU
  1013. MLIELE.IELNBN(IDLU) =MLIELE.IELNBN(IDLU) + 1
  1014.  
  1015. IF (NUMCOL .EQ. NCOLOL) THEN
  1016.  
  1017. C Lecture d'une nouvelle ligne pour savoir si on continue a lire
  1018. READ(IUNAS,1000,ERR=990,END=990) LIGNE
  1019. C PRINT * ,'Nouvelle ligne : NBLIGN,'
  1020. CALL LENCHA(LIGNE,ITLIGN)
  1021. INDXE=INDEX(CARAOK,LIGNE(ITLIGN:ITLIGN))
  1022. IF (INDXE .EQ. 0) LIGNE(ITLIGN:ITLIGN)=' '
  1023. NBLIGN = NBLIGN + 1
  1024.  
  1025. C Premiere lettre de la ligne
  1026. IF ((LIGNE(1:1).EQ.' ') .OR. (LIGNE(1:1).EQ.'$')) GOTO 13
  1027.  
  1028. C Premier mot de la ligne
  1029. COLO8=LIGNE(1:8)
  1030.  
  1031. IRETO2 =0
  1032. IRETO21=0
  1033. C Recherche dans le DATA des PROPERTY
  1034. CALL PLACE(PROTYP,NPROPE ,IRETO21,COLO8)
  1035. IF (IRETO21 .NE. 0) THEN
  1036. WRITE(IOIMP,*) 'PROPERTY non traitee : ',PROTYP(IRETO21)
  1037. GOTO 13
  1038. ENDIF
  1039.  
  1040. C Recherche dans le DATA des éléments géométriques
  1041. CALL PLACE(GETYPE,NBGEO1,IRETO2,COLO8)
  1042. IF (IRETO2.NE.0) GOTO 13
  1043.  
  1044. IFIN = 8
  1045. NUMCOL = 0
  1046. ENDIF
  1047. GOTO 200
  1048.  
  1049. 13 CONTINUE
  1050.  
  1051. IF (MLIELE.IELNBN(IDLU) .EQ. NBNOE1(IRETO1)) THEN
  1052. MPROP.ITYPRO(IELEQ1(IRETO1),IP)=
  1053. & MPROP.ITYPRO(IELEQ1(IRETO1),IP) + 1
  1054. MLIELE.IELTYP(IDLU) = IELEQ1(IRETO1)
  1055. C PRINT *,'Nombre de Noeuds :',MLIELE.IELNBN(IDLU),
  1056. C & IELEQ1(IRETO1),IP,MPROP.ITYPRO(IELEQ1(IRETO1),IP)
  1057. ELSEIF(MLIELE.IELNBN(IDLU) .EQ. NBNOE2(IRETO1)) THEN
  1058. MPROP.ITYPRO(IELEQ2(IRETO1),IP)=
  1059. & MPROP.ITYPRO(IELEQ2(IRETO1),IP) + 1
  1060. MLIELE.IELTYP(IDLU) = IELEQ2(IRETO1)
  1061. C PRINT *,'Nombre de Noeuds :',MLIELE.IELNBN(IDLU),
  1062. C & IELEQ2(IRETO1),IP,MPROP.ITYPRO(IELEQ1(IRETO1),IP)
  1063. ELSE
  1064. CALL ERREUR(21)
  1065. RETURN
  1066. ENDIF
  1067.  
  1068. IF (IRETO2 .NE. 0) THEN
  1069. GOTO 12
  1070. ELSE
  1071. GOTO 11
  1072. ENDIF
  1073. ENDIF
  1074.  
  1075. ELSEIF ((IRETO1 .GE. 33) .AND. (IRETO1 .LE. 38)) THEN
  1076. C Cas des systemes de coordonnees locales
  1077. IF ((IRETO1 .EQ. 33) .OR. (IRETO1 .EQ. 34)) THEN
  1078. C Repere Cartesien
  1079. ITYPES=1
  1080. ELSEIF((IRETO1 .EQ. 35) .OR. (IRETO1 .EQ. 36)) THEN
  1081. C Repere Cylindrique
  1082. ITYPES=2
  1083. ELSEIF((IRETO1 .EQ. 37) .OR. (IRETO1 .EQ. 38)) THEN
  1084. C Repere Spherique
  1085. ITYPES=3
  1086. ENDIF
  1087.  
  1088. C PRINT *,':',GETYPE(IRETO1),':',LIGNE(IDEB:IFIN),':',IDEB
  1089. READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) IDLU
  1090. IF (IOSTA1 .NE. 0) THEN
  1091. moterr ='READ (IOSTAT)'
  1092. interr(1) = IOSTA1
  1093. CALL ERREUR(873)
  1094. RETURN
  1095. ENDIF
  1096.  
  1097. NBSYST = NBSYST + 1
  1098.  
  1099. C Ajustement des SEGMENTS MLINOE et MCOORD
  1100. IF( NBSYST .GT. JGSYST) THEN
  1101. INCJSY = 2 * INCJSY
  1102. JGSYST = JGSYST + INCJSY
  1103. SEGADJ,MSYSTE
  1104. C PRINT * ,'MSYSTE Ajustement intermediaire'
  1105. ENDIF
  1106.  
  1107. MSYSTE.IDSYST(NBSYST)=IDLU
  1108. MSYSTE.ITYSYS(NBSYST)=ITYPES
  1109.  
  1110. C PRINT *,IDLU,ITYPES,NBSYST
  1111. C Lecture des 9 coordonnees du systeme
  1112. NUMCOL = 1
  1113. IDEB = IFIN + 1
  1114. IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
  1115. DO IFLOT=1,9
  1116. NUMCOL = NUMCOL + 1
  1117. IF (NUMCOL .EQ. NCOLOL) THEN
  1118. C Lecture de la ligne suivante
  1119. READ(IUNAS,1000,ERR=990,END=990) LIGNE
  1120. CALL LENCHA(LIGNE,ITLIGN)
  1121. INDXE=INDEX(CARAOK,LIGNE(ITLIGN:ITLIGN))
  1122. IF (INDXE .EQ. 0) LIGNE(ITLIGN:ITLIGN)=' '
  1123. NBLIGN = NBLIGN + 1
  1124. IDEB = 8 + 1
  1125. IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
  1126. NUMCOL = 0
  1127. ELSE
  1128. IDEB = IFIN + 1
  1129. IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
  1130. ENDIF
  1131.  
  1132. C PRINT *,':',LIGNE(IDEB:IFIN),':'
  1133. READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) Flot1
  1134. IF (IOSTA1 .NE. 0) THEN
  1135. moterr ='READ (IOSTAT)'
  1136. interr(1) = IOSTA1
  1137. CALL ERREUR(873)
  1138. RETURN
  1139. ENDIF
  1140. MSYSTE.SYSCOR(IFLOT,NBSYST) = Flot1
  1141.  
  1142. C Ajout du troisieme point par produit vectoriel
  1143. IF (IFLOT .EQ. 9) THEN
  1144. F11 = MSYSTE.SYSCOR(1,NBSYST)
  1145. F12 = MSYSTE.SYSCOR(2,NBSYST)
  1146. F13 = MSYSTE.SYSCOR(3,NBSYST)
  1147.  
  1148. F21 = MSYSTE.SYSCOR(4,NBSYST)
  1149. F22 = MSYSTE.SYSCOR(5,NBSYST)
  1150. F23 = MSYSTE.SYSCOR(6,NBSYST)
  1151.  
  1152. F31 = MSYSTE.SYSCOR(7,NBSYST)
  1153. F32 = MSYSTE.SYSCOR(8,NBSYST)
  1154. F33 = MSYSTE.SYSCOR(9,NBSYST)
  1155.  
  1156. u1 = F21 - F11
  1157. u2 = F22 - F12
  1158. u3 = F23 - F13
  1159.  
  1160. v1 = F31 - F11
  1161. v2 = F32 - F12
  1162. v3 = F33 - F13
  1163.  
  1164. w1= u2*v3 - u3*v2
  1165. w2= u3*v1 - u1*v3
  1166. w3= u1*v2 - u2*v1
  1167.  
  1168. C Je norme les vecteurs
  1169. XL1 = SQRT(u1**2 + u2**2 + u3**2)
  1170. XL2 = SQRT(v1**2 + v2**2 + v3**2)
  1171. XL3 = SQRT(w1**2 + w2**2 + w3**2)
  1172.  
  1173. MSYSTE.SCOOR2(7,NBSYST) = u1/XL1
  1174. MSYSTE.SCOOR2(8,NBSYST) = u2/XL1
  1175. MSYSTE.SCOOR2(9,NBSYST) = u3/XL1
  1176.  
  1177. MSYSTE.SCOOR2(4,NBSYST) = v1/XL2
  1178. MSYSTE.SCOOR2(5,NBSYST) = v2/XL2
  1179. MSYSTE.SCOOR2(6,NBSYST) = v3/XL2
  1180.  
  1181. MSYSTE.SCOOR2(1,NBSYST) = w1/XL3
  1182. MSYSTE.SCOOR2(2,NBSYST) = w2/XL3
  1183. MSYSTE.SCOOR2(3,NBSYST) = w3/XL3
  1184.  
  1185. C F21 = (u1/XL1) + F11
  1186. C F22 = (u2/XL1) + F12
  1187. C F23 = (u3/XL1) + F13
  1188. C
  1189. C F31 = (v1/XL2) + F11
  1190. C F32 = (v2/XL2) + F12
  1191. C F33 = (v3/XL2) + F13
  1192. C
  1193. F41 = (w1/(MAX(XL1,XL2))) + F11
  1194. F42 = (w2/(MAX(XL1,XL2))) + F12
  1195. F43 = (w3/(MAX(XL1,XL2))) + F13
  1196. C
  1197. C MSYSTE.SYSCOR(4 ,NBSYST) = F21
  1198. C MSYSTE.SYSCOR(5 ,NBSYST) = F22
  1199. C MSYSTE.SYSCOR(6 ,NBSYST) = F23
  1200. C
  1201. C MSYSTE.SYSCOR(7 ,NBSYST) = F31
  1202. C MSYSTE.SYSCOR(8 ,NBSYST) = F32
  1203. C MSYSTE.SYSCOR(9 ,NBSYST) = F33
  1204. C
  1205. MSYSTE.SYSCOR(10,NBSYST) = F41
  1206. MSYSTE.SYSCOR(11,NBSYST) = F42
  1207. MSYSTE.SYSCOR(12,NBSYST) = F43
  1208.  
  1209. C PRINT *,u1 ,u2 ,u3
  1210. C PRINT *,v1 ,v2 ,v3
  1211. C PRINT *,w1 ,w2 ,w3
  1212. C
  1213. C PRINT *,'XL1,XL2,XL3',XL1,XL2,XL3
  1214. C PRINT *,F11 ,F12 ,F13
  1215. C PRINT *,F21 ,F22 ,F23
  1216. C PRINT *,F31 ,F32 ,F33
  1217. C PRINT *,F41, F42, F43
  1218. ENDIF
  1219. ENDDO
  1220. ELSEIF ((IRETO1 .GE. 39) .AND. (IRETO1 .LE. 42)) THEN
  1221. C Cas des SPC et SPCD
  1222. READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) IDLU
  1223. IF (IOSTA1 .NE. 0) THEN
  1224. moterr ='READ (IOSTAT)'
  1225. interr(1) = IOSTA1
  1226. CALL ERREUR(873)
  1227. RETURN
  1228. ENDIF
  1229. C PRINT *, GETYPE(IRETO1),IDLU,(IRETO1 - (NBGEO1+NBSY) + 1)/2
  1230. NBSPC = NBSPC + 1
  1231.  
  1232. IF (NBSPC .GT. JGSPC) THEN
  1233. INCSPC = 2 * INCSPC
  1234. JGSPC = JGSPC + INCSPC
  1235. SEGADJ, MSPC
  1236. ENDIF
  1237.  
  1238. DO IDVU=1,NBSDIF
  1239. IF (IDLU .EQ. MSPC.ILISPC(IDVU)) GOTO 301
  1240. ENDDO
  1241.  
  1242. NBSDIF = NBSDIF + 1
  1243. IDVU = NBSDIF
  1244. SEGADJ,MSPC
  1245. MSPC.ILISPC(NBSDIF)=IDLU
  1246.  
  1247. 301 CONTINUE
  1248. MSPC.NBESPC(IDVU) =MSPC.NBESPC(IDVU) + 1
  1249. MSPC.ICOSPC(NBSPC)=IDVU
  1250. IDEB = IFIN + 1
  1251. IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
  1252. READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) INOLU
  1253. IF (IOSTA1 .NE. 0) THEN
  1254. moterr ='READ (IOSTAT)'
  1255. interr(1) = IOSTA1
  1256. CALL ERREUR(873)
  1257. RETURN
  1258. ENDIF
  1259.  
  1260. C Determination du HashCode des SPC
  1261. IDEB = IFIN + 1
  1262. IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
  1263. READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) IBLOQ
  1264. IF (IOSTA1 .NE. 0) THEN
  1265. moterr ='READ (IOSTAT)'
  1266. interr(1) = IOSTA1
  1267. CALL ERREUR(873)
  1268. RETURN
  1269. ENDIF
  1270. IPOS1 = MIN(MAX(INDEX(LIGNE(IDEB:IFIN),'1') - 10,0),1)
  1271. IPOS2 = MIN(MAX(INDEX(LIGNE(IDEB:IFIN),'2') - 10,0),1)
  1272. IPOS3 = MIN(MAX(INDEX(LIGNE(IDEB:IFIN),'3') - 10,0),1)
  1273. IPOS4 = MIN(MAX(INDEX(LIGNE(IDEB:IFIN),'4') - 10,0),1)
  1274. IPOS5 = MIN(MAX(INDEX(LIGNE(IDEB:IFIN),'5') - 10,0),1)
  1275. IPOS6 = MIN(MAX(INDEX(LIGNE(IDEB:IFIN),'6') - 10,0),1)
  1276.  
  1277. IHCODE=IPOS1*(2**5) + IPOS2*(2**4) + IPOS3*(2**3) +
  1278. & IPOS4*(2**2) + IPOS5*(2) + IPOS6
  1279.  
  1280. IDEB = IFIN + 1
  1281. IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
  1282. READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) FLOT1
  1283. IF (IOSTA1 .NE. 0) THEN
  1284. moterr ='READ (IOSTAT)'
  1285. interr(1) = IOSTA1
  1286. CALL ERREUR(873)
  1287. RETURN
  1288. ENDIF
  1289.  
  1290. MSPC.IDSPC (NBSPC)=IDLU
  1291. MSPC.INOSPC(NBSPC)=INOLU
  1292. MSPC.IBLOLU(NBSPC)=IBLOQ
  1293. MSPC.IHASHS(NBSPC)=IHCODE
  1294. MSPC.XSPC (NBSPC)=FLOT1
  1295. C PRINT *,IDLU,INOLU,IBLOQ,FLOT1,NBSDIF
  1296.  
  1297. ELSEIF ((IRETO1 .EQ. 43) .OR. (IRETO1 .EQ. 44)) THEN
  1298. C Cas des LOAD
  1299. IF (NONLUE(IRETO1) .EQ. 0) THEN
  1300. WRITE(IOIMP,*) 'Carte Non lue : ',GETYPE(IRETO1)
  1301. NONLUE(IRETO1)=1
  1302. ENDIF
  1303.  
  1304. ELSEIF ((IRETO1 .EQ. 45) .OR. (IRETO1 .EQ. 46)) THEN
  1305. C Cas des PLOAD
  1306. IF (NONLUE(IRETO1) .EQ. 0) THEN
  1307. WRITE(IOIMP,*) 'Carte Non lue : ',GETYPE(IRETO1)
  1308. NONLUE(IRETO1)=1
  1309. ENDIF
  1310.  
  1311. ELSEIF ((IRETO1 .EQ. 47) .OR. (IRETO1 .EQ. 48)) THEN
  1312. C Cas des PLOAD1
  1313. IF (NONLUE(IRETO1) .EQ. 0) THEN
  1314. WRITE(IOIMP,*) 'Carte Non lue : ',GETYPE(IRETO1)
  1315. NONLUE(IRETO1)=1
  1316. ENDIF
  1317.  
  1318. ELSEIF ((IRETO1 .EQ. 49) .OR. (IRETO1 .EQ. 50)) THEN
  1319. C Cas des PLOAD2
  1320. IF (NONLUE(IRETO1) .EQ. 0) THEN
  1321. WRITE(IOIMP,*) 'Carte Non lue : ',GETYPE(IRETO1)
  1322. NONLUE(IRETO1)=1
  1323. ENDIF
  1324.  
  1325. ELSEIF ((IRETO1 .EQ. 51) .OR. (IRETO1 .EQ. 52)) THEN
  1326. C Cas des PLOAD4
  1327. IF (NONLUE(IRETO1) .EQ. 0) THEN
  1328. WRITE(IOIMP,*) 'Carte Non lue : ',GETYPE(IRETO1)
  1329. NONLUE(IRETO1)=1
  1330. ENDIF
  1331.  
  1332. ELSEIF ((IRETO1 .EQ. 53) .OR. (IRETO1 .EQ. 54)) THEN
  1333. C Cas des FORCE
  1334. READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) IDLU
  1335. IF (IOSTA1 .NE. 0) THEN
  1336. moterr ='READ (IOSTAT)'
  1337. interr(1) = IOSTA1
  1338. CALL ERREUR(873)
  1339. RETURN
  1340. ENDIF
  1341. C PRINT *, GETYPE(IRETO1),IDLU,(IRETO1 - (NBGEO1+NBSY) + 1)/2
  1342. NBFORC = NBFORC + 1
  1343.  
  1344. IF (NBFORC .GT. JGFORC) THEN
  1345. INCFOR = 2 * INCFOR
  1346. JGFORC = JGFORC + INCFOR
  1347. SEGADJ, MFORCE
  1348. ENDIF
  1349.  
  1350. DO IDVU=1,NBFDIF
  1351. IF (IDLU .EQ. MFORCE.ILIFOR(IDVU)) GOTO 303
  1352. ENDDO
  1353.  
  1354. NBFDIF = NBFDIF + 1
  1355. IDVU = NBFDIF
  1356. SEGADJ,MFORCE
  1357. MFORCE.ILIFOR(NBFDIF)=IDLU
  1358.  
  1359. 303 CONTINUE
  1360. MFORCE.NBEFOR(IDVU )=MFORCE.NBEFOR(IDVU) + 1
  1361. MFORCE.ICOFOR(NBFORC)=IDVU
  1362. IDEB = IFIN + 1
  1363. IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
  1364. READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) INOLU
  1365. IF (IOSTA1 .NE. 0) THEN
  1366. moterr ='READ (IOSTAT)'
  1367. interr(1) = IOSTA1
  1368. CALL ERREUR(873)
  1369. RETURN
  1370. ENDIF
  1371.  
  1372. IDEB = IFIN + 1
  1373. IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
  1374. READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) IDSYS
  1375. IF (IOSTA1 .NE. 0) IDSYS = 0
  1376.  
  1377. IDEB = IFIN + 1
  1378. IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
  1379. READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) FLOT1
  1380. IF (IOSTA1 .NE. 0) THEN
  1381. moterr ='READ (IOSTAT)'
  1382. interr(1) = IOSTA1
  1383. CALL ERREUR(873)
  1384. RETURN
  1385. ENDIF
  1386.  
  1387. IF (PRECID) THEN
  1388. C Lecture d'une nouvelle ligne pour savoir si on continue a lire
  1389. READ(IUNAS,1000,ERR=990,END=990) LIGNE
  1390. C PRINT * ,'Nouvelle ligne : NBLIGN,'
  1391. CALL LENCHA(LIGNE,ITLIGN)
  1392. INDXE=INDEX(CARAOK,LIGNE(ITLIGN:ITLIGN))
  1393. IF (INDXE .EQ. 0) LIGNE(ITLIGN:ITLIGN)=' '
  1394. NBLIGN = NBLIGN + 1
  1395. IFIN = 8
  1396. ENDIF
  1397.  
  1398. MFORCE.IDFORC(NBFORC)=IDLU
  1399. MFORCE.INOFOR(NBFORC)=INOLU
  1400. DO IFO=1,3
  1401. IDEB = IFIN + 1
  1402. IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
  1403. READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) FLOT2
  1404. IF (IOSTA1 .NE. 0) THEN
  1405. moterr ='READ (IOSTAT)'
  1406. interr(1) = IOSTA1
  1407. CALL ERREUR(873)
  1408. RETURN
  1409. ENDIF
  1410. MFORCE.XFORCE(IFO,NBFORC)=FLOT2*FLOT1
  1411. ENDDO
  1412. C PRINT *,IDLU,INOLU,IDSYS,NBFDIF
  1413.  
  1414. C Passage dans le repère général
  1415. IF (IDSYS.NE.0) THEN
  1416. DO NUMSYS=1,NBSYST
  1417. IF(MSYSTE.IDSYST(NUMSYS) .EQ. IDSYS) GOTO 304
  1418. ENDDO
  1419. WRITE(IOIMP,*) 'On n''a pas lu le repere d''ID:',IDSYS
  1420. CALL ERREUR(21)
  1421. RETURN
  1422.  
  1423. 304 CONTINUE
  1424. ITYPES = MSYSTE.ITYSYS(NUMSYS)
  1425. C PRINT *,'Type de repere', ITYPES, NUMSYS
  1426. XFL(1) = REAL(0.D0)
  1427. XFL(2) = REAL(0.D0)
  1428. XFL(3) = REAL(0.D0)
  1429. NUMPTS = MLINOE.ICORNO(INOLU)
  1430. j=(NBANC+NUMPTS-1)*idimp1
  1431. IF (ITYPES .EQ. 1) THEN
  1432. C Transformation Cartesienne
  1433. C Le X lu devient mon Y
  1434. XLU=MFORCE.XFORCE(1,NBFORC)
  1435. MFORCE.XFORCE(1,NBFORC)=MFORCE.XFORCE(2,NBFORC)
  1436. MFORCE.XFORCE(2,NBFORC)=XLU
  1437.  
  1438. ELSEIF (ITYPES .EQ. 2) THEN
  1439. C Transformation Cylindrique
  1440. WRITE(IOIMP,*) 'Repere Cylindrique non supporte: IDFORCE,',
  1441. & ' Noeud, Ligne',IDLU,INOLU,NBLIGN
  1442. GOTO 11
  1443.  
  1444. ELSEIF (ITYPES .EQ. 3) THEN
  1445. C Transformation Spherique
  1446. WRITE(IOIMP,*) 'Repere Spherique non supporte: IDFORCE,',
  1447. & ' Noeud, Ligne',IDLU,INOLU,NBLIGN
  1448. GOTO 11
  1449.  
  1450. ELSE
  1451. WRITE(IOIMP,*) 'Systeme de type inconnu :',ITYPES
  1452. CALL ERREUR(21)
  1453. RETURN
  1454. ENDIF
  1455.  
  1456. C Passage en coordonnées X,Y,Z centrées sur le repère Local
  1457. DO III=1,3
  1458. DO IFLOT=1,3
  1459. Flot = MFORCE.XFORCE(IFLOT,NBFORC)
  1460. INDICE=(III-1)*3 + IFLOT
  1461. XFL(III)=XFL(III)+ MSYSTE.SCOOR2(INDICE,NUMSYS)*Flot
  1462. C PRINT *,INDICE,SYSCOR(INDICE,NUMSYS),Flot,XFL(III)
  1463. ENDDO
  1464. ENDDO
  1465.  
  1466. C Remplacement dans MFORCE
  1467. DO IFLOT=1,3
  1468. C Remplacement dans MFORCE
  1469. MFORCE.XFORCE(IFLOT,NBFORC)=XFL(IFLOT)
  1470. ENDDO
  1471. ENDIF
  1472.  
  1473. ELSEIF ((IRETO1 .EQ. 55) .OR. (IRETO1 .EQ. 56)) THEN
  1474. C Cas des MOMENT
  1475. READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) IDLU
  1476. IF (IOSTA1 .NE. 0) THEN
  1477. moterr ='READ (IOSTAT)'
  1478. interr(1) = IOSTA1
  1479. CALL ERREUR(873)
  1480. RETURN
  1481. ENDIF
  1482. C PRINT *, GETYPE(IRETO1),IDLU,(IRETO1 - (NBGEO1+NBSY) + 1)/2
  1483. NBMOME = NBMOME + 1
  1484.  
  1485. IF (NBMOME .GT. JGMOME) THEN
  1486. INCMOM = 2 * INCMOM
  1487. JGMOME = JGMOME + INCMOM
  1488. SEGADJ, MMOMEN
  1489. ENDIF
  1490.  
  1491. DO IDVU=1,NBMDIF
  1492. IF (IDLU .EQ. MMOMEN.ILIMOM(IDVU)) GOTO 305
  1493. ENDDO
  1494.  
  1495. NBMDIF = NBMDIF + 1
  1496. IDVU = NBMDIF
  1497. SEGADJ,MMOMEN
  1498. MMOMEN.ILIMOM(NBMDIF)=IDLU
  1499.  
  1500. 305 CONTINUE
  1501. MMOMEN.NBEMOM(IDVU )=MMOMEN.NBEMOM(IDVU) + 1
  1502. MMOMEN.ICOMOM(NBMOME)=IDVU
  1503. IDEB = IFIN + 1
  1504. IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
  1505. READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) INOLU
  1506. IF (IOSTA1 .NE. 0) THEN
  1507. moterr ='READ (IOSTAT)'
  1508. interr(1) = IOSTA1
  1509. CALL ERREUR(873)
  1510. RETURN
  1511. ENDIF
  1512.  
  1513. IDEB = IFIN + 1
  1514. IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
  1515. READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) IDSYS
  1516. IF (IOSTA1 .NE. 0) IDSYS = 0
  1517.  
  1518. IDEB = IFIN + 1
  1519. IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
  1520. READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) FLOT1
  1521. IF (IOSTA1 .NE. 0) THEN
  1522. moterr ='READ (IOSTAT)'
  1523. interr(1) = IOSTA1
  1524. CALL ERREUR(873)
  1525. RETURN
  1526. ENDIF
  1527.  
  1528. IF (PRECID) THEN
  1529. C Lecture d'une nouvelle ligne pour savoir si on continue a lire
  1530. READ(IUNAS,1000,ERR=990,END=990) LIGNE
  1531. C PRINT * ,'Nouvelle ligne : NBLIGN,'
  1532. CALL LENCHA(LIGNE,ITLIGN)
  1533. INDXE=INDEX(CARAOK,LIGNE(ITLIGN:ITLIGN))
  1534. IF (INDXE .EQ. 0) LIGNE(ITLIGN:ITLIGN)=' '
  1535. NBLIGN = NBLIGN + 1
  1536. IFIN = 8
  1537. ENDIF
  1538.  
  1539. MMOMEN.IDMOME(NBMOME)=IDLU
  1540. MMOMEN.INOMOM(NBMOME)=INOLU
  1541. DO IFO=1,3
  1542. IDEB = IFIN + 1
  1543. IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
  1544. READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) FLOT2
  1545. IF (IOSTA1 .NE. 0) THEN
  1546. moterr ='READ (IOSTAT)'
  1547. interr(1) = IOSTA1
  1548. CALL ERREUR(873)
  1549. RETURN
  1550. ENDIF
  1551. MMOMEN.XMOMEN(IFO,NBMOME)=FLOT2*FLOT1
  1552. ENDDO
  1553. C PRINT *,IDLU,INOLU,IDSYS,NBMDIF
  1554.  
  1555. C Passage dans le repère général
  1556. IF (IDSYS.NE.0) THEN
  1557. DO NUMSYS=1,NBSYST
  1558. IF(MSYSTE.IDSYST(NUMSYS) .EQ. IDSYS) GOTO 306
  1559. ENDDO
  1560. WRITE(IOIMP,*) 'On n''a pas lu le repere d''ID:',IDSYS
  1561. CALL ERREUR(21)
  1562. RETURN
  1563.  
  1564. 306 CONTINUE
  1565. ITYPES = MSYSTE.ITYSYS(NUMSYS)
  1566. C PRINT *,'Type de repere', ITYPES, NUMSYS
  1567. XFL(1) = REAL(0.D0)
  1568. XFL(2) = REAL(0.D0)
  1569. XFL(3) = REAL(0.D0)
  1570. NUMPTS = MLINOE.ICORNO(INOLU)
  1571. j=(NBANC+NUMPTS-1)*idimp1
  1572. IF (ITYPES .EQ. 1) THEN
  1573. C Transformation Cartesienne
  1574. C Le X lu devient mon Y
  1575. XLU=MMOMEN.XMOMEN(1,NBMOME)
  1576. MMOMEN.XMOMEN(1,NBMOME)=MMOMEN.XMOMEN(2,NBMOME)
  1577. MMOMEN.XMOMEN(2,NBMOME)=XLU
  1578.  
  1579. ELSEIF (ITYPES .EQ. 2) THEN
  1580. C Transformation Cylindrique
  1581. WRITE(IOIMP,*) 'Repere Cylindrique non supporte:MOMENT, ',
  1582. & 'Noeud',IDLU,INOLU,NBLIGN
  1583. GOTO 11
  1584.  
  1585. ELSEIF (ITYPES .EQ. 3) THEN
  1586. C Transformation Spherique
  1587. WRITE(IOIMP,*) 'Repere Spherique non supporte:MOMENT, ',
  1588. & 'Noeud',IDLU,INOLU,NBLIGN
  1589. GOTO 11
  1590.  
  1591. ELSE
  1592. WRITE(IOIMP,*) 'Systeme de type inconnu :',ITYPES
  1593. CALL ERREUR(21)
  1594. RETURN
  1595. ENDIF
  1596.  
  1597. C Passage en coordonnées X,Y,Z centrées sur le repère Local
  1598. DO III=1,3
  1599. DO IFLOT=1,3
  1600. Flot = MMOMEN.XMOMEN(IFLOT,NBMOME)
  1601. INDICE=(III-1)*3 + IFLOT
  1602. XFL(III)=XFL(III)+ MSYSTE.SCOOR2(INDICE,NUMSYS)*Flot
  1603. C PRINT *,INDICE,SYSCOR(INDICE,NUMSYS),Flot,XFL(III)
  1604. ENDDO
  1605. ENDDO
  1606.  
  1607. C Remplacement dans MMOMEN
  1608. DO IFLOT=1,3
  1609. C Remplacement dans MMOMEN
  1610. MMOMEN.XMOMEN(IFLOT,NBMOME)=XFL(IFLOT)
  1611. ENDDO
  1612. ENDIF
  1613.  
  1614. ELSEIF ((IRETO1 .EQ. 57) .OR. (IRETO1 .EQ. 58)) THEN
  1615. C Cas des TEMPERATURES
  1616. READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) IDLU
  1617. IF (IOSTA1 .NE. 0) THEN
  1618. moterr ='READ (IOSTAT)'
  1619. interr(1) = IOSTA1
  1620. CALL ERREUR(873)
  1621. RETURN
  1622. ENDIF
  1623. C PRINT *, GETYPE(IRETO1),IDLU,(IRETO1 - (NBGEO1+NBSY) + 1)/2
  1624. NBTEMP = NBTEMP + 1
  1625.  
  1626. IF (NBTEMP .GT. JGTEMP) THEN
  1627. INCTEM = 2 * INCTEM
  1628. JGTEMP = JGTEMP + INCTEM
  1629. SEGADJ, MTEMP
  1630. ENDIF
  1631.  
  1632. DO IDVU=1,NBTDIF
  1633. IF (IDLU .EQ. MTEMP.ILITEM(IDVU)) GOTO 302
  1634. ENDDO
  1635.  
  1636. NBTDIF = NBTDIF + 1
  1637. IDVU = NBTDIF
  1638. SEGADJ,MTEMP
  1639. MTEMP.ILITEM(NBTDIF)=IDLU
  1640.  
  1641. 302 CONTINUE
  1642. MTEMP.NBETEM(IDVU )=MTEMP.NBETEM(IDVU) + 1
  1643. MTEMP.ICOTEM(NBTEMP)=IDVU
  1644. IDEB = IFIN + 1
  1645. IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
  1646. READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) INOLU
  1647. IF (IOSTA1 .NE. 0) THEN
  1648. moterr ='READ (IOSTAT)'
  1649. interr(1) = IOSTA1
  1650. CALL ERREUR(873)
  1651. RETURN
  1652. ENDIF
  1653.  
  1654. IDEB = IFIN + 1
  1655. IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
  1656. READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) FLOT1
  1657. IF (IOSTA1 .NE. 0) THEN
  1658. moterr ='READ (IOSTAT)'
  1659. interr(1) = IOSTA1
  1660. CALL ERREUR(873)
  1661. RETURN
  1662. ENDIF
  1663.  
  1664. MTEMP.IDTEMP(NBTEMP)=IDLU
  1665. MTEMP.INOTEM(NBTEMP)=INOLU
  1666. MTEMP.XTEMP (NBTEMP)=FLOT1
  1667. C PRINT *,IDLU,INOLU,FLOT1,NBTDIF
  1668. ENDIF
  1669. GOTO 11
  1670.  
  1671.  
  1672. C***********************************************************************
  1673. C Fermeture du fichier en lecture
  1674. C***********************************************************************
  1675. 990 CONTINUE
  1676. CLOSE(UNIT=IUNAS,ERR=991)
  1677.  
  1678. C Ajustement du segment MCOORD
  1679. IF (NBNPTS .LT. JGNOLO) THEN
  1680. JGNOLO=NBNPTS
  1681. NBPTS=NBANC+JGNOLO
  1682. SEGADJ,MCOORD
  1683. ENDIF
  1684.  
  1685. C***********************************************************************
  1686. C Creation des MAILLAGES par ID de PROPERTY
  1687. C***********************************************************************
  1688. C PRINT *,'RECOMPOSITION DES MAILLAGES', NBPROP
  1689. IF (NBPROP .GT. 0) THEN
  1690. M=NBPROP
  1691. SEGINI,MTAB1
  1692.  
  1693. C Ecriture dans la table de Sortie de la TABLE MAILLAGES
  1694. COLO80='MAILLAGES'
  1695. CALL ECCTAB(MTABLE,'MOT ',0,0.d0,COLO80 ,.FALSE.,0,
  1696. & 'TABLE ',0,0.d0,'RIEN',.FALSE.,MTAB1)
  1697. IF (IERR.NE.0) RETURN
  1698. ENDIF
  1699.  
  1700. DO IP=1,NBPROP
  1701. NBMAIL=0
  1702.  
  1703. NBNN =0
  1704. NBELEM=0
  1705. NBSOUS=100
  1706. NBREF =0
  1707. SEGINI,MELEME
  1708. MPROP.IMELCO(IP)=MELEME
  1709. DO ITY=1,100
  1710. IF (MPROP.ITYPRO(ITY,IP) .GT. 0) THEN
  1711. NBMAIL= NBMAIL + 1
  1712. NBNN = NBNNE(ITY)
  1713. NBELEM= MPROP.ITYPRO(ITY,IP)
  1714. NBSOUS= 0
  1715. NBREF = 0
  1716. SEGINI,IPT1
  1717. IPT1.ITYPEL=ITY
  1718. MPROP.IMELSI(ITY,IP)=IPT1
  1719. MELEME.LISOUS(NBMAIL)=IPT1
  1720. C PRINT *, IP, MPROP.ITYPRO(ITY,IP), NOMS(ITY), NBNNE(ITY)
  1721. ENDIF
  1722. ENDDO
  1723. III=MELEME
  1724. NBSOUS=NBMAIL
  1725. IF (NBSOUS .EQ. 1) THEN
  1726. SEGSUP,MELEME
  1727. MPROP.IMELCO(IP)=IPT1
  1728. MELEME=IPT1
  1729. ELSE
  1730. NBNN =0
  1731. NBELEM=0
  1732. NBREF =0
  1733. SEGADJ,MELEME
  1734. SEGDES,MELEME
  1735. ENDIF
  1736.  
  1737. C Ecriture dans la table MAILLAGES
  1738. IPROP = MPROP.ICOPRO(IP)
  1739. CALL ECCTAB(MTAB1 ,'ENTIER ',IPROP,0.d0,'RIEN',.FALSE.,0,
  1740. & 'MAILLAGE',0 ,0.d0,'RIEN',.FALSE.,MELEME)
  1741. IF (IERR.NE.0) RETURN
  1742. ENDDO
  1743.  
  1744. IF (NBPROP .GT. 0) SEGDES,MTAB1
  1745.  
  1746. C***********************************************************************
  1747. C Creation des MAILLAGES par type de RBE2
  1748. C***********************************************************************
  1749. IF (NBRBE2 .GT. 0) THEN
  1750. M=NBRBE2
  1751. SEGINI,MTAB2
  1752.  
  1753. C Ecriture dans la table de Sortie de la TABLE RBE2
  1754. COLO80='RBE2'
  1755. CALL ECCTAB(MTABLE,'MOT ',0,0.d0,COLO80 ,.FALSE.,0,
  1756. & 'TABLE ',0,0.d0,'RIEN',.FALSE.,MTAB2)
  1757. IF (IERR.NE.0) RETURN
  1758. ENDIF
  1759.  
  1760. DO NURBE2=1,NBRBE2
  1761. C PRINT *,NURBE2,MRBE2.NELRBE(NURBE2)+1
  1762.  
  1763. NBNN =1
  1764. NBELEM=MRBE2.NELRBE(NURBE2)+1
  1765. NBSOUS=0
  1766. NBREF =0
  1767. SEGINI,MELEME
  1768. MELEME.ITYPEL=1
  1769. MRBE2.IMELRB(NURBE2) = MELEME
  1770.  
  1771. C Ecriture dans la table RBE2
  1772. M=2
  1773. SEGINI,MTAB3
  1774. CALL ECCTAB(MTAB3 ,'MOT ',0 ,0.d0,'MAILLAGE',.FALSE.,0,
  1775. & 'MAILLAGE',0 ,0.d0,'RIEN ',.FALSE.,MELEME)
  1776. IF (IERR.NE.0) RETURN
  1777. IBLOQ = MRBE2.IBLRBE(NURBE2)
  1778. C PRINT *,'NURBE2,IBLOQ',NURBE2,IBLOQ
  1779. CALL ECCTAB(MTAB3 ,'MOT ',0 ,0.d0,'HASHCODE',.FALSE.,0,
  1780. & 'ENTIER ',IBLOQ ,0.d0,'RIEN ',.FALSE.,0)
  1781. IF (IERR.NE.0) RETURN
  1782. SEGDES,MTAB3
  1783.  
  1784. CALL ECCTAB(MTAB2 ,'ENTIER ',NURBE2,0.d0,'MAILLAGE',.FALSE.,0,
  1785. & 'TABLE ',0 ,0.d0,'RIEN ',.FALSE.,MTAB3)
  1786. IF (IERR.NE.0) RETURN
  1787. ENDDO
  1788. IF (NBRBE2 .GT. 0) SEGDES,MTAB2
  1789.  
  1790. C***********************************************************************
  1791. C Remplissage des MAILLAGES
  1792. C***********************************************************************
  1793. DO 299 IELEM=1,NELTOT
  1794. IDELEM = MLIELE.ICOREL(IELEM)
  1795. IDCONN = MLIELE.IELCON(IDELEM)
  1796. IDTYPE = MLIELE.IELTYP(IDELEM)
  1797. IPLU = MLIELE.IDPROP(IDELEM)
  1798.  
  1799. ITYP2 = 0
  1800. COLO4 = NOMS(IDTYPE)
  1801. C Recherche dans le DATA des éléments géométriques
  1802. CALL PLACE(CTYPE,NBGEO2,ITYP2,COLO4)
  1803.  
  1804. C PRINT *,NOMS(IDTYPE),ITYP2
  1805. IF (MLIELE.IRBE2(IDELEM) .NE. 0) THEN
  1806. C Traitement des RBE2
  1807. NURBE2 = MLIELE.IDPROP(IDELEM)
  1808. IPT1 = MRBE2.IMELRB(NURBE2)
  1809. NBNN = IPT1.NUM(/1)
  1810. NBELEM = IPT1.NUM(/2)
  1811.  
  1812. C Reconstitution de la Connectivite
  1813. DO IEL = 1,NBELEM
  1814. NUMEL = NBELEM - MRBE2.NELRBE(NURBE2)
  1815. IDCOLU = ICONTO(IDCONN+(IEL - 1))
  1816. IDCOCA = MLINOE.ICORNO(IDCOLU)+NBANC
  1817. C PRINT *,NUMEL,IDCOLU,NBELEM
  1818.  
  1819. MRBE2.NELRBE(NURBE2) = MRBE2.NELRBE(NURBE2) - 1
  1820. IPT1.NUM(1,NUMEL) = IDCOCA
  1821. ENDDO
  1822. IF (NUMEL .EQ. NBELEM) THEN
  1823. SEGDES, IPT1
  1824. C PRINT *,'SEGDES,IPT1',IPT1
  1825. ENDIF
  1826.  
  1827. ELSE
  1828. C Traitement des Elements classiques
  1829. DO IPLO=1,NBPROP
  1830. C Recherche de la Property qui a le même ID
  1831. IF (MPROP.ICOPRO(IPLO) .EQ. IPLU) GOTO 300
  1832. ENDDO
  1833. WRITE(IOIMP,*) 'Aucune Property n''a ete trouvee...'
  1834. CALL ERREUR(21)
  1835. RETURN
  1836.  
  1837. 300 CONTINUE
  1838. MELEME= MPROP.IMELCO(IPLO)
  1839. C PRINT *,MELEME,IDTYPE,IPLO,IPLU,IDELEM
  1840. IPT1 = MPROP.IMELSI(IDTYPE,IPLO)
  1841. NBNN = IPT1.NUM(/1)
  1842. NBELEM= IPT1.NUM(/2)
  1843. NUMEL = MPROP.NBELPR(IDTYPE,IPLO) + 1
  1844. MPROP.NBELPR(IDTYPE,IPLO) = NUMEL
  1845.  
  1846.  
  1847. C Reconstitution de la Connectivite
  1848. C PRINT *,NOMS(IDTYPE),IDELEM,IPLU,IPLO
  1849. DO INOEUD=1,NBNN
  1850. ITEST = IORDCO(20* (ITYP2-1) + INOEUD)
  1851. IDCOLU = ICONTO(IDCONN+(ITEST-1))
  1852. IDCOCA = MLINOE.ICORNO(IDCOLU)+NBANC
  1853. IPT1.NUM(INOEUD,NUMEL) = IDCOCA
  1854. C PRINT *,'INOEUD',IDCOLU,IDCOCA
  1855. ENDDO
  1856. IF (NUMEL .EQ. NBELEM) THEN
  1857. SEGDES, IPT1
  1858. C PRINT *,'SEGDES, MELEME classique',IPT1
  1859. ENDIF
  1860. ENDIF
  1861. 299 CONTINUE
  1862.  
  1863. C***********************************************************************
  1864. C Generation des MELEME pour les SPC
  1865. C***********************************************************************
  1866. IF (NBSDIF .GT. 0) THEN
  1867. M=NBSDIF
  1868. SEGINI,MTAB1
  1869.  
  1870. C Ecriture dans la table de Sortie de la TABLE BLOCAGES
  1871. COLO80='BLOCAGES'
  1872. CALL ECCTAB(MTABLE,'MOT ',0,0.d0,COLO80 ,.FALSE.,0,
  1873. & 'TABLE ',0,0.d0,'RIEN',.FALSE.,MTAB1)
  1874. IF (IERR.NE.0) RETURN
  1875. ENDIF
  1876.  
  1877. DO ISPC=1,NBSDIF
  1878. NBMAIL=0
  1879.  
  1880. NBNN =1
  1881. NBELEM=MSPC.NBESPC(ISPC)
  1882. NBSOUS=0
  1883. NBREF =0
  1884. SEGINI,MELEME
  1885. MELEME.ITYPEL=1
  1886. MSPC.IMELSP(ISPC)=MELEME
  1887.  
  1888. C Ecriture dans la table BLOCAGES
  1889. IDS = MSPC.ILISPC(ISPC)
  1890. CALL ECCTAB(MTAB1 ,'ENTIER ',IDS ,0.d0,'RIEN',.FALSE.,0,
  1891. & 'MAILLAGE',0 ,0.d0,'RIEN',.FALSE.,MELEME)
  1892. IF (IERR.NE.0) RETURN
  1893. ENDDO
  1894.  
  1895. IF (NBSDIF .GT. 0) SEGDES,MTAB1
  1896.  
  1897. DO IELEM = 1,NBSPC
  1898. IDIF = MSPC.ICOSPC(IELEM)
  1899. IDNOLU = MSPC.INOSPC(IELEM)
  1900. IF(IDNOLU .EQ. 0)THEN
  1901. CALL ERREUR(1064)
  1902. RETURN
  1903. ENDIF
  1904. MELEME = MSPC.IMELSP(IDIF)
  1905. NBNN = MELEME.NUM(/1)
  1906. NBELEM = MELEME.NUM(/2)
  1907. NUMEL = NBELEM - MSPC.NBESPC(IDIF) + 1
  1908. MSPC.NBESPC(IDIF) = MSPC.NBESPC(IDIF) - 1
  1909. IDCOCA = MLINOE.ICORNO(IDNOLU)+NBANC
  1910. C PRINT *,IDIF,IDNOLU,IDCOCA,XCOOR(/1)/idimp1
  1911. MELEME.NUM(1,NUMEL) = IDCOCA
  1912. IF (NUMEL .EQ. NBELEM) THEN
  1913. SEGDES, MELEME
  1914. C PRINT *,'SEGDES, MELEME, BLOCAGES',MELEME
  1915. ENDIF
  1916. ENDDO
  1917.  
  1918. C***********************************************************************
  1919. C Generation des CHPOINT pour les FORCES
  1920. C***********************************************************************
  1921. IF (NBFDIF .GT. 0) THEN
  1922. M=NBFDIF
  1923. SEGINI,MTAB1
  1924.  
  1925. C Ecriture dans la table de Sortie de la TABLE FORCES
  1926. COLO80='FORCES'
  1927. CALL ECCTAB(MTABLE,'MOT ',0,0.d0,COLO80 ,.FALSE.,0,
  1928. & 'TABLE ',0,0.d0,'RIEN',.FALSE.,MTAB1)
  1929. IF (IERR.NE.0) RETURN
  1930. ENDIF
  1931.  
  1932. DO IFOR=1,NBFDIF
  1933. NNIN = 3
  1934. NNNOE= MFORCE.NBEFOR(IFOR)
  1935. SEGINI,MTRAV
  1936. ITRAV = MTRAV
  1937. MTRAV.INCO(1)='FX '
  1938. MTRAV.INCO(2)='FY '
  1939. MTRAV.INCO(3)='FZ '
  1940.  
  1941. DO IELEM = 1,NBFORC
  1942. IF (MFORCE.IDFORC(IELEM) .EQ. MFORCE.ILIFOR(IFOR)) THEN
  1943. IDNOLU = MFORCE.INOFOR(IELEM)
  1944. IDCOCA = MLINOE.ICORNO(IDNOLU)+NBANC
  1945. DO IVAL=1,3
  1946. XVAL = MFORCE.XFORCE(IVAL,IELEM)
  1947. MTRAV.BB (IVAL,NNNOE) = XVAL
  1948. MTRAV.IBIN(IVAL,NNNOE) = 1
  1949. ENDDO
  1950. MTRAV.IGEO( NNNOE) = IDCOCA
  1951. NNNOE = NNNOE - 1
  1952. IF (NNNOE .EQ. 0) THEN
  1953. CALL CRECHP(ITRAV,ICHPO1)
  1954. C PRINT *,'SEGSUP,MTRAV',MTRAV
  1955. SEGSUP,MTRAV
  1956. C Ecriture dans la table FORCES
  1957. IDT = MFORCE.ILIFOR(IFOR)
  1958. CALL ECCTAB(MTAB1 ,'ENTIER ',IDT ,0.d0,'RIEN',.FALSE.,0,
  1959. & 'CHPOINT ',0 ,0.d0,'RIEN',.FALSE.,ICHPO1)
  1960. IF (IERR.NE.0) RETURN
  1961. ENDIF
  1962. ENDIF
  1963. ENDDO
  1964. ENDDO
  1965.  
  1966. IF (NBFORC .GT. 0) SEGDES,MTAB1
  1967.  
  1968.  
  1969. C***********************************************************************
  1970. C Generation des CHPOINT pour les MOMENTS
  1971. C***********************************************************************
  1972. IF (NBMDIF .GT. 0) THEN
  1973. M=NBMDIF
  1974. SEGINI,MTAB1
  1975.  
  1976. C Ecriture dans la table de Sortie de la TABLE MOMENTS
  1977. COLO80='MOMENTS'
  1978. CALL ECCTAB(MTABLE,'MOT ',0,0.d0,COLO80 ,.FALSE.,0,
  1979. & 'TABLE ',0,0.d0,'RIEN',.FALSE.,MTAB1)
  1980. IF (IERR.NE.0) RETURN
  1981. ENDIF
  1982.  
  1983. DO IMOM=1,NBMDIF
  1984. NNIN = 3
  1985. NNNOE= MMOMEN.NBEMOM(IMOM)
  1986. SEGINI,MTRAV
  1987. ITRAV = MTRAV
  1988. MTRAV.INCO(1)='MX '
  1989. MTRAV.INCO(2)='MY '
  1990. MTRAV.INCO(3)='MZ '
  1991.  
  1992. DO IELEM = 1,NBFORC
  1993. IF (MMOMEN.IDMOME(IELEM) .EQ. MMOMEN.ILIMOM(IMOM)) THEN
  1994. IDNOLU = MMOMEN.INOMOM(IELEM)
  1995. IDCOCA = MLINOE.ICORNO(IDNOLU)+NBANC
  1996. DO IVAL=1,3
  1997. XVAL = MMOMEN.XMOMEN(IVAL,IELEM)
  1998. MTRAV.BB (IVAL,NNNOE) = XVAL
  1999. MTRAV.IBIN(IVAL,NNNOE) = 1
  2000. ENDDO
  2001. MTRAV.IGEO( NNNOE) = IDCOCA
  2002. NNNOE = NNNOE - 1
  2003. IF (NNNOE .EQ. 0) THEN
  2004. CALL CRECHP(ITRAV,ICHPO1)
  2005. C PRINT *,'SEGSUP,MTRAV',MTRAV
  2006. SEGSUP,MTRAV
  2007. C Ecriture dans la table MOMENTS
  2008. IDT = MMOMEN.ILIMOM(IMOM)
  2009. CALL ECCTAB(MTAB1 ,'ENTIER ',IDT ,0.d0,'RIEN',.FALSE.,0,
  2010. & 'CHPOINT ',0 ,0.d0,'RIEN',.FALSE.,ICHPO1)
  2011. IF (IERR.NE.0) RETURN
  2012. ENDIF
  2013. ENDIF
  2014. ENDDO
  2015. ENDDO
  2016.  
  2017. IF (NBFORC .GT. 0) SEGDES,MTAB1
  2018.  
  2019. C***********************************************************************
  2020. C Generation des CHPOINT pour les TEMPERATURE
  2021. C***********************************************************************
  2022. IF (NBTDIF .GT. 0) THEN
  2023. M=NBTDIF
  2024. SEGINI,MTAB1
  2025.  
  2026. C Ecriture dans la table de Sortie de la TABLE TEMPERATURES
  2027. COLO80='TEMPERATURES'
  2028. CALL ECCTAB(MTABLE,'MOT ',0,0.d0,COLO80 ,.FALSE.,0,
  2029. & 'TABLE ',0,0.d0,'RIEN',.FALSE.,MTAB1)
  2030. IF (IERR.NE.0) RETURN
  2031. ENDIF
  2032.  
  2033. DO ITMP=1,NBTDIF
  2034. NNIN = 1
  2035. NNNOE= MTEMP.NBETEM(ITMP)
  2036. SEGINI,MTRAV
  2037. ITRAV = MTRAV
  2038. MTRAV.INCO(1)='T '
  2039.  
  2040. DO IELEM = 1,NBTEMP
  2041. IF (MTEMP.IDTEMP(IELEM) .EQ. MTEMP.ILITEM(ITMP)) THEN
  2042. IDNOLU = MTEMP.INOTEM(IELEM)
  2043. XVAL1 = MTEMP.XTEMP(IELEM)
  2044. IDCOCA = MLINOE.ICORNO(IDNOLU)+NBANC
  2045. MTRAV.BB (1,NNNOE) = XVAL1
  2046. MTRAV.IBIN(1,NNNOE) = 1
  2047. MTRAV.IGEO( NNNOE) = IDCOCA
  2048. NNNOE = NNNOE - 1
  2049. IF (NNNOE .EQ. 0) THEN
  2050. CALL CRECHP(ITRAV,ICHPO1)
  2051. C PRINT *,'SEGSUP,MTRAV',MTRAV
  2052. SEGSUP,MTRAV
  2053. C Ecriture dans la table TEMPERATURES
  2054. IDT = MTEMP.ILITEM(ITMP)
  2055. CALL ECCTAB(MTAB1 ,'ENTIER ',IDT ,0.d0,'RIEN',.FALSE.,0,
  2056. & 'CHPOINT ',0 ,0.d0,'RIEN',.FALSE.,ICHPO1)
  2057. IF (IERR.NE.0) RETURN
  2058. ENDIF
  2059. ENDIF
  2060. ENDDO
  2061. ENDDO
  2062.  
  2063. IF (NBTDIF .GT. 0) SEGDES,MTAB1
  2064.  
  2065. C***********************************************************************
  2066. C Generation des trièdres pour les SYSTEMES : SEG2
  2067. C***********************************************************************
  2068. IF (NBSYST .GT. 0) THEN
  2069. M=NBSYST
  2070. SEGINI,MTAB2
  2071.  
  2072. C Ecriture dans la table de Sortie de la TABLE SYSTEMS
  2073. COLO80='SYSTEMES'
  2074. CALL ECCTAB(MTABLE,'MOT ',0,0.d0,COLO80 ,.FALSE.,0,
  2075. & 'TABLE ',0,0.d0,'RIEN',.FALSE.,MTAB2)
  2076. IF (IERR.NE.0) RETURN
  2077.  
  2078. C Ajustement du SEGMENT MCOORD
  2079. NBANC2=XCOOR(/1)/(IDIM+1)
  2080. NBPTS=NBANC2+(4*NBSYST)
  2081. SEGADJ,MCOORD
  2082. ENDIF
  2083.  
  2084. DO NUMSYS=1,NBSYST
  2085. C Ajout au SEGMENT MCOORD des points en question
  2086. IFLOT2 = 0
  2087. j =(NBANC2+(NUMSYS-1)*4)*idimp1
  2088. DO IFLOT=1,12
  2089. IFLOT2=IFLOT2 + 1
  2090. IF (MOD(IFLOT2,4) .EQ. 0) THEN
  2091. C On saute la couleur
  2092. IFLOT2=IFLOT2 + 1
  2093. ENDIF
  2094. Flot1 = MSYSTE.SYSCOR(IFLOT,NUMSYS)
  2095. MCOORD.XCOOR(j+IFLOT2)=Flot1
  2096. C PRINT *,NUMSYS,j+IFLOT2,NBANC2+(NUMSYS-1)*4,Flot1
  2097. ENDDO
  2098.  
  2099. NBNN = 2
  2100. NBELEM = 3
  2101. NBSOUS = 0
  2102. NBREF = 0
  2103. SEGINI,IPT3
  2104. IPT3.ITYPEL = IELEQ1(3)
  2105.  
  2106. NUMORIG=NBANC2+(NUMSYS-1)*4 + 1
  2107. DO IEL=1,NBELEM
  2108. DO INN=1,NBNN
  2109. IF (INN .EQ. 1) THEN
  2110. IPT3.NUM(INN,IEL)=NUMORIG + INN - 1
  2111. ELSE
  2112. IPT3.NUM(INN,IEL)=NUMORIG + IEL
  2113. ENDIF
  2114. C PRINT *, IPT3.NUM(INN,IEL),XCOOR(/1)/(IDIM+1)
  2115. ENDDO
  2116. ENDDO
  2117.  
  2118. C Ecriture dans la table SYSTEMS
  2119. IDSYS = MSYSTE.IDSYST(NUMSYS)
  2120. CALL ECCTAB(MTAB2 ,'ENTIER ',IDSYS,0.d0,'RIEN',.FALSE.,0,
  2121. & 'MAILLAGE',0 ,0.d0,'RIEN',.FALSE.,IPT3)
  2122. IF (IERR.NE.0) RETURN
  2123. ENDDO
  2124.  
  2125.  
  2126. C***********************************************************************
  2127. C FIN et sortie
  2128. C***********************************************************************
  2129. 991 CONTINUE
  2130. C Traitement des erreurs
  2131. IF (iOK .NE.0) THEN
  2132. CALL ERREUR(iOK)
  2133. RETURN
  2134.  
  2135. ELSE
  2136. CALL ECROBJ('TABLE ',MTABLE)
  2137.  
  2138. ENDIF
  2139. SEGDES,MTABLE
  2140. SEGSUP,MLINOE, MLIELE, MPROP, MSYSTE, MRBE2, MSPC, MTEMP, MMOMEN
  2141.  
  2142. RETURN
  2143. END
  2144.  
  2145.  
  2146.  
  2147.  
  2148.  
  2149.  
  2150.  

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