* PACKAGE GTCNVT !" ベクトル, 等値線図(速度, 温度場) *" gamiras model リスタートファイル出力表示専用 *" 95/05/31 (takepiro) for dcl-5.0 ****************************************************************** PROGRAM GTCNVT * #ifdef SYS_IBMS INCLUDE (GTSINC) INCLUDE (GZSIZE) #else #include "gtsinc.F" #include "gzsize.F" #endif COMMON /GMWORK/ MWORK REAL MWORK ( IJKDIM ) * REAL GDU( IJKDIM ) REAL GDV( IJKDIM ) REAL GDW( IJKDIM ) REAL GDT( IJKDIM ) REAL GDTOR( IJKDIM ) REAL GDPOR( IJKDIM ) * CHARACTER HHEADU( NDC )*(NCC) CHARACTER HHEADV( NDC )*(NCC) CHARACTER HHEADW( NDC )*(NCC) CHARACTER HHEADT( NDC )*(NCC) CHARACTER HHEDTR( NDC )*(NCC) CHARACTER HHEDPR( NDC )*(NCC) * INTEGER NTMX PARAMETER ( NTMX=20 ) DATA IFILE / 50 / CHARACTER HFILE( 1 ) *(NFILN) DATA HFILE / '$GTTMPDIR/gtool.out' / * REAL XMIN, XMAX, YMIN, YMAX !" 描画位置 DATA XMIN, XMAX / 0.2, 0.8 / DATA YMIN, YMAX / 0.10, 0.55 / * *" [オプション] * INTEGER PRJ !" 投影法 DATA PRJ / 0 / REAL POSI(2), ROTA , MAG !" 投影中心経度緯度,回転,拡大率 DATA POSI, ROTA, MAG/ 180.,0., 0., 1./ INTEGER X(2), Y(2), Z(2) !" 表示するベクトル場の座標(1) DATA X, Y, Z / 6*-1 / !" 表示する速度温度場の座標(2) REAL CONT ( 4 ) DATA CONT / 4 * -999. / INTEGER CCYCLE DATA CCYCLE / 5 / INTEGER CIDX ( 2 ) DATA CIDX / 1, 3 / INTEGER INTV ( 2 ) !" 矢印プロット間隔 DATA INTV / 2*1 / REAL FACT !" ベクトルのスケーリングファクター DATA FACT / 1.0 / LOGICAL EQRAT !" X, Y 方向スケーリングを同じにする DATA EQRAT / .TRUE. / LOGICAL LUNIT !" ユニットベクトルを描くか DATA LUNIT / .TRUE. / INTEGER IARLEN !" ベクトル投影モード DATA IARLEN / 3 / INTEGER ICENT !" ベクトル投影中心 DATA ICENT / -1 / INTEGER MAP , MAPIDX DATA MAP , MAPIDX / 0, 1 / INTEGER WSN DATA WSN / 0 / LOGICAL MONO, PRINT DATA MONO, PRINT / 2*.FALSE. / CHARACTER PS *(NFILN) DATA PS / '$GTTMPDIR/sgks.ps' / INTEGER LAY DATA LAY / 1 / INTEGER STR, END, STEP DATA STR, END, STEP / 1, 999999, 1 / REAL RANGE ( 4 ) DATA RANGE / 4*-999. / INTEGER IDX DATA IDX / 1 / LOGICAL EXCH DATA EXCH /.FALSE./ CHARACTER ITEM *(NCC) CHARACTER UNIT *(NCC) CHARACTER TITLE *(NCC*2) CHARACTER DSET *(NCC) CHARACTER EDIT *(NCC) CHARACTER ETTL *(NCC) DATA ITEM, UNIT, TITLE, DSET, EDIT, ETTL /6*' '/ LOGICAL GRESET DATA GRESET / .FALSE. / LOGICAL HELP DATA HELP / .FALSE. / * NAMELIST /OPTION/ PRJ, POSI, ROTA, MAG, & X, Y, Z, & INTV, FACT, LUNIT, EQRAT, IARLEN, ICENT, & MAP, MAPIDX, LAY, WSN, MONO, PRINT, PS, & RANGE, STR, END, STEP, EXCH, & ITEM, UNIT, TITLE, DSET, EDIT, ETTL, GRESET, & HELP, HFILE * *" < 1. コマンドライン解析 > * CALL OPTARG ( 91, 'OPTION', 'HFILE', NOPT, NFILE ) READ (91,OPTION,IOSTAT=IOS) CLOSE(91) IF ( IOS.NE.0 .OR. HELP ) THEN WRITE(6,OPTION) STOP ENDIF * CALL GTOPEN CALL GTSIZE ( HHEADU, IJKDIM ) CALL GTSIZE ( HHEADV, IJKDIM ) CALL GTSIZE ( HHEADW, IJKDIM ) CALL GTSIZE ( HHEADT, IJKDIM ) CALL GTSIZE ( HHEDTR, IJKDIM ) CALL GTSIZE ( HHEDPR, IJKDIM ) * CALL GMSIZE ( IJKDIM ) * IF ( WSN .LE. 0 ) THEN IF ( PRINT ) THEN WSN = 2 IF ( PS .NE. ' ' ) THEN CALL GUNENV( PS, '.', .FALSE. ) CALL SWCSET( 'PSFILE', PS ) IP=LENC(PS) WRITE (6,*) 'ps='//PS(1:IP) ENDIF ELSE WSN = 1 ENDIF ENDIF * *" 描画位置設定 * CALL GGOPEN ( WSN ) * CALL GGPSET( 'MAPPRJ', PRJ ) !" 投影法 CALL GGPSET( 'MAPLAT', POSI(1) ) !" 投影中心緯度 CALL GGPSET( 'MAPLON', POSI(2) ) !" 投影中心経度 CALL GGPSET( 'MAPROT', ROTA ) !" 投影回転 CALL GGPSET( 'MAPFAC', MAG ) !" 投影拡大率 * CALL GGMSET( 'IARLEN', IARLEN ) !" ベクトル表示モード CALL GGMSET( 'ICENT' , ICENT ) !" ベクトル表示位置 * CALL GGPSET ( 'VXINT', INTV(1) ) !" ベクトル表示間隔 CALL GGPSET ( 'VYINT', INTV(2) ) !" ベクトル表示間隔 CALL GGPSET ( 'VECFCT', FACT ) !" ベクトル表示拡大率 CALL GGPSET ( 'LEQRAT', EQRAT ) CALL GGPSET ( 'LUNIT', LUNIT ) !" 単位ベクトル表示スイッチ CALL SGSLAI ( IDX ) * CALL GGPSET( 'VXMIN' , XMIN ) CALL GGPSET( 'VXMAX' , XMAX ) CALL GGPSET( 'VYMIN' , YMIN ) CALL GGPSET( 'VYMAX' , YMAX ) * CALL GGPSET( 'TXSLOC', TXLOC ) CALL GGPSET( 'TYSLOC', TYLOC ) CALL GGPSET( 'TXSWDH', TXWDH ) CALL GGPSET( 'TYSWDH', TYWDH ) * CALL GFROPN ( IFILE, HFILE ) * IF ( X(1).LT.0 .AND. Y(1).LT.0 .AND. Z(1).LT.0 ) Z(1) = 0 IF ( X(1).GE.0 .AND. X(2).LT.0 ) X(2) = X(1) IF ( Y(1).GE.0 .AND. Y(2).LT.0 ) Y(2) = Y(1) IF ( Z(1).GE.0 .AND. Z(2).LT.0 ) Z(2) = Z(1) IF ( STEP .LE. 1 ) STEP = 1 * *" << 2. データ読み込み >> * II = 0 1100 CONTINUE * CALL GFBRED O ( HHEADU , GDU, IEODU , I IFILE , 1 ) CALL GFBRED O ( HHEADV, GDV, IEODV , I IFILE , 1 ) CALL GFBRED O ( HHEADW, GDW, IEODW , I IFILE , 1 ) CALL GFBRED O ( HHEADT, GDT, IEODT , I IFILE , 1 ) CALL GFBRED O ( HHEDTR, GDTOR, IEODTR , I IFILE , 1 ) CALL GFBRED O ( HHEDPR, GDPOR, IEODPR , I IFILE , 1 ) * IF ( MAX(IEODU,IEODV,IEODW,IEODT,IEODTR,IEODPR) .EQ. 0 ) THEN * II = II + 1 IF ( ( II.GE.STR ).AND.( II.LE.END ).AND. & ( MOD( II-STR,STEP ).EQ.0 ) ) THEN * *" << 3. データ加工 >> * *" < 3.1 格子点選択, 平均操作 > * IF ( X(1) .EQ. 0 ) THEN CALL GMXAVG I ( HHEADV, GDV, I 'XM' , 'zonal mean' ) CALL GMXAVG I ( HHEADW, GDW, I 'XM' , 'zonal mean' ) ENDIF IF ( X(2) .EQ. 0 ) THEN CALL GMXAVG I ( HHEADU, GDU, I 'XM' , 'zonal mean' ) CALL GMXAVG I ( HHEADT, GDT, I 'XM' , 'zonal mean' ) ENDIF IF ( X(1) .GT. 0 ) THEN CALL GMXSEL I ( HHEADV, GDV, X(1) , I ' ' , ' ' ) CALL GMXSEL I ( HHEADW, GDW, X(1) , I ' ' , ' ' ) ENDIF IF ( X(2) .GT. 0 ) THEN CALL GMXSEL I ( HHEADU, GDU, X(2) , I ' ' , ' ' ) CALL GMXSEL I ( HHEADT, GDT, X(2) , I ' ' , ' ' ) ENDIF * IF ( Y(1) .EQ. 0 ) THEN CALL GMYAVG I ( HHEADU, GDU, I 'YM' , 'merid mean' ) CALL GMYAVG I ( HHEADW, GDW, I 'YM' , 'merid mean' ) ENDIF IF ( Y(2) .EQ. 0 ) THEN CALL GMYAVG I ( HHEADV, GDV, I 'YM' , 'merid mean' ) CALL GMYAVG I ( HHEADT, GDT, I 'YM' , 'merid mean' ) ENDIF IF ( Y(1) .GT. 0 ) THEN CALL GMYSEL I ( HHEADU, GDU, Y(1) , I ' ' , ' ' ) CALL GMYSEL I ( HHEADW, GDW, Y(1) , I ' ' , ' ' ) ENDIF IF ( Y(2) .GT. 0 ) THEN CALL GMYSEL I ( HHEADV, GDV, Y(2) , I ' ' , ' ' ) CALL GMYSEL I ( HHEADT, GDT, Y(2) , I ' ' , ' ' ) ENDIF IF ( Z(1) .EQ. 0 ) THEN CALL GMZAVG I ( HHEADU, GDU, I 'ZM' , 'vert mean' ) CALL GMZAVG I ( HHEADV, GDV, I 'ZM' , 'vert mean' ) ENDIF IF ( Z(2) .EQ. 0 ) THEN CALL GMZAVG I ( HHEADW, GDW, I 'ZM' , 'vert mean' ) CALL GMZAVG I ( HHEADT, GDT, I 'ZM' , 'vert mean' ) ENDIF IF ( Z(1) .GT. 0 ) THEN CALL GMZSEL I ( HHEADU, GDU, Z(1) , I ' ' , ' ' ) CALL GMZSEL I ( HHEADV, GDV, Z(1) , I ' ' , ' ' ) ENDIF IF ( Z(2) .GT. 0 ) THEN CALL GMZSEL I ( HHEADW, GDW, Z(2) , I ' ' , ' ' ) CALL GMZSEL I ( HHEADT, GDT, Z(2) , I ' ' , ' ' ) ENDIF * CALL GMXCYC I ( HHEADU, GDU ) CALL GMXCYC I ( HHEADV, GDV ) CALL GMXCYC I ( HHEADW, GDW ) CALL GMXCYC I ( HHEADT, GDT ) * IF ( EXCH ) THEN CALL GMEYXZ I ( HHEADU, GDU, I ' ' , ' ' ) CALL GMEYXZ I ( HHEADV, GDV, I ' ' , ' ' ) CALL GMEYXZ I ( HHEADW, GDW, I ' ' , ' ' ) CALL GMEYXZ I ( HHEADT, GDT, I ' ' , ' ' ) ENDIF * *" < 3.2 表示量タイトル, 単位設定 > * IF ( ITEM .NE. ' ' ) THEN CALL GHCSET( HHEADU, 'ITEM', ITEM ) CALL GHCSET( HHEADV, 'ITEM', ITEM ) CALL GHCSET( HHEADW, 'ITEM', ITEM ) CALL GHCSET( HHEADT, 'ITEM', ITEM ) ENDIF * IF ( UNIT .NE. ' ' ) THEN CALL GHCSET( HHEADU, 'UNIT', UNIT ) CALL GHCSET( HHEADV, 'UNIT', UNIT ) CALL GHCSET( HHEADW, 'UNIT', UNIT ) CALL GHCSET( HHEADT, 'UNIT', UNIT ) ENDIF * IF ( TITLE .NE. ' ' ) THEN CALL GHCSTS( HHEADU, 'TITL', TITLE ) CALL GHCSTS( HHEADV, 'TITL', TITLE ) CALL GHCSTS( HHEADW, 'TITL', TITLE ) CALL GHCSTS( HHEADT, 'TITL', TITLE ) ENDIF * IF ( DSET .NE. ' ' ) THEN CALL GHCSET( HHEADU, 'DSET', DSET ) CALL GHCSET( HHEADV, 'DSET', DSET ) CALL GHCSET( HHEADW, 'DSET', DSET ) CALL GHCSET( HHEADT, 'DSET', DSET ) ENDIF * IF ( GRESET ) THEN CALL GHRSGP( HHEADV ) CALL GHRSGP( HHEADV ) ENDIF * *" < 3.3 コンター間隔 > * IF ( CONT(1) .GT. 0. ) THEN IF( X(1) .GE. 0.0 )THEN CALL GHPSET( HHEADU, 'DIVS', CONT(1) ) ELSE IF( Y(1) .GE. 0.0 )THEN CALL GHPSET( HHEADV, 'DIVS', CONT(1) ) ELSE IF( Z(1) .GE. 0.0 )THEN CALL GHPSET( HHEADW, 'DIVS', CONT(1) ) ENDIF ENDIF IF ( CONT(2) .GT. 0. ) THEN IF( X(1) .GE. 0.0 )THEN CALL GHPSET( HHEADU, 'DIVL', CONT(2) ) ELSE IF( Y(1) .GE. 0.0 )THEN CALL GHPSET( HHEADV, 'DIVL', CONT(2) ) ELSE IF( Z(1) .GE. 0.0 )THEN CALL GHPSET( HHEADW, 'DIVL', CONT(2) ) ENDIF ENDIF IF ( CONT(3) .GT. 0. ) THEN CALL GHPSET( HHEADT, 'DIVS', CONT(3) ) ENDIF IF ( CONT(4) .GT. 0. ) THEN CALL GHPSET( HHEADT, 'DIVL', CONT(4) ) ENDIF * *" < 3.4 表示範囲 > * IF ( RANGE(1) .NE. -999. ) THEN CALL GHPSET( HHEADU, 'DMIN', 0. ) CALL GHPSET( HHEADU, 'DMAX', RANGE(1) ) ENDIF IF ( RANGE(2) .NE. -999. ) THEN CALL GHPSET( HHEADV, 'DMIN', 0. ) CALL GHPSET( HHEADV, 'DMAX', RANGE(2) ) ENDIF IF ( RANGE(3) .NE. -999. ) THEN CALL GHPSET( HHEADW, 'DMIN', 0. ) CALL GHPSET( HHEADW, 'DMAX', RANGE(3) ) ENDIF IF ( RANGE(4) .NE. -999. ) THEN CALL GHPSET( HHEADT, 'DMIN', 0. ) CALL GHPSET( HHEADT, 'DMAX', RANGE(4) ) ENDIF * *" << 4. 軸の設定 >> * CALL UZINIT CALL UDPSET ( 'LABEL', CLABEL ) CALL UDPSET ( 'INDXMJ', CIDX(2) ) CALL UDPSET ( 'INDXMN', CIDX(1) ) * IF ( X(1). GE. 0 ) THEN !" 子午面表示 CALL GGLAY ( LAY, HHEADU ) CALL GGAXES ( HHEADU ) CALL GGCNVT I ( HHEADW , GDW , I HHEADV , GDV , I HHEADU , GDU ) * CALL GGLAY ( LAY, HHEADT ) CALL GGAXES ( HHEADT ) CALL GGCNVT I ( HHEADW , GDW , I HHEADV , GDV , I HHEADU , GDT ) ELSE IF ( Y(1). GE. 0 ) THEN !" CALL GGLAY ( LAY, HHEADV ) CALL GGAXES ( HHEADV ) CALL GGCNVT I ( HHEADW , GDW , I HHEADU , GDU , I HHEADV , GDV ) * CALL GGLAY ( LAY, HHEADT ) CALL GGAXES ( HHEADT ) CALL GGCNVT I ( HHEADW , GDW , I HHEADU , GDU , I HHEADU , GDT ) ELSE IF ( Z(1). GE. 0 ) THEN !" 地図投影 CALL GGLAY ( LAY, HHEADW ) CALL GGAXES ( HHEADW ) CALL GGCNVT I ( HHEADU , GDU , I HHEADV , GDV , I HHEADW , GDW ) * CALL GGLAY ( LAY, HHEADT ) CALL GGAXES ( HHEADT ) CALL GGCNVT I ( HHEADU , GDU , I HHEADV , GDV , I HHEADU , GDT ) ENDIF * ENDIF IF ( II .LT. END ) GOTO 1100 ENDIF * CALL GFCLSE ( IFILE ) * CALL GGCLSE * STOP END ********************************************************************** SUBROUTINE GGLAY I ( LAY, HHEAD ) * #ifdef SYS_IBMS INCLUDE (GTSINC) INCLUDE (GZSIZE) #else #include "gtsinc.F" #include "gzsize.F" #endif * CHARACTER HHEAD( NDC )*(NCC) INTEGER LAY * IF ( LAY .EQ. 2 ) THEN CALL GGLAY2 ( HHEAD ) ELSE IF ( LAY .EQ. 3 ) THEN CALL GGLAY3 ( HHEAD ) ELSE CALL GGLAY1 ( HHEAD ) ENDIF RETURN END ********************************************************************** SUBROUTINE GGCNVT I ( HHEADU , GVECTU , I HHEADV , GVECTV , I HHEAD , GDATA ) * #ifdef SYS_IBMS INCLUDE (GTSINC) INCLUDE (GZSIZE) #else #include "gtsinc.F" #include "gzsize.F" #endif * REAL GVECTU( IJKDIM ) REAL GVECTV( IJKDIM ) REAL GDATA ( IJKDIM ) * CHARACTER HHEADU( NDC )*(NCC) CHARACTER HHEADV( NDC )*(NCC) CHARACTER HHEAD ( NDC )*(NCC) * CALL GGMVCT I ( HHEADU, GVECTU, I HHEADU, GVECTV ) * CALL SGLSET('LCLIP',.TRUE.) CALL GGCNTR ( HHEAD , GDATA ) CALL SGLSET('LCLIP',.FALSE.) * RETURN END