! quelle.f90!!    Copyright (C) 2007  Paul Panserrieu, < peutetre@cs.tu-berlin.de >!!    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 CESTMODULE quelleUSE fdtd_gitterIMPLICIT NONECONTAINSSUBROUTINE 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_dipolSUBROUTINE 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  ENDIFEND SUBROUTINE update_quelleSUBROUTINE 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  ENDDOEND SUBROUTINE hard_cosSUBROUTINE 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  ENDDOEND SUBROUTINE hard_sinSUBROUTINE 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  ENDDOEND SUBROUTINE hard_mixEND MODULE quelle