MINICERN/mathlib/gen/d/d501p1.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/04/01 15:02:19  mclareni
   6 * Mathlib gen
   7 *
   8 *
   9 #include "gen/pilot.h"
  10       SUBROUTINE D501P1(K,M,NC,X,NX,Y,SY,MODE,EPS0,EPS,MAXIT,IPRT,
  11      +                  N,A,AL,AU,NERROR,VERS)
  12
  13 ************************************************************************
  14 *   LEAMAX, VERSION: 15.03.1993
  15 ************************************************************************
  16 *
  17 *   THIS ROUTINE CHECKS THE VALUES OF INPUT PARAMETERS OF THE
  18 *   SUBROUTINES  DSUMSQ, DFUNFT, DMAXLK  DEPENDING ON THE VALUE OF
  19 *   THE PARAMETER  VERS.
  20 *   IF  IPRT < 0  ALL VALUES OF THE INPUT PARAMETERS ARE PRINTED.
  21 *
  22 *************************************************************************
  23
  24 #include "gen/imp64.inc"
  25       CHARACTER VERS*6,TIT1(3)*35,TIT2(0:1)*35
  26       DIMENSION X(*),Y(*),SY(*),A(*),AL(*),AU(*)
  27       PARAMETER (Z1 = 1, R10 = Z1/10)
  28
  29       DATA TIT1(1) /'MINIMIZATION OF A SUM OF SQUARES'/
  30       DATA TIT1(2) /'LEAST-SQUARES DATA FITTING'/
  31       DATA TIT1(3) /'MAXIMUM LIKELIHOOD ESTIMATION'/
  32
  33       DATA TIT2(0) /'APPROXIMATE DERIVATIVES (MODE = 0)'/
  34       DATA TIT2(1) /'ANALYTICAL DERIVATIVES (MODE = 1)'/
  35
  36       IF(IPRT .NE. 0) THEN
  37        IF(VERS .EQ. 'DSUMSQ') IV=1
  38        IF(VERS .EQ. 'DFUNFT') IV=2
  39        IF(VERS .EQ. 'DMAXLK') IV=3
  40
  41        WRITE(6,1000) VERS,TIT1(IV),TIT2(MODE)
  42       ENDIF
  43
  44 ************************************************************************
  45 *   PRINT INPUT PARAMETERS (IF IPRT .LT. 0)
  46 ************************************************************************
  47
  48       IF(IPRT .LT. 0) THEN
  49        WRITE(6,1010) VERS,M,N
  50        IF(VERS .NE. 'DMAXLK') WRITE(6,1020) NC
  51        IF(VERS .NE. 'DSUMSQ') WRITE(6,1030) K,NX
  52        WRITE(6,1040) MAXIT,MODE,IPRT,EPS
  53       ENDIF
  54
  55 ************************************************************************
  56 *   CHECK VALUES OF INPUT PARAMETERS, AND PRINT THEM (IF IPRT .LT. 0)
  57 ************************************************************************
  58
  59       NERROR=0
  60
  61       IF(     MAXIT .LT. 1
  62      1   .OR. K     .LT. 1
  63      2   .OR. N     .LT. 1
  64      3   .OR. M     .LT. N
  65      4   .OR. NC    .LT. N
  66      5   .OR. NX    .LT. K ) THEN
  67        NERROR=1
  68        RETURN
  69       ENDIF
  70
  71       IF(IPRT .LT. 0) THEN
  72        WRITE(6,1050) (AL(I), I=1,N)
  73        WRITE(6,1060) (AU(I), I=1,N)
  74        WRITE(6,1070) (A(I),  I=1,N)
  75       IF(VERS .NE. 'DSUMSQ')WRITE(6,1080)((X(I),I=L,M*NX,NX),L=1,K)
  76        IF(VERS .EQ. 'DFUNFT') THEN
  77         WRITE(6,1090) (Y(I), I=1,M)
  78         WRITE(6,1100) (SY(I),I=1,M)
  79        ENDIF
  80       ENDIF
  81
  82       DO 10 I=1,N
  83       IF(AL(I) .GT. AU(I)) THEN
  84        NERROR=1
  85        RETURN
  86       ENDIF
  87    10 CONTINUE
  88
  89 ************************************************************************
  90 *   IF VALUES OF THE PARAMETERS A, SY, MODE OR EPS ARE NOT PRACTICABLE
  91 *   SET RECOMMENDED VALUES FOR THIS PARAMETERS
  92 ************************************************************************
  93
  94       DO 20 I=1,N
  95       IF(A(I) .GT. AU(I)) A(I)=AU(I)
  96       IF(A(I) .LT. AL(I)) A(I)=AL(I)
  97    20 CONTINUE
  98
  99       IF (VERS .EQ. 'DFUNFT') THEN
 100        DO 30 I = 1,M
 101        IF(SY(I) .LE. 0) THEN
 102         NERROR=1
 103         RETURN
 104        ENDIF
 105    30  CONTINUE
 106       ENDIF
 107
 108 CC    IF(STEP .LE. 0) STEP=1
 109       IF(MODE .NE. 1) MODE=0
 110       IF (EPS .LT. EPS0  .OR.  EPS .GT. R10) EPS=10*EPS0
 111
 112       RETURN
 113
 114  1000 FORMAT(7(/),30X,'MATHLIB PACKAGE   D501   VERSION 15.03.93'//
 115      1       30X,'PACKAGE LEAMAX  ****  ROUTINE ',A6,' ****'///
 116      2       15X,A35,A35//)
 117  1010 FORMAT(' INPUT  OF  ',A6,' :'//'  M :',I5,6X,'N :',I5)
 118  1020 FORMAT('  NC:',I5)
 119  1030 FORMAT('  K :',I5,6X,'NX:',I5)
 120  1040 FORMAT('  MAXIT :',I5,8X,'MODE :',I5,8X,'IPRT :',I5/
 121      +       '  EPS   :',1PD11.1/)
 122  1050 FORMAT(/'  AL :',/(5(1PD15.5)))
 123  1060 FORMAT( '  AU :',/(5(1PD15.5)))
 124  1070 FORMAT( '  A :', /(5(1PD15.5)))
 125  1080 FORMAT( '  X :', /(5(1PD15.5)))
 126  1090 FORMAT( '  Y :', /(5(1PD15.5)))
 127  1100 FORMAT( '  SY :',/(5(1PD15.5)))
 128
 129       END
 130
 131
 132