Télécharger la plaquette Cast3M


fr en

Télécharger varile.eso

Retour à la liste

Numérotation des lignes : 

varile

  1. C VARILE    SOURCE    OF166741  26/02/19    21:15:04     12437          
  2.  
  3.       SUBROUTINE VARILE(IPTABL,IPMODL,IPCH1,IPCH2,IPCH3,LESUP,CHARP,
  4.      &                  IRET)
  5.  
  6. C=======================================================================
  7. *
  8. *  OBJET :  
  9. *  °°°°°°°  
  10. *
  11. *  ENTREES :
  12. *  ---------
  13. *     IPMODL  Pointeur sur un MMODEL (=0 si syntaxe CHPOINT)
  14. *     IPCH1   Pointeur sur un MCHAML ou CHPOINT (PARAMETRES finaux)
  15. *     IPCH2   Pointeur sur un MCHAML ou CHPOINT (COEFFICIENTS)
  16. *     IPCH3   Pointeur sur un MCHAML ou CHPOINT (ETAT initial)
  17. *     LESUP   Support de sortie pour le champ si MCHAML
  18. *     CHARP   Chaine definissant le sous type (facultatif) pour MCHAML
  19. *
  20. *
  21. *  SORTIE :
  22. *  °°°°°°°°
  23. *     IRET   Pointeur sur le MCHAML ou CHPOINT resultat
  24. *            =0 si operation impossible
  25. *
  26. C=======================================================================
  27.  
  28.       IMPLICIT INTEGER(I-N)
  29.       IMPLICIT REAL*8 (A-H,O-Z)
  30.  
  31. -INC PPARAM
  32. -INC CCOPTIO
  33. -INC CCNOYAU
  34. -INC CCASSIS
  35. -INC CCREEL
  36.  
  37. -INC SMCOORD
  38. -INC SMELEME
  39. -INC SMMODEL
  40.       POINTEUR MOPARA.NOMID,MOPAVA.NOMID,MOCOEF.NOMID
  41. -INC SMCHAML
  42. -INC SMCHPOI
  43.       POINTEUR IMETAF.MPOVAL,IMETAI.MPOVAL,IMCOEF.MPOVAL
  44. -INC SMLMOTS
  45. -INC SMTABLE
  46.  
  47. -INC TMPTVAL
  48.       POINTEUR IVPARF.MPTVAL,IVETAI.MPTVAL,IVCOEF.MPTVAL
  49.  
  50.       SEGMENT ICPR(nbpts)
  51.  
  52.       SEGMENT NOTYPE
  53.         CHARACTER*16 TYPE(NBTYPE)
  54.       ENDSEGMENT
  55.       POINTEUR MOTYR8.notype
  56.  
  57. C  Entrees/sorties de la routine UMAT
  58.       SEGMENT WKUMAT
  59.         REAL*8 TIME(2),DTIME, TEMP,DTEMP, PRED(NPRED),DPRED(NPRED),
  60.      &         STATEV(NSTATV), PROPS(NPROPS)
  61.         REAL*8 PNEWDT, sse, spd, scd, rpl, drpldt,
  62.      &         coorga(3), drot(3,3), dfgrd0(3,3),dfgrd1(3,3),
  63.      &         sigt(ntens), epst(ntens), depst(ntens),
  64.      &         ddsdde(ntens,ntens), ddsddt(ntens), drplde(ntens)
  65.         INTEGER  ndi, nshr, lcarac, layer, kspt, kstep, KINC
  66.         CHARACTER*16  CMNAME
  67.       ENDSEGMENT
  68.  
  69.       CHARACTER*(*)      CHARP
  70.  
  71.       CHARACTER*(NCONCH) CONM
  72.  
  73.       PARAMETER ( NINF=3 )
  74.       INTEGER INFOS(NINF)
  75.  
  76.       IRET = 0
  77.       JERR = 99
  78.  
  79. C-------------------------------------------------
  80. C- Vérification de la table & Preconditionnement :
  81. C-------------------------------------------------
  82.       ip = 1
  83.       CALL SELLOI(IPTABL,MTAB1,ip)
  84.       IF (MTAB1.LE.0 .OR. IERR.NE.0) RETURN
  85.  
  86.       ITROU1 = mtab1.MTABIV(1)
  87.       LMEPTR = mtab1.MTABIV(2)
  88.       MLMOT1 = mtab1.MTABIV(3)
  89.       MLMOT3 = mtab1.MTABIV(4)
  90.       MLMOT2 = mtab1.MTABIV(5)
  91.       ITROUT = mtab1.MTABIV(6)
  92.       SEGDES,mtab1
  93.  
  94.       SEGACT,MLMOT1,MLMOT3
  95.       NPARA = MLMOT1.MOTS(/2)
  96.       NVARI = MLMOT3.MOTS(/2)
  97.       NETAT = NPARA + NVARI
  98.       NCOEF = 0
  99.       IF (MLMOT2.GT.0) THEN
  100.         SEGACT,MLMOT2
  101.         NCOEF = MLMOT2.MOTS(/2)
  102.       ENDIF
  103.  
  104.       IF (ITROU1.NE.1) THEN
  105.         MOTERR = '(VARI LEXT) valeur ITROU1 inattendue !'
  106.         CALL ERREUR(-385)
  107.         CALL ERREUR(5)
  108.         GOTO 9900
  109.       ENDIF
  110.       IF (NPARA.EQ.0) THEN
  111.         MOTERR = '(VARI LEXT) PARA_LOI = 0 !'
  112.         CALL ERREUR(-385)
  113.         CALL ERREUR(21)
  114.         GOTO 9900
  115.       ENDIF
  116.       IF (NVARI.EQ.0) THEN
  117.         MOTERR = '(VARI LEXT) VARI_LOI = 0 !'
  118.         CALL ERREUR(-385)
  119.         CALL ERREUR(21)
  120.         GOTO 9900
  121.       ENDIF
  122.  
  123. C- IPCH2 = 0 implique IPCH3 = 0
  124.       IF (NCOEF.GT.0) THEN
  125.         IF (IPCH2.EQ.0 .AND. IPCH3.EQ.0) THEN
  126.           MOTERR = 'COEF_LOI/COEFFICIENTS'
  127.           CALL ERREUR(565)
  128.           GOTO 9900
  129.         ENDIF
  130.       ENDIF
  131.  
  132.       IF (ITROUT .EQ. 11) THEN
  133.         IPRED = 2
  134.         NPRED = NPARA - 2
  135.       ELSE IF (ITROUT .EQ. 01 .OR. ITROUT.EQ.10) THEN
  136.         IPRED = 1
  137.         NPRED = NPARA - 1
  138.       ELSE
  139.         IPRED = 0
  140.         NPRED = NPARA
  141.       ENDIF
  142.       NSTATV = NVARI
  143.       NPROPS = MAX(1,NCOEF)
  144.       ntens  = 6
  145.  
  146.       SEGINI,WKUMAT
  147. C- Initialisations arbitraires du segment wkumat
  148. C- Instant initial et pas de temps (iteration globale,
  149.       TIME(1) = 0.D0
  150.       TIME(2) = 0.D0
  151.       DTIME   = 0.D0
  152. C- Temperature a t0 et increment
  153.       TEMP  = 0.0D0
  154.       DTEMP = 0.0D0
  155. C- Parametres :
  156.       DO i = 1, NPRED
  157.         PRED(i)  = 0.D0
  158.         DPRED(i) = 0.D0
  159.       ENDDO
  160. C- Variables :
  161.       DO i = 1, NSTATV
  162.         STATEV(i) = 0.D0
  163.       ENDDO
  164. C- Coefficients :
  165.       DO i = 1, NPROPS
  166.         PROPS(i) = 0.D0
  167.       ENDDO
  168.       sse = 0.D0
  169.       spd = 0.D0
  170.       scd = 0.D0
  171.       rpl = 0.D0
  172.       drpldt = 0.D0
  173.       DO i = 1, ntens
  174.         sigt(i)  = 0.D0
  175.         epst(i)  = 0.D0
  176.         depst(i) = 0.D0
  177.         DO j = 1, ntens
  178.           ddsdde(j,i) = 0.D0
  179.         ENDDO
  180.         ddsddt(i) = 0.D0
  181.         drplde(i) = 0.D0
  182.       ENDDO
  183.       DO j = 1, 3
  184.         coorga(j) = 0.D0
  185.         DO i = 1, 3
  186.           drot(i,j)   = 0.D0
  187.           DFGRD0(i,j) = 0.D0
  188.           DFGRD1(i,j) = 0.D0
  189.         ENDDO
  190.         drot(j,j)   = 1.D0
  191.         DFGRD0(j,j) = 1.D0
  192.         DFGRD1(j,j) = 1.D0
  193.       ENDDO
  194.       PNEWDT = 1.0D+6
  195.       lcarac = 0.D0
  196.       NDI   = IFOUR
  197.       NSHR  = 0
  198.       LAYER = 0
  199.       KSPT  = 0
  200.       KSTEP = 1
  201.       KINC  = 1
  202.       CMNAME = 'LOIEXT          '
  203.  
  204.       SEGACT,MCOORD
  205.  
  206. C----------------------------------------------------------
  207. C  SYNTAXE 1 : MODELE MCHAML (MCHAML) (MCHAML) SUPPORT TYPE
  208. C----------------------------------------------------------
  209.       IF (IPMODL.NE.0) THEN
  210.  
  211.         MCHEL1 = 0
  212.         MCHEL2 = 0
  213.         MCHEL3 = 0
  214.  
  215.         lesup1 = LESUP
  216.         CALL CHASUP(IPMODL,IPCH1,MCHEL1,iret,lesup1)
  217.         IF (iret.NE.0) THEN
  218.           CALL ERREUR(iret)
  219.           GOTO 1900
  220.         ENDIF
  221.         IF (IPCH2.GT.0) THEN
  222.           CALL CHASUP(IPMODL,IPCH2,MCHEL2,iret,lesup1)
  223.           IF (iret.NE.0) THEN
  224.             CALL ERREUR(iret)
  225.             GOTO 1900
  226.           ENDIF
  227.         ENDIF
  228.         IF (IPCH3.GT.0) THEN
  229.           CALL CHASUP(IPMODL,IPCH3,MCHEL3,iret,lesup1)
  230.           IF (iret.NE.0) THEN
  231.             CALL ERREUR(iret)
  232.             GOTO 1900
  233.           ENDIF
  234.         ENDIF
  235.         IF (NCOEF.GT.0) THEN
  236.           CALL EXTR17(IPCH2,mlmots)
  237.           jgm = mlmots.MOTS(/2)
  238.           ierloc = 0
  239.           DO IN = 1, NCOEF
  240.             CALL PLACE(mlmots.MOTS,jgm,ip,MLMOT2.MOTS(IN))
  241.             IF (ip.NE.0) ierloc = ierloc + 1
  242.           ENDDO
  243.           SEGSUP,mlmots
  244. C- Pas de composantes COEF dans IPCH2/MCHEL2
  245. C- On permute MCHEL2 et MCHEL3 si possible
  246.           IF (ierloc.EQ.0) THEN
  247.             IF (IPCH3.EQ.0) THEN
  248.               MOTERR = 'COEF_LOI/COEFFICIENTS'
  249.               CALL ERREUR(565)
  250.               GOTO 1900
  251.             ENDIF
  252.             ip     = MCHEL2
  253.             MCHEL2 = MCHEL3
  254.             MCHEL3 = ip
  255.           ENDIF
  256.         ELSE
  257.           MCHEL3 = MCHEL2
  258.           MCHEL2 = 0
  259.         ENDIF
  260. C- MCHEL1 = PARAmetres, MCHEL2 = COEFFicients, MCHEL3 = VARIables init
  261.  
  262.         NBROBL = NPARA
  263.         NBRFAC = 0
  264.         SEGINI,MOPARA
  265.         DO in = 1, NPARA
  266.           mopara.LESOBL(in) = MLMOT1.MOTS(in)
  267.         ENDDO
  268.  
  269.         NBROBL = NETAT
  270.         NBRFAC = 0
  271.         SEGINI,MOPAVA
  272.         DO in = 1, NPARA
  273.           mopava.LESOBL(in) = MLMOT1.MOTS(in)
  274.         ENDDO
  275.         DO in = 1, NVARI
  276.           mopava.LESOBL(NPARA+in) = MLMOT3.MOTS(in)
  277.         ENDDO
  278.  
  279.         MOCOEF = 0
  280.         IF (NCOEF.GT.0) THEN
  281.           NBROBL = NCOEF
  282.           NBRFAC = 0
  283.           SEGINI,MOCOEF
  284.           DO in = 1, NCOEF
  285.             mocoef.LESOBL(in) = MLMOT2.MOTS(in)
  286.           ENDDO
  287.         ENDIF
  288.  
  289.         nbtype = 1
  290.         SEGINI,MOTYR8
  291.         motyr8.TYPE(1) = 'REAL*8  '
  292.  
  293.         MMODEL = IPMODL
  294.         NSOUS  = mmodel.KMODEL(/1)
  295.  
  296. C  Creation du MCHAML
  297.         N1 = NSOUS
  298.         N3 = 6
  299.         IF (CHARP.EQ.' ') THEN
  300.           L1 = mchel1.TITCHE(/1)
  301.         ELSE
  302.           L1 = LEN(CHARP)
  303.         ENDIF
  304.         SEGINI,MCHELM
  305.         mchelm.IFOCHE = mchel1.IFOCHE
  306.         IF (CHARP.EQ.' ') THEN
  307.           mchelm.TITCHE = MCHEL1.TITCHE
  308.         ELSE
  309.           mchelm.TITCHE = CHARP
  310.         ENDIF
  311.  
  312. C  Boucle sur les sous-zones du MMODEL
  313.         ISOUS = 0
  314.         DO IS = 1, NSOUS
  315.  
  316.           IMODEL = mmodel.KMODEL(IS)
  317.  
  318. C    INITIALISATIONS
  319.           MELE   = imodel.NEFMOD
  320.           IPMAIL = imodel.IMAMOD
  321.           CONM   = imodel.CONMOD
  322.  
  323. c*?          IF (MELE.EQ.259) GOTO 100
  324.  
  325.           IVPARF = 0
  326.           IVCOEF = 0
  327.           IVETAI = 0
  328.           kerr   = 99
  329.  
  330.           ISOUS = ISOUS + 1
  331.  
  332. C   CREATION DU TABLEAU INFOS (UTILITE ?)
  333.           irtd = 1
  334.           CALL IDENT(IPMAIL,CONM,MCHEL1,MCHEL2,INFOS,irtd)
  335.           IF (irtd.NE.1) GOTO 190
  336. c*?          IF (MELE.EQ.22) GOTO 100
  337.  
  338. C Recuperation du segment d'integration MINTE du modele associe a LESUP
  339. C Supports d'integration specifiques selon la formulation du modele
  340.           IPMINT = 0
  341.           lesup1 = LESUP
  342.  
  343.           ithdm  = 0
  344.           nfor = imodel.FORMOD(/2)
  345.           CALL PLACE(FORMOD,nfor,ichph,'CHANGEMENT_PHASE')
  346.           CALL PLACE(FORMOD,nfor,icont,'CONTACT         ')
  347.           CALL PLACE(FORMOD,nfor,icntr,'CONTRAINTE      ')
  348.           CALL PLACE(FORMOD,nfor,iliai,'LIAISON         ')
  349.           IF (ichph.NE.0 .OR. icont.NE.0 .OR. icntr.NE.0 .OR.
  350.      &        iliai.NE.0) lesup1 = 1
  351.           CALL PLACE(FORMOD,nfor,ither,'THERMIQUE       ')
  352.           CALL PLACE(FORMOD,nfor,idiff,'DIFFUSION       ')
  353.           CALL PLACE(FORMOD,nfor,imeta,'METALLURGIE     ')
  354.           IF (ither.NE.0 .OR. idiff.NE.0 .OR. imeta.NE.0) ithdm = 1
  355. c? Peut-on avoir un support 6 en dehors des formulations listees ci-avant ?
  356.           IF ( lesup1 .EQ. 6 ) ithdm = 1
  357. C         Cas des JOI1 ==> Ressorts THERMIQUES
  358.           IF (MELE .EQ. 265) lesup1 = 1
  359.  
  360.           IF (ithdm.NE.0) THEN
  361. C           Support 6 SAUF pour le RAYONNEMENT...
  362.             nmat = imodel.MATMOD(/2)
  363.             CALL PLACE(matmod,nmat,iray,'RAYONNEMENT')
  364.             IF (iray.EQ.0) THEN
  365.               IF (lesup1.GT.2) lesup1 = 6
  366.               NLG = MELE
  367.             ELSE
  368.               IF (lesup1.GT.2) lesup1 = 3
  369.               NLG = NUMGEO(MELE)
  370.             ENDIF
  371.             IF (lesup1.EQ.1) THEN
  372.               CALL TSHAPE(NLG,'NOEUD  ',IPMINT)
  373.             ELSE IF (lesup1.EQ.2) THEN
  374.               CALL TSHAPE(NLG,'GRAVITE',IPMINT)
  375.             ELSE IF (lesup1.EQ.6) THEN
  376.               CALL TSHAPE(NLG,'GAUSS  ',IPMINT)
  377.             ENDIF
  378.           ELSE
  379.             if (infmod(/1).lt.2+lesup1) then
  380.               moterr = '(VARILE) ERREUR 5 - INFMOD(/1) inconsistent?'
  381.               call erreur(-385)
  382.               call erreur(5)
  383.               goto 190
  384.             endif
  385.             IPMINT = INFMOD(2+lesup1)
  386.           ENDIF
  387.           if (ipmint.eq.0) then
  388.             call erreur(5)
  389.             goto 190
  390.           endif
  391.           NPINT = INFMOD(1)
  392.  
  393. * On determine le support IPLACA de la zone du champ en entree :
  394.           MINTE1 = MCHEL1.INFCHE(IS,4)
  395.           IF (MINTE1.EQ.0) THEN
  396.             IPLACA = 0
  397.           ELSE
  398.             IPLACA = MCHEL1.INFCHE(ISOUS,6)
  399.           ENDIF
  400.  
  401.           CALL KOMCHA(MCHEL1,IPMAIL,CONM,MOPARA,MOTYR8,1,INFOS,NINF,
  402.      &                IVPARF)
  403.           IF (IERR.NE.0) GOTO 190
  404.  
  405.           NBGETF = 0
  406.           NELETF = 0
  407.  
  408.           DO in = 1, NPARA
  409.             MELVAL = ivparf.IVAL(in)
  410.             NBGETF = MAX(NBGETF,MELVAL.VELCHE(/1))
  411.             NELETF = MAX(NELETF,MELVAL.VELCHE(/2))
  412.           ENDDO
  413.  
  414.           IF (NCOEF.GT.0) THEN
  415.             CALL KOMCHA(MCHEL2,IPMAIL,CONM,MOCOEF,MOTYR8,1,INFOS,NINF,
  416.      &                  IVCOEF)
  417.             IF (IERR.NE.0) GOTO 190
  418.             DO in = 1, NCOEF
  419.               MELVAL = ivcoef.IVAL(in)
  420.               NBGETF = MAX(NBGETF,MELVAL.VELCHE(/1))
  421.               NELETF = MAX(NELETF,MELVAL.VELCHE(/2))
  422.             ENDDO
  423.           ENDIF
  424.  
  425.           IF (MCHEL3.GT.0) THEN
  426.             CALL KOMCHA(MCHEL3,IPMAIL,CONM,MOPAVA,MOTYR8,1,INFOS,NINF,
  427.      &                  IVETAI)
  428.             IF (IERR.NE.0) GOTO 190
  429.             DO in = 1, NETAT
  430.               MELVAL = ivetai.IVAL(in)
  431.               NBGETF = MAX(NBGETF,MELVAL.VELCHE(/1))
  432.               NELETF = MAX(NELETF,MELVAL.VELCHE(/2))
  433.             ENDDO
  434.           ENDIF
  435.  
  436.           N2 = NETAT
  437.           SEGINI,MCHAML
  438.  
  439.           DO in = 1, NPARA
  440.             mchaml.nomche(in) = mopara.LESOBL(in)
  441.             mchaml.typche(in) = 'REAL*8          '
  442.             mchaml.ielval(in) = ivparf.IVAL(in)
  443.           ENDDO
  444.  
  445.           N1PTEL = NBGETF
  446.           N1EL   = NELETF
  447.           N2PTEL = 0
  448.           N2EL   = 0
  449.  
  450.           DO in = 1, NVARI
  451.             mchaml.nomche(NPARA+in) = mopava.LESOBL(NPARA+in)
  452.             mchaml.typche(NPARA+in) = 'REAL*8          '
  453.             SEGINI,MELVAL
  454.             mchaml.ielval(NPARA+in) = MELVAL
  455.           ENDDO
  456.  
  457.           mchelm.IMACHE(ISOUS) = IPMAIL
  458.           mchelm.CONCHE(ISOUS) = CONM
  459.           mchelm.ICHAML(ISOUS) = MCHAML
  460.           DO ip = 1, N3
  461.             mchelm.INFCHE(ISOUS,ip) = mchel1.INFCHE(IS,ip)
  462.           ENDDO
  463.           mchelm.INFCHE(ISOUS,4) = IPMINT
  464.           IF (lesup1.EQ.1) mchelm.INFCHE(ISOUS,4) = 0
  465.           mchelm.INFCHE(ISOUS,6) = lesup1
  466.  
  467.           DO IELT = 1, NELETF
  468.             DO IGAU = 1, NBGETF
  469.  
  470. C Recuperation des coefficients
  471.               IF (NCOEF.GT.0) THEN
  472.                 DO in = 1, NCOEF
  473.                   MELVAL = ivcoef.IVAL(in)
  474.                   IG = MIN(IGAU,melval.VELCHE(/1))
  475.                   IE = MIN(IELT,melval.VELCHE(/2))
  476.                   wkumat.PROPS(in) = melval.VELCHE(IG,IE)
  477.                 ENDDO
  478.               ENDIF
  479.  
  480. C Recuperation des parametres finaux
  481.               IF (ITROUT .EQ. 11) THEN
  482.                 MELVAL = ivparf.IVAL(1)
  483.                 IG = MIN(IGAU,MELVAL.VELCHE(/1))
  484.                 IE = MIN(IELT,MELVAL.VELCHE(/2))
  485.                 wkumat.DTIME = melval.VELCHE(IG,IE)
  486.                 MELVAL = ivparf.IVAL(2)
  487.                 IG = MIN(IGAU,MELVAL.VELCHE(/1))
  488.                 IE = MIN(IELT,MELVAL.VELCHE(/2))
  489.                 wkumat.DTEMP = melval.VELCHE(IG,IE)
  490.               ELSE IF (ITROUT .EQ. 10) THEN
  491.                 MELVAL = ivparf.IVAL(1)
  492.                 IG = MIN(IGAU,MELVAL.VELCHE(/1))
  493.                 IE = MIN(IELT,MELVAL.VELCHE(/2))
  494.                 wkumat.DTEMP = melval.VELCHE(IG,IE)
  495.               ELSE IF (ITROUT .EQ. 01) THEN
  496.                 MELVAL = ivparf.IVAL(1)
  497.                 IG = MIN(IGAU,MELVAL.VELCHE(/1))
  498.                 IE = MIN(IELT,MELVAL.VELCHE(/2))
  499.                 wkumat.DTIME = melval.VELCHE(IG,IE)
  500.               ENDIF
  501.               DO in = IPRED+1, NPARA
  502.                 MELVAL = ivparf.IVAL(in)
  503.                 IG = MIN(IGAU,MELVAL.VELCHE(/1))
  504.                 IE = MIN(IELT,MELVAL.VELCHE(/2))
  505.                 wkumat.DPRED(in-IPRED) = melval.VELCHE(IG,IE)
  506.               ENDDO
  507. C Recuperation de l'etat initial (si fourni) - Maj Increment
  508.               IF (IVETAI.NE.0) THEN
  509.                 IF (ITROUT .EQ. 11) THEN
  510.                   MELVAL = ivetai.IVAL(1)
  511.                   IG = MIN(IGAU,MELVAL.VELCHE(/1))
  512.                   IE = MIN(IELT,MELVAL.VELCHE(/2))
  513.                   r_z = melval.VELCHE(IG,IE)
  514.                   wkumat.TIME(2) = r_z
  515.                   wkumat.DTIME = wkumat.DTIME - r_z
  516.                   MELVAL = ivetai.IVAL(2)
  517.                   IG = MIN(IGAU,MELVAL.VELCHE(/1))
  518.                   IE = MIN(IELT,MELVAL.VELCHE(/2))
  519.                   r_z = melval.VELCHE(IG,IE)
  520.                   wkumat.TEMP  = r_z
  521.                   wkumat.DTEMP = wkumat.DTEMP - r_z
  522.                 ELSE IF (ITROUT .EQ. 10) THEN
  523.                   MELVAL = ivetai.IVAL(1)
  524.                   IG = MIN(IGAU,MELVAL.VELCHE(/1))
  525.                   IE = MIN(IELT,MELVAL.VELCHE(/2))
  526.                   r_z = melval.VELCHE(IG,IE)
  527.                   wkumat.TEMP  = r_z
  528.                   wkumat.DTEMP = wkumat.DTEMP - r_z
  529.                 ELSE IF (ITROUT .EQ. 01) THEN
  530.                   MELVAL = ivetai.IVAL(1)
  531.                   IG = MIN(IGAU,MELVAL.VELCHE(/1))
  532.                   IE = MIN(IELT,MELVAL.VELCHE(/2))
  533.                   r_z = melval.VELCHE(IG,IE)
  534.                   wkumat.TIME(2) = r_z
  535.                   wkumat.DTIME = wkumat.DTIME - r_z
  536.                 ENDIF
  537.                 DO in = IPRED+1, NPARA
  538.                   MELVAL = ivetai.IVAL(in)
  539.                   IG = MIN(IGAU,melval.VELCHE(/1))
  540.                   IE = MIN(IELT,melval.VELCHE(/2))
  541.                   r_z = melval.VELCHE(IG,IE)
  542.                   wkumat.PRED(in-IPRED)  = r_z
  543.                   wkumat.DPRED(in-IPRED) = wkumat.DPRED(in-IPRED) - r_z
  544.                 ENDDO
  545.                 DO in = 1, NVARI
  546.                   MELVAL = ivetai.IVAL(NPARA+in)
  547.                   IG = MIN(IGAU,melval.VELCHE(/1))
  548.                   IE = MIN(IELT,melval.VELCHE(/2))
  549.                   wkumat.STATEV(in) = melval.VELCHE(IG,IE)
  550.                 ENDDO
  551.               ENDIF
  552.  
  553. **      segprt,wkumat
  554. C Appel depuis CAST3M a la loi externe pointee par LMPETR
  555.               CALL UMATEXT( LMEPTR,
  556.      &                      sigt, STATEV, ddsdde, sse, spd, scd,
  557.      &                      rpl, ddsddt, drplde, drpldt,
  558.      &                      epst, depst, TIME, DTIME,
  559.      &                      TEMP, DTEMP, PRED, DPRED,
  560.      &                      CMNAME, ndi, nshr, ntens, NSTATV,
  561.      &                      PROPS, NCOEF, coorga,
  562.      &                      drot, PNEWDT, lcarac, dfgrd0, dfgrd1,
  563.      &                      IELT, IGAU, layer, kspt, kstep, KINC )
  564.  
  565.               IF (KINC.NE.1) THEN
  566.                 INTERR(1) = KINC
  567.                 CALL ERREUR(957)
  568.                 GOTO 190
  569.               ENDIF
  570.  
  571. C Recuperation de l'etat final calcule
  572.               DO in = 1, NVARI
  573.                 MELVAL = mchaml.IELVAL(NPARA+in)
  574.                 melval.VELCHE(IGAU,IELT) = wkumat.STATEV(in)
  575.               ENDDO
  576.  
  577.             ENDDO
  578.           ENDDO
  579.  
  580.           kerr = 0
  581.  190      CONTINUE
  582.           IF (IVPARF.NE.0) SEGSUP,IVPARF
  583.           IF (IVCOEF.NE.0) SEGSUP,IVCOEF
  584.           IF (IVETAI.NE.0) SEGSUP,IVETAI
  585.  
  586.           IF (kerr.NE.0) GOTO 1900
  587.  
  588.  100      CONTINUE
  589.         ENDDO
  590. C  FIN de la boucle sur les sous-zones du MMODEL
  591. C -----------------------------------------------
  592.  
  593. C* Ajustement du champ de sortie :
  594.         IF (ISOUS.NE.NSOUS) THEN
  595.           N1 = ISOUS
  596.           SEGADJ,mchelm
  597.         ENDIF
  598. C* Compactage du champ de sortie :
  599.         NSOUS = mchelm.ICHAML(/1)
  600.         DO IS = 1, NSOUS
  601.           MCHAML = mchelm.ICHAML(IS)
  602.           DO im = 1, mchaml.IELVAL(/1)
  603.             MELVAL = mchaml.IELVAL(im)
  604.             CALL COMRED(MELVAL)
  605.             mchaml.IELVAL(im) = MELVAL
  606.           ENDDO
  607.         ENDDO
  608.  
  609.         IRET = MCHELM
  610.         JERR = 0
  611.  
  612. C Erreur lors du traitement
  613.  1900   CONTINUE
  614.         IF (JERR.NE.0) THEN
  615.           SEGSUP,MCHELM
  616.           IRET = 0
  617.         ENDIF
  618.  
  619.         SEGSUP,MOPARA,MOPAVA,MOTYR8
  620.  
  621. C--------------------------------------
  622. C  SYNTAXE 2 : MCHPOI (MCHPOI) (MCHPOI)
  623. C--------------------------------------
  624.       ELSE
  625.  
  626.         ilm1 = 0
  627.         ilm2 = 0
  628.         ilm3 = 0
  629.         IMETAF = 0
  630.         IMCOEF = 0
  631.         IMETAI = 0
  632.         ICPR = 0
  633.  
  634. C- Composantes de IPCH1
  635.         CALL EXTR11(IPCH1,ilm1)
  636. C- Composantes de IPCH2
  637.         IF (IPCH2.GT.0) CALL EXTR11(IPCH2,ilm2)
  638. C- Composantes de IPCH3
  639.         IF (IPCH3.GT.0) CALL EXTR11(IPCH3,ilm3)
  640. C- Composantes du Champ final
  641.         jgn = mlmot1.MOTS(/1)
  642.         jgm = NETAT
  643.         SEGINI,MLMOT4
  644.         DO in = 1, NPARA
  645.           mlmot4.MOTS(in) = mlmot1.MOTS(in)
  646.         ENDDO
  647.         DO in = 1, NVARI
  648.           mlmot4.MOTS(NPARA+in) = mlmot3.MOTS(in)
  649.         ENDDO
  650.  
  651. C- Verification de la presence de PARAMETRES dans IPCH1
  652.         mlmots = ilm1
  653.         jgm = mlmots.MOTS(/2)
  654.         ierloc = 0
  655.         DO IN = 1, NPARA
  656.           CALL PLACE(mlmots.MOTS,jgm,ip,MLMOT1.MOTS(IN))
  657.           IF (ip.EQ.0) THEN
  658.             MOTERR = 'ERROR: PARA_LOI/PARAMETRES "'//
  659.      &               MLMOT1.MOTS(IN)//'" is missing in CHPOPF'
  660.             CALL ERREUR(-385)
  661.             ierloc = ierloc + 1
  662.           ENDIF
  663.         ENDDO
  664.         IF (ierloc.NE.0) THEN
  665.           CALL ERREUR(665)
  666.           GOTO 2900
  667.         ENDIF
  668. C- Verification de la presence de COEFFICIENTS dans IPCH2
  669.         IF (NCOEF.GT.0) THEN
  670.           mlmots = ilm2
  671.           jgm = mlmots.MOTS(/2)
  672.           ierloc = 0
  673.           DO IN = 1, NCOEF
  674.             CALL PLACE(mlmots.MOTS,jgm,ip,MLMOT2.MOTS(IN))
  675.             IF (ip.NE.0) ierloc = ierloc + 1
  676.           ENDDO
  677. C- Pas de composantes COEF dans IPCH2 -> On permute IPCH2 et IPCH3
  678.           IF (ierloc.EQ.0) THEN
  679.             IF (IPCH3.EQ.0) THEN
  680.               MOTERR = 'COEF_LOI/COEFFICIENTS'
  681.               CALL ERREUR(565)
  682.               GOTO 2900
  683.             ENDIF
  684.             ip    = IPCH2
  685.             IPCH2 = IPCH3
  686.             IPCH3 = ip
  687.             ip   = ilm2
  688.             ilm2 = ilm3
  689.             ilm3 = ip
  690.             mlmots = ilm2
  691.             jgm = mlmots.MOTS(/2)
  692.             ierloc = 0
  693.             DO IN = 1, NCOEF
  694.               CALL PLACE(mlmots.MOTS,jgm,ip,MLMOT2.MOTS(IN))
  695.               IF (ip.EQ.0) THEN
  696.                 MOTERR = 'ERROR: COEF_LOI/COEFFICIENTS "'//
  697.      &                   MLMOT2.MOTS(IN)//'" is missing in CHPOC'
  698.                 CALL ERREUR(-385)
  699.                 ierloc = ierloc + 1
  700.               ENDIF
  701.             ENDDO
  702.             IF (ierloc.NE.0) THEN
  703.               CALL ERREUR(665)
  704.               GOTO 2900
  705.             ENDIF
  706.           ENDIF
  707.         ELSE
  708.           IPCH3 = IPCH2
  709.           IPCH2 = 0
  710.           ilm3  = ilm2
  711.           ilm2  = 0
  712.         ENDIF
  713. C- Verification de la presence de PARAMETRES/VARIABLES dans IPCHE3
  714.         IF (IPCH3.GT.0) THEN
  715.           mlmots = ilm3
  716.           jgm = mlmots.MOTS(/2)
  717.           ierloc = 0
  718.           DO IN = 1, NPARA
  719.             CALL PLACE(mlmots.MOTS,jgm,ip,MLMOT1.MOTS(IN))
  720.             IF (ip.EQ.0) THEN
  721.               MOTERR = 'ERROR: PARA_LOI/PARAMETRES "'//
  722.      &                 MLMOT1.MOTS(IN)//'" is missing in CHPOI'
  723.               CALL ERREUR(-385)
  724.               ierloc = ierloc + 1
  725.             ENDIF
  726.           ENDDO
  727.           DO IN = 1, NVARI
  728.             CALL PLACE(mlmots.MOTS,jgm,ip,MLMOT3.MOTS(IN))
  729.             IF (ip.EQ.0) THEN
  730.               MOTERR = 'ERROR: VARI_LOI/VARIABLES "'//
  731.      &                 MLMOT3.MOTS(IN)//'" is missing in CHPOI'
  732.               CALL ERREUR(-385)
  733.               ierloc = ierloc + 1
  734.             ENDIF
  735.           ENDDO
  736.           IF (ierloc.NE.0) THEN
  737.             CALL ERREUR(665)
  738.             GOTO 2900
  739.           ENDIF
  740.         ENDIF
  741. C- IPCH1 = PARAmetres, IPCH2 = COEFF, IPCH3 = VARI init
  742.  
  743. C- Maillage support de IPCH1 via ICPR :
  744. C- ICPR(i) = j (jeme noeud du support = noeud numero i)
  745.         IMUL = 1
  746.         CALL EXTR21(IPCH1,IMUL,IPT1)
  747.         IF (IERR.NE.0) RETURN
  748.         nnnoe = ipt1.NUM(/2)
  749.  
  750.         mchpo1 = IPCH1
  751.  
  752.         SEGINI,icpr
  753.         nnnoe = 0
  754.         DO I = 1, mchpo1.IPCHP(/1)
  755.           MSOUPO = mchpo1.IPCHP(I)
  756.           IN = 0
  757.           DO J = 1, msoupo.NOCOMP(/2)
  758. c*?            NHARMO = msoupo.NOHARM(J)
  759.             CALL PLACE(MLMOT1.MOTS,NPARA,ip,msoupo.NOCOMP(J))
  760.             IF (ip.NE.0) IN = IN + 1
  761.           ENDDO
  762.           IF (IN.GT.0) THEN
  763.             MELEME = msoupo.IGEOC
  764.             DO K = 1, meleme.NUM(/2)
  765.               inoe = meleme.num(1,K)
  766.               IF (ICPR(inoe).EQ.0) THEN
  767.                 nnnoe = nnnoe + 1
  768.                 ICPR(inoe) = nnnoe
  769.               ENDIF
  770.             ENDDO
  771.           ENDIF
  772.         ENDDO
  773.  
  774. C- Recuperation des parametres finaux (imetaf)
  775.         N  = nnnoe
  776.         NC = NETAT
  777.         SEGINI,IMETAF
  778.         mchpo1 = IPCH1
  779.         DO i = 1, mchpo1.IPCHP(/1)
  780.           MSOUPO = mchpo1.IPCHP(i)
  781.           MELEME = msoupo.IGEOC
  782.           MPOVAL = msoupo.IPOVAL
  783.           DO j = 1, msoupo.NOCOMP(/2)
  784. c*?            NHARMO = msoupo.NOHARM(j)
  785.             CALL PLACE(MLMOT1.MOTS,NPARA,ip,msoupo.NOCOMP(j))
  786.             IF (ip.GT.0) THEN
  787.               DO k = 1, meleme.NUM(/2)
  788.                 inoe = icpr(meleme.NUM(1,k))
  789.                 imetaf.vpocha(inoe,ip) = mpoval.vpocha(k,j)
  790.               ENDDO
  791.             ENDIF
  792.           ENDDO
  793.         ENDDO
  794.         ifo1 = MCHPO1.IFOPOI
  795.         ifos = ifo1
  796.  
  797. C- Recuperation des coefficients (si besoin)
  798.         IF (NCOEF.GT.0) THEN
  799.           N  = nnnoe
  800.           NC = NCOEF
  801.           SEGINI,IMCOEF
  802.           mchpo2 = IPCH2
  803.           DO i = 1, mchpo2.IPCHP(/1)
  804.             MSOUPO = mchpo2.IPCHP(i)
  805.             MELEME = msoupo.IGEOC
  806.             MPOVAL = msoupo.IPOVAL
  807.             DO j = 1, msoupo.NOCOMP(/2)
  808. c*?            NHARMO = msoupo.NOHARM(J)
  809.               CALL PLACE(MLMOT2.MOTS,NCOEF,ip,msoupo.NOCOMP(j))
  810.               IF (ip.GT.0) THEN
  811.                 DO k = 1, meleme.NUM(/2)
  812.                   inoe = icpr(meleme.NUM(1,k))
  813.                   if (inoe.gt.0) then
  814.                     imcoef.vpocha(inoe,ip) = mpoval.vpocha(k,j)
  815.                   endif
  816.                 ENDDO
  817.               ENDIF
  818.             ENDDO
  819.           ENDDO
  820.           ifo2 = MCHPO2.IFOPOI
  821.           IF (ifo1 .NE. ifo2) THEN
  822.             moterr(1:8)='CHPOINT'
  823.             interr(1)=ifo1
  824.             interr(2)=ifo2
  825.             interr(3)=IFOUR
  826.             call erreur(1132)
  827.             ifos = IFOUR
  828.           ENDIF
  829.         ENDIF
  830.  
  831. C- Recuperation de l'etat initial si fourni
  832.         IF (IPCH3.GT.0) THEN
  833.           N  = nnnoe
  834.           NC = NETAT
  835.           SEGINI,IMETAI
  836.           mchpo3 = IPCH3
  837.           DO i = 1, mchpo3.IPCHP(/1)
  838.             MSOUPO = mchpo3.IPCHP(i)
  839.             MELEME = msoupo.IGEOC
  840.             MPOVAL = msoupo.IPOVAL
  841.             DO j = 1, msoupo.NOCOMP(/2)
  842. c*?            NHARMO = msoupo.NOHARM(J)
  843.               CALL PLACE(MLMOT4.MOTS,NETAT,ip,msoupo.NOCOMP(j))
  844.               IF (ip.GT.0) THEN
  845.                 DO k = 1, meleme.NUM(/2)
  846.                   inoe = icpr(meleme.NUM(1,k))
  847.                   if (inoe.gt.0) then
  848.                     imetai.vpocha(inoe,ip) = mpoval.vpocha(k,j)
  849.                   endif
  850.                 ENDDO
  851.               ENDIF
  852.             ENDDO
  853.           ENDDO
  854.           ifo3 = MCHPO3.IFOPOI
  855.           IF (ifo1 .NE. ifo3) THEN
  856.             moterr(1:8)='CHPOINT'
  857.             interr(1)=ifo1
  858.             interr(2)=ifo3
  859.             interr(3)=IFOUR
  860.             call erreur(1132)
  861.             ifos = IFOUR
  862.           ENDIF
  863.         ENDIF
  864.  
  865. C- Calcul de la loi sur les neouds supports de IPCH1 
  866.         DO IP = 1, nnnoe
  867.  
  868. C Recuperation des parametres finaux
  869.           IF (ITROUT .EQ. 11) THEN
  870.             wkumat.DTIME = imetaf.vpocha(IP,1)
  871.             wkumat.DTEMP = imetaf.vpocha(IP,2)
  872.           ELSE IF (ITROUT .EQ. 10) THEN
  873.             wkumat.DTEMP = imetaf.vpocha(IP,1)
  874.           ELSE IF (ITROUT .EQ. 01) THEN
  875.             wkumat.DTIME = imetaf.vpocha(IP,1)
  876.           ENDIF
  877.           DO in = IPRED+1, NPARA
  878.             wkumat.DPRED(in-IPRED) = imetaf.vpocha(IP,in)
  879.           ENDDO
  880. C Recuperation des coefficients
  881.           IF (NCOEF.GT.0) THEN
  882.             DO in = 1, NCOEF
  883.               wkumat.PROPS(in) = imcoef.vpocha(IP,in)
  884.             ENDDO
  885.           ENDIF
  886. C Recuperation de l'etat initial (si fourni) - Maj Increment
  887.           IF (IMETAI.NE.0) THEN
  888.             IF (ITROUT .EQ. 11) THEN
  889.               r_z = imetai.vpocha(IP,1)
  890.               wkumat.TIME(2) = r_z
  891.               wkumat.DTIME = wkumat.DTIME - r_z
  892.               r_z = imetai.vpocha(IP,2)
  893.               wkumat.TEMP  = r_z
  894.               wkumat.DTEMP = wkumat.DTEMP - r_z
  895.             ELSE IF (ITROUT .EQ. 10) THEN
  896.               r_z = imetai.vpocha(IP,1)
  897.               wkumat.TEMP  = r_z
  898.               wkumat.DTEMP = wkumat.DTEMP - r_z
  899.             ELSE IF (ITROUT .EQ. 01) THEN
  900.               r_z = imetai.vpocha(IP,1)
  901.               wkumat.TIME(2) = r_z
  902.               wkumat.DTIME = wkumat.DTIME - r_z
  903.             ENDIF
  904.             DO in = IPRED+1, NPARA
  905.               r_z = imetai.vpocha(IP,in)
  906.               wkumat.PRED(in-IPRED)  = r_z
  907.               wkumat.DPRED(in-IPRED) = wkumat.DPRED(in-IPRED) - r_z
  908.             ENDDO
  909.             DO in = 1, NVARI
  910.               wkumat.STATEV(in) = imetai.vpocha(IP,NPARA+in)
  911.             ENDDO
  912.           ENDIF
  913.  
  914. C Appel depuis CAST3M a la loi externe pointee par LMPETR
  915.           CALL UMATEXT( LMEPTR,
  916.      &                  sigt, STATEV, ddsdde, sse, spd, scd,
  917.      &                  rpl, ddsddt, drplde, drpldt,
  918.      &                  epst, depst, TIME, DTIME,
  919.      &                  TEMP, DTEMP, PRED, DPRED,
  920.      &                  CMNAME, ndi, nshr, ntens, NSTATV,
  921.      &                  PROPS, NCOEF, coorga,
  922.      &                  drot, PNEWDT, lcarac, dfgrd0, dfgrd1,
  923.      &                  IELT, IGAU, layer, kspt, kstep, KINC )
  924.  
  925.           IF (KINC.NE.1) THEN
  926.             INTERR(1) = KINC
  927.             CALL ERREUR(957)
  928.             GOTO 2900
  929.           ENDIF
  930.  
  931. C Recuperation de l'etat final calcule
  932.           DO in = 1, NVARI
  933.             imetaf.vpocha(IP,NPARA+in) = wkumat.STATEV(in)
  934.           ENDDO
  935.  
  936.         ENDDO
  937.  
  938.         JERR = 0
  939.  
  940.         CALL oooprl(1)
  941.  
  942.         NBNN   = 1
  943.         NBELEM = nnnoe
  944.         NBREF  = 0
  945.         NBSOUS = 0
  946.         SEGINI,IPT1
  947.         DO ip = 1, nbpts
  948.           inoe = icpr(ip)
  949.           if (inoe.ne.0) ipt1.NUM(1,inoe) = ip
  950.         ENDDO
  951.  
  952.         NSOUPO = 1
  953.         NAT    = 2
  954.         SEGINI,MCHPOI
  955.  
  956.         mchpoi.IFOPOI = ifos
  957.         mchpoi.JATTRI(1) = 1
  958.         mchpoi.JATTRI(1) = mchpo1.JATTRI(1)
  959.         mchpoi.MTYPOI = '        '
  960.         mchpoi.MOCHDE = '            CHPOINT CREE PAR VARI LEXT'
  961.         mchpoi.MCPCNF = mchpo1.MCPCNF
  962.  
  963.         NC = NETAT
  964.         SEGINI,MSOUPO
  965.         mchpoi.IPCHP(1) = MSOUPO
  966.  
  967.         DO in = 1, NETAT
  968.           msoupo.NOCOMP(in) = mlmot4.mots(in)
  969.           msoupo.NOHARM(in) = 0
  970.         ENDDO
  971.         msoupo.IGEOC  = IPT1
  972.         msoupo.IPOVAL = IMETAF
  973.  
  974.         IRET = MCHPOI
  975.  
  976.  
  977.  2900   CONTINUE
  978.         mlmots = ilm1
  979.         IF (mlmots.NE.0) SEGSUP,mlmots
  980.         mlmots = ilm2
  981.         IF (mlmots.NE.0) SEGSUP,mlmots
  982.         mlmots = ilm3
  983.         IF (mlmots.NE.0) SEGSUP,mlmots
  984.         IF (IMCOEF.EQ.0) SEGSUP,IMCOEF
  985.         IF (IMETAI.EQ.0) SEGSUP,IMETAI
  986.         IF (ICPR.EQ.0) SEGSUP,ICPR
  987.         SEGSUP,MLMOT4
  988.  
  989.       ENDIF
  990.  
  991. C Fin de VARILE
  992. C =============
  993.       SEGSUP,WKUMAT
  994.       SEGDES,MCOORD
  995.  
  996.  9900 CONTINUE
  997.       SEGDES,MLMOT1,MLMOT3
  998.       IF (MLMOT2.GT.0) SEGDES,MLMOT2
  999.  
  1000. c      return
  1001.       END
  1002.  
  1003.  
  1004.  

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