vector.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\vector.f
00002 !
00104                      SUBROUTINE VECTOR
00105 !                    *****************
00106 !
00107      &(VEC,OP,FORMUL,IELM1,XMUL,F,G,H,U,V,W,MESH,MSK,MASKEL,LEGO,ASSPAR)
00108 !
00109 !***********************************************************************
00110 ! BIEF   V7P0                                   08/01/2014
00111 !***********************************************************************
00112 !
00113 !
00114 !
00115 !
00116 !
00117 !
00118 !
00119 !
00120 !
00121 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00122 !| ASSPAR         |-->| IF YES, RARALLEL ASSEMBLY OF THE VECTOR IS DONE
00123 !| F              |-->| FUNCTION USED IN THE VECTOR FORMULA (BIEF_OBJ)
00124 !| FORMUL         |-->| STRING WITH THE FORMULA DESCRIBING THE VECTOR
00125 !| G              |-->| FUNCTION USED IN THE VECTOR FORMULA (BIEF_OBJ)
00126 !| H              |-->| FUNCTION USED IN THE VECTOR FORMULA (BIEF_OBJ)
00127 !| IELM1          |-->| TYPE OF ELEMENT
00128 !| MASKEL         |-->| MASKING OF ELEMENTS
00129 !|                |   | =1. : NORMAL   =0. : MASKED ELEMENT
00130 !| MESH           |-->| MESH STRUCTURE
00131 !| MSK            |-->| IF YES, THERE IS MASKED ELEMENTS
00132 !| OP             |-->| '=' : WE DO VEC= THE VECTOR
00133 !|                |   | '+' : WE DO VEC=VEC+ THE VECTOR
00134 !| U              |-->| FUNCTION USED IN THE VECTOR FORMULA (BIEF_OBJ)
00135 !| V              |-->| FUNCTION USED IN THE VECTOR FORMULA (BIEF_OBJ)
00136 !| W              |-->| FUNCTION USED IN THE VECTOR FORMULA (BIEF_OBJ)
00137 !| VEC            |<->| RESULTING VECTOR
00138 !| XMUL           |-->| MULTIPLICATION COEFFICIENT
00139 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00140 !
00141       USE BIEF, EX_VECTOR => VECTOR
00142 !
00143       IMPLICIT NONE
00144       INTEGER LNG,LU
00145       COMMON/INFO/LNG,LU
00146 !
00147 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00148 !
00149       TYPE(BIEF_OBJ),    INTENT(INOUT) :: VEC
00150       DOUBLE PRECISION,  INTENT(IN)    :: XMUL
00151       INTEGER,           INTENT(IN)    :: IELM1
00152       LOGICAL,           INTENT(IN)    :: MSK
00153       CHARACTER(LEN=16), INTENT(IN)    :: FORMUL
00154       CHARACTER(LEN=1),  INTENT(IN)    :: OP
00155       TYPE(BIEF_OBJ),    INTENT(IN)    :: F,G,H,U,V,W,MASKEL
00156       TYPE(BIEF_MESH),   INTENT(INOUT) :: MESH
00157       LOGICAL, OPTIONAL, INTENT(IN)    :: LEGO,ASSPAR
00158 !
00159 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00160 !
00161       INTEGER  :: NPT                  ! NUMBER OF POINTS PER ELEMENT
00162       INTEGER  :: DIM1T                ! FIRST DIMENSION OF T IN VECTOS
00163       LOGICAL  :: LLEGO,AASSPAR        ! ASSEMBLY OR NOT
00164       INTEGER  :: IELM0                ! P0 DISCRETISATION
00165 !
00166       IF(PRESENT(LEGO)) THEN
00167         LLEGO=LEGO
00168       ELSE
00169         LLEGO=.TRUE.
00170       ENDIF
00171 !
00172 !-----------------------------------------------------------------------
00173 !  POSSIBLE CHANGE OF DISCRETISATION
00174 !-----------------------------------------------------------------------
00175 ! IF A VECTOR HAS BEEN ALLOCATED WITH STATUS 1, I.E ITS DISCRETISATION
00176 ! CANNOT CHANGE, IT IS NECESSARY TO TEST THE COHERENCE BETWEEN THE
00177 ! DISCRETISATION OF THE VECTOR AND THAT PROPOSED IN ARGUMENT.
00178 ! MIGHT HAVE SURPRISES OTHERWISE !!!!
00179 !
00180       IF(VEC%STATUS.EQ.1.AND.VEC%ELM.NE.IELM1) THEN
00181         IF(LNG.EQ.1) WRITE(LU,1001) VEC%NAME,VEC%ELM,IELM1
00182         IF(LNG.EQ.2) WRITE(LU,1002) VEC%NAME,VEC%ELM,IELM1
00183 1001    FORMAT(1X,'VECTOR : CHANGEMENT DE DISCRETISATION IMPOSSIBLE',
00184      &  ' POUR VECTEUR ',A6,' : ',1I6,' <=> ',1I6)
00185 1002    FORMAT(1X,'VECTOR: CHANGING DISCRETIZATION FORBIDDEN',
00186      &  ' FOR THE VECTOR ',A6,' : ',1I6,' <=> ',1I6)
00187         CALL PLANTE(1)
00188         STOP
00189       ELSEIF(VEC%STATUS.EQ.2.OR.VEC%STATUS.EQ.1.OR.
00190      &      (VEC%STATUS.EQ.0.AND.OP.EQ.'=')) THEN
00191         NPT = BIEF_NBPTS(IELM1,MESH)
00192         VEC%ELM = IELM1
00193         IF(NPT.GT.VEC%MAXDIM1) THEN
00194           IF(LNG.EQ.1) THEN
00195             WRITE(LU,*) 'LE VECTEUR ',VEC%NAME
00196             WRITE(LU,*) 'A UNE DIMENSION TROP PETITE : ',VEC%MAXDIM1
00197             WRITE(LU,*) 'IL NE PEUT ETRE UTILISE DANS VECTOR'
00198             WRITE(LU,*) 'POUR UNE TAILLE DE ',NPT
00199           ENDIF
00200           IF(LNG.EQ.2) THEN
00201             WRITE(LU,*) 'VECTOR ',VEC%NAME
00202             WRITE(LU,*) 'HAS A FIRST DIMENSION OF: ',VEC%MAXDIM1
00203             WRITE(LU,*) 'IT CANNOT BE USED IN VECTOR'
00204             WRITE(LU,*) 'FOR A SIZE OF ',NPT
00205           ENDIF
00206           CALL PLANTE(1)
00207           STOP
00208         ELSE
00209           VEC%DIM1= NPT
00210           IF(VEC%STATUS.EQ.0) VEC%STATUS=2
00211         ENDIF
00212       ELSE
00213         IF(LNG.EQ.1) THEN
00214           WRITE(LU,*) 'LE VECTEUR ',VEC%NAME,' A UN STATUT EGAL A',
00215      &                VEC%STATUS,' IL NE PEUT ETRE UTILISE DANS VECTOR'
00216         ENDIF
00217         IF(LNG.EQ.2) THEN
00218           WRITE(LU,*) 'VECTOR ',VEC%NAME,' HAS A STATUS ',VEC%STATUS,
00219      &                ' IT CANNOT BE USED IN SUBROUTINE VECTOR'
00220         ENDIF
00221         CALL PLANTE(1)
00222         STOP
00223       ENDIF
00224 !
00225 ! ASSEMBLY: NOT PERFORMED FOR VECTORS
00226 ! RESULT OF P0 DISCRETISATION
00227 ! LLEGO IS SET TO TRUE IF THE RESULTANT VECTOR DISCRETISATION
00228 ! IS P1, FALSE OTHERWISE.
00229 !
00230       IELM0 = 10*(IELM1/10)
00231       IF(IELM0.EQ.IELM1) LLEGO=.FALSE.
00232 !
00233 !-----------------------------------------------------------------------
00234 !  CALLS THE SUBROUTINE THAT SHUNTS AND ASSEMBLES
00235 !-----------------------------------------------------------------------
00236 !
00237       IF(DIMENS(IELM1).EQ.MESH%DIM) THEN
00238         DIM1T=MESH%NELMAX
00239       ELSE
00240         DIM1T=MESH%NELEBX
00241       ENDIF
00242 !
00243 !-----------------------------------------------------------------------
00244 !  OPTIONAL ASSEMBLY: VALUES OF VEC SUMMED AT INTERFACE POINTS
00245 !-----------------------------------------------------------------------
00246 !
00247       AASSPAR=.FALSE.
00248       IF(NCSIZE.GT.1) THEN
00249         IF(PRESENT(ASSPAR).AND.DIMENS(IELM1).EQ.MESH%DIM) THEN
00250           AASSPAR=ASSPAR
00251         ENDIF
00252       ENDIF
00253 !
00254       IF(DIMENS(IELM1).EQ.MESH%DIM.OR.MESH%NELEB.GT.0) THEN
00255 !
00256         CALL VECTOS(VEC,VEC%R,OP,FORMUL,XMUL,
00257      &              F%R,G%R,H%R,U%R,V%R,W%R,
00258      &              F,G,H,U,V,W,MESH%W%R,LLEGO,
00259      &              MESH%XEL%R   , MESH%YEL%R   , MESH%ZEL%R  ,
00260      &              MESH%X%R     , MESH%Y%R     , MESH%Z%R    ,
00261      &              MESH%SURFAC%R, MESH%LGSEG%R ,
00262      &              MESH%IKLE%I  , MESH%IKLBOR%I, MESH%NBOR%I ,
00263      &              MESH%XSGBOR%R, MESH%YSGBOR%R, MESH%ZSGBOR%R,
00264      &              NPT,MESH%NELEM,MESH%NELEB,
00265      &              MESH%NELMAX,MESH%NELEBX,
00266      &              IELM1,MESH%LV,MSK,MASKEL%R,MESH,DIM1T,
00267      &              MESH%NELBOR%I,MESH%NULONE%I,AASSPAR)
00268 !
00269       ENDIF
00270 !
00271 !-----------------------------------------------------------------------
00272 !
00273       RETURN
00274       END

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