1 : C ENPAPF SOURCE FANDEUR 13/01/29 21:15:30 7683 2 : SUBROUTINE ENPAPF(MSOLUT,ITAB,IBBE1,IBBE2,IBBE3,IMEL,IRETOU,IFORM) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : C===================================================================== 6 : C LECTURE PAS A PAS D'UN MSOLUT: LECTURE D'UN NOUVEAU PAS 7 : C SUR LA BANDE IORES 8 : C APPELE PAR : ENSOLF 9 : C APPELLE : LFCDIE LFCDI2 CREPO1 10 : C ECRIT PAR : FARVACQUE-LENA 11 : C====================================================================== 12 : -INC CCOPTIO 13 : -INC SMSOLUT 14 : -INC SMCHPOI 15 : -INC SMCHAML 16 : SEGMENT/ITAB/(TAB(N1),ITABB(N2)) 17 : SEGMENT/ITBBE2/(ITABE2(NN)) 18 : SEGMENT/ITBBE1/(ITABE1(NN)) 19 : SEGMENT/ITBBE3/(ITABE3(3,N3)) 20 : DIMENSION ILENA(10) 21 : DATA ZERO/0.D0/ 22 : C====================================================================== 23 : C 24 : IRETOU=0 25 : SEGACT MSOLUT 26 : NIPO1=MSOLIS(/1)-4 27 : SEGACT ITAB 28 : N1=TAB(/1) 29 : N2=ITABB(/1) 29 : CALL LFCDI2(IORES,N1,TAB,IRETOU,IFORM) 30 : IF(IRETOU.NE.0) GOTO 1000 30 : CALL LFCDIE(IORES,N2,ITABB,IRETOU,IFORM) 31 : IF(IRETOU.NE.0) GOTO 1000 32 : IF(IIMPI.EQ.5) WRITE(IOIMP,800)(TAB(I),I=1,N1) 33 : IF(IIMPI.EQ.5)WRITE(IOIMP,801)(ITABB(I),I=1,N2) 34 : 800 FORMAT(/' *** TAB ',(5E12.5)) 35 : 801 FORMAT(' ITABB=',3I4,' IPOS DES ENREGISTREMENTS:',12I5) 36 : C 37 : ITBBE1=IBBE1 38 : ITBBE2=IBBE2 39 : ITBBE3=IBBE3 40 : DO 25 III=1,NIPO1 41 : NENRE=ITABB(4+III)-ITABB(3+III) 42 : ITABE1(2*III-1)=0 43 : IF(NENRE.EQ.0) GOTO 26 44 : ISOLIT=MSOLIT(III+4) 45 : IF(ISOLIT.NE.2) GOTO 200 46 : C CHPOINT +++++++++++++++++++++++++ 47 : NSOUPO=NENRE 48 : NAT=1 49 : SEGINI MCHPOI 50 : ITABE1(2*III-1)=MCHPOI 51 : C les chpo contenus dans les objets de type solution sont diffus 52 : JATTRI(1)=1 53 : DO 102 I=1,NSOUPO 54 : J=ITABE2(III)+I 55 : NC=ITABE3(2,J) 56 : SEGINI MSOUPO 57 : N=ITABE3(1,J) 58 : SEGINI MPOVAL 59 : IPOVAL=MPOVAL 60 : L=N*NC 60 : CALL LFCDI2(IORES,L,VPOCHA,IRETOU,IFORM) 61 : IF(IRETOU.NE.0) GOTO 1000 62 : SEGDES MPOVAL,MSOUPO 63 : IPCHP(I)=MSOUPO 64 : 102 CONTINUE 65 : SEGDES MCHPOI 66 : GOTO26 67 : C 68 : 200 IF(ISOLIT.NE.5) GOTO 300 69 : C MCHAML ++++++++++++++++++++++++++ 70 : WRITE(IOIMP,*) 'ENPAPF : ISOLIT = 5 MCHAML ==> CONTACTER SUPPORT' 71 : N1=NENRE 72 : L1 = 0 73 : N3 = 6 74 : SEGINI MCHELM 75 : ITABE1(2*III-1)=MCHELM 76 : DO 202 ISOU=1,N1 77 : J=ITABE2(III)+ISOU 78 : N2 =ITABE3(2,J) 79 : SEGINI,MCHAML 80 : ICHAML(ISOU) = MCHAML 81 : N1PTEL=ITABE3(1,J) 82 : N1EL =ITABE3(3,J) 83 : N2PTEL = 0 84 : N2EL = 0 85 : L=N1PTEL*N1EL 86 : DO k = 1, N2 87 : SEGINI MELVAL 87 : CALL LFCDI2(IORES,L,VELCHE,IRETOU,IFORM) 88 : IF(IRETOU.NE.0) GOTO 1000 89 : SEGDES MELVAL 90 : IELVAL(k)=MELVAL 91 : ENDDO 92 : SEGDES MCHAML 93 : 202 CONTINUE 94 : SEGDES MCHELM 95 : GOTO 26 96 : 300 CONTINUE 97 : 26 CONTINUE 98 : 25 CONTINUE 99 : C 100 : C CAS D UN MODE 101 : C 102 : IF(ITYSOL.NE.'MODE ') GOTO 12 103 : MSOLEN=MSOLIS(4) 104 : SEGACT MSOLEN 105 : IPAS=ISOLEN(/1)+1 106 : N=IPAS 107 : SEGADJ MSOLEN 108 : LVALM=5 109 : NIMOD= 3 110 : SEGINI MMODE 111 : ISOLEN(IPAS)=MMODE 112 : FMMODD(1)=TAB(3) 113 : FMMODD(2)=TAB(4) 114 : FMMODD(3)=TAB(5) 115 : FMMODD(4)=TAB(6) 116 : FMMODD(5)=TAB(7) 117 : IMMODD(1)=ITABB(1) 118 : IMMODD(2)=ITABB(2) 119 : IMMODD(3)=ITABB(3) 120 : SEGDES MMODE,MSOLEN 121 : GOTO 20 122 : C 123 : C CAS D UN DYNAMIQUE 124 : C 125 : 12 IF(ITYSOL.NE.'DYNAMIQU') GOTO 13 126 : MSOLRE=MSOLIS(1) 127 : SEGACT MSOLRE 128 : IPAS=SOLRE(/1)+1 129 : N=IPAS 130 : SEGADJ MSOLRE 131 : SOLRE(IPAS)=TAB(2) 132 : SEGDES MSOLRE 133 : C MSOLEN=MSOLIS(2) 134 : C SEGADJ MSOLEN 135 : C ISOLEN(IPAS)=ITABB(1) 136 : C SEGDES MSOLEN 137 : GOTO 20 138 : 13 CONTINUE 139 : GOTO 20 140 : C 141 : C DANS TOUS LES CAS 142 : C 143 : 20 CONTINUE 144 : IF(IPAS.EQ.1) GOTO 21 145 : IF(IMEL.EQ.0) GOTO21 146 : ITBBE2=IMEL 147 : NN=IPAS 148 : SEGADJ ITBBE2 148 : CALL CREPO1(ZERO,ZERO,ZERO,IPOIN) 149 : ITABE2(IPAS)=IPOIN 150 : 21 CONTINUE 151 : C 152 : DO 30 III=1,NIPO1 153 : MSOLEN=MSOLIS(4+III) 154 : IF(MSOLEN.EQ.0) GOTO 30 155 : SEGACT MSOLEN 156 : N=IPAS 157 : SEGADJ MSOLEN 158 : ISOLEN(IPAS)=ITABE1(2*III-1) 159 : SEGDES MSOLEN 160 : 30 CONTINUE 161 : C 162 : 1000 CONTINUE 163 : SEGDES MSOLUT 164 : RETURN 165 : END 166 : 167 :
© Cast3M 2003 - All rights reserved.
Disclaimer