Télécharger facaxi.eso

Retour à la liste

Numérotation des lignes :

facaxi
  1. C FACAXI SOURCE MB234859 21/11/22 21:15:01 11194
  2. SUBROUTINE FACAXI (MYMOD,INFOEL,NPAX,NGAX,KACHE,INOR,ICHFAC
  3. & ,EXTINC)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. C
  7. LOGICAL ICOQ,BTHRD
  8. C----------------------------------------------------------------------
  9. C SP appele par FFORME
  10. C
  11. C Calcul des facteurs de forme en axisymetrique
  12. C Entree :
  13. C MYMOD : pointeur de l'objet modèle
  14. C INFOEL : utile pour les coques ou quadratiques
  15. C NPAX : nombre de points d integration (disc.reguliere)
  16. C NGAX : nombre de points de Gauss
  17. C KACHE : 0 si option convexe, sinon option cache
  18. C INOR : 1 si normalisation, 0 sinon
  19. C EXTINC : coefficient d'extinction (si cavite absorbante)
  20. C sortie:
  21. C ICHFAC : pointeur sur l'objet MCHAML resultat
  22. C
  23. C----------------------------------------------------------------------
  24. C traitement des coques par dedoublement des elements a partir
  25. C de la normale
  26. C ->
  27. C A (inverse) = A - e*n (e=1e-3)
  28. C cas des boucles 1 sur k1 et 2 sur k2
  29. C mais pas de la boucle 3 obstructeurs
  30. C
  31. C bcl face k1
  32. C ** face k1 **
  33. C bcl face k2
  34. C .. face k2 ..
  35. C bcl 3 obstructeurs
  36. C .. si coq: inverse face k2 ..
  37. C les obstructeurs sont les memes que pour k2
  38. C fin bcl face k2
  39. C
  40. C ** si coq : inverse face k1 **
  41. C bcl face k2
  42. C .. face k2 ..
  43. C bcl 3 obstructeurs
  44. C .. si coq: inverse face k2 ..
  45. C les obstructeurs sont les memes que pour k2
  46. C fin bcl face k2
  47. C fin bcl face k1
  48. C
  49. C Ajout de la parallelisation par les threads
  50. C Le travail sur chaque face k1 est realise dans la subroutine FFAXCA
  51. C----------------------------------------------------------------------
  52. C
  53. -INC CCREEL
  54. -INC SMELEME
  55. -INC SMMODEL
  56.  
  57. -INC PPARAM
  58. -INC CCOPTIO
  59. -INC SMCOORD
  60. POINTEUR MYMOD.MMODEL
  61. -INC CCASSIS
  62. C Declaration du COMMON pour le travail en parallele
  63. COMMON/FAFORM/IPARAL
  64. EXTERNAL FFAXCi
  65. C
  66. C SEGMENT POUR LA PARALLELISATION
  67. SEGMENT SPARAL
  68. INTEGER NBTHRD
  69. INTEGER IAFAIR(NBEL2)
  70. INTEGER IMYMOD,ISEGEL,KNPAX,KNGAX,KKACHE,IIFACFO
  71. INTEGER KITYP,KNELT1,IWRKTH
  72. REAL*8 XEXTINC,XRAD
  73. LOGICAL BICOQ
  74. ENDSEGMENT
  75. C
  76. C----------------------------------------------------------------------
  77. SEGMENT , INFOEL
  78. LOGICAL KCOQ(N1),KQUAD(N1)
  79. ENDSEGMENT
  80. C----------------------------------------------------------------------
  81. C FACTEURS DE FORME
  82. C NNBEL1 = NOMBRE DE LIGNES + 1
  83. C NBEL2 = NOMBRE DE COLONNES
  84. C LFACT(NNBEL1) POINTE SUR LE TABLEAU DES SURFACES
  85. C
  86. SEGMENT IFACFO
  87. INTEGER LFACT(NNBEL1)
  88. ENDSEGMENT
  89. SEGMENT LFAC
  90. REAL*8 FACT(NBEL2)
  91. ENDSEGMENT
  92. POINTEUR PSUR.LFAC, PLIG.LFAC
  93. POINTEUR PCOL.LFAC
  94. C----------------------------------------------------------------------
  95. C coordonnees des obstructeurs
  96. SEGMENT SFOBS
  97. REAL*8 OBS(2,NTOBS)
  98. ENDSEGMENT
  99. C----------------------------------------------------------------------
  100. SEGMENT STRAV
  101. REAL*8 A1(NA,NA),A2(NA,NA),A3(NA,NA),AA2(NA,NA)
  102. REAL*8 U1(NA1),U2(NA1),UU2(NA1)
  103. ENDSEGMENT
  104. C----------------------------------------------------------------------
  105. SEGMENT SEGTH
  106. INTEGER SSFOBS(NTHRD)
  107. INTEGER SSTRAV(NTHRD)
  108. ENDSEGMENT
  109. C
  110. EPS = 1D-5
  111. KIMP = IIMPI
  112. NES = IDIM
  113.  
  114. C... critere de dedoublement des coques
  115. ECOQ=1.D-3
  116. IF (INFOEL.EQ.0) THEN
  117. ICOQ = .FALSE.
  118. ELSE
  119. ICOQ = .TRUE.
  120. SEGACT INFOEL
  121. ENDIF
  122. C... quadratique
  123. NSPA1=1
  124. NSPA2=1
  125. NSPA3=1
  126. NS=2
  127.  
  128. RAD = 0
  129. C
  130. C Calcul du nombre de faces NFACE et du rayon RAD
  131. SEGACT MYMOD
  132. NTYP = MYMOD.KMODEL(/1)
  133. NFACE = 0
  134. DO 10 ITYP=1,NTYP
  135. IMODEL = MYMOD.KMODEL(ITYP)
  136. SEGACT IMODEL
  137. IPT1 = IMAMOD
  138. SEGACT IPT1
  139. NEL = IPT1.NUM(/2)
  140. NSGEO = IPT1.NUM(/1)
  141. C Recherche du max sur Ox
  142. DO 5 IEL = 1,NEL
  143. DO 6 IPT = 1,NSGEO
  144. IREF = (IDIM+1)*(IPT1.NUM(IPT,IEL)-1)
  145. VALX = XCOOR(IREF+1)
  146. IF (VALX.GT.RAD) RAD = VALX
  147. 6 CONTINUE
  148. 5 CONTINUE
  149. IF (ICOQ.AND.KCOQ(ITYP)) THEN
  150. NFACE = NFACE + 2 * NEL
  151. ELSE
  152. NFACE = NFACE + NEL
  153. ENDIF
  154. 10 CONTINUE
  155. C
  156. IF (KIMP.GE.3) THEN
  157. WRITE( 6,*) ' DIMENSIONNEMENT : RAD =',RAD
  158. WRITE( 6,*) ' NOMBRE TOTAL DE FACES ',NFACE
  159. ENDIF
  160. C
  161. C>>> FAUT-IL PARALLELISER AVEC LES THREADS
  162. C -------------------------------------
  163. NBTHR = NBTHRS
  164. BTHRD = .TRUE.
  165. C
  166. ITH = 0
  167. IF (NBESC.NE.0) ITH=oothrd
  168. IF ((NBTHRS.EQ.1).OR.(ITH.GT.0)) THEN
  169. NBTHR = 1
  170. BTHRD = .FALSE.
  171. ENDIF
  172. CC WRITE(*,*) 'NBTHRD=',NBTHR,'BTHRD=',BTHRD,'NBESC=',NBESC
  173. C
  174. C>>> INITIALISATION SFOBS et STRAV
  175. C -----------------------------
  176. NTHRD=NBTHR
  177. SEGINI,SEGTH
  178. NA=2
  179. NA1=3
  180. DO IITH = 1,NTHRD
  181. IF(KACHE.NE.0) THEN
  182. NTOBS = 2*NFACE
  183. SEGINI SFOBS
  184. SSFOBS(IITH)=SFOBS
  185. ENDIF
  186. SEGINI STRAV
  187. SSTRAV(IITH)=STRAV
  188. ENDDO
  189. C
  190. C>>> INITIALISATION OBJET FACFOR
  191. C ---------------------------
  192. NNBEL1=NFACE+1
  193. NBEL2=NFACE
  194. SEGINI IFACFO
  195. DO 900 LS=1,NNBEL1
  196. SEGINI PLIG
  197. LFACT(LS)=PLIG
  198. SEGACT PLIG*MOD
  199. 900 CONTINUE
  200. PSUR = LFACT(NNBEL1)
  201. SEGACT PSUR*MOD
  202. C
  203. C -------------------------------------------------------------
  204. C>> BOUCLE FACE 1
  205. C
  206. IF (BTHRD) THEN
  207. CALL THREADII
  208. ENDIF
  209. C
  210. NELT1= 0
  211. DO 100 ITYP = 1,NTYP
  212. C
  213. C Initialisation segment thread
  214. SEGINI,SPARAL
  215. SPARAL.NBTHRD = NBTHR
  216. SPARAL.IMYMOD = MYMOD
  217. SPARAL.ISEGEL = INFOEL
  218. SPARAL.KNPAX = NPAX
  219. SPARAL.KNGAX = NGAX
  220. SPARAL.KKACHE = KACHE
  221. SPARAL.IIFACFO = IFACFO
  222. SPARAL.KITYP = ITYP
  223. SPARAL.KNELT1 = NELT1
  224. SPARAL.IWRKTH = SEGTH
  225. SPARAL.XEXTINC = EXTINC
  226. SPARAL.XRAD = RAD
  227. SPARAL.BICOQ = ICOQ
  228. C
  229. IF (BTHRD) THEN
  230. C Remplissage du COMMON/FAFORME/
  231. IPARAL=SPARAL
  232. DO ith=2,NBTHR
  233. CALL THREADID(ith,FFAXCi)
  234. ENDDO
  235. CALL FFAXCi(1)
  236.  
  237. C Attente de la fin de tous les threads en cours de travail
  238. DO ith=2,NBTHR
  239. CALL THREADIF(ith)
  240. ENDDO
  241. C
  242. C On complete les trous dans la raquette
  243. DO 13 ICMP = 1,NBEL2
  244. NBK = IAFAIR(ICMP)
  245. IF (NBK.NE.0) THEN
  246. S1 = PSUR.FACT(ICMP)
  247. PLIG = LFACT(ICMP)
  248. DO 14 IREC = 1,NBK
  249. S2=PSUR.FACT(IREC)
  250. PCOL=LFACT(IREC)
  251. PLIG.FACT(IREC)=(S2/S1)*PCOL.FACT(ICMP)
  252. 14 CONTINUE
  253. ENDIF
  254. 13 CONTINUE
  255. C
  256. SEGSUP,SPARAL
  257. C
  258. ELSE
  259. C Appel de la SUBROUTINE qui fait le travail
  260. CALL FFAXCA(1,SPARAL)
  261. ENDIF
  262. C
  263. IF (ICOQ.AND.KCOQ(ITYP)) THEN
  264. NELT1 = NELT1 + 2 * NEL1
  265. ELSE
  266. NELT1 = NELT1 + NEL1
  267. ENDIF
  268. C
  269. 100 CONTINUE
  270. C
  271. C -------------------------------------------------------------
  272. C
  273. C On libere les Threads
  274. IF (BTHRD) THEN
  275. CALL THREADIS
  276. ENDIF
  277. C
  278. C Desactivation des maillages elementaires
  279. DO 920 ITYP = 1,NTYP
  280. IMODEL = MYMOD.KMODEL(ITYP)
  281. IPT1 = IMAMOD
  282. SEGDES IPT1
  283. SEGDES IMODEL
  284. 920 CONTINUE
  285. SEGDES MYMOD
  286.  
  287. C>>> SURFACES DIMENSIONNEES
  288. C ----------------------
  289. DO 910 LS=1,NFACE
  290. PSUR.FACT(LS)=PSUR.FACT(LS)*RAD*RAD
  291. 910 CONTINUE
  292. C
  293. C>>> NORMALISATION,CACUL DES BILANS ET IMPRESSION
  294. C --------------------------------------------
  295. IF(EXTINC.GT.1D-3) THEN
  296. INOR=0
  297. ENDIF
  298.  
  299. CALL KFN(IFACFO,INOR,KIMP)
  300.  
  301. C Traduction puis suppression de IFACFO
  302.  
  303. IF (KIMP.GE.3) THEN
  304. CALL PRFACF(IFACFO)
  305. ENDIF
  306.  
  307. LTITR=1
  308. CALL FFMCHA(MYMOD,INFOEL,IFACFO,ICHFAC,LTITR)
  309.  
  310. C>>> MENAGE AVANT DE QUITTER LA SOURCE
  311. C ---------------------------------
  312. SEGACT IFACFO
  313. DO 930 NNEL = 1,LFACT(/1)
  314. LFAC = LFACT(NNEL)
  315. SEGSUP LFAC
  316. 930 CONTINUE
  317. SEGSUP IFACFO
  318. C
  319. DO 940 IITH = 1,NTHRD
  320. IF(KACHE.NE.0) THEN
  321. SFOBS=SSFOBS(IITH)
  322. SEGSUP,SFOBS
  323. ENDIF
  324. STRAV=SSTRAV(IITH)
  325. SEGSUP,STRAV
  326. 940 CONTINUE
  327. SEGSUP,SEGTH
  328. C
  329. RETURN
  330. END
  331.  
  332.  

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