C INCOMS SOURCE GOUNAND 21/06/02 21:16:24 11022 SUBROUTINE INCOMS(MYCOMS,CGEOM2,LERF,IMPR,IRET) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER (I-N) C*********************************************************************** C NOM : INCOMS C PROJET : Noyau linéaire NLIN C DESCRIPTION : Initialise le segment contenant les informations sur C les lois de comportement 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 APPELES (E/S) : C APPELE PAR : C*********************************************************************** C ENTREES : - C SORTIES : MYCOMS C CODE RETOUR (IRET) : = 0 si tout s'est bien passé C*********************************************************************** C VERSION : v1, 10/05/04, version initiale C HISTORIQUE : v1, 10/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 PPARAM -INC CCOPTIO -INC SMELEME POINTEUR CGEOM2.MELEME -INC SMLMOTS POINTEUR LNCOM.MLMOTS -INC TNLIN *-INC SLCOMP POINTEUR MYCOMS.COMPS POINTEUR COCOUR.COMP * INTEGER IMPR,IRET CHARACTER*8 BLANC CHARACTER*8 NCOM INTEGER IDIM0,IDIM1,IDIM2,IDIM3,IDIM4 CHARACTER*1 CDIM0,CDIM1,CDIM2,CDIM3,CDIM4,CMETH,CIH CHARACTER*1 CID * * * Executable statements * IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans incoms' BLANC=' ' NBCOMP=0 SEGINI MYCOMS * * Détermination de la dimension de l'espace de dérivation * IF (LERF.NE.0) THEN CALL DIMESH(CGEOM2,IDMESH,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 IESDER=IDMESH ELSE IESDER=IDIM ENDIF * * Loi de comportement RIEN * NCOM=BLANC NCOM='RIEN' NCOCOF=0 SEGINI COCOUR COCOUR.NOMCOM=NCOM COCOUR.LTREF=.FALSE. SEGDES COCOUR MYCOMS.LISCOM(**)=COCOUR * * Loi de comportement IDEN * NCOM=BLANC NCOM='IDEN' NCOCOF=1 SEGINI COCOUR COCOUR.NOMCOM=NCOM COCOUR.DERCOF(1)=0 COCOUR.LTREF=.FALSE. SEGDES COCOUR MYCOMS.LISCOM(**)=COCOUR * * Loi de comportement rays = epsi * sigma * T^3 * NCOM=BLANC NCOM='RAYS' NCOCOF=3 SEGINI COCOUR COCOUR.NOMCOM=NCOM COCOUR.DERCOF(1)=0 COCOUR.DERCOF(2)=0 COCOUR.DERCOF(3)=0 COCOUR.LTREF=.FALSE. SEGDES COCOUR MYCOMS.LISCOM(**)=COCOUR * * Loi de comportement MUR * NCOM=BLANC NCOM='MUR' NCOCOF=4 SEGINI COCOUR COCOUR.NOMCOM=NCOM COCOUR.DERCOF(1)=0 COCOUR.DERCOF(2)=0 COCOUR.DERCOF(3)=0 COCOUR.DERCOF(4)=0 COCOUR.LTREF=.FALSE. SEGDES COCOUR MYCOMS.LISCOM(**)=COCOUR * * Loi de comportement SUTH * NCOM=BLANC NCOM='SUTH' NCOCOF=3 SEGINI COCOUR COCOUR.NOMCOM=NCOM COCOUR.DERCOF(1)=0 COCOUR.DERCOF(2)=0 COCOUR.DERCOF(3)=0 COCOUR.LTREF=.FALSE. SEGDES COCOUR MYCOMS.LISCOM(**)=COCOUR * * Loi de comportement DDX{1..IESDER} * DO IID=1,IESDER CALL INT2CH(IID,CID,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 NCOM=BLANC NCOM='D/DX' NCOM(5:5)=CID NCOCOF=1 SEGINI COCOUR COCOUR.NOMCOM=NCOM COCOUR.DERCOF(1)=1 COCOUR.LTREF=.FALSE. SEGDES COCOUR MYCOMS.LISCOM(**)=COCOUR ENDDO * * Loi de comportement DIV * NCOM=BLANC NCOM='DIV' NCOCOF=IESDER SEGINI COCOUR COCOUR.NOMCOM=NCOM DO IIDIM=1,IESDER COCOUR.DERCOF(IIDIM)=1 ENDDO COCOUR.LTREF=.FALSE. SEGDES COCOUR MYCOMS.LISCOM(**)=COCOUR * * Loi de comportement MAXI * NCOM=BLANC NCOM='MAXI' NCOCOF=1 SEGINI COCOUR COCOUR.NOMCOM=NCOM COCOUR.DERCOF(1)=0 COCOUR.LTREF=.FALSE. SEGDES COCOUR MYCOMS.LISCOM(**)=COCOUR * * Loi de comportement TAU * NCOM=BLANC NCOM='TAU' NCOCOF=5 SEGINI COCOUR COCOUR.NOMCOM=NCOM COCOUR.DERCOF(1)=0 COCOUR.DERCOF(2)=0 COCOUR.DERCOF(3)=0 COCOUR.DERCOF(4)=0 COCOUR.DERCOF(5)=0 COCOUR.LTREF=.FALSE. SEGDES COCOUR MYCOMS.LISCOM(**)=COCOUR * * Loi de comportement SIGMA * NCOM=BLANC NCOM='SIGMA' NCOCOF=5 SEGINI COCOUR COCOUR.NOMCOM=NCOM COCOUR.DERCOF(1)=0 COCOUR.DERCOF(2)=0 COCOUR.DERCOF(3)=0 COCOUR.DERCOF(4)=0 COCOUR.DERCOF(5)=0 COCOUR.LTREF=.FALSE. SEGDES COCOUR MYCOMS.LISCOM(**)=COCOUR * * Loi de comportement TAILDIRE * NCOM=BLANC NCOM='TAILDIRE' NCOCOF=IDIM SEGINI COCOUR COCOUR.NOMCOM=NCOM DO IIDIM=1,IDIM COCOUR.DERCOF(IIDIM)=0 ENDDO COCOUR.LTREF=.TRUE. SEGDES COCOUR MYCOMS.LISCOM(**)=COCOUR * * Loi de comportement VOLORI * NCOM=BLANC NCOM='VOLORI' NCOCOF=0 SEGINI COCOUR COCOUR.NOMCOM=NCOM COCOUR.LTREF=.TRUE. SEGDES COCOUR MYCOMS.LISCOM(**)=COCOUR * * Loi de comportement MADSMID * max |d|/min|d| où d=det J * avec un signe moins si d change de signe * NCOM=BLANC NCOM='MADSMID' NCOCOF=0 SEGINI COCOUR COCOUR.NOMCOM=NCOM COCOUR.LTREF=.TRUE. SEGDES COCOUR MYCOMS.LISCOM(**)=COCOUR * * Loi de comportement AHUF : Huang * AHPF : Huang préconditionné * DO ICOPO=1,2 IF (ICOPO.EQ.1) THEN CIH='U' ELSE CIH='P' ENDIF NARG=2 NCOM=BLANC NCOM='AH?F' NCOM(3:3)=CIH NCOCOF=((IDIM*(IDIM+1))/2)+NARG SEGINI COCOUR COCOUR.NOMCOM=NCOM * Plus clair, mais inutile * DO ICOCOF=1,NCOCOF * COCOUR.DERCOF(ICOCOF)=0 * ENDDO COCOUR.LTREF=.TRUE. SEGDES COCOUR MYCOMS.LISCOM(**)=COCOUR * * Lois de comportement AHUR{1..idim}*{0..iesder} * DO IDIM1=1,IDIM CALL INT2CH(IDIM1,CDIM1,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 DO IDIM2=0,IESDER CALL INT2CH(IDIM2,CDIM2,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 NCOM=BLANC NCOM='AH?R' NCOM(3:3)=CIH NCOM(5:5)=CDIM1 NCOM(6:6)=CDIM2 NCOCOF=((IDIM*(IDIM+1))/2)+NARG SEGINI COCOUR COCOUR.NOMCOM=NCOM COCOUR.LTREF=.TRUE. SEGDES COCOUR MYCOMS.LISCOM(**)=COCOUR ENDDO ENDDO * * Lois de comportement AHUJ{1..idim}*4 * DO IDIM1=1,IDIM CALL INT2CH(IDIM1,CDIM1,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 DO IDIM2=0,IESDER CALL INT2CH(IDIM2,CDIM2,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 DO IDIM3=1,IDIM CALL INT2CH(IDIM3,CDIM3,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 DO IDIM4=0,IESDER CALL INT2CH(IDIM4,CDIM4,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 NCOM=BLANC NCOM='AH?J' NCOM(3:3)=CIH NCOM(5:5)=CDIM1 NCOM(6:6)=CDIM2 NCOM(7:7)=CDIM3 NCOM(8:8)=CDIM4 NCOCOF=((IDIM*(IDIM+1))/2)+NARG SEGINI COCOUR COCOUR.NOMCOM=NCOM COCOUR.LTREF=.TRUE. SEGDES COCOUR MYCOMS.LISCOM(**)=COCOUR ENDDO ENDDO ENDDO ENDDO ENDDO * * Loi de comportement Qualité de maillage * DO IQ=1,2 NCOM=BLANC IF (IQ.EQ.1) THEN NCOM='QEQU' ELSE NCOM='QALI' ENDIF NCOCOF=((IDIM*(IDIM+1))/2) SEGINI COCOUR COCOUR.NOMCOM=NCOM COCOUR.LTREF=.TRUE. SEGDES COCOUR MYCOMS.LISCOM(**)=COCOUR ENDDO * * Lois de comportement MUSTAB{1,2,3}{1..idim} * (viscosité numérique) * DO IMETH=1,3 CALL INT2CH(IMETH,CMETH,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 DO IDIM1=0,IDIM CALL INT2CH(IDIM1,CDIM1,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 NCOM=BLANC NCOM='MUSTAB' NCOM(7:7)=CMETH NCOM(8:8)=CDIM1 NCOCOF=IDIM+3 SEGINI COCOUR COCOUR.NOMCOM=NCOM COCOUR.LTREF=.TRUE. SEGDES COCOUR MYCOMS.LISCOM(**)=COCOUR ENDDO ENDDO * * Loi de comportement TSUF : Tension de surface * NCOM=BLANC NCOM='TSUF' NCOCOF=1 SEGINI COCOUR COCOUR.NOMCOM=NCOM COCOUR.LTREF=.TRUE. SEGDES COCOUR MYCOMS.LISCOM(**)=COCOUR * * Lois de comportement TSUR{1..idim}*{0..iesder} * DO IDIM1=0,IDIM CALL INT2CH(IDIM1,CDIM1,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 DO IDIM2=0,IESDER CALL INT2CH(IDIM2,CDIM2,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 NCOM=BLANC NCOM='TSUR' NCOM(5:5)=CDIM1 NCOM(6:6)=CDIM2 NCOCOF=1 SEGINI COCOUR COCOUR.NOMCOM=NCOM COCOUR.LTREF=.TRUE. SEGDES COCOUR MYCOMS.LISCOM(**)=COCOUR ENDDO ENDDO * * Lois de comportement TSUJ{1..idim}*4 * DO IDIM1=1,IDIM CALL INT2CH(IDIM1,CDIM1,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 DO IDIM2=0,IESDER CALL INT2CH(IDIM2,CDIM2,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 DO IDIM3=1,IDIM CALL INT2CH(IDIM3,CDIM3,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 DO IDIM4=0,IESDER CALL INT2CH(IDIM4,CDIM4,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 NCOM=BLANC NCOM='TSUJ' NCOM(5:5)=CDIM1 NCOM(6:6)=CDIM2 NCOM(7:7)=CDIM3 NCOM(8:8)=CDIM4 NCOCOF=1 SEGINI COCOUR COCOUR.NOMCOM=NCOM COCOUR.LTREF=.TRUE. SEGDES COCOUR MYCOMS.LISCOM(**)=COCOUR ENDDO ENDDO ENDDO ENDDO * * Lois de comportement TSU{1..4}{1..idim}*4 * DO IDIM0=1,4 CALL INT2CH(IDIM0,CDIM0,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 DO IDIM1=1,IDIM CALL INT2CH(IDIM1,CDIM1,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 DO IDIM2=0,IESDER CALL INT2CH(IDIM2,CDIM2,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 DO IDIM3=1,IDIM CALL INT2CH(IDIM3,CDIM3,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 DO IDIM4=0,IESDER CALL INT2CH(IDIM4,CDIM4,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 NCOM=BLANC NCOM='TSU' NCOM(4:4)=CDIM0 NCOM(5:5)=CDIM1 NCOM(6:6)=CDIM2 NCOM(7:7)=CDIM3 NCOM(8:8)=CDIM4 NCOCOF=1 SEGINI COCOUR COCOUR.NOMCOM=NCOM COCOUR.LTREF=.TRUE. SEGDES COCOUR MYCOMS.LISCOM(**)=COCOUR ENDDO ENDDO ENDDO ENDDO ENDDO * * Lois de comportement VNOR{1..idim} * DO IDIM1=1,IDIM CALL INT2CH(IDIM1,CDIM1,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 NCOM=BLANC NCOM='VNOR' NCOM(5:5)=CDIM1 NCOCOF=0 SEGINI COCOUR COCOUR.NOMCOM=NCOM COCOUR.LTREF=.TRUE. SEGDES COCOUR MYCOMS.LISCOM(**)=COCOUR ENDDO * * Lois de comportement VNOJ{1..idim}*3 * DO IDIM1=1,IDIM CALL INT2CH(IDIM1,CDIM1,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 DO IDIM2=0,IDIM CALL INT2CH(IDIM2,CDIM2,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 DO IDIM3=1,IDIM CALL INT2CH(IDIM3,CDIM3,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 NCOM=BLANC NCOM='VNOJ' NCOM(5:5)=CDIM1 NCOM(6:6)=CDIM2 NCOM(7:7)=CDIM3 NCOCOF=0 SEGINI COCOUR COCOUR.NOMCOM=NCOM COCOUR.LTREF=.TRUE. SEGDES COCOUR MYCOMS.LISCOM(**)=COCOUR ENDDO ENDDO ENDDO * * Lois de comportement IMET{1..idim}{idim1..idim} * DO IDIM1=1,IDIM CALL INT2CH(IDIM1,CDIM1,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 DO IDIM2=IDIM1,IDIM CALL INT2CH(IDIM2,CDIM2,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 NCOM=BLANC NCOM='IMET' NCOM(5:5)=CDIM1 NCOM(6:6)=CDIM2 NCOCOF=0 SEGINI COCOUR COCOUR.NOMCOM=NCOM COCOUR.LTREF=.TRUE. SEGDES COCOUR MYCOMS.LISCOM(**)=COCOUR ENDDO ENDDO * * Loi de comportement X1 : première coordonnée des noeuds * Uniquement si mode AXI car sinon JPc non définie (cf. nlin.eso) * IF (IFOMOD.NE.-1) THEN NCOM=BLANC NCOM='X1' NCOCOF=0 SEGINI COCOUR COCOUR.NOMCOM=NCOM COCOUR.LTREF=.TRUE. SEGDES COCOUR MYCOMS.LISCOM(**)=COCOUR ENDIF * * Impression finale * IF (IMPR.GT.1) THEN SEGPRT,MYCOMS NBCOMP=MYCOMS.LISCOM(/1) DO IBCOMP=1,NBCOMP COCOUR=MYCOMS.LISCOM(IBCOMP) SEGPRT,COCOUR ENDDO ENDIF SEGDES MYCOMS * * Normal termination * IRET=0 RETURN * * Format handling * * * Error handling * 9999 CONTINUE IRET=1 WRITE(IOIMP,*) 'An error was detected in subroutine incoms' RETURN * * End of subroutine INCOMS * END