C
C     Generalized program for OROWAN'S equation.
C
C     1973.11.12      H.Matsuno
C     1989. 7. 9      J.Yanagimoto
C
      PROGRAM MAIN
C
          COMMON /COM0  / XRV1(500),XRV2(500),ORV1(500),ORV2(500)
          COMMON /COM1  / PRV1(500),PRV2(500),FRV1(500),FRV2(500)
          COMMON /COM2  / TRV1(500),TRV2(500)
          COMMON /COM3  / X,O,NSIO,NSST,U,RK,A,W,PAI,H
          COMMON /COM4  / F,PM,PMK,SGX,SGXK,TAU,TAUK,PR
          COMMON /COM5  / NUM,NKM,XU(50),U0(50),XK(50),RK0(50)
          COMMON /COM6  / NEXT,NENT,NT1,NT2,NT0
          COMMON /COM7  / DH,H1,XL,OM,SUMP,SUMG,TAM
C
C ... Initialization.
      PAI= 3.14159265
      NPMAX= 10
C
C ... Data input.
      WRITE(6,1001)
      READ(5,*) R
      WRITE(6,1002)
      READ(5,*) H1,H2
      WRITE(6,1003)
      READ(5,*) SGB,SGF
      WRITE(6,1004)
      READ(5,*) NKM
      DO 1 I=1,NKM
      WRITE(6,1005) I
    1 READ(5,*) XK(I),RK0(I)
      WRITE(6,1006)
      READ(5,*) NUM
      DO 2 I=1,NUM
      WRITE(6,1007) I
    2 READ(5,*) XU(I),U0(I)
      WRITE(6,1009) R,H1,H2,SGF,SGB
C
C ... Data Initialization.
      DIA = 2.0*R
      FF  =-SGF*H2
      FB  =-SGB*H1
      DH  = H1-H2
      XL  = SQRT(R*DH-0.25*DH**2)
      OM  = ATAN(XL/(R-0.5*(H1-H2)))
      DQM = OM/400.
C
C ... Calculation from exit side.
      WRITE(6,1080)
      WRITE(6,2002)
      WRITE(6,1501)
      DQ  = DQM
      O   = 0.
      F   = FF
      FN  = F
      NSIO= 2
      NP  = NPMAX
      DO 50 I=1,500
      X= R*SIN(O)
      H= H2+ 2.0*R*(1.0-COS(O))
      CALL FRICTN(X,U)
      CALL DEFOM(X,RK)
      C1= -0.5/U
      C2= 1.0-0.25*PAI
      C3= 1.0+F/H/RK
      C4= SQRT(C1**2+4.0*C2*C3)
      A = 0.5*(C1+C4)/C2
      IF(A.GE.1.0) GO TO 10
      NSST= 1
      W= -C2*A**2+1.0
      IF(O.GT.0.0) GO TO 9
      C2= 1.0
      GO TO 8
    9 CONTINUE
      C1= SIN(O)/COS(O)
      C2= 1.0+U*(1.0/O-1.0/C1)
    8 CONTINUE
      PM= (FN/H+RK*W)/C2
      SGX= FN/H
      TAU= U*PM
      CALL OROSLP(F,FN,O,DQ,H,U,RK,W,DIA,NSIO)
      GO TO 20
   10 CONTINUE
      NSST= 2
      W= 0.25*PAI
      C1= SIN(O)/COS(O)
      IF(O.GT.0.0) GO TO 15
      C2= W
      GO TO 16
   15 CONTINUE
      C2= W-0.5*(1.0/O-1.0/C1)
   16 CONTINUE
      V= C2*SIN(O)+0.5*COS(O)
      PM= FN/H+RK*C2
      SGX= FN/H
      TAU= 0.5*RK
      CALL OROSTK(F,FN,O,DQ,H,U,RK,V,DIA,NSIO)
   20 CONTINUE
      PRV2(I)= PM
      FRV2(I)= F
      TRV2(I)= TAU
      XRV2(I)= X
      ORV2(I)= O
      IF(NP.LT.NPMAX) GO TO 30
      CALL PRINT1
      NP= 0
   30 CONTINUE
      F= FN
      O= O+DQ
      IF(O.GE.OM) GO TO 41
      NP= NP+1
   50 CONTINUE
   41 CONTINUE
      NEXT= I
C
C ... Calculation from entry side.
      WRITE(6,2001)
      WRITE(6,1501)
      DQ  = DQM
      O   = OM
      F   = FB
      FN  = F
      NSIO= 1
      NP  = NPMAX
      DO 150 I=1,500
      X= R*SIN(O)
      H= H2+ 2.0*R*(1.0-COS(O))
      CALL DEFOM(X,RK)
      CALL FRICTN(X,U)
      C1= -0.5/U
      C2= 1.0-0.25*PAI
      C3= 1.0+F/H/RK
      C4= SQRT(C1**2+4.0*C2*C3)
      A = 0.5*(C1+C4)/C2
      IF(A.GE.1.0) GO TO 110
      NSST= 1
      W= -C2*A**2+1.0
      IF(O.GT.0.0) GO TO 109
      C2= 1.0
      GO TO 108
  109 CONTINUE
      C1= SIN(O)/COS(O)
      C2= 1.0+U*(1.0/O-1.0/C1)
  108 CONTINUE
      PM= (FN/H+RK*W)/C2
      SGX= FN/H
      TAU= U*PM
      U= -U
      DQ= -DQ
      CALL OROSLP(F,FN,O,DQ,H,U,RK,W,DIA,NSIO)
      DQ= -DQ
      U= -U
      GO TO 120
  110 CONTINUE
      NSST= 2
      W= 0.25*PAI
      C1= SIN(O)/COS(O)
      IF(O.GT.0.0) GO TO 115
      C2= W
      GO TO 116
  115 CONTINUE
      C2= W+0.5*(1.0/O-1.0/C1)
  116 CONTINUE
      V= C2*SIN(O)-0.5*COS(O)
      U= -U
      DQ= -DQ
      PM= FN/H+RK*C2
      SGX= FN/H
      TAU= 0.5*RK
      CALL OROSTK(F,FN,O,DQ,H,U,RK,V,DIA,NSIO)
      DQ= -DQ
      U= -U
  120 CONTINUE
      PRV1(I)= PM
      FRV1(I)= F
      TRV1(I)= TAU
      XRV1(I)= X
      ORV1(I)= O
      IF(NP.LT.NPMAX) GO TO 130
      CALL PRINT1
      NP= 0
  130 CONTINUE
      F= FN
      O= O-DQ
      IF(O.LE.0.0) GO TO 141
      NP= NP+ 1
  150 CONTINUE
  141 CONTINUE
      NENT= I
      CALL SERCH
C
C ... Format statements.
 1001 FORMAT(///' *** Generalized program for OROWAN-S equation.***',
     *        //'   ... Enter roll radius.')
 1002 FORMAT( //'   ... Enter strip thickness before & after rolling.')
 1003 FORMAT( //'   ... Enter back & front tension of strip.')
 1004 FORMAT( //'   ... Enter number of intervals for yield stress.')
 1005 FORMAT(   '     ... Enter X-co. & yield stress for pnt.no.',I3)
 1006 FORMAT( //'   ... Enter number of intervals for fric. coeff.')
 1007 FORMAT(   '     ... Enter X-co. & fric. coeff. for pnt.no.',I3)
 1009 FORMAT( //' *** Input data ***',
     *        //'       Roll radius R=',F10.4,'(mm)',
     *         /'       Thickness of strip H1,H2=',2F10.4,'(mm)',
     *         /'       Front and back tensions SGF,SGB=',2F10.4,
     *          '(kgf/mm2)')
 1080 FORMAT(///' *** CALCULATED RESULT -- 1 ***')
 2001 FORMAT(///T5,' *** Stress distribution on entry side.***'/)
 2002 FORMAT(///T5,' *** Stress distribution on exit side.***'/)
 1501 FORMAT(T15,  'X', T23,  'O', T29,'SL/ST', T42,  'F', T50,'P',
     *       T57,'P/K', T66,'SGX', T72,'SGX/K', T81,'TAU',
     *       T94,  'H',T102,  'U',T109,   'RK',T118,  'A',T126,'W')
C
      STOP
      END
C
C   SUBR. OROSLP
      SUBROUTINE OROSLP(F,FN,O,DQ,H,U,RK,W,DIA,NSIO)
C
C *** Subroutine for orowan slipping.***
C
      FS= F
      OS= O
      CALL FNSLIP(FS,FNS,OS,H,U,RK,W,DIA,NSIO)
      C0= DQ*FNS
      OS= O+0.5*DQ
      FS= F+0.5*C0
      CALL FNSLIP(FS,FNS,OS,H,U,RK,W,DIA,NSIO)
      C1= DQ*FNS
      OS= O+0.5*DQ
      FS= F-0.5*C0+C1
      CALL FNSLIP(FS,FNS,OS,H,U,RK,W,DIA,NSIO)
      C2= DQ*FNS
      OS= O+1.0*DQ
      FS= F+0.5*C1+0.5*C2
      CALL FNSLIP(FS,FNS,OS,H,U,RK,W,DIA,NSIO)
      C3= DQ*FNS
      C4= 0.5*C0+1.5*C1+0.5*C2+0.5*C3
      FN= F+C4/3.0
      RETURN
      END
C
C   SUBR. FNSLIP
      SUBROUTINE FNSLIP(FS,FNS,OS,H,U,RK,W,DIA,NSIO)
C
C *** Subroutine for slipping function.***
C
      C1= SIN(OS)+U*COS(OS)
      C2= FS*DIA*C1/H
      C3= DIA*RK*W*C1
      FNS= C2+C3
      IF(OS.GT.0.0) GO TO 10
      C2= 1.0
      GO TO 11
   10 CONTINUE
      C1= SIN(OS)/COS(OS)
      C2= 1.0+U*(1.0/OS-1.0/C1)
   11 CONTINUE
      FNS= FNS/C2
      RETURN
      END
C
C   SUBR. OROSTK
      SUBROUTINE OROSTK(F,FN,O,DQ,H,U,RK,W,DIA,NSIO)
C
C *** Subroutine for orowan sticking.***
C
      FS= F
      OS= O
      CALL FNSTIK(FS,FNS,OS,H,U,RK,W,DIA,NSIO)
      C0= DQ*FNS
      OS= O+0.5*DQ
      FS= F+0.5*C0
      CALL FNSTIK(FS,FNS,OS,H,U,RK,W,DIA,NSIO)
      C1= DQ*FNS
      OS= O+0.5*DQ
      FS= F-0.5*C0+C1
      CALL FNSTIK(FS,FNS,OS,H,U,RK,W,DIA,NSIO)
      C2= DQ*FNS
      OS= O+1.0*DQ
      FS= F+0.5*C1+0.5*C2
      CALL FNSTIK(FS,FNS,OS,H,U,RK,W,DIA,NSIO)
      C3= DQ*FNS
      C4= 0.5*C0+1.5*C1+0.5*C2+0.5*C3
      FN= F+C4/3.0
      RETURN
      END
C
C   SUBR. FNSTIK
      SUBROUTINE FNSTIK(FS,FNS,OS,H,U,RK,W,DIA,NSIO)
C
C *** Subroutine for sticking function.***
C
      C1= SIN(OS)
      C2= FS*DIA*C1/H
      C3= DIA*RK*W
      FNS= C2+C3
      RETURN
      END
C
C   SUBR. FRICTN
      SUBROUTINE FRICTN(X,U)
C
          COMMON /COM5  / NUM,NKM,XU(50),U0(50),XK(50),RK0(50)
C
      DO 10 I=1,NUM
      U= 0.1
      IF(X.LT.XU(I  )) GO TO 10
      IF(X.GE.XU(I+1)) GO TO 10
      C1= (U0(I+1)-U0(I))/(XU(I+1)-XU(I))
      U= U0(I)+C1*(X-XU(I))
      U= ABS(U)
      GO TO 20
   10 CONTINUE
   20 CONTINUE
      RETURN
      END
C
C   SUBR. DEFOM
      SUBROUTINE DEFOM(X,RK)
C
          COMMON /COM5  / NUM,NKM,XU(50),U0(50),XK(50),RK0(50)
C
      DO 10 I=1,NKM
      RK= 20.0
      IF(X.LT.XK(I  )) GO TO 10
      IF(X.GE.XK(I+1)) GO TO 10
      C1= (RK0(I+1)-RK0(I))/(XK(I+1)-XK(I))
      RK= RK0(I)+C1*(X-XK(I))
      GO TO 20
   10 CONTINUE
   20 CONTINUE
      RETURN
      END
C
C   SUBR. PRINT1
      SUBROUTINE PRINT1
C
          COMMON /COM3  / X,O,NSIO,NSST,U,RK,A,W,PAI,H
          COMMON /COM4  / F,PM,PMK,SGX,SGXK,TAU,TAUK,PR
C
      PMK= PM/RK
      SGXK= SGX/RK
      TAUK= TAU/RK
      OS= 180.0*O/PAI
      WRITE(6,100) X,OS,NSST,F,PM,PMK,SGX,SGXK,TAU,H,U,RK,A,W
  100 FORMAT(T10,2F8.2,I6,5X,2F8.2,F8.3,F8.2,F8.3,F8.2,
     *       4X,F8.2,F8.3,2F8.2,F8.3)
      RETURN
      END
C
C   SUBR. SERCH
      SUBROUTINE SERCH
C
          COMMON /COM0  / XRV1(500),XRV2(500),ORV1(500),ORV2(500)
          COMMON /COM1  / PRV1(500),PRV2(500),FRV1(500),FRV2(500)
          COMMON /COM2  / TRV1(500),TRV2(500)
          COMMON /COM4  / F,PM,PMK,SGX,SGXK,TAU,TAUK,PR
          COMMON /COM6  / NEXT,NENT,NT1,NT2,NT0
          COMMON /COM7  / DH,H1,XL,OM,SUMP,SUMG,TAM
C
      NT0= 0
      DO 10 I=1,NEXT
      J= NENT-I+1
      DF= FRV1(J)-FRV2(I)
      IF(DF.GT.0.0) GO TO 10
      GO TO 20
   10 CONTINUE
      NT0= 1
      GO TO 30
   20 CONTINUE
      NT1= J
      NT2= I
      IF(NT2.NE.1) GO TO 40
      IF(DF.GE.-0.01) GO TO 40
      NT0= 1
      GO TO 30
   40 CONTINUE
      NT1= NT1-1
      SUMP1= 0.0
      SUMG1= 0.0
      IF(NT1.EQ.0) GO TO 50
      DO 60 I=1,NT1
      SUMP1= SUMP1+PRV1(I)*(XRV1(I)-XRV1(I+1))
      SUMG1= SUMG1+PRV1(I)*(XRV1(I)-XRV1(I+1))*XRV1(I)
   60 CONTINUE
   50 CONTINUE
      SUMP2= 0.0
      SUMG2= 0.0
      DO 70 I=1,NT2
      SUMP2= SUMP2+PRV2(I)*(XRV2(I+1)-XRV2(I))
      SUMG2= SUMG2+PRV2(I)*(XRV2(I+1)-XRV2(I))*XRV2(I)
   70 CONTINUE
      SUMP= SUMP1+SUMP2
      SUMG= 2.0*(SUMG1+SUMG2)/1000.0
      TAM= 1000.0*SUMG/(2.0*SUMP)
      PM= (SUMP1+SUMP2)/XL
   30 CONTINUE
      CALL PRINT2
      RETURN
      END
C
C   SUBR. PRINT2
      SUBROUTINE PRINT2
C
          COMMON /COM0  / XRV1(500),XRV2(500),ORV1(500),ORV2(500)
          COMMON /COM1  / PRV1(500),PRV2(500),FRV1(500),FRV2(500)
          COMMON /COM2  / TRV1(500),TRV2(500)
          COMMON /COM3  / X,O,NSIO,NSST,U,RK,A,W,PAI,H
          COMMON /COM4  / F,PM,PMK,SGX,SGXK,TAU,TAUK,PR
          COMMON /COM6  / NEXT,NENT,NT1,NT2,NT0
          COMMON /COM7  / DH,H1,XL,OM,SUMP,SUMG,TAM
C
      RS= DH/H1
      OMS= 180.0*OM/PAI
      ON= ORV2(NT2)
      ON= 180.0*ON/PAI
      XN= XRV2(NT2)
      WRITE(6,100)
  100 FORMAT(///'*** CALCULATED RESULT -- 2 ***'///)
      IF(NT0.EQ.1) GO TO 10
      WRITE(6,110)
  110 FORMAT(T10,'* REDUCTION RATIO')
      WRITE(6,111) RS
  111 FORMAT(T14,'R',F8.3,'  (--)'/)
      WRITE(6,120)
  120 FORMAT(T10,'* CONTACT LENGTH')
      WRITE(6,121) XL,OMS
  121 FORMAT(T14,'XL',F8.2,'  (MM)',4X,'OM',F8.2,'  (DEGREE)'/)
      WRITE(6,130)
  130 FORMAT(T10,'* NEUTRAL POINT')
      WRITE(6,131) XN,ON
  131 FORMAT(T14,'XN',F8.2,'  (MM)',4X,'ON',F8.2,'  (DEGREE)'/)
      C1= FRV2(NT2)
      C2= PRV2(NT2)
      WRITE(6,135)
  135 FORMAT(T10,'* NEUTRAL POINT PRESSURE')
      WRITE(6,136) C1,C2
  136 FORMAT(T14,'F',F8.2,'  (KG/MM)',4X,'P',F8.3,'  (KG/MM2)'/)
      WRITE(6,140)
  140 FORMAT(T10,'* MEAN ROLL PRESSURE')
      WRITE(6,141) PM
  141 FORMAT(T14,'PM',F8.2,'  (KG/MM2)'/)
      WRITE(6,150)
  150 FORMAT(T10,'* ROLLING FORCE AND TORQUE')
      WRITE(6,151) SUMP,SUMG
  151 FORMAT(T14,'P',F8.2,'  (T/M)',4X,'G',F8.3,'  (T-M/M)'/)
      WRITE(6,160)
  160 FORMAT(T10,'* TORQUE ARM')
      WRITE(6,161) TAM
  161 FORMAT(T14,'A',F8.3,'  (MM)'/)
      GO TO 20
   10 CONTINUE
      WRITE(6,170)
  170 FORMAT(T10,'* NO NEUTRAL POINT')
   20 CONTINUE
      RETURN
      END