1 : C COTEMO SOURCE PASCAL 12/04/17 21:15:03 7355 2 : SUBROUTINE COTEMO(IP1,MFR) 3 : c----------------------------------------------------------------------- 4 : c 5 : c teste les noms des composantes des MCHAML susceptibles d etre crees 6 : c avec le sous model : on ne veut pas de redondance 7 : c 8 : c----------------------------------------------------------------------- 9 : IMPLICIT INTEGER(I-N) 10 : -INC CCOPTIO 11 : -INC SMELEME 12 : -INC SMMODEL 13 : pointeur nomid1.nomid 14 : segment NOMLIS 15 : CHARACTER*8 LESCOM(NTOT) 16 : CHARACTER*8 lecham(ntot) 17 : endsegment 18 : * 19 : character*8 mocham, moref 20 : 21 : imodel = ip1 22 : ntot = 0 23 : segini nomlis 24 : nfor=formod(/2) 25 : ithe=0 25 : CALL PLACE(FORMOD,NFOR,IMAGN,'MAGNETODYNAMIQUE') 25 : CALL PLACE(FORMOD,NFOR,IDIFF,'DIFFUSION') 25 : CALL PLACE(FORMOD,NFOR,IELEC,'ELECTROSTATIQUE') 25 : CALL PLACE(FORMOD,NFOR,ITHEHY,'THERMOHYDRIQUE') 25 : CALL PLACE(FORMOD,NFOR,IRAYO,'RAYONNEMENT') 25 : CALL PLACE(FORMOD,NFOR,ICONV,'CONVECTION') 25 : CALL PLACE(FORMOD,NFOR,ITHER,'THERMIQUE') 26 : ithe=ithehy+iconv+ither+irayo 27 : 28 : do lm = 1,22 29 : 30 : MOCOMP=0 31 : mocham = ' ' 32 : 33 : goto (1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 34 : & 16, 17, 18, 19, 20, 21, 22) lm 35 : 36 : 1 NBROBL=1 37 : NBRFAC=0 38 : SEGINI NOMID 39 : LESOBL(1)='SCAL ' 40 : MOCOMP=NOMID 41 : mocham = 'RESERVE ' 42 : GOTO 120 43 : * 44 : 2 NBROBL=1 45 : NBRFAC=0 46 : SEGINI NOMID 47 : LESOBL(1)='MAHO ' 48 : MOCOMP=NOMID 49 : mocham = 'MAHOOKE ' 50 : GOTO 120 51 : * 52 : 3 NBROBL=1 53 : NBRFAC=0 54 : SEGINI NOMID 55 : LESOBL(1)='TEMP ' 56 : MOCOMP=NOMID 57 : mocham = 'RESERVE ' 58 : GOTO 120 59 : * 60 : 4 continue 61 : GOTO 120 62 : 5 continue 63 : GOTO 120 64 : * 65 : 6 if(lnomid(1).ne.0) then 66 : mocomp=lnomid(1) 67 : else 67 : CALL IDDEPL(MFR,IFOUR,MOCOMP,NOBL,NFAC) 68 : IF (IDIFF.EQ.1) THEN 69 : nomid = mocomp 70 : segact,nomid*MOD 71 : lesobl(1) = TYMODE(1) 72 : segdes,nomid 73 : ENDIF 74 : endif 75 : mocham = 'DEPLACEM' 76 : GOTO 120 77 : * 78 : 7 if(lnomid(2).ne.0) then 79 : mocomp=lnomid(2) 80 : else 80 : CALL IDFORC(MFR,IFOUR,MOCOMP,NOBL,NFAC) 81 : IF (IDIFF.EQ.1) THEN 82 : nomid = mocomp 83 : segact,nomid*MOD 84 : lesobl(1) = TYMODE(2) 85 : segdes,nomid 86 : ENDIF 87 : endif 88 : mocham = 'FORCES ' 89 : GOTO 120 90 : * 91 : 8 continue 92 : GOTO 120 93 : 9 continue 94 : GOTO 120 95 : * 96 : 10 if(lnomid(3).ne.0) then 97 : mocomp=lnomid(3) 98 : else 98 : CALL IDGRAD(MFR,IFOUR,MOCOMP,NOBL,NFAC) 99 : IF (IDIFF.EQ.1) THEN 100 : nomid = mocomp 101 : segact,nomid*MOD 102 : C*8 lesobl(1)(2:7) = TYMODE(1)(1:6) 103 : lesobl(1)(2:3) = TYMODE(1)(1:2) 104 : segdes,nomid 105 : ENDIF 106 : endif 107 : mocham = 'GRADIENT' 108 : GOTO 120 109 : * 110 : 11 if(lnomid(4).ne.0) then 111 : mocomp=lnomid(4) 112 : else 112 : CALL IDCONT(IMODEL,IFOUR,MOCOMP,NOBL,NFAC) 113 : endif 114 : mocham = 'CONTRAIN' 115 : GOTO 120 116 : * 117 : 12 if(lnomid(5).ne.0) then 118 : mocomp=lnomid(5) 119 : else 119 : CALL IDDEFO(IMODEL,IFOUR,MOCOMP,NOBL,NFAC) 120 : endif 121 : mocham = 'DEFORMAT' 122 : GOTO 120 123 : * 124 : 13 if(lnomid(6).ne.0) then 125 : mocomp=lnomid(6) 126 : else 126 : CALL IDMATR(MFR,IMODEL,MOCOMP,NOBL,NFAC) 127 : endif 128 : mocham = 'MATERIAU' 129 : GOTO 120 130 : * 131 : 14 if(lnomid(7).ne.0) then 132 : mocomp=lnomid(7) 133 : else 133 : CALL IDCARB(MELE,IFOUR,MOCOMP,NOBL,NFAC) 134 : endif 135 : mocham = 'CARACTER' 136 : GOTO 120 137 : * 138 : 15 if(lnomid(8).ne.0) then 139 : mocomp=lnomid(8) 140 : else 140 : CALL IDTEMP(MFR,IFOUR,NPINT,MOCOMP,NOBL,NFAC) 141 : endif 142 : mocham = 'TEMPERAT' 143 : GOTO 120 144 : * 145 : 16 if(lnomid(9).ne.0) then 146 : mocomp=lnomid(9) 147 : else 147 : CALL IDPRIN(MFR,IFOUR,MOCOMP,NOBL,NFAC) 148 : endif 149 : mocham = 'PRINCIPA' 150 : GOTO 120 151 : * 152 : 17 if(lnomid(13).ne.0) then 153 : mocomp=lnomid(13) 154 : else 154 : CALL IDDEIN(IMODEL,IFOUR,MOCOMP,NOBL,NFAC) 155 : endif 156 : mocham = 'DEFINELA' 157 : GOTO 120 158 : * 159 : 18 continue 160 : 19 continue 161 : GOTO 120 162 : * 163 : 20 if(lnomid(10).ne.0) then 164 : mocomp=lnomid(10) 165 : else 165 : CALL IDVARI(MFR,IMODEL,MOCOMP,NOBL,NFAC) 166 : endif 167 : mocham = 'VARINTER' 168 : GOTO 120 169 : * 170 : 21 if(lnomid(11).ne.0) then 171 : mocomp=lnomid(11) 172 : else 172 : CALL IDGRAF(MFR,IFOUR,MOCOMP,NOBL,NFAC) 173 : endif 174 : mocham = 'GRAFLEXI' 175 : GOTO 120 176 : * 177 : 22 if(lnomid(12).ne.0) then 178 : mocomp=lnomid(12) 179 : else 179 : CALL IDPHAS(MFR,IMODEL,MOCOMP,NOBL,NFAC) 180 : endif 181 : mocham = 'PHASES ' 182 : GOTO 120 183 : * 184 : 120 CONTINUE 185 : nomid = mocomp 186 : if (nomid.gt.0) then 187 : segact,nomid 188 : nobl=lesobl(/2) 189 : nfac=lesfac(/2) 190 : nto1 = lescom(/2) 191 : ntot = nto1 + nobl + nfac 192 : * write(6,*) 'lm ', lm, mocham, nobl, nfac,'nto1 ', nto1,mfr 193 : segadj nomlis 194 : do im = 1,(nobl+nfac) 195 : lecham(nto1 + im) = mocham 196 : if (im.le.nobl) then 197 : lescom(nto1 + im) = lesobl(im) 198 : else 199 : lescom(nto1 + im) = lesfac(im - nobl) 200 : endif 201 : enddo 202 : segdes,nomid 203 : endif 204 : 205 : enddo 206 : * 207 : ntot = lescom(/2) 208 : * write(6,*) 'ntot -cotemo', ntot 209 : do 874 in = 1, (ntot - 1) 210 : moref = lescom(in) 211 : mocham = lecham(in) 212 : * write(6,*) 'comp-champ-ref' , in ,moref, mocham 213 : do jm = (in + 1),ntot 214 : * write(6,*) 'comp-champ-tes' , jm, lescom(jm), lecham(jm) 215 : if (lescom(jm).eq.moref) then 216 : if(moref.eq.'EPAI'.and.imagn.ne.0) go to 874 217 : if(moref.eq.'T '. and.ithe.ne.0) go to 874 218 : moterr(1:8) = moref 219 : moterr(9:16) = lecham(in) 220 : moterr(17:24) = lecham(jm) 220 : call erreur(913) 221 : endif 222 : enddo 223 : 874 continue 224 : 225 : segsup nomlis 226 : return 227 : end 228 : 229 : 230 : 231 :
© Cast3M 2003 - All rights reserved.
Disclaimer