Scrambler
1
|
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