Download q4crsp.eso

Back to the list

   1 : C Q4CRSP    SOURCE    CHAT      06/03/29    21:30:52     5360           
   2 : C
   3 :       SUBROUTINE Q4CRSP(NB1,NB2,ITRNOE,NBNMAX,NBE,NBN,iarr)
   4 : C     **********************************************************************
   5 : C     OBJET Q4CRSP : CREATION D'UN MAILLAGE GRILLE (CAS SIMPLE)
   6 : C     OBJET          MEME NOMBRE DE NOEUDS SUR LES COTES OPPOSES.
   7 : C
   8 : C     EN ENTREE   :  
   9 : C       NB1,NB2 : NOMBRE DE NOEUDS SUR UNE LIGNE, SUR UNE COLONNE
  10 : C       ITRNOE : LE TABLEAU DES MAILLES (A REMPLIR)
  11 : C                 SA TAILLE DOIT ETRE EGALE A (NB1 * NB2 * NBNMAX)
  12 : C       NBNMAX  : NOMBRE MAXIMUM DE NOEUDS PAR ELEMENTS (4 OU +)
  13 : C
  14 : C     EN SORTIE   :
  15 : C       ITRNOE : TABLEAU DE DEFINITION DES ELEMENTS (NUMERO DES NOEUDS)
  16 : C       NBE     : NOMBRE D'ELEMENTS
  17 : C       NBN     : NOMBRE DE NOEUDS
  18 : C       iarr    : CODE D'ERREUR 
  19 : C                 -1 SI NB1, NB2 OU NBNMAX EST INCORRECT
  20 : C     **********************************************************************
  21 :       IMPLICIT INTEGER(I-N)
  22 :       INTEGER NB1,NB2
  23 :       INTEGER ITRNOE(*),NBNMAX,NBE,NBN,iarr
  24 : C
  25 :       INTEGER I,J
  26 : C
  27 :       iarr = -1
  28 :       NBE = 0
  29 :       NBN = 0
  30 :       IF( NBNMAX.LT.4 )GOTO 999
  31 :       IF((NB1.LE.0).OR.(NB2.LE.0))GOTO 999
  32 :       iarr = 0
  33 :       NBE = NB1*NB2
  34 :       NBN = (NB1+1)*(NB2+1)
  35 :       DO 20 I=1,NB1
  36 :         DO 10 J=1,NB2
  37 :           ITRNOE(((I-1)*NB2+(J-1))*NBNMAX+1 ) = 
  38 :      >      J+((NB2+1)*(I-1))
  39 :           ITRNOE(((I-1)*NB2+(J-1))*NBNMAX+2 ) = 
  40 :      >      J+((NB2+1)*(I-1)) + 1
  41 :           ITRNOE(((I-1)*NB2+(J-1))*NBNMAX+3 ) = 
  42 :      >      J+((NB2+1)* I   ) + 1
  43 :           ITRNOE(((I-1)*NB2+(J-1))*NBNMAX+4 ) = 
  44 :      >      J+((NB2+1)* I   )          
  45 :    10   CONTINUE
  46 :    20  CONTINUE
  47 :   999 END
  48 :  
  49 :  
  50 :  

© Cast3M 2003 - All rights reserved.
Disclaimer