Download eigglo.eso

Back to the list

   1 : C EIGGLO    SOURCE    CHAT      05/01/12    23:28:46     5004           
   2 : c---------------------------------------------------------------------
   3 : c
   4 :       SUBROUTINE EIGGLO (NDIME, NSTR1, NTENS, 
   5 :      .                   betam, prosi, sgten, soxyz)
   6 : c
   7 : c=====================================================================
   8 : c                                                                    =
   9 : c   This subroutine performs rotation of tension stress matrix,      =
  10 : c   from eigen to global system (optimized).                         =
  11 : c                                                                    =
  12 : c    Input variable:                                                 =
  13 : c                                                                    =
  14 : c       ntens                  no. of tension componentes            =
  15 : c       betam                  rotation matrix                       =
  16 : c       sgten (i)  (i=1,3)     principal tension stress tensor       =
  17 : c                                                                    =
  18 : c    Output variable:                                                =
  19 : c                                                                    =
  20 : c       sgten                  tension stress tensor contribution    =
  21 : c                                                                    =
  22 : c   Author: Rui Faria                           Version: 96.09.18    =
  23 : c                                               --------             =
  24 : c=====================================================================
  25 :       IMPLICIT INTEGER(I-N)
  26 :       integer*4  ndime, nstr1, ntens
  27 :       real*8     sgten (nstr1), 
  28 :      .           betam (ndime,ndime), prosi (ndime,ndime),
  29 :      .           soxyz (ndime,ndime)
  30 : c
  31 :       integer*4  istrs, jstrs
  32 :       real*8     provi
  33 : c
  34 :       if (ntens .gt. 0)  then
  35 :           do 10 istrs = 1, ndime
  36 :              do 20 jstrs = 1, ndime
  37 :                 prosi (istrs,jstrs) = betam (jstrs,istrs) *
  38 :      .                                sgten (jstrs)
  39 :    20        continue
  40 :    10     continue
  41 : c
  41 :           call proma1 (soxyz, prosi, betam, ndime, ndime, ndime)
  42 : c
  43 :           if (nstr1 .eq. 6)  then
  44 :               sgten (1) = soxyz (1,1)
  45 :               sgten (2) = soxyz (2,2)
  46 :               sgten (3) = soxyz (3,3)
  47 :               sgten (4) = soxyz (1,2)
  48 :               sgten (5) = soxyz (1,3)
  49 :               sgten (6) = soxyz (2,3)
  50 :           else
  51 :               sgten (1) = soxyz (1,1)
  52 :               sgten (2) = soxyz (2,2)
  53 :               provi     = sgten (3)
  54 :               sgten (3) = provi
  55 :               sgten (4) = soxyz (1,2)
  56 :           end if
  57 :       else
  57 :           call zeror  (sgten, nstr1)
  58 :       end if
  59 : c
  60 :       return
  61 :       end
  62 :  
  63 :  

© Cast3M 2003 - All rights reserved.
Disclaimer