1 : C PROLRF SOURCE GOUNAND 05/12/21 21:35:54 5281 2 : SUBROUTINE PROLRF(ELPRO1,ELPRO2, 3 : $ ELCOUR, 4 : $ IMPR,IRET) 5 : IMPLICIT REAL*8 (A-H,O-Z) 6 : IMPLICIT INTEGER (I-N) 7 : C*********************************************************************** 8 : C NOM : PROLRF 9 : C PROJET : Noyau linéaire NLIN 10 : C DESCRIPTION : Construit les coordonnées des noeuds d'éléments produits 11 : C (ex : prisme = triangle * segment) 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 : INELPR, INELCU 20 : C*********************************************************************** 21 : C ENTREES : ELPRO1, ELPRO2 22 : C ENTREES/SORTIES : ELCOUR (supposé actif en *MOD) 23 : C SORTIES : - 24 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 25 : C*********************************************************************** 26 : C VERSION : v1, 28/04/2000, version initiale 27 : C HISTORIQUE : v1, 28/04/2000, 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 : CBEGININCLUDE SELREF 37 : SEGMENT ELREF 38 : CHARACTER*(LNNOM) NOMLRF 39 : CHARACTER*(LNFORM) FORME 40 : CHARACTER*(LNTYPL) TYPEL 41 : CHARACTER*(LNESP) ESPACE 42 : INTEGER DEGRE 43 : REAL*8 XCONOD(NDIMEL,NBNOD) 44 : INTEGER NPQUAF(NBDDL) 45 : INTEGER NUMCMP(NBDDL) 46 : INTEGER QUENOD(NBDDL) 47 : INTEGER ORDDER(NDIMEL,NBDDL) 48 : POINTEUR MBPOLY.POLYNS 49 : ENDSEGMENT 50 : SEGMENT ELREFS 51 : POINTEUR LISEL(0).ELREF 52 : ENDSEGMENT 53 : CENDINCLUDE SELREF 54 : POINTEUR ELCOUR.ELREF 55 : POINTEUR ELPRO1.ELREF 56 : POINTEUR ELPRO2.ELREF 57 : * 58 : INTEGER IMPR,IRET 59 : * 60 : INTEGER NBNOD1,NBNOD2,NBNODC 61 : INTEGER IBNOD1,IBNOD2,IBNODC 62 : INTEGER NDIML1,NDIML2,NDIMLC 63 : INTEGER IDIML1,IDIML2,IDIMLC 64 : * 65 : * Executable statements 66 : * 67 : IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans prolrf.eso' 68 : SEGACT ELPRO1 69 : SEGACT ELPRO2 70 : NDIML1=ELPRO1.XCONOD(/1) 71 : NBNOD1=ELPRO1.XCONOD(/2) 72 : NDIML2=ELPRO2.XCONOD(/1) 73 : NBNOD2=ELPRO2.XCONOD(/2) 74 : NDIMLC=ELCOUR.XCONOD(/1) 75 : NBNODC=ELCOUR.XCONOD(/2) 76 : IF ((NDIML1+NDIML2).NE.NDIMLC) THEN 77 : WRITE(IOIMP,*) 'Err. dim. esp.' 78 : GOTO 9999 79 : ENDIF 80 : IF ((NBNOD1*NBNOD2).NE.NBNODC) THEN 81 : WRITE(IOIMP,*) 'Err. nb. noeud.' 82 : GOTO 9999 83 : ENDIF 84 : IBNODC=0 85 : DO 1 IBNOD2=1,NBNOD2 86 : DO 12 IBNOD1=1,NBNOD1 87 : IBNODC=IBNODC+1 88 : IDIMLC=0 89 : DO 122 IDIML1=1,NDIML1 90 : IDIMLC=IDIMLC+1 91 : ELCOUR.XCONOD(IDIMLC,IBNODC)= 92 : $ ELPRO1.XCONOD(IDIML1,IBNOD1) 93 : 122 CONTINUE 94 : DO 124 IDIML2=1,NDIML2 95 : IDIMLC=IDIMLC+1 96 : ELCOUR.XCONOD(IDIMLC,IBNODC)= 97 : $ ELPRO2.XCONOD(IDIML2,IBNOD2) 98 : 124 CONTINUE 99 : 12 CONTINUE 100 : 1 CONTINUE 101 : SEGDES ELPRO2 102 : SEGDES ELPRO1 103 : * 104 : * Normal termination 105 : * 106 : IRET=0 107 : RETURN 108 : * 109 : * Format handling 110 : * 111 : * 112 : * Error handling 113 : * 114 : 9999 CONTINUE 115 : IRET=1 116 : WRITE(IOIMP,*) 'An error was detected in subroutine prolrf' 117 : RETURN 118 : * 119 : * End of subroutine PROLRF 120 : * 121 : END 122 : 123 : 124 :
© Cast3M 2003 - All rights reserved.
Disclaimer