Télécharger la plaquette Cast3M


fr en

Télécharger cv2mab.eso

Retour à la liste

Numérotation des lignes : 

cv2mab

  1. C CV2MAB    SOURCE    GOUNAND   21/06/02    21:15:39     11022          
  2.       SUBROUTINE CV2MAB(MDISCP,NCVARP,MDISCD,NCVARD,
  3.      $     IMTLSB,
  4.      $     MYFALS,
  5.      $     MATLSB,
  6.      $     IMPR,IRET)
  7.       IMPLICIT REAL*8 (A-H,O-Z)
  8.       IMPLICIT INTEGER (I-N)
  9. C***********************************************************************
  10. C NOM         : CV2MAB
  11. C DESCRIPTION : Transforme un MCHAEL (mon champ par éléments)
  12. C               représentant un ensemble de matrices élémentaires en
  13. C               MATRIK...
  14. C
  15. C LANGAGE     : ESOPE
  16. C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  17. C               mél : gounand@semt2.smts.cea.fr
  18. C***********************************************************************
  19. C APPELES          : KEEF   (recherche de l'élément fini)
  20. C APPELES (E/S)    : ECROBJ, PRLIST (écriture entier, objet,
  21. C                    impression)
  22. C APPELE PAR       : PRLSB2
  23. C***********************************************************************
  24. C ENTREES            :
  25. C ENTREES/SORTIES    : -
  26. C SORTIES            :
  27. C TRAVAIL            : * MYMEL (type MELEME) : maillage élémentaire.
  28. C                      * JMTLSB (type MCHEVA) : valeurs du champ IMTLSB
  29. C                        sur le maillage élémentaire.
  30. C                        Structure (cf.include SMCHAEL) :
  31. C                        (nb. ddl dual, nb. ddl primal,
  32. C                         nb. comp. duales, nb. comp. primales,
  33. C                         1, nb. éléments)
  34. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  35. C***********************************************************************
  36. C VERSION    : v1, 22/07/09, version initiale
  37. C HISTORIQUE : v1, 22/07/09, création
  38. C HISTORIQUE :
  39. C HISTORIQUE :
  40. C***********************************************************************
  41. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  42. C en cas de modification de ce sous-programme afin de faciliter
  43. C la maintenance !
  44. C***********************************************************************
  45.  
  46. -INC PPARAM
  47. -INC CCOPTIO
  48. -INC SMLMOTS
  49.       POINTEUR NCVARP.MLMOTS
  50.       POINTEUR NCVARD.MLMOTS
  51. -INC SMELEME
  52.       POINTEUR MELPRI.MELEME
  53.       POINTEUR MELDUA.MELEME
  54.       POINTEUR MYMEL.MELEME
  55.       INTEGER NBNN,NBELEM,NBSOUS,NBREF
  56. -INC SMLENTI
  57.       POINTEUR LPOQFP.MLENTI
  58.       POINTEUR LPOQFD.MLENTI
  59.       POINTEUR KPOQFP.MLENTI
  60.       POINTEUR KPOQFD.MLENTI
  61.       INTEGER JG
  63.       POINTEUR MATLSB.MATRIK
  64. *
  65. * Includes persos
  66. *
  67. -INC TNLIN      
  68. *-INC SMCHAEL
  69.       POINTEUR IMTLSB.MCHAEL
  70.       POINTEUR JMTLSB.MCHEVA
  71.       INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM
  72. *-INC SFALRF
  73.       POINTEUR MYFALS.FALRFS
  74. *-INC SELREF
  75.       POINTEUR LRFPRI.ELREF
  76.       POINTEUR LRFDUA.ELREF
  77. *
  78.       CHARACTER*4 MDISCP,MDISCD
  79.       INTEGER IMPR,IRET
  80. *
  81.       INTEGER IBNN,IBELEM
  82.       INTEGER ITQUAF,NDDLPR,NDDLDU
  83.       INTEGER        IDDLPR,IDDLDU
  84.       INTEGER               NSOUS,NPOQUF
  85.       INTEGER ISOUS
  86.       INTEGER ILIGRP,ILIGRD,IELRIG,ICMPP,ICMPD
  87.  
  88. *
  89. * Executable statements
  90. *
  91.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans cv2mab'
  92.       NRIGE=7
  93.       NMATRI=0
  94.       NKID=9
  95.       NKMT=7
  96.       SEGINI,MATLSB
  97. *
  98. *     Remplissage de MRIGID
  99. *
  100.       SEGACT NCVARP
  101.       SEGACT NCVARD
  102.       SEGACT IMTLSB
  103.       NSOUS=IMTLSB.JMACHE(/1)
  104. C      SEGPRT,NCVARP
  105. C      SEGPRT,NCVARD
  106. C      SEGPRT,IMTLSB
  107.       DO ISOUS=1,NSOUS
  108.          JMTLSB=IMTLSB.ICHEVA(ISOUS)
  109.          IF (JMTLSB.NE.0) THEN
  110. C            SEGPRT,NCVARP
  111. C            SEGPRT,NCVARD
  112. C            SEGPRT,JMTLSB
  113.             SEGACT JMTLSB
  114.             MYMEL =IMTLSB.JMACHE(ISOUS)
  115.             SEGACT MYMEL
  116.             ITQUAF=MYMEL.ITYPEL
  117.             CALL KEEF(ITQUAF,MDISCP,MYFALS,
  118.      $           LRFPRI,IMPR,IRET)
  119.             IF (IRET.NE.0) GOTO 9999
  120.             SEGACT LRFPRI
  121.             NDDLPR=LRFPRI.NPQUAF(/1)
  122.             CALL KEEF(ITQUAF,MDISCD,MYFALS,
  123.      $           LRFDUA,IMPR,IRET)
  124.             IF (IRET.NE.0) GOTO 9999
  125.             SEGACT LRFDUA
  126.             NDDLDU=LRFDUA.NPQUAF(/1)
  127.             DO IVARP=1,NCVARP.MOTS(/2)
  128. *  Construction de la liste des points du QUAF sur lesquels il y a des
  129. *  ddl pour l'inconnue primale
  130.                JG=0
  131.                SEGINI LPOQFP
  132.                DO IDDLPR=1,NDDLPR
  133.                   IF (LRFPRI.NUMCMP(IDDLPR).EQ.IVARP) THEN
  134.                      LPOQFP.LECT(**)=LRFPRI.NPQUAF(IDDLPR)
  135.                   ENDIF
  136.                ENDDO
  137.                IF (LPOQFP.LECT(/1).EQ.0) THEN
  138.                   GOTO 1
  139.                ENDIF
  140. C*  Suppression des doublons (pas besoin)
  141. C               CALL IUNIQ(LPOQFP.LECT,LPOQFP.LECT(/1),
  142. C     $           LPOQFP.LECT,NPOQFP,
  143. C     $              IMPR,IRET)
  144. C               IF (IRET.NE.0) GOTO 9999
  145. C               JG=NPOQFP
  146. C               SEGADJ,LPOQFP
  147. * Segment de repérage dans cette liste
  148.                JG=MYMEL.NUM(/1)
  149.                SEGINI,KPOQFP
  150.                CALL RSETXI(KPOQFP.LECT,LPOQFP.LECT,LPOQFP.LECT(/1))
  151. * Construction du maillage primal
  152.                NBNN=LPOQFP.LECT(/1)
  153.                NBELEM = MYMEL.NUM(/2)
  154.                NBSOUS = 0
  155.                NBREF=0
  156.                SEGINI,MELPRI
  157. * Type 32 POLY
  158.                MELPRI.ITYPEL=32
  159.                DO IBELEM=1,NBELEM
  160.                   DO IBNN=1,NBNN
  161.                      MELPRI.NUM(IBNN,IBELEM)=
  162.      $                    MYMEL.NUM(LPOQFP.LECT(IBNN),IBELEM)
  163.                   ENDDO
  164.                ENDDO
  165.                SEGDES MELPRI
  166. *
  167.                DO IVARD=1,NCVARD.MOTS(/2)
  168. *  Construction de la liste des points du QUAF sur lesquels il y a des
  169. *  ddl pour l'inconnue duale
  170.                   JG=0
  171.                   SEGINI LPOQFD
  172.                   DO IDDLDU=1,NDDLDU
  173.                      IF (LRFDUA.NUMCMP(IDDLDU).EQ.IVARD) THEN
  174.                         LPOQFD.LECT(**)=LRFDUA.NPQUAF(IDDLDU)
  175.                      ENDIF
  176.                   ENDDO
  177.                   IF (LPOQFD.LECT(/1).EQ.0) THEN
  178.                      GOTO 3
  179.                   ENDIF
  180. C*  Suppression des doublons
  181. C                  CALL IUNIQ(LPOQFD.LECT,LPOQFD.LECT(/1),
  182. C     $                 LPOQFD.LECT,NPOQFD,
  183. C     $                 IMPR,IRET)
  184. C                  IF (IRET.NE.0) GOTO 9999
  185. C                  JG=NPOQFD
  186. C                  SEGADJ,LPOQFD
  187. * Segment de repérage dans cette liste
  188.                   JG=MYMEL.NUM(/1)
  189.                   SEGINI,KPOQFD
  190.                   CALL RSETXI(KPOQFD.LECT,LPOQFD.LECT,LPOQFD.LECT(/1))
  191. * Construction du maillage dual
  192.                   NBNN=LPOQFD.LECT(/1)
  193.                   NBELEM = MYMEL.NUM(/2)
  194.                   NBSOUS = 0
  195.                   NBREF=0
  196.                   SEGINI,MELDUA
  197. * Type 32 POLY
  198.                   MELDUA.ITYPEL=32
  199.                   DO IBELEM=1,NBELEM
  200.                      DO IBNN=1,NBNN
  201.                         MELDUA.NUM(IBNN,IBELEM)=
  202.      $                       MYMEL.NUM(LPOQFD.LECT(IBNN),IBELEM)
  203.                      ENDDO
  204.                   ENDDO
  205.                   SEGDES MELDUA
  206. * Construction du IMATRI
  207.                   NBME=1
  208.                   NBSOUS=1
  209.                   SEGINI IMATRI
  210.                   LISPRI(1)=NCVARP.MOTS(IVARP)
  211.                   LISDUA(1)=NCVARD.MOTS(IVARD)
  212. * Construction du IZAFM
  213.                   NBEL=MYMEL.NUM(/2)
  214.                   NP=LPOQFP.LECT(/1)
  215.                   MP=LPOQFD.LECT(/1)
  216.                   SEGINI IZAFM
  217. * remplissage des matrices élémentaires
  218.                   NBLIG=JMTLSB.WELCHE(/1)
  219.                   NBCOL=JMTLSB.WELCHE(/2)
  220.                   N2LIG=JMTLSB.WELCHE(/3)
  221.                   N2COL=JMTLSB.WELCHE(/4)
  222.                   NBPOI=JMTLSB.WELCHE(/5)
  223.                   NBELM=JMTLSB.WELCHE(/6)
  224.                   IF (NBLIG.NE.NDDLDU.OR.NBCOL.NE.NDDLPR.OR.N2LIG.NE.1
  225.      $                 .OR.N2COL.NE.1.OR.NBPOI.NE.1.OR.NBELM.NE.NBEL)
  226.      $                 THEN
  227.                      WRITE(IOIMP,*) 'Erreur dims JMTLSB'
  228.                      GOTO 9999
  229.                   ENDIF
  230.                   DO IDDLDU=1,NDDLDU
  231.                      IF (LRFDUA.NUMCMP(IDDLDU).EQ.IVARD) THEN
  232.                         IMP=KPOQFD.LECT(LRFDUA.NPQUAF(IDDLDU))
  233.                         DO IDDLPR=1,NDDLPR
  234.                            IF (LRFPRI.NUMCMP(IDDLPR).EQ.IVARP) THEN
  235.                               INP=KPOQFP.LECT(LRFPRI.NPQUAF(IDDLPR))
  236.                               DO IBEL=1,NBEL
  237.                                  AM(IBEL,INP,IMP)=
  238.      $                                JMTLSB.WELCHE(IDDLDU,IDDLPR,
  239.      $                                1,1,1,IBEL)
  240.                               ENDDO
  241.                            ENDIF
  242.                         ENDDO
  243.                      ENDIF
  244.                   ENDDO
  245.                   SEGDES IZAFM
  246.                   LIZAFM(1,1)=IZAFM
  247.                   SEGDES IMATRI
  248. *
  249. * Remplissage du chapeau
  250. *
  251.                   NRIGE=MATLSB.IRIGEL(/1)
  252.                   NMATRI=MATLSB.IRIGEL(/2)+1
  253.                   NKID=MATLSB.KIDMAT(/1)
  254.                   NKMT=MATLSB.KKMMT(/1)
  255.                   SEGADJ,MATLSB
  256.                   MATLSB.IRIGEL(1,NMATRI)=MELPRI
  257.                   MATLSB.IRIGEL(2,NMATRI)=MELDUA
  258.                   MATLSB.IRIGEL(4,NMATRI)=IMATRI
  259.                   MATLSB.IRIGEL(7,NMATRI)=2
  260.                   SEGSUP KPOQFD
  261.  3                CONTINUE
  262.                   SEGSUP LPOQFD
  263.                ENDDO
  264.                SEGSUP KPOQFP
  265.  1             CONTINUE
  266.                SEGSUP LPOQFP
  267.             ENDDO
  268.             SEGDES LRFDUA
  269.             SEGDES LRFPRI
  270.             SEGDES MYMEL
  271.             SEGDES JMTLSB
  272.          ENDIF
  273.       ENDDO
  274.       SEGDES IMTLSB
  275.       SEGDES NCVARD
  276.       SEGDES NCVARP
  277.       SEGDES MATLSB
  278.       IF (IMPR.GT.3) THEN
  279.          WRITE(IOIMP,*) 'On a créé MATLSB=',MATLSB
  280.          CALL ECROBJ('MATRIK  ',MATLSB)
  281.          CALL PRLIST
  282.       ENDIF
  283. *
  284. * Normal termination
  285. *
  286.       IRET=0
  287.       RETURN
  288. *
  289. * Format handling
  290. *
  291. *
  292. * Error handling
  293. *
  294.  9999 CONTINUE
  295.       IRET=1
  296.       WRITE(IOIMP,*) 'An error was detected in subroutine cv2mab'
  297.       RETURN
  298. *
  299. * End of subroutine CV2MAB
  300. *
  301.       END
  302.  
  303.  
  304.  
  305.  
  306.  
  307.  
  308.  
  309.  

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