1 : C CALCGB SOURCE GOUNAND 11/04/29 21:15:01 6947 2 : SUBROUTINE CALCGB(IVCOM,LCOF,METRIQ, 3 : $ FC, 4 : $ IMPR,IRET) 5 : IMPLICIT REAL*8 (A-H,O-Z) 6 : IMPLICIT INTEGER (I-N) 7 : C*********************************************************************** 8 : C NOM : CALCGB 9 : C DESCRIPTION : Calcul de la loi de comportement aux points de Gauss 10 : C 11 : C 12 : C LANGAGE : ESOPE 13 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) 14 : C mél : gounand@semt2.smts.cea.fr 15 : C*********************************************************************** 16 : C APPELES : 17 : C APPELE PAR : 18 : C*********************************************************************** 19 : C ENTREES : 20 : C ENTREES/SORTIES : 21 : C SORTIES : - 22 : C TRAVAIL : 23 : C*********************************************************************** 24 : C VERSION : v1, 11/05/04, version initiale 25 : C HISTORIQUE : v1, 11/05/04, création 26 : C HISTORIQUE : 27 : C HISTORIQUE : 28 : C*********************************************************************** 29 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 30 : C en cas de modification de ce sous-programme afin de faciliter 31 : C la maintenance ! 32 : C*********************************************************************** 33 : -INC CCOPTIO 34 : CBEGININCLUDE SMCHAEL 35 : SEGMENT MCHAEL 36 : POINTEUR IMACHE(N1).MELEME 37 : POINTEUR ICHEVA(N1).MCHEVA 38 : ENDSEGMENT 39 : SEGMENT MCHEVA 40 : REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM) 41 : ENDSEGMENT 42 : SEGMENT LCHEVA 43 : POINTEUR LISCHE(NBCHE).MCHEVA 44 : ENDSEGMENT 45 : CENDINCLUDE SMCHAEL 46 : INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM,N1 47 : POINTEUR FC.MCHEVA 48 : POINTEUR LCOF.LCHEVA 49 : POINTEUR MYCOF.MCHEVA 50 : * les MCHEVA des coefficient 51 : CBEGININCLUDE SLCOMP 52 : SEGMENT COMP 53 : CHARACTER*8 NOMCOM 54 : INTEGER DERCOF(NCOCOF) 55 : LOGICAL LTREF 56 : ENDSEGMENT 57 : SEGMENT COMPS 58 : POINTEUR LISCOM(NBCOMP).COMP 59 : ENDSEGMENT 60 : CENDINCLUDE SLCOMP 61 : POINTEUR IVCOM.COMP 62 : CBEGININCLUDE TMPREC 63 : SEGMENT MPREC 64 : POINTEUR DAT(NDAT).MCHEVA 65 : POINTEUR PREC(NPREC).MCHEVA 66 : ENDSEGMENT 67 : CENDINCLUDE TMPREC 68 : POINTEUR METRIQ.MPREC 69 : INTEGER IMPR,IRET 70 : CHARACTER*8 NOMLOI 71 : REAL*8 MAXVAL 72 : * 73 : * Executable statements 74 : * 75 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans calcgb' 76 : NOMLOI=IVCOM.NOMCOM 77 : * WRITE(IOIMP,*) 'NOMLOI=',NOMLOI 78 : * 79 : * Dispatching 80 : * 81 : IF (NOMLOI.EQ.'RIEN ') THEN 82 : FC.VELCHE(1,1,1,1,1,1)=1.D0 83 : ELSEIF (NOMLOI.EQ.'IDEN ') THEN 84 : NLFC=FC.VELCHE(/6) 85 : NPFC=FC.VELCHE(/5) 86 : MYCOF=LCOF.LISCHE(1) 87 : NLC=MYCOF.VELCHE(/6) 88 : NPC=MYCOF.VELCHE(/5) 89 : N2C=MYCOF.VELCHE(/4) 90 : IF (NLFC.NE.NLC.OR.NPFC.NE.NPC.OR.N2C.NE.1) THEN 91 : WRITE(IOIMP,*) 'Erreur grave 1' 92 : GOTO 9999 93 : ENDIF 94 : DO ILFC=1,NLFC 95 : DO IPFC=1,NPFC 96 : FC.VELCHE(1,1,1,1,IPFC,ILFC)= 97 : $ MYCOF.VELCHE(1,1,1,1,IPFC,ILFC) 98 : ENDDO 99 : ENDDO 100 : ELSEIF (NOMLOI.EQ.'1/X ') THEN 101 : NLFC=FC.VELCHE(/6) 102 : NPFC=FC.VELCHE(/5) 103 : MYCOF=LCOF.LISCHE(1) 104 : NLC=MYCOF.VELCHE(/6) 105 : NPC=MYCOF.VELCHE(/5) 106 : N2C=MYCOF.VELCHE(/4) 107 : IF (NLFC.NE.NLC.OR.NPFC.NE.NPC.OR.N2C.NE.1) THEN 108 : WRITE(IOIMP,*) 'Erreur grave 2' 109 : GOTO 9999 110 : ENDIF 111 : DO ILFC=1,NLFC 112 : DO IPFC=1,NPFC 113 : FC.VELCHE(1,1,1,1,IPFC,ILFC)=1.D0/ 114 : $ MYCOF.VELCHE(1,1,1,1,IPFC,ILFC) 115 : ENDDO 116 : ENDDO 117 : ELSEIF (NOMLOI.EQ.'MAXI ') THEN 118 : NLFC=FC.VELCHE(/6) 119 : NPFC=FC.VELCHE(/5) 120 : MYCOF=LCOF.LISCHE(1) 121 : NLC=MYCOF.VELCHE(/6) 122 : NPC=MYCOF.VELCHE(/5) 123 : N2C=MYCOF.VELCHE(/4) 124 : IF (NLFC.NE.NLC.OR.NPFC.NE.NPC.OR.N2C.NE.1) THEN 125 : WRITE(IOIMP,*) 'Erreur grave 3' 126 : GOTO 9999 127 : ENDIF 128 : DO ILFC=1,NLFC 129 : MAXVAL=FC.VELCHE(1,1,1,1,1,ILFC) 130 : DO IPFC=2,NPFC 131 : MAXVAL=MAX(MAXVAL,FC.VELCHE(1,1,1,1,IPFC,ILFC)) 132 : ENDDO 133 : DO IPFC=1,NPFC 134 : FC.VELCHE(1,1,1,1,IPFC,ILFC)=MAXVAL 135 : ENDDO 136 : ENDDO 137 : ELSEIF (NOMLOI.EQ.'RAYS ') THEN 137 : CALL CCGRAS(LCOF,FC,IMPR,IRET) 138 : IF (IRET.NE.0) GOTO 9999 139 : ELSEIF (NOMLOI.EQ.'MUR ') THEN 139 : CALL CCGMUR(LCOF,FC,IMPR,IRET) 140 : IF (IRET.NE.0) GOTO 9999 141 : ELSEIF (NOMLOI.EQ.'SUTH ') THEN 141 : CALL CCGSUT(LCOF,FC,IMPR,IRET) 142 : IF (IRET.NE.0) GOTO 9999 143 : ELSEIF (NOMLOI.EQ.'DIV ') THEN 143 : CALL CCGDIV(LCOF,FC,IMPR,IRET) 144 : IF (IRET.NE.0) GOTO 9999 145 : ELSEIF (NOMLOI.EQ.'TAU ') THEN 145 : CALL CCGTAU(LCOF,FC,1,IMPR,IRET) 146 : IF (IRET.NE.0) GOTO 9999 147 : ELSEIF (NOMLOI.EQ.'SIGMA ') THEN 147 : CALL CCGTAU(LCOF,FC,2,IMPR,IRET) 148 : IF (IRET.NE.0) GOTO 9999 149 : ELSEIF (NOMLOI.EQ.'MADSMID ') THEN 149 : CALL CCGMMD(LCOF,NOMLOI,FC,IMPR,IRET) 150 : IF (IRET.NE.0) GOTO 9999 151 : ELSEIF (NOMLOI.EQ.'VOLORI ') THEN 151 : CALL CCGADV(LCOF,NOMLOI,FC,IMPR,IRET) 152 : IF (IRET.NE.0) GOTO 9999 153 : ELSEIF (NOMLOI(1:3).EQ.'AHU') THEN 153 : CALL CCGAHU(LCOF,NOMLOI,FC,IMPR,IRET) 154 : IF (IRET.NE.0) GOTO 9999 155 : * ELSEIF (NOMLOI(1:3).EQ.'AHP') THEN 155 : * CALL CCGAHP(LCOF,NOMLOI,METRIQ,FC,IMPR,IRET) 156 : * IF (IRET.NE.0) GOTO 9999 157 : ELSEIF ((NOMLOI(1:4).EQ.'QEQU').OR.(NOMLOI(1:4).EQ.'QALI')) THEN 157 : CALL CCGQME(LCOF,NOMLOI,FC,IMPR,IRET) 158 : IF (IRET.NE.0) GOTO 9999 159 : ELSEIF (NOMLOI(1:4).EQ.'D/DX') THEN 159 : CALL CCGRAD(LCOF,NOMLOI,FC,IMPR,IRET) 160 : IF (IRET.NE.0) GOTO 9999 161 : ELSEIF (NOMLOI.EQ.'TAILDIRE') THEN 161 : CALL CCGTDI(LCOF,FC,IMPR,IRET) 162 : IF (IRET.NE.0) GOTO 9999 163 : ELSEIF (NOMLOI(1:6).EQ.'MUSTAB') THEN 163 : CALL CCGMUS(LCOF,NOMLOI,FC,IMPR,IRET) 164 : IF (IRET.NE.0) GOTO 9999 165 : ELSEIF (NOMLOI(1:3).EQ.'TSU') THEN 165 : CALL CCGTSU(LCOF,NOMLOI,FC,IMPR,IRET) 166 : IF (IRET.NE.0) GOTO 9999 167 : ELSEIF (NOMLOI(1:3).EQ.'VNO') THEN 167 : CALL CCGNOR(LCOF,NOMLOI,FC,IMPR,IRET) 168 : IF (IRET.NE.0) GOTO 9999 169 : ELSEIF (NOMLOI(1:4).EQ.'IMET') THEN 169 : CALL CCGIME(LCOF,NOMLOI,FC,IMPR,IRET) 170 : IF (IRET.NE.0) GOTO 9999 171 : ELSE 172 : WRITE(IOIMP,*) 'Loi de comportement ',NOMLOI 173 : WRITE(IOIMP,*) 'non définie dans calcgb' 174 : GOTO 9999 175 : ENDIF 176 : * 177 : * Normal termination 178 : * 179 : IRET=0 180 : RETURN 181 : * 182 : * Format handling 183 : * 184 : * 185 : * Error handling 186 : * 187 : 9999 CONTINUE 188 : IRET=1 189 : WRITE(IOIMP,*) 'An error was detected in subroutine calcgb' 190 : RETURN 191 : * 192 : * End of subroutine CALCGB 193 : * 194 : END 195 : 196 : 197 : 198 : 199 : 200 :
© Cast3M 2003 - All rights reserved.
Disclaimer