1 : C OPCHPO SOURCE GOUNAND 11/04/21 21:15:26 6946 2 : 3 : SUBROUTINE OPCHPO(IPO1,IEPS,IRET) 4 : 5 : C======================================================================= 6 : C EFFECTUE DIVERSES OPERATIONS SUR LES CHPOINTS 7 : C ENTREES 8 : C IPO1=POINTEUR SUR LE CHAMPOINT 9 : C IEPS= 1 COSINUS 10 : C = 2 SINUS 11 : C = 3 TANGENTE (OPERATION FAITE DANS TANGEN.ESO) 12 : C = 4 ARCOSINUS (OPERATION FAITE DANS ARCCS.ESO) 13 : C = 5 ARCSINUS (OPERATION FAITE DANS ARCCS.ESO) 14 : C = 6 ARCTANGENTE 15 : C = 7 EXPONENTIELLE 16 : C = 8 LOGARITHME 17 : C = 9 VALEUR ABSOLUE 18 : C =10 COSINUS HYPERBOLIQUE 19 : C =11 SINUS HYPERBOLIQUE 20 : C =12 TANGENTE HYPERBOLIQUE 21 : C =13 ERF (FONCTION D'ERREUR) 22 : C SORTIES 23 : C IRET=POINTEUR SUR LE CHAMPOINT RESULTANT 24 : C =0 SI L OPERATION EST IMPOSSSIBLE 25 : C 26 : C CODE EBERSOLT AVRIL 86 27 : C 28 : C======================================================================= 29 : 30 : IMPLICIT INTEGER(I-N) 31 : IMPLICIT REAL*8(A-H,O-Z) 32 : 33 : -INC CCOPTIO 34 : -INC CCREEL 35 : 36 : -INC SMCHPOI 37 : 38 : C Conversion des angles (DEGres en RADians & RADians en DEGres) 39 : C PARAMETER ( cDegRad = 0.01745329251994329576923690768488612D0 , 40 : C & cRadDeg = 57.29577951308232087679815481410517040D0 ) 41 : C 42 : IRET=0 43 : C 44 : C Facteurs de conversion des angles 45 : C XCONV = cDegRad 46 : C XVNOC = cRadDeg 47 : XCONV = XPI / 180.D0 48 : XVNOC = 180.D0 / XPI 49 : C 50 : MCHPO1=IPO1 51 : SEGINI,MCHPOI=MCHPO1 52 : NSOUPO=IPCHP(/1) 53 : 54 : DO 72 IA=1,NSOUPO 55 : MSOUP1=IPCHP(IA) 56 : SEGINI,MSOUPO=MSOUP1 57 : IPCHP(IA)=MSOUPO 58 : MPOVA1=IPOVAL 59 : SEGINI,MPOVAL=MPOVA1 60 : IPOVAL=MPOVAL 61 : SEGDES,MSOUPO 62 : N =VPOCHA(/1) 63 : NC=VPOCHA(/2) 64 : GOTO( 1, 2,66,66,66, 6, 7, 8, 9,10,11,12,13),IEPS 65 : 66 CONTINUE 66 : SEGSUP,MPOVAL 66 : CALL ERREUR(19) 67 : GOTO 666 68 : C 69 : C COSINUS 70 : C 71 : 1 CONTINUE 72 : DO 100 IC=1,NC 73 : DO 101 IB=1,N 74 : VPOCHA(IB,IC)=COS(XCONV*VPOCHA(IB,IC)) 75 : 101 CONTINUE 76 : 100 CONTINUE 77 : GOTO 166 78 : C 79 : C SINUS 80 : C 81 : 2 CONTINUE 82 : DO 200 IC=1,NC 83 : DO 201 IB=1,N 84 : VPOCHA(IB,IC)=SIN(XCONV*VPOCHA(IB,IC)) 85 : 201 CONTINUE 86 : 200 CONTINUE 87 : GOTO 166 88 : C 89 : C TANGENTE 90 : C 91 : C NOTE : OPERATION EFFECTUEE DANS LE SOUS-PROGRAMME TANGEN 92 : C APPELE DIRECTEMENT PAR PILOT 93 : C 94 : 3 CONTINUE 95 : GOTO 166 96 : C 97 : C ARCOSINUS 98 : C 99 : C NOTE : OPERATION EFFECTUEE DANS LE SOUS-PROGRAMME ARCCS(1) 100 : C APPELE DIRECTEMENT PAR PILOT 101 : C 102 : 4 CONTINUE 103 : GOTO 166 104 : C 105 : C ARCSINUS 106 : C 107 : C NOTE : OPERATION EFFECTUEE DANS LE SOUS-PROGRAMME ARCCS(2) 108 : C APPELE DIRECTEMENT PAR PILOT 109 : C 110 : 5 CONTINUE 111 : GOTO 166 112 : C 113 : C ARCTANGENTE 114 : C 115 : 6 CONTINUE 116 : DO 600 IC=1,NC 117 : DO 601 IB=1,N 118 : VPOCHA(IB,IC)=XVNOC*ATAN(VPOCHA(IB,IC)) 119 : 601 CONTINUE 120 : 600 CONTINUE 121 : GOTO 166 122 : C 123 : C EXPONENTIELLE 124 : C 125 : 7 CONTINUE 126 : DO 700 IC=1,NC 127 : DO 701 IB=1,N 128 : VPOCHA(IB,IC)=EXP(VPOCHA(IB,IC)) 129 : 701 CONTINUE 130 : 700 CONTINUE 131 : GOTO 166 132 : C 133 : C LOGARITHME 134 : C 135 : 8 CONTINUE 136 : DO 800 IC=1,NC 137 : DO 801 IB=1,N 138 : XX=VPOCHA(IB,IC) 139 : * 140 : IF (XX.LT.XPETIT) THEN 140 : CALL ERREUR(36) 141 : SEGSUP MPOVAL 142 : GOTO 666 143 : ENDIF 144 : * 145 : VPOCHA(IB,IC)=LOG(XX) 146 : 801 CONTINUE 147 : 800 CONTINUE 148 : GOTO 166 149 : C 150 : C VALEUR ABSOLUE 151 : C 152 : 9 CONTINUE 153 : DO 900 IC=1,NC 154 : DO 901 IB=1,N 155 : VPOCHA(IB,IC)=ABS(VPOCHA(IB,IC)) 156 : 901 CONTINUE 157 : 900 CONTINUE 158 : GOTO 166 159 : C 160 : C COSINUS HYPERBOLIQUE 161 : C 162 : 10 CONTINUE 163 : DO 1000 IC=1,NC 164 : DO 1001 IB=1,N 165 : VPOCHA(IB,IC)=COSH(VPOCHA(IB,IC)) 166 : 1001 CONTINUE 167 : 1000 CONTINUE 168 : GOTO 166 169 : C 170 : C SINUS HYPERBOLIQUE 171 : C 172 : 11 CONTINUE 173 : DO 1100 IC=1,NC 174 : DO 1101 IB=1,N 175 : VPOCHA(IB,IC)=SINH(VPOCHA(IB,IC)) 176 : 1101 CONTINUE 177 : 1100 CONTINUE 178 : GOTO 166 179 : C 180 : C TANGENTE HYPERBOLIQUE 181 : C 182 : 12 CONTINUE 183 : DO 1200 IC=1,NC 184 : DO 1201 IB=1,N 185 : VPOCHA(IB,IC)=TANH(VPOCHA(IB,IC)) 186 : 1201 CONTINUE 187 : 1200 CONTINUE 188 : GOTO 166 189 : C 190 : C FONCTION D'ERREUR ERF 191 : C 192 : 13 CONTINUE 193 : DO 1300 IC=1,NC 194 : DO 1301 IB=1,N 195 : XX=ERGAUS(VPOCHA(IB,IC)) 196 : VPOCHA(IB,IC)=XX 197 : 1301 CONTINUE 198 : 1300 CONTINUE 199 : * GOTO 166 200 : * 201 : 166 CONTINUE 202 : SEGDES MPOVAL 203 : 72 CONTINUE 204 : 205 : 666 CONTINUE 206 : IF (IERR.NE.0) THEN 207 : SEGSUP,MCHPOI 208 : IRET = 0 209 : ELSE 210 : SEGDES,MCHPOI 211 : IRET = MCHPOI 212 : ENDIF 213 : 214 : RETURN 215 : END 216 : 217 : 218 :
© Cast3M 2003 - All rights reserved.
Disclaimer