C @(#)fitdirect.for 17.1.1.1 (ESO-IPG) 01/25/02 17:16:21 C=========================================================================== C Copyright (C) 1995 European Southern Observatory (ESO) 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 C the 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 C GNU General Public License for more details. C C You should have received a copy of the GNU General Public C License along with this program; if not, write to the Free C Software Foundation, Inc., 675 Massachusetss Ave, Cambridge, C MA 02139, USA. C C Corresponding concerning ESO-MIDAS should be addressed as follows: C Internet e-mail: midas@eso.org C Postal address: European Southern Observatory C Data Management Division C Karl-Schwarzschild-Strasse 2 C D 85748 Garching bei Muenchen C GERMANY C=========================================================================== C C program fitdirect implicit none include 'MID_REL_INCL:fit_var.inc' ! copies of keywords coming from line character*80 SPESYS,SESSYS,OUTSYS,HISSYS integer GRASYS character*30 choice character*70 sjunk character*60 filnam integer ifla,ist,i,ijk,iok C include 'MID_REL_INCL:fit_mid.inc' INTEGER MADRID(1) INCLUDE 'MID_INCLUDE:ST_DEF.INC' COMMON/VMR/MADRID INCLUDE 'MID_INCLUDE:ST_DAT.INC' C!!!!!!! C MIDAS SET-UP C!!!!!!! call STSPRO('fitdirect') call STKRDC('SPECTAB',1,1,80,i,SPESYS,ijk,ijk,iok) if (iok.ne.0) then call ErrMsg('Error in reading keywords: check context..') call STSEPI() stop end if call STKRDC('OUTTAB',1,1,80,i,OUTSYS,ijk,ijk,iok) if (iok.ne.0) then call ErrMsg('Error in reading keywords: check context..') call STSEPI() stop end if call STKRDC('HISTAB',1,1,80,i,HISSYS,ijk,ijk,iok) if (iok.ne.0) then call ErrMsg('Error in reading keywords: check context..') call STSEPI() stop end if call STKRDC('SESSNAM',1,1,80,i,SESSYS,ijk,ijk,iok) if (iok.ne.0) then call ErrMsg('Error in reading keywords: check context..') call STSEPI() stop end if call STKRDI('GRAWIN',1,1,i,GRASYS,ijk,ijk,iok) if (iok.ne.0) then call ErrMsg('Error in reading keywords: check context..') call STSEPI() stop end if C!!!!!!! C Videata iniziale C!!!!!!! choice = ' ' do i=1,4 call sttdis(choice,0,ist) end do sjunk = ' - FitLyman- Lyman clouds fitting procedure' do i=1,2 call sttdis(' ',0,ist) end do call DisMsg('Loading & initializing data...') call DisMsg('Wait please..') C!!!!!!! C Inizializzazione programma C!!!!!!! if (SESSYS.ne.'NULL') then i=index(SESSYS,' ') sjunk=SESSYS(1:i-1)//PARTBL else sjunk=PARTBL end if call rsetup(sjunk,ist) ! read set-up if (ist.ne.0) then ! on error, default values call WrnMsg('Error in reading set-up: using defaults') ! copy syskeys into variables if (SPESYS.ne.'NULL') then FILSPE=SPESYS else call ErrMsg('Missing input parameters: check line command') call STSEPI() stop end if if (OUTSYS.ne.'NULL') then FILOUT=OUTSYS else call ErrMsg('Missing input parameters: check line command') call STSEPI() stop end if if (HISSYS.ne.'NULL') then FILLOG=HISSYS else call ErrMsg('Missing input parameters: check line command') call STSEPI() stop end if TURBLN=0 i_grap = .false. if (GRASYS.ne.0) i_grap = .true. call F_TBLR('SCRATCH',1,ist) !initializes lypar (in memory!) else call f_tblr(sjunk,1,ist) !read init. param. if (SPESYS.ne.'NULL') FILSPE=SPESYS ! overrides values read if (OUTSYS.ne.'NULL') FILOUT=OUTSYS if (HISSYS.ne.'NULL') FILLOG=HISSYS if (GRASYS.ne.-1) then if (GRASYS .eq.1) i_grap = .true. if (GRASYS .eq.0) i_grap = .false. end if end if call f_tblw(PARTBL,1,ist) c call AskStp('PROGRAM',ist) call ssetup(PARTBL,ist) if (ist.ne.0) then call ErrMsg('Error in writing set-up: check disk space') call STSEPI() stop end if call AtmRD(ist) !read atompar.dat NPUNTI=NMXSPE call reaspe(FILSPE,NPUNTI) !read spectrum if (NPUNTI.lt.1) goto 666 i=index(FILLOG,' ') filnam=fillog(1:i-1)//PARTBL call GETIDN(filnam,IDnum,ist) if (ist.ne.0) then call WrnMsg('Log files not found: starting from scratch') IDnum=0 end if ! read fit limits if (SESSYS.ne.'NULL') then i=index(SESSYS,' ') sjunk=SESSYS(1:i-1)//LIMTBL else sjunk=LIMTBL end if call rintvl(sjunk,1,ist) call sintvl(sjunk,1,ist) ! read minuit instructions if (SESSYS.ne.'NULL') then i=index(SESSYS,' ') sjunk=SESSYS(1:i-1)//MINTBL else sjunk=MINTBL end if call rminui(sjunk,1,ist) call sminui(sjunk,1,ist) call GraMai(ist) ! plot call DisMsg(' ..done') call sttdis(' ',0,ist) C#### C DIRECTMINI C#### call DisMsg('Preparing minimization data...') call f_tblr(PARTBL,1,ifla) if (ifla.ne.0) then call ErrMsg('Error in reading lypar') call STSEPI() stop end if call rintvl(LIMTBL,1,ifla) if (ifla.ne.0) then call ErrMsg('Error in reading lypar') call STSEPI() stop end if call rminui(MINTBL,1,ifla) if (ifla.ne.0) then call ErrMsg('Error in reading lypar') call STSEPI() stop end if call FitWin(i,ifla) ! create data for FCN if (ifla.lt.0) then call ErrMsg('Error in initial condition for fit') call STSEPI() stop end if call FCNHd() call MinuHd() call DisMsg('...Done') write(sjunk,'(a25,i6)')'Number of pixel selected:',i call DisMsg(sjunk) C Esegue il fit call DisMsg('Executing fitting procedures...') call Minmze() call DisMsg('...Done') C Presenta e salva i risultati call GraMai(ifla) call ShoRes IDnum=IDNum+1 call SavRes(FILOUT,ist) i=index(FILLOG,' ') !saves on history file filnam=FILLOG(1:i-1)//PARTBL call f_tblw(filnam,IDNum,ist) filnam=FILLOG(1:i-1)//MINTBL call sminui(filnam,IDNum,ist) filnam=FILLOG(1:i-1)//LIMTBL call sintvl(filnam,IDNum,ist) write(sjunk,'(a17,i6)')'Saved with ID = ',IDnum call DisMsg(sjunk) 666 continue call STSEPI() end