check.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac3d\check.f
00002 !
00061                      SUBROUTINE CHECK
00062 !                    ****************
00063 !
00064      &(IKLE2,NBOR,NELBOR,IKLBOR,NELEB,NELEBX,IKLE3,NELBO3,NULONE,
00065      & DIM1NUL,DIM2NUL,NBOR3,NELEM2,NPOIN2,NPTFR,NELEM3,NPTFR3,INFO)
00066 !
00067 !***********************************************************************
00068 ! TELEMAC3D   V6P1                                   21/08/2010
00069 !***********************************************************************
00070 !
00071 !
00072 !
00073 !
00074 !
00075 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00076 !| IKLBOR         |-->| CONNECTIVITY TABLE OF BOUNDARY ELEMENTS
00077 !| IKLE2          |-->| GLOBAL NUMBERS OF POINTS IN 2D ELEMENTS
00078 !| IKLE3          |-->| GLOBAL NUMBERS OF POINTS IN 3D ELEMENTS
00079 !| INFO           |-->| LISTING PRINTOUT OR NOT
00080 !| NBOR           |-->| GLOBAL NUMBER OF 2D BOUNDARY POINTS
00081 !| NBOR3          |-->| GLOBAL NUMBER OF 3D BOUNDARY POINTS
00082 !| NELBO3         |-->| ASSOCIATION OF EACH BOUNDARY EDGE
00083 !|                |   | TO THE CORRESPONDING 3D ELEMENT
00084 !| NELBOR         |-->| NUMBER OF THE ADJACENT ELEMENT AT THE K TH
00085 !|                |   | BOUNDARY SEGMENT
00086 !| NELEM2         |-->| NUMBER OF ELEMENTS IN 2D MESH
00087 !| NELEM3         |-->| NUMBER OF ELEMENTS IN 3D MESH
00088 !| NPOIN2         |-->| NUMBER OF POINTS IN 2D
00089 !| NPTFR          |-->| NUMBER OF BOUNDARY POINTS IN 2D
00090 !| NPTFR3         |-->| NUMBER OF BOUNDARY POINTS IN 3D
00091 !| NULONE         |-->| GOES WITH ARRAY NELBOR. NELBOR GIVES THE
00092 !|                |   | ADJACENT ELEMENT, NULONE GIVES THE LOCAL
00093 !|                |   | NUMBER OF THE FIRST NODE OF THE BOUNDARY EDGE
00094 !|                |   | I.E. 1, 2 OR 3 FOR TRIANGLES.
00095 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00096 !
00097       USE BIEF
00098 !
00099       IMPLICIT NONE
00100       INTEGER LNG,LU
00101       COMMON/INFO/LNG,LU
00102 !
00103 !-----------------------------------------------------------------------
00104 !
00105       INTEGER, INTENT(IN) :: NELEM2,NPOIN2,NPTFR,NELEM3
00106       INTEGER, INTENT(IN) :: NPTFR3,NELEB,NELEBX,DIM1NUL,DIM2NUL
00107       INTEGER, INTENT(IN) :: NELBOR(NPTFR),NBOR(NPTFR)
00108       INTEGER, INTENT(IN) :: IKLE2(NELEM2,3)
00109       INTEGER, INTENT(IN) :: IKLBOR(NELEBX,4),IKLE3(NELEM3,6)
00110       INTEGER, INTENT(IN) :: NELBO3(NELEBX)
00111       INTEGER, INTENT(IN) :: NULONE(DIM1NUL,DIM2NUL)
00112       INTEGER, INTENT(IN) :: NBOR3(NPTFR3)
00113       LOGICAL, INTENT(IN) :: INFO
00114 !
00115 !-----------------------------------------------------------------------
00116 !
00117       INTEGER IERR,IEL,N1,N2,IPTFR,ILOC,IELEB
00118 !
00119 !***********************************************************************
00120 !
00121 !     INITIALISES FATAL ERROR COUNT
00122 !
00123       IERR  = 0
00124 !
00125 !-----------------------------------------------------------------------
00126 !
00127 !     CHECKS 2D ARRAY NELBOR: GLOBAL POINT ON THE BOUNDARY MUST BE ONE
00128 !                             POINT OF THE ELEMENT GIVEN BY NELBOR
00129 !
00130       IF(NCSIZE.LE.1) THEN
00131 !
00132         DO IPTFR = 1,NPTFR
00133           IEL = NELBOR(IPTFR)
00134           N1  = NBOR(IPTFR)
00135           IF (N1.NE.IKLE2(IEL,1).AND.N1.NE.IKLE2(IEL,2).AND.
00136      &        N1.NE.IKLE2(IEL,3)) THEN
00137             IF (LNG.EQ.1) WRITE(LU,11) IEL,IPTFR
00138             IF (LNG.EQ.2) WRITE(LU,12) IEL,IPTFR
00139             IERR = IERR + 1
00140           ENDIF
00141         ENDDO
00142 !
00143       ENDIF
00144 !
00145 !-----------------------------------------------------------------------
00146 !
00147 !     CHECKS 3D ARRAYS IKLBOR,MESH3D%NELBOR=NELBO3 HERE,NULONE
00148 !
00149       IF(NCSIZE.LE.1) THEN
00150 !
00151         DO ILOC = 1,DIM2NUL
00152           DO IELEB=1,NELEB
00153               N1=NBOR3(IKLBOR(IELEB,ILOC))
00154               N2=IKLE3(NELBO3(IELEB),NULONE(IELEB,ILOC))
00155               IF (N1.NE.N2) THEN
00156                 IF (LNG.EQ.1) WRITE(LU,51) IELEB,ILOC,N1,N2
00157                 IF (LNG.EQ.2) WRITE(LU,52) IELEB,ILOC,N1,N2
00158                 IERR = IERR + 1
00159               ENDIF
00160           ENDDO
00161         ENDDO
00162 !
00163       ENDIF
00164 !
00165 !-----------------------------------------------------------------------
00166 !
00167 ! PRINTS OUT THE RESULTS
00168 !
00169       IF(IERR.EQ.0) THEN
00170         IF(LNG.EQ.1 .AND. INFO) WRITE(LU,111)
00171         IF(LNG.EQ.2 .AND. INFO) WRITE(LU,112)
00172       ELSEIF(IERR.EQ.1) THEN
00173         IF(LNG.EQ.1) WRITE(LU,121)
00174         IF(LNG.EQ.2) WRITE(LU,122)
00175         CALL PLANTE(1)
00176         STOP
00177       ELSE
00178         IF(LNG.EQ.1) WRITE(LU,131) IERR
00179         IF(LNG.EQ.2) WRITE(LU,132) IERR
00180         CALL PLANTE(1)
00181         STOP
00182       ENDIF
00183 !
00184 !-----------------------------------------------------------------------
00185 !
00186 11    FORMAT(' CHECK: L''ELEMENT',
00187      &   I6,' N''EST PAS ADJACENT AU POINT DE BORD',I5)
00188 12    FORMAT(' CHECK: ELEMENT',
00189      &   I6,' IS NOT ADJACENT TO BOUNDARY NODE',I5)
00190 51    FORMAT(' CHECK: ERREUR SUR LA STRUCTURE DE DONNEES',/,
00191      &       'IELEB,ILOC,N1,N2 :',4I5)
00192 52    FORMAT(' CHECK: ERROR ON DATA STRUCTURE',/,
00193      &       'IELEB,ILOC,N1,N2 :',4I5)
00194 111   FORMAT(' CHECK: AUCUNE ERREUR N''A ETE DETECTEE',////)
00195 112   FORMAT(' CHECK: NO ERROR HAS BEEN DETECTED',////)
00196 121   FORMAT(' CHECK: 1 ERREUR FATALE . ARRET DU PROGRAMME',////)
00197 122   FORMAT(' CHECK: 1 FATALE ERROR . BREAK IN THE PROGRAM',////)
00198 131   FORMAT(' CHECK: ',I4,' ERREURS FATALES . ARRET DU PROGRAMME',////)
00199 132   FORMAT(' CHECK: ',I4,' FATALE ERRORS . BREAK IN THE PROGRAM',////)
00200 !
00201 !-----------------------------------------------------------------------
00202 !
00203       RETURN
00204       END

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