1 : C ENSOLF SOURCE FANDEUR 10/12/14 21:16:10 6812 2 : SUBROUTINE ENSOLF(ICOLAC,IRET,IFORM) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : C======================================================================= 6 : C LECTURE D'UN OBJET MSOLUT SUR LE FICHIER IORES 7 : C 8 : C APPELE PAR : LIPIL 9 : C APPELLE : LFCDIE ENPAPF LFCDES LFCDIM 10 : C ECRIT PAR :FARVACQUE -LENA 11 : C 12 : C======================================================================= 13 : -INC CCOPTIO 14 : -INC SMELEME 15 : -INC SMCHPOI 16 : C**-INC SMCHELM 17 : -INC SMSOLUT 18 : -INC TMCOLAC 19 : C==== 20 : SEGMENT/ITBBE1/( ITABE1(NN)) 21 : SEGMENT/ITBBE2/( ITABE2(NN)) 22 : SEGMENT/ITBBE3/( ITABE3(L3,N3)) 23 : SEGMENT/ITAB/(TAB(N1),ITABB(N2)) 24 : DIMENSION ILENA(10),ILECBI(2) 25 : C======================================================================= 26 : C 27 : IRET=0 28 : IMEL=0 29 : MSOLUT=0 30 : C READ(IORES,8000,END=1000,ERR=1000) NIPO1,MELEME,L3 31 : NTOTO=3 31 : CALL LFCDIE (IORES,NTOTO,ILENA(1),IRETOU,IFORM) 32 : IF(IRETOU.NE.0) GOTO 1000 33 : NIPO1 =ILENA(1) 34 : ISOMM=ILENA(1)+ILENA(2)+ILENA(3) 35 : IF (ISOMM.EQ.0) GO TO 10 36 : MELEME =ILENA(2) 37 : L3 =ILENA(3) 38 : NIPO=NIPO1+4 39 : SEGINI MSOLUT 40 : MSOLIS(3)=MELEME 41 : C READ(IORES,8001,END=1000,ERR=1000) ITYSOL(1),ITYSOL(2) 42 : NTOTO=2 42 : CALL LFCDIM (IORES,NTOTO,ILECBI,IRETOU,IFORM) 43 : WRITE(ITYSOL,FMT='(2A4)')(ILECBI(IY),IY=1,2) 44 : IF(IRETOU.NE.0) GOTO 1000 45 : NN=2*NIPO1 46 : SEGINI ITBBE1 46 : CALL LFCDIE(IORES,NN,ITABE1,IRETOU,IFORM) 47 : IF(IRETOU.NE.0) GOTO 1000 48 : NN=NIPO1+1 49 : SEGINI ITBBE2 50 : IBBE2=ITBBE2 50 : CALL LFCDIE(IORES,NN,ITABE2,IRETOU,IFORM) 51 : IF(IRETOU.NE.0)GOTO 1000 52 : N3=ITABE2(NN) 53 : SEGINI ITBBE3 54 : L=N3*L3 54 : CALL LFCDIE(IORES,L,ITABE3,IRETOU,IFORM) 55 : IF(IRETOU.NE.0) GOTO1000 56 : DO 1803 III=1,NIPO1 57 : MSOLIT(III+4) = ITABE1(2*III-1) 58 : IF(ITABE1(2*III).EQ.0) GOTO 1803 59 : N=0 60 : SEGINI MSOLEN 61 : MSOLIS(III+4)=MSOLEN 62 : 1803 CONTINUE 63 : C 64 : C ***** CAS DES MODES ET DES SOLUSTAT ET DES PSEUMODES 65 : C 66 : IF(ITYSOL.EQ.'DYNAMIQU') GOTO 1810 67 : N=0 68 : SEGINI MSOLEN 69 : MSOLIS(4)=MSOLEN 70 : ITLAC1=KCOLA(1) 71 : MELEME=ITLAC1.ITLAC(MELEME) 72 : SEGACT MELEME 73 : IF(NUM(/2).NE.1) GOTO 1820 74 : NN=1 75 : SEGINI ITBBE2 76 : IMEL=ITBBE2 77 : ITABE2(1)=NUM(1,1) 78 : 1820 CONTINUE 79 : SEGDES MELEME 80 : GOTO 1849 81 : C 82 : C ***** CAS DES DYNAMIQU 83 : C 84 : 1810 CONTINUE 85 : IF(ITYSOL.NE.'DYNAMIQU') GOTO 1811 86 : SEGINI MSOLRE 87 : MSOLIS(1)=MSOLRE 88 : GOTO 1849 89 : 1811 CONTINUE 90 : C 91 : C******** DANS TOUS LES CAS : LECTURE PAS A PAS ******************** 92 : C 93 : 1849 CONTINUE 94 : N1=7 95 : N2=4+NIPO1 96 : SEGINI ITAB 97 : 1898 CONTINUE 98 : CCCC READ(IORES,700,END=1899,ERR=1899) IQUOI 98 : CALL LFCDES (IORES,IQUOI,IRETOU,IFORM) 99 : IF(IRETOU.NE.0) GOTO 1899 100 : C IQUOI=6 FIN DU MSOLUT , IQUOI=1 LECTURE D'UN NOUVEAU PAS 101 : IF(IQUOI.NE.1) GOTO 1899 101 : CALL ENPAPF(MSOLUT,ITAB,ITBBE1,IBBE2,ITBBE3,IMEL,IRETOU,IFORM) 102 : IF(IRETOU.EQ.0) GOTO 1898 103 : C 104 : C ***FIN DE LECTURE DU MSOLUT:ON REGLE LE PB DU MELEME ATTACHE AUX MODE 105 : C 106 : 1899 CONTINUE 107 : C ON SEGACT MSOLUT CAR IL EST DESACTIVE DANS ENPAPF 108 : SEGACT MSOLUT 109 : ITBBE2=IBBE2 110 : SEGSUP ITAB,ITBBE2,ITBBE3 111 : IF(IMEL.EQ.0) GOTO 1897 112 : ITBBE2=IMEL 113 : SEGACT ITBBE2 114 : NBSOUS=0 115 : NBREF=0 116 : NBNN=1 117 : NPAS=ITABE2(/1) 118 : IF(NPAS.EQ.0) GOTO 1000 119 : NBELEM=NPAS 120 : SEGINI MELEME 121 : DO 1896 I=1,NPAS 122 : NUM(1,I)=ITABE2(I) 123 : 1896 CONTINUE 124 : ITYPEL=1 125 : MSOLIS(3)=-MELEME 126 : SEGDES MELEME 127 : C 128 : C **** ECRITURE COMPLETE DES CHPOINTS,MCHELM ... CONTENUS DANS LES 129 : C **** MSOLEN 130 : C 131 : 1897 CONTINUE 132 : ITLAC1=KCOLA(1) 133 : ITLAC2=KCOLA(11) 134 : ITLAC3=KCOLA(2) 135 : ITLAC4=KCOLA(5) 136 : C 137 : DO 4805 II=5,NIPO 138 : IF(MSOLIS(II).EQ.0.OR.MSOLIT(II).EQ.0) GOTO 4805 139 : MSOLEN=MSOLIS(II) 140 : SEGACT MSOLEN 141 : N=ISOLEN(/1) 142 : IF(N.EQ.0) GOTO 1000 143 : III=II-4 144 : IIVA=ITABE1(2*III) 145 : C 146 : C ** MCHPOI ++++++++++++++ 147 : IF(MSOLIT(II).NE.2) GOTO 4811 148 : MCHPO1=ITLAC3.ITLAC(IIVA) 149 : SEGACT MCHPO1 150 : NSOUPO=MCHPO1.IPCHP(/1) 151 : DO 4834 ISOU=1,NSOUPO 152 : MSOUP1=MCHPO1.IPCHP(ISOU) 153 : SEGACT MSOUP1 154 : 4834 CONTINUE 155 : DO 4830 J=1,N 156 : IF(ISOLEN(J).EQ.0) GOTO 4830 157 : MCHPOI=ISOLEN(J) 158 : SEGACT MCHPOI 159 : MTYPOI=MCHPO1.MTYPOI 160 : MOCHDE=MCHPO1.MOCHDE 161 : DO 4831 ISOU=1,NSOUPO 162 : MSOUPO=IPCHP(ISOU) 163 : MSOUP1=MCHPO1.IPCHP(ISOU) 164 : SEGACT MSOUPO 165 : NC=NOCOMP(/2) 166 : DO 4832 IC=1,NC 167 : 4832 NOCOMP(IC)=MSOUP1.NOCOMP(IC) 168 : IGEOC=ITLAC1.ITLAC(MSOUP1.IGEOC) 169 : SEGDES MSOUPO 170 : 4831 CONTINUE 171 : SEGDES MCHPOI 172 : 4830 CONTINUE 173 : DO 4833 ISOU=1,NSOUPO 174 : MSOUP1=MCHPO1.IPCHP(ISOU) 175 : SEGDES MSOUP1 176 : 4833 CONTINUE 177 : SEGDES MCHPO1 178 : GOTO 4806 179 : C 180 : 4811 IF(MSOLIT(II).NE.5) GO TO 4812 181 : C MCHAML +++++++++++++++++ 182 : MCHEL1=ITLAC4.ITLAC(IIVA) 183 : C* SEGACT MCHEL1 184 : C* NSOU=MCHEL1.IELVAL(/1) 185 : C* DO 4836 J=1,N 186 : C* IF(ISOLEN(J).EQ.0) GOTO 4836 187 : C* MCHELM=ISOLEN(J) 188 : C* SEGACT MCHELM 189 : C* MTYELM=MCHEL1.MTYELM 190 : C* MTYELM=MCHEL1.MTYELM 191 : C* IFOCHE=MCHEL1.IFOCHE 192 : C* IMGCH1=MCHEL1.IMGCH1 193 : C* MOCHEL=MCHEL1.MOCHEL 194 : C* IF (NSOU.EQ.0) GO TO 4840 195 : C* DO 4839 ISOU=1,NSOU 196 : C* INUM(ISOU)=MCHEL1.INUM(ISOU) 197 : C* IAFF(ISOU)=ITLAC2.ITLAC(MCHEL1.IAFF(ISOU)) 198 : C* IHARMO(ISOU)=MCHEL1.IHARMO(ISOU) 199 : 4839 CONTINUE 200 : 4840 CONTINUE 201 : C* SEGDES MCHELM 202 : 4836 CONTINUE 203 : C* SEGDES MCHEL1 204 : C 205 : 4812 CONTINUE 206 : 4806 CONTINUE 207 : SEGDES MSOLEN 208 : 4805 CONTINUE 209 : IRET=MSOLUT 210 : IF(IQUOI.NE.6) IRET=-IRET 211 : SEGDES MSOLUT 212 : 1000 CONTINUE 213 : 10 RETURN 214 : END 215 : 216 :
© Cast3M 2003 - All rights reserved.
Disclaimer