You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
175 lines
4.3 KiB
Fortran
175 lines
4.3 KiB
Fortran
5 years ago
|
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
|