bief_allvec.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\bief_allvec.f
00002 !
00059                      SUBROUTINE BIEF_ALLVEC
00060 !                    **********************
00061 !
00062      &( NAT , VEC , NOM , IELM , DIM2 , STATUT , MESH )
00063 !
00064 !***********************************************************************
00065 ! BIEF   V6P1                                   21/08/2010
00066 !***********************************************************************
00067 !
00068 !
00069 !
00070 !
00071 !
00072 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00073 !| DIM2           |-->| SECOND DIMENSION OF VECTOR
00074 !| IELM           |-->| TYPE OF ELEMENT, OR DIMENSION
00075 !|                |   | (DEPENDING ON 'STATUT')
00076 !| NAT            |<--| 1: REAL VECTOR   2:VECTOR OF INTEGERS
00077 !| NOM            |-->| FORTRAN NAME
00078 !| STATUT         |-->| VECTOR STATUS:
00079 !|                |   | 0 : FREE VECTOR, IELM IS ITS DIMENSION
00080 !|                |   | 1 : VECTOR DEFINED ON A MESH
00081 !|                |   | IELM IS THEN THE ELEMENT TYPE
00082 !|                |   | CHANGING DISCRETISATION FORBIDDEN
00083 !|                |   | 2 : LIKE 1 BUT CHANGING DISCRETISATION ALLOWED
00084 !| VEC            |<--| VECTOR TO BE ALLOCATED
00085 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00086 !
00087       USE BIEF, EX_BIEF_ALLVEC => BIEF_ALLVEC
00088 !
00089       IMPLICIT NONE
00090       INTEGER LNG,LU
00091       COMMON/INFO/LNG,LU
00092 !
00093 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00094 !
00095       TYPE(BIEF_OBJ)  , INTENT(INOUT) :: VEC
00096       INTEGER         , INTENT(IN)    :: NAT,IELM,DIM2,STATUT
00097       CHARACTER(LEN=6), INTENT(IN)    :: NOM
00098       TYPE(BIEF_MESH) , INTENT(IN)    :: MESH
00099 !
00100 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00101 !
00102       INTEGER ERR
00103       INTRINSIC MAX
00104 !
00105       INTEGER IMAX,I
00106       DOUBLE PRECISION XMAX
00107 !
00108 !-----------------------------------------------------------------------
00109 !  HEADER COMMON TO ALL OBJECTS
00110 !-----------------------------------------------------------------------
00111 !
00112 !     KEY OF THE OBJECT - TO CHECK MEMORY CRASHES
00113 !
00114       VEC%KEY = 123456
00115 !
00116 !     TYPE OF THE OBJECT (HERE VECTOR)
00117 !
00118       VEC%TYPE = 2
00119 !
00120 !     NAME OF THE OBJECT
00121 !
00122       VEC%NAME = NOM
00123 !
00124 !-----------------------------------------------------------------------
00125 !  PART SPECIFIC TO VECTORS
00126 !-----------------------------------------------------------------------
00127 !
00128 !     NATURE
00129 !
00130       VEC%NAT = NAT
00131 !
00132 !     MAXIMUM SIZE PER DIMENSION
00133 !
00134       IF(STATUT.EQ.1.OR.STATUT.EQ.2) THEN
00135         VEC%MAXDIM1 = BIEF_NBMPTS(IELM,MESH)
00136       ELSE
00137         VEC%MAXDIM1 = IELM
00138       ENDIF
00139 !
00140 !     VEC%MAXDIM1 MUST BE AT LEAST 1
00141 !     TO AVOID BOUND CHECKING ERRORS ON SOME COMPILERS
00142 !
00143       VEC%MAXDIM1=MAX(VEC%MAXDIM1,1)
00144 !
00145 !     DISCRETISES
00146 !
00147       IF(STATUT.EQ.1.OR.STATUT.EQ.2) THEN
00148         VEC%ELM = IELM
00149       ELSE
00150         VEC%ELM = -1000
00151       ENDIF
00152 !
00153 !     FIRST DIMENSION OF VECTOR
00154 !
00155       IF(STATUT.EQ.1.OR.STATUT.EQ.2) THEN
00156         VEC%DIM1 = BIEF_NBPTS(IELM,MESH)
00157       ELSE
00158         VEC%DIM1 = IELM
00159       ENDIF
00160 !
00161 !     SECOND DIMENSION OF VECTOR (VEC%DIM2 MAY BE CHANGED)
00162 !
00163       VEC%DIM2    = DIM2
00164       VEC%MAXDIM2 = DIM2
00165 !
00166 !     CASE OF DISCONTINUITY BETWEEN ELEMENTS
00167 !     (SEE CORRSL, VC13AA, VC13BB)
00168 !
00169       VEC%DIMDISC = 0
00170 !
00171 !     STATUS
00172 !
00173       VEC%STATUS = STATUT
00174 !
00175 !     INFORMATION ON CONTENT
00176 !
00177       VEC%TYPR = '?'
00178       VEC%TYPI = '?'
00179 !
00180 !     DYNAMICALLY ALLOCATES MEMORY (REAL OR INTEGER, DEPENDING OF NAT)
00181 !
00182       IF(NAT.EQ.1) THEN
00183 !
00184         ALLOCATE(VEC%R(VEC%MAXDIM1*VEC%DIM2),STAT=ERR)
00185 !       JAJ NULLIFY THE INTEGER PART
00186         NULLIFY(VEC%I)
00187 !
00188 !       FILLS ARRAY WITH BIG NUMBERS
00189 !       TO RAISE QUESTIONS IF NOT INITIALISED
00190 !
00191         XMAX = HUGE(100.D0)
00192         CALL OV('X=C     ',VEC%R,VEC%R,VEC%R,XMAX,
00193      &          VEC%MAXDIM1*VEC%DIM2)
00194 !
00195       ELSEIF(NAT.EQ.2) THEN
00196 !
00197         ALLOCATE(VEC%I(VEC%MAXDIM1*VEC%DIM2),STAT=ERR)
00198 !       JAJ NULLIFY THE REAL PART
00199         NULLIFY(VEC%R)
00200 !
00201 !       FILLS ARRAY WITH BIG NUMBERS
00202 !       TO RAISE QUESTIONS IF NOT INITIALISED
00203 !
00204         IMAX = HUGE(100)
00205           DO I=1,VEC%MAXDIM1*VEC%DIM2
00206             VEC%I(I) = IMAX
00207           ENDDO
00208 !
00209       ELSE
00210         IF(LNG.EQ.1) WRITE(LU,*) 'NAT INCONNU DANS ALLVEC'
00211         IF(LNG.EQ.2) WRITE(LU,*) 'UNKNOWN NAT IN ALLVEC'
00212         CALL PLANTE(1)
00213         STOP
00214       ENDIF
00215 !
00216 !-----------------------------------------------------------------------
00217 !
00218       IF(ERR.EQ.0) THEN
00219 !       IF(LNG.EQ.1) WRITE(LU,*) 'VECTEUR : ',NOM,' ALLOUE'
00220 !       IF(LNG.EQ.2) WRITE(LU,*) 'VECTOR: ',NOM,' ALLOCATED'
00221       ELSE
00222         IF(LNG.EQ.1) WRITE(LU,10) NOM,ERR
00223         IF(LNG.EQ.2) WRITE(LU,20) NOM,ERR
00224 10      FORMAT(1X,'ERREUR A L''ALLOCATION DU VECTEUR : ',A6,/,1X,
00225      &            'CODE D''ERREUR : ',1I6)
00226 20      FORMAT(1X,'ERROR DURING ALLOCATION OF VECTOR: ',A6,/,1X,
00227      &            'ERROR CODE: ',1I6)
00228         CALL PLANTE(1)
00229         STOP
00230       ENDIF
00231 !
00232 !-----------------------------------------------------------------------
00233 !
00234       RETURN
00235       END

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