Télécharger quesuq.eso

Retour à la liste

Numérotation des lignes :

  1. C QUESUQ SOURCE CB215821 19/08/20 21:21:08 10287
  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.  
  64. -INC PPARAM
  65. -INC CCOPTIO
  66. -INC SMCHAML
  67. -INC SMINTE
  68. -INC SMMODEL
  69. SEGMENT/MTEST/(ITEST(NTEST))
  70. *
  71. CHARACTER*16 CONCH
  72. *
  73. IRET=0
  74. IRET2=0
  75. ICONST=1
  76. *
  77. NOMID = MOMOT
  78. NBROBL = LESOBL(/2)
  79. NBRFAC = LESFAC(/2)
  80. *
  81. MCHELM=IPCHE1
  82. SEGACT MCHELM
  83. NSOUS=ICHAML(/1)
  84.  
  85. NTEST=NSOUS
  86. SEGINI,MTEST
  87. *
  88. * si le chamelem est constant sur l'element quelque soit le
  89. * support demande on est bon
  90. *
  91. DO 10 ISOUS=1,NSOUS
  92. MCHAML=ICHAML(ISOUS)
  93. SEGACT MCHAML
  94. NCOMP=IELVAL(/1)
  95. DO 20 ICOMP=1,NCOMP
  96. *
  97. * TEST SUR LES NOMS DE COMPOSANTES
  98. *
  99. JELAI=0
  100. DO 21 ICOCO=1,NBROBL
  101. IF(NOMCHE(ICOMP).EQ.LESOBL(ICOCO)) JELAI=1
  102. 21 CONTINUE
  103. IF(JELAI.EQ.0) THEN
  104. DO 22 ICOCO=1,NBRFAC
  105. IF(NOMCHE(ICOMP).EQ.LESFAC(ICOCO)) JELAI=1
  106. 22 CONTINUE
  107. ENDIF
  108. IF(JELAI.EQ.0) GO TO 20
  109. ITEST(ISOUS)=MAX(ITEST(ISOUS),JELAI)
  110. *
  111. MELVAL=IELVAL(ICOMP)
  112. IF(MELVAL.NE.0)THEN
  113. SEGACT MELVAL
  114. IF(TYPCHE(ICOMP)(1:8).NE.'POINTEUR')THEN
  115. IPOIN=VELCHE(/1)
  116. ELSE
  117. IPOIN=IELCHE(/1)
  118. ENDIF
  119. IF(IPOIN.NE.1)THEN
  120. ICONST=0
  121. GOTO 500
  122. ENDIF
  123. ENDIF
  124. 20 CONTINUE
  125. 10 CONTINUE
  126. *
  127. 500 CONTINUE
  128. N3=INFCHE(/2)
  129. IF (N3.LT.4) GOTO 1000
  130. IF(N3.GE.6) THEN
  131. ISUP1=INFCHE(1,6)
  132. IRET2=ISUP1
  133. IF (ICONST.EQ.1) GOTO 666
  134. ELSE
  135. GOTO 3000
  136. ENDIF
  137. *
  138. IFLAG=0
  139. *
  140. * CAS ISUP = 0
  141. * ------------
  142. *
  143. IF(ISUP.EQ.0)THEN
  144. IF(N3.GE.6)ISUP1=INFCHE(1,6)
  145. DO 1 ISOUS=1,NSOUS
  146. IF (INFCHE(ISOUS,4).EQ.0) GOTO 1
  147. IF (ITEST(ISOUS).EQ.0) GOTO 1
  148. IF (N3.GE.6) THEN
  149. INFCH=INFCHE(ISOUS,6)
  150. IF (INFCH.EQ.1) GOTO 1
  151. IF (INFCH.NE.ISUP1) THEN
  152. MINTE=INFCHE(1,4)
  153. MINTE1=INFCHE(ISOUS,4)
  154. SEGACT MINTE
  155. SEGACT MINTE1
  156. NBPGAU=POIGAU(/1)
  157. NBPGA1=MINTE1.POIGAU(/1)
  158. IF(NBPGAU.EQ.NBPGA1)THEN
  159. IFLAG=IFLAG+1
  160. ELSE
  161. GOTO 2000
  162. ENDIF
  163. ELSE
  164. IFLAG=IFLAG+1
  165. ENDIF
  166. ELSE
  167. GOTO 3000
  168. ENDIF
  169. 1 CONTINUE
  170. *
  171. * TOUTES LES SOUS ZONES DOIVENT ETRE SUR LE BON SUPPORT
  172. *
  173. IF (IFLAG.EQ.0) GOTO 1000
  174. IF (IFLAG.EQ.NSOUS) THEN
  175. IF(ISUP.EQ.0) THEN
  176. IRET=ISUP1
  177. IRET2=ISUP1
  178. ENDIF
  179. GOTO 666
  180. ELSE
  181. GOTO 2000
  182. ENDIF
  183. *
  184. * CAS ISUP > 0
  185. * ------------
  186. * DANS CE CAS CE SONT LES ZONES DU MODELE QUI PILOTENT
  187. *
  188. ELSE
  189. ISUP1=ISUP
  190. *
  191. * ETUDE DE LA SOUS ZONE DU MODELE
  192. *
  193. IMODEL=IPMODE
  194. MELE=NEFMOD
  195. *
  196. * BOUCLE SUR LES ZONES DU CHAMELEM
  197. *
  198. DO 2 ISOUS=1,NSOUS
  199. CONCH=CONCHE(ISOUS)
  200. IPMAIL=IMACHE(ISOUS)
  201. IF(IMAMOD.NE.IPMAIL.OR.CONCH.NE.CONMOD)GOTO 2
  202. IF (INFCHE(ISOUS,4).EQ.0) GOTO 2
  203. IF (ITEST(ISOUS).EQ.0) GOTO 2
  204. *
  205. IF (N3.GE.6) THEN
  206. INFCH=INFCHE(ISOUS,6)
  207. IF (INFCH.EQ.1) GOTO 2
  208. IF (INFCH.NE.ISUP1) THEN
  209. IF(ISUP1.EQ.6)THEN
  210. CALL TSHAPE(MELE,'GAUSS',IPMIN1)
  211. ELSE
  212. * INFO=IPINF
  213. IPMIN1=INFMOD(lesupp+2)
  214. ENDIF
  215. MINTE=INFCHE(ISOUS,4)
  216. MINTE1=IPMIN1
  217. SEGACT MINTE
  218. SEGACT MINTE1
  219. NBPGAU=POIGAU(/1)
  220. NBPGA1=MINTE1.POIGAU(/1)
  221. IF(NBPGAU.EQ.NBPGA1)THEN
  222. IRT=1
  223. ELSE
  224. IRT=0
  225. ENDIF
  226. IF(IRT.EQ.1)THEN
  227. IFLAG=IFLAG+1
  228. ELSE
  229. GOTO 2000
  230. ENDIF
  231. ELSE
  232. IFLAG=IFLAG+1
  233. ENDIF
  234. ELSE
  235. GOTO 3000
  236. ENDIF
  237. 2 CONTINUE
  238. *
  239. * LA SOUS-ZONE DOIT ETRE SUR LE BON SUPPORT
  240. *
  241. IF (IFLAG.EQ.0) GOTO 1000
  242. IF (IFLAG.EQ.1) THEN
  243. IF(ISUP.EQ.0) THEN
  244. IRET=ISUP1
  245. IRET2=ISUP1
  246. ENDIF
  247. GOTO 666
  248. ELSE
  249. GOTO 2000
  250. ENDIF
  251. ENDIF
  252. *
  253. 1000 CONTINUE
  254. *
  255. * IPCHE1 EST AUX NOEUDS
  256. *
  257. IRET=1
  258. IF (ISUP.EQ.1) IRET=0
  259. IF (ICOND.EQ.1.AND.IRET.EQ.1.AND.ISUP.NE.0) GOTO 2000
  260. GOTO 666
  261. *
  262. 2000 CONTINUE
  263. *
  264. IF(ISUP.NE.0)THEN
  265. *
  266. * IPCHE1 EST SUR UN AUTRE SUPPORT QUE CELUI VOULU ET PAS AUX NOEUDS
  267. *
  268. * ==> MESSAGE D'ERREUR POUR QUE L'ON DONNE LE CHAMELEM SUR UN
  269. * SUPPORT CORRECT
  270. *
  271. MOTERR(1:8)=TITCHE
  272. CALL ERREUR(124)
  273. ELSE
  274. *
  275. * LES DIFFERENTS SOUS-ZONES DU CHAMELEM ONT DES POINTS SUPPORTS DIFFERENTS
  276. *
  277. CALL ERREUR(560)
  278. ENDIF
  279. IRET=9999
  280. IRET2=9999
  281. RETURN
  282. *
  283. 3000 CONTINUE
  284. *
  285. * IPCHE1 A UN POINTEUR SUR UN MINTE <> 0 MAIS L'INFCHE(..,6)
  286. * N'EST PAS RENSEIGNE (NE DOIT PAS ARRIVE NORMALEMENT)
  287. *
  288. IRET=9999
  289. IRET2=9999
  290. CALL ERREUR(53)
  291. *
  292. 666 CONTINUE
  293. SEGSUP,MTEST
  294. END
  295.  
  296.  
  297.  

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