C 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 (X0=2.0,Y0=3.0,XL0=5.0,YL0=5.0,YM=2.1) c PARAMETER (DXL=0.3,DYL=0.3,GTH=-60.0,TH0=60.0,DTH=10.0,JYJ=2) c PARAMETER (X0=2.0,Y0=3.0,XL0=6.0,YL0=6.0) PARAMETER (DXL=1.0,DYL=1.0,GTH=-60.0,TH0=60.0,DTH=10.0,JYJ=2) c PARAMETER (NX= 60,NY= 30,NZ= 30,LAS1=41,IXC= 21) c PARAMETER (NX= 60,NY= 30,NZ= 30,LAS1=11,IXC= 21) 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=20,NZG=20,ICU=1,MDFU=1,THBI=-60.) PARAMETER (MX=NX+2,JYG2=NHY+NZ,JYG=JYG2+2,MY=JYG2+2) PARAMETER (KK=MX*MY,MX2=MX,KP=0,LANK=20,KKK=N1*JYG*2,N6=KKK*4) PARAMETER (LAST=12,IIQ0=2,XXL=61.00,YYL=61.00,ZZL=31.00,MM=2) c PARAMETER (LAST=12,IIQ0=1,XXL=61.00,YYL=61.00,ZZL=31.00,MM=2) PARAMETER (NXP= 0,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,MM1=N2/2,MM2=2*NZ2,MM3=MM2*NB,KK2=KK*2) PARAMETER (IBB=12,IBL=18,IBD=2,KBB=3,KBL=10,KBD=2) c parameter (idci=2,ity=1,isz=1,fct=1.00,h1=0.35) c character chrt*24/"Bzo=0nT Bz=-5nT t=57m"/ c character chrt*15/"Bz=-5nT t=57m"/ character chg(3)*7 data chg(1)/"Bz=-5nT"/ data chg(2)/"Bz= 0nT"/ data chg(3)/"Bz= 5nT"/ character ch1(4)*5 data ch1(1)/"t=16m"/ data ch1(2)/"t=32m"/ data ch1(3)/"t=48m"/ data ch1(4)/"t=64m"/ character ch2(3)*4 data ch2(1)/"-5nT"/ data ch2(2)/" 0nT"/ data ch2(3)/" 5nT"/ character chr(3)*32 data chr(1)/"Incoming southward IMF"/ data chr(2)/"No uniform IMF"/ data chr(3)/"Incoming northward IMF"/ 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) 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.0588, 1 -1.0E-3, -0.8E-4,-3.000E-4, 0.0/ DATA ZMAX/ 3.0E-2,2.064E-6, 10.0E-3, 1.0E-3, 0.0588, 1 1.0E-3, 0.8E-4, 3.000E-4, 1.0E-5/ C REWIND 12 c open(12,file='/usr1/g3/ogino/data1/mhd3003', c 1 access='sequential', c 2 form='unformatted') c open(12,file='/usr2/togi/mhd4001',access='sequential', c 1 form='unformatted') open(12,file='/usr2/ogdata/mhd3a/mhd4001', 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 DO 100 II=1,LAST 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 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(12,END=9) PP IF(M.GT.4) READ(12,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 DO 20 I=1,NX2 I1=I 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=2,NZ2 I1=I+N2*(K-1) I2=I+N1*(NHY1+K-2)+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=NHY1+K-1+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 20 J=2,NY2 I1=I+N1*(J-1) I2=I+N1*(NY2-J)+JXG*(M-1) P(I2)=0.5*(F(I1)+F(I1+N2)) IF(I.NE.IXC) GO TO 20 I1=IXC+N1*(J-1) I2=NY2+1-J+N1*(M+7) U(I2)=0.5*(F(I1)+F(I1+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) 20 CONTINUE IF(IIQ.NE.IIQ0) GO TO 100 IIQ=0 C DO 34 J=1,8 DO 34 I=1,JXG I1=I+JXG*(J-1) F(I1)=P(I1) 34 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 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 INO=INO+1 c CALL PLOTS(X,Y,1,INO) c CALL FACTOR(36.0) c CALL NEWPE1(IPEN) I1=II c CALL DATA(X0,YM,LAST,I1,NXP,NX) IAA=1 XL=2.5*XL0 c call plots(idci,ity,isz,INO) call factor(fct) call newpen(ipen) c call symbol(x0,y0+yl*3+dyl*2+h1*3.5,h1*1.5,chrt,0.0,24) g1=int((ii-1)/4)+1 call symbol(x0,y0+yl*3+dyl*2+h1*3.5,h1*1.5,chg(g1),0.0,7) yy=y0+yl*2+dyl*2+h1*0.5 call symbol(x0+h1*4,yy+0.25*g1*yl,h1,ch2(g1),0.0,4) g2=ii-(g1-1)*4 h2=h1*10 call symbol(x0+h2,y0+yl*3+dyl*2+h1*3.5,h1*1.5,ch1(g2),0.0,5) c call symbol(x0,y0+yl*3+dyl*2+h1*6.0,h1*1.5,chr(g1),0.0,22) c call symblc(x0-3.0*h1,y0+yl*3+dyl*2+h1*1.5,h1,"\\(",0.0,3) call symbol(x0-3.5*h1,y0+yl*3+dyl*2+h1*1.5,h1,"(nT)",0.0,4) call symbol(x0-4.5*h1,y0+yl*2+dyl*1+h1*1.0,h1,"(km/s)",0.0,6) c call symblc(x0-0.0*h1,y0+yl*3+dyl*2+h1*1.5,h1,"\\)",0.0,3) call symbol(x0-2.0*h1,y0+yl*3+dyl*2-h1*0.5,h1,"10",0.0,2) call symbol(x0-3.0*h1,y0+yl*2.80+dyl*2-h1*0.5,h1*1.2,"Bz",0.0,2) call symbol(x0-3.0*h1,y0+yl*1.80+dyl*1-h1*0.5,h1*1.2,"Vx",0.0,2) call symblc(x0-2.0*h1,y0+yl*0.80-h1*0.5,h1*1.2,"\\162",0.0,5) call symbol(x0-2.0*h1,y0+yl*0.65-h1*0.5,h1*1.2,"P",0.0,1) call symbol(x0-1.5*h1,y0+yl*2.5+dyl*2-h1*0.5,h1,"0",0.0,1) call symbol(x0-3.0*h1,y0+yl*2.0+dyl*2-h1*0.5,h1,"-10",0.0,3) call symbol(x0-3.0*h1,y0+yl*2.0+dyl*1-h1*0.5,h1,"400",0.0,3) call symbol(x0-1.5*h1,y0+yl*1.5+dyl*1-h1*0.5,h1,"0",0.0,1) call symbol(x0-4.0*h1,y0+yl*1.0+dyl*1-h1*0.5,h1,"-400",0.0,4) call symbol(x0-1.5*h1,y0+yl*0.0+dyl*0-h1*0.5,h1,"0",0.0,1) call symbol(x0-1.8*h1,y0+yl*0.0+dyl*0-h1*2.5,h1,"30Re",0.0,4) xg=x0 yg=y0-h1*8.0 CALL DATA(Xg,Yg,LAST,ii,NXP,NX,h1) xgg=x0-2.0*h1 ygg=y0-h1*0.5 call symblc(xgg+0.40*xl,ygg+yl*0.80,h1*1.2,"\\162",0.0,5) call symbol(xgg+0.48*xl,ygg+yl*0.25,h1*1.2,"P",0.0,1) call symbol(x0+xl*0.5-0.45*h1,y0-h1*2.5,h1,"0",0.0,1) call symbol(x0+xl-2.4*h1,y0-h1*2.5,h1,"-30Re",0.0,5) call symbol(x0+xl*0.75-0.4*h1,y0-h1*3.5,h1,"X",0.0,1) c C 1 DENSITY - RO IM=3 KP1=IZM(IM) VMIN=ZMIN(IM) VMAX=ZMAX(IM) XB=X0 YB=Y0 IB=1 LL=1 CALL GRAP7G(IAA,IB,LL,NX,NX,NXP,XB,YB,XL,YL,U,VMIN,VMAX,KP1) C 2 PRESSURE-P IAA=2 CALL NEWPE1(IPEN) IM=2 KP1=IZM(IM) VMIN=ZMIN(IM) VMAX=ZMAX(IM) XB=X0 YB=Y0 IB=5 LL=1 CALL GRAP7G(IAA,IB,LL,NX,NX,NXP,XB,YB,XL,YL,U,VMIN,VMAX,KP1) C 3 VELOCITY - VX VY VZ IAA=1 CALL NEWPE1(IPEN) IM=5 KP1=IZM(IM) VMIN=ZMIN(IM) VMAX=ZMAX(IM) XB=X0 YB=Y0+YL+DYL IB=2 LL=3 CALL GRAP7G(IAA,IB,LL,NX,NX,NXP,XB,YB,XL,YL,U,VMIN,VMAX,KP1) C 4 MAGNETIC FIELD - BX BY BZ CALL NEWPE1(IPEN) IM=8 KP1=IZM(IM) VMIN=ZMIN(IM) VMAX=ZMAX(IM) XB=X0 YB=Y0+2.0*(YL+DYL) IB=6 LL=3 CALL GRAP7G(IAA,IB,LL,NX,NX,NXP,XB,YB,XL,YL,U,VMIN,VMAX,KP1) CALL PLOTE C INO=INO+1 c CALL PLOTS(X,Y,1,INO) c CALL FACTOR(36.0) c CALL NEWPE1(IPEN) I1=II+1 c CALL DATA(X0,YM,LAST,I1,NXP,NX) IAA=1 XL=2.5*XL0 call plots(idci,ity,isz,INO) call factor(fct) call newpen(ipen) h2=h1*10 c call symbol(x0,y0+yl*3+dyl*2+h1*3.5,h1*1.5,chrt,0.0,24) c call symbol(x0,y0+yl*3+dyl*2+h1*6.0,h1*1.5,chr(1),0.0,22) call symbol(x0,y0+yl*3+dyl*2+h1*3.5,h1*1.5,chg(g1),0.0,7) yy=y0+yl*2+dyl*2+h1*0.5 call symbol(x0+h1*4,yy+0.25*g1*yl,h1,ch2(g1),0.0,4) call symbol(x0+h2,y0+yl*3+dyl*2+h1*3.5,h1*1.5,ch1(g2),0.0,5) c call symbol(x0,y0+yl*3+dyl*2+h1*6.0,h1*1.5,chr(g1),0.0,22) call symbol(x0-h1*2.5,y0+yl*3+dyl*2-h1*0.5,h1,"10",0.0,2) call symbol(x0-3.5*h1,y0+yl*3+dyl*2+h1*1.5,h1,"(nT)",0.0,4) call symbol(x0-4.5*h1,y0+yl*2+dyl*1+h1*1.0,h1,"(km/s)",0.0,6) call symbol(x0-3.0*h1,y0+yl*2.90+dyl*2-h1*0.5,h1*1.2,"Bx",0.0,2) call symbol(x0-3.0*h1,y0+yl*2.80+dyl*2-h1*0.5,h1*1.2,"By",0.0,2) call symbol(x0-3.0*h1,y0+yl*2.70+dyl*2-h1*0.5,h1*1.2,"Bz",0.0,2) call symbol(x0-3.0*h1,y0+yl*1.90+dyl*1-h1*0.5,h1*1.2,"Vx",0.0,2) call symbol(x0-3.0*h1,y0+yl*1.80+dyl*1-h1*0.5,h1*1.2,"Vy",0.0,2) call symbol(x0-3.0*h1,y0+yl*1.70+dyl*1-h1*0.5,h1*1.2,"Vz",0.0,2) call symblc(x0-2.0*h1,y0+yl*0.80-h1*0.5,h1*1.2,"\\162",0.0,5) call symbol(x0-2.0*h1,y0+yl*0.65-h1*0.5,h1*1.2,"P",0.0,1) call symbol(x0-1.5*h1,y0+yl*2.5+dyl*2-h1*0.5,h1,"0",0.0,1) call symbol(x0-3.0*h1,y0+yl*2.0+dyl*2-h1*0.5,h1,"-10",0.0,3) call symbol(x0-3.0*h1,y0+yl*2.0+dyl*1-h1*0.5,h1,"400",0.0,3) call symbol(x0-1.5*h1,y0+yl*1.5+dyl*1-h1*0.5,h1,"0",0.0,1) call symbol(x0-4.0*h1,y0+yl*1.0+dyl*1-h1*0.5,h1,"-400",0.0,4) call symbol(x0-1.5*h1,y0+yl*0.0+dyl*0-h1*0.5,h1,"0",0.0,1) call symbol(x0-1.8*h1,y0+yl*0.0+dyl*0-h1*2.5,h1,"30Re",0.0,4) xg=x0 yg=y0-h1*8.0 i10=ii CALL DATA(Xg,Yg,LAST,i10,NXP,NX,h1) call symbol(x0+xl*0.5-0.45*h1,y0-h1*2.5,h1,"0",0.0,1) call symbol(x0+xl-2.0*h1,y0-h1*2.5,h1,"30Re",0.0,4) call symbol(x0+xl*0.75-0.4*h1,y0-h1*3.5,h1,"Z",0.0,1) call symbol(x0+xl*0.25-0.4*h1,y0-h1*3.5,h1,"Y",0.0,1) c C 1 DENSITY - RO IM=3 KP1=IZM(IM) VMIN=ZMIN(IM) VMAX=ZMAX(IM) XB=X0 YB=Y0 IB=1+8 LL=1 CALL GRAP7G(IAA,IB,LL,JYG2,NX,0,XB,YB,XL,YL,U,VMIN,VMAX,KP1) C 2 PRESSURE-P IAA=2 CALL NEWPE1(IPEN) IM=2 KP1=IZM(IM) VMIN=ZMIN(IM) VMAX=ZMAX(IM) XB=X0 YB=Y0 IB=5+8 LL=1 CALL GRAP7G(IAA,IB,LL,JYG2,NX,0,XB,YB,XL,YL,U,VMIN,VMAX,KP1) C 3 VELOCITY - VX VY VZ IAA=1 CALL NEWPE1(IPEN) IM=5 KP1=IZM(IM) VMIN=ZMIN(IM) VMAX=ZMAX(IM) XB=X0 YB=Y0+YL+DYL IB=2+8 LL=3 CALL GRAP7G(IAA,IB,LL,JYG2,NX,0,XB,YB,XL,YL,U,VMIN,VMAX,KP1) C 4 MAGNETIC FIELD - BX BY BZ CALL NEWPE1(IPEN) IM=8 KP1=IZM(IM) VMIN=ZMIN(IM) VMAX=ZMAX(IM) XB=X0 YB=Y0+2.0*(YL+DYL) IB=6+8 LL=3 CALL GRAP7G(IAA,IB,LL,JYG2,NX,0,XB,YB,XL,YL,U,VMIN,VMAX,KP1) CALL PLOTE 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 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 call plots(idci,ity,isz,INO) call factor(fct) call newpen(ipen) c xg=x0 yg=y0-h1*8.0 i10=ii CALL DATA(Xg,Yg,LAST,i10,NXP,NX,h1) C XL=1.300*XL0 YL=1.300*YL0 h2=h1*10 call symbol(x0,y0+yl*2+dyl*1+h1*3.5,h1*1.5,chg(g1),0.0,7) call symbol(x0+h2,y0+yl*2+dyl*1+h1*3.5,h1*1.5,ch1(g2),0.0,5) call symbol(x0,y0+yl*2+dyl*1+h1*6.0,h1*1.5,chr(g1),0.0,22) C 2 PRESSURE-P IM=2 KP1=IZM(IM) VMIN=ZMIN(IM) VMAX=ZMAX(IM) XB=X0+XL+DXL YB=Y0 call symbol(xb,yb+yl+h1*0.2,h1*1.2,"P",0.0,1) 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 3 DENSITY-RO IM=3 KP1=IZM(IM) VMIN=ZMIN(IM) VMAX=ZMAX(IM) XB=X0+0.0*(XL+DXL) call symblc(xb,yb+yl+h1*0.5,h1*1.2,"\\162",0.0,5) III=1 call symbol(xb+xl-h1,yb+yl*0.5-h1*1.9,h1,"-30Re",0.0,5) call symbol(xb-4.0*h1,yb+yl*0.5-h1*1.9,h1,"30Re",0.0,4) call symbol(xb-1.3*h1,yb+yl*0.5-h1*0.5,h1,"X",0.0,1) call symbol(xb+xl*0.5-0.4*h1,yb+yl*1.0+h1*0.2,h1,"Z",0.0,1) 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,"30Re",0.0,4) call symbol(xb+xl*0.6-0.4*h1,yb+yl+h1*0.2,h1,"30Re",0.0,4) call symbol(xb+xl*0.6-0.4*h1,yb-h1*1.2,h1,"30Re",0.0,4) 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 5 VR,VZ IM=5 KP1=IZM(IM) VMIN=0.5*ZMIN(IM) VMAX=0.5*ZMAX(IM) XB=X0+XL+DXL YB=Y0+YL+DYL 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) MB=1 DO 150 J=1,JYG DO 150 I=1,N1 I1=I+N1*(J-1) I2=I1+JXG I3=I1+JXG*2 I4=I1+JXG*3 U(I1)=F(I2) IF(J.GT.JYG/2) U(I2)=F(I4) IF(J.LE.JYG/2) U(I2)=-F(I3) 150 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 YB=Y0+2.0*(YL+DYL) XB=X0 YB=Y0+1.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,yb+yl*0.5-h1*1.9,h1,"-30Re",0.0,5) call symbol(xb-4.0*h1,yb+yl*0.5-h1*1.9,h1,"30Re",0.0,4) call symbol(xb-1.3*h1,yb+yl*0.5-h1*0.5,h1,"X",0.0,1) call symbol(xb+xl*0.5-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.6-0.3*h1,yb+yl+h1*0.2,h1,"30Re",0.0,4) call symbol(xb+xl*0.6-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 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) 180 CONTINUE CALL GRAP3A(MXA,MYA,MB,NXG,NZG,NXP,XB,YB,XL,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