dustem_set_func_ind.pro
4.65 KB
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
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
PRO dustem_set_func_ind,pd,iv
;REM: iv not necessary when ionfrac/isrf not there
;This program used to be called dustem_sort_params
;+
; NAME:
; dustem_set_func_ind
; CALLING SEQUENCE:
; dustem_set_func_ind
; PURPOSE:
; Sorts the parameter descriptions and values the way they must
; be processed.
; INPUTS:
; None
; OPTIONAL INPUT:
; None
; OUTPUTS:
; None
; PROCEDURE AND SUBROUTINE USED
; Parameter description (!param_desc) and values (!init_value) are
; ordered the way they should be processed. The ordered information
; is put into system variables !PDO and !IDO respectively
; If the isrf is being modified, then, PAH ionization fraction
; is set to be updated as well.
; SIDE EFFECTS:
; !PDO and !IDO variables are set.
; Optionally !ionfrac is set.
; The !func_ind variable is set.
; MODIFICATION HISTORY:
; See cvs logs
; Written by NF,JPB,DP Jan-2007
;-
;nparam = n_elements(*(*!dustem_fit).param_descs)
;replacing by this because sometimes we need the param_descs vector to be different
nparam = n_elements(pd)
;!func_ind=ptr_new(fltarr(nparam))
;SORT THE PARAMETERS
;ord = sort(*(*!dustem_fit).param_descs)
;!PDO = ptr_new((*(*!dustem_fit).param_descs)(ord)) ;param_desc ordered (PDO)
;!IDO = ptr_new((*(*!dustem_fit).param_init_values)(ord)) ;init_desc ordered (IDO)
;Do NOT order the parameters
;PDO = ptr_new((*(*!dustem_fit).param_descs)) ;param_desc ordered (PDO)
;IDO = ptr_new((*(*!dustem_fit).param_init_values)) ;init_desc ordered (IDO)
PDO = ptr_new(pd) ;param_desc ordered (PDO)
IDO = ptr_new(iv) ;init_desc ordered (IDO)
;==== DEAL WITH THE ISRF<->IONFRAC DEPENDENCY
fct = strarr(nparam)
;YOU MIGHT USE THESE VARIABLE IN UPCOMING PROCEDURES
;fcte = strarr(nparam) ;my own var
;undscind = strarr(nparam) ;an array containing the index of the last underscore before the key 'keywords' so that we can obtain the name of the plugin
;==== TEST TO FIND THE INDEX OF THE UNDERSCORE AFTER THE PLUGIN NAME
;!!!!!!!!commenting this for now!!!!!!!!
;FOR i=0L,nparam-1 DO BEGIN
;fcte[i] = strmid((*PDO)[i],14,strlen((*PDO)[i])) ; an example is 'stellar_population_o11' (form 'dustem_create_stellar_population_o11') for the radius (2 for the temperature) of the O stellar population
;ii = strsplit(fcte[i],'_',count=count) & ii = ii(count-1)-1 ; contains the index of the last underscore before the 'key' keyword
;undscind[i] = ii
;ENDFOR
FOR i=0L,nparam-1 DO BEGIN
;fct[i] = strmid((*PDO)(i),0,strlen((*PDO)(i))-2.) ; old code line
;NEW LINES I ADDED
fct[i] = strmid((*PDO)(i),0) ; or fct[i] = strtrim((*PDO)(i),2)
ii = strsplit(fct[i],'_',count=count) & ii = ii(count-1)-1
fct[i] = strmid(fct[i],0,ii)
ENDFOR
;RQ: WHAT I FOUND QUITE ODD IS THE REMOVAL OF THE DUSTEM_CREATE_ISRF.PRO PROCEDURE SO MAYBE THIS PART IS NOT NEEDED AFTERALL
;I SHOULD MAKE SURE OF THE BEHAVIOR OF THE WRAPPER WITH RESPECT TO THE REMOVAL OF THIS PART
wisrf = where(fct eq 'dustem_create_isrf' or fct eq 'dustem_create_isrf2',cisrf) ;DUSTEM_CREATE_ISRF is being called as a param ?
IF cisrf NE 0 THEN BEGIN
wionf = where(fct EQ 'dustem_create_ionfrac',cionf) ; DUSTEM_CREATE_IONFRAC is being called as a param ?
; ISRF(yes), IONFRAC(no) => then everything is set by the IONFRACPAH in GRAIN.DAT
; ISRF(yes), IONFRAC(yes) => make sure DUSTEM_CREATE_IONFRAC is called after DUSTEM_CREATE_ISRF
IF cionf NE 0 THEN BEGIN
IF (wisrf(cisrf-1)) NE (nparam-1) THEN BEGIN ;ISRF was not the last in the list
(*PDO) = [(*PDO)(0:wionf(0)-1), (*PDO)(wisrf(0):wisrf(cisrf-1)), (*PDO)(wionf(0):wionf(cionf-1)), (*PDO)(wisrf(cisrf-1)+1:*)]
(*IDO) = [(*IDO)(0:wionf(0)-1), (*IDO)(wisrf(0):wisrf(cisrf-1)), (*IDO)(wionf(0):wionf(cionf-1)), (*IDO)(wisrf(cisrf-1)+1:*)]
ENDIF ELSE BEGIN ;ISRF was the last in the list
(*PDO) = [(*PDO)(0:wionf(0)-1), (*PDO)(wisrf(0):wisrf(cisrf-1)), (*PDO)(wionf(0):wionf(cionf-1))]
(*IDO) = [(*IDO)(0:wionf(0)-1), (*IDO)(wisrf(0):wisrf(cisrf-1)), (*IDO)(wionf(0):wionf(cionf-1))]
ENDELSE
ENDIF
ENDIF
(*!dustem_fit).param_func=ptr_new(replicate(0.,nparam))
ind = 1.
fct_prev = ''
FOR i=0L,nparam-1 DO BEGIN
IF (strmid((*PDO)[i],0,7) EQ 'dustem_') THEN BEGIN
;fct = strmid((*PDO)[i],14, strlen((*PDO)[i])-16) ;old line
;NEW lines I added
fct = strmid((*PDO)[i],14)
ii = strsplit(fct,'_',count=count) & ii = ii(count-1)-1
fct = strmid(fct,0,ii)
IF (fct EQ fct_prev) THEN BEGIN
(*(*!dustem_fit).param_func)[i]=(*(*!dustem_fit).param_func)[i-1]
ENDIF ELSE BEGIN
(*(*!dustem_fit).param_func)[i]=ind
ind=ind+1
ENDELSE
fct_prev=fct
ENDIF
ENDFOR
END