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    CB215821  24/04/12    21:15:54     11897          
  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.  
  333.  

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