MODULE Network_Graphics USE Precision USE DISLIN USE Simple_Graphics,ONLY:r_sg IMPLICIT NONE PUBLIC::InitNetworkGraphics,EndNetworkGraphics,PlotNetwork2D,PlotNetwork3D PRIVATE LOGICAL,SAVE::new_network_plot,vertical_bar INTEGER,SAVE::page_length,page_width,axis_length,axis_width,n_ticks,n_digits CHARACTER(LEN=10),SAVE::color_pallete CONTAINS SUBROUTINE InitNetworkGraphics(file,file_type,page_size,plot_title,x_label,y_label,label_format,axis_labels_format,color_tab& &le,colorbar_position,my_func) CHARACTER(LEN=*),OPTIONAL,INTENT(IN)::file,file_type INTEGER,DIMENSION(2),INTENT(IN),OPTIONAL::page_size CHARACTER(LEN=*),DIMENSION(:),OPTIONAL,INTENT(IN)::plot_title CHARACTER(LEN=*),OPTIONAL,INTENT(IN)::x_label,y_label CHARACTER(LEN=3),OPTIONAL,INTENT(IN)::label_format CHARACTER(LEN=*),DIMENSION(4),INTENT(IN),OPTIONAL::axis_labels_format CHARACTER(LEN=*),INTENT(IN),OPTIONAL::color_table CHARACTER(LEN=*),INTENT(IN),OPTIONAL::colorbar_position OPTIONAL::my_func INTERFACE SUBROUTINE my_func(level) INTEGER,INTENT(IN)::level END SUBROUTINE my_func END INTERFACE INTEGER::title_line new_network_plot=.TRUE. n_digits=1 n_ticks=5 IF(PRESENT(file))CALL SETFIL(file) IF(PRESENT(file_type))THEN CALL METAFL(file_type) ELSE CALL METAFL("CONS") END IF IF(PRESENT(page_size))THEN page_length=page_size(1) page_width=page_size(2) CALL PAGE(page_length,page_width) ELSE page_length=300*11 page_width=300*8.5 CALL PAGE(page_length,page_width) END IF CALL SCRMOD("REVERS") IF(PRESENT(my_func))CALL my_func(0) CALL DISINI CALL WINKEY("ESCAPE") CALL CENTER CALL PAGERA CALL COMPLX CALL NOCHEK CALL TEXMOD("ON") CALL FRAME(0) CALL TXTJUS("CENT") CALL NUMFMT("FLOAT") CALL SHDPAT(16) CALL NOARLN CALL HNAME(page_width/50) IF(PRESENT(x_label))CALL NAME(x_label,'X') IF(PRESENT(y_label))CALL NAME(y_label,'Y') CALL HEIGHT(page_width/50) IF(PRESENT(plot_title))THEN DO title_line=1,SIZE(plot_title) CALL TITLIN(plot_title(title_line),title_line) END DO END IF IF(PRESENT(label_format))THEN n_ticks=MAX(1,MIN(IACHAR(label_format(1:1))-48,9)) n_digits=MAX(0,MIN(IACHAR(label_format(3:3))-48,9)) CALL LABDIG(n_digits,"XYZ") SELECT CASE(label_format(2:2)) CASE('D') CALL LABELS("EXP","XYZ") CASE('E') CALL LABELS("FEXP","XYZ") CASE('F') CALL LABELS("FLOAT","XYZ") CASE DEFAULT CALL LABELS("NONE","XYZ") ENDSELECT ELSE CALL LABDIG(n_digits,"XYZ") CALL LABELS("NONE","XYZ") END IF axis_length=(2*page_length)/3 axis_width=(2*page_width)/3 CALL AXSPOS(page_length/6,(5*page_width)/6) CALL AXSLEN(axis_length,axis_width) IF(PRESENT(axis_labels_format))THEN CALL SETGRF(axis_labels_format(1),axis_labels_format(2),& axis_labels_format(3),axis_labels_format(4)) ELSE CALL SETGRF("LINE","LINE","LINE","LINE") END IF IF(PRESENT(color_table))THEN color_pallete=color_table ELSE color_pallete="RAIN" END IF IF(PRESENT(colorbar_position))THEN IF(colorbar_position(1:1)=='H'.OR.colorbar_position(1:1)=='h')THEN vertical_bar=.FALSE. ELSE vertical_bar=.TRUE. END IF ELSE vertical_bar=.TRUE. END IF IF(PRESENT(my_func))CALL my_func(1) END SUBROUTINE SUBROUTINE EndNetworkGraphics(my_func) OPTIONAL::my_func INTERFACE SUBROUTINE my_func(level) INTEGER,INTENT(IN)::level END SUBROUTINE my_func END INTERFACE IF(PRESENT(my_func))CALL my_func(-1) CALL DISFIN END SUBROUTINE EndNetworkGraphics SUBROUTINE PlotNetwork2D(heads_tails,node_offset,node_coords,arc_mask,node_mask,node_values,node_labels,arc_values,arc_label& &s,number_arcs,number_nodes,color_nodes,resize_nodes,color_arcs,resize_arcs,arc_size_range,arc_color_range,node_size_range,no& &de_color_range,node_colorbar_format,arc_colorbar_format,vector_type,axis,my_func) IMPLICIT NONE INTEGER,DIMENSION(:,:),INTENT(IN)::heads_tails INTEGER,INTENT(IN)::node_offset REAL(KIND=r_sg),DIMENSION(:,-node_offset:),INTENT(IN)::node_coords LOGICAL(KIND=l_wp),DIMENSION(-node_offset:),INTENT(IN),OPTIONAL::node_mask LOGICAL(KIND=l_wp),DIMENSION(:),INTENT(IN),OPTIONAL::arc_mask REAL(KIND=r_wp),DIMENSION(-node_offset:),INTENT(IN),OPTIONAL::node_values REAL(KIND=r_wp),DIMENSION(:),INTENT(IN),OPTIONAL::arc_values INTEGER,DIMENSION(-node_offset:),INTENT(IN),OPTIONAL::node_labels INTEGER,DIMENSION(:),INTENT(IN),OPTIONAL::arc_labels LOGICAL,INTENT(IN),OPTIONAL::number_nodes,number_arcs LOGICAL,INTENT(IN),OPTIONAL::color_nodes,resize_nodes,& color_arcs,resize_arcs REAL(KIND=r_wp),DIMENSION(2),INTENT(IN),OPTIONAL::arc_color_range,node_color_range,& arc_size_range,node_size_range CHARACTER(LEN=3),OPTIONAL,INTENT(IN)::node_colorbar_format,arc_colorbar_format INTEGER,INTENT(IN),OPTIONAL::vector_type REAL(KIND=r_sg),DIMENSION(2*2),INTENT(IN),OPTIONAL::axis OPTIONAL::my_func INTERFACE SUBROUTINE my_func(level) INTEGER,INTENT(IN)::level END SUBROUTINE my_func END INTERFACE INTEGER::n_nodes,n_nodes_lb,n_nodes_ub,n_arcs,node,arc,head,tail REAL(KIND=r_sg),DIMENSION(2,2)::axis_ranges REAL(KIND=r_sg),DIMENSION(2)::axis_lengths REAL(KIND=r_wp),DIMENSION(2)::node_cr,node_sr REAL(KIND=r_wp)::node_ac,node_bc,& node_as,node_bs INTEGER::node_color,node_size REAL(KIND=r_wp),DIMENSION(2)::arc_cr,arc_sr REAL(KIND=r_wp)::arc_ac,arc_bc,& arc_as,arc_bs INTEGER::arc_color,arc_size INTEGER::x,y,z INTEGER::x1,y1,z1,x2,y2,z2 INTEGER::max_node_size,max_arc_size INTEGER::node_bar_x_corner,node_bar_y_corner,arc_bar_x_corner,arc_bar_y_corner INTEGER::node_bar_length,arc_bar_length LOGICAL::node_coloring,node_resizing,arc_coloring,arc_resizing LOGICAL::node_labeling,arc_labeling LOGICAL::node_numbering,arc_numbering LOGICAL::node_masking,arc_masking INTEGER::vector_spec,bar_position n_nodes=SIZE(node_coords,DIM=2) n_nodes_lb=LBOUND(node_coords,DIM=2) n_nodes_ub=UBOUND(node_coords,DIM=2) n_arcs=SIZE(heads_tails,DIM=2) IF(new_network_plot)THEN IF(.NOT.PRESENT(axis))THEN axis_ranges(:,1)=MINVAL(node_coords,DIM=2) axis_ranges(:,2)=MAXVAL(node_coords,DIM=2) axis_lengths=axis_ranges(:,2)-axis_ranges(:,1) ELSE axis_ranges=RESHAPE(axis,SHAPE=(/2,2/)) axis_lengths=axis_ranges(:,2)-axis_ranges(:,1) END IF CALL GRAF(axis_ranges(1,1),axis_ranges(1,2),axis_ranges(1,1),axis_lengths(1)/REAL(n_ticks),axis_ranges(2,1),axis_ranges(2,2)& &,axis_ranges(2,1),axis_lengths(2)/REAL(n_ticks)) CALL TITLE new_network_plot=.FALSE. END IF IF(PRESENT(my_func))CALL my_func(2) max_node_size=MAX(2,INT((MIN(page_length,page_width)/2)/SQRT(REAL(n_nodes)))) CALL SETVLT(color_pallete) CALL COLOR("FORE") IF(PRESENT(node_values))THEN IF(PRESENT(node_color_range))THEN node_cr=node_color_range ELSE node_cr(1)=MINVAL(node_values) node_cr(2)=MAXVAL(node_values) END IF IF(PRESENT(node_size_range))THEN node_sr=node_size_range ELSE node_sr(1)=MINVAL(node_values) node_sr(2)=MAXVAL(node_values) END IF node_ac=255_r_wp/& (node_cr(2)-node_cr(1)+EPSILON(0.0_r_wp)) node_bc=-node_ac*node_cr(1) node_as=REAL(max_node_size,r_wp)/& (node_sr(2)-node_sr(1)+EPSILON(0.0_r_wp)) node_bs=-node_as*node_sr(1) END IF IF(PRESENT(number_nodes))THEN node_numbering=number_nodes ELSE node_numbering=.FALSE. END IF IF(PRESENT(node_labels).OR.node_numbering)THEN node_labeling=.TRUE. ELSE node_labeling=.FALSE. END IF IF(PRESENT(node_mask))THEN node_masking=.TRUE. ELSE node_masking=.FALSE. END IF node_size=1 IF(PRESENT(node_values))THEN IF(PRESENT(color_nodes))THEN node_coloring=color_nodes ELSE node_coloring=.TRUE. END IF IF(PRESENT(resize_nodes))THEN node_resizing=resize_nodes ELSE node_resizing=.TRUE. END IF IF(node_coloring)THEN IF(PRESENT(node_colorbar_format))THEN n_ticks=MAX(1,MIN(IACHAR(node_colorbar_format(1:1))-48,9)) n_digits=MAX(0,MIN(IACHAR(node_colorbar_format(3:3))-48,9)) CALL LABDIG(n_digits,"XYZ") SELECT CASE(node_colorbar_format(2:2)) CASE('D') CALL LABELS("EXP","XYZ") CASE('E') CALL LABELS("FEXP","XYZ") CASE('F') CALL LABELS("FLOAT","XYZ") CASE DEFAULT CALL LABELS("NONE","XYZ") ENDSELECT END IF IF(vertical_bar)THEN CALL WIDBAR(page_length/40) node_bar_y_corner=(5*page_width)/6 node_bar_x_corner=(31*page_length)/240 node_bar_length=(2*page_width)/3 bar_position=0 ELSE CALL WIDBAR(page_width/40) node_bar_x_corner=page_length/6 node_bar_y_corner=(37*page_width)/240 node_bar_length=(2*page_length)/3 bar_position=1 END IF CALL LINWID(1) CALL COLOR("FORE") CALL ZAXIS(REAL(node_cr(1),r_sg),REAL(node_cr(2),r_sg),& REAL(node_cr(1),r_sg),& REAL(ABS(node_cr(2)-node_cr(1))/n_ticks,r_sg),& node_bar_length,"",1,bar_position,& node_bar_x_corner,node_bar_y_corner) END IF PlotNodesWithValues:DO node=n_nodes_lb,n_nodes_ub IF(node_masking)THEN IF(.NOT.node_mask(node))CYCLE PlotNodesWithValues END IF x=NXPOSN(node_coords(1,node)) y=NYPOSN(node_coords(2,node)) IF(node_coloring)THEN node_color=MAX(1,& MIN(INT(node_ac*node_values(node)+node_bc),254)) CALL SETCLR(node_color) END IF IF(node_resizing)THEN node_size=MAX(1,MIN(INT(node_as*node_values(node)+node_bs),max_node_size)) END IF CALL CIRCLE(x,y,node_size) IF(node_labeling)THEN IF(node_numbering)THEN CALL COLOR("FORE") CALL NUMBER(REAL(node,r_sg),-1,x,y) ELSE CALL COLOR("FORE") CALL NUMBER(REAL(node_labels(node),r_sg),-1,x,y) END IF END IF END DO PlotNodesWithValues ELSE PlotNodesWithoutValues:DO node=n_nodes_lb,n_nodes_ub IF(node_masking)THEN IF(.NOT.node_mask(node))CYCLE PlotNodesWithoutValues END IF x=NXPOSN(node_coords(1,node)) y=NYPOSN(node_coords(2,node)) CALL CIRCLE(x,y,node_size) IF(node_labeling)THEN IF(node_numbering)THEN CALL COLOR("FORE") CALL NUMBER(REAL(node,r_sg),-1,x,y) ELSE CALL COLOR("FORE") CALL NUMBER(REAL(node_labels(node),r_sg),-1,x,y) END IF END IF END DO PlotNodesWithoutValues END IF max_arc_size=max_node_size/2 CALL SETVLT(color_pallete) CALL COLOR("FORE") IF(PRESENT(arc_values))THEN IF(PRESENT(arc_color_range))THEN arc_cr=arc_color_range ELSE arc_cr(1)=MINVAL(arc_values) arc_cr(2)=MAXVAL(arc_values) END IF IF(PRESENT(arc_size_range))THEN arc_sr=arc_size_range ELSE arc_sr(1)=MINVAL(arc_values) arc_sr(2)=MAXVAL(arc_values) END IF arc_ac=255_r_wp/& (arc_cr(2)-arc_cr(1)+EPSILON(0.0_r_wp)) arc_bc=-arc_ac*arc_cr(1) arc_as=REAL(max_arc_size,r_wp)/& (arc_sr(2)-arc_sr(1)+EPSILON(0.0_r_wp)) arc_bs=-arc_as*arc_sr(1) END IF IF(PRESENT(vector_type))THEN vector_spec=vector_type ELSE vector_spec=1421 END IF IF(PRESENT(number_arcs))THEN arc_numbering=number_arcs ELSE arc_numbering=.FALSE. END IF IF(PRESENT(arc_labels).OR.arc_numbering)THEN arc_labeling=.TRUE. ELSE arc_labeling=.FALSE. END IF IF(PRESENT(arc_mask))THEN arc_masking=.TRUE. ELSE arc_masking=.FALSE. END IF arc_size=1 IF(PRESENT(arc_values))THEN IF(PRESENT(color_arcs))THEN arc_coloring=color_arcs ELSE arc_coloring=.TRUE. END IF IF(PRESENT(resize_arcs))THEN arc_resizing=resize_arcs ELSE arc_resizing=.TRUE. END IF IF(arc_coloring)THEN IF(PRESENT(arc_colorbar_format))THEN n_ticks=MAX(1,MIN(IACHAR(arc_colorbar_format(1:1))-48,9)) n_digits=MAX(0,MIN(IACHAR(arc_colorbar_format(3:3))-48,9)) CALL LABDIG(n_digits,"XYZ") SELECT CASE(arc_colorbar_format(2:2)) CASE('D') CALL LABELS("EXP","XYZ") CASE('E') CALL LABELS("FEXP","XYZ") CASE('F') CALL LABELS("FLOAT","XYZ") CASE DEFAULT CALL LABELS("NONE","XYZ") ENDSELECT END IF IF(vertical_bar)THEN CALL WIDBAR(page_length/40) arc_bar_y_corner=(5*page_width)/6 arc_bar_x_corner=(203*page_length)/240 arc_bar_length=(2*page_width)/3 bar_position=0 ELSE CALL WIDBAR(page_width/40) arc_bar_x_corner=page_length/6 arc_bar_y_corner=(209*page_width)/240 arc_bar_length=(2*page_length)/3 bar_position=1 END IF CALL LINWID(1) CALL COLOR("FORE") CALL ZAXIS(REAL(arc_cr(1),r_sg),REAL(arc_cr(2),r_sg),& REAL(arc_cr(1),r_sg),& REAL(ABS(arc_cr(2)-arc_cr(1))/n_ticks,r_sg),& arc_bar_length,"",0,bar_position,& arc_bar_x_corner,arc_bar_y_corner) END IF PlotArcsWithValues:DO arc=1,n_arcs IF(arc_masking)THEN IF(.NOT.arc_mask(arc))CYCLE PlotArcsWithValues END IF x1=NXPOSN(node_coords(1,heads_tails(1,arc))) y1=NYPOSN(node_coords(2,heads_tails(1,arc))) x2=NXPOSN(node_coords(1,heads_tails(2,arc))) y2=NYPOSN(node_coords(2,heads_tails(2,arc))) IF(arc_coloring)THEN arc_color=MAX(1,& MIN(INT(arc_ac*arc_values(arc)+arc_bc),254)) CALL SETCLR(arc_color) END IF IF(arc_resizing)THEN arc_size=MAX(1,MIN(INT(arc_as*arc_values(arc)+arc_bs),max_arc_size)) END IF CALL LINWID(arc_size) CALL VECTOR(x1,y1,x2,y2,vector_spec) IF(arc_labeling)THEN IF(arc_numbering)THEN CALL COLOR("FORE") CALL LINWID(2) CALL NUMBER(REAL(arc,r_sg),-1,(x1+x2)/2,(y1+y2)/2) ELSE CALL COLOR("FORE") CALL LINWID(2) CALL NUMBER(REAL(arc_labels(arc),r_sg),-1,(x1+x2)/2,(y1+y2)/2) END IF END IF END DO PlotArcsWithValues ELSE PlotArcsWithoutValues:DO arc=1,n_arcs IF(arc_masking)THEN IF(.NOT.arc_mask(arc))CYCLE PlotArcsWithoutValues END IF x1=NXPOSN(node_coords(1,heads_tails(1,arc))) y1=NYPOSN(node_coords(2,heads_tails(1,arc))) x2=NXPOSN(node_coords(1,heads_tails(2,arc))) y2=NYPOSN(node_coords(2,heads_tails(2,arc))) CALL VECTOR(x1,y1,x2,y2,vector_spec) IF(arc_labeling)THEN IF(arc_numbering)THEN CALL COLOR("FORE") CALL LINWID(2) CALL NUMBER(REAL(arc,r_sg),-1,(x1+x2)/2,(y1+y2)/2) ELSE CALL COLOR("FORE") CALL LINWID(2) CALL NUMBER(REAL(arc_labels(arc),r_sg),-1,(x1+x2)/2,(y1+y2)/2) END IF END IF END DO PlotArcsWithoutValues END IF END SUBROUTINE SUBROUTINE PlotNetwork3D(heads_tails,node_offset,node_coords,arc_mask,node_mask,node_values,node_labels,arc_values,arc_label& &s,number_arcs,number_nodes,color_nodes,resize_nodes,color_arcs,resize_arcs,arc_size_range,arc_color_range,node_size_range,no& &de_color_range,node_colorbar_format,arc_colorbar_format,vector_type,axis,my_func) IMPLICIT NONE INTEGER,DIMENSION(:,:),INTENT(IN)::heads_tails INTEGER,INTENT(IN)::node_offset REAL(KIND=r_sg),DIMENSION(:,-node_offset:),INTENT(IN)::node_coords LOGICAL(KIND=l_wp),DIMENSION(-node_offset:),INTENT(IN),OPTIONAL::node_mask LOGICAL(KIND=l_wp),DIMENSION(:),INTENT(IN),OPTIONAL::arc_mask REAL(KIND=r_wp),DIMENSION(-node_offset:),INTENT(IN),OPTIONAL::node_values REAL(KIND=r_wp),DIMENSION(:),INTENT(IN),OPTIONAL::arc_values INTEGER,DIMENSION(-node_offset:),INTENT(IN),OPTIONAL::node_labels INTEGER,DIMENSION(:),INTENT(IN),OPTIONAL::arc_labels LOGICAL,INTENT(IN),OPTIONAL::number_nodes,number_arcs LOGICAL,INTENT(IN),OPTIONAL::color_nodes,resize_nodes,& color_arcs,resize_arcs REAL(KIND=r_wp),DIMENSION(2),INTENT(IN),OPTIONAL::arc_color_range,node_color_range,& arc_size_range,node_size_range CHARACTER(LEN=3),OPTIONAL,INTENT(IN)::node_colorbar_format,arc_colorbar_format INTEGER,INTENT(IN),OPTIONAL::vector_type REAL(KIND=r_sg),DIMENSION(3*2),INTENT(IN),OPTIONAL::axis OPTIONAL::my_func INTERFACE SUBROUTINE my_func(level) INTEGER,INTENT(IN)::level END SUBROUTINE my_func END INTERFACE INTEGER::n_nodes,n_nodes_lb,n_nodes_ub,n_arcs,node,arc,head,tail REAL(KIND=r_sg),DIMENSION(3,2)::axis_ranges REAL(KIND=r_sg),DIMENSION(3)::axis_lengths REAL(KIND=r_wp),DIMENSION(2)::node_cr,node_sr REAL(KIND=r_wp)::node_ac,node_bc,& node_as,node_bs INTEGER::node_color,node_size REAL(KIND=r_wp),DIMENSION(2)::arc_cr,arc_sr REAL(KIND=r_wp)::arc_ac,arc_bc,& arc_as,arc_bs INTEGER::arc_color,arc_size REAL(KIND=r_sg)::x,y,z REAL(KIND=r_sg)::x1,y1,z1,x2,y2,z2 INTEGER::max_node_size,max_arc_size INTEGER::node_bar_x_corner,node_bar_y_corner,arc_bar_x_corner,arc_bar_y_corner INTEGER::node_bar_length,arc_bar_length LOGICAL::node_coloring,node_resizing,arc_coloring,arc_resizing LOGICAL::node_labeling,arc_labeling LOGICAL::node_numbering,arc_numbering LOGICAL::node_masking,arc_masking INTEGER::vector_spec,bar_position n_nodes=SIZE(node_coords,DIM=2) n_nodes_lb=LBOUND(node_coords,DIM=2) n_nodes_ub=UBOUND(node_coords,DIM=2) n_arcs=SIZE(heads_tails,DIM=2) IF(new_network_plot)THEN IF(.NOT.PRESENT(axis))THEN axis_ranges(:,1)=MINVAL(node_coords,DIM=2) axis_ranges(:,2)=MAXVAL(node_coords,DIM=2) axis_lengths=axis_ranges(:,2)-axis_ranges(:,1) ELSE axis_ranges=RESHAPE(axis,SHAPE=(/3,2/)) axis_lengths=axis_ranges(:,2)-axis_ranges(:,1) END IF CALL GRAF3D(axis_ranges(1,1),axis_ranges(1,2),axis_ranges(1,1),axis_lengths(1)/REAL(n_ticks),axis_ranges(2,1),axis_ranges(2,& &2),axis_ranges(2,1),axis_lengths(2)/REAL(n_ticks),axis_ranges(3,1),axis_ranges(3,2),axis_ranges(3,1),axis_lengths(3)/REAL(n_& &ticks)) CALL TITLE new_network_plot=.FALSE. END IF IF(PRESENT(my_func))CALL my_func(2) max_node_size=MAX(2,INT((MIN(page_length,page_width)/2)/SQRT(REAL(n_nodes)))) CALL SETVLT(color_pallete) CALL COLOR("FORE") IF(PRESENT(node_values))THEN IF(PRESENT(node_color_range))THEN node_cr=node_color_range ELSE node_cr(1)=MINVAL(node_values) node_cr(2)=MAXVAL(node_values) END IF IF(PRESENT(node_size_range))THEN node_sr=node_size_range ELSE node_sr(1)=MINVAL(node_values) node_sr(2)=MAXVAL(node_values) END IF node_ac=255_r_wp/& (node_cr(2)-node_cr(1)+EPSILON(0.0_r_wp)) node_bc=-node_ac*node_cr(1) node_as=REAL(max_node_size,r_wp)/& (node_sr(2)-node_sr(1)+EPSILON(0.0_r_wp)) node_bs=-node_as*node_sr(1) END IF IF(PRESENT(number_nodes))THEN node_numbering=number_nodes ELSE node_numbering=.FALSE. END IF IF(PRESENT(node_labels).OR.node_numbering)THEN node_labeling=.TRUE. ELSE node_labeling=.FALSE. END IF IF(PRESENT(node_mask))THEN node_masking=.TRUE. ELSE node_masking=.FALSE. END IF node_size=1 IF(PRESENT(node_values))THEN IF(PRESENT(color_nodes))THEN node_coloring=color_nodes ELSE node_coloring=.TRUE. END IF IF(PRESENT(resize_nodes))THEN node_resizing=resize_nodes ELSE node_resizing=.TRUE. END IF IF(node_coloring)THEN IF(PRESENT(node_colorbar_format))THEN n_ticks=MAX(1,MIN(IACHAR(node_colorbar_format(1:1))-48,9)) n_digits=MAX(0,MIN(IACHAR(node_colorbar_format(3:3))-48,9)) CALL LABDIG(n_digits,"XYZ") SELECT CASE(node_colorbar_format(2:2)) CASE('D') CALL LABELS("EXP","XYZ") CASE('E') CALL LABELS("FEXP","XYZ") CASE('F') CALL LABELS("FLOAT","XYZ") CASE DEFAULT CALL LABELS("NONE","XYZ") ENDSELECT END IF IF(vertical_bar)THEN CALL WIDBAR(page_length/40) node_bar_y_corner=(5*page_width)/6 node_bar_x_corner=(31*page_length)/240 node_bar_length=(2*page_width)/3 bar_position=0 ELSE CALL WIDBAR(page_width/40) node_bar_x_corner=page_length/6 node_bar_y_corner=(37*page_width)/240 node_bar_length=(2*page_length)/3 bar_position=1 END IF CALL LINWID(1) CALL COLOR("FORE") CALL ZAXIS(REAL(node_cr(1),r_sg),REAL(node_cr(2),r_sg),& REAL(node_cr(1),r_sg),& REAL(ABS(node_cr(2)-node_cr(1))/n_ticks,r_sg),& node_bar_length,"",1,bar_position,& node_bar_x_corner,node_bar_y_corner) END IF PlotNodesWithValues:DO node=n_nodes_lb,n_nodes_ub IF(node_masking)THEN IF(.NOT.node_mask(node))CYCLE PlotNodesWithValues END IF CALL REL3PT(node_coords(1,node),node_coords(2,node),node_coords(3,node),x,y) IF(node_coloring)THEN node_color=MAX(1,& MIN(INT(node_ac*node_values(node)+node_bc),254)) CALL SETCLR(node_color) END IF IF(node_resizing)THEN node_size=MAX(1,MIN(INT(node_as*node_values(node)+node_bs),max_node_size)) END IF CALL HSYMBL(INT(node_size)) CALL SYMBOL(21,INT(x),INT(y)) IF(node_labeling)THEN IF(node_numbering)THEN ELSE END IF END IF END DO PlotNodesWithValues ELSE PlotNodesWithoutValues:DO node=n_nodes_lb,n_nodes_ub IF(node_masking)THEN IF(.NOT.node_mask(node))CYCLE PlotNodesWithoutValues END IF CALL REL3PT(node_coords(1,node),node_coords(2,node),node_coords(3,node),x,y) CALL HSYMBL(INT(node_size)) CALL SYMBOL(21,INT(x),INT(y)) IF(node_labeling)THEN IF(node_numbering)THEN ELSE END IF END IF END DO PlotNodesWithoutValues END IF max_arc_size=max_node_size/2 CALL SETVLT(color_pallete) CALL COLOR("FORE") IF(PRESENT(arc_values))THEN IF(PRESENT(arc_color_range))THEN arc_cr=arc_color_range ELSE arc_cr(1)=MINVAL(arc_values) arc_cr(2)=MAXVAL(arc_values) END IF IF(PRESENT(arc_size_range))THEN arc_sr=arc_size_range ELSE arc_sr(1)=MINVAL(arc_values) arc_sr(2)=MAXVAL(arc_values) END IF arc_ac=255_r_wp/& (arc_cr(2)-arc_cr(1)+EPSILON(0.0_r_wp)) arc_bc=-arc_ac*arc_cr(1) arc_as=REAL(max_arc_size,r_wp)/& (arc_sr(2)-arc_sr(1)+EPSILON(0.0_r_wp)) arc_bs=-arc_as*arc_sr(1) END IF IF(PRESENT(vector_type))THEN vector_spec=vector_type ELSE vector_spec=1421 END IF IF(PRESENT(number_arcs))THEN arc_numbering=number_arcs ELSE arc_numbering=.FALSE. END IF IF(PRESENT(arc_labels).OR.arc_numbering)THEN arc_labeling=.TRUE. ELSE arc_labeling=.FALSE. END IF IF(PRESENT(arc_mask))THEN arc_masking=.TRUE. ELSE arc_masking=.FALSE. END IF arc_size=1 IF(PRESENT(arc_values))THEN IF(PRESENT(color_arcs))THEN arc_coloring=color_arcs ELSE arc_coloring=.TRUE. END IF IF(PRESENT(resize_arcs))THEN arc_resizing=resize_arcs ELSE arc_resizing=.TRUE. END IF IF(arc_coloring)THEN IF(PRESENT(arc_colorbar_format))THEN n_ticks=MAX(1,MIN(IACHAR(arc_colorbar_format(1:1))-48,9)) n_digits=MAX(0,MIN(IACHAR(arc_colorbar_format(3:3))-48,9)) CALL LABDIG(n_digits,"XYZ") SELECT CASE(arc_colorbar_format(2:2)) CASE('D') CALL LABELS("EXP","XYZ") CASE('E') CALL LABELS("FEXP","XYZ") CASE('F') CALL LABELS("FLOAT","XYZ") CASE DEFAULT CALL LABELS("NONE","XYZ") ENDSELECT END IF IF(vertical_bar)THEN CALL WIDBAR(page_length/40) arc_bar_y_corner=(5*page_width)/6 arc_bar_x_corner=(203*page_length)/240 arc_bar_length=(2*page_width)/3 bar_position=0 ELSE CALL WIDBAR(page_width/40) arc_bar_x_corner=page_length/6 arc_bar_y_corner=(209*page_width)/240 arc_bar_length=(2*page_length)/3 bar_position=1 END IF CALL LINWID(1) CALL COLOR("FORE") CALL ZAXIS(REAL(arc_cr(1),r_sg),REAL(arc_cr(2),r_sg),& REAL(arc_cr(1),r_sg),& REAL(ABS(arc_cr(2)-arc_cr(1))/n_ticks,r_sg),& arc_bar_length,"",0,bar_position,& arc_bar_x_corner,arc_bar_y_corner) END IF PlotArcsWithValues:DO arc=1,n_arcs IF(arc_masking)THEN IF(.NOT.arc_mask(arc))CYCLE PlotArcsWithValues END IF CALL POS3PT(node_coords(1,heads_tails(1,arc)),node_coords(2,heads_tails(1,arc)),node_coords(3,heads_tails(1,arc)),x1,y1,z1) CALL POS3PT(node_coords(1,heads_tails(2,arc)),node_coords(2,heads_tails(2,arc)),node_coords(3,heads_tails(2,arc)),x2,y2,z2) IF(arc_coloring)THEN arc_color=MAX(1,& MIN(INT(arc_ac*arc_values(arc)+arc_bc),254)) CALL SETCLR(arc_color) END IF IF(arc_resizing)THEN arc_size=MAX(1,MIN(INT(arc_as*arc_values(arc)+arc_bs),max_arc_size)) END IF CALL LINWID(arc_size) CALL VECTR3(x1,y1,z1,x2,y2,z2,vector_spec) IF(arc_labeling)THEN IF(arc_numbering)THEN ELSE END IF END IF END DO PlotArcsWithValues ELSE PlotArcsWithoutValues:DO arc=1,n_arcs IF(arc_masking)THEN IF(.NOT.arc_mask(arc))CYCLE PlotArcsWithoutValues END IF CALL POS3PT(node_coords(1,heads_tails(1,arc)),node_coords(2,heads_tails(1,arc)),node_coords(3,heads_tails(1,arc)),x1,y1,z1) CALL POS3PT(node_coords(1,heads_tails(2,arc)),node_coords(2,heads_tails(2,arc)),node_coords(3,heads_tails(2,arc)),x2,y2,z2) CALL VECTR3(x1,y1,z1,x2,y2,z2,vector_spec) IF(arc_labeling)THEN IF(arc_numbering)THEN ELSE END IF END IF END DO PlotArcsWithoutValues END IF END SUBROUTINE END MODULE Network_Graphics