      SUBROUTINE MODIFY(NMAX,IFIT,NUMNP,KODE,HTICE,DEPB,PSURF,
     &                  ADOT,FRACT,FLOWA,SLDGB,BDROCK,AFUDGE,IDT,
     &                  NUMEL,KX)
      IMPLICIT REAL*8(A-H,O-Z)
      DIMENSION IFIT(7),KODE(NMAX),HTICE(NMAX),PSURF(NMAX)
      DIMENSION ADOT(NMAX),FRACT(NMAX),FLOWA(NMAX),SLDGB(NMAX)
      DIMENSION BDROCK(NMAX),DEPB(NMAX),AFUDGE(NMAX),IDT(NMAX)
      DIMENSION KX(NMAX,4)
      LOGICAL CTOGG,ITOGG,IOTOGG
      INTEGER BTOGG,SLTOGG,WTOGG
      COMMON /TOGGLES/ SLTOGG,CTOGG,WTOGG,ITOGG,BTOGG,IOTOGG,IPAGE
      parameter(npage=39)
      character*80 list(1000)
      COMMON /IOLIST/ LIST
      FLOWMIN=1d-6
c      FLOWMIN=2.29d0
      SLDGBMIN=1d-9
      RSURF=-500.d0
      RTHICK=1000.d0
      RFACT=1.d0
      RFACTE=1.d0
      AFMAX=10.d0
      AFMIN=0.01d0
      IF(IOTOGG) then
        IF(IFIT(1).EQ.1) then
          WRITE(list(ipage+1),*) 'MODIFYING ADOT:NODE'
          ipage=ipage+1
        ENDIF
        IF(IFIT(2).EQ.1) then
          WRITE(list(ipage+1),*) 'MODIFYING FRACT:NODE'
          ipage=ipage+1
        endif
        IF(IFIT(3).EQ.1) then
          WRITE(list(ipage+1),*) 'MODIFYING FLOW:NODE'
          ipage=ipage+1
        endif
        IF(IFIT(4).EQ.1) then
          WRITE(list(ipage+1),*) 'MODIFYING SLDGB:NODE'
          ipage=ipage+1
        endif
        IF(IFIT(5).EQ.1) then
          WRITE(list(ipage+1),*) 'MODIFYING AFUDGE:NODE'
          ipage=ipage+1
        endif
        IF(IFIT(6).EQ.1) then
          WRITE(list(ipage+1),*) 'MODIFYING AFUDGE/SLDGB:NODE'
          ipage=ipage+1
        endif
        IF(IFIT(1).EQ.-1) then
          WRITE(list(ipage+1),*) 'MODIFYING ADOT:ELEMENT'
          ipage=ipage+1
        endif
        IF(IFIT(2).EQ.-1) then
          WRITE(list(ipage+1),*) 'MODIFYING FRACT:ELEMENT'
          ipage=ipage+1
        endif
        IF(IFIT(3).EQ.-1) then
          WRITE(list(ipage+1),*) 'MODIFYING FLOW:ELEMENT'
          ipage=ipage+1
        endif
        IF(IFIT(4).EQ.-1) then
          WRITE(list(ipage+1),*) 'MODIFYING SLDGB:ELEMENT'
          ipage=ipage+1
        endif
        IF(IFIT(5).EQ.-1) then
          WRITE(list(ipage+1),*) 'MODIFYING AFUDGE:ELEMENT'
          ipage=ipage+1
        endif
        IF(IFIT(6).EQ.-1) then
          WRITE(list(ipage+1),*) 'MODIFYING AFUDGE/SLDGB:ELEMENT'
          ipage=ipage+1
        endif
      endif
      IF(IFIT(1).EQ.1 .OR. 
     &   IFIT(2).EQ.1 .OR. 
     &   IFIT(3).EQ.1 .OR.
     &   IFIT(4).EQ.1 .OR.
     &   IFIT(5).EQ.1 .OR.
     &   IFIT(6).EQ.1) THEN
        DO J=1,NUMNP
          THICKC=HTICE(J)-DEPB(J)
          THICKA=PSURF(J)-BDROCK(J)
          IF(KODE(J).EQ.1) THEN
            RATIOD=0.d0
            RATIOF=1.d0
          ELSE
            RATIOD=1.d0-(HTICE(J)-RSURF)/(PSURF(J)-RSURF)
            RATIOD=RATIOD*RFACT
            RATIOF=RFACT*(PSURF(J)-RSURF)/(HTICE(J)-RSURF)
          ENDIF
          IF(IFIT(1).EQ.1) THEN
            IF(IDT(J).EQ.0) THEN
              ADOT(J)=ADOT(J)+RATIOD
            ENDIF
          ENDIF
          IF(IFIT(2).EQ.1) THEN
c            FRACT(J)=FRACT(J)-FRACT(J)*RATIOD
            FRACT(J)=FRACT(J)-0.1d0*RATIOD
            IF(FRACT(J).GT.1.) FRACT(J)=1.d0
            IF(FRACT(J).LT.0.) FRACT(J)=0.d0
          ENDIF
          IF(IFIT(3).EQ.1) THEN
            FLOWA(J)=FLOWA(J)*RATIOF
            IF(FLOWA(J).GT.10.) FLOWA(J)=10.d0
            IF(FLOWA(J).LT.FLOWMIN) FLOWA(J)=FLOWMIN
          ENDIF
          IF(IFIT(4).EQ.1) THEN
            SLDGB(J)=SLDGB(J)*RATIOF
            IF(SLDGB(J).GT..20) SLDGB(J)=.20d0
            IF(SLDGB(J).LT.SLDGBMIN) SLDGB(J)=SLDGBMIN
          ENDIF
          IF(IFIT(5).EQ.1) THEN
c           IF(KODE(J).EQ.1) THEN
c             RATIOD=0.
c           ELSE
c             RATIOD=1.-(THICKC-RTHICK)/(THICKA-RTHICK)
c             RATIOD=RATIOD*RFACT
c           ENDIF
C            BDROCK(J)=BDROCK(J)+RATIOD*100.
C            IF(BDROCK(J).LT.-9999.) BDROCK(J)=-9999.
C            IF(BDROCK(J).GT.PSURF(J)) BDROCK(J)=PSURF(J)
            AFUDGE(J)=AFUDGE(J)*RATIOF
            IF(AFUDGE(J).GT.AFMAX) AFUDGE(J)=AFMAX
            IF(AFUDGE(J).LT.AFMIN) AFUDGE(J)=AFMIN
C      PRINT 23,J,HTICE(J),PSURF(J),RATIOD*100.,BDROCK(J)
23    FORMAT(I5,4G13.6)
          ENDIF
          IF(IFIT(6).EQ.1) THEN
            IF(FRACT(J).LT.0.5) THEN
              AFUDGE(J)=AFUDGE(J)*RATIOF
              IF(AFUDGE(J).GT.AFMAX) AFUDGE(J)=AFMAX
              IF(AFUDGE(J).LT.AFMIN) AFUDGE(J)=AFMIN
            ELSE
              SLDGB(J)=SLDGB(J)*RATIOF
              IF(SLDGB(J).GT..20) SLDGB(J)=.20d0
              IF(SLDGB(J).LT.SLDGBMIN) SLDGB(J)=SLDGBMIN
            ENDIF
          ENDIF
        ENDDO
      ENDIF
      IF(IFIT(1).EQ.-1 .OR. 
     &   IFIT(2).EQ.-1 .OR. 
     &   IFIT(3).EQ.-1 .OR.
     &   IFIT(4).EQ.-1 .OR.
     &   IFIT(5).EQ.-1 .OR.
     &   IFIT(6).EQ.-1) THEN
        DO J=1,NUMEL
          HT=0.d0
          DB=0.d0
          PS=0.d0
          BD=0.d0
          DO K=1,4
            HT=HT+HTICE(KX(J,K))
            DB=DB+DEPB(KX(J,K))
            PS=PS+PSURF(KX(J,K))
            BD=BD+BDROCK(KX(J,K))
          ENDDO
          HT=0.25d0*HT
          DB=0.25d0*DB
          PS=0.25d0*PS
          BD=0.25d0*BD
          THICKC=HT-DB
          THICKA=PS-BD
          RATIOD=1.d0-(HT-RSURF)/(PS-RSURF)
          RATIOD=RATIOD*RFACTE
          RATIOF=RFACTE*(PS-RSURF)/(HT-RSURF)
C         PRINT *,REAL(HT),REAL(PS),REAL(RATIOD),REAL(RATIOF)
          IF(IFIT(1).EQ.-1) THEN
            DO K=1,4
              IF(IDT(KX(J,K)).EQ.0) THEN
                ADOT(KX(J,K))=ADOT(KX(J,K))+RATIOD
              ENDIF
            ENDDO
          ENDIF
          IF(IFIT(2).EQ.-1) THEN
            DO K=1,4
c             FRACT(KX(J,K))=FRACT(KX(J,K))-FRACT(KX(J,K))*RATIOD
              FRACT(KX(J,K))=FRACT(KX(J,K))-0.1d0*RATIOD
              IF(FRACT(KX(J,K)).GT.1.) FRACT(KX(J,K))=1.d0
              IF(FRACT(KX(J,K)).LT.0.) FRACT(KX(J,K))=0.d0
            ENDDO
          ENDIF
          IF(IFIT(3).EQ.-1) THEN
            DO K=1,4
              FLOWA(KX(J,K))=
     &              0.5d0*(FLOWA(KX(J,K))+FLOWA(KX(J,K))*RATIOF)
              IF(FLOWA(KX(J,K)).GT.10.) FLOWA(KX(J,K))=10.d0
              IF(FLOWA(KX(J,K)).LT.FLOWMIN) FLOWA(KX(J,K))=FLOWMIN
            ENDDO
          ENDIF
          IF(IFIT(4).EQ.-1) THEN
            DO K=1,4
              SLDGB(KX(J,K))=
     &              0.5d0*(SLDGB(KX(J,K))+SLDGB(KX(J,K))*RATIOF)
              IF(SLDGB(KX(J,K)).GT..20) SLDGB(KX(J,K))=.20d0
              IF(SLDGB(KX(J,K)).LT.SLDGBMIN) SLDGB(KX(J,K))=SLDGBMIN
            ENDDO
          ENDIF
          IF(IFIT(5).EQ.-1) THEN
            DO K=1,4
             AFUDGE(KX(J,K))=
     &              0.5d0*(AFUDGE(KX(J,K))+AFUDGE(KX(J,K))*RATIOF)
              IF(AFUDGE(KX(J,K)).GT.AFMAX) AFUDGE(KX(J,K))=AFMAX
              IF(AFUDGE(KX(J,K)).LT.AFMIN) AFUDGE(KX(J,K))=AFMIN
            ENDDO
          ENDIF
          IF(IFIT(6).EQ.-1) THEN
            DO K=1,4
              IF(FRACT(KX(J,K)).LT.0.5) THEN
                AFUDGE(KX(J,K))=
     &              0.5d0*(AFUDGE(KX(J,K))+AFUDGE(KX(J,K))*RATIOF)
                IF(AFUDGE(KX(J,K)).GT.AFMAX) AFUDGE(KX(J,K))=AFMAX
                IF(AFUDGE(KX(J,K)).LT.AFMIN) AFUDGE(KX(J,K))=AFMIN
              ELSE
                SLDGB(KX(J,K))=
     &              0.5d0*(SLDGB(KX(J,K))+SLDGB(KX(J,K))*RATIOF)
                IF(SLDGB(KX(J,K)).GT..20) SLDGB(KX(J,K))=.20d0
                IF(SLDGB(KX(J,K)).LT.SLDGBMIN) SLDGB(KX(J,K))=SLDGBMIN
              ENDIF
            ENDDO
          ENDIF
        ENDDO
      ENDIF
      IF(IFIT(1).EQ.2 .OR. 
     &   IFIT(2).EQ.2 .OR. 
     &   IFIT(3).EQ.2 .OR.
     &   IFIT(4).EQ.2 .OR.
     &   IFIT(5).EQ.2) THEN
        THICKDIFF=0.0
        THICKAVG=0.0
        DO J=1,NUMNP
          THICKC=HTICE(J)-DEPB(J)
          THICKA=PSURF(J)-BDROCK(J)
          THICKAVG=THICKAVG+THICKA+THICKC
          THICKDIFF=THICKDIFF+(THICKC-THICKA)
        ENDDO
        THICKAVG=0.5d0*THICKAVG/NUMNP
        THICKDIFF=THICKDIFF/NUMNP
        ratio=1.d0-1*THICKDIFF/THICKAVG
        IF(IFIT(5).EQ.2) then
          IF(IOTOGG) then
            WRITE(list(ipage+1),*) 'MODIFYING AFUDGE:GLOBAL',
     &                             real(thickdiff),real(ratio)
            ipage=ipage+1
          ENDIF
          avg1=0
          avg2=0
          do i=1,numnp
            avg1=avg1+afudge(i)
            afudge(i)=afudge(i)*ratio
            IF(AFUDGE(i).GT.AFMAX) AFUDGE(i)=AFMAX
            IF(AFUDGE(i).LT.AFMIN) AFUDGE(i)=AFMIN
            avg2=avg2+afudge(i)
          enddo
          avg1=avg1/numnp
          avg2=avg2/numnp
          IF(IOTOGG) then
            WRITE(list(ipage+1),*) '                       ',
     &                             real(avg1),real(avg2)
            ipage=ipage+1
          ENDIF
        ENDIF
        IF(IFIT(4).EQ.2) then
          IF(IOTOGG) then
            WRITE(list(ipage+1),*) 'MODIFYING SLDGB:GLOBAL',
     &                             real(thickdiff),real(ratio)
            ipage=ipage+1
          ENDIF
          avg1=0
          avg2=0
          do i=1,numnp
            avg1=avg1+SLDGB(i)
            SLDGB(i)=SLDGB(i)*ratio
            IF(SLDGB(J).GT..20) SLDGB(J)=.20d0
            IF(SLDGB(J).LT.SLDGBMIN) SLDGB(J)=SLDGBMIN
            avg2=avg2+SLDGB(i)
          enddo
          avg1=avg1/numnp
          avg2=avg2/numnp
          IF(IOTOGG) then
            WRITE(list(ipage+1),*) '                       ',
     &                             real(avg1),real(avg2)
            ipage=ipage+1
          ENDIF
        ENDIF
      ENDIF
      END

