MODULE CHANNEL USE params USE synspec IMPLICIT NONE INTEGER, DIMENSION(MAXBND) :: NBEAM_OF_BAND ! NUMBER OF BEAMS IN THIS ! BAND (pwj) CHARACTER (len=2), DIMENSION(MAXBND) :: CHANNEL_MODEL_OF_BAND ! TWO VALID VALUES: ! 'IP' -- INTEFEROGRAM PERTURBATION MODE !PWJ ! 'PS' -- PHASE-SHIFTED REFLECTED BEAM !PWJ REAL(DOUBLE), DIMENSION(MAXBND,MAX_NUM_OF_BEAMS,4) :: SCHAN_SCALE, CHAN_SCALE REAL(DOUBLE), DIMENSION(MAXBND,MAX_NUM_OF_BEAMS,4) :: CCIPARM ! CHANNEL SPECTRUM VALUES (pwj) REAL(DOUBLE), DIMENSION(MAXBND,MAX_NUM_OF_BEAMS,4) :: CHANNEL_CPARM ! CHANNEL SPECTRUM VALUES (pwj) INTEGER, DIMENSION(MAXBND,MAX_NUM_OF_BEAMS,4) :: CHANNEL_IFIX ! CHANNEL SPECTRUM VALUES (pwj) INTEGER :: FIRST_CHANNEL_PARM_NUM ! THE POSITION OF FIRST CHANNEL ! PARM IN STATE VECTOR (pwj) CONTAINS !--------------------------------------------------------------------------- SUBROUTINE READ_CHANNEL_PARMS(IBAND, NUM_OF_BEAMS, UNIT2) !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC ! C ! AUTHOR: WUJIAN PENG C ! DATE: AUG. 4 , 2002 C ! C ! FUNCTION: THIS SUBROUTINE IS USED TO READ CHANNEL PARAMETERS C ! FOR BANDPASS IBAND FROM FILE UNIT1 AND WRITE THEM C ! INTO FILE UNIT2; THE BANDPASS HAS NUM_OF_BEAMS C ! SETS OF PARAMETERS, EACH SET CONTAINS FOUR PARMS: C ! CHANNEL_CPARM(IBAND,IBEAM,K),K=1,4 C ! AND THE CORRESPONDING FLAGS: C ! CHANNEL_IFIX(IBAND,IBEAM,K),K=1,4 C ! C ! INPUT: IBAND -- THE CURRENT BANDPASS NUMBER C ! NUM_OF_BEAMS -- NUMBER OF BEAMS IN CURRENT BANDPASS C ! UNIT1 -- INPUT FILE UNIT NUMBER C ! UNIT2 -- OUTPUT FILE UNIT NUMBER C ! C ! OUTPUT: CHANNEL_CPARM-- CHANNEL PARAMETERS C ! CHANNEL_CIPARM-- CHANNEL PARAMETERS C ! CHANNEL_IFIX -- FLAGS INDICATING WHICH CPARM NEEDS C ! TO BE FIT C ! C ! NOTE: VARIABLES : CHANNEL_CPARM, CHANNEL_CIPARM, C ! CHANNEL_IFIX C ! ARE DEFINED IN 'bands.dat' C ! C !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC INTEGER, INTENT(IN) :: IBAND, NUM_OF_BEAMS, UNIT2 INTEGER :: J !, K !-- READ THE PARAMETERS--------------------------------------- !WRITE (UNIT2, 99) IBAND DO J = 1, NUM_OF_BEAMS !READ (UNIT1, *) (CCIPARM(IBAND,J,K),K=1,4) !WRITE (UNIT2, 100) WRITE (UNIT2, 9) J WRITE (UNIT2, 11) CCIPARM(IBAND,J,1), CHANNEL_IFIX(IBAND,J,1) WRITE (UNIT2, 12) CCIPARM(IBAND,J,2), CHANNEL_IFIX(IBAND,J,2) WRITE (UNIT2, 13) CCIPARM(IBAND,J,3), CHANNEL_IFIX(IBAND,J,3) WRITE (UNIT2, 14) CCIPARM(IBAND,J,4), CHANNEL_IFIX(IBAND,J,4) !READ (UNIT1, *) (CHANNEL_IFIX(IBAND,J,K),K=1,4) !WRITE (UNIT2, 200) !WRITE (UNIT2, 20) (CHANNEL_IFIX(IBAND,J,K),K=1,4) END DO !-- STORE THE INITIAL PARAMETERS------------------------------- CHANNEL_CPARM(IBAND,:NUM_OF_BEAMS,:) = CCIPARM(IBAND,:NUM_OF_BEAMS,:) 9 FORMAT(' CHANNEL BEAM : ', I5 ) 11 FORMAT(' INITIAL PEAK AMPLITUDE OF BEAM AND FIT SWITCH : ', F10.5, I5) 12 FORMAT(' INITIAL CHANNEL PERIOD : ', F10.5, I5) 13 FORMAT(' INITIAL ZERO PHASE REFERENCE WAVENUMBER : ', F10.5, I5) 14 FORMAT(' INITIAL CHANGE IN AMPLITUDE PER WAVENUMBER : ', F10.5, I5) ! 10 FORMAT(4F10.4) ! 20 FORMAT(4I5) ! 99 FORMAT('INPUT CHANNEL PARAMETER FOR BANDPASS: ',I5) ! 100 FORMAT('INPUT PEAK AMPLITUDE OF REFLECTED BEAM RELATIVE ',' TO PARIMARY',& ! /,' INPUT SEPARATION(CM-1) BETWEEN CHANNEL PEAKS',/,& ! ' INPUT ZERO CHANNEL PHASE REFERENCE WAVENUMBER',/,& ! ' INPUT CHANGE IN CHANNEL AMPLITUDE PER WAVENUMBER') ! 200 FORMAT('INPUT CHANNEL_IFIX FOR EACH PARAMETER(1=YES,0=NO)') RETURN END SUBROUTINE READ_CHANNEL_PARMS !--------------------------------------------------------------------------- SUBROUTINE INSERT_CHANNEL_PARMS(NVAR, PARM, PNAME, SPARM) !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC ! ! AUTHOR: WUJIAN PENG ! DATE: AUG. 4 , 2002 ! ! FUNCTION: THIS SUBROUTINE IS TO INSERT THE CHANNEL PARMS TO BE FIT ! INTO THE STATE VECTOR PARM(), AND THE POSITION OF FIRST ! CHANNEL PARAMETER IN PARM() WILL BE STORED. ! ! INPUT : NVAR -- THE CURRENT LENGTH OF PARMS WHICH HAVE BEEN FILLED ! INTO THE STATE VECTOR C ! CHAN_SCALE -- SCALING FACTOR FOR CHANNEL PARAMETERS C ! SCHAN_SCALE -- UNCERTAINTY OF THE SCALING FACTER C ! C ! OUTPUT: PARM -- THE STATE VECTOR TO BE FIT C ! PNAME -- NAMES OF THE STATEVECTOR ELEMENT C ! SPARM -- UNCERTAINTIES OF THE STATEVECTOR INITIAL GUESS C ! C ! NOTE : C ! VARIABLES: NBAND,NBEAM_OF_BAND, C ! CHANNEL_IFIX, CHANNEL_CPARM, C ! FIRST_CHANNEL_PARM_NUM C ! ARE DEFINED IN 'bands.dat' C ! C !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC INTEGER, INTENT(INOUT) :: NVAR REAL(DOUBLE), INTENT(OUT) :: PARM(NMAX), SPARM(*) CHARACTER, INTENT(OUT) :: PNAME(*)*(*) INTEGER :: IBAND, IBEAM, K !-- INSERT THE CHANNEL PARMS TO BE FIT INTO STATE VECTOR PARM()-------- !-- AND KEEP THE START NUMBER IN THE PARM()--------------------------- FIRST_CHANNEL_PARM_NUM = NVAR + 1 DO IBAND = 1, NBAND DO IBEAM = 1, NBEAM_OF_BAND(IBAND) DO K = 1, 4 IF (CHANNEL_IFIX(IBAND,IBEAM,K) == 0) CYCLE NVAR = NVAR + 1 SELECT CASE (K) CASE (1) PNAME(NVAR) = 'PEAK_AMP' CASE (2) PNAME(NVAR) = 'CHAN_SEP' CASE (3) PNAME(NVAR) = 'ZERO_PH_REF' CASE (4) PNAME(NVAR) = 'CHANGE_IN_CHAN_AMP' END SELECT PARM(NVAR) = CHAN_SCALE(IBAND,IBEAM,K) SPARM(NVAR) = SCHAN_SCALE(IBAND,IBEAM,K) END DO END DO END DO RETURN !-- RETURN TO THE CALLER END SUBROUTINE INSERT_CHANNEL_PARMS !--------------------------------------------------------------------------- SUBROUTINE RETRIEVE_CHANNEL_PARMS(PARM) !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC ! C ! AUTHOR: WUJIAN PENG C ! DATE: AUG. 4 , 2002 C ! C ! FUNCTION: THIS SUBROUTINE IS TO RETRIEVE THE CHANNEL PARMS TO BE C ! FITTED FROM THE STATE VECTOR PARM(), THE FIRST CHANNEL C ! PARM IN STATE VECTOR PARM() IS INDICATED BY THE VARIABLE C ! 'FIRST_CHANNEL_PARM_NUM' C ! C ! INPUT: PARM -- THE STATE VECTOR TO BE FIT C ! C ! OUTPUT: PART OF CHANNEL_CPARM(,,) C ! C ! NOTE : C ! VARIABLES: NBAND,NBEAM_OF_BAND, C ! CHANNEL_IFIX, CHANNEL_CPARM, CHANNEL_CIPARM C ! FIRST_CHANNEL_PARM_NUM C ! ARE DEFINED IN 'bands.dat' C ! C !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC REAL(DOUBLE) :: PARM(NMAX) INTEGER :: IBAND, IBEAM, K, NVAR !-- RETRIEVE THE CHANNEL PARMS TO BE FIT FROM STATE VECTOR PARM()-------- NVAR = FIRST_CHANNEL_PARM_NUM - 1 DO IBAND = 1, NBAND DO IBEAM = 1, NBEAM_OF_BAND(IBAND) DO K = 1, 4 IF (CHANNEL_IFIX(IBAND,IBEAM,K) == 0) CYCLE NVAR = NVAR + 1 CHANNEL_CPARM(IBAND,IBEAM,K) = PARM(NVAR)*CCIPARM(IBAND,IBEAM,K) END DO END DO END DO RETURN END SUBROUTINE RETRIEVE_CHANNEL_PARMS !--------------------------------------------------------------------------- REAL(KIND(0.0D0)) FUNCTION FIT_CHANNEL_PARMS (IBAND, JSCAN, J, BKGND, TCALI, TEMP) !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC ! C ! AUTHOR: WUJIAN PENG C ! DATE: AUG. 4 , 2002 C ! C ! FUNCTION: THIS FUNCTION IS USED TO GET THE UPDATED SPECTRUM AFTER ! THE CHANNEL PARMS ARE USED. IT USES TWO CHANNEL MODELS: C ! IP -- INTERFEROGRAM PERTURBATION MODEL C ! PS -- PHASE-SHIFTED REFLECTING MODEL C ! C ! INPUT: C ! IBAND -- NUMBER OF CURRENT BANDPASS C ! JSCAN -- NUMBER OF CURRENT SCAN C ! J -- INDEX FOR CURRENT MON POINT ! BKGND -- THE BACKGROUND FITTING VALUES FOR CURRENT BANDPASS C ! TCALI -- COMPUTED COMPLEX SPECTRUM BY SUBROUTINE FSPEC2 C ! C ! OUTPUT: C ! -- THE UPDATED SPECTRUM AFTER USING CHANNEL PARM C ! ! NOTE: VARIABLES : ZSHIFT, CHANNEL_MODEL_OF_BAND C ! ARE DEFINED IN 'bands.dat' C ! !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC INTEGER, INTENT(IN) :: IBAND, JSCAN, J REAL(DOUBLE), INTENT(IN) :: BKGND REAL(DOUBLE), INTENT(OUT) :: TEMP COMPLEX(DBLE_COMPLEX), INTENT(IN) :: TCALI REAL(DOUBLE) :: THETA, REALPT, COMPX, PSUM, YCTEMP CHARACTER(len=2) :: CH_MOD COMPLEX(DBLE_COMPLEX) :: CMOD, CHANNEL_VALUE FIT_CHANNEL_PARMS = 0.0D0 !-- GET CHANNEL MODEL OF CURRENT BAND AND !-- CALL SUBROUTINE TO OBTAIN : REALPT, COMPX, PSUM CH_MOD = CHANNEL_MODEL_OF_BAND(IBAND) CALL CALCULATE_PARMS (IBAND, J, REALPT, COMPX, PSUM) !-- FITTING THE CHANNEL SPECTRUM IF (CH_MOD=='PS' .OR. CH_MOD=='Ps' .OR. CH_MOD=='pS' .OR. CH_MOD=='ps') & THEN !PROCCESS WITH PHASE-SHITED ! REFLECTING MODEL THETA = ATAN(COMPX/REALPT) CMOD = DCMPLX(SQRT(REALPT*REALPT + COMPX*COMPX),0.D0) CHANNEL_VALUE = CMOD*DCMPLX(COS(THETA),SIN(THETA)) YCTEMP = BKGND*(DBLE(TCALI*CHANNEL_VALUE) + ZSHIFT(IBAND,JSCAN)) FIT_CHANNEL_PARMS = YCTEMP IF (OUTPUT_CHANNEL_FILES) THEN TEMP = REAL( CHANNEL_VALUE ) !FOR_CHANNEL_VALUE_FILES ENDIF GO TO 10 ENDIF IF (CH_MOD=='IP' .OR. CH_MOD=='Ip' .OR. CH_MOD=='ip' .OR. CH_MOD=='iP') & THEN !PROCESS WITH INTERFEROGRAM- ! PERTURBATION MODEL YCTEMP = BKGND*(DBLE(TCALI) + ZSHIFT(IBAND,JSCAN)+PSUM) FIT_CHANNEL_PARMS = YCTEMP IF (OUTPUT_CHANNEL_FILES) TEMP = PSUM !for_channel_value_files ELSE WRITE (6, *) ' UNKNOWN CHANNEL SPECTRUM MODEL : ', CH_MOD WRITE (6, *) ' PROGRAM ABNORMALLY EXITED!' STOP 'STOP AT FUNCTON FIT_CHAN_PARMS' ENDIF 10 CONTINUE RETURN END FUNCTION FIT_CHANNEL_PARMS !--------------------------------------------------------------------------- SUBROUTINE CALCULATE_PARMS(IBAND, J, REALPT, COMPX, PSUM) !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC ! C ! AUTHOR: WUJIAN PENG C ! DATE: AUG. 4 , 2002 C ! C ! FUNCTION: COMPUTE THREE PARAMETERS : C ! REALPT, COMPX, PSUM C ! OF BANDPASS IBAND AT POINT J FOR FUNCTION FIT_CHANNEL_PARMS C ! C ! INPUT: C ! IBAND -- NUMBER OF CURRENT SPECTRA C ! J -- INTEGER INDICATING THE CURRENT FITTING POINT C ! C ! OUTPUT: C ! COMPX -- A SCALAR USED FOR NIPLE MODEL: PHASE-SHIFTED C ! REFLECTED BEAMS C ! PSUM -- A SCALAR USED FOR INTERFEROGRAM PERTURBATION C ! MODEL C ! REALPT-- A SCALAR USED FOR PHASE_SHIFTED REFLECTED MODEL C ! C ! NOTE: VARIABLE ' CHANNEL_CPARM ' IS DEFINED IN 'bands.dat' C ! SPAC IS DEFINED IN 'jmix.dat' C ! C !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC INTEGER, INTENT(IN) :: IBAND, J REAL(DOUBLE), INTENT(OUT) :: REALPT, COMPX, PSUM INTEGER :: LL, NB REAL(DOUBLE) :: WAVE, ABEAM, DELAY, COSPART !-- INITIALIZE LOCAL VARIABLES---------------------------------------- WAVE = WSTART(IBAND) + (J - 1)*SPAC(IBAND) REALPT = 1.D0 COMPX = 0.D0 PSUM = 0.D0 NB = NBEAM_OF_BAND(IBAND) !-- COMPUTE OUTPUT VALUES--------------------------------------------- DO LL = 1, NB ABEAM = CHANNEL_CPARM(IBAND,LL,1)*(1.D0 + CHANNEL_CPARM(IBAND,LL,4)*(& WAVE-WSTART(IBAND))) DELAY = 6.2831853D0*(WAVE - CHANNEL_CPARM(IBAND,LL,3))/CHANNEL_CPARM(& IBAND,LL,2) COSPART = ABEAM*COS(DELAY) REALPT = REALPT - ABEAM + COSPART COMPX = COMPX + ABEAM*SIN(DELAY) PSUM = PSUM + COSPART END DO RETURN END SUBROUTINE CALCULATE_PARMS !--------------------------------------------------------------------------- SUBROUTINE PRINT_CHANNEL_PARMS(FILE_UNIT) !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC ! C ! AUTHOR: WUJIAN PENG C ! DATE: AUG. 4 , 2002 C ! C ! FUNCTION: THIS SUBROUTINE IS TO PRINT ALL CHANNEL PARMS AFTER BEING ! FIT C ! INPUT : FILE_UNIT -- FILE UNIT NUMBER OF OUTPUT C ! C ! C ! OUTPUT: CHANNEL PARMS --CHANNEL_CPARM(,,) C ! C ! NOTE : VARIABLE 'CHANNEL_CPARM' IS DEFINED IN 'bands.dat' C ! C !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC INTEGER :: FILE_UNIT INTEGER :: IBAND, IBEAM, K !-- PRINT CHANNEL PARMS------------------------------------------------- DO IBAND = 1, NBAND DO IBEAM = 1, NBEAM_OF_BAND(IBAND) WRITE (FILE_UNIT, 99) IBAND, IBEAM WRITE (FILE_UNIT, 991) WRITE (FILE_UNIT, 100) (CHANNEL_CPARM(IBAND,IBEAM,K),K=1,4) END DO END DO RETURN 99 FORMAT(/,'RETRIEVED CHANNEL PARAMETERS FOR BANDPASS: ',I2,' BEAM: ',I5) 991 FORMAT(' PEAK_AMP CHAN_SEP ZERO_PH_REF ',' CHANGE_IN_CHAN_AMP') 100 FORMAT(4(f12.5,2X)) END SUBROUTINE PRINT_CHANNEL_PARMS END MODULE CHANNEL