bief_allvec_in_block.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\bief_allvec_in_block.f
00002 !
00070                      SUBROUTINE BIEF_ALLVEC_IN_BLOCK
00071 !                    *******************************
00072 !
00073      &( BLO , N , NAT , NOMGEN , IELM , NDIM , STATUT , MESH )
00074 !
00075 !***********************************************************************
00076 ! BIEF   V6P1                                   21/08/2010
00077 !***********************************************************************
00078 !
00079 !
00080 !
00081 !
00082 !
00083 !
00084 !
00085 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00086 !| BLO            |<->| BLOCK WHERE THE VECTORS WILL BE ALLOCATED
00087 !| IELM           |-->| TYPE OF ELEMENT OF VECTORS, OR DIMENSION
00088 !|                |   | (DEPENDING ON 'STATUT', SEE BELOW)
00089 !| N              |-->| NUMBER OF VECTORS TO BE ALLOCATED
00090 !| NAT            |<--| 1: REAL VECTOR   2:VECTOR OF INTEGERS
00091 !| NDIM           |-->| SECOND DIMENSION OF VECTORS
00092 !| NOMGEN         |-->| GENERIC NAME OF VECTORS
00093 !|                |   | WILL BE COMPLETED WITH RANK
00094 !| STATUT         |-->| VECTOR STATUS:
00095 !|                |   | 0 : FREE VECTOR, IELM IS ITS DIMENSION
00096 !|                |   | 1 : VECTOR DEFINED ON A MESH
00097 !|                |   | IELM IS THEN THE ELEMENT TYPE
00098 !|                |   | CHANGING DISCRETISATION FORBIDDEN
00099 !|                |   | 2 : LIKE 1 BUT CHANGING DISCRETISATION ALLOWED
00100 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00101 !
00102       USE BIEF, EX_BIEF_ALLVEC_IN_BLOCK => BIEF_ALLVEC_IN_BLOCK
00103 !
00104       IMPLICIT NONE
00105       INTEGER LNG,LU
00106       COMMON/INFO/LNG,LU
00107 !
00108 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00109 !
00110       TYPE(BIEF_OBJ)  , INTENT(INOUT) :: BLO
00111       INTEGER         , INTENT(IN)    :: IELM,NDIM,STATUT,NAT,N
00112       CHARACTER(LEN=6), INTENT(IN)    :: NOMGEN
00113       TYPE(BIEF_MESH) , INTENT(IN)    :: MESH
00114 !
00115 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00116 !
00117       INTEGER IDEB,I,II
00118 !
00119       CHARACTER(LEN=6) :: NOM
00120       CHARACTER*1 CHIFFRE(0:9)
00121       DATA CHIFFRE/'0','1','2','3','4','5','6','7','8','9'/
00122       SAVE CHIFFRE
00123 !
00124 !-----------------------------------------------------------------------
00125 !
00126       IDEB = 6
00127       DO I=5,2,-1
00128         IF(NOMGEN(I:I).EQ.' ') IDEB = I
00129       ENDDO ! I
00130 !
00131 !-----------------------------------------------------------------------
00132 !
00133       IF(BLO%N+N.LE.BLO%MAXBLOCK) THEN
00134 !
00135         IF(N.GT.0) THEN
00136 !
00137           DO I = BLO%N+1 , BLO%N+N
00138 !
00139 !           NAME OF THE VECTOR
00140 !
00141             NOM=NOMGEN
00142             IF(I.LT.10) THEN
00143               IDEB = MIN(6,IDEB)
00144               NOM(IDEB:IDEB) = CHIFFRE(I)
00145             ELSEIF(I.LT.100) THEN
00146               IDEB = MIN(5,IDEB)
00147               NOM(IDEB  :IDEB  ) = CHIFFRE(I/10)
00148               NOM(IDEB+1:IDEB+1) = CHIFFRE(I-10*(I/10))
00149             ELSEIF(I.LT.1000) THEN
00150               IDEB = MIN(4,IDEB)
00151               NOM(IDEB  :IDEB  ) = CHIFFRE(I/100)
00152               II=I-100*(I/100)
00153               NOM(IDEB+1:IDEB+1) = CHIFFRE(II/10)
00154               NOM(IDEB+2:IDEB+2) = CHIFFRE(II-10*(II/10))
00155             ELSE
00156               IF(LNG.EQ.1) WRITE(LU,*) 
00157 'PLUS DE 999 VECTEURS DEMANDER     &                                  DANS ALLVEC_IN_BLOCK'
00158               IF(LNG.EQ.2) WRITE(LU,*) 
00159 'MORE THAN 999 VECTORS ASKED     &                                  IN ALLVEC_IN_BLOCK'
00160               CALL PLANTE(1)
00161               STOP
00162             ENDIF
00163 !
00164 !           ALLOCATES THE VECTOR
00165 !
00166             ALLOCATE(BLO%ADR(I)%P)
00167             CALL BIEF_ALLVEC(NAT,BLO%ADR(I)%P,NOM,IELM,NDIM,STATUT,MESH)
00168 !
00169           ENDDO ! I
00170 !
00171           BLO%N=BLO%N+N
00172 !
00173         ENDIF
00174 !
00175       ELSE
00176 !
00177         IF(LNG.EQ.1) THEN
00178           WRITE(LU,*) 'BIEF_ALLVEC_IN_BLOCK :'
00179           WRITE(LU,*) 'PLUS DE ',BLO%MAXBLOCK,' (',N,')'
00180           WRITE(LU,*) 'VECTEURS DEMANDES, CHANGER MAXBLOCK DANS ALLBLO.'
00181         ENDIF
00182         IF(LNG.EQ.2) THEN
00183           WRITE(LU,*) 'BIEF_ALLVEC_IN_BLOCK:'
00184           WRITE(LU,*) 'MORE THAN ',BLO%MAXBLOCK,'(',N,')'
00185           WRITE(LU,*) 'VECTORS TO BE ALLOCATED'
00186           WRITE(LU,*) 'CHANGE MAXBLOCK IN ALLBLO.'
00187         ENDIF
00188         CALL PLANTE(1)
00189         STOP
00190 !
00191       ENDIF
00192 !
00193 !-----------------------------------------------------------------------
00194 !
00195       RETURN
00196       END

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