C ************************************************************************ C PROGRAM D E P T H P L O T C ************************************************************************ C PROGRAM TO CHECK A DEPTH FILE C PLOT PACKED DEPTH FILE AND GIVE MINIMUM AND MAXIMUM VALUES C BEFORE RUNNING ADJUST: C DIMENSIONS IN PARAMETER C FILE NAME C PLOT PARAMETERS IN CALL FOR ISOCOR1D, IF NEEDED C LAT AND LONG DIMENSIONS FOR MAP PLOT IN MAPSET C IF DO NOT WANT MAPS IS JUST TO COMENT COMMANDS C IF DO NOT WANT SPECIAL VALUE JUST COMMENT IT INSIDE 10 LOOP, BUT THEM IT C WOULD BE NICE NOT TO CONSIDER AREA INSIDE MAP (FURTHER IMPROVMENT, WHO C KNOWS WHEN) C ************************************************************************ program depthplot parameter (idm=1437, jdm=1678) c parameter (idm=1071, jdm=1437) dimension depths(idm,jdm), ddd(jdm,idm) character*2 util(idm*jdm+14),preambl(5)*79 C ************************************************************************ open(1,file='depth.1437x1678', & status='old') c open(1,file='depth.1437x1437', c & status='old') c open(1,file='depth1437.raw', c & status='old') c open(1,file='depthdamee.1071x1437', c & status='old') READ (1,'(A79)') PREAMBL READ (1,120) IDIM,JDIM,LENGTH,(UTIL(L),L=1,LENGTH) 120 FORMAT (3i8/(40a2)) call unpakk(depths,idm,idim,jdim,util,length) close (1) C ************************************************************************ call opngks C TEST MAXIMUM AND MINIMUN VALUES dmin = 5555555. dmax = 0. do 10 i=1,idm do 10 j = 1,jdm if(depths(i,j).lt.dmin) dmin = depths(i,j) if(depths(i,j).gt.dmax) dmax = depths(i,j) 10 continue write(*,*) ' dmin = ',dmin write(*,*) ' dmax = ',dmax do i = 1,idm write(*,*) i,depths(i,50),depths(i,105),depths(i,205) enddo C PLOT ORIGINAL FILE do 20 i=1,idm do 20 j = 1,jdm ddd(j,i) = depths(idm+1-i,j) if(ddd(j,i).eq.0.) ddd(j,i) = -0.01 20 continue do i = 1,idm write(*,*) i,ddd(50,i),ddd(105,i),ddd(205,i) enddo c call cpsetr ('spv - special value',999999.) c call cpseti ('pai - parameter array index', -2) c call cpseti ('clu',1) c call cpseti ('clc',0) c call conrec (ddd,jdm,jdm,idm, -1.,1.,1., 0,-1.,-366) call conrec (ddd,jdm,jdm,idm, 0.,10000.,10000., 0,-1.,-366) call perim (1,0,1,0) call frame call conrec (ddd,jdm,jdm,idm, 0.,1000.,200., 0,-1.,-366) call perim (1,0,1,0) call frame call conrec (ddd,jdm,jdm,idm, 0.,200.,100., 0,-1.,-366) call perim (1,0,1,0) call frame call conrec (ddd,jdm,jdm,idm, 0.,5000.,200., 0,-1.,-366) call frame c call conrec (ddd,jdm,jdm,idm, 0.,8000.,4000., 0,-1.,-366) c call perim (1,0,1,0) call clsgks stop end C ************************************************************************ subroutine pakk(array,idim,ii,jj,compac,length) c c --- converts the contents of -array- into an ascii character string which c --- is stored in character*2 array -compac-. compac(1)...compac(7) contain c --- the base value, i.e., the minimum value encountered in -array-. c --- compac(8)...compac(14) contain a scale factor by which the individual c --- 6-bit integers encoded as ascii character pairs in compac(8),... c --- compac(length) must be multiplied before the base value is added c --- during an unpakking operation. base value and scale factor are encoded c --- in e14.7 format. c c --- the printable ascii characters used to encode the integers include c --- the numbers 0...9, upper- and lower-case letters a...z, a...z, plus c --- two additional characters '.' and '/' (total of 64). c c --- a packing operation fills (ii*jj+14) array elements in -compac- which c --- must be dimensioned accordingly in the calling program. the total c --- number of occupied array elements is returned in -length-. in calls to c --- unpack, -length- is treated as input variable. c real array(idim,1) character*2 char,compac(1),comp2(14) character*14 comp14(2) equivalence (comp2,comp14) data nbits/12/ base=1.e22 do 1 i=1,ii do 1 j=1,jj 1 base=amin1(base,array(i,j)) scal=0. do 2 i=1,ii do 2 j=1,jj 2 scal=amax1(scal,array(i,j)-base) scal=scal/float(2**nbits-1) i1=0 i2=0 length=14 do 3 i=1,ii do 3 j=1,jj if (scal.eq.0.) go to 7 numb=(array(i,j)-base)/scal+.5 i1=numb/64 i2=numb-64*i1 c c --- map 6-bit numbers onto character set consisting of numbers c --- 0...9, letters a...z, a...z, and the two characters '.' and '/'. c --- (if mapping into the character range 32...95 -- which includes the c --- characters !"#$%&'()*+,-./:;<=>?@[\]^_ -- is deemed safe, delete c --- the next 6 lines.) c if (i1.gt.37) i1=i1+6 c if (i1.gt.11) i1=i1+7 c i1=i1+14 c if (i2.gt.37) i2=i2+6 c if (i2.gt.11) i2=i2+7 c i2=i2+14 c 7 length=length+1 compac(length)(1:1)=char(i1+32) compac(length)(2:2)=char(i2+32) 100 format (a2) 3 continue write (comp14(1),101) base write (comp14(2),101) scal 101 format (1pe14.7) do 8 l=1,14 8 compac(l)=comp2(l) c return c c entry unpakk(array,idim,ii,jj,compac,length) c do 9 l=1,14 9 comp2(l)=compac(l) read (comp14(1),101) base read (comp14(2),101) scal lngth=14 do 4 i=1,ii do 4 j=1,jj lngth=lngth+1 i1=ichar(compac(lngth)(1:1)) i2=ichar(compac(lngth)(2:2)) c c --- 6-bit numbers are mapped onto character set consisting of numbers c --- 0...9, letters a...z, a...z, and the two characters '.' and '/'. c --- (if mapped into character range 32...95, delete next 6 lines) c if (i1.gt.96) i1=i1-6 c if (i1.gt.64) i1=i1-7 c i1=i1-14 c if (i2.gt.96) i2=i2-6 c if (i2.gt.64) i2=i2-7 c i2=i2-14 4 array(i,j)=scal*float(64*(i1-32)+(i2-32))+base if (lngth.ne.length) stop 'unpack' return end