! GeGetResources.f90 ! ! Read the resources from file and allocate the refering ! prototype particle and decay lists. ! ! Detlef Irmscher, Thomas Ullrich, Uni Heidelberg, September 1993 ! Last update: 16.3.95 tu - bug in GeGetLine corrected ! ! Port to DECUnix: 28.11.97, R.Holzmann ! subroutine GeGetResources use genesis_m, self=>GeGetResources implicit none integer :: ierr, nparticles, ndecays character(len=80) :: resource, value ! ! Open resource file: ! In case of I/O errors we stop here, since the lack ! of resource file data is fatal for the run. ! open(lunRc, file=rcFile, action='read', iostat=ierr) if (ierr /= 0) call GeErrorMessage("GeGetResources", & "can't open resource file "// & "'"//trim(rcFile)//"'", & rc=ierr, fatal=.true.) ! ! Check if it's a valid resource file by checking ! if the keyword 'genesis' is present in the first ! line. ! read(lunRc, '(a)', iostat=ierr) resource if (index(resource,'genesis') == 0 .or. ierr /= 0) & call GeErrorMessage("GeGetResources", & "not a valid resource file "// & "'"//trim(rcFile)//"'", & rc=ierr, fatal=.true.) rewind(lunRc) ! ! pass1: count the number of particle and decay definitions. ! Stop if no particles or no decays are found. ! nparticles = 0; ndecays = 0 do while (GeGetLine(lunRc, resource, value) == 0) if (index(resource,'particle%name') /= 0) nparticles = nparticles + 1 if (index(resource,'decay%name') /= 0) ndecays = ndecays + 1 enddo if (nparticles == 0) call GeErrorMessage("GeGetResources", & "particle resources missing") if (ndecays == 0) call GeErrorMessage("GeGetResources", & "decay resources missing") ! ! Allocate particle and decay lists (prototypes) ! Previously defined resource lists are freed. ! if (associated(particleList)) deallocate(particleList) allocate(particleList(nparticles), stat=ierr) if (ierr /= 0) call GeErrorMessage("GeGetResources", & "can't allocate particle list", & rc=ierr, fatal=.true.) if (associated(decayList)) deallocate(decayList) allocate(decayList(ndecays), stat=ierr) if (ierr /= 0) call GeErrorMessage("GeGetResources", & "can't allocate decay list", & rc=ierr, fatal=.true.) print *,'pass 1 done' ! ! pass2: Load all resources except decays. For that ! we need the complete particle list. ! ! rewind(lunRc) call GeLoadParticleRc(init=.true.) do while (GeGetLine(lunRc, resource, value) == 0) if (index(resource,'run%') == 1) then call GeLoadRunRc(resource, value) else if (index(resource,'particle%') == 1) then call GeLoadParticleRc(resource, value) else if (index(resource,'target%') == 1) then call GeLoadCollisionRc(resource, value) else if (index(resource,'projectile%') == 1) then call GeLoadCollisionRc(resource, value) endif enddo print *,'pass 2 done' ! ! pass3: load decay resources ! rewind(lunRc) call GeLoadDecayRc(init=.true.) do while (GeGetLine(lunRc, resource, value) == 0) if (index(resource,'decay%') == 1) & call GeLoadDecayRc(resource, value) enddo print *,'pass 3 done' ! ! That's it so far. Further consistency check will ! be made in routine 'checkResources'. All what is ! left is to close the resource file. ! close(lunRc) contains ! ! Returns resource and value string left adjusted. ! Strips inline comments starting with '!'. ! GeGetLine ensures that both strings have a length ! different from zero. No other consistency check ! is done. GeGetLine returns /= 0 if EOF is reached. ! recursive integer function GeGetLine(lun, resource, value) result(getL) implicit none integer :: lun, inline integer, parameter :: maxline = 80 character(len=*) :: resource, value character(len=maxline) :: line read(lun,'(a)',iostat=getL) line ! get complete line if (getL == 0) then inline = index(line,'!') ! remove inline comments if (inline /= 0) line(inline:maxline) = '' resource = line(1:index(line,':')-1) ! split line value = line(index(line,':')+1:maxline) resource = adjustl(resource) ! adjust left value = adjustl(value) if (len(trim(resource)) == 0 .or. len(trim(value)) == 0) & getL = GeGetLine(lun, resource, value) endif end function GeGetLine ! ! Load general run resources located in module 'Run' ! subroutine GeLoadRunRc(resource, value) use genesis_m implicit none character(len=*) :: resource, value if (index(resource, 'run%rndmSeed') == 1) then read(value,*) rndmSeed else if (index(resource, 'run%pion0_over_nch') == 1) then read(value,*) pion0_over_nch else if (index(resource, 'run%is_mass_weight') == 1) then read(value,*) is_mass_weight else if (index(resource, 'run%is_pt_weight') == 1) then read(value,*) is_pt_weight else if (index(resource, 'run%central_over_total_pion0') == 1) then read(value,*) central_over_total_pion0 else if (index(resource, 'run%central_rapidity') == 1) then read(value,*) central_rapidity else if (index(resource, 'run%etaMin') == 1) then read(value,*) etaMin else if (index(resource, 'run%etaMax') == 1) then read(value,*) etaMax endif end subroutine GeLoadRunRc ! ! Load collision resources located in module 'Collision' ! subroutine GeLoadCollisionRc(resource, value) use genesis_m implicit none character(len=*) :: resource, value if (index(resource, 'projectile%Z') == 1) then read(value,*) projectile%Z else if (index(resource, 'projectile%A') == 1) then read(value,*) projectile%A else if (index(resource, 'projectile%p') == 1) then read(value,*) projectile%p%p%pz projectile%p%p%px = 0 projectile%p%p%py = 0 projectile%p%E = sqrt(projectile%p%p%pz**2 + projectile%A**2) else if (index(resource, 'target%Z') == 1) then read(value,*) target%Z else if (index(resource, 'target%A') == 1) then read(value,*) target%A else if (index(resource, 'target%p') == 1) then read(value,*) target%p%p%pz target%p%p%px = 0 target%p%p%py = 0 target%p%E = sqrt(target%p%p%pz**2 + target%A**2) endif end subroutine GeLoadCollisionRc ! ! Load particle resources located in module 'Particles'. ! The beginning of a new particle definition must always ! start with a 'particle%name' resource. ! subroutine GeLoadParticleRc(resource, value, init) use genesis_m implicit none character(len=*), optional :: resource, value logical, optional :: init integer, save :: i = 0 if (present(init)) then ! changed because of DEC compiler problem if(init) then i = 0 return endif endif if (index(resource, 'particle%name') == 1) then i = i + 1 particleList(i)%name = value particleList(i)%id = 0 particleList(i)%mass = 0 particleList(i)%width = 0 particleList(i)%charge = 0 particleList(i)%spin = 0 particleList(i)%relSigmaTotal = 0 particleList(i)%relSigmaCentral = 0 particleList(i)%ptHbookId = 0 particleList(i)%yHbookId = 0 endif if (i > 0) then if (index(resource, 'particle%id') == 1) then read(value,*) particleList(i)%id else if (index(resource, 'particle%mass') == 1) then read(value,*) particleList(i)%mass else if (index(resource, 'particle%width') == 1) then read(value,*) particleList(i)%width else if (index(resource, 'particle%charge') == 1) then read(value,*) particleList(i)%charge else if (index(resource, 'particle%spin') == 1) then read(value,*) particleList(i)%spin else if (index(resource, 'particle%relSigmaTotal') == 1) then read(value,*) particleList(i)%relSigmaTotal else if (index(resource, 'particle%relSigmaCentral') == 1) then read(value,*) particleList(i)%relSigmaCentral else if (index(resource, 'particle%ptHbookId') == 1) then read(value,*) particleList(i)%ptHbookId else if (index(resource, 'particle%yHbookId') == 1) then read(value,*) particleList(i)%yHbookId endif endif end subroutine GeLoadParticleRc ! ! Load decay resources located in module 'Decays' ! The beginning of a new particle definition must always ! start with a 'decay%name' resource. Children can only ! be assigned if the 'decay%child' resource is preceeded ! by 'decay%nBody'. ! subroutine GeLoadDecayRc(resource, value, init) use genesis_m implicit none character(len=*), optional :: resource, value logical, optional :: init integer :: j integer, save :: i = 0, nb = 0 if (present(init)) then ! changed because of DEC compiler problem if(init) then i = 0; nb = 0 return end if endif if (index(resource, 'decay%name') == 1) then i = i + 1 nb = 0 decayList(i)%name = value decayList(i)%formFactor = USE_NONE decayList(i)%branchingRatio = 0 decayList(i)%enabled = .false. decayList(i)%nBody = 0 decayList(i)%decayChildren = .true. endif if (i > 0) then if (index(resource, 'decay%nBody') == 1) then read(value,*) decayList(i)%nBody allocate(decayList(i)%child(decayList(i)%nBody)) else if (index(resource, 'decay%branchingRatio') == 1) then read(value,*) decayList(i)%branchingRatio else if (index(resource, 'decay%formFactor') == 1) then select case(value) case ('VDM') decayList(i)%formFactor = USE_VDM case ('Lepton-G') decayList(i)%formFactor = USE_LEPTON_G case ('dummy') decayList(i)%formFactor = USE_NONE case default decayList(i)%formFactor = ERROR end select else if (index(resource, 'decay%decayChildren') == 1) then read(value,*) decayList(i)%decayChildren else if (index(resource, 'decay%parent') == 1) then do j = 1, size(particleList) if (particleList(j)%name == value) then decayList(i)%parent = particleList(j) exit endif enddo else if (index(resource, 'decay%enabled') == 1) then read(value,*) decayList(i)%enabled endif if (associated(decayList(i)%child)) then if (index(resource, 'decay%child') == 1) then nb = nb + 1 do j = 1, size(particleList) if (particleList(j)%name == value) then decayList(i)%child(nb) = particleList(j) exit endif enddo endif endif endif end subroutine GeLoadDecayRc end subroutine GeGetResources