C CCGMMD SOURCE GOUNAND 21/06/02 21:15:13 11022 SUBROUTINE CCGMMD(LCOF,NOMLOI, $ FC, $ IMPR,IRET) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER (I-N) C*********************************************************************** C NOM : CCGMMD C DESCRIPTION : Calcul de la loi de comportement aux points de Gauss : C max |d|/min|d| où d=det J C avec un signe moins si d change de signe 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, 04/08/04, version initiale C HISTORIQUE : v1, 04/08/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 PPARAM -INC CCOPTIO -INC CCREEL -INC TNLIN *-INC SMCHAEL INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM,N1 POINTEUR FC.MCHEVA POINTEUR LCOF.LCHEVA POINTEUR JMAJAC.MCHEVA POINTEUR JMIJAC.MCHEVA POINTEUR JDTJAC.MCHEVA POINTEUR JMAREG.MCHEVA POINTEUR JMET.MCHEVA CHARACTER*8 NOMLOI INTEGER ICOF * SEGMENT MCOF POINTEUR COEF(IDIM,IDIM).MCHEVA ENDSEGMENT POINTEUR MET.MCOF * LOGICAL LBID * INTEGER IMPR,IRET * * Executable statements * IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans ccgmmd' C IF (.NOT.(IDIM.EQ.1)) THEN C WRITE(IOIMP,*) 'IDIM=',IDIM,' ?' C GOTO 9999 C ENDIF NLFC=FC.WELCHE(/6) NPFC=FC.WELCHE(/5) ICOF=0 * * Récupération des coefficients de la metrique * C SEGINJ MET C DO IIDIM=1,IDIM C ICOF=ICOF+1 C JMET=LCOF.LISCHE(ICOF) C IF (ICOF.EQ.1) THEN C NLJM=JMET.WELCHE(/6) C NPJM=JMET.WELCHE(/5) C ELSE C NLJM2=JMET.WELCHE(/6) C NPJM2=JMET.WELCHE(/5) C IF (NLJM2.NE.NLJM.OR.NPJM2.NE.NPJM) THEN C WRITE(IOIMP,*) 'Erreur grave dims JMET' C GOTO 9999 C ENDIF C ENDIF C MET.COEF(IIDIM,IIDIM)=JMET C ENDDO C DO IIDIM=1,IDIM C NJ=IDIM-IIDIM C IF (NJ.GE.1) THEN C DO JIDIM=IIDIM+1,IDIM C ICOF=ICOF+1 C JMET=LCOF.LISCHE(ICOF) C NLJM2=JMET.WELCHE(/6) C NPJM2=JMET.WELCHE(/5) C IF (NLJM2.NE.NLJM.OR.NPJM2.NE.NPJM) THEN C WRITE(IOIMP,*) 'Erreur grave dims JMET2' C GOTO 9999 C ENDIF C MET.COEF(IIDIM,JIDIM)=JMET C ENDDO C ENDIF C ENDDO * ICOF=ICOF+1 JMAJAC=LCOF.LISCHE(ICOF) C NLJA=JMAJAC.WELCHE(/6) C NPJA=JMAJAC.WELCHE(/5) C IREF=JMAJAC.WELCHE(/4) C IREL=JMAJAC.WELCHE(/3) C* C IF (IREL.NE.IDIM) THEN C WRITE(IOIMP,*) 'Erreur dims JMAJAC' C GOTO 9999 C ENDIF * ICOF=ICOF+1 JMIJAC=LCOF.LISCHE(ICOF) ICOF=ICOF+1 JDTJAC=LCOF.LISCHE(ICOF) NLJD=JDTJAC.WELCHE(/6) NPJD=JDTJAC.WELCHE(/5) ICOF=ICOF+1 JMAREG=LCOF.LISCHE(ICOF) C NLJR=JMAREG.WELCHE(/6) C NPJR=JMAREG.WELCHE(/5) C I1 =JMAREG.WELCHE(/4) C I2 =JMAREG.WELCHE(/3) C IF ((NLJR.NE.1).OR.(NPJR.NE.1).OR.(I1.NE.IREF).OR.(I2.NE.IREF)) C $ THEN C WRITE(IOIMP,*) 'Erreur dims JMAREG' C GOTO 9999 C ENDIF * DO ILFC=1,NLFC IF (NLJD.EQ.1) THEN ILJD=1 ELSE ILJD=ILFC ENDIF XMADA=-XGRAND XMIDA=XGRAND XMAD=-XGRAND XMID=XGRAND DO IPJD=1,NPJD C DO IPFC=1,NPFC C IF (NPJD.EQ.1) THEN C IPJD=1 C ELSE C IPJD=IPFC C ENDIF XDET=JDTJAC.WELCHE(1,1,1,1,IPJD,ILJD) AXDET=ABS(XDET) XMADA=MAX(XMADA,AXDET) XMIDA=MIN(XMIDA,AXDET) XMAD=MAX(XMAD,XDET) XMID=MIN(XMID,XDET) ENDDO * * Les déterminants nuls ou petit ou changeant de signe ont déjà été * capturés dans geoli2 (normalement !) * CONTRI=SIGN(1.D0,XMAD*XMID)*(XMADA/XMIDA) * WRITE(IOIMP,*) 'CONTRI=',CONTRI * DO IPFC=1,NPFC FC.WELCHE(1,1,1,1,IPFC,ILFC)= $ FC.WELCHE(1,1,1,1,IPFC,ILFC)+CONTRI ENDDO ENDDO * * Normal termination * IRET=0 RETURN * * Format handling * * * Error handling * 9999 CONTINUE IRET=1 WRITE(IOIMP,*) 'An error was detected in subroutine ccgmmd' RETURN * * End of subroutine CCGMMD * END