diffsel.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\diffsel\diffsel.f
00002 !
00044                      PROGRAM DIFFSEL
00045 !                    ***************
00046 !
00047 !
00048 !***********************************************************************
00049 ! PARALLEL   V6P1                                   21/08/2010
00050 !***********************************************************************
00051 !
00052 !
00053 !
00054 !
00055 !
00056 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00057 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00058 !
00059       IMPLICIT NONE
00060 !
00061       INTEGER NVAR,I,K,NELEM1,NPOIN1,NDP1,II1,II2,J
00062       INTEGER ITAB(100000),JTAB(100000),IT1(10),IT2(10)
00063       INTEGER NELEM2,NPOIN2,NDP2
00064 !
00065       REAL  XTAB(100000),YTAB(100000)
00066       REAL R1, R2, EPSILON, EPSREF, EPSMAX
00067 !
00068       CHARACTER*72 TIT1,TIT2
00069       INTEGER I1,I2,J1,J2
00070 !
00071       CHARACTER*32 C1_32,C2_32
00072       CHARACTER*40 FICNAM1, FICNAM2
00073 !
00074 !------ NAME OF THE 2 FILES TO COMPARE (SELAFIN)
00075 !
00076       PRINT*,'NOM DU FICHIER SELAFIN 1'
00077       READ(5,5000) FICNAM1
00078 5000  FORMAT(A)
00079 !
00080       PRINT*,'NOM DU FICHIER SELAFIN 2'
00081       READ(5,5000) FICNAM2
00082       EPSREF = 1.E-10
00083       EPSMAX = 0.
00084       PRINT*,'                    FICHIERS SELAFIN : '
00085       PRINT*,'      - ', FICNAM1
00086       PRINT*,'      - ', FICNAM2
00087       PRINT*,' '
00088 !
00089 !------ EXPLOITATION OF THE FILES:
00090 !
00091       OPEN (UNIT=2,FILE=FICNAM2,FORM='UNFORMATTED',
00092      &      STATUS='OLD',ERR=8010)
00093       OPEN (UNIT=1,FILE=FICNAM1,FORM='UNFORMATTED',
00094      &      STATUS='OLD',ERR=8000)
00095 !
00096 !------ #1 : TITLE
00097 !
00098         READ (1) TIT1
00099         READ (2) TIT2
00100         IF ( TIT1 .EQ. TIT2 ) THEN
00101           PRINT *, ' #1 ... OK'
00102         ELSE
00103           WRITE(*,*) ' #2 ... ERREUR : DIFFERENT'
00104           CALL PLANTE(1)
00105           STOP
00106         ENDIF
00107 !
00108 !------ #2 : NBV_1 AND NBV_2
00109 !
00110       READ (1) I1, I2
00111       READ (2) J1, J2
00112         IF (I1 .NE. J1) PRINT*, ' #2 ... ERREUR I1=',I1,
00113      &                                   ',  J1=',J1
00114         IF (I2 .NE. J2) PRINT*, ' #2 ... ERREUR I2=',I2,
00115      &                                   ',  J2=',J2
00116 !
00117         PRINT *, ' #2 ... OK'
00118 !
00119 !------ #3 : NAMES AND UNITS
00120 !
00121       NVAR = I1 + I2
00122       DO I=1, NVAR
00123       READ(1) C1_32
00124       READ(2) C2_32
00125 !
00126         IF (C1_32 .NE. C2_32) THEN
00127           PRINT*, ' #3 ... ERREUR C1_32=',C1_32,
00128      &                      ', C2_32=',C2_32
00129           CALL PLANTE(1)
00130           STOP
00131         ENDIF
00132 !
00133       ENDDO ! I
00134         PRINT *, ' #3 ... OK,   NVAR=',NVAR
00135 !
00136 !------ #4 : 1,0,0,0,0,0,0,0,0,0,0
00137 !
00138       READ(1)  ( IT1(K), K=1,10)
00139       READ(2)  ( IT2(K), K=1,10)
00140         DO K=1, 10
00141         IF (IT1(K) .NE.IT2(K)) THEN
00142           PRINT*, ' #4 ... ERREUR IT1=',IT1(K),
00143      &                     ',   IT2=',IT2(K)
00144           CALL PLANTE(1)
00145           STOP
00146         ENDIF
00147         ENDDO ! K
00148 !
00149       IF (IT1(10) .EQ. 1) THEN
00150       READ(1)  ( IT1(K), K=1,6)
00151       READ(2)  ( IT2(K), K=1,6)
00152         DO K=1, 10
00153         IF (IT1(K) .NE. IT2(K)) THEN
00154           PRINT*, ' #4 ... ERREUR IT1=',IT1(K),
00155      &                     ',   IT2=',IT2(K)
00156           CALL PLANTE(1)
00157           STOP
00158         ENDIF
00159         ENDDO ! K
00160       ENDIF
00161       PRINT *, ' #4 ... OK'
00162 !
00163 !------ #5 : NELEM, NPOIN, NDP, 1
00164 !
00165       READ (1) NELEM1, NPOIN1, NDP1, II1
00166       READ (2) NELEM2, NPOIN2, NDP2, II2
00167         IF ( NELEM1 .NE. NELEM2 )
00168      &    WRITE(*,*) ' #5 ... ERREUR : NELEM1<>NELEM2'
00169           CALL PLANTE(1)
00170           STOP
00171         IF ( NPOIN1 .NE. NPOIN2 )
00172      &    WRITE(*,*) ' #5 ... ERREUR : NPOIN1<>NPOIN2'
00173           CALL PLANTE(1)
00174           STOP
00175         IF ( NDP1 .NE. NDP2 )
00176      &    WRITE(*,*) ' #5 ... ERREUR : NDP1<>NDP2'
00177           CALL PLANTE(1)
00178           STOP
00179         IF ( II1 .NE. II2 )
00180      &    WRITE(*,*) ' #5 ... ERREUR : II1<>II2'
00181           CALL PLANTE(1)
00182           STOP
00183         PRINT *,' #5 ... OK,  NELEM=',NELEM1,',  NPOINT=',NPOIN1
00184 !
00185 !------ #6 : IKLE
00186 !
00187       READ (1) (ITAB(I), I=1, NELEM1*NDP1)
00188       READ (2) (JTAB(I), I=1, NELEM1*NDP1)
00189         EPSILON=0.
00190         DO K=1, NELEM1*NDP1
00191         IF (FLOAT(ABS(ITAB(K)-JTAB(K))) .GT. EPSMAX)
00192      &      EPSMAX=ABS(ITAB(K)-JTAB(K))
00193         IF (FLOAT(ABS(ITAB(K)-JTAB(K))) .GT. EPSILON)
00194      &          EPSILON = FLOAT(ABS(ITAB(K)-JTAB(K)) )
00195         ENDDO ! K
00196         IF (EPSILON .GT. EPSREF) THEN
00197           PRINT*, ' #6 ... ERREUR : EPSILON = ', EPSILON
00198         ENDIF
00199         PRINT *, ' #6 ... OK'
00200 !
00201 !------ #7 : IPOBO
00202 !
00203       READ (1) (ITAB(I), I=1, NPOIN1)
00204       READ (2) (JTAB(I), I=1, NPOIN1)
00205         EPSILON=0.
00206         DO K=1, NPOIN1
00207         IF (ABS(ITAB(K)-JTAB(K)) .GT. EPSMAX)
00208      &      EPSMAX=ABS(ITAB(K)-JTAB(K))
00209         IF (ABS(ITAB(K)-JTAB(K)) .GT. EPSILON)
00210      &          EPSILON = ABS(ITAB(K)-JTAB(K) )
00211         ENDDO ! K
00212         IF (EPSILON .GT. EPSREF) THEN
00213           PRINT*, ' #7 ... ERREUR IPOBO : EPSILON = ', EPSILON
00214         ENDIF
00215         PRINT *, ' #7 ... OK'
00216 !
00217 !------ #8 : X
00218 !
00219 !8/11: PB CRASHES HERE (" INVALID REAL")
00220 !
00221       READ (1) (XTAB(I), I=1, NPOIN1)
00222       READ (2) (YTAB(I), I=1, NPOIN1)
00223         EPSILON=0.
00224         DO K=1, NPOIN1
00225         IF (ABS(XTAB(K)-YTAB(K)) .GT. EPSMAX)
00226      &      EPSMAX=ABS(XTAB(K)-YTAB(K))
00227         IF (ABS(XTAB(K)-YTAB(K)) .GT. EPSILON)
00228      &          EPSILON = ABS(XTAB(K)-YTAB(K) )
00229         ENDDO ! K
00230         IF (EPSILON .GT. EPSREF) THEN
00231           PRINT*, ' #8 ... ERREUR : EPSILON = ', EPSILON
00232           CALL PLANTE(1)
00233           STOP
00234         ENDIF
00235 !
00236         PRINT *, ' #8 ... OK'
00237 !
00238 !------ #9 : Y
00239 !
00240       READ (1) (XTAB(I), I=1, NPOIN1)
00241       READ (2) (YTAB(I), I=1, NPOIN1)
00242         EPSILON=0.
00243         DO K=1, NPOIN1
00244         IF (ABS(XTAB(K)-YTAB(K)) .GT. EPSMAX)
00245      &      EPSMAX=ABS(XTAB(K)-YTAB(K))
00246         IF (ABS(XTAB(K)-YTAB(K)) .GT. EPSILON)
00247      &          EPSILON = ABS(XTAB(K)-YTAB(K) )
00248         ENDDO ! K
00249         IF (EPSILON .GT. EPSREF) THEN
00250           PRINT*, ' #9 ... ERREUR : EPSILON = ', EPSILON
00251           CALL PLANTE(1)
00252           STOP
00253         ENDIF
00254         PRINT *, ' #9 ... OK'
00255 !
00256 !------ #10 : T
00257 !
00258 800   CONTINUE
00259 !
00260       READ(1, END=9999) R1
00261       READ(2) R2
00262       IF (ABS(R1-R2) .GT. EPSREF) THEN
00263         PRINT*, '# 10 ... ERREUR : EPSILON = ', ABS(R1-R2), 
00264 ',     &        T1=', R1, ', T2=',R2
00265         CALL PLANTE(1)
00266         STOP
00267       ENDIF
00268       PRINT*, '#10 ... T1=T2=', R1
00269 !
00270 !------ #9 : NVAR VECTORS
00271 !
00272       IF ( NVAR .LT. 1) GOTO 800
00273       DO J=1,NVAR
00274         READ (1) (XTAB(I), I=1, NPOIN1)
00275         READ (2) (YTAB(I), I=1, NPOIN1)
00276         EPSILON=0.
00277         DO K=1, NPOIN1
00278           IF (ABS(XTAB(K)-YTAB(K)) .GT. EPSMAX)
00279      &      EPSMAX=ABS(XTAB(K)-YTAB(K))
00280           IF (ABS(XTAB(K)-YTAB(K)) .GT. EPSILON)
00281      &    EPSILON = ABS(XTAB(K)-YTAB(K) )
00282         ENDDO ! K
00283         IF (EPSILON .GT. EPSREF) THEN
00284           PRINT*, ' #11 ... ERREUR : EPSILON = ', EPSILON, ', T = ', R1
00285         ENDIF
00286       ENDDO ! J
00287 !
00288       GOTO 800
00289 !
00290 !------ ERRORS
00291 !
00292 8000  WRITE(*,*) 'ERREUR OUVERTURE FICHIER 1'
00293       CALL PLANTE(1)
00294       STOP
00295 8010  WRITE(*,*) 'ERREUR OUVERTURE FICHIER 2'
00296       CALL PLANTE(1)
00297       STOP
00298 !
00299 !------- END : CLOSES THE FILES
00300 !
00301 9999  CONTINUE
00302       PRINT*,' '
00303       PRINT*, '   -> EPSILON MAX GLOBAL : ', EPSMAX
00304       CLOSE (1)
00305       CLOSE (2)
00306       END PROGRAM DIFFSEL

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