ecrsel.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\stbtel\ecrsel.f
00002 !
00030                         SUBROUTINE ECRSEL
00031 !                       *****************
00032 !
00033      &(VAINIT,IKINIT,NPINIT,NEINIT,SHP,ELT,NPOIN,NPOIN1,NPMAX,W,
00034      & X,ZF,NSFOND,NCOLOR,COLOR,VAR,NVARIN,NVAROU,NVAR2,STD,FUSION,
00035      & NRES,NGEO,NFO1,MAILLE)
00036 !
00037 !***********************************************************************
00038 ! PROGICIEL : STBTEL  V5.2           11/02/93    J.M. JANIN
00039 !***********************************************************************
00040 !
00041 !   FONCTION  : RECHERCHE LES NOMBRES TOTAUX DE NOEUDS ET D'ELEMENTS DU
00042 !               MAILLAGE DANS LE FICHIER D'ENTREE SELAFIN
00043 !
00044 !-----------------------------------------------------------------------
00045 !                             ARGUMENTS
00046 ! .________________.____.______________________________________________
00047 ! |      NOM       |MODE|                   ROLE
00048 ! |________________|____|______________________________________________
00049 ! | NPOIN1         |<-- | NOMBRE REEL DE POINTS DU MAILLAGE
00050 ! |                |    | (NPOIN REPRESENTE L'INDICE MAX DES NOEUDS CAR
00051 ! |                |    | SUPERTAB LAISSE DES TROUS DANS LA NUMEROTATION
00052 ! | TYPELE         |<-- | TYPE D'ELEMENTS
00053 ! |________________|____|______________________________________________
00054 ! | COMMON:        |    |
00055 ! |  GEO:          |    |
00056 ! |    MESH        |<-- | TYPE DES ELEMENTS DU MAILLAGE
00057 ! |    NDP         | -->| NOMBRE DE NOEUDS PAR ELEMENTS
00058 ! |    NPOIN       |<-- | NOMBRE TOTAL DE NOEUDS DU MAILLAGE
00059 ! |    NELEM       |<-- | NOMBRE TOTAL D'ELEMENTS DU MAILLAGE
00060 ! |    NPMAX       | -->| DIMENSION EFFECTIVE DES TABLEAUX X ET Y
00061 ! |                |    | (NPMAX = NPOIN + 0.1*NELEM)
00062 ! |    NELMAX      | -->| DIMENSION EFFECTIVE DES TABLEAUX CONCERNANT
00063 ! |                |    | LES ELEMENTS (NELMAX = NELEM + 0.2*NELEM)
00064 ! |  FICH:         |    |
00065 ! |    NRES        |--> | NUMERO DU CANAL DU FICHIER DE SERAFIN
00066 ! |    NGEO        |--> | NUMERO DU CANAL DU FICHIER MAILLEUR
00067 ! |    NLIM        |--> | NUMERO DU CANAL DU FICHIER DYNAM DE TELEMAC
00068 ! |    NFO1        |--> | NUMERO DU CANAL DU FICHIER TRIANGLE TRIGRID
00069 ! |________________|____|______________________________________________
00070 ! MODE : -->(DONNEE NON MODIFIEE), <--(RESULTAT), <-->(DONNEE MODIFIEE)
00071 !-----------------------------------------------------------------------
00072 ! APPELE PAR : HOMERE
00073 ! APPEL DE : -
00074 !***********************************************************************
00075 !
00076       IMPLICIT NONE
00077       INTEGER LNG,LU
00078       COMMON/INFO/LNG,LU
00079 !
00080       DOUBLE PRECISION XBID(1)
00081       REAL W(*)
00082       INTEGER IBID(1)
00083       CHARACTER*72 CBID
00084       CHARACTER*9 MAILLE
00085 !
00086       INTEGER NEINIT,NPOIN
00087       INTEGER IKINIT(NEINIT,3),ELT(NPOIN),NCOLOR(NPOIN)
00088       INTEGER NPINIT,NPOIN1,NPOIN2,NPMAX
00089       INTEGER NSFOND,NVARIN,NVAROU,NVAR2
00090       INTEGER NRES,NGEO,NFO1,IVAR,IPOIN,ISTAT,I
00091 !
00092       DOUBLE PRECISION VAINIT(NPINIT),SHP(NPMAX,3)
00093       DOUBLE PRECISION X(NPOIN),ZF(NPOIN),VAR(NPOIN),A(2)
00094 !
00095       CHARACTER*3  STD
00096 !
00097       LOGICAL COLOR,BIEF_EOF,FUSION,OK2
00098       EXTERNAL BIEF_EOF
00099 !
00100 !=======================================================================
00101 !
00102       OK2 = FUSION
00103       NPOIN2 = NPINIT - NPOIN1
00104 !
00105 !  ECRITURE DU TEMPS
00106 !
00107 10    CONTINUE
00108 !
00109       A(1) = 0.D0
00110       IF(NVARIN.GT.0) THEN
00111         IF (BIEF_EOF(NGEO)) GOTO 40
00112         IF (OK2) THEN
00113           IF (BIEF_EOF(NFO1)) OK2 = .FALSE.
00114           IF (OK2) CALL LIT(A,W,IBID,CBID,1,'R4',NFO1,STD,ISTAT)
00115         ENDIF
00116         CALL LIT(A,W,IBID,CBID,1,'R4',NGEO,STD,ISTAT)
00117       ENDIF
00118 !
00119       CALL ECRI2(A,IBID,CBID,1,'R4',NRES,STD,ISTAT)
00120 !
00121 !=======================================================================
00122 !
00123 !  ECRITURE DES VARIABLES
00124 !
00125       IF (NVARIN.GT.0) THEN
00126         DO IVAR = 1,NVARIN
00127 !
00128 !         ZF DEJA LU AVEC ADCIRC
00129           IF(MAILLE.NE.'ADCIRC') THEN
00130             CALL LIT(VAINIT,W,IBID,CBID,NPOIN1,'R4',NGEO,STD,ISTAT)
00131           ENDIF
00132 !
00133           IF (FUSION) THEN
00134             IF (OK2.AND.IVAR.LE.NVAR2) THEN
00135               CALL LIT(VAINIT(NPOIN1+1),W,IBID,CBID,NPOIN2,'R4',
00136      &                 NFO1,STD,ISTAT)
00137             ELSE
00138               DO I = NPOIN1+1,NPINIT
00139                 VAINIT(I) = 0.D0
00140               ENDDO
00141             ENDIF
00142           ENDIF
00143 !
00144           IF (IVAR.EQ.NSFOND) THEN
00145             CALL ECRI2(ZF,IBID,CBID,NPOIN,'R4',NRES,STD,ISTAT)
00146           ELSE
00147             DO IPOIN = 1,NPOIN
00148               VAR(IPOIN) = VAINIT(IKINIT(ELT(IPOIN),1))*SHP(IPOIN,1)
00149      &                   + VAINIT(IKINIT(ELT(IPOIN),2))*SHP(IPOIN,2)
00150      &                   + VAINIT(IKINIT(ELT(IPOIN),3))*SHP(IPOIN,3)
00151             ENDDO
00152             CALL ECRI2(VAR,IBID,CBID,NPOIN,'R4',NRES,STD,ISTAT)
00153           ENDIF
00154         ENDDO
00155 !
00156         IF (OK2) THEN
00157           IF (NVARIN.LT.NVAR2) THEN
00158             DO IVAR = NVARIN+1,NVAR2
00159               CALL LIT(VAINIT,W,IBID,CBID,2,'R4',NFO1,STD,ISTAT)
00160             ENDDO
00161           ENDIF
00162         ENDIF
00163 !
00164       ENDIF
00165 !
00166       IF(NSFOND.EQ.NVARIN+1.OR.MAILLE.EQ.'ADCIRC') THEN
00167         CALL ECRI2(ZF,IBID,CBID,NPOIN,'R4',NRES,STD,ISTAT)
00168       ENDIF
00169       IF(COLOR) THEN
00170         CALL ECRI2(XBID,NCOLOR,CBID,NPOIN,'I ',NRES,STD,ISTAT)
00171       ENDIF
00172       IF(NVAROU.EQ.0) THEN
00173         CALL ECRI2(X,IBID,CBID,NPOIN,'R4',NRES,STD,ISTAT)
00174       ENDIF
00175 !
00176       IF (NVARIN.GT.0) GOTO 10
00177 !
00178 40    CONTINUE
00179 !
00180 !=======================================================================
00181 !
00182       RETURN
00183       END

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