charac.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\charac.f
00002 !
00090                      SUBROUTINE CHARAC
00091 !                    *****************
00092 !
00093      &( FN    , FTILD  , NOMB  , UCONV  , VCONV , WCONV  , FRCONV ,
00094      &  ZSTAR , FREQ   ,
00095      &  DT    , IFAMAS , IELM  , NPOIN2 , NPLAN , JF     , NF     ,
00096      &  MSK   , MASKEL , SHP   , SHZ    , SHF   , TB     , ELT    ,
00097      &  ETA   , FRE    , IT3   , ISUB   , FREBUF, MESH   ,
00098      &  NELEM2, NELMAX2, IKLE2 , SURDET2, AM1   , RHS    , SLV    ,
00099      &  AGGLO , LISTIN , NGAUSS, UNSV   , OPTCHA, POST   , PERIO  ,
00100      &  YA4D  , SIGMA  , STOCHA, VISC )
00101 !
00102 !***********************************************************************
00103 ! BIEF   V6P3                                   21/08/2010
00104 !***********************************************************************
00105 !
00106 !
00107 !
00108 !
00109 !
00110 !
00111 !
00112 !
00113 !
00114 !
00115 !
00116 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00117 !| AGGLO          |-->| MASS-LUMPING (FOR WEAK FORM)
00118 !| AM1            |<->| A MATRIX (FOR WEAK FORM)
00119 !| RHS            |<->| A RIGHT-HAND SIDE (FOR WEAK FORM)
00120 !| DT             |-->| TIME STEP
00121 !| ELT            |<->| ARRIVAL ELEMENT
00122 !| ETA            |<->| ARRIVAL LAYER (IN 3D WITH PRISMS)
00123 !| FRCONV         |-->| FREQUENCY COMPONENT OF ADVECTION FIELD
00124 !| FRE            |<->| ARRIVAL FREQUENCY (IN 4D)
00125 !| FREBUF         |<->| INTEGER WORK ARRAY (IN 4D)
00126 !| FREQ           |-->| DISCRETISED FREQUENCIES (IN 4D).
00127 !|                |   | IF NOT TOMAWAC, MUST BE ZSTAR !!!!!!!!!!!
00128 !| FN             |-->| VARIABLES AT TIME N .
00129 !| FTILD          |<--| VARIABLES AFTER ADVECTION .
00130 !| IELM           |-->| TYPE OF ELEMENT : 11 : TRIANGLE P1
00131 !|                |   |                   41 : PRISM IN TELEMAC3D
00132 !| IFAMAS         |-->| A MODIFIED IFABOR WHEN ELEMENTS ARE MASKED
00133 !| IKLE2          |-->| CONNECTIVITY TABLE FOR TRIANGLES
00134 !| IT3            |<->| INTEGER WORK ARRAY
00135 !| ISUB           |<->| ARRIVAL SUB-DOMAIN (IN PARALLEL)
00136 !| JF             |-->| FREQUENCY (IN A RANGE OF 1 TO NF)
00137 !| LISTIN         |-->| IF YES, PRINTS INFORMATIONS ON LISTING (WEAK FORM)
00138 !| MASKEL         |-->| MASKING OF ELEMENTS
00139 !|                |   | =1. : NORMAL   =0. : MASKED ELEMENT
00140 !| MESH           |-->| MESH STRUCTURE
00141 !| MSK            |-->| IF YES, THERE IS MASKED ELEMENTS.
00142 !| NELEM2         |-->| NUMBER OF ELEMENTS IN 2D
00143 !| NELMAX2        |-->| MAXIMUM NUMBER OF ELEMENTS IN 2D
00144 !| NF             |-->| NUMBER OF FREQUENCIES (IN 4D)
00145 !| NGAUSS         |-->| NUMBER OF GAUSS POINTS (WEAK FORM)
00146 !| NOMB           |-->| NUMBER OF VARIABLES TO BE ADVECTED
00147 !| NPLAN          |-->| NUMBER OF PLANES IN THE 3D MESH OF PRISMS
00148 !| NPOIN2         |-->| NUMBER OF POINTS IN THE 2D MESH
00149 !| OPTCHA         |-->| OPTION FOR THE FORM OF CHARACTERISTICS
00150 !|                |   | 1 : STRONG (CLASSICAL) FORM
00151 !|                |   | 2 : BACKWARD WEAK FORM
00152 !| PERIO          |-->| IF YES, PERIODIC VERSION ON THE VERTICAL
00153 !| POST           |-->| IF YES, DATA MUST BE KEPT FOR A POSTERIORI
00154 !|                |   | INTERPOLATION
00155 !| SHP            |<->| BARYCENTRIC COORDINATES OF POINTS IN TRIANGLES
00156 !| SHZ            |<->| BARYCENTRIC COORDINATES ON VERTICAL
00157 !| SHF            |<->| BARYCENTRIC COORDINATES ON THE FREQUENCY AXIS
00158 !| SIGMA          |-->| IF YES, TRANSFORMES MESH FOR TELEMAC-3D
00159 !| SLV            |-->| A SOLVER CONFIGURATION (FOR WEAK FORM)
00160 !| STOCHA         |-->| STOCHASTIC DIFFUSION MODEL
00161 !|                |   | 0: NO DIFFUSION 1: oil spill       2: algae
00162 !| SURDET2        |-->| GEOMETRIC COEFFICIENT USED IN PARAMETRIC TRANSFORMATION
00163 !| TB             |<->| BLOCK CONTAINING THE BIEF_OBJ WORK ARRAYS
00164 !| UCONV          |-->| X-COMPONENT OF ADVECTION FIELD
00165 !| UNSV           |-->| 1/(INTEGRAL OF TEST FUNCTIONS)
00166 !| VCONV          |-->| Y-COMPONENT OF ADVECTION FIELD
00167 !| VISC           |-->| VISCOSITY (MAY BE TENSORIAL)
00168 !| WCONV          |-->| Z-COMPONENT OF ADVECTION FIELD IN THE TRANSFORMED MESH
00169 !| YA4D           |-->| IF YES, 4D VERSION FOR TOMAWAC
00170 !| ZSTAR          |-->| TRANSFORMED VERTICAL COORDINATES IN 3D
00171 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00172 !
00173       USE BIEF, EX_CHARAC => CHARAC
00174       USE STREAMLINE, ONLY : SCARACT
00175 !
00176       IMPLICIT NONE
00177       INTEGER LNG,LU
00178       COMMON/INFO/LNG,LU
00179 !
00180 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00181 !
00182       INTEGER         , INTENT(IN)           :: NOMB,OPTCHA,NGAUSS
00183       INTEGER         , INTENT(IN)           :: NPLAN,JF,NF,NELEM2
00184       INTEGER         , INTENT(IN)           :: NPOIN2,NELMAX2
00185       INTEGER         , INTENT(INOUT)        :: IELM,FRE(*)
00186 !     NEXT 4 DIMENSIONS ARE A MINIMUM IT IS MORE WITH WEAK FORM
00187       INTEGER         , INTENT(INOUT),TARGET :: ELT(NPOIN2*NPLAN)
00188       INTEGER         , INTENT(INOUT),TARGET :: ETA(NPOIN2*NPLAN)
00189       INTEGER         , INTENT(INOUT),TARGET :: IT3(NPOIN2*NPLAN)
00190       INTEGER         , INTENT(INOUT),TARGET :: ISUB(NPOIN2*NPLAN)
00191       INTEGER         , INTENT(INOUT)        :: FREBUF(*)
00192       TYPE(BIEF_OBJ)  , INTENT(IN)           :: FN,UCONV,VCONV,WCONV
00193       TYPE(BIEF_OBJ)  , INTENT(IN)           :: FRCONV
00194       TYPE(BIEF_OBJ)  , INTENT(IN)           :: ZSTAR,MASKEL,IKLE2
00195       TYPE(BIEF_OBJ)  , INTENT(IN)           :: SURDET2,FREQ,UNSV
00196       TYPE(BIEF_OBJ)  , INTENT(INOUT)        :: TB,SHF,AM1,RHS
00197       TYPE(BIEF_OBJ)  , INTENT(INOUT),TARGET :: FTILD,SHP,SHZ
00198       LOGICAL         , INTENT(IN)           :: MSK,LISTIN
00199       DOUBLE PRECISION, INTENT(IN)           :: DT,AGGLO
00200       TYPE(BIEF_MESH) , INTENT(INOUT)        :: MESH
00201       TYPE(BIEF_OBJ)  , INTENT(IN), TARGET   :: IFAMAS
00202       TYPE(SLVCFG)    , INTENT(INOUT)        :: SLV
00203 !
00204       LOGICAL, INTENT(IN), OPTIONAL          :: POST,PERIO,YA4D,SIGMA
00205       INTEGER, INTENT(IN), OPTIONAL          :: STOCHA
00206       TYPE(BIEF_OBJ), INTENT(IN), OPTIONAL, TARGET :: VISC
00207 !
00208 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00209 !
00210       INTEGER NPOIN,IELMU,SIZEBUF,ASTOCHA
00211 !
00212 !-----------------------------------------------------------------------
00213 !
00214       TYPE(BIEF_OBJ), POINTER :: T1,T2,T3,T4,T5,T6,T7,T8,T9,T10,AVISC
00215       TYPE(BIEF_OBJ), POINTER :: PT_FTILD,PT_SHPBUF
00216       TYPE(BIEF_OBJ), TARGET  :: T1WEAK,T2WEAK,T3WEAK,T4WEAK,T5WEAK
00217       TYPE(BIEF_OBJ), TARGET  :: T6WEAK,T7WEAK,SHPWEA
00218       TYPE(BIEF_OBJ), TARGET  :: FTILD_WEAK,SHPBUF,SHZBUF,SHZWEA
00219       INTEGER, DIMENSION(:), POINTER :: IFA
00220       DOUBLE PRECISION, DIMENSION(:), POINTER :: PT_SHP,PT_SHZ
00221       INTEGER I,NPT,DIM1F,IPLAN,NG
00222       LOGICAL QUAD,QUAB,APOST,APERIO,AYA4D,ASIGMA,DEJA
00223       DATA DEJA/.FALSE./
00224       INTRINSIC MIN
00225       SAVE
00226 !
00227 !-----------------------------------------------------------------------
00228 !
00229       IF(OPTCHA.GT.1) THEN
00230         IF(IELM.EQ.11) THEN
00231           NG=NGAUSS*NELEM2
00232         ELSEIF(IELM.EQ.41) THEN
00233           NG=NGAUSS*NELEM2*(NPLAN-1)
00234         ENDIF
00235         IF(.NOT.DEJA) THEN
00236           CALL ALLBLO(FTILD_WEAK,'FTIWEA')
00237           CALL BIEF_ALLVEC_IN_BLOCK(FTILD_WEAK,FTILD%N,1,
00238      &                              'FTW   ',NG,1,0,MESH)
00239           CALL BIEF_ALLVEC(1,T1WEAK,'T1WEAK',NG,1,0,MESH)
00240           CALL BIEF_ALLVEC(1,T2WEAK,'T2WEAK',NG,1,0,MESH)
00241           CALL BIEF_ALLVEC(1,T4WEAK,'T4WEAK',NG,1,0,MESH)
00242           CALL BIEF_ALLVEC(1,T5WEAK,'T5WEAK',NG,1,0,MESH)
00243           CALL BIEF_ALLVEC(1,SHPWEA,'SHPWEA',NG,3,0,MESH)
00244           IF(IELM.EQ.41) THEN
00245             CALL BIEF_ALLVEC(1,T3WEAK,'T3WEAK',NG,1,0,MESH)
00246             CALL BIEF_ALLVEC(1,T6WEAK,'T6WEAK',NG,1,0,MESH)
00247             CALL BIEF_ALLVEC(1,T7WEAK,'T7WEAK',NG,1,0,MESH)
00248             CALL BIEF_ALLVEC(1,SHZWEA,'SHZWEA',NG,1,0,MESH)
00249           ELSE
00250             CALL BIEF_ALLVEC(1,T3WEAK,'T3WEAK', 1,1,0,MESH)
00251             CALL BIEF_ALLVEC(1,T6WEAK,'T6WEAK', 1,1,0,MESH)
00252             CALL BIEF_ALLVEC(1,T7WEAK,'T7WEAK', 1,1,0,MESH)
00253             CALL BIEF_ALLVEC(1,SHZWEA,'SHZWEA',1 ,1,0,MESH)
00254           ENDIF
00255           IF(NCSIZE.GT.1) THEN
00256             CALL BIEF_ALLVEC(1,SHPBUF,'SHPBUF',NG,3,0,MESH)
00257           ELSE
00258             CALL BIEF_ALLVEC(1,SHPBUF,'SHPBUF',1 ,3,0,MESH)
00259           ENDIF
00260           IF(NCSIZE.GT.1.AND.IELM.EQ.41) THEN
00261             CALL BIEF_ALLVEC(1,SHZBUF,'SHZBUF',NG,1,0,MESH)
00262           ELSE
00263             CALL BIEF_ALLVEC(1,SHZBUF,'SHZBUF',1 ,1,0,MESH)
00264           ENDIF
00265           DEJA=.TRUE.
00266         ENDIF
00267       ENDIF
00268 !
00269 !-----------------------------------------------------------------------
00270 !  OPTIONAL OPTIONS
00271 !-----------------------------------------------------------------------
00272 !
00273 !     ENABLING A POSTERIORI INTERPOLATION
00274 !
00275       IF(PRESENT(POST)) THEN
00276         APOST=POST
00277       ELSE
00278         APOST=.FALSE.
00279       ENDIF
00280 !
00281 !     PERIODICITY FOR TOMAWAC
00282 !
00283       IF(PRESENT(PERIO)) THEN
00284         APERIO=PERIO
00285       ELSE
00286         APERIO=.FALSE.
00287       ENDIF
00288 !
00289 !     4D FOR TOMAWAC
00290 !
00291       IF(PRESENT(YA4D)) THEN
00292         AYA4D=YA4D
00293       ELSE
00294         AYA4D=.FALSE.
00295       ENDIF
00296 !
00297 !     TRANSFORMED MESH FOR TELEMAC-3D
00298 !
00299       IF(PRESENT(SIGMA)) THEN
00300         ASIGMA=SIGMA
00301       ELSE
00302         ASIGMA=.FALSE.
00303       ENDIF
00304 !
00305 !     STOCHASTIC DIFFUSION
00306 !
00307       IF(PRESENT(STOCHA)) THEN
00308         ASTOCHA=STOCHA
00309       ELSE
00310         ASTOCHA=0
00311       ENDIF
00312       IF(PRESENT(VISC)) THEN
00313         AVISC => VISC
00314       ELSE
00315         IF(ASTOCHA.NE.0) THEN
00316           IF(LNG.EQ.1) THEN
00317             WRITE(LU,*) 'CHARAC : AVEC DIFFUSION STOCHASTIQUE'
00318             WRITE(LU,*) '         UN ARGUMENT VISC DOIT ETRE DONNE'
00319           ENDIF
00320           IF(LNG.EQ.2) THEN
00321             WRITE(LU,*) 'CHARAC: WITH STOCHASTIC DIFFUSION'
00322             WRITE(LU,*) '        AN ARGUMENT VISC MUST BE GIVEN'
00323           ENDIF
00324           CALL PLANTE(1)
00325           STOP
00326         ELSE
00327 !         HERE A DUMMY TARGET, WILL NOT BE USED
00328 !         MAYBE NULLIFY WOULD BE BETTER ?
00329           AVISC => IFAMAS
00330         ENDIF
00331       ENDIF
00332 !
00333 !-----------------------------------------------------------------------
00334 !  TABLEAUX DE TRAVAIL PRIS DANS LE BLOC TB
00335 !-----------------------------------------------------------------------
00336 !
00337       IF(TB%N.GE.10) THEN
00338         T8 =>TB%ADR( 8)%P
00339         T9 =>TB%ADR( 9)%P
00340         T10=>TB%ADR(10)%P
00341         IF(OPTCHA.GT.1) THEN
00342           T1 =>T1WEAK
00343           T2 =>T2WEAK
00344           T3 =>T3WEAK
00345           T4 =>T4WEAK
00346           T5 =>T5WEAK
00347           T6 =>T6WEAK
00348           T7 =>T7WEAK
00349           PT_SHP=>SHPWEA%R
00350           PT_SHZ=>SHZWEA%R
00351           PT_SHPBUF=>SHPBUF
00352           PT_FTILD=>FTILD_WEAK
00353         ELSE
00354           T1 =>TB%ADR(1)%P
00355           T2 =>TB%ADR(2)%P
00356           T3 =>TB%ADR(3)%P
00357           T4 =>TB%ADR(4)%P
00358           T5 =>TB%ADR(5)%P
00359           T6 =>TB%ADR(6)%P
00360           T7 =>TB%ADR(7)%P
00361           PT_SHP=>SHP%R
00362           PT_SHZ=>SHZ%R
00363           PT_SHPBUF=>MESH%M%X
00364           PT_FTILD=>FTILD
00365         ENDIF
00366       ELSE
00367         IF(LNG.EQ.1) THEN
00368           WRITE(LU,*) 'TAILLE DU BLOC TB:',TB%N
00369           WRITE(LU,*) 'TROP PETITE DANS CHARAC'
00370           WRITE(LU,*) '10 REQUIS'
00371         ENDIF
00372         IF(LNG.EQ.2) THEN
00373           WRITE(LU,*) 'SIZE OF BLOCK TB:',TB%N
00374           WRITE(LU,*) 'TOO SMALL IN CHARAC'
00375           WRITE(LU,*) '10 REQUESTED'
00376         ENDIF
00377         CALL PLANTE(1)
00378         STOP
00379       ENDIF
00380 !
00381 !-----------------------------------------------------------------------
00382 !  DEPLOIEMENT DE LA STRUCTURE DE MAILLAGE
00383 !-----------------------------------------------------------------------
00384 !
00385       NPOIN = MESH%NPOIN
00386       IELMU = UCONV%ELM
00387 !
00388 !     PREPARING WORK ARRAYS
00389 !
00390 !     THE OFF-DIAGONAL TERMS OF WORK MATRIX IN MESH WILL BE USED AS
00391 !     SHPBUF(3,SIZEBUF)
00392 !
00393       IF(OPTCHA.GT.1) THEN
00394         SIZEBUF=NG
00395       ELSE
00396         SIZEBUF=(MESH%M%X%MAXDIM1*MESH%M%X%MAXDIM2)/3
00397 !       T7 WILL BE USED AS SHZBUF(SIZEBUF)
00398         SIZEBUF=MIN(SIZEBUF,T7%MAXDIM1)
00399 !       IT3 WILL BE USED AS ELTBUF
00400         SIZEBUF=MIN(SIZEBUF,NPOIN)
00401       ENDIF
00402 !
00403 !-----------------------------------------------------------------------
00404 !  ARE THERE QUADRATIC OR QUASI-BUBBLE VARIABLES ?
00405 !  AND COMPUTATION OF LARGEST NUMBER OF POINTS
00406 !-----------------------------------------------------------------------
00407 !
00408       QUAD=.FALSE.
00409       QUAB=.FALSE.
00410       NPT=0
00411       IF(FN%TYPE.EQ.4) THEN
00412         DO I=1,FN%N
00413           IF(FN%ADR(I)%P%ELM.EQ.12) QUAB = .TRUE.
00414           IF(FN%ADR(I)%P%ELM.EQ.13) QUAD = .TRUE.
00415           NPT=MAX(NPT,FN%ADR(I)%P%DIM1)
00416         ENDDO
00417       ELSEIF(FN%TYPE.EQ.2) THEN
00418         IF(FN%ELM.EQ.12) QUAB = .TRUE.
00419         IF(FN%ELM.EQ.13) QUAD = .TRUE.
00420         NPT=MAX(NPT,FN%DIM1)
00421       ENDIF
00422       IF(QUAB.AND.QUAD) THEN
00423         WRITE(LU,*) 'CHARAC: QUADRATIC AND QUASI-BUBBLE CANNOT BE MIXED'
00424         CALL PLANTE(1)
00425         STOP
00426       ENDIF
00427 !
00428 !-----------------------------------------------------------------------
00429 !     CHECKING SHP SIZE (ONCE A BUG...)
00430 !-----------------------------------------------------------------------
00431 !
00432       IF(3*NPT.GT.SHP%MAXDIM1*SHP%MAXDIM2) THEN
00433         IF(LNG.EQ.1) THEN
00434           WRITE(LU,*) 'TAILLE DE SHP:',SHP%MAXDIM1*SHP%MAXDIM2
00435           WRITE(LU,*) 'TROP PETITE DANS CHARAC, ',3*NPT
00436           WRITE(LU,*) 'REQUISE'
00437         ENDIF
00438         IF(LNG.EQ.2) THEN
00439           WRITE(LU,*) 'SIZE OF SHP:',SHP%MAXDIM1*SHP%MAXDIM2
00440           WRITE(LU,*) 'TOO SMALL IN CHARAC, ',3*NPT
00441           WRITE(LU,*) 'REQUESTED'
00442         ENDIF
00443         CALL PLANTE(1)
00444         STOP
00445       ENDIF
00446 !
00447       IF(MAX(NPOIN2,NPT).GT.T2%MAXDIM1) THEN
00448         IF(LNG.EQ.1) THEN
00449           WRITE(LU,*) 'TAILLE DE T2:',T2%MAXDIM1
00450           WRITE(LU,*) 'TROP PETITE DANS CHARAC, ',MAX(NPOIN2,NPT)
00451           WRITE(LU,*) 'REQUISE'
00452         ENDIF
00453         IF(LNG.EQ.2) THEN
00454           WRITE(LU,*) 'SIZE OF T2:',T2%MAXDIM1
00455           WRITE(LU,*) 'TOO SMALL IN CHARAC, ',MAX(NPOIN2,NPT)
00456           WRITE(LU,*) 'REQUESTED'
00457         ENDIF
00458         CALL PLANTE(1)
00459         STOP
00460       ENDIF
00461 !
00462 !-----------------------------------------------------------------------
00463 !  APPEL DE SCARACT
00464 !-----------------------------------------------------------------------
00465 !
00466       IF(MSK) THEN
00467 !       APPEL AVEC IFAMAS
00468         IFA=>IFAMAS%I
00469       ELSE
00470 !       APPEL AVEC IFABOR
00471         IFA=>MESH%IFABOR%I
00472       ENDIF
00473 !
00474 !     STARTING X AND Y OF POINTS (T1=XCONV AND T2=YCONV)
00475 !
00476       IF(OPTCHA.GT.1) THEN
00477 !
00478         CALL CHAR_GAUSS(T1%R,T2%R,T3%R,SHPWEA%R,SHZWEA%R,ELT,ETA,
00479      &                  MESH%X%R,MESH%Y%R,
00480      &                  IKLE2%I,NPOIN2,NELEM2,NELMAX2,NG,NGAUSS,IELM,
00481      &                  NPLAN,ZSTAR%R)
00482         IF(IELM.EQ.11) THEN
00483           DIM1F=NG
00484         ELSEIF(IELM.EQ.41) THEN
00485           DIM1F=NPOIN2
00486         ENDIF
00487         NPT=NG
00488 !
00489       ELSE
00490 !
00491         CALL OS('X=Y     ',X=T1,Y=MESH%X)
00492         CALL OS('X=Y     ',X=T2,Y=MESH%Y)
00493 !
00494 !       IELM MUST BE INTENT(INOUT) BECAUSE IT IS SUCH IN CHGDIS
00495         IF(QUAD) THEN
00496           CALL CHGDIS(T1,IELM,13,MESH)
00497           CALL CHGDIS(T2,IELM,13,MESH)
00498         ELSEIF(QUAB) THEN
00499           CALL CHGDIS(T1,IELM,12,MESH)
00500           CALL CHGDIS(T2,IELM,12,MESH)
00501         ENDIF
00502 !
00503         IF(IELM.EQ.11) THEN
00504           CALL GTSH11(SHP%R,ELT,IKLE2%I,MESH%ELTCAR%I,NPOIN2,
00505      &                NELEM2,NELMAX2,MESH%NSEG,QUAB,QUAD)
00506           DIM1F=NPT
00507         ELSEIF(IELM.EQ.41) THEN
00508 !         STARTING Z OF POINTS (T3=ZCONV)
00509           DO IPLAN=1,NPLAN
00510             DO I= (IPLAN-1)*NPOIN2+1,IPLAN*NPOIN2
00511               T3%R(I)=ZSTAR%R(IPLAN)
00512             ENDDO
00513           ENDDO
00514 !         IN 4D, STARTING F OF POINTS (T9=FCONV)
00515           IF(AYA4D) THEN
00516             CALL OV('X=C     ',T9%R,T9%R,T9%R,
00517      &              FREQ%R(JF),NPOIN2*NPLAN)
00518           ENDIF
00519           CALL GTSH41(SHP%R,SHZ%R,SHF%R,WCONV%R,FRCONV%R,
00520      &                ELT,ETA,FRE,IKLE2%I,MESH%ELTCAR%I,
00521      &                NPOIN2,NELMAX2,NPLAN,JF,NF,AYA4D)
00522           DIM1F=NPOIN2
00523         ELSE
00524           WRITE(LU,*) 'ELEMENT NOT IMPLEMENTED IN CHARAC: ',IELM
00525           CALL PLANTE(1)
00526           STOP
00527         ENDIF
00528 !
00529       ENDIF
00530 !
00531       CALL SCARACT(FN,PT_FTILD,UCONV%R,VCONV%R,WCONV%R,FRCONV%R,
00532      &             MESH%X%R,MESH%Y%R,ZSTAR%R,FREQ%R,
00533 !                  XCONV YCONV ZCONV FCONV DX   DY   DZ   DF
00534      &             T1%R ,T2%R ,T3%R ,T9%R ,T4%R,T5%R,T6%R,T8%R,
00535 !                           SHP
00536      &             MESH%Z%R,PT_SHP,PT_SHZ,SHF%R,
00537      &             SURDET2%R,DT,IKLE2%I,IFA,ELT,
00538      &             ETA,FRE,IT3,ISUB,
00539      &             IELM,IELMU,NELEM2,NELMAX2,NOMB,NPOIN,NPOIN2,
00540      &             3,NPLAN,NF,MESH,NPT,DIM1F,-1,
00541 !                  SHPBUF      SHZBUF      SHFBUF
00542      &             PT_SHPBUF%R,T7%R       ,T10%R,FREBUF,SIZEBUF,
00543      &             APOST,APERIO,AYA4D,ASIGMA,ASTOCHA,AVISC)
00544 !
00545       IF(OPTCHA.GT.1) THEN
00546 !
00547         IF(NOMB.GT.0) THEN
00548           IF(FTILD%TYPE.EQ.2) THEN
00549             CALL CHAR_WEAK(FTILD,FTILD_WEAK,MESH%SURFAC%R,IKLE2%I,
00550      &                     NPOIN2,NELEM2,NELMAX2,NG,NGAUSS,
00551      &                     MESH,T1,T2,TB,AGGLO,IELM,NPLAN,MESH%Z%R,
00552      &                     RHS,AM1,SLV,UNSV,LISTIN,.TRUE.)
00553           ELSEIF(FTILD%TYPE.EQ.4) THEN
00554             DO I=1,NOMB
00555               CALL CHAR_WEAK(FTILD%ADR(I)%P,FTILD_WEAK%ADR(I)%P,
00556      &                       MESH%SURFAC%R,IKLE2%I,
00557      &                       NPOIN2,NELEM2,NELMAX2,NG,NGAUSS,
00558      &                       MESH,T1,T2,TB,AGGLO,IELM,NPLAN,MESH%Z%R,
00559      &                       RHS,AM1,SLV,UNSV,LISTIN,.TRUE.)
00560             ENDDO
00561           ENDIF
00562         ENDIF
00563 !
00564       ELSE
00565 !
00566 !     PARALLEL COMMUNICATION
00567 !
00568         IF(NCSIZE.GT.1.AND.NOMB.GT.0) THEN
00569           IF(FTILD%TYPE.EQ.2) THEN
00570             CALL PARCOM(FTILD,1,MESH)
00571           ELSEIF(FTILD%TYPE.EQ.4) THEN
00572             DO I=1,NOMB
00573               CALL PARCOM(FTILD%ADR(I)%P,1,MESH)
00574             ENDDO
00575           ENDIF
00576         ENDIF
00577 !
00578       ENDIF
00579 !
00580 !-----------------------------------------------------------------------
00581 !
00582       RETURN
00583       END

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