Télécharger la plaquette Cast3M


fr en

Télécharger chabat.eso

Retour à la liste

Numérotation des lignes : 

chabat

  1. C CHABAT    SOURCE    CB215821  24/04/12    21:15:12     11897          
  2.  
  3. C=======================================================================
  4. C=                            C H A B A T                              =
  5. C=                            -----------                              =
  6. C=                                                                     =
  7. C=  Fonction :                                                         =
  8. C=  ----------                                                         =
  9. C=   Calcul des flux equivalents a des sources volumiques dans le cas  =
  10. C=   des elements BARRE (THERMIQUE) et TUYAU (ADVECTION)               =
  11. C=                                                                     =
  12. C=  Parametres :  (E)=Entree  (S)=Sortie                               =
  13. C=  ------------                                                       =
  14. C=   IPMODL  (E)   Pointeur du MMODEL a traiter                        =
  15. C=   IFORMU  (E)   Entier indiquant la formulation du modele a traiter =
  16. C=   IPCHSO  (E)   Pointeur du MCHAML de sources                       =
  17. C=   IPCHEB  (E)   Pointeur du MCHAML de CARACTERISTIQUES              =
  18. C=                 (necessaire pour les elements BARRes et TUYAux)     =
  19. C=   ISUPCH  (E)   Support des champs en entree                        =
  20. C=   IPCHAL  (S)   MCHAML aux noeuds des flux equivalents              =
  21. C=======================================================================
  22.  
  23.       SUBROUTINE CHABAT (IPMODL,IFORMU, IPCHSO,IPCHEB,ISUPCH, IPCHAL)
  24.  
  25.       IMPLICIT INTEGER(I-N)
  26.       IMPLICIT REAL*8 (A-H,O-Z)
  27.  
  28.  
  29. -INC PPARAM
  30. -INC CCOPTIO
  31. -INC CCREEL
  32.  
  33. -INC SMCOORD
  34. -INC SMCHAML
  35. -INC SMELEME
  36. -INC SMINTE
  37. -INC SMMODEL
  38.  
  39.       SEGMENT INFO
  40.         INTEGER INFELL(JG)
  41.       ENDSEGMENT
  42.  
  43.       SEGMENT MMAT1
  44.         REAL*8 XEL(3,NBPTEL),AEL(NBPTEL,NBPTEL)
  45.       ENDSEGMENT
  46.  
  47.       MMODEL = IPMODL
  48.       NSOU   = KMODEL(/1)
  49.  
  50.       MCHELM = IPCHAL
  51.       MCHEL1 = IPCHSO
  52.       NSZ1   = MCHEL1.IMACHE(/1)
  53.  
  54.       MCHEL2 = IPCHEB
  55.       NSZ2   = MCHEL2.IMACHE(/1)
  56.  
  57.       MMAT1  = 0
  58.  
  59. C  BOUCLE SUR LES ZONES ELEMENTAIRES DU MODELE (ISOU)
  60. C ====================================================
  61.       DO 100 ISOU = 1, NSOU
  62.  
  63. C  Modele elementaire ISOU
  64. C =====
  65.         IMODEL = mmodel.KMODEL(ISOU)
  66. C =====
  67. C  Recherche dans le MCHAML des sources (IPCHSO) de la sous-zone
  68. C  associee au modele elementaire ISOU (IMAMOD et CONMOD), puis
  69. C  recuperation des valeurs du champ elementaire de sources (MELVA1)
  70. C =====
  71.         MELVA1 = 0
  72.         DO is = 1, NSZ1
  73.           IF (MCHEL1.IMACHE(is).EQ.imodel.IMAMOD .AND.
  74.      &        MCHEL1.CONCHE(is).EQ.imodel.CONMOD) THEN
  75.             mchaml = MCHEL1.ICHAML(is)
  76. c il faudrait chercher la composante si le champ en a plus d'une.
  77.             MELVA1 = mchaml.IELVAL(1)
  78.             GOTO 10
  79.           ENDIF
  80.         ENDDO
  81.  10     CONTINUE
  82.         IF (MELVA1.EQ.0) GOTO 100
  83.  
  84. C =====
  85. C  Recherche dans le MCHMAL des caracteristiques (IPCHEB) du
  86. C  maillage (IMAMOD) associe au modele elementaire ISOU, puis
  87. C  recuperation du MCHAML elementaire associe (MELVA2)
  88. C =====
  89.         MELVA2 = 0
  90.         DO is = 1, NSZ2
  91.           IF (MCHEL2.IMACHE(is).EQ.imodel.IMAMOD .AND.
  92.      &        MCHEL2.CONCHE(is).EQ.imodel.CONMOD) THEN
  93.             mchaml = MCHEL2.ICHAML(is)
  94.             NCOELE = mchaml.NOMCHE(/2)
  95.             IPOSI = 0
  96.             CALL PLACE(mchaml.NOMCHE,NCOELE,IPOSI,'SECT')
  97.             IF (IPOSI.NE.0) THEN
  98.               MELVA2 = mchaml.IELVAL(IPOSI)
  99.             ENDIF
  100.             GOTO 20
  101.           ENDIF
  102.         ENDDO
  103.  20     CONTINUE
  104.         IF (MELVA2.EQ.0) THEN
  105.           MOTERR(1:4) = 'SECT'
  106.           MOTERR(5:8) = 'CARA'
  107.           CALL ERREUR(77)
  108.           GOTO 100
  109.         ENDIF
  110. C =====
  111. C  Informations sur l'element fini du modele ISOU
  112. C =====
  113.         NEF    = imodel.NEFMOD
  114.         MELEME = imodel.IMAMOD
  115. C* Rappel : diffusion = thermique (en attendant retour a "mecanique")
  116.         IF (IFORMU.EQ.1 .OR. IFORMU.EQ.2 .OR. IFORMU.EQ.3) THEN
  117.           CALL TSHAPE(NEF,'GAUSS',IPINTE)
  118.         ELSE
  119.           IF (imodel.INFMOD(/1).LT.2+ISUPCH) THEN
  120.             CALL ELQUOI(NEF,0,ISUPCH,ipinf,imodel)
  121.             IF (IERR.NE.0) GOTO 100
  122.             info   = ipinf
  123.             IPINTE = info.INFELL(11)
  124.             SEGSUP,info
  125.           ELSE
  126.             IPINTE = imodel.INFMOD(2+ISUPCH)
  127.           ENDIF
  128.         ENDIF
  129. C =====
  130. C  3.6 - Calcul des flux nodaux equivalents (segment MELVAL)
  131. C =====
  132. C  3.6.1 - Recuperation d'informations sur le maillage elementaire
  133.         MELEME = imodel.IMAMOD
  134.         NBPTEL = meleme.NUM(/1)
  135.         NBELT  = meleme.NUM(/2)
  136.  
  137. C  3.6.2 - Recuperation d'informations sur l'element fini du maillage
  138.         MINTE = IPINTE
  139.         NBPGAU = minte.POIGAU(/1)
  140. c*        NBNO   = minte.SHPTOT(/2)
  141.  
  142. C  3.6.3 - Activation du MCHAML contenant les valeurs des sources
  143.         NBPTE1 = MELVA1.VELCHE(/1)
  144.         NEL1   = MELVA1.VELCHE(/2)
  145.  
  146. C  3.6.4 - Element fini BARRe : recuperation de la section
  147.         IF (IFOMOD.NE.0 .AND. IFOMOD.NE.1) THEN
  148.           iBarre = 1
  149.           iVA1 = MELVA2.VELCHE(/1)
  150.           iMin1 = MIN(1,iVA1)
  151.           iMin2 = MIN(2,iVA1)
  152.           iVA2 = MELVA2.VELCHE(/2)
  153.         ELSE
  154.           iBarre = 0
  155.           SMoy = 1.D0
  156.         ENDIF
  157.  
  158. C  3.6.5 - Initialisation du segment de travail MMAT1
  159.         IF(MMAT1 .EQ. 0)THEN
  160.           SEGINI,MMAT1
  161.         ELSEIF(NBPTEL .GT. MMAT1.XEL(/2))THEN
  162.           SEGADJ,MMAT1
  163.         ENDIF
  164. C  3.6.6 - Initialisation du segment resultat MELVAL des valeurs
  165. C          des flux nodaux pour chaque element du maillage (IMAMOD)
  166.         N1PTEL = NBPTEL
  167.         N1EL   = NBELT
  168.         N2PTEL = 0
  169.         N2EL   = 0
  170.         SEGINI,MELVAL
  171. C  3.6.7 - Boucle sur les elements du maillage elementaire IMAMOD
  172.         DO iELT = 1, NBELT
  173.           CALL ZERO(AEL,NBPTEL,NBPTEL)
  174.           CALL DOXE(XCOOR,IDIM,NBPTEL,meleme.NUM,iELT,XEL)
  175.           IF (iBarre.EQ.1) THEN
  176.             i = MIN(iELT,iVA2)
  177.             SMoy = (MELVA2.VELCHE(iMin1,i)+MELVA2.VELCHE(iMin2,i))*0.5D0
  178.           ENDIF
  179.           IF (IDIM.EQ.3) THEN
  180.             DO iGau = 1, NBPGAU
  181.               DLX = XZERO
  182.               DLY = XZERO
  183.               DLZ = XZERO
  184.               DO i = 1, NBPTEL
  185.                 r_z = minte.SHPTOT(2,i,iGau)
  186.                 DLX = DLX + r_z * XEL(1,i)
  187.                 DLY = DLY + r_z * XEL(2,i)
  188.                 DLZ = DLZ + r_z * XEL(3,i)
  189.               ENDDO
  190.               Volu = SMoy * SQRT(DLX*DLX+DLY*DLY+DLZ*DLZ)
  191.      &                    * minte.POIGAU(iGau)
  192.               DO i = 1, NBPTEL
  193.                 r_z = minte.SHPTOT(1,i,iGau) * Volu
  194.                 DO j = 1, NBPTEL
  195.                   AEL(i,j) = AEL(i,j) + minte.SHPTOT(1,j,iGau) * r_z
  196.                 ENDDO
  197.               ENDDO
  198.             ENDDO
  199.           ELSE IF (IDIM.EQ.2) THEN
  200.             DO iGau = 1, NBPGAU
  201.               DLX = XZERO
  202.               DLY = XZERO
  203.               DO i = 1, NBPTEL
  204.                 r_z = minte.SHPTOT(2,i,iGau)
  205.                 DLX = DLX + r_z * XEL(1,i)
  206.                 DLY = DLY + r_z * XEL(2,i)
  207.               ENDDO
  208.               Volu = SMoy*SQRT(DLX*DLX+DLY*DLY)*POIGAU(iGau)
  209.               DO i = 1, NBPTEL
  210.                 r_z = minte.SHPTOT(1,i,iGau) * Volu
  211.                 DO j = 1,NBPTEL
  212.                   AEL(i,j) = AEL(i,j) + minte.SHPTOT(1,j,iGau) * r_z
  213.                 ENDDO
  214.               ENDDO
  215.             ENDDO
  216.           ENDIF
  217.           IEMIN = MIN(NEL1,iELT)
  218.           DO i = 1, NBPTEL
  219.             r_z = XZERO
  220.             DO j = 1, NBPTEL
  221.               k = MIN(NBPTE1,j)
  222.               r_z = r_z + MELVA1.VELCHE(k,IEMIN) * AEL(j,i)
  223.             ENDDO
  224.             melval.VELCHE(i,iElt) = r_z
  225.           ENDDO
  226.         ENDDO
  227. C =====
  228. C  Initialisation du MCHAML des flux de chaleur nodaux equivalents
  229. C  (MCHAML) associe au modele elementaire ISOU (maillage IMAMOD)
  230. C  Remplissage des donnees associees a MCHAML dans MCHELM (global)
  231. C =====
  232. C       Recuperation du nom de la composante duale dans le modele
  233.         NOMID  = imodel.LNOMID(2)
  234.  
  235.         N2 = 1
  236.         SEGINI,MCHAML
  237.         NBROBL=NOMID.LESOBL(/2)
  238.         IF(NBROBL .NE. 1)THEN
  239.           CALL ERREUR(21)
  240.           RETURN
  241.         ENDIF
  242.         mchaml.NOMCHE(1) = NOMID.LESOBL(1)
  243.         mchaml.TYPCHE(1) ='REAL*8'
  244.         mchaml.IELVAL(1) = MELVAL
  245.  
  246.         mchelm.CONCHE(ISOU)   = imodel.CONMOD
  247.         mchelm.IMACHE(ISOU)   = MELEME
  248.         mchelm.ICHAML(ISOU)   = MCHAML
  249.         mchelm.INFCHE(ISOU,3) = NIFOUR
  250.         mchelm.INFCHE(ISOU,6) = 1
  251.  
  252. C===
  253.  100  CONTINUE
  254. C===
  255. C Fin de la boucle sur les sous-modeles elementaires
  256.  
  257.       IF(MMAT1 .NE. 0) SEGSUP,MMAT1
  258.  
  259.       END
  260.  
  261.  
  262.  

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