1 SUBROUTINE lmpar_parallel(j, fcn)
2 USE fdjac_mod,
ONLY: wa1p => wap, m=>mp, n=>np, &
3 num_lm_params, xp, ncnt=>ncntp
15 REAL(rprec),
PARAMETER :: zero = 0
16 REAL(rprec),
DIMENSION(11),
PARAMETER :: factors = &
17 (/ 1.0_dp, 0.5_dp, 0.25_dp, 0.128_dp, 0.75_dp,
18 1.25_dp, 1.5_dp, 0.9_dp, 1.1_dp, 1.75_dp, 2.1_dp /)
22 INTEGER :: iflag, nfact
26 REAL(rprec) :: deltain, parin, fnorm_in, pnorm_in, scale_factor
30 REAL(rprec),
EXTERNAL :: enorm
45 IF (lfirst_lm .and. num_lm_params > 2)
THEN
50 scale_factor = 10._dp**(1._dp - j)
51 ELSE IF (num_lm_params > 2*nfact)
THEN
52 scale_factor = (j*maxval(factors))/num_lm_params
53 ELSE IF (j .le. nfact)
THEN
54 scale_factor = factors(j)
56 scale_factor =((j-nfact)*minval(factors))/(num_lm_params-nfact)
59 deltain = delta * scale_factor
67 CALL lmpar (n, fjac, ldfjac, ipvt, diag, qtf, deltain, parin, &
68 wa1p, wa2p, wa3p, wa4p)
73 IF (parin.eq.zero .and. j.ne.1) wa1p = wa1p*scale_factor
77 pnorm_in = enorm(n, wa3p)
83 CALL fcn (m, n, wa2p, wa4p, iflag, ncnt)
85 fnorm_in = enorm(m, wa4p)
90 WRITE (j+1000) j, iflag, pnorm_in, fnorm_in, parin, deltain
93 WRITE (j+1000) wa1p(k), wa2p(k)
95 WRITE (j+1000) fjac(k, istat)
99 WRITE (j+1000) wa4p(k)
102 WRITE (j+1000) wa1p, wa2p, wa4p, fjac(1:n, 1:n)
106 END SUBROUTINE lmpar_parallel