C ***************************************************************** C Delos est un mailleur automatique "surfacique" qui genere une C triangulation pour la simulation et/ou la visualisation. C C Licence et conditions d'utilisation de Delos. C C Copyright (C) 1994-2005 ARMINES/Ecole des Mines de Paris C C Ce programme est un logiciel libre ; vous pouvez le redistribuer C et/ou le modifier conformement aux dispositions de la Licence C Publique Generale GNU, telle que publiee par la Free Software C Fondation ; version 2 de la licence, ou encore (a votre choix) C toute version ulterieure. C C Ce programme est distribue dans l'esport qu'il sera utile, mais C SANS AUCUNE GARANTIE ; sans meme la garantie implicite de C COMMERCIALISATION ou D'ADAPTATION A UN OBJET PARTICULIER. Pour C plus de detail, voir la Licence Publique Generale GNU C C Vous devez avoir recu un exemplaire de la Licence Publique C Generale en meme temps que ce programme ; si ce n'est pas le cas, C ecrivez a la Free Software Fondation Inc.,675 Mass Ave,Cambridge, C MA 02139, Etats-Unis. C C Ce logiciel est telechargeable a l'adresse : C C http://www.ensmp.fr/~stab/delos C C vous trouverez egalement, sur ce site, un mode d'emploi complet et C des informations supplementaires. C C ***************************************************************** C ********************************************************************** C FICHIER : DSG_MAIN.F C OBJET : MAILLAGE TRIANGULAIRE D'UNE GEOMETRIE C FONCT. : C OBJET DSTEST : TESTE LA VALIDITE DES PARAMETRES D'ENTREE C C AUTEUR : O. STAB C DATE : 20.07.99 C TESTS : C MODIFICATIONS : C AUTEUR, DATE, OBJET : C C ********************************************************************** C SUBROUTINE DSTEST(NOMD,NOMD2,NOMR,NOMR2,NBPNEW,PRESEN, > ITVL,NITMAX,RTVL,NRTMAX, > ITRACE,IERR) C ********************************************************************** C OBJET DSTEST : TESTE LA VALIDITE DES PARAMETRES D'ENTREE C ********************************************************************** CHARACTER*(*) NOMD,NOMD2,NOMR,NOMR2 INTEGER NBPNEW,PRESEN(*) INTEGER ITVL(*),NITMAX,NRTMAX REAL RTVL(*) INTEGER ITRACE,IERR C CHARACTER*256 MESSAG IF(PRESEN(2).LE.0)NOMD2 = ' ' IF(PRESEN(3).LE.0)NOMR = ' ' IF(PRESEN(4).LE.0)NOMR2 = ' ' IF(PRESEN(5).LE.0)NBPNEW = -1 C --- ANALYSE SEMANTIQUE : C IF((PRESEN(4).LE.0).AND.(PRESEN(3).LE.0))THEN IERR = -1 CALL PGMESS(IERR,23,1,'PAS DE FICHIER RESULTAT',MESSAG) CALL ESECHA(IO,MESSAG,' ') GOTO 9999 ENDIF C IF((PRESEN(3).LE.0).AND.(NBPNEW.GT.0))THEN IF((PRESEN(3).LE.0).AND.(NBPNEW.NE.0))THEN IERR = -1 CALL PGMESS(IERR,24,1,'GRANDEURS NON LOCALISEES !',MESSAG) CALL ESECHA(IO,MESSAG,' ') GOTO 9999 ENDIF IF((PRESEN(3).LE.0).AND.(NBPNEW.EQ.0))THEN CALL PGMESS(101,30,1,'CALCUL DES GRANDEURS SEULEMENT',MESSAG) CALL ESECHA(IO,MESSAG,' ') ENDIF 1000 CONTINUE 9999 END C C PROGRAM DSGPRG C ********************************************************************** C OBJET DSGPRG : Programme principal "delos" C EN ENTREE : 5 parametres C - NOM du fichier de geometrie C - NOM du fichier de densite (facultatif) C - NOM du fichier du maillage resultant C - NOM du fichier de densite resultat (facultatif) C - NOMBRE maximum de noeud (facultatif) C ********************************************************************** C C NBARMX : NOMBRE MAX DE POINT SUR UNE ARETE C NDNMAX : NOMBRE MAX DE DENSITES C INTEGER NBPTMX, NBARMX, NDNMAX C --- ALLOCATION DE LA MEMOIRE --- C INTEGER NBADET INTEGER NITMAX,NRTMAX C --- REPRIS DE DS4_MAIN.F C PARAMETER (NBPTMX = 100000+50, NBADET = 50, NDNMAX = 500) C --- pour les gros cas : sur SGI necessite : limit stacksize 200M PARAMETER (NBPTMX = 1000000+50, NBADET = 50, NDNMAX = 500) PARAMETER (NITMAX = 13*NBPTMX+288 + 310 + 2*NDNMAX) PARAMETER (NRTMAX = 12 * (NBPTMX + 12) + NBPTMX) C PARAMETER (NRTMAX = 20 * (NBPTMX + 12) + NBPTMX) INTEGER ITVL(NITMAX) REAL RTVL(NRTMAX) C C LES DONNEES DU PROGRAMME C CHARACTER*(5) NOMPRG REAL RELEAS CHARACTER*(12) COPYRI INTEGER DATE CHARACTER*(33) CONTAC C --- FICHE DU PROGRAMME --- DATA NOMPRG/'delos'/ C DATA RELEAS/2.05/ DATA RELEAS/2.06/ DATA COPYRI/'ENSMP-ARMINES'/ C DATA DATE/20060913/ C DATA DATE/20100628/ DATA DATE/20111123/ DATA CONTAC/' olivier.stab@mines-paristech.fr'/ C --- LA LECTURE DES ARGUMENTS --- INTEGER NARGMX PARAMETER (NARGMX = 5) INTEGER ITYPEL(NARGMX),IOPTIO(NARGMX) C CHARACTER*45 MESSAG(NARGMX) CHARACTER*63 MESSAG(NARGMX+3) CHARACTER*512 HELPON C C ITYPEL(I) : TYPE LOGIQUE DE L'ENTREE I C 1 = LE NOM D'UN FICHIER DE DONNEES C 2 = LE NOM D'UN FICHIER DE RESULTAT C 3 = UNE VALEUR ENTIERE C 4 = UNE VALEUR REELLE C 5 = UN MOT CLES C 6 = LE NOM D'UN FICHIER DE RESULTAT (ECRASABLE) C 7 = LE NOM D'UN FICHIER DE RESULTAT (CONCATENATION) DATA ITYPEL/1,1,6,6,3/ C IOPTIO(I) : L'ENTREE I EST OPTIONNELLE (0) OU NECESSAIRE (1) DATA IOPTIO/1,0,0,0,0/ C C MESSAG(I) : MESSAGE DECRIVANT L'ENTREE I C SERT A L'INVITATION ET AU MESSAGE D'ERREUR C 12345678901234567890123456789012345678901234567890 C DATA MESSAG/'LE NOM DU FICHIER DES DONNEES (GEOMETRIE) ', C > 'LE NOM DU FICHIER DES DONNEES (DENSITE) ', C > 'LE NOM DU FICHIER DES RESULTATS (MAILLAGE) ', C > 'LE NOM DU FICHIER DES RESULTATS (DENSITE) ', C > 'LE NOMBRE MAXIMUM DE NOEUDS '/ C --- LES MOTS CLE --- INTEGER NBMOTS,LMOTS PARAMETER (NBMOTS = 1,LMOTS = 1) CHARACTER*(LMOTS) MOTS(NBMOTS) DATA MOTS /'-'/ INTEGER ICODES(NBMOTS) DATA ICODES/-1/ C C --- VARIABLES LOCALES --- INTEGER IARGUM(NARGMX) INTEGER PRESEN(NARGMX) CHARACTER*80 CHARTB(NARGMX) INTEGER INTETB(NARGMX) REAL REALTB(NARGMX) INTEGER NBCHAR,NBINTE,NBREAL,I INTEGER ITRACE,IHELP,IERR C ------------------------------------------------------------- C * pour tester la memoire : ITVL(NITMAX-1) = 0 * CALL ESPMOD(ITRACE,IHELP) IF( ITRACE.EQ.1 )CALL ESEPRG(1,NOMPRG,RELEAS,COPYRI,DATE,CONTAC) C --- construction des messages pour les entrees CALL PGMESS(101,2,1, >'LE NOM DU FICHIER DES DONNEES (GEOMETRIE) ',MESSAG(1)) CALL PGMESS(101,3,1, >'LE NOM DU FICHIER DES DONNEES (DENSITE) ',MESSAG(2)) CALL PGMESS(101,4,1, >'LE NOM DU FICHIER DES RESULTATS (MAILLAGE) ',MESSAG(3)) CALL PGMESS(101,5,1, >'LE NOM DU FICHIER DES RESULTATS (DENSITE) ',MESSAG(4)) CALL PGMESS(101,6,1, >'LE NOMBRE MAXIMUM DE NOEUDS ',MESSAG(5)) C IF( IHELP.EQ.1 )GOTO 8888 CALL ESPROG(ITYPEL,IOPTIO,MESSAG, > MOTS,LMOTS,NBMOTS,ICODES, > CHARTB,NBCHAR,INTETB,NBINTE,REALTB,NBREAL, > IARGUM,NARGMX,PRESEN,ITRACE,IERR) IF(IERR.EQ.-1)GOTO 8887 IF(IERR.NE.0)GOTO 9999 C C --- TEST DES ENTREES --- C ====================================== CALL DSTEST(CHARTB(IARGUM(1)),CHARTB(IARGUM(2)), > CHARTB(IARGUM(3)),CHARTB(IARGUM(4)), > INTETB(IARGUM(5)),PRESEN, > ITVL,NITMAX,RTVL,NRTMAX, > ITRACE,IERR) IF(IERR.NE.0)GOTO 8887 C C --- APPEL A LA FONCTION DE TRAITEMENT --- C ====================================== CALL DSINIT2(ITRACE) C CALL DSGMEM(CHARTB(IARGUM(1)),CHARTB(IARGUM(2)), > CHARTB(IARGUM(3)),CHARTB(IARGUM(4)), > INTETB(IARGUM(5)), > ITVL,NITMAX,RTVL,NRTMAX, > ITRACE,IERR) IF(IERR.EQ.-1)GOTO 8887 GOTO 9999 8887 CONTINUE CALL PGMESS(101,8,1, >'pour l aide en ligne tapez : delos h',MESSAG(6)) C CALL ESECHA(1,'pour l aide en ligne tapez :','delos h') CALL ESECHA(1,MESSAG(6),'') GOTO 9999 C --- LE HELP EN LIGNE --- 8888 CONTINUE C CALL PGMESS(1,7,1, > 'AIDE EN LIGNE : ',HELPON) CALL ESECHA(1,HELPON,'') GOTO 9999 9999 END C ********************************************************************** C FICHIER : DSG_NOEUD.F C OBJET : C C FONCT. : C OBJET DSGMEM : GENERATION D'UN MAILLAGE A PARTIR D'UN FICHIER C C AUTEUR : O. STAB C DATE : 20.07.99 C TESTS : C MODIFICATIONS : C AUTEUR, DATE, OBJET : STAB, 05.11.04, messages "normalises" C AUTEUR, DATE, OBJET : STAB, 02.02.04, DSGMEM maj NBPNEW avant appel 2D C C ********************************************************************** C SUBROUTINE DSGMEM(NOMD,NOMDD,NOMR,NOMRR,NBPTOT, > ITVL,NITMAX,RTVL,NRTMAX,ITRACE,IERR) C ********************************************************************** C OBJET DSGMEM : GENERATION D'UN MAILLAGE A PARTIR D'UN FICHIER C lecture fichiers, maillage 1D, maillage 2D par region, ecriture resultat C EN ENTREE : C NOMD : NOM DU FICHIER CONTENANT LES DONNEES C NOMR : NOM DU FICHIER CONTENANT LES RESULTATS (MAILLAGE) C NOMDD : NOM DU FICHIER CONTENANT LES DENSITES (TAILLES SOUHAITEES) C NOMRR : NOM DU FICHIER CONTENANT LES RESULTATS (TAILLES SOUHAITEES) C C ---- TABLEAUX DE TRAVAIL -------------------- C ITVL : TABLEAU D'ENTIERS POUR LES CALCULS C NITMAX : TAILLE DE ITVL C RTVL : TABLEAU DE REELS POUR LES CALCULS C NRTMAX : TAILLE DE RTVL (12 (NBP+12)) C ITRACE : SI > 0 ALORS ECHO DES ETAPES ET DES RESULTATS C C EN SORTIE : C IERR : CODE D'ERREUR C ********************************************************************** CHARACTER*(*) NOMD,NOMR,NOMDD,NOMRR INTEGER NBPTOT INTEGER ITVL(*),NITMAX,NRTMAX REAL RTVL(*) INTEGER ITRACE,IERR C INTEGER LENCHR EXTERNAL LENCHR C --- VARIABLES INTERNES --- CHARACTER*126 MESSAG INTEGER I INTEGER IDE,ITRNOE,NBNMAX,ITRTRI,NBCMAX,NOETRI,NOEMAX INTEGER NBN,NBE,NCC,NBPMAX,NBEMAX INTEGER ITRIRG,NRGMAX,IMTREF,NMT INTEGER ICOORD,IDIMC,IGRDNO,NGRDMX INTEGER MODDEF,MODGEN,IADEC,NIADEC,IRADEC,NRIDEC,NFADEC INTEGER ITRAV,IRTRAV,NITMX2,NRTMX2 REAL ZERO INTEGER NDECMX INTEGER IDIMG,PITRRG,PSTRUC INTEGER NBPNEW,TSN,ICOEF C INTEGER IDE1,IARETE,NBNMX1,NBARET,NBN1,IAR2RG INTEGER INTMAT,IREGIO,NBEREG,NMTCC,IUN INTEGER NBRMAX C --- pour tester la memoire : ITVL(NITMAX) = 0 RTVL(NRTMAX) = 0.0 C IERR = 0 ZERO = 0.0 ITRAV = 1 IRTRAV = 1 C ======================== C --- 2.LECTURE DU MAILLAGE --- C ======================== IMTREF = ITRAV NRGMAX = NITMAX - IMTREF CALL LITFRT(0,NOMD,0,0,NRGMAX,0,IDIMC,NBN,ZERO,IDE, > NBNMAX,NBE,0,NMT,ITVL(IMTREF),NBRMAX,0,IERR) NBRMAX = MAX(NBRMAX,2) ITRAV = IMTREF + NMT NBCMAX = NBNMAX c --- test des donnees et messages d'erreur IF( IERR.NE.0 )THEN CALL PGMESS(IERR,2,1,'A LA LECTURE DU FICHIER :', MESSAG) CALL ESECHA(1,MESSAG,NOMD) GOTO 9999 ENDIF C IF((IDIMC.LT.2).OR.(IDIMC.GT.3))THEN IERR = -1 CALL PGMESS(IERR,4,5,'COORDONNEES DES POINTS', MESSAG) CALL ESECHA(1,MESSAG,' ') CALL PGMESS(IERR,3,1,'ERREUR DANS LE FICHIER : ',MESSAG) CALL ESECHA(1,MESSAG,NOMD) GOTO 9999 ENDIF c IF((IDIMC.LT.2).AND.(NBRMAX.GT.2))THEN IERR = -1 CALL PGMESS(IERR,4,6,'COORDONNEES DES POINTS', MESSAG) CALL ESECHA(1,MESSAG,' ') CALL PGMESS(IERR,3,1,'ERREUR DANS LE FICHIER : ',MESSAG) CALL ESECHA(1,MESSAG,NOMD) GOTO 9999 ENDIF c IF((IDE.EQ.0).AND.(NBE.EQ.0))THEN IF( NBN.EQ.0 )THEN IERR = -1 CALL PGMESS(IERR,7,1,'NI POINT NI ELEMENT DANS LE FICHIER : ', > MESSAG) CALL ESECHA(1,MESSAG,NOMD) GOTO 9999 ENDIF IERR = 0 CALL PGMESS(IERR,8,1,'PAS ELEMENT DANS LE FICHIER : ',MESSAG) CALL ESECHA(1,MESSAG,NOMD) ENDIF c IF(IDE.GT.1)THEN IERR = -1 CALL PGMESS(IERR,9,1,'LES ELEMENTS NE SONT PAS DES ARETES', > MESSAG) CALL ESECHA(1,MESSAG,' ') CALL PGMESS(IERR,3,1,'ERREUR DANS LE FICHIER : ',MESSAG) CALL ESECHA(1,MESSAG,NOMD) GOTO 9999 ENDIF C ======================== C --- 1.LECTURE DE LA DENSITE --- C ======================== NDECMX = 0 CALL LITRAF(0,NOMDD,MODDEF,MODGEN,0,NIADEC, > ZERO,NRIDEC, > NFADEC,NDECMX, > ITVL,NITMAX,RTVL,NRTMAX, > 0,IERR) C --- EN 1D ON PREFERE LE DIRECT --- IF(MODDEF.EQ.3)MODGEN = 1 c --- test des donnees et messages d'erreur IF( IERR .NE. 0 )THEN CALL PGMESS(IERR,2,1,'DANS LE FICHIER',MESSAG) CALL ESECHA(1,MESSAG,NOMDD) GOTO 9999 ENDIF c IF((MODDEF.EQ.2).AND.(IDIMC.EQ.3))THEN IERR=-1 CALL PGMESS(IERR,11,1,'CONCENTRATION PAS DISPONIBLE EN 3D', > MESSAG) CALL ESECHA(1,MESSAG,' ') GOTO 9999 ENDIF C --- DIRECT ET NOMBRE FIXE => WARNING --- IF(((MODGEN.EQ.1).AND.(NBPTOT.GT.0)).AND.(ITRACE.GT.0))THEN CALL PGMESS(0,12,13,'PARAMETRE DECONSEILLE',MESSAG) CALL ESECHA(1,MESSAG,' ') ENDIF C --- ALEATOIRE ET NOMBRE PAS FIXE => WARNING --- IF(((MODDEF.EQ.4).AND.(NBPTOT.LT.0)).AND.(ITRACE.GT.0))THEN CALL PGMESS(0,12,19,'PARAMETRE DECONSEILLE',MESSAG) CALL ESECHA(1,MESSAG,' ') ENDIF C --- LA TAILLE SOUHAITE N'EST PAS DEFINIE EN TOUS LES NOEUDS !!! --- IF((MODDEF.EQ.3).AND.(NBN.NE.NRIDEC))THEN IERR = -1 CALL PGMESS(IERR,12,1,'TAILLE PAS DEFINIE EN TOUS LES NOEUDS', > MESSAG) CALL ESECHA(1,MESSAG,' ') GOTO 9999 ENDIF C ---- NOMBRE TOTAL DE NOEUDS ATTEINT ---- IF(( NBPTOT.GT.0 ).AND.( NBPTOT.LT.NBN ))THEN IERR = -2 CALL DSERRE(1,IERR,'DSGMEM',' NBRE NOEUDS DEJA ATTEINT ') CALL PGMESS(IERR,19,1,'MAXIMUM NOEUDS DEJA ATTEINT',MESSAG) CALL ESEINT(1,MESSAG,NBN,1) GOTO 9999 ENDIF C ================================================= C --- 1.CALCUL DU NOMBRE MAXIMUM DE NOEUD, D'ELEMENTS --- C ================================================= C NITMX2 = NITMAX - NIADEC*NFADEC NRTMX2 = NRTMAX - NRIDEC*NFADEC C PSTRUC = 0 C IF((MODDEF.EQ.1 ).OR.(MODGEN.EQ.3))PSTRUC = 1 IF(MODGEN.EQ.3)PSTRUC = 1 IDIMG = 0 IF( NOMRR.NE.' ' )IDIMG = 1 TSN = 0 IF( MODDEF.EQ.3 )TSN = 1 PITRRG = 0 C IF( NMT.GT. 1 )PITRRG = 1 C A FAIRE (A OPTIMISER) = IF( NMT.GT. 1 )PITRRG = NBRMAX C POUR L'INSTANT : PITRRG = NBRMAX ICOEF = 0 IF(MODGEN.EQ.3)ICOEF = 1 C CONSIDERER NBRMAX DANS DSGMAX : C'EST FAIT MAINTENANT CALL DSGMAX(IDIMC,NMT,NBN,NBE,NBPTOT, > PSTRUC,PITRRG,TSN,ICOEF,IDIMG, > NITMX2,NRTMX2, > NBPMAX,NBEMAX,IERR) IF( IERR.NE. 0 )THEN CALL DSERRE(1,IERR,'DSGMEM','APPEL DSGMAX') GOTO 9999 ENDIF IF( NBEMAX.LT.0 )THEN IF( NBE.EQ.0 )THEN NBEMAX = 0 ELSE IERR = -1 CALL DSERRE(1,IERR,'DSGMEM','NBEMAX INDETERMINE') GOTO 9999 ENDIF ENDIF C c IF((ITRACE.GT.1 ).AND.(NBPTOT.EQ.-1))THEN c CALL ESEINT(1,'NOMBRE MAXIMUM DE NOEUDS : ',NBPMAX,1) c CALL ESEINT(1,'NOMBRE MAXIMUM D ELEMENTS : ',NBEMAX,1) c ENDIF C C ---- ALLOCATION --- NBPNEW = NBPMAX - NBN C NBCMAX = NBNMAX * PSTRUC NOEMAX = NBPMAX * PSTRUC C IADEC = ITRAV ITRNOE = IADEC + (NIADEC*NFADEC) ITRIRG = ITRNOE + (NBEMAX * NBNMAX) NRGMAX = NBEMAX * PITRRG + 1 ITRTRI = ITRIRG + NRGMAX NOETRI = ITRTRI + (NBEMAX * NBCMAX) NOEMAX = NBPMAX * PSTRUC ITRAV = NOETRI + NOEMAX NITMX2 = NITMAX - ITRAV C NGRDMX = NBPMAX * IDIMG C IRADEC = IRTRAV ICOORD = IRADEC + (NRIDEC*NFADEC) IF(MODDEF.EQ.3)ICOORD = IRADEC + NBPMAX IGRDNO = ICOORD + NBPMAX * IDIMC IRTRAV = IGRDNO + NGRDMX * IDIMG NRTMX2 = NRTMAX - IRTRAV c IF(NITMX2.LT.0)THEN IERR = -2 CALL DSERRE(1,IERR,'DSGMEM','TABLEAUX D ENTIERS TROP PETIT') CALL PGMESS(IERR,15,1,'PLUS DE MEMOIRE POUR LES ENTIERS', > MESSAG) CALL ESECHA(1,MESSAG,' ') GOTO 9999 ENDIF c IF(NRTMX2.LT.0)THEN IERR = -2 CALL DSERRE(1,IERR,'DSGMEM','TABLEAUX DE REELS TROP PETIT') CALL PGMESS(IERR,16,1,'PLUS DE MEMOIRE POUR LES REELS', > MESSAG) CALL ESECHA(1,MESSAG,' ') GOTO 9999 ENDIF C ===================================================== C --- LECTURE DU MAILLAGE ET CHARGEMENT DANS LA STRUCTURE --- C ===================================================== CALL DSGESF(NOMD,NOMR,NOMDD,NOMRR, > IDE,ITVL(ITRNOE),NBNMAX,ITVL(ITRTRI),NBCMAX, > ITVL(NOETRI),NOEMAX, > NBN,NBE,NCC,NBPMAX,NBEMAX, > ITVL(ITRIRG),NBRMAX,NRGMAX,ITVL(IMTREF),NMT, > RTVL(ICOORD),IDIMC, > MODDEF,MODGEN,NBPNEW, > ITVL(IADEC),NIADEC,RTVL(IRADEC),NRIDEC,NFADEC, > ITVL(ITRAV),NITMX2,RTVL(IRTRAV),NRTMX2,ITRACE,IERR) IF( IERR.NE.0 )THEN CALL DSERRE(1,IERR,'DSGMEM',' APPEL DSGESF') GOTO 9999 ENDIF C ===================================================== C --- ON RAFFINE LE MAILLAGE LINEIQUE --- C ===================================================== CALL DS1FCT(IDE,ITVL(ITRNOE),NBNMAX,ITVL(ITRTRI),NBCMAX, > ITVL(NOETRI),NOEMAX, > NBN,NBE,NCC,NBPMAX,NBEMAX, C > ITVL(ITRIRG),NRGMAX,ITVL(IMTREF),NMT, > ITVL(ITRIRG),NBRMAX,NRGMAX,ITVL(IMTREF),NMT, > RTVL(ICOORD),IDIMC, > RTVL(IGRDNO),NGRDMX, > MODDEF,MODGEN,NBPNEW, > ITVL(IADEC),NIADEC,RTVL(IRADEC),NRIDEC,NFADEC, > ITVL(ITRAV),NITMX2,RTVL(IRTRAV),NRTMX2,ITRACE,IERR) IF( IERR.LT.0 )THEN CALL DSERRE(1,IERR,'DSGMEM',' APPEL DS1FCT') GOTO 9999 ENDIF C ---- LIMITATION DONNE PAR L'UTILISATEUR --- IF(ITRACE.NE.0)THEN IF( NBPTOT.EQ.NBN )THEN CALL PGMESS(0,25,1,'NB MAXIMUM DE NOEUD ATTEINT ',MESSAG) CALL ESEINT(1,MESSAG,NBPTOT,1) CALL PGMESS(101,15,1,'NOMBRE D ARETES :',MESSAG) CALL ESEINT(1,MESSAG,NBE,1) ENDIF ENDIF C --- ON LIBERE LA PLACE INUTILISEE ITRAV = ITRTRI C ========================= C --- ON PASSE AU MAILLAGE 2D --- C ========================= C ajout 01.02.2005 NBPNEW = NBPMAX - NBN C IDE1 = IDE NBNMX1 = NBNMAX NBN1 = NBN NBARET = NBE IARETE = ITRNOE IAR2RG = ITRIRG C IDE = 2 NBE = 0 NBNMAX = 3 C ------ SEUL LE MODE ITERATIF EST IMPLEMENTE EN 2D -------- MODGEN = 2 NBNMAX = 3 C C --- ALLOCATION DU MAILLAGE --- C INTMAT = ITRAV ITRNOE = INTMAT+NMT ITRAV = ITRNOE + (NBEMAX * NBNMAX) C NRTMX2 = NRTMAX - IRTRAV NITMX2 = NITMAX - ITRAV c IF(NITMX2.LT.0)THEN IERR = -2 CALL DSERRE(1,IERR,'DSGMEM','TABLEAUX D ENTIERS TROP PETIT') CALL PGMESS(IERR,15,1,'PLUS DE MEMOIRE POUR LES ENTIERS', > MESSAG) CALL ESECHA(1,MESSAG,' ') GOTO 9999 ENDIF IF(NRTMX2.LT.0)THEN IERR = -2 CALL PGMESS(IERR,16,1,'PLUS DE MEMOIRE POUR LES REELS', > MESSAG) CALL ESECHA(1,MESSAG,' ') GOTO 9999 ENDIF C pour tester la memoire : ITVL(ITRAV+NITMX2-1) = 0 DO 200 I=1,NMT C ===================================== C ---- ON TRAITE CHAQUE REGION A PART --- C ===================================== IREGIO = ITVL(IMTREF+I-1) NBEREG = NBE IF(ITRACE.NE.0)THEN CALL PGMESS(101,23,1,'--> TRAITEMENT DE LA REGION : ', > MESSAG) IF(NMT.GT.1)CALL ESEINT(1,MESSAG,I,1) ENDIF C --- ON TRIANGULE ET ON RAFFINE : IREGIO --- CALL RGRAFT(IDE1,ITVL(IARETE),NBNMX1,NBN1,NBARET, > ITVL(IAR2RG),NBRMAX,IREGIO, > IDE,ITVL(ITRNOE),NBNMAX, > NBN,NBE,NCC,NBPMAX,NBEMAX, > RTVL(ICOORD),IDIMC, > RTVL(IGRDNO),NGRDMX, > MODDEF,MODGEN,NBPNEW, > ITVL(IADEC),NIADEC,RTVL(IRADEC),NRIDEC,NFADEC, > ITVL(ITRAV),NITMX2,RTVL(IRTRAV),NRTMX2,ITRACE,IERR) IF(IERR.LT..0)THEN CALL DSERRE(1,IERR,'DS4MEM',' APPEL RGRAFT') GOTO 9999 ENDIF C ---- LIMITATION DONNE PAR L'UTILISATEUR --- IF(ITRACE.NE.0)THEN IF(IERR.EQ.2) > CALL DSERRE(1,IERR,'NOMBRE MAXIMUM D ELEMENTS ATTEINT',' ') IF(IERR.EQ.1)THEN CALL PGMESS(0,25,1,'NOMBRE MAXIMUM DE NOEUD ATTEINT ', > MESSAG) CALL ESEINT(1,MESSAG,NBPMAX,1) ENDIF IERR = 0 CALL PGMESS(101,17,1,'NOMBRE DE TRIANGLES :',MESSAG) IF(NMT.GT.1)CALL ESEINT(1,MESSAG,(NBE-NBEREG),1) ENDIF C ---- MATERIAU DES ELEMENTS CREES ---- ITVL(I-1+INTMAT) = NBE 200 CONTINUE C =================================================== C --- 5. ECRITURE FICHIER MAILLAGE --- C =================================================== 300 CONTINUE IF( NOMR.EQ.' ' )GOTO 400 IF(ITRACE.GT.0)THEN CALL PGMESS(101,20,1,'FICHIER RESULTAT MAILLAGE',MESSAG) CALL ESECHA(1,MESSAG,NOMR) ENDIF C NMTCC = NMT CALL ECRVIP(2,NOMR,IDIMC,NBN,RTVL(ICOORD),IDE, > NBNMAX,NBE,ITVL(ITRNOE),NMTCC, > ITVL(IMTREF),ITVL(INTMAT),IERR) IF( IERR.NE.0 )THEN CALL PGMESS(IERR,20,1,' EN ECRIVANT LE FICHIER : ',MESSAG) CALL ESECHA(1,MESSAG,NOMR) GOTO 400 ENDIF IF( ITRACE.GT.0 )THEN c CALL PGMESS(101,20,1,'FICHIER RESULTAT : ',MESSAG) c CALL ESECHA(1,MESSAG,NOMR) CALL PGMESS(101,14,1,'NOMBRE DE NOEUDS : ',MESSAG) CALL ESEINT(1,MESSAG,NBN,1) CALL PGMESS(101,17,1,'NOMBRE DE TRAINGLES: ',MESSAG) CALL ESEINT(1,MESSAG,NBE,1) CALL PGMESS(101,18,1,'NOMBRE DE ZONES : ',MESSAG) CALL ESEINT(1,MESSAG,NMTCC,1) ENDIF C ================================================ C --- 6. ECRITURE DES TAILLES SOUHAITEES AU NOEUDS --- C ================================================ 400 CONTINUE IF( NFADEC.EQ.0 )GOTO 9999 IF( NOMRR.EQ.' ' )GOTO 9999 C IF(ITRACE.GT.0)THEN CALL PGMESS(101,21,1,'FICHIER RESULTAT : ',MESSAG) CALL ESECHA(1,MESSAG,NOMRR) ENDIF IUN = 1 C ---- DENSITE ASSOCIE AU MAILLAGE NOMR --- CALL ECRGRD(NOMRR,NOMR,RTVL(IGRDNO),IUN,NBN,IERR) IF( IERR.NE.0 )THEN CALL PGMESS(IERR,20,1,' EN ECRIVANT LE FICHIER : ',MESSAG) CALL ESECHA(1,MESSAG,NOMRR) GOTO 9999 ENDIF IF( ITRACE.GT.0 )THEN CALL PGMESS(101,19,1,'NOMBRE DE VALEURS ',MESSAG) CALL ESEINT(1,MESSAG,NBN,1) ENDIF C 9999 END C C C ********************************************************************** C FICHIER : DSG_LECTURE.F C OBJET : IDEM DS1_LECTURE (LE REMPLACERA A TERME) C C FONCT. : C OBJET DSGESF : LECTURE D'UN MAILLAGE LINEIQUE ET RAFFINEMENT C ET INITIALISATION DE TOUTES LES "STRUCTURES" DE DONNEES C C AUTEUR : O. STAB C DATE : 20.07.99 C TESTS : C MODIFICATIONS : C AUTEUR, DATE, OBJET : STAB, 28.07.99, EXTRAIT ET MODIFIE DE DS1_NOEUD.F C AUTEUR, DATE, OBJET : STAB, 05.11.04, messages "normalises" C AUTEUR, DATE, OBJET : STAB, 21.12.05, DSGESF lit ANCIEN et nouveau format ! C AUTEUR, DATE, OBJET : O.Stab, 02.07.2006 correction BUG (multimat et ancien format) C C ********************************************************************** C SUBROUTINE DSGESF(NOMD,NOMR,NOMDD,NOMRR, > IDE,ITRNOE,NBNMAX,ITRTRI,NBCMAX,NOETRI,NOEMAX, > NBN,NBE,NCC,NBPMAX,NBEMAX, > ITRIRG,NBRMAX,NRGMAX,IMTREF,NMT, > COORD,IDIMC, > MODDEF,MODGEN,NBPNEW, > IADEC,NIADEC,RADEC,NRIDEC,NFADEC, > ITVL,NITMAX,RTVL,NRTMAX,ITRACE,IERR) C ********************************************************************** C OBJET DSGESF : LECTURE D'UN MAILLAGE LINEIQUE ET RAFFINEMENT C ET INITIALISATION DE TOUTES LES "STRUCTURES" DE DONNEES C C EN ENTREE : C NOMD,NOMR,NOMDD,NOMRR : LES NOM DES FICHIERS C --- LA TAILLE DES TABLEAUX... --- C NBPMAX : NOMBRE MAXIMUM DE POINTS (COORD) C NBEMAX : NOMBRE MAXIMUM D'ELEMENTS (ITRNOE...) C NBRMAX : NOMBRE MAXIMUM DE REGIONS (ITRIRG...) C NRGMAX : ? C NITMAX : TABLEAU DE TRAVAIL D'ENTIERS C NRTMAX : TABLEAU DE TRAVAIL DE REELS C C EN SORTIE : C --- POUR LE MAILLAGE --- C IDE,ITRNOE,NBNMAX,ITRTRI,NBCMAX,NOETRI,NOEMAX,NBN,NBE : LE MAILLAGE C COORD : LES POINTS C --- POUR LE RAFFINEMENT --- C MODDEF,MODGEN,NBPNEW C IADEC,NIADEC,RADEC,NRIDEC,NFADEC : POUR LE RAFFINEMENT C C ********************************************************************** CHARACTER*(*) NOMD,NOMR,NOMDD,NOMRR INTEGER IDE,ITRNOE(*),NBNMAX,ITRTRI(*),NBCMAX,NOETRI(*),NOEMAX INTEGER NBN,NBE,NCC,NBPMAX,NBEMAX INTEGER ITRIRG(*),NBRMAX,NRGMAX,IMTREF(*),NMT REAL COORD(*) INTEGER IDIMC INTEGER ITVL(*) REAL RTVL(*),RADEC(*) INTEGER MODDEF,MODGEN,NBPNEW,IADEC(*),NFADEC,NIADEC,NRIDEC INTEGER NITMAX,NRTMAX,ITRACE,IERR C CHARACTER*256 MESSAG INTEGER NOEMX2,NBCMX2,NRGREF,IUN,NMT2,NBRMX2 INTEGER NDECMX INTEGER NBERG(1000),I,J,J0 C ======================== C --- 1.LECTURE DE LA DENSITE --- C ======================== NDECMX = NFADEC IF((ITRACE.GT.0).AND.(NOMDD.NE.' '))THEN CALL PGMESS(101,26,1,'LECTURE DU FICHIER DENSITE', MESSAG) CALL ESECHA(1,MESSAG,NOMDD) ENDIF CALL LITRAF(1,NOMDD,MODDEF,MODGEN,IADEC,NIADEC, > RADEC,NRIDEC, > NFADEC,NDECMX, > ITVL,NITMAX,RTVL,NRTMAX, > 0,IERR) IF( IERR .NE. 0 )THEN CALL PGMESS(IERR,2,1,'A LA LECTURE DU FICHIER :', MESSAG) CALL ESECHA(1,MESSAG,NOMDD) GOTO 9999 ENDIF IF(ITRACE.GT.0)THEN CALL PGMESS(101,27,1,'NOMBRE DE CONCENTRATIONS : ', MESSAG) CALL ESEINT(1,MESSAG,NFADEC,1) ENDIF C --- EN 1D ON PREFERE LE DIRECT --- IF(MODDEF.EQ.3)MODGEN = 1 C =================================== C --- 1.LECTURE EFFECTIVE DU MAILLAGE --- C =================================== IF(ITRACE.GT.0)THEN CALL PGMESS(101,24,1,'LECTURE DU FICHIER GEOMETRIE', MESSAG) CALL ESECHA(1,MESSAG,NOMD) ENDIF CALL LITFRT(1,NOMD,(NBPMAX*IDIMC),(NBEMAX*NBNMAX), > NMT,(NBRMAX*NBEMAX),IDIMC,NBN,COORD,IDE, > NBNMAX,NBE,ITRNOE,NMT2,IMTREF,NBRMAX,ITRIRG,IERR) IF( IERR.NE.0 )THEN IERR = 0 CALL LITVIP(1,NOMD,(NBPMAX*IDIMC),(NBEMAX*NBNMAX), > NRGMAX,(NBRMAX*NBEMAX),IDIMC,NBN,COORD,IDE, > NBNMAX,NBE,ITRNOE,NMT,IMTREF,NBERG,IERR) C > NBNMAX,NBE,ITRNOE,NMT,IMTREF,ITRIRG,IERR) C il faut construire ITRIRG : O.Stab, 02.07.2006 correction BUG J0=1 DO 10 I=1,NMT DO 5 J=J0,NBERG(I) ITRIRG(J)=IMTREF(I) 5 CONTINUE J0=NBERG(I)+1 10 CONTINUE ENDIF C IF( IERR.NE.0 )THEN CALL PGMESS(IERR,2,1,'LECTURE DU FICHIER : ', MESSAG) CALL ESECHA(1,MESSAG,NOMD) GOTO 9999 ENDIF IF( ITRACE.GT.0 )THEN CALL PGMESS(101,28,1,'NOMBRE DE POINTS : ',MESSAG) CALL ESEINT(1,MESSAG,NBN,1) CALL PGMESS(101,15,1,'NOMBRE D ARETES : ',MESSAG) CALL ESEINT(1,MESSAG,NBE,1) CALL PGMESS(101,18,1,'NOMBRE DE ZONES : ',MESSAG) CALL ESEINT(1,MESSAG,NMT,1) ENDIF C IF(MODGEN.EQ.3)THEN C ------------------------------------------ C ON CREE LA STRUCTURE SEULEMENT POUR LE LISSAGE C ------------------------------------------ CALL SMAOCR(IDE,ITRNOE,NBE,COORD,NBN,IDIMC, > ITRNOE,NBNMAX,ITRTRI, > NBCMAX,NOETRI,NOEMAX, > ITVL,NITMAX,NCC,IERR) IF( IERR.NE.0 )THEN CALL DSERRE(1,IERR,'DSGESF',' APPEL SMAOCR') CALL PGMESS(IERR,21,1,'GEOMETRIE NON VALIDE',MESSAG) CALL ESECHA(1,MESSAG,' ') GOTO 9999 ENDIF IF( ITRACE.NE.0 )THEN CALL PGMESS(101,29,1,'NOMBRE DE COMPOSANTES CONNEXES: ',MESSAG) CALL ESEINT(1,MESSAG,NCC,1) ENDIF C IF((NCC.GT.1).AND.(NITMAX.LT.NBPMAX))THEN IERR = -2 CALL PGMESS(IERR,22,1,'TROP DE COMPOSANTES CONNEXES',MESSAG) CALL ESECHA(1,MESSAG,' ') GOTO 9999 ENDIF ELSE C --- CA DOIT DEJA ETRE FAIT --- C --- ON NE CREE PAS LA STRUCTURE --- NBCMAX = 0 NOEMAX = 0 NCC = 0 ENDIF C 9999 END C C C REMARQUES : C 1. attention il faut faudra la difference entre 1 message C et un bout de texte ! C 2. Chaque module "independant" qui affiche ses propres messages C a une copie de XXMESS avec ses traductions ! C SUBROUTINE PGMESS(ITYPE,NUM1,NUM2,IMESS,IMESSL) C ***************************************************************** C OBJET MSERRO : construit le message IMESSL de code INUM dans la C langue definie (traduit le message IMESS) C ITYPE : type de message C -X : -1, -2, -3 messages d'erreur C 0 : warning C +X : message informatif C < 100 message informatif reserve (identitie) C 1 help on line C 2 C > 100 message quelconque C ***************************************************************** CHARACTER*(*) IMESS,IMESSL INTEGER ITYPE,NUM1,NUM2 C C character*63 helponline(5) character*512 helponline data helponline / >'Usage : delos [v/s/h] Df1 [Df2] [Rf1] [Rf2] [nbn]\n >OPTION : v for verbose, s for silent and h for help\n > where Df1 is the data geometry file Df2 the data mesh size file >Rf1 the resulting mesh file and Rf2 the resulting mesh size.\n > [] means the parameter is optional.'/ character*63 errmess(26) data errmess / >' ', >'while reading the file : ', >'error in the file : ', >'in the points coordinate definition.', >'illegal space dimension', >'dimension must be 3 with an edge with more than 2 zones.', >'no point and no edge in the file : ', >'no edge in the file : ', >'elements are NOT edges.', C 10 >'mesh definition file is not correct.', >'density function CAN T be used in 3D.', >'carreful with that combination... ', >'maximum number of nodes set.', >'mesh size MUST be given at each node of the geometry.', >'no more memory (for integers).', >'no more memory (for reals).', >'while writting file : ', >'random generation of points selected and no maximum set.', >'Maximum number of nodes already reach : ', C 20 >'while writing the file : ', >'geometry is not valid', >'too many polygons ', C DSTEST >'the name of the resulting mesh file is missing', >'no mesh file given, the nodal values won t be located', >'Maximum number of nodes reached : ', >'123456789012345678901234567890123456789012345678901234567890123'/ character*63 messtype(5) data messtype / >'WARNING ', >'DATA ERROR ', >'COMPUTER ERROR ', >'NOT YET POSSIBLE ', >'123456789012345678901234567890123456789012345678901234567890123'/ character*63 messages(31) data messages/ >' ', >'Geometry file ?', >'Mesh size definition file ?', >'Name of the resulting mesh ?', >'Name of the resulting mesh size (optional) ?', >'Maximum number of nodes (optional) ?', >'Online help ', >'For online help type : delos h', >'must be given.', C 10 >'can be given.', >'The maximum number of node is : ', >'The maximum number of triangles is : ', >'Maximum number of nodes reached !', >'Number of nodes : ', >'Number of edges : ', >'Number of borders : ', >'Number of triangles : ', >'Number of zones : ', >'Number of values : ', C 20 >'-->WRITTING MESH FILE : ', >'-->WRITTING DENSITY MESH FILE : ', >'Resulting file : ', >'-->MESHING THE ZONE : ', >'-->READING GEOMETRY FILE : ', >'-->READING MESH FILE : ', >'-->READING SIZE FILE : ', >'Number of concentrations : ', >'Number of points : ', >'Number of non-connex polygons :', C 30 >'nodal value computation only', >'123456789012345678901234567890123456789012345678901234567890123'/ INTEGER LENCHR EXTERNAL LENCHR IF( ITYPE.LE.0 )THEN C --- entete IMESSL=messtype(1-ITYPE)(1:LENCHR(messtype(1-ITYPE))+1)//' ' >//errmess(NUM1)(1:LENCHR(errmess(NUM1)))//' ' >//errmess(NUM2)(1:LENCHR(errmess(NUM2)))//' ' C --- pour le debug : c write(*,*)ITYPE,NUM1,NUM2,IMESSL GOTO 9999 ENDIF c IF( ITYPE.LT.100 )THEN GOTO (10,20) ITYPE GOTO 1100 C ---- help on line ----- 10 CONTINUE IMESSL=helponline GOTO 1100 C --------- 20 CONTINUE GOTO 1100 1100 CONTINUE GOTO 9999 ENDIF IMESSL=messages(NUM1)(1:LENCHR(messages(NUM1)))// >' '//messages(NUM2)(1:LENCHR(messages(NUM2)))//' ' C --- pour le debug : c write(*,*)ITYPE,NUM1,NUM2,IMESSL 9999 END C