1 : C FIMAXI SOURCE CHAT 06/08/24 21:35:37 5529 2 : SUBROUTINE FIMAXI 3 : C************************************************************************ 4 : C 5 : C PROJET : CASTEM 2000 6 : C 7 : C NOM : FIMAXI 8 : C 9 : C DESCRIPTION : Subroutine appellée par FIMPVF 10 : C 11 : C Modelisation 2D axi du trem de pression 12 : C 13 : C Calcul du flux/residu 14 : C 15 : C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI) 16 : C 17 : C AUTEUR : A. BECCANTINI, DEN/DM2S/SFME/LTMF 18 : C 19 : C************************************************************************ 20 : C 21 : C*** SYNTAXE 22 : C 23 : C Discrétisation en VF "cell-centered" des équations d'Euler pour 24 : C un gaz parfait polytropique, axi 25 : C Inconnues: densités, quantité de mouvement, énergie totale par 26 : C unité de volumes (variables conservatives) 27 : C 28 : C First order 29 : C 30 : C RESU = 'FIMP' 'VF' 'AXI' 31 : C 'RESI' MODE LMOTC PN GRADP LIMP ; 32 : C 33 : C MODE : MODELE 'EULER' 34 : C 35 : C LMOTC : LISTMOTS, noms des variables conservatives 36 : C 37 : C PN : pression (SPG = 'CENTRE', une seule 38 : C composante, 'SCAL') 39 : C 40 : C GRADP : gradient (SPG = 'CENTRE', 2 composantes, 41 : C 'PX', 'PY') 42 : C 43 : C LIMP : limiteur (SPG = 'CENTRE', 1 composante, 44 : C 'P1') 45 : C 46 : C SORTIES 47 : C 48 : C RESU : residu 49 : C 50 : C 51 : C************************************************************************ 52 : C 53 : C HISTORIQUE (Anomalies et modifications éventuelles) 54 : C 55 : C Created the 24/02/04 56 : C 57 : C 58 : C************************************************************************ 59 : IMPLICIT INTEGER(I-N) 60 : -INC CCOPTIO 61 : -INC SMLMOTS 62 : C 63 : C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR 64 : C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ 65 : C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES 66 : C & ,IECHO, IIMPI, IOSPI 67 : C & ,IDIM, IFICLE, IPREFI 68 : C & ,MCOORD 69 : C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE 70 : C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU 71 : C & ,NORINC,NORVAL,NORIND,NORVAD 72 : C & ,NUCROU, IPSAUV, IREFOR, ISAFOR 73 : C 74 : INTEGER NBOPT, IMET, IRET, MMODEL, ICOND, IDOMA, ICEN 75 : & , IX2D, IY2D, ILIINC, IPN, IGPN, ILGPN, IRES, NBCOMP 76 : & , JGN, JGM, INEFMD, IS2D, IVOL 77 : C 78 : PARAMETER (NBOPT=2) 79 : CHARACTER*8 LOPT(NBOPT), TYPI 80 : CHARACTER*4 MOT1 81 : C 82 : DATA LOPT/'RESI ','JACOCONS'/ 83 : C 83 : CALL LIRMOT(LOPT,NBOPT,IMET,1) 84 : IF(IERR.NE.0)GOTO 9999 85 : IF(IFOMOD .NE. 0)THEN 86 : C 87 : C******* Message d'erreur standard 88 : C 251 2 89 : C Tentative d'utilisation d'une option non implémentée 90 : C 90 : CALL ERREUR(251) 91 : GOTO 9999 92 : ENDIF 93 : C 94 : C**** IMET = 1 -> residuu 95 : C IMET = 2 -> jacobienne 96 : C 97 : IF(IMET .NE. 1)THEN 98 : C 99 : C******* Message d'erreur standard 100 : C 251 2 101 : C Tentative d'utilisation d'une option non implémentée 102 : C 102 : CALL ERREUR(251) 103 : GOTO 9999 104 : ENDIF 105 : C 106 : C**** Table domaine 107 : C 108 : ICOND=1 108 : CALL LIROBJ('MMODEL',MMODEL,ICOND,IRET) 109 : IF(IERR.NE.0)GOTO 9999 109 : CALL LEKMOD(MMODEL,IDOMA,INEFMD) 110 : IF(IERR.NE.0)GOTO 9999 111 : C 112 : C**** Lecture du MELEME SPG des points CENTRE et 113 : C des centres 2D 114 : C 114 : CALL LEKTAB(IDOMA,'CENTRE',ICEN) 115 : IF(IERR .NE. 0) GO TO 9999 116 : TYPI='CHPOINT ' 116 : CALL ACMO(IDOMA,'XCEN2D',TYPI,IX2D) 117 : IF(IERR .NE. 0) GO TO 9999 117 : CALL ACMO(IDOMA,'YCEN2D',TYPI,IY2D) 118 : IF(IERR .NE. 0) GO TO 9999 118 : CALL ACMO(IDOMA,'XXSUR2D',TYPI,IS2D) 119 : IF(IERR .NE. 0) GO TO 9999 119 : CALL ACMO(IDOMA,'XXVOLUM',TYPI,IVOL) 120 : IF(IERR .NE. 0) GO TO 9999 121 : C 122 : C**** Noms de variables conservatives 123 : C 123 : CALL LIROBJ('LISTMOTS',ILIINC,1,IRET) 124 : IF(IERR .NE. 0) GOTO 9999 125 : MLMOTS = ILIINC 126 : SEGACT MLMOTS 127 : NBCOMP = MLMOTS.MOTS(/2) 128 : IF(NBCOMP .NE. 4)THEN 129 : MOTERR(1:40) = 'LISTINCO = ???' 130 : WRITE(IOIMP,*) MOTERR 131 : C 132 : C******* Message d'erreur standard 133 : C 21 2 134 : C Données incompatibles 135 : C 135 : CALL ERREUR(21) 136 : GOTO 9999 137 : ELSE 138 : MOT1=MLMOTS.MOTS(2) 139 : ENDIF 140 : SEGDES MLMOTS 141 : C 142 : C**** Lecture de PN 143 : C 143 : CALL LIROBJ('CHPOINT ',IPN,1,IRET) 144 : IF(IERR .NE. 0) GOTO 9999 145 : C 146 : C**** Control du CHPOINT 147 : C 148 : JGN=4 149 : JGM=1 150 : SEGINI MLMOT1 151 : MLMOT1.MOTS(1)='SCAL' 151 : CALL QUEPO1(IPN, ICEN, MLMOT1) 152 : IF (IERR .NE. 0) GOTO 9999 153 : SEGDES MLMOT1 154 : C 155 : C**** Lecture de GPN 156 : C 156 : CALL LIROBJ('CHPOINT ',IGPN,1,IRET) 157 : IF(IERR .NE. 0) GOTO 9999 158 : C 159 : C**** Control du CHPOINT 160 : C 161 : JGN=4 162 : JGM=2 163 : SEGINI MLMOT2 164 : MLMOT2.MOTS(1)='P1DX' 165 : MLMOT2.MOTS(2)='P1DY' 165 : CALL QUEPO1(IGPN, ICEN, MLMOT2) 166 : IF (IERR .NE. 0) GOTO 9999 167 : SEGSUP MLMOT2 168 : C 169 : C**** Lecture de LGPN 170 : C 170 : CALL LIROBJ('CHPOINT ',ILGPN,1,IRET) 171 : IF(IERR .NE. 0) GOTO 9999 172 : C 173 : C**** Control du CHPOINT 174 : C 175 : SEGACT MLMOT1*MOD 176 : MLMOT1.MOTS(1)='P1 ' 176 : CALL QUEPO1(ILGPN, ICEN, MLMOT1) 177 : IF (IERR .NE. 0) GOTO 9999 178 : SEGDES MLMOT1 179 : C 180 : C**** Creation of RESI 181 : C 182 : SEGACT MLMOT1*MOD 183 : TYPI='CENTRE ' 184 : MLMOT1.MOTS(1)=MOT1 184 : CALL KRCHP1(TYPI,ICEN,IRES,MLMOT1) 185 : IF(IERR.NE.0) GOTO 9999 186 : C 187 : SEGSUP MLMOT1 188 : C 189 : C**** Computation of the residual 190 : C 190 : CALL FIMAX2(ICEN,IX2D,IY2D,IS2D,IVOL,IPN,IGPN,ILGPN,IRES) 191 : IF(IERR.NE.0) GOTO 9999 192 : C 192 : IF(IRES .NE. 0) CALL ECROBJ('CHPOINT',IRES) 193 : C 194 : 9999 CONTINUE 195 : RETURN 196 : END 197 : 198 : 199 : 200 : 201 : 202 :
© Cast3M 2003 - All rights reserved.
Disclaimer