1 : C CHAMAS SOURCE FANDEUR 13/01/16 21:15:05 7666 2 : 3 : C======================================================================= 4 : C= C H A M A S = 5 : C= ----------- = 6 : C= = 7 : C= Fonction : = 8 : C= ---------- = 9 : C= Calcul des flux equivalents a des sources volumiques dans le cas = 10 : C= des elements MASSIFs (1D, 2D, 3D). = 11 : C= = 12 : C= Parametres : (E)=Entree (S)=Sortie = 13 : C= ------------ = 14 : C= IPMODE (E) Pointeur sur le segment MMODEL de la structure = 15 : C= IPCHSO (E) Pointeur sur le MCHAML aux noeuds de sources = 16 : C= IPCHEB (E) Pointeur sur le segment MCHAML de CARACTERISTIQUES = 17 : C= (inutilise dans ce sous-programme) 18 : C= NOMDUA (E) Nom de la composante du champ de flux equivalents = 19 : C= IPCHAL (S) Pointeur sur le champ des flux equivalents = 20 : C= = 21 : C= Denis ROBERT, le 01/02/88. = 22 : C======================================================================= 23 : 24 : SUBROUTINE CHAMAS (IPMODE,IPCHSO,IPCHEB,NOMDUA, IPCHAL) 25 : 26 : IMPLICIT INTEGER(I-N) 27 : IMPLICIT REAL*8 (A-H,O-Z) 28 : 29 : -INC CCOPTIO 30 : -INC SMCHAML 31 : -INC SMMODEL 32 : 33 : SEGMENT INFO 34 : INTEGER INFELL(JG) 35 : ENDSEGMENT 36 : 37 : CHARACTER*(*) NOMDUA 38 : 39 : IPCHAL=0 40 : 41 : C 1 - QUELQUES VERIFICATIONS SUR LES DONNEES 42 : C ============================================ 43 : MMODEL=IPMODE 44 : SEGACT,MMODEL 45 : NSOU=KMODEL(/1) 46 : C ===== 47 : C Verification de l'existence de sources pour tout le modele 48 : MCHEL1=IPCHSO 49 : SEGACT,MCHEL1 50 : IF (MCHEL1.IMACHE(/1).NE.NSOU) THEN 50 : CALL ERREUR(21) 51 : GOTO 120 52 : ENDIF 53 : 54 : C 2 - CREATION DU MCHAML GLOBAL (RESULTAT) 55 : C ========================================== 56 : L1=18 57 : N1=NSOU 58 : N3=6 59 : SEGINI,MCHELM 60 : C* IFOCHE=IFOMOD 61 : IFOCHE=IFOUR 62 : TITCHE='SOURCES.VOLUMIQUES' 63 : 64 : C 3 - BOUCLE SUR LES ZONES ELEMENTAIRES DU MODELE (ISOU) 65 : C ======================================================== 66 : ITHER = 0 67 : ITHHY = 0 68 : C 69 : DO ISOU = 1, NSOU 70 : C ===== 71 : C 3.1 - Activation du modele elementaire ISOU 72 : C ===== 73 : IMODEL=KMODEL(ISOU) 74 : SEGACT,IMODEL 75 : NEF = NEFMOD 76 : C* On suppose que l'on a une FORMULATION unique (cf. chaleu.eso) 77 : IF (ISOU.EQ.1) THEN 78 : NFOR = FORMOD(/2) 78 : CALL PLACE(FORMOD,NFOR,ITHER,'THERMIQUE') 79 : IF (ITHER.EQ.0) THEN 79 : CALL PLACE(FORMOD,NFOR,ITHHY,'THERMOHYDRIQUE') 80 : ENDIF 81 : ENDIF 82 : C ===== 83 : C 3.2 - Recherche dans le MCHAML des sources (IPCHSO) du maillage 84 : C (IMAMOD) associe au modele elementaire iSou, puis recuperation 85 : C du MCHAML elementaire de sources associe (IPSONO) 86 : C ===== 87 : DO i = 1, NSOU 88 : IF (MCHEL1.IMACHE(i).EQ.IMAMOD) GOTO 10 89 : ENDDO 89 : CALL ERREUR(21) 90 : SEGSUP,MCHELM 91 : GOTO 100 92 : 10 CONTINUE 93 : MCHAM1 = MCHEL1.ICHAML(i) 94 : SEGACT,MCHAM1 95 : IPSONO=MCHAM1.IELVAL(1) 96 : SEGDES,MCHAM1 97 : C ===== 98 : C 3.4 - Initialisation du MCHAML des flux de chaleur nodaux equivalents 99 : C (MCHAML) associe au modele elementaire iSou (maillage IMAMOD) 100 : C Remplissage des donnees associees a MCHAML dans MCHELM (global) 101 : C ===== 102 : N2=1 103 : SEGINI,MCHAML 104 : NOMCHE(1)=NOMDUA 105 : TYPCHE(1)='REAL*8' 106 : IMACHE(ISOU)=IMAMOD 107 : ICHAML(ISOU)=MCHAML 108 : INFCHE(ISOU,3)=NIFOUR 109 : INFCHE(ISOU,6)=1 110 : C ===== 111 : C 3.5 - Recuperation d'informations sur l'element fini du modele 112 : C elementaire iSou (NEF) 113 : C ===== 114 : IF (ITHER.NE.0 .OR. ITHHY.NE.0) THEN 114 : CALL TSHAPE(NEF,'GAUSS',IPINTE) 115 : ELSE 116 : IF (INFMOD(/1).LT.5) THEN 116 : CALL ELQUOI(NEF,0,5,IPINF,IMODEL) 117 : IF (IERR.NE.0) GOTO 100 118 : INFO=IPINF 119 : IPINTE=INFELL(11) 120 : SEGSUP,INFO 121 : ELSE 122 : IPINTE=INFMOD(5) 123 : ENDIF 124 : ENDIF 125 : C ===== 126 : C 3.6 - Calcul des flux nodaux equivalents (segment MELVAL) 127 : C ===== 128 : IPGEO=IMAMOD 129 : IF (IDIM.EQ.3) THEN 129 : CALL CHAMA3(IPSONO,IPGEO,IPINTE,IPCHEQ) 130 : ELSE IF (IDIM.EQ.2) THEN 130 : CALL CHAMA2(IPSONO,IPGEO,IPINTE,IPCHEQ) 131 : ELSE IF (IDIM.EQ.1) THEN 131 : CALL CHAMA1(IPSONO,IPGEO,IPINTE,IPCHEQ) 132 : ENDIF 133 : IF (IERR.NE.0) THEN 134 : SEGSUP,MCHELM 135 : GOTO 100 136 : ENDIF 137 : IELVAL(1)=IPCHEQ 138 : SEGDES,MCHAML 139 : 58 continue 140 : ENDDO 141 : 142 : C 4 - MENAGE : DESACTIVATION DE SEGMENTS 143 : C ======================================== 144 : IPCHAL=MCHELM 145 : SEGDES,MCHELM 146 : 100 DO i = 1, NSOU 147 : IMODEL=KMODEL(i) 148 : SEGDES,IMODEL 149 : ENDDO 150 : 120 SEGDES,MMODEL,MCHEL1 151 : 152 : RETURN 153 : END 154 : 155 : 156 : 157 : 158 :
© Cast3M 2003 - All rights reserved.
Disclaimer