Esope source files

   1 : C NUACHL    SOURCE    PV        09/03/12    21:29:51     6325           
   2 :        SUBROUTINE NUACHL(ICHML)
   3 : *
   4 : *   sous-routine de l'operateur nuage pour créer un objet nuage
   5 : *   à partir d'un champ par élément à composantes réelles.
   6 : *
   7 :       IMPLICIT INTEGER(I-N)
   8 :        IMPLICIT REAL*8(A-H,O-Z)
   9 : *
  10 : -INC CCOPTIO
  11 : -INC SMNUAGE
  12 : -INC SMCHAML
  13 : -INC SMELEME
  14 : *
  15 : *  création d'un segment pour pouvoir créer un tableau
  16 : *
  17 :        SEGMENT,ITABLE
  18 :        CHARACTER*8 COMPOS(N)
  19 :        INTEGER TABLEA(N1,N)
  20 :        ENDSEGMENT
  21 : *compos(i) : nom de la i-ème composante
  22 : *tablea(j,k) :place de la k-ème composante dans le j-ème segment
  23 : 
  24 :        IRETOU = 0
  25 : *
  26 : *  lecture du mchaml
  27 : *
  28 :        MCHELM = ICHML
  29 :        SEGACT MCHELM
  30 :        N1 = ICHAML(/1)
  31 : *
  32 : *  création du tableau
  33 : *
  34 :        IF (N1.EQ.0) THEN
  35 :           NVAR = 0
  36 :           NCOUP = 0
  37 :           SEGINI MNUAGE
  38 :           SEGDES MNUAGE
  39 :        ENDIF
  40 : *
  41 :        NBCOUP = 0
  42 :        DO 10 I = 1,N1
  43 :         MCHAML = ICHAML(I)
  44 :         SEGACT MCHAML
  45 :         N2 = NOMCHE(/2)
  46 :         DO 5 J = 1,N2
  47 : * affichage de l'erreur dans le cas où les composantes ne sont pas
  48 : * réelles
  49 :          IF (TYPCHE(J) .NE.'REAL*8') THEN
  50 :             MOTERR(1:8)=TYPCHE(J)
  51 :             MOTERR(17:20)=NOMCHE(J)
  52 :             MOTERR(21:29) = 'ARGUMENT'
  53 :             DO 7 K = 1,I
  54 :              MCHAML = ICHAML(K)
  55 :              SEGDES MCHAML
  56 :   7         CONTINUE
  57 :             SEGDES MCHELM
  57 :             CALL ERREUR(552)
  58 :             RETURN
  59 :          ENDIF
  60 :   5      CONTINUE
  61 : *
  62 :         MELEME = IMACHE(I)
  63 :         SEGACT MELEME
  64 :         NBCOUP = NBCOUP + NUM(/1)*NUM(/2)
  65 :         IF (I.EQ.1) THEN
  66 :            N = N2
  67 :            SEGINI ITABLE
  68 :            do 20 j =1,n2
  69 :             compos(j) = nomche(j)
  70 :             tablea(i,j) = j
  71 :    20      CONTINUE
  72 :         ELSE
  73 :            l = n
  74 :            do 40 k = 1,n2
  75 :             do 50 j = 1,n
  76 :              if (tablea(i,j).eq.0) then
  77 :                 if (nomche(k).eq.compos(j)) then
  78 :                    tablea(i,j) = k
  79 :                    goto 40
  80 :                 endif
  81 :              endif
  82 :    50       CONTINUE
  83 :             l = l+1
  84 :             n = l
  85 :             segadj itable
  86 :             compos(l) = nomche(k)
  87 :             tablea(i,l) = k
  88 :    40      CONTINUE
  89 :         ENDIF
  90 :         SEGDES MELEME
  91 :         SEGDES MCHAML
  92 :    10  CONTINUE
  93 : 
  94 : *
  95 : *  initialisation de l'objet nuage
  96 : *
  97 :        NVAR = N
  98 :        SEGINI MNUAGE
  99 :        DO 60 I =1,NVAR
 100 :         NUANOM(I) = COMPOS(I)
 101 :         NUATYP(I) = 'FLOTTANT'
 102 :         SEGINI NUAVFL
 103 :         NUAPOI(I)=NUAVFL
 104 :    60  CONTINUE
 105 : *
 106 : *  création du n-uplets du nuage
 107 : *
 108 : * le nuage ne contient que des flottants
 109 : * boucle sur les sous zones
 110 :        IND = 1
 111 :        DO  70 I = 1,N1
 112 :         MCHAML = ICHAML(I)
 113 :         SEGACT MCHAML
 114 :         MELEME = IMACHE(I)
 115 :         SEGACT MELEME
 116 :         nbnn = num(/1)
 117 :         nbelem = num(/2)
 118 : * boucle sur les éléments
 119 :         do 80 j = 1,nbelem
 120 : * boucle sur les points
 121 :          do 90 k = 1,nbnn
 122 : * remplissage du tableau pour chaque composante
 123 :           DO 100 L = 1,NVAR
 124 :            NUAVFL = NUAPOI(L)
 125 :            N3 = TABLEA(I,L)
 126 :            IF (N3.EQ.0) THEN
 127 :               NUAFLO(IND) = 0.D0
 128 :            ELSE
 129 :               MELVAL = IELVAL(N3)
 130 :               SEGACT MELVAL
 131 :               KMIN = MIN(VELCHE(/1),K)
 132 :               JMIN= MIN(J,VELCHE(/2))
 133 :               NUAFLO(IND) = VELCHE(KMIN,JMIN)
 134 :               SEGDES  MELVAL
 135 :            ENDIF
 136 :   100     CONTINUE
 137 :           IND = IND + 1
 138 :    90    CONTINUE
 139 :    80   CONTINUE
 140 :         SEGDES MELEME
 141 :         SEGDES MCHAML
 142 :    70  CONTINUE
 143 :        SEGSUP ITABLE
 144 :        SEGDES MCHELM
 145 :        DO 110 I=1,NVAR
 146 :           NUAVFL=NUAPOI(I)
 147 :           SEGDES NUAVFL
 148 :  110   CONTINUE
 149 :        SEGDES MNUAGE
 150 : *
 151 : *  ecriture du nuage
 152 : *
 152 :        CALL ECROBJ('NUAGE ',MNUAGE)
 153 :        END
 154 :  
 155 :  
 156 :  
 157 :  
 158 :