1 : C RLEXF2 SOURCE PV 09/03/12 21:33:53 6325 2 : SUBROUTINE RLEXF2(MCHCEN,MCHLIM,MCHELM,MCHFAC) 3 : C 4 : C**** Variables de COOPTIO 5 : C 6 : C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR 7 : C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ 8 : C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES 9 : C & ,IECHO, IIMPI, IOSPI 10 : C & ,IDIM 11 : C & ,MCOORD 12 : C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE 13 : C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU 14 : C & ,NORINC,NORVAL,NORIND,NORVAD 15 : C & ,NUCROU, IPSAUV 16 : C 17 : IMPLICIT INTEGER(I-N) 18 : -INC CCOPTIO 19 : INTEGER NBNN, NBELEM 20 : -INC SMELEME 21 : -INC SMCHAML 22 : C 23 : -INC SMCHPOI 24 : POINTEUR MCHCEN.MCHPOI, MCHLIM.MCHPOI, MCHFAC.MCHPOI 25 : POINTEUR MPOCEN.MPOVAL, MPOLIM.MPOVAL, MPOFAC.MPOVAL 26 : C 27 : -INC SMLENTI 28 : POINTEUR MLECEN.MLENTI, MLELIM.MLENTI, MLEFAC.MLENTI 29 : C 30 : INTEGER IGEOM, NCOM, NBSOUS, ISOUS, IELEM, NGF, NLF, NGV, NLV 31 : & ,IVOI, ICOM, I2 32 : REAL*8 VAL 33 : CHARACTER*8 NOM1 34 : C 35 : LOGICAL LOGCEN 35 : CALL LICHT(MCHCEN,MPOCEN,NOM1,IGEOM) 36 : IF(IERR.NE.0)GOTO 9999 37 : NCOM=MPOCEN.VPOCHA(/2) 38 : C En LICHT SEGACT*MOD MPOCEN 38 : CALL KRIPAD(IGEOM,MLECEN) 39 : IF(IERR.NE.0)GOTO 9999 40 : C 41 : C**** En KRIPAD 42 : C SEGACT IGEOM 43 : C SEGINI MLECEN 44 : C 45 : MELEME=IGEOM 46 : SEGDES MELEME 47 : C 48 : IF(MCHLIM.GT.0)THEN 48 : CALL LICHT(MCHLIM,MPOLIM,NOM1,IGEOM) 49 : IF(IERR.NE.0)GOTO 9999 50 : C En LICHT SEGACT*MOD MPOLIM 50 : CALL KRIPAD(IGEOM,MLELIM) 51 : IF(IERR.NE.0)GOTO 9999 52 : C 53 : C**** En KRIPAD 54 : C SEGACT IGEOM 55 : C SEGINI MLELIM 56 : C 57 : MELEME=IGEOM 58 : SEGDES MELEME 59 : ELSE 60 : MPOLIM=0 61 : MLELIM=0 62 : ENDIF 63 : C 63 : CALL LICHT(MCHFAC,MPOFAC,NOM1,IGEOM) 64 : IF(IERR.NE.0)GOTO 9999 65 : C En LICHT SEGACT*MOD MPOFAC 65 : CALL KRIPAD(IGEOM,MLEFAC) 66 : IF(IERR.NE.0)GOTO 9999 67 : C 68 : C**** En KRIPAD 69 : C SEGACT IGEOM 70 : C SEGINI MLEFAC 71 : C 72 : MELEME=IGEOM 73 : SEGDES MELEME 74 : C 75 : SEGACT MCHELM 76 : NBSOUS=MCHELM.IMACHE(/1) 77 : C 78 : DO ISOUS=1,NBSOUS,1 79 : MELEME=MCHELM.IMACHE(ISOUS) 80 : MCHAM1=MCHELM.ICHAML(ISOUS) 81 : SEGACT MELEME 82 : SEGACT MCHAM1 83 : MELVA1=MCHAM1.IELVAL(1) 84 : MELVA2=MCHAM1.IELVAL(2) 85 : SEGACT MELVA1 86 : SEGACT MELVA2 87 : NOM1=MCHAM1.NOMCHE(1) 88 : IF(NOM1 .NE. 'alphax ')THEN 89 : WRITE(IOIMP,*) NOM1, '!=', 'alphax ' 90 : C 21 2 91 : C Données incompatibles 91 : CALL ERREUR(21) 92 : GOTO 9999 93 : ENDIF 94 : NOM1=MCHAM1.NOMCHE(2) 95 : IF(NOM1 .NE. 'alphay ')THEN 96 : WRITE(IOIMP,*) NOM1, '!=', 'alphay ' 97 : C 21 2 98 : C Données incompatibles 98 : CALL ERREUR(21) 99 : GOTO 9999 100 : ENDIF 101 : IF(IDIM.EQ.3)THEN 102 : MELVA3=MCHAM1.IELVAL(3) 103 : SEGACT MELVA3 104 : NOM1=MCHAM1.NOMCHE(3) 105 : IF(NOM1 .NE. 'alphaz ')THEN 106 : WRITE(IOIMP,*) NOM1, '!=', 'alphaz ' 107 : C 21 2 108 : C Données incompatibles 108 : CALL ERREUR(21) 109 : GOTO 9999 110 : ENDIF 111 : ENDIF 112 : C 113 : NBNN=MELEME.NUM(/1) 114 : NBELEM=MELEME.NUM(/2) 115 : C 116 : DO IELEM=1,NBELEM,1 117 : NGF=MELEME.NUM(1,IELEM) 118 : NLF=MLEFAC.LECT(NGF) 119 : IF(NLF.EQ.0)THEN 120 : WRITE (IOIMP,*) 'subroutine rlexf2.eso' 120 : CALL ERREUR(5) 121 : GOTO 9999 122 : ENDIF 123 : DO IVOI=2,NBNN,1 124 : NGV=MELEME.NUM(IVOI,IELEM) 125 : NLV=MLECEN.LECT(NGV) 126 : IF(NLV.NE.0)THEN 127 : LOGCEN=.TRUE. 128 : ELSE 129 : LOGCEN=.FALSE. 130 : NLV=MLELIM.LECT(NGV) 131 : IF(NLV.EQ.0)THEN 132 : WRITE(IOIMP,*) 'subroutine rlexf2.eso' 132 : CALL ERREUR(5) 133 : GOTO 9999 134 : ENDIF 135 : ENDIF 136 : DO ICOM = 1, NCOM, 1 137 : IF(LOGCEN)THEN 138 : VAL=MPOCEN.VPOCHA(NLV,ICOM) 139 : ELSE 140 : VAL=MPOLIM.VPOCHA(NLV,ICOM) 141 : ENDIF 142 : I2=(ICOM-1)*IDIM+1 143 : MPOFAC.VPOCHA(NLF,I2)=MPOFAC.VPOCHA(NLF,I2)+ 144 : & (MELVA1.VELCHE(IVOI,IELEM)*VAL) 145 : MPOFAC.VPOCHA(NLF,I2+1)=MPOFAC.VPOCHA(NLF,I2+1)+ 146 : & (MELVA2.VELCHE(IVOI,IELEM)*VAL) 147 : IF(IDIM.EQ.3) 148 : & MPOFAC.VPOCHA(NLF,I2+2)=MPOFAC.VPOCHA(NLF,I2+2)+ 149 : & (MELVA3.VELCHE(IVOI,IELEM)*VAL) 150 : ENDDO 151 : ENDDO 152 : ENDDO 153 : SEGDES MELEME 154 : SEGDES MCHAM1 155 : SEGDES MELVA1 156 : SEGDES MELVA2 157 : IF(IDIM.EQ.3) SEGDES MELVA3 158 : ENDDO 159 : C 160 : SEGDES MCHELM 161 : IF(MPOLIM .NE. 0) THEN 162 : SEGDES MPOLIM 163 : SEGSUP MLELIM 164 : ENDIF 165 : SEGDES MPOFAC 166 : SEGDES MPOCEN 167 : SEGSUP MLECEN 168 : SEGSUP MLEFAC 169 : C 170 : 9999 RETURN 171 : END 172 : 173 : 174 : 175 : 176 :
© Cast3M 2003 - All rights reserved.
Disclaimer