Télécharger la plaquette Cast3M


fr en

Télécharger facaxi.eso

Retour à la liste

Numérotation des lignes : 

facaxi

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

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