Télécharger la plaquette Cast3M


fr en

Télécharger ricolo.eso

Retour à la liste

Numérotation des lignes : 

ricolo

  1. C RICOLO    SOURCE    CB215821  25/04/23    21:15:42     12247          
  2. C
  3.       SUBROUTINE RICOLO(MCHPOI,ICLE,MRIGID)
  4.  
  5.       IMPLICIT REAL*8 (A-H,O-Z)
  6.       IMPLICIT INTEGER (I-N)
  7.  
  8. C***********************************************************************
  9. C NOM         : RICOLO
  10. C DESCRIPTION : Transforme un CHPOINT MCHPOI en matrice colonne MRIGID
  11. C               En pratique on fait plein de matrices carrees 2x2
  12. C LANGAGE     : ESOPE
  13. C
  14. C AUTEUR, DATE, MODIF :
  15. C  16/02/2012, Benoit Prabel : creation
  16. C
  17. C  ... merci de completer les evolutions futures ...
  18. C
  19. C***********************************************************************
  20. C ENTREES            : MCHPOI (+ autres lectures internes a ricolo)
  21. C ENTREES/SORTIES    :
  22. C SORTIES            : MRIGID
  23. C***********************************************************************
  24.  
  25. -INC PPARAM
  26. -INC CCOPTIO
  27. -INC CCHAMP
  28.  
  29. -INC SMRIGID
  30. -INC SMCOORD
  31. -INC SMCHPOI
  32. -INC SMELEME
  33. -INC SMLMOTS
  34.  
  35.       CHARACTER*(LOCOMP) MODUAL,MOPRIM
  36.       CHARACTER*4 MOSYM(3),MOOPT(2)
  37.       CHARACTER*4 MOMOT(1)
  38.       CHARACTER*8 LETYPE
  39.       DATA MOSYM/'SYME','ANTI','QUEL'/
  40.       DATA MOOPT/'PRIM','DUAL'/
  41.       DATA MOMOT(1) /'TYPE'/
  42.       LOGICAL     fldiag
  43.  
  44. c***********************************************************************
  45. c Executable statements
  46. c***********************************************************************
  47.  
  48. c======================================================================c
  49. c RECUPERATION DES AUTRES OBJETS d ENTREE ET VERIFICATION DES DONNEES
  50.  
  51. c     colonne ou ligne = seuls choix possibles
  52.       IF(ICLE.ne.2.and.ICLE.ne.3) THEN
  53.         write(IOIMP,*) 'VALEUR DE ICLE ERRONNEE =',ICLE
  54.      &                ,' LORS DE L APPEL A RICOLO ERRONNE'
  55.         CALL ERREUR(21)
  56.         RETURN
  57.       ENDIF
  58.  
  59. c     symetrique, antisymetrique ou quelconque (syme par defaut)
  60.       ISYM = 0
  61.       CALL LIRMOT(MOSYM,3,ISYM,0)
  62.       if(ISYM.eq.0) ISYM=1
  63.  
  64. *     LECTURE DU SUPPORT GEOMETRIQUE (1 seul point admis pour l instant)
  65.       CALL LIROBJ('POINT   ',KPOINT,1,IRETOU)
  66.       IF(IRETOU.EQ.0)THEN
  67.         CALL ERREUR(20)
  68.         RETURN
  69.       ENDIF
  70.       IF(IERR.NE.0)   RETURN
  71. c       CALL CRELEM(KPOINT)
  72. c       IPELEM=KPOINT
  73.  
  74. *     LECTURE DU NOM DU PRIMAL/DUAL (selon option colonne/ligne )
  75. *      ASSOCIE A KPOINT  + deduction de l'autre
  76.       idd1=0
  77. c     option colonne : on cherche l inconnue primale
  78.       IF(ICLE.eq.2) THEN
  79.          CALL LIRMOT(NOMDD,LNOMDD,idd1,0)
  80.          if (idd1.ne.0) then
  81.            MOPRIM=NOMDD(idd1)
  82.            MODUAL=NOMDU(idd1)
  83. c          si mot cle 'DUAL' + nom du dual alors MODUAL prend ce nom-la
  84.            CALL LIRMOT(MOOPT(2),1,IOPT,0)
  85.            if(iopt.ne.0) then
  86.              CALL LIRCHA(MODUAL,1,IRETOU)
  87.              IF(IERR.NE.0) RETURN
  88.            endif
  89.          else
  90.            CALL LIRCHA(MOPRIM,1,IRETOU)
  91.            CALL LIRMOT(MOOPT(2),1,IOPT,0)
  92.            if(iopt.ne.0) then
  93.              CALL LIRCHA(MODUAL,1,IRETOU)
  94.              IF(IERR.NE.0) RETURN
  95.            else
  96.              MODUAL=MOPRIM
  97.            write(IOIMP,*) 'Attention vous utilisez l inconnue PRIMale '
  98.      $                   ,MOPRIM,' non definie dans NOMDD du bdata...'
  99.            write(IOIMP,*) 'On utilise ',MODUAL,' comme DUALe associee'
  100.            endif
  101.          endif
  102.       ENDIF
  103. c     option ligne : on cherche l inconnue duale
  104.       IF(ICLE.eq.3) THEN
  105.          CALL LIRMOT(NOMDU,LNOMDU,idd1,0)
  106.          if (idd1.ne.0) then
  107.            MOPRIM=NOMDD(idd1)
  108.            MODUAL=NOMDU(idd1)
  109. c          si mot cle 'PRIM' + nom du primal alors MOPRIM prend ce nom-la
  110.            CALL LIRMOT(MOOPT(1),1,IOPT,0)
  111.            if(iopt.ne.0) then
  112.              CALL LIRCHA(MOPRIM,1,IRETOU)
  113.              IF(IERR.NE.0) RETURN
  114.            endif
  115.          else
  116.            CALL LIRCHA(MODUAL,1,IRETOU)
  117.            CALL LIRMOT(MOOPT(1),1,IOPT,0)
  118.            if(iopt.ne.0) then
  119.              CALL LIRCHA(MOPRIM,1,IRETOU)
  120.              IF(IERR.NE.0) RETURN
  121.            else
  122.              MOPRIM=MODUAL
  123.            write(IOIMP,*) 'Attention vous utilisez l inconnue DUALe '
  124.      $                    ,MODUAL,' non definie dans NOMDU du bdata...'
  125.            write(IOIMP,*) 'On utilise ',MOPRIM,' comme PRIMale associee'
  126.            endif
  127.          endif
  128.       ENDIF
  129.       if(iimpi.ge.1)write(IOIMP,*)'ICLE,PRIMAL,DUAL',ICLE,MOPRIM,MODUAL
  130.       IF(IERR.NE.0) RETURN
  131.  
  132.  
  133.       MLMOT1=0
  134.       MLMOT2=0
  135.       CALL LIROBJ('LISTMOTS',MLMOT1,0,IRETOU)
  136.       IF(MLMOT1.ne.0) THEN
  137.         CALL LIROBJ('LISTMOTS',MLMOT2,1,IRETOU)
  138.         IF(IERR.NE.0) RETURN
  139.         segact,MLMOT1,MLMOT2
  140.         NLMOT1=MLMOT1.MOTS(/2)
  141.         NLMOT2=MLMOT2.MOTS(/2)
  142.       ENDIF
  143.  
  144.  
  145. c======================================================================c
  146. C TRAVAIL SUR LE CHPOINT
  147.  
  148.       SEGACT MCHPOI
  149.       NSOUPO = IPCHP(/1)
  150. C On compte le nombre de matrices a generer
  151.       NRIGEL=0
  152.       DO ISOUPO = 1, NSOUPO
  153.          MSOUPO = IPCHP(ISOUPO)
  154.          SEGACT MSOUPO
  155.          NC=NOCOMP(/2)
  156.          NRIGEL=NRIGEL+NC
  157.          SEGDES MSOUPO
  158.       ENDDO
  159.       SEGINI MRIGID
  160. * BP 01/04/2014 ajout d'un type a la rigidite (recopie de manuri.eso)
  161. *     -- LECTURE DU SOUS-TYPE DE LA "RIGIDITE" A CREER --
  162.       ITYP = 0
  163.       CALL LIRMOT(MOMOT,1,ITYP,0)
  164.       IF(ITYP.EQ.1) THEN
  165.          ICODE = 1
  166.          CALL LIRCHA (LETYPE,ICODE,IRETOU)
  167.          IF (IERR .NE. 0) RETURN
  168.       ELSE
  169. C ... Si on n'a rien trouve, on met un sous type par defaut dedans
  170.         IF(ICLE.eq.2) LETYPE='COLONNE '
  171.         IF(ICLE.eq.3) LETYPE='LIGNE   '
  172.       ENDIF
  173.       MTYMAT=LETYPE
  174.       IFORIG = IFOPOI
  175. C
  176.       IRIG=0
  177. C====> BOUCLE SUR LES ZONES DU CHPOINT ======================
  178.       DO ISOUPO = 1, NSOUPO
  179.          if(iimpi.ge.2) write(IOIMP,*)' Sous-zone',ISOUPO,'/',NSOUPO
  180.          MSOUPO = IPCHP(ISOUPO)
  181.          SEGACT MSOUPO
  182.          NC=NOCOMP(/2)
  183.          MELEME=IGEOC
  184.          SEGACT MELEME
  185.          NBEL=NUM(/2)
  186. c Le meleme d un chpoint est constitue de poi1 (=elements a 1 noeud)
  187. c creation d une geometrie IPT1 avec KPOINT + IGEOC (=> 1+1=2 noeuds)
  188.            NBNN=2
  189.            NBSOUS=0
  190.            NBREF=0
  191.            NBELEM=NBEL
  192.            SEGINI,IPT1
  193.            IPT1.ITYPEL=28
  194.            Jdiag = 0
  195.            DO JEL=1,NBEL
  196.               IPT1.NUM(1,JEL)=KPOINT
  197.               IPT1.NUM(2,JEL)=NUM(1,JEL)
  198. *             on repere une eventuelle diagonale
  199.               if(IPT1.NUM(1,JEL).eq.IPT1.NUM(2,JEL)) Jdiag=JEL
  200.            ENDDO
  201. c fin de fabrication de IPT1
  202.          SEGDES,MELEME,IPT1
  203.          MPOVAL=IPOVAL
  204.          SEGACT MPOVAL
  205.  
  206. C   ---> BOUCLE SUR LES COMPOSANTES ---------
  207.          DO IC=1,NC
  208.  
  209.             IRIG=IRIG+1
  210.             if(iimpi.ge.2)
  211.      &      write(IOIMP,*)' Composante',IC,'/',NC,' -> rigidite ',IRIG
  212.  
  213. c        ---infos generales---
  214.             COERIG(IRIG)=1.D0
  215.             IRIGEL(1,IRIG)=IPT1
  216.             IRIGEL(5,IRIG)=NIFOUR
  217.             IRIGEL(7,IRIG)=ISYM-1
  218.             NLIGRP=2
  219.             NLIGRD=2
  220.  
  221. c        ---segment DESCRipteur---
  222.             SEGINI DESCR
  223.             LISINC(1)=MOPRIM
  224.             LISDUA(1)=MODUAL
  225.             NOELEP(1)=1
  226.             NOELED(1)=1
  227.             NOELEP(2)=2
  228.             NOELED(2)=2
  229.  
  230. *          -Cas colonne : on a un chpoint de dual : il faut retrouver le primal
  231.             IF(ICLE.eq.2) THEN
  232.  
  233.               idd2=0
  234. c             cas ou on a fourni MLMOT1 et MLMOT2
  235.               IF(MLMOT1.ne.0) THEN
  236.                 CALL PLACE(MLMOT1.MOTS,NLMOT1,idd2,NOCOMP(IC))
  237.                 IF (idd2.NE.0) THEN
  238.                    LISINC(2)=MLMOT2.MOTS(idd2)
  239.                 ELSE
  240.                   write(IOIMP,*) 'On ne trouve pas ',NOCOMP(IC),
  241.      $                           ' dans le listmot ',MLMOT1
  242.                   call erreur(488)
  243.                   return
  244.                 ENDIF
  245. c             cas ou cherche la correspondance
  246.               ELSE
  247.                 CALL PLACE(NOMDU,LNOMDU,idd2,NOCOMP(IC))
  248.                 IF (idd2.NE.0) THEN
  249.                    LISINC(2)=NOMDD(idd2)
  250.                 ELSE
  251.                    LISINC(2)=NOCOMP(IC)
  252.              write(IOIMP,*) 'Attention le chpoint utilise la duale '
  253.      $          ,NOCOMP(IC),' non definie dans NOMDU du bdata...'
  254.              write(IOIMP,*) 'On utilise ',NOCOMP(IC)
  255.      $                     ,' comme primale associee'
  256.                 ENDIF
  257.               ENDIF
  258.               LISDUA(2)=NOCOMP(IC)
  259.  
  260. *          -Cas ligne : on a un chpoint de primal : il faut retrouver le dual
  261.             ELSE
  262.  
  263.               idd2=0
  264. c             cas ou on a fourni MLMOT1 et MLMOT2
  265.               IF(MLMOT1.ne.0) THEN
  266.                 CALL PLACE(MLMOT1.MOTS,NLMOT1,idd2,NOCOMP(IC))
  267.                 IF (idd2.NE.0) THEN
  268.                    LISDUA(2)=MLMOT2.MOTS(idd2)
  269.                 ELSE
  270.                   write(IOIMP,*) 'On ne trouve pas ',NOCOMP(IC),
  271.      $                           ' dans le listmot ',MLMOT1
  272.                   call erreur(488)
  273.                   return
  274.                 ENDIF
  275. c             cas ou cherche la correspondance
  276.               ELSE
  277.                 CALL PLACE(NOMDD,LNOMDD,idd2,NOCOMP(IC))
  278.                 IF (idd2.NE.0) THEN
  279.                    LISDUA(2)=NOMDU(idd2)
  280.                 ELSE
  281.                    LISDUA(2)=NOCOMP(IC)
  282.              write(IOIMP,*) 'Attention le chpoint utilise la primale '
  283.      $         ,NOCOMP(IC),' non definie dans NOMDD du bdata...'
  284.              write(IOIMP,*) 'On utilise ',NOCOMP(IC)
  285.      $                     ,' comme duale associee'
  286.                 ENDIF
  287.               ENDIF
  288.               LISINC(2)=NOCOMP(IC)
  289.  
  290.             ENDIF
  291.  
  292.             if(iimpi.ge.2) then
  293.               write(IOIMP,*)' LISINC = ',(LISINC(iou),iou=1,2)
  294.               write(IOIMP,*)' LISDUA = ',(LISDUA(iou),iou=1,2)
  295.             endif
  296. c           debut du test pour savoir si on se situe sur une diagonale
  297.             fldiag = LISINC(1).eq.LISINC(2).and.LISDUA(1).eq.LISDUA(2)
  298.             SEGDES DESCR
  299.             IRIGEL(3,IRIG)=DESCR
  300.  
  301. c        ---matrice XMATRI proprement dite ---
  302.             NELRIG=NBEL
  303.             SEGINI XMATRI
  304. c          -cas symetrique (cas par defaut)
  305.             IF(ISYM.le.1) THEN
  306.               DO JEL=1,NBEL
  307. c                  RE(1,1,JEL)=0.D0
  308.                  RE(1,2,JEL)=VPOCHA(JEL,IC)
  309.                  RE(2,1,JEL)=VPOCHA(JEL,IC)
  310. c                  RE(2,2,JEL)=0.D0
  311.               ENDDO
  312. c             petite correction pour ne pas remplir 2 fois la meme case !
  313. c             (=cas de la diagonale)
  314. c             rem : inutile dans les cas antisymetrique et quelconque
  315.               if(Jdiag.ne.0.and.fldiag) then
  316.                  RE(1,1,Jdiag)=VPOCHA(Jdiag,IC)
  317.                  RE(1,2,Jdiag)=0.D0
  318.                  RE(2,1,Jdiag)=0.D0
  319.                  RE(2,2,Jdiag)=0.D0
  320.               endif
  321.             ENDIF
  322. c          -cas antisymetrique
  323.             IF(ISYM.eq.2) THEN
  324.             IF(ICLE.eq.2) THEN
  325.               DO JEL=1,NBEL
  326. c                  RE(1,1,JEL)=0.D0
  327.                  RE(1,2,JEL)=-1.D0*VPOCHA(JEL,IC)
  328.                  RE(2,1,JEL)=VPOCHA(JEL,IC)
  329. c                  RE(2,2,JEL)=0.D0
  330.               ENDDO
  331.             ELSE
  332.               DO JEL=1,NBEL
  333. c                  RE(1,1,JEL)=0.D0
  334.                  RE(1,2,JEL)=VPOCHA(JEL,IC)
  335.                  RE(2,1,JEL)=-1.D0*VPOCHA(JEL,IC)
  336. c                  RE(2,2,JEL)=0.D0
  337.               ENDDO
  338.             ENDIF
  339.             ENDIF
  340. c          -cas quelconque
  341.             IF(ISYM.eq.3) THEN
  342.             IF(ICLE.eq.2) THEN
  343.               DO JEL=1,NBEL
  344. c                  RE(1,1,JEL)=0.D0
  345. c                  RE(1,2,JEL)=0.D0
  346.                  RE(2,1,JEL)=VPOCHA(JEL,IC)
  347. c                  RE(2,2,JEL)=0.D0
  348.               ENDDO
  349.             ELSE
  350.               DO JEL=1,NBEL
  351. c                  RE(1,1,JEL)=0.D0
  352.                  RE(1,2,JEL)=VPOCHA(JEL,IC)
  353. c                  RE(2,1,JEL)=0.D0
  354. c                  RE(2,2,JEL)=0.D0
  355.               ENDDO
  356.             ENDIF
  357.             ENDIF
  358.             if(iimpi.ge.2) then
  359.               write(IOIMP,*)' RE(1,:) = ',(RE(1,iou),iou=1,2)
  360.               write(IOIMP,*)' RE(2,:) = ',(RE(2,iou),iou=1,2)
  361.             endif
  362.             IRIGEL(4,IRIG)=XMATRI
  363.             xmatri.symre=irigel(7,irig)
  364.             SEGDES XMATRI
  365.  
  366.          ENDDO
  367. C   <--- FIN DE BOUCLE SUR LES COMPOSANTES ---------
  368.          SEGDES MPOVAL
  369.          SEGDES MSOUPO
  370.  
  371.       ENDDO
  372. C<==== FIN DE BOUCLE SUR LES ZONES DU CHPOINT ======================
  373.       SEGDES MRIGID
  374.       SEGDES MCHPOI
  375.  
  376.       IF(MLMOT1.ne.0) THEN
  377.          segdes,MLMOT1,MLMOT2
  378.       ENDIF
  379.  
  380. c***********************************************************************
  381. C Normal termination
  382. c***********************************************************************
  383.  
  384.       RETURN
  385.  
  386. c***********************************************************************
  387. c End of subroutine
  388. c***********************************************************************
  389.  
  390.       END
  391.  
  392.  
  393.  
  394.  

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