Télécharger la plaquette Cast3M


fr en

Télécharger flumas.eso

Retour à la liste

Numérotation des lignes : 

flumas

  1. C FLUMAS    SOURCE    CB215821  24/04/12    21:16:00     11897          
  2.  
  3. C=======================================================================
  4. C=                            F L U M A S                              =
  5. C=                            -----------                              =
  6. C=                                                                     =
  7. C=  Fonction :                                                         =
  8. C=  ----------                                                         =
  9. C=   Calcul des flux nodaux equivalents a une condition de FLUX IMPOSE =
  10. C=   pour des elements de type MASSIF (1D, 2D, 3D)                     =
  11. C=   Sous-programme appele par FLUX2 (flux2.eso)                       =
  12. C=                                                                     =
  13. C=  Parametres :  (E)=Entree (S)=Sortie                                =
  14. C=  ------------                                                       =
  15. C=   IPMODE   (E)   Pointeur sur le segment MMODEL                     =
  16. C=   IPGEOM   (E)   Objet MAILLAGE support de IPCHPO                   =
  17. C=   IPCHPO   (E)   Pointeur sur le CHPOINT (ou le MCHAML) de flux     =
  18. C=                  imposes aux noeuds de la structure                 =
  19. C=                  (champ variable ou constant)                       =
  20. C=   NUMPOI   (E)   Vaut -1 si le flux impose est normal a la surface, =
  21. C=                  sinon pointeur sur un POINT correspondant a la     =
  22. C=                  direction du flux (par rapport au repere global)   =
  23. C=   MOCOMP   (E)   Nom de la composante du champ de flux equivalents  =
  24. C=   MLMOTX   (E)   Pointeur MLMOTS de la liste des composantes de     =
  25. C=                  IPCHPO associees aux 3 directions x,y,z.           =
  26. C=   IPFLUX   (S)   Pointeur sur le champ des flux nodaux equivalents  =
  27. C=                                                                     =
  28. C=  Variables locales :                                                =
  29. C=  -------------------                                                =
  30. C=   ITGEOM   Pointeur sur un MAILLAGE elementaire du MASSIF           =
  31. C=   IPENVE   Pointeur sur l'enveloppe d'un maillage MASSIF            =
  32. C=   IPGEOM   Pointeur sur un MAILLAGE elementaire du CHPOINT          =
  33. C=   IPOGEO   Pointeur sur un MAILLAGE commun au CHPOINT et au MASSIF  =
  34. C=                                                                     =
  35. C=  Denis ROBERT, le 1er fevrier 1988.                                 =
  36. C=======================================================================
  37.  
  38.       SUBROUTINE FLUMAS (IPMODE,IPGEOM,IPCHPO,NUMPOI,NOMCQ,MLMOTX,
  39.      &                   IPFLUX)
  40.  
  41.       IMPLICIT INTEGER(I-N)
  42.       IMPLICIT REAL*8 (A-H,O-Z)
  43.  
  44.  
  45. -INC PPARAM
  46. -INC CCOPTIO
  47. -INC CCHAMP
  48. -INC CCREEL
  49. -INC SMCHAML
  50. -INC SMCHPOI
  51. -INC SMMODEL
  52. -INC SMELEME
  53. -INC SMCOORD
  54. -INC SMLMOTS
  55.  
  56.       CHARACTER*(*) NOMCQ
  57.  
  58.       PARAMETER (XUn=1.)
  59.  
  60.       DIMENSION IVAL(4)
  61.       CHARACTER*(LOCOMP) IMOT1,IMOT2
  62.  
  63. C= Activation du MMODEL
  64.       MMODEL=IPMODE
  65.       NSOU=KMODEL(/1)
  66. C= Activation de MLMOTX si defini
  67.       NINC = 0
  68.       IF (MLMOTX.NE.0) THEN
  69.         MLMOTS=MLMOTX
  70.         SEGACT,MLMOTS
  71.         NINC = MOTS(/2)
  72.       ENDIF
  73.  
  74. C  BOUCLE SUR LES ZONES ELEMENTAIRES DU MODELE
  75. C =============================================
  76.       idimp1=IDIM+1
  77.       IRRT=0
  78.  
  79.       DO ISOU=1,NSOU
  80.  
  81.         IPCHEL=0
  82.         IMODEL=KMODEL(ISOU)
  83.         NEF=NEFMOD
  84.  
  85. * Determination de l'ENVELOPPE du MASSIF
  86.         ITGEOM=IMAMOD
  87.         CALL ECROBJ('MAILLAGE',ITGEOM)
  88.         IF (IDIM.EQ.3) THEN
  89.           CALL ENVELO
  90.         ELSE IF (IDIM.EQ.2) THEN
  91.           CALL PRCONT
  92.         ELSE IF (IDIM.EQ.1) THEN
  93.           CALL PREX1D
  94.         ENDIF
  95.         CALL LIROBJ('MAILLAGE',IPENVE,1,IRET)
  96.         CALL ACTOBJ('MAILLAGE',IPENVE,1)
  97.         IF (IERR.NE.0) GOTO 9900
  98.  
  99. *  ON RECUPERE LES MAILLAGES ELEMENTAIRES DE L'ENVELOPPE
  100. *  APPUYES STRICTEMENT SUR LE CHPOINT DE FLUX
  101.         CALL ECROBJ('MAILLAGE',IPGEOM)
  102.         CALL ECRCHA('STRI')
  103.         CALL ECRCHA('APPU')
  104.         CALL ECROBJ('MAILLAGE',IPENVE)
  105.         CALL EXTREL(IRR,0,i)
  106.  
  107. *  Pas DE MAILLAGE COMMUN A CETTE PARTIE DE L'ENVELOPPE ET DU CHPOINT
  108.         IF (IRR.EQ.1) THEN
  109.           IRRT=IRRT+1
  110.           GOTO 9900
  111.         ENDIF
  112.  
  113. *  IL Y A DES MAILLAGES COMMUNS AU CHPOINT ET A L'ENVELOPPE
  114.         CALL LIROBJ('MAILLAGE',IPOGEO,1,IRET)
  115.         CALL ACTOBJ('MAILLAGE',IPOGEO,1)
  116.         IF (IERR.NE.0) GOTO 9900
  117. *  ON DESIRE CONNAITRE LES CARACTERISTIQUES DE CES MAILLAGES
  118.         IPT3=IPOGEO
  119.         SEGACT,IPT3
  120.         NSOU3=IPT3.LISOUS(/1)
  121.         IF (NSOU3.EQ.0) NBN2=IPT3.NUM(/1)
  122.  
  123. *  BOUCLE SUR LES ZONES DE CET OBJET GEOMETRIQUE
  124.         DO IMAIL=1,MAX(1,NSOU3)
  125.           IF (NSOU3.NE.0) THEN
  126.             IPT2=IPT3.LISOUS(IMAIL)
  127.             SEGACT,IPT2
  128.             IPOGEO=IPT2
  129.             NBN2=IPT2.NUM(/1)
  130.           ENDIF
  131. *    RECHERCHE DE LA FORMULATION DES (SUR)FACES POUR LES MASSIF
  132.           CALL FLUX3(NEF,NBN2,NEFACE)
  133. * IMPOSSIBLE D'UTILISER L'OPERATEUR FLUX POUR LES ELEMENTS DE TYPE NEF
  134.           IF (NEFACE.EQ.0) THEN
  135.             MOTERR(1:4)=NOMTP(NEF)
  136.             CALL ERREUR(407)
  137.             GOTO 9901
  138.           ENDIF
  139. *      RECUPERATION DES CARACTERISTIQUES D'INTEGRATION
  140.           CALL TSHAPE(NEFACE,'GAUSS',IPINTE)
  141. *       ECHEC DANS L'ACQUISITION DES CARACTERISTIQUES D'INTEGRATION
  142.           IF (IERR.NE.0) GOTO 9901
  143.  
  144. *   ON GENERE UN CHAMELEM ELEMENTAIRE DE FLUX
  145. *   A PARTIR DU MAILLAGE ELEMENTAIRE DE POINTEUR IPOGEO
  146. *   ET DU CHPOINT
  147.           if (IPCHPO.gt.0) then
  148.             CALL CHAME1(IPOGEO,0,IPCHPO,' ',ICHELF,6)
  149.           else
  150. *ou ET DU MCHAML
  151.             ICHE = -1*IPCHPO
  152.             CALL REDUIC(ICHE,IPOGEO,ICHELF)
  153.           endif
  154.           MCHEL1=ICHELF
  155.           IF (IERR.NE.0) GOTO 9901
  156.           MCHAM1=MCHEL1.ICHAML(1)
  157.           NBCOMP=MCHAM1.IELVAL(/1)
  158.           IF (NBCOMP.EQ.1) THEN
  159.             IPFLOD=MCHAM1.IELVAL(1)
  160.           ELSE
  161. C POUR CHAQUE ELEMENT,
  162. C ON DETERMINE UN VECTEUR DIRIGE VERS L INTERIEUR DU MASSIF
  163. C A PARTIR D UN POINT DE LA FACE ET DU CENTRE DE GRAVITE DU MASSIF
  164. C ON COPIE LE CHAMP EN AJOUTANT UNE COMPOSANTE
  165.             IF (MLMOTX.EQ.0) THEN
  166.               MOTERR(1:8)='LISTMOTS'
  167.               CALL ERREUR(37)
  168.               GOTO 9901
  169.             ENDIF
  170.             MLMOTS=MLMOTX
  171.             MELVAL=MCHAM1.IELVAL(1)
  172.             N1PTEL=VELCHE(/1)
  173.             N1EL=VELCHE(/2)
  174.             N2PTEL=0
  175.             N2EL=0
  176.             NBCOMP=IDIM
  177.             N2=NBCOMP+IDIM
  178.             SEGINI,MCHAML
  179.               IPFLOD=MCHAML
  180.               DO I=1,N2
  181.                 SEGINI,MELVAL
  182.                 IELVAL(I)=MELVAL
  183.               ENDDO
  184.               DO I=1,NINC
  185.                 IMOT1=MOTS(i)
  186.                 DO J=1,NINC
  187.                   IMOT2=MCHAM1.NOMCHE(J)
  188.                   IF (IMOT1.EQ.IMOT2) IVAL(I)=J
  189.                 ENDDO
  190.               ENDDO
  191.               DO I=1,NBCOMP
  192.                 MELVA1=MCHAM1.IELVAL(IVAL(I))
  193.                 MELVAL=IELVAL(I)
  194.                 DO j=1,N1EL
  195.                   DO k=1,N1PTEL
  196.                     VELCHE(k,j)=MELVA1.VELCHE(k,j)
  197.                   ENDDO
  198.                 ENDDO
  199.               ENDDO
  200.  
  201.               NBPTE1=N1PTEL
  202.               NEL1=N1EL
  203.               NUMPOI=1
  204.               MELEME=IPOGEO
  205.               IPT1=ITGEOM
  206.               NBMA1=NUM(/1)
  207.               DO IEF=1,NUM(/2)
  208.                 DO IEM=1,IPT1.NUM(/2)
  209.                   JNE=0
  210.                   DO INM=1,IPT1.NUM(/1)
  211.                     DO INF=1,NBMA1
  212.                       IF (IPT1.NUM(INM,IEM).EQ.NUM(INF,IEF)) JNE=JNE+1
  213.                     ENDDO
  214.                   ENDDO
  215.                   IF (JNE.EQ.NBMA1) GOTO 170
  216.                 ENDDO
  217.                 DO j=1,N2
  218.                   MELVAL=IELVAL(j)
  219.                   SEGSUP,MELVAL
  220.                 ENDDO
  221.  
  222.                 CALL ERREUR(21)
  223.                 GOTO 9901
  224. C      CDG element de "volume"
  225. C      CDG de la "face"
  226. C      Calcul de la normale interieure (stocker dans MCHAML)
  227.  170            NBM=IPT1.NUM(/1)
  228.                 IF (IDIM.EQ.2) THEN
  229.                   XG=XZero
  230.                   YG=XZero
  231.                   DO INM=1,NBM
  232.                     IREFM=(IPT1.NUM(INM,IEM)-1)*idimp1
  233.                     XG=XG+XCOOR(IREFM+1)
  234.                     YG=YG+XCOOR(IREFM+2)
  235.                   ENDDO
  236.                   XG=XG/NBM
  237.                   YG=YG/NBM
  238.                   XK=XZero
  239.                   YK=XZero
  240.                   DO INF=1,NBMA1
  241.                     IREFF=(NUM(INF,IEF)-1)*idimp1
  242.                     XK=XK+XCOOR(IREFF+1)
  243.                     YK=YK+XCOOR(IREFF+2)
  244.                   ENDDO
  245.                   XK=XK/NBMA1
  246.                   YK=YK/NBMA1
  247.                   V1=XG-XK
  248.                   V2=YG-YK
  249.                   VN=SQRT(V1*V1+V2*V2)
  250.                   V1=V1/VN
  251.                   V2=V2/VN
  252.                   DO INF=1,NBMA1
  253.                     MELVAL=IELVAL(NBCOMP+1)
  254.                     VELCHE(INF,IEF)=V1
  255.                     MELVAL=IELVAL(NBCOMP+2)
  256.                     VELCHE(INF,IEF)=V2
  257.                   ENDDO
  258.                 ELSE IF (IDIM.EQ.3) THEN
  259.                   XG=XZero
  260.                   YG=XZero
  261.                   ZG=XZero
  262.                   DO INM=1,NBM
  263.                     IREFM=(IPT1.NUM(INM,IEM)-1)*idimp1
  264.                     XG=XG+XCOOR(IREFM+1)
  265.                     YG=YG+XCOOR(IREFM+2)
  266.                     ZG=ZG+XCOOR(IREFM+3)
  267.                   ENDDO
  268.                   XG=XG/NBM
  269.                   YG=YG/NBM
  270.                   ZG=ZG/NBM
  271.                   XK=XZero
  272.                   YK=XZero
  273.                   ZK=XZero
  274.                   DO INF=1,NBMA1
  275.                     IREFF=(NUM(INF,IEF)-1)*idimp1
  276.                     XK=XK+XCOOR(IREFF+1)
  277.                     YK=YK+XCOOR(IREFF+2)
  278.                     ZK=ZK+XCOOR(IREFF+3)
  279.                   ENDDO
  280.                   XK=XK/NBMA1
  281.                   YK=YK/NBMA1
  282.                   ZK=ZK/NBMA1
  283.                   V1=XG-XK
  284.                   V2=YG-YK
  285.                   V3=ZG-ZK
  286.                   VN=SQRT(V1*V1+V2*V2+V3*V3)
  287.                   V1=V1/VN
  288.                   V2=V2/VN
  289.                   V3=V3/VN
  290.                   DO INF=1,NBMA1
  291.                     MELVAL=IELVAL(NBCOMP+1)
  292.                     VELCHE(INF,IEF)=V1
  293.                     MELVAL=IELVAL(NBCOMP+2)
  294.                     VELCHE(INF,IEF)=V2
  295.                     MELVAL=IELVAL(NBCOMP+3)
  296.                     VELCHE(INF,IEF)=V3
  297.                   ENDDO
  298.                 ELSE IF (IDIM.EQ.1) THEN
  299.                   XG=XZero
  300.                   DO INM=1,NBM
  301.                     IREFM=(IPT1.NUM(INM,IEM)-1)*idimp1
  302.                     XG=XG+XCOOR(IREFM+1)
  303.                   ENDDO
  304.                   XG=XG/NBM
  305.                   XK=XZero
  306.                   DO INF=1,NBMA1
  307.                     IREFF=(NUM(INF,IEF)-1)*idimp1
  308.                     XK=XK+XCOOR(IREFF+1)
  309.                   ENDDO
  310.                   XK=XK/NBMA1
  311.                   V1=XG-XK
  312.                   V1=V1/ABS(V1)
  313.                   DO INF=1,NBMA1
  314.                     MELVAL=IELVAL(NBCOMP+1)
  315.                     VELCHE(INF,IEF)=V1
  316.                   ENDDO
  317.                 ENDIF
  318.               ENDDO
  319.             ENDIF
  320. *   CHAMELEM ELEMENTAIRE DES FLUX NODAUX EQUIVALENTS
  321.             L1=7
  322.             N1=1
  323.             N3=1
  324.             SEGINI,MCHELM
  325.             IPCHEL=MCHELM
  326.             TITCHE='CHALEUR'
  327.             IFOCHE=IFOUR
  328.             INFCHE(1,1)=0
  329.             IMACHE(1)=IPOGEO
  330.             N2=1
  331.             SEGINI,MCHAML
  332.             ICHAML(1)=MCHAML
  333.             NOMCHE(1)='FLUX'
  334.             TYPCHE(1)='REAL*8'
  335. *   CALCUL DES FLUX NODAUX EQUIVALENTS
  336. *   FACES ASSOCIEES SEG2 OU SEG3
  337.             IF (NEFACE.EQ.2.OR.NEFACE.EQ.3) THEN
  338.               CALL FLUMA2(IPFLOD,IPOGEO,IPINTE,NUMPOI,IPFLEQ)
  339. *   FACES ASSOCIEES TRI3,TRI6,QUA4 OU QUA8
  340.             ELSE IF (NEFACE.EQ. 4.OR.NEFACE.EQ.6.OR.NEFACE.EQ.8.OR.
  341.      .               NEFACE.EQ.10) THEN
  342.               CALL FLUMA3(IPFLOD,IPOGEO,IPINTE,NUMPOI,IPFLEQ)
  343. *   FACES ASSOCIEES POI1
  344.             ELSE IF (NEFACE.EQ.45) THEN
  345.               CALL FLUMA1(IPFLOD,IPOGEO,IPINTE,NUMPOI,IPFLEQ)
  346.             ENDIF
  347.             IF (NUMPOI.EQ.1) THEN
  348.               MCHAM2=IPFLOD
  349.               DO i=1,MCHAM2.IELVAL(/1)
  350.                 MELVAL=MCHAM2.IELVAL(i)
  351.                 SEGSUP,MELVAL
  352.               ENDDO
  353.               SEGSUP,MCHAM2
  354.             ENDIF
  355.             IF (IERR.NE.0) THEN
  356.               SEGSUP,MCHAML,MCHELM
  357.               GOTO 9901
  358.             ENDIF
  359.             IELVAL(1)=IPFLEQ
  360.  
  361. *     ON TRANSFORME LE CHAMELEM EN CHPOINT
  362.             CALL CHAMPO(IPCHEL,0,IPCH1,IDUM)
  363.             MCHPOI=IPCH1
  364.             DO i=1,IPCHP(/1)
  365.               MSOUPO=IPCHP(i)
  366.               NOCOMP(1)=nomcq
  367.             ENDDO
  368.  
  369.             CALL DTCHEL(IPCHEL)
  370. *    ON REGROUPE,LE CAS ECHEANT,LES DIFFERENTS CHPOINTS
  371.             IF ((ISOU-IRRT).GT.1.OR.IMAIL.GT.1) THEN
  372.               CALL ADCHPO(IPCH1,IPFLUX,IRET,XUn,XUn)
  373.               IF (IRET.EQ.0) GOTO 9901
  374. C*            CALL ECRCHA('GEOM')
  375.               CALL DTCHPO(IPCH1)
  376. C*            CALL ECRCHA('GEOM')
  377.               CALL DTCHPO(IPFLUX)
  378.               IPFLUX=IRET
  379.             ELSE
  380.               IPFLUX=IPCH1
  381.             ENDIF
  382.           ENDDO
  383.  9901   CONTINUE
  384.  9900   CONTINUE
  385.         IF (IERR.NE.0) GOTO 9999
  386.       ENDDO
  387.  
  388. * IL N'EXISTE PAS D'ELEMENTS COMMUNS AU CHPOINT DES FLUX NODAUX
  389. * ET A L'ENVELOPPE DU MASSIF
  390.       IF (IRRT.EQ.NSOU) CALL ERREUR(408)
  391.  
  392.  9999 CONTINUE
  393.  
  394.       END
  395.  
  396.  
  397.  
  398.  
  399.  
  400.  

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