fixed logical bugs in initialising params

Annie Hughes
1 parent 08e3260e
Showing 3 changed files with 210 additions and 115 deletions Show diff stats
src/idl/dustem_init_fixed_params.pro
src/idl/dustem_init_params.pro
src/idl/dustem_init_parinfo.pro
-PRO dustem_init_fixed_params,fpd,fiv,help=help
+PRO dustem_init_fixed_params,fpd,fiv,help=help,clear=clear
  
 ;+
 ; NAME:
@@ -28,6 +28,7 @@ PRO dustem_init_fixed_params,fpd,fiv,help=help
 ;
 ; ACCEPTED KEY-WORDS:
 ;    help      = if set, print this help
+;    clear     = if set, clear all existing fixed parameters
 ;
 ; COMMON BLOCKS:
 ;    None
@@ -57,9 +58,16 @@ IF keyword_set(help) THEN BEGIN
   goto,the_end
 END
  
+if keyword_set(clear) then begin
+;   message,'Clearing the fixed parameters',/info
+;   stop
+   (*!dustem_fit).fixed_param_descs=ptr_new()
+   (*!dustem_fit).fixed_param_init_values=ptr_new()
+  goto,the_end
+end
+
 ;Save the values of fit parameter descriptions and values
 need_save=0
-
 ;This routine will use (*!dustem_fit).param_descs)
 ;Therefore, if the variable already exists, its content is saved, and will be put back in place later
 IF ptr_valid((*!dustem_fit).param_descs) THEN BEGIN
@@ -69,7 +77,8 @@ IF ptr_valid((*!dustem_fit).param_descs) THEN BEGIN
   need_save=1
 ENDIF
  
-;temporarily use the regular parameter system variables to update
+;TEMPORARILY put FPD and FIV into the regular parameter system
+;variables. This allows us to the use the dustem_set_params routine
 (*!dustem_fit).param_descs=ptr_new(fpd)
 (*!dustem_fit).param_init_values=ptr_new(fiv)
 ;Trimmed JPB on 08 March 2024
@@ -77,9 +86,8 @@ ENDIF
 ind=where(fpd NE '',count)
  
 ;fixing the parameters
-IF count NE 0 THEN BEGIN
+IF count NE 0 THEN $
   dustem_set_params,[fiv]
-ENDIF
  
 ;set the fixed system variables, used to keep memory of the fixed
 ;parameters description and values
@@ -92,6 +100,11 @@ IF need_save EQ 1 THEN BEGIN
   (*!dustem_fit).param_init_values=ptr_new(iv)
   ;(*!dustem_fit).param_func=ptr_new(find)
 ENDIF 
+IF need_save EQ 0 THEN BEGIN
+  (*!dustem_fit).param_descs=ptr_new()
+  (*!dustem_fit).param_init_values=ptr_new()
+  ;(*!dustem_fit).param_func=ptr_new(find)
+ENDIF 
  
 the_end:
 END
@@ -4,7 +4,9 @@ PRO dustem_init_params,model,pd,iv, $
                        ,tied=tied,fixed=fixed $
                        ,polarization=polarization $
                        ,no_reset_plugin_structure=no_reset_plugin_structure $
-                       ,force_reset=force_reset
+                       ,force_reset=force_reset $
+                       ,help=help,debug=debug
+
 ;+
 ; NAME:
 ;    dustem_init_params
@@ -184,148 +186,217 @@ if keyword_set(polarization) and polexists eq 0 then $
 ; basic sanity checking of PLUGINS
 ; to be written
  
-;== PLAY NICE -- check what already exists in the parameter structure
-defsysv,'!dustem_parinfo',exists=par_status
+; first decide what needs to be done
+fpar_status=ptr_valid((*!dustem_fit).fixed_param_descs)
+par_status=ptr_valid((*!dustem_fit).param_descs)
+fpd_set = keyword_set(fpd)
+pd_set = keyword_set(pd)
  
-if keyword_set(force_reset) and !dustem_verbose NE 0 then $
-   message, 'Reinitialising all previous parameter options (FORCE_RESET=1)',/info
+old_pd=[] & old_iv=[] & old_parinfo=[]
+old_ulimed=[] & old_llimed=[] & old_ulims=[] & old_llims=[]
+old_fixed=[] & old_tied=[]
+nold=0.
  
-if par_status eq 0 and !dustem_verbose NE 0 then $
-   message, 'No existing parameters found',/info
+new_pd=[] & new_iv=[] & new_parinfo=[]
+new_ulimed=[] & new_llimed=[] & new_ulims=[] & new_llims=[]
+new_fixed=[] & new_tied=[]
+nnew=0.
  
-if par_status eq 1 and not keyword_set(force_reset) then begin
-   if  !dustem_verbose NE 0 then message,'Updating/adding model parameters',/info
-   new_pd=pd & new_iv=iv & nnewpars=n_elements(new_pd)
-   new_ulimed=intarr(nnewpars)
-   new_llimed=intarr(nnewpars)
-   new_ulims=intarr(nnewpars)
-   new_llims=intarr(nnewpars)
-   new_fixed=intarr(nnewpars)
-   new_tied=intarr(nnewpars)
-   if keyword_set(ulimed) then new_ulimed=ulimed
-   if keyword_set(llimed) then new_llimed=llimed
-   if keyword_set(ulims) then new_ulims=ulims
-   if keyword_set(llims) then new_llims=llims
-   if keyword_set(fixed) then new_fixed=fixed
-   if keyword_set(tied) then new_tied=tied
+old_fpd=[] & old_fiv=[]
+nold_fixed=0.
  
+new_fpd=[] & new_fiv=[]
+nnew_fixed=0.
+
+if fpar_status eq 1 then begin
+   old_fpd=(*(*!dustem_fit).fixed_param_descs)
+   old_fiv=(*(*!dustem_fit).fixed_param_init_values)
+   nold_fixed=n_elements(old_fpd)
+end
+
+if par_status eq 1 then begin
    old_pd=(*(*!dustem_fit).param_descs)
    old_iv=(*(*!dustem_fit).param_init_values)
+   nold=n_elements(old_pd)
    old_parinfo=*!dustem_parinfo
    old_fixed=old_parinfo.fixed
    old_tied=old_parinfo.tied
    noldpars=n_elements(old_parinfo)
-   old_ulimed=intarr(noldpars)
-   old_llimed=intarr(noldpars)
-   old_ulims=fltarr(noldpars)
-   old_llims=fltarr(noldpars)
-   for i=0,noldpars-1 do begin
+   old_ulimed=intarr(nold)
+   old_llimed=intarr(nold)
+   old_ulims=fltarr(nold)
+   old_llims=fltarr(nold)
+   for i=0,nold-1 do begin
       old_ulimed[i]=old_parinfo[i].limited[1]
       old_llimed[i]=old_parinfo[i].limited[0]
       old_ulims[i]=(old_parinfo[i].limits[1])*old_iv[i]
       old_llims[i]=(old_parinfo[i].limits[0])*old_iv[i]
    endfor
-   ; check for duplicates 
-   noldpars=n_elements(old_pd)
-   match,strupcase(new_pd),strupcase(old_pd),a,b,count=ndups
-   if ndups gt noldpars then begin
-      message, 'Number of duplicates exceeds number of existing parameters. This should not happen ?'/info
-      stop
-   endif
-   if ndups gt 0 and ndups le noldpars then begin
-      if  !dustem_verbose NE 0 then begin
+end
+
+if pd_set eq 1 then begin
+   new_pd=pd & new_iv=iv & nnew=n_elements(new_pd)
+   new_ulimed=intarr(nnew)
+   new_llimed=intarr(nnew)
+   new_ulims=intarr(nnew)
+   new_llims=intarr(nnew)
+   new_fixed=intarr(nnew)
+   new_tied=intarr(nnew)
+   if keyword_set(ulimed) then new_ulimed=ulimed
+   if keyword_set(llimed) then new_llimed=llimed
+   if keyword_set(ulims) then new_ulims=ulims
+   if keyword_set(llims) then new_llims=llims
+   if keyword_set(fixed) then new_fixed=fixed
+   if keyword_set(tied) then new_tied=tied
+end
+
+if fpd_set eq 1 then begin
+   new_fpd=fpd & new_fiv=fiv & nnew_fixed=n_elements(new_fpd)
+end
+
+if keyword_set(force_reset) then goto, initialise
+
+if pd_set eq 1 then begin
+   if par_status eq 1 then begin
+      match,strupcase(new_pd),strupcase(old_pd),a,b,count=ndups
+      if ndups gt nold then begin
+         message, 'Number of duplicates exceeds number of existing free parameters. This should not happen ?'/info
+         stop
+      end else if ndups eq 0 then begin
+         message,'No duplicate free parameters found...',/info
+      end else if ndups eq nold then begin
+         message,'Updating all old values of free parameters...',/info
+         old_pd=[]
+         old_iv=[]
+         old_parinfo=[]
+         old_ulimed=[]
+         old_llimed=[]
+         old_ulims=[]
+         old_llims=[]
+         old_fixed=[]
+         old_tied=[]
+      end else if ndups gt 0 and ndups lt nold then begin
          message,string(ndups)+' matching parameters found. Updating values...',/info
          for i=0,ndups-1 do print,old_pd[b[i]]
-      end
-      remove,b,old_pd
-      remove,b,old_iv
-      remove,b,old_parinfo
-      remove,b,old_ulimed
-      remove,b,old_llimed
-      remove,b,old_ulims
-      remove,b,old_llims
-      remove,b,old_fixed
-      remove,b,old_tied
+         remove,b,old_pd
+         remove,b,old_iv
+         remove,b,old_parinfo
+         remove,b,old_ulimed
+         remove,b,old_llimed
+         remove,b,old_ulims
+         remove,b,old_llims
+         remove,b,old_fixed
+         remove,b,old_tied
+      endif
    endif
-   ;merge the structures
-   pd=[new_pd,old_pd]
-   iv=[new_iv,old_iv]
-   ulimed=[new_ulimed,old_ulimed]
-   llimed=[new_llimed,old_llimed]
-   ulims=[new_ulims,old_ulims]
-   llims=[new_llims,old_llims]
-   fixed=[new_fixed,old_fixed]
-   tied=[new_tied,old_tied]
-endif
  
+   if fpar_status eq 1 then begin
+      match,strupcase(new_pd),strupcase(old_fpd),a,b,count=ndups
+      if ndups gt nold_fixed then begin
+         message, 'Number of duplicates exceeds number of existing fixed parameters. This should not happen ?'/info
+         stop
+      end else if ndups eq 0 then begin
+         message,'No duplicate free parameters found in old fixed params...',/info
+      end else if ndups eq nold_fixed then begin
+         message,'Updating all old values of fixed parameters found in new free params...',/info
+         old_fpd=[]
+         old_fiv=[]
+      end else if ndups gt 0 and ndups lt nold_fixed then begin
+         message,string(ndups)+' matching fixed parameters found. Updating values...',/info
+         for i=0,ndups-1 do print,old_fpd[b[i]]
+         remove,b,old_fpd
+         remove,b,old_fiv
+      endif
+   endif
+endif
  
-;; stop
-;; message,'line 262',/info
-;; if ptr_valid((*!dustem_fit).param_descs) then print,(*(*!dustem_fit).param_descs)
-;; if ptr_valid((*!dustem_fit).fixed_param_descs) then print,(*(*!dustem_fit).fixed_param_descs)
-;; stop
+if fpd_set eq 1 then begin
+   if par_status eq 1 then begin
+      match,strupcase(new_fpd),strupcase(old_pd),a,b,count=ndups
+      if ndups gt nold then begin
+         message, 'Number of duplicates exceeds number of existing fixed parameters. This should not happen ?'/info
+         stop
+      end else if ndups eq 0 then begin
+         message,'No duplicate fixed parameters found  in old free params...',/info
+      end else if ndups eq nold then begin
+         message,'Updating all old values of free parameters found in fixed params...',/info
+         old_pd=[]
+         old_iv=[]
+         old_parinfo=[]
+         old_ulimed=[]
+         old_llimed=[]
+         old_ulims=[]
+         old_llims=[]
+         old_fixed=[]
+         old_tied=[]
+      end else if ndups gt 0 and ndups lt nold then begin
+         message,string(ndups)+' matching parameters found. Updating values...',/info
+         for i=0,ndups-1 do print,old_pd[b[i]]
+         remove,b,old_pd
+         remove,b,old_iv
+         remove,b,old_parinfo
+         remove,b,old_ulimed
+         remove,b,old_llimed
+         remove,b,old_ulims
+         remove,b,old_llims
+         remove,b,old_fixed
+         remove,b,old_tied
+      endif
+   endif
  
-;== INITIALIZE DUST MODEL PARAMETERS and PLUGIN FREE PARAMETERS
-dustem_init_parinfo,pd,iv,up_limited=ulimed,lo_limited=llimed,up_limits=ulims,lo_limits=llims,fixed=fixed,tied=tied
-
-;; stop
-;; message,'line 271',/info
-;; if ptr_valid((*!dustem_fit).param_descs) then print,(*(*!dustem_fit).param_descs)
-;; if ptr_valid((*!dustem_fit).fixed_param_descs) then print,(*(*!dustem_fit).fixed_param_descs)
-;; stop
-
-;== Initialize ANY FIXED PARAMETERS FOR DUST MODEL AND PLUGINS
-IF keyword_set(fpd) THEN BEGIN
-;== PLAY NICE -- check what already exists in the fixed parameter structure
-   fpar_status=ptr_valid((*!dustem_fit).fixed_param_descs)
-   
-   if keyword_set(force_reset) and  !dustem_verbose NE 0 then $
-      message, 'Reinitialising all previous fixed parameter options (FORCE_RESET=1)',/info
-   
-   if fpar_status eq 0  and  !dustem_verbose NE 0 then $
-      message, 'No existing fixed parameters found',/info
-
-   if fpar_status eq 1 and not keyword_set(force_reset) then begin
-      if  !dustem_verbose NE 0 then message,'Updating/adding fixed parameters',/info
-      new_fpd=fpd & new_fiv=fiv & nnewfixed=n_elements(new_fpd)
-      
-      old_fpd=(*(*!dustem_fit).fixed_param_descs)
-      old_fiv=(*(*!dustem_fit).fixed_param_init_values)
-      noldfixed=n_elements(old_fpd)
-      
+   if fpar_status eq 1 then begin
       match,strupcase(new_fpd),strupcase(old_fpd),a,b,count=ndups
-      if ndups gt noldfixed then begin
-         message, 'Number of duplicates exceeds number of fixed parameters. This should not happen ?'/info
+      if ndups gt nold_fixed then begin
+         message, 'Number of duplicates exceeds number of existing fixed parameters. This should not happen ?'/info
          stop
-      endif
-      if ndups gt 0 and ndups le noldfixed then begin
-         if  !dustem_verbose NE 0 then message,string(ndups)+' matching fixed parameters found. Updating values for '+old_fpd[b],/info
+      end else if ndups eq 0 then begin
+         message,'No duplicate fixed parameters found in old fixed params...',/info
+      end else if ndups eq nold_fixed then begin
+         message,'Updating all old values of fixed parameters...',/info
+         old_fpd=[]
+         old_fiv=[]
+      end else if ndups gt 0 and ndups lt nold_fixed then begin
+         message,string(ndups)+' matching fixed parameters found. Updating values...',/info
+         for i=0,ndups-1 do print,old_fpd[b[i]]
          remove,b,old_fpd
          remove,b,old_fiv
       endif
-      fpd=[new_fpd,old_fpd]
-      fiv=[new_fiv,old_fiv]
    endif
-   dustem_init_fixed_params,fpd,fiv
-ENDIF
-;; stop
-;; message,'line 312',/info
-;; if ptr_valid((*!dustem_fit).param_descs) then print,(*(*!dustem_fit).param_descs)
-;; if ptr_valid((*!dustem_fit).fixed_param_descs) then print,(*(*!dustem_fit).fixed_param_descs)
-;; stop
+endif
+
+;merge the pd structures
+pd=[new_pd,old_pd]
+iv=[new_iv,old_iv]
+ulimed=[new_ulimed,old_ulimed]
+llimed=[new_llimed,old_llimed]
+ulims=[new_ulims,old_ulims]
+llims=[new_llims,old_llims]
+fixed=[new_fixed,old_fixed]
+tied=[new_tied,old_tied]
+
+fpd=[new_fpd,old_fpd]
+fiv=[new_fiv,old_fiv]
+
+initialise:
+;== INITIALIZE DUST MODEL PARAMETERS and PLUGIN FREE PARAMETERS
+; currently this works without checking if PD is non-NULL because we
+; require there alway to be a PD vector... one day we should change this
+npd=n_elements(pd) & nfpd=n_elements(fpd)
+
+if npd ge 1 then dustem_init_parinfo,pd,iv,up_limited=ulimed,lo_limited=llimed,up_limits=ulims,lo_limits=llims,fixed=fixed,tied=tied
+if npd eq 0 and nold gt 0 then $
+   dustem_init_parinfo,pd,iv,/clear
+
+if nfpd ge 1 then dustem_init_fixed_params,fpd,fiv
+if nfpd eq 0 and nold_fixed gt 0 then $
+   dustem_init_fixed_params,fpd,fiv,/clear
  
 ;== INITIALIZE ANY PLUGINS
 IF not keyword_set(no_reset_plugin_structure) THEN BEGIN
    dustem_init_plugins,pd,fpd=fpd
 ENDIF
-;; stop
-;; message,'line 322',/info
-;; if ptr_valid((*!dustem_fit).param_descs) then print,(*(*!dustem_fit).param_descs)
-;; if ptr_valid((*!dustem_fit).fixed_param_descs) then print,(*(*!dustem_fit).fixed_param_descs)
-;; stop
  
 if !dustem_verbose NE 0 then message,'Finished initializing free and fixed parameters of dust model and plugins',/info
-;;stop
  
 the_end:
  
 PRO dustem_init_parinfo,pd,iv, $
                         fixed=fixed,tied=tied, $
                         up_limited=up_limited,lo_limited=lo_limited,up_limits=up_limits,lo_limits=lo_limits, $
-                        relstep=relstep,step=step
+                        relstep=relstep,step=step, $
+                        clear=clear
  
 ;+
 ; NAME:
@@ -48,6 +49,16 @@ IF keyword_set(help) THEN BEGIN
   goto,the_end
 END
  
+if keyword_set(clear) then begin
+   message,'Normally you should never get here before we overhaul the parameter description structure',/info
+   stop
+   (*!dustem_fit).param_descs=ptr_new()
+   (*!dustem_fit).param_init_values=ptr_new()
+   (*!dustem_fit).current_param_values = ptr_new()  
+   defsysv,'!dustem_parinfo',ptr_new()
+   goto, the_end
+end
+
  
 (*!dustem_fit).param_descs=ptr_new(pd)