Télécharger la plaquette Cast3M


fr en

Télécharger rimb.eso

Retour à la liste

Numérotation des lignes : 

rimb

  1. C RIMB      SOURCE    PV        20/09/26    21:19:49     10724          
  2. C RIMA      SOURCE    ANNE      99/12/22    21:35:54     3744
  3.       subroutine rimb(MYRIG)
  4.  
  5. ********************************************
  6. *   traduction objet rigi en matrik
  7. *              ou    matrik en rigi
  8. *
  9. *******************************************
  10.  
  11.       IMPLICIT INTEGER(I-N)
  12.       IMPLICIT REAL*8 (A-H,O-Z)
  13.  
  14.  
  15. -INC PPARAM
  16. -INC CCOPTIO
  17. -INC SMELEME
  18.       POINTEUR MYMEL.MELEME
  19. -INC SMRIGID
  20.       POINTEUR MYRIG.MRIGID
  21.       POINTEUR MDESCR.DESCR
  22.       POINTEUR MIMAT.xMATRI
  23. *      POINTEUR MXMAT.XMATRI
  24. -INC SMLENTI
  25.       POINTEUR KRINCP.MLENTI
  26.       POINTEUR KRINCD.MLENTI
  27. -INC SMLMOTS
  28.       POINTEUR LIPTOT.MLMOTS
  29.       POINTEUR LIDTOT.MLMOTS
  30. *INC SMMATRIK
  31.  
  32.       SEGMENT MATRIK
  33.       REAL*8  COEMTK(NMATRI)
  34.       INTEGER jRIGEL(NRIGE,NMATRI)
  35.       INTEGER KSYM,KMINC,KMINCP,KMINCD,KIZM
  36.       INTEGER KISPGT,KISPGP,KISPGD
  37.       INTEGER KNTTT,KNTTP,KNTTD
  38.       INTEGER KIDMAT(NKID)
  39.       INTEGER KKMMT(NKMT)
  40.       ENDSEGMENT
  41.       POINTEUR MYMTK.MATRIK
  42.  
  43.       SEGMENT jMATRI
  44.       CHARACTER*8 LISPRj(NBME),LISDUb(NBME)
  45.       INTEGER LIZAFM(NBSOUS,NBME)
  46.       INTEGER KSPGP,KSPGD
  47.       ENDSEGMENT
  48.       POINTEUR MJMAT.JMATRI
  49. C Stokage matrices elementaires non assemblees (valeurs)
  50.       SEGMENT IZAFM
  51.       REAL*8  AM(NBEL,NP,MP)
  52.       ENDSEGMENT
  53.       POINTEUR MIZAFM.IZAFM
  54. C
  55.       SEGMENT GMEL
  56.       POINTEUR MELS(NMEL).MELEME
  57.       ENDSEGMENT
  58.       POINTEUR LMLPRI.GMEL
  59.       POINTEUR LMLDUA.GMEL
  60.       POINTEUR LMELP.GMEL
  61.       POINTEUR LMELD.GMEL
  62.       POINTEUR MYMELP.MELEME
  63.       POINTEUR MYMELD.MELEME
  64.  
  65.       SEGMENT GJMAT
  66.       POINTEUR JMATS(NJMAT).JMATRI
  67.       ENDSEGMENT
  68.       POINTEUR LJMAT.GJMAT
  69.       SEGMENT GIZA
  70.       POINTEUR IZAS(NIZA).IZAFM
  71.       ENDSEGMENT
  72.       POINTEUR LIZA.GIZA
  73.       POINTEUR MIZA.IZAFM
  74. C
  75.       SEGMENT GLENT
  76.       POINTEUR LENTS(NLENT).MLENTI
  77.       ENDSEGMENT
  78.       POINTEUR LLEPRI.GLENT
  79.       POINTEUR LLEDUA.GLENT
  80.       POINTEUR LKRPRI.GLENT
  81.       POINTEUR LKRDUA.GLENT
  82.       POINTEUR MYLNTP.MLENTI
  83.       POINTEUR MYLNTD.MLENTI
  84.       POINTEUR MYKRP.MLENTI
  85.       POINTEUR MYKRD.MLENTI
  86. *
  87. * Déclaration des variables
  88. *
  89.       INTEGER NRIG,NRIGEL,NBME,NNOEL,NP,MP
  90.       INTEGER      KRIGEL,IBME,      IP,ID,IP2,ID2
  91.       INTEGER NLIGRP,NLIGRD
  92.       INTEGER ILIGRP,ILIGRD
  93.       INTEGER NPUNIQ,NDUNIQ,NBEL,NBNN
  94.       INTEGER IPUNIQ,IDUNIQ,IBEL,IBNN,IEL,IELRIG
  95.       INTEGER NPOPQ,NPODQ
  96.       REAL*8 COEF,VAL
  97.  
  98.       CHARACTER*8 TYPE,TYPP
  99.  
  100. *
  101. * Passage Rigidité en MATRIK
  102. *
  103. *      write(6,*) ' entree dans rimb nrig',nrig
  104.       IMPR=0
  105.       SEGACT MYRIG
  106.       NRIG  =MYRIG.IRIGEL(/1)
  107.       NRIGEL=MYRIG.IRIGEL(/2)
  108. * Un tests pour voir si on peut faire la conversion
  109.       IF (NRIG.EQ.6) THEN
  110. *            WRITE(IOIMP,*) 'NRIGE.EQ.6, check the output matrix'
  111.       ENDIF
  112.       IMATRI=0
  113. * Calcule de maniere a limiter le nombre de SEGADJ dans la boucle
  114.       INCNMA=MAX(1000,NRIGEL*3)
  115.       NMATRI=INCNMA
  116.       NRIGE = 7
  117.       NKID=9
  118.       NKMT=7
  119.       SEGINI MYMTK
  120. *
  121.       DO 1 KRIGEL=1,NRIGEL
  122. * D'autres tests pour voir si on peut faire la conversion
  123.          IF(MYRIG.IRIGEL(5,KRIGEL).NE.0) THEN
  124.             WRITE(IOIMP,*) 'Harmonique de fourier non nulle'
  125. *  19 2
  126. *Option indisponible
  127.             CALL ERREUR(19)
  128.          ENDIF
  129.          IF(MYRIG.IRIGEL(6,KRIGEL).NE.0) THEN
  130.             WRITE(IOIMP,*) 'Matrice definie par une inegalite'
  131.             CALL ERREUR(19)
  132.          ENDIF
  133.          COEF  =MYRIG.COERIG(KRIGEL)
  134.          MYMEL =MYRIG.IRIGEL(1,KRIGEL)
  135.          SEGACT MYMEL
  136.          NNOEL = MYMEL.NUM(/1)
  137.          NEL   = MYMEL.NUM(/2)
  138. ***            MYMTK.JRIGEL(1,KRIGEL)=MYMEL
  139. ***            MYMTK.JRIGEL(2,KRIGEL)=MYMEL
  140. * Analyse du segment descripteur
  141.          MDESCR=MYRIG.IRIGEL(3,KRIGEL)
  142.          SEGACT MDESCR
  143.          NLIGRP=MDESCR.NOELEP(/1)
  144.          NLIGRD=MDESCR.NOELED(/1)
  145. * Construction de la liste d'inconnues primales sans doublons
  146. * et du segment de repérage dans cette liste
  147.          JGN=4
  148.          JGM=NLIGRP
  149.          SEGINI LIPTOT
  150.          CALL CUNIQ(MDESCR.LISINC,4,NLIGRP,
  151.      $        LIPTOT.MOTS,NPUNIQ,
  152.      $        IMPR,IRET)
  153.          IF (IRET.NE.0) GOTO 9999
  154.          JGN=4
  155.          JGM=NPUNIQ
  156.          SEGADJ,LIPTOT
  157.          JG=NLIGRP
  158.          SEGINI KRINCP
  159.          CALL CREPER(4,NLIGRP,NPUNIQ,MDESCR.LISINC,LIPTOT.MOTS,
  160.      $        KRINCP.LECT,
  161.      $        IMPR,IRET)
  162.          IF (IRET.NE.0) GOTO 9999
  163. * Construction de la liste d'inconnues duales sans doublons
  164. * et du segment de repérage dans cette liste
  165.          JGN=4
  166.          JGM=NLIGRD
  167.          SEGINI LIDTOT
  168.          CALL CUNIQ(MDESCR.LISDUA,4,NLIGRD,
  169.      $        LIDTOT.MOTS,NDUNIQ,
  170.      $        IMPR,IRET)
  171.          IF (IRET.NE.0) GOTO 9999
  172.          JGN=4
  173.          JGM=NDUNIQ
  174.          SEGADJ,LIDTOT
  175.          JG=NLIGRD
  176.          SEGINI KRINCD
  177.          CALL CREPER(4,NLIGRD,NDUNIQ,MDESCR.LISDUA,LIDTOT.MOTS,
  178.      $        KRINCD.LECT,
  179.      $        IMPR,IRET)
  180.          IF (IRET.NE.0) GOTO 9999
  181. * Pour chaque inconnue PRIMALE, construction de la liste des noeuds
  182. * (locaux par élément) sur lequel il porte
  183.          NLENT=NPUNIQ
  184.          SEGINI,LLEPRI
  185.          JG=0
  186.          SEGINI,LLEPRI.LENTS(*)
  187.          DO ILIGRP=1,NLIGRP
  188.             IPUNIQ=KRINCP.LECT(ILIGRP)
  189.             MYLNTP=LLEPRI.LENTS(IPUNIQ)
  190.             MYLNTP.LECT(**)=MDESCR.NOELEP(ILIGRP)
  191.          ENDDO
  192. * Suppression des doublons éventuels
  193.          DO IPUNIQ=1,NPUNIQ
  194.             CALL IUNIQ(LLEPRI.LENTS(IPUNIQ).LECT,
  195.      $           LLEPRI.LENTS(IPUNIQ).LECT(/1),
  196.      $           LLEPRI.LENTS(IPUNIQ).LECT,NPOPQ,
  197.      $           IMPR,IRET)
  198.             IF (IRET.NE.0) GOTO 9999
  199.             JG=NPOPQ
  200.             SEGADJ,LLEPRI.LENTS(IPUNIQ)
  201.          ENDDO
  202. * segment de repérage dans cette liste
  203.          NLENT=NPUNIQ
  204.          SEGINI,LKRPRI
  205.          JG=NNOEL
  206.          SEGINI,LKRPRI.LENTS(*)
  207.          DO IPUNIQ=1,NPUNIQ
  208.             CALL RSETXI(LKRPRI.LENTS(IPUNIQ).LECT,
  209.      $           LLEPRI.LENTS(IPUNIQ).LECT,
  210.      $           LLEPRI.LENTS(IPUNIQ).LECT(/1))
  211.          ENDDO
  212. * Pour chaque inconnue DUALE, construction de la liste des noeuds
  213. * (locaux par élément) sur lequel il porte
  214.          NLENT=NDUNIQ
  215.          SEGINI,LLEDUA
  216.          JG=0
  217.          SEGINI,LLEDUA.LENTS(*)
  218.          DO ILIGRD=1,NLIGRD
  219.             IDUNIQ=KRINCD.LECT(ILIGRD)
  220.             MYLNTD=LLEDUA.LENTS(IDUNIQ)
  221.             MYLNTD.LECT(**)=MDESCR.NOELED(ILIGRD)
  222.          ENDDO
  223. * Suppression des doublons éventuels
  224.          DO IDUNIQ=1,NDUNIQ
  225.             CALL IUNIQ(LLEDUA.LENTS(IDUNIQ).LECT,
  226.      $           LLEDUA.LENTS(IDUNIQ).LECT(/1),
  227.      $           LLEDUA.LENTS(IDUNIQ).LECT,NPODQ,
  228.      $           IMPR,IRET)
  229.             IF (IRET.NE.0) GOTO 9999
  230.             JG=NPODQ
  231.             SEGADJ,LLEDUA.LENTS(IDUNIQ)
  232.          ENDDO
  233. * segment de repérage dans cette liste
  234.          NLENT=NDUNIQ
  235.          SEGINI,LKRDUA
  236.          JG=NNOEL
  237.          SEGINI,LKRDUA.LENTS(*)
  238.          DO IDUNIQ=1,NDUNIQ
  239.             CALL RSETXI(LKRDUA.LENTS(IDUNIQ).LECT,
  240.      $           LLEDUA.LENTS(IDUNIQ).LECT,
  241.      $           LLEDUA.LENTS(IDUNIQ).LECT(/1))
  242.          ENDDO
  243. * Pour chaque inconnue PRIMALE, construction de l'objet géométrie
  244.          NMEL=NPUNIQ
  245.          SEGINI,LMLPRI
  246.          DO IPUNIQ=1,NPUNIQ
  247.             NBNN=LLEPRI.LENTS(IPUNIQ).LECT(/1)
  248.             NBELEM=NEL
  249.             NBSOUS=0
  250.             NBREF=0
  251.             SEGINI,LMLPRI.MELS(IPUNIQ)
  252.             DO IEL=1,NEL
  253.                DO IBNN=1,NBNN
  254.                   MYMELP=LMLPRI.MELS(IPUNIQ)
  255.                   MYLNTP=LLEPRI.LENTS(IPUNIQ)
  256.                   MYMELP.NUM(IBNN,IEL)=
  257.      $                 MYMEL.NUM(MYLNTP.LECT(IBNN),IEL)
  258.                ENDDO
  259.             ENDDO
  260.             SEGDES,LMLPRI.MELS(IPUNIQ)
  261.          ENDDO
  262. * Pour chaque inconnue DUALE, construction de l'objet géométrie
  263.          NMEL=NDUNIQ
  264.          SEGINI,LMLDUA
  265.          DO IDUNIQ=1,NDUNIQ
  266.             NBNN=LLEDUA.LENTS(IDUNIQ).LECT(/1)
  267.             NBELEM=NEL
  268.             NBSOUS=0
  269.             NBREF=0
  270.             SEGINI,LMLDUA.MELS(IDUNIQ)
  271.             DO IEL=1,NEL
  272.                DO IBNN=1,NBNN
  273.                   MYMELD=LMLDUA.MELS(IDUNIQ)
  274.                   MYLNTD=LLEDUA.LENTS(IDUNIQ)
  275.                   MYMELD.NUM(IBNN,IEL)=
  276.      $                 MYMEL.NUM(MYLNTD.LECT(IBNN),IEL)
  277.                ENDDO
  278.             ENDDO
  279.             SEGDES,LMLDUA.MELS(IDUNIQ)
  280.          ENDDO
  281. *
  282. * Initialisation des objets que l'on concatènera dans MATRIK
  283. *
  284.          NMAT=NPUNIQ*NDUNIQ
  285.          NMEL=NMAT
  286.          SEGINI,LMELP
  287.          SEGINI,LMELD
  288.          NJMAT=NMAT
  289.          SEGINI,LJMAT
  290.          NBME=1
  291.          NBSOUS=1
  292.          SEGINI,LJMAT.JMATS(*)
  293.          NIZA=NMAT
  294.          SEGINI,LIZA
  295.          DO IPUNIQ=1,NPUNIQ
  296.             DO IDUNIQ=1,NDUNIQ
  297. *   Initialisation de LIZA
  298.                IMAT=(IPUNIQ-1)*NDUNIQ+IDUNIQ
  299.                NBEL=NEL
  300.                NP=LLEPRI.LENTS(IPUNIQ).LECT(/1)
  301.                MP=LLEDUA.LENTS(IDUNIQ).LECT(/1)
  302.                SEGINI,LIZA.IZAS(IMAT)
  303. *   Initialisation de LJMAT
  304.                MJMAT=LJMAT.JMATS(IMAT)
  305.                MJMAT.LISPRJ(1)=LIPTOT.MOTS(IPUNIQ)//'    '
  306.                MJMAT.LISDUB(1)=LIDTOT.MOTS(IDUNIQ)//'    '
  307.                MJMAT.LIZAFM(1,1)=LIZA.IZAS(IMAT)
  308. *   Initialisation de LMELP et LMELD
  309.                LMELP.MELS(IMAT)=LMLPRI.MELS(IPUNIQ)
  310.                LMELD.MELS(IMAT)=LMLDUA.MELS(IDUNIQ)
  311.             ENDDO
  312.          ENDDO
  313. *
  314. * Boucle sur les matrices élémentaires de MYRIG
  315. * et recopie des valeurs dans les IZAS de LIZA
  316. *
  317.          MIMAT=MYRIG.IRIGEL(4,KRIGEL)
  318.          SEGACT MIMAT
  319.          NELRIG=MIMAT.re(/3)
  320.          DO IELRIG=1,NELRIG
  321. *            MXMAT=MIMAT.IMATTT(IELRIG)
  322. *            SEGACT MXMAT
  323.             DO ILIGRP=1,NLIGRP
  324.                IPUNIQ=KRINCP.LECT(ILIGRP)
  325.                IP=MDESCR.NOELEP(ILIGRP)
  326.                MYKRP=LKRPRI.LENTS(IPUNIQ)
  327.                DO ILIGRD=1,NLIGRD
  328.                   IDUNIQ=KRINCD.LECT(ILIGRD)
  329.                   ID=MDESCR.NOELED(ILIGRD)
  330.                   MYKRD=LKRDUA.LENTS(IDUNIQ)
  331.                   IMAT=(IPUNIQ-1)*NDUNIQ+IDUNIQ
  332.                   MIZA=LIZA.IZAS(IMAT)
  333.                   IBEL=IELRIG
  334.                   IP2=MYKRP.LECT(IP)
  335.                   ID2=MYKRD.LECT(ID)
  336.                   VAL=MIMAT.RE(ILIGRD,ILIGRP,ielrig)
  337.                   MIZA.AM(IBEL,IP2,ID2)=VAL*COEF
  338.                ENDDO
  339.             ENDDO
  340. *            SEGDES MXMAT
  341.          ENDDO
  342.          SEGDES MIMAT
  343.          SEGDES,LIZA.IZAS(*)
  344.          SEGSUP,LIZA
  345.          SEGDES,LJMAT.JMATS(*)
  346. *
  347. * Concaténation des valeurs dans l'objet MATRIK
  348. *
  349.          NMATAV=IMATRI
  350. *         NMATAP=IMATRI+NMAT
  351.          IMATRI=IMATRI+NMAT
  352.          IF (IMATRI.GT.NMATRI) THEN
  353.             NMATRI=IMATRI+INCNMA
  354.             NRIGE = 7
  355.             NKID=9
  356.             NKMT=7
  357.             SEGADJ,MYMTK
  358.          ENDIF
  359.          DO IMAT=1,NMAT
  360.             MYMTK.JRIGEL(1,NMATAV+IMAT)=LMELP.MELS(IMAT)
  361.             MYMTK.JRIGEL(2,NMATAV+IMAT)=LMELD.MELS(IMAT)
  362.             MYMTK.JRIGEL(4,NMATAV+IMAT)=LJMAT.JMATS(IMAT)
  363.             MYMTK.JRIGEL(7,NMATAV+IMAT)=3
  364.          ENDDO
  365.          SEGSUP,LJMAT
  366.          SEGSUP,LMELD
  367.          SEGSUP,LMELP
  368.          SEGSUP,LMLDUA
  369.          SEGSUP,LMLPRI
  370.          SEGSUP,LKRDUA.LENTS(*)
  371.          SEGSUP,LKRDUA
  372.          SEGSUP,LLEDUA.LENTS(*)
  373.          SEGSUP,LLEDUA
  374.          SEGSUP,LKRPRI.LENTS(*)
  375.          SEGSUP,LKRPRI
  376.          SEGSUP,LLEPRI.LENTS(*)
  377.          SEGSUP,LLEPRI
  378.          SEGSUP KRINCP
  379.          SEGSUP LIDTOT
  380.          SEGSUP KRINCD
  381.          SEGSUP LIPTOT
  382.          SEGDES MDESCR
  383.          SEGDES MYMEL
  384.  1    CONTINUE
  385.       NMATRI=IMATRI
  386.       NRIGE = 7
  387.       NKID=9
  388.       NKMT=7
  389.       SEGADJ,MYMTK
  390. *
  391.       SEGDES MYMTK
  392.       SEGDES MYRIG
  393.       CALL ECROBJ('MATRIK',MYMTK)
  394.       RETURN
  395. *
  396. * Error handling
  397. *
  398.  9999 CONTINUE
  399.       WRITE(IOIMP,*) 'An error was detected in subroutine rima'
  400.       RETURN
  401.       END
  402.  
  403.  
  404.  
  405.  
  406.  
  407.  
  408.  
  409.  
  410.  
  411.  
  412.  
  413.  
  414.  

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