front2.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\front2.f
00002 !
00059                      SUBROUTINE FRONT2
00060 !                    *****************
00061 !
00062      &(NFRLIQ,NFRSOL,DEBLIQ,FINLIQ,DEBSOL,FINSOL,LIHBOR,LIUBOR,
00063      & X,Y,NBOR,KP1BOR,DEJAVU,NPOIN,NPTFR,KLOG,LISTIN,NUMLIQ,MAXFRO)
00064 !
00065 !***********************************************************************
00066 ! BIEF   V6P1                                   21/08/2010
00067 !***********************************************************************
00068 !
00069 !
00070 !
00071 !
00072 !
00073 !
00074 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00075 !| DEBLIQ         |<--| BEGINNING OF LIQUID BOUNDARIES
00076 !| DEBSOL         |<--| BEGINNING OF SOLID BOUNDARIES
00077 !| DEJAVU         |<->| WORK ARRAY
00078 !| FINLIQ         |<--| END OF LIQUID BOUNDARIES
00079 !| FINSOL         |<--| END OF SOLID BOUNDARIES
00080 !| KLOG           |-->| LIHBOR(K)=KLOG : SOLID BOUNDARY
00081 !| KP1BOR         |-->| GIVES THE NEXT BOUNDARY POINT IN A CONTOUR
00082 !| LIHBOR         |-->| TYPE OF BOUNDARY CONDITIONS ON DEPTH
00083 !| LISTIN         |-->| IF YES, PRINTING ON LISTING
00084 !| LIUBOR         |-->| TYPE OF BOUNDARY CONDITIONS ON U
00085 !| MAXFRO         |-->| MAXIMUM NUMBER OF LIQUID OR SOLID BOUNDARIES
00086 !| NBOR           |-->| GLOBAL NUMBER OF BOUNDARY POINTS
00087 !| NFRLIQ         |<--| NUMBER OF LIQUID BOUNDARIES
00088 !| NFRSOL         |<--| NUMBER OF SOLID BOUNDARIES
00089 !| NPOIN          |-->| NUMBER OF POINTS
00090 !| NPTFR          |-->| NUMBER OF BOUNDARY POINTS
00091 !| NUMLIQ         |-->| BOUNDARY NUMBER OF BOUNDARY POINTS
00092 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00093 !
00094       IMPLICIT NONE
00095       INTEGER LNG,LU
00096       COMMON/INFO/LNG,LU
00097 !
00098 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00099 !
00100       INTEGER, INTENT(IN)  :: NPOIN,NPTFR,KLOG,MAXFRO
00101       INTEGER, INTENT(OUT) :: NFRLIQ,NFRSOL
00102       INTEGER, INTENT(OUT) :: DEBLIQ(MAXFRO),FINLIQ(MAXFRO)
00103       INTEGER, INTENT(OUT) :: DEBSOL(MAXFRO),FINSOL(MAXFRO)
00104       INTEGER , INTENT(IN) :: LIHBOR(NPTFR),LIUBOR(NPTFR)
00105       DOUBLE PRECISION, INTENT(IN) :: X(NPOIN) , Y(NPOIN)
00106       INTEGER, INTENT(IN) :: NBOR(NPTFR),KP1BOR(NPTFR)
00107       INTEGER, INTENT(OUT) :: DEJAVU(NPTFR)
00108       LOGICAL, INTENT(IN) :: LISTIN
00109       INTEGER, INTENT(OUT) :: NUMLIQ(NPTFR)
00110 !
00111 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00112 !
00113       INTEGER K,KPREV,IDEP,SOL1,LIQ1,L1,L2,L3,NILE
00114 !
00115       LOGICAL SOLF,LIQF,SOLD,LIQD
00116 !
00117       DOUBLE PRECISION MINNS,MAXNS,EPS,YMIN,NS
00118 !
00119       INTRINSIC ABS
00120 !
00121 !-----------------------------------------------------------------------
00122 !
00123 !  INITIALISES
00124 !
00125 !  DEJAVU : MARKS WITH 1 THE POINTS THAT HAVE ALREADY BEEN TREATED
00126 !  NILE   : NUMBER OF ISLANDS
00127 !
00128       DO K=1,NPTFR
00129         DEJAVU(K) = 0
00130       ENDDO ! K
00131 !
00132       NILE = 0
00133       IDEP = 1
00134       NFRLIQ = 0
00135       NFRSOL = 0
00136 !
00137 !-----------------------------------------------------------------------
00138 !
00139 !  COMES BACK TO LABEL 20 IF THERE IS AT LEAST 1 ISLAND
00140 !
00141 20    CONTINUE
00142 !
00143 !  LOOKS FOR THE SOUTH-WESTERNMOST POINT (THERE CAN BE MORE THAN 1)
00144 !
00145       MINNS = X(NBOR(IDEP)) + Y(NBOR(IDEP))
00146       MAXNS = MINNS
00147       YMIN  = Y(NBOR(IDEP))
00148 !
00149       DO K = 1 , NPTFR
00150       IF(DEJAVU(K).EQ.0) THEN
00151         NS = X(NBOR(K)) + Y(NBOR(K))
00152         IF(NS.LT.MINNS) THEN
00153           IDEP = K
00154           MINNS = NS
00155           YMIN = Y(NBOR(K))
00156         ENDIF
00157         IF(NS.GT.MAXNS) MAXNS = NS
00158       ENDIF
00159       ENDDO ! K
00160 !
00161       EPS = (MAXNS-MINNS) * 1.D-4
00162 !
00163 !  SELECTS THE SOUTHERNMOST POINT FROM THE SOUTH-WESTERNMOST CANDIDATES
00164 !
00165       DO K = 1 , NPTFR
00166       IF(DEJAVU(K).EQ.0) THEN
00167         NS = X(NBOR(K)) + Y(NBOR(K))
00168         IF(ABS(MINNS-NS).LT.EPS) THEN
00169           IF(Y(NBOR(K)).LT.YMIN) THEN
00170             IDEP = K
00171             YMIN = Y(NBOR(K))
00172           ENDIF
00173         ENDIF
00174       ENDIF
00175       ENDDO ! K
00176 !
00177 !-----------------------------------------------------------------------
00178 !
00179 !  NUMBERS AND LOCATES THE CONTOUR BOUNDARIES STARTING
00180 !  AT POINT IDEP
00181 !
00182 !  SOLD = .TRUE. : THE BOUNDARY STARTING AT IDEP IS SOLID
00183 !  LIQD = .TRUE. : THE BOUNDARY STARTING AT IDEP IS LIQUID
00184 !  SOLF = .TRUE. : THE BOUNDARY ENDING AT IDEP IS SOLID
00185 !  LIQF = .TRUE. : THE BOUNDARY ENDING AT IDEP IS LIQUID
00186 !  LIQ1 : NUMBER OF THE 1ST LIQUID BOUNDARY OF THE CONTOUR
00187 !  SOL1 : NUMBER OF THE 1ST SOLID BOUNDARY OF THE CONTOUR
00188 !
00189       K = IDEP
00190 !
00191       SOL1 = 0
00192       LIQ1 = 0
00193       LIQF = .FALSE.
00194       SOLF = .FALSE.
00195 !
00196 ! TYPE OF THE 1ST SEGMENT
00197 !
00198 !     LAW OF PREDOMINANCE SOLID OVER LIQUID
00199       IF(LIHBOR(K).EQ.KLOG.OR.LIHBOR(KP1BOR(K)).EQ.KLOG) THEN
00200 !       THE 1ST SEGMENT IS SOLID
00201         NFRSOL = NFRSOL + 1
00202         SOL1 = NFRSOL
00203         SOLD = .TRUE.
00204         LIQD = .FALSE.
00205       ELSE
00206 !       THE 1ST SEGMENT IS LIQUID
00207         NFRLIQ = NFRLIQ + 1
00208         LIQ1 = NFRLIQ
00209         LIQD = .TRUE.
00210         SOLD = .FALSE.
00211       ENDIF
00212 !
00213       DEJAVU(K) = 1
00214       KPREV = K
00215       K = KP1BOR(K)
00216 !
00217 50    CONTINUE
00218 !
00219 ! LOOKS FOR TRANSITION POINTS FROM THE POINT FOLLOWING IDEB
00220 !
00221 ! ALSO LOOKS FOR ISOLATED POINTS TO DETECT THE ERRORS IN
00222 ! THE DATA
00223 !
00224       L1 = LIHBOR(KPREV)
00225       L2 = LIHBOR(K)
00226       L3 = LIHBOR(KP1BOR(K))
00227 !
00228       IF(L1.EQ.KLOG.AND.L2.NE.KLOG.AND.L3.NE.KLOG) THEN
00229 !     SOLID-LIQUID TRANSITION AT POINT K
00230         NFRLIQ = NFRLIQ + 1
00231         FINSOL(NFRSOL) = K
00232         DEBLIQ(NFRLIQ) = K
00233         LIQF = .TRUE.
00234         SOLF = .FALSE.
00235       ELSEIF(L1.NE.KLOG.AND.L2.NE.KLOG.AND.L3.EQ.KLOG) THEN
00236 !     LIQUID-SOLID TRANSITION AT POINT K
00237         NFRSOL = NFRSOL + 1
00238         FINLIQ(NFRLIQ) = K
00239         DEBSOL(NFRSOL) = K
00240         LIQF = .FALSE.
00241         SOLF = .TRUE.
00242       ELSEIF(L1.NE.KLOG.AND.L2.NE.KLOG.AND.L3.NE.KLOG) THEN
00243 !     LIQUID-LIQUID TRANSITIONS AT POINT K
00244         IF(L2.NE.L3.OR.LIUBOR(K).NE.LIUBOR(KP1BOR(K))) THEN
00245           FINLIQ(NFRLIQ) = K
00246           NFRLIQ = NFRLIQ + 1
00247           DEBLIQ(NFRLIQ) = KP1BOR(K)
00248         ENDIF
00249       ELSEIF(L1.EQ.KLOG.AND.L2.NE.KLOG.AND.L3.EQ.KLOG) THEN
00250 !     ERROR IN THE DATA
00251         IF(LNG.EQ.1) WRITE(LU,102) K
00252         IF(LNG.EQ.2) WRITE(LU,103) K
00253         CALL PLANTE(1)
00254         STOP
00255       ELSEIF(L1.NE.KLOG.AND.L2.EQ.KLOG.AND.L3.NE.KLOG) THEN
00256 !     ERROR IN THE DATA
00257         IF(LNG.EQ.1) WRITE(LU,104) K
00258         IF(LNG.EQ.2) WRITE(LU,105) K
00259         CALL PLANTE(1)
00260         STOP
00261       ENDIF
00262 !
00263       DEJAVU(K) = 1
00264       KPREV = K
00265       K = KP1BOR(K)
00266       IF(K.NE.IDEP) GO TO 50
00267 !
00268 !  CASE WHERE THE BOUNDARY TYPE CHANGES AT IDEP
00269 !
00270       IF(SOLF) THEN
00271 !       THE LAST CONTOUR BOUNDARY WAS SOLID
00272         IF(SOLD) THEN
00273 !         THE FIRST CONTOUR BOUNDARY WAS SOLID
00274           DEBSOL(SOL1) = DEBSOL(NFRSOL)
00275           NFRSOL = NFRSOL - 1
00276         ELSEIF(LIQD) THEN
00277 !         THE FIRST CONTOUR BOUNDARY WAS LIQUID
00278           DEBLIQ(LIQ1) = IDEP
00279           FINSOL(NFRSOL) = IDEP
00280         ENDIF
00281 !
00282       ELSEIF(LIQF) THEN
00283 !       THE LAST CONTOUR BOUNDARY WAS LIQUID
00284         IF(LIQD) THEN
00285 !         THE FIRST CONTOUR BOUNDARY WAS LIQUID
00286           DEBLIQ(LIQ1) = DEBLIQ(NFRLIQ)
00287           NFRLIQ = NFRLIQ - 1
00288         ELSEIF(SOLD) THEN
00289 !         THE FIRST CONTOUR BOUNDARY WAS SOLID
00290           DEBSOL(SOL1) = IDEP
00291           FINLIQ(NFRLIQ) = IDEP
00292         ENDIF
00293 !
00294       ELSE
00295 !     CASE WHERE THE WHOLE CONTOUR HAS THE SAME TYPE
00296         IF(SOL1.NE.0) THEN
00297           DEBSOL(SOL1) = IDEP
00298           FINSOL(SOL1) = IDEP
00299         ELSEIF(LIQ1.NE.0) THEN
00300           DEBLIQ(LIQ1) = IDEP
00301           FINLIQ(LIQ1) = IDEP
00302         ELSE
00303           IF(LISTIN.AND.LNG.EQ.1) THEN
00304            WRITE(LU,'(1X,A)') 'CAS IMPOSSIBLE DANS FRONT2'
00305           ENDIF
00306           IF(LISTIN.AND.LNG.EQ.2) THEN
00307            WRITE(LU,'(1X,A)') 'IMPOSSIBLE CASE IN FRONT2'
00308           ENDIF
00309           CALL PLANTE(1)
00310           STOP
00311         ENDIF
00312       ENDIF
00313 !
00314 !-----------------------------------------------------------------------
00315 !
00316 !  CHECKS WHETHER THERE ARE OTHER CONTOURS LEFT:
00317 !
00318       DO K = 1 , NPTFR
00319         IF(DEJAVU(K).EQ.0) THEN
00320           IDEP = K
00321           NILE = NILE + 1
00322           GO TO 20
00323         ENDIF
00324       ENDDO ! K
00325 !
00326 !-----------------------------------------------------------------------
00327 !
00328       DO K=1,NPTFR
00329         NUMLIQ(K)=0
00330       ENDDO ! K
00331 !
00332 !  PRINTS OUT THE RESULTS AND COMPUTES NUMLIQ
00333 !
00334       IF(NILE.NE.0.AND.LISTIN.AND.LNG.EQ.1) WRITE(LU,69) NILE
00335       IF(NILE.NE.0.AND.LISTIN.AND.LNG.EQ.2) WRITE(LU,169) NILE
00336 !
00337       IF(NFRLIQ.NE.0) THEN
00338         IF(LISTIN.AND.LNG.EQ.1) WRITE(LU,70) NFRLIQ
00339         IF(LISTIN.AND.LNG.EQ.2) WRITE(LU,170) NFRLIQ
00340         DO K = 1, NFRLIQ
00341 !
00342 !  MARKS THE NUMBERS OF THE LIQUID BOUNDARIES
00343 !
00344           L1=DEBLIQ(K)
00345           NUMLIQ(L1)=K
00346 707       L1=KP1BOR(L1)
00347           NUMLIQ(L1)=K
00348           IF(L1.NE.FINLIQ(K)) GO TO 707
00349 !
00350 !  END OF MARKING
00351 !
00352           IF(LISTIN.AND.LNG.EQ.1) WRITE(LU,90)
00353      &                            K,DEBLIQ(K),NBOR(DEBLIQ(K)),
00354      &                            X(NBOR(DEBLIQ(K))),Y(NBOR(DEBLIQ(K))),
00355      &                            FINLIQ(K),NBOR(FINLIQ(K)),
00356      &                            X(NBOR(FINLIQ(K))),Y(NBOR(FINLIQ(K)))
00357           IF(LISTIN.AND.LNG.EQ.2) WRITE(LU,190)
00358      &                            K,DEBLIQ(K),NBOR(DEBLIQ(K)),
00359      &                            X(NBOR(DEBLIQ(K))),Y(NBOR(DEBLIQ(K))),
00360      &                            FINLIQ(K),NBOR(FINLIQ(K)),
00361      &                            X(NBOR(FINLIQ(K))),Y(NBOR(FINLIQ(K)))
00362         ENDDO ! K
00363       ENDIF
00364 !
00365       IF(NFRSOL.NE.0) THEN
00366         IF(LISTIN.AND.LNG.EQ.1) WRITE(LU,100) NFRSOL
00367         IF(LISTIN.AND.LNG.EQ.2) WRITE(LU,101) NFRSOL
00368         DO K = 1, NFRSOL
00369           IF(LISTIN.AND.LNG.EQ.1) WRITE(LU,90)
00370      &                            K,DEBSOL(K),NBOR(DEBSOL(K)),
00371      &                            X(NBOR(DEBSOL(K))),Y(NBOR(DEBSOL(K))),
00372      &                            FINSOL(K),NBOR(FINSOL(K)),
00373      &                            X(NBOR(FINSOL(K))),Y(NBOR(FINSOL(K)))
00374           IF(LISTIN.AND.LNG.EQ.2) WRITE(LU,190)
00375      &                            K,DEBSOL(K),NBOR(DEBSOL(K)),
00376      &                            X(NBOR(DEBSOL(K))),Y(NBOR(DEBSOL(K))),
00377      &                            FINSOL(K),NBOR(FINSOL(K)),
00378      &                            X(NBOR(FINSOL(K))),Y(NBOR(FINSOL(K)))
00379         ENDDO ! K
00380       ENDIF
00381 !
00382 !-----------------------------------------------------------------------
00383 !
00384 !  FORMATS
00385 !
00386 69    FORMAT(/,1X,'IL Y A ',1I3,' ILE(S) DANS LE DOMAINE')
00387 169   FORMAT(/,1X,'THERE IS ',1I3,' ISLAND(S) IN THE DOMAIN')
00388 70    FORMAT(/,1X,'IL Y A ',1I3,' FRONTIERE(S) LIQUIDE(S) :')
00389 170   FORMAT(/,1X,'THERE IS ',1I3,' LIQUID BOUNDARIES:')
00390 100   FORMAT(/,1X,'IL Y A ',1I3,' FRONTIERE(S) SOLIDE(S) :')
00391 101   FORMAT(/,1X,'THERE IS ',1I3,' SOLID BOUNDARIES:')
00392 102   FORMAT(/,1X,'FRONT2 : ERREUR AU POINT DE BORD ',1I5,
00393      &       /,1X,'         POINT LIQUIDE ENTRE DEUX POINTS SOLIDES')
00394 103   FORMAT(/,1X,'FRONT2 : ERROR AT BOUNDARY POINT ',1I5,
00395      &       /,1X,'         LIQUID POINT BETWEEN TWO SOLID POINTS')
00396 104   FORMAT(/,1X,'FRONT2 : ERREUR AU POINT DE BORD ',1I5,
00397      &       /,1X,'         POINT SOLIDE ENTRE DEUX POINTS LIQUIDES')
00398 105   FORMAT(/,1X,'FRONT2 : ERROR AT BOUNDARY POINT ',1I5,
00399      &       /,1X,'         SOLID POINT BETWEEN TWO LIQUID POINTS')
00400 90    FORMAT(/,1X,'FRONTIERE ',1I3,' : ',/,1X,
00401      &            ' DEBUT AU POINT DE BORD ',1I6,
00402      &            ' , DE NUMERO GLOBAL ',1I8,/,1X,
00403      &            ' ET DE COORDONNEES : ',G16.7,3X,G16.7,
00404      &       /,1X,' FIN AU POINT DE BORD ',1I6,
00405      &            ' , DE NUMERO GLOBAL ',1I8,/,1X,
00406      &            ' ET DE COORDONNEES : ',G16.7,3X,G16.7)
00407 190   FORMAT(/,1X,'BOUNDARY ',1I3,' : ',/,1X,
00408      &            ' BEGINS AT BOUNDARY POINT: ',1I6,
00409      &            ' , WITH GLOBAL NUMBER: ',1I8,/,1X,
00410      &            ' AND COORDINATES: ',G16.7,3X,G16.7,
00411      &       /,1X,' ENDS AT BOUNDARY POINT: ',1I6,
00412      &            ' , WITH GLOBAL NUMBER: ',1I8,/,1X,
00413      &            ' AND COORDINATES: ',G16.7,3X,G16.7)
00414 !
00415 !-----------------------------------------------------------------------
00416 !
00417       IF(NFRSOL.GT.MAXFRO.OR.NFRLIQ.GT.MAXFRO) THEN
00418         IF(LNG.EQ.1) THEN
00419           WRITE(LU,*) 'FRONT2 : DEPASSEMENT DE TABLEAUX'
00420           WRITE(LU,*) '         AUGMENTER MAXFRO DANS LE CODE APPELANT'
00421           WRITE(LU,*) '         A LA VALEUR ',MAX(NFRSOL,NFRLIQ)
00422         ENDIF
00423         IF(LNG.EQ.2) THEN
00424           WRITE(LU,*) 'FRONT2: SIZE OF ARRAYS EXCEEDED'
00425           WRITE(LU,*) '        INCREASE MAXFRO IN THE CALLING PROGRAM'
00426           WRITE(LU,*) '        UP TO THE VALUE ',MAX(NFRSOL,NFRLIQ)
00427         ENDIF
00428         CALL PLANTE(1)
00429         STOP
00430       ENDIF
00431 !
00432 !-----------------------------------------------------------------------
00433 !
00434       RETURN
00435       END

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