Commit 83d9fef2 authored by Yann CAPDEVILLE's avatar Yann CAPDEVILLE
Browse files

work in progress

parent af41271c
......@@ -435,21 +435,20 @@ contains
end subroutine write_receivers
!-------------------------------------------------------------------------
!-------------------------------------------------
subroutine set_rcv_coord(rc)
subroutine set_rcv_coord()
!-------------------------------------------------
use def_gparam
implicit none
type(receivers), intent(inout) :: rc
!
rc%rec_coord(:,:)=rc%coord(:,:)
rcv%rec_coord(:,:)=rcv%coord(:,:)
if (geoc_corr) &
rc%rec_coord(2,:)=rad2deg*(PI/2.d0-atan(GEOC*tan((PI/2.d0- &
rc%rec_coord(2,:)/rad2deg))))
rcv%rec_coord(2,:)=rad2deg*(PI/2.d0-atan(GEOC*tan((PI/2.d0- &
rcv%rec_coord(2,:)/rad2deg))))
!on transforme les degres en radian
rc%rec_coord(2:3,:)=rc%rec_coord(2:3,:)*deg2rad
rcv%rec_coord(2:3,:)=rcv%rec_coord(2:3,:)*deg2rad
if (.not.hsrc) then
allocate(rc%mb%rad(rc%mb%NBRR)) !NBRR should be 1 here
rc%mb%rad(1)=RA
allocate(rcv%mb%rad(rcv%mb%NBRR)) !NBRR should be 1 here
rcv%mb%rad(1)=RA
endif
!------------------------------------------------------------------------
end subroutine set_rcv_coord
......@@ -470,29 +469,28 @@ contains
end function M0
!-------------------------------------------------------------------------
!-------------------------------------------------------------------------
subroutine set_src_coord(sc)
subroutine set_src_coord()
!-------------------------------------------------------------------------
implicit none
type(sources), intent(inout) :: sc
integer :: i,j
!
if (RA<0.d0) STOP 'load_source: RA is not initialized!'
if (srcinv.or.hsrc) then
!already in radius and meters
sc%src_coord(1,:)=src%coord(1,:)
src%src_coord(1,:)=src%coord(1,:)
else
!conversion profondeur (en km)->rayon (en m)
sc%src_coord(1,:)=RA-src%src_coord(1,:)*1000.d0
src%src_coord(1,:)=RA-src%coord(1,:)*1000.d0
allocate(src%mb%rad(src%mb%NBRR))
src%mb%rad(:)=sc%src_coord(1,:)
src%mb%rad(:)=src%src_coord(1,:)
endif
sc%src_coord(2:,:)=src%src_coord(2:,:)
sc%Msrc =sc%Mtmp
src%src_coord(2:,:)=src%coord(2:,:)
src%Msrc =src%Mtmp
if (geoc_corr) &
sc%src_coord(2,:)=rad2deg*(PI/2.d0-atan(GEOC*tan((PI/2.d0- &
sc%src_coord(2,:)/rad2deg))))
src%src_coord(2,:)=rad2deg*(PI/2.d0-atan(GEOC*tan((PI/2.d0- &
src%src_coord(2,:)/rad2deg))))
!passage en radian
sc%src_coord(2:3,:)=sc%src_coord(2:3,:)*deg2rad
src%src_coord(2:3,:)=src%src_coord(2:3,:)*deg2rad
!
!-------------------------------------------------------------------------
end subroutine set_src_coord
......
......@@ -115,8 +115,8 @@ contains
print*,'Opening eigenfunction files ...'
call open_fctp(eigenfileS,eigenfileT,rad_recepteur=receiver_rad)
!RA is now initialized
call set_src_coord(src)
call set_rcv_coord(rcv)
call set_src_coord()
call set_rcv_coord()
scale2=1.D0/(rhobar*RA*RA*RA)
scale1=scale2/RA/RA
!
......@@ -1409,6 +1409,7 @@ contains
ts=src%src_coord(2,is)
ps=src%src_coord(3,is)
call euler(ts,ps,tr,pr,asr,bsr,gsr)
! print*,'coucou ',ts*rad2deg,ps*rad2deg,tr*rad2deg,pr*rad2deg,bsr*rad2deg
do bNp=-2,2
x=bNp*gsr
csd(bNp)=dcmplx(dcos(x),dsin(x))
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment