1 : C DFOUR2 SOURCE PV 09/03/12 21:19:18 6325 2 : SUBROUTINE DFOUR2(IPCHE1,ANGL,IPCHE2) 3 : 4 : C==================================================================== 5 : C 6 : C ENTREES 7 : C IPCHE1 = CHAMELEM DE TYPE CONTRAINTES OU DEFORMATIONS 8 : C ANGL = ANGLE 9 : C SORTIES 10 : C IPCHE2 = SI SUCCES , POINTEUR SUR UN MCHAML 11 : C 0 SINON 12 : C 13 : C J BROCHARD MARS 87 14 : C NOUVEAUX CHAMELEMS P DOWLATYARI SEP 91 15 : C===================================================================== 16 : IMPLICIT INTEGER(I-N) 17 : IMPLICIT REAL*8(A-H,O-Z) 18 : -INC CCOPTIO 19 : -INC SMCHAML 20 : -INC CCREEL 21 : CHARACTER*4 NOMCOM 22 : 23 : C 24 : ANGL=(ANGL*XPI)/180.D0 25 : C 26 : C-------ON VERIFIE QUE IFOCHE EST BIEN EGAL A 1 27 : C 28 : MCHEL1=IPCHE1 29 : SEGACT MCHEL1 30 : IF(MCHEL1.IFOCHE.NE.1)THEN 31 : MOTERR(1:8)='DFOURIER' 31 : CALL ERREUR(333) 32 : SEGDES MCHEL1 33 : RETURN 34 : ENDIF 35 : C 36 : C ON VERIFIE QUE LE CHAMP/ELEMENT EST BIEN DE TYPE CONTRAINTE OU 37 : C DEFORMATION 38 : C 39 : IF(MCHEL1.TITCHE.EQ.'CONTRAINTES')THEN 40 : ITYPE=1 41 : L1=11 42 : ELSEIF(MCHEL1.TITCHE.EQ.'DEFORMATIONS')THEN 43 : ITYPE=2 44 : L1=12 45 : ELSE 46 : MOTERR(1:8)='DFOURIER' 46 : CALL ERREUR(334) 47 : SEGDES MCHEL1 48 : RETURN 49 : ENDIF 50 : C 51 : N1=MCHEL1.INFCHE(/1) 52 : N3=MCHEL1.INFCHE(/2) 53 : SEGINI MCHELM 54 : IPCHE2=MCHELM 55 : TITCHE=MCHEL1.TITCHE 56 : IFOCHE=1 57 : NSOUS=N1 58 : C 59 : C BOUCLE SUR LES SOUS-ZONES 60 : C 61 : DO 500 ISOUS=1,NSOUS 62 : C 63 : CONCHE(ISOUS)=MCHEL1.CONCHE(ISOUS) 64 : IMACHE(ISOUS)=MCHEL1.IMACHE(ISOUS) 65 : DO 10 IN=1,N3 66 : INFCHE(ISOUS,IN)=MCHEL1.INFCHE(ISOUS,IN) 67 : 10 CONTINUE 68 : C 69 : C ON MET NUMERO DE l'HARMONIQUE A ZERO POUR ADDITIONS FUTURS 70 : C 71 : NHRM=INFCHE(ISOUS,3) 72 : INFCHE(ISOUS,3)=0 73 : C 74 : COSNT=COS(NHRM*ANGL) 75 : SINNT=SIN(NHRM*ANGL) 76 : IF(NHRM.LT.0) THEN 77 : CNT=SINNT 78 : SINNT=COSNT 79 : COSNT=CNT 80 : ENDIF 81 : C 82 : C CREATION DU MCHAML DE LA SOUS-ZONE 83 : C 84 : MCHAM1=MCHEL1.ICHAML(ISOUS) 85 : SEGACT MCHAM1 86 : N2=MCHAM1.IELVAL(/1) 87 : SEGINI MCHAML 88 : ICHAML(ISOUS)=MCHAML 89 : DO 100 ICOMP=1,N2 90 : C 91 : MELVA1=MCHAM1.IELVAL(ICOMP) 92 : SEGACT MELVA1 93 : NBPTEL=MELVA1.VELCHE(/1) 94 : NEL=MELVA1.VELCHE(/2) 95 : NOMCOM=MCHAM1.NOMCHE(ICOMP) 96 : C 97 : IF(NOMCOM.EQ.'SMRR'.OR.NOMCOM.EQ.'SMZZ'.OR. 98 : 1 NOMCOM.EQ.'SMTT'.OR.NOMCOM.EQ.'SMRZ'.OR. 99 : 2 NOMCOM.EQ. 'N11'.OR.NOMCOM.EQ. 'N22'.OR. 100 : 3 NOMCOM.EQ. 'M11'.OR.NOMCOM.EQ. 'M22'.OR. 101 : 4 NOMCOM.EQ.'EPRR'.OR.NOMCOM.EQ.'EPZZ'.OR. 102 : 5 NOMCOM.EQ.'EPTT'.OR.NOMCOM.EQ.'GARZ'.OR. 103 : 6 NOMCOM.EQ.'EPSS'.OR.NOMCOM.EQ.'RTSS'.OR. 104 : 7 NOMCOM.EQ.'RTTT')THEN 105 : C 106 : NOMCHE(ICOMP)=NOMCOM 107 : TYPCHE(ICOMP)='REAL*8' 108 : N1PTEL=NBPTEL 109 : N1EL=NEL 110 : N2PTEL=0 111 : N2EL=0 112 : SEGINI MELVAL 113 : IELVAL(ICOMP)=MELVAL 114 : DO 110 IB=1,NEL 115 : DO 110 IGAU=1,NBPTEL 116 : VELCHE(IGAU,IB)=MELVA1.VELCHE(IGAU,IB)*COSNT 117 : 110 CONTINUE 118 : SEGDES MELVAL,MELVA1 119 : C 120 : ELSEIF(NOMCOM.EQ.'SMRT'.OR.NOMCOM.EQ.'SMZT'.OR. 121 : 1 NOMCOM.EQ. 'N12'.OR.NOMCOM.EQ. 'M12'.OR. 122 : 2 NOMCOM.EQ.'GART'.OR.NOMCOM.EQ.'GAZT'.OR. 123 : 3 NOMCOM.EQ.'GAST'.OR.NOMCOM.EQ.'RTST')THEN 124 : C 125 : NOMCHE(ICOMP)=NOMCOM 126 : TYPCHE(ICOMP)='REAL*8' 127 : N1PTEL=NBPTEL 128 : N1EL=NEL 129 : N2PTEL=0 130 : N2EL=0 131 : SEGINI MELVAL 132 : IELVAL(ICOMP)=MELVAL 133 : DO 120 IB=1,NEL 134 : DO 120 IGAU=1,NBPTEL 135 : VELCHE(IGAU,IB)=MELVA1.VELCHE(IGAU,IB)*SINNT 136 : 120 CONTINUE 137 : SEGDES MELVAL,MELVA1 138 : C 139 : ELSE 140 : MOTERR(1:4)='DFOU' 141 : MOTERR(5:8)=NOMCOM 141 : CALL ERREUR(335) 142 : SEGSUP MCHAML,MCHELM 143 : SEGDES MELVA1 144 : SEGDES MCHAM1,MCHEL1 145 : RETURN 146 : ENDIF 147 : C 148 : 100 CONTINUE 149 : SEGDES MCHAML,MCHAM1 150 : C 151 : 500 CONTINUE 152 : SEGDES MCHEL1,MCHELM 153 : RETURN 154 : END 155 : 156 : 157 : 158 : 159 : 160 : 161 : 162 : 163 : 164 : 165 :
© Cast3M 2003 - All rights reserved.
Disclaimer