1 : C WRMTAK SOURCE CHAT 05/01/13 04:12:25 5004 2 : SUBROUTINE WRMTAK(IFSAU,ITLACC,IMAX1,IFORM,IDEB) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : C*********************************************************************** 6 : C NOM : WRMTAK 7 : C DESCRIPTION : Ecriture des objets de type MATRAK sur le 8 : C fichier IFSAU 9 : C (appelé par wrpil.eso) 10 : C 11 : C LANGAGE : ESOPE 12 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF) 13 : C mél : gounand@semt2.smts.cea.fr 14 : C*********************************************************************** 15 : C APPELES (E/S) : ECDIFE (ecriture d'un tableau d'entiers) 16 : C ECDIFR (ecriture d'un tableau de REAL*8) 17 : C*********************************************************************** 18 : C SYNTAXE GIBIANE : SAUV 19 : C ENTREES : IFSAU, numéro du fichier en écriture 20 : C IDEB, IMAX1, indice de début et de fin 21 : C de la pile des objets MATRAK (ITLACC) 22 : C à écrire. 23 : C IFORM, le fichier a ecrire est formaté ou 24 : C non. 25 : C*********************************************************************** 26 : C VERSION : v1, 15/07/98, version initiale 27 : C HISTORIQUE : v1, 15/07/98, création 28 : C HISTORIQUE : 29 : C HISTORIQUE : 30 : C*********************************************************************** 31 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 32 : C en cas de modification de ce sous-programme afin de faciliter 33 : C la maintenance ! 34 : C*********************************************************************** 35 : -INC CCOPTIO 36 : C-INC SMMATRAKANC 37 : C************************************************************************* 38 : C 39 : C REPERAGE ET STOKAGE DES MATRICES ELEMENTAIRES puis assemblees 40 : C 41 : 42 : * LGEOC SPG de la pression et/ou des multiplicateurs de Lagrange 43 : * (points CENTRE ) pour chaque operateur de contrainte 44 : * KGEOC SPG pour la totalite des points CENTRE. 45 : * KGEOS SPG pour la totalite des points SOMMET (Diagonale vitesse) 46 : * KLEMC Connectivites de l'ensemble des contraintes 47 : * LIZAFM(NBSOUS) contient les pointeurs IZAFM des sous-zones 48 : 49 : SEGMENT MATRAK 50 : INTEGER LGEOC(NBOP),IDEBS(NBOP),IFINS(NBOP) 51 : INTEGER LIZAFM(NBSOUS) 52 : INTEGER IKAM0 (NBSOUS) 53 : INTEGER IMEM (NBELC) 54 : INTEGER KLEMC,KGEOS,KGEOC,KDIAG,KCAC,KIZCL,KIZGC 55 : ENDSEGMENT 56 : 57 : SEGMENT IZAFM 58 : REAL*8 AM(NNELP,NP,IESP),RPGI(NELAX) 59 : ENDSEGMENT 60 : C************************************************************************* 61 : -INC SMMATRK1 62 : -INC TMCOLAC 63 : SEGMENT IZA 64 : REAL*8 A(NBVA) 65 : ENDSEGMENT 66 : C 67 : INTEGER NDTAB 68 : INTEGER IEL,I 69 : INTEGER ILENA(7) 70 : C====================================================================== 71 : * 72 : * Executable statements 73 : * 74 : C 75 : C ... BOUCLE SUR LES MATRAK DE LA PILE 76 : DO 1 IEL=IDEB,IMAX1 77 : MATRAK=ITLAC(IEL) 78 : IF (MATRAK.EQ.0) THEN 79 : WRITE(IOIMP,*) 'Failing to save a nil pointer' 80 : WRITE(IOIMP,*) 'MATRAK type object...' 81 : GOTO 9999 82 : ENDIF 83 : C Sauvegarde du chapeau 84 : C Dimensions 85 : SEGACT MATRAK 86 : NBOP =LGEOC(/1) 87 : NBSOUS=LIZAFM(/1) 88 : NBELC =IMEM(/1) 89 : ILENA(1)=NBOP 90 : ILENA(2)=NBSOUS 91 : ILENA(3)=NBELC 92 : NDTAB=3 92 : CALL ECDIFE(IFSAU,NDTAB,ILENA,IFORM) 93 : C Rigidités élémentaires 94 : NDTAB=NBOP 94 : CALL ECDIFE(IFSAU,NDTAB,LGEOC,IFORM) 95 : NDTAB=NBOP 95 : CALL ECDIFE(IFSAU,NDTAB,IDEBS,IFORM) 96 : NDTAB=NBOP 96 : CALL ECDIFE(IFSAU,NDTAB,IFINS,IFORM) 97 : NDTAB=NBSOUS 97 : CALL ECDIFE(IFSAU,NDTAB,LIZAFM,IFORM) 98 : NDTAB=NBSOUS 98 : CALL ECDIFE(IFSAU,NDTAB,IKAM0,IFORM) 99 : NDTAB=NBELC 99 : CALL ECDIFE(IFSAU,NDTAB,IMEM,IFORM) 100 : ILENA( 1)=KLEMC 101 : ILENA( 2)=KGEOS 102 : ILENA( 3)=KGEOC 103 : ILENA( 4)=KDIAG 104 : ILENA( 5)=KCAC 105 : ILENA( 6)=KIZCL 106 : ILENA( 7)=KIZGC 107 : NDTAB=7 107 : CALL ECDIFE(IFSAU,NDTAB,ILENA,IFORM) 108 : C Sauvegarde des IZAFM 109 : DO 11 I=1,NBSOUS 110 : IZAFM=LIZAFM(I) 111 : IF (IZAFM.NE.0) THEN 112 : SEGACT IZAFM 113 : NNELP=AM(/1) 114 : NP =AM(/2) 115 : IESP =AM(/3) 116 : NELAX=RPGI(/1) 117 : ILENA(1)=NNELP 118 : ILENA(2)=NP 119 : ILENA(3)=IESP 120 : ILENA(4)=NELAX 121 : NDTAB=4 121 : CALL ECDIFE(IFSAU,NDTAB,ILENA,IFORM) 122 : NDTAB=NNELP*NP*IESP 122 : CALL ECDIFR(IFSAU,NDTAB,AM,IFORM) 123 : NDTAB=NELAX 123 : CALL ECDIFR(IFSAU,NDTAB,RPGI,IFORM) 124 : SEGDES IZAFM 125 : ENDIF 126 : 11 CONTINUE 127 : C Sauvegarde du IZL 128 : IF (KIZCL.NE.0) THEN 129 : IZL=KIZCL 130 : SEGACT IZL 131 : C Dimensions 132 : NJA=KZA(/1) 133 : NJAN=NUAN(/1) 134 : NJAB=B(/1) 135 : ILENA(1)=NJA 136 : ILENA(2)=NJAN 137 : ILENA(3)=NJAB 138 : ILENA(4)=KZA1 139 : NDTAB=4 139 : CALL ECDIFE(IFSAU,NDTAB,ILENA,IFORM) 140 : C Contenu des tableaux 141 : NDTAB=NJA 141 : CALL ECDIFE(IFSAU,NDTAB,KZA,IFORM) 142 : NDTAB=NJAN 142 : CALL ECDIFE(IFSAU,NDTAB,NUAN,IFORM) 143 : NDTAB=NJAN 143 : CALL ECDIFE(IFSAU,NDTAB,NUNA,IFORM) 144 : NDTAB=NJAN 144 : CALL ECDIFE(IFSAU,NDTAB,IMEL,IFORM) 145 : NDTAB=NJAN 145 : CALL ECDIFE(IFSAU,NDTAB,IMJ,IFORM) 146 : NDTAB=NJAB 146 : CALL ECDIFR(IFSAU,NDTAB,B,IFORM) 147 : C Sauvegarde du IDMAT 148 : IF (KZA1.NE.0) THEN 149 : IDMAT=KZA1 150 : SEGACT IDMAT 151 : C Dimension 152 : NBLK=IDESCR(/1) 153 : ILENA(1)=NBLK 154 : ILENA(2)=IDIAG 155 : NDTAB=2 155 : CALL ECDIFE(IFSAU,NDTAB,ILENA,IFORM) 156 : NDTAB=NBLK 156 : CALL ECDIFE(IFSAU,NDTAB,IDESCR,IFORM) 157 : NDTAB=NBLK+1 157 : CALL ECDIFE(IFSAU,NDTAB,NLDBLK,IFORM) 158 : IF (IDIAG.NE.0) THEN 159 : IZA=IDIAG 160 : SEGACT IZA 161 : NBVA=A(/1) 162 : ILENA(1)=NBVA 163 : NDTAB=1 163 : CALL ECDIFE(IFSAU,NDTAB,ILENA,IFORM) 164 : NDTAB=NBVA 164 : CALL ECDIFR(IFSAU,NDTAB,A,IFORM) 165 : SEGDES IZA 166 : ENDIF 167 : C Sauvegarde des IDBLK 168 : DO 211 INBLK=1,NBLK 169 : IDBLK=IDESCR(INBLK) 170 : IF (IDBLK.NE.0) THEN 171 : SEGACT IDBLK 172 : C Dimension 173 : NLBLK=IDEBLK(/1)-1 174 : ILENA(1)=NLBLK 175 : ILENA(2)=IMAT 176 : ILENA(3)=ILON 177 : NDTAB=3 177 : CALL ECDIFE(IFSAU,NDTAB,ILENA,IFORM) 178 : NDTAB=NLBLK+1 178 : CALL ECDIFE(IFSAU,NDTAB,IDEBLK,IFORM) 179 : IF (IMAT.NE.0) THEN 180 : IZA=IMAT 181 : SEGACT IZA 182 : NBVA=A(/1) 183 : ILENA(1)=NBVA 184 : NDTAB=1 184 : CALL ECDIFE(IFSAU,NDTAB,ILENA,IFORM) 185 : NDTAB=NBVA 185 : CALL ECDIFR(IFSAU,NDTAB,A,IFORM) 186 : SEGDES IZA 187 : ENDIF 188 : SEGDES IDBLK 189 : ENDIF 190 : 211 CONTINUE 191 : SEGDES IDMAT 192 : ENDIF 193 : SEGDES IZL 194 : ENDIF 195 : SEGDES MATRAK 196 : 1 CONTINUE 197 : * 198 : * Normal termination 199 : * 200 : RETURN 201 : * 202 : * Format handling 203 : * 204 : * 205 : * Error handling 206 : * 207 : 9999 CONTINUE 208 : WRITE(IOIMP,*) 'An error was detected in subroutine wrmtak' 209 : RETURN 210 : * 211 : * End of subroutine WRMTIK 212 : * 213 : END 214 : 215 : 216 : 217 : 218 : 219 : 220 : 221 : 222 :
© Cast3M 2003 - All rights reserved.
Disclaimer