!     Last change:  IPK  24 Aug 2001    3:08 pm
      SUBROUTINE REGISTR(I)
      USE BLK1MOD
!      INCLUDE 'BLK1.COM'
      INCLUDE 'BFILES.I90'

      CALL SLPOINT(A1,B1,A2,B2,C1,D1,C2,D2,N)
!
!     A1 = X CORD OF DESIRED WORLD-1
!     B1 = Y CORD OF DESIRED WORLD-1
!     A2 = X CORD OF DESIRED WORLD-2
!     B2 = X CORD OF DESIRED WORLD-2
!     C1 = X CORD OF INPUT WORLD-1
!     D1 = Y CORD OF INPUT WORLD-1
!     C2 = X CORD OF INPUT WORLD-2
!     D2 = X CORD OF INPUT WORLD-2

      IF(N .EQ. 1) THEN

!     Compute new locations

        SCALEER= (A2-A1)/(C2-C1)
        ASIZ=(BFMINMAX(I,3)-BFMINMAX(I,1))*SCALEER
        FLEFT=(C1-BFMINMAX(I,1))/(BFMINMAX(I,3)-BFMINMAX(I,1))
        XNEW1=A1-FLEFT*ASIZ
        XNEW2=XNEW1+ASIZ
        WRITE(90,*) 'X-SCAL',SCALEER,ASIZ,FLEFT,XNEW1,XNEW2
        SCALEER= (B2-B1)/(D2-D1)
        BSIZ=(BFMINMAX(I,4)-BFMINMAX(I,2))*SCALEER
        FBEL=(D1-BFMINMAX(I,2))/(BFMINMAX(I,4)-BFMINMAX(I,2))
        YNEW1=B1-FBEL*BSIZ
        YNEW2=YNEW1+BSIZ
        WRITE(90,*) 'Y-SCAL',SCALEER,BSIZ,FBEL,YNEW1,YNEW2

!      Confirm that they are acceptable

        CALL DISPREG(BFMINMAX(I,1),BFMINMAX(I,2),BFMINMAX(I,3),BFMINMAX(I,4),XNEW1,YNEW1,XNEW2,YNEW2,NN)
        WRITE(90,*) 'AFTER DIS',NN,XNEW1,YNEW1,XNEW2,YNEW2

!      Store them in the appropriate array

        IF(NN .EQ. 1) THEN
          BFMINMAX(I,1)=XNEW1
          BFMINMAX(I,2)=YNEW1
          BFMINMAX(I,3)=XNEW2
          BFMINMAX(I,4)=YNEW2
        ELSE
          RETURN
        ENDIF

!      Save them if they are wanted

        CALL SAVORG(I,1)
       
      ENDIF

      RETURN
      END SUBROUTINE
      
!     Display selected origins

      SUBROUTINE DISPREG(A1,B1,A2,B2,C1,D1,C2,D2,NN)

!   This subroutine gets points
!
      USE WINTERACTER

      IMPLICIT NONE
!
! Define some parameters to match those in the resource file
!
   include 'd.inc'
!
!
! Declare window-type and message variables
!
      TYPE(WIN_STYLE)    :: WINDOW

      TYPE(WIN_MESSAGE) :: MESSAGE
      
      INTEGER            :: N,IBOX,NN
      INTEGER           :: IERR
      REAL              :: A1,B1,A2,B2,C1,D1,C2,D2
      CHARACTER*1       :: IFLAG


           
      call wdialogload(IDD_CONFIRM)
      ierr=infoerror(1)

      CALL WDialogSelect(IDD_CONFIRM)
      ierr=infoerror(1)

      CALL WDialogPutReal(IDF_REAL1,A1,'(F8.0)')
      CALL WDialogPutReal(IDF_REAL2,B1,'(F8.0)')
      CALL WDialogPutReal(IDF_REAL5,A2,'(F8.0)')
      CALL WDialogPutReal(IDF_REAL6,B2,'(F8.0)')
      CALL WDialogPutReal(IDF_REAL3,C1,'(F8.0)')
      CALL WDialogPutReal(IDF_REAL4,D1,'(F8.0)')
      CALL WDialogPutReal(IDF_REAL7,C2,'(F8.0)')
      CALL WDialogPutReal(IDF_REAL8,D2,'(F8.0)')

      CALL WDialogShow(-1,-1,0,Modal)
      ierr=infoerror(1)

      do

!  Branch depending on type of message.
!
        IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
          NN=1
          CALL WDialogGetReal(IDF_REAL1,A1)
          CALL WDialogGetReal(IDF_REAL2,B1)
          CALL WDialogGetReal(IDF_REAL5,A2)
          CALL WDialogGetReal(IDF_REAL6,B2)
          CALL WDialogGetReal(IDF_REAL3,C1)
          CALL WDialogGetReal(IDF_REAL4,D1)
          CALL WDialogGetReal(IDF_REAL7,C2)
          CALL WDialogGetReal(IDF_REAL8,D2)
          RETURN
        ELSEIF(WInfoDialog(ExitButton) .EQ. IDCANCEL) THEN
          NN=0
          RETURN
        ENDIF
!ipk sep02
        NN=0
        RETURN
      ENDDO
      RETURN
      END

!     Select points

      SUBROUTINE SLPOINT(A1,B1,A2,B2,C1,D1,C2,D2,NN)
!
!   This subroutine gets points
!
      USE WINTERACTER

      IMPLICIT NONE
!
!
! Define some parameters to match those in the resource file
!
   include 'd.inc'

      INTEGER :: NP,NE,NHTP,NMESS,NBRR,IPSW,IRMAIN,ISCRN,icolon,IQSW,IRDISP,ntempin,IGFGSW,IGFGSWB,ICRIN,IPW1,WIDEL,WIDSCL,itrianout
      COMMON /HEDS/ NP,NE,NHTP,NMESS,NBRR,IPSW(15),IRMAIN,ISCRN,icolon(12),IQSW(2),IRDISP,ntempin,igfgsw,igfgswb,ICRIN,IPW1,WIDEL,WIDSCL,itrianout


      INCLUDE 'TXFRM.COM'
!IPK MAY02       COMMON  /TXFRM/  XS, YS, TXSCAL 
!

!
! Declare window-type and message variables
!
      TYPE(WIN_STYLE)    :: WINDOW

      TYPE(WIN_MESSAGE) :: MESSAGE
      
      INTEGER            :: N,IBOX,NN
      INTEGER           :: IERR
!IPK MAY02
      REAL              :: A1,B1,A2,B2,C1,D1,C2,D2,XX,YY
      CHARACTER*1       :: IFLAG


      call wdialogload(IDD_SLRGNO)
      ierr=infoerror(1)

      CALL WDialogSelect(IDD_SLRGNO)
      ierr=infoerror(1)
      
      CALL WDialogPutINTEGER(IDF_INTEGER1,N)
      
      CALL WDialogShow(-1,-1,0,Modal)
      ierr=infoerror(1)

      do

!  Branch depending on type of message.
!
        IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN

           CALL WDialogGetINTEGER(IDF_INTEGER1,N)
           GO TO 150
        ENDIF
!ipk sep02
        RETURN
      ENDDO
  150 CONTINUE                 
  
      NHTP=0
      NBRR=3
      NMESS=43
      CALL HEDR
      WRITE(90,*) 'BACK FROM HEDR'
      IF(N .EQ. 1) THEN
        CALL XYLOC(XX,YY,iflag,ibox)
         C1 = XX*TXSCAL - XS 
         D1 = YY*TXSCAL - YS 
      WRITE(90,*) 'BACK FROM XYLOC-1',C1,D1,IBOX,IFLAG
      ELSE
        CALL XYLOC(XX,YY,iflag,ibox)
         C2 = XX*TXSCAL - XS 
         D2 = YY*TXSCAL - YS 
      WRITE(90,*) 'BACK FROM XYLOC-2',C2,D2,IBOX,IFLAG
      ENDIF
      IF(IFLAG .EQ. 'q'  .OR.  (IFLAG .EQ. 'c'  .AND. IBOX .EQ. 10))THEN 
        CALL WRTOUT(0) 
        RETURN 
      ENDIF
   
      call wdialogload(IDD_REGST)
      ierr=infoerror(1)

      CALL WDialogSelect(IDD_REGST)
      ierr=infoerror(1)

      CALL WDialogPutReal(IDF_REAL1,A1,'(F8.0)')
      CALL WDialogPutReal(IDF_REAL2,B1,'(F8.0)')
      CALL WDialogPutReal(IDF_REAL3,A2,'(F8.0)')
      CALL WDialogPutReal(IDF_REAL4,B2,'(F8.0)')
      CALL WDialogPutReal(IDF_REAL5,C1,'(F8.0)')
      CALL WDialogPutReal(IDF_REAL6,D1,'(F8.0)')
      CALL WDialogPutReal(IDF_REAL7,C2,'(F8.0)')
      CALL WDialogPutReal(IDF_REAL8,D2,'(F8.0)')

      CALL WDialogShow(-1,-1,0,Modal)
      ierr=infoerror(1)

      do

!  Branch depending on type of message.
!
        IF (WInfoDialog(ExitButton) .EQ. IDADJUST) THEN

           CALL WDialogGetReal(IDF_REAL1,A1)
           CALL WDialogGetReal(IDF_REAL2,B1)
           CALL WDialogGetReal(IDF_REAL3,A2)
           CALL WDialogGetReal(IDF_REAL4,B2)
           CALL WDialogGetReal(IDF_REAL5,C1)
           CALL WDialogGetReal(IDF_REAL6,D1)
           CALL WDialogGetReal(IDF_REAL7,C2)
           CALL WDialogGetReal(IDF_REAL8,D2)
           NN=1
           RETURN
        ELSEIF (WInfoDialog(ExitButton) .EQ. IDFSWITCH) THEN

           CALL WDialogGetReal(IDF_REAL1,A1)
           CALL WDialogGetReal(IDF_REAL2,B1)
           CALL WDialogGetReal(IDF_REAL3,A2)
           CALL WDialogGetReal(IDF_REAL4,B2)
           CALL WDialogGetReal(IDF_REAL5,C1)
           CALL WDialogGetReal(IDF_REAL6,D1)
           CALL WDialogGetReal(IDF_REAL7,C2)
           CALL WDialogGetReal(IDF_REAL8,D2)
           IF(N .EQ. 1) THEN
             N=2
           ELSE
             N=1
           ENDIF
           GO TO 150
        ELSEIF (WInfoDialog(ExitButton) .EQ. IDCANCEL) THEN
          NN=0
          RETURN
        ENDIF
!IPK SEP02
        NN=0
        RETURN
      ENDDO  
      RETURN
      END           


      SUBROUTINE SAVORG(NN,III)

!   This subroutine askf to check first then saves ORG file data
!
      USE WINTERACTER

      IMPLICIT NONE
!
! Define some parameters to match those in the resource file
!
   include 'd.inc'
!
!
! Declare window-type and message variables
!
      TYPE(WIN_STYLE)    :: WINDOW

      TYPE(WIN_MESSAGE) :: MESSAGE
      
      INCLUDE 'BFILES.I90'
      CHARACTER(LEN=256)  :: FILTER

      INTEGER            :: NN,I,III
      CHARACTER(LEN=255)  :: FNAME
      CHARACTER(LEN=3)    :: SUB
      INTEGER             :: INFO(3)
      REAL                :: XSIZ,YSIZ
      IF(III .EQ. 1) THEN
        CALL WMessageBox(YesNo,QuestionIcon,CommonOK, 'Do you wish to '// &
                           'save locations as ORG or JPGW file?', 'SAVE ORG/JPGW FILE')
!
!   If answer 'NO', return
!
        IF (WInfoDialog(4) .EQ. 2) RETURN
      ENDIF
      
!   Otherwise process
      call IGrFileInfo(BFNAME(NN),INFO,3)

      FILTER ="Registration Files|*.org;*.jpgw|ORG file -- *.org|*.org|JPGW file  -- *.jpgw|*.jpgw|"
      
      CALL WSelectFile(FILTER,SaveDialog+PromptOn+AppendExt,FNAME,'Save ORG/JPGW File')

      IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN

!        SUB='org'
        OPEN(104,FILE=FNAME,STATUS ='UNKNOWN', FORM ='FORMATTED')
        CALL IlowerCase(FNAME)
        CALL GETSUB(FNAME,SUB)
        if(sub .eq. 'jpg') then
          XSIZ=(BFMINMAX(NN,3)-BFMINMAX(NN,1))/FLOAT(INFO(2))
          YSIZ=(BFMINMAX(NN,2)-BFMINMAX(NN,4))/FLOAT(INFO(3))
          WRITE(104,*) XSIZ
          WRITE(104,*) ' 0.0'
          WRITE(104,*) ' 0.0'
          WRITE(104,*) YSIZ
          WRITE(104,*) BFMINMAX(NN,1)
          WRITE(104,*) BFMINMAX(NN,4)
          CLOSE(104)
        else    
!        CALL ADDSUB(FNAME,SUB)
!          OPEN(104,FILE=FNAME,STATUS ='UNKNOWN', FORM ='FORMATTED')
          WRITE(104,'(4G16.8)') (BFMINMAX(NN,I),I=1,4)
          CLOSE(104)
        endif
      ENDIF

      RETURN
      END