    !  Auxo.f90
    !
    !  FUNCTIONS:
    !  Auxo - Entry point of console application.
    !

    !****************************************************************************
    !
    !  PROGRAM: Auxo
    !
    !  PURPOSE:  Entry point for the console application.
    !
    !****************************************************************************

    program Auxo
    use ifport

    implicit none

    ! Variables

    ! Body of Auxo

    Integer JJ, JJJ,NM,JTYPE(20,3),MCON(27,2),LSN(4), JCT,I,J,L,J1,J2,ISW,NJ,NK,M,NA,JF
    Integer K,KK,LSC,LN,JN,LL,LJ,LS,KJ,NLS,IP1,KL
    Double Precision TR, E, Alpha,X,Y,Z, TEMP,XF,YF,ZF,AA,AB,AC
    Double Precision CORD(20,3),AREA(27),A(27,30),CSAT(27), DEFX(27,4),SR(27,4),OLEN(27),SRS,STRS

    open(1, File = 'a.inp', STATUS = 'Unknown')
    open(2, File = 'a.out', STATUS = 'Unknown')
    open(30, File = 'a.txt', STATUS = 'Unknown')

    Write(30,5)
    Write(*,5)
5   Format( //,'  -----------------------------------------------------',//,'                  Program Auxo ',/,'           Variant on CEST from Harrison, 1973 ',i4)
    LSC = 0

10  READ(1,*, ERR = 1000, END = 1000)JJ,JJJ,JCT,NM,TR,ALPHA,E
    write(*,*)JJ,JJJ,JCT,NM,TR,ALPHA,E
    IF(JJ)20,30,30
20  STOP
30  IF(E) 40,40,50
40  E= 207000.0
50  DO 60 I=1,JCT
60  READ(1,*, ERR = 1000, END = 1000),(CORD(I,J),J=1,JJJ),(JTYPE(I,J),J=1,JJJ)
    DO 70 I=1,NM
        Write(30,5)2
70  READ (1,*, ERR = 1000, END = 1000),(MCON(I,J),J=1,2),AREA(I)
    L=0
    DO 80 I=1,JCT
        DO 80 J=1,JJJ
80  L=L+JTYPE(I,J)

    Write(30,5)3
    DO 100 I=1,NM
        J1=MCON(I,1)
        J2=MCON(I,2)
        X=CORD(J1,1)-CORD(J2,1)
        Y=CORD(J1,2)-CORD(J2,2)
        IF(JJJ-2)95,95,96
95      OLEN (I)=SQRT(X*X+Y*Y)
        GO TO 100
96      Z=CORD(J1,3)-CORD(J2,3)
        OLEN(I)=SQRT(X*X+Y*Y+Z*Z)
100 CONTINUE

    Write(30,5)4
    IF(ALPHA) 105,104,105
104 ALPHA =.000011
105 ISW=1
110 NJ=0
    NK=0
    DO 90 I=1,L
        DO 90 J=1,NM
90  A(1,J)=0.
    Write(30,5)5
    DO 270 J=1,JCT
        DO 260 M=1,NM
            NA=NJ
            IF(J-MCON(M,1))130,120,130
120         JF=MCON(M,2)
            GO TO 150
130         IF(J-MCON(M,2))260,140,260
140         JF=MCON(M,1)
150         X=CORD(JF,1)-CORD(J,1)
            Y=CORD(JF,2)-CORD(J,2)
            IF(JJJ-2)170,170,160
160         Z=CORD(JF,3)-CORD(J,3)
170         IF (JTYPE(J,1)) 190,190,180
180         NA=NA+1
            A(NA,M)=-X/OLEN(M)
            Write(2,1010)1,NA,M,A(NA,M)
190         IF(JTYPE(J,2))210,210,200
200         NA=NA+1
            A(NA,M)=-Y/OLEN(M)
            Write(2,1010)2,NA,M,A(NA,M)
210         IF(JJJ - 2)240,240,220
220         IF(JTYPE(J,3))240,240,230
230         NA=NA+1
            A(NA,M)=-Z/OLEN(M)
            Write(2,1010)3,NA,M,A(NA,M)
240         IF(NA-NK)260,260,250
250         NK=NA
260     CONTINUE
        NJ=NK
270 CONTINUE
    Write(30,5)6
    IF(ISW) 890,890,280
280 IF(TR)282,289,282
282 DO 283 I=1,NM
283 CSAT(I) = E*AREA(I)*ALPHA*TR
    DO 284 I=1,L
        DEFX(I,2)=0.
        DO 284 J=1,NM
284 DEFX(I,2)=DEFX(I,2)+A(I,J)*CSAT(J)
    Write(30,5)7
289 DO 320 J=1,L
        DO 290 I=1,NM
290     CSAT(I)=E*AREA(I)*A(J,I)/OLEN(I)
        DO 310 I=J,L
            TEMP=0.0
            DO 300 K=1,NM
300         TEMP=TEMP+A(I,K)*CSAT(K)
310     DEFX(I,1)=TEMP
        DO 320 I=1,L
            A(J,I)=DEFX(I,1)
            Write(2,1010)4,J,I,A(J,I)
320 Continue
    Write(30,5)8
    DO 330 I=1,L
        DO 330 J=1,L
            A(J,I)=A(I,J)
            Write(2,1010)5,I,J,A(I,J)
            Write(2,1010)6,J,I,A(J,I)
330 Continue
    LSC=L
    Write(30,5)9
340 READ(1,*, ERR = 1000, END = 1000),KK,LN
    LSC=LSC+1
    IF(KK) 470,470,350
350 DO 360 I=1,L
        A(I,LSC)=0.
        Write(2,1010)7,I,LSC,A(I,LSC)
360 Continue
    I=LSC-L
    LSN(I)=KK
    DO 460 I=1,LN
        READ(1,*, ERR = 1000, END = 1000),JN,XF,YF
        IF(JJJ-2) 380,380,370
370     READ (1,*, ERR = 1000, END = 1000),ZF
380     LL=0
        LJ=JN-1

        Write(30,5)10
        IF(LJ) 395,395,385
385     DO 390 J=1,LJ
            DO 390 K=1,JJJ
390     LL=LL+JTYPE(J,K)
395     IF(JTYPE(JN,1)) 410,410,400
400     LL=LL+1
        A(LL,LSC)=XF

        Write(30,5)11
        Write(2,1010)8,LL,LSC,A(LL,LSC)
410     IF(JTYPE(JN,2)) 430,430,420
420     LL=LL+1
        A(LL,LSC)=YF
        Write(2,1010)11,LL,LSC,A(LL,LSC)
430     IF(JJJ - 2) 460,460,440
440     IF(JTYPE(JN,3)) 460,460,450
450     LL=LL+1
        A(LL,LSC)=ZF
        Write(2,1010)9,LL,LSC,A(LL,LSC)
460 CONTINUE
    GO TO 340
470 Write(*,*)'End of input data'
    IF(TR) 480,500,480
480 LS=L+1
    DO 490 I=1,L
        A(I,LS) = A(I,LS) + DEFX(I,2)
        Write(2,1010)10,I,LS,A(I,LS)
490 Continue
500 KJ=LSC-1
    NLS=KJ-L
    DO 680 I=1,L
        IP1=I+1
        TEMP=ABS(A(I,I))
        K=l
        DO 590 J=I,L
            IF(ABS(A(J,I))-TEMP) 590,590,585
585         K=J
            TEMP=ABS(A(J,I))
590     CONTINUE
        IF(K-I) 600,620,600
600     DO 610 J=I,KJ
            TEMP=A(I,J)
            A(I,J)=A(K,J)
            A(K,J)=TEMP
            Write(2,1010)11,I,J,A(I,J)
            Write(2,1010)12,K,J,A(K,J)
610     Continue
620     IF(A(I,I)) 640,639,640
639     A(I,I) = 0.001
        Write(*,1010)14,I,I,A(I,I)
        Write(2,1010)14,I,I,A(I,I)
640     TEMP=1./A(I,I)
        DO 650 J=I,KJ
650     A(I,J)=A(I,J)*TEMP
        DO 680 J= 1,L
            IF(I-J) 660,680,660
660         TEMP=A(J,I)
            DO 670 K=IP1,KJ
670         A(J,K)=A(J,K)-TEMP*A(I,K)
680 CONTINUE
    Write(30,700)JJ
    Write(*,700)JJ
    Write(2,700)JJ
700 FORMAT(37H LINEAR ELASTIC ANALYSIS OF TRUSS NO.,I5///)
    WRITE(30,730)ALPHA,TR
730 FORMAT(16H COEFF.EXPANSION,F11.8,10H TEMP RISE,F7.2//)
    Write(30,740)
740 FORMAT(23H THE JOINT DEFORMATIONS//)
    DO 870 I=1,NLS
        KL=L+I
        Write(30,*)'   '
        Write(30,750)LSN(I)
750     FORMAT(37H DISPLACEMENTS CAUSED BY LOAD SET NO., I3//)
        LL=0
        Write(30,771)
771     Format(        ' JOINT    X-DEFLECTION    Y-DEFLECTION   Z-DEFLECTION')
        DO 870 J=1,JCT
            IF(JTYPE(J,1)) 780,780,770
770         LL=LL+1
            AA=A(LL,KL)
            GO TO 790
780         AA = -0.
790         IF(JTYPE(J,2)) 810,810,800
800         LL=LL+1
            AB=A(LL,KL)
            GO TO 820
810         AB = -0.
820         IF(JJJ-2) 825,825,830
825         AC = 0.0
            GO TO 860
830         IF (JTYPE(J,3)) 850,850,840
840         LL=LL+1
            AC=A(LL,KL)
            GO TO 860
850         AC = -0.0
860         Write(30,861)J,AA,AB,AC
861         FORMAT(I8,F14.5,2F13.5)
870 CONTINUE
    DO 880 I=1,L
        DO 880 J=1,NLS
            K=L+J
880 DEFX(I,J)=A(I,K)
    ISW=-1
    GO TO 110
890 DO 900 I=1,NM
        TEMP=E*AREA(I)/OLEN(I)
        DO 900 J=1,L
900 A(J,I)=A(J,I)*TEMP
    DO 920 I=1,NM
        DO 920 J=1,NLS
            SR(I,J)=0.
            DO 920 K=1,L
920 SR(I,J)=SR(I,J)+A(K,I)*DEFX(K,J)
    IF(TR) 930,950,930
930 DO 940 I=1,NM
940 SR(I,1)=SR(I,1)-E*AREA(I)*ALPHA*TR
950 Write(3,*)'   '
    Write(3,960)
960 FORMAT(24H AXIAL FORCES IN MEMBERS//)
    DO 990 I=1,NLS
        Write(30,*)'   '
        Write(30,970),LSN(I)
        Write(30,*)'   '
970     FORMAT(38H AXIAL TENSIONS CAUSED BY LOAD SET NO., I3//)
        Write(30,*) ' MEMBER   AXIAL TENSION   STRESS'
        DO 990 J=1,NM
            STRS=SR(J,I)/AREA(J)
990 Write(30,991)J,SR(J,I),STRS
991 FORMAT(I8,F14.5,F11.3)
    Write(30,*)'    '
    
998 Write(*,*) ' ZERO DIVISION IN EQUATION SOLUTION'
999 Write(*,1001)JJ
1001 FORMAT(33H ANALYSIS COMPLETED FOR TRUSS NO.,I5////)
    GO TO 10
    Goto 1020
1000 Write(*,*)'Input Error'
1010 Format('Location : ', I4,' I : ',I4, '  J :', I4, '  A  ', F10.3)
1020 Write(*,1030)
1030 Format(' End program')
    close(1)
    close(2)
    close(30)
    end program Auxo

