Esope source files

   1 : C CALP      SOURCE    PV        09/03/12    21:16:14     6325           
   2 :       SUBROUTINE CALP
   3 : *
   4 : *
   5 : *     AUTEUR : J.BRUN (AVRIL 90)
   6 : *
   7 : *-----------------------------------------------------------
   8 : *     BUT :
   9 : *        ENTETE DE L'OPERATEUR SERVANT A CALCULER LES CONTRAINTES
  10 : *        OU LES DEFORMATIONS EN PEAU OU AU PLAN MOYEN
  11 : *
  12 : *
  13 : *----------------------------------------------------------
  14 :       IMPLICIT INTEGER(I-N)
  15 :       IMPLICIT REAL*8 (A-H,O-Z)
  16 : *
  17 : -INC SMCHAML
  18 : -INC CCOPTIO
  19 : *
  20 :       CHARACTER*4 LMOT(3),LOC
  21 :       DATA        LMOT/'INFE','MOYE','SUPE'/
  22 :       NBMOT=3
  23 : *----------------------------------------------------------
  24 : *
  25 : *        LECTURE DES PARAMETRES EN ENTREE
  26 : *
  27 : *----------------------------------------------------------
  28 : *
  29 : *        LECTURE DE 2 CHAMELEMS QUELCONQUES
  30 : *
  30 :       CALL LIROBJ('MCHAML',IPTS1,1,IOK)
  31 :       IF (IOK.EQ.0) RETURN
  31 :       CALL LIROBJ('MCHAML',IPTS2,1,IOK)
  32 :       IF (IOK.EQ.0) RETURN
  33 : *
  34 : *        DETECTION DE LA PRESENCE D'UN MCHAML  SCALAIRE  (T)
  35 : *               pour option  T  --->  TINF T TSUP  
  36 :       ITEMP=0
  37 :       MCHELM=IPTS1
  38 :       SEGACT MCHELM
  39 :       IF (TITCHE(1:12).EQ.'SCALAIRE    ') THEN
  40 :         ITEMP=IPTS1
  41 :             SEGDES MCHELM
  42 :         GOTO 1000
  43 :       ENDIF
  44 :       SEGDES MCHELM
  45 :       MCHELM=IPTS2
  46 :       SEGACT MCHELM
  47 :       IF (TITCHE(1:12).EQ.'SCALAIRE    ') THEN
  48 :         ITEMP=IPTS2
  49 :             SEGDES MCHELM       
  50 :         GOTO 1000
  51 :       ENDIF
  52 :       SEGDES MCHELM      
  53 :                
  54 : *
  55 : *        DETECTION DE LA PRESENCE D'UN MCHAML DE DEFORMATION
  56 : *
  57 :       IDEFO=0
  58 :       MCHELM=IPTS1
  59 :       SEGACT MCHELM
  60 :       IF (TITCHE(1:12).EQ.'DEFORMATIONS') THEN
  61 :         IDEFO=1
  62 :       ENDIF
  63 :       SEGDES MCHELM
  64 :       MCHELM=IPTS2
  65 :       SEGACT MCHELM
  66 :       IF (TITCHE(1:12).EQ.'DEFORMATIONS') THEN
  67 :         IDEFO=1
  68 :       ENDIF
  69 :       SEGDES MCHELM
  70 :       
  71 : *
  72 :       IF (IDEFO.EQ.1) THEN
  72 :         CALL RNGCHA(IPTS1,IPTS2,'DEFORMATIONS','CARACTERISTIQUES',
  73 :      1              IPTR1,IPTR2)
  74 :       ELSE
  74 :         CALL RNGCHA(IPTS1,IPTS2,'CONTRAINTES','CARACTERISTIQUES',
  75 :      1              IPTR1,IPTR2)
  76 :       ENDIF
  77 :       IF(IERR.NE.0)GOTO 1000
  78 : *
  79 : *    ... CHAMELEM tensoriel ...
  80 : *
  81 :       IF(IPTR1.EQ.0) THEN
  82 :          MOTERR(1:16)='CONTRAINTES     '
  82 :          CALL ERREUR(291)
  83 :          RETURN
  84 :       ENDIF
  85 : *
  86 : *    ... CHAMELEM DE CARACTERISTIQUES ...
  87 : *
  88 :       IF(IPTR2.EQ.0) THEN
  89 :          MOTERR(1:16)='CARACTERISTIQUES'
  89 :          CALL ERREUR(291)
  90 :          RETURN
  91 :       ENDIF
  92 : *
  93 : *     ... MODELE ...
  94 : *
  94 :       CALL LIROBJ('MMODEL',IPTR3,1,IOK)
  95 :       IF (IERR.NE.0) GOTO 1000
  96 : *
  97 : *    ... PLAN DE SORTIE DES RESULTATS ...
  98 : *
  99 :       LOC='MOYE'
  99 :       CALL LIRMOT(LMOT,NBMOT,ILOC,0)
 100 :       IF (ILOC.NE.0) LOC=LMOT(ILOC)
 101 : *
 102 : *    ... Le calcul lui-même ...
 103 : *
 104 :       IF (IDEFO.EQ.1) THEN
 104 :           CALL CALP2(IPTR1,IPTR2,IPTR3,LOC,IPTR)
 105 :       ELSE
 105 :           CALL CALP1(IPTR1,IPTR2,IPTR3,LOC,IPTR)
 106 :       ENDIF
 107 : *
 108 : *    ... Sortie du résultat ...
 109 : *
 109 :       IF(IERR.EQ.0) CALL ECROBJ('MCHAML',IPTR)
 110 :       RETURN 
 111 : 1000  CONTINUE
 112 : 
 113 : *   projection d un champ de temperature calcule sur un massif
 114 : *       sur des coques  en TINF     T   et TSUP 
 115 : *
 116 : *     Lecture du modele de coque.
 117 : *
 117 :       CALL LIROBJ('MMODEL',IPMODE,1,IRET)
 118 :       IF (IRET.EQ.0.OR.IERR.NE.0) THEN
 119 :         RETURN
 120 :       ENDIF
 121 : C  on verifie que c est bien un modele de coques 
 122 : 
 123 :       
 124 : C   identification  du champ original de temperature et des
 125 : C                     caracteristiques      
 126 :       IPCHT=itemp
 127 : C        
 128 :       if(ipcht.eq.ipts1) then
 129 :       ipche= ipts2
 130 :       else
 131 :       ipche=ipts1 
 132 :       endif
 133 :       
 133 :       call prot(ipmode,ipcht,ipche,iptr) 
 133 :       IF(IERR.EQ.0) CALL ECROBJ('MCHAML',IPTR)      
 134 : *      
 135 :       return 
 136 :       END
 137 :  
 138 :  
 139 :  
 140 :  
 141 :  
 142 :