! gales.f90 ! module in which all the routines for gale calculation are held ! contains: GaleScore, GaleIndex, GetGaleThresh module Gales use StanGeneral implicit none contains !******************************************************************************* ! function to calculate gale score (0=no gale,1=gale,2=severe gale,3=very severe gale) ! obtained from Hulme+Jones,1991,Weather 46:126-136 function GaleScore (Speed,Thresh1,Thresh2,Thresh3) real GaleScore real :: Speed integer :: Thresh1,Thresh2,Thresh3 real, parameter :: MissVal = -999.0 if (Speed.NE.MissVal.AND.Thresh1.NE.MissVal.AND.Thresh2.NE.MissVal.AND.Thresh3.NE.MissVal) then if (Speed.GE.Thresh3) then GaleScore = 3 else if (Speed.GE.Thresh2) then GaleScore = 2 else if (Speed.GE.Thresh1) then GaleScore = 1 else GaleScore = 0 end if else GaleScore = MissVal end if end function GaleScore !******************************************************************************* ! function to calculate gale index ! obtained from Hulme+Jones,1991,Weather 46:126-136 function GaleIndex (FVal,ZVal) real GaleIndex real :: FVal,ZVal real, parameter :: MissVal = -999.0 if (FVal.NE.MissVal.AND.ZVal.NE.MissVal) then GaleIndex = sqrt ((FVal ** 2.0) + ((0.5 * ZVal) ** 2.0)) else GaleIndex = MissVal end if end function GaleIndex !******************************************************************************* ! subroutine to get gale thresholds from .dat file ! data in .dat file obtained from Hulme+Jones,1991,Weather 46:126-136 subroutine GetGaleThresh (YearAD,Thresh) integer, pointer, dimension (:,:) :: Thresh, FileThresh integer, pointer, dimension (:) :: YearAD, FileYearAD real, parameter :: MissVal = -999.0 integer :: AllocStat integer :: FileYearN, YearN integer :: FileYear0, FileYear1, Year0, Year1 integer :: XYear, XSeverity, XFileYear character (len=80) :: ThreshFile !*************************************** ! initialise and load from file YearN = size (YearAD) ThreshFile = '/cru/mikeh1/f709762/f90/mod/_ref/gale/galethresh.dat' open (2, file=ThreshFile, status="old", access="sequential", form="formatted", action="read") read (2,"(i8)"), FileYearN allocate ( FileYearAD (FileYearN), & Thresh (FileYearN,3), & FileThresh (FileYearN,3), stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: GetGaleThresh: Allocation failure #####" FileThresh = MissVal do XYear = 1, FileYearN read (2,"(4i8)"), FileYearAD(XYear), (FileThresh(XYear,XSeverity),XSeverity=1,3) end do close (2) !*************************************** ! convert to the threshold array we want call CommonVecPer (FileYearAD,YearAD,FileYear0,FileYear1,Year0,Year1) if (FileYear0.EQ.MissVal) then print*, " > The file of gale thresholds has no period in common with the master array." else print*, " > The period of gale thresholds loaded: ", FileYearAD(FileYear0), FileYearAD(FileYear1) end if do XFileYear = FileYear0, FileYear1 XYear = Year0 + XFileYear - FileYear0 do XSeverity = 1, 3 Thresh(XYear,XSeverity) = FileThresh(XFileYear,XSeverity) end do end do deallocate (FileYearAD, FileThresh, stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: GetGaleThresh: Deallocation failure #####" end subroutine GetGaleThresh !******************************************************************************* end module Gales