1 : C ECCHAR SOURCE CHAT 05/01/12 23:20:31 5004 2 : SUBROUTINE ECCHAR(MCHARG,jentet) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : C =================================================================== 6 : C = ECRITURE D'UN OBJET CHARGEMENT = 7 : C = = 8 : C = CREATION : 15/10/85 = 9 : C = PROGRAMMEUR : GUILBAUD = 10 : C = EXTENSION : 11/97 = 11 : C = PROGRAMMEUR : KICHENIN = 12 : C =================================================================== 13 : -INC SMCHARG 14 : -INC SMLREEL 15 : -INC CCOPTIO 16 : -INC SMCOORD 17 : 18 : SEGACT MCHARG 19 : NCHAR=KCHARG(/1) 20 : INTERR(1)=MCHARG 21 : INTERR(2)=NCHAR 22 : 23 : * CHARGEMENT de pointeur %i1 qui contient %i2 chargement(s) élémentaire(s) 24 : 25 : WRITE(6,*) ' ' 25 : CALL ERREUR(-111) 26 : WRITE(6,*) ' ' 27 : DO 100 N=1,NCHAR 28 : ICHARG=KCHARG(N) 29 : SEGACT ICHARG 30 : IF((CHATYP.EQ.'CHPOINT ').OR.(CHATYP.EQ.'MCHAML ')) THEN 31 : INTERR(1)=N 32 : MOTERR(1:4) = CHANOM(N) 33 : MOTERR(5:8) = CHALIE(N) 34 : MOTERR(9:12) = CHAMOB(N) 35 : 36 : * Chargement élémentaire %i1 : nom %m1:4 , nature %m5:8, deplacement %m9:12 37 : * Description spatiale : 38 : 38 : CALL ERREUR(-112) 39 : IF(CHATYP.EQ.'CHPOINT ') THEN 40 : IBICHP=ICHPO1 40 : CALL ECCHPO(IBICHP,jentet) 41 : ELSEIF(CHATYP.EQ.'MCHAML ') THEN 42 : IBICHP=ICHPO1 42 : CALL ZPCHEL(IBICHP,jentet) 43 : ENDIF 44 : 45 : * Description temporelle : 46 : 46 : CALL ERREUR(-113) 47 : WRITE(6,*) ' ' 48 : MLREEL=ICHPO2 49 : SEGACT MLREEL 50 : N1=PROG(/1) 51 : INTERR(1)=N1 52 : INTERR(2)=MLREEL 53 : 54 : * Listreel des temps de pointeur %i2 qui contient les %i1 temps suivant : 55 : 55 : CALL ERREUR(-114) 56 : if(jentet.eq.1) n1 = min (n1,10) 57 : IF(N1.NE.0) WRITE(IOIMP,5)(PROG(J),J=1,N1) 58 : 5 FORMAT(5X,10(1X,1PE12.5)) 59 : SEGDES MLREEL 60 : MLREEL=ICHPO3 61 : SEGACT MLREEL 62 : N1=PROG(/1) 63 : INTERR(1)=MLREEL 64 : INTERR(2)=N1 65 : 66 : * Listreel de la fonction de pointeur %i1 qui contient les %i2 valeurs : 67 : 68 : WRITE(6,*) ' ' 68 : CALL ERREUR(-115) 69 : if(jentet.eq.1) n1 = min (n1,10) 70 : IF(N1.NE.0) WRITE(IOIMP,5)(PROG(J),J=1,N1) 71 : WRITE(6,*) ' ' 72 : SEGDES MLREEL 73 : 74 : ELSEIF (CHATYP.EQ.'TABLE ') THEN 75 : INTERR(1)=N 76 : MOTERR(1:4) = CHANOM(N) 77 : MOTERR(5:8) = CHALIE(N) 78 : MOTERR(9:12) = CHAMOB(N) 79 : 80 : * Chargement élémentaire %i1 : nom %m1:4 , nature %m5:8, deplacement %m9:12 81 : * Première table : 82 : 82 : CALL ERREUR(-294) 83 : WRITE(6,*) ' ' 84 : IBITAB = ICHPO1 84 : CALL ECTABL(IBITAB) 85 : 86 : * Deuxième table : 87 : 88 : WRITE(6,*) ' ' 88 : CALL ERREUR(-295) 89 : WRITE(6,*) ' ' 90 : IBITAB = ICHPO2 90 : CALL ECTABL(IBITAB) 91 : WRITE(6,*) ' ' 92 : ENDIF 93 : 94 : c------------------ description du deplacement optionnel ------------- 95 : * Deplacement de type %m1:11 defini par 96 : IF (CHAMOB(N).EQ.'TRAN'.OR.CHAMOB(N).EQ.'ROTA' 97 : & .OR.CHAMOB(N).EQ.'TRAJ') THEN 98 : IF (CHAMOB(N).EQ.'TRAN') MOTERR(1:11) = 'TRANSLATION' 99 : IF (CHAMOB(N).EQ.'ROTA') MOTERR(1:11) = 'ROTATION ' 100 : IF (CHAMOB(N).EQ.'TRAJ') MOTERR(1:11) = 'TRAJECTOIRE' 100 : CALL ERREUR(-323) 101 : WRITE(6,*) ' ' 102 : 103 : IF ((CHAMOB(N).EQ.'TRAN').OR.(CHAMOB(N).EQ.'ROTA')) THEN 104 : * LISTE D'UN POINT 105 : SEGACT MCOORD 106 : IB=ICHPO4 107 : ID=(IDIM+1)*(IB-1) 108 : INTERR(1)=IB 109 : REAERR(1)=XCOOR(ID+1) 110 : REAERR(2)=XCOOR(ID+2) 111 : REAERR(3)=XCOOR(ID+3) 112 : if (idim.eq.3) REAERR(4)=XCOOR(ID+4) 112 : IF (IDIM.EQ.2) CALL ERREUR(-7) 112 : IF (IDIM.EQ.3) CALL ERREUR(-8) 113 : WRITE(6,*) ' ' 114 : 115 : IF((IDIM.EQ.3).AND.(CHAMOB(N).EQ.'ROTA')) THEN 116 : IB=ICHPO5 117 : ID=(IDIM+1)*(IB-1) 118 : INTERR(1)=IB 119 : REAERR(1)=XCOOR(ID+1) 120 : REAERR(2)=XCOOR(ID+2) 121 : REAERR(3)=XCOOR(ID+3) 122 : REAERR(4)=XCOOR(ID+4) 122 : CALL ERREUR(-8) 123 : WRITE(6,*) ' ' 124 : ENDIF 125 : 126 : * Description vitesse : 126 : CALL ERREUR(-324) 127 : WRITE(6,*) ' ' 128 : MLREEL=ICHPO6 129 : SEGACT MLREEL 130 : N1=PROG(/1) 131 : INTERR(1)=N1 132 : INTERR(2)=MLREEL 133 : 134 : * Listreel de pointeur %i2 qui contient les %i1 temps : 134 : CALL ERREUR(-114) 135 : if(jentet.eq.1) n1 = min (n1,10) 136 : IF(N1.NE.0) WRITE(IOIMP,5)(PROG(J),J=1,N1) 137 : SEGDES MLREEL 138 : MLREEL=ICHPO7 139 : SEGACT MLREEL 140 : N1=PROG(/1) 141 : INTERR(1)=MLREEL 142 : INTERR(2)=N1 143 : 144 : * Listreel de pointeur %i1 qui contient les %i2 valeurs : 145 : WRITE(6,*) ' ' 145 : CALL ERREUR(-115) 146 : IF(N1.NE.0) WRITE(IOIMP,5)(PROG(J),J=1,N1) 147 : WRITE(6,*) ' ' 148 : SEGDES MLREEL 149 : 150 : ELSE IF (CHAMOB(N).EQ.'TRAJ') THEN 151 : * Trajectoire decrite par le CHPOINT 151 : CALL ERREUR(-325) 152 : WRITE(6,*) ' ' 153 : IBICHP=ICHPO4 153 : CALL ECCHPO(IBICHP,jentet) 154 : ELSE 155 : ENDIF 156 : ENDIF 157 : 158 : SEGDES ICHARG 159 : 100 CONTINUE 160 : SEGDES MCHARG 161 : RETURN 162 : END 163 : 164 : 165 : 166 : 167 :
© Cast3M 2003 - All rights reserved.
Disclaimer