C CALCGB SOURCE GOUNAND 11/04/29 21:15:01 6947 SUBROUTINE CALCGB(IVCOM,LCOF,METRIQ, $ FC, $ IMPR,IRET) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER (I-N) C*********************************************************************** C NOM : CALCGB C DESCRIPTION : Calcul de la loi de comportement aux points de Gauss C C C LANGAGE : ESOPE C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) C mél : gounand@semt2.smts.cea.fr C*********************************************************************** C APPELES : C APPELE PAR : C*********************************************************************** C ENTREES : C ENTREES/SORTIES : C SORTIES : - C TRAVAIL : C*********************************************************************** C VERSION : v1, 11/05/04, version initiale C HISTORIQUE : v1, 11/05/04, création C HISTORIQUE : C HISTORIQUE : C*********************************************************************** C Prière de PRENDRE LE TEMPS de compléter les commentaires C en cas de modification de ce sous-programme afin de faciliter C la maintenance ! C*********************************************************************** -INC CCOPTIO CBEGININCLUDE SMCHAEL SEGMENT MCHAEL POINTEUR IMACHE(N1).MELEME POINTEUR ICHEVA(N1).MCHEVA ENDSEGMENT SEGMENT MCHEVA REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM) ENDSEGMENT SEGMENT LCHEVA POINTEUR LISCHE(NBCHE).MCHEVA ENDSEGMENT CENDINCLUDE SMCHAEL INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM,N1 POINTEUR FC.MCHEVA POINTEUR LCOF.LCHEVA POINTEUR MYCOF.MCHEVA * les MCHEVA des coefficient CBEGININCLUDE SLCOMP SEGMENT COMP CHARACTER*8 NOMCOM INTEGER DERCOF(NCOCOF) LOGICAL LTREF ENDSEGMENT SEGMENT COMPS POINTEUR LISCOM(NBCOMP).COMP ENDSEGMENT CENDINCLUDE SLCOMP POINTEUR IVCOM.COMP CBEGININCLUDE TMPREC SEGMENT MPREC POINTEUR DAT(NDAT).MCHEVA POINTEUR PREC(NPREC).MCHEVA ENDSEGMENT CENDINCLUDE TMPREC POINTEUR METRIQ.MPREC INTEGER IMPR,IRET CHARACTER*8 NOMLOI REAL*8 MAXVAL * * Executable statements * IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans calcgb' NOMLOI=IVCOM.NOMCOM * WRITE(IOIMP,*) 'NOMLOI=',NOMLOI * * Dispatching * IF (NOMLOI.EQ.'RIEN ') THEN FC.VELCHE(1,1,1,1,1,1)=1.D0 ELSEIF (NOMLOI.EQ.'IDEN ') THEN NLFC=FC.VELCHE(/6) NPFC=FC.VELCHE(/5) MYCOF=LCOF.LISCHE(1) NLC=MYCOF.VELCHE(/6) NPC=MYCOF.VELCHE(/5) N2C=MYCOF.VELCHE(/4) IF (NLFC.NE.NLC.OR.NPFC.NE.NPC.OR.N2C.NE.1) THEN WRITE(IOIMP,*) 'Erreur grave 1' GOTO 9999 ENDIF DO ILFC=1,NLFC DO IPFC=1,NPFC FC.VELCHE(1,1,1,1,IPFC,ILFC)= $ MYCOF.VELCHE(1,1,1,1,IPFC,ILFC) ENDDO ENDDO ELSEIF (NOMLOI.EQ.'1/X ') THEN NLFC=FC.VELCHE(/6) NPFC=FC.VELCHE(/5) MYCOF=LCOF.LISCHE(1) NLC=MYCOF.VELCHE(/6) NPC=MYCOF.VELCHE(/5) N2C=MYCOF.VELCHE(/4) IF (NLFC.NE.NLC.OR.NPFC.NE.NPC.OR.N2C.NE.1) THEN WRITE(IOIMP,*) 'Erreur grave 2' GOTO 9999 ENDIF DO ILFC=1,NLFC DO IPFC=1,NPFC FC.VELCHE(1,1,1,1,IPFC,ILFC)=1.D0/ $ MYCOF.VELCHE(1,1,1,1,IPFC,ILFC) ENDDO ENDDO ELSEIF (NOMLOI.EQ.'MAXI ') THEN NLFC=FC.VELCHE(/6) NPFC=FC.VELCHE(/5) MYCOF=LCOF.LISCHE(1) NLC=MYCOF.VELCHE(/6) NPC=MYCOF.VELCHE(/5) N2C=MYCOF.VELCHE(/4) IF (NLFC.NE.NLC.OR.NPFC.NE.NPC.OR.N2C.NE.1) THEN WRITE(IOIMP,*) 'Erreur grave 3' GOTO 9999 ENDIF DO ILFC=1,NLFC MAXVAL=FC.VELCHE(1,1,1,1,1,ILFC) DO IPFC=2,NPFC MAXVAL=MAX(MAXVAL,FC.VELCHE(1,1,1,1,IPFC,ILFC)) ENDDO DO IPFC=1,NPFC FC.VELCHE(1,1,1,1,IPFC,ILFC)=MAXVAL ENDDO ENDDO ELSEIF (NOMLOI.EQ.'RAYS ') THEN CALL CCGRAS(LCOF,FC,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 ELSEIF (NOMLOI.EQ.'MUR ') THEN CALL CCGMUR(LCOF,FC,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 ELSEIF (NOMLOI.EQ.'SUTH ') THEN CALL CCGSUT(LCOF,FC,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 ELSEIF (NOMLOI.EQ.'DIV ') THEN CALL CCGDIV(LCOF,FC,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 ELSEIF (NOMLOI.EQ.'TAU ') THEN CALL CCGTAU(LCOF,FC,1,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 ELSEIF (NOMLOI.EQ.'SIGMA ') THEN CALL CCGTAU(LCOF,FC,2,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 ELSEIF (NOMLOI.EQ.'MADSMID ') THEN CALL CCGMMD(LCOF,NOMLOI,FC,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 ELSEIF (NOMLOI.EQ.'VOLORI ') THEN CALL CCGADV(LCOF,NOMLOI,FC,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 ELSEIF (NOMLOI(1:3).EQ.'AHU') THEN CALL CCGAHU(LCOF,NOMLOI,FC,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 * ELSEIF (NOMLOI(1:3).EQ.'AHP') THEN * CALL CCGAHP(LCOF,NOMLOI,METRIQ,FC,IMPR,IRET) * IF (IRET.NE.0) GOTO 9999 ELSEIF ((NOMLOI(1:4).EQ.'QEQU').OR.(NOMLOI(1:4).EQ.'QALI')) THEN CALL CCGQME(LCOF,NOMLOI,FC,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 ELSEIF (NOMLOI(1:4).EQ.'D/DX') THEN CALL CCGRAD(LCOF,NOMLOI,FC,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 ELSEIF (NOMLOI.EQ.'TAILDIRE') THEN CALL CCGTDI(LCOF,FC,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 ELSEIF (NOMLOI(1:6).EQ.'MUSTAB') THEN CALL CCGMUS(LCOF,NOMLOI,FC,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 ELSEIF (NOMLOI(1:3).EQ.'TSU') THEN CALL CCGTSU(LCOF,NOMLOI,FC,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 ELSEIF (NOMLOI(1:3).EQ.'VNO') THEN CALL CCGNOR(LCOF,NOMLOI,FC,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 ELSEIF (NOMLOI(1:4).EQ.'IMET') THEN CALL CCGIME(LCOF,NOMLOI,FC,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 ELSE WRITE(IOIMP,*) 'Loi de comportement ',NOMLOI WRITE(IOIMP,*) 'non définie dans calcgb' GOTO 9999 ENDIF * * Normal termination * IRET=0 RETURN * * Format handling * * * Error handling * 9999 CONTINUE IRET=1 WRITE(IOIMP,*) 'An error was detected in subroutine calcgb' RETURN * * End of subroutine CALCGB * END