presel.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\stbtel\presel.f
00002 !
00023                         SUBROUTINE PRESEL
00024 !                       *****************
00025 !
00026      &(IKLE,TRAV1,NELEM,NELMAX,NDP,TEXTE,NBFOND,SORLEO,COLOR,
00027      & NSFOND,NVARIN,NVAROU,MAILLE)
00028 !
00029 !***********************************************************************
00030 ! PROGICIEL : STBTEL V5.2    07/12/88    J-M HERVOUET (LNH) 30 87 80 18
00031 !                            19/02/93    J-M JANIN    (LNH) 30 87 72 84
00032 !                                        A   WATRIN
00033 !***********************************************************************
00034 !
00035 !  FONCTION  :  PREPARATION DE DONNEES AVANT L'APPEL DE FMTSEL
00036 !
00037 !-----------------------------------------------------------------------
00038 !                             ARGUMENTS
00039 ! .________________.____.______________________________________________
00040 ! |      NOM       |MODE|                   ROLE
00041 ! |________________|____|______________________________________________
00042 ! |________________|____|______________________________________________
00043 ! MODE : -->(DONNEE NON MODIFIEE), <--(RESULTAT), <-->(DONNEE MODIFIEE)
00044 !-----------------------------------------------------------------------
00045 !
00046 ! APPELE PAR : PREDON
00047 ! APPEL DE : -
00048 !
00049 !***********************************************************************
00050 !
00051       IMPLICIT NONE
00052       INTEGER LNG,LU
00053       COMMON/INFO/LNG,LU
00054 !
00055       INTEGER NDP,NELEM,NELMAX,NBFOND,NSFOND,NVARIN,NVAROU
00056       INTEGER TRAV1(NELEM,NDP),IKLE(NELMAX,NDP),I,IDP,IELEM
00057 !
00058       CHARACTER*32 TEXTE(26)
00059       CHARACTER*9 MAILLE
00060 !
00061       LOGICAL SORLEO(26),COLOR
00062 !
00063 !-----------------------------------------------------------------------
00064 !
00065 !  IKLE EST REFAIT EN FONCTION DU NOMBRE DEFINITIF D'ELEMENTS
00066 !  LE RESULTAT EST MIS DANS TRAV1.
00067 !
00068       DO IELEM = 1 , NELEM
00069         DO IDP = 1 , NDP
00070           TRAV1(IELEM,IDP) = IKLE(IELEM,IDP)
00071         ENDDO
00072       ENDDO
00073 !
00074 !-----------------------------------------------------------------------
00075 !
00076 !  NOMS DES VARIABLES QUI SERONT DANS LE FICHIER DE GEOMETRIE
00077 !  TABLEAUX INDIQUANT SI ELLES SERONT ECRITES.
00078 !
00079       DO I = 1 , 26
00080         SORLEO(I) = .FALSE.
00081       ENDDO
00082 !
00083       NVAROU = NVARIN
00084       IF (NVAROU.GT.0) THEN
00085         DO I = 1 , NVAROU
00086           SORLEO(I) = .TRUE.
00087         ENDDO
00088       ENDIF
00089 !
00090 !-----------------------------------------------------------------------
00091 !
00092 !  RAJOUT DU FOND PUIS DE LA COULEUR DES NOEUDS PUIS D'UNE VARIABLE
00093 !  BIDON SI NECESSAIRE DANS LES VARIABLES DE SORTIE
00094 !
00095       IF (NBFOND.GT.0.AND.NSFOND.EQ.0.AND.NVAROU.LT.26) THEN
00096         NVAROU = NVAROU + 1
00097         SORLEO(NVAROU) = .TRUE.
00098         IF (LNG.EQ.1) TEXTE(NVAROU)='FOND                            '
00099         IF (LNG.EQ.2) TEXTE(NVAROU)='BOTTOM                          '
00100         NSFOND = NVAROU
00101       ELSEIF (NBFOND.EQ.0) THEN
00102         NSFOND = 0
00103       ENDIF
00104 !
00105       IF (COLOR) THEN
00106         IF (NVAROU.LT.26) THEN
00107           NVAROU = NVAROU + 1
00108           SORLEO(NVAROU) = .TRUE.
00109           TEXTE(NVAROU) = 'COULEUR                         '
00110         ELSE
00111           COLOR = .FALSE.
00112         ENDIF
00113       ENDIF
00114 !
00115       IF(NVAROU.EQ.0) THEN
00116         SORLEO(1) = .TRUE.
00117         IF(MAILLE.NE.'ADCIRC') THEN
00118           TEXTE(1) = 'MAILLAGE                        '
00119         ELSE
00120           IF (LNG.EQ.1) TEXTE(1)='FOND                            '
00121           IF (LNG.EQ.2) TEXTE(1)='BOTTOM                          '
00122         ENDIF
00123       ENDIF
00124 !
00125 !-----------------------------------------------------------------------
00126 !
00127       RETURN
00128       END

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