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   24/09/18    21:15:05     12011          
  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. *         write(ioimp,*) 'ITRY=',ITRY
  61. * Lecture des noms de composantes
  62.          CALL LIROBJ('LISTMOTS',MLMOTS,0,ILMOTS)
  63.          IF (ILMOTS.EQ.0) THEN
  64.             CALL LIRCHA(MOCOMP,ITRY-1,IRET)
  65.             IF (IERR.NE.0) RETURN
  66.             IF(IRET.NE.0) THEN
  67.                JGN=LOCOMP
  68.                JGM=1
  69.                SEGINI MLMOTS
  70.                MOTS(1)=MOCOMP
  71.                GOTO 1001
  72.             ELSE
  73.                IF (ITRY.EQ.1) THEN
  74.                   IF (TYCHA.EQ.'CHPOINT') THEN
  75.                      CALL EXTR11(ICHA,MLMOTS)
  76.                      IF(IERR.NE.0) RETURN
  77.                   ELSEIF (TYCHA.EQ.'MCHAML') THEN
  78.                      CALL EXTR17(ICHA,MLMOTS)
  79.                      IF(IERR.NE.0) RETURN
  80.                   ELSE
  81. * On ne veut pas d'objet de type %m1:8
  82.                      MOTERR(1:8)=TYCHA
  83.                      CALL ERREUR(39)
  84.                      RETURN
  85.                   ENDIF
  86.                   CALL GUESCO(TYCHA,MLMOTS,MLMOT1)
  87.                   IF(IERR.NE.0) RETURN
  88.                   SEGSUP MLMOTS
  89.                   MLMOTS=MLMOT1
  90.                   IF (MLMOTS.EQ.0) GOTO 1000
  91. *                  write(ioimp,*) 'On a devine les composantes :'
  92. *                  segprt,mlmots
  93.                   GOTO 1001
  94.                ENDIF
  95.             ENDIF
  96.          ELSE
  97.             GOTO 1001
  98.          ENDIF
  99.  1000 CONTINUE
  100.  1001 CONTINUE
  101. * Pour le message d'erreur 803 éventuellement appelé dans tens1
  102.       MOTERR(1:8)=MOTENS(IOTENS)
  103.       CALL TENS1(ICHA,TYCHA,MLMOTS,IOTENS,ICHA1)
  104.       IF(IERR.NE.0) RETURN
  105. *
  106.       IF (ILMOTS.EQ.0) SEGSUP MLMOTS
  107. *
  108.       CALL ACTOBJ(TYCHA,ICHA1,1)
  109.       CALL ECROBJ(TYCHA,ICHA1)
  110. *
  111. * Normal termination
  112. *
  113.       RETURN
  114. *
  115. * Format handling
  116. *
  117. *
  118. * Error handling
  119. *
  120. *
  121. * End of subroutine PRTENS
  122. *
  123.       END
  124.  
  125.  

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