allblo_in_block.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\allblo_in_block.f
00002 !
00060                      SUBROUTINE ALLBLO_IN_BLOCK
00061 !                    **************************
00062 !
00063      &( BLO , N , NOMGEN )
00064 !
00065 !***********************************************************************
00066 ! BIEF   V6P1                                   21/08/2010
00067 !***********************************************************************
00068 !
00069 !
00070 !
00071 !
00072 !
00073 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00074 !| BLO            |<->| BLOCK WHERE TO ALLOCATE THE BLOCK STRUCTURES
00075 !| N              |-->| NUMBER OF BLOCKS TO BE ADDED IN BLO
00076 !| NOMGEN         |-->| GENERIC FORTRAN NAME OF THE BLOCKS
00077 !|                |   | IT WILL BE COMPLETED WITH THEIR RANK
00078 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00079 !
00080       USE BIEF, EX_ALLBLO_IN_BLOCK => ALLBLO_IN_BLOCK
00081 !
00082       IMPLICIT NONE
00083       INTEGER LNG,LU
00084       COMMON/INFO/LNG,LU
00085 !
00086 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00087 !
00088       TYPE(BIEF_OBJ)  , INTENT(INOUT) :: BLO
00089       INTEGER         , INTENT(IN)    :: N
00090       CHARACTER(LEN=6), INTENT(IN)    :: NOMGEN
00091 !
00092 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00093 !
00094       INTEGER IDEB,I,II
00095 !
00096       CHARACTER(LEN=6) :: NOM
00097       CHARACTER(LEN=1) :: CHIFFRE(0:9)
00098       DATA CHIFFRE/'0','1','2','3','4','5','6','7','8','9'/
00099       SAVE CHIFFRE
00100 !
00101 !-----------------------------------------------------------------------
00102 !
00103       IDEB = 6
00104       DO I=5,2,-1
00105         IF(NOMGEN(I:I).EQ.' ') IDEB = I
00106       ENDDO ! I
00107 !
00108 !-----------------------------------------------------------------------
00109 !
00110       IF(N.LE.BLO%MAXBLOCK) THEN
00111 !
00112       DO I = 1 , N
00113 !
00114 !  NAME OF THE BLOCK
00115 !
00116         NOM=NOMGEN
00117         IF(I.LT.10) THEN
00118           IDEB = MIN(6,IDEB)
00119           NOM(IDEB:IDEB) = CHIFFRE(I)
00120         ELSEIF(I.LT.100) THEN
00121           IDEB = MIN(5,IDEB)
00122           NOM(IDEB  :IDEB  ) = CHIFFRE(I/10)
00123           NOM(IDEB+1:IDEB+1) = CHIFFRE(I-10*(I/10))
00124         ELSEIF(I.LT.1000) THEN
00125           IDEB = MIN(4,IDEB)
00126           NOM(IDEB  :IDEB  ) = CHIFFRE(I/100)
00127           II=I-100*(I/100)
00128           NOM(IDEB+1:IDEB+1) = CHIFFRE(II/10)
00129           NOM(IDEB+2:IDEB+2) = CHIFFRE(II-10*(II/10))
00130         ELSE
00131           IF(LNG.EQ.1) WRITE(LU,*) 'TROP DE BLOCK DANS ALLBLO_IN_BLOCK'
00132           IF(LNG.EQ.2) WRITE(LU,*) 'TOO MANY BLOCKS IN ALLBLO_IN_BLOCK'
00133           CALL PLANTE(1)
00134           STOP
00135         ENDIF
00136 !
00137 !  ALLOCATES THE BLOCK
00138 !
00139         ALLOCATE(BLO%ADR(I)%P)
00140         CALL ALLBLO(BLO%ADR(I)%P,NOM)
00141         BLO%N=BLO%N+1
00142 !
00143       ENDDO
00144 !
00145       ELSE
00146 !
00147       IF(LNG.EQ.1) THEN
00148         WRITE(LU,*) 'ALLBLO_IN_BLOCK : PLUS DE ',BLO%MAXBLOCK,' (',N,')'
00149         WRITE(LU,*) '                  BLOCS DEMANDES'
00150         WRITE(LU,*) '                  CHANGER MAXBLOCK DANS ALLBLO'
00151       ENDIF
00152       IF(LNG.EQ.2) THEN
00153         WRITE(LU,*) 'ALLBLO_IN_BLOCK : MORE THAN '
00154         WRITE(LU,*) '                 ',BLO%MAXBLOCK,' (',N,')'
00155         WRITE(LU,*) '                  BLOCKS TO BE ALLOCATED'
00156         WRITE(LU,*) '                  CHANGE MAXBLOCK IN ALLBLO'
00157       ENDIF
00158       CALL PLANTE(1)
00159       STOP
00160 !
00161       ENDIF
00162 !
00163 !-----------------------------------------------------------------------
00164 !
00165       RETURN
00166       END

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