quelle.f90

Sfdtd Simple finite-difference time-domain

! quelle.f90
!
!    Copyright (C) 2007  Paul Panserrieu, < [e-mail] >
!
!    This program is free software: you can redistribute it and/or modify
!    it under the terms of the GNU General Public License as published by
!    the Free Software Foundation, either version 3 of the License.
! 
! last modified: 01-08-2007 04:52:02 PM CEST

MODULE quelle

USE fdtd_gitter

IMPLICIT NONE

CONTAINS

SUBROUTINE init_dipol(d, frequenz, edit_dipol)

  TYPE(dipol), INTENT(INOUT)                :: d
  DOUBLE PRECISION, INTENT(IN)              :: frequenz
  INTEGER, INTENT(IN)                       :: edit_dipol            

  ! Standardeinstellung des Dipols: Position und Amplitude 
  IF (edit_dipol .EQ. 0) THEN
    d%px=0; d%py=0; d%pz=0; d%phi=0.0d0; d%E(:)=(/ 0.0d0, 0.0d0, 1.0d0 /) 
  ENDIF
  d%omega=2.0d0*PI*frequenz
 
END SUBROUTINE init_dipol

SUBROUTINE update_quelle(g, d, t, max_t, model)

  TYPE(gitter), INTENT(INOUT)              :: g
  TYPE(dipol), INTENT(IN)                  :: d
  INTEGER, INTENT(IN)                      :: t
  INTEGER, INTENT(IN)                      :: max_t
  INTEGER, INTENT(IN)                      :: model

  IF (t <= max_t) THEN
    SELECT CASE (model)
    CASE(1)
      CALL hard_cos(g, d, t)
    CASE(2)
      CALL hard_sin(g, d, t)
    CASE(3)
      CALL hard_mix(g, d, t)
    CASE DEFAULT
      WRITE(*,*) "update_quelle(): falscher Stimulus"
    END SELECT
  ENDIF

END SUBROUTINE update_quelle

SUBROUTINE hard_cos(g, d, t)

  TYPE(gitter), INTENT(INOUT)              :: g
  TYPE(dipol), INTENT(IN)                  :: d
  INTEGER, INTENT(IN)                      :: t
  INTEGER                                  :: i

  DO i = 1, 3, 1
    IF(d%E(i) .NE. 0.0d0) THEN
      g%E(d%px,d%py,d%pz,i) = DCOS(d%omega*g%dt*DBLE(t)+d%phi)*d%E(i)
    ENDIF
  ENDDO

END SUBROUTINE hard_cos

SUBROUTINE hard_sin(g, d, t)

  TYPE(gitter), INTENT(INOUT)              :: g
  TYPE(dipol), INTENT(IN)                  :: d
  INTEGER, INTENT(IN)                      :: t
  INTEGER                                  :: i

  DO i = 1, 3, 1
    IF(d%E(i) .NE. 0.0d0) THEN
      g%E(d%px,d%py,d%pz,i) = DSIN(d%omega*g%dt*DBLE(t)+d%phi)*d%E(i)
    ENDIF
  ENDDO

END SUBROUTINE hard_sin

SUBROUTINE hard_mix(g, d, t)

  TYPE(gitter), INTENT(INOUT)              :: g
  TYPE(dipol), INTENT(IN)                  :: d
  INTEGER, INTENT(IN)                      :: t
  INTEGER                                  :: i

  DO i = 1, 3, 1
    IF(d%E(i) .NE. 0.0d0) THEN
      g%E(d%px,d%py,d%pz,i) = DSIN(d%omega*g%dt*DBLE(t)+d%phi)                     &
                            * (1.0d0 - DCOS(d%omega*g%dt*DBLE(t)+d%phi))*d%E(i)
    ENDIF
  ENDDO

END SUBROUTINE hard_mix

END MODULE quelle