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

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