1 : C NUACHP SOURCE CHAT 05/01/13 02:02:43 5004 2 : SUBROUTINE NUACHP(ICHP) 3 : * 4 : * sous routine de l'operateur nuage pour creer un objet 5 : * nuage à partir d'un champ par point. 6 : * 7 : IMPLICIT INTEGER(I-N) 8 : IMPLICIT REAL*8(A-H,O-Z) 9 : * 10 : -INC CCOPTIO 11 : -INC SMELEME 12 : -INC SMNUAGE 13 : -INC SMLMOTS 14 : -INC SMCHPOI 15 : * 16 : * 17 : * 18 : IRETOU = 0 19 : * 20 : *------------------------ Lecture du CHPOINT --------------------- 21 : * 22 : MCHPOI = ICHP 23 : SEGACT MCHPOI 24 : NSOUPO = IPCHP(/1) 25 : * 26 : *-------- Boucle créant un LISTMOT contenant les noms des variables --- 27 : *-------- contenues dans le CHPOINT. Ces noms n'apparaissent qu'une --- 28 : *-------- seule fois -------------------------------------------------- 29 : * 30 : IF (NSOUPO .EQ. 0) THEN 31 : NVAR = 0 32 : NBCOUP = 0 33 : SEGINI MNUAGE 34 : SEGDES MNUAGE 35 : ENDIF 36 : * 37 : DO 10 I=1,NSOUPO 38 : MSOUPO = IPCHP(I) 39 : SEGACT MSOUPO 40 : IF(I.EQ.1) THEN 41 : JGN = 4 42 : JGM = 20 43 : SEGINI MLMOTS 44 : NC = NOCOMP(/2) 45 : IF(NC.GT.20) THEN 46 : JGM = NC + 10 47 : SEGADJ MLMOTS 48 : ENDIF 49 : DO 20 J=1,NC 50 : MOTS(J) = NOCOMP(J) 51 : 20 CONTINUE 52 : NBMO = NC 53 : ELSE 54 : NC = NOCOMP(/2) 55 : DO 30 J = 1,NC 56 : NEXIS = 0 57 : DO 40 K = 1,NBMO 58 : IF(NOCOMP(J).EQ.MOTS(K)) THEN 59 : NEXIS = 1 60 : ENDIF 61 : 40 CONTINUE 62 : IF(NEXIS.EQ.0) THEN 63 : NBMO = NBMO + 1 64 : IF (NBMO.GT.MOTS(/2)) THEN 65 : JGM = JGM + 10 66 : SEGADJ MLMOTS 67 : ENDIF 68 : MOTS(NBMO) = NOCOMP(J) 69 : ENDIF 70 : 30 CONTINUE 71 : ENDIF 72 : SEGDES MSOUPO 73 : 10 CONTINUE 74 : * 75 : *------------------ on redefinit la taille du LISTMOT ---------------- 76 : * 77 : JGM = NBMO 78 : SEGADJ MLMOTS 79 : * 80 : *--------------Calcul du nombre total de points------------------------- 81 : * 82 : NBPOI = 0 83 : DO 50 I=1,NSOUPO 84 : MSOUPO = IPCHP(I) 85 : SEGACT MSOUPO 86 : MELEME = IGEOC 87 : SEGACT MELEME 88 : NBPOI = NBPOI + NUM(/2) 89 : SEGDES MELEME 90 : SEGDES MSOUPO 91 : 50 CONTINUE 92 : * 93 : * 94 : * 95 : *---------------Initialisation de l'objet nuage------------------------- 96 : * 97 : NVAR = NBMO 98 : SEGINI MNUAGE 99 : DO 60 I = 1,NVAR 100 : NUANOM(I) = MOTS(I) 101 : 60 CONTINUE 102 : NBCOUP = NBPOI 103 : DO 70 I = 1,NVAR 104 : NUATYP(I) = 'FLOTTANT' 105 : 70 CONTINUE 106 : 107 : SEGSUP MLMOTS 108 : * 109 : * 110 : *-------------------Création des n-uplets du nuage--------------- 111 : * 112 : *---------A chaque n-uplet correspond une liste de réels--------- 113 : *---------comportant les composantes contenues dans le----------- 114 : *---------champ par point---------------------------------------- 115 : * 116 : *---------Boucle sur les composantes du nuage-------------------- 117 : * 118 : DO 90 I = 1,NVAR 119 : SEGINI NUAVFL 120 : NUAPOI(I) = NUAVFL 121 : IND = 1 122 : * 123 : *---------Boucle sur les sous-maillages-------------------------- 124 : * 125 : DO 100 J = 1,NSOUPO 126 : MSOUPO = IPCHP(J) 127 : SEGACT MSOUPO 128 : MELEME = MSOUPO.IGEOC 129 : SEGACT MELEME 130 : MPOVAL = IPOVAL 131 : SEGACT MPOVAL 132 : N = VPOCHA(/1) 133 : NC = VPOCHA(/2) 134 : * 135 : *---------Boucle sur les points du sous-maillage intégrant------- 136 : *---------une boucle sur les différentes composantes du---------- 137 : *---------point. Remplissage du tableau de valeurs-------------- 138 : * 139 : DO 110 L = 1,N 140 : DO 120 K = 1,NC 141 : IF (NUANOM(I) .EQ. NOCOMP(K)) THEN 142 : NUAFLO(IND) = VPOCHA(L,K) 143 : ENDIF 144 : 120 CONTINUE 145 : IND = IND + 1 146 : 110 CONTINUE 147 : 148 : SEGDES MPOVAL 149 : SEGDES MELEME 150 : SEGDES MSOUPO 151 : 152 : 100 CONTINUE 153 : SEGDES NUAVFL 154 : 155 : 90 CONTINUE 156 : 157 : SEGDES MCHPOI 158 : SEGDES MNUAGE 159 : * 160 : *---------------------Ecriture du nuage--------------------------- 161 : * 161 : CALL ECROBJ('NUAGE ', MNUAGE) 162 : RETURN 163 : * 164 : END 165 :
© Cast3M 2003 - All rights reserved.
Disclaimer