Télécharger la plaquette Cast3M


fr en

Télécharger config.eso

Retour à la liste

Numérotation des lignes : 

config

  1. C CONFIG    SOURCE    PV090527  25/06/04    21:15:01     12275          
  2.       SUBROUTINE CONFIG     
  3. C=======================================================================
  4. C   OPERATEUR TRANSFORMANT DES CHAMPS DE CONTRAINTES/DEFORMATIONS SUR 
  5. C   LA CONFIGURATION COURANTE OU ACTUALISANT DES CHAMPS DE
  6. C   CARACTERISTIQUES
  7. C
  8. C       MCHAMA (MCHAMB ...) = 'CONF' MOD1 MCHAM1 (MCHAM2 ...) ;
  9. C
  10. C Entrees :
  11. C ---------
  12. C MOD1   : OBJET MODELE (TYPE MMODEL)
  13. C MCHAM1 : OBJET MCHAML DE CONTRAINTES OU DE DEFORMATIONS
  14. C MCHAM2 : OBJET MCHAML DE CONTRAINTES OU DE DEFORMATIONS
  15. C ...    : OBJET MCHAML DE CONTRAINTES OU DE DEFORMATIONS
  16. C
  17. C Sorties :
  18. C ---------
  19. C MCHAMA : OBJET MCHAML TRANSFORME DE MCHAM1
  20. C MCHAMB : OBJET MCHAML TRANSFORME DE MCHAM2
  21. C ...    : OBJET MCHAML TRANSFORME DE ...   
  22. C
  23. C Remarque : la configuration courante est celle du MCOORD et la 
  24. C            configuration associee au MCHAML est celle stockee 
  25. C            a l'indice mclcnf
  26. C=======================================================================
  27.       IMPLICIT INTEGER(I-N)
  28.       IMPLICIT REAL*8(A-H,O-Z)
  29.  
  30. -INC PPARAM
  31. -INC CCOPTIO
  32. -INC SMMODEL
  33. -INC SMCHAML
  34. -INC SMCOORD
  35. -INC SMCHPOI 
  36. -INC SMELEME 
  37.       POINTEUR MCHEX1.MCHELM
  38. C
  39.       PARAMETER(NDERI=7)
  40.       CHARACTER*4 MODERI(NDERI)
  41.       DATA MODERI/'LINE','QUAD','I  ','II  ','TRUE','JAUM','UTIL'/
  42. c       -> IDERI =  1      2     1      2      3      4      5
  43. c          traitement particulier uniquement si IDERI = 4 ou 5
  44. C
  45.       LOGICAL CARACT
  46.       SEGMENT IRESUL(0)
  47. C
  48.       CHARACTER*(LOCOMP) NODEF(3),NODEG(3)
  49.       CHARACTER*(LOCOMP) RODEF(3),RODEG(3)
  50.       DATA NODEF / 'UX  ','UY  ','UZ  ' /
  51.       DATA NODEG / 'UR  ','UZ  ','UT  ' /
  52.       DATA RODEF / 'RX  ','RY  ','RZ  ' /
  53.       DATA RODEG / 'RR  ','RZ  ','RT  ' /
  54. C-----------------------------------------------------------------------
  55.       IPMODL=0
  56.       IPCHE1=0
  57.       IPCHE2=0
  58.       IPCHP1=0
  59. *as xfem 2010_01_13
  60.       IPCHP0=0
  61.       ICHAX1=0
  62.       IDERI=MEPSIL
  63. C
  64. C     LECTURE DU MMODEL
  65. C
  66.       CALL LIROBJ('MMODEL  ',IPMODL,1,IRT1)
  67.       IF(IERR.NE.0) RETURN
  68.       CALL ACTOBJ('MMODEL  ',IPMODL,2)
  69.       IF(IERR.NE.0)RETURN
  70. C
  71.       MMODEL = IPMODL
  72.       NBPART = KMODEL(/1)
  73.       IPICA = 0
  74.       DO 4 IPART=1,NBPART
  75.         IMODEL = KMODEL(IPART)
  76. C Pour certains modeles (OTTOSEN, UO2), les operateurs PICA et CAPI ne
  77. C doivent pas modifier les champs !
  78. * septembre 2019: cette restriction est enlevee
  79. **      IF ( INATUU.EQ.42 .OR. INATUU.EQ.108 ) IPICA = IPICA+1
  80. C Pour les modeles utilisateur UMAT, les contraintes sont deja de Cauchy
  81. C et ne doivent donc pas etre transportees !
  82.         IF ( INATUU.EQ.-1) IPICA = IPICA+1
  83. C Verification presence XFEM
  84. *as xfem 2010_01_13
  85.         NOBMO1=IVAMOD(/1)
  86.         if (NOBMO1.ne.0) then
  87.           Do iobmo1=1,NOBMO1
  88.             if (TYMODE(iobmo1).eq.'MCHAML') then
  89.               MCHEX1=IVAMOD(iobmo1)
  90.               if (MCHEX1.TITCHE .eq. 'ENRICHIS') then
  91.                 ICHAX1 = MCHEX1.ICHAML(1)
  92.                 goto 3
  93.               endif
  94.             endif
  95.           Enddo
  96.         endif
  97.  3      CONTINUE
  98. *fin as xfem 2010_01_13
  99.  4    CONTINUE
  100.       IPICA = 0
  101.  
  102. C Presence XFEM -> pointeur ICHAX1 non nul
  103. *as xfem 2010_01_13
  104.       if (ichax1.ne.0 .and. ipchp0.EQ.0) then
  105.         write(ioimp,*) 'pr un deplacement enrichi, on a besoin du ',
  106.      &      'deplacement entre la config. 0 et la config. de reference'
  107.         CALL ERREUR(21)
  108.         return
  109.       endif
  110. C
  111. C     LECTURE DU(DES) MCHAML(S) A TRANSFORMER
  112. C
  113.       SEGINI,IRESUL
  114.       ICODE=1
  115. C     ------------------------------------------------------------------
  116.   10  CONTINUE
  117.       CALL LIROBJ('MCHAML  ',IPIN,ICODE,IRT1)
  118. C
  119.       IF (IERR.NE.0) RETURN
  120.       IF (IRT1.EQ.0) GOTO 20
  121. C
  122. C  sauver les configuration et passage dans mclcnf pour le reduaf
  123.       MCHELM=IPIN
  124.       SEGACT MCHELM
  125.       if(mclcnf.eq.0.or.mclcnf.eq.mcoord) then
  126.         IPCHE2=IPIN
  127.         GOTO 11
  128.       endif
  129.       CALL ACTOBJ('MCHAML  ',IPIN,2)
  130.       IF(IERR.NE.0) RETURN
  131.       mcoor1=mclcnf
  132.       segact,mcoord,mcoor1
  133. **    write (6,*) 'mclcnf mcoord avant reduag',mclcnf,mcoord
  134. *  ici faire quelque chose pour que reduaf ne plante pas sur une erreur de configuration
  135.       CALL REDUAG(IPIN,IPMODL,IPCHE1,0,IR,KER)
  136. C
  137.       IF (IERR.NE.0) RETURN
  138.       IF (IR  .NE.1) CALL ERREUR(KER)
  139.  
  140. C IPICA = NBPART -> Le modele entier contient des modeles UMAT
  141. C                   Recopie MCHAML IPCHE1 tel quel et on quitte
  142.       IF (IPICA.EQ.NBPART) THEN
  143.         CALL COPIE8(IPCHE1,IPCHE2)
  144.         GOTO 11
  145.       ENDIF
  146. C
  147. C     Presence de caracteristiques a actualiser
  148.       MCHELM=IPCHE1
  149.       caract=(titche.eq.'CARACTERISTIQUES')
  150. C-----------------------------------------------------------------------
  151. C     LECTURE D'UN CHPOINT DE DEPLACEMENTS
  152. C-----------------------------------------------------------------------
  153.       CALL LIROBJ('CHPOINT ',IPCHP1,0,IRETOU)
  154. C
  155.       IF (IRETOU.NE.0) THEN
  156.         mchpoi=ipchp1
  157.         call actobj('CHPOINT',mchpoi,2)
  158.       ELSE
  159. C       Construire le chpoint de deplacements permettant de passer de la 
  160. C       configuration associee au MCHAML (mcoor1) a celle courante (mcoord)
  161.         NAT=2
  162.         NSOUPO=1
  163.         SEGINI MCHPOI
  164.         ipchp1=mchpoi
  165.         mtypoi='config'
  166.         ifopoi=ifour
  167.         jattri(1)=1
  168. C
  169.         mrotat=mrota
  170.         mrota1=mcoor1.mrota
  171.         idimr=3    
  172.         if (mrotat.ne.0.or.mrota1.ne.0) call oooprl(1)
  173.         if (mrotat.ne.0) then
  174.         segact mrotat
  175.         if (xrota(/1).ne.idimr.or.xrota(/2).ne.nbpts) then
  176.          segadj mrotat
  177.          segdes mrotat
  178.         endif
  179.         endif
  180.         if (mrota1.ne.0) then
  181.         segact mrota1                
  182.         if (mrota1.xrota(/1).ne.idimr.or.mrota1.xrota(/2).ne.nbpts) then
  183.          segadj mrota1
  184.         endif
  185.         endif
  186.         if(mrotat.ne.0) segact mrotat                
  187.         if (mrotat.ne.0.or.mrota1.ne.0) call oooprl(0)
  188. C
  189.         nct=3
  190.         ncr=3
  191.         nc=nct+ncr
  192.         SEGINI MSOUPO
  193.         ipchp(1)=msoupo
  194.         if (ifour.ne.0.and.ifour.ne.1) then
  195.           do i=1,nct
  196.             nocomp(i)=nodef(i)
  197.           enddo
  198.           do i=nct+1,nc
  199.             nocomp(i)=rodef(i-nct)
  200.           enddo
  201.         else
  202.           do i=1,nct
  203.             nocomp(i)=nodeg(i)
  204.           enddo
  205.           do i=nct+1,nc
  206.             nocomp(i)=rodeg(i-nct)
  207.           enddo
  208.         endif
  209. C
  210.         N=nbpts
  211.         segini mpoval
  212.         ipoval=mpoval
  213.         nbpts1=mcoor1.xcoor(/1)/(idim+1)
  214. **      write(6,*) 'config nbpts nbpts1',nbpts,nbpts1
  215.         do i=1,min(nbpts,nbpts1)
  216.           do j=1,nct
  217.             ij=(i-1)*(idim+1)+j
  218.             vpocha(i,j)=xcoor(ij)-mcoor1.xcoor(ij)
  219.           enddo
  220.           do j=1,ncr
  221.             jj=j+nct
  222.             if(mrota.ne.0.and.mrota1.ne.0) then 
  223.               vpocha(i,jj)=xrota(j,i)-mrota1.xrota(j,i)
  224.             elseif(mrota.ne.0.and.mrota1.eq.0) then 
  225.               vp          =xrota(j,i)
  226.               vpocha(i,jj)=vp         
  227.             elseif(mrota.eq.0.and.mrota1.ne.0) then 
  228.               vpocha(i,jj)=         -mrota1.xrota(j,i)
  229.             endif
  230.           enddo
  231.         enddo
  232.         do i=min(nbpts,nbpts1)+1,nbpts
  233.           do j=1,nct
  234.             ij=(i-1)*(idim+1)+j
  235.             vpocha(i,j)=xcoor(ij)
  236.           enddo
  237.         enddo
  238.         if(mrota.ne.0) then                                  
  239.           do i=min(nbpts,nbpts1)+1,nbpts
  240.             do j=1,ncr
  241.               jj=j+nct
  242.               vpocha(i,jj)=xrota(j,i)
  243.             enddo
  244.           enddo
  245.         endif
  246. C
  247.       if (mrota1.ne.0) segdes mrota1
  248.       if (mrotat.ne.0) segdes mrotat
  249. C
  250.         if (.not.caract) then
  251.           do i=1,nbpts
  252.             do j=1,nc
  253.               vpocha(i,j)=-vpocha(i,j)
  254.             enddo
  255.           enddo
  256.         endif
  257. C
  258.         nbnn=1
  259.         nbelem=nbpts       
  260.         nbsous=0
  261.         nbref=0
  262.         segini meleme
  263.         itypel=1
  264.         do i=1,nbelem
  265.           num(1,i)=i
  266.         enddo
  267.         igeoc=meleme
  268.       endif
  269. **    segact mchpoi
  270. **    call ecchpo(mchpoi,0)
  271. C
  272.       segact mchelm*mod
  273.       IF (.NOT.CARACT) THEN
  274. **  write (6,*) 'mcoors mcoord avant piocap',mcoors,mcoord,mchelm
  275.         mclcnf=mcoord
  276. **      segact mcoord
  277.         nbpts=xcoor(/1)/(idim+1)
  278.         CALL PIOCAP(IPMODL,IPCHE1,IPCHP1,IPCHP0,ICHAX1,1,IDERI,
  279.      &                 IPCHE2,IRET)
  280.         mchelm=ipche2
  281. **  write (6,*) 'mclcnf mcoord apres piocap',mclcnf,mcoord,mchelm
  282.       ELSE
  283. C     Mise a jour des caracteristiques materielles
  284. **  write (6,*) 'mclcnf mcoord avant formch',mclcnf,mcoord,mchelm
  285.  
  286.         CALL FORMCH(IPMODL,IPCHE1,IPCHP1,iret,IPCHE2,mcoor1)
  287.         mchelm=ipche2
  288.         segact mchelm*mod
  289.         mclcnf=mcoord
  290. **  write (6,*) 'mclcnf mcoord apres formch',mclcnf,mcoord,mchelm
  291.       ENDIF
  292.       segact mcoord
  293.       nbpts=xcoor(/1)/(idim+1)
  294.       segdes,mcoord,mcoor1
  295. **    call verrou(3)
  296. C
  297.  11   CONTINUE
  298.       IRESUL(**)=IPCHE2
  299. C
  300.       ICODE = 0
  301.       GOTO 10
  302. C     ------------------------------------------------------------------
  303. C     Ecriture du(des) objet(s) resultat(s)
  304.  20   CONTINUE
  305. C
  306.       INBC=IRESUL(/1)
  307.       DO IE=1,INBC
  308.         IPCHE3=IRESUL(INBC+1-IE)
  309.         CALL ACTOBJ('MCHAML  ',IPCHE3,2)
  310.         CALL ECROBJ('MCHAML  ',IPCHE3)
  311.       ENDDO
  312.       SEGSUP,IRESUL
  313. C
  314. C     Suppression du chpoint cree
  315.       if (iretou.eq.0) then
  316.         do isp=1,ipchp(/1)
  317.           msoupo=ipchp(isp)
  318.           mpoval=ipoval
  319.           segsup mpoval
  320.           meleme=igeoc
  321.           segsup meleme
  322.           segsup msoupo                                                                 
  323.         enddo
  324.         segsup mchpoi
  325.       endif
  326.       END
  327.  
  328.  
  329.  
  330.  

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