!IPK LAST UPDATE jAN 25 2001 INCREMENT NP FOR ALREADY EXISTING NODES IN NOP !IPK LAST UPDATE APR 6 1998 SUBROUTINE FILM(ISWT) !june93 SUBROUTINE FILM(IFILL) !- ! ISWT = 0 means read a value for IFILL ! ISWT = 1 means use a value of 1 for IFILL ! If IFILL = 1, use all unused node nos. for filling midside nodes ! If IFILL = 0, start midside node numbering with max node no. !- USE WINTERACTER USE BLK1MOD USE BLK2MOD ! INCLUDE 'BLK1.COM' ! INCLUDE 'BLK2.COM' INCLUDE 'BFILES.I90' INCLUDE 'TXFRM.COM' !IPK MAY02 COMMON /TXFRM/ XS, YS, TXSCAL INTEGER NUSED(MAXP) !IPK MAY02 REAL*8 XX,YY data itime/0/ if(itime .eq. 0) then ifill=0 itime=1 endif ! call WcursorShape(1) NHTPsv = nhtp NMESSsv = nmess NBRRsv = nbrr NHTP = 0 NBRR = 0 NMESS=45 CALL HEDR NMESS = 19 xprt=3.2 ! IF(ISWT .EQ. 0) THEN CALL GETINT(IFILL) ELSE IFILL=1 ENDIF ! !- !-.....FIND MISSING NODE NUMBERS..... !- NP0 = 0 DO 10 I=1,MAXP 10 NUSED(I) = 0 DO 101 J = 1, NE IF( IMAT(J) .EQ. 0 ) GO TO 101 DO 100 K = 1, 8 IF( NOP(J,K) .LE. 0) GOTO 100 NUSED(NOP(J,K))=999 100 END DO 101 END DO ! Form list of elements connected to nodes IERR=0 CALL NDNECON(IERR) IF(IERR .GT. 0) THEN LIMIT=MAXECON CALL NODERR(IERR,LIMIT) GO TO 200 ENDIF !C- !C-.....PUT INPUTS INTO PROPER LOCATIONS..... !C- ! DO 140 J = 1, NE ! IF( IMAT(J) .EQ. 0 ) GO TO 140 ! IF( NOP(J,5) .GT. 0 ) GO TO 140 ! DO 130 K = 1, 4 ! IT(K) = NOP(J,K) ! NOP(J,K) = 0 ! 130 CONTINUE ! KK = 0 ! DO 135 K = 1, 8, 2 ! KK = KK + 1 ! NOP(J,K) = IT(KK) ! 135 CONTINUE ! 140 CONTINUE !- !-.....INSERT NEW NUMBERS..... !- NP0=0 IF(IFILL .EQ. 0) NP0=NP DO 190 J = 1, NE !ipk apr98 IF( IMAT(J) .GT. 0 .AND. IMAT(J) .LT.901) THEN IF(( IMAT(J) .GT. 0 .AND. IMAT(J) .LT.901) .or. & & imat(j) .gt. 903) THEN NCN = NCORN(J) JN = J + 1 DO 180 K = 2, NCN, 2 if((imat(j) .gt. 995 .and. imat(j) .lt. 1999) .and. (k .eq. 4 .or. k .eq. 8) & & ) go to 180 NA = K - 1 NB = MOD(K+1,NCN) IF(NB .EQ. 0) NB=NCN NA = NOP(J,NA) NB = NOP(J,NB) AA=(WD(NA)+WD(NB))/2. AB=(WD1(NA)+WD1(NB))/2. IF( NOP(J,K) .EQ. 0 ) THEN IRDONE=0 99 NP0 = NP0 + 1 IF(NP0 .GT. MAXP) THEN CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK,'Execution terminated, nodal limits exceeded. Backup written','LIMITS EXCEEDED') CALL WRTOUT(0) STOP ENDIF IF(INEW(NP0) .EQ. 1) GO TO 99 IF (NUSED(NP0) .GT. 0) GOTO 99 NOP(J,K) = NP0 XX=(CORD(NA,1)+CORD(NB,1))/2. YY=(CORD(NA,2)+CORD(NB,2))/2. CORD(NP0,1)=XX CORD(NP0,2)=YY WD(NP0)=AA WD1(NP0)=AB WIDTH(NP0)=(WIDTH(NA)+WIDTH(NB))/2. SS1(NP0)=(SS1(NA)+SS1(NB))/2. SS2(NP0)=(SS2(NA)+SS2(NB))/2. WIDS(NP0)=(WIDS(NA)+WIDS(NB))/2. WIDBS(NP0)=(WIDBS(NA)+WIDBS(NB))/2. BS1(NP0)=(BS1(NA)+BS1(NB))/2. INEW(NP0) = 1 IF(LOCK(NA) .EQ. 1 .AND. LOCK(NB) .EQ. 1) LOCK(NP0)=1 XUSR(NP0) = XX*TXSCAL - XS YUSR(NP0) = YY*TXSCAL - YS INSKP(NP0) = 0 !SSO(N),- !,BS1(N)-.....SEARCH FOR OTHER ELEMENT..... !- !ipk dec98 set a counter ielct=0 !ipk0ct93 DO 170 JJ = JN, NE DO 170 JJJ=1,NDELM(NA) JJ=NECON(NA,JJJ) !IPK SEP02 DO 170 JJ = 1, NE !ipkoct93 IF( IMAT(JJ) .GT. 0 .OR. IMAT(JJ) .LT.901) THE if(jj .eq. j) go to 170 if(imat(jj) .gt. 0) then NNCN = NCORN(JJ) DO 160 KK = 2, NNCN, 2 IF( NOP(JJ,KK-1) .EQ. NB ) THEN KN = MOD(KK+1,NNCN) IF(KN .EQ. 0) KN=NNCN IF( NOP(JJ,KN) .EQ. NA ) THEN NOP(JJ,KK) = NP0 !ipk dec98 ielct=ielct+1 if(ielct .eq. 2) then GO TO 180 else go to 170 endif !ipk dec98 end changes ENDIF !IPK APR98 ADD ELSEIF( NOP(JJ,KK-1) .EQ. NA ) THEN KN = MOD(KK+1,NNCN) IF(KN .EQ. 0) KN=NNCN IF( NOP(JJ,KN) .EQ. NB ) THEN NOP(JJ,KK) = NP0 !ipk dec98 ielct=ielct+1 if(ielct .eq. 2) then GO TO 180 else go to 170 endif !ipk dec98 end changes ENDIF !IPK APR98 ENDIF 160 CONTINUE ENDIF 170 CONTINUE ELSE NM=NOP(J,K) IF(INEW(NM) .NE. 1) THEN XX=(CORD(NA,1)+CORD(NB,1))/2. YY=(CORD(NA,2)+CORD(NB,2))/2. CORD(NM,1)=XX CORD(NM,2)=YY WD(NM)=AA WD1(NM)=AB WIDTH(NM)=(WIDTH(NA)+WIDTH(NB))/2. SS1(NM)=(SS1(NA)+SS1(NB))/2. SS2(NM)=(SS2(NA)+SS2(NB))/2. WIDS(NM)=(WIDS(NA)+WIDS(NB))/2. WIDBS(NM)=(WIDBS(NA)+WIDBS(NB))/2. BS1(NM)=(BS1(NA)+BS1(NB))/2. INEW(NM) = 1 IF(LOCK(NA) .EQ. 1 .AND. LOCK(NB) .EQ. 1) LOCK(NM)=1 XUSR(NM) = XX*TXSCAL - XS YUSR(NM) = YY*TXSCAL - YS INSKP(NM) = 0 !ipk jan01 IF(NM .GT. NP) NP=NM ELSE WD(NM)=AA WD1(NM)=AB ENDIF ENDIF 180 CONTINUE ENDIF 190 CONTINUE IF (NP0 .GT. NP) NP=NP0 200 CONTINUE NHTP = nhtpsv NMESS = nmesssv NBRR = nbrrsv ! call WcursorShape(0) !IPK MAY03 ICHG=0 RETURN END SUBROUTINE NODERR(NODER,LIMIT) USE WINTERACTER include 'd.inc' ! ! Declare window-type and message variables ! TYPE(WIN_STYLE) :: WINDOW TYPE(WIN_MESSAGE) :: MESSAGE INTEGER :: IERR,NODER,LIMIT call wdialogload(IDD_NODERR) ierr=infoerror(1) CALL WDialogSelect(IDD_NODERR) ierr=infoerror(1) CALL WDialogPutInteger(IDF_INTEGER2,LIMIT) CALL WDialogPutInteger(IDF_INTEGER3,NODER) CALL WDialogShow(-1,-1,0,Modal) ierr=infoerror(1) do ! IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN RETURN ELSE RETURN ENDIF enddo RETURN END