lectri.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\stbtel\lectri.f
00002 !
00031                         SUBROUTINE LECTRI
00032 !                       *****************
00033 !
00034      & (X, Y, IKLE, NCOLOR,NGEO , NFO1)
00035 !
00036 !***********************************************************************
00037 ! PROGICIEL : STBTEL V5.2          18/08/93   P. LANG  (LHF)
00038 !***********************************************************************
00039 !
00040 !     FONCTION  : LECTURE DES INFOS DE GEOMETRIE DANS LES FICHIERS TRIGR
00041 !
00042 !-----------------------------------------------------------------------
00043 !                             ARGUMENTS
00044 ! .________________.____.______________________________________________
00045 ! !      NOM       !MODE!                   ROLE
00046 ! !________________!____!______________________________________________
00047 ! ! X,Y            !<-- ! COORDONNEES DES POINTS DU MAILLAGE
00048 ! ! IKLE           !<-- ! NUMEROS GLOBAUX DES NOEUDS DE CHAQUE ELEMENT
00049 ! ! NCOLOR         !<-- ! TABLEAU DES COULEURS DES NOEUDS(POUR LES CL)
00050 ! !________________!____!______________________________________________
00051 ! ! COMMON:        !    !
00052 ! !  GEO:          !    !
00053 ! !    MESH        ! -->! TYPE DES ELEMENTS DU MAILLAGE
00054 ! !    NDP         ! -->! NOMBRE DE NOEUDS PAR ELEMENTS
00055 ! !    NPOIN       ! -->! NOMBRE TOTAL DE NOEUDS DU MAILLAGE
00056 ! !    NELEM       ! -->! NOMBRE TOTAL D'ELEMENTS DU MAILLAGE
00057 ! !    NPMAX       ! -->! DIMENSION EFFECTIVE DES TABLEAUX X ET Y
00058 ! !                !    ! (NPMAX = NPOIN + 100)
00059 ! !    NELMAX      ! -->! DIMENSION EFFECTIVE DES TABLEAUX CONCERNANT
00060 ! !                !    ! LES ELEMENTS (NELMAX = NELEM + 200)
00061 ! !  FICH:         !    !
00062 ! !    NRES        !--> ! NUMERO DU CANAL DU FICHIER DE SERAFIN
00063 ! !    NGEO       !--> ! NUMERO DU CANAL DU FICHIER MAILLEUR
00064 ! !    NLIM      !--> ! NUMERO DU CANAL DU FICHIER DYNAM DE TELEMAC
00065 ! !    NFO1      !--> ! NUMERO DU CANAL DU FICHIER TRIANGLE TRIGRID
00066 ! !                !    !
00067 ! !  INFO:         !    !
00068 ! !    LNG         !--> ! LANGUE UTILISEE
00069 ! !    LU          !--> ! CANAL DE SORTIE DES MESSAGES
00070 ! !________________!____!______________________________________________
00071 ! MODE : -->(DONNEE NON MODIFIEE), <--(RESULTAT), <-->(DONNEE MODIFIEE)
00072 !-----------------------------------------------------------------------
00073 ! APPELE PAR :
00074 ! APPEL DE :
00075 !***********************************************************************
00076 !
00077       IMPLICIT NONE
00078       INTEGER NGEO, NFO1
00079       INTEGER MESH, NDP, NPOIN, NELEM, NPMAX, NELMAX
00080       INTEGER IKLE(NELMAX,4)
00081       INTEGER NCOLOR(*), I, J
00082       INTEGER ITYPND,NUMNOD
00083       INTEGER LNG,LU
00084       DOUBLE PRECISION X(*), Y(*)
00085 !
00086 ! COMMON
00087 !
00088       COMMON/GEO/ MESH, NDP, NPOIN, NELEM, NPMAX, NELMAX
00089       COMMON/INFO/LNG,LU
00090 !
00091       REWIND (NGEO)
00092       REWIND (NFO1)
00093       READ (NGEO,'(//)')
00094       DO I=1,NPOIN
00095         READ (NGEO,*,ERR=8000,END=9000) NUMNOD,X(I),Y(I),ITYPND
00096         IF (ITYPND.EQ.1) NCOLOR(I) = 11
00097         IF (ITYPND.EQ.2) NCOLOR(I) = 4
00098         IF (ITYPND.EQ.3) NCOLOR(I) = 5
00099         IF (ITYPND.EQ.4) NCOLOR(I) = 7
00100         IF (ITYPND.EQ.5) NCOLOR(I) = 8
00101         IF (ITYPND.EQ.6) NCOLOR(I) = 9
00102         IF (ITYPND.EQ.7) NCOLOR(I) = 1
00103         IF (ITYPND.EQ.8) NCOLOR(I) = 12
00104         IF (ITYPND.EQ.9) NCOLOR(I) = 15
00105         IF (ITYPND.EQ.10) NCOLOR(I) = 2
00106         IF (ITYPND.EQ.11) NCOLOR(I) = 3
00107         IF (ITYPND.EQ.12) NCOLOR(I) = 14
00108         IF (ITYPND.EQ.13) NCOLOR(I) = 13
00109       ENDDO
00110 !
00111       DO I=1,NELEM
00112         READ (NFO1, * , ERR=8010, END=9010) (IKLE(I,J),J=1,3)
00113       ENDDO
00114       RETURN
00115  8000 CONTINUE
00116       IF (LNG.EQ.1) WRITE (LU,4000)
00117       IF (LNG.EQ.2) WRITE (LU,4001)
00118  4000 FORMAT (//,1X,'***************************************'
00119      &        ,/,1X,'SOUS-PROGRAMME LECTRI : ERREUR DANS LA'
00120      &        ,/,1X,'LECTURE DU FICHIER DE MAILLAGE TRIGRID.'
00121      &        ,/,1X,'***************************************')
00122  4001 FORMAT (//,1X,'****************************'
00123      &        ,/,1X,'SUBROUTINE LECTRI :'
00124      &        ,/,1X,'ERROR READING TRIGRID FILE.'
00125      &        ,/,1X,'****************************')
00126       CALL PLANTE(1)
00127       STOP
00128  9000 CONTINUE
00129       IF (LNG.EQ.1) WRITE (LU,4010)
00130       IF (LNG.EQ.2) WRITE (LU,4011)
00131  4010 FORMAT (//,1X,'***************************************'
00132      &        ,/,1X,'SOUS-PROGRAMME LECTRI : FIN DU FICHIER'
00133      &        ,/,1X,'DE MAILLAGE RENCONTREE'
00134      &        ,/,1X,'***************************************')
00135  4011 FORMAT (//,1X,'***************************************'
00136      &        ,/,1X,'SUBROUTINE LECTRI : UNEXPECTED END OF'
00137      &        ,/,1X,'TRIGRID FILE ENCOUNTERED'
00138      &        ,/,1X,'***************************************')
00139       CALL PLANTE(1)
00140       STOP
00141  8010 CONTINUE
00142       IF (LNG.EQ.1) WRITE (LU,4020)
00143       IF (LNG.EQ.2) WRITE (LU,4021)
00144  4020 FORMAT (//,1X,'***************************************'
00145      &        ,/,1X,'SOUS-PROGRAMME LECTRI : ERREUR DANS LA'
00146      &        ,/,1X,'LECTURE DU FICHIER TRIANGLE DE TRIGRID'
00147      &        ,/,1X,'***************************************')
00148  4021 FORMAT (//,1X,'***************************************'
00149      &        ,/,1X,'SUBROUTINE LECTRI : ERROR READING'
00150      &        ,/,1X,'TRIGRID TRIANGLE FILE'
00151      &        ,/,1X,'***************************************')
00152       CALL PLANTE(1)
00153       STOP
00154  9010 CONTINUE
00155       IF (LNG.EQ.1) WRITE (LU,4030)
00156       IF (LNG.EQ.2) WRITE (LU,4031)
00157  4030 FORMAT (//,1X,'***************************************'
00158      &        ,/,1X,'SOUS-PROGRAMME LECTRI :'
00159      &        ,/,1X,'FIN DU FICHIER TRIANGLE RENCONTRE'
00160      &        ,/,1X,'***************************************')
00161  4031 FORMAT (//,1X,'***************************************'
00162      &        ,/,1X,'SUBROUTINE LECTRI : END OF'
00163      &        ,/,1X,'TRIGRID TRIANGLE FILE ENCOUNTERED'
00164      &        ,/,1X,'***************************************')
00165       CALL PLANTE(1)
00166       STOP
00167       END

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