PROGRAM kion100 * 1995-07-03, 1998-02-13, 2000-04-25 masuda/k. * Koosuiryoo no "data" no titen goto no kisetu henka no "graph" o * 1 gamen ni 100 (10 x 10) titen bun zutu kaku. IMPLICIT NONE INCLUDE 'datapath.fi' CHARACTER*50 fname INTEGER imon, kframe, n REAL rmonth(12) * REAL vxmin,vxmax,vymin,vymax REAL wtmin,wtmax,wmmin,wmmax REAL wttk0,wttki,wmtk0,wmtki REAL wtlb0,wtlbi,wmlb0,wmlbi REAL dvxbtk,dvybtk,dvxltk,dvyltk REAL chsizw INTEGER labit,labfrt,labim,labfrm INTEGER ltypew,lcolw * INTEGER iounit INTEGER iswitch, iseq, iyearb, iyeare, irtn REAL rlat, rlon, rheit REAL tmonv(12), tannv, tannv2 CHARACTER*25 hstat, hcntr INTEGER nxfrm, nyfrm, kxfrm, kyfrm * DATA iounit/ 12 / DATA wtmin/ -30.0/,wtmax/ 50.0/ DATA wmmin/ 0.2/,wmmax/ 12.8/ DATA wttk0/ -30.0 /,wttki/ 5.0/ DATA wmtk0/ 1.0 /,wmtki/ 1.0/ DATA wtlb0/ -20.0 /,wtlbi/ 20.0/ DATA wmlb0/ 1.0 /,wmlbi/ 1.0/ DATA dvxbtk/0.0025/,dvybtk/0.0025/,dvxltk/0.0020/,dvyltk/0.0020/ DATA chsizw/0.0020/ DATA labit/ 3 /,labfrt/ 0 / DATA labim/ 2 /,labfrm/ 0 / DATA ltypew/ 1 /,lcolw / 1 / DATA nxfrm/10/, nyfrm/10/ * BEGIN DO imon = 1, 12 rmonth(imon) = imon END DO * fname = dapath//'climate/rikanenp/kion' OPEN(unit=iounit, file=fname, & status='OLD',access='SEQUENTIAL',form='FORMATTED') READ(iounit, '(1X)') * * Sakuzu hazime CALL opngks * kframe = 0 9000 CONTINUE * * "data" o yomu * iswitch = 1 CALL readrika (iounit, iswitch, iseq, hstat, hcntr, & rlat, rlon, rheit, & tmonv, tannv, tannv2, iyearb, iyeare, irtn) IF (irtn .LT. 0) GO TO 9900 kframe = kframe+1 * * zu 1 (migi-sita). kion (tate) to tuki (yoko) * kyfrm = mod(kframe-1, nxfrm*nyfrm)/nxfrm + 1 kxfrm = mod ( mod(kframe-1, nxfrm*nyfrm),nxfrm) + 1 vxmin = (kxfrm-0.9) / real(nxfrm) vxmax = (kxfrm-0.1) / real(nxfrm) vymin = (nyfrm-kyfrm+0.1) / real(nyfrm) vymax = (nyfrm-kyfrm+0.9) / real(nyfrm) CALL GSWN (1, wmmin, wmmax, wtmin, wtmax ) CALL GSVP (1, vxmin, vxmax, vymin, vymax ) * CALL GSLN (ltypew) CALL GSPLCI(lcolw) CALL GSTXCI(lcolw) CALL waku2 (wmmin, wmmax, wtmin, wtmax, & wmtk0, wmtki, wttk0, wttki, & dvxbtk,dvybtk,dvxltk,dvyltk, & wmlb0, wmlbi, wtlb0, wtlbi, chsizw, & labim, labfrm,labit, labfrt) * IF (irtn .EQ. 0) THEN CALL GSELNT(1) n = 12 CALL GSLN ( 1 ) CALL GSPLCI( 3 ) CALL GPL (n, rmonth, tmonv) * CALL GSMK ( 2 ) CALL GSMKSC( 0.5 ) CALL GSPMCI( 5 ) CALL GPM (n, rmonth, tmonv) ELSE CALL GSELNT(0) CALL GSTXCI(2) CALL GSTXAL(2,3) CALL GSCHH (0.005) CALL GSCHUP( 0.0, 1.0) CALL GTX( 0.5*(vxmin+vxmax), 0.5*(vymin+vymax), & '"data" ga nai.') END IF * CALL GSELNT(1) CALL GSLN ( 2 ) CALL GSPLCI( 2 ) CALL senbun( wmmin, 0.0, wmmax, 0.0 ) CALL GSLN ( 1 ) * * daimei (timei) * CALL GSELNT(0) CALL GSTXCI(1) CALL GSTXAL(1,2) CALL GSCHH (0.005) CALL GTX (vxmin, vymax, hstat( 1:16) ) * IF ( kxfrm .EQ. nxfrm .AND. kyfrm .EQ. nyfrm) THEN CALL frame END IF GO TO 9000 9900 CONTINUE CLOSE(unit=iounit) * owari CALL frame CALL clsgks END INCLUDE 'waku2.f' INCLUDE 'wc2ndc.f' INCLUDE 'senbun.f' INCLUDE 'readrika.f'