limwac.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\tomawac\limwac.f
00002 !
00069                      SUBROUTINE LIMWAC
00070 !                    *****************
00071 !
00072      &(F     , FBOR  , LIFBOR, NPTFR , NPLAN , NF    ,  TETA , FREQ  ,
00073      & NPOIN2, NBOR  , AT    , LT    , DDC   , LIMSPE, FPMAXL, FETCHL,
00074      & SIGMAL, SIGMBL, GAMMAL, FPICL , HM0L  , APHILL, TETA1L, SPRE1L,
00075      & TETA2L, SPRE2L, XLAMDL, X ,Y  , KENT  , KSORT , NFO1  , NBI1  ,
00076      & BINBI1, UV    , VV    , SPEULI, VENT  , VENSTA, GRAVIT, DEUPI ,
00077      & PRIVE , NPRIV , SPEC  , FRA   , DEPTH , FRABL ,BOUNDARY_COLOUR)
00078 !
00079 !***********************************************************************
00080 ! TOMAWAC   V6P3                                   21/06/2011
00081 !***********************************************************************
00082 !
00083 !
00084 !
00085 !
00086 !
00087 !
00088 !
00089 !
00090 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00091 !| APHILL         |-->| BOUNDARY PHILLIPS CONSTANT
00092 !| AT             |-->| COMPUTATION TIME
00093 !| BINBI1         |-->| BINARY FILE 1 BINARY
00094 !| BOUNDARY_COLOUR|-->| COLOUR OF BOUNDARY POINT (DEFAULT: ITS RANK)
00095 !| DDC            |-->| DATE OF COMPUTATION BEGINNING
00096 !| DEPTH          |-->| WATER DEPTH
00097 !| DEUPI          |-->| 2.PI
00098 !| F              |-->| VARIANCE DENSITY DIRECTIONAL SPECTRUM
00099 !| FBOR           |<->| SPECTRAL VARIANCE DENSITY AT THE BOUNDARIES
00100 !| FETCHL         |-->| BOUNDARY MEAN FETCH VALUE
00101 !| FPICL          |-->| BOUNDARY PEAK FREQUENCY
00102 !| FPMAXL         |-->| BOUNDARY MAXIMUM PEAK FREQUENCY
00103 !| FRA            |<--| DIRECTIONAL SPREADING FUNCTION VALUES
00104 !| FRABL          |-->| BOUNDARY ANGULAR DISTRIBUTION FUNCTION
00105 !| FREQ           |-->| DISCRETIZED FREQUENCIES
00106 !| GAMMAL         |-->| BOUNDARY PEAK FACTOR
00107 !| GRAVIT         |-->| GRAVITY ACCELERATION
00108 !| HM0L           |-->| BOUNDARY SIGNIFICANT WAVE HEIGHT
00109 !| KENT           |-->| B.C.: A SPECTRUM IS PRESCRIBED AT THE BOUNDARY
00110 !| KSORT          |-->| B.C.: FREE BOUNDARY: NO ENERGY ENTERING THE DOMAIN
00111 !| LIFBOR         |-->| TYPE OF BOUNDARY CONDITION ON F
00112 !| LIMSPE         |-->| TYPE OF BOUNDARY DIRECTIONAL SPECTRUM
00113 !| LT             |-->| NUMBER OF THE TIME STEP CURRENTLY SOLVED
00114 !| NBI1           |-->| LOGICAL UNIT NUMBER OF THE USER BINARY FILE
00115 !| NBOR           |-->| GLOBAL NUMBER OF BOUNDARY POINTS
00116 !| NF             |-->| NUMBER OF FREQUENCIES
00117 !| NFO1           |-->| LOGICAL UNIT NUMBER OF THE USER FORMATTED FILE
00118 !| NPLAN          |-->| NUMBER OF DIRECTIONS
00119 !| NPOIN2         |-->| NUMBER OF POINTS IN 2D MESH
00120 !| NPRIV          |-->| NUMBER OF PRIVATE ARRAYS
00121 !| NPTFR          |-->| NUMBER OF BOUNDARY POINTS
00122 !| PRIVE          |-->| USER WORK TABLE
00123 !| SIGMAL         |-->| BOUNDARY SPECTRUM VALUE OF SIGMA-A
00124 !| SIGMBL         |-->| BOUNDARY SPECTRUM VALUE OF SIGMA-B
00125 !| SPEC           |<--| VARIANCE DENSITY FREQUENCY SPECTRUM
00126 !| SPEULI         |-->| INDICATES IF B.C. SPECTRUM IS MODIFIED BY USER
00127 !| SPRE1L         |-->| BOUNDARY DIRECTIONAL SPREAD 1
00128 !| SPRE2L         |-->| BOUNDARY DIRECTIONAL SPREAD 2
00129 !| TETA           |-->| DISCRETIZED DIRECTIONS
00130 !| TETA1L         |-->| BOUNDARY MAIN DIRECTION 1
00131 !| TETA2L         |-->| BOUNDARY MAIN DIRECTION 2
00132 !| UV, VV         |-->| WIND VELOCITIES AT THE MESH POINTS
00133 !| VENSTA         |-->| INDICATES IF THE WIND IS STATIONARY
00134 !| VENT           |-->| INDICATES IF WIND IS TAKEN INTO ACCOUNT
00135 !| X              |-->| ABSCISSAE OF POINTS IN THE MESH
00136 !| XLAMDL         |-->| BOUNDARY WEIGHTING FACTOR FOR ANGULAR
00137 !|                |   | DISTRIBUTION FUNCTION
00138 !| Y              |-->| ORDINATES OF POINTS IN THE MESH
00139 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00140 !
00141       USE INTERFACE_TOMAWAC, EX_LIMWAC => LIMWAC
00142       IMPLICIT NONE
00143 !
00144       INTEGER LNG,LU
00145       COMMON/INFO/LNG,LU
00146 !
00147       INTEGER NPLAN,NF,NPOIN2,NPTFR,LT,NPRIV
00148       INTEGER, INTENT(IN) :: BOUNDARY_COLOUR(NPTFR)
00149 !
00150       DOUBLE PRECISION F(NPOIN2,NPLAN,NF),X(NPOIN2),Y(NPOIN2)
00151       DOUBLE PRECISION FBOR(NPTFR,NPLAN,NF),TETA(NPLAN),FREQ(NF)
00152       DOUBLE PRECISION UV(NPOIN2),VV(NPOIN2), SPEC(NF), FRA(NPLAN)
00153       DOUBLE PRECISION PRIVE(NPOIN2,NPRIV),DDC, DEPTH(NPOIN2)
00154       DOUBLE PRECISION HM0L,FPICL,GAMMAL,SIGMAL,SIGMBL,APHILL,FETCHL
00155       DOUBLE PRECISION FPMAXL,TETA1L,SPRE1L,TETA2L,SPRE2L,XLAMDL
00156       DOUBLE PRECISION GRAVIT,DEUPI,E2FMIN
00157 !
00158       DOUBLE PRECISION AT
00159 !
00160       LOGICAL SPEULI, VENT, VENSTA
00161 !
00162       INTEGER NBOR(NPTFR),LIFBOR(NPTFR),NFO1,NBI1,NPB
00163       INTEGER KENT,KSORT,IFF,IPLAN,IPTFR,LIMSPE,FRABL
00164 !
00165 !     DOUBLE PRECISION, ALLOCATABLE :: TRAV(:)
00166       DOUBLE PRECISION, ALLOCATABLE :: UV2D(:),VV2D(:),PROF(:)
00167       DOUBLE PRECISION, ALLOCATABLE :: FB_CTE(:,:)
00168       LOGICAL FLAG
00169 !
00170       CHARACTER(LEN=3) BINBI1
00171 !
00172       SAVE NPB,UV2D,VV2D,PROF,FB_CTE
00173 !
00174 !***********************************************************************
00175 !
00176 !     MODIFIES THE TYPE OF BOUNDARY CONDITION (OPTIONAL)
00177 !
00178 !     CAN BE CODED BY THE USER (SPEULI=.TRUE.)
00179 !
00180 !     LIFBOR(IPTFR)=KENT OR KSORT
00181 !
00182       FLAG=.FALSE.
00183       IF (VENT .AND. (LIMSPE.EQ.1 .OR. LIMSPE.EQ.2 .OR. LIMSPE.EQ.3
00184      & .OR. LIMSPE.EQ.5)) FLAG=.TRUE.
00185 !
00186 !     THE FIRST TIME, ALLOCATES MEMORY FOR THE USEFUL ARRAYS
00187 !     ---------------------------------------------------------------
00188 !
00189       IF(LT.LT.1) THEN
00190         NPB=1
00191         IF(FLAG) THEN
00192           ALLOCATE(UV2D(1:NPTFR),VV2D(1:NPTFR))
00193           NPB=NPTFR
00194         ENDIF
00195         IF(LIMSPE.EQ.7 .OR. SPEULI) THEN
00196           ALLOCATE(PROF(1:NPTFR))
00197           NPB=NPTFR
00198         ENDIF
00199         IF(NPB.EQ.1) THEN
00200           ALLOCATE(FB_CTE(1:NPLAN,1:NF))
00201         ENDIF
00202       ENDIF
00203       IF (.NOT.ALLOCATED(UV2D)) ALLOCATE(UV2D(NPTFR))
00204       IF (.NOT.ALLOCATED(VV2D)) ALLOCATE(VV2D(NPTFR))
00205       IF (.NOT.ALLOCATED(PROF)) ALLOCATE(PROF(NPTFR))
00206       IF (.NOT.ALLOCATED(FB_CTE)) ALLOCATE(FB_CTE(1:NPLAN,1:NF))
00207 !
00208 !     THE FIRST TIME (AND POSSIBLY SUBSEQUENTLY IF THE WIND IS NOT
00209 !     STATIONARY AND IF THE BOUNDARY SPECTRUM DEPENDS ON IT),
00210 !     COMPUTES THE BOUNDARY SPECTRUM
00211 !
00212       IF(LT.LT.1 .OR. (.NOT.VENSTA.AND.FLAG) .OR. SPEULI) THEN
00213         IF(FLAG) THEN
00214           DO IPTFR=1,NPTFR
00215             UV2D(IPTFR)=UV(NBOR(IPTFR))
00216             VV2D(IPTFR)=VV(NBOR(IPTFR))
00217           ENDDO
00218         ENDIF
00219         IF(LIMSPE.EQ.7 .OR. SPEULI) THEN
00220           DO IPTFR=1,NPTFR
00221             PROF(IPTFR)=DEPTH(NBOR(IPTFR))
00222           ENDDO
00223         ENDIF
00224 !
00225         E2FMIN = 1.D-30
00226 !
00227 !       WHEN NPB=1 FBOR ONLY FILLED FOR FIRST POINT
00228 !
00229 !       SPECTRUM ON BOUNDARIES
00230 !
00231         IF(NPB.EQ.NPTFR) THEN
00232           CALL SPEINI
00233      &(   FBOR  ,SPEC  ,FRA   ,UV2D  ,VV2D  ,FREQ ,
00234      &    TETA  ,GRAVIT,FPMAXL,FETCHL,SIGMAL,SIGMBL,GAMMAL,FPICL,
00235      &    HM0L  ,APHILL,TETA1L,SPRE1L,TETA2L,SPRE2L,XLAMDL,
00236      &    NPB   ,NPLAN ,NF    ,LIMSPE,E2FMIN,PROF  ,FRABL )
00237         ELSE
00238           CALL SPEINI
00239      &(   FB_CTE,SPEC  ,FRA   ,UV2D  ,VV2D  ,FREQ ,
00240      &    TETA  ,GRAVIT,FPMAXL,FETCHL,SIGMAL,SIGMBL,GAMMAL,FPICL,
00241      &    HM0L  ,APHILL,TETA1L,SPRE1L,TETA2L,SPRE2L,XLAMDL,
00242      &    NPB   ,NPLAN ,NF    ,LIMSPE,E2FMIN,PROF  ,FRABL )
00243         ENDIF
00244 !
00245 !     ===========================================================
00246 !     TO BE MODIFIED BY USER - RESU CAN BE CHANGED
00247 !     ===========================================================
00248 !
00249         IF(SPEULI) THEN
00250 !
00251 !        EXEMPLE DE MODIFICATION DE FRA - A MODIFIER SUIVANT VOTRE CAS
00252 !        EXAMPLE OF MODIFICATION OF FRA - TO BE MODIFIED DEPENDING
00253 !        ON YOUR CASE
00254 !
00255 !        ALLOCATE(TRAV(1:NF))
00256 !
00257 !        DO IFREQ=1,NF
00258 !          IF(FREQ(IFF).LT.FPIC) THEN
00259 !            TRAV(IFF)=0.4538D0*(FREQ(IFF)/FPIC)**(-2.03D0)
00260 !          ELSE
00261 !            TRAV(IFF)=0.4538D0*(FREQ(IFF)/FPIC)**(1.04D0)
00262 !          ENDIF
00263 !        ENDDO
00264 !
00265 !        DO IPLAN=1,NPLAN
00266 !           DTETA=TETA(IPLAN)-TETA1
00267 !           IF((TETA(IPLAN)-TETA1).GT.DEUPI/2.D0) THEN
00268 !              DTETA=DEUPI-DTETA
00269 !           ENDIF
00270 !           DO IFF=1,NF
00271 !              FRA(IPLAN)=1.D0/SQRT(DEUPI)*TRAV(IFF)*
00272 !     *                       EXP(-DTETA**2/(2.D0*TRAV(IFF)**2))
00273 !              DO IPTFR=1,NPTFR
00274 !                FBOR(IPTFR,IPLAN,IFF)= SPEC(IFF)*FRA(IPLAN)
00275 !              ENDDO
00276 !           ENDDO
00277 !        ENDDO
00278 !        DEALLOCATE(TRAV)
00279 !
00280 !        PARTIE A SUPPRIMER SI ON FAIT DES MODIFICATIONS
00281 !        DELETE THESE LINES IF MODIFICATIONS HAVE BEEN IMPLEMENTED
00282 !
00283         IF(LNG.EQ.1) THEN
00284           WRITE(LU,*) '*****  ERREUR LIMWAC  ******'
00285           WRITE(LU,*)
00286      &      ' VOUS NE MODIFIEZ PAS LE SPECTRE AUX LIMITES ALORS QUE'
00287           WRITE(LU,*) ' VOUS EN DEMANDEZ LA POSSIBILITE'
00288         ELSE
00289           WRITE(LU,*) '*****  ERROR LIMWAC  ******'
00290           WRITE(LU,*)
00291      &      ' YOU DID NOT MODIFY THE BOUNDARY SPECTRUM WHEREAS '
00292           WRITE(LU,*) ' YOU ASK FOR THAT '
00293         ENDIF
00294         CALL PLANTE(1)
00295         STOP
00296       ENDIF
00297 !
00298 !     ===========================================================
00299 !     END OF USER MODIFICATIONS
00300 !     ===========================================================
00301 !
00302       ENDIF
00303 !
00304 !     -----------------------------------------------------------------
00305 !     DUPLICATES THE BOUNDARY CONDITION FROM DYNAM ON ALL THE
00306 !     DIRECTIONS AND FREQUENCIES, IF LIQUID BOUNDARY
00307 !     -----------------------------------------------------------------
00308 !
00309       IF(FLAG.OR.LIMSPE.EQ.7.OR.SPEULI) THEN
00310         DO IPTFR=1,NPTFR
00311           IF(LIFBOR(IPTFR).EQ.KENT) THEN
00312             DO IFF=1,NF
00313               DO IPLAN=1,NPLAN
00314                 F(NBOR(IPTFR),IPLAN,IFF)=FBOR(IPTFR,IPLAN,IFF)
00315               ENDDO
00316             ENDDO
00317           ENDIF
00318         ENDDO
00319       ELSE
00320         DO IPTFR=1,NPTFR
00321           IF(LIFBOR(IPTFR).EQ.KENT) THEN
00322             DO IFF=1,NF
00323               DO IPLAN=1,NPLAN
00324                 F(NBOR(IPTFR),IPLAN,IFF)=FB_CTE(IPLAN,IFF)
00325               ENDDO
00326             ENDDO
00327           ENDIF
00328         ENDDO
00329       ENDIF
00330 !
00331 !-----------------------------------------------------------------------
00332 !
00333       RETURN
00334       END

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