Télécharger opchpo.eso

Retour à la liste

Numérotation des lignes :

  1. C OPCHPO SOURCE CB215821 16/11/28 21:15:10 9202
  2.  
  3. SUBROUTINE OPCHPO(MCHPO1,IEPS,MCHPO2)
  4.  
  5. C=======================================================================
  6. C N'EFFECTUE PLUS QUE ATAN2 SUR LES CHPOINTS
  7. C ENTREES
  8. C IPO1 (E) POINTEUR SUR UN CHPOINT.
  9. C IPO2 (E) POINTEUR SUR UN CHPOINT (2eme ARGUMENT DANS ATAN2)
  10. C IEPS = 11 ARCTANGENTE (Seule operation pas encore parallele)
  11. C
  12. C SORTIES
  13. C IPO2=POINTEUR SUR LE CHAMPOINT RESULTANT
  14. C
  15. C CODE EBERSOLT AVRIL 86
  16. C
  17. C=======================================================================
  18.  
  19. IMPLICIT INTEGER(I-N)
  20. IMPLICIT REAL*8(A-H,O-Z)
  21.  
  22. SEGMENT ICPR(XCOOR(/1)/(IDIM+1))
  23. LOGICAL BATAN2
  24. REAL*8 XIN1,XIN2,XOUT
  25. INTEGER IR
  26.  
  27. -INC CCOPTIO
  28. -INC CCREEL
  29. -INC SMCHPOI
  30. -INC TMTRAV
  31. -INC SMELEME
  32. -INC SMCOORD
  33. C
  34. BATAN2 = .FALSE.
  35.  
  36. IR =0
  37.  
  38. XIN1=XZERO
  39. XIN2=XZERO
  40. XOUT=XZERO/XPI
  41. C
  42. IF(MCHPO2.NE.0) THEN
  43. C Calcul de ATAN2 (2 arguments)
  44. BATAN2 = .TRUE.
  45. CALL TRACHP(MCHPO1,MTRAV)
  46. SEGACT MTRAV*MOD
  47. NNIN=NHAR(/1)
  48. MCHPOI=MCHPO2
  49. SEGACT MCHPOI
  50. SEGINI ICPR
  51. DO I=1,IGEO(/1)
  52. ICPR(IGEO(I))=I
  53. ENDDO
  54. DO I=1,IPCHP(/1)
  55. MSOUPO=IPCHP(I)
  56. SEGACT MSOUPO
  57. MELEME=IGEOC
  58. MPOVAL=IPOVAL
  59. DO 22 J=1,NOCOMP(/2)
  60. DO K=1,NNIN
  61. IF(NOCOMP(J).EQ.INCO(K) ) GO TO 24
  62. ENDDO
  63. GO TO 22
  64.  
  65. 24 CONTINUE
  66. SEGACT MELEME,MPOVAL
  67. DO 25 L=1,NUM(/2)
  68. IA=ICPR(NUM(1,L))
  69. IF(IA.EQ.0) GO TO 25
  70. IBIN(K,IA)=-1
  71. XIN1=BB(K,IA)
  72. XIN2=VPOCHA(L,J)
  73. CALL OPFLOT(XIN1,XIN2,IR,BATAN2,IEPS,XOUT)
  74. BB(K,IA)= XOUT
  75.  
  76. 25 CONTINUE
  77. SEGDES MELEME,MPOVAL
  78.  
  79. 22 CONTINUE
  80. SEGDES MSOUPO
  81. ENDDO
  82.  
  83. DO I=1,IGEO(/1)
  84. DO 27 J=1,NNIN
  85. IF( IBIN(J,I) .EQ. 0 ) THEN
  86. GO TO 27
  87. ELSEIF(IBIN(J,I).EQ.1) THEN
  88. IF(BB(J,I).GT.REAL(0.D0)) THEN
  89. BB(J,I)=REAL(90.D0)
  90. ELSEIF(BB(J,I).LT.REAL(0.D0)) THEN
  91. BB(J,I)=REAL(-90.D0)
  92. ELSE
  93. Y=REAL(0.D0)
  94. GOTO 999
  95. ENDIF
  96. ELSE
  97. IBIN(J,I)=1
  98. ENDIF
  99. 27 CONTINUE
  100. ENDDO
  101.  
  102. SEGDES MTRAV
  103. CALL CRECHP (MTRAV,KSOLU)
  104. SEGSUP MTRAV
  105. MCHPO2 = KSOLU
  106. RETURN
  107.  
  108. ELSE
  109. C Ce cas doit passer dans OPCHP1 qui va remplacer OPCHPO lorsque
  110. C ATAN2 sera realise en parallele
  111. PRINT *,'Faire CALL OPCHP1 au lieu de OPCHPO'
  112. PRINT *,'Please CALL OPCHP1 instead of OPCHPO'
  113. CALL ERREUR(21)
  114. RETURN
  115. ENDIF
  116.  
  117. 999 CONTINUE
  118. C Nombre inacceptable %r1
  119. REAERR(1) = Y
  120. CALL ERREUR(1009)
  121.  
  122. IF( BATAN2 .EQV. .TRUE. ) THEN
  123. SEGDES MELEME,MPOVAL
  124. SEGDES MSOUPO
  125. SEGSUP MTRAV
  126. ENDIF
  127.  
  128. RETURN
  129.  
  130. END
  131.  
  132.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales