Télécharger caavct.eso

Retour à la liste

Numérotation des lignes :

  1. C CAAVCT SOURCE PV 16/11/17 21:58:18 9180
  2. SUBROUTINE CAAVCT
  3. C************************************************************************
  4. C
  5. C MODIFICATIONS : IZDD -> IZD2 (chgt de diago)
  6. C TEST SUR MTABD
  7. C SIMPLIFICATION DES PARAMETRES DE PF500 (on passe
  8. C MTABD)
  9. C
  10. C************************************************************************
  11. C
  12. C .Rajout de commentaires et de nouveaux messages d'erreurs en utilisant
  13. C la routine ERREUR de K2000 : F.D Juillet 96
  14. C .Correction d'erreurs dans le cas des CHPO Centre : on teste le nom
  15. C des inconnues et on effectue le calcul pour toutes les composantes
  16. C des inconnues : P.G Aout 96
  17. C************************************************************************
  18. IMPLICIT INTEGER(I-N)
  19. IMPLICIT REAL*8 (A-H,O-Z)
  20. CHARACTER*8 NOMI,TYPE,TYPE1,NOM,NOMZ,TYPC,TYP0,TYPINC
  21. CHARACTER*8 NOMIX(10)
  22. CHARACTER*9 NOMI1
  23. CHARACTER*4 NOC,KOMP(4)
  24. C
  25. -INC CCOPTIO
  26. -INC SMLENTI
  27. POINTEUR IZIPAD.MLENTI,MLH.MLENTI
  28. -INC SMCHAML
  29. -INC SMCHPOI
  30. POINTEUR CLIM.MCHPOI
  31. POINTEUR IPHI.MPOVAL,IPHR.MPOVAL,IPHH.MPOVAL
  32. POINTEUR IZD.MCHPOI ,IZD0.MCHPOI ,IZG.MCHPOI ,IZGD.MCHPOI
  33. POINTEUR IZDD.MPOVAL,IZDD0.MPOVAL,IZGG.MPOVAL,IZGDD.MPOVAL
  34. POINTEUR IZD2.MPOVAL,IZSS.MPOVAL,IZS.MCHPOI,IZH.MCHPOI
  35. POINTEUR IZPHI.MCHPOI
  36. -INC SMLMOTS
  37. POINTEUR MINCOG.MLMOTS
  38. -INC SMELEME
  39. POINTEUR MAH.MELEME
  40. POINTEUR MELEMI.MELEME
  41. POINTEUR IGEOM0.MELEME
  42. -INC SMLREEL
  43. -INC SMEVOLL
  44. PARAMETER (NTB=1)
  45. DIMENSION KTAB(NTB)
  46. CHARACTER*8 LTAB(NTB)
  47. DATA KOMP/'UX ','UY ','UZ ','SCAL'/
  48. DATA LTAB /'EQEX '/
  49. C
  50. C- Lecture des tables transmises en arguments
  51. C ------------------------------------------
  52. CALL LITABS(LTAB,KTAB,NTB,1,IRET)
  53. IF (IRET.EQ.0)THEN
  54. WRITE(6,*)' Opérateur AVCT :'
  55. WRITE(6,*)' On attend un ensemble de table soustypes'
  56. RETURN
  57. ENDIF
  58. KIZC = KTAB(1)
  59. C
  60. C- Lecture facultative de la "cfl"
  61. C ------------------------------
  62. CALL LIRREE(ALFA,0,IRET)
  63. IF (IRET.EQ.0) ALFA=1.D0
  64. C
  65. C- Lecture facultative des paramètres pour les impressions de controle
  66. C -------------------------------------------------------------------
  67. CALL LIRCHA(NOM,0,IRET)
  68. IMPR = 0
  69. IF (IRET.EQ.0) THEN
  70. IMPR = 0
  71. ELSEIF (NOM.EQ.'IMPR ') THEN
  72. CALL LIRENT(IMPR,1,IRET)
  73. IF (IRET.EQ.0) RETURN
  74. ENDIF
  75. C
  76. C- Récuperation des pointeurs des tables INCO et EQEX !!
  77. C- BUG dans LITABS puisque EQEX etait facultatif --> à corriger
  78. C
  79. TYPE=' '
  80. CALL ACMO(KIZC,'INCO',TYPE,INCO)
  81. IF(IERR.NE.0) RETURN
  82.  
  83. C
  84. C- Récupération des noms d'inconnues
  85. C ---------------------------------
  86. TYPE = 'LISTMOTS'
  87. CALL ACMO(KIZC,'LISTINCO',TYPE,MLMOT2)
  88. IF (IERR.NE.0) RETURN
  89. SEGACT MLMOT2
  90. NBINC1 = MLMOT2.MOTS(/2)
  91. C
  92. C- Récupérations des pointeurs associés aux tables KIZD et KIZG
  93. C ------------------------------------------------------------
  94. C (contenant la matrice "masse" diagonale et l'"incrément".)
  95. C
  96. TYPE=' '
  97. CALL ACMO(KIZC,'KIZD ',TYPE,KIZD)
  98. TYPE=' '
  99. CALL ACMO(KIZC,'KIZK ',TYPE,KIZK)
  100. TYPE=' '
  101. CALL ACMO(KIZC,'KIZG ',TYPE,KIZG)
  102.  
  103. C
  104. C- Initialisation des données temporelles
  105. C --------------------------------------
  106. CALL ACMF(KIZC,'TFINAL',TFINAL)
  107.  
  108. TYPE=' '
  109. CALL ACMO(KIZC,'PASDETPS',TYPE,MTABT)
  110.  
  111. IF (MTABT.NE.0) THEN
  112. CALL ACMF(MTABT,'DELTAT',DT)
  113. IF (IERR.NE.0) RETURN
  114. CALL ACMF(MTABT,'TPS',TPS)
  115. IF (IERR.NE.0) RETURN
  116. CALL ACME(MTABT,'NUPASDT',IPT)
  117. IF (IERR.NE.0) RETURN
  118. ELSE
  119. DT = 1.D0
  120. TPS = 0.D0
  121. IPT = 1
  122. ENDIF
  123. DT = DT * ALFA
  124.  
  125. IFINAL=0
  126. TPS1 = TPS + DT
  127. C write(6,*)' TPS=',tps,' TFINAL=',tfinal,' DT=',dt
  128. IF(TPS.GT.TFINAL)THEN
  129. IFINAL=1
  130. GO TO 800
  131. ELSEIF(TPS1.GT.TFINAL)THEN
  132. DT=TFINAL-TPS
  133. IFINAL=1
  134. ENDIF
  135. TPS = TPS + DT
  136. C
  137. C- Récupération des pointeurs associés aux tables KIZG1 et KIZS
  138. C ------------------------------------------------------------
  139. C
  140. TYPE=' '
  141. CALL ACMO(KIZC,'KIZG1 ',TYPE,KIZG1)
  142. TYPE=' '
  143. CALL ACMO(KIZC,'KIZS ',TYPE,KIZS)
  144. C
  145. C==============================================================
  146. C Boucle principale : Traitement de chaque inconnue de LISTINCO
  147. C==============================================================
  148. C
  149. DO 1 L=1,NBINC1
  150. C
  151. C- NOMI est l'identifiant de l'inconnue dans chaque table
  152. C
  153. NOMI = MLMOT2.MOTS(L)
  154. C
  155. C- Activation du MPOVAL de l'inconnue au temps précédant
  156. C -----------------------------------------------------
  157. TYPE = 'CHPOINT '
  158. CALL ACMO(INCO,NOMI,TYPE,IZPHI)
  159. IF (IERR.NE.0) RETURN
  160. CALL LICHT(IZPHI,IPHI,TYP0,IGEOM0)
  161. NPT = IPHI.VPOCHA(/1)
  162. NC = IPHI.VPOCHA(/2)
  163. C
  164. C- Activation du terme source éventuel associé à l'inconnue NOMI
  165. C -------------------------------------------------------------
  166. IZSS = 0
  167. IGEOMS = 0
  168. IF (KIZS.NE.0) THEN
  169. TYPE = 'CHPOINT '
  170. CALL ACMO(KIZS,NOMI,TYPE,IZS)
  171. IF (IERR.NE.0) RETURN
  172. CALL LICHT(IZS,IZSS,TYP0,IGEOMS)
  173. IF (IGEOMS.NE.IGEOM0) THEN
  174. MOTERR(1: 8) = NOMI(1:4)//'KIZS'
  175. MOTERR(9:16) = NOMI(1:4)//'INCO'
  176. INTERR(1) = 1
  177. CALL ERREUR(698)
  178. RETURN
  179. ENDIF
  180. ENDIF
  181. C
  182. C- Identification du MPOVAL de l'inconnue au nouveau pas de temps
  183. C --------------------------------------------------------------
  184. C (pour écrasement éventuel des valeurs du pas précédant)
  185. C
  186. IPHR = IPHI
  187. C
  188. C- Correspondance entre numérotation globale et locale
  189. C ---------------------------------------------------
  190. CALL KRIPAD(IGEOM0,IZIPAD)
  191. SEGACT IGEOM0
  192. C
  193. C- Cas ou il y a des matrices masses non diagonales
  194. C ------------------------------------------------
  195. IF(KIZK.NE.0)THEN
  196. TYPE=' '
  197. MATRIK=KIZK
  198. SEGACT MATRIK
  199. NBK=IRIGEL(/2)
  200. DO 411 K=1,NBK
  201.  
  202. IMATRI=IRIGEL(4,K)
  203. SEGACT IMATRI
  204. NBME=LISPRI(/2)
  205. WRITE(6,*)' INCO : ',(LISPRI(ii),ii=1,nbme)
  206. 411 CONTINUE
  207. ENDIF
  208. C
  209. C- Cas où les tables KIZD et KIZG sont données
  210. C -------------------------------------------
  211. IF (KIZD.NE.0.AND.KIZG.NE.0) THEN
  212. C
  213. C- Recherche de la matrice "masse" diagonale associée à l'inconnue NOMI
  214. C --------------------------------------------------------------------
  215. TYPE = ' '
  216. CALL ACMO(KIZD,NOMI,TYPE,IZD)
  217. IF (TYPE.NE.'CHPOINT ') THEN
  218. WRITE(6,*)'pas de matrice diagonale pour ',NOMI
  219. GOTO 1
  220. ENDIF
  221. CALL LICHT(IZD,IZDD,TYPC,IGEOM)
  222. C
  223. C- Recherche de l'"incrément" associé à l'inconnue NOMI
  224. C ----------------------------------------------------
  225. TYPE = ' '
  226. CALL ACMO(KIZG,NOMI,TYPE,IZG)
  227. IF (TYPE.NE.'CHPOINT ') THEN
  228. GOTO 1
  229. ENDIF
  230. CALL LICHT(IZG,IZGG,TYPC,IGEOM)
  231. C
  232. C- Imposition des conditions aux limites sur l'"incrément"
  233. C ------------------------------------------------------
  234. TYPE=' '
  235. CALL ACMO(KIZC,'KIZI ',TYPE,KIZI)
  236. IF (KIZI.NE.0) THEN
  237. DO 211 I=1,NC
  238. NOC = KOMP(I)
  239. IF (NC.EQ.1) NOC=KOMP(4)
  240. TYPE = ' '
  241. CALL ACMO(KIZI,NOMI,TYPE,MCHPOI)
  242. IF (TYPE.EQ.'CHPOINT') THEN
  243. CALL LACHT(MCHPOI,MPOVAL,NOC,MELEMI)
  244. IF (MPOVAL.NE.0) THEN
  245. SEGACT MELEMI
  246. LONG = MELEMI.NUM(/2)
  247. CALL RSETX2(IZGG.VPOCHA(1,I),MELEMI.NUM,
  248. & LONG,VPOCHA,IZIPAD.LECT)
  249. SEGDES MELEMI,MPOVAL
  250. ENDIF
  251. ENDIF
  252. 211 CONTINUE
  253. ENDIF
  254. C
  255. C- Calcul de l'inconnue au nouveau pas de temps
  256. C --------------------------------------------
  257. C- En EF
  258. C- En VF
  259. C
  260. DO 11 I=1,NC
  261. C
  262. C -------------------- Cas de des inconnues situées au Centre
  263. C --------------------------------------
  264. IF (TYPC.EQ.'FACE') THEN
  265. TYPE=' '
  266. CALL ACMO(KIZC,'DOMAINE',TYPE,MTABD)
  267. IF (MTABD.EQ.0) THEN
  268. MOTERR(1: 8) = 'TABLE '
  269. MOTERR(9:16) = 'DOMAINE '
  270. CALL ERREUR(79)
  271. RETURN
  272. ENDIF
  273. TYPE = 'CHPOINT '
  274. cccc CALL ACMO(KIZD,'DIAC0',TYPE,MCHPO4)
  275. CALL ACMO(KIZD,NOMI,TYPE,MCHPO4)
  276. IF (IERR.NE.0) RETURN
  277. CALL LICHT(MCHPO4,IZD2,TYPINC,IGEOM2)
  278. CALL PF500(IZD2,IPHI,IZSS,IZGG,IPHR,DT,MTABD,I)
  279. C
  280. if(I .EQ. NC) SEGDES MCHPO4,IZD2
  281. C
  282. C -------------------- Cas de des inconnues situées au Sommet
  283. C --------------------------------------
  284. ELSEIF (TYPC.EQ.'SOMMET') THEN
  285. IF (KIZG1.EQ.0) THEN
  286. LONG=IZDD.VPOCHA(/1)
  287. CALL P500(IZDD.VPOCHA(1,I),IPHI.VPOCHA(1,I),
  288. & IZGG.VPOCHA(1,I),IPHR.VPOCHA(1,I),LONG,DT)
  289. ELSE
  290. TYPE = ' '
  291. CALL ACMO(KIZG1,NOMI,TYPE,IZGD)
  292. IF (TYPE.NE.'CHPOINT ') THEN
  293. LONG = IZDD.VPOCHA(/1)
  294. CALL P500(IZDD.VPOCHA(1,I),IPHI.VPOCHA(1,I),
  295. & IZGG.VPOCHA(1,I),IPHR.VPOCHA(1,I),LONG,DT)
  296. ELSE
  297. CALL LICHT(IZGD,IZGDD,TYPC,IGEOM)
  298. LONG=IZDD.VPOCHA(/1)
  299. CALL P501(IZDD.VPOCHA(1,I),IPHI.VPOCHA(1,I),
  300. & IZGG.VPOCHA(1,I),IPHR.VPOCHA(1,I),
  301. & LONG,DT,IZGDD.VPOCHA(1,I))
  302. ENDIF
  303. ENDIF
  304. ENDIF
  305. 11 CONTINUE
  306. C
  307. C- Imposition des conditions aux limites
  308. C -------------------------------------
  309. TYPE = ' '
  310. CALL ACMO(KIZC,'CLIM',TYPE,MCHPOI)
  311. IF (TYPE.EQ.'CHPOINT')THEN
  312. DO 111 I=1,NC
  313. IF (NC.EQ.1) THEN
  314. NOC=NOMI(1:4)
  315. ELSE
  316. WRITE(NOC,FMT='(I1,A3)')I,NOMI(1:3)
  317. ENDIF
  318. SEGACT MCHPOI
  319. NSOUPO = IPCHP(/1)
  320. DO 10111 NSP=1,NSOUPO
  321. MSOUPO = IPCHP(NSP)
  322. SEGACT MSOUPO
  323. NCOMP = NOCOMP(/2)
  324. DO 10112 NCP=1,NCOMP
  325. IF (NOCOMP(NCP).EQ.NOC) THEN
  326. MELEMI = IGEOC
  327. MPOVAL = IPOVAL
  328. SEGACT MELEMI,MPOVAL
  329. LONG = MELEMI.NUM(/2)
  330. CALL RSETX2(IPHR.VPOCHA(1,I),MELEMI.NUM,
  331. & LONG,VPOCHA(1,NCP),IZIPAD.LECT)
  332. SEGDES MELEMI,MPOVAL
  333. ENDIF
  334. 10112 CONTINUE
  335. SEGDES MSOUPO
  336. 10111 CONTINUE
  337. SEGDES MCHPOI
  338. 111 CONTINUE
  339. ENDIF
  340. C
  341. C- Mise à zero de l'ensemble des données et ménage
  342. C -----------------------------------------------
  343. LONG = IZGG.VPOCHA(/1)*IZGG.VPOCHA(/2)
  344. CALL INITD(IZGG.VPOCHA,LONG,0.D0)
  345. SEGDES IZG,IZGG
  346. SEGDES IZD,IZDD
  347. IF (KIZG1.NE.0.AND.IZGD.NE.0) THEN
  348. CALL INITD(IZGDD.VPOCHA,LONG,0.D0)
  349. SEGDES IZGD,IZGDD
  350. ENDIF
  351. IF (KIZS.NE.0.AND.IZSS.NE.0) THEN
  352. CALL INITD(IZSS.VPOCHA,LONG,0.D0)
  353. ENDIF
  354. C --------------------------------------------------
  355. C- Fin du cas ou les tables KIZD et KIZG sont données
  356. C --------------------------------------------------
  357. ENDIF
  358. C
  359. C- Traitement des historiques
  360. C --------------------------
  361. IF (MTABT.NE.0) THEN
  362. TYPE=' '
  363. CALL ACMO(KIZC,'HIST',TYPE,KHIS)
  364. IF (KHIS.NE.0)THEN
  365. NUCOMP = IPHR.VPOCHA(/2)
  366. NOMIX(1) = NOMI
  367. NOMIX(2) = '1'//NOMI(1:7)
  368. NOMIX(3) = '2'//NOMI(1:7)
  369. NOMIX(4) = '3'//NOMI(1:7)
  370. DO 82 NUC=1,NUCOMP+1
  371. NUCR = 1
  372. IF (NUC.GT.1) NUCR=NUC-1
  373. TYPE = ' '
  374. CALL ACMO(KHIS,NOMIX(NUC),TYPE,MEVOLL)
  375. IF (TYPE.EQ.'EVOLUTIO')THEN
  376. TYPE1=' '
  377. NOMI1='$'//NOMIX(NUC)
  378. CALL ACMO(KHIS,NOMI1,TYPE1,MAH)
  379. IF (TYPE1.EQ.'MAILLAGE') THEN
  380. SEGACT MAH
  381. ENDIF
  382. CALL ECROBJ('CHPOINT',IZPHI)
  383. CALL ECROBJ('MAILLAGE',MAH)
  384. CALL REDU
  385. CALL LIROBJ('CHPOINT',IZH,1,IRET)
  386. CALL LICHT(IZH,IPHH,TYPC,IGEOM)
  387. TYPE1=' '
  388. CALL ACMO(KHIS,'KFIH',TYPE1,KFIH)
  389. IF (TYPE1.EQ.'ENTIER') THEN
  390. CALL ACME(KHIS,'KFIH',KFIH)
  391. ELSE
  392. KFIH = 20
  393. ENDIF
  394. INDH = IPT - IPT/KFIH * KFIH
  395. IF (INDH.NE.0) GOTO 80
  396.  
  397. SEGACT MEVOLL
  398. NH=IEVOLL(/1)
  399. DO 81 IH=1,NH
  400. KEVOLL=IEVOLL(IH)
  401. SEGACT KEVOLL
  402. MLREE1=IPROGX
  403. IF (IH.EQ.1)THEN
  404. SEGACT MLREE1
  405. JG=MLREE1.PROG(/1)+1
  406. SEGADJ MLREE1
  407. MLREE1.PROG(JG)=TPS
  408. SEGDES MLREE1
  409. ENDIF
  410.  
  411. MLREE2=IPROGY
  412. SEGACT MLREE2
  413. SEGADJ MLREE2
  414. if(ih.le.iphh.vpocha(/1)) then
  415. MLREE2.PROG(JG)=IPHH.VPOCHA(IH,NUCR)
  416. else
  417. MLREE2.PROG(JG)=0
  418. endif
  419. SEGDES MLREE2,KEVOLL
  420. 81 CONTINUE
  421. SEGDES MEVOLL
  422. 80 CONTINUE
  423. SEGDES MAH
  424. ENDIF
  425. 82 CONTINUE
  426. ENDIF
  427. ELSE
  428. WRITE(6,*)' Pour des historiques il faut une table PASDETPS'
  429. ENDIF
  430. C
  431. SEGDES IPHI,IPHR
  432. SEGDES IGEOM0
  433. SEGSUP IZIPAD
  434. 1 CONTINUE
  435. C
  436. SEGDES MLMOT2
  437. C
  438. C- Impressions de controle
  439. C -----------------------
  440. IF (IMPR.NE.0) THEN
  441. KFIDT = IMPR
  442. IF (MTABT.NE.0) THEN
  443. CALL ACMM(MTABT,'OPER',NOMI)
  444. CALL ACMM(MTABT,'ZONE',NOMZ)
  445. CALL ACMF(MTABT,'DTCONV',DTT1)
  446. CALL ACMF(MTABT,'DTDIFU',DTT2)
  447. CALL ACMF(MTABT,'DIAEL',DIAEL)
  448. CALL ACME(MTABT,'NUEL',NUEL)
  449. CALL ACME(MTABT,'NUPASDT',IPT)
  450. ELSE
  451. IPT=1
  452. ENDIF
  453. IND = IPT - IPT/KFIDT * KFIDT
  454.  
  455. IF (IPT.EQ.1) THEN
  456. WRITE(6,*)
  457. & ' IPT : NUMERO DU PAS DE TEMPS , NUEL : NUMERO DE L ELEMENT , '
  458. &,' DIAEL : DIAMETRE MOYEN DE L ELEMENT '
  459. WRITE(6,*)
  460. &' ALFA : TOLERANCE SUR LE PAS DE TEMPS , DTMAX : PAS DE TEMPS MAX'
  461. &,' DTT1 : PAS DE TEMPS DE CONVECTION , DTT2 PAS DE TEMPS DE'
  462. &,' DIFFUSION'
  463. ENDIF
  464. IF (IND.EQ.0)THEN
  465. WRITE(6,1011)NOMZ,NOMI
  466. WRITE(6,1010)IPT,NUEL,DIAEL,ALFA,DT,DTT1,DTT2
  467. ENDIF
  468. ENDIF
  469. C
  470. C- Mise à jour de la table PASDETPS
  471. C --------------------------------
  472. 800 CONTINUE
  473. IF (KIZD.NE.0.AND.KIZG.NE.0) THEN
  474. IF (MTABT.NE.0) THEN
  475. CALL ECMF(MTABT,'DELTAT-1',DT)
  476. CALL ECMF(MTABT,'TPS',TPS)
  477. DT=1.E30
  478. CALL ECMF(MTABT,'DELTAT',DT)
  479. IPT = IPT + 1
  480. CALL ECME(MTABT,'NUPASDT',IPT)
  481. ENDIF
  482. ENDIF
  483.  
  484. CALL ECRENT(IFINAL)
  485.  
  486. RETURN
  487. C
  488. C- Formats associés aux impression de controle
  489. C -------------------------------------------
  490. 1010 FORMAT(2X,'N.DT',I5,' NU.EL',I5,' DIAEL=',1PE11.4,' ALFA=',
  491. & 1PE11.4,' DTMAX=',1PE11.4,
  492. & ' DT1=',1PE11.4,' DT2=',1PE11.4)
  493. 1011 FORMAT(2X,' ZONE :',A8,' OPERATEUR :',A8)
  494. END
  495.  
  496.  
  497.  
  498.  
  499.  
  500.  
  501.  
  502.  
  503.  
  504.  
  505.  
  506.  

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