1 : C GEOMFT SOURCE GOUNAND 06/08/04 21:16:04 5520 2 : SUBROUTINE GEOMFT(JCOOR,FFPG,SSFACT,NBELEF, 3 : $ JDTJAC,LAXI, 4 : $ JDTJA2, 5 : $ IMPR,IRET) 6 : IMPLICIT REAL*8 (A-H,O-Z) 7 : IMPLICIT INTEGER (I-N) 8 : C*********************************************************************** 9 : C NOM : GEOMFT 10 : C PROJET : Noyau linéaire NLIN 11 : C DESCRIPTION : multiplie par 2piR le determinant 12 : C de la matrice jacobienne 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 CODE RETOUR (IRET) : = 0 si tout s'est bien passé 25 : C*********************************************************************** 26 : C VERSION : v1, 02/10/03, version initiale 27 : C HISTORIQUE : 28 : C HISTORIQUE : 29 : C*********************************************************************** 30 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 31 : C en cas de modification de ce sous-programme afin de faciliter 32 : C la maintenance ! 33 : C*********************************************************************** 34 : -INC CCOPTIO 35 : CBEGININCLUDE SMCHAEL 36 : SEGMENT MCHAEL 37 : POINTEUR IMACHE(N1).MELEME 38 : POINTEUR ICHEVA(N1).MCHEVA 39 : ENDSEGMENT 40 : SEGMENT MCHEVA 41 : REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM) 42 : ENDSEGMENT 43 : SEGMENT LCHEVA 44 : POINTEUR LISCHE(NBCHE).MCHEVA 45 : ENDSEGMENT 46 : CENDINCLUDE SMCHAEL 47 : POINTEUR JCOOR.MCHEVA 48 : POINTEUR JDTJAC.MCHEVA 49 : POINTEUR JDTJA2.MCHEVA 50 : * Valeurs des fns d'interpolation du coeff. aux points de Gauss 51 : POINTEUR FFPG.MCHEVA 52 : CBEGININCLUDE SFACTIV 53 : SEGMENT FACTIV 54 : POINTEUR IFACTI(NBSOUV).SFACTI 55 : ENDSEGMENT 56 : SEGMENT SFACTI 57 : POINTEUR ISFACT(NBSOFV).SSFACT 58 : ENDSEGMENT 59 : SEGMENT SSFACT 60 : LOGICAL LFACTI(NBELFV,NBELEV) 61 : ENDSEGMENT 62 : CENDINCLUDE SFACTIV 63 : * 64 : INTEGER LAXI 65 : INTEGER IMPR,IRET 66 : * 67 : INTEGER NDLIG,NDCOL,N2DLIG,N2DCOL,NDNOEU,NDELM 68 : INTEGER NDDL,IESREL,NBPOGO 69 : * 70 : * Executable statements 71 : * 72 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans geomft' 73 : SEGACT SSFACT 74 : NBELFV=SSFACT.LFACTI(/1) 75 : NBELEV=SSFACT.LFACTI(/2) 76 : IESREL=IDIM 77 : SEGACT JCOOR 78 : NDLIG=JCOOR.VELCHE(/1) 79 : NDCOL=JCOOR.VELCHE(/2) 80 : N2DLIG=JCOOR.VELCHE(/3) 81 : N2DCOL=JCOOR.VELCHE(/4) 82 : NDNOEU=JCOOR.VELCHE(/5) 83 : NDELM=JCOOR.VELCHE(/6) 84 : IF (NDLIG.NE.1.OR.N2DLIG.NE.1.OR.N2DCOL.NE.IESREL. 85 : $ OR.NDNOEU.NE.1.OR.NDELM.NE.NBELEV) THEN 86 : WRITE(IOIMP,*) 'Erreur dims JCOOR' 87 : GOTO 9999 88 : ENDIF 89 : NDDL=NDCOL 90 : SEGACT FFPG 91 : NDLIG=FFPG.VELCHE(/1) 92 : NDCOL=FFPG.VELCHE(/2) 93 : N2DLIG=FFPG.VELCHE(/3) 94 : N2DCOL=FFPG.VELCHE(/4) 95 : NDNOEU=FFPG.VELCHE(/5) 96 : NDELM=FFPG.VELCHE(/6) 97 : IF (NDLIG.NE.1.OR.NDCOL.NE.NDDL.OR.N2DLIG.NE.1 98 : $ .OR.N2DCOL.NE.1.OR.NDELM.NE.NBELFV) THEN 99 : WRITE(IOIMP,*) 'Erreur dims FFPG' 100 : GOTO 9999 101 : ENDIF 102 : NBPOGO=NDNOEU 103 : SEGACT JDTJAC 104 : NDLIG=JDTJAC.VELCHE(/1) 105 : NDCOL=JDTJAC.VELCHE(/2) 106 : N2DLIG=JDTJAC.VELCHE(/3) 107 : N2DCOL=JDTJAC.VELCHE(/4) 108 : NDNOEU=JDTJAC.VELCHE(/5) 109 : NDELM=JDTJAC.VELCHE(/6) 110 : IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.N2DLIG.NE.1 111 : $ .OR.N2DCOL.NE.1 112 : $ .OR.(NDNOEU.NE.NBPOGO.AND.NDNOEU.NE.1) 113 : $ .OR.NDELM.NE.NBELEF) THEN 114 : WRITE(IOIMP,*) 'Erreur dims JDTJAC' 115 : GOTO 9999 116 : ENDIF 117 : NPJAC=NDNOEU 118 : IF (LAXI.EQ.1.OR.LAXI.EQ.3) THEN 119 : NBLIG=1 120 : NBCOL=1 121 : N2LIG=1 122 : N2COL=1 123 : NBPOI=NBPOGO 124 : NBELM=NBELEF 125 : SEGINI JDTJA2 125 : CALL GEOMF1(NDDL,IESREL,NBPOGO,NBELEV,NBELFV,NBELEF, 126 : $ NPJAC, 127 : $ JCOOR.VELCHE,FFPG.VELCHE,SSFACT.LFACTI, 128 : $ JDTJAC.VELCHE,LAXI, 129 : $ JDTJA2.VELCHE, 130 : $ IMPR,IRET) 131 : IF (IRET.NE.0) GOTO 9999 132 : SEGDES JDTJA2 133 : IF (IMPR.GT.3) THEN 134 : WRITE(IOIMP,*) 'On a créé', 135 : $ ' JDTJA2(élément , poi.gauss ,', 136 : $ ' 1,1,1,1)' 136 : CALL PRCHVA(JDTJA2,IMPR,IRET) 137 : IF (IRET.NE.0) GOTO 9999 138 : ENDIF 139 : ELSEIF (LAXI.EQ.2) THEN 140 : NBLIG=1 141 : NBCOL=1 142 : N2LIG=1 143 : N2COL=1 144 : NBPOI=NPJAC 145 : NBELM=NBELEF 146 : SEGINI JDTJA2 146 : CALL GEOME2(NPJAC,NBELEF, 147 : $ JDTJAC.VELCHE,LAXI, 148 : $ JDTJA2.VELCHE, 149 : $ IMPR,IRET) 150 : IF (IRET.NE.0) GOTO 9999 151 : SEGDES JDTJA2 152 : IF (IMPR.GT.3) THEN 153 : WRITE(IOIMP,*) 'On a créé', 154 : $ ' JDTJA2(élément , poi.gauss ,', 155 : $ ' 1,1,1,1)' 155 : CALL PRCHVA(JDTJA2,IMPR,IRET) 156 : IF (IRET.NE.0) GOTO 9999 157 : ENDIF 158 : ELSE 159 : WRITE(IOIMP,*) 'LAXI=',LAXI,' incorrect' 160 : GOTO 9999 161 : ENDIF 162 : SEGDES JDTJAC 163 : SEGDES FFPG 164 : SEGDES JCOOR 165 : SEGDES SSFACT 166 : * 167 : * Normal termination 168 : * 169 : IRET=0 170 : RETURN 171 : * 172 : * Format handling 173 : * 174 : * 175 : * Error handling 176 : * 177 : 9999 CONTINUE 178 : IRET=1 179 : WRITE(IOIMP,*) 'An error was detected in subroutine geomft' 180 : RETURN 181 : * 182 : * End of subroutine GEOMFT 183 : * 184 : END 185 : 186 :
© Cast3M 2003 - All rights reserved.
Disclaimer