Esope source files

   1 : C DEZOMA    SOURCE    CHAT      05/01/12    22:47:58     5004           
   2 : CCC
   3 : C **********************************************************************
   4 : CCC
   5 :       SUBROUTINE DETERZONAMAC(SIGTRI,NDIMS,VARINT,IPLCON,IPLCAP,IPLAPEX,
   6 :      .                        nescri,ues)
   7 :       IMPLICIT INTEGER(I-N)
   8 :       integer ndims,iplcon,iplcap,iplapex,nescri,ues
   9 :       real*8    sigtri(ndims),varint(2),siginvari(3),Eauxp,Eauxq,
  10 :      .          Yicon,Yicap,p,q,t,xco,xca,psepara,aux3,qcor,Nr_qfunc,
  11 :      .          vecp,vecq,pcap,prodesc,wwfunc,etaconfunc,pcapfunc
  12 :       real*8    exm,qaa,pcc,eww,xk1,xk2,etb,exv,xep,paa,cco,
  13 :      .          exl,xnn,aaa,bbb,pc0,exr,cca,phi,alp,pcc2,paa2,qaa2,
  14 :      .          exm2,eww2,cpr,cpm,cfr,you,xnu
  15 :       common /elasdata/ you,xnu
  16 :       common /MRScone/ exm,qaa,pcc,eww,xk1,xk2,etb,exv,xep,paa,cco,
  17 :      .                 exl,xnn,aaa,bbb
  18 :       common /MRScapp/ pc0,exr,cca,phi,alp,pcc2,paa2,qaa2,exm2,eww2,
  19 :      .                 cpr,cpm,cfr
  20 :       iplcon =0
  21 :       iplcap =0
  22 :       iplapex=0
  23 :       do i=1,3
  24 :           siginvari(i)=0.D0
  25 :         enddo
  25 :       call InvariantesPQT(sigtri,ndims,siginvari)
  26 :       p=siginvari(1)
  27 :       q=siginvari(2)
  28 :       t=siginvari(3)
  29 :       xco=varint(1)
  30 :       xca=varint(2)
  31 :       Eauxp=you/(1.D0-2.d0*xnu)/9.D0
  32 :       Eauxq=you/(1.d0+xnu)/2.D0    
  32 :       call yieldcoMAC(siginvari,xco,Yicon)
  32 :       call yieldcaMAC(siginvari,xca,xco,Yicap)
  33 :       pcap=pcapfunc(xca)
  34 :       psepara=alp*pcap
  35 :       aux3=etaconfunc(xco)*(psepara-pcc)/wwfunc(t,eww)
  36 :       qcor=NR_qfunc(aux3,qaa,exm,aux3,1.D-10)
  37 :       if(nescri.eq.1) then
  38 :          write(ues,999) '   Invari : ',p,q,t
  39 :          write(ues,999) '   Var int: ',xco,xca
  40 :          write(ues,999) '    Yicon : ',yicon
  41 :          write(ues,999) '    Yicap : ',yicap
  42 :          write(ues,999) '   Sep.p_q: ',psepara,qcor
  43 :  999     format(a12,3(E15.9,1x))
  44 :       endif
  45 : c zona del cone
  46 :       If (p.le.psepara) then
  47 :          If (Yicon.le.0.D0) return
  48 :          iplcon=1
  49 : c mirar si es apex
  50 :          vecp=-xnn*etaconfunc(xco)*(pcc-alp*pcap)/(pcc+alp*pcap)
  51 :          vecq=wwfunc(t,eww)*Eauxq/Eauxp
  52 :          prodesc=((p-pcc)*(-vecq)+q*(vecp))
  53 :          if (nescri.eq.1) then
  54 :             write(ues,999)' CONE GrApex: ', vecp,vecq,xnn            
  55 :             write(ues,999)'      PtApex: ', pcc,0.D0
  56 :             write(ues,999)'      Prodes: ', prodesc
  57 :          endif
  58 :          if (prodesc.gt.0.D0) then
  59 :             iplapex=1
  60 :             return
  61 :          endif
  62 : c zona del cap
  63 :       else
  64 :          If (Yicap.le.0.D0) return
  65 :          iplcap=1
  66 :       endif
  67 :       return
  68 :       end   
  69 :  
  70 :  
  71 :