dynami.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\stbtel\dynami.f
00002 !
00024                         SUBROUTINE DYNAMI
00025 !                       *****************
00026 !
00027      &(NPTFR,NBOR,LIHBOR,LIUBOR,LIVBOR,LITBOR,NCOLFR,MAILLE,NLIM)
00028 !
00029 !***********************************************************************
00030 ! STBTEL VERSION        6.0                J-C GALLAND (LNH) 30 87 78 13
00031 !                                          J-M JANIN   (LNH) 30 87 72 84
00032 !                                          P LANG      (LHF)
00033 ! ORIGINE   : TELEMAC
00034 !***********************************************************************
00035 !
00036 !  FONCTION : ECRITURE DU FICHIER DYNAM DE TELEMAC
00037 !             POUR TOUTE MODIFICATION DES CL VOIR DANS LE SPGM STBTEL
00038 !
00039 !-----------------------------------------------------------------------
00040 !                             ARGUMENTS
00041 ! .________________.____.______________________________________________
00042 ! I      NOM       IMODEI                   ROLE
00043 ! I________________I____I______________________________________________
00044 ! |   NPTFR        | -->| NOMBRE DE POINTS FRONTIERE
00045 ! |   NBOR         | -->| TABLEAU DES POINTS DE BORD
00046 ! |   NCOLFR       | -->| TABLEAU DES COULEURS DES POINTS FRONTIERES
00047 ! |   MAILLE       | -->| NOM DU MAILLEUR
00048 ! |________________|____|______________________________________________
00049 ! | COMMON:        |    |
00050 ! |  GEO:          |    |
00051 ! |    MESH        | -->| TYPE DES ELEMENTS DU MAILLAGE
00052 ! |    NDP         | -->| NOMBRE DE NOEUDS PAR ELEMENTS
00053 ! |    NPOIN       | -->| NOMBRE TOTAL DE NOEUDS DU MAILLAGE
00054 ! |    NELEM       | -->| NOMBRE TOTAL D'ELEMENTS DU MAILLAGE
00055 ! |    NPMAX       | -->| DIMENSION EFFECTIVE DES TABLEAUX X ET Y
00056 ! |                |    | (NPMAX = NPOIN + 0.1*NELEM)
00057 ! |    NELMAX      | -->| DIMENSION EFFECTIVE DES TABLEAUX CONCERNANT
00058 ! |                |    | LES ELEMENTS (NELMAX = NELEM + 0.2*NELEM)
00059 ! |________________|____|______________________________________________
00060 ! MODE : -->(DONNEE NON MODIFIEE), <--(RESULTAT), <-->(DONNEE MODIFIEE)
00061 !----------------------------------------------------------------------
00062 ! APPELE PAR : STBTEL
00063 ! APPEL DE : -
00064 !***********************************************************************
00065 !
00066       IMPLICIT NONE
00067       INTEGER LNG,LU
00068       COMMON/INFO/LNG,LU
00069 !
00070       INTEGER ILOG , IADH , IENT , IENTU , IINC , ISORT
00071       INTEGER NLIM , NPTFR
00072       INTEGER NELMAX , NELEM , NPOIN , MESH , NDP , NPMAX , J
00073       INTEGER NBOR(*) , NCOLFR(*)
00074       INTEGER LIHBOR(*) , LIUBOR(*) ,LIVBOR(*) ,LITBOR(*)
00075 !
00076       DOUBLE PRECISION HBOR , UBOR , VBOR , AUBOR , TBOR , ATBOR ,BTBOR
00077 !
00078       CHARACTER*9  MAILLE
00079 !
00080       COMMON/GEO/ MESH , NDP , NPOIN , NELEM , NPMAX , NELMAX
00081 !
00082 !***********************************************************************
00083 !
00084       ILOG = 2
00085       IADH = 0
00086       IENT = 5
00087       IENTU= 6
00088       ISORT= 4
00089       IINC = 1
00090 !
00091       REWIND NLIM
00092 !
00093       DO J =1,NPTFR
00094 !
00095 ! PAR DEFAUT, ON SUPPOSE QUE LE POINT EST UN POINT FRONTIERE SOLIDE
00096 ! SANS FROTTEMENT. LA COULEUR 11, STANDARD POUR SUPERTAB, DONNE CE
00097 ! TYPE DE CARACTERISTIQUE.
00098 !
00099         LIHBOR(J)=ILOG
00100         LIUBOR(J)=ILOG
00101         LIVBOR(J)=ILOG
00102         LITBOR(J)=ILOG
00103 !
00104         IF(NCOLFR(J).EQ.1) THEN
00105 !
00106 ! H IMPOSEE , U ET V LIBRES
00107 !
00108           LIHBOR(J)=IENT
00109           LIUBOR(J)=ISORT
00110           LIVBOR(J)=ISORT
00111           LITBOR(J)=ISORT
00112 !
00113         ELSE IF (NCOLFR(J).EQ.2) THEN
00114 !
00115 !  H  IMPOSEE , DEBIT IMPOSE
00116 !
00117           LIHBOR(J)=IENT
00118           LIUBOR(J)=IENT
00119           LIVBOR(J)=IENT
00120           LITBOR(J)=IENT
00121 !
00122         ELSE IF (NCOLFR(J).EQ.3) THEN
00123 !
00124 !  H , U ET V IMPOSEES
00125 !
00126           LIHBOR(J)=IENT
00127           LIUBOR(J)=IENTU
00128           LIVBOR(J)=IENTU
00129           LITBOR(J)=IENT
00130 !
00131         ELSE IF (NCOLFR(J).EQ.4) THEN
00132 !
00133 ! H IMPOSEE , U LIBRE , V NULLE
00134 !
00135           LIHBOR(J)=IENT
00136           LIUBOR(J)=ISORT
00137           LIVBOR(J)=IADH
00138           LITBOR(J)=ISORT
00139 !
00140         ELSE IF (NCOLFR(J).EQ.5) THEN
00141 !
00142 !  CONDITION D'ONDE INCIDENTE
00143 !
00144           LIHBOR(J)=IINC
00145           LIUBOR(J)=IINC
00146           LIVBOR(J)=IINC
00147           LITBOR(J)=ISORT
00148 !
00149         ELSE IF (NCOLFR(J).EQ.7) THEN
00150 !
00151 ! H IMPOSEE , U NULLE , V LIBRE
00152 !
00153           LIHBOR(J)=IENT
00154           LIUBOR(J)=IADH
00155           LIVBOR(J)=ISORT
00156           LITBOR(J)=ISORT
00157 !
00158         ELSE IF (NCOLFR(J).EQ.8) THEN
00159 !
00160 ! H LIBRE , U ET V IMPOSEES
00161 !
00162           LIHBOR(J)=ISORT
00163           LIUBOR(J)=IENT
00164           LIVBOR(J)=IENT
00165           LITBOR(J)=IENT
00166 !
00167         ELSE IF (NCOLFR(J).EQ.9) THEN
00168 !
00169 !  H LIBRE , U ET V IMPOSEES
00170 !
00171           LIHBOR(J)=ISORT
00172           LIUBOR(J)=IENTU
00173           LIVBOR(J)=IENTU
00174           LITBOR(J)=IENT
00175 !
00176         ELSE IF (NCOLFR(J).EQ.12) THEN
00177 !
00178 ! H LIBRE , U IMPOSEE , V NULLE
00179 !
00180           LIHBOR(J)=ISORT
00181           LIUBOR(J)=IENT
00182           LIVBOR(J)=IADH
00183           LITBOR(J)=IENT
00184 !
00185         ELSE IF (NCOLFR(J).EQ.13) THEN
00186 !
00187 ! FRONTIERE SOLIDE AVEC V NULLE
00188 !
00189           LIHBOR(J)=ILOG
00190           LIUBOR(J)=ILOG
00191           LIVBOR(J)=IADH
00192           LITBOR(J)=ILOG
00193 !
00194         ELSE IF (NCOLFR(J).EQ.14) THEN
00195 !
00196 ! FRONTIERE SOLIDE AVEC U NULLE
00197 !
00198           LIHBOR(J)=ILOG
00199           LIUBOR(J)=IADH
00200           LIVBOR(J)=ILOG
00201           LITBOR(J)=ILOG
00202 !
00203         ELSE IF (NCOLFR(J).EQ.15) THEN
00204 !
00205 ! H LIBRE , U NULLE , V IMPOSEE
00206 !
00207           LIHBOR(J)=ISORT
00208           LIUBOR(J)=IADH
00209           LIVBOR(J)=IENT
00210           LITBOR(J)=IENT
00211 !
00212         ENDIF
00213 !
00214       ENDDO
00215 !
00216       DO J=1,NPTFR
00217 !
00218         HBOR = 0.D0
00219         UBOR = 0.D0
00220         VBOR = 0.D0
00221         AUBOR = 0.D0
00222         TBOR = 0.D0
00223         ATBOR = 0.D0
00224         BTBOR = 0.D0
00225 !
00226         WRITE(NLIM,30) LIHBOR(J),LIUBOR(J),LIVBOR(J),HBOR,UBOR,VBOR,
00227      &                   AUBOR,LITBOR(J),TBOR,ATBOR,BTBOR,NBOR(J),J
00228 !
00229       ENDDO
00230 !
00231       IF (LNG.EQ.1.AND.MAILLE(1:8).NE.'SUPERTAB'.AND.
00232      &                 MAILLE(1:7).NE.'TRIGRID') WRITE(LU,40) MAILLE
00233       IF (LNG.EQ.2.AND.MAILLE(1:8).NE.'SUPERTAB'.AND.
00234      &                 MAILLE(1:7).NE.'TRIGRID') WRITE(LU,3040) MAILLE
00235 !
00236 !-----------------------------------------------------------------------
00237 !
00238  40   FORMAT(/,
00239      & ' *********************************************************',/,
00240      & ' ATTENTION : LE FICHIER UNIVERSEL EST AU FORMAT ',A8,/,
00241      & '             IL FAUDRA VERIFIER LES CONDITIONS AUX LIMITES',/,
00242      & '             DANS LE FICHIER DES CONDITIONS AUX LIMITES',/,
00243      & ' *********************************************************',/)
00244 !
00245  3040 FORMAT(/,
00246      & ' **************************************************',/,
00247      & ' BEWARE: THE UNIVERSAL FILE FORMAT IS ',A8,/,
00248      & '         BOUNDARY CONDITIONS WILL HAVE TO BE',/,
00249      & '         CHECKED IN THE BOUNDARY CONDITIONS FILE',/,
00250      & ' **************************************************',/)
00251 !
00252  30   FORMAT(1X,I2,1X,2(I1,1X),3(F6.3,1X),1X,
00253      &                    F3.1,3X,I1,1X,3(F6.3,1X),1I9,1X,1I9)
00254 !
00255 !-----------------------------------------------------------------------
00256 !
00257       RETURN
00258       END

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