anchor.diff:  !             last upgrade : July 2016
   !
   !
  +
  +MODULE constants
  +  IMPLICIT NONE
  +  PUBLIC
  +  INTEGER,  PARAMETER :: dp = KIND(1.0D0)
  +  INTEGER, PARAMETER :: dpc = KIND((1.0D0,1.0D0))
  +  REAL(dp), PUBLIC :: k_lambda, start_point
  +  REAL(DP), PUBLIC, ALLOCATABLE :: onebodyenergy(:)
  +  INTEGER , PUBLIC :: n_total
  +END MODULE constants
  +
  +!Module to read in name/value pairs from a file, with each line of the form line 'name = value'
  +
  +MODULE inifile
  +  IMPLICIT NONE
  +  PUBLIC
  +  INTEGER, PARAMETER :: ini_max_name_len = 128
  +  INTEGER, PARAMETER :: ini_max_string_len = 1024
  +  LOGICAL :: ini_fail_on_not_found = .FALSE.
  +  LOGICAL :: ini_echo_read = .FALSE.
  +  TYPE tnamevalue
  +     !no known way to make character string pointers..
  +     CHARACTER(ini_max_name_len)  :: name
  +     CHARACTER(ini_max_string_len):: value
  +  END TYPE tnamevalue
  +
  +  TYPE tnamevalue_pointer
  +     TYPE(tnamevalue), POINTER :: p
  +  END TYPE tnamevalue_pointer
  +
  +  TYPE tnamevaluelist
  +     INTEGER count
  +     INTEGER delta
  +     INTEGER capacity
  +     TYPE(tnamevalue_pointer), DIMENSION(:), POINTER :: items
  +  END TYPE tnamevaluelist
  +
  +  TYPE tinifile
  +     LOGICAL slashcomments
  +     TYPE (tnamevaluelist) :: l, readvalues
  +  END TYPE tinifile
  +
  +  TYPE(tinifile) :: defini
  +
  +CONTAINS
  +
  +  SUBROUTINE tnamevaluelist_init(l)
  +    TYPE (tnamevaluelist) :: l
  +
  +    l%count = 0
  +    l%capacity = 0
  +    l%delta = 128
  +    NULLIFY(l%items)
  +
  +  END SUBROUTINE tnamevaluelist_init
  +
  +  SUBROUTINE tnamevaluelist_clear(l)
  +    TYPE (tnamevaluelist) :: l
  +    INTEGER i, status
  +
  +    DO i=l%count,1,-1
  +       DEALLOCATE (l%items(i)%p, stat = status)
  +    END DO
  +    DEALLOCATE (l%items, stat = status)
  +    CALL tnamevaluelist_init(l)
  +
  +  END SUBROUTINE tnamevaluelist_clear
  +
  +  SUBROUTINE tnamevaluelist_valueof(l, aname, avalue)
  +    TYPE (tnamevaluelist) :: l
  +    CHARACTER(len=*), INTENT(in) :: aname
  +    CHARACTER(len=*) :: avalue
  +    INTEGER i
  +
  +    DO i=1, l%count
  +       IF (l%items(i)%p%name == aname) THEN
  +          avalue = l%items(i)%p%value 
  +          RETURN
  +       END IF
  +    END DO
  +    avalue = ''
  +
  +  END SUBROUTINE tnamevaluelist_valueof
  +
  +  SUBROUTINE tnamevaluelist_add(l, aname, avalue)
  +    TYPE (tnamevaluelist) :: l
  +    CHARACTER(len=*), INTENT(in) :: aname, avalue
  +
  +    IF (l%count == l%capacity) CALL tnamevaluelist_setcapacity(l, l%capacity + l%delta)
  +    l%count = l%count + 1
  +    ALLOCATE(l%items(l%count)%p)
  +    l%items(l%count)%p%name = aname
  +    l%items(l%count)%p%value = avalue
  +
  +  END SUBROUTINE tnamevaluelist_add
  +
  +  SUBROUTINE tnamevaluelist_setcapacity(l, c)
  +    TYPE (tnamevaluelist) :: l
  +    INTEGER c
  +    TYPE(tnamevalue_pointer), DIMENSION(:), POINTER :: tmpitems
  +
  +    IF (l%count > 0) THEN
  +       IF (c < l%count) STOP 'tnamevaluelist_setcapacity: smaller than count'
  +       ALLOCATE(tmpitems(l%count))
  +       tmpitems = l%items(1:l%count)
  +       DEALLOCATE(l%items)
  +       ALLOCATE(l%items(c))
  +       l%items(1:l%count) = tmpitems
  +       DEALLOCATE(tmpitems)
  +    ELSE
  +       ALLOCATE(l%items(c))
  +    END IF
  +    l%capacity = c
  +
  +  END SUBROUTINE tnamevaluelist_setcapacity
  +
  +  SUBROUTINE tnamevaluelist_delete(l, i)
  +    TYPE (tnamevaluelist) :: l
  +    INTEGER, INTENT(in) :: i
  +
  +    DEALLOCATE(l%items(i)%p)
  +    IF (l%count > 1) l%items(i:l%count-1) = l%items(i+1:l%count)
  +    l%count = l%count -1
  +
  +  END SUBROUTINE tnamevaluelist_delete
  +
  +  SUBROUTINE ini_namevalue_add(ini,ainline)
  +    TYPE(tinifile) :: ini
  +    CHARACTER (len=*), INTENT(in) :: ainline
  +    INTEGER eqpos, slashpos, lastpos
  +    CHARACTER (len=LEN(ainline)) :: aname, s, inline
  +
  +    inline=TRIM(ADJUSTL(ainline))
  +    eqpos = SCAN(inline,'=')
  +    IF (eqpos/=0 .AND. inline(1:1)/='#' .AND. inline(1:7) /= 'comment' ) THEN
  +       aname = TRIM(inline(1:eqpos-1))
  +       s = ADJUSTL(inline(eqpos+1:)) 
  +       IF (ini%slashcomments) THEN
  +          slashpos=SCAN(s,'/')
  +          IF (slashpos /= 0) THEN
  +             s  = s(1:slashpos-1)
  +          END IF
  +       END IF
  +       lastpos=LEN_TRIM(s)
  +       IF (lastpos>1) THEN
  +          IF (s(1:1)=='''' .AND. s(lastpos:lastpos)=='''') THEN
  +             s = s(2:lastpos-1)
  +          END IF
  +       END IF
  +       CALL tnamevaluelist_add(ini%l, aname, s)
  +    END IF
  +
  +  END SUBROUTINE ini_namevalue_add
  +
  +
  +  SUBROUTINE ini_open(filename, unit_id,  error, slash_comments)
  +    CHARACTER (len=*), INTENT(in) :: filename
  +    INTEGER, INTENT(in) :: unit_id
  +    LOGICAL, OPTIONAL, INTENT(out) :: error
  +    LOGICAL, OPTIONAL, INTENT(in) :: slash_comments
  +    LOGICAL aerror
  +
  +    CALL tnamevaluelist_init(defini%l)
  +    CALL tnamevaluelist_init(defini%readvalues)
  +    IF (PRESENT(slash_comments)) THEN
  +       CALL ini_open_file(defini,filename,unit_id,aerror,slash_comments)
  +    ELSE
  +       CALL ini_open_file(defini,filename,unit_id,aerror)
  +    END IF
  +    IF (PRESENT(error)) THEN
  +       error = aerror
  +    ELSE
  +       IF (aerror) THEN
  +          WRITE (*,*) 'ini_open: error opening file ' // TRIM(filename)
  +          STOP
  +       END IF
  +    END IF
  +
  +  END SUBROUTINE ini_open
  +
  +
  +  SUBROUTINE ini_open_file(ini, filename, unit_id,  error, slash_comments)
  +    TYPE(tinifile) :: ini
  +    CHARACTER (len=*), INTENT(in) :: filename
  +    INTEGER, INTENT(in) :: unit_id
  +    LOGICAL, INTENT(out) :: error
  +    LOGICAL, OPTIONAL, INTENT(in) :: slash_comments
  +    CHARACTER (len=120) :: inline
  +
  +    CALL tnamevaluelist_init(ini%l)
  +    CALL tnamevaluelist_init(ini%readvalues)
  +
  +    IF (PRESENT(slash_comments)) THEN
  +       ini%slashcomments = slash_comments
  +    ELSE
  +       ini%slashcomments = .FALSE.
  +    END IF
  +    OPEN(unit=unit_id,file=filename,form='formatted',status='old', err=500)
  +    DO 
  +       READ (unit_id,'(a)',END=400) inline
  +       IF (inline == 'end') EXIT;
  +       IF (inline /= '') CALL ini_namevalue_add(ini,inline) 
  +    END DO
  +400 CLOSE(unit_id)
  +    error=.FALSE.
  +    RETURN
  +500 error=.TRUE.
  +
  +  END SUBROUTINE ini_open_file
  +
  +  SUBROUTINE ini_open_fromlines(ini, lines, numlines, slash_comments)
  +    TYPE(tinifile) :: ini
  +    INTEGER, INTENT(in) :: numlines
  +    CHARACTER (len=*), DIMENSION(numlines), INTENT(in) :: lines
  +    LOGICAL, INTENT(in) :: slash_comments
  +    INTEGER i
  +
  +    CALL tnamevaluelist_init(ini%l)
  +    ini%slashcomments = slash_comments
  +    DO i=1,numlines
  +       CALL ini_namevalue_add(ini,lines(i))
  +    END DO
  +
  +  END  SUBROUTINE ini_open_fromlines
  +
  +  SUBROUTINE ini_close
  +
  +    CALL ini_close_file(defini)
  +
  +  END SUBROUTINE ini_close
  +
  +
  +  SUBROUTINE ini_close_file(ini)
  +    TYPE(tinifile) :: ini
  +
  +    CALL tnamevaluelist_clear(ini%l)
  +    CALL tnamevaluelist_clear(ini%readvalues)
  +
  +  END  SUBROUTINE ini_close_file
  +
  +
  +  FUNCTION ini_read_string(key, notfoundfail) RESULT(avalue)
  +    CHARACTER (len=*), INTENT(in) :: key
  +    LOGICAL, OPTIONAL, INTENT(in) :: notfoundfail
  +    CHARACTER(len=ini_max_string_len) :: avalue
  +
  +    IF (PRESENT(notfoundfail)) THEN
  +       avalue = ini_read_string_file(defini, key, notfoundfail)
  +    ELSE
  +       avalue = ini_read_string_file(defini, key)
  +    END IF
  +
  +  END FUNCTION ini_read_string
  +
  +
  +  FUNCTION ini_read_string_file(ini, key, notfoundfail) RESULT(avalue)
  +    TYPE(tinifile) :: ini
  +    CHARACTER (len=*), INTENT(in) :: key
  +    LOGICAL, OPTIONAL, INTENT(in) :: notfoundfail
  +    CHARACTER(len=ini_max_string_len) :: avalue
  +
  +    CALL tnamevaluelist_valueof(ini%l, key, avalue)
  +    IF (avalue/='') THEN
  +       CALL  tnamevaluelist_add(ini%readvalues, key, avalue)
  +       IF (ini_echo_read) WRITE (*,*) TRIM(key)//' = ',TRIM(avalue)
  +       RETURN
  +    END IF
  +    IF (ini_fail_on_not_found) THEN
  +       WRITE(*,*) 'key not found : '//key
  +       STOP
  +    END IF
  +    IF (PRESENT(notfoundfail)) THEN
  +       IF (notfoundfail) THEN
  +          WRITE(*,*) 'key not found : '//key
  +          STOP
  +       END IF
  +    END IF
  +
  +  END FUNCTION ini_read_string_file
  +
  +
  +  FUNCTION ini_read_int(key, default)
  +    INTEGER, OPTIONAL, INTENT(in) :: default
  +    CHARACTER (len=*), INTENT(in) :: key
  +    INTEGER ini_read_int
  +
  +    IF (PRESENT(default)) THEN
  +       ini_read_int = ini_read_int_file(defini, key, default)
  +    ELSE
  +       ini_read_int = ini_read_int_file(defini, key)
  +    END IF
  +
  +  END FUNCTION ini_read_int
  +
  +
  +  FUNCTION ini_read_int_file(ini, key, default)
  +    TYPE(tinifile) :: ini
  +    INTEGER ini_read_int_file
  +    INTEGER, OPTIONAL, INTENT(in) :: default
  +    CHARACTER  (len=*), INTENT(in) :: key
  +    CHARACTER(len=ini_max_string_len) :: s
  +
  +    s = ini_read_string_file(ini, key,.NOT. PRESENT(default))
  +    IF (s == '') THEN
  +       IF (.NOT. PRESENT(default)) THEN
  +          WRITE(*,*) 'no value for key: '//key
  +          STOP
  +       END IF
  +       ini_read_int_file = default
  +       WRITE (s,*) default
  +       CALL  tnamevaluelist_add(ini%readvalues, key, s)
  +    ELSE
  +       IF (VERIFY(TRIM(s),'-+0123456789') /= 0) GOTO 10
  +       READ (s,*, err = 10) ini_read_int_file
  +    END IF
  +    RETURN
  +10  WRITE (*,*) 'error reading integer for key: '//key
  +    STOP
  +
  +  END FUNCTION ini_read_int_file
  +
  +  FUNCTION ini_read_double(key, default)
  +    DOUBLE PRECISION, OPTIONAL, INTENT(in) :: default
  +    CHARACTER (len=*), INTENT(in) :: key
  +    DOUBLE PRECISION ini_read_double
  +
  +    IF (PRESENT(default)) THEN
  +       ini_read_double = ini_read_double_file(defini, key, default)
  +    ELSE
  +       ini_read_double = ini_read_double_file(defini, key)
  +    END IF
  +
  +  END FUNCTION ini_read_double
  +
  +
  +  FUNCTION ini_read_double_file(ini,key, default)
  +    TYPE(tinifile) :: ini
  +    DOUBLE PRECISION ini_read_double_file 
  +    DOUBLE PRECISION, OPTIONAL, INTENT(in) :: default
  +    CHARACTER (len=*), INTENT(in) :: key
  +    CHARACTER(len=ini_max_string_len) :: s
  +
  +    s = ini_read_string_file(ini,key,.NOT. PRESENT(default))
  +    IF (s == '') THEN
  +       IF (.NOT. PRESENT(default)) THEN
  +          WRITE(*,*) 'no value for key: '//key
  +          STOP
  +       END IF
  +       ini_read_double_file = default
  +       WRITE (s,*) default
  +       CALL  tnamevaluelist_add(ini%readvalues, key, s)
  +    ELSE
  +       READ (s,*, err=10) ini_read_double_file
  +    END IF
  +    RETURN
  +10  WRITE (*,*) 'error reading double for key: '//key
  +    STOP
  +
  +  END FUNCTION ini_read_double_file
  +
  +
  +  FUNCTION ini_read_real(key, default)
  +    REAL, OPTIONAL, INTENT(in) :: default
  +    CHARACTER (len=*), INTENT(in) :: key
  +    REAL ini_read_real
  +
  +    IF (PRESENT(default)) THEN
  +       ini_read_real = ini_read_real_file(defini, key, default)
  +    ELSE
  +       ini_read_real = ini_read_real_file(defini, key)
  +    END IF
  +
  +  END FUNCTION ini_read_real
  +
  +  FUNCTION ini_read_real_file(ini,key, default)
  +    TYPE(tinifile) :: ini
  +    REAL ini_read_real_file 
  +    REAL, OPTIONAL, INTENT(in) :: default
  +    CHARACTER (len=*), INTENT(in) :: key
  +    CHARACTER(len=ini_max_string_len) :: s
  +
  +    s = ini_read_string_file(ini,key,.NOT. PRESENT(default))
  +    IF (s == '') THEN
  +       IF (.NOT. PRESENT(default)) THEN
  +          WRITE(*,*) 'no value for key: '//key
  +          STOP
  +       END IF
  +       ini_read_real_file = default
  +       WRITE (s,*) default
  +       CALL  tnamevaluelist_add(ini%readvalues, key, s)
  +    ELSE
  +       READ (s,*, err=10) ini_read_real_file
  +    END IF
  +    RETURN
  +10  WRITE (*,*) 'error reading double for key: '//key
  +    STOP
  +
  +  END FUNCTION ini_read_real_file
  +
  +
  +  FUNCTION ini_read_logical(key, default)
  +    LOGICAL, OPTIONAL, INTENT(in) :: default
  +    CHARACTER (len=*), INTENT(in) :: key
  +    LOGICAL ini_read_logical
  +
  +    IF (PRESENT(default)) THEN
  +       ini_read_logical = ini_read_logical_file(defini, key, default)
  +    ELSE
  +       ini_read_logical = ini_read_logical_file(defini, key)
  +    END IF
  +
  +  END FUNCTION ini_read_logical
  +
  +  FUNCTION ini_read_logical_file(ini, key, default)
  +    TYPE(tinifile) :: ini
  +    LOGICAL ini_read_logical_file
  +    LOGICAL, OPTIONAL, INTENT(in) :: default
  +    CHARACTER  (len=*), INTENT(in) :: key
  +
  +    CHARACTER(len=ini_max_string_len) :: s
  +
  +    s = ini_read_string_file(ini,key,.NOT. PRESENT(default))
  +    IF (s == '') THEN
  +       IF (.NOT. PRESENT(default)) THEN
  +          WRITE(*,*) 'no value for key: '//key
  +          STOP
  +       END IF
  +       ini_read_logical_file = default
  +       WRITE (s,*) default
  +       CALL  tnamevaluelist_add(ini%readvalues, key, s)
  +    ELSE
  +       IF (VERIFY(TRIM(s),'10tf') /= 0) GOTO 10  
  +       READ (s,*, err = 10) ini_read_logical_file
  +    END IF
  +
  +    RETURN
  +
  +10  WRITE (*,*) 'error reading logical for key: '//key
  +    STOP
  +  END FUNCTION ini_read_logical_file
  +
  +
  +  SUBROUTINE ini_savereadvalues(afile,unit_id)
  +    CHARACTER(len=*)  :: afile
  +    INTEGER, INTENT(in) :: unit_id
  +
  +    CALL ini_savereadvalues_file(defini, afile, unit_id)
  +
  +  END SUBROUTINE ini_savereadvalues
  +
  +
  +  SUBROUTINE ini_savereadvalues_file(ini, afile, unit_id)
  +    TYPE(tinifile) :: ini
  +    CHARACTER(len=*), INTENT(in) :: afile
  +    INTEGER, INTENT(in) :: unit_id
  +    INTEGER i
  +
  +    OPEN(unit=unit_id,file=afile,form='formatted',status='replace', err=500)
  +
  +    DO i=1, ini%readvalues%count
  +       WRITE (unit_id,'(a)') TRIM(ini%readvalues%items(i)%p%name) // ' = ' &
  +            //TRIM(ini%readvalues%items(i)%p%value)
  +
  +    END DO
  +
  +    CLOSE(unit_id)
  +    RETURN
  +
  +500 WRITE(*,*) 'ini_savereadvalues_file: error creating '//TRIM(afile)
  +
  +  END SUBROUTINE ini_savereadvalues_file
  +
  +END MODULE inifile
  +
  +
  +
   PROGRAM  pairing
     USE constants
     USE inifile
  
positive.code: 
  
  
  MODULE constants
    INTEGER,  PARAMETER :: dp = KIND(1.0D0)
    INTEGER, PARAMETER :: dpc = KIND((1.0D0,1.0D0))
    REAL(dp), PUBLIC :: k_lambda, start_point
    REAL(DP), PUBLIC, ALLOCATABLE :: onebodyenergy(:)
    INTEGER , PUBLIC :: n_total
  END MODULE constants
  
  
  
  
negative.code: END SUBROUTINE derivative
  
  
  
  
  !
  