Télécharger lekcof.eso

Retour à la liste

Numérotation des lignes :

  1. C LEKCOF SOURCE PV 13/04/16 21:15:18 7765
  2. SUBROUTINE LEKCOF(TITRE,MTABX,KINC,NU,IXV,
  3. & MCHPOI,MPOVAL,NPT,NC,IK1,IRET)
  4. C----------------------------------------------------------------------
  5. C Ce sous programme lit le NUième coefficient d'un operateur, stocké
  6. C à l'indice ARGnu de la table KIZX de pointeur MTABX associée à
  7. C l'opérateur en cours de traitement.
  8. C Le coefficient est de type ENTIER, FLOTTANT, POINT, CHPOINT ou MOT.
  9. C----------------------------------------------------------------------
  10. C Quel que soit le type de l'objet récupéré, l'objet retourné est un
  11. C CHPOINT. Ce CHPO s'appuie sur un point bidon dans le cas ou la donnée
  12. C est un ENTIER, un FLOTTANT ou un POINT.
  13. C----------------------------------------------------------------------
  14. C HISTORIQUE : 20/09/00 : Les segments MPOVAL sont retournes actif en
  15. C lecture seule.
  16. C HISTORIQUE :
  17. C
  18. C
  19. C---------------------------
  20. C Paramètres Entrée/Sortie :
  21. C---------------------------
  22. C
  23. C E/ TITRE : Commentaires pour les messages d'erreur (à supprimer)
  24. C E/ MTABX : Pointeur de la table contenant le coefficient
  25. C E/ KINC : Pointeur de la table INCO dans laquelle on va chercher
  26. C les valeurs des indices lorsque ceux-ci sont des MOTS.
  27. C E/ NU : Rang du coefficient a aller chercher (ENTIER)
  28. C E/ IXV(*) : Vecteur d'entier indiquant le type de l'objet cherché
  29. C IXV(1) = 0 : Objet CHPO non autorisé
  30. C IXV(1) > 0 : spg du CHPO si une composante (SCAL)
  31. C IXV(1) < 0 : spg du CHPO si IDIM composante (VECT)
  32. C IXV(2) = 0 : Objet FLOTTANT ou ENTIER non autorisé in
  33. C IXV(2) = 1 : Objet FLOTTANT ou ENTIER autorisé
  34. C IXV(3) = 0 : Objet POINT non autorisé
  35. C IXV(3) = 1 : Objet POINT autorisé
  36. C IXV(i),i>3 : Autres spg pour CHPO (similaire à IXV(1))
  37. C cf IRET
  38. C /S MCHPOI : Pointeur du CHPO contenant le coef
  39. C /S MPOVAL : Pointeur sur le segment du CHPO contenant les coef
  40. C /S NPT : Nombre de point du spg du CHPO
  41. C /S NC : Nombre de composante du CHPO
  42. C (on autorise 1 ou IDIM)
  43. C /S IK1 : Indicateur retournant le type de l'objet trouvé
  44. C 0=CHPO 1=FLOTTANT 2=POINT >3=CHPO de spg IXV(ik1)
  45. C Dans le cas ou IK1=1 ou 2 la donnée est transformée
  46. C en CHPO et stocké à l'indice ARGSnu de la table MTABX
  47. C E/S IRET : En entrée, =0 tentative de lecture seule
  48. C : En entrée, =1 Si l'objet n existe pas on le cree
  49. C si CHPOIN autorise et on le met dans la table inco
  50. C Dans ce cas en sortie IRET=2 (ceci ne marche
  51. C que si dime de IXV<=3
  52. C : En entrée, si supérieur à 3 dimension de IXV,
  53. C En sortie, indicateur de succès (0=problèmes, 1=OK ,
  54. C 2 si creation aveugle)
  55. C----------------------------------------------------------------------
  56. C Dans le cas ENTIER, FLOTTANT ou POINT, on construit un CHPOINT
  57. C que l'on stocke à l'indice ARGSnu de la table MTABX.
  58. C Dans le cas MOT, on récupère la donnée se trouvant à l'indice MOT
  59. C de la table INCO que l'on transforme éventuellement en CHPOINT comme
  60. C precedemment.
  61. C----------------------------------------------------------------------
  62. IMPLICIT INTEGER(I-N)
  63. IMPLICIT REAL*8 (A-H,O-Z)
  64. -INC CCOPTIO
  65. -INC SMCOORD
  66. -INC SMCHPOI
  67. -INC SMELEME
  68. -INC SMTABLE
  69. POINTEUR igeom.meleme
  70. POINTEUR MTABX.MTABLE,KINC.MTABLE
  71. CHARACTER*(*) TITRE
  72. CHARACTER*8 TYPE,TYPC,NOM,MARG,NARG,TYPI
  73. LOGICAL LOGI
  74. REAL*8 XVAL(3)
  75. DIMENSION IXV(*)
  76. C
  77. C- Récupération du TYPE du NUième argument de l'opérateur
  78. C
  79. C write(6,*)' DEBUT LEKCOF'
  80. IXV1 = IRET
  81. ISG1 = 1
  82. IRET = 1
  83. IF (NU.LE.0 .OR. NU.GE.100) THEN
  84. INTERR(1) = NU
  85. INTERR(2) = 1
  86. INTERR(3) = 99
  87. CALL ERREUR(789)
  88. IRET = 0
  89. RETURN
  90. ENDIF
  91. IF (NU.LE.9) THEN
  92. WRITE(NARG,FMT='(A3,I1)')'ARG',Nu
  93. WRITE(MARG,FMT='(A4,I1)')'ARGS',Nu
  94. ELSE
  95. WRITE(NARG,FMT='(A3,I2)')'ARG',Nu
  96. WRITE(MARG,FMT='(A4,I2)')'ARGS',Nu
  97. ENDIF
  98. TYPE = ' '
  99. CALL LENCHA(NARG,LC)
  100. CALL ACCTAB(MTABX,'MOT', 0,0.D0,NARG(1:LC),LOGI, 0,
  101. & TYPE ,IENT,XVAL, NOM,LOGI,MCHPOI)
  102. C
  103. C- Argument de TYPE ENTIER ou FLOTTANT
  104. C
  105. IF (TYPE.EQ.'FLOTTANT'.OR.TYPE.EQ.'ENTIER') THEN
  106. IF (IXV(2).EQ.0) THEN
  107. MOTERR(1: 8) = NARG
  108. MOTERR(9:16) = TYPE
  109. CALL ERREUR(787)
  110. IRET = 0
  111. RETURN
  112. ENDIF
  113. IF (TYPE.EQ.'ENTIER') XVAL(1)=FLOAT(IENT)
  114. C creation d'un champoin
  115. NBNN=1
  116. NBELEM=1
  117. NBSOUS=0
  118. NBREF=0
  119. SEGINI MELEME
  120. ITYPEL=1
  121. NUM(1,1)=1
  122. SEGDES MELEME
  123.  
  124. NSOUPO=1
  125. NAT=1
  126. N=1
  127. NC=1
  128. SEGINI MCHPOI,MSOUPO,MPOVAL
  129. JATTRI(1)=2
  130. IFOPOI=IFOMOD
  131. MTYPOI=' '
  132. MOCHDE=' '
  133. IPCHP(1)=MSOUPO
  134. IPOVAL=MPOVAL
  135. NOCOMP(1)='SCAL'
  136. SEGDES MCHPOI,MSOUPO
  137. C creation d'un champoin fin
  138.  
  139. VPOCHA(1,1)=XVAL(1)
  140. IK1 = 1
  141. NPT = 1
  142. NC = 1
  143. C
  144. C- Argument de type CHPOINT
  145. C
  146. ELSEIF (TYPE.EQ.'CHPOINT') THEN
  147. IF (IXV(1).EQ.0) THEN
  148. MOTERR(1: 8) = NARG
  149. MOTERR(9:16) = TYPE
  150. CALL ERREUR(787)
  151. IRET = 0
  152. RETURN
  153. ENDIF
  154. CALL LRCHT(MCHPOI,MPOVAL,TYPC,IGEOM)
  155.  
  156. NC=VPOCHA(/2)
  157. MELEME = IXV(1)
  158. IF (MELEME.LT.0) THEN
  159. MELEME= -IXV(1)
  160. ISG1 = -1
  161. ENDIF
  162. IF (IGEOM.NE.MELEME) THEN
  163. * write (6,*) ' lekcof 1-1 ',igeom,meleme
  164. segact igeom,meleme
  165. igeom0=abs(igeom)
  166. call crech1(igeom,0)
  167. call crech1(meleme,0)
  168. endif
  169. * write (6,*) ' lekcof 1-2 ',igeom,meleme
  170. IF (IGEOM.NE.MELEME) THEN
  171. IF (IXV1.GT.3) THEN
  172. IXV2 = IXV1 - 3
  173. I = 0
  174. 10 CONTINUE
  175. I = I + 1
  176. IF(NC.GT.1)THEN
  177. IGEOM=-ABS(IGEOM)
  178. ISG1=-1
  179. ENDIF
  180. IF (IGEOM0.EQ.IXV(I+3)) THEN
  181. IK1=I+3
  182. GOTO 20
  183. ENDIF
  184. IF (I.LT.IXV2) GOTO 10
  185. ENDIF
  186. MOTERR(1: 8) = NARG
  187. MOTERR(9:16) = TYPE
  188. CALL ERREUR(788)
  189. IRET = 0
  190. RETURN
  191. ELSE
  192. IK1 = 0
  193. ENDIF
  194. 20 CONTINUE
  195. NPT = VPOCHA(/1)
  196. NC = VPOCHA(/2)
  197. IF ( (ISG1.EQ.-1.AND.NC.NE.IDIM) .OR.
  198. & (ISG1.EQ.1.AND.NC.NE.1) ) THEN
  199. MOTERR(1: 8) = NARG
  200. MOTERR(9:16) = TYPE
  201. CALL ERREUR(784)
  202. IRET = 0
  203. RETURN
  204. ENDIF
  205. C
  206. C- Argument de type POINT
  207. C
  208. ELSEIF (TYPE.EQ.'POINT') THEN
  209. IF (IXV(3).EQ.0)THEN
  210. MOTERR(1: 8) = NARG
  211. MOTERR(9:16) = TYPE
  212. CALL ERREUR(787)
  213. IRET = 0
  214. RETURN
  215. ENDIF
  216. IP = MCHPOI
  217. XVAL(1) = XCOOR((IP-1)*(IDIM+1) +1)
  218. XVAL(2) = XCOOR((IP-1)*(IDIM+1) +2)
  219. IF (IDIM.EQ.3) XVAL(3)=XCOOR((IP-1)*(IDIM+1) +3)
  220. IK1 = 2
  221. NPT = 1
  222.  
  223. C creation d'un champoin
  224. NBNN=1
  225. NBELEM=1
  226. NBSOUS=0
  227. NBREF=0
  228. SEGINI MELEME
  229. ITYPEL=1
  230. NUM(1,1)=1
  231. SEGDES MELEME
  232.  
  233. NSOUPO=1
  234. NAT=1
  235. N=1
  236. NC=IDIM
  237. SEGINI MCHPOI,MSOUPO,MPOVAL
  238. JATTRI(1)=2
  239. IFOPOI=IFOMOD
  240. MTYPOI=' '
  241. MOCHDE=' '
  242. IPCHP(1)=MSOUPO
  243. IPOVAL=MPOVAL
  244. NOCOMP(1)='SCAL'
  245. SEGDES MCHPOI,MSOUPO
  246. C creation d'un champoin fin
  247.  
  248. VPOCHA(1,1) = XVAL(1)
  249. VPOCHA(1,2) = XVAL(2)
  250. IF (IDIM.EQ.3) VPOCHA(1,3)=XVAL(3)
  251. C
  252. C- Argument de type MOT
  253. C-
  254. C- TYPC : TYPE de l'objet rangé à l'indice MOT de la table KINC.
  255. C- On considère à nouveau les cas ENTIER, FLOTTANT, POINT ou CHPO
  256. C- que l'on traite de la meme facon que ci-dessus.
  257. C
  258. ELSEIF(TYPE.EQ.'MOT')THEN
  259. IF (KINC.EQ.0) THEN
  260. MOTERR(1: 8) = NARG
  261. MOTERR(9:16) = 'INCO '
  262. CALL ERREUR(785)
  263. IRET = 0
  264. RETURN
  265. ENDIF
  266. TYPC = ' '
  267. CALL ACMO(KINC,NOM,TYPC,MCHPOI)
  268. IF (TYPC.EQ.'CHPOINT ') THEN
  269. IF (IXV(1).EQ.0) THEN
  270. MOTERR(1: 8) = NARG
  271. MOTERR(9:16) = TYPC
  272. CALL ERREUR(787)
  273. IRET = 0
  274. RETURN
  275. ENDIF
  276. MELEME = IXV(1)
  277. IF (MELEME.LT.0) THEN
  278. MELEME= -IXV(1)
  279. ISG1 = -1
  280. ENDIF
  281. CALL LRCHT(MCHPOI,MPOVAL,TYPE,IGEOM)
  282. NC=VPOCHA(/2)
  283. IF (IGEOM.NE.MELEME) THEN
  284. * write (6,*) ' lekcof 2-1 ',igeom,meleme
  285. segact igeom,meleme
  286. igeomo=abs(igeom)
  287. * call ecmail(igeom,1)
  288. * call ecmail(meleme,1)
  289. * segact igeom,meleme
  290. call crech1(igeom,0)
  291. call crech1(meleme,0)
  292. endif
  293. IF (IGEOM.NE.MELEME) THEN
  294. * write (6,*) ' lekcof 2-2 ',igeom,meleme,ixv1
  295. IF (IXV1.GT.3) THEN
  296. IXV2 = IXV1 - 3
  297. I = 0
  298. 100 CONTINUE
  299. I = I + 1
  300. IF(NC.GT.1)THEN
  301. IGEOM=-ABS(IGEOM)
  302. ISG1=-1
  303. ENDIF
  304. IF (IGEOMO.EQ.IXV(I+3)) THEN
  305. IK1=I+3
  306. GOTO 110
  307. ENDIF
  308. IF (I.LT.IXV2) GOTO 100
  309. ENDIF
  310. MOTERR(1: 8) = NARG
  311. MOTERR(9:16) = TYPC
  312. CALL ERREUR(788)
  313. IRET = 0
  314. RETURN
  315. ELSE
  316. IK1 = 0
  317. ENDIF
  318. 110 CONTINUE
  319. NPT = VPOCHA(/1)
  320. NC = VPOCHA(/2)
  321. IF ( (ISG1.EQ.-1.AND.NC.NE.IDIM) .OR.
  322. & (ISG1.EQ.1.AND.NC.NE.1) ) THEN
  323. MOTERR(1: 8) = NARG
  324. MOTERR(9:16) = TYPC
  325. CALL ERREUR(784)
  326. IRET = 0
  327. RETURN
  328. ENDIF
  329. ELSEIF (TYPC.EQ.'FLOTTANT') THEN
  330. IF (IXV(2).EQ.0) THEN
  331. MOTERR(1: 8) = NARG
  332. MOTERR(9:16) = TYPC
  333. CALL ERREUR(787)
  334. IRET = 0
  335. RETURN
  336. ENDIF
  337. CALL ACMF(KINC,NOM,XVAL)
  338. IK1 = 1
  339.  
  340. C creation d'un champoin
  341. NBNN=1
  342. NBELEM=1
  343. NBSOUS=0
  344. NBREF=0
  345. SEGINI MELEME
  346. ITYPEL=1
  347. NUM(1,1)=1
  348. SEGDES MELEME
  349.  
  350. NSOUPO=1
  351. NAT=1
  352. N=1
  353. NC=1
  354. SEGINI MCHPOI,MSOUPO,MPOVAL
  355. JATTRI(1)=2
  356. IFOPOI=IFOMOD
  357. MTYPOI=' '
  358. MOCHDE=' '
  359. IPCHP(1)=MSOUPO
  360. IPOVAL=MPOVAL
  361. NOCOMP(1)='SCAL'
  362. SEGDES MCHPOI,MSOUPO
  363. C creation d'un champoin fin
  364.  
  365. VPOCHA(1,1) = XVAL(1)
  366. NPT = 1
  367. NC = 1
  368. ELSEIF (TYPC.EQ.'ENTIER') THEN
  369. IF (IXV(2).EQ.0) THEN
  370. MOTERR(1: 8) = NARG
  371. MOTERR(9:16) = TYPC
  372. CALL ERREUR(787)
  373. IRET = 0
  374. RETURN
  375. ENDIF
  376. CALL ACME(KINC,NOM,IENT)
  377. XVAL(1) = FLOAT(IENT)
  378.  
  379. C creation d'un champoin
  380. NBNN=1
  381. NBELEM=1
  382. NBSOUS=0
  383. NBREF=0
  384. SEGINI MELEME
  385. ITYPEL=1
  386. NUM(1,1)=1
  387. SEGDES MELEME
  388.  
  389. NSOUPO=1
  390. NAT=1
  391. N=1
  392. NC=1
  393. SEGINI MCHPOI,MSOUPO,MPOVAL
  394. JATTRI(1)=2
  395. IFOPOI=IFOMOD
  396. MTYPOI=' '
  397. MOCHDE=' '
  398. IPCHP(1)=MSOUPO
  399. IPOVAL=MPOVAL
  400. NOCOMP(1)='SCAL'
  401. SEGDES MCHPOI,MSOUPO
  402. C creation d'un champoin fin
  403.  
  404. VPOCHA(1,1) = XVAL(1)
  405. IK1 = 1
  406. NPT = 1
  407. NC = 1
  408. ELSEIF (TYPC.EQ.'POINT') THEN
  409. IF (IXV(3).EQ.0) THEN
  410. MOTERR(1: 8) = NARG
  411. MOTERR(9:16) = TYPC
  412. CALL ERREUR(787)
  413. IRET = 0
  414. RETURN
  415. ENDIF
  416. IP = MCHPOI
  417. XVAL(1) = XCOOR((IP-1)*(IDIM+1) +1)
  418. XVAL(2) = XCOOR((IP-1)*(IDIM+1) +2)
  419. IF (IDIM.EQ.3) XVAL(3)=XCOOR((IP-1)*(IDIM+1) +3)
  420.  
  421. C creation d'un champoin
  422. NBNN=1
  423. NBELEM=1
  424. NBSOUS=0
  425. NBREF=0
  426. SEGINI MELEME
  427. ITYPEL=1
  428. NUM(1,1)=1
  429. SEGDES MELEME
  430.  
  431. NSOUPO=1
  432. NAT=1
  433. N=1
  434. NC=IDIM
  435. SEGINI MCHPOI,MSOUPO,MPOVAL
  436. JATTRI(1)=2
  437. IFOPOI=IFOMOD
  438. MTYPOI=' '
  439. MOCHDE=' '
  440. IPCHP(1)=MSOUPO
  441. IPOVAL=MPOVAL
  442. NOCOMP(1)='SCAL'
  443. SEGDES MCHPOI,MSOUPO
  444. C creation d'un champoin fin
  445.  
  446. VPOCHA(1,1) = XVAL(1)
  447. VPOCHA(1,2) = XVAL(2)
  448. IF (IDIM.EQ.3) VPOCHA(1,3)=XVAL(3)
  449. IK1 = 2
  450. NPT = 1
  451. ELSE
  452. IF(IXV1.EQ.1)THEN
  453. IF(IXV(1).GT.0)THEN
  454. NC=1
  455. IGEOM=IXV(1)
  456. TYPI='LEKCOF'
  457. TYPC='CHPOINT'
  458. CALL CRCHPT(TYPI,IGEOM,NC,MCHPOI)
  459. CALL ECMO(KINC,NOM,TYPC,MCHPOI)
  460. CALL LICHT(MCHPOI,MPOVAL,TYPC,IGEOM0)
  461. IRET=2
  462. RETURN
  463. ELSEIF(IXV(1).LT.0)THEN
  464. NC=IDIM
  465. IGEOM=-IXV(1)
  466. TYPI='LEKCOF'
  467. TYPC='CHPOINT'
  468. CALL CRCHPT(TYPI,IGEOM,NC,MCHPOI)
  469. CALL ECMO(KINC,NOM,TYPC,MCHPOI)
  470. CALL LICHT(MCHPOI,MPOVAL,TYPC,IGEOM0)
  471. IRET=2
  472. RETURN
  473. ENDIF
  474. ENDIF
  475.  
  476. IF (MCHPOI.EQ.0) THEN
  477. MOTERR( 1: 8) = NARG
  478. MOTERR( 9:16) = NOM
  479. MOTERR(17:24) = 'INCO '
  480. CALL ERREUR(786)
  481. ELSE
  482. MOTERR(1: 8) = NARG
  483. MOTERR(9:16) = TYPC
  484. CALL ERREUR(787)
  485. ENDIF
  486. IRET = 0
  487. RETURN
  488. ENDIF
  489. C
  490. C- Argument de type autre que ENTIER, FLOTTANT, POINT, CHPO ou MOT
  491. C
  492. ELSE
  493. MOTERR(1: 8) = NARG
  494. MOTERR(9:16) = TYPE
  495. CALL ERREUR(787)
  496. IRET = 0
  497. RETURN
  498. ENDIF
  499. C
  500. RETURN
  501. END
  502.  
  503.  
  504.  
  505.  
  506.  
  507.  
  508.  
  509.  

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