Télécharger la plaquette Cast3M


fr en

Télécharger rigi3.eso

Retour à la liste

Numérotation des lignes : 

rigi3

  1. C RIGI3     SOURCE    PV090527  26/04/30    21:16:19     12529          
  2.       SUBROUTINE RIGI3(MATE,MELE,IPMAIL,IPMINT,IPMIN1,NBPGAU,LRE,
  3.      &      NSTRS,IVAMAT,IVACAR,CMATE,MFR,NBGMAT,NELMAT,IMAT,
  4.      &       LHOOK,NMATT,LW,NPINT,IPMATR,IIPDPG)
  5. *---------------------------------------------------------------------*
  6. *        __________________________                                   *
  7. *        |                        |                                   *
  8. *        |  CALCUL DE LA RIGIDITE |                                   *
  9. *        |________________________|                                   *
  10. *                                                                     *
  11. *      coq3,dkt,coq4,coq8,coq2,dst
  12. *                                                                     *
  13. *---------------------------------------------------------------------*
  14. *                                                                     *
  15. *   ENTREES :                                                         *
  16. *   ________                                                          *
  17. *                                                                     *
  18. *        MATE     Numero du materiau                                  *
  19. *        MELE     Numero de l'element fini                            *
  20. *        IPMAIL   Pointeur sur un segment  MELEME                     *
  21. *        IPMINT   Pointeur sur un segment MINTE aux points de Gauss   *
  22. *        IPMIN1   pointeur sur un segment MINTE aux noeuds            *
  23. *        NBPGAU   Nombre de point d'integration pour la rigidite      *
  24. *        LRE      Nombre de ddl dans la matrice de rigidite           *
  25. *        NSTRS    Nombre de composante de contraintes/deformations    *
  26. *        IVAMAT   Pointeur sur un segment MPTVAL pour le materiau ou  *
  27. *                 pour une matrice de hooke                           *
  28. *        IVACAR   Pointeur sur un segment MPTVAL pour les caracteri-  *
  29. *                 stiques                                             *
  30. *        CMATE    Nom du materiau                                     *
  31. *        MFR      Numero de la formulation element fini               *
  32. *        NBGMAT   Taille maxi des melval du materiau (pt de gauss)    *
  33. *        NELMAT   Taille maxi des melval du materiau (No d'element)   *
  34. *        IMAT     (2 il y a une matrice de HOOKE,1 non  )             *
  35. *        NMATT    Nombre de composante de materiau (IMAT=1)           *
  36. *        NPINT    Nombre de points d'integration dans l'epaisseur
  37. *                 dans le cas des elements de coque integres
  38. *
  39. *                                                                     *
  40. *   SORTIES :                                                         *
  41. *   ________                                                          *
  42. *                                                                     *
  43. *        IPMATR   pointeur sur la rigidite de la sous-zone            *
  44. *                                                                     *
  45. *---------------------------------------------------------------------*
  46.       IMPLICIT INTEGER(I-N)
  47.       IMPLICIT REAL*8(A-H,O-Z)
  48.  
  49. -INC PPARAM
  50. -INC CCOPTIO
  51. -INC CCHAMP
  52. -INC CCREEL
  53.  
  54. -INC SMCHAML
  55. -INC SMINTE
  56. -INC SMELEME
  57. -INC SMRIGID
  58. -INC SMMODEL
  59. -INC SMCOORD
  60. -INC SMLREEL
  61.  
  62. -INC TMPTVAL
  63.  
  64.       SEGMENT WRK1
  65.        REAL*8 DDHOOK(LHOOK,LHOOK) ,DDHOMU(LHOOK,LHOOK)
  66.        REAL*8 REL(LRE,LRE) , XE(3,NBBB)
  67.       ENDSEGMENT
  68. *
  69.       SEGMENT WRK2
  70.        REAL*8 SHPWRK(6,NBNO) ,BGENE(LHOOK,LRE)
  71.       ENDSEGMENT
  72. *
  73.       SEGMENT WRK3
  74.        REAL*8 WORK(LW)
  75.       ENDSEGMENT
  76. *
  77.       SEGMENT WRK4
  78.        REAL*8 BPSS(3,3) ,XEL(3,NBBB)
  79.       ENDSEGMENT
  80. *
  81.       SEGMENT WRK5
  82.        REAL*8   BGENE1(LHOOK,LRE),POIG(NBPGA1)
  83.       ENDSEGMENT
  84. *
  85.       SEGMENT,MVELCH
  86.          REAL*8 VALMAT(NV1)
  87.       ENDSEGMENT
  88. *
  89.       CHARACTER*8 CMATE
  90. *
  91. *      write(6,*) 'entree dans rigi3 lhook',lhook
  92. *
  93. C   INITIALISATION DU POINT AUTOUR DUQUEL SE FAIT LE MOUVEMENT
  94. C   DE LA SECTION EN DEFO PLANE GENERALISEE
  95.       IF (IIPDPG.GT.0) THEN
  96. C <- test equivalent ici a IFOUR.EQ.-3
  97. C        SEGACT MCOORD
  98.         IREF=(IIPDPG-1)*(IDIM+1)
  99.         XDPGE=XCOOR(IREF+1)
  100.         YDPGE=XCOOR(IREF+2)
  101.       ELSE
  102.         XDPGE=XZERO
  103.         YDPGE=XZERO
  104.       ENDIF
  105. *
  106.       MELEME=IPMAIL
  107.       NBNN=NUM(/1)
  108.       NBELEM=NUM(/2)
  109. *
  110.       NV1=NMATT
  111.       SEGINI,MVELCH
  112. *
  113.       XMATRI=IPMATR
  114. C*    NLIGRP=LRE
  115. C*    NLIGRD=LRE
  116. *
  117.       NHRM=NIFOUR
  118. *
  119.       MINTE=IPMINT
  120.       IRTD=1
  121. C
  122. C_______________________________________________________________________
  123. C
  124. C     NUMERO DES ETIQUETTES      :
  125. C     ETIQUETTES DE 1 A 98 POUR TRAITEMENT SPECIFIQUE A L ELEMENT
  126. C     DANS LA ZONE SPECIFIQUE A CHAQUE ELEMENT COMMENCANT PAR :
  127. C     5  CONTINUE
  128. C     ELEMENT 5   ETIQUETTES 1005 2005 3005 4005   ...
  129. C     44 CONTINUE
  130. C     ELEMENT 44  ETIQUETTES 1044 2044 3044 4044   ...
  131. C_______________________________________________________________________
  132. C
  133.       GOTO(99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  134.      1      99,99,99,99,99,99,27,28,99,99,99,99,99,99,99,99,99,99,99,99,
  135.      2      41,99,99,44,28,99,99,99,49,99,99,99,99,99,99,41,99,99,99,99,
  136.      3      99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  137.      4      99,99,99,99,99,99,99,99,99,99,99,99,93,99,99,99,99),MELE
  138.       GOTO 99
  139. C_______________________________________________________________________
  140. C
  141. C     ELEMENT COQ3
  142. C_______________________________________________________________________
  143. C
  144.   27  CONTINUE
  145.       NBBB=NBNN
  146.       SEGINI WRK1,WRK3
  147. C
  148. C     BOUCLE DE CALCUL POUR LES DIFFERENTS ELEMENTS
  149. C
  150.       DO  3027 IB=1,NBELEM
  151. C
  152. C     ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  153. C
  154.       CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  155. C
  156. C     ON CHERCHE LES COEFF DES MAT DE HOOKE
  157. C
  158.       MPTVAL=IVAMAT
  159.       IF(IMAT.EQ.2) THEN
  160.         IF (IB.LE.NELMAT.OR.NBGMAT.GT.1) THEN
  161.           MELVAL=IVAL(1)
  162.           IBMN=MIN(IB  ,IELCHE(/2))
  163.           MLREEL=IELCHE(1,IBMN)
  164.           SEGACT MLREEL
  165.           CALL DOHOOO(PROG,LHOOK,DDHOOK)
  166.           SEGDES MLREEL
  167.         ENDIF
  168.       ELSE IF (IMAT.EQ.1) THEN
  169.         DO 9027 IM=1,NMATT
  170.           IF (IVAL(IM).NE.0) THEN
  171.             MELVAL=IVAL(IM)
  172.             IBMN=MIN(IB  ,VELCHE(/2))
  173.             VALMAT(IM)=VELCHE(1,IBMN)
  174.           ELSE
  175.             VALMAT(IM)=0.D0
  176.           ENDIF
  177.  9027   CONTINUE
  178.         IF (IB.LE.NELMAT.OR.NBGMAT.GT.1)
  179.      1  CALL DOHCOM(VALMAT,NMATT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  180.       ENDIF
  181. C
  182. C     CHERCHER LES EPAISSEUR ET EXCENTREMENT
  183. C
  184.       MPTVAL=IVACAR
  185.       MELVAL=IVAL(1)
  186.       IBMN=MIN(IB,VELCHE(/2))
  187.       EPAIST=VELCHE(1,IBMN)
  188.       IF (IVAL(2).NE.0) THEN
  189.         MELVAL=IVAL(2)
  190.         IBMN=MIN(IB,VELCHE(/2))
  191.         EXCEN =VELCHE(1,IBMN)
  192.         IF (EXCEN.NE.0.D0) THEN
  193.           CALL ERREUR(474)
  194.           GO TO 9927
  195.         ENDIF
  196.       ELSE
  197.         EXCEN=0.D0
  198.       ENDIF
  199. C
  200. C     ON CALCULE SA RAIDEUR
  201. C
  202.       CALL COQ3RI(REL,XE,EPAIST,DDHOOK,WORK)
  203. C
  204.  4027 CONTINUE
  205. C
  206. C     REMPLISSAGE DE XMATRI
  207. C
  208.       CALL REMPMT(REL,LRE,RE(1,1,ib))
  209.  3027 CONTINUE
  210.  
  211.       IF(IRTD.EQ.0) THEN
  212.         MOTERR(1:8)=CMATE
  213.         MOTERR(9:16)=NOMFR(MFR/2+1)
  214.         INTERR(1)=IFOUR
  215.         CALL ERREUR(81)
  216.       ENDIF
  217.  9927 CONTINUE
  218.       SEGSUP WRK1,WRK3
  219.       GOTO 510
  220. C_______________________________________________________________________
  221. C
  222. C     ELEMENT DKT
  223. C_______________________________________________________________________
  224. C
  225.   28  CONTINUE
  226.       NBNO=NBNN
  227.       NBBB=NBNN
  228.       SEGINI WRK1,WRK2,WRK4
  229.       IF(NPINT.NE.0)THEN
  230.         NBPGA1=NBPGAU/NPINT
  231.         IF(NBGMAT.NE.1)THEN
  232.          NBPGEP=NPINT
  233.         ELSE
  234.          NBPGEP=1
  235.         ENDIF
  236.         SEGINI WRK5
  237.         DO 1028 IG=1,NBPGA1
  238.          POIG(IG)=POIGAU(IG)
  239.  1028   CONTINUE
  240. Ccccc   CALL POIDNW(NPINT,NBPGA1,2,POIG)
  241.        CALL SIMPSN(NPINT,NBPGA1,2,POIG)
  242.       ENDIF
  243. C
  244.       DO 3028  IB=1,NBELEM
  245. C
  246. C     ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  247. C
  248.       CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  249. C
  250.       CALL VPAST(XE,BPSS)
  251. C     BPSS    STOCKE LA MATRICE DE PASSAGE
  252.       CALL VCORLC (XE,XEL,BPSS)
  253.       CALL ZERO (REL,LRE,LRE)
  254. C
  255. C     ON CHERCHE LES EPAISEURS ET ON LES MOYENNE,
  256. C                LES EXCENTREMENTS ET ON LES MOYENNE.
  257. C
  258.       MPTVAL=IVACAR
  259.       MELVAL=IVAL(1)
  260.       EPAIST=0.D0
  261.       IF (MELVAL.NE.0) THEN
  262.         DO IGAU=1,NBPGAU
  263.           IGMN=MIN(IGAU,VELCHE(/1))
  264.           IBMN=MIN(IB,VELCHE(/2))
  265.           EPAIST=EPAIST+VELCHE(IGMN,IBMN)
  266.         ENDDO
  267.         EPAIST=EPAIST/NBPGAU
  268.       ENDIF
  269. *
  270.       MELVAL=IVAL(2)
  271.       EXCEN=0.D0
  272.       IF (MELVAL.NE.0) THEN
  273.         DO IGAU=1,NBPGAU
  274.           IGMN=MIN(IGAU,VELCHE(/1))
  275.           IBMN=MIN(IB,VELCHE(/2))
  276.           EXCEN=EXCEN+VELCHE(IGMN,IBMN)
  277.         ENDDO
  278.         EXCEN=EXCEN/NBPGAU
  279.       ENDIF
  280. C
  281.       IF(NPINT.EQ.0)THEN
  282. C
  283. C     COQUE GLOBAL
  284. C
  285. C     BOUCLE SUR LES POINTS DE GAUSS
  286. C
  287.       DO 1128  IGAU=1,NBPGAU
  288. *
  289.       CALL BMAT28(IGAU,NBPGAU,POIGAU,QSIGAU,ETAGAU,DZEGAU,
  290.      &            MELE,MFR,NBNO,LRE,IFOUR,NSTRS,0,1.D0,XEL,
  291.      &            SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  292.       DJAC=DJAC*POIGAU(IGAU)
  293. C
  294. C  ON MODIFIE LA MATRICE B EN CAS D'EXCENTREMENT
  295. C
  296.        IF (EXCEN.NE.0.) THEN
  297.       DO      IJL=1,3
  298.       DO      IJC=1,LRE
  299.       BGENE(IJL,IJC)=BGENE(IJL,IJC)+EXCEN*BGENE(IJL+3,IJC)
  300.       enddo    
  301.       enddo    
  302.        ENDIF
  303. C
  304. C     ON CHERCHE LES COEFFICIENTS DE LA MATRICE DE HOOKE
  305. C
  306.       MPTVAL=IVAMAT
  307.       IF(IMAT.EQ.2) THEN
  308.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  309.           MELVAL=IVAL(1)
  310.           IBMN=MIN(IB  ,IELCHE(/2))
  311.           IGMN=MIN(IGAU,IELCHE(/1))
  312.           MLREEL=IELCHE(IGMN,IBMN)
  313.           SEGACT MLREEL
  314.           CALL DOHOOO(PROG,LHOOK,DDHOOK)
  315.           SEGDES MLREEL
  316.         ENDIF
  317.       CALL BDBS1(BGENE,DJAC,DDHOOK,LRE,NSTRS,REL,MFR,IFOUR,MATE,
  318.      1     IGAU,IMAT,EXCEN)
  319.       ELSE IF (IMAT.EQ.1) THEN
  320. *
  321.           DO 9028 IM=1,NMATT
  322.             IF (IVAL(IM).NE.0) THEN
  323.               MELVAL=IVAL(IM)
  324.               IBMN=MIN(IB  ,VELCHE(/2))
  325.               IGMN=MIN(IGAU,VELCHE(/1))
  326.               VALMAT(IM)=VELCHE(IGMN,IBMN)
  327.             ELSE
  328.               VALMAT(IM)=0.D0
  329.             ENDIF
  330.  9028     CONTINUE
  331.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1))
  332.      1    CALL DOHCOM(VALMAT,NMATT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  333.         CALL HOOKMU(EPAIST,0.D0,LHOOK,DDHOOK,DDHOMU)
  334.         CALL BDBS1(BGENE,DJAC,DDHOMU,LRE,NSTRS,REL,MFR,IFOUR,MATE,
  335.      1     IGAU,IMAT,EXCEN)
  336.       ENDIF
  337.  1128 CONTINUE
  338. C
  339.       ELSE
  340. C
  341. C    COQUE INTEGREE
  342. C
  343. C     BOUCLE SUR LES POINTS DE GAUSS DE LA SURFACE
  344. C
  345.       DO 1101  IGAU=1,NBPGA1
  346. *
  347.       CALL BMAT28(IGAU,NBPGAU,POIGAU,QSIGAU,ETAGAU,DZEGAU,
  348.      &            MELE,MFR,NBNO,LRE,IFOUR,LHOOK,0,1.D0,XEL,
  349.      &            SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  350. C
  351. C  ON MODIFIE LA MATRICE B EN CAS D'EXCENTREMENT
  352. C
  353.         IF (EXCEN.NE.0.) THEN
  354.       DO      IJL=1,3
  355.       DO      IJC=1,LRE
  356.       BGENE(IJL,IJC)=BGENE(IJL,IJC)+EXCEN*BGENE(IJL+3,IJC)
  357.       enddo   
  358.       enddo   
  359.         ENDIF
  360. C
  361. C   BOUCLE SUR LES NAPPES DANS L'EPAISSEUR
  362. C
  363.       DO 1102 INAP=1,NBPGEP
  364. C
  365.       IGAU1=(INAP-1)*NBPGA1+IGAU
  366. C
  367. C      CALCUL DE LA MATRICE B CORRESPONDANT AUX DEFORMATIONS 3D
  368. C
  369.       IF(NBGMAT.EQ.1.AND.NPINT.NE.1)THEN
  370.        ZZZ2 = SQRT( (EPAIST**3.D0)/12.D0 )
  371.        ZZZ1 = SQRT( EPAIST )
  372.        DO      IJL=1,3
  373.        DO      IJC=1,LRE
  374.          BGENE1(IJL,IJC)  =ZZZ1*BGENE(IJL,IJC)
  375.          BGENE1(IJL+3,IJC)=ZZZ2*BGENE(IJL+3,IJC)
  376.        enddo    
  377.        enddo    
  378.        DJAC1=DJAC*POIG(IGAU1)
  379.       ELSE
  380.        ZZZ=DZEGAU(IGAU1)*(EPAIST/2.D0)
  381.        DO  IJL=1,3
  382.        DO  IJC=1,LRE
  383.          BGENE1(IJL,IJC)=BGENE(IJL,IJC)
  384.          BGENE1(IJL+3,IJC)=ZZZ*BGENE(IJL+3,IJC)
  385.        enddo    
  386.        enddo    
  387.        DJAC1=DJAC*POIGAU(IGAU1)*(EPAIST/2.D0)
  388.       ENDIF
  389. C
  390. C     ON CHERCHE LA MATRICE DE HOOKE
  391. C
  392.       MPTVAL=IVAMAT
  393.       IF(IMAT.EQ.2) THEN
  394.         IF (IGAU1.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  395.           MELVAL=IVAL(1)
  396.           IBMN=MIN(IB  ,IELCHE(/2))
  397.           IGMN=MIN(IGAU1,IELCHE(/1))
  398.           MLREEL=IELCHE(IGMN,IBMN)
  399.           SEGACT MLREEL
  400.           CALL DHDKTI(PROG,LHOOK,DDHOOK)
  401.           SEGDES MLREEL
  402. *        write(6,*)((ddhook(IU,io),iu=1,6),io=1,6)
  403.         ENDIF
  404.       ELSE IF (IMAT.EQ.1) THEN
  405.           DO 9001 IM=1,NMATT
  406.             IF (IVAL(IM).NE.0) THEN
  407.               MELVAL=IVAL(IM)
  408.               IBMN=MIN(IB  ,VELCHE(/2))
  409.               IGMN=MIN(IGAU1,VELCHE(/1))
  410.               VALMAT(IM)=VELCHE(IGMN,IBMN)
  411.             ELSE
  412.               VALMAT(IM)=0.D0
  413.             ENDIF
  414.  9001     CONTINUE
  415.         IF (IGAU1.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1))
  416.      1    CALL DOHCOM(VALMAT,NMATT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  417. *        write(6,*)((ddhook(IU,io),iu=1,6),io=1,6)
  418.       ENDIF
  419.       CALL BDBS1(BGENE1,DJAC1,DDHOOK,LRE,LHOOK,REL,MFR,IFOUR,MATE,
  420.      1     IGAU,IMAT,EXCEN)
  421.  1102 CONTINUE
  422.  1101 CONTINUE
  423.       ENDIF
  424.       REL(6,6)=REL(5,5)*1.D-7
  425.       REL(12,12)=REL(6,6)
  426.       REL(18,18)=REL(6,6)
  427.       ICOM=0
  428.       IF(ABS(EXCEN).GT.XPETIT .OR. CMATE.EQ.'COMPOSIT'
  429.      1  .OR. IMAT.EQ.2) ICOM=1
  430.       CALL TRANSK(REL,BPSS,LRE,3,ICOM)
  431. C
  432. C     REMPLISSAGE DE XMATRI
  433. C
  434.       CALL REMPMT(REL,LRE,RE(1,1,IB))
  435.  3028 CONTINUE
  436.       IF(IRTD.EQ.0) THEN
  437.         MOTERR(1:8)=CMATE
  438.         MOTERR(9:16)=NOMFR(MFR/2+1)
  439.        INTERR(1)=IFOUR
  440.        CALL ERREUR(81)
  441.       ENDIF
  442.       SEGSUP WRK1,WRK2,WRK4
  443.       IF(NPINT.NE.0)SEGSUP WRK5
  444.       GOTO 510
  445. C_______________________________________________________________________
  446. C
  447. C     ELEMENT COQ8
  448. C_______________________________________________________________________
  449. C
  450.   41  CONTINUE
  451.       NBBB=NBNN
  452.       NBNO=NBNN
  453.       SEGINI WRK1,WRK2,WRK3
  454.       MINTE1=IPMIN1
  455.       SEGACT MINTE1
  456.       NBPGA1=MINTE1.SHPTOT(/3)
  457.       NBN1  =MINTE1.SHPTOT(/2)
  458. C
  459. C     BOUCLE DE CALCUL POUR LES DIFFERENTS ELEMENTS
  460. C
  461.       DO  3041 IB=1,NBELEM
  462. C
  463. C     ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  464. C
  465.       CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  466. C
  467.       CALL ZERO (REL,LRE,LRE)
  468. C
  469. C     ON CHERCHE LES EPAISSEURS ET LES EXCENTREMENTS.
  470. C
  471.       MPTVAL=IVACAR
  472.       DO 4041 IGAU=1,NBPGAU
  473.         MELVAL=IVAL(1)
  474.         IGMN=MIN(IGAU,VELCHE(/1))
  475.         IBMN=MIN(IB,VELCHE(/2))
  476.         WORK(IGAU)   =VELCHE(IGMN,IBMN)
  477.         IF (IVAL(2).NE.0) THEN
  478.           MELVAL=IVAL(2)
  479.           IGMN=MIN(IGAU,VELCHE(/1))
  480.           IBMN=MIN(IB,VELCHE(/2))
  481.           WORK(10+IGAU)=VELCHE(IGMN,IBMN)
  482.         ELSE
  483.           WORK(10+IGAU)=0.D0
  484.         ENDIF
  485.  4041 CONTINUE
  486. C
  487. C      DETERMINATION DES AXES LOCAUX AUX NOEUDS
  488. C
  489.        CALL CQ8LOC(XE,NBNN,MINTE1.SHPTOT,WORK(21),IRR)
  490. C
  491. C       BOUCLE SUR LES POINTS DE GAUSS
  492. C
  493.        DO 3042  IGAU=1,NBPGAU
  494.         E3=DZEGAU(IGAU)
  495.         CALL BCOQ8E(IGAU,XE,NBNN,WORK(1),WORK(11),BGENE,DJAC,
  496.      1             E3,SHPTOT,WORK(21),IRR)
  497. C
  498. C     GESTION D'ERREUR: IRR=0 CORRESPOND A UN VECTEUR NUL (CF. CROSS2)
  499. C                       IRR=-1 CORRESPOND A UN JACOBIEN NUL(CF. SHLJAC)
  500. C
  501.        IF(IRR.EQ.0) THEN
  502.          CALL ERREUR(241)
  503.          GOTO 9941
  504.        ELSE IF(IRR.EQ.-1)THEN
  505.          CALL ERREUR(240)
  506.          GOTO 9941
  507.        ENDIF
  508. C
  509.        DJAC=ABS(DJAC)*POIGAU(IGAU)
  510. C
  511. C     ON CHERCHE LES COEFF DES MAT DE HOOKE
  512. C
  513.        MPTVAL=IVAMAT
  514.        IF(IMAT.EQ.2) THEN
  515.          IF ((IGAU.LE.NBGMAT).AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  516.            MELVAL=IVAL(1)
  517.            IBMN=MIN(IB  ,IELCHE(/2))
  518.            IGMN=MIN(IGAU,IELCHE(/1))
  519.            MLREEL=IELCHE(IGMN,IBMN)
  520.            SEGACT MLREEL
  521.            CALL DOHOOO(PROG,LHOOK,DDHOOK)
  522.            SEGDES MLREEL
  523.          ENDIF
  524.        ELSE IF (IMAT.EQ.1) THEN
  525.          DO 9041 IM=1,NMATT
  526.            IF (IVAL(IM).NE.0) THEN
  527.              MELVAL=IVAL(IM)
  528.              IBMN=MIN(IB  ,VELCHE(/2))
  529.              IGMN=MIN(IGAU,VELCHE(/1))
  530.              VALMAT(IM)=VELCHE(IGMN,IBMN)
  531.            ELSE
  532.              VALMAT(IM)=0.D0
  533.            ENDIF
  534.  9041    CONTINUE
  535.          IF((IGAU.LE.NBGMAT).AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1))
  536.      1     CALL DOHCOE (VALMAT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  537.        ENDIF
  538. C
  539. C     ON CALCULE SA RAIDEUR
  540. C
  541.        CALL COQ8RI(BGENE,DJAC,DDHOOK,LRE,NBPGAU,IGAU,NBNN,REL)
  542. C
  543.  3042 CONTINUE
  544. C
  545. C     REMPLISSAGE DE XMATRI
  546. C
  547.       CALL REMPMT(REL,LRE,RE(1,1,IB))
  548.  3041 CONTINUE
  549. c
  550.       IF(IRTD.EQ.0) THEN
  551.         MOTERR(1:8)=CMATE
  552.         MOTERR(9:16)=NOMFR(MFR/2+1)
  553.        INTERR(1)=IFOUR
  554.        CALL ERREUR(81)
  555.       ENDIF
  556.  9941 CONTINUE
  557.       SEGSUP WRK1,WRK2,WRK3
  558.       SEGDES MINTE1
  559.       GOTO 510
  560. C_______________________________________________________________________
  561. C
  562. C     SECTEUR DE CALCUL POUR LE COQ2
  563. C_______________________________________________________________________
  564. C
  565.   44  CONTINUE
  566.       DIM3=1.D0
  567.       NBNO=NBNN
  568.       NBBB=NBNN
  569.       SEGINI WRK1,WRK2,WRK4
  570.       DO 3044  IB=1,NBELEM
  571. C
  572. C     ON CHERCHE  LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  573. C
  574.       CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  575.       if (idim.eq.3.and.ifour.eq.1) then
  576.         do ii = 1,NBNN
  577.           jj=idimp1*(NUM(ii,IB)-1)
  578.           xel(1,ii) = xe(1,ii)
  579.           xel(2,ii) = xe(2,ii)
  580.           xel(3,ii) = xe(3,ii)
  581.           xe(2,ii) = xel(3,ii)
  582.           xe(3,ii) = XZero
  583.         enddo
  584.       endif
  585. C
  586.       CALL ZERO (REL,LRE,LRE)
  587. C
  588. C     BOUCLE SUR LES POINTS DE GAUSS
  589. C
  590.       DO 4044  IGAU=1,NBPGAU
  591.       MPTVAL=IVACAR
  592.       MELVAL=IVAL(1)
  593.       IBMN=MIN(IB,VELCHE(/2))
  594.       EPAIST=VELCHE(1,IBMN)
  595.       IF (IVAL(2).NE.0) THEN
  596.         MELVAL=IVAL(2)
  597.         IBMN=MIN(IB,VELCHE(/2))
  598.         EXCEN =VELCHE(1,IBMN)
  599.       ELSE
  600.         EXCEN=0.D0
  601.       ENDIF
  602.       IF (IFOUR.EQ.-2) THEN
  603.        IF (IVAL(3).NE.0) THEN
  604.         MELVAL=IVAL(3)
  605.         IBMN=MIN(IB,VELCHE(/2))
  606.         DIM3 =VELCHE(1,IBMN)
  607.        ELSE
  608.         DIM3=1.D0
  609.        ENDIF
  610.       ENDIF
  611. C
  612. C     APPEL A BCOQ2    ...
  613. C
  614.       CALL BCOQ2(BGENE,NSTRS,DJAC,IGAU,IFOUR,XE,NHRM,QSIGAU,POIGAU,
  615.      .           EXCEN,DIM3,IRRT,XDPGE,YDPGE)
  616. C
  617. C     GESTION D'ERREUR
  618. C        LES ERREURS PREVUES SONT LONGEUR DE L'ELEMENT =0 OU RAYON
  619. C        AU POINT D'INTEGRATION =0 OU RAPPORT R/L TROP PETIT (INFERIEUR
  620. C        A 1.E-3).
  621. C
  622.       IF(IRRT.EQ.1) THEN
  623.         INTERR(1)=IB
  624.         CALL ERREUR(255)
  625.         GOTO 9944
  626.       ELSE IF (IRRT.EQ.2) THEN
  627.         INTERR(1)=IB
  628.         CALL ERREUR(256)
  629.         GOTO 9944
  630.       ENDIF
  631. C
  632.       MPTVAL=IVAMAT
  633.       IF(IMAT.EQ.2) THEN
  634.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  635.           MELVAL=IVAL(1)
  636.           IBMN=MIN(IB  ,IELCHE(/2))
  637.           IGMN=MIN(IGAU,IELCHE(/1))
  638.           MLREEL=IELCHE(IGMN,IBMN)
  639.           SEGACT MLREEL
  640.           CALL DOHOOO(PROG,LHOOK,DDHOOK)
  641.           SEGDES MLREEL
  642.         ENDIF
  643.         CALL BDBST(BGENE,DJAC,DDHOOK,LRE,NSTRS,REL)
  644.       ELSE IF (IMAT.EQ.1) THEN
  645. *
  646.           DO 9044 IM=1,NMATT
  647.             IF (IVAL(IM).NE.0) THEN
  648.               MELVAL=IVAL(IM)
  649.               IBMN=MIN(IB  ,VELCHE(/2))
  650.               IGMN=MIN(IGAU,VELCHE(/1))
  651.               VALMAT(IM)=VELCHE(IGMN,IBMN)
  652.             ELSE
  653.               VALMAT(IM)=0.D0
  654.             ENDIF
  655.  9044     CONTINUE
  656.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1))
  657.      1    CALL DOHCOM(VALMAT,NMATT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  658.         CALL HOOKMU(EPAIST,0.D0,LHOOK,DDHOOK,DDHOMU)
  659.         CALL BDBST(BGENE,DJAC,DDHOMU,LRE,NSTRS,REL)
  660.       ENDIF
  661.  4044 CONTINUE
  662. C
  663. C     REMPLISSAGE DE XMATRI
  664. C
  665.       CALL REMPMT(REL,LRE,RE(1,1,IB))
  666.  3044 CONTINUE
  667. C
  668. C IMPRESSION D'UN EVENTUEL MESSAGE D'ERREUR...
  669.       IF(IRTD.EQ.0) THEN
  670.         MOTERR(1:8)=CMATE
  671.         MOTERR(9:16)=NOMFR(MFR/2+1)
  672.        INTERR(1)=IFOUR
  673.        CALL ERREUR(81)
  674.       ENDIF
  675.  9944 CONTINUE
  676.       SEGSUP WRK1,WRK2,WRK4
  677.       GOTO 510
  678. C_______________________________________________________________________
  679. C
  680. C     SECTEUR DE CALCUL POUR LE COQ4
  681. C_______________________________________________________________________
  682. C
  683.   49  CONTINUE
  684.       NBNO=NBNN
  685.       NBBB=NBNN
  686.       SEGINI WRK1,WRK2,WRK4
  687. c
  688. c ... Si le mat\E9riau n'est pas isotrope, dans le cas g\E9n\E9ral les
  689. c     tensions et le cisaillement NE sont PAS d\E9coupl\E9es. Ce qui veut
  690. c     dire qu'on n'a pas le droit de les int\E9grer diff\E9remment ...
  691. c
  692.       DO 3049  IB=1,NBELEM
  693. C
  694. C     ON CHERCHE  LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  695. C
  696.       CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  697. C
  698.       CALL ZERO (REL,LRE,LRE)
  699.       CALL CQ4LOC(XE,XEL,BPSS,IRRT,1)
  700. C     IRRT=1 NODI TROPPO VICINI
  701.       IF(IRRT.EQ.1) THEN
  702.          INTERR(1)=IB
  703.          CALL ERREUR(323)
  704.          GOTO 9949
  705.       ELSE IF(IRRT.EQ.3) THEN
  706.          IRRT = 0
  707.          NOPLAN = 1
  708.       ELSE
  709.          NOPLAN = 0
  710.       ENDIF
  711. C
  712. C     BOUCLE SUR LES POINTS DE GAUSS
  713. C
  714.       MPTVAL=IVACAR
  715.       MELVAL=IVAL(1)
  716.       IBMN=MIN(IB,VELCHE(/2))
  717.       EPAIST=VELCHE(1,IBMN)
  718.       IF (IVAL(2).NE.0) THEN
  719.         MELVAL=IVAL(2)
  720.         IBMN=MIN(IB,VELCHE(/2))
  721.         EXCEN =VELCHE(1,IBMN)
  722.       ELSE
  723.         EXCEN=0.D0
  724.       ENDIF
  725.       DO 4049  IGAU=1,NBPGAU
  726. C
  727. C     APPEL A BCOQ4
  728. C
  729.       if(cmate.eq.'ISOTROPE') then
  730.       CALL BCOQ4(IGAU,XEL,SHPTOT,SHPWRK,BGENE,DJAC,EXCEN,NOPLAN,IRRT,
  731.      +                                                         0)
  732.       else
  733.       CALL BCOQ4O(IGAU,XEL,SHPTOT,SHPWRK,BGENE,DJAC,EXCEN,NOPLAN,IRRT,
  734.      +                                                         0)
  735.       endif
  736.       DJAC=DJAC*POIGAU(IGAU)
  737. C     IRRT=1 JACOBIANO <= 0
  738.       IF(IRRT.EQ.1) THEN
  739.          INTERR(1)=IB
  740.          CALL ERREUR(321)
  741.          GOTO 9949
  742.       ENDIF
  743. C
  744.       MPTVAL=IVAMAT
  745.       IF(IMAT.EQ.2) THEN
  746.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  747.           MELVAL=IVAL(1)
  748.           IBMN=MIN(IB  ,IELCHE(/2))
  749.           IGMN=MIN(IGAU,IELCHE(/1))
  750.           MLREEL=IELCHE(IGMN,IBMN)
  751.           SEGACT MLREEL
  752.           CALL DOHOOO(PROG,LHOOK,DDHOOK)
  753.           SEGDES MLREEL
  754.         ENDIF
  755.         CALL BDBST(BGENE,DJAC,DDHOOK,LRE,NSTRS,REL)
  756.       ELSE IF (IMAT.EQ.1) THEN
  757. *
  758.           DO 9049 IM=1,NMATT
  759.             IF (IVAL(IM).NE.0) THEN
  760.               MELVAL=IVAL(IM)
  761.               IBMN=MIN(IB  ,VELCHE(/2))
  762.               IGMN=MIN(IGAU,VELCHE(/1))
  763.               VALMAT(IM)=VELCHE(IGMN,IBMN)
  764.             ELSE
  765.               VALMAT(IM)=0.D0
  766.             ENDIF
  767.  9049     CONTINUE
  768.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1))
  769.      1    CALL DOHCIS(VALMAT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  770.         CALL HOOKMU(EPAIST,0.D0,LHOOK,DDHOOK,DDHOMU)
  771.         if(cmate.eq.'ISOTROPE') then
  772.            CALL COQ4RI (IGAU,BGENE,DJAC,EXCEN,NOPLAN,DDHOMU,REL)
  773.         else
  774.            CALL COQ4RJ (IGAU,BGENE,DJAC,EXCEN,NOPLAN,DDHOMU,REL)
  775.         endif
  776.       ENDIF
  777.  4049 CONTINUE
  778. C
  779.       REL(6,6)=REL(5,5)*1.D-7
  780.       REL(12,12)=REL(6,6)
  781.       REL(18,18)=REL(6,6)
  782.       REL(24,24)=REL(6,6)
  783.       ICOM=0
  784.       IF(ABS(EXCEN).GT.XPETIT .OR.CMATE.EQ.'COMPOSIT'
  785.      1   .OR. IMAT.EQ.2) ICOM=1
  786.       CALL TRANSK(REL,BPSS,LRE,4,ICOM)
  787. C
  788. C     REMPLISSAGE DE XMATRI
  789. C
  790.       CALL REMPMT(REL,LRE,RE(1,1,IB))
  791.  3049 CONTINUE
  792. C
  793. C IMPRESSION D'UN EVENTUEL MESSAGE D'ERREUR...
  794.       IF(IRTD.EQ.0) THEN
  795.         MOTERR(1:8)=CMATE
  796.         MOTERR(9:16)=NOMFR(MFR/2+1)
  797.        INTERR(1)=IFOUR
  798.        CALL ERREUR(81)
  799.       ENDIF
  800.  9949 CONTINUE
  801.       SEGSUP WRK1,WRK2,WRK4
  802.       GOTO 510
  803. C_______________________________________________________________________
  804. C
  805. C     ELEMENT DST
  806. C_______________________________________________________________________
  807. C
  808.   93  CONTINUE
  809.       NBNO=NBNN
  810.       NBBB=NBNN
  811.       SEGINI WRK1,WRK2,WRK3,WRK4
  812.       IF(CMATE.NE.'ISOTROPE')THEN
  813.          MPTVAL=IVAMAT
  814.          IF(IMAT.EQ.1.AND.CMATE.EQ.'ORTHOTRO')THEN
  815.             MELVAL=IVAL(7)
  816.          ELSE
  817.             MELVAL=IVAL(2)
  818.          ENDIF
  819.          NBGCOS=VELCHE(/1)
  820.       ENDIF
  821.       DO 3093  IB=1,NBELEM
  822. C
  823. C     ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  824. C
  825.       CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  826. C
  827.       CALL VPAST(XE,BPSS)
  828. C     BPSS    STOCKE LA MATRICE DE PASSAGE
  829.       CALL VCORLC (XE,XEL,BPSS)
  830.       CALL ZERO (REL,LRE,LRE)
  831. C
  832. C     BOUCLE SUR LES POINTS DE GAUSS
  833. C
  834.       DO 1193  IGAU=1,NBPGAU
  835.       MPTVAL=IVACAR
  836.       MELVAL=IVAL(1)
  837.       IBMN =MIN(IB,VELCHE(/2))
  838.       EPAIST=VELCHE(1,IBMN)
  839.       IF (IVAL(2).NE.0) THEN
  840.         MELVAL=IVAL(2)
  841.         IBMN =MIN(IB,VELCHE(/2))
  842.         EXCEN =VELCHE(1,IBMN)
  843.       ELSE
  844.         EXCEN=0.D0
  845.       ENDIF
  846. *
  847. * Dans le cas des mat\E9riaux orthotropes, les d\E9formations sont d'abord
  848. * calcul\E9es dans le rep\E8re d'orthotropie (les formules utilis\E9es par les
  849. * routines RCDST et BMFDST ne sont valables que dans ce rep\E8re); elles
  850. * sont ensuite exprim\E9es dans le rep\E8re local de l'\E9l\E9ment.
  851. *
  852.       IF(CMATE.NE.'ISOTROPE')THEN
  853.         IF(IGAU.LE.NBGCOS)THEN
  854.           IF(IMAT.EQ.2)THEN
  855.             MPTVAL=IVAMAT
  856.             MELVAL=IVAL(2)
  857.             IBMN=MIN(IB  ,VELCHE(/2))
  858.             IGMN=MIN(IGAU,VELCHE(/1))
  859.             COSA=VELCHE(IGMN,IBMN)
  860.             MELVAL=IVAL(3)
  861.             IBMN=MIN(IB  ,VELCHE(/2))
  862.             IGMN=MIN(IGAU,VELCHE(/1))
  863.             SINA=VELCHE(IGMN,IBMN)
  864.           ENDIF
  865.         ENDIF
  866.       ENDIF
  867. C
  868. C     ON CHERCHE LES COEFFICIENTS DE LA MATRICE DE HOOKE
  869. C
  870.       MPTVAL=IVAMAT
  871.       IF(IMAT.EQ.2) THEN
  872.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.
  873.      +                   OR.NBGMAT.GT.1)) THEN
  874.           MELVAL=IVAL(1)
  875.           IBMN=MIN(IB  ,IELCHE(/2))
  876.           IGMN=MIN(IGAU,IELCHE(/1))
  877.           MLREEL=IELCHE(IGMN,IBMN)
  878.           SEGACT MLREEL
  879.             CALL DOHOOO(PROG,LHOOK,DDHOMU)
  880.           SEGDES MLREEL
  881.             IF(CMATE.EQ.'ORTHOTRO')
  882.      +           CALL CHGREP1(COSA,SINA,DDHOMU,LHOOK)
  883.         ENDIF
  884.       ELSE IF (IMAT.EQ.1) THEN
  885. *
  886.           DO 9093 IM=1,NMATT
  887.             IF (IVAL(IM).NE.0) THEN
  888.               MELVAL=IVAL(IM)
  889.               IBMN=MIN(IB  ,VELCHE(/2))
  890.               IGMN=MIN(IGAU,VELCHE(/1))
  891.               VALMAT(IM)=VELCHE(IGMN,IBMN)
  892.             ELSE
  893.               VALMAT(IM)=0.D0
  894.             ENDIF
  895.  9093     CONTINUE
  896.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1))
  897.      1    CALL DOHDST(VALMAT,CMATE,IFOUR,NSTRS,DDHOOK,IRTD)
  898.         CALL HOOKMU(EPAIST,0.D0,NSTRS,DDHOOK,DDHOMU)
  899.       ENDIF
  900. *
  901.       CALL ZERO(BGENE,NSTRS,LRE)
  902.       IF(CMATE.NE.'ISOTROPE')THEN
  903.         IF(IGAU.LE.NBGCOS)THEN
  904.          IF(IMAT.EQ.1.AND.CMATE.EQ.'ORTHOTRO')THEN
  905.             COSA=VALMAT(7)
  906.             SINA=VALMAT(8)
  907.           ENDIF
  908.           DO 1393 INO=1,NBNN
  909.            XX=COSA*XEL(1,INO)+SINA*XEL(2,INO)
  910.            YY=(-SINA)*XEL(1,INO)+COSA*XEL(2,INO)
  911.            XE(1,INO)=XX
  912.            XE(2,INO)=YY
  913.  1393     CONTINUE
  914.          ENDIF
  915. CC
  916. C     TERMES DE LA MATRICE DE RIGIDITE RELATIFS
  917. C      AUX CISAILLEMENTS TRANSVERSES
  918. C
  919.         CALL RCDST(XE,NSTRS,LRE,DDHOMU,
  920.      1                WORK(1),WORK(10),WORK(19),REL,BGENE,1)
  921.  
  922. C     TERMES DE LA MATRICE B RELATIFS AUX EFFETS
  923. C        DE MEMBRANE ET DE FLEXION
  924. C
  925.          CALL BMFDST(IGAU,XE,NSTRS,QSIGAU,ETAGAU,SHPTOT,SHPWRK,
  926.      1            WORK(1),WORK(10),WORK(19),BGENE,DUM)
  927. *
  928.          DO 10 NPOI=1,3
  929.          SHPWRK(1,NPOI)=SHPTOT(1,NPOI,IGAU)
  930.          SHPWRK(2,NPOI)=SHPTOT(2,NPOI,IGAU)
  931.          SHPWRK(3,NPOI)=SHPTOT(3,NPOI,IGAU)
  932.   10     CONTINUE
  933.          CALL JACOBI(XEL,SHPWRK,2,3,DJAC)
  934.          CALL ROTB(BGENE,NSTRS,COSA,SINA)
  935.       ELSE
  936. C
  937. C     TERMES DE LA MATRICE DE RIGIDITE RELATIFS
  938. C      AUX CISAILLEMENTS TRANSVERSES
  939. C
  940.         CALL RCDST(XEL,NSTRS,LRE,DDHOMU,
  941.      1              WORK(1),WORK(10),WORK(19),REL,BGENE,1)
  942. C
  943. C     TERMES DE LA MATRICE B RELATIFS AUX EFFETS
  944. C        DE MEMBRANE ET DE FLEXION
  945. C
  946.         CALL BMFDST(IGAU,XEL,NSTRS,QSIGAU,ETAGAU,SHPTOT,SHPWRK,
  947.      1            WORK(1),WORK(10),WORK(19),BGENE,DJAC)
  948.       ENDIF
  949.       DJAC=DJAC*POIGAU(IGAU)
  950. C
  951. C  ON MODIFIE LA MATRICE B EN CAS D'EXCENTREMENT
  952. C
  953.         IF (EXCEN.NE.0.) THEN
  954.       DO      IJL=1,3
  955.       DO      IJC=1,LRE
  956.       BGENE(IJL,IJC)=BGENE(IJL,IJC)+EXCEN*BGENE(IJL+3,IJC)
  957.       enddo   
  958.       enddo   
  959.         ENDIF
  960. C
  961.       CALL BDBS1(BGENE,DJAC,DDHOMU,LRE,NSTRS,REL,MFR,IFOUR,MATE,
  962.      1     IGAU,IMAT,EXCEN)
  963.  1193 CONTINUE
  964.       REL(6,6)=REL(5,5)*1.D-7
  965.       REL(12,12)=REL(6,6)
  966.       REL(18,18)=REL(6,6)
  967.       ICOM=0
  968.       IF(ABS(EXCEN).GT.XPETIT .OR. CMATE.EQ.'COMPOSIT'
  969.      1  .OR. IMAT.EQ.2) ICOM=1
  970.       CALL TRANSK(REL,BPSS,LRE,3,ICOM)
  971. C
  972. C     REMPLISSAGE DE XMATRI
  973. C
  974.       CALL REMPMT(REL,LRE,RE(1,1,IB))
  975.  3093  CONTINUE
  976. C
  977.  9993 CONTINUE
  978.       SEGSUP WRK1,WRK2,WRK3,WRK4
  979.       GOTO 510
  980. *
  981. C=======================================================================
  982. C========= ERREUR : CAS NON PREVUS =====================================
  983. C=======================================================================
  984.    99 CONTINUE
  985.       MOTERR(1:4)=NOMTP(MELE)
  986.       MOTERR(9:12)='RIGI3'
  987.       CALL ERREUR(86)
  988. *
  989.   510 CONTINUE
  990.       SEGSUP,MVELCH
  991. *      SEGDES XMATRI
  992.  
  993.       RETURN
  994.       END
  995.  
  996.  
  997.  
  998.  
  999.  

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