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/01/13    21:15:01     12111          
  2.       SUBROUTINE CONFIG     
  3. C=======================================================================
  4. C   OPERATEUR TRANSFORMANT LES CONTRAINTES SUR LA CONFIGURATION COURANTE
  5. C
  6. C       MOD1= OBJET MODELE (TYPE MMODEL)
  7. C
  8. C       SI1 = CHAMP  DE CONTRAINTES (TYPE MCHAML)EN ENTREE
  9. C                OU DE DEFORMATIONS
  10. C
  11. C       SI2 = CHAMP  DE CONTRAINTES (TYPE MCHAML) EN SORTIE
  12. C                OU DE DEFORMATIONS
  13. C
  14. C       CNF = CONFIGURATION COURANTE                                         
  15. C
  16. C       CODE COMBESCURE SEPT 87
  17. C
  18. C=======================================================================
  19.       IMPLICIT INTEGER(I-N)
  20.       IMPLICIT REAL*8(A-H,O-Z)
  21.  
  22.  
  23. -INC PPARAM
  24. -INC CCOPTIO
  25. -INC SMMODEL
  26. -INC SMCHAML
  27. -INC SMCOORD
  28. -INC SMCHPOI 
  29. -INC SMELEME 
  30.       POINTEUR MCHEX1.MCHELM
  31. C
  32.       PARAMETER(NDERI=7)
  33.       CHARACTER*4 MODERI(NDERI)
  34.       DATA MODERI/'LINE','QUAD','I  ','II  ','TRUE','JAUM','UTIL'/
  35. c       -> IDERI =  1      2     1      2      3      4      5
  36. c          traitement particulier uniquement si IDERI = 4 ou 5
  37.  
  38.       CHARACTER*(LOCOMP) NODEF(3),NODEG(3)
  39.       CHARACTER*(LOCOMP) RODEF(3),RODEG(3)
  40.  
  41.       DATA NODEF / 'UX  ','UY  ','UZ  ' /
  42.       DATA NODEG / 'UR  ','UZ  ','UT  ' /
  43.       DATA RODEF / 'RX  ','RY  ','RZ  ' /
  44.       DATA RODEG / 'RR  ','RZ  ','RT  ' /
  45. C-----------------------------------------------------------------------
  46.  
  47.       IPMODL=0
  48.       IPCHE1=0
  49.       IPCHE2=0
  50.       IPCHP1=0
  51. *as xfem 2010_01_13
  52.       IPCHP0=0
  53.       ICHAX1=0
  54.       IDERI=0
  55.       im=1
  56.       ideri=1
  57.  
  58.       CALL LIROBJ('MMODEL  ',IPMODL,1,IRT1)
  59.       IF(IERR.NE.0) RETURN
  60.       CALL ACTOBJ('MMODEL  ',IPMODL,2)
  61.       IF(IERR.NE.0)RETURN
  62. C
  63. C     ON LIT LE MCHAML A TRANSFORMER
  64. C
  65.       CALL LIROBJ('MCHAML  ',IPIN,1,IRT1)
  66.       if (ipin.eq.0) ierr=2
  67.       IF(IERR.NE.0) RETURN
  68.       call verrou(2)
  69.       segact mcoord*mod
  70.       mchelm=ipin
  71. *  sauver les configuration et passage dans mclcnf pour le reduaf
  72.       segact mchelm
  73.       if(mclcnf.eq.0) then
  74.          call ecrobj('MCHAML  ',ipin)
  75.          call verrou(3)
  76.          return
  77.       endif
  78. **    mclcns=mclcnf
  79.       mcoors=mcoord
  80. **    mcoord=mclcns
  81.       CALL ACTOBJ('MCHAML  ',IPIN,2)
  82.       IF(IERR.NE.0) RETURN
  83.       segact mcoord
  84.       nbpts=xcoor(/1)/(idim+1)
  85. **    write (6,*) 'mclcnf mcoord avant reduag',mclcnf,mcoord
  86. *  ici faire quelque chose pour que reduaf ne plante pas sur une erreur de configuration
  87.       CALL REDUAG(IPIN,IPMODL,IPCHE1,0,IR,KER)
  88.       if (ierr.ne.0) return
  89.       mchelm=ipche1
  90. ** A cause du cache la configuration peut etre mauvaise
  91.       segact mchelm*mod
  92. **    mclcnf=mclcns
  93. **    segact mchelm
  94. **    write (6,*) 'mcoors mcoord apres reduag',mcoors,mcoord
  95.       IF(IR   .NE. 1) CALL ERREUR(KER)
  96.       IF(IERR .NE. 0) RETURN
  97. C
  98. C     ON construit le chpoint de deplacement a partir de la config courante et de celle du
  99. C     chamelem
  100. C
  101.       icar=0
  102.        if (titche.eq.'CARACTERISTIQUES') icar = 1
  103.  
  104.        call lirobj('CHPOINT ',ipchp1,0,iretou)
  105.        mchpoi=ipchp1
  106.        if (iretou.eq.0) then
  107.       mcoor1 = mcoors                            
  108.       segact,mcoord,mcoor1
  109.       nbpts1=mcoor1.xcoor(/1)/(idim+1)
  110.       NAT=2
  111.       NSOUPO=1
  112.       SEGINI MCHPOI
  113.       ipchp1=mchpoi
  114.       NCB=2
  115.       if (ifour.eq.2) ncB=3
  116.       segact MCOORD
  117.       nc=ncb
  118.       mrotat=mrota
  119.       mrota1=mcoor1.mrota
  120.       if (mrotat.ne.0) then
  121.         nc=2*ncB
  122.         segact mrotat,mrota1
  123.       endif
  124.       SEGINI MSOUPO
  125.       IPCHP(1)=msoupo
  126.       if (ifour.ne.0.and.ifour.ne.1) then
  127.         do i=1,ncb
  128.           nocomp(i)=nodef(i)
  129.         enddo
  130.       else
  131.         do i=1,ncb
  132.           nocomp(i)=nodeg(i)
  133.         enddo
  134.       endif
  135.       if (mrotat.ne.0) then
  136.       if (ifour.ne.0.and.ifour.ne.1) then
  137.         do i=1,ncb
  138.           nocomp(i+ncb)=rodef(i)
  139.         enddo
  140.       else
  141.         do i=1,ncb
  142.           nocomp(i+ncb)=rodeg(i)
  143.         enddo
  144.       endif
  145.       endif
  146.       N=nbpts1
  147.       segini mpoval
  148.       ipoval=mpoval
  149.       if (nbpts1.gt.nbpts) then
  150.        nbpts=nbpts1
  151.        segadj mcoord
  152.       endif
  153.       if(icar.eq.0) then
  154.       do i=1,nbpts
  155.       do j=1,idim
  156.        ij=(i-1)*(idim+1)+j
  157.        ij0=(i-1)*idim+j
  158.        vpocha(i,j)=xcoor(ij)-mcoor1.xcoor(ij)
  159.        if(mrota.ne.0) vpocha(i,j+ncb)=xrota(ij0)-mrota1.xrota(ij0)
  160.       enddo
  161.       enddo
  162.       else                        
  163.       do i=1,nbpts
  164.       do j=1,idim
  165.        ij=(i-1)*(idim+1)+j
  166.        ij0=(i-1)*idim+j
  167.        vpocha(i,j)=mcoor1.xcoor(ij)-xcoor(ij)
  168.        if(mrota.ne.0) vpocha(i,j+ncb)=mrota1.xrota(ij0)-xrota(ij0)
  169.       enddo
  170.       enddo
  171.       endif
  172.       nbnn=1
  173.       nbelem=n       
  174.       nbsous=0
  175.       nbref=0
  176.       segini meleme
  177.       itypel=1
  178.       do i=1,nbelem
  179.         num(1,i)=i
  180.       enddo
  181.       igeoc=meleme
  182.       endif
  183.       segact mchpoi
  184. **    call ecchpo(mchpoi,0)
  185.  
  186. *as xfem 2010_01_13
  187.       if (ierr.ne.0) then
  188.         if (ichax1.ne.0) then
  189.           write(ioimp,*) 'pr un deplacement enrichi, on a besoin du ',
  190.      &       'deplacement entre la config. 0 et la config. de reference'
  191.           return
  192.         endif
  193.       endif
  194. C
  195.       MMODEL = IPMODL
  196.       NBPART = KMODEL(/1)
  197.       IPICA = 0
  198.       DO 4 IPART=1,NBPART
  199.         IMODEL = KMODEL(IPART)
  200. C Pour certains modeles (OTTOSEN, UO2), les operateurs PICA et CAPI ne
  201. C doivent pas modifier les champs !
  202. * septembre 2019: cette restriction est enlevee
  203. **      IF ( INATUU.EQ.42 .OR. INATUU.EQ.108 ) IPICA = IPICA+1
  204. C Pour les modeles utilisateur UMAT, les contraintes sont deja de Cauchy
  205. C et ne doivent donc pas etre transportees !
  206.         IF ( INATUU.EQ.-1) IPICA = IPICA+1
  207. C Verification presence XFEM
  208. *as xfem 2010_01_13
  209.         NOBMO1=IVAMOD(/1)
  210.         if (NOBMO1.ne.0) then
  211.           Do iobmo1=1,NOBMO1
  212.             if (TYMODE(iobmo1).eq.'MCHAML') then
  213.               MCHEX1=IVAMOD(iobmo1)
  214.               if (MCHEX1.TITCHE .eq. 'ENRICHIS') then
  215.                 ICHAX1 = MCHEX1.ICHAML(1)
  216.                 goto 3
  217.               endif
  218.             endif
  219.           Enddo
  220.         endif
  221.  3      CONTINUE
  222. *fin as xfem 2010_01_13
  223.  4    CONTINUE
  224.  
  225. C Presence XFEM -> pointeur ICHAX1 non nul
  226. *as xfem 2010_01_13
  227.       if (ichax1.ne.0 .and. ipchp0.EQ.0) then
  228.         write(ioimp,*) 'pr un deplacement enrichi, on a besoin du ',
  229.      &      'deplacement entre la config. 0 et la config. de reference'
  230.         CALL ERREUR(21)
  231.         return
  232.       endif
  233.  
  234. C IPICA = NBPART -> Le modele entier contient des modeles UMAT
  235. C                   Recopie MCHAML IPCHE1 tel quel et on quitte
  236.       IF (IPICA.EQ.NBPART) THEN
  237.         IRET = 1
  238.         CALL COPIE8(IPCHE1,IPCHE2)
  239. C
  240. C Melange de MODELEs : Traitement GENERAL
  241. C
  242.       ELSE
  243.         IRET = 0
  244.         mchelm=ipche1
  245.         segact mchelm*mod
  246.         if (icar.eq.0) then
  247. **    write (6,*) 'mcoors mcoord avant piocap',mcoors,mcoord,mchelm
  248. **      mcoord=mcoors
  249.         mclcnf=mcoord
  250.         segact mcoord
  251.         nbpts=xcoor(/1)/(idim+1)
  252.         CALL PIOCAP(IPMODL,IPCHE1,IPCHP1,IPCHP0,ICHAX1,IM,IDERI,
  253.      &              IPCHE2,IRET)
  254.         mchelm=ipche2
  255. **    write (6,*) 'mclcnf mcoord apres piocap',mclcnf,mcoord,mchelm
  256.         else
  257. C       Mise a jour des caracteristiques materielles
  258. **    write (6,*) 'mclcnf mcoord avant formch',mclcnf,mcoord,mchelm
  259.         CALL FORMCH(IPMODL,IPCHE1,IPCHP1,iret,IPCHe2)
  260.         mchelm=ipche2
  261.         segact mchelm*mod
  262. **      mcoord=mcoors
  263.         mclcnf=mcoord
  264. **    write (6,*) 'mclcnf mcoord apres formch',mclcnf,mcoord,mchelm
  265.         endif
  266.         segact mcoord
  267.         nbpts=xcoor(/1)/(idim+1)
  268.         segdes mcoord
  269.         call verrou(3)
  270.       ENDIF
  271.  
  272.       IF (IRET.EQ.1) THEN
  273. **      write(6,*) 'sortie de config ',ipche2
  274.         CALL ACTOBJ('MCHAML  ',IPCHE2,2)
  275.         CALL ECROBJ('MCHAML  ',IPCHE2)
  276.       ENDIF
  277.  
  278.       END
  279.  
  280.  
  281.  
  282.  
  283.  
  284.  
  285.  
  286.  
  287.  
  288.  

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