Download trjral.eso

Back to the list

   1 : C TRJRAL    SOURCE    CHAT      05/01/13    03:50:51     5004           
   2 :       SUBROUTINE TRJRAL(IPARPO,IZLAR,MELEME,IZSH)
   3 : C                                                                               
   4 : C                                                                               
   5 : C                                                                               
   6 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC           
   7 : C                                                                               
   8 : C     PASSE DES COORDONNEES DE REFERENCES AUX COORDONNEES REELLES               
   9 : C                                                                               
  10 : C     IPARPO SEGMENT DES COORDONNEES DE REFERENCES                               
  11 : C     IZLAR SEGMENT DES COORDONNEES REELLES                                     
  12 : C     MELEME MAILLAGE
  13 : C     IZSH SEGMENT DE TRAVAIL POUR LE CALCUL DES FONCTIONS DE FORME
  14 : C
  15 : C     SHP FONCTION DE FORME
  16 : C     XYZL COORDONNEES REELLES DES NOEUDS DE L ELEMENT
  17 : C     XR COORDONNEE DE LA PARTICULE DANS L ELEMENT DE REFERENCE                 
  18 : C                                                                               
  19 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC          
  20 : C                                                                               
  21 : C                                                                               
  22 :       IMPLICIT INTEGER(I-N)
  23 :       IMPLICIT REAL*8 (A-H,O-Z)                                                 
  24 : C
  25 : C                                                                               
  26 : -INC CCOPTIO
  27 : -INC SMCOORD
  28 : -INC SMELEME
  29 : C                                                                               
  30 :       SEGMENT  IPARPO
  31 :         INTEGER NAPAR(NPOS),NUMP(NPOS)
  32 :         REAL*8 CREF(NDIM,NPOS),TPAR(NPOS)
  33 :       ENDSEGMENT
  34 :       POINTEUR IZLAR.IPARPO
  35 : C                                                                               
  36 :       SEGMENT IZSH
  37 :             REAL*8 SHP(6,MNO9),SHY(12,MNO9),XYZL(3,MNO9)
  38 :       ENDSEGMENT
  39 : C                                                                               
  40 : C                                                                               
  41 : C                                                                               
  42 : C                                                                               
  43 : C                                                                               
  44 : C                                                                               
  45 :       DIMENSION XR(3)
  46 : C                                                                               
  47 : C                                                                               
  48 : C                                                                               
  49 : C     WRITE(6,*) ' TRJRAL '
  50 :       NDIM=CREF(/1)                                                             
  51 :       NPOS=NAPAR(/1)                                                            
  52 :       SEGINI IZLAR
  53 : C     write(6,*)' SEGINI IZLAR',IZLAR
  54 :       DO 1 IPOS=1,NPOS                                                          
  55 :       IEL=NAPAR(IPOS)                                                           
  56 : C     write(6,*) iel,nump(ipos),cref(1,ipos),cref(2,ipos),tpar(ipos)
  57 :       IZLAR.NAPAR(IPOS)=IEL
  58 :       IZLAR.TPAR(IPOS)=TPAR(IPOS)
  59 :       IZLAR.NUMP(IPOS)=NUMP(IPOS)
  59 :       CALL MELNEL(IEL,MELEME,IPT1,NEL0,1)
  60 :       NOEL=IPT1.NUM(/1)
  61 :       IELL=IEL-NEL0
  61 :       CALL DOXE(XCOOR,IDIM,NOEL,IPT1.NUM,IELL,XYZL)
  62 :       ITY=IPT1.ITYPEL
  63 :       XR(3)=0.D0
  64 :       DO 4 ID1=1,NDIM                                                          
  65 :       XR(ID1)=CREF(ID1,IPOS)                                                  
  66 : C     WRITE(6,*)' CREFIJ ',ID1,IPOS,CREF(ID1,IPOS)                            
  67 :    4  CONTINUE                                                                  
  67 :       CALL SHAPE(XR(1),XR(2),XR(3),ITY,SHP,IRET)
  68 :       DO 5 ID1=1,NDIM                                                          
  69 :       IZLAR.CREF(ID1,IPOS)=0.D0
  70 :       DO 6 K=1,NOEL                                                             
  71 :       IZLAR.CREF(ID1,IPOS)=IZLAR.CREF(ID1,IPOS)+SHP(1,K)*XYZL(ID1,K)
  72 :    6  CONTINUE                                                                  
  73 :    5  CONTINUE                                                                  
  74 : C     WRITE(6,*)IPOS,' CLEFIJ ',(IZLAR.CREF(ID1,IPOS),ID1=1,NDIM)
  75 :    1  CONTINUE                                                                  
  76 :       RETURN                                                                    
  77 :       END                                                                       
  78 :  
  79 :  

© Cast3M 2003 - All rights reserved.
Disclaimer