program gt3conv use gtool, only: string, gtargcount, gtargget, abortprogram use gtool_history, only: gt_history_axis, HistoryCreate, & & historyClose, gt_history_varinfo, HistoryAddVariable, & & historyPut, HistorySetTime, HistoryAddAttr use dc_trace, only: setdebug use gt3map implicit none integer:: i, iostat, ndims character(len = string):: arg, input character(len = string):: output = "" type(gt3_map):: map type(gt_history_axis), allocatable:: axis(:) type(gt_history_varinfo):: varinfo integer:: verbose = 2 logical:: explicit_valid_range = .false. continue ! 引数の読み込み(最後の引数がファイル名) do, i = 1, GtArgCount() call GtArgGet(i, arg) if (arg == '-debug') then call setdebug else if (arg(1:2) == '-h') then goto 900 else if (arg(1:2) == '-q') then verbose = verbose - 1 else if (arg(1:2) == '-v') then verbose = verbose + 1 else if (arg(1:6) == '-valid') then explicit_valid_range = .true. else if (arg(1:4) == 'out=') then output = arg else input = arg endif enddo if (output == "") output = OutputFilename(input, ".nc") if (verbose > 0) then write(*, fmt='(A)') & & "gt3conv: from " // trim(input) // " to " // trim(output) endif call open(map, input, iostat) if (iostat /= 0) goto 900 allocate(axis(map%n_axes)) call get_axis(map, axis) call HistoryCreate(trim(output), trim(map%title), & & trim(map%source), trim(map%institution), & & axis, origin=0.0, interval=0.0) ! データ変数の作成 do, i = 1, map%n_vars call get_variable(map, "VAR", i, varinfo) call HistoryAddVariable(varinfo) call make_attr(map, "VAR", i) enddo ! 大域属性は 1 つ変数を作った後で (gtool_history のバグ) call HistoryAddAttr("", "history", trim(map%history)) ! 軸重み変数の作成 do, i = 1, map%n_axes - 1 call make_attr(map, "AXI", i) call get_variable(map, "WGT", i, varinfo) if (varinfo%name == '') cycle call HistoryAddVariable(varinfo) call make_attr(map, "WGT", i) enddo ! 軸変数の値を作成 do, i = 1, map%n_axes - 1 call HistoryPut(map%axistab(i)%name, map%axistab(i)%value) if (.not. associated(map%axistab(i)%name_w)) cycle call HistoryPut(map%axistab(i)%name_w, map%axistab(i)%value_w) enddo ! 時間軸をいったん全部書き込み do, i = 1, map%n_times call HistoryPut(map%axistab(map%n_axes)%name, map%timetab(i)%time) enddo ! データ変数の中身を読み書き call history_copy(map) call HistoryClose() call close(map, iostat) if (iostat /= 0) goto 900 stop 900 continue print *, "error ", iostat print *, "usage: gt3conv [-debug] [out=output] input" call abortprogram("") contains subroutine make_attr(map, class, order) use gt3read, only: gt3_header implicit none type(gt3_map), intent(in):: map character(len = *):: class integer, intent(in):: order type(gt3_header):: header character(len = token):: varname character(len = string):: comment integer:: i continue call getHeader(map, class, order, header, varname) if (class == 'AXI') then ! 軸重み if (associated(map%axistab(order)%name_w)) then call HistoryAddAttr(varname, "gt_calc_weight", & & trim(map%axistab(order)%name_w)) endif if (header%dataset(1:1) == 'C') then if (size(map%axistab(order)%value) > header%record_size / 2) then call HistoryAddAttr(varname, "topology", & & "circular") endif call HistoryAddAttr(varname, "modulo", map%axistab(order)%range) endif endif ! 何に使うのだろう... もうちょっと考えたほうがよい call HistoryAddAttr(varname, & & "gt_user_gtool3_tdur", header%time_duration) ! 欠損値 call HistoryAddAttr(varname, "missing_value", & & header%missing_value) call HistoryAddAttr(varname, "_FillValue", & & header%missing_value) ! とてもお勧めできるとは思えない if (explicit_valid_range) then if (header%missing_value > 0) then call HistoryAddAttr(varname, "valid_max", & & header%missing_value * (1.0 - epsilon(1.0))) else call HistoryAddAttr(varname, "valid_min", & & header%missing_value * (1.0 - epsilon(1.0))) endif endif ! 描画範囲 if (header%range_min /= header%range_max) then call HistoryAddAttr(varname, & & "gt_graph_range", (/header%range_min, header%range_max/)) endif ! コンター間隔関係設定 if (header%div_small /= 0.0) then call HistoryAddAttr(varname, & & "gt_graph_smalltick_interval", header%div_small) call HistoryAddAttr(varname, & & "gt_graph_contours_interval", header%div_small) endif if (header%div_large /= 0.0) then call HistoryAddAttr(varname, & & "gt_graph_tick_interval", header%div_large) call HistoryAddAttr(varname, & & "gt_graph_contours_thick_interval", header%div_large) endif ! 軸投影関係設定 if (abs(header%scaling) == 2) then call HistoryAddAttr(varname, "gt_graph_logscale", "yes") endif if (header%scaling > 0) then call HistoryAddAttr(varname, "positive", "up") else call HistoryAddAttr(varname, "positive", "down") endif ! 予約欄 if (header%option(1) /= "") then call HistoryAddAttr(varname, "gt_user_gtool3_optn1", & & trim(header%option(1))) endif if (header%option(2) /= "") then call HistoryAddAttr(varname, "gt_user_gtool3_optn2", & & trim(header%option(2))) endif if (header%option(3) /= "") then call HistoryAddAttr(varname, "gt_user_gtool3_optn3", & & trim(header%option(3))) endif ! コメント欄 comment = "" do, i = 1, 12 comment = trim(comment) // " " // trim(header%memo(i)) enddo if (comment /= "") then call HistoryAddAttr(varname, "comment", trim(comment)) endif end subroutine subroutine history_copy(map) use gt3read, only: gt3_header, getunit implicit none type(gt3_map):: map type(gt3_header):: header real, pointer:: buffer(:, :, :) integer:: iostat, irec type(unitlist_t), pointer:: ulist continue irec = 0 ulist => map%unit%prev do irec = irec + 1 call GetUnit(map%file, header, buffer, iostat) if (iostat /= 0) return ! 格子不整合で invalid になる場合除去 ulist => ulist%next if (.not. ulist%valid) cycle ! いざ書き出し call HistorySetTime(real(header%time)) call HistoryPut(varname_3to4(map, header%item), buffer) if (verbose > 1) then write(*, fmt='(A,I6,"/",I6)') & achar(27) // '[A', irec, map%n_units endif enddo end subroutine function OutputFilename(src, suffix) result(result) character(len = string):: result character(len = *), intent(in):: src, suffix character(len = *), parameter:: pathdelim = ':/' // achar(92) character(len = *), parameter:: ANS = "ABCDEFGHIJKLMNOPQRSTUVW& &XYZabcdefghijklmnopqrstuvwxyz0123456789_ " integer:: basename, period, i continue ! ディレクトリ成分らしきものは除去 basename = scan(src, pathdelim, back=.true.) if (basename > 0) then result = src(basename + 1: ) else result = src endif ! 最後の '.' 以降を除去 period = index(result, '.', back=.true.) if (period /= 0) result(period: ) = "" ! 変な文字を下線に置換 do i = verify(result, ANS) if (i == 0) exit result(i:i) = '_' enddo ! 拡張子を強要 result = trim(result) // suffix end function end program