! globalisetim.f90 ! f90 main program written on 28.03.00 by Tim Mitchell ! last modification on 28.03.00 ! f90 -o globalisetim initialmod.f90 loadmod.f90 savemod.f90 transformmod.f90 globalisetim.f90 program GlobaliseTim use InitialMod use LoadMod use SaveMod use TransformMod implicit none real, pointer, dimension (:) :: VecSaved real, pointer, dimension (:,:) :: LinLoaded, FileLin, LinSaved, TimSaved integer, pointer, dimension (:) :: WorkADYear integer, pointer, dimension (:,:) :: WorkMapIDLRaw character (len=80), pointer, dimension (:) :: FileLinNames, WorkLinNames, SaveLinNames integer, allocatable, dimension (:) :: LineSelect integer, allocatable, dimension (:,:) :: PairSelect real, parameter :: MissVal = -999.0 real :: RunTot, RunEn, RunSqTot real :: AllSumX, AllSumY, AllSumXX, AllSumYY, AllSumXY, AllEn real :: Numer, Denom, AllAye, AllBee, AllAre real :: KaySelect real :: MissAccept integer :: WorkGrid, WorkLongN, WorkLatN, WorkDataN integer :: WorkMonth0, WorkMonth1, WorkMonthN, WorkYearN, WorkDecN integer :: WorkFileTimN, WorkFileLinN, WorkLinN, FileLinN, SaveTimN integer :: AllocStat, ReadStatus integer :: XFile, XLin, XYear, XFind, XLine integer :: QAnom, QMain integer :: SelectLin, SelectLinA, SelectLinB, SelectLinN, QIntercept integer :: FirstFree character (len=10) :: WorkGridTitle character (len=80) :: WorkGridFilePath, WorkTimTitle !******************************************************************************* ! main program open (99, file="/cru/u2/f709762/data/scratch/log-comptim.dat", status="replace", action="write") call Initialise call Globalise call SliceMean call DumpToLin deallocate (LinLoaded,WorkLinNames) print* close (99) contains !******************************************************************************* ! initialise subroutine Initialise print*, " > ***** GlobaliseTim *****" print*, " > Globalises by year across regions, then 30y slicifies" print*, " > Not always equivalent to operations employing global means" print* MissAccept = 10.0 print*, " > Select parameters that will govern operations (months=irrelevant)." call GridSelect (WorkGrid,WorkGridTitle,WorkLongN,WorkLatN,WorkDataN,WorkGridFilePath) call PeriodSelect (WorkYearN,WorkDecN,WorkADYear) call LoadTim (WorkYearN,WorkADYear,WorkLinN,WorkLinNames,LinLoaded) end subroutine Initialise !******************************************************************************* ! turn into global mean subroutine Globalise allocate (LinSaved(1,WorkYearN), & SaveLinNames(1) , stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: Globalise: Allocation failure #####" LinSaved = MissVal do XYear = 1, WorkYearN RunTot = 0.0 RunEn = 0.0 do XLin = 1, WorkLinN if (LinLoaded(XLin,XYear).NE.MissVal) then RunTot = RunTot + LinLoaded(XLin,XYear) RunEn = RunEn + 1.0 end if end do if (RunEn.GE.1) LinSaved (1,XYear) = RunTot / RunEn end do SaveLinNames (1) = "globalised from .tim" end subroutine Globalise !******************************************************************************* ! sliceify into 30y means subroutine SliceMean allocate (VecSaved(WorkYearN), stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: SliceMean: Allocation failure #####" VecSaved = MissVal do XYear = 1, WorkYearN VecSaved (XYear) = LinSaved (1,XYear) end do call SimpleSlice (WorkYearN,30,MissAccept,VecSaved) do XYear = 1, WorkYearN LinSaved (1,XYear) = VecSaved (XYear) end do deallocate (VecSaved, stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: SliceMean: Deallocation failure #####" end subroutine SliceMean !******************************************************************************* ! save .lin file subroutine DumpToLin print*, " > Enter the .lin file title: " do read (*,*,iostat=ReadStatus), WorkTimTitle if (ReadStatus.LE.0.AND.WorkTimTitle.NE."") exit end do call SaveLin (1,WorkYearN,SaveLinNames,WorkADYear,LinSaved) deallocate (LinSaved,SaveLinNames,stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: DumpToLin: Deallocation failure #####" end subroutine DumpToLin !******************************************************************************* end program GlobaliseTim