Personal tools
You are here: Home Data and software SE library release sewrite.f
Document Actions

sewrite.f

A demo fortran source file that combines sewrite commands for writing the header as well as a cycle into the SE output file. You may want to mofidy and link this file with your stellar evolution code.

Click here to get the file

Size 5.5 kB - File type text/x-fortran

File contents

C 17 June 2009, r651
C *********************************************************************
      subroutine sewritecycle(FID1,icounthdf,mi,xmm,rse,rhose,tse,
     $     pressure,velocity,isvthere,dse,konvekt,ypsevol,nyps,age,dtime
     $     ,xmtot)
C *** sewritecycle: USEEPP write of one complete cycle (or model)
C     FID1       file handle
C     icounthdf  model number, ppn uses the same internal model number as
C                cycle in the stellar evolution code (output)
C     mi         number of shells in that cycle
C     xmm        array: Lagrangian mass coordinate
C     rse        array: mass coordinate
C     rhose      array: densisty
C     tse        array: temperature
C     pressure,velocity 
C     dse        array: diffusion coeffient in Eulerian coordinate
C     konvekt     : convection indicator
C               1 : convectively unstable
C              -1 : convectively stable, but mixing, e.g. in overshooting region
C     ypsevol    array with contral abundances
C     nyps       number of control arrays
C     age        in yrs
C     dtime      time step in secs
C     xmtot      total mass in solar masses
      implicit none
C *** FSE.fi has some word length definitions, pick where your se 
C     library is installed
C      include "/ngpod1/opt/se-intel/include/FSE.fi"
C      include "/opt/se/include/FSE.fi"
      include '/astro/fherwig/opt/se/include/FSE.fi'
C
      include 'para_intdec.inc'
      include 'para.inc'
C      integer msl               ! dimension of SE evolution grid arrays
C      parameter ( msl = 5000 )
      integer fid1,icounthdf,mi,isvthere,nyps,konvekt(msl)
      integer*4 konv4(mi)
      double precision xmtot,dtime,age
      double precision ypsevol(msl,nyps)
      double precision xmm(msl),pressure(msl),velocity(msl)
     $     ,rhose(msl),tse(msl),rse(msl),dse(msl)
C *** SE_INT represents 4-byte integers, whereas in EVOL all integers are 8-byte
      konv4=konvekt(1:mi)
C
C *** we don't have velocity in hydrostatic codes; we will provide 
C     the attribute isvthere to inform whether or not the velocity is 
C     provided
C     
      if (isvthere.eq.1) then
         call FSE_WRITE(FID1, icounthdf, mi, 9,
     1        xmm, "mass", SE_DOUBLE,
     2        rse, "radius", SE_DOUBLE,
     3        rhose, "rho", SE_DOUBLE,
     4        tse, "temperature", SE_DOUBLE,
     5        dse, "dcoeff", SE_DOUBLE,
     6        konv4, "convection_indicator", SE_INT,
     7        ypsevol, "yps", SE_DOUBLE_2D, MSL, NYPS,    
     8        pressure, "pressure", SE_DOUBLE,
     9        velocity, "velocity", SE_DOUBLE)
      elseif (isvthere.eq.0) then
         call FSE_WRITE(FID1, icounthdf, mi, 8,
     1        xmm, "mass", SE_DOUBLE,
     2        rse, "radius", SE_DOUBLE,
     3        rhose, "rho", SE_DOUBLE,
     4        tse, "temperature", SE_DOUBLE,
     5        konv4, "convection_indicator", SE_INT,
     6        dse, "dcoeff", SE_DOUBLE,
     7        ypsevol, "yps", SE_DOUBLE_2D, MSL, NYPS,    
     8        pressure, "pressure", SE_DOUBLE)
      endif

      call FSE_WRITE_IATTR(FID1, icounthdf, "shellnb", mi)
      call FSE_WRITE_IATTR(FID1, icounthdf, "is_v_there", isvthere)
      call FSE_WRITE_DATTR(FID1, icounthdf, "age", age)
      call FSE_WRITE_DATTR(FID1, icounthdf, "deltat", dtime)
      call FSE_WRITE_DATTR(FID1, icounthdf, "total_mass", xmtot)

      return
      end
C *********************************************************************
      subroutine sewritefhead(fid1,modini,nprn,codev,modname,mini,zini
     $     ,rotini,overini,alphav,oneyear,mass_unit,radius_unit,rho_unit
     $     ,temperature_unit,dcoeff_unit,xdyps,nyps)
C *** sewritefhead: USEEPP write file header       
C     modini       first model in packet, should be the same as 2nd 
C                  field in name
C     overini      for EVOL this is fvexp
C     alphav       3DUP bottom of env multiplier 
C     nyps         number of control arrays
C     idyps        array with list of isotopes in ypsevol, defined as (Z,A,G)
      
      implicit none
      integer nprn,fid1,modini,nyps
      character*80 modname, codev
      double precision mini,zini,rotini,overini,alphav,oneyear,mass_unit
     $     ,radius_unit,rho_unit,temperature_unit,dcoeff_unit
      double precision an(nyps), zn(nyps),xiso(nyps),xdyps(3,nyps)

C
C *** Stellar evolution sequence parameters:
      call FSE_WRITE_IATTR(FID1,-1, "icyclenb",  nprn)
      call FSE_WRITE_IATTR(FID1,-1, "firstcycle",  modini)
      call FSE_WRITE_SATTR(FID1,-1,"codev",codev)
      call FSE_WRITE_SATTR(FID1,-1,"modname",modname)
      call FSE_WRITE_DATTR(FID1,-1,"mini",mini)
      call FSE_WRITE_DATTR(FID1,-1,"zini",zini)
      call FSE_WRITE_DATTR(FID1,-1,"rotini",rotini)
      call FSE_WRITE_DATTR(FID1,-1,"overini",overini)
      call FSE_WRITE_DATTR(FID1,-1,"alphav",alphav)

C *** Units for variables (with respect to CGS, i.e. if your age is given in
C *** years then give age_unit=oneyear in secs 
      call FSE_WRITE_DATTR(FID1, -1, "age_unit",oneyear)
      call FSE_WRITE_DATTR(FID1, -1, "mass_unit",mass_unit)
      call FSE_WRITE_DATTR(FID1, -1, "radius_unit",radius_unit)
      call FSE_WRITE_DATTR(FID1, -1, "rho_unit",rho_unit)
      call FSE_WRITE_DATTR(FID1, -1, "temperature_unit",temperature_unit
     $     )
      call FSE_WRITE_DATTR(FID1, -1, "dcoeff_unit",dcoeff_unit)

C *** write IDs of control UPS array
      zn=xdyps(1,:)
      an=xdyps(2,:)
      xiso=xdyps(3,:)
      call FSE_WRITE_DARRAYATTR(FID1,-1, "Z",zn,nyps)
      call FSE_WRITE_DARRAYATTR(FID1,-1, "A",an,nyps)
      call FSE_WRITE_DARRAYATTR(FID1,-1,"isomeric_state", xiso,nyps)

      return
      end

Powered by Plone CMS, the Open Source Content Management System

This site conforms to the following standards: