sw/os8/v3d/sources/fortran/all/expic.ra

   1 /
   2 /EXPIC
   3 /INTEGER OR REAL RAISED TO COMPLEX
   4 /
   5 / VERSION 5A 4-26-77 MH
   6 /
   7 /(A)^(C+I*D)
   8 /A=0 YIELDS 0
   9 /D=0 MEANS USE EXP3 TO CALCULATE A^C
  10 /C+D=0 YIELDS 1.0
  11 /ENTER + EXIT IN STARTE
  12         SECT    #EXPIC
  13         DPCHK
  14         EXTERN  #CAC
  15         EXTERN  EXP
  16         EXTERN  COS
  17         EXTERN  SIN
  18         EXTERN  ALOG
  19         EXTERN  EXP3
  20         EXTERN  SQRT
  21         BASE    0
  22 EXPIC,  JA      .
  23         FSTA    C,0
  24         STARTF
  25         FLDA    0       /BASE
  26         FSTA    A,0
  27         BASE    .+2000
  28         XTA     0
  29         FSTA    T1              /SAVE XR 0
  30         FLDA    A
  31         JNE     EX1     /A NOT 0
  32         STARTE          /A=B=0
  33         FCLA
  34 EX,     FSTA    #CAC            /RESULT = 0
  35         JA      EXPIC
  36 EX1,    FLDA    C               /C+D=0?
  37         JNE     EX2
  38         FLDA    D
  39         JNE     EX2
  40         STARTE
  41         FLDA    FP1             /RESULT = 1 IF C=D=0
  42         JA      EX
  43 EX2,    FLDA    D
  44         JNE     EX3             /USE EXP3 IF D=0
  45         JSR     EXP3
  46         JA      .+6
  47         JA      A
  48         JA      C
  49         FSTA    A
  50         STARTE
  51         FLDA    A               /RETURN AS REAL PART
  52         JA      EX
  53 /
  54 /LOGR=ALOG(SQRT(A*A))
  55 EX3,    FLDA    A
  56         FMUL    A
  57         FSTA    LOGR
  58         JSR     SQRT
  59         JA      .+4
  60         JA      LOGR
  61         FSTA    LOGR
  62         JSR     ALOG
  63         JA      .+4
  64         JA      LOGR
  65         FSTA    LOGR
  66 /ARG=C+D*LOGR
  67         FLDA    D
  68         FMUL    LOGR
  69         FADD    C
  70         FSTA    ARG
  71 /
  72 /CALCULATE SIN AND COS OF ARG. SAVE SIGN OF EACH
  73         JSR     SIN
  74         JA      .+4
  75         JA      ARG
  76         FSTA    SINE
  77         JSR     COS
  78         JA      .+4
  79         JA      ARG
  80         FSTA    CSINE
  81 /CALL C*LOGR-D
  82         FLDA    C
  83         FMUL    LOGR
  84         FSUB    D
  85         FSTA    REST
  86 /REAL = EXP(REST+ALOG(CSINE))
  87         FLDA    CSINE   /REAL
  88         JLT     .+6
  89         LDX     0,1             /=1 IF POSITIVE
  90         JA      .+3
  91         FNEG
  92         JSA     DO
  93         JXN     .+3,0           /SKIP IF POS
  94         FNEG
  95         FSTA    C
  96         FLDA    SINE            /IMAG
  97         JLT     .+6
  98         LDX     0,1
  99         JA      .+5
 100         LDX     0,0
 101         FNEG
 102         JSA     DO
 103         JXN     .+3,0
 104         FNEG                    /RESTORE SIGN
 105         FSTA    D
 106         FLDA    T1              /RESTORE XR0
 107         ATX     0
 108         STARTE
 109         FLDA    C
 110         FSTA    #CAC
 111         JA      EXPIC
 112 /
 113 DO,     JA      .
 114         FSTA    LOGR
 115         JSR     ALOG
 116         JA      .+4
 117         JA      LOGR
 118         FADD    REST
 119         FSTA    ARG
 120         JSR     EXP
 121         JA      .+4
 122         JA      ARG
 123         FSTA    ARG
 124         FLDA    LOGR            /CHECK SIGN
 125         JGE     DOX
 126         FLDA    ARG
 127         FNEG
 128         FSTA    ARG
 129 DOX,    FLDA    ARG
 130         JA      DO
 131 A,      F 0.0
 132 C,      F 0.0
 133 D,      F 0.0
 134 LOGR,   F 0.0
 135 ARG,    F 0.0
 136 SINE,   F 0.0
 137 CSINE,  F 0.0
 138 REST,   F 0.0
 139 FP1,    F 1.0
 140         F 0.0
 141 T1,     F 0.0
 142 \f