Télécharger grad1x.eso

Retour à la liste

Numérotation des lignes :

  1. C GRAD1X SOURCE CB215821 16/06/15 21:15:02 8969
  2. C
  3. subroutine GRAD1X (IMODEL,IVADEP,LRE,IVAGRA,NGRA,
  4. & MINT1,MINT2,IIPDPG,IOK)
  5. c
  6. c CALCUL DU GRADIENT DANS LE CAS D'ELEMENTS XFEM (MFR=63)
  7. c
  8. c largement inspiré de epsix.eso + bgrmas.eso
  9. C
  10. C
  11. C*********************************************************
  12. C PARTIE DECLARATIVE
  13. C*********************************************************
  14.  
  15. C
  16. IMPLICIT REAL*8(A-H,O-Z)
  17. C
  18. PARAMETER (NDDLMAX=30,NBNIMAX=10)
  19. C
  20. PARAMETER (NBENRMAX=5)
  21. DIMENSION MLRE(NBENRMAX+1)
  22. C
  23. -INC CCOPTIO
  24. -INC SMCOORD
  25. -INC SMMODEL
  26. -INC SMCHAML
  27. -INC SMINTE
  28. -INC SMELEME
  29. -INC SMLREEL
  30. C
  31. POINTEUR MCHEX1.MCHELM,MINT1.MINTE,MINT2.MINTE
  32. C
  33. SEGMENT WRK1
  34. REAL*8 XE(3,NBBB)
  35. REAL*8 XDDL(LRE),GRADI(NGRA)
  36. ENDSEGMENT
  37. c
  38. SEGMENT WRK2
  39. REAL*8 SHPWRK(6,NBNO),BGR(NGRA,LRE)
  40. REAL*8 LV7WRK(NBENRMA2,2,6,NBBB)
  41. ENDSEGMENT
  42. C
  43. SEGMENT MPTVAL
  44. INTEGER IPOS(NS),NSOF(NS)
  45. INTEGER IVAL(NCOSOU)
  46. CHARACTER*16 TYVAL(NCOSOU)
  47. ENDSEGMENT
  48. C
  49. SEGMENT MRACC
  50. INTEGER TLREEL(NBENRMA2,NBI)
  51. ENDSEGMENT
  52. C
  53. C write (*,*) '############################'
  54. C write (*,*) '##### DEBUT DE GRAD1X #####'
  55. C write (*,*) '############################'
  56. C
  57. C
  58. C*********************************************************
  59. c
  60. C RECUPERATION + ACTIVATIONS + VALEURS UTILES
  61. c
  62. C*********************************************************
  63. c
  64. IOK = 0
  65. C++++ Recup de la geometrie deja activée par grad1 ++++++
  66. MELEME= IMAMOD
  67. C nbre de noeuds par element, nbre d elements
  68. NBNN1 = NUM(/1)
  69. NBEL1 = NUM(/2)
  70.  
  71.  
  72. C++++ RECUP DES INFOS EF ++++++++++++++++++++++++++++++++
  73. MELE = NEFMOD
  74. NGAU1 = MINT1.POIGAU(/1)
  75. c C sous decoupage et points de Gauss de l element geometrique de base
  76. c IF(MINT2.NE.0) SEGACT,MINT2
  77. c NGAU2 = MINT2.POIGAU(/1)
  78.  
  79.  
  80. C++++ Recup des infos d enrichissement +++++++++++++++++++
  81. c recup du MCHEX1 d'enrichissement
  82. MCHAM1 = 0
  83. NOBMO1 = IVAMOD(/1)
  84. if (NOBMO1.ne.0) then
  85. do iobmo1=1,NOBMO1
  86. if ((TYMODE(iobmo1)).eq.'MCHAML') then
  87. MCHEX1 = IVAMOD(iobmo1)
  88. segact,MCHEX1
  89. if ((MCHEX1.TITCHE).eq.'ENRICHIS') then
  90. MCHAM1 = MCHEX1.ICHAML(1)
  91. segact,MCHAM1
  92. segdes,MCHEX1
  93. goto 1000
  94. endif
  95. segdes,MCHEX1
  96. endif
  97. enddo
  98. write(*,*) 'Le modele est vide (absence d enrichissement)'
  99. else
  100. write(*,*) 'Il n y a pas de MCHEML enrichissement dans le Modele'
  101. endif
  102.  
  103. 1000 continue
  104. c niveau d enrichissement(s) du modele (ddls std u exclus)
  105. c NBENR1= 0 si std, 1 si H seul, 2 si H+F1, 3 si H+F1+F2, etc...
  106. if (MCHAM1.ne.0) then
  107. NBENR1= MCHAM1.IELVAL(/1)
  108. else
  109. NBENR1 = 0
  110. endif
  111. C write(*,*) 'niveau d enrichissement(s) du modele',NBENR1
  112. c
  113. C
  114. C
  115. C*********************************************************
  116. C INITIALISATIONS...
  117. C*********************************************************
  118. c
  119. c preparation des tables avec:
  120.  
  121. if (NBENR1.ne.0) then
  122. do ienr=1,NBENR1
  123. c -le nombre d'inconnues de chaque sous-zone
  124. c determinee depuis le nombre de fonction de forme
  125. c ienr= 1: U+H(1+1=2), 2: U+H+F1(2+4=6), 3: U+H+F1+F2(6+4=10)
  126. nbniJ = 2 + ((ienr-1)*4)
  127. MLRE(1+ienr) = IDIM*NBNN1*nbniJ
  128. enddo
  129. endif
  130. C Tables + longues car 1er indice correspond au fontion de forme std
  131. MLRE(1) = IDIM*NBNN1*1
  132.  
  133. if (NBENR1.lt.(NBENRMAX+1)) then
  134. do ienr=(NBENR1+1),(NBENRMAX)
  135. MLRE(1+ienr) = 0
  136. enddo
  137. endif
  138. c
  139. c ...DU SEGMENT WRK1
  140. NBENRMA2 = NBENRMAX
  141. NBBB = NBNN1
  142. SEGINI,WRK1
  143.  
  144. c ...DU SEGMENT WRK2
  145. c NBNO = NBNI
  146. NBNO = LRE/IDIM
  147. SEGINI,WRK2
  148. C
  149. c ...DU SEGMENT MRACC
  150. NBENRMA2 = NBENRMAX
  151. NBI = NBNN1
  152. segini,MRACC
  153. C
  154. C du nombre d erreur sur le noms de composantes
  155. NBERR1=0
  156.  
  157.  
  158.  
  159. C*********************************************************
  160. C
  161. C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> BOUCLE SUR LES ELEMENTS
  162. C
  163. DO 2000 J=1,NBEL1
  164. C write(*,*) '========= EF',J,' /',NBEL1,'========='
  165. C
  166. C
  167. C*********************************************************
  168. C POUR CHAQUE ELEMENT, ...
  169. C*********************************************************
  170. C
  171. C++++ ON RECUPERE LES COORDONNEES DES NOEUDS DE L ELEMENT
  172. CALL DOXE(XCOOR,IDIM,NBNN1,NUM,J,XE)
  173. C
  174. c
  175. C++++ NBENRJ = niveau d enrichissement de l element ++++
  176. C =0 si EF std =1 si U+H =2 si U+H+F1 =3 si U+H+F1+F2
  177. NBENRJ=0
  178. if(NBENR1.ne.0) then
  179. do IENR=1,NBENR1
  180. MELVA1 = MCHAM1.IELVAL(IENR)
  181. segact,MELVA1
  182. N2PTEL=MELVA1.IELCHE(/1)
  183. N2EL =MELVA1.IELCHE(/2)
  184. do I=1,NBNN1
  185. IF (N2PTEL.EQ.1 .AND. N2EL.EQ.1)THEN
  186. C Cas du champ constant sur tout le MAILLAGE support
  187. mlree1 = MELVA1.IELCHE(1,1)
  188. ELSEIF(N2PTEL.EQ.1)THEN
  189. C Cas du champ constant par element
  190. mlree1 = MELVA1.IELCHE(1,J)
  191. ELSE
  192. C Cas du champ variable sur les noeuds et les elements
  193. mlree1 = MELVA1.IELCHE(I,J)
  194. ENDIF
  195.  
  196. C on en profite pour remplir MRACC table de raccourcis pour cet element
  197. TLREEL(IENR,I) = mlree1
  198. if (mlree1.ne.0) then
  199. NBENRJ = max(NBENRJ,IENR)
  200. C et on active la listreel
  201. segact,mlree1
  202. endif
  203. enddo
  204. segdes,MELVA1
  205. enddo
  206. endif
  207. if (NBENRMA2.gt.NBENR1) then
  208. do IENR2=(NBENR1+1),NBENRMA2
  209. do I=1,NBNN1
  210. TLREEL(IENR2,I) = 0
  211. enddo
  212. enddo
  213. endif
  214. C
  215. c
  216. c++++ quelques indices pour dimensionner au plus juste
  217. c nbre total de ddl de l'élément considéré
  218. c NLIGRD = MLRE(1+NBENRJ)
  219. c NLIGRD = MLRE(1+NBENRJ)
  220. NDDL = MLRE(1+NBENRJ)
  221. c nbre fonction de forme=((Ni_std+Ni_enrichi)*nbnoeud)=Ninconnues/idim
  222. NBNI = (MLRE(1+NBENRJ)) / IDIM
  223. * nbre d inconnue / noeud
  224. NCOMP = NDDL/NBNN1
  225. C write(6,*) 'EF',J,' NBENRJ=',NBENRJ,
  226. C &'donc',NDDL,' ddls et ',NBNI,' fonctions de forme'
  227. c
  228. c
  229. C
  230. C++++ ON CALCULE XDDL ++++
  231. MPTVAL = IVADEP
  232. NCOSOU = IVAL(/1)
  233. C
  234. INITOT = 0
  235. C-->> BOUCLE SUR LES niveaux d'ENRICHISSEMENTS (0:U 1:A 2:BCDE1 3:BCDE2)
  236. DO IENR=0,NBENRJ
  237. *nbre de fonction(s) de ce niveau d'enrichissement (=1 si std ou H, =4 pour F1,2,...)
  238. if (IENR .le. 1) then
  239. NBNIENR = 1
  240. else
  241. NBNIENR = 4
  242. endif
  243. C---->> BOUCLE SUR LES fonctions de forme de ce type d'enrichissement
  244. DO INI=1,NBNIENR
  245. INITOT = INITOT + 1
  246. C------>> BOUCLE SUR LA DIMENSION
  247. DO 2220 KDIM=1,IDIM
  248. ICOMP = (INITOT-1)*IDIM + KDIM
  249.  
  250. c --cas ou on n'a pas trouvé assez de composantes--
  251. if(ICOMP.GT.NCOSOU) GOTO 2221
  252.  
  253. MELVAL = IVAL(ICOMP)
  254. c --cas ou on a pas trouvé cette composante dans cette zone du
  255. c chpoint solution devenu mchaml --
  256. if(MELVAL.eq.0)then
  257. c Avait on besoin de cette composante?
  258. c oui, si c'est une composante obligatoire
  259. if(IENR.eq.0) goto 2991
  260. c oui, si l'un des noeuds est enrichi
  261. do I=1,NBNN1
  262. if(TLREEL(IENR,I).ne.0) goto 2991
  263. enddo
  264. c non, si c'est facultatif et qu'on n'est pas enrichi -> on saute
  265. goto 2220
  266. c ->AVERTISSEMENT puis on saute
  267. 2991 NBERR1=NBERR1+1
  268. if(IIMPI.lt.1) goto 2220
  269. c write(IOIMP,*) 'PB OPERATEUR GRAD :'
  270. write(IOIMP,991) ICOMP,IENR,INI,KDIM
  271. 991 format(2X,'ABSENCE DANS LE CHPOINT DEPLACEMENT DE LA ',I3,
  272. $ 'ieme COMPOSANTE (enrichissement',I3,
  273. $ ', fonction',I3,', direction ',I3,
  274. $ ') NECESSAIRE POUR L UN DES NOEUDS SUIVANTS :')
  275. write(IOIMP,*)' noeuds :',(NUM(iou,J),iou=1,NBNN1)
  276. goto 2220
  277. endif
  278.  
  279. C---------->> BOUCLE SUR LES NOEUDS
  280. N1PTEL = VELCHE(/1)
  281. N1EL = VELCHE(/2)
  282. DO I=1,NBNN1
  283. IQ = ((INITOT-1)*NBNN1*IDIM) + ((I-1)*IDIM) + KDIM
  284. IF (N1PTEL.EQ.1 .AND. N1EL.EQ.1)THEN
  285. C Cas du champ constant sur tout le MAILLAGE support
  286. XDDL(IQ) = VELCHE(1,1)
  287. ELSEIF(N1PTEL.EQ.1) THEN
  288. C Cas du champ constant par element
  289. XDDL(IQ) = VELCHE(1,J)
  290. ELSE
  291. C Cas du champ variable sur les noeuds et les elements
  292. XDDL(IQ) = VELCHE(I,J)
  293. ENDIF
  294. ENDDO
  295.  
  296. 2220 CONTINUE
  297. ENDDO
  298. ENDDO
  299.  
  300. c --cas normal (toutes les composantes souhaitees etaient presentes)--
  301. GOTO 2223
  302.  
  303. c --cas ou on n'a pas trouvé assez de composantes--
  304. 2221 CONTINUE
  305. if (IIMPI.ge.1) then
  306. WRITE(IOIMP,2222) J,NCOSOU,NCOMP
  307. 2222 FORMAT('OPERATEUR GRAD : ELEMENT ',I6,
  308. & ' LE CHAMP DE DEPLACEMENT CONTIENT ',I3,' COMPOSANTES',
  309. & ' PAR NOEUD AU LIEU DE ',I3,' ATTENDUES')
  310. endif
  311. NDDL=NCOSOU*NBNN1
  312. NBENRJ=IENR
  313.  
  314. 2223 CONTINUE
  315. c --cas ou on a une ou des erreurs--
  316. IF (NBERR1.gt.0.and.J.eq.NBEL1) THEN
  317. write(IOIMP,*) 'OPERATEUR GRAD : ABSENCE DANS LE CHPOINT ',
  318. & 'DEPLACEMENT DE CERTAINES INCONNUES ATTENDUES PAR LE MODELE'
  319. ENDIF
  320.  
  321. c
  322. c
  323. c rem: il serait probablement interessant au niveau du tems cpu
  324. c d'utiliser moins de pts de Gauss lorsque l element est élastique
  325. c On pourrait par ex. utiliser MINT2 = infell(12) qui contient
  326. c le segment d'integration de l'EF std (QUA4 par ex.)
  327. * if((NBENRJ.eq.0).and.(MINT2.ne.0)) then
  328. * MINTE = MINT2
  329. * NBPGAU= NGAU2
  330. * else
  331. MINTE = MINT1
  332. NBPGAU= NGAU1
  333. * endif
  334. c
  335. C
  336. C*********************************************************
  337. C
  338. C>>>>>>>>>> BOUCLE SUR LES POINTS DE GAUSS
  339. C
  340. DO 2500 KGAU=1,NBPGAU
  341. C
  342. C*********************************************************
  343. C Initialisation à 0
  344. C*********************************************************
  345.  
  346. c ZERO ne serait-il pas facultatif?
  347. CALL ZERO(SHPWRK,6,NBNO)
  348. XGAU = 0.D0
  349. YGAU = 0.D0
  350. ZGAU = 0.D0
  351. C
  352. i6zz = 3
  353. IF(IDIM.EQ.3) i6zz = 4
  354. C
  355. do ienr7=1,NBENRJ
  356. do inod7=1,NBNN1
  357. do i6=1,i6zz
  358. LV7WRK(ienr7,1,i6,inod7) = 0.D0
  359. LV7WRK(ienr7,2,i6,inod7) = 0.D0
  360. enddo
  361. enddo
  362. enddo
  363.  
  364.  
  365. c*********************************************************
  366. c Calcul des fonction de forme std dans repere local
  367. c*********************************************************
  368.  
  369. ccccc BOUCLE SUR LES NOEUDS ccccccccccccccccccccccccccccc
  370. c (et donc sur les Ni std)
  371. DO 2510 I=1,NBNN1
  372.  
  373. C++++ Calcul des Ni std
  374. c (rappel: 1:Ni 2:Ni,qsi 3:Ni,eta avec i=1,4)
  375. SHPWRK(1,I) = SHPTOT(1,I,KGAU)
  376. SHPWRK(2,I) = SHPTOT(2,I,KGAU)
  377. SHPWRK(3,I) = SHPTOT(3,I,KGAU)
  378. IF(IDIM.EQ.3) SHPWRK(4,I) = SHPTOT(4,I,KGAU)
  379.  
  380. C++++ Calcul des coordonnees dans le repere global
  381. XGAU = XGAU + (SHPWRK(1,I)*XE(1,I))
  382. YGAU = YGAU + (SHPWRK(1,I)*XE(2,I))
  383. IF(IDIM.EQ.3) ZGAU = ZGAU + (SHPWRK(1,I)*XE(3,I))
  384.  
  385. 2510 CONTINUE
  386. ccccc fin de BOUCLE SUR LES NOEUDS ccccccccccccccccccccccc
  387. c if(J.eq.77) write(6,*) 'xgau_',KGAU,' =',XGAU,YGAU,ZGAU
  388.  
  389.  
  390.  
  391. c*********************************************************
  392. c Passage des fonctions de forme std dans repere global
  393. c*********************************************************
  394.  
  395. C++++ CALCUL DES Ni,x Ni,y (i=1,4) + CALCUL DE det(J)
  396. CALL JACOBI(XE,SHPWRK,IDIM,NBNN1,DJAC)
  397. c if(J.eq.1.and.KGAU.eq.1)
  398. c & write(*,*) 'Ni(i=1,4)=',(SHPWRK(1,iou),iou=1,NBNN1)
  399.  
  400. c*********************************************************
  401. c Si on est pas du tout enrichi on peut sauter une grosse partie
  402. c*********************************************************
  403. if(NBENRJ.eq.0) goto 2999
  404.  
  405. c*********************************************************
  406. c Calcul des level set + leurs derivees dans repere global
  407. c*********************************************************
  408.  
  409. ccccc BOUCLE SUR LES enrichissements ccccccccccccccccccc
  410. do 2520 ienr=1,NBENRJ
  411.  
  412. c MELVA1=MCHAM1.IELVAL(IENR)
  413. c segact,MELVA1
  414.  
  415. ccccc BOUCLE SUR LES NOEUDS ccccccccccccccccccccccccccc
  416. DO 2521 I=1,NBNN1
  417.  
  418. C++++ Le I eme noeud est-il ienr-enrichi?
  419. mlree1= TLREEL(IENR,I)
  420. c if(J.eq.77) write(6,*) 'ienr,I',ienr,I,' mlree1=',mlree1
  421. if(mlree1.eq.0) goto 2521
  422.  
  423.  
  424. c Calcul du repere local de fissure(=PSI,PHI)
  425. c (rappel: 1,1:psi 1,2:phi 2,1 psi,x ...etc...)
  426. do 2522 inode=1,NBNN1
  427. c pour le H-enrichissement, on n a pas gardé PSI (inutile)
  428. if (ienr.ne.1) then
  429. c valeur de PSI au inode^ieme noeud
  430. xpsi1 = mlree1.PROG(inode)
  431. c qu on multiplie par la valeur de Ni^std au pt de G considéré
  432. LV7WRK(ienr,1,1,I)= LV7WRK(ienr,1,1,I)
  433. & + (SHPWRK(1,inode)*xpsi1)
  434. LV7WRK(ienr,1,2,I)= LV7WRK(ienr,1,2,I)
  435. & + (SHPWRK(2,inode)*xpsi1)
  436. LV7WRK(ienr,1,3,I)= LV7WRK(ienr,1,3,I)
  437. & + (SHPWRK(3,inode)*xpsi1)
  438. IF(IDIM.EQ.3) LV7WRK(ienr,1,4,I)= LV7WRK(ienr,1,4,I)
  439. & + (SHPWRK(4,inode)*xpsi1)
  440. c valeur de PHI au inode^ieme noeud
  441. xphi1 = mlree1.PROG(NBNN1+inode)
  442. else
  443. xphi1 = mlree1.PROG(inode)
  444. endif
  445. LV7WRK(ienr,2,1,I)= LV7WRK(ienr,2,1,I)
  446. & + (SHPWRK(1,inode)*xphi1)
  447. LV7WRK(ienr,2,2,I)= LV7WRK(ienr,2,2,I)
  448. & + (SHPWRK(2,inode)*xphi1)
  449. LV7WRK(ienr,2,3,I)= LV7WRK(ienr,2,3,I)
  450. & + (SHPWRK(3,inode)*xphi1)
  451. IF(IDIM.EQ.3) LV7WRK(ienr,2,4,I)= LV7WRK(ienr,2,4,I)
  452. & + (SHPWRK(4,inode)*xphi1)
  453. 2522 continue
  454.  
  455. 2521 continue
  456. ccccc fin de BOUCLE SUR LES NOEUDS ccccccccccccccccccccccc
  457.  
  458.  
  459. 2520 CONTINUE
  460. ccccc fin de BOUCLE SUR LES enrichissements cccccccccccccccc
  461.  
  462. c on a construit
  463. C LV7WRK(ienr, PSI/PHI, valeur/deriveeparqsi/pareta, iNOEUD)
  464.  
  465.  
  466. c*********************************************************
  467. c Ajout des fonctions de forme d enrichissement
  468. c + leurs derivees dans repere global
  469. c*********************************************************
  470. CALL SHAPX(XGAU,YGAU,ZGAU,MELE,LV7WRK,NBENRMAX,NBENRJ,
  471. &TLREEL,J,SHPWRK,IRET)
  472. c if(J.eq.77) write(6,*) 'retour de shapx'
  473.  
  474.  
  475.  
  476. c retour a la partie commune aux EF enrichi et non enrichi
  477. 2999 continue
  478.  
  479. C*********************************************************
  480. C CALCUL DE BGR
  481. C*********************************************************
  482. c ZERO ne serait-il pas facultatif?
  483. call ZERO(BGR,9,NDDL)
  484. KB=1
  485. C boucle sur tous les Ni
  486. DO 3001 II=1,NBNI
  487.  
  488. c partie commune 2D 3D
  489. BGR(1,KB) = SHPWRK(2,II)
  490. BGR(2,KB) = SHPWRK(3,II)
  491. BGR(4,KB+1) = SHPWRK(2,II)
  492. BGR(5,KB+1) = SHPWRK(3,II)
  493.  
  494. c cas 3D
  495. IF (IDIM.EQ.3) THEN
  496. BGR(3,KB) = SHPWRK(4,II)
  497. BGR(6,KB+1) = SHPWRK(4,II)
  498. BGR(7,KB+2) = SHPWRK(2,II)
  499. BGR(8,KB+2) = SHPWRK(3,II)
  500. BGR(9,KB+2) = SHPWRK(4,II)
  501. ENDIF
  502.  
  503. c cas 2D PLAN GENE
  504. IF (IFOUR.EQ.-3) THEN
  505. IREF=(IIPDPG-1)*(IDIM+1)
  506. BGR(9,KB) = 1.D0
  507. BGR(9,KB+1) = XCOOR(IREF+1)-XGAU
  508. BGR(9,KB+2) = YGAU-XCOOR(IREF+2)
  509. ENDIF
  510.  
  511. KB = KB + IDIM
  512.  
  513. 3001 CONTINUE
  514. C
  515. c
  516.  
  517. C*********************************************************
  518. C CALCUL DE BGR.q
  519. C*********************************************************
  520.  
  521. C APPEL A LA PROCEDURE DE CALCUL
  522. CALL BGRDEP(BGR,NGRA,XDDL,NDDL,GRADI)
  523. c
  524.  
  525. C*********************************************************
  526. C ECRITURE DES DIFFERENTES COMPOSANTES DU GRADIENT
  527. C*********************************************************
  528. MPTVAL=IVAGRA
  529. DO i=1,NGRA
  530. MELVAL=IVAL(i)
  531. IGMN=MIN(KGAU,VELCHE(/1))
  532. IBMN=MIN(J,VELCHE(/2))
  533. VELCHE(IGMN,IBMN)=GRADI(i)
  534. ENDDO
  535. c
  536. c
  537. 2500 CONTINUE
  538. C FIN DE BOUCLE SUR LES POINTS DE GAUSS <<<<<<<<<<<<<<
  539. C
  540. c
  541. c quelques desactivations
  542. do IENR=1,NBENR1
  543. do I=1,NBNN1
  544. mlree1 = TLREEL(IENR,I)
  545. if(mlree1.ne.0) segdes,mlree1
  546. enddo
  547. enddo
  548. c
  549. c
  550. c
  551. 2000 CONTINUE
  552. C FIN DE BOUCLE SUR LES ELEMENTS <<<<<<<<<<<<<<<<<<<<<
  553. c
  554. c
  555.  
  556. C*********************************************************
  557. C SUPPRESSION ET DESACTIVATION DE SEGMENTS
  558. C*********************************************************
  559. C
  560. SEGSUP,WRK1,WRK2
  561. SEGSUP,MRACC
  562.  
  563. c segdes,MINT1 fait dans grad1
  564. C if(MINT2.ne.0) segdes,MINT2
  565. c on met mint2 a zero pour eviter pb dans grad1
  566. MINT2 = 0
  567. c
  568. c pas de retour en erreur pour linstant
  569. IOK=1
  570. c write(6,*) 'iok=',IOK
  571. C
  572. RETURN
  573. END
  574.  
  575.  
  576.  
  577.  
  578.  
  579.  
  580.  

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