Line data    Source code

       1             : MODULE m_nwrfst
       2             : 
       3             :    CONTAINS
       4             :    
       5          36 :    SUBROUTINE nwrfst(mrad,nsol,is,it,nmatch,nzero,ferro,ec,rc,pow,piw,gc,err,var,dv,varnew,errnew)
       6             : 
       7             : !..........................................................nwrfst
       8             : ! starting values for E, A, A_out, A_inw
       9             : !
      10             :       IMPLICIT NONE
      11             : 
      12             :       INTEGER, INTENT (IN) :: mrad
      13             :       INTEGER, INTENT (IN) :: is, it, nmatch, nsol, nzero
      14             :       LOGICAL, INTENT (IN) :: ferro
      15             :       REAL, INTENT    (IN) :: ec
      16             : 
      17             :       REAL, INTENT (INOUT) :: dv(4), err(4), errnew(4), var(4), varnew(4)
      18             :       REAL, INTENT (IN)    :: gc(2,2,mrad), piw(2,2), pow(2,2), rc(mrad)
      19             : 
      20             : 
      21             :       REAL ratt, rr, trymix
      22             :       INTEGER iv, j, n
      23             : 
      24             :       REAL niw(2), now(2)
      25             : 
      26          36 :       trymix = 0.010
      27             : 
      28             : !                                      --------------------
      29             : !                                       START VALUES FOR
      30             : !                                           PARAMETERS
      31             : !                                      --------------------
      32          36 :       var(1) = ec
      33          36 :       var(2) = pow(is,is)/piw(is,is)
      34             : 
      35          36 :       IF ((nsol.EQ.2) .AND. ferro) THEN
      36          48 :          DO j = 1,nsol
      37          48 :             now(j) = 0.00
      38             :          END DO
      39        8096 :          DO n = 1,nmatch - 1
      40        8080 :             rr = rc(n)**3
      41       24256 :             DO j = 1,nsol
      42       24240 :                now(j) = now(j) + gc(j,j,n)**2*rr
      43             :             END DO
      44             :          END DO
      45          48 :          DO j = 1,nsol
      46          48 :             niw(j) = 0.00
      47             :          END DO
      48        1216 :          DO n = nmatch,nzero - 1
      49        1200 :             rr = rc(n)**3
      50        3616 :             DO j = 1,nsol
      51        3600 :                niw(j) = niw(j) + gc(j,j,n)**2*rr
      52             :             END DO
      53             :          END DO
      54          16 :          ratt = pow(it,it)/piw(it,it)
      55          16 :          var(3) = trymix * (now(is)+niw(is)*var(2)) / (now(it)+niw(it)*ratt)
      56          16 :          var(4) = ratt * var(3) / var(2)
      57             :       ELSE
      58          60 :          DO iv = 3,4
      59          40 :             err(iv) = 0.00
      60          40 :             errnew(iv) = 0.00
      61          40 :             var(iv) = 0.00
      62          40 :             varnew(iv) = 0.00
      63          60 :             dv(iv) = 0.00
      64             :          END DO
      65             :       END IF
      66             : 
      67          36 :    END SUBROUTINE nwrfst
      68             :       
      69             : END MODULE m_nwrfst