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 '/phoenics/d_includ/farray'
      INCLUDE '/phoenics/d_includ/satear'
      INCLUDE '/phoenics/d_includ/grdear'
      INCLUDE '/phoenics/d_includ/grdloc'
      INCLUDE '/phoenics/d_includ/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