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    PV090527  26/04/30    21:16:23     12529          
  2.       subroutine rimb(MYRIG)
  3.  
  4. ********************************************
  5. *   traduction objet rigi en matrik
  6. *              ou    matrik en rigi
  7. *
  8. *******************************************
  9.  
  10.       IMPLICIT INTEGER(I-N)
  11.       IMPLICIT REAL*8 (A-H,O-Z)
  12.  
  13.  
  14. -INC PPARAM
  15. -INC CCOPTIO
  16. -INC SMELEME
  17.       POINTEUR MYMEL.MELEME
  18. -INC SMRIGID
  19.       POINTEUR MYRIG.MRIGID
  20.       POINTEUR MDESCR.DESCR
  21.       POINTEUR MIMAT.xMATRI
  22. *      POINTEUR MXMAT.XMATRI
  23. -INC SMLENTI
  24.       POINTEUR KRINCP.MLENTI
  25.       POINTEUR KRINCD.MLENTI
  26. -INC SMLMOTS
  27.       POINTEUR LIPTOT.MLMOTS
  28.       POINTEUR LIDTOT.MLMOTS
  29. *INC SMMATRIK
  30.  
  31.       SEGMENT MATRIK
  32.       REAL*8  COEMTK(NMATRI)
  33.       INTEGER jRIGEL(NRIGE,NMATRI)
  34.       INTEGER KSYM,KMINC,KMINCP,KMINCD,KIZM
  35.       INTEGER KISPGT,KISPGP,KISPGD
  36.       INTEGER KNTTT,KNTTP,KNTTD
  37.       INTEGER KIDMAT(NKID)
  38.       INTEGER KKMMT(NKMT)
  39.       ENDSEGMENT
  40.       POINTEUR MYMTK.MATRIK
  41.  
  42.       SEGMENT jMATRI
  43.       CHARACTER*8 LISPRj(NBME),LISDUb(NBME)
  44.       INTEGER LIZAFM(NBSOUS,NBME)
  45.       INTEGER KSPGP,KSPGD
  46.       ENDSEGMENT
  47.       POINTEUR MJMAT.JMATRI
  48. C Stokage matrices elementaires non assemblees (valeurs)
  49.       SEGMENT IZAFM
  50.       REAL*8  AM(NBEL,NP,MP)
  51.       ENDSEGMENT
  52.       POINTEUR MIZAFM.IZAFM
  53. C
  54.       SEGMENT GMEL
  55.       POINTEUR MELS(NMEL).MELEME
  56.       ENDSEGMENT
  57.       POINTEUR LMLPRI.GMEL
  58.       POINTEUR LMLDUA.GMEL
  59.       POINTEUR LMELP.GMEL
  60.       POINTEUR LMELD.GMEL
  61.       POINTEUR MYMELP.MELEME
  62.       POINTEUR MYMELD.MELEME
  63.  
  64.       SEGMENT GJMAT
  65.       POINTEUR JMATS(NJMAT).JMATRI
  66.       ENDSEGMENT
  67.       POINTEUR LJMAT.GJMAT
  68.       SEGMENT GIZA
  69.       POINTEUR IZAS(NIZA).IZAFM
  70.       ENDSEGMENT
  71.       POINTEUR LIZA.GIZA
  72.       POINTEUR MIZA.IZAFM
  73. C
  74.       SEGMENT GLENT
  75.       POINTEUR LENTS(NLENT).MLENTI
  76.       ENDSEGMENT
  77.       POINTEUR LLEPRI.GLENT
  78.       POINTEUR LLEDUA.GLENT
  79.       POINTEUR LKRPRI.GLENT
  80.       POINTEUR LKRDUA.GLENT
  81.       POINTEUR MYLNTP.MLENTI
  82.       POINTEUR MYLNTD.MLENTI
  83.       POINTEUR MYKRP.MLENTI
  84.       POINTEUR MYKRD.MLENTI
  85. *
  86. * Déclaration des variables
  87. *
  88.       INTEGER NRIG,NRIGEL,NBME,NNOEL,NP,MP
  89.       INTEGER      KRIGEL,IBME,      IP,ID,IP2,ID2
  90.       INTEGER NLIGRP,NLIGRD
  91.       INTEGER ILIGRP,ILIGRD
  92.       INTEGER NPUNIQ,NDUNIQ,NBEL,NBNN
  93.       INTEGER IPUNIQ,IDUNIQ,IBEL,IBNN,IEL,IELRIG
  94.       INTEGER NPOPQ,NPODQ
  95.       REAL*8 COEF,VAL
  96.  
  97.       CHARACTER*8 TYPE,TYPP
  98.  
  99. *
  100. * Passage Rigidité en MATRIK
  101. *
  102. *      write(6,*) ' entree dans rimb nrig',nrig
  103.       IMPR=0
  104.       SEGACT MYRIG
  105.       NRIG  =MYRIG.IRIGEL(/1)
  106.       NRIGEL=MYRIG.IRIGEL(/2)
  107. * Un tests pour voir si on peut faire la conversion
  108.       IF (NRIG.EQ.6) THEN
  109. *            WRITE(IOIMP,*) 'NRIGE.EQ.6, check the output matrix'
  110.       ENDIF
  111.       IMATRI=0
  112. * Calcule de maniere a limiter le nombre de SEGADJ dans la boucle
  113.       INCNMA=MAX(1000,NRIGEL*3)
  114.       NMATRI=INCNMA
  115.       NRIGE = 7
  116.       NKID=9
  117.       NKMT=7
  118.       SEGINI MYMTK
  119. *
  120.       DO 1 KRIGEL=1,NRIGEL
  121. * D'autres tests pour voir si on peut faire la conversion
  122.          IF(MYRIG.IRIGEL(5,KRIGEL).NE.0) THEN
  123.             WRITE(IOIMP,*) 'Harmonique de fourier non nulle'
  124. *  19 2
  125. *Option indisponible
  126.             CALL ERREUR(19)
  127.          ENDIF
  128.          IF(MYRIG.IRIGEL(6,KRIGEL).NE.0) THEN
  129.             WRITE(IOIMP,*) 'Matrice definie par une inegalite'
  130.             CALL ERREUR(19)
  131.          ENDIF
  132.          COEF  =MYRIG.COERIG(KRIGEL)
  133.          MYMEL =MYRIG.IRIGEL(1,KRIGEL)
  134.          SEGACT MYMEL
  135.          NNOEL = MYMEL.NUM(/1)
  136.          NEL   = MYMEL.NUM(/2)
  137. ***            MYMTK.JRIGEL(1,KRIGEL)=MYMEL
  138. ***            MYMTK.JRIGEL(2,KRIGEL)=MYMEL
  139. * Analyse du segment descripteur
  140.          MDESCR=MYRIG.IRIGEL(3,KRIGEL)
  141.          SEGACT MDESCR
  142.          NLIGRP=MDESCR.NOELEP(/1)
  143.          NLIGRD=MDESCR.NOELED(/1)
  144. * Construction de la liste d'inconnues primales sans doublons
  145. * et du segment de repérage dans cette liste
  146.          JGN=4
  147.          JGM=NLIGRP
  148.          SEGINI LIPTOT
  149.          CALL CUNIQ(MDESCR.LISINC,4,NLIGRP,
  150.      $        LIPTOT.MOTS,NPUNIQ,
  151.      $        IMPR,IRET)
  152.          IF (IRET.NE.0) GOTO 9999
  153.          JGN=4
  154.          JGM=NPUNIQ
  155.          SEGADJ,LIPTOT
  156.          JG=NLIGRP
  157.          SEGINI KRINCP
  158.          CALL CREPER(4,NLIGRP,NPUNIQ,MDESCR.LISINC,LIPTOT.MOTS,
  159.      $        KRINCP.LECT,
  160.      $        IMPR,IRET)
  161.          IF (IRET.NE.0) GOTO 9999
  162. * Construction de la liste d'inconnues duales sans doublons
  163. * et du segment de repérage dans cette liste
  164.          JGN=4
  165.          JGM=NLIGRD
  166.          SEGINI LIDTOT
  167.          CALL CUNIQ(MDESCR.LISDUA,4,NLIGRD,
  168.      $        LIDTOT.MOTS,NDUNIQ,
  169.      $        IMPR,IRET)
  170.          IF (IRET.NE.0) GOTO 9999
  171.          JGN=4
  172.          JGM=NDUNIQ
  173.          SEGADJ,LIDTOT
  174.          JG=NLIGRD
  175.          SEGINI KRINCD
  176.          CALL CREPER(4,NLIGRD,NDUNIQ,MDESCR.LISDUA,LIDTOT.MOTS,
  177.      $        KRINCD.LECT,
  178.      $        IMPR,IRET)
  179.          IF (IRET.NE.0) GOTO 9999
  180. * Pour chaque inconnue PRIMALE, construction de la liste des noeuds
  181. * (locaux par élément) sur lequel il porte
  182.          NLENT=NPUNIQ
  183.          SEGINI,LLEPRI
  184.          JG=0
  185.          SEGINI,LLEPRI.LENTS(*)
  186.          DO ILIGRP=1,NLIGRP
  187.             IPUNIQ=KRINCP.LECT(ILIGRP)
  188.             MYLNTP=LLEPRI.LENTS(IPUNIQ)
  189.             MYLNTP.LECT(**)=MDESCR.NOELEP(ILIGRP)
  190.          ENDDO
  191. * Suppression des doublons éventuels
  192.          DO IPUNIQ=1,NPUNIQ
  193.             CALL IUNIQ(LLEPRI.LENTS(IPUNIQ).LECT,
  194.      $           LLEPRI.LENTS(IPUNIQ).LECT(/1),
  195.      $           LLEPRI.LENTS(IPUNIQ).LECT,NPOPQ,
  196.      $           IMPR,IRET)
  197.             IF (IRET.NE.0) GOTO 9999
  198.             JG=NPOPQ
  199.             SEGADJ,LLEPRI.LENTS(IPUNIQ)
  200.          ENDDO
  201. * segment de repérage dans cette liste
  202.          NLENT=NPUNIQ
  203.          SEGINI,LKRPRI
  204.          JG=NNOEL
  205.          SEGINI,LKRPRI.LENTS(*)
  206.          DO IPUNIQ=1,NPUNIQ
  207.             CALL RSETXI(LKRPRI.LENTS(IPUNIQ).LECT,
  208.      $           LLEPRI.LENTS(IPUNIQ).LECT,
  209.      $           LLEPRI.LENTS(IPUNIQ).LECT(/1))
  210.          ENDDO
  211. * Pour chaque inconnue DUALE, construction de la liste des noeuds
  212. * (locaux par élément) sur lequel il porte
  213.          NLENT=NDUNIQ
  214.          SEGINI,LLEDUA
  215.          JG=0
  216.          SEGINI,LLEDUA.LENTS(*)
  217.          DO ILIGRD=1,NLIGRD
  218.             IDUNIQ=KRINCD.LECT(ILIGRD)
  219.             MYLNTD=LLEDUA.LENTS(IDUNIQ)
  220.             MYLNTD.LECT(**)=MDESCR.NOELED(ILIGRD)
  221.          ENDDO
  222. * Suppression des doublons éventuels
  223.          DO IDUNIQ=1,NDUNIQ
  224.             CALL IUNIQ(LLEDUA.LENTS(IDUNIQ).LECT,
  225.      $           LLEDUA.LENTS(IDUNIQ).LECT(/1),
  226.      $           LLEDUA.LENTS(IDUNIQ).LECT,NPODQ,
  227.      $           IMPR,IRET)
  228.             IF (IRET.NE.0) GOTO 9999
  229.             JG=NPODQ
  230.             SEGADJ,LLEDUA.LENTS(IDUNIQ)
  231.          ENDDO
  232. * segment de repérage dans cette liste
  233.          NLENT=NDUNIQ
  234.          SEGINI,LKRDUA
  235.          JG=NNOEL
  236.          SEGINI,LKRDUA.LENTS(*)
  237.          DO IDUNIQ=1,NDUNIQ
  238.             CALL RSETXI(LKRDUA.LENTS(IDUNIQ).LECT,
  239.      $           LLEDUA.LENTS(IDUNIQ).LECT,
  240.      $           LLEDUA.LENTS(IDUNIQ).LECT(/1))
  241.          ENDDO
  242. * Pour chaque inconnue PRIMALE, construction de l'objet géométrie
  243.          NMEL=NPUNIQ
  244.          SEGINI,LMLPRI
  245.          DO IPUNIQ=1,NPUNIQ
  246.             NBNN=LLEPRI.LENTS(IPUNIQ).LECT(/1)
  247.             NBELEM=NEL
  248.             NBSOUS=0
  249.             NBREF=0
  250.             SEGINI,LMLPRI.MELS(IPUNIQ)
  251.             DO IEL=1,NEL
  252.                DO IBNN=1,NBNN
  253.                   MYMELP=LMLPRI.MELS(IPUNIQ)
  254.                   MYLNTP=LLEPRI.LENTS(IPUNIQ)
  255.                   MYMELP.NUM(IBNN,IEL)=
  256.      $                 MYMEL.NUM(MYLNTP.LECT(IBNN),IEL)
  257.                ENDDO
  258.             ENDDO
  259.             SEGDES,LMLPRI.MELS(IPUNIQ)
  260.          ENDDO
  261. * Pour chaque inconnue DUALE, construction de l'objet géométrie
  262.          NMEL=NDUNIQ
  263.          SEGINI,LMLDUA
  264.          DO IDUNIQ=1,NDUNIQ
  265.             NBNN=LLEDUA.LENTS(IDUNIQ).LECT(/1)
  266.             NBELEM=NEL
  267.             NBSOUS=0
  268.             NBREF=0
  269.             SEGINI,LMLDUA.MELS(IDUNIQ)
  270.             DO IEL=1,NEL
  271.                DO IBNN=1,NBNN
  272.                   MYMELD=LMLDUA.MELS(IDUNIQ)
  273.                   MYLNTD=LLEDUA.LENTS(IDUNIQ)
  274.                   MYMELD.NUM(IBNN,IEL)=
  275.      $                 MYMEL.NUM(MYLNTD.LECT(IBNN),IEL)
  276.                ENDDO
  277.             ENDDO
  278.             SEGDES,LMLDUA.MELS(IDUNIQ)
  279.          ENDDO
  280. *
  281. * Initialisation des objets que l'on concatènera dans MATRIK
  282. *
  283.          NMAT=NPUNIQ*NDUNIQ
  284.          NMEL=NMAT
  285.          SEGINI,LMELP
  286.          SEGINI,LMELD
  287.          NJMAT=NMAT
  288.          SEGINI,LJMAT
  289.          NBME=1
  290.          NBSOUS=1
  291.          SEGINI,LJMAT.JMATS(*)
  292.          NIZA=NMAT
  293.          SEGINI,LIZA
  294.          DO IPUNIQ=1,NPUNIQ
  295.             DO IDUNIQ=1,NDUNIQ
  296. *   Initialisation de LIZA
  297.                IMAT=(IPUNIQ-1)*NDUNIQ+IDUNIQ
  298.                NBEL=NEL
  299.                NP=LLEPRI.LENTS(IPUNIQ).LECT(/1)
  300.                MP=LLEDUA.LENTS(IDUNIQ).LECT(/1)
  301.                rigrel=0
  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.  
  415.  
  416.  

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