Scrambler  1
interfaces.f90
Go to the documentation of this file.
00001 !#########################################################################
00002 !               
00003 !    Copyright (C) 2003-2012 Department of Physics and Astronomy,
00004 !                            University of Rochester,
00005 !                            Rochester, NY
00006 !
00007 !    interfaces.f90 is part of AstroBEAR.
00008 !
00009 !    AstroBEAR is free software: you can redistribute it and/or modify    
00010 !    it under the terms of the GNU General Public License as published by 
00011 !    the Free Software Foundation, either version 3 of the License, or    
00012 !    (at your option) any later version.
00013 !
00014 !    AstroBEAR is distributed in the hope that it will be useful, 
00015 !    but WITHOUT ANY WARRANTY; without even the implied warranty of
00016 !    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
00017 !    GNU General Public License for more details.
00018 !
00019 !    You should have received a copy of the GNU General Public License
00020 !    along with AstroBEAR.  If not, see <http://www.gnu.org/licenses/>.
00021 !
00022 !#########################################################################
00025 
00029 
00032 MODULE Interfaces
00033    USE GlobalDeclarations
00034    IMPLICIT NONE
00036    TYPE InterfaceDef      
00037      REAL(KIND=qPREC) :: position(3)=(/0,0,0/)
00038      REAL(KIND=qPREC) :: RotationMatrix(3,3)=RESHAPE((/1d0,0d0,0d0,0d0,1d0,0d0,0d0,0d0,1d0/),(/3,3/))    !Rotates lab frame into object frame
00039      REAL(KIND=qPREC), ALLOCATABLE, DIMENSION(:,:) :: WaveVector
00040      REAL(KIND=qPREC), ALLOCATABLE, DIMENSION(:) :: amplitude
00041      REAL(KIND=qPREC), ALLOCATABLE, DIMENSION(:) :: phase
00042      REAL(KIND=qPREC) :: HalfWidth=1e30
00043      INTEGER :: nWaves=0
00044      INTEGER :: iWaves=0
00045      INTEGER :: ObjId
00046    END TYPE InterfaceDef
00047 
00048 CONTAINS
00049 
00050   SUBROUTINE CreateInterface(InterfaceObj,theta,phi)
00051     TYPE(InterfaceDef), POINTER :: InterfaceObj
00052     REAL(KIND=qPREC), OPTIONAL :: theta,phi
00053     ALLOCATE(InterfaceObj)
00054     IF(Present(theta) .AND. Present(phi)) THEN
00055         CALL SetInterfaceOrientation(InterfaceObj, theta,phi)
00056     ENDIF
00057   END SUBROUTINE  CreateInterface
00058 
00059   SUBROUTINE UpdateInterface(InterfaceObj)
00060     TYPE(InterfaceDef), POINTER :: InterfaceObj
00061     !update attributes that needs to be updated, if any
00062   END SUBROUTINE UpdateInterface
00063 
00064    SUBROUTINE SetInterfaceOrientation(InterfaceObj, theta, phi)
00065       TYPE(InterfaceDef), POINTER :: InterfaceObj
00066       REAL(KIND=qPREC) :: c2,c3,s2,s3,theta,phi
00067       c2=cos(theta)
00068       c3=cos(phi)
00069       s2=sin(theta)
00070       s3=sin(phi)      
00071       InterfaceObj%RotationMatrix=RESHAPE((/ &
00072            c2*c3, -s3, +c3*s2,&
00073            c2*s3, c3, s2*s3, &
00074            -s2, 0d0, c2/),(/3,3/),(/0d0/),(/2,1/))
00075    END SUBROUTINE SetInterfaceOrientation
00076 
00077    SUBROUTINE InitInterfaceWaves(InterfaceObj, nWaves)
00078       TYPE(InterfaceDef), POINTER :: InterfaceObj
00079       INTEGER :: nWaves
00080       IF (nWaves == 0) RETURN
00081       ALLOCATE(InterfaceObj%WaveVector(nWaves,2), InterfaceObj%amplitude(nWaves), InterfaceObj%Phase(nWaves))
00082       InterfaceObj%iWaves=0
00083       InterfaceObj%nWaves=nWaves
00084    END SUBROUTINE InitInterfaceWaves
00085 
00086    SUBROUTINE AddInterfaceWave(InterfaceObj, wavevector, phase, amplitude)      
00087       TYPE(InterfaceDef), POINTER :: InterfaceObj
00088       REAL(KIND=qPREC), DIMENSION(2) :: wavevector
00089       REAL(KIND=qPREC) :: phase, amplitude
00090       INTEGER :: iwaves
00091       iwaves=InterfaceObj%iwaves+1
00092       InterfaceObj%iwaves=iwaves
00093       InterfaceObj%WaveVector(iwaves,:)=wavevector
00094       InterfaceObj%phase(iwaves)=phase
00095       InterfaceObj%amplitude(iwaves)=amplitude
00096    END SUBROUTINE AddInterfaceWave
00097       
00098    SUBROUTINE DestroyInterface(InterfaceObj)
00099       TYPE(InterfaceDef), POINTER :: InterfaceObj
00100       IF (ALLOCATED(InterfaceObj%WaveVector)) DEALLOCATE(InterfaceObj%WaveVector)
00101       IF (ALLOCATED(InterfaceObj%Amplitude)) DEALLOCATE(InterfaceObj%Amplitude)
00102       IF (ALLOCATED(InterfaceObj%Phase)) DEALLOCATE(InterfaceObj%Phase)
00103       DEALLOCATE(InterfaceObj)
00104       NULLIFY(InterfaceObj)
00105    END SUBROUTINE DestroyInterface
00106 
00107    FUNCTION IsAboveInterface(InterfaceObj, pos, dist)
00108      TYPE(InterfaceDef), POINTER :: InterfaceObj
00109      REAL(KIND=qPREC), DIMENSION(3) :: pos, coords
00110      REAL(KIND=qPREC) :: z
00111      REAL(KIND=qPREC), OPTIONAL :: dist
00112      LOGICAL :: IsAboveInterface
00113      INTEGER :: l,i
00114      DO l=1,3
00115         coords(l)=SUM(InterfaceObj%RotationMatrix(:,l)*(pos(:)-InterfaceObj%position(:))) !Inverse rotation
00116      END DO
00117      IF (coords(3) > InterfaceObj%HalfWidth) THEN
00118         IsAboveInterface=.true.
00119      ELSEIF (coords(3) < -InterfaceObj%HalfWidth) THEN
00120         IsAboveInterface=.false.
00121      ELSE
00122         z=0         
00123         DO i=1,InterfaceObj%nWaves
00124            z=z+InterfaceObj%amplitude(i)*cos(SUM(InterfaceObj%WaveVector(i,:)*coords(1:2))+InterfaceObj%Phase(i))
00125         END DO
00126         IsAboveInterface=coords(3)>z
00127      END IF
00128      IF (Present(dist)) dist=abs(coords(3)-z)
00129   END FUNCTION IsAboveInterface
00130 
00131 
00132   FUNCTION DistanceToInterface(InterfaceObj, pos)
00133      TYPE(InterfaceDef), POINTER :: InterfaceObj
00134      REAL(KIND=qPREC), DIMENSION(3) :: pos, coords
00135      REAL(KIND=qPREC) :: z
00136      REAL(KIND=qPREC) :: DistanceToInterface
00137      INTEGER :: l,i
00138      DO l=1,3
00139         coords(l)=SUM(InterfaceObj%RotationMatrix(:,l)*(pos(:)-InterfaceObj%position(:))) !Inverse rotation
00140      END DO
00141      z=0         
00142      DO i=1,InterfaceObj%nWaves
00143         z=z+InterfaceObj%amplitude(i)*cos(SUM(InterfaceObj%WaveVector(i,:)*coords(1:2))+InterfaceObj%Phase(i))
00144      END DO
00145      DistanceToInterface=abs(coords(3)-z)
00146      
00147    END FUNCTION DistanceToInterface
00148 
00149 END MODULE Interfaces
00150 
 All Classes Files Functions Variables