ov.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\ov.f
00002 !
00104                      SUBROUTINE OV
00105 !                    *************
00106 !
00107      & ( OP , X , Y , Z , C , NPOIN )
00108 !
00109 !***********************************************************************
00110 ! BIEF   V6P1                                   21/08/2010
00111 !***********************************************************************
00112 !
00113 !
00114 !
00115 !
00116 !
00117 !
00118 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00119 !| C              |-->| A GIVEN CONSTANT
00120 !| NPOIN          |-->| SIZE OF VECTORS
00121 !| OP             |-->| STRING INDICATING THE OPERATION TO BE DONE
00122 !| X              |<--| RESULTING VECTOR
00123 !| Y              |-->| TO BE USED IN THE OPERATION
00124 !| Z              |-->| TO BE USED IN THE OPERATION
00125 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00126 !
00127       IMPLICIT NONE
00128       INTEGER LNG,LU
00129       COMMON/INFO/LNG,LU
00130 !
00131 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00132 !
00133       INTEGER, INTENT(IN)             :: NPOIN
00134       DOUBLE PRECISION, INTENT(IN)    :: Y(NPOIN),Z(NPOIN),C
00135       DOUBLE PRECISION, INTENT(INOUT) :: X(NPOIN)
00136       CHARACTER(LEN=8), INTENT(IN)    :: OP
00137 !
00138 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00139 !
00140       INTEGER I
00141 !
00142       INTRINSIC SQRT,ABS,COS,SIN,ATAN,MAX,MIN
00143 !
00144 !-----------------------------------------------------------------------
00145 !
00146       SELECT CASE(OP(3:8))
00147 !
00148 !-----------------------------------------------------------------------
00149 !
00150         CASE('C     ')
00151 !
00152         DO I=1,NPOIN
00153           X(I) = C
00154         ENDDO
00155 !
00156 !-----------------------------------------------------------------------
00157 !
00158         CASE('0     ')
00159 !
00160         DO I=1,NPOIN
00161           X(I) = 0.D0
00162         ENDDO
00163 !
00164 !-----------------------------------------------------------------------
00165 !
00166         CASE('Y     ')
00167 !
00168         DO I=1,NPOIN
00169           X(I) = Y(I)
00170         ENDDO
00171 !
00172 !-----------------------------------------------------------------------
00173 !
00174         CASE('+Y    ')
00175 !
00176         DO I=1,NPOIN
00177           X(I) = Y(I)
00178         ENDDO
00179 !
00180 !-----------------------------------------------------------------------
00181 !
00182         CASE('-Y    ')
00183 !
00184         DO I=1,NPOIN
00185           X(I) = - Y(I)
00186         ENDDO
00187 !
00188 !-----------------------------------------------------------------------
00189 !
00190         CASE('1/Y   ')
00191 !
00192         DO I=1,NPOIN
00193           X(I) = 1.D0/Y(I)
00194         ENDDO
00195 !
00196 !-----------------------------------------------------------------------
00197 !
00198         CASE('Y+Z   ')
00199 !
00200         DO I=1,NPOIN
00201           X(I) = Y(I) + Z(I)
00202         ENDDO
00203 !
00204 !-----------------------------------------------------------------------
00205 !
00206         CASE('Y-Z   ')
00207 !
00208         DO I=1,NPOIN
00209           X(I) = Y(I) - Z(I)
00210         ENDDO
00211 !
00212 !-----------------------------------------------------------------------
00213 !
00214         CASE('YZ    ')
00215 !
00216         DO I=1,NPOIN
00217           X(I) = Y(I) * Z(I)
00218         ENDDO
00219 !
00220 !-----------------------------------------------------------------------
00221 !
00222         CASE('-YZ   ')
00223 !
00224         DO I=1,NPOIN
00225           X(I) = - Y(I) * Z(I)
00226         ENDDO
00227 !
00228 !-----------------------------------------------------------------------
00229 !
00230         CASE('XY    ')
00231 !
00232         DO I=1,NPOIN
00233           X(I) = X(I) * Y(I)
00234         ENDDO
00235 !
00236 !-----------------------------------------------------------------------
00237 !
00238         CASE('X+YZ  ')
00239 !
00240         DO I=1,NPOIN
00241           X(I) = X(I) + Y(I) * Z(I)
00242         ENDDO
00243 !
00244 !-----------------------------------------------------------------------
00245 !
00246         CASE('X-YZ  ')
00247 !
00248         DO I=1,NPOIN
00249           X(I) = X(I) - Y(I) * Z(I)
00250         ENDDO
00251 !
00252 !-----------------------------------------------------------------------
00253 !
00254         CASE('CXY   ')
00255 !
00256         DO I=1,NPOIN
00257            X(I) = C * X(I) * Y(I)
00258         ENDDO
00259 !
00260 !-----------------------------------------------------------------------
00261 !
00262         CASE('CYZ   ')
00263 !
00264         DO I=1,NPOIN
00265           X(I) = C * Y(I) * Z(I)
00266         ENDDO
00267 !
00268 !-----------------------------------------------------------------------
00269 !
00270         CASE('CXYZ  ')
00271 !
00272         DO I=1,NPOIN
00273           X(I) = C * X(I) * Y(I) * Z(I)
00274         ENDDO
00275 !
00276 !-----------------------------------------------------------------------
00277 !
00278         CASE('X+CYZ ')
00279 !
00280         DO I=1,NPOIN
00281           X(I) = X(I) + C * Y(I) * Z(I)
00282         ENDDO
00283 !
00284 !-----------------------------------------------------------------------
00285 !
00286         CASE('Y/Z   ')
00287 !
00288         DO I=1,NPOIN
00289           X(I) = Y(I) / Z(I)
00290         ENDDO
00291 !
00292 !-----------------------------------------------------------------------
00293 !
00294         CASE('CY/Z  ')
00295 !
00296         DO I=1,NPOIN
00297           X(I) = C*Y(I) / Z(I)
00298         ENDDO
00299 !
00300 !-----------------------------------------------------------------------
00301 !
00302         CASE('CXY/Z ')
00303 !
00304         DO I=1,NPOIN
00305           X(I) = C*X(I)*Y(I) / Z(I)
00306         ENDDO
00307 !
00308 !-----------------------------------------------------------------------
00309 !
00310         CASE('X+CY/Z')
00311 !
00312         DO I=1,NPOIN
00313           X(I) = X(I) + C * Y(I) / Z(I)
00314         ENDDO
00315 !
00316 !-----------------------------------------------------------------------
00317 !
00318         CASE('X+Y   ')
00319 !
00320         DO I=1,NPOIN
00321           X(I) = X(I) + Y(I)
00322         ENDDO
00323 !
00324 !-----------------------------------------------------------------------
00325 !
00326         CASE('X-Y   ')
00327 !
00328         DO I=1,NPOIN
00329           X(I) = X(I) - Y(I)
00330         ENDDO
00331 !
00332 !-----------------------------------------------------------------------
00333 !
00334         CASE('CX    ')
00335 !
00336         DO I=1,NPOIN
00337           X(I) = C * X(I)
00338         ENDDO
00339 !
00340 !-----------------------------------------------------------------------
00341 !
00342         CASE('CY    ')
00343 !
00344         DO I=1,NPOIN
00345           X(I) = C * Y(I)
00346         ENDDO
00347 !
00348 !-----------------------------------------------------------------------
00349 !
00350         CASE('Y+CZ  ')
00351 !
00352         DO I=1,NPOIN
00353           X(I) = Y(I) + C * Z(I)
00354         ENDDO
00355 !
00356 !-----------------------------------------------------------------------
00357 !
00358         CASE('X+CY  ')
00359 !
00360         DO I=1,NPOIN
00361           X(I) = X(I) + C * Y(I)
00362         ENDDO
00363 !
00364 !-----------------------------------------------------------------------
00365 !
00366         CASE('SQR(Y)')
00367 !
00368         DO I=1,NPOIN
00369           X(I) = SQRT(Y(I))
00370         ENDDO
00371 !
00372 !-----------------------------------------------------------------------
00373 !
00374         CASE('ABS(Y)')
00375 !
00376         DO I=1,NPOIN
00377           X(I) = ABS(Y(I))
00378         ENDDO
00379 !
00380 !-----------------------------------------------------------------------
00381 !
00382         CASE('N(Y,Z)')
00383 !
00384         DO I=1,NPOIN
00385           X(I) = SQRT( Y(I)**2 + Z(I)**2 )
00386         ENDDO
00387 !
00388 !-----------------------------------------------------------------------
00389 !
00390         CASE('Y+C   ')
00391 !
00392         DO I=1,NPOIN
00393           X(I) = Y(I) + C
00394         ENDDO
00395 !
00396 !-----------------------------------------------------------------------
00397 !
00398         CASE('X+C   ')
00399 !
00400         DO I=1,NPOIN
00401           X(I) = X(I) + C
00402         ENDDO
00403 !
00404 !-----------------------------------------------------------------------
00405 !
00406         CASE('Y**C  ')
00407 !
00408         DO I=1,NPOIN
00409           IF(Y(I).GE.0.D0) THEN
00410             X(I) = Y(I)**C
00411           ELSE
00412             IF (LNG.EQ.1) WRITE(LU,100)
00413             IF (LNG.EQ.2) WRITE(LU,101)
00414 100         FORMAT(1X,'OV (BIEF) : Y**C INTERDIT SI Y < 0')
00415 101         FORMAT(1X,'OV (BIEF): Y**C FORBIDDEN IF Y < 0')
00416             CALL PLANTE(1)
00417             STOP
00418           ENDIF
00419         ENDDO
00420 !
00421 !-----------------------------------------------------------------------
00422 !
00423         CASE('COS(Y)')
00424 !
00425         DO I=1,NPOIN
00426           X(I) = COS(Y(I))
00427         ENDDO
00428 !
00429 !-----------------------------------------------------------------------
00430 !
00431         CASE('SIN(Y)')
00432 !
00433         DO I=1,NPOIN
00434           X(I) = SIN(Y(I))
00435         ENDDO
00436 !
00437 !-----------------------------------------------------------------------
00438 !
00439         CASE('ATN(Y)')
00440 !
00441         DO I=1,NPOIN
00442           X(I) = ATAN(Y(I))
00443         ENDDO
00444 !
00445 !-----------------------------------------------------------------------
00446 !
00447         CASE('A(Y,Z)')
00448 !
00449         DO I=1,NPOIN
00450           X(I) = ATAN2(Y(I),Z(I))
00451         ENDDO
00452 !
00453 !-----------------------------------------------------------------------
00454 !
00455         CASE('+(Y,C)')
00456 !
00457         DO I=1,NPOIN
00458           X(I) = MAX(Y(I),C)
00459         ENDDO
00460 !
00461 !-----------------------------------------------------------------------
00462 !
00463         CASE('-(Y,C)')
00464 !
00465         DO I=1,NPOIN
00466           X(I) = MIN(Y(I),C)
00467         ENDDO
00468 !
00469 !-----------------------------------------------------------------------
00470 !
00471         CASE('+(Y,Z)')
00472 !
00473         DO I=1,NPOIN
00474           X(I) = MAX(Y(I),Z(I))
00475         ENDDO
00476 !
00477 !-----------------------------------------------------------------------
00478 !
00479         CASE('-(Y,Z)')
00480 !
00481         DO I=1,NPOIN
00482           X(I) = MIN(Y(I),Z(I))
00483         ENDDO
00484 !
00485 !-----------------------------------------------------------------------
00486 !
00487         CASE('YIFZ<C')
00488 !
00489         DO I=1,NPOIN
00490           IF ( Z(I).LT.C ) X(I) = Y(I)
00491         ENDDO
00492 !
00493 !-----------------------------------------------------------------------
00494 !
00495         CASE('C(Y-Z)')
00496 !
00497         DO I=1,NPOIN
00498           X(I) = C*(Y(I)-Z(I))
00499         ENDDO
00500 !
00501 !-----------------------------------------------------------------------
00502 !
00503         CASE DEFAULT
00504 !
00505           IF (LNG.EQ.1) WRITE(LU,1000) OP
00506           IF (LNG.EQ.2) WRITE(LU,1001) OP
00507 1000      FORMAT(1X,'OV (BIEF) : OPERATION INCONNUE: ',A8)
00508 1001      FORMAT(1X,'OV (BIEF) : UNKNOWN OPERATION: ',A8)
00509           CALL PLANTE(1)
00510           STOP
00511 !
00512 !-----------------------------------------------------------------------
00513 !
00514       END SELECT
00515 !
00516 !-----------------------------------------------------------------------
00517 !
00518       RETURN
00519       END

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