mille.f90

Go to the documentation of this file.

 
! Code converted using TO_F90 by Alan Miller
! Date: 2012-03-03  Time: 17:00:12
 
 
 
MODULE mpmille
    USE mpdef
    IMPLICIT NONE
    SAVE
 
    INTEGER(mpi), PARAMETER :: lun=51
    INTEGER(mpi), PARAMETER :: ndim=10000
    INTEGER(mpi) :: nr=0
    INTEGER(mpi) :: icount=0
    INTEGER(mpi) :: isp
    REAL(mps) :: glder(ndim)
    INTEGER(mpi) :: inder(ndim)
        
END MODULE mpmille  
 
 
SUBROUTINE mille(nlc,derlc,ngl,dergl,label,rmeas,sigma) ! add data
    USE mpmille
 
    IMPLICIT NONE
    INTEGER(mpi) :: i
    !     -----------------------------------------------------------------
 
    INTEGER(mpi), INTENT(IN)                      :: nlc
    REAL(mps), INTENT(IN)                         :: derlc(nlc)
    INTEGER(mpi), INTENT(IN)                      :: ngl
    REAL(mps), INTENT(IN)                         :: dergl(ngl)
    INTEGER(mpi), INTENT(IN)                      :: label(ngl)
    REAL(mps), INTENT(IN)                         :: rmeas
    REAL(mps), INTENT(IN)                         :: sigma
    !     -----------------------------------------------------------------
 
    SAVE
    !     ...
    IF(sigma <= 0.0) RETURN   ! error zero - no measurement
    IF(nr == 0) THEN
        nr=1
        glder(1)=0.0
        inder(1)=0             ! error counter
        isp=0
    END IF
    IF(nr+nlc+ngl+2 > ndim) THEN
        icount=icount+1
        IF(icount <= 10) THEN
            WRITE(*,*) 'Mille warning: data can not be stored'
            IF(icount == 10) THEN
                WRITE(*,*) 'Mille warning: no further printout'
            END IF
        END IF
        inder(1)=inder(1)+1    ! count errors
        RETURN                 ! record dimension too small
    END IF
    nr=nr+1
    glder(nr)=rmeas           ! measured value
    inder(nr)=0
    DO i=1,nlc                ! local derivatives
        IF(derlc(i) /= 0.0) THEN
            nr=nr+1
            glder(nr)=derlc(i)    ! derivative of local parameter
            inder(nr)=i           ! index of local parameter
        END IF
    END DO
 
    nr=nr+1
    glder(nr)=sigma           ! error of measured value
    inder(nr)=0
    DO i=1,ngl                ! global derivatives
        IF(dergl(i) /= 0.0.AND.label(i) > 0) THEN
            nr=nr+1
            glder(nr)=dergl(i)    ! derivative of global parameter
            inder(nr)=label(i)    ! index of global parameter
        END IF
    END DO
    RETURN
END SUBROUTINE mille
 
    
SUBROUTINE millsp(nsp,dergl,label)
    USE mpmille
 
    IMPLICIT NONE
    INTEGER(mpi) :: i
 
    INTEGER(mpi), INTENT(IN)                      :: nsp
    REAL(mps), INTENT(IN)                         :: dergl(nsp)
    INTEGER(mpi), INTENT(IN)                      :: label(nsp)       
 
    IF(nsp <= 0.OR.isp /= 0) RETURN
    isp=nr
    IF(nr == 0) THEN
        nr=1
        glder(1)=0.0
        inder(1)=0             ! error counter
    END IF
    IF(nr+nsp+2 > ndim) THEN
        inder(1)=inder(1)+1    ! count errors
        RETURN                 ! record dimension too small
    END IF
    nr=nr+1                   ! zero pair
    glder(nr)=0.0
    inder(nr)=0
    nr=nr+1                   ! nsp and zero
    glder(nr)=-real(nsp,mps)
    inder(nr)=0
    DO i=1,nsp
        nr=nr+1
        glder(nr)=dergl(i)       ! floating-point
        inder(nr)=label(i)       ! integer
    END DO
    RETURN
END SUBROUTINE millsp
 
SUBROUTINE kille
    USE mpmille
 
    IMPLICIT NONE
    
    nr=0    ! reset
    RETURN
END SUBROUTINE kille
 
SUBROUTINE endle
    USE mpmille
 
    IMPLICIT NONE
    INTEGER(mpi) :: i
        
    IF(nr > 1) THEN
        WRITE(lun) nr+nr,(glder(i),i=1,nr),(inder(i),i=1,nr)
    END IF
    nr=0    ! reset
    RETURN
END SUBROUTINE endle