conv_serafin.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\stbtel\conv_serafin.f
00002 !
00040       MODULE CONV_SERAFIN
00041       CONTAINS
00042 !                       ***********************
00043                         SUBROUTINE READ_SERAFIN
00044 !                       ***********************
00045 !
00046      &(SLFFILE,LIMFILE)
00047 !
00048 !***********************************************************************
00049 ! STBTEL   V6P1                                   11/07/2011
00050 !***********************************************************************
00051 !
00052 !BRIEF    READS A FILE OF SERAFIN FORMAT AND FILL THE MESH OBJECT
00053 !
00054 !HISTORY  Y.AUDOUIN (EDF)
00055 !+        11/07/2011
00056 !+        V6P1
00057 !+   CREATION OF THE FILE
00058 !
00059 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00060 !| SLFFILE        |-->| NAME OF THE SERAFIN FILE IN THE TEMPORARY FOLDER
00061 !| LIMFILE        |-->| NAME OF THE BOUNDARY FILE IN THE TEMPORARY FOLDER
00062 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00063 !
00064       USE DECLARATIONS_STBTEL
00065       USE CONV_LIM
00066       USE BIEF
00067 !
00068       IMPLICIT NONE
00069       ! LANGAE AND OUTPUT VALUE
00070       INTEGER LNG,LU
00071       COMMON/INFO/LNG,LU
00072 !
00073 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00074 !
00075       CHARACTER(LEN=MAXLENHARD), INTENT(IN) :: SLFFILE
00076       CHARACTER(LEN=MAXLENHARD), INTENT(IN) :: LIMFILE
00077 !
00078 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00079 !
00080       INTEGER :: I,J,K,IERR,IDUM
00081       CHARACTER(LEN=32) :: VARI
00082       REAL :: TIME
00083       INTEGER :: IB(6)
00084       DOUBLE PRECISION XB(1)
00085       REAL :: RB(1)
00086       CHARACTER(LEN=1) :: CB
00087       INTEGER :: ISTAT
00088       REAL, ALLOCATABLE :: TMP(:)
00089       DOUBLE PRECISION, ALLOCATABLE :: TMP2(:)
00090       CHARACTER*2 :: RF
00091       CHARACTER*8 :: FFORMAT
00092 !
00093       WRITE(LU,*) '----------------------------------------------------'
00094       IF(LNG.EQ.1) WRITE(LU,*) '------DEBUT LECTURE DU FICHIER SERAFIN'
00095       IF(LNG.EQ.2) WRITE(LU,*) '------BEGINNING READING OF SERAFIN FILE'
00096       WRITE(LU,*) '----------------------------------------------------'
00097 !
00098 !-----------------------------------------------------------------------
00099 !
00100       ! IF THE OPTION DOUBLE PRECISION IS TRUE WE READ IN DOUBLE
00101       ! PRECISION SINGLE OTHERWISE
00102       IF(SERAFIN_DOUBLE) THEN
00103         RF='R8'
00104         WRITE(LU,*) 'DOUBLE PRECISION'
00105         FFORMAT='SERAFIND'
00106       ELSE
00107         RF='R4'
00108         FFORMAT='        '
00109       ENDIF
00110       OPEN(NINP,IOSTAT=IERR,FILE=SLFFILE,FORM='UNFORMATTED')
00111       CALL FNCT_CHECK(IERR,'OPEN '//TRIM(SLFFILE))
00112       ! READING NAME OF THE MESH
00113       CALL LIT(XB,RB,IB,MESH2%TITLE,TITLE_SIZE,'CH',NINP,'STD',ISTAT)
00114       ! SET THE DESCRIPTION  TO NO DESCRIPTION
00115       MESH2%DESCRIPTION = 'NO DESCRIPTION'//CHAR(0)
00116       ! GET THE NUMBER OF VARIABLES
00117       CALL LIT(XB,RB,IB,CB,2,'I ',NINP,'STD',ISTAT)
00118       IF(DEBUG) WRITE(LU,*) IB(1),IB(2)
00119       MESH2%NVAR = IB(1) + IB(2)
00120 !
00121       IF(LNG.EQ.1) WRITE(LU,*) '---INFORMATIONS SUR LES VARIABLES'
00122       IF(LNG.EQ.2) WRITE(LU,*) '---VARIABLES INFORMATIONS'
00123       IF(DEBUG.AND.(LNG.EQ.1)) WRITE(LU,*) 'NOMBRE DE VARIABLES :',
00124      &               MESH2%NVAR
00125       IF(DEBUG.AND.(LNG.EQ.2)) WRITE(LU,*) 'NUMBER OF VARIABLES :',
00126      &               MESH2%NVAR
00127 !
00128       IF(MESH2%NVAR.NE.0) THEN
00129         ALLOCATE(MESH2%NAMEVAR(MESH2%NVAR),STAT=IERR)
00130         CALL FNCT_CHECK(IERR,'ALLOCATE MESH2%NAMEVAR')
00131         ALLOCATE(MESH2%UNITVAR(MESH2%NVAR),STAT=IERR)
00132         CALL FNCT_CHECK(IERR,'ALLOCATE MESH2%UNITVAR')
00133         ! GET THE NAME AND UNIT OF EACH VARIABLE
00134         DO I=1,MESH2%NVAR
00135           CALL LIT(XB,RB,IB,VARI,32,'CH',NINP,'STD',ISTAT)
00136           MESH2%NAMEVAR(I) = VARI(1:16)
00137           MESH2%UNITVAR(I) = VARI(17:32)
00138           CALL BLANC2USCORE(MESH2%NAMEVAR(I),16)
00139           CALL BLANC2USCORE(MESH2%UNITVAR(I),16)
00140           IF(DEBUG.AND.(LNG.EQ.1)) WRITE(LU,*) 'NOM DE LA VARIABLE : ',
00141      &                  MESH2%NAMEVAR(I)
00142           IF(DEBUG.AND.(LNG.EQ.1)) WRITE(LU,*)'UNITE DE LA VARIABLE : ',
00143      &                  MESH2%UNITVAR(I)
00144           IF(DEBUG.AND.(LNG.EQ.2)) WRITE(LU,*) 'VARIABLE NAME: ',
00145      &                  MESH2%NAMEVAR(I)
00146           IF(DEBUG.AND.(LNG.EQ.2)) WRITE(LU,*) 'VARIABLE UNIT: ',
00147      &                  MESH2%UNITVAR(I)
00148         ENDDO
00149       ENDIF
00150       CALL LIT(XB,RB,MESH2%IB,CB,10,'I ',NINP,'STD',ISTAT)
00151 !
00152       ! GO BACK TO THE BEGINNING OF THE FILE
00153       CLOSE(NINP,IOSTAT=IERR)
00154       CALL FNCT_CHECK(IERR,'CLOSE '//TRIM(SLFFILE))
00155       OPEN(NINP,IOSTAT=IERR,FILE=SLFFILE,FORM='UNFORMATTED')
00156       CALL FNCT_CHECK(IERR,'OPEN '//TRIM(SLFFILE))
00157 !
00158       ! CANCELLING READGEO OUTPUT INFORMATIONS
00159       ! READING THE NUMBER ELEMENTS, POINT, ...
00160       CALL READGEO1(MESH2%NPOIN, MESH2%NELEM, MESH2%NPTFR,
00161      &              MESH2%NDP, MESH2%IB, NINP,IDUM)
00162       ! IF WE ARE IN 3D
00163       IF(MESH2%IB(7).GT.1) THEN
00164         MESH2%NDIM=3
00165       ELSE
00166         MESH2%NDIM=2
00167       ENDIF
00168       ! DEFINE THE TYPE OF ELEMENT
00169       IF(MESH2%NDIM.EQ.2) THEN
00170         IF(MESH2%NDP.EQ.3) MESH2%TYPE_ELEM = TYPE_TRIA3
00171         IF(MESH2%NDP.EQ.4) MESH2%TYPE_ELEM = TYPE_QUAD4
00172       ELSE
00173         IF(MESH2%NDP.EQ.4) MESH2%TYPE_ELEM = TYPE_TETRA4
00174         IF(MESH2%NDP.EQ.6) MESH2%TYPE_ELEM = TYPE_PRISM6
00175       ENDIF
00176       IF(MESH2%TYPE_ELEM.EQ.0) THEN
00177         IF(LNG.EQ.1) THEN
00178           WRITE(LU,*) 'TYPE D ELEMENT INCONNU'
00179           WRITE(LU,*) 'NOMBRE DE POINT PAR ELEMENT :',MESH2%NDP
00180           WRITE(LU,*) 'DIMENSION DU MAILLAGE :',MESH2%NDIM
00181         ENDIF
00182         IF(LNG.EQ.2) THEN
00183           WRITE(LU,*) 'UNKNOWN ELEMENT TYPE'
00184           WRITE(LU,*) 'NUMBER OF POINT PER ELEMENT:',MESH2%NDP
00185           WRITE(LU,*) 'DIMENSION OF THE MESH:',MESH2%NDIM
00186         ENDIF
00187         CALL PLANTE(-1)
00188       ENDIF
00189 !
00190       ! READING IPOBO AND IKLES
00191       ALLOCATE(MESH2%IKLES(MESH2%NELEM*MESH2%NDP),STAT=IERR)
00192       CALL FNCT_CHECK(IERR,'ALLOCATE MESH2%IKLES')
00193       ALLOCATE(MESH2%IPOBO(MESH2%NPOIN),STAT=IERR)
00194       CALL FNCT_CHECK(IERR,'ALLOCATE MESH%IPOBO')
00195 !
00196       CALL READGEO2(MESH2%NPOIN, MESH2%NELEM, MESH2%NPTFR,
00197      &              MESH2%NDP, MESH2%IKLES, MESH2%IPOBO,
00198      &              MESH2%IB, NINP)
00199       IF(DEBUG) WRITE(LU,*) 'NPTFR:',MESH2%NPTFR
00200       IF(DEBUG) WRITE(LU,*) 'NDIM:',MESH2%NDIM
00201       IF(DEBUG) WRITE(LU,*) 'NDP:',MESH2%NDP
00202       IF(DEBUG) WRITE(LU,*) 'IB:',MESH2%IB
00203 !
00204       ! READING COORDINATES AND KNOLG IF IN PARALLEL
00205       ALLOCATE(MESH2%X(MESH2%NPOIN),STAT=IERR)
00206       CALL FNCT_CHECK(IERR,'ALLOCATE MESH2%X')
00207       ALLOCATE(MESH2%Y(MESH2%NPOIN),STAT=IERR)
00208       CALL FNCT_CHECK(IERR,'ALLOCATE MESH2%Y')
00209       IF(MESH2%NDIM.EQ.3) THEN
00210         ALLOCATE(MESH2%Z(MESH2%NPOIN),STAT=IERR)
00211         CALL FNCT_CHECK(IERR,'ALLOCATE MESH2%Z')
00212       ENDIF
00213       IF( (MESH2%IB(8).NE.0) .OR. (MESH2%IB(9).NE.0) ) THEN
00214         ALLOCATE(MESH2%KNOLG(MESH2%NPOIN),STAT=IERR)
00215         CALL FNCT_CHECK(IERR,'ALLOCATE MESH2%KNOLG')
00216       ELSE
00217         ALLOCATE(MESH2%KNOLG(1),STAT=IERR)
00218         CALL FNCT_CHECK(IERR,'ALLOCATE MESH2%KNOLG')
00219       ENDIF
00220 !
00221       !READING THE COORDINATES
00222 
00223 !     PROJECTION
00224       IDUM=1
00225 !
00226       CALL READGEO3(MESH2%KNOLG,MESH2%X,MESH2%Y,MESH2%NPOIN,
00227      &              NINP,MESH2%IB,FFORMAT,IDUM,0.D0,0.D0)
00228       IF( (MESH2%IB(8).EQ.0) .AND. (MESH2%IB(9).EQ.0) ) THEN
00229         DEALLOCATE(MESH2%KNOLG)
00230       ENDIF
00231 
00232 !
00233       ! COMPLETING COORDINATES NAME AND UNIT
00234       ALLOCATE(MESH2%NAMECOO(MESH2%NDIM),STAT=IERR)
00235       CALL FNCT_CHECK(IERR,'ALLOCATE MESH2%NAMECOO')
00236       ALLOCATE(MESH2%UNITCOO(MESH2%NDIM),STAT=IERR)
00237       CALL FNCT_CHECK(IERR,'ALLOCATE MESH2%UNITCOO')
00238       MESH2%NAMECOO(1) = 'X'
00239       MESH2%UNITCOO(1) = 'M'
00240       MESH2%NAMECOO(2) = 'Y'
00241       MESH2%UNITCOO(2) = 'M'
00242       IF(MESH2%NDIM.EQ.3) THEN
00243         MESH2%NAMECOO(3) = 'Z'
00244         MESH2%UNITCOO(3) = 'M'
00245       ENDIF
00246       DO I=1,MESH2%NDIM
00247         CALL BLANC2USCORE(MESH2%NAMECOO(I),16)
00248         CALL BLANC2USCORE(MESH2%UNITCOO(I),16)
00249       ENDDO
00250 !
00251       IF(LNG.EQ.1) WRITE(LU,*) '---INFORMATIONS SUR LES RESUTATS'
00252       IF(LNG.EQ.2) WRITE(LU,*) '---RESULTS INFORMATIONS'
00253       ! WE DO A FIRST READ TO COUNT THE NUMBER OF TIMESTEPS
00254       MESH2%TIMESTEP = 0
00255       DO WHILE(.TRUE.)
00256         ! IF WE ARE AT THE END OF THE FILE WE GO TO HELL (666)
00257         ! CANNOT USE LIT BECAUSE LIT CALL PLANTE IF END
00258         READ(NINP,END=666) TIME
00259         MESH2%TIMESTEP = MESH2%TIMESTEP + 1
00260         DO I=1,MESH2%NVAR
00261           CALL LIT(XB,RB,IB,CB,1,RF,NINP,'STD',ISTAT)
00262         ENDDO
00263       ENDDO
00264 !
00265 666   IF(MESH2%TIMESTEP .NE. 0) THEN
00266         ! IF WE HAVE RESULTS WE GO BACK TO BEGINNING OF THE FILE
00267         CLOSE(NINP,IOSTAT=IERR)
00268         CALL FNCT_CHECK(IERR,'CLOSE '//TRIM(SLFFILE))
00269         OPEN(NINP,FILE=SLFFILE, FORM='UNFORMATTED', IOSTAT=IERR)
00270         CALL FNCT_CHECK(IERR,'OPEN '//TRIM(SLFFILE))
00271         ! ADVANCING IN THE FILE TO THE RESULTS
00272         CALL QUICKREAD(NINP)
00273         ! ALLOCATING RESULTS TABLES
00274         ALLOCATE(MESH2%TIMES(MESH2%TIMESTEP),STAT=IERR)
00275         CALL FNCT_CHECK(IERR,'ALLOCATE MESH2%TIMES')
00276         ALLOCATE(MESH2%RESULTS(MESH2%TIMESTEP,MESH2%NVAR,
00277      &                             MESH2%NPOIN),STAT=IERR)
00278         CALL FNCT_CHECK(IERR,'ALLOCATE MESH2%RESULTS')
00279         IF(DEBUG.AND.(LNG.EQ.1)) WRITE(LU,*)
00280      &            'NOMBRE DE PAS DE TEMPS:',MESH2%TIMESTEP
00281         IF(DEBUG.AND.(LNG.EQ.2)) WRITE(LU,*)
00282      &            'NUMBER OF TIME STEP:',MESH2%TIMESTEP
00283         ! THEN READ THE RESULTS FOR ALL VARIALBLES AND ALL TIMESTEPS
00284         ALLOCATE(TMP(MESH2%NPOIN),STAT=IERR)
00285         CALL FNCT_CHECK(IERR,'ALLOCATE TMP')
00286         ALLOCATE(TMP2(MESH2%NPOIN),STAT=IERR)
00287         CALL FNCT_CHECK(IERR,'ALLOCATE TMP')
00288         DO I=1,MESH2%TIMESTEP
00289           CALL LIT(MESH2%TIMES(I),RB,IB,CB,1,RF,NINP,'STD',ISTAT)
00290           IF(DEBUG.AND.(LNG.EQ.1)) WRITE(LU,*) '--POUR TEMPS : ',
00291      &                  REAL(MESH2%TIMES(I))
00292           IF(DEBUG.AND.(LNG.EQ.2)) WRITE(LU,*) '--FOR TIME: ',
00293      &                  REAL(MESH2%TIMES(I))
00294           DO J=1,MESH2%NVAR
00295             IF(DEBUG.AND.(LNG.EQ.1)) WRITE(LU,*) '-POUR VARIABLE : ',
00296      &             MESH2%NAMEVAR(J)
00297             IF(DEBUG.AND.(LNG.EQ.2)) WRITE(LU,*) '-FOR VARIABLE: ',
00298      &             MESH2%NAMEVAR(J)
00299             CALL LIT(TMP2,TMP,IB,CB,
00300      &               MESH2%NPOIN,
00301      &               RF,NINP,'STD',ISTAT)
00302             DO K=1,MESH2%NPOIN
00303               MESH2%RESULTS(I,J,K) = TMP2(K)
00304             ENDDO
00305           ENDDO
00306         ENDDO
00307         DEALLOCATE(TMP)
00308         DEALLOCATE(TMP2)
00309       ENDIF
00310       ! IF WE ARE IN 3D THE FIRST VARIABLE IS THE Z COORDINATES
00311       IF(MESH2%NDIM.EQ.3) THEN
00312         IF(DEBUG.AND.(LNG.EQ.1)) WRITE(LU,*) 'COPIE COORDONEES Z'
00313         IF(DEBUG.AND.(LNG.EQ.2)) WRITE(LU,*) 'COPY Z COORDINATES'
00314         DO I=1,MESH2%NPOIN
00315           MESH2%Z(I) = MESH2%RESULTS(1,1,I)
00316         ENDDO
00317       ENDIF
00318 !
00319       CLOSE(NINP,IOSTAT=IERR)
00320       CALL FNCT_CHECK(IERR,'CLOSE '//TRIM(SLFFILE))
00321 !
00322       IF(LNG.EQ.1) WRITE(LU,*)
00323      &       '---INFORMATIONS SUR LES CONDITIONS LIMITES'
00324       IF(LNG.EQ.2) WRITE(LU,*) '---BOUNDARY INFORMATIONS'
00325       IF(LIMFILE(1:1).EQ.' ') THEN
00326         IF(LNG.EQ.1) WRITE(LU,*) 'PAS DE FICHIER DE CONDITIONS LIMITES'
00327         IF(LNG.EQ.2) WRITE(LU,*) 'NO BOUNDARY FILE'
00328         MESH2%NPTFR = 0
00329       ELSE
00330         ! READING THE BOUNDARY LIMIT FILE
00331         CALL READ_LIM(LIMFILE)
00332       ENDIF
00333 !
00334 !-----------------------------------------------------------------------
00335 !
00336       WRITE(LU,*) '----------------------------------------------------'
00337       IF(LNG.EQ.1) WRITE(LU,*) '------FIN LECTURE DU FICHIER SERAFIN'
00338       IF(LNG.EQ.2) WRITE(LU,*) '------ENDING READING OF SERAFIN FILE'
00339       WRITE(LU,*) '----------------------------------------------------'
00340       END SUBROUTINE
00341 !                       *****************
00342                         SUBROUTINE WRITE_SERAFIN
00343 !                       *****************
00344      &(SLFFILE,LIMFILE)
00345 !
00346 !***********************************************************************
00347 ! STBTEL   V6P1                                   11/07/2011
00348 !***********************************************************************
00349 !
00350 !BRIEF    WRITE A FILE OF SERAFIN FORMAT WITH THE MESH OBJECT
00351 !+        INFORMATIONS
00352 !
00353 !HISTORY  Y.AUDOUIN (EDF)
00354 !+        11/07/2011
00355 !+        V6P1
00356 !+   CREATION OF THE FILE
00357 !
00358 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00359 !| SLFFILE        |-->| NAME OF THE SERAFIN FILE
00360 !| LIMFILE        |-->| NAME OF THE BOUNDARY FILE
00361 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00362 !
00363       USE DECLARATIONS_STBTEL
00364       USE BIEF
00365       USE CONV_LIM
00366 !
00367       IMPLICIT NONE
00368       ! LANGAE AND OUTPUT VALUE
00369       INTEGER LNG,LU
00370       COMMON/INFO/LNG,LU
00371 !
00372 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00373 !
00374       CHARACTER(LEN=MAXLENHARD) :: SLFFILE
00375       CHARACTER(LEN=MAXLENHARD) :: LIMFILE
00376 !
00377 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00378 !
00379       INTEGER :: I,J,K,IERR,ISTAT
00380       CHARACTER(LEN=SNAME_SIZE*2) ::VARI
00381       INTEGER :: IB(6)
00382       DOUBLE PRECISION :: XB(1)
00383       CHARACTER*1 :: CB
00384       CHARACTER*2 :: RF
00385       CHARACTER*80 :: TITLE
00386       DOUBLE PRECISION, ALLOCATABLE :: TMP(:)
00387 !
00388       WRITE(LU,*) '----------------------------------------------------'
00389       IF(LNG.EQ.1) WRITE(LU,*)'------DEBUT ECRITURE DU FICHIER SERAFIN'
00390       IF(LNG.EQ.2) WRITE(LU,*)'------BEGINNING WRITTING OF SERAFIN FILE'
00391       WRITE(LU,*) '----------------------------------------------------'
00392 !
00393 !-----------------------------------------------------------------------
00394 !
00395       ! IF THE OPTION DOUBLE PRECISION IS TRUE WE WRITE IN DOUBLE
00396       ! PRECISION SINGLE OTHERWISE
00397       IF(SERAFIN_DOUBLE) THEN
00398         RF='R8'
00399       ELSE
00400         RF='R4'
00401       ENDIF
00402       OPEN(NOUT,IOSTAT=IERR,FILE=SLFFILE,STATUS='NEW',
00403      &     FORM='UNFORMATTED')
00404       CALL FNCT_CHECK(IERR,'OPEN '//TRIM(SLFFILE))
00405       ! TITLE AND NUMBER OF VARIABLES
00406       TITLE = MESH2%TITLE
00407       CALL ECRI2(XB,IB,TITLE,80,'CH',NOUT,'STD',ISTAT)
00408       IF(LNG.EQ.1) WRITE(LU,*) '---INFORMATIONS SUR LES VARIABLES'
00409       IF(LNG.EQ.2) WRITE(LU,*) '---VARIABLES INFORMATIONS'
00410       IB(1) = MESH2%NVAR
00411       IB(2) = 0
00412       CALL ECRI2(XB,IB,CB,2,'I ',NOUT,'STD',ISTAT)
00413       ! NAME OF THE VARIABLES
00414       DO I=1,MESH2%NVAR
00415         VARI(1:16) = MESH2%NAMEVAR(I)
00416         VARI(17:32) = MESH2%UNITVAR(I)
00417         CALL ECRI2(XB,IB,VARI,32,'CH',NOUT,'STD',ISTAT)
00418       ENDDO
00419       ! GEO1 INFORMATIONS
00420       IF(LNG.EQ.1) WRITE(LU,*) '---INFORMATIONS SUR MAILLAGE'
00421       IF(LNG.EQ.2) WRITE(LU,*) '---MESH INFORMATIONS'
00422       CALL ECRI2(XB,MESH2%IB,CB,10,'I ',NOUT,'STD',ISTAT)
00423       IF(MESH2%IB(10) .EQ. 1) THEN
00424         IB(:) = 1
00425         CALL ECRI2(XB,IB,CB,6,'I ',NOUT,'STD',ISTAT)
00426       ENDIF
00427       IB(1) = MESH2%NELEM
00428       IB(2) = MESH2%NPOIN
00429       IB(3) = MESH2%NDP
00430       IB(4) = 1
00431       CALL ECRI2(XB,IB,CB,4,'I ',NOUT,'STD',ISTAT)
00432       ! IKLES AND IPOBO
00433       CALL ECRI2(XB,MESH2%IKLES,CB,MESH2%NELEM*MESH2%NDP,'I ',
00434      &           NOUT,'STD',ISTAT)
00435       IF(MESH2%IB(8).EQ.0 .AND. MESH2%IB(9).EQ.0) THEN
00436         CALL ECRI2(XB,MESH2%IPOBO,CB,MESH2%NPOIN,'I ',NOUT,'STD',
00437      &             ISTAT)
00438       ELSE
00439         CALL ECRI2(XB,MESH2%KNOLG,CB,MESH2%NPOIN,'I ',NOUT,'STD',
00440      &             ISTAT)
00441       ENDIF
00442       ! COORDONATES
00443       CALL ECRI2(MESH2%X,IB,CB,MESH2%NPOIN,RF,NOUT,'STD',ISTAT)
00444       CALL ECRI2(MESH2%Y,IB,CB,MESH2%NPOIN,RF,NOUT,'STD',ISTAT)
00445       ! RESULTS INFORMATIONS
00446       IF(LNG.EQ.1) WRITE(LU,*) '---INFORMATIONS SUR LES RESUTATS'
00447       IF(LNG.EQ.2) WRITE(LU,*) '---RESULTS INFORMATIONS'
00448       IF(MESH2%TIMESTEP.NE.0) THEN
00449         ALLOCATE(TMP(MESH2%NPOIN),STAT=IERR)
00450         CALL FNCT_CHECK(IERR,'ALLOCATE TMP')
00451         DO I=1,MESH2%TIMESTEP
00452           CALL ECRI2(MESH2%TIMES(I),IB,CB,1,RF,NOUT,'STD',ISTAT)
00453           DO J=1,MESH2%NVAR
00454             DO K=1,MESH2%NPOIN
00455               TMP(K) = MESH2%RESULTS(I,J,K)
00456             ENDDO
00457             CALL ECRI2(TMP,IB,CB,MESH2%NPOIN,
00458      &                  RF,NOUT,'STD',ISTAT)
00459           ENDDO
00460         ENDDO
00461         DEALLOCATE(TMP)
00462       ENDIF
00463 !
00464       CLOSE(NOUT,IOSTAT=IERR)
00465       CALL FNCT_CHECK(IERR,'CLOSE '//TRIM(SLFFILE))
00466       IF(LNG.EQ.1) WRITE(LU,*)
00467      &           '---INFORMATIONS SUR LES CONDITIONS LIMITES'
00468       IF(LNG.EQ.2) WRITE(LU,*) '---BOUNDARY INFORMATIONS'
00469       ! WRITTING THE BOUNFARY FILE
00470       IF(MESH2%NPTFR.EQ.0) THEN
00471         IF(LNG.EQ.1) WRITE(LU,*)
00472      &          'PAS D INFORMATIONS SUR LES CONDITIONS LIMITES'
00473         IF(LNG.EQ.2) WRITE(LU,*) 'NO BOUNDARY INFORMATIONS'
00474       ELSE
00475         CALL WRITE_LIM(LIMFILE)
00476       ENDIF
00477 !
00478 !-----------------------------------------------------------------------
00479 !
00480       WRITE(LU,*) '----------------------------------------------------'
00481       IF(LNG.EQ.1) WRITE(LU,*) '------FIN ECRITURE DU FICHIER SERAFIN'
00482       IF(LNG.EQ.2) WRITE(LU,*) '------ENDING WRITTING OF SERAFIN FILE'
00483       WRITE(LU,*) '----------------------------------------------------'
00484       END SUBROUTINE
00485 !                       *****************
00486                         SUBROUTINE QUICKREAD
00487 !                       *****************
00488      &(IDFILE)
00489 !
00490 !***********************************************************************
00491 ! STBTEL   V6P1                                   11/07/2011
00492 !***********************************************************************
00493 !
00494 !BRIEF    MAKE A QUICK READ OF THE SERAFIN FILE TO REACH THE RESULTS
00495 !
00496 !HISTORY  Y.AUDOUIN (EDF)
00497 !+        11/07/2011
00498 !+        V6P1
00499 !+   CREATION OF THE FILE
00500 !
00501 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00502 !| IDFILE        |-->| ID OF THE SERAFIN FILE
00503 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00504 !
00505       USE DECLARATIONS_STBTEL
00506       USE BIEF
00507 !
00508       IMPLICIT NONE
00509 !
00510 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00511 !
00512       INTEGER, INTENT(IN) :: IDFILE
00513 !
00514 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00515 !
00516       INTEGER :: I
00517       INTEGER :: IB(10)
00518       DOUBLE PRECISION XB(1)
00519       REAL :: RB(1)
00520       CHARACTER(LEN=1) :: CB
00521       INTEGER :: ISTAT
00522       CHARACTER*2 :: RF
00523 !
00524 !-----------------------------------------------------------------------
00525 !
00526       ! IF THE OPTION DOUBLE PRECISION IS TRUE WE WRITE IN DOUBLE
00527       ! PRECISION SINGLE OTHERWISE
00528       IF(SERAFIN_DOUBLE) THEN
00529         RF='R8'
00530       ELSE
00531         RF='R4'
00532       ENDIF
00533       ! TITLE
00534       CALL LIT(XB,RB,IB,CB,1,'CH',IDFILE,'STD',ISTAT)
00535       ! NUMBER OF VARIABLES
00536       CALL LIT(XB,RB,IB,CB,2,'I ',IDFILE,'STD',ISTAT)
00537       ! NAME AND UNIT
00538       DO I=1,IB(1)+IB(2)
00539         CALL LIT(XB,RB,IB,CB,1,'CH',IDFILE,'STD',ISTAT)
00540       ENDDO
00541       ! 10 INTEGERS
00542       CALL LIT(XB,RB,IB,CB,10,'I ',IDFILE,'STD',ISTAT)
00543       ! CASE WHERE DATE AND TIME ARE IN THE FILE
00544       IF(IB(10).EQ.1) CALL LIT(XB,RB,IB,CB,6,'I ',IDFILE,'STD',ISTAT)
00545       ! 4 INTEGERS
00546       CALL LIT(XB,RB,IB,CB,4,'I ',IDFILE,'STD',ISTAT)
00547       ! IKLES
00548       CALL LIT(XB,RB,IB,CB,1,'I ',IDFILE,'STD',ISTAT)
00549       ! IPOBO OR KNOLG
00550       CALL LIT(XB,RB,IB,CB,1,'I ',IDFILE,'STD',ISTAT)
00551       ! X AND Y
00552       CALL LIT(XB,RB,IB,CB,1,RF,IDFILE,'STD',ISTAT)
00553       CALL LIT(XB,RB,IB,CB,1,RF,IDFILE,'STD',ISTAT)
00554 !
00555 !-----------------------------------------------------------------------
00556 !
00557       END SUBROUTINE
00558       END MODULE

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