feqpr
C FEQPR SOURCE JK148537 24/11/05 21:15:02 12066 C_______________________________________________________________________ C C ENTREES: C ________ C C IPMODL Pointeur sur un MMODEL C IPCHM1 Pointeur sur un MCHAML de CONTRAINTES C IPCHM2 Pointeur sur un MCHAML de CARACTERISTIQUES C C SORTIES: C ________ C C IPCHP4 Pointeur sur un CHPOINT de forces aux noeuds C IRET = 1 OU 0 suivant succes ou pas (Message d'erreur C imprime dans ce cas) C_______________________________________________________________________ C IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) C -INC PPARAM -INC CCOPTIO -INC CCHAMP -INC SMMODEL -INC SMCHAML -INC SMCHPOI -INC SMELEME -INC SMINTE -INC SMLENTI C SEGMENT NOTYPE CHARACTER*16 TYPE(NBTYPE) ENDSEGMENT C SEGMENT MPTVAL INTEGER IPOS(NS) ,NSOF(NS) INTEGER IVAL(NCOSOU) CHARACTER*16 TYVAL(NCOSOU) ENDSEGMENT C C PARAMETER ( NINF=3 ) INTEGER INFOS(NINF) CHARACTER*(NCONCH) CONM C_______________________________________________________________________ C C A T-ON BIEN UN MMODEL CHARGEMENT PRESSION C_______________________________________________________________________ C MMODEL=IPMODL SEGACT,MMODEL NSOUS = MMODEL.KMODEL(/1) SEGINI, LIMODL DO ISOUS = 1,NSOUS IMODEL = MMODEL.KMODEL(ISOUS) SEGACT, IMODEL IF (FORMOD(1).EQ.'CHARGEMENT') THEN ENDIF ENDDO C IF (NSOUS.EQ.0) THEN MOTERR(1:10)='un MMODEL ' MOTERR(11:20)='CHARGEMENT' MOTERR(21:30)=' PRESSION ' RETURN ENDIF C C TEST DE NON REDONDANCES DES SOUS-MODELES C N1 = 1 DO I = NSOUS,2,-1 DO J = (I-1),1,-1 IF (IMODE1.EQ.IMODE2) THEN GOTO 10 ELSE IF (IMODE1.IMAMOD.EQ.IMODE2.IMAMOD .AND. & IMODE1.CONMOD.EQ.IMODE2.CONMOD) THEN GOTO 10 ENDIF ENDDO N1 = N1 + 1 10 CONTINUE ENDDO C C CREATION DU MMODEL C J = 0 SEGINI,MMODE1 DO i = 1,NSOUS j = j + 1 ENDIF ENDDO IPMOD0 = MMODE1 SEGSUP, LIMODL C_______________________________________________________________________ C C QUELQUES INITIALISATIONS C_______________________________________________________________________ C ISUP1 = 0 ISUP2 = 0 IRET = 0 IPCHP4 = 0 MCHELM = 0 MCHAML = 0 IPCHE1 = 0 IPCHE2 = 0 C_______________________________________________________________________ C C REDUCTION DES MCHAML EN ENTREE SUR LE MODELE C_______________________________________________________________________ C C DEJA FAIT DANS BSIGMA IF (IPCHM1.NE.0) THEN IF (IERR.NE.0) RETURN ENDIF C IF (IPCHM2.NE.0) THEN IF (IERR.NE.0) RETURN ENDIF C_______________________________________________________________________ C C VERIFICATION DES LIEUX SUPPORT DES MCHAML C_______________________________________________________________________ C IF (IPCHE1.NE.0) THEN IF (ISUP1.GT.1) RETURN ENDIF C IF (IPCHE2.NE.0) THEN IF (ISUP2.GT.1) RETURN ENDIF C_______________________________________________________________________ C C ACTIVATION DU MODELE C_______________________________________________________________________ C MMODEL=IPMOD0 NSOUS = MMODEL.KMODEL(/1) DO IM = 1, NSOUS IMODEL = MMODEL.KMODEL(IM) ENDDO C C ACTIVATION DU MCHELM CONTENANT 'PRES' C IF (IPCHE1.NE.0) THEN MCHEL1 = IPCHE1 ELSE MCHEL1 = IPCHE2 ENDIF SEGACT, MCHEL1 C C INITIALISATION DU MCHELM DE FORCES C N1 = NSOUS L1 = 6 N3 = 6 SEGINI, MCHELM IPCHE5 = MCHELM MCHELM.IFOCHE = IFOUR MCHELM.TITCHE = 'FORCES' NBTYPE=1 SEGINI,NOTYPE TYPE(1)='REAL*8' MOTYR8 = NOTYPE C C======================================================================= C C BOUCLE SUR LES MODELES ELEMENTAIRES C C======================================================================= C ISOUS = 0 C DO 200 KISOUS = 1, NSOUS C C INITIALISATION C IVAMAT=0 IVACAR=0 IVASTR=0 IVAFOR=0 MOMATR=0 MOCARA=0 MOSTRS=0 MOFORC=0 IPMINT=0 IPMIN1=0 C C TRAITEMENT DU MODELE C IMODEL = MMODEL.KMODEL(KISOUS) ISOUS = ISOUS+1 MELE = IMODEL.NEFMOD C C PETITE VERIFICATION SUR LE TYPE D'ELEMENT C IF (MELE.EQ.0) THEN C C ERREUR : IMPOSSIBLE D UTILISER L OPERATEUR PRESSI POUR C LES ELEMENTS DE FORMULATION MELE C MOTERR(1:8)=NOMTP(MELE) GOTO 9992 ENDIF IPMAIL = IMODEL.IMAMOD CONM = IMODEL.CONMOD C C CREATION DU TABLEAU INFOS C IF (IRTD.EQ.0) GOTO 9992 C_______________________________________________________________________ C C ACTIVATION DU MELEME C_______________________________________________________________________ C MELEME = IPMAIL SEGACT, MELEME NBNN = MELEME.NUM(/1) NBELEM = MELEME.NUM(/2) C_______________________________________________________________________ C C INFORMATIONS SUR L'ELEMENT FINI C_______________________________________________________________________ C NBPGAU= INFELE(4) MINTE = INFMOD(5) MINTE1= INFMOD(8) MFR = INFELE(13) NSTRS = INFELE(16) C IPMINT= MINTE IPMIN1= MINTE1 SEGACT, MINTE IPPORE= 0 IF (MFR2.EQ.33.OR.MFR2.EQ.57.OR.MFR2.EQ.59) IPPORE = NBNN C IMACHE(ISOUS) = IPMAIL INFCHE(ISOUS,1)=0 INFCHE(ISOUS,2)=0 INFCHE(ISOUS,3)=NIFOUR INFCHE(ISOUS,4)=0 INFCHE(ISOUS,5)=0 INFCHE(ISOUS,6)=1 C_______________________________________________________________________ C C NOMS DE COMPOSANTES DE CONTRAINTES C_______________________________________________________________________ C IF (IPCHE1.NE.0) THEN MOSTRS=LNOMID(4) NOMID=MOSTRS NSTR=LESOBL(/2) NFAC=LESFAC(/2) C C VERIFICATION DE LEUR PRESENCE C IF (IERR.NE.0) GOTO 9991 C IF (ISUP1.EQ.1) THEN NSTRS = 1 ENDIF ELSE MOMATR=LNOMID(6) NOMID=MOMATR NMATR=LESOBL(/2) NMATF=LESFAC(/2) C C VERIFICATION DE LEUR PRESENCE C IF (IERR.NE.0) GOTO 9991 C IF (ISUP2.EQ.1) THEN ENDIF ENDIF C_______________________________________________________________________ C C NOMS DE COMPOSANTES DE FORCES ET CREATION DU MCHAML DE FORCE C (CE MCHAML SERA TRANSFORME EN FIN DE SUBROUTINE EN CHPOINT) C_______________________________________________________________________ C MOFORC = LNOMID(2) NOMID=MOFORC NFORC=LESOBL(/2) NFACF=LESFAC(/2) C N2=NFORC SEGINI, MCHAML ICHAML(ISOUS)=MCHAML C DO 110 ICOMP=1,NFORC NOMCHE(ICOMP)=LESOBL(ICOMP) TYPCHE(ICOMP)='REAL*8' 110 CONTINUE C IF (NFACF.NE.0) THEN IFAC = 0 DO 111 ICOMP=(NFORC+1),N2 IFAC = IFAC + 1 NOMCHE(ICOMP)=LESFAC(IFAC) TYPCHE(ICOMP)='REAL*8' 111 CONTINUE ENDIF C C TAILLES DE MELVAL C N1EL=NBELEM N1PTEL=NBNN NBPTEL=NBPGAU NEL =N1EL C C CREATION DU MELVAL DE FORCES C NS=1 NCOSOU=NFORC+NFACF SEGINI, MPTVAL IVAFOR=MPTVAL DO 100 ICOMP=1,NCOSOU N2PTEL=0 N2EL=0 SEGINI, MELVAL IELVAL(ICOMP)=MELVAL IVAL(ICOMP)=MELVAL 100 CONTINUE C_______________________________________________________________________ C C NOMS DE COMPOSANTES DE CARACTERISTIQUES (FACULTATIF) C_______________________________________________________________________ C NBROBL=0 NBRFAC=0 NOMID=0 IVECT=0 NOTYPE = MOTYR8 C C EPAISSEUR DANS LE CAS MASSIF EN CONTRAINTES PLANES C IF(MFR.EQ.72.AND.IFOUR.EQ.-2)THEN C NBRFAC=1 SEGINI, NOMID LESFAC(1)='DIM3' C C EPAISSEUR DANS LE CAS DES COQUES 2D COQ2 C ELSEIF(MFR.EQ.74.AND.MELE.EQ.44.AND.IFOUR.EQ.-2)THEN C NBRFAC=1 SEGINI, NOMID LESFAC(1)='DIM3' C C EPAISSEUR DANS LE CAS DES COQUES EPAISSES C ELSEIF (MFR.EQ.74.AND.MFR2.EQ.5) THEN NBROBL=1 NBRFAC=0 SEGINI, NOMID LESOBL(1)='EPAI' C C EPAISSEUR ET RAYON EXTERNE DANS LE CAS DES TUYAUX C ELSEIF (MFR.EQ.74.AND.MFR2.EQ.13) THEN NBROBL=2 NBRFAC=4 SEGINI, NOMID LESOBL(1)='EPAI' LESOBL(2)='RAYO' LESFAC(1)='RACO' LESFAC(2)='VX' LESFAC(3)='VY' LESFAC(4)='VZ' C ENDIF MOCARA=NOMID MOTYPE=NOTYPE C NCARA=NBROBL NCARF=NBRFAC NCARR=NCARA+NCARF C IF (IPCHE2.NE.0) THEN IF (MOCARA.NE.0) THEN + IVACAR) IF (MOTYPE.NE.MOTYR8) SEGSUP,NOTYPE SEGSUP, NOMID IF (IERR.NE.0) GOTO 9990 IF (ISUP2.EQ.1) THEN IF (IERR.NE.0)THEN ISUP2=0 GOTO 9990 ENDIF ENDIF ELSE IF (MOTYPE.NE.MOTYR8) SEGSUP,NOTYPE SEGSUP, NOMID ENDIF ELSE IF (NCARA.GT.0) THEN IF (MOTYPE.NE.MOTYR8) SEGSUP,NOTYPE SEGSUP, NOMID MOTERR(1:8)='CARACTER' MOTERR(9:12)=NOMTP(MELE) MOTERR(13:20)='FEQPR' GOTO 9990 ENDIF C_______________________________________________________________________ C C CALCUL DES FORCES EQUIVALENTES C_______________________________________________________________________ C IF (IPCHE1.NE.0) THEN MPTVAL=IVASTR ELSE MPTVAL=IVAMAT ENDIF IVAPRE = IVAL(1) C C - ELEMENTS DE FORMULATION MASSIF C IF (MFR2.EQ.1) THEN XP=0.D0 IF (MELE.EQ.2.OR.MELE.EQ.3.OR.MELE.EQ.79.OR.MELE.EQ.80) THEN ELSE IF(MELE.EQ.4.OR.MELE.EQ.6.OR.MELE.EQ.8.OR. + MELE.EQ.10.OR.MELE.EQ.81.OR.MELE.EQ.82.OR. + MELE.EQ.83) THEN IF (IDIM.EQ.3) THEN ELSE C ERREUR, APPLICATION PRESSION SUR SURFACE DANS UN PB 2D GOTO 9990 ENDIF ELSE IF (MELE.EQ.45) THEN ELSE C ERREUR, ELEMENT NON IMPLEMENTE MOTERR(1:4)=NOMTP(MELE) MOTERR(5:12)='FEQPR ' GOTO 9990 ENDIF C C - ELEMENTS DE FORMULATION COQUES C ELSE IF (MFR2.EQ.3.OR.MFR2.EQ.5.OR.MFR2.EQ.9) THEN C IF (MELE.EQ.27.OR.MELE.EQ.28.OR.MELE.EQ.45.OR. + MELE.EQ.93.OR.MELE.EQ.44.OR.MELE.EQ.49.OR. + MELE.EQ.41.OR.MELE.EQ.56) THEN C VERIFICATION DE L ORIENTATION DU IPMAIL CALL VERSEN IF (IERR.NE.0) GOTO 9990 IF (MELE.EQ.27.OR.MELE.EQ.28.OR.MELE.EQ.45 + .OR.MELE.EQ.93) THEN ELSE IF (MELE.EQ.44) THEN ELSE IF (MELE.EQ.49) THEN IPT1 = IPMAIL SEGACT, IPT1 ELSE IF (MELE.EQ.41.OR.MELE.EQ.56) THEN IPT1 = IPMAIL SEGACT, IPT1 ENDIF ELSE C ERREUR, ELEMENT NON IMPLEMENTE MOTERR(1:4)=NOMTP(MELE) MOTERR(5:12)='FEQPR ' GOTO 9990 ENDIF C ELSE IF (MFR2.EQ.13) THEN C C - ELEMENTS TUYAU C C C - SINON TENTATIVE D'UTILISATION D'UNE OPTION NON IMPLEMENTEE C ELSE GOTO 9990 ENDIF C C DESACTIVATION AVANT DE PASSER A LA SOUS ZONE SUIVANTE C C IF(ISUP1.EQ.1)THEN ELSE ENDIF C C IF(ISUP2.EQ.1)THEN ELSE ENDIF C IF (IERR.NE.0) GO TO 9990 C C======================================================================= C C FIN DE BOUCLE SUR LES MODELES ELEMENTAIRES C C======================================================================= 200 CONTINUE C_______________________________________________________________________ C C TRANSFORMATION DU CHAMELEM EN CHPOINT C_______________________________________________________________________ C IF (IRETOU.EQ.0) GOTO 9000 C C FIN NORMALE C IRET = 1 GOTO 9000 C_______________________________________________________________________ C C ERREUR DANS UNE SOUS ZONE, DESACTIVATION ET RETOUR C_______________________________________________________________________ C 9990 CONTINUE IF (MCHAML.NE.0) SEGSUP, MCHAML C 9991 CONTINUE C 9992 CONTINUE IF (MCHELM.NE.0) SEGSUP, MCHELM IRET = 0 C_______________________________________________________________________ C C DERNIERES DESACTIVATION AVANT DE QUITTER C_______________________________________________________________________ C 9000 CONTINUE NOTYPE = MOTYR8 SEGSUP,NOTYPE C RETURN END
© Cast3M 2003 - Tous droits réservés.
Mentions légales