API tools faq
paste
Advertisement
rgedies

mesh_fine01

rgedies
May 26th, 2023
623
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Fortran 52.16 KB | Source Code | 0 0
raw download clone embed print report
  1.       subroutine MESH_FINE01(D_PIPE,T_PIPE,T_SLEEVE,GAP,WELDAREA,
  2.      1     ANGLE_W,VL_PIPE,NNODE,NELEM,INODE,
  3.      2     COORD,LARRAY_ELE,KEY_POINT,R_CC,iabaqus)
  4.       parameter (nnmax=2000,nemax=1000)
  5.       IMPLICIT REAL*8 (A-H, O-Z)
  6.  
  7.  
  8.       DIMENSION :: KEY_POINT(*),LARRAY_ELE(8,*)
  9.       DIMENSION :: INODE(*),COORD(2,*)
  10.  
  11.       DIMENSION :: x(1000),y(1000),n_repeat(10,2)
  12.       DIMENSION :: co_f(2),co_l(2),dist(4),larray2D(1000,5)
  13.  
  14.     DIMENSION :: INODE_TEMP1(10000),IELEM_TEMP1(4,10000), & INELEM_TEMP1(4,10000)
  15.     DIMENSION :: INODE_TEMP2(10000),IELEM_TEMP2(4,10000), & INELEM_TEMP2(4,10000)
  16.     REAL*8 COORD_TEMP1(2,10000),COORD_TEMP2(2,10000)
  17.  
  18.     INTEGER NDEN1, NDEN2,NDEN3,NDEN4,NDEN5,NDEN6,NDEN7,NDEN8,NDEN9 &    ,NDEN10
  19.     INTEGER NDEN11, NDEN12,NDEN13,NDEN14,NDEN15,NDEN16,NDEN17,NDEN18&   ,NDEN19,&       NDEN20
  20.       common /coord/x,y
  21.     COMMON /MESHING/DLENGTH1, DHAZ, DLENGTH2, DBAND, DMESHSIZE
  22.  
  23.  
  24.     INTEGER NNUM_HAZ, NNUM_WELD, NNUM_PIPE, NNUM_SLEEVE
  25.     REAL*8 ELEMSIZE, ELLP_X1, ELLP_X2, ELLP_Y1, ELLP_Y2
  26.     REAL*8 POINTS(2,50),CORNERS(2,4)
  27.     INTEGER ITOTALNODES, ITOTALELEMS, ITOTALNODES2, ITOTALELEMS2&   , NRESIDUAL &, NCOARSESIDE
  28.     REAL*8 DTEMP1, DTEMP2
  29.     LOGICAL BTRAN
  30.     INTEGER NNUM_HAZ_H, NNUM_HAZ_V, NNUM_BAND, NNUM_PIPE_TRAN&  , NNUM_PIPE_END
  31.  
  32.     BTRAN = .TRUE.
  33.  
  34.       pi=acos(-1.0d0)
  35.       to_rad = pi/180.d0
  36.       ang_set = 30.d0*to_rad
  37.       angle_w = angle_w*to_rad
  38.  
  39.       weldxx=sqrt(2.0*weldarea)
  40.       if (weldxx .gt. (gap+7.*t_sleeve/8.)) then
  41.          weldxx=t_sleeve+gap
  42.       endif
  43.       weldyy=2.0*weldarea/weldxx
  44.  
  45.       r_cc=0.5*sqrt(weldxx*weldxx+weldyy*weldyy)
  46.  
  47.     CALL INITMESH(INODE_TEMP1, IELEM_TEMP1, INELEM_TEMP1, COORD_TEMP1, &     10000,10000)
  48.  
  49.     ZLEG = 2.0D0*WELDAREA**0.5D0
  50.  
  51.     CALL KEYPOINTS_SLEEVE(D_PIPE,T_PIPE,T_SLEEVE,GAP,ZLEG,
  52.      1     ANGLE_W,VL_PIPE,POINTS,50)
  53.  
  54.     ELLP_X1 = DLENGTH1
  55.     ELLP_Y1 = DHAZ
  56.  
  57.     NNUM_HAZ = ELLP_X1/DMESHSIZE
  58.     NNUM_HAZ_T = DHAZ/DMESHSIZE
  59.     NNUM_WELD_PIPE = 0.3D0*NNUM_HAZ ! REDUCE THE NUMBER BY HALF
  60.     NRESIDUAL = NNUM_HAZ-NNUM_WELD_PIPE
  61.     IF ( MOD(NRESIDUAL,2) .NE.0 ) THEN
  62.         NNUM_WELD_PIPE = NNUM_WELD_PIPE +1
  63.     END IF
  64.    
  65.     IFINESIDE = NNUM_HAZ+1 !THESE ARE THE DEFINING NUMBERS FOR THE MESH
  66.     ISIDE = NNUM_HAZ_T+1
  67.     ICOARSESIDE = NNUM_WELD_PIPE +1
  68.  
  69.     NDEN1 = NNUM_HAZ
  70.     NDEN2 = NNUM_HAZ_T
  71.     NDEN12 = NNUM_WELD_PIPE
  72.  
  73.     ITOTALNODES = 0
  74.     ITOTALELEMS = 0
  75.      
  76.       CALL INITMESH(INODE_TEMP1,IELEM_TEMP1,INELEM_TEMP1, COORD_TEMP1,&  10000,10000)
  77.     CALL MESHRECTANGLE_TRANSITION2(IFINESIDE,ICOARSESIDE, ISIDE&    , INODE_TEMP1,& IELEM_TEMP1,INELEM_TEMP1, COORD_TEMP1) 
  78.    
  79.     CALL GETNODENUMBER(INODE_TEMP1, 10000,ITOTALNODES)
  80.     CALL GETELEMNUMBER(IELEM_TEMP1, 10000,ITOTALELEMS)
  81.  
  82.     CORNERS(1,1) = POINTS(1,10)
  83.     CORNERS(2,1) = POINTS(2,10)
  84.     CORNERS(1,2) = POINTS(1,8)
  85.     CORNERS(2,2) = POINTS(2,8)
  86.     CORNERS(1,3) = POINTS(1,7)
  87.     CORNERS(2,3) = POINTS(2,7)
  88.     CORNERS(1,4) = POINTS(1,6)
  89.     CORNERS(2,4) = POINTS(2,6)
  90.     CALL TRANSFORMNODES(COORD_TEMP1,CORNERS,ITOTALNODES,1.0D0,1.0D0)
  91.  
  92.       CALL INITMESH(INODE_TEMP2,IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2,&  10000,10000)
  93.     CALL MESHRECTANGLE_TRANSITION2(IFINESIDE,ICOARSESIDE, ISIDE&    , INODE_TEMP2,& IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2) 
  94.  
  95.     CORNERS(1,1) = POINTS(1,8)
  96.     CORNERS(2,1) = POINTS(2,8)
  97.     CORNERS(1,2) = POINTS(1,1)
  98.     CORNERS(2,2) = POINTS(2,1)
  99.     CORNERS(1,3) = POINTS(1,3)
  100.     CORNERS(2,3) = POINTS(2,3)
  101.     CORNERS(1,4) = POINTS(1,7)
  102.     CORNERS(2,4) = POINTS(2,7) 
  103.     CALL TRANSFORMNODES(COORD_TEMP2,CORNERS,ITOTALNODES,1.0D0,1.0D0)
  104.  
  105.  
  106.     CALL MERGEBLOCKMESHES(INODE_TEMP1, IELEM_TEMP1, INELEM_TEMP1, & ITOTALNODES,ITOTAlelems,COORD_TEMP1, INODE_TEMP2, IELEM_TEMP2, & INELEM_TEMP2, ITOTALNODES, ITOTALELEMS, COORD_TEMP2)
  107.  
  108.     CALL GETNODENUMBER(INODE_TEMP1, 10000,ITOTALNODES)
  109.     CALL GETELEMNUMBER(IELEM_TEMP1, 10000,ITOTALELEMS)
  110.                
  111.     ISIDE = DHAZ*ISIDE*0.75D0/DBAND
  112.     NCOARSESIDE = 0.4D0*(IFINESIDE-1)
  113.     NRESIDUAL = NNUM_HAZ-NCOARSESIDE
  114.     IF ( MOD(NRESIDUAL,2) .NE.0 ) THEN
  115.         NCOARSESIDE = NCOARSESIDE +1
  116.     END IF
  117.     ICOARSESIDE = NCOARSESIDE +1
  118.     NDEN4 = NCOARSESIDE
  119.     NDEN3 = ISIDE-1
  120.       CALL INITMESH(INODE_TEMP2,IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2,&  10000,10000)
  121.     CALL MESHRECTANGLE_TRANSITION2(IFINESIDE,ICOARSESIDE, ISIDE&    , INODE_TEMP2, & IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2)
  122.     CALL GETNODENUMBER(INODE_TEMP2, 10000,ITOTALNODES2)
  123.     CALL GETELEMNUMBER(IELEM_TEMP2, 10000,ITOTALELEMS2)
  124.     CORNERS(1,1) = POINTS(1,8)
  125.     CORNERS(2,1) = POINTS(2,8)
  126.     CORNERS(1,2) = POINTS(1,10)
  127.     CORNERS(2,2) = POINTS(2,10)
  128.     CORNERS(1,3) = POINTS(1,11)
  129.     CORNERS(2,3) = POINTS(2,11)
  130.     CORNERS(1,4) = POINTS(1,9)
  131.     CORNERS(2,4) = POINTS(2,9) 
  132.     CALL TRANSFORMNODES(COORD_TEMP2,CORNERS,ITOTALNODES2,1.0D0,1.2D0)
  133.  
  134.     CALL MERGEBLOCKMESHES(INODE_TEMP1, IELEM_TEMP1, INELEM_TEMP1, & ITOTALNODES,ITOTALELEMS,COORD_TEMP1, INODE_TEMP2, IELEM_TEMP2, & INELEM_TEMP2, ITOTALNODES2, ITOTALELEMS2, COORD_TEMP2)
  135.  
  136.     CALL GETNODENUMBER(INODE_TEMP1, 10000,ITOTALNODES)
  137.     CALL GETELEMNUMBER(IELEM_TEMP1, 10000,ITOTALELEMS)
  138.  
  139.       CALL INITMESH(INODE_TEMP2,IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2,&  10000,10000)
  140.     CALL MESHRECTANGLE_TRANSITION2(IFINESIDE,ICOARSESIDE, ISIDE&    , INODE_TEMP2,& IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2)
  141.     CALL GETNODENUMBER(INODE_TEMP2, 10000,ITOTALNODES2)
  142.     CALL GETELEMNUMBER(IELEM_TEMP2, 10000,ITOTALELEMS2)
  143.     CORNERS(1,1) = POINTS(1,1)
  144.     CORNERS(2,1) = POINTS(2,1)
  145.     CORNERS(1,2) = POINTS(1,8)
  146.     CORNERS(2,2) = POINTS(2,8)
  147.     CORNERS(1,3) = POINTS(1,9)
  148.     CORNERS(2,3) = POINTS(2,9)
  149.     CORNERS(1,4) = POINTS(1,2)
  150.     CORNERS(2,4) = POINTS(2,2) 
  151.     CALL TRANSFORMNODES(COORD_TEMP2,CORNERS,ITOTALNODES2,1.0D0,1.2D0)
  152.  
  153.     CALL MERGEBLOCKMESHES(INODE_TEMP1, IELEM_TEMP1, INELEM_TEMP1,& ITOTALNODES,ITOTALELEMS,COORD_TEMP1, INODE_TEMP2, IELEM_TEMP2, & INELEM_TEMP2, ITOTALNODES2, ITOTALELEMS2, COORD_TEMP2)
  154.  
  155.     CALL GETNODENUMBER(INODE_TEMP1, 10000,ITOTALNODES)
  156.     CALL GETELEMNUMBER(IELEM_TEMP1, 10000,ITOTALELEMS)
  157.                
  158.     IFINESIDE = ICOARSESIDE
  159.     NCOARSESIDE = 0.2D0*(IFINESIDE-1)
  160.     IF ( NCOARSESIDE .LT. 5 ) NCOARSESIDE = 5
  161.     NRESIDUAL = (IFINESIDE-1)-NCOARSESIDE
  162.     IF ( MOD(NRESIDUAL,2) .NE.0 ) THEN
  163.         NCOARSESIDE = NCOARSESIDE +1
  164.     END IF
  165.     ICOARSESIDE = NCOARSESIDE +1
  166.  
  167.     IF ( (IFINESIDE - ICOARSESIDE).LT. 2 ) BTRAN = .FALSE.
  168.      
  169.     DTEMP1 = DSQRT((POINTS(1,9)-POINTS(1,11))*(POINTS(1,9)& -POINTS(1,11))& + (POINTS(2,9)-POINTS(2,11))*(POINTS(2,9)-POINTS(2,11)))
  170.     DTEMP2 = DSQRT((POINTS(1,14)-POINTS(1,11))*(POINTS(1,14)&   -POINTS(1,11))& + (POINTS(2,14)-POINTS(2,11))*(POINTS(2,14)-POINTS(2,11)))
  171.     ISIDE = 0.5D0*IFINESIDE*DTEMP2/DTEMP1
  172.     IF ( ISIDE .LT. 2 ) ISIDE = 2
  173.     NDEN5 = NCOARSESIDE
  174.     NDEN6 = ISIDE -1
  175.  
  176.       CALL INITMESH(INODE_TEMP2,IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2, &     10000,10000)
  177.     IF ( BTRAN ) THEN
  178.         CALL MESHRECTANGLE_TRANSITION2(IFINESIDE,ICOARSESIDE, ISIDE, &      INODE_TEMP2,&       IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2)
  179.     ELSE
  180.         CALL MESHRECTANGLE(IFINESIDE, ISIDE, INODE_TEMP2,&      IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2)
  181.     END IF
  182.  
  183.     CALL GETNODENUMBER(INODE_TEMP2, 10000,ITOTALNODES2)
  184.     CALL GETELEMNUMBER(IELEM_TEMP2, 10000,ITOTALELEMS2)
  185.  
  186.     CALL MARKBCFACE(INODE_TEMP2, COORD_TEMP2,IELEM_TEMP2,INELEM_TEMP2,& ITOTALELEMS2,3,2)!!THIS SAYS: SET FACE 3 TO FORCED 2
  187.  
  188.     CORNERS(1,1) = POINTS(1,9)
  189.     CORNERS(2,1) = POINTS(2,9)
  190.     CORNERS(1,2) = POINTS(1,11)
  191.     CORNERS(2,2) = POINTS(2,11)
  192.     CORNERS(1,3) = POINTS(1,14)
  193.     CORNERS(2,3) = POINTS(2,14)
  194.     CORNERS(1,4) = POINTS(1,15)
  195.     CORNERS(2,4) = POINTS(2,15)
  196.     CALL TRANSFORMNODES(COORD_TEMP2,CORNERS,ITOTALNODES2,1.0D0,1.5D0)
  197.  
  198.     CALL MERGEBLOCKMESHES(INODE_TEMP1, IELEM_TEMP1, INELEM_TEMP1,& ITOTALNODES,ITOTALELEMS,COORD_TEMP1, INODE_TEMP2, IELEM_TEMP2, & INELEM_TEMP2, ITOTALNODES2, ITOTALELEMS2, COORD_TEMP2)
  199.  
  200.     CALL GETNODENUMBER(INODE_TEMP1, 10000,ITOTALNODES)
  201.     CALL GETELEMNUMBER(IELEM_TEMP1, 10000,ITOTALELEMS)
  202.  
  203.       CALL INITMESH(INODE_TEMP2,IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2, &    10000,10000)
  204.     IF ( BTRAN ) THEN
  205.         CALL MESHRECTANGLE_TRANSITION2(IFINESIDE,ICOARSESIDE, ISIDE, &      INODE_TEMP2,&       IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2)
  206.     ELSE
  207.         CALL MESHRECTANGLE(IFINESIDE, ISIDE, INODE_TEMP2,&      IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2)
  208.     END IF
  209.     CALL GETNODENUMBER(INODE_TEMP2, 10000,ITOTALNODES2)
  210.     CALL GETELEMNUMBER(IELEM_TEMP2, 10000,ITOTALELEMS2)
  211.  
  212.     CALL MARKBCFACE(INODE_TEMP2, COORD_TEMP2,IELEM_TEMP2,INELEM_TEMP2,& ITOTALELEMS2,3,2)!!THIS SAYS: SET FACE 3 TO 2,FORCED
  213.  
  214.     CORNERS(1,1) = POINTS(1,2)
  215.     CORNERS(2,1) = POINTS(2,2)
  216.     CORNERS(1,2) = POINTS(1,9)
  217.     CORNERS(2,2) = POINTS(2,9)
  218.     CORNERS(1,3) = POINTS(1,15)
  219.     CORNERS(2,3) = POINTS(2,15)
  220.     CORNERS(1,4) = POINTS(1,16)
  221.     CORNERS(2,4) = POINTS(2,16)
  222.     CALL TRANSFORMNODES(COORD_TEMP2,CORNERS,ITOTALNODES2,1.0D0,1.5D0)
  223.  
  224.     CALL MERGEBLOCKMESHES(INODE_TEMP1, IELEM_TEMP1, INELEM_TEMP1,& ITOTALNODES,ITOTALELEMS,COORD_TEMP1, INODE_TEMP2, IELEM_TEMP2, & INELEM_TEMP2, ITOTALNODES2, ITOTALELEMS2, COORD_TEMP2)
  225.     CALL GETNODENUMBER(INODE_TEMP1, 10000,ITOTALNODES)
  226.     CALL GETELEMNUMBER(IELEM_TEMP1, 10000,ITOTALELEMS)
  227.  
  228.     BTRAN = .TRUE.
  229.  
  230.     IFINESIDE = NDEN2+1
  231.     ISIDE = NDEN3+1
  232.     NCOARSESIDE = 0.75D0*(IFINESIDE-1)
  233.  
  234.     NRESIDUAL = (IFINESIDE-1)-NCOARSESIDE
  235.     IF ( MOD(NRESIDUAL,2) .NE.0 ) THEN
  236.         NCOARSESIDE = NCOARSESIDE +1
  237.     END IF
  238.     ICOARSESIDE = NCOARSESIDE +1
  239.     IF ( (IFINESIDE - ICOARSESIDE).LT. 2 ) BTRAN = .FALSE.
  240.     IF ( BTRAN ) THEN
  241.         NDEN7 = NCOARSESIDE
  242.     ELSE
  243.         NDEN7 = IFINESIDE - 1
  244.     END IF
  245.  
  246.       CALL INITMESH(INODE_TEMP2,IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2,&  10000,10000)
  247.     IF ( BTRAN ) THEN
  248.         CALL MESHRECTANGLE_TRANSITION2(IFINESIDE,ICOARSESIDE, ISIDE, &      INODE_TEMP2,&       IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2)
  249.     ELSE
  250.         CALL MESHRECTANGLE(IFINESIDE, ISIDE, INODE_TEMP2,&      IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2)
  251.     END IF
  252.     CALL GETNODENUMBER(INODE_TEMP2, 10000,ITOTALNODES2)
  253.     CALL GETELEMNUMBER(IELEM_TEMP2, 10000,ITOTALELEMS2)
  254.     CALL MARKBCFACE(INODE_TEMP2, COORD_TEMP2,IELEM_TEMP2,INELEM_TEMP2, &    ITOTALELEMS2,2,1)!!THIS SAYS: SET FACE 3  TO 1,FREE
  255.  
  256.  
  257.     CORNERS(1,1) = POINTS(1,10)
  258.     CORNERS(2,1) = POINTS(2,10)
  259.     CORNERS(1,2) = POINTS(1,6)
  260.     CORNERS(2,2) = POINTS(2,6)
  261.     CORNERS(1,3) = POINTS(1,12)
  262.     CORNERS(2,3) = POINTS(2,12)
  263.     CORNERS(1,4) = POINTS(1,11)
  264.     CORNERS(2,4) = POINTS(2,11)
  265.     CALL TRANSFORMNODES(COORD_TEMP2,CORNERS,ITOTALNODES2,1.0D0,1.2D0)
  266.  
  267.     CALL MERGEBLOCKMESHES(INODE_TEMP1, IELEM_TEMP1, INELEM_TEMP1,& ITOTALNODES,ITOTALELEMS,COORD_TEMP1, INODE_TEMP2, IELEM_TEMP2, & INELEM_TEMP2, ITOTALNODES2, ITOTALELEMS2, COORD_TEMP2)
  268.  
  269.     CALL GETNODENUMBER(INODE_TEMP1, 10000,ITOTALNODES)
  270.     CALL GETELEMNUMBER(IELEM_TEMP1, 10000,ITOTALELEMS)
  271.  
  272.       CALL INITMESH(INODE_TEMP2,IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2,&         10000,10000)
  273.     IF ( BTRAN ) THEN
  274.         CALL MESHRECTANGLE_TRANSITION2(IFINESIDE,ICOARSESIDE, ISIDE,&        INODE_TEMP2,&      IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2)
  275.     ELSE
  276.         CALL MESHRECTANGLE(IFINESIDE, ISIDE, INODE_TEMP2,&      IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2)
  277.     END IF
  278.     CALL GETNODENUMBER(INODE_TEMP2, 10000,ITOTALNODES2)
  279.     CALL GETELEMNUMBER(IELEM_TEMP2, 10000,ITOTALELEMS2)
  280.  
  281.     CALL MARKBCFACE(INODE_TEMP2, COORD_TEMP2,IELEM_TEMP2,INELEM_TEMP2,& ITOTALELEMS2,4,1)!!THIS SAYS: SET FACE 4 TO 1, FREE CONVECTION
  282.        
  283.     CORNERS(1,1) = POINTS(1,3)
  284.     CORNERS(2,1) = POINTS(2,3)
  285.     CORNERS(1,2) = POINTS(1,1)
  286.     CORNERS(2,2) = POINTS(2,1)
  287.     CORNERS(1,3) = POINTS(1,2)
  288.     CORNERS(2,3) = POINTS(2,2)
  289.     CORNERS(1,4) = POINTS(1,17)
  290.     CORNERS(2,4) = POINTS(2,17)
  291.     CALL TRANSFORMNODES(COORD_TEMP2,CORNERS,ITOTALNODES2,1.0D0,1.2D0)
  292.  
  293.     CALL MERGEBLOCKMESHES(INODE_TEMP1, IELEM_TEMP1, INELEM_TEMP1, & ITOTALNODES,ITOTALELEMS,COORD_TEMP1, INODE_TEMP2, IELEM_TEMP2, & INELEM_TEMP2, ITOTALNODES2, ITOTALELEMS2, COORD_TEMP2)
  294.  
  295.     CALL GETNODENUMBER(INODE_TEMP1, 10000,ITOTALNODES)
  296.     CALL GETELEMNUMBER(IELEM_TEMP1, 10000,ITOTALELEMS)
  297.  
  298.     BTRAN = .TRUE.
  299.  
  300.     IFINESIDE = NDEN7+1
  301.     ISIDE = NDEN6+1
  302.     NCOARSESIDE = 0.2D0*(IFINESIDE-1)
  303.     IF ( NCOARSESIDE .LT. 5 ) NCOARSESIDE = 5
  304.     NRESIDUAL = (IFINESIDE-1)-NCOARSESIDE
  305.     IF ( MOD(NRESIDUAL,2) .NE.0 ) THEN
  306.         NCOARSESIDE = NCOARSESIDE +1
  307.     END IF
  308.     ICOARSESIDE = NCOARSESIDE +1
  309.     IF ( (IFINESIDE - ICOARSESIDE).LT. 2 ) BTRAN = .FALSE.
  310.     IF ( BTRAN ) THEN
  311.         NDEN8 = NCOARSESIDE
  312.     ELSE
  313.         NDEN8 = IFINESIDE - 1
  314.     END IF
  315.  
  316.       CALL INITMESH(INODE_TEMP2,IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2,&  10000,10000)
  317.     IF ( BTRAN ) THEN
  318.         CALL MESHRECTANGLE_TRANSITION2(IFINESIDE,ICOARSESIDE, ISIDE,&        INODE_TEMP2,&      IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2)
  319.     ELSE
  320.         CALL MESHRECTANGLE(IFINESIDE, ISIDE, INODE_TEMP2,&      IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2)
  321.     END IF
  322.     CALL GETNODENUMBER(INODE_TEMP2, 10000,ITOTALNODES2)
  323.     CALL GETELEMNUMBER(IELEM_TEMP2, 10000,ITOTALELEMS2)
  324.  
  325.     CALL MARKBCFACE(INODE_TEMP2, COORD_TEMP2,IELEM_TEMP2,INELEM_TEMP2,& ITOTALELEMS2,2,1)!!THIS SAYS: SET 2 TO 1, FREE CONVECTION
  326.  
  327.     CORNERS(1,1) = POINTS(1,11)
  328.     CORNERS(2,1) = POINTS(2,11)
  329.     CORNERS(1,2) = POINTS(1,12)
  330.     CORNERS(2,2) = POINTS(2,12)
  331.     CORNERS(1,3) = POINTS(1,13)
  332.     CORNERS(2,3) = POINTS(2,13)
  333.     CORNERS(1,4) = POINTS(1,14)
  334.     CORNERS(2,4) = POINTS(2,14)
  335.     CALL TRANSFORMNODES(COORD_TEMP2,CORNERS,ITOTALNODES2,1.0D0,1.5D0)
  336.  
  337.     CALL MERGEBLOCKMESHES(INODE_TEMP1, IELEM_TEMP1, INELEM_TEMP1,& ITOTALNODES,ITOTALELEMS,COORD_TEMP1, INODE_TEMP2, IELEM_TEMP2, & INELEM_TEMP2, ITOTALNODES2, ITOTALELEMS2, COORD_TEMP2)
  338.  
  339.     CALL GETNODENUMBER(INODE_TEMP1, 10000,ITOTALNODES)
  340.     CALL GETELEMNUMBER(IELEM_TEMP1, 10000,ITOTALELEMS)
  341.  
  342.       CALL INITMESH(INODE_TEMP2,IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2,&  10000,10000)
  343.     IF ( BTRAN ) THEN
  344.         CALL MESHRECTANGLE_TRANSITION2(IFINESIDE,ICOARSESIDE, ISIDE,&        INODE_TEMP2,&      IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2)
  345.     ELSE
  346.         CALL MESHRECTANGLE(IFINESIDE, ISIDE, INODE_TEMP2, &     IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2)
  347.     END IF
  348.     CALL GETNODENUMBER(INODE_TEMP2, 10000,ITOTALNODES2)
  349.     CALL GETELEMNUMBER(IELEM_TEMP2, 10000,ITOTALELEMS2)
  350.  
  351.     CALL MARKBCFACE(INODE_TEMP2, COORD_TEMP2,IELEM_TEMP2,INELEM_TEMP2,& ITOTALELEMS2,4,1)!!THIS SAYS: SET FACE 1 TO 1, FREE CONVECTION
  352.  
  353.     CORNERS(1,1) = POINTS(1,17)
  354.     CORNERS(2,1) = POINTS(2,17)
  355.     CORNERS(1,2) = POINTS(1,2)
  356.     CORNERS(2,2) = POINTS(2,2)
  357.     CORNERS(1,3) = POINTS(1,16)
  358.     CORNERS(2,3) = POINTS(2,16)
  359.     CORNERS(1,4) = POINTS(1,18)
  360.     CORNERS(2,4) = POINTS(2,18)
  361.     CALL TRANSFORMNODES(COORD_TEMP2,CORNERS,ITOTALNODES2,1.0D0,1.5D0)
  362.  
  363.     CALL MERGEBLOCKMESHES(INODE_TEMP1, IELEM_TEMP1, INELEM_TEMP1,& ITOTALNODES,ITOTALELEMS,COORD_TEMP1, INODE_TEMP2, IELEM_TEMP2, & INELEM_TEMP2, ITOTALNODES2, ITOTALELEMS2, COORD_TEMP2)
  364.  
  365.     CALL GETNODENUMBER(INODE_TEMP1, 10000,ITOTALNODES)
  366.     CALL GETELEMNUMBER(IELEM_TEMP1, 10000,ITOTALELEMS)
  367.  
  368.     DTEMP1 = DSQRT((POINTS(1,12)-POINTS(1,13))*(POINTS(1,12)&   -POINTS(1,13))& + (POINTS(2,19)-POINTS(2,13))*(POINTS(2,19)-POINTS(2,13)))
  369.     DTEMP2 = DSQRT((POINTS(1,19)-POINTS(1,13))*(POINTS(1,19)&   -POINTS(1,13))& + (POINTS(2,19)-POINTS(2,13))*(POINTS(2,19)-POINTS(2,13)))
  370.     NDEN9 = 0.6D0*NDEN6
  371.     IF ( NDEN9 .LT.3 ) NDEN9 =3
  372.     NDEN10 = NDEN8-2
  373.  
  374.     BTRAN = .TRUE.
  375.  
  376.     IFINESIDE = NDEN8+1
  377.  
  378.     IF ( IFINESIDE .LE. 3 ) BTRAN = .FALSE.
  379.     ISIDE = NDEN9+1
  380.  
  381.     IF ( BTRAN ) THEN
  382.     ELSE
  383.         NDEN10 = IFINESIDE -1
  384.     END IF
  385.  
  386.       CALL INITMESH(INODE_TEMP2,IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2,&  10000,10000)
  387.  
  388.     IF ( BTRAN ) THEN
  389.         CALL MESHRECTANGLE_TRANSITION(IFINESIDE, ISIDE, INODE_TEMP2,&       IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2)
  390.     ELSE
  391.         CALL MESHRECTANGLE(IFINESIDE, ISIDE, INODE_TEMP2,&      IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2)
  392.     END IF
  393.  
  394.     CALL GETNODENUMBER(INODE_TEMP2, 10000,ITOTALNODES2)
  395.     CALL GETELEMNUMBER(IELEM_TEMP2, 10000,ITOTALELEMS2)
  396.  
  397.     CALL MARKBCFACE(INODE_TEMP2, COORD_TEMP2,IELEM_TEMP2,INELEM_TEMP2,& ITOTALELEMS2,4,2)!!THIS SAYS: SET FACE 4 TO 2, FORCED
  398.  
  399.     CORNERS(1,1) = POINTS(1,14)
  400.     CORNERS(2,1) = POINTS(2,14)
  401.     CORNERS(1,2) = POINTS(1,13)
  402.     CORNERS(2,2) = POINTS(2,13)
  403.     CORNERS(1,3) = POINTS(1,19)
  404.     CORNERS(2,3) = POINTS(2,19)
  405.     CORNERS(1,4) = POINTS(1,20)
  406.     CORNERS(2,4) = POINTS(2,20)
  407.     CALL TRANSFORMNODES(COORD_TEMP2,CORNERS,ITOTALNODES2,1.0D0,1.5D0)
  408.  
  409.     CALL MERGEBLOCKMESHES(INODE_TEMP1, IELEM_TEMP1, INELEM_TEMP1,& ITOTALNODES,ITOTALELEMS,COORD_TEMP1, INODE_TEMP2, IELEM_TEMP2, & INELEM_TEMP2, ITOTALNODES2, ITOTALELEMS2, COORD_TEMP2)
  410.  
  411.     CALL GETNODENUMBER(INODE_TEMP1, 10000,ITOTALNODES)
  412.     CALL GETELEMNUMBER(IELEM_TEMP1, 10000,ITOTALELEMS)
  413.  
  414.       CALL INITMESH(INODE_TEMP2,IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2,&  10000,10000)
  415.  
  416.     IF ( BTRAN ) THEN
  417.         CALL MESHRECTANGLE_TRANSITION(IFINESIDE, ISIDE, INODE_TEMP2,&       IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2)
  418.     ELSE
  419.         CALL MESHRECTANGLE(IFINESIDE, ISIDE, INODE_TEMP2,&      IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2)
  420.     END IF
  421.  
  422.     CALL GETNODENUMBER(INODE_TEMP2, 10000,ITOTALNODES2)
  423.     CALL GETELEMNUMBER(IELEM_TEMP2, 10000,ITOTALELEMS2)
  424.  
  425.     CALL MARKBCFACE(INODE_TEMP2, COORD_TEMP2,IELEM_TEMP2,INELEM_TEMP2,& ITOTALELEMS2,2,2)!!THIS SAYS: SET FACE 2 TO 2, FORCED
  426.  
  427.     CORNERS(1,1) = POINTS(1,18)
  428.     CORNERS(2,1) = POINTS(2,18)
  429.     CORNERS(1,2) = POINTS(1,16)
  430.     CORNERS(2,2) = POINTS(2,16)
  431.     CORNERS(1,3) = POINTS(1,22)
  432.     CORNERS(2,3) = POINTS(2,22)
  433.     CORNERS(1,4) = POINTS(1,21)
  434.     CORNERS(2,4) = POINTS(2,21)
  435.     CALL TRANSFORMNODES(COORD_TEMP2,CORNERS,ITOTALNODES2,1.0D0,1.5D0)
  436.  
  437.     CALL MERGEBLOCKMESHES(INODE_TEMP1, IELEM_TEMP1, INELEM_TEMP1,& ITOTALNODES,ITOTALELEMS,COORD_TEMP1, INODE_TEMP2, IELEM_TEMP2, & INELEM_TEMP2, ITOTALNODES2, ITOTALELEMS2, COORD_TEMP2)
  438.  
  439.     CALL GETNODENUMBER(INODE_TEMP1, 10000,ITOTALNODES)
  440.     CALL GETELEMNUMBER(IELEM_TEMP1, 10000,ITOTALELEMS)
  441.  
  442.     DTEMP1 = DABS(POINTS(2,19)-POINTS(2,23))
  443.     DTEMP2 = T_PIPE
  444.     NDEN11 = 0.1D0*NDEN9*DTEMP1/DTEMP2
  445.     IF ( NDEN11 .LT. 2 ) NDEN11 = 2
  446.  
  447.     IFINESIDE = NDEN10+1
  448.     ISIDE = NDEN11 +1
  449.       CALL INITMESH(INODE_TEMP2,IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2, &     10000,10000)
  450.     CALL MESHRECTANGLE(IFINESIDE, ISIDE, INODE_TEMP2,& IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2)
  451.     CALL GETNODENUMBER(INODE_TEMP2, 10000,ITOTALNODES2)
  452.     CALL GETELEMNUMBER(IELEM_TEMP2, 10000,ITOTALELEMS2)
  453.  
  454.     CALL MARKBCFACE(INODE_TEMP2, COORD_TEMP2,IELEM_TEMP2,INELEM_TEMP2,& ITOTALELEMS2,4,2)!!THIS SAYS: SET FACE 4 TO 2, FORCED
  455.     CORNERS(1,1) = POINTS(1,20)
  456.     CORNERS(2,1) = POINTS(2,20)
  457.     CORNERS(1,2) = POINTS(1,19)
  458.     CORNERS(2,2) = POINTS(2,19)
  459.     CORNERS(1,3) = POINTS(1,23)
  460.     CORNERS(2,3) = POINTS(2,23)
  461.     CORNERS(1,4) = POINTS(1,24)
  462.     CORNERS(2,4) = POINTS(2,24)
  463.     CALL TRANSFORMNODES(COORD_TEMP2,CORNERS,ITOTALNODES2,1.0D0,1.5D0)
  464.  
  465.     CALL MERGEBLOCKMESHES(INODE_TEMP1, IELEM_TEMP1, INELEM_TEMP1,& ITOTALNODES,ITOTALELEMS,COORD_TEMP1, INODE_TEMP2, IELEM_TEMP2, & INELEM_TEMP2, ITOTALNODES2, ITOTALELEMS2, COORD_TEMP2)
  466.  
  467.     CALL GETNODENUMBER(INODE_TEMP1, 10000,ITOTALNODES)
  468.     CALL GETELEMNUMBER(IELEM_TEMP1, 10000,ITOTALELEMS)
  469.  
  470.       CALL INITMESH(INODE_TEMP2,IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2,&  10000,10000)
  471.     CALL MESHRECTANGLE(IFINESIDE, ISIDE, INODE_TEMP2,& IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2)
  472.     CALL GETNODENUMBER(INODE_TEMP2, 10000,ITOTALNODES2)
  473.     CALL GETELEMNUMBER(IELEM_TEMP2, 10000,ITOTALELEMS2)
  474.  
  475.     CALL MARKBCFACE(INODE_TEMP2, COORD_TEMP2,IELEM_TEMP2,INELEM_TEMP2, &    ITOTALELEMS2,2,2)!!THIS SAYS: SET FACE 2 TO 2, FORCED
  476.     CORNERS(1,1) = POINTS(1,21)
  477.     CORNERS(2,1) = POINTS(2,21)
  478.     CORNERS(1,2) = POINTS(1,22)
  479.     CORNERS(2,2) = POINTS(2,22)
  480.     CORNERS(1,3) = POINTS(1,26)
  481.     CORNERS(2,3) = POINTS(2,26)
  482.     CORNERS(1,4) = POINTS(1,25)
  483.     CORNERS(2,4) = POINTS(2,25)
  484.     CALL TRANSFORMNODES(COORD_TEMP2,CORNERS,ITOTALNODES2,1.0D0,1.5D0)
  485.  
  486.     CALL MERGEBLOCKMESHES(INODE_TEMP1, IELEM_TEMP1, INELEM_TEMP1,& ITOTALNODES,ITOTALELEMS,COORD_TEMP1, INODE_TEMP2, IELEM_TEMP2, & INELEM_TEMP2, ITOTALNODES2, ITOTALELEMS2, COORD_TEMP2)
  487.  
  488.     CALL GETNODENUMBER(INODE_TEMP1, 10000,ITOTALNODES)
  489.     CALL GETELEMNUMBER(IELEM_TEMP1, 10000,ITOTALELEMS)
  490.  
  491.     CALL MARKELEMENTS(IELEM_TEMP1, ITOTALELEMS, 2,1)
  492.  
  493.     IFINESIDE = NDEN12+1
  494.       CALL INITMESH(INODE_TEMP2,IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2,&  10000,10000)
  495.     CALL MESHRECTANGLE(IFINESIDE, IFINESIDE, INODE_TEMP2,& IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2)
  496.     CALL GETNODENUMBER(INODE_TEMP2, 10000,ITOTALNODES2)
  497.     CALL GETELEMNUMBER(IELEM_TEMP2, 10000,ITOTALELEMS2)
  498.  
  499.     CALL MARKELEMENTS(IELEM_TEMP2,ITOTALELEMS2,2,3)
  500.  
  501.     CALL MARKBCFACE(INODE_TEMP2, COORD_TEMP2,IELEM_TEMP2,INELEM_TEMP2, &    ITOTALELEMS2,4,1)!!THIS SAYS: SET FACE  TO 1, FREE
  502.  
  503.     CORNERS(1,1) = POINTS(1,6)
  504.     CORNERS(2,1) = POINTS(2,6)
  505.     CORNERS(1,2) = POINTS(1,7)
  506.     CORNERS(2,2) = POINTS(2,7)
  507.     CORNERS(1,3) = POINTS(1,29)
  508.     CORNERS(2,3) = POINTS(2,29)
  509.     CORNERS(1,4) = POINTS(1,27)
  510.     CORNERS(2,4) = POINTS(2,27)
  511.     CALL TRANSFORMNODES(COORD_TEMP2,CORNERS,ITOTALNODES2,1.0D0,1.0D0)
  512.  
  513.     CALL MERGEBLOCKMESHES(INODE_TEMP1, IELEM_TEMP1, INELEM_TEMP1,& ITOTALNODES,ITOTALELEMS,COORD_TEMP1, INODE_TEMP2, IELEM_TEMP2, & INELEM_TEMP2, ITOTALNODES2, ITOTALELEMS2, COORD_TEMP2)
  514.  
  515.     CALL GETNODENUMBER(INODE_TEMP1, 10000,ITOTALNODES)
  516.     CALL GETELEMNUMBER(IELEM_TEMP1, 10000,ITOTALELEMS)
  517.  
  518.       CALL INITMESH(INODE_TEMP2,IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2,&  10000,10000)
  519.     CALL MESHRECTANGLE(IFINESIDE, IFINESIDE, INODE_TEMP2,& IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2)
  520.     CALL GETNODENUMBER(INODE_TEMP2, 10000,ITOTALNODES2)
  521.     CALL GETELEMNUMBER(IELEM_TEMP2, 10000,ITOTALELEMS2)
  522.  
  523.     CALL MARKELEMENTS(IELEM_TEMP2,ITOTALELEMS2,2,3)
  524.  
  525.     CORNERS(1,1) = POINTS(1,7)
  526.     CORNERS(2,1) = POINTS(2,7)
  527.     CORNERS(1,2) = POINTS(1,3)
  528.     CORNERS(2,2) = POINTS(2,3)
  529.     CORNERS(1,3) = POINTS(1,28)
  530.     CORNERS(2,3) = POINTS(2,28)
  531.     CORNERS(1,4) = POINTS(1,29)
  532.     CORNERS(2,4) = POINTS(2,29)
  533.     CALL TRANSFORMNODES(COORD_TEMP2,CORNERS,ITOTALNODES2,1.0D0,1.0D0)
  534.  
  535.     CALL MERGEBLOCKMESHES(INODE_TEMP1, IELEM_TEMP1, INELEM_TEMP1, & ITOTALNODES,ITOTALELEMS,COORD_TEMP1, INODE_TEMP2, IELEM_TEMP2, & INELEM_TEMP2, ITOTALNODES2, ITOTALELEMS2, COORD_TEMP2)
  536.  
  537.     CALL GETNODENUMBER(INODE_TEMP1, 10000,ITOTALNODES)
  538.     CALL GETELEMNUMBER(IELEM_TEMP1, 10000,ITOTALELEMS)
  539.       CALL INITMESH(INODE_TEMP2,IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2, &     10000,10000)
  540.     CALL MESHRECTANGLE(IFINESIDE, IFINESIDE, INODE_TEMP2,& IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2)
  541.     CALL GETNODENUMBER(INODE_TEMP2, 10000,ITOTALNODES2)
  542.     CALL GETELEMNUMBER(IELEM_TEMP2, 10000,ITOTALELEMS2)
  543.  
  544.     CALL MARKELEMENTS(IELEM_TEMP2,ITOTALELEMS2,2,3)
  545.  
  546.     CALL MARKBCFACE(INODE_TEMP2, COORD_TEMP2,IELEM_TEMP2,INELEM_TEMP2,& ITOTALELEMS2,3,1)!!THIS SAYS: SET FACE 3 TO 1,FREE
  547.  
  548.     CORNERS(1,1) = POINTS(1,29)
  549.     CORNERS(2,1) = POINTS(2,29)
  550.     CORNERS(1,2) = POINTS(1,28)
  551.     CORNERS(2,2) = POINTS(2,28)
  552.     CORNERS(1,3) = POINTS(1,5)
  553.     CORNERS(2,3) = POINTS(2,5)
  554.     CORNERS(1,4) = POINTS(1,27)
  555.     CORNERS(2,4) = POINTS(2,27)
  556.     CALL TRANSFORMNODES(COORD_TEMP2,CORNERS,ITOTALNODES2,1.0D0,1.0D0)
  557.  
  558.     CALL MERGEBLOCKMESHES(INODE_TEMP1, IELEM_TEMP1, INELEM_TEMP1,& ITOTALNODES,ITOTALELEMS,COORD_TEMP1, INODE_TEMP2, IELEM_TEMP2, & INELEM_TEMP2, ITOTALNODES2, ITOTALELEMS2, COORD_TEMP2)
  559.  
  560.     CALL GETNODENUMBER(INODE_TEMP1, 10000,ITOTALNODES)
  561.     CALL GETELEMNUMBER(IELEM_TEMP1, 10000,ITOTALELEMS)
  562.  
  563.     NDEN13 = 2*NDEN12
  564.     NDEN16 = (DABS(POINTS(1,33) - POINTS(1,31)))/DMESHSIZE
  565.     NRESIDUAL = NDEN16 - NDEN13
  566.     IF ( MOD(NRESIDUAL, 2) .NE. 0 ) THEN
  567.         NDEN16 = NDEN16 +1
  568.     END IF
  569.     IFINESIDE = NDEN16 + 1
  570.     ICOARSESIDE = NDEN13 +1
  571.     NDEN15 = NDEN2
  572.     ISIDE = NDEN15 +1
  573.       CALL INITMESH(INODE_TEMP2,IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2,&  10000,10000)
  574.     CALL MESHRECTANGLE_TRANSITION2(IFINESIDE, ICOARSESIDE, ISIDE&   , INODE_TEMP2,& IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2)
  575.     CALL GETNODENUMBER(INODE_TEMP2, 10000,ITOTALNODES2)
  576.     CALL GETELEMNUMBER(IELEM_TEMP2, 10000,ITOTALELEMS2)
  577.  
  578.     CALL MARKELEMENTS(IELEM_TEMP2,ITOTALELEMS2,2,2)
  579.  
  580.     CALL MARKBCFACE(INODE_TEMP2, COORD_TEMP2,IELEM_TEMP2,INELEM_TEMP2,& ITOTALELEMS2,4,1)!!THIS SAYS: SET FACE 4 TO 1, FREE
  581.  
  582.  
  583.     CORNERS(1,1) = POINTS(1,33)
  584.     CORNERS(2,1) = POINTS(2,33)
  585.     CORNERS(1,2) = POINTS(1,32)
  586.     CORNERS(2,2) = POINTS(2,32)
  587.     CORNERS(1,3) = POINTS(1,5)
  588.     CORNERS(2,3) = POINTS(2,5)
  589.     CORNERS(1,4) = POINTS(1,3)
  590.     CORNERS(2,4) = POINTS(2,3) 
  591.     CALL TRANSFORMNODES(COORD_TEMP2,CORNERS,ITOTALNODES2,1.0D0,1.0D0)
  592.  
  593.     CALL MERGEBLOCKMESHES(INODE_TEMP1, IELEM_TEMP1, INELEM_TEMP1,& ITOTALNODES,ITOTALELEMS,COORD_TEMP1, INODE_TEMP2, IELEM_TEMP2, & INELEM_TEMP2, ITOTALNODES2, ITOTALELEMS2, COORD_TEMP2)
  594.  
  595.     CALL GETNODENUMBER(INODE_TEMP1, 10000,ITOTALNODES)
  596.     CALL GETELEMNUMBER(IELEM_TEMP1, 10000,ITOTALELEMS)
  597.  
  598.     NDEN18 = NDEN3
  599.     NDEN19 = 0.3D0*NDEN16
  600.     NRESIDUAL = NDEN16-NDEN19
  601.     IF ( MOD(NRESIDUAL, 2) .NE. 0) THEN
  602.         NDEN19 = NDEN19 +1
  603.     END IF
  604.     IFINESIDE = NDEN16 +1
  605.     ISIDE = NDEN18+1
  606.     ICOARSESIDE = NDEN19+1
  607.       CALL INITMESH(INODE_TEMP2,IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2,&  10000,10000)
  608.     CALL MESHRECTANGLE_TRANSITION2(IFINESIDE, ICOARSESIDE, ISIDE&   , INODE_TEMP2,& IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2)
  609.     CALL GETNODENUMBER(INODE_TEMP2, 10000,ITOTALNODES2)
  610.     CALL GETELEMNUMBER(IELEM_TEMP2, 10000,ITOTALELEMS2)
  611.  
  612.     CALL MARKELEMENTS(IELEM_TEMP2,ITOTALELEMS2,2,2)
  613.     CALL MARKBCFACE(INODE_TEMP2, COORD_TEMP2,IELEM_TEMP2,INELEM_TEMP2, &    ITOTALELEMS2,2,1)!!THIS SAYS: SET FACE 2 TO 1,FREE
  614.  
  615.     CORNERS(1,1) = POINTS(1,32)
  616.     CORNERS(2,1) = POINTS(2,32)
  617.     CORNERS(1,2) = POINTS(1,33)
  618.     CORNERS(2,2) = POINTS(2,33)
  619.     CORNERS(1,3) = POINTS(1,36)
  620.     CORNERS(2,3) = POINTS(2,36)
  621.     CORNERS(1,4) = POINTS(1,35)
  622.     CORNERS(2,4) = POINTS(2,35)
  623.     CALL TRANSFORMNODES(COORD_TEMP2,CORNERS,ITOTALNODES2,1.0D0,1.0D0)
  624.  
  625.     CALL MERGEBLOCKMESHES(INODE_TEMP1, IELEM_TEMP1, INELEM_TEMP1, & ITOTALNODES,ITOTALELEMS,COORD_TEMP1, INODE_TEMP2, IELEM_TEMP2, & INELEM_TEMP2, ITOTALNODES2, ITOTALELEMS2, COORD_TEMP2)
  626.  
  627.     CALL GETNODENUMBER(INODE_TEMP1, 10000,ITOTALNODES)
  628.     CALL GETELEMNUMBER(IELEM_TEMP1, 10000,ITOTALELEMS)
  629.  
  630.     NDEN21 = NDEN9
  631.     NDEN22 = 0.2D0*NDEN19
  632.     IF ( NDEN22 .EQ. 0 ) NDEN22 =1
  633.     NRESIDUAL = NDEN19-NDEN22
  634.     IF ( MOD(NRESIDUAL, 2) .NE. 0) THEN
  635.         NDEN22 = NDEN22 +1
  636.     END IF
  637.     IFINESIDE = NDEN19 +1
  638.     ISIDE = NDEN21+1
  639.     ICOARSESIDE = NDEN22+1
  640.  
  641.     BTRAN = .TRUE.
  642.  
  643.     IF ( (IFINESIDE - ICOARSESIDE ) .LT. 2) BTRAN = .FALSE.
  644.     IF ( BTRAN ) THEN
  645.     ELSE
  646.         NDEN22 = IFINESIDE - 1
  647.     END IF
  648.  
  649.       CALL INITMESH(INODE_TEMP2,IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2,&  10000,10000)
  650.    
  651.     IF ( BTRAN ) THEN
  652.         CALL MESHRECTANGLE_TRANSITION2(IFINESIDE,ICOARSESIDE, ISIDE,&        INODE_TEMP2,&      IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2)
  653.     ELSE
  654.         CALL MESHRECTANGLE(IFINESIDE, ISIDE, INODE_TEMP2,&      IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2)
  655.     END IF
  656.  
  657.     CALL GETNODENUMBER(INODE_TEMP2, 10000,ITOTALNODES2)
  658.     CALL GETELEMNUMBER(IELEM_TEMP2, 10000,ITOTALELEMS2)
  659.  
  660.     CALL MARKELEMENTS(IELEM_TEMP2,ITOTALELEMS2,2,2)
  661.  
  662.     CALL MARKBCFACE(INODE_TEMP2, COORD_TEMP2,IELEM_TEMP2,INELEM_TEMP2,& ITOTALELEMS2,2,1)!!THIS SAYS: SET FACE TO 1,FREE
  663.  
  664.  
  665.     CORNERS(1,1) = POINTS(1,35)
  666.     CORNERS(2,1) = POINTS(2,35)
  667.     CORNERS(1,2) = POINTS(1,36)
  668.     CORNERS(2,2) = POINTS(2,36)
  669.     CORNERS(1,3) = POINTS(1,39)
  670.     CORNERS(2,3) = POINTS(2,39)
  671.     CORNERS(1,4) = POINTS(1,38)
  672.     CORNERS(2,4) = POINTS(2,38)
  673.     CALL TRANSFORMNODES(COORD_TEMP2,CORNERS,ITOTALNODES2,1.0D0,1.0D0)
  674.  
  675.     CALL MERGEBLOCKMESHES(INODE_TEMP1, IELEM_TEMP1, INELEM_TEMP1,& ITOTALNODES,ITOTALELEMS,COORD_TEMP1, INODE_TEMP2, IELEM_TEMP2, & INELEM_TEMP2, ITOTALNODES2, ITOTALELEMS2, COORD_TEMP2)
  676.  
  677.     CALL GETNODENUMBER(INODE_TEMP1, 10000,ITOTALNODES)
  678.     CALL GETELEMNUMBER(IELEM_TEMP1, 10000,ITOTALELEMS)
  679.  
  680.     NDEN24 = NDEN11
  681.     IFINESIDE = NDEN22 +1
  682.     ISIDE = NDEN24+1
  683.       CALL INITMESH(INODE_TEMP2,IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2,&  10000,10000)
  684.     CALL MESHRECTANGLE(IFINESIDE, ISIDE, INODE_TEMP2,& IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2)
  685.     CALL GETNODENUMBER(INODE_TEMP2, 10000,ITOTALNODES2)
  686.     CALL GETELEMNUMBER(IELEM_TEMP2, 10000,ITOTALELEMS2)
  687.  
  688.     CALL MARKELEMENTS(IELEM_TEMP2,ITOTALELEMS2,2,2)
  689.     CALL MARKBCFACE(INODE_TEMP2, COORD_TEMP2,IELEM_TEMP2,INELEM_TEMP2, &    ITOTALELEMS2,2,1)!!THIS SAYS: SET FACE 2 TO 1,FREE
  690.  
  691.     CORNERS(1,1) = POINTS(1,38)
  692.     CORNERS(2,1) = POINTS(2,38)
  693.     CORNERS(1,2) = POINTS(1,39)
  694.     CORNERS(2,2) = POINTS(2,39)
  695.     CORNERS(1,3) = POINTS(1,42)
  696.     CORNERS(2,3) = POINTS(2,42)
  697.     CORNERS(1,4) = POINTS(1,41)
  698.     CORNERS(2,4) = POINTS(2,41)
  699.     CALL TRANSFORMNODES(COORD_TEMP2,CORNERS,ITOTALNODES2,1.0D0,1.5D0)
  700.  
  701.     CALL MERGEBLOCKMESHES(INODE_TEMP1, IELEM_TEMP1, INELEM_TEMP1,& ITOTALNODES,ITOTALELEMS,COORD_TEMP1, INODE_TEMP2, IELEM_TEMP2, & INELEM_TEMP2, ITOTALNODES2, ITOTALELEMS2, COORD_TEMP2)
  702.  
  703.     CALL GETNODENUMBER(INODE_TEMP1, 10000,ITOTALNODES)
  704.     CALL GETELEMNUMBER(IELEM_TEMP1, 10000,ITOTALELEMS)
  705.  
  706.  
  707.     IF ( DABS(POINTS(1,5) - POINTS(1,30)) .GT. 5.0D-1) THEN
  708.         DRATIO = DABS(POINTS(1,5)-POINTS(1,30))/DBAND
  709.         IF ( DRATIO .GT. 1.0D0 ) THEN
  710.             NDEN14 = NDEN2
  711.         ELSE
  712.             NDEN14 = DRATIO*NDEN2
  713.         DRATIO = 1.0D0
  714.         END IF
  715.         NDEN14 = 0.5D0*NDEN14
  716.        
  717.         IF ( NDEN14 .GT. 8 ) THEN
  718.             IF ( MOD( NDEN14-6, 2) .EQ. 0) NDEN17 = 6
  719.             IF ( MOD( NDEN14-5, 2) .EQ. 0) NDEN17 = 5
  720.             IFINIESIDE = NDEN14+1
  721.             ICOARSESIDE = NDEN17+1
  722.             ISIDE = NDEN15+1
  723.             CALL INITMESH(INODE_TEMP2,IELEM_TEMP2,INELEM_TEMP2&         , COORD_TEMP2, &             10000,10000)
  724.             CALL MESHRECTANGLE_TRANSITION2(IFINESIDE,ICOARSESIDE,ISIDE, &            INODE_TEMP2,&      IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2)           
  725.         ELSE IF ( NDEN14 .LE.8 .AND. NDEN14 .GE.3 ) THEN
  726.             NDEN17 = NDEN14-2
  727.             IFINESIDE = NDEN14 +1
  728.             ISIDE = NDEN15 +2
  729.             CALL INITMESH(INODE_TEMP2,IELEM_TEMP2,INELEM_TEMP2&         , COORD_TEMP2,&          10000,10000)
  730.             CALL MESHRECTANGLE_TRANSITION(IFINESIDE,ISIDE&          , INODE_TEMP2,&     IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2)
  731.         ELSE
  732.             NDEN17 = NDEN14
  733.             IFINESIDE = NDEN14+1
  734.             ISIDE = NDEN15+1
  735.             CALL INITMESH(INODE_TEMP2,IELEM_TEMP2,INELEM_TEMP2&         , COORD_TEMP2, &             10000,10000)
  736.  
  737.             IF( IFINESIDE .LT. 2 )  IFINESIDE = 2
  738.             IF( ISIDE .LT. 2 ) ISIDE = 2
  739.             CALL MESHRECTANGLE(IFINESIDE,ISIDE, INODE_TEMP2,&       IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2)
  740.         END IF
  741.  
  742.         CALL GETNODENUMBER(INODE_TEMP2, 10000,ITOTALNODES2)
  743.         CALL GETELEMNUMBER(IELEM_TEMP2, 10000,ITOTALELEMS2)
  744.  
  745.         CALL MARKELEMENTS(IELEM_TEMP2,ITOTALELEMS2,2,2)
  746.         CALL MARKBCFACE(INODE_TEMP2, COORD_TEMP2,IELEM_TEMP2&       ,INELEM_TEMP2,&     ITOTALELEMS2,4,1)!!THIS SAYS: SET FACE 4 TO 1,FREE
  747.  
  748.  
  749.         CORNERS(1,1) = POINTS(1,30)
  750.         CORNERS(2,1) = POINTS(2,30)
  751.         CORNERS(1,2) = POINTS(1,5)
  752.         CORNERS(2,2) = POINTS(2,5)
  753.         CORNERS(1,3) = POINTS(1,32)
  754.         CORNERS(2,3) = POINTS(2,32)
  755.         CORNERS(1,4) = POINTS(1,31)
  756.         CORNERS(2,4) = POINTS(2,31)
  757.         CALL TRANSFORMNODES(COORD_TEMP2,CORNERS,ITOTALNODES2,0.5D0&     ,1.0D0)
  758.  
  759.         CALL MERGEBLOCKMESHES(INODE_TEMP1, IELEM_TEMP1, INELEM_TEMP1, & ITOTALNODES,ITOTALELEMS,COORD_TEMP1, INODE_TEMP2, IELEM_TEMP2, &    INELEM_TEMP2, ITOTALNODES2, ITOTALELEMS2, COORD_TEMP2)
  760.  
  761.         CALL GETNODENUMBER(INODE_TEMP1, 10000,ITOTALNODES)
  762.         CALL GETELEMNUMBER(IELEM_TEMP1, 10000,ITOTALELEMS)
  763.  
  764.         IF (NDEN17 .GT. 3) THEN
  765.             NDEN20 = NDEN17-2
  766.             IFINESIDE = NDEN17+1
  767.             ISIDE = NDEN18+1
  768.             CALL INITMESH(INODE_TEMP2,IELEM_TEMP2,INELEM_TEMP2&         , COORD_TEMP2,&          10000,10000)
  769.             CALL MESHRECTANGLE_TRANSITION(IFINESIDE,ISIDE&          , INODE_TEMP2,&     IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2)
  770.         ELSE
  771.             NDEN20 = NDEN17
  772.             IFINESIDE = NDEN17 +1
  773.             ISIDE = NDEN18+1
  774.  
  775.             IF( IFINESIDE .LT. 2 )  IFINESIDE = 2
  776.             IF( ISIDE .LT. 2 ) ISIDE = 2
  777.             CALL INITMESH(INODE_TEMP2,IELEM_TEMP2,INELEM_TEMP2 &, COORD_TEMP2,&          10000,10000)
  778.             CALL MESHRECTANGLE(IFINESIDE,ISIDE, INODE_TEMP2,&       IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2)
  779.         END IF
  780.         CALL GETNODENUMBER(INODE_TEMP2, 10000,ITOTALNODES2)
  781.         CALL GETELEMNUMBER(IELEM_TEMP2, 10000,ITOTALELEMS2)
  782.  
  783.         CALL MARKELEMENTS(IELEM_TEMP2,ITOTALELEMS2,2,2)
  784.         CALL MARKBCFACE(INODE_TEMP2, COORD_TEMP2,IELEM_TEMP2&       ,INELEM_TEMP2, &        ITOTALELEMS2,4,1)!!THIS SAYS: SET FACE 4 TO 1,FREE
  785.  
  786.         CORNERS(1,1) = POINTS(1,31)
  787.         CORNERS(2,1) = POINTS(2,31)
  788.         CORNERS(1,2) = POINTS(1,32)
  789.         CORNERS(2,2) = POINTS(2,32)
  790.         CORNERS(1,3) = POINTS(1,35)
  791.         CORNERS(2,3) = POINTS(2,35)
  792.         CORNERS(1,4) = POINTS(1,34)
  793.         CORNERS(2,4) = POINTS(2,34)
  794.         CALL TRANSFORMNODES(COORD_TEMP2,CORNERS,ITOTALNODES2,0.5D0 &        ,1.0D0)
  795.  
  796.         CALL MERGEBLOCKMESHES(INODE_TEMP1, IELEM_TEMP1, INELEM_TEMP1, & ITOTALNODES,ITOTALELEMS,COORD_TEMP1, INODE_TEMP2, IELEM_TEMP2,  &   INELEM_TEMP2, ITOTALNODES2, ITOTALELEMS2, COORD_TEMP2)
  797.  
  798.         CALL GETNODENUMBER(INODE_TEMP1, 10000,ITOTALNODES)
  799.         CALL GETELEMNUMBER(IELEM_TEMP1, 10000,ITOTALELEMS)
  800.  
  801.         NDEN23 = NDEN20
  802.         IFINESIDE = NDEN20+1
  803.         ISIDE = NDEN21+1
  804.  
  805.         IF( IFINESIDE .LT. 2 )  IFINESIDE = 2
  806.         IF( ISIDE .LT. 2 ) ISIDE = 2
  807.         CALL INITMESH(INODE_TEMP2,IELEM_TEMP2,INELEM_TEMP2&     , COORD_TEMP2,&      10000,10000)
  808.         CALL MESHRECTANGLE(IFINESIDE,ISIDE, INODE_TEMP2,&   IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2)
  809.         CALL GETNODENUMBER(INODE_TEMP2, 10000,ITOTALNODES2)
  810.         CALL GETELEMNUMBER(IELEM_TEMP2, 10000,ITOTALELEMS2)
  811.  
  812.         CALL MARKELEMENTS(IELEM_TEMP2,ITOTALELEMS2,2,2)
  813.         CALL MARKBCFACE(INODE_TEMP2, COORD_TEMP2,IELEM_TEMP2 &      ,INELEM_TEMP2,&     ITOTALELEMS2,4,1)!!THIS SAYS: SET FACE 4 TO 1,FREE
  814.  
  815.         CORNERS(1,1) = POINTS(1,34)
  816.         CORNERS(2,1) = POINTS(2,34)
  817.         CORNERS(1,2) = POINTS(1,35)
  818.         CORNERS(2,2) = POINTS(2,35)
  819.         CORNERS(1,3) = POINTS(1,38)
  820.         CORNERS(2,3) = POINTS(2,38)
  821.         CORNERS(1,4) = POINTS(1,37)
  822.         CORNERS(2,4) = POINTS(2,37)
  823.         CALL TRANSFORMNODES(COORD_TEMP2,CORNERS,ITOTALNODES2,0.5D0&     ,1.0D0)
  824.  
  825.         CALL MERGEBLOCKMESHES(INODE_TEMP1, IELEM_TEMP1, INELEM_TEMP1,&  ITOTALNODES,ITOTALELEMS,COORD_TEMP1, INODE_TEMP2, IELEM_TEMP2, &    INELEM_TEMP2, ITOTALNODES2, ITOTALELEMS2, COORD_TEMP2)
  826.  
  827.         CALL GETNODENUMBER(INODE_TEMP1, 10000,ITOTALNODES)
  828.         CALL GETELEMNUMBER(IELEM_TEMP1, 10000,ITOTALELEMS)
  829.  
  830.         ISIDE = NDEN24+1
  831.         IF( ISIDE .LT. 2 ) ISIDE = 2
  832.         CALL INITMESH(INODE_TEMP2,IELEM_TEMP2,INELEM_TEMP2&     , COORD_TEMP2,&      10000,10000)
  833.         CALL MESHRECTANGLE(IFINESIDE,ISIDE, INODE_TEMP2,&   IELEM_TEMP2,INELEM_TEMP2, COORD_TEMP2)
  834.         CALL GETNODENUMBER(INODE_TEMP2, 10000,ITOTALNODES2)
  835.         CALL GETELEMNUMBER(IELEM_TEMP2, 10000,ITOTALELEMS2)
  836.  
  837.         CALL MARKELEMENTS(IELEM_TEMP2,ITOTALELEMS2,2,2)
  838.         CALL MARKBCFACE(INODE_TEMP2, COORD_TEMP2,IELEM_TEMP2 &      ,INELEM_TEMP2,&     ITOTALELEMS2,4,1)!!THIS SAYS: SET FACE 4 TO 1,FREE
  839.  
  840.         CORNERS(1,1) = POINTS(1,37)
  841.         CORNERS(2,1) = POINTS(2,37)
  842.         CORNERS(1,2) = POINTS(1,38)
  843.         CORNERS(2,2) = POINTS(2,38)
  844.         CORNERS(1,3) = POINTS(1,41)
  845.         CORNERS(2,3) = POINTS(2,41)
  846.         CORNERS(1,4) = POINTS(1,40)
  847.         CORNERS(2,4) = POINTS(2,40)
  848.         CALL TRANSFORMNODES(COORD_TEMP2,CORNERS,ITOTALNODES2,0.5D0&     ,1.5D0)
  849.  
  850.         CALL MERGEBLOCKMESHES(INODE_TEMP1, IELEM_TEMP1, INELEM_TEMP1,&  ITOTALNODES,ITOTALELEMS,COORD_TEMP1, INODE_TEMP2, IELEM_TEMP2, &    INELEM_TEMP2, ITOTALNODES2, ITOTALELEMS2, COORD_TEMP2)
  851.  
  852.         CALL GETNODENUMBER(INODE_TEMP1, 10000,ITOTALNODES)
  853.         CALL GETELEMNUMBER(IELEM_TEMP1, 10000,ITOTALELEMS)
  854.  
  855.     END IF
  856.  
  857.     XX = POINTS(1,5)
  858.     YY = POINTS(2,5)
  859.     CALL FINDNODE(INODE_TEMP1,ITOTALNODES,COORD_TEMP1,XX,YY&    ,KEY_POINT(1))
  860.     XX = POINTS(1,27)
  861.     YY = POINTS(2,27)
  862.     CALL FINDNODE(INODE_TEMP1,ITOTALNODES,COORD_TEMP1,XX,YY&    ,KEY_POINT(2))
  863.     XX = POINTS(1,6)
  864.     YY = POINTS(2,6)
  865.     CALL FINDNODE(INODE_TEMP1,ITOTALNODES,COORD_TEMP1,XX,YY &   ,KEY_POINT(3))
  866.     XX = POINTS(1,3)
  867.     YY = POINTS(2,3)
  868.     CALL FINDNODE(INODE_TEMP1,ITOTALNODES,COORD_TEMP1,XX,YY&    ,KEY_POINT(4))
  869.     KEY_POINT(5) = KEY_POINT(4)
  870.     XX = POINTS(1,14)
  871.     YY = POINTS(2,14)
  872.     CALL FINDNODE(INODE_TEMP1,ITOTALNODES,COORD_TEMP1,XX,YY &   ,KEY_POINT(9))
  873.     XX = POINTS(1,15)
  874.     YY = POINTS(2,15)
  875.     CALL FINDNODE(INODE_TEMP1,ITOTALNODES,COORD_TEMP1,XX,YY &   ,KEY_POINT(10))
  876.     XX = POINTS(1,16)
  877.     YY = POINTS(2,16)
  878.     CALL FINDNODE(INODE_TEMP1,ITOTALNODES,COORD_TEMP1,XX,YY&    ,KEY_POINT(11))
  879.  
  880.     KEY_POINT(6) = KEY_POINT(3)
  881.     KEY_POINT(7) = KEY_POINT(3)
  882.     KEY_POINT(8) = KEY_POINT(3)
  883.  
  884.     NNODE = ITOTALNODES
  885.     NELEM = ITOTALELEMS
  886.  
  887.     DO I = 1, NNODE
  888.         INODE(I) = INODE_TEMP1(I)
  889.         COORD(1,I) = COORD_TEMP1(1,I)
  890.         COORD(2,I) = COORD_TEMP1(2,I)
  891.     END DO
  892.     DO I =1, ITOTALELEMS
  893.         LARRAY_ELE(1,I) = IELEM_TEMP1(1,I)
  894.         LARRAY_ELE(2,I) = INELEM_TEMP1(1,I)
  895.         LARRAY_ELE(3,I) = INELEM_TEMP1(2,I)
  896.         LARRAY_ELE(4,I) = INELEM_TEMP1(3,I)
  897.         LARRAY_ELE(5,I) = INELEM_TEMP1(4,I)
  898.         LARRAY_ELE(6,I) = IELEM_TEMP1(2,I)
  899.         LARRAY_ELE(7,I) = IELEM_TEMP1(3,I)
  900.         LARRAY_ELE(8,I) = IELEM_TEMP1(4,I)
  901.     END DO
  902.  
  903.  
  904.     OPEN (81, FILE="NODE_TEST.INP")
  905.     OPEN (82, FILE="ELEM_TEST.INP")
  906.     WRITE(81,*) "*NODE, NSET=GLOBAL"
  907.     WRITE(82,*) "*ELEMENT, TYPE=DCAX4, ELSET=EALL"
  908.     DO I = 1, 10000
  909.         IF ( INODE_TEMP1(I) .GT. 0 ) THEN
  910.             WRITE(81,900) INODE_TEMP1(I), COORD_TEMP1(1,I), &           COORD_TEMP1(2,I), 0.0D0
  911.         END IF
  912.     END DO
  913.  
  914.     DO I = 1, 10000
  915.         IF ( IELEM_TEMP1(1,I) .GT. 0 ) THEN
  916.             WRITE(82,901) IELEM_TEMP1(1,I),INELEM_TEMP1(1,I),&           INELEM_TEMP1(2,I), INELEM_TEMP1(3,I),&     INELEM_TEMP1(4,I)
  917.         END IF
  918.     END DO
  919.  
  920.  
  921.   900 FORMAT(1X, I8, ", ", F12.4, ", ", F12.4, ", ", F12.4)
  922.   901 FORMAT(1X, I8, ", ", I8, ", ", I8, ", ", I8, ", ", I8)
  923.     CLOSE (81)
  924.     CLOSE (82)
  925.                
  926.     END
  927.  
  928.     SUBROUTINE GETMESHNUMBERS_TRANSITION(IFINESIDE, ISIDE, NNODE &  , NELEM)
  929.     IMPLICIT REAL*8 ( A-H, O-Z)
  930.  
  931.     INTEGER IFINESIDE, ISIDE, NNODE,NELEM
  932.     NNODE = (ISIDE-2)*IFINESIDE + 2*(IFINESIDE-2)
  933.     NELEM = (ISIDE-3)*(IFINESIDE-1) + 2*(IFINESIDE-3)+2
  934.     RETURN
  935.     END
  936.  
  937.     SUBROUTINE MESHRECTANGLE_TRANSITION(IFINESIDE, ISIDE, & INODE, IELEM, INELEM, COORD)
  938.     IMPLICIT REAL*8 (A-H,O-Z)
  939.     INTEGER INODE(*), IELEM(4,*), INELEM(4,*)
  940.     REAL*8 COORD(2,*)
  941.  
  942.     REAL*8 DXH, DYH
  943.     INTEGER ILABLE,NNODE, NELEM, INODE1, INODE2, INODE3, INODE4,&   IENDLABEL, ICURRENTLABEL, IELAB
  944.     CALL GETMESHNUMBERS_TRANSITION(IFINESIDE, ISIDE, NNODE, NELEM)
  945.  
  946.     DO 10 I =1,NNODE
  947.         INODE(I) = I
  948.    10 END DO
  949.     DXH = 1.0D0/(IFINESIDE-1)
  950.     DYH = 1.0D0/(ISIDE-1)
  951.  
  952.     DO 30 I = 1, IFINESIDE
  953.         DO 20 J = 1,ISIDE-2
  954.             COORD(1,(J-1)*IFINESIDE + I ) = (I-1)*DXH
  955.             COORD(2,(J-1)*IFINESIDE + I ) = (J-1)*DYH
  956.    20       END DO
  957.    30   END DO
  958.     IENDLABEL = (ISIDE-2)*IFINESIDE
  959.     DO 50 I = 2, IFINESIDE -1
  960.         DO 40 J = ISIDE-1, ISIDE
  961.             ICURRENTLABEL = IENDLABEL + (J-ISIDE+1)*(IFINESIDE-2)+I-1
  962.             COORD(1,ICURRENTLABEL ) = (I-1)*DXH
  963.             COORD(2,ICURRENTLABEL ) = (J-1)*DYH
  964.    40       END DO
  965.    50   END DO
  966.  
  967.     IENDLABEL = IENDLABEL + IFINESIDE -2
  968.     DXH = 1.0D0/(IFINESIDE-3)
  969.     DO I = IENDLABEL + 1,  IENDLABEL + IFINESIDE-2
  970.         COORD(1,I) = (I-IENDLABEL - 1)*DXH;
  971.     END DO
  972.     ILASTROWFIRST = IENDLABEL + 1
  973.     ILASTROWLAST = IENDLABEL + IFINESIDE-2
  974.  
  975.     DYH = 1.0D0/(ISIDE-2)
  976.     DO I = 2, ISIDE-2
  977.         INODE1 = (I - 1)*IFINESIDE+ 1
  978.         INODE2 = I*IFINESIDE
  979.         COORD(2,INODE1) = (I-1)*DYH
  980.         COORD(2,INODE2) = (I-1)*DYH
  981.     END DO
  982.  
  983.     DO I = 1, IFINESIDE-1
  984.         DO J = 1, ISIDE-3
  985.             INODE1 = (J-1)*IFINESIDE + I
  986.             INODE2 = INODE1 + 1
  987.             INODE3 = INODE2 + IFINESIDE
  988.             INODE4 = INODE3 -1
  989.             IELELABEL = (J-1)*(IFINESIDE-1) + I
  990.             IELEM(1,IELELABEL) = IELELABEL
  991.             INELEM(1,IELELABEL) = INODE1
  992.             INELEM(2,IELELABEL) = INODE2
  993.             INELEM(3,IELELABEL) = INODE3
  994.             INELEM(4,IELELABEL) = INODE4
  995.         END DO
  996.     END DO
  997.  
  998.     J = ISIDE-3
  999.     DO I = 1, IFINESIDE-1
  1000.         INODE1 = J*IFINESIDE+I
  1001.         INODE2 = INODE1 + 1
  1002.         INODE3 = INODE2 + IFINESIDE - 1
  1003.         INODE4 = INODE3 - 1
  1004.         IF ( I .EQ. 1 ) THEN
  1005.             INODE4 = ILASTROWFIRST
  1006.         END IF
  1007.         IF ( I .EQ. IFINESIDE - 1 ) THEN
  1008.             INODE3 = ILASTROWLAST
  1009.         END IF
  1010.         IELELABEL = (ISIDE-3)*(IFINESIDE-1) + I
  1011.         IELEM(1,IELELABEL) = IELELABEL
  1012.         INELEM(1,IELELABEL) = INODE1
  1013.         INELEM(2,IELELABEL) = INODE2
  1014.         INELEM(3,IELELABEL) = INODE3
  1015.         INELEM(4,IELELABEL) = INODE4
  1016.     END DO
  1017.     J = ISIDE-2
  1018.     DO I = 1, IFINESIDE-3
  1019.         INODE1 = J*IFINESIDE+I
  1020.         INODE2 = INODE1 + 1
  1021.         INODE3 = INODE2 + IFINESIDE-2
  1022.         INODE4 = INODE3 -1
  1023.         IELELABEL = (ISIDE-2)*(IFINESIDE-1) + I
  1024.         IELEM(1,IELELABEL) = IELELABEL
  1025.         INELEM(1,IELELABEL) = INODE1
  1026.         INELEM(2,IELELABEL) = INODE2
  1027.         INELEM(3,IELELABEL) = INODE3
  1028.         INELEM(4,IELELABEL) = INODE4
  1029.     END DO
  1030.     END
  1031.  
  1032.     SUBROUTINE MESHRECTANGLE(IFINESIDE, ISIDE, &    INODE, IELEM, INELEM, COORD)
  1033.     IMPLICIT REAL*8 (A-H,O-Z)
  1034.     INTEGER INODE(*), IELEM(4,*), INELEM(4,*)
  1035.     INTEGER IFRONTSIDE, ISIDE
  1036.     REAL*8 COORD(2,*)
  1037.  
  1038.     REAL*8 DXH, DYH
  1039.     INTEGER ILABLE,NNODE, NELEM, INODE1, INODE2, INODE3, INODE4,&   IENDLABEL, ICURRENTLABEL
  1040.     NELEM = (ISIDE-1)*(IFINESIDE-1)
  1041.     NNODE = ISIDE*IFINESIDE
  1042.  
  1043.     DO 10 I =1,NNODE
  1044.         INODE(I) = I
  1045.    10 END DO
  1046.     DXH = 1.0D0/(IFINESIDE-1)
  1047.     DYH = 1.0D0/(ISIDE-1)
  1048.  
  1049.     DO 30 I = 1, IFINESIDE
  1050.         DO 20 J = 1,ISIDE
  1051.             COORD(1,(J-1)*IFINESIDE + I ) = (I-1)*DXH
  1052.             COORD(2,(J-1)*IFINESIDE + I ) = (J-1)*DYH
  1053.    20       END DO
  1054.    30   END DO
  1055.  
  1056.  
  1057.     DO 70 I = 1, IFINESIDE-1
  1058.         DO 60 J = 1, ISIDE-1
  1059.             INODE1 = (J-1)*IFINESIDE + I
  1060.             INODE2 = INODE1 + 1
  1061.             INODE3 = INODE2 + IFINESIDE
  1062.             INODE4 = INODE3 -1
  1063.             IELELABEL = (J-1)*(IFINESIDE-1) + I
  1064.             IELEM(1,IELELABEL) = IELELABEL
  1065.             INELEM(1,IELELABEL) = INODE1
  1066.             INELEM(2,IELELABEL) = INODE2
  1067.             INELEM(3,IELELABEL) = INODE3
  1068.             INELEM(4,IELELABEL) = INODE4
  1069.    60       END DO
  1070.    70   END DO
  1071.     RETURN
  1072.     END
  1073.  
  1074.     SUBROUTINE MERGEBLOCKMESHES(INODE1, IELEM1, INELEM1, NNODE1,NELEM1&,COORD1, INODE2, IELEM2, INELEM2, NNODE2, NELEM2, COORD2)
  1075.     parameter (nnmax=2000,nemax=1000)
  1076.     IMPLICIT REAL*8 ( A-H, O-Z )
  1077.     INTEGER INODE1(*), IELEM1(4,*), INELEM1(4,*), NNODE1, NELEM1,& INODE2(*), IELEM2(4,*), INELEM2(4,*), NNODE2, NELEM2
  1078.     INTEGER INODE3(10000,2), IELEM3(4,10000), INELEM3(4,10000)
  1079.     INTEGER INPOINTER, IEPOINTER
  1080.     REAL*8 COORD1(2, *), COORD2(2,*)
  1081.  
  1082.     INPOINTER = 0
  1083.     IEPOINTER = 0
  1084.     DO I =1,10000
  1085.         IF ( INODE1(I) .LE. 0 ) THEN
  1086.             INPOINTER = I-1
  1087.             GOTO 10
  1088.         END IF
  1089.     END DO
  1090.    10 CONTINUE
  1091.     DO I =1,10000
  1092.         IF ( IELEM1(1,I) .LE. 0 ) THEN
  1093.             IEPOINTER = I-1
  1094.             GOTO 20
  1095.         END IF
  1096.     END DO
  1097.    20 CONTINUE
  1098.  
  1099.     DO I = 1, NNODE2
  1100.         INODE3(I,1) = INODE2(I)
  1101.         INODE3(I,2) = 0 !! NO CHANGE
  1102.         DO J = 1, 4
  1103.             IELEM3(J,I) = IELEM2(J,I)
  1104.             INELEM3(J,I) = INELEM2(J,I)
  1105.         END DO
  1106.     END DO
  1107.  
  1108.     INPOINTER_OLD = INPOINTER
  1109.     DO I = 1, NNODE2
  1110.         X = COORD2(1,I)
  1111.         Y = COORD2(2,I)
  1112.         INODEINDEX = -1
  1113.         DO J = 1, INPOINTER_OLD
  1114.             X1 = COORD1(1,J)
  1115.             Y1 = COORD1(2,J)
  1116.             DISTANCE = (X-X1)*(X-X1) + (Y-Y1)*(Y-Y1)
  1117.             IF ( DISTANCE .LT. 1.0D-12 ) THEN
  1118.                 INODEINDEX = J
  1119.                 GO TO 30
  1120.             END IF
  1121.         END DO
  1122.    30       CONTINUE
  1123.         IF ( INODEINDEX .NE. -1 ) THEN
  1124.             INODE3(I,2) = INODE1(INODEINDEX) !! CHANGED
  1125.         ELSE            !! ADD THE NODE TO MASTER
  1126.             INPOINTER = INPOINTER +1
  1127.             INODE1(INPOINTER) = INPOINTER
  1128.             COORD1(1,INPOINTER) = COORD2(1,I)
  1129.             COORD1(2,INPOINTER) = COORD2(2,I)
  1130.             INODE3(I,2) = INPOINTER
  1131.         END IF         
  1132.     END DO
  1133.                  
  1134.     DO I = 1, NELEM2
  1135.         IEPOINTER = IEPOINTER + 1
  1136.         IELEM1(1,IEPOINTER) = IEPOINTER
  1137.         IELEM1(2,IEPOINTER) = IELEM3(2,I)
  1138.         IELEM1(3,IEPOINTER) = IELEM3(3,I)
  1139.         IELEM1(4,IEPOINTER) = IELEM3(4,I)
  1140.         INELEM1(1,IEPOINTER) = INODE3(INELEM2(1,I),2)
  1141.         INELEM1(2,IEPOINTER) = INODE3(INELEM2(2,I),2)
  1142.         INELEM1(3,IEPOINTER) = INODE3(INELEM2(3,I),2)
  1143.         INELEM1(4,IEPOINTER) = INODE3(INELEM2(4,I),2)  
  1144.     END DO     
  1145.     RETURN
  1146.     END
  1147.  
  1148.     SUBROUTINE INITMESH(INODE, IELEM, INELEM,COORD,NNODE,NELEM)
  1149.     IMPLICIT REAL*8 ( A-H, O-Z)
  1150.     INTEGER INODE(*), IELEM(4,*), INELEM(4,*)
  1151.     REAL*8 COORD(2,*)
  1152.  
  1153.     DO I = 1, NNODE
  1154.         INODE(I) = -1
  1155.         COORD(1,I) = 0.0D0
  1156.         COORD(2,I) = 0.0D0
  1157.     END DO
  1158.     DO I =1, NELEM
  1159.         DO J = 1,4
  1160.             IELEM(J,I) = -1
  1161.             INELEM(J,I) = -1
  1162.         END DO
  1163.     END DO
  1164.     RETURN
  1165.     END
  1166.  
  1167.     REAL*8 FUNCTION TOTALNODES(INODE, SIZEOFARRAY)
  1168.     INTEGER INODE(*), SIZEOFARRAY
  1169.     DO I = 1, SIZEOFARRAY
  1170.         IF ( INODE(I) .EQ. -1 ) GOTO 10
  1171.     END DO
  1172.    10 CONTINUE
  1173.       TOTALNODES = I -1
  1174.     RETURN
  1175.     END
  1176.  
  1177.     REAL*8 FUNCTION TOTALELEMS(IELEM, SIZEOFARRAY)
  1178.     INTEGER IELEM(4,*), SIZEOFARRAY
  1179.     DO I = 1, SIZEOFARRAY
  1180.         IF ( IELEM(1,I) .EQ. -1 ) GOTO 10
  1181.     END DO
  1182.    10 CONTINUE
  1183.       TOTALELEMS = I - 1
  1184.     RETURN
  1185.     END    
  1186.  
  1187.     SUBROUTINE MARKELEMENTS(IELEM, NELEMS, IPROPINDEX, IVAL)
  1188.     IMPLICIT REAL*8 ( A-H,O-Z)
  1189.     INTEGER IELEM(4,*), IVAL, IPROPINDEX, NELEMS
  1190.     DO I = 1, NELEMS
  1191.         IF ( IELEM(1,I) .GT. 0 ) THEN
  1192.             IELEM(IPROPINDEX,I) = IVAL
  1193.         END IF
  1194.     END DO
  1195.     RETURN
  1196.     END
  1197.  
  1198.     SUBROUTINE MARKBCFACE(INODE, COORD_NODES, IELEM, INELEM&    , NELEMS,&  ITYPE, IVAL)
  1199.  
  1200.     IMPLICIT REAL*8 ( A-H,O-Z)
  1201.     INTEGER IELEM(4,*), IVAL, NELEMS,INODE(*), INELEM(4,*)
  1202.     REAL*8 DIST, DCOORD, COORD_NODES(2,*)
  1203.     INTEGER INDEX, ISUM
  1204.    
  1205.     IF ( ITYPE .EQ. 1) THEN
  1206.         DIST =0.0D0
  1207.         INDEX = 2
  1208.     ELSE IF ( ITYPE .EQ. 2 ) THEN
  1209.         DIST = 1.0D0
  1210.         INDEX = 1
  1211.     ELSE IF ( ITYPE .EQ. 3 ) THEN
  1212.         DIST = 1.0D0
  1213.         INDEX = 2
  1214.     ELSE
  1215.         DIST = 0.0D0
  1216.         INDEX = 1
  1217.     END IF
  1218.     DO I = 1, NELEMS
  1219.         IF ( IELEM(1,I) .GT. 0 ) THEN
  1220.             ISUM =0
  1221.             DO J = 1, 4
  1222.                 NODE = INELEM(J,I)
  1223.                 X = COORD_NODES(INDEX,NODE)
  1224.                 IF ( DABS(X-DIST) .LT. 1.0D-8) THEN
  1225.                     ISUM = ISUM +1
  1226.                 END IF
  1227.             END DO
  1228.             IF ( ISUM .EQ. 2 ) THEN
  1229.                 IELEM(3,I) = IVAL
  1230.                 IELEM(4,I) = ITYPE
  1231.             END IF
  1232.  
  1233.         END IF
  1234.     END DO
  1235.   905 FORMAT(1X,5I8)
  1236.   906 FORMAT(1X,I10, 2F15.5)
  1237.     RETURN
  1238.     END
  1239.  
  1240.     SUBROUTINE FINDNODE(INODE, NNODES, COORDNODES, XX,YY,INDEX)
  1241.     IMPLICIT REAL*8 ( A-H, O-Z)
  1242.     INTEGER INODE(*), NNODES, INDEX
  1243.     REAL*8 COORDNODES(2,10000), XXX,YYY
  1244.     INDEX = -1
  1245.     DO I = 1, NNODES
  1246.         XXX = COORDNODES(1,I)
  1247.         YYY = COORDNODES(2,I)
  1248.         DISTANCE = (XXX-XX)*(XXX-XX) + (YYY-YY)*(YYY-YY)
  1249.         IF ( DISTANCE .LT. 1.0D-12 ) THEN
  1250.             INDEX = I
  1251.             GOTO 10
  1252.         END IF
  1253.     END DO
  1254.    10 CONTINUE
  1255.       RETURN
  1256.     END
  1257.  
  1258.     SUBROUTINE FINDCLOSESTNODE(INODE, NNODES, COORDNODES, X,Y,INDEX)
  1259.     IMPLICIT REAL*8 ( A-H, O-Z)
  1260.     INTEGER INODE(*), NNODES, INDEX
  1261.     REAL*8 COORDNODES(2,*), X,Y
  1262.     REAL*8 DMAX, DISTANCE
  1263.     DMIN = 1.0D24
  1264.     INDEX = -1
  1265.     DO I = 1, NNODES
  1266.         XX = COORDNODES(1,I)
  1267.         YY = COORDNODES(2,I)
  1268.         DISTANCE = (XX-X)*(XX-X) + (YY-Y)*(YY-Y)
  1269.         IF ( DISTANCE .LT. DMIN ) THEN
  1270.             DMIN = DISTANCE
  1271.             INDEX = I
  1272.         END IF
  1273.     END DO
  1274.  
  1275.       RETURN
  1276.     END    
  1277.  
  1278.     SUBROUTINE KEYPOINTS_SLEEVE(D_PIPE,T_PIPE,T_SLEEVE,GAP,WELDLEG,
  1279.      1     ANGLE_W,VL_PIPE,POINTS, NPTS)
  1280.     IMPLICIT REAL*8 (A-H,O-Z)
  1281.     REAL*8 D_PIPE, T_PIPE, T_SLEEVE, GAP, WELDLEG, ANGLE_W, VL_PIPE, & POINTS(2,*)
  1282.     INTEGER NPTS
  1283.     REAL*8 FEATURE_ANGLE, FTV
  1284.     LOGICAL P5ANDP30
  1285.  
  1286.     COMMON /MESHING/DLENGTH1, DHAZ, DLENGTH2, DBAND, DMESHSIZE
  1287.  
  1288.     WELDLEG2 = WELDLEG/DSQRT(2.0D0)
  1289.  
  1290.     FEATURE_ANGLE = 30.0D0
  1291.     DPI = DASIN(1.0D0)*2.0D0
  1292.     FTV = DTAN(FEATURE_ANGLE*DPI/180.0D0)
  1293.     DLENGTH1 = WELDLEG2
  1294.     DLENGTH2 = DLENGTH1
  1295.     DHAZ = 0.3D0* WELDLEG2 ! 0.3 IS A HARD-CODED NUMBER FOR HAZ THICKNESS
  1296.     DBAND = 0.75D0*DHAZ ! 0.75 IS ANOTHER HARD-CODED NUMBER FOR BANDWITH
  1297.     DBOTTOM = DHAZ + DBAND
  1298.     IF ( DBOTTOM .GT. 0.75D0*T_PIPE ) THEN
  1299.         DHAZ = 0.75D0*T_PIPE/1.75D0
  1300.         DBAND = 0.75D0*DHAZ
  1301.     END IF
  1302.  
  1303.     POINTS(2,3) = 0.0D0
  1304.     POINTS(1,3) = 0.5D0*D_PIPE
  1305.     POINTS(1,1) = POINTS(1,3)-DHAZ
  1306.     POINTS(2,1) = POINTS(2,3) + FTV*DHAZ
  1307.     POINTS(1,6) = POINTS(1,3)
  1308.     POINTS(2,6) = WELDLEG2
  1309.     POINTS(1,7) = POINTS(1,3)
  1310.     POINTS(2,7) = 0.5D0*POINTS(2,6)
  1311.     POINTS(1,8) = POINTS(1,7) - DHAZ
  1312.     POINTS(2,8) = POINTS(2,7)
  1313.     POINTS(1,9) = POINTS(1,8) - DBAND
  1314.     POINTS(2,9) = POINTS(2,8)
  1315.     POINTS(1,15) = POINTS(1,7) - T_PIPE
  1316.     POINTS(2,15) = POINTS(2,7)
  1317.     POINTS(1,10) = POINTS(1,1)
  1318.     POINTS(2,10) = POINTS(2,6) - FTV*DHAZ
  1319.  
  1320.     POINTS(1,2) = POINTS(1,9)
  1321.     POINTS(2,2) = POINTS(2,1) - FTV*DBAND
  1322.     POINTS(1,11) = POINTS(1,9)
  1323.     POINTS(2,11) = POINTS(2,10)+ FTV*DBAND
  1324.     POINTS(1,12) = POINTS(1,3)
  1325.     POINTS(2,12) = POINTS(2,11) + FTV*(DHAZ+DBAND)
  1326.     POINTS(1,14) = POINTS(1,15)
  1327.     POINTS(2,14) = POINTS(2,11) + (T_PIPE-DHAZ-DBAND)*FTV
  1328.     POINTS(1,13) = POINTS(1,3)
  1329.     POINTS(2,13) = POINTS(2,14) + T_PIPE*FTV
  1330.     POINTS(1,16) = POINTS(1,15)
  1331.     POINTS(2,16) = POINTS(2,2) - (T_PIPE-DHAZ-DBAND)*FTV
  1332.     POINTS(1,17) = POINTS(1,7)
  1333.     POINTS(2,17) = POINTS(2,2)- FTV*(DHAZ+DBAND)
  1334.     POINTS(1,18) = POINTS(1,3)
  1335.     POINTS(2,18) = POINTS(2,16)-T_PIPE*FTV
  1336.     DDIST = DABS(POINTS(2,6)-POINTS(2,13))
  1337.     DDIST = 2.0D0*DDIST
  1338.     POINTS(1,19) = POINTS(1,3)
  1339.     POINTS(2,19) = POINTS(2,13) + DDIST
  1340.     POINTS(1,20) = POINTS(1,15)
  1341.     POINTS(2,20) = POINTS(2,19)
  1342.     POINTS(1,21) = POINTS(1,3)
  1343.     POINTS(2,21) = POINTS(2,18) - DDIST
  1344.     POINTS(1,22) = POINTS(1,15)
  1345.     POINTS(2,22) = POINTS(2,21)
  1346.     POINTS(1,23) = POINTS(1,3)
  1347.     POINTS(2,23) = 0.5D0*VL_PIPE
  1348.     POINTS(1,24) = POINTS(1,15)
  1349.     POINTS(2,24) = POINTS(2,23)
  1350.     POINTS(1,25) = POINTS(1,3)
  1351.     POINTS(2,25) = -0.5D0*VL_PIPE
  1352.     POINTS(1,26) = POINTS(1,15)
  1353.     POINTS(2,26) = POINTS(2,25)
  1354.  
  1355.     POINTS(1,4) = POINTS(1,3) + GAP
  1356.     POINTS(2,4) = 0.0D0
  1357.     POINTS(1,5) = POINTS(1,3) + WELDLEG2
  1358.     POINTS(2,5) = 0.0D0
  1359.     POINTS(1,27) = 0.5D0*(POINTS(1,5) + POINTS(1,6))
  1360.     POINTS(2,27) = 0.5D0*(POINTS(2,5) + POINTS(2,6))
  1361.     POINTS(1,28) = 0.5D0*(POINTS(1,3) + POINTS(1,5))
  1362.     POINTS(2,28) = 0.5D0*(POINTS(2,3) + POINTS(2,5))
  1363.  
  1364.     POINTS(1,29) = POINTS(1,3) + 2.0D0*(POINTS(1,27)&   -POINTS(1,3))/3.0D0
  1365.     POINTS(2,29) = POINTS(2,3) + 2.0D0*(POINTS(2,27)&   -POINTS(2,3))/3.0D0
  1366.  
  1367.     P5ANDP30 = .FALSE.
  1368.     POINTS(1,30) = POINTS(1,4) + T_SLEEVE
  1369.     POINTS(2,30) = 0.0D0
  1370.     IF ( DABS(POINTS(1,5)-POINTS(1,30)) .LT. 0.5D0 ) P5ANDP30 = .TRUE.
  1371.     IF ( P5ANDP30 .EQ. .TRUE. ) THEN
  1372.         POINTS(1,30) = POINTS(1,5)
  1373.     END IF
  1374.  
  1375.     POINTS(1,31) = POINTS(1,30)
  1376.     POINTS(2,31) = -DHAZ
  1377.     POINTS(1,32) = POINTS(1,5)
  1378.     POINTS(2,32) = POINTS(2,31)
  1379.     POINTS(1,33) = POINTS(1,4)
  1380.     POINTS(2,33) = POINTS(2,31)
  1381.     POINTS(1,34) = POINTS(1,30)
  1382.     POINTS(2,34) = -DHAZ-DBAND
  1383.     POINTS(1,35) = POINTS(1,5)
  1384.     POINTS(2,35) = POINTS(2,34)
  1385.     POINTS(1,36) = POINTS(1,4)
  1386.     POINTS(2,36) = POINTS(2,34)
  1387.     POINTS(1,37) = POINTS(1,30)
  1388.     POINTS(2,37) = POINTS(2,34) - 3.0D0*DBAND
  1389.     POINTS(1,38) = POINTS(1,5)
  1390.     POINTS(2,38) = POINTS(2,37)
  1391.     POINTS(1,39) = POINTS(1,4)
  1392.     POINTS(2,39) = POINTS(2,37)
  1393.     POINTS(1,40) = POINTS(1,30)
  1394.     POINTS(2,40) = -0.5D0*VL_PIPE
  1395.     POINTS(1,41) = POINTS(1,5)
  1396.     POINTS(2,41) = POINTS(2,40)
  1397.     POINTS(1,42) = POINTS(1,4)
  1398.     POINTS(2,42) = POINTS(2,40)
  1399.  
  1400.     RETURN
  1401.     END
  1402.  
  1403.     SUBROUTINE TRANSFORMNODES(COORDS, CORNERS, NUM, GRADE1, GRADE2)
  1404.     IMPLICIT REAL*8 (A-H,O-Z)
  1405.     REAL*8 COORDS(2,*), CORNERS(2,*), GRADE1, GRADE2
  1406.     INTEGER NUM
  1407.     REAL*8 X1,X2,X3,X4,Y1,Y2,Y3,Y4,X,Y,DX,DY,DX1,DX2,DY1,DY2
  1408.  
  1409.     X1 = CORNERS(1,1)
  1410.     Y1 = CORNERS(2,1)
  1411.     X2 = CORNERS(1,2)
  1412.     Y2 = CORNERS(2,2)
  1413.     X3 = CORNERS(1,3)
  1414.     Y3 = CORNERS(2,3)
  1415.     X4 = CORNERS(1,4)
  1416.     Y4 = CORNERS(2,4)
  1417.  
  1418.     DO I = 1, NUM
  1419.         X = COORDS(1,I)
  1420.         Y = COORDS(2,I)
  1421.         DX1 = X1+X**GRADE1*(X2-X1)
  1422.         DX2 = X4+X**GRADE1*(X3-X4)
  1423.         DX = DX1 + Y**GRADE2*(DX2-DX1)
  1424.         DY1 = Y1+X**GRADE1*(Y2-Y1)
  1425.         DY2 = Y4+X**GRADE1*(Y3-Y4)
  1426.         DY = DY1 + Y**GRADE2*(DY2-DY1)
  1427.         COORDS(1,I) = DX
  1428.         COORDS(2,I) = DY
  1429.     END DO
  1430.     RETURN
  1431.     END
  1432.  
  1433.     SUBROUTINE GETNODENUMBER(INODE,IMAX, INUM)
  1434.     INTEGER INODE(*), IMAX
  1435.     DO I = 1, IMAX
  1436.         IF ( INODE(I) .LE. 0 ) GOTO 10
  1437.     END DO
  1438.    10 INUM = I-1
  1439.     RETURN
  1440.     END
  1441.     SUBROUTINE GETELEMNUMBER(IELEM,IMAX, INUM)
  1442.     INTEGER IELEM(4,*), IMAX
  1443.     DO I = 1, IMAX
  1444.         IF ( IELEM(1,I) .LE. 0 ) GOTO 10
  1445.     END DO
  1446.    10 INUM = I-1
  1447.     RETURN
  1448.     END
  1449.  
  1450.     SUBROUTINE MESHRECTANGLE_TRANSITION2(IFINESIDE, ICOARSESIDE, ISIDE, &   INODE, IELEM, INELEM, COORD)
  1451.     IMPLICIT REAL*8 (A-H,O-Z)
  1452.     INTEGER INODE(*), IELEM(4,*), INELEM(4,*), IFINESIDE, ICOARSESIDE
  1453.     INTEGER ISIDE
  1454.     REAL*8 COORD(2,*)
  1455.  
  1456.     REAL*8 DXH, DYH, CORNERS(2,4)
  1457.     INTEGER ILABLE,NNODE, NELEM, INODE1, INODE2, INODE3, INODE4,&   IENDLABEL, ICURRENTLABEL, IELAB
  1458.     REAL*8 COORD_TEMP(2,10000)
  1459.     INTEGER INODE_TEMP(10000), IELEM_TEMP(4,10000)&, INELEM_TEMP(4,10000)
  1460.     N1 = IFINESIDE-1
  1461.     N2 = ICOARSESIDE -1
  1462.     N3 = ISIDE-1
  1463.     NEACHSIDE = (N1-N2)/2
  1464.     X1 = 1.0D0*NEACHSIDE/N1
  1465.     X2 = 1.0D0*(NEACHSIDE+N2)/N1
  1466.     Y1 = 1.0D0*N3/(N3+NEACHSIDE)
  1467.  
  1468.     NTOTALNODES = ISIDE*(NEACHSIDE+1)
  1469.     NTOTALELEMS = (ISIDE-1)*NEACHSIDE
  1470.  
  1471.     CALL MESHRECTANGLE(NEACHSIDE+1,ISIDE,INODE,IELEM, & INELEM, COORD)
  1472.     CORNERS(1,1) = 0.0D0
  1473.     CORNERS(2,1) = 0.0D0
  1474.     CORNERS(1,2) = X1
  1475.     CORNERS(2,2) = 0.0D0   
  1476.     CORNERS(1,3) = X1
  1477.     CORNERS(2,3) = Y1
  1478.     CORNERS(1,4) = 0.0D0
  1479.     CORNERS(2,4) = 1.0D0
  1480.                 CALL TRANSFORMNODES(COORD,CORNERS,NTOTALNODES,1.0D0,1.0D0)
  1481.  
  1482.     CALL GETNODENUMBER(INODE,10000,NTOTALNODES)
  1483.     CALL GETELEMNUMBER(IELEM,10000,NTOTALELEMS)
  1484.  
  1485.     CALL INITMESH(INODE_TEMP,IELEM_TEMP,INELEM_TEMP,COORD_TEMP& , 10000,10000)
  1486.     CALL MESHRECTANGLE(ICOARSESIDE,ISIDE,INODE_TEMP,IELEM_TEMP,&    INELEM_TEMP, COORD_TEMP)
  1487.     CORNERS(1,1) = X1
  1488.     CORNERS(2,1) = 0.0D0
  1489.     CORNERS(1,2) = X2
  1490.     CORNERS(2,2) = 0.0D0   
  1491.     CORNERS(1,3) = X2
  1492.     CORNERS(2,3) = Y1
  1493.     CORNERS(1,4) = X1
  1494.     CORNERS(2,4) = Y1
  1495.     CALL TRANSFORMNODES(COORD_TEMP,CORNERS,ISIDE*ICOARSESIDE,1.0D0& ,1.0D0)
  1496.     CALL MERGEBLOCKMESHES(INODE, IELEM, INELEM, NTOTALNODES&    ,NTOTALELEMS &,COORD, INODE_TEMP, IELEM_TEMP, INELEM_TEMP, ISIDE*ICOARSESIDE,& (ISIDE-1)*(ICOARSESIDE-1), COORD_TEMP)
  1497.  
  1498.     CALL GETNODENUMBER(INODE,10000,NTOTALNODES)
  1499.     CALL GETELEMNUMBER(IELEM,10000,NTOTALELEMS)
  1500.  
  1501.     CALL INITMESH(INODE_TEMP,IELEM_TEMP,INELEM_TEMP,COORD_TEMP, 10000&  ,10000)
  1502.     CALL MESHRECTANGLE(NEACHSIDE+1,ISIDE,INODE_TEMP,IELEM_TEMP,&    INELEM_TEMP, COORD_TEMP)
  1503.     CORNERS(1,1) = X2
  1504.     CORNERS(2,1) = 0.0D0
  1505.     CORNERS(1,2) = 1.0D0
  1506.     CORNERS(2,2) = 0.0D0   
  1507.     CORNERS(1,3) = 1.0D0
  1508.     CORNERS(2,3) = 1.0D0
  1509.     CORNERS(1,4) = X2
  1510.     CORNERS(2,4) = Y1
  1511.     CALL TRANSFORMNODES(COORD_TEMP,CORNERS,ISIDE*(NEACHSIDE+1),1.0D0 &  ,1.0D0)
  1512.     CALL GETNODENUMBER(INODE,10000,NTOTALNODES)
  1513.     CALL GETELEMNUMBER(IELEM,10000,NTOTALELEMS)
  1514.     CALL MERGEBLOCKMESHES(INODE, IELEM, INELEM, NTOTALNODES&,NTOTALELEMS &,COORD, INODE_TEMP, IELEM_TEMP, INELEM_TEMP&, ISIDE*(NEACHSIDE+1), & (ISIDE-1)*NEACHSIDE, COORD_TEMP)
  1515.  
  1516.     CALL GETNODENUMBER(INODE,10000,NTOTALNODES)
  1517.     CALL GETELEMNUMBER(IELEM,10000,NTOTALELEMS)
  1518.  
  1519.     CALL INITMESH(INODE_TEMP,IELEM_TEMP,INELEM_TEMP,COORD_TEMP, 10000&  ,10000)
  1520.     CALL GETNODENUMBER(INODE,10000,NTOTALNODES)
  1521.     CALL GETELEMNUMBER(IELEM,10000,NTOTALELEMS)
  1522.     CALL MESHRECTANGLE(ICOARSESIDE,NEACHSIDE+1,INODE_TEMP,IELEM_TEMP,&  INELEM_TEMP, COORD_TEMP)
  1523.     CORNERS(1,1) = X1
  1524.     CORNERS(2,1) = Y1
  1525.     CORNERS(1,2) = X2
  1526.     CORNERS(2,2) = Y1  
  1527.     CORNERS(1,3) = 1.0D0
  1528.     CORNERS(2,3) = 1.0D0
  1529.     CORNERS(1,4) = 0.0D0
  1530.     CORNERS(2,4) = 1.0D0
  1531.     CALL TRANSFORMNODES(COORD_TEMP,CORNERS,ICOARSESIDE*(NEACHSIDE+1) &  ,1.0D0,1.0D0)
  1532.     CALL MERGEBLOCKMESHES(INODE, IELEM, INELEM, NTOTALNODES,NTOTALELEMS&,COORD, INODE_TEMP, IELEM_TEMP, INELEM_TEMP&, ICOARSESIDE*(NEACHSIDE+1),& (ICOARSESIDE-1)*NEACHSIDE, COORD_TEMP)
  1533.  
  1534.     CALL GETNODENUMBER(INODE,10000,NTOTALNODES)
  1535.     CALL GETELEMNUMBER(IELEM,10000,NTOTALELEMS)
  1536.  
  1537.     RETURN
  1538.     END
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!