cGxrswa.for c c

c
c
      SUBROUTINE UCOGND
C-----------------------------------------------------------------------
C     SUBROUTINE UCOGND is called from section 1, group 13 of GXRSTM.
C-----------------------------------------------------------------------
      include '/phoenics/d_includ/farray'
      INCLUDE '/phoenics/d_includ/satear'
      INCLUDE '/phoenics/d_includ/grdloc'
      INCLUDE '/phoenics/d_includ/satgrd'
      INCLUDE '/phoenics/d_includ/grdear'
      COMMON /NAMFN/NAMFUN,NAMSUB
      CHARACTER*6 NAMFUN,NAMSUB
      NAMSUB = 'UCOGND'
      IF(WALLTY) CALL UWALFN
      IF(NPATCH(1:4).EQ.'SMPL') CALL USYMPL
      NAMSUB = 'ucognd'
      END
C-----------------------------------------------------------------------
c
      SUBROUTINE UVLGND
C-----------------------------------------------------------------------
C     SUBROUTINE UVLGND is called from section 12, group 13 of GXRSTM.
C-----------------------------------------------------------------------
      include '/phoenics/d_includ/farray'
      INCLUDE '/phoenics/d_includ/satear'
      INCLUDE '/phoenics/d_includ/grdloc'
      INCLUDE '/phoenics/d_includ/satgrd'
      INCLUDE '/phoenics/d_includ/grdear'
      COMMON /NAMFN/NAMFUN,NAMSUB
      CHARACTER*6 NAMFUN,NAMSUB
      NAMSUB = 'UVLGND'
      IF(NPATCH(1:4).EQ.'WDMP') CALL UWDAMP
      IF(WALLTY) CALL UWALFN
      NAMSUB = 'uvlgnd'
      END
C-----------------------------------------------------------------------
c
      SUBROUTINE USYMPL
C-----------------------------------------------------------------------
C     SUBROUTINE USYMPL is called by UCOGND and UVLGND.
C-----------------------------------------------------------------------
      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'
      INCLUDE '/phoenics/d_includ/rsmcmn'
      COMMON /NAMFN/NAMFUN,NAMSUB
      CHARACTER*6 NAMFUN,NAMSUB
      NAMSUB = 'USYMPL'
C  IGO   E=1 ; W=2 ; N=3 ; S=4 ; H=5 ; L=6
C  IDIR  E=1 ; W=1 ; N=2 ; S=2 ; H=3 ; L=3
      IGO=INDEX('EWNSHL',NPATCH(5:5))
      IDIR=(IGO+1)/2
      J0CO=L0F(CO)
      J0VT=L0F(VIST)
      IF(IDIR.EQ.1) CALL SUB2(J0NMSR,J0U2DK,J0DIST,J0DX)
      IF(IDIR.EQ.2) CALL SUB2(J0NMSR,J0V2DK,J0DIST,J0DY)
      IF(IDIR.EQ.3) CALL SUB2(J0NMSR,J0W2DK,J0DIST,J0DZ)
      DO 1 IX = IXF,IXL
CDIR$ IVDEP
      DO 1 IY = IYF,IYL
        I = (IX-1)*NY+IY
        F(J0CO+I) = F(J0NMSR+I)*F(J0DEN1+I)*F(J0VT+I)
     1              *F(L0GCRT+ ISL(INDVAR))/(0.5*F(J0DIST+I))
    1 CONTINUE
      NAMSUB = 'usympl'
      END
C-----------------------------------------------------------------------
c
      SUBROUTINE UWALFN
C-----------------------------------------------------------------------
C     SUBROUTINE UWALFN is called by UCOGND and UVLGND.
C-----------------------------------------------------------------------
      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'
      INCLUDE '/phoenics/d_includ/rsmcmn'
C#### dbs 11.03.10 common lnrtm4 replaces turb3
C####      COMMON/TURB3/RTTDKE,AKC,EWC,ACON,TAUDKE
      COMMON/LRNTM4/RSCMCD,CDDAK2,TAUDKE,RTTDKE,AKC,EWC
      COMMON/NAMFN/NAMFUN,NAMSUB
      CHARACTER*6 NAMFUN,NAMSUB
      LOGICAL GTURB
      NAMSUB = 'UWALFN'
      IF(ISC.EQ.1) THEN
        CALL FN1(CO,1.0E5*FIXVAL)
      ELSEIF(ISC.EQ.12.AND.GTURB(INDVAR)) THEN
        GFACT=0.0
c the following is not general because the lateral, normal and
c  streamwise directions are presumed to be ix,iy & iz
        IF(INDVAR.EQ.JU2RS) GFACT=0.65/TAUDKE
        IF(INDVAR.EQ.JV2RS) GFACT=0.25/TAUDKE
        IF(INDVAR.EQ.JW2RS) GFACT=1.10/TAUDKE
C the following line is not general because the sign of the
C shearing stress is not known a priori
        IF(INDVAR.EQ.JVWRS.OR.INDVAR.EQ.JUVRS.OR.INDVAR.EQ.JUWRS)
     1                        GFACT=0.255/TAUDKE
        J=0
        J0VAL=L0F(VAL)
        L0STRS=L0PVAR(PVSTRS,IREG,0)
        DO 3 IX=IXF,IXL
CDIR$ IVDEP
        DO 3 IY=IYF,IYL
          I=(IX-1)*NY+IY
          J=J+1
          F(J0VAL+I)=GFACT*F(L0STRS+J)
    3   CONTINUE
      ENDIF
      NAMSUB = 'uwalfn'
      END
C-----------------------------------------------------------------------
c
      SUBROUTINE UWDAMP
C-----------------------------------------------------------------------
C     SUBROUTINE UWDAMP is called by UVLGND.
C-----------------------------------------------------------------------
      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'
      INCLUDE '/phoenics/d_includ/rsmcmn'
      COMMON /NAMFN/NAMFUN,NAMSUB
      CHARACTER*6 NAMFUN,NAMSUB,NM12*2
      LOGICAL EQZ,GNORM,GCROS
      REAL GRLAU2(3),GRLAV2(3),GRLAW2(3),GRLADF(3)
      DATA GRLAU2,GRLAV2,GRLAW2,GRLADF
     1     /-2.,1.,1.,1.,-2.,1.,1.,1.,-2.,3.,-3.,0./
      NAMSUB = 'UWDAMP'
      J0LEN=L0F(INAME('LEN1'))
C  IGO   E=1 ; W=2 ; N=3 ; S=4 ; H=5 ; L=6
C  IDIR  E=1 ; W=1 ; N=2 ; S=2 ; H=3 ; L=3
      IGO=INDEX('EWNSHL',NPATCH(5:5))
      IDIR=(IGO+1)/2
      IF(IGO.EQ.0) RETURN
C
      IF(INDVAR.EQ.KE.OR.IDIR.EQ.1.AND.INDVAR.EQ.JVWRS
     1               .OR.IDIR.EQ.2.AND.INDVAR.EQ.JUWRS
     1     .OR.IDIR.EQ.3.AND.(INDVAR.EQ.JUVRS.OR.INDVAR.EQ.JDFRS)) THEN
        CALL FN1(VAL,0.)
        RETURN
      ENDIF
      IF(JSCAML.EQ.3 .AND. (NAME(INDVAR)(2:3).EQ.'TR' .OR.
     1   NAME(INDVAR)(2:3).EQ.'SC') ) THEN
        NM12=NAME(INDVAR)(1:2)
        IF(((NM12.EQ.'UT'.OR.NM12.EQ.'US').AND.IDIR.NE.1).OR.
     1     ((NM12.EQ.'VT'.OR.NM12.EQ.'VS').AND.IDIR.NE.2).OR.
     1     ((NM12.EQ.'WT'.OR.NM12.EQ.'WS').AND.IDIR.NE.3)) THEN
          CALL FN1(VAL,0.0)
          RETURN
        ENDIF
      ENDIF
C
      IF(IDIR.EQ.3) CALL GETPTC(NPATCH,G1,J1,J2,J3,J4,IZF,IZL,J5,J6)
      IF(IDIR.EQ.1) THEN
        I1AD=ITWO(IXF*NY,IXL*NY,IGO.EQ.2)
        DO 1 IY=IYF,IYL
          I0=IY-NY
          I1=I0+I1AD
          GWDS1=0.5*F(J0DX+I1)
          GLEN1=F(J0LEN+I1)
          GCWD=GWDS1/(GLEN1+tiny)
CDIR$ IVDEP
        DO 1 IX=IXF,IXL
          I=I0+IX*NY
          GWDS=GWDS1+ABS(F(J0XG+I)-F(J0XG+I1))
          GLEN=F(J0LEN+I)
          F(J0WDPC+I)=GCWD*GLEN/gwds
    1   CONTINUE
      ELSEIF(IDIR.EQ.2) THEN
        I1AD=ITWO(IYF,IYL,IGO.EQ.4)
        DO 2 IX=IXF,IXL
          I0=IX*NY-NY
          I1=I0+I1AD
          GWDS1=0.5*F(J0DY+I1)
          GLEN1=F(J0LEN+I1)
          GCWD=GWDS1/(GLEN1+tiny)
CDIR$ IVDEP
        DO 2 IY=IYF,IYL
          I=I0+IY
          GWDS=GWDS1+ABS(F(J0YG+I)-F(J0YG+I1))
          GLEN=F(J0LEN+I)
          F(J0WDPC+I)=GCWD*GLEN/GWDS
    2   CONTINUE
        IF(IGO.EQ.4.AND..NOT.CARTES.AND.EQZ(RINNER)) THEN
          DO 21 IX=IXF,IXL
          I0=IX*NY-NY
CDIR$ IVDEP
          DO 21 IY=IYF,IYL
            I=I0+IY
            GXX=F(J0YG+I)/YVLAST
            F(J0WDPC+I)=GXX*GXX*(3.-2.*GXX)
   21     CONTINUE
        ENDIF
      ELSEIF(IGO.EQ.5) THEN
        GWDH=F(L0F(LZZW)+IZL)-F(L0F(LZZG)+IZL)
        GWLDIS=F(L0F(LZZW)+IZL)-F(L0F(LZZG)+IZ)
        DO 3 IX=IXF,IXL
CDIR$ IVDEP
        DO 3 IY=IYF,IYL
          I=(IX-1)*NY+IY
          GLENH=F(J0LEN+I+(IZL-IZ)*JUMPZ)
          GCWD=GWDH/(GLENH+tiny)
          GLENTH=F(J0LEN+I)
          F(J0WDPC+I)=GCWD*GLENTH/GWLDIS
    3   CONTINUE
      ELSEIF(IGO.EQ.6) THEN
        GZLWL=0.0
        IF(IZF.NE.1) GZLWL=F(L0F(LZZW)+IZF-1)
        GWDL=F(L0F(LZZG)+IZF)-GZLWL
        GWLDIS=F(L0F(LZZG)+IZ)-GZLWL
        DO 4 IX=IXF,IXL
CDIR$ IVDEP
        DO 4 IY=IYF,IYL
          I=(IX-1)*NY+IY
          GLENL=F(J0LEN+I+(IZF-IZ)*JUMPZ)
          GCWD=GWDL/(GLENL+tiny)
          GLENTH=F(J0LEN+I)
          F(J0WDPC+I)=GCWD*GLENTH/GWLDIS
    4   CONTINUE
      ENDIF
CDIR$ IVDEP
      DO 5 I=1,NXNY
        F(J0WDPC+I)=AMIN1(F(J0WDPC+I),1.0)
    5 CONTINUE
C
      J0VAL=L0F(VAL)
      IF(GNORM(INDVAR)) THEN
        IF(INDVAR.EQ.JU2RS) GREAL=GRLAU2(IDIR)
        IF(INDVAR.EQ.JV2RS) GREAL=GRLAV2(IDIR)
        IF(INDVAR.EQ.JW2RS) GREAL=GRLAW2(IDIR)
        IF(INDVAR.EQ.JDFRS) GREAL=GRLADF(IDIR)
        IF(IDIR.EQ.1) CALL SUB2(J0NMRS,J0U2RS, J0NMR2,J0R2U2)
        IF(IDIR.EQ.2) CALL SUB2(J0NMRS,J0V2RS, J0NMR2,J0R2V2)
        IF(IDIR.EQ.3) CALL SUB2(J0NMRS,J0W2RS, J0NMR2,J0R2W2)
        DO 6 IX=IXF,IXL
CDIR$ IVDEP
        DO 6 IY=IYF,IYL
          I=(IX-1)*NY+IY
          F(J0VAL+I)=GREAL*F(J0WDPC+I)*
     1        (GC1W*F(J0EPDK+I)*F(J0NMRS+I)+GC2W*F(J0NMR2+I))
    6   CONTINUE
      ELSEIF(GCROS(INDVAR)) THEN
        IF(INDVAR.EQ.JUVRS) J0RED2=J0R2UV
        IF(INDVAR.EQ.JUWRS) J0RED2=J0R2UW
        IF(INDVAR.EQ.JVWRS) J0RED2=J0R2VW
        J0PHI=L0F(INDVAR)
        DO 7 IX=IXF,IXL
CDIR$ IVDEP
        DO 7 IY=IYF,IYL
          I=(IX-1)*NY+IY
          F(J0VAL+I)=-1.5*F(J0WDPC+I)*
     1        (GC1W*F(J0EPDK+I)*F(J0PHI+I)+GC2W*F(J0RED2+I))
    7   CONTINUE
      ELSEIF(JSCAML.EQ.3 .AND. (NAME(INDVAR)(2:3).EQ.'TR' .OR.
     1       NAME(INDVAR)(2:3).EQ.'SC') ) THEN
        J0PHI=L0F(INDVAR)
        DO 8 IX=IXF,IXL
CDIR$ IVDEP
        DO 8 IY=IYF,IYL
          I=(IX-1)*NY+IY
          F(J0VAL+I)=-F(J0WDPC+I)*(GC1TW*F(J0EPDK+I)*F(J0PHI+I))
    8   CONTINUE
      ENDIF
      NAMSUB = 'uwdamp'
      END
c