📄 dxfortrangraph.f90

📁 DXF producer by Fortran
💻 F90
字号:
!!
!! + DXFortran Graphical Module 
!! 
module DXFortranGraph

! 
! Description: 
!   Module of the Standart Librarie of DXFortran. 
! 
! Current Code Owner:
! Carlos Otero & Davide Santos
! (Department of Civil Engineering of the University of Algarve - Portugal)     
! www.ualg.pt/est/adec/csc/dxfortran
! 
! History: 
!  
! Version   Date     Comment 
! -------   -----    ------- 
! 0.1       03.11    Carlos Otero & Davide Santos
! 
! Code Description: 
!   Language:  Fortran 90. 
!   Software Standards: "European Standards for Writing and  
!  Documenting Exchangeable Fortran 90 Code". 

Use DXFortranStd
 
Implicit none 

Contains 

! Define procedures contained in this module. 

!
!+ Subroutine to Draw a 2D graphic axis
!
Subroutine dfGraphAxis2D	   & 
		  (FileNum,			   &
           Layer,			   &
           MaxXX,			   &
           MaxYY,			   &
		   MinXX,		 	   &
		   MinYY,			   &
           PrimaryScaleXX,     &
           PrimaryScaleYY,     &
           DimPrimaryScaleXX,  &
		   DimPrimaryScaleYY,  &
		   SecondaryScaleXX,   &
		   SecondaryScaleYY,   &
		   DimSecondaryScaleXX,&
		   DimSecondaryScaleYY,&
		   DrawPrimaryGridXX,  &
		   DrawPrimaryGridYY,  &
		   DrawSecondaryGridXX,&
		   DrawSecondaryGridYY,&
		   DrawBorderAxisXX,   &
		   DrawBorderAxisYY,   &
		   DrawZeroAxisXX,     &
		   DrawZeroAxisYY,     &
           TextPositionXX,     &
		   TextPositionYY,     &
           TextHight,          &
		   TextStyle)   



! Description: 
! 
! Draw a graphic axis in 2D in format dxf, using the arguments 
! 
! Method: 
! No comment...
!
! Current Code Owner: 
! Davide Santos (University of Algarve)     
! 
! History: 
! Version     Date      Comment 
! -------   --------    ------- 
!	1.0		03.11.18	Davide Santos
!
! Code Description: 
!   Language:  Fortran 90. 
!   Software Standards: "European Standards for Writing and  
!     Documenting Exchangeable Fortran 90 Code". 
! 
! Use staments


Implicit none 
 

! Definitions of variables

Integer	::	FileNum,		      &	!+ File number
			n,                    & !+ Counter
			i,				      &	!+ Reference item
			opc,                  & !+ Option
			NPrimXX,              & !+ Number of ???
			NSecXX,			      &
			NPrimYY,              & !+ Number of ???
			NSecYY,			      &
            DrawZeroAxisXX,       &	!+ Draw Zeros Axis ((1 - Yes; 0 - No)
			DrawZeroAxisYY,       &	!+ Draw Zeros Axis ((1 - Yes; 0 - No)
            DrawBorderAxisXX,     &	!+ Draw Zeros Axis ((1 - Yes; 0 - No)
            DrawBorderAxisYY,     &	!+ Draw Zeros Axis ((1 - Yes; 0 - No)
			DrawPrimaryGridXX,	  &	!+ Draw Primary XX Grid (1 - Yes; 0 - No)
			DrawSecondaryGridXX,  &	!+ Draw Secundary XX Grid (1 - Yes; 0 - No)
			DrawPrimaryGridYY,	  &	!+ Draw Primary YY Grid (1 - Yes; 0 - No)
			DrawSecondaryGridYY,  &	!+ Draw Secundary YY Grid (1 - Yes; 0 - No)
			TextPositionXX,       &	!+ Position Text XX Axis (-1 - Lower Value; 0 - Zero Value; 1 - Upper Value) 
			TextPositionYY  	    !+ Position Text YY axis (-1 - Lower Value; 0 - Zero Value; 1 - Upper Value) 

Real ::		MaxXX,			    &
			MinXX,			    &
			PrimaryScaleXX,     &
			SecondaryScaleXX,   &
			MaxYY,			    &
			MinYY,			    &
			PrimaryScaleYY,     &
			SecondaryScaleYY,   &
            DimPrimaryScaleXX,  &
            DimPrimaryScaleYY,  &
            DimSecondaryScaleXX,&
		    DimSecondaryScaleYY,&
			TextHight	

character*(*)	::	text*25, & ! Variable to asign of datas in the axis
					TextStyle


Character , Intent(in) ::  Layer *(*)        !+ Axis Layer


!+ Draw Minimum XX axis
	if(DrawBorderAxisXX == 1 .Or. TextPositionXX == -1) call dfLine(FileNum, Layer,"bylayer ", "bylayer", MinXX, MinYY,0.0, MaxXX, MinYY, 0.0, 0.0)

!+ Draw Maximum XX axis
	if(DrawBorderAxisXX == 1 .Or. TextPositionXX == 1) call dfLine(FileNum, Layer,"bylayer ", "bylayer", MinXX, MaxYY,0.0, MaxXX, MaxYY, 0.0, 0.0)

!+ Draw Minimum YY Axis
	if(DrawBorderAxisYY == 1 .Or. TextPositionYY == -1) call dfLine(FileNum, Layer,"bylayer ", "bylayer", MinXX, MinYY,0.0, MinXX, MaxYY, 0.0, 0.0)

!+ Draw Maximum YY Axis
	if(DrawBorderAxisYY == 1 .Or. TextPositionYY == 1) call dfLine(FileNum, Layer,"bylayer ", "bylayer", MaxXX, MinYY,0.0, MaxXX, MaxYY, 0.0, 0.0)

!+ Draw Zero XX Axis
if(DrawZeroAxisXX == 1 .Or. TextPositionXX == 0) call dfLine(FileNum, Layer,"bylayer ", "bylayer", MinXX, 0.0,0.0, MaxXX, 0.0, 0.0, 0.0)

!+ Draw Zero YY Axis
if(DrawZeroAxisYY == 1 .Or. TextPositionYY == 0) call dfLine(FileNum, Layer,"bylayer ", "bylayer", 0.0, MinYY,0.0, 0.0, MaxYY, 0.0, 0.0)


NPrimXX = INT((MaxXX-MinXX)/PrimaryScaleXX)

do i=0,NPrimXX

if(((MinXX + i*PrimaryScaleXX)**2.0)**0.5 < 10000.0000000) opc = 0
if(((MinXX + i*PrimaryScaleXX)**2.0)**0.5 <  1000.0000000) opc = 1
if(((MinXX + i*PrimaryScaleXX)**2.0)**0.5 <   100.0000000) opc = 2
if(((MinXX + i*PrimaryScaleXX)**2.0)**0.5 <    10.0000000) opc = 3
if(((MinXX + i*PrimaryScaleXX)**2.0)**0.5 <     1.0000000) opc = 4
if(((MinXX + i*PrimaryScaleXX)**2.0)**0.5 <     0.1000000) opc = 5
if(((MinXX + i*PrimaryScaleXX)**2.0)**0.5 <     0.0010000) opc = 6
if(((MinXX + i*PrimaryScaleXX)**2.0)**0.5 <     0.0001000) opc = 7
if(((MinXX + i*PrimaryScaleXX)**2.0)**0.5 <     0.0000100) opc = 8
if(((MinXX + i*PrimaryScaleXX)**2.0)**0.5 <     0.0000010) opc = 9
if(((MinXX + i*PrimaryScaleXX)**2.0)**0.5 <     0.0000001) opc = 10
if(((MinXX + i*PrimaryScaleXX)**2.0)**0.5 ==    0.0)       opc = 0


	!+ Draw Primary Scale on Minimum XX Axis
	if(DrawBorderAxisXX == 1 .Or. TextPositionXX == -1) call dfline(FileNum,Layer,"bylayer","bylayer",MinXX + i*PrimaryScaleXX, MinYY- DimPrimaryScaleYY,0.0,MinXX + i*PrimaryScaleXX, MinYY,0.0,0.0)

	!+ Draw Primary Scale on Maximum XX Axis
	if(DrawBorderAxisXX == 1 .Or. TextPositionXX == 1) call dfline(FileNum,Layer,"bylayer","bylayer",MinXX + i*PrimaryScaleXX, MaxYY + DimPrimaryScaleXX,0.0,MinXX + i*PrimaryScaleXX, MaxYY,0.0,0.0)

	!+ Draw Primary Scale on Zero XX Axis
	if(DrawZeroAxisXX == 1 .Or. TextPositionXX == 0) call dfline(FileNum,Layer,"bylayer","bylayer",MinXX + i*PrimaryScaleXX, - DimPrimaryScaleXX,0.0,MinXX + i*PrimaryScaleXX, 0.0+(MaxXX-MinXX)*0.02,0.0,0.0)
	

	!+ Draw Primary Grid YY
	if(DrawPrimaryGridYY == 1) call dfline(FileNum,Layer,"bylayer","bylayer",MinXX + i*PrimaryScaleXX, MinYY,0.0,MinXX + i*PrimaryScaleXX, MaxYY,0.0,0.0)

	!+ Write Values on minimum XX Axis
	if(TextPositionXX== -1) Then
	call SUB_PSFR2C(MinXX + i*PrimaryScaleXX,Text,Opc)
	call dftext(FileNum,Layer,"bylayer",MinXX + i*PrimaryScaleXX, MinYY-DimPrimaryScaleXX,0.0,Text,TextHight,1.,90.,2,2,TextStyle)
	end if

	!+ Write Values on zero XX Axis
	if(TextPositionXX== 0) Then
	call SUB_PSFR2C(MinXX + i*PrimaryScaleXX,Text,Opc)
	call dftext(FileNum,Layer,"bylayer",MinXX + i*PrimaryScaleXX, 0.0-DimPrimaryScaleXX,0.0,Text,TextHight,1.,90.,2,2,TextStyle)
	end if

	!+ Write Values on Maximum XX Axis
	if(TextPositionXX == 1) Then
	call SUB_PSFR2C(MinXX + i*PrimaryScaleXX,Text,Opc)
	call dftext(FileNum,Layer,"bylayer",MinXX + i*PrimaryScaleXX, MaxYY+DimPrimaryScaleXX,0.0,Text,TextHight,1.,90.,0,2,TextStyle)
	end if
enddo

NSecXX = int((MaxXX-MinXX)/SecondaryScaleXX)
do i=0,NSecXX
	!+ Draw Secondary Scale on Minimum XX Axis
	if (DrawBorderAxisXX == 1 .Or. TextPositionXX == -1) call dfline(FileNum,Layer,"bylayer","bylayer",MinXX + i*SecondaryScaleXX, MinYY- DimSecondaryScaleXX,0.0,MinXX + i*SecondaryScaleXX, MinYY,0.0,0.0)

	!+ Draw Secondary Scale on Maximum XX Axis
	if (DrawBorderAxisXX == 1 .Or. TextPositionXX == 1) call dfline(FileNum,Layer,"bylayer","bylayer",MinXX + i*SecondaryScaleXX, MaxYY+DimSecondaryScaleXX,0.0,MinXX + i*SecondaryScaleXX, MaxYY,0.0,0.0)

	!+ Draw Secondary Scale on Zero XX Axis
	if(DrawZeroAxisXX == 1 .Or. TextPositionXX == 0) call dfline(FileNum,Layer,"bylayer","bylayer",MinXX + i*SecondaryScaleXX, 0.0-DimSecondaryScaleXX,0.0,MinXX + i*SecondaryScaleXX, 0.0+(MaxXX-MinXX)*0.01,0.0,0.0)
	
	!+ Draw Secondary Grid YY
	if(DrawSecondaryGridYY == 1) call dfline(FileNum,Layer,"bylayer","bylayer",MinXX + i*SecondaryScaleXX, MinYY,0.0,MinXX + i*SecondaryScaleXX, MaxYY,0.0,0.0)

enddo



NPrimYY = INT((MaxXX-MinXX)/PrimaryScaleXX)

do i=0,NPrimYY

if(((MinYY + i*PrimaryScaleYY)**2.0)**0.5 < 10000.000000) opc = 0
if(((MinYY + i*PrimaryScaleYY)**2.0)**0.5 <  1000.000000) opc = 1
if(((MinYY + i*PrimaryScaleYY)**2.0)**0.5 <   100.000000) opc = 2
if(((MinYY + i*PrimaryScaleYY)**2.0)**0.5 <    10.000000) opc = 3
if(((MinYY + i*PrimaryScaleYY)**2.0)**0.5 <     1.000000) opc = 4
if(((MinYY + i*PrimaryScaleYY)**2.0)**0.5 <     0.100000) opc = 5
if(((MinYY + i*PrimaryScaleYY)**2.0)**0.5 <     0.0010000) opc = 6
if(((MinYY + i*PrimaryScaleYY)**2.0)**0.5 <     0.0001000) opc = 7
if(((MinYY + i*PrimaryScaleYY)**2.0)**0.5 <     0.0000100) opc = 8
if(((MinYY + i*PrimaryScaleYY)**2.0)**0.5 <     0.0000010) opc = 9
if(((MinYY + i*PrimaryScaleYY)**2.0)**0.5 <     0.0000001) opc = 10
if(((MinYY + i*PrimaryScaleYY)**2.0)**0.5 ==    0.0)     opc = 0

	!+ Draw Primary Scale on Minimum YY Axis
	if (DrawBorderAxisYY == 1 .Or. TextPositionYY == -1) call dfline(FileNum,Layer,"bylayer","bylayer",MinXX-DimPrimaryScaleYY , MinYY+ i*PrimaryScaleYY,0.0,MinXX, MinYY + i*PrimaryScaleYY,0.0,0.0)

	!+ Draw Primary Scale on Maximum YY Axis
	if (DrawBorderAxisYY == 1 .Or. TextPositionYY ==  1) call dfline(FileNum,Layer,"bylayer","bylayer",MaxXX+DimPrimaryScaleYY , MinYY +i*PrimaryScaleYY,0.0,MaxXX, MinYY + i*PrimaryScaleYY,0.0,0.0)

	!+ Draw Primary Scale on Zero YY Axis
	if(DrawZeroAxisYY == 1 .Or. TextPositionYY == 0) call dfline(FileNum,Layer,"bylayer","bylayer",-DimPrimaryScaleYY , MinYY+i*PrimaryScaleYY,0.0,(MaxXX-MinXX)*0.02,MinYY+i*PrimaryScaleYY,0.0,0.0)
	
	!+ Draw Primary Grid XX
	if(DrawPrimaryGridXX == 1) call dfline(FileNum,Layer,"bylayer","bylayer",MinXX, MinYY+ i*PrimaryScaleYY,0.0,MaxXX, MinYY + i*PrimaryScaleYY,0.0,0.0)

	!+ Write Values on minimum YY Axis
	if(TextPositionYY== -1) Then
	call SUB_PSFR2C(MinXX + i*PrimaryScaleXX,Text,Opc)
	call dftext(FileNum,Layer,"bylayer",MinXX-DimPrimaryScaleYY, MinYY+ i*PrimaryScaleYY,0.0,Text,TextHight,1.,0.0,2,2,TextStyle)
	end if

	!+ Write Values on zero YY Axis
	if(TextPositionYY== 0) Then
	call SUB_PSFR2C(MinXX + i*PrimaryScaleXX,Text,Opc)
	call dftext(FileNum,Layer,"bylayer",-DimPrimaryScaleYY, MinYY+i*PrimaryScaleYY,0.0,Text,TextHight,1.,0.0,2,2,TextStyle)
	end if

	!+ Write Values on Maximum YY Axis
	if(TextPositionYY == 1) Then
	call SUB_PSFR2C(MinYY + i*PrimaryScaleYY,Text,Opc)
	call dftext(FileNum,Layer,"bylayer",MaxXX + DimPrimaryScaleYY , MinYY +i*PrimaryScaleYY,0.0,Text,TextHight,1.,0.0,0,2,TextStyle)
	end if

end do

NSecYY = int((MaxYY-MinYY)/SecondaryScaleYY)

do i=0,NSecYY
	!+ Draw Primary Scale on Minimum YY Axis
	if (DrawBorderAxisYY == 1 .Or. TextPositionYY == -1) call dfline(FileNum,Layer,"bylayer","bylayer",MinXX-DimSecondaryScaleYY, MinYY+ i*SecondaryScaleYY,0.0,MinXX, MinYY + i*SecondaryScaleYY,0.0,0.0)

	!+ Draw Primary Scale on Maximum YY Axis
	if (DrawBorderAxisYY == 1 .Or. TextPositionYY == 1)	call dfline(FileNum,Layer,"bylayer","bylayer",MaxXX+DimSecondaryScaleYY,MinYY+i*SecondaryScaleYY,0.0,MaxXX, MinYY + i*SecondaryScaleYY,0.0,0.0)

	!+ Draw Primary Scale on Zero YY Axis
	if (DrawZeroAxisYY == 1 .Or. TextPositionYY == 0) call dfline(FileNum,Layer,"bylayer","bylayer",-DimSecondaryScaleYY,MinYY+i*SecondaryScaleYY,0.0,DimSecondaryScaleYY,MinYY+i*SecondaryScaleYY,0.0,0.0)

	!+ Draw Secondary Grid XX
	if(DrawSecondaryGridXX == 1) call dfline(FileNum,Layer,"bylayer","bylayer",MinXX, MinYY+ i*SecondaryScaleYY,0.0,MaxXX, MinYY + i*SecondaryScaleYY,0.0,0.0)
end do
end subroutine

!-----------------------------------------------------------------
! real 2 character
!-----------------------------------------------------------------
    SUBROUTINE SUB_PSFR2C(var1,var2,opc)


    REAL             ,INTENT ( IN) :: var1
    CHARACTER(len=*) ,INTENT  (OUT) :: var2
    INTEGER           ,INTENT ( IN) :: opc 
    
    OPEN (998,file="r2c.tmp",status="scratch")
    
    SELECT CASE (opc)
           CASE (0)
            WRITE(998,"(f12.0)")var1
           CASE (1)
            WRITE(998,"(f12.1)")var1
           CASE (2)
            WRITE(998,"(f12.2)")var1
           CASE (3)
            WRITE(998,"(f12.3)")var1
           CASE (4)
            WRITE(998,"(f12.4)")var1
           CASE (5)
            WRITE(998,"(f12.5)")var1
           CASE (6)
            WRITE(998,"(f12.6)")var1
           CASE (7)
            WRITE(998,"(f12.7)")var1
           CASE (8)
            WRITE(998,"(f12.8)")var1
           CASE (9)
            WRITE(998,"(f12.9)")var1
           CASE (10)
            WRITE(998,"(f12.10)")var1
           CASE (11)
            WRITE(998,"(f12.11)")var1
		   CASE (12)
            WRITE(998,"(f12.12)")var1
           CASE DEFAULT
           WRITE(*,*) "Erro - SUB_PSFR2C - Num. Casas decimais Errado"
     END SELECT
    
    REWIND(998)
    READ(998,*) var2
	var2 = TRIM(var2)
    CLOSE(998)
      
    RETURN
    END SUBROUTINE

!
!+ Draw a XY 2D Graph
!
Subroutine dfGraphXY2D	       & 
		  (FileNum,			   &
           Layer,			   &
		   X,				   & 
		   Y,                  &
		   NPoints)

! Description: 
! 
! Draw a XY 2D graphic in format dxf, using the arguments 
! 
! Method: 
! No comment...
!
! Current Code Owner: 
! Davide Santos (University of Algarve)     
! 
! History: 
! Version     Date      Comment 
! -------   --------    ------- 
!	1.0		03.11.18	Davide Santos
!
! Code Description: 
!   Language:  Fortran 90. 
!   Software Standards: "European Standards for Writing and  
!     Documenting Exchangeable Fortran 90 Code". 
! 
! Use staments


Implicit none 
 

! Definitions of variables

Integer	::	FileNum,		      &	!+ File number
			NPoints,              & !+ Counter
			i						!+ Reference item

Real, Dimension(:) :: X, Y  !+ XY Points (xx : yy)


Character , Intent(in) ::  Layer *(*)        !+ Axis Layer

do i=1,NPoints - 1  
call dfline(FileNum,Layer,"bylayer","bylayer",X(i),Y(i),0.0,X(i+1),Y(i+1),0.0,0.0) 
end do   

end subroutine



end module DXFortranGraph
💿 文件大小 374 K
👤 上传用户 ggh062
📂 所属分类邮电通讯系统
🏷️ 相关标签

#producer #Fortran #DXF #by
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -