ecrres.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\stbtel\ecrres.f
00002 !
00030                         SUBROUTINE ECRRES
00031 !                       *****************
00032 !
00033      &(VAINIT,IKINIT,NPINIT,NEINIT,SHP,ELT,NPOIN,NPOIN1,NPMAX,W,
00034      & X,ZF,NSFOND,NCOLOR,COLOR,VAR,NVARIN,NVAROU,STD,NDP,IKLES,
00035      & STOTOT,TPSFIN,NGEO,NRES)
00036 !
00037 !***********************************************************************
00038 ! PROGICIEL : STBTEL  V5.2           11/02/93    J.M. JANIN
00039 !                               26/02/99    P. LANG (SOGREAH)
00040 !***********************************************************************
00041 !
00042 !   FONCTION  : FIN D'ECRITURE DU FICHIER RESULTAT DANS LE CAS DE
00043 !               L'OPTION D'ELIMINATION DES ELEMENTS SECS
00044 !
00045 !-----------------------------------------------------------------------
00046 !                             ARGUMENTS
00047 ! .________________.____.______________________________________________
00048 ! |      NOM       |MODE|                   ROLE
00049 ! |________________|____|______________________________________________
00050 ! | VAINIT         |--->| TABLEAU DB PPREC SEVANT A LIRE LES VARIABLES
00051 ! | IKINIT         |--->| TABLEAU IKLE DU FICHIER INITIAL
00052 ! | NPINIT         |--->| NOMBRE DE POINTS DU FICHIER INITIAL
00053 ! | NEINIT         |--->| NOMBRE D'ELEMENTS DU FICHIER INITIAL
00054 ! | SHP            |--->| MATRICE D'INTERPOLATION DES POINTS SUR LE MAILLAGE INITIAL
00055 ! | ELT            |--->| TAB INDIQUANT L'ELEMENT INITIAL AUQUEL LE POINT APPARTIENT
00056 ! | NPOIN          |--->| NOMBRE DE POINTS ACTUEL
00057 ! | NPOIN1         |--->| NOMBRE DE POINTS INITIAL
00058 ! |    NPMAX       | -->| DIMENSION EFFECTIVE DES TABLEAUX X ET Y
00059 ! |                |    | (NPMAX = NPOIN + 0.1*NELEM)
00060 ! | NEINIT         |--->| NOMBRE D'ELEMENTS DU FICHIER INITIAL
00061 ! | NEINIT         |--->| NOMBRE D'ELEMENTS DU FICHIER INITIAL
00062 ! | NEINIT         |--->| NOMBRE D'ELEMENTS DU FICHIER INITIAL
00063 ! | NEINIT         |--->| NOMBRE D'ELEMENTS DU FICHIER INITIAL
00064 ! | NEINIT         |--->| NOMBRE D'ELEMENTS DU FICHIER INITIAL
00065 ! | TYPELE         |<-- | TYPE D'ELEMENTS
00066 ! |________________|____|______________________________________________
00067 ! | COMMON:        |    |
00068 ! |  GEO:          |    |
00069 ! |    MESH        |<-- | TYPE DES ELEMENTS DU MAILLAGE
00070 ! |    NDP         | -->| NOMBRE DE NOEUDS PAR ELEMENTS
00071 ! |    NPOIN       |<-- | NOMBRE TOTAL DE NOEUDS DU MAILLAGE
00072 ! |    NELEM       |<-- | NOMBRE TOTAL D'ELEMENTS DU MAILLAGE
00073 ! |    NPMAX       | -->| DIMENSION EFFECTIVE DES TABLEAUX X ET Y
00074 ! |                |    | (NPMAX = NPOIN + 0.1*NELEM)
00075 ! |    NELMAX      | -->| DIMENSION EFFECTIVE DES TABLEAUX CONCERNANT
00076 ! |                |    | LES ELEMENTS (NELMAX = NELEM + 0.2*NELEM)
00077 ! |________________|____|______________________________________________
00078 ! MODE : -->(DONNEE NON MODIFIEE), <--(RESULTAT), <-->(DONNEE MODIFIEE)
00079 !-----------------------------------------------------------------------
00080 ! APPELE PAR : HOMERE
00081 ! APPEL DE : -
00082 !***********************************************************************
00083 !
00084       IMPLICIT NONE
00085       INTEGER LNG,LU
00086       COMMON/INFO/LNG,LU
00087 !
00088       DOUBLE PRECISION XBID(1)
00089       REAL W(*)
00090       INTEGER IBID(1)
00091       CHARACTER*72 CBID
00092 !
00093       INTEGER   NDP
00094 !
00095       INTEGER NEINIT,NPOIN
00096       INTEGER IKINIT(NEINIT,3),ELT(NPOIN),NCOLOR(NPOIN)
00097       INTEGER NPINIT,NPOIN1,NPMAX
00098       INTEGER NSFOND,NVARIN,NVAROU,IB(10)
00099       INTEGER NGEO,NRES,IVAR,IPOIN,ISTAT
00100 !
00101       DOUBLE PRECISION VAINIT(NPINIT),SHP(NPMAX,3), TPSFIN(1)
00102       DOUBLE PRECISION X(NPOIN),ZF(NPOIN),VAR(NPOIN),A(2)
00103 !
00104       LOGICAL STOTOT
00105       INTEGER IKLES(NDP,NEINIT)
00106       CHARACTER*3  STD
00107       CHARACTER*32 NOMVAR
00108 !
00109       INTEGER I
00110       LOGICAL COLOR,BIEF_EOF
00111       EXTERNAL BIEF_EOF
00112 !
00113 !=======================================================================
00114 !
00115       REWIND NGEO
00116       CALL LIT(XBID,W ,IBID,CBID,72,'CH',NGEO,STD,ISTAT)
00117       CALL LIT(XBID,W ,IB  ,CBID, 2,'I ',NGEO,STD,ISTAT)
00118       DO  I=1,NVARIN
00119         CALL LIT(XBID,W ,IBID,NOMVAR,32,'CH',NGEO,STD,ISTAT)
00120       ENDDO ! I
00121       CALL LIT(XBID,W ,IB  ,CBID,10,'I ',NGEO,STD,ISTAT)
00122       IF (IB(10).EQ.1) THEN
00123         CALL LIT(XBID,W ,IB  ,CBID, 6,'I ',NGEO,STD,ISTAT)
00124       ENDIF
00125       CALL LIT(XBID,W ,IB  ,CBID, 4,'I ',NGEO,STD,ISTAT)
00126       CALL LIT(XBID,W,IKLES,CBID,NEINIT*NDP,'I ',NGEO,STD,ISTAT)
00127       CALL LIT(XBID,W,IB,CBID, 1,'I ',NGEO,STD,ISTAT)
00128       CALL LIT(X   ,W,IBID,CBID,NPINIT,'R4',NGEO,STD,ISTAT)
00129       CALL LIT(X   ,W,IBID,CBID,NPINIT,'R4',NGEO,STD,ISTAT)
00130 !
00131 !  ECRITURE DU TEMPS
00132 !
00133 10    CONTINUE
00134 !
00135       A(1) = 0.D0
00136       IF (NVARIN.GT.0) THEN
00137         IF (BIEF_EOF(NGEO)) GOTO 40
00138         CALL LIT(A,W,IBID,CBID,1,'R4',NGEO,STD,ISTAT)
00139       ENDIF
00140       IF (STOTOT.OR.A(1).EQ.TPSFIN(1)) THEN
00141 !
00142         IF (LNG.EQ.1) WRITE (LU,9000) A(1)
00143         IF (LNG.EQ.2) WRITE (LU,9001) A(1)
00144         IF (STD(1:3).EQ.'IBM') THEN
00145           A(2) = 0.D0
00146           CALL ECRI2(A,IBID,CBID,2,'R4',NRES,STD,ISTAT)
00147         ELSE
00148           CALL ECRI2(A,IBID,CBID,1,'R4',NRES,STD,ISTAT)
00149         ENDIF
00150       ENDIF
00151 !
00152 !=======================================================================
00153 !
00154 !  ECRITURE DES VARIABLES
00155 !
00156       IF(NVARIN.GT.0) THEN
00157 !
00158         DO IVAR = 1,NVARIN
00159           CALL LIT(VAINIT,W,IBID,CBID,NPOIN1,'R4',NGEO,STD,ISTAT)
00160 !
00161           IF (STOTOT.OR.A(1).EQ.TPSFIN(1)) THEN
00162             IF (IVAR.EQ.NSFOND) THEN
00163               CALL ECRI2(ZF,IBID,CBID,NPOIN,'R4',NRES,STD,ISTAT)
00164             ELSE
00165               DO IPOIN = 1,NPOIN
00166                  VAR(IPOIN) = VAINIT(IKINIT(ELT(IPOIN),1))*SHP(IPOIN,1)
00167      &                      + VAINIT(IKINIT(ELT(IPOIN),2))*SHP(IPOIN,2)
00168      &                      + VAINIT(IKINIT(ELT(IPOIN),3))*SHP(IPOIN,3)
00169               ENDDO
00170               CALL ECRI2(VAR,IBID,CBID,NPOIN,'R4',NRES,STD,ISTAT)
00171             ENDIF
00172           ENDIF
00173         ENDDO
00174 !
00175       ENDIF
00176 !
00177       IF (STOTOT.OR.A(1).EQ.TPSFIN(1)) THEN
00178         IF (NSFOND.EQ.NVARIN+1) THEN
00179           CALL ECRI2(ZF,IBID,CBID,NPOIN,'R4',NRES,STD,ISTAT)
00180         ENDIF
00181         IF (COLOR)
00182      &    CALL ECRI2(XBID,NCOLOR,CBID,NPOIN,'I ',NRES,STD,ISTAT)
00183         IF (NVAROU.EQ.0)
00184      &    CALL ECRI2(X,IBID,CBID,NPOIN,'R4',NRES,STD,ISTAT)
00185       ENDIF
00186 !
00187       IF (NVARIN.GT.0) GOTO 10
00188 !
00189 40    CONTINUE
00190 !
00191 !=======================================================================
00192 !
00193  9000 FORMAT (1X,'************************************************',/,
00194      &        1X,'  ROUTINE ECRRES - TEMPS ECRIT DANS LE FICHIER ',/,
00195      &        1X,'  DE SORTIE : ',F8.1,' SEC.',/,
00196      &        1X,'************************************************')
00197  9001 FORMAT (1X,'************************************************',/,
00198      &        1X,'  ROUTINE ECRRES - TIME STORED IN THE OUTPUT ',/,
00199      &        1X,'  FILE : ',F8.1,' SEC.',/,
00200      &        1X,'************************************************')
00201       RETURN
00202       END

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