! makehtm2.f90 ! performs highly specialised operation to make set of internet files ! last modified on 23.04.02 ! updated from makehtm.f90 ! f90 -o ./../goglo/makehtm2 filenames.f90 initialmod.f90 glofiles.f90 ./../goglo/makehtm2.f90 program MakeHTM2 use FileNames use InitialMod use GloFiles implicit none !******************************************************************************* ! definitions real, pointer, dimension (:,:,:) :: Data ! region,variable,period real, pointer, dimension (:) :: GloVec ! region integer, pointer, dimension (:,:) :: MapIDLReg ! shape of IDL mapping arrays integer, pointer, dimension (:) :: RegSizes ! region sizes + reg-->raw character (len=20), pointer, dimension (:) :: RegNames ! names of individual regions character (len=80), pointer, dimension (:) :: InFile, OutFile character (len=3), dimension (17) :: PerSub ! names of time periods character (len=3), dimension ( 9) :: VarSub ! names of variables character (len=7), dimension ( 9) :: VarText ! text for variables real, parameter :: MissVal = -999.0 integer :: ReadStatus, AllocStat integer :: FileN,PerN,VarN,RegN integer :: XFile, XVar, XPer, XReg, XChar integer :: QOperation, QFinish, QVar, QPer integer :: PerSubBeg, VarSubBeg, NumSubBeg, NumSubLen, TemplateLen, StrLen, StemBeg character (len=80), parameter :: Blank = "" character (len=80) :: GivenFile, NameOnly, Template, String, HTMCountry, HTMTable, Stem, Tip character (len=20) :: NumSub !******************************************************************************* ! main program print* print*, " > ***** MakeHTM: performs specialised op to make internet files *****" print* print*, " > Select the .glo files." call GetBatch (Blank,InFile) FileN = size (InFile, 1) PerN = 17 VarN = 9 print*, " > Identify the region set (/cru/u2/f709762/goglo/ref/)." call LoadRefReg (Blank,MapIDLReg,RegSizes,RegNames) RegN = size (RegSizes,1) PerSub =['ann','MAM','JJA','SON','DJF','Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec'] VarSub =['tmp','tmn','tmx','dtr','frs','pre','wet','vap','cld'] VarText=['T mean ','T min ','T max ','T range','frost ','precip ','wetdays','vapour ','cloud '] call GetHTMPaths allocate (Data (RegN,VarN,PerN), stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: MakeHTM: Data: Allocation failure #####" Data = MissVal do XFile = 1, FileN print* print "(a,i4)", " > Loading file ", XFile GivenFile = InFile(XFile) call LoadGloVec (GivenFile, MapIDLReg, GloVec) call FindTimePer call FindVariable if (QVar.NE.MissVal.AND.QPer.NE.MissVal) then do XReg = 1, RegN Data (XReg,QVar,QPer) = GloVec (XReg) end do end if deallocate (GloVec,stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: MakeHTM: Deallocation failure #####" end do deallocate (InFile,stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: MakeHTM: Deallocation failure #####" call SaveHTM deallocate (OutFile,Data,MapIDLReg,RegSizes,RegNames,stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: MakeHTM: Deallocation failure #####" print* contains !******************************************************************************* ! get period index subroutine FindTimePer XPer = 0 ; QPer = MissVal do XPer = XPer + 1 PerSubBeg = index(GivenFile,PerSub(XPer)) if (PerSubBeg.GT.0) QPer = XPer if (XPer.EQ.PerN.OR.QPer.GT.0) exit end do end subroutine FindTimePer !******************************************************************************* ! get variable index subroutine FindVariable XVar = 0 ; QVar = MissVal do XVar = XVar + 1 VarSubBeg = index(GivenFile,VarSub(XVar)) if (VarSubBeg.GT.0) QVar = XVar if (XVar.EQ.VarN.OR.QVar.GT.0) exit end do end subroutine FindVariable !******************************************************************************* ! get .htm filepaths subroutine GetHTMPaths print* print*, " > Enter the .htm save file, without any region name: " Template = SavePath (Blank,'.htm') StemBeg = index (Template,'.htm') Stem = Template (1:(StemBeg-1)) // "." Tip = ".htm" call MakeBatch (Stem,Tip,RegNames,OutFile) !print*, "OutFile(1)=", trim(OutFile(1)) !@@@@@@@@@@@@@@@@@@@@@@@@@ end subroutine GetHTMPaths !******************************************************************************* ! save each .htm in turn subroutine SaveHTM print* print*, " > Saving regions to .htm files..." HTMCountry = '/cru/mikeh1/f709762/f90/goglo/_ref/htm/htm-country.txt' HTMTable = '/cru/mikeh1/f709762/f90/goglo/_ref/htm/htm-table.txt' do XReg = 1, RegN open (4, file=HTMCountry, status="replace", action="write", iostat=ReadStatus) write (4,"(a)"), trim(adjustl(RegNames(XReg))) close (4) open (4, file=HTMTable, status="replace", action="write", iostat=ReadStatus) do XVar = 1, VarN String = '

' // trim(adjustl(VarText(XVar))) StrLen = len_trim(VarText(XVar)) if (StrLen.LT.8) then do XChar = 1, (8-StrLen) String = trim(String) // ' ' end do end if write (4,"(a)"), String do XPer = 1, PerN if (VarSub(XVar).EQ.'pre') then String = GetTextFromInt (nint(Data(XReg,XVar,XPer))) else String = GetTextFromReal (Data(XReg,XVar,XPer)) end if StrLen = len_trim(String) if (StrLen.LT.5) then do XChar = 1, (5-StrLen) String = ' ' // trim(String) end do end if if (XPer.EQ.2.OR.XPer.EQ.6) String = '   ' // trim(String) write (4,"(a)"), String end do write (4,"(a)"), '' end do close (4) call system ( 'cat /cru/mikeh1/f709762/f90/goglo/_ref/htm/htm-part1.txt ' // HTMCountry // & ' /cru/mikeh1/f709762/f90/goglo/_ref/htm/htm-part2.txt ' // HTMCountry // & ' /cru/mikeh1/f709762/f90/goglo/_ref/htm/htm-part3.txt ' // HTMCountry // & ' /cru/mikeh1/f709762/f90/goglo/_ref/htm/htm-part4.txt ' // HTMCountry // & ' /cru/mikeh1/f709762/f90/goglo/_ref/htm/htm-part5.txt ' // HTMCountry // & ' /cru/mikeh1/f709762/f90/goglo/_ref/htm/htm-after5.txt ' // HTMTable // & ' /cru/mikeh1/f709762/f90/goglo/_ref/htm/htm-toend.txt > ' // OutFile(XReg) ) ! ' /cru/mikeh1/f709762/f90/goglo/_ref/htm/htm-part6.txt ' // HTMTable // & ! ' /cru/mikeh1/f709762/f90/goglo/_ref/htm/htm-part7.txt > ' // OutFile(XReg) ) end do end subroutine SaveHTM !******************************************************************************* ! end end program MakeHTM2