Télécharger mschp1.eso

Retour à la liste

Numérotation des lignes :

  1. C MSCHP1 SOURCE PV 20/04/28 21:15:16 10593
  2. SUBROUTINE MSCHP1(IPO2,IPO3,X1,IKO,IPO1,ICLE,IRET,ISOM)
  3. C=======================================================================
  4. C ENTREE
  5. C IPO1 = POINTEUR SUR LE PREMIER CHPO
  6. C IPO2 = POINTEUR SUR LE SECOND CHPO
  7. C IPO3 = POINTEUR SUR LE TROISIEME CHPO (OPTION "COMP")
  8. C X1 = VALEUR MIN OU MAX (OPTION "COMP")
  9. C IKO = 0 SI IPO2 PUIS IPO3, 1 SI X1 PUIS IPO2, -1 SI IPO2 PUIS X1
  10. C ICLE = ENTIER CARACTERISANT LE TYPE DE COMPARAISON
  11. C ISOM = 1 SI ON VEUT LA SOMME, 0 SINON
  12. C SORTIE
  13. C IRET = POINTEUR SUR LE CHAMP RESULTAT SI ISOM=0
  14. C IRET = SOMME DES 1 ET DES 0 SI ISOM=1
  15. C=======================================================================
  16. IMPLICIT INTEGER(I-N)
  17. IMPLICIT REAL*8(A-H,O-Z)
  18. -INC SMCHPOI
  19.  
  20. -INC PPARAM
  21. -INC CCOPTIO
  22. -INC SMELEME
  23. -INC SMCOORD
  24.  
  25. SEGMENT/MTRA/(NOPOIN(nbpts))
  26. SEGMENT MTR1
  27. CHARACTER*4 IPCOM(0)
  28. ENDSEGMENT
  29. SEGMENT/MTR4/(IPHAR(0))
  30. SEGMENT/MTR2/(IC2CC(NC2))
  31. SEGMENT MTR3
  32. REAL*8 BB2(NNIN,NNNOE)
  33. ENDSEGMENT
  34. SEGMENT MTR5
  35. REAL*8 BB3(NNIN,NNNOE)
  36. ENDSEGMENT
  37. C
  38. IKOK=IKO
  39. IF (IKOK.EQ.0.AND.IPO3.LE.0) IKOK=-1
  40. C
  41. C ======================================================================
  42. C REMPLISSAGE DE NOPOIN, IPCOM et BB2
  43. C ======================================================================
  44. C
  45. C ----------------------------------
  46. C ON RECUPERE LES INFOS DU CHPOINT 2
  47. C ----------------------------------
  48. MCHPOI=IPO2
  49. NSOUPO=IPCHP(/1)
  50.  
  51. c PREDIMENSIONNEMENT DE IC2CC AU MAX POSSIBLE
  52. NC2=0
  53. DO IA=1,NSOUPO
  54. MSOUPO=IPCHP(IA)
  55. NC2=NC2+NOCOMP(/2)
  56. ENDDO
  57. SEGINI,MTR2
  58.  
  59. c AUTRES INITIALISATIONS
  60. IK=0
  61. KSOM=0
  62. SEGINI,MTRA,MTR1,MTR4
  63.  
  64.  
  65. C BOUCLE SUR LES ZONES DU CHPO 2
  66. C
  67. DO 20 IA=1,NSOUPO
  68.  
  69. MSOUPO=IPCHP(IA)
  70.  
  71. * composantes + harmoniques --> liste locale
  72. NC=NOCOMP(/2)
  73. * boucle sur les composantes de cette zone du chpoint
  74. DO 40 IC=1,NC
  75. NCC=IPCOM(/2)
  76. * boucle sur les composantes deja enregistrees
  77. DO 50 ICC=1,NCC
  78. IF(IPCOM(ICC).NE.NOCOMP(IC)) GO TO 50
  79. IF(IPHAR(ICC).EQ.NOHARM(IC)) GO TO 40
  80. 50 CONTINUE
  81. * nouvelle composante -> on l'enregistre dans la liste complete
  82. IPCOM(**)=NOCOMP(IC)
  83. IPHAR(**)=NOHARM(IC)
  84. NCC=NCC+1
  85. ICC=NCC
  86. IC2CC(IC)=ICC
  87. NC2=MAX(IC,NC2)
  88. 40 CONTINUE
  89.  
  90. * maillage --> numerotation locale NOPOIN
  91. MELEME=IGEOC
  92. NBNN=NUM(/1)
  93. NBELEM=NUM(/2)
  94. DO 30 IB=1,NBELEM
  95. K=NUM(1,IB)
  96. IF(NOPOIN(K).NE.0) GOTO 30
  97. IK=IK+1
  98. NOPOIN(K)=IK
  99. 30 CONTINUE
  100. 20 CONTINUE
  101. SEGADJ,MTR2
  102.  
  103. C ----------------------------------------------
  104. C ON RECUPERE LES INFOS DU CHPOINT 3 (SI BESOIN)
  105. C ----------------------------------------------
  106. IF (IKOK.EQ.0) THEN
  107. MCHPOI=IPO3
  108. NSOUPO=IPCHP(/1)
  109.  
  110. c PREDIMENSIONNEMENT DE IC2CC AU MAX POSSIBLE
  111. DO IA=1,NSOUPO
  112. MSOUPO=IPCHP(IA)
  113. NC2=NC2+NOCOMP(/2)
  114. ENDDO
  115. SEGADJ,MTR2
  116.  
  117. C BOUCLE SUR LES ZONES DU CHPO 2
  118. C
  119. DO 120 IA=1,NSOUPO
  120.  
  121. MSOUPO=IPCHP(IA)
  122.  
  123. * composantes + harmoniques --> liste locale
  124. NC=NOCOMP(/2)
  125. * boucle sur les composantes de cette zone du chpoint
  126. DO 140 IC=1,NC
  127. NCC=IPCOM(/2)
  128. * boucle sur les composantes deja enregistrees
  129. DO 150 ICC=1,NCC
  130. IF(IPCOM(ICC).NE.NOCOMP(IC)) GOTO 150
  131. IF(IPHAR(ICC).EQ.NOHARM(IC)) GOTO 140
  132. 150 CONTINUE
  133. * nouvelle composante -> on l'enregistre dans la liste complete
  134. IPCOM(**)=NOCOMP(IC)
  135. IPHAR(**)=NOHARM(IC)
  136. NCC=NCC+1
  137. ICC=NCC
  138. IC2CC(IC)=ICC
  139. NC2=MAX(IC,NC2)
  140. 140 CONTINUE
  141.  
  142. * maillage --> numerotation locale NOPOIN
  143. MELEME=IGEOC
  144. NBNN=NUM(/1)
  145. NBELEM=NUM(/2)
  146. DO 130 IB=1,NBELEM
  147. K=NUM(1,IB)
  148. IF(NOPOIN(K).NE.0) GOTO 130
  149. IK=IK+1
  150. NOPOIN(K)=IK
  151. 130 CONTINUE
  152. 120 CONTINUE
  153. SEGADJ,MTR2
  154. ENDIF
  155.  
  156. C -----------------------------------------------------
  157. C CREATION ET REMPLISSAGE DE BB2 = VALEURS DU CHPOINT 2
  158. C -----------------------------------------------------
  159.  
  160. MCHPOI=IPO2
  161. NSOUPO=IPCHP(/1)
  162. NNIN=NC2
  163. NNNOE=IK
  164. SEGINI,MTR3
  165. DO 21 IA=1,NSOUPO
  166.  
  167. MSOUPO=IPCHP(IA)
  168.  
  169. * maillage ET valeur
  170. MPOVA2=IPOVAL
  171. MELEME=IGEOC
  172. NBNN=NUM(/1)
  173. NBELEM=NUM(/2)
  174. DO 31 IB=1,NBELEM
  175. K=NUM(1,IB)
  176. IK=NOPOIN(K)
  177. * on en profite pour enregistrer les valeurs du chpo 2
  178. * --> stockee dans tableau local BB2
  179. DO 32 IC=1,NC
  180. ICC=IC2CC(IC)
  181. BB2(ICC,IK)=MPOVA2.VPOCHA(IB,IC)
  182. 32 CONTINUE
  183. 31 CONTINUE
  184. 21 CONTINUE
  185.  
  186. C -----------------------------------------------------------------
  187. C CREATION ET REMPLISSAGE DE BB3 = VALEURS DU CHPOINT 3 (SI BESOIN)
  188. C -----------------------------------------------------------------
  189.  
  190. IF (IKOK.EQ.0) THEN
  191. MCHPOI=IPO3
  192. NSOUPO=IPCHP(/1)
  193. NNIN=NC2
  194. NNNOE=IK
  195. SEGINI,MTR5
  196. DO 121 IA=1,NSOUPO
  197. MSOUPO=IPCHP(IA)
  198.  
  199. * maillage ET valeur
  200. MPOVA2=IPOVAL
  201. MELEME=IGEOC
  202. NBNN=NUM(/1)
  203. NBELEM=NUM(/2)
  204. DO 131 IB=1,NBELEM
  205. K=NUM(1,IB)
  206. IK=NOPOIN(K)
  207. * on en profite pour enregistrer les valeurs du chpo 2
  208. * --> stockee dans tableau local BB2
  209. DO 132 IC=1,NC
  210. ICC=IC2CC(IC)
  211. BB3(ICC,IK)=MPOVA2.VPOCHA(IB,IC)
  212. 132 CONTINUE
  213. 131 CONTINUE
  214. 121 CONTINUE
  215. ENDIF
  216.  
  217.  
  218. C ======================================================================
  219. C CREATION DU CHPOINT RESULTAT DEPUIS LE 1ER CHPOINT
  220. C ======================================================================
  221. C
  222. MCHPO1=IPO1
  223. SEGINI,MCHPOI=MCHPO1
  224. ICHPOI=MCHPOI
  225. MOCHDE='CHPOINT CREE PAR MASQ'
  226.  
  227. NSOUPO=IPCHP(/1)
  228. C BOUCLE SUR LES ZONES
  229. DO 60 IA=1,NSOUPO
  230.  
  231. MSOUP1=IPCHP(IA)
  232. SEGINI,MSOUPO=MSOUP1
  233. IPCHP(IA)=MSOUPO
  234. NC=NOCOMP(/2)
  235. MPOVA1=IPOVAL
  236. SEGINI,MPOVAL=MPOVA1
  237. IPOVAL=MPOVAL
  238. MELEME=IGEOC
  239. NBELEM=NUM(/2)
  240.  
  241. C BOUCLE SUR LES COMPOSANTES
  242. DO 70 IC=1,NC
  243.  
  244. C recherche dans la liste cree depuis le 2eme chpoint
  245. DO 71 ICC=1,IPCOM(/2)
  246. IF(IPCOM(ICC).NE.NOCOMP(IC)) GOTO 71
  247. IF(IPHAR(ICC).EQ.NOHARM(IC)) GOTO 72
  248. 71 CONTINUE
  249. c on n'a pas trouve de composantes adequates <=> ICC=0
  250. ICC=0
  251. 72 CONTINUE
  252. c on a trouve ICC
  253.  
  254. c BOUCLE SUR LES NOEUDS (le maillage reste le meme que 1er CHPOINT)
  255. DO 80 IB=1,NBELEM
  256.  
  257. K=NUM(1,IB)
  258. IK=NOPOIN(K)
  259. c si ik=0 OU ICC=0, le point OU la composante n'existe pas
  260. c dans les autres chpoints ==> x2=x3=0 par convention
  261. IF (ICC.EQ.0.OR.IK.EQ.0) THEN
  262. IF (IKOK.EQ.0) THEN
  263. X2=0.D0
  264. X3=0.D0
  265. ELSEIF (IKOK.GT.0) THEN
  266. X2=X1
  267. X3=0.D0
  268. ELSE
  269. X2=0.D0
  270. X3=X1
  271. ENDIF
  272. ELSE
  273. IF (IKOK.EQ.0) THEN
  274. X2=BB2(ICC,IK)
  275. X3=BB3(ICC,IK)
  276. ELSEIF (IKOK.GT.0) THEN
  277. X2=X1
  278. X3=BB2(ICC,IK)
  279. ELSE
  280. X2=BB2(ICC,IK)
  281. X3=X1
  282. ENDIF
  283. ENDIF
  284. *
  285. C COMPARAISON PROPREMENT DITE
  286. *
  287. * -----------------------------------------
  288. * SOIT ON VEUT UN MASQUE POINT PAR POINT...
  289. * -----------------------------------------
  290. *
  291. IF (ISOM.EQ.0) THEN
  292. *
  293. * MOT-CLE "SUPE"
  294. IF (ICLE.EQ.1) THEN
  295. IF (VPOCHA(IB,IC).GT.X2) THEN
  296. VPOCHA(IB,IC)=1.D0
  297. ELSE
  298. VPOCHA(IB,IC)=0.D0
  299. ENDIF
  300. *
  301. * MOT-CLE "EGSU"
  302. ELSEIF (ICLE.EQ.2) THEN
  303. IF (VPOCHA(IB,IC).GE.X2) THEN
  304. VPOCHA(IB,IC)=1.D0
  305. ELSE
  306. VPOCHA(IB,IC)=0.D0
  307. ENDIF
  308. *
  309. * MOT-CLE "EGAL"
  310. ELSEIF (ICLE.EQ.3) THEN
  311. IF (VPOCHA(IB,IC).EQ.X2) THEN
  312. VPOCHA(IB,IC)=1.D0
  313. ELSE
  314. VPOCHA(IB,IC)=0.D0
  315. ENDIF
  316. *
  317. * MOT-CLE "EGIN"
  318. ELSEIF (ICLE.EQ.4) THEN
  319. IF (VPOCHA(IB,IC).LE.X2) THEN
  320. VPOCHA(IB,IC)=1.D0
  321. ELSE
  322. VPOCHA(IB,IC)=0.D0
  323. ENDIF
  324. *
  325. * MOT-CLE "INFE"
  326. ELSEIF (ICLE.EQ.5) THEN
  327. IF (VPOCHA(IB,IC).LT.X2) THEN
  328. VPOCHA(IB,IC)=1.D0
  329. ELSE
  330. VPOCHA(IB,IC)=0.D0
  331. ENDIF
  332. *
  333. * MOT-CLE "DIFF"
  334. ELSEIF (ICLE.EQ.6) THEN
  335. IF (VPOCHA(IB,IC).NE.X2) THEN
  336. VPOCHA(IB,IC)=1.D0
  337. ELSE
  338. VPOCHA(IB,IC)=0.D0
  339. ENDIF
  340. *
  341. * MOT-CLE "COMP"
  342. ELSEIF (ICLE.EQ.7) THEN
  343. IF (VPOCHA(IB,IC).GE.X2.AND.VPOCHA(IB,IC).LE.X3) THEN
  344. VPOCHA(IB,IC)=1.D0
  345. ELSE
  346. VPOCHA(IB,IC)=0.D0
  347. ENDIF
  348. ENDIF
  349. *
  350. * -----------------------------------------
  351. * SOIT ON CHERCHE SEULEMENT LA SOMME...
  352. * -----------------------------------------
  353. ELSEIF(ISOM.EQ.1) THEN
  354. *
  355. * MOT-CLE "SUPE"
  356. IF (ICLE.EQ.1) THEN
  357. IF (VPOCHA(IB,IC).GT.X2) KSOM=KSOM+1
  358. *
  359. * MOT-CLE "EGSU"
  360. ELSEIF(ICLE.EQ.2) THEN
  361. IF (VPOCHA(IB,IC).GE.X2) KSOM=KSOM+1
  362. *
  363. * MOT-CLE "EGAL"
  364. ELSEIF(ICLE.EQ.3) THEN
  365. IF (VPOCHA(IB,IC).EQ.X2) KSOM=KSOM+1
  366. *
  367. * MOT-CLE "EGIN"
  368. ELSEIF(ICLE.EQ.4) THEN
  369. IF (VPOCHA(IB,IC).LE.X2) KSOM=KSOM+1
  370. *
  371. * MOT-CLE "INFE"
  372. ELSEIF(ICLE.EQ.5) THEN
  373. IF (VPOCHA(IB,IC).LT.X2) KSOM=KSOM+1
  374. *
  375. * MOT-CLE "DIFF"
  376. ELSEIF(ICLE.EQ.6) THEN
  377. IF (VPOCHA(IB,IC).NE.X2) KSOM=KSOM+1
  378. *
  379. * MOT-CLE "COMP"
  380. ELSEIF(ICLE.EQ.7) THEN
  381. IF (VPOCHA(IB,IC).GE.X2.AND.VPOCHA(IB,IC).LE.X3)
  382. & KSOM=KSOM+1
  383. ENDIF
  384. ENDIF
  385.  
  386. 80 CONTINUE
  387.  
  388. 70 CONTINUE
  389. 60 CONTINUE
  390.  
  391.  
  392. C-----------------------------------------------------------------------
  393. C NETTOYAGE ET FIN DE PROGRAMME
  394. C-----------------------------------------------------------------------
  395. C
  396.  
  397. SEGSUP MTRA,MTR1,MTR4,MTR2,MTR3
  398. IF (IKOK.EQ.0) SEGSUP,MTR5
  399.  
  400. IF (ISOM.EQ.1) THEN
  401. SEGSUP,MCHPOI
  402. IRET=KSOM
  403. ELSE
  404. IRET=ICHPOI
  405. ENDIF
  406.  
  407.  
  408. RETURN
  409. END
  410.  
  411.  
  412.  
  413.  
  414.  
  415.  
  416.  
  417.  
  418.  

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