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    OF166741  25/02/21    21:18:18     12166          
  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 1528 IJL=1,3
  298.       DO 1528 IJC=1,LRE
  299.       BGENE(IJL,IJC)=BGENE(IJL,IJC)+EXCEN*BGENE(IJL+3,IJC)
  300.  1528 CONTINUE
  301.        ENDIF
  302. C
  303. C     ON CHERCHE LES COEFFICIENTS DE LA MATRICE DE HOOKE
  304. C
  305.       MPTVAL=IVAMAT
  306.       IF(IMAT.EQ.2) THEN
  307.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  308.           MELVAL=IVAL(1)
  309.           IBMN=MIN(IB  ,IELCHE(/2))
  310.           IGMN=MIN(IGAU,IELCHE(/1))
  311.           MLREEL=IELCHE(IGMN,IBMN)
  312.           SEGACT MLREEL
  313.           CALL DOHOOO(PROG,LHOOK,DDHOOK)
  314.           SEGDES MLREEL
  315.         ENDIF
  316.       CALL BDBS1(BGENE,DJAC,DDHOOK,LRE,NSTRS,REL,MFR,IFOUR,MATE,
  317.      1     IGAU,IMAT,EXCEN)
  318.       ELSE IF (IMAT.EQ.1) THEN
  319. *
  320.           DO 9028 IM=1,NMATT
  321.             IF (IVAL(IM).NE.0) THEN
  322.               MELVAL=IVAL(IM)
  323.               IBMN=MIN(IB  ,VELCHE(/2))
  324.               IGMN=MIN(IGAU,VELCHE(/1))
  325.               VALMAT(IM)=VELCHE(IGMN,IBMN)
  326.             ELSE
  327.               VALMAT(IM)=0.D0
  328.             ENDIF
  329.  9028     CONTINUE
  330.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1))
  331.      1    CALL DOHCOM(VALMAT,NMATT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  332.         CALL HOOKMU(EPAIST,0.D0,LHOOK,DDHOOK,DDHOMU)
  333.         CALL BDBS1(BGENE,DJAC,DDHOMU,LRE,NSTRS,REL,MFR,IFOUR,MATE,
  334.      1     IGAU,IMAT,EXCEN)
  335.       ENDIF
  336.  1128 CONTINUE
  337. C
  338.       ELSE
  339. C
  340. C    COQUE INTEGREE
  341. C
  342. C     BOUCLE SUR LES POINTS DE GAUSS DE LA SURFACE
  343. C
  344.       DO 1101  IGAU=1,NBPGA1
  345. *
  346.       CALL BMAT28(IGAU,NBPGAU,POIGAU,QSIGAU,ETAGAU,DZEGAU,
  347.      &            MELE,MFR,NBNO,LRE,IFOUR,LHOOK,0,1.D0,XEL,
  348.      &            SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  349. C
  350. C  ON MODIFIE LA MATRICE B EN CAS D'EXCENTREMENT
  351. C
  352.         IF (EXCEN.NE.0.) THEN
  353.       DO 1501 IJL=1,3
  354.       DO 1501 IJC=1,LRE
  355.       BGENE(IJL,IJC)=BGENE(IJL,IJC)+EXCEN*BGENE(IJL+3,IJC)
  356.  1501 CONTINUE
  357.         ENDIF
  358. C
  359. C   BOUCLE SUR LES NAPPES DANS L'EPAISSEUR
  360. C
  361.       DO 1102 INAP=1,NBPGEP
  362. C
  363.       IGAU1=(INAP-1)*NBPGA1+IGAU
  364. C
  365. C      CALCUL DE LA MATRICE B CORRESPONDANT AUX DEFORMATIONS 3D
  366. C
  367.       IF(NBGMAT.EQ.1.AND.NPINT.NE.1)THEN
  368.        ZZZ2 = SQRT( (EPAIST**3.D0)/12.D0 )
  369.        ZZZ1 = SQRT( EPAIST )
  370.        DO 1503 IJL=1,3
  371.        DO 1503 IJC=1,LRE
  372.          BGENE1(IJL,IJC)  =ZZZ1*BGENE(IJL,IJC)
  373.          BGENE1(IJL+3,IJC)=ZZZ2*BGENE(IJL+3,IJC)
  374.  1503  CONTINUE
  375.        DJAC1=DJAC*POIG(IGAU1)
  376.       ELSE
  377.        ZZZ=DZEGAU(IGAU1)*(EPAIST/2.D0)
  378.        DO 1502 IJL=1,3
  379.        DO 1502 IJC=1,LRE
  380.          BGENE1(IJL,IJC)=BGENE(IJL,IJC)
  381.          BGENE1(IJL+3,IJC)=ZZZ*BGENE(IJL+3,IJC)
  382.  1502  CONTINUE
  383.        DJAC1=DJAC*POIGAU(IGAU1)*(EPAIST/2.D0)
  384.       ENDIF
  385. C
  386. C     ON CHERCHE LA MATRICE DE HOOKE
  387. C
  388.       MPTVAL=IVAMAT
  389.       IF(IMAT.EQ.2) THEN
  390.         IF (IGAU1.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  391.           MELVAL=IVAL(1)
  392.           IBMN=MIN(IB  ,IELCHE(/2))
  393.           IGMN=MIN(IGAU1,IELCHE(/1))
  394.           MLREEL=IELCHE(IGMN,IBMN)
  395.           SEGACT MLREEL
  396.           CALL DHDKTI(PROG,LHOOK,DDHOOK)
  397.           SEGDES MLREEL
  398. *        write(6,*)((ddhook(IU,io),iu=1,6),io=1,6)
  399.         ENDIF
  400.       ELSE IF (IMAT.EQ.1) THEN
  401.           DO 9001 IM=1,NMATT
  402.             IF (IVAL(IM).NE.0) THEN
  403.               MELVAL=IVAL(IM)
  404.               IBMN=MIN(IB  ,VELCHE(/2))
  405.               IGMN=MIN(IGAU1,VELCHE(/1))
  406.               VALMAT(IM)=VELCHE(IGMN,IBMN)
  407.             ELSE
  408.               VALMAT(IM)=0.D0
  409.             ENDIF
  410.  9001     CONTINUE
  411.         IF (IGAU1.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1))
  412.      1    CALL DOHCOM(VALMAT,NMATT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  413. *        write(6,*)((ddhook(IU,io),iu=1,6),io=1,6)
  414.       ENDIF
  415.       CALL BDBS1(BGENE1,DJAC1,DDHOOK,LRE,LHOOK,REL,MFR,IFOUR,MATE,
  416.      1     IGAU,IMAT,EXCEN)
  417.  1102 CONTINUE
  418.  1101 CONTINUE
  419.       ENDIF
  420.       REL(6,6)=REL(5,5)*1.D-7
  421.       REL(12,12)=REL(6,6)
  422.       REL(18,18)=REL(6,6)
  423.       ICOM=0
  424.       IF(ABS(EXCEN).GT.XPETIT .OR. CMATE.EQ.'COMPOSIT'
  425.      1  .OR. IMAT.EQ.2) ICOM=1
  426.       CALL TRANSK(REL,BPSS,LRE,3,ICOM)
  427. C
  428. C     REMPLISSAGE DE XMATRI
  429. C
  430.       CALL REMPMT(REL,LRE,RE(1,1,IB))
  431.  3028 CONTINUE
  432.       IF(IRTD.EQ.0) THEN
  433.         MOTERR(1:8)=CMATE
  434.         MOTERR(9:16)=NOMFR(MFR/2+1)
  435.        INTERR(1)=IFOUR
  436.        CALL ERREUR(81)
  437.       ENDIF
  438.       SEGSUP WRK1,WRK2,WRK4
  439.       IF(NPINT.NE.0)SEGSUP WRK5
  440.       GOTO 510
  441. C_______________________________________________________________________
  442. C
  443. C     ELEMENT COQ8
  444. C_______________________________________________________________________
  445. C
  446.   41  CONTINUE
  447.       NBBB=NBNN
  448.       NBNO=NBNN
  449.       SEGINI WRK1,WRK2,WRK3
  450.       MINTE1=IPMIN1
  451.       SEGACT MINTE1
  452.       NBPGA1=MINTE1.SHPTOT(/3)
  453.       NBN1  =MINTE1.SHPTOT(/2)
  454. C
  455. C     BOUCLE DE CALCUL POUR LES DIFFERENTS ELEMENTS
  456. C
  457.       DO  3041 IB=1,NBELEM
  458. C
  459. C     ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  460. C
  461.       CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  462. C
  463.       CALL ZERO (REL,LRE,LRE)
  464. C
  465. C     ON CHERCHE LES EPAISSEURS ET LES EXCENTREMENTS.
  466. C
  467.       MPTVAL=IVACAR
  468.       DO 4041 IGAU=1,NBPGAU
  469.         MELVAL=IVAL(1)
  470.         IGMN=MIN(IGAU,VELCHE(/1))
  471.         IBMN=MIN(IB,VELCHE(/2))
  472.         WORK(IGAU)   =VELCHE(IGMN,IBMN)
  473.         IF (IVAL(2).NE.0) THEN
  474.           MELVAL=IVAL(2)
  475.           IGMN=MIN(IGAU,VELCHE(/1))
  476.           IBMN=MIN(IB,VELCHE(/2))
  477.           WORK(10+IGAU)=VELCHE(IGMN,IBMN)
  478.         ELSE
  479.           WORK(10+IGAU)=0.D0
  480.         ENDIF
  481.  4041 CONTINUE
  482. C
  483. C      DETERMINATION DES AXES LOCAUX AUX NOEUDS
  484. C
  485.        CALL CQ8LOC(XE,NBNN,MINTE1.SHPTOT,WORK(21),IRR)
  486. C
  487. C       BOUCLE SUR LES POINTS DE GAUSS
  488. C
  489.        DO 3042  IGAU=1,NBPGAU
  490.         E3=DZEGAU(IGAU)
  491.         CALL BCOQ8E(IGAU,XE,NBNN,WORK(1),WORK(11),BGENE,DJAC,
  492.      1             E3,SHPTOT,WORK(21),IRR)
  493. C
  494. C     GESTION D'ERREUR: IRR=0 CORRESPOND A UN VECTEUR NUL (CF. CROSS2)
  495. C                       IRR=-1 CORRESPOND A UN JACOBIEN NUL(CF. SHLJAC)
  496. C
  497.        IF(IRR.EQ.0) THEN
  498.          CALL ERREUR(241)
  499.          GOTO 9941
  500.        ELSE IF(IRR.EQ.-1)THEN
  501.          CALL ERREUR(240)
  502.          GOTO 9941
  503.        ENDIF
  504. C
  505.        DJAC=ABS(DJAC)*POIGAU(IGAU)
  506. C
  507. C     ON CHERCHE LES COEFF DES MAT DE HOOKE
  508. C
  509.        MPTVAL=IVAMAT
  510.        IF(IMAT.EQ.2) THEN
  511.          IF ((IGAU.LE.NBGMAT).AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  512.            MELVAL=IVAL(1)
  513.            IBMN=MIN(IB  ,IELCHE(/2))
  514.            IGMN=MIN(IGAU,IELCHE(/1))
  515.            MLREEL=IELCHE(IGMN,IBMN)
  516.            SEGACT MLREEL
  517.            CALL DOHOOO(PROG,LHOOK,DDHOOK)
  518.            SEGDES MLREEL
  519.          ENDIF
  520.        ELSE IF (IMAT.EQ.1) THEN
  521.          DO 9041 IM=1,NMATT
  522.            IF (IVAL(IM).NE.0) THEN
  523.              MELVAL=IVAL(IM)
  524.              IBMN=MIN(IB  ,VELCHE(/2))
  525.              IGMN=MIN(IGAU,VELCHE(/1))
  526.              VALMAT(IM)=VELCHE(IGMN,IBMN)
  527.            ELSE
  528.              VALMAT(IM)=0.D0
  529.            ENDIF
  530.  9041    CONTINUE
  531.          IF((IGAU.LE.NBGMAT).AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1))
  532.      1     CALL DOHCOE (VALMAT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  533.        ENDIF
  534. C
  535. C     ON CALCULE SA RAIDEUR
  536. C
  537.        CALL COQ8RI(BGENE,DJAC,DDHOOK,LRE,NBPGAU,IGAU,NBNN,REL)
  538. C
  539.  3042 CONTINUE
  540. C
  541. C     REMPLISSAGE DE XMATRI
  542. C
  543.       CALL REMPMT(REL,LRE,RE(1,1,IB))
  544.  3041 CONTINUE
  545. c
  546.       IF(IRTD.EQ.0) THEN
  547.         MOTERR(1:8)=CMATE
  548.         MOTERR(9:16)=NOMFR(MFR/2+1)
  549.        INTERR(1)=IFOUR
  550.        CALL ERREUR(81)
  551.       ENDIF
  552.  9941 CONTINUE
  553.       SEGSUP WRK1,WRK2,WRK3
  554.       SEGDES MINTE1
  555.       GOTO 510
  556. C_______________________________________________________________________
  557. C
  558. C     SECTEUR DE CALCUL POUR LE COQ2
  559. C_______________________________________________________________________
  560. C
  561.   44  CONTINUE
  562.       DIM3=1.D0
  563.       NBNO=NBNN
  564.       NBBB=NBNN
  565.       SEGINI WRK1,WRK2,WRK4
  566.       DO 3044  IB=1,NBELEM
  567. C
  568. C     ON CHERCHE  LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  569. C
  570.       CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  571.       if (idim.eq.3.and.ifour.eq.1) then
  572.         do ii = 1,NBNN
  573.           jj=idimp1*(NUM(ii,IB)-1)
  574.           xel(1,ii) = xe(1,ii)
  575.           xel(2,ii) = xe(2,ii)
  576.           xel(3,ii) = xe(3,ii)
  577.           xe(2,ii) = xel(3,ii)
  578.           xe(3,ii) = XZero
  579.         enddo
  580.       endif
  581. C
  582.       CALL ZERO (REL,LRE,LRE)
  583. C
  584. C     BOUCLE SUR LES POINTS DE GAUSS
  585. C
  586.       DO 4044  IGAU=1,NBPGAU
  587.       MPTVAL=IVACAR
  588.       MELVAL=IVAL(1)
  589.       IBMN=MIN(IB,VELCHE(/2))
  590.       EPAIST=VELCHE(1,IBMN)
  591.       IF (IVAL(2).NE.0) THEN
  592.         MELVAL=IVAL(2)
  593.         IBMN=MIN(IB,VELCHE(/2))
  594.         EXCEN =VELCHE(1,IBMN)
  595.       ELSE
  596.         EXCEN=0.D0
  597.       ENDIF
  598.       IF (IFOUR.EQ.-2) THEN
  599.        IF (IVAL(3).NE.0) THEN
  600.         MELVAL=IVAL(3)
  601.         IBMN=MIN(IB,VELCHE(/2))
  602.         DIM3 =VELCHE(1,IBMN)
  603.        ELSE
  604.         DIM3=1.D0
  605.        ENDIF
  606.       ENDIF
  607. C
  608. C     APPEL A BCOQ2    ...
  609. C
  610.       CALL BCOQ2(BGENE,NSTRS,DJAC,IGAU,IFOUR,XE,NHRM,QSIGAU,POIGAU,
  611.      .           EXCEN,DIM3,IRRT,XDPGE,YDPGE)
  612. C
  613. C     GESTION D'ERREUR
  614. C        LES ERREURS PREVUES SONT LONGEUR DE L'ELEMENT =0 OU RAYON
  615. C        AU POINT D'INTEGRATION =0 OU RAPPORT R/L TROP PETIT (INFERIEUR
  616. C        A 1.E-3).
  617. C
  618.       IF(IRRT.EQ.1) THEN
  619.         INTERR(1)=IB
  620.         CALL ERREUR(255)
  621.         GOTO 9944
  622.       ELSE IF (IRRT.EQ.2) THEN
  623.         INTERR(1)=IB
  624.         CALL ERREUR(256)
  625.         GOTO 9944
  626.       ENDIF
  627. C
  628.       MPTVAL=IVAMAT
  629.       IF(IMAT.EQ.2) THEN
  630.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  631.           MELVAL=IVAL(1)
  632.           IBMN=MIN(IB  ,IELCHE(/2))
  633.           IGMN=MIN(IGAU,IELCHE(/1))
  634.           MLREEL=IELCHE(IGMN,IBMN)
  635.           SEGACT MLREEL
  636.           CALL DOHOOO(PROG,LHOOK,DDHOOK)
  637.           SEGDES MLREEL
  638.         ENDIF
  639.         CALL BDBST(BGENE,DJAC,DDHOOK,LRE,NSTRS,REL)
  640.       ELSE IF (IMAT.EQ.1) THEN
  641. *
  642.           DO 9044 IM=1,NMATT
  643.             IF (IVAL(IM).NE.0) THEN
  644.               MELVAL=IVAL(IM)
  645.               IBMN=MIN(IB  ,VELCHE(/2))
  646.               IGMN=MIN(IGAU,VELCHE(/1))
  647.               VALMAT(IM)=VELCHE(IGMN,IBMN)
  648.             ELSE
  649.               VALMAT(IM)=0.D0
  650.             ENDIF
  651.  9044     CONTINUE
  652.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1))
  653.      1    CALL DOHCOM(VALMAT,NMATT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  654.         CALL HOOKMU(EPAIST,0.D0,LHOOK,DDHOOK,DDHOMU)
  655.         CALL BDBST(BGENE,DJAC,DDHOMU,LRE,NSTRS,REL)
  656.       ENDIF
  657.  4044 CONTINUE
  658. C
  659. C     REMPLISSAGE DE XMATRI
  660. C
  661.       CALL REMPMT(REL,LRE,RE(1,1,IB))
  662.  3044 CONTINUE
  663. C
  664. C IMPRESSION D'UN EVENTUEL MESSAGE D'ERREUR...
  665.       IF(IRTD.EQ.0) THEN
  666.         MOTERR(1:8)=CMATE
  667.         MOTERR(9:16)=NOMFR(MFR/2+1)
  668.        INTERR(1)=IFOUR
  669.        CALL ERREUR(81)
  670.       ENDIF
  671.  9944 CONTINUE
  672.       SEGSUP WRK1,WRK2,WRK4
  673.       GOTO 510
  674. C_______________________________________________________________________
  675. C
  676. C     SECTEUR DE CALCUL POUR LE COQ4
  677. C_______________________________________________________________________
  678. C
  679.   49  CONTINUE
  680.       NBNO=NBNN
  681.       NBBB=NBNN
  682.       SEGINI WRK1,WRK2,WRK4
  683. c
  684. c ... Si le mat\E9riau n'est pas isotrope, dans le cas g\E9n\E9ral les
  685. c     tensions et le cisaillement NE sont PAS d\E9coupl\E9es. Ce qui veut
  686. c     dire qu'on n'a pas le droit de les int\E9grer diff\E9remment ...
  687. c
  688.       DO 3049  IB=1,NBELEM
  689. C
  690. C     ON CHERCHE  LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  691. C
  692.       CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  693. C
  694.       CALL ZERO (REL,LRE,LRE)
  695.       CALL CQ4LOC(XE,XEL,BPSS,IRRT,1)
  696. C     IRRT=1 NODI TROPPO VICINI
  697.       IF(IRRT.EQ.1) THEN
  698.          INTERR(1)=IB
  699.          CALL ERREUR(323)
  700.          GOTO 9949
  701.       ELSE IF(IRRT.EQ.3) THEN
  702.          IRRT = 0
  703.          NOPLAN = 1
  704.       ELSE
  705.          NOPLAN = 0
  706.       ENDIF
  707. C
  708. C     BOUCLE SUR LES POINTS DE GAUSS
  709. C
  710.       MPTVAL=IVACAR
  711.       MELVAL=IVAL(1)
  712.       IBMN=MIN(IB,VELCHE(/2))
  713.       EPAIST=VELCHE(1,IBMN)
  714.       IF (IVAL(2).NE.0) THEN
  715.         MELVAL=IVAL(2)
  716.         IBMN=MIN(IB,VELCHE(/2))
  717.         EXCEN =VELCHE(1,IBMN)
  718.       ELSE
  719.         EXCEN=0.D0
  720.       ENDIF
  721.       DO 4049  IGAU=1,NBPGAU
  722. C
  723. C     APPEL A BCOQ4
  724. C
  725.       if(cmate.eq.'ISOTROPE') then
  726.       CALL BCOQ4(IGAU,XEL,SHPTOT,SHPWRK,BGENE,DJAC,EXCEN,NOPLAN,IRRT,
  727.      +                                                         0)
  728.       else
  729.       CALL BCOQ4O(IGAU,XEL,SHPTOT,SHPWRK,BGENE,DJAC,EXCEN,NOPLAN,IRRT,
  730.      +                                                         0)
  731.       endif
  732.       DJAC=DJAC*POIGAU(IGAU)
  733. C     IRRT=1 JACOBIANO <= 0
  734.       IF(IRRT.EQ.1) THEN
  735.          INTERR(1)=IB
  736.          CALL ERREUR(321)
  737.          GOTO 9949
  738.       ENDIF
  739. C
  740.       MPTVAL=IVAMAT
  741.       IF(IMAT.EQ.2) THEN
  742.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  743.           MELVAL=IVAL(1)
  744.           IBMN=MIN(IB  ,IELCHE(/2))
  745.           IGMN=MIN(IGAU,IELCHE(/1))
  746.           MLREEL=IELCHE(IGMN,IBMN)
  747.           SEGACT MLREEL
  748.           CALL DOHOOO(PROG,LHOOK,DDHOOK)
  749.           SEGDES MLREEL
  750.         ENDIF
  751.         CALL BDBST(BGENE,DJAC,DDHOOK,LRE,NSTRS,REL)
  752.       ELSE IF (IMAT.EQ.1) THEN
  753. *
  754.           DO 9049 IM=1,NMATT
  755.             IF (IVAL(IM).NE.0) THEN
  756.               MELVAL=IVAL(IM)
  757.               IBMN=MIN(IB  ,VELCHE(/2))
  758.               IGMN=MIN(IGAU,VELCHE(/1))
  759.               VALMAT(IM)=VELCHE(IGMN,IBMN)
  760.             ELSE
  761.               VALMAT(IM)=0.D0
  762.             ENDIF
  763.  9049     CONTINUE
  764.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1))
  765.      1    CALL DOHCIS(VALMAT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  766.         CALL HOOKMU(EPAIST,0.D0,LHOOK,DDHOOK,DDHOMU)
  767.         if(cmate.eq.'ISOTROPE') then
  768.            CALL COQ4RI (IGAU,BGENE,DJAC,EXCEN,NOPLAN,DDHOMU,REL)
  769.         else
  770.            CALL COQ4RJ (IGAU,BGENE,DJAC,EXCEN,NOPLAN,DDHOMU,REL)
  771.         endif
  772.       ENDIF
  773.  4049 CONTINUE
  774. C
  775.       REL(6,6)=REL(5,5)*1.D-7
  776.       REL(12,12)=REL(6,6)
  777.       REL(18,18)=REL(6,6)
  778.       REL(24,24)=REL(6,6)
  779.       ICOM=0
  780.       IF(ABS(EXCEN).GT.XPETIT .OR.CMATE.EQ.'COMPOSIT'
  781.      1   .OR. IMAT.EQ.2) ICOM=1
  782.       CALL TRANSK(REL,BPSS,LRE,4,ICOM)
  783. C
  784. C     REMPLISSAGE DE XMATRI
  785. C
  786.       CALL REMPMT(REL,LRE,RE(1,1,IB))
  787.  3049 CONTINUE
  788. C
  789. C IMPRESSION D'UN EVENTUEL MESSAGE D'ERREUR...
  790.       IF(IRTD.EQ.0) THEN
  791.         MOTERR(1:8)=CMATE
  792.         MOTERR(9:16)=NOMFR(MFR/2+1)
  793.        INTERR(1)=IFOUR
  794.        CALL ERREUR(81)
  795.       ENDIF
  796.  9949 CONTINUE
  797.       SEGSUP WRK1,WRK2,WRK4
  798.       GOTO 510
  799. C_______________________________________________________________________
  800. C
  801. C     ELEMENT DST
  802. C_______________________________________________________________________
  803. C
  804.   93  CONTINUE
  805.       NBNO=NBNN
  806.       NBBB=NBNN
  807.       SEGINI WRK1,WRK2,WRK3,WRK4
  808.       IF(CMATE.NE.'ISOTROPE')THEN
  809.          MPTVAL=IVAMAT
  810.          IF(IMAT.EQ.1.AND.CMATE.EQ.'ORTHOTRO')THEN
  811.             MELVAL=IVAL(7)
  812.          ELSE
  813.             MELVAL=IVAL(2)
  814.          ENDIF
  815.          NBGCOS=VELCHE(/1)
  816.       ENDIF
  817.       DO 3093  IB=1,NBELEM
  818. C
  819. C     ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  820. C
  821.       CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  822. C
  823.       CALL VPAST(XE,BPSS)
  824. C     BPSS    STOCKE LA MATRICE DE PASSAGE
  825.       CALL VCORLC (XE,XEL,BPSS)
  826.       CALL ZERO (REL,LRE,LRE)
  827. C
  828. C     BOUCLE SUR LES POINTS DE GAUSS
  829. C
  830.       DO 1193  IGAU=1,NBPGAU
  831.       MPTVAL=IVACAR
  832.       MELVAL=IVAL(1)
  833.       IBMN =MIN(IB,VELCHE(/2))
  834.       EPAIST=VELCHE(1,IBMN)
  835.       IF (IVAL(2).NE.0) THEN
  836.         MELVAL=IVAL(2)
  837.         IBMN =MIN(IB,VELCHE(/2))
  838.         EXCEN =VELCHE(1,IBMN)
  839.       ELSE
  840.         EXCEN=0.D0
  841.       ENDIF
  842. *
  843. * Dans le cas des mat\E9riaux orthotropes, les d\E9formations sont d'abord
  844. * calcul\E9es dans le rep\E8re d'orthotropie (les formules utilis\E9es par les
  845. * routines RCDST et BMFDST ne sont valables que dans ce rep\E8re); elles
  846. * sont ensuite exprim\E9es dans le rep\E8re local de l'\E9l\E9ment.
  847. *
  848.       IF(CMATE.NE.'ISOTROPE')THEN
  849.         IF(IGAU.LE.NBGCOS)THEN
  850.           IF(IMAT.EQ.2)THEN
  851.             MPTVAL=IVAMAT
  852.             MELVAL=IVAL(2)
  853.             IBMN=MIN(IB  ,VELCHE(/2))
  854.             IGMN=MIN(IGAU,VELCHE(/1))
  855.             COSA=VELCHE(IGMN,IBMN)
  856.             MELVAL=IVAL(3)
  857.             IBMN=MIN(IB  ,VELCHE(/2))
  858.             IGMN=MIN(IGAU,VELCHE(/1))
  859.             SINA=VELCHE(IGMN,IBMN)
  860.           ENDIF
  861.         ENDIF
  862.       ENDIF
  863. C
  864. C     ON CHERCHE LES COEFFICIENTS DE LA MATRICE DE HOOKE
  865. C
  866.       MPTVAL=IVAMAT
  867.       IF(IMAT.EQ.2) THEN
  868.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.
  869.      +                   OR.NBGMAT.GT.1)) THEN
  870.           MELVAL=IVAL(1)
  871.           IBMN=MIN(IB  ,IELCHE(/2))
  872.           IGMN=MIN(IGAU,IELCHE(/1))
  873.           MLREEL=IELCHE(IGMN,IBMN)
  874.           SEGACT MLREEL
  875.             CALL DOHOOO(PROG,LHOOK,DDHOMU)
  876.           SEGDES MLREEL
  877.             IF(CMATE.EQ.'ORTHOTRO')
  878.      +           CALL CHGREP1(COSA,SINA,DDHOMU,LHOOK)
  879.         ENDIF
  880.       ELSE IF (IMAT.EQ.1) THEN
  881. *
  882.           DO 9093 IM=1,NMATT
  883.             IF (IVAL(IM).NE.0) THEN
  884.               MELVAL=IVAL(IM)
  885.               IBMN=MIN(IB  ,VELCHE(/2))
  886.               IGMN=MIN(IGAU,VELCHE(/1))
  887.               VALMAT(IM)=VELCHE(IGMN,IBMN)
  888.             ELSE
  889.               VALMAT(IM)=0.D0
  890.             ENDIF
  891.  9093     CONTINUE
  892.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1))
  893.      1    CALL DOHDST(VALMAT,CMATE,IFOUR,NSTRS,DDHOOK,IRTD)
  894.         CALL HOOKMU(EPAIST,0.D0,NSTRS,DDHOOK,DDHOMU)
  895.       ENDIF
  896. *
  897.       CALL ZERO(BGENE,NSTRS,LRE)
  898.       IF(CMATE.NE.'ISOTROPE')THEN
  899.         IF(IGAU.LE.NBGCOS)THEN
  900.          IF(IMAT.EQ.1.AND.CMATE.EQ.'ORTHOTRO')THEN
  901.             COSA=VALMAT(7)
  902.             SINA=VALMAT(8)
  903.           ENDIF
  904.           DO 1393 INO=1,NBNN
  905.            XX=COSA*XEL(1,INO)+SINA*XEL(2,INO)
  906.            YY=(-SINA)*XEL(1,INO)+COSA*XEL(2,INO)
  907.            XE(1,INO)=XX
  908.            XE(2,INO)=YY
  909.  1393     CONTINUE
  910.          ENDIF
  911. CC
  912. C     TERMES DE LA MATRICE DE RIGIDITE RELATIFS
  913. C      AUX CISAILLEMENTS TRANSVERSES
  914. C
  915.         CALL RCDST(XE,NSTRS,LRE,DDHOMU,
  916.      1                WORK(1),WORK(10),WORK(19),REL,BGENE,1)
  917.  
  918. C     TERMES DE LA MATRICE B RELATIFS AUX EFFETS
  919. C        DE MEMBRANE ET DE FLEXION
  920. C
  921.          CALL BMFDST(IGAU,XE,NSTRS,QSIGAU,ETAGAU,SHPTOT,SHPWRK,
  922.      1            WORK(1),WORK(10),WORK(19),BGENE,DUM)
  923. *
  924.          DO 10 NPOI=1,3
  925.          SHPWRK(1,NPOI)=SHPTOT(1,NPOI,IGAU)
  926.          SHPWRK(2,NPOI)=SHPTOT(2,NPOI,IGAU)
  927.          SHPWRK(3,NPOI)=SHPTOT(3,NPOI,IGAU)
  928.   10     CONTINUE
  929.          CALL JACOBI(XEL,SHPWRK,2,3,DJAC)
  930.          CALL ROTB(BGENE,NSTRS,COSA,SINA)
  931.       ELSE
  932. C
  933. C     TERMES DE LA MATRICE DE RIGIDITE RELATIFS
  934. C      AUX CISAILLEMENTS TRANSVERSES
  935. C
  936.         CALL RCDST(XEL,NSTRS,LRE,DDHOMU,
  937.      1              WORK(1),WORK(10),WORK(19),REL,BGENE,1)
  938. C
  939. C     TERMES DE LA MATRICE B RELATIFS AUX EFFETS
  940. C        DE MEMBRANE ET DE FLEXION
  941. C
  942.         CALL BMFDST(IGAU,XEL,NSTRS,QSIGAU,ETAGAU,SHPTOT,SHPWRK,
  943.      1            WORK(1),WORK(10),WORK(19),BGENE,DJAC)
  944.       ENDIF
  945.       DJAC=DJAC*POIGAU(IGAU)
  946. C
  947. C  ON MODIFIE LA MATRICE B EN CAS D'EXCENTREMENT
  948. C
  949.         IF (EXCEN.NE.0.) THEN
  950.       DO 1593 IJL=1,3
  951.       DO 1593 IJC=1,LRE
  952.       BGENE(IJL,IJC)=BGENE(IJL,IJC)+EXCEN*BGENE(IJL+3,IJC)
  953.  1593 CONTINUE
  954.         ENDIF
  955. C
  956.       CALL BDBS1(BGENE,DJAC,DDHOMU,LRE,NSTRS,REL,MFR,IFOUR,MATE,
  957.      1     IGAU,IMAT,EXCEN)
  958.  1193 CONTINUE
  959.       REL(6,6)=REL(5,5)*1.D-7
  960.       REL(12,12)=REL(6,6)
  961.       REL(18,18)=REL(6,6)
  962.       ICOM=0
  963.       IF(ABS(EXCEN).GT.XPETIT .OR. CMATE.EQ.'COMPOSIT'
  964.      1  .OR. IMAT.EQ.2) ICOM=1
  965.       CALL TRANSK(REL,BPSS,LRE,3,ICOM)
  966. C
  967. C     REMPLISSAGE DE XMATRI
  968. C
  969.       CALL REMPMT(REL,LRE,RE(1,1,IB))
  970.  3093  CONTINUE
  971. C
  972.  9993 CONTINUE
  973.       SEGSUP WRK1,WRK2,WRK3,WRK4
  974.       GOTO 510
  975. *
  976. C=======================================================================
  977. C========= ERREUR : CAS NON PREVUS =====================================
  978. C=======================================================================
  979.    99 CONTINUE
  980.       MOTERR(1:4)=NOMTP(MELE)
  981.       MOTERR(9:12)='RIGI3'
  982.       CALL ERREUR(86)
  983. *
  984.   510 CONTINUE
  985.       SEGSUP,MVELCH
  986. *      SEGDES XMATRI
  987.  
  988.       RETURN
  989.       END
  990.  
  991.  
  992.  

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