1 : C RECOF2 SOURCE KICH 11/08/11 21:15:46 7079 2 : SUBROUTINE RECOF2(ipmodl,ipcha1,ichp1,ipout) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : 6 : CHARACTER*4 mocom1,motddl 7 : -INC CCOPTIO 8 : -INC SMCHPOI 9 : -INC SMELEME 10 : -INC SMMODEL 11 : -INC SMCHAML 12 : -INC SMCOORD 13 : -INC SMLMOTS 14 : segment icta 15 : integer icpt(ima) 16 : character*4 iccomp(ima) 17 : endsegment 18 : segment icpr(nbpts) 19 : segment modsta 20 : integer pimoda(nmoda),pistat(nstat) 21 : integer ivmoda(nmoda),ivstat(nstat) 22 : endsegment 23 : SEGMENT MSWMIL 24 : CHARACTER*(4) MOTDDL(IA) 25 : ENDSEGMENT 26 : * 27 : PARAMETER(NDEPL=10) 28 : CHARACTER*4 CMOT 29 : CHARACTER*8 CMATE 30 : CHARACTER*(NCONCH) CONM 31 : CHARACTER*4 MLDREE(ndepl),MLDIMA(ndepl) 32 : DATA MLDREE/'UX','UY','UZ','UR','UT','RX','RY','RZ','RT','P'/ 33 : DATA MLDIMA/'IUX','IUY','IUZ','IUR','IUT','IRX','IRY','IRZ','IRT' 34 : &,'IP'/ 35 : 36 : 37 : nstat = 100 38 : kstat = 0 39 : nmoda = 100 40 : kmoda = 0 41 : segini modsta 42 : 43 : nbpts=xcoor(/1)/(idim+1) 44 : segini icpr 45 : ipout = 0 46 : impou = 0 47 : IA = 1 48 : segini mswmil 49 : motddl(1) = 'LX' 50 : 51 : MMODEL = IPMODL 52 : SEGACT MMODEL 53 : NSOUS = KMODEL(/1) 54 : 55 : MCHELM = IPCHA1 56 : segact mchelm 57 : 58 : DO 50 ISOUS=1,NSOUS 59 : IMODEL=KMODEL(ISOUS) 60 : SEGACT IMODEL 61 : CMATE = cmatee 62 : 63 : if (cmate.eq.'STATIQUE'.or.cmate.eq.'MODAL') then 64 : do im = 1 , imache(/1) 65 : if (imache(im).eq.imamod) then 66 : if (conche(im).eq.conmod) then 67 : mchaml = ichaml(im) 68 : segact mchaml 69 : do iv = 1,ielval(/1) 70 : if (nomche(iv).eq.'DEFO') then 71 : 72 : if (cmate.eq.'STATIQUE') then 73 : kstat = kstat + 1 74 : ivstat(kstat) = ielval(iv) 75 : pistat(kstat) = imamod 76 : meleme = imamod 77 : segact meleme 77 : if (itypel.ne.1) call erreur(5) 77 : if (num(/1).ne.1) call erreur(5) 78 : do ip =1, num(/2) 79 : icpr(num(1,ip))=kstat 80 : enddo 81 : if (kstat.eq.nstat) then 82 : nstat = nstat + 100 83 : segadj modsta 84 : endif 85 : endif 86 : if (cmate.eq.'MODAL') then 87 : kmoda = kmoda + 1 88 : ivmoda(kmoda) = ielval(iv) 89 : pimoda(kmoda) = imamod 90 : meleme = imamod 91 : segact meleme 92 : if (itypel.ne.1) then 92 : call erreur(26) 93 : goto 99 94 : endif 95 : if (num(/1).ne.1) then 95 : call erreur(26) 96 : goto 99 97 : endif 98 : do ip =1 ,num(/2) 99 : icpr(num(1,ip))=kmoda 100 : enddo 101 : if (kmoda.eq.nmoda) then 102 : nmoda = nmoda + 100 103 : segadj modsta 104 : endif 105 : endif 106 : melval = ielval(iv) 107 : segact melval 108 : 109 : endif 110 : enddo 111 : segdes mchaml 112 : endif 113 : endif 114 : enddo 115 : endif 116 : 117 : segdes imodel 118 : 50 CONTINUE 119 : nmoda = kmoda 120 : nstat = kstat 121 : segadj modsta 122 : if (nmoda.eq.0.and.nstat.eq.0) then 122 : call erreur(26) 123 : goto 99 124 : endif 125 : 126 : mchpoi = ichp1 127 : segact mchpoi 128 : nsoupo = ipchp(/1) 129 : DO is = 1 ,nsoupo 130 : msoupo = ipchp(is) 131 : segact msoupo 132 : NC = NOCOMP(/2) 133 : ipt1 = igeoc 134 : mpoval = ipoval 135 : segact ipt1,mpoval 136 : N = vpocha(/1) 137 : DO ic = 1,NC 138 : mocom1 = nocomp(ic) 139 : DO 90 ipn = 1 , N 140 : ipts = ipt1.num(1,ipn) 141 : sca1 = vpocha(ipn,ic) 142 : if (mocom1.eq.'BETA'.or.mocom1.eq.'IBET') then 143 : kstat = icpr(ipts) 144 : if (kstat.eq.0) goto 90 145 : melval = ivstat(kstat) 146 : meleme = pistat(kstat) 147 : else if (mocom1.eq.'ALFA'.or.mocom1.eq.'IALF') then 148 : kmoda = icpr(ipts) 149 : if (kmoda.eq.0) goto 90 150 : melval = ivmoda(kmoda) 151 : meleme = pimoda(kmoda) 152 : else 153 : goto 90 154 : endif 155 : 156 : if (mocom1.eq.'BETA'.or.mocom1.eq.'ALFA') then 157 : do ib = 1,num(/2) 158 : if (num(1,ib).eq.ipts) then 159 : ibmn = min(ib,ielche(/2)) 160 : ichin = ielche(1,ibmn) 161 : if (ipout.gt.0) then 162 : ich1 = ipout 162 : call adchpo(ich1,ichin,ipout,1.d0,sca1) 163 : else 163 : call muchpo(ichin,sca1,ipout,1) 164 : endif 165 : endif 166 : enddo 167 : endif 168 : 169 : if (mocom1.eq.'IBET'.or.mocom1.eq.'IALF') then 170 : do ib = 1,num(/2) 171 : if (num(1,ib).eq.ipts) then 172 : ibmn = min(ib,ielche(/2)) 173 : ichin = ielche(1,ibmn) 174 : if (impou.gt.0) then 175 : ich1 = impou 175 : call adchpo(ich1,ichin,impou,1.d0,sca1) 176 : else 176 : call muchpo(ichin,sca1,impou,1) 177 : endif 178 : endif 179 : enddo 180 : endif 181 : 182 : 90 CONTINUE 183 : ENDDO 184 : 185 : segdes msoupo,ipt1,mpoval 186 : ENDDO 187 : 188 : segdes mchpoi 189 : 190 : do ik = 1,nmoda 191 : meleme = pimoda(ik) 192 : segdes meleme 193 : melval = ivmoda(ik) 194 : segdes melval 195 : enddo 196 : do ik = 1,nstat 197 : meleme = pistat(ik) 198 : segdes meleme 199 : melval = ivstat(ik) 200 : segdes melval 201 : enddo 202 : 202 : if (ipout.eq.0) call erreur(26) 203 : ich1 = ipout 204 : MCHPOI=ich1 205 : SEGACT MCHPOI*MOD 206 : JATTRI(1)=1 207 : SEGDES MCHPOI 207 : CALL ENLEV5(ICH1,MSWMIL,ipout) 208 : 209 : if (impou.gt.0) then 209 : CALL ENLEV5(impou,MSWMIL,ich2) 210 : JGN = 4 211 : JGM = ndepl 212 : segini mlmot1,mlmot2 213 : iplm1 = mlmot1 214 : iplm2 = mlmot2 215 : do im = 1,JGM 216 : mlmot1.mots(im) = mldree(im) 217 : mlmot2.mots(im) = mldima(im) 218 : enddo 218 : CALL NOMC2(ich2,IPLM1,IPLM2,impou) 219 : MCHPOI=impou 220 : SEGACT MCHPOI*MOD 221 : JATTRI(1)=1 222 : ipout = impou 223 : segdes mchpoi 223 : CALL FUCHPO(ICH1,impou,IPOUT) 224 : endif 225 : 99 segsup modsta,icpr 226 : 227 : 228 : RETURN 229 : END 230 : 231 : 232 : 233 : 234 :
© Cast3M 2003 - All rights reserved.
Disclaimer