Download jacmrs.eso

Back to the list

   1 : C JACMRS    SOURCE    CHAT      05/01/13    00:48:11     5004           
   2 : CCC
   3 : C **********************************************************************
   4 : CCC
   5 :       SUBROUTINE JAC_MRSMAC (KMAT,NDIMK,SIG,NDIMS,VINTCON,VINTCAP,LCON,
   6 :      .                  lcap,xmat,nescri,ues,nnumer,deltax,kerre)
   7 :       IMPLICIT INTEGER(I-N)
   8 :       
   9 :       integer   ndims,kerre,nescri,nnumer,ues,ndimk,
  10 :      .          j,i,ndimx,kmod
  11 :       real*8    sig(ndims),vintcon,vintcap,Kmat(*),xmat(*),deltax,x(7),
  12 :      .          lcon,lcap,lam
  13 : 
  14 :       kerre=0
  15 :       do i=1,7
  16 :           x(i)=0.D0
  17 :         enddo
  17 :       call CaracmateMAC(xmat)
  18 : 
  19 :       if ((lcon.le.0.D0).and.(lcap.le.0.D0)) then
  20 :          do i=1,ndims
  21 :            do j=1,ndims
  22 :              Kmat(ndimk*(i-1)+j)=0.D0
  23 :            enddo
  24 :            Kmat(ndimk*(i-1)+i)=1.D0
  25 :          enddo
  26 :         return
  27 :       else if ((lcon.gt.0.D0).and.(lcap.gt.0.D0)) then
  28 :          write(*,*)' Modelo MRSLMAC: no tiene corner'
  29 :          return
  30 :       else if ((lcon.gt.0.D0).and.(lcap.lt.0.D0)) then
  31 :         kmod=21
  32 :         lam=lcon
  33 :       else
  34 :         kmod=22
  35 :         lam=lcap
  36 :       endif
  37 :       do i=1,ndims
  38 :           x(i)=sig(i)
  39 :         enddo
  40 :       ndimx=ndims+2
  41 :       x(ndims+1)=vintcon
  42 :       x(ndims+2)=vintcap
  42 :       call jac21(Kmat,ndimk,x,ndimx,lam,ndims,
  43 :      .           kmod,nescri,ues,nnumer,deltax,kerre)
  44 :       return
  45 :       end
  46 :  
  47 :  
  48 :  

© Cast3M 2003 - All rights reserved.
Disclaimer