Télécharger la plaquette Cast3M


fr en

Télécharger cv2cml.eso

Retour à la liste

Numérotation des lignes : 

cv2cml

  1. C CV2CML    SOURCE    PV090527  25/01/07    14:42:31     12115          
  2.       SUBROUTINE CV2CML(CGEOMQ,MYDISC,MYLMOT,MYMCHA,
  3.      $     MYFALS,
  4.      $     MCHELM,
  5.      $     IMPR,IRET)
  6.       IMPLICIT REAL*8 (A-H,O-Z)
  7.       IMPLICIT INTEGER (I-N)
  8. C***********************************************************************
  9. C NOM         : CV2CML
  10. C DESCRIPTION : Transforme un MCHAEL en MCHAML pour peu que
  11. C               MYDISC = QUAF ou QUAI ou LINE => MCHAML AUX noeuds
  12. C               MYDISC = CSTE => MCHAML AUX noeuds du QUAF constant par
  13. C               éléments
  14. C
  15. C LANGAGE     : ESOPE
  16. C AUTEUR      : Stéphane GOUNAND (CEA/DES/ISAS/DM2S/SEMT/LTA)
  17. C               mél : gounand@semt2.smts.cea.fr
  18. C***********************************************************************
  19. C APPELES          :
  20. C APPELE PAR       : PRLIN2
  21. C***********************************************************************
  22. C ENTREES            : * CGEOME (type MELEME) : maillage de QUAFs
  23. C                        partitionné.
  24. C                      * MYDISC (type CH*(4)) : nom d'espace de
  25. C                        discrétisation (cf. NOMFA dans l'include
  26. C                        SFALRF)
  27. C                      * MYFALS (type FALRFS) : segment de description
  28. C                        des familles d'éléments de références.
  29. C SORTIES            : * MYMCHA (type MCHAEL) : champ par éléments de
  30. C                        la grandeur tensorielle (degrés de liberté de
  31. C                        la grandeur).
  32. C ENTREES/SORTIES    : -
  33. C TRAVAIL            :
  34. C                        (1, nb. ddl, NCOMPD, NCOMPP, 1, nb. élément)
  35. C
  36. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  37. C***********************************************************************
  38. C VERSION    : v1, 21/05/21, version initiale basée sur CV2CP9
  39. C HISTORIQUE : v1, 21/05/21, création
  40. C HISTORIQUE :
  41. C HISTORIQUE :
  42. C***********************************************************************
  43. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  44. C en cas de modification de ce sous-programme afin de faciliter
  45. C la maintenance !
  46. C***********************************************************************
  47.  
  48. -INC PPARAM
  49. -INC CCOPTIO
  50. -INC CCGEOME
  51. -INC SMCOORD
  52. -INC SMCHAML
  53. -INC SMELEME
  54.       POINTEUR CGEOMQ.MELEME
  55.       POINTEUR SOUMAI.MELEME
  56.       POINTEUR SOUMAQ.MELEME
  57. -INC SMLENTI
  58.       POINTEUR MPQUAF.MLENTI
  59.       POINTEUR IORDO.MLENTI
  60. -INC SMLMOTS
  61.       POINTEUR MYLMOT.MLMOTS
  62. *
  63. * Includes persos
  64. *
  65. -INC TNLIN
  66. *-INC SMCHAEL
  67.       POINTEUR MYMCHA.MCHAEL
  68.       POINTEUR MZMCHA.MCHEVA
  69. *-INC SFALRF
  70.       POINTEUR MYFALS.FALRFS
  71. *-INC SELREF
  72.       POINTEUR MYLRF.ELREF
  73. *
  74.       CHARACTER*(4) MYDISC
  75.       PARAMETER (NDISC=4)
  76.       CHARACTER*(4) DISCS(NDISC)
  77.       LOGICAL LCROI
  78.       INTEGER IMPR,IRET
  79. *
  80.       DATA DISCS/'CSTE','LINE','QUAI','QUAF'/
  81. *
  82. * Executable statements
  83. *
  84.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans cv2cml'
  85. *
  86.       CALL PLACE5(DISCS,NDISC,IDISC,MYDISC)
  87. * Cas particulier MYDISC='CSTE'
  88.       IF (IDISC.EQ.1) THEN
  89.          SEGACT MYMCHA
  90.          NSOUS=MYMCHA.JMACHE(/1)
  91.          SEGACT CGEOMQ
  92. *
  93.          L1=8
  94.          N1=NSOUS
  95.          N3=6
  96.          SEGINI MCHELM
  97.          TITCHE='NLIN    '
  98.          IFOCHE=IFOUR
  99.          SEGACT MYLMOT
  100.          NNCOMP=MYLMOT.MOTS(/2)
  101.          IF (NNCOMP.NE.1) THEN
  102.             WRITE(IOIMP,*) 'Programming Error 1'
  103.             GOTO 9999
  104.          ENDIF
  105.          DO ISOUS=1,NSOUS
  106.             SOUMAI=CGEOMQ.LISREF(ISOUS)
  107.             IF (SOUMAI.EQ.0) THEN
  108.                SOUMAI=CGEOMQ.LISOUS(ISOUS)
  109.             ENDIF
  110.             SEGACT SOUMAI
  111.             MZMCHA=MYMCHA.ICHEVA(ISOUS)
  112.             SEGACT,MZMCHA
  113.             NBEL=SOUMAI.NUM(/2)
  114. * Petits tests
  115.             NDLIG=MZMCHA.WELCHE(/1)
  116.             NDCOL=MZMCHA.WELCHE(/2)
  117.             N2DLIG=MZMCHA.WELCHE(/3)
  118.             N2DCOL=MZMCHA.WELCHE(/4)
  119.             NDNOEU=MZMCHA.WELCHE(/5)
  120.             NDELM=MZMCHA.WELCHE(/6)
  121.             IF (.NOT.(NDLIG.EQ.1
  122.      $           .AND.NDCOL.EQ.1
  123.      $           .AND.N2DLIG.EQ.1
  124.      $           .AND.N2DCOL.EQ.1.AND.NDNOEU.EQ.1
  125.      $           .AND.(NDELM.EQ.1.OR.NDELM.EQ.NBEL))) THEN
  126.                WRITE(IOIMP,*) 'Erreur dims MZMCHA'
  127.                write(ioimp,*) 'NDLIG,NDCOL=',NDLIG,NDCOL
  128.                write(ioimp,*) 'N2DLIG,N2DCOL=',N2DLIG,N2DCOL
  129.                write(ioimp,*) 'NDNOEU,NDELM,NBEL=',NDNOEU,NDELM,NBEL
  130.                GOTO 9999
  131.             ENDIF
  132.             N2=1
  133.             SEGINI MCHAML
  134.             NOMCHE(1)=MYLMOT.MOTS(1)
  135.             TYPCHE(1)='REAL*8          '
  136.             N1PTEL=1
  137.             N1EL=NDELM
  138.             N2PTEL=0
  139.             N2EL=0
  140.             SEGINI MELVAL
  141.             DO IDELM=1,NDELM
  142.                VELCHE(1,IDELM)=MZMCHA.WELCHE(1,1,1,1,1,IDELM)
  143.             ENDDO
  144.             IELVAL(1)=MELVAL
  145.             CONCHE(ISOUS)=' '
  146.             ICHAML(ISOUS)=MCHAML
  147.             IMACHE(ISOUS)=SOUMAI
  148.             INFCHE(ISOUS,1)=0
  149.             INFCHE(ISOUS,2)=0
  150.             INFCHE(ISOUS,3)=NIFOUR
  151.             INFCHE(ISOUS,4)=0
  152.             INFCHE(ISOUS,5)=0
  153.             INFCHE(ISOUS,6)=1
  154.          ENDDO
  155. * Cas MYDISC='LINE','QUAI','QUAF'
  156.       ELSEIF (IDISC.GT.1.AND.IDISC.LE.NDISC) THEN
  157.          SEGACT MYMCHA
  158.          NSOUS=MYMCHA.JMACHE(/1)
  159.          SEGACT CGEOMQ
  160.          L1=8
  161.          N1=NSOUS
  162.          N3=6
  163.          SEGINI MCHELM
  164.          TITCHE='NLIN    '
  165.          IFOCHE=IFOUR
  166.          SEGACT MYLMOT
  167.          NNCOMP=MYLMOT.MOTS(/2)
  168.          IF (NNCOMP.NE.1) THEN
  169.             WRITE(IOIMP,*) 'Programming Error 2'
  170.             GOTO 9999
  171.          ENDIF
  172.          DO ISOUS=1,NSOUS
  173.             SOUMAQ=CGEOMQ.LISOUS(ISOUS)
  174.             SEGACT SOUMAQ
  175.             SOUMAI=CGEOMQ.LISREF(ISOUS)
  176.             IF (SOUMAI.EQ.0) THEN
  177.                SOUMAI=SOUMAQ
  178.             ELSE
  179.                SEGACT SOUMAI
  180.             ENDIF
  181.             MZMCHA=MYMCHA.ICHEVA(ISOUS)
  182.             SEGACT,MZMCHA
  183.             NBNN=SOUMAI.NUM(/1)
  184.             NBEL=SOUMAQ.NUM(/2)
  185.             ITQUAF=SOUMAQ.ITYPEL
  186. * On cherche l'élément fini correspondant au QUAF
  187.             CALL KEEF(ITQUAF,MYDISC,
  188.      $           MYFALS,
  189.      $           MYLRF,
  190.      $           IMPR,IRET)
  191.             IF (IRET.NE.0) GOTO 9999
  192.             SEGACT MYLRF
  193.             NDDL=MYLRF.NPQUAF(/1)
  194.             IF (NDDL.NE.NBNN) THEN
  195.                WRITE(IOIMP,*) 'Programming error 3'
  196.                write(ioimp,*) 'MYDISC=',MYDISC
  197.                write(ioimp,*) 'NBNN,NDDL=',NBNN,NDDL
  198.                GOTO 9999
  199.             ENDIF
  200. * Petits tests
  201.             NDLIG=MZMCHA.WELCHE(/1)
  202.             NDCOL=MZMCHA.WELCHE(/2)
  203.             N2DLIG=MZMCHA.WELCHE(/3)
  204.             N2DCOL=MZMCHA.WELCHE(/4)
  205.             NDNOEU=MZMCHA.WELCHE(/5)
  206.             NDELM=MZMCHA.WELCHE(/6)
  207.             IF (.NOT.( (NDLIG.EQ.1.AND.NDCOL.EQ.NDDL)
  208.      $           .OR. (NDLIG.EQ.NDDL.AND.NDCOL.EQ.1))
  209.      $           .AND.N2DLIG.NE.1
  210.      $           .AND.N2DCOL.NE.1.AND.NDNOEU.NE.1
  211.      $           .AND.(NDELM.NE.1.OR.NDELM.NE.NBEL)) THEN
  212.                WRITE(IOIMP,*) 'Erreur dims MZMCHA'
  213.                GOTO 9999
  214.             ENDIF
  215.             N2=1
  216.             SEGINI MCHAML
  217.             NOMCHE(1)=MYLMOT.MOTS(1)
  218.             TYPCHE(1)='REAL*8          '
  219.             N1PTEL=NDDL
  220.             N1EL=NDELM
  221.             N2PTEL=0
  222.             N2EL=0
  223.             SEGINI MELVAL
  224. *     Construisons le segment qui permet de parcourir les ddl dans
  225. *     l'ordre croissant des points du quaf
  226. *     Implicitement, on utilise le fait que les maillages LINE et QUAD
  227. *     parcourent les points du QUAF en croissant aussi.
  228. *     On utilise le tri par insertion car les listes sont petites
  229.             JG=NDDL
  230.             SEGINI MPQUAF
  231.             SEGINI IORDO
  232.             DO IG=1,JG
  233.                MPQUAF.LECT(IG)=MYLRF.NPQUAF(IG)
  234.                IORDO.LECT(IG)=IG
  235.             ENDDO
  236.             LCROI=.TRUE.
  237.             CALL ORDO04(MPQUAF.LECT(1),NDDL,LCROI,IORDO.LECT(1))
  238. *
  239.             DO IDELM=1,NDELM
  240.                DO IDDL=1,NDDL
  241.                   JDDL=IORDO.LECT(IDDL)
  242.                   IF (NDLIG.EQ.1) THEN
  243.                      ILIG=1
  244.                      ICOL=JDDL
  245.                   ELSE
  246.                      ILIG=JDDL
  247.                      ICOL=1
  248.                   ENDIF
  249.                   VELCHE(IDDL,IDELM)=MZMCHA.WELCHE(ILIG,ICOL,1,1,1
  250.      $                 ,IDELM)
  251.                ENDDO
  252.             ENDDO
  253.             SEGSUP IORDO
  254.             SEGSUP MPQUAF
  255.             IELVAL(1)=MELVAL
  256.             CONCHE(ISOUS)=' '
  257.             ICHAML(ISOUS)=MCHAML
  258.             IMACHE(ISOUS)=SOUMAI
  259.             INFCHE(ISOUS,1)=0
  260.             INFCHE(ISOUS,2)=0
  261.             INFCHE(ISOUS,3)=NIFOUR
  262.             INFCHE(ISOUS,4)=0
  263.             INFCHE(ISOUS,5)=0
  264.             INFCHE(ISOUS,6)=1
  265.          ENDDO
  266.       ELSE
  267.          WRITE(IOIMP,*) 'CHAM keyword incompatible with discretization '
  268.      $        ,MYDISC
  269.          GOTO 9999
  270.       ENDIF
  271. *      IMPR=6
  272.       IF (IMPR.GT.3) THEN
  273.          CALL ECROBJ('MCHAML  ',MCHELM)
  274.          CALL PRLIST
  275.       ENDIF
  276. *      IMPR=0
  277. *
  278. * Normal termination
  279. *
  280.       IRET=0
  281.       RETURN
  282. *
  283. * Format handling
  284. *
  285. *
  286. * Error handling
  287. *
  288.  9999 CONTINUE
  289.       IRET=1
  290.       WRITE(IOIMP,*) 'An error was detected in subroutine cv2cml'
  291.       RETURN
  292. *
  293. * End of subroutine CV2CML
  294. *
  295.       END
  296.  
  297.  
  298.  

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