nwrfst.f 1.93 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71
      SUBROUTINE nwrfst(mrad,nsol,is,it,nmatch,nzero,ferro,ec,rc,
     +                  pow,piw,gc,err,var,dv,varnew,errnew)

c..........................................................nwrfst
c starting values for E, A, A_out, A_inw
c
      IMPLICIT NONE
C     ..
C     .. Scalar Arguments ..
      INTEGER, INTENT (IN) :: mrad
      REAL ec
      INTEGER is,it,nmatch,nsol,nzero
      LOGICAL ferro
C     ..
C     .. Array Arguments ..
      REAL dv(4),err(4),errnew(4),gc(2,2,mrad),piw(2,2),pow(2,2),
     +     rc(mrad),var(4),varnew(4)
C     ..
C     .. Local Scalars ..
      REAL ratt,rr,trymix
      INTEGER iv,j,n
C     ..
C     .. Local Arrays ..
      REAL niw(2),now(2)
C     ..
C     .. Data statements ..
C
      DATA trymix/0.010/
C     ..
C                                      --------------------
C                                       START VALUES FOR
C                                           PARAMETERS
C                                      --------------------
      var(1) = ec
      var(2) = pow(is,is)/piw(is,is)
c
      IF ((nsol.EQ.2) .AND. ferro) THEN
         DO 10 j = 1,nsol
            now(j) = 0.00
   10    CONTINUE
         DO 30 n = 1,nmatch - 1
            rr = rc(n)**3
            DO 20 j = 1,nsol
               now(j) = now(j) + gc(j,j,n)**2*rr
   20       CONTINUE
   30    CONTINUE
         DO 40 j = 1,nsol
            niw(j) = 0.00
   40    CONTINUE
         DO 60 n = nmatch,nzero - 1
            rr = rc(n)**3
            DO 50 j = 1,nsol
               niw(j) = niw(j) + gc(j,j,n)**2*rr
   50       CONTINUE
   60    CONTINUE
         ratt = pow(it,it)/piw(it,it)
         var(3) = trymix* (now(is)+niw(is)*var(2))/
     +            (now(it)+niw(it)*ratt)
         var(4) = ratt*var(3)/var(2)
      ELSE
         DO 70 iv = 3,4
            err(iv) = 0.00
            errnew(iv) = 0.00
            var(iv) = 0.00
            varnew(iv) = 0.00
            dv(iv) = 0.00
   70    CONTINUE
      END IF
c
      RETURN
      END