conv_lim.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\stbtel\conv_lim.f
00002 !
00034       MODULE CONV_LIM
00035       CONTAINS
00036 !                       *****************
00037                         SUBROUTINE READ_LIM
00038 !                       *****************
00039      &(LIMFILE)
00040 !***********************************************************************
00041 ! PROGICIEL : STBTEL  6.0           19/05/11    Y. AUDOUIN
00042 !***********************************************************************
00043 !
00044 !     FONCTION  : READ MED FILE AND FILL MESH_OBJ
00045 !
00046 !-----------------------------------------------------------------------
00047 !                             ARGUMENTS
00048 ! .________________.____.______________________________________________
00049 ! |      NOM       |MODE|                   ROLE
00050 ! |________________|____|______________________________________________
00051 ! | INFILE         |--> | NAME OF THE BOUNDARY FILE
00052 ! |________________|____|______________________________________________
00053 ! MODE : -->(DONNEE NON MODIFIEE), <--(RESULTAT), <-->(DONNEE MODIFIEE)
00054 !-----------------------------------------------------------------------
00055 ! APPELE PAR : CONVERTER
00056 ! APPEL DE :
00057 !***********************************************************************
00058       USE DECLARATIONS_STBTEL
00059 !
00060       IMPLICIT NONE
00061       ! LANGAE AND OUTPUT VALUE
00062       INTEGER LNG,LU
00063       COMMON/INFO/LNG,LU
00064 !
00065       CHARACTER(LEN=MAXLENHARD),INTENT(IN) :: LIMFILE
00066 !
00067       INTEGER :: I
00068       INTEGER :: IERR,IPTFR,IDUM,INBOR,IHBOR,IUBOR,IVBOR
00069       INTEGER :: VALUES(MAXFAM)
00070       DOUBLE PRECISION :: DDUM
00071 !
00072       WRITE(LU,*) '----------------------------------------------------'
00073       IF(LNG.EQ.1)WRITE(LU,*)
00074      &        '------DEBUT LECTURE FICHIER DES CONDITIONS LIMITES'
00075       IF(LNG.EQ.2)WRITE(LU,*) '------BEGINNING READING OF BOUNDARY FILE'
00076       WRITE(LU,*) '----------------------------------------------------'
00077 !
00078 !-----------------------------------------------------------------------
00079 !
00080       DDUM=0.0
00081       IDUM=0
00082       IF(DEBUG) WRITE(LU,*) 'LIMFILE : ',TRIM(LIMFILE)
00083       ! READING THE BOUNDARY LIMIT FILE
00084       OPEN(NLIM,IOSTAT=IERR,FILE=LIMFILE,FORM='FORMATTED')
00085       CALL FNCT_CHECK(IERR,'OPEN '//TRIM(LIMFILE))
00086       ! TEST IF NPTFR IS KNOWN (NOT WHEN COMMING FROM MED)
00087       IF(MESH2%NPTFR.EQ.0) THEN
00088         IF(DEBUG.AND.(LNG.EQ.1)) WRITE(LU,*) 'CALCUL DE NPTFR'
00089         IF(DEBUG.AND.(LNG.EQ.2)) WRITE(LU,*) 'CALCULING NPTFR'
00090         DO WHILE(.TRUE.)
00091         ! COUNT THE NUMBER OF LINE IN THE FILE
00092         READ(NLIM,*,END=666) IDUM, IDUM,IDUM,
00093      &             DDUM, DDUM, DDUM,
00094      &             DDUM,IDUM,DDUM,DDUM,DDUM,
00095      &             IDUM,IDUM
00096         MESH2%NPTFR = MESH2%NPTFR + 1
00097         ENDDO
00098         ! REWIND OF THE FILE
00099 666     CLOSE(NLIM,IOSTAT=IERR)
00100         CALL FNCT_CHECK(IERR,'CLOSE '//TRIM(LIMFILE))
00101         OPEN(NLIM,IOSTAT=IERR,FILE=LIMFILE,FORM='FORMATTED')
00102         CALL FNCT_CHECK(IERR,'OPEN '//TRIM(LIMFILE))
00103       ENDIF
00104 
00105       ALLOCATE(MESH2%LIHBOR(MESH2%NPTFR),STAT=IERR)
00106       CALL FNCT_CHECK(IERR,'ALLOCATE NESH2%LIHBOR')
00107       ALLOCATE(MESH2%NBOR(MESH2%NPTFR),STAT=IERR)
00108       CALL FNCT_CHECK(IERR,'ALLOCATE MESH2%NBOR')
00109       IF(DEBUG.AND.(LNG.EQ.1)) WRITE(LU,*) 'LECTURE DU FICHIER'
00110       IF(DEBUG.AND.(LNG.EQ.2)) WRITE(LU,*) 'READING BOUNDARY FILE'
00111       ! BUILDING THE BOUNDARY FAMILIES
00112       VALUES(:) = 0
00113       ! WE CONSIDER THAT IF WE READ THE BOUNDARY FILE
00114       ! WE REMOVE THE FAMILIES IN THE MED FILE
00115       IF(MESH2%NFAM.NE.0) THEN
00116         DEALLOCATE(MESH2%IDFAM)
00117         DEALLOCATE(MESH2%NAMEFAM)
00118         DEALLOCATE(MESH2%VALFAM)
00119         MESH2%NFAM = 0
00120       ENDIF
00121       DO I=1,MESH2%NPTFR
00122         READ(NLIM,*) IHBOR, IUBOR, IVBOR,
00123      &             DDUM, DDUM, DDUM,
00124      &             DDUM,IDUM,DDUM,DDUM,DDUM,
00125      &             INBOR,IPTFR
00126         IF(IPTFR.NE.I) THEN
00127           WRITE(LU,*) 'WARNING : THERE IS AN ERROR AT LINE ',I,
00128      &                'OF THE BOUNDARY FILES I'
00129           WRITE(LU,*) 'THE LAST COLUMN NUMBER',
00130      &                ' SHOULD BE ',I,'AND IT IS ',IPTFR
00131         ENDIF
00132         MESH2%NBOR(I) = INBOR
00133         MESH2%LIHBOR(I) = IHBOR*100+IUBOR*10+IVBOR
00134         IF(COUNT(VALUES.EQ.MESH2%LIHBOR(I)).EQ.0) THEN
00135           MESH2%NFAM = MESH2%NFAM + 1
00136           VALUES(MESH2%NFAM) = MESH2%LIHBOR(I)
00137         ENDIF
00138       ENDDO
00139       IF(DEBUG) WRITE(LU,*) 'NFAM :',MESH2%NFAM
00140       IF(DEBUG.AND.(LNG.EQ.1)) WRITE(LU,*) 'CONSTRUCTION DES FAMILLES'
00141       IF(DEBUG.AND.(LNG.EQ.2)) WRITE(LU,*) 'CONSTRUCTING FAMILIES'
00142       !FILLING MED VARIABLES
00143       ALLOCATE(MESH2%IDFAM(MESH2%NFAM),STAT=IERR)
00144       CALL FNCT_CHECK(IERR,'ALLOCATE MESH2%IDFAM')
00145       ALLOCATE(MESH2%NAMEFAM(MESH2%NFAM),STAT=IERR)
00146       CALL FNCT_CHECK(IERR,'ALLOCATE MESH2%NAMEFAM')
00147       ALLOCATE(MESH2%VALFAM(MESH2%NFAM),STAT=IERR)
00148       CALL FNCT_CHECK(IERR,'ALLOCATE MESH2%VALFAM')
00149       ALLOCATE(MESH2%NGROUPFAM(MESH2%NFAM),STAT=IERR)
00150       CALL FNCT_CHECK(IERR,'ALLOCATE MESH2%VALFAM')
00151       ALLOCATE(MESH2%GROUPFAM(MESH2%NFAM,1),STAT=IERR)
00152       CALL FNCT_CHECK(IERR,'ALLOCATE MESH2%VALFAM')
00153       DO I=1,MESH2%NFAM
00154         MESH2%IDFAM(I) = I
00155         MESH2%NAMEFAM(I) = 'FAM_CONLIM_'//TRIM(I2CHAR(VALUES(I)))
00156         MESH2%VALFAM(I) = VALUES(I)
00157         MESH2%NGROUPFAM(I) = 1
00158         MESH2%GROUPFAM(I,1) = 'CONLIM_'//TRIM(I2CHAR(VALUES(I)))
00159         IF(DEBUG) WRITE(LU,*) 'NAME  : ',MESH2%NAMEFAM(I)
00160         IF(DEBUG) WRITE(LU,*) 'ID    : ',MESH2%IDFAM(I)
00161         IF(DEBUG) WRITE(LU,*) 'VALUE : ',MESH2%VALFAM(I)
00162         IF(DEBUG) WRITE(LU,*) 'NGROUP : ',MESH2%NGROUPFAM(I)
00163         IF(DEBUG) WRITE(LU,*) 'VALUE : ',MESH2%GROUPFAM(I,1)
00164 
00165       ENDDO
00166       CLOSE(NLIM,IOSTAT=IERR)
00167       CALL FNCT_CHECK(IERR,'CLOSE '//TRIM(LIMFILE))
00168 !
00169 !-----------------------------------------------------------------------
00170 !
00171       WRITE(LU,*) '----------------------------------------------------'
00172       IF(LNG.EQ.1) WRITE(LU,*) '------FIN LECTURE DU FICHIER DES ',
00173      &              'CONDITIONS LIMITES'
00174       IF(LNG.EQ.2) WRITE(LU,*) '------ENDING READING OF BOUNDARY FILE'
00175       WRITE(LU,*) '----------------------------------------------------'
00176       END SUBROUTINE
00177 
00178 !                       *****************
00179                         SUBROUTINE WRITE_LIM
00180 !                       *****************
00181      &(LIMFILE)
00182 !***********************************************************************
00183 ! PROGICIEL : STBTEL  6.0           19/05/11    Y. AUDOUIN
00184 !***********************************************************************
00185 !
00186 !     FONCTION  : READ MED FILE AND FILL MESH_OBJ
00187 !
00188 !-----------------------------------------------------------------------
00189 !                             ARGUMENTS
00190 ! .________________.____.______________________________________________
00191 ! |      NOM       |MODE|                   ROLE
00192 ! |________________|____|______________________________________________
00193 ! | INFILE         |--> | COORDONNEES DES POINTS DU MAILLAGE
00194 ! |________________|____|______________________________________________
00195 ! MODE : -->(DONNEE NON MODIFIEE), <--(RESULTAT), <-->(DONNEE MODIFIEE)
00196 !-----------------------------------------------------------------------
00197 ! APPELE PAR : CONVERTER
00198 ! APPEL DE :
00199 !***********************************************************************
00200       USE DECLARATIONS_STBTEL
00201 !
00202       IMPLICIT NONE
00203       ! LANGAE AND OUTPUT VALUE
00204       INTEGER LNG,LU
00205       COMMON/INFO/LNG,LU
00206 !
00207       CHARACTER(LEN=MAXLENHARD),INTENT(IN) :: LIMFILE
00208 !
00209       INTEGER :: IDUM,I,IERR,IHBOR,IUBOR,IVBOR
00210       DOUBLE PRECISION :: DDUM
00211 !
00212       WRITE(LU,*) '----------------------------------------------------'
00213       IF(LNG.EQ.1) WRITE(LU,*)
00214      &             '------BEGINNING WRITTING OF BOUNDARY FILE'
00215       IF(LNG.EQ.2) WRITE(LU,*)
00216      &           '------DEBUT LECTURE DU FICHIER DES CONDITIONS LIMITES'
00217       WRITE(LU,*) '----------------------------------------------------'
00218 !
00219 !-----------------------------------------------------------------------
00220 !
00221       OPEN(NBND,IOSTAT=IERR,FILE=LIMFILE,STATUS='NEW',FORM='FORMATTED')
00222       CALL FNCT_CHECK(IERR,'OPEN '//TRIM(LIMFILE))
00223       IDUM = 0
00224       DDUM = 0.0
00225       DO I=1,MESH2%NPTFR
00226         IHBOR = MESH2%LIHBOR(I)/100
00227         IUBOR = (MESH2%LIHBOR(I) - 100*IHBOR)/10
00228         IVBOR = MESH2%LIHBOR(I) - 100*IHBOR - 10*IUBOR
00229         WRITE(NBND,*)
00230      &              IHBOR, IUBOR, IVBOR,
00231      &              DDUM, DDUM, DDUM,
00232      &              DDUM, IHBOR, DDUM, DDUM, DDUM,
00233      &              MESH2%NBOR(I), I
00234       ENDDO
00235       CLOSE(NLIM,IOSTAT=IERR)
00236       CALL FNCT_CHECK(IERR,'CLOSE '//TRIM(LIMFILE))
00237 !
00238 !-----------------------------------------------------------------------
00239 !
00240       WRITE(LU,*) '----------------------------------------------------'
00241       IF(LNG.EQ.1) WRITE(LU,*)
00242      &    '------FIN LECTURE DU FICHIER DES CONDITIONS LIMITES'
00243       IF(LNG.EQ.2) WRITE(LU,*) '------ENDING WRITTING OF BOUNDARY FILE'
00244       WRITE(LU,*) '----------------------------------------------------'
00245       END SUBROUTINE
00246       END MODULE

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