module fbindsubs implicit none interface SUBROUTINE gopen_gks (err_file) use fbindtypes CHARACTER(LEN=*), INTENT(IN) :: err_file ! error message file end subroutine !----------------------------------------------------------------------------- SUBROUTINE gclose_gks () use fbindtypes end subroutine !----------------------------------------------------------------------------- SUBROUTINE gsave_gsl (wsid, ent_names, ent_vals) use fbindtypes INTEGER, INTENT(IN) :: wsid TYPE(Ggsl_id), POINTER, DIMENSION (:) :: ent_names TYPE(Ggsl), POINTER, DIMENSION (:) :: ent_vals end subroutine !----------------------------------------------------------------------------- SUBROUTINE grestore_gsl (wsid, ent_vals) use fbindtypes INTEGER, INTENT(IN) :: wsid TYPE(Ggsl), POINTER, DIMENSION (:) :: ent_vals end subroutine !----------------------------------------------------------------------------- SUBROUTINE gescape (escape_id, in_data, out_data) use fbindtypes INTEGER, INTENT(IN) :: escape_id CHARACTER(LEN=*),INTENT(IN) :: in_data CHARACTER(LEN=*),INTENT(OUT) :: out_data end subroutine !----------------------------------------------------------------------------- SUBROUTINE gemergency_close_gks () use fbindtypes end subroutine !----------------------------------------------------------------------------- SUBROUTINE gerr_hand (err_num, fname, err_file) use fbindtypes INTEGER, INTENT(IN) :: err_num INTEGER, INTENT(IN) :: fname CHARACTER(LEN=*), INTENT(IN) :: err_file end subroutine !----------------------------------------------------------------------------- SUBROUTINE gerr_log (err_num, fname, err_file) use fbindtypes INTEGER, INTENT(IN) :: err_num INTEGER, INTENT(IN) :: fname CHARACTER(LEN=*), INTENT(IN) :: err_file end subroutine !----------------------------------------------------------------------------- SUBROUTINE groute (dir) use fbindtypes TYPE(Groute_dir_id), INTENT(IN) :: dir end subroutine !----------------------------------------------------------------------------- SUBROUTINE gopen_stencil ( stencil_name, inside_rule ) use fbindtypes INTEGER, INTENT(IN) :: stencil_name TYPE(Ginside_rule_id), INTENT(IN) :: inside_rule end subroutine !----------------------------------------------------------------------------- SUBROUTINE gclose_stencil () use fbindtypes end subroutine !----------------------------------------------------------------------------- SUBROUTINE grename_stencil ( old_stencil_name, new_stencil_name ) use fbindtypes INTEGER, INTENT(IN) :: old_stencil_name INTEGER, INTENT(IN) :: new_stencil_name end subroutine !----------------------------------------------------------------------------- SUBROUTINE gdel_stencil ( stencil_name ) use fbindtypes INTEGER, INTENT(IN) :: stencil_name end subroutine !----------------------------------------------------------------------------- SUBROUTINE gcreate_stencil_bndry ( stencil_name, inside_rule, bndry ) use fbindtypes INTEGER :: stencil_name TYPE(Ginside_rule_id) :: inside_rule TYPE(Gseq_bndry) :: bndry end subroutine !----------------------------------------------------------------------------- SUBROUTINE gcreate_stencil_conts (stencil_name, inside_rule, path ) use fbindtypes INTEGER, INTENT(IN) :: stencil_name TYPE(Ginside_rule_id), INTENT(IN) :: inside_rule TYPE(Gseq_path), INTENT(IN) :: path end subroutine !----------------------------------------------------------------------------- SUBROUTINE gget_stencil_attr (stencil_name, attr_name, error_ind, attr_val) use fbindtypes INTEGER, INTENT(IN) :: stencil_name TYPE(Gstencil_attr_name_id), INTENT(IN) :: attr_name INTEGER,INTENT(OUT) :: error_ind TYPE(Gstencil_attr_val),INTENT(OUT) :: attr_val end subroutine !----------------------------------------------------------------------------- SUBROUTINE ginst_stencil_path (stencil_name, instance_name, start_map, & end_map, instance_num, path ) use fbindtypes INTEGER, INTENT(IN) :: stencil_name INTEGER, INTENT(IN) :: instance_name TYPE(Gwc_point), INTENT(IN) :: start_map TYPE(Gwc_point), INTENT(IN) :: end_map REAL, INTENT(IN) :: instance_num TYPE(Gpath), INTENT(IN) :: path end subroutine !----------------------------------------------------------------------------- SUBROUTINE ginst_stencil_seq_path (instance_seq_spec, path, stencil_tran) use fbindtypes TYPE(Ginstance_seq_spec), INTENT(IN) :: instance_seq_spec TYPE(Gpath_spec), INTENT(IN) :: path TYPE(Gmatrix_23), INTENT(IN) :: stencil_tran end subroutine !----------------------------------------------------------------------------- SUBROUTINE gopen_tiling ( tiling_name ) use fbindtypes INTEGER, INTENT(IN) :: tiling_name end subroutine !----------------------------------------------------------------------------- SUBROUTINE gclose_tiling () use fbindtypes end subroutine !----------------------------------------------------------------------------- SUBROUTINE grename_tiling ( old_tiling_name, new_tiling_name ) use fbindtypes INTEGER, INTENT(IN) :: old_tiling_name INTEGER, INTENT(IN) :: new_tiling_name end subroutine !----------------------------------------------------------------------------- SUBROUTINE gdel_tiling ( tiling_name ) use fbindtypes INTEGER tiling_name end subroutine !----------------------------------------------------------------------------- SUBROUTINE gadd_set_names_nameset (nameset) use fbindtypes TYPE (Gname_set), INTENT(IN) :: nameset end subroutine !----------------------------------------------------------------------------- SUBROUTINE gremove_set_names_nameset (nameset) use fbindtypes TYPE (Gname_set), INTENT(IN) :: nameset end subroutine !----------------------------------------------------------------------------- SUBROUTINE gadd_set_scissor_scissor_set (scissor_set) use fbindtypes TYPE (Gscissor_set), INTENT(IN) :: scissor_set end subroutine !----------------------------------------------------------------------------- SUBROUTINE gremove_set_scissor_scissor_set (scissor_id_set) use fbindtypes TYPE (Gscissor_id_set), INTENT(IN) :: scissor_id_set end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_win_vp (normtran, win_limits, vp_limits) use fbindtypes INTEGER, INTENT(IN) :: normtran TYPE (Gwc_win), INTENT(IN) :: win_limits TYPE (Gndc_vp), INTENT(IN) :: vp_limits end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_vp_in_pri (normtran, ref_tran_num, rel_pri) use fbindtypes INTEGER, INTENT(IN) :: normtran INTEGER, INTENT(IN) :: ref_tran_num TYPE(Gpri_id), INTENT(IN) :: rel_pri end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_scissor_mode (mode) use fbindtypes TYPE(Gscissor_mode_id), INTENT(IN) :: mode end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_norm_tran_num (normtran) use fbindtypes INTEGER, INTENT(IN) :: normtran end subroutine !----------------------------------------------------------------------------- SUBROUTINE gdel_prims_ndc_pic (selcrit) use fbindtypes TYPE(Gsel_crit), INTENT(IN) :: selcrit end subroutine !----------------------------------------------------------------------------- SUBROUTINE gadd_set_names_ndc_pic (name_set, selcrit) use fbindtypes TYPE(Gname_set), INTENT(IN) :: name_set TYPE (Gsel_crit), INTENT(IN) :: selcrit end subroutine !----------------------------------------------------------------------------- SUBROUTINE gremove_set_names_ndc_pic (name_set, selcrit) use fbindtypes TYPE(Gname_set), INTENT(IN) :: name_set TYPE(Gsel_crit), INTENT(IN) :: selcrit end subroutine !----------------------------------------------------------------------------- SUBROUTINE gremove_set_scissor_ndc_pic ( scissor_id_set, selcrit ) use fbindtypes TYPE(Gscissor_id_set), INTENT(IN) :: scissor_id_set TYPE(Gsel_crit), INTENT(IN) :: selcrit end subroutine !----------------------------------------------------------------------------- SUBROUTINE gadd_set_scissor_ndc_pic ( scissor_set, selcrit ) use fbindtypes TYPE(Gscissor_set), INTENT(IN) :: scissor_set TYPE(Gsel_crit), INTENT(IN) :: selcrit end subroutine !----------------------------------------------------------------------------- SUBROUTINE greorder_ndc_pic ( src_sel, ref_sel, rel_pos ) use fbindtypes TYPE(Gsel_crit), INTENT(IN) :: src_sel TYPE(Gsel_crit), INTENT(IN) :: ref_sel TYPE(Gpos_id), INTENT(IN) :: rel_pos end subroutine !----------------------------------------------------------------------------- SUBROUTINE gcopy_ndc_pic_ndc_mf ( ndc_mf_spec, picid, selcrit, nameset ) use fbindtypes CHARACTER(LEN=*), INTENT(IN) :: ndc_mf_spec INTEGER, INTENT(IN) :: picid TYPE(Gsel_crit), INTENT(IN) :: selcrit TYPE(Gname_set), INTENT(IN) :: nameset end subroutine !----------------------------------------------------------------------------- SUBROUTINE gcopy_ndc_mf_pic_ndc_pic (ndc_mf_spec, picid, nameset) use fbindtypes CHARACTER(LEN=*), INTENT(IN) :: ndc_mf_spec INTEGER, INTENT(IN) :: picid TYPE(Gname_set), INTENT(IN) :: nameset end subroutine !----------------------------------------------------------------------------- SUBROUTINE gopen_pic_part (partname) use fbindtypes INTEGER, INTENT(IN) :: partname end subroutine !----------------------------------------------------------------------------- SUBROUTINE gclose_pic_part () use fbindtypes end subroutine !----------------------------------------------------------------------------- SUBROUTINE gar_pic_part (part_name, ar_spec, ar_name) use fbindtypes INTEGER, INTENT(IN) :: part_name CHARACTER(LEN=*), INTENT(IN) :: ar_spec INTEGER, INTENT(IN) :: ar_name end subroutine !----------------------------------------------------------------------------- SUBROUTINE gret_pic_part_ar (ar_spec, ar_name, part_name) use fbindtypes CHARACTER (LEN=*), INTENT(IN) :: ar_spec INTEGER, INTENT(IN) :: ar_name INTEGER, INTENT(IN) :: part_name end subroutine !----------------------------------------------------------------------------- SUBROUTINE greopen_pic_part (part_name) use fbindtypes INTEGER, INTENT(IN) :: part_name end subroutine !----------------------------------------------------------------------------- SUBROUTINE gappend_pic_part (src_partname, sink_partname, globaltran, & globalmode, localtran, localmode, nameset ) use fbindtypes INTEGER, INTENT(IN) :: src_partname INTEGER, INTENT(IN) :: sink_partname TYPE(Gmatrix_23), INTENT(IN) :: globaltran TYPE(Gtran_mode_id), INTENT(IN) :: globalmode TYPE(Gmatrix_23), INTENT(IN) :: localtran TYPE(Gtran_mode_id), INTENT(IN) :: localmode TYPE(Gname_set), INTENT(IN) :: nameset end subroutine !----------------------------------------------------------------------------- SUBROUTINE grename_pic_part (old_name, new_name) use fbindtypes INTEGER, INTENT(IN) :: old_name INTEGER, INTENT(IN) :: new_name end subroutine !----------------------------------------------------------------------------- SUBROUTINE gdel_pic_part (part_name) use fbindtypes INTEGER, INTENT(IN) :: part_name ! picture part name to delete end subroutine !----------------------------------------------------------------------------- SUBROUTINE gcopy_pic_part_pic_part_store (part_name, sel_crit, global_tran, & global_mode, local_tran, local_mode,& name_set, scissor_sel) use fbindtypes INTEGER, INTENT(IN) :: part_name TYPE(Gsel_crit), INTENT(IN) :: sel_crit TYPE(Gmatrix_23), INTENT(IN) :: global_tran TYPE(Gtran_mode_id), INTENT(IN) :: global_mode TYPE(Gmatrix_23), INTENT(IN) :: local_tran TYPE(Gtran_mode_id), INTENT(IN) :: local_mode TYPE(Gname_set), INTENT(IN) :: name_set TYPE(Gscissor_sel_id), INTENT(IN) :: scissor_sel end subroutine !----------------------------------------------------------------------------- SUBROUTINE gcopy_ndc_pic_pic_part_store (sel_crit, part_name, name_set) use fbindtypes TYPE (Gsel_crit), INTENT(IN) :: sel_crit INTEGER, INTENT(IN) :: part_name TYPE (Gname_set), INTENT(IN) :: name_set end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_in_dev_mode ( dev_id, mode ) use fbindtypes TYPE(Gdev_id), INTENT(IN) :: dev_id TYPE(Gop_mode_id), INTENT(IN) :: mode end subroutine !----------------------------------------------------------------------------- SUBROUTINE greq_in ( dev_id, in_st, in_val ) use fbindtypes TYPE(Gdev_id),INTENT(IN) :: dev_id TYPE(Gin_st_id),INTENT(OUT) :: in_st TYPE(Gin_val),INTENT(OUT) :: in_val end subroutine !----------------------------------------------------------------------------- SUBROUTINE gsample_in ( dev_id, in_val ) use fbindtypes TYPE(Gdev_id),INTENT(IN) :: dev_id TYPE(Gin_val),INTENT(OUT) :: in_val end subroutine !----------------------------------------------------------------------------- SUBROUTINE gawait_in ( timeout, events ) use fbindtypes REAL, INTENT(IN) :: timeout TYPE(Gdev_id_val_set),INTENT(OUT) :: events end subroutine !----------------------------------------------------------------------------- SUBROUTINE gflush_dev_events (dev_id) use fbindtypes TYPE(Gdev_id), INTENT(IN) :: dev_id end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_font_ind_map ( font_index, font_name ) use fbindtypes INTEGER, INTENT(IN) :: font_index CHARACTER(LEN=*), INTENT(IN) :: font_name end subroutine !----------------------------------------------------------------------------- SUBROUTINE gget_glyph_name ( font_index, spec_char, spec_glyph ) use fbindtypes INTEGER, INTENT(IN) :: font_index CHARACTER(LEN=1), INTENT(IN) :: spec_char CHARACTER(LEN=*), INTENT(OUT) :: spec_glyph end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_char_code ( font_index, spec_char, spec_glyph ) use fbindtypes INTEGER, INTENT(IN) :: font_index CHARACTER(LEN=1), INTENT(IN) :: spec_char CHARACTER(LEN=*), INTENT(IN) :: spec_glyph end subroutine !----------------------------------------------------------------------------- SUBROUTINE gaudit (audit_id, audit_op) use fbindtypes INTEGER, INTENT(IN) :: audit_id TYPE(Gaudit_op_id), INTENT(IN) :: audit_op end subroutine !----------------------------------------------------------------------------- SUBROUTINE gwrite_user_rec_audit (audit_id, rec) use fbindtypes INTEGER, INTENT(IN) :: audit_id TYPE(Gaudit_user_data), INTENT(IN) :: rec end subroutine !----------------------------------------------------------------------------- SUBROUTINE gplayback (audit_id, playback_op) use fbindtypes INTEGER, INTENT(IN) :: audit_id TYPE(Gplayback_ops), INTENT(IN) :: playback_op end subroutine !----------------------------------------------------------------------------- SUBROUTINE gread_item_func_name_audit (audit_id, func_name) use fbindtypes INTEGER, INTENT(IN) :: audit_id TYPE(Gfn_id),INTENT(OUT) :: func_name end subroutine !----------------------------------------------------------------------------- SUBROUTINE gread_item_audit (audit_id, func_name, func_params) use fbindtypes INTEGER, INTENT(IN) :: audit_id TYPE(Gfn_id),INTENT(OUT) :: func_name TYPE(Gfunc_params),INTENT(OUT) :: func_params end subroutine !----------------------------------------------------------------------------- SUBROUTINE gproc_audit_item (audit_id, intr_op) use fbindtypes INTEGER, INTENT(IN) :: audit_id TYPE(Gprocess_op_id), INTENT(IN) :: intr_op end subroutine !----------------------------------------------------------------------------- SUBROUTINE ginq_op_st_entry ( entry_name, error_ind, entry_value ) use fbindtypes TYPE(Gop_st_list_id), INTENT(IN) :: entry_name INTEGER,INTENT(OUT) :: error_ind TYPE(Gop_st_list),INTENT(OUT) :: entry_value end subroutine !----------------------------------------------------------------------------- SUBROUTINE ginq_gdt_entry (ent_name, err_ind, ent_val) use fbindtypes TYPE(Ggdt_id), INTENT(IN) :: ent_name INTEGER,INTENT(OUT) :: err_ind TYPE(Ggdt),INTENT(OUT) :: ent_val end subroutine !----------------------------------------------------------------------------- SUBROUTINE ginq_gsl_entry (ent_name, err_ind, ent_val) use fbindtypes TYPE(Ggsl_id), INTENT(IN) :: ent_name INTEGER,INTENT(OUT) :: err_ind TYPE(Ggsl),INTENT(OUT) :: ent_val end subroutine !----------------------------------------------------------------------------- SUBROUTINE ginq_in_overf (err_ind, & dev_id ) use fbindtypes INTEGER,INTENT(OUT) :: err_ind TYPE(Gdev_id),INTENT(OUT) :: dev_id end subroutine !----------------------------------------------------------------------------- SUBROUTINE geval_tran_matrix (fixed_pt, shift_vec, rot_angle, scale_facs, & tran_mat) use fbindtypes TYPE(Gwc_ndc_point), INTENT(IN) :: fixed_pt TYPE(gwc_ndc_point), INTENT(IN) :: shift_vec REAL, INTENT(IN) :: rot_angle TYPE(Gscale_facs), INTENT(IN) :: scale_facs TYPE(Gmatrix_23),INTENT(OUT) :: tran_mat end subroutine !----------------------------------------------------------------------------- SUBROUTINE gaccum_tran_matrix (in_mat, fixed_pt, shift_vec, rot_angle, & scale_facs, tran_mat ) use fbindtypes TYPE(Gmatrix_23), INTENT(IN) :: in_mat TYPE(Gwc_ndc_point), INTENT(IN) :: fixed_pt TYPE(Gwc_ndc_point), INTENT(IN) :: shift_vec REAL, INTENT(IN) :: rot_angle TYPE(Gscale_facs), INTENT(IN) :: scale_facs TYPE(Gmatrix_23),INTENT(OUT) :: tran_mat end subroutine !----------------------------------------------------------------------------- SUBROUTINE geval_circle ( centre, radius, circle ) use fbindtypes TYPE(Gwc_point), INTENT(IN) :: centre REAL, INTENT(IN) :: radius TYPE(Gmatrix_33),INTENT(OUT) :: circle end subroutine !----------------------------------------------------------------------------- SUBROUTINE geval_ell (ellip_spec, ellip) use fbindtypes TYPE(Gellip_spec), INTENT(IN) :: ellip_spec TYPE(Gmatrix_33),INTENT(OUT) :: ellip end subroutine !----------------------------------------------------------------------------- SUBROUTINE geval_circ_arc_3_point ( start_pt, imm_pt, end_pt, circular_arc ) use fbindtypes TYPE(Gwc_point), INTENT(IN) :: start_pt TYPE(Gwc_point), INTENT(IN) :: imm_pt TYPE(Gwc_point), INTENT(IN) :: end_pt TYPE(Gconic_sec),INTENT(OUT) :: circular_arc end subroutine !----------------------------------------------------------------------------- SUBROUTINE geval_circ_arc_ctr (centre, start_vec, end_vec, sense_flag, & radius, circular_arc) use fbindtypes TYPE(Gwc_point), INTENT(IN) :: centre TYPE(Gvec), INTENT(IN) :: start_vec TYPE(Gvec), INTENT(IN) :: end_vec TYPE(Gsense_flag_id), INTENT(IN) :: sense_flag REAL, INTENT(IN) :: radius TYPE(Gconic_sec),INTENT(OUT) :: circular_arc end subroutine !----------------------------------------------------------------------------- SUBROUTINE geval_ell_arc ( centre, ellip_spec, start_vec, & end_vec, conic_arc ) use fbindtypes TYPE(Gwc_point), INTENT(IN) :: centre TYPE(Gellip_spec), INTENT(IN) :: ellip_spec TYPE(Gvec), INTENT(IN) :: start_vec TYPE(Gvec), INTENT(IN) :: end_vec TYPE(Gconic_sec),INTENT(OUT) :: conic_arc end subroutine !----------------------------------------------------------------------------- SUBROUTINE geval_hyp_arc ( hyperbola_spec, start_vec, end_vec, conic_arc ) use fbindtypes TYPE(Ghyperbola_spec), INTENT(IN) :: hyperbola_spec TYPE(Gvec), INTENT(IN) :: start_vec TYPE(Gvec), INTENT(IN) :: end_vec TYPE(Gconic_sec),INTENT(OUT) :: conic_arc end subroutine !----------------------------------------------------------------------------- SUBROUTINE geval_par_arc ( parabola_spec, conic_arc ) use fbindtypes TYPE(Gparabola_spec), INTENT(IN) :: parabola_spec TYPE(Gconic_sec),INTENT(OUT) :: conic_arc end subroutine !----------------------------------------------------------------------------- SUBROUTINE geval_wc_ord ( wc_ordinate, ord_sel, ndc_val ) use fbindtypes REAL, INTENT(IN) :: wc_ordinate TYPE(Gord_sel_id), INTENT(IN) :: ord_sel REAL,INTENT(OUT) :: ndc_val end subroutine !----------------------------------------------------------------------------- SUBROUTINE gopen_ws (wsid, wsspec, wstype) use fbindtypes INTEGER, INTENT(IN) :: wsid CHARACTER (LEN=*), INTENT(IN) :: wsspec TYPE(Gws_type), INTENT(IN) :: wstype end subroutine !----------------------------------------------------------------------------- SUBROUTINE gclose_ws (wsid) use fbindtypes INTEGER, INTENT(IN) :: wsid end subroutine !----------------------------------------------------------------------------- SUBROUTINE gsave_wsl (wsid, ent_names, ent_vals ) use fbindtypes INTEGER, INTENT(IN) :: wsid TYPE(Gwsl_id), POINTER, DIMENSION (:) :: ent_names TYPE(Gwsl), POINTER, DIMENSION (:) :: ent_vals end subroutine !----------------------------------------------------------------------------- SUBROUTINE grestore_wsl (wsid, ent_vals) use fbindtypes INTEGER, INTENT(IN) :: wsid TYPE(Gwsl), POINTER, DIMENSION (:) :: ent_vals end subroutine !----------------------------------------------------------------------------- SUBROUTINE gget_ws_status ( ws_id, ws_st ) use fbindtypes INTEGER, INTENT(IN) :: ws_id TYPE(Gws_st_id), INTENT(OUT) :: ws_st end subroutine !----------------------------------------------------------------------------- SUBROUTINE gremove_backdrop (wsid) use fbindtypes INTEGER, INTENT(IN) :: wsid end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_view_pri ( wsid, view_ind, ref_view_ind, rel_pri ) use fbindtypes INTEGER, INTENT(IN) :: wsid INTEGER, INTENT(IN) :: view_ind INTEGER, INTENT(IN) :: ref_view_ind TYPE(Gpri_id), INTENT(IN) :: rel_pri end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_view_sel_crit ( wsid, view_ind, sel_crit ) use fbindtypes INTEGER, INTENT(IN) :: wsid INTEGER, INTENT(IN) :: view_ind TYPE(Gsel_crit), INTENT(IN) :: sel_crit end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_view ( wsid, view_ind, view_ori_matrix, view_map_matrix, & view_scissor ) use fbindtypes INTEGER, INTENT(IN) :: wsid INTEGER, INTENT(IN) :: view_ind TYPE(Gmatrix_23), INTENT(IN) :: view_ori_matrix TYPE(Gmatrix_23), INTENT(IN) :: view_map_matrix TYPE(Gview_scissor), INTENT(IN) :: view_scissor end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_ws_vis_effects (wsid, vis_eff) use fbindtypes INTEGER, INTENT(IN) :: wsid TYPE(Gvis_eff_st_id), INTENT(IN) :: vis_eff end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_ws_win_vp (wsid, ldc_win, dc_vp) use fbindtypes INTEGER, INTENT(IN) :: wsid TYPE(Gndc_win), INTENT(IN) :: ldc_win TYPE(Gdc_vp), INTENT(IN) :: dc_vp end subroutine !----------------------------------------------------------------------------- SUBROUTINE gdef_in_dev (dev_id, seq_measure_id, trigger_set, init_val) use fbindtypes TYPE(Gdev_id), INTENT(IN) :: dev_id TYPE(Gseq_measure_id), INTENT(IN) :: seq_measure_id TYPE(Gtrigger_set), INTENT(IN) :: trigger_set TYPE(Ginit_val), INTENT(IN) :: init_val end subroutine !----------------------------------------------------------------------------- SUBROUTINE ginit_in_dev (dev_id, init_val) use fbindtypes TYPE(Gdev_id), INTENT(IN) :: dev_id TYPE(Ginit_val), INTENT(IN) :: init_val end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_ws_sel_crit (wsid, sel_type, sel_crit) use fbindtypes INTEGER, INTENT(IN) :: wsid TYPE(Gsel_crit_id), INTENT(IN) :: sel_type TYPE(Gsel_crit), INTENT(IN) :: sel_crit end subroutine !----------------------------------------------------------------------------- SUBROUTINE gcopy_real_pic_real_mf (wsid, rld_mf_spec, picid) use fbindtypes INTEGER, INTENT(IN) :: wsid CHARACTER(LEN=*), INTENT(IN) :: rld_mf_spec INTEGER, INTENT(IN) :: picid end subroutine !----------------------------------------------------------------------------- SUBROUTINE gcopy_blank_real_pic_real_mf (wsid, rld_mf_spec, picid) use fbindtypes INTEGER, INTENT(IN) :: wsid CHARACTER(LEN=*), INTENT(IN) :: rld_mf_spec INTEGER, INTENT(IN) :: picid end subroutine !----------------------------------------------------------------------------- SUBROUTINE gcopy_real_mf_pic_backdrop (wsid, rld_mf_spec, picid) use fbindtypes INTEGER , INTENT(IN) :: wsid CHARACTER(LEN=*), INTENT(IN) :: rld_mf_spec INTEGER, INTENT(IN) :: picid end subroutine !----------------------------------------------------------------------------- SUBROUTINE gmessage (wsid, char_str) use fbindtypes INTEGER, INTENT(IN) :: wsid CHARACTER(LEN=*), INTENT(IN) :: char_str end subroutine !----------------------------------------------------------------------------- SUBROUTINE ginq_wsl_entry (wsid, ent_name, ent_type, err_ind, ent_val) use fbindtypes INTEGER, INTENT(IN) :: wsid TYPE(Gwsl_id), INTENT(IN) :: ent_name TYPE(Gset_realized_id), INTENT(IN) :: ent_type INTEGER, INTENT(OUT) :: err_ind TYPE(Gwsl), INTENT(OUT) :: ent_val end subroutine !----------------------------------------------------------------------------- SUBROUTINE ginq_gen_wdt_entry (wstype, entry_name, error_ind, entry_val) use fbindtypes INTEGER, INTENT(IN) :: wstype TYPE(Gwdt_id), INTENT(IN) :: entry_name INTEGER, INTENT(OUT) :: error_ind TYPE(Gwdt), INTENT(OUT) :: entry_val end subroutine !----------------------------------------------------------------------------- SUBROUTINE ginq_spec_wdt_entry (wsid, entry_name, error_ind, entry_val) use fbindtypes INTEGER, INTENT(IN) :: wsid TYPE(Gwdt_id), INTENT(IN) :: entry_name INTEGER, INTENT(OUT) :: error_ind TYPE(Gwdt), INTENT(OUT) :: entry_val end subroutine !----------------------------------------------------------------------------- SUBROUTINE ginq_spec_wdt_entry_st ( wsid, entry_name, error_ind, entry_state ) use fbindtypes INTEGER, INTENT(IN) :: wsid TYPE(Gwdt_id), INTENT(IN) :: entry_name INTEGER, INTENT(OUT) :: error_ind INTEGER, INTENT(OUT) :: entry_state end subroutine !----------------------------------------------------------------------------- SUBROUTINE gres_spec_wdt_entry_st (wsid, entry_name) use fbindtypes INTEGER, INTENT(IN) :: wsid TYPE(Gwdt_id), INTENT(IN) :: entry_name end subroutine !----------------------------------------------------------------------------- SUBROUTINE gget_text_extent (wsid, text_pos, char_str, err_ind, concat_pt, & xmin, xmax, ymin, ymax) use fbindtypes INTEGER, INTENT(IN) :: wsid TYPE(Gwc_point), INTENT(IN) :: text_pos CHARACTER (LEN=*), INTENT(IN) :: char_str INTEGER,INTENT(OUT) :: err_ind TYPE(Gwc_point),INTENT(OUT) :: concat_pt TYPE(Gwc_point),INTENT(OUT) :: xmin TYPE(Gwc_point),INTENT(OUT) :: xmax TYPE(Gwc_point),INTENT(OUT) :: ymin TYPE(Gwc_point),INTENT(OUT) :: ymax end subroutine !----------------------------------------------------------------------------- SUBROUTINE geval_view_ori_matrix ( view_ref_pt, view_up_vec, view_ori_mat ) use fbindtypes TYPE(Gndc_point), INTENT(IN) :: view_ref_pt TYPE(Gview_up_vec), INTENT(IN) :: view_up_vec TYPE(Gmatrix_23), INTENT(OUT) :: view_ori_mat end subroutine !----------------------------------------------------------------------------- SUBROUTINE geval_view_map_matrix ( win_lim, vp_lim, view_map_mat ) use fbindtypes TYPE(Gndc_win), INTENT(IN) :: win_lim TYPE(Gldc_vp), INTENT(IN) :: vp_lim TYPE(Gmatrix_23), INTENT(OUT) :: view_map_mat end subroutine !----------------------------------------------------------------------------- SUBROUTINE gconv_colr(wsid, colr_spec, colr_model, colr_val, conv_flag) use fbindtypes INTEGER, INTENT(IN) :: wsid TYPE(Gcolr_spec), INTENT(IN) :: colr_spec TYPE(Gcolr_model_id), INTENT(IN) :: colr_model TYPE(Gcolr_spec), INTENT(OUT) :: colr_val TYPE(Gconv_flag_id), INTENT(OUT) :: conv_flag end subroutine !----------------------------------------------------------------------------- SUBROUTINE gcreate_seg (seg_name) use fbindtypes INTEGER, INTENT(IN) :: seg_name end subroutine !----------------------------------------------------------------------------- SUBROUTINE gclose_seg () use fbindtypes end subroutine !----------------------------------------------------------------------------- SUBROUTINE grename_seg (old_name, new_name) use fbindtypes INTEGER, INTENT(IN) :: old_name INTEGER, INTENT(IN) :: new_name end subroutine !----------------------------------------------------------------------------- SUBROUTINE gdel_seg (seg_name) use fbindtypes INTEGER, INTENT(IN) :: seg_name end subroutine !----------------------------------------------------------------------------- SUBROUTINE gdel_seg_ws (wsid, seg_name) use fbindtypes INTEGER, INTENT(IN) :: wsid INTEGER, INTENT(IN) :: seg_name end subroutine !----------------------------------------------------------------------------- SUBROUTINE gassoc_seg_ws (wsid, seg_name) use fbindtypes INTEGER, INTENT(IN) :: wsid INTEGER, INTENT(IN) :: seg_name end subroutine !----------------------------------------------------------------------------- SUBROUTINE gcopy_seg_ws (wsid, seg_name) use fbindtypes INTEGER, INTENT(IN) :: wsid INTEGER, INTENT(IN) :: seg_name end subroutine !----------------------------------------------------------------------------- SUBROUTINE ginsert_seg (seg_name, tran_mat) use fbindtypes INTEGER, INTENT(IN) :: seg_name TYPE(Gmatrix_23), INTENT(IN) :: tran_mat end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_seg_attr (seg_name, seg_attr_val) use fbindtypes INTEGER, INTENT(IN) :: seg_name TYPE(Gseg_attr_val), INTENT(IN) :: seg_attr_val end subroutine !----------------------------------------------------------------------------- SUBROUTINE gactivate_ws (wsid) use fbindtypes INTEGER, INTENT(IN) :: wsid end subroutine !----------------------------------------------------------------------------- SUBROUTINE gdeactivate_ws (wsid) use fbindtypes INTEGER, INTENT(IN) :: wsid end subroutine !----------------------------------------------------------------------------- SUBROUTINE gclear_ws (wsid) use fbindtypes INTEGER, INTENT(IN) :: wsid end subroutine !----------------------------------------------------------------------------- SUBROUTINE gget_map_seg_name (seg_name, map_name) use fbindtypes INTEGER, INTENT(IN) :: seg_name INTEGER, INTENT(OUT) :: map_name end subroutine !----------------------------------------------------------------------------- SUBROUTINE gget_map_ws_id (wsid, map_name) use fbindtypes INTEGER, INTENT(IN) :: wsid TYPE(Ggen_name), INTENT(OUT) :: map_name end subroutine !----------------------------------------------------------------------------- end interface INTERFACE gcreate_out_prim SUBROUTINE gcreate_out_line (line) use fbindtypes TYPE(Gset_line), INTENT(IN) :: line end subroutine !----------------------------------------------------------------------------- SUBROUTINE gcreate_out_nurb (nurb) use fbindtypes TYPE(Gset_nurb), INTENT(IN) :: nurb end subroutine !----------------------------------------------------------------------------- SUBROUTINE gcreate_out_conic_sec (conic_sec) use fbindtypes TYPE(Gset_conic_sec), INTENT(IN) :: conic_sec end subroutine !----------------------------------------------------------------------------- SUBROUTINE gcreate_out_marker (marker) use fbindtypes TYPE(Gmarker), INTENT(IN) :: marker end subroutine !----------------------------------------------------------------------------- SUBROUTINE gcreate_out_fill (fill) use fbindtypes TYPE(Gset_fill), INTENT(IN) :: fill end subroutine !----------------------------------------------------------------------------- SUBROUTINE gcreate_out_ellip_sec (ellip_sec) use fbindtypes TYPE(Gset_ellip_sec), INTENT(IN) :: ellip_sec end subroutine !----------------------------------------------------------------------------- SUBROUTINE gcreate_out_ellip_seg (ellip_seg) use fbindtypes TYPE(Gset_ellip_seg), INTENT(IN) :: ellip_seg end subroutine !----------------------------------------------------------------------------- SUBROUTINE gcreate_out_ellip_disc (ellip_disc) use fbindtypes TYPE(Gset_ellip_disc), INTENT(IN) :: ellip_disc end subroutine !----------------------------------------------------------------------------- SUBROUTINE gcreate_out_closed_nurb (closed_nurb) use fbindtypes TYPE(Gset_closed_nurb), INTENT(IN) :: closed_nurb end subroutine !----------------------------------------------------------------------------- SUBROUTINE gcreate_out_text (text) use fbindtypes TYPE(Gtext), INTENT(IN) :: text end subroutine !----------------------------------------------------------------------------- SUBROUTINE gcreate_out_cell_array (cell_array) use fbindtypes TYPE(Gcell_array), INTENT(IN) :: cell_array end subroutine !----------------------------------------------------------------------------- SUBROUTINE gcreate_out_design (design) use fbindtypes TYPE(Gdesign), INTENT(IN) :: design end subroutine !----------------------------------------------------------------------------- SUBROUTINE gcreate_out_gdp (gdp) use fbindtypes TYPE(Ggdp), INTENT(IN) :: gdp end subroutine !----------------------------------------------------------------------------- END INTERFACE !################################################### INTERFACE gset_cont_attr SUBROUTINE gset_cont_attr_style (style) use fbindtypes TYPE(Gstyle_id), INTENT(IN) :: style end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_cont_attr_width (width) use fbindtypes REAL, INTENT(IN) :: width end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_cont_attr_cap (cap) use fbindtypes TYPE(Gcap_id), INTENT(IN) :: cap end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_cont_attr_join (join) use fbindtypes TYPE(Gjoin), INTENT(IN) :: join end subroutine !----------------------------------------------------------------------------- END INTERFACE !################################################### INTERFACE gset_stencil_attr SUBROUTINE gset_st_attr_topy (topy) use fbindtypes TYPE(Gtopy) :: topy end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_st_attr_capy (capy) use fbindtypes TYPE(Gcapy) :: capy end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_st_attr_halfy (halfy) use fbindtypes TYPE(Ghalfy) :: halfy end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_st_attr_basey (basey) use fbindtypes TYPE(Gbasey) :: basey end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_st_attr_bottomy (bottomy) use fbindtypes TYPE(Gbottomy) :: bottomy end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_st_attr_centrey (centrey) use fbindtypes TYPE(Gcentrey) :: centrey end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_st_attr_leftx (leftx) use fbindtypes TYPE(Gleftx) :: leftx end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_st_attr_rightx (rightx) use fbindtypes TYPE(Grightx) :: rightx end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_st_attr_centrex (centrex) use fbindtypes TYPE(Gcentrex) :: centrex end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_st_attr_centre (centre) use fbindtypes TYPE(Glc_point_centre) :: centre end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_st_attr_origin (origin) use fbindtypes TYPE(Glc_point_origin) :: origin end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_st_attr_centretop (centretop) use fbindtypes TYPE(Glc_point_centretop) :: centretop end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_st_attr_centrebottom (centrebottom) use fbindtypes TYPE(Glc_point_centrebottom) :: centrebottom end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_st_attr_centreleft (centreleft) use fbindtypes TYPE(Glc_point_centreleft) :: centreleft end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_st_attr_centreright (centreright) use fbindtypes TYPE(Glc_point_centreright) :: centreright end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_st_attr_topleft (topleft) use fbindtypes TYPE(Glc_point_topleft) :: topleft end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_st_attr_topright (topright) use fbindtypes TYPE(Glc_point_topright) :: topright end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_st_attr_bottomleft (bottomleft) use fbindtypes TYPE(Glc_point_bottomleft) :: bottomleft end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_st_attr_bottomright (bottomright) use fbindtypes TYPE(Glc_point_bottomright) :: bottomright end subroutine !----------------------------------------------------------------------------- END INTERFACE !################################################### INTERFACE ginst_stencil SUBROUTINE ginst_stencil_put_spec (stencil_name, instance_name, stencil_tran, & put_spec) use fbindtypes INTEGER, INTENT(IN) :: stencil_name INTEGER, INTENT(IN) :: instance_name TYPE(Gmatrix_23), INTENT(IN) :: stencil_tran TYPE(Gput), INTENT(IN) :: put_spec end subroutine !----------------------------------------------------------------------------- SUBROUTINE ginst_stencil_align_spec (stencil_name, instance_name, stencil_tran, & align_spec) use fbindtypes INTEGER, INTENT(IN) :: stencil_name INTEGER, INTENT(IN) :: instance_name TYPE(Gmatrix_23), INTENT(IN) :: stencil_tran TYPE(Galign), INTENT(IN) :: align_spec end subroutine !----------------------------------------------------------------------------- SUBROUTINE ginst_stencil_map_spec (stencil_name, instance_name, stencil_tran, & map_spec) use fbindtypes INTEGER, INTENT(IN) :: stencil_name INTEGER, INTENT(IN) :: instance_name TYPE(Gmatrix_23), INTENT(IN) :: stencil_tran TYPE(Gmap), INTENT(IN) :: map_spec end subroutine !----------------------------------------------------------------------------- END INTERFACE !################################################### INTERFACE gcreate_tiling_comp SUBROUTINE gctc_set_line (set_line, origin, rep_tech) use fbindtypes TYPE(Gset_line), INTENT(IN) :: set_line TYPE(Gwc_point), INTENT(IN) :: origin TYPE(Greplic_tech_id), INTENT(IN) :: rep_tech end subroutine !----------------------------------------------------------------------------- SUBROUTINE gctc_set_nurb (set_nurb, origin, rep_tech) use fbindtypes TYPE(Gset_nurb), INTENT(IN) :: set_nurb TYPE(Gwc_point), INTENT(IN) :: origin TYPE(Greplic_tech_id), INTENT(IN) :: rep_tech end subroutine !----------------------------------------------------------------------------- SUBROUTINE gctc_set_conic_sec (set_conic_sec, origin, rep_tech) use fbindtypes TYPE(Gset_conic_sec), INTENT(IN) :: set_conic_sec TYPE(Gwc_point), INTENT(IN) :: origin TYPE(Greplic_tech_id), INTENT(IN) :: rep_tech end subroutine !----------------------------------------------------------------------------- SUBROUTINE gctc_set_fill (set_fill, origin, rep_tech) use fbindtypes TYPE(Gset_fill), INTENT(IN) :: set_fill TYPE(Gwc_point), INTENT(IN) :: origin TYPE(Greplic_tech_id), INTENT(IN) :: rep_tech end subroutine !----------------------------------------------------------------------------- SUBROUTINE gctc_set_ellip_sec (set_ellip_sec, origin, rep_tech) use fbindtypes TYPE(Gset_ellip_sec), INTENT(IN) :: set_ellip_sec TYPE(Gwc_point), INTENT(IN) :: origin TYPE(Greplic_tech_id), INTENT(IN) :: rep_tech end subroutine !----------------------------------------------------------------------------- SUBROUTINE gctc_set_ellip_seg (set_ellip_seg, origin, rep_tech) use fbindtypes TYPE(Gset_ellip_seg), INTENT(IN) :: set_ellip_seg TYPE(Gwc_point), INTENT(IN) :: origin TYPE(Greplic_tech_id), INTENT(IN) :: rep_tech end subroutine !----------------------------------------------------------------------------- SUBROUTINE gctc_set_ellip_disc (set_ellip_disc, origin, rep_tech) use fbindtypes TYPE(Gset_ellip_disc), INTENT(IN) :: set_ellip_disc TYPE(Gwc_point), INTENT(IN) :: origin TYPE(Greplic_tech_id), INTENT(IN) :: rep_tech end subroutine !----------------------------------------------------------------------------- SUBROUTINE gctc_set_closed_nurb (set_closed_nurb, origin, rep_tech) use fbindtypes TYPE(Gset_closed_nurb), INTENT(IN) :: set_closed_nurb TYPE(Gwc_point), INTENT(IN) :: origin TYPE(Greplic_tech_id), INTENT(IN) :: rep_tech end subroutine !----------------------------------------------------------------------------- SUBROUTINE gctc_design (design, origin, rep_tech) use fbindtypes TYPE(Gdesign), INTENT(IN) :: design end subroutine !----------------------------------------------------------------------------- END INTERFACE !################################################### INTERFACE gset_prim_attr SUBROUTINE gset_pa_pick_id (pick_id) use fbindtypes TYPE(Gpick_id), INTENT(IN) :: pick_id end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_pa_name_set (name_set) use fbindtypes TYPE(Gname_set), INTENT(IN) :: name_set end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_pa_scissor_set (scissor_set) use fbindtypes TYPE(Gscissor_set), INTENT(IN) :: scissor_set end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_pa_global_tran (global_tran) use fbindtypes TYPE(Gmatrix_23_global), INTENT(IN) :: global_tran end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_pa_loc_tran (loc_tran) use fbindtypes TYPE(Gmatrix_23_local), INTENT(IN) :: loc_tran end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_pa_pat_size (pat_size) use fbindtypes TYPE(Gpat_size), INTENT(IN) :: pat_size end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_pa_pat_ref_pt (pat_ref_pt) use fbindtypes TYPE(Gwc_point), INTENT(IN) :: pat_ref_pt end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_pa_text_height (text_height) use fbindtypes TYPE(Gtext_height), INTENT(IN) :: text_height end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_pa_text_up_vec (text_up_vec) use fbindtypes TYPE(Gtext_up_vec), INTENT(IN) :: text_up_vec end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_pa_text_skew (text_skew) use fbindtypes TYPE(Gtext_skew), INTENT(IN) :: text_skew end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_pa_text_path (text_path) use fbindtypes TYPE(Gtext_path_id), INTENT(IN) :: text_path end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_pa_text_align (text_align) use fbindtypes TYPE(Gtext_align), INTENT(IN) :: text_align end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_pa_curve_ind (curve_ind) use fbindtypes TYPE(Gcurve_ind), INTENT(IN) :: curve_ind end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_pa_curve_asfs (curve_asfs) use fbindtypes TYPE(Gcurve_asfs), INTENT(IN) :: curve_asfs end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_pa_curve_type (curve_type) use fbindtypes TYPE(Gcurve_type), INTENT(IN) :: curve_type end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_pa_curve_width (curve_width) use fbindtypes TYPE(Gcurve_width), INTENT(IN) :: curve_width end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_pa_curve_colr_spec (curve_colr_spec) use fbindtypes TYPE(Gcurve_colr_spec), INTENT(IN) :: curve_colr_spec end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_pa_marker_ind (marker_ind) use fbindtypes TYPE(Gmarker_ind), INTENT(IN) :: marker_ind end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_pa_marker_asfs (marker_asfs) use fbindtypes TYPE(Gmarker_asfs), INTENT(IN) :: marker_asfs end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_pa_marker_type (marker_type) use fbindtypes TYPE(Gmarker_type), INTENT(IN) :: marker_type end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_pa_marker_size (marker_size) use fbindtypes TYPE(Gmarker_size), INTENT(IN) :: marker_size end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_pa_marker_colr_spec (marker_colr_spec) use fbindtypes TYPE(Gcolr_spec), INTENT(IN) :: marker_colr_spec end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_pa_area_ind (area_ind) use fbindtypes TYPE(Garea_ind), INTENT(IN) :: area_ind end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_pa_area_asfs (area_asfs) use fbindtypes TYPE(Garea_asfs), INTENT(IN) :: area_asfs end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_pa_int_style (int_style) use fbindtypes TYPE(Gint_style_id), INTENT(IN) :: int_style end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_pa_int_style_ind (int_style_ind) use fbindtypes TYPE(Gint_style_ind), INTENT(IN) :: int_style_ind end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_pa_int_colr_spec (int_colr_spec) use fbindtypes TYPE(Gint_colr_spec), INTENT(IN) :: int_colr_spec end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_pa_edge_flag (edge_flag) use fbindtypes TYPE(Gedge_flag_id), INTENT(IN) :: edge_flag end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_pa_edge_type (edge_type) use fbindtypes TYPE(Gedge_type), INTENT(IN) :: edge_type end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_pa_edge_width (edge_width) use fbindtypes TYPE(Gedge_width), INTENT(IN) :: edge_width end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_pa_edge_colr_spec (edge_colr_spec) use fbindtypes TYPE(Gedge_colr_spec), INTENT(IN) :: edge_colr_spec end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_pa_char_ind (char_ind) use fbindtypes TYPE(Gchar_ind), INTENT(IN) :: char_ind end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_pa_char_asfs (char_asfs) use fbindtypes TYPE(Gchar_asfs), INTENT(IN) :: char_asfs end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_pa_char_font_prec (char_font_prec) use fbindtypes TYPE(Gfont_prec), INTENT(IN) :: char_font_prec end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_pa_char_expan (char_expan) use fbindtypes TYPE(Gchar_expan), INTENT(IN) :: char_expan end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_pa_char_space (char_space) use fbindtypes TYPE(Gchar_space), INTENT(IN) :: char_space end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_pa_char_colr_spec (char_colr_spec) use fbindtypes TYPE(Gchar_colr_spec), INTENT(IN) :: char_colr_spec end subroutine !----------------------------------------------------------------------------- END INTERFACE !################################################### INTERFACE gset_ndc_pic_prim_attr SUBROUTINE gset_nppa_pick_id (selcrit, pick_id) use fbindtypes TYPE(Gsel_crit) , INTENT(IN) :: selcrit TYPE(Gpick_id), INTENT(IN) :: pick_id end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_nppa_name_set (selcrit, name_set) use fbindtypes TYPE(Gsel_crit) , INTENT(IN) :: selcrit TYPE(Gname_set), INTENT(IN) :: name_set end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_nppa_scissor_set (selcrit, scissor_set) use fbindtypes TYPE(Gsel_crit) , INTENT(IN) :: selcrit TYPE(Gscissor_set), INTENT(IN) :: scissor_set end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_nppa_global_tran (selcrit, global_tran) use fbindtypes TYPE(Gsel_crit) , INTENT(IN) :: selcrit TYPE(Gmatrix_23_global), INTENT(IN) :: global_tran end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_nppa_loc_tran (selcrit, loc_tran) use fbindtypes TYPE(Gsel_crit) , INTENT(IN) :: selcrit TYPE(Gmatrix_23_local), INTENT(IN) :: loc_tran end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_nppa_pat_size (selcrit, pat_size) use fbindtypes TYPE(Gsel_crit) , INTENT(IN) :: selcrit TYPE(Gpat_size), INTENT(IN) :: pat_size end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_nppa_pat_ref_pt (selcrit, pat_ref_pt) use fbindtypes TYPE(Gsel_crit) , INTENT(IN) :: selcrit TYPE(Gwc_point), INTENT(IN) :: pat_ref_pt end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_nppa_text_height (selcrit, text_height) use fbindtypes TYPE(Gsel_crit) , INTENT(IN) :: selcrit TYPE(Gtext_height), INTENT(IN) :: text_height end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_nppa_text_up_vec (selcrit, text_up_vec) use fbindtypes TYPE(Gsel_crit) , INTENT(IN) :: selcrit TYPE(Gtext_up_vec), INTENT(IN) :: text_up_vec end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_nppa_text_skew (selcrit, text_skew) use fbindtypes TYPE(Gsel_crit) , INTENT(IN) :: selcrit TYPE(Gtext_skew), INTENT(IN) :: text_skew end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_nppa_text_path (selcrit, text_path) use fbindtypes TYPE(Gsel_crit) , INTENT(IN) :: selcrit TYPE(Gtext_path_id), INTENT(IN) :: text_path end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_nppa_text_align (selcrit, text_align) use fbindtypes TYPE(Gsel_crit) , INTENT(IN) :: selcrit TYPE(Gtext_align), INTENT(IN) :: text_align end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_nppa_curve_ind (selcrit, curve_ind) use fbindtypes TYPE(Gsel_crit) , INTENT(IN) :: selcrit TYPE(Gcurve_ind), INTENT(IN) :: curve_ind end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_nppa_curve_asfs (selcrit, curve_asfs) use fbindtypes TYPE(Gsel_crit) , INTENT(IN) :: selcrit TYPE(Gcurve_asfs), INTENT(IN) :: curve_asfs end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_nppa_curve_type (selcrit, curve_type) use fbindtypes TYPE(Gsel_crit) , INTENT(IN) :: selcrit TYPE(Gcurve_type), INTENT(IN) :: curve_type end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_nppa_curve_width (selcrit, curve_width) use fbindtypes TYPE(Gsel_crit) , INTENT(IN) :: selcrit TYPE(Gcurve_width), INTENT(IN) :: curve_width end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_nppa_curve_colr_spec (selcrit, curve_colr_spec) use fbindtypes TYPE(Gsel_crit) , INTENT(IN) :: selcrit TYPE(Gcurve_colr_spec), INTENT(IN) :: curve_colr_spec end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_nppa_marker_ind (selcrit, marker_ind) use fbindtypes TYPE(Gsel_crit) , INTENT(IN) :: selcrit TYPE(Gmarker_ind), INTENT(IN) :: marker_ind end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_nppa_marker_asfs (selcrit, marker_asfs) use fbindtypes TYPE(Gsel_crit) , INTENT(IN) :: selcrit TYPE(Gmarker_asfs), INTENT(IN) :: marker_asfs end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_nppa_marker_type (selcrit, marker_type) use fbindtypes TYPE(Gsel_crit) , INTENT(IN) :: selcrit TYPE(Gmarker_type), INTENT(IN) :: marker_type end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_nppa_marker_size (selcrit, marker_size) use fbindtypes TYPE(Gsel_crit) , INTENT(IN) :: selcrit TYPE(Gmarker_size), INTENT(IN) :: marker_size end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_nppa_marker_colr_spec (selcrit, marker_colr_spec) use fbindtypes TYPE(Gsel_crit) , INTENT(IN) :: selcrit TYPE(Gcolr_spec), INTENT(IN) :: marker_colr_spec end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_nppa_area_ind (selcrit, area_ind) use fbindtypes TYPE(Gsel_crit) , INTENT(IN) :: selcrit TYPE(Garea_ind), INTENT(IN) :: area_ind end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_nppa_area_asfs (selcrit, area_asfs) use fbindtypes TYPE(Gsel_crit) , INTENT(IN) :: selcrit TYPE(Garea_asfs), INTENT(IN) :: area_asfs end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_nppa_int_style (selcrit, int_style) use fbindtypes TYPE(Gsel_crit) , INTENT(IN) :: selcrit TYPE(Gint_style_id), INTENT(IN) :: int_style end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_nppa_int_style_ind (selcrit, int_style_ind) use fbindtypes TYPE(Gsel_crit) , INTENT(IN) :: selcrit TYPE(Gint_style_ind), INTENT(IN) :: int_style_ind end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_nppa_int_colr_spec (selcrit, int_colr_spec) use fbindtypes TYPE(Gsel_crit) , INTENT(IN) :: selcrit TYPE(Gint_colr_spec), INTENT(IN) :: int_colr_spec end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_nppa_edge_flag (selcrit, edge_flag) use fbindtypes TYPE(Gsel_crit) , INTENT(IN) :: selcrit TYPE(Gedge_flag_id), INTENT(IN) :: edge_flag end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_nppa_edge_type (selcrit, edge_type) use fbindtypes TYPE(Gsel_crit) , INTENT(IN) :: selcrit TYPE(Gedge_type), INTENT(IN) :: edge_type end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_nppa_edge_width (selcrit, edge_width) use fbindtypes TYPE(Gsel_crit) , INTENT(IN) :: selcrit TYPE(Gedge_width), INTENT(IN) :: edge_width end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_nppa_edge_colr_spec (selcrit, edge_colr_spec) use fbindtypes TYPE(Gsel_crit) , INTENT(IN) :: selcrit TYPE(Gedge_colr_spec), INTENT(IN) :: edge_colr_spec end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_nppa_char_ind (selcrit, char_ind) use fbindtypes TYPE(Gsel_crit) , INTENT(IN) :: selcrit TYPE(Gchar_ind), INTENT(IN) :: char_ind end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_nppa_char_asfs (selcrit, char_asfs) use fbindtypes TYPE(Gsel_crit) , INTENT(IN) :: selcrit TYPE(Gchar_asfs), INTENT(IN) :: char_asfs end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_nppa_char_font_prec (selcrit, char_font_prec) use fbindtypes TYPE(Gsel_crit) , INTENT(IN) :: selcrit TYPE(Gfont_prec), INTENT(IN) :: char_font_prec end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_nppa_char_expan (selcrit, char_expan) use fbindtypes TYPE(Gsel_crit) , INTENT(IN) :: selcrit TYPE(Gchar_expan), INTENT(IN) :: char_expan end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_nppa_char_space (selcrit, char_space) use fbindtypes TYPE(Gsel_crit) , INTENT(IN) :: selcrit TYPE(Gchar_space), INTENT(IN) :: char_space end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_nppa_char_colr_spec (selcrit, char_colr_spec) use fbindtypes TYPE(Gsel_crit) , INTENT(IN) :: selcrit TYPE(Gchar_colr_spec), INTENT(IN) :: char_colr_spec end subroutine !----------------------------------------------------------------------------- END INTERFACE !################################################### INTERFACE gset_rep SUBROUTINE gset_rep_curv_bun ( wsid, rep_ind, curv_bun) use fbindtypes INTEGER, INTENT(IN) :: wsid INTEGER, INTENT(IN) :: rep_ind TYPE(Gcurve_bun), INTENT(IN) :: curv_bun end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_rep_mark_bun ( wsid, rep_ind, mark_bun) use fbindtypes INTEGER, INTENT(IN) :: wsid INTEGER, INTENT(IN) :: rep_ind TYPE(Gmarker_bun), INTENT(IN) :: mark_bun end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_rep_area_bun ( wsid, rep_ind, area_bun) use fbindtypes INTEGER, INTENT(IN) :: wsid INTEGER, INTENT(IN) :: rep_ind TYPE(Garea_bun), INTENT(IN) :: area_bun end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_rep_char_bun ( wsid, rep_ind, char_bun) use fbindtypes INTEGER, INTENT(IN) :: wsid INTEGER, INTENT(IN) :: rep_ind TYPE(Gchar_bun), INTENT(IN) :: char_bun end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_rep_patt_array ( wsid, rep_ind, patt_array) use fbindtypes INTEGER, INTENT(IN) :: wsid INTEGER, INTENT(IN) :: rep_ind TYPE(Gcolr_array_spec), INTENT(IN) :: patt_array end subroutine !----------------------------------------------------------------------------- SUBROUTINE gset_rep_colr ( wsid, rep_ind, colr) use fbindtypes INTEGER, INTENT(IN) :: wsid INTEGER, INTENT(IN) :: rep_ind TYPE(Gcolr_coord), INTENT(IN) :: colr end subroutine !----------------------------------------------------------------------------- END INTERFACE !################################################### end module fbindsubs