Télécharger chkesc.eso

Retour à la liste

Numérotation des lignes :

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

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