!--------( PCHKMAG : plot mag.TotalForce profile of AM data )-------- implicit none integer :: lwkdir, lrtrim real,parameter :: ras = (2.54/300.) ! assume 300dpi, ras (cm) = 1 raster size ! 2100 data / full width (2100 rasters = 17.78 cm) ! 3.5 min. (= 210 sec.) data if 0.1 sec. intv. sampling integer :: mc(2100); real :: f(2100) character(16) :: atyp(0:4) & = (/ '0:CommonASCIIobs', '1:DPAM/HGAM(1st)', '2:HGAM(2nd) ', & '3:HeliBird(1st) ', '4:HeliBird(2nd) ' /) character(80) :: wdr, flog, fnin, fnam character(150) :: buf; character(27) :: label; character(20) :: sdtm character(8) :: lnam integer :: ldr, ktyp, kend, irow, n, j, m, iymd, km, i, IER integer :: mv, m1, m2, m2r, kor real :: fid, flat, flon, falt, tmag, tmag1, tres, yo, x, y real(8) :: tms call premsg('PCHKMAG : plot mag.TotalForce profile of AM data') call opnpin() ldr = lwkdir(50,wdr) + 1 flog = wdr; fnin = wdr; fnam = wdr call gparma('Enter LOG filename ==> ', 81-ldr, flog(ldr:80)) call premsg('Select Data Type') call premsg(' [ 1:DPAM or HGAM(1st) 3:HeliBird(1st) 4:HeliBird(2nd)') call gparmi(' 2:HGAM(2nd) or 0:CommonASCIIobs ] ==> ', ktyp) if ((ktyp < 0) .or. (ktyp > 4)) call abendm('Unknown Type') call gparma('Enter Input data filename ==> ', 81-ldr, fnin(ldr:80)) open(1,file=fnin,status='old') call gparma('Enter Output PS filename ==> ', 81-ldr, fnam(ldr:80)) call clspin() if (fnam(ldr:ldr) == ' ') fnam(1:1) = char(0) if (fnam(80:80) /= ' ') call abendm('too long filename') write(6,'(a)') '----------------------------------------' write(6,'(a)')'PCHKMAG : plot mag.TotalForce profile of AM data' write(6,'(a,a)') ' Data Type : ', atyp(ktyp) write(6,'(a,a)') ' Input data filename : ', fnin(1:lrtrim(fnin)) write(6,'(a,a)') ' Output PS filename : ', fnam(1:lrtrim(fnam)) call psopn(fnam, 'A4P') kend = 0; lnam = 'whole ' call plots(1.5, 2.0) call lstyle('T', 0.4, 0., 0, -999) irow = 10 ! 10 rows / page do n = 0 do read(1,'(a)',iostat=IER) buf if (IER < 0) then; kend = 1; exit; endif if ((buf(1:1) == '#') .or. (buf(1:1) == '/')) then if (buf(1:10) == '/DateTime:') read(buf(11:19),*) iymd else if ((buf(1:1) == '&') .or. (buf(1:1) == '%')) then read(buf,'(1x,a8)') lnam if (n > 0) exit else if (ktyp == 0) then read(buf,'(8x,11x,10x,f10.3)') tmag if (n == 0) then read(buf,'(8x,i2,1x,i2,1x,f5.2)') j,m,tms tms = tms + (j*100 + m)*100 endif else if (ktyp == 1) then read(buf,*) fid,iymd,tms,km,flat,flon,falt,tmag else if (ktyp == 2) then read(buf,*) fid,iymd,tms,km,flat,flon,falt,tmag1,tres,tmag else read(buf,'(i9,1x,2(i2,1x),f5.2,2f10.2)') iymd,j,m,tms,tmag,tmag1 tms = tms + (j*100 + m)*100 if (ktyp == 4) tmag = tmag1 endif if (n == 0) write(label,'(a8,1x,i8,1x,f9.2)') lnam,iymd,tms n = n + 1; if (tmag < 0.) tmag = 0.; f(n) = tmag if (n == 2100) exit endif enddo if (n == 0) exit irow = irow - 1 if (irow < 0) then call ptext(fnin, 80, 0., -1., 0) call plote() call plots(1.5, 2.0) call lstyle('T', 0.4, 0., 0, -999) irow = 9 endif x = 0.; yo = ras * float(irow*300) ! 300 dots (=2.54 cm) / row call ptext(label, 27, 0., yo+1.9, 0) call plot(x, yo+1.143, 3) do i=1,n mv = nint(f(i)*5.) ! convert to 125 dots (300dpi) / 25nT m2 = mv/125; m1 = mv - m2*125 if (m1 < 0) then m2 = m2 - 1; m1 = m1 + 125 endif if ((m1 < 12) .and. (kor == 1) .and. (m2 == (m2r+1))) then m2 = m2-1; m1 = m1+125 else if (m1 < 69) then kor = 0 else kor = 1 endif m2r = m2; m2 = m2 - m2/40*40 if (m2 < 0) m2 = m2 + 40; mc(i) = m2 ! Fine (m1) full range size : 125 dots (+10%) ! Fine (m1) full range : 25nT (+10%) [5 dots / nT] ! Coarse (m2) full range : (25x40=) 1000nT ! Coarse (m2) full range size : 80 dots y = yo + ras*float(m1) call plot(x, y, 2) x = ras*float(i) call plot(x, y, 2) enddo do i=n,1,-1 y = yo + ras*float(mc(i)*2+140) call plot(x, y, 2) x = ras*float(i-1) call plot(x, y, 2) enddo call plot(x, yo+1.143, 2) if (kend == 1) exit enddo call ptext(fnin, 80, 0., -1., 0) call plote() call pscls() if (flog(ldr:ldr) /= ' ') then open(99,file=flog,access='append') write(99,'(//a)') 'PCHKMAG : plot mag.TotalForce profile of AM data' write(99,'(a,a)') ' Data Type : ', atyp(ktyp) write(99,'(a,a)') ' Input data filename : ', fnin(1:lrtrim(fnin)) write(99,'(a,a)') ' Output PS filename : ', fnam(1:lrtrim(fnam)) call strdtm(sdtm) write(99,'(a,a,a)') '=============== ', sdtm, '===============' close(99) endif stop end