1 : C PB402 SOURCE MAGN 10/05/18 21:16:34 6675 2 : SUBROUTINE PB402 3 : &(XREF,X,Y,PG,FN,GR,FM,GM,ND,NP,MP,NG,NPG,NOM2,ITYPI) 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8 (A-H,O-Z) 6 : C************************************************************************ 7 : C 8 : C CALCULE LES FONCTIONS DE FORME D'UN : QUA4 9 : C 10 : C ^ eta 11 : C | 12 : C 1 |________ 13 : C |n4 |n3 14 : C | | 15 : C | | 16 : C |_______|_____>ksi 17 : C 0 1 18 : C n1 n2 19 : C************************************************************************ 20 : 21 : REAL*8 X(NPG),Y(NPG),XREF(ND,NP) 22 : REAL*8 FN(NP,NPG),GR(ND,NP,NPG),PG(NPG) 23 : REAL*8 FM(MP,NPG),GM(ND,MP,NPG) 24 : REAL*8 A,B,C,D,U(6),H(6) 25 : CHARACTER*4 NOM2 26 : C*** 27 : XREF(1,1)=0.D0 28 : XREF(2,1)=0.D0 29 : XREF(1,2)=1.D0 30 : XREF(2,2)=0.D0 31 : XREF(1,3)=1.D0 32 : XREF(2,3)=1.D0 33 : XREF(1,4)=0.D0 34 : XREF(2,4)=1.D0 35 : 36 : C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 37 : NGG=NG*NG 38 : IF(NP.NE.4.OR.ND.NE.2.OR.NGG.NE.NPG) 39 : *WRITE(6,1001)NP,ND,NG,NPG,NGG 39 : IF(NP.NE.4.OR.ND.NE.2.OR.NGG.NE.NPG)CALL ARRET(0) 40 : NP2=NP*ND 41 : C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 41 : CALL CALUHG(U,H,NG) 42 : A=0.D0 43 : B=1.D0 44 : C=0.D0 45 : D=1.D0 46 : IF(ITYPI.EQ.2)THEN 47 : X(1)=0.D0 48 : Y(1)=0.D0 49 : X(2)=1.D0 50 : Y(2)=0.D0 51 : X(3)=1.D0 52 : Y(3)=1.D0 53 : X(4)=0.D0 54 : Y(4)=1.D0 55 : DO 2 L=1,4 56 : PG(L)=1.D0/4.D0 57 : 2 CONTINUE 58 : ELSE 58 : CALL CALG2(A,B,C,D,NG,H,U,X,Y,PG) 59 : ENDIF 60 : DO 1 L=1,NPG 61 : C 62 : FN(1,L)=(X(L)-1.D0)*(Y(L)-1.D0) 63 : FN(2,L)=-X(L)*(Y(L)-1.D0) 64 : FN(3,L)=X(L)*Y(L) 65 : FN(4,L)=-Y(L)*(X(L)-1.D0) 66 : C 67 : GR(1,1,L)=Y(L)-1.D0 68 : GR(2,1,L)=X(L)-1.D0 69 : GR(1,2,L)=-(Y(L)-1.D0) 70 : GR(2,2,L)=-X(L) 71 : GR(1,3,L)=Y(L) 72 : GR(2,3,L)=X(L) 73 : GR(1,4,L)=-Y(L) 74 : GR(2,4,L)=-(X(L)-1.D0) 75 : C 76 : 77 : IF(NOM2.EQ.'P1P1')THEN 78 : FM(1,L)=FN(1,L) 79 : FM(2,L)=FN(2,L) 80 : FM(3,L)=FN(3,L) 81 : FM(4,L)=FN(4,L) 82 : GM(1,1,L)=Y(L)-1.D0 83 : GM(2,1,L)=X(L)-1.D0 84 : GM(1,2,L)=-(Y(L)-1.D0) 85 : GM(2,2,L)=-X(L) 86 : GM(1,3,L)=Y(L) 87 : GM(2,3,L)=X(L) 88 : GM(1,4,L)=-Y(L) 89 : GM(2,4,L)=-(X(L)-1.D0) 90 : ELSE 91 : FM(1,L)=1.D0 92 : GM(1,1,L)=0.D0 93 : GM(2,1,L)=0.D0 94 : ENDIF 95 : 96 : 1 CONTINUE 97 : 98 : C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 99 : C WRITE(6,101) 100 : C WRITE(6,1002)FN 101 : C WRITE(6,1002)GR 102 : C WRITE(6,101) 103 : RETURN 104 : 1002 FORMAT(10(1X,1PE11.4)) 105 : 1001 FORMAT(20(1X,I5)) 106 : 101 FORMAT(1X,'... SUB PB402 ... FN,GR,FX,GX ',9(10H..........)/) 107 : C 108 : END 109 : 110 : 111 : 112 : 113 : 114 :
© Cast3M 2003 - All rights reserved.
Disclaimer