The TELEMAC-MASCARET system  trunk
cmd.f
Go to the documentation of this file.
1 ! **************
2  SUBROUTINE cmd
3 ! **************
4 !
5  &(icol , ligne , adress , dimens , trouve , motcle , nmot2 ,
6  & motint , motrea , motlog , motcar , motatt , indic , SIZE ,
7  & utindx , dynam , vucmd , execmd , nficda , nmaxr )
8 !
9 !***********************************************************************
10 ! DAMOCLES V6P0 21/08/2010
11 !***********************************************************************
12 !
13 !brief CARRIES OUT A COMMAND PROVIDED IN THE DICTIONARY AND
14 !+ STEERING FILES : COMMAND = '&' + 3 LETTERS.
15 !
16 !note PORTABILITY : IBM,CRAY,HP,SUN
17 !note DOCUMENTATION : COMMANDS &LIS, &ETA, &IND, &STO, &FIN
18 !+ ARE ONLY CARRIED OUT IF EXECMD=.TRUE.
19 !+ AND VUCMD(NB_CMB)=.TRUE.
20 !+ COMMAND &DYN IS IGNORED IN THE STEERING FILE
21 !
22 !history O. QUIQUEMPOIX (LNH)
23 !+ 14/12/1993
24 !+
25 !+
26 !
27 !history J-M HERVOUET (LNH); A. YESSAYAN; L. LEGUE
28 !+ 15/01/2008
29 !+ V5P8
30 !+
31 !
32 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
33 !+ 13/07/2010
34 !+ V6P0
35 !+ Translation of French comments within the FORTRAN sources into
36 !+ English comments
37 !
38 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
39 !+ 21/08/2010
40 !+ V6P0
41 !+ Creation of DOXYGEN tags for automated documentation and
42 !+ cross-referencing of the FORTRAN sources
43 !
44 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
45 !| ADRESS |-->| TABLEAU DES ADRESSES DES MOTS CLES
46 !| DIMENS |-->| TABLEAU DES DIMENSIONS DES MOTS CLES
47 !| DYNAM |<->| LOGIQUE POUR LE MODE DYNAMIQUE
48 !| EXECMD |-->| LOGIQUE D'ACTIVATION DES COMMANDES MEMORISEES
49 !| ICOL |<->| POSITION COURANTE DU POINTEUR DANS LA LIGNE
50 !| INDIC |-->| TABLEAU D'INDICATEURS D'ETAT DES MOTS CLES
51 !| | | = 0 : PAS DE SUBMIT & NON TABLEAU
52 !| | | = 1 : PAS DE SUBMIT & TABLEAU
53 !| | | = 2 : AVEC SUBMIT & NON TABLEAU
54 !| | | = 3 : AVEC SUBMIT & NON TABLEAU
55 !| LIGNE |-->| LIGNE EN COURS DE DECODAGE.
56 !| MOTATT |-->| TABLEAU DES SUBMITS
57 !| MOTCAR |-->| TABLEAU DES VALEURS CARACTERES
58 !| MOTCLE |-->| TABLEAU DES MOTS CLES ACTIFS
59 !| MOTINT |-->| TABLEAU DES VALEURS ENTIERES
60 !| MOTLOG |-->| TABLEAU DES VALEURS LOGIQUES
61 !| MOTREA |-->| TABLEAU DES VALEURS REELLES
62 !| NFICDA |-->| NUMERO DE CANAL DU FICHIER DES DONNEES
63 !| NMAXR |-->| TABLEAU DES INDEX MAXIMUM REELS PAR TYPES
64 !| NMOT2 |-->| TABLEAU DU NOMBRE DE MOTS CLES PAR TYPE
65 !| SIZE |-->| TABLEAU DES LONGUEURS DES MOTS CLES
66 !| TROUVE |-->| INDICATEUR D'ETAT DES MOTS CLES
67 !| | | = 0 : AUCUNE VALEUR TROUVEE
68 !| | | = 1 : VALEUR PAR DEFAUT TROUVEE
69 !| | | = 2 : VALEUR TROUVEE (FICHIER DE DONNEES)
70 !| | | = 3 : AUCUNE VALEUR TROUVEE (OPTIONNELLE)
71 !| | | = 5 : TABLEAU DE MOTS A SUBMIT COMPACTE
72 !| | | = 6 : MOT CLE A SUBMIT FORCE NON AFFECTE
73 !| | | = 7 : MOT CLE A SUBMIT FORCE AFFECTE (DICO)
74 !| | | = 8 : MOT CLE A SUBMIT FORCE AFFECTE (CAS)
75 !| | | = 9 : FICHIER DICO : SUBMIT + VALEUR LANCEUR
76 !| | | =10 : FICHIER CAS : SUBMIT + VALEUR LANCEUR
77 !| UTINDX |-->| TABLEAU DE LOGIQUES D'UTILISATION DES INDEX
78 !| VUCMD |<->| TABLEAU DE LOGIQUES (MEMORISATION DES CMDES)
79 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
80 !
81  USE declarations_damocles
82  USE declarations_special
83  IMPLICIT NONE
84 !
85 !
86  INTEGER ICOL,NMOT2(4),ADRESS(4,*),DIMENS(4,*),TROUVE(4,*)
87  INTEGER SIZE(4,*),INDIC(4,*),MOTINT(*),NFICDA,NMAXR(4)
88  LOGICAL MOTLOG(*),DYNAM,UTINDX(4,*),VUCMD(5),EXECMD
89  CHARACTER(LEN=*) MOTCLE(4,*),LIGNE
90  CHARACTER(LEN=PATH_LEN) MOTATT(4,*),MOTCAR(*)
91  DOUBLE PRECISION MOTREA(*)
92 !
93  INTEGER PREVAL,LONGLU
94  EXTERNAL preval,longlu
95 !
96 !-----------------------------------------------------------------------
97 !
98  INTEGER I1,IAD,L1,L2,TRANS,ISIZE,K,I,N
99  CHARACTER(LEN=72) :: FMT0, FMT1, FMT2, FMT3, FMT4, FMT5, FMT6,
100  & fmt7, fmt8, fmt10, fmt12, fmt14,
101  & fmt16, fmt18, fmt20, fmt22,
102  & fmt24, fmt26, fmt28, fmt30,
103  & fmt32, fmt34, fmt35
104  CHARACTER(LEN=6) :: TYP(4)
105  CHARACTER(LEN=1) TABUL
106 !
107 !-----------------------------------------------------------------------
108 !
109  INTRINSIC char
110 !
111 !-----------------------------------------------------------------------
112 !
113  parameter( typ = (/ 'MOTINT','MOTREA','MOTLOG','MOTCAR' /) )
114 !
115 !***********************************************************************
116 ! RCS AND SCCS MARKING
117 !
118 !***********************************************************************
119 !
120  tabul = char(9)
121  i1 = icol + 1
122 ! CASE WHERE LIGNE='NUL'
123  IF(i1+2.GT.longli) i1=1
124 !
125 ! *********************** COMMAND &FIN **************************
126 !
127  IF(ligne(i1:i1+2).EQ.'FIN'.OR.(execmd.AND.vucmd(5))) THEN
128  IF (.NOT.(execmd)) THEN
129  vucmd(5) = .true.
130  retour = .true.
131  GO TO 1000
132  ENDIF
133  WRITE (lu,12)
134  12 FORMAT(1x,/,1x,'END OF FILE FOR DAMOCLES',/)
135 !
136 ! *********************** COMMAND &ETA **************************
137 !
138  ELSE IF (ligne(i1:i1+2).EQ.'ETA'.OR.(execmd.AND.vucmd(2))) THEN
139  IF (.NOT.(execmd)) THEN
140  vucmd(2) = .true.
141  GO TO 1000
142  ENDIF
143  WRITE (lu,13)
144  13 FORMAT(1x,/,1x,'VALUES OF THE KEY-WORDS:',/)
145 !
146  fmt1 ="(1X,A,/,1X,'MOTINT(',1I3,')=',A,I9 ,/)"
147  fmt2 ="(1X,A,/,1X,'MOTREA(',1I3,')=',A,G16.7,/)"
148  fmt3 ="(1X,A,/,1X,'MOTLOG(',1I3,')=',A,L1 ,/)"
149  fmt4 ="(1X,A,/,1X,'MOTCAR(',1I3,')=',A,A ,/)"
150  fmt5 ="(1X,A,/,1X,'MOTINT(',1I3,') = ',A,' ; ',I9 ,/)"
151  fmt6 ="(1X,A,/,1X,'MOTREA(',1I3,') = ',A,' ; ',G16.7,/)"
152  fmt7 ="(1X,A,/,1X,'MOTLOG(',1I3,') = ',A,' ; ',L1 ,/)"
153  fmt8 ="(1X,A,/,1X,'MOTCAR(',1I3,') = ',A,' ; ',A ,/)"
154 !
155  DO n =1,4
156  DO i = 1 , nmaxr(n)
157  IF(utindx(n,i)) THEN
158  isize = SIZE(n,i)
159  IF(trouve(n,i).GE.1) THEN
160  DO k=1,dimens(n,i)
161  iad = adress(n,i) + k - 1
162  IF (indic(n,i).LT.2) THEN
163  trans=0
164  motatt(n,iad)=' '
165  l1=1
166  ELSE
167  trans=4
168  l1=longlu(motatt(n,iad))
169  ENDIF
170 ! IF (TROUVE(N,I).NE.3) THEN
171  ! Array as format not accepted in fortran 95
172  SELECT CASE (n+trans)
173  CASE(1)
174  fmt0 = fmt1
175  CASE(2)
176  fmt0 = fmt2
177  CASE(3)
178  fmt0 = fmt3
179  CASE(4)
180  fmt0 = fmt4
181  CASE(5)
182  fmt0 = fmt5
183  CASE(6)
184  fmt0 = fmt6
185  CASE(7)
186  fmt0 = fmt7
187  CASE(8)
188  fmt0 = fmt8
189  END SELECT
190  IF(n.EQ.1) THEN
191  WRITE(lu,fmt0)
192  & motcle(n,i)(1:isize),iad,motatt(n,iad)(1:l1),
193  & motint(iad)
194  ELSE IF (n.EQ.2) THEN
195  WRITE(lu,fmt0)
196  & motcle(n,i)(1:isize),iad,motatt(n,iad)(1:l1),
197  & motrea(iad)
198  ELSE IF (n.EQ.3) THEN
199  WRITE(lu,fmt0)
200  & motcle(n,i)(1:isize),iad,motatt(n,iad)(1:l1),
201  & motlog(iad)
202  ELSE IF (n.EQ.4) THEN
203  l2 = longlu(motcar(iad))
204  WRITE(lu,fmt0)
205  & motcle(n,i)(1:isize),iad,motatt(n,iad)(1:l1),
206  & motcar(iad)(1:l2)
207  ENDIF
208 ! ENDIF
209  ENDDO ! K
210  ELSE
211  WRITE(lu,213) motcle(n,i)(1:isize)
212 213 FORMAT(1x,a,/,1x,'VALUE NOT FOUND',/,1x)
213  ENDIF
214 !
215  ENDIF
216  ENDDO ! I
217  ENDDO ! N
218 !
219 ! *********************** COMMAND &IND **************************
220 !
221  ELSE IF (ligne(i1:i1+2).EQ.'IND'.OR.(execmd.AND.vucmd(3))) THEN
222  IF (.NOT.(execmd)) THEN
223  vucmd(3) = .true.
224  GOTO 1000
225  ENDIF
226 !
227 ! DEFINITION OF THE FORMATS USED
228 !
229  fmt1 ="(1X,'MOTINT(',1I3,') =',A,I9 )"
230  fmt2 ="(1X,'MOTREA(',1I3,') =',A,G16.7)"
231  fmt3 ="(1X,'MOTLOG(',1I3,') =',A,L1 )"
232  fmt4 ="(1X,'MOTCAR(',1I3,') =',A,A )"
233  fmt5 ="(1X,'MOTINT(',1I3,') = ',A,' ; ',I9 )"
234  fmt6 ="(1X,'MOTREA(',1I3,') = ',A,' ; ',G16.7)"
235  fmt7 ="(1X,'MOTLOG(',1I3,') = ',A,' ; ',L1 )"
236  fmt8 ="(1X,'MOTCAR(',1I3,') = ',A,' ; ',A )"
237  fmt10="(1X,'!!! COMPACTED ARRAY !!!')"
238  fmt12="(1X,'WARNING ! OUTPUT SIZE = 0')"
239  fmt14="(1X,'SIZE = ',I4)"
240  fmt16="(1X,'OPTIONAL VALUE NOT FOUND')"
241  fmt18="(1X,'FORCED VALUE NOT FOUND')"
242  fmt20="(1X,'INDEX = ',I4)"
243  fmt22="(1X,'VALUE NOT FOUND')"
244  fmt24="(/,1X,'VALUES OF THE KEY-WORDS :',/)"
245  fmt26="(1X,'NUMBER OF INTEGER KEY WORDS = ',I4,"//
246  & "10X,'(LAST INDEX :',I4,')')"
247  fmt28="(1X,'NUMBER OF REAL KEY WORDS = ',I4,"//
248  & "10X,'(LAST INDEX :',I4,')')"
249  fmt30="(1X,'NUMBER OF LOGICAL KEY WORDS = ',I4,"//
250  & "10X,'(LAST INDEX :',I4,')')"
251  fmt32="(1X,'NUMBER OF CHARACTER KEY WORDS = ',I4,"//
252  & "10X,'(LAST INDEX :',I4,')')"
253  fmt34="(1X,'TOTAL NUMBER OF KEY WORDS = ',I4)"
254  fmt35="(/,1X,70('-'),/,1X,A,/,1X,70('-'))"
255 !
256 ! TITLE
257  WRITE(lu,fmt24)
258 !
259  WRITE(lu,*)' '
260  WRITE(lu,*)'====================================='
261  WRITE(lu,fmt26) nmot2(1),nmaxr(1)
262  WRITE(lu,fmt28) nmot2(2),nmaxr(2)
263  WRITE(lu,fmt30) nmot2(3),nmaxr(3)
264  WRITE(lu,fmt32) nmot2(4),nmaxr(4)
265  WRITE(lu,*)'-------------------------------------'
266  WRITE(lu,fmt34) nmot2(1)+nmot2(2)+nmot2(3)+nmot2(4)
267  WRITE(lu,*)'====================================='
268  WRITE(lu,*)' '
269 
270 !
271  DO n =1,4
272  DO i = 1 , nmaxr(n)
273  IF(utindx(n,i)) THEN
274  IF(trouve(n,i).GE.1.OR.dimens(n,i).GT.1) THEN
275  WRITE(lu,fmt35) motcle(n,i)(1:SIZE(n,i))
276 ! COMPACTED ?
277  IF (trouve(n,i).EQ.5) THEN
278  WRITE(lu,fmt10)
279  ENDIF
280 ! INDEX
281  WRITE(lu,fmt20) i
282 ! SIZE
283  WRITE(lu,fmt14) dimens(n,i)
284  IF (dimens(n,i).GT.1.AND.
285  & trouve(n,i).EQ.0.AND.dynam) THEN
286  WRITE(lu,fmt12)
287  ENDIF
288 !
289 ! TROUVE ?
290  IF (trouve(n,i).EQ.3) THEN
291  WRITE(lu,fmt16)
292  ENDIF
293  IF (trouve(n,i).EQ.6) THEN
294  WRITE(lu,fmt18)
295  ENDIF
296 !
297 ! LINEFEED FOR PRESENTATION PURPOSES
298  IF (dimens(n,i).GT.1) WRITE(lu,*) ' '
299 !
300  DO k=1,dimens(n,i)
301  iad = adress(n,i) + k - 1
302  IF (indic(n,i).GE.2) THEN
303  trans = 4
304  l1=longlu(motatt(n,iad))
305  ELSE
306  trans = 0
307  motatt(n,iad)=' '
308  l1 =1
309  ENDIF
310 !
311 ! IF (TROUVE(N,I).NE.3) THEN
312  SELECT CASE (n+trans)
313  CASE(1)
314  fmt0 = fmt1
315  CASE(2)
316  fmt0 = fmt2
317  CASE(3)
318  fmt0 = fmt3
319  CASE(4)
320  fmt0 = fmt4
321  CASE(5)
322  fmt0 = fmt5
323  CASE(6)
324  fmt0 = fmt6
325  CASE(7)
326  fmt0 = fmt7
327  CASE(8)
328  fmt0 = fmt8
329  END SELECT
330  IF(n.EQ.1) THEN
331  WRITE(lu,fmt0)
332  & iad,motatt(n,iad)(1:l1),motint(iad)
333  ELSE IF (n.EQ.2) THEN
334  WRITE(lu,fmt0)
335  & iad,motatt(n,iad)(1:l1),motrea(iad)
336  ELSE IF (n.EQ.3) THEN
337  WRITE(lu,fmt0)
338  & iad,motatt(n,iad)(1:l1),motlog(iad)
339  ELSE IF (n.EQ.4) THEN
340  l2 = longlu(motcar(iad))
341  WRITE(lu,fmt0)
342  & iad,motatt(n,iad)(1:l1),motcar(iad)(1:l2)
343  ENDIF
344 ! ENDIF
345  ENDDO ! K
346  ELSE
347  WRITE(lu,fmt35) motcle(n,i)(1:SIZE(n,i))
348  WRITE(lu,fmt22)
349  WRITE(lu,fmt20) i
350  WRITE(lu,fmt14) dimens(n,i)
351  WRITE(lu,*)' '
352  ENDIF
353 !
354  ENDIF
355  ENDDO ! I
356  ENDDO ! N
357 !
358 ! *********************** COMMAND &LIS **************************
359 !
360  ELSE IF (ligne(i1:i1+2).EQ.'LIS'.OR.(execmd.AND.vucmd(1))) THEN
361  IF (.NOT.(execmd)) THEN
362  vucmd(1) = .true.
363  GO TO 1000
364  ENDIF
365 ! FORMATS
366  fmt2 = "(/,1X,'KEY-WORDS LIST :',/)"
367  fmt4 = "(1X,'SIZE : ',I3,5X,'ADRESS IN ',A,"//
368  & "1X,':',1X,I3)"
369  fmt5 = "(1X,/,1X,A)"
370 ! TITLE
371  WRITE (lu,fmt2)
372 !
373  DO n = 1 , 4
374  DO i = 1 , nmaxr(n)
375 !
376  IF(utindx(n,i)) THEN
377  iad = adress(n,i)
378  WRITE (lu,fmt5) motcle(n,i)(1:SIZE(n,i))
379  IF (dimens(n,i).GT.1.AND.trouve(n,i).EQ.0.AND.dynam) THEN
380  WRITE (lu,fmt4) 0,typ(n),iad
381  ELSE
382  WRITE (lu,fmt4) dimens(n,i),typ(n),iad
383  ENDIF
384  ENDIF
385  ENDDO ! I
386  ENDDO ! N
387 !
388 ! *********************** COMMAND &DOC **************************
389 !
390  ELSE IF ( ligne(i1:i1+2).EQ.'DOC' ) THEN
391 !
392  WRITE(lu,*) 'COMMAND &DOC HAS BEEN SUPPRESSED IN THIS RELEASE'
393 !
394 ! *********************** COMMAND &STO **************************
395 !
396  ELSE IF (ligne(i1:i1+2).EQ.'STO'.OR.(execmd.AND.vucmd(4))) THEN
397  IF (.NOT.(execmd)) THEN
398  vucmd(4) = .true.
399  retour=.true.
400  GO TO 1000
401  ENDIF
402  WRITE (lu,1114)
403 1114 FORMAT(1x,/,1x,'DAMOCLES STOPPED BY COMMAND &STO')
404  CALL plante(1)
405  stop
406 !
407 ! *********************** COMMAND &DYN **************************
408 !
409  ELSEIF ( ligne(i1:i1+2).EQ.'DYN' ) THEN
410  IF (nfic.EQ.nficda) THEN
411  WRITE(lu,*)'WARNING : INSTRUCTION &DYN FROM STEERING ',
412  & 'FILE HAS BEEN IGNORED !!'
413  ELSE
414  dynam=.true.
415  ENDIF
416  ELSE
417  WRITE(lu,'(1X,A)') ligne(1:longli)
418  WRITE(lu,'(1X,A6,I4,A)') 'LINE: ',nlign,' UNKNOWN COMMAND'
419  ENDIF
420 !
421 ! //// SEEKS THE FIRST WHITE CHARACTER FOLLOWING & ////
422 !
423  1000 CONTINUE
424  icol = preval(i1+1,ligne,' ',tabul,' ')
425 !
426 !-----------------------------------------------------------------------
427 !
428  RETURN
429  END
dimens
integer function dimens(IELM)
Definition: dimens.f:7
declarations_special
Definition: declarations_special.F:3
declarations_special::lu
integer lu
Definition: declarations_special.F:45
declarations_damocles::retour
logical retour
Definition: declarations_damocles.f:28
declarations_damocles::nlign
integer nlign
Definition: declarations_damocles.f:30
declarations_damocles::nfic
integer nfic
Definition: declarations_damocles.f:33
cmd
subroutine cmd(ICOL, LIGNE, ADRESS, DIMENS, TROUVE, MOTCLE, NMOT2, MOTINT, MOTREA, MOTLOG, MOTCAR, MOTATT, INDIC, SIZE, UTINDX, DYNAM, VUCMD, EXECMD, NFICDA, NMAXR)
Definition: cmd.f:9
declarations_damocles::longli
integer longli
Definition: declarations_damocles.f:31
declarations_damocles
Definition: declarations_damocles.f:3
Generated on Tue Jan 5 2021 14:38:00 for The TELEMAC-MASCARET system by doxygen 1.8.13