kecom6
C KECOM6 SOURCE GOUNAND 21/06/02 21:17:04 11022 $ MYFALS, $ IMPR,IRET) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER (I-N) C*********************************************************************** C NOM : KECOM6 C PROJET : Noyau linéaire NLIN C DESCRIPTION : C * On teste les noms des ddls des variables et des coefficients * On verifie egalement qu'il n'y a pas de noeuds à numéro nul dans CGEOME * qui pourrait etre utilises. Ces noeuds nuls sont eventuellement * cree par TRQUAF (cf. PRLIN2) pour permettre l'utilisation d'un * maillage non QUAF en entree de NLIN. C C LANGAGE : ESOPE C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) C mél : gounand@semt2.smts.cea.fr C*********************************************************************** C APPELES : KEEF (recherche de l'élément fini) C APPELE PAR : C*********************************************************************** C ENTREES : C SORTIES : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé C*********************************************************************** C VERSION : v1, 26/09/02, version initiale C HISTORIQUE : v1, 26/09/02, création C HISTORIQUE : C HISTORIQUE : C*********************************************************************** C Prière de PRENDRE LE TEMPS de compléter les commentaires C en cas de modification de ce sous-programme afin de faciliter C la maintenance ! C*********************************************************************** -INC PPARAM -INC CCOPTIO -INC SMELEME POINTEUR CGEOME.MELEME POINTEUR SOUGEO.MELEME -INC SMLMOTS POINTEUR MYLMOT.MLMOTS * Mes includes persos -INC TNLIN *-INC SFALRF POINTEUR MYFALS.FALRFS *-INC SELREF POINTEUR MYLRF.ELREF * CHARACTER*4 MYDISC,MGDIS INTEGER IMPR,IRET * * Fonctions appelées * INTEGER IMAX * INTEGER ICOMP ,ISOUS ,MAXISO INTEGER NSOUS,NDDL,ITQUAF,MAXCMP * * Executable statements * IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans kecom6' * SEGACT CGEOME NSOUS=CGEOME.LISOUS(/1) MAXCMP=0 DO 3 ISOUS=1,NSOUS SOUGEO=CGEOME.LISOUS(ISOUS) SEGACT SOUGEO * On cherche l'élément fini correspondant au QUAF ITQUAF=SOUGEO.ITYPEL $ MYFALS, $ MYLRF, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 SEGACT MYLRF NDDL=MYLRF.NPQUAF(/1) MAXCMP=MAX(MAXCMP,MAXISO) * Le test uniquement sur le 1er element doit etre suffisant DO IDDL=1,NDDL NNQUA=MYLRF.NPQUAF(IDDL) NNGLO=SOUGEO.NUM(NNQUA,1) IF (NNGLO.EQ.0) THEN IGDIS=SOUGEO.ICOLOR(1) MGDIS='QUAF' IF (IGDIS.EQ.1) MGDIS='LINE' IF (IGDIS.EQ.2) MGDIS='QUAD' WRITE(IOIMP,*) 'A discretization space ',MYDISC, $ ' is incompatible with a ',MGDIS,' mesh' GOTO 9999 ENDIF ENDDO SEGDES MYLRF SEGDES SOUGEO 3 CONTINUE SEGACT MYLMOT SEGDES MYLMOT SEGDES CGEOME IF (ICOMP.NE.MAXCMP) THEN WRITE(IOIMP,*) 'Une variable de ddls :' 2019 FORMAT (10(2X,A8) ) * SEGPRT,MYLMOT WRITE(IOIMP,*) $ 'n''est pas compatible avec la discrétisation : ', $ MYDISC GOTO 9999 ENDIF * * Normal termination * IRET=0 RETURN * * Format handling * * * Error handling * 9999 CONTINUE IRET=1 WRITE(IOIMP,*) 'An error was detected in subroutine kecom6' RETURN * * End of subroutine KECOM6 * END
© Cast3M 2003 - Tous droits réservés.
Mentions légales