Télécharger la plaquette Cast3M


fr en

Télécharger prtens.eso

Retour à la liste

Numérotation des lignes : 

prtens

  1. C PRTENS    SOURCE    GOUNAND   25/09/11    21:15:02     12361          
  2.       SUBROUTINE PRTENS()
  3.       IMPLICIT REAL*8 (A-H,O-Z)
  4.       IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM         : PRTENS
  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 SMCHPOI
  34. -INC SMLMOTS
  35. *
  36.       PARAMETER (NOTENS=11)
  37.       CHARACTER*8 MOTENS(NOTENS),TYCHA
  38.       CHARACTER*(LOCOMP) MOCOMP
  39. C
  40.       DATA MOTENS/'NORM2','NORMINF','DET','TRACE','INVERSE','IDEN','LOG'
  41.      $     ,'EXP','INVS','ABSOLU','PRINCIPA'/
  42. *
  43. * Executable statements
  44. *
  45. * Mot-clé
  46.       CALL LIRMOT(MOTENS,-NOTENS,IOTENS,1)
  47.       IF(IERR.NE.0) RETURN
  48. *      write(ioimp,*) 'MOTENS,IOTENS=',MOTENS(IOTENS),IOTENS
  49. * Lecture du champ
  50.       TYCHA='CHPOINT '
  51.       CALL LIROBJ(TYCHA,ICHA,0,IRET)
  52.       IF (IRET.EQ.0) THEN
  53.          TYCHA='MCHAML  '
  54.          CALL LIROBJ(TYCHA,ICHA,1,IRET)
  55.          IF(IERR.NE.0) RETURN
  56.       ENDIF
  57.       CALL ACTOBJ(TYCHA,ICHA,1)
  58. *
  59.       DO 1000 ITRY=1,2
  60. * Lecture des noms de composantes
  61.          CALL LIROBJ('LISTMOTS',MLMOTS,ITRY-1,ILMOTS)
  62.          IF (ILMOTS.EQ.0) THEN
  63.             IF (TYCHA.EQ.'CHPOINT') THEN
  64.                CALL EXTR11(ICHA,MLMOTS)
  65.                IF(IERR.NE.0) RETURN
  66.             ELSEIF (TYCHA.EQ.'MCHAML') THEN
  67.                CALL EXTR17(ICHA,MLMOTS)
  68.                IF(IERR.NE.0) RETURN
  69.             ELSE
  70. * On ne veut pas d'objet de type %m1:8
  71.                MOTERR(1:8)=TYCHA
  72.                CALL ERREUR(39)
  73.                RETURN
  74.             ENDIF
  75.             CALL GUESCO(TYCHA,MLMOTS,MLMOT1)
  76.             IF(IERR.NE.0) RETURN
  77.             SEGSUP MLMOTS
  78.             MLMOTS=MLMOT1
  79.             IF (MLMOTS.EQ.0) THEN
  80.                GOTO 1000
  81.             ELSE
  82.                if (IIMPI.NE.0) THEN
  83.                   write(ioimp,*) 'On a devine les composantes :'
  84.                   write(ioimp,'(10(1X,A))') 'MLMOTS=',(MOTS(i),i=1
  85.      $                 ,MOTS(/2))
  86.                endif
  87.                GOTO 1001
  88.             ENDIF
  89.          ENDIF
  90.  1000 CONTINUE
  91.  1001 CONTINUE
  92. * Pour le message d'erreur 803 éventuellement appelé dans tens1
  93.       MOTERR(1:8)=MOTENS(IOTENS)
  94.       CALL TENS1(ICHA,TYCHA,MLMOTS,IOTENS,ICHA1)
  95.       IF(IERR.NE.0) RETURN
  96. *
  97.       IF (ILMOTS.EQ.0) SEGSUP MLMOTS
  98. *
  99.       CALL ACTOBJ(TYCHA,ICHA1,1)
  100.       CALL ECROBJ(TYCHA,ICHA1)
  101. *
  102. * Normal termination
  103. *
  104.       RETURN
  105. *
  106. * Format handling
  107. *
  108. *
  109. * Error handling
  110. *
  111. *
  112. * End of subroutine PRTENS
  113. *
  114.       END
  115.  
  116.  

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