! mikehfiles.f90 ! module in which all Mike Hulme file routines are held module MikeHFiles use FileNames implicit none contains !******************************************************************************* ! save one of Mike H's CET .mon files instead of .per file subroutine SaveCETMON (CallFile, CallVariCode, YearAD, Monthly, Seasonal, Annual) real, pointer, dimension (:,:) :: Monthly, Seasonal real, pointer, dimension (:) :: Annual real, allocatable, dimension (:,:) :: MonTemp, SeaTemp real, allocatable, dimension (:) :: AnnTemp integer, pointer, dimension (:) :: YearAD character (len=80), intent(in) :: CallFile ! can be blank character (len=158), dimension (4) :: Headers integer, intent(in) :: CallVariCode ! can be MissVal, -1=min,0=mean,1=max,2=sum real, parameter :: MissVal = -999.0 real, parameter :: MonMissVal = -99.9 integer :: NoSave, ReadStatus, AllocStat integer :: YearN, MonthN, SeasonN integer :: XYear, XMonth, XSeason integer :: VariCode character (len=80) :: SaveFile character (len=20) :: LineFormat character (len= 4) :: Suffix !*************************************** ! check sizes NoSave = 0 Suffix = ".mon" YearN = size (Monthly,1) MonthN = size (Monthly,2) SeasonN = size (Seasonal,2) if (size(YearAD).NE.YearN.OR.size(Seasonal,1).NE.YearN.OR.size(Annual).NE.YearN & .OR.MonthN.NE.12.OR.SeasonN.NE.4) then print*, " > SaveMON: No save. Weird number of months or years." NoSave = 1 end if if (CallVariCode.LT.-1.OR.CallVariCode.GT.2) then print*, " > Enter the variable (-1=min,0=mean,1=max,2=sum): " do read (*,*,iostat=ReadStatus), VariCode if (ReadStatus.LE.0.AND.VariCode.GE.-1.AND.VariCode.LE.2) exit end do else VariCode = CallVariCode end if LineFormat = '(i5,12f5.1,5f6.2)' !*************************************** ! save data to file if (NoSave.EQ.0) then allocate (MonTemp (YearN,MonthN), & SeaTemp (YearN,SeasonN), & AnnTemp (YearN), stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: SaveMON: Allocation failure #####" do XYear = 1, YearN do XMonth = 1, MonthN if (Monthly(XYear,XMonth).NE.MissVal) then MonTemp(XYear,XMonth) = Monthly(XYear,XMonth) else MonTemp(XYear,XMonth) = MonMissVal end if end do do XSeason = 1, SeasonN if (Seasonal(XYear,XSeason).NE.MissVal) then SeaTemp(XYear,XSeason) = Seasonal(XYear,XSeason) else SeaTemp(XYear,XSeason) = MonMissVal end if end do if (Annual(XYear).NE.MissVal) then AnnTemp(XYear) = Annual(XYear) else AnnTemp(XYear) = MonMissVal end if end do SaveFile = SavePath (CallFile,Suffix) open (2, file=SaveFile, status="replace", access="sequential", form="formatted", action="write") write (2,LineFormat), YearAD(1), (MonTemp(1,XMonth), XMonth=1,12), AnnTemp(1), & MonMissVal, (SeaTemp(1,XSeason), XSeason=1,3) do XYear = 2, YearN write (2,LineFormat), YearAD(XYear), (MonTemp(XYear,XMonth), XMonth=1,12), AnnTemp(XYear), & SeaTemp((XYear-1),4), (SeaTemp(XYear,XSeason), XSeason=1,3) end do close (2) deallocate (MonTemp,SeaTemp,AnnTemp,stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: SaveMON: Deallocation failure #####" end if end subroutine SaveCETMON !******************************************************************************* end module MikeHFiles