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 (X0=2.0,Y0=2.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 c parameter (itap=20+1*4,iip00=8,iiq00=4,ICO=3) parameter (iir00=150,thx=1.0,itapp=11,ICO=3) c** parameter (itap=6+5*3,iip00=8,iiq00=4,iir00=32,thx=4.0) parameter (ori1=315.0,tim1=960.0,ori2=360,last1=8) c** parameter (ori1=270+225*0,ori2=360,last1=8) c PARAMETER (X0=1.0,Y0=2.0,XL0=6.0,YL0=6.0) c PARAMETER (X0=0.8,Y0=3.0,XL0=5.2,YL0=5.2) c PARAMETER (X0=1.0,Y0=2.0,XL0=7.2,YL0=7.2) c PARAMETER (X0=1.0,Y0=2.0,XL0=8.2,YL0=8.2) PARAMETER (X0=0.0,Y0=0.0,XL0=10.0,YL0=10.0) PARAMETER (DXL=1.8,DYL=1.5,GTH=-60.0,TH0=60.0,DTH=10.0,JYJ=2) c c PARAMETER (NX= 320,NY= 80,NZ= 160,LAS1=41,IXC= 41) c PARAMETER (NX= 320,NY= 80,NZ= 160,LAS1=41,IXC= 61) c PARAMETER (NX= 320,NY= 80,NZ= 160,LAS1=41,IXC=101) c PARAMETER (NX= 500,NY=100,NZ= 200,LAS1=41,IXC=161) PARAMETER (NX= 180,NY= 60,NZ= 120,LAS1=41,IXC=121) c PARAMETER (NX= 500,NY=100,NZ= 200,LAS1=41,IXC=501) 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) c PARAMETER (NXG=20,NZG=20,ICU=1,MDFU=1,THBI=-60.) PARAMETER (NXG=40,NZG=20,ICU=1,MDFU=1,THBI=-60.) PARAMETER (MX=NX+2,JYG2=NZ,JYG=JYG2+2,MY=JYG2+2,MMY=MY) PARAMETER (KK=MX*MY,MX2=MX,KP=0,LANK=20,KKK=N1*JYG*2,N6=KKK*8) c PARAMETER (LAST= 1,IIQ0=1,XXL=160.50,YYL= 40.50,ZZL= 80.50,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 (LAST=12,IIQ0=1,XXL=61.00,YYL=61.00,ZZL=31.00,MM=2) c PARAMETER (NXP=100,ARU=10.0,AR1=3.0,LAN1=30,LAN2=40,MOD=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) c PARAMETER (IPE1=1,MM1=N2/4,MM2=4*NZ2,MM3=MM2*NB,KK2=KK*2) 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.32,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*15/"Bz=-5nT t=57m"/ character chrt*24/"Rotation of Incoming IMF"/ c character chrt*24/"Incoming uniform IMF "/ c character chrt*24/"Incoming southward IMF "/ c character chrt*24/"No uniform IMF "/ character chg(3)*46 c data chg(1)/"MHD Simulation for 1996 November 17 Event "/ c data chg(1)/"MHD Simulation for 1999 March 19 Event "/ data chg(1)/"MHD Simulation for 1999 October 22 Event "/ c data chg(1)/"MHD Simulation for 1999 March 20 Event "/ c data chg(2)/"B= 2.5nT t=960m (240m) "/ data chg(3)/"Density and energy of cross section "/ c character chr(6)*46 data chr(1)/"T = 22-10-1999 06:30:00 "/ data chr(2)/"T = 19-03-1999 23:20:00 "/ data chr(3)/"T = 19-03-1999 23:30:00 "/ data chr(4)/"T = 19-03-1999 23:40:00 "/ data chr(5)/"T = 19-03-1999 23:50:00 "/ data chr(6)/"T = 19-03-1999 24:00:00 "/ C DIMENSION U(KK2),F(N3),P(N6),PP(MM1),HHX(N1),FBB(16) 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, 1.0E-3, 1.0E-3, 0.0294, 1 1.0E-3, 0.8E-4, 3.000E-4, 1.0E-5/ c REWIND 12 open(11,file='eartha10.data', 1 access='sequential',form='unformatted') c open(11,file='/archive/proj5/ogino/eartha3/gh220390.data', c 1 access='sequential',form='unformatted') c open(11,file='/MC2600/OGINA046/fa191390.data', c 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 c call xyopen call initvrml 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 itap=ii+10 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 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(itap,END=9) PP IF(M.GT.4) READ(itap,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 c c do 176 m=1,ll do 176 j=1,ny2 c do 178 k=1,nz2 do 178 i=1,nx2 c i1=i+n1*(j-1)+n2*(k-1)+n3*(m-1) i1=i+n1*(j-1)+n2*(k-1) j1=i+n1*(nz2-k) u(j1)=f(i1) 178 continue c do 176 k=1,nz2 do 176 i=1,nx2 c i1=i+n1*(j-1)+n2*(k-1)+n3*(m-1) i1=i+n1*(j-1)+n2*(k-1) j1=i+n1*(k-1) f(i1)=u(j1) if(m.eq.4) f(i1)=-f(i1) if(m.eq.6) f(i1)=-f(i1) if(m.eq.7) f(i1)=-f(i1) 176 continue c 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) 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) 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) 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) c j1=j+NY+NZ2*(k-1)+JXG*(M+7) c j2=NY2-j+1+NZ2*(NZ2-k)+JXG*(M+7) j1=k+NZ2*(j+NY-1)+JXG*(M+7) j2=NZ2-k+1+NZ2*(NY2-j)+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) if(M.eq.4) P(j2)=-P(j1) if(M.eq.6) P(j2)=-P(j1) 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 I10=I9+JXG I11=I10+JXG I12=I11+JXG I13=I12+JXG I14=I13+JXG I15=I14+JXG I16=I15+JXG F(I1)=F(I5)/F(I1) c afx1=AMAX1(F(I9),1.0e-10) F(I9)=F(I13)/afx1 c cc F(I9)=F(I13)/F(I9) 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 do 72 m=1,4 do 72 k=1,NZ2 do 72 i=1,NX2 i1=i+n1*(k-1)+jxg*(m-1) i2=i+n1*(NZ2-K)+jxg*(m+3) f(i2)=f(i1) 72 continue c do 74 j=1,ny1 do 74 i=1,NX2 i1=i+n1*(j-1) i2=i1+jxg i3=i2+jxg i4=i3+jxg i5=i4+jxg i6=i5+jxg i7=i6+jxg i8=i7+jxg x1=f(i1) x2=f(i2) x3=f(i3) x4=f(i4) x5=f(i5) x6=f(i6) x7=f(i7) x8=f(i8) f(i1)=x5 f(i2)=x6 f(i3)=-x7 f(i4)=-x8 f(i5)=x1 f(i6)=x2 f(i7)=-x3 f(i8)=-x4 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 c call plots(idci,ity,isz,INO) c call factor(fct) c call newpen(ipen) c xg=x0 yg=y0-h1*4.0 ygg=y0-h1*6.0 i10=ii c CALL DATA(Xg,Ygg,LAST,i10,NXP,NX,h1) C c XL=1.000*XL0*1.5 XL=1.000*XL0*2.0 YL=1.000*YL0 h2=h1*10 xg=X0+XL+XL0*0.30+DXL xg=X0 sg1=(Nx*0.5+1-nxp-ixcc)*HX hhs=1.0*h1 c call datasg(xg,yg,sg1,hhs) g1=int((ii-1)/4)+1 c g1=int((ii-1)/2)+1 c g1=2*(int((ii-1)/2)+1) c c call symbol(x0,y0+yl*3+dyl*2+h1*3.5,h1*1.5,chg(g1),0.0,7) c* yy=y0+yl*2+dyl*2+h1*0.5 yy=y0+yl*3+dyl*3.5+h1*0.5 c call symbol(x0+h1*2,yy+0.25*g1*yl,h1,ch2(g1),0.0,4) g2=ii-(g1-1)*4 c g2=ii-(g1-1)*2 c g2=2*(ii-2*int((ii-1)/2)) xgg=x0+xl*0.8 c* ygg=y0+yl*2+dyl+h1*3.5 ygg=y0+yl*3+dyl*2.5+h1*3.5 hhs=h1*1.5 ccccccccccccccccccccccccccccc CCC ori=ori1+ori2/last1*ii ccc ori=ori1-ori2/last1*ii ori=ori1 ccc ori=ori1-ori2/(8*iir00/75)*ii cc 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 c thx=4.0 cccccccccccccccccccccccccccccc CCC tim=iir00*iiq00*iip00*0.937*0.5*thx*0.6*(ii+itap)/60 c iir0=100 thx=1 to site 22.5 do wo hyougen suru tameni c itapp wo dounyu c tim1=iir00*iiq00*iip00*0.937*0.5*thx*0.8 c tim=tim1 ccc tim=tim1*(ii*1.0+itap+itapp*0.5)/60 c xg1=x0+h2+h1*2 c* yg1=y0+yl*2+dyl*1+h1*3.5 c 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) c 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) c call symbol(x0,y0+yl*3+dyl*2.5+h1*6.0,h1*1.5,chg(1),0.0,46) c z houkou no pressure de aru c c ccccccccccccccccccccccccccccccccccccccccccccccccc C 1 and 2 Temperature c********************** IM=3 KP1=IZM(IM) VMIN=ZMIN(IM) VMAX=1.0*ZMAX(IM) VMAX=0.5*ZMAX(IM) XB=X0 YB=Y0 YB=Y0+0.0*(yl+dyl) c 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) c call symbol(xb+xl+h1*0.2,yb+yl*0.5-h1*0.6,h1,"-220Re",0.0,6) c call symbol(xb-3.8*h1,yb+yl*0.5-h1*1.9,h1,"30Re",0.0,4) c call symbol(xb-2.3*h1,yb+yl*0.5-h1*0.5,h1,"X",0.0,1) c call symbol(xb+xl*0.19-0.4*h1,yb+yl*1.0+h1*0.2,h1,"Z",0.0,1) c call symbol(xb+xl*0.19-0.4*h1,yb-h1*1.3,h1,"Y",0.0,1) c call symbol(xb+xl*0.29-0.3*h1,yb+yl+h1*0.2,h1,"50Re",0.0,4) c call symbol(xb+xl*0.29-0.3*h1,yb-h1*1.2,h1,"50Re",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 CALL COLOR2(MX,MMY,XB,YB,XL,YL,U,VMIN,VMAX,ICO) c call imagc2(mx,mmy,xb,yb,xl,yl,u,vmin,vmax,ico) xb=-18.0 yb=-18.0 xl=54.0 yl=36.0 ipx0=4 icc=1 zcc=0.0 call pixel1(mx,mmy,xb,yb,xl,yl,ipx0,ico,icc,zcc,vmin,vmax,u) c CALL NEWPE1(IPE1) c 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) XB=X0 YB=Y0+0.0*(YL+DYL) c YB=Y0+yl+yb c call symbol(xb,yb+yl+h1*0.3,h1*1.2,"V",0.0,1) c call symblc(xb-0.1*h1,yb+yl+h1*1.6,h1*1.2,"\\256",0.0,5) c call symbol(xb+xl+h1*0.2,yb+yl*0.5-h1*0.6,h1,"-220Re",0.0,6) c call symbol(xb-3.3*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.19-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,"50Re",0.0,4) c call symbol(xb+xl*0.19-0.4*h1,yb-h1*1.3,h1,"Y",0.0,1) c call symbol(xb+xl*0.29-0.4*h1,yb-h1*1.3,h1*1.00,"50Re",0.0,4) c call symbol(xb+xl*0.29-0.3*h1,yb+yl+h1*0.2,h1,"50Re",0.0,4) c call symbol(xb+xl*0.29-0.3*h1,yb-h1*1.2,h1,"-50Re",0.0,5) MB=1 DO 1801 J=1,JYG DO 1801 I=1,N1 I1=I+N1*(J-1) I2=I1+JXG I3=I2+JXG I4=I3+JXG I5=I4+JXG I6=I5+JXG I7=I6+JXG I8=I7+JXG U(I1)=F(I2) U(I2)=F(I4) 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(I7) c U(I1)=F(I2) c U(I2)=-F(I4) c U(I2)=-F(I3) 1801 CONTINUE c CALL GRAP3A(MXA,MYA,MB,NXG,NZG,NXP,XB,YB,XL,YL,AR2, c 1 U,VMIN,VMAX,URMIN,KP1,IAR,LAS1) c CALL NEWPE1(IPE1) c c call plote INO=INO+1 ity=1 c call plots(idci,ity,isz,INO) c call factor(fct) c call newpen(ipen) c c ccccccccccccccccccccccccccccccccccccccccccccccccc C 3 and 4 Temperature c********************** IM=3 KP1=IZM(IM) VMIN=ZMIN(IM) VMAX=1.0*ZMAX(IM) VMAX=0.5*ZMAX(IM) XB=X0 YB=Y0 YB=Y0+0.0*(yl+dyl) c 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) c call symbol(xb+xl+h1*0.2,yb+yl*0.5-h1*0.6,h1,"-220Re",0.0,6) c call symbol(xb-3.8*h1,yb+yl*0.5-h1*1.9,h1,"30Re",0.0,4) c call symbol(xb-2.3*h1,yb+yl*0.5-h1*0.5,h1,"X",0.0,1) c call symbol(xb+xl*0.19-0.4*h1,yb+yl*1.0+h1*0.2,h1,"Z",0.0,1) c call symbol(xb+xl*0.19-0.4*h1,yb-h1*1.3,h1,"Y",0.0,1) c call symbol(xb+xl*0.29-0.3*h1,yb+yl+h1*0.2,h1,"50Re",0.0,4) c call symbol(xb+xl*0.29-0.3*h1,yb-h1*1.2,h1,"50Re",0.0,4) III=5 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) c call imagc2(mx,mmy,xb,yb,xl,yl,u,vmin,vmax,ico) xb=-18.0 yb=-18.0 xl=54.0 yl=36.0 ipx0=4 icc=3 zcc=0.0 call pixel1(mx,mmy,xb,yb,xl,yl,ipx0,ico,icc,zcc,vmin,vmax,u) c CALL NEWPE1(IPE1) c 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) XB=X0 YB=Y0+0.0*(YL+DYL) c YB=Y0+yl+yb c call symbol(xb,yb+yl+h1*0.3,h1*1.2,"V",0.0,1) c call symblc(xb-0.1*h1,yb+yl+h1*1.6,h1*1.2,"\\256",0.0,5) c call symbol(xb+xl+h1*0.2,yb+yl*0.5-h1*0.6,h1,"-220Re",0.0,6) c call symbol(xb-3.3*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.19-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,"50Re",0.0,4) c call symbol(xb+xl*0.19-0.4*h1,yb-h1*1.3,h1,"Y",0.0,1) c call symbol(xb+xl*0.29-0.4*h1,yb-h1*1.3,h1*1.00,"50Re",0.0,4) c call symbol(xb+xl*0.29-0.3*h1,yb+yl+h1*0.2,h1,"50Re",0.0,4) c call symbol(xb+xl*0.29-0.3*h1,yb-h1*1.2,h1,"-50Re",0.0,5) MB=1 DO 180 J=1,JYG DO 180 I=1,N1 I1=I+N1*(J-1) I2=I1+JXG I3=I2+JXG I4=I3+JXG I5=I4+JXG I6=I5+JXG I7=I6+JXG I8=I7+JXG U(I1)=F(I6) U(I2)=F(I7) 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(I4) c* IF(J.LE.JYG/2) U(I1)=-F(J6) c 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 c CALL GRAP3A(MXA,MYA,MB,NXG,NZG,NXP,XB,YB,XL,YL,AR2, c 1 U,VMIN,VMAX,URMIN,KP1,IAR,LAS1) c CALL NEWPE1(IPE1) c c call plote INO=INO+1 ity=1 c call plots(idci,ity,isz,INO) c call factor(fct) c call newpen(ipen) c c c 2 density-rho IM=4 KP1=IZM(IM) VMIN=ZMIN(IM) VMAX=1.0*ZMAX(IM) VMAX=0.5*ZMAX(IM) XB=X0+XL+DXL XB=X0 YB=Y0 YB=Y0+0.0*(yl+dyl) c 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) c call symbol(xb+yl+0.5*h1,yb+yl*0.5-h1*1.9,h1,"50Re",0.0,4) c call symbol(xb-4.05*h1,yb+yl*0.5-h1*1.9,h1,"-50Re",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+yl*0.63-0.1*h1,yb+yl+h1*0.2,h1,"50Re",0.0,4) c call symbol(xb+yl*0.63-0.3*h1,yb-h1*1.2,h1,"-50Re",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) c call imagc2(mmy,mmy,xb,yb,yl,yl,u,vmin,vmax,ico) xb=-18.0 yb=-18.0 xl=36.0 yl=36.0 ipx0=4 icc=2 zcc=(Nx*0.5+1-nxp-ixcc)*HX zcc=-zcc c zcc=0.0 call pixel1(mmy,mmy,xb,yb,yl,yl,ipx0,ico,icc,zcc,vmin,vmax,u) c 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) XB=X0 YB=Y0+0.0*(YL+DYL) c YB=Y0+yl+yb c call symbol(xb,yb+yl+h1*0.3,h1*1.2,"V",0.0,1) c call symblc(xb-0.1*h1,yb+yl+h1*1.6,h1*1.2,"\\256",0.0,5) c call symbol(xb+yl+0.5*h1,yb+yl*0.5-h1*1.9,h1,"50Re",0.0,4) c call symbol(xb-3.95*h1,yb+yl*0.5-h1*1.9,h1,"-50Re",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,"50Re",0.0,4) c call symbol(xb+yl*0.63-0.1*h1,yb+yl+h1*0.2,h1,"50Re",0.0,4) c call symbol(xb+yl*0.63-0.3*h1,yb-h1*1.2,h1,"-50Re",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 c CALL GRAP3A(MYA,MYA,MB,NZG,NZG,0,XB,YB,YL,YL,AR2, c 1 U,VMIN,VMAX,URMIN,KP1,IAR,LAS1) c CALL NEWPE1(IPE1) c xg=x0 yg=y0-h1*4.0 sg1=(Nx*0.5+1-nxp-ixcc)*HX hhs=1.0*h1 c call datasg(xg,yg,sg1,hhs) c 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 DIFF2(M,MX,MY,U,V) DIMENSION U(1),V(1) C IF(M.EQ.99) GO TO 99 ALP=1.0/8.0 MX1=MX-1 MY1=MY-1 N1=MX*MY DO 100 II=1,M DO 12 I=1,N1 V(I)=U(I) 12 CONTINUE DO 14 J=2,MY1 DO 14 I=2,MX1 I1=I+MX*(J-1) U(I1)=(1.0-4.0*ALP)*V(I1)+ALP*(V(I1-1)+V(I1+1)+V(I1-MX)+V(I1+MX)) 14 CONTINUE MY2=MX*(MY-2) C DO 16 I=2,MX1 I1=I U(I1)=(1.0-4.0*ALP)*V(I1)+ALP*(V(I1-1)+V(I1+1)+2.0*V(I1+MX)) I1=I+MX*(MY-1) U(I1)=(1.0-4.0*ALP)*V(I1)+ALP*(V(I1-1)+V(I1+1)+2.0*V(I1-MX)) 16 CONTINUE DO 18 J=2,MY1 I1=1+MX*(J-1) U(I1)=(1.0-4.0*ALP)*V(I1)+ALP*(2.0*V(I1+1)+V(I1-MX)+V(I1+MX)) I1=MX+MX*(J-1) U(I1)=(1.0-4.0*ALP)*V(I1)+ALP*(2.0*V(I1-1)+V(I1-MX)+V(I1+MX)) 18 CONTINUE C DO 20 I=1,MX I1=I+MX*MY1/2 U(I1)=V(I1) 20 CONTINUE C 100 CONTINUE 99 CONTINUE RETURN END