Télécharger etmchl.eso

Retour à la liste

Numérotation des lignes :

  1. C ETMCHL SOURCE CB215821 19/08/20 21:17:14 10287
  2. SUBROUTINE ETMCHL(MCHEL1,MCHEL2,IRECHE)
  3.  
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8(A-H,O-Z)
  6.  
  7. -INC CCOPTIO
  8. -INC CCREEL
  9. -INC SMCHAML
  10.  
  11.  
  12. CHARACTER*(NCONCH) CONCH1,CONCH2
  13. CHARACTER*8 NOMCH1,NOMCH2,nop1,nop2,CHA8
  14. CHARACTER*16 TYPCH1,TYPCH2
  15. CHARACTER*72 SOUTY1,SOUTY2
  16.  
  17. SEGMENT ISEG(0)
  18.  
  19. SEGMENT IZR1(N11)
  20. C IZR1(:) : MCHAM1 si pas de correspondance dans MCHEL2
  21. C -N2 du MCHAML resultat sinon
  22. SEGMENT IZR2(2,N12)
  23. C IZR2(1,:) : POINTEUR MCHAML si correspondance, entier negatif sinon
  24. C IZR2(2,:) : Numero de SOUS-ZONE dans le MCHELM resultat
  25.  
  26. SEGMENT ICORE2(2,N22M,N12)
  27. C ICORE2(1,:,:) : POINTEUR MELVAL si correspondance, entier negatif sinon
  28. C ICORE2(2,:,:) : Numero de COMPOSANTE dans le MCHAML resultat
  29.  
  30. C Cas ultra rapide : Meme POINTEURS MCHELM
  31. IF(MCHEL1 .EQ. MCHEL2)THEN
  32. IRECHE=MCHEL1
  33. RETURN
  34. ENDIF
  35.  
  36. N11=MCHEL1.ICHAML(/1)
  37. N12=MCHEL2.ICHAML(/1)
  38.  
  39. C Cas "VIDES"
  40. IF (N11 .EQ. 0)THEN
  41. IRECHE=MCHEL2
  42. RETURN
  43. ELSEIF(N12 .EQ. 0)THEN
  44. IRECHE=MCHEL1
  45. RETURN
  46. ENDIF
  47.  
  48. C Cas rapide : Memes POINTEURS MCHAML
  49. IF(N11 .EQ. N12)THEN
  50. DO II=1,N11
  51. ima1 = MCHEL1.imache(II)
  52. C inf31 = MCHEL1.infche(II,3)
  53. inf61 = MCHEL1.infche(II,6)
  54. nop1 = MCHEL1.conche(II)(17:24)
  55. CONCH1 = MCHEL1.conche(II)
  56. mcham1 = MCHEL1.ichaml(II)
  57.  
  58. ima2 = MCHEL2.imache(II)
  59. C inf32 = MCHEL2.infche(II,3)
  60. inf62 = MCHEL2.infche(II,6)
  61. nop2 = MCHEL2.conche(II)(17:24)
  62. CONCH2 = MCHEL2.conche(II)
  63. mcham2 = MCHEL2.ichaml(II)
  64. IF( ima1.NE.ima2 .OR. inf61.NE.inf62 .OR. nop1.NE.nop2 .OR.
  65. & CONCH1.NE.CONCH2 .OR. mcham1.NE.mcham2) GOTO 10
  66. ENDDO
  67. IRECHE=MCHEL1
  68. RETURN
  69. ENDIF
  70.  
  71. C Cas lent
  72. 10 CONTINUE
  73.  
  74. N21M=0
  75. DO II=1,N11
  76. MCHAM1=MCHEL1.ICHAML(II)
  77. N21=MCHAM1.IELVAL(/1)
  78. N21M=MAX(N21M,N21)
  79. ENDDO
  80.  
  81. N22M=0
  82. DO II=1,N12
  83. MCHAM2=MCHEL2.ICHAML(II)
  84. N22=MCHAM2.IELVAL(/1)
  85. N22M=MAX(N22M,N22)
  86. ENDDO
  87.  
  88. C Tableau de travail
  89. CALL oooprl(1)
  90. SEGINI,IZR1,IZR2,ICORE2
  91. CALL oooprl(0)
  92.  
  93. C Boucle MCHEL1
  94. DO 100 IN11=1,N11
  95. ima1 = MCHEL1.imache(IN11)
  96. C inf31 = MCHEL1.infche(IN11,3)
  97. inf61 = MCHEL1.infche(IN11,6)
  98. nop1 = MCHEL1.conche(IN11)(17:24)
  99. CONCH1 = MCHEL1.conche(IN11)
  100. mcham1 = MCHEL1.ichaml(IN11)
  101. IZR1(IN11)= mcham1
  102.  
  103. C Boucle MCHEL2
  104. DO 110 IN12=1,N12
  105. mcham2 = MCHEL2.ichaml(IN12)
  106. IZR2(1,IN12)=mcham2
  107. ima2 = MCHEL2.imache(IN12)
  108. IF(ima2 .NE. ima1)GOTO 110
  109. CONCH2 = MCHEL2.conche(IN12)
  110. IF(CONCH2 .NE. CONCH1)GOTO 110
  111. nop2 = MCHEL2.conche(IN12)(17:24)
  112. IF(nop2 .NE. nop1)GOTO 110
  113. C inf32 = MCHEL2.infche(IN12,3)
  114. inf62 = MCHEL2.infche(IN12,6)
  115.  
  116. C Correspondance de IN11 et IN12
  117. N21=MCHAM1.IELVAL(/1)
  118. N22=MCHAM2.IELVAL(/1)
  119.  
  120. IZR1(IN11) = -N21
  121. IZR2(1,IN12)=-IN12
  122. IZR2(2,IN12)= IN11
  123.  
  124. C Boucle MCHAM1
  125. DO 120 IN21=1,N21
  126. NOMCH1=MCHAM1.NOMCHE(IN21)
  127. TYPCH1=MCHAM1.TYPCHE(IN21)
  128. MELVA1=MCHAM1.IELVAL(IN21)
  129. C Boucle MCHAM2
  130. DO 130 IN22=1,N22
  131. NOMCH2=MCHAM2.NOMCHE(IN22)
  132. MELVA2=MCHAM2.IELVAL(IN22)
  133. ICORE2(1,IN22,IN12)=MELVA2
  134. IF(NOMCH2 .NE. NOMCH1)GOTO 130
  135. C Meme composante
  136.  
  137. TYPCH2=MCHAM2.TYPCHE(IN22)
  138. IF(inf62 .NE. inf61)THEN
  139. C Supports differents
  140. moterr(1:4)=NOMCH1(1:4)
  141. call erreur(1010)
  142. return
  143. ENDIF
  144. IF(TYPCH2 .NE. TYPCH1)THEN
  145. C Types differents
  146. moterr(1:4) = NOMCH1(1:4)
  147. moterr(5:21) = TYPCH1
  148. moterr(22:38) = TYPCH2
  149. call erreur(917)
  150. return
  151. ENDIF
  152. C Correspondance des COMPOSANTES IN21 et IN22
  153. ICORE2(1,IN22,IN12)=-IN22
  154. ICORE2(2,IN22,IN12)= 0
  155. IF(MELVA1 .NE. MELVA2)THEN
  156. IF (TYPCH1 .EQ. 'REAL*8 ')THEN
  157. C Teste les valeurs REAL*8
  158. N1PTE1=MELVA1.VELCHE(/1)
  159. N1E1 =MELVA1.VELCHE(/2)
  160. N1PTE2=MELVA2.VELCHE(/1)
  161. N1E2 =MELVA2.VELCHE(/2)
  162. N1PMAX=MAX(N1PTE1,N1PTE2)
  163. N1EMAX=MAX(N1E1 ,N1E2)
  164. DO 131 IEL=1,N1EMAX
  165. N1EM1=MIN(IEL ,N1E1)
  166. N1EM2=MIN(IEL ,N1E2)
  167. DO 132 IPTEL=1,N1PMAX
  168. X1=MELVA1.VELCHE(MIN(IPTEL,N1PTE1),N1EM1)
  169. X2=MELVA2.VELCHE(MIN(IPTEL,N1PTE2),N1EM2)
  170. IF(ABS(X1-X2) .GT. ABS(X1+X2)/2.D6)THEN
  171. interr(1) =IPTEL
  172. interr(2) =IEL
  173. moterr(1:4) =NOMCH1(1:4)
  174. call erreur(918)
  175. return
  176. ENDIF
  177. 132 CONTINUE
  178. 131 CONTINUE
  179.  
  180. ELSE
  181. C Teste les POINTEURS
  182. N2PTE1=MELVA1.IELCHE(/1)
  183. N2E1 =MELVA1.IELCHE(/2)
  184. N2PTE2=MELVA2.IELCHE(/1)
  185. N2E2 =MELVA2.IELCHE(/2)
  186. N2PMAX=MAX(N2PTE1,N2PTE2)
  187. N2EMAX=MAX(N2E1 ,N2E2)
  188. DO 133 IEL=1,N2EMAX
  189. N2EM1=MIN(IEL ,N2E1)
  190. N2EM2=MIN(IEL ,N2E2)
  191. DO 134 IPTEL=1,N2PMAX
  192. IP1=MELVA1.IELCHE(MIN(IPTEL,N2PTE1),N2EM1)
  193. IP2=MELVA2.IELCHE(MIN(IPTEL,N2PTE2),N2EM2)
  194. IF(IP1 .NE. IP2)THEN
  195. interr(1) =IPTEL
  196. interr(2) =IEL
  197. moterr(1:4) =NOMCH1(1:4)
  198. call erreur(918)
  199. return
  200. ENDIF
  201. 134 CONTINUE
  202. 133 CONTINUE
  203. ENDIF
  204. ENDIF
  205. 130 CONTINUE
  206. 120 CONTINUE
  207.  
  208. C On positionne les composantes de MCHAML2 NON CORRESPONDANTES a la suite
  209. N2SUPL=0
  210. DO 135 IN22=1,N22
  211. IF(ICORE2(2,IN22,IN12) .NE. 0) GOTO 135
  212. N2SUPL=N2SUPL+1
  213. ICORE2(2,IN22,IN12)=N21+N2SUPL
  214. 135 CONTINUE
  215. IF(N2SUPL .EQ. 0) THEN
  216. IZR1(IN11) = mcham1
  217. ELSE
  218. IZR1(IN11) =-(N21+N2SUPL)
  219. ENDIF
  220. 110 CONTINUE
  221. 100 CONTINUE
  222.  
  223. C On positionne les sous-zones de MCHEL2 NON CORRESPONDANTES a la suite
  224. N1SUP=0
  225. DO 101 IN12=1,N12
  226. IF(IZR2(2,IN12) .GT. 0) GOTO 101
  227. N1SUP=N1SUP+1
  228. IZR2(2,IN12)=-(N11+N1SUP)
  229. 101 CONTINUE
  230.  
  231. C Creation du resultat
  232. SOUTY1 = MCHEL1.TITCHE
  233. L1 = MCHEL1.TITCHE(/1)
  234. *
  235. CHA8 = SOUTY1(1:8)
  236. IF (CHA8 .EQ. ' ') THEN
  237. CHA8 = MCHEL2.TITCHE(1:8)
  238. IF (CHA8 .NE. ' ') THEN
  239. SOUTY1 = MCHEL2.TITCHE
  240. L1 = MCHEL2.TITCHE(/1)
  241. ENDIF
  242. ELSE
  243. SOUTY2=MCHEL2.TITCHE
  244. IF (SOUTY2 .NE. SOUTY1) THEN
  245. CHA8=MCHEL2.TITCHE(1:8)
  246. IF (CHA8 .NE. ' ') THEN
  247. SOUTY1=' '
  248. L1 =1
  249. ENDIF
  250. ENDIF
  251. ENDIF
  252. L1=MAX(L1,1)
  253.  
  254. N1=N11+N1SUP
  255. N31=MCHEL1.INFCHE(/2)
  256. N32=MCHEL2.INFCHE(/2)
  257. N3=MAX(N31,N32)
  258.  
  259. C Regroupement des SEGINI
  260. CALL oooprl(1)
  261. SEGINI,MCHELM
  262. IRECHE=MCHELM
  263. DO IN11=1,N11
  264. IZR=IZR1(IN11)
  265. IF(IZR .LT. 0)THEN
  266. N2=-IZR
  267. SEGINI,MCHAML
  268. IZR1(IN11)=-MCHAML
  269. ENDIF
  270. ENDDO
  271. CALL oooprl(0)
  272.  
  273. MCHELM.TITCHE=SOUTY1(1:L1)
  274. MCHELM.IFOCHE=ifour
  275.  
  276. C On copie les infos de MCHEL1
  277. DO IN11=1,N11
  278. MCHELM.CONCHE(IN11)=MCHEL1.CONCHE(IN11)
  279. MCHELM.IMACHE(IN11)=MCHEL1.IMACHE(IN11)
  280. IZR=IZR1(IN11)
  281. IF(IZR .GT. 0)THEN
  282. MCHELM.ICHAML(IN11)= IZR
  283.  
  284. ELSE
  285. MCHAML=-IZR
  286. MCHELM.ICHAML(IN11)=MCHAML
  287. MCHAM1=MCHEL1.ichaml(IN11)
  288. N21=MCHAM1.IELVAL(/1)
  289. DO IN21=1,N21
  290. MCHAML.NOMCHE(IN21)=MCHAM1.NOMCHE(IN21)
  291. MCHAML.TYPCHE(IN21)=MCHAM1.TYPCHE(IN21)
  292. MCHAML.IELVAL(IN21)=MCHAM1.IELVAL(IN21)
  293. ENDDO
  294. ENDIF
  295.  
  296. DO IN31=1,N31
  297. MCHELM.INFCHE(IN11,IN31)=MCHEL1.INFCHE(IN11,IN31)
  298. ENDDO
  299. ENDDO
  300.  
  301. C On adjoint les SOUS-ZONES et COMPOSANTES non CORRESPONDANTES de MCHEL2 !
  302. DO 300 IN12=1,N12
  303. IZR=IZR2(2,IN12)
  304. IF(IZR .GT. 0) THEN
  305. C On adjoint les COMPOSANTES supplementaires des MCHAM2 dans les MCHAML resultat
  306. MCHAML=MCHELM.ICHAML(IZR)
  307. MCHAM2=MCHEL2.ichaml(IN12)
  308. N22=MCHAM2.IELVAL(/1)
  309. DO IN22=1,N22
  310. ICR=ICORE2(2,IN22,IN12)
  311. IF(ICR .NE. 0) THEN
  312. MCHAML.NOMCHE(ICR)=MCHAM2.NOMCHE(IN22)
  313. MCHAML.TYPCHE(ICR)=MCHAM2.TYPCHE(IN22)
  314. MCHAML.IELVAL(ICR)=MCHAM2.IELVAL(IN22)
  315. ENDIF
  316. ENDDO
  317.  
  318. ELSE
  319. C On adjoint les SOUS-ZONES non CORRESPONDANTES de MCHEL2
  320. MIZR=-IZR
  321. MCHELM.CONCHE(MIZR)=MCHEL2.CONCHE(IN12)
  322. MCHELM.IMACHE(MIZR)=MCHEL2.IMACHE(IN12)
  323. MCHELM.ICHAML(MIZR)=MCHEL2.ICHAML(IN12)
  324. DO IN32=1,N32
  325. MCHELM.INFCHE(MIZR,IN32)=MCHEL2.INFCHE(IN12,IN32)
  326. ENDDO
  327. ENDIF
  328. 300 CONTINUE
  329.  
  330. SEGSUP,IZR1,IZR2,ICORE2
  331.  
  332. END
  333.  
  334.  
  335.  

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