Télécharger oooadj.eso

Retour à la liste

Numérotation des lignes :

oooadj
  1. C OOOADJ SOURCE PV090527 26/05/05 21:15:07 12532
  2. SUBROUTINE OOOADJ (LRET,PSEG,IDI1,JDES,NTAB)
  3. C--------------------------------------------------------------------
  4. C
  5. C REALISER LA FONCTION : SEGADJ , PSEG
  6. C
  7. C PSEG POINTEUR SUR LE SEGMENT A AJUSTER (VOIR : ISEG=PSEG)
  8. C IDI1 TEL QUE : ISEG((IDI1-4)+1) = VALEUR DE LA PREMIERE
  9. C DIMENSION DU PREMIER TABLEAU DE PSEG .
  10. C JDES POUR LE I IEME TABLEAU DU SEGMENT , (I=1,NTAB) :
  11. C
  12. C TYPE=JDES(I) : TYPE DES ELEMENTS DU TABLEAU
  13. C SOUS LA FORME : TYLN*10000+NBBE
  14. C NBBE : NOMBRE DE BITS PAR ELEMENT DU TABLEAU
  15. C TYLN : (KTYP-1)*3+KLNI
  16. C
  17. C NBBM=JDES(NT+1) : NOMBRE DE BITS PAR MOT
  18. C
  19. C LDIM=JDES(NT+1+I) : INDICE DE LA DESCRIPTION
  20. C NDIM=JDES(NT+2+I)-LDIM-1 : NOMBRE DE DIMENSIONS
  21. C JDIM=2*NT+2+LDIM
  22. C NEWD=JDES(JDIM+K) : K IEME DIMENSION AJUSTEE
  23. C
  24. C POUR TOUT LES TABLEAUX SAUF LE PREMIER , JDES(JDIM)
  25. C PEUT ETRE UTILISE COMME MEMOIRE DE TRAVAIL PAR OOOADJ
  26. C
  27. C POUR LE PREMIER TABLEAU AAA , JDES(JDIM) CONTIENT
  28. C LE DEPLACEMENT IDO1 DE AAA PAR RAPPORT AU DEBUT DE
  29. C PSEG . TEL QUE SI XXX DU MEME TYPE QUE AAA MIS EN
  30. C EQUIVALENCE AVEC LE DEBUT DE PSEG :
  31. C XXX(IDO1+1) <=> AAA(1)
  32. C
  33. C KLNI
  34. C 1 2 3
  35. C ----------------------------------------------
  36. C I LOGICAL I LOGICAL*2 I LOGICAL*1 I 1
  37. C ----------------------------------------------
  38. C I INTEGER I INTEGER*2 I INTEGER*1 I 2
  39. C ----------------------------------------------
  40. C I REAL I REAL *8 I REAL *16 I 3 KTYP
  41. C ----------------------------------------------
  42. C I COMPLEX I COMPLEX*16 I COMPLEX*32 I 4
  43. C ----------------------------------------------
  44. C I CHARACTER I I I 5
  45. C ----------------------------------------------
  46. C
  47. C
  48. C-----------------------------------------------------------------------
  49. C
  50. C LA METHODE UTILISEE
  51. C
  52. C ON EFFECTUE DEUX PASSAGES SUR TOUT LES TABLEAUX DU SEGMENT
  53. C
  54. C PREMIER PASSAGE : EXAMEN DES TABLEAUX DANS L'ORDRE GAUCHE
  55. C DROITE A LA RECHERCHE DES REDUCTIONS DE
  56. C DIMENSION QU'ON EFFECTUE A MESURE .
  57. C REDUCTION EVENTUELLE DU SEGMENT (OOOXTR)
  58. C
  59. C DEUXIEME PASSAGE : EXTENSION EVENTUELLE DU SEGMENT (OOOXTN)
  60. C EXAMEN DES TABLEAUX DANS L'ORDRE DROITE
  61. C GAUCHE A LA RECHERCHE DES EXTENSIONS DE
  62. C DIMENSION QU'ON EFFECTUE A MESURE .
  63. C
  64. C MODIFICATION POUR UN TABLEAU
  65. C
  66. C SOIT TN UN TABLEAU FORTRAN A K INDICES DE DIMENSIONS
  67. C RESPECTIVES N1 , N2 , ... , NK POUR MODIFIER (REDUIRE
  68. C OU AUGMENTER) LA DIMENSION DU I IEME INDICE ET REALISER
  69. C L'IMPLANTATION MEMOIRE CORRESPONDANT A CETTE MODIFICATION
  70. C ON CONSIDERE LE TABLEAU FORTRAN EQUIVALENT A DEUX INDICES
  71. C TM(M1,M2) AVEC : M1 = N1*...*NI , M2 = (N1*...*NK)/M1
  72. C DANS LEQUEL ON MODIFIE LE PREMIER INDICE .
  73. C
  74. C SOIT MM LE NOUVEAU PREMIER INDICE :
  75. C
  76. C SI MM < M1
  77. C
  78. C DO J = 2 , M2
  79. C DO I = 1 , MM
  80. C TM(I+(J-1)*MM) = TM(I+(J-1)*M1)
  81. C
  82. C SI MM > M1
  83. C
  84. C DO J = M2 , 2 , -1
  85. C DO I = M1 , 1 , -1
  86. C TM(I+(J-1)*MM) = TM(I+(J-1)*M1)
  87. C
  88. C PROGRAMMEUR : MOUGIN
  89. C MODIF : 11/02/87 => ERREURS DANS DES CAS DE DIMENSIONS NULLES
  90. C MODIF : 27/01/89 INTRODUIRE DANS LA FAMILLE OOOW..
  91. C
  92. C-----------------------------------------------------------------------
  93. %INC IOOWCOM
  94. %INC IOOUNIT
  95. %INC IOOSGM
  96. %INC IOOADR
  97. %INC IOODES
  98. C-----------------------------------------------------------------------
  99. C
  100. C MACRO JSEG POUR EVITER DE PLANTER EN "CONTROL" SUR LE TABLEAUX
  101. C DE LONGUEUR NULLE
  102. C EXACTEMENT COMME ISEG, MAIS PAS DE TEST DE DEBORDEMENT
  103. C
  104. MACRO,JSEG(IP)
  105. JSEG=JSG(MDISG(ISEG)+IP+5)
  106. ENDMACRO
  107. C-----------------------------------------------------------------------
  108. C
  109. C EN PREALABLE AUX REDUCTIONS DE TABLEAUX
  110. C
  111. C ->NBBM NOMBRE DE BITS PAR MOT
  112. C ->JDES(JDIM) LES DEPLACEMENTS DES TABLEAUX APRES REDUCTION
  113. C ->KTAB L'INDICE DU PREMIER TABLEAU AYANT UNE REDUCTION
  114. C ->NMOT NOMBRE DE MOTS DU NOUVEAU SEGMENT
  115. C
  116. C NDIM NOMBRE DE DIMENSIONS DU TABLEAU
  117. C IDIM INDICE DANS ISEG DES DEPLACEMENT ET DIMENSIONS
  118. C JDIM INDICE DANS JDES DE LA DESCRIPTION DU TABLEAU
  119. C NBBE NOMBRE DE BITS PAR ELEMENT DU TABLEAU
  120. C NEL0 DEPLACEMENT INITIAL DU TABLEAU
  121. C NEL1 DEPLACEMENT DU TABLEAU
  122. C NELB NOMBRE D'ELEMENTS DU TABLEAU
  123. C NBIT NOMBRE DE BITS DU SEGMENT
  124. C
  125. C-----------------------------------------------------------------------
  126.  
  127. %IF UNIX32,WIN32
  128. C Pour eviter l'overflow sur nbit
  129. REAL*8 NBIT,NBBE
  130. %ENDIF
  131.  
  132. INTEGER TYLN , JDES(NTAB)
  133. LOGICAL LMODJ
  134. SEGMENT , ISEG(0)*I
  135. POINTEUR PSEG.ISEG
  136.  
  137. C LWAIT=.TRUE. duree dans ooowait seulement
  138. C LGLL =.TRUE. duree dans ooogll seulement
  139. INTEGER ITTIME(4)
  140. LOGICAL LGLL,LWAIT
  141. CHARACTER*(6) HDUREE
  142.  
  143. C Logique pour chronométrer l'attente
  144. LGLL =MZATTE .LT. 0 .AND. thread
  145. LWAIT =MZATTE .GT. 0
  146.  
  147. LRET=2
  148. igll=1
  149.  
  150. NBBM=JDES(NTAB+1)
  151. ISEG=PSEG
  152. KTAB=NTAB+1
  153. DO JTAB=1,NTAB
  154. LDIM=JDES(NTAB+1+JTAB)
  155. NDIM=JDES(NTAB+2+JTAB)-LDIM-1
  156. JDIM=LDIM+2*NTAB+2
  157. IDIM=LDIM+IDI1-5
  158. NBBE=MOD(JDES(JTAB),10000)
  159. IF (JTAB.EQ.1) THEN
  160. NEL1=JDES(JDIM)
  161. ELSE
  162. NEL0=JSEG(IDIM)
  163. NEL1=(NBIT+NBBE-1)/NBBE
  164. JDES(JDIM)=NEL1
  165. IF (NEL1.GT.NEL0) GO TO 901
  166. ENDIF
  167. NELB=1
  168. DO KDIM=1,NDIM
  169. IIII=JSEG(IDIM+KDIM)
  170. IF (IIII.LT. 0) GO TO 902
  171. JJJJ=JDES(JDIM+KDIM)
  172. IF (JJJJ.LT. 0) GO TO 903
  173. IF (JJJJ.LT.IIII) KTAB=MIN(KTAB,JTAB)
  174. NELB=NELB*MIN(JJJJ,IIII)
  175. ENDDO
  176. NBIT=(NEL1+NELB)*NBBE
  177. ENDDO
  178. NMOT=(NBIT+NBBM-1)/NBBM
  179. C-----------------------------------------------------------------------
  180. C
  181. C POUR CHACUN DES TABLEAUX , DE GAUCHE A DROITE
  182. C ON EFFECTUE TOUTES LES REDUCTIONS
  183. C
  184. IF (KTAB.LE.NTAB) THEN
  185. DO JTAB=KTAB,NTAB
  186.  
  187. C ->IDOA DEPLACEMENT DU TABLEAU AVANT DECALAGE GLOBAL
  188.  
  189. LDIM=JDES(NTAB+1+JTAB)
  190. NDIM=JDES(NTAB+2+JTAB)-LDIM-1
  191. IDIM=LDIM+IDI1-5
  192. JDIM=LDIM+2*NTAB+2
  193. IF (JTAB.EQ.1) THEN
  194. IDOA=JDES(JDIM)
  195. ELSE
  196. IDOA=JSEG(IDIM)
  197. ENDIF
  198.  
  199. C ->LMODJ VRAI SI AU MOINS UNE DES DIMENSIONS EST REDUITE
  200. C ->NELA LE NOMBRE D'ELEMENT DU TABLEAU DE DEPART
  201. C ->NELB LE NOMBRE D'ELEMENT DU TABLEAU REDUIT
  202.  
  203. LMODJ=.FALSE.
  204. NELA = 1
  205. NELB = 1
  206. DO KDIM=1,NDIM
  207. LMODJ= LMODJ .OR. (JSEG(IDIM+KDIM) .GT. JDES(JDIM+KDIM))
  208. NELA = NELA * JSEG(IDIM+KDIM)
  209. NELB = NELB * MIN(JSEG(IDIM+KDIM) , JDES(JDIM+KDIM))
  210. ENDDO
  211.  
  212. C DECALAGE GLOBAL A GAUCHE DU TABLEAU
  213. C MISE A JOUR DU DEPLACEMENT DANS LE SEGMENT
  214. C
  215. C TYLN TYPE DES ELEMENTS DU TABLEAU
  216. C NBBE NOMBRE DE BITS PAR ELEMENT DU TABLEAU
  217. C IDOZ CORRECTION AUX DEPLACEMENTS POUR TENIR COMPTE DES
  218. C DIMENSIONS DES SEGMENT D'ACCES (VOIR : OOOADG)
  219. C IDOB DEPLACEMENT DU TABLEAU APRES DECALAGE GLOBAL
  220.  
  221. TYLN= JDES(JTAB)/10000
  222. NBBE=MOD(JDES(JTAB),10000)
  223. IDOZ=MAX(1,INT(NBBM/NBBE))
  224. IDOB=JDES(JDIM)
  225. IDOO=IDOB-IDOZ
  226. IF (IDOB.LT.IDOA) THEN
  227. IF (NELB.GT.0) then
  228. if (thread .and. igll .eq. 1) call ooogll(0)
  229. igll=0
  230. endif
  231. CALL OOOADG (ISEG,TYLN,NELA,IDOO,IDOA-IDOZ)
  232. JSEG(IDIM)=IDOB
  233. ENDIF
  234.  
  235. C POUR CHACUNE DES DIMENSIONS DU TABLEAU
  236.  
  237. IF (LMODJ) THEN
  238. MM =1
  239. DO KDIM=1,NDIM
  240.  
  241. C ->M1 LA PREMIERE DIMENSION DU TABLEAU TM
  242. C ->MM LA PREMIERE DIMENSION DU TABLEAU TM AJUSTEE
  243.  
  244. IIII= JSEG(IDIM+KDIM)
  245. JJJJ=MIN(JDES(JDIM+KDIM),IIII)
  246. M1 =MM*IIII
  247. MM =MM*JJJJ
  248. IF (JJJJ.LT.IIII) THEN
  249.  
  250. C MISE A JOUR DE LA DIMENSION DANS LE SEGMENT
  251.  
  252. JSEG(IDIM+KDIM)=JJJJ
  253. IF (NELB.GT.0) THEN
  254.  
  255. C ->M2 LA DEUXIEME DIMENSION DU TABLEAU TM
  256. C ->NELA DIMENSION TOTALE DU TABLEAU TM AJUSTEE
  257.  
  258. M2 =NELA/M1
  259. NELA=MM*M2
  260.  
  261. C DECALAGE A GAUCHE DU TABLEAU
  262.  
  263. IF (M2.GT.1.and.mm.gt.0) THEN
  264. if (thread .and. igll .eq. 1) call ooogll(0)
  265. igll=0
  266. DO J=2,M2
  267. CALL OOOADG (ISEG,TYLN,MM,IDOO+(J-1)*MM,IDOO+(J-1)*M1)
  268. ENDDO
  269. ENDIF
  270. ENDIF
  271. ENDIF
  272. ENDDO
  273. ENDIF
  274. ENDDO
  275.  
  276. C EFFECTUER LA REDUCTION DE TAILLE DU SEGMENT
  277. C Mesure du TEMPS
  278. if (LGLL) CALL oootps(ITTIME,nth)
  279. if (thread .and. igll .eq. 0) then
  280. call ooogll(1)
  281. igll=1
  282. endif
  283. if (LGLL) then
  284. C Mesure de l'attente
  285. ITPS0=ITTIME(1)+ITTIME(2)
  286. CALL oootps(ITTIME,nth)
  287. IELAPS=ITTIME(1)+ITTIME(2)-ITPS0
  288. IF(IELAPS .ge. ABS(MZATTE))THEN
  289. WRITE(HDUREE,'(i6)') IELAPS
  290. CALL OOOMES(PSEG,'GEMAT ATTEND'//HDUREE)
  291. ENDIF
  292. endif
  293. NMOTR=((NMOT+(MSLSM-1))/MSLSM)*MSLSM
  294. CALL OOOXTR (ISEG,NMOTR)
  295.  
  296. ENDIF
  297. C-----------------------------------------------------------------------
  298. C
  299. C EN PREALABLE AUX EXTENTIONS DE TABLEAUX
  300. C
  301. C ->JDES(JDIM) LES DEPLACEMENTS DES TABLEAUX APRES EXTENSION
  302. C ->KTAB L'INDICE DU PREMIER TABLEAU AYANT UNE EXTENSION
  303. C ->NMOT NOMBRE DE MOTS DU NOUVEAU SEGMENT
  304.  
  305. KTAB=NTAB+1
  306. DO JTAB=1,NTAB
  307. LDIM=JDES(NTAB+1+JTAB)
  308. NDIM=JDES(NTAB+2+JTAB)-LDIM-1
  309. JDIM=LDIM+2*NTAB+2
  310. IDIM=LDIM+IDI1-5
  311. NBBE=MOD(JDES(JTAB),10000)
  312. IF (JTAB.EQ.1) THEN
  313. NEL1=JDES(JDIM)
  314. ELSE
  315. NEL1=(NBIT+NBBE-1)/NBBE
  316. JDES(JDIM)=NEL1
  317. ENDIF
  318. NELB=1
  319. DO KDIM=1,NDIM
  320. IIII=JSEG(IDIM+KDIM)
  321. JJJJ=JDES(JDIM+KDIM)
  322. IF (JJJJ.GT.IIII) KTAB=MIN(KTAB,JTAB)
  323. NELB=NELB*JJJJ
  324. ENDDO
  325. NBIT=(NEL1+NELB)*NBBE
  326. ENDDO
  327. NMOT=(NBIT+NBBM-1)/NBBM
  328. C-----------------------------------------------------------------------
  329. C
  330. C POUR CHACUN DES TABLEAUX , DE DROITE A GAUCHE
  331. C ON EFFECTUE TOUTES LES EXTENSIONS
  332. C
  333.  
  334. IF (KTAB.LE.NTAB) THEN
  335.  
  336. C EFFECTUER L'EXTENSION DE TAILLE DU SEGMENT
  337. LSG1 = MSLS1(MDISG(ISEG))
  338. LSG2 = (((NMOT+MSLCZ)+(MSLSM-1))/MSLSM)*MSLSM
  339. IF (LSG2.GT.LSG1) THEN
  340. C Mesure du TEMPS
  341. if (LGLL) CALL oootps(ITTIME,nth)
  342. if (thread .and. igll .eq. 0) then
  343. call ooogll(1)
  344. igll=1
  345. endif
  346. if (LGLL) then
  347. C Mesure de l'attente
  348. ITPS0=ITTIME(1)+ITTIME(2)
  349. CALL oootps(ITTIME,nth)
  350. IELAPS=ITTIME(1)+ITTIME(2)-ITPS0
  351. IF(IELAPS .ge. ABS(MZATTE))THEN
  352. WRITE(HDUREE,'(i6)') IELAPS
  353. CALL OOOMES(PSEG,'GEMAT ATTEND'//HDUREE)
  354. ENDIF
  355. endif
  356.  
  357. NMOT1=NMOT+NMOT/10+MSLSM
  358. NMOTR=((NMOT1+(MSLSM-1))/MSLSM)*MSLSM
  359. CALL OOOEXT (LRET,ISEG,NMOTR)
  360. if (thread .and. igll .eq. 1) call ooogll(0)
  361. igll=0
  362. IF (LRET.EQ.1) RETURN
  363. ENDIF
  364. if (thread .and. igll .eq. 1) call ooogll(0)
  365. igll=0
  366.  
  367. DO JTAB=NTAB,KTAB,-1
  368.  
  369. C ->IDOA DEPLACEMENT DU TABLEAU AVANT DECALAGE GLOBAL
  370.  
  371. LDIM=JDES(NTAB+1+JTAB)
  372. NDIM=JDES(NTAB+2+JTAB)-LDIM-1
  373. IDIM=LDIM+IDI1-5
  374. JDIM=LDIM+2*NTAB+2
  375. IF (JTAB.EQ.1) THEN
  376. IDOA=JDES(JDIM)
  377. ELSE
  378. IDOA=JSEG(IDIM)
  379. ENDIF
  380.  
  381. C ->LMODJ VRAI SI AU MOINS UNE DES DIMENSIONS EST AUGMENTEE
  382. C ->NELA LE NOMBRE D'ELEMENT DU TABLEAU DE DEPART
  383. C ->NELB LE NOMBRE D'ELEMENT DU TABLEAU ETENDU
  384.  
  385. LMODJ = .FALSE.
  386. NELA = 1
  387. NELB = 1
  388. DO KDIM=1,NDIM
  389. LMODJ = LMODJ .OR. (JSEG(IDIM+KDIM) .LT. JDES(JDIM+KDIM))
  390. NELA = NELA * JSEG(IDIM+KDIM)
  391. NELB = NELB * JDES(JDIM+KDIM)
  392. ENDDO
  393.  
  394. C DECALAGE GLOBAL A DROITE DU TABLEAU
  395. C MISE A JOUR DU DEPLACEMENT DANS LE SEGMENT
  396. C
  397. C TYLN TYPE DES ELEMENTS DU TABLEAU
  398. C NBBE NOMBRE DE BITS PAR ELEMENT DU TABLEAU
  399. C IDOZ CORRECTION AUX DEPLACEMENTS POUR TENIR COMPTE DES
  400. C DIMENSIONS DES SEGMENT D'ACCES (VOIR : OOOADD)
  401. C IDOB DEPLACEMENT DU TABLEAU APRES DECALAGE GLOBAL
  402. C
  403. C IDOO IDOB-IDOZ
  404.  
  405. TYLN= JDES(JTAB)/10000
  406. NBBE=MOD(JDES(JTAB),10000)
  407. IDOZ=MAX(1,INT(NBBM/NBBE))
  408. IDOB=JDES(JDIM)
  409. IDOO=IDOB-IDOZ
  410. IF (IDOB.GT.IDOA) THEN
  411.  
  412.  
  413. IF (NELA.GT.0) CALL OOOADD (ISEG,TYLN,NELA,IDOO,IDOA-IDOZ)
  414. JSEG(IDIM)=IDOB
  415. ENDIF
  416.  
  417. C POUR CHACUNE DES DIMENSIONS DU TABLEAU
  418.  
  419. IF (NELB.GT.NELA) THEN
  420. CALL OOOADZ (ISEG,TYLN,NELB-NELA,IDOO+NELA)
  421. ENDIF
  422. IF (LMODJ) THEN
  423. MM =1
  424. DO KDIM=1,NDIM
  425.  
  426. C ->M1 LA PREMIERE DIMENSION DU TABLEAU TM
  427. C ->MM LA PREMIERE DIMENSION DU TABLEAU TM AJUSTEE
  428.  
  429. IIII=JSEG(IDIM+KDIM)
  430. JJJJ=JDES(JDIM+KDIM)
  431. M1 =MM*IIII
  432. MM =MM*JJJJ
  433. IF (JJJJ.GT.IIII) THEN
  434.  
  435. C MISE A JOUR DE LA DIMENSION DANS LE SEGMENT
  436.  
  437. JSEG(IDIM+KDIM)=JJJJ
  438.  
  439. C ->M2 LA DEUXIEME DIMENSION DU TABLEAU TM
  440. C ->NELA DIMENSION TOTALE DU TABLEAU TM AJUSTEE
  441.  
  442. IF (NELA.GT.0) THEN
  443. M2 =NELA/M1
  444. NELA=MM*M2
  445.  
  446. C DECALAGE A DROITE DU TABLEAU
  447.  
  448. IF (M2.GT.1) THEN
  449. DO J=M2,2,-1
  450. CALL OOOADD (ISEG,TYLN,M1,IDOO+(J-1)*MM,IDOO+(J-1)*M1)
  451. CALL OOOADZ (ISEG,TYLN,MM-M1,IDOO+(J-1)*MM+M1)
  452. ENDDO
  453. ENDIF
  454. CALL OOOADZ (ISEG,TYLN,MM-M1,IDOO +M1)
  455. ENDIF
  456. ENDIF
  457. ENDDO
  458. ENDIF
  459. ENDDO
  460. ELSE
  461. if (thread .and. igll .eq. 1) call ooogll(0)
  462. igll=0
  463. ENDIF
  464.  
  465. RETURN
  466. C-----------------------------------------------------------------------
  467. C
  468. C MESSAGES D'ERREUR
  469. C
  470. 901 CALL OOOERR (NEL0,1,'DEPLACEMENT DETRUIT DANS LE SEGMENT')
  471. GO TO 950
  472. 902 CALL OOOERR (IIII,1,'DIMENSION NEGATIVE DANS LE SEGMENT')
  473. GO TO 950
  474. 903 CALL OOOERR (JJJJ,1,'DIMENSION NEGATIVE DEMANDEE')
  475. GO TO 950
  476. 950 STOP 16
  477. END
  478.  
  479.  
  480.  

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