mur.f90

Sfdtd Simple finite-difference time-domain

  ENDDO

END SUBROUTINE mur_2_Ezx

SUBROUTINE mur_2_Eyx(g, r)

  TYPE(gitter), INTENT(INOUT)      :: g
  TYPE(MurBound), INTENT(INOUT)    :: r
  INTEGER                          :: I,J,K

  !DO EDGES WITH FIRST ORDER ORBC
  DO K=g%nzl+1,g%nzyh,1
    J=g%nyl
    g%E(g%nxl, J, K, 2)=r%EYSX1(2,J,K)+r%CD*(g%E(g%nxl+1, J, K, 2)-r%EYSX1(1,J,K))
    g%E(g%nxgh, J, K, 2)=r%EYSX1(3,J,K)+r%CD*(g%E(g%nxyh, J, K, 2)-r%EYSX1(4,J,K))
    J=g%nyyh
    g%E(g%nxl, J, K, 2)=r%EYSX1(2,J,K)+r%CD*(g%E(g%nxl+1, J, K, 2)-r%EYSX1(1,J,K))
    g%E(g%nxgh, J, K, 2)=r%EYSX1(3,J,K)+r%CD*(g%E(g%nxyh, J, K, 2)-r%EYSX1(4,J,K))
  ENDDO

  DO J=g%nyl+1,g%nyyh-1, 1
    K=g%nzl+1
    g%E(g%nxl, J, K, 2)=r%EYSX1(2,J,K)+r%CD*(g%E(g%nxl+1, J, K, 2)-r%EYSX1(1,J,K))
    g%E(g%nxgh, J, K, 2)=r%EYSX1(3,J,K)+r%CD*(g%E(g%nxyh, J, K, 2)-r%EYSX1(4,J,K))
    K=g%nzyh
    g%E(g%nxl, J, K, 2)=r%EYSX1(2,J,K)+r%CD*(g%E(g%nxl+1, J, K, 2)-r%EYSX1(1,J,K))
    g%E(g%nxgh, J, K, 2)=r%EYSX1(3,J,K)+r%CD*(g%E(g%nxl+1, J, K, 2)-r%EYSX1(4,J,K))
  ENDDO

  !NOW DO 2ND ORDER ORBC ON REMAINING PORTIONS OF FACES
  DO K=g%nzl+2,g%nzyh-1, 1
    DO J=g%nyl+1,g%nyyh-1, 1

      g%E(g%nxl, J, K, 2)= - r%EYSX2(2,J,K)+r%CD*(g%E(g%nxl+1, J, K, 2)+r%EYSX2(1,J,K))        &
                           + r%CXDD*(r%EYSX1(1,J,K)+r%EYSX1(2,J,K))                            &
                           + r%CFDD*(r%EYSX1(1,J+1,K)-2.0d0*r%EYSX1(1,J,K)+r%EYSX1(1,J-1,K)    &
                           + r%EYSX1(2,J+1,K)-2.0d0*r%EYSX1(2,J,K)+r%EYSX1(2,J-1,K))           &
                           + r%CFDD*(r%EYSX1(1,J,K+1)-2.0d0*r%EYSX1(1,J,K)+r%EYSX1(1,J,K-1)    &
                           + r%EYSX1(2,J,K+1)-2.0d0*r%EYSX1(2,J,K)+r%EYSX1(2,J,K-1))

     g%E(g%nxgh, J, K, 2) = - r%EYSX2(3,J,K)+r%CD*(g%E(g%nxyh, J, K, 2)+r%EYSX2( 4,J,K))       &
                            + r%CXDD*(r%EYSX1(4,J,K)+r%EYSX1(3,J,K))                           &
                            + r%CFDD*(r%EYSX1(4,J+1,K)-2.0d0*r%EYSX1(4,J,K)+r%EYSX1(4,J-1,K)   &
                            + r%EYSX1(3,J+1,K)-2.0d0*r%EYSX1(3,J,K)+r%EYSX1(3,J-1,K))          &
                            + r%CFDD*(r%EYSX1(4,J,K+1)-2.0d0*r%EYSX1(4,J,K)+r%EYSX1(4,J,K-1)   &
                            + r%EYSX1(3,J,K+1)-2.0d0*r%EYSX1(3,J,K)+r%EYSX1(3,J,K-1))
    ENDDO
  ENDDO

!NOW SAVE PAST VALUES
  DO K=g%nzl+1,g%nzyh, 1
    DO J=g%nyl,g%nyyh, 1
      r%EYSX2(1,J,K)=r%EYSX1(1,J,K)
      r%EYSX2(2,J,K)=r%EYSX1(2,J,K)
      r%EYSX2(3,J,K)=r%EYSX1(3,J,K)
      r%EYSX2(4,J,K)=r%EYSX1(4,J,K)
      r%EYSX1(1,J,K)=g%E(g%nxl, J, K, 2)
      r%EYSX1(2,J,K)=g%E(g%nxl+1, J, K, 2)
      r%EYSX1(3,J,K)=g%E(g%nxyh, J, K, 2)
      r%EYSX1(4,J,K)=g%E(g%nxgh, J, K, 2)
    ENDDO
  ENDDO

END SUBROUTINE mur_2_Eyx 

SUBROUTINE mur_2_Ezy(g, r)

  TYPE(gitter), INTENT(INOUT)      :: g
  TYPE(MurBound), INTENT(INOUT)    :: r
  INTEGER                          :: I,J,K

  !DO EDGES WITH FIRST ORDER ORBC
  DO K=g%nzl, g%nzyh, 1
    I=g%nxl+1
    g%E(I,g%nyl,K,3)=r%EZSY1(I,2,K)+r%CD*(g%E(I,g%nyl+1,K,3)-r%EZSY1(I,1,K))
    g%E(I,g%nygh,K,3)=r%EZSY1(I,3,K)+r%CD*(g%E(I,g%nyyh,K,3)-r%EZSY1(I,4,K))
    I=g%nxyh
    g%E(I,g%nyl,K,3)=r%EZSY1(I,2,K)+r%CD*(g%E(I,g%nyl+1,K,3)-r%EZSY1(I,1,K))
    g%E(I,g%nygh,K,3)=r%EZSY1(I,3,K)+r%CD*(g%E(I,g%nyyh,K,3)-r%EZSY1(I,4,K))
  ENDDO

  DO I=g%nxl+2,g%nxyh-1, 1
    K=g%nzl
    g%E(I,g%nyl,K,3)=r%EZSY1(I,2,K)+r%CD*(g%E(I,g%nyl+1,K,3)-r%EZSY1(I,1,K))
    g%E(I,g%nygh,K,3)=r%EZSY1(I,3,K)+r%CD*(g%E(I,g%nyyh,K,3)-r%EZSY1(I,4,K))
    K=g%nzyh
    g%E(I,g%nyl,K,3)=r%EZSY1(I,2,K)+r%CD*(g%E(I,g%nyl+1,K,3)-r%EZSY1(I,1,K))
    g%E(I,g%nygh,K,3)=r%EZSY1(I,3,K)+r%CD*(g%E(I,g%nyyh,K,3)-r%EZSY1(I,4,K))
  ENDDO

  !NOW DO 2ND ORDER ORBC ON REMAINING PORTIONS OF FACES
  DO K=g%nzl+1,g%nzyh-1,1
    DO I=g%nxl+2,g%nxyh-1, 1
      g%E(I,g%nyl,K,3)= - r%EZSY2(I,2,K)+r%CD*(g%E(I,g%nyl+1,K,3)+r%EZSY2(I,1,K))          &
                        + r%CXDD*(r%EZSY1(I,1,K)+r%EZSY1(I,2,K))                           &
                        + r%CFDD*(r%EZSY1(I+1,1,K)-2.0d0*r%EZSY1(I,1,K)+r%EZSY1(I-1,1,K)   &
                        + r%EZSY1(I+1,2,K)-2.0d0*r%EZSY1(I,2,K)+r%EZSY1(I-1,2,K))          &
                        + r%CFDD*(r%EZSY1(I,1,K+1)-2.0d0*r%EZSY1(I,1,K)+r%EZSY1(I,1,K-1)   &
                        + r%EZSY1(I,2,K+1)-2.0d0*r%EZSY1(I,2,K)+r%EZSY1(I,2,K-1)) 

      g%E(I,g%nygh,K,3)=  - r%EZSY2(I,3,K)+r%CD*(g%E(I,g%nyyh,K,3)+r%EZSY2(I,4,K))         &
                          + r%CXDD*(r%EZSY1(I,4,K)+r%EZSY1(I,3,K))                         &
                          + r%CFDD*(r%EZSY1(I+1,4,K)-2.0d0*r%EZSY1(I,4,K)+r%EZSY1(I-1,4,K) &
                          + r%EZSY1(I+1,3,K)-2.0d0*r%EZSY1(I,3,K)+r%EZSY1(I-1,3,K))        &
                          + r%CFDD*(r%EZSY1(I,4,K+1)-2.0d0*r%EZSY1(I,4,K)+r%EZSY1(I,4,K-1) &
                          + r%EZSY1(I,3,K+1)-2.0d0*r%EZSY1(I,3,K)+r%EZSY1(I,3,K-1))
    ENDDO
  ENDDO

  !NOW SAVE PAST VALUES
  DO K=g%nzl,g%nzyh, 1
    DO I=g%nxl+1,g%nxyh,1
      r%EZSY2(I,1,K)=r%EZSY1(I,1,K)
      r%EZSY2(I,2,K)=r%EZSY1(I,2,K)
      r%EZSY2(I,3,K)=r%EZSY1(I,3,K)
      r%EZSY2(I,4,K)=r%EZSY1(I,4,K)
      r%EZSY1(I,1,K)=g%E(I,g%nyl,K,3)
      r%EZSY1(I,2,K)=g%E(I,g%nyl+1,K,3)
      r%EZSY1(I,3,K)=g%E(I,g%nyyh,K,3)
      r%EZSY1(I,4,K)=g%E(I,g%nygh,K,3)
    ENDDO
  ENDDO

END SUBROUTINE mur_2_Ezy

SUBROUTINE mur_2_Exy(g, r)

  TYPE(gitter), INTENT(INOUT)      :: g
  TYPE(MurBound), INTENT(INOUT)    :: r
  INTEGER                          :: I,J,K

  !DO EDGES WITH FIRST ORDER ORBC
  DO K=g%nzl+1,g%nzyh, 1
    I=g%nxl
    g%E(I,g%nyl,K,1)=r%EXSY1(I,2,K)+r%CD*(g%E(I,g%nyl+1,K,1)-r%EXSY1(I,1,K))
    g%E(I,g%nygh,K,1)=r%EXSY1(I,3,K)+r%CD*(g%E(I,g%nyyh,K,1)-r%EXSY1(I,4,K))
    I=g%nxyh
    g%E(I,g%nyl,K,1)=r%EXSY1(I,2,K)+r%CD*(g%E(I,g%nyl+1,K,1)-r%EXSY1(I,1,K))
    g%E(I,g%nygh,K,1)=r%EXSY1(I,3,K)+r%CD*(g%E(I,g%nyyh,K,1)-r%EXSY1(I,4,K))
  ENDDO

  DO I=g%nxl+1,g%nxyh-1,1
    K=g%nzl+1
    g%E(I,g%nyl,K,1)=r%EXSY1(I,2,K)+r%CD*(g%E(I,g%nyl+1,K,1)-r%EXSY1(I,1,K))
    g%E(I,g%nygh,K,1)=r%EXSY1(I,3,K)+r%CD*(g%E(I,g%nyyh,K,1)-r%EXSY1(I,4,K))
    K=g%nzyh
    g%E(I,g%nyl,K,1)=r%EXSY1(I,2,K)+r%CD*(g%E(I,g%nyl+1,K,1)-r%EXSY1(I,1,K))
    g%E(I,g%nygh,K,1)=r%EXSY1(I,3,K)+r%CD*(g%E(I,g%nyyh,K,1)-r%EXSY1(I,4,K))
  ENDDO

  !NOW DO 2ND ORDER ORBC ON REMAINING PORTIONS OF FACES
    DO K=g%nzl+2,g%nzyh-1,1
      DO I=g%nxl+1,g%nxyh-1,1
        g%E(I,g%nyl,K,1)=     - r%EXSY2(I,2,K)+r%CD*(g%E(I,g%nyl+1,K,1)+r%EXSY2(I,1,K))  &
                        + r%CXDD*(r%EXSY1(I,1,K)+r%EXSY1(I,2,K))                         &
                        + r%CFDD*(r%EXSY1(I+1,1,K)-2.0d0*r%EXSY1(I,1,K)+r%EXSY1(I-1,1,K) &
                        + r%EXSY1(I+1,2,K)-2.0d0*r%EXSY1(I,2,K)+r%EXSY1(I-1,2,K))        &
                        + r%CFDD*(r%EXSY1(I,1,K+1)-2.0d0*r%EXSY1(I,1,K)+r%EXSY1(I,1,K-1) &
                        + r%EXSY1(I,2,K+1)-2.0d0*r%EXSY1(I,2,K)+r%EXSY1(I,2,K-1))

        g%E(I,g%nygh,K,1)=    - r%EXSY2(I,3,K)+r%CD*(g%E(I,g%nyyh,K,1)+r%EXSY2(I,4,K))   &
                        + r%CXDD*(r%EXSY1(I,4,K)+r%EXSY1(I,3,K))                         &
                        + r%CFDD*(r%EXSY1(I+1,4,K)-2.0d0*r%EXSY1(I,4,K)+r%EXSY1(I-1,4,K) &
                        + r%EXSY1(I+1,3,K)-2.0d0*r%EXSY1(I,3,K)+r%EXSY1(I-1,3,K))        &
                        + r%CFDD*(r%EXSY1(I,4,K+1)-2.0d0*r%EXSY1(I,4,K)+r%EXSY1(I,4,K-1) &
                        + r%EXSY1(I,3,K+1)-2.0d0*r%EXSY1(I,3,K)+r%EXSY1(I,3,K-1))
    ENDDO
  ENDDO

  !NOW SAVE PAST VALUES
  DO K=g%nzl+1,g%nzyh,1
    DO I=g%nxl,g%nxyh,1
      r%EXSY2(I,1,K)=r%EXSY1(I,1,K)
      r%EXSY2(I,2,K)=r%EXSY1(I,2,K)
      r%EXSY2(I,3,K)=r%EXSY1(I,3,K)
      r%EXSY2(I,4,K)=r%EXSY1(I,4,K)
      r%EXSY1(I,1,K)=g%E(I,g%nyl,K,1)
      r%EXSY1(I,2,K)=g%E(I,g%nyl+1,K,1)
      r%EXSY1(I,3,K)=g%E(I,g%nyyh,K,1)
      r%EXSY1(I,4,K)=g%E(I,g%nygh,K,1)
    ENDDO
  ENDDO

END SUBROUTINE mur_2_Exy

SUBROUTINE mur_2_Exz(g, r)

  TYPE(gitter), INTENT(INOUT)      :: g
  TYPE(MurBound), INTENT(INOUT)    :: r
  INTEGER                          :: I,J,K

  !DO EDGES WITH FIRST ORDER ORBC
  DO J=g%nyl+1,g%nyyh,1
    I=g%nxl
    g%E(I,J,g%nzl,1)=r%EXSZ1(I,J,2)+r%CD*(g%E(I,J,g%nzl+1,1)-r%EXSZ1(I,J,1))
    g%E(I,J,g%nzgh,1)=r%EXSZ1(I,J,3)+r%CD*(g%E(I,J,g%nzyh,1)-r%EXSZ1(I,J,4))
    I=g%nxyh
    g%E(I,J,g%nzl,1)=r%EXSZ1(I,J,2)+r%CD*(g%E(I,J,g%nzl+1,1)-r%EXSZ1(I,J,1))
    g%E(I,J,g%nzgh,1)=r%EXSZ1(I,J,3)+r%CD*(g%E(I,J,g%nzyh,1)-r%EXSZ1(I,J,4))
  ENDDO

  DO I=g%nxl+1,g%nxyh-1,1
    J=g%nyl+1
    g%E(I,J,g%nzl,1)=r%EXSZ1(I,J,2)+r%CD*(g%E(I,J,g%nzl+1,1)-r%EXSZ1(I,J,1))
    g%E(I,J,g%nzgh,1)=r%EXSZ1(I,J,3)+r%CD*(g%E(I,J,g%nzyh,1)-r%EXSZ1(I,J,4))
    J=g%nyyh
    g%E(I,J,g%nzl,1)=r%EXSZ1(I,J,2)+r%CD*(g%E(I,J,g%nzl+1,1)-r%EXSZ1(I,J,1))
    g%E(I,J,g%nzgh,1)=r%EXSZ1(I,J,3)+r%CD*(g%E(I,J,g%nzyh,1)-r%EXSZ1(I,J,4))
  ENDDO

  !NOW DO 2ND ORDER ORBC ON REMAINING PORTIONS OF FACES
  DO J=g%nyl+2,g%nyyh-1,1
    DO I=g%nxl+1,g%nxyh-1,1
      g%E(I,J,g%nzl,1)= - r%EXSZ2(I,J,2)+r%CD*(g%E(I,J,g%nzl+1,1)+r%EXSZ2(I,J,1))        &
                        + r%CXDD*(r%EXSZ1(I,J,1)+r%EXSZ1(I,J,2))                         &
                        + r%CFDD*(r%EXSZ1(I+1,J,1)-2.0d0*r%EXSZ1(I,J,1)+r%EXSZ1(I-1,J,1) &
                        + r%EXSZ1(I+1,J,2)-2.0d0*r%EXSZ1(I,J,2)+r%EXSZ1(I-1,J,2))        &
                        + r%CFDD*(r%EXSZ1(I,J+1,1)-2.0d0*r%EXSZ1(I,J,1)+r%EXSZ1(I,J-1,1) &
                        + r%EXSZ1(I,J+1,2)-2.0d0*r%EXSZ1(I,J,2)+r%EXSZ1(I,J-1,2))

      g%E(I,J,g%nzgh,1)=- r%EXSZ2(I,J,3)+r%CD*(g%E(I,J,g%nzyh,1)+r%EXSZ2(I,J,4))         &
                        + r%CXDD*(r%EXSZ1(I,J,4)+r%EXSZ1(I,J,3))                         &
                        + r%CFDD*(r%EXSZ1(I+1,J,4)-2.0d0*r%EXSZ1(I,J,4)+r%EXSZ1(I-1,J,4) &
                        + r%EXSZ1(I+1,J,3)-2.0d0*r%EXSZ1(I,J,3)+r%EXSZ1(I-1,J,3))        &
                        + r%CFDD*(r%EXSZ1(I,J+1,4)-2.0d0*r%EXSZ1(I,J,4)+r%EXSZ1(I,J-1,4) &
                        + r%EXSZ1(I,J+1,3)-2.0d0*r%EXSZ1(I,J,3)+r%EXSZ1(I,J-1,3))  
    ENDDO
  ENDDO

  !NOW SAVE PAST VALUES
  DO J=g%nyl+1,g%nyyh,1
    DO I=g%nxl,g%nxyh,1
      r%EXSZ2(I,J,1)=r%EXSZ1(I,J,1)
      r%EXSZ2(I,J,2)=r%EXSZ1(I,J,2)
      r%EXSZ2(I,J,3)=r%EXSZ1(I,J,3)
      r%EXSZ2(I,J,4)=r%EXSZ1(I,J,4)
      r%EXSZ1(I,J,1)=g%E(I,J,g%nzl,1)
      r%EXSZ1(I,J,2)=g%E(I,J,g%nzl+1,1)
      r%EXSZ1(I,J,3)=g%E(I,J,g%nzyh,1)
      r%EXSZ1(I,J,4)=g%E(I,J,g%nzgh,1)
    ENDDO
  ENDDO

END SUBROUTINE mur_2_Exz

SUBROUTINE mur_2_Eyz(g, r)

  TYPE(gitter), INTENT(INOUT)      :: g
  TYPE(MurBound), INTENT(INOUT)    :: r
  INTEGER                          :: I,J,K

  !DO EDGES WITH FIRST ORDER ORBC
  DO J=g%nyl,g%nyyh,1
    I=g%nxl+1
    g%E(I,J,g%nzl,2)=r%EYSZ1(I,J,2)+r%CD*(g%E(I,J,g%nzl+1,2)-r%EYSZ1(I,J,1))
    g%E(I,J,g%nzgh,2)=r%EYSZ1(I,J,3)+r%CD*(g%E(I,J,g%nzyh,2)-r%EYSZ1(I,J,4))
    I=g%nxyh
    g%E(I,J,g%nzl,2)=r%EYSZ1(I,J,2)+r%CD*(g%E(I,J,g%nzl+1,2)-r%EYSZ1(I,J,1))
    g%E(I,J,g%nzgh,2)=r%EYSZ1(I,J,3)+r%CD*(g%E(I,J,g%nzyh,2)-r%EYSZ1(I,J,4))
  ENDDO

  DO I=g%nxl+2,g%nxyh-1,1
    J=g%nyl
    g%E(I,J,g%nzl,2)=r%EYSZ1(I,J,2)+r%CD*(g%E(I,J,g%nzl+1,2)-r%EYSZ1(I,J,1))
    g%E(I,J,g%nzgh,2)=r%EYSZ1(I,J,3)+r%CD*(g%E(I,J,g%nzyh,2)-r%EYSZ1(I,J,4))
    J=g%nyyh
    g%E(I,J,g%nzl,2)=r%EYSZ1(I,J,2)+r%CD*(g%E(I,J,g%nzl+1,2)-r%EYSZ1(I,J,1))
    g%E(I,J,g%nzgh,2)=r%EYSZ1(I,J,3)+r%CD*(g%E(I,J,g%nzyh,2)-r%EYSZ1(I,J,4))
  ENDDO

  !NOW DO 2ND ORDER ORBC ON REMAINING PORTIONS OF FACES
  DO J=g%nyl+1,g%nyyh-1,1
    DO I=g%nxl+2,g%nxyh-1,1
      g%E(I,J,g%nzl,2)= - r%EYSZ2(I,J,2)+r%CD*(g%E(I,J,g%nzl+1,2)+r%EYSZ2(I,J,1))        &
                        + r%CXDD*(r%EYSZ1(I,J,1)+r%EYSZ1(I,J,2))                         &
                        + r%CFDD*(r%EYSZ1(I+1,J,1)-2.0d0*r%EYSZ1(I,J,1)+r%EYSZ1(I-1,J,1) &
                        + r%EYSZ1(I+1,J,2)-2.0d0*r%EYSZ1(I,J,2)+r%EYSZ1(I-1,J,2))        &
                        + r%CFDD*(r%EYSZ1(I,J+1,1)-2.0d0*r%EYSZ1(I,J,1)+r%EYSZ1(I,J-1,1) &
                        + r%EYSZ1(I,J+1,2)-2.0d0*r%EYSZ1(I,J,2)+r%EYSZ1(I,J-1,2)) 

      g%E(I,J,g%nzgh,2)= - r%EYSZ2(I,J,3)+r%CD*(g%E(I,J,g%nzyh,2)+r%EYSZ2(I,J,4))         &
                         + r%CXDD*(r%EYSZ1(I,J,4)+r%EYSZ1(I,J,3))                         &
                         + r%CFDD*(r%EYSZ1(I+1,J,4)-2.0d0*r%EYSZ1(I,J,4)+r%EYSZ1(I-1,J,4) &
                         + r%EYSZ1(I+1,J,3)-2.0d0*r%EYSZ1(I,J,3)+r%EYSZ1(I-1,J,3))        &
                         + r%CFDD*(r%EYSZ1(I,J+1,4)-2.0d0*r%EYSZ1(I,J,4)+r%EYSZ1(I,J-1,4) &
                         + r%EYSZ1(I,J+1,3)-2.0d0*r%EYSZ1(I,J,3)+r%EYSZ1(I,J-1,3))
    ENDDO
  ENDDO

  !NOW SAVE PAST VALUES
  DO J=g%nyl,g%nyyh,1
    DO I=g%nxl+1,g%nxyh,1
      r%EYSZ2(I,J,1)=r%EYSZ1(I,J,1)
      r%EYSZ2(I,J,2)=r%EYSZ1(I,J,2)
      r%EYSZ2(I,J,3)=r%EYSZ1(I,J,3)
      r%EYSZ2(I,J,4)=r%EYSZ1(I,J,4)
      r%EYSZ1(I,J,1)=g%E(I,J,g%nzl,2)
      r%EYSZ1(I,J,2)=g%E(I,J,g%nzl+1,2)
      r%EYSZ1(I,J,3)=g%E(I,J,g%nzyh,2)
      r%EYSZ1(I,J,4)=g%E(I,J,g%nzgh,2)
    ENDDO
  ENDDO

END SUBROUTINE mur_2_Eyz

END MODULE mur