c c this program reads the data file hov.dat produced by hovmol.f c and plots a hovmoller diagram c parameter (nx = 257, lev = 33) real sum(nx,lev), data(nx,lev),tmp(nx,lev),scale real lon1, lon2, alon1, alon2 integer smooth_flag common /prog/ lon1,lon2,alon1,alon2 lon1 = -2500. lon2 = 2500. write(*,*) 'Enter longitude bounds: ex -40,40' read (*,*) alon1, alon2 write(*,*) 'Enter cmin, cmax, cint' read(*,*) cmin, cmax, cint read(*,*) smooth_flag write(*,*) cmin, cmax, cint amin = 999999.0 amax =-999999.0 c------------------------reading part BEGIN c----input file do im = 1,5 if(im.eq.1) open (unit=50, file='fort.16', + form='formatted', status='old') if(im.eq.2) open (unit=50, file='fort.19', + form='formatted', status='old') if(im.eq.3) open (unit=50, file='fort.20', + form='formatted', status='old') if(im.eq.4) open (unit=50, file='fort.15', + form='formatted', status='old') if(im.eq.5) open (unit=50, file='fort.18', + form='formatted', status='old') if(im.eq.1) scale = 1.e6 if(im.eq.2) scale = 1.e2 if(im.eq.3) scale = 1.e4 if(im.eq.4) scale = 1. if(im.eq.5) scale = 1. do j = 1,33 do i=1,nx read(50,*) sum(i,j) data(i,j)= sum(i,j)*scale if(data(i,j).gt.amax) amax = data(i,j) if(data(i,j).lt.amin) amin = data(i,j) enddo enddo close (50) write(*,*) 'Min = ', amin write(*,*) 'Max =' , amax c------------------------ call opngks cc if(smooth_flag.eq.1) call smoother(data) if(im.eq.2.or.im.eq.3) cint = 0.2 if(im.eq.4) cmin = -10. if(im.eq.4) cmax = 10. if(im.eq.4) cint = 1. if(im.eq.5) cmin = 0. if(im.eq.5) cmax = 30. if(im.eq.5) cint = 2. call hovmoller(data,nx,lev,cmin,cmax,cint) if (im.eq.1) CALL PLCHHQ(.5,.95,'PV (scale=1e6) ',.012,0.,0.) if (im.eq.2) CALL PLCHHQ(.5,.95,'Omega(scale=1e2) ',.012,0.,0.) if (im.eq.3) CALL PLCHHQ(.5,.95,'Relative vorticity (scale=1e4) ',.012,0.,0.) if (im.eq.4) CALL PLCHHQ(.5,.95,'Vg ',.012,0.,0.) if (im.eq.5) CALL PLCHHQ(.5,.95,'Theta ',.012,0.,0.) call frame enddo call clsgks end c--------------------------------------------------------------------- c--------------------------------------------------------------------- c--------------------------------------------------------------------- subroutine hovmoller(data, ix, jy, cmin, cmax, cint) c--------------------------------------------------------------------- real data(ix,jy) real cmin, cmax, cint real lon1, lon2, alon1, alon2 C FOR THE COLORING ROUTINE DIMENSION RWRK(200000),IWRK(50000),IAMA(1000000) DIMENSION IASF(13),WRK(100000) DIMENSION XCRA(500000),YCRA(500000) DIMENSION IAIA(10),IGIA(10) DATA IASF / 13*1 / common /prog/ lon1,lon2,alon1,alon2 EXTERNAL COLRAM write(*,*) ix,jy c--- specify colors call gscr(1,0,1.,1.,1.) !background white call gscr(1,1,0.,0.,0.) !foreground black call gscr(1,20,1.,0.,0.) call gscr(1,30,0.,0.,1.) x1 = .1 x2 = .9 !was 0.9 y2 = .9 !was 0.75 y1 = .2 !was 0.25 xl = alon1 xr = alon2 yb = 0. ! 1000 float(jy) yt = 10000. ! 100 call set(x1,x2,y1,y2,xl,xr,yb,yt,0) ncont = int((cmax-cmin)/cint) + 1 call setcolors(ncont, cmin, cmax, cint) call cpseti('CLS',0) call cpseti('NCL',ncont) do i=1,ncont rlev = cmin + (i-1)*cint call cpseti('PAI', i) call cpsetr('CLV',rlev) call cpseti('CLU',3) !labels chg to 3 if(rlev.lt.0.) call cpseti('CLD',61166) !dashed for negative if(rlev.eq .0.) call cpseti('CLU',0) !do not plot 0 contour enddo CALL CPSETI('SET',0) CALL CPSETR('XC1',lon1) CALL CPSETR('XCM',lon2) CALL CPSETR('YC1',yb) !122 changed for 31 CALL CPSETR('YCN',yt) c CALL CPSETR ('T2D - TENSION ON THE 2D SPLINES',3.) call cprect(data,ix,ix,jy,rwrk,100000,iwrk,50000) CALL ARINAM (IAMA,1000000) !initialize the area CALL CPCLAM (data,RWRK,IWRK,IAMA) !to be colored C Color the map. CALL ARSCAM (IAMA,XCRA,YCRA,100000,IAIA,IGIA,10,COLRAM) call cpcldr(data,rwrk,iwrk) call labmod('(i5)','(I5)',5,5,10,10,0,0,0) cc call gridal(11,1,9,2,1,1,5,0.,990.) !6 for 5 cc call gridal(8,1,13,1,1,1,5,0.,990.) !6 for 5 call gridal(10,1,10,1,1,1,5,0.,990.) CALL SET(0.,1.,0.,1.,0.,1.,0.,1.,1) CALL PLCHHQ(x1-0.08,.5,'Height',.013,90.,0.) CALL PLCHHQ(0.5,y1-0.07,'horizontal',.013,0.,0.) c CALL PLCHHQ(0.8,y1-0.09,'shaded >=1m/s',.012,0.,0.) c CALL PLCHHQ(.5,.97,'880820 12Z',.015,0.,0.) c CALL PLCHHQ(.5,.92,'Vwnd (@10-12N, CINT=2m/s)',.012,0.,0.) c return end c--------------------------------------------------------------------- c--------------------------------------------------------------------- c --------------------------------------------------------------------- SUBROUTINE COLRAM (XCRA,YCRA,NCRA,IAIA,IGIA,NAIA) C Dimension XCRA(*),YCRA(*),IAIA(*),IGIA(*) C C The arrays XCRA and YCRA, for indices 1 to NCRA, contain the X and Y C coordinates of points defining a polygon. The area identifiers in C the array IAIA, each with an associated group identifier in the array C IGIA, tell us whether the polygon is to be color-filled or not. C C C Assume the polygon will be filled until we find otherwise. C IFLL=1 C C If any of the area identifiers is negative, don't fill the polygon. C DO 101 I=1,NAIA IF (IAIA(I).LT.0) IFLL=0 101 CONTINUE C C Otherwise, fill the polygon in the color implied by its area C identifier relative to edge group 3 (the contour-line group). C IF (IFLL.NE.0) THEN IFLL=0 DO 102 I=1,NAIA IF (IGIA(I).EQ.3) IFLL=IAIA(I) 102 CONTINUE IF (IFLL.GT.0.AND.IFLL.LT.50) THEN CALL GSFACI (IFLL+1) CALL GFA (NCRA-1,XCRA,YCRA) END IF END IF C C Done. C RETURN C END c --------------------------------------------------------------------- subroutine setcolors(ic , cmin, cmax, cint) call gscr(1,0,1.,1.,1.) !color # 0 = background call gscr(1,1,0.,0.,0.) ii = (cmax-cmin ) /cint + 2 !for anomaly 0-cmin; !zero plot not needed, chg 1 write (*,*) ii colr_min = .3 colr_max = .9 cdif = (colr_max - colr_min )/(ii-1) do i=2,ii acol = colr_min + (i-2)*cdif write(*,*) i,acol call gscr(1,i,acol,acol,acol) enddo c--reset first 4 colors to be white c if (im.eq.1.or.im.eq.5) then do i= 12,40 call gscr(1,i,1.,1.,1.) !color # 0 = background enddo c endif return end c-------------------------------