C
C-------------------------------------------------------------COLOC_EXTRA---
C
C SUBRUTINA COLOC_EXTRA
C
C MONTAJE DE UNA ECUACION EXTRA DE COLOCACION
C EN EL INTERIOR DE UN ELEMENTO
C
SUBROUTINE COLOC_EXTRA(PRB,SOL,MAT,CNT,ELT,NOD,ZCTO,
@ SAij,SFi,CEQ,COD)
C
IMPLICIT NONE
INCLUDE '_param.for'
INCLUDE '_struct.for'
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VARIABLES EXTERNAS
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C PRB : Variables globales del problema
RECORD /S_problema/ PRB
C SOL : Solidos del problema
RECORD /S_solido/ SOL(N_MAX_SOL)
C MAT : Materiales del problema
RECORD /S_material/ MAT(N_MAX_SOL)
C CNT : Contornos del problema
RECORD /S_contorno/ CNT(N_MAX_CNT)
C ELT : Elementos del problema
RECORD /S_elemento/ ELT(N_MAX_ELT)
C NOD : Nodos del problema
RECORD /S_nodo/ NOD(N_MAX_NOD)
C ZCTO : Zona de contacto
RECORD /S_zncto/ ZCTO
C S_AIJ(,) : Matriz del sistema.
REAL*8 SAij(N_MAX_INC,N_MAX_INC)
C S_Fi() : Termino independiente.
REAL*8 SFi(N_MAX_INC)
C CEQ : Contador de ecuaciones
INTEGER CEQ
C COD = 1 - Colocación extra en el comienzo de la zona de contacto
C 2 - Colocación extra en el final de la zona de contacto
INTEGER COD
C
C <-20/03/2002
C CPTij(,) : Ecuaciones en globales
REAL*8 CPTij(2,N_MAX_INC+1)
C CPTnt(,) : Ecuaciones en locales
REAL*8 CPTnt(2,N_MAX_INC+1)
C BIEij(,) : Ecuaciones en globales
REAL*8 BIEij(2,N_MAX_INC+1)
C BIEnt(,) : Ecuaciones en locales
REAL*8 BIEnt(2,N_MAX_INC+1)
C 20/03/2002->
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C VARIABLES INTERNAS
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C Contadores
INTEGER m,n,q,r
INTEGER CSOLA,CCNT,CCNTA,CELT,CELTA,NODA,CELTP
INTEGER CSOLB,CCNTB,CELTB
INTEGER N1,N2,Ea
C C1,C2 : Variables de interpolacón
REAL*8 c1,c2,posA
REAL*8 posB
C PCA,PCB : Puntos de colocacion adicional
RECORD /S_coloc/ PCA
RECORD /S_coloc/ PCB
C Ta,Na : Vector Tangente y Normal al elemento
REAL*8 Ta(MAX_DIM),Na(MAX_DIM)
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VALORES INICIALES
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C CONTORNOS DE CONTACTO Y SOLIDOS DE CONTACTO
C
ccntA=ZCTO.CNT(1)
ccntB=ZCTO.CNT(2)
csolA=CNT(ccntA).SOL
csolB=CNT(ccntB).SOL
C
C ELEMENTOS DONDE SE COLOCA LA ECUACIÓN,
C NODO "CONFLICTIVO" Y
C COORDENADA LOCAL DEL PUNTO DE COLOCACION
C
SELECT CASE(COD)
C
CASE(1)
C
C Punto de colocación al comienzo de la zona de contacto
C
celtA=CNT(ccntA).ELT(1)
celtB=CNT(ccntB).ELT(CNT(ccntB).NELT)
nodA =ELT(celtA).NI(1)
posA =-1.d0/3.d0
posB = 1.d0/3.d0
C
CASE(2)
C
C Punto de colocación al final de la zona de contacto
C
celtB=CNT(ccntB).ELT(1)
celtA=CNT(ccntA).ELT(CNT(ccntA).NELT)
nodA =ELT(celtA).NI(2)
posA = 1.d0/3.d0
posB =-1.d0/3.d0
C
CASE DEFAULT
WRITE(F_W,01) 1
WRITE (*,01) 1
STOP
END SELECT
C
C PUNTOS DE COLOCACION ADICIONALES
C
PCA.LOC=posA
PCA.TIP=2
PCA.ELT=ELT(celtA).NUM
PCA.CMP=1
C
PCB.LOC=posB
PCB.TIP=2
PCB.ELT=ELT(celtB).NUM
PCB.CMP=1
C
n1=ELT(celtA).NI(1)
n2=ELT(celtA).NI(2)
c2=(posA+1.d0)/2.d0
c1=1.d0-c2
DO m=1,2
PCA.XYZ(m)=c1*NOD(n1).XYZ(m)+c2*NOD(n2).XYZ(m)
END DO
C
n1=ELT(celtB).NI(1)
n2=ELT(celtB).NI(2)
c2=(posB+1.d0)/2.d0
c1=1.d0-c2
DO m=1,2
PCB.XYZ(m)=c1*NOD(n1).XYZ(m)+c2*NOD(n2).XYZ(m)
END DO
C
C Inicializacion de las matrices de constantes de integracion
C
DO m=1,SOL(csolA).NCNT
ccnt=SOL(csolA).CNT(m)
DO n=1,CNT(ccnt).NELT
celt=CNT(ccnt).ELT(n)
celtp=ELT(celt).TIP
DO q=1,PRB.TP.DIM
DO r=1 , PRB.ELTP(celtp).NVE
PCA.EIJ(celt).Eij(q,r)=0.d0
END DO
END DO
END DO
END DO
C
PCA.Cij(1,1)=0.5d0
PCA.Cij(1,2)=0.d0
PCA.Cij(2,1)=0.d0
PCA.Cij(2,2)=0.5d0
C
DO m=1,SOL(csolB).NCNT
ccnt=SOL(csolB).CNT(m)
DO n=1,CNT(ccnt).NELT
celt=CNT(ccnt).ELT(n)
celtp=ELT(celt).TIP
DO q=1,PRB.TP.DIM
DO r=1 , PRB.ELTP(celtp).NVE
PCB.EIJ(celt).Eij(q,r)=0.d0
END DO
END DO
END DO
END DO
C
PCB.Cij(1,1)=0.5d0
PCB.Cij(1,2)=0.d0
PCB.Cij(2,1)=0.d0
PCB.Cij(2,2)=0.5d0
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C CALCULO DE LA ECUACION DE COLOCACION
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C ECUACIONES ADICIONALES
C
Ea=PRB.NINC
C
DO m=1,PRB.NINC
SAij(Ea+1,m)=0.d0
SAij(Ea+2,m)=0.d0
ENDDO
SFi(Ea+1)=0.d0
SFi(Ea+2)=0.d0
C
C CLAVE DE LA CDC: X1X -> BIE extendida al sólido A
C X2X -> BIE extendida al sólido B
C
SELECT CASE(NOD(nodA).CBC(2))
C
CASE(111,112,113,211,212,213,311,312,313)
C
C BIE EXTENDIDA AL SOLIDO A
C
CALL PC_BIE(PRB,SOL(csolA),MAT(csolA),CNT,ELT,NOD,PCA,
@ SAij,SFi,Ea)
C
CASE(121,122,123,221,222,223,321,322,323)
C
C BIE EXTENDIDA AL SOLIDO B
C
CALL PC_BIE(PRB,SOL(csolB),MAT(csolB),CNT,ELT,NOD,PCB,
@ SAij,SFi,Ea)
C
CASE(131,132,133,231,232,233,331,332,333)
C
C BIE EXTENDIDA AL SOLIDO A+B
C
CALL PC_BIE(PRB,SOL(csolA),MAT(csolA),CNT,ELT,NOD,PCA,
@ SAij,SFi,Ea)
Ea=PRB.NINC
CALL PC_BIE(PRB,SOL(csolB),MAT(csolB),CNT,ELT,NOD,PCB,
@ SAij,SFi,Ea)
C
CASE DEFAULT
WRITE(F_W,01) 2
WRITE (*,01) 2
STOP
END SELECT
C
C <-20/03/2002
C
C ECUACION DE COLOCACION EN GLOBALES
C
DO m=1,PRB.NINC
BIEij(1,m)=SAij(PRB.NINC+1,m)
BIEij(2,m)=SAij(PRB.NINC+2,m)
ENDDO
BIEij(1,m)=SFi(PRB.NINC+1)
BIEij(2,m)=SFi(PRB.NINC+2)
C
C ECUACION DE COMPATIBILIDAD EN GLOBALES
C
DO m=1,PRB.NINC
CPTij(1,m)=SAij(ceq,m)
CPTij(2,m)=SAij(ceq+1,m)
ENDDO
CPTij(1,m)=SFi(ceq)
CPTij(2,m)=SFi(ceq+1)
C
C 20/03/2002->
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C CALCULO DEL VECTOR NORMAL (AL CNT A)
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
CALL NOR_ELT(Na,ELT(celtA),NOD)
Ta(1)=-Na(2)
Ta(2)=Na(1)
C
C <-20/03/2002
C
C ECUACION DE COLOCACION EN LOCALES
C
DO m=1,PRB.NINC+1
BIEnt(1,m)=BIEij(1,m)*Na(1)+BIEij(2,m)*Na(2)
BIEnt(2,m)=BIEij(1,m)*Ta(1)+BIEij(2,m)*Ta(2)
ENDDO
C
C ECUACION DE COMPATIBILIDAD EN LOCALES
C
DO m=1,PRB.NINC+1
CPTnt(1,m)=CPTij(1,m)*Na(1)+CPTij(2,m)*Na(2)
CPTnt(2,m)=CPTij(1,m)*Ta(1)+CPTij(2,m)*Ta(2)
ENDDO
C
C WRITE(*,*) PRB.NINC+1
C WRITE(123,02) ( CPTij(1,m) ,CPTij(2,m) ,CPTnt(1,m) ,CPTnt(2,m) ,
C @ BIEij(1,m) ,BIEij(2,m) ,BIEnt(1,m) ,BIEnt(2,m) ,
C @ m=1,PRB.NINC+1)
C WRITE(123,02)
C
C 20/03/2002->
C
Ea=PRB.NINC+1
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C SUSTITUCION
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C CLAVE DE LA CDC: 1XX -> Quitar la componente normal de compatibilidad.
C 2XX -> Quitar la componente tangencial de compatibilidad.
C 3XX -> Quitar ambas.
C
C XX1 -> Poner la componente normal de la BIE.
C XX2 -> Poner la componente tangencial de la BIE.
C XX3 -> Poner la suma de ambas.
C
SELECT CASE(NOD(nodA).CBC(3))
CASE(1)
CONTINUE
CASE(2)
SELECT CASE(NOD(nodA).CBC(2))
CASE(111,121,131)
C
C <-20/03/2002
C
C CPTn + BIEn / CPTt
C
DO m=1,PRB.NINC
SAij(ceq+1,m)=CPTnt(1,m)+BIEnt(1,m)
SAij(ceq ,m)=CPTnt(2,m)
ENDDO
SFi(ceq+1)=CPTnt(1,m)+BIEnt(1,m)
SFi(ceq )=CPTnt(2,m)
C
C 20/03/2002->
C
C Componente tangencial de compatibilidad
C DO m=1,PRB.NINC
C SAij(ceq,m)=SAij(ceq,m)*Ta(1)+SAij(ceq+1,m)*Ta(2)
C ENDDO
C SFi(ceq)=SFi(ceq)*Ta(1)+SFi(ceq+1)*Ta(2)
C Componente normal de colocacion
C DO m=1,PRB.NINC
C SAij(ceq+1,m)=SAij(Ea,m)*Na(1)+SAij(Ea+1,m)*Na(2)
C ENDDO
C SFi(ceq+1)=SFi(Ea)*Na(1)+SFi(Ea+1)*Na(2)
C
WRITE(*,*) 'Nodo:',NOD(nodA).NUM,' Compat.n <-> BIE.n'
C
CASE(112,122,132)
C
C <-20/03/2002
C
C CPTn + BIEt / CPTt
C
DO m=1,PRB.NINC
SAij(ceq+1,m)=CPTnt(1,m)+BIEnt(2,m)
SAij(ceq ,m)=CPTnt(2,m)
ENDDO
SFi(ceq+1)=CPTnt(1,m)+BIEnt(2,m)
SFi(ceq )=CPTnt(2,m)
C
C 20/03/2002->
C
C Componente tangencial de compatibilidad
C DO m=1,PRB.NINC
C SAij(ceq,m)=SAij(ceq,m)*Ta(1)+SAij(ceq+1,m)*Ta(2)
C ENDDO
C SFi(ceq)=SFi(ceq)*Ta(1)+SFi(ceq+1)*Ta(2)
C Componente tangencial de colocacion
C DO m=1,PRB.NINC
C SAij(ceq+1,m)=SAij(Ea,m)*Ta(1)+SAij(Ea+1,m)*Ta(2)
C ENDDO
C SFi(ceq+1)=SFi(Ea)*Ta(1)+SFi(Ea+1)*Ta(2)
C
WRITE(*,*) 'Nodo:',NOD(nodA).NUM,' Compat.n <-> BIE.t'
C
CASE(113,123,133)
C
C <-20/03/2002
C
C CPTn + BIEij / CPTt
C
DO m=1,PRB.NINC
SAij(ceq+1,m)=CPTnt(1,m)+BIEij(1,m)+BIEij(2,m)
SAij(ceq ,m)=CPTnt(2,m)
ENDDO
SFi(ceq+1)=CPTnt(1,m)+BIEij(1,m)+BIEij(2,m)
SFi(ceq )=CPTnt(2,m)
C
C 20/03/2002->
C
C Componente tangencial de compatibilidad
C DO m=1,PRB.NINC
C SAij(ceq,m)=SAij(ceq,m)*Ta(1)+SAij(ceq+1,m)*Ta(2)
C ENDDO
C SFi(ceq)=SFi(ceq)*Ta(1)+SFi(ceq+1)*Ta(2)
C Componente 1+2 de colocacion
C DO m=1,PRB.NINC
C SAij(ceq+1,m)=SAij(Ea,m)+SAij(Ea+1,m)
C ENDDO
C SFi(ceq+1)=SFi(Ea)+SFi(Ea+1)
C
WRITE(*,*) 'Nodo:',NOD(nodA).NUM,' Compat.n <-> BIE.1+2'
C
CASE(211,221,231)
C
C <-20/03/2002
C
C CPTn / CPTt + BIEn
C
DO m=1,PRB.NINC
SAij(ceq+1,m)=CPTnt(1,m)
SAij(ceq ,m)=CPTnt(2,m)+BIEnt(1,m)
ENDDO
SFi(ceq+1)=CPTnt(1,m)
SFi(ceq )=CPTnt(2,m)+BIEnt(1,m)
C
C 20/03/2002->
C
C Componente normal de compatibilidad
C DO m=1,PRB.NINC
C SAij(ceq,m)=SAij(ceq,m)*Na(1)+SAij(ceq+1,m)*Na(2)
C ENDDO
C SFi(ceq)=SFi(ceq)*Na(1)+SFi(ceq+1)*Na(2)
C Componente normal de colocacion
C DO m=1,PRB.NINC
C SAij(ceq+1,m)=SAij(Ea,m)*Na(1)+SAij(Ea+1,m)*Na(2)
C ENDDO
C SFi(ceq+1)=SFi(Ea)*Na(1)+SFi(Ea+1)*Na(2)
C
WRITE(*,*) 'Nodo:',NOD(nodA).NUM,' Compat.t <-> BIE.n'
C
CASE(212,222,232)
C
C <-20/03/2002
C
C CPTn / CPTt + BIEt
C
DO m=1,PRB.NINC
SAij(ceq+1,m)=CPTnt(1,m)
SAij(ceq ,m)=CPTnt(2,m)+BIEnt(2,m)
ENDDO
SFi(ceq+1)=CPTnt(1,m)
SFi(ceq )=CPTnt(2,m)+BIEnt(2,m)
C
C 20/03/2002->
C
C Componente normal de compatibilidad
C DO m=1,PRB.NINC
C SAij(ceq,m)=SAij(ceq,m)*Na(1)+SAij(ceq+1,m)*Na(2)
C ENDDO
C SFi(ceq)=SFi(ceq)*Na(1)+SFi(ceq+1)*Na(2)
C Componente tangencial de colocacion
C DO m=1,PRB.NINC
C SAij(ceq+1,m)=SAij(Ea,m)*Ta(1)+SAij(Ea+1,m)*Ta(2)
C ENDDO
C SFi(ceq+1)=SFi(Ea)*Ta(1)+SFi(Ea+1)*Ta(2)
C
WRITE(*,*) 'Nodo:',NOD(nodA).NUM,' Compat.t <-> BIE.t'
C
CASE(213,223,233)
C
C <-20/03/2002
C
C CPTn / CPTt + BIEij
C
DO m=1,PRB.NINC
SAij(ceq+1,m)=CPTnt(1,m)
SAij(ceq ,m)=CPTnt(2,m)+BIEij(1,m)+BIEij(2,m)
ENDDO
SFi(ceq+1)=CPTnt(1,m)
SFi(ceq )=CPTnt(2,m)+BIEij(1,m)+BIEij(2,m)
C
C 20/03/2002->
C
C Componente normal de compatibilidad
C DO m=1,PRB.NINC
C SAij(ceq,m)=SAij(ceq,m)*Na(1)+SAij(ceq+1,m)*Na(2)
C ENDDO
C SFi(ceq)=SFi(ceq)*Na(1)+SFi(ceq+1)*Na(2)
C Componente 1+2 de colocacion
C DO m=1,PRB.NINC
C SAij(ceq+1,m)=SAij(Ea,m)+SAij(Ea+1,m)
C ENDDO
C SFi(ceq+1)=SFi(Ea)+SFi(Ea+1)
C
WRITE(*,*) 'Nodo:',NOD(nodA).NUM,' Compat.t <-> BIE.1+2'
C
CASE(311,321,331,312,322,332,313,323,333)
C
C <-20/03/2002
C
C CPT1 + BIE1 / CPT2 + BIE2
C
DO m=1,PRB.NINC
SAij(ceq+1,m)=CPTij(1,m)+BIEij(1,m)
SAij(ceq ,m)=CPTij(2,m)+BIEij(2,m)
ENDDO
SFi(ceq+1)=CPTij(1,m)+BIEij(1,m)
SFi(ceq )=CPTij(2,m)+BIEij(2,m)
C
C 20/03/2002->
C
C Componente 1 y 2 de colocacion
C DO m=1,PRB.NINC
C SAij(ceq,m) =SAij(Ea,m)
C SAij(ceq+1,m)=SAij(Ea+1,m)
C ENDDO
C SFi(ceq) =SFi(Ea)
C SFi(ceq+1)=SFi(Ea+1)
C
WRITE(*,*) 'Nodo:',NOD(nodA).NUM,' Compat.1y2 <-> BIE.1y2'
C
CASE DEFAULT
WRITE(F_W,01) 3
WRITE (*,01) 3
STOP
END SELECT
CASE(3,-3,13,33)
SELECT CASE(NOD(nodA).CBC(2))
CASE(111,121,131,311,321,331)
C
C <-20/03/2002
C
C CPTn + BIEn / CPTt
C
DO m=1,PRB.NINC
SAij(ceq+1,m)=CPTnt(1,m)+BIEnt(1,m)
SAij(ceq ,m)=CPTnt(2,m)
ENDDO
SFi(ceq+1)=CPTnt(1,m)+BIEnt(1,m)
SFi(ceq )=CPTnt(2,m)
C
C 20/03/2002->
C
C Componente tangencial de compatibilidad
C DO m=1,PRB.NINC
C SAij(ceq,m)=SAij(ceq,m)*Ta(1)+SAij(ceq+1,m)*Ta(2)
C ENDDO
C SFi(ceq)=SFi(ceq)*Ta(1)+SFi(ceq+1)*Ta(2)
C Componente normal de colocacion
C DO m=1,PRB.NINC
C SAij(ceq+1,m)=SAij(Ea,m)*Na(1)+SAij(Ea+1,m)*Na(2)
C ENDDO
C SFi(ceq+1)=SFi(Ea)*Na(1)+SFi(Ea+1)*Na(2)
C
WRITE(*,*) 'Nodo:',NOD(nodA).NUM,' Compat.n <-> BIE.n'
C
CASE(112,122,132,312,322,332)
C
C <-20/03/2002
C
C CPTn + BIEt / CPTt
C
DO m=1,PRB.NINC
SAij(ceq+1,m)=CPTnt(1,m)+BIEnt(2,m)
SAij(ceq ,m)=CPTnt(2,m)
ENDDO
SFi(ceq+1)=CPTnt(1,m)+BIEnt(2,m)
SFi(ceq )=CPTnt(2,m)
C
C 20/03/2002->
C
C Componente tangencial de compatibilidad
C DO m=1,PRB.NINC
C SAij(ceq,m)=SAij(ceq,m)*Ta(1)+SAij(ceq+1,m)*Ta(2)
C ENDDO
C SFi(ceq)=SFi(ceq)*Ta(1)+SFi(ceq+1)*Ta(2)
C Componente tangencial de colocacion
C DO m=1,PRB.NINC
C SAij(ceq+1,m)=SAij(Ea,m)*Ta(1)+SAij(Ea+1,m)*Ta(2)
C ENDDO
C SFi(ceq+1)=SFi(Ea)*Ta(1)+SFi(Ea+1)*Ta(2)
C
WRITE(*,*) 'Nodo:',NOD(nodA).NUM,' Compat.n <-> BIE.t'
C
CASE(113,123,133,313,323,333)
C
C <-20/03/2002
C
C CPTn + BIEij / CPTt
C
DO m=1,PRB.NINC
SAij(ceq+1,m)=CPTnt(1,m)+BIEij(1,m)+BIEij(2,m)
SAij(ceq ,m)=CPTnt(2,m)
ENDDO
SFi(ceq+1)=CPTnt(1,m)+BIEij(1,m)+BIEij(2,m)
SFi(ceq )=CPTnt(2,m)
C
C 20/03/2002->
C
C Componente tangencial de compatibilidad
C DO m=1,PRB.NINC
C SAij(ceq,m)=SAij(ceq,m)*Ta(1)+SAij(ceq+1,m)*Ta(2)
C ENDDO
C SFi(ceq)=SFi(ceq)*Ta(1)+SFi(ceq+1)*Ta(2)
C Componente 1+2 de colocacion
C DO m=1,PRB.NINC
C SAij(ceq+1,m)=SAij(Ea,m)+SAij(Ea+1,m)
C ENDDO
C SFi(ceq+1)=SFi(Ea)+SFi(Ea+1)
C
WRITE(*,*) 'Nodo:',NOD(nodA).NUM,' Compat.n <-> BIE.1+2'
C
CASE(211,221,231,212,222,232,213,223,233)
CONTINUE
CASE DEFAULT
WRITE(F_W,01) 4
WRITE (*,01) 4
STOP
END SELECT
CASE DEFAULT
WRITE(F_W,01) 5
WRITE (*,01) 5
STOP
END SELECT
C
C FIN DE LA RUTINA
C
RETURN
C
C FORMATOS DE ESCRITURA.
C
01 FORMAT(/,2x,'ERROR 1 - 10-2-CEXTRA - Error de programa (#',
@ i1,'#).')
02 FORMAT(1x,8(1x,e22.16,1x))
C
END
C
e-REdING. Biblioteca de la Escuela Superior de Ingenieros de Sevilla.
