lecdon_postel3d.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\postel3d\lecdon_postel3d.f
00002 !
00063                         SUBROUTINE LECDON_POSTEL3D
00064 !                       **************************
00065 !
00066      &(MOTCAR,FILE_DESC,PATH,NCAR)
00067 !
00068 !***********************************************************************
00069 ! POSTEL3D VERSION 6.0   01/09/99   T. DENOT (LNH) 01 30 87 74 89
00070 ! FORTRAN90
00071 !***********************************************************************
00072 !
00073 ! SOUS-PROGRAMME APPELE PAR : HOMERE_POSTEL3D
00074 ! SOUS-PROGRAMME APPELES : DAMOC , LIT
00075 !
00076 !**********************************************************************
00077 !
00078       USE DECLARATIONS_TELEMAC
00079       USE DECLARATIONS_POSTEL3D
00080 !
00081       IMPLICIT NONE
00082       INTEGER LNG,LU
00083       COMMON/INFO/LNG,LU
00084 !
00085 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00086 !
00087       INTEGER, INTENT(IN)               :: NCAR
00088       CHARACTER(LEN=250), INTENT(IN)    :: PATH
00089       CHARACTER(LEN=144), INTENT(INOUT) :: FILE_DESC(4,4000)
00090       CHARACTER(LEN=144), INTENT(INOUT) :: MOTCAR(4000)
00091 !                                                 NMAX
00092 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00093 !
00094       CHARACTER(LEN=250) NOM_CAS,NOM_DIC
00095       CHARACTER*4 VTEL3D
00096       CHARACTER(LEN=24), PARAMETER :: CODE='POSTEL3D                '
00097 !
00098 !
00099 ! DECLARATION DES VARIABLES LUES DANS NPRE
00100 !
00101 !
00102 ! DECLARATION DES TABLEAUX POUR L'APPEL DE DAMOC
00103 ! NMAX  : NOMBRE MAXIMUM DE MOTS-CLES POUR CHAQUE TYPE (REEL,ENTIER...)
00104 !         DONT A BESOIN POSTEL3D
00105 !
00106       INTEGER NMAX
00107       PARAMETER (NMAX=4000)
00108 !
00109       INTEGER ADRESS(4,NMAX),DIMENS(4,NMAX)
00110       DOUBLE PRECISION   MOTREA(NMAX)
00111       INTEGER            MOTINT(NMAX) , ISTAT
00112       LOGICAL            MOTLOG(NMAX)
00113 !
00114       CHARACTER*72     MOTCLE(4,NMAX,2)
00115       INTEGER          TROUVE(4,NMAX)
00116       INTEGER      I(10),J,K
00117       LOGICAL DOC
00118 !
00119       DOUBLE PRECISION XB(2)
00120       REAL, ALLOCATABLE :: RB(:)
00121       INTEGER IB(2), ERR
00122       CHARACTER(LEN=1) CB
00123 !
00124 !***********************************************************************
00125 ! allocate a (simple) REAL vector
00126 !
00127       ALLOCATE(RB(50000),STAT=ERR)
00128       CALL CHECK_ALLOCATE(ERR,'LECDON_POSTEL3D:RB')
00129 !
00130 !***********************************************************************
00131 !
00132 !
00133 !-----------------------------------------------------------------------
00134 !
00135 !-----------------------------------------------------------------------
00136 !
00137 ! LECTURE DU FICHIER CAS
00138 !
00139       IF (LNG.EQ.1) WRITE(LU,21)
00140       IF (LNG.EQ.2) WRITE(LU,22)
00141 !
00142       DO K=1,NMAX
00143 !
00144 !    UN FICHIER NON DONNE PAR DAMOCLES SERA RECONNU PAR UN BLANC
00145 !    (IL N'EST PAS SUR QUE TOUS LES COMPILATEURS INITIALISENT AINSI)
00146 !
00147         MOTCAR(K)(1:1)=' '
00148 !
00149         DIMENS(1,K) = 0
00150         DIMENS(2,K) = 0
00151         DIMENS(3,K) = 0
00152         DIMENS(4,K) = 0
00153 !
00154       ENDDO
00155 !
00156 !     IMPRESSION DE LA DOC
00157       DOC = .FALSE.
00158 !
00159 !-----------------------------------------------------------------------
00160 !     OUVERTURE DES FICHIERS DICTIONNAIRE ET CAS
00161 !-----------------------------------------------------------------------
00162 !
00163       NOM_DIC='POSDICO'
00164       NOM_CAS='POSCAS'
00165       OPEN(2,FILE=NOM_DIC,FORM='FORMATTED',ACTION='READ')
00166       OPEN(3,FILE=NOM_CAS,FORM='FORMATTED',ACTION='READ')
00167 !
00168       CALL DAMOCLE( ADRESS , DIMENS , NMAX   , DOC     , LNG    , LU ,
00169      &              MOTINT , MOTREA , MOTLOG , MOTCAR  , MOTCLE ,
00170      &              TROUVE , 2      , 3      , .FALSE. , FILE_DESC )
00171 !
00172 !-----------------------------------------------------------------------
00173 !     FERMETURE DES FICHIERS DICTIONNAIRE ET CAS
00174 !-----------------------------------------------------------------------
00175 !
00176       CLOSE(2)
00177       CLOSE(3)
00178 !
00179 !     DECRYPTAGE DES CHAINES SUBMIT
00180 !
00181       CALL READ_SUBMIT(POS_FILES,100,CODE,FILE_DESC,NMAX)
00182 !
00183 !-----------------------------------------------------------------------
00184 !
00185 !     RETRIEVING FILES NUMBERS IN POSTEL-3D FORTRAN PARAMETERS
00186 !     AT THIS LEVEL LOGICAL UNITS ARE EQUAL TO THE FILE NUMBER
00187 !
00188       DO J=1,100
00189         IF(POS_FILES(J)%TELNAME.EQ.'POSPRE') THEN
00190 !         POSPRE=POS_FILES(J)%LU  (IS EQUIVALENT)
00191           POSPRE=J
00192         ELSEIF(POS_FILES(J)%TELNAME.EQ.'POSHOR') THEN
00193           POSHOR=J
00194         ELSEIF(POS_FILES(J)%TELNAME.EQ.'POSVER') THEN
00195           POSVER=J
00196         ELSEIF(POS_FILES(J)%TELNAME.EQ.'POSGEO') THEN
00197           POSGEO=J
00198         ENDIF
00199       ENDDO
00200 !
00201 !-----------------------------------------------------------------------
00202 !
00203 !     MOTS CLES LIES A TOUTES LES COUPES
00204 !
00205       NUPRSO = MAX(MOTINT(ADRESS(1,3)),1)
00206       PESOGR = MAX(MOTINT(ADRESS(1,4)),1)
00207 !
00208 !     MOTS CLES LIES DE TYPE CARACTERE
00209 !
00210       VTEL3D = MOTCAR(ADRESS(4,13))(1:4)
00211       BINPRE = MOTCAR(ADRESS(4,14))(1:3)
00212       BINCOU = MOTCAR(ADRESS(4,15))(1:3)
00213       BINGEO = MOTCAR(ADRESS(4,17))(1:3)
00214 !
00215 !     FORMATS EN DUR
00216 !
00217       POS_FILES(POSPRE)%FMT='SELAFIN '
00218       POS_FILES(POSHOR)%FMT='SELAFIN '
00219       POS_FILES(POSVER)%FMT='SELAFIN '
00220       POS_FILES(POSGEO)%FMT='SELAFIN '
00221 !
00222       POS_FILES(POSPRE)%NAME=MOTCAR( ADRESS(4, 3) )
00223       POS_FILES(POSHOR)%NAME=MOTCAR( ADRESS(4, 4) )
00224       POS_FILES(POSVER)%NAME=MOTCAR( ADRESS(4, 5) )
00225       POS_FILES(POSGEO)%NAME=MOTCAR( ADRESS(4,16) )
00226 !
00227 !-----------------------------------------------------------------------
00228 !
00229 ! LECTURE PARTIELLE DU FICHIER DE RESULTATS 3D
00230 ! CERTAINES DONNEES (NOMBRE DE POINTS,...) SONT INDISPENSABLES POUR
00231 ! CONSTRUIRE LES POINTEURS + COMPTAGE DU NOMBRE D'ENREGISTREMENTS
00232 !
00233       OPEN(POS_FILES(POSPRE)%LU,FILE=POS_FILES(POSPRE)%TELNAME,
00234      &     FORM='UNFORMATTED',ACTION='READ')
00235       REWIND POS_FILES(POSPRE)%LU
00236 !
00237       CALL LIT(XB,RB,IB,TITCAS,72,'CH',POS_FILES(POSPRE)%LU,
00238      &         BINPRE,ISTAT)
00239 !
00240       CALL LIT(XB,RB,IB,CB,2, 'I ',POS_FILES(POSPRE)%LU,BINPRE,ISTAT)
00241       NVA3 = IB(1)+IB(2)
00242 !
00243 !   LEC/ECR 3 : NOMS ET UNITES DES VARIABLES
00244 !
00245       IF(NVA3.GE.1) THEN
00246         DO K=1,NVA3
00247           CALL LIT(XB,RB,IB,TEXTLU(K),32,'CH',POS_FILES(POSPRE)%LU,
00248      &             BINPRE,ISTAT)
00249         ENDDO
00250       ENDIF
00251 !
00252 !
00253       CALL LIT(XB,RB,I,CB,10,'I ',POS_FILES(POSPRE)%LU,BINPRE,ISTAT)
00254 !
00255       NPLAN = I(7)
00256 !
00257       IF (I(6).EQ.1) THEN
00258       VARSUB=.TRUE.
00259       ELSE
00260       VARSUB=.FALSE.
00261       ENDIF
00262 !
00263       DO K = 1,5
00264         READ(POS_FILES(POSPRE)%LU)
00265       ENDDO
00266       NENRE = 0
00267 43    CONTINUE
00268 !th   +1 car il y a dt
00269       DO K = 1,NVA3+1
00270         READ(POS_FILES(POSPRE)%LU,ERR=48,END=48)
00271       ENDDO
00272 !
00273       IF (VARSUB) THEN
00274         DO K = 1,4
00275           READ(POS_FILES(POSPRE)%LU,ERR=48,END=48)
00276         ENDDO
00277       ENDIF
00278 !
00279       NENRE = NENRE + 1
00280       GOTO 43
00281 48    CONTINUE
00282 !
00283 !
00284 !-----------------------------------------------------------------------
00285 !
00286 ! MOTS CLES LIES AUX COUPES HORIZONTALES
00287 !
00288       NC2DH = MIN(MAX(MOTINT(ADRESS(1,1)),0),9)
00289 !
00290       IF(NC2DH.GE.1) THEN
00291         DO K=1,NC2DH
00292           NPLREF(K) = K-1
00293           IF (K.LE.DIMENS(1,5)) NPLREF(K) = MOTINT(ADRESS(1,5)+K-1)
00294 !th un controle que l'on peut pour l'instant enlever
00295 !th (on ne connait pas nplan actuellement
00296 !th          NPLREF(K) = MIN(MAX(NPLREF(K),0),NPLAN)
00297           HREF(K) = 0.D0
00298           IF (K.LE.DIMENS(2,1)) HREF(K) = MOTREA(ADRESS(2,1)+K-1)
00299         ENDDO
00300       ENDIF
00301 !
00302 ! MOTS CLES LIES AUX COUPES VERTICALES
00303 !
00304       NC2DV = MIN(MAX(MOTINT(ADRESS(1,2)),0),9)
00305 !
00306       IM = MOTINT(ADRESS(1,6))
00307       JM = NPLAN
00308 !
00309       IF(NC2DV.GE.1) THEN
00310         DO K=1,NC2DV
00311           NSEG(K) = MIN(DIMENS(2,2*K),DIMENS(2,2*K+1)) - 1
00312           IF (NSEG(K).LT.1) THEN
00313             IF (LNG.EQ.1) WRITE(LU,91) K
00314             IF (LNG.EQ.2) WRITE(LU,92) K
00315             CALL PLANTE(0)
00316           ENDIF
00317           DO J=0,NSEG(K)
00318             X2DV(J+1,K) = MOTREA(ADRESS(2,2*K  )+J)
00319             Y2DV(J+1,K) = MOTREA(ADRESS(2,2*K+1)+J)
00320           ENDDO
00321           DISTOR(K) = 1.D0
00322           IF (K.LE.DIMENS(2,20)) DISTOR(K) = MOTREA(ADRESS(2,20)+K-1)
00323           IM = MAX(IM,NSEG(K)+1)
00324         ENDDO !K
00325       ENDIF
00326 !
00327 ! ARRET EN CAS DE DEMANDE DE COUPES NULLE
00328 !
00329       IF (NC2DH+NC2DV.EQ.0) THEN
00330         IF (LNG.EQ.1) WRITE(LU,101)
00331         IF (LNG.EQ.2) WRITE(LU,102)
00332         CALL PLANTE(1)
00333         STOP
00334       ENDIF
00335 !
00336 !-----------------------------------------------------------------------
00337 !
00338 21    FORMAT(/,19X,'********************************************',/,
00339      &         19X,'*         LECTURE DES PARAMETRES           *',/,
00340      &         19X,'*           APPEL DE DAMOCLES              *',/,
00341      &         19X,'*     VERIFICATION DES DONNEES LUES        *',/,
00342      &         19X,'*           SUR LE FICHIER CAS             *',/,
00343      &         19X,'********************************************',/)
00344 22    FORMAT(/,19X,'********************************************',/,
00345      &         19X,'*       READING OF THE PARAMETERS          *',/,
00346      &         19X,'*           CALLING DAMOCLES               *',/,
00347      &         19X,'*          CHECKING READ DATA              *',/,
00348      &         19X,'*         ON THE STEERING FILE             *',/,
00349      &         19X,'********************************************',/)
00350 !
00351 !-----------------------------------------------------------------------
00352 !
00353 91    FORMAT('LA COUPE VERTICALE',I2,' EST MAL DEFINIE :',/,
00354      &       'IL FAUT AU MOINS 2 ABSCISSES ET 2 ORDONNEES')
00355 92    FORMAT('VERTICAL CROSS SECTION',I2,' IS NOT WELL DEFINED :',/,
00356      &       'YOU NEED AT LEAST 2 ABSCISSAE AND 2 ORDONATES')
00357 !
00358 101   FORMAT('VOUS N''AVEZ DEMANDE AUCUNE COUPE HORIZONTALE',/,
00359      &       'NI AUCUNE COUPE VERTICALE, POSTEL3D N''A RIEN A FAIRE')
00360 102   FORMAT('YOU HAVE ASKED NO HORIZONTAL CROSS SECTION AND',/,
00361      &       'NO VERTICAL CROSS SECTION, POSTEL3D HAS NOTHING TO DO')
00362 !
00363 !111   FORMAT(' NOMBRE D''ENREGISTREMENTS    : ',I8,///,
00364 !     &       ' MAILLAGE 2D',/,
00365 !     &       ' -----------',//,
00366 !     &       ' NOMBRE DE POINTS 2D         : ',I8,/,
00367 !     &       ' NOMBRE D''ELEMENTS 2D        : ',I8,/,
00368 !     &       ' NOMBRE DE POINTS DE BORD 2D : ',I8,///,
00369 !     &       ' MAILLAGE 3D',/,
00370 !     &       ' -----------',//,
00371 !     &       ' NOMBRE DE POINTS 3D         : ',I8,/,
00372 !     &       ' NOMBRE D''ELEMENTS 3D        : ',I8,/,
00373 !     &       ' NOMBRE DE PLANS             : ',I8,//)
00374 !112   FORMAT(' NUMBER OF RECORDS           : ',I8,///,
00375 !     &       ' 2D MESH',/,
00376 !     &       ' -------',//,
00377 !     &       ' NUMBER OF 2D NODES          : ',I8,/,
00378 !     &       ' NUMBER OF 2D ELEMENTS       : ',I8,/,
00379 !     &       ' NUMBER OF 2D BOUNDARY NODES : ',I8,///,
00380 !     &       ' 3D MESH',/,
00381 !     &       ' -------',//,
00382 !     &       ' NUMBER OF 3D NODES          : ',I8,/,
00383 !     &       ' NUMBER OF 3D ELEMENTS       : ',I8,/,
00384 !     &       ' NUMBER OF LEVELS            : ',I8,//)
00385 !
00386       DEALLOCATE (RB)
00387 !
00388       RETURN
00389       END SUBROUTINE

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