Télécharger fform1.eso

Retour à la liste

Numérotation des lignes :

fform1
  1. C FFORM1 SOURCE CB215821 20/11/04 21:17:23 10766
  2. SUBROUTINE FFORM1(mymod,mchelm,ichfac)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C
  6. C SOUS-PROGRAMME ASSOCIE A L'OPERATEUR FFOR
  7. C (LECTURE ET VERIFICATION DES DONNEES PUIS AIGUILLAGE)
  8. C
  9. C__________________________________________________________________
  10. C APPEL :
  11. C
  12. C 3D CH2 = FFOR MODL1 (ENTI1) (FLOT1) ('SYME' P1 P2 P3) ('NNOR') ;
  13. C 2D CH2 = FFOR MODL1 (ENTI1) (FLOT1) ('SYME' P1 P2 ) ('NNOR') ;
  14. C CONV CH2 = FFOR MODL1 (ENTI1) 'CVXE' ;
  15. C AXIS CH2 = FFOR MODL1 (ENTI1) ('NGAU' ENTI2) ('CVXE') ('NNOR') ;
  16. C
  17. C
  18. C 03/96 : option supplementaire pour tenir compte de l'absorption du
  19. C milieu:
  20. C 'ABSO' EXTINC ;
  21. C pour simplifier la lecture on demande que ce coef. soit negatif
  22. C
  23. C 09/02: on donne le nombre de points d'integration pour le traitement
  24. C des faces proches en AXIS (cf 'NGAU')
  25. C__________________________________________________________________
  26. C OPERANDES :
  27. C
  28. C CH2 'MCHAML' FACTEURS DE FORME
  29. C MODL1 'MMODEL' STRUCTURE MODELISEE (CONTOUR OU ENVELOPPE)
  30. C ENTI1 'ENTIER' DISCRETISATION ANGULAIRE EN 2D-PLAN OU
  31. C 3D-CAS GENERAL
  32. C FLOT1 'FLOTTANT' FACTEUR DE DECOUPAGE DES ELEMENTS
  33. C CVXE 'MOT CLE' MOT CLE POUR LES CAVITES CONVEXES
  34. C SYME 'MOT CLE' MOT CLE DEFINISSANT UN AXE OU UN PLAN
  35. C DE SYMETRIE
  36. C P1,P2,P3 'POINT' POINTS DEFINISSANT L'AXE OU LE PLAN DE
  37. C SYMETRIE
  38. C NGAU 'MOT CLE' EN AXISYMETRIQUE
  39. C ENTI2 'ENTIER' nombre de points d'integration
  40. C
  41. C ABSO mot-clé pour un milieu absorbant
  42. C EXTINC coefficient d'absorption
  43. C__________________________________________________________________
  44. C
  45. C
  46.  
  47. -INC PPARAM
  48. -INC CCOPTIO
  49. -INC SMMODEL
  50. -INC SMCHAML
  51. C
  52. POINTEUR MYMOD.MMODEL
  53. C ___________________________________________________________
  54. C Stockage de numeros de points
  55. SEGMENT ,LISTEN
  56. INTEGER LECT(NBE)
  57. ENDSEGMENT
  58. POINTEUR IAXE.LISTEN
  59. C ___________________________________________________________
  60. C Stockage d'informations concernant le type des éléments
  61. SEGMENT ,INFOEL
  62. LOGICAL KCOQ(N1),KQUAD(N1)
  63. ENDSEGMENT
  64. C ___________________________________________________________
  65. C
  66. CHARACTER*4 MOTCLE
  67. LOGICAL MCVX,MSYM,MGAUS,MABS
  68. C
  69. C__________________________________________________________________
  70. C
  71. MCVX = .FALSE.
  72. MSYM = .FALSE.
  73. MGAUS = .FALSE.
  74. MABS = .FALSE.
  75. KNOR = 1
  76. IAXE = 0
  77. EXTINC = -1.D-5
  78. C
  79. C -----------------------------------------------------
  80. C On va vérifier que le TYPE DES ÉLÉMENTS des maillages
  81. C sur lequel repose le modèle CONVIENT .
  82. C et le type de modèle
  83. C
  84. SEGACT MYMOD
  85. N1 = MYMOD.KMODEL(/1)
  86. iy=0
  87. 20 iy=iy+1
  88. if( iy.gt.mymod.kmodel(/1)) then
  89. call erreur (19)
  90. return
  91. endif
  92. imodel=mymod.kmodel(iy)
  93. segact imodel
  94. if (formod(1).ne.'THERMIQUE') goto 20
  95. nmat=matmod(/2)
  96. if (matmod(2).ne.'RAYONNEMENT') goto 20
  97. if (matmod(3).ne.'CAVITE') go to 20
  98. if (imatee.ne.4) go to 20
  99. inatu=inatuu
  100. * pour la valeur de inatu voir subroutine nomate
  101. if( inatu.eq.2)then
  102. knor=0
  103. elseif(inatu.eq.3) then
  104. MSYM = .TRUE.
  105. elseif(inatu.eq.4) then
  106. MCVX = .TRUE.
  107. elseif(inatu.eq.5) then
  108. MSYM = .TRUE.
  109. MCVX = .TRUE.
  110. elseif(inatu.eq.6) then
  111. knor=0
  112. MCVX = .TRUE.
  113. elseif(inatu.eq.7) then
  114. MSYM = .TRUE.
  115. knor=0
  116. elseif(inatu.eq.8) then
  117. MSYM = .TRUE.
  118. MCVX = .TRUE.
  119. knor=1
  120. elseif(inatu.ne.1) then
  121. write(6,*) ' pb dans fforme'
  122. write(6,*) ' inatu ' , inatu
  123. call erreur(5)
  124. endif
  125. imail= imamod
  126. ngax=ivamod(1)
  127. int=ivamod(2)
  128. npax=20
  129. npax=max ( int,npax)
  130. SEGINI INFOEL
  131. * recherche du coefficient d'absorption
  132. *
  133. if( mchelm.ne.0) then
  134. segact mchelm
  135. do iy=1,imache(/1)
  136. * write(6,*) imamod,imache(iy),conche(iy),conmod
  137. if( imache(iy).eq.imamod.and.conche(iy).eq.conmod) then
  138. mchaml=ichaml(iy)
  139. segact mchaml
  140. do it=1,nomche(/2)
  141. if( nomche(it).eq.'CABS' ) THEN
  142. melval=ielval(it)
  143. segact melval
  144. extinc=-velche(1,1)
  145. mabs=.true.
  146. go to 8
  147. endif
  148. enddo
  149. endif
  150. enddo
  151. 8 continue
  152. endif
  153. * write(6,*) ' extinc',extinc
  154. * write(6,*) ' knor mcvx , msym , mgaus mabs'
  155. * write(6,*) knor,mcvx , msym , mgaus,mabs
  156.  
  157. C
  158. DO 10 ITYP=1,N1
  159. C
  160. IMODEL = MYMOD.KMODEL(ITYP)
  161. SEGACT IMODEL
  162. C
  163. C la formulation est simple a priori
  164. C
  165. IF(FORMOD(1).NE.'THERMIQUE'.or.matmod(2).ne.'RAYONNEMENT') THEN
  166. CALL ERREUR(21)
  167. RETURN
  168. ENDIF
  169. * write(6,*) ' nefmod ' , nefmod
  170. C
  171. C On va rega Crder quelle est la nature de l'élément
  172. IF (IDIM.EQ.3) THEN
  173.  
  174. IF ((NEFMOD.EQ.4).OR.(NEFMOD.EQ.8)) THEN
  175. C TRI3 ou QUA4
  176. KQUAD(ITYP)=.FALSE.
  177. KCOQ(ITYP) =.FALSE.
  178. ELSEIF ((NEFMOD.EQ.27).OR.(NEFMOD.EQ.49)) THEN
  179. C COQ3 ou COQ4
  180. KQUAD(ITYP)=.FALSE.
  181. KCOQ(ITYP) =.TRUE.
  182. ELSEIF ((NEFMOD.EQ.6).OR.(NEFMOD.EQ.10)) THEN
  183. C TRI6 ou QUA8
  184. KQUAD(ITYP)=.TRUE.
  185. KCOQ(ITYP) =.FALSE.
  186. ELSEIF ((NEFMOD.EQ.56).OR.(NEFMOD.EQ.41)) THEN
  187. C COQ6 ou COQ8
  188. KQUAD(ITYP)=.TRUE.
  189. KCOQ(ITYP) =.TRUE.
  190. ELSE
  191. CALL ERREUR(16)
  192. RETURN
  193. ENDIF
  194. C
  195. ELSEIF (IDIM.EQ.2) THEN
  196. C
  197. IF (NEFMOD.EQ.2) THEN
  198. C SEG2
  199. KQUAD(ITYP)=.FALSE.
  200. KCOQ(ITYP) =.FALSE.
  201. ELSEIF (NEFMOD.EQ.44) THEN
  202. C COQ2
  203. KQUAD(ITYP)=.FALSE.
  204. KCOQ(ITYP) =.TRUE.
  205. ELSEIF (NEFMOD.EQ.3) THEN
  206. C SEG3
  207. KQUAD(ITYP)=.TRUE.
  208. KCOQ(ITYP) =.FALSE.
  209. ELSE
  210. CALL ERREUR(16)
  211. RETURN
  212. ENDIF
  213. C
  214. ELSE
  215. CALL ERREUR(14)
  216. RETURN
  217. ENDIF
  218.  
  219. 10 CONTINUE
  220.  
  221. SEGDES INFOEL
  222. C
  223. C
  224. C ----------------------------------------------------
  225. C Orientation vers les différents sous-programmes
  226. C
  227. IF (IFOMOD.NE.0) THEN
  228. C On n'est pas en mode axisymétrique
  229. C
  230. IF (MCVX.AND.(.NOT.MSYM)) THEN
  231. C on n'a recu que CVXE
  232. GOTO 100
  233. ELSEIF (MSYM) THEN
  234. C il faut lire des points pour le cas général
  235. GOTO 200
  236. ELSE
  237. C cas général
  238. GOTO 210
  239. ENDIF
  240. C
  241. ELSE
  242. C On est en mode axisymétrique
  243. GOTO 300
  244. C
  245. ENDIF
  246. C
  247. C**********************************************************
  248. C
  249. C
  250. C
  251. C********************
  252. C CAS CONVEXE
  253. C********************
  254. C
  255. 100 CALL LIRENT(INT1,0,IRETOU)
  256. IF (IRETOU.NE.0) THEN
  257. INT=INT1
  258. ELSE
  259. INT=3
  260. ENDIF
  261. * write(6,*) ' int ', int
  262. CALL FACCVX(MYMOD,INFOEL,INT,ICHFAC)
  263.  
  264. GOTO 900
  265. C
  266. C
  267. C********************
  268. C CAS GENERAL
  269. C********************
  270. C
  271. C----cas avec 'SYME' => lecture des points
  272. C
  273. 200 segact imodel
  274. ip1 = ivamod(3)
  275. ip2 = ivamod(4)
  276. NBE = IDIM
  277. SEGINI ,IAXE
  278. IAXE.LECT(1) = IP1
  279. IAXE.LECT(2) = IP2
  280. IF (IDIM.EQ.3) THEN
  281. ip3=ivamod(5)
  282. iaxe.lect(3)=ip3
  283. ENDIF
  284. SEGDES IAXE
  285. C
  286. C----suite du cas général
  287. C
  288. 210 CALL LIRENT(INT1,0,IRETOU)
  289. IF (IRETOU.NE.0) THEN
  290. IF(IDIM.EQ.3) THEN
  291. LRES=MIN0(INT1,100)
  292. ELSE
  293. LRES=MIN0(INT1,1000)
  294. ENDIF
  295. ELSE
  296. IF(IDIM.EQ.3) THEN
  297. LRES=50
  298. ELSE
  299. LRES=200
  300. ENDIF
  301. ENDIF
  302. * write(6,*) ' lres ' , lres
  303.  
  304.  
  305. * IF (MABS) THEN
  306. * CALL LIRREE(FLO2,0,IRETO2)
  307. * CALL LIRREE(FLO1,0,IRETOU)
  308. * IF(FLO2.LT.(-1.D-5)) THEN
  309. * EXTINC = -FLO2
  310. * ELSE
  311. * EXTINC = -FLO1
  312. * FLO1 = FLO2
  313. * IRETOU=IRETO2
  314. * ENDIF
  315. * ELSE
  316. * CALL LIRREE(FLO1,0,IRETOU)
  317. * ENDIF
  318. * IF (IRETOU.NE.0) THEN
  319. * IF(IDIM.EQ.3) THEN
  320. * XDEC=MIN(FLO1,2.D0)
  321. * ELSE
  322. * XDEC=MIN(FLO1,10.D0)
  323. * ENDIF
  324. * ELSE
  325. IF(IDIM.EQ.3) THEN
  326. XDEC=0.5
  327. ELSE
  328. XDEC=5.D0
  329. ENDIF
  330. * ENDIF
  331. * write(6,*) ' xdec ' , xdec
  332. C
  333. C
  334. IF (IDIM.EQ.3) THEN
  335. * write(6,*) ' appel a facgen'
  336. * write(6,*) LRES,XDEC,IAXE,KNOR,EXTINC
  337. CALL FACGEN(MYMOD,INFOEL,LRES,XDEC,IAXE,KNOR,ICHFAC,EXTINC)
  338. ELSE
  339. * write(6,*) ' appel a facge2'
  340. * write(6,*) LRES,XDEC,IAXE,KNOR,EXTINC
  341. * write(6,*) ( kcoq(iou),kquad(iou),iou=1,kcoq(/1))
  342.  
  343. CALL FACGE2(MYMOD,INFOEL,LRES,XDEC,IAXE,KNOR,ICHFAC,EXTINC)
  344. ENDIF
  345. IF (IAXE.NE.0) SEGSUP IAXE
  346. C
  347. GOTO 900
  348. C
  349. C********************
  350. C CAS AXISYMETRIQUE
  351. C********************
  352. C
  353.  
  354. 300 CONTINUE
  355.  
  356. C valeurs par defaut
  357.  
  358. NGAX=10
  359. NPAX=20
  360.  
  361. CALL LIRENT(INT1,0,IRETO1)
  362. CALL LIRENT(INT2,0,IRETO2)
  363.  
  364. IF (IRETO2.NE.0) THEN
  365. NGAX = MIN0(INT1,10)
  366. NPAX = MIN0(INT2,1000)
  367. ELSEIF (MGAUS) THEN
  368. NPAX = MIN0(INT1,1000)
  369. ELSEIF (IRETO1.NE.0) THEN
  370. NGAX=MIN0(INT1,10)
  371. ENDIF
  372.  
  373. C WRITE(6,*) ' FFOR NG NP ',NGAX,NPAX
  374.  
  375. IF (MCVX) THEN
  376. KACHE = 0
  377. ELSE
  378. KACHE = 1
  379. ENDIF
  380. C
  381. IF(MABS) THEN
  382. CALL LIRREE(FLO1,0,IRETOU)
  383. IF (IRETOU.NE.0) THEN
  384. EXTINC=-FLO1
  385. ENDIF
  386. ENDIF
  387.  
  388. CALL FACAXI(MYMOD,INFOEL,NPAX,NGAX,KACHE,KNOR,ICHFAC,EXTINC)
  389. C
  390. C**********************************************************
  391. C
  392. 900 SEGSUP ,INFOEL
  393. segact mymod
  394. mchelm=ICHFAC
  395. segact mchelm*mod
  396. do i=1,mymod.kmodel(/1)
  397. imodel=mymod.kmodel(i)
  398. segact imodel
  399. conche(i)=conmod
  400. enddo
  401. C Ecriture du chamelem facteur de forme
  402. * CALL ECROBJ('MCHAML ',ICHFAC)
  403. END
  404.  
  405.  
  406.  
  407.  
  408.  
  409.  

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