C P V B V x-y x-z heimen ni natteiru C earg2621.f /EARTH/TEST261 OGNBB91 FILE NAME / MHD3CD / OGNBB91 C* use subroutine sub3ahm.f (sub3ahm.o) c* long flow lines and contour lines c parameter (itap=20+1*4,iip00=8,iiq00=4) parameter (iir00=150,thx=1.0,itapp=11) parameter (ori1=+45*20+22.5*11,ori2=360,last1=8) PARAMETER (X0=2.0,Y0=3.0,XL0=5.2,YL0=5.2) PARAMETER (DXL=2.0,DYL=1.8,GTH=-60.0,TH0=60.0,DTH=10.0,JYJ=2) c PARAMETER (NX= 180,NY= 60,NZ= 60,LAS1=41,IXC= 61) PARAMETER (N1=NX+2,N2=N1*(NY+2),N3=N2*(NZ+2)) PARAMETER (NB=8,NBB=11,N4=N3*NB,N5=N3*NBB,THH0=70.0) PARAMETER (NHY=NY,NHY1=NHY+1,NHY2=NHY+2) 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.50,YYL= 30.50,ZZL=30.50,MM=2) PARAMETER (NXP= 30,ARU=10.0,AR1=3.0,LAN1=30,LAN2=40,MOD=2) PARAMETER (IPEN=2,IAR=1,URMIN=0.01,BIS=0.00E-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,NP2=NP1*NHY1,NP3=NP2*NZ2,NP4=NP3*3) PARAMETER (IPE1=1,KK2=KK*2) PARAMETER (IBB=12,IBL=18,IBD=2,KBB=3,KBL=10,KBD=2) PARAMETER (mm0=1,MM1=N2/mm0,MM2=mm0*NZ2,MM3=MM2*NB) 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) c character chrt*24/"Bzo=0nT Bz=-5nT t=57m "/ c character chrt*24/"Bz=-5nT t=57m "/ character chrt*24/"Rotation of Incoming IMF"/ character chg(3)*46 data chg(1)/"3D MHD Simulation of Earth's Magnetosphere "/ 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, Bz = -5 nT "/ 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 DIMENSION U(KK2),F(N3),P(N6),PP(MM1),HHX(N1),FBB(8) 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/ DATA ZMIN/-3.0E-2, 0.0, 0.0, 0.0, -0.0294, 1 -1.0E-3, -0.8E-4,-3.000E-4, 0.0/ DATA ZMAX/ 3.0E-2,1.032E-6, 50.0E-4, 1.0E-3, 0.0294, 1 1.0E-3, 0.8E-4, 3.000E-4, 1.0E-5/ C REWIND 12 c open(11,file='earthb10.data', 1 access='sequential',form='unformatted') c 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 ity=1 XL=1.000*XL0 YL=1.000*YL0 IKP=MM1 IIQ=IIQ+1 C READ(11,END=9) (F(I),I=1,N4) C JXN=NX2 IP=0 LB=1 LL=8 cc kokokara do 20 no roop ha start DO 20 M=1,LL C I1=0 IF(IKP.EQ.MM1) GO TO 174 I2=IKP+1 DO 173 I=I2,MM1 I1=I1+1 F(I1)=PP(I) 173 CONTINUE 174 CONTINUE DO 170 J=1,MM2 IF(M.LE.4) READ(11,END=9) PP IF(M.GT.4) READ(11,END=9) PP DO 170 I=1,MM1 IKP=I I1=I1+1 F(I1)=PP(I) IF(I1.EQ.N3) GO TO 172 170 CONTINUE 172 CONTINUE c DO 2201 I=1,NX2 I1=I+N2*(NZ2/2-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) c I2=I+N1*(K-1)+JXG*(M-1) I2=I+N1*(K+NZ-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) 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 c I1=I+N1*(J-1)+N2*(NZ2/2-1) I1=I+N1*(J-1)+N2*(1-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=2,NZ2 i1=ixcc+N1*(j-1)+N2*(k-1) c j1=j+NY+NZ2*(k-1)+JXG*(M+7) c j2=NY2-j+1+NZ2*(NZ2-k)+JXG*(M+7) j1=j+NY+JYG*(k+nz-1)+JXG*(M+7) j2=NY2-j+1+JYG*(NZ2-k)+JXG*(M+7) j3=NY2-j+1+JYG*(k+nz-1)+JXG*(M+7) j4=j+NY+JYG*(NZ2-k)+JXG*(M+7) P(j1)=0.5*(F(i1)+F(i1+1)) c P(j1)=F(i1) P(j2)=P(j1) P(j3)=P(j1) P(j4)=P(j1) if(M.eq.3) P(j2)=-P(j1) if(M.eq.4) P(j2)=-P(j1) if(M.eq.6) P(j2)=-P(j1) if(M.eq.3) P(j3)=-P(j3) if(M.eq.7) P(j3)=-P(j3) if(M.eq.4) P(j4)=-P(j4) if(M.eq.7) P(j4)=-P(j4) 26 continue 20 CONTINUE 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) 34 CONTINUE c DO 3401 J=1,5 DO 3401 I=1,JXG/2 I1=I+JXG*(J-1) F(I1)=SP(I1) 3401 CONTINUE c DO 3402 J=5,5 c DO 3402 I=1,JXG/2 c I1=I+JXG*(J-1) c F(I1)=SP(I1) c 3402 CONTINUE C DO 36 J=1,8 DO 38 K=1,MDFU DO 37 I=1,N1 I2=I+N1*(J-1) P(I)=U(I2) 37 CONTINUE DO 38 I=2,NX1 I2=I+N1*(J-1) U(I2)=0.25*(P(I-1)+2.0*P(I)+P(I+1)) 38 CONTINUE I1=1+N1*(J-1) I2=N1*J C WRITE(6,382) J C WRITE(6,384) (U(I),I=I1,I2) 382 FORMAT(1H ,5X,3HNO=,I4) 384 FORMAT(1H ,5X,1P10E12.4) 36 CONTINUE c DO 361 J=1,5 DO 381 K=1,MDFU DO 371 I=1,N1/2 I2=I+N1*(J-1) P(I)=SU(I2) SP(I)=SU(I2) 371 CONTINUE DO 381 I=2,NX/2+1 I2=I+N1*(J-1) U(I2)=0.25*(SP(I-1)+2.0*SP(I)+SP(I+1)) 381 CONTINUE I1=1+N1*(J-1) I2=N1*J c WRITE(6,382) J c WRITE(6,384) (U(I),I=I1,I2) c 382 FORMAT(1H ,5X,3HNO=,I4) c 384 FORMAT(1H ,5X,1P10E12.4) 361 CONTINUE C c DO 362 J=5,5 c DO 388 K=1,MDFU c DO 378 I=1,N1/2 c I2=I+N1*(J-1) c P(I)=SU(I2) c SP(I)=SU(I2) c 378 CONTINUE c DO 388 I=2,NX/2+1 c I2=I+N1*(J-1) c U(I2)=0.25*(SP(I-1)+2.0*SP(I)+SP(I+1)) c 388 CONTINUE c I1=1+N1*(J-1) c I2=N1*J c WRITE(6,382) J c WRITE(6,384) (U(I),I=I1,I2) c 382 FORMAT(1H ,5X,3HNO=,I4) c 384 FORMAT(1H ,5X,1P10E12.4) c 362 CONTINUE DO 46 J=1,8 DO 48 K=1,MDFU DO 47 I=1,JYG I2=I+N1*(J-1)+N1*8 P(I)=U(I2) 47 CONTINUE DO 48 I=2,JYG-1 I2=I+N1*(J-1)+N1*8 U(I2)=0.25*(P(I-1)+2.0*P(I)+P(I+1)) 48 CONTINUE I1=1+N1*(J-1)+N1*8 I2=N1*J+N1*8 C WRITE(6,382) J C WRITE(6,384) (U(I),I=I1,I2) 46 CONTINUE C DO 461 J=1,5 DO 481 K=1,MDFU DO 471 I=1,JYG/2 I2=I+N1*(J-1)+N1*8 P(I)=SU(I2) SP(I)=SU(I2) 471 CONTINUE DO 481 I=2,JYG/2-1 I2=I+N1*(J-1)+N1*8 U(I2)=0.25*(SP(I-1)+2.0*SP(I)+SP(I+1)) 481 CONTINUE I1=1+N1*(J-1)+N1*8 I2=N1*J+N1*8 C WRITE(6,382) J C WRITE(6,384) (U(I),I=I1,I2) 461 CONTINUE c c DO 462 J=5,5 c DO 482 K=1,MDFU c DO 472 I=1,JYG/2 c I2=I+N1*(J-1)+N1*8 c P(I)=SU(I2) c SP(I)=SU(I2) c 472 CONTINUE c DO 482 I=2,JYG/2-1 c I2=I+N1*(J-1)+N1*8 c U(I2)=0.25*(SP(I-1)+2.0*SP(I)+SP(I+1)) c 482 CONTINUE c I1=1+N1*(J-1)+N1*8 c I2=N1*J+N1*8 C WRITE(6,382) J C WRITE(6,384) (U(I),I=I1,I2) c 462 CONTINUE 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 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.5 YL=1.000*YL0 h2=h1*10 xg=X0+XL+XL0*0.30+DXL sg1=(Nx*0.5+1-nxp-ixcc)*0.5 hhs=1.0*h1 call datasg(xg,yg,sg1,hhs) g1=int((ii-1)/4)+1 c yy=y0+yl*3+dyl*3.5+h1*0.5 g2=ii-(g1-1)*4 xgg=x0+xl*0.8 ygg=y0+yl*3+dyl*2.5+h1*3.5 hhs=h1*1.5 ccccccccccccccccccccccccccccc ori=ori1 c 500 call kakudo(xgg,ygg,ori,hhs) c call symblc(xgg+7.2*h1,ygg,h1*1.5,"\\260",0.0,5) c call symblc(xgg-h1*1.3,ygg,h1*1.5,"\\161",0.0,5) h2=h1*10 g1=3 g2=ii cccccccccccccccccccccccccccccc tim=tim1 xg1=x0+h2+h1*2 yg1=y0+yl*3+dyl*2.5+h1*3.5 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) call symbol(x0,y0+yl*3+dyl*2.5+h1*3.5,h1*1.4,chr(ii),0.0,46) c call symbol(x0+h2,y0+yl*3+dyl*2+h1*3.5,h1*1.5,ch1(g2),0.0,6) c call symbol(x0,y0+yl*2+dyl*1+h1*6.0,h1*1.5,chr(g1),0.0,22) call symbol(x0,y0+yl*3+dyl*2.5+h1*6.0,h1*1.5,chg(1),0.0,46) c c z houkou no pressure de aru C 2 PRESSURE-P IM=2 KP1=IZM(IM) VMIN=ZMIN(IM) VMAX=ZMAX(IM) XB=X0 YB=Y0 c YB=Y0+yl+yb 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.3*h1,yb+yl*0.5-h1*1.9,h1,"30Re",0.0,4) call symbol(xb-1.8*h1,yb+yl*0.5-h1*0.5,h1,"X",0.0,1) call symbol(xb+xl*0.33-0.4*h1,yb+yl*1.0+h1*0.2,h1,"Z",0.0,1) call symbol(xb+xl*0.33-0.4*h1,yb-h1*1.3,h1,"Y",0.0,1) call symbol(xb+xl*0.43-0.4*h1,yb-h1*1.3,h1*1.00,"30Re",0.0,4) call symbol(xb+xl*0.43-0.3*h1,yb+yl+h1*0.2,h1,"30Re",0.0,4) c call symbol(xb+xl*0.43-0.3*h1,yb-h1*1.2,h1,"-30Re",0.0,5) III=5 CALL PHAS1(III,NX,JYG2,F,U) CALL DIFF2(MM,MX,MY,U,P) CALL GRAP4M(MXA,MYA,NXP2,XB,YB,XL,YL,HX2,HZ2,AR2,U,VMIN,VMAX, 1 KP1,LAN1,VO) CALL NEWPE1(IPE1) c c y houkou no pressure dearu C 2 PRESSURE-P c IM=2 c KP1=IZM(IM) c VMIN=ZMIN(IM) c VMAX=ZMAX(IM) c XB=X0 c YB=Y0 c III=5 c CALL PHAS1(III,NX,JYG2,SF,SU) c CALL DIFF2(MM,MX,MY,SU,SP) c CALL GRAP4M(MXA,MYA,NXP2,XB,YB,XL,YL,HX2,HZ2,AR2,SU,VMIN,VMAX, c 1 KP1,LAN1,VO) c CALL NEWPE1(IPE1) c c y-z houkouno pressure no heimen zu C 2 PRESSURE-P IM=2 KP1=IZM(IM) VMIN=ZMIN(IM) VMAX=ZMAX(IM) XB=X0+XL+DXL YB=Y0 c YB=Y0+yl+yb 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) c call symbol(xb+xl*0.5-0.4*h1,yb-h1*1.3,h1,"Y",0.0,1) c call symbol(xb+yl*0.60-0.4*h1,yb+yl+h1*0.2,h1*0.75,"30Re",0.0,4) 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,MY,MY,U,P) CALL GRAP4M(MYA,MYA,0,XB,YB,YL,YL,HZ2,HZ2,AR2,U,VMIN,VMAX, 1 KP1,LAN1,VO) CALL NEWPE1(IPE1) c C 2 density-rho c IM=3 c KP1=IZM(IM) c VMIN=ZMIN(IM) c VMAX=ZMAX(IM) c XB=X0 c YB=Y0 c YB=Y0+yl+yb c call symbol(xb,yb+yl+h1*0.2,h1*1.2,"P",0.0,1) c call symblc(xb,yb+yl+h1*0.5,h1*1.2,"\\162",0.0,5) c call symbol(xb+xl+h1*0.2,yb+yl*0.5-h1*0.6,h1,"-60Re",0.0,5) c call symbol(xb-2.9*h1,yb+yl*0.5-h1*1.9,h1,"30Re",0.0,4) c call symbol(xb-1.8*h1,yb+yl*0.5-h1*0.5,h1,"X",0.0,1) c call symbol(xb+xl*0.33-0.4*h1,yb+yl*1.0+h1*0.2,h1,"Z",0.0,1) c call symbol(xb+xl*0.33-0.4*h1,yb-h1*1.3,h1,"Y",0.0,1) c call symbol(xb+xl*0.43-0.4*h1,yb-h1*1.3,h1*1.00,"30Re",0.0,4) c call symbol(xb+xl*0.43-0.3*h1,yb+yl+h1*0.2,h1,"30Re",0.0,4) c call symbol(xb+xl*0.43-0.3*h1,yb-h1*1.2,h1,"-30Re",0.0,5) c III=1 c CALL PHAS1(III,NX,JYG2,F,U) c CALL DIFF2(MM,MX,MY,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 NEWPE1(IPE1) c C 2 density-rho c IM=3 c KP1=IZM(IM) c VMIN=ZMIN(IM) c VMAX=ZMAX(IM) c XB=X0+XL+DXL c YB=Y0 c YB=Y0+yl+yb c call symbol(xb,yb+yl+h1*0.2,h1*1.2,"P",0.0,1) c call symblc(xb,yb+yl+h1*0.5,h1*1.2,"\\162",0.0,5) c call symbol(xb+yl+0.5*h1,yb+yl*0.5-h1*1.9,h1,"30Re",0.0,4) c call symbol(xb-3.75*h1,yb+yl*0.5-h1*1.9,h1,"-30Re",0.0,5) c call symbol(xb+0.5*h1+yl,yb+yl*0.5-h1*0.5,h1,"Y",0.0,1) c call symbol(xb+yl*0.49-0.4*h1,yb+yl*1.0+h1*0.2,h1,"Z",0.0,1) c call symbol(xb+xl*0.5-0.4*h1,yb-h1*1.3,h1,"Y",0.0,1) c call symbol(xb+yl*0.60-0.4*h1,yb+yl+h1*0.2,h1*0.75,"30Re",0.0,4) c call symbol(xb+yl*0.63-0.1*h1,yb+yl+h1*0.2,h1,"30Re",0.0,4) c call symbol(xb+yl*0.63-0.3*h1,yb-h1*1.2,h1,"-30Re",0.0,5) c III=8+1 c CALL PHAS1(III,NX,JYG2,F,U) c CALL DIFF2(MM,MY,MY,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 NEWPE1(IPE1) c 5 VR,VZ IM=5 KP1=IZM(IM) VMIN=1.0*ZMIN(IM) VMAX=1.0*ZMAX(IM) XB=X0+XL+DXL c YB=Y0+2.0*(YL+DYL) XB=X0 YB=Y0+1.0*(YL+DYL) c YB=Y0+yl+yb call symbol(xb,yb+yl+h1*0.3,h1*1.2,"V",0.0,1) call symblc(xb-0.1*h1,yb+yl+h1*1.6,h1*1.2,"\\256",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.3*h1,yb+yl*0.5-h1*1.9,h1,"30Re",0.0,4) call symbol(xb-1.8*h1,yb+yl*0.5-h1*0.5,h1,"X",0.0,1) call symbol(xb+xl*0.33-0.4*h1,yb+yl*1.0+h1*0.2,h1,"Z",0.0,1) c call symbol(xb+xl*0.5-0.4*h1,yb-h1*1.3,h1,"Y",0.0,1) c call symbol(xb+xl*0.60-0.4*h1,yb+yl+h1*0.2,h1*0.75,"30Re",0.0,4) call symbol(xb+xl*0.33-0.4*h1,yb-h1*1.3,h1,"Y",0.0,1) call symbol(xb+xl*0.43-0.4*h1,yb-h1*1.3,h1*1.00,"30Re",0.0,4) call symbol(xb+xl*0.43-0.3*h1,yb+yl+h1*0.2,h1,"30Re",0.0,4) c call symbol(xb+xl*0.43-0.3*h1,yb-h1*1.2,h1,"-30Re",0.0,5) MB=1 DO 180 J=1,JYG DO 180 I=1,N1 I1=I+N1*(J-1) I2=I1+JXG I3=I1+JXG*2 I4=I1+JXG*3 U(I1)=F(I2) c* J1=I+N1*(JYG-J) c* J6=J1+JXG*5 c* J8=J1+JXG*7 c* IF(J.GT.JYG/2) U(I1)=F(I6) IF(J.GT.JYG/2) U(I2)=F(I4) c* IF(J.LE.JYG/2) U(I1)=-F(J6) IF(J.LE.JYG/2) U(I2)=-F(I3) c U(I1)=F(I2) c U(I2)=-F(I4) c U(I2)=-F(I3) 180 CONTINUE CALL GRAP3A(MXA,MYA,MB,NXG,NZG,NXP,XB,YB,XL,YL,AR2, 1 U,VMIN,VMAX,URMIN,KP1,IAR,LAS1) CALL NEWPE1(IPE1) c C 5 VR,VZ IM=5 KP1=IZM(IM) VMIN=1.0*ZMIN(IM) VMAX=1.0*ZMAX(IM) XB=X0+XL+DXL c YB=Y0+2.0*(YL+DYL) c XB=X0 YB=Y0+1.0*(YL+DYL) c YB=Y0+yl+yb call symbol(xb,yb+yl+h1*0.3,h1*1.2,"V",0.0,1) call symblc(xb-0.1*h1,yb+yl+h1*1.6,h1*1.2,"\\256",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) c call symbol(xb+xl*0.5-0.4*h1,yb-h1*1.3,h1,"Y",0.0,1) c call symbol(xb+yl*0.60-0.4*h1,yb+yl+h1*0.2,h1*0.75,"30Re",0.0,4) 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) MB=1 DO 185 J=1,JYG DO 185 I=1,JYG I1=I+JYG*(J-1) I2=I1+JYG*JYG I21=I+JXG*9+JYG*(J-1) I3=I21+JXG I4=I3+JXG c* J1=I+N1*(JYG-J) c* J6=J1+JXG*5 c* J8=J1+JXG*7 c* IF(J.GT.JYG/2) U(I1)=F(I6) c* IF(J.GT.JYG/2) U(I2)=F(I8) c* IF(J.LE.JYG/2) U(I1)=-F(J6) c* IF(J.LE.JYG/2) U(I2)=F(J8) c* U(I1)=F(I2) U(I1)=F(I3) U(I2)=F(I4) 185 CONTINUE CALL GRAP3A(MYA,MYA,MB,NZG,NZG,0,XB,YB,YL,YL,AR2, 1 U,VMIN,VMAX,URMIN,KP1,IAR,LAS1) CALL NEWPE1(IPE1) C 8 BR,BZ IM=8 KP1=IZM(IM) VMIN=1.0*ZMIN(IM) VMAX=1.0*ZMAX(IM) XB=X0+XL+DXL YB=Y0+2.0*(YL+DYL) XB=X0 YB=Y0+2.0*(YL+DYL) call symbol(xb,yb+yl+h1*0.3,h1*1.2,"B",0.0,1) call symblc(xb-0.1*h1,yb+yl+h1*1.6,h1*1.2,"\\256",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.3*h1,yb+yl*0.5-h1*1.9,h1,"30Re",0.0,4) call symbol(xb-1.8*h1,yb+yl*0.5-h1*0.5,h1,"X",0.0,1) call symbol(xb+xl*0.33-0.4*h1,yb+yl*1.0+h1*0.2,h1,"Z",0.0,1) c call symbol(xb+xl*0.5-0.4*h1,yb-h1*1.3,h1,"Y",0.0,1) c call symbol(xb+xl*0.60-0.4*h1,yb+yl+h1*0.2,h1*0.75,"30Re",0.0,4) call symbol(xb+xl*0.43-0.3*h1,yb+yl+h1*0.2,h1,"30Re",0.0,4) call symbol(xb+xl*0.43-0.3*h1,yb-h1*1.2,h1,"-30Re",0.0,5) MB=1 DO 187 J=1,JYG DO 187 I=1,N1 I1=I+N1*(J-1) I2=I1+JXG I6=I1+JXG*5 I8=I1+JXG*7 J1=I+N1*(JYG-J) J6=J1+JXG*5 J8=J1+JXG*7 IF(J.GT.JYG/2) U(I1)=F(I6) IF(J.GT.JYG/2) U(I2)=F(I8) IF(J.LE.JYG/2) U(I1)=-F(J6) IF(J.LE.JYG/2) U(I2)=F(J8) c U(I1)=F(I6) c U(I2)=F(I8) 187 CONTINUE CALL GRAP3A(MXA,MYA,MB,NXG,NZG,NXP,XB,YB,XL,YL,AR2, 1 U,VMIN,VMAX,URMIN,KP1,IAR,LAS1) CALL NEWPE1(IPE1) C 8 BR,BZ IM=8 KP1=IZM(IM) VMIN=1.0*ZMIN(IM) VMAX=1.0*ZMAX(IM) XB=X0+XL+DXL c YB=Y0+2.0*(YL+DYL) c XB=X0 YB=Y0+2.0*(YL+DYL) call symbol(xb,yb+yl+h1*0.3,h1*1.2,"B",0.0,1) call symblc(xb-0.1*h1,yb+yl+h1*1.6,h1*1.2,"\\256",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) c call symbol(xb+xl*0.5-0.4*h1,yb-h1*1.3,h1,"Y",0.0,1) c call symbol(xb+yl*0.60-0.4*h1,yb+yl+h1*0.2,h1*0.75,"30Re",0.0,4) 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) MB=1 DO 181 J=1,JYG DO 181 I=1,JYG I1=I+JYG*(J-1) I2=I1+JYG*JYG I6=I+JXG*13+JYG*(J-1) I7=I6+JXG I8=I7+JXG J1=I+N1*(JYG-J) J6=J1+JXG*5 J8=J1+JXG*7 IF(J.GT.JYG/2) U(I1)=F(I6) IF(J.GT.JYG/2) U(I2)=F(I8) IF(J.LE.JYG/2) U(I1)=-F(J6) IF(J.LE.JYG/2) U(I2)=F(J8) U(I1)=F(I7) U(I2)=F(I8) 181 CONTINUE CALL GRAP3A(MYA,MYA,MB,NZG,NZG,0,XB,YB,YL,YL,AR2, 1 U,VMIN,VMAX,URMIN,KP1,IAR,LAS1) 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 = ",f5.1,"Re") call symbol(xg,yg,h1,isymb,0.0,12) c write(6,*) "(",isymb,") s" return end c subroutine kakudo(xg,yg,ori,h1) character isymb*20 write(isymb,40) ori 40 format("=",f6.1) 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 write(isymb,40) ori 40 format(" ",f6.1) 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