c Copyright (C) 2008-2014 Vincent Eymet c c KDISTRIBUTION is free software; you can redistribute it and/or modify c it under the terms of the GNU General Public License as published by c the Free Software Foundation; either version 3, or (at your option) c any later version. c KDISTRIBUTION 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 You should have received a copy of the GNU General Public License c along with KDISTRIBUTION; if not, see c subroutine make_model(base,m,alt,pres,temp, & Nmol,molec_names,molar_fraction,filelist) implicit none include 'max.inc' include 'formats.inc' c c Purpose: to build the list of thermodynamic conditions k-distribution data sets c have to be compute for c c Input: c + base: name of the folder that contains high-resolution spectra c c Output: c + m: number of atmospheric levels c + alt: atltitude for each level (m) c + pres: pressure for each level (atm) c + temp: temperature for each level (K) c + Nmol: number of molecular species for each level c + molec_names: name of each molecular species, for each level c + molar_fraction: molar fraction of each species, for each level c + filelist: list of files that DO contain HR spectra c c I/O character*(Nchar_mx) base integer m double precision alt(1:Nmax) double precision pres(1:Nmax) double precision temp(1:Nmax) integer Nmol(1:Nmax) character*(Nchar_mx) molec_names(1:Nmax,1:Nmol_mx) double precision molar_fraction(1:Nmax,1:Nmol_mx) character*(Nchar_mx) filelist(1:Nmax) c temp integer ifolder,ifile integer Nfolders,Nfiles character*(Nchar_mx) folders(1:Nf_mx) character*(Nchar_mx) files(1:Nf_mx) logical is_hr_spectrum integer Nmolec,imol double precision P double precision T double precision x(1:Nmol_mx) character*(Nchar_mx) molname(1:Nmol_mx) c label integer strlen character*(Nchar_mx) label label='subroutine make_model' c Debug c write(*,*) 'base=',base(1:strlen(base)) c Debug call base_list(base, & Nfolders,folders,Nfiles,files) c Debug c write(*,*) 'Nfolders=',Nfolders c do ifolder=1,Nfolders c write(*,*) 'folder(',ifolder,')=', c & folders(ifolder)(1:strlen(folders(ifolder))) c enddo ! ifolder c write(*,*) 'Nfiles=',Nfiles c do ifile=1,Nfiles c write(*,*) 'file(',ifile,')=', c & files(ifile)(1:strlen(files(ifile))) c enddo ! ifile c stop c Debug m=0 do ifile=1,Nfiles call hr_spectrum_file(files(ifile),is_hr_spectrum, & Nmolec,P,T,molname,x) c Debug c write(*,*) 'file=',files(ifile)(1:strlen(files(ifile))) c write(*,*) 'is_hr_spectrum=',is_hr_spectrum c if (is_hr_spectrum) then c write(*,*) 'P=',P c write(*,*) 'T=',T c do imol=1,Nmol c write(*,*) 'molname=', c & molname(imol)(1:strlen(molname(imol))) c write(*,*) 'x(',imol,'=',x(imol) c enddo ! imol c endif c Debug if (is_hr_spectrum) then m=m+1 if (m.gt.Nmax) then call error(label) write(*,*) 'm=',m write(*,*) 'while Nmax=',Nmax stop endif alt(m)=0.0D+0 ! m pres(m)=P ! atm temp(m)=T ! K Nmol(m)=Nmolec do imol=1,Nmolec molar_fraction(m,imol)=x(imol) molec_names(m,imol)= & molname(imol)(1:strlen(molname(imol))) enddo ! imol filelist(m)=files(ifile)(1:strlen(files(ifile))) endif ! is_hr_spectrum enddo ! ifile return end subroutine hr_spectrum_file(infile,is_hr_spectrum, & Nmol,P,T,molname,x) implicit none include 'formats.inc' include 'max.inc' include 'mpif.h' c c Purpose: to check whether or not a given file is a high-resolution spectrum file c c Input: c + infile: input file to analyze c c Output: c + is_hr_spectrum: true if "infile" is a high-resolution spectrum file c + Nmol: number of molecular species used to compute the HR spectrum if is_hr_spectrum=true c + P: pressure (atm) used to compute the HR spectrum if is_hr_spectrum=true c + T: temperature (K) used to compute the HR spectrum if is_hr_spectrum=true c + molname: name of each molecular species c + x: concentration (molar fraction) of each molecular species used to compute the HR spectrum if is_hr_spectrum=true c c I/O character*(Nchar_mx) infile logical is_hr_spectrum integer Nmol double precision P double precision T character*(Nchar_mx) molname(1:Nmol_mx) double precision x(1:Nmol_mx) c temp integer imol,i integer nl character*(Nchar_mx) expression logical exist_p,exist_t,exist_x integer pindex,ierr,ios c label integer strlen character*(Nchar_mx) label label='subroutine hr_spectrum_file' c Debug c write(*,*) 'infile=',infile(1:strlen(infile)) c Debug c Get 'pindex', the index of the current process call MPI_COMM_RANK(MPI_COMM_WORLD,pindex,ierr) c look for common expression that should be in HR spectra files expression='Pressure (atm):' call look_for_expression(infile,expression,exist_p) expression='Temperature (K):' call look_for_expression(infile,expression,exist_t) expression='Number of molecules:' call look_for_expression(infile,expression,exist_x) c Debug c write(*,*) 'exist=',exist_p,exist_t,exist_x c Debug if (exist_p.and.exist_t.and.exist_x) then is_hr_spectrum=.true. else is_hr_spectrum=.false. endif if (is_hr_spectrum) then open(10,file=infile(1:strlen(infile)), & status='old',iostat=ios) if (ios.ne.0) then call error(label) write(*,*) 'File not found:' write(*,*) infile(1:strlen(infile)) stop endif read(10,*) read(10,*) P read(10,*) read(10,*) T read(10,*) read(10,*) Nmol read(10,*) do imol=1,Nmol do i=1,2 read(10,*) enddo ! i read(10,10) molname(imol) read(10,*) read(10,*) x(imol) enddo ! imol endif return end subroutine look_for_expression(infile,expression,exist) implicit none include 'max.inc' include 'mpif.h' c c Purpose: to locate a given text string into a given file c c Input: c + infile: file to search c + expression: expression to locate c c Output: c + exist: true if expression has been found in infile c c I/O character*(Nchar_mx) infile character*(Nchar_mx) expression logical exist c temp character*(Nchar_mx) command character*(Nchar_mx) tfile integer nl integer pindex,ierr c label integer strlen character*(Nchar_mx) label label='subroutine look_for_expression' c Get 'pindex', the index of the current process call MPI_COMM_RANK(MPI_COMM_WORLD,pindex,ierr) tfile='./grep_res' command='grep ' & //'"' & //expression(1:strlen(expression)) & //'"' & //' ' & //infile(1:strlen(infile)) & //' > ' & //tfile(1:strlen(tfile)) c Debug c write(*,*) 'command:' c write(*,*) command(1:strlen(command)) c Debug call exec(command) call get_nlines(tfile,pindex,nl) if (nl.eq.0) then exist=.false. else exist=.true. endif return end