* PACKAGE ACRSET !" 座標設定 * *" [HIS] 95/08/18 (takepiro) *" 96/03/12 (takepiro) 自動倍精度対応 *********************************************************************** SUBROUTINE ACRSET !" 座標設定 * * [PARAM] #include "zcdim.F" !" 格子点数, 波数 #include "zhdim.F" !" 文字列文字数 * * [OUTPUT] REAL DX !" X 軸上の格子点間隔 REAL DZ !" Z 軸上の格子点間隔 CHARACTER HCORX*(NCC) !" X 座標軸名 CHARACTER HCORZ*(NCC) !" Z 座標軸名 * * [INTERNAL WORK] INTEGER IFPAR , JFPAR !" NAMELIST 装置番号 LOGICAL OFIRST * REAL XLEN !" 水平方向の領域の大きさ REAL ZLEN !" 鉛直方向の領域の大きさ CHARACTER HCORX0*(NCC) !" 座標軸接頭子(X) CHARACTER HCORZ0*(NCC) !" 座標軸接頭子(Z) * * [NAMELIST] REAL XLNGTH !" 水平方向(X)の領域の大きさ REAL ZLNGTH !" 鉛直方向(Z)の領域の大きさ * * [NAMELIST DEFAULT] NAMELIST /NMCORD/ XLNGTH , ZLNGTH DATA XLNGTH, ZLNGTH / 8.0, 1.0 / * DATA HCORX0, HCORZ0 / 'GX', 'GZ' / DATA OFIRST /.TRUE./ * SAVE XLEN , ZLEN , HCORX0 , HCORZ0, OFIRST * *" < 1. NAMELIST 読み込み > * IF ( OFIRST ) THEN CALL REWNML ( IFPAR , JFPAR ) READ ( IFPAR, NMCORD , END=1190 ) 1190 WRITE ( JFPAR, NMCORD ) * XLEN = XLNGTH ZLEN = ZLNGTH ENDIF * RETURN * ------------------------------ ENTRY ACRGET !" 座標値 O ( DX , DZ ) * DX = XLEN / REAL(NX) DZ = ZLEN / REAL(NZ+1) * RETURN * ------------------------------ ENTRY ACNGET !" 座標軸名 O ( HCORX , HCORZ ) * CALL ACNSTZ O ( HCORX , I HCORX0 , NX , XLEN ) * CALL ACNSTZ O ( HCORZ , I HCORZ0 , NZ , ZLEN ) * RETURN END *********************************************************************** SUBROUTINE ACNSTZ !" 座標名設定(接頭子//格子点数//'-'//領域サイズ) O ( HCORN , I HCORX , NX , XLEN ) * * [PARAM] #include "zhdim.F" !" 文字列文字数 * * [OUTPUT] CHARACTER HCORN*(NCC) !" 座標軸名 * * [INPUT] CHARACTER HCORX*(NCC) !" 座標軸名(接頭子) INTEGER NX !" 格子点数(内部領域) REAL XLEN !" 領域の大きさ * * [INTERNAL WORK] INTEGER IAY, INUM, INXL * CHARACTER HNUM * (NCC) CHARACTER HXLEN * (NCC) * * [EXTERNAL FUNCTION] INTEGER LENC * *" < 1. 座標軸名接頭子 > * CALL CLADJ( HCORX ) IAY = LENC( HCORX ) * *" < 2. 格子点数 > * WRITE ( HNUM , '(I4)' ) NX CALL CLADJ ( HNUM ) INUM = LENC( HNUM ) * *" < 3. 領域の大きさ > * *" CALL GULCHR CALL ZULCHR !" 自動倍精度対応ルーチン I ( '(1P,E7.1)', XLEN , O HXLEN , INXL ) * HCORN = HCORX(1:IAY)//HNUM(1:INUM)//'-'//HXLEN(1:INXL) * RETURN END