! perfiles.f90 ! module in which all load from .per file routines are held ! contains: LoadPER etc module LoadPerFiles use FileNames implicit none contains !******************************************************************************* ! find out dimensions of arrays to specify for LoadPer subroutine PreLoadPer (CallFile,YearN) character (len=80), intent(inout) :: CallFile ! can be blank integer, intent(out) :: YearN integer :: VariCode,HeaderN character (len=20) :: LineFormat CallFile = LoadPath (CallFile,".per") call LoadPERHeaders (CallFile,VariCode,HeaderN,LineFormat,YearN=YearN) end subroutine PreLoadPer !******************************************************************************* ! call PreLoadPer first, alloc arrays, then call this ! load .per file subroutine LoadPer (CallFile,VariCode,YearAD,Monthly,Seasonal,Annual,Silent) real, pointer, dimension (:,:) :: Monthly, Seasonal real, pointer, dimension (:) :: Annual integer, pointer, dimension (:) :: YearAD integer, intent (in), optional :: Silent integer, intent (out) :: VariCode character (len=80), intent(in) :: CallFile ! can be blank real, parameter :: MissVal = -999.0 integer :: ReadStatus, AllocStat integer :: YearN, MonthN, HeaderN, SeasonN integer :: XYear, XMonth, XHeader, XSeason integer :: TimeCode, LineYear character (len=80) :: LoadFile, Trash character (len=20) :: LineFormat character (len= 4) :: Suffix !*************************************** call LoadPerHeaders (CallFile,VariCode,HeaderN,LineFormat,YearAD=YearAD) YearN = size (YearAD) MonthN = 12 SeasonN = 4 open (2, file=CallFile, status="old", access="sequential", form="formatted", action="read") do XHeader = 1, HeaderN read (2,*), Trash end do do XYear = 1, YearN read (2,LineFormat), LineYear, (Monthly(XYear,XMonth), XMonth=1,12), & (Seasonal(XYear,XSeason), XSeason=1,4), Annual(XYear) end do close (2) end subroutine LoadPer !******************************************************************************* ! load headers for .per data files ! call twice, first with YearN, then alloc YearAD, then call again with YearAD subroutine LoadPerHeaders (FileName,VariCode,HeaderN,LineFormat,YearAD,YearN) integer,dimension (:),pointer,optional :: YearAD integer, intent (out) :: HeaderN,VariCode ! -1=min, 0=mean, 1=max, 2=sum integer, intent (out), optional :: YearN character (len=80), intent (in) :: FileName character (len=20), intent (out) :: LineFormat real, parameter :: MissVal = -999.0 integer :: Year0, Year1, AllocStat, XYear character (len=80) :: LoadName, Trash character (len=20) :: Gambit character (len=8) :: TimePeriod, Variable !*************************************** open (1, file=FileName, status="old", action="read") read (1,"(a20)"), Gambit if (Gambit.EQ."Tyndall Centre file ") then HeaderN = 4 read (1,"(a36,a8,a1,a8)"), Trash, TimePeriod, Trash, Variable ! time period and variable read (1,"(a9,i4,a1,i4,a36,a20)"), Trash, Year0, Trash, Year1, Trash, LineFormat else if (Gambit.EQ."A Tyndall Centre fil") then HeaderN = 15 read (1,"(a36,a8,a1,a8)"), Trash, TimePeriod, Trash, Variable ! time period and variable read (1,"(a9,i4,a1,i4,a36,a20)"), Trash, Year0, Trash, Year1, Trash, LineFormat else if (Gambit.EQ."Monthly, seasonal, a") then HeaderN = 20 read (1,*), Trash read (1,*), Trash read (1,"(a9,i4,a1,i4,a36,a20)"), Trash, Year0, Trash, Year1, Trash, LineFormat end if close (1) if (trim(Variable).EQ."Min") then VariCode = -1 else if (trim(Variable).EQ."Mean") then VariCode = 0 else if (trim(Variable).EQ."Max") then VariCode = 1 else if (trim(Variable).EQ."Sum") then VariCode = 2 else VariCode = MissVal end if if (present(YearN)) then YearN = Year1 - Year0 + 1 else if (present(YearAD)) then do XYear = 1, (Year1 - Year0 + 1) YearAD (XYear) = XYear + Year0 - 1 end do end if end subroutine LoadPerHeaders !******************************************************************************* end module LoadPerFiles