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    PV090527  26/04/30    21:16:17     12529          
  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.             rigrel=0
  304.             SEGINI XMATRI
  305. c          -cas symetrique (cas par defaut)
  306.             IF(ISYM.le.1) THEN
  307.               DO JEL=1,NBEL
  308. c                  RE(1,1,JEL)=0.D0
  309.                  RE(1,2,JEL)=VPOCHA(JEL,IC)
  310.                  RE(2,1,JEL)=VPOCHA(JEL,IC)
  311. c                  RE(2,2,JEL)=0.D0
  312.               ENDDO
  313. c             petite correction pour ne pas remplir 2 fois la meme case !
  314. c             (=cas de la diagonale)
  315. c             rem : inutile dans les cas antisymetrique et quelconque
  316.               if(Jdiag.ne.0.and.fldiag) then
  317.                  RE(1,1,Jdiag)=VPOCHA(Jdiag,IC)
  318.                  RE(1,2,Jdiag)=0.D0
  319.                  RE(2,1,Jdiag)=0.D0
  320.                  RE(2,2,Jdiag)=0.D0
  321.               endif
  322.             ENDIF
  323. c          -cas antisymetrique
  324.             IF(ISYM.eq.2) THEN
  325.             IF(ICLE.eq.2) THEN
  326.               DO JEL=1,NBEL
  327. c                  RE(1,1,JEL)=0.D0
  328.                  RE(1,2,JEL)=-1.D0*VPOCHA(JEL,IC)
  329.                  RE(2,1,JEL)=VPOCHA(JEL,IC)
  330. c                  RE(2,2,JEL)=0.D0
  331.               ENDDO
  332.             ELSE
  333.               DO JEL=1,NBEL
  334. c                  RE(1,1,JEL)=0.D0
  335.                  RE(1,2,JEL)=VPOCHA(JEL,IC)
  336.                  RE(2,1,JEL)=-1.D0*VPOCHA(JEL,IC)
  337. c                  RE(2,2,JEL)=0.D0
  338.               ENDDO
  339.             ENDIF
  340.             ENDIF
  341. c          -cas quelconque
  342.             IF(ISYM.eq.3) THEN
  343.             IF(ICLE.eq.2) THEN
  344.               DO JEL=1,NBEL
  345. c                  RE(1,1,JEL)=0.D0
  346. c                  RE(1,2,JEL)=0.D0
  347.                  RE(2,1,JEL)=VPOCHA(JEL,IC)
  348. c                  RE(2,2,JEL)=0.D0
  349.               ENDDO
  350.             ELSE
  351.               DO JEL=1,NBEL
  352. c                  RE(1,1,JEL)=0.D0
  353.                  RE(1,2,JEL)=VPOCHA(JEL,IC)
  354. c                  RE(2,1,JEL)=0.D0
  355. c                  RE(2,2,JEL)=0.D0
  356.               ENDDO
  357.             ENDIF
  358.             ENDIF
  359.             if(iimpi.ge.2) then
  360.               write(IOIMP,*)' RE(1,:) = ',(RE(1,iou),iou=1,2)
  361.               write(IOIMP,*)' RE(2,:) = ',(RE(2,iou),iou=1,2)
  362.             endif
  363.             IRIGEL(4,IRIG)=XMATRI
  364.             xmatri.symre=irigel(7,irig)
  365.             SEGDES XMATRI
  366.  
  367.          ENDDO
  368. C   <--- FIN DE BOUCLE SUR LES COMPOSANTES ---------
  369.          SEGDES MPOVAL
  370.          SEGDES MSOUPO
  371.  
  372.       ENDDO
  373. C<==== FIN DE BOUCLE SUR LES ZONES DU CHPOINT ======================
  374.       SEGDES MRIGID
  375.       SEGDES MCHPOI
  376.  
  377.       IF(MLMOT1.ne.0) THEN
  378.          segdes,MLMOT1,MLMOT2
  379.       ENDIF
  380.  
  381. c***********************************************************************
  382. C Normal termination
  383. c***********************************************************************
  384.  
  385.       RETURN
  386.  
  387. c***********************************************************************
  388. c End of subroutine
  389. c***********************************************************************
  390.  
  391.       END
  392.  
  393.  
  394.  
  395.  
  396.  
  397.  

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