Télécharger chkesc.eso

Retour à la liste

Numérotation des lignes :

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

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