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/04/12    21:15:01     12234          
  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.         if(mrotat.ne.0) segact mrotat                
  172.         if(mrota1.ne.0) segact mrota1                
  173.         idimr=idim
  174.         if (mrotat.ne.0) then
  175.         if (xrota(/1).ne.idimr.or.xrota(/2).ne.nbpts) segadj mrotat
  176.         endif
  177.         if (mrota1.ne.0) then
  178.         if (mrota1.xrota(/1).ne.idimr.or.mrota1.xrota(/2).ne.nbpts)
  179.      >         segadj mrota1
  180.         endif
  181. C
  182.         nct=3
  183.         ncr=3
  184.         nc=nct+ncr
  185.         SEGINI MSOUPO
  186.         ipchp(1)=msoupo
  187.         if (ifour.ne.0.and.ifour.ne.1) then
  188.           do i=1,nct
  189.             nocomp(i)=nodef(i)
  190.           enddo
  191.           do i=nct+1,nc
  192.             nocomp(i)=rodef(i-nct)
  193.           enddo
  194.         else
  195.           do i=1,nct
  196.             nocomp(i)=nodeg(i)
  197.           enddo
  198.           do i=nct+1,nc
  199.             nocomp(i)=rodeg(i-nct)
  200.           enddo
  201.         endif
  202. C
  203.         N=nbpts
  204.         segini mpoval
  205.         ipoval=mpoval
  206.         nbpts1=mcoor1.xcoor(/1)/(idim+1)
  207. **      write(6,*) 'config nbpts nbpts1',nbpts,nbpts1
  208.         do i=1,min(nbpts,nbpts1)
  209.           do j=1,nct
  210.             ij=(i-1)*(idim+1)+j
  211.             vpocha(i,j)=xcoor(ij)-mcoor1.xcoor(ij)
  212.           enddo
  213.           do j=1,ncr
  214.             jj=j+nct
  215.             if(mrota.ne.0.and.mrota1.ne.0) then 
  216.               vpocha(i,jj)=xrota(j,i)-mrota1.xrota(j,i)
  217.             elseif(mrota.ne.0.and.mrota1.eq.0) then 
  218.               vpocha(i,jj)=xrota(j,i)
  219.             elseif(mrota.eq.0.and.mrota1.ne.0) then 
  220.               vpocha(i,jj)=         -mrota1.xrota(j,i)
  221.             endif
  222.           enddo
  223.         enddo
  224.         do i=min(nbpts,nbpts1)+1,nbpts
  225.           do j=1,nct
  226.             ij=(i-1)*(idim+1)+j
  227.             vpocha(i,j)=xcoor(ij)
  228.           enddo
  229.         enddo
  230.         if(mrota.ne.0) then                                  
  231.           do i=min(nbpts,nbpts1)+1,nbpts
  232.             do j=1,ncr
  233.               jj=j+nct
  234.               vpocha(i,jj)=xrota(j,i)
  235.             enddo
  236.           enddo
  237.         endif
  238. C
  239.         if (.not.caract) then
  240.           do i=1,nbpts
  241.             do j=1,nc
  242.               vpocha(i,j)=-vpocha(i,j)
  243.             enddo
  244.           enddo
  245.         endif
  246. C
  247.         nbnn=1
  248.         nbelem=nbpts       
  249.         nbsous=0
  250.         nbref=0
  251.         segini meleme
  252.         itypel=1
  253.         do i=1,nbelem
  254.           num(1,i)=i
  255.         enddo
  256.         igeoc=meleme
  257.       endif
  258. **    segact mchpoi
  259. **    call ecchpo(mchpoi,0)
  260. C
  261.       segact mchelm*mod
  262.       IF (.NOT.CARACT) THEN
  263. **  write (6,*) 'mcoors mcoord avant piocap',mcoors,mcoord,mchelm
  264.         mclcnf=mcoord
  265. **      segact mcoord
  266.         nbpts=xcoor(/1)/(idim+1)
  267.         CALL PIOCAP(IPMODL,IPCHE1,IPCHP1,IPCHP0,ICHAX1,1,IDERI,
  268.      &                 IPCHE2,IRET)
  269.         mchelm=ipche2
  270. **  write (6,*) 'mclcnf mcoord apres piocap',mclcnf,mcoord,mchelm
  271.       ELSE
  272. C     Mise a jour des caracteristiques materielles
  273. **  write (6,*) 'mclcnf mcoord avant formch',mclcnf,mcoord,mchelm
  274.  
  275.         CALL FORMCH(IPMODL,IPCHE1,IPCHP1,iret,IPCHE2,mcoor1)
  276.         mchelm=ipche2
  277.         segact mchelm*mod
  278.         mclcnf=mcoord
  279. **  write (6,*) 'mclcnf mcoord apres formch',mclcnf,mcoord,mchelm
  280.       ENDIF
  281.       segact mcoord
  282.       nbpts=xcoor(/1)/(idim+1)
  283.       segdes,mcoord,mcoor1
  284. **    call verrou(3)
  285. C
  286.  11   CONTINUE
  287.       IRESUL(**)=IPCHE2
  288. C
  289.       ICODE = 0
  290.       GOTO 10
  291. C     ------------------------------------------------------------------
  292. C     Ecriture du(des) objet(s) resultat(s)
  293.  20   CONTINUE
  294. C
  295.       INBC=IRESUL(/1)
  296.       DO IE=1,INBC
  297.         IPCHE3=IRESUL(INBC+1-IE)
  298.         CALL ACTOBJ('MCHAML  ',IPCHE3,2)
  299.         CALL ECROBJ('MCHAML  ',IPCHE3)
  300.       ENDDO
  301.       SEGSUP,IRESUL
  302. C
  303. C     Suppression du chpoint cree
  304.       if (iretou.eq.0) then
  305.         do isp=1,ipchp(/1)
  306.           msoupo=ipchp(isp)
  307.           mpoval=ipoval
  308.           segsup mpoval
  309.           meleme=igeoc
  310.           segsup meleme
  311.           segsup msoupo                                                                 
  312.         enddo
  313.         segsup mchpoi
  314.       endif
  315.       END
  316.  
  317.  
  318.  

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