Télécharger la plaquette Cast3M


fr en

Télécharger tens1.eso

Retour à la liste

Numérotation des lignes : 

tens1

  1. C TENS1     SOURCE    GOUNAND   25/10/23    21:15:08     12386          
  2.       SUBROUTINE TENS1(ICHA,TYCHA,MLMOTS,IOTENS,ICHA1)
  3.       IMPLICIT REAL*8 (A-H,O-Z)
  4.       IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM         : TENS1
  7. C DESCRIPTION : Opérations sur des tenseurs (unaires pour l'instant)
  8. C
  9. C
  10. C
  11. C LANGAGE     : ESOPE
  12. C AUTEUR      : Stephane GOUNAND (CEA/DES/ISAS/DM2S/SEMT/LTA)
  13. C               mel : gounand@semt2.smts.cea.fr
  14. C***********************************************************************
  15. C APPELES          :
  16. C APPELES (E/S)    :
  17. C APPELES (BLAS)   :
  18. C APPELES (CALCUL) :
  19. C APPELE PAR       :
  20. C***********************************************************************
  21. C SYNTAXE GIBIANE    :
  22. C ENTREES            :
  23. C ENTREES/SORTIES    :
  24. C SORTIES            :
  25. C***********************************************************************
  26. C VERSION    : v1, 28/08/2024, version initiale
  27. C HISTORIQUE : v1, 28/08/2024, creation
  28. C HISTORIQUE :
  29. C HISTORIQUE :
  30. C***********************************************************************
  31. -INC PPARAM
  32. -INC CCOPTIO
  33. -INC CCREEL
  34. -INC SMCHPOI
  35. -INC SMCHAML
  36. -INC SMLMOTS
  37. -INC TMTRAV
  38.       SEGMENT MTRAV1.MTRAV
  39.       SEGMENT MTRCML
  40.       REAL*8 CC(NNIN,N1PTEL,N1EL)
  41.       ENDSEGMENT
  42.       CHARACTER*8 TYCHA,CCCOMP
  43.       segment idxcom(ncomp)
  44. *
  45. C   ENTREEES
  46. C        A(3,3) = MATRICE A DIAGONALISER
  47. C   SORTIES
  48. C        D(3)   =  VALEURS PROPRES D(1) > D(2) ET D(3)=A(3,3)
  49. C        R(3,3) =  RESULTAT DES OPERATIONS TENSORIELLES
  50.       DIMENSION A(3,3),D(3),R(3,3)
  51.       DIMENSION IDXSYM(3,3,3)
  52.       DIMENSION IDXGEN(3,3,3)
  53.       DIMENSION INVSYM(2,6,3)
  54.       DIMENSION INVGEN(2,9,3)
  55.       DATA ((A(I,J),I=1,3),J=1,3) /9*0.D0/
  56.       DATA (D(I),I=1,3) /3*0.D0/
  57.       DATA ((R(I,J),I=1,3),J=1,3) /9*0.D0/
  58.       DATA (((IDXSYM(I,J,K),I=1,1),J=1,1),K=1,1) /1/
  59.       DATA (((IDXSYM(I,J,K),I=1,2),J=1,2),K=2,2) /1,2,2,3/
  60.       DATA (((IDXSYM(I,J,K),I=1,3),J=1,3),K=3,3) /1,2,4,2,3,5,4,5,6/
  61.       DATA (((IDXGEN(I,J,K),I=1,1),J=1,1),K=1,1) /1/
  62.       DATA (((IDXGEN(I,J,K),I=1,2),J=1,2),K=2,2) /1,3,2,4/
  63.       DATA (((IDXGEN(I,J,K),I=1,3),J=1,3),K=3,3) /1,4,7,2,5,8,3,6,9/
  64. *
  65.       DATA (((INVSYM(I,J,K),I=1,2),J=1,1),K=1,1) /1,1/
  66.       DATA (((INVSYM(I,J,K),I=1,2),J=1,3),K=2,2) /1,1,2,1,2,2/
  67.       DATA (((INVSYM(I,J,K),I=1,2),J=1,6),K=3,3)
  68.      $     /1,1,2,1,2,2,3,1,3,2,3,3/
  69.       DATA (((INVGEN(I,J,K),I=1,2),J=1,1),K=1,1) /1,1/
  70.       DATA (((INVGEN(I,J,K),I=1,2),J=1,4),K=2,2) /1,1,1,2,2,1,2,2/
  71.       DATA (((INVGEN(I,J,K),I=1,2),J=1,9),K=3,3)
  72.      $     /1,1,1,2,1,3,2,1,2,2,2,3,3,1,3,2,3,3/
  73. *
  74. *      DATA MOTENS/'NORM2','NORMINF','DET','TRACE','INVERSE','IDEN','LOG'
  75. *     $     ,'EXP','INVS','ABSOLU','PRINCIPA','RECOMPOS','TRANSPOS'/
  76.  
  77. *
  78. * Executable statements
  79. *
  80.       SEGACT MLMOTS
  81.       NCOMP=MOTS(/2)
  82. * Cas entrée scalaire ou vecteur, symétrique, ordre 2, général
  83.       IF (NCOMP.EQ.1) THEN
  84.          IKAS=1
  85.       ELSEIF (NCOMP.EQ.IDIM) THEN
  86.          IKAS=2
  87.       ELSEIF (NCOMP*2.EQ.IDIM*(IDIM+1)) THEN
  88.          IKAS=3
  89.       ELSEIF (NCOMP.EQ.IDIM*IDIM) THEN
  90.          IKAS=4
  91.       ELSEIF (NCOMP.EQ.IDIM*(IDIM+1).AND.IOTENS.EQ.12) THEN
  92.          IKAS=5
  93.       ELSE
  94.          GOTO 9997
  95.       ENDIF
  96. * Nombre de composantes du résultat
  97.       IF (IOTENS.GE.1.AND.IOTENS.LE.4) THEN
  98.          NCOM1=1
  99.       ELSEIF (IOTENS.EQ.11) THEN
  100.          NCOM1=IDIM*(IDIM+1)
  101.       ELSEIF (IOTENS.EQ.12) THEN
  102.          NCOM1=(IDIM*(IDIM+1))/2
  103.       ELSE
  104.          NCOM1=NCOMP
  105.       ENDIF
  106.       IF (TYCHA.EQ.'CHPOINT ') THEN
  107.          MCHPOI=ICHA
  108. * Transformation du CHPOINT entré en objet de travail
  109.          CALL CP2TR2(MLMOTS,0,MCHPOI,MTRAV)
  110.          IF (IERR.NE.0) RETURN
  111.          SEGACT MTRAV*MOD
  112.          NNNOE=IGEO(/1)
  113.          IF (NCOM1.NE.NCOMP) THEN
  114.             NNIN=NCOM1
  115.             SEGINI MTRAV1
  116.             IF (NCOM1.EQ.1.AND.IOTENS.NE.12) THEN
  117.                MTRAV1.INCO(1)='SCAL'
  118.                MTRAV1.NHAR(1)=NHAR(1)
  119.             ELSEIF (IOTENS.EQ.11) THEN
  120.                ICMP=0
  121.                CCCOMP='SI'
  122.                DO i=1,IDIM
  123.                   WRITE(CCCOMP(3:3),FMT='(I1)') I
  124.                   WRITE(CCCOMP(4:4),FMT='(I1)') I
  125.                   ICMP=ICMP+1
  126.                   MTRAV1.INCO(ICMP)=CCCOMP
  127.                   MTRAV1.NHAR(ICMP)=NHAR(1)
  128.                ENDDO
  129.                CCCOMP='CO'
  130.                DO i=1,IDIM
  131.                   WRITE(CCCOMP(4:4),FMT='(I1)') I
  132.                   DO j=1,IDIM
  133.                      WRITE(CCCOMP(3:3),FMT='(I1)') J
  134.                      ICMP=ICMP+1
  135.                      MTRAV1.INCO(ICMP)=CCCOMP
  136.                      MTRAV1.NHAR(ICMP)=NHAR(1)
  137.                   ENDDO
  138.                ENDDO
  139.             ELSEIF (IOTENS.EQ.12) THEN
  140.                ICMP=0
  141.                CCCOMP='G'
  142.                DO i=1,IDIM
  143.                   WRITE(CCCOMP(2:2),FMT='(I1)') I
  144.                   DO j=1,i
  145.                      WRITE(CCCOMP(3:3),FMT='(I1)') J
  146.                      ICMP=ICMP+1
  147.                      MTRAV1.INCO(ICMP)=CCCOMP
  148.                      MTRAV1.NHAR(ICMP)=NHAR(1)
  149.                   ENDDO
  150.                ENDDO
  151.             ELSE
  152.                write(ioimp,*) 'CHPO COMP ncom1=',ncom1,' ????'
  153.                goto 9999
  154.             ENDIF
  155.             DO INNOE=1,NNNOE
  156.                MTRAV1.IGEO(INNOE)=IGEO(INNOE)
  157.             ENDDO
  158.          ENDIF
  159.       ELSEIF (TYCHA.EQ.'MCHAML') THEN
  160.          MCHELM=ICHA
  161.          NOID=1
  162. * Extrayons les composantes intéressantes
  163. *         write(ioimp,*) 'Avant excoc2' ;
  164. *         CALL ECROBJ('MCHAML  ',MCHELM)
  165. *         call prlist
  166. *         segprt,MLMOTS
  167.          CALL EXCOC2(MCHELM,MLMOTS,MCHEL1,MLMOTS,NOID)
  168.          IF (IERR.NE.0) RETURN
  169. *         write(ioimp,*) 'Apres excoc2' ;
  170. *         CALL ECROBJ('MCHAML  ',MCHEL1)
  171. *         call prlist
  172.          CALL ACTOBJ('MCHAML  ',MCHEL1,1)
  173.          SEGACT,MCHEL1*MOD
  174.          SEGACT MLMOTS
  175.       ELSE
  176.          GOTO 9998
  177.       ENDIF
  178. *      segprt,mtrav
  179. *
  180. *     write(ioimp,*) 'IOTENS=',IOTENS
  181. *
  182. * Un peu de gestion d'erreur avant la boucle...
  183. *
  184. * Seuls NORM2 et NORMINF disponibles pour les vecteurs
  185.       IF (IKAS.EQ.2.AND.IOTENS.GT.2) THEN
  186.          CALL ERREUR(803)
  187.          RETURN
  188.       ENDIF
  189.       MOTERR(1:8)=TYCHA
  190. *
  191. * La boucle sur les noeuds ou les éléments : on pourra paralléliser ici
  192. *
  193.       IF (TYCHA.EQ.'CHPOINT ') THEN
  194.          DO INNOE=1,NNNOE
  195. * Remplissage des tableaux de travail
  196.             IF (IKAS.EQ.1.OR.IKAS.EQ.2) THEN
  197.                DO I=1,NCOMP
  198.                   A(I,1)=BB(I,INNOE)
  199.                ENDDO
  200.             ELSEIF (IKAS.EQ.3) THEN
  201.                DO J=1,IDIM
  202.                   DO I=1,IDIM
  203.                      A(I,J)=BB(IDXSYM(I,J,IDIM),INNOE)
  204.                   ENDDO
  205.                ENDDO
  206.             ELSEIF (IKAS.EQ.4) THEN
  207.                DO J=1,IDIM
  208.                   DO I=1,IDIM
  209.                      A(I,J)=BB(IDXGEN(I,J,IDIM),INNOE)
  210.                   ENDDO
  211.                ENDDO
  212.             ELSEIF (IKAS.EQ.5) THEN
  213.                ICMP=0
  214.                DO i=1,IDIM
  215.                   ICMP=ICMP+1
  216.                   D(i)=BB(ICMP,INNOE)
  217.                ENDDO
  218.                DO i=1,IDIM
  219.                   DO j=1,IDIM
  220.                      ICMP=ICMP+1
  221.                      R(j,i)=BB(ICMP,INNOE)
  222.                   ENDDO
  223.                ENDDO
  224.             ELSE
  225.                write(ioimp,*) 'ikas=',ikas,' ????'
  226.                MOTERR(1:8)='TENS1'
  227.                call erreur(1039)
  228.                return
  229.             endif
  230. *     On prépare le message d'erreur 49 en cas de déterminant nul pour
  231. *     l'inversion d'une matrice...
  232.             IF (IOTENS.EQ.5) INTERR(1)=IGEO(INNOE)
  233. *
  234. * Faire les opérations tensorielles
  235. *
  236.             CALL TENS2(IOTENS,IKAS,A,D,R)
  237.             IF (IERR.NE.0) RETURN
  238. *
  239.             IF (NCOM1.NE.NCOMP) THEN
  240.                IF(NCOM1.EQ.1) THEN
  241.                   MTRAV1.BB(1,INNOE)=R(1,1)
  242.                   MTRAV1.IBIN(1,INNOE)=1
  243.                ELSEIF (IOTENS.EQ.11) THEN
  244.                   ICMP=0
  245.                   DO i=1,IDIM
  246.                      ICMP=ICMP+1
  247.                      MTRAV1.BB(ICMP,INNOE)=D(i)
  248.                      MTRAV1.IBIN(ICMP,INNOE)=1
  249.                   ENDDO
  250.                   DO i=1,IDIM
  251.                      DO j=1,IDIM
  252.                         ICMP=ICMP+1
  253.                         MTRAV1.BB(ICMP,INNOE)=R(j,i)
  254.                         MTRAV1.IBIN(ICMP,INNOE)=1
  255.                      ENDDO
  256.                   ENDDO
  257.                ELSEIF (IOTENS.EQ.12) THEN
  258.                   DO ICOM1=1,NCOM1
  259.                      I=INVSYM(1,ICOM1,IDIM)
  260.                      J=INVSYM(2,ICOM1,IDIM)
  261.                      MTRAV1.BB(ICOM1,INNOE)=A(I,J)
  262.                      MTRAV1.IBIN(ICOM1,INNOE)=1
  263.                   ENDDO
  264.                ELSE
  265.                   write(ioimp,*) 'CHPO VAL ncom1=',ncom1,' ????'
  266.                   goto 9999
  267.                ENDIF
  268.             ELSE
  269.                IF (IKAS.EQ.1.OR.IKAS.EQ.2) THEN
  270.                   DO I=1,NCOMP
  271.                      BB(I,INNOE)=R(I,1)
  272.                      IBIN(I,INNOE)=1
  273.                   ENDDO
  274.                ELSEIF (IKAS.EQ.3) THEN
  275.                   DO ICOMP=1,NCOMP
  276.                      I=INVSYM(1,ICOMP,IDIM)
  277.                      J=INVSYM(2,ICOMP,IDIM)
  278.                      BB(ICOMP,INNOE)=R(I,J)
  279.                      IBIN(ICOMP,INNOE)=1
  280.                   ENDDO
  281.                ELSEIF (IKAS.EQ.4) THEN
  282.                   DO ICOMP=1,NCOMP
  283.                      I=INVGEN(1,ICOMP,IDIM)
  284.                      J=INVGEN(2,ICOMP,IDIM)
  285.                      BB(ICOMP,INNOE)=R(I,J)
  286.                      IBIN(ICOMP,INNOE)=1
  287.                   ENDDO
  288.                ELSE
  289.                   write(ioimp,*) 'ikas=',ikas,' ????'
  290.                   goto 9999
  291.                endif
  292.             ENDIF
  293. * Fin de la boucle sur les noeuds
  294.          ENDDO
  295. *     segprt,mtrav
  296.       ELSEIF (TYCHA.EQ.'MCHAML  ') THEN
  297.          N1=MCHEL1.ICHAML(/1)
  298.          DO I1=1,N1
  299.             MCHAML=MCHEL1.ICHAML(I1)
  300.             SEGACT MCHAML
  301.             N2=IELVAL(/1)
  302.             IF (N2.NE.NCOMP) THEN
  303.                write(ioimp,*) ' TENS1 1 MCHEL1,MCHAML,N2,NCOMP=',MCHEL1
  304.      $              ,MCHAML,N2,NCOMP
  305.                write(ioimp,'(10(1X,A))') 'NOMCHE=',(NOMCHE(ii),ii=1,N2)
  306.                write(ioimp,'(10(1X,A))') 'MLMOTS=',(MOTS(ii),ii=1,NCOMP)
  307. * Composante inexistante
  308.                CALL ERREUR(280)
  309.                RETURN
  310.             ENDIF
  311. * Les composantes du chaml ne sont pas forcément dans l'ordre de MLMOTS...
  312.             segini idxcom
  313.             DO ICOMP=1,NCOMP
  314.                call place(nomche(1),ncomp,i2,mots(icomp))
  315.                if (i2.le.0) then
  316.                   write(ioimp,*) ' TENS1 2 MCHEL1,MCHAML,NCOMP,I2='
  317.      $                 ,MCHEL1,MCHAML,NCOMP,I2
  318.                   write(ioimp,'(10(1X,A))') 'NOMCHE=',(NOMCHE(ii),ii=1
  319.      $                 ,NCOMP)
  320.                   write(ioimp,'(10(1X,A))') 'MLMOTS=',(MOTS(ii),ii=1
  321.      $                 ,NCOMP)
  322.                   goto 9999
  323.                endif
  324.                idxcom(ICOMP)=i2
  325.             ENDDO
  326.             N1EL=0
  327.             N1PTEL=0
  328.             N2EL=0
  329.             N2PTEL=0
  330.             DO ICOMP=1,NCOMP
  331.                i2=idxcom(icomp)
  332.                IF (TYPCHE(I2).NE.'REAL*8') THEN
  333.                   MOTERR(1:8)='MCHAML'
  334.                   MOTERR(9:16)=TYPCHE(I2)
  335. * 131 2               On n'attend pas un objet de type %m1:8 de sous-type %m9:16
  336.                   CALL ERREUR(131)
  337.                   RETURN
  338.                ENDIF
  339.                MELVAL=IELVAL(I2)
  340.                SEGACT MELVAL
  341.                N1EL=MAX(N1EL,VELCHE(/2))
  342.                N1PTEL=MAX(N1PTEL,VELCHE(/1))
  343.             ENDDO
  344.             IF (NCOM1.EQ.NCOMP) THEN
  345.                SEGINI,MCHAM1=MCHAML
  346.             ELSE
  347.                N2=NCOM1
  348.                SEGINI,MCHAM1
  349.                IF(NCOM1.EQ.1.AND.IOTENS.NE.12) THEN
  350.                   MCHAM1.NOMCHE(1)='SCAL'
  351.                   MCHAM1.TYPCHE(1)='REAL*8'
  352.                ELSEIF (IOTENS.EQ.11) THEN
  353.                   ICMP=0
  354.                   CCCOMP='SI'
  355.                   DO i=1,IDIM
  356.                      ICMP=ICMP+1
  357.                      WRITE(CCCOMP(3:3),FMT='(I1)') I
  358.                      WRITE(CCCOMP(4:4),FMT='(I1)') I
  359.                      MCHAM1.NOMCHE(ICMP)=CCCOMP
  360.                      MCHAM1.TYPCHE(ICMP)='REAL*8'
  361.                   ENDDO
  362.                   CCCOMP='CO'
  363.                   DO i=1,IDIM
  364.                      WRITE(CCCOMP(4:4),FMT='(I1)') I
  365.                      DO j=1,IDIM
  366.                         WRITE(CCCOMP(3:3),FMT='(I1)') J
  367.                         ICMP=ICMP+1
  368.                         MCHAM1.NOMCHE(ICMP)=CCCOMP
  369.                         MCHAM1.TYPCHE(ICMP)='REAL*8'
  370.                      ENDDO
  371.                   ENDDO
  372.                ELSEIF (IOTENS.EQ.12) THEN
  373.                   ICMP=0
  374.                   CCCOMP='G'
  375.                   DO i=1,IDIM
  376.                      WRITE(CCCOMP(2:2),FMT='(I1)') I
  377.                      DO j=1,i
  378.                         WRITE(CCCOMP(3:3),FMT='(I1)') J
  379.                         ICMP=ICMP+1
  380.                         MCHAM1.NOMCHE(ICMP)=CCCOMP
  381.                         MCHAM1.TYPCHE(ICMP)='REAL*8'
  382.                      ENDDO
  383.                   ENDDO
  384.                ELSE
  385.                   write(ioimp,*) 'CHAM COMP ncom1=',ncom1,' ????'
  386.                   goto 9999
  387.                ENDIF
  388.             ENDIF
  389.             NNIN=max(NCOM1,NCOMP)
  390.             SEGINI MTRCML
  391.             DO ICOMP=1,NCOMP
  392.                i2=idxcom(icomp)
  393.                MELVAL=IELVAL(I2)
  394.                J1PTEL=VELCHE(/1)
  395.                J1EL=VELCHE(/2)
  396.                DO I1EL=1,N1EL
  397.                   DO I1PTEL=1,N1PTEL
  398.                      CC(ICOMP,I1PTEL,I1EL)=VELCHE(MIN(I1PTEL,J1PTEL)
  399.      $                    ,MIN(I1EL,J1EL))
  400.                   ENDDO
  401.                ENDDO
  402.             ENDDO
  403. *
  404.             DO I1EL=1,N1EL
  405.                DO I1PTEL=1,N1PTEL
  406. * Remplissage des tableaux de travail
  407.                   IF (IKAS.EQ.1.OR.IKAS.EQ.2) THEN
  408.                      DO I=1,NCOMP
  409.                         A(I,1)=CC(I,I1PTEL,I1EL)
  410.                      ENDDO
  411.                   ELSEIF (IKAS.EQ.3) THEN
  412.                      DO J=1,IDIM
  413.                         DO I=1,IDIM
  414.                            A(I,J)=CC(IDXSYM(I,J,IDIM),I1PTEL,I1EL)
  415.                         ENDDO
  416.                      ENDDO
  417.                   ELSEIF (IKAS.EQ.4) THEN
  418.                      DO J=1,IDIM
  419.                         DO I=1,IDIM
  420.                            A(I,J)=CC(IDXGEN(I,J,IDIM),I1PTEL,I1EL)
  421.                         ENDDO
  422.                      ENDDO
  423.                   ELSEIF (IKAS.EQ.5) THEN
  424.                      ICMP=0
  425.                      DO i=1,IDIM
  426.                         ICMP=ICMP+1
  427.                         D(i)=CC(ICMP,I1PTEL,I1EL)
  428.                      ENDDO
  429.                      DO i=1,IDIM
  430.                         DO j=1,IDIM
  431.                            ICMP=ICMP+1
  432.                            R(j,i)=CC(ICMP,I1PTEL,I1EL)
  433.                         ENDDO
  434.                      ENDDO
  435.                   ELSE
  436.                      write(ioimp,*) 'ikas=',ikas,' ????'
  437.                      GOTO 9999
  438.                   endif
  439. *
  440. * Faire les opérations tensorielles
  441. *
  442.                   CALL TENS2(IOTENS,IKAS,A,D,R)
  443.                   IF (IERR.NE.0) RETURN
  444. *
  445.                   IF (NCOM1.NE.NCOMP) THEN
  446.                      IF(NCOM1.EQ.1) THEN
  447.                         CC(1,I1PTEL,I1EL)=R(1,1)
  448.                      ELSEIF (IOTENS.EQ.11) THEN
  449.                         ICMP=0
  450.                         DO i=1,IDIM
  451.                            ICMP=ICMP+1
  452.                            CC(ICMP,I1PTEL,I1EL)=D(i)
  453.                         ENDDO
  454.                         DO i=1,IDIM
  455.                            DO j=1,IDIM
  456.                               ICMP=ICMP+1
  457.                               CC(ICMP,I1PTEL,I1EL)=R(j,i)
  458.                            ENDDO
  459.                         ENDDO
  460.                      ELSEIF (IOTENS.EQ.12) THEN
  461.                         DO ICOM1=1,NCOM1
  462.                            I=INVSYM(1,ICOM1,IDIM)
  463.                            J=INVSYM(2,ICOM1,IDIM)
  464.                            CC(ICOM1,I1PTEL,I1EL)=A(I,J)
  465.                         ENDDO
  466.                      ELSE
  467.                         write(ioimp,*) 'CHAM VAL ncom1=',ncom1,' ????'
  468.                         goto 9999
  469.                      ENDIF
  470.  
  471.                   ELSE
  472.                      IF (IKAS.EQ.1.OR.IKAS.EQ.2) THEN
  473.                         DO I=1,NCOMP
  474.                            CC(I,I1PTEL,I1EL)=R(I,1)
  475.                         ENDDO
  476.                      ELSEIF (IKAS.EQ.3) THEN
  477.                         DO ICOMP=1,NCOMP
  478.                            I=INVSYM(1,ICOMP,IDIM)
  479.                            J=INVSYM(2,ICOMP,IDIM)
  480.                            CC(ICOMP,I1PTEL,I1EL)=R(I,J)
  481.                         ENDDO
  482.                      ELSEIF (IKAS.EQ.4) THEN
  483.                         DO ICOMP=1,NCOMP
  484.                            I=INVGEN(1,ICOMP,IDIM)
  485.                            J=INVGEN(2,ICOMP,IDIM)
  486.                            CC(ICOMP,I1PTEL,I1EL)=R(I,J)
  487.                         ENDDO
  488.                      ELSE
  489.                         write(ioimp,*) 'ikas=',ikas,' ????'
  490.                         goto 9999
  491.                      endif
  492.                   ENDIF
  493. * Fin de la boucle sur les noeuds et éléments
  494.                ENDDO
  495. * Fin de la boucle sur les éléments
  496.             ENDDO
  497.             DO ICOM1=1,NCOM1
  498.                SEGINI MELVA1
  499.                DO I1EL=1,N1EL
  500.                   DO I1PTEL=1,N1PTEL
  501.                      MELVA1.VELCHE(I1PTEL,I1EL)=CC(ICOM1,I1PTEL,I1EL)
  502.                   ENDDO
  503.                ENDDO
  504.                IF (NCOMP.EQ.NCOM1) THEN
  505.                   I2=IDXCOM(ICOM1)
  506.                   MCHAM1.IELVAL(I2)=MELVA1
  507.                ELSE
  508.                   MCHAM1.IELVAL(ICOM1)=MELVA1
  509.                ENDIF
  510.             ENDDO
  511.             segsup idxcom
  512.             SEGSUP MTRCML
  513.             MCHEL1.ICHAML(I1)=MCHAM1
  514. *     Fin de la boucle sur les sous-zones
  515.          ENDDO
  516.       ELSE
  517.          GOTO 9998
  518.       ENDIF
  519. *
  520. * Transformation des objets de travail en champs
  521. *
  522.       IF (TYCHA.EQ.'CHPOINT ') THEN
  523.          IF (NCOM1.NE.NCOMP) THEN
  524. *            segprt,MTRAV1
  525. * Le résultat est dans MTRAV1
  526.             CALL CRECHP(MTRAV1,MCHPO1)
  527.             SEGSUP MTRAV1
  528. * Type diffus par defaut
  529.             MCHPO1.JATTRI(1)=1
  530.          ELSE
  531.             IF (IOTENS.GE.1.AND.IOTENS.LE.4) INCO(1)='SCAL'
  532.             CALL CRECHP(MTRAV,MCHPO1)
  533.          ENDIF
  534.          SEGSUP MTRAV
  535.          ICHA1=MCHPO1
  536.       ELSEIF (TYCHA.EQ.'MCHAML  ') THEN
  537.          ICHA1=MCHEL1
  538.       ELSE
  539.          GOTO 9998
  540.       ENDIF
  541. *
  542. * Normal termination
  543. *
  544.       RETURN
  545. *
  546. * Format handling
  547. *
  548. *
  549. * Error handling
  550. *
  551.  9997 CONTINUE
  552. * 980 2
  553. * L'objet %m1:8 n'a pas le bon nombre de composantes
  554.       MOTERR(1:8)='LISTMOTS'
  555.       CALL ERREUR(980)
  556.       RETURN
  557.  9998 CONTINUE
  558. * On ne veut pas d'objet de type %m1:8
  559.       MOTERR(1:8)=TYCHA
  560.       CALL ERREUR(39)
  561.       RETURN
  562.  9999 CONTINUE
  563.       MOTERR(1:8)='TENS1'
  564.       call erreur(1039)
  565.       return
  566. *
  567.  
  568. * End of subroutine TENS1
  569. *
  570.       END
  571.  
  572.  

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