!********************************************************** MODULE MODHII real, allocatable :: zgas(:),qhi(:),qx(:),qhei(:),qo(:),lines(:,:) integer, allocatable :: gridn(:) real :: zup,zlow integer :: diz,kk1,kk2 integer :: n_mod contains !************************************************************ ! ! This subroutine reads HII region libraries ! SUBROUTINE READHII(filename) use MODRIGHE, only: nr_tot implicit none character(len=*) :: filename character(len=1) :: a integer :: i integer, allocatable :: intlines(:,:) ! write(*,'(a)')"reading HII library "//filename//".dat ...." ! it count the numbers of rows in the file open(unit=88,file=filename//'.dat',status='old') n_mod=-1 ! there is one header row do read(unit=88,fmt='(a)',end=100)a n_mod=n_mod+1 enddo 100 continue close(88) ! deallocation of arrays if already allocated if (allocated(zgas)) then deallocate(zgas) deallocate(qhi) deallocate(qx) deallocate(qhei) deallocate(qo) deallocate(gridn) deallocate(lines) endif allocate(zgas(n_mod)) allocate(qhi(n_mod)) allocate(qx(n_mod)) allocate(qhei(n_mod)) allocate(qo(n_mod)) allocate(gridn(n_mod)) allocate(lines(nr_tot,n_mod),intlines(nr_tot,n_mod)) open(unit=88,file=filename//'.dat',status='old') read(88,fmt='(a)')a do i=1,n_mod read(88,500)gridn(i),zgas(i),qhi(i),qx(i),qhei(i),qo(i),intlines(:,i) enddo close(88) write(*,*)"OK!" qhi=10.**qhi qx=10.**qx where (qhei .gt.-33.) qhei=10.**qhei elsewhere qhei=0. end where where (qhei .gt.-33.) qo=10.**qo elsewhere qo=0. end where where (intlines .ne. 0) lines=exp(intlines/1000.-50.) ! [lines]=10^30 erg/s elsewhere lines=0. endwhere deallocate(intlines) ! gridn,zgas, qhi, qx, qhei, qo,intfluxriga 500 format (14x,i1,1x,f5.4,8x,f8.4,1x,f8.4,1x,f8.4,1x,f8.4,1x,114i5) END SUBROUTINE READHII end MODULE MODHII