check_digits.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\check_digits.f
00002 !
00059                      SUBROUTINE CHECK_DIGITS
00060 !                    ***********************
00061 !
00062      &(F,T1,MESH)
00063 !
00064 !***********************************************************************
00065 ! BIEF   V6P1                                   21/08/2010
00066 !***********************************************************************
00067 !
00068 !
00069 !
00070 !
00071 !
00072 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00073 !| F              |-->| BIEF_OBJ STRUCTURE TO BE CHECKED
00074 !| MESH           |-->| MESH STRUCTURE
00075 !| T1             |<->| WORK BIEF STRUCTURE, SIMILAR TO F
00076 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00077 !
00078       USE BIEF
00079 !
00080       IMPLICIT NONE
00081       INTEGER LNG,LU
00082       COMMON/INFO/LNG,LU
00083 !
00084 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00085 !
00086       TYPE(BIEF_OBJ),  INTENT(IN   ) :: F
00087       TYPE(BIEF_OBJ),  INTENT(INOUT) :: T1
00088       TYPE(BIEF_MESH), INTENT(INOUT) :: MESH
00089 !
00090 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00091 !
00092       INTEGER I,ISTOP
00093 !
00094       INTEGER  P_IMAX
00095       EXTERNAL P_IMAX
00096 !
00097 !-----------------------------------------------------------------------
00098 !
00099       CALL OS('X=Y     ',X=T1,Y=F)
00100       CALL PARCOM(T1,3,MESH)
00101       ISTOP=0
00102       DO I=1,T1%DIM1
00103         IF(T1%R(I).NE.F%R(I)) THEN
00104           IF(LNG.EQ.1) THEN
00105           WRITE(LU,*) 'CHECK_DIGITS : DIFFERENCE DANS ',F%NAME
00106           WRITE(LU,*) '               AU POINT LOCAL ',I
00107           WRITE(LU,*) '               =  POINT GLOBAL ',MESH%KNOLG%I(I)
00108           WRITE(LU,*) '               VALEUR ',F%R(I)
00109           WRITE(LU,*) '               MINIMUM ',T1%R(I)
00110           WRITE(LU,*) '            DIFFERENCE ',F%R(I)-T1%R(I)
00111           ENDIF
00112           IF(LNG.EQ.2) THEN
00113           WRITE(LU,*) 'CHECK_DIGITS : DIFFERENCE IN ',F%NAME
00114           WRITE(LU,*) '               AT LOCAL POINT ',I
00115           WRITE(LU,*) '               =  GLOBAL POINT ',MESH%KNOLG%I(I)
00116           WRITE(LU,*) '               VALUE ',F%R(I)
00117           WRITE(LU,*) '               MINIMUM ',T1%R(I)
00118           WRITE(LU,*) '            DIFFERENCE ',F%R(I)-T1%R(I)
00119           ENDIF
00120           ISTOP=I
00121         ENDIF
00122       ENDDO
00123 !
00124       IF(NCSIZE.GT.1) ISTOP=P_IMAX(ISTOP)
00125       IF(ISTOP.GT.0) THEN
00126         IF(LNG.EQ.1) THEN
00127           WRITE(LU,*) 'CHECK_DIGITS : ERREUR SUR VECTEUR ',F%NAME
00128         ENDIF
00129         IF(LNG.EQ.2) THEN
00130           WRITE(LU,*) 'CHECK_DIGITS : ERROR ON VECTOR ',F%NAME
00131         ENDIF
00132         CALL PLANTE(1)
00133         STOP
00134       ENDIF
00135 !
00136 !-----------------------------------------------------------------------
00137 !
00138       RETURN
00139       END

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