Changeset 5369
 Timestamp:
 Nov 11, 2022 10:04:18 AM (5 months ago)
 Location:
 trunk/fsource
 Files:

 1 added
 1 deleted
 3 edited
Legend:
 Unmodified
 Added
 Removed

trunk/fsource/SConstruct
r5360 r5369 68 68 for pth in [F2PYpath,spath,os.path.normpath(os.path.join(spath,'..')),os.path.join(spath,'Scripts')]: 69 69 if not pth: continue 70 # look for f2py3 first 70 71 if sys.platform == "win32": 71 72 program = 'f2py3.exe' … … 76 77 F2PYpath,F2PYprog = os.path.split(f2pyprogram) 77 78 break 79 # not there, try f2py 78 80 if sys.platform == "win32": 79 81 program = 'f2py.exe' … … 84 86 F2PYpath,F2PYprog = os.path.split(f2pyprogram) 85 87 break 88 # none of the above, look for f2py.py (probably obsolete) 86 89 program = 'f2py.py' 87 90 f2pyprogram = os.path.join(pth,program) … … 412 415 #print ('Compile: ',file, target) 413 416 filelist.append(target) 417 for file in glob.glob(os.path.join(sub,'*.f90')): 418 target = env.fort(file) # connect .o files to .f90 files 419 filelist.append(target) 414 420 #lib = Library(sub, Glob(os.path.join(sub,'*.for'))) # register library to be created 415 421 if sys.platform == "win32": 
trunk/fsource/powsubs/psvoigt.for
r1274 r5369 26 26 REAL*4 GNORM !Gaussian Normalization constant 27 27 REAL*4 COFT(6),COFN(3) 28 28 REAL*4 EPS !Are values different 29 ! Local variables saved between calls 30 REAL*4 prev_sig,prev_gam 31 REAL*4 eta,fwhm,frac,dsdg,dsdl,sumhm,dedf,sqsg 32 save eta,fwhm,frac,prev_sig,prev_gam,dsdg,dsdl,sumhm, 33 1 dedf,sqsg 34 29 35 !SUBROUTINES CALLED: 30 36 … … 37 43 DATA COFT/1.0,2.69269,2.42843,4.47163,0.07842,1.0/ 38 44 DATA COFN/1.36603,0.47719,0.11116/ 45 DATA prev_sig/1.0/ 46 DATA prev_gam/1.0/ 47 DATA eps/1.0e10/ !Threshold for recalculation 39 48 40 49 !CODE: 41 50 42 SQSG = MAX(SQRT(SIG),0.001) 43 FWHG = STOFW*SQSG 44 PGL = FWHG**5 45 SUMHM = PGL 46 DSDL = 0.0 47 DSDG = 0.0 48 DO ITRM=1,5 49 PGL = PGL/FWHG 50 DSDL = DSDL+FLOAT(ITRM)*COFT(ITRM+1)*PGL 51 DSDG = DSDG+FLOAT(6ITRM)*COFT(ITRM)*PGL 52 PGL = PGL*GAM 53 SUMHM = SUMHM+COFT(ITRM+1)*PGL 54 END DO 55 FWHM = EXP(0.2*LOG(SUMHM)) 56 FRAC = GAM/FWHM 57 DEDF = 0.0 58 PF = 1.0 59 ETA = 0.0 60 DO ITRM=1,3 61 DEDF = DEDF+FLOAT(ITRM)*COFN(ITRM)*PF 62 PF = PF*FRAC 63 ETA = ETA+COFN(ITRM)*PF 64 END DO 51 ! Check for repeat call 52 if (abs(prev_sigsig) .gt. eps .or. 53 1 (abs(prev_gamgam).gt.eps)) then !need to recalculate 54 prev_sig = sig 55 prev_gam = gam 56 SQSG = MAX(SQRT(SIG),0.001) 57 FWHG = STOFW*SQSG 58 PGL = FWHG**5 59 SUMHM = PGL 60 DSDL = 0.0 61 DSDG = 0.0 62 DO ITRM=1,5 63 PGL = PGL/FWHG 64 DSDL = DSDL+FLOAT(ITRM)*COFT(ITRM+1)*PGL 65 DSDG = DSDG+FLOAT(6ITRM)*COFT(ITRM)*PGL 66 PGL = PGL*GAM 67 SUMHM = SUMHM+COFT(ITRM+1)*PGL 68 END DO 69 FWHM = EXP(0.2*LOG(SUMHM)) 70 FRAC = GAM/FWHM 71 DEDF = 0.0 72 PF = 1.0 73 ETA = 0.0 74 DO ITRM=1,3 75 DEDF = DEDF+FLOAT(ITRM)*COFN(ITRM)*PF 76 PF = PF*FRAC 77 ETA = ETA+COFN(ITRM)*PF 78 END DO 79 end if !end of recalculation step 65 80 CALL LORENTZ(DX,FWHM,TL,DTLDT,DTLDFW) 66 81 SIGP = (FWHM/STOFW)**2 … … 83 98 RETURN 84 99 END 85 100 86 101 SUBROUTINE PSVOIGT2(DX,SIG,GAM,FUNC,DFDX,DFDS,DFDG) 87 102 
trunk/fsource/pypowder.for
r1970 r5369 1 S UBROUTINE PYPSVFCJ(NPTS,DTT,TTHETA,SIG,GAM,SPH,PRFUNC)1 Subroutine PYPSVFCJ(NPTS,DTT,TTHETA,CDSIG,CDGAM,SPH,PRFUNC) 2 2 C DTT in degrees 3 3 C TTHETA in degrees 4 C SPH is S/L + H/L 4 C SPH is S/L + H/L 5 C CDSIG Gaussian variance,centidegrees squared 6 C CDGAM Lorenzian FWHM, centidegrees 5 7 C RETURNS FUNCTION ONLY 6 8 Cf2py intent(in) NPTS 7 9 Cf2py intent(in) DTT 8 cf2py depend(NPTS) DTT10 Cf2py depend(NPTS) DTT 9 11 Cf2py intent(in) TTHETA 10 Cf2py intent(in) SIG11 Cf2py intent(in) GAM12 Cf2py intent(in) CDSIG 13 Cf2py intent(in) CDGAM 12 14 Cf2py intent(in) SPH 13 15 Cf2py intent(out) PRFUNC 14 16 Cf2py depend(NPTS) PRFUNC 15 16 17 REAL*4 DTT(0:NPTS1),PRFUNC(0:NPTS1) 17 REAL*4 TTHETA,SIG,GAM,SPH 18 REAL*4 TTHETA,SIG,CDSIG,CDGAM,SPH,DPRDT,DPRDG,DPRDD,DPRDLZ,DPRDS 19 REAL*4 GAM 18 20 INTEGER*4 NPTS,I 19 DO I=0,NPTS1 20 CALL PSVFCJ(DTT(I)*100.,TTHETA*100.,SIG,GAM,SPH, 21 1 PRFUNC(I),DPRDT,SIGPART,GAMPART,SLPART) 22 END DO 23 RETURN 24 END 25 26 SUBROUTINE PYDPSVFCJ(NPTS,DTT,TTHETA,SIG,GAM,SPH,PRFUNC, 27 1 DPRDT,SIGPART,GAMPART,SLPART) 21 C CDSIG is in centidegrees squared, we must change to normal degrees 22 SIG = CDSIG/10000.0 23 GAM = CDGAM/100.0 24 DO I=0,NPTS1 25 Call Get_Prof_Val(SIG,GAM,SPH,0.0,DTT(I)+TTHETA,TTHETA,DPRDT, 26 1 DPRDG,DPRDD,DPRDS,DPRDLZ,PRFUNC(I)) 27 PRFUNC(I)=PRFUNC(I)/100. !Calling code expects peak normalised in centidegrees 28 END DO 29 RETURN 30 END 31 32 SUBROUTINE PYDPSVFCJ(NPTS,DTT,TTHETA,CDSIG,CDGAM,SPH,PRFUNC, 33 1 DPRDT,SIGPART,GAMPART,SLPART) 28 34 C DTT in degrees 29 35 C TTHETA in degrees … … 32 38 Cf2py intent(in) NPTS 33 39 Cf2py intent(in) DTT 34 cf2py depend(NPTS) DTT40 Cf2py depend(NPTS) DTT 35 41 Cf2py intent(in) TTHETA 36 Cf2py intent(in) SIG37 Cf2py intent(in) GAM42 Cf2py intent(in) CDSIG 43 Cf2py intent(in) CDGAM 38 44 Cf2py intent(in) SPH 39 45 Cf2py intent(out) PRFUNC … … 47 53 Cf2py intent(out) SLPART 48 54 Cf2py depend(NPTS) SLPART 49 50 INTEGER*4 NPTS 51 REAL*4 TTHETA,SIG,GAM,SPH 52 REAL*4 DTT(0:NPTS1),DPRDT(0:NPTS1),SIGPART(0:NPTS1), 53 1 GAMPART(0:NPTS1),SLPART(0:NPTS1),PRFUNC(0:NPTS1) 54 DO I=0,NPTS1 55 CALL PSVFCJ(DTT(I)*100.,TTHETA*100.,SIG,GAM,SPH, 56 1 PRFUNC(I),DPRDT(I),SIGPART(I),GAMPART(I),SLPART(I)) 57 DPRDT(I) = DPRDT(I)*100. 55 INTEGER*4 NPTS,I 56 REAL*4 TTHETA,CDSIG,SIG,CDGAM,SPH,LPART 57 REAL*4 GAM 58 REAL*4 DTT(0:NPTS1),DPRDT(0:NPTS1),SIGPART(0:NPTS1) 59 REAL*4 GAMPART(0:NPTS1),SLPART(0:NPTS1),PRFUNC(0:NPTS1) 60 SIG = CDSIG/10000. 61 GAM = CDGAM/100. 62 DO I=0,NPTS1 63 Call Get_Prof_Val(SIG,GAM,SPH,0.0,DTT(I)+TTHETA,TTHETA, 64 1 DPRDT(I),SIGPART(I),GAMPART(I),SLPART(I),LPART, PRFUNC(I)) 65 ! Calling code expects all values to be for a peak normalised in centidegrees 66 SIGPART(I)=SIGPART(I)/1.0e6 67 GAMPART(I)=GAMPART(I)/1.0e4 68 SLPART(I)=SLPART(I)/100. 69 PRFUNC(I)=PRFUNC(I)/100. 70 DPRDT(I)=DPRDT(I)/100. 58 71 END DO 59 72 RETURN … … 65 78 Cf2py intent(in) NPTS 66 79 Cf2py intent(in) DTT 67 cf2py depend(NPTS) DTT80 Cf2py depend(NPTS) DTT 68 81 Cf2py intent(in) SIG 69 82 Cf2py intent(in) GAM … … 76 89 DO I=0,NPTS1 77 90 CALL PSVOIGT(DTT(I)*100.,SIG,GAM, 78 1 PRFUNC(I),DPRDT,SIGPART,GAMPART)91 1 PRFUNC(I),DPRDT,SIGPART,GAMPART) 79 92 END DO 80 93 RETURN … … 82 95 83 96 SUBROUTINE PYDPSVOIGT(NPTS,DTT,SIG,GAM,PRFUNC, 84 1 DPRDT,SIGPART,GAMPART)97 1 DPRDT,SIGPART,GAMPART) 85 98 C DTT in degrees 86 99 C RETURNS FUNCTION & DERIVATIVES 87 100 Cf2py intent(in) NPTS 88 101 Cf2py intent(in) DTT 89 cf2py depend(NPTS) DTT102 Cf2py depend(NPTS) DTT 90 103 Cf2py intent(in) SIG 91 104 Cf2py intent(in) GAM … … 102 115 REAL*4 SIG,GAM 103 116 REAL*4 DTT(0:NPTS1),DPRDT(0:NPTS1),SIGPART(0:NPTS1), 104 1 GAMPART(0:NPTS1),PRFUNC(0:NPTS1)117 1 GAMPART(0:NPTS1),PRFUNC(0:NPTS1) 105 118 DO I=0,NPTS1 106 119 CALL PSVOIGT(DTT(I)*100.,SIG,GAM, 107 1 PRFUNC(I),DPRDT(I),SIGPART(I),GAMPART(I))120 1 PRFUNC(I),DPRDT(I),SIGPART(I),GAMPART(I)) 108 121 DPRDT(I) = DPRDT(I)*100. 109 122 END DO … … 118 131 Cf2py intent(in) NPTS 119 132 Cf2py intent(in) DTT 120 cf2py depend(NPTS) DTT133 Cf2py depend(NPTS) DTT 121 134 Cf2py intent(in) TTHETA 122 135 Cf2py intent(in) SIG … … 131 144 DO I=0,NPTS1 132 145 CALL PSVFCJO(DTT(I)*100.,TTHETA*100.,SIG,GAM,SPH/2.0,SPH/2.0, 133 1 PRFUNC(I),DPRDT,SIGPART,GAMPART,SLPART,HLPART)146 1 PRFUNC(I),DPRDT,SIGPART,GAMPART,SLPART,HLPART) 134 147 END DO 135 148 RETURN … … 144 157 Cf2py intent(in) NPTS 145 158 Cf2py intent(in) DTT 146 cf2py depend(NPTS) DTT159 Cf2py depend(NPTS) DTT 147 160 Cf2py intent(in) TTHETA 148 161 Cf2py intent(in) SIG … … 163 176 REAL*4 TTHETA,SIG,GAM,SHL 164 177 REAL*4 DTT(0:NPTS1),DPRDT(0:NPTS1),SIGPART(0:NPTS1), 165 1 GAMPART(0:NPTS1),SLPART(0:NPTS1),PRFUNC(0:NPTS1)178 1 GAMPART(0:NPTS1),SLPART(0:NPTS1),PRFUNC(0:NPTS1) 166 179 DO I=0,NPTS1 167 180 CALL PSVFCJO(DTT(I)*100.,TTHETA*100.,SIG,GAM,SHL/2.,SHL/2., 168 1 PRFUNC(I),DPRDT(I),SIGPART(I),GAMPART(I),SPART,HPART)181 1 PRFUNC(I),DPRDT(I),SIGPART(I),GAMPART(I),SPART,HPART) 169 182 SLPART(I) = SPART 170 183 DPRDT(I) = DPRDT(I)*100. … … 178 191 Cf2py intent(in) NPTS 179 192 Cf2py intent(in) DTT 180 cf2py depend(NPTS) DTT193 Cf2py depend(NPTS) DTT 181 194 Cf2py intent(in) ALP 182 195 Cf2py intent(in) BET … … 189 202 REAL*4 ALP,BET,SIG,GAM,SHL 190 203 REAL*4 DTT(0:NPTS1),PRFUNC(0:NPTS1),DPRDT,ALPPART, 191 1 BETPART,SIGPART,GAMPART204 1 BETPART,SIGPART,GAMPART 192 205 DO I=0,NPTS1 193 206 CALL EPSVOIGT(DTT(I),ALP,BET,SIG,GAM,PRFUNC(I),DPRDT, 194 1 ALPPART,BETPART,SIGPART,GAMPART)207 1 ALPPART,BETPART,SIGPART,GAMPART) 195 208 END DO 196 209 RETURN … … 198 211 199 212 SUBROUTINE PYDEPSVOIGT(NPTS,DTT,ALP,BET,SIG,GAM,PRFUNC, 200 1 DPRDT,ALPPART,BETPART,SIGPART,GAMPART)213 1 DPRDT,ALPPART,BETPART,SIGPART,GAMPART) 201 214 C DTT in microsec 202 215 C RETURNS FUNCTION & DERIVATIVES 203 216 Cf2py intent(in) NPTS 204 217 Cf2py intent(in) DTT 205 cf2py depend(NPTS) DTT218 Cf2py depend(NPTS) DTT 206 219 Cf2py intent(in) ALP 207 220 Cf2py intent(in) BET … … 224 237 REAL*4 ALP,BET,SIG,GAM,SHL 225 238 REAL*4 DTT(0:NPTS1),DPRDT(0:NPTS1),ALPPART(0:NPTS1), 226 1 BETPART(0:NPTS1),SIGPART(0:NPTS1),227 1 GAMPART(0:NPTS1),PRFUNC(0:NPTS1)239 1 BETPART(0:NPTS1),SIGPART(0:NPTS1), 240 1 GAMPART(0:NPTS1),PRFUNC(0:NPTS1) 228 241 DO I=0,NPTS1 229 242 CALL EPSVOIGT(DTT(I),ALP,BET,SIG,GAM,PRFUNC(I),DPRDT(I), 230 1 ALPPART(I),BETPART(I),SIGPART(I),GAMPART(I))243 1 ALPPART(I),BETPART(I),SIGPART(I),GAMPART(I)) 231 244 END DO 232 245 RETURN … … 261 274 Cf2py intent(in) NIN 262 275 Cf2py intent(in) XIN 263 cf2py depend(NIN) XIN276 Cf2py depend(NIN) XIN 264 277 Cf2py intent(in) YIN 265 cf2py depend(NIN) YIN278 Cf2py depend(NIN) YIN 266 279 Cf2py intent(in) NOUT 267 280 Cf2py intent(in) XOUT 268 cf2py depend(NOUT) XOUT281 Cf2py depend(NOUT) XOUT 269 282 Cf2py intent(out) YOUT 270 cf2py depend(NOUT) YOUT283 Cf2py depend(NOUT) YOUT 271 284 272 285 INTEGER NIN,NOUT
Note: See TracChangeset
for help on using the changeset viewer.