initab.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\tomawac\initab.f
00002 !
00113                      SUBROUTINE INITAB
00114 !                    *****************
00115 !
00116      &(IBOR1,IFABOR1,NELEM2_DIM,PART)
00117 !
00118 !***********************************************************************
00119 ! TOMAWAC   V7P0                                   20/06/2011
00120 !***********************************************************************
00121 !
00122 !
00123 !
00124 !
00125 !
00126 !
00127 !
00128 !
00129 !
00130 !
00131 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00132 !| IBOR1          |<--| WORK TABLE
00133 !| IFABOR1        |-->| ELEMENTS BEHIND THE EDGES OF A TRIANGLE
00134 !|                |   | IF NEGATIVE OR ZERO, THE EDGE IS A LIQUID,
00135 !|                |   | SOLID OR PERIODIC BOUNDARY
00136 !| NELEM2_DIM     |---| NUMBER OF ELEMENTS IN 2D
00137 !| PART           |-->| FLAG FOR DIRECT COUPLING WITH TELEMAC
00138 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00139 !
00140       USE BIEF
00141       USE DECLARATIONS_TELEMAC
00142       USE DECLARATIONS_TOMAWAC
00143 !
00144       IMPLICIT NONE
00145 !
00146 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00147 !
00148       INTEGER, INTENT(IN)    :: PART,NELEM2_DIM
00149       INTEGER, INTENT(IN)    :: IFABOR1(NELEM2_DIM,3)
00150       INTEGER, INTENT(INOUT) :: IBOR1(NELEM2_DIM,7)
00151 !
00152 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00153 !
00154       INTEGER IPLAN,IPOIN,IELEM2,IFREQ
00155       DOUBLE PRECISION AUXI,C
00156 !
00157 !-----------------------------------------------------------------------
00158 !
00159       DO IPLAN = 1,NPLAN
00160         COSTET(IPLAN) = COS(TETA(IPLAN))
00161         SINTET(IPLAN) = SIN(TETA(IPLAN))
00162         ETAP1(IPLAN)=IPLAN+1
00163       ENDDO
00164       ETAP1(NPLAN)=1
00165 !
00166       AUXI=(RAISF-1.D0)/2.D0
00167       DFREQ(1)=AUXI*FREQ(1)
00168       DFREQ(NF)=AUXI*FREQ(NF-1)
00169       DO IFREQ = 2,NF-1
00170         DFREQ(IFREQ) = AUXI*(FREQ(IFREQ)+FREQ(IFREQ-1))
00171         DO IPOIN=1,NPOIN2
00172           B(IPOIN+(IFREQ-1)*NPOIN2)=0.D0
00173         ENDDO
00174       ENDDO
00175 !
00176       IF(SPHE) THEN
00177         DO IPOIN=1,NPOIN2
00178           COSF(IPOIN)=COS(Y(IPOIN)*DEGRAD)
00179           TGF(IPOIN)=TAN(Y(IPOIN)*DEGRAD)
00180         ENDDO
00181       ENDIF
00182 !
00183       DO IELEM2=1,NELEM2
00184         IBOR1(IELEM2,1)=IFABOR1(IELEM2,1)
00185         IBOR1(IELEM2,2)=IFABOR1(IELEM2,2)
00186         IBOR1(IELEM2,3)=IFABOR1(IELEM2,3)
00187         IBOR1(IELEM2,4)=1
00188         IBOR1(IELEM2,5)=1
00189         IBOR1(IELEM2,6)=1
00190         IBOR1(IELEM2,7)=1
00191       ENDDO
00192 !
00193 !     INITIALISES THE VARIABLE BETA
00194 !
00195       DO IPOIN=1,NPOIN2
00196         BETA(IPOIN)=0.D0
00197       ENDDO
00198 !
00199 !     INITIALISES THE GRADIENTS OF DEPTH, U AND V
00200 !
00201 !
00202 !     INVERSE OF INTEGRAL OF TEST FUNCTIONS
00203 !
00204       IF(.NOT.PROINF.OR.COURAN.OR.PART.EQ.0) THEN
00205         CALL VECTOR(ST0,'=','MASBAS          ',IELM2,1.D0,MESH%X,
00206      &              ST0,ST0,ST0,ST0,ST0,MESH,.FALSE.,ST0,
00207      &              ASSPAR=.TRUE.)
00208         CALL OV('X=1/Y   ',ST0%R,ST0%R,ST0%R,C,NPOIN2)
00209       ENDIF
00210 !
00211 !     NOW PROJECTED GRADIENTS DIVIDED BY INTEGRALS OF TEST FUNCTIONS
00212 !
00213       IF(.NOT.PROINF) THEN
00214         CALL VECTOR(SDZX,'=','GRADF          X',IELM2,1.D0,SDEPTH,
00215      &              ST0,ST0,ST0,ST0,ST0,MESH,.FALSE.,ST0,
00216      &              ASSPAR=.TRUE.)
00217         CALL VECTOR(SDZY,'=','GRADF          Y',IELM2,1.D0,SDEPTH,
00218      &              ST0,ST0,ST0,ST0,ST0,MESH,.FALSE.,ST0,
00219      &              ASSPAR=.TRUE.)
00220         CALL OV('X=XY    ',SDZX%R,ST0%R,ST0%R,C,NPOIN2)
00221         CALL OV('X=XY    ',SDZY%R,ST0%R,ST0%R,C,NPOIN2)
00222       ENDIF
00223 !
00224       IF(COURAN.OR.PART.EQ.0) THEN
00225         CALL VECTOR(SDUX,'=','GRADF          X',IELM2,1.D0,SUC,
00226      &              ST0,ST0,ST0,ST0,ST0,MESH,.FALSE.,ST0,ASSPAR=.TRUE.)
00227         CALL VECTOR(SDVX,'=','GRADF          X',IELM2,1.D0,SVC,
00228      &              ST0,ST0,ST0,ST0,ST0,MESH,.FALSE.,ST0,ASSPAR=.TRUE.)
00229         CALL VECTOR(SDUY,'=','GRADF          Y',IELM2,1.D0,SUC,
00230      &              ST0,ST0,ST0,ST0,ST0,MESH,.FALSE.,ST0,ASSPAR=.TRUE.)
00231         CALL VECTOR(SDVY,'=','GRADF          Y',IELM2,1.D0,SVC,
00232      &              ST0,ST0,ST0,ST0,ST0,MESH,.FALSE.,ST0,ASSPAR=.TRUE.)
00233         CALL OV('X=XY    ',SDUX%R,ST0%R,ST0%R,C,NPOIN2)
00234         CALL OV('X=XY    ',SDVX%R,ST0%R,ST0%R,C,NPOIN2)
00235         CALL OV('X=XY    ',SDUY%R,ST0%R,ST0%R,C,NPOIN2)
00236         CALL OV('X=XY    ',SDVY%R,ST0%R,ST0%R,C,NPOIN2)
00237       ENDIF
00238 !
00239 !-----------------------------------------------------------------------
00240 !
00241       RETURN
00242       END

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