Télécharger fform1.eso

Retour à la liste

Numérotation des lignes :

  1. C FFORM1 SOURCE CB215821 19/08/20 21:17:46 10287
  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. go to 8
  145. endif
  146. enddo
  147. endif
  148. enddo
  149. 8 continue
  150. endif
  151. * write(6,*) ' extinc',extinc
  152. * write(6,*) ' knor mcvx , msym , mgaus mabs'
  153. * write(6,*) knor,mcvx , msym , mgaus,mabs
  154.  
  155. C
  156. DO 10 ITYP=1,N1
  157. C
  158. IMODEL = MYMOD.KMODEL(ITYP)
  159. SEGACT IMODEL
  160. C
  161. C la formulation est simple a priori
  162. C
  163. IF(FORMOD(1).NE.'THERMIQUE'.or.matmod(2).ne.'RAYONNEMENT') THEN
  164. CALL ERREUR(21)
  165. RETURN
  166. ENDIF
  167. * write(6,*) ' nefmod ' , nefmod
  168. C
  169. C On va rega Crder quelle est la nature de l'élément
  170. IF (IDIM.EQ.3) THEN
  171.  
  172. IF ((NEFMOD.EQ.4).OR.(NEFMOD.EQ.8)) THEN
  173. C TRI3 ou QUA4
  174. KQUAD(ITYP)=.FALSE.
  175. KCOQ(ITYP) =.FALSE.
  176. ELSEIF ((NEFMOD.EQ.27).OR.(NEFMOD.EQ.49)) THEN
  177. C COQ3 ou COQ4
  178. KQUAD(ITYP)=.FALSE.
  179. KCOQ(ITYP) =.TRUE.
  180. ELSEIF ((NEFMOD.EQ.6).OR.(NEFMOD.EQ.10)) THEN
  181. C TRI6 ou QUA8
  182. KQUAD(ITYP)=.TRUE.
  183. KCOQ(ITYP) =.FALSE.
  184. ELSEIF ((NEFMOD.EQ.56).OR.(NEFMOD.EQ.41)) THEN
  185. C COQ6 ou COQ8
  186. KQUAD(ITYP)=.TRUE.
  187. KCOQ(ITYP) =.TRUE.
  188. ELSE
  189. CALL ERREUR(16)
  190. RETURN
  191. ENDIF
  192. C
  193. ELSEIF (IDIM.EQ.2) THEN
  194. C
  195. IF (NEFMOD.EQ.2) THEN
  196. C SEG2
  197. KQUAD(ITYP)=.FALSE.
  198. KCOQ(ITYP) =.FALSE.
  199. ELSEIF (NEFMOD.EQ.44) THEN
  200. C COQ2
  201. KQUAD(ITYP)=.FALSE.
  202. KCOQ(ITYP) =.TRUE.
  203. ELSEIF (NEFMOD.EQ.3) THEN
  204. C SEG3
  205. KQUAD(ITYP)=.TRUE.
  206. KCOQ(ITYP) =.FALSE.
  207. ELSE
  208. CALL ERREUR(16)
  209. RETURN
  210. ENDIF
  211. C
  212. ELSE
  213. CALL ERREUR(14)
  214. RETURN
  215. ENDIF
  216.  
  217. 10 CONTINUE
  218.  
  219. SEGDES INFOEL
  220. C
  221. C
  222. C ----------------------------------------------------
  223. C Orientation vers les différents sous-programmes
  224. C
  225. IF (IFOMOD.NE.0) THEN
  226. C On n'est pas en mode axisymétrique
  227. C
  228. IF (MCVX.AND.(.NOT.MSYM)) THEN
  229. C on n'a recu que CVXE
  230. GOTO 100
  231. ELSEIF (MSYM) THEN
  232. C il faut lire des points pour le cas général
  233. GOTO 200
  234. ELSE
  235. C cas général
  236. GOTO 210
  237. ENDIF
  238. C
  239. ELSE
  240. C On est en mode axisymétrique
  241. GOTO 300
  242. C
  243. ENDIF
  244. C
  245. C**********************************************************
  246. C
  247. C
  248. C
  249. C********************
  250. C CAS CONVEXE
  251. C********************
  252. C
  253. 100 CALL LIRENT(INT1,0,IRETOU)
  254. IF (IRETOU.NE.0) THEN
  255. INT=INT1
  256. ELSE
  257. INT=3
  258. ENDIF
  259. * write(6,*) ' int ', int
  260. CALL FACCVX(MYMOD,INFOEL,INT,ICHFAC)
  261.  
  262. GOTO 900
  263. C
  264. C
  265. C********************
  266. C CAS GENERAL
  267. C********************
  268. C
  269. C----cas avec 'SYME' => lecture des points
  270. C
  271. 200 segact imodel
  272. ip1 = ivamod(3)
  273. ip2 = ivamod(4)
  274. NBE = IDIM
  275. SEGINI ,IAXE
  276. IAXE.LECT(1) = IP1
  277. IAXE.LECT(2) = IP2
  278. IF (IDIM.EQ.3) THEN
  279. ip3=ivamod(5)
  280. iaxe.lect(3)=ip3
  281. ENDIF
  282. SEGDES IAXE
  283. C
  284. C----suite du cas général
  285. C
  286. 210 CALL LIRENT(INT1,0,IRETOU)
  287. IF (IRETOU.NE.0) THEN
  288. IF(IDIM.EQ.3) THEN
  289. LRES=MIN0(INT1,100)
  290. ELSE
  291. LRES=MIN0(INT1,1000)
  292. ENDIF
  293. ELSE
  294. IF(IDIM.EQ.3) THEN
  295. LRES=50
  296. ELSE
  297. LRES=200
  298. ENDIF
  299. ENDIF
  300. * write(6,*) ' lres ' , lres
  301.  
  302.  
  303. * IF (MABS) THEN
  304. * CALL LIRREE(FLO2,0,IRETO2)
  305. * CALL LIRREE(FLO1,0,IRETOU)
  306. * IF(FLO2.LT.(-1.D-5)) THEN
  307. * EXTINC = -FLO2
  308. * ELSE
  309. * EXTINC = -FLO1
  310. * FLO1 = FLO2
  311. * IRETOU=IRETO2
  312. * ENDIF
  313. * ELSE
  314. * CALL LIRREE(FLO1,0,IRETOU)
  315. * ENDIF
  316. * IF (IRETOU.NE.0) THEN
  317. * IF(IDIM.EQ.3) THEN
  318. * XDEC=MIN(FLO1,2.D0)
  319. * ELSE
  320. * XDEC=MIN(FLO1,10.D0)
  321. * ENDIF
  322. * ELSE
  323. IF(IDIM.EQ.3) THEN
  324. XDEC=0.5
  325. ELSE
  326. XDEC=5.D0
  327. ENDIF
  328. * ENDIF
  329. * write(6,*) ' xdec ' , xdec
  330. C
  331. C
  332. IF (IDIM.EQ.3) THEN
  333. * write(6,*) ' appel a facgen'
  334. * write(6,*) LRES,XDEC,IAXE,KNOR,EXTINC
  335. CALL FACGEN(MYMOD,INFOEL,LRES,XDEC,IAXE,KNOR,ICHFAC,EXTINC)
  336. ELSE
  337. * write(6,*) ' appel a facge2'
  338. * write(6,*) LRES,XDEC,IAXE,KNOR,EXTINC
  339. * write(6,*) ( kcoq(iou),kquad(iou),iou=1,kcoq(/1))
  340.  
  341. CALL FACGE2(MYMOD,INFOEL,LRES,XDEC,IAXE,KNOR,ICHFAC,EXTINC)
  342. ENDIF
  343. IF (IAXE.NE.0) SEGSUP IAXE
  344. C
  345. GOTO 900
  346. C
  347. C********************
  348. C CAS AXISYMETRIQUE
  349. C********************
  350. C
  351.  
  352. 300 CONTINUE
  353.  
  354. C valeurs par defaut
  355.  
  356. NGAX=10
  357. NPAX=20
  358.  
  359. CALL LIRENT(INT1,0,IRETO1)
  360. CALL LIRENT(INT2,0,IRETO2)
  361.  
  362. IF (IRETO2.NE.0) THEN
  363. NGAX = MIN0(INT1,10)
  364. NPAX = MIN0(INT2,1000)
  365. ELSEIF (MGAUS) THEN
  366. NPAX = MIN0(INT1,1000)
  367. ELSEIF (IRETO1.NE.0) THEN
  368. NGAX=MIN0(INT1,10)
  369. ENDIF
  370.  
  371. C WRITE(6,*) ' FFOR NG NP ',NGAX,NPAX
  372.  
  373. IF (MCVX) THEN
  374. KACHE = 0
  375. ELSE
  376. KACHE = 1
  377. ENDIF
  378. C
  379. IF(MABS) THEN
  380. CALL LIRREE(FLO1,0,IRETOU)
  381. IF (IRETOU.NE.0) THEN
  382. EXTINC=-FLO1
  383. ENDIF
  384. ENDIF
  385.  
  386. CALL FACAXI(MYMOD,INFOEL,NPAX,NGAX,KACHE,KNOR,ICHFAC,EXTINC)
  387. C
  388. C**********************************************************
  389. C
  390. 900 SEGSUP ,INFOEL
  391. segact mymod
  392. mchelm=ICHFAC
  393. segact mchelm*mod
  394. do i=1,mymod.kmodel(/1)
  395. imodel=mymod.kmodel(i)
  396. segact imodel
  397. conche(i)=conmod
  398. enddo
  399. C Ecriture du chamelem facteur de forme
  400. * CALL ECROBJ('MCHAML ',ICHFAC)
  401. END
  402.  
  403.  
  404.  
  405.  
  406.  

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