C ZZOIMP SOURCE GOUNAND 25/11/12 21:16:06 12399 SUBROUTINE ZZOIMP(MTABX,MTAB1) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C*********************************************************************** C ----------------------------------------------------------- C --------- TOIMP ---------------------------------------- C ----------------------------------------------------------- C --------- PARAMETRI DELLO OPERATORE (NELLO ORDINE) : ----- C ----------------------------------------------------------- C --------- TENSION ( tau et pression ) --------- C ----------------------------------------------------------- C C SYNTAXE : C C TOIMP (tau pression) C C 1------2 C (R1,AL1) LEF FLUIDE NOEUDS 1 2 C C C C CAS TRIDIMENSIONNEL C 4 ________ 3 C / FLUIDE / C 1 /________/2 C C C*********************************************************************** -INC PPARAM -INC CCOPTIO -INC SMCHAML -INC SMCOORD -INC SMLENTI POINTEUR IZIPAD.MLENTI -INC SMELEME POINTEUR MELEM1.MELEME -INC SMCHPOI POINTEUR IZG1.MCHPOI, IZGG1.MPOVAL POINTEUR IZTU1.MPOVAL POINTEUR MZTO.MPOVAL POINTEUR IZVOL.MPOVAL, IZTCO.MPOVAL -INC SMLMOTS POINTEUR LINCO.MLMOTS CHARACTER*8 NOMZ,NOMA,TYPE,CHAI,TYPC CHARACTER*(LOCOMP) NOM,NOMI LOGICAL LOGI PARAMETER (NTB=1) CHARACTER*8 LTAB(NTB) DIMENSION KTAB(NTB),IXV(3) SAVE IPAS DATA LTAB/'KIZX '/,IPAS/0/ C***************************************************************************** CTOIMP C write(6,*)' Debut TOIMP ' C C- Récupération de la table INCO (pointeur KINC) C CALL LEKTAB(MTAB1,'INCO',KINC) IF(KINC.EQ.0)THEN C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24 MOTERR( 1: 8) = ' INCO ' MOTERR( 9:16) = ' INCO ' MOTERR(17:24) = ' EQEX ' CALL ERREUR(786) RETURN ENDIF C***************************************************************************** C OPTIONS C KIMPL = 0 -> EXPL 1 -> IMPL 2 -> SEMI C KFORM = 0 -> SI 1 -> EF 2 -> VF 3 -> EFMC C IDCEN = 0-> rien 1-> CENTREE 2-> SUPGDC 3-> SUPG 4-> TVISQUEU 5-> CNG IAXI=0 IF(IFOMOD.EQ.0)IAXI=2 C C- Récupération de la table des options KOPT (pointeur KOPTI) C CALL LEKTAB(MTABX,'KOPT',KOPTI) IF (KOPTI.EQ.0) THEN C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24 MOTERR( 1: 8) = ' KOPT ' MOTERR( 9:16) = ' KOPT ' MOTERR(17:24) = ' KIZX ' CALL ERREUR(786) RETURN ENDIF C? CALL ACME(KOPTI,'MTRMASS ',MMPG) C? IPG=0 C? IF(MMPG.EQ.3)IPG=1 C? CALL ACME(KOPTI,'IDCEN',IDCEN) CALL ACME(KOPTI,'KIMPL',KIMPL) CALL ACME(KOPTI,'KFORM',KFORM) IF(KFORM.NE.0.AND.KFORM.NE.1)THEN C Option %m1:8 incompatible avec les données MOTERR( 1: 8) = 'EF/EFM1 ' CALL ERREUR(803) RETURN ENDIF IF (IERR.NE.0) RETURN C write(6,*)' Apres les options ' C***************************************************************************** C C- Récupération de la table DOMAINE associée au domaine local C CALL ACMM(MTABX,'NOMZONE',NOMZ) CALL LEKTAB(MTABX,'DOMZ',MTABZ) IF(MTABZ.EQ.0)THEN C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24 MOTERR( 1: 8) = ' DOMZ ' MOTERR( 9:16) = ' DOMZ ' MOTERR(17:24) = ' KIZX ' CALL ERREUR(786) RETURN ENDIF CALL LEKTAB(MTABZ,'MAILLAGE',MELEME) CALL LEKTAB(MTABZ,'CENTRE',MELEMC) CALL LEKTAB(MTABZ,'XXPSOML',MCHELM) CALL LEKTAB(MTABZ,'XXCOTE',MCHPCO) IF (IERR.NE.0) RETURN SEGACT MELEME SEGACT MCHELM CALL LICHT(MCHPCO,IZTCO,TYPC,IGEOM) NCOT=IZTCO.VPOCHA(/2) C************************************************************************* C VERIFICATIONS SUR LES INCONNUES C C- Récupération du nombre d'inconnues et du nom de l'inconnue NOMI C TYPE='LISTMOTS' CALL ACMO(MTABX,'LISTINCO',TYPE,LINCO) IF (IERR.NE.0) RETURN SEGACT LINCO NBINC=LINCO.MOTS(/2) IF(NBINC.NE.1)THEN C Indice %m1:8 : contient plus de %i1 %m9:16 MOTERR( 1:8) = 'LISTINCO' INTERR(1) = 1 MOTERR(9:16) = ' MOTS ' CALL ERREUR(799) RETURN ENDIF C --> 1 ere Inconnue NOMI=LINCO.MOTS(1) TYPE=' ' CALL ACMO(KINC,NOMI,TYPE,MCHPOI) IF(TYPE.NE.'CHPOINT ')THEN C Indice %m1:8 : ne contient pas un objet de type %m9:16 MOTERR( 1: 8) = 'INC '//NOMI MOTERR( 9:16) = 'CHPOINT ' CALL ERREUR(800) RETURN ELSE CALL LICHT(MCHPOI,IZTU1,TYPC,MELEM1) ENDIF C************************************************************************* C Le domaine de definition est donne par le SPG de la premiere inconnue C Les inconnues suivantes devront posseder ce meme pointeur C On verifie que les points de la zone sont tous inclus dans ce SPG CALL KRIPAD(MELEM1,IZIPAD) IF(IPAS.EQ.0)THEN CALL VERPAD(IZIPAD,MELEME,IRET) IF(IRET.NE.0)THEN C Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique MOTERR(1: 8) = 'INC '//NOMI MOTERR(9:16) = 'CHPOINT ' CALL ERREUR(788) IPAS=0 RETURN ENDIF ENDIF C************************************************************************* C Lecture du coefficient C Type du coefficient : C IK1=0 CHPOINT IK1=1 scalaire IK1=2 vecteur CALL ACME(MTABX,'IARG',IARG) IF(IARG.NE.1)THEN WRITE(6,*)'Opérateur TOIMP : nombre d''arguments incorrect' C Indice %m1:8 : nombre d'arguments incorrect MOTERR(1:8) = 'IARG ' CALL ERREUR(804) RETURN ENDIF IXV(1)=-MELEMC IXV(2)=0 IXV(3)=1 CALL LEKCOF('Opérateur TOIMP :', & MTABX,KINC,1,IXV,MTO,MZTO,NTAU,NC1,IKS,IRET) IF(IRET.EQ.0)RETURN IF(IKS.EQ.2)IKS=1 C write(6,*)' Fin lecture Arguments ' C Fin lecture Arguments ************************************************ C write(6,*)' Kform=',kform,' KIMPL=',kimpl IF(KIMPL.EQ.0)THEN IKIMPL=1 CALL LEKTAB(MTAB1,'KIZG',KIZG) IF(KIZG.EQ.0)THEN CALL CRTABL(KIZG) CALL ECMM(KIZG,'SOUSTYPE','KIZG') CALL ECMO(MTAB1,'KIZG','TABLE ',KIZG) ENDIF TYPE=' ' CALL ACMO(KIZG,NOMI,TYPE,IZG1) IF(TYPE.NE.'CHPOINT ')THEN NC=IZTU1.VPOCHA(/2) TYPE='SOMMET' CALL CRCHPT(TYPE,MELEM1,NC,2,IZG1) CALL ECMO(KIZG,NOMI,'CHPOINT ',IZG1) ENDIF ELSE IKIMPL=-1 NAT=2 NSOUPO=1 SEGACT MELEM1 N=MELEM1.NUM(/2) NC=IZTU1.VPOCHA(/2) NINKO=NC SEGINI MCHPO1,MSOUP1,MPOVA1 MCHPO1.IFOPOI=IFOUR MCHPO1.MOCHDE=TITREE MCHPO1.MTYPOI='SMBR' MCHPO1.JATTRI(1)=2 MCHPO1.IPCHP(1)=MSOUP1 DO 177 N=1,NINKO WRITE(NOM,FMT='(I1)')N NOM=NOM(1:1)//NOMI(1:LOCOMP-1) MSOUP1.NOCOMP(N)=NOM 177 CONTINUE MSOUP1.IGEOC=MELEM1 MSOUP1.IPOVAL=MPOVA1 IZG1=MCHPO1 ENDIF CALL LICHT(IZG1,IZGG1,TYPC,IGEOM) IF(IGEOM.NE.MELEM1)THEN WRITE(6,*)' Opérateur TOIM' WRITE(6,*)' Incompatibilité de SPG entre 1ères inconnues' RETURN ENDIF SEGACT MELEME NBSOUS=LISOUS(/1) IF(NBSOUS.EQ.0)NBSOUS=1 NUTOEL=0 NPTD=IZGG1.VPOCHA(/1) DO 1 L=1,NBSOUS IPT1=MELEME IF(NBSOUS.NE.1)IPT1=LISOUS(L) SEGACT IPT1 MCHAML=ICHAML(L) SEGACT MCHAML MELVAL=IELVAL(1) SEGACT MELVAL NP =IPT1.NUM(/1) NBEL=IPT1.NUM(/2) CALL ZTOIMP(NBEL,NUTOEL,NP,IZIPAD.LECT,IPT1.NUM, & VELCHE,IZTCO.VPOCHA,NCOT,IKIMPL, & IZTU1.VPOCHA,IZGG1.VPOCHA,NPTD,MZTO.VPOCHA,NTAU,IKS) C write(6,*)' TO ' C write(6,1002)(IZGG1.VPOCHA(ii,1),ii=1,nptd) C write(6,*)' TO 2' C write(6,1002)(IZGG1.VPOCHA(ii,2),ii=1,nptd) SEGDES MZTO SEGDES IPT1,MCHAML,MELVAL NUTOEL=NUTOEL+NBEL 1 CONTINUE IF(KIMPL.NE.0)THEN TYPE=' ' CALL ACMO(MTAB1,'SMBR',TYPE,MCHPO2) IF(TYPE.NE.'CHPOINT')THEN C write(6,*)' IZG1=',izg1 CALL ECMO(MTAB1,'SMBR','CHPOINT',IZG1) ELSE CALL ECROBJ('CHPOINT',MCHPO2) CALL ECROBJ('CHPOINT',IZG1) CALL PRFUSE CALL LIROBJ('CHPOINT',MCHPOI,1,IRET) CALL ECMO(MTAB1,'SMBR','CHPOINT',MCHPOI) ENDIF ENDIF SEGDES MELEME SEGDES IZTU1 SEGDES IZG1,IZGG1 SEGDES LINCO SEGSUP IZIPAD IPAS=1 C write(6,*)' FIN TOIMP ' RETURN 90 CONTINUE WRITE(6,*)' Interuption anormale de TOIMP ' C Option %m1:8 incompatible avec les données MOTERR( 1: 8) = ' EF ' CALL ERREUR(803) RETURN 1002 FORMAT(10(1X,1PE11.4)) END