Liren Large Software Subsidy 9

home *** CD-ROM | disk | FTP | other *** search

/ Liren Large Software Subsidy 9 / 09.iso / e / e003 / 14.ddi / MOD1.FOR next >

Wrap

Text File | 1987-04-18 | 61.8 KB | 773 lines

SUBROUTINE PRTERR(I) MOD05167 COMMON/UNIT/IN,IO MOD05168 COMMON/FRECNT/LINE(80) MOD05169 IF(I.NE.0)GO TO 300 MOD05170 WRITE(IO,303)LINE MOD05171 303 FORMAT(' ++ SYNTAX ERROR ON BELOW LINE +++ ',/,2X,80A1) MOD05172 STOP MOD05173 300 GO TO (1,2,3,4,5,6,7,8,9,10),I MOD05174 1 WRITE(IO,101) MOD05175 101 FORMAT(' ++ F ++ TOTAL NUMBER OF NODES OR ELEMENTS ARE ZERO' MOD05176 1,/,' CHECK YOUR INPUT FOR TOTAL NUMBER OF NODES OR ELEMENTS')MOD05177 STOP MOD05178 2 WRITE(IO,102) MOD05179 102 FORMAT(' ++ F ++ CORNER NODE SHOULD NOT BE ZERO ,CHECK MOD05180 1YOUR INPUT ') MOD05181 STOP MOD05182 3 WRITE(IO,103) MOD05183 103 FORMAT(' ++ F ++ SURFACE GENERATION WILL BE TERMINATED MOD05184 1BECAUSE ;' MOD05185 2,/,' EITHER SOME OF THE SUPPLIED CORNER NODE NUMBER MOD05186 3ARE WRONG ' MOD05187 4,/,' OR THE INCREMENT ARE WRONG , CHECK YOUR INPUT ') MOD05188 STOP MOD05189 4 WRITE(IO,104) MOD05190 104 FORMAT(' ++ F +++ NEGATIVE NODE NUMBER SPECIFIED FOR VOLUME MOD05191 1GENERATION ' MOD05192 2,/,' CHECK YOUR INPUT ') MOD05193 STOP MOD05194 5 WRITE(IO,105) MOD05195 105 FORMAT(' ++ F ++ VOLUME GENERATION IS BEING TERMINATED ,' MOD05196 1,/,' CHECK ALL CORNER NODE NUMBERS ') MOD05197 STOP MOD05198 6 WRITE(IO,106) MOD05199 106 FORMAT(' ++ F ++ MESH GENERATION IS NOT AVILABEL ') MOD05200 STOP MOD05201 7 WRITE(IO,107) MOD05202 107 FORMAT(' ++ F ++ TOTAL GENRATED NODES ARE EXCEEDED THAN ::' MOD05203 1,/,' WHAT YOU SPECIFY IN YOUR INPUT') MOD05204 STOP MOD05205 8 WRITE(IO,108) MOD05206 108 FORMAT(' ++ F ++ INSUFFICIENCE STORAGE ...' MOD05207 1,/,11X,' INCREASE THE SIZE OF ARRARY A IN COMMON A ') MOD05208 STOP MOD05209 9 WRITE(IO,109) MOD05210 109 FORMAT(' ++ F ++ TOTAL GENERATED ELEMENTS ARE EXCEEDED THAN::' MOD05211 1,/,11X,' WHAT YOU SPECIFY IN YOUR INPUT ') MOD05212 STOP MOD05213 10 WRITE(IO,110)LINE MOD05214 110 FORMAT(' ++ F ++ ELEMENT NUMBER IS LESS OR EQUAL ZERO ON LINE :' MOD05215 1,/,2X,80A1) MOD05216 STOP MOD05217 END MOD05218 SUBROUTINE FCOPY1 MOD02474 COMMON/ETITLE/TITLE(20) MOD02475 COMMON/TOTAL/MAXELM,MAXNOD,MAXNDM MOD02476 COMMON/UNIT/IN,IO,IP,INP,INPF,ITER,IS6 MOD02477 DIMENSION IB(6),IC(8),IA(20) MOD02478 DATA BLANK/1H / MOD02479 REWIND 51 MOD02480 REWIND IS6 MOD02481 WRITE(IS6,2)TITLE MOD02482 WRITE(IS6,4)MAXNOD,MAXELM,MAXNDM MOD02483 2 FORMAT(20A4) MOD02484 4 FORMAT(3I5) MOD02485 DO 10 J=1,MAXNOD MOD02486 READ(51)(IB(K),K=1,6),N,X,Y,Z MOD02487 WRITE(IS6,11)N,(IB(K),K=1,6),X,Y,Z MOD02488 11 FORMAT(7I5,3F10.3) MOD02489 10 CONTINUE MOD02490 12 FORMAT(A4) MOD02491 DO 20 J=1,MAXELM MOD02492 READ(51)I,MT,(IC(K),K=1,8),N1,N2,N3,N4 MOD02493 WRITE(IS6,21)I,MT,(IC(K),K=1,8),N1,N2,N3,N4 MOD02494 21 FORMAT(14I5) MOD02495 IF(MT.EQ.10.OR.MT.EQ.16)GO TO 25 MOD02496 GO TO 20 MOD02497 25 READ(51)(IA(K),K=1,12) MOD02498 WRITE(IS6,26)(IA(K),K=1,12) MOD02499 26 FORMAT(12I5) MOD02500 20 CONTINUE MOD02501 RETURN MOD02502 END MOD02503 SUBROUTINE PRCOOR(LIMIT,NSTOR,X,Y,Z,IBON,ISENEW) MOD04819 INTEGER BLANK MOD04820 REAL*8 X1,Y1,Z1 MOD04821 COMMON/UNIT/IN,IO,IPL,INP,INPF MOD04822 COMMON/SEQUEN/ISEQU,ISTART,INCRE MOD04823 COMMON/SAP6/ISAP6 MOD04824 COMMON/TOTAL/MAXELM,MAXNOD,MAXNDM MOD04825 COMMON/ETITLE/TITLE(20) MOD04826 DIMENSION IBON(LIMIT,6),NSTOR(LIMIT),X(LIMIT),Y(LIMIT),Z(LIMIT) MOD04827 1,ISENEW(LIMIT) MOD04828 DATA BLANK/1H / MOD04829 LIMIT1=LIMIT MOD04830 IZERO=0 MOD04831 IUSA=0 MOD04832 KNN=0 MOD04833 MITWO=-2 MOD04834 IF(ISEQU.EQ.0)GO TO 5 MOD04835 K=1 MOD04836 J=0 MOD04837 DO 3 I=1,LIMIT MOD04838 IF(NSTOR(I).LE.0)GO TO 3 MOD04839 KO=NSTOR(I) MOD04840 NSTOR(I)=0 MOD04841 KN=ISTART+J MOD04842 NSTOR(K)=KN MOD04843 X(K)=X(I) MOD04844 Y(K)=Y(I) MOD04845 Z(K)=Z(I) MOD04846 ISENEW(KO)=KN MOD04847 K=K+1 MOD04848 J=J+INCRE MOD04849 DO 2 MM=1,6 MOD04850 IBON(KN,MM)=IBON(KO,MM) MOD04851 IF(KO.EQ.KN)GO TO 2 MOD04852 IBON(KO,MM)=0 MOD04853 2 CONTINUE MOD04854 3 CONTINUE MOD04855 5 WRITE(IPL,10)TITLE MOD04856 WRITE(IPL,11)MITWO MOD04857 10 FORMAT(20A4) MOD04858 WRITE(IPL,11)LIMIT1 MOD04859 11 FORMAT(5X,I5) MOD04860 I=0 MOD04861 ICO=0 MOD04862 20 I=I+1 MOD04863 IF(I.GT.LIMIT)GO TO 100 MOD04864 IF(NSTOR(I).LE.0)GO TO 20 MOD04865 ICO=ICO+1 MOD04866 J=NSTOR(I) MOD04867 WRITE(IPL,11)J MOD04868 WRITE(IPL,12)X(J),Y(J),Z(J) MOD04869 WRITE(15,15)J,(IBON(J,KK1),KK1=1,6) MOD04870 15 FORMAT(7I5) MOD04871 12 FORMAT(3E12.5) MOD04872 X1=X(J) MOD04873 Y1=Y(J) MOD04874 Z1=Z(J) MOD04875 IF(ISAP6.NE.1)GO TO 25 MOD04876 WRITE(51)(IBON(J,MM),MM=1,6),J,X(J),Y(J),Z(J) MOD04877 GO TO 20 MOD04878 25 WRITE(INP)BLANK,J,BLANK,(IBON(J,MM),MM=1,6),X1,Y1,Z1,KNN MOD04879 WRITE(INPF,30)BLANK,J,BLANK,(IBON(J,MM),MM=1,6),X(J),Y(J),Z(J),KNNMOD04880 30 FORMAT(A1,I4,A1,I4,5I5,3F10.3,I5) MOD04881 GO TO 20 MOD04882 100 IF(ICO.EQ.LIMIT1)GO TO 110 MOD04883 WRITE(IO,200)ICO MOD04884 200 FORMAT(' ++ W ++ TOTAL NODES GENERATED ARE =',I5) MOD04885 REWIND IPL MOD04886 REWIND INP MOD04887 REWIND INPF MOD04888 REWIND 15 MOD04889 REWIND 51 MOD04890 LIMIT1=ICO MOD04891 IUSA=1 MOD04892 GO TO 5 MOD04893 110 WRITE(IPL,11)IZERO MOD04894 101 FORMAT(A1) MOD04895 MAXNOD=LIMIT1 MOD04896 IF(IUSA.EQ.1)RETURN MOD04897 WRITE(IO,300)LIMIT1 MOD04898 300 FORMAT(' . . . TOTAL NODES GENERATED ARE = ',I5) MOD04899 RETURN MOD04900 END MOD04901 SUBROUTINE PRELEM(LIMIT,NUMEL,MTYP,IPS,MATRI,THICK,BETA,ICON,IELD MOD04986 1,IELX,NTEMP,DENSIT,AREA,CDIS,CVEL,GAUSS1,ISENEW) MOD04987 REAL*8 XBETA,XTHIC MOD04988 COMMON/UNIT/IN,IO,IPL,INP,INPF MOD04989 COMMON/ELARRY/NELAR(4,20) MOD04990 COMMON/SEQUEN/ISEQU MOD04991 COMMON/SAP6/ISAP6 MOD04992 COMMON/EGROUP/ITYPEL,NONTYP MOD04993 COMMON/TOTAL/MAXELM,ID001,ID002,MAXGRO MOD04994 DIMENSION MTYP(NUMEL),IPS(NUMEL),MATRI(NUMEL),THICK(NUMEL) MOD04995 1,BETA(NUMEL),ICON(NUMEL,20),ICC(20),IELD(NUMEL),IELX(NUMEL) MOD04996 2,NTEMP(NUMEL),DENSIT(NUMEL),AREA(NUMEL),CDIS(NUMEL) MOD04997 3,CVEL(NUMEL),GAUSS1(LIMIT,2),ISENEW(LIMIT) MOD04998 &,KDUM(9) MOD04999 DATA BLANK/1H / MOD05000 LOMGRO=MAXGRO+1 MOD05001 IF(ISEQU.EQ.0)GO TO 5 MOD05002 DO 3 I=1,NUMEL MOD05003 IF(MTYP(I).EQ.0)GO TO 3 MOD05004 DO 2 J=1,20 MOD05005 KO=ICON(I,J) MOD05006 IF(KO.EQ.0)GO TO 2 MOD05007 KN=ISENEW(KO) MOD05008 ICON(I,J)=KN MOD05009 2 CONTINUE MOD05010 3 CONTINUE MOD05011 5 CONTINUE MOD05012 11 FORMAT(5X,I5) MOD05013 I=0 MOD05014 ICO=0 MOD05015 20 I=I+1 MOD05016 IF(I.GT.NUMEL)GO TO 100 MOD05017 IF(MTYP(I).EQ.0)GO TO 20 MOD05018 ICO=ICO+1 MOD05019 MT=IABS(MTYP(I)) MOD05020 MH=IELD(I) MOD05021 IF(MH.LE.0)MH=NELAR(1,MT) MOD05022 IELD(I)=MH MOD05023 MT11=MT MOD05024 IF(MT.NE.16)GO TO 450 MOD05025 IELT=IELX(I) MOD05026 IF(IELX(I).EQ.5)IELT=1 MOD05027 IF(IELX(I).EQ.7)IELT=1 MOD05028 IF(IELT.NE.1)GO TO 450 MOD05029 IF(NELAR(1,MT).EQ.3)NELAR(1,MT)=4 MOD05030 IF(NELAR(1,MT).EQ.6)NELAR(1,MT)=8 MOD05031 IF(NELAR(1,MT).EQ.7)NELAR(1,MT)=9 MOD05032 DO 410 IAG=1,3 MOD05033 KDUM(IAG)=ICON(I,IAG) MOD05034 410 KDUM(IAG+3)=ICON(I,IAG+2) MOD05035 DO 420 IAG=6,7 MOD05036 420 KDUM(IAG+2)=ICON(I,IAG) MOD05037 KDUM(7)=ICON(I,3) MOD05038 IF(IELD(I).EQ.3)KDUM(7)=0 MOD05039 MH11=NELAR(1,MT) MOD05040 WRITE(50)MT11,LOMGRO,MH11,DENSIT(I),AREA(I) MOD05041 WRITE(50)I,(KDUM(J),J=1,MH11) MOD05042 GO TO 460 MOD05043 450 CONTINUE MOD05044 MH11=NELAR(1,MT) MOD05045 WRITE(50)MT11,LOMGRO,MH11,DENSIT(I),AREA(I) MOD05046 14 FORMAT(5X,I5,6X,I5) MOD05047 WRITE(50)I,(ICON(I,J),J=1,MH11) MOD05048 460 CONTINUE MOD05049 IF(ISAP6.NE.1)GO TO 17 MOD05050 N22=THICK(I) MOD05051 N33=BETA(I) MOD05052 WRITE(51)I,MT,(ICON(I,L1),L1=1,8),MATRI(I),N22,N33,IPS(I) MOD05053 IF(MT.EQ.10.OR.MT.EQ.16)GO TO 19 MOD05054 GO TO 20 MOD05055 19 WRITE(51)(ICON(I,L1),L1=9,20) MOD05056 GO TO 20 MOD05057 17 IONE=1 MOD05058 IZERO=0 MOD05059 IK8=8 MOD05060 IF(MT.NE.1)GO TO 25 MOD05061 XBETA=BETA(I) MOD05062 IF(MTYP(I).EQ.-1)GO TO 32 MOD05063 WRITE(INP)I,ICON(I,1),ICON(I,2),MATRI(I),XBETA,IPS(I),IZERO MOD05064 WRITE(INPF,26)I,ICON(I,1),ICON(I,2),MATRI(I),BETA(I),IPS(I),IZERO MOD05065 26 FORMAT(4I5,F10.3,2I5) MOD05066 27 FORMAT(4I5,F10.3,2I5,I5,F10.3,I5,2F10.3) MOD05067 GO TO 20 MOD05068 32 WRITE(INP)I,ICON(I,1),ICON(I,2),MATRI(I),XBETA,IPS(I),IZERO MOD05069 1,IELD(I),CDIS(I),IELX(I),CVEL(I),THICK(I) MOD05070 WRITE(INPF,27)I,ICON(I,1),ICON(I,2),MATRI(I),BETA(I),IPS(I),IZERO MOD05071 1,IELD(I),CDIS(I),IELX(I),CVEL(I),THICK(I) MOD05072 GO TO 20 MOD05073 25 IF(MT.NE.2)GO TO 28 MOD05074 INELKI=BETA(I) MOD05075 INELKJ=THICK(I) MOD05076 WRITE(INP)I,ICON(I,1),ICON(I,2),ICON(I,3),MATRI(I),IPS(I) MOD05077 1,IZERO,INELKI,INELKJ MOD05078 WRITE(INPF,29)I,ICON(I,1),ICON(I,2),ICON(I,3),MATRI(I),IPS(I) MOD05079 1,IZERO,INELKI,INELKJ MOD05080 29 FORMAT(9I5) MOD05081 GO TO 20 MOD05082 28 IF(MT.NE.17)GO TO 40 MOD05083 IPOI1=MATRI(I) MOD05084 IF(ISEQU.EQ.1)IPOI1=ISENEW(IPOI1) MOD05085 RR=GAUSS1(IPOI1,1) MOD05086 SS=GAUSS1(IPOI1,2) MOD05087 WRITE(INP)I,IELD(I),IPS(I),BETA(I),RR,SS,IONE,MATRI(I) MOD05088 1,(ICON(I,J),J=1,8) MOD05089 WRITE(INPF,41)I,IELD(I),IPS(I),BETA(I),RR,SS,IONE,MATRI(I) MOD05090 1,(ICON(I,J),J=1,8) MOD05091 41 FORMAT(3I5,3E12.5,10I5) MOD05092 GO TO 20 MOD05093 40 IF(MT.EQ.16)IK8=9 MOD05094 IF(MT.EQ.3.OR.MT.EQ.4)GO TO 66 MOD05095 IF(MT.EQ.8.OR.MT.EQ.11)GO TO 66 MOD05096 IF(MT.EQ.12.OR.MT.EQ.13)GO TO 66 MOD05097 IF(MT.NE.18)GO TO 67 MOD05098 IELD1=IELD(I) MOD05099 IST=BETA(I) MOD05100 IPES1=IELX(I) MOD05101 NDLS=THICK(I) MOD05102 NHKK=NTEMP(I) MOD05103 WRITE(INP)I,IELD1,IPES1,NDLS,NHKK,IPS(I),MATRI(I),IST,IZERO MOD05104 1,(ICON(I,J),J=1,16) MOD05105 WRITE(INPF,71)I,IELD1,IPES1,NDLS,NHKK,IPS(I),MATRI(I),IST,IZERO MOD05106 1,(ICON(I,J),J=1,16) MOD05107 71 FORMAT(I5,8I3,/,16I5) MOD05108 GO TO 20 MOD05109 67 IELD1=MH MOD05110 IELX1=IELX(I) MOD05111 IF(IELX1.LE.0)IELX1=IELD1 MOD05112 IST=BETA(I) MOD05113 IF(MT.NE.16)GO TO 69 MOD05114 NDLS=THICK(I) MOD05115 WRITE(INP)I,IELD1,IELX(I),NDLS,IZERO,NTEMP(I) MOD05116 &,IPS(I),MATRI(I),IZERO MOD05117 1,(ICON(I,J),J=1,9) MOD05118 WRITE(INPF,68)I,IELD1,IELX(I),NDLS,IZERO,NTEMP(I) MOD05119 &,IPS(I),MATRI(I),IZERO MOD05120 1,(ICON(I,J),J=1,9) MOD05121 68 FORMAT(I5,5I3,2I3,10I5) MOD05122 GO TO 20 MOD05123 69 CONTINUE MOD05124 NDIR=THICK(I) MOD05125 WRITE(INP)I,IELD1,IELX1,IPS(I),MATRI(I),IST,IZERO,NDIR MOD05126 WRITE(INPF,70)I,IELD1,IELX1,IPS(I),MATRI(I),IST,IZERO,NDIR MOD05127 70 FORMAT(8I5) MOD05128 WRITE(INP)(ICON(I,J),J=1,IK8) MOD05129 WRITE(INP)(ICON(I,J),J=9,20),IZERO MOD05130 WRITE(INPF,72)(ICON(I,J),J=1,IK8) MOD05131 WRITE(INPF,18)(ICON(I,J),J=9,20) MOD05132 GO TO 20 MOD05133 72 FORMAT(8I5) MOD05134 66 XBETA=BETA(I) MOD05135 XTHIC=THICK(I) MOD05136 WRITE(INP)I,MH,IPS(I),XBETA,XTHIC,MATRI(I),IZERO MOD05137 1,(ICON(I,J),J=1,IK8) MOD05138 WRITE(INPF,30)I,MH,IPS(I),BETA(I),THICK(I),MATRI(I),IZERO MOD05139 1,(ICON(I,J),J=1,IK8) MOD05140 30 FORMAT(I5,I3,I2,2F10.3,I5,I4,9I5) MOD05141 18 FORMAT(12I5) MOD05142 GO TO 20 MOD05143 100 NUMEL1=ICO MOD05144 MAXELM=MAXELM+ICO MOD05145 MAXGRO=MAXGRO+1 MOD05146 WRITE(IO,200)ICO,MAXGRO MOD05147 IF(ISAP6.NE.1)WRITE(52)ICO,ITYPEL,NONTYP MOD05148 200 FORMAT(' . . . . TOTAL OF',I5,' ELEMENTS GENERATED FOR GROUP' MOD05149 1,' NUMBER =',I5) MOD05150 DO 60 I=1,NUMEL1 MOD05151 MTYP(I)=0 MOD05152 IPS(I)=0 MOD05153 MATRI(I)=0 MOD05154 THICK(I)=0 MOD05155 BETA(I)=0. MOD05156 IELD(I)=0 MOD05157 IELX(I)=0 MOD05158 DO 61 J=1,20 MOD05159 ICON(I,J)=0 MOD05160 61 CONTINUE MOD05161 60 CONTINUE MOD05162 ITYPEL=0 MOD05163 NONTYP=0 MOD05164 RETURN MOD05165 END MOD05166 SUBROUTINE QUADM (N,ND,XM,XX,NOD5,IEL,THIC,DE,NND5,KIND) MOD00789 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC MOD00790 IMPLICIT REAL*8(A-H,O-Z) MOD00791 COMMON /SAP6/ ISAP6 MOD00792 COMMON/JACHEK/ISEE,IERR MOD00793 DIMENSION XM(1),D(16),XG(4,4),WGT(4,4),XX(2,8),NOD5(1) MOD00794 DIMENSION H(8),P(2,8),IPERM(4),XJ(2,2) MOD00795 DATA XG / 0., 0., 0., 0., MOD00796 1-.5773502691896D0, .5773502691896D0, 0.D0, 0.D0, MOD00797 2-.7745966692415D0, .00000000000D0, .7745966692415D0, 0.D0, MOD00798 3-.8611363115941D0,-.3399810435849D0, .3399810435849D0, MOD00799 4.8611363115941D0/ MOD00800 DATA WGT / 2.000D0, 0.D0, 0.D0, 0.D0, MOD00801 11.00000000000D0,1.00000000000D0, 0.D0, 0.D0, MOD00802 2.5555555555556D0, .8888888888889D0, .5555555555556D0, 0.D0, MOD00803 3.3478548451375D0, .6521451548625D0, .6521451548625D0, MOD00804 4.3478548451375D0/ MOD00805 DATA IPERM/2,3,4,1/ MOD00806 IERR=0 MOD00807 DO 7 I=1,IEL MOD00808 7 XM(I)=0. MOD00809 DO 100 LX=1,3 MOD00810 R=XG(LX,3) MOD00811 DO 100 LY=1,3 MOD00812 S=XG(LY,3) MOD00813 WT=WGT(LX,3)*WGT(LY,3) MOD00814 CALL FUNCT2 (R,S,H,P,NOD5,XJ,DET,XX,N,IEL,NND5) MOD00815 IF(ISEE.EQ.1.AND.IERR.EQ.0)GO TO 100 MOD00816 IF(ISEE.EQ.1.AND.IERR.EQ.1)RETURN MOD00817 IF (ISAP6 .EQ. 0) GO TO 30 MOD00818 IF (THIC .EQ. 0.0) GO TO 40 MOD00819 GO TO 35 MOD00820 30 IF (KIND.EQ.4 .OR. KIND.EQ.11) GO TO 40 MOD00821 35 XBAR=THIC MOD00822 GO TO 60 MOD00823 40 XBAR=0.0 MOD00824 DO 50 K=1,IEL MOD00825 50 XBAR=XBAR + H(K)*XX(1,K) MOD00826 60 FAC=WT*XBAR*DET*DE MOD00827 DO 325 I=1,IEL MOD00828 FACM=FAC/IEL MOD00829 325 XM(I)=XM(I) + FACM MOD00830 100 CONTINUE MOD00831 RETURN MOD00832 END MOD00833 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC MOD00834 SUBROUTINE TAREA(XYZ,NOD,I,J,K,TR,TVEC,ICH,NTOT) MOD00767 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC MOD00768 IMPLICIT REAL*8 (A-H,O-Z) MOD00769 DIMENSION XYZ(NTOT,1),NOD(1),TVEC(1),A(3),B(3) MOD00770 SQRT(X)=DSQRT(X) MOD00771 DO 100 L = 1, 3 MOD00772 A(L) = XYZ(NOD(J),L) - XYZ(NOD(I),L) MOD00773 B(L) = XYZ(NOD(K),L) - XYZ(NOD(I),L) MOD00774 100 CONTINUE MOD00775 TVEC(1) = (A(2)*B(3) - A(3)*B(2)) / 2.0 MOD00776 TVEC(2) = (A(3)*B(1) - A(1)*B(3)) / 2.0 MOD00777 TVEC(3) = (A(1)*B(2) - A(2)*B(1)) / 2.0 MOD00778 IF (ICH .EQ. 3) RETURN MOD00779 AB = 0.0 MOD00780 DO 200 L = 1, 3 MOD00781 AB = AB + TVEC(L)**2 MOD00782 200 CONTINUE MOD00783 AB = SQRT(AB) MOD00784 TR = AB /3.0 MOD00785 RETURN MOD00786 END MOD00787 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC MOD00788 SUBROUTINE FUNCT2 (R,S,H,P,NOD5,XJ,DET,XX,NEL,IEL,NND5) MOD01081 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC MOD01082 IMPLICIT REAL*8(A-H,O-Z) MOD01083 COMMON/JACHEK/ISEE1,IERR MOD01084 DIMENSION H(1),P(2,1),NOD5(1),IPERM(4),XJ(2,2),XX(2,1) MOD01085 DATA IPERM/2,3,4,1/ MOD01086 ABS(X)=DABS(X) MOD01087 RP = 1.0D0 + R MOD01088 SP = 1.0D0 + S MOD01089 RM = 1.0D0 - R MOD01090 SM = 1.0D0 - S MOD01091 R2 = 1.0D0 - R*R MOD01092 S2 = 1.0D0 - S*S MOD01093 H(1) = 0.25D0* RP* SP MOD01094 H(2) = 0.25D0* RM* SP MOD01095 H(3) = 0.25D0* RM* SM MOD01096 H(4) = 0.25D0* RP* SM MOD01097 P(1,1)=0.25D0*SP MOD01098 P(1,2)=-P(1,1) MOD01099 P(1,3)=-0.25D0*SM MOD01100 P(1,4)=-P(1,3) MOD01101 P(2,1)=0.25D0*RP MOD01102 P(2,2)=0.25D0*RM MOD01103 P(2,3)=-P(2,2) MOD01104 P(2,4)=-P(2,1) MOD01105 IF (IEL.EQ.4) GO TO 50 MOD01106 I=0 MOD01107 2 I=I + 1 MOD01108 IF (I.GT.NND5) GO TO 40 MOD01109 NN=NOD5(I) - 4 MOD01110 GO TO (5,6,7,8), NN MOD01111 5 H(5) = 0.50D0* R2* SP MOD01112 P(1,5)=-R*SP MOD01113 P(2,5)=0.50D0*R2 MOD01114 GO TO 2 MOD01115 6 H(6) = 0.50D0* RM* S2 MOD01116 P(1,6)=-0.50D0*S2 MOD01117 P(2,6)=-RM*S MOD01118 GO TO 2 MOD01119 7 H(7) = 0.50D0* R2* SM MOD01120 P(1,7)=-R*SM MOD01121 P(2,7)=-0.50D0*R2 MOD01122 GO TO 2 MOD01123 8 H(8) = 0.50D0* RP* S2 MOD01124 P(1,8)=0.50D0*S2 MOD01125 P(2,8)=-RP*S MOD01126 GO TO 2 MOD01127 40 IH=0 MOD01128 41 IH=IH + 1 MOD01129 IF (IH.GT.NND5) GO TO 50 MOD01130 IN=NOD5(IH) MOD01131 I1=IN - 4 MOD01132 I2=IPERM(I1) MOD01133 H(I1)=H(I1) - 0.5D0*H(IN) MOD01134 H(I2)=H(I2) - 0.5D0*H(IN) MOD01135 H(IH + 4)=H(IN) MOD01136 DO 45 J=1,2 MOD01137 P(J,I1)=P(J,I1) - 0.5D0*P(J,IN) MOD01138 P(J,I2)=P(J,I2) - 0.5D0*P(J,IN) MOD01139 45 P(J,IH + 4)=P(J,IN) MOD01140 GO TO 41 MOD01141 50 DO 100 I=1,2 MOD01142 DO 100 J=1,2 MOD01143 DUM = 0.0D0 MOD01144 DO 90 K=1,IEL MOD01145 90 DUM = DUM + P(I,K)* XX(J,K) MOD01146 100 XJ(I,J) = DUM MOD01147 DET = XJ(1,1)* XJ(2,2) - XJ(2,1)* XJ(1,2) MOD01148 IF(DET.GT.1.0D-8) GO TO 110 MOD01149 WRITE (6,2000) NEL,DET MOD01150 IERR=1 MOD01151 RETURN MOD01152 110 CONTINUE MOD01153 RETURN MOD01154 2000 FORMAT(' ++ F ++ NEGATIVE OR ZERO JACOBIAN' MOD01155 1,' ,ELEMENT NUMBER =',I5,' DET =',E15.7) MOD01156 END MOD01157 FUNCTION COMPNT(IG,II1,IC,IDEG,IW,ICC,NN) MOD01158 DIMENSION IG(II1,1),IC(1),IDEG(1),IW(1),ICC(1) MOD01159 DO 100 I=1,NN MOD01160 ICC(I)=0 MOD01161 IC(I)=0 MOD01162 100 CONTINUE MOD01163 NC=0 MOD01164 ICC(1)=1 MOD01165 110 DO 120 I=1,NN MOD01166 IF(IC(I)) 120,130,120 MOD01167 120 COMPNT=NC MOD01168 RETURN MOD01169 130 NC=NC+1 MOD01170 KI=0 MOD01171 KO=1 MOD01172 IW(1)=I MOD01173 IC(I)=NC MOD01174 IF(NC-1)150,140,140 MOD01175 140 IS=ICC(NC)+1 MOD01176 ICC(NC+1)=IS MOD01177 150 KI=KI+1 MOD01178 II=IW(KI) MOD01179 N=IDEG(II) MOD01180 IF(N)160,110,160 MOD01181 160 DO 180 I=1,N MOD01182 IA = IG(II,I) MOD01183 IF(IC(IA)) 180,170,180 MOD01184 170 IC(IA)=NC MOD01185 KO=KO+1 MOD01186 IW(KO)=IA MOD01187 IS=ICC(NC+1)+1 MOD01188 ICC(NC+1)=IS MOD01189 180 CONTINUE MOD01190 IF(KO-KI)110,110,150 MOD01191 END MOD01192 SUBROUTINE FUNCT (R,S,T,H,P,NOD9,XJ,DET,XX,IEL,NND9,IELX,IELD) MOD00835 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC MOD00836 IMPLICIT REAL*8(A-H,O-Z) MOD00837 COMMON /UNIT/ INN,IOUT,IP MOD00838 COMMON /CGELE/ NEL MOD00839 COMMON/JACHEK/ISEE1,IERR MOD00840 DIMENSION H(1),P(3,1),NOD9(1),IPERM(8),XJ(3,3),XX(3,1) MOD00841 DATA IPERM / 2,3,4,1,6,7,8,5 / MOD00842 ABS(X)=DABS(X) MOD00843 RP=1.0D0 + R MOD00844 SP=1.0D0 + S MOD00845 TP=1.0D0 + T MOD00846 RM=1.0D0 - R MOD00847 SM=1.0D0 - S MOD00848 TM=1.0D0 - T MOD00849 RR=1.0D0 - R*R MOD00850 SS=1.0D0 - S*S MOD00851 TT=1.0D0 - T*T MOD00852 H(1)=0.125D0*RP*SP*TP MOD00853 H(2)=0.125D0*RM*SP*TP MOD00854 H(3)=0.125D0*RM*SM*TP MOD00855 H(4)=0.125D0*RP*SM*TP MOD00856 H(5)=0.125D0*RP*SP*TM MOD00857 H(6)=0.125D0*RM*SP*TM MOD00858 H(7)=0.125D0*RM*SM*TM MOD00859 H(8)=0.125D0*RP*SM*TM MOD00860 P(1,1)= 0.125D0*SP*TP MOD00861 P(1,2)=-P(1,1) MOD00862 P(1,3)=-0.125D0*SM*TP MOD00863 P(1,4)=-P(1,3) MOD00864 P(1,5)= 0.125D0*SP*TM MOD00865 P(1,6)=-P(1,5) MOD00866 P(1,7)=-0.125D0*SM*TM MOD00867 P(1,8)=-P(1,7) MOD00868 P(2,1)= 0.125D0*RP*TP MOD00869 P(2,2)= 0.125D0*RM*TP MOD00870 P(2,3)=-P(2,2) MOD00871 P(2,4)=-P(2,1) MOD00872 P(2,5)= 0.125D0*RP*TM MOD00873 P(2,6)= 0.125D0*RM*TM MOD00874 P(2,7)=-P(2,6) MOD00875 P(2,8)=-P(2,5) MOD00876 P(3,1)= 0.125D0*RP*SP MOD00877 P(3,2)= 0.125D0*RM*SP MOD00878 P(3,3)= 0.125D0*RM*SM MOD00879 P(3,4)= 0.125D0*RP*SM MOD00880 P(3,5)=-P(3,1) MOD00881 P(3,6)=-P(3,2) MOD00882 P(3,7)=-P(3,3) MOD00883 P(3,8)=-P(3,4) MOD00884 IF (IEL.EQ.8) GO TO 50 MOD00885 I=0 MOD00886 2 I=I + 1 MOD00887 IF (I.GT.NND9) GO TO 40 MOD00888 NN=NOD9(I) - 8 MOD00889 GO TO (9,10,11,12,13,14,15,16,17,18,19,20,21) ,NN MOD00890 9 H(9) =0.25D0*RR*SP*TP MOD00891 P(1,9) =-0.50*R*SP*TP MOD00892 P(2,9) = 0.25D0*RR*TP MOD00893 P(3,9) = 0.25D0*RR*SP MOD00894 GO TO 2 MOD00895 10 H(10)=0.25D0*RM*SS*TP MOD00896 P(1,10)=-0.25D0*SS*TP MOD00897 P(2,10)=-0.50*RM*S*TP MOD00898 P(3,10)= 0.25D0*RM*SS MOD00899 GO TO 2 MOD00900 11 H(11)=0.25D0*RR*SM*TP MOD00901 P(1,11)=-0.50D0*R*SM*TP MOD00902 P(2,11)=-0.25D0*RR*TP MOD00903 P(3,11)= 0.25D0*RR*SM MOD00904 GO TO 2 MOD00905 12 H(12)=0.25D0*RP*SS*TP MOD00906 P(1,12)= 0.25D0*SS*TP MOD00907 P(2,12)=-0.50D0*RP*S*TP MOD00908 P(3,12)= 0.25D0*RP*SS MOD00909 GO TO 2 MOD00910 13 H(13)=0.25D0*RR*SP*TM MOD00911 P(1,13)=-0.50D0*R*SP*TM MOD00912 P(2,13)= 0.25D0*RR*TM MOD00913 P(3,13)=-0.25D0*RR*SP MOD00914 GO TO 2 MOD00915 14 H(14)=0.25D0*RM*SS*TM MOD00916 P(1,14)=-0.25D0*SS*TM MOD00917 P(2,14)=-0.50D0*RM*S*TM MOD00918 P(3,14)=-0.25D0*RM*SS MOD00919 GO TO 2 MOD00920 15 H(15)=0.25D0*RR*SM*TM MOD00921 P(1,15)=-0.50D0*R*SM*TM MOD00922 P(2,15)=-0.25D0*RR*TM MOD00923 P(3,15)=-0.25D0*RR*SM MOD00924 GO TO 2 MOD00925 16 H(16)=0.25D0*RP*SS*TM MOD00926 P(1,16)= 0.25D0*SS*TM MOD00927 P(2,16)=-0.50D0*RP*S*TM MOD00928 P(3,16)=-0.25D0*RP*SS MOD00929 GO TO 2 MOD00930 17 H(17)=0.25D0*RP*SP*TT MOD00931 P(1,17)= 0.25D0*SP*TT MOD00932 P(2,17)= 0.25D0*RP*TT MOD00933 P(3,17)=-0.50D0*RP*SP*T MOD00934 GO TO 2 MOD00935 18 H(18)=0.25D0*RM*SP*TT MOD00936 P(1,18)=-0.25D0*SP*TT MOD00937 P(2,18)= 0.25D0*RM*TT MOD00938 P(3,18)=-0.50D0*RM*SP*T MOD00939 GO TO 2 MOD00940 19 H(19)=0.25D0*RM*SM*TT MOD00941 P(1,19)=-0.25D0*SM*TT MOD00942 P(2,19)=-0.25D0*RM*TT MOD00943 P(3,19)=-0.50D0*RM*SM*T MOD00944 GO TO 2 MOD00945 20 H(20)=0.25D0*RP*SM*TT MOD00946 P(1,20)= 0.25D0*SM*TT MOD00947 P(2,20)=-0.25D0*RP*TT MOD00948 P(3,20)=-0.50D0*RP*SM*T MOD00949 GO TO 2 MOD00950 21 H(21)=RR*SS*TT MOD00951 P(1,21)=-2.0D0*R*SS*TT MOD00952 P(2,21)=-2.0D0*S*RR*TT MOD00953 P(3,21)=-2.0D0*T*RR*SS MOD00954 GO TO 2 MOD00955 40 IH=0 MOD00956 41 IH=IH + 1 MOD00957 IF (IH.GT.NND9) GO TO 50 MOD00958 II=IH + 7 MOD00959 IF (II.EQ.IELX) GO TO 51 MOD00960 42 IN=NOD9(IH) MOD00961 IF (IN.GT.16) GO TO 46 MOD00962 I1=IN - 8 MOD00963 I2=IPERM(I1) MOD00964 H(I1)=H(I1) - 0.5D0*H(IN) MOD00965 H(I2)=H(I2) - 0.5D0*H(IN) MOD00966 H(IH+8)=H(IN) MOD00967 DO 45 J=1,3 MOD00968 P(J,I1)=P(J,I1) - 0.5D0*P(J,IN) MOD00969 P(J,I2)=P(J,I2) - 0.5D0*P(J,IN) MOD00970 45 P(J,IH+8)=P(J,IN) MOD00971 GO TO 41 MOD00972 46 IF (IN.EQ.21) GO TO 30 MOD00973 I1=IN - 16 MOD00974 I2=I1 + 4 MOD00975 H(I1)=H(I1) - 0.5D0*H(IN) MOD00976 H(I2)=H(I2) - 0.5D0*H(IN) MOD00977 H(IH+8)=H(IN) MOD00978 DO 47 J=1,3 MOD00979 P(J,I1)=P(J,I1) - 0.5D0*P(J,IN) MOD00980 P(J,I2)=P(J,I2) - 0.5D0*P(J,IN) MOD00981 47 P(J,IH+8)=P(J,IN) MOD00982 GO TO 41 MOD00983 30 IH=0 MOD00984 31 IH=IH + 1 MOD00985 IN=NOD9(IH) MOD00986 IF (IN.EQ.21) GO TO 35 MOD00987 IF (IN.GT.16) GO TO 33 MOD00988 I1=IN - 8 MOD00989 I2=IPERM(I1) MOD00990 H(I1)=H(I1) + 0.125D0*H(21) MOD00991 H(I2)=H(I2) + 0.125D0*H(21) MOD00992 DO 32 J=1,3 MOD00993 P(J,I1)=P(J,I1) + 0.125D0*P(J,21) MOD00994 32 P(J,I2)=P(J,I2) + 0.125D0*P(J,21) MOD00995 GO TO 31 MOD00996 33 I1=IN - 16 MOD00997 I2=I1 + 4 MOD00998 H(I1)=H(I1) + 0.125D0*H(21) MOD00999 H(I2)=H(I2) + 0.125D0*H(21) MOD01000 DO 34 J=1,3 MOD01001 P(J,I1)=P(J,I1) + 0.125D0*P(J,21) MOD01002 34 P(J,I2)=P(J,I2) + 0.125D0*P(J,21) MOD01003 GO TO 31 MOD01004 35 DO 36 I=1,8 MOD01005 H(I)=H(I) - 0.125D0*H(21) MOD01006 DO 36 J=1,3 MOD01007 36 P(J,I)=P(J,I) - 0.125D0*P(J,21) MOD01008 NN=NND9 + 7 MOD01009 IF (NN.EQ.8) GO TO 50 MOD01010 DO 38 I=9,NN MOD01011 H(I)=H(I) - 0.25D0*H(21) MOD01012 DO 38 J=1,3 MOD01013 38 P(J,I)=P(J,I) - 0.25D0*P(J,21) MOD01014 H(NND9+8)=H(21) MOD01015 DO 39 J=1,3 MOD01016 39 P(J,NND9+8)=P(J,21) MOD01017 50 IF (IELX.LT.IELD) RETURN MOD01018 51 DO 100 I=1,3 MOD01019 DO 100 J=1,3 MOD01020 DUM=0.0D0 MOD01021 DO 90 K=1,IELX MOD01022 90 DUM=DUM + P(I,K)*XX(J,K) MOD01023 100 XJ(I,J)=DUM MOD01024 DET = XJ(1,1)*XJ(2,2)*XJ(3,3) MOD01025 1+ XJ(1,2)*XJ(2,3)*XJ(3,1) MOD01026 2+ XJ(1,3)*XJ(2,1)*XJ(3,2) MOD01027 3- XJ(1,3)*XJ(2,2)*XJ(3,1) MOD01028 4- XJ(1,2)*XJ(2,1)*XJ(3,3) MOD01029 5- XJ(1,1)*XJ(2,3)*XJ(3,2) MOD01030 IF (DET.GT.1.0E-08) GO TO 110 MOD01031 WRITE (IOUT,2000)NEL,DET MOD01032 IERR=1 MOD01033 RETURN MOD01034 110 IF (IELX.LT.IELD) GO TO 42 MOD01035 RETURN MOD01036 2000 FORMAT(' ++ F ++ NEGATIVE OR ZERO JACOBIAN' MOD01037 1,' ,ELEMENT NUMBER =',I5,' DET =',E15.7) MOD01038 END MOD01039 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC MOD01040 SUBROUTINE QUADM3 (N,ND,XM,XX,NOD9,IST,IEL,IELX,DE,NND9) MOD01041 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC MOD01042 IMPLICIT REAL*8(A-H,O-Z) MOD01043 COMMON/JACHEK/ISEE,IERR MOD01044 DIMENSION XM(1),XX(3,1),D(63),XG(4,4),WGT(4,4),NOD9(1) MOD01045 DIMENSION H(21),P(3,21),XJ(3,3) MOD01046 DATA XG / 0.0D0, 0.0D0, 0.0D0, 0.0D0, MOD01047 1-.5773502691896D0, .5773502691896D0, 0.D0, 0.D0, MOD01048 2-.7745966692415D0, .0000000000000D0, .7745966692415D0, 0.D0, MOD01049 3-.8611363115941D0,-.3399810435849D0, .3399810435849D0, MOD01050 4.8611363115941D0/ MOD01051 DATA WGT / 2.000D0, 0.D0, 0.D0, 0.D0, MOD01052 11.0000000000000D0,1.0000000000000D0, 0.D0, 0.D0, MOD01053 2.5555555555556D0, .8888888888889D0, .5555555555556D0, 0.D0, MOD01054 3.3478548451375D0, .6521451548625D0, .6521451548625D0, MOD01055 4.3478548451375D0/ MOD01056 NINTM=3 MOD01057 IERR=0 MOD01058 NINTZM=3 MOD01059 DO 7 I=1 ,IEL MOD01060 7 XM(I)=0. MOD01061 10 DO 900 LX=1,NINTM MOD01062 R=XG(LX,NINTM) MOD01063 DO 900 LY=1,NINTM MOD01064 S=XG(LY,NINTM) MOD01065 DO 900 LZ=1,NINTZM MOD01066 T=XG(LZ,NINTZM) MOD01067 WT=WGT(LX,NINTM)*WGT(LY,NINTM)*WGT(LZ,NINTZM) MOD01068 IELD = IELX MOD01069 CALL FUNCT (R,S,T,H,P,NOD9,XJ,DET,XX,IEL,NND9,IELX,IELD) MOD01070 IF(ISEE.EQ.1.AND.IERR.EQ.0)GO TO 900 MOD01071 IF(ISEE.EQ.1.AND.IERR.EQ.1)RETURN MOD01072 FAC = WT*DET*DE MOD01073 DO 325 I=1,IEL MOD01074 FACM=FAC/IEL MOD01075 325 XM(I)=XM(I) + FACM MOD01076 900 CONTINUE MOD01077 RETURN MOD01078 END MOD01079 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC MOD01080