1 : C PRLIN SOURCE CHAT 09/10/09 21:21:51 6519 2 : SUBROUTINE PRLIN() 3 : IMPLICIT REAL*8 (A-H,O-Z) 4 : IMPLICIT INTEGER (I-N) 5 : C*********************************************************************** 6 : C NOM : PRLIN 7 : C DESCRIPTION : Lecture des données et écriture des résultats 8 : C pour nlin 9 : C 10 : C LANGAGE : ESOPE 11 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) 12 : C mél : gounand@semt2.smts.cea.fr 13 : C*********************************************************************** 14 : C APPELES : PRLIN2 15 : C APPELES (E/S) : LIROBJ, ECROBJ 16 : C APPELE PAR : PILOT ou KOPS 17 : C*********************************************************************** 18 : C SYNTAXE GIBIANE : 19 : C ENTREES : 20 : C SORTIES : * MATLIN (type MATRIK) : matrice de rigidité. 21 : C*********************************************************************** 22 : C VERSION : v3.1, 30/07/04, possiblité de travailler 23 : C dans l'espace de référence 24 : C VERSION : v3, 10/05/04, refonte complète (modif SMPOUET) 25 : C lois de comportement 26 : C VERSION : v2, 22/09/03, refonte complète (modif SMPOUET) 27 : C VERSION : v1, 22/08/03, version initiale 28 : C HISTORIQUE : v1, 22/08/03, création 29 : C HISTORIQUE : 30 : C HISTORIQUE : 31 : C*********************************************************************** 32 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 33 : C en cas de modification de ce sous-programme afin de faciliter 34 : C la maintenance ! 35 : C*********************************************************************** 36 : -INC CCGEOME 37 : -INC CCOPTIO 38 : -INC SMELEME 39 : POINTEUR CGEOM2.MELEME 40 : POINTEUR CSGEO2.MELEME 41 : -INC SMTABLE 42 : POINTEUR TABCPR.MTABLE 43 : POINTEUR TABCDU.MTABLE 44 : C-INC SMLMOTS 45 : C POINTEUR MOTSCL.MLMOTS 46 : -INC SMRIGID 47 : POINTEUR MATLIN.MRIGID 48 : -INC SMCHPOI 49 : POINTEUR CHPLIN.MCHPOI 50 : * 51 : *dbg INTEGER OOOVAL 52 : * 53 : CHARACTER*4 LGDISC 54 : CHARACTER*4 METING 55 : INTEGER LAXI 56 : INTEGER LERF 57 : LOGICAL LERJ 58 : INTEGER IMPR,IRET 59 : * 60 : PARAMETER (NMOT0=2,NMOT1=2,NMOT2=1,NMOT3=2,NMOT4=1) 61 : CHARACTER*4 MOTCL0(NMOT0),MOTCL1(NMOT1) 62 : CHARACTER*4 MOTCL2(NMOT2),MOTCL3(NMOT3) 63 : CHARACTER*4 MOTCL4(NMOT4) 64 : DATA MOTCL0/'TJAC','TPG '/ 65 : DATA MOTCL1/'EREF','ERF1'/ 66 : DATA MOTCL2/'ERRJ'/ 67 : DATA MOTCL3/'CRES','MATK'/ 68 : * DATA MOTCL4/'MREG','NMRE'/ 69 : DATA MOTCL4/'MREG'/ 70 : * 71 : * Executable statements 72 : * 73 : IMPR=0 74 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans prlin' 75 : *dbg NSEGAV=OOOVAL(2,1) 76 : * 77 : * Lecture du mot-cle pour les subroutines de test 78 : * Pas à destination des utilisateurs 79 : * 79 : CALL LIRMOT(MOTCL0,NMOT0,IRAN,0) 80 : IF (IRAN.EQ.1) THEN 80 : CALL TESTJA 81 : RETURN 82 : ELSEIF (IRAN.EQ.2) THEN 82 : CALL TESTPG 83 : RETURN 84 : ENDIF 85 : * 86 : * Lecture de la famille d'espaces de discrétisations 87 : * pour la géométrie 88 : * 88 : CALL LIRCHA(LGDISC,1,IRET) 89 : IF (IRET.NE.4) GOTO 9999 90 : * 91 : * Lecture du maillage de QUAF 92 : * 92 : CALL LIROBJ('MAILLAGE',CGEOM2,1,IRET) 93 : IF (IRET.EQ.0) GOTO 9999 94 : * 95 : * Lecture du maillage surfacique de QUAF (optionnel) 96 : * 96 : CALL LIROBJ('MAILLAGE',CSGEO2,0,IRET) 97 : IF (IRET.EQ.0) THEN 98 : CSGEO2=0 99 : ENDIF 100 : * 101 : * Lecture de la table des coefficients du système d'équations 102 : * pour la variable primale 102 : CALL LIROBJ('TABLE ',TABCPR,1,IRET) 103 : IF (IRET.EQ.0) GOTO 9999 104 : * Lecture de la table des coefficients du système d'équations 105 : * pour la variable duale 105 : CALL LIROBJ('TABLE ',TABCDU,1,IRET) 106 : IF (IRET.EQ.0) GOTO 9999 107 : C* 108 : C* Lecture du mot-cle pour l'axisymétrique 109 : C* Inutile, on peut l'introduire explicitement avec 110 : C* les coefficients. Ca paraît plus propre 111 : C* 112 : C JGM=3 113 : C JGN=4 114 : C SEGINI MOTSCL 115 : C MOTSCL.MOTS(1)='AXIS' 116 : C MOTSCL.MOTS(2)='AXI1' 117 : C MOTSCL.MOTS(3)='AXI2' 117 : C CALL LIRMOT(MOTSCL.MOTS,MOTSCL.MOTS(/2),IRAN,0) 118 : C IF (IFOMOD.EQ.0.AND.IRAN.EQ.0) THEN 119 : C WRITE(IOIMP,*) 'En axi, on attend un des mots-cles :' 120 : C SEGPRT,MOTSCL 121 : C GOTO 9999 122 : C ELSEIF (IFOMOD.NE.0.AND.IRAN.NE.0) THEN 123 : C WRITE(IOIMP,*) 'Le mot-cle ',MOTSCL.MOTS(IRAN), 124 : C $ ' necessite OPTI MODE AXIS.' 125 : C GOTO 9999 126 : C ENDIF 127 : C LAXI=IRAN 128 : C SEGSUP MOTSCL 129 : * 130 : LAXI=IFOMOD 131 : * 132 : * Lecture du mot-cle pour si on discrétise dans l'espace de référence 133 : * ou dans l'espace de référence avec le volume des éléments normalisé 134 : * à 1 135 : * DATA MOTCL1/'EREF','ERF1'/ 136 : * 136 : CALL LIRMOT(MOTCL1,NMOT1,LERF,0) 137 : * 138 : * Lecture du mot-cle pour si on capture les erreurs de changement de 139 : * signe du Jacobien 140 : * DATA MOTCL2/'ERRJ'/ 141 : * 141 : CALL LIRMOT(MOTCL2,NMOT2,IRAN,0) 142 : IF (IRAN.EQ.0) THEN 143 : LERJ=.FALSE. 144 : ELSEIF (IRAN.EQ.1) THEN 145 : LERJ=.TRUE. 146 : ELSE 147 : GOTO 9999 148 : ENDIF 149 : * 150 : * Lecture du mot-cle pour l'assemblage compatible avec RESO 151 : * DATA MOTCL3/'CRES','MATK'/ 152 : * 152 : CALL LIRMOT(MOTCL3,NMOT3,IRESO,0) 153 : * IRESO=2 154 : * 155 : * Lecture du mot-cle pour accélération de NLIN si maillage régulier 156 : * DATA MOTCL4/'MREG'/ 157 : * 157 : CALL LIRMOT(MOTCL4,NMOT4,IMREG,0) 158 : * IMREG=1 159 : * IF (IMREG.EQ.1) WRITE(IOIMP,*) 'MAILLAGE REGULIER' 160 : * 161 : * Lecture de la famille de méthodes d'intégration 162 : * 162 : CALL LIRCHA(METING,0,IRET) 163 : IF (IERR.NE.0) GOTO 9999 164 : IF (IRET.EQ.0) THEN 165 : METING=' ' 166 : ENDIF 167 : C WRITE(IOIMP,*) 'LAXI=',LAXI 168 : C WRITE(IOIMP,*) 'LERF=',LERF 169 : C WRITE(IOIMP,*) 'LERJ=',LERJ 170 : C WRITE(IOIMP,*) 'METING=',METING 171 : * 172 : * Fin des lectures 173 : * 173 : CALL PRLIN2(CGEOM2,LGDISC,CSGEO2,TABCPR,TABCDU,METING,LAXI,LERF, 174 : $ LERJ,IRESO,IMREG, 175 : $ MATLIN,CHPLIN, 176 : $ IMPR,IRET) 177 : IF (IRET.NE.0) THEN 178 : IF (LERJ) GOTO 9666 179 : GOTO 9999 180 : ENDIF 181 : IF ((CHPLIN.EQ.0).AND.(MATLIN.EQ.0)) THEN 182 : WRITE(IOIMP,*) 'Nothing was computed, check your tables' 183 : GOTO 9999 184 : ENDIF 185 : * l'ordre des retours sera normalement, mat chpo = NLIN ... 186 : IF (CHPLIN.NE.0) THEN 186 : CALL ECROBJ('CHPOINT ',CHPLIN) 187 : ENDIF 188 : IF (MATLIN.NE.0) THEN 189 : IF (IRESO.EQ.2) THEN 189 : CALL ECROBJ('MATRIK ',MATLIN) 190 : ELSE 190 : CALL ECROBJ('RIGIDITE',MATLIN) 191 : ENDIF 192 : ENDIF 193 : *dbg NSEGAP=OOOVAL(2,1) 194 : *dbg NSEGD=NSEGAP-NSEGAV 195 : *dbg WRITE(IOIMP,*) 'NLIN : ',NSEGD,' segments crees ', 196 : *dbg $ ' MAT=',MATLIN,' CHP=',CHPLIN 197 : * 198 : * Normal termination 199 : * 200 : IRET=0 201 : RETURN 202 : * 203 : * Format handling 204 : * 205 : * 206 : * Error handling 207 : * 208 : 9666 CONTINUE 209 : IRET=666 210 : RETURN 211 : 9999 CONTINUE 212 : IRET=1 213 : WRITE(IOIMP,*) 'An error was detected in subroutine prlin' 213 : CALL ERREUR(26) 214 : RETURN 215 : * 216 : * End of subroutine PRLIN 217 : * 218 : END 219 : 220 : 221 : 222 : 223 : 224 : 225 : 226 :
© Cast3M 2003 - All rights reserved.
Disclaimer