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    OF166741  24/10/03    21:15:15     12022          
  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=6
  324.             SEGINI,MCHELM
  325.             IPCHEL=MCHELM
  326.             TITCHE='CHALEUR'
  327.             IFOCHE=IFOUR
  328.             IMACHE(1)=IPOGEO
  329.             CONCHE(1)=CONMOD
  330.             INFCHE(1,6)=1
  331.             N2=1
  332.             SEGINI,MCHAML
  333.             ICHAML(1)=MCHAML
  334.             NOMCHE(1)='FLUX'
  335.             TYPCHE(1)='REAL*8'
  336. *   CALCUL DES FLUX NODAUX EQUIVALENTS
  337. *   FACES ASSOCIEES SEG2 OU SEG3
  338.             IF (NEFACE.EQ.2.OR.NEFACE.EQ.3) THEN
  339.               CALL FLUMA2(IPFLOD,IPOGEO,IPINTE,NUMPOI,IPFLEQ)
  340. *   FACES ASSOCIEES TRI3,TRI6,QUA4 OU QUA8
  341.             ELSE IF (NEFACE.EQ. 4.OR.NEFACE.EQ.6.OR.NEFACE.EQ.8.OR.
  342.      .               NEFACE.EQ.10) THEN
  343.               CALL FLUMA3(IPFLOD,IPOGEO,IPINTE,NUMPOI,IPFLEQ)
  344. *   FACES ASSOCIEES POI1
  345.             ELSE IF (NEFACE.EQ.45) THEN
  346.               CALL FLUMA1(IPFLOD,IPOGEO,IPINTE,NUMPOI,IPFLEQ)
  347.             ENDIF
  348.             IF (NUMPOI.EQ.1) THEN
  349.               MCHAM2=IPFLOD
  350.               DO i=1,MCHAM2.IELVAL(/1)
  351.                 MELVAL=MCHAM2.IELVAL(i)
  352.                 SEGSUP,MELVAL
  353.               ENDDO
  354.               SEGSUP,MCHAM2
  355.             ENDIF
  356.             IF (IERR.NE.0) THEN
  357.               SEGSUP,MCHAML,MCHELM
  358.               GOTO 9901
  359.             ENDIF
  360.             IELVAL(1)=IPFLEQ
  361.  
  362. *     ON TRANSFORME LE CHAMELEM EN CHPOINT
  363.             CALL CHAMPO(IPCHEL,0,IPCH1,IDUM)
  364.             MCHPOI=IPCH1
  365.             DO i=1,IPCHP(/1)
  366.               MSOUPO=IPCHP(i)
  367.               NOCOMP(1)=nomcq
  368.             ENDDO
  369.  
  370.             CALL DTCHEL(IPCHEL)
  371. *    ON REGROUPE,LE CAS ECHEANT,LES DIFFERENTS CHPOINTS
  372.             IF ((ISOU-IRRT).GT.1.OR.IMAIL.GT.1) THEN
  373.               CALL ADCHPO(IPCH1,IPFLUX,IRET,XUn,XUn)
  374.               IF (IRET.EQ.0) GOTO 9901
  375. C*            CALL ECRCHA('GEOM')
  376.               CALL DTCHPO(IPCH1)
  377. C*            CALL ECRCHA('GEOM')
  378.               CALL DTCHPO(IPFLUX)
  379.               IPFLUX=IRET
  380.             ELSE
  381.               IPFLUX=IPCH1
  382.             ENDIF
  383.           ENDDO
  384.  9901   CONTINUE
  385.  9900   CONTINUE
  386.         IF (IERR.NE.0) GOTO 9999
  387.       ENDDO
  388.  
  389. * IL N'EXISTE PAS D'ELEMENTS COMMUNS AU CHPOINT DES FLUX NODAUX
  390. * ET A L'ENVELOPPE DU MASSIF
  391.       IF (IRRT.EQ.NSOU) CALL ERREUR(408)
  392.  
  393.  9999 CONTINUE
  394.  
  395.       END
  396.  
  397.  
  398.  

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