C PIMODL SOURCE JK148537 25/12/12 21:15:08 12418 *======================================================================= *= SOUS-PROGRAMME PERMETTANT DE DEROULER UN MMODEL = *= (UTILE SURTOUT EN CAS DE MODELE MELANGE) = *= = *= IPMOD0 MMODEL initial complet = *= IPMOD1 MMODEL "deroule" contenant, de maniere unitaire, les sous- = *= modeles de formulation 'MECANIQUE', 'LIQUIDE' et 'POREUX' = *= vaut 0 en cas d'ERREUR (MMODEL "deroule" vide) = *= IPMAI1 MAILLAGE "deroule" contenant, pour chaque sous-modele de = *= IPMOD1, le maillage support (type 28) si le mode de calcul = *= est de type DPGE (2D/1D) = *= vaut 0 si non utile/defini = *= INIVE = 0 sans 'MELANGE' avec sous-modeles encapsules = *= = 1 avec 'MELANGE' et sous-modeles encapsules sauf 'PARALLELE'= *= = 2 avec 'MELANGE' et sous-modeles encapsules si 'PARALLELE' = *= Nota : - IPMOD0 / IPMOD1 est ACTIF en entree / sortie. = *= - Tous les sous-modeles de IPMOD1 sont ACTIFs en sortie ! = *======================================================================= SUBROUTINE PIMODL (IPMOD0,IPMOD1,IPMAI1,INIVE) IMPLICIT INTEGER (I-N) IMPLICIT REAL*8 (A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC CCPRECO -INC SMMODEL -INC SMELEME POINTEUR ipt0.meleme SEGMENT limodl(0) CHARACTER*(16) moforg LOGICAL lDPGE IPMOD1 = 0 IPMAI1 = 0 iimpi0 = IIMPI c*dbg iimpi0 = 1972 mmodel = IPMOD0 c* segact,mmodel*nomod <- Actif en E/S C PRECOnditionnment "CMODPG" des MODELES mecaniques en mode DPGE (2D/1D) C ====================================================================== C Recherche si le modele IPMOD0 n'a pas deja ete traite : C Verification si presence dans le preconditionnement CCPRECO / "CMODPG" ith = oothrd ith1 = ith + 1 CALL OOOHO1(mmodel,ihorot) ITAILL = NBMODP(ith1) DO is = 1, ITAILL IF ( PMODPE(is,ith1) .EQ. mmodel .AND. & PMODPH(is,ith1) .EQ. ihorot ) THEN mmode1 = PMODPS(is,ith1) meleme = PMADPS(is,ith1) if (iimpi0.eq.1972) then write(ioimp,*) 'Preconditionnement PIMODL trouve', & mmodel,mmode1,meleme,is endif C Mise a jour du preconditionnement dans CCPRECO : Deplacement en position 1 IF (is .GT. 1) THEN DO js = is, 2, -1 PMODPE(js,ith1) = PMODPE(js - 1,ith1) PMODPH(js,ith1) = PMODPH(js - 1,ith1) PMODPS(js,ith1) = PMODPS(js - 1,ith1) PMADPS(js,ith1) = PMADPS(js - 1,ith1) ENDDO PMODPE(1,ith1) = mmodel PMODPH(1,ith1) = ihorot PMODPS(1,ith1) = mmode1 PMADPS(1,ith1) = meleme ENDIF IF (mmode1.NE.0 .AND. mmode1.NE.mmodel) & CALL ACTOBJ('MMODEL ',mmode1,1) IF (meleme.NE.0) CALL ACTOBJ('MAILLAGE',meleme,1) IPMOD1 = mmode1 IPMAI1 = meleme if (iimpi0.eq.1972) & write(ioimp,*) 'PIMODL : IPMOD1 avec NSOU1 =', & mmode1.kmodel(/1) GOTO 100 ENDIF ENDDO C On deroule le MODELE des MODELES mecaniques en mode DPGE (2D/1D) C ====================================================================== * On met dans le segment limodl tous les sous-modeles utiles. NSOUS = mmodel.kmodel(/1) N1 = 0 N1SM = 0 SEGINI,limodl DO is = 1, NSOUS imodel = mmodel.kmodel(is) c* segact imodel moforg = imodel.FORMOD(1)(1:16) if (cmatee.eq.'ADVECTIO') goto 50 IF (moforg.EQ.'MECANIQUE ' .OR. & moforg.EQ.'CONTRAINTE ' .OR. & moforg.EQ.'POREUX ' .OR. & moforg.EQ.'ELECTROSTATIQUE ' .OR. & moforg.EQ.'DIFFUSION ' .OR. & moforg.EQ.'LIQUIDE ' ) THEN N1 = N1 + 1 limodl(**) = imodel ELSE IF (moforg.EQ.'NAVIER_STOKES ') THEN IF (imodel.MATMOD(1).EQ.'NLIN') THEN N1 = N1 + 1 limodl(**) = IMODEL ENDIF ELSE IF (moforg.EQ.'MELANGE ') THEN IF (imodel.MATMOD(1).NE.'SERIE') THEN IF (INIVE.ge.1) THEN limodl(**) = IMODEL N1 = N1 + 1 ENDIF IF (IVAMOD(/1).GE.1) THEN DO j = 1,IVAMOD(/1) IF (TYMODE(j).EQ.'IMODEL ') THEN IMODE1 = IVAMOD(j) SEGACT,IMODE1 IF (IMODE1.FORMOD(1)(1:10).EQ.'MECANIQUE ' .OR. & IMODE1.FORMOD(1)(1:10).EQ.'POREUX ' .OR. & IMODE1.FORMOD(1)(1:10).EQ.'LIQUIDE ' ) THEN if (CMATEE.NE.'PARALLEL') then limodl(**) = IMODE1 N1SM = N1SM + 1 else if (inive.ne.2) then limodl(**) = IMODE1 N1SM = N1SM + 1 endif endif ELSE C SEGDES,IMODE1 ENDIF ENDIF ENDDO ENDIF ENDIF c ELSE IF (moforg.EQ.'................') THEN ENDIF 50 CONTINUE ENDDO C- Le modele deroule contenu dans limodl correspond au modele de depart : C-------------------- IF (N1.EQ.NSOUS .AND. N1SM.EQ.0) THEN mmode1 = mmodel if (iimpi0.eq.1972) then write(ioimp,*) 'Preconditionnement PIMODL IPMOD0 = IPMOD1' endif C- Moedele deroule plus petit et/ou incluant des sous-modeles ELSE C- Test sur le nombre de sous-modeles de limodl qui doit etre non nul ! NSOUS = limodl(/1) IF (NSOUS.LE.0) THEN CALL ERREUR(-182) GOTO 99 ENDIF * Test de non redondance si presence de sous-modeles MELANGE : N1 = NSOUS IF (N1SM .NE. 0) THEN N1 = 1 DO is = NSOUS, 2, -1 imode1 = limodl(is) DO js = (is-1),1,-1 imode2 = limodl(js) IF (imode1.eq.imode2) THEN limodl(is) = 0 GOTO 10 ELSE IF (imode1.IMAMOD.EQ.imode2.IMAMOD .AND. & imode1.CONMOD.EQ.imode2.CONMOD) THEN limodl(is) = 0 GOTO 10 ENDIF ENDDO N1 = N1 + 1 10 CONTINUE ENDDO ENDIF * Creation du MMODEL deroule : is = 0 SEGINI,mmode1 DO js = 1, NSOUS IF (limodl(js).GT.0) THEN is = is + 1 mmode1.kmodel(is) = limodl(js) ENDIF ENDDO SEGACT,mmode1*NOMOD if (is.ne.N1) then write(ioimp,*) 'PIMODL : N1 != is !',is,N1 endif ENDIF NSOU1 = mmode1.kmodel(/1) if (iimpi0.eq.1972) & write(ioimp,*) 'PIMODL : IPMOD1 avec NSOU1 =',NSOU1 IF (NSOU1.LE.0) THEN write(ioimp,*) 'PIMODL : IPMOD1 vide - NSOU1 = 0' CALL ERREUR(-182) GOTO 99 ENDIF ipt1 = 0 C- Test si le mode de calcul courant est "DPGE" mfr = 1 CALL INFDPG(mfr,IFOUR,lDPGE,ndpge) IF (lDPGE) THEN NBNN = 0 NBELEM = 0 NBREF = 0 NBSOUS = 0 SEGINI,ipt0 SEGACT,ipt0*NOMOD NBSOUS = NSOU1 SEGINI,ipt1 N1 = 0 DO is = 1, NSOU1 imodel = mmode1.kmodel(is) mfr = imodel.INFELE(13) CALL INFDPG(mfr,IFOUR,lDPGE,ndpge) IF (lDPGE) THEN IIPDPG = imodel.IPDPGE IIPDPG = IPTPOI(IIPDPG) IF (IIPDPG.LE.0) THEN CALL ERREUR(925) CALL ERREUR(5) GOTO 99 ENDIF ipt3 = imodel.imamod NBNN3 = ipt3.NUM(/1) NBNN = NBNN3+1 NBELEM = ipt3.NUM(/2) NBREF = 0 NBSOUS = 0 SEGINI,meleme meleme.ITYPEL=28 DO i = 1, NBELEM DO j = 1, NBNN3 meleme.NUM(j,i) = ipt3.NUM(j,i) ENDDO meleme.NUM(NBNN,i) = IIPDPG meleme.ICOLOR(i) = ipt3.ICOLOR(i) ENDDO SEGACT,meleme*NOMOD N1 = N1 + 1 ELSE meleme = ipt0 ENDIF ipt1.lisous(is) = meleme ENDDO SEGACT,ipt1*NOMOD IF (N1.EQ.0) THEN segsup,ipt1,ipt0 ipt1 = 0 ENDIF ENDIF IPMOD1 = mmode1 IPMAI1 = ipt1 C Mise a jour du preconditionnement CCPRECO / "CMODPG" C Si N1SM non nul et INIVE different de 1, pas de preco ... En attendant mieux ! if (N1SM.NE.0 .AND. INIVE.NE.1) then if (iimpi0.eq.1972) & write(ioimp,*) 'PIMODL : Preconditionnement non retenu ', & NSOU1,N1SM,INIVE goto 99 endif ITAILL = MIN(ITAILL + 1, NPMDPG) NBMODP(ith1) = ITAILL DO is = ITAILL, 2, -1 PMODPE(is,ith1) = PMODPE(is - 1,ith1) PMODPH(is,ith1) = PMODPH(is - 1,ith1) PMODPS(is,ith1) = PMODPS(is - 1,ith1) PMADPS(is,ith1) = PMADPS(is - 1,ith1) ENDDO PMODPE(1,ith1) = mmodel PMODPH(1,ith1) = ihorot PMODPS(1,ith1) = mmode1 PMADPS(1,ith1) = ipt1 if (iimpi0.eq.1973) then write(ioimp,*) 'PIMODL : Preconditionnement realise', & mmodel,mmode1,ipt1,itaill endif C Sortie du sous-programme (menage...) 99 CONTINUE SEGSUP,limodl 100 CONTINUE c RETURN END