classe.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\damocles\classe.f
00002 !
00067                      SUBROUTINE CLASSE
00068 !                    *****************
00069 !
00070      &(DIMENS , SIZE   , MOTCLE , UTINDX , NMAX   ,
00071      & OFFSET , ADRESS , INDIC  , LUIGN  ,
00072      & MOTINT , MOTREA , MOTLOG , MOTCAR , MOTATT ,
00073      & DEFCAR , DEFINT , DEFLOG , DEFREA , DEFATT )
00074 !
00075 !***********************************************************************
00076 ! DAMOCLES   V6P0                                   21/08/2010
00077 !***********************************************************************
00078 !
00079 !
00080 !
00081 !
00082 !
00083 !
00084 !
00085 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00086 !| ADRESS         |<->| TABLEAU DES ADRESSES DES MOTS CLES
00087 !| DEFATT         |<->| TABLEAU DES SUBMITS PAR DEFAUT
00088 !| DEFCAR         |<->| TABLEAU DES VALEURS CARACTERES PAR DEFAUT
00089 !| DEFINT         |<->| TABLEAU DES VALEURS ENTIERES PAR DEFAUT
00090 !| DEFLOG         |<->| TABLEAU DES VALEURS LOGIQUES PAR DEFAUT
00091 !| DEFREA         |<->| TABLEAU DES VALEURS REELLES PAR DEFAUT
00092 !| DIMENS         |<->| TABLEAU DES DIMENSIONS DES MOTS CLES
00093 !| INDIC          |<->| TABLEAU D'INDICATEURS D'ETAT DES MOTS CLES
00094 !|                |   | = 0 : PAS DE SUBMIT & NON TABLEAU
00095 !|                |   | = 1 : PAS DE SUBMIT & TABLEAU
00096 !|                |   | = 2 : AVEC   SUBMIT & NON TABLEAU
00097 !|                |   | = 3 : AVEC   SUBMIT & NON TABLEAU
00098 !| LUIGN          |-->| LOGIQUE POUR LES MOTS A NE PAS CLASSER
00099 !| MOTATT         |<->| TABLEAU DES SUBMITS
00100 !| MOTCAR         |<->| TABLEAU DES VALEURS CARACTERES
00101 !| MOTCLE         |-->| TABLEAU DES MOTS CLES ACTIFS
00102 !| MOTINT         |<->| TABLEAU DES VALEURS ENTIERES
00103 !| MOTLOG         |<->| TABLEAU DES VALEURS LOGIQUES
00104 !| MOTREA         |<->| TABLEAU DES VALEURS REELLES
00105 !| NMAX           |-->| TAILLE MAXIMALE AUTORISEE POUR LES TABLEAUX
00106 !| OFFSET         |<->| TABLEAUX DES PROCHAINES ADRESSES LIBRES
00107 !| SIZE           |<->| TABLEAU DES LONGUEURS DES MOTS CLES
00108 !| UTINDX         |<->| TABLEAU DE LOGIQUES D'UTILISATION DES INDEX
00109 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00110 !
00111       IMPLICIT NONE
00112 !
00113       INTEGER          LNG,LU
00114       INTEGER          INDX,NTYP,ITAI,LONGU,NMOT(4),DEFLU
00115       INTEGER          NLIGN,LONGLI
00116       CHARACTER*72     PARAM
00117 !
00118       INTEGER          NMAX,MOTINT(*),ADRESS(4,*),DIMENS(4,*)
00119       INTEGER          SIZE(4,*),OFFSET(4),DEFINT(*),INDIC(4,*)
00120       LOGICAL          UTINDX(4,*),DEFLOG(*),MOTLOG(*),LUIGN
00121       CHARACTER*72     MOTCLE(4,*)
00122       CHARACTER*144    MOTCAR(*),DEFCAR(*)
00123       CHARACTER*144    MOTATT(4,*),DEFATT(*)
00124       DOUBLE PRECISION MOTREA(*),DEFREA(*)
00125 !
00126 !-----------------------------------------------------------------------
00127 !
00128       INTEGER          I
00129 !
00130 !-----------------------------------------------------------------------
00131 !
00132       COMMON / DCINFO / LNG,LU
00133       COMMON / DCNGE  / INDX,NTYP,ITAI,LONGU,NMOT,DEFLU
00134       COMMON / DCMLIG / NLIGN , LONGLI
00135       COMMON / DCNGEC / PARAM
00136 !
00137 !***********************************************************************
00138 !                                    RCS AND SCCS MARKING
00139 !
00140 !***********************************************************************
00141 !
00142       IF (LUIGN) GO TO 1600
00143 !
00144 !     GLOBAL TREATMENT OF THE KEYWORD
00145 !
00146       IF (INDX .GT. NMAX) THEN
00147         WRITE(LU,*) '****************************************'
00148         IF(LNG.EQ.1) THEN
00149           WRITE(LU,*) 'ERREUR A LA LIGNE :',NLIGN,
00150      &                ' DU DICTIONNAIRE'
00151           WRITE(LU,*) 'INDEX INVALIDE : ',INDX,' MAX = ',NMAX
00152         ELSEIF(LNG.EQ.2) THEN
00153           WRITE(LU,*) 'ERROR AT LINE:',NLIGN,
00154      &                ' OF THE DICTIONARY'
00155           WRITE(LU,*) 'INVALID INDEX: ',INDX,' MAX = ',NMAX
00156         ENDIF
00157         WRITE(LU,*) '****************************************'
00158         CALL PLANTE(1)
00159         STOP
00160       ENDIF
00161 !
00162       IF (NMOT(NTYP) .GT. NMAX) THEN
00163         WRITE(LU,*)'*****************************************'
00164         IF(LNG.EQ.1) THEN
00165           WRITE(LU,*) 'ERREUR A LA LIGNE :',NLIGN,
00166      &                ' DU DICTIONNAIRE'
00167           WRITE(LU,*)'TROP DE MOTS CLES. MAXIMUM : ',NMAX
00168         ELSEIF(LNG.EQ.2) THEN
00169           WRITE(LU,*) 'ERROR AT LINE:',NLIGN,
00170      &                ' OF THE DICTIONARY'
00171           WRITE(LU,*) 'TOO MANY KEY-WORDS, MAXIMUM : ',NMAX
00172         ENDIF
00173         WRITE(LU,*)'*****************************************'
00174         CALL PLANTE(1)
00175         STOP
00176       ENDIF
00177 !
00178 ! REDUNDANT WITH LUIGN? KEPT BY DEFAULT - TO BE CHECKED
00179       IF (INDX .LE. 0) GO TO 1600
00180 !
00181       IF (UTINDX(NTYP,INDX)) THEN
00182         WRITE(LU,*)'*****************************'
00183         IF(LNG.EQ.1) THEN
00184           WRITE(LU,*) 'ERREUR A LA LIGNE : ',NLIGN
00185           WRITE(LU,*) 'L''INDEX  : ',INDX,
00186      &   ' A DEJA ETE UTILISE POUR LE TYPE : ',NTYP
00187         ELSEIF(LNG.EQ.2) THEN
00188           WRITE(LU,*) 'ERROR AT LINE: ',NLIGN
00189           WRITE(LU,*) 'THE INDEX: ',INDX,
00190      &   ' IS USED TWO TIMES FOR THE TYPE : ',NTYP
00191         ENDIF
00192         WRITE(LU,*)'*****************************'
00193         CALL PLANTE(1)
00194         STOP
00195       ELSE
00196         UTINDX(NTYP,INDX) = .TRUE.
00197       ENDIF
00198 !
00199       IF (ITAI .LE. 0) THEN
00200         ITAI = 1
00201       ELSE
00202 ! PREVENTS DYNAMIC ALLOCATION FOR SOMETHING ELSE THAN AN ARRAY
00203                    INDIC(NTYP,INDX)=INDIC(NTYP,INDX)+1
00204       ENDIF
00205 !
00206 ! ADDITION CF JMH - ISSUES A WARNING FOR ESTET - N3S DICO FILES
00207 ! WHEN THE DEFAULT VALUES ARE DEFINED IN INSUFFICIENT NUMBER
00208 ! COMPARED TO THE DIMENSIONS
00209 !
00210       IF(DEFLU.GT.0.AND.DEFLU.NE.ITAI) THEN
00211         WRITE(LU,*) ' '
00212         IF(LNG.EQ.1) THEN
00213           WRITE(LU,*)'ATTENTION ! A LA LIGNE ',NLIGN,
00214      &               ' DU DICTIONNAIRE :'
00215           WRITE(LU,*)'LE NOMBRE DE VALEURS PAR DEFAUT ',
00216      &                DEFLU,' EST DIFFERENT DE LA TAILLE ',
00217      &                'ANNONCEE ',ITAI
00218         ELSEIF(LNG.EQ.2) THEN
00219           WRITE(LU,*) 'WARNING !  AT LINE ',NLIGN,
00220      &                ' OF THE DICTIONARY :'
00221           WRITE(LU,*) 'NUMBER OF DEFAULT VALUES ',DEFLU,
00222      &                 ' IS DIFFERENT FROM THE SIZE ',ITAI
00223         ENDIF
00224         WRITE(LU,*) ' '
00225       ENDIF
00226 !
00227       IF (DEFLU .EQ. 0) THEN
00228         IF     (NTYP .EQ. 1) THEN
00229           DEFINT(1) = 0
00230         ELSEIF (NTYP .EQ. 2) THEN
00231           DEFREA(1) = 0.0
00232         ELSEIF (NTYP .EQ. 3)THEN
00233           DEFLOG(1) = .FALSE.
00234         ELSEIF (NTYP .EQ. 4) THEN
00235           DEFCAR(1) = ' '
00236         ENDIF
00237       ENDIF
00238 !
00239       IF (ITAI .NE. DEFLU) THEN
00240         IF (ITAI .GT. DEFLU) THEN
00241           DO I = DEFLU + 1 , ITAI
00242             IF     (NTYP .EQ. 1) THEN
00243               DEFINT(I) = DEFINT(MAX(1,DEFLU))
00244             ELSEIF (NTYP .EQ. 2) THEN
00245               DEFREA(I) = DEFREA(MAX(1,DEFLU))
00246             ELSEIF (NTYP .EQ. 3) THEN
00247               DEFLOG(I) = DEFLOG(MAX(1,DEFLU))
00248             ELSEIF (NTYP .EQ. 4) THEN
00249               DEFCAR(I) = DEFCAR(MAX(1,DEFLU))
00250             ENDIF
00251 !           DEFATT(NYTP,I) = DEFATT(NYTP,MAX(1,DEFLU))
00252           ENDDO ! I
00253         ENDIF
00254         DEFLU = ITAI
00255       ENDIF
00256 !
00257 !   STORES THE KEYWORD ATTRIBUTES IN THE ARRAYS
00258 !   NUMBER OF KEYWORDS OF TYPE NTYP
00259 !
00260       NMOT(NTYP) = NMOT(NTYP) + 1
00261 !
00262 !   NEXT FREE ADDRESS FOR THE KEYWORD OF TYPE NTYP
00263 !
00264       ADRESS(NTYP,INDX) = OFFSET(NTYP)
00265 !
00266 !   STORED KEYWORD
00267 !
00268       MOTCLE(NTYP,INDX) = PARAM(1:LONGU)
00269 !
00270 !   NUNBER OF VALUES ASSOCIATED WITH THE KEYWORD OF TYPE NTYP
00271 !
00272       DIMENS(NTYP,INDX) = ITAI
00273 !
00274 !   LENGTH OF THE KEYWORD (CHARACTERS)
00275 !
00276       SIZE(NTYP,INDX) = LONGU
00277 !
00278 !   STORES THE VALUES IN THE ARRAYS
00279 !
00280       IF (((ADRESS(NTYP,INDX)+ITAI-1) .GT. NMAX)
00281      &   .OR. (OFFSET(NTYP) .GT. NMAX)) THEN
00282         IF(LNG.EQ.1) THEN
00283           WRITE(LU,*) 'ADRESSE SUPERIEURE A NMAX = ',NMAX
00284           WRITE(LU,*) 'TROP DE VALEURS DE TYPE : ',NTYP
00285      &                ,' DECLAREES.'
00286           WRITE(LU,*) 'ARRET AU MOT CLE D''INDEX : ',INDX
00287         ELSEIF(LNG.EQ.2) THEN
00288           WRITE(LU,*) 'ADRESS GREATER THAN NMAX = ',NMAX
00289           WRITE(LU,*) 'TOO MANY VALUES OF TYPE : ',NTYP
00290      &                ,' DECLARED.'
00291           WRITE(LU,*) 'STOP AT KEY-WORD OF INDEX: ',INDX
00292         ENDIF
00293         CALL PLANTE(1)
00294         STOP
00295       ENDIF
00296 !
00297       DO I = 1 , ITAI
00298         IF (NTYP .EQ. 1) THEN
00299           MOTINT(ADRESS(NTYP,INDX)+I-1) = DEFINT(I)
00300         ELSE IF (NTYP .EQ. 2) THEN
00301           MOTREA(ADRESS(NTYP,INDX)+I-1) = DEFREA(I)
00302         ELSE IF (NTYP .EQ. 3) THEN
00303           MOTLOG(ADRESS(NTYP,INDX)+I-1) = DEFLOG(I)
00304         ELSE IF (NTYP .EQ. 4) THEN
00305           MOTCAR(ADRESS(NTYP,INDX)+I-1) = DEFCAR(I)
00306         ENDIF
00307         IF (INDIC(NTYP,INDX).GE.2)
00308      &    MOTATT(NTYP,ADRESS(NTYP,INDX)+I-1) = DEFATT(I)
00309       ENDDO ! I
00310 !
00311 !   UPDATES THE NEXT FREE ADDRESS
00312 !
00313       OFFSET(NTYP) = OFFSET(NTYP) + ITAI
00314 !
00315 !   INITIALISES THE TEMPORARY VARIABLES
00316 !
00317 1600  CONTINUE
00318       PARAM  = ' '
00319       LONGU  = 0
00320       NTYP   = -100
00321       INDX   = 123456
00322       ITAI   = -100
00323       DEFLU  = 0
00324 !
00325 !-----------------------------------------------------------------------
00326 !
00327       RETURN
00328       END

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