From c3f32d240be5a7767b3b7f2de4f90aac49e03ec2 Mon Sep 17 00:00:00 2001 From: Joao Sobrinho Date: Fri, 17 Aug 2018 12:11:42 +0100 Subject: [PATCH] fork update --- Software/ConvertToHDF5/ConvertToHDF5.F90 | 9 +- .../ConvertToHDF5/ModuleDelft3D_2_Mohid.F90 | 245 +++- .../ConvertToHDF5/ModuleGlueHDF5Files.F90 | 694 +++++++--- .../ConvertToHDF5/ModuleHDF5ToASCIIandBIN.F90 | 4 +- .../ModuleNetCDFCF_2_HDF5MOHID.F90 | 14 +- Software/DDC/DDCWorker/DDCWorker.F90 | 2 +- .../ModuleDDC.F90 | 16 +- Software/HDF5Exporter/ModuleHDF5Exporter.f90 | 13 +- .../HDF5Extractor/ModuleHDF5Extractor.F90 | 1 + Software/MOHIDBase1/ModuleEnterData.F90 | 4 +- Software/MOHIDBase1/ModuleFunctions.F90 | 439 +++--- Software/MOHIDBase1/ModuleGlobalData.F90 | 6 + Software/MOHIDBase1/ModuleSedimentQuality.F90 | 2 +- Software/MOHIDBase2/ModuleAtmosphere.F90 | 13 +- Software/MOHIDBase2/ModuleField4D.F90 | 123 +- Software/MOHIDBase2/ModuleGeometry.F90 | 163 +-- Software/MOHIDBase2/ModuleHorizontalGrid.F90 | 531 ++------ Software/MOHIDBase2/ModuleNETCDF.F90 | 3 +- Software/MOHIDLand/ModuleBasin.F90 | 14 +- Software/MOHIDLand/ModulePorousMedia.F90 | 2 +- Software/MOHIDLand/ModuleRunOff.F90 | 322 +++-- Software/MOHIDLand/ModuleRunoffProperties.F90 | 8 +- Software/MOHIDWater/GOTMVariables_in.F90 | 4 + Software/MOHIDWater/Main.F90 | 21 +- Software/MOHIDWater/ModuleGOTM.F90 | 1 - Software/MOHIDWater/ModuleGauge.F90 | 2 +- Software/MOHIDWater/ModuleHydrodynamic.F90 | 1183 ++++++++++------- .../MOHIDWater/ModuleLagrangianGlobal.F90 | 17 +- Software/MOHIDWater/ModuleModel.F90 | 3 + .../ModuleSequentialAssimilation.F90 | 8 +- Software/MOHIDWater/ModuleTurbulence.F90 | 6 +- Software/MOHIDWater/ModuleWaterProperties.F90 | 679 ++++++---- Software/MOHIDWater/ModuleWaves.F90 | 6 +- Software/MOHIDWater/mpif.F90 | 4 + 34 files changed, 2497 insertions(+), 2065 deletions(-) diff --git a/Software/ConvertToHDF5/ConvertToHDF5.F90 b/Software/ConvertToHDF5/ConvertToHDF5.F90 index e49f4f05b..bd1e85a6a 100644 --- a/Software/ConvertToHDF5/ConvertToHDF5.F90 +++ b/Software/ConvertToHDF5/ConvertToHDF5.F90 @@ -67,6 +67,7 @@ program ConvertToHDF5 use ModuleMOG2DFormat use ModuleIHRadarFormat #endif + use ModuleDelft3D_2_Mohid implicit none @@ -109,6 +110,8 @@ program ConvertToHDF5 character(len = StringLength), parameter:: GluesHD5Files = 'GLUES HDF5 FILES' character(len = StringLength), parameter:: PatchHD5Files = 'PATCH HDF5 FILES' character(len = StringLength), parameter:: ConvertIHRadarFormatToHDF5 = 'CONVERT IH RADAR FORMAT' + + character(len = StringLength), parameter:: ConvertDelft3DFormatToHDF5 = 'CONVERT DELFT3D FORMAT' logical :: WatchPassedAsArgument = .false. logical :: Watch = .false. @@ -263,7 +266,7 @@ subroutine ReadOptions if (DataFile == null_str) then !Read input file name from nomfich file - call ReadFileName('IN_MODEL', DataFile, "Convert2netcdf", STAT = STAT_CALL) + call ReadFileName('IN_MODEL', DataFile, "ConvertToHDF5", STAT = STAT_CALL) if (STAT_CALL == FILE_NOT_FOUND_ERR_) then DataFile = 'ConvertToHDF5Action.dat' @@ -525,6 +528,10 @@ subroutine ReadOptions call ConvertIHRadarFormat(ObjEnterData, ClientNumber, STAT = STAT_CALL) if(STAT_CALL .ne. SUCCESS_) stop 'ReadOptions - ConvertToHDF5 - ERR270' #endif + + case (ConvertDelft3DFormatToHDF5) + + call ConvertDelft3D_2_Mohid(ObjEnterData, ClientNumber, STAT = STAT_CALL) case default diff --git a/Software/ConvertToHDF5/ModuleDelft3D_2_Mohid.F90 b/Software/ConvertToHDF5/ModuleDelft3D_2_Mohid.F90 index 241eb7e0c..0a101b864 100644 --- a/Software/ConvertToHDF5/ModuleDelft3D_2_Mohid.F90 +++ b/Software/ConvertToHDF5/ModuleDelft3D_2_Mohid.F90 @@ -69,6 +69,9 @@ Module ModuleDelft3D_2_Mohid logical :: Ocean_IN logical :: Ocean_IN_Ini logical :: Ocean_IN_Bound + !testing + logical :: Ocean_Read_Hydro + integer :: AtmNumber character(len=PathLength ), dimension(:), pointer :: AtmPropFile @@ -268,6 +271,10 @@ subroutine ConvertDelft3D_2_Mohid(ObjEnterData, ClientNumber, STAT) if (Me%Ocean_IN) call WriteModInOut + if (Me%Ocean_Read_Hydro) then + call ReadHydro + endif + nUsers = DeassociateInstance(mENTERDATA_, ObjEnterData) if (nUsers == 0) stop 'ConvertDelft3D_2_Mohid - ModuleDelft3D_2_Mohid - ERR10' @@ -490,6 +497,19 @@ subroutine ReadGlobalOptions endif endif + + call GetData(Me%Ocean_Read_Hydro, & + Me%ObjEnterData, iflag, & + SearchType = FromBlock, & + keyword = 'OCEAN_READ_HYDRO', & + default = .false., & + ClientModule = 'ModuleDelft3D_2_Mohid', & + STAT = STAT_CALL) + if (STAT_CALL /= SUCCESS_) then + stop 'ReadGlobalOptions - ModuleDelft3D_2_Mohid - ERR50' + endif + + end subroutine ReadGlobalOptions @@ -821,6 +841,8 @@ subroutine ConstructModProp(block_begin, block_end, ObjField4D, PropID, ValueIni real :: LatReference, LonReference, ValueIni_ logical :: BlockInBlockFound character(len=PathLength) :: FilenameIn + real, dimension(1:2,1:2) :: WindowLimitsXY + real :: West, East, South, North !Begin----------------------------------------------------------------- @@ -830,6 +852,16 @@ subroutine ConstructModProp(block_begin, block_end, ObjField4D, PropID, ValueIni if (STAT_CALL /= SUCCESS_) then stop 'ConstructModProp - ModuleDelft3D_2_Mohid - ERR10' endif + + call GetGridBorderLimits(Me%ObjMod_Grid_Out, West, East, South, North, STAT = STAT_CALL) + if (STAT_CALL /= SUCCESS_) then + stop 'ConstructModProp - ModuleDelft3D_2_Mohid - ERR20' + endif + + WindowLimitsXY(2,1) = South + WindowLimitsXY(2,2) = North + WindowLimitsXY(1,1) = West + WindowLimitsXY(1,2) = East call ExtractBlockFromBlock (Me%ObjEnterData, & ClientNumber = Me%ClientNumber, & @@ -864,7 +896,8 @@ subroutine ConstructModProp(block_begin, block_end, ObjField4D, PropID, ValueIni TimeID = Me%ObjTime, & FileName = FilenameIn, & LatReference = LatReference, & - LonReference = LonReference, & + LonReference = LonReference, & + WindowLimitsXY= WindowLimitsXY, & Extrapolate = .true., & PropertyID = PropID, & ClientID = Me%ClientNumber, & @@ -1533,6 +1566,7 @@ subroutine ReadBoundCells !Local----------------------------------------------------------------- character(len=StringLength) :: CharRead integer :: STAT_CALL, nlines, i + logical :: StopRun !---------------------------------------------------------------------- @@ -1573,11 +1607,28 @@ subroutine ReadBoundCells Me%BoundSectionsName(i) = CharRead(1:15) enddo + StopRun = .false. + + do i=1, Me%BoundCellsNumber + if (Me%BoundCellsJ(i) > Me%ModWorkSize3D%JUB .or. Me%BoundCellsJ(i) < Me%ModWorkSize3D%JLB) then + write(*,*) 'Bound cell number =', i, 'is not define correctly. Not valid column =',Me%BoundCellsJ(i) + StopRun = .true. + endif + if (Me%BoundCellsI(i) > Me%ModWorkSize3D%IUB .or. Me%BoundCellsI(i) < Me%ModWorkSize3D%ILB) then + write(*,*) 'Bound cell number =', i, 'is not define correctly. Not valid line =',Me%BoundCellsI(i) + StopRun = .true. + endif + enddo + + if (StopRun) then + stop 'ReadBoundCells - ModuleDelft3D_2_Mohid - ERR30' + endif + call UnitsManager(Me%BoundCellsUnit, CLOSE_FILE, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) then - stop 'ReadBoundCells - ModuleDelft3D_2_Mohid - ERR30' + stop 'ReadBoundCells - ModuleDelft3D_2_Mohid - ERR40' endif end subroutine ReadBoundCells @@ -1981,6 +2032,8 @@ subroutine ReadBound2D(CurrentTime, Instant, ObjField4D, PropIDNumber, OutProp2D do ip= 1, Me%BoundCellsNumber if (Me%BoundNoDataXY2D(ip)) then + write(*,*) "Boundary cell =", ip + write(*,*) "Instant =", Instant stop 'ReadBound2D - ModuleDelft3D_2_Mohid - ERR20' else OutProp2D(ip, Instant) = Me%BoundPropXY2D(iP) @@ -2026,6 +2079,9 @@ subroutine ReadBound3D(CurrentTime, Instant, ObjField4D, PropIDNumber, OutProp3D do k=1, Me%ModNlayers icount = icount + 1 if (Me%BoundNoDataXYZ3D(icount)) then + write(*,*) "Boundary cell =", ip + write(*,*) "Layer =", k + write(*,*) "Instant =", Instant stop 'ReadBound3D - ModuleDelft3D_2_Mohid - ERR20' else OutProp3D(ip, k, Instant) = Me%BoundPropXYZ3D(icount) @@ -2068,48 +2124,54 @@ subroutine ComputeRiemann(Instant) do k=1, Me%ModNlayers !Initialization Riemann = 0. - !m/s s-1 * m - Riemann = CH * (Me%BoundSSH_XYT2D(ip, Instant)) - + + Riemann = Riemann + Me%BoundVely3D_XYZT3D(ip,k,instant) + if (Me%BoundAstro) then - Riemann = Riemann + CH * (Me%BoundSSH_ASTRO_XYT2D(ip, Instant)) - endif + Riemann = Riemann + Me%BoundVely3D_Astro_XYZT3D(ip,k,instant) + endif + !south boundary if (i == Me%ModWorkSize3d%ILB) then - Riemann = Riemann + Me%BoundVely3D_XYZT3D(ip,k,instant) - + + !m/s s-1 * m + Riemann = Riemann + CH * (Me%BoundSSH_XYT2D(ip, Instant)) + if (Me%BoundAstro) then - Riemann = Riemann + Me%BoundVely3D_Astro_XYZT3D(ip,k,instant) - endif - + Riemann = Riemann + CH * (Me%BoundSSH_ASTRO_XYT2D(ip, Instant)) + endif + + !north boundary elseif (i == Me%ModWorkSize3d%IUB) then - Riemann = Riemann - Me%BoundVely3D_XYZT3D(ip,k,instant) - + !m/s s-1 * m + Riemann = Riemann - CH * (Me%BoundSSH_XYT2D(ip, Instant)) + if (Me%BoundAstro) then - Riemann = Riemann - Me%BoundVely3D_Astro_XYZT3D(ip,k,instant) - endif - + Riemann = Riemann - CH * (Me%BoundSSH_ASTRO_XYT2D(ip, Instant)) + endif + !west boundary elseif (j == Me%ModWorkSize3d%JLB) then + + !m/s s-1 * m + Riemann = Riemann + CH * (Me%BoundSSH_XYT2D(ip, Instant)) - Riemann = Riemann + Me%BoundVelx3D_XYZT3D(ip,k,instant) - if (Me%BoundAstro) then - Riemann = Riemann + Me%BoundVelx3D_Astro_XYZT3D(ip,k,instant) - endif + Riemann = Riemann + CH * (Me%BoundSSH_ASTRO_XYT2D(ip, Instant)) + endif + !east boundary elseif (j == Me%ModWorkSize3d%JUB) then - - Riemann = Riemann - Me%BoundVelx3D_XYZT3D(ip,k,instant) - + !m/s s-1 * m + Riemann = Riemann - CH * (Me%BoundSSH_XYT2D(ip, Instant)) + if (Me%BoundAstro) then - Riemann = Riemann - Me%BoundVelx3D_Astro_XYZT3D(ip,k,instant) - endif + Riemann = Riemann - CH * (Me%BoundSSH_ASTRO_XYT2D(ip, Instant)) + endif - endif Me%BoundRiemannXYZT3(ip, k, Instant) = Riemann @@ -2221,7 +2283,8 @@ subroutine WriteModInOut call ModBound endif - + + call KillField4D(Field4DID = Me%ObjField4D_SSH, & STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) then @@ -2342,7 +2405,7 @@ subroutine ModBound Instant = it, & ObjField4D = Me%ObjField4D_VelY_Astro, & PropIDNumber = Me%VelYProp%IDNumber, & - OutProp3D = Me%BoundVely3D_Astro_XYZT3D) + OutProp3D = Me%BoundVely3D_Astro_XYZT3D) endif @@ -2384,6 +2447,130 @@ subroutine ModBound end subroutine ModBound !--------------------------------------------------------------------------- + + !--------------------------------------------------------------------------- + + subroutine ReadHydro + + + !Arguments------------------------------------------------------------- + + !Local----------------------------------------------------------------- + integer :: it + type (T_Time) :: CurrentTime + real, dimension(:,:), pointer :: CoordX, CoordY + integer :: STAT_CALL + + !---------------------------------------------------------------------- + + if (Me%ObjMod_Grid_Out == 0) call ConstructModGrid + + call ConstructModProp( block_begin = '<>', & + block_end = '<>', & + ObjField4D = Me%ObjField4D_Ssh, & + PropID = Me%SSHProp, & + ValueIni = Me%SSHValueIni) + + call ConstructModProp( block_begin = '<>', & + block_end = '<>', & + ObjField4D = Me%ObjField4D_VelX, & + PropID = Me%VelXProp, & + ValueIni = Me%VelxValueIni) + + call ConstructModProp( block_begin = '<>', & + block_end = '<>', & + ObjField4D = Me%ObjField4D_VelY, & + PropID = Me%VelYProp, & + ValueIni = Me%VelyValueIni) + + CurrentTime = Me%BeginTime + + call GetZCoordinates(Me%ObjMod_Grid_Out, CoordX, CoordY, STAT = STAT_CALL) + if (STAT_CALL/=SUCCESS_) then + stop 'ReadHydro - ModuleDelft3D_2_Mohid - ERR10' + endif + + + + allocate(Me%BoundX2D (1)) + allocate(Me%BoundY2D (1)) + allocate(Me%BoundPropXY2D (1)) + allocate(Me%BoundNoDataXY2D (1)) + + allocate(Me%BoundX3D (1)) + allocate(Me%BoundY3D (1)) + allocate(Me%BoundZ3D (1)) + allocate(Me%BoundPropXYZ3D (1)) + allocate(Me%BoundNoDataXYZ3D (1)) + + Me%BoundX2D (1) = CoordX(1, 1) + Me%BoundY2D (1) = CoordY(1, 1) + + Me%BoundX3D (1) = CoordX(1, 1) + Me%BoundY3D (1) = CoordY(1, 1) + Me%BoundZ3D (1) = 0. + + it = 0 + + do while (CurrentTime<=Me%EndTime) + + it = it + 1 + + !SSH + call ReadBound2D( CurrentTime = CurrentTime, & + Instant = it, & + ObjField4D = Me%ObjField4D_SSH, & + PropIDNumber = Me%SSHProp%IDNumber, & + OutProp2D = Me%BoundSSH_XYT2D) + + !velocity X + call ReadBound3D( CurrentTime = CurrentTime, & + Instant = it, & + ObjField4D = Me%ObjField4D_VelX, & + PropIDNumber = Me%VelXProp%IDNumber, & + OutProp3D = Me%BoundVelx3D_XYZT3D) + + + !velocity Y + call ReadBound3D( CurrentTime = CurrentTime, & + Instant = it, & + ObjField4D = Me%ObjField4D_VelY, & + PropIDNumber = Me%VelYProp%IDNumber, & + OutProp3D = Me%BoundVely3D_XYZT3D) + + + CurrentTime = CurrentTime + Me%DT + + + + enddo + + deallocate(Me%BoundX2D ) + deallocate(Me%BoundY2D ) + deallocate(Me%BoundPropXY2D ) + deallocate(Me%BoundNoDataXY2D ) + + deallocate(Me%BoundX3D ) + deallocate(Me%BoundY3D ) + deallocate(Me%BoundZ3D ) + deallocate(Me%BoundPropXYZ3D ) + deallocate(Me%BoundNoDataXYZ3D) + + call UnGetHorizontalGrid(Me%ObjMod_Grid_Out, CoordX, STAT = STAT_CALL) + + if (STAT_CALL/=SUCCESS_) then + stop 'ReadHydro - ModuleDelft3D_2_Mohid - ERR20' + endif + + call UnGetHorizontalGrid(Me%ObjMod_Grid_Out, CoordY, STAT = STAT_CALL) + + if (STAT_CALL/=SUCCESS_) then + stop 'ReadHydro - ModuleDelft3D_2_Mohid - ERR30' + endif + + end subroutine ReadHydro + + !--------------------------------------------------------------------------- subroutine ModIni(CurrentTime) diff --git a/Software/ConvertToHDF5/ModuleGlueHDF5Files.F90 b/Software/ConvertToHDF5/ModuleGlueHDF5Files.F90 index e0e93f226..52ea44f64 100644 --- a/Software/ConvertToHDF5/ModuleGlueHDF5Files.F90 +++ b/Software/ConvertToHDF5/ModuleGlueHDF5Files.F90 @@ -61,13 +61,26 @@ Module ModuleGlueHDF5Files !Types--------------------------------------------------------------------- + private :: T_TimeMap + type T_TimeMap + integer, dimension(:), pointer :: FirstInstantBest + integer, dimension(:), pointer :: LastInstantBest + integer, dimension(:), pointer :: ObjHDF5_ID + integer(HID_T), dimension(:), pointer :: File_ID + type (T_Time), dimension(:), pointer :: FirstDateBest + type (T_Time), dimension(:), pointer :: LastDateBest + integer :: PresentFile + logical :: BestTimeSerieON = .true. + end type T_TimeMap + + private :: T_GlueHDF5Files type T_GlueHDF5Files integer :: ObjEnterData = 0 integer :: ObjHDF5_In = 0 integer :: ObjHDF5_Out = 0 - character(len=PathLength), dimension(:), pointer :: FileNameIn - integer, dimension(:), pointer :: FirstInstant + character(len=PathLength), dimension(:), pointer :: FileNameIn + integer, dimension(:), pointer :: FirstInstant type (T_Time) :: LastInstant character(len=PathLength) :: FileNameOut integer :: FileNameInNumber @@ -76,9 +89,10 @@ Module ModuleGlueHDF5Files logical :: GlueInTime character(len=PathLength) :: BaseGroup character(len=PathLength) :: TimeGroup + type (T_TimeMap) :: TimeMap end type T_GlueHDF5Files - type(T_GlueHDF5Files), pointer :: Me + type(T_GlueHDF5Files), pointer :: Me !-------------------------------------------------------------------------- @@ -171,7 +185,7 @@ subroutine ReadOptions(ClientNumber) Me%ObjEnterData, iflag, & SearchType = FromBlock, & keyword = '3D_OPEN', & - default = .false., & + default = .false., & ClientModule = 'ModuleGlueHDF5Files', & STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) stop 'ReadOptions - ModuleGlueHDF5Files - ERR40' @@ -206,12 +220,25 @@ subroutine ReadOptions(ClientNumber) Default = .true., & ClientModule = 'ModuleGlueHDF5Files', & STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'ReadOptions - ModuleGlueHDF5Files - ERR60' - + if (STAT_CALL /= SUCCESS_) stop 'ReadOptions - ModuleGlueHDF5Files - ERR70' + + if (Me%GlueInTime) then + call GetData(Me%TimeMap%BestTimeSerieON, & + Me%ObjEnterData, iflag, & + SearchType = FromBlock, & + keyword = 'BEST_TIME_SERIE', & + Default = .false., & + ClientModule = 'ModuleGlueHDF5Files', & + STAT = STAT_CALL) + if (STAT_CALL /= SUCCESS_) stop 'ReadOptions - ModuleGlueHDF5Files - ERR80' + else + Me%TimeMap%BestTimeSerieON = .false. + endif + do1 : do - call ExtractBlockFromBlock(Me%ObjEnterData, ClientNumber, & - '<>', '<>', BlockFound, & - FirstLine = FirstLine, LastLine = LastLine, & + call ExtractBlockFromBlock(Me%ObjEnterData, ClientNumber, & + '<>', '<>', BlockFound, & + FirstLine = FirstLine, LastLine = LastLine, & STAT = STAT_CALL) if1 : if(STAT_CALL .EQ. SUCCESS_) then @@ -228,7 +255,7 @@ subroutine ReadOptions(ClientNumber) call GetData(FileNameAux, Me%ObjEnterData, iflag, & Buffer_Line = FirstLine + i, & STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'ReadOptions - ModuleGlueHDF5Files - ERR70' + if (STAT_CALL /= SUCCESS_) stop 'ReadOptions - ModuleGlueHDF5Files - ERR90' if (GetHDF5FileOkToRead(FileNameAux)) then iAux2 = iAux2 + 1 @@ -253,7 +280,7 @@ subroutine ReadOptions(ClientNumber) else if (STAT_CALL .EQ. BLOCK_END_ERR_) then if1 write(*,*) write(*,*) 'Error calling ExtractBlockFromBuffer. ' - if(STAT_CALL .ne. SUCCESS_)stop 'ReadOptions - ModuleGlueHDF5Files - ERR80' + if(STAT_CALL .ne. SUCCESS_)stop 'ReadOptions - ModuleGlueHDF5Files - ERR100' end if if1 end do do1 @@ -277,8 +304,6 @@ subroutine GlueProcess !Begin----------------------------------------------------------------- - call InquireFile(Me%FileNameIn(1)) - ! NIX #ifdef _USE_NIX write(aux, *) 'cp ',trim(Me%FileNameIn(1)), ' ',trim(Me%FileNameOut) @@ -296,54 +321,300 @@ subroutine GlueProcess call ConstructHDF5 (Me%ObjHDF5_Out, Me%FileNameOut, & Access = HDF5_READWRITE, STAT = STAT_CALL) - !only verify group compatibility if glueing in time - !if adding results groups need to verify if time is the same - if (Me%GlueInTime) then - write (*,*) - write (*,*) 'Glueing HDF files...' + + if (Me%TimeMap%BestTimeSerieON) then + + call BestTimeSerieGlue + + else + + call InquireFile(Me%FileNameIn(1)) + + + + !only verify group compatibility if glueing in time + !if adding results groups need to verify if time is the same + if (Me%GlueInTime) then + write (*,*) + write (*,*) 'Glueing HDF files...' - do i=2, Me%FileNameInNumber + do i=2, Me%FileNameInNumber - call CheckVGCompatibility(i) + call CheckVGCompatibility(i) - enddo - else - write (*,*) - write (*,*) 'Merging HDF files...' + enddo + else + write (*,*) + write (*,*) 'Merging HDF files...' - do i=2, Me%FileNameInNumber + do i=2, Me%FileNameInNumber - call InquireFile(Me%FileNameIn(i)) + call InquireFile(Me%FileNameIn(i)) - !check if times are the same and bathymetries have same dimension - call CheckTimeAndBathymetry(i) + !check if times are the same and bathymetries have same dimension + call CheckTimeAndBathymetry(i) - !add the new groups not existing in the output - call CheckGroupExistence(i) + !add the new groups not existing in the output + call CheckGroupExistence(i) - !neded for glue. first instant is always used because no glueintime occurs - Me%FirstInstant(i) = 1 + !neded for glue. first instant is always used because no glueintime occurs + Me%FirstInstant(i) = 1 - enddo + enddo + endif + + do i=2, Me%FileNameInNumber + + call GlueFileIn(i) + + enddo + + if (Me%GlueInTime) then + write (*,*) + write (*,*) 'Finished Glueing HDF files!' + else + write (*,*) + write (*,*) 'Finished Merging HDF files!' + endif + + endif + + end subroutine GlueProcess + + !-------------------------------------------------------------------------- + + subroutine BestTimeSerieGlue + + !Local----------------------------------------------------------------- + integer :: i, STAT_CALL + integer :: HDF5_READ + integer(HID_T) :: IDOut, gr_id + logical :: CheckOK + + + !Begin----------------------------------------------------------------- + + call GetHDF5FileID (Me%ObjHDF5_Out, IDOut, STAT = STAT_CALL) + if (STAT_CALL /= 0) stop 'BestTimeSerieGlue - ModuleGlueHDF5Files - ERR10' + + call h5gopen_f (IDOut, "/", gr_id, STAT_CALL) + + call h5ldelete_f(loc_id = gr_id, & + name = "/Results", & + hdferr = STAT_CALL) + if (STAT_CALL /= 0) stop 'BestTimeSerieGlue - ModuleGlueHDF5Files - ERR20' + + call h5ldelete_f(loc_id = gr_id, & + name = "/Time", & + hdferr = STAT_CALL) + if (STAT_CALL /= 0) stop 'BestTimeSerieGlue - ModuleGlueHDF5Files - ERR30' + + + call GetHDF5GroupExist(Me%ObjHDF5_Out, "/Grid/VerticalZ", Me%Vert3D, STAT = STAT_CALL) + if (STAT_CALL /= SUCCESS_) then + stop 'BestTimeSerieGlue - ModuleGlueHDF5Files - ERR40' + endif + + if (Me%Vert3D) then + call h5ldelete_f(loc_id = gr_id, & + name = "/Grid/VerticalZ", & + hdferr = STAT_CALL) + if (STAT_CALL /= 0) stop 'BestTimeSerieGlue - ModuleGlueHDF5Files - ERR50' endif + call GetHDF5GroupExist(Me%ObjHDF5_Out, "/Grid/OpenPoints", Me%Open3D, STAT = STAT_CALL) + if (STAT_CALL /= SUCCESS_) then + stop 'BestTimeSerieGlue - ModuleGlueHDF5Files - ERR60' + endif + + if (Me%Open3D) then + call h5ldelete_f(loc_id = gr_id, & + name = "/Grid/OpenPoints", & + hdferr = STAT_CALL) + if (STAT_CALL /= 0) stop 'BestTimeSerieGlue - ModuleGlueHDF5Files - ERR70' + endif + + + allocate(Me%TimeMap%ObjHDF5_ID(1:Me%FileNameInNumber)) + allocate(Me%TimeMap%File_ID (1:Me%FileNameInNumber)) + + Me%TimeMap%ObjHDF5_ID(1:Me%FileNameInNumber) = 0 + Me%TimeMap%File_ID (1:Me%FileNameInNumber) = 0 + + !Gets File Access Code + call GetHDF5FileAccess (HDF5_READ = HDF5_READ) + + do i=1, Me%FileNameInNumber + + call InquireFile(Me%FileNameIn(i)) + + call ConstructHDF5 (Me%TimeMap%ObjHDF5_ID(i), Me%FileNameIn(i), & + Access = HDF5_READ, STAT = STAT_CALL) + if (STAT_CALL /= SUCCESS_) then + stop 'BestTimeSerieGlue - ModuleGlueHDF5Files - ERR80' + endif + + call GetHDF5FileID (HDF5ID = Me%TimeMap%ObjHDF5_ID(i), FileID = Me%TimeMap%File_ID(i), STAT = STAT_CALL) + if (STAT_CALL /= SUCCESS_) then + stop 'BestTimeSerieGlue - ModuleGlueHDF5Files - ERR90' + endif + + + enddo + + do i=2, Me%FileNameInNumber + + CheckOK = .true. + + call CompareSubGroups (Me%TimeMap%File_ID(i), Me%TimeMap%File_ID(i-1), "/", "/", CheckOK) + + if (.not.CheckOK) then + write(*,*) trim(Me%FileNameIn(i))//" is not a compatible file" + stop 'BestTimeSerieGlue - ModuleGlueHDF5Files - ERR100' + endif + + enddo + + + call AddNewGroupsToOutput(IDin = Me%TimeMap%File_ID(1), GroupName = "/") + + + call ConstructTimeMap + + do i=1, Me%FileNameInNumber + + !neded for glue. first instant is always used because no glueintime occurs + Me%FirstInstant(i) = 1 + + enddo + + do i=1, Me%FileNameInNumber + + call KillHDF5(Me%TimeMap%ObjHDF5_ID(i), STAT = STAT_CALL) + if (STAT_CALL /= SUCCESS_) then + stop 'BestTimeSerieGlue - ModuleGlueHDF5Files - ERR110' + endif + + enddo + do i=1, Me%FileNameInNumber + call GlueFileIn(i) enddo + + + + + end subroutine BestTimeSerieGlue + + !-------------------------------------------------------------------------- + + subroutine ConstructTimeMap + + !Arguments------------------------------------------------------------- + + !Local----------------------------------------------------------------- + integer :: i, j, STAT_CALL, nItems + type (T_Time) :: DateAux - if (Me%GlueInTime) then - write (*,*) - write (*,*) 'Finished Glueing HDF files!' - else - write (*,*) - write (*,*) 'Finished Merging HDF files!' - endif - end subroutine GlueProcess + !Begin----------------------------------------------------------------- + + allocate(Me%TimeMap%FirstInstantBest(1:Me%FileNameInNumber)) + allocate(Me%TimeMap%LastInstantBest (1:Me%FileNameInNumber)) - !-------------------------------------------------------------------------- + allocate(Me%TimeMap%FirstDateBest (1:Me%FileNameInNumber)) + allocate(Me%TimeMap%LastDateBest (1:Me%FileNameInNumber)) + + + do i = Me%FileNameInNumber, 1, -1 + + Me%TimeMap%FirstInstantBest(i) = 0 + Me%TimeMap%LastInstantBest (i) = 0 + + + call GetHDF5GroupNumberOfItems (HDF5ID = Me%TimeMap%ObjHDF5_ID(i), & + GroupName = "/Time", & + nItems = nItems, & + STAT = STAT_CALL) + + if (i == Me%FileNameInNumber) then + + Me%TimeMap%FirstInstantBest(i) = 1 + Me%TimeMap%LastInstantBest (i) = nItems + + Me%TimeMap%FirstDateBest (i) = HDF5TimeInstant(HDF5ID = Me%TimeMap%ObjHDF5_ID(i), Instant = 1) + Me%TimeMap%LastDateBest (i) = HDF5TimeInstant(HDF5ID = Me%TimeMap%ObjHDF5_ID(i), Instant = nItems) + + else + do j = nItems, 1, -1 + + DateAux = HDF5TimeInstant(HDF5ID = Me%TimeMap%ObjHDF5_ID(i), Instant = j) + + if (DateAux < Me%TimeMap%FirstDateBest (i+1)) then + + Me%TimeMap%FirstInstantBest(i) = 1 + Me%TimeMap%LastInstantBest (i) = j + + Me%TimeMap%FirstDateBest (i) = HDF5TimeInstant(HDF5ID = Me%TimeMap%ObjHDF5_ID(i), Instant = 1) + Me%TimeMap%LastDateBest (i) = DateAux + + exit + + endif + enddo + endif + + + enddo + + end subroutine ConstructTimeMap + + !-------------------------------------------------------------------------- + + !---------------------------------------------------------------------------- + + + type(T_Time) function HDF5TimeInstant(HDF5ID, Instant) + + !Arguments------------------------------------------------------------- + integer :: Instant + integer :: HDF5ID + + + !Local----------------------------------------------------------------- + real, dimension(:), pointer :: TimeVector + integer :: STAT_CALL + + !Begin----------------------------------------------------------------- + + allocate(TimeVector(6)) + + + call HDF5SetLimits (HDF5ID, 1, 6, STAT = STAT_CALL) + + call HDF5ReadWindow (HDF5ID = HDF5ID, & + GroupName = "/Time", & + Name = "Time", & + Array1D = TimeVector, & + OutputNumber = Instant, & + STAT = STAT_CALL) + if (STAT_CALL /= SUCCESS_)stop 'HDF5TimeInstant - ModuleGlueHDF5Files - ERR10' + + call SetDate(HDF5TimeInstant, Year = TimeVector(1), Month = TimeVector(2), & + Day = TimeVector(3), Hour = TimeVector(4), & + Minute = TimeVector(5), Second = TimeVector(6)) + + + deallocate(TimeVector) + + end function HDF5TimeInstant + + + !-------------------------------------------------------------------------- + subroutine InquireFile(FileName) @@ -369,7 +640,6 @@ subroutine CheckVGCompatibility(i) !Local----------------------------------------------------------------- integer :: i, HDF5_READ, STAT_CALL, IDIn, IDOut logical :: CheckOK - logical :: Vert3D, Open3D !Begin----------------------------------------------------------------- @@ -783,7 +1053,8 @@ end subroutine AddNewGroupsToOutput subroutine GlueFileIn(i) !Local----------------------------------------------------------------- - integer :: i, HDF5_READ, STAT_CALL, IDIn, IDOut + integer :: i, HDF5_READ, STAT_CALL + integer(HID_T) :: IDIn, IDOut logical :: CheckOK, Exist !Begin----------------------------------------------------------------- @@ -805,8 +1076,18 @@ subroutine GlueFileIn(i) !Only glue time if glueing in time. if not time between files are the same if (Me%GlueInTime) then + + if (Me%TimeMap%BestTimeSerieON) then + call GlueInTimeBest(IDOut = IDOut, & + IDIn = IDIn, & + GroupNameOut = "/Time", & + GroupNameIn = "/Time", & + i = i) + else - call GlueInTime (IDOut, IDIn, '/'//trim(Me%TimeGroup)//'/', '/'//trim(Me%TimeGroup)//'/', Me%FirstInstant(i), CheckOK) + call GlueInTime (IDOut, IDIn, '/'//trim(Me%TimeGroup)//'/', '/'//trim(Me%TimeGroup)//'/', Me%FirstInstant(i), CheckOK) + + endif if (.not.CheckOK) then write(*,*) trim(Me%FileNameIn(i))//" is not a compatible file" @@ -984,7 +1265,8 @@ recursive subroutine CompareSubGroups (IDOut, IDIn, GroupNameOut, GroupNameIn, C end subroutine CompareSubGroups - !-------------------------------------------------------------------------- + + !-------------------------------------------------------------------------- subroutine GlueInTime (IDOut, IDIn, GroupNameOut, GroupNameIn, FirstInstant, Check) @@ -1012,44 +1294,37 @@ subroutine GlueInTime (IDOut, IDIn, GroupNameOut, GroupNameIn, FirstInstant, Che !Get the number of members in the Group call h5gn_members_f(IDOut, GroupNameOut, nmembersOut, STAT_CALL) - - if (STAT_CALL /= 0) stop 'GlueInTime - ModuleHDF5Files - ERR01' + if (STAT_CALL /= SUCCESS_) stop 'GlueInTime - ModuleGlueHDF5Files - ERR10' call h5gn_members_f(IDIn, GroupNameIn, nmembersIn, STAT_CALL) - - if (STAT_CALL /= 0) stop 'GlueInTime - ModuleHDF5Files - ERR02' + if (STAT_CALL /= SUCCESS_) stop 'GlueInTime - ModuleGlueHDF5Files - ERR20' !Gets information about the group call h5gget_obj_info_idx_f(IDOut, GroupNameOut, nmembersOut-1, obj_nameOut, obj_type, STAT_CALL) - - if (STAT_CALL /= 0) stop 'GlueInTime - ModuleHDF5Files - ERR03' + if (STAT_CALL /= SUCCESS_) stop 'GlueInTime - ModuleGlueHDF5Files - ERR30' !Opens the Group call h5gopen_f (IDOut, GroupNameOut, gr_id, STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'HDF5ReadDataR4 - ModuleHDF5 - ERR04' + if (STAT_CALL /= SUCCESS_) stop 'GlueInTime - ModuleGlueHDF5Files - ERR40' !Opens data set call h5dopen_f (gr_id, trim(adjustl(obj_nameOut)), dset_id, STAT_CALL) - - if (STAT_CALL /= 0) stop 'GlueInTime - ModuleHDF5Files - ERR05' - + if (STAT_CALL /= SUCCESS_) stop 'GlueInTime - ModuleGlueHDF5Files - ERR50' + allocate(DataVal(6)) call ReadInterface (dset_id, DataVal, dimsOut, STAT_CALL) - - if (STAT_CALL/=0) stop 'GlueInTime - ModuleHDF5Files - ERR06' + if (STAT_CALL /= SUCCESS_) stop 'GlueInTime - ModuleGlueHDF5Files - ERR60' call SetDate (Me%LastInstant, DataVal(1), DataVal(2), DataVal(3), DataVal(4), DataVal(5), DataVal(6)) !Closes data set call h5dclose_f (dset_id, STAT_CALL) - - if (STAT_CALL /= 0) stop 'GlueInTime - ModuleHDF5Files - ERR07' + if (STAT_CALL /= SUCCESS_) stop 'GlueInTime - ModuleGlueHDF5Files - ERR70' !Closes group call h5gclose_f (gr_id, STAT_CALL) - - if (STAT_CALL /= 0) stop 'GlueInTime - ModuleHDF5Files - ERR08' + if (STAT_CALL /= SUCCESS_) stop 'GlueInTime - ModuleGlueHDF5Files - ERR80' FirstTime = .true. @@ -1061,34 +1336,28 @@ subroutine GlueInTime (IDOut, IDIn, GroupNameOut, GroupNameIn, FirstInstant, Che !Gets information about the group call h5gget_obj_info_idx_f(IDIn, GroupNameIn, idx-1, obj_nameIn, obj_type, STAT_CALL) - - if (STAT_CALL /= 0) stop 'GlueInTime - ModuleHDF5Files - ERR09' + if (STAT_CALL /= SUCCESS_) stop 'GlueInTime - ModuleGlueHDF5Files - ERR90' !Opens the Group call h5gopen_f (IDIn, GroupNameIn, gr_id, STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'HDF5ReadDataR4 - ModuleHDF5 - ERR10' + if (STAT_CALL /= SUCCESS_) stop 'GlueInTime - ModuleGlueHDF5Files - ERR100' !Opens data set call h5dopen_f (gr_id, trim(adjustl(obj_nameIn)), dset_id, STAT_CALL) - - if (STAT_CALL /= 0) stop 'GlueInTime - ModuleHDF5Files - ERR11' + if (STAT_CALL /= SUCCESS_) stop 'GlueInTime - ModuleGlueHDF5Files - ERR110' call ReadInterface (dset_id, DataVal, dims, STAT_CALL) !call h5dread_f(dset_id, H5T_NATIVE_REAL, DataVal, dims, STAT_CALL) - - if (STAT_CALL /= 0) stop 'GlueInTime - ModuleHDF5Files - ERR12' - + if (STAT_CALL /= SUCCESS_) stop 'GlueInTime - ModuleGlueHDF5Files - ERR120' + !Closes data set call h5dclose_f (dset_id, STAT_CALL) - - if (STAT_CALL /= 0) stop 'GlueInTime - ModuleHDF5Files - ERR13' + if (STAT_CALL /= SUCCESS_) stop 'GlueInTime - ModuleGlueHDF5Files - ERR30' !Closes group call h5gclose_f (gr_id, STAT_CALL) - - if (STAT_CALL /= 0) stop 'GlueInTime - ModuleHDF5Files - ERR14' - + if (STAT_CALL /= SUCCESS_) stop 'GlueInTime - ModuleGlueHDF5Files - ERR40' call SetDate (NextTime, DataVal(1), DataVal(2), DataVal(3), DataVal(4), DataVal(5), DataVal(6)) @@ -1118,12 +1387,11 @@ subroutine GlueInTime (IDOut, IDIn, GroupNameOut, GroupNameIn, FirstInstant, Che dset_id, NumType, GroupNameOut, trim(adjustl(Name))) call WriteInterface (dset_id, DataVal, dims, STAT_CALL) - - if (STAT_CALL /= 0) stop 'GlueInTime - ModuleHDF5Files - ERR16' + if (STAT_CALL /= SUCCESS_) stop 'GlueInTime - ModuleGlueHDF5Files - ERR160' + !Closes data set call h5dclose_f (dset_id, STAT_CALL) - - if (STAT_CALL /= 0) stop 'GlueInTime - ModuleHDF5Files - ERR17' + if (STAT_CALL /= SUCCESS_) stop 'GlueInTime - ModuleGlueHDF5Files - ERR170' !Closes group call h5gclose_f (gr_id, STAT_CALL) @@ -1139,6 +1407,112 @@ subroutine GlueInTime (IDOut, IDIn, GroupNameOut, GroupNameIn, FirstInstant, Che end subroutine GlueInTime !-------------------------------------------------------------------------- + + + !-------------------------------------------------------------------------- + + subroutine GlueInTimeBest (IDOut, IDIn, GroupNameOut, GroupNameIn, i) + + !Arguments------------------------------------------------------------- + integer(HID_T) :: IDOut, IDIn + character(len=*) :: GroupNameOut, GroupNameIn + integer :: i + + + !Local----------------------------------------------------------------- + integer :: nmembersOut, nmembersIn + character(StringLength) :: obj_nameIn + integer :: obj_type, idx, NumType + integer(HID_T) :: dset_id, prp_id, gr_id + integer(HID_T) :: space_id + character(StringLength) :: Name + integer :: Rank, STAT_CALL, k + real, allocatable, dimension(:) :: DataVal + integer(HSIZE_T), dimension(7) :: dims + type (T_Time) :: NextTime + + !Begin----------------------------------------------------------------- + + Me%TimeMap%PresentFile = i + + + !Get the number of members in the Group + call h5gn_members_f(IDOut, GroupNameOut, nmembersOut, STAT_CALL) + if (STAT_CALL /= SUCCESS_) stop 'GlueInTimeBest - ModuleGlueHDF5Files - ERR10' + + call h5gn_members_f(IDIn, GroupNameIn, nmembersIn, STAT_CALL) + if (STAT_CALL /= SUCCESS_) stop 'GlueInTimeBest - ModuleGlueHDF5Files - ERR20' + + allocate(DataVal(6)) + + k = 0 + + do idx = Me%TimeMap%FirstInstantBest(i), Me%TimeMap%LastInstantBest(i) + + !Gets information about the group + + call h5gget_obj_info_idx_f(IDIn, GroupNameIn, idx-1, obj_nameIn, obj_type, STAT_CALL) + if (STAT_CALL /= SUCCESS_) stop 'GlueInTimeBest - ModuleGlueHDF5Files - ERR30' + + !Opens the Group + call h5gopen_f (IDIn, GroupNameIn, gr_id, STAT_CALL) + if (STAT_CALL /= SUCCESS_) stop 'GlueInTimeBest - ModuleGlueHDF5Files - ERR40' + + !Opens data set + call h5dopen_f (gr_id, trim(adjustl(obj_nameIn)), dset_id, STAT_CALL) + if (STAT_CALL /= SUCCESS_) stop 'GlueInTimeBest - ModuleGlueHDF5Files - ERR50' + + call ReadInterface (dset_id, DataVal, dims, STAT_CALL) + + !call h5dread_f(dset_id, H5T_NATIVE_REAL, DataVal, dims, STAT_CALL) + + if (STAT_CALL /= SUCCESS_) stop 'GlueInTimeBest - ModuleGlueHDF5Files - ERR60' + + !Closes data set + call h5dclose_f (dset_id, STAT_CALL) + + if (STAT_CALL /= SUCCESS_) stop 'GlueInTimeBest - ModuleGlueHDF5Files - ERR70' + + !Closes group + call h5gclose_f (gr_id, STAT_CALL) + + if (STAT_CALL /= SUCCESS_) stop 'GlueInTimeBest - ModuleGlueHDF5Files - ERR80' + + + call SetDate (NextTime, DataVal(1), DataVal(2), DataVal(3), DataVal(4), DataVal(5), DataVal(6)) + + k = k + 1 + + call ConstructDSName (trim(Me%TimeGroup), nmembersOut + k, Name) + + dims(1) = 6 + dims(2:7) = 0 + Rank = 1 + NumType = H5T_NATIVE_REAL + + !Opens Group, Creates Dset, etc + call PrepareWrite (IDOut, Rank, dims, space_id, prp_id, gr_id, & + dset_id, NumType, GroupNameOut, trim(adjustl(Name))) + + call WriteInterface (dset_id, DataVal, dims, STAT_CALL) + if (STAT_CALL /= SUCCESS_) stop 'GlueInTimeBest - ModuleGlueHDF5Files - ERR90' + + !Closes data set + call h5dclose_f (dset_id, STAT_CALL) + if (STAT_CALL /= SUCCESS_) stop 'GlueInTimeBest - ModuleGlueHDF5Files - ERR100' + + !Closes group + call h5gclose_f (gr_id, STAT_CALL) + + enddo + + + deallocate(DataVal) + + end subroutine GlueInTimeBest + + !-------------------------------------------------------------------------- + recursive subroutine GlueInResults (ObjHDF5_Out, IDOut, IDIn, GroupName, FirstInstant, dataType) @@ -1169,6 +1543,9 @@ recursive subroutine GlueInResults (ObjHDF5_Out, IDOut, IDIn, GroupName, FirstIn integer(HID_T) :: attr_id, type_id character(len=StringLength) :: Units logical :: data_is_integer + integer :: istart, iend + + !Begin----------------------------------------------------------------- @@ -1183,6 +1560,7 @@ recursive subroutine GlueInResults (ObjHDF5_Out, IDOut, IDIn, GroupName, FirstIn k = 0 + do idx = 1, nmembersIn @@ -1193,6 +1571,14 @@ recursive subroutine GlueInResults (ObjHDF5_Out, IDOut, IDIn, GroupName, FirstIn if (STAT_CALL /= 0) stop 'GlueInResults - ModuleHDF5Files - ERR30' if (obj_type == H5G_DATASET_F) then + + if (Me%TimeMap%BestTimeSerieON) then + istart = Me%TimeMap%FirstInstantBest(Me%TimeMap%PresentFile) + iend = Me%TimeMap%LastInstantBest (Me%TimeMap%PresentFile) + if (idx < istart .or. idx > iend) then + cycle + endif + endif !Opens the Group @@ -1236,6 +1622,11 @@ recursive subroutine GlueInResults (ObjHDF5_Out, IDOut, IDIn, GroupName, FirstIn allocate(DataInt2D(1:dims(1),1:dims(2))) call ReadInterface(dset_id, DataInt2D, dims, STAT_CALL) + + else + + data_is_integer = .false. + endif if (STAT_CALL /= 0) stop 'GlueInResults - ModuleHDF5Files - ERR90' @@ -1304,120 +1695,61 @@ recursive subroutine GlueInResults (ObjHDF5_Out, IDOut, IDIn, GroupName, FirstIn if (obj_name(ia:ia) == '_') exit enddo - dims_int = dims + dims_int = dims - if (Rank==1) then + if (Rank==1) then - call HDF5SetLimits (ObjHDF5_Out, 1, dims_int(1), STAT = STAT_CALL) - if (STAT_CALL /= 0) stop 'GlueInResults - ModuleHDF5Files - ERR210' + call HDF5SetLimits (ObjHDF5_Out, 1, dims_int(1), STAT = STAT_CALL) + if (STAT_CALL /= 0) stop 'GlueInResults - ModuleHDF5Files - ERR210' - call HDF5WriteData(ObjHDF5_Out, GroupName, trim(adjustl(obj_name(1:ia-1))), & - Units, Array1D = DataVal1D, OutputNumber = nmembersOut + k, STAT = STAT_CALL) - if (STAT_CALL /= 0) stop 'GlueInResults - ModuleHDF5Files - ERR220' + call HDF5WriteData(ObjHDF5_Out, GroupName, trim(adjustl(obj_name(1:ia-1))), & + Units, Array1D = DataVal1D, OutputNumber = nmembersOut + k, STAT = STAT_CALL) + if (STAT_CALL /= 0) stop 'GlueInResults - ModuleHDF5Files - ERR220' - deallocate(DataVal1D) + deallocate(DataVal1D) - elseif (Rank==2) then + elseif (Rank==2) then - call HDF5SetLimits (ObjHDF5_Out, 1, dims_int(1), 1, dims_int(2), STAT = STAT_CALL) - if (STAT_CALL /= 0) stop 'GlueInResults - ModuleHDF5Files - ERR220' + call HDF5SetLimits (ObjHDF5_Out, 1, dims_int(1), 1, dims_int(2), STAT = STAT_CALL) + if (STAT_CALL /= 0) stop 'GlueInResults - ModuleHDF5Files - ERR220' - if (data_is_integer == .true.) then + if (data_is_integer == .true.) then - call HDF5WriteData(ObjHDF5_Out, GroupName, trim(adjustl(obj_name(1:ia-1))), & - Units, Array2D = DataInt2D, OutputNumber = nmembersOut + k, STAT = STAT_CALL) - if (STAT_CALL /= 0) stop 'GlueInResults - ModuleHDF5Files - ERR225' + call HDF5WriteData(ObjHDF5_Out, GroupName, trim(adjustl(obj_name(1:ia-1))), & + Units, Array2D = DataInt2D, OutputNumber = nmembersOut + k, STAT = STAT_CALL) + if (STAT_CALL /= 0) stop 'GlueInResults - ModuleHDF5Files - ERR225' - deallocate(DataInt2D) - else - call HDF5WriteData(ObjHDF5_Out, GroupName, trim(adjustl(obj_name(1:ia-1))), & - Units, Array2D = DataVal2D, OutputNumber = nmembersOut + k, STAT = STAT_CALL) - if (STAT_CALL /= 0) stop 'GlueInResults - ModuleHDF5Files - ERR230' + deallocate(DataInt2D) + else + call HDF5WriteData(ObjHDF5_Out, GroupName, trim(adjustl(obj_name(1:ia-1))), & + Units, Array2D = DataVal2D, OutputNumber = nmembersOut + k, STAT = STAT_CALL) + if (STAT_CALL /= 0) stop 'GlueInResults - ModuleHDF5Files - ERR230' - deallocate(DataVal2D) - endif + deallocate(DataVal2D) + endif - elseif(Rank == 3) then + elseif(Rank == 3) then - call HDF5SetLimits (ObjHDF5_Out, 1, dims_int(1), 1, dims_int(2),1, dims_int(3), STAT = STAT_CALL) + call HDF5SetLimits (ObjHDF5_Out, 1, dims_int(1), 1, dims_int(2),1, dims_int(3), STAT = STAT_CALL) - if ( present(dataType) ) then - if ( dataType .eq. 2 ) then + if ( present(dataType) ) then + if ( dataType .eq. 2 ) then + call HDF5WriteData(ObjHDF5_Out, GroupName, trim(adjustl(obj_name(1:ia-1))), & + Units, Array3D = DataInt3D, OutputNumber = nmembersOut + k, STAT = STAT_CALL) + if (STAT_CALL /= 0) stop 'GlueInResults - ModuleHDF5Files - ERR240' + deallocate(DataInt3D) + endif + endif + + if ( .not. present(dataType) .or. present(dataType) .and. dataType .eq. 1 ) then call HDF5WriteData(ObjHDF5_Out, GroupName, trim(adjustl(obj_name(1:ia-1))), & - Units, Array3D = DataInt3D, OutputNumber = nmembersOut + k, STAT = STAT_CALL) + Units, Array3D = DataVal3D, OutputNumber = nmembersOut + k, STAT = STAT_CALL) if (STAT_CALL /= 0) stop 'GlueInResults - ModuleHDF5Files - ERR240' - deallocate(DataInt3D) + deallocate(DataVal3D) endif - endif - - if ( .not. present(dataType) .or. present(dataType) .and. dataType .eq. 1 ) then - call HDF5WriteData(ObjHDF5_Out, GroupName, trim(adjustl(obj_name(1:ia-1))), & - Units, Array3D = DataVal3D, OutputNumber = nmembersOut + k, STAT = STAT_CALL) - if (STAT_CALL /= 0) stop 'GlueInResults - ModuleHDF5Files - ERR240' - deallocate(DataVal3D) - endif - - - endif - - !Is assumed that the the data set name is equal the group name -! call ConstructDSName (trim(adjustl(GroupName))//trim(adjustl(obj_name(1:ia-1))), nmembersOut + k, Name) - -! NumType = H5T_NATIVE_REAL - - !Opens Group, Creates Dset, etc -! call PrepareWrite (IDOut, Rank, dims, space_id, prp_id, gr_id, & -! dset_id, NumType, GroupName, trim(adjustl(Name))) - - -! call h5dwrite_f (dset_id, H5T_NATIVE_REAL, DataVal, dims, STAT_CALL) - -! if (STAT_CALL /= 0) stop 'GlueInResults - ModuleHDF5Files - ERR250' - - - !Creates data space for Units -! call h5screate_f (H5S_SCALAR_F, space_id, STAT_CALL) -! if (STAT_CALL /= SUCCESS_) stop 'CreateMinMaxAttribute - ModuleHDF5 - ERR260' - !Copies Type -! call h5Tcopy_f (H5T_NATIVE_CHARACTER, type_id, STAT_CALL) -! if (STAT_CALL /= SUCCESS_) stop 'CreateMinMaxAttribute - ModuleHDF5 - ERR270' - - !Sets Size -! call h5Tset_size_f (type_id, len_trim(Units), STAT_CALL) -! if (STAT_CALL /= SUCCESS_) stop 'CreateMinMaxAttribute - ModuleHDF5 - ERR280' - - !Creates attribute -! call h5acreate_f (gr_id, "Units", type_id, space_id, attr_id, STAT_CALL) -! if (STAT_CALL /= SUCCESS_) stop 'CreateMinMaxAttribute - ModuleHDF5 - ERR290' - - !Writes attribute -! call h5awrite_f (attr_id, type_id, Units, dims, STAT_CALL) -! if (STAT_CALL /= SUCCESS_) stop 'CreateMinMaxAttribute - ModuleHDF5 - ERR300' - - !Close type id -! call h5Tclose_f (type_id, STAT_CALL) -! if (STAT_CALL /= SUCCESS_) stop 'CreateMinMaxAttribute - ModuleHDF5 - ERR310' - - !Closes attribute -! call h5aclose_f (attr_id, STAT_CALL) -! if (STAT_CALL /= SUCCESS_) stop 'CreateMinMaxAttribute - ModuleHDF5 - ERR320' - - !Closes dataspaces -! call h5sclose_f (space_id, STAT_CALL) -! if (STAT_CALL /= SUCCESS_) stop 'CreateMinMaxAttribute - ModuleHDF5 - ERR330' - - - - - !Closes data set -! call h5dclose_f (dset_id, STAT_CALL) - -! if (STAT_CALL /= 0) stop 'GlueInResults - ModuleHDF5Files - ERR340' - - !Closes group -! call h5gclose_f (gr_id, STAT_CALL) + endif endif @@ -1612,8 +1944,20 @@ subroutine KillGlueHDF5Files integer :: STAT_CALL, nUsers !Begin----------------------------------------------------------------- + + if (Me%TimeMap%BestTimeSerieON) then + + deallocate(Me%TimeMap%FirstInstantBest) + deallocate(Me%TimeMap%LastInstantBest ) + deallocate(Me%TimeMap%FirstDateBest ) + deallocate(Me%TimeMap%LastDateBest ) + + deallocate(Me%TimeMap%ObjHDF5_ID ) + deallocate(Me%TimeMap%File_ID ) + endif + call KillHDF5(Me%ObjHDF5_Out, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_)stop 'KillGlueHDF5Files - ModuleGlueHDF5Files - ERR03' diff --git a/Software/ConvertToHDF5/ModuleHDF5ToASCIIandBIN.F90 b/Software/ConvertToHDF5/ModuleHDF5ToASCIIandBIN.F90 index 7aa14e9bc..a4085c49a 100644 --- a/Software/ConvertToHDF5/ModuleHDF5ToASCIIandBIN.F90 +++ b/Software/ConvertToHDF5/ModuleHDF5ToASCIIandBIN.F90 @@ -1021,7 +1021,7 @@ subroutine OutputSwanASCII(PropName, TimeName, Aux2D, l, p) if (len_trim(Me%OutputListFolderName) == 0) then write(Me%UnitProps(p),'(A30)') Filename else - aux = trim(Me%OutputListFolderName) // "\" // trim(Filename) + aux = trim(Me%OutputListFolderName) //backslash// trim(Filename) write(Me%UnitProps(p),'(A100)') aux endif @@ -1239,7 +1239,7 @@ subroutine OutputSwanASCIIVectorial(PropName, NextTime, l, p) if (len_trim(Me%OutputListFolderName) == 0) then write(Me%UnitProps(p),'(A30)') Filename else - aux = trim(Me%OutputListFolderName) // "\" // trim(Filename) + aux = trim(Me%OutputListFolderName) //backslash// trim(Filename) write(Me%UnitProps(p),'(A100)') aux endif diff --git a/Software/ConvertToHDF5/ModuleNetCDFCF_2_HDF5MOHID.F90 b/Software/ConvertToHDF5/ModuleNetCDFCF_2_HDF5MOHID.F90 index 3e9c530d8..519b4dd9e 100644 --- a/Software/ConvertToHDF5/ModuleNetCDFCF_2_HDF5MOHID.F90 +++ b/Software/ConvertToHDF5/ModuleNetCDFCF_2_HDF5MOHID.F90 @@ -383,7 +383,7 @@ subroutine WriteComputeIntensity if (.not. Found) stop 'WriteComputeIntensity - ModuleNetCDFCF_2_HDF5MOHID - ERR20' - do i=1, Me%Date%TotalInst + do i=1, Me%Date%TotalInstOut !Read component X if (Me%Field(iPx)%Dim==2) then @@ -492,7 +492,7 @@ subroutine WriteComputeDirection if (.not. Found) stop 'WriteComputeDirection - ModuleNetCDFCF_2_HDF5MOHID - ERR20' - do i=1, Me%Date%TotalInst + do i=1, Me%Date%TotalInstOut !Read component X if (Me%Field(iPx)%Dim==2) then @@ -590,7 +590,7 @@ subroutine WriteBeaufort enddo if (.not. Found) stop 'WriteBeaufort - ModuleNetCDFCF_2_HDF5MOHID - ERR10' - do i=1, Me%Date%TotalInst + do i=1, Me%Date%TotalInstOut !Read component X if (Me%Field(iPx)%Dim==2) then allocate(Me%Field(iPx)%Value2DOut(Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB)) @@ -688,7 +688,7 @@ subroutine WriteRelativeHumidity enddo if (.not. Found) stop 'WriteComputeIntensity - ModuleNetCDFCF_2_HDF5MOHID - ERR30' - do i=1, Me%Date%TotalInst + do i=1, Me%Date%TotalInstOut !Read temperature if (Me%Field(iPt)%Dim/=2) then @@ -794,7 +794,7 @@ subroutine WriteAverageInDepth if (.not. Found) stop 'WriteAverageInDepth - ModuleNetCDFCF_2_HDF5MOHID - ERR10' - do i=1, Me%Date%TotalInst + do i=1, Me%Date%TotalInstOut !Read 3D property if (Me%Field(iPt)%Dim/=3) then @@ -873,7 +873,7 @@ subroutine WriteReflectivity2Precipitation if (.not. Found) stop 'WriteReflectivity2Precipitation - ModuleNetCDFCF_2_HDF5MOHID - ERR10' - do i=1, Me%Date%TotalInst + do i=1, Me%Date%TotalInstOut !Read 2D property if (Me%Field(iPt)%Dim/=2) then @@ -1015,7 +1015,7 @@ subroutine WriteRotation if (.not. Found) stop 'WriteRotation - ModuleNetCDFCF_2_HDF5MOHID - ERR50' - do i=1, Me%Date%TotalInst + do i=1, Me%Date%TotalInstOut !Read component X if (Me%Field(iPx)%Dim==2) then diff --git a/Software/DDC/DDCWorker/DDCWorker.F90 b/Software/DDC/DDCWorker/DDCWorker.F90 index 6531945cc..17d3e1044 100644 --- a/Software/DDC/DDCWorker/DDCWorker.F90 +++ b/Software/DDC/DDCWorker/DDCWorker.F90 @@ -1852,7 +1852,7 @@ integer function ReturnOnlyFileName(FileNamePlusPath, OnlyFileName) j = 1 do i=n,1,-1 - if (FileNamePlusPath(i:i)=='/' .or. FileNamePlusPath(i:i)=='\') then + if (FileNamePlusPath(i:i)=='/' .or. FileNamePlusPath(i:i)=="\") then j = i+1 exit endif diff --git a/Software/DomainDecompositionConsolidation/ModuleDDC.F90 b/Software/DomainDecompositionConsolidation/ModuleDDC.F90 index 5bde0025d..2d7d1e254 100644 --- a/Software/DomainDecompositionConsolidation/ModuleDDC.F90 +++ b/Software/DomainDecompositionConsolidation/ModuleDDC.F90 @@ -308,30 +308,30 @@ end function ModelLevel !-------------------------------------------------------------------------- character(len=PathLength) pure function ModelPath (AuxString, Level) - + !Arguments------------------------------------------------------------- character(len=*), intent(in) :: AuxString integer, intent(in) :: Level - + !Local----------------------------------------------------------------- integer :: position - + !------------------------------------------------------------------------ position = scan(AuxString, "/", back = .true.) - if (position == 0) then - position = scan(AuxString, "\", back = .true.) + if (position == 0) then + position = scan(AuxString, backslash, back = .true.) endif if (position == 0) then ModelPath = "../res" else ModelPath = AuxString(Level+1:position)//"res" - endif + endif !------------------------------------------------------------------------ - + end function ModelPath - + !-------------------------------------------------------------------------- function AllocateDirectoryList(ModelPath) diff --git a/Software/HDF5Exporter/ModuleHDF5Exporter.f90 b/Software/HDF5Exporter/ModuleHDF5Exporter.f90 index b3cb6d379..221c9e73f 100644 --- a/Software/HDF5Exporter/ModuleHDF5Exporter.f90 +++ b/Software/HDF5Exporter/ModuleHDF5Exporter.f90 @@ -980,11 +980,22 @@ subroutine ReadGlobalData call GetData(Me%ExportType, Me%ObjEnterData, iflag, & keyword = 'EXPORT_TYPE', & SearchType = FromFile, & - Default = 1, & + !1 + Default = ExportCellToTimeseries, & ClientModule = 'ExportToTimeSerie', & STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & stop 'ReadGlobalData - ModuleExportHDF5ToTimeSerie - ERR010' + + + if (Me%ExportType /= ExportCellToTimeseries .and. & + Me%ExportType /= ExportAreaToTimeseries) then + write (*,*) " wrong option EXPORT_TYPE =", Me%ExportType + write (*,*) " valid options are:" + write (*,*) " 1 - extract a time series from a point in a cell" + write (*,*) " 2 - extract a time series from a polygon intersecting a set of cells" + stop 'ReadGlobalData - ModuleExportHDF5ToTimeSerie - ERR015' + endif ! Obtain the start and end times for the Time Serie diff --git a/Software/HDF5Extractor/ModuleHDF5Extractor.F90 b/Software/HDF5Extractor/ModuleHDF5Extractor.F90 index 6bf1140d8..ac07a3c63 100644 --- a/Software/HDF5Extractor/ModuleHDF5Extractor.F90 +++ b/Software/HDF5Extractor/ModuleHDF5Extractor.F90 @@ -1638,6 +1638,7 @@ recursive subroutine InquireSubGroup (ID, GroupName, Level) !(for time dependent itens assumed that data type equal for all fields) !Opens data set call h5dopen_f(ID, trim(adjustl(obj_name)), dset_id, STAT_CALL) + !Gets datatype call h5dget_type_f (dset_id, datatype_id, STAT_CALL) !call h5tget_size_f (datatype_id, size, STAT_CALL) diff --git a/Software/MOHIDBase1/ModuleEnterData.F90 b/Software/MOHIDBase1/ModuleEnterData.F90 index 1ca83dd59..f9d798149 100644 --- a/Software/MOHIDBase1/ModuleEnterData.F90 +++ b/Software/MOHIDBase1/ModuleEnterData.F90 @@ -795,7 +795,7 @@ subroutine ReadFileName(KEYWORD, FILE_NAME, Message, TIME_END, Extension, FilesI iFN = len_trim(FILE_NAME) ipath = 0 do i = iFN, 1, -1 - if (FILE_NAME(i:i) == '/' .or. FILE_NAME(i:i) == '\') then + if (FILE_NAME(i:i) == '/' .or. FILE_NAME(i:i) == backslash) then ipath = i exit endif @@ -4854,7 +4854,7 @@ end module ModuleEnterData !---------------------------------------------------------------------------------------------------------- !MOHID Water Modelling System. -!Copyright (C) 1985, 1998, 2002, 2005. Instituto Superior Técnico, Technical University of Lisbon. +!Copyright (C) 1985, 1998, 2002, 2005. Instituto Superior TĆ©cnico, Technical University of Lisbon. !---------------------------------------------------------------------------------------------------------- diff --git a/Software/MOHIDBase1/ModuleFunctions.F90 b/Software/MOHIDBase1/ModuleFunctions.F90 index a8e0547f5..95623f7f3 100644 --- a/Software/MOHIDBase1/ModuleFunctions.F90 +++ b/Software/MOHIDBase1/ModuleFunctions.F90 @@ -147,6 +147,7 @@ Module ModuleFunctions !Coordinates of grid cells public :: RODAXY public :: FromCartesianToGrid + public :: FromGridToCartesian interface FromGridToCartesian module procedure FromGridToCartesianR4 @@ -179,9 +180,12 @@ Module ModuleFunctions public :: FillMatrix3D !Assimilation - TwoWay Joćo Sobrinho - public :: TwoWayAssimilation3D - public :: TwoWayAssimilationWaterLevel - public :: TwoWayAssimilation2D + public :: TwoWayAssimilation + + interface TwoWayAssimilation + module procedure TwoWayAssimilation2D + module procedure TwoWayAssimilation3D + end interface TwoWayAssimilation !Reading of Time Keywords public :: ReadTimeKeyWords @@ -212,8 +216,6 @@ Module ModuleFunctions public :: PolIntProfile public :: polint - !Average of nearby vertical velocities - public :: ComputeAvgVerticalVelocity !Polygon public :: RelativePosition4VertPolygon public :: PolygonArea @@ -5070,19 +5072,21 @@ subroutine ExtraPol3DNearestCell (ILB, IUB, JLB, JUB, KLB, KUB, ComputePoints3D, do dij=1,dijmax do jj=j-dij,j+dij - do ii=i-dij,i+dij if (jj < JLB) cycle if (jj > JUB) cycle - if (ii < ILB) cycle - if (ii > IUB) cycle - if (OutValues3D(ii, jj, k) > FillValueReal/4.) then - SumValues = SumValues + OutValues3D(ii, jj, k) - Count = Count + 1 - endif + do ii=i-dij,i+dij - enddo + if (ii < ILB) cycle + if (ii > IUB) cycle + + if (OutValues3D(ii, jj, k) > FillValueReal/4.) then + SumValues = SumValues + OutValues3D(ii, jj, k) + Count = Count + 1 + endif + + enddo enddo if (Count > 0) exit @@ -5124,6 +5128,7 @@ subroutine ExtraPol3DNearestCell (ILB, IUB, JLB, JUB, KLB, KUB, ComputePoints3D, else + write(*,*) 'i j k=',i,j,k stop 'ExtraPol3DNearestCell - ModuleFunctions - ERR10' endif @@ -5217,19 +5222,21 @@ subroutine ExtraPol3DNearestCell_8 (ILB, IUB, JLB, JUB, KLB, KUB, ComputePoints3 do dij=1,dijmax do jj=j-dij,j+dij - do ii=i-dij,i+dij if (jj < JLB) cycle if (jj > JUB) cycle - if (ii < ILB) cycle - if (ii > IUB) cycle - if (OutValues3D(ii, jj, k) > FillValueReal/4.) then - SumValues = SumValues + OutValues3D(ii, jj, k) - Count = Count + 1 - endif + do ii=i-dij,i+dij - enddo + if (ii < ILB) cycle + if (ii > IUB) cycle + + if (OutValues3D(ii, jj, k) > FillValueReal/4.) then + SumValues = SumValues + OutValues3D(ii, jj, k) + Count = Count + 1 + endif + + enddo enddo if (Count > 0) exit @@ -5270,7 +5277,10 @@ subroutine ExtraPol3DNearestCell_8 (ILB, IUB, JLB, JUB, KLB, KUB, ComputePoints3 OutValues3D(i, j, k) = FillValueReal else - + write(*,*) 'kk dk=',kk, dk + write(*,*) 'ii jj dij dijmax=',ii, jj, dij, dijmax + write(*,*) 'Count SumValues=',Count, SumValues + write(*,*) 'i j k=',i,j,k stop 'ExtraPol3DNearestCell_8 - ModuleFunctions - ERR10' endif @@ -5602,226 +5612,137 @@ subroutine FillMatrix3D (ILB, IUB, JLB, JUB, KLB, KUB, ComputePoints3D, OutValue end subroutine FillMatrix3D !----------------------------------------------------------------------------------------------------------------- - subroutine TwoWayAssimilationWaterLevel(FatherProperty, SonProperty, Open3DFather, Open3DSon, SizeFather, SizeSon,& - ILink, JLink, DecayTime, DT, TotSonVolInFather2D, AuxMatrix, & - FatherCorners, VolumeSon, VolumeFather) - !Arguments--------------------------------------------------------------------------------- - type(T_Size3D) , intent(IN) :: SizeSon, SizeFather - real, dimension(:,: ), pointer, intent(IN) :: SonProperty, VolumeFather, VolumeSon - integer, dimension(:,:,:), pointer, intent(IN) :: Open3DFather, Open3DSon - real, dimension(:,: ), pointer, intent(INOUT) :: FatherProperty - integer, dimension(:,: ), pointer, intent(IN) :: ILink, JLink - real, intent(IN) :: DecayTime, DT - real, dimension(:,:), pointer :: TotSonVolInFather2D, AuxMatrix, FatherCorners - !Local variables -------------------------------------------------------------------------------- - integer :: i, j, KUBFather, KUBSon, IUBSon, ILBSon, JUBSon, JLBSon - !Begin------------------------------------------------------------------------------------- - ILBSon = SizeSon%ILB - IUBSon = SizeSon%IUB - JLBSon = SizeSon%JLB - JUBSon = SizeSon%JUB - KUBSon = SizeSon%KUB - KUBFather = SizeFather%KUB - !!left lower corner - !FatherCorners(1, 1) = FatherProperty(ILink(ILBSon, JLBSon)+1, JLink(ILBSon, JLBSon)+1) - !!left upper corner - !FatherCorners(2, 1) = FatherProperty(ILink(IUBSon, JLBSon)+1, JLink(IUBSon, JLBSon)+1) - !!Right lower corner - !FatherCorners(3, 1) = FatherProperty(ILink(ILBSon, JUBSon)+1, JLink(ILBSon, JUBSon)+1) - !!Right upper corner - !FatherCorners(4, 1) = FatherProperty(ILink(IUBSon, JUBSon)+1, JLink(IUBSon, JUBSon)+1) + subroutine TwoWayAssimilation2D(FatherProperty, SonProperty, Open3DFather, Open3DSon, KUBFather, & + IUBSon, ILBSon, JUBSon, JLBSon, KUBSon, IConnect, Jconnect, DecayTime, & + DT, TotSonVolInFather, AuxMatrix, FatherCopyCorners, VolumeZSon, VolumeZFather) + !Arguments--------------------------------------------------------------------------------- + real, dimension(:,:), pointer, intent(IN) :: SonProperty + integer, dimension(:,:,:), pointer, intent(IN) :: Open3DFather, Open3DSon + real(8), dimension(:,:,:), pointer, intent(IN) :: VolumeZSon, VolumeZFather + real, dimension(:,:), pointer, intent(INOUT) :: FatherProperty + integer, dimension(:,:), pointer, intent(IN) :: IConnect, Jconnect + integer, intent(IN) :: KUBFather, KUBSon, IUBSon, ILBSon, JUBSon, JLBSon + real, intent(IN) :: DecayTime, DT + !Aux variables -------------------------------------------------------------------------------- + integer :: i, j + real, dimension(:,:), pointer :: AuxMatrix + real, dimension(:,:,:), pointer :: TotSonVolInFather + real, dimension(:,:), pointer :: FatherCopyCorners + !Begin------------------------------------------------------------------------------------- + + !left lower corner + FatherCopyCorners(1, KUBFather) = FatherProperty(IConnect(ILBSon, JLBSon)+1, Jconnect(ILBSon, JLBSon)+1) + !left upper corner + FatherCopyCorners(2, KUBFather) = FatherProperty(IConnect(IUBSon, JLBSon)+1, Jconnect(IUBSon, JLBSon)+1) + !Right lower corner + FatherCopyCorners(3, KUBFather) = FatherProperty(IConnect(ILBSon, JUBSon)+1, Jconnect(ILBSon, JUBSon)+1) + !Right upper corner + FatherCopyCorners(4, KUBFather) = FatherProperty(IConnect(IUBSon, JUBSon)+1, Jconnect(IUBSon, JUBSon)+1) do j = JLBSon, JUBSon - do i = ILBSon, IUBSon - AuxMatrix(ILink(i, j)+1, JLink(i, j)+1) = (AuxMatrix(ILink(i, j)+1, JLink(i, j)+1) + & - SonProperty(i, j) * VolumeSon(i, j)) * Open3DSon(i, j, KUBSon) - enddo + do i = ILBSon, IUBSon + if (Open3DSon(i, j, KUBSon) == 1)then + AuxMatrix(IConnect(i, j)+1, Jconnect(i, j)+1) = & + AuxMatrix(IConnect(i, j)+1, Jconnect(i, j)+1) + SonProperty(i, j) * VolumeZSon(i, j, KUBFather) + endif + enddo enddo - do j = JLink(1, 1)+3, JLink(IUBSon, JUBSon)-1 - do i = ILink(1, 1)+3, ILink(IUBSon, JUBSon)-1 - if (Open3DFather(i, j, KUBFather) == 1 .and. TotSonVolInFather2D(i, j) > 0 )then - FatherProperty(i, j) = FatherProperty(i, j) + (AuxMatrix(i, j) / TotSonVolInFather2D(i, j) - & - FatherProperty(i, j)) * (DT / DecayTime) * & - (TotSonVolInFather2D(i, j) / VolumeFather(i, j)) - - endif - enddo + do j = Jconnect(1, 1)+1, Jconnect(IUBSon, JUBSon)+1 + do i = IConnect(1, 1)+1, IConnect(IUBSon, JUBSon)+1 + if (Open3DFather(i, j, KUBFather) == 1 .and. TotSonVolInFather(i, j, KUBFather) > 0 )then + FatherProperty(i, j) = FatherProperty(i, j) + (AuxMatrix(i, j) / & + TotSonVolInFather(i, j, KUBFather) - FatherProperty(i, j)) * & + (DT / DecayTime) * (TotSonVolInFather(i, j, KUBFather) / & + VolumeZFather(i, j, KUBFather)) + endif + enddo enddo - !!left lower corner - !FatherProperty(ILink(ILBSon, JLBSon)+1, JLink(ILBSon, JLBSon)+1) = FatherCorners(1,1) - !!left upper corner, KUBFather - !FatherProperty(ILink(IUBSon, JLBSon)+1, JLink(IUBSon, JLBSon)+1) = FatherCorners(2,1) - !!Right lower corner - !FatherProperty(ILink(ILBSon, JUBSon)+1, JLink(ILBSon, JUBSon)+1) = FatherCorners(3,1) - !!Right upper corner - !FatherProperty(ILink(IUBSon, JUBSon)+1, JLink(IUBSon, JUBSon)+1) = FatherCorners(4,1) + !left lower corner + FatherProperty(IConnect(ILBSon, JLBSon)+1, Jconnect(ILBSon, JLBSon)+1) = FatherCopyCorners(1,KUBFather) + !left upper corner, KUBFather + FatherProperty(IConnect(IUBSon, JLBSon)+1, Jconnect(IUBSon, JLBSon)+1) = FatherCopyCorners(2,KUBFather) + !Right lower corner + FatherProperty(IConnect(ILBSon, JUBSon)+1, Jconnect(ILBSon, JUBSon)+1) = FatherCopyCorners(3,KUBFather) + !Right upper corner + FatherProperty(IConnect(IUBSon, JUBSon)+1, Jconnect(IUBSon, JUBSon)+1) = FatherCopyCorners(4,KUBFather) - end subroutine TwoWayAssimilationWaterLevel + end subroutine TwoWayAssimilation2D !------------------------------------------------------------------------------------------------------------------ - subroutine TwoWayAssimilation2D(FatherProperty, SonProperty, Open3DFather, Open3DSon, SizeFather, SizeSon, & - ILink, JLink, DecayTime, DT, TotSonVolInFather, AuxMatrix, FatherCorners, & - VolumeSon, VolumeFather) - !Arguments-------------------------------------------------------------------------------------------------- - type(T_Size3D), intent(IN) :: SizeSon, SizeFather - real, dimension(:,:,:), pointer, intent(IN) :: SonProperty, VolumeSon, VolumeFather - real, dimension(:,:,:), pointer, intent(INOUT) :: FatherProperty - integer, dimension(:,:), pointer, intent(IN) :: ILink, JLink - integer, dimension(:,:,:), pointer, intent(IN) :: Open3DFather, Open3DSon - real, intent(IN) :: DecayTime, DT - real, dimension(:,:,:), pointer, intent(IN) :: AuxMatrix, TotSonVolInFather - real, dimension(:,:), pointer, intent(IN) :: FatherCorners - !local variables --------------------------------------------------------------------------------------------- - integer :: i, j, KUBFather, IUBSon, ILBSon, JUBSon, & - JLBSon, KLBSon - !Begin------------------------------------------------------------------------------------------------------ - ILBSon = SizeSon%ILB - IUBSon = SizeSon%IUB - JLBSon = SizeSon%JLB - JUBSon = SizeSon%JUB - !Copy Values of FatherProperty coincident with the corners of the Son domain (because the son domain does - ! not compute them). - - !!left lower corner - !FatherCorners(1, 1) = FatherProperty(ILink(ILBSon, JLBSon)+1, JLink(ILBSon, JLBSon)+1, 1) - !!left upper corner - !FatherCorners(2, 1) = FatherProperty(ILink(IUBSon, JLBSon)+1, JLink(IUBSon, JLBSon)+1, 1) - !!Right lower corner - !FatherCorners(3, 1) = FatherProperty(ILink(ILBSon, JUBSon)+1, JLink(ILBSon, JUBSon)+1, 1) - !!Right upper corner - !FatherCorners(4, 1) = FatherProperty(ILink(IUBSon, JUBSon)+1, JLink(IUBSon, JUBSon)+1, 1) - - !Paralelizar! Joćo Sobrinho - do j = JLBSon, JUBSon - do i = ILBSon, IUBSon - !For each Parent cell, add all son cells located inside (sonProp * sonVol) - AuxMatrix(ILink(i, j)+1, JLink(i, j)+1, 1) = AuxMatrix(ILink(i, j)+1, JLink(i, j)+1, 1) + & - SonProperty(i, j, 1) * VolumeSon(i, j, 1) * & - Open3DSon(i, j, 1) - enddo - enddo - - !Paralelizar! Joćo Sobrinho - do j = JLink(1, 1)+3, JLink(IUBSon, JUBSon)-1 - do i = ILink(1, 1)+3, ILink(IUBSon, JUBSon)-1 - - if (Open3DFather(i, j, 1) == 1 .and. TotSonVolInFather(i, j, 1) > 0. )then - - FatherProperty(i, j, 1) = FatherProperty(i, j, 1) + (AuxMatrix(i, j, 1) / TotSonVolInFather(i, j, 1) -& - FatherProperty(i, j, 1)) * (DT / DecayTime) * & - (TotSonVolInFather(i, j, 1) / VolumeFather(i, j, 1)) - endif - - enddo - enddo - - !!left lower corner - !FatherProperty(ILink(ILBSon, JLBSon)+1, JLink(ILBSon, JLBSon)+1, 1) = FatherCorners(1, 1) - !!left upper corner - !FatherProperty(ILink(IUBSon, JLBSon)+1, JLink(IUBSon, JLBSon)+1, 1) = FatherCorners(2, 2) - !!Right lower corner - !FatherProperty(ILink(ILBSon, JUBSon)+1, JLink(ILBSon, JUBSon)+1, 1) = FatherCorners(3, 3) - !!Right upper corner - !FatherProperty(ILink(IUBSon, JUBSon)+1, JLink(IUBSon, JUBSon)+1, 1) = FatherCorners(4, 4) - - end subroutine TwoWayAssimilation2D - - !-------------------------------------------------------------------------------------------------------------- - - subroutine TwoWayAssimilation3D(FatherProperty, SonProperty, Open3DFather, Open3DSon, SizeFather, SizeSon, & - ILink, JLink, DecayTime, DT, TotSonVolInFather, AuxMatrix, FatherCorners, & - VolumeSon, VolumeFather) - !Arguments--------------------------------------------------------------------------------- - type(T_Size3D) , intent(IN) :: SizeSon, SizeFather - real, dimension(:,:,:), pointer, intent(IN) :: SonProperty, VolumeSon, VolumeFather - real, dimension(:,:,:), pointer, intent(INOUT) :: FatherProperty - integer, dimension(:,:), pointer, intent(IN) :: ILink, JLink - integer, dimension(:,:,:), pointer, intent(IN) :: Open3DFather, Open3DSon - real, intent (IN) :: DecayTime, DT - real, dimension(:,:,:), pointer :: AuxMatrix, TotSonVolInFather - real, dimension(:,:), pointer :: FatherCorners - !Local variables ----------------------------------------------------------------------------- - integer :: i, j, k, ILBSon, JLBSon, IUBSon, JUBSon, KLBSon, & - KUBSon, KUBFather, KLBFather - !Begin---------------------------------------------------------------------------------------- - ILBSon = SizeSon%ILB - IUBSon = SizeSon%IUB - JLBSon = SizeSon%JLB - JUBSon = SizeSon%JUB - KLBSon = SizeSon%KLB - KUBSon = SizeSon%KUB - KLBFather = SizeFather%KLB - KUBFather = SizeFather%KUB - !Copies Values of FatherProperty coincident with the corners of the Son domain (because the son domain does - ! not compute them). - !do k = KLBFather, KUBFather - ! !left lower corner - ! FatherCorners(1, k) = FatherProperty(ILink(ILBSon, JLBSon)+1, JLink(ILBSon, JLBSon)+1, k) - ! !left upper corner - ! FatherCorners(2, k) = FatherProperty(ILink(IUBSon, JLBSon)+1, JLink(IUBSon, JLBSon)+1, k) - ! !Right lower corner - ! FatherCorners(3, k) = FatherProperty(ILink(ILBSon, JUBSon)+1, JLink(ILBSon, JUBSon)+1, k) - ! !Right upper corner - ! FatherCorners(4, k) = FatherProperty(ILink(IUBSon, JUBSon)+1, JLink(IUBSon, JUBSon)+1, k) - !enddo - - !Paralelizar! Joćo Sobrinho - do k = KLBSon, KUBSon + subroutine TwoWayAssimilation3D(FatherProperty,SonProperty, Open3DFather, Open3DSon, & + KUBFather, KLBFather, IUBSon, ILBSon, JUBSon, JLBSon, & + KUBSon, KLBSon, IConnect, Jconnect, DecayTime, DT, & + TotSonVolInFather, AuxMatrix, FatherCopyCorners, VolumeZSon, VolumeZFather) + !Arguments--------------------------------------------------------------------------------- + real, dimension(:,:,:), pointer, intent(IN) :: SonProperty + real(8), dimension(:,:,:), pointer, intent(IN) :: VolumeZSon, VolumeZFather + real, dimension(:,:,:), pointer, intent(INOUT) :: FatherProperty + integer, dimension(:,:), pointer, intent(IN) :: IConnect, Jconnect + integer, dimension(:,:,:), pointer, intent(IN) :: Open3DFather, Open3DSon + integer, intent(IN) :: KUBFather, KLBFather, IUBSon, ILBSon, JUBSon, JLBSon + integer, intent(IN) :: KUBSon, KLBSon + real, intent (IN) :: DecayTime, DT + !Aux variables ----------------------------------------------------------------------------- + integer :: i, j, k + real, dimension(:,:,:), pointer :: AuxMatrix + real, dimension(:,:,:), pointer :: TotSonVolInFather + real, dimension(:,:), pointer :: FatherCopyCorners + !Begin---------------------------------------------------------------------------------------- + + !Copies Values of FatherProperty coincident with the corners of the Son domain (because the son domain does + ! not compute them). + do k = KLBFather, KUBFather + !left lower corner + FatherCopyCorners(1, k) = FatherProperty(IConnect(ILBSon, JLBSon)+1, Jconnect(ILBSon, JLBSon)+1, k) + !left upper corner + FatherCopyCorners(2, k) = FatherProperty(IConnect(IUBSon, JLBSon)+1, Jconnect(IUBSon, JLBSon)+1, k) + !Right lower corner + FatherCopyCorners(3, k) = FatherProperty(IConnect(ILBSon, JUBSon)+1, Jconnect(ILBSon, JUBSon)+1, k) + !Right upper corner + FatherCopyCorners(4, k) = FatherProperty(IConnect(IUBSon, JUBSon)+1, Jconnect(IUBSon, JUBSon)+1, k) + enddo + !Paralelizar! Joćo Sobrinho + do k = KLBSon, KUBSon do j = JLBSon, JUBSon - do i = ILBSon, IUBSon - !For each Parent cell, add all son cells located inside (sonProp * sonVol) - AuxMatrix(ILink(i, j)+1, JLink(i, j)+1, k) = AuxMatrix(ILink(i, j)+1, JLink(i, j)+1, k) + & - SonProperty(i, j, k) * VolumeSon(i, j, k) * & - Open3DSon(i, j, k) - enddo - enddo + do i = ILBSon, IUBSon + if (Open3DSon(i, j, k) == 1)then + !For each Parent cell, add all son cells located inside (sonProp * sonVol) + AuxMatrix(IConnect(i, j)+1, Jconnect(i, j)+1, k) = AuxMatrix(IConnect(i, j)+1, Jconnect(i, j)+1, k) + & + SonProperty(i, j, k) * VolumeZSon(i, j, k) + endif + enddo enddo - - !Paralelizar! Joćo Sobrinho - do k = KLBFather, KUBFather - do j = JLink(1, 1)+3, JLink(IUBSon, JUBSon)-1 - do i = ILink(1, 1)+3, ILink(IUBSon, JUBSon)-1 - if (Open3DFather(i, j, k) == 1 .and. TotSonVolInFather(i, j, k) > 0. )then - FatherProperty(i, j, k) = FatherProperty(i, j, k) + (AuxMatrix(i, j, k) / TotSonVolInFather(i, j, k) -& - FatherProperty(i, j, k)) * (DT / DecayTime) * (TotSonVolInFather(i, j, k) / & - VolumeFather(i, j, k)) - endif + enddo + !Paralelizar! Joćo Sobrinho + do k = KLBFather, KUBFather + do j = Jconnect(1, 1)+1, Jconnect(IUBSon, JUBSon)+1 + do i = IConnect(1, 1)+1, IConnect(IUBSon, JUBSon)+1 + if (Open3DFather(i, j, k) == 1 .and. TotSonVolInFather(i, j, k) > 0. )then + FatherProperty(i, j, k) = FatherProperty(i, j, k) + & + (AuxMatrix(i, j, k) / TotSonVolInFather(i, j, k) - FatherProperty(i, j, k)) * & + (DT / DecayTime) * (TotSonVolInFather(i, j, k) / VolumeZFather(i, j, k)) + endif + enddo enddo - enddo - enddo - - !!Paralelizar! Joćo Sobrinho - !do k = KLBFather, KUBFather - !do j = JLink(1, 1)+1, JLink(IUBSon, JUBSon)+1 - !do i = ILink(1, 1)+1, ILink(IUBSon, JUBSon)+1 - ! if (Open3DFather(i, j, k) == 1 .and. TotSonVolInFather(i, j, k) > 0. )then - ! FatherProperty(i, j, k) = FatherProperty(i, j, k) + (AuxMatrix(i, j, k) / TotSonVolInFather(i, j, k) -& - ! FatherProperty(i, j, k)) * (DT / DecayTime) * (TotSonVolInFather(i, j, k) / & - ! VolumeFather(i, j, k)) - ! endif - ! - !enddo - !enddo - !enddo - - !do k = KLBFather, KUBFather - ! !left lower corner - ! FatherProperty(ILink(ILBSon, JLBSon)+1, JLink(ILBSon, JLBSon)+1, k) = FatherCorners(1, k) - ! !left upper corner - ! FatherProperty(ILink(IUBSon, JLBSon)+1, JLink(IUBSon, JLBSon)+1, k) = FatherCorners(2, k) - ! !Right lower corner - ! FatherProperty(ILink(ILBSon, JUBSon)+1, JLink(ILBSon, JUBSon)+1, k) = FatherCorners(3, k) - ! !Right upper corner - ! FatherProperty(ILink(IUBSon, JUBSon)+1, JLink(IUBSon, JUBSon)+1, k) = FatherCorners(4, k) - !enddo - - end subroutine TwoWayAssimilation3D - - !------------------------------------------------------------------------------------- - + enddo + + do k = KLBFather, KUBFather + !left lower corner + FatherProperty(IConnect(ILBSon, JLBSon)+1, Jconnect(ILBSon, JLBSon)+1, k) = FatherCopyCorners(1, k) + !left upper corner + FatherProperty(IConnect(IUBSon, JLBSon)+1, Jconnect(IUBSon, JLBSon)+1, k) = FatherCopyCorners(2, k) + !Right lower corner + FatherProperty(IConnect(ILBSon, JUBSon)+1, Jconnect(ILBSon, JUBSon)+1, k) = FatherCopyCorners(3, k) + !Right upper corner + FatherProperty(IConnect(IUBSon, JUBSon)+1, Jconnect(IUBSon, JUBSon)+1, k) = FatherCopyCorners(4, k) + enddo + + end subroutine TwoWayAssimilation3D + + !------------------------------------------------------------------------------------- subroutine ReadTimeKeyWords(ObjEnterData, ExtractTime, BeginTime, EndTime, DT, & VariableDT, ClientModule, MaxDT, GmtReference, & DTPredictionInterval) @@ -8092,62 +8013,6 @@ subroutine polint(xa,ya,n,x,y,dy, STAT) end subroutine !End------------------------------------------------------------ - - ! This routine computes the average of the vertical velocities around (and including) the center cell - ! To be used for the lagrangian layers evolution. Matrix outputed : ZonalVerticalVelocity - ! Needs to be parallelized - ! Joao Sobrinho - subroutine ComputeAvgVerticalVelocity(VerticalVelocity, ZonalVerticalVelocity, Size3D, & - OpenPoints3D) - !Arguments--------------------------------------------------- - real, dimension(:,:,:), pointer :: VerticalVelocity, ZonalVerticalVelocity - integer, dimension(:,:,:), pointer :: OpenPoints3D - type(T_Size3D) :: Size3D - integer :: i, j, k, NumCells, ILB, IUB, JLB, JUB, KLB, KUB - real :: SumVerticalVelocity - !Begin------------------------------------------------------- - if (MonitorPerformance) call StartWatch ("ModuleFunctions", "ComputeAvgVerticalVelocity") - - ILB = Size3D%ILB - IUB = Size3D%IUB - - JLB = Size3D%JLB - JUB = Size3D%JUB - - KLB = Size3D%KLB - KUB = Size3D%KUB - - do k = KLB, KUB - do j = JLB, JUB - do i = ILB, IUB - !If The current cell is a water point BUT not an openpoint, then zonal vertical velocity should use ony the - ! vertical velocity of the current cell. Hence the OpenPoints3D(i, j , k) in the end - SumVerticalVelocity = VerticalVelocity(i, j, k) + & - (VerticalVelocity(i+1, j-1, k) * OpenPoints3D(i+1, j-1, k) + & - VerticalVelocity(i+1, j , k) * OpenPoints3D(i+1, j , k) + & - VerticalVelocity(i+1, j+1, k) * OpenPoints3D(i+1, j+1, k) + & - VerticalVelocity(i , j-1, k) * OpenPoints3D(i , j-1, k) + & - VerticalVelocity(i , j+1, k) * OpenPoints3D(i , j+1, k) + & - VerticalVelocity(i-1, j-1, k) * OpenPoints3D(i-1, j-1, k) + & - VerticalVelocity(i-1, j , k) * OpenPoints3D(i-1, j , k) + & - VerticalVelocity(i-1, j+1, k) * OpenPoints3D(i-1, j+1, k)) * & - OpenPoints3D(i, j , k) - - NumCells = 1 + (OpenPoints3D(i+1, j-1, k) + OpenPoints3D(i+1, j , k) + OpenPoints3D(i+1, j+1, k) + & - OpenPoints3D(i , j-1, k) + OpenPoints3D(i , j , k) + OpenPoints3D(i , j+1, k) + & - OpenPoints3D(i-1, j-1, k) + OpenPoints3D(i-1, j , k) + OpenPoints3D(i-1, j+1, k)) * & - OpenPoints3D(i, j , k) - - ZonalVerticalVelocity(i, j, k) = SumVerticalVelocity / NumCells - - enddo - enddo - enddo - - if (MonitorPerformance) call StopWatch ("ModuleFunctions", "ComputeAvgVerticalVelocity") - - end subroutine ComputeAvgVerticalVelocity - !End------------------------------------------------------------ Subroutine ComputeDiffusion1D(ilb, iub, dt, du, Prop, k, v, ComputePoints, & Ticoef, Ecoef, DCoef, Fcoef, Theta) !Arguments--------------------------------------------------- @@ -11957,7 +11822,7 @@ subroutine CheckAlternativeTidalCompNames (TidalName, MohidTidalName) MohidTidalName = 'NU2' endif - if (TidalName(1:il) == 'La2' .or. TidalName(1:il) == 'LAMDA2') then + if (TidalName(1:il) == 'La2' .or. TidalName(1:il) == 'LAMDA2' .or. TidalName(1:il) == 'LA2') then MohidTidalName = 'LDA2' endif @@ -12194,7 +12059,7 @@ integer function ReadEsriGridData(UnitIn, Imax, Jmax, Matrix2D) !Begin----------------------------------------------------------------- - do I=1,6 + do i=1,6 read(UnitIn,*) if (STAT_CALL /= SUCCESS_) then stop 'ReadEsriGridData - ModuleFunctions - ERR10' diff --git a/Software/MOHIDBase1/ModuleGlobalData.F90 b/Software/MOHIDBase1/ModuleGlobalData.F90 index c84bb3941..d292e13d5 100644 --- a/Software/MOHIDBase1/ModuleGlobalData.F90 +++ b/Software/MOHIDBase1/ModuleGlobalData.F90 @@ -189,6 +189,12 @@ Module ModuleGlobalData integer, parameter :: NOT_ASSOCIATE_ = 20 integer, parameter :: FILE_EXISTS_ERR_ = 21 integer, parameter :: OUT_OF_BOUNDS_ERR_ = 22 !Add to use with ModulePhreeqC + + !MOHID LAND AND MOHID WATER and MOHID RIVER + integer, parameter :: MOHIDLAND_ = 1 + integer, parameter :: MOHIDWATER_ = 2 + integer, parameter :: MOHIDRIVER_ = 3 + !Types of coordinates integer, parameter :: GEOG_ = 1 !Coordenadas Geograficas diff --git a/Software/MOHIDBase1/ModuleSedimentQuality.F90 b/Software/MOHIDBase1/ModuleSedimentQuality.F90 index 16abca6e4..db55e3de0 100644 --- a/Software/MOHIDBase1/ModuleSedimentQuality.F90 +++ b/Software/MOHIDBase1/ModuleSedimentQuality.F90 @@ -471,7 +471,7 @@ subroutine ConstructAsciiOutPut Number = ' ' write(Number, fmt='(i4)')Counter open(UNIT = Me%Files%AsciiUnit, & - FILE = '..\res\SQ_Situation_'//trim(adjustl(Number))//'.log', & + FILE = '..'//backslash//'res'//backslash//'SQ_Situation_'//trim(adjustl(Number))//'.log', & STATUS = "REPLACE", & IOSTAT = STAT_CALL) if (STAT_CALL == SUCCESS_) then diff --git a/Software/MOHIDBase2/ModuleAtmosphere.F90 b/Software/MOHIDBase2/ModuleAtmosphere.F90 index 89f9adc85..51d0d5ba2 100644 --- a/Software/MOHIDBase2/ModuleAtmosphere.F90 +++ b/Software/MOHIDBase2/ModuleAtmosphere.F90 @@ -246,6 +246,7 @@ Module ModuleAtmosphere type T_Atmosphere integer :: InstanceID = null_int !initialization: Jauch character(PathLength) :: ModelName = null_str !initialization: Jauch + integer :: ModelType = MOHIDLAND_ type(T_Size2D) :: Size type(T_Size2D) :: WorkSize type(T_External) :: ExternalVar @@ -347,6 +348,7 @@ Module ModuleAtmosphere subroutine StartAtmosphere(ModelName, & + ModelType, & AtmosphereID, & TimeID, & GridDataID, & @@ -357,6 +359,7 @@ subroutine StartAtmosphere(ModelName, & !Arguments-------------------------------------------------------------- character(Len=*) :: ModelName + integer :: ModelType integer :: AtmosphereID integer :: TimeID integer :: GridDataID @@ -392,7 +395,8 @@ subroutine StartAtmosphere(ModelName, & call AllocateInstance Me%ModelName = ModelName - + Me%ModelType = ModelType + !Associates External Instances Me%ObjTime = AssociateInstance (mTIME_, TimeID ) Me%ObjGridData = AssociateInstance (mGRIDDATA_, GridDataID ) @@ -633,7 +637,12 @@ subroutine ConstructGlobalVariables STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) stop 'ConstructGlobalVariables - ModuleAtmosphere - ERR60' - if (trim(Me%ModelName) == 'MOHID Land Model') then + !This can not be a string that is set by the user. + !In operational models this value is not 'MOHID Land Model' + !so that the timeseries are saved with a correct model name + !This was changed to a integer that is not changed by the user + !if (trim(Me%ModelName) == 'MOHID Land Model') then + if (Me%ModelType == MOHIDLAND_) then defValue = 2 else defValue = 1 diff --git a/Software/MOHIDBase2/ModuleField4D.F90 b/Software/MOHIDBase2/ModuleField4D.F90 index 25e077ac7..dece93cdd 100644 --- a/Software/MOHIDBase2/ModuleField4D.F90 +++ b/Software/MOHIDBase2/ModuleField4D.F90 @@ -1675,24 +1675,24 @@ subroutine ReadOptions(PropField, ExtractType) !Field NAme was setted by argument? if (.not. Me%File%FieldNameArgument) then - call GetData(PropField%FieldName, & - Me%ObjEnterData , iflag, & - SearchType = ExtractType, & - keyword = 'FIELD_NAME', & - default = trim(PropField%ID%Name), & - ClientModule = 'ModuleField4D', & + call GetData(PropField%FieldName, & + Me%ObjEnterData , iflag, & + SearchType = ExtractType, & + keyword = 'FIELD_NAME', & + default = trim(PropField%ID%Name), & + ClientModule = 'ModuleField4D', & STAT = STAT_CALL) if (STAT_CALL .NE. SUCCESS_) stop 'ReadOptions - ModuleField4D - ERR70' if (iflag == 0) then - call GetData(PropField%FieldName, & - Me%ObjEnterData , iflag, & - SearchType = ExtractType, & - keyword = 'HDF_FIELD_NAME', & - default = trim(PropField%ID%Name), & - ClientModule = 'ModuleField4D', & + call GetData(PropField%FieldName, & + Me%ObjEnterData , iflag, & + SearchType = ExtractType, & + keyword = 'HDF_FIELD_NAME', & + default = trim(PropField%ID%Name), & + ClientModule = 'ModuleField4D', & STAT = STAT_CALL) - if (STAT_CALL .NE. SUCCESS_) stop 'ReadOptions - ModuleField4D - ERR75' + if (STAT_CALL .NE. SUCCESS_) stop 'ReadOptions - ModuleField4D - ERR80' endif else PropField%FieldName = Me%File%FieldName @@ -1705,7 +1705,7 @@ subroutine ReadOptions(PropField, ExtractType) default = .true., & ClientModule = 'ModuleField4D', & STAT = STAT_CALL) - if (STAT_CALL .NE. SUCCESS_) stop 'ReadOptions - ModuleField4D - ERR80' + if (STAT_CALL .NE. SUCCESS_) stop 'ReadOptions - ModuleField4D - ERR90' call GetData(PropField%From2Dto3D, & Me%ObjEnterData , iflag, & @@ -1714,7 +1714,7 @@ subroutine ReadOptions(PropField, ExtractType) default = .false., & ClientModule = 'ModuleField4D', & STAT = STAT_CALL) - if (STAT_CALL .NE. SUCCESS_) stop 'ReadOptions - ModuleField4D - ERR90' + if (STAT_CALL .NE. SUCCESS_) stop 'ReadOptions - ModuleField4D - ERR100' call GetData(PropField%From3Dto2D, & @@ -1724,7 +1724,7 @@ subroutine ReadOptions(PropField, ExtractType) default = .false., & ClientModule = 'ModuleField4D', & STAT = STAT_CALL) - if (STAT_CALL .NE. SUCCESS_) stop 'ReadOptions - ModuleField4D - ERR95' + if (STAT_CALL .NE. SUCCESS_) stop 'ReadOptions - ModuleField4D - ERR110' call GetOutPutTime(Me%ObjEnterData, & @@ -1736,7 +1736,7 @@ subroutine ReadOptions(PropField, ExtractType) OutPutsOn = Me%OutPut%Yes, & OutPutsNumber = Me%OutPut%TotalOutputs, & STAT = STAT_CALL) - if (STAT_CALL .NE. SUCCESS_) stop 'ReadOptions - ModuleField4D - ERR100' + if (STAT_CALL .NE. SUCCESS_) stop 'ReadOptions - ModuleField4D - ERR120' Me%OutPut%NextOutPut = 1 @@ -1747,7 +1747,7 @@ subroutine ReadOptions(PropField, ExtractType) default = .false., & ClientModule = 'ModuleField4D', & STAT = STAT_CALL) - if (STAT_CALL .NE. SUCCESS_) stop 'ReadOptions - ModuleField4D - ERR160' + if (STAT_CALL .NE. SUCCESS_) stop 'ReadOptions - ModuleField4D - ERR130' if (PropField%Harmonics%ON) then call GetData(PropField%Harmonics%Extract, & @@ -1757,7 +1757,7 @@ subroutine ReadOptions(PropField, ExtractType) default = .false., & ClientModule = 'ModuleField4D', & STAT = STAT_CALL) - if (STAT_CALL .NE. SUCCESS_) stop 'ReadOptions - ModuleField4D - ERR170' + if (STAT_CALL .NE. SUCCESS_) stop 'ReadOptions - ModuleField4D - ERR140' call GetData(PropField%Harmonics%FieldNameDim, & Me%ObjEnterData , iflag, & @@ -1766,7 +1766,27 @@ subroutine ReadOptions(PropField, ExtractType) default = char_residual_, & ClientModule = 'ModuleField4D', & STAT = STAT_CALL) - if (STAT_CALL .NE. SUCCESS_) stop 'ReadOptions - ModuleField4D - ERR175' + if (STAT_CALL .NE. SUCCESS_) stop 'ReadOptions - ModuleField4D - ERR150' + + call GetData(PropField%Harmonics%TimeReference, & + Me%ObjEnterData , iflag, & + SearchType = ExtractType, & + keyword = 'TIME_REF', & + default = 0., & + ClientModule = 'ModuleField4D', & + STAT = STAT_CALL) + if (STAT_CALL /= SUCCESS_) stop 'ReadOptions - ModuleField4D - ERR160' + + if (iflag == 1) PropField%Harmonics%TimeReference = - PropField%Harmonics%TimeReference + + call GetData(PropField%Harmonics%ReferenceValue, & + Me%ObjEnterData , iflag, & + SearchType = ExtractType, & + keyword = 'REF_VALUE', & + default = 0., & + ClientModule = 'ModuleField4D', & + STAT = STAT_CALL) + if (STAT_CALL /= SUCCESS_) stop 'ReadOptions - ModuleField4D - ERR170' call GetData(PropField%Harmonics%TideStateON, & @@ -1776,18 +1796,18 @@ subroutine ReadOptions(PropField, ExtractType) default = .false., & ClientModule = 'ModuleField4D', & STAT = STAT_CALL) - if (STAT_CALL .NE. SUCCESS_) stop 'ReadOptions - ModuleField4D - ERR177' + if (STAT_CALL .NE. SUCCESS_) stop 'ReadOptions - ModuleField4D - ERR180' if (PropField%Harmonics%TideStateON) then - call GetData(PropField%Harmonics%TideStateDT, & - Me%ObjEnterData , iflag, & - SearchType = ExtractType, & - keyword = 'TIDE_STATE_DT', & - default = 1800., & - ClientModule = 'ModuleField4D', & + call GetData(PropField%Harmonics%TideStateDT, & + Me%ObjEnterData , iflag, & + SearchType = ExtractType, & + keyword = 'TIDE_STATE_DT', & + default = 1800., & + ClientModule = 'ModuleField4D', & STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'ReadOptions - ModuleField4D - ERR179' + if (STAT_CALL /= SUCCESS_) stop 'ReadOptions - ModuleField4D - ERR190' endif endif @@ -1802,7 +1822,7 @@ subroutine ReadOptions(PropField, ExtractType) default = Me%MaskDim, & ClientModule = 'ModuleField4D', & STAT = STAT_CALL) - if (STAT_CALL .NE. SUCCESS_) stop 'ReadOptions - ModuleField4D - ERR110' + if (STAT_CALL .NE. SUCCESS_) stop 'ReadOptions - ModuleField4D - ERR200' if (iflag == 0 .and. Me%File%Form == HDF5_) then @@ -1810,12 +1830,12 @@ subroutine ReadOptions(PropField, ExtractType) call GetHDF5ArrayDimensions (Me%File%Obj, trim(PropField%VGroupPath), & PropField%Harmonics%FieldNameDim, & NDim = PropField%SpaceDim, STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_)stop 'ReadOptions - ModuleField4D - ERR115' + if (STAT_CALL /= SUCCESS_)stop 'ReadOptions - ModuleField4D - ERR210' else call GetHDF5ArrayDimensions (Me%File%Obj, trim(PropField%VGroupPath), & trim(PropField%FieldName), OutputNumber = 1, & NDim = PropField%SpaceDim, STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_)stop 'ReadOptions - ModuleField4D - ERR120' + if (STAT_CALL /= SUCCESS_)stop 'ReadOptions - ModuleField4D - ERR220' endif endif if (PropField%Harmonics%ON) then @@ -1834,7 +1854,7 @@ subroutine ReadOptions(PropField, ExtractType) else - stop 'ReadOptions - ModuleField4D - ERR170' + stop 'ReadOptions - ModuleField4D - ERR230' endif @@ -1849,7 +1869,7 @@ subroutine ReadOptions(PropField, ExtractType) default = .true., & ClientModule = 'ModuleField4D', & STAT = STAT_CALL) - if (STAT_CALL .NE. SUCCESS_) stop 'ReadOptions - ModuleField4D - ERR130' + if (STAT_CALL .NE. SUCCESS_) stop 'ReadOptions - ModuleField4D - ERR240' call GetData(PropField%MinValue, & @@ -1859,7 +1879,7 @@ subroutine ReadOptions(PropField, ExtractType) default = FillValueReal, & ClientModule = 'ModuleField4D', & STAT = STAT_CALL) - if (STAT_CALL .NE. SUCCESS_) stop 'ReadOptions - ModuleField4D - ERR140' + if (STAT_CALL .NE. SUCCESS_) stop 'ReadOptions - ModuleField4D - ERR250' PropField%MinValueON = .false. @@ -1874,7 +1894,7 @@ subroutine ReadOptions(PropField, ExtractType) default = -FillValueReal, & ClientModule = 'ModuleField4D', & STAT = STAT_CALL) - if (STAT_CALL .NE. SUCCESS_) stop 'ReadOptions - ModuleField4D - ERR150' + if (STAT_CALL .NE. SUCCESS_) stop 'ReadOptions - ModuleField4D - ERR260' PropField%MaxValueON = .false. @@ -1888,7 +1908,7 @@ subroutine ReadOptions(PropField, ExtractType) default = Me%Extrapolate, & ClientModule = 'ModuleField4D', & STAT = STAT_CALL) - if (STAT_CALL .NE. SUCCESS_) stop 'ReadOptions - ModuleField4D - ERR160' + if (STAT_CALL .NE. SUCCESS_) stop 'ReadOptions - ModuleField4D - ERR270' !ExtrapolAverage_ = 1, ExtrapolNearstCell_ = 2 call GetData(PropField%ExtrapolateMethod, & @@ -1898,7 +1918,7 @@ subroutine ReadOptions(PropField, ExtractType) default = Me%ExtrapolateMethod, & ClientModule = 'ModuleField4D', & STAT = STAT_CALL) - if (STAT_CALL .NE. SUCCESS_) stop 'ReadOptions - ModuleField4D - ERR160' + if (STAT_CALL .NE. SUCCESS_) stop 'ReadOptions - ModuleField4D - ERR280' !Bilinear2D_ = 1, NearestNeighbor2D_ = 2 call GetData(PropField%InterpolMethod, & @@ -1908,11 +1928,11 @@ subroutine ReadOptions(PropField, ExtractType) default = Bilinear2D_, & ClientModule = 'ModuleField4D', & STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'ReadOptions - ModuleField4D - ERR170' + if (STAT_CALL /= SUCCESS_) stop 'ReadOptions - ModuleField4D - ERR290' if (PropField%InterpolMethod /= Bilinear2D_ .and. & PropField%InterpolMethod /= NearestNeighbor2D_) then - stop 'ReadOptions - ModuleField4D - ERR180' + stop 'ReadOptions - ModuleField4D - ERR300' endif @@ -1923,7 +1943,7 @@ subroutine ReadOptions(PropField, ExtractType) default = .false., & ClientModule = 'ModuleField4D', & STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'ReadOptions - ModuleField4D - ERR180' + if (STAT_CALL /= SUCCESS_) stop 'ReadOptions - ModuleField4D - ERR310' call GetData(PropField%DiscardFillValues, & Me%ObjEnterData , iflag, & @@ -1932,12 +1952,12 @@ subroutine ReadOptions(PropField, ExtractType) default = .true., & ClientModule = 'ModuleField4D', & STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'ReadOptions - ModuleField4D - ERR190' + if (STAT_CALL /= SUCCESS_) stop 'ReadOptions - ModuleField4D - ERR320' ! Check if the simulation goes backward in time or forward in time (default mode) call GetBackTracking(Me%ObjTime, Me%BackTracking, STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'ReadOptions - ModuleField4D - ERR200' + if (STAT_CALL /= SUCCESS_) stop 'ReadOptions - ModuleField4D - ERR330' @@ -2088,24 +2108,7 @@ subroutine ReadHarmonicWaves(PropField, ExtractType) if (STAT_CALL /= SUCCESS_) stop 'ReadHarmonicWaves - ModuleField4D - ERR70' endif - call GetData(PropField%Harmonics%TimeReference, & - Me%ObjEnterData , iflag, & - SearchType = ExtractType, & - keyword = 'TIME_REF', & - default = 0., & - ClientModule = 'ModuleField4D', & - STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'ReadHarmonicWaves - ModuleField4D - ERR80' - - call GetData(PropField%Harmonics%ReferenceValue, & - Me%ObjEnterData , iflag, & - SearchType = ExtractType, & - keyword = 'REF_VALUE', & - default = 0., & - ClientModule = 'ModuleField4D', & - STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'ReadHarmonicWaves - ModuleField4D - ERR90' - + end subroutine ReadHarmonicWaves diff --git a/Software/MOHIDBase2/ModuleGeometry.F90 b/Software/MOHIDBase2/ModuleGeometry.F90 index 7242f81d6..408f4fc24 100644 --- a/Software/MOHIDBase2/ModuleGeometry.F90 +++ b/Software/MOHIDBase2/ModuleGeometry.F90 @@ -77,8 +77,7 @@ Module ModuleGeometry #endif _USE_MPI use ModuleFunctions, only: SetMatrixValue, SetMatrixValueAllocatable, & - Chunk_J, Chunk_K, GetPointer, & - ComputeAvgVerticalVelocity + Chunk_J, Chunk_K, GetPointer use ModuleHDF5 use ModuleStopWatch, only : StartWatch, StopWatch @@ -120,7 +119,6 @@ Module ModuleGeometry private :: ComputeDistances private :: ComputeAreas private :: ComputeVolumes - private :: ComputeVolume2D private :: StoreVolumeZOld #ifdef _USE_SEQASSIMILATION @@ -243,7 +241,6 @@ Module ModuleGeometry real :: BottomLayerThickness = FillValueReal real :: GridMovementDump = FillValueReal real :: DisplacementLimit = FillValueReal - real :: RelaxToAverageFactor = FillValueReal integer :: InitializationMethod = FillValueInt real :: Equidistant = FillValueReal logical :: RomsDistortion = .false. @@ -274,7 +271,6 @@ Module ModuleGeometry type T_Volumes real(8), dimension(:, :, :), allocatable :: VolumeZ, VolumeU, VolumeV, VolumeW, VolumeZOld - real(8), dimension(:, :), allocatable :: VolumeZ_2D !Joao Sobrinho logical :: FirstVolW = .true. end type T_Volumes @@ -311,7 +307,6 @@ Module ModuleGeometry VolumeU => null(), & VolumeV => null(), & VolumeZOld => null() - real(8), dimension(:, :, ), pointer :: VolumeZ_2D => null(), & end type T_StatePointer #endif _USE_SEQASSIMILATION @@ -347,8 +342,6 @@ Module ModuleGeometry logical :: BathymNotCorrect = .false. character(len=Pathlength) :: InputFile = null_str !initialization: Jauch - - real, dimension(:,:,:), pointer :: NearbyAvgVel_Z => null() ! Joao Sobrinho #ifdef _USE_SEQASSIMILATION !This variable is used to retain location of original memory space for variables @@ -800,11 +793,7 @@ subroutine AllocateVariables(Kmax) allocate (Me%Volumes%VolumeZ(ILB:IUB, JLB:JUB, KLB:KUB), stat = STATUS) if (STATUS /= SUCCESS_) stop 'AllocateVariables - Geometry - ERR10' Me%Volumes%VolumeZ = FillValueDouble - !Joao Sobrinho - allocate (Me%Volumes%VolumeZ_2D(ILB:IUB, JLB:JUB), stat = STATUS) - if (STATUS /= SUCCESS_) stop 'AllocateVariables - Geometry - ERR11' - Me%Volumes%VolumeZ_2D = FillValueDouble - + allocate (Me%Volumes%VolumeU(ILB:IUB, JLB:JUB, KLB:KUB), stat = STATUS) if (STATUS /= SUCCESS_) stop 'AllocateVariables - Geometry - ERR20' Me%Volumes%VolumeU = FillValueDouble @@ -903,10 +892,6 @@ subroutine AllocateVariables(Kmax) allocate (Me%KTop%Z(ILB:IUB, JLB:JUB), stat = STATUS) if (STATUS /= SUCCESS_) stop 'AllocateVariables - Geometry - ERR250' Me%KTop%Z(:,:) = FillValueInt - - allocate (Me%NearbyAvgVel_Z(ILB:IUB, JLB:JUB, KLB:KUB), stat = STATUS) !Joao Sobrinho - if (STATUS /= SUCCESS_) stop "AllocateVariables - Geometry - ERR255" - call SetMatrixValue(Me%NearbyAvgVel_Z, Me%Size, FillValueReal) end subroutine AllocateVariables @@ -1297,16 +1282,6 @@ subroutine GetDomainsFromFile STAT = STATUS) if (STATUS /= SUCCESS_) & stop "GetDomainsFromFile - Geometry - ERR230" - !Joao Sobrinho - call GetData(NewDomain%RelaxToAverageFactor, & - ObjEnterData, iflag, & - SearchType = FromBlock, & - keyword = 'RELAXTOAVERAGEFACTOR', & - ClientModule = 'ModuleGeometry', & - Default = 0.7, & - STAT = STATUS) - if (STATUS /= SUCCESS_) & - stop "GetDomainsFromFile - Geometry - ERR235" if (LagrangianOld_flag == 1) then call GetData(DomainType, & @@ -1334,8 +1309,7 @@ subroutine GetDomainsFromFile write (*,*) "Initialization Method invalid" stop "GetDomainsFromFile - Geometry - ERR250" endif - endif - + endif endif @@ -2652,8 +2626,6 @@ subroutine PointToGeometryState(GeometryID, STAT) Me%AuxPointer%WaterColumnZ => Me%WaterColumn%Z Me%AuxPointer%VolumeZ => Me%Volumes%VolumeZ - - Me%AuxPointer%VolumeZ_2D => Me%Volumes%VolumeZ_2D Me%AuxPointer%VolumeU => Me%Volumes%VolumeU @@ -2917,23 +2889,22 @@ end subroutine UpdateKfloor subroutine ComputeVerticalGeometry(GeometryID, WaterPoints3D, SurfaceElevation, & ActualTime, VerticalVelocity, DT_Waterlevel, & - SZZ, DecayTime, KTop, OpenPoints3D, STAT) - !Joao Sobrinho - added OpenPoints3D + SZZ, DecayTime, KTop, STAT) + !Arguments------------------------------------------------------------- - integer :: GeometryID - integer, dimension(:, :, :), pointer :: WaterPoints3D - integer, dimension(:, :, :), pointer, optional :: OpenPoints3D - real, dimension(:, :), pointer, optional :: SurfaceElevation - type (T_Time), optional :: ActualTime - real, dimension(:, :, :), pointer, optional :: VerticalVelocity !Gives the vertical variation - real, intent(in), optional :: DT_Waterlevel !for the lagragean coordinate - real, dimension(:, :, :), pointer, optional :: SZZ, DecayTime - integer, dimension(:, :), pointer, optional :: KTop - integer, intent(out), optional :: STAT + integer :: GeometryID + integer, dimension(:, :, :), pointer :: WaterPoints3D + real, dimension(:, :), pointer, optional :: SurfaceElevation + type (T_Time), optional :: ActualTime + real, dimension(:, :, :), pointer, optional :: VerticalVelocity !Gives the vertical variation + real, intent(in), optional :: DT_Waterlevel !for the lagragean coordinate + real, dimension(:, :, :), pointer, optional :: SZZ, DecayTime + integer, dimension(:, :), pointer, optional :: KTop + integer, intent(out), optional :: STAT !Local----------------------------------------------------------------- - integer :: ready_ - integer :: STAT_ + integer :: ready_ + integer :: STAT_ !---------------------------------------------------------------------- @@ -2954,8 +2925,7 @@ subroutine ComputeVerticalGeometry(GeometryID, WaterPoints3D, SurfaceElevation, call SetMatrixValue( GetPointer(Me%Distances%SZZ), Me%Size, SZZ ) else !Computes SZZ - call ComputeSZZ(SurfaceElevation, TRANSIENTGEOMETRY, VerticalVelocity, DT_Waterlevel, WaterPoints3D, & - OpenPoints3D) + call ComputeSZZ(SurfaceElevation, TRANSIENTGEOMETRY, VerticalVelocity, DT_Waterlevel, WaterPoints3D) if (Me%LastDomain%DomainType == Sigma) then if (Me%LastDomain%SigmaZleveHybrid) then @@ -2991,11 +2961,12 @@ subroutine ComputeVerticalGeometry(GeometryID, WaterPoints3D, SurfaceElevation, !It is necessary for the Soil model call ComputeZCellCenter - !Computes the WaterColumn - if (Me%FirstDomain%DomainType /= FixSediment) then - call ComputeWaterColumn(SurfaceElevation) - call ComputeVolume2D - endif + if (present(SurfaceElevation)) then + !Computes the WaterColumn + if (Me%FirstDomain%DomainType /= FixSediment) then + call ComputeWaterColumn(SurfaceElevation) + endif + endif nullify(Me%Externalvar%DecayTime) @@ -3196,41 +3167,8 @@ subroutine ComputeWaterColumn(SurfaceElevation) end subroutine ComputeWaterColumn !-------------------------------------------------------------------------- - subroutine ComputeVolume2D !Joćo Sobrinho - !locals----------------------------------------------------------------- - integer :: i, j, STAT_CALL - real, dimension(:,:), pointer :: DUX, DVY - integer, dimension(:, :), pointer :: WaterPoints2D - !Begin------------------------------------------------------------------ - - !Gets DUX, DVY - call GetHorizontalGrid(Me%ObjHorizontalGrid, DUX = DUX, DVY = DVY, STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'ComputeVolume2D - Geometry - ERR01' - - !Gets WaterPoints2D - call GetWaterPoints2D(Me%ObjHorizontalMap, WaterPoints2D, STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'ComputeVolume2D - Geometry - ERR02' - - !Integrate volumeZ - for 2way nesting purposes - do j = Me%WorkSize%JLB, Me%WorkSize%JUB - do i = Me%WorkSize%ILB, Me%WorkSize%IUB - Me%Volumes%VolumeZ_2D(i, j) = Me%WaterColumn%Z(i, j) * dble(DUX(i, j)) * dble(DVY(i, j)) * & - WaterPoints2D(i, j) - enddo - enddo - - call UnGetHorizontalGrid(Me%ObjHorizontalGrid, DUX, STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'ComputeVolume2D - Geometry - ERR03' - call UnGetHorizontalGrid(Me%ObjHorizontalGrid, DVY, STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'ComputeVolume2D - Geometry - ERR04' - - call UnGetHorizontalMap(Me%ObjHorizontalMap, WaterPoints2D, STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'ComputeVolume2D - Geometry - ERR05' - - end subroutine ComputeVolume2D - !-------------------------------------------------------------------------- !Computes the Distances (DWZ + DZZ + DUZ + DVZ + DZI + DZE) @@ -3820,16 +3758,14 @@ end subroutine StoreVolumeZOld !-------------------------------------------------------------------------- !For every domain calls the respective computation rotine - subroutine ComputeSZZ (SurfaceElevation, ComputionType, VerticalVelocity, DT_Waterlevel, WaterPoints3D, & - OpenPoints3D) + subroutine ComputeSZZ (SurfaceElevation, ComputionType, VerticalVelocity, DT_Waterlevel, WaterPoints3D) !Parameter------------------------------------------------------------- real, dimension(:, :), pointer :: SurfaceElevation integer :: ComputionType real, dimension(:, :, :), optional, pointer :: VerticalVelocity real, intent(in), optional :: DT_Waterlevel - integer, dimension(:, :, :), optional, pointer :: WaterPoints3D, OpenPoints3D - real, dimension(:, :, :), pointer :: ZonalVerticalVelocity + integer, dimension(:, :, :), optional, pointer :: WaterPoints3D !Esternal-------------------------------------------------------------- @@ -3920,11 +3856,8 @@ subroutine ComputeSZZ (SurfaceElevation, ComputionType, VerticalVelocity, DT_Wat call ComputeSigma(SurfaceElevation, CurrentDomain) else if (CurrentDomain%IsLagrangian) then - - call ComputeAvgVerticalVelocity(VerticalVelocity, Me%NearbyAvgVel_Z, Me%WorkSize, OpenPoints3D) - - call ComputeLagrangianNew(SurfaceElevation, VerticalVelocity, & - Me%NearbyAvgVel_Z, DT_Waterlevel, CurrentDomain) + call ComputeLagrangianNew(SurfaceElevation, VerticalVelocity, & + DT_Waterlevel, CurrentDomain) endif case (Isopycnic) @@ -3963,12 +3896,9 @@ subroutine ComputeSZZ (SurfaceElevation, ComputionType, VerticalVelocity, DT_Wat call ComputeCartesian(SurfaceElevation, CurrentDomain, ComputionType) endif - else - call ComputeAvgVerticalVelocity(VerticalVelocity, Me%NearbyAvgVel_Z, Me%WorkSize, & - OpenPoints3D) - - call ComputeLagrangianNew(SurfaceElevation, VerticalVelocity, & - Me%NearbyAvgVel_Z, DT_Waterlevel, CurrentDomain) + else + call ComputeLagrangianNew(SurfaceElevation, VerticalVelocity, & + DT_Waterlevel, CurrentDomain) endif endif @@ -4850,11 +4780,11 @@ end subroutine ComputeLagrangian !-------------------------------------------------------------------------- !Computes SZZ for a Lagrangian Domain - from up - subroutine ComputeLagrangianNew(SurfaceElevation, VerticalVelocity, ZonalVerticalVelocity, DT_Waterlevel, Domain) + subroutine ComputeLagrangianNew(SurfaceElevation, VerticalVelocity, DT_Waterlevel, Domain) !Parameter------------------------------------------------------------- real, dimension(:, :), pointer :: SurfaceElevation - real, dimension(:, :, :), pointer :: VerticalVelocity, ZonalVerticalVelocity + real, dimension(:, :, :), pointer :: VerticalVelocity real, intent(in) :: DT_Waterlevel type (T_Domain), pointer :: Domain @@ -4862,6 +4792,7 @@ subroutine ComputeLagrangianNew(SurfaceElevation, VerticalVelocity, ZonalVertica integer :: i, j, k, ILB, IUB, JLB, JUB integer :: LowerLayer, UpperLayer integer, dimension(:, :), pointer :: WaterPoints2D +! real , dimension(:, :,:), pointer :: OldSZZ real :: TopDepth, BottomDepth, DomainThickness real :: MinimalThickness real :: DisplacementLimit @@ -4948,9 +4879,7 @@ subroutine ComputeLagrangianNew(SurfaceElevation, VerticalVelocity, ZonalVertica !For the Layer k the Vertical Velocity to consider is the velocity in !k+1(Upper Face) once the vertical velocity has a different index than !the SZZ - ! Joao Sobrinho - Added relaxation to average of the nearby (and current cell) vertical velocity - FreeGridVelocity = VerticalVelocity(i, j, k+1) * (1 - Domain%RelaxToAverageFactor) + & - ZonalVerticalVelocity(i, j, k+1) * Domain%RelaxToAverageFactor + FreeGridVelocity = VerticalVelocity(i, j, k+1) FreeSZZ = Me%Distances%SZZ(i, j, k) - & FreeGridVelocity * DT_Waterlevel @@ -6009,12 +5938,11 @@ end subroutine GetGeometryAreas !-------------------------------------------------------------------------- subroutine GetGeometryVolumes(GeometryID, VolumeZ, VolumeU, VolumeV, & - VolumeW, VolumeZOld, VolumeZ_2D, ActualTime, STAT) + VolumeW, VolumeZOld, ActualTime, STAT) !Parameter------------------------------------------------------------- integer :: GeometryID real(8), dimension(:, :, :), pointer, optional :: VolumeZ, VolumeU, VolumeV, VolumeW, VolumeZOld - real(8), dimension(:, :), pointer, optional :: VolumeZ_2D type (T_Time), optional :: ActualTime integer, intent(out), optional :: STAT @@ -6042,11 +5970,6 @@ subroutine GetGeometryVolumes(GeometryID, VolumeZ, VolumeU, VolumeV, & call Read_Lock(mGEOMETRY_, Me%InstanceID) VolumeZ => Me%Volumes%VolumeZ endif - !VolumeZ_2D - Joao Sobrinho - if (present(VolumeZ_2D)) then - call Read_Lock(mGEOMETRY_, Me%InstanceID) - VolumeZ_2D => Me%Volumes%VolumeZ_2D - endif !VolumeU if (present(VolumeU)) then @@ -6682,8 +6605,6 @@ subroutine ReSetGeometry(GeometryID, STAT) Me%Areas%AreaV => Me%AuxPointer%AreaV Me%Volumes%VolumeZ => Me%AuxPointer%VolumeZ - - Me%Volumes%VolumeZ_2D => Me%AuxPointer%VolumeZ_2D Me%Volumes%VolumeZOld => Me%AuxPointer%VolumeZOld @@ -6836,14 +6757,13 @@ subroutine DeallocateVariables deallocate (Me%Volumes%VolumeZ, stat = STATUS) if (STATUS /= SUCCESS_) stop 'DeallocateVariables - Geometry - ERR10' endif - if (allocated(Me%Volumes%VolumeZ_2D)) then - deallocate (Me%Volumes%VolumeZ_2D, stat = STATUS) - if (STATUS /= SUCCESS_) stop 'DeallocateVariables - Geometry - ERR11' - endif + if (allocated(Me%Volumes%VolumeU)) then deallocate (Me%Volumes%VolumeU, stat = STATUS) if (STATUS /= SUCCESS_) stop 'DeallocateVariables - Geometry - ERR20' endif + + if (allocated(Me%Volumes%VolumeV)) then deallocate (Me%Volumes%VolumeV, stat = STATUS) if (STATUS /= SUCCESS_) stop 'DeallocateVariables - Geometry - ERR30' @@ -6956,11 +6876,6 @@ subroutine DeallocateVariables deallocate (Me%KTop%Z, stat = STATUS) if (STATUS /= SUCCESS_) stop 'DeallocateVariables - Geometry - ERR230' endif - !Joao Sobrinho - if (allocated(Me%NearbyAvgVel_Z)) then - deallocate (Me%NearbyAvgVel_Z, stat = STATUS) - if (STATUS /= SUCCESS_) stop 'DeallocateVariables - Geometry - ERR240' - endif end subroutine DeallocateVariables @@ -7069,8 +6984,6 @@ subroutine NullifyGeometryStatePointer(GeometryID, STAT) nullify(Me%AuxPointer%AreaV) nullify(Me%AuxPointer%VolumeZ) - - nullify(Me%AuxPointer%VolumeZ_2D) nullify(Me%AuxPointer%VolumeZOld) diff --git a/Software/MOHIDBase2/ModuleHorizontalGrid.F90 b/Software/MOHIDBase2/ModuleHorizontalGrid.F90 index a9cc76be0..5fc2930bd 100644 --- a/Software/MOHIDBase2/ModuleHorizontalGrid.F90 +++ b/Software/MOHIDBase2/ModuleHorizontalGrid.F90 @@ -73,9 +73,6 @@ Module ModuleHorizontalGrid public :: ConstructFatherGridLocation private :: ConstructNewFatherGrid1D private :: ConstructNewFatherGrid2D - private :: CheckNesting - private :: ConstructIWDSon2Father2D !Joao Sobrinho - private :: DetermineMaxRatio private :: Add_FatherGrid private :: CheckGridBorder private :: DefineBorderPolygons @@ -86,7 +83,6 @@ Module ModuleHorizontalGrid public :: WriteHorizontalGrid public :: WriteHorizontalGrid_UV public :: LocateCell - private :: LocateCell_2 public :: LocateCell1D public :: LocateCellPolygons public :: RecenterHorizontalGrid @@ -419,14 +415,6 @@ Module ModuleHorizontalGrid integer, dimension(:,:), pointer :: JV => null() integer, dimension(:,:), pointer :: ICross => null() integer, dimension(:,:), pointer :: JCross => null() - - integer, dimension(:,:), pointer :: ILinkZ => null() !Joao Sobrinho - integer, dimension(:,:), pointer :: JLinkZ => null() - integer, dimension(:,:), pointer :: ILinkU => null() - integer, dimension(:,:), pointer :: JLinkU => null() - integer, dimension(:,:), pointer :: ILinkV => null() - integer, dimension(:,:), pointer :: JLinkV => null() - type (T_Size2D) :: MPI_Window type (T_FatherGrid), pointer :: Next => null() type (T_FatherGrid), pointer :: Prev => null() @@ -497,7 +485,8 @@ Module ModuleHorizontalGrid integer :: FilesListID = null_int character(PathLength) :: ModelPath = null_str type (T_Coef2D) :: Coef2D - type (T_Coef3D) :: Coef3D + type (T_Coef3D) :: Coef3D + logical :: AutomaticLines = .false. end type T_DDecomp @@ -524,10 +513,6 @@ Module ModuleHorizontalGrid integer :: ZoneLong = null_int integer :: ZoneLat = null_int integer, dimension(2) :: Grid_Zone - - integer, pointer, dimension(:, :) :: IWD_connections => null() - real, pointer, dimension(:) :: IWD_Distances => null() - logical :: UsedIWD_2Way = .false. type(T_Compute) :: Compute @@ -1295,9 +1280,21 @@ subroutine OptionsDDecomp() call Block_Unlock(Me%ObjEnterData2, ClientNumber, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) stop 'OptionsDDecomp - ModuleHorizontalGrid - ERR210' -iAuto: if (.not. Me%DDecomp%Auto) then +iAuto: if (Me%DDecomp%Auto) then + + call GetData(Value = Me%DDecomp%AutomaticLines, & + EnterDataID = Me%ObjEnterData2, & + flag = iflag, & + keyword = 'AUTOMATIC_LINES', & + SearchType = FromFile, & + default = .false., & + ClientModule = 'ModuleHorizontalGrid', & + STAT = STAT_CALL) + if (STAT_CALL /= SUCCESS_) stop 'OptionsDDecomp - ModuleHorizontalGrid - ERR230' + + else - call GetData(Value = Me%DDecomp%NInterfaces, & + call GetData(Value = Me%DDecomp%NInterfaces, & EnterDataID = Me%ObjEnterData2, & flag = iflag, & keyword = 'INTERFACES_NUMBER', & @@ -1483,7 +1480,7 @@ subroutine AutomaticDDecomp() write(*,*) 'halo_points', Me%DDecomp%Halo_Points - if (Me%DDecomp%Global%IUB > Me%DDecomp%Global%JUB) then + if (Me%DDecomp%Global%IUB > Me%DDecomp%Global%JUB .or. Me%DDecomp%AutomaticLines) then call AutomaticDDecompLines () else call AutomaticDDecompColumns() @@ -1666,7 +1663,7 @@ end subroutine AllocateInstance !-------------------------------------------------------------------------- subroutine ConstructFatherGridLocation(HorizontalGridID, HorizontalGridFatherID, & - GridID, OkCross, OkZ, OkU, OkV, Window, TwoWay, STAT) + GridID, OkCross, OkZ, OkU, OkV, Window, STAT) !Arguments------------------------------------------------------------- integer :: HorizontalGridID @@ -1674,14 +1671,13 @@ subroutine ConstructFatherGridLocation(HorizontalGridID, HorizontalGridFatherID, integer, optional, intent (IN) :: GridID logical, optional, intent (IN) :: OkCross, OkZ, OkU, OkV type (T_Size2D), optional :: Window - integer, optional, intent (OUT) :: STAT - logical, optional, intent (IN) :: TwoWay + integer, optional, intent (OUT) :: STAT !Local----------------------------------------------------------------- type (T_HorizontalGrid), pointer :: ObjHorizontalGridFather type (T_FatherGrid), pointer :: NewFatherGrid integer :: STAT_, ready_, GridID_ - logical :: OkZ_, OkU_, OkV_, OkCross_, GoForIWD !Joćo Sobrinho + logical :: OkZ_, OkU_, OkV_, OkCross_ !------------------------------------------------------------------------ @@ -1743,16 +1739,6 @@ subroutine ConstructFatherGridLocation(HorizontalGridID, HorizontalGridFatherID, OkZ_, OkU_, OkV_, OkCross_) endif - if (TwoWay)then !Joao Sobrinho - call CheckNesting(ObjHorizontalGridFather, GoForIWD, NewFatherGrid) - if (GoForIWD) then - Me%UsedIWD_2Way = .true. - Call ConstructIWDSon2Father2D(ObjHorizontalGridFather, NewFatherGrid) - endif - - endif - - if (Me%CoordType == SIMPLE_GEOG_ .and. .not. Me%ReadCartCorners .and. Me%ProjType == PAULO_PROJECTION_) then if (ObjHorizontalGridFather%Longitude /= Me%Longitude) then stop 'ConstructFatherGridLocation - ModuleHorizontalGrid - ERR10' @@ -1899,10 +1885,12 @@ subroutine ConstructNewFatherGrid1D(ObjHorizontalGridFather, NewFatherGrid, Grid integer :: ILB, IUB, JLB, JUB, i, j integer :: ILBwork, IUBwork, JLBwork, JUBwork logical :: CheckRotation_ - integer :: ILBFAther, IUBFather, JLBFather, JUBFather, U, V + integer :: ILBFAther, IUBFather, JLBFather, JUBFather !---------------------------------------------------------------------- + !if (Me%CornersXYInput) stop 'ConstructNewFatherGrid1D - ModuleHoriuzontalGrid - ERR01' + if (present(CheckRotation)) then CheckRotation_ = CheckRotation else @@ -1952,8 +1940,7 @@ subroutine ConstructNewFatherGrid1D(ObjHorizontalGridFather, NewFatherGrid, Grid NewFatherGrid%MPI_Window%JLB = -null_int NewFatherGrid%MPI_Window%JUB = null_int - U = 1 - V = 1 + !Compute points location ib the father grid if (NewFatherGrid%OkZ) then @@ -1964,19 +1951,14 @@ subroutine ConstructNewFatherGrid1D(ObjHorizontalGridFather, NewFatherGrid, Grid !Initialize Values NewFatherGrid%XX_Z (:,:) = FillValueReal NewFatherGrid%YY_Z (:,:) = FillValueReal - !Joao Sobrinho - allocate (NewFatherGrid%ILinkZ (ILB:IUB, JLB:JUB)) - allocate (NewFatherGrid%JLinkZ (ILB:IUB, JLB:JUB)) - + + allocate (NewFatherGrid%IZ (ILB:IUB, JLB:JUB)) allocate (NewFatherGrid%JZ (ILB:IUB, JLB:JUB)) NewFatherGrid%IZ (:,:) = FillValueInt NewFatherGrid%JZ (:,:) = FillValueInt - - NewFatherGrid%ILinkZ (:,:) = FillValueInt - NewFatherGrid%JLinkZ (:,:) = FillValueInt - + XX_Z => NewFatherGrid%XX_Z YY_Z => NewFatherGrid%YY_Z IZ => NewFatherGrid%IZ @@ -1985,6 +1967,7 @@ subroutine ConstructNewFatherGrid1D(ObjHorizontalGridFather, NewFatherGrid, Grid endif if (NewFatherGrid%OkU) then + allocate (NewFatherGrid%XX_U (ILB:IUB, JLB:JUB)) allocate (NewFatherGrid%YY_U (ILB:IUB, JLB:JUB)) @@ -1993,16 +1976,10 @@ subroutine ConstructNewFatherGrid1D(ObjHorizontalGridFather, NewFatherGrid, Grid allocate (NewFatherGrid%IU (ILB:IUB, JLB:JUB)) allocate (NewFatherGrid%JU (ILB:IUB, JLB:JUB)) - !Joao Sobrinho - allocate (NewFatherGrid%ILinkU (ILB:IUB, JLB:JUB)) - allocate (NewFatherGrid%JLinkU (ILB:IUB, JLB:JUB)) NewFatherGrid%IU (:,:) = FillValueInt NewFatherGrid%JU (:,:) = FillValueInt - NewFatherGrid%ILinkU (:,:) = FillValueInt - NewFatherGrid%JLinkU (:,:) = FillValueInt - XX_U => NewFatherGrid%XX_U YY_U => NewFatherGrid%YY_U IU => NewFatherGrid%IU @@ -2011,6 +1988,7 @@ subroutine ConstructNewFatherGrid1D(ObjHorizontalGridFather, NewFatherGrid, Grid endif if (NewFatherGrid%OkV) then + allocate (NewFatherGrid%XX_V (ILB:IUB, JLB:JUB)) allocate (NewFatherGrid%YY_V (ILB:IUB, JLB:JUB)) @@ -2019,16 +1997,9 @@ subroutine ConstructNewFatherGrid1D(ObjHorizontalGridFather, NewFatherGrid, Grid allocate (NewFatherGrid%IV (ILB:IUB, JLB:JUB)) allocate (NewFatherGrid%JV (ILB:IUB, JLB:JUB)) - - !Joao Sobrinho - allocate (NewFatherGrid%ILinkV (ILB:IUB, JLB:JUB)) - allocate (NewFatherGrid%JLinkV (ILB:IUB, JLB:JUB)) - + NewFatherGrid%IV (:,:) = FillValueInt NewFatherGrid%JV (:,:) = FillValueInt - - NewFatherGrid%ILinkV (:,:) = FillValueInt - NewFatherGrid%JLinkV (:,:) = FillValueInt YY_V => NewFatherGrid%YY_V XX_V => NewFatherGrid%XX_V @@ -2116,19 +2087,12 @@ subroutine ConstructNewFatherGrid1D(ObjHorizontalGridFather, NewFatherGrid, Grid call RODAXY(Xorig, Yorig, Rotation, XX_Z(i, j), YY_Z(i, j)) - call LocateCell (ObjHorizontalGridFather%Compute%XX_Z, & - ObjHorizontalGridFather%Compute%YY_Z, & - XX_Z(i, j), YY_Z(i, j), & - ILBFAther, IUBFather, JLBFather, JUBFather, & + call LocateCell (ObjHorizontalGridFather%Compute%XX_Z, & + ObjHorizontalGridFather%Compute%YY_Z, & + XX_Z(i, j), YY_Z(i, j), & + ILBFAther, IUBFather, JLBFather, JUBFather, & IZ(i, j), JZ(i, j)) - call LocateCell_2(ObjHorizontalGridFather%Compute%XX_U, & - ObjHorizontalGridFather%Compute%YY_V, & - XX_Z(i, j), YY_Z(i, j), & - ILBFAther, IUBFather, JLBFather, JUBFather, & - NewFatherGrid%ILinkZ(i, j), NewFatherGrid%JLinkZ(i, j)) - - !Window NewFatherGrid%MPI_Window%ILB = min(NewFatherGrid%MPI_Window%ILB, IZ(i, j)) NewFatherGrid%MPI_Window%IUB = max(NewFatherGrid%MPI_Window%IUB, IZ(i, j)) @@ -2172,17 +2136,11 @@ subroutine ConstructNewFatherGrid1D(ObjHorizontalGridFather, NewFatherGrid, Grid call RODAXY(Xorig, Yorig, Rotation, XX_U(i, j), YY_U(i, j)) - call LocateCell (ObjHorizontalGridFather%Compute%XX_U, & - ObjHorizontalGridFather%Compute%YY_U, & - XX_U(i, j), YY_U(i, j), & - ILBFAther, IUBFather, JLBFather, JUBFather + 1, & + call LocateCell (ObjHorizontalGridFather%Compute%XX_U, & + ObjHorizontalGridFather%Compute%YY_U, & + XX_U(i, j), YY_U(i, j), & + ILBFAther, IUBFather, JLBFather, JUBFather + 1, & IU(i, j), JU(i, j)) - - call LocateCell_2(ObjHorizontalGridFather%Compute%XX_Z, & - ObjHorizontalGridFather%Compute%YY_V, & - XX_U(i, j), YY_U(i, j), & - ILBFAther, IUBFather, JLBFather, JUBFather, & - NewFatherGrid%ILinkU(i, j), NewFatherGrid%JLinkU(i, j), U = U) !Window NewFatherGrid%MPI_Window%ILB = min(NewFatherGrid%MPI_Window%ILB, IU(i, j)) @@ -2226,17 +2184,11 @@ subroutine ConstructNewFatherGrid1D(ObjHorizontalGridFather, NewFatherGrid, Grid call RODAXY(Xorig, Yorig, Rotation, XX_V(i, j), YY_V(i, j)) - call LocateCell (ObjHorizontalGridFather%Compute%XX_V, & - ObjHorizontalGridFather%Compute%YY_V, & - XX_V(i, j), YY_V(i, j), & - ILBFAther, IUBFather + 1, JLBFather, JUBFather, & + call LocateCell (ObjHorizontalGridFather%Compute%XX_V, & + ObjHorizontalGridFather%Compute%YY_V, & + XX_V(i, j), YY_V(i, j), & + ILBFAther, IUBFather + 1, JLBFather, JUBFather, & IV(i, j), JV(i, j)) - - call LocateCell_2(ObjHorizontalGridFather%Compute%XX_U, & - ObjHorizontalGridFather%Compute%YY_Z, & - XX_V(i, j), YY_V(i, j), & - ILBFAther, IUBFather, JLBFather, JUBFather, & - NewFatherGrid%ILinkV(i, j), NewFatherGrid%JLinkV(i, j), V = V) !MPI_Window NewFatherGrid%MPI_Window%ILB = min(NewFatherGrid%MPI_Window%ILB, IV(i, j)) @@ -2578,166 +2530,7 @@ subroutine ConstructNewFatherGrid2D(ObjHorizontalGridFather, NewFatherGrid, Grid NewFatherGrid%MPI_Window%JUB = NewFatherGrid%MPI_Window%JUB + 1 end subroutine ConstructNewFatherGrid2D - - !------------------------------------------------------------------------------------- - - !------------------------------------------------------------------------------------- - subroutine CheckNesting(ObjHorizontalGridFather, GoForIWD, NewFatherGrid) - !Joao Sobrinho - !Arguments------------------------------------------------------------- - type (T_HorizontalGrid), pointer :: ObjHorizontalGridFather - logical, intent (OUT) :: GoForIWD - type (T_FatherGrid), pointer :: NewFatherGrid - !Local----------------------------------------------------------------- - integer :: JUB, j - real :: DistanceToFather, DxFather, DistanceToFather_Next - logical :: Trigger - - !---------------------------------------------------------------------- - GoForIWD = .false. - JUB = Me%Size%JUB - j = 1 - DistanceToFather = 0.0 - Trigger = .true. - - if (Me%Grid_Angle .NE. ObjHorizontalGridFather%Grid_Angle)then - GoForIWD = .true. - else - - do while (Trigger .AND. j < JUB) - - DxFather = ObjHorizontalGridFather%XX(NewFatherGrid%JU(j, 1)) - & - ObjHorizontalGridFather%XX(NewFatherGrid%JU(j, 1) + 1) - - if (NewFatherGrid%JU(1, j + 1) > NewFatherGrid%JU(1, j))then - DistanceToFather = NewFatherGrid%XX_U(1, j) - ObjHorizontalGridFather%XX(NewFatherGrid%JU(1, j + 1)) - DistanceToFather_Next = NewFatherGrid%XX_U(1, j + 1) - ObjHorizontalGridFather%XX(NewFatherGrid%JU(1, j + 1)) - - if (abs(DistanceToFather) > abs(DxFather) * 0.09 .and. DistanceToFather < 0.0 & - .and. abs(DistanceToFather_Next > abs(DxFather) * 0.09) )then - Trigger = .false. - GoForIWD = .true. - else - j = j + 1 - endif - - else - j = j + 1 - endif - - enddo - - endif - - end subroutine CheckNesting - - !--------------------------------------------------------------------------- - - subroutine ConstructIWDSon2Father2D(ObjHorizontalGridFather, NewFatherGrid) - !Routine made to build the matrix of distances from son to father, to be used in IWD. Joao sobrinho - !Arguments-------------------------------------------------------------- - type (T_HorizontalGrid), pointer :: ObjHorizontalGridFather - type (T_FatherGrid), pointer :: NewFatherGrid - !Local------------------------------------------------------------------ - real :: FatherCenterX, FatherCenterY, DistanceToFather, SonCenterX, SonCenterY - real :: SearchRadious - integer :: index, Nbr_Connections, MaxRatio, min_J, min_I, max_J, max_I - integer :: i, j, i2, j2 - !------------------------------------------------------------------------- - index = 1 - ! Compute max ratio, which will be used to alocate IWD_Connections - call DetermineMaxRatio(ObjHorizontalGridFather, NewFatherGrid, MaxRatio) - - !Nbr_Connections = (NewFatherGrid%JV(1, Me%Size%JUB - 1) - NewFatherGrid%JV(1, 1)) * & - ! (NewFatherGrid%IV(1, Me%Size%IUB - 1) - NewFatherGrid%IV(1, 1)) * MaxRatio - - min_J = min(NewFatherGrid%JZ(1,1), NewFatherGrid%JZ(1, Me%Size%JUB - 1), & - NewFatherGrid%JZ(Me%Size%IUB - 1, 1), NewFatherGrid%JZ(Me%Size%IUB - 1, Me%Size%JUB - 1)) - min_I = min(NewFatherGrid%IZ(1,1), NewFatherGrid%IZ(1, Me%Size%JUB - 1), & - NewFatherGrid%IZ(Me%Size%IUB - 1, 1), NewFatherGrid%IZ(Me%Size%IUB - 1, Me%Size%JUB - 1)) - max_J = max(NewFatherGrid%JZ(1,1), NewFatherGrid%JZ(1, Me%Size%JUB - 1), & - NewFatherGrid%JZ(Me%Size%IUB - 1, 1), NewFatherGrid%JZ(Me%Size%IUB - 1, Me%Size%JUB - 1)) - max_I = max(NewFatherGrid%JZ(1,1), NewFatherGrid%JZ(1, Me%Size%JUB - 1), & - NewFatherGrid%JZ(Me%Size%IUB - 1, 1), NewFatherGrid%JZ(Me%Size%IUB - 1, Me%Size%JUB - 1)) - - Nbr_Connections = (max_J - min_J) * (max_I - min_I) * MaxRatio - - allocate (Me%IWD_connections(Nbr_Connections, 4)) !Joao Sobrinho - Falta desalocar no fim! - allocate (Me%IWD_Distances(Nbr_Connections)) - - Me%IWD_connections(:, :) = FillValueInt - Me%IWD_Distances(:) = FillValueReal - !i and j -> father cell - !i2 and j2 -> son cell - !Paralelizar! - do j = min_J, max_J - do i = min_I, max_I - - !Find Father cell center - - FatherCenterX = (( ObjHorizontalGridFather%XX_IE(i, j ) + ObjHorizontalGridFather%XX_IE(i+1, j ))/2. + & - ( ObjHorizontalGridFather%XX_IE(i, j+1) + ObjHorizontalGridFather%XX_IE(i+1, j+1))/2.)/2. - FatherCenterY = (( ObjHorizontalGridFather%YY_IE(i, j ) + ObjHorizontalGridFather%YY_IE(i+1, j ))/2. + & - ( ObjHorizontalGridFather%YY_IE(i, j+1) + ObjHorizontalGridFather%YY_IE(i+1, j+1))/2.)/2. - - SearchRadious = 1.1 * Sqrt((FatherCenterX - ObjHorizontalGridFather%XX(j))**2 + & - (FatherCenterY - ObjHorizontalGridFather%YY(j))**2) - - ! Find and build matrix of correspondent son cells - do j2 = 1, Me%Size%JUB - 1 - do i2 = 1, Me%Size%IUB - 1 - SonCenterX = (( Me%XX_IE(i, j ) + Me%XX_IE(i+1, j ))/2. + & - ( Me%XX_IE(i, j+1) + Me%XX_IE(i+1, j+1))/2.)/2. - SonCenterY = (( Me%YY_IE(i, j ) + Me%YY_IE(i+1, j ))/2. + & - ( Me%YY_IE(i, j+1) + Me%YY_IE(i+1, j+1))/2.)/2. - - DistanceToFather = Sqrt((SonCenterX - FatherCenterX)**2.0 + & - (SonCenterY - FatherCenterY)**2.0) - if (DistanceToFather <= SearchRadious) then - Me%IWD_connections(index, 1) = i - Me%IWD_connections(index, 2) = j - Me%IWD_connections(index, 3) = i2 - Me%IWD_connections(index, 4) = j2 - - Me%IWD_Distances(index) = DistanceToFather - - index = index + 1 - endif - enddo - enddo - - enddo - enddo - - end subroutine ConstructIWDSon2Father2D - - !--------------------------------------------------------------------------- - - subroutine DetermineMaxRatio(ObjHorizontalGridFather, NewFatherGrid, Ratio) - !Argumments--------------------------------------------------------------------- - type (T_HorizontalGrid), pointer :: ObjHorizontalGridFather - type (T_FatherGrid), pointer :: NewFatherGrid - integer, intent(OUT) :: Ratio - !local-------------------------------------------------------------------------- - real :: MaxRatio, aux, i, j - - !------------------------------------------------------------------------------- - MaxRatio = 1.0 - aux = 1.0 - Ratio = 1 - - do j = 1, Me%Size%JUB - 1 - do i = 1, Me%Size%IUB - 1 - aux = ObjHorizontalGridFather%GridCellArea(NewFatherGrid%IV(i, j), NewFatherGrid%JV(i, j)) / Me%GridCellArea(i, j) - if (aux > MaxRatio) then - MaxRatio = aux - endif - enddo - enddo - - Ratio = INT(MaxRatio) + 1 - - end subroutine DetermineMaxRatio + !-------------------------------------------------------------------------- ! This subroutine adds a new grid to the father grid List subroutine Add_FatherGrid(NewFatherGrid) @@ -4985,15 +4778,15 @@ end subroutine DefinesBorderPoly !*********************************************************************** ! * - ! Esta subroutina calcula 2 vectores e um escalar para a conversćo * - ! de coordenadas geodésicas em UTM: * + ! Esta subroutina calcula 2 vectores e um escalar para a conversĆ£o * + ! de coordenadas geodĆ©sicas em UTM: * ! * ! comprimento do fuso: DLZONE(I) * - ! nŗ do fuso: IZONE1(J) * - ! nŗ do fuso de origem: IZONE_ORIG * + ! nĀŗ do fuso: IZONE1(J) * + ! nĀŗ do fuso de origem: IZONE_ORIG * ! * - ! O meridiano de Greenwich estį no fuso 31. Considera-se como origem * - ! o ķnicio do 1ŗ fuso da malha. Cada fuso tem 6 graus e hį 60 fusos. * + ! O meridiano de Greenwich estĆ” no fuso 31. Considera-se como origem * + ! o Ć­nicio do 1Āŗ fuso da malha. Cada fuso tem 6 graus e hĆ” 60 fusos. * ! * ! * ! AIRES: 30/6/1977 * @@ -8334,7 +8127,7 @@ subroutine Add_MPI_ID_2_Filename(HorizontalGridID, FileName, STAT) iFN = len_trim(Filename) ipath = 0 do i = iFN, 1, -1 - if (Filename(i:i) == '/' .or. Filename(i:i) == '\') then + if (Filename(i:i) == '/' .or. Filename(i:i) == backslash) then ipath = i exit endif @@ -8513,8 +8306,7 @@ end subroutine GetHorizontalGridSize subroutine GetHorizontalGrid(HorizontalGridID, XX_IE, YY_IE, XX_Z, YY_Z, & XX_U, YY_U, XX_V, YY_V, XX_Cross, YY_Cross, & DXX, DYY, DZX, DZY, DUX, DUY, DVX, DVY, XX, YY, & - XX2D_Z, YY2D_Z, XX2D_U, YY2D_U, XX2D_V, YY2D_V, IV, JV,& - IU, JU, IZ, JZ, STAT) + XX2D_Z, YY2D_Z, XX2D_U, YY2D_U, XX2D_V, YY2D_V, IV, JV, STAT) !Arguments------------------------------------------------------------- integer :: HorizontalGridID @@ -8523,8 +8315,7 @@ subroutine GetHorizontalGrid(HorizontalGridID, XX_IE, YY_IE, XX_Z, YY_Z, real, dimension(: ), pointer, optional :: XX_Z, YY_Z, XX_U, YY_U, XX_V, YY_V, XX_Cross, YY_Cross real, dimension(:, :), pointer, optional :: DXX, DYY, DZX, DZY real, dimension(:, :), pointer, optional :: DUX, DUY, DVX, DVY - integer, dimension(:, :), pointer, optional :: IV, JV - integer, dimension(:, :), pointer, optional :: IU, JU, IZ, JZ !Joao Sobrinho + integer, dimension(:, :), pointer, optional :: IV, JV !JoĆ£o Sobrinho real, dimension(: ), pointer, optional :: XX, YY integer, optional, intent(OUT) :: STAT @@ -8693,26 +8484,6 @@ subroutine GetHorizontalGrid(HorizontalGridID, XX_IE, YY_IE, XX_Z, YY_Z, JV => Me%LastFatherGrid%JV call Read_Lock(mHORIZONTALGRID_, Me%InstanceID) endif - !IV. Father cell inside which is each son cell (row). - if (present(IU)) then - IU => Me%LastFatherGrid%IU - call Read_Lock(mHORIZONTALGRID_, Me%InstanceID) - endif - !JV. Father cell inside which is each son cell(column). - if (present(JU)) then - JU => Me%LastFatherGrid%JU - call Read_Lock(mHORIZONTALGRID_, Me%InstanceID) - endif - !IV. Father cell inside which is each son cell (row). - if (present(IZ)) then - IZ => Me%LastFatherGrid%IZ - call Read_Lock(mHORIZONTALGRID_, Me%InstanceID) - endif - !JV. Father cell inside which is each son cell(column). - if (present(JZ)) then - JZ => Me%LastFatherGrid%JZ - call Read_Lock(mHORIZONTALGRID_, Me%InstanceID) - endif STAT_ = SUCCESS_ else @@ -10795,28 +10566,23 @@ logical function WindowCellsIntersection(WorkSizeA, WorkSizeB) !Begin----------------------------------------------------------------- - LineInterSection = .false. - ColumnInterSection = .false. + LineInterSection = .true. + ColumnInterSection = .true. - if ((WorkSizeA%ILB >= WorkSizeB%ILB .and. WorkSizeA%ILB <= WorkSizeB%IUB) .or. & - (WorkSizeA%IUB >= WorkSizeB%ILB .and. WorkSizeA%IUB <= WorkSizeB%IUB)) then - LineInterSection = .true. + if (WorkSizeA%ILB < WorkSizeB%ILB .and. WorkSizeA%IUB < WorkSizeB%ILB) then + LineInterSection = .false. endif - if ((WorkSizeB%ILB >= WorkSizeA%ILB .and. WorkSizeB%ILB <= WorkSizeA%IUB) .or. & - (WorkSizeB%IUB >= WorkSizeA%ILB .and. WorkSizeB%IUB <= WorkSizeA%IUB)) then - LineInterSection = .true. + if (WorkSizeA%ILB > WorkSizeB%IUB .and. WorkSizeA%IUB > WorkSizeB%IUB) then + LineInterSection = .false. endif - - if ((WorkSizeA%JLB >= WorkSizeB%JLB .and. WorkSizeA%JLB >= WorkSizeB%JUB) .or. & - (WorkSizeA%JUB >= WorkSizeB%JLB .and. WorkSizeA%JUB <= WorkSizeB%JUB)) then - ColumnInterSection = .true. + if (WorkSizeA%JLB < WorkSizeB%JLB .and. WorkSizeA%JUB < WorkSizeB%JLB) then + ColumnInterSection = .false. endif - if ((WorkSizeB%JLB >= WorkSizeA%JLB .and. WorkSizeB%JLB >= WorkSizeA%JUB) .or. & - (WorkSizeB%JUB >= WorkSizeA%JLB .and. WorkSizeB%JUB <= WorkSizeA%JUB)) then - ColumnInterSection = .true. + if (WorkSizeA%JLB > WorkSizeB%JUB .and. WorkSizeA%JUB > WorkSizeB%JUB) then + ColumnInterSection = .false. endif if (LineInterSection .and. ColumnInterSection) then @@ -12976,13 +12742,13 @@ subroutine WriteHorizontalGrid (HorizontalGridID, ObjHDF5, OutputNumber, WorkSiz STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) stop 'WriteHorizontalGrid - HorizontalGrid - ERR04' - call HDF5WriteData (ObjHDF5, "/Grid/Longitude", "Longitude", "ŗ", & + call HDF5WriteData (ObjHDF5, "/Grid/Longitude", "Longitude", "Āŗ", & Array2D = Me%LongitudeConn, & OutputNumber = OutputNumber, & STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) stop 'WriteHorizontalGrid - HorizontalGrid - ERR05' - call HDF5WriteData (ObjHDF5, "/Grid/Latitude", "Latitude", "ŗ", & + call HDF5WriteData (ObjHDF5, "/Grid/Latitude", "Latitude", "Āŗ", & Array2D = Me%LatitudeConn, & OutputNumber = OutputNumber, & STAT = STAT_CALL) @@ -13011,12 +12777,12 @@ subroutine WriteHorizontalGrid (HorizontalGridID, ObjHDF5, OutputNumber, WorkSiz STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) stop 'WriteHorizontalGrid - HorizontalGrid - ERR04' - call HDF5WriteData (ObjHDF5, "/Grid", "Longitude", "ŗ", & + call HDF5WriteData (ObjHDF5, "/Grid", "Longitude", "Āŗ", & Array2D = Me%LongitudeConn, & STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) stop 'WriteHorizontalGrid - HorizontalGrid - ERR05' - call HDF5WriteData (ObjHDF5, "/Grid", "Latitude", "ŗ", & + call HDF5WriteData (ObjHDF5, "/Grid", "Latitude", "Āŗ", & Array2D = Me%LatitudeConn, & STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) stop 'WriteHorizontalGrid - HorizontalGrid - ERR06' @@ -13150,7 +12916,7 @@ subroutine WriteHorizontalGrid (HorizontalGridID, ObjHDF5, OutputNumber, WorkSiz if (STAT_CALL /= SUCCESS_) then !linux path - AuxFile = trim(adjustl(Me%DDecomp%ModelPath))//"\"//trim(adjustl(Me%DDecomp%FilesListName)) + AuxFile = trim(adjustl(Me%DDecomp%ModelPath))//backslash//trim(adjustl(Me%DDecomp%FilesListName)) open(file = AuxFile, & unit = Me%DDecomp%FilesListID, & @@ -13172,7 +12938,7 @@ subroutine WriteHorizontalGrid (HorizontalGridID, ObjHDF5, OutputNumber, WorkSiz iFile = 1 ilen = len_trim(FileName) do i = ilen,1,-1 - if (FileName(i:i) == '/' .or. FileName(i:i) == '\') then + if (FileName(i:i) == '/' .or. FileName(i:i) == backslash) then iFile = i+1 exit endif @@ -13268,7 +13034,7 @@ subroutine WriteHorizontalGrid_UV (HorizontalGridID, ObjHDF5, WorkSize, STAT) Aux2D(WorkIUB+2 , WorkJLB:WorkJUB+1) = Me%LongitudeConn(WorkIUB+1 , WorkJLB:WorkJUB+1) Aux2D(WorkILB:WorkIUB+2, WorkJUB+2) = Aux2D (WorkILB:WorkIUB+2, WorkJUB+1) - call HDF5WriteData (ObjHDF5, "/Grid", "Longitude", "ŗ", & + call HDF5WriteData (ObjHDF5, "/Grid", "Longitude", "Āŗ", & Array2D = Aux2D, & STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) stop 'WriteHorizontalGrid_UV - HorizontalGrid - ERR40' @@ -13277,7 +13043,7 @@ subroutine WriteHorizontalGrid_UV (HorizontalGridID, ObjHDF5, WorkSize, STAT) Aux2D(WorkIUB+2 , WorkJLB:WorkJUB+1) = Me%LatitudeConn(WorkIUB+1 , WorkJLB:WorkJUB+1) Aux2D(WorkILB:WorkIUB+2, WorkJUB+2) = Aux2D (WorkILB:WorkIUB+2, WorkJUB+1) - call HDF5WriteData (ObjHDF5, "/Grid", "Latitude", "ŗ", & + call HDF5WriteData (ObjHDF5, "/Grid", "Latitude", "Āŗ", & Array2D = Aux2D, & STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) stop 'WriteHorizontalGrid_UV - HorizontalGrid - ERR50' @@ -13374,7 +13140,7 @@ subroutine WriteHorizontalGrid_UV (HorizontalGridID, ObjHDF5, WorkSize, STAT) if (STAT_CALL /= SUCCESS_) then !linux path - AuxFile = trim(adjustl(Me%DDecomp%ModelPath))//"\"//trim(adjustl(Me%DDecomp%FilesListName)) + AuxFile = trim(adjustl(Me%DDecomp%ModelPath))//backslash//trim(adjustl(Me%DDecomp%FilesListName)) open(file = AuxFile, & unit = Me%DDecomp%FilesListID, & @@ -13396,7 +13162,7 @@ subroutine WriteHorizontalGrid_UV (HorizontalGridID, ObjHDF5, WorkSize, STAT) iFile = 1 ilen = len_trim(FileName) do i = ilen,1,-1 - if (FileName(i:i) == '/' .or. FileName(i:i) == '\') then + if (FileName(i:i) == '/' .or. FileName(i:i) == backslash) then iFile = i+1 exit endif @@ -14873,14 +14639,6 @@ subroutine KillHorizontalGrid(HorizontalGridID, STAT) deallocate(Me%AuxPolygon%VerticesF) deallocate(Me%AuxPolygon) - - if (Me%UsedIWD_2way)then !Joao Sobrinho - deallocate(Me%IWD_connections) - nullify (Me%IWD_connections) - deallocate(Me%IWD_Distances) - nullify (Me%IWD_Distances) - endif - call KillFatherGridList @@ -14991,21 +14749,6 @@ subroutine KillFatherGridList call SetError(FATAL_, INTERNAL_, "KillFatherGridList; HorizontalGrid. ERR40") nullify (FatherGrid%JZ) - - !ILinkZ - deallocate(FatherGrid%ILinkZ, STAT = status) - if (status /= SUCCESS_) & - call SetError(FATAL_, INTERNAL_, "KillFatherGridList; HorizontalGrid. ERR41") - - nullify (FatherGrid%ILinkZ) - !Joao Sobrinho - !JLinkZ - deallocate(FatherGrid%JLinkZ, STAT = status) - if (status /= SUCCESS_) & - call SetError(FATAL_, INTERNAL_, "KillFatherGridList; HorizontalGrid. ERR42") - - nullify (FatherGrid%JLinkZ) - endif @@ -15046,23 +14789,6 @@ subroutine KillFatherGridList call SetError(FATAL_, INTERNAL_, "KillFatherGridList; HorizontalGrid. ERR80") nullify (FatherGrid%JU) - - !ILinkU - deallocate(FatherGrid%ILinkU, STAT = status) - - if (status /= SUCCESS_) & - call SetError(FATAL_, INTERNAL_, "KillFatherGridList; HorizontalGrid. ERR81") - - nullify (FatherGrid%ILinkU) - - !Joao Sobrinho - !JLinkU - deallocate(FatherGrid%JLinkU, STAT = status) - - if (status /= SUCCESS_) & - call SetError(FATAL_, INTERNAL_, "KillFatherGridList; HorizontalGrid. ERR82") - - nullify (FatherGrid%JLinkU) endif @@ -15101,23 +14827,6 @@ subroutine KillFatherGridList call SetError(FATAL_, INTERNAL_, "KillFatherGridList; HorizontalGrid. ERR120") nullify (FatherGrid%JV) - - !Joao Sobrinho - !ILinkV - deallocate(FatherGrid%ILinkV, STAT = status) - - if (status /= SUCCESS_) & - call SetError(FATAL_, INTERNAL_, "KillFatherGridList; HorizontalGrid. ERR111") - - nullify (FatherGrid%ILinkV) - - !JLinkV - deallocate(FatherGrid%JLinkV, STAT = status) - - if (status /= SUCCESS_) & - call SetError(FATAL_, INTERNAL_, "KillFatherGridList; HorizontalGrid. ERR112") - - nullify (FatherGrid%JLinkV) endif @@ -15388,7 +15097,9 @@ subroutine LocateObjFather (ObjHorizontalGrid, ObjHorizontalGridID) ObjHorizontalGrid => ObjHorizontalGrid%Next enddo - if (.not. associated(ObjHorizontalGrid)) stop 'HorizontalGrid - LocateObjFather - ERR01' + if (.not. associated(ObjHorizontalGrid)) then + stop 'HorizontalGrid - LocateObjFather - ERR01' + endif end subroutine LocateObjFather @@ -17161,95 +16872,7 @@ end subroutine LocateCell1DR8 !------------------------------------------------------------------------------ - Subroutine LocateCell_2 (XX, YY, XPos, YPos, & - ILB, IUB, JLB, JUB, ILink, JLink, U, V) - - !Arguments--------------------------------------------------------- - real, dimension(:) , pointer :: XX, YY - real , intent (IN ) :: XPos, YPos - integer , intent (IN ) :: ILB, IUB, JLB, JUB - integer , intent (OUT) :: ILink, JLink - integer, optional :: U, V - - !Local------------------------------------------------------------- - integer :: IMiddle, JMiddle, Dcd1, Dcd2, IUpper, JUpper - - !Begin------------------------------------------------------------- - ILink = ILB - IUpper = IUB - - Dcd1 = 2 - Dcd2 = 2 - - if(Ypos < YY(ILB) .or. Ypos > YY(IUB))then - - ILink = null_int - - elseif (present(V))then - do while (Dcd1 > 1) - IMiddle = int((ILink + IUpper)/2) - if (Ypos > YY(IMiddle - 1)) then - ILink = IMiddle - else - IUpper = IMiddle - endif - Dcd1 = IUpper - ILink - enddo - else - do while (Dcd1 > 1) - IMiddle = int((ILink + IUpper)/2) - if (Ypos > YY(IMiddle)) then - ILink = IMiddle - else - IUpper = IMiddle - endif - Dcd1 = IUpper - ILink - enddo - - end if - - - JLink = JLB - JUpper = JUB - - if(Xpos < XX(JLB) .or. Xpos > XX(JUB))then - - JLink = null_int - - elseif (present(U))then - do while (Dcd2 > 1) - JMiddle = int((JLink + JUpper)/2) - if (Xpos > XX(JMiddle - 1)) then - JLink = JMiddle - else - JUpper = JMiddle - endif - Dcd2 = JUpper - JLink - enddo - else - - do while (Dcd2 > 1) - JMiddle = int((JLink + JUpper)/2) - if (Xpos > XX(JMiddle)) then - JLink = JMiddle - else - JUpper = JMiddle - endif - Dcd2 = JUpper - JLink - enddo - - end if - - if (.not. Dcd1>0 .and. Dcd2>0) then - - call SetError(FATAL_, INTERNAL_, 'LocateCell - HorizontalGrid - ERR01') - - - endif - - - end subroutine LocateCell_2 -!------------------------------------------------------------------------------ + real function Bilinear (YYUpper, YYLower, YPos, & XXUpper, XXLower, XPos, & @@ -17942,7 +17565,7 @@ end module ModuleHorizontalGrid !---------------------------------------------------------------------------------------------------------- !MOHID Water Modelling System. -!Copyright (C) 1985, 1998, 2002, 2005. Instituto Superior Técnico, Technical University of Lisbon. +!Copyright (C) 1985, 1998, 2002, 2005. Instituto Superior TĆ©cnico, Technical University of Lisbon. !---------------------------------------------------------------------------------------------------------- diff --git a/Software/MOHIDBase2/ModuleNETCDF.F90 b/Software/MOHIDBase2/ModuleNETCDF.F90 index 125c4ca88..7b880a3a4 100644 --- a/Software/MOHIDBase2/ModuleNETCDF.F90 +++ b/Software/MOHIDBase2/ModuleNETCDF.F90 @@ -210,7 +210,8 @@ subroutine ConstructNETCDF(NCDFID, FileName, Access, STAT) if (Access == NCDF_CREATE_) then STAT_CALL = nf90_create(path = trim(FileName), & - cmode = NF90_CLOBBER, & +! cmode = NF90_CLOBBER, & + cmode = NF90_HDF5, & ncid = Me%ncid) if(STAT_CALL /= nf90_noerr) stop 'ConstructNETCDF - ModuleNETCDF - ERR01' diff --git a/Software/MOHIDLand/ModuleBasin.F90 b/Software/MOHIDLand/ModuleBasin.F90 index 0dfe94971..6da1dd0b5 100644 --- a/Software/MOHIDLand/ModuleBasin.F90 +++ b/Software/MOHIDLand/ModuleBasin.F90 @@ -509,6 +509,7 @@ Module ModuleBasin type T_Basin integer :: InstanceID = 0 character(len=StringLength) :: ModelName = null_str + integer :: ModelType = MOHIDLAND_ logical :: StopOnBathymetryChange = .true. type (T_Size2D) :: Size, WorkSize type (T_Coupling) :: Coupled @@ -740,6 +741,7 @@ subroutine ConstructBasin(ObjBasinID, ObjTime, ModelName, StopOnBathymetryChange ObjBasinID = Me%InstanceID Me%ModelName = ModelName + Me%ModelType = MOHIDLAND_ !Associates External Instances Me%ObjTime = AssociateInstance (mTIME_, ObjTime) @@ -3154,6 +3156,7 @@ subroutine ConstructCoupledModules( & !Constructs Atmosphere if (Me%Coupled%Atmosphere) then call StartAtmosphere (ModelName = Me%ModelName, & + ModelType = Me%ModelType, & AtmosphereID = Me%ObjAtmosphere, & TimeID = Me%ObjTime, & GridDataID = Me%ObjGridData, & @@ -4157,6 +4160,8 @@ subroutine ModifyBasin(ObjBasinID, NewDT, STAT) character (Len = StringLength) :: OptionsType type (T_BasinProperty), pointer :: Property logical :: IsFinalFile + logical :: VariableDT + !---------------------------------------------------------------------- if (MonitorPerformance) call StartWatch ("ModuleBasin", "ModifyBasin") @@ -4403,7 +4408,14 @@ subroutine ModifyBasin(ObjBasinID, NewDT, STAT) UnLockToWhichModules = 'AllModules' OptionsType = 'ModifyBasin' call ReadUnLockExternalVar (UnLockToWhichModules, OptionsType) - call ComputeNextDT(NewDT) + + call GetVariableDT (Me%ObjTime, VariableDT, STAT = STAT_CALL) + if (STAT_CALL /= SUCCESS_) stop 'ModifyBasin - ModuleBasin - ERR00' + + + if (VariableDT) then + call ComputeNextDT(NewDT) + endif STAT_ = SUCCESS_ else diff --git a/Software/MOHIDLand/ModulePorousMedia.F90 b/Software/MOHIDLand/ModulePorousMedia.F90 index 8b44cfb3d..4b500024d 100644 --- a/Software/MOHIDLand/ModulePorousMedia.F90 +++ b/Software/MOHIDLand/ModulePorousMedia.F90 @@ -2262,7 +2262,7 @@ subroutine ConstructAsciiOutPut Number = ' ' write(Number, fmt='(i4)')Counter open(UNIT = Me%Files%AsciiUnit, & -! FILE = '..\res\iter.soi_'//trim(adjustl(Number))//'.log', & +! FILE = '..'//backslash//'res'//backslash//'iter.soi_'//trim(adjustl(Number))//'.log', & FILE = Me%Files%ASCFile, & STATUS = "REPLACE", & IOSTAT = STAT_CALL) diff --git a/Software/MOHIDLand/ModuleRunOff.F90 b/Software/MOHIDLand/ModuleRunOff.F90 index 5fcecfafa..4b703eb76 100644 --- a/Software/MOHIDLand/ModuleRunOff.F90 +++ b/Software/MOHIDLand/ModuleRunOff.F90 @@ -86,6 +86,7 @@ Module ModuleRunOff private :: AllocateVariables private :: ConstructOverLandCoefficient private :: ConstructStormWaterDrainage + private :: WriteStreetGutterLinksFile private :: ConstructHDF5Output private :: ConstructTimeSeries @@ -334,11 +335,13 @@ Module ModuleRunOff real, dimension(:,:), pointer :: StormWaterCenterFlowY => null() !Output real, dimension(:,:), pointer :: StormWaterCenterModulus => null() !Output real, dimension(:,:), pointer :: BuildingsHeight => null() !Height of building in cell - real, dimension(:,:), pointer :: StormWaterInteraction => null() !Points where interaction with SWMM - !occurs - real, dimension(:,:), pointer :: StormWaterGutterInteraction => null() !Points where gutter interaction with - !SWMM occurs (default is the same as - !StormWaterInteraction) + real, dimension(:,:), pointer :: NumberOfSewerStormWaterNodes => null() !Number of total SWMM nodes + !(sewer + storm water) per grid cell + !that interact with MOHID + real, dimension(:,:), pointer :: NumberOfStormWaterNodes => null() !Number of SWMM storm water only nodes + !per grid cell that interact + !with MOHID (default is the same as + !NumberOfSewerStormWaterNodes) real, dimension(:,:), pointer :: StreetGutterLength => null() !Length of Stret Gutter in a given cell real, dimension(:,:), pointer :: MassError => null() !Contains mass error real, dimension(:,:), pointer :: CenterFlowX => null() @@ -352,15 +355,15 @@ Module ModuleRunOff integer, dimension(:,:), pointer :: DFourSinkPoint => null() !Point which can't drain with in X/Y only integer, dimension(:,:), pointer :: StabilityPoints => null() !Points where models check stability type(T_PropertyID) :: OverLandCoefficientID - logical :: StormWaterModel = .false. !If connected to SWMM - real, dimension(:,:), pointer :: StormWaterModelFlow => null() !Flow from SWMM (inflow + outflow) - real, dimension(:,:), pointer :: StreetGutterFlow => null() !Inflow at street gutters (per target - !junction) - real, dimension(:,:), pointer :: SewerInflow => null() !Integrated inflow at sewer manholes - !(per junction) - !(potential) - real, dimension(:,:), pointer :: StormInteractionFlow => null() !Interaction Flow - !(at gutters + sewer manholes) (real) + logical :: StormWaterModel = .false. !If connected to SWMM + real, dimension(:,:), pointer :: StormWaterEffectiveFlow => null() !Flow from SWMM (inflow + outflow) + real, dimension(:,:), pointer :: StreetGutterPotentialFlow=> null() !Potential flow to street gutters + !in grid cells with street gutters + real, dimension(:,:), pointer :: StormWaterPotentialFlow => null() !Sum of all potential flows + !from street gutters draining to + !grid cells with storm water nodes + real, dimension(:,:), pointer :: StreetGutterEffectiveFlow=> null() !Effective flow to street gutters + !in grid cells with street gutters integer, dimension(:,:), pointer :: StreetGutterTargetI => null() !Sewer interaction point... integer, dimension(:,:), pointer :: StreetGutterTargetJ => null() !...where street gutter drains to real :: MinSlope = null_real @@ -653,8 +656,8 @@ subroutine ReadDataFile type(T_PropertyID) :: OverLandCoefficientDeltaID type(T_PropertyID) :: StormWaterDrainageID type(T_PropertyID) :: BuildingsHeightID - type(T_PropertyID) :: StormWaterInteractionID - type(T_PropertyID) :: StormWaterGutterInteractionID + type(T_PropertyID) :: NumberOfSewerStormWaterNodesID + type(T_PropertyID) :: NumberOfStormWaterNodesID type(T_PropertyID) :: StreetGutterLengthID integer :: ObjEnterDataGutterInteraction = 0 character(len=StringLength) :: InitializationMethod, Filename @@ -1599,9 +1602,9 @@ subroutine ReadDataFile !Looks for StormWater Interaction Point if (Me%StormWaterModel) then - allocate(Me%StormWaterInteraction(Me%Size%ILB:Me%Size%IUB, Me%Size%JLB:Me%Size%JUB)) + allocate(Me%NumberOfSewerStormWaterNodes(Me%Size%ILB:Me%Size%IUB, Me%Size%JLB:Me%Size%JUB)) allocate(Me%StreetGutterLength (Me%Size%ILB:Me%Size%IUB, Me%Size%JLB:Me%Size%JUB)) - allocate(Me%StormWaterGutterInteraction (Me%Size%ILB:Me%Size%IUB, Me%Size%JLB:Me%Size%JUB)) + allocate(Me%NumberOfStormWaterNodes (Me%Size%ILB:Me%Size%IUB, Me%Size%JLB:Me%Size%JUB)) call RewindBuffer (Me%ObjEnterData, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleRunOff - ERR680' @@ -1611,25 +1614,25 @@ subroutine ReadDataFile !or MOHID Land street gutter inflow to SWMM - directed to nearest manhole) !The cell value is number of manholes in each cell !If this field is zero everywhere, there wil be no SWMM-MOHIDLand interaction - call ExtractBlockFromBuffer(Me%ObjEnterData, ClientNumber, & + call ExtractBlockFromBuffer(Me%ObjEnterData, ClientNumber, & '', & '', BlockFound, & STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleRunOff - ERR690' if (BlockFound) then - call ConstructFillMatrix ( PropertyID = StormWaterInteractionID, & + call ConstructFillMatrix ( PropertyID = NumberOfSewerStormWaterNodesID, & EnterDataID = Me%ObjEnterData, & - TimeID = Me%ObjTime, & - HorizontalGridID = Me%ObjHorizontalGrid, & - ExtractType = FromBlock, & - PointsToFill2D = Me%ExtVar%BasinPoints, & - Matrix2D = Me%StormWaterInteraction, & - TypeZUV = TypeZ_, & + TimeID = Me%ObjTime, & + HorizontalGridID = Me%ObjHorizontalGrid, & + ExtractType = FromBlock, & + PointsToFill2D = Me%ExtVar%BasinPoints, & + Matrix2D = Me%NumberOfSewerStormWaterNodes, & + TypeZUV = TypeZ_, & STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleRunOff - ERR691' - call KillFillMatrix(StormWaterInteractionID%ObjFillMatrix, STAT = STAT_CALL) + call KillFillMatrix(NumberOfSewerStormWaterNodesID%ObjFillMatrix, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleRunOff - ERR692' else @@ -1654,7 +1657,7 @@ subroutine ReadDataFile if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleRunoff - ERR694.5' !Gets Sewer Points that can interact with street gutter - !By default these are the same points as StormWaterInteraction (all points can recieve street gutter) + !By default these are the same points as NumberOfSewerStormWaterNodes (all points can recieve street gutter) !This exists to individualize SWMM junctions (manholes) that can recieve gutter flow (eg. pluvial junctions) !It is only used to find for each gutter the closer cell that can have gutter inflow (avoid the ones that can't) !If this field is zero everywhere, it cant find SWMM junctions to discharge gutter flow and will return error @@ -1665,14 +1668,14 @@ subroutine ReadDataFile if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleRunOff - ERR694' if (BlockFound) then - call ConstructFillMatrix ( PropertyID = StormWaterGutterInteractionID, & - EnterDataID = Me%ObjEnterData, & - TimeID = Me%ObjTime, & - HorizontalGridID = Me%ObjHorizontalGrid, & - ExtractType = FromBlock, & - PointsToFill2D = Me%ExtVar%BasinPoints, & - Matrix2D = Me%StormWaterGutterInteraction, & - TypeZUV = TypeZ_, & + call ConstructFillMatrix ( PropertyID = NumberOfStormWaterNodesID, & + EnterDataID = Me%ObjEnterData, & + TimeID = Me%ObjTime, & + HorizontalGridID = Me%ObjHorizontalGrid, & + ExtractType = FromBlock, & + PointsToFill2D = Me%ExtVar%BasinPoints, & + Matrix2D = Me%NumberOfStormWaterNodes, & + TypeZUV = TypeZ_, & STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) stop 'ReadDataFi le - ModuleRunOff - ERR695' @@ -1734,10 +1737,10 @@ subroutine ReadDataFile end select endif - call KillFillMatrix(StormWaterGutterInteractionID%ObjFillMatrix, STAT = STAT_CALL) + call KillFillMatrix(NumberOfStormWaterNodesID%ObjFillMatrix, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleRunOff - ERR696' - !StormWaterGutterInteraction points can only e <= StormWaterInteraction points + !NumberOfStormWaterNodes points can only be <= NumberOfSewerStormWaterNodes points call VerifyStreetGutterInteraction else @@ -1750,8 +1753,8 @@ subroutine ReadDataFile stop 'ReadDataFile - ModuleRunOff - ERR0696.5' endif - !If not defined in file it will be the same as StormWaterInteraction - call SetMatrixValue(Me%StormWaterGutterInteraction, Me%Size, Me%StormWaterInteraction) + !If not defined in file it will be the same as NumberOfSewerStormWaterNodes + call SetMatrixValue(Me%NumberOfStormWaterNodes, Me%Size, Me%NumberOfSewerStormWaterNodes) endif call RewindBuffer (Me%ObjEnterData, STAT = STAT_CALL) @@ -1978,10 +1981,10 @@ subroutine VerifyStreetGutterInteraction !there cant be more gutter interaction points than all interaction points !since gutter interaction is only going to be used to drive gutter flow to the cells !that have eligible points (e.g. only discharge gutter in pluvial nodes) - if (Me%StormWaterGutterInteraction(i,j) > Me%StormWaterInteraction(i,j)) then + if (Me%NumberOfStormWaterNodes(i,j) > Me%NumberOfSewerStormWaterNodes(i,j)) then write(*,*) - write(*,*) 'Error: StormWaterGutterInteraction nŗ of points is higher than' - write(*,*) 'all StormWaterInteraction points in cell: ', i, j + write(*,*) 'Error: Number Of Storm Water Nodes is higher than' + write(*,*) 'Number Of Sewer Storm WaterNodes in cell: ', i, j stop 'VerifyStreetGutterInteraction - Module Runoff - ERR01' endif @@ -3267,19 +3270,19 @@ subroutine ConstructStormWaterDrainage !Model link like SMWM if (Me%StormWaterModel) then - allocate(Me%StormWaterModelFlow (Me%Size%ILB:Me%Size%IUB, Me%Size%JLB:Me%Size%JUB)) - allocate(Me%StreetGutterFlow (Me%Size%ILB:Me%Size%IUB, Me%Size%JLB:Me%Size%JUB)) - allocate(Me%SewerInflow (Me%Size%ILB:Me%Size%IUB, Me%Size%JLB:Me%Size%JUB)) - allocate(Me%StreetGutterTargetI (Me%Size%ILB:Me%Size%IUB, Me%Size%JLB:Me%Size%JUB)) - allocate(Me%StreetGutterTargetJ (Me%Size%ILB:Me%Size%IUB, Me%Size%JLB:Me%Size%JUB)) - allocate(Me%StormInteractionFlow (Me%Size%ILB:Me%Size%IUB, Me%Size%JLB:Me%Size%JUB)) - Me%StormWaterModelFlow = 0.0 - Me%StreetGutterFlow = 0.0 - Me%SewerInflow = 0.0 - Me%StormInteractionFlow = 0.0 + allocate(Me%StormWaterEffectiveFlow (Me%Size%ILB:Me%Size%IUB, Me%Size%JLB:Me%Size%JUB)) + allocate(Me%StreetGutterPotentialFlow (Me%Size%ILB:Me%Size%IUB, Me%Size%JLB:Me%Size%JUB)) + allocate(Me%StormWaterPotentialFlow (Me%Size%ILB:Me%Size%IUB, Me%Size%JLB:Me%Size%JUB)) + allocate(Me%StreetGutterTargetI (Me%Size%ILB:Me%Size%IUB, Me%Size%JLB:Me%Size%JUB)) + allocate(Me%StreetGutterTargetJ (Me%Size%ILB:Me%Size%IUB, Me%Size%JLB:Me%Size%JUB)) + allocate(Me%StreetGutterEffectiveFlow (Me%Size%ILB:Me%Size%IUB, Me%Size%JLB:Me%Size%JUB)) + Me%StormWaterEffectiveFlow = 0.0 + Me%StreetGutterPotentialFlow = 0.0 + Me%StormWaterPotentialFlow = 0.0 + Me%StreetGutterEffectiveFlow = 0.0 - Me%StreetGutterTargetI = null_int - Me%StreetGutterTargetJ = null_int + Me%StreetGutterTargetI = null_int + Me%StreetGutterTargetJ = null_int !Algorithm to find the nearest sewer interaction point near the street gutter. !Point must be lower equal current point @@ -3305,7 +3308,7 @@ subroutine ConstructStormWaterDrainage if (Me%ExtVar%BasinPoints(iAux, jAux) == OpenPoint) then if ((IgnoreTopography .or. Me%ExtVar%Topography(iAux, jAux) <= Me%ExtVar%Topography(i, j)) .and. & - Me%StormWaterGutterInteraction(iAux, jAux) > AllmostZero) then + Me%NumberOfStormWaterNodes(iAux, jAux) > AllmostZero) then nearestfound = .true. if (IgnoreTopography .or. Me%ExtVar%Topography(iAux, jAux) <= lowestValue) then lowestValue = Me%ExtVar%Topography(iAux, jAux) @@ -3323,7 +3326,7 @@ subroutine ConstructStormWaterDrainage if (Me%ExtVar%BasinPoints(iAux, jAux) == OpenPoint) then if ((IgnoreTopography .or. Me%ExtVar%Topography(iAux, jAux) <= Me%ExtVar%Topography(i, j)) .and. & - Me%StormWaterGutterInteraction(iAux, jAux) > AllmostZero) then + Me%NumberOfStormWaterNodes(iAux, jAux) > AllmostZero) then nearestfound = .true. if (IgnoreTopography .or. Me%ExtVar%Topography(iAux, jAux) <= lowestValue) then lowestValue = Me%ExtVar%Topography(iAux, jAux) @@ -3341,7 +3344,7 @@ subroutine ConstructStormWaterDrainage if (Me%ExtVar%BasinPoints(iAux, jAux) == OpenPoint) then if ((IgnoreTopography .or. Me%ExtVar%Topography(iAux, jAux) <= Me%ExtVar%Topography(i, j)) .and. & - Me%StormWaterGutterInteraction(iAux, jAux) > AllmostZero) then + Me%NumberOfStormWaterNodes(iAux, jAux) > AllmostZero) then nearestfound = .true. if (IgnoreTopography .or. Me%ExtVar%Topography(iAux, jAux) <= lowestValue) then lowestValue = Me%ExtVar%Topography(iAux, jAux) @@ -3358,7 +3361,7 @@ subroutine ConstructStormWaterDrainage if (Me%ExtVar%BasinPoints(iAux, jAux) == OpenPoint) then if ((IgnoreTopography .or. Me%ExtVar%Topography(iAux, jAux) <= Me%ExtVar%Topography(i, j)) .and. & - Me%StormWaterGutterInteraction(iAux, jAux) > AllmostZero) then + Me%NumberOfStormWaterNodes(iAux, jAux) > AllmostZero) then nearestfound = .true. if (IgnoreTopography .or. Me%ExtVar%Topography(iAux, jAux) <= lowestValue) then lowestValue = Me%ExtVar%Topography(iAux, jAux) @@ -3377,7 +3380,7 @@ subroutine ConstructStormWaterDrainage ! ! if (Me%ExtVar%BasinPoints(iAux, jAux) == OpenPoint) then ! if (Me%ExtVar%Topography(iAux, jAux) <= Me%ExtVar%Topography(i, j) .and. & -! Me%StormWaterInteraction(iAux, jAux) > AllmostZero) then +! Me%NumberOfSewerStormWaterNodes(iAux, jAux) > AllmostZero) then ! nearestfound = .true. ! if (Me%ExtVar%Topography(iAux, jAux) <= lowestValue) then ! lowestValue = Me%ExtVar%Topography(iAux, jAux) @@ -3411,12 +3414,56 @@ subroutine ConstructStormWaterDrainage endif enddo - enddo + enddo + call WriteStreetGutterLinksFile endif end subroutine + + !-------------------------------------------------------------------------- + + subroutine WriteStreetGutterLinksFile + + !Arguments------------------------------------------------------------- + + !Local----------------------------------------------------------------- + integer :: STAT_CALL, UnitNumber, i, j, targetI, targetJ + character(len=PathLength) :: StreetGutterLinksFileName = "StreetGutterLinks.lin" + + !Begin----------------------------------------------------------------- + + call ReadFileName("ROOT_SRT", StreetGutterLinksFileName, STAT = STAT_CALL) + if (STAT_CALL /= SUCCESS_) stop 'WriteStreetGutterLinksFile - ModuleRunOff - ERR01' + StreetGutterLinksFileName = trim(adjustl(StreetGutterLinksFileName))//"StreetGutterLinks.lin" + + call UnitsManager (UnitNumber, OPEN_FILE, STAT = STAT_CALL) + open (unit=UnitNumber, status = 'unknown', file = StreetGutterLinksFileName) + + do j = Me%WorkSize%JLB, Me%WorkSize%JUB + do i = Me%WorkSize%ILB, Me%WorkSize%IUB + + if (Me%StreetGutterLength(i, j) > AllmostZero) then + + !SEWER interaction point + targetI = Me%StreetGutterTargetI(i, j) + targetJ = Me%StreetGutterTargetJ(i, j) + + write(UnitNumber,*)'' + write(UnitNumber,*) Me%ExtVar%XX2D_Z( i, j), Me%ExtVar%YY2D_Z( i, j) + write(UnitNumber,*) Me%ExtVar%XX2D_Z(targetI, targetJ), Me%ExtVar%YY2D_Z(targetI, targetJ) + write(UnitNumber,*)'' + + endif + + enddo + enddo + + call UnitsManager (UnitNumber, CLOSE_FILE, STAT = STAT_CALL) + + + end subroutine WriteStreetGutterLinksFile !-------------------------------------------------------------------------- @@ -3510,10 +3557,10 @@ subroutine ConstructTimeSeries PropertyList(8) = trim(GetPropertyName (VelocityModulus_)) if(Me%StormWaterModel)then - PropertyList(9) = "storm water model flow" - PropertyList(10) = "street gutter flow" - PropertyList(11) = "sewer potential inflow" - PropertyList(12) = "storm water real flow" + PropertyList(9) = "storm water potential flow" + PropertyList(10) = "storm water effective flow" + PropertyList(11) = "street gutter potential flow" + PropertyList(12) = "street gutter effective flow" endif call GetData (TimeSerieLocationFile, & @@ -4867,7 +4914,7 @@ subroutine ModifyRunOff(RunOffID, STAT) !Flow through street gutter if (Me%StormWaterModel) then - call StreetGutterFlow + call ComputeStreetGutterPotentialFlow endif !StormWater Drainage @@ -7067,7 +7114,7 @@ end subroutine StormWaterDrainage !-------------------------------------------------------------------------- - subroutine StreetGutterFlow + subroutine ComputeStreetGutterPotentialFlow !Arguments------------------------------------------------------------- @@ -7121,12 +7168,12 @@ subroutine StreetGutterFlow !Flow Rate into street Gutter - needs to be per gutter interaction points because the cell value !will be passed to all SWMM gutter interaction junctions - Me%StreetGutterFlow(i, j) = Min(flow, Me%myWaterVolume(i, j) / Me%ExtVar%DT) / & - Me%StormWaterGutterInteraction(targetI, targetJ) + Me%StreetGutterPotentialFlow(i, j) = Min(flow, Me%myWaterVolume(i, j) / Me%ExtVar%DT) / & + Me%NumberOfStormWaterNodes(targetI, targetJ) else - Me%StreetGutterFlow(i, j) = 0.0 + Me%StreetGutterPotentialFlow(i, j) = 0.0 endif @@ -7138,8 +7185,8 @@ subroutine StreetGutterFlow !$OMP DO SCHEDULE(DYNAMIC, CHUNK) do j = Me%WorkSize%JLB, Me%WorkSize%JUB do i = Me%WorkSize%ILB, Me%WorkSize%IUB - if (Me%StormWaterInteraction(i, j) > AllmostZero) then - Me%SewerInflow(i, j) = 0.0 + if (Me%NumberOfSewerStormWaterNodes(i, j) > AllmostZero) then + Me%StormWaterPotentialFlow(i, j) = 0.0 endif enddo enddo @@ -7155,13 +7202,14 @@ subroutine StreetGutterFlow targetI = Me%StreetGutterTargetI(i, j) targetJ = Me%StreetGutterTargetJ(i, j) - Me%SewerInflow(targetI, targetJ) = Me%SewerInflow(targetI, targetJ) + Me%StreetGutterFlow(i, j) + Me%StormWaterPotentialFlow(targetI, targetJ) = Me%StormWaterPotentialFlow(targetI, targetJ) + & + Me%StreetGutterPotentialFlow(i, j) endif enddo enddo - end subroutine StreetGutterFlow + end subroutine ComputeStreetGutterPotentialFlow !-------------------------------------------------------------------------- @@ -7187,20 +7235,20 @@ subroutine AddFlowFromStormWaterModel !The algorithm below has the following assumptions !1. MOHID Land calculates the POTENTIAL inflow into the sewer system through the street gutters. values per target gutter - !points (matrix StreetGutterFlow) - !2. The values of the StreetGutterFlow are integrated at the nearest StormWaterInteraction points. values per gutter points - !(matrix SewerInflow) - !3. This matrix (SewerInflow) is provide to SWMM + !points (matrix StreetGutterPotentialFlow) + !2. The values of the StreetGutterPotentialFlow are integrated at the nearest "NumberOfSewerStormWaterNodes" grid cells. values per gutter points + !(matrix StormWaterPotentialFlow) + !3. This matrix (StormWaterPotentialFlow) is provided to SWMM !4. Swmm calculates the EFFECTIVE inflow and returns the efective flow (inflow or outflow) at each interaction point - !(matrix StormWaterModelFlow) + !(matrix StormWaterEffectiveFlow) !5. The algorithm below calculates the efective flow in each cell !5a - if the flow in the gutter target point is negative (inflow into the sewer system) the flow at each gutter will be !affected - ! by the ratio of StormWaterModelFlow/SewerInflow (will be reduced in the same ratio as EFFECTIVE/POTENTIAL inflow) + ! by the ratio of StormWaterEffectiveFlow/StormWaterPotentialFlow (will be reduced in the same ratio as EFFECTIVE/POTENTIAL inflow) !5b - if the flow in the cell is positive (outflow from the sewer system), the flow flows out ("saltam as tampas"). !6. The Water Column is reduced/increased due to the final flow - !Remark: as StormWaterModelFlow is inflow or outflow at each cell the two processes below can be separated and - !2nd evaluation of StormInteractionFlow does not need to be summed to first evaluation + !Remark: as StormWaterEffectiveFlow is inflow or outflow at each cell the two processes below can be separated and + !2nd evaluation of StreetGutterEffectiveFlow does not need to be summed to first evaluation !Algorithm which calculates the real inflow in each point @@ -7210,7 +7258,7 @@ subroutine AddFlowFromStormWaterModel if (Me%ExtVar%BasinPoints(i, j) == BasinPoint) then - Me%StormInteractionFlow(i, j) = 0.0 + Me%StreetGutterEffectiveFlow(i, j) = 0.0 !If the point is a street gutter point !we have to reduce the volume by the total number of associated inlets @@ -7219,21 +7267,23 @@ subroutine AddFlowFromStormWaterModel targetI = Me%StreetGutterTargetI(i, j) targetJ = Me%StreetGutterTargetJ(i, j) - if (Me%StormWaterModelFlow(targetI, targetJ) < 0.0 .and. Me%SewerInflow(targetI, targetJ) > AllmostZero) then + if (Me%StormWaterEffectiveFlow(targetI, targetJ) < 0.0 .and. & + Me%StormWaterPotentialFlow(targetI, targetJ) > AllmostZero) then !Distribute real / potential !sewer inflow and street gutter flow is per gutter junction. !it would need to * per number of gutter junctions to have total flow but because number of gutter junctions !appear both in numerator and denominator is not needed - Me%StormInteractionFlow(i, j) = -1.0 * Me%StreetGutterFlow(i, j) * & - Me%StormWaterModelFlow(targetI, targetJ) / Me%SewerInflow(targetI, targetJ) + Me%StreetGutterEffectiveFlow(i, j) = -1.0 * Me%StreetGutterPotentialFlow(i, j) * & + Me%StormWaterEffectiveFlow(targetI, targetJ) / & + Me%StormWaterPotentialFlow(targetI, targetJ) endif endif !Overflow of the sewer system - if (Me%StormWaterInteraction(i, j) > AllmostZero .and. Me%StormWaterModelFlow(i, j) > 0) then - Me%StormInteractionFlow(i, j) = -1.0 * Me%StormWaterModelFlow(i, j) + if (Me%NumberOfSewerStormWaterNodes(i, j) > AllmostZero) then + Me%StreetGutterEffectiveFlow(i, j) = -1.0 * Me%StormWaterEffectiveFlow(i, j) endif endif @@ -7249,9 +7299,9 @@ subroutine AddFlowFromStormWaterModel if (Me%ExtVar%BasinPoints(i, j) == BasinPoint) then - Me%myWaterColumnOld (i, j) = Me%myWaterColumnOld (i, j) - & - Me%StormInteractionFlow(i, j) * & - Me%ExtVar%DT / & + Me%myWaterColumnOld (i, j) = Me%myWaterColumnOld(i, j) - & + Me%StreetGutterEffectiveFlow(i, j) * & + Me%ExtVar%DT / & Me%ExtVar%GridCellArea(i, j) if (Me%myWaterColumnOld(i, j) < 0.0) then @@ -7261,6 +7311,7 @@ subroutine AddFlowFromStormWaterModel Me%myWaterColumnOld (i, j) = 0.0 endif + endif enddo @@ -9363,36 +9414,37 @@ subroutine RunOffOutput endif if (Me%StormWaterModel) then + + !sum of potential street gutter flow from all street gutters draining to + !a grid cell with a storm water SWMM node + call HDF5WriteData (Me%ObjHDF5, "//Results/storm water potential inflow", & + "storm water potential inflow", "m3/s", & + Array2D = Me%StormWaterPotentialFlow, & + OutputNumber = Me%OutPut%NextOutPut, & + STAT = STAT_CALL) + if (STAT_CALL /= SUCCESS_) stop 'RunOffOutput - ModuleRunOff - ERR160' !result from SWMM (effective inflow or outflow) - call HDF5WriteData (Me%ObjHDF5, "//Results/storm water model flow", & - "storm water model flow", "m3/s", & - Array2D = Me%StormWaterModelFlow, & - OutputNumber = Me%OutPut%NextOutPut, & - STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'RunOffOutput - ModuleRunOff - ERR160' - - !street gutter flow per gutter junction (at gutter location) - call HDF5WriteData (Me%ObjHDF5, "//Results/street gutter flow", & - "street gutter flow", "m3/s", & - Array2D = Me%StreetGutterFlow, & - OutputNumber = Me%OutPut%NextOutPut, & + call HDF5WriteData (Me%ObjHDF5, "//Results/storm water effective flow", & + "storm water effective flow", "m3/s", & + Array2D = Me%StormWaterEffectiveFlow, & + OutputNumber = Me%OutPut%NextOutPut, & STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) stop 'RunOffOutput - ModuleRunOff - ERR170' - !street gutter target flow per gutter junction (potential manhole inflow for SWMM) - call HDF5WriteData (Me%ObjHDF5, "//Results/sewer potential inflow", & - "sewer potential inflow", "m3/s", & - Array2D = Me%SewerInflow, & - OutputNumber = Me%OutPut%NextOutPut, & + !potential street gutter flow per grid cell where there are street gutters + call HDF5WriteData (Me%ObjHDF5, "//Results/street gutter potential flow", & + "street gutter potential flow", "m3/s", & + Array2D = Me%StreetGutterPotentialFlow, & + OutputNumber = Me%OutPut%NextOutPut, & STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'RunOffOutput - ModuleRunOff - ERR180' + if (STAT_CALL /= SUCCESS_) stop 'RunOffOutput - ModuleRunOff - ERR180' !storm interaction effective inflows (at gutter location) and outflows (at manholes) - call HDF5WriteData (Me%ObjHDF5, "//Results/storm water real flow", & - "storm water real flow", "m3/s", & - Array2D = Me%StormInteractionFlow, & - OutputNumber = Me%OutPut%NextOutPut, & + call HDF5WriteData (Me%ObjHDF5, "//Results/street gutter effective flow", & + "street gutter effective flow", "m3/s", & + Array2D = Me%StreetGutterEffectiveFlow, & + OutputNumber = Me%OutPut%NextOutPut, & STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) stop 'RunOffOutput - ModuleRunOff - ERR190' @@ -9451,61 +9503,61 @@ subroutine OutputTimeSeries call WriteTimeSerie(Me%ObjTimeSerie, & Data2D = Me%MyWaterColumn, & STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'OutputTimeSeries - ModuleRunoff - ERR01' + if (STAT_CALL /= SUCCESS_) stop 'OutputTimeSeries - ModuleRunoff - ERR02' call WriteTimeSerie(Me%ObjTimeSerie, & Data2D = Me%CenterFlowX, & STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'OutputTimeSeries - ModuleRunoff - ERR01' + if (STAT_CALL /= SUCCESS_) stop 'OutputTimeSeries - ModuleRunoff - ERR03' call WriteTimeSerie(Me%ObjTimeSerie, & Data2D = Me%CenterFlowY, & STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'OutputTimeSeries - ModuleRunoff - ERR01' + if (STAT_CALL /= SUCCESS_) stop 'OutputTimeSeries - ModuleRunoff - ERR04' call WriteTimeSerie(Me%ObjTimeSerie, & Data2D = Me%FlowModulus, & STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'OutputTimeSeries - ModuleRunoff - ERR01' + if (STAT_CALL /= SUCCESS_) stop 'OutputTimeSeries - ModuleRunoff - ERR05' call WriteTimeSerie(Me%ObjTimeSerie, & Data2D = Me%CenterVelocityX, & STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'OutputTimeSeries - ModuleRunoff - ERR01' + if (STAT_CALL /= SUCCESS_) stop 'OutputTimeSeries - ModuleRunoff - ERR06' call WriteTimeSerie(Me%ObjTimeSerie, & Data2D = Me%CenterVelocityY, & STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'OutputTimeSeries - ModuleRunoff - ERR01' + if (STAT_CALL /= SUCCESS_) stop 'OutputTimeSeries - ModuleRunoff - ERR07' call WriteTimeSerie(Me%ObjTimeSerie, & Data2D = Me%VelocityModulus, & STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'OutputTimeSeries - ModuleRunoff - ERR01' + if (STAT_CALL /= SUCCESS_) stop 'OutputTimeSeries - ModuleRunoff - ERR08' if(Me%StormWaterModel)then call WriteTimeSerie(Me%ObjTimeSerie, & - Data2D = Me%StormWaterModelFlow, & + Data2D = Me%StormWaterPotentialFlow, & STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'OutputTimeSeries - ModuleRunoff - ERR01' + if (STAT_CALL /= SUCCESS_) stop 'OutputTimeSeries - ModuleRunoff - ERR09' + call WriteTimeSerie(Me%ObjTimeSerie, & - Data2D = Me%StreetGutterFlow, & + Data2D = Me%StormWaterEffectiveFlow, & STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'OutputTimeSeries - ModuleRunoff - ERR01' + if (STAT_CALL /= SUCCESS_) stop 'OutputTimeSeries - ModuleRunoff - ERR10' - call WriteTimeSerie(Me%ObjTimeSerie, & - Data2D = Me%SewerInflow, & + Data2D = Me%StreetGutterPotentialFlow, & STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'OutputTimeSeries - ModuleRunoff - ERR01' + if (STAT_CALL /= SUCCESS_) stop 'OutputTimeSeries - ModuleRunoff - ERR11' call WriteTimeSerie(Me%ObjTimeSerie, & - Data2D = Me%StormInteractionFlow, & + Data2D = Me%StreetGutterEffectiveFlow, & STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'OutputTimeSeries - ModuleRunoff - ERR01' + if (STAT_CALL /= SUCCESS_) stop 'OutputTimeSeries - ModuleRunoff - ERR12' endif @@ -10482,7 +10534,7 @@ logical function IsUrbanDrainagePoint(RunOffID, i, j) call Ready(RunOffID, ready_) if ((ready_ .EQ. IDLE_ERR_) .OR. (ready_ .EQ. READ_LOCK_ERR_)) then - if (Me%StormWaterInteraction(i, j) > AllmostZero) then + if (Me%NumberOfSewerStormWaterNodes(i, j) > AllmostZero) then IsUrbanDrainagePoint = .true. else IsUrbanDrainagePoint = .false. @@ -10521,7 +10573,7 @@ logical function GetPondedWaterColumn(RunOffID, nComputePoints, waterColumn) idx = 1 do j = Me%WorkSize%JLB, Me%WorkSize%JUB do i = Me%WorkSize%ILB, Me%WorkSize%IUB - if (Me%StormWaterInteraction(i, j) > AllmostZero) then + if (Me%NumberOfSewerStormWaterNodes(i, j) > AllmostZero) then waterColumn(idx) = Max(Me%MyWaterColumn(i, j) - Me%MinimumWaterColumn, 0.0) idx = idx + 1 endif @@ -10564,10 +10616,10 @@ logical function GetInletInFlow(RunOffID, nComputePoints, inletInflow) do j = Me%WorkSize%JLB, Me%WorkSize%JUB do i = Me%WorkSize%ILB, Me%WorkSize%IUB - if (Me%StormWaterInteraction (i, j) > AllmostZero) then + if (Me%NumberOfSewerStormWaterNodes (i, j) > AllmostZero) then !inlet Flow rate min between - inletInflow(idx) = Me%SewerInflow(i, j) + inletInflow(idx) = Me%StormWaterPotentialFlow(i, j) idx = idx + 1 endif @@ -10608,8 +10660,8 @@ logical function SetStormWaterModelFlow(RunOffID, nComputePoints, overlandToSewe idx = 1 do j = Me%WorkSize%JLB, Me%WorkSize%JUB do i = Me%WorkSize%ILB, Me%WorkSize%IUB - if (Me%StormWaterInteraction(i, j) > AllmostZero) then - Me%StormWaterModelFlow(i, j) = overlandToSewerFlow(idx) + if (Me%NumberOfSewerStormWaterNodes(i, j) > AllmostZero) then + Me%StormWaterEffectiveFlow(i, j) = overlandToSewerFlow(idx) idx = idx + 1 endif enddo diff --git a/Software/MOHIDLand/ModuleRunoffProperties.F90 b/Software/MOHIDLand/ModuleRunoffProperties.F90 index 19a2d5789..651985d3c 100644 --- a/Software/MOHIDLand/ModuleRunoffProperties.F90 +++ b/Software/MOHIDLand/ModuleRunoffProperties.F90 @@ -3533,7 +3533,7 @@ subroutine ConstructAsciiFile Number = ' ' write(Number, fmt='(i4)')Counter open(UNIT = Me%Files%AsciiUnit, & - FILE = '..\res\RP_ADCoefs_'//trim(adjustl(Number))//'.log', & + FILE = '..'//backslash//'res'//backslash//'RP_ADCoefs_'//trim(adjustl(Number))//'.log', & STATUS = "REPLACE", & IOSTAT = STAT_CALL) if (STAT_CALL == SUCCESS_) then @@ -4487,7 +4487,7 @@ subroutine SetBasinConcRP (RunoffPropertiesID, BasinConcentration, & !BasinMas if (STAT_ /= SUCCESS_) stop 'SetBasinConcRP - ModuleRunoffProperties - ERR020' else - write(*,*) 'Looking for Runoff Property in Runoff Property ???', GetPropertyName(PropertyXIDNumber) + write(*,*) 'Looking for Runoff Property in Runoff Property ?', GetPropertyName(PropertyXIDNumber) write(*,*) 'but not found. Link between WQ in modules can not be done.' stop 'SetBasinConcRP - ModuleDrainageNetwork - ERR010' end if @@ -7535,7 +7535,7 @@ end subroutine ModifyPropertyValues ! !!BOUNDARY FLUXES IN RUNOFF (NOT YET DONE) ! ! !!FLUXES IN X AND Y DIRECTION -! if (Me%ComputeOptions%AdvDiff_SpatialMethod==AdvDif_CentralDif_) then ! diferenēas centrais +! if (Me%ComputeOptions%AdvDiff_SpatialMethod==AdvDif_CentralDif_) then ! diferenļæ½as centrais ! ! ! AdvTermA_U = (aux * FluxU(i,j ) / 2.) @@ -10228,4 +10228,4 @@ subroutine ReadUnLockExternalVar end module ModuleRunoffProperties !MOHID Water Modelling System. -!Copyright (C) 1985, 1998, 2002, 2006. MARETEC, Instituto Superior Técnico, Technical University of Lisbon. +!Copyright (C) 1985, 1998, 2002, 2006. MARETEC, Instituto Superior Tļæ½cnico, Technical University of Lisbon. \ No newline at end of file diff --git a/Software/MOHIDWater/GOTMVariables_in.F90 b/Software/MOHIDWater/GOTMVariables_in.F90 index d19207c7f..e0a3fad83 100644 --- a/Software/MOHIDWater/GOTMVariables_in.F90 +++ b/Software/MOHIDWater/GOTMVariables_in.F90 @@ -1,3 +1,5 @@ +!<@cond GOTMvars + !------------------------------------------------------------------------------ ! !This program is free software; you can redistribute it and/or @@ -129,3 +131,5 @@ !---------------------------------------------------------------------------------------------------------- !Copyright (C) 2000 - GOTM code. !---------------------------------------------------------------------------------------------------------- + +!<@endcond \ No newline at end of file diff --git a/Software/MOHIDWater/Main.F90 b/Software/MOHIDWater/Main.F90 index b5f74e660..032160ecd 100644 --- a/Software/MOHIDWater/Main.F90 +++ b/Software/MOHIDWater/Main.F90 @@ -98,7 +98,7 @@ program MohidWater #ifdef _USE_MPI use ModuleHydrodynamic, only : GetHydroNeedsFather, SetHydroFather, & SendHydrodynamicMPI, RecvHydrodynamicMPI, & - UpdateHydroMPI, GetModelHasTwoWay + UpdateHydroMPI use ModuleWaterproperties, only : GetWaterNeedsFather, GetPropListNeedsFather, & SetWaterPropFather, SendWaterPropertiesMPI, & RecvWaterPropertiesMPI, UpdateWaterMPI @@ -113,7 +113,7 @@ program MohidWater SetWaterPropFather, GetWaterOverlap, & SetModelOverlapWater #else OVERLAP - use ModuleHydrodynamic, only : GetHydroNeedsFather, SetHydroFather, GetModelHasTwoWay + use ModuleHydrodynamic, only : GetHydroNeedsFather, SetHydroFather use ModuleWaterproperties, only : GetWaterNeedsFather, GetPropListNeedsFather, & SetWaterPropFather #endif OVERLAP @@ -163,7 +163,6 @@ program MohidWater integer :: OverlapWaterPropertiesID = 0 #endif OVERLAP - logical :: TwoWayOn = .false. integer :: FatherGridID = null_int type (T_MohidWater), pointer :: FatherModel => null() type (T_MohidWater), pointer :: Next => null() @@ -369,13 +368,11 @@ subroutine ConstructMohidWater if (STAT_CALL /= SUCCESS_) stop 'ConstructMohidWater - MohidWater - ERR100' endif -!Joao Sobrinho - call GetModelHasTwoWay(CurrentModel%HydrodynamicID, CurrentModel%TwoWayOn) - !Joao Sobrinho + + call ConstructFatherGridLocation(CurrentModel%HorizontalGridID, & CurrentModel%FatherModel%HorizontalGridID, & Window = CurrentModel%FatherLink%Window, & - TwoWay = CurrentModel%TwoWayOn, & STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) stop 'ConstructMohidWater - MohidWater - ERR110' @@ -610,7 +607,7 @@ subroutine ConstructMohidWaterMPI end if !PCL - write(*,*) "Construct modelo MPI ID =", CurrentModel%MPI_ID + write(*,*) "Construct model MPI ID =", CurrentModel%MPI_ID call ConstructModel(LagInstance, ModelNames, NumberOfModels, & ObjLagrangianGlobal, CurrentModel%ModelID, & @@ -853,14 +850,14 @@ subroutine ConstructMohidWaterMPI call GetHydroNeedsFather (CurrentModel%HydrodynamicID, & CurrentModel%FatherLink%Hydro, & STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'ConstructMohidWater - MohidWater - ERR300' + if (STAT_CALL /= SUCCESS_) stop 'ConstructMohidWaterMPI - MohidWater - ERR300' call GetWaterNeedsFather (CurrentModel%WaterpropertiesID, & CurrentModel%FatherLink%Water, & CurrentModel%FatherLink%nProp, & STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'ConstructMohidWater - MohidWater - ERR310' + if (STAT_CALL /= SUCCESS_) stop 'ConstructMohidWaterMPI - MohidWater - ERR310' if (CurrentModel%FatherLink%Hydro .or. CurrentModel%FatherLink%Water) then CurrentModel%FatherLink%Nesting = .true. @@ -1697,7 +1694,7 @@ character(len=PathLength) function ModelName (ModelPath) LenName = LenName-4 ModelName = ModelName(1:LenName) do i = LenName, 1, -1 - if (ModelName(i:i) =='\' .or. ModelName(i:i) =='/') then + if (ModelName(i:i) ==backslash .or. ModelName(i:i) =='/') then ModelName = ModelName(i+1:LenName) exit endif @@ -2405,6 +2402,6 @@ end program MohidWater !---------------------------------------------------------------------------------------------------------- !MOHID Water Modelling System. -!Copyright (C) 1985, 1998, 2002, 2005. Instituto Superior Técnico, Technical University of Lisbon. +!Copyright (C) 1985, 1998, 2002, 2005. Instituto Superior Tļæ½cnico, Technical University of Lisbon. !---------------------------------------------------------------------------------------------------------- diff --git a/Software/MOHIDWater/ModuleGOTM.F90 b/Software/MOHIDWater/ModuleGOTM.F90 index 848bda632..392694c22 100644 --- a/Software/MOHIDWater/ModuleGOTM.F90 +++ b/Software/MOHIDWater/ModuleGOTM.F90 @@ -71,7 +71,6 @@ module ModuleGOTM ! Original author(s): GOTM code ! ! $Log$ -!\ ! !BUGS ! !EOP diff --git a/Software/MOHIDWater/ModuleGauge.F90 b/Software/MOHIDWater/ModuleGauge.F90 index 34e80b30a..5c89b973d 100644 --- a/Software/MOHIDWater/ModuleGauge.F90 +++ b/Software/MOHIDWater/ModuleGauge.F90 @@ -1645,7 +1645,7 @@ subroutine ReadGaugeData(PresentGauge, FromBlock, ReadHarmonicsOk) STAT = status) if (status /= SUCCESS_) stop 'ReadGaugeData - ModuleGauge - ERR120' - if (flag == 1) PresentGauge%TimeReference = - PresentGauge%TimeReference !rcm + if (flag == 1) PresentGauge%TimeReference = - PresentGauge%TimeReference call GetData(AuxChar , & diff --git a/Software/MOHIDWater/ModuleHydrodynamic.F90 b/Software/MOHIDWater/ModuleHydrodynamic.F90 index 4a2f46353..bc6ab8927 100644 --- a/Software/MOHIDWater/ModuleHydrodynamic.F90 +++ b/Software/MOHIDWater/ModuleHydrodynamic.F90 @@ -67,6 +67,7 @@ !EOI !------------------------------------------------------------------------- + Module ModuleHydrodynamic !------------------------------------------------------------------------- ! IST/MARETEC, Marine Modelling Group, Mohid2000 modelling system @@ -146,7 +147,7 @@ Module ModuleHydrodynamic ReturnsIntersectionCorners, & GetGridOutBorderPolygon, & GetDDecompWorkSize2D, WriteHorizontalGrid_UV, & - GetCellRotation, GetGridCellArea !Joćo Sobrinho + GetCellRotation #ifdef _USE_MPI use ModuleHorizontalGrid, only : ReceiveSendProperitiesMPI, THOMAS_DDecompHorizGrid #endif @@ -396,15 +397,9 @@ Module ModuleHydrodynamic private :: ComputeSystemEnergy private :: WriteEnergyDataFile private :: Hydrodynamic_OutPut - private :: ReadySon !Joćo Sobrinho private :: UpdateFatherModel !Joćo Sobrinho private :: ComputeFeedbackSon2Father !Joćo Sobrinho - private :: GetExternal2WayAuxVariables ! Joćo Sobrinho - private :: UnGetExternal2WayAuxVariables ! Joćo Sobrinho - private :: UpdateMatrixes2Way !Joćo Sobrinho - private :: UpdateMatrixes2Way2D !" Joao Sobrinho - private :: Write_HDF5_Format private :: Write_Surface_HDF5_Format private :: CenterVelocity @@ -462,10 +457,9 @@ Module ModuleHydrodynamic public :: SetHydroFather - public :: GetModelHasTwoWay !Joao Sobrinho private :: ConstructTimeInterpolation private :: TestSubModelOptionsConsistence - private :: Allocate2WayVariables !Joćo Sobrinho + private :: ConstructHydro2Way !Joćo Sobrinho private :: ReadNextOrInitialField private :: AddSubmodelWaterLevel private :: ReadLockFather @@ -883,9 +877,11 @@ Module ModuleHydrodynamic private :: T_Velocity type T_Velocity - type (T_Horizontal) :: Horizontal - type (T_Vertical) :: Vertical - real :: DT = null_real + type (T_Horizontal) :: Horizontal + type (T_Vertical) :: Vertical + real :: DT = null_real + real, dimension (:, :), pointer :: BarotropicUc + real, dimension (:, :), pointer :: BarotropicVc end type T_Velocity private :: T_WaterFluxes @@ -1465,8 +1461,7 @@ Module ModuleHydrodynamic NullWaterLevelGradI = .false., & NullWaterLevelGradJ = .false., & TwoWay = .false., & ! Joćo Sobrinho - KillAuxiliar2Way = .false., & ! Joćo Sobrinho - KillAuxiliar2Way2D = .false. ! Joćo Sobrinho + KillAuxiliar2Way = .false. ! Joćo Sobrinho real, pointer, dimension(:,:) :: InvertBarometerCells => null() integer :: Wind = null_int @@ -1605,7 +1600,7 @@ Module ModuleHydrodynamic logical :: RestartOverwrite = .false. logical :: Faces = .false. - logical :: Real4 = .false. !Joćo Sobrinho + logical :: Real4 = .true. !Joćo Sobrinho real :: WaterLevelUnits = null_real logical :: TimeSerieDischON = .false. @@ -1917,9 +1912,8 @@ Module ModuleHydrodynamic !Auxiliar flux properties real(8), pointer, dimension(:,:,:) :: Aux3DFlux => null() - !Auxiliar 2Way matrixes + !Auxiliar 2Way matrix real, dimension(:,:,:), pointer :: TotSonVolInFather => null() !Joćo Sobrinho - real, dimension(:,:), pointer :: TotSonVolInFather2D => null() !Joao Sobrinho real, dimension(:,:), pointer :: Corners => null() !Joćo Sobrinho real, dimension (:,:,:), pointer :: Aux2Way => null() !Joćo Sobrinho real, dimension(:,:), pointer :: AuxWaterLevel => null() !Joćo Sobrinho @@ -2266,8 +2260,11 @@ Subroutine Construct_Hydrodynamic(DischargesID, AssimilationID) !Construct the Time Serie Obj if (Me%OutPut%TimeSerieON) call Construct_Time_Serie - if (Me%OutPut%TimeSerieON .or. Me%OutPut%hdf5ON .or. Me%OutPut%ProfileON) & + if (Me%OutPut%TimeSerieON .or. Me%OutPut%hdf5ON .or. & + Me%OutPut%ProfileON .or. Me%OutPut%HDF5_Surface_ON.or. & + Me%OutW%OutPutWindowsON) then call ConstructMatrixesOutput + endif if (Me%OutPut%ProfileON) call Construct_Output_Profile @@ -2533,7 +2530,7 @@ End Subroutine InitialHydrodynamicField !End---------------------------------------------------------------- - Subroutine Allocate2WayVariables + Subroutine ConstructHydro2Way !Arguments------------------------------------------------------------- @@ -2558,20 +2555,16 @@ Subroutine Allocate2WayVariables KLBFather = Me%Size%KLB KUBFather = Me%Size%KUB - allocate(Me%TotSonVolInFather(ILBFather:IUBFather, JLBFather:JUBFather, KLBFather:KUBFather)) + allocate(Me%TotSonVolInFather(ILBFather-1:IUBFather+1, JLBFather-1:JUBFather+1, KLBFather-1:KUBFather+1)) Me%TotSonVolInFather(:,:,:) = 0.0 - Me%ComputeOptions%KillAuxiliar2Way2D = .true. - - allocate(Me%TotSonVolInFather2D(ILBFather:IUBFather, JLBFather:JUBFather)) - Me%TotSonVolInFather2D(:,:) = 0.0 - allocate(Me%Aux2Way(ILBFather:IUBFather, JLBFather:JUBFather, KLBFather:KUBFather)) + allocate(Me%Aux2Way(ILBFather-1:IUBFather+1, JLBFather-1:JUBFather+1, KLBFather-1:KUBFather+1)) Me%Aux2Way(:,:,:) = 0.0 - allocate(Me%AuxWaterLevel(ILBFather:IUBFather, JLBFather:JUBFather)) + allocate(Me%AuxWaterLevel(ILBFather-1:IUBFather+1, JLBFather-1:JUBFather+1)) Me%AuxWaterLevel(:,:) = 0.0 - allocate(Me%Corners(0:5, KLBFather:KUBFather)) + allocate(Me%Corners(0:5, KLBFather-1:KUBFather+1)) Me%Corners(:,:) = 0.0 Me%ComputeOptions%KillAuxiliar2Way = .true. @@ -2579,7 +2572,7 @@ Subroutine Allocate2WayVariables call Ready (AuxInstanceID, ready_) ! change back to son pointers endif - end Subroutine Allocate2WayVariables + end Subroutine ConstructHydro2Way !---------------------------------------------------------------------------- @@ -2644,6 +2637,7 @@ subroutine Generic4thDimension if (STAT_CALL /= SUCCESS_) & stop 'Generic4thDimension - ModuleHydrodynamic - ERR60' + #endif else @@ -3880,6 +3874,16 @@ subroutine ConstructTsunami stop 'ConstructTsunami - ModuleHydrodynamic - ERR40' endif + ! AMPLIFICATION OF THE TSUNAMI + call GetData(Me%Tsunami%Fault%Amplification, & + Me%ObjEnterData, iflag, & + Keyword = 'FAULT_AMPLIFICATION', & + SearchType = FromFile, & + ClientModule = 'ModuleHydrodynamic', & + default = 1., & + STAT = STAT_CALL) + if (STAT_CALL /= SUCCESS_) stop 'ConstructTsunami - ModuleHydrodynamic - ERR245' + i3: if (Me%Tsunami%Fault%InputMethod == FaultFile_ ) then ! Fault filemane of the input grid data file @@ -4022,16 +4026,6 @@ subroutine ConstructTsunami stop 'ConstructTsunami - ModuleHydrodynamic - ERR240' endif - ! AMPLIFICATION OF THE TSUNAMI - call GetData(Me%Tsunami%Fault%Amplification, & - Me%ObjEnterData, iflag, & - Keyword = 'FAULT_AMPLIFICATION', & - SearchType = FromFile, & - ClientModule = 'ModuleHydrodynamic', & - default = 1., & - STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'ConstructTsunami - ModuleHydrodynamic - ERR245' - endif i3 endif i1 @@ -4477,7 +4471,7 @@ Subroutine Construct_Numerical_Options Me%ObjEnterData, iflag, & SearchType = FromFile, & keyword = 'READ_CONTINUOUS_FORMAT', & - Default = DefaultFormat, & + Default = HDF5_, & ClientModule ='ModuleHydrodynamic', & STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & @@ -4501,7 +4495,7 @@ Subroutine Construct_Numerical_Options Me%ObjEnterData, iflag, & SearchType = FromFile, & keyword = 'WRITE_CONTINUOUS_FORMAT', & - Default = DefaultFormat, & + Default = HDF5_, & ClientModule ='ModuleHydrodynamic', & STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & @@ -4526,7 +4520,7 @@ Subroutine Construct_Numerical_Options Me%ObjEnterData, iflag, & SearchType = FromFile, & keyword = 'CONTINUOUS_FORMAT', & - Default = DefaultFormat, & + Default = HDF5_, & ClientModule ='ModuleHydrodynamic', & STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & @@ -4544,7 +4538,7 @@ Subroutine Construct_Numerical_Options if (Me%ComputeOptions%WriteContinuousFormat /= Binary_ .and. & Me%ComputeOptions%WriteContinuousFormat /= HDF5_) then - stop 'Construct_Numerical_Options - Hydrodynamic - ERR28.' + stop 'Construct_Numerical_Options - Hydrodynamic - ERR28.'!Joćo Sobrinho endif @@ -6006,7 +6000,7 @@ Subroutine Construct_Numerical_Options if (STAT_CALL /= SUCCESS_) & call SetError(FATAL_, INTERNAL_, 'Construct_Numerical_Options - Hydrodynamic - ERR501') - + ! !Keyword : INVERTED_BAROMETER_COEF ! @@ -6845,7 +6839,20 @@ Subroutine Construct_Numerical_Options call SetError(FATAL_, INTERNAL_, 'Construct_Numerical_Options - Hydrodynamic - ERR730') endif + ! + !Keyword : SUBMODEL + ! + ! ! Check if the user wants to run this model as a submodel + ! + ! + ! + !Type : logical + !Default : .false. + !File keyword : IN_DAD3D + !Search Type : From File + ! + call GetData(Me%SubModel%ON, & Me%ObjEnterData, iflag, & keyword = 'SUBMODEL', & @@ -6857,8 +6864,20 @@ Subroutine Construct_Numerical_Options if (STAT_CALL /= SUCCESS_) & call SetError(FATAL_, INTERNAL_, 'Construct_Numerical_Options - Hydrodynamic - ERR740') - + ! + !Keyword : SUBMODEL_FATHER_HOT_START + ! + ! ! Check if the user wants to the submodel with a father hot start + ! + ! + ! + !Type : logical + !Default : .false. + !File keyword : IN_DAD3D + !Search Type : From File + ! + call GetData(Me%SubModel%FatherHotStart, & Me%ObjEnterData, iflag, & keyword = 'SUBMODEL_FATHER_HOT_START', & @@ -6870,7 +6889,22 @@ Subroutine Construct_Numerical_Options if (STAT_CALL /= SUCCESS_) & call SetError(FATAL_, INTERNAL_, 'Construct_Numerical_Options - Hydrodynamic - ERR745') + + + ! + !Keyword : MISSING_NULL + ! + ! ! Check if the user wants to replace the missing values by zero + ! + ! + ! + !Type : logical + !Default : .false. + !File keyword : IN_DAD3D + !Search Type : From File + ! + call GetData(Me%SubModel%MissingNull, & Me%ObjEnterData, iflag, & keyword = 'MISSING_NULL', & @@ -6882,7 +6916,21 @@ Subroutine Construct_Numerical_Options if (STAT_CALL /= SUCCESS_) & call SetError(FATAL_, INTERNAL_, 'Construct_Numerical_Options - Hydrodynamic - ERR750') + + ! + !Keyword : SUBMODEL_EXTRAPOLATE + ! + ! ! Check if the user wants to extrapolate the father velocities and water levels + ! + ! + ! + !Type : logical + !Default : .false. + !File keyword : IN_DAD3D + !Search Type : From File + ! + call GetData(Me%SubModel%Extrapolate, & Me%ObjEnterData, iflag, & keyword = 'SUBMODEL_EXTRAPOLATE', & @@ -6892,11 +6940,25 @@ Subroutine Construct_Numerical_Options STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - call SetError(FATAL_, INTERNAL_, 'Construct_Numerical_Options - Hydrodynamic - ERR751') + call SetError(FATAL_, INTERNAL_, 'Construct_Numerical_Options - Hydrodynamic - ERR750') + + ! + !Keyword : DEADZONE + ! + ! ! Check if the user wants to define a dead zone where the submodel do not ! look for information in the father model + ! + ! + ! + !Type : logical + !Default : .false. + !File keyword : IN_DAD3D + !Search Type : From File + ! + call GetData(Me%SubModel%DeadZone, & Me%ObjEnterData, iflag, & keyword = 'DEADZONE', & @@ -6908,7 +6970,20 @@ Subroutine Construct_Numerical_Options if (STAT_CALL /= SUCCESS_) & call SetError(FATAL_, INTERNAL_, 'Construct_Numerical_Options - Hydrodynamic - ERR760') + ! + !Keyword : DEADZONE_FILE + ! + ! ! file name where the dead zone is defined was polygon + ! + ! + ! + !Type : logical + !Default : .false. + !File keyword : IN_DAD3D + !Search Type : From File + ! + call GetData(Me%SubModel%DeadZoneFile, & Me%ObjEnterData, iflag, & keyword = 'DEADZONE_FILE', & @@ -7383,8 +7458,7 @@ Subroutine Construct_Numerical_Options !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! - !Keyword : - + !Keyword : OBSTACLE ! ! !Checks if the user want to parameteriza the influence of an @@ -8648,8 +8722,8 @@ Subroutine ConstructBlumbergKantha if (ii < ILBWork .or. ii > IUBWork) & call SetError(FATAL_, INTERNAL_, "ConstructBlumbergKantha - Hydrodynamic - ERR100") - endif - + endif + if (Me%DDecomp%MasterOrSlave) then if (j>= Me%DDecomp%HaloMap%JLB .and. j<= Me%DDecomp%HaloMap%JUB+1) then jj = j + 1 - Me%DDecomp%HaloMap%JLB @@ -8660,7 +8734,7 @@ Subroutine ConstructBlumbergKantha jj = j if (jj < JLBWork .or. jj > JUBWork) & call SetError(FATAL_, INTERNAL_, "ConstructBlumbergKantha - Hydrodynamic - ERR110") - endif + endif Me%ComputeOptions%Tlag(ii, jj) = AuxVector(3) @@ -8755,6 +8829,9 @@ Subroutine AllocateVariables allocate (Me%Velocity%Vertical%Across (ILB:IUB, JLB:JUB, KLB:KUB)) + allocate (Me%Velocity%BarotropicUc (ILB:IUB, JLB:JUB )) + allocate (Me%Velocity%BarotropicVc (ILB:IUB, JLB:JUB )) + ! guillaume if (Me%ComputeOptions%AltimetryAssimilation%Yes .or. & Me%ComputeOptions%Geost_Initialization) then @@ -8785,12 +8862,17 @@ Subroutine AllocateVariables Me%WaterLevel%Mini(:,:) = -FillValueReal endif - Me%Velocity%Horizontal%U%New(:,:,:) = FillValueReal - Me%Velocity%Horizontal%U%Old(:,:,:) = FillValueReal - Me%Velocity%Horizontal%V%New(:,:,:) = FillValueReal - Me%Velocity%Horizontal%V%Old(:,:,:) = FillValueReal - Me%Velocity%Vertical%Across(:,:,:) = FillValueReal - Me%Velocity%Vertical%Cartesian(:,:,:) = FillValueReal + Me%Velocity%Horizontal%U%New (:,:,:) = FillValueReal + Me%Velocity%Horizontal%U%Old (:,:,:) = FillValueReal + Me%Velocity%Horizontal%V%New (:,:,:) = FillValueReal + Me%Velocity%Horizontal%V%Old (:,:,:) = FillValueReal + Me%Velocity%Vertical%Across (:,:,:) = FillValueReal + Me%Velocity%Vertical%Cartesian(:,:,:) = FillValueReal + + Me%Velocity%BarotropicUc (:,: ) = FillValueReal + Me%Velocity%BarotropicVc (:,: ) = FillValueReal + + !Auxiliar horizontal velocity pointers nullify (Me%Velocity%Horizontal%UV%New) nullify (Me%Velocity%Horizontal%UV%Old) @@ -10079,6 +10161,7 @@ subroutine Construct_OutPutTime ! Local ------------------------------------------------------------------------------ integer :: STAT_CALL integer :: iflag, iW + integer :: ILB, IUB, JLB, JUB, KLB, KUB !Begin---------------------------------------------------------------------------- @@ -10197,7 +10280,45 @@ subroutine Construct_OutPutTime allocate(Me%OutW%ObjHDF5 (Me%OutW%WindowsNumber)) allocate(Me%OutW%OriginalCorners(Me%OutW%WindowsNumber)) + + KLB = Me%WorkSize%KLB + KUB = Me%WorkSize%KUB + do iW = 1, Me%OutW%WindowsNumber + + if (Me%DDecomp%MasterOrSlave) then + + ILB = Me%DDecomp%Global%ILB + IUB = Me%DDecomp%Global%IUB + JLB = Me%DDecomp%Global%JLB + JUB = Me%DDecomp%Global%JUB + + else + + ILB = Me%WorkSize%ILB + IUB = Me%WorkSize%IUB + JLB = Me%WorkSize%JLB + JUB = Me%WorkSize%JUB + + endif + + if (Me%OutW%OutPutWindows(iW)%KLB < KLB .or. & + Me%OutW%OutPutWindows(iW)%KUB > KUB) then + + write(*,*) 'cell layers out of the model domain for the output window number',iW + stop 'Construct_OutPutTime - Hydrodynamic - ERR73' + + endif + + if (Me%OutW%OutPutWindows(iW)%ILB < ILB .or. & + Me%OutW%OutPutWindows(iW)%IUB > IUB .or. & + Me%OutW%OutPutWindows(iW)%JLB < JLB .or. & + Me%OutW%OutPutWindows(iW)%JUB > JUB) then + + write(*,*) 'cell corners out of the model domain for the output window number',iW + stop 'Construct_OutPutTime - Hydrodynamic - ERR75' + + endif Me%OutW%OutPutWindows%NextOutPut = 1 @@ -10261,6 +10382,11 @@ subroutine Construct_OutPutTime if (STAT_CALL /= SUCCESS_) & call SetError(FATAL_, KEYWORD_, "Construct_OutPutTime - Hydrodynamic - ERR90") + !Override to allow the output of fields associated with the option WaterLevelMaxMin + if (Me%ComputeOptions%WaterLevelMaxMin) then + Me%OutPut%Simple = .false. + endif + !Joćo Sobrinho call GetData(Me%Output%Real4, & Me%ObjEnterData, & @@ -11145,6 +11271,7 @@ subroutine Open_HDF5_OutPut_File(iW) else + Me%OutW%OutPutWindows(iW)%ON = .false. OutputOk = .false. endif @@ -11194,7 +11321,7 @@ subroutine Open_HDF5_OutPut_File(iW) !Gets File Access Code call GetHDF5FileAccess (HDF5_CREATE = HDF5_CREATE) - + ObjHDF5 = 0 !Opens HDF File @@ -13550,15 +13677,13 @@ end subroutine GetResidualHorizontalVelocity !-------------------------------------------------------------------------- !-------------------------------------------------------------------------- - subroutine Get2WayAuxVariables(HydrodynamicID, SonVolumeInFatherCell, SonVolumeInFatherCell2D, & - AuxMatrix, Corners, STAT) + subroutine Get2WayAuxVariables(HydrodynamicID, SonVolumeInFatherCell, AuxMatrix, Corners, STAT) !Arguments------------------------------------------------------------- integer, intent(IN ) :: HydrodynamicID - real, dimension(:,:,:), pointer, optional :: SonVolumeInFatherCell - real, dimension(:,:), pointer, optional :: SonVolumeInFatherCell2D + real, dimension(:,:,:), pointer :: SonVolumeInFatherCell real, dimension(:,:,:), pointer :: AuxMatrix - real, dimension(:,:), pointer :: Corners + real, dimension(:,:), pointer :: Corners integer, optional, intent(OUT) :: STAT !External ------------------------------------------------------------- @@ -13576,15 +13701,8 @@ subroutine Get2WayAuxVariables(HydrodynamicID, SonVolumeInFatherCell, SonVolumeI cd1 : if ((ready_ .EQ. IDLE_ERR_ ) .OR. & (ready_ .EQ. READ_LOCK_ERR_)) then - if (present(SonVolumeInFatherCell))then - call Read_Lock(mHydrodynamic_, Me%InstanceID) - SonVolumeInFatherCell => Me%TotSonVolInFather - endif - if (present(SonVolumeInFatherCell2D))then - call Read_Lock(mHydrodynamic_, Me%InstanceID) - SonVolumeInFatherCell2D => Me%TotSonVolInFather2D - endif - + call Read_Lock(mHydrodynamic_, Me%InstanceID) + SonVolumeInFatherCell => Me%TotSonVolInFather call Read_Lock(mHydrodynamic_, Me%InstanceID) call SetMatrixValue( Me%Aux2Way, Me%WorkSize, 0.0) AuxMatrix => Me%Aux2Way @@ -15273,8 +15391,8 @@ subroutine Modify_Hydrodynamic(HydrodynamicID, & !External-------------------------------------------------------------- - integer :: ready_, readyFather_ - type (T_Hydrodynamic), pointer :: ObjHydrodynamicFather + integer :: ready_ !, readyFather_ + !type (T_Hydrodynamic), pointer :: ObjHydrodynamicFather !Local----------------------------------------------------------------- integer :: STAT_, STAT_CALL, AuxHydrodynamicID !Auxiliar local variable Joćo Sobrinho @@ -15349,6 +15467,8 @@ subroutine Modify_Hydrodynamic(HydrodynamicID, & if (Me%ComputeOptions%Energy) & call ComputeSystemEnergy + !Joćo Sobrinho 2017 - included the call of the routine to update the father model by assimilation + ! of the son domain - Fazer nova routina if (.not. associated(Me%Next))then if (Me%ComputeOptions%TwoWay) then @@ -15791,11 +15911,11 @@ subroutine SetHydroFather (HydrodynamicID, HydrodynamicFatherID, InitialField, S if(InitialField) then - Me%FatherInstanceID = HydrodynamicFatherID - + Me%FatherInstanceID = HydrodynamicFatherID ! Joćo Sobrinho + call TestSubModelOptionsConsistence (ObjHydrodynamicFather%ComputeOptions%Continuous) call GetComputeTimeStep (ObjHydrodynamicFather%ObjTime, DT_Father) - call Allocate2WayVariables + call ConstructHydro2Way !Ang: new implementation Me%SubModel%FatherKLB = ObjHydrodynamicFather%WorkSize%KLB @@ -15808,6 +15928,9 @@ subroutine SetHydroFather (HydrodynamicID, HydrodynamicFatherID, InitialField, S call SetMatrixValue(Me%SubModel%DUZ_Old, Me%Size, Me%SubModel%DUZ_New) call SetMatrixValue(Me%SubModel%DVZ_Old, Me%Size, Me%SubModel%DVZ_New) + !Me%SubModel%DUZ_Old(:,:,:) = Me%SubModel%DUZ_New(:,:,:) + !Me%SubModel%DVZ_Old(:,:,:) = Me%SubModel%DVZ_New(:,:,:) + if (ObjHydrodynamicFather%LastIteration > Me%SubModel%NextTime & .or. InitialField) then @@ -15893,23 +16016,7 @@ subroutine SetHydroFather (HydrodynamicID, HydrodynamicFatherID, InitialField, S end subroutine SetHydroFather !-------------------------------------------------------------------------- - !Joao Sobrinho - subroutine GetModelHasTwoWay(HydrodynamicID, TwoWay) - - !Arguments------------------------------------------------------------- - logical, intent(OUT) :: TwoWay - integer :: HydrodynamicID - !Local----------------------------------------------------------------- - integer :: ready_ - !----------------------------------------------------------------------- - call Ready (HydrodynamicID, ready_) - - TwoWay = Me%ComputeOptions%TwoWay - - end subroutine GetModelHasTwoWay - - !----------------------------------------------------------------------------- subroutine TestSubModelOptionsConsistence(FatherContinuous) !Arguments------------------------------------------------------------- @@ -21181,6 +21288,18 @@ subroutine ReadNextOrInitialField (UFather, VFather, DUZFather, DVZFather, if (status /= SUCCESS_) & call SetError(FATAL_, INTERNAL_, "ReadNextOrInitialField; Hydrodynamic. ERR10") + if (Me%SubModel%Extrapolate) then + + + call ExtraPol3DNearestCell_8(ILBson, IUBson, JLBson, JUBson + 1, & + KLBson, KUBson, Compute3DUSon, Me%SubModel%qX) + + + call ExtraPol3DNearestCell_8(ILBson, IUBson + 1 , JLBson, JUBson, & + KLBson, KUBson, Compute3DVSon, Me%SubModel%qY) + + endif + endif cd3 call InterpolRegularGrid (Me%ObjHorizontalGrid, & @@ -21220,13 +21339,8 @@ subroutine ReadNextOrInitialField (UFather, VFather, DUZFather, DVZFather, call SetError(FATAL_, INTERNAL_, "ReadNextOrInitialField; Hydrodynamic. ERR14") if (Me%SubModel%Extrapolate) then - - call ExtraPol3DNearestCell_8(ILBson, IUBson, JLBson, JUBson + 1, & - KLBson, KUBson, Compute3DUSon, Me%SubModel%qX) - - call ExtraPol3DNearestCell_8(ILBson, IUBson + 1 , JLBson, JUBson, & - KLBson, KUBson, Compute3DVSon, Me%SubModel%qY) - + + call ExtraPol3DNearestCell(ILBson, IUBson, JLBson, JUBson + 1, & KLBson, KUBson, Compute3DUSon, Me%SubModel%U_Next) @@ -21288,10 +21402,9 @@ subroutine AddSubmodelWaterLevel !Arguments------------------------------------------------------------- Teste WaterLevelIncrease integer :: i, j, STAT_CALL - call GetWaterPoints2D(Me%ObjHorizontalMap, & - Me%External_Var%WaterPoints2D, STAT = STAT_CALL) + call GetWaterPoints2D(Me%ObjHorizontalMap, Me%External_Var%WaterPoints2D, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'AddSubmodelWaterLevel - ModuleHydrodynamic - ERR01' + stop 'AddSubmodelWaterLevel - ModuleHydrodynamic - ERR01' !Paralelizar! Joćo Sobrinho do j = Me%WorkSize%JLB, Me%WorkSize%JUB do i = Me%WorkSize%ILB, Me%WorkSize%IUB @@ -21301,10 +21414,9 @@ subroutine AddSubmodelWaterLevel enddo enddo - call UnGetHorizontalMap(Me%ObjHorizontalMap, & - Me%External_Var%WaterPoints2D, STAT = STAT_CALL) + call UnGetHorizontalMap(Me%ObjHorizontalMap, Me%External_Var%WaterPoints2D, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'AddSubmodelWaterLevel - ModuleHydrodynamic - ERR02' + stop 'AddSubmodelWaterLevel - ModuleHydrodynamic - ERR02' end subroutine AddSubmodelWaterLevel @@ -24447,7 +24559,7 @@ subroutine New_Geometry !Arguments------------------------------------------------------------ !Local---------------------------------------------------------------- - integer, dimension(:,:,:), pointer :: WaterPoints3D, OpenPoints3D + integer, dimension(:,:,:), pointer :: WaterPoints3D real, dimension(:,: ), pointer :: SurfaceElevation real, dimension(:,:,:), pointer :: Velocity_Z, DecayTime real :: DT_WaterLevel @@ -24458,8 +24570,6 @@ subroutine New_Geometry !Begin---------------------------------------------------------------- WaterPoints3D => Me%External_Var%WaterPoints3D - - OpenPoints3D => Me%External_Var%OpenPoints3D !Joao Sobrinho SurfaceElevation => Me%WaterLevel%New @@ -24484,6 +24594,12 @@ subroutine New_Geometry if (ColdPeriod > (Me%EndTime - Me%BeginTime)) & stop 'Subroutine New_Geometry - ModuleHydrodynamic. ERR20' + + if (ColdPeriod > 0. .and. Me%ComputeOptions%Continuous) then + write(*,*) 'ColdRelaxPeriod is ON in a HOT START ' + write(*,*) 'Remove from Assimilation_x.dat the keyword COLD_RELAX_PERIOD' + stop 'Subroutine New_Geometry - ModuleHydrodynamic. ERR30' + endif cd4: if (ColdPeriod <= DT_RunPeriod) then CoefCold = 1 @@ -24538,23 +24654,22 @@ subroutine New_Geometry if (Me%Relaxation%Geometry) then !Compute new volume - call ComputeVerticalGeometry(Me%ObjGeometry, WaterPoints3D, & - SurfaceElevation, Me%CurrentTime, & - Velocity_Z, DT_WaterLevel, & - DecayTime = DecayTime, OpenPoints3D = OpenPoints3D, & - STAT = STAT_CALL) + call ComputeVerticalGeometry(Me%ObjGeometry, WaterPoints3D, & + SurfaceElevation, Me%CurrentTime, & + Velocity_Z, DT_WaterLevel, & + DecayTime = DecayTime, STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) & + if (STAT_CALL /= SUCCESS_) & stop 'Subroutine New_Geometry - ModuleHydrodynamic. ERR30' else - - call computeverticalgeometry(me%objgeometry, waterpoints3d, & - surfaceelevation, me%currenttime, & - velocity_z, dt_waterlevel, & - OpenPoints3D = OpenPoints3D, stat = stat_call) + + call ComputeVerticalGeometry(Me%ObjGeometry, WaterPoints3D, & + SurfaceElevation, Me%CurrentTime, & + Velocity_Z, DT_WaterLevel, & + STAT = STAT_CALL) - if (stat_call /= success_) & - stop 'subroutine new_geometry - modulehydrodynamic. err40' + if (STAT_CALL /= SUCCESS_) & + stop 'Subroutine New_Geometry - ModuleHydrodynamic. ERR40' endif @@ -25736,6 +25851,8 @@ Subroutine Compute_Velocity(PressureBackwardInTime) !PCL if (Me%Relaxation%Velocity) call VelocityRelaxation + + call ComputeBarotropicVelocity STAT_CALL = SUCCESS_ @@ -25762,6 +25879,113 @@ Subroutine Compute_Velocity(PressureBackwardInTime) end Subroutine Compute_Velocity + !------------------------------------------------------------------------------ + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! ! + ! This subroutine computes the barotropic velocity for the Z points (cell center) ! + ! ! + ! Input : Flow, Geometry ! + ! OutPut: BarotropicUc, BarotropicVc ! + ! Author: Paulo Leitćo (02/2018) ! + ! ! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + subroutine ComputeBarotropicVelocity + + !Arguments------------------------------------------------------------- + + + !Local----------------------------------------------------------------- + real, dimension(:, :, :), pointer :: DWZ + real, dimension(:, :, :), pointer :: Velocity_U, Velocity_V + real, dimension(:, : ), pointer :: WaterColumn + real, dimension(:, : ), pointer :: Vel2D_U, Vel2D_V + integer, dimension(:, :, :), pointer :: OpenPoints3D + integer, dimension(:, : ), pointer :: KFloor_Z + integer :: ILB, IUB, i + integer :: JLB, JUB, j + integer :: Kbottom, KUB, k + integer :: CHUNK + + !Begin----------------------------------------------------------------- + ILB = Me%WorkSize%ILB + IUB = Me%WorkSize%IUB + JLB = Me%WorkSize%JLB + JUB = Me%WorkSize%JUB + KUB = Me%WorkSize%KUB + + Velocity_U => Me%Velocity%Horizontal%U%New + Velocity_V => Me%Velocity%Horizontal%V%New + + Vel2D_U => Me%Velocity%BarotropicUc + Vel2D_V => Me%Velocity%BarotropicVc + + DWZ => Me%External_Var%DWZ + OpenPoints3D => Me%External_Var%OpenPoints3D + WaterColumn => Me%External_Var%WaterColumn + KFloor_Z => Me%External_Var%KFloor_Z + + CHUNK = CHUNK_J(JLB, JUB) + + if (MonitorPerformance) then + call StartWatch ("ModuleHydrodynamic", "ComputeBarotropicVelocity") + endif + + !$OMP PARALLEL PRIVATE(i,j,k,kbottom) + + !$OMP DO SCHEDULE(DYNAMIC,CHUNK) +doi: do j=JLB, JUB +doj: do i=ILB, IUB + + +cd1: if (OpenPoints3D(i, j, KUB) == OpenPoint) then + + Kbottom = KFloor_Z(i, j) + + Vel2D_U(i, j) = 0. + Vel2D_V(i, j) = 0. + +dok1: do k = Kbottom, KUB + + Vel2D_U(i, j) = Vel2D_U(i, j) + (Velocity_U(i,j,k) + Velocity_U(i,j+1,k))/2.*DWZ(i,j,k) + Vel2D_V(i, j) = Vel2D_V(i, j) + (Velocity_V(i,j,k) + Velocity_V(i+1,j,k))/2.*DWZ(i,j,k) + + enddo dok1 + + if (WaterColumn(i, j) > 0.) then + + Vel2D_U(i, j) = Vel2D_U(i, j) / WaterColumn(i, j) + Vel2D_V(i, j) = Vel2D_V(i, j) / WaterColumn(i, j) + + else + + Vel2D_U(i, j) = 0. + Vel2D_V(i, j) = 0. + + endif + + endif cd1 + + enddo doj + enddo doi + !$OMP END DO + !$OMP END PARALLEL + + if (MonitorPerformance) then + call StopWatch ("ModuleHydrodynamic", "ComputeBarotropicVelocity") + endif + + nullify(Velocity_U ) + nullify(Velocity_V ) + nullify(Vel2D_U ) + nullify(Vel2D_V ) + nullify(DWZ ) + nullify(OpenPoints3D ) + nullify(WaterColumn ) + nullify(KFloor_Z ) + + + end subroutine ComputeBarotropicVelocity + !------------------------------------------------------------------------------ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! ! @@ -25853,7 +26077,6 @@ subroutine InstantMixingSmallDepths nullify(KFloor_UV ) end subroutine InstantMixingSmallDepths - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! ! @@ -27190,7 +27413,7 @@ Subroutine WaterLevelMaxMin(WaterLevel_Max, WaterLevel_Min) integer :: i, j integer :: IUB, ILB, JUB, JLB, KUB - integer, pointer, dimension (:,:,:) :: WaterPoints3D + integer, pointer, dimension (:,:,:) :: OpenPoints3D real, dimension(:,:), pointer :: WaterLevel_New @@ -27208,7 +27431,7 @@ Subroutine WaterLevelMaxMin(WaterLevel_Max, WaterLevel_Min) KUB = Me%WorkSize%KUB WaterLevel_New => Me%WaterLevel%New - WaterPoints3D => Me%External_Var%WaterPoints3D + OpenPoints3D => Me%External_Var%OpenPoints3D !End - Shorten variables name @@ -27223,7 +27446,7 @@ Subroutine WaterLevelMaxMin(WaterLevel_Max, WaterLevel_Min) do1: do j = JLB, JUB do2: do i = ILB, IUB -cd1: if (WaterPoints3D(i, j, KUB) == OpenPoint) then +cd1: if (OpenPoints3D(i, j, KUB) == OpenPoint) then !Do we have a new record water level? if (WaterLevel_Max(i,j) < WaterLevel_New(i,j)) then @@ -27247,7 +27470,7 @@ Subroutine WaterLevelMaxMin(WaterLevel_Max, WaterLevel_Min) endif nullify (WaterLevel_New) - nullify (WaterPoints3D ) + nullify (OpenPoints3D ) !---------------------------------------------------------------------- @@ -30655,7 +30878,7 @@ Subroutine WaterLevel_FlatherWindWaveV3 ( WaterFlux_XY, WaterFlux_YX, endif - ![m/s] = [m/s] - [m/s] * [-] + ![m/s] = [m/s] - [m/s] * [-] T3 = T3 - ImposedVelocity(ib, jb) * XY_Component_Cart_E @@ -31294,7 +31517,11 @@ Subroutine WaterLevel_FlatherLocalSolution if (LocalAssimila) then - Aux1 = dble(Bathymetry(i_int, j_int) + SlowCoef * AssimilaWaterLevel(i_int, j_int)) + Aux1 = dble(Bathymetry(i_int, j_int) + SlowCoef * AssimilaWaterLevel(i_int, j_int)) + + if (Me%ComputeOptions%LocalSolution == AssimilationField_) then + Aux1 = Aux1 + dble((1. - SlowCoef) * WaterLevel_New(i_int, j_int)) + endif else @@ -31453,8 +31680,14 @@ Subroutine WaterLevel_FlatherLocalSolution endif if (LocalAssimila) then - LocalWLa = LocalWLa + SlowCoef * AssimilaWaterLevel(ib , jb ) - LocalWLb = LocalWLb + SlowCoef * AssimilaWaterLevel(i_int, j_int) + LocalWLa = LocalWLa + SlowCoef * AssimilaWaterLevel(ib , jb ) + LocalWLb = LocalWLb + SlowCoef * AssimilaWaterLevel(i_int, j_int) + + if (Me%ComputeOptions%LocalSolution == AssimilationField_) then + LocalWLa = LocalWLa + (1. - SlowCoef) * WaterLevel_New (ib , jb ) + LocalWLb = LocalWLb + (1. - SlowCoef) * WaterLevel_New (i_int, j_int) + endif + endif @@ -34666,6 +34899,7 @@ Subroutine Explicit_Forces !Obstacle drag if (Me%ComputeOptions%Obstacle) & call Modify_ObstacleDrag + if (Me%ComputeOptions%Turbine) & call ModifyTurbine(Me%ObjTurbine, Me%Velocity%Horizontal%U%New, & Me%Velocity%Horizontal%V%New, & @@ -48960,214 +49194,146 @@ end subroutine Hydrodynamic_OutPut end subroutine ReadySon !Joćo Sobrinho - takes submodel variables and updates father domain - subroutine UpdateFatherModel(SonHydrodynamicID, STAT) - !Arguments------------------------------------------------------------------------------------------------ - integer, intent(IN) :: SonHydrodynamicID - !Locals--------------------------------------------------------------------------------------------------- - integer, dimension(:,:), pointer :: IV, JV, IU, JU, IZ, JZ - integer, dimension(:,:,:), pointer :: Open3DFather, Open3DSon - real, dimension(:,:,:), pointer :: VolumeZFather, VolumeUSon, VolumeUFather - real, dimension(:,:,:), pointer :: VolumeVSon, VolumeVFather, VolumeZSon - real, dimension(:,:), pointer :: VolumeZFather_2D, VolumeZSon_2D - type (T_Hydrodynamic), pointer :: ObjHydrodynamicSon - integer :: status, STAT_, ready_son, i, j, k, AuxHydrodynamicID - integer, intent(OUT) :: STAT - !Begin---------------------------------------------------------------------------------------------------- + subroutine UpdateFatherModel(SonHydrodynamicID, STAT) + !Locals---------------------------------------------------------------- + integer :: IUB, ILB, JUB, JLB, KUB, KLB + integer :: IUBSon, ILBSon, JUBSon, JLBSon, KUBSon, KLBSon, AuxHydrodynamicID + integer, intent(IN) :: SonHydrodynamicID + integer, dimension(:,:), pointer :: IV, JV + integer, dimension(:,:,:), pointer :: Open3DFather, Open3DSon + real(8), dimension(:,:,:), pointer :: VolumeZSon, VolumeZFather !Joćo Sobrinho + type (T_Hydrodynamic), pointer :: ObjHydrodynamicSon + integer :: status, STAT_, ready_son, i, j, k + integer, optional, intent(OUT) :: STAT + + !Begin------------------------------------------------------------------------------ STAT_ = UNKNOWN_ AuxHydrodynamicID = SonHydrodynamicID - call ReadySon(AuxHydrodynamicID, ObjHydrodynamicSon, ready_son) !Gets son object + call ReadySon(AuxHydrodynamicID, ObjHydrodynamicSon, ready_son) !Gets son solution cd1 : if (ready_son .EQ. IDLE_ERR_) then if (MonitorPerformance) call StartWatch ("ModuleHydrodynamic", "Modify_Hydrodynamic") - !Get 3Dvolumes, openPoints and areas - call GetExternal2WayAuxVariables(AuxHydrodynamicID, IV, JV, IU, JU, IZ, JZ, VolumeUSon, & - VolumeVSon, VolumeZSon, Open3DSon, Open3DFather, VolumeZFather,& - VolumeUFather, VolumeVFather, VolumeZSon_2D, VolumeZFather_2D) - !Zeros matrixes and compute total volume of son cells in each father cell - call UpdateMatrixes2Way(ObjHydrodynamicSon%WorkSize, Open3DSon, VolumeUSon, IU, JU) - !update Velocity U - !2D and 3D cases to improve cycle paralelization - if ((Me%WorkSize%KUB == 1) .or. (ObjHydrodynamicSon%WorkSize%KUB == 1))then - - call TwoWayAssimilation2D(Me%Velocity%Horizontal%U%New, ObjHydrodynamicSon%Velocity%Horizontal%U%New, & - Open3DFather, Open3DSon, Me%WorkSize, ObjHydrodynamicSon%WorkSize, IU, JU, & - ObjHydrodynamicSon%ComputeOptions%AssimCoef, Me%WaterLevel%DT, & - Me%TotSonVolInFather, Me%Aux2Way, Me%Corners, VolumeUSon, VolumeUFather) - else - call TwoWayAssimilation3D(Me%Velocity%Horizontal%U%New, ObjHydrodynamicSon%Velocity%Horizontal%U%New, & - Open3DFather, Open3DSon, Me%WorkSize, ObjHydrodynamicSon%WorkSize, IU, JU, & - ObjHydrodynamicSon%ComputeOptions%AssimCoef, Me%WaterLevel%DT, & - Me%TotSonVolInFather, Me%Aux2Way, Me%Corners, VolumeUSon, VolumeUFather) - endif + ! Father gridSize + IUB = Me%WorkSize%IUB + ILB = Me%WorkSize%ILB + JUB = Me%WorkSize%JUB + JLB = Me%WorkSize%JLB + KUB = Me%WorkSize%KUB + KLB = Me%WorkSize%KLB + + IUBSon = ObjHydrodynamicSon%WorkSize%IUB + ILBSon = ObjHydrodynamicSon%WorkSize%ILB + JUBSon = ObjHydrodynamicSon%WorkSize%JUB + JLBSon = ObjHydrodynamicSon%WorkSize%JLB + KUBSon = ObjHydrodynamicSon%WorkSize%KUB + KLBSon = ObjHydrodynamicSon%WorkSize%KLB + + !Get the father cell associated with each son cell + call GetHorizontalGrid(AuxHydrodynamicID, IV = IV, STAT = status) + if (status /= SUCCESS_) & + call SetError (FATAL_, INTERNAL_, "UpdateFatherModel - Hydrodynamic - ERR01") - call UpdateMatrixes2Way(ObjHydrodynamicSon%WorkSize, Open3DSon, VolumeVSon, IV, JV) + call GetHorizontalGrid(AuxHydrodynamicID, JV = JV, STAT = status) + if (status /= SUCCESS_) call SetError (FATAL_, INTERNAL_, "UpdateFatherModel - Hydrodynamic - ERR02") + + call GetGeometryVolumes(AuxHydrodynamicID, VolumeZ = VolumeZSon, & + STAT = status) + if (status /= SUCCESS_) call SetError (FATAL_, INTERNAL_, "UpdateFatherModel - Hydrodynamic - ERR03") - !update Velocity V - !2D and 3D cases to improve cycle paralelization - if ((Me%WorkSize%KUB == 1) .or. (ObjHydrodynamicSon%WorkSize%KUB == 1))then - call TwoWayAssimilation2D(Me%Velocity%Horizontal%V%New, ObjHydrodynamicSon%Velocity%Horizontal%V%New, & - Open3DFather, Open3DSon, Me%WorkSize, ObjHydrodynamicSon%WorkSize, IV, JV, & - ObjHydrodynamicSon%ComputeOptions%AssimCoef, Me%WaterLevel%DT, & - Me%TotSonVolInFather, Me%Aux2Way, Me%Corners, VolumeVSon, VolumeVFather) - else - call TwoWayAssimilation3D(Me%Velocity%Horizontal%V%New, ObjHydrodynamicSon%Velocity%Horizontal%V%New, & - Open3DFather, Open3DSon, Me%WorkSize, ObjHydrodynamicSon%WorkSize, IV, JV, & - ObjHydrodynamicSon%ComputeOptions%AssimCoef, Me%WaterLevel%DT, & - Me%TotSonVolInFather, Me%Aux2Way, Me%Corners, VolumeVSon, VolumeVFather) - endif + call GetOpenPoints3D(AuxHydrodynamicID, Open3DSon, STAT = status) + if (status /= SUCCESS_) call SetError (FATAL_, INTERNAL_, "UpdateFatherModel - Hydrodynamic - ERR04") + + AuxHydrodynamicID = Me%InstanceID ! Change ID to Father + + call GetOpenPoints3D(AuxHydrodynamicID, Open3DFather, STAT = status) + if (status /= SUCCESS_) call SetError (FATAL_, INTERNAL_, "UpdateFatherModel - Hydrodynamic - ERR05") + + call GetGeometryVolumes(AuxHydrodynamicID, VolumeZ = VolumeZFather, & + STAT = status) + if (status /= SUCCESS_) call SetError (FATAL_, INTERNAL_, "UpdateFatherModel - Hydrodynamic - ERR06")!Joćo Sobrinho + + call SetMatrixValue( Me%TotSonVolInFather, Me%WorkSize, 0.0) + !paralelizar! Joćo Sobrinho + do k = KLBSon, KUBSon + do j = JLBSon, JUBSon + do i = ILBSon, IUBSon + if (Open3DSon(i, j, k) == 1)then + Me%TotSonVolInFather(IV(i, j)+1, JV(i, j)+1, k) = & + Me%TotSonVolInFather(IV(i, j)+1, JV(i, j)+1, k) + VolumeZSon(i, j, k) + endif + enddo + enddo + enddo - call UpdateMatrixes2Way(ObjHydrodynamicSon%WorkSize, Open3DSon, VolumeZSon, IZ, JZ) - - !Update vertical geometry - !2D and 3D cases to improve cycle paralelization - if ((Me%WorkSize%KUB == 1) .or. (ObjHydrodynamicSon%WorkSize%KUB == 1))then - call TwoWayAssimilation2D(Me%Velocity%Vertical%Cartesian, & - ObjHydrodynamicSon%Velocity%Vertical%Cartesian, Open3DFather, Open3DSon, & - Me%WorkSize, ObjHydrodynamicSon%WorkSize, IZ, JZ, & - ObjHydrodynamicSon%ComputeOptions%AssimCoef, Me%WaterLevel%DT, & - Me%TotSonVolInFather, Me%Aux2Way, Me%Corners, VolumeZSon, VolumeZFather) - else - call TwoWayAssimilation3D(Me%Velocity%Vertical%Cartesian, & - ObjHydrodynamicSon%Velocity%Vertical%Cartesian, Open3DFather, Open3DSon, & - Me%WorkSize, ObjHydrodynamicSon%WorkSize, IZ, JZ, & - ObjHydrodynamicSon%ComputeOptions%AssimCoef, Me%WaterLevel%DT, & - Me%TotSonVolInFather, Me%Aux2Way, Me%Corners, VolumeZSon, VolumeZFather) - endif - - !Calculation of volume 2D because volumes are allocated in 3D and waterLevel is always 2D - call UpdateMatrixes2Way2D(ObjHydrodynamicSon%WorkSize, Open3DSon, VolumeZSon_2D, IZ, JZ) - - !update Water level - !Different routine for water level, as it is always a 2D matrix - call TwoWayAssimilationWaterLevel(Me%WaterLevel%New, ObjHydrodynamicSon%WaterLevel%New, Open3DFather, & - Open3DSon, Me%WorkSize, ObjHydrodynamicSon%WorkSize, IZ, JZ, & - ObjHydrodynamicSon%ComputeOptions%AssimCoef, Me%WaterLevel%DT, & - Me%TotSonVolInFather2D, Me%AuxWaterLevel, Me%Corners, VolumeZSon_2D, & - VolumeZFather_2D) - !Prep for WaterProperties use - call UpdateMatrixes2Way(ObjHydrodynamicSon%WorkSize, Open3DSon, VolumeZSon, IZ, JZ) + call SetMatrixValue( Me%Aux2Way, Me%WorkSize, 0.0) + + !Assimilation of son domain into father domain + call TwoWayAssimilation(Me%Velocity%Horizontal%U%New, ObjHydrodynamicSon%Velocity%Horizontal%U%New, & + Open3DFather, Open3DSon, KUB, KLB, IUBSon, ILBSon, JUBSon, JLBSon, KUBSon, & + KLBSon, IV, JV, ObjHydrodynamicSon%ComputeOptions%AssimCoef, Me%WaterLevel%DT, & + Me%TotSonVolInFather, Me%Aux2Way, Me%Corners, VolumeZSon, VolumeZFather) + + call SetMatrixValue( Me%Aux2Way, Me%WorkSize, 0.0) + + call TwoWayAssimilation(Me%Velocity%Horizontal%V%New, ObjHydrodynamicSon%Velocity%Horizontal%V%New, & + Open3DFather, Open3DSon, KUB, KLB, IUBSon, ILBSon, JUBSon, JLBSon, KUBSon, KLBSon,& + IV, JV, ObjHydrodynamicSon%ComputeOptions%AssimCoef, Me%WaterLevel%DT, & + Me%TotSonVolInFather, Me%Aux2Way, Me%Corners, VolumeZSon, VolumeZFather) + + call SetMatrixValue( Me%Aux2Way, Me%WorkSize, 0.0) + + call TwoWayAssimilation(Me%Velocity%Vertical%Cartesian, ObjHydrodynamicSon%Velocity%Vertical%Cartesian, & + Open3DFather, Open3DSon, KUB, KLB, IUBSon, ILBSon, JUBSon, JLBSon, KUBSon, KLBSon,& + IV, JV, ObjHydrodynamicSon%ComputeOptions%AssimCoef, Me%WaterLevel%DT, & + Me%TotSonVolInFather, Me%Aux2Way, Me%Corners, VolumeZSon, VolumeZFather) + + call SetMatrixValue( Me%AuxWaterLevel, Me%WorkSize2D, 0.0) + + call TwoWayAssimilation(Me%WaterLevel%New, ObjHydrodynamicSon%WaterLevel%New, Open3DFather, Open3DSon, & + KUB, IUBSon, ILBSon, JUBSon, JLBSon, KUBSon, IV, JV, & + ObjHydrodynamicSon%ComputeOptions%AssimCoef, Me%WaterLevel%DT, Me%TotSonVolInFather, & + Me%AuxWaterLevel, Me%Corners, VolumeZSon, VolumeZFather) AuxHydrodynamicID = SonHydrodynamicID ! Change ID to Son + + call UngetHorizontalGrid(AuxHydrodynamicID, IV, STAT = status) + if (status /= SUCCESS_) call SetError (FATAL_, INTERNAL_, "UpdateFatherModel - Hydrodynamic - ERR07") + + call UngetHorizontalGrid(AuxHydrodynamicID, JV, STAT = status) + if (status /= SUCCESS_) call SetError (FATAL_, INTERNAL_, "UpdateFatherModel - Hydrodynamic - ERR08") + + call UnGetGeometry(AuxHydrodynamicID, VolumeZSon, STAT = status) + if (status /= SUCCESS_) call SetError (FATAL_, INTERNAL_, "UpdateFatherModel - Hydrodynamic - ERR09") + + call UnGetMap(AuxHydrodynamicID, Open3DSon, STAT = status) + if (status /= SUCCESS_) call SetError (FATAL_, INTERNAL_, "UpdateFatherModel - Hydrodynamic - ERR10") - call UnGetExternal2WayAuxVariables(AuxHydrodynamicID, IV, JV, IU, JU, IZ, JZ, VolumeUSon, & - VolumeVSon, VolumeZSon, Open3DSon, Open3DFather, VolumeZFather,& - VolumeUFather, VolumeVFather, VolumeZSon_2D, VolumeZFather_2D) + AuxHydrodynamicID = Me%InstanceID ! Change ID to Father + call UnGetMap(AuxHydrodynamicID, Open3DFather, STAT = status) + if (status /= SUCCESS_) call SetError (FATAL_, INTERNAL_, "UpdateFatherModel - Hydrodynamic - ERR11") + + call UnGetGeometry(AuxHydrodynamicID, VolumeZFather, STAT = status) + if (status /= SUCCESS_) call SetError (FATAL_, INTERNAL_, "UpdateFatherModel - Hydrodynamic - ERR12") + if (MonitorPerformance) call StopWatch ("ModuleHydrodynamic", "Modify_Hydrodynamic") STAT_ = SUCCESS_ else - STAT_ = ready_son + STAT_ = ready_son + end if cd1 - STAT = STAT_ + if (present(STAT))then + STAT = STAT_ + endif end subroutine UpdateFatherModel !End------------------------------------------------------------------------------ - subroutine GetExternal2WayAuxVariables(AuxHydrodynamicID, IV, JV, IU, JU, IZ, JZ, VolumeUSon, & - VolumeVSon, VolumeZSon, Open3DSon, Open3DFather, VolumeZFather, & - VolumeUFather, VolumeVFather, VolumeZSon_2D, VolumeZFather_2D) - !Argumets ------------------------------------------------------------------------------------------ - integer, intent(INOUT) :: AuxHydrodynamicID - integer, dimension(:,:), pointer, intent(OUT) :: IV, JV, IU, JU, IZ, JZ - integer, dimension(:,:,:), pointer, intent(OUT) :: Open3DFather, Open3DSon - real, dimension(:,:,:), pointer, intent(OUT) :: VolumeZFather, VolumeUSon, VolumeUFather, & - VolumeVSon, VolumeVFather, VolumeZSon - real, dimension(:,: ), pointer, intent(OUT) :: VolumeZSon_2D, VolumeZFather_2D - !Locals ------------------------------------------------------------------------------------------------------ - integer :: status - - call GetHorizontalGrid(AuxHydrodynamicID, IV = IV, & - JV = JV, & - IU = IU, & - JU = JU, & - IZ = IZ, & - JZ = JZ, & - STAT = status) - if (status /= SUCCESS_) call SetError (FATAL_, INTERNAL_, "GetExternal2WayAuxVariables - Hydrodynamic - ERR01") - - call GetGeometryVolumes(AuxHydrodynamicID, VolumeU = VolumeUSon, & - VolumeV = VolumeVSon, & - VolumeZ = VolumeZSon, & - VolumeZ_2D = VolumeZSon_2D, & - STAT = status) - if (status /= SUCCESS_) call SetError (FATAL_, INTERNAL_, "GetExternal2WayAuxVariables - Hydrodynamic - ERR02") - - call GetOpenPoints3D(AuxHydrodynamicID, Open3DSon, STAT = status) - if (status /= SUCCESS_) call SetError (FATAL_, INTERNAL_, "GetExternal2WayAuxVariables - Hydrodynamic - ERR03") - - AuxHydrodynamicID = Me%InstanceID ! Change ID to Father - - call GetOpenPoints3D(AuxHydrodynamicID, Open3DFather, STAT = status) - if (status /= SUCCESS_) call SetError (FATAL_, INTERNAL_, "GetExternal2WayAuxVariables - Hydrodynamic - ERR04") - - call GetGeometryVolumes(AuxHydrodynamicID, VolumeU = VolumeUFather, & - VolumeV = VolumeVFather, & - VolumeZ = VolumeZFather, & - VolumeZ_2D = VolumeZFather_2D, & - STAT = status) - if (status /= SUCCESS_) call SetError (FATAL_, INTERNAL_, "GetExternal2WayAuxVariables - Hydrodynamic - ERR05") - - end subroutine GetExternal2WayAuxVariables - !---------------------------------------------------------------------------- - - subroutine UnGetExternal2WayAuxVariables(AuxHydrodynamicID, IV, JV, IU, JU, IZ, JZ, VolumeUSon, & - VolumeVSon, VolumeZSon, Open3DSon, Open3DFather, VolumeZFather, & - VolumeUFather, VolumeVFather, VolumeZSon_2D, VolumeZFather_2D) - - !Argumets ------------------------------------------------------------------------------------------ - integer, intent(INOUT) :: AuxHydrodynamicID - integer, dimension(:,:), pointer :: IV, JV, IU, JU, IZ, JZ - integer, dimension(:,:,:), pointer :: Open3DFather, Open3DSon - real, dimension(:,:,:), pointer :: VolumeZFather, VolumeUSon, VolumeUFather, & - VolumeVSon, VolumeVFather, VolumeZSon - real, dimension(:,: ), pointer :: VolumeZSon_2D, VolumeZFather_2D - !Locals ------------------------------------------------------------------------------------------------------ - integer :: status - - call UngetHorizontalGrid(AuxHydrodynamicID, IV, STAT = status) - if (status /= SUCCESS_) call SetError (FATAL_, INTERNAL_, "UnGetExternal2WayAuxVariables-Hydrodynamic-ERR01") - call UngetHorizontalGrid(AuxHydrodynamicID, JV, STAT = status) - if (status /= SUCCESS_) call SetError (FATAL_, INTERNAL_, "UnGetExternal2WayAuxVariables-Hydrodynamic-ERR02") - call UngetHorizontalGrid(AuxHydrodynamicID, IU, STAT = status) - if (status /= SUCCESS_) call SetError (FATAL_, INTERNAL_, "UnGetExternal2WayAuxVariables-Hydrodynamic-ERR03") - call UngetHorizontalGrid(AuxHydrodynamicID, JU, STAT = status) - if (status /= SUCCESS_) call SetError (FATAL_, INTERNAL_, "UnGetExternal2WayAuxVariables-Hydrodynamic-ERR04") - call UngetHorizontalGrid(AuxHydrodynamicID, IZ, STAT = status) - if (status /= SUCCESS_) call SetError (FATAL_, INTERNAL_, "UnGetExternal2WayAuxVariables-Hydrodynamic-ERR05") - call UngetHorizontalGrid(AuxHydrodynamicID, JZ, STAT = status) - if (status /= SUCCESS_) call SetError (FATAL_, INTERNAL_, "UnGetExternal2WayAuxVariables-Hydrodynamic-ERR06") - call UnGetGeometry(AuxHydrodynamicID, VolumeUSon, STAT = status) - if (status /= SUCCESS_) call SetError (FATAL_, INTERNAL_, "UnGetExternal2WayAuxVariables-Hydrodynamic-ERR07") - call UnGetGeometry(AuxHydrodynamicID, VolumeVSon, STAT = status) - if (status /= SUCCESS_) call SetError (FATAL_, INTERNAL_, "UnGetExternal2WayAuxVariables-Hydrodynamic-ERR08") - call UnGetGeometry(AuxHydrodynamicID, VolumeZSon, STAT = status) - if (status /= SUCCESS_) call SetError (FATAL_, INTERNAL_, "UnGetExternal2WayAuxVariables-Hydrodynamic-ERR09") - call UnGetGeometry(AuxHydrodynamicID, VolumeZSon_2D, STAT = status) - if (status /= SUCCESS_) call SetError (FATAL_, INTERNAL_, "UnGetExternal2WayAuxVariables-Hydrodynamic-ERR10") - call UnGetMap(AuxHydrodynamicID, Open3DSon, STAT = status) - if (status /= SUCCESS_) call SetError (FATAL_, INTERNAL_, "UnGetExternal2WayAuxVariables-Hydrodynamic-ERR11") - - AuxHydrodynamicID = Me%InstanceID ! Change ID to Father - - call UnGetMap(AuxHydrodynamicID, Open3DFather, STAT = status) - if (status /= SUCCESS_) call SetError (FATAL_, INTERNAL_, "UnGetExternal2WayAuxVariables-Hydrodynamic-ERR12") - call UnGetGeometry(AuxHydrodynamicID, VolumeZFather, STAT = status) - if (status /= SUCCESS_) call SetError (FATAL_, INTERNAL_, "UnGetExternal2WayAuxVariables-Hydrodynamic-ERR13") - call UnGetGeometry(AuxHydrodynamicID, VolumeUFather, STAT = status) - if (status /= SUCCESS_) call SetError (FATAL_, INTERNAL_, "UnGetExternal2WayAuxVariables-Hydrodynamic-ERR14") - call UnGetGeometry(AuxHydrodynamicID, VolumeVFather, STAT = status) - if (status /= SUCCESS_) call SetError (FATAL_, INTERNAL_, "UnGetExternal2WayAuxVariables-Hydrodynamic-ERR15") - call UnGetGeometry(AuxHydrodynamicID, VolumeZFather_2D, STAT = status) - if (status /= SUCCESS_) call SetError (FATAL_, INTERNAL_, "UnGetExternal2WayAuxVariables-Hydrodynamic-ERR16") - - end subroutine UnGetExternal2WayAuxVariables - - !---------------------------------------------------------------------------- subroutine ComputeFeedbackSon2Father(AuxHydrodynamicID, HydrodynamicID) @@ -49175,7 +49341,8 @@ subroutine ComputeFeedbackSon2Father(AuxHydrodynamicID, HydrodynamicID) type (T_Hydrodynamic), pointer :: ObjHydrodynamicFather !Locals---------------------------------------------------------------- integer, intent(IN) :: HydrodynamicID - integer :: ready_, readyFather_, STAT_, STAT_CALL, i, AuxHydrodynamicID + integer :: ready_, readyFather_, STAT_CALL, i, AuxHydrodynamicID + !integer :: STAT_ !Begin------------------------------------------------------------------------------ @@ -49194,6 +49361,7 @@ subroutine ComputeFeedbackSon2Father(AuxHydrodynamicID, HydrodynamicID) call ReadyFather(AuxHydrodynamicID, ObjHydrodynamicFather, readyFather_) ! getsFather if (ObjHydrodynamicFather%LastIteration == Me%CurrentTime)then + !Ver se é preciso nulificar o Pai call Ready (AuxHydrodynamicID, ready_) ! switches Me% from Son to Father @@ -49213,52 +49381,7 @@ subroutine ComputeFeedbackSon2Father(AuxHydrodynamicID, HydrodynamicID) end subroutine ComputeFeedbackSon2Father !-------------------------------------------------------------------------------------------------------------------- - subroutine UpdateMatrixes2Way(WorkSize, OpenPoints, Matrix, ILink, JLink) - !Arguments-------------------------------------------------------------------------------- - type(T_Size3D) :: WorkSize - integer, dimension(:,:,:), pointer :: OpenPoints - real, dimension(:,:,:), pointer :: Matrix - integer, dimension(:,: ), pointer :: ILink, JLink - !Local variables-------------------------------------------------------------------------- - integer :: i, j, k - !Begin------------------------------------------------------------------------------------ - call SetMatrixValue( Me%TotSonVolInFather, Me%WorkSize, 0.0) - call SetMatrixValue( Me%Aux2Way, Me%WorkSize, 0.0) - - do k = WorkSize%KLB, WorkSize%KUB - do j = WorkSize%JLB, WorkSize%JUB - do i = WorkSize%ILB, WorkSize%IUB - Me%TotSonVolInFather(ILink(i, j)+1, JLink(i, j)+1, k) = & - Me%TotSonVolInFather(ILink(i, j)+1, JLink(i, j)+1, k) + Matrix(i, j, k) * OpenPoints(i, j, k) - enddo - enddo - enddo - - end subroutine UpdateMatrixes2Way - - !------------------------------------------------------------------------------------------------------------------ - subroutine UpdateMatrixes2Way2D(WorkSize, OpenPoints, Matrix, ILink, JLink) - !Arguments-------------------------------------------------------------------------------- - type(T_Size3D) :: WorkSize - integer, dimension(:,:, :), pointer :: OpenPoints - real, dimension(:,: ), pointer :: Matrix - integer, dimension(:,: ), pointer :: ILink, JLink - !Local variables-------------------------------------------------------------------------- - integer :: i, j - !Begin------------------------------------------------------------------------------------ - call SetMatrixValue( Me%AuxWaterLevel, Me%WorkSize2D, 0.0) - call SetMatrixValue( Me%TotSonVolInFather2D, Me%WorkSize2D, 0.0) - - do j = WorkSize%JLB, WorkSize%JUB - do i = WorkSize%ILB, WorkSize%IUB - Me%TotSonVolInFather2D(ILink(i, j)+1, JLink(i, j)+1) = & - Me%TotSonVolInFather2D(ILink(i, j)+1, JLink(i, j)+1) + Matrix(i, j) * OpenPoints(i, j, WorkSize%KUB) - enddo - enddo - - end subroutine UpdateMatrixes2Way2D - !------------------------------------------------------------------------------------------------------------------- subroutine ComputeFloodRisk @@ -50476,8 +50599,8 @@ subroutine Write_HDF5_Format(iW) if (Me%ComputeOptions%WaterLevelMaxMin) then - Me%OutPut%WaterLevelMax(:, :) = Me%WaterLevel%Maxi(:,:) * Me%OutPut%WaterLevelUnits - Me%OutPut%WaterLevelMin(:, :) = Me%WaterLevel%Mini(:,:) * Me%OutPut%WaterLevelUnits + Me%OutPut%WaterLevelMax(:, :) = Me%WaterLevel%Maxi (:, :) * Me%OutPut%WaterLevelUnits + Me%OutPut%WaterLevelMin(:, :) = Me%WaterLevel%Mini (:, :) * Me%OutPut%WaterLevelUnits Me%OutPut%WaterLevelDif(:, :) = Me%OutPut%WaterLevelMax(:, :) - Me%OutPut%WaterLevelMin(:, :) AuxProp = trim(GetPropertyName (WaterLevel_))//"_Max" @@ -51024,7 +51147,7 @@ subroutine Write_Surface_HDF5_Format call HDF5WriteData (Me%ObjSurfaceHDF5, & "/Grid/VerticalZ", & - "VerticalZ", "m", & + "Vertical", "m", & Array3D = Me%External_Var%SZZ, & OutputNumber = NextSurfaceOutPut, & STAT = STAT_CALL) @@ -51496,6 +51619,8 @@ subroutine CenterVelocity( CenterU, CenterV, VectorType) if (MonitorPerformance) then call StartWatch ("ModuleHydrodynamic", "CenterVelocity") endif + + ! Joćo Sobrinho !$OMP PARALLEL PRIVATE(i,j,k,AngleX,AngleY,VelU,VelV) @@ -51791,26 +51916,26 @@ subroutine OutPut_Profile Me%OutPut%CenterU, & SZZ = Me%External_Var%SZZ, & STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'OutPut_Profile - ModuleHydrodynamic - ERR05' + if (STAT_CALL /= SUCCESS_) stop 'OutPut_Profile - ModuleHydrodynamic - ERR01' call WriteProfile(Me%ObjProfile, & Me%OutPut%CenterV, & SZZ = Me%External_Var%SZZ, & STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'OutPut_Profile - ModuleHydrodynamic - ERR06' + if (STAT_CALL /= SUCCESS_) stop 'OutPut_Profile - ModuleHydrodynamic - ERR02' call WriteProfile(Me%ObjProfile, & Me%OutPut%CenterW, & SZZ = Me%External_Var%SZZ, & STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'OutPut_Profile - ModuleHydrodynamic - ERR07' + if (STAT_CALL /= SUCCESS_) stop 'OutPut_Profile - ModuleHydrodynamic - ERR03' call WriteProfile(Me%ObjProfile, & Me%OutPut%ModulusH, & SZZ = Me%External_Var%SZZ, & STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'OutPut_Profile - ModuleHydrodynamic - ERR08' + if (STAT_CALL /= SUCCESS_) stop 'OutPut_Profile - ModuleHydrodynamic - ERR04' call WriteProfile(Me%ObjProfile, & Me%OutPut%DirectionH, & @@ -52130,7 +52255,7 @@ subroutine KillHydrodynamic(HydrodynamicID, STAT) call KillFillMatrix(Me%WaterLevel%ID%ObjFillMatrix, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) stop 'KillHydrodynamic - ModuleHydrodynamic - ERR30' end if - + if (Me%ComputeOptions%TideStateON) then if (Me%WaterLevel%TideStateID%SolutionFromFile) then call KillFillMatrix(Me%WaterLevel%TideStateID%ObjFillMatrix, STAT = STAT_CALL) @@ -54881,7 +55006,7 @@ Subroutine DeallocateVariables !Water level variables allocation deallocate (Me%WaterLevel%New, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR01.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR10.' nullify (Me%WaterLevel%New) @@ -54889,13 +55014,13 @@ Subroutine DeallocateVariables deallocate (Me%WaterLevel%Old, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR02.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR20.' nullify (Me%WaterLevel%Old) deallocate (Me%WaterLevel%VolumeCreated, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR02a.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR30.' nullify (Me%WaterLevel%VolumeCreated) @@ -54903,13 +55028,13 @@ Subroutine DeallocateVariables deallocate (Me%WaterLevel%Maxi, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR02b.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR40.' nullify (Me%WaterLevel%Maxi) deallocate (Me%WaterLevel%Mini, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR02c.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR50.' nullify (Me%WaterLevel%Mini) @@ -54925,7 +55050,7 @@ Subroutine DeallocateVariables !Horizontal velocity deallocate (Me%Velocity%Horizontal%U%New, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR04.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR60.' nullify (Me%Velocity%Horizontal%U%New) @@ -54933,7 +55058,7 @@ Subroutine DeallocateVariables deallocate (Me%Velocity%Horizontal%U%Old, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR05.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR70.' nullify (Me%Velocity%Horizontal%U%Old) @@ -54941,7 +55066,7 @@ Subroutine DeallocateVariables deallocate (Me%Velocity%Horizontal%V%New, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR07.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR80.' nullify (Me%Velocity%Horizontal%V%New) @@ -54949,7 +55074,7 @@ Subroutine DeallocateVariables deallocate (Me%Velocity%Horizontal%V%Old, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR08.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR90.' nullify (Me%Velocity%Horizontal%V%Old) #endif _USE_PAGELOCKED @@ -54987,52 +55112,64 @@ Subroutine DeallocateVariables #else deallocate (Me%Velocity%Vertical%Cartesian, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR11.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR100.' nullify (Me%Velocity%Vertical%Cartesian) #endif _USE_PAGELOCKED deallocate (Me%Velocity%Vertical%Across, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR10.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR110.' - nullify (Me%Velocity%Vertical%Across) + nullify (Me%Velocity%Vertical%Across) + + deallocate (Me%Velocity%BarotropicUc, STAT = STAT_CALL) + if (STAT_CALL /= SUCCESS_) & + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR120.' + + nullify (Me%Velocity%BarotropicUc) + + deallocate (Me%Velocity%BarotropicVc, STAT = STAT_CALL) + if (STAT_CALL /= SUCCESS_) & + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR120.' + + nullify (Me%Velocity%BarotropicVc) if (Me%NonHydrostatic%ON) then deallocate (Me%Velocity%Vertical%CartesianOld, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR11a.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR130.' nullify (Me%Velocity%Vertical%CartesianOld) deallocate (Me%NonHydrostatic%PressureCorrect, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR11b.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR140.' nullify (Me%NonHydrostatic%PressureCorrect) deallocate (Me%NonHydrostatic%PrevisionalQ, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR11c.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR150.' nullify (Me%NonHydrostatic%PrevisionalQ) deallocate (Me%NonHydrostatic%CCoef, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR11d.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR160.' nullify (Me%NonHydrostatic%CCoef) deallocate (Me%NonHydrostatic%GCoef, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR11e.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR170.' nullify (Me%NonHydrostatic%GCoef) deallocate (Me%NonHydrostatic%VerticalSurfLayerOld, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR11f.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR180.' nullify (Me%NonHydrostatic%VerticalSurfLayerOld) @@ -55043,25 +55180,25 @@ Subroutine DeallocateVariables deallocate (Me%VelBaroclinic%W_New, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR11a.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR190.' nullify (Me%VelBaroclinic%W_New) deallocate (Me%VelBaroclinic%W_Old, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR11b.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR200.' nullify (Me%VelBaroclinic%W_Old) deallocate (Me%VelBaroclinic%U%New, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR11c.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR210.' nullify(Me%VelBaroclinic%U%New) deallocate (Me%VelBaroclinic%U%Old, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR11d.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR220.' nullify(Me%VelBaroclinic%U%Old) @@ -55069,26 +55206,26 @@ Subroutine DeallocateVariables deallocate (Me%VelBaroclinic%V%New, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR11e.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR230.' nullify(Me%VelBaroclinic%V%New) deallocate (Me%VelBaroclinic%V%Old, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR11f.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR240.' nullify(Me%VelBaroclinic%V%Old) deallocate (Me%VelBaroclinic%U2D, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR11g.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR250.' nullify(Me%VelBaroclinic%U2D) deallocate (Me%VelBaroclinic%V2D, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR11h.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR260.' nullify(Me%VelBaroclinic%V2D) @@ -55109,27 +55246,27 @@ Subroutine DeallocateVariables !Water fluxes deallocate (Me%WaterFluxes%X, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DellocateVariables - ModuleHydrodynamic. ERR13.' + stop 'Subroutine DellocateVariables - ModuleHydrodynamic. ERR270.' nullify (Me%WaterFluxes%X) deallocate (Me%WaterFluxes%Y, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR14.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR280.' nullify (Me%WaterFluxes%Y) deallocate (Me%WaterFluxes%Z, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR15.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR290.' nullify (Me%WaterFluxes%Z) deallocate (Me%WaterFluxes%Discharges, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR15a.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR300.' nullify (Me%WaterFluxes%Discharges) @@ -55157,14 +55294,14 @@ Subroutine DeallocateVariables !Can be interesting to compute the average water level deallocate (Me%Residual%WaterLevel, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR03.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR310.' nullify (Me%Residual%WaterLevel) deallocate (Me%Residual%Velocity_U, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR06.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR320.' nullify (Me%Residual%Velocity_U) @@ -55172,21 +55309,21 @@ Subroutine DeallocateVariables deallocate (Me%Residual%Velocity_V, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR09.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR330.' nullify (Me%Residual%Velocity_V) deallocate (Me%Residual%Vertical_Velocity, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR12.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR340.' nullify (Me%Residual%Vertical_Velocity) deallocate (Me%Residual%WaterFlux_X, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR13a.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR350.' nullify (Me%Residual%WaterFlux_X) @@ -55194,13 +55331,13 @@ Subroutine DeallocateVariables deallocate (Me%Residual%WaterFlux_Y, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR14a.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR360.' nullify (Me%Residual%WaterFlux_Y) deallocate (Me%Residual%DWZ, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR13b.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR380.' nullify (Me%Residual%DWZ) @@ -55211,33 +55348,33 @@ Subroutine DeallocateVariables !Forces deallocate (Me%Forces%Rox3X, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR16.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR390.' nullify (Me%Forces%Rox3X) deallocate (Me%Forces%Rox3Y, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR16a.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR400.' nullify (Me%Forces%Rox3Y) deallocate (Me%Forces%Horizontal_Transport, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR17.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR410.' nullify (Me%Forces%Horizontal_Transport) deallocate (Me%Forces%Inertial_Aceleration, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR18.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR420.' nullify (Me%Forces%Inertial_Aceleration) deallocate (Me%Forces%TidePotentialLevel, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR18a.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR430.' nullify (Me%Forces%TidePotentialLevel) @@ -55246,7 +55383,7 @@ Subroutine DeallocateVariables deallocate (Me%Forces%Altim_Relax_Aceleration, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR18b.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR440.' nullify (Me%Forces%Altim_Relax_Aceleration) @@ -55255,7 +55392,7 @@ Subroutine DeallocateVariables if (Me%Relaxation%Force) then deallocate (Me%Forces%Relax_Aceleration, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR18d.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR450.' nullify (Me%Forces%Relax_Aceleration) @@ -55265,7 +55402,7 @@ Subroutine DeallocateVariables if (Me%Relaxation%Geometry) then deallocate (Me%Relaxation%DecayTimeGeo, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR18e.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR460.' nullify (Me%Relaxation%DecayTimeGeo) @@ -55275,7 +55412,7 @@ Subroutine DeallocateVariables deallocate (Me%WaveStress%DumpCoef, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR18f.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR470.' nullify (Me%WaveStress%DumpCoef) @@ -55284,7 +55421,7 @@ Subroutine DeallocateVariables !Coefficients deallocate (Me%Coef%D2%D, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR20.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR480.' nullify (Me%Coef%D2%D) @@ -55292,20 +55429,20 @@ Subroutine DeallocateVariables deallocate (Me%Coef%D2%E, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR21.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR490.' nullify (Me%Coef%D2%E) deallocate (Me%Coef%D2%EAux, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR21a.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR500.' nullify (Me%Coef%D2%EAux) deallocate (Me%Coef%D2%F, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR22.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR510.' nullify (Me%Coef%D2%F) @@ -55313,14 +55450,14 @@ Subroutine DeallocateVariables deallocate (Me%Coef%D2%Ti, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR23.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR520.' nullify (Me%Coef%D2%Ti) deallocate (Me%Coef%D2%TiAux, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR23d.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR530.' nullify (Me%Coef%D2%TiAux) @@ -55330,14 +55467,14 @@ Subroutine DeallocateVariables deallocate (Me%Coef%D2%Rad, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR23a.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR540.' nullify(Me%Coef%D2%Rad) deallocate (Me%Coef%D2%TiRad, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR23b.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR550.' nullify(Me%Coef%D2%TiRad) @@ -55352,19 +55489,19 @@ Subroutine DeallocateVariables #else deallocate (Me%Coef%D3%D, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR24.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR560.' deallocate (Me%Coef%D3%E, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR25.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR570.' deallocate (Me%Coef%D3%F, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR26.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR580.' deallocate (Me%Coef%D3%Ti, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR27.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR590.' nullify (Me%Coef%D3%D) nullify (Me%Coef%D3%E) @@ -55377,13 +55514,13 @@ Subroutine DeallocateVariables !Bottom boundary: this variable in the future must migrate to the module ModuleBottom deallocate (Me%External_Var%ChezyZ, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR28.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR600.' nullify (Me%External_Var%ChezyZ) deallocate (Me%External_Var%ChezyVelUV, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR28.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR610.' nullify (Me%External_Var%ChezyVelUV) @@ -55396,7 +55533,7 @@ Subroutine DeallocateVariables Deallocate (Me%OutPut%OutTime, STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'Sub. DeallocateVariables - ModuleHydrodynamic - ERR33' + if (STAT_CALL /= SUCCESS_) stop 'Sub. DeallocateVariables - ModuleHydrodynamic - ERR620' nullify (Me%OutPut%OutTime) @@ -55408,7 +55545,7 @@ Subroutine DeallocateVariables call KillProfile(Me%ObjProfile, STAT = STAT_CALL) if (STAT_CALL .NE. SUCCESS_) & - stop 'DeallocateVariables - ModuleHydrodynamic - ERR340' + stop 'DeallocateVariables - ModuleHydrodynamic - ERR630' end if @@ -55416,7 +55553,7 @@ Subroutine DeallocateVariables if (Me%ObjTimeSerie /= 0) then call KillTimeSerie(Me%ObjTimeSerie, STAT = STAT_CALL) if (STAT_CALL .NE. SUCCESS_) & - stop 'DeallocateVariables - ModuleHydrodynamic - ERR34' + stop 'DeallocateVariables - ModuleHydrodynamic - ERR640' endif @@ -55429,52 +55566,52 @@ Subroutine DeallocateVariables deallocate (LocalBaroc%Kleft, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR35.' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR650.' nullify (LocalBaroc%Kleft) deallocate (LocalBaroc%Kright, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR36' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR660' nullify (LocalBaroc%Kright) deallocate (LocalBaroc%Depth_integ, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR37' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR670' nullify (LocalBaroc%Depth_integ) deallocate (LocalBaroc%Hcenter, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR38' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR680' nullify (LocalBaroc%Hcenter) deallocate (LocalBaroc%Hleft, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR39' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR690' nullify (LocalBaroc%Hleft) deallocate (LocalBaroc%Hright, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR40' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR700' nullify (LocalBaroc%Hright) deallocate (LocalBaroc%HroLeft, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR41' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR710' nullify (LocalBaroc%HroLeft) deallocate (LocalBaroc%HroRight, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR42' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR720' nullify (LocalBaroc%HroRight) deallocate (LocalBaroc%DensRight, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR420' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR710' nullify (LocalBaroc%DensRight) deallocate (LocalBaroc%DensLeft, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR430' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR720' nullify (LocalBaroc%DensLeft) enddo @@ -55502,32 +55639,32 @@ Subroutine DeallocateVariables deallocate (Me%VECG_3D, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR43' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR730' nullify (Me%VECG_3D) deallocate (Me%VECW_3D, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR44' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR740' nullify (Me%VECW_3D) deallocate (Me%VECG_2D, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR45' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR750' nullify (Me%VECG_2D) deallocate (Me%VECW_2D, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR46' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR760' nullify (Me%VECW_2D) if (Me%ComputeOptions%BarotropicRadia == BlumbergKantha_) then deallocate (Me%ComputeOptions%Tlag, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR47' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR770' nullify (Me%ComputeOptions%Tlag) endif @@ -55536,58 +55673,58 @@ Subroutine DeallocateVariables deallocate (Me%ComputeOptions%BiHarmonicUX_VY, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR48' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR780' deallocate (Me%ComputeOptions%BiHarmonicUY_VX, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR49' + stop 'Subroutine DeallocateVariables - ModuleHydrodynamic. ERR790' endif ic1: if (Me%CyclicBoundary%ON) then deallocate (Me%Coef%D1%a, STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'DeallocateVariables; ModuleHydrodynamic. ERR52.' + if (STAT_CALL /= SUCCESS_) stop 'DeallocateVariables; ModuleHydrodynamic. ERR800.' deallocate (Me%Coef%D1%b, STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'DeallocateVariables; ModuleHydrodynamic. ERR53.' + if (STAT_CALL /= SUCCESS_) stop 'DeallocateVariables; ModuleHydrodynamic. ERR810.' deallocate (Me%Coef%D1%bb, STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'DeallocateVariables; ModuleHydrodynamic. ERR54.' + if (STAT_CALL /= SUCCESS_) stop 'DeallocateVariables; ModuleHydrodynamic. ERR820.' deallocate (Me%Coef%D1%c, STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'DeallocateVariables; ModuleHydrodynamic. ERR55.' + if (STAT_CALL /= SUCCESS_) stop 'DeallocateVariables; ModuleHydrodynamic. ERR830.' deallocate (Me%Coef%D1%r, STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'DeallocateVariables; ModuleHydrodynamic. ERR56.' + if (STAT_CALL /= SUCCESS_) stop 'DeallocateVariables; ModuleHydrodynamic. ERR840.' deallocate (Me%Coef%D1%u, STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'DeallocateVariables; ModuleHydrodynamic. ERR57.' + if (STAT_CALL /= SUCCESS_) stop 'DeallocateVariables; ModuleHydrodynamic. ERR850.' deallocate (Me%Coef%D1%x, STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'DeallocateVariables; ModuleHydrodynamic. ERR58.' + if (STAT_CALL /= SUCCESS_) stop 'DeallocateVariables; ModuleHydrodynamic. ERR860.' deallocate (Me%Coef%D1%z, STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'DeallocateVariables; ModuleHydrodynamic. ERR59.' + if (STAT_CALL /= SUCCESS_) stop 'DeallocateVariables; ModuleHydrodynamic. ERR870.' deallocate (Me%Coef%D1%gam, STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'DeallocateVariables; ModuleHydrodynamic. ERR60.' + if (STAT_CALL /= SUCCESS_) stop 'DeallocateVariables; ModuleHydrodynamic. ERR880.' endif ic1 if(Me%ComputeOptions%Obstacle)then deallocate (Me%Drag%Coef, STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'DeallocateVariables; ModuleHydrodynamic. ERR70.' + if (STAT_CALL /= SUCCESS_) stop 'DeallocateVariables; ModuleHydrodynamic. ERR890.' if(Me%Drag%ID%SolutionFromFile)then call KillFillMatrix(Me%Drag%ID%ObjFillMatrix, STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'DeallocateVariables; ModuleHydrodynamic. ERR80.' + if (STAT_CALL /= SUCCESS_) stop 'DeallocateVariables; ModuleHydrodynamic. ERR900.' endif deallocate (Me%Forces%ObstacleDrag_Aceleration, STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'DeallocateVariables; ModuleHydrodynamic. ERR110.' + if (STAT_CALL /= SUCCESS_) stop 'DeallocateVariables; ModuleHydrodynamic. ERR910.' end if @@ -55595,10 +55732,10 @@ Subroutine DeallocateVariables if(Me%ComputeOptions%Scraper)then deallocate (Me%Forces%Scraper_Aceleration, STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'DeallocateVariables; ModuleHydrodynamic. ERR120.' + if (STAT_CALL /= SUCCESS_) stop 'DeallocateVariables; ModuleHydrodynamic. ERR920.' deallocate (Me%Scraper%Position, STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'DeallocateVariables; ModuleHydrodynamic. ERR125.' + if (STAT_CALL /= SUCCESS_) stop 'DeallocateVariables; ModuleHydrodynamic. ERR930.' if (Me%Scraper%UOn) deallocate(Me%Scraper%VelU) @@ -55606,26 +55743,28 @@ Subroutine DeallocateVariables if(Me%Scraper%ID_U%SolutionFromFile)then call KillFillMatrix(Me%Scraper%ID_U%ObjFillMatrix, STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'DeallocateVariables; ModuleHydrodynamic. ERR130.' + if (STAT_CALL /= SUCCESS_) stop 'DeallocateVariables; ModuleHydrodynamic. ERR940.' endif if(Me%Scraper%ID_V%SolutionFromFile)then call KillFillMatrix(Me%Scraper%ID_V%ObjFillMatrix, STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'DeallocateVariables; ModuleHydrodynamic. ERR140.' + if (STAT_CALL /= SUCCESS_) stop 'DeallocateVariables; ModuleHydrodynamic. ERR950.' endif ! if(Me%Scraper%ID_W%SolutionFromFile)then ! call KillFillMatrix(Me%Scraper%ID_W%ObjFillMatrix, STAT = STAT_CALL) -! if (STAT_CALL /= SUCCESS_) stop 'DeallocateVariables; ModuleHydrodynamic. ERR150.' +! if (STAT_CALL /= SUCCESS_) stop 'DeallocateVariables; ModuleHydrodynamic. ERR960.' ! endif end if - if (Me%OutPut%TimeSerieON .or. Me%OutPut%hdf5ON .or. Me%OutPut%ProfileON) & + if (Me%OutPut%TimeSerieON .or. Me%OutPut%hdf5ON .or. & + Me%OutPut%ProfileON .or. Me%OutPut%HDF5_Surface_ON.or. & + Me%OutW%OutPutWindowsON) then call KillMatrixesOutput - + endif if (Me%ComputeOptions%InvertBaromSomeBound) & deallocate(Me%ComputeOptions%InvertBarometerCells) @@ -55648,25 +55787,25 @@ Subroutine DeallocateVariables if(Me%Output%FloodRisk)then deallocate(Me%Output%MaxWaterColumn, STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'DeallocateVariables - ModuleHydrodynamic - ERR160' + if (STAT_CALL /= SUCCESS_) stop 'DeallocateVariables - ModuleHydrodynamic - ERR970' deallocate(Me%Output%VelocityAtMaxWaterColumn, STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'DeallocateVariables - ModuleHydrodynamic - ERR170' + if (STAT_CALL /= SUCCESS_) stop 'DeallocateVariables - ModuleHydrodynamic - ERR980' deallocate(Me%Output%MaxFloodRisk, STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'DeallocateVariables - ModuleHydrodynamic - ERR180' + if (STAT_CALL /= SUCCESS_) stop 'DeallocateVariables - ModuleHydrodynamic - ERR990' deallocate(Me%Output%MaxVelocity, STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'DeallocateVariables - ModuleHydrodynamic - ERR190' + if (STAT_CALL /= SUCCESS_) stop 'DeallocateVariables - ModuleHydrodynamic - ERR1000' deallocate(Me%Output%MaxWaterLevel, STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'DeallocateVariables - ModuleHydrodynamic - ERR200' + if (STAT_CALL /= SUCCESS_) stop 'DeallocateVariables - ModuleHydrodynamic - ERR1010' deallocate(Me%Output%MapMax, STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'DeallocateVariables - ModuleHydrodynamic - ERR210' + if (STAT_CALL /= SUCCESS_) stop 'DeallocateVariables - ModuleHydrodynamic - ERR1020' deallocate(Me%Output%MapMin, STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) stop 'DeallocateVariables - ModuleHydrodynamic - ERR210' + if (STAT_CALL /= SUCCESS_) stop 'DeallocateVariables - ModuleHydrodynamic - ERR1030' endif @@ -55775,15 +55914,12 @@ Subroutine DeallocateVariables nullify(Me%Aux2Way) deallocate(Me%TotSonVolInFather) nullify(Me%TotSonVolInFather) - deallocate(Me%TotSonVolInFather2D) - nullify(Me%TotSonVolInFather2D) deallocate(Me%AuxWaterLevel) nullify(Me%AuxWaterLevel) deallocate(Me%Corners) nullify(Me%Corners) endif - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !---------------------------------------------------------------------- @@ -56290,29 +56426,33 @@ Subroutine ReadLock_ModuleWaves !Begin------------------------------------------------------------------ - if (Me%WaveStress%ON)then + if (Me%Generic4D%ON) then + call SetGeneric4DValues(Me%ObjWaves, Me%Generic4D%CurrentValue, STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine ReadLock_ModuleWaves - ModuleHydrodynamic. ERR10.' + if (STAT_CALL /= SUCCESS_) & + stop 'ReadLock_ModuleWaves - ModuleHydrodynamic - ERR10' + endif + + if (Me%WaveStress%ON)then - call GetWavesStress (Me%ObjWaves, & - Me%External_Var%TauWavesU, & - Me%External_Var%TauWavesV, & + call GetWavesStress (Me%ObjWaves, & + Me%External_Var%TauWavesU, & + Me%External_Var%TauWavesV, & STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) & + if (STAT_CALL /= SUCCESS_) & stop 'Subroutine ReadLock_ModuleWaves - ModuleHydrodynamic. ERR20.' endif if (Me%ComputeOptions%WaveShearStress)then - call GetWaves (WavesID = Me%ObjWaves, & - Abw = Me%External_Var%Abw, & - Ubw = Me%External_Var%Ubw, & + call GetWaves (WavesID = Me%ObjWaves, & + Abw = Me%External_Var%Abw, & + Ubw = Me%External_Var%Ubw, & STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) & + if (STAT_CALL /= SUCCESS_) & stop 'Subroutine ReadLock_ModuleWaves - ModuleHydrodynamic. ERR30.' endif @@ -56334,14 +56474,14 @@ Subroutine ReadLock_ModuleWaves STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine ReadLock_ModuleWaves; module ModuleHydrodynamic. ERR20a.' + stop 'Subroutine ReadLock_ModuleWaves; module ModuleHydrodynamic. ERR40.' call GetWaves (WavesID = Me%ObjWaves, & WaveHeight = Me%External_Var%WaveHeight, & STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine ReadLock_ModuleWaves; module ModuleHydrodynamic. ERR20b.' + stop 'Subroutine ReadLock_ModuleWaves; module ModuleHydrodynamic. ERR50.' endif @@ -56353,7 +56493,7 @@ Subroutine ReadLock_ModuleWaves WaveLength = Me%External_Var%WaveLength, & STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine ReadLock_ModuleWaves; module ModuleHydrodynamic. ERR20c.' + stop 'Subroutine ReadLock_ModuleWaves; module ModuleHydrodynamic. ERR60.' call GetWavesStress (Me%ObjWaves, & @@ -56362,7 +56502,7 @@ Subroutine ReadLock_ModuleWaves STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - stop 'Subroutine ReadLock_ModuleWaves; module ModuleHydrodynamic. ERR20d.' + stop 'Subroutine ReadLock_ModuleWaves; module ModuleHydrodynamic. ERR70.' endif @@ -56485,6 +56625,14 @@ Subroutine ReadUnLock_ModuleWaves stop 'Subroutine ReadUnLock_ModuleWaves; module ModuleHydrodynamic. ERR02c.' endif + +! call SetWavesSeaLevelVel2DSwan(WavesID = Me%ObjWaves, & +! SeaLevel = Me%WaterLevel%New, & +! VelU = Me%Velocity%BarotropicUc, & +! VelV = Me%Velocity%BarotropicVc, & +! STAT = STAT_CALL) + +! stop 'Subroutine ReadUnLock_ModuleWaves; module ModuleHydrodynamic. ERR200.' End Subroutine ReadUnLock_ModuleWaves @@ -57427,22 +57575,26 @@ subroutine SendHydrodynamicMPI (HydrodynamicID, Destination, Window, InitialFiel call MPI_Send (Me%ComputeOptions%Continuous, 1, MPI_LOGICAL, Destination, & 1000, MPI_COMM_WORLD, STAT_CALL) if (STAT_CALL /= SUCCESS_) stop 'SendHydrodynamicMPI - MohidWater - ERR02' - + + !Sends KLB call MPI_Send (Me%WorkSize%KLB, 1, MPI_INTEGER, Destination, 1001, & MPI_COMM_WORLD, STAT_CALL) if (STAT_CALL /= SUCCESS_) stop 'SendHydrodynamicMPI - MohidWater - ERR03' + !Sends KUB call MPI_Send (Me%WorkSize%KUB, 1, MPI_INTEGER, Destination, 1002, & MPI_COMM_WORLD, STAT_CALL) if (STAT_CALL /= SUCCESS_) stop 'SendHydrodynamicMPI - MohidWater - ERR04' + Precision = MPIKind(DT) !Sends DT call MPI_Send (DT, 1, Precision, Destination, 1003, MPI_COMM_WORLD, STAT_CALL) if (STAT_CALL /= SUCCESS_) stop 'SendHydrodynamicMPI - MohidWater - ERR05' + endif @@ -57456,6 +57608,7 @@ subroutine SendHydrodynamicMPI (HydrodynamicID, Destination, Window, InitialFiel call MPI_Send (AuxTime, 6, Precision, Destination, 1004, MPI_COMM_WORLD, STAT_CALL) if (STAT_CALL /= SUCCESS_) stop 'SendHydrodynamicMPI - MohidWater - ERR06' + !Gets OpenPoints call GetOpenPoints3D (Me%ObjMap, Open3DFather, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) stop 'SendHydrodynamicMPI - MohidWater - ERR07' @@ -57483,6 +57636,7 @@ subroutine SendHydrodynamicMPI (HydrodynamicID, Destination, Window, InitialFiel call MPI_Send (Me%Velocity%Horizontal%U%New(ILB:IUB, JLB:JUB+1, KLB:KUB), & iSize, Precision, Destination, 1005, MPI_COMM_WORLD, STAT_CALL) if (STAT_CALL /= SUCCESS_) stop 'SendHydrodynamicMPI - MohidWater - ERR11' + !VFather iSize = (IUB+1-ILB+1) * (JUB-JLB+1) * (KUB-KLB+1) @@ -57490,18 +57644,19 @@ subroutine SendHydrodynamicMPI (HydrodynamicID, Destination, Window, InitialFiel iSize, Precision, Destination, 1006, MPI_COMM_WORLD, STAT_CALL) if (STAT_CALL /= SUCCESS_) stop 'SendHydrodynamicMPI - MohidWater - ERR12' + !FluxXFather iSize = (IUB-ILB+1) * (JUB+1-JLB+1) * (KUB-KLB+1) call MPI_Send (Me%WaterFluxes%X(ILB:IUB, JLB:JUB+1, KLB:KUB), & iSize, MPI_DOUBLE_PRECISION, Destination, 1007, MPI_COMM_WORLD, STAT_CALL) if (STAT_CALL /= SUCCESS_) stop 'SendHydrodynamicMPI - MohidWater - ERR13' - + !FluxYFather iSize = (IUB+1-ILB+1) * (JUB-JLB+1) * (KUB-KLB+1) call MPI_Send (Me%WaterFluxes%Y(ILB:IUB+1, JLB:JUB, KLB:KUB), & iSize, MPI_DOUBLE_PRECISION, Destination, 1008, MPI_COMM_WORLD, STAT_CALL) if (STAT_CALL /= SUCCESS_) stop 'SendHydrodynamicMPI - MohidWater - ERR14' - + !ZFather iSize = (IUB-ILB+1) * (JUB-JLB+1) @@ -57535,28 +57690,32 @@ subroutine SendHydrodynamicMPI (HydrodynamicID, Destination, Window, InitialFiel !WetFaces_UFather iSize = (IUB-ILB+1) * (JUB+1-JLB+1) * (KUB-KLB+1) call MPI_Send (WetFaces_UFather(ILB:IUB, JLB:JUB+1, KLB:KUB), & - iSize, MPI_INTEGER, Destination, 1011, MPI_COMM_WORLD, STAT_CALL) + iSize, MPI_INTEGER, Destination, 1013, MPI_COMM_WORLD, STAT_CALL) if (STAT_CALL /= SUCCESS_) stop 'SendHydrodynamicMPI - MohidWater - ERR19' !WetFaces_VFather iSize = (IUB+1-ILB+1) * (JUB-JLB+1) * (KUB-KLB+1) call MPI_Send (WetFaces_VFather(ILB:IUB+1, JLB:JUB, KLB:KUB), & - iSize, MPI_INTEGER, Destination, 1012, MPI_COMM_WORLD, STAT_CALL) + iSize, MPI_INTEGER, Destination, 1014, MPI_COMM_WORLD, STAT_CALL) if (STAT_CALL /= SUCCESS_) stop 'SendHydrodynamicMPI - MohidWater - ERR20' !DUZFather iSize = (IUB-ILB+1) * (JUB+1-JLB+1) * (KUB-KLB+1) call MPI_Send (DUZFather(ILB:IUB, JLB:JUB+1, KLB:KUB), & - iSize, Precision , Destination, 1013, MPI_COMM_WORLD, STAT_CALL) + iSize, Precision , Destination, 1015, MPI_COMM_WORLD, STAT_CALL) if (STAT_CALL /= SUCCESS_) stop 'SendHydrodynamicMPI - MohidWater - ERR21' + + !DVZFather iSize = (IUB+1-ILB+1) * (JUB-JLB+1) * (KUB-KLB+1) call MPI_Send (DVZFather(ILB:IUB+1, JLB:JUB, KLB:KUB), & - iSize, Precision, Destination, 1014, MPI_COMM_WORLD, STAT_CALL) + iSize, Precision, Destination, 1016, MPI_COMM_WORLD, STAT_CALL) if (STAT_CALL /= SUCCESS_) stop 'SendHydrodynamicMPI - MohidWater - ERR22' + + !Ungets information call UnGetMap (Me%ObjMap, Open3DFather, STAT = STAT_CALL) @@ -57615,6 +57774,8 @@ subroutine RecvHydrodynamicMPI (HydrodynamicID, Source, Window, InitialField, integer, dimension(:,:,:), pointer, save :: WetFaces_VFather integer, dimension(:,:,:), pointer, save :: Faces3D_UFather integer, dimension(:,:,:), pointer, save :: Faces3D_VFather + + integer :: iSize integer, save :: Precision @@ -57641,7 +57802,7 @@ subroutine RecvHydrodynamicMPI (HydrodynamicID, Source, Window, InitialField, !Recieves Continous Compute call MPI_Recv (FatherContinous, 1, MPI_LOGICAL, Source, 1000, MPI_COMM_WORLD, status, STAT_CALL) if (STAT_CALL /= SUCCESS_) stop 'RecvHydrodynamicMPI - MohidWater - ERR01' - + !Recieves KLB call MPI_Recv (KLB, 1, MPI_INTEGER, Source, 1001, MPI_COMM_WORLD, status, STAT_CALL) if (STAT_CALL /= SUCCESS_) stop 'RecvHydrodynamicMPI - MohidWater - ERR02' @@ -57656,6 +57817,7 @@ subroutine RecvHydrodynamicMPI (HydrodynamicID, Source, Window, InitialField, !Recieves DT call MPI_Recv (DT, 1, Precision, Source, 1003, MPI_COMM_WORLD, status, STAT_CALL) if (STAT_CALL /= SUCCESS_) stop 'RecvHydrodynamicMPI - MohidWater - ERR04' + call TestSubModelOptionsConsistence (FatherContinous) @@ -57692,7 +57854,7 @@ subroutine RecvHydrodynamicMPI (HydrodynamicID, Source, Window, InitialField, WetFaces_VFather = 0 Faces3D_UFather = 0 Faces3D_VFather = 0 - + endif call SetMatrixValue(Me%SubModel%DUZ_Old, Me%Size, Me%SubModel%DUZ_New) @@ -57701,6 +57863,7 @@ subroutine RecvHydrodynamicMPI (HydrodynamicID, Source, Window, InitialField, !Receives LastIteration call MPI_Recv (AuxTime, 6, Precision, Source, 1004, MPI_COMM_WORLD, status, STAT_CALL) if (STAT_CALL /= SUCCESS_) stop 'RecvHydrodynamicMPI - MohidWater - ERR05' + call SetDate (LastIteration, AuxTime(1), AuxTime(2), AuxTime(3), AuxTime(4), AuxTime(5), AuxTime(6)) @@ -57711,13 +57874,14 @@ subroutine RecvHydrodynamicMPI (HydrodynamicID, Source, Window, InitialField, call MPI_Recv (UFather(ILB:IUB, JLB:JUB+1, KLB:KUB), iSize, Precision, & Source, 1005, MPI_COMM_WORLD, status, STAT_CALL) if (STAT_CALL /= SUCCESS_) stop 'RecvHydrodynamicMPI - MohidWater - ERR06' + !VFather iSize = (IUB+1-ILB+1) * (JUB-JLB+1) * (KUB-KLB+1) call MPI_Recv (VFather(ILB:IUB+1, JLB:JUB, KLB:KUB), iSize, Precision, & Source, 1006, MPI_COMM_WORLD, status, STAT_CALL) if (STAT_CALL /= SUCCESS_) stop 'RecvHydrodynamicMPI - MohidWater - ERR07' - + !FluxXFather iSize = (IUB-ILB+1) * (JUB+1-JLB+1) * (KUB-KLB+1) @@ -57745,14 +57909,14 @@ subroutine RecvHydrodynamicMPI (HydrodynamicID, Source, Window, InitialField, call MPI_Recv (Open3DFather(ILB:IUB, JLB:JUB, KLB:KUB), iSize, MPI_INTEGER, & Source, 1010, MPI_COMM_WORLD, status, STAT_CALL) if (STAT_CALL /= SUCCESS_) stop 'RecvHydrodynamicMPI - MohidWater - ERR11' - + !Faces3D_UFather iSize = (IUB-ILB+1) * (JUB+1-JLB+1) * (KUB-KLB+1) call MPI_Recv (Faces3D_UFather(ILB:IUB, JLB:JUB+1, KLB:KUB), iSize, MPI_INTEGER,& Source, 1011, MPI_COMM_WORLD, status, STAT_CALL) if (STAT_CALL /= SUCCESS_) stop 'RecvHydrodynamicMPI - MohidWater - ERR12' - + !Faces3D_VFather iSize = (IUB+1-ILB+1) * (JUB-JLB+1) * (KUB-KLB+1) @@ -57764,27 +57928,28 @@ subroutine RecvHydrodynamicMPI (HydrodynamicID, Source, Window, InitialField, !WetFaces_UFather iSize = (IUB-ILB+1) * (JUB+1-JLB+1) * (KUB-KLB+1) call MPI_Recv (WetFaces_UFather(ILB:IUB, JLB:JUB+1, KLB:KUB), iSize, MPI_INTEGER,& - Source, 1011, MPI_COMM_WORLD, status, STAT_CALL) + Source, 1013, MPI_COMM_WORLD, status, STAT_CALL) if (STAT_CALL /= SUCCESS_) stop 'RecvHydrodynamicMPI - MohidWater - ERR14' - + !WetFaces_VFather iSize = (IUB+1-ILB+1) * (JUB-JLB+1) * (KUB-KLB+1) call MPI_Recv (WetFaces_VFather(ILB:IUB+1, JLB:JUB, KLB:KUB), iSize, MPI_INTEGER,& - Source, 1012, MPI_COMM_WORLD, status, STAT_CALL) + Source, 1014, MPI_COMM_WORLD, status, STAT_CALL) if (STAT_CALL /= SUCCESS_) stop 'RecvHydrodynamicMPI - MohidWater - ERR15' - + !DUZFather iSize = (IUB-ILB+1) * (JUB+1-JLB+1) * (KUB-KLB+1) call MPI_Recv (DUZFather(ILB:IUB, JLB:JUB+1, KLB:KUB), iSize, Precision, & - Source, 1013, MPI_COMM_WORLD, status, STAT_CALL) + Source, 1015, MPI_COMM_WORLD, status, STAT_CALL) if (STAT_CALL /= SUCCESS_) stop 'RecvHydrodynamicMPI - MohidWater - ERR16' + !DVZFather iSize = (IUB+1-ILB+1) * (JUB-JLB+1) * (KUB-KLB+1) call MPI_Recv (DVZFather(ILB:IUB+1, JLB:JUB, KLB:KUB), iSize, Precision, & - Source, 1014, MPI_COMM_WORLD, status, STAT_CALL) + Source, 1016, MPI_COMM_WORLD, status, STAT_CALL) if (STAT_CALL /= SUCCESS_) stop 'RecvHydrodynamicMPI - MohidWater - ERR17' diff --git a/Software/MOHIDWater/ModuleLagrangianGlobal.F90 b/Software/MOHIDWater/ModuleLagrangianGlobal.F90 index 40edf8ffb..c9b4ade30 100644 --- a/Software/MOHIDWater/ModuleLagrangianGlobal.F90 +++ b/Software/MOHIDWater/ModuleLagrangianGlobal.F90 @@ -15674,15 +15674,15 @@ subroutine MoveParticHorizontal (CurrentOrigin, ThicknessGradient, Fay, Spreadin !Begin----------------------------------------------------------------------------------------- if (Me%State%Oil) then - call GetOilViscCin(OilID = CurrentOrigin%ObjOil, & - OilViscCin = OilViscCin, & + call GetOilViscCin(OilID = CurrentOrigin%ObjOil, & + OilViscCin = OilViscCin, & STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) stop 'MoveParticHorizontal - ModuleLagrangianGlobal - ERR01' !next property needed for rising velocity, method Zheng - If (CurrentOrigin%MethodFloatVel .EQ. Zheng_) then - call GetOWInterfacialTension(CurrentOrigin%ObjOil, & - OWInterfacialTension = OWInterfacialTension, & + If (CurrentOrigin%MethodFloatVel .EQ. Zheng_) then + call GetOWInterfacialTension(CurrentOrigin%ObjOil, & + OWInterfacialTension = OWInterfacialTension, & STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) stop 'MoveParticHorizontal - ModuleLagrangianGlobal - ERR02' @@ -15775,9 +15775,10 @@ subroutine MoveParticHorizontal (CurrentOrigin, ThicknessGradient, Fay, Spreadin U = CurrentPartic%CurrentX V = CurrentPartic%CurrentY - if (CurrentOrigin%Movement%Float) then - GradDWx = 0.0 - GradDWy = 0.0 + if (CurrentOrigin%Movement%Float) then + !Equal probability to go in any horizontal direction + GradDWx = 0.5 + GradDWy = 0.5 else !Spagnol et al. (Mar. Ecol. Prog. Ser., 235, 299-302, 2002). !Linear Interpolation to obtain the thickness gradient diff --git a/Software/MOHIDWater/ModuleModel.F90 b/Software/MOHIDWater/ModuleModel.F90 index 19e988bdf..4cde03540 100644 --- a/Software/MOHIDWater/ModuleModel.F90 +++ b/Software/MOHIDWater/ModuleModel.F90 @@ -213,6 +213,7 @@ Module ModuleModel !character(StringLength), dimension(:), pointer :: ModelNames character(StringLength) :: ModelName = null_str + integer :: ModelType = MOHIDWATER_ integer :: NumberOfModels = 0 integer :: MPI_ID = null_int @@ -390,6 +391,7 @@ subroutine ConstructModel (LagInstance, ModelNames, NumberOfModels, !Stores name Me%ModelName = trim(ModelNames(Me%InstanceID)) + Me%ModelType = MOHIDWATER_ #ifndef _OUTPUT_OFF_ write(*, *)"-------------------------- MODEL -------------------------" @@ -987,6 +989,7 @@ subroutine ConstructModel (LagInstance, ModelNames, NumberOfModels, if (STAT_CALL /= SUCCESS_) stop 'ConstructModel - ModuleModel - ERR440' call StartAtmosphere(ModelName = trim(Me%ModelName),& + ModelType = Me%ModelType, & AtmosphereID = Me%ObjAtmosphere, & TimeID = Me%ObjTime, & GridDataID = Me%Water%ObjBathymetry, & diff --git a/Software/MOHIDWater/ModuleSequentialAssimilation.F90 b/Software/MOHIDWater/ModuleSequentialAssimilation.F90 index fa31087e4..1948750f5 100644 --- a/Software/MOHIDWater/ModuleSequentialAssimilation.F90 +++ b/Software/MOHIDWater/ModuleSequentialAssimilation.F90 @@ -340,7 +340,7 @@ Module ModuleSequentialAssimilation real(8), dimension(:, :, :), pointer :: VolumeZ => null() !initialization: Carina real(8), dimension(:, :, :), pointer :: VolumeU => null() !initialization: Carina real(8), dimension(:, :, :), pointer :: VolumeV => null() !initialization: Carina - real(8), dimension(:, :, :), pointer :: VolumeV => null() !initialization: Carina + !real(8), dimension(:, :, :), pointer :: VolumeV => null() !initialization: Carina end type T_FullState private :: T_Files @@ -5039,9 +5039,9 @@ subroutine SEEKAnalysis deallocate (Aux3) deallocate (Aux4) - !Reference: Hoteit, Ibrahim, 2001, Filtres de Kalman Réduits Efficaces pour - ! l'Assimilation de Données en Oceanographie, Thčse de Docteur en - ! Mathématiques Appliquées de l'Université de Joseph Fourrier + !Reference: Hoteit, Ibrahim, 2001, Filtres de Kalman Rļæ½duits Efficaces pour + ! l'Assimilation de Donnļæ½es en Oceanographie, Thļæ½se de Docteur en + ! Mathļæ½matiques Appliquļæ½es de l'Universitļæ½ de Joseph Fourrier end subroutine SEEKAnalysis diff --git a/Software/MOHIDWater/ModuleTurbulence.F90 b/Software/MOHIDWater/ModuleTurbulence.F90 index e062ea439..6c9fc8e2d 100644 --- a/Software/MOHIDWater/ModuleTurbulence.F90 +++ b/Software/MOHIDWater/ModuleTurbulence.F90 @@ -1667,7 +1667,7 @@ subroutine TurbulenceOptions Me%ObjEnterData, flag, & SearchType = FromFile, & keyword = 'READ_CONTINUOUS_FORMAT', & - Default = DefaultFormat, & + Default = HDF5_, & ClientModule ='Turbulence', & STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & @@ -1691,7 +1691,7 @@ subroutine TurbulenceOptions Me%ObjEnterData, flag, & SearchType = FromFile, & keyword = 'WRITE_CONTINUOUS_FORMAT', & - Default = DefaultFormat, & + Default = HDF5_, & ClientModule ='Turbulence', & STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & @@ -1718,7 +1718,7 @@ subroutine TurbulenceOptions Me%ObjEnterData, flag, & SearchType = FromFile, & keyword = 'CONTINUOUS_FORMAT', & - Default = DefaultFormat, & + Default = HDF5_, & ClientModule ='Turbulence', & STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & diff --git a/Software/MOHIDWater/ModuleWaterProperties.F90 b/Software/MOHIDWater/ModuleWaterProperties.F90 index 35f20eddf..1527dd40c 100644 --- a/Software/MOHIDWater/ModuleWaterProperties.F90 +++ b/Software/MOHIDWater/ModuleWaterProperties.F90 @@ -263,7 +263,7 @@ Module ModuleWaterProperties ComputeT90_Canteras, SetMatrixValue, CHUNK_J, CHUNK_K, & InterpolateProfileR8, TimeToString, ChangeSuffix, & ExtraPol3DNearestCell, ConstructPropertyIDOnFly, Pad, & - TwoWayAssimilation3D, TwoWayAssimilation2D!Joćo Sobrinho + TwoWayAssimilation!Joćo Sobrinho use mpi #else _USE_MPI use ModuleFunctions, only: SigmaLeendertse, SigmaUNESCO, SigmaWang, & @@ -276,7 +276,7 @@ Module ModuleWaterProperties ComputeT90_Canteras, SetMatrixValue, CHUNK_J, CHUNK_K, & InterpolateProfileR8, TimeToString, ChangeSuffix, & ExtraPol3DNearestCell, ConstructPropertyIDOnFly, Pad, & - TwoWayAssimilation3D, TwoWayAssimilation2D!Joćo Sobrinho + TwoWayAssimilation!Joćo Sobrinho #endif _USE_MPI use ModuleTurbulence, only: GetHorizontalViscosity, GetVerticalDiffusivity, & @@ -356,7 +356,7 @@ Module ModuleWaterProperties private :: ConstructCohortList private :: AddCohort private :: ConstructCohort - private :: Construct_CohortPropertiesFromFile + private :: Construct_CohortPropFromFile private :: ConstructSpeciesSettlement private :: SetSpeciesSettlementProbability private :: UpdateLarvaeDistribution @@ -489,8 +489,8 @@ Module ModuleWaterProperties private :: RemovePropertyFromList private :: AddNewbornsToList private :: ConstructNewBornCohort - private :: Construct_CohortPropertiesFromCohort - private :: Construct_OutputBoxFluxesFromCohort + private :: Construct_CohortPropFromCohort + private :: Construct_OutputBoxesFromCohort private :: UpdateBivalvePropertyList private :: UpdateInterfaceMass private :: BivalveOutput @@ -507,8 +507,8 @@ Module ModuleWaterProperties private :: ModifySpecificHeat private :: ModifyTwoWay private :: UpdateFatherModelWP - private :: Get2wayData - private :: UnGet2wayData + private :: GetMapInformation + private :: UngetMapInformation private :: OutPut_Results_HDF private :: OutPut_SurfaceResults_HDF private :: OutPut_TimeSeries @@ -928,7 +928,7 @@ Module ModuleWaterProperties real :: OffSet = FillValueReal logical :: TimeSerie = .false. logical :: OutputHDF = .false. - logical :: OutputReal4 = .false. !Joćo Sobrinho + logical :: OutputReal4 = .true. !Joćo Sobrinho logical :: OutputSurfaceHDF = .false. logical :: OutputProfile = .false. logical :: OutputHDFSedVel = .false. @@ -1136,7 +1136,6 @@ Module ModuleWaterProperties logical :: XZFlow = .false. logical :: Backtracking = .false. real, pointer, dimension(:,:,:) :: TotSonVolInFather ! Joćo Sobrinho - real, pointer, dimension(:,:) :: TotSonVolInFather2D ! Joćo Sobrinho real, pointer, dimension(:,:) :: Corners ! Joćo Sobrinho real, pointer, dimension(:,:,:) :: Aux2Way ! Joćo Sobrinho end type T_External @@ -1180,8 +1179,9 @@ Module ModuleWaterProperties integer :: MPI_ID = FillValueInt logical :: ON = .true. logical :: MasterOrSlave = .false. - type (T_Size2D) :: WindowLimitsJI + type (T_Size2D) :: HaloMap type (T_Size2D) :: Mapping + type (T_Size2D) :: Global end type T_DDecomp type T_NoFlux @@ -1627,9 +1627,19 @@ subroutine StartOutputBoxFluxes KLB = Me%Size%KLB KUB = Me%Size%KUB - !Keyword: BOXFLUXES + ! + !Keyword : BOXFLUXES + ! ! This keyword have two functions if exist fluxes between boxes are compute ! and the value read is the name file where the boxes are defined + ! + ! + !Type : Character + !Default : Do not have + !File keyword : SEDPROP + !Multiple Options : Do not have + !Search Type : From File + ! call GetData(Me%Files%BoxesFile, & Me%ObjEnterData, iflag, & @@ -2004,6 +2014,7 @@ subroutine ConstructDDecomp call GetDDecompParameters(HorizontalGridID = Me%ObjHorizontalGrid, & MasterOrSlave = Me%DDecomp%MasterOrSlave, & + Global = Me%DDecomp%Global, & STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) call CloseAllAndStop ('ConstructDDecomp - ModuleWaterProperties - ERR10') @@ -2012,7 +2023,7 @@ subroutine ConstructDDecomp ifMS: if (Me%DDecomp%MasterOrSlave) then call GetDDecompWorkSize2D(HorizontalGridID = Me%ObjHorizontalGrid, & - WorkSize = Me%DDecomp%WindowLimitsJI, & + WorkSize = Me%DDecomp%HaloMap, & STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) call CloseAllAndStop ('ConstructDDecomp - ModuleWaterProperties - ERR20') @@ -2397,7 +2408,7 @@ subroutine ConstructSpecies (NewSpecies, ClientNumber) call CloseAllAndStop ('ConstructSpecies - ModuleWaterProperties - ERR220') if(NewSpecies%Old)then - call ConstructCohortListFromRestartFile(NewSpecies) + call ConstructCohortFromRestart(NewSpecies) else call ConstructCohortList(NewSpecies, ClientNumber) endif @@ -2482,7 +2493,7 @@ end subroutine ConstructSpeciesSettlement !-------------------------------------------------------------------------- - subroutine ConstructCohortListFromRestartFile(NewSpecies) + subroutine ConstructCohortFromRestart(NewSpecies) !Arguments------------------------------------------------------------- type (T_Species), pointer :: NewSpecies @@ -2517,12 +2528,12 @@ subroutine ConstructCohortListFromRestartFile(NewSpecies) call ConstructHDF5 (ObjHDF5, & trim(Me%Files%InitialWaterProperties)//"5",& HDF5_READ, STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_)call CloseAllAndStop ('ConstructCohortListFromRestartFile - ModuleWaterProperties - ERR01') + if (STAT_CALL /= SUCCESS_)call CloseAllAndStop ('ConstructCohortFromRestart - ModuleWaterProperties - ERR01') call GetHDF5GroupNumberOfItems(ObjHDF5, "/Concentration", nProperties, STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_)call CloseAllAndStop ('ConstructCohortListFromRestartFile - ModuleWaterProperties - ERR10') + if (STAT_CALL /= SUCCESS_)call CloseAllAndStop ('ConstructCohortFromRestart - ModuleWaterProperties - ERR10') - if(nProperties == 0)call CloseAllAndStop ('ConstructCohortListFromRestartFile - ModuleWaterProperties - ERR20') + if(nProperties == 0)call CloseAllAndStop ('ConstructCohortFromRestart - ModuleWaterProperties - ERR20') SpeciesNameLength = len_trim(NewSpecies%ID%Name) @@ -2532,7 +2543,7 @@ subroutine ConstructCohortListFromRestartFile(NewSpecies) call GetHDF5GroupID(ObjHDF5, "/Concentration", iProp, PropertyName, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - call CloseAllAndStop ('ConstructCohortListFromRestartFile - ModuleWaterProperties - ERR10') + call CloseAllAndStop ('ConstructCohortFromRestart - ModuleWaterProperties - ERR10') PropertyNameLength = len_trim(PropertyName) @@ -2580,7 +2591,7 @@ subroutine ConstructCohortListFromRestartFile(NewSpecies) call KillHDF5 (ObjHDF5, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - call CloseAllAndStop ('ConstructCohortListFromRestartFile - ModuleWaterProperties - ERR100') + call CloseAllAndStop ('ConstructCohortFromRestart - ModuleWaterProperties - ERR100') elseif(.not. EXIST)then @@ -2591,11 +2602,11 @@ subroutine ConstructCohortListFromRestartFile(NewSpecies) write(*,*)"continue calculation of bivalve cohorts from: " write(*,*)trim(NewSpecies%ID%Name) write(*,*)"Please see and correct keyword EUL_INI in nomfich.dat file." - call CloseAllAndStop ('ConstructCohortListFromRestartFile - ModuleWaterProperties - ERR100') + call CloseAllAndStop ('ConstructCohortFromRestart - ModuleWaterProperties - ERR100') endif - end subroutine ConstructCohortListFromRestartFile + end subroutine ConstructCohortFromRestart !-------------------------------------------------------------------------- @@ -2704,6 +2715,7 @@ subroutine ConstructCohort(Species, NewCohort) type(T_Property), pointer :: NewProperty ! character(LEN = StringLength) :: CohortPropName character(len=5) :: CohortIDStr + integer :: MassConservation !Begin----------------------------------------------------------------- @@ -2730,11 +2742,11 @@ subroutine ConstructCohort(Species, NewCohort) IsVectorial = .false., & Units = trim(Species%ID%Units)) - call Construct_CohortPropertiesFromFile (NewProperty, Species, 'LENGTH') + call Construct_CohortPropFromFile (NewProperty, Species, 'LENGTH') !CohortPropName = 'LENGTH' !NewProperty%ID%Name = trim(adjustl(NewCohort%ID%Name))//" length" - !call Construct_CohortPropertiesFromFile (NewProperty, Species, trim(CohortPropName)) + !call Construct_CohortPropFromFile (NewProperty, Species, trim(CohortPropName)) nullify(NewProperty) @@ -2749,11 +2761,11 @@ subroutine ConstructCohort(Species, NewCohort) IsVectorial = .false., & Units = trim(Species%ID%Units)) - call Construct_CohortPropertiesFromFile (NewProperty, Species, 'STRUCTURE') + call Construct_CohortPropFromFile (NewProperty, Species, 'STRUCTURE') !CohortPropName = 'STRUCTURE' !NewProperty%ID%Name = trim(adjustl(NewCohort%ID%Name))//" structure" - !call Construct_CohortPropertiesFromFile (NewProperty, Species, trim(CohortPropName)) + !call Construct_CohortPropFromFile (NewProperty, Species, trim(CohortPropName)) nullify(NewProperty) @@ -2768,11 +2780,11 @@ subroutine ConstructCohort(Species, NewCohort) IsVectorial = .false., & Units = trim(Species%ID%Units)) - call Construct_CohortPropertiesFromFile (NewProperty, Species, 'RESERVES') + call Construct_CohortPropFromFile (NewProperty, Species, 'RESERVES') !CohortPropName = 'RESERVES' !NewProperty%ID%Name = trim(adjustl(NewCohort%ID%Name))//" reserves" - !call Construct_CohortPropertiesFromFile (NewProperty, Species, trim(CohortPropName)) + !call Construct_CohortPropFromFile (NewProperty, Species, trim(CohortPropName)) nullify(NewProperty) @@ -2787,11 +2799,11 @@ subroutine ConstructCohort(Species, NewCohort) IsVectorial = .false., & Units = trim(Species%ID%Units)) - call Construct_CohortPropertiesFromFile (NewProperty, Species, 'MATURITY') + call Construct_CohortPropFromFile (NewProperty, Species, 'MATURITY') !~ CohortPropName = 'MATURITY' !~ NewProperty%ID%Name = trim(adjustl(NewCohort%ID%Name))//" maturity" -!~ call Construct_CohortPropertiesFromFile (NewProperty, Species, trim(CohortPropName)) +!~ call Construct_CohortPropFromFile (NewProperty, Species, trim(CohortPropName)) nullify(NewProperty) @@ -2806,11 +2818,11 @@ subroutine ConstructCohort(Species, NewCohort) IsVectorial = .false., & Units = trim(Species%ID%Units)) - call Construct_CohortPropertiesFromFile (NewProperty, Species, 'REPRODUCTION') + call Construct_CohortPropFromFile (NewProperty, Species, 'REPRODUCTION') !~ CohortPropName = 'REPRODUCTION' !~ NewProperty%ID%Name = trim(adjustl(NewCohort%ID%Name))//" reproduction" -!~ call Construct_CohortPropertiesFromFile (NewProperty, Species, trim(CohortPropName)) +!~ call Construct_CohortPropFromFile (NewProperty, Species, trim(CohortPropName)) nullify(NewProperty) @@ -2825,11 +2837,11 @@ subroutine ConstructCohort(Species, NewCohort) IsVectorial = .false., & Units = trim(Species%ID%Units)) - call Construct_CohortPropertiesFromFile (NewProperty, Species, 'AGE') + call Construct_CohortPropFromFile (NewProperty, Species, 'AGE') !~ CohortPropName = 'AGE' !~ NewProperty%ID%Name = trim(adjustl(NewCohort%ID%Name))//" age" -!~ call Construct_CohortPropertiesFromFile (NewProperty, Species, trim(CohortPropName)) +!~ call Construct_CohortPropFromFile (NewProperty, Species, trim(CohortPropName)) NewProperty%Evolution%AdvectionDiffusion = .false. !age has no advection-diffusion nullify(NewProperty) @@ -2845,17 +2857,24 @@ subroutine ConstructCohort(Species, NewCohort) IsVectorial = .false., & Units = trim(Species%ID%Units)) - call Construct_CohortPropertiesFromFile (NewProperty, Species, 'NUMBER') + call Construct_CohortPropFromFile (NewProperty, Species, 'NUMBER') !~ CohortPropName = 'NUMBER' !~ NewProperty%ID%Name = trim(adjustl(NewCohort%ID%Name))//" number" -!~ call Construct_CohortPropertiesFromFile (NewProperty, Species, trim(CohortPropName)) +!~ call Construct_CohortPropFromFile (NewProperty, Species, trim(CohortPropName)) Me%Coupled%MinimumConcentration%Yes = ON NewProperty%Evolution%MinConcentration = ON NewProperty%MinValue = 0.0 + call GetBoundaryConditionList(MassConservation = MassConservation) + + NewProperty%Evolution%Advec_Difus_Parameters%DecayTime = 1440.0 + NewProperty%Evolution%Advec_Difus_Parameters%BoundaryCondition = MassConservation + nullify(NewProperty) + + end subroutine ConstructCohort @@ -2915,7 +2934,7 @@ end subroutine AllocateAuxLarvae !-------------------------------------------------------------------------- - subroutine Construct_CohortPropertiesFromFile (NewProperty, Species, OverrideKeyword) + subroutine Construct_CohortPropFromFile (NewProperty, Species, OverrideKeyword) !Arguments------------------------------------------------------------- type(T_property), pointer :: NewProperty @@ -3007,14 +3026,14 @@ subroutine Construct_CohortPropertiesFromFile (NewProperty, Species, OverrideKey if (NewProperty%evolution%AdvectionDiffusion) & call Read_Advec_Difus_Parameters(NewProperty) - NewProperty%Evolution%MinConcentration = .false. + NewProperty%Evolution%MinConcentration = .true. NewProperty%Evolution%MaxConcentration = .false. - NewProperty%MinValue = FillValueReal + NewProperty%MinValue = 0.0 NewProperty%MaxValue = - FillValueReal allocate(NewProperty%Mass_Created(ILB:IUB, JLB:JUB, KLB:KUB), STAT = STAT_CALL) if (STAT_CALL .NE. SUCCESS_) & - call CloseAllAndStop ('Subroutine Construct_CohortPropertiesFromFile - ModuleWaterProperties - ERR10') + call CloseAllAndStop ('Subroutine Construct_CohortPropFromFile - ModuleWaterProperties - ERR10') NewProperty%Mass_Created(:,:,:) = 0. @@ -3026,11 +3045,11 @@ subroutine Construct_CohortPropertiesFromFile (NewProperty, Species, OverrideKey call GetComputeTimeStep(Me%ObjTime, ModelDT, STAT = STAT_CALL) if (STAT_CALL .NE. SUCCESS_) & - call CloseAllAndStop ('Subroutine Construct_CohortPropertiesFromFile - ModuleWaterProperties - ERR300') + call CloseAllAndStop ('Subroutine Construct_CohortPropFromFile - ModuleWaterProperties - ERR300') call GetVariableDT (Me%ObjTime, VariableDT, STAT = STAT_CALL) if (STAT_CALL .NE. SUCCESS_) & - call CloseAllAndStop ('Subroutine Construct_CohortPropertiesFromFile - ModuleWaterProperties - ERR310') + call CloseAllAndStop ('Subroutine Construct_CohortPropFromFile - ModuleWaterProperties - ERR310') if (VariableDT) then @@ -3044,7 +3063,7 @@ subroutine Construct_CohortPropertiesFromFile (NewProperty, Species, OverrideKey if (NewProperty%evolution%DTInterval < (ModelDT)) then write(*,*) write(*,*) ' Time step error.' - call CloseAllAndStop ('Subroutine Construct_CohortPropertiesFromFile - ModuleWaterProperties - ERR330') + call CloseAllAndStop ('Subroutine Construct_CohortPropFromFile - ModuleWaterProperties - ERR330') elseif (NewProperty%evolution%DTInterval > (ModelDT)) then @@ -3055,7 +3074,7 @@ subroutine Construct_CohortPropertiesFromFile (NewProperty, Species, OverrideKey if (Erroraux /= 0) then write(*,*) write(*,*) ' Time step error.' - call CloseAllAndStop ('Subroutine Construct_CohortPropertiesFromFile - ModuleWaterProperties - ERR340') + call CloseAllAndStop ('Subroutine Construct_CohortPropFromFile - ModuleWaterProperties - ERR340') endif ! Run period in seconds @@ -3068,7 +3087,7 @@ subroutine Construct_CohortPropertiesFromFile (NewProperty, Species, OverrideKey if (ErrorAux /= 0) then write(*,*) write(*,*) ' Time step error.' - call CloseAllAndStop ('Subroutine Construct_CohortPropertiesFromFile - ModuleWaterProperties - ERR350') + call CloseAllAndStop ('Subroutine Construct_CohortPropFromFile - ModuleWaterProperties - ERR350') endif NewProperty%Evolution%HydroIntegration = .true. @@ -3097,7 +3116,7 @@ subroutine Construct_CohortPropertiesFromFile (NewProperty, Species, OverrideKey #else allocate(NewProperty%Concentration(ILB:Pad(ILB, IUB), JLB:JUB, KLB:KUB), STAT = STAT_CALL) if (STAT_CALL .NE. SUCCESS_) & - call CloseAllAndStop ('Construct_CohortPropertiesFromFile - ModuleWaterProperties - ERR10') + call CloseAllAndStop ('Construct_CohortPropFromFile - ModuleWaterProperties - ERR10') #endif NewProperty%Concentration(:,:,:) = FillValueReal @@ -3106,7 +3125,7 @@ subroutine Construct_CohortPropertiesFromFile (NewProperty, Species, OverrideKey allocate (NewProperty%Assimilation%Field(ILB:IUB, JLB:JUB, KLB:KUB), STAT = STAT_CALL) if (STAT_CALL .NE. SUCCESS_) & - call CloseAllAndStop ('Construct_CohortPropertiesFromFile - ModuleWaterProperties - ERR30') + call CloseAllAndStop ('Construct_CohortPropFromFile - ModuleWaterProperties - ERR30') NewProperty%Assimilation%Field(:,:,:) = FillValueReal !endif @@ -3129,14 +3148,14 @@ subroutine Construct_CohortPropertiesFromFile (NewProperty, Species, OverrideKey OverrideValueKeyword = trim(OverrideKeyword), & STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - call CloseAllAndStop ('Construct_CohortPropertiesFromFile - ModuleWaterProperties - ERR110') + call CloseAllAndStop ('Construct_CohortPropFromFile - ModuleWaterProperties - ERR110') call GetDefaultValue(NewProperty%ID%ObjFillMatrix, NewProperty%Scalar, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - call CloseAllAndStop ('Construct_CohortPropertiesFromFile - ModuleWaterProperties - ERR120') + call CloseAllAndStop ('Construct_CohortPropFromFile - ModuleWaterProperties - ERR120') call KillFillMatrix(NewProperty%ID%ObjFillMatrix, STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) call CloseAllAndStop ('Construct_CohortPropertiesFromFile - ModuleWaterProperties - ERR121') + if (STAT_CALL /= SUCCESS_) call CloseAllAndStop ('Construct_CohortPropFromFile - ModuleWaterProperties - ERR121') call CheckFieldConsistence(NewProperty) @@ -3172,7 +3191,7 @@ subroutine Construct_CohortPropertiesFromFile (NewProperty, Species, OverrideKey ClientModule = 'ModuleWaterProperties', & STAT = STAT_CALL) if (STAT_CALL .NE. SUCCESS_) & - call CloseAllAndStop ('Construct_CohortPropertiesFromFile - ModuleWaterProperties - ERR180') + call CloseAllAndStop ('Construct_CohortPropFromFile - ModuleWaterProperties - ERR180') cd4 : if (associated(Me%ExternalVar%BoundaryPoints2D)) then cd2 : if (BoundaryMethod=='EXTERIOR' ) then @@ -3199,7 +3218,7 @@ subroutine Construct_CohortPropertiesFromFile (NewProperty, Species, OverrideKey write(*,*) write(*,*) 'The boundary initialization methods can only be two: ' write(*,*) ' INTERIOR OR EXTERIOR' - call CloseAllAndStop ('Construct_CohortPropertiesFromFile - ModuleWaterProperties - ERR190') + call CloseAllAndStop ('Construct_CohortPropFromFile - ModuleWaterProperties - ERR190') end if cd2 @@ -3217,7 +3236,7 @@ subroutine Construct_CohortPropertiesFromFile (NewProperty, Species, OverrideKey Me%Bivalve%nPropertiesFromBivalve = Me%Bivalve%nPropertiesFromBivalve + 1 - end subroutine Construct_CohortPropertiesFromFile + end subroutine Construct_CohortPropFromFile !---------------------------------------------------------------------------- @@ -3241,8 +3260,10 @@ subroutine ConstructNewBornCohort (Species, NewCohort) NewCohort%ID%Name = trim(adjustl(Species%ID%Name))//" cohort "//trim(adjustl(CohortIDStr)) write(*,*)trim(adjustl(NewCohort%ID%Name)) - call AllocateAuxLarvae(NewCohort) - + if (Species%LarvaeTransport) then + call AllocateAuxLarvae(NewCohort) + end if + !Newborns properties, from bivalve? call GetBivalveNewBornParameters (Bivalve_ID = Me%ObjBivalve, & SpeciesIDNumber = Species%ID%IDNumber, & @@ -3268,11 +3289,11 @@ subroutine ConstructNewBornCohort (Species, NewCohort) IsVectorial = .false., & Units = trim(Species%ID%Units)) - call Construct_CohortPropertiesFromCohort (NewProperty, Species, 'LENGTH') + call Construct_CohortPropFromCohort (NewProperty, Species, 'LENGTH') !~ CohortPropName = 'LENGTH' !~ NewProperty%ID%Name = trim(adjustl(NewCohort%ID%Name))//" length" -!~ call Construct_CohortPropertiesFromCohort (NewProperty, Species, trim(CohortPropName)) +!~ call Construct_CohortPropFromCohort (NewProperty, Species, trim(CohortPropName)) Property_L => NewProperty @@ -3289,12 +3310,12 @@ subroutine ConstructNewBornCohort (Species, NewCohort) IsVectorial = .false., & Units = trim(Species%ID%Units)) - call Construct_CohortPropertiesFromCohort (NewProperty, Species, 'STRUCTURE') + call Construct_CohortPropFromCohort (NewProperty, Species, 'STRUCTURE') !~ CohortPropName = 'STRUCTURE' !~ NewProperty%ID%Name = trim(adjustl(NewCohort%ID%Name))//" structure" -!~ call Construct_CohortPropertiesFromCohort (NewProperty, Species, trim(CohortPropName)) +!~ call Construct_CohortPropFromCohort (NewProperty, Species, trim(CohortPropName)) nullify(NewProperty) @@ -3309,12 +3330,12 @@ subroutine ConstructNewBornCohort (Species, NewCohort) IsVectorial = .false., & Units = trim(Species%ID%Units)) - call Construct_CohortPropertiesFromCohort (NewProperty, Species, 'RESERVES') + call Construct_CohortPropFromCohort (NewProperty, Species, 'RESERVES') !~ CohortPropName = 'RESERVES' !~ NewProperty%ID%Name = trim(adjustl(NewCohort%ID%Name))//" reserves" -!~ call Construct_CohortPropertiesFromCohort (NewProperty, Species, trim(CohortPropName)) +!~ call Construct_CohortPropFromCohort (NewProperty, Species, trim(CohortPropName)) nullify(NewProperty) @@ -3329,12 +3350,12 @@ subroutine ConstructNewBornCohort (Species, NewCohort) IsVectorial = .false., & Units = trim(Species%ID%Units)) - call Construct_CohortPropertiesFromCohort (NewProperty, Species, 'MATURITY') + call Construct_CohortPropFromCohort (NewProperty, Species, 'MATURITY') !~ CohortPropName = 'MATURITY' !~ NewProperty%ID%Name = trim(adjustl(NewCohort%ID%Name))//" maturity" -!~ call Construct_CohortPropertiesFromCohort (NewProperty, Species, trim(CohortPropName)) +!~ call Construct_CohortPropFromCohort (NewProperty, Species, trim(CohortPropName)) nullify(NewProperty) @@ -3349,12 +3370,12 @@ subroutine ConstructNewBornCohort (Species, NewCohort) IsVectorial = .false., & Units = trim(Species%ID%Units)) - call Construct_CohortPropertiesFromCohort (NewProperty, Species, 'REPRODUCTION') + call Construct_CohortPropFromCohort (NewProperty, Species, 'REPRODUCTION') !~ CohortPropName = 'REPRODUCTION' !~ NewProperty%ID%Name = trim(adjustl(NewCohort%ID%Name))//" reproduction" -!~ call Construct_CohortPropertiesFromCohort (NewProperty, Species, trim(CohortPropName)) +!~ call Construct_CohortPropFromCohort (NewProperty, Species, trim(CohortPropName)) nullify(NewProperty) @@ -3370,12 +3391,12 @@ subroutine ConstructNewBornCohort (Species, NewCohort) IsVectorial = .false., & Units = trim(Species%ID%Units)) - call Construct_CohortPropertiesFromCohort (NewProperty, Species, 'AGE') + call Construct_CohortPropFromCohort (NewProperty, Species, 'AGE') !~ CohortPropName = 'AGE' !~ NewProperty%ID%Name = trim(adjustl(NewCohort%ID%Name))//" age" -!~ call Construct_CohortPropertiesFromCohort (NewProperty, Species, trim(CohortPropName)) +!~ call Construct_CohortPropFromCohort (NewProperty, Species, trim(CohortPropName)) NewProperty%Evolution%AdvectionDiffusion = .false. !age has no advection-diffusion nullify(NewProperty) @@ -3390,12 +3411,12 @@ subroutine ConstructNewBornCohort (Species, NewCohort) IsVectorial = .false., & Units = trim(Species%ID%Units)) - call Construct_CohortPropertiesFromCohort (NewProperty, Species, 'NUMBER') + call Construct_CohortPropFromCohort (NewProperty, Species, 'NUMBER') !~ CohortPropName = 'NUMBER' !~ NewProperty%ID%Name = trim(adjustl(NewCohort%ID%Name))//" number" -!~ call Construct_CohortPropertiesFromCohort (NewProperty, Species, trim(CohortPropName)) +!~ call Construct_CohortPropFromCohort (NewProperty, Species, trim(CohortPropName)) Me%Coupled%MinimumConcentration%Yes = ON NewProperty%Evolution%MinConcentration = ON @@ -3408,7 +3429,7 @@ subroutine ConstructNewBornCohort (Species, NewCohort) if (Species%CohortBoxTimeSerie) then !create and open the box time serie files for the new properties - call Construct_OutputBoxFluxesFromCohort(NewCohort) + call Construct_OutputBoxesFromCohort(NewCohort) end if @@ -3420,7 +3441,7 @@ end subroutine ConstructNewBornCohort !-------------------------------------------------------------------------- - subroutine Construct_CohortPropertiesFromCohort (NewProperty, Species, CohortPropName) + subroutine Construct_CohortPropFromCohort (NewProperty, Species, CohortPropName) !Arguments------------------------------------------------------------- type(T_property), pointer :: NewProperty @@ -3516,14 +3537,14 @@ subroutine Construct_CohortPropertiesFromCohort (NewProperty, Species, CohortPro NewProperty%Evolution%Advec_Difus_Parameters%VolumeRelMax = 1.5 NewProperty%Evolution%Advec_Difus_Parameters%AdvectionNudging = .false. - NewProperty%Evolution%MinConcentration = .false. + NewProperty%Evolution%MinConcentration = .true. NewProperty%Evolution%MaxConcentration = .false. - NewProperty%MinValue = FillValueReal + NewProperty%MinValue = 0.0 NewProperty%MaxValue = - FillValueReal allocate(NewProperty%Mass_Created(ILB:IUB, JLB:JUB, KLB:KUB), STAT = STAT_CALL) if (STAT_CALL .NE. SUCCESS_) & - call CloseAllAndStop ('Subroutine Construct_CohortPropertiesFromCohort - ModuleWaterProperties - ERR10') + call CloseAllAndStop ('Subroutine Construct_CohortPropFromCohort - ModuleWaterProperties - ERR10') NewProperty%Mass_Created(:,:,:) = 0. @@ -3536,11 +3557,11 @@ subroutine Construct_CohortPropertiesFromCohort (NewProperty, Species, CohortPro call GetComputeTimeStep(Me%ObjTime, ModelDT, STAT = STAT_CALL) if (STAT_CALL .NE. SUCCESS_) & - call CloseAllAndStop ('Subroutine Construct_CohortPropertiesFromCohort - ModuleWaterProperties - ERR00') + call CloseAllAndStop ('Subroutine Construct_CohortPropFromCohort - ModuleWaterProperties - ERR00') call GetVariableDT (Me%ObjTime, VariableDT, STAT = STAT_CALL) if (STAT_CALL .NE. SUCCESS_) & - call CloseAllAndStop ('Subroutine Construct_CohortPropertiesFromCohort - ModuleWaterProperties - ERR10') + call CloseAllAndStop ('Subroutine Construct_CohortPropFromCohort - ModuleWaterProperties - ERR10') if (VariableDT) then @@ -3554,7 +3575,7 @@ subroutine Construct_CohortPropertiesFromCohort (NewProperty, Species, CohortPro if (NewProperty%evolution%DTInterval < (ModelDT)) then write(*,*) write(*,*) ' Time step error.' - call CloseAllAndStop ('Subroutine Construct_CohortPropertiesFromCohort - ModuleWaterProperties - ERR20') + call CloseAllAndStop ('Subroutine Construct_CohortPropFromCohort - ModuleWaterProperties - ERR20') elseif (NewProperty%evolution%DTInterval > (ModelDT)) then @@ -3565,7 +3586,7 @@ subroutine Construct_CohortPropertiesFromCohort (NewProperty, Species, CohortPro if (Erroraux /= 0) then write(*,*) write(*,*) ' Time step error.' - call CloseAllAndStop ('Subroutine Construct_CohortPropertiesFromCohort - ModuleWaterProperties - ERR30') + call CloseAllAndStop ('Subroutine Construct_CohortPropFromCohort - ModuleWaterProperties - ERR30') endif ! Run period in seconds @@ -3578,7 +3599,7 @@ subroutine Construct_CohortPropertiesFromCohort (NewProperty, Species, CohortPro if (ErrorAux /= 0) then write(*,*) write(*,*) ' Time step error.' - call CloseAllAndStop ('Subroutine Construct_CohortPropertiesFromCohort - ModuleWaterProperties - ERR40') + call CloseAllAndStop ('Subroutine Construct_CohortPropFromCohort - ModuleWaterProperties - ERR40') endif NewProperty%Evolution%HydroIntegration = .true. @@ -3608,7 +3629,7 @@ subroutine Construct_CohortPropertiesFromCohort (NewProperty, Species, CohortPro #else allocate(NewProperty%Concentration(ILB:Pad(ILB, IUB), JLB:JUB, KLB:KUB), STAT = STAT_CALL) if (STAT_CALL .NE. SUCCESS_) & - call CloseAllAndStop ('Construct_CohortPropertiesFromCohort - ModuleWaterProperties - ERR50') + call CloseAllAndStop ('Construct_CohortPropFromCohort - ModuleWaterProperties - ERR50') #endif NewProperty%Concentration(:,:,:) = FillValueReal @@ -3617,7 +3638,7 @@ subroutine Construct_CohortPropertiesFromCohort (NewProperty, Species, CohortPro allocate (NewProperty%Assimilation%Field(ILB:IUB, JLB:JUB, KLB:KUB), STAT = STAT_CALL) if (STAT_CALL .NE. SUCCESS_) & - call CloseAllAndStop ('Construct_CohortPropertiesFromCohort - ModuleWaterProperties - ERR60') + call CloseAllAndStop ('Construct_CohortPropFromCohort - ModuleWaterProperties - ERR60') NewProperty%Assimilation%Field(:,:,:) = FillValueReal !endif @@ -3711,11 +3732,11 @@ subroutine Construct_CohortPropertiesFromCohort (NewProperty, Species, CohortPro Me%Bivalve%nPropertiesFromBivalve = Me%Bivalve%nPropertiesFromBivalve + 1 - end subroutine Construct_CohortPropertiesFromCohort + end subroutine Construct_CohortPropFromCohort !-------------------------------------------------------------------------- - subroutine Construct_OutputBoxFluxesFromCohort (NewCohort) + subroutine Construct_OutputBoxesFromCohort (NewCohort) !Arguments-------------------------------------------------------------- type(T_Cohort), pointer :: NewCohort @@ -3735,11 +3756,11 @@ subroutine Construct_OutputBoxFluxesFromCohort (NewCohort) allocate(CohortScalarOutputList(nScalars), STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - call CloseAllAndStop ('Construct_OutputBoxFluxesFromCohort - ModuleWaterProperties - ERR03') + call CloseAllAndStop ('Construct_OutputBoxesFromCohort - ModuleWaterProperties - ERR03') allocate(CohortFluxesOutputList(nFluxes), STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - call CloseAllAndStop ('Construct_OutputBoxFluxesFromCohort - ModuleWaterProperties - ERR04') + call CloseAllAndStop ('Construct_OutputBoxesFromCohort - ModuleWaterProperties - ERR04') CohortScalarOutputList(1) = trim(adjustl(NewCohort%ID%Name))//" structure" CohortScalarOutputList(2) = trim(adjustl(NewCohort%ID%Name))//" reserves" @@ -3757,20 +3778,20 @@ subroutine Construct_OutputBoxFluxesFromCohort (NewCohort) nDimensions = 3, & STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - call CloseAllAndStop ('Construct_OutputBoxFluxesFromCohort - ModuleWaterProperties - ERR07') + call CloseAllAndStop ('Construct_OutputBoxesFromCohort - ModuleWaterProperties - ERR07') deallocate(CohortFluxesOutputList, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - call CloseAllAndStop ('Construct_OutputBoxFluxesFromCohort - ModuleWaterProperties - ERR08') + call CloseAllAndStop ('Construct_OutputBoxesFromCohort - ModuleWaterProperties - ERR08') nullify (CohortFluxesOutputList) deallocate(CohortScalarOutputList, STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - call CloseAllAndStop ('Construct_OutputBoxFluxesFromCohort - ModuleWaterProperties - ERR07') + call CloseAllAndStop ('Construct_OutputBoxesFromCohort - ModuleWaterProperties - ERR07') nullify (CohortScalarOutputList) - end subroutine Construct_OutputBoxFluxesFromCohort + end subroutine Construct_OutputBoxesFromCohort !---------------------------------------------------------------------------- @@ -10154,7 +10175,7 @@ subroutine Construct_PropertyOutPut(NewProperty, ExtractType) call GetData(NewProperty%OutputReal4, & Me%ObjEnterData, iflag, & Keyword = 'OUTPUT_HDF_REAL4', & - Default = .false., & + Default = .true., & SearchType = ExtractType, & ClientModule = 'ModuleWaterProperties', & STAT = STAT_CALL) @@ -10215,10 +10236,23 @@ subroutine Construct_PropertyOutPut(NewProperty, ExtractType) SearchType = ExtractType, & ClientModule = 'ModuleWaterProperties', & STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) call CloseAllAndStop ('Construct_PropertyOutPut - ModuleWaterProperties - ERR02a') + if (STAT_CALL /= SUCCESS_) call CloseAllAndStop ('Construct_PropertyOutPut - ModuleWaterProperties - ERR02') - !Keyword OUTPUT_PROFILE + ! + !Keyword : OUTPUT_PROFILE + ! + ! ! Checks out if the user pretends to write a profile output for this property + ! + ! + !Type : Boolean + !Default : .false. + !File keyword : DISPQUAL + !Multiple Options : Do not have + !Search Type : FromBlock + !Begin Block : + !End Block : + ! call GetData(NewProperty%OutputProfile, & Me%ObjEnterData, iflag, & Keyword = 'OUTPUT_PROFILE', & @@ -10227,9 +10261,19 @@ subroutine Construct_PropertyOutPut(NewProperty, ExtractType) ClientModule = 'ModuleWaterProperties', & STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) call CloseAllAndStop ('Construct_PropertyOutPut - ModuleWaterProperties - ERR03') - - !Keyword: BOX_TIME_SERIE + ! + !Keyword : BOX_TIME_SERIE + ! ! Checks out if the user pretends to write a time serie inside each box for this property + ! + !Type : Boolean + !Default : .false. + !File keyword : DISPQUAL + !Multiple Options : 1 (.true.) , 0 (.false.) + !Search Type : FromBlock + !Begin Block : + !End Block : + ! call GetData(NewProperty%BoxTimeSerie, & Me%ObjEnterData, iflag, & Keyword = 'BOX_TIME_SERIE', & @@ -10252,8 +10296,21 @@ subroutine Construct_PropertyOutPut(NewProperty, ExtractType) endif - !Keyword: STATISTICS + ! + !Keyword : STATISTICS + ! + ! ! Checks out if the user pretends the statistics of this property + ! + ! + !Type : Boolean + !Default : .false. + !File keyword : DISPQUAL + !Multiple Options : Do not have + !Search Type : FromBlock + !Begin Block : + !End Block : + ! call GetData(NewProperty%Statistics, & Me%ObjEnterData, iflag, & Keyword = 'STATISTICS', & @@ -10266,8 +10323,21 @@ subroutine Construct_PropertyOutPut(NewProperty, ExtractType) if (NewProperty%Statistics) then - !Keyword: STATISTICS_FILE + ! + !Keyword : STATISTICS_FILE + ! + ! ! The statistics definition file of this property + ! + ! + !Type : Character + !Default : Do not have + !File keyword : DISPQUAL + !Multiple Options : Do not have + !Search Type : FromBlock + !Begin Block : + !End Block : + ! call GetData(NewProperty%StatisticsFile, & Me%ObjEnterData, iflag, & Keyword = 'STATISTICS_FILE', & @@ -10279,9 +10349,22 @@ subroutine Construct_PropertyOutPut(NewProperty, ExtractType) endif - !Keyword: OUTPUT_HDF_SEDVEL + ! + !Keyword : OUTPUT_HDF_SEDVEL + ! + ! ! Checks out if the user pretends to write a HDF format file for this property ! at the surface layer + ! + ! + !Type : Boolean + !Default : .false. + !File keyword : DISPQUAL + !Multiple Options : Do not have + !Search Type : FromBlock + !Begin Block : + !End Block : + ! call GetData(NewProperty%OutputHDFSedVel, & Me%ObjEnterData, iflag, & Keyword = 'OUTPUT_HDF_SEDVEL', & @@ -10342,11 +10425,11 @@ subroutine ReadOldConcBoundariesHDF(NewProperty) ifMS: if (Me%DDecomp%MasterOrSlave) then - ILW = Me%DDecomp%WindowLimitsJI%ILB - IUW = Me%DDecomp%WindowLimitsJI%IUB + ILW = Me%DDecomp%HaloMap%ILB + IUW = Me%DDecomp%HaloMap%IUB - JLW = Me%DDecomp%WindowLimitsJI%JLB - JUW = Me%DDecomp%WindowLimitsJI%JUB + JLW = Me%DDecomp%HaloMap%JLB + JUW = Me%DDecomp%HaloMap%JUB else ifMS @@ -10641,6 +10724,20 @@ subroutine ConstructDensity !---------------------------------------------------------------------- + ! + !Keyword : REFERENCE_DENSITY + ! + ! + ! Do not have + ! + ! + !Type : Real + !Default : 1026.0 + !File keyword : DISPQUAL + !Multiple Options : Do not have + !Search Type : FromFile + ! + call GetData(Me%Density%Reference, & Me%ObjEnterData, iflag, & SearchType = FromFile, & @@ -10650,6 +10747,20 @@ subroutine ConstructDensity STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_)call CloseAllAndStop ('ConstructDensity - ModuleWaterProperties - ERR10') + ! + !Keyword : DENSITY_METHOD + ! + ! + ! Do not have + ! + ! + !Type : integer + !Default : UNESCOState_ + !File keyword : DISPQUAL + !Multiple Options : Do not have + !Search Type : FromFile + ! + call GetData(Me%Density%Method, & Me%ObjEnterData, iflag, & SearchType = FromFile, & @@ -11059,6 +11170,20 @@ subroutine ConstructSpecificHeat !---------------------------------------------------------------------- + ! + !Keyword : REFERENCE_SPECIFICHEAT + ! + ! + ! Do not have + ! + ! + !Type : Real + !Default : 4200.0 + !File keyword : DISPQUAL + !Multiple Options : Do not have + !Search Type : FromFile + ! + call GetData(Me%SpecificHeat%Reference, & Me%ObjEnterData, iflag, & SearchType = FromFile, & @@ -11068,6 +11193,20 @@ subroutine ConstructSpecificHeat STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) call CloseAllAndStop ('ConstructSpecificHeat - ModuleWaterProperties - ERR01') + ! + !Keyword : SPECIFICHEAT_METHOD + ! + ! + ! Do not have + ! + ! + !Type : integer + !Default : 1 + !File keyword : DISPQUAL + !Multiple Options : Do not have + !Search Type : FromFile + ! + call GetData(Me%SpecificHeat%Method, & Me%ObjEnterData, iflag, & SearchType = FromFile, & @@ -11253,8 +11392,22 @@ subroutine ConstructConvection Me%SmallDepths%ON (:,:) = .false. - !Keyword: SMALLDEPTH_LIMIT + + + ! + !Keyword : SMALLDEPTH_LIMIT + ! + ! ! Water column thickness below which homogeneous water properties is assumed. + ! + ! + !Type : Real + !Default : FillValueReal + !File keyword : DISPQUAL + !Multiple Options : Do not have + !Search Type : FromFile + ! + call GetData(Me%SmallDepths%Limit, & Me%ObjEnterData, & iflag, & @@ -11271,8 +11424,21 @@ subroutine ConstructConvection call SetError(FATAL_, KEYWORD_, "ConstructConvection - WaterProperties - ERR04") end if - !Keyword: FREE_CONVECTION + + ! + !Keyword : FREE_CONVECTION + ! + ! ! This option tend to mixe instable density profiles + ! + ! + !Type : logical + !Default : .false. + !File keyword : DISPQUAL + !Multiple Options : Do not have + !Search Type : FromFile + ! + call GetData(Me%FreeConvection, & Me%ObjEnterData, & iflag, & @@ -11379,11 +11545,11 @@ subroutine Read_Old_Properties_2D(Scalar_2D, PropertyName) ifMS: if (Me%DDecomp%MasterOrSlave) then - ILW = Me%DDecomp%WindowLimitsJI%ILB - IUW = Me%DDecomp%WindowLimitsJI%IUB + ILW = Me%DDecomp%HaloMap%ILB + IUW = Me%DDecomp%HaloMap%IUB - JLW = Me%DDecomp%WindowLimitsJI%JLB - JUW = Me%DDecomp%WindowLimitsJI%JUB + JLW = Me%DDecomp%HaloMap%JLB + JUW = Me%DDecomp%HaloMap%JUB else ifMS @@ -11450,28 +11616,27 @@ subroutine ConstructGlobalOutput if(OutputON)then - CurrentProperty => Me%FirstProperty - do while (associated(CurrentProperty)) - - if(.not. CurrentProperty%OutputReal4) then - Me%WriteHDFReal4 = .false. - exit - endif + CurrentProperty => Me%FirstProperty + do while (associated(CurrentProperty)) + + if(.not. CurrentProperty%OutputReal4) then + Me%WriteHDFReal4 = .false. + exit + endif - CurrentProperty => CurrentProperty%Next + CurrentProperty => CurrentProperty%Next - enddo - !Joćo Sobrinho - if(Me%WriteHDFReal4)then - - nullify(Me%Output%Aux3Dreal4) - allocate(Me%Output%Aux3Dreal4(Me%Size%ILB:Me%Size%IUB,& - Me%Size%JLB:Me%Size%JUB,& - Me%Size%KLB:Me%Size%KUB)) - - Me%Output%Aux3Dreal4(:,:,:) = 0.0 - endif - + enddo + !Joćo Sobrinho + if(Me%WriteHDFReal4)then + + nullify(Me%Output%Aux3Dreal4) + allocate(Me%Output%Aux3Dreal4(Me%Size%ILB:Me%Size%IUB,& + Me%Size%JLB:Me%Size%JUB,& + Me%Size%KLB:Me%Size%KUB)) + + Me%Output%Aux3Dreal4(:,:,:) = 0.0 + endif call GetOutPutTime(Me%ObjEnterData, & CurrentTime = Me%ExternalVar%Now, & @@ -11519,7 +11684,7 @@ subroutine ConstructGlobalOutput OutPutsOn = Me%OutPut%WriteRestartFile, & STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - call CloseAllAndStop ('ConstructGlobalOutput - WaterProperties - ERR03') + call CloseAllAndStop ('ConstructGlobalOutput - WaterProperties - ERR30') if(Me%OutPut%WriteRestartFile)then @@ -11527,8 +11692,19 @@ subroutine ConstructGlobalOutput end if - !Keyword: RESTART_FILE_OVERWRITE + ! + !Keyword : RESTART_FILE_OVERWRITE + ! + ! ! This option checks wether the restart file is to be overwritten or not + ! + ! + !Type : logical + !Default : .true. + !Multiple Options : Do not have + !Search Type : FromFile + ! + call GetData(Me%OutPut%RestartOverwrite, & Me%ObjEnterData, & iflag, & @@ -11576,8 +11752,45 @@ subroutine ConstructGlobalOutput allocate(Me%OutW%ObjHDF5 (Me%OutW%WindowsNumber)) allocate(Me%OutW%OriginalCorners(Me%OutW%WindowsNumber)) + + KLB = Me%WorkSize%KLB + KUB = Me%WorkSize%KUB do iW = 1, Me%OutW%WindowsNumber + + if (Me%DDecomp%MasterOrSlave) then + + ILB = Me%DDecomp%Global%ILB + IUB = Me%DDecomp%Global%IUB + JLB = Me%DDecomp%Global%JLB + JUB = Me%DDecomp%Global%JUB + + else + + ILB = Me%WorkSize%ILB + IUB = Me%WorkSize%IUB + JLB = Me%WorkSize%JLB + JUB = Me%WorkSize%JUB + + endif + + if (Me%OutW%OutPutWindows(iW)%KLB < KLB .or. & + Me%OutW%OutPutWindows(iW)%KUB > KUB) then + + write(*,*) 'cell layers out of the model domain for the output window number',iW + stop 'ConstructGlobalOutput - WaterProperties - ERR65' + + endif + + if (Me%OutW%OutPutWindows(iW)%ILB < ILB .or. & + Me%OutW%OutPutWindows(iW)%IUB > IUB .or. & + Me%OutW%OutPutWindows(iW)%JLB < JLB .or. & + Me%OutW%OutPutWindows(iW)%JUB > JUB) then + + write(*,*) 'cell corners out of the model domain for the output window number',iW + stop 'ConstructGlobalOutput - WaterProperties - ERR70' + + endif Me%OutW%OutPutWindows%NextOutPut = 1 @@ -11628,7 +11841,7 @@ subroutine ConstructGlobalOutput ClientModule = 'ModuleWaterProperties', & STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - call SetError(FATAL_, KEYWORD_, "ConstructGlobalOutput - WaterProperties - ERR70") + call SetError(FATAL_, KEYWORD_, "ConstructGlobalOutput - WaterProperties - ERR80") call GetData(Me%OutPut%Simple, & Me%ObjEnterData, & @@ -11639,7 +11852,7 @@ subroutine ConstructGlobalOutput ClientModule = 'ModuleWaterProperties', & STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) & - call SetError(FATAL_, KEYWORD_, "ConstructGlobalOutput - WaterProperties - ERR80") + call SetError(FATAL_, KEYWORD_, "ConstructGlobalOutput - WaterProperties - ERR90") end subroutine ConstructGlobalOutput @@ -12883,8 +13096,6 @@ end subroutine SetWaterPropFather !-------------------------------------------------------------------------- - !--------------------------------------------------------------------------------------------------- - subroutine ConstructTimeInterpolation(PropertySon, PropFatherVariable, DT_Father) !Arguments------------------------------------------------------------- @@ -18917,7 +19128,7 @@ subroutine ModifyTwoWay (WaterPropertiesID, CurrentTime) type (T_Time) :: CurrentTime integer, intent (IN) :: WaterPropertiesID integer :: FatherWaterpropertiesID - !Locals------------------------------------------------------------------------------- + !Locals integer :: ID, ready_ !Begin------------------------------------------------------------------------------ if (MonitorPerformance) call StartWatch ("ModuleWaterProperties", "ModifyTwoWay") @@ -18982,15 +19193,14 @@ end subroutine ModifyTwoWay !-------------------------------------------------------------------------- subroutine UpdateFatherModelWP(SonWaterPropertiesID, FatherWaterPropertiesID) - !Arguments-------------------------------------------------------------------------------------------- - integer :: SonWaterPropertiesID, FatherWaterPropertiesID - !Local variables-------------------------------------------------------------------------------------- - integer, dimension(:,:), pointer :: IZ, JZ + !Locals---------------------------------------------------------------- + integer :: IUB, ILB, JUB, JLB, KUB, KLB, IUBSon, ILBSon, JUBSon, JLBSon, KUBSon + integer :: KLBSon, SonWaterPropertiesID, STAT_CALL, FatherWaterPropertiesID + integer, dimension(:,:), pointer :: IV, JV integer, dimension(:,:,:), pointer :: Open3DFather, Open3DSon - real, dimension(:,:,:), pointer :: VolumeZSon, VolumeZFather + real(8), dimension(:,:,:), pointer :: VolumeZSon, VolumeZFather type (T_WaterProperties), pointer :: ObjWaterPropertiesSon type (T_Property), pointer :: PropertyX, PropertySon - integer :: STAT_CALL !Begin------------------------------------------------------------------------------ if (MonitorPerformance) call StartWatch ("ModuleWaterProperties", "UpdateFatherModelWP") @@ -18999,10 +19209,39 @@ subroutine UpdateFatherModelWP(SonWaterPropertiesID, FatherWaterPropertiesID) PropertyX => Me%FirstProperty call LocateObjSon(SonWaterPropertiesID, ObjWaterPropertiesSon) !Gets son solution - - call Get2wayData(SonWaterPropertiesID, FatherWaterPropertiesID, IZ, JZ, Open3DFather, Open3DSon, & - VolumeZSon, VolumeZFather) - + + IUB = Me%WorkSize%IUB + ILB = Me%WorkSize%ILB + JUB = Me%WorkSize%JUB + JLB = Me%WorkSize%JLB + KUB = Me%WorkSize%KUB + KLB = Me%WorkSize%KLB + + IUBSon = ObjWaterPropertiesSon%WorkSize%IUB + ILBSon = ObjWaterPropertiesSon%WorkSize%ILB + JUBSon = ObjWaterPropertiesSon%WorkSize%JUB + JLBSon = ObjWaterPropertiesSon%WorkSize%JLB + KUBSon = ObjWaterPropertiesSon%WorkSize%KUB + KLBSon = ObjWaterPropertiesSon%WorkSize%KLB + + call GetMapInformation(SonWaterPropertiesID, FatherWaterPropertiesID, IV, JV, Open3DFather, Open3DSon) + + call GetGeometryVolumes(SonWaterPropertiesID, VolumeZ = VolumeZSon, STAT = STAT_CALL) + if (STAT_CALL .NE. SUCCESS_) call CloseAllAndStop ('UpdateFatherModelWP - ModuleWaterProperties - ERR01') + + call GetGeometryVolumes(FatherWaterPropertiesID, VolumeZ = VolumeZFather, STAT = STAT_CALL) + if (STAT_CALL .NE. SUCCESS_) call CloseAllAndStop ('UpdateFatherModelWP - ModuleWaterProperties - ERR02') + + call Get2WayAuxVariables(FatherWaterPropertiesID, & + SonVolumeInFatherCell = Me%ExternalVar%TotSonVolInFather, & + AuxMatrix = Me%ExternalVar%Aux2Way, & + Corners = Me%ExternalVar%Corners, & + STAT = STAT_CALL) + if (STAT_CALL .NE. SUCCESS_)then + write(*,*) 'Error getting auxiliar Matrixes from hydrodynamic to waterproperties, for 2way' + call CloseAllAndStop ('UpdateFatherModelWP - ModuleWaterProperties - ERR03') + endif + !Assimilates all the properties with twoway option ON do while (associated(PropertyX)) @@ -19012,27 +19251,19 @@ subroutine UpdateFatherModelWP(SonWaterPropertiesID, FatherWaterPropertiesID) if (PropertySon%Submodel%TwoWay)then if(PropertySon%Evolution%NextCompute == PropertyX%Evolution%LastCompute)then - if ((Me%WorkSize%KUB == 1) .or. (ObjWaterPropertiesSon%WorkSize%KUB == 1))then - !Assimilation of son domain into father domain - call TwoWayAssimilation2D(PropertyX%Concentration,PropertySon%Concentration, Open3DFather,& - Open3DSon, Me%WorkSize, ObjWaterPropertiesSon%WorkSize, IZ, JZ, & - PropertySon%Submodel%TwoWayAssimCoef, PropertyX%Evolution%DtInterval, & - Me%ExternalVar%TotSonVolInFather, Me%ExternalVar%Aux2Way, & - Me%ExternalVar%Corners, VolumeZSon, VolumeZFather) - else - call TwoWayAssimilation3D(PropertyX%Concentration,PropertySon%Concentration, Open3DFather,& - Open3DSon, Me%WorkSize, ObjWaterPropertiesSon%WorkSize, IZ, JZ, & - PropertySon%Submodel%TwoWayAssimCoef, PropertyX%Evolution%DtInterval, & - Me%ExternalVar%TotSonVolInFather, Me%ExternalVar%Aux2Way, & - Me%ExternalVar%Corners, VolumeZSon, VolumeZFather) - - endif - endif + !Assimilation of son domain into father domain + call TwoWayAssimilation(PropertyX%Concentration,PropertySon%Concentration, & + Open3DFather, Open3DSon, KUB, KLB, IUBSon, ILBSon, JUBSon, JLBSon, & + KUBSon, KLBSon, IV, JV, PropertySon%Submodel%TwoWayAssimCoef, & + PropertyX%Evolution%DtInterval, Me%ExternalVar%TotSonVolInFather, & + Me%ExternalVar%Aux2Way, Me%ExternalVar%Corners, VolumeZSon, & + VolumeZFather) + endif endif else write(*,*)'Cant find property in submodel for the 2way algorithm' write(*,*)'Property missing = ', trim(PropertySon%ID%Name) - call CloseAllAndStop ('UpdateFatherModelWP - ModuleWaterProperties - ERR05') + call CloseAllAndStop ('UpdateFatherModelWP - ModuleWaterProperties - ERR04') endif nullify (PropertySon) @@ -19041,101 +19272,85 @@ subroutine UpdateFatherModelWP(SonWaterPropertiesID, FatherWaterPropertiesID) enddo nullify (PropertyX) + + call UngetHydrodynamic(FatherWaterPropertiesID, Me%ExternalVar%TotSonVolInFather, STAT = STAT_CALL) + if (STAT_CALL /= SUCCESS_) call CloseAllAndStop ('UpdateFatherModelWP - ModuleWaterProperties - ERR05') + + call UngetHydrodynamic(FatherWaterPropertiesID, Me%ExternalVar%Aux2Way, STAT = STAT_CALL) + if (STAT_CALL /= SUCCESS_) call CloseAllAndStop ('UpdateFatherModelWP - ModuleWaterProperties - ERR06') + + call UngetHydrodynamic(FatherWaterPropertiesID, Me%ExternalVar%Corners, STAT = STAT_CALL) + if (STAT_CALL /= SUCCESS_) call CloseAllAndStop ('UpdateFatherModelWP - ModuleWaterProperties - ERR07') - call UnGet2wayData(SonWaterPropertiesID, FatherWaterPropertiesID, IZ, JZ, Open3DFather, Open3DSon, & - VolumeZSon, VolumeZFather) + call UngetMapInformation(SonWaterPropertiesID, FatherWaterPropertiesID, IV, JV, Open3DFather, Open3DSon) + + call UnGetGeometry(SonWaterPropertiesID, VolumeZSon, STAT = STAT_CALL) + if (STAT_CALL /= SUCCESS_) stop 'Subroutine UpdateFatherModelWP - ModuleWaterProperties. ERR08' + + call UnGetGeometry(SonWaterPropertiesID, VolumeZSon, STAT = STAT_CALL) + if (STAT_CALL /= SUCCESS_) stop 'Subroutine UpdateFatherModelWP - ModuleWaterProperties. ERR09' if (MonitorPerformance) call StopWatch ("ModuleWaterProperties", "UpdateFatherModelWP") end subroutine UpdateFatherModelWP !------------------------------------------------------------------------------------ - subroutine Get2wayData(SonWaterPropertiesID, FatherWaterPropertiesID, IZ, JZ, Open3DFather, Open3DSon, & - VolumeZSon, VolumeZFather) + subroutine GetMapInformation(SonWaterPropertiesID, FatherWaterPropertiesID, IV, JV, Open3DFather, Open3DSon) - !Arguments-------------------------------------------------------------------- + !External-------------------------------------------------------------------- integer, intent(IN) :: SonWaterPropertiesID, FatherWaterPropertiesID - integer, dimension(:,:), pointer, intent(OUT) :: IZ, JZ + integer, dimension(:,:), pointer, intent(OUT) :: IV, JV integer, dimension(:,:,:), pointer, intent(OUT) :: Open3DFather, Open3DSon - real, dimension(:,:,:), pointer, intent(OUT) :: VolumeZSon, VolumeZFather + !Local ------------------------------------------------------------------------ integer :: status !Begin---------------------------------------------------------------------------------- !Get the father cell associated with each son cell - call GetHorizontalGrid(SonWaterPropertiesID, IZ = IZ, STAT = status) - if (status /= SUCCESS_) stop "Get2wayData - WaterProperties - ERR01" + call GetHorizontalGrid(SonWaterPropertiesID, IV = IV, STAT = status) + if (status /= SUCCESS_) stop "GetMapInformation - WaterProperties - ERR01" - call GetHorizontalGrid(SonWaterPropertiesID, JZ = JZ, STAT = status) - if (status /= SUCCESS_) stop "Get2wayData - WaterProperties - ERR02" + call GetHorizontalGrid(SonWaterPropertiesID, JV = JV, STAT = status) + if (status /= SUCCESS_) stop "GetMapInformation - WaterProperties - ERR02" call GetOpenPoints3D(SonWaterPropertiesID, Open3DSon, STAT = status) - if (status /= SUCCESS_) stop "Get2wayData - WaterProperties - ERR03" + if (status /= SUCCESS_) stop "GetMapInformation - WaterProperties - ERR03" call GetOpenPoints3D(FatherWaterPropertiesID, Open3DFather, STAT = status) - if (status /= SUCCESS_) stop "Get2wayData - WaterProperties - ERR04" - - call GetGeometryVolumes(SonWaterPropertiesID, VolumeZ = VolumeZSon, STAT = status) - if (status /= SUCCESS_) stop "Get2wayData - WaterProperties - ERR05" - - call GetGeometryVolumes(FatherWaterPropertiesID, VolumeZ = VolumeZFather, STAT = status) - if (status /= SUCCESS_) stop "Get2wayData - WaterProperties - ERR06" - - call Get2WayAuxVariables(FatherWaterPropertiesID, & - SonVolumeInFatherCell = Me%ExternalVar%TotSonVolInFather, & - AuxMatrix = Me%ExternalVar%Aux2Way, & - Corners = Me%ExternalVar%Corners, & - STAT = status) - if (status .NE. SUCCESS_)then - write(*,*) 'Error getting auxiliar Matrixes from hydrodynamic to waterproperties 3D, for 2way' - call CloseAllAndStop ('Get2wayData - WaterProperties - ERR07') - endif + if (status /= SUCCESS_) stop "GetMapInformation - WaterProperties - ERR04" - end subroutine Get2wayData + end subroutine GetMapInformation !------------------------------------------------------------------------------------ - subroutine UnGet2wayData(SonWaterPropertiesID, FatherWaterPropertiesID, IZ, JZ, Open3DFather, Open3DSon, & - VolumeZSon, VolumeZFather) + subroutine UngetMapInformation(SonWaterPropertiesID, FatherWaterPropertiesID, IV, JV, Open3DFather, Open3DSon) - !Arguments -------------------------------------------------------------------- + !External -------------------------------------------------------------------- integer :: SonWaterPropertiesID, FatherWaterPropertiesID - integer, dimension(:,:), pointer :: IZ, JZ + integer, dimension(:,:), pointer :: IV, JV integer, dimension(:,:,:), pointer :: Open3DFather, Open3DSon - real , dimension(:,:,:), pointer :: VolumeZSon, VolumeZFather + !Local ----------------------------------------------------------------------- integer :: status !Begin ----------------------------------------------------------------------- - call UngetHorizontalGrid(SonWaterPropertiesID, IZ, STAT = status) - if (status /= SUCCESS_) stop "UnGet2wayData - WaterProperties - ERR01" + call UngetHorizontalGrid(SonWaterPropertiesID, IV, STAT = status) + if (status /= SUCCESS_) & + call SetError (FATAL_, INTERNAL_, "UngetMapInformation - WaterProperties - ERR01") - call UngetHorizontalGrid(SonWaterPropertiesID, JZ, STAT = status) - if (status /= SUCCESS_) stop "UnGet2wayData - WaterProperties - ERR02" + call UngetHorizontalGrid(SonWaterPropertiesID, JV, STAT = status) + if (status /= SUCCESS_) & + call SetError (FATAL_, INTERNAL_, "UngetMapInformation - WaterProperties - ERR02") call UnGetMap(SonWaterPropertiesID, Open3DSon, STAT = status) - if (status /= SUCCESS_) stop "UnGet2wayData - WaterProperties - ERR03" + if (status /= SUCCESS_) stop "UngetMapInformation - WaterProperties - ERR05" call UnGetMap(FatherWaterPropertiesID, Open3DFather, STAT = status) - if (status /= SUCCESS_) stop "UnGet2wayData - WaterProperties - ERR04" - - call UngetHydrodynamic(FatherWaterPropertiesID, Me%ExternalVar%TotSonVolInFather, STAT = status) - if (status /= SUCCESS_) stop "UnGet2wayData - WaterProperties - ERR05" - - call UngetHydrodynamic(FatherWaterPropertiesID, Me%ExternalVar%Aux2Way, STAT = status) - if (status /= SUCCESS_) stop "UnGet2wayData - WaterProperties - ERR06" - - call UngetHydrodynamic(FatherWaterPropertiesID, Me%ExternalVar%Corners, STAT = status) - if (status /= SUCCESS_) stop "UnGet2wayData - WaterProperties - ERR07" + if (status /= SUCCESS_) stop "UngetMapInformation - WaterProperties - ERR08" - call UnGetGeometry(SonWaterPropertiesID, VolumeZSon, STAT = status) - if (status /= SUCCESS_) stop "UnGet2wayData - WaterProperties - ERR08" - - call UnGetGeometry(FatherWaterPropertiesID, VolumeZFather, STAT = status) - if (status /= SUCCESS_) stop "UnGet2wayData - WaterProperties - ERR09" - end subroutine UnGet2wayData + end subroutine UngetMapInformation !------------------------------------------------------------------------------------ subroutine ModifyDecayRate @@ -20175,6 +20390,13 @@ subroutine DataAssimilationProcesses if (STAT_CALL /= SUCCESS_) & call CloseAllAndStop ('DataAssimilationProcesses; WaterProperties. ERR40') + + if (ColdPeriod > 0. .and. Property%Old) then + write(*,*) 'ColdRelaxPeriod is ON in a HOT START ' + write(*,*) 'Remove from Assimilation_x.dat the keyword COLD_RELAX_PERIOD' + call CloseAllAndStop ('DataAssimilationProcesses; WaterProperties. ERR50') + endif + DT_RunPeriod = Actual - Me%BeginTime @@ -20842,8 +21064,8 @@ subroutine ModifyDensity(CurrentTime) write(ModelName,*) 'ModelName =', trim(adjustl(Me%ModelName)),' - MPI ID =', Me%DDecomp%MPI_ID, & ' - domain corners(imin, imax, jmin, jmax)=',icILB, icIUB, icJLB, icJUB - di_out = Me%DDecomp%WindowLimitsJI%ILB - 1 - dj_out = Me%DDecomp%WindowLimitsJI%JLB - 1 + di_out = Me%DDecomp%HaloMap%ILB - 1 + dj_out = Me%DDecomp%HaloMap%JLB - 1 else write(ModelName,*) 'ModelName =', trim(adjustl(Me%ModelName)) @@ -20851,6 +21073,8 @@ subroutine ModifyDensity(CurrentTime) dj_out = 0 endif + + ILB = Me%WorkSize%ILB IUB = Me%WorkSize%IUB JLB = Me%WorkSize%JLB @@ -20946,7 +21170,7 @@ subroutine ModifyDensity(CurrentTime) WriteNumber = WriteNumber + 1 endif - + if (WriteNumber > WriteNumberMax) then write(*,*) 'Too much temperature and/or salinity anomalous values >', WriteNumberMax call CloseAllAndStop (' ModifyDensity - ModuleWaterProperties - ERR60') @@ -22226,7 +22450,7 @@ subroutine OutPut_SurfaceResults_HDF call HDF5WriteData (Me%ObjSurfaceHDF5, & "/Grid/VerticalZ", & - "VerticalZ", "m", & + "Vertical", "m", & Array3D = Me%ExternalVar%SZZ, & OutputNumber = SurfaceOutPutNumber, & STAT = STAT_CALL) @@ -22257,22 +22481,23 @@ subroutine OutPut_SurfaceResults_HDF if (Me%WriteHDFReal4)then call SetMatrixValue(Me%Output%Aux3Dreal4, Me%Size, PropertyX%Concentration) - call HDF5WriteData (Me%ObjSurfaceHDF5, & - "/Results/"//PropertyX%ID%Name, & - PropertyX%ID%Name, PropertyX%ID%Units, & - Array3D = Me%Output%Aux3Dreal4, & - OutputNumber = SurfaceOutPutNumber, & + call HDF5WriteData (Me%ObjSurfaceHDF5, & + "/Results/"//PropertyX%ID%Name, & + PropertyX%ID%Name, PropertyX%ID%Units, & + Array3D = Me%Output%Aux3Dreal4, & + OutputNumber = SurfaceOutPutNumber, & STAT = STAT_CALL) if (STAT_CALL /= SUCCESS_) call CloseAllAndStop ('OutPut_Results_HDF - ModuleWaterProperties - ERR70') else - call HDF5WriteData (Me%ObjSurfaceHDF5, & + + call HDF5WriteData (Me%ObjSurfaceHDF5, & "/Results/"//PropertyX%ID%Name, & PropertyX%ID%Name, PropertyX%ID%Units, & Array3D = PropertyX%Concentration, & OutputNumber = SurfaceOutPutNumber, & STAT = STAT_CALL) - if (STAT_CALL /= SUCCESS_) call CloseAllAndStop ('OutPut_Results_HDF - ModuleWaterProperties - ERR80') + if (STAT_CALL /= SUCCESS_) call CloseAllAndStop ('OutPut_Results_HDF - ModuleWaterProperties - ERR80') endif diff --git a/Software/MOHIDWater/ModuleWaves.F90 b/Software/MOHIDWater/ModuleWaves.F90 index 760c2d421..8564b9131 100644 --- a/Software/MOHIDWater/ModuleWaves.F90 +++ b/Software/MOHIDWater/ModuleWaves.F90 @@ -1220,7 +1220,7 @@ subroutine ConstructWaveParameters call GetData(Me%RunSwan%BatchFile, & Me%ObjEnterData, iflag, & Keyword = 'SWAN_BATCH_FILE', & - default = 'Swan\RunSwan.bat', & + default = 'Swan'//backslash//'RunSwan.bat', & SearchType = FromFile, & ClientModule ='ModuleWave', & STAT = STAT_CALL) @@ -1230,7 +1230,7 @@ subroutine ConstructWaveParameters call GetData(Me%RunSwan%FileOutSwan, & Me%ObjEnterData, iflag, & Keyword = 'SWAN_OUTPUT_FILE', & - default = 'Swan\FileOut.dat', & + default = 'Swan'//backslash//'FileOut.dat', & SearchType = FromFile, & ClientModule ='ModuleWave', & STAT = STAT_CALL) @@ -3913,7 +3913,7 @@ subroutine RunSwanModel if (VariableBathym) then - call WriteBatimSwan(FileBatimSwan = 'Swan\FileBatimIn.dat') + call WriteBatimSwan(FileBatimSwan = 'Swan'//backslash//'FileBatimIn.dat') endif diff --git a/Software/MOHIDWater/mpif.F90 b/Software/MOHIDWater/mpif.F90 index 5da54811a..4df111c30 100644 --- a/Software/MOHIDWater/mpif.F90 +++ b/Software/MOHIDWater/mpif.F90 @@ -1,3 +1,5 @@ + !<@cond mpif + INTEGER MPI_SOURCE, MPI_TAG, MPI_ERROR PARAMETER (MPI_SOURCE=3,MPI_TAG=4,MPI_ERROR=5) INTEGER MPI_STATUS_SIZE @@ -415,3 +417,5 @@ COMMON /MPIPRIVC/ MPI_ARGVS_NULL, MPI_ARGV_NULL SAVE /MPIPRIVC/ + + !<@endcond \ No newline at end of file