cgxfric.htm
c
c
c -- file name gxvelslp.htm 060701
C.... FNVSLP calculates slip velocity for a current slab (NGO=1). It is
C called from INIPRP at the start of the run (NGO=0) to make
C preliminary settings.
SUBROUTINE FNVSLP(NGO,L0VREL,CFPA)
INCLUDE 'farray'
INCLUDE 'satear'
INCLUDE 'grdear'
INCLUDE 'grdloc'
INCLUDE 'satgrd'
COMMON/NAMFN/NAMFUN,NAMSUB /GENI/NXNY,NXM1NY,IG1(7),NFM,IG2(50)
1 /UVWCOL/IUC1,IVC1,IWC1,IUFIL(32)
1 /UCRTUN/IUCF(6),IUCR10,IVCR10,IWCR10,IUCR20,IVCR20,IWCR20
1 /PRPCMN/IPRF(13),LBVREL,LBNUSS
LOGICAL SOLU,SOLV,SOLW,XBOU
CHARACTER*6 NAMFUN,NAMSUB
SAVE SOLU,SOLV,SOLW,VSLPMX
C
NAMFUN= 'FNVLSP'
C.... Preliminaries:
IF(NGO.EQ.0) THEN
IF(CCM) THEN
CALL SUB3L(SOLU,IUC1.NE.0,SOLV,IVC1.NE.0,SOLW,IWC1.NE.0)
ELSE
CALL SUB3L(SOLU,SOLVE(U1),SOLV,SOLVE(V1),SOLW,SOLVE(W1))
CALL SUB3R(VSLMXU,1.E10,VSLMXV,1.E10,VSLMXW,1.E10)
IF(SOLU) VSLMXU=AMIN1( ABS(VARMAX(3)), ABS(VARMAX(4)) )
IF(SOLV) VSLMXV=AMIN1( ABS(VARMAX(5)), ABS(VARMAX(6)) )
IF(SOLW) VSLMXW=AMIN1( ABS(VARMAX(7)), ABS(VARMAX(8)) )
VSLPMX=AMIN1( VSLMXU, VSLMXV, VSLMXW)
ENDIF
c.... calculate limit for vrel
ELSE
C.... Calculate slip velocity for a current slab:
IF(CCM) THEN
IF(SOLU) CALL SUB2( L0U1,IUCR10, L0U2,IUCR20 )
IF(SOLV) CALL SUB2( L0V1,IVCR10, L0V2,IVCR20 )
IF(SOLW) CALL SUB2( L0W1,IWCR10, L0W2,IWCR20 )
IADZS= (IZSTEP-1)*NFM
DO 10 IX= IXF,IXL
IADX= (IX-1)*NY
DO 10 IY= IYF,IYL
IJ = IY+IADX
IJK= IJ+IADZS
DIFFSQ= 0.0
IF(SOLU) DIFFSQ= DIFFSQ + (F(L0U1+IJK)-F(L0U2+IJK))**2
IF(SOLV) DIFFSQ= DIFFSQ + (F(L0V1+IJK)-F(L0V2+IJK))**2
IF(SOLW) DIFFSQ= DIFFSQ + (F(L0W1+IJK)-F(L0W2+IJK))**2
F(L0VREL+IJ)= AMAX1(CFPA,SQRT(DIFFSQ+TINY))
10 CONTINUE
ELSE
IF(SOLU) CALL SUB2( L0U1,L0F(U1), L0U2,L0F(U2) )
IF(SOLV) CALL SUB2( L0V1,L0F(V1), L0V2,L0F(V2) )
IF(SOLW) THEN
CALL SUB2( L0W1, L0F(W1), L0W2, L0F(W2) )
CALL SUB2( L0W1L,L0W1-NFM, L0W2L,L0W2-NFM )
ENDIF
DO 20 IX= IXF,IXL
XBOU= IX.EQ.NX.AND..NOT.XCYCLE
DO 20 IY= IYF,IYL
I= IY+(IX-1)*NY
DIFFSQ= 0.0
IF(SOLU) THEN
IF(IX.EQ.1) THEN
IF(.NOT.XCYCLE) THEN
DIFFSQ= 2.*(F(L0U1+I)-F(L0U2+I))**2
ELSE
DIFFSQ= (F(L0U1+I)-F(L0U2+I))**2
J= I+NXM1NY
DIFFSQ= DIFFSQ + (F(L0U1+J)-F(L0U2+J))**2
ENDIF
ELSEIF(XBOU) THEN
J= I-NY
DIFFSQ= 2.*(F(L0U1+J)-F(L0U2+J))**2
ELSE
DIFFSQ= (F(L0U1+I)-F(L0U2+I))**2
J= I-NY
DIFFSQ= DIFFSQ + (F(L0U1+J)-F(L0U2+J))**2
ENDIF
ENDIF
IF(SOLV) THEN
IF(IY.EQ.1) THEN
DIFFSQ= DIFFSQ + 2.*(F(L0V1+I)-F(L0V2+I))**2
ELSEIF(IY.EQ.NY) THEN
DIFFSQ= DIFFSQ + 2.*(F(L0V1+I-1)-F(L0V2+I-1))**2
ELSE
DIFFSQ= DIFFSQ + (F(L0V1+I)-F(L0V2+I))**2
1 + (F(L0V1+I-1)-F(L0V2+I-1))**2
ENDIF
ENDIF
IF(SOLW) THEN
IF(IZ.EQ.1) THEN
DIFFSQ= DIFFSQ + 2.*(F(L0W1+I)-F(L0W2+I))**2
ELSEIF(IZ.EQ.NZ) THEN
DIFFSQ= DIFFSQ + 2.*(F(L0W1L+I)-F(L0W2L+I))**2
ELSE
DIFFSQ= DIFFSQ + (F(L0W1 +I)-F(L0W2 +I))**2
1 + (F(L0W1L+I)-F(L0W2L+I))**2
ENDIF
ENDIF
F(L0VREL+I)= AMAX1(CFPA, SQRT(0.5*DIFFSQ+TINY))
F(L0VREL+I)= AMIN1(F(L0VREL+I),VSLPMX)
20 CONTINUE
ENDIF
IF(LBVREL.NE.0) CALL FN0(LBVREL,-L0VREL)
ENDIF
END
c