1 : C CHARGE SOURCE PV 09/03/12 21:16:54 6325 2 : SUBROUTINE CHARGE 3 : C 4 : C--------------------------------------------------------------------- 5 : C 6 : C CREATION DE L'OBJET CHARGEMENT 7 : C 8 : C SYNTAXE : CHARGE = CHAR (MOT) | MCHAML | EVOL | (|'LIE '|) ... 9 : C | CHPOINT | |'LIBR'| 10 : C | TABLE1 TABLE2 | 11 : C 12 : C ... ( | 'TRAN' VEC1 EVOL2 | ) ; 13 : C | 'ROTA' POIN1 (POIN2 si 3D) EVOL2 | 14 : C | 'TRAJ' TABLE3 TABLE4 | 15 : C 16 : C MOT : Nom du chargement 17 : C TABLE1 : Table des temps indicee par des entiers 18 : C TABLE2 : Table des champs (CHPOINT ou MCHAML) indicee par des 19 : C entiers 20 : C Par defaut le chargement est fixe. 3 options permettent de preciser 21 : C un mouvement relatif du chargement par rapport au corps etudie 22 : C TABLE3 : Table des temps indicee par des entiers 23 : C TABLE4 : Table des points de la trajectoire indicee par 24 : C des entiers 25 : C 26 : C CREATION : 22/02/85 27 : C PROGRAMMEUR : GUILBAUD 28 : C MODIFICATION : 02/09/94 29 : C PROGRAMMEUR : JEANVOINE 30 : C EXTENSION : /02/98 KICH 31 : C----------------------------------------------------------------------- 32 : C 33 : IMPLICIT INTEGER(I-N) 34 : -INC CCOPTIO 35 : -INC SMCOORD 36 : -INC SMCHARG 37 : -INC SMCHPOI 38 : -INC SMCHAML 39 : -INC SMTABLE 40 : -INC SMLREEL 41 : -INC SMEVOLL 42 : C SEGMENT ICPR(XCOOR(/1)/(IDIM+1)) 43 : C DIMENSION X(3),Y(4) 44 : COMMON /CTOURN/XPT1,YPT1,ZPT1,XV1,YV1,ZV1,XV2,YV2,ZV2,XVEC,YVEC, 45 : # ZVEC,ANGLE,ICLE 46 : 47 : CHARACTER*4 MOT1,MOT2 48 : IRETO2=0 49 : IRETO3=0 50 : C----------------------- Lecture obligatoire du nom ------------------ 51 : 51 : CALL LIRCHA(MOT1,0,LCHA) 52 : IF (MOT1.EQ.'LIBR'.OR.MOT1.EQ.'LIE '.OR.MOT1.EQ.'STAT'.OR. 53 : $ MOT1.EQ.'TRAN'.OR.MOT1.EQ.'ROTA'.OR.MOT1.EQ.'TRAJ') THEN 54 : MOT2 = MOT1 55 : MOT1 = ' ' 56 : ELSE 57 : MOT2 = ' ' 58 : ENDIF 59 : 60 : C--------------- Lecture du MCHAML,CHPOINT ou TABLE ----------------- 61 : 61 : CALL LIROBJ('TABLE ',ITA1,0,IRETO1) 62 : IF(IRETO1.EQ.0) THEN 62 : CALL LIROBJ('CHPOINT ',ICH1,0,IRETO2) 63 : IF(IRETO2.EQ.0) THEN 63 : CALL LIROBJ('MCHAML ',ICH2,0,IRETO3) 64 : IF(IRETO3.EQ.0) THEN 64 : CALL ERREUR(686) 65 : RETURN 66 : ENDIF 67 : ENDIF 67 : CALL LIROBJ('EVOLUTIO',MEVOLL,1,IRETOU) 68 : ELSE 68 : CALL LIROBJ('TABLE ',ITA2,1,IRETOU) 69 : ENDIF 70 : IF(IERR.NE.0) RETURN 71 : N=1 72 : SEGINI MCHARG 73 : SEGINI ICHARG 74 : KCHARG(1)=ICHARG 75 : CHANAT='FORCE' 76 : IF (LCHA.NE.0) THEN 77 : if(mot1.eq.'PSUI') then 77 : call erreur(994) 78 : return 79 : endif 80 : CHANOM = MOT1 81 : ELSE 82 : CHANOM = ' ' 83 : ENDIF 84 : 85 : *------------------ cas du CHPOINT ou du MCHAML -------------------- 86 : 87 : IF((IRETO2.EQ.1).OR.(IRETO3.EQ.1)) THEN 88 : SEGACT MEVOLL 89 : IEV1 = IEVOLL(/1) 90 : IF (IEV1.NE.1) THEN 90 : CALL ERREUR(687) 91 : SEGDES MEVOLL 92 : RETURN 93 : ENDIF 94 : KEVOLL=IEVOLL(1) 95 : SEGACT KEVOLL 96 : MLREE1 = IPROGX 97 : MLREE2 = IPROGY 98 : SEGACT MLREE1,MLREE2 99 : IF (MLREE1.PROG(/1).LT.2.OR.MLREE2.PROG(/1).LT.2) THEN 100 : * la dimension des LISTREEL doit etre plus grande que 1 101 : SEGDES MEVOLL,KEVOLL,MLREE1,MLREE2 102 : SEGSUP MCHARG,ICHARG 102 : CALL ERREUR(897) 103 : RETURN 104 : ENDIF 105 : SEGDES MLREE1,MLREE2 106 : ICHPO2=IPROGX 107 : ICHPO3=IPROGY 108 : IF(IRETO2.EQ.1) THEN 109 : CHATYP = 'CHPOINT ' 110 : ICHPO1 = ICH1 111 : ELSE 112 : CHATYP = 'MCHAML ' 113 : ICHPO1 = ICH2 114 : ENDIF 115 : IF (CHATYP.EQ.'CHPOINT ') THEN 116 : MCHPOI = ICH1 117 : SEGACT MCHPOI 118 : MSOUPO = IPCHP(1) 119 : SEGACT MSOUPO 120 : IF ((NOCOMP(1).EQ.'FX '.OR.NOCOMP(1).EQ.'FY '.OR. 121 : $ NOCOMP(1).EQ.'FZ '.OR.NOCOMP(1).EQ.'FR '.OR. 122 : $ NOCOMP(1).EQ.'FT '.OR.NOCOMP(1).EQ.'MR '.OR. 123 : $ NOCOMP(1).EQ.'MT '.OR.NOCOMP(1).EQ.'MX '.OR. 124 : $ NOCOMP(1).EQ.'MY '.OR.NOCOMP(1).EQ.'MZ ') 125 : $ .AND.(CHANOM.EQ.' ')) CHANOM = 'MECA' 126 : SEGDES MSOUPO,MCHPOI 127 : ENDIF 128 : SEGDES KEVOLL 129 : SEGDES MEVOLL 130 : 131 : *------------------------- cas des TABLES ----------------------- 132 : 133 : ELSE 134 : CHATYP = 'TABLE ' 135 : ICHPO1 = ITA1 136 : ICHPO2 = ITA2 137 : ENDIF 138 : C----------------------- Lecture des mots-cle optionnels ------------------ 139 : IRETOU = 0 140 : IRETO1 = 0 141 : IRETO2 = 0 141 : IF (MOT2.EQ.' ') CALL LIRCHA(MOT2,0,LCHA) 142 : IF (LCHA.NE.0) THEN 143 : IF (MOT2.EQ.'LIBR') THEN 144 : CHALIE = 'LIBR' 144 : CALL LIRCHA(MOT2,0,LCHA) 145 : ELSEIF(MOT2.EQ.'LIE ') THEN 146 : CHALIE='LIE ' 146 : CALL LIRCHA(MOT2,0,LCHA) 147 : ELSE 148 : CHALIE='LIE ' 149 : ENDIF 150 : ELSE 151 : CHALIE='LIE ' 152 : ENDIF 153 : 154 : IF (LCHA.NE.0) THEN 155 : 156 : IF (MOT2.EQ.'TRAN') THEN 157 : CHAMOB = MOT2 157 : CALL LIROBJ('POINT ',IPO1,1,IRETO1) 158 : IF(IERR.NE.0) RETURN 159 : ICHPO4 = IPO1 159 : CALL LIROBJ('EVOLUTIO',MEVOLL,1,IRETOU) 160 : IF(IERR.NE.0) RETURN 161 : 162 : ELSE IF (MOT2.EQ.'ROTA') THEN 163 : CHAMOB = MOT2 163 : CALL LIROBJ('POINT ',IPT1,1,IRETO1) 164 : IF(IERR.NE.0) RETURN 165 : ICHPO4 = IPT1 166 : IF (IDIM.GE.3) THEN 166 : CALL LIROBJ('POINT ',IPT2,1,IRETO2) 167 : IF(IERR.NE.0) RETURN 168 : ICHPO5 = IPT2 169 : ENDIF 169 : CALL LIROBJ('EVOLUTIO',MEVOLL,1,IRETOU) 170 : IF(IERR.NE.0) RETURN 171 : 172 : ELSE IF (MOT2.EQ.'TRAJ') THEN 173 : CHAMOB = MOT2 173 : CALL LIROBJ('CHPOINT ',ITA1,1,IRETO1) 174 : IF(IERR.NE.0) RETURN 175 : 176 : ELSE 177 : * 178 : GOTO 900 179 : ENDIF 180 : 181 : ELSE 182 : CHAMOB = 'STAT' 183 : ENDIF 184 : * 185 : IF ((MOT2.EQ.'TRAN').OR.(MOT2.EQ.'ROTA')) THEN 186 : SEGACT MEVOLL 187 : IEV1 = IEVOLL(/1) 188 : IF (IEV1.NE.1) THEN 188 : CALL ERREUR(687) 189 : SEGDES MEVOLL 190 : RETURN 191 : ENDIF 192 : KEVOLL=IEVOLL(1) 193 : SEGACT KEVOLL 194 : MLREE1 = IPROGX 195 : MLREE2 = IPROGY 196 : SEGACT MLREE1,MLREE2 197 : IF (MLREE1.PROG(/1).LT.2.OR.MLREE2.PROG(/1).LT.2) THEN 198 : * la dimension des LISTREEL doit etre plus grande que 1 199 : SEGDES MEVOLL,KEVOLL,MLREE1,MLREE2 200 : SEGSUP ICHARG,MCHARG 200 : CALL ERREUR(897) 201 : RETURN 202 : ENDIF 203 : SEGDES MLREE1,MLREE2 204 : ICHPO6=IPROGX 205 : ICHPO7=IPROGY 206 : SEGDES KEVOLL 207 : SEGDES MEVOLL 208 : ELSE IF (MOT2.EQ.'TRAJ') THEN 209 : MCHPO2 = ITA1 210 : SEGACT MCHPO2 211 : NSOUPO = MCHPO2.IPCHP(/1) 212 : IF (NSOUPO.GT.1) THEN 213 : SEGSUP ICHARG,MCHARG 214 : * le champ doit posseder une seule composante 214 : CALL ERREUR(898) 215 : RETURN 216 : ENDIF 217 : MSOUP2 = MCHPO2.IPCHP(1) 218 : SEGDES MCHPO2 219 : SEGACT MSOUP2 220 : NC = MSOUP2.NOCOMP(/2) 221 : IF (NC.GT.1) THEN 222 : SEGSUP ICHARG,MCHARG 223 : SEGDES MSOUP2 224 : * le champ doit posseder une seule composante 224 : CALL ERREUR(898) 225 : RETURN 226 : ENDIF 227 : IF (MSOUP2.NOCOMP(1).NE.'TEMP') THEN 228 : SEGSUP ICHARG,MCHARG 229 : SEGDES MSOUP2 230 : * le nom de la composante doit etre TEMP 230 : CALL ERREUR(898) 231 : RETURN 232 : ENDIF 233 : 234 : ICHPO4 = MCHPO2 235 : ICHPO5 = MSOUP2.IGEOC 236 : MPOVA2 = MSOUP2.IPOVAL 237 : SEGDES MSOUP2 238 : SEGACT MPOVA2 239 : JG = MPOVA2.VPOCHA(/1) 240 : SEGINI MLREE2 241 : ICHPO6 = MLREE2 242 : DO IVO = 1,JG 243 : MLREE2.PROG(IVO) = MPOVA2.VPOCHA(IVO,1) 244 : ENDDO 245 : SEGDES MPOVA2 246 : SEGDES MLREE2 247 : ENDIF 248 : * 249 : 900 CONTINUE 250 : SEGDES ICHARG,MCHARG 250 : CALL ECROBJ('CHARGEME',MCHARG) 251 : RETURN 252 : END 253 : 254 : 255 : 256 : 257 : 258 :
© Cast3M 2003 - All rights reserved.
Disclaimer