    Module ACADDraw
    use Base
    contains


    Subroutine ACAD (I, Frame, N, MCON, Cord)

    implicit none
    integer I
    Integer N,j,J1,J2

    integer MCON(mt,mn)
    REAL (KIND=dp) CORD(mt,ml)


    REAL (KIND=dp) :: ALAST = 0.0
    REAL (KIND=dp) :: ELAST = 0.0
    REAL (KIND=dp) :: AEND = 814.0
    REAL (KIND=dp) :: EEND = 594.0
    REAL (KIND=dp) A2,B2,C2,D2, xLOC, yLOC, xLOC1, yLOC1
    REAL (KIND=dp) OffsetX, OffsetY, SCALE, jiggle, num, offsetF
    integer Frame(mt)

    Write(*,100)
100 Format( //"               Drawing Frames for checking purposes",/)


    WRITE(sCAD,20)
20  FORMAT(' 0',/&
        ,'ENDSEC',/&
        ,'  0',/&
        ,'SECTION',/&
        ,'  2',/&
        ,'ENTITIES'  )

    A2 = ALAST
    B2 = ELAST
    C2 = AEND
    D2 = EEND
    OffsetX = 30.0D0
    OffsetY = 30.0D0
    SCALE = 20.0D0
    jiggle = 1.0d0


    CALL DRAW (A2,B2,C2,Zero,10)

    B2 = EEND

    CALL DRAW (A2,B2,C2,B2,10)
    CALL DRAW (A2,Zero,A2,B2,10)
    CALL DRAW (C2,Zero,C2,B2,10)

    do j = 1,n

        if(Frame(j) .gt. 0) then

            J1=ABS(MCON(j,1))
            J2=ABS(MCON(j,2))
            num = dble(frame(j))
            write(*,300)Frame(j),MCON(j,1),MCon(j,2),CORD(j1,1),CORD(j1,2),CORD(j1,3),CORD(j2,1),CORD(j2,2),CORD(j2,3), num
            OffsetF = OffsetY + (num-1.0d0)*150.0d0
            CALL DRAW (((SCALE*CORD(j1,1))+OffsetX),SCALE*CORD(j1,3)+OffsetF,SCALE*CORD(j2,1)+OffsetX,SCALE*CORD(j2,3)+OffsetF,14)
            
            xLOC = (SCALE*CORD(j1,1))+OffsetX + jiggle
            yLOC = SCALE*CORD(j1,3)+OffsetF
            CALL TEXTSL (xLOC,yLOC,j1,1.0D0, 1)
            xLOC1 = (SCALE*CORD(j2,1))+OffsetX + jiggle
            yLOC1 = SCALE*CORD(j2,3)+OffsetF
            CALL TEXTSL (xLOC1, yLOC1, j2, 1.0D0, 1)
            xLOC = (xLOC + xLOC1)/2.0
            yLOC = (yLOC + yLOC1)/2.0
            CALL TEXTSL (xLOC, yLOC , j, 2.0D0, 2)

        endif
300     Format(3I4,7F10.3)

    end do

170 WRITE(sCAD,70)
70  FORMAT(' 0',/&
        ,'ENDSEC',/&
        ,'  0',/&
        ,'EOF')


    return
    end subroutine


    !      ************************************************************
    !
    SUBROUTINE DRAW (X1,Y1,X2,Y2,NC)
    !
    !      ************************************************************
    REAL (KIND=dp) X1,Y1,X2,Y2
    Integer NC


    WRITE(sCAD,10)
10  FORMAT(' 0',/&
        ,'LINE',/&
        ,'  8')
    IF (NC .EQ. 1) THEN
        WRITE(sCAD,11)
11      FORMAT('LSDGN',/'  62',/, '3',/,' 10')
    ELSEIF (NC .EQ. 2) THEN
        WRITE(3,12)
12      FORMAT('LSDAT50',/,' 10')
    ELSEIF (NC .EQ. 3) THEN
        WRITE(sCAD,13)
13      FORMAT('LSMH25',/,' 10')
    ELSEIF (NC .EQ. 4) THEN
        WRITE(sCAD,14)
14      FORMAT('LSPRO50',/,' 10')
    ELSEIF (NC .EQ. 5) THEN
        WRITE(sCAD,15)
15      FORMAT('LSDGN70',/,' 10')
    ELSEIF (NC .EQ. 6) THEN
        WRITE(sCAD,16)
16      FORMAT('CONS25',/,' 10')
    ELSEIF (NC .EQ. 10) THEN
        WRITE(sCAD,112)
112     FORMAT('LSDAT',/'  62',/, '2',/,' 10')
    ELSEIF (NC .EQ. 11) THEN
        WRITE(sCAD,113)
113     FORMAT('LSDGN',/,'  62',/, '3',/,' 10')
    ELSEIF (NC .EQ. 12) THEN
        WRITE(sCAD,114)
114     FORMAT('LSMH',/,'  62',/, '4',/,' 10')
    ELSEIF (NC .EQ. 13) THEN
        WRITE(sCAD,115)
115     FORMAT('LSDGNF',/,'  62',/, '6',/,' 10')
        Write(*,*)X1, Y1, X2, Y2
        If(X1 .gt. 4000.0) Then
            X1 = 0.0
        Endif
    ELSEIF (NC .EQ. 14) THEN
        WRITE(sCAD,116)
116     FORMAT('LSPRO',/,'  62',/, '5',/,' 10')
    ENDIF

    CALL LINE1(X1)

    WRITE(sCAD,20)
20  FORMAT('20'  )

    CALL LINE1(Y1)

    WRITE(sCAD,30)
30  FORMAT('11'  )

    CALL LINE1(X2)

    WRITE(sCAD,40)
40  FORMAT('21'  )
    CALL LINE1(Y2)

    RETURN
    END


    !      ************************************************************
    !
    SUBROUTINE LINE1(X3)
    !
    !      ************************************************************

    implicit none
    REAL (KIND=dp) X3
    IF ( X3 .LT. 9.9999) THEN
        WRITE(sCAD,10)X3
10      FORMAT(F10.5)
    ELSEIF (X3 .LT. 99.9999) THEN
        WRITE(sCAD,20)X3
20      FORMAT(F10.5)
    ELSEIF (X3 .LT. 999.9999) THEN
        WRITE(sCAD,30)X3
30      FORMAT(F12.5)
    ELSEIF (X3 .LT. 9999.9999) THEN
        WRITE(sCAD,40)X3
40      FORMAT(F13.5)
    ELSEIF (X3 .LT. 99999.9999) THEN
        WRITE(sCAD,50)X3
50      FORMAT(F14.5)
    ENDIF

    RETURN
    END

    !      ************************************************************
    !
    SUBROUTINE TEXTSL (X,Y,GRADE,SIZE, I)
    !
    !      ************************************************************
    implicit none
    integer Grade
    real (KIND=dp) X,Y,Size, ANG
    Integer NC
    Integer I
    ANG = 0.0D0

    if(I .eq. 1) then
        WRITE(sCAD,10)
10      FORMAT(' 0',/,'TEXT',/,'  8',/,'LSMH25',/,'  62',/, '2',/,' 10')
    else
        WRITE(sCAD,113)
113     FORMAT(' 0',/,'TEXT',/,'  8',/,'LSDGN',/,'  62',/, '3',/,' 10')
        !      ADJUST INSERTION POINT
    endif

    CALL TEXT2(X)

    WRITE(sCAD,20)
20  FORMAT('20'  )

    CALL TEXT2(Y)

    WRITE(sCAD,30)
30  FORMAT('40'  )

    CALL text2 (size)

    WRITE(sCAD,40)
40  FORMAT(' 1' )

    CALL textAI(GRADE)

    WRITE(sCAD,50)
50  FORMAT('50'  )
    ang=45.0
    CALL text2 (ang)


    RETURN
    END



    !      ************************************************************
    !
    SUBROUTINE TEXTAI(I)
    !
    !      ************************************************************
    implicit none
    integer I
    IF (I .LT. -9999) THEN
        WRITE(sCAD,5)I
5       FORMAT(I6)
    ELSEIF (I .LT. -999) THEN
        WRITE(sCAD,4)I
4       FORMAT(I5)
    ELSEIF (I .LT. -99) THEN
        WRITE(sCAD,3)I
3       FORMAT(I4)
    ELSEIF (I .LT. -9) THEN
        WRITE(sCAD,2)I
2       FORMAT(I3)
    ELSEIF ( I .LT. 0) THEN
        WRITE(sCAD,1)I
1       FORMAT(I2)
    ELSEIF ( I .LT. 10) THEN
        WRITE(sCAD,10)I
10      FORMAT(I1)
    ELSEIF (I .LT. 100) THEN
        WRITE(sCAD,20)I
20      FORMAT(I2)
    ELSEIF (I .LT. 1000) THEN
        WRITE(sCAD,30)I
30      FORMAT(I3)
    ELSEIF (I .LT. 10000) THEN
        WRITE(sCAD,40)I
40      FORMAT(I4)
    ELSEIF (I .LT. 100000) THEN
        WRITE(sCAD,50)I
50      FORMAT(I5)
    ENDIF

    RETURN
    END
    !      ************************************************************
    !
    SUBROUTINE TEXT2(X3)
    !
    !      ************************************************************
    REAL (KIND=dp) X3

    IF ( X3 .LT. 9.9999) THEN
        WRITE(sCAD,10)X3
10      FORMAT(F8.5)
    ELSEIF (X3 .LT. 99.9999) THEN
        WRITE(sCAD,20)X3
20      FORMAT(F9.5)
    ELSEIF (X3 .LT. 999.9999) THEN
        WRITE(sCAD,30)X3
30      FORMAT(F10.5)
    ELSEIF (X3 .LT. 9999.9999) THEN
        WRITE(sCAD,40)X3
40      FORMAT(F11.5)
    ELSEIF (X3 .LT. 99999.9999) THEN
        WRITE(sCAD,50)X3
50      FORMAT(F12.5)
    ENDIF

    RETURN
    END

    !      ************************************************************
    !
    SUBROUTINE TEXT31(X3)
    !
    !      ************************************************************
    REAL (KIND=dp)  X3
    IF (X3 .LT. -9999.99999) THEN
        WRITE(sCAD,5)X3
5       FORMAT(F9.2)
    ELSEIF (X3 .LT. -999.99999) THEN
        WRITE(sCAD,4)X3
4       FORMAT(F8.2)
    ELSEIF (X3 .LT. -99.99999) THEN
        WRITE(sCAD,3)X3
3       FORMAT(F7.2)
    ELSEIF (X3 .LT. -9.99999) THEN
        WRITE(sCAD,2)X3
2       FORMAT(F6.2)
    ELSEIF ( X3 .LT. 0.0000) THEN
        WRITE(sCAD,1)X3
1       FORMAT(F5.2)
    ELSEIF ( X3 .LT. 9.9999) THEN
        WRITE(sCAD,10)X3
10      FORMAT(F5.2)
    ELSEIF (X3 .LT. 99.9999) THEN
        WRITE(sCAD,20)X3
20      FORMAT(F5.2)
    ELSEIF (X3 .LT. 999.9999) THEN
        WRITE(sCAD,30)X3
30      FORMAT(F6.2)
    ELSEIF (X3 .LT. 9999.9999) THEN
        WRITE(sCAD,40)X3
40      FORMAT(F7.2)
    ELSEIF (X3 .LT. 99999.9999) THEN
        WRITE(sCAD,50)X3
50      FORMAT(F8.2)
    ENDIF

    RETURN
    END

    end module
