pentco.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\artemis\pentco.f
00002 !
00115                         SUBROUTINE PENTCO
00116 !                       *****************
00117      &(II)
00118 !
00119 !***********************************************************************
00120 !  ARTEMIS V6P1                                       31/05/11
00121 !***********************************************************************
00122 !
00123 !
00124 !
00125 !
00126 !
00127 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00128 !|    II          |-->|  OPTION FOR GRADIENT AND CURVATURE EFFECTS
00129 !|    T2          |---|  WORK TABLE
00130 !|    T4          |---|  WORK TABLE
00131 !|    T5          |---|  WORK TABLE
00132 !|    T6          |---|  WORK TABLE
00133 !|    T7          |---|  WORK TABLE
00134 !|    T9          |---|  WORK TABLE
00135 !|    T8          |---|  WORK TABLE
00136 !|    T11         |---|  WORK TABLE
00137 !|    T12         |---|  WORK TABLE
00138 !|    T3          |<--|  OUTPUT WORK TABLE WITH CORRECTION TERMS FOR
00139 !|                |   |  GRADIENT AND CURVATURE EFFECTS
00140 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00141 !
00142 ! APPELE PAR                   :  BERKHO
00143 ! SOUS-PROGRAMMES APPELES      :  FCTE1 et FCTE2
00144 ! TABLEAUX DE TRAVAIL UTILISES :  T2 T3 T4 T5 T6 T7 T9 T8 T11 T12
00145 !
00146 !-----------------------------------------------------------------------
00147 !
00148       USE BIEF
00149       USE INTERFACE_ARTEMIS,ONLY: FCTE1,FCTE2
00150       USE DECLARATIONS_TELEMAC
00151       USE DECLARATIONS_ARTEMIS
00152 !
00153       IMPLICIT NONE
00154 !
00155 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00156 !
00157       INTEGER, INTENT(IN) :: II
00158 !
00159 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00160 !
00161       INTEGER I
00162       DOUBLE PRECISION PI,DEGRAD,RADDEG
00163 !
00164 !-----------------------------------------------------------------------
00165 !
00166       PARAMETER( PI = 3.1415926535897932384626433D0 , DEGRAD=PI/180.D0 )
00167       PARAMETER( RADDEG = 180.D0 / PI )
00168 !
00169 !-----------------------------------------------------------------------
00170 !
00171 !
00172 ! MASS MATRIX
00173 !
00174       CALL VECTOR(T2 , '=' , 'MASBAS          ' , IELM ,
00175      &            1.D0 , C , C , C , C , C , C ,
00176      &            MESH , MSK  , MASKEL )
00177 !
00178       IF(II.EQ.1.OR.II.EQ.3) THEN
00179 ! --------------
00180 ! GRADIENT EFFECTS
00181 ! --------------
00182 !
00183 !--->  E1*GRAD(H)**2 ---> IN T4
00184 !
00185 !  DX
00186 !
00187       CALL VECTOR(T7 , '=' , 'GRADF          X' , IELM ,
00188      &            1.D0 , H , T1 , T1 , T1 , T1 , T1 ,
00189      &            MESH , MSK , MASKEL)
00190       CALL OS( 'X=YZ    ' , T4,T7,T7,0.D0)
00191 !
00192 !  DY
00193 !
00194       CALL VECTOR(T7 , '=' , 'GRADF          Y' , IELM ,
00195      &            1.D0 , H , T1 , T1 , T1 , T1 , T1 ,
00196      &            MESH , MSK , MASKEL)
00197       CALL OS( 'X=YZ    ' , T5,T7,T7,0.D0)
00198 !
00199 ! GRAD(H)**2
00200 !
00201       CALL OS( 'X=X+Y   ', T4,T5,SBID,0.D0)
00202 !
00203 ! SQUARE MASS
00204 !
00205       CALL OS( 'X=YZ    ' , T8,T2,T2,0.D0)
00206 !
00207 ! COEFF GRAD(H)**2
00208 !
00209       CALL OS( 'X=Y/Z   ' , T4,T4,T8,0.D0)
00210 !
00211 !---> FUNCTION E1
00212 !
00213       DO I=1,NPOIN
00214         T11%R(I)=FCTE1(  K%R(I)*H%R(I) )
00215       END DO
00216 !
00217 !--->  E1*GRAD(H)**2 ---> IN T4
00218 !
00219       CALL OS( 'X=YZ    ' , T4,T4,T11,0.D0)
00220 ! END OF GRADIENT EFFECTS
00221       ENDIF
00222 !
00223       IF(II.EQ.2.OR.II.EQ.3) THEN
00224 ! ------------------
00225 ! CURVATURE EFFECTS
00226 ! ------------------
00227 !---> E2/K0*LAPLACIAN(H)   ---> IN T9
00228 !  DX
00229       CALL VECTOR(T7 , '=' , 'GRADF          X' , IELM ,
00230      &            1.D0 , H , T1 , T1 , T1 , T1 , T1 ,
00231      &            MESH , MSK , MASKEL)
00232       CALL OS( 'X=Y/Z    ' , T7,T7,T2,0.D0)
00233 
00234       CALL VECTOR(T5 , '=' , 'GRADF          X' , IELM ,
00235      &            1.D0 , T7 , T1 , T1 , T1 , T1 , T1 ,
00236      &            MESH , MSK , MASKEL)
00237 !
00238 ! COEFF DX
00239 !
00240       CALL OS( 'X=Y/Z    ' , T5,T5,T2,0.D0)
00241 !
00242 !  DY
00243 !
00244       CALL VECTOR(T7 , '=' , 'GRADF          Y' , IELM ,
00245      &            1.D0 , H , T1 , T1 , T1 , T1 , T1 ,
00246      &            MESH , MSK , MASKEL)
00247       CALL OS( 'X=Y/Z    ' , T7,T7,T2,0.D0)
00248 !
00249       CALL VECTOR(T6 , '=' , 'GRADF          Y' , IELM ,
00250      &            1.D0 , T7 , T1 , T1 , T1 , T1 , T1 ,
00251      &            MESH , MSK , MASKEL)
00252 !
00253 ! COEFF DY
00254 !
00255       CALL OS( 'X=Y/Z    ' , T6,T6,T2,0.D0)
00256 !
00257       CALL OS( 'X=Y+Z   ', T9,T5,T6,0.D0)
00258 !
00259 !---> FUNCTION E2 * 2 H
00260 !
00261       DO I=1,NPOIN
00262         T12%R(I)=2.*H%R(I) * FCTE2(K%R(I)*H%R(I))
00263       END DO
00264 !
00265 !---> E2/K0*LAPLACIAN(H)
00266 !
00267       CALL OS( 'X=YZ    ' , T9,T9,T12,0.D0)
00268 !
00269 ! END OF CURVATURE EFFECTS
00270       ENDIF
00271 !
00272 ! SUM OF GRADIENT AND CURVTURE EFFECTS, DEPENDING OF OPTION "IPENTCO"
00273 !
00274       IF(II.EQ.1)  THEN
00275 !       F= E1*GRAD(H)**2
00276         CALL OS( 'X=Y      ' , T3,T4,SBID,0.D0)
00277       ENDIF
00278 !
00279       IF(II.EQ.2)  THEN
00280 !       F= E2/K0*LAPLACIAN(H)
00281         CALL OS( 'X=Y      ' , T3,T9,SBID,0.D0)
00282       ENDIF
00283 !
00284       IF(II.EQ.3)  THEN
00285 !       F =  E1*grad(H)**2 + E2/K0*LAPLACIEN(H)
00286         CALL OS( 'X=Y+Z    ' , T3,T4,T9,0.D0)
00287       ENDIF
00288 !
00289 ! ADD 1.,  T3 = 1 + F
00290 !
00291       CALL OS( 'X=X+C   ', T3,SBID,SBID,1.D0)
00292 !
00293 !-----------------------------------------------------------------------
00294 !
00295       RETURN
00296       END

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