! operatedat.f90 ! f90 program written by Tim Mitchell on 26.01.01 ! last modified on 25.01.01 ! tool to operate on synoptic indices from standard .dat and .syn files of synoptic data ! f90 -o operatedat filenames.f90 jldatfiles.f90 synfiles.f90 jlgeneral.f90 operatedat.f90 program OperateDAT use FileNames use JLDATFiles use SYNFiles use JLGeneral implicit none real, pointer, dimension (:,:,:,:) :: FileFlow integer, pointer, dimension (:,:,:,:) :: Data integer, pointer, dimension (:,:,:) :: FileData, FileLamb, FileJenk, FileAuto integer, pointer, dimension (:,:) :: MonthLengths integer, pointer, dimension (:) :: YearAD, FileYearAD real, parameter :: MissVal = -999.0 character (len=80), parameter :: Blank = "" real :: BlockMissVal, Multiplier real :: DataMiss, DataFrac, OpMiss, OpEn, OpFrac integer :: ReadStatus, AllocStat, MenuChoice, NextFree integer :: ChosenCol, ChosenColA, ChosenColB, ChosenOp integer :: StartYear, EndYear, FirstYear, YearN integer :: BlockYearN, BlockStartAD, BlockEndAD, BlockStartX, BlockEndX integer :: XYear, XMonth, XDay, XHeader, XFooter, XFileYear, XVari, XCol integer :: HeaderN, FooterN, MonthN, DayN, VariN, StringLen, ColN integer :: FileYear0,FileYear1,Year0,Year1 integer :: QComp, QIntFloat, QFileComp integer :: NonBlank, IntConstant character (len=80) :: GivenFile, OrigFile, LineFormat, Waste character (len=1) :: IntFloat !******************************************************************************* ! main call Intro do print*, " > Main menu. Make your choice. (0=list)" do read (*,*,iostat=ReadStatus), MenuChoice if (ReadStatus.LE.0) exit end do if (MenuChoice.EQ.1) then print*, " > Are you sure? (1=no,2=yes)" do read (*,*,iostat=ReadStatus), MenuChoice if (ReadStatus.LE.0.AND.MenuChoice.GE.1.AND.MenuChoice.LE.2) exit end do if (MenuChoice.EQ.1) print*, " > No changes made." if (MenuChoice.EQ.2) call Intro else if (MenuChoice.EQ. 2) then call OperateAk else if (MenuChoice.EQ. 3) then call OperateAB else if (MenuChoice.EQ.10) then call LoadFromSYN else if (MenuChoice.EQ.11) then call LoadFromDAT else if (MenuChoice.EQ.20) then call SaveToSYN else if (MenuChoice.EQ.21) then call SaveToDAT else if (MenuChoice.EQ.30) then call CheckMaster else if (MenuChoice.NE.99) then print*, " > 1. Reinitialise" print*, " > 2. Operate A.k" print*, " > 3. Operate A.B" print*, " > 10. Load data from .syn" print*, " > 11. Load data from .dat" print*, " > 20. Save data to .syn" print*, " > 21. Save data to .dat" print*, " > 30. Check main arrays" print*, " > 99. Exit" end if if (MenuChoice.EQ.99) exit end do call Conclude contains !******************************************************************************* ! intro subroutine Intro open (99,file="/cru/u2/f709762/data/scratch/log-odat.dat",status="replace",action="write") print* print*, " > ##### OperateDAT.f90 ##### Tool for operating on synoptic classes #####" print* print*, " > Enter the number of columns in the master array:" do read (*,*,iostat=ReadStatus), ColN if (ReadStatus.LE.0 .AND. ColN.GE.1) exit end do print*, " > Enter the start and end years AD of the master array:" do read (*,*,iostat=ReadStatus), StartYear, EndYear if (ReadStatus.LE.0 .AND. StartYear.LE.EndYear) exit end do YearN = EndYear - StartYear + 1 MonthN = 12 ; DayN = 31 ; VariN = 8 NextFree = 1 allocate ( Data (ColN, YearN, MonthN, DayN), & YearAD (YearN), stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: Intro: Allocation failure #####" Data = -9 do XYear = 1, YearN YearAD (XYear) = StartYear + XYear - 1 end do print* end subroutine Intro !******************************************************************************* ! load from .dat file subroutine LoadFromDAT call LoadJLDAT (Blank,FileYearAD,FileData) call CommonVecPer (FileYearAD,YearAD,FileYear0,FileYear1,Year0,Year1) if (FileYear0.EQ.MissVal) then print*, " > The loaded file has no period in common with the master array." else print*, " > Common period loaded into master array: ", FileYearAD(FileYear0), FileYearAD(FileYear1) end if do XFileYear = FileYear0, FileYear1 XYear = Year0 + XFileYear - FileYear0 do XMonth = 1, MonthN do XDay = 1, DayN Data(NextFree,XYear,XMonth,XDay) = FileData(XFileYear,XMonth,XDay) end do end do end do deallocate (FileYearAD, FileData, stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: LoadFromDAT: Deallocation failure #####" call StoreMoveOn print* end subroutine LoadFromDAT !******************************************************************************* ! load from .syn file subroutine LoadFromSYN call LoadSYN (Blank,FileYearAD,FileLamb,FileJenk,FileAuto,FileFlow) call CommonVecPer (FileYearAD,YearAD,FileYear0,FileYear1,Year0,Year1) if (FileYear0.EQ.MissVal) then print*, " > The loaded file has no period in common with the master array." else print*, " > The common period is: ", FileYearAD(FileYear0), FileYearAD(FileYear1) end if print*, " > Load manual LWT (=1), automated LWT (=2), or auto-Jenk (=3) ?" do read (*,*,iostat=ReadStatus), QComp if (ReadStatus.LE.0 .AND. QComp.GE.1 .AND. QComp.LE.3) exit end do do XFileYear = FileYear0, FileYear1 XYear = Year0 + XFileYear - FileYear0 do XMonth = 1, MonthN do XDay = 1, DayN if (QComp.EQ.1) Data(NextFree,XYear,XMonth,XDay) = FileLamb(XFileYear,XMonth,XDay) if (QComp.EQ.2) Data(NextFree,XYear,XMonth,XDay) = FileJenk(XFileYear,XMonth,XDay) if (QComp.EQ.3) Data(NextFree,XYear,XMonth,XDay) = FileAuto(XFileYear,XMonth,XDay) end do end do end do deallocate (FileYearAD,FileLamb,FileJenk,FileAuto,FileFlow, stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: LoadFromSYN: Deallocation failure #####" call StoreMoveOn print* end subroutine LoadFromSYN !******************************************************************************* ! save to .dat file subroutine SaveToDAT call SelectColumn allocate ( FileData (YearN, MonthN, DayN), stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: SaveToDAT: Allocation failure #####" do XYear = 1, YearN do XMonth = 1, MonthN do XDay = 1, DayN FileData (XYear,XMonth,XDay) = Data(ChosenCol,XYear,XMonth,XDay) end do end do end do call SaveJLDAT (Blank,YearAD,FileData) deallocate (FileData, stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: SaveToDAT: Deallocation failure #####" print* end subroutine SaveToDAT !******************************************************************************* ! save to .syn file subroutine SaveToSYN end subroutine SaveToSYN !******************************************************************************* ! operate A . constant subroutine OperateAk print*, " > Select the operation (A/k=1, A*k=2, A-k=3, A+k=4, A**k=6, A(abs)=7): " do read (*,*,iostat=ReadStatus), ChosenOp if (ReadStatus.LE.0 .AND. ChosenOp.GE.1 .AND. ChosenOp.LE.7 .AND. ChosenOp.NE.5) exit end do call SelectColumn if (ChosenOp.NE.7) then print*, " > Select the integer constant: " do read (*,*,iostat=ReadStatus), IntConstant if (ReadStatus.LE.0) exit end do end if do XYear = 1, YearN do XMonth = 1, MonthN do XDay = 1, DayN Data(NextFree,XYear,XMonth,XDay) = IntegerOp (Data(ChosenCol,XYear,XMonth,XDay),IntConstant,ChosenOp,-9) end do end do end do call StoreMoveOn print* end subroutine OperateAk !******************************************************************************* ! operate A . B subroutine OperateAB print*, " > Select the operation (A/B=1, A*B=2, A-B=3, A+B=4, A**B=6: " do read (*,*,iostat=ReadStatus), ChosenOp if (ReadStatus.LE.0 .AND. ChosenOp.GE.1 .AND. ChosenOp.LE.6 .AND. ChosenOp.NE.5) exit end do print*, " > Select columns A and B in turn: " call SelectColumn ChosenColA = ChosenCol call SelectColumn ChosenColB = ChosenCol do XYear = 1, YearN do XMonth = 1, MonthN do XDay = 1, DayN Data(NextFree,XYear,XMonth,XDay) = IntegerOp & (Data(ChosenColA,XYear,XMonth,XDay),Data(ChosenColB,XYear,XMonth,XDay),ChosenOp,-9) end do end do end do call StoreMoveOn print* end subroutine OperateAB !******************************************************************************* ! check master array subroutine CheckMaster call GetMonthLengths (YearAD,MonthLengths) OpEn = 0.0 do XYear = 1, YearN do XMonth = 1, MonthN OpEn = OpEn + MonthLengths(XYear,XMonth) end do end do print "(a38,f10.2)", " > Number of days in main array: ", OpEn print "(a17)", " > COL MISS%" do XCol = 1, ColN DataMiss = 0.0 do XYear = 1, YearN do XMonth = 1, MonthN do XDay = 1, MonthLengths(XYear,XMonth) if (Data (XCol,XYear,XMonth,XDay) .EQ. -9) DataMiss = DataMiss + 1.0 end do end do end do DataFrac = 100.0 * DataMiss / OpEn print "(i9,f8.2)", XCol, DataFrac end do print* deallocate (MonthLengths,stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: CheckMaster: Deallocation failure #####" end subroutine CheckMaster !******************************************************************************* ! select column subroutine SelectColumn print*, " > Select the column: " do read (*,*,iostat=ReadStatus), ChosenCol if (ReadStatus.LE.0 .AND. ChosenCol.GE.1 .AND. ChosenCol.LE.ColN) exit end do end subroutine SelectColumn !******************************************************************************* ! store data in column and move on subroutine StoreMoveOn call CheckBlank if (NonBlank.EQ.0) then print*, " > Operation has no valid results. No results stored." else print*, " > Results stored in column: ", NextFree NextFree = NextFree + 1 if (NextFree.GT.ColN) then NextFree = NextFree - 1 print*, " > All columns are being used. Next free set to: ", NextFree end if end if end subroutine StoreMoveOn !******************************************************************************* ! check whether column is (=0) or is not (=1) blank subroutine CheckBlank NonBlank = 0 XYear = 0 do XYear = XYear + 1 XMonth = 0 do XMonth = XMonth + 1 XDay = 0 do XDay = XDay + 1 if (Data(NextFree,XYear,XMonth,XDay).NE.-9) NonBlank = 1 if (NonBlank.EQ.1) exit if (XDay.EQ.DayN) exit end do if (NonBlank.EQ.1) exit if (XMonth.EQ.MonthN) exit end do if (NonBlank.EQ.1) exit if (XYear.EQ.YearN) exit end do end subroutine CheckBlank !******************************************************************************* ! conclude subroutine Conclude deallocate (YearAD,Data,stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: Conclude: Deallocation failure #####" close (99) print* end subroutine Conclude !******************************************************************************* end program OperateDAT