Télécharger la plaquette Cast3M


fr en

Télécharger sste1.eso

Retour à la liste

Numérotation des lignes : 

sste1

  1. C SSTE1     SOURCE    OF166741  25/02/21    21:18:40     12166          
  2.  
  3. *************************************************************************
  4. *************************************************************************
  5. *************************************************************************
  6.       SUBROUTINE SSTE1 (IPMODL,IPCHE1,IPCHE2,IPCHE4,IPCAR,
  7.      .                    PRECIS,NITMAX,NMAXSSTEPS,NNUMER,DELTAX,
  8.      .                    IPCHE7,IPCHE8,IPCHE9,IPRIGI)
  9. *  entrees:
  10. *  ipmodl = pointeur sur un objet mmodel
  11. *  ipche1 = pointeur sur un mchaml de contraintes initiales
  12. *  ipche2 = pointeur sur un mchaml de variables internes initiales
  13. *  ipche4 = pointeur sur un mchaml d'increment elastique de deformations
  14. *  ipcar  = pointeur sur un mchaml de caracteristiques
  15. *  precis = precision des iterations internes
  16. * sorties:
  17. *  ipche7 = pointeur sur un mchaml de contraintes
  18. *  ipche8 = pointeur sur un mchaml de variables internes
  19. *  ipche9 = pointeur sur un mchaml de deformations
  20. *  iprigi = pointeur sur l'objet de type rigidite
  21. *
  22.       IMPLICIT INTEGER(I-N)
  23.       IMPLICIT REAL*8(A-H,O-Z)
  24.  
  25. -INC PPARAM
  26. -INC CCOPTIO
  27. -INC CCGEOME
  28.  
  29. -INC SMCOORD
  30. -INC SMCHAML
  31. -INC SMELEME
  32. -INC SMINTE
  33. -INC SMMODEL
  34. -INC SMRIGID
  35.  
  36. -INC TMPTVAL
  37.  
  38.       SEGMENT NOTYPE
  39.          CHARACTER*16 TYPE(NBTYPE)
  40.       ENDSEGMENT
  41.  
  42.       CHARACTER*8 CMATE
  43.       CHARACTER*(NCONCH) CONM
  44.       PARAMETER (NINF=3)
  45.       INTEGER INFOS(NINF)
  46.  
  47.       CALL QUESUP(IPMODL,IPCHE1,5,0,ISUP1,IRET1)
  48.       IF (ISUP1.GT.1) RETURN
  49.       CALL QUESUP(IPMODL,IPCHE2,5,0,ISUP2,IRET2)
  50.       IF (ISUP2.GT.1) RETURN
  51.       CALL QUESUP(IPMODL,IPCHE4,5,0,ISUP4,IRET4)
  52.       IF (ISUP4.GT.1) RETURN
  53.       CALL QUESUP(IPMODL,IPCAR,3,0,ISUP5,IRET5)
  54.       IF (ISUP5.GT.1) RETURN
  55.  
  56.       NBTYPE = 1
  57.       SEGINI,notype
  58.       notype.TYPE(1) = 'REAL*8  '
  59.       MOTYR8 = notype
  60. c
  61. c Activar el modelo
  62. c
  63.       MMODEL=IPMODL
  64.       NSOUS=MMODEL.KMODEL(/1)
  65. c
  66. c Creation de los 3 mchelms de salida
  67. c
  68.       N1=NSOUS
  69.       L1=11
  70.       N3=6
  71.       SEGINI MCHELM
  72.       MCHELM.TITCHE='CONTRAINTES'
  73.       MCHELM.IFOCHE=IFOUR
  74.       IPCHE7=MCHELM
  75.       L1=18
  76.       SEGINI MCHEL1
  77.       MCHEL1.TITCHE='VARIABLES INTERNES'
  78.       MCHEL1.IFOCHE=IFOUR
  79.       IPCHE8=MCHEL1
  80.       L1=12
  81.       SEGINI MCHEL2
  82.       MCHEL2.TITCHE='DEFORMATIONS'
  83.       MCHEL2.IFOCHE=IFOUR
  84.       IPCHE9=MCHEL2
  85. c
  86. c Creacion del objeto rigidite
  87. c
  88.       NRIGEL=NSOUS
  89.       SEGINI MRIGID
  90.       MRIGID.MTYMAT = 'RIGIDITE'
  91.       MRIGID.ICHOLE=0
  92.       MRIGID.IMGEO1=0
  93.       MRIGID.IMGEO2=0
  94.       MRIGID.IFORIG=IFOUR
  95.       DO ISOUS=1,NSOUS
  96.          MRIGID.COERIG(ISOUS)=1.D0
  97.          MRIGID.IRIGEL(4,ISOUS)=0
  98.       ENDDO
  99.       IPRIGI=MRIGID
  100. c
  101. c     bucle sobre zonas
  102. c
  103.       DO 1000 ISOUS=1,NSOUS
  104.          NSTR=0
  105.          MOSTRS=0
  106.          IVASTR=0
  107.          MOVARI=0
  108.          NVARI=0
  109.          NVARF=0
  110.          IVARI=0
  111.          MOEPSI=0
  112.          NDEF=0
  113.          IVADEF=0
  114.          IVADS=0
  115.          NCARA=0
  116.          NCARF=0
  117.          MOCARA=0
  118.          IVACAR=0
  119.          NMATF=0
  120.          NMATR=0
  121.          MOMATR=0
  122.          IVAMAT=0
  123.          IVASTF=0
  124.          IVARIF=0
  125.          IVADEP=0
  126.          KERRE=0
  127.          KERR1=0
  128.          MCHAML=0
  129.          MCHAM1=0
  130.          MCHAM2=0
  131. c Recuperar la informacion general de la zona
  132. c Activa el modelo de la zona
  133.         IMODEL=KMODEL(ISOUS)
  134.         MELE  =IMODEL.NEFMOD
  135.         CONM  =IMODEL.CONMOD
  136. c Activa la malla
  137.         MELEME=IMODEL.IMAMOD
  138.         NBNN  =MELEME.NUM(/1)
  139.         NBELEM=MELEME.NUM(/2)
  140. c Tipo de material
  141.         CMATE  = imodel.CMATEE
  142.         MATE   = imodel.IMATEE
  143.         INPLAS = imodel.INATUU
  144. c Controlar que sea uno de los materiales de trabajo
  145.         IF ((INPLAS.lt.111).or.(INPLAS.gt.113)) then
  146.           write(*,*) ' Material no disponible'
  147.         ENDIF
  148. ccc
  149. *  informacion de elementos finitos
  150. *  activa un segmento q se llama luego INFO, q tiene INFELE
  151.       MELE =INFELE(1)
  152.       NBGS =INFELE(4)
  153.       NBG  =INFELE(6)
  154.       IPORE=INFELE(8)
  155.       LRE  =INFELE(9)
  156.       LHOOK=INFELE(10)
  157.       MINTE=INFMOD(7)
  158.       MFR  =INFELE(13)
  159.       NDDL =INFELE(15)
  160.       NSTRS=INFELE(16)
  161.         ippore=0
  162. *  Controla que sean elementos masivos
  163.       IF ((MFR.lt.1).or.(MFR.gt.1)) then
  164.          write(*,*) ' Tipo de elemento no disponible'
  165.       ENDIF
  166. * Llena informacion en los 3 campos de salida
  167.       MCHELM.IMACHE(ISOUS)=MELEME
  168.       MCHELM.CONCHE(ISOUS)=CONM
  169.       MCHEL1.IMACHE(ISOUS)=MELEME
  170.       MCHEL1.CONCHE(ISOUS)=CONM
  171.       MCHEL2.IMACHE(ISOUS)=MELEME
  172.       MCHEL2.CONCHE(ISOUS)=CONM
  173.       MCHELM.INFCHE(ISOUS,1)=0
  174.       MCHELM.INFCHE(ISOUS,2)=0
  175.       MCHELM.INFCHE(ISOUS,3)=NIFOUR
  176.       MCHELM.INFCHE(ISOUS,4)=MINTE
  177.       MCHELM.INFCHE(ISOUS,5)=0
  178.       MCHELM.INFCHE(ISOUS,6)=5
  179.       MCHEL1.INFCHE(ISOUS,1)=0
  180.       MCHEL1.INFCHE(ISOUS,2)=0
  181.       MCHEL1.INFCHE(ISOUS,3)=NIFOUR
  182.       MCHEL1.INFCHE(ISOUS,4)=MINTE
  183.       MCHEL1.INFCHE(ISOUS,5)=0
  184.       MCHEL1.INFCHE(ISOUS,6)=5
  185.       MCHEL2.INFCHE(ISOUS,1)=0
  186.       MCHEL2.INFCHE(ISOUS,2)=0
  187.       MCHEL2.INFCHE(ISOUS,3)=NIFOUR
  188.       MCHEL2.INFCHE(ISOUS,4)=MINTE
  189.       MCHEL2.INFCHE(ISOUS,5)=0
  190.       MCHEL2.INFCHE(ISOUS,6)=5
  191. * Llena informacion la rigidite
  192. *  Activa segmento MINTE
  193.       NBNO=NBNN
  194.       NBPGAU=MINTE.POIGAU(/1)
  195.       IPMINT=MINTE
  196. *  Inicializa segmento descr, descripcion incognitas matriz rigidite
  197.       NLIGRP=LRE
  198.       NLIGRD=LRE
  199.       SEGINI DESCR
  200.       IPDESCR=DESCR
  201.  
  202.         nomid=lnomid(1)
  203.         if (nomid.eq.0) then
  204.           write(ioimp,*) 'LNOMID(1)=0'
  205.           call erreur(5)
  206.         endif
  207.         modepl=nomid
  208.         ndepl=lesobl(/2)
  209.         ndum=lesfac(/2)
  210.  
  211.         nomid=lnomid(2)
  212.         if (nomid.eq.0) then
  213.           write(ioimp,*) 'LNOMID(2)=0'
  214.           call erreur(5)
  215.         endif
  216.         moforc=nomid
  217.         nforc=lesobl(/2)
  218.         ndum=lesfac(/2)
  219.  
  220. *  Llena el segmento descr con los nombres de las incognitas
  221.       IDDL=1
  222.       NCOMP=NDEPL
  223.       NBNNS=NBNN
  224.       DO INOEUD=1,NBNNS
  225.           DO ICOMP=1,NCOMP
  226.                NOMID=MODEPL
  227.                DESCR.LISINC(IDDL)=LESOBL(ICOMP)
  228.                NOMID=MOFORC
  229.                DESCR.LISDUA(IDDL)=LESOBL(ICOMP)
  230.                NOELEP(IDDL)=INOEUD
  231.                NOELED(IDDL)=INOEUD
  232.                IDDL=IDDL+1
  233.           ENDDO
  234.       ENDDO
  235. *  Inicializa segmento imatri, chapeau sur les segments
  236. *      contenant les matrices de rigidite elementaires
  237.       NELRIG =NBELEM
  238.       SEGINI xMATRI
  239. *  Trata la rigidite
  240.       MRIGID.IRIGEL(1,ISOUS)=MELEME
  241.       MRIGID.IRIGEL(2,ISOUS)=0
  242.       MRIGID.IRIGEL(3,ISOUS)=IPDESCR
  243.       MRIGID.IRIGEL(4,ISOUS)=xMATRI
  244.       MRIGID.IRIGEL(5,ISOUS)=NIFOUR
  245.       MRIGID.IRIGEL(6,ISOUS)=0
  246. c     no simetricas = 2, simetricas = 0
  247.       IRIGE7=2
  248.       MRIGID.IRIGEL(7,ISOUS)=IRIGE7
  249.       xmatri.symre=irige7
  250. * tratamiento de los 4 campos dados
  251.       NBNO=NBNNE(NUMGEO(MELE))
  252.       CALL IDENT(MELEME,CONM,IPCHE1,IPCHE2,INFOS,IRTD)
  253.       IF (IRTD.EQ.0)THEN
  254.          write(*,*)' no compatibles'
  255.          RETURN
  256.       ENDIF
  257.  
  258. *  contraintes: IVASTR
  259.         nomid=lnomid(4)
  260.         if (nomid.eq.0) then
  261.           write(ioimp,*) 'LNOMID(4)=0'
  262.           call erreur(5)
  263.         endif
  264.         mostrs=nomid
  265.         nstr=lesobl(/2)
  266.         nfac=lesfac(/2)
  267.       CALL KOMCHA(IPCHE1,MELEME,CONM,MOSTRS,MOTYR8,1,INFOS,3,IVASTR)
  268.       IF (ISUP1.EQ.1) THEN
  269.        CALL VALCHE(IVASTR,NSTR,IPMINT,ippore,MOSTRS,MELE)
  270.        goto 888
  271.       ENDIF
  272. *  variables internes: IVARI
  273.         nomid=lnomid(10)
  274.         if (nomid.eq.0) then
  275.           write(ioimp,*) 'LNOMID(10)=0'
  276.           call erreur(5)
  277.         endif
  278.         movari=nomid
  279.         nvari=lesobl(/2)
  280.         nvarf=lesfac(/2)
  281.       NVART=NVARI+NVARF
  282.       CALL KOMCHA(IPCHE2,MELEME,CONM,MOVARI,MOTYR8,1,INFOS,3,IVARI)
  283.       IF (ISUP2.EQ.1) THEN
  284.        CALL VALCHE(IVARI,NVART,IPMINT,ippore,MOVARI,IELE)
  285.        goto 888
  286.       ENDIF
  287. *  increments de deformations: IVADS
  288.         nomid=lnomid(5)
  289.         if (nomid.eq.0) then
  290.           write(ioimp,*) 'LNOMID(5)=0'
  291.           call erreur(5)
  292.         endif
  293.         moepsi=nomid
  294.         ndef=lesobl(/2)
  295.         nfac=lesfac(/2)
  296.  
  297.       CALL KOMCHA(IPCHE4,MELEME,CONM,MOEPSI,MOTYR8,1,INFOS,3,IVADS)
  298.       IF (ISUP4.EQ.1) THEN
  299.        CALL VALCHE(IVADS,NDEF,IPMINT,ippore,MOEPSI,MELE)
  300.        goto 888
  301.       ENDIF
  302.  
  303. *  caracteristiques materielles: IVAMAT
  304.         nomid=lnomid(6)
  305.         if (nomid.eq.0) then
  306.           write(ioimp,*) 'LNOMID(6)=0'
  307.           call erreur(5)
  308.         endif
  309.         momatr=nomid
  310.         nmatr=lesobl(/2)
  311.         nmatf=lesfac(/2)
  312.       NMATT=NMATR+NMATF
  313.       CALL KOMCHA(IPCAR,MELEME,CONM,MOMATR,MOTYR8,1,INFOS,3,IVAMAT)
  314.       IF (ISUP5.EQ.1) THEN
  315.        CALL VALCHE(IVAMAT,NMATT,IPMINT,ippore,MOMATR,MELE)
  316.        goto 888
  317.       ENDIF
  318. * Creacion de los mchamls de las zonas
  319.       NBPTEL=NBGS
  320.       NEL   =NBELEM
  321.       N1PTEL=NBPTEL
  322.       N1EL  =NEL
  323. *  contraintes
  324.       N2    =NSTRS
  325.       SEGINI MCHAML
  326.       MCHELM.ICHAML(ISOUS)=MCHAML
  327.       mchelm.conche(isous) = conmod
  328.       NSR   =1
  329.       NCOSOR=NSTRS
  330.       SEGINI MPTVAL
  331.       IVASTF=MPTVAL
  332.       NOMID =MOSTRS
  333.       DO ICOMP=1,NSTRS
  334.          MCHAML.NOMCHE(ICOMP)=NOMID.LESOBL(ICOMP)
  335.          MCHAML.TYPCHE(ICOMP)='REAL*8'
  336.          N2PTEL=0
  337.          N2EL=0
  338.          SEGINI MELVAL
  339.          MCHAML.IELVAL(ICOMP)=MELVAL
  340.          IVAL(ICOMP)=MELVAL
  341.       enddo
  342. *  variables internes
  343.       N2    =NVART
  344.       SEGINI MCHAM1
  345.       MCHEL1.ICHAML(ISOUS)=MCHAM1
  346.       mchel1.conche(isous) = conmod
  347.       NSR   =1
  348.       NCOSOR=NVART
  349.       SEGINI MPTVAL
  350.       IVARIF=MPTVAL
  351.       NOMID=MOVARI
  352.       DO ICOMP=1,NVARI
  353.          MCHAM1.NOMCHE(ICOMP)=LESOBL(ICOMP)
  354.          MCHAM1.TYPCHE(ICOMP)='REAL*8'
  355.          N2PTEL=0
  356.          N2EL=0
  357.          SEGINI MELVAL
  358.          MCHAM1.IELVAL(ICOMP)=MELVAL
  359.          IVAL(ICOMP)=MELVAL
  360.       enddo
  361.       DO ICOMP=NVARI+1,NVART
  362.          MCHAM1.NOMCHE(ICOMP)=LESFAC(ICOMP-NVARI)
  363.          MCHAM1.TYPCHE(ICOMP)='REAL*8'
  364.          N2PTEL=0
  365.          N2EL=0
  366.          SEGINI MELVAL
  367.          MCHAM1.IELVAL(ICOMP)=MELVAL
  368.          IVAL(ICOMP)=MELVAL
  369.       enddo
  370.       N1PTEL=NBPTEL
  371.       N1EL=NEL
  372.       N2=NDEF
  373.       SEGINI MCHAM2
  374.       MCHEL2.ICHAML(ISOUS)=MCHAM2
  375.       mchel2.conche(isous) = conmod
  376.       NSR=1
  377.       NCOSOR=NDEF
  378.       SEGINI MPTVAL
  379.       IVADEP=MPTVAL
  380.       NOMID=MOEPSI
  381.       DO ICOMP=1,NDEF
  382.          MCHAM2.NOMCHE(ICOMP)=LESOBL(ICOMP)
  383.          MCHAM2.TYPCHE(ICOMP)='REAL*8'
  384.          N2PTEL=0
  385.          N2EL=0
  386.          SEGINI MELVAL
  387.          MCHAM2.IELVAL(ICOMP)=MELVAL
  388.          IVAL(ICOMP)=MELVAL
  389.       enddo
  390.  
  391.       CALL SSTE2(MATE,INPLAS,MELE,MELEME,MINTE,xMATRI,
  392.      .     NBELEM,NBPTEL,NBNN,LRE,MFR,
  393.      .     IVASTR,IVARI,IVADS,IVAMAT,NSTRS,NVARI,NMATT,
  394.      .     IVASTF,IVARIF,IVADEP,LHOOK,IRIGE7,
  395.      .     PRECIS,NITMAX,NMAXSSTEPS,NNUMER,DELTAX,KERRE)
  396.  
  397. * Desactivar segmentos
  398.          IF(ISUP1.EQ.1)THEN
  399.             CALL DTMVAL (IVASTR,3)
  400.          ELSE
  401.             CALL DTMVAL (IVASTR,1)
  402.          ENDIF
  403.          IF(ISUP2.EQ.1)THEN
  404.             CALL DTMVAL (IVARI,3)
  405.          ELSE
  406.             CALL DTMVAL (IVARI,1)
  407.          ENDIF
  408.          IF(ISUP4.EQ.1)THEN
  409.             CALL DTMVAL (IVADS,3)
  410.          ELSE
  411.             CALL DTMVAL (IVADS,1)
  412.          ENDIF
  413.          IF(ISUP5.EQ.1)THEN
  414.             CALL DTMVAL (IVAMAT,3)
  415.          ELSE
  416.             CALL DTMVAL (IVAMAT,1)
  417.          ENDIF
  418.          IF (KERRE.EQ.0) THEN
  419.             CALL DTMVAL (IVASTF,1)
  420.             CALL DTMVAL (IVARIF,1)
  421.             CALL DTMVAL (IVADEP,1)
  422.          ELSE
  423.             CALL DTMVAL (IVASTF,3)
  424.             CALL DTMVAL (IVARIF,3)
  425.             CALL DTMVAL (IVADEP,3)
  426.             SEGSUP MCHAML,MCHAM1,MCHAM2
  427.             GO TO 888
  428.          END IF
  429. 1000  continue
  430.  
  431.  888  CONTINUE
  432.       IF(KERRE.NE.0)THEN
  433.          SEGSUP MCHELM,MCHEL1,MCHEL2,MRIGID,xMATRI,DESCR
  434.       ENDIF
  435.  
  436.       notype = MOTYR8
  437.       SEGSUP,notype
  438.  
  439.       RETURN
  440.       END
  441.  
  442.  
  443.  

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