1 : C PRLIN4 SOURCE GOUNAND 06/01/18 21:15:56 5293 2 : SUBROUTINE PRLIN4(TABVDC,TATRAV, 3 : $ IMPR,IRET) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : IMPLICIT INTEGER (I-N) 6 : C*********************************************************************** 7 : C NOM : PRLIN4 8 : C DESCRIPTION : 9 : * Dans PRLIN4, on explicite ce que l'on va vraiment devoir 10 : * calculer dans TATRAV 11 : C 12 : C LANGAGE : ESOPE 13 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) 14 : C mél : gounand@semt2.smts.cea.fr 15 : C*********************************************************************** 16 : C APPELES : 17 : C APPELE PAR : PRLIN2 18 : C*********************************************************************** 19 : C ENTREES : 20 : C SORTIES : 21 : C TRAVAIL : 22 : C 23 : C*********************************************************************** 24 : C VERSION : v1, 19/12/2005, version initiale 25 : C HISTORIQUE : v1, 19/12/2005, création 26 : C HISTORIQUE : 27 : C HISTORIQUE : 28 : C*********************************************************************** 29 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 30 : C en cas de modification de ce sous-programme afin de faciliter 31 : C la maintenance ! 32 : C*********************************************************************** 33 : -INC CCOPTIO 34 : CBEGININCLUDE SLCOMP 35 : SEGMENT COMP 36 : CHARACTER*8 NOMCOM 37 : INTEGER DERCOF(NCOCOF) 38 : LOGICAL LTREF 39 : ENDSEGMENT 40 : SEGMENT COMPS 41 : POINTEUR LISCOM(NBCOMP).COMP 42 : ENDSEGMENT 43 : CENDINCLUDE SLCOMP 44 : POINTEUR MYCOMP.COMP 45 : -INC SMLENTI 46 : POINTEUR LDAT.MLENTI 47 : POINTEUR POWCOF.MLENTI 48 : CBEGININCLUDE SMPOUET 49 : SEGMENT TABGEO 50 : CHARACTER*4 DISGEO 51 : POINTEUR IGEO.MCHAEL 52 : ENDSEGMENT 53 : SEGMENT TABVDC 54 : INTEGER VVARPR(NUMVPR) 55 : INTEGER VVARDU(NUMVDU) 56 : INTEGER VDATPR(NUMDPR) 57 : INTEGER VDATDU(NUMDDU) 58 : INTEGER VCOFPR(NUMCPR) 59 : INTEGER VCOFDU(NUMCDU) 60 : INTEGER ILCPR(NUMDER+1,NUMOP,NUMVPR) 61 : INTEGER ILCDU(NUMDER+1,NUMOP,NUMVDU) 62 : POINTEUR VLCOF(JLCOF).MLENTI 63 : POINTEUR VCOMP(JGCOF).COMP 64 : POINTEUR VLDAT(JGCOF).MLENTI 65 : INTEGER DJSVD(JGVD) 66 : POINTEUR NOMVD(JGVD).MLMOTS 67 : POINTEUR MVD(JGVD).MCHPOI 68 : REAL*8 XVD(JGVD) 69 : CHARACTER*4 DISVD(KGVD) 70 : ENDSEGMENT 71 : SEGMENT TATRAV 72 : POINTEUR VVCOF(JLCOF).MCHEVA 73 : POINTEUR VCOF(JGCOF).MCHEVA 74 : POINTEUR IVD(JGVD).MCHAEL 75 : POINTEUR VD(JGVD).MCHEVA 76 : POINTEUR DVD(JGVD).MCHEVA 77 : POINTEUR FFVD(KGVD).MCHEVA 78 : POINTEUR DFFVD(KGVD).MCHEVA 79 : LOGICAL LVCOF(JGCOF) 80 : LOGICAL LVD(JGVD) 81 : LOGICAL LDVD(JGVD) 82 : LOGICAL LFFVD(KGVD) 83 : LOGICAL LDFFVD(KGVD) 84 : ENDSEGMENT 85 : SEGMENT TABMAT 86 : POINTEUR VMAT(NUMVDU,NUMVPR).MCHAEL 87 : ENDSEGMENT 88 : CENDINCLUDE SMPOUET 89 : * 90 : INTEGER IMPR,IRET 91 : * 92 : * 93 : * Executable statements 94 : * 95 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans prlin4' 96 : SEGACT TABVDC 97 : SEGACT TATRAV*MOD 98 : NUMVPR=TABVDC.VVARPR(/1) 99 : NUMVDU=TABVDC.VVARDU(/1) 100 : NUMDER=TABVDC.ILCPR(/1)-1 101 : NUMOP=TABVDC.ILCPR(/2) 102 : JLCOF=TATRAV.VVCOF(/1) 103 : * Mises à zéro préalables 104 : JGCOF=TATRAV.LVCOF(/1) 105 : DO IJGCOF=1,JGCOF 106 : TATRAV.LVCOF(IJGCOF)=.FALSE. 107 : ENDDO 108 : JGVD=TATRAV.LVD(/1) 109 : DO IJGVD=1,JGVD 110 : TATRAV.LVD(IJGVD)=.FALSE. 111 : TATRAV.LDVD(IJGVD)=.FALSE. 112 : ENDDO 113 : KGVD=TATRAV.LFFVD(/1) 114 : DO IKGVD=1,KGVD 115 : TATRAV.LFFVD(IKGVD)=.FALSE. 116 : TATRAV.LDFFVD(IKGVD)=.FALSE. 117 : ENDDO 118 : * 119 : * Que va-t-on devoir calculer ? On le tagge a 1. 120 : * Parmi les coeffs 121 : DO IJLCOF=1,JLCOF 122 : POWCOF=TABVDC.VLCOF(IJLCOF) 123 : SEGACT POWCOF 124 : DO IPC=1,POWCOF.LECT(/1) 125 : IPOW=POWCOF.LECT(IPC) 126 : IF (IPOW.NE.0) THEN 127 : TATRAV.LVCOF(IPC)=.TRUE. 128 : ENDIF 129 : ENDDO 130 : SEGDES POWCOF 131 : ENDDO 132 : * Parmi les datas et leurs dérivées 133 : DO IJGCOF=1,JGCOF 134 : IF (TATRAV.LVCOF(IJGCOF).EQV..TRUE.) THEN 135 : MYCOMP=TABVDC.VCOMP(IJGCOF) 136 : LDAT =TABVDC.VLDAT(IJGCOF) 137 : SEGACT MYCOMP 138 : NDAT=MYCOMP.DERCOF(/1) 139 : SEGACT LDAT 140 : DO IDAT=1,NDAT 141 : LDER =MYCOMP.DERCOF(IDAT) 142 : IJGVD=LDAT.LECT(IDAT) 143 : * IKGVD=TABVDC.DJSVD(IJGVD) 144 : IF (LDER.EQ.0) THEN 145 : TATRAV.LVD(IJGVD)=.TRUE. 146 : * TATRAV.LFFVD(IKGVD)=.TRUE. 147 : ELSEIF (LDER.EQ.1) THEN 148 : TATRAV.LDVD(IJGVD)=.TRUE. 149 : * TATRAV.LDFFVD(IKGVD)=.TRUE. 150 : ELSEIF (LDER.EQ.2) THEN 151 : TATRAV.LVD(IJGVD)=.TRUE. 152 : * TATRAV.LFFVD(IKGVD)=.TRUE. 153 : TATRAV.LDVD(IJGVD)=.TRUE. 154 : * TATRAV.LDFFVD(IKGVD)=.TRUE. 155 : ELSE 156 : WRITE(IOIMP,*) 'Erreur grave 1' 157 : GOTO 9999 158 : ENDIF 159 : ENDDO 160 : SEGDES LDAT 161 : SEGDES MYCOMP 162 : ENDIF 163 : ENDDO 164 : * Parmi les variables et leurs dérivées 165 : DO IOP=1,NUMOP 166 : DO IDER=0,NUMDER 167 : DO IVARPR=1,NUMVPR 168 : IILCPR=TABVDC.ILCPR(IDER+1,IOP,IVARPR) 169 : IF (IILCPR.NE.0) THEN 170 : IJGVD=TABVDC.VVARPR(IVARPR) 171 : IF (IDER.EQ.0) THEN 172 : TATRAV.LVD(IJGVD)=.TRUE. 173 : ELSE 174 : TATRAV.LDVD(IJGVD)=.TRUE. 175 : ENDIF 176 : ENDIF 177 : ENDDO 178 : DO IVARDU=1,NUMVDU 179 : IILCDU=TABVDC.ILCDU(IDER+1,IOP,IVARDU) 180 : IF (IILCDU.NE.0) THEN 181 : IJGVD=TABVDC.VVARDU(IVARDU) 182 : IF (IDER.EQ.0) THEN 183 : TATRAV.LVD(IJGVD)=.TRUE. 184 : ELSE 185 : TATRAV.LDVD(IJGVD)=.TRUE. 186 : ENDIF 187 : ENDIF 188 : ENDDO 189 : ENDDO 190 : ENDDO 191 : * Parmi les fonctions de forme 192 : DO IJGVD=1,JGVD 193 : IF (TATRAV.LVD(IJGVD).EQV..TRUE.) THEN 194 : IKGVD=TABVDC.DJSVD(IJGVD) 195 : TATRAV.LFFVD(IKGVD)=.TRUE. 196 : IF (TABVDC.MVD(IJGVD).EQ.0) THEN 197 : TATRAV.LVD(IJGVD)=.FALSE. 198 : ENDIF 199 : ENDIF 200 : IF (TATRAV.LDVD(IJGVD).EQV..TRUE.) THEN 201 : IKGVD=TABVDC.DJSVD(IJGVD) 202 : TATRAV.LDFFVD(IKGVD)=.TRUE. 203 : IF (TABVDC.MVD(IJGVD).EQ.0) THEN 204 : TATRAV.LDVD(IJGVD)=.FALSE. 205 : ENDIF 206 : ENDIF 207 : ENDDO 208 : * 209 : * Fin... 210 : * 211 : SEGDES,TATRAV 212 : SEGDES,TABVDC 213 : * 214 : * Normal termination 215 : * 216 : IRET=0 217 : RETURN 218 : * 219 : * Format handling 220 : * 221 : * 222 : * Error handling 223 : * 224 : 9999 CONTINUE 225 : IRET=1 226 : WRITE(IOIMP,*) 'An error was detected in subroutine prlin4' 227 : RETURN 228 : * 229 : * End of subroutine PRLIN4 230 : * 231 : END 232 : 233 : 234 :
© Cast3M 2003 - All rights reserved.
Disclaimer