bord3d.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac3d\bord3d.f
00002 !
00189                      SUBROUTINE BORD3D
00190 !                    *****************
00191 !
00192      &(TIME,LT,ENTET,NPTFR2_DIM,NFRLIQ)
00193 !
00194 !***********************************************************************
00195 ! TELEMAC3D   V7P0                                   09/07/2014
00196 !***********************************************************************
00197 !
00198 !
00199 !
00200 !
00201 !
00202 !
00203 !
00204 !
00205 !
00206 !
00207 !
00208 !
00209 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00210 !| ENTET          |-->| LOGICAL, IF YES INFORMATION IS GIVEN ON MASS
00211 !|                |   | CONSERVATION.
00212 !| LT             |-->| CURRENT TIME STEP NUMBER
00213 !| NFRLIQ         |-->| NUMBER OF LIQUID BOUNDARIES
00214 !| NPTFR2_DIM     |-->| NPTFR2? NOT USED
00215 !| TIME           |-->| TIME OF TIME STEP
00216 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00217 !
00218       USE BIEF
00219       USE DECLARATIONS_TELEMAC
00220       USE DECLARATIONS_TELEMAC3D, EX_NFRLIQ=>NFRLIQ
00221       USE INTERFACE_TELEMAC3D, EX_BORD3D => BORD3D
00222       USE EXCHANGE_WITH_ATMOSPHERE
00223 !
00224       IMPLICIT NONE
00225       INTEGER LNG,LU
00226       COMMON/INFO/LNG,LU
00227 !
00228 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00229 !
00230 !     TIME AND ENTET ARE AT AND INFOGR (NOW IN DECLARATIONS_TELEMAC3D)
00231       DOUBLE PRECISION, INTENT(IN)    :: TIME
00232       INTEGER         , INTENT(IN)    :: LT
00233       LOGICAL         , INTENT(IN)    :: ENTET
00234       INTEGER         , INTENT(IN)    :: NPTFR2_DIM
00235       INTEGER         , INTENT(IN)    :: NFRLIQ
00236 !
00237 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00238 !
00239       INTEGER IPOIN2,NP,IBORD,IVIT,ICOT,IDEB,IFRLIQ,IPROF,K,N
00240       INTEGER IPTFR,ITRAC,IPLAN,I3D
00241       LOGICAL YAZMIN
00242       DOUBLE PRECISION ROEAU,ROAIR,VITV,PROFZ,WINDRELX,WINDRELY
00243 !
00244       DOUBLE PRECISION P_DMIN
00245       INTEGER  P_IMAX
00246       EXTERNAL P_IMAX,P_DMIN
00247       DOUBLE PRECISION STA_DIS_CUR
00248       EXTERNAL STA_DIS_CUR
00249 !
00250 !-----------------------------------------------------------------------
00251 !
00252       DOUBLE PRECISION ZMIN(MAXFRO)
00253 !
00254       INTEGER YADEB(MAXFRO),MSK1,IJK
00255 !
00256 !     DECLARATION RELATED TO HEAT EXCHANGE
00257       DOUBLE PRECISION PATM,HREL,NEBU,RAINFALL,WW2,WINDX,WINDY
00258       DOUBLE PRECISION RAY_ATM,RAY_EAU,FLUX_EVAP,FLUX_SENS,DEBEVAP
00259 !
00260       DOUBLE PRECISION WW,TREEL,A,B,LAMB,RO,SAL
00261 !     DOUBLE PRECISION XB,YB,ZB
00262       INTEGER NFO
00263       INTEGER ITEMP
00264 !
00265 !     SIMPLE CASES FOR LATERAL BOUNDARIES ARE TREATED AUTOMATICALLY:
00266 !
00267 !     - PRESCRIBED DEPTH     (5 4 4)
00268 !     - PRESCRIBED VELOCITY  (  6 6)
00269 !     - PRESCRIBED DISCHARGE (  5 5)
00270 !
00271 !     CORRESPONDING KEYWORDS ARE:
00272 !
00273 !     'PRESCRIBED ELEVATIONS' OR 'COTES IMPOSEES'
00274 !     'PRESCRIBED VELOCITIES' OR 'VITESSES IMPOSEES'
00275 !     'PRESCRIBED FLOWRATES' OR 'DEBITS IMPOSES'
00276 !
00277 !     THE IMPLEMENTATION OF AUTOMATIC CASES MAY BE CANCELLED
00278 !     PROVIDED THAT THE RELEVANT ARRAYS ARE FILLED
00279 !
00280 !
00281 !***********************************************************************
00282 !
00283 !
00284 !           +++++++++++++++++++++++++++++++++++++++++++++++
00285 !              AUTOMATIC TREATMENT OF LIQUID BOUNDARIES
00286 !           +++++++++++++++++++++++++++++++++++++++++++++++
00287 !
00288 !
00289 !=======================================================================
00290 !
00291 !     SECURES NO SLIP BOUNDARY CONDITIONS
00292 !
00293       IF(LT.EQ.1) THEN
00294 !
00295 !     VELOCITIES
00296 !
00297       DO IPTFR = 1,NPTFR2
00298         IPOIN2 = NBOR2%I(IPTFR)
00299         DO IPLAN = 1,NPLAN
00300           IBORD = (IPLAN-1)*NPTFR2 + IPTFR
00301           IF(LIUBOL%I(IBORD).EQ.KADH) UBORL%R(IBORD) = 0.D0
00302           IF(LIVBOL%I(IBORD).EQ.KADH) VBORL%R(IBORD) = 0.D0
00303           IF(LIWBOL%I(IBORD).EQ.KADH) WBORL%R(IBORD) = 0.D0
00304         ENDDO
00305       ENDDO
00306 !
00307       DO IPOIN2 = 1,NPOIN2
00308         IF(LIUBOF%I(IPOIN2).EQ.KADH) UBORF%R(IPOIN2) = 0.D0
00309         IF(LIVBOF%I(IPOIN2).EQ.KADH) VBORF%R(IPOIN2) = 0.D0
00310         IF(LIWBOF%I(IPOIN2).EQ.KADH) WBORF%R(IPOIN2) = 0.D0
00311         IF(LIUBOS%I(IPOIN2).EQ.KADH) UBORS%R(IPOIN2) = 0.D0
00312         IF(LIVBOS%I(IPOIN2).EQ.KADH) VBORS%R(IPOIN2) = 0.D0
00313         IF(LIWBOS%I(IPOIN2).EQ.KADH) WBORS%R(IPOIN2) = 0.D0
00314       ENDDO
00315 !
00316 !     IMPORTANT OPTION:
00317 !     VERTICAL VELOCITIES ARE SET AS HORIZONTAL VELOCITIES
00318 !     THIS IS AN OPTION, OTHERWISE LIWBOL=KSORT (SEE LIMI3D)
00319 !
00320 !     DO IPTFR = 1,NPTFR2
00321 !       IPOIN2 = NBOR2%I(IPTFR)
00322 !       DO IPLAN = 1,NPLAN
00323 !         IBORD = (IPLAN-1)*NPTFR2 + IPTFR
00324 !         LIWBOL%I(IBORD)= LIUBOL%I(IBORD)
00325 !         IF(LIWBOL%I(IBORD).EQ.KENT) WBORL%R(IBORD) = 0.D0
00326 !       ENDDO
00327 !     ENDDO
00328 !
00329 !     TRACERS
00330 !
00331 !     IF(NTRAC.NE.0) THEN
00332 !
00333 !       DO ITRAC = 1,NTRAC
00334 !
00335 !         DO IPTFR = 1,NPTFR2
00336 !           IPOIN2 = NBOR2%I(IPTFR)
00337 !           LITABF%ADR(ITRAC)%P%I(IPOIN2) = KSORT (DOES NOT WORK WITH SEDIMENT)
00338 !           LITABS%ADR(ITRAC)%P%I(IPOIN2) = KSORT
00339 !           DO IPLAN = 1,NPLAN
00340 !             IBORD = (IPLAN-1)*NPTFR2 + IPTFR
00341 !             IF(LITABL%ADR(ITRAC)%P%I(IBORD).EQ.KADH)
00342 !    &           TABORL%ADR(ITRAC)%P%R(IBORD) = 0.D0
00343 !           ENDDO
00344 !         ENDDO
00345 !
00346 !         DO IPOIN2 = 1,NPOIN2
00347 !           IF(LITABF%ADR(ITRAC)%P%I(IPOIN2).EQ.KADH)
00348 !    &                       TABORF%ADR(ITRAC)%P%R(IPOIN2) = 0.D0
00349 !           IF(LITABS%ADR(ITRAC)%P%I(IPOIN2).EQ.KADH)
00350 !    &                       TABORS%ADR(ITRAC)%P%R(IPOIN2) = 0.D0
00351 !         ENDDO
00352 !
00353 !       ENDDO
00354 !
00355 !     ENDIF
00356 !
00357       ENDIF
00358 !
00359 !=======================================================================
00360 !  FOR ALL TIMESTEPS
00361 !=======================================================================
00362 !
00363 !     IF VELOCITY PROFILE OPTION 5: MINIMUM ELEVATION OF EVERY BOUNDARY
00364 !
00365       YAZMIN=.FALSE.
00366       DO IFRLIQ=1,NFRLIQ
00367         ZMIN(IFRLIQ)=1.D99
00368         IF(PROFVEL(IFRLIQ).EQ.5) YAZMIN=.TRUE.
00369       ENDDO
00370       IF(YAZMIN) THEN
00371         DO K=1,NPTFR2
00372           IFRLIQ=NUMLIQ%I(K)
00373           IPOIN2=NBOR2%I(K)
00374           IF(IFRLIQ.NE.0) THEN
00375             ZMIN(IFRLIQ)=MIN(ZMIN(IFRLIQ),ZF%R(IPOIN2)+H%R(IPOIN2))
00376           ENDIF
00377         ENDDO
00378         IF(NCSIZE.GT.1) THEN
00379           DO IFRLIQ=1,NFRLIQ
00380             ZMIN(IFRLIQ)=P_DMIN(ZMIN(IFRLIQ))
00381           ENDDO
00382         ENDIF
00383       ENDIF
00384 !
00385 !     INITIALISES YADEB
00386 !
00387       IF(NFRLIQ.GE.1) THEN
00388         DO K=1,NFRLIQ
00389           YADEB(K)=0
00390         ENDDO
00391       ENDIF
00392 !
00393       IDEB=0
00394       ICOT=0
00395       IVIT=0
00396 !
00397 !     LOOP ON ALL 2D BOUNDARY POINTS
00398 !
00399       DO K=1,NPTFR2
00400 !
00401 !     PRESCRIBED ELEVATION GIVEN IN STEERING FILE (NCOTE<>0)
00402 !     -------------------------------------------------------
00403 !
00404       IF(LIHBOR%I(K).EQ.KENT.AND.NCOTE.NE.0) THEN
00405 !
00406         IPOIN2 = NBOR2%I(K)
00407         ICOT=NUMLIQ%I(K)
00408         IF(STA_DIS_CURVES(ICOT).EQ.1) THEN
00409           HBOR%R(K) = STA_DIS_CUR(ICOT,FLUX_BOUNDARIES(ICOT),
00410      &                            PTS_CURVES(ICOT),QZ,NFRLIQ,
00411      &                            ZF%R(IPOIN2)+H%R(IPOIN2))
00412      &                - ZF%R(IPOIN2)
00413           HBOR%R(K) = MAX(0.D0,HBOR%R(K))
00414         ELSEIF(NCOTE.GE.NUMLIQ%I(K)) THEN
00415           N=IPOIN2
00416           IF(NCSIZE.GT.1) N=MESH2D%KNOLG%I(N)
00417           HBOR%R(K) = SL3(ICOT,AT,N,INFOGR)-ZF%R(IPOIN2)
00418           HBOR%R(K) = MAX(0.D0,HBOR%R(K))
00419         ELSE
00420           IF(LNG.EQ.1) WRITE(LU,100) NUMLIQ%I(K)
00421 100       FORMAT(1X,'BORD3D : COTES IMPOSEES EN NOMBRE INSUFFISANT',/,
00422      &           1X,'         DANS LE FICHIER DES PARAMETRES',/,
00423      &           1X,'         IL EN FAUT AU MOINS : ',1I6,/,
00424      &           1X,'         AUTRE POSSIBILITE :',/,
00425      &           1X,'         FICHIER DES COURBES DE TARAGE MANQUANT')
00426           IF(LNG.EQ.2) WRITE(LU,101) NUMLIQ%I(K)
00427 101       FORMAT(1X,'BORD3D: MORE PRESCRIBED ELEVATIONS ARE REQUIRED',/,
00428      &           1X,'        IN THE PARAMETER FILE',/,
00429      &           1X,'        AT LEAST ',1I6,' MUST BE GIVEN',/,
00430      &           1X,'        OTHER POSSIBILITY:',/,
00431      &           1X,'        STAGE-DISCHARGE CURVES FILE MISSING')
00432           CALL PLANTE(1)
00433           STOP
00434         ENDIF
00435 !
00436       ENDIF
00437 !
00438       ENDDO
00439 !
00440 !     PRESCRIBED DISCHARGE GIVEN IN STEERING FILE (NDEBIT<>0)
00441 !     --------------------------------------------------------
00442 !
00443       DO K=1,NPTFR2
00444 !
00445 !     A VELOCITY PROFILE IS SET HERE AND WILL BE CORRECTED LATER
00446 !     TO GET THE CORRECT DISCHARGE (CALL TO DEBIMP3D)
00447 !
00448       IF(LIUBOL%I(K).EQ.KENT.AND.NDEBIT.NE.0) THEN
00449 !
00450         IPOIN2 = NBOR2%I(K)
00451         DO NP=1,NPLAN
00452           IJK=(NP-1)*NPTFR2+K
00453           I3D=(NP-1)*NPOIN2+IPOIN2
00454           IFRLIQ=NUMLIQ%I(K)
00455           IF(PROFVEL(IFRLIQ).EQ.2) THEN
00456 !           GIVEN BY USER IN BOUNDARY CONDITIONS FILE
00457             UBORL%R(IJK) = UBOR2D%R(K+NPTFR2)
00458             VBORL%R(IJK) = VBOR2D%R(K+NPTFR2)
00459           ELSEIF(PROFVEL(IFRLIQ).EQ.3) THEN
00460 !           NORMAL AND NORM GIVEN BY UBOR IN BOUNDARY CONDITIONS FILE
00461             UBORL%R(IJK) = -XNEBOR2%R(K)*UBOR2D%R(K+NPTFR2)
00462             VBORL%R(IJK) = -YNEBOR2%R(K)*UBOR2D%R(K+NPTFR2)
00463           ELSEIF(PROFVEL(IFRLIQ).EQ.4) THEN
00464 !           NORMAL AND PROPORTIONAL TO SQRT(H)
00465             UBORL%R(IJK)=-XNEBOR2%R(K) * SQRT(MAX(H%R(IPOIN2),0.D0))
00466             VBORL%R(IJK)=-YNEBOR2%R(K) * SQRT(MAX(H%R(IPOIN2),0.D0))
00467           ELSEIF(PROFVEL(IFRLIQ).EQ.5) THEN
00468 !           NORMAL PROFILE IN SQUARE ROOT OF H, BUT VIRTUAL H
00469 !           DEDUCED FROM LOWEST FREE SURFACE OF THE BOUNDARY
00470             UBORL%R(IJK)=-XNEBOR2%R(K) *
00471      &                   SQRT(MAX(ZMIN(IFRLIQ)-ZF%R(IPOIN2),0.D0))
00472             VBORL%R(IJK)=-YNEBOR2%R(K) *
00473      &                   SQRT(MAX(ZMIN(IFRLIQ)-ZF%R(IPOIN2),0.D0))
00474           ELSE
00475 !           NORMAL AND NORM 1
00476             UBORL%R(IJK)=-XNEBOR2%R(K)
00477             VBORL%R(IJK)=-YNEBOR2%R(K)
00478           ENDIF
00479 !         NO VELOCITY IF NO WATER
00480           IF(H%R(IPOIN2).LT.1.D-4) THEN
00481             UBORL%R(IJK) = 0.D0
00482             VBORL%R(IJK) = 0.D0
00483           ENDIF
00484 !         CASE OF A VERTICAL PROFILE
00485           IF(VERPROVEL(IFRLIQ).NE.1) THEN
00486             PROFZ=VEL_PROF_Z(IFRLIQ,NBOR2%I(K),
00487      &                       AT,LT,NP,INFOGR,VERPROVEL(IFRLIQ))
00488             UBORL%R(IJK) = UBORL%R(IJK)*PROFZ
00489             VBORL%R(IJK) = VBORL%R(IJK)*PROFZ
00490           ENDIF
00491 !         U AND V INITIALISED WITH PRESCRIBED VALUES (FOR DEBIMP3D)
00492 !         WILL BE CHANGED AGAIN AFTER DEBIMP3D
00493           U%R(I3D)=UBORL%R(IJK)
00494           V%R(I3D)=VBORL%R(IJK)
00495         ENDDO
00496 !
00497         YADEB(NUMLIQ%I(K))=1
00498 !
00499       ENDIF
00500 !
00501       ENDDO
00502 !
00503 !     PRESCRIBED VELOCITY GIVEN IN STEERING FILE (NVIT<>0)
00504 !     -----------------------------------------------------
00505 !
00506       DO K=1,NPTFR2
00507 !
00508 !     THIS VELOCITY IS CONSIDERED NORMAL TO THE BOUNDARY
00509 !
00510       IF(LIUBOL%I(K).EQ.KENTU.AND.NVIT.NE.0) THEN
00511         IVIT=NUMLIQ%I(K)
00512         IF(NVIT.GE.IVIT) THEN
00513           DO NP=1,NPLAN
00514             IBORD = (NP-1)*NPTFR2+K
00515             IF(NCSIZE.GT.1) THEN
00516               N=MESH2D%KNOLG%I(NBOR2%I(K))+(NP-1)*NPOIN2
00517             ELSE
00518               N=NBOR3%I(IBORD)
00519             ENDIF
00520             UBORL%R(IBORD)=-MESH2D%XNEBOR%R(K)*VIT3(IVIT,AT,N,INFOGR)
00521             VBORL%R(IBORD)=-MESH2D%YNEBOR%R(K)*VIT3(IVIT,AT,N,INFOGR)
00522             WBORL%R(IBORD)=0.D0
00523           ENDDO
00524         ELSE
00525           IF(LNG.EQ.1) WRITE(LU,200) NUMLIQ%I(K)
00526 200       FORMAT(1X,'BORD3D : VITESSES IMPOSEES EN NOMBRE INSUFFISANT',
00527      &           /,1X,'       DANS LE FICHIER DES PARAMETRES',
00528      &           /,1X,'       IL EN FAUT AU MOINS : ',1I6)
00529           IF(LNG.EQ.2) WRITE(LU,201) NUMLIQ%I(K)
00530 201       FORMAT(1X,'BORD3D : MORE PRESCRIBED VELOCITIES ARE REQUIRED',
00531      &           /,1X,'       IN THE PARAMETER FILE',
00532      &           /,1X,'       AT LEAST ',1I6,' MUST BE GIVEN')
00533           CALL PLANTE(1)
00534           STOP
00535         ENDIF
00536       ENDIF
00537 !
00538       ENDDO
00539 !
00540 !     PRESCRIBED TRACER GIVEN IN STEERING FILE,
00541 !     BUT POSSIBLE OVERWRITING IF LIQUID BOUNDARY FILE IS GIVEN
00542 !     SEE FUNCTION TR3
00543 !     -------------------------------------------------------
00544 !
00545       IF(NTRAC.GT.0.AND.NTRACER.GT.0) THEN
00546         DO ITRAC=1,NTRAC
00547         DO K=1,NPTFR2
00548         DO NP=1,NPLAN
00549           IBORD = (NP-1)*NPTFR2+K
00550           IF(LITABL%ADR(ITRAC)%P%I(IBORD).EQ.KENT) THEN
00551             IFRLIQ=NUMLIQ%I(K)
00552             IF(IFRLIQ.EQ.0) THEN
00553               IF(LNG.EQ.1) WRITE(LU,298) IBORD
00554 298           FORMAT(1X,'BORD3D : VALEURS IMPOSEES DU TRACEUR',/,
00555      &               1X,'         SUR PAROI SOLIDE',/,
00556      &               1X,'         AU POINT DE BORD ',1I6)
00557               IF(LNG.EQ.2) WRITE(LU,299) IBORD
00558 299           FORMAT(1X,'BORD3D: PRESCRIBED TRACER VALUE',/,
00559      &               1X,'        ON A SOLID BOUNDARY',/,
00560      &               1X,'        AT BOUNDARY POINT ',1I6)
00561               CALL PLANTE(1)
00562               STOP
00563             ENDIF
00564             IF(NTRACER.GE.IFRLIQ*NTRAC) THEN
00565               IF(NCSIZE.GT.1) THEN
00566                 N=MESH2D%KNOLG%I(NBOR2%I(K))+(NP-1)*NPOIN2
00567               ELSE
00568                 N=NBOR3%I(IBORD)
00569               ENDIF
00570               TABORL%ADR(ITRAC)%P%R(IBORD)=
00571      &                                   TR3(IFRLIQ,ITRAC,N,AT,INFOGR)
00572             ELSE
00573               IF(LNG.EQ.1) WRITE(LU,300) NUMLIQ%I(K)*NTRAC
00574 300           FORMAT(1X,'BORD3D : VALEURS IMPOSEES DU TRACEUR',/,
00575      &               1X,'         EN NOMBRE INSUFFISANT',/,
00576      &               1X,'         DANS LE FICHIER DES PARAMETRES',/,
00577      &               1X,'         IL EN FAUT AU MOINS : ',1I6)
00578               IF(LNG.EQ.2) WRITE(LU,301) NUMLIQ%I(K)
00579 301           FORMAT(1X,'BORD3D: MORE PRESCRIBED TRACER VALUES',/,
00580      &               1X,'        ARE REQUIRED IN THE PARAMETER FILE',/,
00581      &               1X,'        AT LEAST ',1I6,' MUST BE GIVEN')
00582               CALL PLANTE(1)
00583               STOP
00584             ENDIF
00585 !           CASE OF A PROFILE ON THE VERTICAL
00586             IPROF=VERPROTRA(ITRAC+(IFRLIQ-1)*NTRAC)
00587             IF(IPROF.NE.1) THEN
00588               PROFZ=TRA_PROF_Z(IFRLIQ,NBOR2%I(K),AT,LT,NP,
00589      &                         INFOGR,IPROF,ITRAC)
00590               IF(IPROF.EQ.2.OR.IPROF.EQ.0) THEN
00591 !               Rouse concentrations profiles (IPROF=2) or values given by user (IPROF=0)
00592                 TABORL%ADR(ITRAC)%P%R(IBORD)=PROFZ
00593               ELSEIF(IPROF.EQ.3) THEN
00594 !               Normalised concentrations profiles (IPROF=3)
00595                 TABORL%ADR(ITRAC)%P%R(IBORD)=
00596      &          TABORL%ADR(ITRAC)%P%R(IBORD)*PROFZ
00597               ELSE
00598                 WRITE(LU,*) 'BORD3D : IPROF=',IPROF
00599                 IF(LNG.EQ.1) THEN
00600                   WRITE(LU,*) 'OPTION INCONNUE POUR LES'
00601                   WRITE(LU,*) 'PROFILS DES TRACEURS SUR LA VERTICALE'
00602                 ENDIF
00603                 IF(LNG.EQ.2) THEN
00604                   WRITE(LU,*) 'UNKNOWN OPTION FOR THE'
00605                   WRITE(LU,*) 'TRACERS VERTICAL PROFILES'
00606                 ENDIF
00607                 CALL PLANTE(1)
00608                 STOP
00609               ENDIF
00610             ENDIF
00611           ENDIF
00612 !
00613         ENDDO
00614         ENDDO
00615         ENDDO
00616       ENDIF
00617 !
00618 !-----------------------------------------------------------------------
00619 !
00620 !     AUTOMATIC TIDAL BOUNDARY CONDITIONS
00621 !
00622       IF(TIDALTYPE.GE.1) CALL TIDAL_MODEL_T3D()
00623 !
00624 !-----------------------------------------------------------------------
00625 !
00626 !     PRESCRIBED DISCHARGES: FINAL TREATMENT OF VELOCITIES
00627 !     ----------------------------------------------------
00628 !
00629 !     LOOP ON LIQUID BOUNDARIES
00630 !
00631       IF(NFRLIQ.NE.0) THEN
00632       DO IFRLIQ = 1 , NFRLIQ
00633 !
00634       IF(NDEBIT.NE.0) THEN
00635 !
00636         MSK1=1
00637         IF(NDEBIT.GE.IFRLIQ) THEN
00638           IF(NCSIZE.GT.1) YADEB(IFRLIQ)=P_IMAX(YADEB(IFRLIQ))
00639            IF(YADEB(IFRLIQ).EQ.1) THEN
00640            CALL DEBIMP_3D(Q3(IFRLIQ,AT,INFOGR),
00641      &                    UBORL%R,VBORL%R,WBORL%R,
00642      &                    U,V,NUMLIQ%I,NUMLIQ_ELM%I,IFRLIQ,T3_02,
00643      &                    NPTFR2,NETAGE,MASK_3D%ADR(MSK1)%P,
00644      &                    MESH3D,EQUA,IELM2V,SVIDE,MASKTR,
00645      &                    MESH3D%NELEB)
00646            ENDIF
00647           ELSE
00648           IF(LNG.EQ.1) WRITE(LU,400) IFRLIQ
00649 400       FORMAT(1X,'BORD3D : DEBITS IMPOSES',/,
00650      &           1X,'       EN NOMBRE INSUFFISANT',/,
00651      &           1X,'       DANS LE FICHIER DES PARAMETRES',/,
00652      &           1X,'       IL EN FAUT AU MOINS : ',1I6)
00653           IF(LNG.EQ.2) WRITE(LU,401) IFRLIQ
00654 401       FORMAT(1X,'BORD3D : MORE PRESCRIBED FLOWRATES',/,
00655      &           1X,'       ARE REQUIRED IN THE PARAMETER FILE',/,
00656      &           1X,'       AT LEAST ',1I6,' MUST BE GIVEN')
00657           CALL PLANTE(1)
00658           STOP
00659         ENDIF
00660       ENDIF
00661 !
00662       ENDDO ! IFRLIQ
00663       ENDIF
00664 !
00665 !     RESETS BOUNDARY CONDITIONS ON U AND V (WILL BE USED BY TFOND
00666 !     AND OTHER SUBROUTINES BEFORE THE NEXT BOUNDARY CONDITIONS TREATMENT)
00667 !
00668       DO K=1,NPTFR2
00669         IF(LIUBOL%I(K).EQ.KENT) THEN
00670           DO NP=1,NPLAN
00671             IJK=(NP-1)*NPTFR2+K
00672             U%R((NP-1)*NPOIN2+NBOR2%I(K))=UBORL%R(IJK)
00673             V%R((NP-1)*NPOIN2+NBOR2%I(K))=VBORL%R(IJK)
00674           ENDDO
00675         ENDIF
00676       ENDDO
00677 !
00678 !     EXAMPLE OF PRESCRIBED VERTICAL VELOCITIES AT ENTRANCES
00679 !     VELOCITIES TANGENT TO BOTTOM AND FREE SURFACE
00680 !
00681 !     DO K=1,NPTFR2
00682 !       IF(LIWBOL%I(K).EQ.KENT.OR.LIWBOL%I(K).EQ.KENTU) THEN
00683 !         DO NP=1,NPLAN
00684 !             IJK=(NP-1)*NPTFR2+K
00685 !             I2D=NBOR2%I(K)
00686 !             I3D=(NP-1)*NPOIN2+I2D
00687 !             WBORL DEDUCED FROM FREE SURFACE AND BOTTOM
00688 !             TETA=(Z(I3D)-Z(I2D))/
00689 !    *        MAX(1.D-3,Z((NPLAN-1)*NPOIN2+I2D)-Z(I2D))
00690 !             GX=        TETA *GRADZN%ADR(1)%P%R(I2D)
00691 !    *            +(1.D0-TETA)*GRADZF%ADR(1)%P%R(I2D)
00692 !             GY=        TETA *GRADZN%ADR(2)%P%R(I2D)
00693 !    *            +(1.D0-TETA)*GRADZF%ADR(2)%P%R(I2D)
00694 !             WBORL%R(IJK)=UBORL%R(IJK)*GX+VBORL%R(IJK)*GY
00695 !         ENDDO
00696 !       ENDIF
00697 !     ENDDO
00698 !
00699 !           +++++++++++++++++++++++++++++++++++++++++++++++
00700 !           END OF AUTOMATIC TREATMENT OF LIQUID BOUNDARIES
00701 !           +++++++++++++++++++++++++++++++++++++++++++++++
00702 !
00703 !
00704 !
00705 !           +++++++++++++++++++++++++++++++++++++++++++++++
00706 !                               WIND
00707 !           +++++++++++++++++++++++++++++++++++++++++++++++
00708 !
00709       IF(VENT) THEN
00710         ROEAU = 1000.D0
00711         ROAIR = 1.3D0
00712         DO IPOIN2 = 1,NPOIN2
00713 !         RELATIVE WIND
00714           WINDRELX=WIND%ADR(1)%P%R(IPOIN2)-U%R(NPOIN3-NPOIN2+IPOIN2)
00715           WINDRELY=WIND%ADR(2)%P%R(IPOIN2)-V%R(NPOIN3-NPOIN2+IPOIN2)
00716           VITV=SQRT(WINDRELX**2+WINDRELY**2)
00717 !         A MORE ACCURATE TREATMENT
00718 !         IF(VITV.LE.5.D0) THEN
00719 !           FAIR = ROAIR/ROEAU*0.565D-3
00720 !         ELSEIF (VITV.LE.19.22D0) THEN
00721 !           FAIR = ROAIR/ROEAU*(-0.12D0+0.137D0*VITV)*1.D-3
00722 !         ELSE
00723 !           FAIR = ROAIR/ROEAU*2.513D-3
00724 !         ENDIF
00725 !         BEWARE : BUBORS IS VISCVI*DU/DN, NOT DU/DN
00726           IF(H%R(IPOIN2).GT.HWIND) THEN
00727 !           EXPLICIT PART
00728             BUBORS%R(IPOIN2) =  FAIR*VITV*WIND%ADR(1)%P%R(IPOIN2)
00729             BVBORS%R(IPOIN2) =  FAIR*VITV*WIND%ADR(2)%P%R(IPOIN2)
00730 !           IMPLICIT PART
00731             AUBORS%R(IPOIN2) = -FAIR*VITV
00732             AVBORS%R(IPOIN2) = -FAIR*VITV
00733           ELSE
00734             BUBORS%R(IPOIN2) = 0.D0
00735             BVBORS%R(IPOIN2) = 0.D0
00736             AUBORS%R(IPOIN2) = 0.D0
00737             AVBORS%R(IPOIN2) = 0.D0
00738           ENDIF
00739         ENDDO
00740       ENDIF
00741 !
00742 !
00743 !           +++++++++++++++++++++++++++++++++++++++++++++++
00744 !                         END OF WIND TREATMENT
00745 !           +++++++++++++++++++++++++++++++++++++++++++++++
00746 !
00747 !
00748 !
00749 !
00750 !           +++++++++++++++++++++++++++++++++++++++++++++++
00751 !                     HEAT EXCHANGE WITH ATMOSPHERE
00752 !           +++++++++++++++++++++++++++++++++++++++++++++++
00753 !
00754 !
00755 !                 LINES BELOW ARE AN EXAMPLE
00756 !                                    =======
00757 !    TO BE GIVEN :
00758 !
00759 !    ITEMP = NUMBER OF TRACER WHICH IS THE HEAT
00760 !    TAIR  = AIR TEMPERATURE WHICH MAY VARY WITH TIME
00761 !    SAL   = SALINITY WHICH MAY VARY WITH TIME
00762 !
00763       IF (ATMOSEXCH.EQ.1.OR.ATMOSEXCH.EQ.2) THEN
00764 !       READING OF INPUT DATA FILE
00765         NFO = T3D_FILES(T3DFO1)%LU   ! FORMATTED DATA FILE 1
00766         CALL INTERPMETEO(WW,WINDX,WINDY,
00767      &                   TAIR,PATM,HREL,NEBU,RAINFALL,AT,NFO)
00768         ITEMP = 1
00769 !       LOG LAW FOR WIND AT 2 METERS
00770 !        WW2 = WW * LOG(2.D0/0.0002D0)/LOG(10.D0/0.0002D0)
00771 !       WRITTEN BELOW AS:
00772         WW2 = WW * LOG(1.D4)/LOG(5.D4)
00773 !       ALTERNATIVE LAW FOR WIND AT 2 METERS
00774 !        WW2 = 0.6D0*WW
00775         DO IPOIN2=1,NPOIN2
00776           TREEL=TA%ADR(ITEMP)%P%R(NPOIN3-NPOIN2+IPOIN2)
00777 !          SAL = 35.D-3 ! EXAMPLE OF SEA SALINITY
00778           SAL = 0.D0
00779           RO = RO0*(1.D0-(7.D0*(TREEL-4.D0)**2-750.D0*SAL)*1.D-6)
00780           LAMB=RO*CP
00781 
00782           IF(ATMOSEXCH.EQ.1) THEN
00783             A=(4.48D0+0.049D0*TREEL)+2021.5D0*C_ATMOS*(1.D0+WW)*
00784      &        (1.12D0+0.018D0*TREEL+0.00158D0*TREEL**2)
00785             ATABOS%ADR(ITEMP)%P%R(IPOIN2)=-A/LAMB
00786             BTABOS%ADR(ITEMP)%P%R(IPOIN2)= A*TAIR/LAMB
00787           ELSEIF(ATMOSEXCH.EQ.2) THEN
00788 !     SENSIBLE HEAT FLUXES
00789             CALL EVAPO(TREEL,TAIR,WW2,PATM,HREL,RO,
00790      &                 FLUX_EVAP,FLUX_SENS,DEBEVAP,C_ATMOS)
00791 !     LONGWAVE HEAT FLUXES
00792             CALL SHORTRAD(TREEL,TAIR,NEBU,RAY_ATM,RAY_EAU)
00793 !
00794 !     BOUNDARY CONDITION FOR TEMPERATURE AT SURFACE
00795             ATABOS%ADR(ITEMP)%P%R(IPOIN2) = 0.D0
00796             BTABOS%ADR(ITEMP)%P%R(IPOIN2) = (RAY_ATM-RAY_EAU-FLUX_EVAP
00797      &                                      -FLUX_SENS)/LAMB
00798           ENDIF
00799         ENDDO
00800       ENDIF
00801 !     IMPORTANT:
00802 !     STATES THAT ATABOS AND BTABOS ARE NOT ZERO (SEE LIMI3D AND DIFF3D)
00803 !     OTHERWISE THEY WILL NOT BE CONSIDERED
00804       IF(ATMOSEXCH.EQ.1.OR.ATMOSEXCH.EQ.2) THEN
00805         ATABOS%ADR(ITEMP)%P%TYPR='Q'
00806         BTABOS%ADR(ITEMP)%P%TYPR='Q'
00807       ENDIF
00808 !
00809 !
00810 !           +++++++++++++++++++++++++++++++++++++++++++++++
00811 !                 END OF HEAT EXCHANGE WITH ATMOSPHERE
00812 !           +++++++++++++++++++++++++++++++++++++++++++++++
00813 !
00814 !
00815 !
00816 !-----------------------------------------------------------------------
00817 !
00818 !     OPTIMISATION:
00819 !
00820 !     EXPLICIT STRESSES WILL NOT BE TREATED IF SAID TO BE 0
00821 !
00822 !     EXPLICIT STRESSES SET TO 0 ON VELOCITIES (UNLESS PROGRAMMED
00823 !                                               IN THIS SUBROUTINE):
00824 !
00825       BUBORF%TYPR='0'
00826       BUBORL%TYPR='0'
00827       BVBORF%TYPR='0'
00828       BVBORL%TYPR='0'
00829       BWBORF%TYPR='0'
00830       BWBORL%TYPR='0'
00831       BWBORS%TYPR='0'
00832 !
00833 !     CASE OF WIND (SEE ABOVE)
00834 !
00835       IF(VENT) THEN
00836         BUBORS%TYPR='Q'
00837         BVBORS%TYPR='Q'
00838         AUBORS%TYPR='Q'
00839         AVBORS%TYPR='Q'
00840       ELSE
00841         BUBORS%TYPR='0'
00842         BVBORS%TYPR='0'
00843       ENDIF
00844 !
00845 !-----------------------------------------------------------------------
00846 !
00847       RETURN
00848       END

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