C gedas35:/home1/ogino/eartha/ognb480a.f + tsub480a.f C stcpu1:/data/g3/ogino/eartha2/seartha3/pvrml/magne/ c zvrmain433.f + zvrsub432.f (zvrsub432.o) C FILE NAME OGINO/EARTHB/OGNBB93 FILE NAME /POSC/OGNBB94 parameter (itapp=20+1*4,itappp=11) parameter (iip00=8,iiq00=4,iir00=150,thx=1.0) parameter (ori1= 85.0,tim1=960.0,XLIM=0.0,XLI2=10.0) c PARAMETER (X0=2.0,Y0=5.0,XL0=7.5,YL=7.5,ori2=360,last1=8) PARAMETER (X0=3.0,Y0=4.0,XL0=10.0,YL=10.0,ori2=360,last1=8) c PARAMETER (X0=1.2,Y0=5.0,XL0=5.5,YL=5.5) PARAMETER (DXL=2.0,DYL=1.0,GTH=-45.0,TH0=60.0,DTH=10.0) c PARAMETER (NX= 320,NY= 80,NZ= 160) c PARAMETER (NX= 500,NY=100,NZ= 200) PARAMETER (NX= 180,NY= 60,NZ= 120) PARAMETER (N1=NX+2,N2=N1*(NY+2),N3=N2*(NZ+2)) c PARAMETER (NB=3,NBB=11,N4=N3*NB,N5=N3*NBB,THH0=70.0) PARAMETER (NB=3,NBB=11,N4=N3*NB,N5=N3*NBB,THH0=60.0) PARAMETER (NXG= 46,NZG=20,ICU=1,MDFU=2) c PARAMETER (NXG=140,NZG=60,ICU=1,MDFU=2) PARAMETER (MX=2*NX+3,JYG2=NZ,JYG=JYG2+2,MY=2*JYG2+3) PARAMETER (KK=MX*MY,MX2=MX,KP=0,LANK=20,KKK=N1*JYG*2,N6=KKK*4) c PARAMETER (LAST=1,IIQ0=1,XXL=100.20,YYL=28.20,ZZL=56.20,MM=2) c PARAMETER (LAST=1,IIQ0=1,XXL=250.50,YYL=50.50,ZZL=100.50,MM=2) PARAMETER (LAST= 1,IIQ0=1,XXL= 54.3,YYL=18.30,ZZL=36.30,MM=2) c PARAMETER (NXP=170,ARU=10.0,AR1=3.5,LAN1=30,LAN2=40,MOD=2) PARAMETER (NXP= 30,ARU=10.0,AR1=3.5,LAN1=30,LAN2=40,MOD=2) PARAMETER (IPEN=1,IAR=0,URMIN=0.01,BIS=-1.5E-4,EP1=1.0E-2) PARAMETER (RO01=5.0E-4,PR01=3.56E-8,VSW=0.044,VSWW=0.2*VSW) PARAMETER (JXG=N1*JYG,ARB=2.0,ARBI=3.5,N7=N3*3,NX1=NX+1) PARAMETER (NY1=NY+1,NZ1=NZ+1,NX2=NX+2,NY2=NY+2,NZ2=NZ+2) PARAMETER (N11=N1+1,N12=N2+1,N21=N1+N2,N22=N21+1,NXZ=NX*NZ) PARAMETER (NP1=NX2/2+NXP,NP1B=NX2/2-NXP) PARAMETER (NP2=NP1*NY2,NP3=NP2*NZ2,NP4=NP3*3) C PARAMETER (IBB=30,IBL=120,IBD=30,KBB=2,KBL=18,KBD=4) PARAMETER (IBB=30,IBL=120,IBD=30,KBB=2,KBL=14,KBD=4) parameter (nux=200,nuy=50,nuxy=nux*nuy,ico=3) parameter (nux1=nux-1,nuy1=nuy-1,nuxy1=nux1*nuy1) parameter (icc0=1, zcc0=0.0) PARAMETER (M0=1,M1=N2/M0,M2=NZ2*8*M0,M3=NZ2*5*M0) c parameter (idci=2,ity=2,isz=1,fct=1.00,H1=3.60,H2=2.80) parameter (idci=2,ity=2,isz=1,fct=1.00,H1=3.00,H2=2.80) parameter(nnx=102,nny=102,nnz=2) c c character tl1*40/'Northward turning from southward IMF'/ c character tl2*40/'Bz=0nT -5nT 5nT t=161.5m (104.5m)'/ c character tl1*40/'Southward turning from northward IMF'/ c character tl2*40/'Bz=0nT 5nT -5nT t=171.0m (114.0m)'/ c c character chrt*36/"Southward-northward of Incoming IMF "/ c character chrt*36/"No uniform IMF "/ c character chrt*36/"Incoming uniform IMF "/ c character chrt*36/"Rotation of incoming IMF "/ c character chrt*36/"Time variation of IMF "/ c character chrt*36/"Incoming Southward IMF "/ c character chrt*36/"Incoming Northward IMF "/ c character chrt*36/"Southward Turning from Northward IMF"/ c character chrt*36/"Northward Turning from Southward IMF"/ c character chg(3)*47 c data chg(1)/"MHD Simulation for 1999 October 21 Event "/ c data chg(1)/"MHD Simulation for 1999 October 22 Event "/ c data chg(1)/"MHD Simulation for 1999 March 19 Event "/ data chg(1)/"MHD Simulation of Earth's Magnetosphere "/ c data chg(2)/"T = 19-03-1999 12:40:00 "/ c data chg(2)/"T = 19-03-1999 06:40:00 "/ c data chg(2)/"T = 21-10-1999 02:29:00 "/ data chg(2)/"T = 22-10-1999 06:30:00 "/ c data chg(1)/"B= 5.0nT t=880m (240.0m) "/ c data chg(1)/"B= 5.0nT t=360m ( 240m) theta = 45 deg"/ c data chg(1)/"B= 0.0nT t=156m ( 0m) theta = 0 deg"/ c c data chg(1)/"B= 5.0nT t= 720m theta = 0 deg "/ c data chg(1)/"B= 5.0nT t= 960m theta = 5 deg "/ c data chg(1)/"B= 5.0nT t=1200m theta = 10 deg "/ c data chg(1)/"B= 5.0nT t= 960m theta = 15 deg "/ c data chg(1)/"B= 5.0nT t=1200m theta = 20 deg "/ c data chg(1)/"B= 5.0nT t=1200m theta = 25 deg "/ c data chg(1)/"B= 5.0nT t= 960m theta = 30 deg "/ c data chg(1)/"B= 5.0nT t=1200m theta = 35 deg "/ c data chg(1)/"B= 5.0nT t= 960m theta = 275 deg "/ c data chg(1)/"B= 5.0nT t= 720m theta = 45 deg "/ data chg(3)/"Density and energy of cross section "/ c DIMENSION F(N4),P(N6),u(nuxy),v(nuxy1) DIMENSION IZM(9),ZMIN(9),ZMAX(9),IA(11),AA(25) common app(nnx,nny,nnz),ie(nnx,nny,nnz) DATA IZM/2,2,2,2,2,2,2,2,2/ DATA ZMIN/-3.0E-2, 0.0,-0.0E-3, 0.0, -0.02, & -0.5E-3,-0.4E-4,-0.5E-3, 0.0/ DATA ZMAX/ 3.0E-2, 0.5E-6, 2.0E-3, 0.5E-3, 0.02, & 0.5E-3, 0.4E-4, 0.5E-3, 0.5E-5/ c c open(12,file='/masao2/ogdata/earthaa/ogdata/erota275.data', c 1 access='sequential',form='unformatted') open(12,file='eartha10.data', 1 access='sequential',form='unformatted') c open(12,file='/archive/proj5/ogino/eartha6/gc210149.data', c 1 access='sequential',form='unformatted') c c c call xyopen call initvrml u(1)=0.0 v(1)=0.0 ino=0 DO 300 JJJ=1,1 ITAP=JJJ+11 IA(1)=NX IA(2)=JYG2 IA(3)=NX IA(4)=NY IA(5)=NZ IA(6)=NXP IA(7)=6 IA(8)=2 ia(9)=nux ia(10)=nuy ia(11)=icc0 c AA(1)=TH0 AA(2)=ARU AA(3)=AR1 AA(4)=ARB AA(5)=XXL AA(6)=YYL AA(7)=ZZL AA(8)=1.0 AA(9)=0.2 AA(11)=-1.0 AA(12)=0.0 AA(15)=XL0 AA(16)=YL AA(17)=GTH AA(18)=-20.0 AA(19)=120.0 AA(21)=25.0 AA(18)=-15.0 AA(19)=80.0 AA(21)=28.0 AA(18)=-30.0 AA(19)=220.0 AA(21)=50.0 AA(18)=-30.0 c AA(19)= 30.0 AA(19)= 120.0 AA(21)= 30.0 AA(18)=-18.0 AA(19)= 36.0 AA(21)= 18.0 AA(20)=EP1 AA(23)=XLIM AA(24)=XLI2 aa(25)=zcc0 XEP=0.5*FLOAT(NX1-2*NXP)/FLOAT(NX1) C C GRAPHIC OPEN c CALL XYOPEN(0,0.0,0.0,33.0,33.0,0) XLL1=3.0*XL+2.0*DXL+X0 AR2=AR1*AR1 PI=3.1415926 NB1=NB+1 NXP2=NXP*2 MXA=MX-2 MYA=MY-2 HX=XXL/FLOAT(NX1) HY=YYL/FLOAT(NY1) HZ=ZZL/FLOAT(NZ1) HX2=0.5*HX HY2=0.5*HY HZ2=0.5*HZ HXG=FLOAT(NX1)/FLOAT(NXG+1) HZG=FLOAT(JYG2+1)/FLOAT(NZG+1) HXX=XXL/FLOAT(NXG+1) HZZ=(YYL+ZZL-HY2-HZ2)/FLOAT(NZG+1) CC HZZ=(ZZL-HY2-HZ2)/FLOAT(NZG+1) NXZG=NXG*NZG C IA(1)=NXG IA(2)=NZG AA(1)=THH0 AA(4)=ARBI AD=2.0 TH1=GTH*PI/180.0 XC1=COS(TH1) XS1=SIN(TH1) YLL1=YL+DYL XL=XL0*0.5*(AA(19)-AA(18))/AA(21) AA(15)=XL AA(16)=YL xla=xl*(-aa(18))/(aa(19)-aa(18)) yla=yl*0.5 xlb=yla*xc1 ylb=-yla*xs1 IIQ=IIQ0-1 JJ=0 C DO 1003 II=1,LAST IIQ=IIQ+1 DO 724 I1=1,M2 I2=M1*(I1-M3-1)+1 I3=M1*(I1-M3) IF(I1.LE.M3) READ(ITAP) (F(I),I=1,M1) IF(I1.GT.M3) READ(ITAP) (F(I),I=I2,I3) 724 CONTINUE c c ll=3 do 172 m=1,ll do 172 j=1,ny2 c do 174 k=1,nz2 do 174 i=1,nx2 i1=i+n1*(j-1)+n2*(k-1)+n3*(m-1) j1=i+n1*(nz2-k) p(j1)=f(i1) 174 continue c do 172 k=1,nz2 do 172 i=1,nx2 i1=i+n1*(j-1)+n2*(k-1)+n3*(m-1) j1=i+n1*(k-1) f(i1)=p(j1) if(m.eq.1) f(i1)=-f(i1) if(m.eq.2) f(i1)=-f(i1) c if(m.eq.7) f(i1)=-f(i1) 172 continue c c cc do 555 i=m1*2*nz2*2+1,m1*2*nz2*2.5 cc F(i)=-F(i) cc 555 continue IF(IIQ.NE.IIQ0) GO TO 1003 IIQ=0 IF(II.LE.0) GO TO 1003 C X1=2.0 C CALL BOUND3(NX,NY,NZ,NXP,MDFU,NB,BIS,RO01,PR01,VSW, C & X1,HX,HY,HZ,ARU,AR2,F,P) C c CALL PLOTS(NAME,16.2) c CALL FACTOR(1.50) c CALL PLOT(0.0,0.0,-3) c ino=ino+1 c call plots(idci,ity,isz,ino) c call factor(fct) c CALL NEWPEN(IPEN) I1=II c CALL DATA(0.5,0.5,LAST,I1,NXP,NX) C C 3 B BAGNETIC FIELD BX,BY,BZ IA(1)=NXG/2 IA(2)=NZG/2 IA(1)=NXG IA(2)=NXG IA(1)=100 IA(2)=100 IA(1)=50 IA(2)=50 IM=3 KP1=IZM(IM) VMIN=ZMIN(IM) VMAX=ZMAX(IM) X1=X0-0.5*YL*XC1 AA(13)=AMAX1(X0,X1) c AA(14)=Y0-0.05*YL AA(14)=Y0+0.00*YL+0.00*DYL IA(7)=6 c write(6,*) ino,' No. 01' cc polar cap start B Vector under figure c c write(6,*) ino,' No. 011' c CALL AINTE1A(IA,AA,F,P) write(6,*) ino,' No. 012' call zsub33(ia,aa) write(6,*) ino,' No. 013' c CALL AINTE1(IA,AA,F,P) write(6,*) ino,' No. 014' c c xb=x0 yb=aa(14) c call symbol(xb-h2*2.0,yb+yla-h2*0.5,h2,'X',0.0,1) c call symbol(xb+xla+xlb-h2*0.5,yb+yla-ylb-h2*1.5,h2,'Y',0.0,1) c call symbol(xb+xla-h2*0.5,yb+yl+h2*0.5,h2,'Z',0.0,1) C IA(1)=NXG IA(1)=NXG/2 IA(2)=NZG IA(2)=NZG/2 c IA(2)=10 AA(13)=AMAX1(X0,X1) c AA(14)=Y0+1.30*YL+DYL AA(14)=Y0+0.00*YL+0.00*DYL IA(7)=6 c write(6,*) ino,' No. 02' cc from equator start B Vector upper figure c CALL AINTE2(IA,AA,F,P) CALL AINTE21(IA,AA,F,P) yb=aa(14) c call symbol(xb-h2*2.0,yb+yla-h2*0.5,h2,'X',0.0,1) c call symbol(xb+xla+xlb-h2*0.5,yb+yla-ylb-h2*1.5,h2,'Y',0.0,1) c call symbol(xb+xla-h2*0.5,yb+yl+h2*0.5,h2,'Z',0.0,1) c call symbol(xb-h2*4.0,yb+yla-h2*2.0,h2,'15Re',0.0,4) c call symbol(xb+xl+h2*3.0,yb+yla-h2*2.0,h2,'-80Re',0.0,5) c call symbol(xb+xla+xlb+h2*2.0,yb+yla-ylb-h2*1.5,h2,'28Re',0.0,4) c call symbol(xb+xla+h2*2.0,yb+yl+h2*0.5,h2,'28Re',0.0,4) c xgb=x0+yl*0.2 xgg=xgb+h1*24.0 c ygg=y0+yl*1.10+dyl*0.5 ygg=y0+yl*1.00+dyl*0.5 ccccccccccccccccccccccccccccc ori=ori1 c 500 call kakudo(xgg,ygg+h1*3.5,ori,h1*1.0) c call symblc(xgg+5.7*h1,ygg+h1*3.5,h1*1.0,"\\260",0.0,5) c call symblc(xgg-h1*1.3,ygg+h1*3.5,h1*1.0,"\\161",0.0,5) c hh2=h1*6 c tim=tim1 c xg1=xgb+hh2+h1*2 xg1=xgb+hh2+h1*4 yg1=ygg+h1*3.5 c call timesg(xg1,yg1,tim,h1) c call symbol(xg1-h1*2,yg1,h1*1.0," t=",0.0,3) c call symbol(xg1+h1*5,yg1,h1*1.0,"min",0.0,3) c call symbol(xgb,yg1,h1*1.0,chg(1),0.0,40) c call symbol(xgb,yg1+h1*2.5,h1*1.4,chrt,0.0,30) c call symbol(xb,yg1,h1,tl2,0.0,40) c call symblc(xb+h1*5.4,yg1+h1*0.2,h1*0.7,'\256',0.0,4) c call symblc(xb+h1*10.2,yg1+h1*0.2,h1*0.7,'\256',0.0,4) c call symblc(xb+h1*09.7,yg1+h1*0.2,h1*0.7,'\256',0.0,4) c call symbol(xb,yg1+h1*1.0,h1,tl1,0.0,40) c CALL PLOTE c xgmi=aa(18) xgma=aa(19) ygma=aa(21) zgma=aa(21) c r=0.0 g=1.0 g=0.5 b=1.0 x1=xgmi y1=ygma+5.0*h2 z1=0.0 c call symblv(x1,y1,z1,h1,chg(1),47) call symblv2(r,g,b,x1,y1,z1,h1,chg(1),47) x1=xgmi y1=ygma+3.0*h2 z1=0.0 c call symblv(x1,y1,z1,h2,chg(2),47) c call symblv(x1,y1,z1,h1,chg(2),47) call symblv2(r,g,b,x1,y1,z1,h1,chg(2),47) c x1=xgmi-1.5*h2 y1=0.0-0.5*h2 z1=0.0 c call symblv(x1,y1,z1,h2,"X",1) call symblv2(r,g,b,x1,y1,z1,h2,"X",1) x1=xgmi-2.7*h2 y1=0.0+0.8*h2 z1=0.0 c call symblv(x1,y1,z1,h2,"30Re",4) call symblv2(r,g,b,x1,y1,z1,h2,"30Re",4) x1=xgma+0.4*h2 y1=0.0+0.8*h2 z1=0.0 c call symblv(x1,y1,z1,h2,"-120Re",6) call symblv2(r,g,b,x1,y1,z1,h2,"-60Re",5) x1=0.0-0.5*h2 y1=0.0-0.5*h2 z1=ygma+1.0*h2 c call symblv(x1,y1,z1,h2,"Y 30Re",7) call symblv2(r,g,b,x1,y1,z1,h2,"Y 30Re",7) x1=0.0-0.5*h2 y1=ygma+0.5*h2 z1=0.0 c call symblv(x1,y1,z1,h2,"Z 30Re",7) call symblv2(r,g,b,x1,y1,z1,h2,"Z 30Re",7) x1=0.0-0.5*h2 y1=-ygma-1.2*h2 z1=0.0 c call symblv(x1,y1,z1,h2,"-30Re",5) call symblv2(r,g,b,x1,y1,z1,h2,"-30Re",5) x=0.0 y=0.0 z=0.0 r=1.0 ir=0 ig=0 ib=1 call sphere1(x,y,z,r,ir,ig,ib) r=1.0 g=1.0 b=1.0 call backgr1(r,g,b) c 1003 CONTINUE 300 CONTINUE C 999 CONTINUE c CALL XYCLOS STOP END