SUBROUTINE ADDQUAD ! Subroutine to add a quadrilateral block USE BLK1MOD USE BLK2MOD ! INCLUDE 'BLK1.COM' ! INCLUDE 'BLK2.COM' INCLUDE 'TXFRM.COM' CHARACTER*1 IFLAG DATA N1,N2,N3,N4/1,1,1,1/ ! Initiliaze list etc NHTPSV=NHTP NMESSSV=NMESS NBRRSV=NBRR DO N=1,NP LIST(N)=0 ENDDO ! Get the points that form the triangle 4 CONTINUE NHTP=0 NMESS=8 NBRR = 3 CALL HEDR ! ! Get screen coordinates of each end of line ! 7 CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX) ALX=XTEMP ALY=YTEMP IF(IRMAIN .EQ. 1) RETURN ! IF(IFLAG .EQ. 'q' .OR. (IFLAG .EQ. 'c' .AND. IBOX .EQ. 10))THEN CALL WRTOUT(0) RETURN elseif(iflag .eq. 'n') then call getfpna(XTEMP) call getfpna(YTEMP) ENDIF ! ! Exit input ! ! 9 CALL PLOTT(XTEMP,YTEMP,3) ! CALL PLOTT(XTEMP,YTEMP,2) NBRR=0 CALL HEDR CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX) ARX=XTEMP ARY=YTEMP if(iflag .eq. 'n') then call getfpna(XTEMP) call getfpna(YTEMP) endif IF(IRMAIN .EQ. 1) RETURN ! CALL PLOTT(ALX,ALY,3) CALL PLOTT(XTEMP,YTEMP,2) CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX) BRX=XTEMP BRY=YTEMP if(iflag .eq. 'n') then call getfpna(XTEMP) call getfpna(YTEMP) endif IF(IRMAIN .EQ. 1) RETURN ! 16 CONTINUE ! CALL PLOTT(XTEMP,YTEMP,3) CALL PLOTT(XTEMP,YTEMP,2) CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX) BLX=XTEMP BLY=YTEMP if(iflag .eq. 'n') then call getfpna(XTEMP) call getfpna(YTEMP) endif IF(IRMAIN .EQ. 1) RETURN ! 20 CONTINUE ! CALL PLOTT(XTEMP,YTEMP,3) CALL PLOTT(XTEMP,YTEMP,2) CALL PLOTT(ALX,ALY,2) ! Get the number of element information CALL PANELQUAD(N1,N2,N3,N4) ! Get number For 1 and 3 and 2 and 4 NMID1=(N1+N3)/2 NMID2=(N2+N4)/2 ! Form the new nodes CALL DEFNOD(ALX,ALY) CALL DEFNOD(ARX,ARY) CALL DEFNOD(BRX,BRY) CALL DEFNOD(BLX,BLY) ! Now work on sides DO N=1,N1-1 RATIO=FLOAT(N)/FLOAT(N1) X1=ALX+RATIO*(ARX-ALX) Y1=ALY+RATIO*(ARY-ALY) CALL DEFNOD(X1,Y1) ENDDO DO N=1,N2-1 RATIO=FLOAT(N)/FLOAT(N2) X1=ARX+RATIO*(BRX-ARX) Y1=ARY+RATIO*(BRY-ARY) CALL DEFNOD(X1,Y1) ENDDO DO N=1,N3-1 RATIO=FLOAT(N)/FLOAT(N3) X1=BRX+RATIO*(BLX-BRX) Y1=BRY+RATIO*(BLY-BRY) CALL DEFNOD(X1,Y1) ENDDO DO N=1,N4-1 RATIO=FLOAT(N)/FLOAT(N4) X1=BLX+RATIO*(ALX-BLX) Y1=BLY+RATIO*(ALY-BLY) CALL DEFNOD(X1,Y1) ENDDO CALL FRMNODQ(ALX,ALY,ARX,ARY,BRX,BRY,BLX,BLY,NMID1,NMID2) ! Form triangles for the added nodes CALL DELN2(NP,1) NHTP=NHTPSV NMESS=NMESSSV NBRR=NBRRSV CALL HEDR RETURN END SUBROUTINE PANELQUAD(N1,N2,N3,N4) use winteracter implicit none include 'D.inc' INCLUDE 'BFILES.I90' ! ! Declare window-type and message variables ! TYPE(WIN_STYLE) :: WINDOW TYPE(WIN_MESSAGE) :: MESSAGE integer :: N1,N2,N3,N4,IERR ! real :: character*3 :: sub call wdialogload(IDD_QUAD) ierr=infoerror(1) CALL WDialogPutInteger(idf_integer1,n1) CALL WDialogPutInteger(idf_integer2,n2) CALL WDialogPutInteger(idf_integer3,n3) CALL WDialogPutInteger(idf_integer4,n4) CALL WDialogSelect(IDD_QUAD) ierr=infoerror(1) CALL WDialogShow(-1,-1,0,Modal) ierr=infoerror(1) IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN CALL WDialogGetInteger(idf_integer1,n1) CALL WDialogGetInteger(idf_integer2,n2) CALL WDialogGetInteger(idf_integer3,n3) CALL WDialogGetInteger(idf_integer4,n4) ENDIF RETURN END