fond.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\fond.f
00002 !
00059                      SUBROUTINE FOND
00060 !                    ***************
00061 !
00062      &(ZF  ,X,Y,NPOIN,NFON,NBOR,KP1BOR,NPTFR)
00063 !
00064 !***********************************************************************
00065 ! BIEF   V6P1                                   21/08/2010
00066 !***********************************************************************
00067 !
00068 !
00069 !
00070 !
00071 !
00072 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00073 !| KP1BOR         |-->| GIVES THE NEXT BOUNDARY POINT IN A CONTOUR
00074 !| NBOR           |-->| GLOBAL NUMBER OF BOUNDARY POINTS
00075 !| NFON           |-->| LOGICAL UNIT OF FILE FOR BOTTOM BATHYMETRY
00076 !| NPOIN          |-->| NUMBER OF POINTS
00077 !| NPTFR          |-->| NUMBER OF BOUNDARY POINTS
00078 !| X              |-->| ABSCISSAE OF POINTS IN THE MESH
00079 !| Y              |-->| ORDINATES OF POINTS IN THE MESH
00080 !| ZF             |-->| ELEVATION OF BOTTOM
00081 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00082 !
00083       USE BIEF, EX_FOND => FOND
00084 !
00085       IMPLICIT NONE
00086       INTEGER LNG,LU
00087       COMMON/INFO/LNG,LU
00088 !
00089 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00090 !
00091       INTEGER, INTENT(IN) :: NFON,NPOIN,NPTFR
00092       DOUBLE PRECISION, INTENT(OUT) :: ZF(NPOIN)
00093       DOUBLE PRECISION, INTENT(IN)  :: X(NPOIN),Y(NPOIN)
00094       INTEGER, INTENT(IN) :: NBOR(NPTFR),KP1BOR(NPTFR)
00095 !
00096 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00097 !
00098       INTEGER NP,ERR
00099 !
00100       DOUBLE PRECISION BID
00101 !
00102       CHARACTER*1 C
00103 !
00104       DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: XRELV,YRELV,COTE
00105 !
00106 !-----------------------------------------------------------------------
00107 !                    READS THE DIGITISED POINTS
00108 !                      FROM LOGICAL UNIT NFON
00109 !-----------------------------------------------------------------------
00110 !
00111 !  ASSESSES THE EXTENT OF DATA
00112 !
00113       NP = 0
00114 20    READ(NFON,120,END=24,ERR=124) C
00115 120   FORMAT(A1)
00116       IF(C(1:1).NE.'C'.AND.C(1:1).NE.'B') THEN
00117         BACKSPACE ( UNIT = NFON )
00118         NP = NP + 1
00119         READ(NFON,*) BID,BID,BID
00120       ENDIF
00121       GO TO 20
00122 124   CONTINUE
00123       IF(LNG.EQ.1) WRITE(LU,18) NP
00124       IF(LNG.EQ.2) WRITE(LU,19) NP
00125 18    FORMAT(1X,'FOND (BIEF)'
00126      &      ,/,1X,'ERREUR DANS LE FICHIER DES FONDS'
00127      &      ,/,1X,'A LA LIGNE ',I7)
00128 19    FORMAT(1X,'FOND (BIEF)'
00129      &      ,/,1X,'ERROR IN THE BOTTOM FILE'
00130      &      ,/,1X,'AT LINE ',I7)
00131       CALL PLANTE(1)
00132       STOP
00133 24    CONTINUE
00134 !
00135 !  DYNAMICALLY ALLOCATES THE ARRAYS
00136 !
00137       ALLOCATE(XRELV(NP),STAT=ERR)
00138       ALLOCATE(YRELV(NP),STAT=ERR)
00139       ALLOCATE(COTE(NP) ,STAT=ERR)
00140 !
00141       IF(ERR.NE.0) THEN
00142         IF(LNG.EQ.1) WRITE(LU,10) NP
00143         IF(LNG.EQ.2) WRITE(LU,11) NP
00144 10      FORMAT(1X,'FOND (BIEF)'
00145      &      ,/,1X,'ERREUR A L''ALLOCATION DE 3 TABLEAUX'
00146      &      ,/,1X,'DE TAILLE ',I7)
00147 11      FORMAT(1X,'FOND (BIEF)'
00148      &      ,/,1X,'ERROR DURING ALLOCATION OF 3 ARRAYS'
00149      &      ,/,1X,'OF SIZE ',I7)
00150         CALL PLANTE(1)
00151         STOP
00152       ENDIF
00153 !
00154 !  READS THE DATA
00155 !
00156       REWIND(NFON)
00157       NP = 0
00158 23    READ(NFON,120,END=22,ERR=122) C
00159       IF(C(1:1).NE.'C'.AND.C(1:1).NE.'B') THEN
00160         BACKSPACE ( UNIT = NFON )
00161         NP = NP + 1
00162         READ(NFON,*) XRELV(NP) , YRELV(NP) , COTE(NP)
00163       ENDIF
00164       GO TO 23
00165 !
00166 122   CONTINUE
00167       IF(LNG.EQ.1) WRITE(LU,12) NP
00168       IF(LNG.EQ.2) WRITE(LU,13) NP
00169 12    FORMAT(1X,'FOND (BIEF)'
00170      &      ,/,1X,'ERREUR DANS LE FICHIER DES FONDS'
00171      &      ,/,1X,'A LA LIGNE ',I7)
00172 13    FORMAT(1X,'FOND (BIEF)'
00173      &      ,/,1X,'ERROR IN THE BOTTOM FILE'
00174      &      ,/,1X,'AT LINE ',I7)
00175       CALL PLANTE(1)
00176       STOP
00177 !
00178 22    CONTINUE
00179 !
00180       IF(LNG.EQ.1) WRITE(LU,112) NP
00181       IF(LNG.EQ.2) WRITE(LU,113) NP
00182 112   FORMAT(1X,'FOND (BIEF) :'
00183      &      ,/,1X,'NOMBRE DE POINTS DANS LE FICHIER DES FONDS : ',I7)
00184 113   FORMAT(1X,'FOND (BIEF):'
00185      &      ,/,1X,'NUMBER OF POINTS IN THE BOTTOM FILE: ',I7)
00186 !
00187 !-----------------------------------------------------------------------
00188 !   THE BOTTOM ELEVATION IS COMPUTED BY INTERPOLATION ONTO THE
00189 !                      DOMAIN INTERIOR POINTS
00190 !-----------------------------------------------------------------------
00191 !
00192       CALL FASP(X,Y,ZF,NPOIN,XRELV,YRELV,COTE,NP,NBOR,KP1BOR,NPTFR,0.D0)
00193 !
00194 !-----------------------------------------------------------------------
00195 !
00196       DEALLOCATE(XRELV)
00197       DEALLOCATE(YRELV)
00198       DEALLOCATE(COTE)
00199 !
00200 !-----------------------------------------------------------------------
00201 !
00202       RETURN
00203       END

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