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 generate_base(T,planet_descriptor,Nmol,mol_index, & iso_index,mol_niso,mol_name,custom_db,htv, & T_hitemp,htsd_co2,htsd_h2o,nis,Nb,nu_low,nu_hi,over,rid, & n,filename,Tref,fformat,Npass,nl_lp,large_db) implicit none c c Purpose: to select spectroscopic database according to c temperature level, and molecule name c c Input: c + T: temperature c + planet_descriptor: string that identifies the atmosphere c + Nmol: number of molecules present at level i c + mol_index: indexes of molecules present at level i c + iso_index: indexes (using HITRAN convention) of isotopes c + mol_niso: number of isotopes for each molecule c + mol_name: name of each one of the "Nmol" species c + custom_db: option tu use custom LBL databases c + htv: version of the HITRAN database to use c + htsd_co2: defined in "options.in" c - htsd_co2=-1 if CDSD-1000 has to be used for CO2 @ T>T_hitemp c - htsd_co2=0 if CDSD-1000 UPDATED has to be used for CO2 @ T>T_hitemp c - htsd_co2=1 if HITEMP-2010 has to be used for CO2 @ T>T_hitemp c - htsd_co2=2 if CDSD-HITEMP has to be used for CO2 @ T>T_hitemp c - htsd_co2=3 if CDSD-4000 has to be used for CO2 @ T>T_hitemp c + htsd_h2o: defined in "options.in" c - htsd_h2o=1 if HITEMP has to be used for H2O @ T>T_hitemp c - htsd_h2o=2 if HITEMP-2010 has to be used for H2O @ T>T_hitemp c + nis: option (1: use main isotope only, 2: use all isotopes) c c Output: c + n: number of files that contain relevant spectroscopic data c + filename: names of the files that contains relevant spectrocopic data c + Tref: reference temperature for the relevant spectrocopic data c + fformat: integer that defines the format spectral database is written in c - fformat=1: HITRAN c - fformat=2: HITEMP c - fformat=3: CDSD-4000 c include 'max.inc' include 'descriptors.inc' include 'formats.inc' include 'mpif.h' c I/O double precision T character*(Nchar_mx) planet_descriptor integer Nmol integer mol_index(1:Nmol_max) integer iso_index(1:Nmol_max,1:Niso_max) integer mol_niso(1:Nmol_max) character*10 mol_name(1:Nmol_max) logical custom_db integer htv integer htsd_co2 integer htsd_h2o integer nis integer Nb double precision nu_low(1:Nbmx) double precision nu_hi(1:Nbmx) integer over logical rid integer n character*(Nchar_mx) filename(1:nfiles_mx) double precision Tref(1:Nmol_max) integer fformat(1:nfiles_mx) integer Npass integer nl_lp logical large_db c temp integer n_tmp character*(Nchar_mx) filename_tmp(1:nfiles_mx) integer mol,nl_total,nl integer nlf(1:nfiles_mx) integer idx,ff,i,ifile integer fidx1,fidx2 character*2 idx_str character*(Nchar_mx) base,list_file character*(Nchar_mx) command character*(Nchar_mx) file_database character*(Nchar_mx) linesp_file integer nk double precision slimits1(1:Nti_mx,2) character*4 htv_ch character*2 htv_idx,hitran_suffix double precision T_hitemp logical HT,HT2010,CDSDHT,CDSD4000,CDSD1000,CDSD1000UP,ex integer ios character*(Nchar_mx) lbl_file c MPI integer ierr,np,pindex integer stat(MPI_STATUS_SIZE) integer chunk,nchunks integer code0 integer proc,fin,fpf integer free(1:Nproc_mx) integer nsp c MPI c label integer strlen character*(Nchar_mx) label label='subroutine generate_base' CALL MPI_COMM_SIZE(MPI_COMM_WORLD,np,ierr) CALL MPI_COMM_RANK(MPI_COMM_WORLD,pindex,ierr) if (.not.custom_db) then c check if HITEMP is installed HT=.false. inquire(file='./data/HITEMP/', & exist=ex) if (.not.ex) then HT=.false. else HT=.true. endif c check if HITEMP-2010 is installed HT2010=.false. inquire(file='./data/HITEMP-2010/', & exist=ex) if (.not.ex) then HT2010=.false. else HT2010=.true. endif c check if CDSD-HITEMP is installed CDSDHT=.false. inquire(file='./data/CDSD-HITEMP/', & exist=ex) if (.not.ex) then CDSDHT=.false. else CDSDHT=.true. endif c check if CDSD-4000 is installed inquire(file='./data/CDSD_4000/', & exist=ex) if (.not.ex) then CDSD4000=.false. else CDSD4000=.true. endif large_db=.false. c check if CDSD-1000 is installed inquire(file='./data/CDSD1000/', & exist=ex) if (.not.ex) then CDSD1000=.false. else CDSD1000=.true. endif large_db=.false. c check if CDSD-1000_UPDATED is installed inquire(file='./data/CDSD1000_UPDATED/', & exist=ex) if (.not.ex) then CDSD1000UP=.false. else CDSD1000UP=.true. endif large_db=.false. endif ! custom_db=F c 2013-10-30 c Force HT2010 to TRUE HT2010=.true. c 2013-10-30 write(htv_ch,14) htv htv_idx=htv_ch(3:4) if (pindex.eq.0) then ! root process only n=0 c when using custom LBL databases if (custom_db) then base='./data/custom_LBL/' inquire(file=base(1:strlen(base)),exist=ex) if (.not.ex) then call error(label) write(*,*) 'Custom LBL database required' write(*,*) 'but the corresponding folder was not found:' write(*,*) base(1:strlen(base)) stop endif do mol=1,Nmol idx=mol_index(mol) n=n+1 filename(n)=base(1:strlen(base))// & 'custom_'// & mol_name(mol)(1:strlen(mol_name(mol)))// & '.txt' Tref(idx)=296.0D+0 ! K fformat(n)=1 ! HITRAN format inquire(file=filename(n)(1:strlen(filename(n))),exist=ex) if (.not.ex) then call error(label) write(*,*) 'Custom LBL database required for:' write(*,*) mol_name(mol)(1:strlen(mol_name(mol))) write(*,*) 'but the corresponding file was not found:' write(*,*) filename(n)(1:strlen(filename(n))) stop endif enddo ! mol large_db=.false. goto 421 endif ! custom_db do mol=1,Nmol idx=mol_index(mol) ff=0 c Debug c write(*,*) 'idx=',idx c Debug if (idx.eq.1) then ! H2O c Debug c write(*,*) 'This is: ',label(1:strlen(label)) c write(*,*) 'T=',T,' T_hitemp=',T_hitemp c Debug if (T.ge.T_hitemp) then c Debug c write(*,*) 'HT2010=',HT2010 c Debug if (htsd_h2o.eq.1) then if (HT) then ! HITEMP base='./data/HITEMP/' n=n+1 filename(n)=base(1:strlen(base))// & '01_1000k.par' fformat(n)=2 Tref(idx)=296.0D+0 ! K ff=1 else ! HT=false call error(label) write(*,*) 'HITEMP database ' & //'is required' write(*,*) 'But is not installed' write(*,*) 'custom_db=',custom_db inquire(file='./data/HITEMP/', & exist=ex) write(*,*) './data/HITEMP exist=',ex stop endif ! HITEMP else if (htsd_h2o.eq.2) then if (HT2010) then ! HITEMP-2010 base='./data/HITEMP-2010/H2O_line_list/' & //'Uncompressed_files/' list_file='./optimizations/list.txt' command='./bash/list_HT2010.bash '// & base(1:strlen(base))// & ' '// & list_file(1:strlen(list_file)) call exec(command) call get_list(list_file,n_tmp,filename_tmp) do ifile=1,n_tmp n=n+1 filename(n)=filename_tmp(ifile) & (1:strlen(filename_tmp(ifile))) fformat(n)=1 enddo Tref(idx)=296.0D+0 ! K ff=1 else ! HT2010=false call error(label) write(*,*) 'HITEMP-2010 database ' & //'is required' write(*,*) 'But is not installed' write(*,*) 'custom_db=',custom_db inquire(file='./data/HITEMP-2010/', & exist=ex) write(*,*) './data/HITEMP-2010 exist=',ex stop endif ! HITEMP-2010 endif ! htsd c endif ! T > T_hitemp else if (idx.eq.2) then ! CO2 c Debug c write(*,*) '--------------------------------------------' c write(*,*) 'planet_descriptor=', c & planet_descriptor(1:strlen(planet_descriptor)) c write(*,*) 'T_hitemp=',T_hitemp c write(*,*) 'T=',T c write(*,*) 'htsd_co2=',htsd_co2 c write(*,*) 'HT2010=',HT2010 c write(*,*) 'CDSD4000=',CDSD4000 c write(*,*) '--------------------------------------------' c Debug if (T.ge.T_hitemp) then if (htsd_co2.eq.-1) then ! use CDSD-1000 if (CDSD1000) then ! CDSD-1000 base='./data/CDSD1000/' list_file='./optimizations/list.txt' command='./bash/list_CDSD4000.bash '// & base(1:strlen(base))// & ' '// & list_file(1:strlen(list_file)) call exec(command) call get_list(list_file,n_tmp,filename_tmp) do ifile=1,n_tmp n=n+1 filename(n)=filename_tmp(ifile) & (1:strlen(filename_tmp(ifile))) fformat(n)=1 enddo Tref(idx)=1000.0D+0 ! K ff=1 else ! CDSD1000=false call error(label) write(*,*) 'CDSD-1000 database ' & //'is required' write(*,*) 'But is not installed' write(*,*) 'custom_db=',custom_db inquire(file='./data/CDSD1000/', & exist=ex) write(*,*) './data/CDSD1000 exist=',ex stop endif ! CDSD1000 else if (htsd_co2.eq.0) then ! use CDSD-1000_UPDATED if (CDSD1000UP) then ! CDSD-1000_UPDATED base='./data/CDSD1000_UPDATED/' list_file='./optimizations/list.txt' command='./bash/list_CDSD4000.bash '// & base(1:strlen(base))// & ' '// & list_file(1:strlen(list_file)) call exec(command) call get_list(list_file,n_tmp,filename_tmp) do ifile=1,n_tmp n=n+1 filename(n)=filename_tmp(ifile) & (1:strlen(filename_tmp(ifile))) fformat(n)=1 enddo Tref(idx)=1000.0D+0 ! K ff=1 else ! CDSD1000UP=false call error(label) write(*,*) 'CDSD-1000_UPDATED database ' & //'is required' write(*,*) 'But is not installed' write(*,*) 'custom_db=',custom_db inquire(file='./data/CDSD1000_UPDATED/', & exist=ex) write(*,*) './data/CDSD1000_UPDATED exist=',ex stop endif ! CDSD1000UP else if (htsd_co2.eq.1) then ! use HITEMP-2010 if (HT2010) then ! HITEMP-2010 base='./data/HITEMP-2010/CO2_line_list/' & //'Uncompressed_files/' list_file='./optimizations/list.txt' command='./bash/list_HT2010.bash '// & base(1:strlen(base))// & ' '// & list_file(1:strlen(list_file)) call exec(command) call get_list(list_file,n_tmp,filename_tmp) do ifile=1,n_tmp n=n+1 filename(n)=filename_tmp(ifile) & (1:strlen(filename_tmp(ifile))) fformat(n)=1 enddo Tref(idx)=296.0D+0 ! K ff=1 else ! HT2010=false call error(label) write(*,*) 'HITEMP-2010 database ' & //'is required' write(*,*) 'But is not installed' write(*,*) 'custom_db=',custom_db inquire(file='./data/HITEMP-2010/', & exist=ex) write(*,*) './data/HITEMP-2010 exist=',ex stop endif ! HT2010 else if (htsd_co2.eq.2) then ! use CDSD-HITEMP if (CDSDHT) then base='./data/CDSD-HITEMP/' list_file='./optimizations/list.txt' command='./bash/list_CDSD-HITEMP.bash '// & base(1:strlen(base))// & ' '// & list_file(1:strlen(list_file)) call exec(command) call get_list(list_file,n_tmp,filename_tmp) do ifile=1,n_tmp n=n+1 filename(n)=filename_tmp(ifile) & (1:strlen(filename_tmp(ifile))) fformat(n)=1 ! HITRAN2008 format enddo Tref(idx)=296.0D+0 ! K ff=1 else ! CDSDHT=false call error(label) write(*,*) 'CDSD-HITEMP database ' & //'is required' write(*,*) 'But is not installed' stop endif ! CDSDHT else if (htsd_co2.eq.3) then ! if htsd_co2=2 -> use CDSD-4000 if (CDSD4000) then base='./data/CDSD_4000/' list_file='./optimizations/list.txt' command='./bash/list_CDSD4000.bash '// & base(1:strlen(base))// & ' '// & list_file(1:strlen(list_file)) call exec(command) call get_list(list_file,n_tmp,filename_tmp) do ifile=1,n_tmp n=n+1 filename(n)=filename_tmp(ifile) & (1:strlen(filename_tmp(ifile))) fformat(n)=3 ! CDSD4000 format enddo Tref(idx)=296.0D+0 ! K ff=1 large_db=.true. else ! CDSD4000=false call error(label) write(*,*) 'CDSD-4000 database ' & //'is required' write(*,*) 'But is not installed' stop endif ! CDSD4000 else call error(label) write(*,*) 'Bad input parameter:' write(*,*) 'htsd_co2=',htsd_co2 stop endif ! htsd_co2 endif ! T > T_hitemp else if (idx.eq.5) then ! CO if (T.ge.T_hitemp) then if (HT2010) then ! HITEMP-2010 base='./data/HITEMP-2010/CO_line_list/' & //'Uncompressed_files/' n=n+1 filename(n)=base(1:strlen(base))// & '05_HITEMP2010.par' Tref(idx)=296.0D+0 ! K fformat(n)=1 ff=1 else ! old HITEMP ff=1 base='./data/HITEMP/' n=n+1 filename(n)=base(1:strlen(base))// & '05_hot.par' Tref(idx)=296.0D+0 ! K fformat(n)=2 endif endif else if (idx.eq.8) then ! NO if (T.ge.T_hitemp) then if (HT2010) then ! HITEMP-2010 base='./data/HITEMP-2010/NO_line_list/' & //'Uncompressed_files/' n=n+1 filename(n)=base(1:strlen(base))// & '08_HITEMP2010.par' Tref(idx)=296.0D+0 ! K fformat(n)=1 ff=1 endif endif else if (idx.eq.13) then ! OH if (T.ge.T_hitemp) then if (HT2010) then ! HITEMP-2010 base='./data/HITEMP-2010/OH_line_list/' & //'Uncompressed_files/' n=n+1 filename(n)=base(1:strlen(base))// & '13_HITEMP2010.par' Tref(idx)=296.0D+0 ! K fformat(n)=1 ff=1 else ! old HITEMP ff=1 base='./data/HITEMP/' n=n+1 filename(n)=base(1:strlen(base))// & '13_HIT2K.PAR' Tref(idx)=296.0D+0 ! K fformat(n)=2 endif endif endif ! idx 123 continue c Debug c write(*,*) 'ff=',ff c Debug if (ff.eq.0) then ! all other cases => HITRAN base='./data/HITRAN'// & htv_ch(1:strlen(htv_ch))// & '/' n=n+1 call idx2str(idx,idx_str) hitran_suffix=htv_idx(1:strlen(htv_idx)) if (htv.eq.2012) then c Some files in the HITRAN2012 data set c are taken from the 2008 version if ((idx.eq.4) & .or.(idx.eq.8) & .or.(idx.eq.23) & .or.(idx.eq.25) & .or.(idx.eq.30) & .or.(idx.eq.32) & .or.(idx.eq.34) & .or.(idx.eq.35) & .or.(idx.eq.38) & .or.(idx.eq.39) & .or.(idx.eq.40) & .or.(idx.eq.41) & .or.(idx.eq.42)) then hitran_suffix='08' endif endif filename(n)=base(1:strlen(base)) & //idx_str(1:strlen(idx_str)) & //'_hit' & //hitran_suffix(1:strlen(hitran_suffix)) & //'.par' Tref(idx)=296.0D+0 ! K fformat(n)=1 endif enddo ! mol 421 continue c Debug c do ifile=1,n c write(*,*) ifile,filename(ifile)(1:strlen(filename(ifile))) c enddo ! ifile c Debug c Check all LBL files do exist c do ifile=1,n c inquire(file=filename(ifile)(1:strlen(filename(ifile))), c & exist=ex) c if (.not.ex) then c write(*,*) 'Error from ',label(1:strlen(label)),' :' c write(*,*) 'File index:',ifile,' /',n c write(*,*) filename(ifile)(1:strlen(filename(ifile))) c write(*,*) 'Do not exist' c stop c endif c enddo ! ifile c Debug c write(*,*) 'All files do exist' c Debug lbl_file='./optimizations/LBL_files.txt' if ((over.eq.0).and.(rid)) then open(12,file=lbl_file(1:strlen(lbl_file)) & ,status='old',iostat=ios) if (ios.ne.0) then ! list_file not found call error(label) write(*,*) 'File could not be found:' write(*,*) lbl_file(1:strlen(lbl_file)) stop else read(12,*) n do ifile=1,n read(12,37) fformat(ifile),nlf(ifile),filename(ifile) enddo close(12) endif ! ios call calc_nl_total(n,filename,fformat,nlf, & nis,Nmol,mol_index,iso_index,mol_niso, & nl_total) rid=.false. else ! over=1 or rid=F write(*,*) 'Parsing LBL data files...' c Debug c write(*,*) 'calling calc_slimits1' c Debug call calc_slimits1(Nb,nu_low,nu_hi,large_db,nk,slimits1) c Debug c write(*,*) 'done' c Debug c Debug c write(*,*) 'Now producing file LBL_files.txt' c write(*,*) 'n=',n c Debug linesp_file='./nlines' open(12,file=lbl_file(1:strlen(lbl_file))) write(12,*) n do ifile=1,n c Debug c write(*,*) 'ifile:',ifile c Debug file_database=filename(ifile) c Debug c write(*,*) 'file_database=',file_database c Debug call get_nlines(file_database,linesp_file,nlf(ifile)) c Debug c write(*,*) 'nlf(',ifile,')=',nlf(ifile) c Debug write(12,37) fformat(ifile),nlf(ifile),filename(ifile) enddo close(12) c Debug c write(*,*) 'LBL_files.txt finished' c write(*,*) 'Now calling calc_nl_total, nis=',nis c Debug call calc_nl_total(n,filename,fformat,nlf, & nis,Nmol,mol_index,iso_index,mol_niso, & nl_total) c Debug c write(*,*) 'Now parsing files...' c Debug nchunks=n code0=7 ! data transfer do proc=1,np-1 call MPI_SEND(code0,1,MPI_INTEGER & ,proc,1,MPI_COMM_WORLD,ierr) enddo c send integer data call MPI_BCAST(nk,1,MPI_INTEGER & ,0,MPI_COMM_WORLD,ierr) c send double precision data call MPI_BCAST(slimits1,Nti_mx*2,MPI_DOUBLE_PRECISION & ,0,MPI_COMM_WORLD,ierr) do proc=1,np-1 free(proc)=1 enddo fin=0 chunk=0 do while(fin.eq.0) 444 continue call find_free_process(free,np-1,fpf,proc) if (fpf.eq.1) then ! a free child process found chunk=chunk+1 if (chunk.le.nchunks) then code0=8 call MPI_SEND(code0,1,MPI_INTEGER & ,proc,1,MPI_COMM_WORLD,ierr) call MPI_SEND(chunk,1,MPI_INTEGER & ,proc,1,MPI_COMM_WORLD,ierr) free(proc)=0 ! child process index 'proc' is busy else ! chunk>nchunks free(proc)=2 ! means child process index 'proc' has been stopped endif goto 444 else ! no free child process found call stopped_processes(free,np-1,nsp) if (nsp.eq.np-1) then fin=1 goto 111 endif c wait for task to achieve call MPI_RECV(proc,1,MPI_INTEGER & ,MPI_ANY_SOURCE,MPI_ANY_TAG,MPI_COMM_WORLD, & stat,ierr) free(proc)=1 ! child process index 'proc' is free again endif ! fpf=0 or 1 111 continue enddo ! while fin=0 write(*,*) '...done' endif ! pindex endif ! raz c Debug c write(*,*) 'nl_total=',nl_total c write(*,*) 'Nline_mx=',Nline_mx c write(*,*) 'nl_total/Nline_mx=',nl_total/Nline_mx c Debug Npass=nl_total/Nline_mx+1 nl_lp=nl_total-Nline_mx*(Npass-1) c Debug write(*,*) '--------------------------' write(*,*) 'Npass=',Npass c write(*,*) 'nl_lp=',nl_lp write(*,*) '--------------------------' c stop c Debug return end subroutine calc_nl_total(Nfiles,filename,fformat,nlf, & nis,Nmol,mol_index,iso_index,mol_niso, & nl_total) implicit none include 'max.inc' include 'formats.inc' c c Purpose: to compute the total number of lines that must be c taken into account c c I/O integer Nfiles character*(Nchar_mx) filename(1:nfiles_mx) integer fformat(1:nfiles_mx) integer nlf(1:nfiles_mx) integer nis,Nmol integer mol_index(1:Nmol_max) integer iso_index(1:Nmol_max,1:Niso_max) integer mol_niso(1:Nmol_max) integer nl_total c temp integer index_tmp,isotope_tmp integer molec,isotop integer isof integer ifile,ios,line character*(Nchar_mx) file_database integer strlen character*(Nchar_mx) label label='subroutine calc_nl_total' write(*,*) 'Computing total number of lines...' nl_total=0 c Debug c write(*,*) 'This is calc_nl_total, nis=',nis c Debug if (nis.eq.2) then ! use all isotopes do ifile=1,Nfiles nl_total=nl_total+nlf(ifile) enddo ! ifile else ! use limited number of isotopes do ifile=1,Nfiles c Debug c write(*,*) 'working on file',ifile,'/',Nfiles,':' c write(*,*) filename(ifile)(1:strlen(filename(ifile))) c Debug if ((fformat(ifile).lt.1).or.(fformat(ifile).gt.3)) then call error(label) write(*,*) 'fformat(',ifile,')=',fformat(ifile) stop endif file_database=filename(ifile) open(10,file=file_database(1:strlen(file_database)) & ,status='old',iostat=ios) if (ios.ne.0) then ! file not found call error(label) write(*,*) 'File could not be opened:', & file_database(1:strlen(file_database)) stop else do line=1,nlf(ifile) if (fformat(ifile).eq.1) then ! HITRAN file read(10,60) index_tmp ! molecule number [unitless] & ,isotope_tmp ! isotopologue number [unitless] else if (fformat(ifile).eq.2) then ! HITEMP file read(10,70) index_tmp ! molecule number [unitless] & ,isotope_tmp ! isotopologue number [unitless] else if (fformat(ifile).eq.3) then ! CDSD file read(10,60) index_tmp ! molecule number [unitless] & ,isotope_tmp ! isotopologue number [unitless] endif isof=0 call indexes(Nmol,mol_index,iso_index, & mol_niso,index_tmp,isotope_tmp,molec,isotop,isof) if (isof.eq.1) then nl_total=nl_total+1 endif enddo ! line endif ! ios.ne.0 c Debug c write(*,*) 'nl_total=',nl_total c Debug enddo ! ifile endif c Debug c write(*,*) 'nl_total=',nl_total c Debug return end subroutine slimits_filename(i,filename) implicit none include 'max.inc' integer i,strlen character*(Nchar_mx) filename,base character*4 ich4 call num2str4(i,ich4) base='./optimizations/slimits' filename=base(1:strlen(base))// & ich4(1:strlen(ich4))// & '.txt' return end subroutine idx2str(idx,idx_str) implicit none include 'max.inc' include 'formats.inc' integer idx,strlen character*1 zero_ch,idx_str1 character*2 idx_str write(zero_ch,11) 0 if (idx.lt.10) then write(idx_str1,11) idx idx_str=zero_ch(1:strlen(zero_ch))// & idx_str1(1:strlen(idx_str1)) else write(idx_str,12) idx endif return end subroutine cdsd_file(nu,err,fidx,filename) implicit none include 'max.inc' integer fidx,strlen,err double precision nu character*2 idx_str character*(Nchar_mx) filename if (nu.lt.628.59D+0) then fidx=-1 else if ((nu.gt.263.42D+0).and.(nu.le.628.59D+0)) then fidx=1 else if ((nu.gt.628.59D+0).and.(nu.le.709.91D+0)) then fidx=2 else if ((nu.gt.709.91D+0).and.(nu.le.851.41D+0)) then fidx=3 else if ((nu.gt.851.41D+0).and.(nu.le.2046.96D+0)) then fidx=4 else if ((nu.gt.2046.96D+0).and.(nu.le.2159.43D+0)) then fidx=5 else if ((nu.gt.2159.43D+0).and.(nu.le.2231.82D+0)) then fidx=6 else if ((nu.gt.2231.82D+0).and.(nu.le.3294.49D+0)) then fidx=7 else if ((nu.gt.3294.49D+0).and.(nu.le.3570.21D+0)) then fidx=8 else if ((nu.gt.3570.21D+0).and.(nu.le.4723.47D+0)) then fidx=9 else if ((nu.gt.4723.47D+0).and.(nu.le.9648.02D+0)) then fidx=10 else if (nu.gt.9648.02D+0) then fidx=-1 endif if (fidx.eq.-1) then err=1 goto 123 else err=0 endif call idx2str(fidx,idx_str) filename='cdsd_1000.'//idx_str(1:strlen(idx_str)) 123 continue return end subroutine get_list(list_file,Nfiles,files) implicit none include 'max.inc' c c Purpose: to get the number of files, and their path, from a list file c that was created using the "bash/list.bash" script c c Input: c + list_file: list file produced by the bash/list.bash script c c Output: c + Nfiles: number of files c + files: array of files path c c I/O character*(Nchar_mx) list_file integer Nfiles character*(Nchar_mx) files(1:nfiles_mx) c temp integer nl,i,ios character*(Nchar_mx) line c label integer strlen character*(Nchar_mx) label label='subroutine get_list' call get_nlines(list_file,1,nl) c Debug c write(*,*) 'nl=',nl c Debug if (nl.gt.nfiles_mx) then call error(label) write(*,*) 'nl=',nl write(*,*) 'while nfiles_mx=',nfiles_mx stop endif Nfiles=nl c Debug c write(*,*) 'Nfiles=',Nfiles c Debug open(11,file=list_file(1:strlen(list_file)) & ,status='old',iostat=ios) if (ios.ne.0) then ! list_file not found call error(label) write(*,*) 'file could not be found:' write(*,*) list_file(1:strlen(list_file)) stop endif do i=1,Nfiles read(11,'(a)') line files(i)=line(1:strlen(line)) c Debug c write(*,*) 'files(',i,')=',files(i)(1:strlen(files(i))) c Debug enddo close(11) return end