Télécharger lirnas.eso

Retour à la liste

Numérotation des lignes :

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

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