qnlin3.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\tomawac\qnlin3.f
00002 !
00048                         SUBROUTINE QNLIN3
00049 !                       *****************
00050 !
00051      &( TSTOT , TSDER , F     , NB_NOD, FREQ  , TETA  , NT    , NF    ,
00052      &  RAISF , TAILF , SEUIL , FSEUIL, LBUF  , DIMBUF, F_POIN, F_COEF,
00053      &  F_PROJ, T_POIN, TB_SCA, NQ_TE1, NQ_OM2, NF1   , NT1   , DFREQ ,
00054      &  K_IF1 , K_IF2 , K_IF3 , TB_V14, TB_V24, TB_V34, K_1P  , K_1M  ,
00055      &  K_1P2P, K_1P3M, K_1P2M, K_1P3P, K_1M2P, K_1M3M, K_1M2M, K_1M3P,
00056      &  TB_TPM, TB_TMP, TB_FAC, NCONF , NCONFM, IDCONF)
00057 !
00058 !***********************************************************************
00059 ! TOMAWAC   V6P1                                   24/06/2011
00060 !***********************************************************************
00061 !
00062 !
00063 !
00064 !reference  LAVRENOV, I.V. (2001):
00065 !+           "EFFECT OF WIND WAVE PARAMETER FLUCTUATION ON THE NONLINEAR
00066 !+           SPECTRUM EVOLUTION". J. PHYS. OCEANOGR. 31, 861-873.
00067 !
00068 !
00069 !
00070 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00071 !| DIMBUF         |-->| VARIABLE FOR SPECTRUM INTERPOLATION
00072 !| DFREQ          |-->| FREQUENCY STEPS BETWEEN DISCRETIZED FREQUENCIES
00073 !| F              |-->| DIRECTIONAL SPECTRUM
00074 !| F_COEF         |-->| WORK TABLE FOR SPECTRUM INTERPOLATION
00075 !| F_POIN         |-->| WORK TABLE FOR SPECTRUM INTERPOLATION
00076 !| F_PROJ         |-->| WORK TABLE FOR SPECTRUM INTERPOLATION
00077 !| FREQ           |-->| DISCRETIZED FREQUENCIES
00078 !| FSEUIL         |-->| WORK TABLE
00079 !| K_IF1          |-->| WORK TABLE
00080 !| K_IF2          |-->| WORK TABLE
00081 !| K_IF3          |-->| WORK TABLE
00082 !| K_1M           |-->| WORK TABLE
00083 !| K_1M2M         |-->| WORK TABLE
00084 !| K_1M2P         |-->| WORK TABLE
00085 !| K_1M3M         |-->| WORK TABLE
00086 !| K_1M3P         |-->| WORK TABLE
00087 !| K_1P           |-->| WORK TABLE
00088 !| K_1P2M         |-->| WORK TABLE
00089 !| K_1P2P         |-->| WORK TABLE
00090 !| K_1P3M         |-->| WORK TABLE
00091 !| K_1P3P         |-->| WORK TABLE
00092 !| IDCONF         |-->| WORK TABLE
00093 !| LBUF           |-->| VARIABLE FOR SPECTRUM INTERPOLATION
00094 !| NB_NOD         |-->| NUMBER OF POINTS IN 2D MESH
00095 !| NCONF          |-->| NUMBER OF RETAINED CONFIGURATIONS
00096 !| NCONFM         |-->| MAXIMUM NUMBER OF CONFIGURATIONS
00097 !| NF             |-->| NUMBER OF FREQUENCIES
00098 !| NF1            |-->| NUMBER OF INTEGRATION POINT ON OMEGA1
00099 !| NQ_OM2         |-->| NUMBER OF INTEGRATION POINT ON OMEGA2
00100 !| NQ_TE1         |-->| SETTING FOR INTEGRATION ON THETA1
00101 !| NT             |-->| NUMBER OF DIRECTIONS
00102 !| NT1            |-->| NUMBER OF INTEGRATION POINT ON TETA1
00103 !| RAISF          |-->| FREQUENTIAL RATIO
00104 !| SEUIL          |-->| THRESHOLD0 FOR CONFIGURATIONS ELIMINATION (GQM)
00105 !| T_POIN         |-->| WORK TABLE FOR SPECTRUM INTERPOLATION
00106 !| TAILF          |-->| SPECTRUM QUEUE FACTOR
00107 !| TB_FAC         |-->| WORK TABLE
00108 !| TB_SCA         |-->| SCALE COEFFICIENT
00109 !| TB_TMP         |-->| WORK TABLE
00110 !| TB_TPM         |-->| WORK TABLE
00111 !| TB_V14         |-->| WORK TABLE
00112 !| TB_V24         |-->| WORK TABLE
00113 !| TB_V34         |-->| WORK TABLE
00114 !| TETA           |-->| DISCRETIZED DIRECTIONS
00115 !| TSDER          |<->| DERIVED PART OF THE SOURCE TERM CONTRIBUTION
00116 !| TSTOT          |<->| TOTAL PART OF THE SOURCE TERM CONTRIBUTION
00117 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00118 !
00119       IMPLICIT NONE
00120 !
00121 !.....VARIABLES IN ARGUMENT
00122 !     """"""""""""""""""""
00123       INTEGER           NF    , NT    , NB_NOD
00124       DOUBLE PRECISION  TAILF , RAISF , SEUIL
00125       DOUBLE PRECISION  FREQ(NF), DFREQ(NF), TETA(NT), FSEUIL(NB_NOD)
00126       DOUBLE PRECISION  F(NB_NOD,NT,NF), TSTOT(NB_NOD,NT,NF)
00127       DOUBLE PRECISION  TSDER(NB_NOD,NT,NF)
00128 !
00129 !.....Variables for spectral-angular interpolation of the spectrum
00130       INTEGER           LBUF  , DIMBUF
00131       INTEGER           F_POIN(DIMBUF), T_POIN(DIMBUF)
00132       DOUBLE PRECISION  F_COEF(DIMBUF), F_PROJ(DIMBUF), TB_SCA(DIMBUF)
00133 !
00134 !.....Transmitted variables for computing QNL4.
00135       INTEGER           NQ_TE1, NQ_OM2, NF1   , NT1
00136       INTEGER           K_IF1(NF1), K_1P(NT1,NF1), K_1M(NT1,NF1)
00137       INTEGER           K_IF2 (NQ_OM2,NT1,NF1), K_IF3 (NQ_OM2,NT1,NF1),
00138      &                  K_1P2P(NQ_OM2,NT1,NF1), K_1P3M(NQ_OM2,NT1,NF1),
00139      &                  K_1P2M(NQ_OM2,NT1,NF1), K_1P3P(NQ_OM2,NT1,NF1),
00140      &                  K_1M2P(NQ_OM2,NT1,NF1), K_1M3M(NQ_OM2,NT1,NF1),
00141      &                  K_1M2M(NQ_OM2,NT1,NF1), K_1M3P(NQ_OM2,NT1,NF1)
00142       DOUBLE PRECISION  TB_V14(NF1)           , TB_FAC(NQ_OM2,NT1,NF1),
00143      &                  TB_V24(NQ_OM2,NT1,NF1), TB_V34(NQ_OM2,NT1,NF1),
00144      &                  TB_TPM(NQ_OM2,NT1,NF1), TB_TMP(NQ_OM2,NT1,NF1)
00145 !
00146 !.....Variables related to the configuration selection
00147       INTEGER           NCONF , NCONFM, IDCONF(NCONFM,3)
00148 !
00149 !.....LOCAL VARIABLES
00150 !     """""""""""""""""
00151       INTEGER           IP    , JF    , JT    , JF1   , JT1   , IQ_OM2,
00152      &                  JFM0  , JFM1  , JFM2  , JFM3  , IXF1  , IXF2  ,
00153      &                  IXF3  , JFMIN , JFMAX , ICONF
00154       INTEGER           KT1P  , KT1M  , JT1P  , JT1M  , KT1P2P, KT1P2M,
00155      &                  KT1P3P, KT1P3M, KT1M2P, KT1M2M, KT1M3P, KT1M3M,
00156      &                  JT1P2P, JT1P2M, JT1P3P, JT1P3M, JT1M2P, JT1M2M,
00157      &                  JT1M3P, JT1M3M
00158       DOUBLE PRECISION  V1_4  , V2_4  , V3_4  , Q_2P3M, Q_2M3P, FACTOR,
00159      &                  T_2P3M, T_2M3P, S_2P3M, S_2M3P, SCAL_T, T2P3M ,
00160      &                  T2M3P , SP0   , SP1P  , SP1M  , SP1P2P, SP1P2M,
00161      &                  SP1P3P, SP1P3M, SP1M2P, SP1M2M, SP1M3P, SP1M3M,
00162      &                  CF0   , CP0   , CF1   , CP1   , CF2   , CP2   ,
00163      &                  CF3   , CP3   , Q2PD0 , Q2PD1 , Q2PD2P, Q2PD3M,
00164      &                  Q2MD0 , Q2MD1 , Q2MD2M, Q2MD3P,
00165      &                  AUX00 , AUX01 , AUX02 , AUX03 , AUX04 , AUX05 ,
00166      &                  AUX06 , AUX07 , AUX08 , AUX09 , AUX10
00167 !
00168 !=======================================================================
00169 !     COMPUTES THE GENERALIZED MIN AND MAX FREQUENCIES : INSTEAD OF GOING
00170 !     FROM 1 TO NF IN FREQ(JF) FOR THE MAIN FREQUENCY, IT GOES FROM JFMIN
00171 !     TO JFMAX
00172 !     JFMIN IS GIVEN BY Fmin=FREQ(1) /Gamma_min
00173 !     JFMAX IS GIVEN BY Fmax=FREQ(NF)*Gamma_max
00174 !     TESTS HAVE SHOWN THAT IT CAN BE ASSUMED Gamma_min=1. (JFMIN=1) AND
00175 !     Gamma_max=1.3 (JFMAX>NF) TO OBTAIN IMPROVED RESULTS
00176 !=======================================================================
00177       JFMIN= 1-INT(DLOG(1.0D0)/DLOG(RAISF))
00178       JFMAX=NF+INT(DLOG(1.3D0)/DLOG(RAISF))
00179 !
00180 !=======================================================================
00181 !     COMPUTES THE SPECTRUM THRESHOLD VALUES (BELOW WHICH QNL4 IS NOT
00182 !     CALCULATED). THE THRESHOLD IS SET WITHIN 0 AND 1.
00183 !=======================================================================
00184       DO IP=1,NB_NOD
00185         AUX00=0.0D0
00186         DO JF=1,NF
00187           DO JT=1,NT
00188             IF (F(IP,JT,JF).GT.AUX00) AUX00=F(IP,JT,JF)
00189           ENDDO
00190         ENDDO
00191         FSEUIL(IP)=AUX00*SEUIL
00192       ENDDO
00193 !=======================================================================
00194 !
00195 !
00196 !
00197 !
00198 !     ==================================================
00199 !     STARTS LOOP 1 OVER THE SELECTED CONFIGURATIONS
00200 !     ==================================================
00201       DO ICONF=1,NCONF
00202 !       ---------selected configuration characteristics
00203         JF1   =IDCONF(ICONF,1)
00204         JT1   =IDCONF(ICONF,2)
00205         IQ_OM2=IDCONF(ICONF,3)
00206 !
00207 !       ---------Recovers V1**4=(f1/f0)**4
00208         V1_4  =TB_V14(JF1)
00209 !       ---------Recovers the shift of the frequency index on f1
00210         IXF1  =K_IF1(JF1)
00211 !       ---------Recovers the direction indexes for Delat1
00212         KT1P  =K_1P(JT1,JF1)
00213         KT1M  =K_1M(JT1,JF1)
00214 !       ---------Recovers V2**4=(f2/f0)**4 and V3**4=(f3/f0)**4
00215         V2_4  =TB_V24(IQ_OM2,JT1,JF1)
00216         V3_4  =TB_V34(IQ_OM2,JT1,JF1)
00217 !       ---------Recovers the frequency indexes shift on f2 and f3
00218         IXF2  =K_IF2 (IQ_OM2,JT1,JF1)
00219         IXF3  =K_IF3 (IQ_OM2,JT1,JF1)
00220 !       ---------Recovers the direction indexes shift
00221         KT1P2P=K_1P2P(IQ_OM2,JT1,JF1)
00222         KT1P2M=K_1P2M(IQ_OM2,JT1,JF1)
00223         KT1P3P=K_1P3P(IQ_OM2,JT1,JF1)
00224         KT1P3M=K_1P3M(IQ_OM2,JT1,JF1)
00225         KT1M2P=K_1M2P(IQ_OM2,JT1,JF1)
00226         KT1M2M=K_1M2M(IQ_OM2,JT1,JF1)
00227         KT1M3P=K_1M3P(IQ_OM2,JT1,JF1)
00228         KT1M3M=K_1M3M(IQ_OM2,JT1,JF1)
00229 !       ---------Recovers the coupling coefficients
00230         T2P3M =TB_TPM(IQ_OM2,JT1,JF1)
00231         T2M3P =TB_TMP(IQ_OM2,JT1,JF1)
00232 !       ---------Recovers the multiplicative factor of QNL4
00233         FACTOR=TB_FAC(IQ_OM2,JT1,JF1)
00234 !
00235 !       = = = = = = = = = = = = = = = = = = = = = = = = =
00236 !       STARTS LOOP 2 OVER THE SPECTRUM FREQUENCIES
00237 !       = = = = = = = = = = = = = = = = = = = = = = = = =
00238         DO JF=JFMIN,JFMAX
00239 !
00240 !.........Recovers the coefficient for the coupling factor
00241 !.........Computes the coupling coefficients for the case +Delta1 (SIG=1)
00242           SCAL_T=TB_SCA(LBUF+JF)*FACTOR
00243           T_2P3M=T2P3M*SCAL_T
00244           T_2M3P=T2M3P*SCAL_T
00245 !
00246 !.........Frequency indexes and coefficients
00247           JFM0=F_POIN(JF+LBUF)
00248           CF0 =F_COEF(JF+LBUF)
00249           CP0 =F_PROJ(JF+LBUF)
00250           JFM1=F_POIN(JF+IXF1)
00251           CF1 =F_COEF(JF+IXF1)
00252           CP1 =F_PROJ(JF+IXF1)
00253           JFM2=F_POIN(JF+IXF2)
00254           CF2 =F_COEF(JF+IXF2)
00255           CP2 =F_PROJ(JF+IXF2)
00256           JFM3=F_POIN(JF+IXF3)
00257           CF3 =F_COEF(JF+IXF3)
00258           CP3 =F_PROJ(JF+IXF3)
00259 !
00260 !         -------------------------------------------------
00261 !         STARTS LOOP 3 OVER THE SPECTRUM DIRECTIONS
00262 !         -------------------------------------------------
00263           DO JT=1,NT
00264 !
00265 !...........Direction indexes
00266 !           direct config (+delta1) (sig =1)
00267             JT1P  =T_POIN(JT+KT1P)
00268             JT1P2P=T_POIN(JT+KT1P2P)
00269             JT1P2M=T_POIN(JT+KT1P2M)
00270             JT1P3P=T_POIN(JT+KT1P3P)
00271             JT1P3M=T_POIN(JT+KT1P3M)
00272 !           image config (-delta1)
00273             JT1M  =T_POIN(JT+KT1M)
00274             JT1M2P=T_POIN(JT+KT1M2P)
00275             JT1M2M=T_POIN(JT+KT1M2M)
00276             JT1M3P=T_POIN(JT+KT1M3P)
00277             JT1M3M=T_POIN(JT+KT1M3M)
00278 !
00279 !           - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
00280 !           STARTS LOOP 4 OVER THE MESH NODES
00281 !           - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
00282             DO IP=1,NB_NOD
00283 !
00284               SP0=F(IP,JT,JFM0)*CF0
00285 !
00286               IF (SP0.GT.FSEUIL(IP)) THEN
00287 !
00288 !               Config. +Delta1 (SIG=1)
00289 !               =======================
00290 !...............Computes the spectrum values in 1, 2, 3
00291                 SP1P  =F(IP,JT1P  ,JFM1)*CF1
00292                 SP1P2P=F(IP,JT1P2P,JFM2)*CF2
00293                 SP1P3M=F(IP,JT1P3M,JFM3)*CF3
00294                 SP1P2M=F(IP,JT1P2M,JFM2)*CF2
00295                 SP1P3P=F(IP,JT1P3P,JFM3)*CF3
00296 !
00297 !...............Computes auxiliary products and variables
00298                 AUX01=SP0*V1_4+SP1P
00299                 AUX02=SP0*SP1P
00300                 AUX03=SP1P2P*SP1P3M
00301                 AUX04=SP1P2P*V3_4+SP1P3M*V2_4
00302                 AUX05=SP1P2M*SP1P3P
00303                 AUX06=SP1P2M*V3_4+SP1P3P*V2_4
00304                 AUX07=AUX02*V3_4
00305                 AUX08=AUX02*V2_4
00306 !
00307 !...............Computes the components of the transfer term
00308                 S_2P3M=AUX03*AUX01-AUX02*AUX04
00309                 S_2M3P=AUX05*AUX01-AUX02*AUX06
00310                 Q_2P3M=T_2P3M*S_2P3M
00311                 Q_2M3P=T_2M3P*S_2M3P
00312                 AUX00 =Q_2P3M+Q_2M3P
00313 !
00314 !...............Computes the components of the derived terms (dQ/dF)
00315                 Q2PD0 =T_2P3M*(AUX03*V1_4   - SP1P*AUX04)*CF0
00316                 Q2PD1 =T_2P3M*(AUX03        - SP0 *AUX04)*CF1
00317                 Q2PD2P=T_2P3M*(AUX01*SP1P3M - AUX07     )*CF2
00318                 Q2PD3M=T_2P3M*(AUX01*SP1P2P - AUX08     )*CF3
00319                   Q2MD0 =T_2M3P*(AUX05*V1_4   - SP1P*AUX06)*CF0
00320                   Q2MD1 =T_2M3P*(AUX03        - SP0 *AUX06)*CF1
00321                   Q2MD2M=T_2M3P*(AUX01*SP1P3P - AUX07     )*CF2
00322                   Q2MD3P=T_2M3P*(AUX01*SP1P2M - AUX08     )*CF3
00323                 AUX09=Q2PD0+Q2MD0
00324                 AUX10=Q2PD1+Q2MD1
00325 !
00326 !...............Sum of Qnl4 term in the table TSTOT
00327                 TSTOT(IP,JT    ,JFM0)=TSTOT(IP,JT    ,JFM0)+AUX00 *CP0
00328                 TSTOT(IP,JT1P  ,JFM1)=TSTOT(IP,JT1P  ,JFM1)+AUX00 *CP1
00329                 TSTOT(IP,JT1P2P,JFM2)=TSTOT(IP,JT1P2P,JFM2)-Q_2P3M*CP2
00330                 TSTOT(IP,JT1P2M,JFM2)=TSTOT(IP,JT1P2M,JFM2)-Q_2M3P*CP2
00331                 TSTOT(IP,JT1P3M,JFM3)=TSTOT(IP,JT1P3M,JFM3)-Q_2P3M*CP3
00332                 TSTOT(IP,JT1P3P,JFM3)=TSTOT(IP,JT1P3P,JFM3)-Q_2M3P*CP3
00333 !
00334 !...............Sum of the term dQnl4/dF in the table TSDER
00335                 TSDER(IP,JT    ,JFM0)=TSDER(IP,JT    ,JFM0)+AUX09 *CP0
00336                 TSDER(IP,JT1P  ,JFM1)=TSDER(IP,JT1P  ,JFM1)+AUX10 *CP1
00337                 TSDER(IP,JT1P2P,JFM2)=TSDER(IP,JT1P2P,JFM2)-Q2PD2P*CP2
00338                 TSDER(IP,JT1P2M,JFM2)=TSDER(IP,JT1P2M,JFM2)-Q2MD2M*CP2
00339                 TSDER(IP,JT1P3M,JFM3)=TSDER(IP,JT1P3M,JFM3)-Q2PD3M*CP3
00340                 TSDER(IP,JT1P3P,JFM3)=TSDER(IP,JT1P3P,JFM3)-Q2MD3P*CP3
00341 !
00342 !               Config. -Delta1 (SIG=-1)
00343 !               ========================
00344 !...............Computes the spectrum values in 1, 2, 3
00345                 SP1M  =F(IP,JT1M  ,JFM1)*CF1
00346                 SP1M2P=F(IP,JT1M2P,JFM2)*CF2
00347                 SP1M3M=F(IP,JT1M3M,JFM3)*CF3
00348                 SP1M2M=F(IP,JT1M2M,JFM2)*CF2
00349                 SP1M3P=F(IP,JT1M3P,JFM3)*CF3
00350 !
00351 !...............Computes auxiliary products and variables
00352                 AUX01=SP0*V1_4+SP1M
00353                 AUX02=SP0*SP1M
00354                 AUX03=SP1M2P*SP1M3M
00355                 AUX04=SP1M2P*V3_4+SP1M3M*V2_4
00356                 AUX05=SP1M2M*SP1M3P
00357                 AUX06=SP1M2M*V3_4+SP1M3P*V2_4
00358                 AUX07=AUX02*V3_4
00359                 AUX08=AUX02*V2_4
00360 !
00361 !...............Computes the transfer term components
00362                 S_2P3M=AUX03*AUX01-AUX02*AUX04
00363                 S_2M3P=AUX05*AUX01-AUX02*AUX06
00364                 Q_2P3M=T_2M3P*S_2P3M
00365                 Q_2M3P=T_2P3M*S_2M3P
00366                 AUX00 =Q_2P3M+Q_2M3P
00367 !
00368 !...............Computes the derived terms components (dQ/dF)
00369                 Q2PD0 =T_2P3M*(AUX03*V1_4   - SP1M*AUX04)*CF0
00370                 Q2PD1 =T_2P3M*(AUX03        - SP0 *AUX04)*CF1
00371                 Q2PD2P=T_2P3M*(AUX01*SP1M3M - AUX07     )*CF2
00372                 Q2PD3M=T_2P3M*(AUX01*SP1M2P - AUX08     )*CF3
00373                   Q2MD0 =T_2M3P*(AUX05*V1_4   - SP1M*AUX06)*CF0
00374                   Q2MD1 =T_2M3P*(AUX03        - SP0 *AUX06)*CF1
00375                   Q2MD2M=T_2M3P*(AUX01*SP1M3P - AUX07     )*CF2
00376                   Q2MD3P=T_2M3P*(AUX01*SP1M2M - AUX08     )*CF3
00377                 AUX09=Q2PD0+Q2MD0
00378                 AUX10=Q2PD1+Q2MD1
00379 !
00380 !...............Sum of Qnl4 term in the table TSTOT
00381                 TSTOT(IP,JT    ,JFM0)=TSTOT(IP,JT    ,JFM0)+AUX00 *CP0
00382                 TSTOT(IP,JT1M  ,JFM1)=TSTOT(IP,JT1M  ,JFM1)+AUX00 *CP1
00383                 TSTOT(IP,JT1M2P,JFM2)=TSTOT(IP,JT1M2P,JFM2)-Q_2P3M*CP2
00384                 TSTOT(IP,JT1M2M,JFM2)=TSTOT(IP,JT1M2M,JFM2)-Q_2M3P*CP2
00385                 TSTOT(IP,JT1M3M,JFM3)=TSTOT(IP,JT1M3M,JFM3)-Q_2P3M*CP3
00386                 TSTOT(IP,JT1M3P,JFM3)=TSTOT(IP,JT1M3P,JFM3)-Q_2M3P*CP3
00387 !
00388 !...............Sum of the term dQnl4/dF in the table TSDER
00389                 TSDER(IP,JT    ,JFM0)=TSDER(IP,JT    ,JFM0)+AUX09 *CP0
00390                 TSDER(IP,JT1M  ,JFM1)=TSDER(IP,JT1M  ,JFM1)+AUX10 *CP1
00391                 TSDER(IP,JT1M2P,JFM2)=TSDER(IP,JT1M2P,JFM2)-Q2PD2P*CP2
00392                 TSDER(IP,JT1M2M,JFM2)=TSDER(IP,JT1M2M,JFM2)-Q2MD2M*CP2
00393                 TSDER(IP,JT1M3M,JFM3)=TSDER(IP,JT1M3M,JFM3)-Q2PD3M*CP3
00394                 TSDER(IP,JT1M3P,JFM3)=TSDER(IP,JT1M3P,JFM3)-Q2MD3P*CP3
00395 !
00396               ENDIF
00397 !
00398             ENDDO
00399 !           - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
00400 !           END OF LOOP 4 OVER THE MESH NODES
00401 !           - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
00402 !
00403           ENDDO
00404 !         -------------------------------------------------
00405 !         END OF LOOP 3 OVER THE SPECTRUM DIRECTIONS
00406 !         -------------------------------------------------
00407 !
00408         ENDDO
00409 !       = = = = = = = = = = = = = = = = = = = = = = = = =
00410 !       END OF LOOP 2 OVER THE SPECTRUM FREQUENCIES
00411 !       = = = = = = = = = = = = = = = = = = = = = = = = =
00412 !
00413       ENDDO
00414 !     ==================================================
00415 !     END OF LOOP 1 OVER THE SELECTED CONFIGURATIONS
00416 !     ==================================================
00417 !
00418       RETURN
00419       END

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