PROGRAM SUSPEND
      REAL KX
C
      CALL KOPF
C
C     INPUT OF PARAMETERS
      CALL swahl0(EK,G1X,D1X,G2X)
C
C
C
C     MENUE
C
   99 WRITE(*,100)
  100 FORMAT(1H1,////////////'       (C) INSTITUT FUER HOCHFREQUENZ',
     1'TECHNIK UNIVERSITAET STUTTGART FRG',/'                         ',
     2'      F. ENDRESS / U. BOCHTLER',///'                  S U S ',
     3'P E N D E D   S U B S T R A T E',///,
     4'                      SELECT ACTIVITY :',///,
     5'            0   INPUT: NEW PARAMETERS',//,
     6'            1   ANALYSIS OF A SINGLE LINE',//,
     7'            2   SYNTHESIS OF A SINGLE LINE',//,
     8'            3   ANALYSIS OF A COUPLER',//,
     9'            4   SYNTHESIS OF A COUPLER',//,
     1'            5   END OF PROGRAM',///)
      READ(*,120) IA
  120 FORMAT(I4)
      A=IA*1.0
      IF(A.EQ.5) GOTO 2
      IF(A.EQ.0) CALL swahl0(EK,G1X,D1X,G2X)
      IF(A.EQ.1) CALL swahl1(EK,G1X,D1X,G2X)
      IF(A.EQ.2) CALL swahl2(EK,G1X,D1X,G2X)
      IF(A.EQ.3) CALL swahl3(EK,G1X,D1X,G2X)
      IF(A.EQ.4) CALL swahl4(EK,G1X,D1X,G2X)
      GOTO 99
    2 CONTINUE
      STOP
      END
C
C
C     INITIAL TEXT
C
      SUBROUTINE KOPF
      WRITE(*,100)
  100 FORMAT(1H1,////////////'       (C) INSTITUT FUER HOCHFREQUENZ',
     1'TECHNIK UNIVERSITAET STUTTGART, FRG',/'                       ',
     2'      F. ENDRESS / U. BOCHTLER',///'                  S U S ',
     3'P E N D E D   S U B S T R A T E',///' PROGRAM FOR DETERMINATION',
     4' OF CHARACTERISTIC IMPEDANCE AND GEOMETRIC',/' DIMENSIONS OF A',
     5' SUSPENDED-SUBSTRATE-LINE. THE  LINE IS SUSPENDED IN THE'/,
     6' MIDDLE OF A HOUSING. WITH ANALYSIS AND SYNTHESIS YOU WILL GET',
     7' SINGLE-LINES',/' AND LINE-COUPLERS. YOU CAN CHOSE YOUR OWN',
     8' PARAMETERS OR IMPLEMENTED SETS OF',/' PARAMETERS BELONGING',
     9' TO DIFFERENT SUBSTRATES.                                    ',
     2'                       ',/'        '/,
     9' LITERATURE:      J.SMITH, THE EVEN- AND ODD-MODE CAPACITANCE',/
     7'                  PARAMETERS FOR COUPLED LINES IN SUSPENDED',/
     2'                  SUBSTRATE, IEEE, MTT 1971, PP 424-431',/
     2///' CONTINUE WITH: 1',
     3' <RETURN>'//)
      READ(*,120) IA
  120 FORMAT(I4)
      A=IA*1.0
      RETURN
      END
C
C
C     WAHL 0: INPUT NEW PARAMETERS

C     D1X:    THICKNESS OF SUBSTRATE
C     EK:     REL. PERMITTIVITY OF SUSTRATE
C     G1X:    DISTANCE SUBSTRATE  -  BOTTOM GROUND-PLANE
C     G2X:    DISTANCE LINE  -  TOP GROUND-PLANE
C
      SUBROUTINE swahl0(EK,G1X,D1X,G2X)
      CALL WYY(B)
      IF(B.EQ.2) GOTO 1
      CALL WHL0(EK,G1X,D1X,G2X)
      GOTO 2
    1 CALL WAHL1(EK,G1X,D1X,G2X)
    2 RETURN
      END
      SUBROUTINE WHL0(EK,G1X,D1X,G2X)
      WRITE(*,100)
  100 FORMAT(1H1,///////////////'  PLEASE ENTER YOUR PARAMETERS   ',///)
      WRITE(*,103)
  103 FORMAT(1H ,' PERMITTIVITY OF SUBSTRATE             ER='\)
      READ(*,120) EK
      WRITE(*,105)
  105 FORMAT(1H ,' DISTANCE TO TOP GROUND-PLANE IN MM   G2X='\)
      READ(*,120) G2X
      WRITE(*,106)
  106 FORMAT(1H ,' DISTANCE TO BOTTOM PLANE IN MM       G1X='\)
      READ(*,120) G1X
      WRITE(*,107)
  107 FORMAT(1H ,' THICKNESS OF SUBSTRATE IN MM         D1X='\)
      READ(*,120) D1X
  120 FORMAT(F14.7)
      RETURN
      END
C
C
C     OWN OR IMPLEMENTED PARAMETERS ?
C
      SUBROUTINE WYY(B)
      WRITE(*,100)
  100 FORMAT(1H1,///////////////'            SELECT ACTIVITY:     :',
     1'     INPUT OF....'////'                  <1>',
     2'     OWN PARAMETERS       ',/////'                  <2>',
     3'    IMPLEMENTED PARAMETERS     ?'///////' PLEASE ENTER  :',///)
      READ(*,120) IB
  120 FORMAT(I4)
      B=IB*1.0
      RETURN
      END
C
C
C     IMPLEMENTED SETS OF PARAMETERS
C
C     D1X:    THICKNESS OF SUBSTRATE
C     EK:     RELATIVE PERMITTIVITY
C     G1X:    DISTANCE SUBSTRATE  -  BOTTOM GROUND-PLANE
C     G2X:    DISTANCE LINE  -  TOP GROUND-PLANE
C
      SUBROUTINE WAHL1(EK,G1X,D1X,G2X)
      REAL EK,G1X,G2X,D1X
      DIMENSION PARAM(4,10)
C     EACH OF THE FOLLOWING LINES IS ONE SET OF PARAMETERS
C     ORDER: EK,G1X,D1X,G2X
C     IF YOU ADD A NEW SET YOU SHOULD INCREMENT II
      DATA PARAM(1,1),param(2,1),param(3,1),param(4,1)
     1/9.9,0.4325,0.635,0.4325/
      DATA PARAM(1,2),param(2,2),param(3,2),param(4,2)
     1/9.9,0.683,0.635,0.683/
      DATA PARAM(1,3),param(2,3),param(3,3),param(4,3)
     1/2.2,1.0,1.27,1.0/
      DATA PARAM(1,4),param(2,4),param(3,4),param(4,4)
     1/6.0,1.0,1.270,1.0/
      DATA PARAM(1,5),param(2,5),param(3,5),param(4,5)
     1/10.5,0.4325,0.635,0.4325/
      II=5
      WRITE (*,100)
  100 FORMAT(1H1,///////////////'                PARAMETERS   ',/)
      WRITE(*,103)
  103 FORMAT(1H ,' PERMITTIVITY OF SUBSTRATE                   ER')
      WRITE(*,105)
  105 FORMAT(1H ,' DISTANCE TO TOP GROUND-PLANE IN MM         G2X')
      WRITE(*,106)
  106 FORMAT(1H ,' DISTANCE TO BOTTOM GROUND-PLANE IN MM      G1X')
      WRITE(*,107)
  107 FORMAT(1H ,' THICKNESS OF SUBSTRATE IN MM               D1X',//,)
      I=1
   99 WRITE(*,98) I,PARAM(1,I),PARAM(2,I),PARAM(3,I),PARAM(4,I)
   98 FORMAT(1H ,' SET: ',I2,'       ER=',F7.4,'       G1X=',F7.4,
     1'      D1X=',F7.4,'      G2X=',F7.4,)
      I=I+1
      IF(I.LE.II) GOTO 99
      WRITE(*,108)
  108 FORMAT(1H ,////' SELECTED:            '///)
      READ(*,120) NWAHL
  120 FORMAT(I4)
      EK=PARAM(1,NWAHL)
      G1X=PARAM(2,NWAHL)
      D1X=PARAM(3,NWAHL)
      G2X=PARAM(4,NWAHL)
      RETURN
      END
C
C
C
C     WAHL 1: ANALYSIS OF A SINGLE LINE
C
C     D1X:    THICKNESS OF SUBSTRATE
C     EK:     RELATIVE PERMITTIVITY
C     G1X:    DISTANCE SUBSTRATE  -  BOTTOM GROUND-PLANE
C     G2X:    DISTANCE LINE  -  TOP GROUND-PLANE
C
      SUBROUTINE swahl1(EK,G1X,D1X,G2X)
      INEXT=0
    1 CONTINUE
      CALL EINGB1(WX)
      CALL SINLIN(WX,EK,G1X,D1X,G2X,CX,EKE,ZLX)
      CALL AUSGB1(ZLX,CX,EKE,WX,INEXT)
      IF (INEXT.EQ.1) GOTO 1
      RETURN
      END
C
C
C     INPUT OF LINE-WIDTH
C
      SUBROUTINE EINGB1(WX)
      WRITE(*,101)
  101 FORMAT(1H ,////' LINE-WIDTH IN MM                       WX='\)
      READ(*,120) WX
  120 FORMAT(F14.7)
      RETURN
      END
C
C
C
C     OUTPUT OF COMPUTED VALUES:
C
C     CX:    CAPACITANCE IN PF/CM
C     EKE:   EFFECTIVE REL.PERMITTIVITY OF SUBSTRATE
C     WX:    LINE-WIDTH
C     ZLX:   CHARACTERISTIC IMPEDANCE IN OHM
C
      SUBROUTINE AUSGB1(ZLX,CX,EKE,WX,INEXT)
      WRITE(*,100) WX,ZLX,CX,EKE
  100 FORMAT(1H ,//'  LINE-WIDTH IN MM                     W = ',F12.4/,
     1'  CHARACTERISTIC IMPEDANCE             Z = ',F12.1,' OHM',/,
     2'  CAPACITANCE PER UNIT LENGTH          C = ',F12.4,' PF/CM',/,
     3'  EFFECTIVE PERMITTIVITY                 = ',F12.4,//,
     4' NEW VALUES <1>  ,  BACK TO MENUE <0> '//)
      READ(*,120) INEXT
  120 FORMAT(I4)
      RETURN
      END
C
C
C
C     WAHL 2: SYNTHESIS OF A SINGLE LINE
C
C     D1X:    THICKNESS OF SUBSTRATE
C     EK:     RELATIVE PERMITTIVITY
C     G1X:    DISTANCE SUBSTRATE  -  BOTTOM GROUND-PLANE
C     G2X:    DISTANCE LINE  -  TOP GROUND-PLANE
C
      SUBROUTINE swahl2(EK,G1X,D1X,G2X)
      INEXT=0
    1 CONTINUE
      Q=0
      CALL EINGB2(ZLS)
      CALL ITERAT(ZLS,EK,G1X,D1X,G2X,ZLX,CX,EKE,WX,Q)
      IF (Q.EQ.0) GOTO 2
      WRITE(*,100)
  100 FORMAT(1H ,'   COMPUTATION NOT POSSIBLE   ! '//)
    2 CALL AUSGB2(ZLX,CX,EKE,WX,INEXT)
      IF (INEXT.EQ.1) GOTO 1
      RETURN
      END
C
C
C     INPUT OF PARAMETERS
C
      SUBROUTINE EINGB2(ZLS)
      WRITE(*,101)
  101 FORMAT(1H ,/////' DESIRED CHARACTERISTIC IMPEDANCE         ZL='\)
      READ(*,120) ZLS
  120 FORMAT(F14.7)
      RETURN
      END
C
C
C     SUBROUTINE: ITERATIVE COMPUTATION OF CHARACTERISTIC IMPEDANCE
C
C     D1X:    THICKNESS OF SUBSTRATE
C     EK:     REL.PERMITTIVITY OF SUBSTRATE
C     EKE:    EFF.    '           '   '
C     GX:     GAP WIDTH
C     G1X:    DISTANCE SUBSTRATE  -  BOTTOM GROUND-PLANE
C     G2X:    DISTANCE LINE  -  TOP GROUND-PLANE
C     WX:     LINE WIDTH
C     ZLS:    DESIRED -CHARACTERISTIC IMPEDANCE IN OHM
C     ZLX:    CHARACTERISTIC IMPEDANCE IN OHM
C
      SUBROUTINE ITERAT(ZLS,EK,G1X,D1X,G2X,ZLX,CX,EKE,WX,Q)
      XL=0.01
      XR=6.0
      DELTA=0.05
      CALL SINLIN(XR,EK,G1X,D1X,G2X,CX,EKE,ZLX)
      FXR=ZLX-ZLS
      CALL SINLIN(XL,EK,G1X,D1X,G2X,CX,EKE,ZLX)
      FXL=ZLX-ZLS
      IF(FXL*FXR.LT.0.0) GOTO 1
      Q=1
      RETURN
    1 X=XR-(XR-XL)/2.
      CALL SINLIN(X,EK,G1X,D1X,G2X,CX,EKE,ZLX)
      FX=ZLX-ZLS
      IF(ABS(FX).LT.DELTA) GOTO 2
      IF(FX*FXR.LT.0.0) GOTO 3
      XR=X
      FXR=FX
      GOTO 1
    3 XL=X
      FXL=FX
      GOTO 1
    2 WX=X
      RETURN
      END
C
C
C
C     OUTPUT OF COMPUTED VALUES , WAHL 2
C
C     CX:    CAPACITANCE IN PF/CM
C     EKE:   EFFECTIVE REL.PERMITTIVITY OF SUBSTRATE
C     WX:    LINE-WIDTH
C     ZLX:   CHARACTERISTIC IMPEDANCE IN OHM
C
      SUBROUTINE AUSGB2(ZLX,CX,EKE,WX,INEXT)
      WRITE(*,100) WX,ZLX,CX,EKE
  100 FORMAT(1H ,//'  LINE-WIDTH IN MM                   W = ',F12.4/,
     1'  CHARACTERISTIC IMPEDANCE           Z = ',F12.1,' OHM',/,
     2'  CAPACITANCE PER UNIT LENGTH        C = ',F12.4,' PF/CM',/,
     3'  EFFECTIVE PERMITTIVITY               = ',F12.4,//,
     4' NEW VALUES <1>  ,  BACK TO MENUE <0> '/)
      READ(*,120) INEXT
  120 FORMAT(I4)
      RETURN
      END
C
C
C
C     WAHL 3: ANALYSIS OF A STRIPLINE-COUPLER
C
C     D1X:    THICKNESS OF SUBSTRATE
C     EK:     RELATIVE PERMITTIVITY
C     G1X:    DISTANCE SUBSTRATE  -  BOTTOM GROUND-PLANE
C     G2X:    DISTANCE LINE  -  TOP GROUND-PLANE
C
      SUBROUTINE swahl3(EK,G1X,D1X,G2X)
      REAL KX
   44 CALL EINGB3(WX,GX)
      CALL TWOLIN(WX,GX,EK,G1X,D1X,G2X,EKEO,EKEE,ZOX,ZEX,
     1ZLX,KX,COX,CEX)
      EKE=SQRT(EKEO*EKEE)
      CALL AUSGB3(ZLX,ZEX,ZOX,WX,GX,A,KX,EKE,EKEO,EKEE)
      IF(A.EQ.1) GOTO 44
      RETURN
      END
C
C
C     INPUT ,  WAHL 3
C
      SUBROUTINE EINGB3(WX,GX)
      REAL KX
      WRITE(*,100)
  100 FORMAT(1H1,/////////////////'                PLEASE ENTER:',//)
    2 WRITE (*,105)
  105 FORMAT(1H ,'  LINE WIDTH IN MM                  WX='\)
      READ(*,120) WX
      IF(WX.GT.0.005) GOTO 3
      WRITE(*,107)
  107 FORMAT(1H ,//' ETCHING NOT POSSIBLE !!'//)
      GOTO 2
    3 WRITE (*,106)
  106 FORMAT(1H ,'  GAP WIDTH IN MM                   GX='\)
      READ(*,120) GX
  120 FORMAT(F14.7)
      IF(GX.GT.0.005) GOTO 4
      WRITE(*,108)
  108 FORMAT(1H ,//' ETCHING NOT POSSIBLE !!'//)
      GOTO 3
    4 RETURN
      END
C
C
C     OUTPUT OF COMPUTED VALUES
C
      SUBROUTINE AUSGB3(ZLX,ZEX,ZOX,WX,GX,A,KX,EKE,EKEO,EKEE)
      REAL KX
      WRITE (*,100) ZLX,ZEX,ZOX,KX,WX,GX,EKEE,EKEO,EKE
  100 FORMAT(1H ,//////////'             RESULTS:          ',///,
     1'         CHARACTERISTIC IMPEDAMCE        ZL=',F12.4/,
     1'              > EVEN MODE                ZE=',F12.4/,
     1'              > ODD MODE                 ZO=',F12.4/,
     1'         COUPLING COEFFICIENT             K=',F12.4/,
     2'         LINE-WIDTH                       W=',F12.4/,
     3'         GAP-WIDTH                        G=',F12.4/,
     9'         EPPS EFF EVEN MODE              EE=',F12.4/,
     8'         EPPS EFF ODD MODE               EO=',F12.4/,
     2'         EPPS EFF AVERAGE                ER=',F12.4/,
     4///' NEW VALUES <1>  ,  BACK TO MENUE <0>'////)
      READ(*,120) IA
  120 FORMAT(I4)
      A=IA*1.0
      RETURN
      END
C
C
C     WAHL 4:  SYNTHESIS OF A STRIPLINE-COUPLER
C
C     D1X:    THICKNESS OF SUBSTRATE
C     EK:     RELATIVE PERMITTIVITY
C     G1X:    DISTANCE SUBSTRATE  -  BOTTOM GROUND-PLANE
C     G2X:    DISTANCE LINE  -  TOP GROUND-PLANE
C
      SUBROUTINE swahl4(EK,G1X,D1X,G2X)
      REAL KX
   44 CALL EINGB4(ZLX,KX,ZEXS,ZOXS,WX,GX)
      IS=1
      IF(ABS(ZEXS/ZOXS-1).GT.0.05) GOTO 45
      WRITE (*,99)
   99 FORMAT(1H ,///' COUPLING COEFFICIENT TOO SMALL PLEASE USE A S',
     1' INGLE LINE           '//'         ! ',///,
     2' NEW VALUES <1>  ,  BACK TO MENUE <0>',///)
      READ(*,120) IA
      A=IA*1.0
      IF(A.EQ.0) RETURN
      GOTO 44
   45 CALL STARTW(ZLS,EK,G1X,D1X,G2X,ZLX,CX,EKE,WX,GX,
     1ZOXS,ZEXS)
      CALL TWOLIN(WX,GX,EK,G1X,D1X,G2X,EKEO,EKEE,ZOX,ZEX,ZLX,
     1KX,COX,CEX)
      EKE=SQRT(EKEO*EKEE)
      CALL AUSGB4(ZLX,ZEX,ZOX,WX,GX,A,KX,EKE,EKEE,EKEO,IS)
      GOTO 17
   17 CONTINUE
   19 IS=IS+1
      IF(IS.EQ.10)GOTO 23
      CALL IKERAT(EK,ZEXS,ZOXS,ZEX,ZOX,WX,GX,WXST,GXST,
     1G1X,D1X,G2X)
      CALL TWOLIN(WX,GX,EK,G1X,D1X,G2X,EKEO,EKEE,ZOX,ZEX,ZLX,
     1KX,COX,CEX)
      CALL AUSGB4(ZLX,ZEX,ZOX,WX,GX,A,KX,EKE,EKEE,EKEO,IS)
      IF(ABS(ZOXS/ZOX-1).GT.0.002) GOTO 19
      IF(ABS(ZEXS/ZEX-1).GT.0.002) GOTO 19
      GOTO27
   23 WRITE(*,100)
  100 FORMAT(1H ,' TIME OUT AFTER 10 ITERATIONS-STEPS')
      EKE=(1/(ZOX*ZEX)*(ZOXS*SQRT(EKEO)+ZEXS*SQRT(EKEE)))**2
   27 CALL AUSGB4(ZLX,ZEX,ZOX,WX,GX,A,KX,EKE,EKEE,EKEO,IS)
      WRITE (*,101)
  101 FORMAT(1H ,///' NEW VALUES <1>  ,  BACK TO MENUE <0>'////)
      READ(*,120) IA
  120 FORMAT(I4)
      A=IA*1.0
      IF(A.EQ.1) GOTO 44
      RETURN
      END
C
C
C     ITERATION-PROCEDURE  STRIPLINECOUPLER
C
C     D1X:    THICKNESS OF SUBSTRATE
C     EK:     REL.PERMITTIVITY OF SUBSTRATE
C     GX:     GAP WIDTH
C     GXST:   START-GAP WIDTH
C     G1X:    DISTANCE SUBSTRATE  -  BOTTOM GROUND-PLANE
C     G2X:    DISTANCE LINE  -  TOP GROUND-PLANE
C     WX:     LINE-WIDTH
C     WXST:   START-LINE-WIDTH
C     ZEX:    EVEN MODE CHARACTERISTIC IMPEDANCE
C     ZEXS:   DESIRED EVEN MODE CHARACTERISTIC IMPEDANCE
C     ZOX:    ODD MODE CHARACTERISTIC IMPEDANCE
C     ZOXS:   DESIRED ODD MODE CHARACTERISTIC IMPEDANCE
C
      SUBROUTINE IKERAT(EK,ZEXS,ZOXS,ZEX,ZOX,WX,GX,WXST,GXST,
     1G1X,D1X,G2X)
      CALL TWOLIN(1.02*WX,GX,EK,G1X,D1X,G2X,EKEO,EKEE,DZOX,DZEX,ZLX,
     1KX,COX,CEX)
      XWX=DZOX-ZOX
      XWY=DZEX-ZEX
      CALL TWOLIN(WX,1.02*GX,EK,G1X,D1X,G2X,EKEO,EKEE,DZOX,DZEX,ZLX,
     1KX,COX,CEX)
      XSX=DZOX-ZOX
      XSY=DZEX-ZEX
      XZX=ZOXS-ZOX
      XZY=ZEXS-ZEX
      A1=(XZX*XSY-XZY*XSX)/(XWX*XSY-XWY*XSX)
      A2=(XZX*XWY-XZY*XWX)/(XSX*XWY-XSY*XWX)
      WX=WX*(1+A1/50.0)
      GX=GX*(1+A2/50.0)
      IF(WX.LT.0.05) WX=0.05
      IF(WX.GT.15.0) WX=15.0
      IF(GX.LT.0.01) GX=0.01
      RETURN
      END
C
C
C     COMPUTATION INITIAL VALUE
C
C     CEX:    EVEN MODE CAPACITANCE
C     COX:    CAPACITANCE IM ODD MODEFALL
C     D1X:    THICKNESS OF SUBSTRATE
C     EK:     REL.PERMITTIVITY OF SUBSTRATE
C     EKE:    EFF.    '           '   '
C     GX:     GAP WIDTH
C     GXST:   START-GAP WIDTH
C     G1X:    DISTANCE SUBSTRATE  -  BOTTOM GROUND-PLANE
C     G2X:    DISTANCE LINE  -  TOP GROUND-PLANE
C     KX:     COUPLING COEFFICIENT
C     WX:     LINE-WIDTH
C     WXST:   START-VALUE LINE-WIDTH
C     ZEXS:   DESIRED EVEN MODE CHARACTERISTIC IMPEDANCE
C     ZLS:    DESIRED CHARACTERISTIC IMPEDANCE IN OHM
C     ZLX:    CHARACTERISTIC IMPEDANCE IN OHM
C     ZOXS:   DESIRED ODD MODE CHARACTERISTIC IMPEDANCE
C
      SUBROUTINE STARTW(ZLS,EK,G1X,D1X,G2X,ZLX,CX,EKE,WX,GX,
     1ZOXS,ZEXS)
      ZLS=(ZEXS+ZOXS)/2
      CALL ITERAT(ZLS,EK,G1X,D1X,G2X,ZLX,CX,EKE,WX,Q)
      GX=ZOXS/(3.0*(ZEXS-ZOXS))
      CALL TWOLIN(WX,GX,EK,G1X,D1X,G2X,EKEO,EKEE,ZOX,ZEX,ZLX,
     1KX,COX,CEX)
      IF(WX.LT.0.05) WX=0.05
      IF(WX.GT.15.0) WX=15.0
      IF(GX.LT.0.05) GX=0.05
      IF(GX.GT.15.0) GX=15.0
      RETURN
      END
C
C
C     INPUT FUER WAHL 4
C
      SUBROUTINE EINGB4(ZLX,KX,ZEXS,ZOXS,WX,GX)
      REAL KX
      WRITE(*,100)
  100 FORMAT(1H1,/////////////////'            SELECT INPUT:',//
     1//'          <1>     EVEN AND ODD MODE IMPEDANCES',
     2//'          <2>     CHARAC. IMPEDANCE UND COUPL. COEFFICIENT ',
     3///)
      READ(*,119) IA
  119 FORMAT(I4)
      A=IA*1.0
      IF (A.EQ.1) GOTO 1
      WRITE (*,101)
  101 FORMAT(1H ,'   CHARACTERISTIC IMPEDANCE IN OHM            ZL='\)
      READ(*,120)ZLX
      WRITE (*,102)
  102 FORMAT(1H ,'   COUPLING COEFFICIENT                        K='\)
      READ(*,120)KX
      ZEXS=ZLX*SQRT((1+KX)/(1-KX))
      ZOXS=ZLX*SQRT((1-KX)/(1+KX))
      GOTO 2
    1 WRITE (*,103)
  103 FORMAT(1H ,'  EVEN MODE IMPEDANCE IN OHM        ZEXS='\)
      READ(*,120)ZEXS
      WRITE (*,104)
  104 FORMAT(1H ,'  ODD MODE  IMPEDANCE IN OHM        ZOXS='\)
      READ(*,120)ZOXS
  120 FORMAT(F14.7)
    2 IF(ZEXS.GT.ZOXS) GOTO 3
      WRITE (*,105)
  105 FORMAT(1H ,///' EVEN MODE IMPEDANCE IS ALWAYS GREATER TH',//,
     1' AN ODD MODE IMPEDANCE ! !                                 ',//,
     2'                        '///)
      GOTO 1
    3 IF((ZEXS/ZOXS).LT.5.0) GOTO4
      WRITE (*,106)
  106 FORMAT(1H ,///' COMPUTATION NOT POSSIBLE  !',//)
      GOTO 1
    4 RETURN
      END
C
C
C     OUTPUT COMPUTED PARAMETER
C
      SUBROUTINE AUSGB4(ZLX,ZEX,ZOX,WX,GX,A,KX,EKE,EKEE,EKEO,IS)
      REAL KX
      WRITE (*,100) IS,ZLX,ZEX,ZOX,KX,WX,GX,EKEE,EKEO,EKE
  100 FORMAT(1H ,//////////'    RESULTS AFTER ',I2,'  STEPS:',///,
     1'         CHARACTERISTIC IMPEDAMCE        ZL=',F12.4/,
     1'              > EVEN MODE               ZEX=',F12.4/,
     1'              > ODD MODE                ZOX=',F12.4/,
     1'         COUPLING COEFFICIENT             K=',F12.4/,
     2'         LINE-WIDTH                      WX=',F12.4/,
     3'         GAP WIDTH                       GX=',F12.4/,
     9'         EPPS EFF EVEN MODE              EE=',F12.4/,
     8'         EPPS EFF ODD MODE               EO=',F12.4/,
     3'         EPPS EFF RELATIV                ER=',F12.4/,)
C
      RETURN
      END
C
C
C     SUBROUTINE: COMPUTATION OF A SINGLE LINE
C
C     CX:     CAPACITANCE IN PF/CM
C     D1X:    THICKNESS OF SUBSTRATE
C     EK:     RELATIVE PERMITTIVITY
C     EKE:    EFFECTIVE REL.PERMITTIVITY OF SUBSTRATE
C     G1X:    DISTANCE SUBSTRATE  -  BOTTOM GROUND-PLANE
C     G2X:    DISTANCE LINE  -  TOP GROUND-PLANE
C     WX:     LINE WIDTH
C     ZLX:    CHARACTERISTIC IMPEDANCE IN OHM
C
      SUBROUTINE SINLIN(WX,EK,G1X,D1X,G2X,CX,EKE,ZLX)
      CPK=CPLATE(WX,EK,G1X,D1X,G2X)
      CP0=CPLATE(WX,1.0,G1X,D1X,G2X)
      CFOK=CFODD(WX,1.E5,EK,G1X,D1X,G2X)
      CFO0=CFODD(WX,1.E5,1.,G1X,D1X,G2X)
      CX=CPK+4.*CFOK
      C0=CP0+4.*CFO0
      EKE=CX/C0
      E0=10./36./3.1415927
      ZLX=377.*E0/SQRT(CX*C0)
      RETURN
      END
C
C
C
C     SUBROUTINE: COMPUTATION OF A STRIPLINE-COUPLER
C
C     CEX:    EVEN MODE CAPACITANCE
C     COX:    CAPACITANCE IM ODD MODEFALL
C     D1X:    THICKNESS OF SUBSTRATE
C     EK:     REL.PERMITTIVITY OF SUBSTRATE
C     EKEE:     '     '   '  IM EVEN MODE
C     EKEO:     '     '   '  IM ODD MODEFALL
C     GX:     GAP WIDTH
C     G1X:    DISTANCE SUBSTRATE  -  BOTTOM GROUND-PLANE
C     G2X:    DISTANCE LINE  -  TOP GROUND-PLANE
C     KX:     COUPLING COEFFICIENT
C     WX:     LINE WIDTH
C     ZEX:    EVEN MODE CHARACTERISTIC IMPEDANCE
C     ZLS:    DESIRED CHARACTERISTIC IMPEDANCE IN OHM
C     ZLX:    CHARACTERISTIC IMPEDANCE IN OHM
C     ZOX:    ODD MODE CHARACTERISTIC IMPEDANCE
C
      SUBROUTINE TWOLIN(WX,GX,EK,G1X,D1X,G2X,EKEO,EKEE,ZOX,ZEX,
     1ZLX,KX,COX,CEX)
      REAL KX
      CPK=CPLATE(WX,EK,G1X,D1X,G2X)
      CP0=CPLATE(WX,1.0,G1X,D1X,G2X)
      CFOKL=CFODD(WX,1.E10,EK,G1X,D1X,G2X)
      CFOKR=CFODD(WX,GX,EK,G1X,D1X,G2X)
      CFO0L=CFODD(WX,1.E10,1.,G1X,D1X,G2X)
      CFO0R=CFODD(WX,GX,1.,G1X,D1X,G2X)
      CFEKL=CFEVEN(WX,1.E10,EK,G1X,D1X,G2X)
      CFEKR=CFEVEN(WX,GX,EK,G1X,D1X,G2X)
      CFE0L=CFEVEN(WX,1.E10,1.,G1X,D1X,G2X)
      CFE0R=CFEVEN(WX,GX,1.,G1X,D1X,G2X)
      COX=CPK+2.*CFOKL+2.*CFOKR
      CEX=CPK+2.*CFEKL+2.*CFEKR
      DCX=CFOKR-CFEKR
      CO0=CP0+2.*CFO0R+2.*CFO0L
      CE0=CP0+2.*CFE0R+2.*CFE0L
      EKEO=COX/CO0
      EKEE=CEX/CE0
      E0=10./36./3.1415927
      ZOX=377.*E0/SQRT(COX*CO0)
      ZEX=377.*E0/SQRT(CEX*CE0)
      ZLX=SQRT(ZEX*ZOX)
      KX=(ZEX-ZOX)/(ZEX+ZOX)
      RETURN
      END
C
C
C     SUBROUTINE: COMPUTATION OF A PARALLEL-
C     PLATE CAPACITANCE
C
C     CPLATE: PARALLEL-PLATE CAPACITANCE
C     D1X:    THICKNESS OF SUBSTRATE
C     EK:     RELATIVE PERMITTIVITY
C     G1X:    DISTANCE SUBSTRATE  -  BOTTOM GROUND-PLANE
C     G2X;    DISTANCE LINE  -  TOP GROUND-PLANE
C     WX:     VERHAELTNIS STEIFEMBREITE ZU SUBSRATTHICKNESS
C
      FUNCTION CPLATE(WX,EK,G1X,D1X,G2X)
      E0=10./36./3.1415927
      CPLATE=E0*WX/G2X+(E0*WX)/(G1X+D1X/EK)
      RETURN
      END
C
C
C     SUBROUTINE ODD MODE-FRINGING CAPACITANCES
C
      FUNCTION CFODD(WX,GX,EK,G1X,D1X,G2X)
      CALL CFEO(1,CF,WX,GX,EK,G1X,D1X,G2X)
      CFODD=CF
      RETURN
      END
C
C
C     SUBROUTINE EVEN MODE-FRINGING CAPACITANCES
C
      FUNCTION CFEVEN(WX,GX,EK,G1X,D1X,G2X)
      CALL CFEO(2,CF,WX,GX,EK,G1X,D1X,G2X)
      CFEVEN=CF
      RETURN
      END
C
C
C     SUBROUTINE: FRINGING CAPACITANCES EVEN AND
C     ODD MODE
C
      SUBROUTINE CFEO(IC,CF,WX,GX,EK,G1X,D1X,G2X)
      DIMENSION V(30)
      REAL K,KP
      TANH(X)=(1.-EXP(-2.*X))/(1.+EXP(-2.*X))
      COTH(X)=1./TANH(X)
      GN(G1)=1.+K*TANH(G1)*COTH(D1)
      GD(G1)=COTH(G2)+K*COTH(D1)+K*TANH(G1)*(K+COTH(G2)*COTH(D1))
      PHI(G1)=GN(G1)/GD(G1)-TANH(G1+D1)/(1.+K)
      PI=3.141593
      W0=WX
      G0=GX
      G10=G1X
      D10=D1X
      G20=G2X
      K=EK
      IF(W0.GT.3.*D10) W0=3.*D10
      IF(G20.GT.6.*D10) G20=6.*D10
      R=2.*(G10+D10)/(W0+G0)
      X=-0.0979
      DX=.1
    2 X=X+DX
      IF(X.LT.0.) GOTO 16
      IF(X.LT..999998) GOTO 7
      X=X-DX
      DX=DX/5.
      IF(DX.GT.1.E-6) GOTO 2
      X=0.999998
      G0=4.*(G10+D10)*ELP1(X)/PI-W0
      GOTO 3
    7 Y=SQRT(1.-X*X)
      IF(Y.LT.0.999998) GOTO 17
   16 IF(IC.GT.1) GOTO 4
      X=0.
      GOTO 3
    4 X=.002
      Y=SQRT(1.-X*X)
      W0=(G10+D10)*PI/ELP1(Y)-G0
      GOTO 3
   17 CONTINUE
      R1=ELP1(Y)/ELP1(X)
      IF(ABS(R-R1).LT.1.E-3) GOTO 3
      IF(R-R1) 2,3,5
    5 X=X-DX
      DX=DX/3.
      GOTO 2
    3 KP=X
      XM=ELP1(KP)
      F=2.*XM/PI
      X0=W0*XM/(W0+G0)
      A=SN(X0,KP)
      Y=1.
      IF(IC.GT.1) Y=KP
      X=Y*A
      Y=SQRT(1.-X*X)
      EN=ELP1(Y)
      E=ELP1(X)
      CT=4.*E/EN
      W=PI*W0/(W0+G0)
      G=W*G0/W0
      G1=W*G10/W0
      D1=W*D10/W0
      G2=W*G20/W0
      W0=W
      G0=G
      G10=G1
      D10=D1
      G20=G2
      N=29
      NJ=N-1
      H=X0/FLOAT(NJ)
      DO 20 J=1,NJ
      X=H*FLOAT(J-1)
      S=SN(X,KP)
      Y=2.*KP-1.+(1.-KP)*FLOAT(IC)
   20 V(J)=SQRT((1.-(Y*S)**2)/(1.-(S/A)**2))
      C0=0.
      U=(-1.)**IC
      DO 14 M=IC,200,2
      U=-U
      AM=FLOAT(M)
      G1=AM*G10
      D1=AM*D10
      G2=AM*G20
      PHM=PHI(G1)
      IF(ABS(PHM/(1.+K)).LT..00001) GOTO 15
      CM=COS(AM*X0/F)
      PM=(1.-CM)+4*V(NJ)*(COS(AM*(X0-H)/F)-CM)
      JJ=N-3
      DO 30 J=2,JJ,2
      X=H*FLOAT(J-1)
      Y=X+H
      PM=PM+4*V(J)*(COS(AM*X/F)-CM)+2.*V(J+1)*(COS(AM*Y/F)-CM)
   30 CONTINUE
      PM=A*E*CM+H*PM/3.
      PM=8.*PM*U/(PI*A*EN)
      C0=C0+PM*PHM*PM/AM
   14 CONTINUE
   15 CONTINUE
      CP=W0/G20+W0/(G10+D10/K)
      C0=C0*PI/(2.*CT*CT)
      IF(IC.GT.1) GOTO 12
      C0=C0+2./((1.+K)*CT)
      GOTO 11
   12 C0=C0+2.*(1./CT-(G10+D10)/(2.*PI))/(1.+K)+W0/(CP*(W0+G0))
   11 C0=1./C0
      CF=10.*(C0-CP)/(4.*36.*PI)
      RETURN
      END
C
C
C
C     JACOBI FUNKTIONS
C
      FUNCTION SN(XX,KX)
      REAL K,KX,KN(10)
      X=XX
      K=KX
      UN=X
      X=SQRT(1.-K*K)
      KN(1)=(1.-X)/(1.+X)
      IF(KN(1)-1.) 11,10,10
   10 S=(1.-EXP(-2.*UN))/(1.+EXP(-2.*UN))
      GOTO 8
   11 N=1
    5 X=SQRT(1.-KN(N)*KN(N))
      KN(N+1)=(1.-X)/(1.+X)
      IF(KN(N)-1.E-8) 3,4,4
    4 UN=UN/(1.+KN(N))
      N=N+1
      GOTO 5
    3 UN=UN/(1.+KN(N+1))
      S=SIN(UN)
      IF(N-1) 8,8,9
    9 CONTINUE
      DO 6 I=2,N
      J=N-I+1
      S=(1.+KN(J))*S/(1.+KN(J)*S*S)
    6 CONTINUE
    8 SN=S
      RETURN
      END
C
C
C
      FUNCTION ELP1(AX)
      REAL K,KP
      K=AX
      KP=1.-K*K
      A0=1.3862944
      A1=0.1119723
      A2=0.0725296
      B0=0.5
      B1=0.1213478
      B2=0.0288729
      IF(K.LT.0.99999) GOTO 1
      ELP1=.5*ALOG(16./KP)
      GOTO 2
    1 CONTINUE
      ELP1=(B0+B1*KP+B2*KP*KP)*ALOG(1./KP)+A0+A1*KP+A2*KP*KP
    2 RETURN
      END