Télécharger la plaquette Cast3M


fr en

Télécharger fcoul1.eso

Retour à la liste

Numérotation des lignes : 

fcoul1

  1. C FCOUL1    SOURCE    OF166741  25/02/21    21:16:23     12166          
  2.       SUBROUTINE FCOUL1(DEPSI,IPMODL,IPCHE1,IPCHE2,IPCAR,TIME0,TIMEF,
  3.      &                  SIGMA,IPCHE7,IPCHE8,IRETO,NSTRS2)
  4. **********************************************************************
  5. *
  6. *     ECOULEMENT INELASTIQUE POUR LES MODELE A SECTION
  7. *     Boucle sur les ss-zone du modele de section
  8. *
  9. **********************************************************************
  10. *     Pierre Pegon (ISPRA) Juillet/Aout 1993
  11. **********************************************************************
  12. *
  13. *  ENTREES:
  14. *
  15. *  DEPSI(6) INCREMENT DE DEFORMATION POUR LA FIBRE CENTRALE
  16. *  IPMODL = POINTEUR SUR UN OBJET MMODEL
  17. *  IPCHE1 = POINTEUR SUR UN MCHAML DE CONTRAINTES INITIALES
  18. *  IPCHE2 = POINTEUR SUR UN MCHAML DE VARIABLES INTERNES INITIALES
  19. *  IPCAR  = POINTEUR SUR UN MCHAML DE CARACTERISTIQUES
  20. *  TIME0  = INSTANT INITIAL
  21. *  TIMEF  = INSTANT FINAL
  22. *
  23. * SORTIES:
  24. *
  25. *  SIGMA(6) ELEMENT DE REDUCTION DES EFFORT POUR LA FIBRE CENTRALE
  26. *  IPCHE7 = POINTEUR SUR UN MCHAML DE CONTRAINTES
  27. *  IPCHE8 = POINTEUR SUR UN MCHAML DE VARIABLES INTERNES
  28. *
  29. ************************************************************************
  30.       IMPLICIT INTEGER(I-N)
  31.       IMPLICIT REAL*8(A-H,O-Z)
  32.  
  33. -INC PPARAM
  34. -INC CCOPTIO
  35. -INC CCHAMP
  36.  
  37. -INC SMCHAML
  38. -INC SMELEME
  39. -INC SMCOORD
  40. -INC SMMODEL
  41. -INC SMINTE
  42.  
  43. -INC TMPTVAL
  44.  
  45.       SEGMENT NOTYPE
  46.         CHARACTER*16 TYPE(NBTYPE)
  47.       ENDSEGMENT
  48.  
  49. c*      DIMENSION DEPSI(NSTRS2),SIGMA(NSTRS2)
  50.       DIMENSION DEPSI(*),SIGMA(*)
  51.  
  52.       CHARACTER*8 CMATE
  53.       CHARACTER*(NCONCH) CONM
  54.       CHARACTER*16 MOMODL(10)
  55.       PARAMETER ( NINF=3 )
  56.       INTEGER INFOS(NINF)
  57.       LOGICAL lsupva,lsupco,lsupma,lsupca
  58.  
  59.       lsupva=.false.
  60.       lsupco=.false.
  61.       lsupma=.false.
  62.       lsupca=.false.
  63. C
  64.       IRETO=0
  65.       NHRM=NIFOUR
  66. C
  67. C     VERIFICATION DU LIEU SUPPORT DU MCHAML DE CONTRAINTES
  68. C
  69.       CALL  QUESUP(IPMODL,IPCHE1,5,0,ISUP1,IRET1)
  70.       IF (ISUP1.GT.1) RETURN
  71. *
  72. *     VERIFICATION DU LIEU SUPPORT DU MCHAML DE VARIABLES INTERNES
  73. *
  74.       CALL  QUESUP(IPMODL,IPCHE2,5,0,ISUP2,IRET2)
  75.       IF (ISUP2.GT.1) RETURN
  76. C
  77. C     VERIFICATION DU LIEU SUPPORT DU MCHAML DE CARACTERISTIQUES
  78. C
  79.       CALL  QUESUP(IPMODL,IPCAR,5,0,ISUP5,IRET5)
  80.       IF (ISUP5.GT.1) RETURN
  81. C
  82. C     ACTIVATION DU MODELE
  83. C
  84.       MMODEL=IPMODL
  85.       SEGACT MMODEL
  86.       NSOUS=KMODEL(/1)
  87. C
  88. C     CREATION DES 2 MCHELMS
  89. C
  90.       N1=NSOUS
  91.       L1=11
  92.       N3=6
  93.       SEGINI MCHELM
  94.       TITCHE='CONTRAINTES'
  95.       IFOCHE=IFOUR
  96.       IPCHE7=MCHELM
  97.       L1=18
  98.       SEGINI MCHEL1
  99.       MCHEL1.TITCHE='VARIABLES INTERNES'
  100.       MCHEL1.IFOCHE=IFOUR
  101.       IPCHE8=MCHEL1
  102. C
  103. C     MISE A ZERO DES CONTRAINTES
  104. C
  105.       DO IE1=1,NSTRS2
  106.         SIGMA(IE1)=0.D0
  107.       ENDDO
  108. C____________________________________________________________________
  109. C
  110. C     DEBUT DE LA BOUCLE SUR LES DIFFERENTES ZONES
  111. C____________________________________________________________________
  112. C
  113. *-DC-
  114.       EPSUP=-1.0D10
  115.       EPINF= 1.0D10
  116. *
  117.       DAMAG= 0.0D0
  118.       ETIQE= 0.0D0
  119. *-DC-
  120.  
  121.       DO 1000 ISOUS=1,NSOUS
  122. *
  123. *   INITIALISATION
  124. *
  125.          NSTR=0
  126.          MOSTRS=0
  127.          IVASTR=0
  128.          MOVARI=0
  129.          NVARI=0
  130.          NVARF=0
  131.          IVARI=0
  132.          NMATF=0
  133.          NMATR=0
  134.          MOMATR=0
  135.          IVAMAT=0
  136.          NCARA=0
  137.          NCARF=0
  138.          MOCARA=0
  139.          IVACAR=0
  140.          IVASTF=0
  141.          IVARIF=0
  142. C
  143. C     ON RECUPERE L INFORMATION GENERALE
  144. C
  145.          IMODEL=KMODEL(ISOUS)
  146.          SEGACT IMODEL
  147.          IPMAIL=IMAMOD
  148.          CONM  =CONMOD
  149.          IMACHE(ISOUS)=IPMAIL
  150.          CONCHE(ISOUS)=CONMOD
  151.          MCHEL1.IMACHE(ISOUS)=IPMAIL
  152.          MCHEL1.CONCHE(ISOUS)=CONMOD
  153. *
  154.          MELE=NEFMOD
  155.          MELEME=IMAMOD
  156.          SEGACT MELEME
  157.          NBNN=NUM(/1)
  158.          NBELEM=NUM(/2)
  159. C+PPf
  160. C     ON EVACUE LE CAS DU SEGS EN 3D
  161.          IF(MELE.EQ.166.AND.IDIM.EQ.3)THEN
  162.             CALL ERREUR(832)
  163.             GOTO 888
  164.          ENDIF
  165. C+PPf
  166. C
  167. C     TRAITEMENT DU MODELE
  168. C
  169.          NFOR=FORMOD(/2)
  170.          NMAT=MATMOD(/2)
  171. C
  172. C     NATURE DU MATERIAU
  173. C
  174.          CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INFIBR)
  175.          IF (CMATE.EQ.' ')THEN
  176.             CALL ERREUR(251)
  177.             GOTO 888
  178.          ENDIF
  179.          IF(MATE.NE.1)THEN
  180.             CALL ERREUR(635)
  181.             GOTO 888
  182.          ENDIF
  183.          CALL TEMANF(INFIBR,NIFIBR)
  184.          IF((NIFIBR.EQ.0).AND.(INFIBR.NE.0))THEN
  185.             CALL ERREUR(636)
  186.             GOTO 888
  187.          ENDIF
  188.          INFIBR=NIFIBR
  189. *
  190. C____________________________________________________________________
  191. C
  192. C     INFORMATION SUR L'ELEMENT FINI
  193. C____________________________________________________________________
  194. C
  195.          MFR  =INFELE(13)
  196.          IPPORE=0
  197.          IF(MFR.EQ.33) IPPORE=NBNN
  198.          IF (MFR.NE.47)THEN
  199.             CALL ERREUR(637)
  200.             SEGSUP MCHELM,MCHEL1
  201.             RETURN
  202.          ENDIF
  203.          NBG  =INFELE(6)
  204.          NBGS =INFELE(4)
  205.          NSTRS=INFELE(16)
  206.          LRE  =INFELE(9)
  207.          LHOOK=INFELE(10)
  208.          LHOO2=LHOOK*LHOOK
  209. *         MINTE=INFELE(11)
  210.          MINTE=infmod(7)
  211.         IPMINT=MINTE
  212.         SEGACT,MINTE
  213. *
  214. *   REMPLISSAGE DES TABLEAUX INFCHE
  215. *
  216.          INFCHE(ISOUS,1)=0
  217.          INFCHE(ISOUS,2)=0
  218.          INFCHE(ISOUS,3)=NHRM
  219.          INFCHE(ISOUS,4)=IPMINT
  220.          INFCHE(ISOUS,5)=0
  221.          INFCHE(ISOUS,6)=5
  222. *
  223.          MCHEL1.INFCHE(ISOUS,1)=0
  224.          MCHEL1.INFCHE(ISOUS,2)=0
  225.          MCHEL1.INFCHE(ISOUS,3)=NHRM
  226.          MCHEL1.INFCHE(ISOUS,4)=IPMINT
  227.          MCHEL1.INFCHE(ISOUS,5)=0
  228.          MCHEL1.INFCHE(ISOUS,6)=5
  229. C
  230. C     CREATION DU TABLEAU INFOS
  231. C
  232.          CALL IDENT(IPMAIL,CONM,IPCHE1,IPCHE2,INFOS,IRTD)
  233.          IF (IRTD.EQ.0)THEN
  234. *            INFO=IPINF
  235. *            SEGSUP INFO
  236.             GOTO 888
  237.          ENDIF
  238. *
  239. *       TRAITEMENT DU CHAMP DE CONTRAINTES
  240. *
  241.         if(lnomid(4).ne.0) then
  242.          nomid=lnomid(4)
  243.          segact nomid
  244.          mostrs=nomid
  245.          nstr=lesobl(/2)
  246.          nfac=lesfac(/2)
  247.          lsupco=.false.
  248.         else
  249.          lsupco=.true.
  250.          CALL IDCONT(IMODEL,IFOUR,MOSTRS,NSTR,NFAC)
  251.         endif
  252.          IF (MOSTRS.EQ.0) THEN
  253.             MOTERR(1:4)='CONT'
  254.             MOTERR(5:8)=NOMTP(MELE)
  255.             CALL ERREUR (76)
  256. *            INFO=IPINF
  257. *            SEGSUP INFO
  258.             GOTO 888
  259.          ENDIF
  260. *
  261.          NBTYPE=1
  262.          SEGINI NOTYPE
  263.          MOTYPE=NOTYPE
  264.          TYPE(1)='REAL*8'
  265.          CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOSTRS,MOTYPE,1,INFOS,3,IVASTR)
  266.          IF(IERR.NE.0)THEN
  267.             SEGSUP NOTYPE
  268.             GOTO 9990
  269.          ENDIF
  270. *
  271.         IF (ISUP1.EQ.1) THEN
  272.            CALL VALCHE(IVASTR,NSTR,IPMINT,IPPORE,MOSTRS,MELE)
  273.            IF(IERR.NE.0)THEN
  274.              SEGSUP NOTYPE
  275.              ISUP1=0
  276.              GOTO 9990
  277.             ENDIF
  278.         ENDIF
  279. *
  280. *       TRAITEMENT DU CHAMP DE VARIABLES INTERNES
  281. *
  282.        if(lnomid(10).ne.0) then
  283.          nomid=lnomid(10)
  284.          segact nomid
  285.          movari=nomid
  286.          nvari=lesobl(/2)
  287.          nvarf=lesfac(/2)
  288.          lsupva=.false.
  289.        else
  290.          lsupva=.true.
  291.          CALL IDVARI(MFR,IMODEL,MOVARI,NVARI,NVARF)
  292.        endif
  293. *       write(6,*) ' lnomid(10) nvari nvarf ', lnomid(10),nvari,nvarf
  294.          IF (MOVARI.EQ.0) THEN
  295.             MOTERR(1:4)='VARI'
  296.             MOTERR(5:8)=NOMTP(MELE)
  297.             CALL ERREUR (76)
  298.             SEGSUP NOTYPE
  299.             GOTO 9990
  300.          ENDIF
  301. *
  302.          CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOVARI,MOTYPE,1,INFOS,3,IVARI)
  303.          IF(IERR.NE.0)THEN
  304.             SEGSUP NOTYPE
  305.             GOTO 9990
  306.          ENDIF
  307. *
  308.         NVART=NVARI+NVARF
  309.         IF (ISUP2.EQ.1) THEN
  310.            CALL VALCHE(IVARI,NVART,IPMINT,IPPORE,MOVARI,MELE)
  311.            IF(IERR.NE.0)THEN
  312.              SEGSUP NOTYPE
  313.              ISUP2=0
  314.              GOTO 9990
  315.             ENDIF
  316.         ENDIF
  317. *
  318. *   TRAITEMENT DU CHAMP DE CARACTERISTIQUES MATERIELLES
  319. *
  320.         if(lnomid(6).ne.0) then
  321.          nomid=lnomid(6)
  322.          segact nomid
  323.          momatr=nomid
  324.          nmatr=lesobl(/2)
  325.          nmatf=lesfac(/2)
  326.          lsupma=.false.
  327.         else
  328.          lsupma=.true.
  329.          CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF)
  330.         endif
  331.         IF (MOMATR.EQ.0) THEN
  332.            MOTERR(1:4)='MATE'
  333.            MOTERR(5:8)=NOMTP(MELE)
  334.            CALL ERREUR (76)
  335.            GOTO 9990
  336.         ENDIF
  337. *
  338.         IF (NIFIBR.NE.8) THEN
  339.          NBTYPE=1
  340.          SEGINI NOTYPE
  341.          MOTYPE=NOTYPE
  342.          TYPE(1)='REAL*8'
  343. *
  344.         ELSE
  345.           NBTYPE=13
  346.           SEGINI NOTYPE
  347.           MOTYPE=NOTYPE
  348.           DO I=1,NBTYPE
  349.             TYPE(I)='REAL*8'
  350.           ENDDO
  351.           TYPE(10)='POINTEUREVOLUTIO'
  352.           TYPE(11)='POINTEUREVOLUTIO'
  353. *
  354.         ENDIF
  355. *
  356.         CALL KOMCHA(IPCAR,IPMAIL,CONM,MOMATR,MOTYPE,1,
  357.      &                                  INFOS,3,IVAMAT)
  358.         SEGSUP NOTYPE
  359.         IF(IERR.NE.0)THEN
  360.            GOTO 9990
  361.         ENDIF
  362.         NMATT=NMATR+NMATF
  363. *
  364.         IF (ISUP5.EQ.1) THEN
  365.            CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE,MOMATR,MELE)
  366.            IF(IERR.NE.0)THEN
  367.               ISUP5=0
  368.               GOTO 9990
  369.            ENDIF
  370.         ENDIF
  371. *
  372. *      TRAITEMENT DU CHAMP DE CARACTERISTIQUES GEOMETRIQUES
  373. *
  374.         if(lnomid(7).ne.0) then
  375.          nomid=lnomid(7)
  376.          segact nomid
  377.          mocara=nomid
  378.          ncara=lesobl(/2)
  379.          ncarf=lesfac(/2)
  380.          lsupca=.false.
  381.         else
  382.          lsupca=.true.
  383.          CALL IDCARB(MELE,IFOUR,MOCARA,NCARA,NCARF)
  384.         endif
  385. *
  386. *        write(6,*) ' lnomid(7) ncara ncarf ' , lnomid(7),ncara,ncarf
  387.         NBTYPE=1
  388.         SEGINI NOTYPE
  389.         MOTYPE=NOTYPE
  390.         TYPE(1)='REAL*8'
  391. *
  392.         CALL KOMCHA(IPCAR,IPMAIL,CONM,MOCARA,MOTYPE,1,
  393.      &                                     INFOS,3,IVACAR)
  394.         SEGSUP NOTYPE
  395.         IF(IERR.NE.0)THEN
  396.            GOTO 9990
  397.         ENDIF
  398.         NCARR=NCARA+NCARF
  399. *
  400.         IF (ISUP5.EQ.1.AND.MOCARA.NE.0) THEN
  401.            CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  402.            IF(IERR.NE.0)THEN
  403.               ISUP5=0
  404.               GOTO 9990
  405.            ENDIF
  406.         ENDIF
  407. *
  408. *      CREATION DES MCHAMLS DE LA SOUS ZONE
  409. *
  410.          NBPTEL=NBGS
  411.          NEL=NBELEM
  412.          N1PTEL=NBPTEL
  413.          N1EL=NEL
  414. *
  415. *   CONTRAINTES
  416. *
  417.          N2=NSTRS
  418.          SEGINI MCHAML
  419.          ICHAML(ISOUS)=MCHAML
  420.          NSR=1
  421.          NCOSOR=NSTRS
  422.          SEGINI MPTVAL
  423.          IVASTF=MPTVAL
  424.          NOMID=MOSTRS
  425.          SEGACT NOMID
  426.          DO 1100 ICOMP=1,NSTRS
  427.             NOMCHE(ICOMP)=LESOBL(ICOMP)
  428.             TYPCHE(ICOMP)='REAL*8'
  429.             N2PTEL=0
  430.             N2EL=0
  431.             SEGINI MELVAL
  432.             IELVAL(ICOMP)=MELVAL
  433.             IVAL(ICOMP)=MELVAL
  434. 1100     CONTINUE
  435. *
  436. *    VARIABLES INTERNES
  437. *
  438.          N2=NVART
  439.          SEGINI MCHAM1
  440.          MCHEL1.ICHAML(ISOUS)=MCHAM1
  441.          NSR=1
  442.          NCOSOR=NVART
  443.          SEGINI MPTVAL
  444.          IVARIF=MPTVAL
  445.          NOMID=MOVARI
  446.          SEGACT NOMID
  447.          DO 1200 ICOMP=1,NVARI
  448.             MCHAM1.NOMCHE(ICOMP)=LESOBL(ICOMP)
  449.             MCHAM1.TYPCHE(ICOMP)='REAL*8'
  450.             N2PTEL=0
  451.             N2EL=0
  452.             SEGINI MELVAL
  453.             MCHAM1.IELVAL(ICOMP)=MELVAL
  454.             IVAL(ICOMP)=MELVAL
  455. 1200     CONTINUE
  456.          DO 1201 ICOMP=NVARI+1,NVART
  457.             MCHAM1.NOMCHE(ICOMP)=LESFAC(ICOMP)
  458.             MCHAM1.TYPCHE(ICOMP)='REAL*8'
  459.             N2PTEL=0
  460.             N2EL=0
  461.             SEGINI MELVAL
  462.             MCHAM1.IELVAL(ICOMP)=MELVAL
  463.             IVAL(ICOMP)=MELVAL
  464. 1201     CONTINUE
  465. *
  466. *     APPEL A L'ECOULEMENT PROPREMENT DIT
  467. *
  468.          CALL FCOUL2(DEPSI,INFIBR,MELE,IPMAIL,IPMINT,NBPTEL,IVASTR,
  469.      1        IVARI,IVAMAT,IVACAR,NSTRS,NVART,NMATT,NCARR,TIME0,TIMEF,
  470.      2        SIGMA,IVASTF,IVARIF,EPSUP,EPINF,DAMAG,NSTRS2)
  471. *
  472.  9990    CONTINUE
  473. *
  474. ckich contraction eventuelle des melval
  475.         MPTVAL = IVASTF
  476.         do ICOMP=1,NSTRS
  477.           ichin = ival(icomp)
  478.           call comred(ichin)
  479.           ielval(icomp) = ichin
  480. C*        ival(icomp) = ichin
  481.         enddo
  482.  
  483.         MPTVAL=IVARIF
  484.         do ICOMP=1,NVARI
  485.           ichin = ival(icomp)
  486.           call comred(ichin)
  487.           mcham1.ielval(icomp) = ichin
  488. C*        ival(icomp) = ichin
  489.         enddo
  490.         do ICOMP=NVARI+1,NVART
  491.           ichin = ival(icomp)
  492.           call comred(ichin)
  493.           mcham1.ielval(icomp) = ichin
  494. C*        ival(icomp) = ichin
  495.         enddo
  496. *     DESACTIVATION DES SEGMENTS
  497. *
  498.          IF(ISUP1.EQ.1)THEN
  499.             CALL DTMVAL (IVASTR,3)
  500.          ELSE
  501.             CALL DTMVAL (IVASTR,1)
  502.          ENDIF
  503.          IF(ISUP2.EQ.1)THEN
  504.             CALL DTMVAL (IVARI,3)
  505.          ELSE
  506.             CALL DTMVAL (IVARI,1)
  507.          ENDIF
  508.          IF(ISUP5.EQ.1)THEN
  509.             CALL DTMVAL (IVAMAT,3)
  510.             CALL DTMVAL (IVACAR,3)
  511.          ELSE
  512.             CALL DTMVAL (IVAMAT,1)
  513.             CALL DTMVAL (IVACAR,1)
  514.          ENDIF
  515.          IF (IERR.EQ.0) THEN
  516.             CALL DTMVAL (IVASTF,1)
  517.             CALL DTMVAL (IVARIF,1)
  518.          ELSE
  519.             CALL DTMVAL (IVASTF,3)
  520.             CALL DTMVAL (IVARIF,3)
  521.          END IF
  522. *
  523.          IF (MOCARA.NE.0) THEN
  524.             NOMID=MOCARA
  525.             if(lsupca)SEGSUP NOMID
  526.          END IF
  527. *
  528.          IF (MOMATR.NE.0) THEN
  529.             NOMID=MOMATR
  530.             if(lsupma)SEGSUP NOMID
  531.          END IF
  532. *
  533.          IF (MOVARI.NE.0) THEN
  534.             NOMID=MOVARI
  535.             if(lsupva)SEGSUP NOMID
  536.          END IF
  537. *
  538.          IF (MOSTRS.NE.0) THEN
  539.             NOMID=MOSTRS
  540.             if(lsupco)SEGSUP NOMID
  541.          END IF
  542.  
  543.          IF (IERR.NE.0) THEN
  544.             SEGSUP MCHAML,MCHAM1
  545.             GOTO 888
  546.          ENDIF
  547. 1000  CONTINUE
  548. *
  549.  888  CONTINUE
  550.       IF (IERR.EQ.0)THEN
  551.          IRETO=1
  552.       ELSE
  553.          IRETO=0
  554.          SEGSUP MCHELM,MCHEL1
  555.       ENDIF
  556.       END
  557.  
  558.  
  559.  

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