c kspectrum (http://www.meso-star.com/en_Products.html) - This file is part of kspectrum c Copyright (C) 2008-2015 - Méso-Star - Vincent Eymet c c This file must be used under the terms of the CeCILL license. c This source file is licensed as described in the file COPYING, which c you should have received as part of this distribution. The terms c are also available at c http://www.cecill.info/licences/Licence_CeCILL_V2.1-en.txt c subroutine look_for_errors(sdis,custom_db,htv,htsd_co2,htsd_h2o, & dr,nis,line_profile,usl,sl_choice,slwr,slam,slas, & ucia,ciac,ciawr,ciatr,est,pct,over,rid,sens_T,sens_P,sens_x, & uaal,uanb,sda,bslal, & ltr,dorg,tfl,rl,nchunks,k_mxep,sd_mxep, & nu_min,nu_max,B_mxep,constant_dnu, & m,T_hitemp,i_inf,i_sup,band_inf,band_sup, & nlw_cz,np_lc,np_bl,tr_dist,ngamma, & pr_sd,pr_kc) implicit none include 'max.inc' include 'formats.inc' logical ex integer nf integer sdis,htv,htsd_co2,htsd_h2o,dr,nis,sl_choice,line_profile integer over logical custom_db,usl,ucia,pct,rid logical slwr,slam,slas integer est logical sens_T,sens_P,sens_x integer ciac logical ciawr,ciatr integer nchunks double precision k_mxep,sd_mxep double precision nu_min,nu_max,B_mxep,constant_dnu character*(Nchar_mx) file_tab,tfile character*(Nchar_mx) command integer nint_y double precision y_min,x_min,x_max integer uaal,uanb,sda,bslal logical tfl,rl logical ltr integer dorg double precision T_hitemp integer m,i_inf,i_sup,Nb,band_inf,band_sup double precision tr_dist,pr_sd,pr_kc integer ngamma integer nlw_cz,np_lc,np_bl integer mol,nmissing,i,nfiles character*2 str2 character*(Nchar_mx) file_list(1:nfiles_mx) character*(Nchar_mx) lblfile,missing_file(1:nfiles_mx) character*2 htv_idx character*4 htv_ch character*(Nchar_mx) base integer Nmol integer strlen character*(Nchar_mx) label label='subroutine look_for_errors' c Control of options if ((sdis.ne.1).and.(sdis.ne.2)) then write(*,*) 'Incorrect value is "options.in":' write(*,*) 'Compute / use predefined spectral discretization' stop endif if ((custom_db).and.(.not.custom_db)) then write(*,*) 'Incorrect value is "options.in":' write(*,*) 'Use custom LBL database' stop endif if ((htv.ne.2004).and.(htv.ne.2008).and.(htv.ne.2012)) then write(*,*) 'Incorrect value is "options.in":' write(*,*) 'version of the HITRAN database' stop endif if ((htsd_co2.ne.-1).and.(htsd_co2.ne.0).and.(htsd_co2.ne.1).and. & (htsd_co2.ne.2).and.(htsd_co2.ne.3)) then write(*,*) 'Incorrect value is "options.in":' write(*,*) 'Choice of HITEMP/CDSD for CO2 @ T>T_hitemp' stop endif if ((htsd_h2o.ne.1).and. & (htsd_h2o.ne.2)) then write(*,*) 'Incorrect value is "options.in":' write(*,*) 'Choice of HITEMP/HITEMP2010 for H2O @ T>T_hitemp' stop endif if ((dr.ne.1).and.(dr.ne.2)) then write(*,*) 'Incorrect value is "options.in":' write(*,*) 'LBL data reorganization' stop endif if ((nis.ne.1).and.(nis.ne.2)) then write(*,*) 'Incorrect value is "options.in":' write(*,*) 'selection of isotopes when not specified' stop endif if ((line_profile.ne.1).and.(line_profile.ne.2)) then write(*,*) 'Incorrect value is "options.in":' write(*,*) 'Lorentz or Voigt profile' stop endif if ((usl).and.(.not.usl)) then write(*,*) 'Incorrect value is "options.in":' write(*,*) 'using sub-lorentizan profiles' stop endif if ((sl_choice.lt.0).or.(sl_choice.gt.3)) then write(*,*) 'Incorrect value is "options.in":' write(*,*) 'choice of sub-lorentizan profile' write(*,*) 'allowed values: 0, 1, 2, 3' stop endif if ((slwr).and.(.not.slwr)) then write(*,*) 'Incorrect value is "options.in":' write(*,*) 'use CO2 SL profiles over the whole IR range' stop endif if ((slam).and.(.not.slam)) then write(*,*) 'Incorrect value is "options.in":' write(*,*) 'use CO2 SL profiles for all molecules' stop endif if ((slas).and.(.not.slas)) then write(*,*) 'Incorrect value is "options.in":' write(*,*) 'use SL profile asymetry' stop endif if ((ucia).and.(.not.ucia)) then write(*,*) 'Incorrect value is "options.in":' write(*,*) 'compute CIA for CO2' stop endif if ((ciac.ne.1).and.(ciac.ne.2).and.(ciac.ne.3)) then write(*,*) 'Incorrect value is "options.in":' write(*,*) 'choice for CIA source' stop endif if ((ciawr).and.(.not.ciawr)) then write(*,*) 'Incorrect value is "options.in":' write(*,*) 'compute CIA outside wavenumber validity range' stop endif if ((ciatr).and.(.not.ciatr)) then write(*,*) 'Incorrect value is "options.in":' write(*,*) 'compute CIA outside temperature validity range' stop endif if ((est.ne.0).and.(est.ne.1)) then write(*,*) 'Incorrect value is "options.in":' write(*,*) 'erase result files at start time' stop endif if ((pct).and.(.not.pct)) then write(*,*) 'Incorrect value is "options.in":' write(*,*) 'print computation times' stop endif if ((rid).and.(.not.rid)) then write(*,*) 'Incorrect value is "options.in":' write(*,*) 'resume computation if interuption detected' stop endif if ((sens_T).and.(.not.sens_T)) then write(*,*) 'Incorrect value is "options.in":' write(*,*) 'compute sensitivities to temperature' stop endif if ((sens_P).and.(.not.sens_P)) then write(*,*) 'Incorrect value is "options.in":' write(*,*) 'compute sensitivities to pressure' stop endif if ((sens_x).and.(.not.sens_x)) then write(*,*) 'Incorrect value is "options.in":' write(*,*) 'compute sensitivities to concentrations' stop endif if ((uaal.ne.1).and.(uaal.ne.2)) then write(*,*) 'Incorrect value is "options.in":' write(*,*) 'atmospheric levels to use' stop endif if ((uanb.ne.1).and.(uanb.ne.2)) then write(*,*) 'Incorrect value is "options.in":' write(*,*) 'narrowband intervals to use' stop endif if ((sda.ne.0).and.(sda.ne.1).and.(sda.ne.2) & .and.(sda.ne.3).and.(sda.ne.4)) then write(*,*) 'Incorrect value is "options.in":' write(*,*) 'spectral discretization algorithm to use' stop endif if (sda.ne.1) then write(*,*) write(*,*) 'WARNING: accuracy over the spectral grid', & ' is not guaranteed' write(*,*) endif if ((bslal.lt.0).or.(bslal.gt.4)) then write(*,*) 'Incorrect value is "options.in":' write(*,*) 'level of accuracy for between-lines meshing' stop endif if ((ltr).and.(.not.ltr)) then write(*,*) 'Incorrect value is "options.in":' write(*,*) 'line truncation' stop endif if ((dorg.ne.1).and.(dorg.ne.2)) then write(*,*) 'Incorrect value is "options.in":' write(*,*) 'truncation type' stop endif if ((tfl).and.(.not.tfl)) then write(*,*) 'Incorrect value is "options.in":' write(*,*) 'set to zero contribution of constant lines' stop endif if ((rl).and.(.not.rl)) then write(*,*) 'Incorrect value is "options.in":' write(*,*) 'reject lines' stop endif if (ltr) then if (sda.ne.2) then write(*,*) endif write(*,*) 'WARNING: accuracy over values of k', & ' is not guaranteed' write(*,*) endif if ((nchunks.le.0).and.(nchunks.ne.-1)) then write(*,*) 'Incorrect value in "options.in":' write(*,*) 'Number of computation chunks' endif c Control of data if (k_mxep.lt.0.0D+0) then write(*,*) 'Incorrect value in "data.in":' write(*,*) 'Max. error perc. over k for line classification' stop endif if (sdis.eq.1) then if (nu_min.lt.0.0D+0) then write(*,*) 'Incorrect value in "data.in":' write(*,*) 'Minimum wavenumber of spectral interval' stop endif if ((nu_max.lt.0.0D+0).or.(nu_max.le.nu_min)) then write(*,*) 'Incorrect value in "data.in":' write(*,*) 'Maximum wavenumber of spectral interval' stop endif if (B_mxep.lt.0.0D+0) then write(*,*) 'Incorrect value in "data.in":' write(*,*) 'Max. error percentage over Planck for', & ' spectrum discretization' stop endif if (constant_dnu.le.0.0D+0) then write(*,*) 'Incorrect value in "data.in":' write(*,*) 'Constant spectral step' stop endif endif if (T_hitemp.le.0.0D+0) then write(*,*) 'Incorrect value uin "daat.in":' write(*,*) 'High-temperature level=',T_hitemp stop endif if (T_hitemp.lt.800.0D+0) then write(*,*) '------------------------------------' write(*,*) 'Warning:' write(*,*) 'High-temperature level was set to:',T_hitemp,' K' write(*,*) '------------------------------------' endif if (T_hitemp.gt.600.0D+0) then write(*,*) '------------------------------------' write(*,*) 'Warning:' write(*,*) 'High-temperature level was set to:',T_hitemp,' K' write(*,*) 'HITRAN databases are not accurate above 600K' write(*,*) '------------------------------------' endif c$$$ c$$$c ----------------------------------------------------------------------------------------- c$$$c Special settings c$$$ c$$$c set the percentage of lines to reject for k-computations to zero if line rejection c$$$c is enabled: this is because in the new algorithm for computing values of k(nu), line c$$$c rejection is already included. Removing more lines from the LBL data sets can only c$$$c cause confusion and errors. c$$$ if (rl.eq.1) then c$$$ pr_kc=0.0D+0 c$$$ endif c ----------------------------------------------------------------------------------------- c Control of LBL database presence c molparam.txt if (htv.eq.2004) then inquire(file='./data/molparam_hitran2004.txt',exist=ex) if (.not.ex) then call error(label) write(*,*) 'File could not be detected:' write(*,*) './data/molparam_hitran2004.txt' stop endif else if (htv.eq.2008) then inquire(file='./data/molparam_hitran2008.txt',exist=ex) if (.not.ex) then call error(label) write(*,*) 'File could not be detected:' write(*,*) './data/molparam_hitran2008.txt' stop endif else if (htv.eq.2012) then inquire(file='./data/molparam_hitran2012.txt',exist=ex) if (.not.ex) then call error(label) write(*,*) 'File could not be detected:' write(*,*) './data/molparam_hitran2012.txt' stop endif endif goto 421 c HITRAN write(htv_ch,14) htv htv_idx=htv_ch(3:4) base='./data/HITRAN'// & htv_ch(1:strlen(htv_ch)) inquire(file=base(1:strlen(base)),exist=ex) if (.not.ex) then call error(label) write(*,*) 'The HITRAN LBLdb has not been detected' write(*,*) 'Please refer to the manual for instructions:' write(*,*) 'Doc/manual.pdf' stop else nfiles=0 if (htv.eq.2004) then Nmol=39 else Nmol=42 endif do mol=1,Nmol if ((htv.eq.2004).and. & ((mol.eq.30).or.(mol.eq.35))) then goto 323 endif if ((htv.eq.2008).and. & ((mol.eq.30).or.(mol.eq.35).or.(mol.eq.42))) then goto 323 endif call num2str2(mol,str2) lblfile=base(1:strlen(base))// & '/'// & str2(1:strlen(str2))// & '_hit'// & htv_idx(1:strlen(htv_idx))// & '.par' c & '_hit08.par' nfiles=nfiles+1 file_list(nfiles)=lblfile 323 continue enddo ! mol nmissing=0 do i=1,nfiles lblfile=file_list(i) inquire(file=lblfile(1:strlen(lblfile)),exist=ex) if (.not.ex) then nmissing=nmissing+1 missing_file(nmissing)=lblfile endif enddo ! i if (nmissing.ne.0) then call error(label) write(*,*) 'The HITRAN directory was found,' write(*,*) 'but the following files are missing:' do i=1,nmissing lblfile=missing_file(i) write(*,*) lblfile(1:strlen(lblfile)) enddo ! missing stop endif endif c HITEMP and CDSD if (htsd_co2.eq.-1) then inquire(file='./data/CDSD1000',exist=ex) if (.not.ex) then call error(label) write(*,*) 'The CDSD-1000 transition database ' & //'has not been detected' write(*,*) 'Please refer to the manual for instructions:' write(*,*) 'Doc/manual.pdf' stop endif else if (htsd_co2.eq.0) then inquire(file='./data/CDSD1000_UPDATED',exist=ex) if (.not.ex) then call error(label) write(*,*) 'The CDSD-1000_UPDATED' & //' transition database ' & //'has not been detected' write(*,*) 'Please refer to the manual for instructions:' write(*,*) 'Doc/manual.pdf' stop endif else if (htsd_co2.eq.1) then inquire(file='./data/HITEMP-2010',exist=ex) if (.not.ex) then call error(label) write(*,*) 'The HITEMP-2010 transition database ' & //'has not been detected' write(*,*) 'Please refer to the manual for instructions:' write(*,*) 'Doc/manual.pdf' stop endif else if (htsd_co2.eq.2) then inquire(file='./data/CDSD-HITEMP',exist=ex) if (.not.ex) then call error(label) write(*,*) 'The CDSD-HITEMP transition database ' & //'has not been detected' write(*,*) 'Please refer to the manual for instructions:' write(*,*) 'Doc/manual.pdf' stop endif else if (htsd_co2.eq.3) then inquire(file='./data/CDSD_4000',exist=ex) if (.not.ex) then call error(label) write(*,*) 'The CDSD transition database ' & //' has not been detected' write(*,*) 'Please refer to the manual for instructions:' write(*,*) 'Doc/manual.pdf' stop endif endif ! htsd_co2 c if (htsd_h2o.eq.1) then inquire(file='./data/HITEMP',exist=ex) if (.not.ex) then call error(label) write(*,*) 'The HITEMP transition database ' & //'has not been detected' write(*,*) 'Please refer to the manual for instructions:' write(*,*) 'Doc/manual.pdf' stop endif else if (htsd_h2o.eq.2) then inquire(file='./data/HITEMP-2010',exist=ex) if (.not.ex) then call error(label) write(*,*) 'The HITEMP-2010 transition database ' & //'has not been detected' write(*,*) 'Please refer to the manual for instructions:' write(*,*) 'Doc/manual.pdf' stop endif endif ! htsd_h2o c ----------------------------------------------------------------------------------------- 421 continue c ----------------------------------------------------------------------------------------- c checking the presence of input data files tfile='./data/composition.in' inquire(file=tfile(1:strlen(tfile)),exist=ex) if (.not.ex) then ! file not found call error(label) write(*,*) 'File not found:',tfile(1:strlen(tfile)) stop endif if (sdis.eq.2) then tfile='./data/narrowbands.in' inquire(file=tfile(1:strlen(tfile)),exist=ex) if (.not.ex) then ! file not found call error(label) write(*,*) 'File not found:',tfile(1:strlen(tfile)) stop endif endif if (uaal.eq.2) then if ((i_inf.lt.1).or.(i_inf.gt.m)) then call error(label) write(*,*) 'Incorrect value specified in "data.in" for:' write(*,*) 'value of the first atmospheric level' stop endif if ((i_sup.lt.1).or.(i_sup.gt.m)) then call error(label) write(*,*) 'Incorrect value specified in "data.in" for:' write(*,*) 'value of the last atmospheric level' stop endif endif if ((sdis.eq.2).and.(uanb.eq.2)) then open(10,file='./data/narrowbands.in') read(10,*) Nb close(10) if ((band_inf.lt.1).or.(band_inf.gt.Nb)) then call error(label) write(*,*) 'Incorrect value specified in "data.in" for:' write(*,*) 'value of the first narrowband' stop endif if ((band_sup.lt.1).or.(band_sup.gt.Nb)) then call error(label) write(*,*) 'Incorrect value specified in "data.in" for:' write(*,*) 'value of the last narrowband' stop endif if (nlw_cz.le.0) then call error(label) write(*,*) 'Incorrect value specified in "data.in" for:' write(*,*) 'number of line widths to consider', & ' for a line''s central zone' stop endif if (np_lc.le.0) then call error(label) write(*,*) 'Incorrect value specified in "data.in" for:' write(*,*) 'number of points for line centers', & ' discretization' stop endif if (np_bl.le.0) then call error(label) write(*,*) 'Incorrect value specified in "data.in" for:' write(*,*) 'number of points for between-lines', & ' discretization' stop endif if (tr_dist.le.0.0D+0) then call error(label) write(*,*) 'Incorrect value specified in "data.in" for:' write(*,*) 'distance of line truncation' stop endif if (ngamma.le.0) then call error(label) write(*,*) 'Incorrect value specified in "data.in" for:' write(*,*) 'multiple of line width for line truncation' stop endif if ((pr_sd.lt.0.0D+0).or.(pr_sd.gt.1.0D+0)) then call error(label) write(*,*) 'Incorrect value specified in "data.in" for:' write(*,*) 'perc. of lines rejected for discretization' stop endif if ((pr_kc.lt.0.0D+0).or.(pr_kc.gt.1.0D+0)) then call error(label) write(*,*) 'Incorrect value specified in "data.in" for:' write(*,*) 'perc. of lines rejected for computation of k' stop endif endif if ((ucia).and.((ciac.eq.2).or.(ciac.eq.3))) then tfile='./data/CO2_dimer_data' inquire(file=tfile(1:strlen(tfile)),exist=ex) if (.not.ex) then ! file not found call error(label) write(*,*) 'Computing CIA from the work of Baranov 2004' write(*,*) 'requires an additional file "CO2_dimer_data"' write(*,*) 'within the "data" folder;' write(*,*) 'for more details on how to obtain this file,' write(*,*) 'please contact the author:' write(*,*) 'Vincent Eymet, v.eymet@gmail.com' write(*,*) stop endif endif c ----------------------------------------------------------------------------------------- c ----------------------------------------------------------------------------------------- c Various inconsistencies c If resuming an interrupted computation is required, the code will look for c optimizations/LBL_files.txt if ((over.eq.0).and.(rid)) then tfile='./optimizations/LBL_files.txt' inquire(file=tfile(1:strlen(tfile)),exist=ex) if (.not.ex) then ! file not found call error(label) write(*,*) 'Resume interrupted computation is required' write(*,*) 'But the following file is missing:' write(*,*) tfile(1:strlen(tfile)) stop endif endif c ----------------------------------------------------------------------------------------- c ----------------------------------------------------------------------------------------- c Control of Lorentz and Voigt functions tabulation files nf=0 call lorentztab_filename(sd_mxep,file_tab) inquire(file=file_tab(1:strlen(file_tab)),exist=ex) if (.not.ex) then ! file not found write(*,*) 'Warning: the Lorentz function must be tabulated' write(*,*) ' PLEASE WAIT !' x_min=-5.0D+3 x_max=5.0D+3 call lorentz_tabulation(sd_mxep,x_min,x_max,file_tab) nf=1 endif call voigttab_filename(sd_mxep,file_tab) inquire(file=file_tab(1:strlen(file_tab)),exist=ex) if (.not.ex) then ! file not found write(*,*) 'Warning: the Voigt function must be tabulated' write(*,*) ' PLEASE WAIT !' y_min=1.0D-5 nint_y=200 call voigt_tabulation(sd_mxep,y_min,nint_y,file_tab) nf=1 endif c set rights for the new file: nobody should be able to modify it ! if (nf.eq.1) then command='chmod a-w ./data/tabulation*.txt' call exec(command) endif c ----------------------------------------------------------------------------------------- return end