1 : C CAPA7 SOURCE FANDEUR 13/01/16 21:15:02 7666 2 : 3 : C======================================================================= 4 : C= C A P A 7 = 5 : C= --------- = 6 : C= = 7 : C= Fonction : = 8 : C= ---------- = 9 : C= Creation d'un champ par element (MCHAML) contenant les valeurs de = 10 : C= la capacite calorifique equivalente en cas de changement de phase = 11 : C= = 12 : C= Parametres : (E)=Entree (S)=Sortie = 13 : C= ------------ = 14 : C= ITAPHA (E) Table = 15 : C= IPOGEO (E) Maillage ELEMENTAIRE (MELEME) (ACTIF) = 16 : C= ICOQ (E) Non nul si element COQUE, =0 sinon = 17 : C= IPINTE (E) Segment SMINTE de l'element fini (ACTIF) = 18 : C= ICHPHA (S) MCHAML de capacite due au changement de phase = 19 : C======================================================================= 20 : 21 : SUBROUTINE CAPA7 (ITAPHA,IPOGEO,ICOQ,IPINTE, ICHPHA) 22 : 23 : IMPLICIT INTEGER(I-N) 24 : IMPLICIT REAL*8 (A-H,O-Z) 25 : 26 : -INC CCOPTIO 27 : 28 : -INC SMCHAML 29 : -INC SMCHPOI 30 : -INC SMCOORD 31 : -INC SMELEME 32 : -INC SMINTE 33 : 34 : SEGMENT MTRI 35 : INTEGER NPAKET(NX) 36 : REAL*8 TEMPER(NX,2) 37 : INTEGER IPCHPT(2) 38 : ENDSEGMENT 39 : 40 : LOGICAL L0 41 : 42 : PARAMETER ( Epsi = 1.D-5, 43 : & XZero = 0.D0, XUn = 1.D0, X1s2 = 0.5D0 , 44 : & X1s3 = 0.333333333333333333333333333333333333D0 ) 45 : 46 : CHARACTER*4 LNOCO(3) 47 : DATA LNOCO / 'TSUP','TINF','T ' / 48 : 49 : ICHPHA = 0 50 : 51 : C === 52 : C 1 - Recuperation/Verification sur les donnees du changement de phase 53 : C === 54 : C CLAT Chaleur latente du changement de phase (FLOTTANT) 55 : C TPHA1 Temperature 1 du changement de phase (FLOTTANT) 56 : C TPHA2 Temperature 2 du changement de phase (FLOTTANT) 57 : C IPCHP1 Champ de temperatures au pas (CHPOINT) 58 : C IPCHP2 Champ de temperatures au pas N + 1 (CHPOINT) 59 : I0 = 0 60 : X0 = XZero 61 : IP0 = 0 62 : L0 = .FALSE. 62 : CALL ACCTAB(ITAPHA,'MOT ',I0,X0 ,'CHALEUR LATENTE',L0,IP0, 63 : & 'FLOTTANT',I0,CLAT,' ' ,L0,IP0) 63 : CALL ACCTAB(ITAPHA,'MOT ',I0,X0 ,'TPHASE 1',L0,IP0, 64 : & 'FLOTTANT',I0,TPHA1,' ' ,L0,IP0) 64 : CALL ACCTAB(ITAPHA,'MOT ',I0,X0 ,'TPHASE 2',L0,IP0, 65 : & 'FLOTTANT',I0,TPHA2,' ' ,L0,IP0) 65 : CALL ACCTAB(ITAPHA,'MOT ',I0,X0,'CHAMP THERMIQUE 1',L0,IP0, 66 : & 'CHPOINT ',I0,X0,' ' ,L0,IPCHP1) 66 : CALL ACCTAB(ITAPHA,'MOT ',I0,X0,'CHAMP THERMIQUE 2',L0,IP0, 67 : & 'CHPOINT ',I0,X0,' ' ,L0,IPCHP2) 68 : IF (IERR.NE.0) RETURN 69 : TF1 = MIN(TPHA1,TPHA2) 70 : TF2 = MAX(TPHA1,TPHA2) 71 : DTF21 = TF2 - TF1 72 : IF (DTF21.LT.Epsi) THEN 72 : CALL ERREUR(511) 73 : RETURN 74 : ENDIF 75 : DHDTF = SIGN(XUn,(TPHA2-TPHA1)) * CLAT / DTF21 76 : C === 77 : C 2 - Informations sur le maillage considere (IPOGEO) 78 : C === 79 : IPT1 = IPOGEO 80 : c* SEGACT,IPT1 81 : NBNN1 = IPT1.NUM(/1) 82 : NBELE1 = IPT1.NUM(/2) 83 : C === 84 : C 3 - Informations sur le support d'integration (MINTE) 85 : C === 86 : MINTE = IPINTE 87 : c* SEGACT,MINTE 88 : NBPGAU = POIGAU(/1) 89 : C === 90 : C 4 - Initialisation et remplissage du segment de travail MTRI 91 : C === 92 : NX = XCOOR(/1)/(IDIM+1) 93 : SEGINI,MTRI 94 : C- NPAKET(Noeud) = 1 si Noeud est dans le maillage IPOGEO 95 : DO iElt = 1, NBELE1 96 : DO iNoe = 1, NBNN1 97 : MTRI.NPAKET(IPT1.NUM(iNoe,iElt)) = 1 98 : ENDDO 99 : ENDDO 100 : MTRI.IPCHPT(1) = IPCHP1 101 : MTRI.IPCHPT(2) = IPCHP2 102 : C- Recherche de la temperature nodale en debut et fin de pas 103 : C- pour chaque noeud du maillage IPOGEO. 104 : C- Dans le cas des elements COQUEs, la temperature nodale est la 105 : C- moyenne des temperatures T, TSUP et TINF. 106 : C- Si le noeud du maillage IPOGEO n'est pas dans le support des 107 : C- champs de temperatures, sa temperature est arbitrairement nulle. 108 : DO icht = 1, 2 109 : MCHPOI = MTRI.IPCHPT(icht) 110 : SEGACT,MCHPOI 111 : NSOUPO = IPCHP(/1) 112 : DO iSoupo = 1, NSOUPO 113 : MSOUPO = IPCHP(iSoupo) 114 : SEGACT,MSOUPO 114 : CALL PLACE(NOCOMP,NOCOMP(/1),indT,LNOCO(3)) 115 : IF (indT.EQ.0) GOTO 10 116 : C- Verification sur les composantes du CHPOINT pour les coques 117 : IF (ICOQ.NE.0) THEN 117 : CALL PLACE(NOCOMP,NOCOMP(/1),indTI,LNOCO(2)) 117 : CALL PLACE(NOCOMP,NOCOMP(/1),indTS,LNOCO(1)) 118 : IF (indTI.EQ.0 .OR. indTS.EQ.0) THEN 119 : MOTERR(1:4) = LNOCO(1) 120 : IF (indTI.EQ.0) MOTERR(1:4) = LNOCO(2) 120 : CALL ERREUR(181) 121 : GOTO 999 122 : ENDIF 123 : ENDIF 124 : MELEME = IGEOC 125 : SEGACT,MELEME 126 : MPOVAL = IPOVAL 127 : SEGACT,MPOVAL 128 : DO iElt = 1, NUM(/2) 129 : j = NUM(1,iElt) 130 : IF (MTRI.NPAKET(j).NE.0) THEN 131 : MTRI.TEMPER(j,icht) = VPOCHA(iElt,indT) 132 : IF (ICOQ.NE.0) THEN 133 : MTRI.TEMPER(j,icht) = X1s3 * 134 : & ( MTRI.TEMPER(j,icht) + VPOCHA(iELT,indTI) 135 : & + VPOCHA(iELT,indTS) ) 136 : ENDIF 137 : ENDIF 138 : ENDDO 139 : SEGDES,MPOVAL 140 : SEGDES,MELEME 141 : 10 CONTINUE 142 : SEGDES,MSOUPO 143 : ENDDO 144 : SEGDES,MCHPOI 145 : ENDDO 146 : 147 : C === 148 : C 5 - Determination du MCHAML de capacite calorifique du changement 149 : C de phase (terme de chaleur latente) 150 : C === 151 : N2 = 1 152 : SEGINI,MCHAML 153 : NOMCHE(1) = 'C ' 154 : TYPCHE(1) = 'REAL*8' 155 : N1PTEL = NBPGAU 156 : N1EL = NBELE1 157 : N2PTEL = 0 158 : N2EL = 0 159 : SEGINI,MELVAL 160 : IELVAL(1) = MELVAL 161 : C- Remplissage du segment MELVAL pour chaque point de Gauss (iGau) de 162 : C- chacun des elements (iElt) du maillage 163 : DO iElt = 1, NBELE1 164 : DO iGau = 1, NBPGAU 165 : C- Calcul des temperatures T1 et T2 au point de Gauss (iGau) 166 : T1 = XZero 167 : T2 = XZero 168 : DO iNoe = 1, NBNN1 169 : j = IPT1.NUM(iNoe,iElt) 170 : T1 = T1 + MTRI.TEMPER(j,1)*SHPTOT(1,iNoe,iGau) 171 : T2 = T2 + MTRI.TEMPER(j,2)*SHPTOT(1,iNoe,iGau) 172 : ENDDO 173 : C- Calcul du terme de capactite calorifique du au changement de phase 174 : C- (s'il y a lieu) 175 : IF (.NOT.(((T1.LE.TF1).AND.(T2.LE.TF1)).OR. 176 : & ((T1.GE.TF2).AND.(T2.GE.TF2)))) THEN 177 : IF (T1.NE.T2) THEN 178 : DT21 = T2 - T1 179 : DTEFF = X1s2 * (DTF21+DT21-ABS(TF2-T2)-ABS(T1-TF1)) 180 : VELCHE(iGau,iElt) = DHDTF * DTEFF / ABS(DT21) 181 : ELSE 182 : VELCHE(iGau,iElt) = DHDTF 183 : ENDIF 184 : c* ELSE 185 : c* VELCHE(iGau,iElt) = XZero 186 : ENDIF 187 : ENDDO 188 : ENDDO 189 : SEGDES,MELVAL,MCHAML 190 : ICHPHA = MCHAML 191 : 192 : C === 193 : C 6 - MENAGE : Desactivation des segments utilises et crees 194 : C === 195 : 999 CONTINUE 196 : SEGSUP,MTRI 197 : c* SEGDES,IPT1 198 : c* SEGDES,MINTE 199 : 200 : RETURN 201 : END 202 : 203 : 204 :
© Cast3M 2003 - All rights reserved.
Disclaimer