PROGRAM IV_SSCNO USE Precision USE Error_Handling USE System_Monitors USE Initialization_Termination USE Network_Data_Structures USE Lattice_Geometry USE Network_Geometry USE Simple_Graphics USE Network_Graphics USE Network_Spanning_Trees USE jj_i_Cost_Parameters USE jj_i_Cost_Functions USE Lattice_Network_Optimization USE Conjugate_Gradient USE Dual_Network_Solvers USE Dual_Line_Minimizers USE Dual_Newton_SSCNO USE SSCNO_Interface IMPLICIT NONE INTEGER::arc,node,sample,point,instance CHARACTER(LEN=60)::title,plot_title(3)="" CHARACTER(LEN=10)::file_type,file_extension REAL(KIND=r_wp)::applied_voltages_sum REAL(KIND=r_wp),DIMENSION(2)::current_interval=(/0.0_r_wp,1.0_r_wp/),voltage_interval=(/0.0_r_wp,1.0_r_wp/) INTEGER::n_samples=1,n_points=20,n_instances=1 INTEGER::source_type REAL(KIND=r_wp),DIMENSION(4)::axis REAL(KIND=r_wp),DIMENSION(:),ALLOCATABLE::total_currents,total_voltages,& averaged_currents,averaged_voltages REAL(KIND=r_wp),DIMENSION(:,:),ALLOCATABLE::applied_voltages,injected_currents LOGICAL::plot_samples,change_current,change_voltage CALL StartProgram CALL InitializeLatticeNetworkProblem CALL InitializeSSCNO WRITE(*,*)"Enter change_current and change_voltage (T or F)" READ(*,*)change_current,change_voltage IF(change_current)THEN WRITE(*,*)"Enter the interval for the total injected current:" READ(*,*)current_interval END IF IF(change_voltage)THEN WRITE(*,*)"Enter the interval for the total applied voltage:" READ(*,*)voltage_interval END IF WRITE(*,*)"Enter n_samples, n_instances, n_points" READ(*,*)n_samples,n_instances,n_points ALLOCATE(total_currents(n_points),total_voltages(n_points)) ALLOCATE(averaged_currents(n_points),averaged_voltages(n_points)) ALLOCATE(applied_voltages(n_points,n_samples),injected_currents(n_points,n_samples)) WRITE(*,*)"Plot every sample (T or F):" READ(*,*)plot_samples WRITE(*,*)"Enter file output type (CONS, XWIN, PNG, POST, PSCL)" READ(*,*)file_type SELECT CASE(file_type) CASE("POST","PSCL") file_extension="ps" CASE("PNG") file_extension="png" CASE DEFAULT file_extension=".dummy" ENDSELECT CALL ResetTimer(100) CALL StartTimer(100) DO point=1,n_points total_currents(point)=current_interval(1)+& REAL(point-1)*(current_interval(2)-current_interval(1))/REAL(n_points-1) total_voltages(point)=voltage_interval(1)+& REAL(point-1)*(voltage_interval(2)-voltage_interval(1))/REAL(n_points-1) END DO injected_currents=0.0_r_wp applied_voltages=0.0_r_wp SourceType:DO source_type=1,2 IF(source_type==1.AND.(.NOT.change_current))CYCLE SourceType IF(source_type==2.AND.(.NOT.change_voltage))CYCLE SourceType SampleLoop:DO sample=1,n_samples WRITE(message_print_unit,*)"->Doing sample #",sample IF(source_type==1)THEN sources_status(1)='R' sinks_status(1)='R' ELSE IF(source_type==2)THEN sources_status(1)='F' sinks_status(1)='F' END IF CALL CreateLatticeNetworkProblem(create_tree=.TRUE.) CALL CreateSSCNO InstanceLoop:DO instance=1,n_instances CALL AssignCostParameters() PointLoop:DO point=1,n_points WRITE(message_print_unit,*)"---->Doing instance, point #",instance,point IF(source_type==1)THEN sources_flow_capacity(1)=total_currents(point) sinks_flow_capacity(1)=-total_currents(point) ELSE IF(source_type==2)THEN sources_flow_capacity(1)=0.5_r_wp*total_voltages(point) sinks_flow_capacity(1)=-0.5_r_wp*total_voltages(point) END IF CALL AssignSuppliesDemands() CALL CallSSCNO(ElementalCosts=jj_iElementalCosts,& initialize_guess=(point==1)) IF(source_type==1)THEN applied_voltages(point,sample)=applied_voltages(point,sample)+& (nodes_potentials(sources(1))-nodes_potentials(sinks(1))) ELSE IF(source_type==2)THEN injected_currents(point,sample)=injected_currents(point,sample)+& 0 .5_r_wp*(supplies_demands(sources(1))-supplies_demands(sinks(1))) END IF IF(plot_samples)THEN arcs_mask=.TRUE. arcs_mask(:0)=.FALSE._l_wp DO arc=1,n_arcs arcs_mask(arc)=(arcs_mask(arc).AND.(arcs_status(arc)/=periodic_bc_arc)) END DO nodes_mask=.TRUE. nodes_mask(:0)=.FALSE._l_wp CALL InitNetworkGraphics(file="IV."//TRIM(file_extension),file_type=TRIM(file_type),& plot_title=(/"Absolute values of currents"/),& x_label="Current flow \Huge{$\rightarrow$}",& page_size=(/5000,5000/),label_format="5N0",& color_table="RAIN",colorbar_position="Horizontal",& axis_labels_format=(/"NONE","NONE","NONE","NONE"/)) CALL PlotNetwork2D(heads_tails=heads_tails(:,1:n_arcs),& node_offset=-1,node_coords=nodes_coords(:,1:n_nodes),& node_mask=nodes_mask(1:n_nodes),arc_mask=arcs_mask(1:n_arcs),& arc_values=ABS(arcs_flows(1:n_arcs)),& node_values=& nodes_potentials(1:n_nodes),& resize_nodes=.TRUE.,color_nodes=.TRUE.,& resize_arcs=.TRUE.,color_arcs=.TRUE.,& node_size_range=(/-HUGE(1.0_r_wp)/50,HUGE(1.0_r_wp)/20/),& node_colorbar_format="2E1",& arc_colorbar_format="5E1",& vector_type=0,axis=(/0.0,0.0,REAL(lengths+1)/)) nodes_mask(0:n_nodes)=.FALSE._l_wp nodes_mask(-n_special_nodes:-1)=.TRUE._l_wp arcs_mask(-1:-n_special_arcs:(-1))=.TRUE. DO arc=-n_special_arcs,-1 arcs_mask(arc)=(arcs_mask(arc).AND.(arcs_status(arc)/=periodic_bc_arc)) END DO CALL PlotNetwork2D(heads_tails=SSCNO_problem%problem%special_subgraph%heads_tails,& node_offset=n_special_nodes,node_coords=nodes_coords,& node_mask=nodes_mask,arc_mask=arcs_mask(-1:-n_special_arcs:(-1)),& arc_values=REAL(arcs_flows(-1:-n_special_arcs:(-1)),r_wp),& resize_arcs=.TRUE.,color_arcs=.FALSE.,& arc_size_range=(/0.0_r_wp,HUGE(1.0_r_wp)/10/),& node_colorbar_format="5E1",arc_colorbar_format="5E1",& vector_type=0,axis=(/0.0,0.0,REAL(lengths+1)/)) CALL EndNetworkGraphics() arcs_mask=.TRUE. arcs_mask(:0)=.FALSE._l_wp DO arc=1,n_arcs arcs_mask(arc)=(arcs_mask(arc).AND.(arcs_status(arc)/=periodic_bc_arc)) END DO nodes_mask=.TRUE. nodes_mask(:0)=.FALSE._l_wp CALL InitNetworkGraphics(file="IV."//TRIM(file_extension),file_type=TRIM(file_type),& plot_title=(/"Absolute values of voltages"/),& x_label="Current flow \Huge{$\rightarrow$}",& page_size=(/5000,5000/),label_format="5N0",& color_table="RAIN",colorbar_position="Horizontal",& axis_labels_format=(/"NONE","NONE","NONE","NONE"/)) CALL PlotNetwork2D(heads_tails=heads_tails(:,1:n_arcs),& node_offset=-1,node_coords=nodes_coords(:,1:n_nodes),& node_mask=nodes_mask(1:n_nodes),arc_mask=arcs_mask(1:n_arcs),& arc_values=ABS(arcs_voltages(1:n_arcs)),& node_values=& nodes_potentials(1:n_nodes),& resize_nodes=.TRUE.,color_nodes=.TRUE.,& resize_arcs=.TRUE.,color_arcs=.TRUE.,& node_size_range=(/-HUGE(1.0_r_wp)/50,HUGE(1.0_r_wp)/20/),& node_colorbar_format="2E1",& arc_colorbar_format="5E1",& vector_type=0,axis=(/0.0,0.0,REAL(lengths+1)/)) nodes_mask(0:n_nodes)=.FALSE._l_wp nodes_mask(-n_special_nodes:-1)=.TRUE._l_wp arcs_mask(-1:-n_special_arcs:(-1))=.TRUE. DO arc=-n_special_arcs,-1 arcs_mask(arc)=(arcs_mask(arc).AND.(arcs_status(arc)/=periodic_bc_arc)) END DO CALL PlotNetwork2D(heads_tails=SSCNO_problem%problem%special_subgraph%heads_tails,& node_offset=n_special_nodes,node_coords=nodes_coords,& node_mask=nodes_mask,arc_mask=arcs_mask(-1:-n_special_arcs:(-1)),& arc_values=REAL(arcs_voltages(-1:-n_special_arcs:(-1)),r_wp),& resize_arcs=.TRUE.,color_arcs=.FALSE.,& arc_size_range=(/0.0_r_wp,HUGE(1.0_r_wp)/10/),& node_colorbar_format="5E1",arc_colorbar_format="5E1",& vector_type=0,axis=(/0.0,0.0,REAL(lengths+1)/)) CALL EndNetworkGraphics() ELSE END IF END DO PointLoop END DO InstanceLoop applied_voltages(point,sample)=applied_voltages(point,sample)/n_instances injected_currents(point,sample)=injected_currents(point,sample)/n_instances Call DestroySSCNO CALL DestroyLatticeNetworkProblem(destroy_tree=.TRUE.) END DO SampleLoop END DO SourceType CALL StopTimer(100) WRITE(*,*)"Solving",n_points*n_samples*n_instances,& " NO problems took a total of (s) :",ReadTimer(100) WRITE(*,*)"___________________________________________" CALL ProfileSSCNO WRITE(*,*)"___________________________________________" CALL InitGraphics(file="V_I."//TRIM(file_extension),file_type=TRIM(file_type),& n_plots=n_samples+1,tick_labels="4E1",legend_position="UL",& plot_title=(/"Flow-Potential Characteristic","100x100 2D Superconductor Network"/),& x_label="$I$",y_label="$V$") IF(change_voltage.AND.change_current)THEN axis=(/MIN(MINVAL(injected_currents),MINVAL(total_currents)),& MAX(MAXVAL(injected_currents),MAXVAL(total_currents)),& MIN(MINVAL(applied_voltages),MINVAL(total_voltages)),& MAX(MAXVAL(applied_voltages),MAXVAL(total_voltages))/) ELSE IF(change_voltage)THEN axis=(/MINVAL(injected_currents),MAXVAL(injected_currents),& MINVAL(total_voltages),MAXVAL(total_voltages)/) ELSE IF(change_current)THEN axis=(/MINVAL(total_currents),MAXVAL(total_currents),& MINVAL(applied_voltages),MAXVAL(applied_voltages)/) END IF IF(change_current)THEN OPEN(UNIT=200,FILE="applied_voltages.dat",ACTION="WRITE",STATUS="UNKNOWN") DO point=1,n_points WRITE(UNIT=200,FMT="(I5,E10.3)",ADVANCE="NO")point,total_currents(point) DO sample=1,n_samples WRITE(UNIT=200,FMT="(E10.3)",ADVANCE="NO")applied_voltages(point,sample) END DO WRITE(UNIT=200,FMT=*) END DO CLOSE(UNIT=200) averaged_voltages=SUM(applied_voltages,DIM=2)/n_samples OPEN(UNIT=100,FILE="V_I.dat",ACTION="WRITE",STATUS="UNKNOWN") DO point=1,n_points WRITE(UNIT=100,FMT=*)total_currents(point),averaged_voltages(point) END DO CLOSE(UNIT=100) CALL Plot2D(x=total_currents,y=averaged_voltages,plot_spec="L.B",axis=axis) DO sample=1,n_samples CALL Plot2D(x=total_currents,y=applied_voltages(:,sample),plot_spec="SCR",axis=axis) END DO END IF IF(change_voltage)THEN OPEN(UNIT=200,FILE="injected_currents.dat",ACTION="WRITE",STATUS="UNKNOWN") DO point=1,n_points WRITE(UNIT=200,FMT="(I5,E10.3)",ADVANCE="NO")point,total_voltages(point) DO sample=1,n_samples WRITE(UNIT=200,FMT="(E10.3)",ADVANCE="NO")injected_currents(point,sample) END DO WRITE(UNIT=200,FMT=*) END DO CLOSE(UNIT=200) averaged_currents=SUM(injected_currents,DIM=2)/n_samples OPEN(UNIT=100,FILE="I_V.dat",ACTION="WRITE",STATUS="UNKNOWN") DO point=1,n_points WRITE(UNIT=100,FMT=*)total_voltages(point),averaged_currents(point) END DO CLOSE(UNIT=100) CALL Plot2D(y=total_voltages,x=averaged_currents,plot_spec="L:R",axis=axis) DO sample=1,n_samples CALL Plot2D(y=total_voltages,x=injected_currents(:,sample),plot_spec="SSB",axis=axis) END DO END IF CALL EndGraphics() CALL EndProgram DEALLOCATE(total_currents,total_voltages,averaged_currents,averaged_voltages) DEALLOCATE(applied_voltages,injected_currents) END PROGRAM IV_SSCNO