Télécharger fform1.eso

Retour à la liste

Numérotation des lignes :

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

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