Download extr12.eso

Back to the list

   1 : C EXTR12    SOURCE    CHAT      05/01/12    23:51:53     5004           
   2 :       SUBROUTINE EXTR12(INUM,IPO,IRET)                                          
   3 : * -----------------------------------------------------------------             
   4 : *     ce sous-programme verifie si le point pointÉ  par IPO                     
   5 : *     appartient au maillage INUM                                               
   6 : *     IRET = 0, si non                                                          
   7 : *     IRET = 1, si oui                                                          
   8 : * -----------------------------------------------------------------             
   9 :       IMPLICIT INTEGER(I-N)
  10 : -INC CCOPTIO                                                                    
  11 : -INC SMELEME                                                                    
  12 : *                                                                               
  13 :       IRET = 0                                                                  
  14 : *     MELEME = IPO                                                              
  15 : *     SEGACT MELEME                                                             
  16 : *     NPO =NUM(1,1)                                                             
  17 : *     SEGDES MELEME                                                             
  18 :       NPO=IPO                                                                   
  19 :       MELEME=INUM                                                               
  20 :       SEGACT MELEME   
  21 :       nobj=lisous(/1)
  22 :       if (nobj.eq.0) then
  23 :       NP = NUM(/1)                                                              
  24 :       NE = NUM(/2)                                                              
  25 :       DO 10 IE = 1,NE                                                           
  26 :         DO 20 IP = 1,NP                                                         
  27 :            IF (NPO.EQ.NUM(IP,IE))THEN                                           
  28 :               IRET = 1                                                          
  29 :               GOTO 30                                                           
  30 :            ENDIF                                                                
  31 :  20     CONTINUE                                                                
  32 :  10   CONTINUE                                                                  
  33 :  30   CONTINUE   
  34 : *
  35 :       else
  36 :       do 41 iobj=1,nobj
  37 :       ipt1=lisous(iobj)
  38 :       segact ipt1                                                                 
  39 :       NP = ipt1.NUM(/1)                                                              
  40 :       NE = ipt1.NUM(/2)                                                              
  41 :       DO 11 IE = 1,NE                                                           
  42 :         DO 21 IP = 1,NP                                                         
  43 :            IF (NPO.EQ.ipt1.NUM(IP,IE))THEN                                           
  44 :               IRET = 1                                                          
  45 :               segdes ipt1*nomod                                                               
  46 :               GOTO 31                                                           
  47 :            ENDIF                                                                
  48 :  21     CONTINUE                                                                
  49 :  11   CONTINUE                                                                  
  50 :       segdes ipt1*nomod                                                               
  51 :  41    continue
  52 :  31   CONTINUE   
  53 :       endif
  54 :       SEGDES MELEME                                                       
  55 : *                                                                               
  56 :       END                                                                       
  57 :  
  58 :  

© Cast3M 2003 - All rights reserved.
Disclaimer