Télécharger kxl.eso

Retour à la liste

kxl
C KXL       SOURCE    CHAT      05/01/13    01:11:42     5004
      SUBROUTINE KXL(NOMS,TYPE,XL)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
      PARAMETER (NBE=18)
      CHARACTER*8 NOMS,LISTE(NBE)
      CHARACTER*2 TYPE
      DIMENSION XL(3,4)
      DATA LISTE/'SEG3    ','TRI6    ','QUA8    ','TRI7    ','QUA9    ',
     &'CU27    ','PR21    ','TE15    ','PY19    ',
     &'PR18    ','PY14    ',
     &'SEG4    ','TR12    ','QU16    ','CU64    ','PR48    ','TE32    ',
     &'PY57    '/
 
      IF(TYPE.EQ.'P0')THEN
C CENTRE P0
      CALL OPTLI(IP,LISTE,NOMS,NBE)
      IF(IP.EQ.0)RETURN
      GO TO (301,602,802,602,802,2703,2103,1503,1903,2103,1903),IP
 
 301  CONTINUE
      XL(1,1)=0.5D0
      XL(2,1)=0.D0
      XL(3,1)=0.D0
      RETURN
 
 602  CONTINUE
      R2=SQRT(2.D0)
      XL(1,1)=R2/3.D0
      XL(2,1)=R2/3.D0
      XL(3,1)=0.D0
      RETURN
 
 802  CONTINUE
      XL(1,1)=0.5D0
      XL(2,1)=0.5D0
      XL(3,1)=0.D0
      RETURN
 
 2703 CONTINUE
      XL(1,1)=0.5D0
      XL(2,1)=0.5D0
      XL(3,1)=0.5D0
      RETURN
 
 2103 CONTINUE
      R2=SQRT(2.D0)
      XL(1,1)=R2/3.D0
      XL(2,1)=R2/3.D0
      XL(3,1)=0.5D0
      RETURN
 
 1503 CONTINUE
      R2=SQRT(2.D0)
      XL(1,1)=R2/3.D0
      XL(2,1)=R2/3.D0
      XL(3,1)=R2/3.D0
      RETURN
 
 1903 CONTINUE
      XL(1,1)=0.5D0
      XL(2,1)=0.5D0
      XL(3,1)=0.5D0
      RETURN
 
 
      ELSEIF(TYPE.EQ.'P1')THEN
C CENTRE P1
 
      CALL OPTLI(IP,LISTE,NOMS,NBE)
      IF(IP.EQ.0)RETURN
      GO TO (1301,1602,1802,1602,1802,12703,12103,11503,
     &11903,12103,11903),IP
 
 1301 CONTINUE
      XL(1,1)=0.25D0
      XL(2,1)=0.D0
      XL(3,1)=0.D0
      XL(1,2)=0.75D0
      XL(2,2)=0.D0
      XL(3,2)=0.D0
      RETURN
 
 1602 CONTINUE
      R2=SQRT(2.D0)
      XL(1,1)=R2/6.D0
      XL(2,1)=R2/6.D0
      XL(3,1)=0.D0
      XL(1,2)=4.D0*R2/6.D0
      XL(2,2)=R2/6.D0
      XL(3,2)=0.D0
      XL(1,3)=R2/6.D0
      XL(2,3)=4.D0*R2/6.D0
      XL(3,3)=0.D0
      RETURN
 
 1802 CONTINUE
      XL(1,1)=0.75D0
      XL(2,1)=0.75D0
      XL(3,1)=0.D0
      XL(1,2)=0.25D0
      XL(2,2)=0.5D0
      XL(3,2)=0.D0
      XL(1,3)=0.5D0
      XL(2,3)=0.25D0
      XL(3,3)=0.D0
      RETURN
 
12703 CONTINUE
      XL(1,1)=0.75D0
      XL(2,1)=0.75D0
      XL(3,1)=0.25D0
      XL(1,2)=0.25D0
      XL(2,2)=0.5D0
      XL(3,2)=0.25D0
      XL(1,3)=0.5D0
      XL(2,3)=0.25D0
      XL(3,3)=0.25D0
      XL(1,4)=0.5D0
      XL(2,4)=0.25D0
      XL(3,4)=0.75D0
      RETURN
 
12103 CONTINUE
      R2=SQRT(2.D0)
      XL(1,1)=R2/6.D0
      XL(2,1)=R2/6.D0
      XL(3,1)=0.25D0
      XL(1,2)=2.D0*R2/3.D0
      XL(2,2)=R2/6.D0
      XL(3,2)=0.75D0
      XL(1,3)=R2/6.D0
      XL(2,3)=2.D0*R2/3.D0
      XL(3,3)=0.25D0
      XL(1,4)=R2/3.D0
      XL(2,4)=R2/3.D0
      XL(3,4)=0.75D0
      RETURN
11503 CONTINUE
      R2=SQRT(6.D0)
      XL(1,1)=R2*0.25D0
      XL(2,1)=R2*0.25D0
      XL(3,1)=0.25D0
      XL(1,2)=R2*0.75D0
      XL(2,2)=R2*0.25D0
      XL(3,2)=0.25D0
      XL(1,3)=R2*0.75D0
      XL(2,3)=R2*0.75D0
      XL(3,3)=0.25D0
      XL(1,3)=R2*0.25D0
      XL(2,3)=R2*0.25D0
      XL(3,3)=0.75D0
      RETURN
11903 CONTINUE
      RETURN
 
      ENDIF
      END
 
 
 
 
 
 

© Cast3M 2003 - Tous droits réservés.
Mentions légales