Skip to content
Permalink
Branch: master
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
4926 lines (3587 sloc) 232 KB
!------------------------------------------------------------------------------
! IST/MARETEC, Water Modelling Group, Mohid modelling system
!------------------------------------------------------------------------------
!
! TITLE : Mohid Model
! PROJECT : Mohid Land, Mohid SurfaceWater
! MODULE : Atmosphere
! URL : http://www.mohid.com
! AFFILIATION : IST/MARETEC, Marine Modelling Group
! DATE : July 2003
! REVISION : Frank & Pedro Chambel Leitao, Luis Fernandes - v4.0
! DESCRIPTION : Module used to read and calculate values for atmosphere
!
!------------------------------------------------------------------------------
!
!This program is free software; you can redistribute it and/or
!modify it under the terms of the GNU General Public License
!version 2, as published by the Free Software Foundation.
!
!This program is distributed in the hope that it will be useful,
!but WITHOUT ANY WARRANTY; without even the implied warranty of
!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
!GNU General Public License for more details.
!
!You should have received a copy of the GNU General Public License
!along with this program; if not, write to the Free Software
!Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
!
!------------------------------------------------------------------------------
Module ModuleAtmosphere
use ModuleGlobalData
use ModuleDrawing
use ModuleTime
use ModuleHDF5
use ModuleFunctions, only : ConstructPropertyID, CHUNK_J
use ModuleFillMatrix, only : ConstructFillMatrix, ModifyFillMatrix, KillFillMatrix, &
GetIfMatrixRemainsConstant, GetFillMatrixDTPrediction, &
GetNextValueForDTPred, GetValuesProcessingOptions, &
UngetFillMatrix, ModifyFillMatrixVectorial
use ModuleTimeSerie, only : StartTimeSerie, WriteTimeSerie, KillTimeSerie, &
GetTimeSerieLocation, CorrectsCellsTimeSerie, &
GetNumberOfTimeSeries, TryIgnoreTimeSerie, GetTimeSerieName
use ModuleEnterData, only : ReadFileName, ConstructEnterData, GetData, &
ExtractBlockFromBuffer, Block_Unlock, GetOutPutTime, &
KillEnterData
use ModuleGridData, only : GetGridData, UngetGridData
use ModuleHorizontalGrid, only : GetHorizontalGrid, GetHorizontalGridSize, GetGridAngle, &
GetGridLatitudeLongitude, WriteHorizontalGrid, &
UnGetHorizontalGrid, RotateVectorFieldToGrid, &
GetGridCellArea, GetXYCellZ, GetDDecompMPI_ID, &
GetDDecompON, GetGridOutBorderPolygon, &
ComputeAngleFromGridComponents, RotateVectorGridToField
use ModuleStatistic, only : ConstructStatistic, GetStatisticMethod, &
GetStatisticParameters, ModifyStatistic, KillStatistic
use ModuleStopWatch, only : StartWatch, StopWatch
implicit none
private
!Subroutines & Functions---------------------------------------------------
!Constructor
public :: StartAtmosphere
private :: AllocateInstance
private :: ReadPropertiesFilesName
private :: ConstructPropertyList
private :: ConstructProperty
private :: Add_Property
private :: Construct_PropertyValues
private :: ConstructOutPut
private :: ConstructSurfStatistics
private :: OpenHDF5OutPutFile
private :: ConstructTimeSerie
!private :: RotateAtmosphereVectorFields
!Selector
public :: GetWindHeight
public :: GetAirMeasurementHeight
public :: GetAtmosphereProperty
private :: SearchProperty
public :: AtmospherePropertyExists
public :: GetAtmospherenProperties
public :: GetAtmospherePropertiesIDByIdx
public :: GetNextAtmosphereDTPrediction
public :: UngetAtmosphere
private :: ReadLockExternalVar
private :: ReadUnlockExternalVar
!Modifier
public :: ModifyAtmosphere
private :: ModifyAirTemperature
private :: ModifyWindVelocity
private :: ComputeWindVelocity
private :: ModifyWindDirection
private :: ModifyWindModulus
private :: ModifyPrecipitation
private :: ModifySolarRadiation
private :: ClimatologicSolarRadiation
private :: RandomCloud !Function
private :: TOARadiation !Function
private :: ModifyAtmosphericPressure
private :: ModifyCo2AtmosphericPressure
private :: ModifyO2AtmosphericPressure
private :: ModifyPropByIrri
private :: ModifyPropByRain
private :: ModifySunHours
private :: ModifyCloudCover
private :: ModifyRelativeHumidity
private :: ModifyPBLHeight
private :: ModifyIrrigation
private :: ModifyRandom
private :: ModifyOutput
private :: OutPutResultsHDF5
private :: OutPut_TimeSeries
private :: OutPut_Statistics
private :: ModifyAtmospDeposOxidNO3 !LLP
private :: ModifyAtmospDeposReduNH4 !LLP
!Destructor
public :: KillAtmosphere
private :: DeallocateInstance
private :: DeallocateVariables
!Management
private :: Ready
private :: LocateObjAtmosphere
!Interfaces----------------------------------------------------------------
private :: UngetAtmosphere1D
private :: UngetAtmosphere2D
interface UngetAtmosphere
module procedure UngetAtmosphere1D
module procedure UngetAtmosphere2D
end interface UngetAtmosphere
private :: GetAtmospherePropertyScalar
private :: GetAtmospherePropertyVectorial
interface GetAtmosphereProperty
module procedure GetAtmospherePropertyScalar
module procedure GetAtmospherePropertyVectorial
end interface GetAtmosphereProperty
!Parameter-----------------------------------------------------------------
!Sun constant (W / m**2)
real, parameter :: KSun = 1367.0
character(LEN = StringLength), parameter :: block_begin = '<beginproperty>'
character(LEN = StringLength), parameter :: block_end = '<endproperty>'
!Parameter
integer, parameter :: Radiation_MOHID = 1
integer, parameter :: Radiation_CEQUALW2 = 2
integer, parameter :: CloudFromSunHours = 1
integer, parameter :: CloudFromRandom = 2
integer, parameter :: CloudFromRadiation = 3
!Types---------------------------------------------------------------------
type T_External
integer, dimension(:,:), pointer :: MappingPoints2D => null()
real, dimension(:,:), pointer :: GridCellArea => null()
real, dimension(:,:), pointer :: Latitude => null()
real, dimension(:,:), pointer :: Longitude => null()
logical :: Backtracking = .false.
end type T_External
type T_OutPut
type (T_Time), pointer, dimension(:) :: OutTime => null()
logical :: True = .false. !initialization: Jauch
integer :: NextHDF5 = null_int !initialization: Jauch
integer :: Number = null_int !initialization: Jauch
end type T_OutPut
type T_Statistics
integer :: ID = null_int, & !initialization: Jauch
IDx = null_int, & !initialization: Jauch
IDy = null_int !initialization: Jauch
character(LEN = Pathlength) :: File = null_str !initialization: Jauch
logical :: ON = .false. !initialization: Jauch
end type T_Statistics
type T_Property
type (T_PropertyID) :: ID
real, dimension(:,:), pointer :: Field => null() !scalar field. (e.g. converted angle to cell ref)
real, dimension(:,:), pointer :: FieldInputRef => null() !original scalar field (orig angle in input ref)
real, dimension(:,:), pointer :: FieldU => null() !vectorial field rotated to grid cells - U comp.
real, dimension(:,:), pointer :: FieldV => null() !vectorial field rotated to grid cells - V comp.
real, dimension(:,:), pointer :: FieldX => null() !vectorial original field - X (zonal component)
real, dimension(:,:), pointer :: FieldY => null() !vectorial original field - Y (meridional comp.)
!real, dimension(:,:), pointer :: FieldGrid => null()
real :: RandomValue = null_real !initialization: Jauch
logical :: HasRandomComponent = .false.
logical :: PropAddedByIrri = .false.
logical :: PropAddedByRain = .false.
logical :: FirstActualization = .true.
real :: RandomComponent = FillValueReal
logical :: UseToPredictDT = .true.
real :: PredictedDT = -null_real
real :: DTForNextEvent = -null_real
logical :: TimeSerie = .false.
logical :: BoxTimeSerie = .false.
logical :: OutputHDF = .false.
logical :: Constant = .false.
logical :: NoInterpolateValueInTime = .false.
logical :: AccumulateValueInTime = .false.
logical :: InterpolateValueInTime = .false.
logical :: UseOriginalValue = .false.
type (T_Statistics) :: Statistics
type (T_Property), pointer :: Next => null()
type (T_Property), pointer :: Prev => null()
end type T_Property
type T_Files
character(len=Pathlength) :: ConstructData = null_str !initialization: Jauch
character(len=Pathlength) :: Results = null_str !initialization: Jauch
end type T_Files
type T_DTLimits
real :: Limit = 0
real :: DT = 0
end type T_DTLimits
type T_Limits_A
logical :: UseLimits = .false.
type(T_DTLimits) :: Light
type(T_DTLimits) :: Medium
type(T_DTLimits) :: Heavy
real :: MaxValue = 0.0
end type T_Limits_A
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
type(T_Files) :: Files
type(T_Property), pointer :: FirstAtmosphereProp => null()
type(T_Property), pointer :: LastAtmosphereProp => null()
type(T_OutPut) :: OutPut
type(T_Time ) :: BeginTime
type(T_Time ) :: EndTime
type(T_Time ) :: ActualTime
type(T_Time ) :: NextCompute
type(T_Time ) :: LastOutPutHDF5
logical :: WindHeightDefined
logical :: AirMeasurementHeightDefined
logical :: PredictDT = .true.
integer :: PredictDTMethod = 1
real :: WindHeight
real :: AirMeasurementHeight
! real :: PredictedDT = -null_real
! real :: DTForNextEvent = -null_real
! real :: IrriPredictedDT = -null_real
! real :: IrriDTForNextEvent = -null_real
! real :: PrecPredictedDT = -null_real
! real :: PrecDTForNextEvent = -null_real
! logical :: UsePrecipitationForDTPred = .false.
! logical :: UseIrrigationForDTPred = .false.
type(T_Limits_A) :: Rain
type(T_Limits_A) :: Irrigation
integer :: RadiationMethod = 1
integer :: CloudCoverMethod = null_int !initialization: Jauch
real :: CloudCoverNight = 0.595
real :: CloudCoverMinDay = 0.3
real, pointer, dimension(:,: ) :: LastRadiation => null()
integer :: LastCalculateRandomCloud = null_int
integer :: PropertiesNumber = FillValueInt
integer :: CurrentIndex = 2
logical :: PropsAddedByRain = .false.
logical :: PropsAddedByIrri = .false.
logical :: CheckPropertyValues = .false. !initialization: Jauch
real :: ConversionFactorPrec = null_real
logical :: PrecReqConv = .false.
integer, dimension(2) :: PrecMaxCoord
real :: ConversionFactorIrri = null_real
logical :: IrriReqConv = .false.
integer, dimension(2) :: IrriMaxCoord
logical :: OverrideWindVelStandard = .false.
!Instance of Module HDF5
integer :: ObjHDF5 = 0
!Instance of Module_EnterData
integer :: ObjEnterData = 0 !Data File - ConstructData
!Instance of ModuleGridData
integer :: ObjGridData = 0
!Instance of ModuleHorizontalGrid
integer :: ObjHorizontalGrid = 0
!Instance of ModuleTime
integer :: ObjTime = 0
!Instance of ModuleBoxDif
integer :: ObjBoxDif = 0
!Instance of ModuleTimeSerie
integer :: ObjTimeSerie = 0
!Collection of instances
type(T_Atmosphere), pointer :: Next => null()
end type T_Atmosphere
!Global Module Variables
type (T_Atmosphere), pointer :: FirstObjAtmosphere => null()
type (T_Atmosphere), pointer :: Me => null()
!--------------------------------------------------------------------------
contains
!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!CONSTRUCTOR CONSTRUCTOR CONSTRUCTOR CONSTRUCTOR CONSTRUCTOR CONSTRUCTOR
!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
subroutine StartAtmosphere(ModelName, &
ModelType, &
AtmosphereID, &
TimeID, &
GridDataID, &
HorizontalGridID, &
MappingPoints, &
CheckValues, &
STAT)
!Arguments--------------------------------------------------------------
character(Len=*) :: ModelName
integer :: ModelType
integer :: AtmosphereID
integer :: TimeID
integer :: GridDataID
integer :: HorizontalGridID
integer, dimension(:, :), pointer :: MappingPoints
logical, optional :: CheckValues
integer, optional, intent(OUT) :: STAT
!External--------------------------------------------------------------
integer :: STAT_CALL
integer :: ready_
!Local-----------------------------------------------------------------
integer :: STAT_
character(len = StringLength) :: WarningString
!Begin-----------------------------------------------------------------
STAT_ = UNKNOWN_
!Assures nullification of the global variable
if (.not. ModuleIsRegistered(mAtmosphere_)) then
nullify (FirstObjAtmosphere)
call RegisterModule (mAtmosphere_)
endif
call Ready(AtmosphereID, ready_)
cd0 : if (ready_ .EQ. OFF_ERR_) then
!Allocates a new Instance
call AllocateInstance
Me%ModelName = ModelName
Me%ModelType = ModelType
!Associates External Instances
Me%ObjTime = AssociateInstance (mTIME_, TimeID )
Me%ObjGridData = AssociateInstance (mGRIDDATA_, GridDataID )
Me%ObjHorizontalGrid = AssociateInstance (mHORIZONTALGRID_, HorizontalGridID)
Me%ExternalVar%MappingPoints2D => MappingPoints
if (present(CheckValues)) Me%CheckPropertyValues = CheckValues
call ReadLockExternalVar
!Read the name file of the Atmosphere module
call ReadPropertiesFilesName
!Construct enter data
call ConstructEnterData(Me%ObjEnterData, Me%Files%ConstructData, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'StartAtmosphere - ModuleAtmosphere - ERR01'
call ConstructGlobalVariables
if (Me%CloudCoverMethod == CloudFromRadiation) then
allocate( Me%LastRadiation ( Me%WorkSize%ILB:Me%WorkSize%IUB, &
Me%WorkSize%JLB:Me%WorkSize%JUB) )
!Me%LastRadiation = null_real
Me%LastRadiation = 0.
endif
!Constructs the property list
call ConstructPropertyList
if (Me%CheckPropertyValues) then
call CheckPropertyValues (Constructing = .true.)
endif
call ConstructTimeSerie
call ConstructOutput
call KillEnterData(Me%ObjEnterData, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'StartAtmosphere - ModuleAtmosphere - ERR02'
! By default a output file is always open in the construction phase
if (Me%OutPut%True) call OpenHDF5OutPutFile
WarningString = 'Construct'
call ModifyOutPut(WarningString)
call null_time(Me%ActualTime)
nullify(Me%ExternalVar%MappingPoints2D)
call ReadUnlockExternalVar
!Returns ID
AtmosphereID = Me%InstanceID
STAT_ = SUCCESS_
else cd0
stop 'StartAtmosphere - ModuleAtmosphere - ERR03'
end if cd0
if (present(STAT)) STAT = STAT_
end subroutine StartAtmosphere
!--------------------------------------------------------------------------
subroutine AllocateInstance
!Local-----------------------------------------------------------------
type (T_Atmosphere), pointer :: NewAtmosphere => null()
type (T_Atmosphere), pointer :: PreviousAtmosphere => null()
!Allocates new instance
allocate (NewAtmosphere)
nullify (NewAtmosphere%Next)
!Insert New Instance into list and makes Current point to it
if (.not. associated(FirstObjAtmosphere)) then
FirstObjAtmosphere => NewAtmosphere
Me => NewAtmosphere
else
PreviousAtmosphere => FirstObjAtmosphere
Me => FirstObjAtmosphere%Next
do while (associated(Me))
PreviousAtmosphere => Me
Me => Me%Next
enddo
Me => NewAtmosphere
PreviousAtmosphere%Next => NewAtmosphere
endif
Me%InstanceID = RegisterNewInstance (mATMOSPHERE_)
end subroutine AllocateInstance
!--------------------------------------------------------------------------
subroutine ConstructGlobalVariables
!External--------------------------------------------------------------
integer :: STAT_CALL, iflag, defValue
real, dimension(6) :: limits
!Begin------------------------------------------------------------------
call GetComputeTimeLimits(Me%ObjTime, BeginTime = Me%BeginTime, &
EndTime = Me%EndTime, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructGlobalVariables - ModuleAtmosphere - ERR10'
!Actualize the time
Me%ActualTime = Me%BeginTime
Me%NextCompute = Me%ActualTime
! Check if the simulation goes backward in time or forward in time (default mode)
call GetBackTracking(Me%ObjTime, Me%ExternalVar%BackTracking, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) &
stop 'ConstructGlobalVariables - ModuleAtmosphere - ERR20'
! Sets the last output equal to zero
call SetDate(Me%LastOutPutHDF5, 0, 0, 0, 0, 0, 0)
call GetHorizontalGridSize(Me%ObjHorizontalGrid, Size = Me%Size, &
WorkSize = Me%WorkSize, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructGlobalVariables - ModuleAtmosphere - ERR30'
call GetData (Me%WindHeight, &
Me%ObjEnterData, iflag, &
Keyword = 'WIND_MEASUREMENT_HEIGHT', &
!Default = 10m, &
SearchType = FromFile, &
ClientModule = 'ModuleAtmosphere', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) &
stop 'ConstructGlobalVariables - ModuleAtmosphere - ERR40'
if (iflag /= 0) then
Me%WindHeightDefined = .true.
else
Me%WindHeightDefined = .false.
endif
call GetData (Me%AirMeasurementHeight, &
Me%ObjEnterData, iflag, &
Keyword = 'AIR_MEASUREMENT_HEIGHT', &
!Default = 10m, &
SearchType = FromFile, &
ClientModule = 'ModuleAtmosphere', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) &
stop 'ConstructGlobalVariables - ModuleAtmosphere - ERR45'
if (iflag /= 0) then
Me%AirMeasurementHeightDefined = .true.
else
Me%AirMeasurementHeightDefined = .false.
endif
call GetData(Me%RadiationMethod, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'RADIATION_METHOD', &
ClientModule = 'ModuleAtmosphere', &
Default = Radiation_Mohid, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructGlobalVariables - ModuleAtmosphere - ERR40'
!Do not use random number as default method to compute cloud cover
!the method from radiation does a ratio between TOA radiation and given solar radiation
!nowadays solar radiation data is something that both land and water models have and there is no
!justification for using random numbers! David June 2015
call GetData(Me%CloudCoverMethod, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'CLOUD_COVER_METHOD', &
ClientModule = 'ModuleAtmosphere', &
!Default = CloudFromRandom, &
Default = CloudFromRadiation, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructGlobalVariables - ModuleAtmosphere - ERR50'
!if keyword not found and model will compute warn user that the default method has changed
!done in ContructPropertyValues
!Do not allow cloud cover from random
if (Me%CloudCoverMethod == CloudFromRandom) then
write (*,*) ''
write (*,*) 'CLOUD_COVER_METHOD : 2 (from random numbers), in atmosphere data file'
write (*,*) 'was abandoned. The default method now is CLOUD_COVER_METHOD : 3.'
write (*,*) 'Please use CLOUD_COVER_METHOD : 3 (from radiation)'
write (*,*) ' or CLOUD_COVER_METHOD : 1 (from sun hours)'
write (*,*) ' or use a constant value or solution from file.'
write (*,*) ''
stop 'ConstructGlobalVariables - ModuleAtmosphere - ERR50.1'
endif
if (Me%CloudCoverMethod == CloudFromRadiation) then
!Cloud cover value for night (radiation is zero).
!0.595 is from FAO Irrigation and Drainage Paper Report 56
call GetData(Me%CloudCoverNight, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'CLOUD_COVER_NIGHT', &
ClientModule = 'ModuleAtmosphere', &
Default = 0.595, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructGlobalVariables - ModuleAtmosphere - ERR51'
!Minimum cloud cover value for during day (to avoid sunrise and sunset very low values)
!0.3 is from FAO Irrigation and Drainage Paper Report 56
call GetData(Me%CloudCoverMinDay, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'CLOUD_COVER_MIN_DAY', &
ClientModule = 'ModuleAtmosphere', &
Default = 0.3, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructGlobalVariables - ModuleAtmosphere - ERR52'
endif
call GetData(Me%PredictDT, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'PREDICT_DT', &
ClientModule = 'ModuleAtmosphere', &
Default = .true., &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructGlobalVariables - ModuleAtmosphere - ERR60'
!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
endif
call GetData(Me%PredictDTMethod, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'PREDICT_DT_METHOD', &
ClientModule = 'ModuleAtmosphere', &
Default = defValue, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructGlobalVariables - ModuleAtmosphere - ERR60'
write (*,*) ''
write (*,*) 'Atmosphere DT Prediction Method: ', Me%PredictDTMethod
write (*,*) ''
call GetData(limits, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'RAIN_LIMITS', &
ClientModule = 'ModuleAtmosphere', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructGlobalVariables - ModuleAtmosphere - ERR70'
if (iflag <= 0) then
Me%Rain%UseLimits = .false.
elseif (iflag < 6) then
stop 'ConstructGlobalVariables - ModuleAtmosphere - ERR71'
else
Me%Rain%UseLimits = .true.
Me%Rain%Light%Limit = limits(1)
Me%Rain%Light%DT = limits(2)
Me%Rain%Medium%Limit = limits(3)
Me%Rain%Medium%DT = limits(4)
Me%Rain%Heavy%Limit = limits(5)
Me%Rain%Heavy%DT = limits(6)
endif
call GetData(limits, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'IRRI_LIMITS', &
ClientModule = 'ModuleAtmosphere', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructGlobalVariables - ModuleAtmosphere - ERR80'
if (iflag <= 0) then
Me%Irrigation%UseLimits = .false.
elseif (iflag < 6) then
stop 'ConstructGlobalVariables - ModuleAtmosphere - ERR81'
else
Me%Irrigation%UseLimits = .true.
Me%Irrigation%Light%Limit = limits(1)
Me%Irrigation%Light%DT = limits(2)
Me%Irrigation%Medium%Limit = limits(3)
Me%Irrigation%Medium%DT = limits(4)
Me%Irrigation%Heavy%Limit = limits(5)
Me%Irrigation%Heavy%DT = limits(6)
endif
call GetData(Me%OverrideWindVelStandard, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'OVERRIDE_WIND_VEL_STANDARD', &
ClientModule = 'ModuleAtmosphere', &
Default = .false., &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructGlobalVariables - ModuleAtmosphere - ERR100'
end subroutine ConstructGlobalVariables
!--------------------------------------------------------------------------
!Read the name of the files need to construct and modify
! the Atmosphere properties
subroutine ReadPropertiesFilesName
!External--------------------------------------------------------------
character(len = StringLength) :: Message
integer :: STAT_CALL
!Begin------------------------------------------------------------------
!Opens the Atmosphere data file
! ASCII file used to construct new properties
Message ='Atmosphere Data Properties.'
Message = trim(Message)
call ReadFileName('SURF_DAT', Me%Files%ConstructData, Message = Message, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadPropertiesFilesName - ModuleAtmosphere - ERR01'
! ---> File in HDF format where is written instant fields of Atmosphere properties
Message ='Instant fields of Atmosphere properties in HDF format.'
Message = trim(Message)
call ReadFileName('SURF_HDF', Me%Files%Results, Message = Message, &
TIME_END = Me%EndTime, Extension = 'sur', &
MPI_ID = GetDDecompMPI_ID(Me%ObjHorizontalGrid),&
DD_ON = GetDDecompON (Me%ObjHorizontalGrid),&
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadPropertiesFilesName - ModuleAtmosphere - ERR02'
end subroutine ReadPropertiesFilesName
!--------------------------------------------------------------------------
subroutine OpenHDF5OutPutFile
!Local-----------------------------------------------------------------
real, pointer, dimension(:, :) :: GridData
integer :: STAT_CALL
integer :: WorkILB, WorkIUB
integer :: WorkJLB, WorkJUB
integer :: HDF5_CREATE
!----------------------------------------------------------------------
!Bounds
WorkILB = Me%WorkSize%ILB
WorkIUB = Me%WorkSize%IUB
WorkJLB = Me%WorkSize%JLB
WorkJUB = Me%WorkSize%JUB
!Gets File Access Code
call GetHDF5FileAccess (HDF5_CREATE = HDF5_CREATE)
!Opens HDF File
call ConstructHDF5 (Me%ObjHDF5, trim(Me%Files%Results)//"5", &
HDF5_CREATE, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'Open_HDF5_OutPut_File - ModuleAtmosphere - ERR01'
!Write the Horizontal Grid
call WriteHorizontalGrid(Me%ObjHorizontalGrid, Me%ObjHDF5, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'Open_HDF5_OutPut_File - ModuleAtmosphere - ERR02'
!Gets a pointer to GridData
call GetGridData (Me%ObjGridData, GridData, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'Open_HDF5_OutPut_File - ModuleAtmosphere - ERR03'
!Sets limits for next write operations
call HDF5SetLimits (Me%ObjHDF5, WorkILB, WorkIUB, WorkJLB, &
WorkJUB, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'Open_HDF5_OutPut_File - ModuleAtmosphere - ERR05'
!Writes the GridData
call HDF5WriteData (Me%ObjHDF5, "/Grid", "Bathymetry", "m", &
Array2D = GridData, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'Open_HDF5_OutPut_File - ModuleAtmosphere - ERR06'
!Writes the WaterPoints
call HDF5WriteData (Me%ObjHDF5, "/Grid", "MappingPoints2D", "-", &
Array2D = Me%ExternalVar%MappingPoints2D, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'Open_HDF5_OutPut_File - ModuleAtmosphere - ERR07'
!Writes everything to disk
call HDF5FlushMemory (Me%ObjHDF5, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'Open_HDF5_OutPut_File - ModuleAtmosphere - ERR08'
!Ungets the GridData
call UngetGridData (Me%ObjGridData, GridData, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'Open_HDF5_OutPut_File - ModuleAtmosphere - ERR09'
end subroutine OpenHDF5OutPutFile
!--------------------------------------------------------------------------
subroutine ConstructTimeSerie
!External--------------------------------------------------------------
integer :: iflag, STAT_CALL
!Local-----------------------------------------------------------------
real :: CoordX, CoordY
logical :: CoordON, IgnoreOK
integer :: dn, Id, Jd, TimeSerieNumber
type(T_Property), pointer :: PropertyX
integer :: nProperties
character(len=PathLength) :: TimeSerieLocationFile
character(len=StringLength) :: TimeSerieName
character(len=StringLength), dimension(:), pointer :: PropertyList
type (T_Polygon), pointer :: ModelDomainLimit
character(len=StringLength) :: PropertyNameX, PropertyNameY
!Begin-----------------------------------------------------------------
!First checks out how many properties will have time series
PropertyX => Me%FirstAtmosphereProp
nProperties = 0
do while (associated(PropertyX))
if (PropertyX%TimeSerie) then
!vectorial property - need to get data in user referential - X and Y
!~ if (Check_Vectorial_Property(PropertyX%ID%IDNumber)) then
if (PropertyX%ID%IsVectorial) then
nProperties = nProperties + 2
else
nProperties = nProperties + 1
endif
endif
PropertyX=>PropertyX%Next
enddo
if (nProperties > 0) then
!Allocates PropertyList
allocate(PropertyList(nProperties), STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructTimeSerie - ModuleAtmosphere - ERR10'
!Fills up PropertyList
PropertyX => Me%FirstAtmosphereProp
nProperties = 0
do while (associated(PropertyX))
if (PropertyX%TimeSerie) then
nProperties = nProperties + 1
!vectorial property - need to get data in user referential - X and Y
!~ if (Check_Vectorial_Property(PropertyX%ID%IDNumber)) then
if (PropertyX%ID%IsVectorial) then
!get the correct names of the properties
call Get_Vectorial_PropertyNames(PropertyX%ID%IDNumber, PropertyNameX, PropertyNameY)
PropertyList(nProperties) = trim(adjustl(PropertyNameX))
nProperties = nProperties + 1
PropertyList(nProperties) = trim(adjustl(PropertyNameY))
else
PropertyList(nProperties) = trim(adjustl(PropertyX%ID%name))
endif
endif
PropertyX=>PropertyX%Next
enddo
call GetData(TimeSerieLocationFile, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'TIME_SERIE_LOCATION', &
ClientModule = 'ModuleWaterProperties', &
Default = Me%Files%ConstructData, &
STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_) &
stop 'Construct_Time_Serie - ModuleAtmosphere - ERR20'
call GetGridOutBorderPolygon(HorizontalGridID = Me%ObjHorizontalGrid, &
Polygon = ModelDomainLimit, &
STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_) &
stop 'Construct_Time_Serie - ModuleAtmosphere - ERR25'
!Constructs TimeSerie
call StartTimeSerie(Me%ObjTimeSerie, Me%ObjTime, &
trim(TimeSerieLocationFile), &
PropertyList, "srs", &
WaterPoints2D = Me%ExternalVar%MappingPoints2D, &
ModelName = Me%ModelName, &
ModelDomain = ModelDomainLimit, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructTimeSerie - ModuleAtmosphere - ERR30'
call UngetHorizontalGrid(HorizontalGridID = Me%ObjHorizontalGrid, &
Polygon = ModelDomainLimit, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructTimeSerie - ModuleAtmosphere - ERR35'
!Deallocates PropertyList
deallocate(PropertyList, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructTimeSerie - ModuleAtmosphere - ERR40'
!Corrects if necessary the cell of the time serie based in the time serie coordinates
call GetNumberOfTimeSeries(Me%ObjTimeSerie, TimeSerieNumber, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructTimeSerie - ModuleAtmosphere - ERR50'
do dn = 1, TimeSerieNumber
call TryIgnoreTimeSerie(Me%ObjTimeSerie, dn, IgnoreOK, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructTimeSerie - ModuleAtmosphere - ERR60'
if (IgnoreOK) cycle
call GetTimeSerieLocation(Me%ObjTimeSerie, dn, &
CoordX = CoordX, &
CoordY = CoordY, &
CoordON = CoordON, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructTimeSerie - ModuleAtmosphere - ERR70'
call GetTimeSerieName(Me%ObjTimeSerie, dn, TimeSerieName, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructTimeSerie - ModuleAtmosphere - ERR80'
if (CoordON) then
call GetXYCellZ(Me%ObjHorizontalGrid, CoordX, CoordY, Id, Jd, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_ .and. STAT_CALL /= OUT_OF_BOUNDS_ERR_) then
stop 'CConstructTimeSerie - ModuleAtmosphere - ERR90'
endif
! if (STAT_CALL == OUT_OF_BOUNDS_ERR_ .or. Id < 0 .or. Jd < 0) then
! call TryIgnoreTimeSerie(Me%ObjTimeSerie, dn, IgnoreOK, STAT = STAT_CALL)
! if (STAT_CALL /= SUCCESS_) stop 'ConstructTimeSerie - ModuleAtmosphere - ERR100'
! if (IgnoreOK) then
! cycle
! else
! stop 'ConstructTimeSerie - ModuleAtmosphere - ERR80'
! endif
!endif
call CorrectsCellsTimeSerie(Me%ObjTimeSerie, dn, Id, Jd, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructTimeSerie - ModuleAtmosphere - ERR110'
endif
call GetTimeSerieLocation(Me%ObjTimeSerie, dn, &
LocalizationI = Id, &
LocalizationJ = Jd, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructTimeSerie - ModuleAtmosphere - ERR120'
if (Me%ExternalVar%MappingPoints2D(Id, Jd) /= WaterPoint) then
write(*,*) 'Time Serie in a land cell - ',trim(TimeSerieName),' - ',trim(Me%ModelName)
endif
enddo
endif
end subroutine ConstructTimeSerie
!--------------------------------------------------------------------------
subroutine ConstructPropertyList
!Local-----------------------------------------------------------------
type (T_Property), pointer :: NewProperty => null()
type (T_Property), pointer :: PropertyX => null()
type (T_Property), pointer :: PropertyY => null()
integer :: ClientNumber
integer :: i, j, STAT_CALL
logical :: BlockFound
integer :: dummy, iflag
!----------------------------------------------------------------------
! Initialize the Atmosphere properties number
Me%PropertiesNumber = 0
! Initialize the Atmosphere properties list
nullify (Me%FirstAtmosphereProp)
nullify (Me%LastAtmosphereProp)
do1 : do
call ExtractBlockFromBuffer(Me%ObjEnterData, ClientNumber, &
block_begin, block_end, BlockFound, &
STAT = STAT_CALL)
cd1 : if (STAT_CALL .EQ. SUCCESS_ ) then
cd2 : if (BlockFound) then
! Construct a New Property
Call ConstructProperty(NewProperty, ClientNumber)
! Add new Property to the Atmosphere List
Call Add_Property(NewProperty)
else
call Block_Unlock(Me%ObjEnterData, ClientNumber, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) &
stop 'ConstructPropertyList - ModuleAtmosphere - ERR10'
exit do1 !No more blocks
end if cd2
else if (STAT_CALL .EQ. BLOCK_END_ERR_) then cd1
write(*,*)
write(*,*) 'Error calling ExtractBlockFromBuffer. '
stop 'ConstructPropertyList - ModuleAtmosphere - ERR20'
end if cd1
end do do1
if (Me%OverrideWindVelStandard) then
call OverrideWindVel
else
!Verifies Wind consistence. Now is done by vectorial prop
call SearchProperty(PropertyX, WindVelocityX_, .false., STAT = STAT_CALL)
if (STAT_CALL == SUCCESS_) then
write(*,*) 'Vectorial Property wind velocity is now defined in one single block'
write(*,*) 'See Documentation on how to implement it'
stop 'ConstructPropertyList - ModuleAtmosphere . ERR30'
endif
call SearchProperty(PropertyX, WindVelocityY_, .false., STAT = STAT_CALL)
if (STAT_CALL == SUCCESS_) then
write(*,*) 'Vectorial Property wind velocity is now defined in one single block'
write(*,*) 'See Documentation on how to implement it'
stop 'ConstructPropertyList - ModuleAtmosphere . ERR40'
endif
endif
!Rotates Vectores
!call RotateAtmosphereVectorFields(Constructing = .true.)
!Checks if Relative Humidity is between 0 and 1
call SearchProperty(PropertyX, RelativeHumidity_, .false., STAT = STAT_CALL)
if (STAT_CALL == SUCCESS_) then
do j = Me%WorkSize%JLB, Me%WorkSize%JUB
do i = Me%WorkSize%ILB, Me%WorkSize%IUB
if (Me%ExternalVar%MappingPoints2D(i, j) == 1) then
if (PropertyX%Field(i, j) > 1.2) then
write(*,*)'Relative Humidity must be given between 0 and 1.2'
stop 'ConstructPropertyList - ModuleAtmosphere - ERR50'
endif
endif
enddo
enddo
endif
!If Solar radiation exists, add ATMTransmitivity
call SearchProperty(PropertyX, SolarRadiation_, .false., STAT = STAT_CALL)
if (STAT_CALL == SUCCESS_) then
allocate (NewProperty, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructPropertyList - ModuleAtmosphere - ERR60'
!nullify(NewProperty%Field )
!nullify(NewProperty%FieldGrid)
!nullify(NewProperty%Next )
!nullify(NewProperty%Prev )
allocate(NewProperty%Field(Me%Size%ILB:Me%Size%IUB, Me%Size%JLB:Me%Size%JUB))
NewProperty%Field(:,:) = null_real
!NewProperty%FieldGrid => NewProperty%Field
NewProperty%ID%IDnumber = AtmTransmitivity_
NewProperty%ID%Name = GetPropertyName (AtmTransmitivity_)
NewProperty%Constant = .false.
call Add_Property(NewProperty)
endif
call CheckForObsoleteNames
call SearchProperty(PropertyX, CloudCover_, .false., STAT = STAT_CALL)
if (STAT_CALL == SUCCESS_) then
!Do not use random number as default method to compute cloud cover. David June 2015
call GetData(dummy, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'CLOUD_COVER_METHOD', &
ClientModule = 'ModuleAtmosphere', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructPropertyList - ModuleAtmosphere - ERR70'
!if keyword not found but model will compute it, warn user that the default method has changed
if (iflag == 0 .and. .not. PropertyX%ID%SolutionFromFile .and. .not. PropertyX%Constant) then
write (*,*) ''
write (*,*) 'CLOUD_COVER_METHOD keyword not found in atmosphere data file'
write (*,*) 'and model will compute cloud cover'
write (*,*) 'The default method to compute cloud cover has changed '
write (*,*) 'Now is from measured radiation or CLOUD_COVER_METHOD : 3 '
write (*,*) ''
endif
!if computing cloud cover from radiation, cant compute radiation from cloud cover
!this is a "pescadinha de rabo na boca" that can not exist
call SearchProperty(PropertyY, SolarRadiation_, .false., STAT = STAT_CALL)
if (STAT_CALL == SUCCESS_) then
if (.not. PropertyX%ID%SolutionFromFile .and. .not. PropertyX%Constant &
.and. .not. PropertyY%ID%SolutionFromFile .and. .not. PropertyY%Constant &
.and. Me%CloudCoverMethod == CloudFromRadiation) then
write (*,*) ''
write (*,*) 'Model will compute cloud cover and compute solar radiation'
write (*,*) 'and method for cloud cover uses radiation '
write (*,*) 'and method for radiation uses cloud cover '
write (*,*) 'This options are inconsistent. Change them '
write (*,*) ''
stop 'ConstructPropertyList - ModuleAtmosphere - ERR80'
endif
endif
endif
end subroutine ConstructPropertyList
!--------------------------------------------------------------------------
subroutine OverrideWindVel
!Local-----------------------------------------------------------------
type (T_Property), pointer :: PropertyX => null()
type (T_Property), pointer :: PropertyY => null()
type (T_Property), pointer :: PropertyZ => null()
integer :: STAT_CALL
!Begin-----------------------------------------------------------------
call SearchProperty(PropertyX, WindVelocityX_, .false., STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) then
stop 'OverrideWindVel - ModuleAtmosphere . ERR10'
endif
call SearchProperty(PropertyY, WindVelocityY_, .false., STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) then
stop 'OverrideWindVel - ModuleAtmosphere . ERR30'
endif
call SearchProperty(PropertyZ, WindVelocity_, .false., STAT = STAT_CALL)
if (STAT_CALL == SUCCESS_) then
if (PropertyX%ID%SolutionFromFile) then
call ModifyFillMatrix (FillMatrixID = PropertyX%ID%ObjFillMatrix, &
Matrix2D = PropertyX%Field, &
PointsToFill2D = Me%ExternalVar%MappingPoints2D, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'OverrideWindVel - ModuleAtmosphere - ERR50'
if (PropertyZ%UseToPredictDT) then
!From Wind X -> Wind
call GetFillMatrixDTPrediction (PropertyX%ID%ObjFillMatrix, PropertyZ%PredictedDT, &
PropertyZ%DTForNextEvent, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'OverrideWindVel - ModuleAtmosphere - ERR60'
endif
endif
if (PropertyY%ID%SolutionFromFile) then
call ModifyFillMatrix (FillMatrixID = PropertyY%ID%ObjFillMatrix, &
Matrix2D = PropertyY%Field, &
PointsToFill2D = Me%ExternalVar%MappingPoints2D, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'OverrideWindVel - ModuleAtmosphere - ERR70'
if (PropertyZ%UseToPredictDT) then
!From Wind Y -> Wind
call GetFillMatrixDTPrediction (PropertyY%ID%ObjFillMatrix, PropertyZ%PredictedDT, &
PropertyZ%DTForNextEvent, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'OverrideWindVel - ModuleAtmosphere - ERR80'
endif
endif
PropertyZ%FieldX(:,:) = PropertyX%Field(:,:)
PropertyZ%FieldY(:,:) = PropertyY%Field(:,:)
!!Need to rotate input field (Me%Matrix2DX and Me%Matrix2DY) to grid (Me%Matrix2DU and Me%Matrix2DV)
call RotateVectorFieldToGrid(HorizontalGridID = Me%ObjHorizontalGrid, &
VectorInX = PropertyZ%FieldX, &
VectorInY = PropertyZ%FieldY, &
VectorOutX = PropertyZ%FieldU, &
VectorOutY = PropertyZ%FieldV, &
WaterPoints2D = Me%ExternalVar%MappingPoints2D,&
RotateX = .true., &
RotateY = .true., &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) then
stop 'OverrideWindVel - ModuleAtmosphere . ERR90'
endif
else
write(*,*) 'Missing wind velocity property'
stop 'OverrideWindVel - ModuleAtmosphere . ERR100'
endif
nullify (PropertyX)
nullify (PropertyY)
nullify (PropertyZ)
end subroutine OverrideWindVel
!--------------------------------------------------------------------------
subroutine CheckPropertyValues(Constructing)
!Argument--------------------------------------------------------------
logical :: Constructing
!Local-----------------------------------------------------------------
type (T_Property), pointer :: PropertyX => null()
real :: Year, Month, Day, Hour, Minute, Second
integer :: STAT_CALL, i, j
!Begin-----------------------------------------------------------------
!Gets Current Time
call GetComputeCurrentTime(Me%ObjTime, Me%ActualTime, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'CheckPropertyValues - ModuleAtmosphere - ERR01'
call ExtractDate(Me%ActualTime, Year, Month, Day, Hour, Minute, Second)
PropertyX => Me%FirstAtmosphereProp
!Properties that can not be negative. Stop the model and warn the user
do while (associated(PropertyX))
if ( PropertyX%ID%IDNumber==Precipitation_ &
.or. PropertyX%ID%IDNumber==SolarRadiation_ &
.or. PropertyX%ID%IDNumber==RelativeHumidity_ &
.or. PropertyX%ID%IDNumber==WindModulus_ &
.or. PropertyX%ID%IDNumber==PBLHeight_ ) then
!check always in construction phase. only check in modify if the prop has solution from file
if (Constructing .or. PropertyX%ID%SolutionFromFile) then
do j = Me%WorkSize%JLB, Me%WorkSize%JUB
do i = Me%WorkSize%ILB, Me%WorkSize%IUB
if (Me%ExternalVar%MappingPoints2D(i, j) == 1) then
if (PropertyX%Field(i, j) < 0.0) then
write(*,*) 'Negative values in Atmosphere Property at instant'
write(*,'(6f5.0)') Year, Month, Day, Hour, Minute, Second
write(*,*)'ThisProperty can not be negative: ', trim(PropertyX%ID%Name)
stop 'CheckPropertyValues - ModuleAtmosphere - ERR10'
endif
endif
enddo
enddo
endif
endif
PropertyX => PropertyX%Next
end do
nullify(PropertyX)
end subroutine CheckPropertyValues
!--------------------------------------------------------------------------
subroutine CheckForObsoleteNames
!Local-----------------------------------------------------------------
type (T_Property), pointer :: PropertyX => null()
logical :: UsingObseletePropertyName
!Begin-----------------------------------------------------------------
UsingObseletePropertyName = .false.
PropertyX => Me%FirstAtmosphereProp
do while (associated(PropertyX))
if (PropertyX%ID%IDNumber==WindAngle_ ) then
UsingObseletePropertyName = .true.
write(*,*)
write(*,*)"You are trying to use property wind angle in ModuleAtmosphere"
write(*,*)"This property name is obsolete and is now called wind direction"
write(*,*)"Please update your Atmosphere input data file"
write(*,*)
elseif(PropertyX%ID%IDNumber==WindModulos_ ) then
UsingObseletePropertyName = .true.
write(*,*)
write(*,*)"You are trying to use property wind modulos in ModuleAtmosphere"
write(*,*)"This property name is obsolete and is now called wind modulus"
write(*,*)"Please update your Atmosphere input data file"
write(*,*)
end if
PropertyX => PropertyX%Next
end do
if(UsingObseletePropertyName)then
write(*,*)'CheckForObsoleteNames - ModuleAtmosphere - ERR01'
stop
endif
nullify(PropertyX)
end subroutine CheckForObsoleteNames
!--------------------------------------------------------------------------
!subroutine RotateAtmosphereVectorFields(Constructing)
! !Arguments-------------------------------------------------------------
! logical :: Constructing
!
! !Local-----------------------------------------------------------------
! type (T_Property), pointer :: PropertyX => null()
! type (T_Property), pointer :: PropertyY => null()
! integer :: STAT_CALL
!
!
! !----------------------------------------------------------------------
!
!
! call SearchProperty(PropertyX, WindVelocityX_, .false., STAT = STAT_CALL)
! if (STAT_CALL == SUCCESS_) then
! call SearchProperty(PropertyY, WindVelocityY_, .false., STAT = STAT_CALL)
! if (STAT_CALL == SUCCESS_) then
!
! if (Constructing) then
! nullify (PropertyX%FieldGrid)
! allocate(PropertyX%FieldGrid(Me%Size%ILB:Me%Size%IUB, Me%Size%JLB:Me%Size%JUB))
!
! PropertyX%FieldGrid(:,:) = null_real
!
! nullify (PropertyY%FieldGrid)
! allocate(PropertyY%FieldGrid(Me%Size%ILB:Me%Size%IUB, Me%Size%JLB:Me%Size%JUB))
!
! PropertyY%FieldGrid(:,:) = null_real
!
! endif
!
!
! call RotateVectorFieldToGrid(HorizontalGridID = Me%ObjHorizontalGrid, &
! VectorInX = PropertyX%Field, &
! VectorInY = PropertyY%Field, &
! VectorOutX = PropertyX%FieldGrid, &
! VectorOutY = PropertyY%FieldGrid, &
! WaterPoints2D = Me%ExternalVar%MappingPoints2D, &
! RotateX = .true., &
! RotateY = .true., &
! STAT = STAT_CALL)
! endif
! endif
!
!
!end subroutine RotateAtmosphereVectorFields
!--------------------------------------------------------------------------
!This subroutine reads all the information needed to construct a new property.
subroutine ConstructProperty(NewProperty, ClientID)
!Arguments-------------------------------------------------------------
type(T_property), pointer :: NewProperty
integer :: ClientID
!External--------------------------------------------------------------
integer :: STAT_CALL
!----------------------------------------------------------------------
!Allocates new property
allocate (NewProperty, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructProperty - ModuleAtmosphere - ERR01'
nullify(NewProperty%Field )
!nullify(NewProperty%FieldGrid)
nullify(NewProperty%Next )
nullify(NewProperty%Prev )
!Construct property ID
call ConstructPropertyID (NewProperty%ID, Me%ObjEnterData, FromBlock)
!Construct property values
call Construct_PropertyValues (NewProperty, ClientID)
!Defines the property output
call Construct_PropertyOutPut (NewProperty)
!Constructs Statistics
call ConstructSurfStatistics (NewProperty)
!----------------------------------------------------------------------
end subroutine ConstructProperty
!--------------------------------------------------------------------------
!This subroutine reads all the information needed to construct the property values
! in the domain and in the boundaries
subroutine Construct_PropertyValues (NewProperty, ClientID)
!Arguments-------------------------------------------------------------
type(T_property), pointer :: NewProperty
integer :: ClientID
!External--------------------------------------------------------------
integer :: STAT_CALL
!Local-----------------------------------------------------------------
integer :: iflag
integer :: SizeILB, SizeIUB
integer :: SizeJLB, SizeJUB
real :: MinForDTDecrease
logical :: UseForDTPred
!----------------------------------------------------------------------
SizeILB = Me%Size%ILB
SizeIUB = Me%Size%IUB
SizeJLB = Me%Size%JLB
SizeJUB = Me%Size%JUB
!Fills Matrix
!Vectorial prop will have u and v fields (rotated to cell)
!~ if (Check_Vectorial_Property(NewProperty%ID%IDNumber)) then
if (NewProperty%ID%IsVectorial) then
!converted field to cell referential
allocate (NewProperty%FieldU (SizeILB:SizeIUB, SizeJLB:SizeJUB), STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModuleAtmosphere - Construct_PropertyValues - ERR00'
NewProperty%FieldU(:,:) = null_real
!converted field to cell referential
allocate (NewProperty%FieldV (SizeILB:SizeIUB, SizeJLB:SizeJUB), STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModuleAtmosphere - Construct_PropertyValues - ERR10'
NewProperty%FieldV(:,:) = null_real
!original field (only for output)
allocate (NewProperty%FieldX (SizeILB:SizeIUB, SizeJLB:SizeJUB), STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModuleAtmosphere - Construct_PropertyValues - ERR15'
NewProperty%FieldX(:,:) = null_real
!original field (only for output)
allocate (NewProperty%FieldY (SizeILB:SizeIUB, SizeJLB:SizeJUB), STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModuleAtmosphere - Construct_PropertyValues - ERR16'
NewProperty%FieldY(:,:) = null_real
else
allocate (NewProperty%Field (SizeILB:SizeIUB, SizeJLB:SizeJUB), STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModuleAtmosphere - Construct_PropertyValues - ERR017'
NewProperty%Field(:,:) = null_real
!if angle needs also original field (for output)
!~ if (Check_Angle_Property(NewProperty%ID%IDNumber)) then
if (NewProperty%ID%IsAngle) then
allocate (NewProperty%FieldInputRef (SizeILB:SizeIUB, SizeJLB:SizeJUB), STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModuleAtmosphere - Construct_PropertyValues - ERR018'
NewProperty%FieldInputRef(:,:) = null_real
endif
endif
!NewProperty%FieldGrid => NewProperty%Field
!Properties added in a specific time interval (normally a short interval)
!This is usefull for near instantaneous events (ex.:high precipitation in
!very small time period). In this option instead of interpolation one
!calculates the exact amount of property in a time period. This requires
!variableDT.
call GetData(NewProperty%NoInterpolateValueInTime, &
Me%ObjEnterData, iflag, &
Default = .false., &
SearchType = FromBlock, &
keyword ='NO_INTERPOLATION', &
ClientModule = 'ModuleAtmosphere', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_)stop 'Construct_PropertyValues - ModuleAtmosphere - ERR020'
if (iflag .NE. 0) then
write(*,*)
write(*,*) 'ModuleAtmosphere WARNING:'
write(*,*) 'NO_INTERPOLATION keyword is deprecated.'
write(*,*) 'To use accumulated values use instead :'
write(*,*) ' "ACCUMULATE_VALUES : 1" '
write(*,*)
STOP 'Construct_PropertyValues - ModuleAtmosphere - ERR030'
! if (NewProperty%NoInterpolateValueInTime) then
! NewProperty%AccumulateValueInTime = .true.
! else
! NewProperty%AccumulateValueInTime = .false.
! endif
! else
! call GetData(NewProperty%AccumulateValueInTime, &
! Me%ObjEnterData, iflag, &
! Default = .false., &
! SearchType = FromBlock, &
! keyword ='ACCUMULATE_VALUES', &
! ClientModule = 'ModuleAtmosphere', &
! STAT = STAT_CALL)
! if (STAT_CALL /= SUCCESS_)stop 'Construct_PropertyValues - ModuleAtmosphere - ERR030'
endif
if ((NewProperty%ID%IDNumber==Temperature_) .or. &
(NewProperty%ID%IDNumber==WindAngle_) .or. &
(NewProperty%ID%IDNumber==WindDirection_)) then
MinForDTDecrease = null_real
else
MinForDTDecrease = 0.0
endif
if (NewProperty%ID%IDNumber == Irrigation_ .or. NewProperty%ID%IDNumber == Precipitation_) then
UseForDTPred = .true.
else
UseForDTPred = .false.
endif
!~ if (Check_Vectorial_Property(NewProperty%ID%IDNumber)) then
if (NewProperty%ID%IsVectorial) then
call ConstructFillMatrix(PropertyID = NewProperty%ID, &
EnterDataID = Me%ObjEnterData, &
TimeID = Me%ObjTime, &
HorizontalGridID = Me%ObjHorizontalGrid, &
ExtractType = FromBlock, &
PointsToFill2D = Me%ExternalVar%MappingPoints2D, &
Matrix2DU = NewProperty%FieldU, &
Matrix2DV = NewProperty%FieldV, &
Matrix2DX = NewProperty%FieldX, &
Matrix2DY = NewProperty%FieldY, &
TypeZUV = TypeZ_, &
ClientID = ClientID, &
PredictDTMethod = Me%PredictDTMethod, &
MinForDTDecrease = MinForDTDecrease, &
ValueIsUsedForDTPrediction = UseForDTPred, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'Construct_PropertyValues - ModuleAtmosphere - ERR035'
else
!~ if (Check_Angle_Property(NewProperty%ID%IDNumber)) then
if (NewProperty%ID%IsAngle) then
call ConstructFillMatrix(PropertyID = NewProperty%ID, &
EnterDataID = Me%ObjEnterData, &
TimeID = Me%ObjTime, &
HorizontalGridID = Me%ObjHorizontalGrid, &
ExtractType = FromBlock, &
PointsToFill2D = Me%ExternalVar%MappingPoints2D, &
Matrix2D = NewProperty%Field, &
Matrix2DInputRef = NewProperty%FieldInputRef, &
TypeZUV = TypeZ_, &
ClientID = ClientID, &
PredictDTMethod = Me%PredictDTMethod, &
MinForDTDecrease = MinForDTDecrease, &
ValueIsUsedForDTPrediction = UseForDTPred, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'Construct_PropertyValues - ModuleAtmosphere - ERR040'
else
call ConstructFillMatrix(PropertyID = NewProperty%ID, &
EnterDataID = Me%ObjEnterData, &
TimeID = Me%ObjTime, &
HorizontalGridID = Me%ObjHorizontalGrid, &
ExtractType = FromBlock, &
PointsToFill2D = Me%ExternalVar%MappingPoints2D, &
Matrix2D = NewProperty%Field, &
TypeZUV = TypeZ_, &
ClientID = ClientID, &
PredictDTMethod = Me%PredictDTMethod, &
MinForDTDecrease = MinForDTDecrease, &
ValueIsUsedForDTPrediction = UseForDTPred, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'Construct_PropertyValues - ModuleAtmosphere - ERR041'
endif
endif
call GetValuesProcessingOptions (NewProperty%ID%ObjFillMatrix, &
Accumulate = NewProperty%AccumulateValueInTime, &
Interpolate = NewProperty%InterpolateValueInTime, &
UseOriginal = NewProperty%UseOriginalValue, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'Construct_PropertyValues - ModuleAtmosphere - ERR042'
!check if property accumulated is precipitation or irrigation
if (NewProperty%AccumulateValueInTime) then
if (NewProperty%ID%IDNumber /= Precipitation_ .and. NewProperty%ID%IDNumber /= Irrigation_) then
write(*,*)
write(*,*) 'Found Property with ACCUMULATED_VALUES but is not'
write(*,*) 'precipitation or irrigation', trim(NewProperty%ID%Name)
write(*,*) 'Remove that keyword from the property block'
stop 'Construct_PropertyValues - ModuleAtmosphere - ERR043'
endif
endif
call GetIfMatrixRemainsConstant(FillMatrixID = NewProperty%ID%ObjFillMatrix, &
RemainsConstant = NewProperty%Constant, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) &
stop 'Construct_PropertyValues - ModuleAtmosphere - ERR044'
if (.not. NewProperty%ID%SolutionFromFile) then
call KillFillMatrix (NewProperty%ID%ObjFillMatrix, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'Construct_PropertyValues - ModuleAtmosphere - ERR050'
endif
!By default property don't have random component
NewProperty%HasRandomComponent = .false.
call GetData(NewProperty%RandomComponent, &
Me%ObjEnterData, iflag, &
SearchType = FromBlock, &
keyword = 'RANDOM_COMPONENT', &
ClientModule = 'ModuleAtmosphere', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_)stop 'Construct_PropertyValues - ModuleAtmosphere - ERR060'
if (iflag == 1) then
NewProperty%HasRandomComponent = .true.
NewProperty%RandomValue = 0.
endif
if(NewProperty%HasRandomComponent .and. NewProperty%Constant)then
write(*,*)
write(*,*)'WARNING - Atmosphere property has random component and is defined as constant'
write(*,*)'Property name : ', trim(NewProperty%ID%Name)
write(*,*)
end if
!~ if(NewProperty%HasRandomComponent .and. Check_Vectorial_Property(NewProperty%ID%IDNumber)) then
if (NewProperty%HasRandomComponent .and. NewProperty%ID%IsVectorial) then
write(*,*)
write(*,*)'ERROR - Atmosphere vectorial property cant have for now random component'
write(*,*)'Property name : ', trim(NewProperty%ID%Name)
stop 'Construct_PropertyValues - ModuleAtmosphere - ERR065'
end if
!By default property aren't added by irrigation
call GetData(NewProperty%PropAddedByIrri, &
Me%ObjEnterData, iflag, &
SearchType = FromBlock, &
keyword ='IRRIGATION', &
ClientModule = 'ModuleAtmosphere', &
default = .false., &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_)stop 'Construct_PropertyValues - ModuleAtmosphere - ERR070'
if (NewProperty%PropAddedByIrri) then
Me%PropsAddedByIrri = .true.
endif
!By default property aren't added by precipitation
call GetData(NewProperty%PropAddedByRain, &
Me%ObjEnterData, iflag, &
SearchType = FromBlock, &
keyword ='PRECIPITATION', &
default = .false., &
ClientModule = 'ModuleAtmosphere', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_)stop 'Construct_PropertyValues - ModuleAtmosphere - ERR080'
if (NewProperty%PropAddedByRain) then
Me%PropsAddedByRain = .true.
endif
call GetData(NewProperty%UseToPredictDT, &
Me%ObjEnterData, iflag, &
SearchType = FromBlock, &
keyword = 'USE_TO_PREDICT_DT', &
default = .false., &
ClientModule = 'ModuleAtmosphere', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_)stop 'Construct_PropertyValues - ModuleAtmosphere - ERR090'
if (NewProperty%ID%SolutionFromFile) then
if (NewProperty%ID%IDNumber == Irrigation_) then
NewProperty%UseToPredictDT = .true.
elseif (NewProperty%ID%IDNumber == Precipitation_) then
NewProperty%UseToPredictDT = .true.
endif
endif
!if (NewProperty%ID%IDNumber == WindDirection_) then
! !A rotation of the wind direction is done, so that
! ! 0 - Wind from the North
! ! 90 - Wind from the West
! !180 - Wind from the South
! !270 - Wind from the East
! do j = Me%Size%JLB, Me%Size%JUB
! do i = Me%Size%ILB, Me%Size%IUB
! if (Me%ExternalVar%MappingPoints2D(i, j) == WaterPoint) then
! NewProperty%Field(i, j) = 270. - NewProperty%Field(i, j)
! else
! NewProperty%Field(i, j) = FillValueReal
! endif
! enddo
! enddo
!
!
!endif
!----------------------------------------------------------------------
end subroutine Construct_PropertyValues
!--------------------------------------------------------------------------
subroutine ConstructOutPut
!External-----------------------------------------------------------------
integer :: STAT_CALL
!Begin-----------------------------------------------------------------
call GetOutPutTime(Me%ObjEnterData, &
CurrentTime = Me%ActualTime, &
EndTime = Me%EndTime, &
keyword = 'OUTPUT_TIME', &
SearchType = FromFile, &
OutPutsTime = Me%OutPut%OutTime, &
OutPutsOn = Me%OutPut%True, &
OutPutsNumber = Me%OutPut%Number, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructOutPut - ModuleAtmosphere - ERR01'
if (Me%OutPut%True) Me%OutPut%NextHDF5 = 1
end subroutine ConstructOutPut
!--------------------------------------------------------------------------
subroutine Construct_PropertyOutPut(NewProperty)
!Arguments------------------------------------------------------------
type(T_property), pointer :: NewProperty
!Local-----------------------------------------------------------------
integer :: STAT_CALL
integer :: iflag
!Begin----------------------------------------------------------------
call GetData(NewProperty%OutputHDF, &
Me%ObjEnterData, iflag, &
Keyword = 'OUTPUT_HDF', &
Default = .false., &
SearchType = FromBlock, &
ClientModule = 'ModuleAtmosphere', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) &
stop 'Construct_PropertyOutPut - ModuleAtmosphere - ERR01'
call GetData(NewProperty%TimeSerie, &
Me%ObjEnterData, iflag, &
Keyword = 'TIME_SERIE', &
Default = .false., &
SearchType = FromBlock, &
ClientModule = 'ModuleAtmosphere', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) &
stop 'Construct_PropertyOutPut - ModuleAtmosphere - ERR02'
call GetData(NewProperty%BoxTimeSerie, &
Me%ObjEnterData, iflag, &
Keyword = 'BOX_TIME_SERIE', &
Default = .false., &
SearchType = FromBlock, &
ClientModule = 'ModuleAtmosphere', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) &
stop 'Construct_PropertyOutPut - ModuleAtmosphere - ERR03'
end subroutine Construct_PropertyOutPut
!--------------------------------------------------------------------------
subroutine ConstructSurfStatistics(NewProperty)
!Arguments-------------------------------------------------------------
type(T_property), pointer :: NewProperty
!Local-----------------------------------------------------------------
integer :: STAT_CALL
integer :: iflag
integer :: ILB, IUB, JLB, JUB
integer :: WILB, WIUB, WJLB, WJUB
!Begin-----------------------------------------------------------------
ILB = Me%Size%ILB
IUB = Me%Size%IUB
JLB = Me%Size%JLB
JUB = Me%Size%JUB
WILB = Me%WorkSize%ILB
WIUB = Me%WorkSize%IUB
WJLB = Me%WorkSize%JLB
WJUB = Me%WorkSize%JUB
!<BeginKeyword>
!Keyword : STATISTICS
!<BeginDescription>
!
! Checks out if the user pretends the statistics of this property
!
!<EndDescription>
!Type : Boolean
!Default : .false.
!File keyword : DISPQUAL
!Multiple Options : Do not have
!Search Type : FromBlock
!Begin Block : <beginproperty>
!End Block : <endproperty>
!<EndKeyword>
call GetData(NewProperty%Statistics%ON, &
Me%ObjEnterData, iflag, &
Keyword = 'STATISTICS', &
Default = .false., &
SearchType = FromBlock, &
ClientModule = 'ModuleAtmosphere', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructSurfStatistics - Atmosphere - ERR01'
cd2: if (NewProperty%Statistics%ON) then
!~ if (Check_Vectorial_Property(NewProperty%ID%IDNumber)) then
if (NewProperty%ID%IsVectorial) then
write(*,*)
write(*,*)'ERROR - Atmosphere vectorial property cant have for now statistics'
write(*,*)'Property name : ', trim(NewProperty%ID%Name)
stop 'ConstructSurfStatistics - ModuleAtmosphere - ERR01a'
endif
!<BeginKeyword>
!Keyword : STATISTICS_FILE
!<BeginDescription>
!
! The statistics definition file of this property
!
!<EndDescription>
!Type : Character
!Default : Do not have
!File keyword : DISPQUAL
!Multiple Options : Do not have
!Search Type : FromBlock
!Begin Block : <beginproperty>
!End Block : <endproperty>
!<EndKeyword>
call GetData(NewProperty%Statistics%File, &
Me%ObjEnterData, iflag, &
Keyword = 'STATISTICS_FILE', &
SearchType = FromBlock, &
ClientModule = 'ModuleAtmosphere', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_ .or. iflag /= 1) &
stop 'ConstructSurfStatistics - Atmosphere - ERR02'
call ConstructStatistic (StatisticID = NewProperty%Statistics%ID, &
ObjTime = Me%ObjTime, &
ObjHDF5 = Me%ObjHDF5, &
Size = T_Size3D(ILB, IUB, JLB, JUB,0,0), &
WorkSize = T_Size3D(WILB, WIUB, WJLB, WJUB,0,0), &
DataFile = NewProperty%Statistics%File, &
Name = NewProperty%ID%name, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructSurfStatistics - Atmosphere - ERR03'
endif cd2
end subroutine ConstructSurfStatistics
!--------------------------------------------------------------------------
! This subroutine adds a new property to the Water Property List
subroutine Add_Property(NewProperty)
!Arguments-------------------------------------------------------------
type(T_Property), pointer :: NewProperty
!----------------------------------------------------------------------
! Add to the WaterProperty List a new property
if (.not.associated(Me%FirstAtmosphereProp)) then
Me%PropertiesNumber = 1
Me%FirstAtmosphereProp => NewProperty
Me%LastAtmosphereProp => NewProperty
else
NewProperty%Prev => Me%LastAtmosphereProp
Me%LastAtmosphereProp%Next => NewProperty
Me%LastAtmosphereProp => NewProperty
Me%PropertiesNumber = Me%PropertiesNumber + 1
end if
!----------------------------------------------------------------------
end subroutine Add_Property
!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!SELECTOR SELECTOR SELECTOR SELECTOR SELECTOR SELECTOR SELECTOR SELECTOR
!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!COARE
!--------------------------------------------------------------------------
subroutine GetWindHeight(AtmosphereID, Height, isdefined, STAT)
!Arguments--------------------------------------------------------------
integer :: AtmosphereID
real, intent(OUT) :: Height
integer, optional, intent(OUT) :: STAT
logical :: isdefined
!External--------------------------------------------------------------
integer :: ready_
!Local-----------------------------------------------------------------
integer :: STAT_
!----------------------------------------------------------------------
STAT_ = UNKNOWN_
call Ready(AtmosphereID, ready_)
if ((ready_ .EQ. IDLE_ERR_ ) .OR. &
(ready_ .EQ. READ_LOCK_ERR_)) then
Height = Me%WindHeight
isdefined = Me%WindHeightDefined
STAT_ = SUCCESS_
else
STAT_ = ready_
end if
if (present(STAT)) STAT = STAT_
!----------------------------------------------------------------------
end subroutine GetWindHeight
subroutine GetAirMeasurementHeight(AtmosphereID, AirHeight, isdefined, STAT)
!Arguments--------------------------------------------------------------
integer :: AtmosphereID
real, intent(OUT) :: AirHeight
integer, optional, intent(OUT) :: STAT
logical :: isdefined
!External--------------------------------------------------------------
integer :: ready_
!Local-----------------------------------------------------------------
integer :: STAT_
!----------------------------------------------------------------------
STAT_ = UNKNOWN_
call Ready(AtmosphereID, ready_)
if ((ready_ .EQ. IDLE_ERR_ ) .OR. &
(ready_ .EQ. READ_LOCK_ERR_)) then
AirHeight = Me%AirMeasurementHeight
isdefined = Me%AirMeasurementHeightDefined
STAT_ = SUCCESS_
else
STAT_ = ready_
end if
if (present(STAT)) STAT = STAT_
!----------------------------------------------------------------------
end subroutine GetAirMeasurementHeight
!COARE
subroutine GetAtmospherePropertyScalar(AtmosphereID, Scalar, ID, STAT, ShowWarning)
!Arguments--------------------------------------------------------------
integer :: AtmosphereID
real, dimension(:,:), pointer :: Scalar
integer :: ID
integer, optional, intent(OUT) :: STAT
logical, optional, intent(IN) :: ShowWarning
!External--------------------------------------------------------------
integer :: ready_
type (T_Property), pointer :: PropertyX
integer :: STAT_CALL
!Local-----------------------------------------------------------------
integer :: STAT_
logical :: warning
!----------------------------------------------------------------------
STAT_ = UNKNOWN_
call Ready(AtmosphereID, ready_)
if ((ready_ .EQ. IDLE_ERR_ ) .OR. &
(ready_ .EQ. READ_LOCK_ERR_)) then
if (present(ShowWarning)) then
warning = ShowWarning
else
warning = .true.
endif
nullify(PropertyX)
call SearchProperty(PropertyX, ID , warning, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) then
if (present(STAT)) then
STAT = NOT_FOUND_ERR_
return
else
stop 'GetAtmosphereProperty - ModuleAtmosphere - ERR01'
endif
endif
call Read_Lock(mATMOSPHERE_, Me%InstanceID)
!Get the Field (in case of wind direction is in cell referential)
Scalar => PropertyX%Field
STAT_ = SUCCESS_
else
STAT_ = ready_
end if
if (present(STAT)) STAT = STAT_
!----------------------------------------------------------------------
end subroutine GetAtmospherePropertyScalar
!--------------------------------------------------------------------------
subroutine GetAtmospherePropertyVectorial(AtmosphereID, ScalarU, ScalarV, ID, STAT, ShowWarning)
!Arguments--------------------------------------------------------------
integer :: AtmosphereID
real, dimension(:,:), pointer :: ScalarU
real, dimension(:,:), pointer :: ScalarV
integer :: ID
integer, optional, intent(OUT) :: STAT
logical, optional, intent(IN) :: ShowWarning
!External--------------------------------------------------------------
integer :: ready_
type (T_Property), pointer :: PropertyX
integer :: STAT_CALL
!Local-----------------------------------------------------------------
integer :: STAT_
logical :: warning
!----------------------------------------------------------------------
STAT_ = UNKNOWN_
call Ready(AtmosphereID, ready_)
if ((ready_ .EQ. IDLE_ERR_ ) .OR. &
(ready_ .EQ. READ_LOCK_ERR_)) then
if (present(ShowWarning)) then
warning = ShowWarning
else
warning = .true.
endif
nullify(PropertyX)
call SearchProperty(PropertyX, ID , warning, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) then
if (present(STAT)) then
STAT = NOT_FOUND_ERR_
return
else
stop 'GetAtmosphereProperty - ModuleAtmosphere - ERR01'
endif
endif
call Read_Lock(mATMOSPHERE_, Me%InstanceID)
call Read_Lock(mATMOSPHERE_, Me%InstanceID)
!Get the Field in cell referential
ScalarU => PropertyX%FieldU
ScalarV => PropertyX%FieldV
STAT_ = SUCCESS_
else
STAT_ = ready_
end if
if (present(STAT)) STAT = STAT_
!----------------------------------------------------------------------
end subroutine GetAtmospherePropertyVectorial
!--------------------------------------------------------------------------
logical function AtmospherePropertyExists(AtmosphereID, PropertyNumber)
!Arguments--------------------------------------------------------------
integer :: AtmosphereID
integer :: PropertyNumber
!External--------------------------------------------------------------
integer :: ready_
!Local-----------------------------------------------------------------
integer :: STAT_, STAT_CALL
type(T_Property), pointer :: PropertyX
!----------------------------------------------------------------------
STAT_ = UNKNOWN_
call Ready(AtmosphereID, ready_)
cd1 : if ((ready_ .EQ. IDLE_ERR_ ) .OR. &
(ready_ .EQ. READ_LOCK_ERR_)) then
AtmospherePropertyExists = .false.
call SearchProperty(PropertyX, PropertyNumber, .false., STAT_CALL)
if (STAT_CALL == SUCCESS_) AtmospherePropertyExists = .true.
nullify(PropertyX)
else
stop 'AtmospherePropertyExists - ModuleAtmosphere - ERR01'
end if cd1
end function AtmospherePropertyExists
!--------------------------------------------------------------------------
subroutine GetAtmospherenProperties (AtmosphereID, nProperties, STAT)
!Arguments--------------------------------------------------------------
integer :: AtmosphereID
integer :: nProperties
integer, intent(OUT), optional :: STAT
!Local------------------------------------------------------------------
integer :: STAT_CALL, ready_
!-----------------------------------------------------------------------
STAT_CALL = UNKNOWN_
call Ready(AtmosphereID, ready_)
if ((ready_ .EQ. IDLE_ERR_ ) .OR. (ready_ .EQ. READ_LOCK_ERR_)) then
nProperties = Me%PropertiesNumber
STAT_CALL = SUCCESS_
else
STAT_CALL = ready_
end if
if (present(STAT)) STAT = STAT_CALL
end subroutine GetAtmospherenProperties
!---------------------------------------------------------------------------
!---------------------------------------------------------------------------
subroutine GetAtmospherePropertiesIDByIdx (AtmosphereID, Idx, ID,PropRain,PropIrri, STAT)
!Arguments--------------------------------------------------------------
integer :: AtmosphereID
integer, intent(IN) :: Idx
integer, intent(OUT) :: ID
logical, intent(OUT) :: PropRain, PropIrri
integer, intent(OUT), optional :: STAT
!Local------------------------------------------------------------------
integer :: STAT_CALL, ready_, i
type (T_Property), pointer :: CurrProp
!-----------------------------------------------------------------------
STAT_CALL = UNKNOWN_
call Ready(AtmosphereID, ready_)
if ((ready_ .EQ. IDLE_ERR_ ) .OR. (ready_ .EQ. READ_LOCK_ERR_)) then
CurrProp => Me%FirstAtmosphereProp
do i = 1, idx - 1
CurrProp => CurrProp%Next
enddo
ID = CurrProp%ID%IDNumber
PropRain = CurrProp%PropAddedByRain
PropIrri = CurrProp%PropAddedByIrri
STAT_CALL = SUCCESS_
else
STAT_CALL = ready_
end if
if (present(STAT)) STAT = STAT_CALL
end subroutine GetAtmospherePropertiesIDByIdx
!---------------------------------------------------------------------------
subroutine GetNextAtmosphereDTPrediction (AtmosphereID, PredictedDT, DTForNextEvent, STAT)
!Arguments-------------------------------------------------------------
integer :: AtmosphereID
real, intent(OUT) :: PredictedDT, DTForNextEvent
integer, intent(OUT), optional :: STAT
!Local-----------------------------------------------------------------
integer :: STAT_, ready_
type(T_Property), pointer :: PropertyX
real :: max_value
!----------------------------------------------------------------------
STAT_ = UNKNOWN_
call Ready(AtmosphereID, ready_)
if ((ready_ .EQ. IDLE_ERR_ ) .OR. &
(ready_ .EQ. READ_LOCK_ERR_)) then
PredictedDT = -null_real
DTForNextEvent = -null_real
! call GetComputeTimeStep (Me%ObjTime, DT, STAT = STAT_)
! if (STAT_ /= SUCCESS_) stop 'GetNextAtmosphereDTPrediction - ModuleAtmosphere - ERR010'
! call GetGridCellArea (Me%ObjHorizontalGrid, Me%ExternalVar%GridCellArea, STAT_)
! if (STAT_ /= SUCCESS_) stop 'GetNextAtmosphereDTPrediction - ModuleAtmosphere - ERR020'
! write (*,*) '======================================'
! write (*,*) 'Irrigation%UseLimits : ', Me%Irrigation%UseLimits
! write (*,*) 'Rain%USeLimits : ', Me%Rain%UseLimits
! write (*,*) '======================================'
PropertyX => Me%FirstAtmosphereProp
do while (associated(PropertyX))
! if (PropertyX%ID%IDNumber == Irrigation_ .or. PropertyX%ID%IDNumber == Precipitation_) then
! write (*,*) '======================================'
! write (*,*) 'Property : ', trim(PropertyX%ID%Name)
! write (*,*) 'UseToPredictDT : ', PropertyX%UseToPredictDT
! write (*,*) 'DTForNextEvent: : ', PropertyX%DTForNextEvent
! write (*,*) '======================================'
! endif
if (PropertyX%UseToPredictDT) then
if (PropertyX%DTForNextEvent == 0.0) then
if (PropertyX%ID%IDNumber == Irrigation_ .and. Me%Irrigation%UseLimits) then
! write (*,*) '======================================'
! write (*,*) 'Me%Irrigation%MaxValue : ', Me%Irrigation%MaxValue
! write (*,*) 'Me%Irrigation%Heavy%DT : ', Me%Irrigation%Heavy%DT
! write (*,*) 'Me%Irrigation%Heavy%Limit : ', Me%Irrigation%Heavy%Limit
! write (*,*) 'Me%Irrigation%Medium%DT : ', Me%Irrigation%Medium%DT
! write (*,*) 'Me%Irrigation%Medium%Limit: ', Me%Irrigation%Medium%Limit
! write (*,*) 'Me%Irrigation%Light%DT : ', Me%Irrigation%Light%DT
! write (*,*) 'Me%Irrigation%Light%Limit : ', Me%Irrigation%Light%Limit
! write (*,*) 'PropertyX%PredictedDT : ', PropertyX%PredictedDT
! write (*,*) '======================================'
if (Me%IrriReqConv) then
!mm/hour = ( m/s ) * mm/m * s/hour
max_value = Me%Irrigation%MaxValue * Me%ConversionFactorIrri * 1000 * 3600
else
!In this case, the Irrigation Limits also need to be in m3/s
max_value = Me%Irrigation%MaxValue
endif
! write (*,*) '======================================'
! write (*,*) 'Irrigation%PredictedDT : ', PropertyX%PredictedDT
! write (*,*) 'max_value : ', max_value
! write (*,*) 'MaxValue :', Me%Irrigation%MaxValue
! write (*,*) 'DT :', DT
! write (*,*) 'Factor :', Me%ConversionFactorIrri
! write (*,*) 'Area :', Me%ExternalVar%GridCellArea(Me%IrriMaxCoord(1),Me%IrriMaxCoord(2))
! write (*,*) '======================================'
if (max_value >= Me%Irrigation%Heavy%Limit) then
PredictedDT = min (PredictedDT, Me%Irrigation%Heavy%DT)
elseif (max_value >= Me%Irrigation%Medium%Limit) then
PredictedDT = min (PredictedDT, Me%Irrigation%Medium%DT)
elseif (max_value >= Me%Irrigation%Light%Limit) then
PredictedDT = min (PredictedDT, Me%Irrigation%Light%DT)
endif
elseif (PropertyX%ID%IDNumber == Precipitation_ .and. Me%Rain%UseLimits) then
if (Me%PrecReqConv) then
! mm/hour = ( m/s ) * mm/m * s/hour
max_value = (Me%Rain%MaxValue * Me%ConversionFactorPrec) * 1000 * 3600
else
!In this case, the Rain Limits also need to be in m3/s
max_value = Me%Rain%MaxValue
endif
! write (*,*) '======================================'
! write (*,*) 'Precipitation%PredictedDT : ', PropertyX%PredictedDT
! write (*,*) 'max_value : ', max_value
! write (*,*) 'MaxValue :', Me%Rain%MaxValue
! write (*,*) 'DT :', DT
! write (*,*) 'Factor :', Me%ConversionFactorPrec
! write (*,*) 'Area :', Me%ExternalVar%GridCellArea(Me%IrriMaxCoord(1),Me%IrriMaxCoord(2))
! write (*,*) '======================================'
! stop
if (max_value >= Me%Rain%Heavy%Limit) then
PredictedDT = min (PredictedDT, Me%Rain%Heavy%DT)
elseif (max_value >= Me%Rain%Medium%Limit) then
PredictedDT = min (PredictedDT, Me%Rain%Medium%DT)
elseif (max_value >= Me%Rain%Light%Limit) then
PredictedDT = min (PredictedDT, Me%Rain%Light%DT)
endif
endif
endif
PredictedDT = min (PredictedDT, PropertyX%PredictedDT)
DTForNextEvent = min (DTForNextEvent, PropertyX%DTForNextEvent)
endif
PropertyX => PropertyX%Next
end do
! if (Me%UsePrecipitationForDTPred .and. Me%UseIrrigationForDTPred) then
! PredictedDT = min(Me%IrriPredictedDT, Me%PrecPredictedDT)
! DTForNextEvent = min(Me%IrriDTForNextEvent, Me%PrecDTForNextEvent)
! elseif (Me%UseIrrigationForDTPred) then
! PredictedDT = Me%IrriPredictedDT
! DTForNextEvent = Me%IrriDTForNextEvent
! else
! PredictedDT = Me%PrecPredictedDT
! DTForNextEvent = Me%PrecDTForNextEvent
! endif
!
! call UngetHorizontalGrid(Me%ObjHorizontalGrid, Me%ExternalVar%GridCellArea, STAT = STAT_)
! if (STAT_ /= SUCCESS_) stop 'ReadUnlockExternalVar - ModuleAtmosphere - ERR030'
STAT_ = SUCCESS_
else
STAT_ = ready_
end if
if (present(STAT)) STAT = STAT_
end subroutine GetNextAtmosphereDTPrediction
!--------------------------------------------------------------------------
subroutine UngetAtmosphere1D(AtmosphereID, Array, STAT)
!Arguments-------------------------------------------------------------
integer :: AtmosphereID
real, pointer, dimension(:) :: Array
integer, optional, intent (OUT) :: STAT
!External--------------------------------------------------------------
integer :: ready_
!Local-----------------------------------------------------------------
integer :: STAT_
!----------------------------------------------------------------------
STAT_ = UNKNOWN_
call Ready(AtmosphereID, ready_)
cd1 : if (ready_ .EQ. READ_LOCK_ERR_) then
nullify(Array)
call Read_UnLock(mATMOSPHERE_, Me%InstanceID, "UngetSurface1D")
STAT_ = SUCCESS_
else
STAT_ = ready_
end if cd1
if (present(STAT)) &
STAT = STAT_
!----------------------------------------------------------------------
end subroutine UngetAtmosphere1D
!--------------------------------------------------------------------------
subroutine UngetAtmosphere2D(AtmosphereID, Array, STAT)
!Arguments-------------------------------------------------------------
integer :: AtmosphereID
real, pointer, dimension(:,:) :: Array
integer, optional, intent (OUT) :: STAT
!External--------------------------------------------------------------
integer :: ready_
!Local-----------------------------------------------------------------
integer :: STAT_
!----------------------------------------------------------------------
STAT_ = UNKNOWN_
call Ready(AtmosphereID, ready_)
cd1 : if (ready_ .EQ. READ_LOCK_ERR_) then
nullify(Array)
call Read_UnLock(mATMOSPHERE_, Me%InstanceID, "UngetAtmosphere2D")
STAT_ = SUCCESS_
else
STAT_ = ready_
end if cd1
if (present(STAT)) &
STAT = STAT_
!----------------------------------------------------------------------
end subroutine UngetAtmosphere2D
!--------------------------------------------------------------------------
subroutine SearchProperty(PropertyX, PropertyXIDNumber, PrintWarning, STAT)
!Arguments-------------------------------------------------------------
type(T_Property), optional, pointer :: PropertyX
integer , optional, intent (IN) :: PropertyXIDNumber
logical, optional, intent (IN) :: PrintWarning
integer , optional, intent (OUT) :: STAT
!Local-----------------------------------------------------------------
integer :: STAT_
!----------------------------------------------------------------------
STAT_ = UNKNOWN_
PropertyX => Me%FirstAtmosphereProp
do2 : do while (associated(PropertyX))
if5 : if (PropertyX%ID%IDNumber==PropertyXIDNumber) then
exit do2
else
PropertyX => PropertyX%Next
end if if5
end do do2
!A PropertyX was found
if (associated(PropertyX)) then
STAT_ = SUCCESS_
else
if (present(PrintWarning)) then
if (PrintWarning) write (*,*)'Property Not Found in Module Atmosphere ', &
trim(GetPropertyName(PropertyXIDNumber))
endif
STAT_ = NOT_FOUND_ERR_
end if
if (present(STAT)) STAT = STAT_
!----------------------------------------------------------------------
end subroutine SearchProperty
!----------------------------------------------------------------------
subroutine ReadLockExternalVar
!External--------------------------------------------------------------
integer :: STAT_CALL
!Begin-----------------------------------------------------------------
!GridCellArea
call GetGridCellArea (Me%ObjHorizontalGrid, Me%ExternalVar%GridCellArea, STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadLockExternalVar - ModuleAtmosphere - ERR01'
!Lat / Lon
call GetGridLatitudeLongitude(Me%ObjHorizontalGrid, &
GridLatitude = Me%ExternalVar%Latitude, &
GridLongitude = Me%ExternalVar%Longitude, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadLockExternalVar - ModuleAtmosphere - ERR02'
end subroutine ReadLockExternalVar
!----------------------------------------------------------------------
subroutine ReadUnlockExternalVar
!External--------------------------------------------------------------
integer :: STAT_CALL
!Begin-----------------------------------------------------------------
!GridCellArea
call UngetHorizontalGrid(Me%ObjHorizontalGrid, Me%ExternalVar%GridCellArea, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadUnlockExternalVar - ModuleAtmosphere - ERR01'
!Latitude
call UngetHorizontalGrid(Me%ObjHorizontalGrid, Me%ExternalVar%Latitude, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadUnlockExternalVar - ModuleAtmosphere - ERR02'
!Longitude
call UngetHorizontalGrid(Me%ObjHorizontalGrid, Me%ExternalVar%Longitude, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadUnlockExternalVar - ModuleAtmosphere - ERR03'
end subroutine ReadUnlockExternalVar
!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!MODIFIER MODIFIER MODIFIER MODIFIER MODIFIER MODIFIER MODIFIER MODIFIER
!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!--------------------------------------------------------------------------
subroutine ModifyAtmosphere(AtmosphereID, MappingPoints, STAT)
!Arguments-------------------------------------------------------------
integer :: AtmosphereID
integer, dimension(:, :), pointer :: MappingPoints
integer, intent(OUT), optional :: STAT
!Local-----------------------------------------------------------------
type(T_Property), pointer :: PropertyX => null()
!type(T_Property), pointer :: PropertyY => null()
integer :: STAT_, ready_
character(len = StringLength) :: WarningString
!External--------------------------------------------------------------
integer :: STAT_CALL
!Begin------------------------------------------------------------------------
if (MonitorPerformance) call StartWatch ("ModuleAtmosphere", "ModifyAtmosphere")
STAT_ = UNKNOWN_
call Ready(AtmosphereID, ready_)
cd0: if (ready_ .EQ. IDLE_ERR_) then
!Gets Current Time
call GetComputeCurrentTime(Me%ObjTime, Me%ActualTime, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModifyAtmosphere - ModuleAtmosphere - ERR01'
Me%ExternalVar%MappingPoints2D => MappingPoints
call ReadLockExternalVar
call SearchProperty(PropertyX, WindModulus_, STAT = STAT_CALL)
if (STAT_CALL == SUCCESS_) call ModifyWindModulus (PropertyX)
call SearchProperty(PropertyX, WindDirection_, STAT = STAT_CALL)
if (STAT_CALL == SUCCESS_) call ModifyWindDirection (PropertyX)
!Vectorial property
call SearchProperty(PropertyX, WindVelocity_, STAT = STAT_CALL)
if (STAT_CALL == SUCCESS_) call ModifyWindVelocity (PropertyX)
call SearchProperty(PropertyX, AirTemperature_, STAT = STAT_CALL)
if (STAT_CALL == SUCCESS_) call ModifyAirTemperature (PropertyX)
call SearchProperty(PropertyX, RelativeHumidity_, STAT = STAT_CALL)
if (STAT_CALL == SUCCESS_) call ModifyRelativeHumidity (PropertyX)
call SearchProperty(PropertyX, PBLHeight_, STAT = STAT_CALL)
if (STAT_CALL == SUCCESS_) call ModifyPBLHeight (PropertyX)
call SearchProperty(PropertyX, SunHours_, STAT = STAT_CALL)
if (STAT_CALL == SUCCESS_) call ModifySunHours (PropertyX)
call SearchProperty(PropertyX, CloudCover_, STAT = STAT_CALL)
if (STAT_CALL == SUCCESS_) call ModifyCloudCover (PropertyX)
call SearchProperty(PropertyX, Irrigation_, STAT = STAT_CALL)
if (STAT_CALL == SUCCESS_) call ModifyIrrigation (PropertyX)
call SearchProperty(PropertyX, Precipitation_, STAT = STAT_CALL)
if (STAT_CALL == SUCCESS_) call ModifyPrecipitation (PropertyX)
call SearchProperty(PropertyX, SolarRadiation_, STAT = STAT_CALL)
if (STAT_CALL == SUCCESS_) call ModifySolarRadiation (PropertyX)
call SearchProperty(PropertyX, AtmosphericPressure_, STAT = STAT_CALL)
if (STAT_CALL == SUCCESS_) call ModifyAtmosphericPressure (PropertyX)
call SearchProperty(PropertyX, CO2AtmosphericPressure_, STAT = STAT_CALL)
if (STAT_CALL == SUCCESS_) call ModifyCO2AtmosphericPressure (PropertyX)
call SearchProperty(PropertyX, O2AtmosphericPressure_, STAT = STAT_CALL)
if (STAT_CALL == SUCCESS_) call ModifyO2AtmosphericPressure (PropertyX)
call SearchProperty(PropertyX, MeanSeaLevelPressure_, STAT = STAT_CALL)
if (STAT_CALL == SUCCESS_) call ModifyMeanSeaLevelPressure (PropertyX)
call SearchProperty(PropertyX, AtmospDeposOxidNO3_, STAT = STAT_CALL) !LLP
if (STAT_CALL == SUCCESS_) call ModifyAtmospDeposOxidNO3 (PropertyX)
call SearchProperty(PropertyX, AtmospDeposReduNH4_, STAT = STAT_CALL) !LLP
if (STAT_CALL == SUCCESS_) call ModifyAtmospDeposReduNH4 (PropertyX)
call ModifyRandom
if (Me%PropsAddedByIrri) then
call ModifyPropByIrri
endif
if (Me%PropsAddedByRain) then
call ModifyPropByRain
endif
!avoid negative values if read from files
if (Me%CheckPropertyValues) then
call CheckPropertyValues (Constructing = .false.)
endif
WarningString = 'Modify'
call ModifyOutPut (WarningString)
!call RotateAtmosphereVectorFields(Constructing = .false.)
nullify (Me%ExternalVar%MappingPoints2D)
call ReadUnlockExternalVar
STAT_ = SUCCESS_
else cd0
STAT_ = ready_
end if cd0
if (present(STAT)) STAT = STAT_
if (MonitorPerformance) call StopWatch ("ModuleAtmosphere", "ModifyAtmosphere")
end subroutine ModifyAtmosphere
!----------------------------------------------------------------------
subroutine ModifyRandom
!Arguments-------------------------------------------------------------
type(T_Property), pointer :: PropertyX
!Local-----------------------------------------------------------------
real :: RandomValue
integer :: IUB, ILB, JUB, JLB, i, j
integer :: CHUNK
!Begin------------------------------------------------------------------------
!Begin - Shorten variables name
IUB = Me%WorkSize%IUB
ILB = Me%WorkSize%ILB
JUB = Me%WorkSize%JUB
JLB = Me%WorkSize%JLB
!End - Shorten variables name
PropertyX => Me%FirstAtmosphereProp
do1 : do while (associated(PropertyX))
!Add random component
if (PropertyX%HasRandomComponent)then
call random_number(RandomValue)
RandomValue = (RandomValue - 0.5) * PropertyX%RandomComponent
if (MonitorPerformance) then
call StartWatch ("ModuleAtmosphere", "ModifyRandom")
endif
CHUNK = CHUNK_J(JLB, JUB)
!$OMP PARALLEL PRIVATE(i,j)
!Substract previous random field
!$OMP DO SCHEDULE(STATIC,CHUNK)
do j = JLB, JUB
do i = ILB, IUB
PropertyX%Field(i, j) = PropertyX%Field(i, j) - PropertyX%RandomValue
enddo
enddo
!$OMP END DO
!Add new random value
!$OMP DO SCHEDULE(STATIC,CHUNK)
do j = JLB, JUB
do i = ILB, IUB
PropertyX%Field(i, j) = PropertyX%Field(i, j) + RandomValue
enddo
enddo
!$OMP END DO
!$OMP END PARALLEL
if (MonitorPerformance) then
call StopWatch ("ModuleAtmosphere", "ModifyRandom")
endif
!Stores random value
PropertyX%RandomValue = RandomValue
endif
PropertyX => PropertyX%Next
end do do1
end subroutine ModifyRandom
!----------------------------------------------------------------------
subroutine ModifyOutPut(WarningString)
!Arguments-------------------------------------------------------------
type(T_Property), pointer :: PropertyX
!Local-----------------------------------------------------------------
character(len = StringLength) :: WarningString
!Begin------------------------------------------------------------------------
!Output HDF
if (Me%OutPut%True) then
call OutPutResultsHDF5
endif
!Output TimeSerie / Statistics
PropertyX => Me%FirstAtmosphereProp
do2 : do while (associated(PropertyX))
!Output TimeSerie
call OutPut_TimeSeries(PropertyX)
!OutPut Statistics
if (PropertyX%Statistics%ON) then
call OutPut_Statistics(PropertyX%Field, PropertyX%Statistics%ID)
endif
if (WarningString == "Modify") PropertyX%FirstActualization = .false.
PropertyX => PropertyX%Next
enddo do2
end subroutine ModifyOutPut
!----------------------------------------------------------------------
subroutine ModifySolarRadiation(PropSolarRadiation)
!Arguments-------------------------------------------------------------
type(T_Property), pointer :: PropSolarRadiation
!Local-----------------------------------------------------------------
integer :: STAT_CALL
integer :: i,j
integer :: CHUNK
!Begin-----------------------------------------------------------------
if (PropSolarRadiation%ID%SolutionFromFile) then
call ModifyFillMatrix (FillMatrixID = PropSolarRadiation%ID%ObjFillMatrix, &
Matrix2D = PropSolarRadiation%Field, &
PointsToFill2D = Me%ExternalVar%MappingPoints2D, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModifySolarRadiation - ModuleAtmosphere - ERR01'
if (PropSolarRadiation%UseToPredictDT) then
call GetFillMatrixDTPrediction (PropSolarRadiation%ID%ObjFillMatrix, PropSolarRadiation%PredictedDT, &
PropSolarRadiation%DTForNextEvent, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModifySolarRadiation - ModuleAtmosphere - ERR02'
endif
!call ClimatologicSolarRadiation (PropSolarRadiation%Field)
!Save the last radiation of the day
if (Me%CloudCoverMethod == CloudFromRadiation ) then
if (MonitorPerformance) then
call StartWatch ("ModuleAtmosphere", "ModifySolarRadiation")
endif
CHUNK = CHUNK_J(Me%WorkSize%JLB, Me%WorkSize%JUB)
!$OMP PARALLEL PRIVATE(i,j)
!$OMP DO SCHEDULE(DYNAMIC,CHUNK)
do j = Me%WorkSize%JLB, Me%WorkSize%JUB
do i = Me%WorkSize%ILB, Me%WorkSize%IUB
if (Me%ExternalVar%MappingPoints2D(i, j) == 1) then
if (PropSolarRadiation%Field(i,j) .gt. 0.0) then
Me%LastRadiation(i,j) = PropSolarRadiation%Field(i,j)
endif
endif
enddo
enddo
!$OMP END DO
!$OMP END PARALLEL
if (MonitorPerformance) then
call StopWatch ("ModuleAtmosphere", "ModifySolarRadiation")
endif
endif
elseif (.not. PropSolarRadiation%Constant) then
select case(Me%RadiationMethod)
case(Radiation_MOHID)
call ClimatologicSolarRadiation (PropSolarRadiation)
case(Radiation_CEQUALW2)
call CEQUALW2SolarRadiation (PropSolarRadiation)
end select
endif
end subroutine ModifySolarRadiation
!--------------------------------------------------------------------------
subroutine ModifyAtmosphericPressure(PropAtmosphericPressure)
!Arguments-------------------------------------------------------------
type(T_Property), pointer :: PropAtmosphericPressure
!Local-----------------------------------------------------------------
integer :: STAT_CALL
!Local-----------------------------------------------------------------
if (PropAtmosphericPressure%ID%SolutionFromFile .and. .not. &
PropAtmosphericPressure%Constant) then
call ModifyFillMatrix (FillMatrixID = PropAtmosphericPressure%ID%ObjFillMatrix,&
Matrix2D = PropAtmosphericPressure%Field, &
PointsToFill2D = Me%ExternalVar%MappingPoints2D, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModifyAtmosphericPressure - ModuleAtmosphere - ERR01'
if (PropAtmosphericPressure%UseToPredictDT) then
call GetFillMatrixDTPrediction (PropAtmosphericPressure%ID%ObjFillMatrix, PropAtmosphericPressure%PredictedDT, &
PropAtmosphericPressure%DTForNextEvent, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModifyAtmosphericPressure - ModuleAtmosphere - ERR02'
endif
endif
end subroutine ModifyAtmosphericPressure
!--------------------------------------------------------------------------
!--------------------------------------------------------------------------
subroutine ModifyMeanSeaLevelPressure(PropMeanSeaLevelPressure)
!Arguments-------------------------------------------------------------
type(T_Property), pointer :: PropMeanSeaLevelPressure
!Local-----------------------------------------------------------------
integer :: STAT_CALL
!Local-----------------------------------------------------------------
if (PropMeanSeaLevelPressure%ID%SolutionFromFile .and. .not. &
PropMeanSeaLevelPressure%Constant) then
call ModifyFillMatrix (FillMatrixID = PropMeanSeaLevelPressure%ID%ObjFillMatrix,&
Matrix2D = PropMeanSeaLevelPressure%Field, &
PointsToFill2D = Me%ExternalVar%MappingPoints2D, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModifyMeanSeaLevelPressure - ModuleAtmosphere - ERR10'
if (PropMeanSeaLevelPressure%UseToPredictDT) then
call GetFillMatrixDTPrediction (PropMeanSeaLevelPressure%ID%ObjFillMatrix, PropMeanSeaLevelPressure%PredictedDT, &
PropMeanSeaLevelPressure%DTForNextEvent, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModifyMeanSeaLevelPressure - ModuleAtmosphere - ERR02'
endif
endif
end subroutine ModifyMeanSeaLevelPressure
!--------------------------------------------------------------------------
subroutine ModifyCO2AtmosphericPressure(PropCO2AtmosphericPressure)
!Arguments-------------------------------------------------------------
type(T_Property), pointer :: PropCO2AtmosphericPressure
!Local-----------------------------------------------------------------
integer :: STAT_CALL
!Local-----------------------------------------------------------------
if (PropCO2AtmosphericPressure%ID%SolutionFromFile .and. .not. &
PropCO2AtmosphericPressure%Constant) then
call ModifyFillMatrix (FillMatrixID = PropCO2AtmosphericPressure%ID%ObjFillMatrix,&
Matrix2D = PropCO2AtmosphericPressure%Field, &
PointsToFill2D = Me%ExternalVar%MappingPoints2D, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModifyCO2AtmosphericPressure - ModuleAtmosphere - ERR01'
if (PropCO2AtmosphericPressure%UseToPredictDT) then
call GetFillMatrixDTPrediction (PropCO2AtmosphericPressure%ID%ObjFillMatrix, &
PropCO2AtmosphericPressure%PredictedDT, &
PropCO2AtmosphericPressure%DTForNextEvent, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModifyCO2AtmosphericPressure - ModuleAtmosphere - ERR02'
endif
endif
end subroutine ModifyCO2AtmosphericPressure
!--------------------------------------------------------------------------
subroutine ModifyO2AtmosphericPressure(PropO2AtmosphericPressure)
!Arguments-------------------------------------------------------------
type(T_Property), pointer :: PropO2AtmosphericPressure
!Local-----------------------------------------------------------------
integer :: STAT_CALL
!Local-----------------------------------------------------------------
if (PropO2AtmosphericPressure%ID%SolutionFromFile .and. .not. &
PropO2AtmosphericPressure%Constant) then
call ModifyFillMatrix (FillMatrixID = PropO2AtmosphericPressure%ID%ObjFillMatrix,&
Matrix2D = PropO2AtmosphericPressure%Field, &
PointsToFill2D = Me%ExternalVar%MappingPoints2D, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModifyO2AtmosphericPressure - ModuleAtmosphere - ERR01'
if (PropO2AtmosphericPressure%UseToPredictDT) then
call GetFillMatrixDTPrediction (PropO2AtmosphericPressure%ID%ObjFillMatrix, &
PropO2AtmosphericPressure%PredictedDT, &
PropO2AtmosphericPressure%DTForNextEvent, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModifyO2AtmosphericPressure - ModuleAtmosphere - ERR02'
endif
endif
end subroutine ModifyO2AtmosphericPressure
!--------------------------------------------------------------------------
subroutine ModifyWindVelocity(PropWindVelocity)
!Arguments-------------------------------------------------------------
type(T_Property), pointer :: PropWindVelocity
!Begin-----------------------------------------------------------------
integer :: STAT_CALL
iov: if (Me%OverrideWindVelStandard) then
call OverrideWindVel
else iov
if (PropWindVelocity%ID%SolutionFromFile) then
call ModifyFillMatrixVectorial (FillMatrixID = PropWindVelocity%ID%ObjFillMatrix, &
Matrix2DU = PropWindVelocity%FieldU, &
Matrix2DV = PropWindVelocity%FieldV, &
Matrix2DX = PropWindVelocity%FieldX, &
Matrix2DY = PropWindVelocity%FieldY, &
PointsToFill2D = Me%ExternalVar%MappingPoints2D, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModifyWindVelocity - ModuleAtmosphere - ERR01'
if (PropWindVelocity%UseToPredictDT) then
call GetFillMatrixDTPrediction (PropWindVelocity%ID%ObjFillMatrix, PropWindVelocity%PredictedDT, &
PropWindVelocity%DTForNextEvent, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModifyWindVelocity - ModuleAtmosphere - ERR02'
endif
!Computes Wind Velocity from Modulus and Direction
elseif (.not. PropWindVelocity%Constant .and. &
.not. PropWindVelocity%ID%SolutionFromFile) then
call ComputeWindVelocity (PropWindVelocity)
endif
endif iov
end subroutine ModifyWindVelocity
!--------------------------------------------------------------------------
subroutine ComputeWindVelocity (PropWindVelocity)
!Arguments-------------------------------------------------------------
type(T_Property), pointer :: PropWindVelocity
!Local-----------------------------------------------------------------
type(T_Property), pointer :: PropWindModulus
type(T_Property), pointer :: PropWindDirection
integer :: STAT_CALL
!Begin-------------------------------------------------------------------
!Updates and gets pointer to PropWindModulus
call SearchProperty(PropWindModulus, WindModulus_ , .true., STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ComputeWindVelocity - ModuleAtmosphere - ERR01'
!Updates and gets pointer to PropWindModulus
call SearchProperty(PropWindDirection, WindDirection_, .true., STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_)stop 'ComputeWindVelocity - ModuleAtmosphere - ERR02'
!wind agnle was already rotated to cell
PropWindVelocity%FieldU = PropWindModulus%Field * cos(PropWindDirection%Field * PI / 180.)
PropWindVelocity%FieldV = PropWindModulus%Field * sin(PropWindDirection%Field * PI / 180.)
!need to rotate field since we are outside FillMatrix
call RotateVectorGridToField(HorizontalGridID = Me%ObjHorizontalGrid, &
VectorInX = PropWindVelocity%FieldU, &
VectorInY = PropWindVelocity%FieldV, &
VectorOutX = PropWindVelocity%FieldX, &
VectorOutY = PropWindVelocity%FieldY, &
WaterPoints2D = Me%ExternalVar%MappingPoints2D, &
RotateX = .true., &
RotateY = .true., &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_)stop 'ComputeWindVelocity - ModuleAtmosphere - ERR03'
end subroutine ComputeWindVelocity
!--------------------------------------------------------------------------
subroutine ModifyPrecipitation(PropPrecipitation)
!Arguments-------------------------------------------------------------
type(T_Property), pointer :: PropPrecipitation
!Local-----------------------------------------------------------------
integer :: i, j, STAT_CALL
integer :: CHUNK
!real :: max_value
!logical :: Accumulate, Interpolate, UseOriginal
!Begin-----------------------------------------------------------------
if (MonitorPerformance) then
call StartWatch ("ModuleAtmosphere", "ModifyPrecipitation")
endif
if (PropPrecipitation%ID%SolutionFromFile) then
call ModifyFillMatrix (FillMatrixID = PropPrecipitation%ID%ObjFillMatrix, &
Matrix2D = PropPrecipitation%Field, &
PointsToFill2D = Me%ExternalVar%MappingPoints2D, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModifyPrecipitation - ModuleAtmosphere - ERR010'
if (PropPrecipitation%UseToPredictDT) then
call GetFillMatrixDTPrediction (PropPrecipitation%ID%ObjFillMatrix, PropPrecipitation%PredictedDT, &
PropPrecipitation%DTForNextEvent, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModifyPrecipitation - ModuleAtmosphere - ERR020'
call GetNextValueForDTPred (PropPrecipitation%ID%ObjFillMatrix, Me%Rain%MaxValue, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModifyPrecipitation - ModuleAtmosphere - ERR030'
endif
endif
if (PropPrecipitation%FirstActualization) then
! call GetValuesProcessingOptions (PropPrecipitation%ID%ObjFillMatrix, &
! Accumulate = Accumulate, &
! Interpolate = Interpolate, &
! UseOriginal = UseOriginal, &
! STAT = STAT_CALL)
! if (STAT_CALL /= SUCCESS_) stop 'ModifyPrecipitation - ModuleAtmosphere - ERR040'
if (PropPrecipitation%InterpolateValueInTime) then
write(*,*) "Rain can't be INTERPOLATED. Check precipitation property options."
stop 'ModifyPrecipitation - ModuleAtmosphere - ERR050'
elseif (PropPrecipitation%AccumulateValueInTime) then
if (trim(PropPrecipitation%ID%Units) /= 'mm') then
write(*,*)'Invalid Precipitation Units for accumulated values'
write(*,*)'Use mm with ACCUMULATE_VALUES = 1 or '
write(*,*)'use a FLUX (ex. mm/hour) with USE_ORIGINAL_VALUES = 1'
stop 'ModifyPrecipitation - ModuleAtmosphere - ERR060'
endif
if (PropPrecipitation%Constant) then
write(*,*)'Invalid Precipitation Units for constant value'
write(*,*)'Use a FLUX (ex. mm/hour) when using constant value for rain'
stop 'ModifyPrecipitation - ModuleAtmosphere - ERR061'
endif
else
if (trim(PropPrecipitation%ID%Units) == 'mm') then
write(*,*)'Invalid Precipitation Units for original values'
write(*,*)'Use mm with ACCUMULATE_VALUES = 1 or '
write(*,*)'use a FLUX (ex. mm/hour) with USE_ORIGINAL_VALUES = 1'
stop 'ModifyPrecipitation - ModuleAtmosphere - ERR060'
endif
endif
if (trim(adjustl(PropPrecipitation%ID%Units)) /= 'm3/s') then
Me%PrecReqConv = .true.
select case (PropPrecipitation%ID%Units)
case ('mm/day')
Me%ConversionFactorPrec = 1. / 86400000. !In m/s
case ('mm/hour')
Me%ConversionFactorPrec = 1. / 3600000. !In m/s
case ('mm')
if(.not. PropPrecipitation%AccumulateValueInTime) then
write(*,*)'when using "mm" as units for precipitation'
write(*,*)'you must use ACCUMULATE_VALUES = 1'
stop 'ModifyPrecipitation - ModuleAtmosphere - ERR050'
endif
Me%ConversionFactorPrec = 1. / 1000. !In m/s => Fillmatrix converted from mm to mm/s
case default
write(*,*)'Invalid Precipitation Units'
write(*,*)'Use mm, m3/s, mm/day or mm/hour'
stop 'ModifyPrecipitation - ModuleAtmosphere - ERR060'
end select
else
Me%PrecReqConv = .false.
endif
endif
if (PropPrecipitation%FirstActualization .or. .not. PropPrecipitation%Constant) then
if (Me%PrecReqConv) then
CHUNK = CHUNK_J(Me%WorkSize%JLB, Me%WorkSize%JUB)
!$OMP PARALLEL PRIVATE(i,j)
!$OMP DO SCHEDULE(DYNAMIC,CHUNK)
do j = Me%WorkSize%JLB, Me%WorkSize%JUB
do i = Me%WorkSize%ILB, Me%WorkSize%IUB
if (Me%ExternalVar%MappingPoints2D(i, j) == 1) then
PropPrecipitation%Field(i, j) = PropPrecipitation%Field(i, j) * &
(Me%ExternalVar%GridCellArea(i, j) * &
Me%ConversionFactorPrec) !In m3/s
endif
enddo
enddo
!$OMP END DO
!$OMP END PARALLEL
endif
endif
if (MonitorPerformance) then
call StopWatch ("ModuleAtmosphere", "ModifyPrecipitation")
endif
end subroutine ModifyPrecipitation
!--------------------------------------------------------------------------
subroutine ModifyPropByRain
!Arguments-------------------------------------------------------------
type(T_Property), pointer :: PropertyX
!Local-----------------------------------------------------------------
integer :: STAT_CALL
!Begin-----------------------------------------------------------------
PropertyX => Me%FirstAtmosphereProp
do1 : do while (associated(PropertyX))
if (PropertyX%PropAddedByRain) then
if (PropertyX%ID%SolutionFromFile) then
call ModifyFillMatrix (FillMatrixID = PropertyX%ID%ObjFillMatrix, &
Matrix2D = PropertyX%Field, &
PointsToFill2D = Me%ExternalVar%MappingPoints2D, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModifyPropByRain - ModuleAtmosphere - ERR01'
if (PropertyX%UseToPredictDT) then
call GetFillMatrixDTPrediction (PropertyX%ID%ObjFillMatrix, PropertyX%PredictedDT, &
PropertyX%DTForNextEvent, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModifyPropByRain - ModuleAtmosphere - ERR02'
endif
endif
endif
PropertyX => PropertyX%Next
end do do1
end subroutine ModifyPropByRain
!--------------------------------------------------------------------------
subroutine ModifySunHours (PropSunHours)
!Arguments-------------------------------------------------------------
type(T_Property), pointer :: PropSunHours
!Begin-----------------------------------------------------------------
integer :: STAT_CALL
if (PropSunHours%ID%SolutionFromFile) then
call ModifyFillMatrix (FillMatrixID = PropSunHours%ID%ObjFillMatrix, &
Matrix2D = PropSunHours%Field, &
PointsToFill2D = Me%ExternalVar%MappingPoints2D, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModifySunHours - ModuleAtmosphere - ERR01'
if (PropSunHours%UseToPredictDT) then
call GetFillMatrixDTPrediction (PropSunHours%ID%ObjFillMatrix, PropSunHours%PredictedDT, &
PropSunHours%DTForNextEvent, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModifySunHours - ModuleAtmosphere - ERR02'
endif
endif
end subroutine ModifySunHours
!------------------------------------------------------------------------------
subroutine ModifyAirTemperature (PropAirTemperature)
!Arguments-------------------------------------------------------------
type(T_Property), pointer :: PropAirTemperature
!Begin-----------------------------------------------------------------
integer :: STAT_CALL
if (PropAirTemperature%ID%SolutionFromFile) then
call ModifyFillMatrix (FillMatrixID = PropAirTemperature%ID%ObjFillMatrix, &
Matrix2D = PropAirTemperature%Field, &
PointsToFill2D = Me%ExternalVar%MappingPoints2D, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModifyAirTemperature - ModuleAtmosphere - ERR01'
if (PropAirTemperature%UseToPredictDT) then
call GetFillMatrixDTPrediction (PropAirTemperature%ID%ObjFillMatrix, PropAirTemperature%PredictedDT, &
PropAirTemperature%DTForNextEvent, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModifyAirTemperature - ModuleAtmosphere - ERR02'
endif
endif
end subroutine ModifyAirTemperature
!------------------------------------------------------------------------------
subroutine ModifyRelativeHumidity (PropRelativeHumidity)
!Arguments-------------------------------------------------------------
type(T_Property), pointer :: PropRelativeHumidity
!Begin-----------------------------------------------------------------
integer :: STAT_CALL
if (PropRelativeHumidity%ID%SolutionFromFile) then
call ModifyFillMatrix (FillMatrixID = PropRelativeHumidity%ID%ObjFillMatrix,&
Matrix2D = PropRelativeHumidity%Field, &
PointsToFill2D = Me%ExternalVar%MappingPoints2D, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModifyRelativeHumidity - ModuleAtmosphere - ERR01'
if (PropRelativeHumidity%UseToPredictDT) then
call GetFillMatrixDTPrediction (PropRelativeHumidity%ID%ObjFillMatrix, PropRelativeHumidity%PredictedDT, &
PropRelativeHumidity%DTForNextEvent, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModifyRelativeHumidity - ModuleAtmosphere - ERR02'
endif
endif
end subroutine ModifyRelativeHumidity
subroutine ModifyPBLHeight (PropPBLHeight)
!Arguments-------------------------------------------------------------
type(T_Property), pointer :: PropPBLHeight
!Begin-----------------------------------------------------------------
integer :: STAT_CALL
if (PropPBLHeight%ID%SolutionFromFile) then
call ModifyFillMatrix (FillMatrixID = PropPBLHeight%ID%ObjFillMatrix,&
Matrix2D = PropPBLHeight%Field, &
PointsToFill2D = Me%ExternalVar%MappingPoints2D, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModifyPBLHeight - ModuleAtmosphere - ERR01'
if (PropPBLHeight%UseToPredictDT) then
call GetFillMatrixDTPrediction (PropPBLHeight%ID%ObjFillMatrix, PropPBLHeight%PredictedDT, &
PropPBLHeight%DTForNextEvent, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModifyPBLHeight - ModuleAtmosphere - ERR02'
endif
endif
end subroutine ModifyPBLHeight
!------------------------------------------------------------------------------
subroutine ModifyWindModulus (PropWindModulus)
!Arguments-------------------------------------------------------------
type(T_Property), pointer :: PropWindModulus
!Local-----------------------------------------------------------------
type(T_Property), pointer :: PropWindVel
!type(T_Property), pointer :: PropWindVelY
!Begin-----------------------------------------------------------------
integer :: STAT_CALL
if (PropWindModulus%ID%SolutionFromFile) then
call ModifyFillMatrix (FillMatrixID = PropWindModulus%ID%ObjFillMatrix, &
Matrix2D = PropWindModulus%Field, &
PointsToFill2D = Me%ExternalVar%MappingPoints2D, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModifyWindModulus - ModuleAtmosphere - ERR01'
if (PropWindModulus%UseToPredictDT) then
call GetFillMatrixDTPrediction (PropWindModulus%ID%ObjFillMatrix, PropWindModulus%PredictedDT, &
PropWindModulus%DTForNextEvent, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModifyWindModulus - ModuleAtmosphere - ERR02'
endif
elseif (.not. PropWindModulus%Constant) then
!Searches Wind
call SearchProperty(PropWindVel, WindVelocity_, .false., STAT = STAT_CALL)
if (STAT_CALL == SUCCESS_) then
PropWindModulus%Field = sqrt(PropWindVel%FieldU ** 2.0 + PropWindVel%FieldV ** 2.0)
endif
endif
end subroutine ModifyWindModulus
!----------------------------------------------------------------------------
subroutine ModifyWindDirection (PropWindDirection)
!Arguments-------------------------------------------------------------
type(T_Property), pointer :: PropWindDirection
!Local-----------------------------------------------------------------
integer :: STAT_CALL
!type(T_Property), pointer :: PropWindVel
!Begin-----------------------------------------------------------------
if (PropWindDirection%ID%SolutionFromFile) then
call ModifyFillMatrix (FillMatrixID = PropWindDirection%ID%ObjFillMatrix, &
Matrix2D = PropWindDirection%Field, &
Matrix2DInputRef = PropWindDirection%FieldInputRef, &
PointsToFill2D = Me%ExternalVar%MappingPoints2D, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModifyWindDirection - ModuleAtmosphere - ERR01'
if (PropWindDirection%UseToPredictDT) then
call GetFillMatrixDTPrediction (PropWindDirection%ID%ObjFillMatrix, PropWindDirection%PredictedDT, &
PropWindDirection%DTForNextEvent, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModifyWindDirection - ModuleAtmosphere - ERR02'
endif
!This can not be done since wind velocity is not yet known
!elseif (.not. PropWindDirection%Constant) then
!
! !Searches Wind
! call SearchProperty(PropWindVel, WindVelocity_, .false., STAT = STAT_CALL)
! if (STAT_CALL == SUCCESS_) then
!
! !Field is for properties values in cell referential
! !FieldInputRef is for properties values in input referential (in this case nautic)
! call ComputeAngleFromGridComponents(HorizontalGridID = Me%ObjHorizontalGrid, &
! VectorU = PropWindVel%FieldU, &
! VectorV = PropWindVel%FieldV, &
! AngleOutField = PropWindDirection%FieldInputRef, &
! AngleOutGrid = PropWindDirection%Field, &
! WaterPoints2D = Me%ExternalVar%MappingPoints2D, &
! OutReferential = NauticalReferential_, &