RMAGEN84/SRC84/GETSTRESSFIL.F90

    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