Download dtchaz.eso

Back to the list

   1 : C DTCHAZ    SOURCE    PV        13/04/08    21:15:08     7750           
   2 :             SUBROUTINE DTCHAZ(IRET,ktrace,msorse)                                                   
   3 : *-----------------------------------------------------------------------        
   4 : *     DESTRUCTION D'UN NOUVEAU CHAMELEM ( MCHAML )                              
   5 : *-----------------------------------------------------------------------        
   6 :       IMPLICIT INTEGER(I-N)
   7 :       character*6 msorse
   8 : -INC SMCHAML                                                                    
   9 :       MCHELM=IRET                                                               
  10 :       SEGACT MCHELM                                                             
  11 :       DO 100 IA=1,IMACHE(/1)                                                    
  12 :       MCHAML=ICHAML(IA)                                                         
  13 :       SEGACT MCHAML                                                             
  14 :       DO 200 IB=1,IELVAL(/1)                                                    
  15 :       MELVAL=IELVAL(IB)
  16 :       if( melval.eq.ktrace)  then
  17 :         ktrace=-ktrace   
  18 :         msorse='MELVAL'
  19 :       endif                                                 
  20 :       SEGSUP MELVAL                                                             
  21 :   200 CONTINUE
  22 :       if( mchaml.eq.ktrace)  then 
  23 :         ktrace=-ktrace  
  24 :         msorse= 'MCHAML'
  25 :       endif                                                         
  26 :       n2 = 0
  27 :       SEGadj MCHAML
  28 : ***   SEGSUP MCHAML
  29 :   100 CONTINUE
  30 :       if( mchelm.eq.ktrace)   then
  31 :         msorse='MCHELM'
  32 :         ktrace=-ktrace  
  33 :       endif                                                         
  34 :       n1 = 0
  35 :       n3 = 0
  36 :       l1 = 0
  37 :       SEGadj MCHELM
  38 : ***   SEGSUP MCHELM
  39 :       IRET=0                                                                    
  40 :       RETURN                                                              
  41 :       END                                                                       
  42 :  
  43 :  
  44 :  
  45 :  
  46 :  

© Cast3M 2003 - All rights reserved.
Disclaimer