C THIS SUBROUTINE PLOTS ELECTRON DENSITY VS ALTITUDE FOR C EACH INPUT IONOGRAM. IT ALSO PLOTS THE XTRACE AND THE C CALCULATED O-TRACE (RANGE VS FREQUENCY). FINALLY, IT C COLLECTS THE DATA FOR USE IN THE CONTOURING ROUTINE, C CONT. SUBROUTINE PLOT1(IHDR,TITL,ISP,ZHMAX,ISVE,ITYP,IX,IY,ZDLAT,ZDLONG) IMPLICIT REAL*8 (A-H,O-Y) LOGICAL*1 TIT2(80),TITL(80) LOGICAL*4 TIT4(20) COMPLEX*16 TIT1(5) EQUIVALENCE (TIT1(1),TIT2(1)),(TIT4(1),TIT2(1)) COMMON/MID/XMID,YMID C TIT1 IS USED TO BUILD THE SKELETON TITLE FOR THE ELECTRON DENSITY C PLOTS. WE THEN USE TIT2 (WHICH IS EQUIVALENCED WITH IT) TO FILL C IN THE HOLES. DATA TIT1/'DAY ( / ) ','OF 19 AT ',' GMT LMT' X,' ',' '/ C ZTH4,ZED4,ZF,ZFO,ZHP,ZHPO ARE SINGLE PRECISION ARRAYS DESIGNED C TO HOLD THE DATA FOR THE TWO PLOTS MADE FROM EACH IONOGRAM. DIMENSION IPTR(210),TH3(210),ED3(210),ZTH4(210),ZED4(210),ZF(50), X ZFO(50),FH1(70),FN(70),ZHPO(50),ZHP(50) COMMON /CALC/ AA(50),BB(50),F(50),HP(50),FH(50),TH(70),DEN(70) C COMMON /CNT/ HOLDS THE DATA TO BE CONTOURED, AND PASSES IT C BACK TO MAIN. COMMON /CNT/ZA(2500,3),ZXCO(50),LA,LXCO,ZA2(80,3),LA2 COMMON /IO/IYR,IDY,ITI,LMT,TITLE(40),DIP,FHS,MON,IDAY COMMON /TIME/IH,IM,IS COMMON /OCALC/ FO(50),HPO(50) COMMON /SWJTCH/ ISAT,LOCSAT,IFXS,NCASES,ICODE(4),N,METHOD,IORD COMMON /PL/ TH1(70),ED1(70),TH2(70),ED2(70),M,M1 C IF THIS IS THE FIRST CALL TO THIS ROUTINE,WE MUST INITIALIZE. DATA INIT /0/ IF(INIT.NE.0) GO TO 10 c CALL PLOTST(00001,1) c XL=500. c YB=375. c XR=3942. c YT=2850. c CALL SETGRD(500.,375.,3942.,2850.,1) c XMID=((XR-XL)/2.)+XL c YMID=((YT-YB)/2.)+YB 10 CONTINUE C WE NOW FIT DAY, MONTH, TIME, ETC INTO THE SKELETON TITLE. c CALL EDIT(REAL(IDY),'I3)',TIT2(5),NN,IBL,1,IERR) c CALL EDIT(REAL(MON),'I2)',TIT2(10),NN,IBL,1,IERR) c CALL EDIT(REAL(IDAY),'I2)',TIT2(13),NN,IBL,1,IERR) c CALL EDIT(REAL(IYR),'I2)',TIT2(22),NN,IBL,1,IERR) c CALL EDIT(REAL(ITI),'I6)',TIT2(28),NN,IBL,1,IERR) c CALL EDIT(REAL(LMT),'I6)',TIT2(39),NN,IBL,1,IERR) C NOW SIGNAL THAT THIS ROUTINE HAS BEEN CALLED. INIT=1 DO 15 I=1,20 ZF(I)=F(I) ZHP(I)=HP(I) ZFO(I)=FO(I) 15 ZHPO(I)=HPO(I) write(7,*) ' ' write(8,*) ' ' do ka=1,20 write(7,*) zf(ka),zhp(ka) write(8,*) zfo(ka),zhpo(ka) enddo C WE NOW MUST PLOT THE X AND O TRACES. c CALL SETSIZ(1.5) c CALL GRID(0.,10.,40,'F3.0)',4,4400.,0.,22,'F5.0)',1,0) C IF HEADERS HAVE BEEN REQUESTED (SEE READ4), PLOT THEM. c IF(IHDR.NE.0) GO TO 17 c CALL VERLIN('VIRTUAL HEIGHT(KM)',-18,300.,YMID,-8,0) c CALL HORLIN('FREQUENCY(MHZ)',14,XMID,190.5,0,-2) c 17 CALL PLOT(ZF,ZHP,N,'X') C IF THE O-TRACE HAS BEEN CALCULATED, PLOT IT c IF(IORD.EQ.1) CALL PLOT(ZFO,ZHPO,N,'O') c CALL FRMADV C NEXT THE ELECTRON DENSITY PLOT. C CALCULATE THE NUMBER OF INTERVALS ON THE Y-AXIS FROM THE MAX ALT. L=ZHMAX/500+.5 c CALL OGRID(1.,7.,6,'F2.0)',1,0.,ZHMAX,L,'F5.0)',1,0) c CALL SCALE(10.,1.00E+07,0.,ZHMAX,1) C IF HEADERS HAVE BEEN REQUESTED, PLOT THEM. c IF(IHDR.NE.0) GO TO 18 c CALL HORLIN('LOG ELECTRON DENSITY(CM-3)',26,XMID,190.5,0,-2) c CALL VERLIN('ALTITUDE(KM)',-12,300.,YMID,-8,0) c CALL HORLIN(TITL,70,XMID,2850.,0,4) c CALL HORLIN(TIT2,48,XMID,2850.,0,2) C NOW WE GATHER UP ALL THE ELECTRON DENSITY AND TRUE HEIGHT ARRAYS. 18 DO 20 I=1,N TH3(I)=TH(I) 20 ED3(I)=DEN(I) DO 30 I=1,M TH3(N+I)=TH1(I) 30 ED3(N+I)=ED1(I) DO 40 I=1,M1 TH3(M+N+I)=TH2(I) 40 ED3(M+N+I)=ED2(I) M2=M+N+M1 C NOW THAT THE THREE ELECTRON DENSITY ARRAYS HAVE BEEN COALESCED, C WE MUST SORT THEM. CALL PTRSRT(ED3,M2,IPTR) DO 50 I=1,M2 ZED4(I)=ED3(IPTR(I)) 50 ZTH4(I)=TH3(IPTR(I)) write(9,*) ' ' do kb=1,m2 write(9,*) zed4(kb),zth4(kb) enddo C NOW FOR THE ACTUAL PLOTTING. c CALL PLOT(ZED4,ZTH4,M2,' ') c CALL FRMADV C NOW WE INTERPOLATE FH VALUES AT EACH 50 KM MARKER BETWEEN THE F-PEAK C AND THE SATELLITE. J=TH(1)/50 K=TH(N)/50+1 L=N DO 110 I=K,J 120 IF(I.LE.(TH(L-1)/50)) GO TO 110 L=L-1 GO TO 120 110 FH1(J-I+2)=FH(L)*(6371.2+TH(L))**3/(6371.2+50*I)**3 FH1(1)=FH(1) FH1(M)=FH(N) C NOW WE PLACE THE ELECTRON DENSITIES AT THE SAME LOCATIONS IN FN. DO 135 I=1,M 135 FN(I)=ED1(I) C IF WE ARE GOING TO CONTOUR ELECTRON DENSITY, SKIP CALCULATIONS. IF(ITYP.EQ.0) GO TO 130 C NOW CALCULATE THE PLASMA FREQUENCY AND PUT IT IN FN. DO 140 I=1,M 140 FN(I)=DSQRT(ED1(I)*80.6)/1000. GO TO (130,150,160,170,180,190),ITYP C IF FN/FH HAS BEEN REQUESTED, CALCULATE IT. 150 DO 155 I=1,M 155 FN(I)=FN(I)/FH1(I) GO TO 130 C IF FX HAS BEEN REQUESTED, CALCULATE IT. 160 DO 165 I=1,M 165 FN(I)=.5*(FH1(I)+DSQRT(FH1(I)**2+4*FN(I)**2)) GO TO 130 C IF FZ HAS BEEN REQUESTED, CALCULATE IT. 170 DO 175 I=1,M 175 FN(I)=.5*(-FH1(I)+DSQRT(FH1(I)**2+4*FN(I)**2)) GO TO 130 C IF FT HAS BEEN REQUESTED, CALCULATE IT. 180 DO 185 I=1,M 185 FN(I)=DSQRT(FH1(I)**2+FN(I)**2) GO TO 130 C IF FH HAS BEEN REQUESTED PUT IT IN FN ARRAY. 190 DO 195 I=1,M 195 FN(I)=FH1(I) 130 CONTINUE C NOW TO GATHER THEM WITH THE VALUES FOR OTHER IONOGRAMS TO C BE CONTOURED. LXCO=LXCO+1 IX1=IX+1 C WE DECIDE WHAT TO PUT IN ZXCO BASED ON WHAT X-COORDINATE HAS BEEN C SPECIFIED. GO TO(200,210,220,230),IX1 200 ZXCO(LXCO)=ZDLAT GO TO 240 210 ZXCO(LXCO)=IS+IM*60 GO TO 240 220 ZXCO(LXCO)=IM+IS/60. GO TO 240 230 ZXCO(LXCO)=ZDLONG 240 CONTINUE C C THIS CODE ADDED IN ATTEMPT TO IMPLEMENT THE 'SAVE DATA' OPTION C UNIT 9 IS LIB.DATA(SAVEIT) C SAVING FN,FH,ZDLAT,ZDLONG,M,TH1,IYR,IDY,IH,IM,IS C P.K. PARKER 9/11/81 C IF(ISVE .EQ. 0) GOTO 250 WRITE(9,300) M WRITE(9,310) ZDLAT,ZDLONG 300 FORMAT(I6) 310 FORMAT(F14.8,4X,F14.8) DO 320 I=1,M 320 WRITE(9,330) TH1(I),ED1(I),FH1(I) 330 FORMAT(3(F20.8,4X)) WRITE(9,340) IYR,IDY WRITE(9,350) IH,IM,IS 340 FORMAT(2I10) 350 FORMAT(3I10) C C END SAVE OPTION INSERT C C NOW WE STORE THE INFO IN THE ARRAY TO BE CONTOURED. 250 DO 60 I=1,M ZA(LA+I,1)=ZXCO(LXCO) ZA(LA+I,2)=TH1(I) IF(IY.EQ.1) ZA(LA+I,2)=TH1(1)-ZA(LA+I,2) ZA(LA+I,3)=FN(I) 60 CONTINUE LA=LA+M C NOW WE STORE SATELLITE OR F-PEAK POINTS, AS REQUESTED. IF(ISP.EQ.0) RETURN IF(ISP.EQ.2) GO TO 70 LA2=LA2+1 ZA2(LA2,1)=ZXCO(LXCO) ZA2(LA2,2)=TH1(1) IF(IY.EQ.1) ZA2(LA2,2)=TH1(1)-ZA2(LA2,2) ZA2(LA2,3)=FN(1) 70 IF(ISP.EQ.1) RETURN LA2=LA2+1 ZA2(LA2,1)=ZXCO(LXCO) ZA2(LA2,2)=TH1(M) IF(IY.EQ.1) ZA2(LA2,2)=TH1(1)-ZA2(LA2,2) ZA2(LA2,3)=FN(N) RETURN END