1 : C CCGMMD SOURCE GOUNAND 05/12/21 21:16:32 5281 2 : SUBROUTINE CCGMMD(LCOF,NOMLOI, 3 : $ FC, 4 : $ IMPR,IRET) 5 : IMPLICIT REAL*8 (A-H,O-Z) 6 : IMPLICIT INTEGER (I-N) 7 : C*********************************************************************** 8 : C NOM : CCGMMD 9 : C DESCRIPTION : Calcul de la loi de comportement aux points de Gauss : 10 : C max |d|/min|d| où d=det J 11 : C avec un signe moins si d change de signe 12 : C 13 : C 14 : C LANGAGE : ESOPE 15 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) 16 : C mél : gounand@semt2.smts.cea.fr 17 : C*********************************************************************** 18 : C APPELES : 19 : C APPELE PAR : 20 : C*********************************************************************** 21 : C ENTREES : 22 : C ENTREES/SORTIES : 23 : C SORTIES : - 24 : C TRAVAIL : 25 : C*********************************************************************** 26 : C VERSION : v1, 04/08/04, version initiale 27 : C HISTORIQUE : v1, 04/08/04, création 28 : C HISTORIQUE : 29 : C HISTORIQUE : 30 : C*********************************************************************** 31 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 32 : C en cas de modification de ce sous-programme afin de faciliter 33 : C la maintenance ! 34 : C*********************************************************************** 35 : -INC CCOPTIO 36 : -INC CCREEL 37 : CBEGININCLUDE SMCHAEL 38 : SEGMENT MCHAEL 39 : POINTEUR IMACHE(N1).MELEME 40 : POINTEUR ICHEVA(N1).MCHEVA 41 : ENDSEGMENT 42 : SEGMENT MCHEVA 43 : REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM) 44 : ENDSEGMENT 45 : SEGMENT LCHEVA 46 : POINTEUR LISCHE(NBCHE).MCHEVA 47 : ENDSEGMENT 48 : CENDINCLUDE SMCHAEL 49 : INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM,N1 50 : POINTEUR FC.MCHEVA 51 : POINTEUR LCOF.LCHEVA 52 : POINTEUR JMAJAC.MCHEVA 53 : POINTEUR JMIJAC.MCHEVA 54 : POINTEUR JDTJAC.MCHEVA 55 : POINTEUR JMAREG.MCHEVA 56 : POINTEUR JMET.MCHEVA 57 : CHARACTER*8 NOMLOI 58 : INTEGER ICOF 59 : * 60 : SEGMENT MCOF 61 : POINTEUR COEF(IDIM,IDIM).MCHEVA 62 : ENDSEGMENT 63 : POINTEUR MET.MCOF 64 : * 65 : LOGICAL LBID 66 : * 67 : INTEGER IMPR,IRET 68 : * 69 : * Executable statements 70 : * 71 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans ccgmmd' 72 : C IF (.NOT.(IDIM.EQ.1)) THEN 73 : C WRITE(IOIMP,*) 'IDIM=',IDIM,' ?' 74 : C GOTO 9999 75 : C ENDIF 76 : NLFC=FC.VELCHE(/6) 77 : NPFC=FC.VELCHE(/5) 78 : ICOF=0 79 : * 80 : * Récupération des coefficients de la metrique 81 : * 82 : C SEGINJ MET 83 : C DO IIDIM=1,IDIM 84 : C ICOF=ICOF+1 85 : C JMET=LCOF.LISCHE(ICOF) 86 : C IF (ICOF.EQ.1) THEN 87 : C NLJM=JMET.VELCHE(/6) 88 : C NPJM=JMET.VELCHE(/5) 89 : C ELSE 90 : C NLJM2=JMET.VELCHE(/6) 91 : C NPJM2=JMET.VELCHE(/5) 92 : C IF (NLJM2.NE.NLJM.OR.NPJM2.NE.NPJM) THEN 93 : C WRITE(IOIMP,*) 'Erreur grave dims JMET' 94 : C GOTO 9999 95 : C ENDIF 96 : C ENDIF 97 : C MET.COEF(IIDIM,IIDIM)=JMET 98 : C ENDDO 99 : C DO IIDIM=1,IDIM 100 : C NJ=IDIM-IIDIM 101 : C IF (NJ.GE.1) THEN 102 : C DO JIDIM=IIDIM+1,IDIM 103 : C ICOF=ICOF+1 104 : C JMET=LCOF.LISCHE(ICOF) 105 : C NLJM2=JMET.VELCHE(/6) 106 : C NPJM2=JMET.VELCHE(/5) 107 : C IF (NLJM2.NE.NLJM.OR.NPJM2.NE.NPJM) THEN 108 : C WRITE(IOIMP,*) 'Erreur grave dims JMET2' 109 : C GOTO 9999 110 : C ENDIF 111 : C MET.COEF(IIDIM,JIDIM)=JMET 112 : C ENDDO 113 : C ENDIF 114 : C ENDDO 115 : * 116 : ICOF=ICOF+1 117 : JMAJAC=LCOF.LISCHE(ICOF) 118 : C NLJA=JMAJAC.VELCHE(/6) 119 : C NPJA=JMAJAC.VELCHE(/5) 120 : C IREF=JMAJAC.VELCHE(/4) 121 : C IREL=JMAJAC.VELCHE(/3) 122 : C* 123 : C IF (IREL.NE.IDIM) THEN 124 : C WRITE(IOIMP,*) 'Erreur dims JMAJAC' 125 : C GOTO 9999 126 : C ENDIF 127 : * 128 : ICOF=ICOF+1 129 : JMIJAC=LCOF.LISCHE(ICOF) 130 : ICOF=ICOF+1 131 : JDTJAC=LCOF.LISCHE(ICOF) 132 : NLJD=JDTJAC.VELCHE(/6) 133 : NPJD=JDTJAC.VELCHE(/5) 134 : ICOF=ICOF+1 135 : JMAREG=LCOF.LISCHE(ICOF) 136 : C NLJR=JMAREG.VELCHE(/6) 137 : C NPJR=JMAREG.VELCHE(/5) 138 : C I1 =JMAREG.VELCHE(/4) 139 : C I2 =JMAREG.VELCHE(/3) 140 : C IF ((NLJR.NE.1).OR.(NPJR.NE.1).OR.(I1.NE.IREF).OR.(I2.NE.IREF)) 141 : C $ THEN 142 : C WRITE(IOIMP,*) 'Erreur dims JMAREG' 143 : C GOTO 9999 144 : C ENDIF 145 : * 146 : DO ILFC=1,NLFC 147 : IF (NLJD.EQ.1) THEN 148 : ILJD=1 149 : ELSE 150 : ILJD=ILFC 151 : ENDIF 152 : XMADA=-XGRAND 153 : XMIDA=XGRAND 154 : XMAD=-XGRAND 155 : XMID=XGRAND 156 : DO IPJD=1,NPJD 157 : C DO IPFC=1,NPFC 158 : C IF (NPJD.EQ.1) THEN 159 : C IPJD=1 160 : C ELSE 161 : C IPJD=IPFC 162 : C ENDIF 163 : XDET=JDTJAC.VELCHE(1,1,1,1,IPJD,ILJD) 164 : AXDET=ABS(XDET) 165 : XMADA=MAX(XMADA,AXDET) 166 : XMIDA=MIN(XMIDA,AXDET) 167 : XMAD=MAX(XMAD,XDET) 168 : XMID=MIN(XMID,XDET) 169 : ENDDO 170 : * 171 : * Les déterminants nuls ou petit ou changeant de signe ont déjà été 172 : * capturés dans geoli2 (normalement !) 173 : * 174 : CONTRI=SIGN(1.D0,XMAD*XMID)*(XMADA/XMIDA) 175 : * WRITE(IOIMP,*) 'CONTRI=',CONTRI 176 : * 177 : DO IPFC=1,NPFC 178 : FC.VELCHE(1,1,1,1,IPFC,ILFC)= 179 : $ FC.VELCHE(1,1,1,1,IPFC,ILFC)+CONTRI 180 : ENDDO 181 : ENDDO 182 : * 183 : * Normal termination 184 : * 185 : IRET=0 186 : RETURN 187 : * 188 : * Format handling 189 : * 190 : * 191 : * Error handling 192 : * 193 : 9999 CONTINUE 194 : IRET=1 195 : WRITE(IOIMP,*) 'An error was detected in subroutine ccgmmd' 196 : RETURN 197 : * 198 : * End of subroutine CCGMMD 199 : * 200 : END 201 : 202 :
© Cast3M 2003 - All rights reserved.
Disclaimer