Télécharger ipgril.eso

Retour à la liste

Numérotation des lignes :

  1. C IPGRIL SOURCE CB215821 16/09/20 21:15:02 9097
  2. C-----------------------------------------------------------------------
  3. C NOM : IPGRIL
  4. C DESCRIPTION : Interpolation dans un NUAGE represantant une grille
  5. C de valeurs
  6. C LANGAGE : ESOPE
  7. C AUTEUR : Francois DI PAOLA
  8. C-----------------------------------------------------------------------
  9. C APPELE PAR : IPLNU1
  10. C APPELE : IPMULI
  11. C-----------------------------------------------------------------------
  12. C ENTREES : INUA (Objet de type NUAGE)
  13. C SORTIES :
  14. C Lit un CHPOINT ou un MCHAML dans la pile puis ecrit un objet du meme
  15. C type en retour
  16. C-----------------------------------------------------------------------
  17. C VERSION : v1, 02/10/2015, version initiale
  18. C HISTORIQUE : v1, 02/10/2015, creation
  19. C HISTORIQUE :
  20. C HISTORIQUE :
  21. C-----------------------------------------------------------------------
  22. C Priere de PRENDRE LE TEMPS de completer les commentaires
  23. C en cas de modification de ce sous-programme afin de faciliter
  24. C la maintenance !
  25. C-----------------------------------------------------------------------
  26. C REMARQUES : - L'interpolation est exacte, c'est-a-dire que l'on
  27. C retrouve les valeurs de la grille si l'on interpole en
  28. C un noeud de la grille
  29. C - La grille peut contenir autant de dimensions que
  30. C souhaitees
  31. C - Pour le moment, seule l'interpolation multi-lineaire est
  32. C disponible
  33. C - Une interpolation par splines cubiques est possible sur
  34. C la meme base (a faire plus tard ...)
  35. C-----------------------------------------------------------------------
  36. C
  37. SUBROUTINE IPGRIL(INUA)
  38. C
  39. IMPLICIT INTEGER(I-N)
  40. IMPLICIT REAL*8 (A-H,O-Z)
  41. -INC CCNOYAU
  42. -INC CCOPTIO
  43. -INC SMNUAGE
  44. -INC SMCHPOI
  45. -INC SMCHAML
  46. -INC SMLREEL
  47. -INC SMLENTI
  48. -INC SMLMOTS
  49. -INC CCASSIS
  50. CHARACTER*8 MOT1,MOT2
  51. LOGICAL BTHRD
  52. C
  53. C Introduction d'un COMMON pour la parallelisation
  54. C Il est a repercuter aussi dans les sources suivantes :
  55. C - ipmuli.eso
  56. COMMON/IPLMUC/NBTHR,N,NDIM,
  57. & MLENT1,MLENT2,
  58. & ICHPOI,MPOVA1,MPOVA2,
  59. & IMCHAM,MCHAM1,MELVA2,N1EL,N1PTEL
  60.  
  61. EXTERNAL IPMULI
  62.  
  63. C
  64. C Pour la paralelisation de l'interpolation
  65. C
  66. NBTHR=NBTHRS
  67. N=0
  68. NDIM=0
  69. N1EL=0
  70. N1PTEL=0
  71. ICHPOI=0
  72. IMCHAM=0
  73. BTHRD = .FALSE.
  74. C
  75. C
  76. C Depouillement du nuage pour connaitre le nombre de dimensions de
  77. C la grille
  78. MNUAG1=INUA
  79. SEGACT,MNUAG1
  80. NNU=MNUAG1.NUAPOI(/1)
  81. NDIM=NNU-1
  82. IF (NDIM.LT.1) THEN
  83. INTERR(1)=MNUAG1
  84. INTERR(2)=2
  85. INTERR(3)=1
  86. CALL ERREUR(628)
  87. RETURN
  88. ENDIF
  89. C
  90. C Initialisation d'une liste de mots pour stocker les noms des
  91. C dimensions de la grille
  92. JGN=4
  93. JGM=NNU
  94. SEGINI,MLMOT1
  95. C
  96. C Iniilisation d'une liste d'entiers pour stocker les pointeurs vers
  97. C les LISTREEL definissant la grille de valeur de la fonction F
  98. JG=NNU
  99. SEGINI,MLENT1
  100. C
  101. C Parcours du NUAGE pour verifications
  102. NVAL=1
  103. DO I=1,NNU
  104. C Nom de la composante I
  105. MOT1=MNUAG1.NUANOM(I)
  106. C Et rangement du mot dans la liste de mots adhoc
  107. MLMOT1.MOTS(I)=MOT1
  108. C Les composantes doivent abriter 1 seul objet de type LISTREEL
  109. MOT2=MNUAG1.NUATYP(I)
  110. IF (MOT2.NE.'LISTREEL') THEN
  111. CALL ERREUR(941)
  112. RETURN
  113. ENDIF
  114. NUAVI1=MNUAG1.NUAPOI(I)
  115. SEGACT,NUAVI1
  116. NPO=NUAVI1.NUAINT(/1)
  117. IF (NPO.NE.1) THEN
  118. CALL ERREUR(941)
  119. RETURN
  120. ENDIF
  121. MLREE1=NUAVI1.NUAINT(1)
  122. SEGDES,NUAVI1
  123. C Verification de la taille de la derniere liste
  124. SEGACT,MLREE1
  125. IF (I.EQ.NNU) THEN
  126. NTEST=MLREE1.PROG(/1)
  127. IF (NTEST.NE.NVAL) THEN
  128. CALL ERREUR(21)
  129. RETURN
  130. ENDIF
  131. ELSE
  132. NVAL=NVAL*(MLREE1.PROG(/1))
  133. ENDIF
  134. C Et rangement du pointeur dans la liste d'entiers adhoc
  135. MLENT1.LECT(I)=MLREE1
  136. ENDDO
  137. SEGDES,MNUAG1
  138. C
  139. C Acquisition d'un CHPOINT ou d'un MCHAML en entree (MCHPO1/MCHEL1)
  140. ICH=1
  141. CALL LIROBJ('CHPOINT',MCHPO1,0,IRETOU)
  142. IF (IRETOU.EQ.1) THEN
  143. SEGACT,MCHPO1
  144. ELSE
  145. CALL LIROBJ('MCHAML',MCHEL1,0,IRETOU)
  146. IF (IRETOU.EQ.1) THEN
  147. ICH=2
  148. SEGACT,MCHEL1
  149. ELSE
  150. CALL ERREUR(686)
  151. RETURN
  152. ENDIF
  153. ENDIF
  154. C
  155. C ----------------
  156. C CAS D'UN CHPOINT
  157. C ----------------
  158. IF (ICH.EQ.1) THEN
  159. C Initialisation du champ de sortie (MCHPO2) sur la base de
  160. C celui d'entree, il possede les memes sous champs
  161. SEGINI,MCHPO2=MCHPO1
  162. MCHPO2.MOCHDE='CHPOINT interpole'
  163. C Boucle sur les sous champs (MSOUP1) du CHPOINT d'entree
  164. NBSOUS=MCHPO1.IPCHP(/1)
  165. DO I=1,NBSOUS
  166. MSOUP1=MCHPO1.IPCHP(I)
  167. SEGACT,MSOUP1
  168. NCOMP1=MSOUP1.NOCOMP(/2)
  169. C Verification que le CHPOINT contienne bien NDIM composantes
  170. IF (NCOMP1.NE.NDIM) THEN
  171. MOTERR(1:8)='CHPOINT '
  172. CALL ERREUR(980)
  173. RETURN
  174. ENDIF
  175. C Liste de correpondance entre les composantes du CHPOINT et les
  176. C noms des dimensions de la grille
  177. C MLENT2.LECT(i) = numero de la composante de MSOUP1
  178. C correspondante a la dimension i de la grille
  179. JG=NCOMP1
  180. SEGINI,MLENT2
  181. DO J=1,NCOMP1
  182. MOT1=MSOUP1.NOCOMP(J)
  183. JVAL1=0
  184. DO K=1,NDIM
  185. MOT2=MLMOT1.MOTS(K)
  186. IF (MOT1.EQ.MOT2) THEN
  187. JVAL1=K
  188. GOTO 1
  189. ENDIF
  190. ENDDO
  191. C Cas ou une composante du CHPOINT ne se retrouve pas dans les
  192. C noms des dimensions de la grille
  193. 1 IF (JVAL1.EQ.0) THEN
  194. CALL ERREUR(665)
  195. RETURN
  196. ENDIF
  197. MLENT2.LECT(JVAL1)=J
  198. ENDDO
  199. MPOVA1=MSOUP1.IPOVAL
  200. SEGACT,MPOVA1
  201. C Initialisation des sous champs de sortie (MSOUP2)
  202. C - ils sont definits sur les meme noeuds
  203. C - ils ne possedent qu'une seule composante
  204. NC=1
  205. SEGINI,MSOUP2
  206. MSOUP2.NOCOMP(1)=MLMOT1.MOTS(NDIM+1)
  207. MSOUP2.IGEOC=MSOUP1.IGEOC
  208. C On le range aussitot dans le CHPOINT global
  209. MCHPO2.IPCHP(I)=MSOUP2
  210. C Initialisation du tableau de valeurs (MPOVA2) du sous champ de
  211. C sortie
  212. N =MPOVA1.VPOCHA(/1)
  213. NC=1
  214. SEGINI,MPOVA2
  215. C Preparation pour le calcul en parallele
  216.  
  217. C Regalge fait sur PC40 pour determiner le nombre de NOEUDS optimum
  218. C par thread
  219. IOPTIM = 100
  220. N1 = N / IOPTIM
  221. IF ((N1.LE.1) .OR. (NBTHRS .EQ. 1)) THEN
  222. NBTHR = 1
  223. BTHRD = .FALSE.
  224. ELSE
  225. BTHRD = .TRUE.
  226. NBTHR = MIN(N1, NBTHRS)
  227. CALL THREADII
  228. ENDIF
  229.  
  230. ICHPOI=MPOVA1
  231. C Lancement des Threads
  232. IF ((nbthr.gt.1) .AND. BTHRD) THEN
  233. DO ITH=2,NBTHR
  234. CALL THREADID(ITH,IPMULI)
  235. ENDDO
  236. CALL IPMULI(1)
  237. DO ITH=2,NBTHR
  238. CALL THREADIF(ITH)
  239. ENDDO
  240. C En multithread il peut y avoir n'importe quoi dans oov(1) du
  241. C aux acces simultanes et ca crache gemat. donc :
  242. OOV(1)=0
  243. ELSE
  244. CALL IPMULI(1)
  245. ENDIF
  246. MSOUP2.IPOVAL=MPOVA2
  247. SEGDES,MSOUP1,MSOUP2,MPOVA1,MPOVA2
  248. SEGSUP,MLENT2
  249. ENDDO
  250. SEGDES,MCHPO1,MCHPO2
  251. SEGSUP,MLMOT1,MLENT1
  252. C Ecriture du CHPOINT de sortie dans la pile
  253. CALL ECROBJ('CHPOINT ',MCHPO2)
  254. C
  255. C ---------------
  256. C CAS D'UN MCHAML
  257. C ---------------
  258. ELSEIF(ICH.EQ.2) THEN
  259. C Initialisation du champ de sortie (MCHEL2) sur la base de
  260. C celui d'entree, il possede les memes sous zones
  261. SEGINI,MCHEL2=MCHEL1
  262. MCHEL2.TITCHE='MCHAML interpole'
  263. C Boucle sur les sous zones (MCHAM1) du MCHAML d'entree
  264. NBSOUS=MCHEL1.ICHAML(/1)
  265. DO I=1,NBSOUS
  266. MCHAM1=MCHEL1.ICHAML(I)
  267. SEGACT,MCHAM1
  268. C Initialisation des sous zones de sortie (MCHAM2)
  269. C - elles ne possedent qu'une seule composante de type
  270. C flottant
  271. N2=1
  272. SEGINI,MCHAM2
  273. MCHAM2.NOMCHE(1)=MLMOT1.MOTS(NDIM+1)
  274. MCHAM2.TYPCHE(1)='REAL*8'
  275. C On le range aussitot dans le MCHAML global
  276. MCHEL2.ICHAML(I)=MCHAM2
  277. C Verification que le MCHAML de cettre sous zone contienne bien
  278. C NDIM composantes
  279. NCOMP1=MCHAM1.NOMCHE(/2)
  280. IF (NCOMP1.NE.NDIM) THEN
  281. MOTERR(1:8)='MCHAML '
  282. CALL ERREUR(980)
  283. RETURN
  284. ENDIF
  285. C Activation des MELVA1 pour parallelisme
  286. DO J=1,NDIM
  287. MELVA1=MCHAM1.IELVAL(J)
  288. SEGACT,MELVA1
  289. ENDDO
  290. C Liste de correpondance entre les composantes du MCHAML et les
  291. C noms des dimensions de la grille
  292. C MLENT2.LECT(i) = numero de la composante de MCHAM1
  293. C correspondante a la dimension i de la grille
  294. JG=NCOMP1
  295. SEGINI,MLENT2
  296. N1PTEL=0
  297. N1EL=0
  298. N2PTEL=0
  299. N2EL=0
  300. DO J=1,NCOMP1
  301. MOT1=MCHAM1.NOMCHE(J)
  302. JVAL1=0
  303. DO K=1,NDIM
  304. MOT2=MLMOT1.MOTS(K)
  305. IF (MOT1.EQ.MOT2) THEN
  306. JVAL1=K
  307. GOTO 2
  308. ENDIF
  309. ENDDO
  310. C Cas ou une composante du MCHAML ne se retrouve pas dans les
  311. C noms des dimensions de la grille
  312. 2 IF (JVAL1.EQ.0) THEN
  313. CALL ERREUR(665)
  314. RETURN
  315. ENDIF
  316. MLENT2.LECT(JVAL1)=J
  317. C Verification que le champ contient des flottants,
  318. IF (MCHAM1.TYPCHE(J).NE.'REAL*8') THEN
  319. MOTERR(1:16) = MCHAM1.TYPCHE(J)
  320. MOTERR(17:20) = MOT1(1:4)
  321. MOTERR(21:29) = 'argument'
  322. CALL ERREUR(552)
  323. RETURN
  324. ENDIF
  325. C Recherche des tailles MAX des MELVAL de chaque composante de
  326. C cette sous zone (pour preparer le champ de sortie)
  327. MELVA1=MCHAM1.IELVAL(J)
  328. SEGACT,MELVA1
  329. N1PTEL=MAX(N1PTEL,MELVA1.VELCHE(/1))
  330. N1EL=MAX(N1EL,MELVA1.VELCHE(/2))
  331. ENDDO
  332. C Initialisation du tableau de valeurs (MELVA2) du sous champ
  333. C de sortie
  334. SEGINI,MELVA2
  335. C Preparation pour le calcul en parallele
  336. C Regalge fait sur PC40 pour determiner le nombre de NOEUDS optimum
  337. C par thread
  338. IOPTIM = 100
  339. N1 = N1EL / IOPTIM
  340. IF ((N1.LE.1) .OR. (NBTHRS .EQ. 1)) THEN
  341. NBTHR = 1
  342. BTHRD = .FALSE.
  343. ELSE
  344. BTHRD = .TRUE.
  345. NBTHR = MIN(N1, NBTHRS)
  346. CALL THREADII
  347. ENDIF
  348.  
  349. N=0
  350. IMCHAM=MCHAM1
  351. C Lancement des Threads
  352. IF ((nbthr.gt.1) .AND. BTHRD) THEN
  353. DO ITH=2,NBTHR
  354. CALL THREADID(ITH,IPMULI)
  355. ENDDO
  356. CALL IPMULI(1)
  357. DO ITH=2,NBTHR
  358. CALL THREADIF(ITH)
  359. ENDDO
  360. C En multithread il peut y avoir n'importe quoi dans oov(1) du
  361. C aux acces simultanes et ca crache gemat. donc :
  362. OOV(1)=0
  363. ELSE
  364. CALL IPMULI(1)
  365. ENDIF
  366. MCHAM2.IELVAL(1)=MELVA2
  367. SEGDES,MCHAM1,MCHAM2,MELVA2
  368. C Desactivation des MELVA1 pour parallelisme
  369. DO J=1,NDIM
  370. MELVA1=MCHAM1.IELVAL(J)
  371. SEGACT,MELVA1
  372. ENDDO
  373. ENDDO
  374. SEGDES,MCHEL1,MCHEL2
  375. C Ecriture du MCHAML de sortie dans la pile
  376. CALL ECROBJ('MCHAML ',MCHEL2)
  377. ENDIF
  378. C Fin du programme
  379. IF (BTHRD) CALL THREADIS
  380. RETURN
  381. END
  382.  
  383.  
  384.  

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