(file) Return to invert.f90 CVS log (file) (dir) Up to [Development] / JSOC / proj / vfisv / apps

File: [Development] / JSOC / proj / vfisv / apps / invert.f90 (download)
Revision: 1.8, Tue Apr 10 21:16:49 2012 UTC (11 years, 1 month ago) by keiji
Branch: MAIN
CVS Tags: Ver_LATEST, Ver_9-5, Ver_9-41, Ver_9-4, Ver_9-3, Ver_9-2, Ver_9-1, Ver_9-0, Ver_8-8, Ver_8-7, Ver_8-6, Ver_8-5, Ver_8-4, Ver_8-3, Ver_8-2, Ver_8-12, Ver_8-11, Ver_8-10, Ver_8-1, Ver_8-0, Ver_7-1, Ver_7-0, Ver_6-4, Ver_6-3, Ver_6-2, HEAD
Changes since 1.7: +86 -93 lines
*** empty log message ***

SUBROUTINE INVERT (OBS_LONG,SCAT_LONG,GUESS,RES,ERR, FILTERS_LONG, CONVERGENCE_FLAG, WEIGHTS)
  !
  ! J M Borrero
  ! Dec 16, 2009
  ! HAO-NCAR for HMI-Stanford
  !
  ! By RCE, Apr 21, 2010: Passing FILTERS variable to INVERT to get 
  ! Sebastien's filter profiles. Defining FILTERS variable inside INVERT.
  ! Passing FILTERS to SYNTHESIS module.
  ! Element [0][0] in C corresponds to (1,1) in Fortran. Element [1,25] in 
  ! C corresponds to (26,2) in Fortran; hence exchanging the indices in definition
  ! of variable: FILTERS (NUMW, NBINS)
  !
  ! By RCE, Apr 23, 2010: Changed azimuth reference by 90 degrees at the end (after the inversion loop).
  !
  ! By RCE, Apr 23, 2010: (OBSOLETE, see May 17 2011 comment) Normalize all filters to central filter area hard-coded value:
  ! The integrated areas of the six filters for the central pixel (pixel # 8386559) are:    
  ! 1.43858806880917  1.49139978559615   1.52324167542270  1.52811487224149  1.50984871281028  1.46553486521323
  ! the average area being: 1.49279. We will normalize ALL the filters by this value.
  !
  ! By RCE, Apr 23, 2010: Reverse the wavelength order of the observed Stokes profiles so
  ! that the convention of the filter profiles matches the convention for the observations.
  !
  ! By RCE, Nov 1, 2010: OBSOLETE. See March 2012 comment. 
  ! Changed the convergence criterium to CHI2 .LT. GOODFIT*(ICONT/6.5d4) to scale it to the intensity 
  ! of the pixel with respect to disk center. Disk center value is HARD CODED!!!! (6.5D4)
  ! 
  ! By RCE, Nove 8, 2010:  OBSOLETE: See March 2012 comment.
  ! Changed convergence criterium again. Now, when the NEWCHI2 is an improvement over the old one, 
  ! and the difference between the two is less than GOODFIT, then we stop iterating. This is, when CHI2 doesn't improve
  ! fast enough, we get out of the loop. The absolute check for CHI2 (CHI2 .LT. GOODFIT) has been eliminated because it
  ! wasn't a good measure of convergence.
  ! 
  ! By RCE Feb 2011: Added the weights for the Stokes profiles as an input parameter rather than having them hard-coded
  ! in VFISV. The call to GET_WEIGHTS now just normalizes the weights and multiplies by the noise.
  !
  ! By RCE: Re-normalizing filters to different value to account for +/-2A coverage (OBSOLETE, see May 17 2011 comment)
  !
  ! By RCE April 2011: Included filter hack. FILTERS_LONG are the filters calculated in the full wavelength range.
  ! FILTERS are the filter profiles in the narrow wavelength range, where we do the forward modeling.
  ! We do this to avoid computing the forward model very far into the continuum. It takes too much time. So we do
  ! a quick hack to compute the forward model only in an inner wavelength region and then add the filter contribution 
  ! outside of this region, in the continuum around the spectral line.
  !
  ! By RCE, May 17, 2011: Normalization of filters is now done in the wrapper. 
  ! This way, when we change parameters such as the wavelength range
  ! or the wavelength sampling, the normalization factor is computed for the correct parameters. 
  !
  ! By RCE May 24 2011: Defined the CHANGEVAR_FLAG, that decides whether the variable changes (defined in change_var.f90)
  ! for the inversion become in effect or not. There are IF statements in invert.f90 and the
  ! synthesis that check the flag before doing variable conversion.
  !
  ! By RCE, July 2011: I added a module to the code that performs variable changes/combinations of the model atmosphere.
  ! Instead of inverting for eta0 and DoppWidth, now we invert for eta0 and sqrt(eta0)*DoppWidth.
  ! The routines in the CHANGE_VAR module are called from invert at two different points. First after computing the derivatives. 
  ! The variable change is done for the derivatives. Then the gradient and Hessian are computed in order to obtain the perturbation
  ! to the model. This perturbation is given in the new variables, so we call a routine that undoes the change, so that we can
  ! add the perturbation to the model in order to move on to the next iteration.
  ! CHANGEVAR_FLAG is a flag that allows us to decide whether we want the inversion code to work with the changes or not.
  !
  ! By RCE Jan 2012:
  ! Introducing CHI2 REGULARIZATION: There is a regularization term in chi2. It penalizes chi2 for high values of eta0. We
  ! are using this to get rid of the double minima problem, by which, chi2 showed two minima at very different values of eta0
  ! (one low and one high), that was compensated by other parameters like the field strength and the doppler width.
  ! REGUL_FLAG switches the regularization on (1) and off (0).
  !
  ! By RCE March 2012:
  ! Jesper Schou has changed the convergence criterion and the requirements for random resets of the guess model for the 
  ! inversion of a given pixel. 
  ! Convergence criterion is now based on the LM lambda parameter. In general, if lambda reaches its maximum allowed value
  ! then the inversion will be considered converged. Pixels with high field strength (B>500G) will be forced to go to the maximum
  ! number of iterations, regardless of lambda. However, every time that lambda reaches lambda_max, the high field pixel will
  ! be given a new random initial guess.
  ! There are a number of cases, picked out empirically, that force a re-initialization of the inversion for a given pixel. 
  ! They are mostly related with low inclination magnetic fields (mostly vertical), especially in quiet Sun. 
  ! NOTE: The parametrization of the decision to re-initialize an inversion is very specific to the hmi.S_720s series. If the data 
  ! processing changes (especially if the noise changes), all of the parameters related to the resets will have to be tweaked.

  USE FILT_PARAM
  USE CONS_PARAM
  USE LINE_PARAM
  USE INV_PARAM
  USE INV_UTILS
  USE FORWARD
  USE RAN_MOD
  USE CHANGE_VAR
  IMPLICIT NONE
  !---------------------------------------------------------------------
  REAL(DP), INTENT(IN),  DIMENSION(NBINS*4)          :: OBS_LONG
  REAL(DP), INTENT(IN),  DIMENSION(NBINS*4)          :: SCAT_LONG
  REAL(DP),              DIMENSION(NUMW_LONG, NBINS) :: FILTERS_LONG
  REAL(DP), INTENT(INOUT),  DIMENSION(10)            :: GUESS
  REAL(DP),              DIMENSION(NUMW,NBINS)       :: FILTERS
  REAL(DP), INTENT(OUT), DIMENSION(10)               :: RES
  REAL(DP), INTENT(OUT), DIMENSION(12)               :: ERR

  !---------------------------------------------------------------------
  REAL(DP),        DIMENSION(NBINS,4)   :: OBS, SCAT, OBS_REV
  REAL(DP),        DIMENSION(NBINS)     :: INTEG_FILTERS
  REAL(DP),        DIMENSION(4)         :: WEIGHTS
  REAL(DP),        DIMENSION(10)        :: BESTMODEL, MODELG, LASTGOODMODEL, DMODEL, BESTMINMODEL
  REAL(DP),        DIMENSION(16)        :: SIGMA
  REAL(DP)                              :: BESTCHI2, LASTGOODCHI2, TOTPOL, NEWCHI2, LASTGOODLAMBDA, DELTACHI2, LAMBDAX, BESTMINCHI2
  REAL(DP),        DIMENSION(ITER)      :: LAMBDA, CHI2
  REAL(DP),        ALLOCATABLE          :: HESS(:,:), DIVC(:)
  REAL(DP),        DIMENSION(10,ITER)   :: MODEL
  REAL(DP)                              :: SSUM,SRATIO,BNOISE, B_LOW, B_HIGH, LAMBDA_START, LAMBDA_RESET
  INTEGER                               :: I, J, K, M, NPOINTS
  INTEGER                               :: CONV_FLAG, CONVERGENCE_FLAG, NRESET, CHANGEVAR_FLAG, REGUL_FLAG, RESET_FLAG, DONE, ITSTART, ABANDON, N_ABANDON
  !---------------------------------------------------------------------
  REAL(DP),     DIMENSION(NBINS,4)      :: SYN, LASTGOODSYN, BESTSYN
  REAL(DP),     DIMENSION(10,NBINS,4)   :: DSYN, LASTGOODDSYN
  !---------------------------------------------------------------------
  CHARACTER(LEN=20), PARAMETER :: FMT = '("6f14.10")'
! Some variables for random number initialization
  integer                               :: dt_return(1:8), nseed,clock_count
  integer, dimension(:), allocatable    :: seed


  ! Allocate the Hessian and Divergence matrices
  ALLOCATE(HESS(NUMFREE_PARAM,NUMFREE_PARAM),DIVC(NUMFREE_PARAM))

  ! Re-dimension the observations and scattered ligth 
  CALL SORT_OBS(OBS_LONG,OBS)
  CALL SORT_OBS(SCAT_LONG,SCAT)


  ! --- BEGIN THE WAVELENGTH HACK
  ! By RCE April 2011: Select the region of the spectrum of the filters that we are 
  ! going to use in the synthesis and the region that we are going to integrate 
  ! assuming that they're in the continuum of the spectral line. 
  
  ! Difference between NUMW wavelength points for synthesis and NUMW_LONG points in 
  ! which filters were computed.
  ! We divide by 2 to get the number of wavelength points at each side of the
  ! "synthesis range"

  NPOINTS = (NUMW_LONG - NUMW)/2  
  
  ! Select region of filters corresponding to forward modeling wavelength region
  FILTERS(:,:) = FILTERS_LONG(NPOINTS+1:NUMW+NPOINTS,:) 
  ! Integrate the filters in the remaining regions at each side of the forward
  ! modeling region.
  DO I = 1, NBINS 
     INTEG_FILTERS(I) = SUM(FILTERS_LONG(1:NPOINTS,I)) +  &
          SUM(FILTERS_LONG(NUMW_LONG-NPOINTS+1:,I))
  ENDDO
  ! Making sure we add no filter integral if we're doing the forward modeling in the
  ! full wavelength range.
  IF (NPOINTS .EQ. 0) THEN 
     INTEG_FILTERS(:) = 0D0
  ENDIF
  ! --- END OF WAVELENGTH HACK

  !By RCE, Apr 23, 2010: Reversing the wavelength order of the observations 
  ! so that they are in increasing wavelength order

  DO k=1,NBINS
     DO m = 1,4
        OBS_REV(k,m) = OBS(NBINS-k+1,m)
     ENDDO
  ENDDO
  OBS(:,:) = OBS_REV(:,:)

  ! ----- FLAGS FOR THE CODE
  ! By RCE: 
  ! CONVERGENCE_FLAG is sent out to the wrapper with different values depending 
  !   on whether the algorithm converges or not and why.
  ! CHANGEVAR_FLAG decides whether variable change for inversion is implemented (1) or not (0).
  
  CONVERGENCE_FLAG = 0
  CHANGEVAR_FLAG = 1 ! Use new variables or not
  REGUL_FLAG = 1
  ! ---- END FLAGS

  !--- Iteration and re-initialization control
  ! The following parameters control the iterations, the convergence criterion and 
  ! if and when a pixel is re-setted (inversion re-initialized with different guess model)

  BNOISE=300D0 ! Fields above this are dominated by signal
  N_ABANDON=5 ! Abandon 1st reset if no better than this many iterations.
  DELTACHIMIN=1D-4 ! Min change of chi2 to decrease lambda for.
  LAMBDA_START=0.1D0 ! Initial value of lambda
  LAMBDA_RESET=0.1D0 ! Value of lambda after a reset
  LAMBDA_DOWN=5D0 ! How much to decrease lambda for good guess
  LAMBDA_UP=10D0 ! How much to increase lambda for bad guess
  LAMBDA_MIN=1D-4 ! Min lambda value
  LAMBDA_MAX=100D0 ! Max lambda value (exit criterion)
  

  !--- Get seed for random generator
  ! Both values incement with time, so not entirely independent
  call date_and_time(values=dt_return)
  call system_clock(count=clock_count,count_rate=i,count_max=j)
  
  call random_seed(size=nseed)
  allocate(seed(1:nseed))
  seed(:) = dt_return(8) ! Milliseconds of system clock
  seed(1)=clock_count ! Something to do with time spent


  !---------------------------------------------------------------------------------
  ! This IF statement checks whether the intensity is large enough to invert the data
  ! Otherwise the pixel is ignored. This is used to avoid pixels off-the-limb
  !---------------------------------------------------------------------------------
  IF (ICONT .GT. TREIC) THEN

     CALL GET_TOTPOL(OBS,TOTPOL)
     CALL GET_WEIGHT(OBS,WEIGHTS)
     !----------------------------------------------------
     ! Commented by RCE: 
     ! WFA_GUESS overwrites initial guess for Doppler velocity 
     ! eta0, doppler width, azimuth, source function and gradient.
     !----------------------------------------------------

     CALL WFA_GUESS(OBS/ICONT,LANDA0,GUESS(7), GUESS(3), GUESS(1), GUESS(5), GUESS(8), GUESS(9))

     ! Initialization of non-free parameters
     IF (FREE(4).EQ..FALSE.) GUESS(4)=0.5D0
     IF (FREE(10).EQ..FALSE.) GUESS(10)=1D0

     CALL FINE_TUNE_MODEL(GUESS)

     MODEL(:,1)=GUESS
     BESTMODEL(:)=GUESS

     ! By RCE: Weird default values for lambda and chi2 so that I can find out
     ! when they are not being updated.
     LAMBDA(:) = 33.3333
     CHI2(:) = 33.3333333
     LASTGOODCHI2=1E24
     LAMBDA(1)=LAMBDA_START
     BESTCHI2=1E24 ! Best chi2 ever seen
     BESTMINCHI2=1E24 ! Best value actually converged
     BESTMINMODEL=1E24 ! Best model actually converged
     ITSTART=1 ! Start of current iteration

     I=1

     ! Counter for the number of random resets that the model parameters suffer.
     ! RESET_FLAG to flag when the inversion of a pixel needs to be resetted.
     ! DONE flags the exit criterion for the main loop.
     NRESET=0
     RESET_FLAG=0
     DONE=0

     !-----------------------------
     ! Start LOOP iteration
     !-----------------------------
     DO WHILE ((I.LT.ITER).and.(DONE.EQ.0))

        ! Restart with new guess?
        IF (RESET_FLAG.ne.0) THEN
           BESTMINCHI2=BESTCHI2 ! Save current best chi2
           BESTMINMODEL=BESTMODEL ! Save current best chi2
           ITSTART=I ! Remember where we started
           MODELG=BESTMODEL
           CALL RANDOM_MODEL_JUMP(MODELG)
           if (mod(nreset,2).eq.0) then ! Do clever resets every other time.
              if (bestmodel(6).ge.BNOISE) then
                 modelg=bestmodel
                 if (bestmodel(6).gt.1000) then
                    modelg(1)=50
                    modelg(5)=12
                 else
                    if (mod(nreset,4).eq.2) then
                       modelg(1)=10
                       modelg(5)=7
                       sratio=.2
                    else
                       modelg(1)=9
                       modelg(5)=30
                       sratio=1
                    endif
                    ssum=bestmodel(8)+bestmodel(9)
                    modelg(8)=ssum*sratio/(1+sratio)
                    modelg(9)=ssum/(1+sratio)
                 endif
              endif
              if (BESTMODEL(6).lt.BNOISE) then
                 modelg=bestmodel
                 modelg(1)=8
                 modelg(5)=0.75*bestmodel(5)
                 modelg(6)=85
! Predict S0/S1 from Doppler width. Maintain S0+S1
                 ssum=bestmodel(8)+bestmodel(9)
                 sratio=0.017*bestmodel(5)
                 modelg(8)=ssum*sratio/(1+sratio)
                 modelg(9)=ssum/(1+sratio)
              endif
           endif

           CALL FINE_TUNE_MODEL(MODELG)
           MODEL(:,I)=MODELG
           LASTGOODMODEL=MODEL(:,I)
           LASTGOODCHI2=1E24
           LAMBDA(I)=LAMBDA_RESET
           NRESET = NRESET+1
        ENDIF

        !--- Get chi2 only, see if it is better and only calculate derivatives if it is.
        CALL SYNTHESIS(MODEL(:,I),SCAT,.FALSE.,SYN,DSYN, FILTERS, INTEG_FILTERS)
        CALL GET_CHI2(MODEL(:,I),SYN,OBS,WEIGHTS,REGUL_FLAG,NEWCHI2)
        ! Checking for NAN in NEWCHI2
        IF (NEWCHI2.EQ.NEWCHI2+1D0) THEN
           PRINT*,'NaN detected in Subroutine GETCHI2'
           NEWCHI2=2*LASTGOODCHI2
        ENDIF
        CHI2(I)=NEWCHI2
        DELTACHI2=LASTGOODCHI2-NEWCHI2  ! change in chi2

        IF (DELTACHI2.GE.0.0) THEN ! ---- Things got better
           ! Get synthetic profiles and derivatives
           CALL SYNTHESIS(MODEL(:,I),SCAT,.TRUE.,SYN,DSYN, FILTERS, INTEG_FILTERS)
           !--------------------------------------------
           ! Calling change of variables for derivatives
           !--------------------------------------------
           IF (CHANGEVAR_FLAG .EQ. 1) THEN
              CALL DO_CHANGE_DER(MODEL(:,I), DSYN)    
           ENDIF
           ! From now on, the derivatives correspond to the changed variable ones.
           ! Normalizing Derivatives
           CALL NORMALIZE_DSYN(DSYN)
           ! Set to Zero unneeded derivatives
           CALL ZERO_DSYN(DSYN)
           
           LASTGOODLAMBDA=LAMBDA(I)
           LASTGOODMODEL=MODEL(:,I)
           LASTGOODCHI2=NEWCHI2
           LASTGOODSYN=SYN
           LASTGOODDSYN=DSYN

           IF (NEWCHI2.LT.BESTCHI2) THEN
              BESTMODEL=MODEL(:,I)
              BESTCHI2=NEWCHI2
              BESTSYN=SYN
           ENDIF

        ELSE !---- Things did not get better
           SYN=LASTGOODSYN
           DSYN=LASTGOODDSYN
           MODEL(:,I)=LASTGOODMODEL
        ENDIF

        ! Levenberg-Marquardt lambda factor
        CALL GET_LAMBDA(DELTACHI2,LAMBDA(I),LAMBDA(I+1))

        ! Getting Divergence and Hessian.
        CALL GET_DIVC(LASTGOODSYN,OBS,LASTGOODDSYN,WEIGHTS,DIVC)
        CALL GET_HESS(LASTGOODDSYN,WEIGHTS,HESS)

        ! Get perturbations to old model
        CALL GET_DMODEL(LASTGOODMODEL, REGUL_FLAG, DIVC, HESS, LAMBDA(I+1), DMODEL, CONV_FLAG)
        ! Ignore CONV_FLAG and rely on DMODEL set to zero/LAMBDA increase.

        ! Normalizing, trimming and tuning DMODEL
        ! Undoing variable change to obtain the perturbations to
        ! the original model parameters. Overwriting DMODEL!
        CALL NORMALIZE_DMODEL(DMODEL)
        IF (CHANGEVAR_FLAG .EQ. 1) THEN
           CALL UNDO_CHANGE_DMODEL_FINITE(MODEL(:,I),DMODEL)   
        ENDIF
        CALL CUT_DMODEL(DMODEL,MODEL)
        MODEL(:,I+1)=LASTGOODMODEL+DMODEL
        CALL FINE_TUNE_MODEL(MODEL(:,I+1))

        !---- Decision making:
        !     Have we converged?
        !     Do we need to try a new initial guess for this pixel?
        !     Do we just carry on with the iterations?

        DONE=0
        RESET_FLAG=0
        ABANDON=0
        if ((nreset.eq.1).and.((i-itstart).ge.N_ABANDON).and.((lastgoodchi2-bestminchi2).gt.0).and.(bestmodel(6).lt.BNOISE)) ABANDON=1 ! Restart is not getting better.
        if ((LAMBDA(I+1).GE.LAMBDA_MAX).or.(ABANDON.ne.0)) then ! We are done with this round.

           ! Test if reset is desired.
           IF (NRESET .EQ. 0) THEN ! Only one reset allowed for the following cases
              if (BESTMODEL(6).lt.30) RESET_FLAG=1 ! Low field
              if (BESTMODEL(6).gt.BNOISE) RESET_FLAG=1 ! High field
              if (BESTCHI2.gt.20.00) RESET_FLAG=1
              if ((BESTCHI2.gt.2.75).and.(BESTMODEL(6).lt.70).and.(BESTMODEL(5).lt.15)) RESET_FLAG=1 ! A few really bad points
              if (abs(BESTMODEL(2)-90).gt.(10*log(BESTMODEL(6)/7))) RESET_FLAG=1 ! A stab at high incl points
              if ((BESTMODEL(1).lt.5).and.(BESTMODEL(5).gt.20).and.(BESTMODEL(6).lt.BNOISE)) RESET_FLAG=2
           ENDIF
              
           B_LOW=35D0-nreset
           B_HIGH=500D0
           if (abs(BESTMODEL(2)-90).gt.60) RESET_FLAG=1 ! Inclination spike
           if (BESTMODEL(6).lt.B_LOW) RESET_FLAG=1 ! Low field
           if (BESTMODEL(6).gt.B_HIGH) RESET_FLAG=1 ! High field
           if ((BESTMODEL(1).lt.3.5).and.(BESTMODEL(5).gt.30).and.(BESTMODEL(6).lt.45)) RESET_FLAG=2

           if (RESET_FLAG.EQ.0) DONE=1 ! No resets desired
        endif

        I=I+1
     ENDDO ! Main iteration loop

     ! Get errors
     IF (BESTCHI2.gt.1d20) THEN
        CONVERGENCE_FLAG = 4 ! Set flag and give up
     ELSE
       
        ! We compute the derivatives with the best model parameters (without
        ! doing the change of variable afterwards), and we compute the Hessian
        ! and the errors from there.
        
        ! Recalculate chi2 and derivatives. No regularization.
        ! JS: Not clear why NEWCHI2 is recalculated.
        CALL GET_CHI2(BESTMODEL,BESTSYN,OBS,WEIGHTS,0,NEWCHI2)
        CALL SYNTHESIS(BESTMODEL,SCAT,.TRUE.,SYN,LASTGOODDSYN, FILTERS, INTEG_FILTERS)

        CALL NORMALIZE_DSYN(LASTGOODDSYN)

        ! Compute Hessian
        Call GET_HESS(LASTGOODDSYN,WEIGHTS,HESS)
        ! This Hessian is constructed with normalized derivatives
        CALL GET_ERR(HESS, BESTCHI2,SIGMA,CONV_FLAG)

        if (CONV_FLAG.NE.0) CONVERGENCE_FLAG = 5 ! ERROR in SVD: Set flag, otherwise proceed.

        ERR(1)=SIGMA(6)  ! Bfield
        ERR(2)=SIGMA(2)  ! Gamma
        ERR(3)=SIGMA(3)  ! Phi
        ERR(4)=SIGMA(7)  ! VLOS
        ERR(5)=SIGMA(10) ! Alpha_mag
        ERR(6)=SIGMA(11) ! Bfield-Gamma
        ERR(7)=SIGMA(12) ! Bfield-Phi
        ERR(8)=SIGMA(13) ! Gamma-Phi
        ERR(9)=SIGMA(14) ! Bfield-Alpha
        ERR(10)=SIGMA(15)! Gamma-Alpha
        ERR(11)=SIGMA(16)! Phi-Alpha
        ERR(12)=BESTCHI2 ! Bestchi2

        ! Final Result
        RES=BESTMODEL
        
        ! By RCE, Apr 23, 2010: Juanma's correction to azimuth (which is
        ! rotated by 90 degrees with respect to the convention people want).
        RES(3) = RES(3) + 90D0
        IF (RES(3) .GT. 180D0) RES(3) = RES(3) - 180D0

        IF ((I .EQ. ITER).and.(NRESET.eq.0)) THEN 
           CONVERGENCE_FLAG = 2 ! Not converged
        ELSE
           CONVERGENCE_FLAG = 0 ! Found at least one local minimum.
        ENDIF
     ENDIF ! Decent chisq

  ELSE ! Intensity too low to invert
     CONVERGENCE_FLAG = 1
  ENDIF

! CONVERGENCE_FLAG values
!    0: Converged!
!    1: Pixel not inverted due to ICONT LT threshold intensity.
!    2: Maximum number of iterations reached without convergence.
!    4: Never got decent chisq.
!    5: Could not get errors.

  DEALLOCATE(HESS, DIVC)

END SUBROUTINE INVERT


! subroutines added by K.H.
! consolidate (some of) allocate arrays 
SUBROUTINE VFISVALLOC(NUM_LAMBDA_FILTER, NUM_LAMBDA_LONG, NUM_LAMBDA)
  USE FILT_PARAM
  USE LINE_PARAM
  USE CONS_PARAM
  USE INV_PARAM
  IMPLICIT NONE
  INTEGER,  INTENT(IN)           :: NUM_LAMBDA_FILTER, NUM_LAMBDA_LONG, NUM_LAMBDA
  
  NUMW_LONG = NUM_LAMBDA_LONG
  NBINS = NUM_LAMBDA_FILTER
  ALLOCATE (FILTER(NUMW,NBINS),TUNEPOS(NBINS))

  NUMW=NUM_LAMBDA
  ALLOCATE (WAVE(NUMW))
     
END SUBROUTINE VFISVALLOC

!CVSVERSIONINFO "$Id: invert.f90,v 1.8 2012/04/10 22:16:49 keiji Exp $"

Karen Tian
Powered by
ViewCVS 0.9.4