C P V B V x-y x-z heimen ni natteiru C earg777.f /EARTH/TEST261 OGNBB91 C* use subroutine sub3ahm.f (sub3ahm.o) c* long flow lines and contour lines c PARAMETER (X0=2.0,Y0=2.0,XL0=5.0,YL0=5.0,YM=2.1,ICO=4) c PARAMETER (DXL=0.3,DYL=0.3,GTH=-60.0,TH0=60.0,DTH=10.0,JYJ=2) c parameter (iis0=0,iip00=8,iiq00=4,ICO=3) c parameter (iis0=0,iip00=8,iiq00=4,ICO=7) c parameter (iir00=100,thx=1.0,itapp=11) parameter (nnn= 4,ori1=-180.0,tim1=405.0,ori2=360,last1=8) PARAMETER (X0=2.5,Y0=2.0,XL0=4.2,YL0=4.2) c PARAMETER (DXL=1.80,DYL=1.1,GTH=-60.0,TH0=60.0,DTH=10.0,JYJ=2) PARAMETER (DXL=2.00,DYL=1.1,GTH=-60.0,TH0=60.0,DTH=10.0,JYJ=2) c PARAMETER (NX=180,NY= 60,NZ= 60,LAS1=41,IXC=121,IYC= 2,IZC= 2) PARAMETER (N1=NX+2,N2=N1*(NY+2),N3=N2*(NZ+2),N32=N3*2) PARAMETER (NB=8,NBB=11,N4=N3*NB,N5=N3*NBB,THH0=70.0) PARAMETER (NHY=NY,NHY1=NHY+1,NHY2=NHY+2) c PARAMETER (NXG=20,NZG=20,ICU=1,MDFU=1,THBI=-60.) PARAMETER (NXG=30,NZG=20,ICU=1,MDFU=1,THBI=-60.) PARAMETER (MX=NX+2,JYG2=NY+NZ,JYG=JYG2+2,MY=JYG2+2) PARAMETER (KK=MX*MY,MX2=MX,KP=0,LANK=20,KKK=N1*JYG*2,N6=KKK*8) PARAMETER (LAST=1,IIQ0=1,XXL= 90.5,YYL=30.5,ZZL=30.5,MM=2) PARAMETER (NXP= 30,ARU=30.0,AR1=3.0,LAN1=10,LAN2=40,MOD=2) PARAMETER (IPEN=2,IAR=1,URMIN=0.01,BIS=0.00E-4,EP1=1.0E-2) PARAMETER (RO01=185.E-4,PR01=3.56E-8,VSW=.0606,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,NP2=NP1*NHY1,NP3=NP2*NZ2,NP4=NP3*3) PARAMETER (IPE1=1,MM1=N2/1,MM2=1*NZ2,MM3=MM2*NB,KK2=KK*2) PARAMETER (IBB=12,IBL=18,IBD=2,KBB=3,KBL=10,KBD=2) c parameter (idci=2,isz=1,fct=1.00,h1=0.35,ixcc=IXC) c parameter (ori1=225,ori2=360,last1=8) c parameter (ity=1) dimension ori11(16),tim11(16) data ori11/202.5,225.0,247.5,270.0,292.5,315.0,337.5, & 360.0, 22.5, 45.0, 67.5, 90.0,112.5,135.0,157.5,180.0/ data tim11/495.0,510.0,525.0,540.0,555.0,570.0,585.0, & 600.0,615.0,630.0,645.0,660.0,675.0,690.0,705.0,720.0/ c character chrt*36/"Southward-northward of Incoming IMF "/ c character chrt*36/"No uniform IMF "/ c character chrt*36/"Rotation of incoming IMF "/ c character chrt*36/"Time variation of IMF "/ c character chrt*36/"Incoming Northward IMF "/ c character chrt*36/"Incoming Southward IMF "/ character chrt*36/"Incoming Southward and Northward IMF"/ c character chrt*36/"Southward Turning from Northward IMF"/ c character chrt*36/"Northward Turning from Southward IMF"/ c character chrt*36/"Switch off the Northward IMF "/ c character chrt*36/"Switch off the Southward IMF "/ c character chg(3)*46 c data chg(1)/"B= 5.0nT t=880m (240.0m) "/ c data chg(1)/"MHD Simulation for 1996 November 17 Event "/ c data chg(1)/"MHD Simulation for 1999 March 19 Event "/ c data chg(1)/"MHD Simulation for 1999 October 21 Event "/ c data chg(1)/"MHD Simulation for 1999 October 22 Event "/ data chg(1)/"3D MHD Simulation of Earth's Magnetosphere "/ c data chg(1)/"B= 5.0nT t=10.0m ( 10m) "/ c data chg(2)/"B= 2.5nT t=960m (240m) "/ data chg(3)/"Density and energy of cross section "/ c character chr(10)*46 data chr(1)/"Incoming Southward IMF, Theta= 30 degrees "/ c data chr(1)/"T = 22-10-1999 06:40:00 "/ data chr(2)/"T = 22-10-1999 11:20:00 "/ data chr(3)/"T = 22-10-1999 11:30:00 "/ data chr(4)/"T = 22-10-1999 11:40:00 "/ data chr(5)/"T = 22-10-1999 11:50:00 "/ data chr(6)/"T = 22-10-1999 12:00:00 "/ c c DIMENSION U(KK2),F(N4),P(N6),PP(MM1),HHX(N1),FBB(8),FF(N32) DIMENSION IZM(9),ZMIN(9),ZMAX(9),IA(10),AA(23) dimension SU(KK2),SP(N6) integer g1,g2 DATA IZM/2,2,2,2,2,2,2,2,2/ C DATA ZMIN/-3.0E-2, 0.0, 0.0, 0.0, -0.0588, C 1 -1.0E-3, -0.8E-4,-19.23E-4, 0.0/ C DATA ZMAX/ 3.0E-2,2.064E-6, 10.0E-3, 1.0E-3, 0.0588, C 1 1.0E-3, 0.8E-4, 19.23E-4, 1.0E-5/ c DATA ZMIN/ 0.0, 0.0, 0.0, 0.0, -0.0294, c 1 -1.0E-3, -0.8E-4, 0.00E-4, 0.0/ c DATA ZMAX/7.41E-4, 7.41E-4, 1.00E-3, 1.0E-3, 0.0294, c 1 1.0E-3, 0.8E-4, 7.50E-4, 1.0E-5/ DATA ZMIN/ 0.0, 0.0, 0.0, 0.0, -0.0000, 1 -1.0E-3, -0.8E-4, 0.00E-4, 0.0/ c DATA ZMAX/6.19E-3, 6.19E-3, 4.00E-2, 4.00E-2, 0.0294, c DATA ZMAX/3.10E-3, 3.10E-3, 2.00E-2, 2.00E-2, 0.0588, c DATA ZMAX/3.10E-3, 3.10E-3, 1.00E-2, 1.00E-2, 0.0441, DATA ZMAX/1.55E-3, 1.55E-3, 2.00E-5, 2.00E-5, 0.0441, 1 1.0E-3, 0.8E-4, 7.50E-4, 1.0E-5/ c ori1=ori11(nnn) c tim1=tim11(nnn) c ch3=ch31(nnn) c fname="/sub1/ogdata/cmm3a0" // ch3 C C REWIND 12 open(11,file='earthb10.data', 1 access='sequential',form='unformatted') C PI=3.1415926 XL=1.000*XL0 YL=1.000*YL0 IA(1)=NX IA(2)=JYG2 IA(3)=NX IA(4)=NY IA(5)=NZ IA(6)=NXP IA(7)=6 IA(8)=2 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)=XL AA(16)=YL AA(17)=GTH AA(18)=-14.0 AA(19)=24.0 AA(20)=EP1 AA(21)=VSWW XEP=0.5*FLOAT(NX1-2*NXP)/FLOAT(NX1) C c CALL XYOPEN(X,Y,IER) INO=0 C call xyopen c XLL1=3.0*XL+2.0*DXL+X0 AR2=AR1*AR1 NB1=NB+1 NXP2=NXP*1 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) NXZG=NXG*NZG X=PI*THBI/180.0 BISY=BIS*COS(X) BISZ=BIS*SIN(X) DO 221 I=1,N1 221 HHX(I)=HX*FLOAT(I) DO 222 I=1,NB FBB(I+NB)=1.0 222 FBB(I)=1.0 FBB(3)=-1.0 FBB(4)=-1.0 FBB(6)=-1.0 IIQ=IIQ0-1 IIQ=0 JJ=0 C c DO 100 II=9,LAST c DO 100 II=5,LAST DO 100 II=1,LAST c ITAP1=10+II ITAP1=11 ity=1 XL=1.000*XL0 YL=1.000*YL0 IKP=MM1 IIQ=IIQ+1 C READ(12,END=9) (F(I),I=1,N4) C JXN=NX2 IP=0 LB=1 LL=8 c** DO 8 I=1,N32 FF(I)=0.0 8 CONTINUE C** cc kokokara do 20 no roop ha start c DO 12 M=1,LL DO 170 J=1,MM2 READ(ITAP1,END=9) PP DO 170 I=1,MM1 I1=I+MM1*(J-1)+N3*(M-1) F(I1)=PP(I) J1=I+MM1*(J-1) J2=J1+N3 IF(M.GE.6) FF(J1)=FF(J1)+PP(I)*PP(I) IF(M.GE.2.AND.M.LE.4) FF(J2)=FF(J2)+PP(I)*PP(I) 170 CONTINUE 12 continue c DO 20 M=1,LL DO 2201 I=1,NX2 I1=I+N2*(NZ2/2-1)+N3*(M-1) I2=I+N1*(M-1) U(I2)=0.25*(F(I1)+F(I1+N1)+F(I1+N2)+F(I1+N1+N2)) IF(M.EQ.2) U(I2)=-U(I2) C IF(M.EQ.3) U(I2)=-U(I2) IF(M.EQ.6) U(I2)=-U(I2) IF(M.EQ.7) U(I2)=-U(I2) DO 22 K=1,NZ2 I1=I+N2*(K-1)+N3*(M-1) I2=I+N1*(K-1)+JXG*(M-1) P(I2)=0.5*(F(I1)+F(I1+N1)) IF(I.NE.IXC) GO TO 22 I1=IXC+N2*(K-1)+N3*(M-1) I2=K+N1*(M+7) U(I2)=0.5*(F(I1)+F(I1+N1)) IF(M.EQ.2) U(I2)=-U(I2) C IF(M.EQ.3) U(I2)=-U(I2) IF(M.EQ.6) U(I2)=-U(I2) IF(M.EQ.7) U(I2)=-U(I2) 22 CONTINUE DO 2201 J=1,NY2 I1=I+N1*(J-1)+N2*(NZ2/2-1)+N3*(M-1) I2=I+N1*(NY2-J)+JXG*(M-1) SP(I2)=0.5*(F(I1)+F(I1+N2)) IF(I.NE.IXC) GO TO 2201 I1=IXC+N1*(J-1)+N2*(NZ2/2-1) I2=NY2+1-J+N1*(M+7) SU(I2)=0.5*(F(I1)+F(I1+N2)) IF(M.EQ.2) SU(I2)=-SU(I2) C IF(M.EQ.3) SU(I2)=-SU(I2) IF(M.EQ.6) SU(I2)=-SU(I2) IF(M.EQ.7) SU(I2)=-SU(I2) 2201 CONTINUE c do 26 j=2,NY2 do 26 k=1,NZ2 i1=ixcc+N1*(j-1)+N2*(k-1)+N3*(M-1) j1=j+NY+NZ2*(k-1)+JXG*(M+7) j2=NY2-j+1+NZ2*(NZ2-k)+JXG*(M+7) c j2=NY2-j+1+NZ2*(k-1)+JXG*(M+7) P(j1)=0.5*(F(i1)+F(i1+1)) c P(j1)=F(i1) P(j2)=P(j1) if(M.eq.3) P(j2)=-P(j1) c if(M.eq.4) P(j2)=-P(j1) c if(M.eq.6) P(j2)=-P(j1) if(M.eq.7) P(j2)=-P(j1) 26 continue 20 CONTINUE C** DO 231 I=1,N32 FF(I)=SQRT(FF(I)) 231 CONTINUE C* BLC=SQRT(RO01*VSW*VSW)*1.00 BLC=SQRT(RO01*VSW*VSW)*1.00 RC=60.0 RC=56.0 C BLM=0.0 DO 41 K=1,NZ2 DO 41 J=1,NY2 Z=FLOAT(K)-1.5 Y=FLOAT(J)-1.5 AA1=1.0-(Y*Y+Z*Z)/(RC*RC) AA1=AMAX1(AA1,0.5) BLCC=AA1*BLC BLM=0.0 DO 41 I=1,NX2 I1=I+N1*(J-1)+N2*(K-1) I2=I1+N3 I3=I2+N3 I4=I3+N3 I5=I4+N3 I6=I5+N3 I7=I6+N3 I8=I7+N3 RO1=F(I1) VX1=F(I2) VY1=F(I3) VZ1=F(I4) PO1=F(I5) BX1=F(I6) BY1=F(I7) BZ1=F(I8) B1=SQRT(BX1*BX1+BY1*BY1+BZ1*BZ1) BLM=AMAX1(BLM,B1) AMP=1.0 IF(BLM.GE.BLCC) AMP=1.0 IF(J.GE.34) AMP=1.0 F(I1)=AMP*F(I1) F(I2)=AMP*F(I2) F(I3)=AMP*F(I3) F(I4)=AMP*F(I4) F(I5)=AMP*F(I5) F(I6)=AMP*F(I6) F(I7)=AMP*F(I7) F(I8)=AMP*F(I8) 41 continue c BLE=4.00*1.5e-4 VLE=0.80*4.4e-2 c DO 232 K=2,NZ2 DO 232 I=1,NX2 J1=I+N1*(K+NZ-1) J2=J1+JXG J5=J1+JXG*4 J8=J1+JXG*7 P(J1)=0.0 P(J2)=0.0 P(J5)=0.0 P(J8)=0.0 c DO 232 J=2,NY2 J=IYC I1=I+N1*(J-1)+N2*(K-1) I2=I1+N3 I3=I2+N3 I4=I3+N3 I5=I4+N3 I6=I5+N3 I7=I6+N3 I8=I7+N3 RO1=F(I1) VX1=F(I2) VY1=F(I3) VZ1=F(I4) PO1=F(I5) BX1=F(I6) BY1=F(I7) BZ1=F(I8) V1=VX1*VX1+VY1*VY1+VZ1*VZ1 B1=BX1*BX1+BY1*BY1+BZ1*BZ1 P(J1)=P(J1)+0.5*RO1*V1 c P(J2)=P(J2)+RO1 P(J2)=P(J2)-VZ1*BX1+VX1*BZ1 P(J5)=P(J5)+1.5*PO1 c P(J8)=P(J8)+0.5*B1 P(J8)=P(J8)+PO1/RO1 232 CONTINUE C* DO 234 K=2,NZ2 DO 234 J=2,NY2 J1=J+NY+JYG*(K+NZ-1)+JXG*8 J12=NY2-J+1+JYG*(K+NZ-1)+JXG*8 J13=J+NY+JYG*(NZ2-K)+JXG*8 J14=NY2-J+1+JYG*(NZ2-K)+JXG*8 J2=J+NY+JYG*(K+NZ-1)+JXG*9 J22=NY2-J+1+JYG*(K+NZ-1)+JXG*9 J23=J+NY+JYG*(NZ2-K)+JXG*9 J24=NY2-J+1+JYG*(NZ2-K)+JXG*9 J5=J+NY+JYG*(K+NZ-1)+JXG*12 J52=NY2-J+1+JYG*(K+NZ-1)+JXG*12 J53=J+NY+JYG*(NZ2-K)+JXG*12 J54=NY2-J+1+JYG*(NZ2-K)+JXG*12 J8=J+NY+JYG*(K+NZ-1)+JXG*15 J82=NY2-J+1+JYG*(K+NZ-1)+JXG*15 J83=J+NY+JYG*(NZ2-K)+JXG*15 J84=NY2-J+1+JYG*(NZ2-K)+JXG*15 P(J1)=0.0 P(J12)=0.0 P(J13)=0.0 P(J14)=0.0 P(J2)=0.0 P(J22)=0.0 P(J23)=0.0 P(J24)=0.0 P(J5)=0.0 P(J52)=0.0 P(J53)=0.0 P(J54)=0.0 P(J8)=0.0 P(J82)=0.0 P(J83)=0.0 P(J84)=0.0 c DO 234 I=1,NX2 I=IXC I1=I+N1*(J-1)+N2*(K-1) I2=I1+N3 I3=I2+N3 I4=I3+N3 I5=I4+N3 I6=I5+N3 I7=I6+N3 I8=I7+N3 RO1=F(I1) VX1=F(I2) VY1=F(I3) VZ1=F(I4) PO1=F(I5) BX1=F(I6) BY1=F(I7) BZ1=F(I8) V1=VX1*VX1+VY1*VY1+VZ1*VZ1 B1=BX1*BX1+BY1*BY1+BZ1*BZ1 c IF(I.LE.81) B1=0.0 P(J1)=P(J1)+0.5*RO1*V1 c IF(I.LE.81) RO1=0.0 c P(J2)=P(J2)+RO1 P(J2)=P(J2)-VZ1*BX1+VX1*BZ1 P(J5)=P(J5)+1.5*PO1 c P(J8)=P(J8)+0.5*B1 P(J8)=P(J8)+PO1/RO1 P(J12)=P(J1) P(J13)=P(J1) P(J14)=P(J1) P(J22)=P(J2) P(J23)=P(J2) P(J24)=P(J2) P(J52)=P(J5) P(J53)=P(J5) P(J54)=P(J5) P(J82)=P(J8) P(J83)=P(J8) P(J84)=P(J8) 234 CONTINUE c c******************************************* c c DO 252 J=2,NY2 DO 252 I=1,NX2 J1=I+N1*(NY2-J) J2=J1+JXG J5=J1+JXG*4 J8=J1+JXG*7 P(J1)=0.0 P(J2)=0.0 P(J5)=0.0 P(J8)=0.0 c DO 252 K=2,NZ2 K=IZC I1=I+N1*(J-1)+N2*(K-1) I2=I1+N3 I3=I2+N3 I4=I3+N3 I5=I4+N3 I6=I5+N3 I7=I6+N3 I8=I7+N3 RO1=F(I1) VX1=F(I2) VY1=F(I3) VZ1=F(I4) PO1=F(I5) BX1=F(I6) BY1=F(I7) BZ1=F(I8) V1=VX1*VX1+VY1*VY1+VZ1*VZ1 B1=BX1*BX1+BY1*BY1+BZ1*BZ1 P(J1)=P(J1)+0.5*RO1*V1 c P(J2)=P(J2)+RO1 c P(J2)=P(J2)-VZ1*BX1+VX1*BZ1 P(J2)=P(J2)-VZ1*0.0+VX1*BZ1 P(J5)=P(J5)+1.5*PO1 c P(J8)=P(J8)+0.5*B1 P(J8)=P(J8)+PO1/RO1 252 CONTINUE C* c c** IF(IIQ.NE.IIQ0) GO TO 100 IIQ=0 C DO 34 J=1,16 DO 34 I=1,JXG I1=I+JXG*(J-1) F(I1)=P(I1) F(I1)=SQRT(ABS(F(I1))) c IF(J.EQ.2) F(I1)=P(I1) c IF(J.EQ.10) F(I1)=P(I1) IF(J.EQ.2) F(I1)=-P(I1) IF(J.EQ.10) F(I1)=-P(I1) 34 CONTINUE c C DO 70 I=1,JXG I1=I I2=I1+JXG I3=I2+JXG I4=I3+JXG I5=I4+JXG I6=I5+JXG I7=I6+JXG I8=I7+JXG I9=I8+JXG c* F(I9)=SQRT(F(I6)*F(I6)+F(I7)*F(I7)+F(I8)*F(I8)) IF(I.NE.1.AND.I.NE.JXG) GO TO 70 C* WRITE(6,304) I,I1,I2,I8,I9,F(I9) 304 FORMAT(1H ,5X,5I10,2X,1PE12.5) 70 CONTINUE C MMY=122 MMY2=MMY-2 DMY=(MY-MMY)/2 DMY1=DMY+1 DMY2=DMY+MMY DO 72 M=1,NB DO 72 J=1,MMY DO 72 I=1,MX I1=I+MX*(J-1)+JXG*(M-1) I2=I+MX*(J+DMY-1)+JXG*(M-1) F(I1)=F(I2) 72 CONTINUE DO 74 M=1,NB DO 74 J=1,MMY DO 74 I=1,MMY I1=I+MMY*(J-1)+JXG*(M+7) I2=I+DMY+MY*(J+DMY-1)+JXG*(M+7) F(I1)=F(I2) 74 CONTINUE C C INO=INO+1 C* CALL PLOTS(X,Y,2,INO) c CALL PLOTS(X,Y,1,INO) c CALL FACTOR(46.00) c CALL NEWPE1(IPE1) I1=II+2 c CALL DATA(X0,YM,LAST,I1,NXP,NX) C ity=1 c*** ity=2 call plots(idci,ity,isz,INO) call factor(fct) call newpen(ipen) c xg=x0 yg=y0-h1*4.0 i10=ii CALL DATA(Xg,Yg,LAST,i10,NXP,NX,h1) C XL=1.000*XL0*1.50 YL=1.000*YL0 h2=h1*10 xg=X0+XL+YL0*0.20+DXL sg1=(Nx*0.5+1-nxp-ixcc)*hx hhs=1.0*h1 call datasg(xg,yg,sg1,hhs) g1=int((ii-1)/4)+1 yy=y0+yl*4+dyl*4+h1*0.5 g2=ii-(g1-1)*4 c xgg=x0+xl-h1*2.0 xgg=x0+xl+h1*3.0 ygg=y0+yl*4+dyl*3+h1*6.0 yg1=ygg-h1*2.5 hhs=h1*1.5 ccccccccccccccccccccccccccccc ori=ori1 c 500 call kakudo(xgg,yg1,ori,hhs) c call symblc(xgg+7.2*h1,yg1,h1*1.5,"\\260",0.0,5) c call symblc(xgg-h1*1.3,yg1,h1*1.5,"\\161",0.0,5) h2=h1*10 g1=3 g1=ii g2=ii cccccccccccccccccccccccccccccc tim=tim1 xg1=x0+h2+h1*5 c* yg1=y0+yl*2+dyl*1+h1*3.5 c yg1=y0+yl*4+dyl*3+h1*5.5 yg1=ygg c call timesg(xg1,yg1,tim,hhs) c call symbol(xg1-h1*2,yg1,h1*1.5,"t=",0.0,2) c call symbol(xg1+h1*7,yg1,h1*1.5,"min",0.0,3) c call symbol(x0,yg1-h1*2.5,h1*1.5,chg(1),0.0,40) call symbol(x0,yg1-h1*2.5,h1*1.4,chr(ii),0.0,46) call symbol(x0,yg1,h1*1.5,chg(3),0.0,46) call symbol(x0,yg1+h1*2.5,h1*1.5,chg(1),0.0,46) c c c z houkou no magnetic field de aru C 2 magnetic field B IM=1 KP1=IZM(IM) VMIN=ZMIN(IM) VMAX=ZMAX(IM) XB=X0 YB=Y0 YB=Y0+yl+dyl call symbol(xb,yb+yl+h1*0.2,h1*1.2,"P",0.0,1) call symbol(xb+xl+h1*0.2,yb+yl*0.5-h1*0.6,h1,"-60Re",0.0,5) call symbol(xb-3.8*h1,yb+yl*0.5-h1*1.9,h1,"30Re",0.0,4) call symbol(xb-2.3*h1,yb+yl*0.5-h1*0.5,h1,"X",0.0,1) call symbol(xb+xl*0.25-0.4*h1,yb+yl*1.0+h1*0.2,h1,"Z",0.0,1) call symbol(xb+xl*0.25-0.4*h1,yb-h1*1.3,h1,"Y",0.0,1) call symbol(xb+xl*0.35-0.3*h1,yb+yl+h1*0.2,h1,"30Re",0.0,4) c call symbol(xb+xl*0.29-0.3*h1,yb+yl+h1*0.2,h1,"30Re",0.0,4) c call symbol(xb+xl*0.29-0.3*h1,yb-h1*1.2,h1,"-30Re",0.0,5) call symbol(xb+xl*0.35-0.3*h1,yb-h1*1.2,h1,"30Re",0.0,4) III=5 CALL PHAS1(III,NX,JYG2,F,U) CALL DIFF2(MM,MX,MMY,U,P) c CALL GRAP4M(MXA,MMYA,NXP2,XB,YB,XL,YL,HX2,HZ2,AR2,U,VMIN,VMAX, c 1 KP1,LAN1,VO) c c CALL COLOR2(MX,MMY,XB,YB,XL,YL,U,VMIN,VMAX,ICO) call imagc2(mx,mmy,xb,yb,xl,yl,u,vmin,vmax,ico) c CALL NEWPE1(IPE1) c c y-z houkouno magnetic field no heimen zu C 2 magnetic field B IM=2 KP1=IZM(IM) VMIN=ZMIN(IM) VMAX=ZMAX(IM) XB=X0+XL+DXL YB=Y0 YB=Y0+yl+dyl call symbol(xb,yb+yl+h1*0.2,h1*1.2,"P",0.0,1) call symbol(xb+yl+0.5*h1,yb+yl*0.5-h1*1.9,h1,"30Re",0.0,4) call symbol(xb-3.95*h1,yb+yl*0.5-h1*1.9,h1,"-30Re",0.0,5) call symbol(xb+0.5*h1+yl,yb+yl*0.5-h1*0.5,h1,"Y",0.0,1) call symbol(xb+yl*0.49-0.4*h1,yb+yl*1.0+h1*0.2,h1,"Z",0.0,1) call symbol(xb+yl*0.63-0.1*h1,yb+yl+h1*0.2,h1,"30Re",0.0,4) call symbol(xb+yl*0.63-0.3*h1,yb-h1*1.2,h1,"-30Re",0.0,5) III=5+8 CALL PHAS1(III,NX,JYG2,F,U) CALL DIFF2(MM,MMY,MMY,U,P) c CALL GRAP4M(MYA,MYA,0,XB,YB,YL,YL,HZ2,HZ2,AR2,U,VMIN,VMAX, c 1 KP1,LAN1,VO) c CALL COLOR2(MMY,MMY,XB,YB,YL,YL,U,VMIN,VMAX,ICO) call imagc2(mmy,mmy,xb,yb,yl,yl,u,vmin,vmax,ico) CALL NEWPE1(IPE1) c c y houkou no magnetic field de aru C 2 magnetic field B IM=1 KP1=IZM(IM) VMIN=ZMIN(IM) VMAX=ZMAX(IM) XB=X0 YB=Y0 c YB=Y0+yl+dyl call symbol(xb,yb+yl+h1*0.2,h1*1.2,"K",0.0,1) call symbol(xb+xl+h1*0.2,yb+yl*0.5-h1*0.6,h1,"-60Re",0.0,5) call symbol(xb-3.8*h1,yb+yl*0.5-h1*1.9,h1,"30Re",0.0,4) call symbol(xb-2.3*h1,yb+yl*0.5-h1*0.5,h1,"X",0.0,1) call symbol(xb+xl*0.25-0.4*h1,yb+yl*1.0+h1*0.2,h1,"Z",0.0,1) call symbol(xb+xl*0.25-0.4*h1,yb-h1*1.3,h1,"Y",0.0,1) call symbol(xb+xl*0.35-0.3*h1,yb+yl+h1*0.2,h1,"30Re",0.0,4) c call symbol(xb+xl*0.29-0.3*h1,yb+yl+h1*0.2,h1,"30Re",0.0,4) c call symbol(xb+xl*0.29-0.3*h1,yb-h1*1.2,h1,"-30Re",0.0,5) call symbol(xb+xl*0.35-0.3*h1,yb-h1*1.2,h1,"30Re",0.0,4) III=1 CALL PHAS1(III,NX,JYG2,F,U) CALL DIFF2(MM,MX,MMY,U,P) c CALL GRAP4M(MXA,MYA,NXP2,XB,YB,XL,YL,HX2,HZ2,AR2,U,VMIN,VMAX, c 1 KP1,LAN1,VO) c c CALL COLOR2(MX,MMY,XB,YB,XL,YL,U,VMIN,VMAX,ICO) call imagc2(mx,mmy,xb,yb,xl,yl,u,vmin,vmax,ico) c CALL NEWPE1(IPE1) c y-z houkouno magnetic field no heimen zu C 2 magnetic field B IM=2 KP1=IZM(IM) VMIN=ZMIN(IM) VMAX=ZMAX(IM) XB=X0+XL+DXL YB=Y0 c YB=Y0+yl+dyl call symbol(xb,yb+yl+h1*0.2,h1*1.2,"K",0.0,1) call symbol(xb+yl+0.5*h1,yb+yl*0.5-h1*1.9,h1,"30Re",0.0,4) call symbol(xb-3.95*h1,yb+yl*0.5-h1*1.9,h1,"-30Re",0.0,5) call symbol(xb+0.5*h1+yl,yb+yl*0.5-h1*0.5,h1,"Y",0.0,1) call symbol(xb+yl*0.49-0.4*h1,yb+yl*1.0+h1*0.2,h1,"Z",0.0,1) call symbol(xb+yl*0.63-0.1*h1,yb+yl+h1*0.2,h1,"30Re",0.0,4) call symbol(xb+yl*0.63-0.3*h1,yb-h1*1.2,h1,"-30Re",0.0,5) III=1+8 CALL PHAS1(III,NX,JYG2,F,U) CALL DIFF2(MM,MMY,MMY,U,P) c CALL GRAP4M(MYA,MYA,0,XB,YB,YL,YL,HZ2,HZ2,AR2,U,VMIN,VMAX, c 1 KP1,LAN1,VO) c CALL COLOR2(MMY,MMY,XB,YB,YL,YL,U,VMIN,VMAX,ICO) call imagc2(mmy,mmy,xb,yb,yl,yl,u,vmin,vmax,ico) CALL NEWPE1(IPE1) c c ccccccccccccccccccccccccccccccccccccccccccccccccc C 2 magnetic energy c********************** IM=5 KP1=IZM(IM) VMIN=ZMIN(IM) VMAX=ZMAX(IM) XB=X0 YB=Y0 YB=Y0+2.0*(yl+dyl) c call symbol(xb,yb+yl+h1*0.2,h1*1.2,"B",0.0,1) call symbol(xb,yb+yl+h1*0.2,h1*1.2,"T",0.0,1) c call symblc(xb,yb+yl+h1*0.5,h1*1.2,"\\162",0.0,5) call symbol(xb+xl+h1*0.2,yb+yl*0.5-h1*0.6,h1,"-60Re",0.0,5) call symbol(xb-3.8*h1,yb+yl*0.5-h1*1.9,h1,"30Re",0.0,4) call symbol(xb-2.3*h1,yb+yl*0.5-h1*0.5,h1,"X",0.0,1) call symbol(xb+xl*0.25-0.4*h1,yb+yl*1.0+h1*0.2,h1,"Z",0.0,1) call symbol(xb+xl*0.25-0.4*h1,yb-h1*1.3,h1,"Y",0.0,1) call symbol(xb+xl*0.35-0.3*h1,yb+yl+h1*0.2,h1,"30Re",0.0,4) call symbol(xb+xl*0.35-0.3*h1,yb-h1*1.2,h1,"30Re",0.0,4) III=8 CALL PHAS1(III,NX,JYG2,F,U) CALL DIFF2(MM,MX,MMY,U,P) c CALL GRAP4M(MXA,MYA,NXP2,XB,YB,XL,YL,HX2,HZ2,AR2,U,VMIN,VMAX, c 1 KP1,LAN1,VO) c CALL COLOR2(MX,MMY,XB,YB,XL,YL,U,VMIN,VMAX,ICO) call imagc2(mx,mmy,xb,yb,xl,yl,u,vmin,vmax,ico) CALL NEWPE1(IPE1) c c 2 density-rho IM=5 KP1=IZM(IM) VMIN=ZMIN(IM) VMAX=ZMAX(IM) XB=X0+XL+DXL YB=Y0 YB=Y0+2.0*(yl+dyl) c call symbol(xb,yb+yl+h1*0.2,h1*1.2,"B",0.0,1) call symbol(xb,yb+yl+h1*0.2,h1*1.2,"T",0.0,1) c call symblc(xb,yb+yl+h1*0.5,h1*1.2,"\\162",0.0,5) call symbol(xb+yl+0.5*h1,yb+yl*0.5-h1*1.9,h1,"30Re",0.0,4) call symbol(xb-3.95*h1,yb+yl*0.5-h1*1.9,h1,"-30Re",0.0,5) call symbol(xb+0.5*h1+yl,yb+yl*0.5-h1*0.5,h1,"Y",0.0,1) call symbol(xb+yl*0.49-0.4*h1,yb+yl*1.0+h1*0.2,h1,"Z",0.0,1) call symbol(xb+yl*0.63-0.1*h1,yb+yl+h1*0.2,h1,"30Re",0.0,4) call symbol(xb+yl*0.63-0.3*h1,yb-h1*1.2,h1,"-30Re",0.0,5) III=8+8 CALL PHAS1(III,NX,JYG2,F,U) CALL DIFF2(MM,MMY,MMY,U,P) c CALL GRAP4M(MYA,MYA,0,XB,YB,YL,YL,HZ2,HZ2,AR2,U,VMIN,VMAX, c 1 KP1,LAN1,VO) c CALL COLOR2(MMY,MMY,XB,YB,YL,YL,U,VMIN,VMAX,ICO) call imagc2(mmy,mmy,xb,yb,yl,yl,u,vmin,vmax,ico) CALL NEWPE1(IPE1) c********************** c ccccccccccccccccccccccccccccccccccccccccccccccccc C 2 density-rho c********************** IM=3 ico1=2 KP1=IZM(IM) VMIN=ZMIN(IM) VMAX=ZMAX(IM) VMIN=-VMAX XB=X0 YB=Y0 YB=Y0+3.0*(yl+dyl) c call symbol(xb,yb+yl+h1*0.2,h1*1.2,"D",0.0,1) call symbol(xb,yb+yl+h1*0.2,h1*1.2,"Ey",0.0,2) c call symblc(xb,yb+yl+h1*0.5,h1*1.2,"\\162",0.0,5) call symbol(xb+xl+h1*0.2,yb+yl*0.5-h1*0.6,h1,"-60Re",0.0,5) call symbol(xb-3.8*h1,yb+yl*0.5-h1*1.9,h1,"30Re",0.0,4) call symbol(xb-2.3*h1,yb+yl*0.5-h1*0.5,h1,"X",0.0,1) call symbol(xb+xl*0.25-0.4*h1,yb+yl*1.0+h1*0.2,h1,"Z",0.0,1) call symbol(xb+xl*0.25-0.4*h1,yb-h1*1.3,h1,"Y",0.0,1) call symbol(xb+xl*0.35-0.3*h1,yb+yl+h1*0.2,h1,"30Re",0.0,4) call symbol(xb+xl*0.35-0.3*h1,yb-h1*1.2,h1,"30Re",0.0,4) III=2 CALL PHAS1(III,NX,JYG2,F,U) CALL DIFF2(MM,MX,MMY,U,P) c CALL GRAP4M(MXA,MYA,NXP2,XB,YB,XL,YL,HX2,HZ2,AR2,U,VMIN,VMAX, c 1 KP1,LAN1,VO) c CALL COLOR2(MX,MMY,XB,YB,XL,YL,U,VMIN,VMAX,ICO) call imagc2(mx,mmy,xb,yb,xl,yl,u,vmin,vmax,ico1) CALL NEWPE1(IPE1) c c 2 density-rho IM=4 KP1=IZM(IM) VMIN=ZMIN(IM) VMAX=ZMAX(IM) VMIN=-VMAX XB=X0+XL+DXL YB=Y0 YB=Y0+3.0*(yl+dyl) c call symbol(xb,yb+yl+h1*0.2,h1*1.2,"D",0.0,1) call symbol(xb,yb+yl+h1*0.2,h1*1.2,"Ey",0.0,2) c call symblc(xb,yb+yl+h1*0.5,h1*1.2,"\\162",0.0,5) call symbol(xb+yl+0.5*h1,yb+yl*0.5-h1*1.9,h1,"30Re",0.0,4) call symbol(xb-3.95*h1,yb+yl*0.5-h1*1.9,h1,"-30Re",0.0,5) call symbol(xb+0.5*h1+yl,yb+yl*0.5-h1*0.5,h1,"Y",0.0,1) call symbol(xb+yl*0.49-0.4*h1,yb+yl*1.0+h1*0.2,h1,"Z",0.0,1) call symbol(xb+yl*0.63-0.1*h1,yb+yl+h1*0.2,h1,"30Re",0.0,4) call symbol(xb+yl*0.63-0.3*h1,yb-h1*1.2,h1,"-30Re",0.0,5) III=2+8 CALL PHAS1(III,NX,JYG2,F,U) CALL DIFF2(MM,MMY,MMY,U,P) c CALL GRAP4M(MYA,MYA,0,XB,YB,YL,YL,HZ2,HZ2,AR2,U,VMIN,VMAX, c 1 KP1,LAN1,VO) c CALL COLOR2(MMY,MMY,XB,YB,YL,YL,U,VMIN,VMAX,ICO) call imagc2(mmy,mmy,xb,yb,yl,yl,u,vmin,vmax,ico1) CALL NEWPE1(IPE1) c********************** call plote 100 CONTINUE 9 CONTINUE C* CALL XYCLOS(IER) STOP END SUBROUTINE PHAS1(III,NX,NZ,F,U) DIMENSION F(1),U(1) NX2=NX+2 NZ2=NZ+2 M1=NX2*NZ2 DO 10 I=1,M1 I1=I+M1*(III-1) U(I)=F(I1) 10 CONTINUE RETURN END SUBROUTINE NEWPE1(J) CALL NEWPEN(J) RETURN END SUBROUTINE NEWPE2(J) J1=J*2 C* CALL E1LTYP(1,J1,IER) RETURN END subroutine data(xg,yg,ly,lm,ld,lh,h1) character isymb*37 c write(6,*) "tr" c h=0.350 c write(6,10) h c 10 format(f7.3," sf") c write(6,*) "se" c write(6,20) x,y c 20 format(f7.3,1x,f7.3," m") write(isymb,40) ly,lm,ld,lh 40 format("last=",i4," ii=",i4," nxp=",i4," nr=",i4) call symbol(xg,yg,h1,isymb,0.0,37) c write(6,*) "(",isymb,") s" return end subroutine datasg(xg,yg,sg1,h1) character isymb*20 write(isymb,40) sg1 40 format(" x = ",f6.1,"Re") call symbol(xg,yg,h1,isymb,0.0,13) c write(6,*) "(",isymb,") s" return end c subroutine kakudo(xg,yg,ori,h1) character isymb*20 iori=ori write(isymb,40) iori c 40 format("=",f6.1) 40 format("=",i5) call symbol(xg,yg,h1,isymb,0.0,8) c write(6,*) "(",isymb,") s" return end c subroutine timesg(xg,yg,ori,h1) character isymb*20 iori=ori write(isymb,40) iori c 40 format(" ",f6.1) 40 format(" ",i3) call symbol(xg,yg,h1,isymb,0.0,7) c write(6,*) "(",isymb,") s" return end c subroutine ochara2(x,y,is,io,ic,i,ia,umin,umax) character isymb*37 is=is io=io ic=ic ym=0.250 if(i.eq.0) go to 20 write(isymb,40) ia,umin,umax 40 format("ii=",i3," min=",1pe9.2," max=",1pe9.2) call symbol(x,y,ym,isymb,0.0,36) go to 30 20 continue write(isymb,60) umin,umax 60 format("min=",1pe9.2," max=",1pe9.2) call symbol(x,y,ym,isymb,0.0,28) 30 continue return end