C DYNE74 SOURCE CB215821 24/04/12 21:15:39 11897 SUBROUTINE DYNE74(ITSORT,ITCARA,ITABL,ITLIA,KTRAV,II,NLS,NVAR) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) *--------------------------------------------------------------------* * * * Operateur DYNE : algorithme de Fu - de Vogelaere * * ________________________________________________ * * * * Dimensionne les variables NLS et NVAR, gestion des demandes de * * sorties pour les liaisons. * * * * Parametres: * * * * e ITABL Table definissant les liaisons en sortie. * * e ITLIA Table definissant toutes les liaisons sur une base. * * e KTRAV Segment de travail qui va remplir MTRES dans DYNE15 * * es II Compteur * * s NLS Nombre de demandes de liaisons en sortie * * s NVAR Nombre maxi de variables internes de liaisons * * * * * * Auteur, date de cr{ation: * * * * d après Lionel VIVAN, le 2 octobre 1989. * * * *--------------------------------------------------------------------* -INC PPARAM -INC CCOPTIO -INC SMMODEL -INC SMCHAML * SEGMENT,MTRAV INTEGER ICHRE2(NBLS),MPOLA(NBLS),MNULA(NBLS) INTEGER MPOLB(NBLS),MNULB(NBLS) INTEGER IVLIAA(NBLS,NTVAR),INLIAA(NBLS,NTVAR) INTEGER IVLIAB(NBLS,NTVAR),INLIAB(NBLS,NTVAR) ENDSEGMENT * LOGICAL L0,L1,LVAR CHARACTER*8 MONMOT,TYPRET,CHARRE,CMATE CHARACTER*40 CMOT CHARACTER*4 MO4 * CMOT=' ' MTRAV = KTRAV NLS = 0 NVAR = 0 mmodel = itlia * table indicée par des entiers CALL DIMEN7 (ITABL,IDIMEN) mmodel = itlia segact mmodel mchelm = itcara segact mchelm segact mmodel * * recherche des liaisons en sortie : faire une table index de la tsortie.liaison * INDICE = 0 IVAR = 0 100 CONTINUE INDICE = INDICE + 1 TYPRET = ' ' CALL ACCTAB(ITABL,'ENTIER',INDICE,X0,' ',L0,IP0, & TYPRET,I1,X1,CHARRE,L1,ITTL) IF (TYPRET.EQ.'MMODEL ' .AND. ITTL.NE.0) THEN TYPRET = ' ' CALL ACCTAB(ITSORT,'MMODEL ',I0,X0,' ',L0,ITTL, & TYPRET,I1,X1,CHARRE,LVAR,ITVAR) mmode1 = ittl segact mmode1 * on attend une liaison elementaire imode1 = mmode1.kmodel(1) segact imode1 do ik = 1,kmodel(/1) imodel = kmodel(ik) segact imodel * write(6,*) imodel,imode1,conmod,imode1.conmod,imamod,imode1.imamod if (imode1.conmod.eq.conmod.or.imode1.imamod.eq.imamod) goto 110 segdes imodel enddo segdes imode1,mmode1 goto 100 110 continue * * toutes les variables de la liaison sont en sortie * IF (TYPRET.EQ.'LOGIQUE ' .AND. LVAR) THEN NLS = NLS + 1 MNULA(NLS) = INDICE MPOLA(NLS) = ITTL CMATE = CMATEE lcham = 0 MONMOT = ' ' do im = 1,imache(/1) if(imache(im).eq.imamod.and.conche(im).eq.conmod) then mchaml = ichaml(im) lcham = mchaml segact mchaml do l=1,nomche(/2) MO4=nomche(l) if (MO4.eq.'AMOR') MONMOT='FLOTTANT' enddo segdes mchaml endif enddo * IF (CMATE.EQ.'PO_PL_FL') THEN IVAR = 6 NVAR = MAX(NVAR,IVAR) II = II + 1 ICHRE2(II) = IVAR IVLIAA(NLS,1) = 1 INLIAA(NLS,1) = 7 IVLIAA(NLS,2) = 1 INLIAA(NLS,2) = 8 IVLIAA(NLS,3) = 1 INLIAA(NLS,3) = 69 IVLIAA(NLS,4) = 1 INLIAA(NLS,4) = 70 IVLIAA(NLS,5) = 1 INLIAA(NLS,5) = 71 IVLIAA(NLS,6) = 1 INLIAA(NLS,6) = 72 * ELSE IF (CMOT(1:10).EQ.'PO_PL') THEN IF (MONMOT.EQ.'FLOTTANT') THEN IVAR = 3 IVLIAA(NLS,3) = 1 INLIAA(NLS,3) = 39 ELSE IVAR = 2 ENDIF NVAR = MAX(NVAR,IVAR) II = II + 1 ICHRE2(II) = IVAR IVLIAA(NLS,1) = 1 INLIAA(NLS,1) = 15 IVLIAA(NLS,4) = 1 INLIAA(NLS,4) = 7 * ELSE IF (CMOT(1:16).EQ.'COUP_VIT') THEN IVAR = 3 NVAR = MAX(NVAR,IVAR) II = II + 1 ICHRE2(II) = IVAR IVLIAA(NLS,1) = 1 INLIAA(NLS,1) = 73 IVLIAA(NLS,3) = 1 INLIAA(NLS,3) = 8 IVLIAA(NLS,4) = 1 INLIAA(NLS,4) = 7 * ELSE IF (CMOT(1:20).EQ.'COUP_DEP') THEN IVAR = 2 NVAR = MAX(NVAR,IVAR) II = II + 1 ICHRE2(II) = IVAR IVLIAA(NLS,1) = 1 INLIAA(NLS,1) = 74 IVLIAA(NLS,4) = 1 INLIAA(NLS,4) = 7 * ELSE IF (CMOT(1:11).EQ.'POLYNOMI') THEN IVAR = 1 NVAR = MAX(NVAR,IVAR) II = II + 1 ICHRE2(II) = IVAR IVLIAA(NLS,1) = 1 INLIAA(NLS,1) = 77 * ELSE CALL ERREUR(490) RETURN ENDIF * ELSE IF (TYPRET.EQ.'TABLE ' .AND. ITVAR.NE.0) THEN * kich : on met toutes les variables if (.false.) then NLS = NLS + 1 MNULA(NLS) = INDICE MPOLA(NLS) = ITTL CALL ACCTAB(ITTL,'MOT',I0,X0,'TYPE_LIAISON',L0,IP0, & 'MOT',I1,X1,CMOT,L1,IT1) IVAR = 0 * IF (CMOT(1:17).EQ.'POINT_PLAN_FLUIDE') THEN TYPRET = ' ' CALL ACCTAB(ITVAR,'MOT',I0,X0,'DEPLACEMENT',L0,IP0, & TYPRET,I1,X1,CHARRE,LVAR,IT1) IF (TYPRET.EQ.'LOGIQUE ' .AND. LVAR ) THEN IVAR = IVAR + 1 IVLIAA(NLS,1) = 1 INLIAA(NLS,1) = 7 ENDIF TYPRET = ' ' CALL ACCTAB(ITVAR,'MOT',I0,X0,'VITESSE',L0,IP0, & TYPRET,I1,X1,CHARRE,LVAR,IT1) IF (TYPRET.EQ.'LOGIQUE ' .AND. LVAR ) THEN IVAR = IVAR + 1 IVLIAA(NLS,2) = 1 INLIAA(NLS,2) = 8 ENDIF TYPRET = ' ' CALL ACCTAB(ITVAR,'MOT',I0,X0,'MASSE_AJOUTEE',L0,IP0, & TYPRET,I1,X1,CHARRE,LVAR,IT1) IF (TYPRET.EQ.'LOGIQUE ' .AND. LVAR ) THEN IVAR = IVAR + 1 IVLIAA(NLS,3) = 1 INLIAA(NLS,3) = 69 ENDIF TYPRET = ' ' CALL ACCTAB(ITVAR,'MOT',I0,X0,'FORCE_CONVECTION',L0,IP0, & TYPRET,I1,X1,CHARRE,LVAR,IT1) IF (TYPRET.EQ.'LOGIQUE ' .AND. LVAR ) THEN IVAR = IVAR + 1 IVLIAA(NLS,4) = 1 INLIAA(NLS,4) = 70 ENDIF TYPRET = ' ' CALL ACCTAB(ITVAR,'MOT',I0,X0,'FORCE_VISCOSITE',L0,IP0, & TYPRET,I1,X1,CHARRE,LVAR,IT1) IF (TYPRET.EQ.'LOGIQUE ' .AND. LVAR ) THEN IVAR = IVAR + 1 IVLIAA(NLS,5) = 1 INLIAA(NLS,5) = 71 ENDIF TYPRET = ' ' CALL ACCTAB(ITVAR,'MOT',I0,X0,'FORCE_PERTE_DE_CHARGE', & L0,IP0,TYPRET,I1,X1,CHARRE,LVAR,IT1) IF (TYPRET.EQ.'LOGIQUE ' .AND. LVAR ) THEN IVAR = IVAR + 1 IVLIAA(NLS,6) = 1 INLIAA(NLS,6) = 72 ENDIF IF (IVAR.EQ.0) THEN CALL ERREUR(496) RETURN ENDIF * ELSE IF (CMOT(1:10).EQ.'POINT_PLAN') THEN TYPRET = ' ' CALL ACCTAB(ITVAR,'MOT',I0,X0,'DEPLACEMENT',L0,IP0, & TYPRET,I1,X1,CHARRE,LVAR,IT1) IF (TYPRET.EQ.'LOGIQUE ' .AND. LVAR ) THEN IVAR = IVAR + 1 IVLIAA(NLS,4) = 1 INLIAA(NLS,4) = 7 ENDIF TYPRET = ' ' CALL ACCTAB(ITVAR,'MOT',I0,X0,'VITESSE_NORMALE',L0,IP0, & TYPRET,I1,X1,CHARRE,LVAR,IT1) IF (TYPRET.EQ.'LOGIQUE ' .AND. LVAR ) THEN IVAR = IVAR + 1 IVLIAA(NLS,3) = 1 INLIAA(NLS,3) = 39 ENDIF TYPRET = ' ' CALL ACCTAB(ITVAR,'MOT',I0,X0,'FORCE_DE_CHOC',L0,IP0, & TYPRET,I1,X1,CHARRE,LVAR,IT1) IF (TYPRET.EQ.'LOGIQUE ' .AND. LVAR ) THEN IVAR = IVAR + 1 IVLIAA(NLS,1) = 1 INLIAA(NLS,1) = 15 ENDIF IF (IVAR.EQ.0) THEN CALL ERREUR(496) RETURN ENDIF * ELSE IF (CMOT(1:16).EQ.'COUPLAGE_VITESSE') THEN TYPRET = ' ' CALL ACCTAB(ITVAR,'MOT',I0,X0,'DEPLACEMENT',L0,IP0, & TYPRET,I1,X1,CHARRE,LVAR,IT1) IF (TYPRET.EQ.'LOGIQUE ' .AND. LVAR ) THEN IVAR = IVAR + 1 IVLIAA(NLS,4) = 1 INLIAA(NLS,4) = 7 ENDIF TYPRET = ' ' CALL ACCTAB(ITVAR,'MOT',I0,X0,'VITESSE',L0,IP0, & TYPRET,I1,X1,CHARRE,LVAR,IT1) IF (TYPRET.EQ.'LOGIQUE ' .AND. LVAR ) THEN IVAR = IVAR + 1 IVLIAA(NLS,3) = 1 INLIAA(NLS,3) = 8 ENDIF TYPRET = ' ' CALL ACCTAB(ITVAR,'MOT',I0,X0, & 'FORCE_DE_COUPLAGE_VITESSE',L0,IP0, & TYPRET,I1,X1,CHARRE,LVAR,IT1) IF (TYPRET.EQ.'LOGIQUE ' .AND. LVAR ) THEN IVAR = IVAR + 1 IVLIAA(NLS,1) = 1 INLIAA(NLS,1) = 73 ENDIF IF (IVAR.EQ.0) THEN CALL ERREUR(496) RETURN ENDIF * ELSE IF (CMOT(1:20).EQ.'COUPLAGE_DEPLACEMENT') THEN TYPRET = ' ' CALL ACCTAB(ITVAR,'MOT',I0,X0,'DEPLACEMENT',L0,IP0, & TYPRET,I1,X1,CHARRE,LVAR,IT1) IF (TYPRET.EQ.'LOGIQUE ' .AND. LVAR ) THEN IVAR = IVAR + 1 IVLIAA(NLS,4) = 1 INLIAA(NLS,4) = 7 ENDIF TYPRET = ' ' CALL ACCTAB(ITVAR,'MOT',I0,X0, & 'FORCE_DE_COUPLAGE_DEPLACEMENT',L0,IP0, & TYPRET,I1,X1,CHARRE,LVAR,IT1) IF (TYPRET.EQ.'LOGIQUE ' .AND. LVAR ) THEN IVAR = IVAR + 1 IVLIAA(NLS,1) = 1 INLIAA(NLS,1) = 74 ENDIF IF (IVAR.EQ.0) THEN CALL ERREUR(496) RETURN ENDIF * ELSE IF (CMOT(1:11).EQ.'POLYNOMIALE') THEN TYPRET = ' ' CALL ACCTAB(ITVAR,'MOT',I0,X0,'FORCE_POLYNOMIALE', & L0,IP0,TYPRET,I1,X1,CHARRE,LVAR,IT1) IF (TYPRET.EQ.'LOGIQUE '.AND.LVAR) THEN IVAR = IVAR + 1 IVLIAA(NLS,1) = 1 INLIAA(NLS,1) = 77 ENDIF * ELSE CALL ERREUR(490) RETURN ENDIF NVAR = MAX(NVAR,IVAR) II = II + 1 ICHRE2(II) = IVAR IF (IIMPI.EQ.333) THEN WRITE(IOIMP,*)'DYNE24 : ICHRE2(',II,')=',IVAR ENDIF * kich annulation du choix endif ENDIF GOTO 100 ELSE if (indice.le.idimen) goto 100 ENDIF IF (IIMPI.EQ.333) THEN WRITE(IOIMP,*) 'DYNE24 : NVAR = ',NVAR WRITE(IOIMP,*) 'DYNE24 : NLS = ',NLS WRITE(IOIMP,*) 'DYNE24 : IVAR = ',IVAR ENDIF * END