55a56 > c MOB : NUmber of Observation Points 60c61,62 < PARAMETER(MOM=531) --- > PARAMETER(MOM=531,MOB=51) > COMPLEX*16 GX(MOM,MOB),GY(MOM,MOB),GZ(MOM,MOB) 76c78 < CALL INDAT(MOM) --- > CALL INDAT(MOM,MOB) 78c80,81 < CALL HKQVW(MOM) --- > CALL HKQVW(MOM,MOB,GX,GY,GZ) > CALL OTDAT(MOM,MOB,GX,GY,GZ) 80c83 < WRITE(*,*)'Use "grfftbx1.f" for FFT' --- > WRITE(*,*)'Use "grfftp.f" for FFT' 88c91 < SUBROUTINE INDAT(MOM) --- > SUBROUTINE INDAT(MOM,MOB) 93,94c96 < COMMON /FREQ/DOM,IOM,NOM,OMI < * /BOX/BOXX,BOXY,BOXZ,NBOXX,NBOXY,NBOXZ,NOB --- > COMMON /FREQ/DOM,IOM,NOM,OMI /OBS/XO(51),YO(51),ZO(51),NOB 105a108 > NMOB=51 106a110 > IF(MOB.LT.NMOB)NMOB=MOB 332c336,341 < open(9,file='obs_dat',status='unknown') --- > IF(NOB.GT.NMOB)THEN > WRITE(10,*)' NOB>NMOB !!!!!!!!!!!!!' > STOP > END IF > C > iob=1 339,340c348,352 < write(10,2750)iob,X,Y,Z < write(9,2760)x,y,z --- > XO(iob)=X > YO(iob)=Y > ZO(iob)=Z > write(10,2750)iob,XO(iob),YO(iob),ZO(iob) > iob=iob+1 345,346d356 < 2760 format(3f12.4) < close(9) 365a376,381 > c > open(9,file='obs_dat',status='unknown') > do i=1,nob > write(9,9500)xo(i),yo(i),zo(i) > end do > close(9) 459a476,568 > C > C *** DATA OUTPUT *** > C > SUBROUTINE OTDAT(MOM,MOB,GX,GY,GZ) > C > IMPLICIT REAL*8(A-H,O-Z) > COMPLEX*16 VP,VS,GX(MOM,MOB),GY(MOM,MOB),GZ(MOM,MOB),AA,CC > COMMON /FREQ/DOM,IOM,NOM,OMI /OBS/XO(51),YO(51),ZO(51),NOB > * /STRC/DNS(20),VP(20),VS(20),THK(20),NL > * /FLT/STR,DIP,RAK(203,9),FL,FW,VR,FD(203,9),RT(2,9),TWI > * ,xflt,yflt,zflt,delay > * /IFLT/NF,NTW,IS,ngauss,ndip,nstr,iramp > * /SIGN/ISIGN /Hypo/xhypo,yhypo,zhypo > > C > C *** CHECK *** > C > NC=20 > IF(NL.GT.NC)THEN > WRITE(10,*)'FROM OTDAT:NL>NC',NL,NC > STOP > END IF > C > NC=51 > IF(NOB.GT.NC)THEN > WRITE(10,*)'FROM OTDAT:NOB>NC',NOB,NC > STOP > END IF > C > NC=203 > IF(NF.GT.NC)THEN > WRITE(10,*)'FROM OTDAT:NF>NC',NF,NC > STOP > END IF > C > C *** OUTPUT OF DATA (GX, GY AND GZ)*** > C > IF(ISIGN.EQ.1)THEN > DO 100 IOB=1,NOB > DO 110 K=IOM,NOM > GX(K,IOB)=DCMPLX(DREAL(GX(K,IOB)),-DIMAG(GX(K,IOB))) > GY(K,IOB)=DCMPLX(DREAL(GY(K,IOB)),-DIMAG(GY(K,IOB))) > GZ(K,IOB)=DCMPLX(DREAL(GZ(K,IOB)),-DIMAG(GZ(K,IOB))) > 110 CONTINUE > 100 CONTINUE > END IF > C > OPEN(UNIT=8,FILE='grfault.dxyz',STATUS='UNKNOWN') > WRITE(8,2500)DOM,IOM,NOM,OMI > WRITE(8,2510)NOB > DO 500 IOB=1,NOB > DO 510 K=IOM,NOM > WRITE(8,2520)GX(K,IOB),GY(K,IOB),GZ(K,IOB) > 510 CONTINUE > 500 CONTINUE > CLOSE(8) > C > 2500 FORMAT(1X,F10.6,2I10,F10.7) > 2510 FORMAT(1X,I10,///) > 2520 FORMAT(1X,6E12.5) > C > C *** OUTPUT OF DATA (GQ, GV AND GW)*** > C > DO 600 IOB=1,NOB > RX=XO(IOB)-xhypo > RY=YO(IOB)-yhypo > RR=DSQRT(RX*RX+RY*RY) > CR=RX/RR > SR=RY/RR > DO 610 K=IOM,NOM > AA=GX(K,IOB) > CC=GY(K,IOB) > GX(K,IOB)= AA*CR+CC*SR > GY(K,IOB)=-AA*SR+CC*CR > 610 CONTINUE > 600 CONTINUE > C > OPEN(8,FILE='grfault.dqvw',STATUS='UNKNOWN') > WRITE(8,3500)DOM,IOM,NOM,OMI > WRITE(8,3510)NOB > DO 800 IOB=1,NOB > DO 810 K=IOM,NOM > WRITE(8,3520)GX(K,IOB),GY(K,IOB),GZ(K,IOB) > 810 CONTINUE > 800 CONTINUE > CLOSE(8) > C > 3500 FORMAT(1X,F10.6,2I10,F10.7) > 3510 FORMAT(1X,I10,///) > 3520 FORMAT(1X,6E12.5) > C > RETURN > END 684c793 < SUBROUTINE HKQVW(MOM) --- > SUBROUTINE HKQVW(MOM,MOB,GGX,GGY,GGZ) 688c797 < * ,GGX,GGY,GGZ,VS2,VP2,OM,im --- > * ,GGX(MOM,MOB),GGY(MOM,MOB),GGZ(MOM,MOB),VS2,VP2 693c802 < * ,WX(0:3),WY(0:3),WZ(0:3),UX(3,3),UY(3,3),UZ(3,3) --- > * ,WX(0:3),WY(0:3),WZ(0:3),UX(3,3),UY(3,3),UZ(3,3),OM,im 695,696c804 < COMMON /FREQ/DOM,IOM,NOM,OMI < * /BOX/BOXX,BOXY,BOXZ,NBOXX,NBOXY,NBOXZ,NOB --- > COMMON /FREQ/DOM,IOM,NOM,OMI /OBS/XO(51),YO(51),ZO(51),NOB 701c809 < * /SIGN/ISIGN /Hypo/xhypo,yhypo,zhypo --- > * /Hypo/xhypo,yhypo,zhypo 745a854,867 > NC=51 > IF(NOB.GE.NC)THEN > WRITE(10,*)' FROM HKQVW:NOB>NC !!!!!!!!!!' > WRITE(10,*)' NOB,NC=',NOB,NC > STOP > END IF > C > NC=MOB > IF(NOB.GE.NC)THEN > WRITE(10,*)' FROM HKQVW:NOB>MOB !!!!!!!!!!' > WRITE(10,*)' NOB,NC=',NOB,MOB > STOP > END IF > C 754,761d875 < C < OPEN(UNIT=8,FILE='grbox.dxyz',STATUS='UNKNOWN') < WRITE(8,2500)DOM,IOM,NOM,OMI < WRITE(8,2510)NOB,NBOXX,NBOXY,NBOXZ < WRITE(8,2520)BOXX,BOXY,BOXZ < 2500 FORMAT(1X,F10.6,2I10,F10.7) < 2510 FORMAT(1X,4I10) < 2520 FORMAT(1X,3F10.2//) 844,849c958 < do 220 kob=1,NBOXZ*2+1 < ZO=(kob-1)*BOXZ/2.d0 < do 210 job=1,NBOXY*2+1 < YO=(job-1)*BOXY/2.d0 < do 200 iob=1,NBOXX*2+1 < XO=(iob-1)*BOXX/2.d0 --- > DO 200 IOB=1,NOB 851,853c960,962 < GGX=(0.D0,0.D0) < GGY=(0.D0,0.D0) < GGZ=(0.D0,0.D0) --- > GGX(IO,IOB)=(0.D0,0.D0) > GGY(IO,IOB)=(0.D0,0.D0) > GGZ(IO,IOB)=(0.D0,0.D0) 855c964 < ZS=ZO --- > ZS=ZO(IOB) 857c966 < if(zs.eq.zo1)goto 10 --- > if(zs.eq.zo(iob-1))goto 10 862c971 < DO 230 L=1,NL --- > DO 220 L=1,NL 867c976 < 230 CONTINUE --- > 220 CONTINUE 870c979 < DO 240 L=1,LS-1 --- > DO 230 L=1,LS-1 872c981 < 240 CONTINUE --- > 230 CONTINUE 1052,1053c1161,1162 < RX=XF-XO < RY=YF-YO --- > RX=XF-XO(IOB) > RY=YF-YO(IOB) 1215,1217c1324,1326 < GGX=GGX+GX0 < GGY=GGY+GY0 < GGZ=GGZ+GZ0 --- > GGX(IO,IOB)=GGX(IO,IOB)+GX0 > GGY(IO,IOB)=GGY(IO,IOB)+GY0 > GGZ(IO,IOB)=GGZ(IO,IOB)+GZ0 1226,1233d1334 < c < IF(ISIGN.EQ.1)THEN < GGX=DCMPLX(DREAL(GGX),-DIMAG(GGX)) < GGY=DCMPLX(DREAL(GGY),-DIMAG(GGY)) < GGZ=DCMPLX(DREAL(GGZ),-DIMAG(GGZ)) < END IF < WRITE(8,2550)GGX,GGY,GGZ < 2550 FORMAT(1X,6E12.5) 1236,1238d1336 < 210 CONTINUE < ZO1=ZO < 220 CONTINUE 1242,1243d1339 < CLOSE(8) < c