C MODOPE SOURCE JK148537 26/10/19 21:15:12 12674 *======================================================================= *= SOUS-PROGRAMME PERMETTANT D'ADAPTER UN MMODEL A L'OPERATEUR = *= pour rigi / bsigma / epsi / comp = *= = *= = *= PAS DE PRECONDITIONNEMENT ICI, MERCI !! = *= = *= 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' = *= = 3 avec formulation CHARGEMENT = *= = *= INIVE = 6 met en ordre pour COMP = *= Nota : - IPMOD0 / IPMOD1 est ACTIF en entree / sortie. = *======================================================================= SUBROUTINE MODOPE (IPMOD0,IPMOD1,IRET,INIVE) IMPLICIT INTEGER (I-N) IMPLICIT REAL*8 (A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC SMMODEL POINTEUR mmode3.mmodel -INC SMELEME POINTEUR ipt0.meleme CHARACTER*(16) moforg mmodel = IPMOD0 cc segact,mmodel*nomod NSOUS = mmodel.kmodel(/1) if (NSOUS.EQ.0) then IPMOD1 = IPMOD0 return endif segini,mmode1=mmodel N1 = NSOUS segini mmode3 k3 = 0 if (inive.lt.4.or.inive.eq.6) goto 100 DO is = 1, NSOUS imodel = mmode1.kmodel(is) if ((cmatee.eq.'MODAL'.or.cmatee.eq.'STATIQUE') &.and.(inive.eq.4.or.inive.eq.5)) then do im =1,matmod(/2) if (matmod(im)(1:12).eq.'COMP_ASSO') then do jv = 1,ivamod(/1) if (TYMODE(jv).eq.'MMODEL ') then icomp = jv endif enddo endif enddo if (icomp.gt.0) then mmode2 = ivamod(icomp) n1 = n1 + mmode2.kmodel(/1) segadj mmode3 do kr = 1,mmode2.kmodel(/1) k3 = k3 + 1 mmode3.kmodel(k3) = mmode2.kmodel(kr) enddo if (inive.eq.4) mmode1.kmodel(is) = 0 endif endif ENDDO if (k3.eq.0) then ipmod1 = ipmod0 segsup mmode1,mmode3 return endif * test non redondance DO is = 1,k3-1 DO js = is+1,k3 if (mmode3.kmodel(is).eq.mmode3.kmodel(js)) & mmode3.kmodel(js) = 0 ENDDO ENDDO n1 = nsous + k3 segini mmode2 k2 = 0 if (inive.eq.4) then do js = 1,nsous if (mmode1.kmodel(js).gt.0) then k2 = k2 + 1 mmode2.kmodel(k2) = mmode1.kmodel(js) endif enddo endif if (inive.eq.5) then do js = 1,nsous do kr = 1,k3 if (mmode1.kmodel(js).eq.mmode3.kmodel(kr)) & mmode1.kmodel(js) = 0 enddo if (mmode1.kmodel(js).gt.0) then k2 = k2 + 1 mmode2.kmodel(k2) = mmode1.kmodel(js) endif enddo endif do j3 = 1,k3 if (mmode3.kmodel(j3).gt.0) then k2 = k2 + 1 mmode2.kmodel(k2) = mmode3.kmodel(j3) endif enddo n1 = k2 segadj mmode2 segsup mmode1,mmode3 ipmod1 = mmode2 RETURN 100 CONTINUE c inive 0-3 / 6 NMOMEL = 0 DO is = 1, NSOUS imodel = mmode1.kmodel(is) if (cmatee.eq.'ADVECTIO') goto 50 moforg = imodel.FORMOD(1)(1:16) IF (moforg.EQ.'MECANIQUE ' .OR. & moforg.EQ.'CONTRAINTE ' .OR. & moforg.EQ.'POREUX ' .OR. & moforg.EQ.'ELECTROSTATIQUE ' .OR. & moforg.EQ.'DIFFUSION ' .OR. & moforg.EQ.'METALLURGIE ' .OR. & moforg.EQ.'LIQUIDE ' ) THEN k3 = k3 + 1 mmode3.kmodel(k3) = imodel ELSE IF (moforg.eq.'LIAISON '.and.inive.eq.6) then k3 = k3 + 1 mmode3.kmodel(k3) = imodel ELSE IF (moforg.eq.'CHARGEMENT'.and. &imodel.matmod(1).eq.'PRESSION'.and.inive.eq.3) then k3 = k3 + 1 mmode3.kmodel(k3) = imodel ELSE IF (moforg.EQ.'NAVIER_STOKES ') THEN IF (imodel.MATMOD(1).EQ.'NLIN') THEN k3 = k3 + 1 mmode3.kmodel(k3) = imodel ENDIF ELSE IF (moforg.EQ.'MELANGE ') THEN NMOMEL = NMOMEL + 1 IF (imodel.MATMOD(1).NE.'SERIE') THEN IF (INIVE.ge.1.or.INIVE.le.3) THEN k3 = k3 + 1 mmode3.kmodel(k3) = imodel ENDIF IF (IVAMOD(/1).GE.1) THEN n1 = n1 + ivamod(/1) segadj mmode3 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'.or.inive.eq.6) then k3 = k3 + 1 mmode3.kmodel(k3) = imode1 else if (inive.eq.0.or.inive.eq.1.or.inive.eq.3) then k3 = k3 + 1 mmode3.kmodel(k3) = imode1 endif endif ELSE C SEGDES,IMODE1 ENDIF ENDIF ENDDO ENDIF ENDIF c ELSE IF (moforg.EQ.'................') THEN ENDIF 50 CONTINUE ENDDO n1 = k3 segadj mmode3 IF (N1.EQ.NSOUS .AND. NMOMEL.EQ.0) THEN c modele initial ipmod1 = ipmod0 if (iimpi0.eq.1972) then write(ioimp,*) 'Preconditionnement PIMODL IPMOD0 = IPMOD1' endif segsup mmode1,mmode3 RETURN C- Moedele deroule plus petit et/ou incluant des sous-modeles ELSE IF (k3.LE.0) THEN CALL ERREUR(-182) segsup mmode1,mmode3 RETURN ENDIF * Test de non redondance si presence de sous-modeles MELANGE : IF (NMOMEL .GT. 0) THEN N1 = 1 DO is = k3, 2, -1 imode1 = mmode3.kmodel(is) DO js = (is-1),1,-1 imode2 = mmode3.kmodel(js) IF (imode1.eq.imode2) THEN mmode3.kmodel(is) = 0 GOTO 10 ELSE IF (imode1.IMAMOD.EQ.imode2.IMAMOD .AND. & imode1.CONMOD.EQ.imode2.CONMOD) THEN mmode3.kmodel(is) = 0 GOTO 10 ENDIF ENDDO N1 = N1 + 1 10 CONTINUE ENDDO ENDIF * Creation du MMODEL deroule : segsup mmode1 SEGINI,mmode1 is = 0 DO js = 1, k3 IF (mmode3.kmodel(js).GT.0) THEN is = is + 1 mmode1.kmodel(is) = mmode3.kmodel(js) ENDIF ENDDO SEGACT,mmode1*NOMOD if (is.ne.N1) then write(ioimp,*) 'PIMODL : N1 != is !',is,N1 call erreur(22) return endif ENDIF segsup mmode3 ipmod1 = mmode1 if (inive.lt.6) RETURN 200 continue if (NMOMEL.eq.0) return C CREATION DU MMODEL DE TRAVAIL (les sous-modeles de formulation C melange sont mis a la fin pour qu'ils soient traites en dernier C car ils dependent des resultats des autres sous-modeles) SEGINI,MMODEL IT1 = 0 IT2 = N1 - NMOMEL DO IM = 1, N1 IMODEL = mmode1.kmodel(im) IF (IMODEL.GT.0) THEN IF (FORMOD(1)(1:8).NE.'MELANGE ') THEN IT1 = IT1 + 1 KMODEL(IT1) = IMODEL ELSE IT2 = IT2 + 1 KMODEL(IT2) = IMODEL ENDIF ENDIF ENDDO segsup mmode1 IPMOD1 = MMODEL RETURN END