Télécharger nlovep.eso

Retour à la liste

Numérotation des lignes :

  1. C NLOVEP SOURCE CHAT 11/03/16 21:28:36 6902
  2. SUBROUTINE NLOVEP(IPCHCO,IPCHI,IPLMOT, IPCHO,NLOC1, IRET)
  3. C_______________________________________________________________________
  4. C
  5. C VERIFICATION ET PREPARATION DU TRAVAIL SUR LA MOYENNE
  6. C NON LOCALE
  7. C
  8. C
  9. C Entrees:
  10. C --------
  11. C IPCHCO Pointeur sur un MCHAML de Connectivite
  12. C (ss-type CONNECTIVITE NON LOCAL)
  13. C IPCHI Pointeur sur un MCHAML de ss-type indifferentt
  14. C IPLMOT Pointeur sur un LISTMOTS de noms de composante
  15. C
  16. C Sorties:
  17. C --------
  18. C IRET=1 ou 0 si OK ou non
  19. C IPCHO pointeur sur le champ moyenne
  20. C NLOC1 pointeur sur l'arbre de calcul
  21. C
  22. C Appele par: NLOCA1
  23. C -----------
  24. C
  25. C Appel a:
  26. C --------
  27. C
  28. C DOUBLO : detection de doublon
  29. C LOADPO : lecture d'un point (pointeur --> x(3))
  30. C ELQUOI, IDENT, KOMCHA, COPIE8, DTCHEL
  31. C
  32. C P.PEGON 9/11/92
  33. C_______________________________________________________________________
  34. C
  35. IMPLICIT INTEGER(I-N)
  36. IMPLICIT REAL*8(A-H,O-Z)
  37. LOGICAL LMASS,LCARA
  38. *
  39. -INC CCOPTIO
  40. -INC SMCHAML
  41. -INC SMELEME
  42. -INC SMMODEL
  43. -INC SMLMOTS
  44. -INC SMINTE
  45. CHARACTER*(LCONMO) CONM
  46. *
  47. SEGMENT INFO
  48. INTEGER INFELL(JG)
  49. ENDSEGMENT
  50. *
  51. SEGMENT NOTYPE
  52. CHARACTER*16 TYPE (NBTYPE)
  53. ENDSEGMENT
  54. *
  55. SEGMENT MPTVAL
  56. INTEGER IPOS(NS) ,NSOF(NS)
  57. INTEGER IVAL(NCOSOU)
  58. CHARACTER*16 TYVAL(NCOSOU)
  59. ENDSEGMENT
  60. *
  61. SEGMENT WRK0
  62. INTEGER IRAGNT(NSOUCO),IDUMMM(2,NSOUCO),IDUPLI(NSOUCO)
  63. END SEGMENT
  64. *
  65. SEGMENT NLOC1
  66. INTEGER ILOC2 (NZONEF)
  67. END SEGMENT
  68. *
  69. SEGMENT NLOC2
  70. INTEGER MPCHAM (NDOUBL)
  71. INTEGER ILOC4 (NDOUBL)
  72. INTEGER MODLAC,MAILEF,MINTEF
  73. INTEGER MAILAC (NSZACC)
  74. INTEGER MINTAC (NSZACC)
  75. INTEGER ILOC3 (NSZACC)
  76. INTEGER ILOC3I,ILOC3O
  77. INTEGER MELCAR
  78. END SEGMENT
  79. *
  80. SEGMENT NLOC3
  81. INTEGER MELVAC (NCOMP)
  82. END SEGMENT
  83. *
  84. SEGMENT NLOC4
  85. INTEGER JCLE
  86. REAL*8 PT1(3),PT2(3),DISP
  87. INTEGER MELPNI,MELPLI
  88. END SEGMENT
  89. *
  90. PARAMETER ( NINF=3 )
  91. INTEGER INFOS(NINF)
  92. C
  93. PARAMETER(NCLE=5)
  94. CHARACTER*4 MCLE(NCLE)
  95. DATA MCLE/'NORM','TRAN','POIN','DROI','PLAN'/
  96. C
  97. C
  98. C ACTIVATION DU CHAMP DE CONNECTIVITE
  99. C
  100. MCHELM=IPCHCO
  101. SEGACT,MCHELM
  102. NSOUCO=ICHAML(/1)
  103. SEGINI,WRK0
  104. C
  105. C ACTIVATION DES SOUS-ZONES (MCHAML)
  106. C
  107. DO ISOUCO=1,NSOUCO
  108. MCHAML=ICHAML(ISOUCO)
  109. SEGACT,MCHAML
  110. END DO
  111. C
  112. C ON ETABLIT LA LISTE DES MAILLAGES
  113. C ACTIVATION DU SECOND MELVAL DU CHAMP DE CONNECTIVITE
  114. C QUI EST LE MODELE ASSOCIE AU SS-ZONES ACCESSIBLE
  115. C ON ETABLIT LA LISTE DE CES MODELES
  116. C ON DESACTIVE LE MELVAL
  117. C
  118. DO ISOUCO=1,NSOUCO
  119. IDUMMM(1,ISOUCO)=IMACHE(ISOUCO)
  120. MCHAML=ICHAML(ISOUCO)
  121. IRAGNT(ISOUCO)=ISOUCO
  122. NCOMP=IELVAL(/1)
  123. IF(NCOMP.LT.4.OR.NCOMP.GT.6)THEN
  124. CALL ERREUR(734)
  125. SEGSUP,WRK0
  126. GOTO 9999
  127. ENDIF
  128. IF(NOMCHE(2).NE.'PMOD')THEN
  129. MOTERR(1:4)='PMOD'
  130. CALL ERREUR(734)
  131. SEGSUP,WRK0
  132. GOTO 9999
  133. ENDIF
  134. IF(TYPCHE(2).NE.'POINTEURMMODEL')THEN
  135. MOTERR(1:4)='PMOD'
  136. MOTERR(5:12)='MODEL '
  137. CALL ERREUR(736)
  138. SEGSUP,WRK0
  139. GOTO 9999
  140. ENDIF
  141. MELVAL=IELVAL(2)
  142. SEGACT,MELVAL
  143. IDUMMM(2,ISOUCO)=IELCHE(1,1)
  144. SEGDES,MELVAL
  145. END DO
  146. C
  147. C ON ORDONNE LE TABLEAU IDUMMM EN GARDANT LA TRACE DES PERMUTATIONS
  148. C DANS IRAGNT
  149. C ON DETECTE LES DOUBLONS:
  150. C IDUPLI INDIQUE LE NOMBRE DE DOUBLON PAR ZONE EFFECTIVE
  151. C IDUMMM POINTE SUR LE MAILLAGE/MODELE DE LA ZONE EFFECTIVE
  152. C
  153. CALL DOUBLO(IDUMMM,IRAGNT,2,NSOUCO, NZONEF,IDUPLI)
  154. C
  155. C ON REMPLIT NLOC1 ET PARTIELLEMENT NLOC2
  156. C ON ACTIVE LES MMODEL
  157. C ON ACTIVE LES MAILLAGES EFFECTIFS
  158. C ON SUPRIME WRK0
  159. C
  160. J=0
  161. NSZACC=0
  162. SEGINI,NLOC1
  163. DO ISOUCF=1,NZONEF
  164. NDOUBL=IDUPLI(ISOUCF)
  165. SEGINI,NLOC2
  166. ILOC2(ISOUCF)=NLOC2
  167. MMODEL=IDUMMM(2,ISOUCF)
  168. MODLAC=MMODEL
  169. SEGACT,MMODEL
  170. DO IDOUBL=1,NDOUBL
  171. J=J+1
  172. MPCHAM(IDOUBL)=IRAGNT(J)
  173. ILOC4 (IDOUBL)=0
  174. END DO
  175. MELEME=IDUMMM(1,ISOUCF)
  176. MAILEF=MELEME
  177. SEGACT,MELEME
  178. END DO
  179. SEGSUP,WRK0
  180. C
  181. C ON ACTIVES LES IMODEL ET ON CONTINUE DE REMPLIR NLOC2
  182. C (MAILLAGE ET MINTE)
  183. C IL FAUT ACTIVER LE MINTE !!!!
  184. C ON VERIFIE AU PASSAGE QUE LA FORMULATION DU MODELE EST
  185. C BIEN MASSIVE ...
  186. C ... ET QUE SOIT LES LONGUEURS CARACTERISTIQUES SUR UNE MEME
  187. C SOUS-ZONE EFFECTIVE SONT IDENTIQUE OU QUE LE MELVAL DE LONGUEUR
  188. C CARACTERISTIQUE EST LE MEME. POUR CELA ON ACTIVE
  189. C ET ON DESACTIVE LE PREMIER MELVAL DU CHAMP DE CONNECTIVITE
  190. C
  191. C
  192. LMASS=.TRUE.
  193. LCARA=.TRUE.
  194. DO ISOUCF=1,NZONEF
  195. C
  196. NLOC2=ILOC2(ISOUCF)
  197. ILOC3I=0
  198. ILOC3O=0
  199. MMODEL=MODLAC
  200. NSZACC=KMODEL(/1)
  201. * PP 15/6/93
  202. NDOUBL=MPCHAM(/1)
  203. SEGADJ,NLOC2
  204. DO ISZACC=1,NSZACC
  205. IMODEL=KMODEL(ISZACC)
  206. SEGACT,IMODEL
  207. MELE=NEFMOD
  208. MFR=NUMMFR (MELE)
  209. IF (MFR .NE. 1) THEN
  210. CALL ERREUR(737)
  211. LMASS=.FALSE.
  212. ENDIF
  213. MAILAC(ISZACC)=IMAMOD
  214. if(infmod(/1).lt.7) then
  215. CALL ELQUOI (MELE,0,5,INFO,IMODEL)
  216. MINTAC(ISZACC)=INFELL(11)
  217. MINTE=INFELL(11)
  218. SEGSUP,INFO
  219. else
  220. minte=infmod(7)
  221. MINTAC(ISZACC)=minte
  222. endif
  223. SEGACT,MINTE
  224.  
  225. ILOC3 (ISZACC)=0
  226. *
  227. END DO
  228. C
  229. ICHAMC=MPCHAM(1)
  230. MCHAML=ICHAML(ICHAMC)
  231. IF(NOMCHE(1).NE.'NLAR')THEN
  232. MOTERR(1:4)='NLAR'
  233. CALL ERREUR(734)
  234. LCARA=.FALSE.
  235. ELSEIF(TYPCHE(1).NE.'REAL*8')THEN
  236. MOTERR(1:4)='NLAR'
  237. MOTERR(5:12)='FLOTTANT'
  238. CALL ERREUR(736)
  239. LCARA=.FALSE.
  240. ENDIF
  241. IF(LCARA)THEN
  242. MELVAL=IELVAL(1)
  243. SEGACT,MELVAL
  244. MELCAR=MELVAL
  245. IF(VELCHE(/1).EQ.1.AND.VELCHE(/2).EQ.1)THEN
  246. XLCAR=VELCHE(1,1)
  247. ELSE
  248. XLCAR=0.D0
  249. ENDIF
  250. SEGDES,MELVAL
  251. NDOUBL=MPCHAM(/1)
  252. C
  253. DO IDOUBL=1,NDOUBL
  254. ICHAMC=MPCHAM(IDOUBL)
  255. MCHAML=ICHAML(ICHAMC)
  256. IF(NOMCHE(1).NE.'NLAR')THEN
  257. MOTERR(1:4)='NLAR'
  258. CALL ERREUR(734)
  259. LCARA=.FALSE.
  260. ELSEIF(TYPCHE(1).NE.'REAL*8')THEN
  261. MOTERR(1:4)='NLAR'
  262. MOTERR(5:12)='FLOTTANT'
  263. CALL ERREUR(736)
  264. LCARA=.FALSE.
  265. ENDIF
  266. IF(LCARA)THEN
  267. MELVAL=IELVAL(1)
  268. IF(XLCAR.EQ.0.D0)THEN
  269. MELVA1=MELCAR
  270. SEGACT,MELVAL,MELVA1
  271. IF(MELVA1.VELCHE(/1).EQ.VELCHE(/1).AND.
  272. > MELVA1.VELCHE(/2).EQ.VELCHE(/2))THEN
  273. XDIFNL=0.D0
  274. XMAXNL=0.D0
  275. DO IB=1,VELCHE(/2)
  276. DO IG=1,VELCHE(/1)
  277. XDIFNL=XDIFNL+
  278. > ABS(MELVA1.VELCHE(IG,IB)-VELCHE(IG,IB))
  279. XMAXNL=MAX(XMAXNL,MELVA1.VELCHE(IG,IB),
  280. > VELCHE(IG,IB))
  281. ENDDO
  282. ENDDO
  283. ELSE
  284. XDIFNL=1
  285. XMAXNL=1
  286. ENDIF
  287. IF(XMAXNL.EQ.0.D0.OR.XDIFNL.GT.XMAXNL*1.D-10)THEN
  288. CALL ERREUR(739)
  289. LCARA=.FALSE.
  290. ENDIF
  291. SEGDES,MELVAL,MELVA1
  292. C
  293. ELSE
  294. SEGACT,MELVAL
  295. IF(XLCAR.NE.VELCHE(1,1))THEN
  296. CALL ERREUR(738)
  297. LCARA=.FALSE.
  298. ENDIF
  299. SEGDES,MELVAL
  300. ENDIF
  301. ENDIF
  302. END DO
  303. ENDIF
  304. END DO
  305. IF(.NOT.LMASS) GOTO 9998
  306. IF(.NOT.LCARA) GOTO 9998
  307. C
  308. C ON CREE UN HEADER DE MCHAML DE CONNECTIVITE SUR LES ZONES
  309. C EFFECTIVES
  310. C ON CREE UN HEADER DE MODELE SUR LES ZONES EFFECTIVES QUI
  311. C REPREND LE IMODEL ASSOCIE A LA ZONE COURANTE
  312. C
  313. L1=TITCHE(/1)
  314. N1=NZONEF
  315. N3=INFCHE(/2)
  316. SEGINI,MCHEL1
  317. MCHEL1.TITCHE=TITCHE
  318. MCHEL1.IFOCHE=IFOCHE
  319. SEGINI,MMODE1
  320. DO ISOUCF=1,NZONEF
  321. NLOC2=ILOC2(ISOUCF)
  322. ICHAMC=MPCHAM(1)
  323. MCHAML=ICHAML(ICHAMC)
  324. IMACHA=IMACHE(ICHAMC)
  325. MCHEL1.IMACHE(ISOUCF)=IMACHA
  326. MCHEL1.ICHAML(ISOUCF)=0
  327. MMODEL=MODLAC
  328. NSZACC=KMODEL(/1)
  329. DO ISZACC=1,NSZACC
  330. IMODEL=KMODEL(ISZACC)
  331. IF (IMAMOD.EQ.IMACHA)GOTO 1
  332. END DO
  333. CALL ERREUR(740)
  334. GOTO 9997
  335. 1 MINTEF=MINTAC(ISZACC)
  336. MMODE1.KMODEL(ISOUCF)=IMODEL
  337. MCHEL1.CONCHE(ISOUCF)=CONMOD
  338. DO J=1,N3
  339. MCHEL1.INFCHE(ISOUCF,J)=INFCHE(ICHAMC,J)
  340. END DO
  341. END DO
  342. C
  343. C PREPARATION NOMID'S POUR LE CHAMP A MOYENNER
  344. C
  345. MLMOTS=IPLMOT
  346. SEGACT,MLMOTS
  347. NBROBL=MOTS(/2)
  348. NBRFAC=0
  349. SEGINI,NOMID
  350. MOMOTS=NOMID
  351. DO IE1=1,NBROBL
  352. LESOBL(IE1)=MOTS(IE1)
  353. END DO
  354. SEGDES,MLMOTS
  355. NMOTS=NBROBL+NBRFAC
  356. C
  357. C PREPARATION NOTYPE'S POUR LE CHAMP A MOYENNER
  358. C
  359. NBTYPE=1
  360. SEGINI,NOTYPE
  361. TYPE(1)='REAL*8'
  362. C
  363. C ON VERIFIE LA COMPATIBILITE DES SUPPORTS GEOMETRIQUES ET
  364. C QUE CES COMPOSANTES EXISTENT SUR TOUTES LES
  365. C ZONE EFFECTIVES
  366. C
  367. MMODEL=MMODE1
  368. DO ISOUCF=1,NZONEF
  369. NLOC2=ILOC2(ISOUCF)
  370. IMODEL=KMODEL(ISOUCF)
  371. CONM=CONMOD
  372. IPMAIL=IMAMOD
  373. CALL IDENT(IPMAIL,CONM,IPCHI,MCHEL1,INFOS,IRTD)
  374. IF(IRTD .NE. 1)THEN
  375. CALL ERREUR(741)
  376. GOTO 9996
  377. ENDIF
  378. CALL KOMCHA(IPCHI,IPMAIL,CONM,MOMOTS,NOTYPE,1,
  379. > INFOS,3,IVAMOT)
  380. IF (IERR .NE. 0) THEN
  381. CALL ERREUR(742)
  382. GOTO 9996
  383. ENDIF
  384. MPTVAL=IVAMOT
  385. NCOMP=IVAL(/1)
  386. SEGINI,NLOC3
  387. ILOC3I=NLOC3
  388. DO ICOMP=1,NCOMP
  389. MELVAC(ICOMP)=IVAL(ICOMP)
  390. END DO
  391. SEGSUP,MPTVAL
  392. END DO
  393. C
  394. C ON VERIFIE QUE LES MINTE EXISTENT ET QU'ILS SONT AUX PT DE GAUSS
  395. C POUR LE CHAMP A MOYENNER
  396. C
  397. MCHEL2=IPCHI
  398. SEGACT,MCHEL2
  399. DO ISOUCF=1,NZONEF
  400. IMODEL=KMODEL(ISOUCF)
  401. CONM=CONMOD
  402. IPMAIL=IMAMOD
  403. DO J=1,MCHEL2.CONCHE(/2)
  404. IF((MCHEL2.CONCHE(J).EQ.CONM)
  405. > .AND.(MCHEL2.IMACHE(J).EQ.IPMAIL))THEN
  406. IF((MCHEL2.INFCHE(J,4).EQ.0)
  407. > .OR.(MCHEL2.INFCHE(J,6).NE.5))THEN
  408. CALL ERREUR(745)
  409. GOTO 9996
  410. ENDIF
  411. ENDIF
  412. END DO
  413. END DO
  414. SEGDES,MCHEL2
  415. C
  416. C ON CONTINUE LA VERIFICATION DU MCHELM DES
  417. C CONNECTIVITES
  418. C ON CONTINUE DE REMPLIR NLOC2 ET ON CREE ET REMPLIT LES NLOC4
  419. C PAR OUVERTURE/FERMETURE DE MELVAL
  420. C
  421. DO ISOUCF=1,NZONEF
  422. NLOC2=ILOC2(ISOUCF)
  423. NDOUBL=MPCHAM(/1)
  424. DO IDOUBL=1,NDOUBL
  425. ICHAMC=MPCHAM(IDOUBL)
  426. CONM=CONCHE(ICHAMC)
  427. SEGINI,NLOC4
  428. ILOC4(IDOUBL)=NLOC4
  429. DO ICLE=1,NCLE
  430. IF(CONM(13:16) .EQ. MCLE(ICLE))GOTO 2
  431. END DO
  432. CALL ERREUR(746)
  433. GOTO 9996
  434. 2 JCLE=ICLE
  435. MCHAML=ICHAML(ICHAMC)
  436. NCOMP=IELVAL(/1)
  437. GOTO (11,12,13,14,15),ICLE
  438. C NORM
  439. 11 CONTINUE
  440. IF(NCOMP.NE.4)GOTO 16
  441. GOTO 17
  442. C TRAN
  443. 12 CONTINUE
  444. IF(NCOMP.NE.5)GOTO 16
  445. IF (NOMCHE(5).NE.'POT1')THEN
  446. MOTERR(1:4)='POT1'
  447. MOTERR(13:16)='TRAN'
  448. CALL ERREUR(743)
  449. GOTO 9996
  450. ENDIF
  451. IF (TYPCHE(5).NE.'POINTEURPOINT ')THEN
  452. MOTERR(1:4)='POT1'
  453. MOTERR(5:12)='POINT '
  454. MOTERR(13:16)='TRAN'
  455. CALL ERREUR(744)
  456. GOTO 9996
  457. ENDIF
  458. MELVAL=IELVAL(5)
  459. SEGACT,MELVAL
  460. JPT1=IELCHE(1,1)
  461. SEGDES,MELVAL
  462. CALL LOADPO(JPT1,PT1)
  463. GOTO 17
  464. C POIN
  465. 13 CONTINUE
  466. IF(NCOMP.NE.5)GOTO 16
  467. IF (NOMCHE(5).NE.'POT1')THEN
  468. MOTERR(1:4)='POT1'
  469. MOTERR(13:16)='POIN'
  470. CALL ERREUR(743)
  471. GOTO 9996
  472. ENDIF
  473. IF (TYPCHE(5).NE.'POINTEURPOINT ')THEN
  474. MOTERR(1:4)='POT1'
  475. MOTERR(5:12)='POINT '
  476. MOTERR(13:16)='POIN'
  477. CALL ERREUR(744)
  478. GOTO 9996
  479. ENDIF
  480. MELVAL=IELVAL(5)
  481. SEGACT,MELVAL
  482. JPT1=IELCHE(1,1)
  483. SEGDES,MELVAL
  484. CALL LOADPO(JPT1,PT1)
  485. GOTO 17
  486. C DROI
  487. 14 CONTINUE
  488. IF(NCOMP.NE.6)GOTO 16
  489. IF (NOMCHE(5).NE.'POT1')THEN
  490. MOTERR(1:4)='POT1'
  491. MOTERR(13:16)='DROI'
  492. CALL ERREUR(743)
  493. GOTO 9996
  494. ENDIF
  495. IF (TYPCHE(5).NE.'POINTEURPOINT ')THEN
  496. MOTERR(1:4)='POT1'
  497. MOTERR(5:12)='POINT '
  498. MOTERR(13:16)='DROI'
  499. CALL ERREUR(744)
  500. GOTO 9996
  501. ENDIF
  502. MELVAL=IELVAL(5)
  503. SEGACT,MELVAL
  504. JPT1=IELCHE(1,1)
  505. SEGDES,MELVAL
  506. CALL LOADPO(JPT1,PT1)
  507. IF (NOMCHE(6).NE.'POT2')THEN
  508. MOTERR(1:4)='POT2'
  509. MOTERR(13:16)='DROI'
  510. CALL ERREUR(743)
  511. GOTO 9996
  512. ENDIF
  513. IF (TYPCHE(6).NE.'POINTEURPOINT ')THEN
  514. MOTERR(1:4)='POT2'
  515. MOTERR(5:12)='POINT '
  516. MOTERR(13:16)='DROI'
  517. CALL ERREUR(744)
  518. GOTO 9996
  519. ENDIF
  520. MELVAL=IELVAL(6)
  521. SEGACT,MELVAL
  522. JPT2=IELCHE(1,1)
  523. SEGDES,MELVAL
  524. CALL LOADPO(JPT2,PT2)
  525. GOTO 17
  526. C PLAN
  527. 15 CONTINUE
  528. IF(NCOMP.NE.6)GOTO 16
  529. IF (NOMCHE(5).NE.'POT1')THEN
  530. MOTERR(1:4)='POT1'
  531. MOTERR(13:16)='PLAN'
  532. CALL ERREUR(743)
  533. GOTO 9996
  534. ENDIF
  535. IF (TYPCHE(5).NE.'POINTEURPOINT ')THEN
  536. MOTERR(1:4)='POT1'
  537. MOTERR(5:12)='POINT '
  538. MOTERR(13:16)='PLAN'
  539. CALL ERREUR(744)
  540. GOTO 9996
  541. ENDIF
  542. MELVAL=IELVAL(5)
  543. SEGACT,MELVAL
  544. JPT1=IELCHE(1,1)
  545. SEGDES,MELVAL
  546. CALL LOADPO(JPT1,PT1)
  547. IF (NOMCHE(6).NE.'DISP')THEN
  548. MOTERR(1:4)='DISP'
  549. MOTERR(13:16)='PLAN'
  550. CALL ERREUR(743)
  551. GOTO 9996
  552. ENDIF
  553. IF (TYPCHE(6).NE.'REAL*8')THEN
  554. MOTERR(1:4)='DISP'
  555. MOTERR(5:12)='FLOTTANT'
  556. MOTERR(13:16)='PLAN'
  557. CALL ERREUR(744)
  558. GOTO 9996
  559. ENDIF
  560. MELVAL=IELVAL(6)
  561. SEGACT,MELVAL
  562. DISP=VELCHE(1,1)
  563. SEGDES,MELVAL
  564. GOTO 17
  565. C
  566. 16 CONTINUE
  567. CALL ERREUR(734)
  568. GOTO 9996
  569. C
  570. 17 CONTINUE
  571. IF (NOMCHE(3).NE.'NPNI')THEN
  572. MOTERR(1:4)='NPNI'
  573. CALL ERREUR(734)
  574. GOTO 9996
  575. ENDIF
  576. IF (TYPCHE(3).NE.'POINTEURLISTENTI')THEN
  577. MOTERR(1:4)='NPNI'
  578. MOTERR(5:12)='LISTENTI'
  579. CALL ERREUR(736)
  580. GOTO 9996
  581. ENDIF
  582. MELPNI=IELVAL(3)
  583. IF (NOMCHE(4).NE.'NPLI')THEN
  584. MOTERR(1:4)='NPLI'
  585. CALL ERREUR(734)
  586. GOTO 9996
  587. ENDIF
  588. IF (TYPCHE(4).NE.'POINTEURLISTENTI')THEN
  589. MOTERR(1:4)='NPLI'
  590. MOTERR(5:12)='LISTENTI'
  591. CALL ERREUR(736)
  592. GOTO 9996
  593. ENDIF
  594. MELPLI=IELVAL(4)
  595. END DO
  596. END DO
  597. C
  598. C ON VERIFIE QUE SUR CHAQUE SS-ZONE EFFECTIVE ON A UN ICLE=1 ET
  599. C UN SEUL
  600. C
  601. DO ISOUCF=1,NZONEF
  602. NLOC2=ILOC2(ISOUCF)
  603. NDOUBL=ILOC4(/1)
  604. KCLE=0
  605. DO IDOUBL=1,NDOUBL
  606. NLOC4=ILOC4(IDOUBL)
  607. IF(JCLE.EQ.1)KCLE=KCLE+1
  608. END DO
  609. IF(KCLE.EQ.0)THEN
  610. CALL ERREUR(747)
  611. GOTO 9996
  612. ENDIF
  613. IF(KCLE.GT.1)THEN
  614. CALL ERREUR(748)
  615. GOTO 9996
  616. ENDIF
  617. END DO
  618. C
  619. C ON COPIE LE CHAMELEM A MOYENNER
  620. C
  621. CALL COPIE8 (IPCHI,IPCHO)
  622. C
  623. C ON FINIT DE REMPLIR NLOC2 ET ON CREE ET REMPLIT LES NLOC3
  624. C LES MELVAL RESULTATS DE MOYENNE CONSTANT SONT SEGADJUSTES
  625. C
  626. DO ISOUCF=1,NZONEF
  627. NLOC2=ILOC2(ISOUCF)
  628. C
  629. MMODEL=MODLAC
  630. NSZACC=KMODEL(/1)
  631. DO ISZACC=1,NSZACC
  632. IMODEL=KMODEL(ISZACC)
  633. CONM=CONMOD
  634. IPMAIL=IMAMOD
  635. CALL IDENT(IPMAIL,CONM,IPCHI,MCHEL1,INFOS,IRTD)
  636. CALL KOMCHA(IPCHI,IPMAIL,CONM,MOMOTS,NOTYPE,1,
  637. > INFOS,3,IVAMOT)
  638. MPTVAL=IVAMOT
  639. NCOMP=IVAL(/1)
  640. SEGINI,NLOC3
  641. ILOC3(ISZACC)=NLOC3
  642. DO ICOMP=1,NCOMP
  643. MELVAC(ICOMP)=IVAL(ICOMP)
  644. END DO
  645. SEGSUP,MPTVAL
  646. END DO
  647. C
  648. IMODEL=MMODE1.KMODEL(ISOUCF)
  649. CONM=CONMOD
  650. IPMAIL=IMAMOD
  651. CALL IDENT(IPMAIL,CONM,IPCHO,MCHEL1,INFOS,IRTD)
  652. CALL KOMCHA(IPCHO,IPMAIL,CONM,MOMOTS,NOTYPE,1,
  653. > INFOS,3,IVAMOT)
  654. MPTVAL=IVAMOT
  655. NCOMP=IVAL(/1)
  656. SEGINI,NLOC3
  657. ILOC3O=NLOC3
  658. DO ICOMP=1,NCOMP
  659. MELVAC(ICOMP)=IVAL(ICOMP)
  660. END DO
  661. SEGSUP,MPTVAL
  662. C
  663. IPT1=IPMAIL
  664. N1EL=IPT1.NUM(/2)
  665. MINTE=MINTEF
  666. N1PTEL=POIGAU(/1)
  667. DO ICOMP=1,NCOMP
  668. MELVAL=MELVAC(ICOMP)
  669. C SI LE CHAMP N"EST PAS DANS SES BORNES ...
  670. IF((VELCHE(/1).NE.N1PTEL).OR.(VELCHE(/2).NE.N1EL))THEN
  671. C ... IL EST CONSTANT
  672. IF((VELCHE(/1).EQ.1).AND.(VELCHE(/2).EQ.1))THEN
  673. * PP 15/6/93
  674. N2PTEL=IELCHE(/1)
  675. N2EL=IELCHE(/2)
  676. SEGADJ,MELVAL
  677. XELCHE=VELCHE(1,1)
  678. DO I1EL=1,N1EL
  679. DO I1PTEL=1,N1PTEL
  680. VELCHE(I1PTEL,I1EL)=XELCHE
  681. END DO
  682. END DO
  683. C ... OU IL EST CONSTANT PAR ELEMENT
  684. ELSE IF (VELCHE(/1).EQ.1)THEN
  685. IF(VELCHE(/2).NE.N1EL)THEN
  686. CALL ERREUR(749)
  687. GOTO 9995
  688. ENDIF
  689. * PP 15/6/93
  690. N2PTEL=IELCHE(/1)
  691. N2EL=IELCHE(/2)
  692. SEGADJ MELVAL
  693. DO I1EL=1,N1EL
  694. XELCHE=VELCHE(1,I1EL)
  695. DO I1PTEL=1,N1PTEL
  696. VELCHE(I1PTEL,I1EL)=XELCHE
  697. END DO
  698. END DO
  699. C ... OU IL EST ERRONE
  700. ELSE
  701. CALL ERREUR(750)
  702. GOTO 9995
  703. ENDIF
  704. ENDIF
  705. END DO
  706. END DO
  707. C
  708. C ON ACTIVE LES MELVAL DE CONNECTIVITE
  709. C
  710. DO ISOUCF=1,NZONEF
  711. NLOC2=ILOC2 (ISOUCF)
  712. MELVAL=MELCAR
  713. SEGACT,MELVAL
  714. NDOUBL=ILOC4(/1)
  715. DO IDOUBL=1,NDOUBL
  716. NLOC4=ILOC4(IDOUBL)
  717. MELVAL=MELPNI
  718. SEGACT,MELVAL
  719. MELVAL=MELPLI
  720. SEGACT,MELVAL
  721. END DO
  722. END DO
  723. C
  724. C ON DESACTIVE LE MCHELM,MCHAML DE CONNECTIVITE
  725. C
  726. DO ISOUCO=1,NSOUCO
  727. MCHAML=ICHAML(ISOUCO)
  728. SEGDES,MCHAML
  729. END DO
  730. SEGDES,MCHELM
  731. C
  732. C ON SORT (SANS ERREUR ???)
  733. C
  734. NOMID=MOMOTS
  735. SEGSUP,NOMID,NOTYPE
  736. SEGSUP,MCHEL1
  737. SEGSUP,MMODE1
  738. IRET=1
  739. RETURN
  740. C
  741. C TRAITEMENT DES ERREURS
  742. C
  743. 9995 CONTINUE
  744. CALL DTCHEL(IPCHO)
  745. 9996 CONTINUE
  746. DO ISOUCF=1,NZONEF
  747. NLOC2=ILOC2 (ISOUCF)
  748. NDOUBL=ILOC4(/1)
  749. DO IDOUBL=1,NDOUBL
  750. IF(ILOC4(IDOUBL).NE.0)THEN
  751. NLOC4=ILOC4(IDOUBL)
  752. SEGSUP,NLOC4
  753. ENDIF
  754. END DO
  755. NSZACC=ILOC3(/1)
  756. DO ISZACC=1,NSZACC
  757. IF(ILOC3(ISZACC).NE.0)THEN
  758. NLOC3=ILOC3(ISZACC)
  759. SEGSUP,NLOC3
  760. END IF
  761. END DO
  762. IF (ILOC3O.NE.0)THEN
  763. NLOC3=ILOC3O
  764. SEGSUP,NLOC3
  765. END IF
  766. IF (ILOC3I.NE.0)THEN
  767. NLOC3=ILOC3I
  768. NCOMP=MELVAC(/1)
  769. DO ICOMP=1,NCOMP
  770. MELVAL=MELVAC (ICOMP)
  771. SEGDES,MELVAL
  772. END DO
  773. SEGSUP,NLOC3
  774. ENDIF
  775. END DO
  776. 9997 CONTINUE
  777. NOMID=MOMOTS
  778. SEGSUP,NOMID,NOTYPE
  779. SEGSUP,MCHEL1
  780. SEGSUP,MMODE1
  781. 9998 CONTINUE
  782. DO ISOUCF=1,NZONEF
  783. NLOC2=ILOC2 (ISOUCF)
  784. MELEME=MAILEF
  785. MMODEL=MODLAC
  786. NSZACC=KMODEL(/1)
  787. DO ISZACC=1,NSZACC
  788. MINTE=MINTAC(ISZACC)
  789. SEGDES,MINTE
  790. IMODEL=KMODEL(ISZACC)
  791. SEGDES,IMODEL
  792. END DO
  793. SEGDES,MELEME
  794. END DO
  795. DO ISOUCF=1,NZONEF
  796. NLOC2=ILOC2 (ISOUCF)
  797. MMODEL=MODLAC
  798. SEGDES,MMODEL
  799. SEGSUP,NLOC2
  800. END DO
  801. SEGSUP,NLOC1
  802. 9999 CONTINUE
  803. DO ISOUCO=1,NSOUCO
  804. MCHAML=ICHAML(ISOUCO)
  805. SEGDES,MCHAML
  806. END DO
  807. SEGDES,MCHELM
  808. C
  809. IRET=0
  810. RETURN
  811. END
  812.  
  813.  
  814.  
  815.  
  816.  
  817.  
  818.  
  819.  
  820.  
  821.  
  822.  
  823.  
  824.  
  825.  
  826.  
  827.  

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