Télécharger la plaquette Cast3M


fr en

Télécharger flucoq.eso

Retour à la liste

Numérotation des lignes : 

flucoq

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

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