! getchanged.f90 ! f90 main program written on 03.10.00 by Tim Mitchell ! last modification on 03.10.00 ! f90 -o getchanged initialmod.f90 extractmod.f90 savemod.f90 getchanged.f90 program AnomProducts use InitialMod use ExtractMod use SaveMod implicit none !******************************************************************************* real, pointer, dimension (:,:) :: GotYear real, pointer, dimension (:) :: GotMonth, GloSlice integer, pointer, dimension (:) :: WorkADYear, WorkMapRawReg, WorkRegSizes, MonthsValid integer, pointer, dimension (:,:) :: WorkMapIDLRaw, WorkMapIDLReg character (len=20), pointer, dimension (:) :: WorkRegNames real, parameter :: MissVal = -999.0 real :: FileMissVal real :: OpTot, OpEn integer :: WorkMonth0,WorkMonth1,WorkMonthN,WorkYearN,WorkDecN integer :: GridModel,GridLongN,GridLatN,GridDataN,WorkRegN integer :: AllocStat, ReadStatus integer :: XReg, XMonth, XRec integer :: Year0, Year1, ADYear0, ADYear1 integer :: DataMissN, RegValidN, YearValidN integer :: QSaveUnsmoo, QSaveSmoo, QSaveRegMeans integer :: FileStyle, FileRowN, FileColN, FileHeaderN character (len=1) :: UnwantedMonth character (len=10) :: GridTitle, FileFormat character (len=40) :: WorkRegTitle character (len=80) :: UnzippedDump, GivenFile, GetFile, FilePathThis character (len=80) :: GridFile, Blank !******************************************************************************* ! preliminaries Blank = "" open (99,file="/cru/u2/f709762/data/scratch/log-getch.dat",status="replace",action="write") print* print*, " > ***** GetChanged *****" print*, " > Gets change files from raw to .glo" print* call GridSelect (GridModel,GridTitle,GridLongN,GridLatN,GridDataN,GridFile) call RegSelect (GridModel,GridLongN,GridLatN,GridDataN,WorkMapIDLReg,WorkRegSizes,WorkRegNames,& WorkRegTitle,WorkRegN) call SeasonSelect (WorkMonth0,WorkMonth1,WorkMonthN) call RawSelect (GridModel,GridLongN,GridLatN,WorkMapIDLReg,WorkMapIDLRaw,WorkMapRawReg) deallocate (WorkRegNames,WorkMapIDLRaw,stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: GetChanged: Deallocation failure #####" allocate (MonthsValid (12), & GotMonth (WorkRegN), & GotYear (12,WorkRegN), & GloSlice (WorkRegN), stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: GetChanged: Allocation failure #####" MonthsValid = 0 GotYear = MissVal GloSlice = Missval if (WorkMonth1.GT.WorkMonth0) then MonthsValid(WorkMonth0:WorkMonth1) = 1 else MonthsValid(WorkMonth0:12) = 1 MonthsValid(1:WorkMonth1) = 1 end if !******************************************************************************* ! declare raw data file and determine its structure UnZippedDump = "" print*, " > Raw data: in file containing single year of grid box changes." print*, " > Enter the raw data file containing the changes (omit .Z):" do do read (*,*,iostat=ReadStatus), GivenFile if (ReadStatus.LE.0) exit end do inquire (file=GivenFile, name=FilePathThis) open (1, file=FilePathThis, status="old", iostat=ReadStatus, action="read") if (ReadStatus .EQ. 0) then close (1) GetFile = FilePathThis print*, " > File recognised." else GivenFile = trim(GivenFile) // '.Z' inquire (file=GivenFile, name=FilePathThis) open (1, file=FilePathThis, status="old", iostat=ReadStatus, action="read") if (ReadStatus .EQ. 0) then close (1) UnZippedDump = '/cru/u2/f709762/data/scratch/unzipped.dat' call system ('uncompress -c ' // FilePathThis // ' > ' // UnZippedDump) GetFile = UnZippedDump print*, " > File unzipped." else print*, " > File not recognised. Try again." end if end if if (ReadStatus .EQ. 0) exit end do print*, " > Enter the structure style code (see DefineStyle for details)." do read (*,*,iostat=ReadStatus), FileStyle if (ReadStatus.LE.0) exit end do call DefineStyle (FileStyle, FileFormat, FileMissVal, FileRowN, FileColN, FileHeaderN) !******************************************************************************* ! extract data open (unit=2,file=GetFile,status="old",access="sequential",action="read",form="formatted") do XMonth = 1, 12 if (MonthsValid(XMonth).EQ.0) then do XRec = 1, FileHeaderN read (2, "(A1)"), UnwantedMonth end do do XRec = 1, FileRowN read (2, "(A1)"), UnwantedMonth end do else GotMonth = 0.0 call ExtractMonth (2,FileFormat,FileMissVal,FileRowN,FileColN,FileHeaderN, & GridDataN,WorkRegN,WorkMapRawReg,WorkRegSizes,GotMonth) if (FileStyle.GE.200.AND.FileStyle.LE.299) call TemkToTemp (WorkRegN,GotMonth) if (FileStyle.GE.300.AND.FileStyle.LE.399) call TempTens (WorkRegN,GotMonth) GotYear (XMonth,1:WorkRegN) = GotMonth (1:WorkRegN) end if end do close (2) if (UnzippedDump.NE."") call system ('rm ' // UnZippedDump) deallocate (GotMonth,WorkMapRawReg,WorkRegSizes,stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: GetChanged: Deallocation failure #####" !******************************************************************************* ! seasonalise + save do XReg = 1, WorkRegN OpTot = 0.0 OpEn = 0.0 do XMonth = 1, 12 if (MonthsValid(XMonth).EQ.1) then if (GotYear(XMonth,XReg).NE.FileMissVal.AND.GotYear(XMonth,XReg).NE.MissVal) then OpTot = OpTot + GotYear(XMonth,XReg) OpEn = OpEn + 1 end if end if end do if (OpEn.EQ.WorkMonthN) GloSlice (XReg) = OpTot / OpEn end do call SaveGlo (GridLongN, GridLatN, WorkRegN, GridFile, Blank, Blank, GloSlice, WorkMapIDLReg) !******************************************************************************* ! wind down print* deallocate (GloSlice,MonthsValid,GotYear,WorkMapIDLReg) close (99) end program AnomProducts