qnlin1.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\tomawac\qnlin1.f
00002 !
00071                      SUBROUTINE QNLIN1
00072 !                    *****************
00073 !
00074      &( TSTOT , TSDER , IANGNL, COEFNL, NF    , NPLAN , F1    , RAISF ,
00075      &  TAILF , PROINF, NPOIN2, F     , DEPTH , XKMOY , TAUX1 , TAUX2 ,
00076      &  TAUX3 , TAUX4 , TAUX5 , DFINI )
00077 !
00078 !***********************************************************************
00079 ! TOMAWAC   V6P3                                   24/06/2011
00080 !***********************************************************************
00081 !
00082 !
00083 !
00084 !reference  HASSELMANN S., HASSELMANN K. ET AL.(1985) :
00085 !+                     "COMPUTATIONS AND PARAMETERIZATIONS OF THE NONLINEAR
00086 !+                      ENERGY TRANSFER IN GRAVITY-WAVE SPECTRUM. PART1 :
00087 !+                      A NEW METHOD FOR EFFICIENT COMPUTATION OF THE EXACT
00088 !+                      NON-LINEAR TRANSFER INTEGRAL". JPO, VOL 15, PP 1369-1377.
00089 !reference HASSELMANN S., HASSELMANN K. ET AL.(1985) :
00090 !+                     "COMPUTATIONS AND PARAMETERIZATIONS OF THE NONLINEAR
00091 !+                      ENERGY TRANSFER IN GRAVITY-WAVE SPECTRUM. PART2 :
00092 !+                      PARAMETERIZATIONS OF THE NONLINEAR ENERGY TRANSFER
00093 !+                      FOR APPLICATION IN WAVE MODELS". JPO, VOL 15, PP 1378-1391.
00094 !
00095 !
00096 !
00097 !
00098 !
00099 !
00100 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00101 !| COEFNL         |-->| COEFFICIENTS USED FOR DIA METHOD
00102 !| DEPTH          |-->| WATER DEPTH
00103 !| DFINI          |<->| WORK TABLE
00104 !| F              |-->| DIRECTIONAL SPECTRUM
00105 !| F1             |-->| FIRST DISCRETIZED FREQUENCY
00106 !| IANGNL         |-->| ANGULAR INDICES TABLE
00107 !| NF             |-->| NUMBER OF FREQUENCIES
00108 !| NPLAN          |-->| NUMBER OF DIRECTIONS
00109 !| NPOIN2         |-->| NUMBER OF POINTS IN 2D MESH
00110 !| PROINF         |-->| LOGICAL INDICATING INFINITE DEPTH ASSUMPTION
00111 !| RAISF          |-->| FREQUENTIAL RATIO
00112 !| TAILF          |-->| SPECTRUM QUEUE FACTOR
00113 !| TAUX1          |<->| WORK TABLE
00114 !| TAUX2          |<->| WORK TABLE
00115 !| TAUX3          |<->| WORK TABLE
00116 !| TAUX4          |<->| WORK TABLE
00117 !| TAUX5          |<->| WORK TABLE
00118 !| TSDER          |<->| DERIVED PART OF THE SOURCE TERM CONTRIBUTION
00119 !| TSTOT          |<->| TOTAL PART OF THE SOURCE TERM CONTRIBUTION
00120 !| XKMOY          |-->| AVERAGE WAVE NUMBER
00121 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00122 !
00123       IMPLICIT NONE
00124 !
00125 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00126 !
00127       INTEGER, INTENT(IN)             :: NPOIN2,NPLAN,NF
00128       INTEGER, INTENT(IN)             :: IANGNL(NPLAN,8)
00129       DOUBLE PRECISION, INTENT(IN)    :: F1,RAISF,TAILF
00130       DOUBLE PRECISION, INTENT(IN)    :: F(NPOIN2,NPLAN,NF),COEFNL(16)
00131       DOUBLE PRECISION, INTENT(IN)    :: XKMOY(NPOIN2)
00132       DOUBLE PRECISION, INTENT(INOUT) :: TSTOT(NPOIN2,NPLAN,NF)
00133       DOUBLE PRECISION, INTENT(INOUT) :: TSDER(NPOIN2,NPLAN,NF)
00134       DOUBLE PRECISION, INTENT(INOUT) :: TAUX1(NPOIN2),TAUX2(NPOIN2)
00135       DOUBLE PRECISION, INTENT(INOUT) :: TAUX3(NPOIN2)
00136       DOUBLE PRECISION, INTENT(INOUT) :: TAUX4(NPOIN2),TAUX5(NPOIN2)
00137       DOUBLE PRECISION, INTENT(INOUT) :: DFINI(NPOIN2)
00138       DOUBLE PRECISION, INTENT(IN)    :: DEPTH(NPOIN2)
00139       LOGICAL, INTENT(IN)             :: PROINF
00140 !
00141 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00142 !
00143       INTEGER  JBP0  , JFP0  , JFP1  , JFM0  , JFM1  , JFP   , JFM
00144       INTEGER  JBP1  , JB    , JBM0  , JBM1  , IMAGE , JP
00145       INTEGER  JPP0  , JPP1  , JPM0  , JPM1  , IP    , KAUX  , JF
00146       INTEGER  JFMIN , JFMAX
00147       DOUBLE PRECISION COEFP0, COEFP1, COEFM0, COEFM1, COEFJF, XXFAC
00148       DOUBLE PRECISION FMOIN , FPLUS , TERM1 , TERM2 , US1PL4, US1ML4
00149       DOUBLE PRECISION C1    , C2    , C3    , C4    , C5    , C6
00150       DOUBLE PRECISION D1    , D2    , D3    , D4    , D5    , D6
00151       DOUBLE PRECISION C1SQ  , C2SQ  , C3SQ  , C4SQ  , C5SQ  , C6SQ
00152       DOUBLE PRECISION C7    , C8    , D7    , D8    , C7SQ  , C8SQ
00153       DOUBLE PRECISION TERM3 , FDEJF , FREQ
00154 !
00155 !-----------------------------------------------------------------------
00156 !
00157 !     RECOVERS THE COEFFICIENTS COMPUTED IN 'PRENL1'
00158 !
00159       C1    = COEFNL( 1)
00160       C2    = COEFNL( 2)
00161       C3    = COEFNL( 3)
00162       C4    = COEFNL( 4)
00163       C5    = COEFNL( 5)
00164       C6    = COEFNL( 6)
00165       C7    = COEFNL( 7)
00166       C8    = COEFNL( 8)
00167       JFP   = IDINT(COEFNL( 9)+1.D-7)
00168       JFM   = IDINT(COEFNL(10)-1.D-7)
00169       US1PL4= COEFNL(11)
00170       US1ML4= COEFNL(12)
00171       JFMIN = NINT(COEFNL(13))
00172       JFMAX = NINT(COEFNL(14))
00173       C1SQ  = C1**2
00174       C2SQ  = C2**2
00175       C3SQ  = C3**2
00176       C4SQ  = C4**2
00177       C5SQ  = C5**2
00178       C6SQ  = C6**2
00179       C7SQ  = C7**2
00180       C8SQ  = C8**2
00181 !
00182 !     CORRECTION FACTOR FOR FINITE WATER DEPTH
00183 !
00184       IF(.NOT.PROINF) THEN
00185         DO IP=1,NPOIN2
00186           TERM1 = MAX(0.75D0*DEPTH(IP)*XKMOY(IP),0.5D0)
00187           DFINI(IP) = 1.D0+(5.5D0/TERM1)*(1.D0-0.833D0*TERM1)
00188      &               /EXP(MIN(1.25D0*TERM1,7.D2))
00189         ENDDO
00190       ENDIF
00191 !
00192 !     FIRST LOOP ON THE FREQUENCIES
00193 !
00194       DO JF=JFMIN,JFMAX
00195 !
00196 !       COMPUTES THE CONSIDERED FREQUENCY
00197 !
00198         FREQ = F1*RAISF**(JF-1)
00199 !
00200 !       GETS THE INDICES OF THE FREQUENCIES EITHER SIDE OF THE
00201 !       'MAX' FREQUENCY: FREQ(JFP0)
00202 !
00203         JFP0=JF+JFP
00204         JFP1=JFP0+1
00205 !
00206 !       GETS THE INDICES OF THE FREQUENCIES EITHER SIDE OF THE
00207 !       'MIN' FREQUENCY: FREQ(JFM0)
00208 !
00209         JFM0=JF+JFM-1
00210         JFM1=JFM0+1
00211 !
00212 !       LIMITS THE INDICES TO NF AND TAKES INTO ACCOUNT ANALYTICALLY
00213 !       THE SPECTRUM TAIL (DECREASE IN -TAILF).
00214 !
00215         CALL CQUEUE( NF , RAISF , TAILF , JFP1 , JBP1 , COEFP1 )
00216         CALL CQUEUE( NF , RAISF , TAILF , JFP0 , JBP0 , COEFP0 )
00217         CALL CQUEUE( NF , RAISF , TAILF , JF   , JB   , COEFJF )
00218         CALL CQUEUE( NF , RAISF , TAILF , JFM1 , JBM1 , COEFM1 )
00219         CALL CQUEUE( NF , RAISF , TAILF , JFM0 , JBM0 , COEFM0 )
00220 !
00221 !       INTERPOLATION COEFFICIENTS FOR THE MODIFIED SPECTRUM
00222 !
00223         D1=C1*COEFP0*US1PL4
00224         D2=C2*COEFP0*US1PL4
00225         D3=C3*COEFP1*US1PL4
00226         D4=C4*COEFP1*US1PL4
00227         D5=C5*COEFM0*US1ML4
00228         D6=C6*COEFM0*US1ML4
00229         D7=C7*COEFM1*US1ML4
00230         D8=C8*COEFM1*US1ML4
00231 !
00232 !       COMPUTES THE MULTIPLICATIVE COEFFICIENT (IN F**11) AND TAKES
00233 !       INTO ACCOUNT THE CORRECTION TERM IN FINITE DEPTH
00234 !
00235         XXFAC= 3000.D0*FREQ**11
00236         IF(PROINF) THEN
00237           DO IP=1,NPOIN2
00238             TAUX1(IP) = XXFAC
00239           ENDDO
00240         ELSE
00241           DO IP=1,NPOIN2
00242             TAUX1(IP) = DFINI(IP)*XXFAC
00243           ENDDO
00244         ENDIF
00245 !
00246 !       SECOND LOOP ON ANGULAR SYMMETRY
00247 !
00248         DO IMAGE=1,2
00249 !
00250           KAUX=(IMAGE-1)*4
00251 !
00252 !         THIRD LOOP ON THE DIRECTIONS
00253 !
00254           DO JP=1,NPLAN
00255 !
00256             JPP0 = IANGNL(JP,KAUX+1)
00257             JPP1 = IANGNL(JP,KAUX+2)
00258             JPM0 = IANGNL(JP,KAUX+3)
00259             JPM1 = IANGNL(JP,KAUX+4)
00260 !
00261             IF (JFM0.LT.1) THEN
00262 !
00263 !........./-------------------------------------------------------/
00264 !........./ AT LEAST ONE OF THE FREQUENCIES IS LOWER THAN FREQ(1) /
00265 !........./ THE SPECTRUM F- WITH FREQUENCY (1-XLAMD).FREQ IS ZERO /
00266 !........./-------------------------------------------------------/
00267 !
00268               DO IP=1,NPOIN2
00269                 FDEJF = F(IP,JP,JB )*COEFJF
00270                 FPLUS = F(IP,JPP0,JBP0)*D1 + F(IP,JPP1,JBP0)*D2
00271      &                + F(IP,JPP0,JBP1)*D3 + F(IP,JPP1,JBP1)*D4
00272 !
00273                 TERM1 = FDEJF*FPLUS
00274                 TERM3 = TAUX1(IP)*FDEJF
00275 !
00276                 TAUX2(IP) = TERM1*TERM3
00277                 TAUX3(IP) = 2.D0*TERM1*TAUX1(IP)
00278                 TAUX5(IP) = FDEJF*US1PL4*TERM3
00279               ENDDO ! IP
00280 !
00281               IF (JB.EQ.JF) THEN
00282 !
00283                 DO IP=1,NPOIN2
00284                   TSTOT(IP,JP  ,JF  )=TSTOT(IP,JP  ,JF  )-TAUX2(IP)*2.D0
00285                   TSDER(IP,JP  ,JF  )=TSDER(IP,JP  ,JF  )-TAUX3(IP)*2.D0
00286                 ENDDO ! IP
00287 !
00288                 IF (JBP0.EQ.JFP0) THEN
00289 !
00290                   DO IP=1,NPOIN2
00291                    TSTOT(IP,JPP0,JFP0)=TSTOT(IP,JPP0,JFP0)+TAUX2(IP)*C1
00292                    TSTOT(IP,JPP1,JFP0)=TSTOT(IP,JPP1,JFP0)+TAUX2(IP)*C2
00293                    TSDER(IP,JPP0,JFP0)=TSDER(IP,JPP0,JFP0)
00294      &                                +TAUX5(IP)*C1SQ
00295                    TSDER(IP,JPP1,JFP0)=TSDER(IP,JPP1,JFP0)
00296      &                                +TAUX5(IP)*C2SQ
00297                   ENDDO ! IP
00298 !
00299                   IF (JBP1.EQ.JFP1) THEN
00300 !
00301                     DO IP=1,NPOIN2
00302                      TSTOT(IP,JPP0,JFP1)=TSTOT(IP,JPP0,JFP1)
00303      &                                  +TAUX2(IP)*C3
00304                      TSTOT(IP,JPP1,JFP1)=TSTOT(IP,JPP1,JFP1)
00305      &                                  +TAUX2(IP)*C4
00306                      TSDER(IP,JPP0,JFP1)=TSDER(IP,JPP0,JFP1)
00307      &                                  +TAUX5(IP)*C3SQ
00308                      TSDER(IP,JPP1,JFP1)=TSDER(IP,JPP1,JFP1)
00309      &                                  +TAUX5(IP)*C4SQ
00310                     ENDDO ! IP
00311 !
00312                   ENDIF
00313                 ENDIF
00314               ENDIF
00315 !
00316             ELSE
00317 !
00318 !........./--------------------------------------------------------/
00319 !........./ FREQUENCIES F-, F, F+ MAY HAVE ENERGY                  /
00320 !........./--------------------------------------------------------/
00321 !
00322               DO IP=1,NPOIN2
00323                 FDEJF = F(IP,JP,JB )*COEFJF
00324                 FPLUS = F(IP,JPP0,JBP0)*D1 + F(IP,JPP1,JBP0)*D2
00325      &                + F(IP,JPP0,JBP1)*D3 + F(IP,JPP1,JBP1)*D4
00326                 FMOIN = F(IP,JPM0,JBM0)*D5 + F(IP,JPM1,JBM0)*D6
00327      &                + F(IP,JPM0,JBM1)*D7 + F(IP,JPM1,JBM1)*D8
00328 !
00329                 TERM1 = FDEJF*(FPLUS+FMOIN)
00330                 TERM2 = 2.D0*FPLUS*FMOIN
00331                 TERM3 = TAUX1(IP)*FDEJF
00332 !
00333                 TAUX2(IP) = (TERM1-TERM2)*TERM3
00334                 TAUX3(IP) = (2.D0*TERM1-TERM2)*TAUX1(IP)
00335                 TAUX5(IP) = (FDEJF-2.D0*FMOIN)*US1PL4*TERM3
00336                 TAUX4(IP) = (FDEJF-2.D0*FPLUS)*US1ML4*TERM3
00337               ENDDO ! IP
00338 !
00339               IF (JBM0.EQ.JFM0) THEN
00340 !
00341                 DO IP=1,NPOIN2
00342                   TSTOT(IP,JPM0,JFM0)=TSTOT(IP,JPM0,JFM0)+TAUX2(IP)*C5
00343                   TSTOT(IP,JPM1,JFM0)=TSTOT(IP,JPM1,JFM0)+TAUX2(IP)*C6
00344                   TSDER(IP,JPM0,JFM0)=TSDER(IP,JPM0,JFM0)+TAUX4(IP)*C5SQ
00345                   TSDER(IP,JPM1,JFM0)=TSDER(IP,JPM1,JFM0)+TAUX4(IP)*C6SQ
00346                 ENDDO ! IP
00347 !
00348                 IF (JBM1.EQ.JFM1) THEN
00349 !
00350                   DO IP=1,NPOIN2
00351                     TSTOT(IP,JPM0,JFM1)=TSTOT(IP,JPM0,JFM1)+TAUX2(IP)*C7
00352                     TSTOT(IP,JPM1,JFM1)=TSTOT(IP,JPM1,JFM1)+TAUX2(IP)*C8
00353                     TSDER(IP,JPM0,JFM1)=TSDER(IP,JPM0,JFM1)
00354      &                                 +TAUX4(IP)*C7SQ
00355                     TSDER(IP,JPM1,JFM1)=TSDER(IP,JPM1,JFM1)
00356      &                                 +TAUX4(IP)*C8SQ
00357                   ENDDO ! IP
00358 !
00359                   IF (JB.EQ.JF) THEN
00360 !
00361                     DO IP=1,NPOIN2
00362                       TSTOT(IP,JP  ,JF  )=TSTOT(IP,JP  ,JF  )
00363      &                                   -TAUX2(IP)*2.D0
00364                       TSDER(IP,JP  ,JF  )=TSDER(IP,JP  ,JF  )
00365      &                                   -TAUX3(IP)*2.D0
00366                     ENDDO ! IP
00367 !
00368                     IF (JBP0.EQ.JFP0) THEN
00369 !
00370                       DO IP=1,NPOIN2
00371                         TSTOT(IP,JPP0,JFP0)=TSTOT(IP,JPP0,JFP0)
00372      &                                     +TAUX2(IP)*C1
00373                         TSTOT(IP,JPP1,JFP0)=TSTOT(IP,JPP1,JFP0)
00374      &                                     +TAUX2(IP)*C2
00375                         TSDER(IP,JPP0,JFP0)=TSDER(IP,JPP0,JFP0)
00376      &                                     +TAUX5(IP)*C1SQ
00377                         TSDER(IP,JPP1,JFP0)=TSDER(IP,JPP1,JFP0)
00378      &                                     +TAUX5(IP)*C2SQ
00379                       ENDDO ! IP
00380 !
00381                       IF (JBP1.EQ.JFP1) THEN
00382 !
00383                         DO IP=1,NPOIN2
00384                           TSTOT(IP,JPP0,JFP1)=TSTOT(IP,JPP0,JFP1)
00385      &                                       +TAUX2(IP)*C3
00386                           TSTOT(IP,JPP1,JFP1)=TSTOT(IP,JPP1,JFP1)
00387      &                                       +TAUX2(IP)*C4
00388                           TSDER(IP,JPP0,JFP1)=TSDER(IP,JPP0,JFP1)
00389      &                                       +TAUX5(IP)*C3SQ
00390                           TSDER(IP,JPP1,JFP1)=TSDER(IP,JPP1,JFP1)
00391      &                                       +TAUX5(IP)*C4SQ
00392                         ENDDO ! IP
00393 !
00394                       ENDIF
00395                     ENDIF
00396                   ENDIF
00397                 ENDIF
00398               ENDIF
00399 !
00400             ENDIF
00401 !
00402           ENDDO ! JP
00403 !
00404         ENDDO ! IMAGE
00405 !
00406       ENDDO ! JF
00407 !
00408 !-----------------------------------------------------------------------
00409 !
00410       RETURN
00411       END

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