Télécharger quesuq.eso

Retour à la liste

Numérotation des lignes :

  1. C QUESUQ SOURCE BP208322 17/03/22 21:15:08 9364
  2. SUBROUTINE QUESUQ(IPMODE,IPCHE1,ISUP,ICOND,MOMOT,lesupp,IRET,
  3. $ IRET2)
  4. *______________________________________________________________________
  5. *
  6. * VERIFICATION DU LIEU SUPPORT DES MCHAML
  7. *
  8. * IPMODE POINTEUR SUR UNE ZONE ELEMENTAIRE DU MODELE
  9. * ACTIF EN ENTREE ACTIF EN SORTIE
  10. * IPCHE1 POINTEUR SUR LE MCHAML DONT ON SOUHAITE VERIFIER LE SUPPORT
  11. * DE CERTAINES COMPOSANTES
  12. * (LIEU DU MINTE)
  13. * ISUP > 0 :
  14. *
  15. * ISUP = 1 ON SOUHAITE QUE IPCHE1 SOIT AUX NOEUDS
  16. * = 2 ON SOUHAITE QUE IPCHE1 SOIT AUX CENTRE DE GRAVITE
  17. * = 3 ON SOUHAITE QUE IPCHE1 SOIT AUX POINTS DE GAUSS POUR
  18. * LA RIGIDITE
  19. * = 4 ON SOUHAITE QUE IPCHE1 SOIT AUX POINTS DE GAUSS POUR
  20. * LA MASSE
  21. * = 5 ON SOUHAITE QUE IPCHE1 SOIT AUX POINTS DE GAUSS POUR
  22. * LES CONTRAINTES
  23. * ISUP = 0 ON VEUDRAIT CONNAITRE LE SUPPORT
  24. *
  25. * ICOND = 0 SI LE MCHAML PEUT ETRE SUR LE SUPPORT DEMANDE OU AUX
  26. * NOEUDS(UTILISE UNIQUEMENT QUAND ISUP >0)
  27. * 1 SI LE MCHAML DOIT ETRE IMPERATIVEMENT SUR LE SUPPORT
  28. * VOULU (CAS NOTAMENT DES MATRICE DE HOOKES ET DES
  29. * DES MATRICES DE HOOKES TANGENTES)
  30. *
  31. * MOMOT : POINTEUR SUR SEGMENT DES NOMS DES COMPOSANTES A EXAMINER
  32. * ACTIF EN ENTREE ACTIF EN SORTIE
  33. *
  34. * IPINF : POINTEUR SUR SEGMENT INFO
  35. *
  36. *
  37. * DANS LE CAS ISUP > 0
  38. *
  39. * IRET = 1 IPCHE1 SE TROUVE AUX NOEUDS
  40. * = 0 IPCHE1 EST BIEN SUR LE SUPPORT DEMANDE
  41. * = 9999 LE SUPPORT DE UNE OU PLUSIEURS SOUS ZONE N'EST
  42. * PAS LE BON
  43. * DANS LE CAS ISUP = 0
  44. *
  45. * IRET > 0 IL DONNE LE NUMERO DU SUPPORT
  46. * = 0 LE CHAMP EST CONSTANT
  47. * = 9999 LE CHAMELEM N'EST PAS HOMOGENE AU NIVEAU SUPPORT
  48. *
  49. *
  50. * IRET2 > 0 IL DONNE LE NUMERO DU SUPPORT
  51. * = 9999 LE CHAMELEM N'EST PAS HOMOGENE AU NIVEAU SUPPORT
  52. *
  53. * REMARQUE : SI IPCHE1 EST AUX NOEUDS LE PASSAGE DES VALEURS SUR LE
  54. * SUPPORT VOULU SE FAIT DANS VALCHE ET/OU VALMEL SAUF DANS
  55. * LE CAS DES MATRICE DE HOOKES
  56. *
  57. *
  58. * INSPIRE DE QUESUP
  59. *_______________________________________________________________________
  60. *
  61. IMPLICIT INTEGER(I-N)
  62. IMPLICIT REAL*8(A-H,O-Z)
  63. -INC CCOPTIO
  64. -INC SMCHAML
  65. -INC SMINTE
  66. -INC SMMODEL
  67. SEGMENT/MTEST/(ITEST(NTEST))
  68. *
  69. CHARACTER*16 CONCH
  70. *
  71. IRET=0
  72. IRET2=0
  73. ICONST=1
  74. *
  75. NOMID = MOMOT
  76. NBROBL = LESOBL(/2)
  77. NBRFAC = LESFAC(/2)
  78. *
  79. MCHELM=IPCHE1
  80. SEGACT MCHELM
  81. NSOUS=ICHAML(/1)
  82.  
  83. NTEST=NSOUS
  84. SEGINI,MTEST
  85. *
  86. * si le chamelem est constant sur l'element quelque soit le
  87. * support demande on est bon
  88. *
  89. DO 10 ISOUS=1,NSOUS
  90. MCHAML=ICHAML(ISOUS)
  91. SEGACT MCHAML
  92. NCOMP=IELVAL(/1)
  93. DO 20 ICOMP=1,NCOMP
  94. *
  95. * TEST SUR LES NOMS DE COMPOSANTES
  96. *
  97. JELAI=0
  98. DO 21 ICOCO=1,NBROBL
  99. IF(NOMCHE(ICOMP).EQ.LESOBL(ICOCO)) JELAI=1
  100. 21 CONTINUE
  101. IF(JELAI.EQ.0) THEN
  102. DO 22 ICOCO=1,NBRFAC
  103. IF(NOMCHE(ICOMP).EQ.LESFAC(ICOCO)) JELAI=1
  104. 22 CONTINUE
  105. ENDIF
  106. IF(JELAI.EQ.0) GO TO 20
  107. ITEST(ISOUS)=MAX(ITEST(ISOUS),JELAI)
  108. *
  109. MELVAL=IELVAL(ICOMP)
  110. IF(MELVAL.NE.0)THEN
  111. SEGACT MELVAL
  112. IF(TYPCHE(ICOMP)(1:8).NE.'POINTEUR')THEN
  113. IPOIN=VELCHE(/1)
  114. ELSE
  115. IPOIN=IELCHE(/1)
  116. ENDIF
  117. IF(IPOIN.NE.1)THEN
  118. SEGDES MELVAL,MCHAML
  119. ICONST=0
  120. GOTO 500
  121. ENDIF
  122. SEGDES MELVAL
  123. ENDIF
  124. 20 CONTINUE
  125. SEGDES MCHAML
  126. 10 CONTINUE
  127. *
  128. 500 CONTINUE
  129. N3=INFCHE(/2)
  130. IF (N3.LT.4) GOTO 1000
  131. IF(N3.GE.6) THEN
  132. ISUP1=INFCHE(1,6)
  133. IRET2=ISUP1
  134. IF (ICONST.EQ.1) GOTO 666
  135. ELSE
  136. GOTO 3000
  137. ENDIF
  138. *
  139. IFLAG=0
  140. *
  141. * CAS ISUP = 0
  142. * ------------
  143. *
  144. IF(ISUP.EQ.0)THEN
  145. IF(N3.GE.6)ISUP1=INFCHE(1,6)
  146. DO 1 ISOUS=1,NSOUS
  147. IF (INFCHE(ISOUS,4).EQ.0) GOTO 1
  148. IF (ITEST(ISOUS).EQ.0) GOTO 1
  149. IF (N3.GE.6) THEN
  150. INFCH=INFCHE(ISOUS,6)
  151. IF (INFCH.EQ.1) GOTO 1
  152. IF (INFCH.NE.ISUP1) THEN
  153. MINTE=INFCHE(1,4)
  154. MINTE1=INFCHE(ISOUS,4)
  155. SEGACT MINTE
  156. SEGACT MINTE1
  157. NBPGAU=POIGAU(/1)
  158. NBPGA1=MINTE1.POIGAU(/1)
  159. * NO DESACT SEGDES,MINTE,MINTE1
  160. IF(NBPGAU.EQ.NBPGA1)THEN
  161. IFLAG=IFLAG+1
  162. ELSE
  163. GOTO 2000
  164. ENDIF
  165. ELSE
  166. IFLAG=IFLAG+1
  167. ENDIF
  168. ELSE
  169. GOTO 3000
  170. ENDIF
  171. 1 CONTINUE
  172. *
  173. * TOUTES LES SOUS ZONES DOIVENT ETRE SUR LE BON SUPPORT
  174. *
  175. IF (IFLAG.EQ.0) GOTO 1000
  176. IF (IFLAG.EQ.NSOUS) THEN
  177. IF(ISUP.EQ.0) THEN
  178. IRET=ISUP1
  179. IRET2=ISUP1
  180. ENDIF
  181. GOTO 666
  182. ELSE
  183. GOTO 2000
  184. ENDIF
  185. *
  186. * CAS ISUP > 0
  187. * ------------
  188. * DANS CE CAS CE SONT LES ZONES DU MODELE QUI PILOTENT
  189. *
  190. ELSE
  191. ISUP1=ISUP
  192. *
  193. * ETUDE DE LA SOUS ZONE DU MODELE
  194. *
  195. IMODEL=IPMODE
  196. MELE=NEFMOD
  197. *
  198. * BOUCLE SUR LES ZONES DU CHAMELEM
  199. *
  200. DO 2 ISOUS=1,NSOUS
  201. CONCH=CONCHE(ISOUS)
  202. IPMAIL=IMACHE(ISOUS)
  203. IF(IMAMOD.NE.IPMAIL.OR.CONCH.NE.CONMOD)GOTO 2
  204. IF (INFCHE(ISOUS,4).EQ.0) GOTO 2
  205. IF (ITEST(ISOUS).EQ.0) GOTO 2
  206. *
  207. IF (N3.GE.6) THEN
  208. INFCH=INFCHE(ISOUS,6)
  209. IF (INFCH.EQ.1) GOTO 2
  210. IF (INFCH.NE.ISUP1) THEN
  211. IF(ISUP1.EQ.6)THEN
  212. CALL TSHAPE(MELE,'GAUSS',IPMIN1)
  213. ELSE
  214. * INFO=IPINF
  215. IPMIN1=INFMOD(lesupp+2)
  216. ENDIF
  217. MINTE=INFCHE(ISOUS,4)
  218. MINTE1=IPMIN1
  219. SEGACT MINTE
  220. SEGACT MINTE1
  221. NBPGAU=POIGAU(/1)
  222. NBPGA1=MINTE1.POIGAU(/1)
  223. IF(NBPGAU.EQ.NBPGA1)THEN
  224. IRT=1
  225. ELSE
  226. IRT=0
  227. ENDIF
  228. * NO DESACT SEGDES MINTE,MINTE1
  229. IF(IRT.EQ.1)THEN
  230. IFLAG=IFLAG+1
  231. ELSE
  232. GOTO 2000
  233. ENDIF
  234. ELSE
  235. IFLAG=IFLAG+1
  236. ENDIF
  237. ELSE
  238. GOTO 3000
  239. ENDIF
  240. 2 CONTINUE
  241. *
  242. * LA SOUS-ZONE DOIT ETRE SUR LE BON SUPPORT
  243. *
  244. IF (IFLAG.EQ.0) GOTO 1000
  245. IF (IFLAG.EQ.1) THEN
  246. IF(ISUP.EQ.0) THEN
  247. IRET=ISUP1
  248. IRET2=ISUP1
  249. ENDIF
  250. GOTO 666
  251. ELSE
  252. GOTO 2000
  253. ENDIF
  254. ENDIF
  255. *
  256. 1000 CONTINUE
  257. *
  258. * IPCHE1 EST AUX NOEUDS
  259. *
  260. IRET=1
  261. IF (ISUP.EQ.1) IRET=0
  262. IF (ICOND.EQ.1.AND.IRET.EQ.1.AND.ISUP.NE.0) GOTO 2000
  263. GOTO 666
  264. *
  265. 2000 CONTINUE
  266. *
  267. IF(ISUP.NE.0)THEN
  268. *
  269. * IPCHE1 EST SUR UN AUTRE SUPPORT QUE CELUI VOULU ET PAS AUX NOEUDS
  270. *
  271. * ==> MESSAGE D'ERREUR POUR QUE L'ON DONNE LE CHAMELEM SUR UN
  272. * SUPPORT CORRECT
  273. *
  274. MOTERR(1:8)=TITCHE
  275. CALL ERREUR(124)
  276. ELSE
  277. *
  278. * LES DIFFERENTS SOUS-ZONES DU CHAMELEM ONT DES POINTS SUPPORTS DIFFERENTS
  279. *
  280. CALL ERREUR(560)
  281. ENDIF
  282. SEGDES MCHELM
  283. IRET=9999
  284. IRET2=9999
  285. RETURN
  286. *
  287. 3000 CONTINUE
  288. *
  289. * IPCHE1 A UN POINTEUR SUR UN MINTE <> 0 MAIS L'INFCHE(..,6)
  290. * N'EST PAS RENSEIGNE (NE DOIT PAS ARRIVE NORMALEMENT)
  291. *
  292. IRET=9999
  293. IRET2=9999
  294. CALL ERREUR(53)
  295. *
  296. 666 CONTINUE
  297. SEGDES MCHELM
  298. SEGSUP,MTEST
  299. RETURN
  300. END
  301.  
  302.  
  303.  
  304.  
  305.  
  306.  
  307.  
  308.  
  309.  
  310.  

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