1 : C CH2VEC SOURCE GOUNAND 11/06/29 21:15:01 7016 2 : SUBROUTINE CH2VEC(MCHPOI,MINC,KISPG,IDMAT,KVEC,IMPR,IRET) 3 : IMPLICIT REAL*8 (A-H,O-Z) 4 : IMPLICIT INTEGER (I-N) 5 : C*********************************************************************** 6 : C NOM : CH2VEC 7 : C DESCRIPTION : 8 : C 9 : C Ce sp effectue la surcharge : 10 : C chpoint (MCHPOI) -> vecteur (KVEC pointeur de type IZA). 11 : C L'ordonnancement des inconnues est 12 : C donné par MINC, les points concernés par KISPG et IDMAT 13 : C donne le passage num. ancienne -> num. nouvelle (NUAN) 14 : C 15 : C Son alter ego est vec2ch. 16 : C 17 : C Les valeurs non nulles de MCHPOI NE correspondant 18 : C PAS à des inconnues du vecteur KVEC donnent lieu à 19 : C l'émission d'un warning. 20 : C 21 : C 22 : C 23 : C 24 : C LANGAGE : ESOPE 25 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF) 26 : C mél : gounand@semt2.smts.cea.fr 27 : C*********************************************************************** 28 : C APPELES : KRIPAD 29 : C*********************************************************************** 30 : C ENTREES : MCHPOI, MINC, KISPG, IDMAT, IMPR 31 : C ENTREES/SORTIES : KVEC 32 : C SORTIES : IRET 33 : C CODE RETOUR (IRET) : inutilisé (=0 tout marche !) 34 : C 35 : C MCHPOI : pointeur sur segment MCHPOI de l'include SMCHPOI 36 : C chpoint de surchargement pour le vecteur KVEC. 37 : C MINC : pointeur sur segment MINC de l'include SMMATRIK 38 : C décrit l'ordonnancement des inconnues dans une 39 : C certaine numérotation (dite "nouvelle"). 40 : C KISPG : pointeur sur segment MELEME de l'include SMELEME 41 : C support géométrique des inconnues. 42 : C IDMAT : pointeur sur segment IDMAT de l'include SMMATRIK 43 : C contient le tableau NUAN permettant de faire 44 : C le passage numérotation ancienne -> num. "nouvelle". 45 : C IMPR : niveau d'impression 46 : C KVEC : pointeur sur segment IZA de l'include SMMATRIK 47 : C contient le vecteur des inconnues à surcharger. 48 : C (Il est donc initialisé avant l'appel à ch2vec) 49 : C 50 : C*********************************************************************** 51 : C VERSION : v2, 01/12/99 52 : C HISTORIQUE : v1, 01/04/98, création 53 : C HISTORIQUE : v2; 01/12/99, modifs (nouvelle signification de NUAN) 54 : C HISTORIQUE : 55 : C*********************************************************************** 56 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 57 : C en cas de modification de ce sous-programme afin de faciliter 58 : C la maintenance ! 59 : C*********************************************************************** 60 : -INC CCOPTIO 61 : -INC SMMATRIK 62 : POINTEUR KVEC.IZA 63 : -INC SMCHPOI 64 : -INC SMELEME 65 : POINTEUR KISPG.MELEME 66 : -INC SMLENTI 67 : CHARACTER*8 NOMINC 68 : LOGICAL FLINC 69 : * 70 : INTEGER IMPR,IRET 71 : * 72 : INTEGER I1,IN,INBI,INBVA 73 : INTEGER INC,L,N,NBI,NC,NSOUPO 74 : * 75 : IRET=0 76 : C 77 : IF (IMPR.GT.5) WRITE(IOIMP,*) 'Entrée dans ch2vec.eso' 78 : C 79 : IF (IMPR.GT.6) THEN 80 : WRITE(IOIMP,*) ' ch2vec : entrées ' 81 : WRITE(IOIMP,*) ' MCHPOI = ',MCHPOI 82 : WRITE(IOIMP,*) ' MINC = ',MINC 83 : WRITE(IOIMP,*) ' KISPG = ',KISPG 84 : WRITE(IOIMP,*) ' IDMAT = ',IDMAT 85 : ENDIF 86 : C 87 : SEGACT MINC 88 : NBI=LISINC(/2) 89 : C In KRIPAD : SEGACT KISPG 90 : C SEGINI MLENTI 91 : C write(ioimp,*) 'kispg' 91 : C call ecmail(kispg,0) 92 : C write(ioimp,*) 'minc' 93 : C write(ioimp,*) 'minc lisinc',(lisinc(i),i=1,lisinc(/2)) 94 : C write(ioimp,*) 'minc npos ',(npos(i),i=1,npos(/1)) 95 : C do i=1,mpos(/1) 96 : C write(ioimp,*) 'minc mpos (',i,')=',(mpos(i,j),j=1,mpos(/2)) 97 : C enddo 97 : CALL KRIPAD(KISPG,MLENTI) 98 : C write(ioimp,*) 'mlenti ',(lect(i),i=1,lect(/1)) 99 : SEGDES KISPG 100 : SEGACT IDMAT 101 : SEGACT MCHPOI 102 : NSOUPO=IPCHP(/1) 103 : DO 1 L=1,NSOUPO 104 : MSOUPO=IPCHP(L) 105 : SEGACT MSOUPO 106 : NC=NOCOMP(/2) 107 : MELEME=IGEOC 108 : MPOVAL=IPOVAL 109 : SEGACT MELEME 110 : N=NUM(/2) 111 : IF (N.EQ.0) GOTO 15 112 : SEGACT MPOVAL 113 : DO 2 INC=1,NC 114 : NOMINC=NOCOMP(INC)//' ' 115 : FLINC=.FALSE. 116 : C Repeat..until 117 : INBI=1 118 : 21 CONTINUE 119 : IF (NOMINC.EQ.LISINC(INBI)) THEN 120 : FLINC=.TRUE. 121 : ELSEIF (INBI.LT.NBI) THEN 122 : INBI=INBI+1 123 : GOTO 21 124 : ENDIF 125 : IF (.NOT.FLINC) THEN 126 : * WRITE(IOIMP,*) ' ch2vec : Composante ',NOMINC,' unknown ' 127 : ELSE 128 : N=VPOCHA(/1) 129 : DO 3 IN=1,N 130 : I1=LECT(NUM(1,IN)) 131 : IF(I1.EQ.0)THEN 132 : * Silence dans les rangs ! 133 : * WRITE(IOIMP,*) ' ch2vec : le point ',NUM(1,IN), 134 : * $ ' inconnue : ', NOCOMP(INC) 135 : * WRITE(IOIMP,*) ' n''appartient pas au vec.' 136 : ELSE 137 : IF (MPOS(I1,INBI).NE.0) THEN 138 : INBVA=NUAN(NPOS(I1)+MPOS(I1,INBI)-1) 139 : C INBVA=NPOS(NUAN(I1))+MPOS(NUAN(I1),INBI)-1 140 : C KVEC.A(INBVA)=KVEC.A(INBVA)+VPOCHA(IN,INC) 141 : C Je préfère surcharger 142 : C 143 : * WRITE(IOIMP,*) ' ch2vec : le point ',NUM(1,IN), 144 : * $ ' inconnue : ', NOCOMP(INC) , 'valeur ', 145 : * $ VPOCHA(IN,INC) 146 : * WRITE(IOIMP,*) ' attribue au ddl ',INBVA 147 : KVEC.A(INBVA)=VPOCHA(IN,INC) 148 : ENDIF 149 : ENDIF 150 : 3 CONTINUE 151 : ENDIF 152 : 2 CONTINUE 153 : SEGDES MPOVAL 154 : 15 CONTINUE 155 : SEGDES MSOUPO 156 : SEGDES MELEME 157 : 1 CONTINUE 158 : SEGDES MCHPOI 159 : SEGDES IDMAT 160 : SEGSUP MLENTI 161 : SEGDES MINC 162 : * 163 : * Normal termination 164 : * 165 : RETURN 166 : * 167 : * End of CH2VEC 168 : * 169 : END 170 : 171 : 172 : 173 : 174 : 175 : 176 : 177 : 178 : 179 : 180 : 181 :
© Cast3M 2003 - All rights reserved.
Disclaimer