Télécharger chkesc.eso

Retour à la liste

Numérotation des lignes :

chkesc
  1. C CHKESC SOURCE CB215821 21/11/25 21:15:00 11201
  2. SUBROUTINE CHKESC(IRT,IMENA)
  3.  
  4. C CHKESC REGARDE SI IL Y A DANS L'INSTRUCTION UN OBJET DE TYPE //
  5. C SI C'EST LE CAS, IL RAJOUTE ASSI TOUS DANS L'INSTRUCTION
  6. IMPLICIT INTEGER(I-N)
  7. IMPLICIT REAL*8(A-H,O-Z)
  8.  
  9. -INC CCNOYAU
  10. -INC SMTABLE
  11. -INC SMCHAML
  12. -INC SMMODEL
  13.  
  14. -INC PPARAM
  15. -INC CCOPTIO
  16.  
  17. CHARACTER*8 TYPOBJ,CHA8,CHARRE,CHACRE
  18. LOGICAL LOGR1,LOGR2
  19.  
  20. PARAMETER (NBMO1=8)
  21. CHARACTER*4 LESMOT(NBMO1)
  22.  
  23. C LESMOT = LISTE DES OPÉRATEURS GÉRANT LES OBJEST ESCLAVES
  24. DATA LESMOT/'ASSI','LIST','DETR','ETG ',
  25. & 'TYPE','DEBP','FINP','RESP'/
  26.  
  27. PARAMETER (NBMO2=46)
  28. CHARACTER*4 LESMO2(NBMO2)
  29. C LESMO2 = LISTE DES OPÉRATEURS DEMANDANT UNE FUSION DES OBJETS
  30. C AVANT DE LES APPELER
  31. DATA LESMO2/'MASQ','TYPE','EXIS','FORM','NLOC','TRAC','PROI',
  32. & 'ELIM','POIN','NOEU','ARET','CERC','DROI','CONT',
  33. & 'DALL','ENVE','FACE','REGL','ROTA','SURF','TRAN',
  34. & 'PAVE','VOLU','PART','AFFI','CONF','DEPL','DIFF',
  35. & 'ELEM','HOMO','INCL','INTE','INVE','ORDO','PROJ',
  36. & 'RAFF','RAFT','REGE','SYME','TOUR','PLUS','MOIN',
  37. & 'UNIQ','DIME','EXTR','SI '/
  38.  
  39. PARAMETER (NBMO3=2)
  40. CHARACTER*4 LESMO3(NBMO3)
  41. C LESMO3 = LISTE DES OPERATEURS EXECUTES EN PARALLELE ALORS QU''UN
  42. C MCHAML (NON //) A ETE LU SANS MMODEL
  43. DATA LESMO3/'REDU','SOUC'/
  44.  
  45. C BREDUC : BOOLEEN PERMETTANT D'ENCLENCHER LA FUSION
  46. C BREMPL : BOOLEEN PERMETTANT DE REMPLACER DANS LA PILE LA TABLE PAR L'OBJET FUSIONNE
  47. LOGICAL BREDUC,BREMPL,BREDU2,BREMP2,BSPECI
  48. LOGICAL BMAX
  49.  
  50. C SID : SEGMENT CONTENANT LES INFORMATIONS POUR LA FUSION DES OBJETS
  51. SEGMENT SID
  52. C NBFUS : NOMBRE D'OBJETS A FUSIONNER
  53. C IPOINT : POINTEURS A FUSIONNER ou ENTIERS A FUSIONNER (cas particuler MAXI / MINI)
  54. C BVAL : LOGIQUES SUR LESQUELS ON FAIT UN ET/OU LOGIQUE
  55. C XVAL : REELS A FUSIONNER (cas particuler MAXI / MINI)
  56. C CVAL : MOTS A FUSIONNER (cas particuler MAXI / MINI)
  57. C CHATYP : MOT DONNANT LE TYPE D'OBJETS A FUSIONNER
  58. INTEGER IPOINT(NBFUS)
  59. LOGICAL BVAL (NBFUS)
  60. REAL*8 XVAL (NBFUS)
  61. CHARACTER*(IC1) CVAL (NBFUS)
  62. CHARACTER*8 CHATYP,CREATE
  63. ENDSEGMENT
  64.  
  65. C
  66. C POUR TOUT AUTRE OPÉRATEUR EN PRÉSENCE DE TABLE ESCLAVE
  67. C (SAUF DE TYPE CHPOINT OU RIGIDITE)
  68. C ON INSERE "ASSIS TOUS" AU DÉBUT DE LA PHRASE GIBIANE
  69. C SANS FAIRE DE FUSION.
  70. C LES TABLES ESCLAVE DE CHPOINT, DE RIGIDITE, DE FLOTTANT ET DE LOGIQUE
  71. C SONT TOUJOURS ASSEMBLÉES
  72. C EN SORTIE : IRT =1 VEUT DIRE ALLER DANS ASSISTANT
  73. C : IMENA=0 VEUT DIRE NE PAS FAIRE DE MENAGE TOUT DE SUITE
  74. C CAR FUSION SANS REMPLACEMENT DANS TABLE DES OBJETS
  75.  
  76. DIMENSION IAZ(100)
  77.  
  78.  
  79. C WRITE(6,*) ' ENTREE DANS CHKESC'
  80. BREDUC = .FALSE.
  81. BREDU2 = .FALSE.
  82. BREMPL = .FALSE.
  83. BSPECI = .FALSE.
  84. BMAX = .TRUE.
  85. IRT = 0
  86. ILUOB = 0
  87. IMENA = 1
  88.  
  89. IREPRO = 0
  90. IREMOD = 0
  91. IRECHA = 0
  92. IREESC = 0
  93. IMOT1 = 0
  94. IMOT2 = 0
  95. IMOT3 = 0
  96. IRETOU = 0
  97. IRET = 0
  98.  
  99. CALL LIROBJ('PROCEDUR',IRET,0,IREPRO)
  100. IF (IREPRO.NE.0) THEN
  101. CALL REFUS
  102. C WRITE (6,*) ' CHKESC : Lecture d''une PROCEDUR'
  103. RETURN
  104. ENDIF
  105.  
  106. C IBLQM =0 PERMET À GIBIANE DE LIRE AU DELÀ DES MOTS
  107. IBLQM=0
  108.  
  109. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  110. C Lecture de MOTS et d''OBJETS intervenants dans la LOGIQUE de CHKESC
  111. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  112. CALL LIRMOT(LESMOT,NBMO1,IMOT1,0)
  113. IF (IMOT1.NE.0) THEN
  114. CALL REFUS
  115. C WRITE (6,*) ' CHKESC ',LESMOT(IMOT1)
  116. RETURN
  117. ENDIF
  118.  
  119. CALL LIRMOT(LESMO2,NBMO2,IMOT2,0)
  120. IF (IMOT2.NE.0) THEN
  121. C IF (IMOT2 .EQ. 7) THEN
  122. CC Cas un peu particulier de l''operateur 'PROI'
  123. C BSPECI = .TRUE.
  124. C ENDIF
  125. CALL REFUS
  126. ELSE
  127. CALL LIRMOT(LESMO3,NBMO3,IMOT3,0)
  128. IF (IMOT3.NE.0) THEN
  129. CALL REFUS
  130. ENDIF
  131. ENDIF
  132.  
  133. CALL LIROBJ('MMODEL',IRET,0,IREMOD)
  134. IF (IREMOD.NE.0) THEN
  135. MMODEL=IRET
  136. CALL REFUS
  137. ENDIF
  138.  
  139. CALL LIROBJ('MCHAML',IRET,0,IRECHA)
  140. IF (IRECHA.NE.0) THEN
  141. MCHELM=IRET
  142. CALL REFUS
  143. ENDIF
  144.  
  145. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  146. C Logique generale de Fusion & Remplacement des OBJETS
  147. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  148. IF (IMOT2.NE.0) THEN
  149. C Fusion pour les Operateurs de LESMO2
  150. BREDUC=.TRUE.
  151. BREMPL=.FALSE.
  152.  
  153. ELSEIF(IMOT3 .NE. 0) THEN
  154. IF (IREMOD .NE. 0) THEN
  155. C Un MMODEL dans 'REDU' enclenche la fusion sans remplacement
  156. BREDUC=.TRUE.
  157. BREMPL=.FALSE.
  158. ENDIF
  159.  
  160. ELSEIF ((IRECHA .NE. 0) .OR. (IREMOD .NE. 0)) THEN
  161. C Un MMODEL ou un MCHAML enclenche la fusion avec remplacement
  162. BREDUC=.TRUE.
  163. BREMPL=.TRUE.
  164. ENDIF
  165.  
  166.  
  167. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  168. C Boucle sur les arguments de la ligne decodee
  169. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  170. IASSS=0
  171.  
  172. C Cas de souci
  173. IF (IMOT3.EQ.2) then
  174. IASSS=1
  175. ENDIF
  176. DO 10 ICCC=1,100
  177. IBLQM=0
  178. CALL LIRTAB('ESCLAVE',MTABLE,0,IREESC)
  179. ILUOB=ILUOB+1
  180. IAZ(ILUOB)=IMOTLU
  181. IBLQM=1
  182. IF (IREESC.EQ.0) THEN
  183. IF(IASSS.EQ.1)THEN
  184. GOTO 100
  185. ELSE
  186. C WRITE(6,*)'CHKESC : Sortie n_3'
  187. RETURN
  188. ENDIF
  189. ENDIF
  190.  
  191. TYPOBJ=' '
  192.  
  193. C RECHERCHE DU CREATEUR (MTABLE ressort SEGACT dans les ASSISTANT)
  194. CALL ACCTAB(MTABLE,'MOT ',IND ,0.D0 ,'CREATEUR',.TRUE.,0 ,
  195. & 'MOT ',IVALRE,XVALRE,CHACRE ,LOGR1 ,ID1)
  196. IF (IERR.NE.0) RETURN
  197.  
  198. ML=MLOTAB
  199. C DIMENSIONNEMENT DU SEGMENT SID A (ML - 2) a cause des indices 'SOUSTYPE' et 'CREATEUR'
  200. NBFUS = ML - 2
  201. * a voir quoi mettre dans ic1?
  202. IC1 = 8
  203. SEGINI,SID
  204. SID.CREATE=CHACRE
  205. NBENT = 0
  206.  
  207. IND=1
  208. CALL ACCTAB(MTABLE,'ENTIER',IND ,0.D0 ,' ',.TRUE.,0,
  209. & TYPOBJ ,IVALRE,XVALRE,CHARRE,LOGR1 ,ID1)
  210. IF (IERR.NE.0) RETURN
  211.  
  212. IF ((IRECHA .NE. 0) .AND. (TYPOBJ .EQ. 'MCHAML')) THEN
  213. C PLANTE SUR LES COMMANDES AVEC MCHAML // ET NORMAUX
  214. C WRITE(*,*)'Utilisation de MCHAML // et MCHAML normaux'
  215. C CALL TRBAC
  216. C CALL ERREUR(21)
  217. C WRITE(6,*)'CHKESC : Sortie n_4'
  218. C RETURN
  219. ENDIF
  220.  
  221. IF ((IRECHA .NE. 0) .AND. (TYPOBJ .EQ. 'MMODEL') .AND.
  222. & (IMOT3 .EQ. 0)) THEN
  223. C PLANTE SUR LES COMMANDES AVEC MMODEL // ET MCHAML NORMAUX
  224. C WRITE(*,*)'Utilisation de MMODEL // et MCHAML normaux'
  225. C CALL TRBAC
  226. C CALL ERREUR(21)
  227. C WRITE(6,*)'CHKESC : Sortie n_5'
  228. C RETURN
  229. ENDIF
  230.  
  231. IF (IMOT2 .EQ. 0) THEN
  232. IF (TYPOBJ .EQ. 'MMODEL') THEN
  233. C PAS DE REDUCTION SI UN MMODEL ESCLAVE EST RENCONTRE
  234. BREDUC = .FALSE.
  235. IASSS=1
  236. GOTO 10
  237.  
  238. ELSEIF((TYPOBJ.EQ.'MCHAML '.OR. TYPOBJ .EQ. 'MAILLAGE' .OR.
  239. & TYPOBJ.EQ.'ENTIER ') .AND. (.NOT. BREDUC)) THEN
  240. IASSS=1
  241. GOTO 10
  242. ENDIF
  243. ELSEIF(BSPECI) THEN
  244. IASSS=1
  245. GOTO 10
  246. ENDIF
  247.  
  248. C Regles locales de remplacement
  249. BREDU2 = BREDUC
  250. BREMP2 = BREMPL
  251. IF (CHACRE .EQ. 'SOUC') THEN
  252. BMAX = .FALSE.
  253. ENDIF
  254. IF (TYPOBJ .EQ. 'FLOTTANT') THEN
  255. BREDU2 = .TRUE.
  256. BREMP2 = .TRUE.
  257.  
  258. IF (CHACRE .EQ. 'MAXI') THEN
  259. BMAX = .TRUE.
  260. ELSEIF (CHACRE .EQ. 'MINI') THEN
  261. BMAX = .FALSE.
  262. ELSE
  263. CALL ERREUR(21)
  264. RETURN
  265. ENDIF
  266.  
  267. ELSEIF ((TYPOBJ.EQ.'RIGIDITE') .OR. (TYPOBJ.EQ.'CHPOINT ').OR.
  268. & (TYPOBJ.EQ.'LOGIQUE ' )) THEN
  269. BREDU2 = .TRUE.
  270. BREMP2 = .TRUE.
  271. ENDIF
  272.  
  273. IF (BREDU2) THEN
  274. IF (TYPOBJ .NE. 'RIGIDITE' .AND. TYPOBJ .NE. 'CHPOINT ' .AND.
  275. & TYPOBJ .NE. 'LOGIQUE ' .AND. TYPOBJ .NE. 'FLOTTANT' .AND.
  276. & IMOT2 .EQ. 0 .AND. IMOT3.EQ. 0) THEN
  277. C WRITE(*,*)TYPOBJ,BREMP2,BREMPL
  278. C WRITE(*,*)'FUSION CHKESC ANORMALE...'
  279. C CALL ERREUR(21)
  280. C RETURN
  281. ENDIF
  282.  
  283. C REMPLISSAGE DU SEGMENT SID POUR LA FUSION
  284. NBENT = NBENT + 1
  285. SID.IPOINT(NBENT)= ID1
  286. SID.BVAL (NBENT)= LOGR1
  287. SID.XVAL (NBENT)= XVALRE
  288. SID.CHATYP = TYPOBJ
  289. CHA8 = TYPOBJ
  290.  
  291. IF (ML .GE. 4) THEN
  292. DO I=4,ML
  293. C La TABLE n'est plus SEGDES par acctab pour les ESCLAVES
  294. IND=i-2
  295. CALL ACCTAB(MTABLE,'ENTIER',IND ,0.D0 ,' ',.TRUE.,0,
  296. & TYPOBJ ,IVALRE,XVALRE,CHARRE,LOGR2 ,ID2)
  297. IF (IERR.NE.0) RETURN
  298.  
  299. IF (TYPOBJ .NE. CHA8) THEN
  300. C ERREUR SI LES TYPES SONT DIFFERENTS ENTRE 2 INDICES DE LA TABLE ESCLAVE
  301. MOTERR(1:8 ) = CHA8
  302. MOTERR(9:16) = TYPOBJ
  303. CALL ERREUR(1045)
  304. SEGSUP,SID
  305. WRITE(6,*)'CHKESC : Sortie n_7'
  306. RETURN
  307. ENDIF
  308.  
  309. C REMPLISSAGE DU SEGMENT SID POUR LA FUSION PAR TOURNOI
  310. NBENT=NBENT + 1
  311. SID.IPOINT(NBENT)= ID2
  312. SID.BVAL(NBENT) = LOGR2
  313. SID.XVAL(NBENT) = XVALRE
  314. ENDDO
  315. ENDIF
  316.  
  317. C LANCEMENT DE LA FUSION DES OBJETS
  318. C IF (IIMPI .EQ. 215821) THEN
  319. C WRITE(IOIMP,*)'FUSION ENCLENCHEE DANS CHKESC : ',CHA8,BREMP2
  320. C CALL TRBAC
  321. C ENDIF
  322. ID = SID
  323. CALL FUNOBJ(ID,ID1,XVALRE,LOGR1,BMAX)
  324.  
  325. IF (TYPOBJ.EQ.'LOGIQUE ') THEN
  326. CALL POSLOG(LOGR1,ID1)
  327.  
  328. ELSEIF (TYPOBJ.EQ.'FLOTTANT') THEN
  329. IF(ID1 .EQ. 0)THEN
  330. CALL POSREE(XVALRE,ID1)
  331. ELSE
  332. CALL ACTOBJ('LISTREEL',ID1,1)
  333. IMENA=0
  334. ENDIF
  335.  
  336. ELSEIF (TYPOBJ.EQ.'ENTIER ') THEN
  337. C Il manque la gestion de MAXI et MINI pour ce cas la !
  338. CALL ACTOBJ('LISTENTI',ID1,1)
  339. IMENA=0
  340.  
  341. ELSE
  342. CALL ACTOBJ(TYPOBJ,ID1,1)
  343. IMENA=0
  344. ENDIF
  345.  
  346. C REMPLACEMENT DE LA TABLE PAR LE RESULTAT DE LA FUSION
  347. C - Dans la pile GIBIANE
  348. C - Dans la pile des NOMS si BREMP2 est VRAI
  349. CALL RMPGBN(MTABLE,ID1,TYPOBJ,BREMP2)
  350.  
  351. ELSE
  352. WRITE(IOIMP,*)'ERREUR DANS CHKESC.ESO,',TYPOBJ
  353. CALL ERREUR(21)
  354. RETURN
  355. ENDIF
  356.  
  357. SEGSUP,SID
  358. 10 CONTINUE
  359.  
  360. C
  361. 100 CONTINUE
  362. C CALL REFUS
  363. DO IAZI=1,ILUOB
  364. IMOTLU=IAZ(IAZI)
  365. IF(IMOTLU.NE.0) THEN
  366. JPOOB1(IMOTLU)=.TRUE.
  367. IF(IBPILE.GT.IMOTLU) IBPILE=IMOTLU
  368. IF(IHPILE.LT.IMOTLU) IHPILE=IMOTLU
  369. ENDIF
  370. ENDDO
  371. CHARRE=' '
  372. CALL LIRCHA(CHARRE,0,IRETOU)
  373. IF (IRETOU.NE.0) CALL REFUS
  374. IF (IRETOU.EQ.0) RETURN
  375. C CALL TRBAC
  376. IRT=1
  377.  
  378. C WRITE(6,*)'CHKESC : Sortie n_8 NORMALE'
  379. END
  380.  
  381.  
  382.  
  383.  
  384.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales