Télécharger la plaquette Cast3M


fr en

Télécharger capaed.eso

Retour à la liste

Numérotation des lignes : 

capaed

  1. C CAPAED    SOURCE    GG250959  17/09/20    21:15:08     9554           
  2.  
  3. C=======================================================================
  4. C=    OPERATEUR CAPACITE - MODELE 'DIFFUSION' OU 'ELECTROSTATIQUE'     =
  5. C=======================================================================
  6. C=                            C A P A E D                              =
  7. C=                            -----------                              =
  8. C=                                                                     =
  9. C=  Fonction :                                                         =
  10. C=  ----------                                                         =
  11. C=  Calcul de la matrice de "CAPACITE" (type RIGIDITE)                 =
  12. C=                                                                     =
  13. C=  Parametres :  (E)=Entree   (S)=Sortie                              =
  14. C=  ------------                                                       =
  15. C=   IPMODE   (E)   Segment IMODEL pour un modele elementaire  (ACTIF) =
  16. C=   IPCHEL   (E)   Segment MCHELM de CARACTERISTIQUES         (?)     =
  17. C=   ISUPC    (E)   Support du champ de CARACTERISTIQUES               =
  18. C=   IPRIGI  (E/S)  Segment MRIGID : "CAPACITE"                (ACTIF) =
  19. C=======================================================================
  20.  
  21.       SUBROUTINE CAPAED (IPMODE,IPCHEL,ISUPC, IPRIGI)
  22.  
  23.  
  24.       IMPLICIT INTEGER(I-N)
  25.       IMPLICIT REAL*8(A-H,O-Z)
  26.  
  27.  
  28. -INC PPARAM
  29. -INC CCOPTIO
  30. -INC CCHAMP
  31. -INC CCGEOME
  32. -INC CCREEL
  33.  
  34. -INC SMCHAML
  35. -INC SMCOORD
  36. -INC SMELEME
  37. -INC SMINTE
  38. -INC SMMODEL
  39. -INC SMRIGID
  40.  
  41.       INTEGER OOOVAL
  42.  
  43.       SEGMENT NOTYPE
  44.         CHARACTER*16 TYPE(NBTYPE)
  45.       ENDSEGMENT
  46.  
  47.       SEGMENT MPTVAL
  48.         INTEGER IPOS(NS)    ,NSOF(NS)
  49.         INTEGER      IVAL(NCOSOU)
  50.         CHARACTER*16 TYVAL(NCOSOU)
  51.       ENDSEGMENT
  52.  
  53.       SEGMENT INFO
  54.        INTEGER INFELL(JG)
  55.       ENDSEGMENT
  56.  
  57.       CHARACTER*8 CMATE
  58.       CHARACTER*(LCONMO) CONM
  59.  
  60. C= INTTYP definit le support des points d'integration pour CAPAED
  61. C= Cette valeur doit etre coherente avec celle utilisee dans CAPA.
  62.       PARAMETER ( INTTYP = 4 )
  63.  
  64.       PARAMETER ( NINF=3 )
  65.       INTEGER INFOS(NINF)
  66.  
  67.       LOGICAL lsupfo,lsupdp
  68.  
  69.       IPINTE = 0
  70.       MOMATE = 0
  71.       MOTYPE = 0
  72.       MODEPL = 0
  73.       MOFORC = 0
  74.       lsupdp = .FALSE.
  75.       lsupfo = .FALSE.
  76.  
  77. C- Matrice de capacite
  78.       MRIGID = IPRIGI
  79. c*      SEGACT,MRIGID
  80.       NRIGE0 = IRIGEL(/2)
  81.  
  82. C- Recuperation du sous-modele et de la zone elementaire associee
  83.       IMODEL = IPMODE
  84. C*      SEGACT,IMODEL
  85.  
  86.       MELE = NEFMOD
  87.       IF (MELE.EQ.22) GOTO 9991
  88.       IF (MELE.EQ.259) GOTO 9991
  89.  
  90. C- Recuperation d'informations sur le maillage elementaire
  91.       IPT1 = IMAMOD
  92.       SEGACT,IPT1
  93.       NBNOE1 = IPT1.NUM(/1)
  94.       NBELE1 = IPT1.NUM(/2)
  95.  
  96. C- Quelques informations sur le modele
  97.       CONM  = CONMOD
  98.       CMATE = CMATEE
  99.       MATE  = IMATEE
  100.  
  101.       IRET = 1
  102.       CALL IDENT(IPT1,CONM,IPCHEL,0, INFOS,IRET)
  103.       IF (IRET.EQ.0) GOTO 9990
  104.  
  105. C- Recuperation d'informations sur l'element fini
  106.       IF (INFMOD(/1).LT.2+INTTYP) THEN
  107.         CALL ELQUOI(MELE,0,INTTYP,IPINF,IMODEL)
  108.         IF (IERR.NE.0) GOTO 9990
  109.         INFO   = IPINF
  110.         MFR    = INFELL(13)
  111.         LRE    = INFELL( 9)
  112.         MINTE  = INFELL(11)
  113. c*        NBPGAU = INFELL( 6)
  114. c*        NDDL   = INFELL(15)
  115.         SEGSUP,INFO
  116.       ELSE
  117.         MFR    = INFELE(13)
  118.         LRE    = INFELE( 9)
  119.         MINTE  = INFMOD(2+INTTYP)
  120. c*        NBPGAU = INFELE( 6)
  121. c*        NDDL   = INFELE(15)
  122.       ENDIF
  123. c*      IF (MFR.NE.71 .AND. MFR.NE.73) THEN
  124. c*        CALL ERREUR(21)
  125. c*        GOTO 9990
  126. c*      ENDIF
  127.       IPINTE = MINTE
  128.       IF (IPINTE.NE.0) SEGACT,MINTE
  129.       IPPORE = 0
  130.  
  131. C- Recuperation des caracteristiques materielles (obligatoires)
  132.       ISUPC1 = ISUPC
  133.       nbrobl = 1
  134.       nbrfac = 0
  135.       SEGINI,nomid
  136.       IF (MFR.EQ.71) THEN
  137. C*      IF (FORMOD(1).EQ.'ELECTROSTATIQUE') THEN
  138.         lesobl(1) = 'CJEL    '
  139.       ELSE IF (MFR.EQ.73) THEN
  140. C*      ELSE IF (FORMOD(1).EQ.'DIFFUSION') THEN
  141.         lesobl(1) = 'CDIF    '
  142.       ENDIF
  143.       MOMATE = nomid
  144.       NMATT = nbrobl + nbrfac
  145. c
  146.       nbtype = 1
  147.       SEGINI,notype
  148.       type(1) = 'REAL*8'
  149.       MOTYPE = notype
  150.  
  151. C- Definition du descripteur IDESCR pour le modele elementaire
  152. C-- Recherche des noms d'inconnues primales et duales
  153.       IF (LNOMID(1).NE.0) THEN
  154.         MODEPL = LNOMID(1)
  155.         nomid = MODEPL
  156.         SEGACT,nomid
  157.         NDEPL = lesobl(/2)
  158. C*        ndum = lesfac(/2)
  159.       ELSE
  160.         lsupdp = .TRUE.
  161.         CALL IDPRIM(IMODEL,MFR,MODEPL,NDEPL,ndum)
  162.         nomid = MODEPL
  163.         SEGACT,nomid
  164.       ENDIF
  165.       IF (LNOMID(2).NE.0) THEN
  166.         MOFORC = LNOMID(2)
  167.         nomid = MOFORC
  168.         SEGACT,nomid
  169.         NFORC = lesobl(/2)
  170. C*        ndum =lesfac(/2)
  171.       ELSE
  172.         lsupfo = .TRUE.
  173.         CALL IDDUAL(IMODEL,MFR,MOFORC,NFORC,ndum)
  174.         nomid = MOFORC
  175.         SEGACT,nomid
  176.       ENDIF
  177.       IF (NDEPL.EQ.0.OR.NFORC.EQ.0.OR.NDEPL.NE.NFORC) THEN
  178.         CALL ERREUR(5)
  179.         GOTO 9990
  180.       ENDIF
  181. C-- Initialisation du segment DESCRIPTEUR
  182.       NLIGRP = LRE
  183.       NLIGRD = LRE
  184.       IF (NBNOE1*NDEPL .GT. NLIGRD) THEN
  185.         CALL ERREUR(717)
  186.         GOTO 9990
  187.       ENDIF
  188.       SEGINI,DESCR
  189. C-- Remplissage du segment DESCRIPTEUR
  190.       IDDL = 1
  191.       DO inoe = 1, NBNOE1
  192.         DO il = 1, NDEPL
  193.           nomid = MODEPL
  194.           LISINC(IDDL) = lesobl(il)
  195.           NOELEP(IDDL) = inoe
  196.           nomid = MOFORC
  197.           LISDUA(IDDL) = lesobl(il)
  198.           NOELED(IDDL) = inoe
  199.           IDDL = IDDL+1
  200.         ENDDO
  201.       ENDDO
  202.       SEGDES,DESCR
  203.       IDESCR = DESCR
  204.  
  205. C- Partionnement si necessaire de la matrice de capacite
  206. C- determinant ainsi le nombre d'objets elementaires de MRIGID
  207.       LTRK = oooval(1,4)
  208.       IF (LTRK.EQ.0) LTRK = oooval(1,1)
  209. * Ajout a la taille en mots de la matrice des infos du segment
  210.       LSEG = LRE*LRE*NBELE1 + 16
  211.       NBLPRT = (LSEG-1)/LTRK + 1
  212.       NBLMAX = (NBELE1-1)/NBLPRT + 1
  213.       NBLPRT = (NBELE1-1)/NBLMAX + 1
  214. *      write(ioimp,*) ' capaed : nblprt nblmax = ',nblprt,nblmax,nbele1
  215.  
  216. C Ajout de la matrice de CAPACITE THERMOHYDRIQUE a la matrice globale
  217. C ===================================================================
  218.       NRIGEL = NRIGE0 + NBLPRT
  219.       SEGADJ,MRIGID
  220.  
  221.       descr  = IDESCR
  222.       meleme = IPT1
  223.       nbnn   = NBNOE1
  224.       nbelem = NBELE1
  225.       nbsous = 0
  226.       nbref  = 0
  227.  
  228. C Boucle sur les PARTITIONS elementaires de la matrice
  229. C ====================================================
  230.       DO irige = 1, NBLPRT
  231.  
  232.         IF (NBLPRT.GT.1) THEN
  233. C- Partitionnement du maillage support de la matrice elementaire
  234.           SEGACT,IPT1
  235.           ielem = (irige-1)*NBLMAX
  236.           nbelem = MIN(NBLMAX,NBELE1-ielem)
  237. *          write(ioimp,*) ' creation segment ',nbnn,nbelem
  238.           SEGINI,meleme
  239.           itypel = IPT1.itypel
  240.           DO ielt = 1, nbelem
  241.             jelt = ielt + ielem
  242.             DO inoe = 1, nbnn
  243.               num(inoe,ielt) = IPT1.NUM(inoe,jelt)
  244.             ENDDO
  245.             icolor(ielt) = IPT1.ICOLOR(jelt)
  246.           ENDDO
  247. C- Recopie du descripteur
  248.           des1 = IDESCR
  249.           SEGINI,descr=des1
  250.           SEGDES,descr
  251.         ENDIF
  252.         ipmail = meleme
  253.         ipdesc = descr
  254.  
  255. C- Initialisation de la matrice de rigidite elementaire (xmatri)
  256.         NELRIG = nbelem
  257.         SEGINI,xmatri
  258.         ipmatr = xmatri
  259.  
  260. C- Recuperation du champ des proprietes materielles sur la partition
  261.         IVAMAT = 0
  262.         CALL KOMCHA(IPCHEL,ipmail,CONM,MOMATE,MOTYPE,1,INFOS,3,IVAMAT)
  263.         IF (IERR.NE.0) GOTO 9995
  264.         IF (ISUPC1.EQ.1) THEN
  265.           CALL VALCHE(IVAMAT,NMATT,IPINTE,IPPORE,MOMATE,MELE)
  266.           IF (IERR.NE.0) THEN
  267.             ISUPC1 = 0
  268.             GOTO 9995
  269.           ENDIF
  270.         ENDIF
  271.  
  272. * Calcul de la CAPACITE ELEMENTAIRE
  273.         IF (MFR .EQ. 71 .OR. MFR .EQ. 73) THEN
  274.           CALL CAPDIF(MELE,ipmail,ipinte,IVAMAT,NMATT, ipmatr)
  275.         ELSE
  276.           CALL ERREUR(21)
  277.         ENDIF
  278.  
  279. C- Un peu de menage dans les segments
  280.  9995   CONTINUE
  281.         IF (ISUPC1.EQ.1 .OR. NBLPRT.GT.1) THEN
  282.           CALL DTMVAL(IVAMAT,3)
  283.         ELSE
  284.           CALL DTMVAL(IVAMAT,1)
  285.         ENDIF
  286. C- Sortie prematuree en cas d'erreur
  287.         IF (IERR.NE.0) GOTO 9990
  288.  
  289.         xmatri = ipmatr
  290.         SEGDES,xmatri
  291.         IF (NBLPRT.GT.1) THEN
  292.           meleme = ipmail
  293.           SEGDES,meleme
  294.         ENDIF
  295.  
  296. C- Stockage de la matrice de capacite
  297.         jrige = NRIGE0 + irige
  298.         COERIG(jrige)   = 1.
  299.         IRIGEL(1,jrige) = ipmail
  300.         IRIGEL(2,jrige) = 0
  301.         IRIGEL(3,jrige) = ipdesc
  302.         IRIGEL(4,jrige) = ipmatr
  303.         IRIGEL(5,jrige) = NIFOUR
  304.         IRIGEL(6,jrige) = 0
  305.         IRIGEL(7,jrige) = 0
  306.         IRIGEL(8,jrige) = 0
  307.  
  308.       ENDDO
  309.  
  310.       IPRIGI = MRIGID
  311.  
  312. C FIN DU TRAITEMENT : desactivation/destruction de segments
  313. C =========================================================
  314.  9990 CONTINUE
  315.       SEGDES,IPT1
  316.       IF (IPINTE.NE.0) THEN
  317.         MINTE = IPINTE
  318.         SEGDES,MINTE
  319.       ENDIF
  320.       IF (MOMATE.NE.0) THEN
  321.         nomid = MOMATE
  322.         SEGSUP,nomid
  323.       ENDIF
  324.       IF (MOTYPE.NE.0) THEN
  325.         notype = MOTYPE
  326.         SEGSUP,notype
  327.       ENDIF
  328.       IF (MODEPL.NE.0) THEN
  329.         nomid = MODEPL
  330.         SEGDES,nomid
  331.         IF (lsupdp) SEGSUP,nomid
  332.       ENDIF
  333.       IF (MOFORC.NE.0) THEN
  334.         nomid = MOFORC
  335.         SEGDES,nomid
  336.         IF (lsupfo) SEGSUP,nomid
  337.       ENDIF
  338.  9991 CONTINUE
  339. c*      SEGDES,IMODEL
  340. c*      SEGDES,MRIGID
  341.  
  342.       RETURN
  343.       END
  344.  
  345.  
  346.  
  347.  
  348.  
  349.  
  350.  
  351.  
  352.  

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