C OPCHPO SOURCE CB215821 20/11/25 13:35:26 10792 C======================================================================= C N'EFFECTUE PLUS QUE ATAN2 SUR LES CHPOINTS C ENTREES C IPO1 (E) POINTEUR SUR UN CHPOINT. C IPO2 (E) POINTEUR SUR UN CHPOINT (2eme ARGUMENT DANS ATAN2) C IEPS = 11 ARCTANGENTE (Seule operation pas encore parallele) C C SORTIES C IPO2=POINTEUR SUR LE CHAMPOINT RESULTANT C C CODE EBERSOLT AVRIL 86 C C======================================================================= IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) SEGMENT ICPR(nbpts) LOGICAL BATAN2 REAL*8 XIN1,XIN2,XOUT INTEGER IR -INC PPARAM -INC CCOPTIO -INC CCREEL -INC SMCHPOI -INC TMTRAV -INC SMELEME -INC SMCOORD C BATAN2 = .FALSE. IR =0 XIN1=XZERO XIN2=XZERO XOUT=XZERO/XPI C IF(MCHPO2.NE.0) THEN C Calcul de ATAN2 (2 arguments) BATAN2 = .TRUE. SEGACT MTRAV*MOD NNIN=NHAR(/1) MCHPOI=MCHPO2 SEGACT MCHPOI SEGINI ICPR DO I=1,IGEO(/1) ICPR(IGEO(I))=I ENDDO DO I=1,IPCHP(/1) MSOUPO=IPCHP(I) SEGACT MSOUPO MELEME=IGEOC MPOVAL=IPOVAL DO 22 J=1,NOCOMP(/2) DO K=1,NNIN ENDDO GO TO 22 24 CONTINUE SEGACT MELEME,MPOVAL DO 25 L=1,NUM(/2) IA=ICPR(NUM(1,L)) IF(IA.EQ.0) GO TO 25 IBIN(K,IA)=-1 XIN1=BB(K,IA) XIN2=VPOCHA(L,J) BB(K,IA)= XOUT 25 CONTINUE 22 CONTINUE ENDDO DO I=1,IGEO(/1) DO 27 J=1,NNIN IF( IBIN(J,I) .EQ. 0 ) THEN GO TO 27 ELSEIF(IBIN(J,I).EQ.1) THEN IF(BB(J,I).GT.REAL(0.D0)) THEN BB(J,I)=REAL(90.D0) ELSEIF(BB(J,I).LT.REAL(0.D0)) THEN BB(J,I)=REAL(-90.D0) ELSE Y=REAL(0.D0) GOTO 999 ENDIF ELSE IBIN(J,I)=1 ENDIF 27 CONTINUE ENDDO SEGSUP MTRAV MCHPO2 = KSOLU RETURN ELSE C Ce cas doit passer dans OPCHP1 qui va remplacer OPCHPO lorsque C ATAN2 sera realise en parallele PRINT *,'Faire CALL OPCHP1 au lieu de OPCHPO' PRINT *,'Please CALL OPCHP1 instead of OPCHPO' RETURN ENDIF 999 CONTINUE C Nombre inacceptable %r1 REAERR(1) = Y IF( BATAN2 .EQV. .TRUE. ) THEN SEGSUP MTRAV ENDIF END
© Cast3M 2003 - Tous droits réservés.
Mentions légales