Télécharger la plaquette Cast3M


fr en

Télécharger condu.eso

Retour à la liste

Numérotation des lignes : 

condu

  1. C CONDU     SOURCE    CB215821  24/04/12    21:15:27     11897          
  2.  
  3.       SUBROUTINE CONDU
  4.  
  5.       IMPLICIT INTEGER(I-N)
  6.       IMPLICIT REAL*8 (A-H,O-Z)
  7.  
  8.  
  9. -INC PPARAM
  10. -INC CCOPTIO
  11. -INC SMCHAML
  12. -INC SMMODEL
  13.       POINTEUR MODTHR.MMODEL,MODRAY.MMODEL,MODCNV.MMODEL,MODTHM.MMODEL
  14.       POINTEUR MOELEC.MMODEL,MODIFF.MMODEL
  15. -INC SMRIGID
  16. -INC SMCOORD
  17.  
  18.       CHARACTER*(LOCOMP) MOCOMP
  19.  
  20.       segact mcoord
  21.       IPRIGI = 0
  22.       IPMODR = 0
  23.       IPMODC = 0
  24.  
  25. C =========================================
  26. C  1- LECTURE DES ARGUMENTS DE L'OPERATEUR
  27. C =========================================
  28. C  1.1 - Lecture OBLIGATOIRE du modele (MODORI)
  29. C =====
  30.       MOTERR(1:8)=' MODELE '
  31.       CALL MESLIR(-137)
  32.       CALL LIROBJ('MMODEL  ',MODORI,1,IRet)
  33.       CALL ACTOBJ('MMODEL  ',MODORI,1)
  34.       IF (IERR.NE.0) RETURN
  35. C =====
  36. C  1.2 - Lecture OBLIGATOIRE du champ de caracteristiques (MCHORI)
  37. C =====
  38.       CALL MESLIR(-135)
  39.       CALL LIROBJ('MCHAML  ',IPIN,1,IRet)
  40.       CALL ACTOBJ('MCHAML  ',IPIN,1)
  41.       IF (IERR.NE.0) RETURN
  42.       CALL REDUAF(IPIN,MODORI,MCHORI,0,IR,KER)
  43.       IF(IR   .NE. 1) CALL ERREUR(KER)
  44.       IF(IERR .NE. 0) RETURN
  45.  
  46. C =========================================
  47. C  2- QUELQUES VERIFICATIONS DES ARGUMENTS
  48. C =========================================
  49. C  2.1 - Verification du type du champ (MCHORI)
  50. C =====
  51.       MCHELM = MCHORI
  52.       SEGACT,MCHELM
  53.       IF (TITCHE(1:8).NE.'CARACTER') THEN
  54.         MOTERR(1:16) = 'CARACTERISTIQUES'
  55.         CALL ERREUR(291)
  56.         RETURN
  57.       ENDIF
  58. C =====
  59. C  2.2 - Verification du contenu du modele (MODORI)
  60. C        Separation des formulations DIFFUSION & ELECTROSTATIQUE
  61. C                et des formulations THERMIQUE & THERMOHYDRIQUE
  62. C =====
  63.       MMODEL = MODORI
  64.       SEGACT,MMODEL
  65.       NSOUS = KMODEL(/1)
  66.       N1 = NSOUS
  67.       SEGINI,MOELEC,MODTHM,MODRAY,MODCNV,MODTHR,MODIFF
  68.       IELEC = 0
  69.       ITHEM = 0
  70.       IRAYE = 0
  71.       ICONV = 0
  72.       ITHER = 0
  73.       IDIFF = 0
  74.  
  75.       DO isous = 1, NSOUS
  76.         IMODEL = KMODEL(isous)
  77.         SEGACT,IMODEL
  78.         IF      (FORMOD(1).EQ.'ELECTROSTATIQUE ') THEN
  79.           IELEC = IELEC + 1
  80.           MOELEC.KMODEL(IELEC) = IMODEL
  81.         ELSE IF (FORMOD(1).EQ.'THERMOHYDRIQUE  ') THEN
  82.           ITHEM = ITHEM + 1
  83.           MODTHM.KMODEL(ITHEM) = IMODEL
  84.         ELSE IF (FORMOD(1).EQ.'DIFFUSION       ') THEN
  85.           IDIFF = IDIFF + 1
  86.           MODIFF.KMODEL(IDIFF) = IMODEL
  87.         ELSE IF (FORMOD(1).EQ.'THERMIQUE       ') then
  88.           NMAT = MATMOD(/2)
  89.           CALL PLACE(MATMOD,NMAT,ipl,'RAYONNEMENT')
  90.           IF (ipl.NE.0) THEN
  91.             IRAYE = IRAYE + 1
  92.             MODRAY.KMODEL(IRAYE) = IMODEL
  93.           ELSE
  94.             CALL PLACE(MATMOD,NMAT,ipl,'CONVECTION')
  95.             IF (ipl.NE.0) THEN
  96.               ICONV = ICONV + 1
  97.               MODCNV.KMODEL(ICONV) = IMODEL
  98.             ELSE
  99.               ITHER = ITHER + 1
  100.               MODTHR.KMODEL(ITHER) = IMODEL
  101.             ENDIF
  102.           ENDIF
  103.         ELSE
  104.           N1 = N1 - 1
  105.         ENDIF
  106.       ENDDO
  107. C  Verification que le modele MODORI contient au moins un sous-modele
  108. C  dont la formulation est traitee ici !
  109.       IF (N1.LE.0) THEN
  110.         MOTERR(1:8) = 'MMODEL  '
  111.         INTERR(1) = MODORI
  112.         CALL ERREUR(356)
  113.         GOTO 9991
  114.       ENDIF
  115.  
  116.       IF (IELEC.GT.0) THEN
  117. C =======================================================
  118. C  3-    CONSTRUCTION DE LA MATRICE DE CONDUCTIVITE
  119. C     POUR LA FORMULATION ELECTROSTATIQUE
  120. C =======================================================
  121. C  Modele contenant uniquement des formulations DIFFUSION et ELECTROSTATIQUE
  122.         N1 = IELEC
  123.         SEGADJ,MOELEC
  124.         IPMODR = MOELEC
  125. C  Calcul de la matrice : tout est fait dans RIGI1
  126.         ipch = 0
  127.         imat = 1
  128.         noer=0
  129.         CALL RIGI1(IPMODR,MCHORI,ipch,imat,IPRIGI,IRET,noer)
  130.         IF (IRET.NE.1) GOTO 9991
  131.         MRIGID = IPRIGI
  132.       ENDIF
  133.  
  134.       NSOUS = ITHEM + IRAYE + ICONV + ITHER + IDIFF
  135.       IF (NSOUS.GT.0) THEN
  136. C ================================================================
  137. C  4-    CONSTRUCTION DE LA MATRICE DE CONDUCTIVITE
  138. C     POUR LES FORMULATIONS THERMIQUE, DIFFUSION ET THERMOHYDRIQUE
  139. C ================================================================
  140. C  4.1 - Initialisation de la matrice si necessaire
  141. C =====
  142.         IF (IPRIGI.EQ.0) THEN
  143.           NRIGEL = 0
  144.           SEGINI,MRIGID
  145.           MTYMAT = 'RIGIDITE'
  146.           ICHOLE = 0
  147.           IMGEO1 = 0
  148.           IMGEO2 = 0
  149.           IFORIG = IFOUR
  150.           ISUPEQ = 0
  151.           IPRIGI = MRIGID
  152.         ELSE
  153.           MRIGID = IPRIGI
  154.           SEGACT,MRIGID*MOD
  155.         ENDIF
  156. C =====
  157. C  4.2 - Modele avec uniquement les formulations THERMIQUE, DIFFUSION et THERMOHYDRIQUE
  158. C =====
  159.         N1 = NSOUS
  160.         SEGINI,MMODEL
  161.         isous = 0
  162.         IF (ITHEM.GT.0) THEN
  163.           DO i = 1, ITHEM
  164.             isous = isous + 1
  165.             KMODEL(isous) = MODTHM.KMODEL(i)
  166.           ENDDO
  167.         ENDIF
  168.         IF (IRAYE.GT.0) THEN
  169.           DO i = 1, IRAYE
  170.             isous = isous + 1
  171.             KMODEL(isous) = MODRAY.KMODEL(i)
  172.           ENDDO
  173.         ENDIF
  174.         IF (ICONV.GT.0) THEN
  175.           DO i = 1, ICONV
  176.             isous = isous + 1
  177.             KMODEL(isous) = MODCNV.KMODEL(i)
  178.           ENDDO
  179.         ENDIF
  180.         IF (ITHER.GT.0) THEN
  181.           DO i = 1, ITHER
  182.             isous = isous + 1
  183.             KMODEL(isous) = MODTHR.KMODEL(i)
  184.           ENDDO
  185.         ENDIF
  186.         IF (IDIFF.GT.0) THEN
  187.           DO i = 1, IDIFF
  188.             isous = isous + 1
  189.             KMODEL(isous) = MODIFF.KMODEL(i)
  190.           ENDDO
  191.         ENDIF
  192.         IPMODC = MMODEL
  193.  
  194. C =====
  195. C  4.3 - Reduction du champ au modele precedemment reduit
  196. C =====
  197.         MCHELM = MCHORI
  198.         CALL REDUAF(MCHORI,IPMODC,IPCHEC,0,IRET,KERRE)
  199.         IF (IRET.NE.1) THEN
  200.           CALL ERREUR(KERRE)
  201.           GOTO 9990
  202.         ENDIF
  203.         ISUPCH = 0
  204.         CALL QUESUP(IPMODC,IPCHEC,6,0,ISUPCH,IRET)
  205.         IF (ISUPCH.GT.1) GOTO 9990
  206. C NB : La verification du support est effectuee ici pour l'instant,
  207. C      car tous les formulations considerees ici s'appuient sur le
  208. C      meme support (IRET = 1, 2 ou 6).
  209.  
  210. C =====
  211. C  4.4 - Remplissage de la matrice pour chaque modele concerne
  212. C =====
  213. c Formulation thermohydrique
  214.         IF (ITHEM.GT.0) THEN
  215.           DO i = 1, ITHEM
  216.             IMODEL = MODTHM.KMODEL(i)
  217.             SEGACT,IMODEL
  218.             CALL THCOND(IMODEL,IPCHEC,ISUPCH, IPRIGI)
  219.             IF (IERR.NE.0) GOTO 9990
  220.           ENDDO
  221.         ENDIF
  222.  
  223. c Formulation rayonnement
  224.         IF (IRAYE.GT.0) THEN
  225.           MCHELM = IPCHEC
  226.           DO i = 1, IRAYE
  227.             IMODEL = MODRAY.KMODEL(i)
  228.             SEGACT,IMODEL
  229. * on accepte le sous-modele de rayonnement que si le mchaml
  230. * correspondant contient une composante H !
  231.             SEGACT,MCHELM
  232.             imaray = IMACHE(/1)
  233.             MOCOMP ='H'
  234.             DO j = 1, imaray
  235.               IF (imache(j).eq.IMAMOD .AND. conche(j).eq.CONMOD) then
  236.                 mchaml = ichaml(j)
  237.                 SEGACT,mchaml
  238.                 CALL PLACE(nomche,nomche(/2),ipl,MOCOMP)
  239.                 IF (ipl.NE.0) then
  240.                   CALL TCONVE(IMODEL,IPCHEC,ISUPCH, IPRIGI)
  241.                   IF (IERR.NE.0) GOTO 9990
  242.                   GOTO 4420
  243.                 ENDIF
  244.               ENDIF
  245.             ENDDO
  246.  4420       CONTINUE
  247.           ENDDO
  248.         ENDIF
  249.  
  250. c Formulation convection
  251.         IF (ICONV.GT.0) THEN
  252.           DO i = 1, ICONV
  253.             IMODEL = MODCNV.KMODEL(i)
  254.             SEGACT,IMODEL
  255.             CALL TCONVE(IMODEL,IPCHEC,ISUPCH, IPRIGI)
  256.             IF (IERR.NE.0) GOTO 9990
  257.           ENDDO
  258.         ENDIF
  259.  
  260. c Formulation conduction
  261.         IF (ITHER.GT.0) THEN
  262.           DO i = 1, ITHER
  263.             IMODEL = MODTHR.KMODEL(i)
  264.             SEGACT,IMODEL
  265.             CALL TCONDU(IMODEL,IPCHEC,ISUPCH, IPRIGI)
  266.             IF (IERR.NE.0) GOTO 9990
  267.           ENDDO
  268.         ENDIF
  269.  
  270. c Formulation diffusion
  271.         IF (IDIFF.GT.0) THEN
  272.           DO i = 1, IDIFF
  273.             IMODEL = MODIFF.KMODEL(i)
  274.             SEGACT,IMODEL
  275.             CALL TCONDU(IMODEL,IPCHEC,ISUPCH, IPRIGI)
  276.             IF (IERR.NE.0) GOTO 9990
  277.           ENDDO
  278.         ENDIF
  279.       ENDIF
  280.  
  281.       NRIGEL = IRIGEL(/2)
  282.       IF (NRIGEL.EQ.0) THEN
  283.         CALL ERREUR(19)
  284.       ENDIF
  285.  
  286.  9990 CONTINUE
  287.       IF (IERR.NE.0) THEN
  288.         SEGSUP,MRIGID
  289.       ELSE
  290.         SEGDES,MRIGID
  291.         CALL ECROBJ('RIGIDITE',IPRIGI)
  292.       ENDIF
  293.  9991 CONTINUE
  294. C      SEGSUP,MOELEC,MODTHR,MODTHM,MODRAY,MODCNV,MODIFF
  295.  
  296.       END
  297.  
  298.  
  299.  
  300.  
  301.  
  302.  
  303.  

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