! operatetim.f90 ! f90 main program written on 05.05.00 by Tim Mitchell ! last modification on 16.05.00 ! f90 -o operatetim initialmod.f90 loadmod.f90 savemod.f90 scalemod.f90 transformmod.f90 operatetim.f90 program OperateTim use InitialMod use LoadMod use SaveMod use ScaleMod use TransformMod implicit none real, pointer, dimension (:,:,:) :: TimLoaded real, pointer, dimension (:,:) :: LinToSave, FileSeries, OpTim, LinLoaded real, pointer, dimension (:,:) :: FileData, OpError, OpSampN, OpStDev, Scalar real, pointer, dimension (:) :: Vectorised, GloLoaded real, pointer, dimension (:) :: Pattern, OpGlo integer, pointer, dimension (:) :: WorkMapRawReg, WorkRegSizes integer, pointer, dimension (:) :: WorkADYear integer, pointer, dimension (:,:) :: WorkMapIDLRaw, WorkMapIDLReg integer, allocatable, dimension (:) :: UseTim character (len=80), pointer, dimension (:) :: FileRegNames, WorkRegNames, FileLineNames real, parameter :: MissVal = -999.0 real :: YearThresh, RegThresh, MemThresh real :: MissAccept real :: CalcEn, CalcTot, OpTotal, OpEn, OpSqTot, OpTot real :: PerCentMiss, TotalMiss, TimMin, TimMax real :: Aye, RealConstant integer :: WorkGrid, WorkLongN, WorkLatN, WorkDataN, WorkRegN integer :: WorkMonth0, WorkMonth1, WorkMonthN, WorkYearN, WorkDecN integer :: WorkTimN, FileRegN, RegValidN, RegYearValidN, FileLineN integer :: AllocStat, ReadStatus integer :: XFile, XLin, XYear, XFind, XTim, XReg, XLong, XLine integer :: QMain, QMissAccept, QSliceify, QSave, QAnother, QSampPop, QSaveErr, QCalcSig integer :: ExitCheck, QuitProc integer :: YearMissN integer :: SelectFile, SelectADYear, ChosenADYear, ChosenFileN, SelectTim, UseTimN, SelectedLine integer :: SliceLen, Operator, IntConstant character (len=10) :: WorkGridTitle character (len=80) :: WorkGridFilePath, WorkLinTitle, WorkRegTitle, WorkGloFilePath, SaveTitle !******************************************************************************* ! main program call Initialise call GrabTim open (99,file='/cru/u2/f709762/data/scratch/log-optim.dat',access='sequential',status='replace',action='write') QAnother = -1 do QuitProc = 0 if (QAnother.EQ.0) then call SetMissAccept (MissAccept) else if (QAnother.EQ.1) then SliceLen = 30 call IntoSlices else if (QAnother.EQ.2) then UseTimN = 1 call SelectFiles call ConvertGlo else if (QAnother.EQ.4) then UseTimN = 2 call SelectFiles if (QuitProc.EQ.0) call DivideAB else if (QAnother.EQ.5) then UseTimN = 1 call SelectFiles call OperateAGlo else if (QAnother.EQ.6) then call SelectUseTimN call SelectFiles call AverageTim else if (QAnother.EQ.7) then UseTimN = 1 call SelectFiles call AverageTim else if (QAnother.EQ.8) then call SelectUseTimN call SelectFiles call StDevTim else if (QAnother.EQ.9) then call CalcScaleEq else if (QAnother.EQ.10) then call ApplyScaling else if (QAnother.EQ.11) then SliceLen = -1 call IntoSlices else if (QAnother.EQ.12) then UseTimN = 1 call SelectFiles call OperateALin else if (QAnother.EQ.13) then UseTimN = 1 call SelectFiles call OperateAConstant else print*, " > 0. Change % acceptable missing (currently: ", MissAccept print*, " > 1. Transform into 30y slices" print*, " > 2. Extract year-slice(s) from A into .glo(s)" print*, " > 4. Divide A by B" print*, " > 5. Operate on A with specific .glo" print*, " > 6. Average specified A,B,... into .tim" print*, " > 7. Save specified A into .tim" print*, " > 8. Stdev specified A,B,... into .tim" print*, " > 9. Calc scaling eq using specified A,B,..." print*, " > 10. Scale specified A,B,..." print*, " > 11. Transform into slices of specified length" print*, " > 12. Operate on A with specific .lin" print*, " > 13. Operate on A with constant" print*, " > 99. Exit" end if print* print*, " > Main menu: make your choice: " do read (*,*,iostat=ReadStatus), QAnother if (ReadStatus.LE.0 .AND. QAnother.GE.0 .AND. QAnother.LE.99) exit end do if (QAnother.EQ.99) exit end do deallocate (TimLoaded, stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: Main: Deallocation failure #####" print* close (99) contains !******************************************************************************* ! calc scaling eq subroutine CalcScaleEq if (WorkTimN.GT.1) then print*, " > Select the number of .tim files from which to calc scaling eq." do read (*,*,iostat=ReadStatus), UseTimN if (ReadStatus.LE.0.AND.UseTimN.GE.1.AND.UseTimN.LE.WorkTimN) exit end do else UseTimN = 1 end if call SelectFiles ! UseTim (1...UseTimN) referring to TimLoaded (XTim,XReg,XYear) call LoadScalar ! Scalar (1...UseTimN,1...WorkYearN) print*, " > Calculating pattern..." allocate (OpGlo (WorkRegN), & FileData (UseTimN,WorkYearN), stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: CalcScaleEq: Allocation failure #####" OpGlo = MissVal FileData = MissVal do XReg = 1, WorkRegN do XTim = 1, UseTimN do XYear = 1, WorkYearN FileData (UseTim(XTim),XYear) = TimLoaded (UseTim(XTim),XReg,XYear) end do end do call LinearLSRZero (UseTimN,WorkYearN,Scalar,FileData,Aye) OpGlo (XReg) = Aye end do print*, " > Enter the .glo file title to save scaling pattern: " do read (*,*,iostat=ReadStatus), SaveTitle if (ReadStatus.LE.0 .AND. SaveTitle.NE."") exit end do call SaveGlo (WorkLongN, WorkLatN, WorkRegN, SaveTitle, WorkGridFilePath, & OpGlo, WorkMapIDLReg) deallocate (OpGlo,Scalar,UseTim,FileData, stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: CalcScaleEq: Deallocation failure #####" end subroutine CalcScaleEq !******************************************************************************* ! apply scaling subroutine ApplyScaling if (WorkTimN.GT.1) then print*, " > Select the number of .tim files to estimate by scaling." do read (*,*,iostat=ReadStatus), UseTimN if (ReadStatus.LE.0.AND.UseTimN.GE.1.AND.UseTimN.LE.WorkTimN) exit end do else UseTimN = 1 end if call SelectFiles call LoadScalar print*, " > Load the pattern." call LoadGlo (WorkLongN, WorkLatN, WorkRegN, WorkMapIDLReg, Pattern) call ScalingError deallocate (Pattern,Scalar,UseTim, stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: ScalingMenu: Allocation failure #####" print*, " > Save scaling errors to .tim ? (1=no,2=yes)" print*, " > (this file cannot be used to calc sig, as n is unknown)" do read (*,*,iostat=ReadStatus), QSaveErr if (ReadStatus.LE.0.AND.QSaveErr.GE.1.AND.QSaveErr.LE.2) exit end do if (QSaveErr.EQ.2) then print*, " > Enter the .tim file title to save errors: " do read (*,*,iostat=ReadStatus), SaveTitle if (ReadStatus.LE.0 .AND. SaveTitle.NE."") exit end do call SaveTim (WorkRegN, WorkYearN, SaveTitle, WorkRegNames, WorkADYear, OpError) end if print*, " > Calc sig of scaling errors ? (1=no,2=yes)" do read (*,*,iostat=ReadStatus), QCalcSig if (ReadStatus.LE.0.AND.QCalcSig.GE.1.AND.QCalcSig.LE.2) exit end do if (QCalcSig.EQ.2) call ScalingErrorSig deallocate (OpError,OpSampN, stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: ScalingMenu: Allocation failure #####" end subroutine ApplyScaling !******************************************************************************* ! initialise subroutine Initialise print*, " > ***** Operations on .tim files *****" print* MissAccept = 10.0 print*, " > Select parameters that will govern operations." call GridSelect (WorkGrid,WorkGridTitle,WorkLongN,WorkLatN,WorkDataN,WorkGridFilePath) call PeriodSelect (WorkYearN,WorkDecN,WorkADYear) call RegSelect (WorkGrid,WorkLongN,WorkLatN,WorkDataN,WorkMapIDLReg,WorkRegSizes,WorkRegNames,& WorkRegTitle,WorkRegN) end subroutine Initialise !******************************************************************************* ! load .tim subroutine GrabTim print*, " > Select the number of .tim files to load." do read (*,*,iostat=ReadStatus), WorkTimN if (ReadStatus.LE.0.AND.WorkTimN.GE.1) exit end do allocate (TimLoaded (WorkTimN,WorkRegN,WorkYearN), & WorkRegNames (WorkRegN), stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: GrabTim: Allocation failure #####" TimLoaded = MissVal WorkRegNames = "blank" do XTim = 1, WorkTimN print*, " > File number : ", XTim do call LoadTim (WorkYearN,WorkADYear,FileRegN,FileRegNames,FileSeries) if (FileRegN.NE.WorkRegN) then print*, " > ##### Incorrect no. of regions in file. Try again #####" ExitCheck = 1 deallocate (FileRegNames,FileSeries,stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: Deallocation failure #####" else ExitCheck = 0 end if if (ExitCheck.EQ.0) exit end do do XReg = 1, WorkRegN WorkRegNames (XReg) = FileRegNames (XReg) do XYear = 1, WorkYearN TimLoaded (XTim,XReg,XYear) = FileSeries (XReg,XYear) end do end do deallocate (FileRegNames,FileSeries,stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: GrabTim: Deallocation failure #####" end do if (WorkLongN.EQ.96.AND.WorkLatN.EQ.73.AND.WorkRegN.EQ.7008) then print*, " > Converting regperbox into rpb..." do XLong = 1, WorkLongN XReg = WorkMapIDLReg (XLong,1) TimLoaded (1:WorkTimN,XReg,1:WorkYearN) = MissVal XReg = WorkMapIDLReg (XLong,WorkLatN) TimLoaded (1:WorkTimN,XReg,1:WorkYearN) = MissVal end do end if end subroutine GrabTim !******************************************************************************* ! sliceifying into 30y slices subroutine IntoSlices if (SliceLen.EQ.-1) then print*, " > Enter the slice length:" do read (*,*,iostat=ReadStatus), SliceLen if (ReadStatus.LE.0.AND.SliceLen.GE.2.AND.SliceLen.LT.WorkYearN) exit end do end if print*, " > Sliceifying each file and region individually..." allocate (Vectorised (WorkYearN), stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: IntoSlices: Allocation failure #####" do XTim = 1, WorkTimN do XReg = 1, WorkRegN do XYear = 1, WorkYearN Vectorised (XYear) = TimLoaded (XTim,XReg,XYear) end do call SimpleSlice (WorkYearN,SliceLen,MissAccept,Vectorised) do XYear = 1, WorkYearN TimLoaded (XTim,XReg,XYear) = Vectorised (XYear) end do end do if (WorkTimN.GT.1) print*, " > Have slicified file: ", XTim end do deallocate (Vectorised, stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: IntoSlices: Deallocation failure #####" TotalMiss = 0.0 do XTim = 1, WorkTimN do XReg = 1, WorkRegN do XYear = 1, WorkYearN if (TimLoaded(XTim,XReg,XYear).EQ.MissVal) TotalMiss = TotalMiss + 1.0 end do end do end do PerCentMiss = 100.0 * TotalMiss / (WorkTimN*WorkRegN*WorkYearN) print "(a42,f8.2)", " > After sliceifying: percentage missing: ", PerCentMiss end subroutine IntoSlices !******************************************************************************* ! select one or more files from those loaded subroutine SelectUseTimN if (WorkTimN.EQ.1) then print*, " > Insufficient files loaded to perform that operation." QuitProc = 1 else print*, " > Enter the number of .tim to use: " do read (*,*,iostat=ReadStatus), UseTimN if (ReadStatus.LE.0.AND.UseTimN.GT.1.AND.UseTimN.LE.WorkTimN) exit end do end if end subroutine SelectUseTimN !******************************************************************************* ! select one or more files from those loaded subroutine SelectFiles write (99,*), "### SelectFiles" allocate (UseTim (UseTimN), stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: SelectFiles: Allocation failure #####" UseTim = 0 if (UseTimN.GT.WorkTimN) then print*, " > Insufficient files loaded to perform that operation." QuitProc = 1 else if (WorkTimN.GT.1) then print*, " > Select .tim files totalling: ", UseTimN do XTim = 1, UseTimN print*, " > Select .tim file number:", XTim do read (*,*,iostat=ReadStatus), SelectTim if (ReadStatus.LE.0.AND.SelectTim.GE.1.AND.SelectTim.LE.WorkTimN) exit end do UseTim (XTim) = SelectTim write (99,"(2i4)"), XTim, UseTim (XTim) end do else UseTim (1) = 1 write (99,"(2i4)"), 1, 1 end if end if end subroutine SelectFiles !******************************************************************************* ! save global slice for single year subroutine ConvertGlo allocate (OpTim (WorkRegN,WorkYearN), stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: ConvertGlo: Allocation failure #####" OpTim = MissVal do XReg = 1, WorkRegN do XYear = 1, WorkYearN OpTim (XReg,XYear) = TimLoaded(UseTim(1),XReg,XYear) end do end do call TimToGlo (WorkLongN, WorkLatN, WorkRegN, WorkYearN, WorkGridFilePath, & WorkADYear, WorkMapIDLReg, OpTim) deallocate (OpTim, UseTim, stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: ConvertGlo: Deallocation failure #####" end subroutine ConvertGlo !******************************************************************************* ! divide one .tim by another .tim subroutine DivideAB allocate (OpTim (WorkRegN,WorkYearN), stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: DivideAB: Allocation failure #####" OpTim = MissVal do XReg = 1, WorkRegN do XYear = 1, WorkYearN if (TimLoaded(UseTim(1),XReg,XYear).NE.MissVal.AND.TimLoaded(UseTim(2),XReg,XYear).NE.MissVal) then if (TimLoaded(UseTim(2),XReg,XYear).NE.0) then OpTim (XReg,XYear) = TimLoaded(UseTim(1),XReg,XYear) / TimLoaded(UseTim(2),XReg,XYear) end if end if end do end do print*, " > Enter the .tim file title to save: " do read (*,*,iostat=ReadStatus), SaveTitle if (ReadStatus.LE.0 .AND. SaveTitle.NE."") exit end do call SaveTim (WorkRegN, WorkYearN, SaveTitle, WorkRegNames, WorkADYear, OpTim) deallocate (OpTim, UseTim, stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: DivideAB: Deallocation failure #####" end subroutine DivideAB !******************************************************************************* ! divide or subtract one .tim by a .glo subroutine OperateAGlo print*, " > Divide by (=1), multiply by (=2), subtract (=3), or add (=4) .glo ?" do read (*,*,iostat=ReadStatus), Operator if (ReadStatus.LE.0 .AND. Operator.GE.1 .AND. Operator.LE.4) exit end do allocate (OpTim (WorkRegN,WorkYearN), stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: OperateAGlo: Allocation failure #####" OpTim = MissVal call LoadGlo (WorkLongN, WorkLatN, WorkRegN, WorkMapIDLReg, GloLoaded) do XReg = 1, WorkRegN if (GloLoaded(XReg).NE.MissVal) then do XYear = 1, WorkYearN if (TimLoaded(UseTim(1),XReg,XYear).NE.MissVal) then if (Operator.EQ.1) OpTim (XReg,XYear) = TimLoaded(UseTim(1),XReg,XYear) / GloLoaded (XReg) if (Operator.EQ.2) OpTim (XReg,XYear) = TimLoaded(UseTim(1),XReg,XYear) * GloLoaded (XReg) if (Operator.EQ.3) OpTim (XReg,XYear) = TimLoaded(UseTim(1),XReg,XYear) - GloLoaded (XReg) if (Operator.EQ.4) OpTim (XReg,XYear) = TimLoaded(UseTim(1),XReg,XYear) + GloLoaded (XReg) end if end do end if end do print*, " > Enter the .tim file title to save: " do read (*,*,iostat=ReadStatus), SaveTitle if (ReadStatus.LE.0 .AND. SaveTitle.NE."") exit end do call SaveTim (WorkRegN, WorkYearN, SaveTitle, WorkRegNames, WorkADYear, OpTim) deallocate (GloLoaded, OpTim, UseTim, stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: OperateAGlo: Deallocation failure #####" end subroutine OperateAGlo !******************************************************************************* ! divide or subtract one .tim by a .lin subroutine OperateALin print*, " > Divide by (=1), multiply by (=2), subtract (=3), or add (=4) .lin ?" do read (*,*,iostat=ReadStatus), Operator if (ReadStatus.LE.0 .AND. Operator.GE.1 .AND. Operator.LE.4) exit end do allocate (OpTim (WorkRegN,WorkYearN), stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: OperateALin: Allocation failure #####" OpTim = MissVal call LoadLin (WorkYearN, WorkADYear, FileLineN, FileLineNames, LinLoaded) if (FileLineN.EQ.1) then SelectedLine = 1 else print*, " > Enter the index of the line to adopt as the scalar (0=list):" do do read (*,*,iostat=ReadStatus), SelectedLine if (ReadStatus.LE.0 .AND. SelectedLine.GE.0 .AND. SelectedLine .LE. FileLineN) exit end do if (SelectedLine.EQ.0) then do XLine = 1, FileLineN print*, XLine, FileLineNames(XLine) end do end if if (SelectedLine.GT.0) exit end do end if do XYear = 1, WorkYearN if (LinLoaded(SelectedLine,XYear).NE.MissVal) then do XReg = 1, WorkRegN if (TimLoaded(UseTim(1),XReg,XYear).NE.MissVal) then if (Operator.EQ.1) OpTim (XReg,XYear) = TimLoaded(UseTim(1),XReg,XYear) / LinLoaded(SelectedLine,XYear) if (Operator.EQ.2) OpTim (XReg,XYear) = TimLoaded(UseTim(1),XReg,XYear) * LinLoaded(SelectedLine,XYear) if (Operator.EQ.3) OpTim (XReg,XYear) = TimLoaded(UseTim(1),XReg,XYear) - LinLoaded(SelectedLine,XYear) if (Operator.EQ.4) OpTim (XReg,XYear) = TimLoaded(UseTim(1),XReg,XYear) + LinLoaded(SelectedLine,XYear) end if end do end if end do print*, " > Enter the .tim file title to save: " do read (*,*,iostat=ReadStatus), SaveTitle if (ReadStatus.LE.0 .AND. SaveTitle.NE."") exit end do call SaveTim (WorkRegN, WorkYearN, SaveTitle, WorkRegNames, WorkADYear, OpTim) deallocate (LinLoaded, FileLineNames, OpTim, UseTim, stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: OperateALin: Deallocation failure #####" end subroutine OperateALin !******************************************************************************* ! divide or subtract one .tim by a .glo subroutine OperateAConstant print*, " > Divide =1, multiply =2, minus =3, add =4, sqroot =5, exponentiate =6" do read (*,*,iostat=ReadStatus), Operator if (ReadStatus.LE.0 .AND. Operator.GE.1 .AND. Operator.LE.6) exit end do if (Operator.LT.5) then print*, " > Enter constant (real):" do read (*,*,iostat=ReadStatus), RealConstant if (ReadStatus.LE.0) exit end do else if (Operator.EQ.6) then print*, " > Enter constant (positive integer):" do read (*,*,iostat=ReadStatus), IntConstant if (ReadStatus.LE.0.AND.IntConstant.GE.0) exit end do end if allocate (OpTim (WorkRegN,WorkYearN), stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: OperateAConstant: Allocation failure #####" OpTim = MissVal do XReg = 1, WorkRegN do XYear = 1, WorkYearN if (TimLoaded(UseTim(1),XReg,XYear).NE.MissVal) then if (Operator.EQ.1) OpTim (XReg,XYear) = TimLoaded(UseTim(1),XReg,XYear) / RealConstant if (Operator.EQ.2) OpTim (XReg,XYear) = TimLoaded(UseTim(1),XReg,XYear) * RealConstant if (Operator.EQ.3) OpTim (XReg,XYear) = TimLoaded(UseTim(1),XReg,XYear) - RealConstant if (Operator.EQ.4) OpTim (XReg,XYear) = TimLoaded(UseTim(1),XReg,XYear) + RealConstant if (Operator.EQ.5) OpTim (XReg,XYear) = sqrt (TimLoaded(UseTim(1),XReg,XYear)) if (Operator.EQ.6) OpTim (XReg,XYear) = TimLoaded(UseTim(1),XReg,XYear) ** IntConstant end if end do end do print*, " > Enter the .tim file title to save: " do read (*,*,iostat=ReadStatus), SaveTitle if (ReadStatus.LE.0 .AND. SaveTitle.NE."") exit end do call SaveTim (WorkRegN, WorkYearN, SaveTitle, WorkRegNames, WorkADYear, OpTim) deallocate (OpTim, UseTim, stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: OperateAConstant: Deallocation failure #####" end subroutine OperateAConstant !******************************************************************************* ! average together .tim and save them subroutine AverageTim allocate (OpTim (WorkRegN,WorkYearN), stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: AverageTim: Allocation failure #####" OpTim = MissVal MemThresh = (100.0 - MissAccept) * UseTimN / 100.0 RegYearValidN = 0.0 do XReg = 1, WorkRegN do XYear = 1, WorkYearN OpTotal = 0.0 OpEn = 0.0 do XTim = 1, UseTimN if (TimLoaded(UseTim(XTim),XReg,XYear).NE.MissVal) then OpTotal = OpTotal + TimLoaded(UseTim(1),XReg,XYear) OpEn = OpEn + 1 end if end do if (OpEn.GE.MemThresh) then OpTim (XReg,XYear) = OpTotal / OpEn RegYearValidN = RegYearValidN + 1 end if end do end do print*, " > Total region-years valid: ", RegYearValidN print*, " > Enter the .tim file title to save: " do read (*,*,iostat=ReadStatus), SaveTitle if (ReadStatus.LE.0 .AND. SaveTitle.NE."") exit end do call SaveTim (WorkRegN, WorkYearN, SaveTitle, WorkRegNames, WorkADYear, OpTim) deallocate (OpTim, UseTim, stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: AverageTim: Deallocation failure #####" end subroutine AverageTim !******************************************************************************* ! stdev of .tim and save result subroutine StDevTim print*, " > Calc sample (=1) or population (=2) stdev ? " do read (*,*,iostat=ReadStatus), QSampPop if (ReadStatus.LE.0 .AND. QSampPop.GE.1 .AND. QSampPop.LE.2) exit end do print*, " > Calculating standard deviations..." allocate (OpTim (WorkRegN,WorkYearN), stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: StDevTim: Allocation failure #####" OpTim = MissVal MemThresh = (100.0 - MissAccept) * UseTimN / 100.0 RegYearValidN = 0.0 do XReg = 1, WorkRegN do XYear = 1, WorkYearN OpTotal = 0.0 OpSqTot = 0.0 OpEn = 0.0 do XTim = 1, UseTimN if (TimLoaded(UseTim(XTim),XReg,XYear).NE.MissVal) then OpTotal = OpTotal + TimLoaded(UseTim(XTim),XReg,XYear) OpSqTot = OpSqTot + (TimLoaded(UseTim(XTim),XReg,XYear) ** 2) OpEn = OpEn + 1 end if end do if (OpEn.GE.MemThresh) then if (QSampPop.EQ.1) then OpTim (XReg,XYear) = (OpSqTot / OpEn) - ( (OpTotal / OpEn) ** 2) OpTim (XReg,XYear) = sqrt (OpTim (XReg,XYear)) RegYearValidN = RegYearValidN + 1 else if (OpEn.GE.2) then OpTim (XReg,XYear) = (OpSqTot / OpEn) - ( (OpTotal / OpEn) ** 2) OpTim (XReg,XYear) = OpTim (XReg,XYear) * OpEn / (OpEn - 1) OpTim (XReg,XYear) = sqrt (OpTim (XReg,XYear)) RegYearValidN = RegYearValidN + 1 end if end if end if end do end do print*, " > Total region-years valid: ", RegYearValidN print*, " > Enter the .tim file title to save: " do read (*,*,iostat=ReadStatus), SaveTitle if (ReadStatus.LE.0 .AND. SaveTitle.NE."") exit end do call SaveTim (WorkRegN, WorkYearN, SaveTitle, WorkRegNames, WorkADYear, OpTim) deallocate (OpTim, UseTim, stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: StDevTim: Deallocation failure #####" end subroutine StDevTim !******************************************************************************* ! load scalar from .lin subroutine LoadScalar allocate (Scalar (UseTimN,WorkYearN), stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: LoadPattScal: Allocation failure #####" Scalar = MissVal print*, " > Load the scalar for each .tim selected." do XTim = 1, UseTimN print*, " > Load the scalar for .tim number: ", XTim call LoadLin (WorkYearN, WorkADYear, FileLineN, FileLineNames, FileData) if (FileLineN.EQ.1) then SelectedLine = 1 else print*, " > Enter the index of the line to adopt as the scalar (0=list):" do do read (*,*,iostat=ReadStatus), SelectedLine if (ReadStatus.LE.0 .AND. SelectedLine.GE.0 .AND. SelectedLine .LE. FileLineN) exit end do if (SelectedLine.EQ.0) then do XLine = 1, FileLineN print*, XLine, FileLineNames(XLine) end do end if if (SelectedLine.GT.0) exit end do end if do XYear = 1, WorkYearN Scalar (XTim,XYear) = FileData (SelectedLine,XYear) end do deallocate (FileLineNames, FileData, stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: LoadPattScal: Deallocation failure #####" end do end subroutine LoadScalar !******************************************************************************* ! scale and calc error subroutine ScalingError allocate (OpError (WorkRegN,WorkYearN), & OpSampN (WorkRegN,WorkYearN), stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: ScalingError: Allocation failure #####" OpError = MissVal OpSampN = MissVal MemThresh = (100.0 - MissAccept) * UseTimN / 100.0 do XReg = 1, WorkRegN if (Pattern(XReg).NE.MissVal) then do XYear = 1, WorkYearN OpTot = 0.0 OpEn = 0.0 do XTim = 1, UseTimN if (TimLoaded(UseTim(XTim),XReg,XYear).NE.MissVal.AND.Scalar(XTim,XYear).NE.MissVal) then OpTot = OpTot + (Scalar(XTim,XYear) * Pattern(XReg)) - TimLoaded(UseTim(XTim),XReg,XYear) OpEn = OpEn + 1 end if end do if (OpEn.GE.MemThresh) then OpError (XReg,XYear) = OpTot / OpEn OpSampN (XReg,XYear) = OpEn end if end do end if end do end subroutine ScalingError !******************************************************************************* ! calc sig of scaling error subroutine ScalingErrorSig print*, " > Load stdev from .tim" call LoadTim (WorkYearN, WorkADYear, WorkRegN, FileLineNames, OpStDev) print*, " > We divide the stdev by sqrt(n), since error = ensemble mean" do XReg = 1, WorkRegN do XYear = 1, WorkYearN if (OpStDev(XReg,XYear).NE.MissVal.AND.OpSampN(XReg,XYear).NE.MissVal) then OpStDev (XReg,XYear) = OpStDev (XReg,XYear) / sqrt (OpSampN (XReg,XYear) ) else OpStDev (XReg,XYear) = MissVal end if end do end do print*, " > We divide the error by the adjusted stdev" do XReg = 1, WorkRegN do XYear = 1, WorkYearN if (OpStDev(XReg,XYear).NE.MissVal.AND.OpError(XReg,XYear).NE.MissVal) then OpError (XReg,XYear) = OpError (XReg,XYear) / OpStDev (XReg,XYear) else OpError (XReg,XYear) = MissVal end if end do end do deallocate (OpStDev, FileLineNames, stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: ScalingErrorSig: Deallocation failure #####" print*, " > Enter the .tim file title to save significances: " do read (*,*,iostat=ReadStatus), SaveTitle if (ReadStatus.LE.0 .AND. SaveTitle.NE."") exit end do call SaveTim (WorkRegN, WorkYearN, SaveTitle, WorkRegNames, WorkADYear, OpError) end subroutine ScalingErrorSig !******************************************************************************* end program OperateTim