C ++******************************************************************** C * C * C * C ********************************************************************** C=* FROM: SPIDER - MODULAR IMAGE PROCESSING SYSTEM. AUTHOR: J.FRANK * C=* Copyright (C) 1985-2005 Health Research Inc. * C=* * C=* HEALTH RESEARCH INCORPORATED (HRI), * C=* ONE UNIVERSITY PLACE, RENSSELAER, NY 12144-3455. * C=* * C=* Email: spider@wadsworth.org * C=* * C=* This program is free software; you can redistribute it and/or * C=* modify it under the terms of the GNU General Public License as * C=* published by the Free Software Foundation; either version 2 of the * C=* License, or (at your option) any later version. * C=* * C=* This program is distributed in the hope that it will be useful, * C=* but WITHOUT ANY WARRANTY; without even the implied warranty of * C=* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * C=* General Public License for more details. * C=* * C=* You should have received a copy of the GNU General Public License * C=* along with this program; if not, write to the * C=* Free Software Foundation, Inc., * C=* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * C=* * C ********************************************************************** C * C * C * C PURPOSE: PLOT FERMI DISTRIBUTIONS AND SUMS OF IT C * C PARAMETERS: * C * C*********************************************************************** SUBROUTINE FERMP INCLUDE 'CMBLOCK.INC' COMMON A(80),BUF(1024) CHARACTER *1 WHAT,MULAD,NULL NULL=CHAR(0) CALL RDPRMI(IDIM,IDUM,NOT_USED,'PLOT X-DIMENSION') 6666 CALL RDPRMC(WHAT,NCHAR,.TRUE., $ '(L)OWPASS, (H)IGHPASS, OR (B)ANDPASS? (L/H/B)',NULL,IRT) IF (WHAT .EQ. 'H' .OR. WHAT .EQ. 'L') THEN CALL RDPRM2(RAD,TEMP,NOT_USED, $ 'FERMI CUTOFF RADIUS, TEMP. FACTOR') ELSEIF (WHAT .EQ. 'B') THEN CALL RDPRM2(RAD,TEMP,NOT_USED, $ 'FERMI CUTOFF RADIUS, TEMP. FACTOR FOR LOWPASS') CALL RDPRM2(RADH,TEMPH,NOT_USED, $ 'FERMI CUTOFF RADIUS, TEMP. FACTOR FOR HIGHPASS') CALL RDPRMC(MULAD,NCHAR,.TRUE., $ '(M)ULTIPLICATIVE, OR (A)DDITIVE? (M/A)',NULL,IRT) ELSE GOTO 6666 ENDIF DO I=1,IDIM X=(I-1)/FLOAT(2*IDIM) IF (WHAT.EQ.'L') BUF(I)=1./(1.+EXP((X-RAD)/TEMP))*50. IF (WHAT.EQ.'H') BUF(I)=1./(1.+EXP(-(X-RAD)/TEMP))*50. IF (WHAT.EQ.'B') THEN FLOW=1./(1.+EXP((X-RAD)/TEMP)) IF (MULAD .EQ. 'A') $ BUF(I) = (FLOW+1./(1.+EXP(-(X-RADH)/TEMPH)))*50. IF (MULAD .EQ. 'M') $ BUF(I) = (FLOW*1./(1.+EXP(-(X-RADH)/TEMPH)))*50. ENDIF ENDDO CALL MRKUR3(BUF,IDIM,0.,0,60) END