fm3sel.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\stbtel\fm3sel.f
00002 !
00030                         SUBROUTINE FM3SEL
00031 !                       *****************
00032 !
00033      &(X,Y,NPOIN,NBOR,NFIC,STD,NVAR,TEXTE,TEXTLU,VARCLA,NVARCL,
00034      & TITRE,SORLEO,NSOR,W,IKLE,
00035      & IKLES,ITRAV,NELEM,NPTFR,NDP,MXPTVS,MXELVS,DATE,TIME,
00036      & DEBU,SUIT,ECRI,LISTIN,IPARAM,IPOBO)
00037 !
00038 !***********************************************************************
00039 ! PROGICIEL STBTEL V5.2       02/01/96    J-M HERVOUET (LNH) 30 71 80 18
00040 !
00041 !***********************************************************************
00042 !
00043 !     COMME FMTSEL, MAIS LA DIMENSION DE SORLEO  EST
00044 !     PARAMETREE.
00045 !
00046 !     FONCTIONS :  LECTURE DU FICHIER GEOMETRIQUE AU STANDARD SELAFIN
00047 !                  ECRITURE DU FICHIER GEOMETRIQUE AU STANDARD SELAFIN
00048 !
00049 !     LES FONCTIONS DE CE SOUS-PROGRAMME PEUVENT ETRE PILOTEES AVEC
00050 !     LES ARGUMENTS DEBU, SUIT, ET ECRI
00051 !
00052 !     ATTENTION : 1) SI DEBU, SUIT ET ECRIT SONT A .FALSE.
00053 !                    FM3SEL LIT LA GEOMETRIE.
00054 !
00055 !                 2) SI DEBU ITRAV DOIT ETRE LE TABLEAU IA DES ENTIERS
00056 !                    ET ON NE DOIT PAS SE SERVIR DE IKLE ET IKLES
00057 !                    CAR LE SOUS-PROGRAMME DE POINTEURS N'A PAS ENCORE
00058 !                    ETE APPELE.
00059 !-----------------------------------------------------------------------
00060 !                             ARGUMENTS
00061 ! .________________.____.______________________________________________
00062 ! |      NOM       |MODE|                   ROLE
00063 ! |________________|____|______________________________________________
00064 ! |   X,Y          |<-->| COORDONNEES DU MAILLAGE.
00065 ! |   NPOIN        |<-->| NOMBRE DE POINTS DU MAILLAGE.
00066 ! |   NBOR         | -->| NUMEROTAION GLOBALE DES POINTS DE BORD.
00067 ! |   NFIC         | -->| NUMERO DE CANAL DU FICHIER A LIRE OU ECRIRE.
00068 ! |   STAND        | -->| NON UTILISE
00069 ! |   STD          | -->| BINAIRE DU FICHIER (STD, IBM, I3E)
00070 ! |   NVAR         |<-->| NOMBRE DE VARIABLES DANS LE FICHIER
00071 ! |   TEXTE        |<-->| NOMS ET UNITES DES VARIABLES.
00072 ! |   TEXTLU       |<-->| NOMS ET UNITES DES VARIABLES QU'ON VA LIRE.
00073 ! |   VARCLA       | -->| TABLEAU CONTENANT LES VARIABLES CLANDESTI-NES.
00074 ! |   NVARCL       | -->| NOMBRE DE VARIABLES CLANDESTI-NES.
00075 ! |   TITRE        |<-->| TITRE DU FICHIER.
00076 ! |   SORLEO       | -->| VARIABLES QUE L'ON SOUHAITE ECRIRE DANS LE
00077 ! |                |    | FICHIER (TABLEAU DE 26 LOGIQUES)
00078 ! |   NSOR         | -->| DIMENSION DE SOLRLEO
00079 ! |   W            | -->| TABLEAU DE TRAVAIL CONSIDERE ICI COMME REEL
00080 ! |                |    | DE TAILLE NPOIN.
00081 ! |   IKLE         |<-->| TABLE DE CONNECTIVITE (I.E. PASSAGE DE LA
00082 ! |                |    | NUMEROTATION LOCALE DES POINTS D'UN ELEMENT
00083 ! |                |    | A LA NUMEROTATION GLOBALE
00084 ! |   IKLES        | -->| TABLEAU DE TRAVAIL SERVANT A MODIFIER IKLE
00085 ! |                |    | DIMENSION NELEM * NDP
00086 ! |   ITRAV        | -->| TABLEAU DE TRAVAIL ENTIER DE DIMENSION NPOIN
00087 ! |   NELEM        |<-->| NOMBRE D'ELEMENTS DU MAILLAGE.
00088 ! |   NPTFR        |<-->| NOMBRE DE POINTS FRONTIERE DU DOMAINE.
00089 ! |   NDP          |<-->| NOMBRE DE SOMMETS PAR ELEMENT.
00090 ! |   DEBU         | -->| ON LIT UNIQUEMENT LE DEBUT DU FICHIER POUR
00091 ! |                |    | CONNAITRE LES NOMBRES DE POINTS AVEC LESQUELS
00092 ! |                |    | ON POURRA CONSTRUIRE LES POINTEURS.
00093 ! |   SUIT         | -->| ON LIT TOUTE LA PARTIE GEOMETRIE DU FICHIER
00094 ! |                |    | POUR SE PLACER SUR LES ENREGISTREMENTS DES
00095 ! |                |    | RESULTATS.
00096 ! |   ECRI         | -->| ON ECRIT LA PARTIE GEOMETRIE DU FICHIER
00097 ! |   LISTIN       | -->| ECRITURE D'INFORMATIONS SUR LISTING (OU NON)
00098 ! |________________|____|______________________________________________
00099 ! MODE : -->(DONNEE NON MODIFIEE), <--(RESULTAT), <-->(DONNEE MODIFIEE)
00100 !-----------------------------------------------------------------------
00101 !
00102 ! PROGRAMMES APPELES : LIT , ECRIT
00103 !
00104 !***********************************************************************
00105 !
00106 !    LISTE DES ENREGISTREMENTS DU FICHIER GEOMETRIQUE:
00107 !
00108 !      1    : TITRE DE L'ETUDE
00109 !      2    : NOMBRE DE FONCTIONS LUES SUR LA GRILLE 1 ET LA GRILLE 2.
00110 !      3    : NOM ET UNITE DES VARIABLES
00111 !      4    : 1,0,0,0,0,0,0,0,0,0
00112 !      5    : NELEM,NPOIN,NDP,1
00113 !      6    : IKLE
00114 !      7    : IPOBO TABLEAU DE DIMENSION NPOIN, 0 POUR LES POINTS
00115 !             INTERIEURS, UN NUMERO SINON.
00116 !      8    : X
00117 !      9    : Y
00118 !
00119 !    CE QUI SUIT N'EST PAS FAIT DANS FM3SEL.
00120 !
00121 !     10    : TEMPS
00122 !     11    : VARIABLES DECLAREES EN 3 (DANS L'ORDRE DES DECLARATIONS)
00123 !
00124 !***********************************************************************
00125 !
00126       IMPLICIT NONE
00127       INTEGER LNG,LU
00128       COMMON/INFO/LNG,LU
00129 !
00130       DOUBLE PRECISION X(*),Y(*),XBID(2)
00131       REAL W(*)
00132 !
00133 !                     IKLE(NELEM,NDP) IKLES(NDP,NELEM)
00134       INTEGER NBOR(*),IKLE(*)        ,IKLES(*)        ,IB(10),ITRAV(*)
00135       INTEGER NPOIN,ISTAT,NVAR,I,IBID(1),MXPTVS,MXELVS,TIME(3),DATE(3)
00136       INTEGER NFIC,NVARCL,NSOR
00137       INTEGER IELEM,NELEM,NPTFR,NDP,IPARAM(10),IPOBO(*)
00138 !
00139       LOGICAL DEBU,SUIT,ECRI,LISTIN,SORLEO(*)
00140 !
00141       CHARACTER*1 CBID
00142       CHARACTER*3 STD
00143       CHARACTER*72 TITRE
00144       CHARACTER*80 TITSEL
00145       CHARACTER*32 TEXTE(*),TEXTLU(*),VARCLA(NVARCL)
00146 !                        NSOR      NSOR+NVARCL
00147 !-----------------------------------------------------------------------
00148 !
00149 !   ON SE PLACE AU DEBUT DU FICHIER
00150 !
00151       REWIND NFIC
00152 !
00153 !   LEC/ECR 1   : NOM DU FICHIER GEOMETRIQUE.
00154 !
00155       IF(ECRI) THEN
00156         TITSEL = TITRE // 'SERAPHIN'
00157         CALL ECRI2(XBID,IBID,TITSEL,80,'CH',NFIC,STD,ISTAT)
00158         IF(LNG.EQ.1) WRITE(LU,*) 'TITRE :',TITSEL
00159         IF(LNG.EQ.2) WRITE(LU,*) 'TITLE :',TITSEL
00160       ELSE
00161         CALL LIT(XBID,W,IBID,TITRE,72,'CH',NFIC,STD,ISTAT)
00162       ENDIF
00163 !
00164 !   LEC/ECR 2   : NOMBRE DE FONCTIONS DE DISCRETISATION 1 ET 2
00165 !
00166       IF(ECRI) THEN
00167         IB(1)=0
00168         IB(2)=0
00169         DO I=1,NSOR
00170           IF(SORLEO(I)) IB(1) = IB(1) + 1
00171         ENDDO
00172         IB(1) = IB(1) + NVARCL
00173         CALL ECRI2(XBID,IB,CBID,2,'I ',NFIC,STD,ISTAT)
00174       ELSE
00175         CALL LIT(XBID,W,IB,CBID,2,'I ',NFIC,STD,ISTAT)
00176       ENDIF
00177       NVAR =  IB(1)  +  IB(2)  -  NVARCL
00178 !
00179 !   LEC/ECR 3 : NOMS ET UNITES DES VARIABLES
00180 !
00181       IF(NVAR.GE.1) THEN
00182         IF(ECRI) THEN
00183           DO I=1,NSOR
00184             IF(SORLEO(I)) THEN
00185              CALL ECRI2(XBID,IBID,TEXTE(I)(1:32),32,'CH',NFIC,STD,ISTAT)
00186             ENDIF
00187           ENDDO
00188           IF(NVARCL.NE.0) THEN
00189             DO I=1,NVARCL
00190             CALL ECRI2(XBID,IBID,VARCLA(I)(1:32),32,'CH',NFIC,STD,ISTAT)
00191             ENDDO
00192           ENDIF
00193         ELSE
00194           DO I=1,NVAR+NVARCL
00195             CALL LIT(XBID,W,IBID,TEXTLU(I),32,'CH',NFIC,STD,ISTAT)
00196           ENDDO
00197         ENDIF
00198       ENDIF
00199 !
00200 !   LEC/ECR 4   : LISTE DE 10 PARAMETRES ENTIERS
00201 !
00202       IF(ECRI) THEN
00203         IB(1) = 1
00204         DO I = 2,10
00205           IB(I) = 0
00206         ENDDO
00207 !   Y-A-T-IL PASSAGE DE LA DATE ?
00208         IF(DATE(1)+DATE(2)+DATE(3)+TIME(1)+TIME(2)+TIME(3).NE.0) THEN
00209           IB(10) = 1
00210         ENDIF
00211 !   ECRITURE DU TABLEAU DE 10 PARAMETRES
00212         IF(IPARAM(8).EQ.0.AND.IPARAM(9).EQ.0) THEN
00213           CALL ECRI2(XBID,IB,CBID,10,'I ',NFIC,STD,ISTAT)
00214         ELSE
00215 !         ON RECRIT IPARAM QUI CONTIENT DES INFORMATIONS SUR LE PARALLELISME
00216           CALL ECRI2(XBID,IPARAM,CBID,10,'I ',NFIC,STD,ISTAT)
00217         ENDIF
00218 !   PASSAGE DE LA DATE
00219         IF(IB(10).EQ.1) THEN
00220           IB(1)=DATE(1)
00221           IB(2)=DATE(2)
00222           IB(3)=DATE(3)
00223           IB(4)=TIME(1)
00224           IB(5)=TIME(2)
00225           IB(6)=TIME(3)
00226           CALL ECRI2(XBID,IB,CBID,6,'I ',NFIC,STD,ISTAT)
00227         ENDIF
00228       ELSE
00229         CALL LIT(XBID,W,IB,CBID,10,'I ',NFIC,STD,ISTAT)
00230         IF(IB(10).EQ.1) THEN
00231           CALL LIT(XBID,W,IB,CBID,6,'I ',NFIC,STD,ISTAT)
00232           DATE(1)=IB(1)
00233           DATE(2)=IB(2)
00234           DATE(3)=IB(3)
00235           TIME(1)=IB(4)
00236           TIME(2)=IB(5)
00237           TIME(3)=IB(6)
00238         ENDIF
00239       ENDIF
00240 !
00241 !   LEC/ECR 5 : 4 ENTIERS
00242 !
00243       IF(ECRI) THEN
00244         IB(1) = NELEM
00245         IB(2) = NPOIN
00246         IB(3) = NDP
00247         IB(4) = 1
00248         CALL ECRI2(XBID,IB,CBID,4,'I ',NFIC,STD,ISTAT)
00249       ELSE
00250         CALL LIT(XBID,W,IB,CBID,4,'I ',NFIC,STD,ISTAT)
00251         NELEM = IB(1)
00252         NPOIN = IB(2)
00253         NDP   = IB(3)
00254       ENDIF
00255 !
00256 !   LEC/ECR 6 : IKLE
00257 !
00258       IF(DEBU) THEN
00259 !       MODIFICATION POUR LE CALCUL DE MXPTVS ET MXELVS
00260 !       ON LIT MAINTENANT VRAIMENT IKLES ET ON LE RANGE DANS ITRAV
00261 !       A L'ADRESSE 1+NPOIN
00262         CALL LIT(XBID,W,ITRAV(1+NPOIN),
00263      &           CBID,NELEM*NDP,'I ',NFIC,STD,ISTAT)
00264       ELSEIF(SUIT) THEN
00265         CALL LIT(XBID,W,IB   ,CBID,    2    ,'I ',NFIC,STD,ISTAT)
00266       ELSEIF(ECRI) THEN
00267 !       INVERSION DE IKLE  EN IKLES POUR SELAFIN
00268         DO I      = 1,NDP
00269         DO IELEM  = 1,NELEM
00270           IKLES((IELEM-1)*NDP+I) = IKLE((I-1)*NELEM+IELEM)
00271         ENDDO
00272         ENDDO
00273         CALL ECRI2(XBID   ,IKLES,CBID,NELEM*NDP,'I ',NFIC,STD,ISTAT)
00274       ELSE
00275         CALL LIT(XBID,W,IKLES,CBID,NELEM*NDP,'I ',NFIC,STD,ISTAT)
00276 !       INVERSION DE IKLES EN IKLE.
00277         DO I      = 1,NDP
00278         DO IELEM  = 1,NELEM
00279           IKLE((I-1)*NELEM+IELEM) = IKLES((IELEM-1)*NDP+I)
00280         ENDDO
00281         ENDDO
00282       ENDIF
00283 !
00284 !   LEC/ECR 7 : IPOBO
00285 !
00286       IF(DEBU) THEN
00287         CALL LIT(XBID,W,ITRAV,CBID,NPOIN,'I ',NFIC,STD,ISTAT)
00288         NPTFR = 0
00289         IF(NPOIN.GE.1) THEN
00290           DO I = 1 , NPOIN
00291             IF(ITRAV(I).NE.0) NPTFR = NPTFR + 1
00292           ENDDO
00293         ENDIF
00294 !       ITRAV(1) : IPOBO  ITRAV(1+NPOIN) : IKLES
00295 !       ITRAV(1+NPOIN+NDP*NELEM) : TABLEAU DE TRAVAIL.
00296         CALL MXPTEL(MXPTVS,MXELVS,ITRAV(1+NPOIN),
00297      &              ITRAV(1+NPOIN+NDP*NELEM),
00298      &              NPOIN,NELEM,NDP,ITRAV,LISTIN)
00299 !       IPOBO EST MODIFIE PAR MXPTEL
00300       ELSEIF(ECRI) THEN
00301         IF(IPARAM(8).EQ.0.AND.IPARAM(9).EQ.0) THEN
00302           DO I=1,NPOIN
00303            ITRAV(I) = 0
00304           ENDDO
00305           DO I =1,NPTFR
00306            ITRAV(NBOR(I)) = I
00307           ENDDO
00308           CALL ECRI2(XBID   ,ITRAV,CBID,NPOIN,'I ',NFIC,STD,ISTAT)
00309         ELSE
00310 !       PARALLELISME
00311           CALL ECRI2(XBID   ,IPOBO,CBID,NPOIN,'I ',NFIC,STD,ISTAT)
00312         ENDIF
00313       ELSE
00314         CALL LIT(XBID,W,IB,CBID,2,'I ',NFIC,STD,ISTAT)
00315       ENDIF
00316 !
00317 !   LEC/ECR  8 ET 9 : X ET Y  COORDONNEES DES POINTS DU MAILLAGE
00318 !
00319       IF(DEBU.OR.SUIT) THEN
00320         CALL LIT(XBID,W,IBID,CBID,2    ,'R4',NFIC,STD,ISTAT)
00321         CALL LIT(XBID,W,IBID,CBID,2    ,'R4',NFIC,STD,ISTAT)
00322       ELSEIF(ECRI) THEN
00323         CALL ECRI2(X   ,IBID,CBID,NPOIN,'R4',NFIC,STD,ISTAT)
00324         CALL ECRI2(Y   ,IBID,CBID,NPOIN,'R4',NFIC,STD,ISTAT)
00325         IF(LNG.EQ.1) WRITE(LU,*) 'ECRITURE DE X ET Y'
00326         IF(LNG.EQ.2) WRITE(LU,*) 'WRITING X AND Y'
00327       ELSE
00328         CALL LIT(X   ,W,IBID,CBID,NPOIN,'R4',NFIC,STD,ISTAT)
00329         CALL LIT(Y   ,W,IBID,CBID,NPOIN,'R4',NFIC,STD,ISTAT)
00330       ENDIF
00331 !
00332       IF(DEBU.AND.LISTIN) THEN
00333         IF(LNG.EQ.1) WRITE(LU,300) TITRE
00334         IF(LNG.EQ.1) WRITE(LU,500) NPTFR,NELEM,NPOIN
00335         IF(LNG.EQ.2) WRITE(LU,301) TITRE
00336         IF(LNG.EQ.2) WRITE(LU,501) NPTFR,NELEM,NPOIN
00337         IF(NPOIN.LT.3.OR.NPTFR.LT.3.OR.NPTFR.GE.NPOIN) THEN
00338           IF(LNG.EQ.1) WRITE(LU,23) NPOIN,NPTFR
00339           IF(LNG.EQ.2) WRITE(LU,24) NPOIN,NPTFR
00340           CALL PLANTE(1)
00341           STOP
00342         ENDIF
00343       ENDIF
00344 !
00345 !-----------------------------------------------------------------------
00346 !
00347 !  FORMATS D'IMPRESSION :
00348 !
00349 23    FORMAT(1X,'FM3SEL : NOMBRE DE POINTS DU MAILLAGE : ',1I9,/,1X,
00350      &          '         NOMBRE DE POINTS DE FRONTIERE: ',1I9,/,1X,
00351      &          '         DONNEES ERRONEES, ARRET DU PROGRAMME')
00352 24    FORMAT(1X,'FM3SEL : NUMBER OF POINTS IN THE MESH: ',1I9,/,1X,
00353      &          '         NUMBER OF BOUNDARY POINTS: ',1I9,/,1X,
00354      &          '         WRONG DATA, PROGRAMME STOPPED')
00355 300   FORMAT(1X,//,1X,'TITRE: ',A72,/)
00356 301   FORMAT(1X,//,1X,'TITLE: ',A72,/)
00357 500   FORMAT(1X,'NOMBRE DE POINTS FRONTIERE: ',1I9,/,1X,
00358      &'NOMBRE D''ELEMENTS:',1I9,/,1X,'NOMBRE REEL DE POINTS:',1I9)
00359 501   FORMAT(1X,'NUMBER OF BOUNDARY POINTS: ',1I9,/,1X,
00360      &'NUMBER OF ELEMENTS:',1I9,/,1X,'NUMBER OF POINTS:',1I9)
00361 !
00362 !-----------------------------------------------------------------------
00363 !
00364       RETURN
00365       END

Generated on Fri Aug 31 2013 18:12:58 by S.E.Bourban (HRW) using doxygen 1.7.0