bord_tidal_bc.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac2d\bord_tidal_bc.f
00002 !
00055                      SUBROUTINE BORD_TIDAL_BC
00056 !                    ************************
00057 !
00058      &(NBOR,LIHBOR,LIUBOR,NPTFR,
00059      & KENT,KENTU,MESH,GEOSYST,NUMZONE,LAMBD0,PHI0,TIDALTYPE,
00060      & BOUNDARY_COLOUR,MAXFRO,NFO2,NBI2,NRFO,XSHIFT,YSHIFT,BETA)
00061 !
00062 !***********************************************************************
00063 ! TELEMAC2D   V6P2                                   18/11/2010
00064 !***********************************************************************
00065 !
00066 !
00067 !
00068 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00069 !| BETA           |<->| ANGLE (IN DEGREES) BETWEEN LAMBERT AND
00070 !|                |   | MERCATOR-JMJ REFERENCES
00071 !|                |   | (EAST OR X AXES, TRIGONOMETRIC)
00072 !| BOUNDARY_COLOUR|-->| AN INTEGER LINKED TO BOUNDARY POINTS
00073 !|                |   | BY DEFAULT THE LAST LINE OF BOUNDARY CONDITIONS
00074 !|                |   | FILE, HENCE THE GLOBAL BOUNDARY NUMBER, BUT CAN
00075 !|                |   | BE CHANGED BY USER.
00076 !| KENT           |-->| CONVENTION FOR LIQUID INPUT WITH PRESCRIBED VALUE
00077 !| KENTU          |-->| CONVENTION FOR LIQUID INPUT WITH PRESCRIBED VELOCITY
00078 !| GEOSYST        |-->| TYPE OF GEOGRAPHIC SYSTEM (WGS84 LONG/LAT, UTM OR LAMBERT)
00079 !| LAMBD0         |-->| LATITUDE OF ORIGIN POINT (KEYWORD, IN DEGREES)
00080 !| LIHBOR         |-->| TYPE OF BOUNDARY CONDITIONS ON DEPTH
00081 !| LIUBOR         |-->| TYPE OF BOUNDARY CONDITIONS ON U
00082 !| MAXFRO         |-->| MAXIMUM NUMBER OF BOUNDARIES
00083 !| MESH           |-->| MESH STRUCTURE
00084 !| NBOR           |-->| GLOBAL NUMBER OF BOUNDARY POINTS
00085 !| NFO2           |-->| LOGICAL UNIT OF TIDE DATA BASE FILE
00086 !| NBI2           |-->| LOGICAL UNIT OF TIDAL MODEL FILE
00087 !| NRFO           |-->| LOGICAL UNIT OF HARMONIC CONSTANTS FILE
00088 !| NPTFR          |-->| NUMBER OF BOUNDARY POINTS
00089 !| NUMZONE        |-->| NUMBER OF ZONE WHEN PLANE PROJECTION (UTM OR LAMBERT)
00090 !| PHI0           |-->| LONGITUDE OF ORIGIN POINT (KEYWORD, IN DEGREES)
00091 !| TIDALTYPE      |-->| TYPE OF TIDE TO MODEL
00092 !| ZF             |-->| BOTTOM TOPOGRAPHY
00093 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00094 !
00095       USE INTERFACE_TELEMAC2D, EX_BORD_TIDAL_BC => BORD_TIDAL_BC
00096       USE BIEF
00097 !
00098       IMPLICIT NONE
00099       INTEGER LNG,LU
00100       COMMON/INFO/LNG,LU
00101 !
00102 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00103 !
00104       INTEGER, INTENT(IN)            :: NPTFR,NFO2,NBI2,NRFO
00105       INTEGER, INTENT(IN)            :: KENT,KENTU,MAXFRO
00106       INTEGER, INTENT(IN)            :: GEOSYST,NUMZONE,TIDALTYPE
00107       INTEGER, INTENT(IN)            :: LIHBOR(NPTFR),LIUBOR(NPTFR)
00108       INTEGER, INTENT(IN)            :: NBOR(NPTFR)
00109       DOUBLE PRECISION, INTENT(IN)   :: XSHIFT,YSHIFT,LAMBD0,PHI0
00110       DOUBLE PRECISION, INTENT(INOUT):: BETA
00111       TYPE(BIEF_OBJ), INTENT(IN)     :: BOUNDARY_COLOUR
00112       TYPE(BIEF_MESH), INTENT(INOUT) :: MESH
00113 !
00114 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00115 !
00116       INTEGER K,I,J,NNBTIDE,NELEM,ECKEN,NDUM,NBV1,NBV2,PARAM(10),NPOIN2
00117       INTEGER N1,N2,N3,IELEP
00118       INTEGER, PARAMETER :: NPOINJMJ=15350
00119       INTEGER CJMJ(NPOINJMJ,24)
00120       INTEGER, ALLOCATABLE :: IPOBO(:),NBTIDE(:),IKLESA(:,:)
00121       INTEGER, ALLOCATABLE :: FIRSTTIDE(:),LASTTIDE(:)
00122 !
00123       DOUBLE PRECISION X1,X2,X3,Y1,Y2,Y3,PI,DTR,RTD,REARTH
00124       DOUBLE PRECISION XM,YM,DIS,A1,A2,A3,DISEL,ZP,XL,YL
00125       DOUBLE PRECISION XO,YO,ALPHA
00126       DOUBLE PRECISION AF(25),PF(25),COEF(24),COEFM(24)
00127       DOUBLE PRECISION, ALLOCATABLE :: SURFAC(:)
00128       DOUBLE PRECISION, ALLOCATABLE :: XTIDE(:),YTIDE(:),ZTIDE(:)
00129       DOUBLE PRECISION, ALLOCATABLE :: LAMBDA(:),PHI(:)
00130       DOUBLE PRECISION, ALLOCATABLE :: XBTIDE(:),YBTIDE(:)
00131 !
00132       REAL TPS
00133       REAL, ALLOCATABLE :: XTIDER(:),YTIDER(:),ZTIDER(:)
00134 !
00135       LOGICAL DEJA_TBC
00136       DATA    DEJA_TBC /.FALSE./
00137 !
00138       SAVE FIRSTTIDE,LASTTIDE
00139       SAVE DEJA_TBC
00140 !
00141 !-----------------------------------------------------------------------
00142 !
00143       IF(.NOT.DEJA_TBC) THEN
00144 !
00145       IF(NCSIZE.GT.1) THEN
00146         IF(LNG.EQ.1) THEN
00147           WRITE(LU,*) 'LA SUBROUTINE BORD_TIDAL_BC'
00148           WRITE(LU,*) 'N EST PAS ENCORE IMPLEMENTEE EN MODE PARALLELE'
00149           WRITE(LU,*) 'AGIR EN 2 ETAPES :'
00150           WRITE(LU,*)
00151      &       '- MODE SEQUENTIEL POUR GENERER LES CONSTANTES HARMONIQUES'
00152           WRITE(LU,*)
00153      &       '- ENSUITE MODE SCALAIRE OU PARALLELE POUR LA SIMULATION'
00154         ENDIF
00155         IF(LNG.EQ.2) THEN
00156           WRITE(LU,*) 'SUBROUTINE BORD_TIDAL_BC'
00157           WRITE(LU,*) 'HAS NOT BEEN IMPLEMENTED IN PARALLEL MODE YET'
00158           WRITE(LU,*) 'PLEASE USE 2 STEPS:'
00159           WRITE(LU,*)  '- SCALAR MODE TO GENERATE HARMONIC CONSTANT'
00160           WRITE(LU,*)  '- THEN SCALAR OR PARALLEL MODE FOR SIMULATION'
00161         ENDIF
00162         CALL PLANTE(1)
00163         STOP
00164       ENDIF
00165 !
00166       PI  = ATAN(1.D0)*4.D0
00167       DTR = PI/180.D0
00168       RTD = 180.D0/PI
00169       REARTH = 6.37D6
00170 !
00171 !-----------------------------------------------------------------------
00172 !
00173 !  SPECIFIC VALUES FOR THE EXAMPLE OF A GEOGRAPHIC SYSTEM DEFINED BY
00174 !  THE USER
00175 !
00176       XO =  1.2D0
00177       YO = 50.D0
00178 !  ANGLE BETWEEN EAST AXIS ---> X AXIS (TRIGONOMETRIC DEGREES)
00179       ALPHA = 40.D0
00180       ALPHA = ALPHA*DTR ! IN RADIANS
00181 !
00182 !-----------------------------------------------------------------------
00183 !
00184 !     OPEN (57,FILE='../coord_liquid_nodes_Mercator_JMJ.txt')
00185 !
00186       ALLOCATE(XBTIDE(NPTFR))
00187       ALLOCATE(YBTIDE(NPTFR))
00188       ALLOCATE(NBTIDE(NPTFR))
00189 !
00190       ALLOCATE(LAMBDA(NPTFR))
00191       ALLOCATE(PHI(NPTFR))
00192 !
00193       ALLOCATE(FIRSTTIDE(MAXFRO))
00194       ALLOCATE(LASTTIDE(MAXFRO))
00195 !
00196       I = 0
00197       J = 0
00198 !
00199 !  LOOP ON ALL BOUNDARY POINTS
00200 !
00201       DO K=1,NPTFR
00202 !
00203 !  LEVEL IMPOSED WITH VALUE GIVEN IN THE CAS FILE (NCOTE0)
00204 !
00205 !  VELOCITY IMPOSED: ONE USES THE OUTGOING DIRECTION
00206 !                    PROVIDED BY THE USER.
00207 !
00208         IF(LIHBOR(K).EQ.KENT.OR.LIUBOR(K).EQ.KENTU) THEN
00209           I = I + 1
00210 !
00211           NBTIDE(I) = K
00212           XBTIDE(I) = MESH%X%R(NBOR(K))
00213           YBTIDE(I) = MESH%Y%R(NBOR(K))
00214 !
00215 !$$$            IF(BOUNDARY_COLOUR%I(K).EQ.1) THEN
00216           IF(    K.EQ.1
00217      &       .OR.(LIHBOR(K-1).NE.KENT.AND.LIUBOR(K-1).NE.KENTU)) THEN
00218             J = J + 1
00219             FIRSTTIDE(J) = K
00220           ENDIF
00221 !
00222           IF(    K.EQ.NPTFR
00223      &       .OR.(LIHBOR(K+1).NE.KENT.AND.LIUBOR(K+1).NE.KENTU)) THEN
00224             LASTTIDE(J)  = K
00225           ENDIF
00226         ENDIF
00227       ENDDO
00228 !  NUMBER OF LIQUID BOUNDARY POINTS WITH TIDE
00229       NNBTIDE = I
00230 !
00231       WRITE(NRFO,'(I4)') J
00232 !
00233       DO I=1,J
00234         WRITE(NRFO,'(I8,I10)') FIRSTTIDE(I),LASTTIDE(I)
00235       ENDDO
00236 !
00237 !     READ JMJ DATABASE MESH
00238 !
00239 !     MESH FILE, READ UNTIL 10 PARAMETERS:
00240 !
00241       REWIND(NBI2)
00242 !
00243       READ(NBI2)
00244       READ(NBI2) NBV1,NBV2
00245       DO I=1,NBV1+NBV2
00246         READ(NBI2)
00247       ENDDO
00248 !     READING OF 10 PARAMETERS AND DATE
00249       READ(NBI2) (PARAM(I),I=1,10)
00250       IF(PARAM(10).EQ.1) READ(NBI2) (PARAM(I),I=1,6)
00251 !  5: 4 PARAMETERS
00252       READ(NBI2) NELEM,NPOIN2,ECKEN,NDUM
00253 !  DYNAMIC ALLOCATIONS OF ARRAYS
00254       ALLOCATE(IKLESA(3,NELEM))
00255       ALLOCATE(IPOBO(NPOIN2))
00256 !  X AND Y
00257       ALLOCATE(XTIDER(NPOIN2))
00258       ALLOCATE(YTIDER(NPOIN2))
00259       ALLOCATE(ZTIDER(NPOIN2))
00260       ALLOCATE(XTIDE(NPOIN2))
00261       ALLOCATE(YTIDE(NPOIN2))
00262       ALLOCATE(ZTIDE(NPOIN2))
00263       ALLOCATE(SURFAC(NELEM))
00264 !  6: IKLE
00265       READ(NBI2)  ((IKLESA(I,J),I=1,ECKEN),J=1,NELEM)
00266 !  7: IPOBO
00267       READ(NBI2)  (IPOBO(I),I=1,NPOIN2)
00268 !  8: X AND Y
00269       READ(NBI2)  (XTIDER(I),I=1,NPOIN2)
00270       READ(NBI2)  (YTIDER(I),I=1,NPOIN2)
00271       READ(NBI2)  TPS
00272       READ(NBI2)  (ZTIDER(I),I=1,NPOIN2)
00273 !
00274       DO I=1,NPOIN2
00275         XTIDE(I) = DBLE(XTIDER(I))
00276         YTIDE(I) = DBLE(YTIDER(I))
00277         ZTIDE(I) = DBLE(ZTIDER(I))
00278       ENDDO
00279 !
00280       DO J=1,NELEM
00281         X1 = XTIDE(IKLESA(1,J))
00282         X2 = XTIDE(IKLESA(2,J))
00283         X3 = XTIDE(IKLESA(3,J))
00284         Y1 = YTIDE(IKLESA(1,J))
00285         Y2 = YTIDE(IKLESA(2,J))
00286         Y3 = YTIDE(IKLESA(3,J))
00287         SURFAC(J) = 0.5D0 * ( (X2-X1)*(Y3-Y1) - (X3-X1)*(Y2-Y1) )
00288       ENDDO
00289 !
00290       READ (NFO2,*)
00291       READ (NFO2,*)
00292       READ (NFO2,*)
00293       READ (NFO2,*)
00294       READ (NFO2,*)
00295       READ (NFO2,*)
00296 
00297       DO J=1,NPOINJMJ
00298         READ (NFO2,*)
00299         READ (NFO2,'(2(I7,I5,2(I6,I5)))') (CJMJ(J,I),I= 1,12)
00300         READ (NFO2,'(2(I7,I5,2(I6,I5)))') (CJMJ(J,I),I=13,24)
00301       ENDDO
00302 !
00303 !  WGS84 NORTHERN OR SOUTHERN UTM
00304       IF(GEOSYST.EQ.2.OR.GEOSYST.EQ.3.OR.GEOSYST.EQ.5) THEN
00305         CALL CONV_MERCATOR_TO_DEGDEC(NNBTIDE,
00306      &                               XBTIDE(1:NNBTIDE),
00307      &                               YBTIDE(1:NNBTIDE),
00308      &                               LAMBDA(1:NNBTIDE),PHI(1:NNBTIDE),
00309      &                               GEOSYST,NUMZONE,PHI0,LAMBD0)
00310 !  NTF LAMBERT
00311       ELSEIF(GEOSYST.EQ.4) THEN
00312         CALL CONV_LAMBERT_TO_DEGDEC(NNBTIDE,
00313      &                              XBTIDE(1:NNBTIDE),YBTIDE(1:NNBTIDE),
00314      &                              LAMBDA(1:NNBTIDE),PHI(1:NNBTIDE),
00315      &                              NUMZONE)
00316 !  WGS84 LONGITUDE/LATITUDE
00317       ELSEIF(GEOSYST.EQ.1) THEN
00318         DO K=1,NNBTIDE
00319           LAMBDA(K) = XBTIDE(K)
00320           PHI(K)    = YBTIDE(K)
00321         ENDDO
00322       ELSEIF(GEOSYST.EQ.0) THEN
00323 !  DEFINED BY THE USER
00324 !  THIS IS AN EXAMPLE
00325         DO K=1,NNBTIDE
00326           XL = XBTIDE(K)
00327           YL = YBTIDE(K)
00328 !  ROTATION WITH ALPHA ANGLE HERE
00329           XM=XL*COS(ALPHA)-YL*SIN(ALPHA)
00330           YL=XL*SIN(ALPHA)+YL*COS(ALPHA)
00331           XL=XM
00332 !  TRANSLATION AND CONVERSION INTO REAL DEGREES
00333           LAMBDA(K) = XO+XL/REARTH/COS(YO*DTR)*RTD
00334           PHI(K)    = YO+YL/REARTH            *RTD
00335         ENDDO
00336       ELSEIF(GEOSYST.EQ.-1) THEN
00337 !  DEFAULT VALUE
00338         IF(LNG.EQ.1) THEN
00339           WRITE(LU,*) 'VALEUR PAR DEFAUT INCORRECTE POUR LE SYSTEME'
00340           WRITE(LU,*) 'GEOGRAPHIQUE. CHOISIR PARMI LES CHOIX POSSIBLES'
00341           WRITE(LU,*) 'OU IMPLEMENTEZ LA CONVERSION'
00342           WRITE(LU,*) 'VOUS-MEME AVEC LE CHOIX 0 DANS BORD_TIDAL_BC.F :'
00343           WRITE(LU,*) '0 : DEFINI PAR L UTILISATEUR ;'
00344           WRITE(LU,*) '1 : WGS84 LONGITUDE/LATITUDE IN DEGRES REELS ;'
00345           WRITE(LU,*) '2 : WGS84 NORD UTM ;'
00346           WRITE(LU,*) '3 : WGS84 SUD UTM ;'
00347           WRITE(LU,*) '4 : LAMBERT ;'
00348           WRITE(LU,*) '5 : MERCATOR POUR TELEMAC.'
00349         ENDIF
00350         IF(LNG.EQ.2) THEN
00351           WRITE(LU,*) 'INCORRECT DEFAULT VALUE FOR THE GEOGRAPHIC'
00352           WRITE(LU,*) 'SYSTEM. TO BE CHOSEN AMONG THE POSSIBLE CHOICES'
00353           WRITE(LU,*) 'OR IMPLEMENT THE CONVERSION'
00354           WRITE(LU,*) 'BY YOURSELF WITH CHOICE 0 IN BORD_TIDAL_BC.F:'
00355           WRITE(LU,*) '0: DEFINED BY USER,'
00356           WRITE(LU,*) '1: WGS84 LONGITUDE/LATITUDE IN REAL DEGREES,'
00357           WRITE(LU,*) '2: WGS84 NORTHERN UTM,'
00358           WRITE(LU,*) '3: WGS84 SOUTHERN UTM,'
00359           WRITE(LU,*) '4: LAMBERT,'
00360           WRITE(LU,*) '5: MERCATOR FOR TELEMAC.'
00361         ENDIF
00362         CALL PLANTE(1)
00363         STOP
00364       ELSE
00365         IF(LNG.EQ.1) THEN
00366           WRITE(LU,*) 'SYSTEME GEOGRAPHIQUE DE COORDONNEES NON TRAITE.'
00367           WRITE(LU,*) 'CHANGEZ DE SYSTEME OU IMPLEMENTEZ LA CONVERSION'
00368           WRITE(LU,*) 'VOUS-MEME AVEC LE CHOIX 0 DANS BORD_TIDAL_BC.F :'
00369           WRITE(LU,*) '0 : DEFINI PAR L UTILISATEUR ;'
00370           WRITE(LU,*) '1 : WGS84 LONGITUDE/LATITUDE IN DEGRES REELS ;'
00371           WRITE(LU,*) '2 : WGS84 NORD UTM ;'
00372           WRITE(LU,*) '3 : WGS84 SUD UTM ;'
00373           WRITE(LU,*) '4 : LAMBERT ;'
00374           WRITE(LU,*) '5 : MERCATOR POUR TELEMAC.'
00375         ENDIF
00376         IF(LNG.EQ.2) THEN
00377           WRITE(LU,*) 'GEOGRAPHIC SYSTEM FOR COORDINATES'
00378           WRITE(LU,*) 'NOT TAKEN INTO ACCOUNT.'
00379           WRITE(LU,*) 'CHANGE THE SYSTEM OR IMPLEMENT THE CONVERSION'
00380           WRITE(LU,*) 'BY YOURSELF WITH CHOICE 0 IN BORD_TIDAL_BC.F:'
00381           WRITE(LU,*) '0: DEFINED BY USER,'
00382           WRITE(LU,*) '1: WGS84 LONGITUDE/LATITUDE IN REAL DEGREES,'
00383           WRITE(LU,*) '2: WGS84 NORTHERN UTM,'
00384           WRITE(LU,*) '3: WGS84 SOUTHERN UTM,'
00385           WRITE(LU,*) '4: LAMBERT,'
00386           WRITE(LU,*) '5: MERCATOR FOR TELEMAC.'
00387         ENDIF
00388         CALL PLANTE(1)
00389         STOP
00390       ENDIF
00391 !
00392       DO K=1,NNBTIDE
00393         XL=LAMBDA(K)
00394         YL=PHI(K)
00395 !
00396 !  CONVERSION FROM REAL DEGREES TO MERCATOR TELEMAC
00397 !
00398         XM=REARTH*DTR*XL
00399         YM=REARTH*(LOG(TAN((0.5D0*YL   +45.D0)*DTR))
00400      &            -LOG(TAN((0.5D0*48.D0+45.D0)*DTR)))
00401 !
00402 !  POSSIBLE TRANSLATION TO FIT THE COASTLINES OF THE TWO MODELS (JMJ AND LOCAL)!!!
00403 !  DEFAULT: TO COMMENT THE FOLLOWING TWO LINES!
00404 !
00405         XM=XM+XSHIFT
00406         YM=YM+YSHIFT
00407 !
00408 !       WRITE(57,'(F15.2,F16.2)') XM,YM
00409 !
00410 !  INTERPOLATION (FINITE ELEMENTS)
00411 !  MAY BE CHANGED IN THE FUTURE WITH A MORE EFFICIENT INTERPOLATION ALGORITHM
00412 !
00413         DIS=-9.D99
00414 !
00415         J=1
00416         N1=IKLESA(1,J)
00417         N2=IKLESA(2,J)
00418         N3=IKLESA(3,J)
00419 !
00420         A1 =         XM*YTIDE(N2) - XTIDE(N2)*YM + XTIDE(N2)*YTIDE(N3)
00421      &      - XTIDE(N3)*YTIDE(N2) + XTIDE(N3)*YM -        XM*YTIDE(N3)
00422         A2 =         XM*YTIDE(N3) - XTIDE(N3)*YM + XTIDE(N3)*YTIDE(N1)
00423      &      - XTIDE(N1)*YTIDE(N3) + XTIDE(N1)*YM -        XM*YTIDE(N1)
00424         A3 =         XM*YTIDE(N1) - XTIDE(N1)*YM + XTIDE(N1)*YTIDE(N2)
00425      &      - XTIDE(N2)*YTIDE(N1) + XTIDE(N2)*YM -        XM*YTIDE(N2)
00426 !
00427         DO WHILE(     .NOT.(A1.GE.0.D0.AND.A2.GE.0.D0.AND.A3.GE.0.D0)
00428      &           .AND.(J.LE.NELEM))
00429           DISEL=MIN(A1,A2,A3)/SURFAC(J)
00430           IF(DISEL.GT.DIS) THEN
00431             DIS=DISEL
00432             IELEP=J
00433           ENDIF
00434 !
00435           J=J+1
00436           N1=IKLESA(1,J)
00437           N2=IKLESA(2,J)
00438           N3=IKLESA(3,J)
00439 !
00440           A1 =         XM*YTIDE(N2) - XTIDE(N2)*YM + XTIDE(N2)*YTIDE(N3)
00441      &        - XTIDE(N3)*YTIDE(N2) + XTIDE(N3)*YM -        XM*YTIDE(N3)
00442           A2 =         XM*YTIDE(N3) - XTIDE(N3)*YM + XTIDE(N3)*YTIDE(N1)
00443      &        - XTIDE(N1)*YTIDE(N3) + XTIDE(N1)*YM -        XM*YTIDE(N1)
00444           A3 =         XM*YTIDE(N1) - XTIDE(N1)*YM + XTIDE(N1)*YTIDE(N2)
00445      &        - XTIDE(N2)*YTIDE(N1) + XTIDE(N2)*YM -        XM*YTIDE(N2)
00446         ENDDO
00447 !
00448         IF(J.EQ.NELEM+1) THEN
00449           IF(LNG.EQ.1) THEN
00450             WRITE(LU,*) 'ERREUR LORS DE L INTERPOLATION, K =',
00451      &                   BOUNDARY_COLOUR%I(NBTIDE(K)),' DIS =',DIS
00452           ENDIF
00453           IF(LNG.EQ.2) THEN
00454             WRITE(LU,*) 'ERROR DURING INTERPOLATION, K =',
00455      &                   BOUNDARY_COLOUR%I(NBTIDE(K)),' DIS =',DIS
00456           ENDIF
00457 !
00458           J=IELEP
00459           N1=IKLESA(1,J)
00460           N2=IKLESA(2,J)
00461           N3=IKLESA(3,J)
00462 !
00463           A1 =         XM*YTIDE(N2) - XTIDE(N2)*YM + XTIDE(N2)*YTIDE(N3)
00464      &        - XTIDE(N3)*YTIDE(N2) + XTIDE(N3)*YM -        XM*YTIDE(N3)
00465           A2 =         XM*YTIDE(N3) - XTIDE(N3)*YM + XTIDE(N3)*YTIDE(N1)
00466      &        - XTIDE(N1)*YTIDE(N3) + XTIDE(N1)*YM -        XM*YTIDE(N1)
00467           A3 =         XM*YTIDE(N1) - XTIDE(N1)*YM + XTIDE(N1)*YTIDE(N2)
00468      &        - XTIDE(N2)*YTIDE(N1) + XTIDE(N2)*YM -        XM*YTIDE(N2)
00469         ENDIF
00470 !
00471         ZP=0.5D0*(ZTIDE(N1)*A1+ZTIDE(N2)*A2+ZTIDE(N3)*A3)/SURFAC(J)
00472         WRITE(NRFO,'(I5,F12.2)') BOUNDARY_COLOUR%I(NBTIDE(K)),ZP
00473 !
00474         DO I=1,24
00475           COEF(I)=0.0005D0*(CJMJ(N1,I)*A1+CJMJ(N2,I)*A2+CJMJ(N3,I)*A3)/
00476      &            SURFAC(J)
00477         ENDDO
00478 !
00479 !  RECOMMENDED: REAL TIDE (RECOMMENDED METHODOLOGY) OR SCHEMATIC TIDES: 1<=TIDALTYPE<=6
00480 !  TIDALTYPE = 1 TO 6: MAGNITUDE AND PHASE
00481 !
00482         IF(TIDALTYPE.GE.1.AND.TIDALTYPE.LE.6) THEN
00483           DO I=1,12
00484             J=I+I-1
00485             AF(I)=SQRT(COEF(J)**2+COEF(J+1)**2)
00486             IF (AF(I).GT.1.D-9) PF(I)=ATAN2(COEF(J+1),COEF(J))*RTD
00487             PF(I) = MOD(PF(I) + BETA,360.D0)
00488             IF (PF(I).LT.0.D0) PF(I)=PF(I)+360.D0
00489           ENDDO
00490 !
00491           WRITE(NRFO,'(3(F9.3,F7.1))') (AF(I),PF(I),I=1,3)
00492           WRITE(NRFO,'(3(F9.3,F7.1))') (AF(I),PF(I),I=4,6)
00493           WRITE(NRFO,'(3(F9.3,F7.1))') (AF(I),PF(I),I=7,9)
00494           WRITE(NRFO,'(3(F9.3,F7.1))') (AF(I),PF(I),I=10,12)
00495 !
00496 !  REAL TIDES, METHODOLOGY BEFORE 2010: TIDALTYPE = 7
00497 !  TIDALTYPE = 7: PROJECTIONS ON X AND Y AXES
00498 !
00499         ELSEIF(TIDALTYPE.GE.7) THEN
00500 !  DEGREES TO RADIANS CONVERSION OF BETA
00501           BETA = BETA*DTR
00502 !  COEFM WORKING COPY
00503           DO I=1,24
00504             COEFM(I)=COEF(I)
00505           ENDDO
00506 !  X COMPONENTS: ODD; Y COMPONENTS: EVEN
00507           DO I=1,12
00508             COEF(2*I-1) = COEFM(2*I-1)*COS(BETA)-COEFM(2*I)*SIN(BETA)
00509             COEF(2*I)   = COEFM(2*I-1)*SIN(BETA)+COEFM(2*I)*COS(BETA)
00510           ENDDO
00511 !
00512           WRITE(NRFO,'(6(F9.3))') (COEF(I),I=1,6)
00513           WRITE(NRFO,'(6(F9.3))') (COEF(I),I=7,12)
00514           WRITE(NRFO,'(6(F9.3))') (COEF(I),I=13,18)
00515           WRITE(NRFO,'(6(F9.3))') (COEF(I),I=19,24)
00516         ENDIF
00517       ENDDO
00518 !
00519 !     CLOSE (57)
00520 !
00521       DEJA_TBC = .TRUE.
00522 !
00523       ENDIF
00524 !
00525 !-----------------------------------------------------------------------
00526 !
00527       RETURN
00528       END

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