c---The eismont software is used to make transformation c---from SC r.f. to the GSE integer*2 year1,year2, month1,month2,day1,day2 integer*2 yearp,dayp,monthp integer*2 nump integer*1 ok real sec1,sec2,delp,secp integer*2 UT_mf(8),UT_buf(8) real Bsc(3),Bgse(3) double precision timemf,timeat,timbeg real time character*12 inputa,inputd,output character*36 inpa36,inpd36 real dvz(3),dvx(3),dvy(3) c real phase,alpha,beta integer*1 year12(12) data year12/31,28,31,30,31,30,31,31,30,31,30,31/ c------- The names of input files are inputed from the --- c------- COMMAND line under MS-DOS. First file name is the name of--- c------- attitude coefs and the second is a name of file which --- c------- contains the MF data. --- open(1,file=' ') open(2,file=' ') inquire(1,name=inputa) inquire(2,name=inputd) inpa36=inputa inpd36=inputd open(1,file=inpa36) output='fm3gse'//'.dat' open(3,file=output) c-------first attitude data--------------------- CALL HDOFATT(year1,month1,day1,sec1, * year2,month2,day2,sec2) print*,year1,month1,day1,sec1 print*,year2,month2,day2,sec2 pause read(2,678) UT_mf,Bsc CALL TIMESEC(UT_mf,year12,timbeg) timeat=timbeg c-searching for a set of Eismont coefs which has a time reference c-greater then the first time reference in the MF file do while (.not.EOF(1).and.timeat.lt.timbeg) CALL RDOFATT(nump,yearp,monthp,dayp,secp,delp,ok) print*, nump print*, yearp,monthp,dayp,secp,delp UT_buf(1)=yearp UT_buf(2)=monthp UT_buf(3)=dayp do i=4,8 UT_buf(i)=0 end do CALL TIMESEC(UT_buf,year12,timeat) timeat=timeat+secp end do print*, 'The transformation from the S/C frame to GSE frame' print*, 'is started. The fisrt set of Eismont coefs to be used' print*, ' is:', nump pause do while(.not.EOF(2)) c-------read MF in the SC system------------------ read(2,678) UT_mf,Bsc 678 format(1x,i4,5i2,i4,i3,3(1x,f6.1)) CALL TIMESEC(UT_mf,year12,timemf) time=timemf-timeat c print*,time,delp c print*,timemf,timeat c pause if((time.gt.delp).and.(ok.eq.0)) then print*,'------------------------------------------------' print*, UT_mf CALL RDOFATT(nump,yearp,monthp,dayp,secp,delp,ok) print*,nump print*, yearp,monthp,dayp,secp if(ok.eq.0) then c CALL SUNANG (alpha) UT_buf(1)=yearp UT_buf(2)=monthp UT_buf(3)=dayp do i=4,8 UT_buf(i)=0 end do CALL TIMESEC(UT_buf,year12,timeat) timeat=timeat+secp time=timemf-timeat endif c print*,alpha print*,'------------------------------------------------' endif c-------transform------------------------ c-----EISMONT------------------------------ c-------3 orts of the spacecraft system in GSE ---- c--------X-ort----------------------- call attid1(time,0.,0.,dvx) c--------Y-ort----------------------- call attid1(time,90.,0.,dvy) c--------Z-ort----------------------- call attid1(time,90.,90.,dvz) c-----Transormation of MF from S/c system to GSE-------- Bgse(1)=Bsc(1)*dvx(1)+Bsc(2)*dvy(1)+Bsc(3)*dvz(1) Bgse(2)=Bsc(1)*dvx(2)+Bsc(2)*dvy(2)+Bsc(3)*dvz(2) Bgse(3)=Bsc(1)*dvx(3)+Bsc(2)*dvy(3)+Bsc(3)*dvz(3) c========================================================== write(3,456) UT_mf,Bgse 456 format(1x,i4.4,5i2.2,i4.4,i3.3,3(1x,f6.1)) END DO stop end c------------------------------------------------------------ SUBROUTINE ATTID1(TS,U1,U2,DIR) COMMON /Z/ Z(2) COMMON /C/ X(12) DIMENSION S(3),E(3),P2(3),DIR(3),DRA(3),PA(3,3) c print *, U1,u2,ts UX=ATAN(1.)/45.*U1 UY=ATAN(1.)/45.*U2 DRA(1)=COS(UX) DRA(2)=SIN(UX)*COS(UY) DRA(3)=SIN(UX)*SIN(UY) ALF=X(1)+X(2)*SIN(X(11)*TS)+X(3)*COS(X(11)*TS)+X(4)*SIN(X(12)*TS)+ *X(5)*COS(X(12)*TS) BET=X(6)+X(7)*SIN(X(11)*TS)+X(8)*COS(X(11)*TS)+X(9)*SIN(X(12)*TS)+ *X(10)*COS(X(12)*TS) RGR = ATAN(1.)/45 AL =ALF*RGR TGA=TAN(AL ) BE =BET*RGR TGB=TAN(BE ) S(1)=1./SQRT(1.+TGA**2+TGB**2) S(2)= TGA *S(1) S(3)= TGB *S(1) G=Z(1)+Z(2)*TS AX=S(2)*COS(G)+S(3)*SIN(G) E(1)=-AX/SQRT(AX**2+S(1)**2) E(2)=SQRT(1.-E(1)**2)*COS(G) E(3)=SQRT(1.-E(1)**2)*SIN(G) CALL VECT (E,S,P2) DO 1 I=1,3 PA(1,I)= S(I) PA(2,I)= P2(I) 1 PA(3,I)= E(I) DO 2 I=1,3 2 DIR(I)=0 DO 3 I=1,3 DO 3 J=1,3 3 DIR(I)=DIR(I)+PA(I,J)*DRA(J) c print*,dir RETURN END c-----end of sub------------------------------------ SUBROUTINE HDOFATT(year1,month1,day1,sec1, * year2,month2,day2,sec2) integer*2 year1,year2, month1,month2,day1,day2 integer*4 num4 integer*1 i11 integer*1 num1,num2 character*1 a1 character*2 a2 real sec1,sec2 read(1,FMT=345) * num1,a2,a1,i11,num4,num2, * year1,month1,day1,sec1, * year2,month2,day2,sec2 345 format(1x,i2,1x,a2,1x,a1,1x,i1,1x,i5,1x,i1,1X,i4,1x * ,i2,1x,i2,1x,F7.3,1x,i4,1x,i2,1x,i2,1x,F7.3) return end c-----end of SUB--------------------------------------------------- SUBROUTINE RDOFATT(nump,yearp,monthp,dayp,secp, * delp,ok) common/z/ z(2) common/c/ x(12) real xb(12),zb(2) integer*2 nump integer*2 yearp,dayp,monthp integer*1 ok real delp,secp read(1,iostat=ok,FMT=344) nump,yearp,monthp,dayp,secp, * delp,xb, * zb 344 format(1x,i2,1x,i4,1x,i2,1x,i2,1x,F7.3,1x,F7.3,10(1x,F7.3), * 4(1x,F8.4)) if(ok.eq.0) then do i=1,12 x(i)=xb(i) end do z(1)=zb(1) z(2)=zb(2) endif return end c-----end of sub-------------------------------------------------------- subroutine TIMEsec(UTs,year,timmin) c--------number of SEC since the beg of 1995 /1000.--------------------- double precision timmin,ymin integer*1 year(12) integer*2 UTs(8) timmin=(UTs(5)*1.+UTs(4)*60.+(UTs(3)-1)*24.*60.) do i=1,UTs(2)-1 timmin=timmin+year(i)*24.*60. end do if(UTs(1).eq.1996.and.UTs(2).gt.2) then timmin=timmin+24.*60. endif if(uts(1).eq.1996) then ymin=0 do i=1,12 ymin=ymin+24.*60.*year(i) end do timmin=timmin+ymin endif c-------seconds------------------------------------------------------------ timmin=(timmin/1000.)*60.+DFLOAT(UTs(6)*1.E-03)+ * DFLOAT(UTs(7)*1.E-06) return end c-------end of sub------------------------------------------------------- subroutine SUNANG(alpha) C--------Sub is used to calculate the Sun-Xscaxis angle.--------- common/z/ z(2) common/c/ x(12) integer*4 intrvl real time_s real angsun,alpha real angtmp real dvx(3),sunort(3) angsun=0 time_s=0. intrvl=0 sunort(1)=1. sunort(2)=0. sunort(3)=0. do while (time_s.le.4.500) intrvl=intrvl+1 time_s=intrvl/1000. call attid1(time_s,0.,0.,dvx) dvx(3)=0 call angle(dvx,Sunort,angtmp) angsun=angsun+angtmp*dvx(2)/abs(dvx(2)) end do angsun=angsun/intrvl alpha=angsun return end c----------------------------------------------------------- subroutine vect(x,y,z) dimension x(3),y(3),z(3) z(1)=x(2)*y(3)-y(2)*x(3) z(2)=x(3)*y(1)-x(1)*y(3) z(3)=x(1)*y(2)-x(2)*y(1) zz=sqrt(z(1)**2+z(2)**2+z(3)**2) do 1 i=1,3 1 z(i)=z(i)/zz return end c------------------------------------------------------------ SUBROUTINE ANGLE(vec1,vec2,U) real vec1(3),vec2(3),U real sum1,sum2,sum3 real funa sum1=0 sum2=0 sum3=0 do 86 i=1,3 sum1=sum1+vec1(i)*vec2(i) sum2=sum2+vec1(i)*vec1(i) sum3=sum3+vec2(i)*vec2(i) 86 continue if(abs(sum2*sum3).lt.1.E-06) then funa=0. else funa=sqrt(sum1*sum1/(sum2*sum3)) if(funa.gt.1.) then funa=1. endif endif u=acos(funa) return end c++++SUB+++++++++++++++++ subroutine rotgse(mfsc,mfgse,beta,alfa) real beta,alfa real mffs(3),mfsc(3),mfgse(3) c-------spin off------------------------ mffs(2)=mfsc(2)*cos(beta)-mfsc(3)*sin(beta) mffs(3)=mfsc(2)*sin(beta)+mfsc(3)*cos(beta) mffs(1)=mfsc(1) c print*,mffs,alfa c-------solar angle--------------------- mfgse(3)=mffs(3) mfgse(1)=mffs(1)*cos(alfa)-mffs(2)*sin(alfa) mfgse(2)=mffs(1)*sin(alfa)+mffs(2)*cos(alfa) c print*,mfgse c--------------------------------------------------- return end c+SUB+++++++++++++++++++++++++++++++++++++++++++++++ subroutine chkpha(vec1,pha1) real vec1(3),pha1 if(vec1(2).eq.0.) vec1(2)=0.00001 pha1=vec1(3)/vec1(2) pha1=atan(pha1) if(vec1(2).gt.0.) then pha1=pha1+atan(1.)*8. else pha1=pha1+atan(1.)*4. endif return end