SUBROUTINE GETSTRESSFIL USE WINTERACTER USE BLK1MOD include 'd.inc' ALLOCATABLE WDTEMP(:) CHARACTER*256 FILTER,FNAME INTEGER IYRR,IMON,IDAY REAL HOUR LOGICAL OPENED DATA IYRR/2015/,IMON/1/,IDAY/1/ DATA HOUR/0.0/ IF(.NOT. ALLOCATED(WDTEMP)) THEN ALLOCATE (WDTEMP(NP)) ENDIF DO N=1,NP WDTEMP(N)=WD(N) ENDDO 100 CONTINUE ISWT=-1 IWRTMP=0 IF(IMP .GT. 0) THEN ! FIRST WRITE EXISTING MAP TO SCRATCH OPEN(98,FORM='BINARY',STATUS='SCRATCH') CALL WRTMAP(98) REWIND 98 IWRTMP=1 ENDIF CALL GMAP CALL GRIDSB(ISWT) INQUIRE(104, OPENED=OPENED) IF(OPENED) GO TO 200 Filter='Output file -- *.dat|*.dat|' CALL WSelectFile(Filter,SaveDialog+PromptOn+AppendExt+DirChange,FNAME,'Save Stress File') IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN IOT=104 OPEN(IOT,FILE=FNAME,STATUS='UNKNOWN') ELSE GO TO 500 ENDIF 200 CONTINUE CALL SETDT(IYRR,IMON,IDAY,HOUR) WRITE(IOT,'(''DATE '',3I8,F8.3)') IYRR,IMON,IDAY,HOUR DO J=1,NP IF (INEW(J) .EQ. 1) THEN WRITE(IOT,'(''WAVESS '',I8,F8.4)') J,WD(J) ENDIF ENDDO WRITE(IOT,'(''ENDBLOCK'')') FLUSH(IOT) CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'Do you wish to process another map file?'//& CHAR(13)//' ','PROCESS ANOTHER?') ! ! If answer 'No', return ! IF (WInfoDialog(4).EQ.2) THEN WRITE(IOT,'(''ENDDATA'')') FLUSH(IOT) GO TO 500 ENDIF GO TO 100 ! ! Delete all unused nodes ! CALL DELETM(2) 500 DO N=1,NP WD(N)=WDTEMP(N) ENDDO DEALLOCATE (WDTEMP) IF(IWRTMP .GT. 0) THEN CALL RDMAP(2,98,0,0) CLOSE (98) ENDIF RETURN END SUBROUTINE SETDT(N1,N2,N3,R1) 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,IERR real :: R1 character*3 :: sub call wdialogload(IDD_SETYRDT) ierr=infoerror(1) CALL WDialogPutInteger(idf_integer1,n1) CALL WDialogPutInteger(idf_integer2,n2) CALL WDialogPutInteger(idf_integer3,n3) CALL WDialogPutReal(idf_real1,r1) CALL WDialogSelect(IDD_setyrdt) ierr=infoerror(1) CALL WDialogShow(-1,-1,0,Modal) ierr=infoerror(1) DO IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN CALL WDialogGetInteger(idf_integer1,n1) CALL WDialogGetInteger(idf_integer2,n2) CALL WDialogGetInteger(idf_integer3,n3) CALL WDialogGetReal(idf_real1,r1) RETURN ENDIF ENDDO RETURN END SUBROUTINE GMAP USE WINTERACTER include 'd.inc' CHARACTER(LEN=255) :: FNAME CHARACTER(LEN=3) :: SUB,SUB1 INTEGER IMP CALL WSelectFile(ID_STRING1,PromptOn,FNAME,'Load Map File') IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN CALL IlowerCase(FNAME) CALL GETSUB(FNAME,SUB) IF(SUB .EQ. 'map') then IMP=9 OPEN(9,FILE=FNAME,STATUS='OLD',action='read') ELSEIF(SUB .EQ. 'asc' .or. SUB .EQ. 'grd') then IMP=94 OPEN(94,FILE=FNAME,STATUS='OLD',action='read') ELSEIF(SUB .EQ. 'mpb') then imp=92 OPEN(IMP ,FILE=FNAME,STATUS='OLD',form='unformatted',action='read') ELSEIF(SUB .EQ. 'mbb') then imp=92 OPEN(IMP ,FILE=FNAME,STATUS='OLD',form='binary',action='read') ELSEIF(SUB .EQ. 'rm1') then imp=13 OPEN(IMP ,FILE=FNAME,STATUS='OLD',action='read') ELSEIF(SUB .EQ. 'shp') then IMP=113 OPEN(113,FILE=FNAME,STATUS='OLD',FORM ='BINARY',action='read') SUB='DBF' CALL ADDSUB(FNAME,SUB) OPEN(114,FILE=FNAME,STATUS='OLD',FORM ='BINARY',action='read') ENDIF ENDIF CALL RDMAP(2,IMP,0,0) CLOSE (IMP) RETURN END