From 790ef150e1c557242cc29fec58e259846b37734d Mon Sep 17 00:00:00 2001 From: mcgratta Date: Tue, 2 Jan 2024 16:01:49 -0500 Subject: [PATCH] FDS Source: Add ERROR statement numbers, remove unused code --- Manuals/FDS_User_Guide/FDS_User_Guide.tex | 54 ++++++++------- Source/cons.f90 | 2 +- Source/func.f90 | 62 ----------------- Source/init.f90 | 48 ++++++------- Source/read.f90 | 84 +++-------------------- Source/type.f90 | 4 +- 6 files changed, 68 insertions(+), 186 deletions(-) diff --git a/Manuals/FDS_User_Guide/FDS_User_Guide.tex b/Manuals/FDS_User_Guide/FDS_User_Guide.tex index 92e35979bd3..082b45d05e3 100644 --- a/Manuals/FDS_User_Guide/FDS_User_Guide.tex +++ b/Manuals/FDS_User_Guide/FDS_User_Guide.tex @@ -13405,29 +13405,37 @@ \chapter{Error Codes} 395 \> {\ct RAMP with EXTERNAL\_FILE is present but no EXTERNAL\_FILENAME } \> Section~\ref{info:external_control} \\ 396 \> {\ct Row \ldots\ of \ldots\ has a bad 1st latitude. } \> Section~\ref{info:spraypattern} \\ 397 \> {\ct Row \ldots\ of \ldots\ has a bad 2nd latitude. } \> Section~\ref{info:spraypattern} \\ - -401 \> {\ct SURF \ldots\ cannot be applied to a thin obstruction \ldots\ } \> Section~\ref{info:thin_obstructions} \\ -402 \> {\ct VENT \ldots\ cannot be applied to a thin obstruction \ldots\ } \> Section~\ref{info:thin_obstructions} \\ -403 \> {\ct HT3D solid must have at least one face exposed \ldots\ } \> Section~\ref{info:HT3D_Limitations} \\ -404 \> {\ct HT3D thin solid must have at least one face exposed \ldots\ } \> Section~\ref{info:HT3D_Limitations} \\ -405 \> {\ct MESH \ldots\ can stretch in at most 2 coordinate directions. } \> Section~\ref{info:TRNX} \\ -406 \> {\ct MESH \ldots\ Poisson initialization error: \ldots\ } \> Section~\ref{info:Errors} \\ -407 \> {\ct DEVC \ldots\ requires repositioning. } \> Section~\ref{info:DEVC_position} \\ -408 \> {\ct DEVC \ldots\ must be associated with a heat-conducting surface. } \> Section~\ref{info:solidoutputquantities} \\ -409 \> {\ct PROF \ldots\ requires repositioning. } \> Section~\ref{info:PROF} \\ -410 \> {\ct PROF \ldots\ must be associated with a heat-conducting surface. } \> Section~\ref{info:solidoutputquantities} \\ -411 \> {\ct MESH \ldots\ is not in alignment with MESH \ldots\ } \> Section~\ref{info:mesh_alignment} \\ -412 \> {\ct SURF \ldots\ must specify velocity boundary condition ... } \> Section~\ref{info:MASS_FLUX} \\ -413 \> {\ct SURF \ldots\ cannot be applied below GROUND\_LEVEL. } \> Section~\ref{info:wall_of_wind} \\ -414 \> {\ct RAMP\_V\_X assigned to SURF \ldots\ } \> Section~\ref{info:RAMP_Vel_Prof} \\ -415 \> {\ct RAMP\_V\_Y assigned to SURF \ldots\ } \> Section~\ref{info:RAMP_Vel_Prof} \\ -416 \> {\ct RAMP\_V\_Z assigned to SURF \ldots\ } \> Section~\ref{info:RAMP_Vel_Prof} \\ -417 \> {\ct SURF \ldots\ cannot be applied to an exterior boundary. } \> Section~\ref{info:HT3D_Limitations} \\ -418 \> {\ct SURF \ldots\ layers are thicker than the underlying obstruction. } \> Section~\ref{info:linings} \\ -419 \> {\ct MESH \ldots\ UVWFILE \ldots\ does not exist. } \> Section~\ref{info:CSVF} \\ -420 \> {\ct MESH \ldots\ TMPFILE \ldots\ does not exist. } \> Section~\ref{info:CSVF} \\ -421 \> {\ct MESH \ldots\ SPECFILE \ldots\ does not exist. } \> Section~\ref{info:CSVF} \\ - \> \> \\ +398 \> {\ct Row \ldots\ of \ldots\ has a bad 1st longitude. } \> Section~\ref{info:spraypattern} \\ +399 \> {\ct Row \ldots\ of \ldots\ has a bad 2nd longitude. } \> Section~\ref{info:spraypattern} \\ +400 \> {\ct Row \ldots\ of \ldots\ has a bad velocity. } \> Section~\ref{info:spraypattern} \\ +401 \> {\ct Row \ldots\ of \ldots\ has a bad mass flow. } \> Section~\ref{info:spraypattern} \\ +402 \> {\ct Row \ldots\ of \ldots\ has a bad wavelength. } \> Section~\ref{radiative_part_props} \\ +403 \> {\ct Row \ldots\ of \ldots\ has a bad real index. } \> Section~\ref{radiative_part_props} \\ +404 \> {\ct Row \ldots\ of \ldots\ has a bad complex index. } \> Section~\ref{radiative_part_props} \\ +407 \> {\ct TABLE \ldots\ not found. } \> Section~\ref{info:spraypattern} \\ + \> \> \\ +421 \> {\ct SURF \ldots\ cannot be applied to a thin obstruction \ldots\ } \> Section~\ref{info:thin_obstructions} \\ +422 \> {\ct VENT \ldots\ cannot be applied to a thin obstruction \ldots\ } \> Section~\ref{info:thin_obstructions} \\ +423 \> {\ct HT3D solid must have at least one face exposed \ldots\ } \> Section~\ref{info:HT3D_Limitations} \\ +424 \> {\ct HT3D thin solid must have at least one face exposed \ldots\ } \> Section~\ref{info:HT3D_Limitations} \\ +425 \> {\ct MESH \ldots\ can stretch in at most 2 coordinate directions. } \> Section~\ref{info:TRNX} \\ +426 \> {\ct MESH \ldots\ Poisson initialization error: \ldots\ } \> Section~\ref{info:Errors} \\ +427 \> {\ct DEVC \ldots\ requires repositioning. } \> Section~\ref{info:DEVC_position} \\ +428 \> {\ct DEVC \ldots\ must be associated with a heat-conducting surface. } \> Section~\ref{info:solidoutputquantities} \\ +429 \> {\ct PROF \ldots\ requires repositioning. } \> Section~\ref{info:PROF} \\ +430 \> {\ct PROF \ldots\ must be associated with a heat-conducting surface. } \> Section~\ref{info:solidoutputquantities} \\ +431 \> {\ct MESH \ldots\ is not in alignment with MESH \ldots\ } \> Section~\ref{info:mesh_alignment} \\ +432 \> {\ct SURF \ldots\ must specify velocity boundary condition ... } \> Section~\ref{info:MASS_FLUX} \\ +433 \> {\ct SURF \ldots\ cannot be applied below GROUND\_LEVEL. } \> Section~\ref{info:wall_of_wind} \\ +434 \> {\ct RAMP\_V\_X assigned to SURF \ldots\ } \> Section~\ref{info:RAMP_Vel_Prof} \\ +435 \> {\ct RAMP\_V\_Y assigned to SURF \ldots\ } \> Section~\ref{info:RAMP_Vel_Prof} \\ +436 \> {\ct RAMP\_V\_Z assigned to SURF \ldots\ } \> Section~\ref{info:RAMP_Vel_Prof} \\ +437 \> {\ct SURF \ldots\ cannot be applied to an exterior boundary. } \> Section~\ref{info:HT3D_Limitations} \\ +438 \> {\ct SURF \ldots\ layers are thicker than the underlying obstruction. } \> Section~\ref{info:linings} \\ +439 \> {\ct MESH \ldots\ UVWFILE \ldots\ does not exist. } \> Section~\ref{info:CSVF} \\ +440 \> {\ct MESH \ldots\ TMPFILE \ldots\ does not exist. } \> Section~\ref{info:CSVF} \\ +441 \> {\ct MESH \ldots\ SPECFILE \ldots\ does not exist. } \> Section~\ref{info:CSVF} \\ + \> \> \\ 501 \> {\ct No ID provided \ldots } \> Section~\ref{info:HVAC} \\ 502 \> {\ct Invalid TYPE\_ID provided \ldots } \> Section~\ref{info:HVAC} \\ 503 \> {\ct Must have both DUCTs and NODEs in the input file } \> Section~\ref{info:HVAC} \\ diff --git a/Source/cons.f90 b/Source/cons.f90 index a3d4345811a..6e57ed57421 100644 --- a/Source/cons.f90 +++ b/Source/cons.f90 @@ -468,7 +468,7 @@ MODULE GLOBAL_CONSTANTS CHARACTER(LABEL_LENGTH) :: TABLE_ID(1000) INTEGER :: N_TABLE=0,TABLE_TYPE(1000) -INTEGER, PARAMETER :: SPRAY_PATTERN=1,PART_RADIATIVE_PROPERTY=2,POINTWISE_INSERTION=3,TABLE_2D_TYPE=4 +INTEGER, PARAMETER :: SPRAY_PATTERN=1,PART_RADIATIVE_PROPERTY=2,POINTWISE_INSERTION=3 ! Variables related to meshes diff --git a/Source/func.f90 b/Source/func.f90 index 0df81bd4392..56cee797cb4 100644 --- a/Source/func.f90 +++ b/Source/func.f90 @@ -3834,68 +3834,6 @@ SUBROUTINE INTERPOLATE1D_UNIFORM(LOWER,X,XI,ANS) END SUBROUTINE INTERPOLATE1D_UNIFORM -!> \brief Find interpolated value in a 2D array -!> \param TABLE_INDEX Index of the table -!> \param XI Index of first array dimension -!> \param YI Index of second array dimension -!> \param ANS Interpolated value at (XI,YI) - -SUBROUTINE INTERPOLATE2D(TABLE_INDEX,XI,YI,ANS) - -USE TYPES, ONLY: TABLES,TABLES_TYPE -INTEGER, INTENT(IN) :: TABLE_INDEX -REAL(EB), INTENT(IN) :: XI,YI -REAL(EB), INTENT(OUT) :: ANS -REAL(EB) :: XL,XU,FRAC -INTEGER :: I,J -TYPE (TABLES_TYPE), POINTER :: TA - -TA => TABLES(TABLE_INDEX) - -! Do 1D for X edges of table -IF (XI <= TA%LX) THEN - CALL INTERPOLATE1D(TA%Y,TA%Z(1,:),YI,ANS) - RETURN -ELSEIF (XI >= TA%UX) THEN - CALL INTERPOLATE1D(TA%Y,TA%Z(TA%NUMBER_ROWS,:),YI,ANS) - RETURN -ENDIF - -! Do 1D for Y edges of table -IF (YI <= TA%LY) THEN - CALL INTERPOLATE1D(TA%X,TA%Z(:,1),XI,ANS) - RETURN -ELSEIF(YI >= TA%UY) THEN - CALL INTERPOLATE1D(TA%X,TA%Z(:,TA%NUMBER_COLUMNS),XI,ANS) - RETURN -ENDIF - -! Search for column, do 1D if exact -DO J = 1, TA%NUMBER_COLUMNS - IF (ABS(YI-TA%Y(J)) < SPACING(TA%Y(J))) THEN - CALL INTERPOLATE1D(TA%X,TA%Z(:,J),XI,ANS) - RETURN - ENDIF - IF (TA%Y(J) > YI) EXIT -ENDDO - -! Search for row, do 1D if exact -DO I = 1, TA%NUMBER_ROWS - IF(ABS(XI-TA%X(I)) < SPACING(TA%X(I))) THEN - CALL INTERPOLATE1D(TA%Y,TA%Z(I,:),YI,ANS) - RETURN - ENDIF - IF (TA%X(I) > XI) EXIT -ENDDO - -FRAC = (XI-TA%X(I-1))/(TA%X(I)-TA%X(I-1)) -XL = FRAC*(TA%Z(I,J-1)-TA%Z(I-1,J-1))+TA%Z(I-1,J-1) -XU = FRAC*(TA%Z(I,J )-TA%Z(I-1,J ))+TA%Z(I-1,J) -ANS = (YI-TA%Y(J-1))/(TA%Y(J)-TA%Y(J-1))*(XU-XL)+XL - -END SUBROUTINE INTERPOLATE2D - - !> \brief Randomly choose a point from a normal distribution !> \param MEAN Mean of the normal distribution !> \param SIGMA Standard deviation diff --git a/Source/init.f90 b/Source/init.f90 index 0c4aa43068a..cdf48acaf2e 100644 --- a/Source/init.f90 +++ b/Source/init.f90 @@ -1105,7 +1105,7 @@ SUBROUTINE INITIALIZE_MESH_VARIABLES_2(NM) IF (.NOT.SOLID_CELL) THEN IF ( (ABS(B1%U_NORMAL_0)>TWO_EPSILON_EB .OR. ANY(SF%LEAK_PATH>=0)) .AND. WC%OBST_INDEX>0 ) THEN - WRITE(LU_ERR,'(A,A,A,I0)') 'ERROR(401): SURF ',TRIM(SF%ID),' cannot be applied to a thin obstruction, OBST #',& + WRITE(LU_ERR,'(A,A,A,I0)') 'ERROR(421): SURF ',TRIM(SF%ID),' cannot be applied to a thin obstruction, OBST #',& M%OBSTRUCTION(WC%OBST_INDEX)%ORDINAL STOP_STATUS = SETUP_STOP RETURN @@ -1113,7 +1113,7 @@ SUBROUTINE INITIALIZE_MESH_VARIABLES_2(NM) IF (WC%VENT_INDEX>0 .AND. WC%OBST_INDEX>0) THEN VT => M%VENTS(WC%VENT_INDEX) IF (VT%BOUNDARY_TYPE==HVAC_BOUNDARY) THEN - WRITE(LU_ERR,'(A,A,A,I0)') 'ERROR(402): VENT ',TRIM(VT%ID),' cannot be applied to a thin obstruction, OBST #',& + WRITE(LU_ERR,'(A,A,A,I0)') 'ERROR(422): VENT ',TRIM(VT%ID),' cannot be applied to a thin obstruction, OBST #',& M%OBSTRUCTION(WC%OBST_INDEX)%ORDINAL STOP_STATUS = SETUP_STOP RETURN @@ -1889,7 +1889,7 @@ SUBROUTINE INITIALIZE_HT3D_WALL_CELLS(NM) DO IOR=1,3 IF (ABS(BC%IOR)==IOR) CYCLE IF (.NOT.IOR_AVOID(-IOR) .AND. .NOT.IOR_AVOID(IOR)) THEN - WRITE(LU_ERR,'(A,I0,A,I0)') 'ERROR: HT3D solid must have at least one face exposed in each direction, Mesh=',NM,& + WRITE(LU_ERR,'(A,I0,A,I0)') 'ERROR(423): HT3D solid must have at least one face exposed in each direction, Mesh=',NM,& ', IOR=',IOR STOP_STATUS = SETUP_STOP RETURN @@ -1987,7 +1987,7 @@ SUBROUTINE INITIALIZE_HT3D_WALL_CELLS(NM) DO IOR=1,3 IF (ABS(BC%IOR)==IOR) CYCLE IF (.NOT.IOR_AVOID(-IOR) .AND. .NOT.IOR_AVOID(IOR)) THEN - WRITE(LU_ERR,'(A,I0,A,I0)') 'ERROR(404): HT3D thin solid must have at least one face exposed, Mesh=',NM,& + WRITE(LU_ERR,'(A,I0,A,I0)') 'ERROR(424): HT3D thin solid must have at least one face exposed, Mesh=',NM,& ', IOR=',IOR STOP_STATUS = SETUP_STOP RETURN @@ -2211,7 +2211,7 @@ SUBROUTINE INITIALIZE_POISSON_SOLVER(NM) SELECT CASE(PRES_FLAG) CASE DEFAULT IF (NOC(1)/=0 .AND. NOC(2)/=0 .AND. NOC(3)/=0) THEN - WRITE(LU_ERR,'(A,I0,A)') 'ERROR(405): MESH ',NM,' can stretch in at most 2 coordinate directions.' + WRITE(LU_ERR,'(A,I0,A)') 'ERROR(425): MESH ',NM,' can stretch in at most 2 coordinate directions.' STOP_STATUS = SETUP_STOP IERR = 1 RETURN @@ -2480,7 +2480,7 @@ SUBROUTINE INITIALIZE_POISSON_SOLVER(NM) ! Check for errors with Poisson solver initialization IF (IERR/=0) THEN - WRITE(LU_ERR,'(A,I0,A,I0)') 'ERROR(406): MESH ',NM,' Poisson initialization error: ',IERR + WRITE(LU_ERR,'(A,I0,A,I0)') 'ERROR(426): MESH ',NM,' Poisson initialization error: ',IERR STOP_STATUS = SETUP_STOP RETURN ENDIF @@ -2541,7 +2541,7 @@ SUBROUTINE INITIALIZE_DEVICES(NM) IF (IW==0 .AND. CC_IBM) CALL GET_CFACE_INDEX(NM,IIG,JJG,KKG,DV%X,DV%Y,DV%Z,ICF) IF (IW==0 .AND. ICF==0 .AND. DV%SPATIAL_STATISTIC=='null') THEN - WRITE(LU_ERR,'(A,A,A)') 'ERROR(407): DEVC ',TRIM(DV%ID),' requires repositioning.' + WRITE(LU_ERR,'(A,A,A)') 'ERROR(427): DEVC ',TRIM(DV%ID),' requires repositioning.' STOP_STATUS = SETUP_STOP RETURN ELSEIF (IW>0) THEN @@ -2565,7 +2565,7 @@ SUBROUTINE INITIALIZE_DEVICES(NM) IF (OUTPUT_QUANTITY(DV%QUANTITY_INDEX(1))%INSIDE_SOLID) THEN IF (SURFACE(SURF_INDEX)%THERMAL_BC_INDEX /= THERMALLY_THICK) THEN - WRITE(LU_ERR,'(A,A,A)') 'ERROR(408): DEVC ',TRIM(DV%ID),' must be associated with a heat-conducting surface.' + WRITE(LU_ERR,'(A,A,A)') 'ERROR(428): DEVC ',TRIM(DV%ID),' must be associated with a heat-conducting surface.' STOP_STATUS = SETUP_STOP RETURN ENDIF @@ -2639,7 +2639,7 @@ SUBROUTINE INITIALIZE_PROFILES(NM) SF => SURFACE(M%WALL(IW)%SURF_INDEX) ONE_D => M%BOUNDARY_ONE_D(M%WALL(IW)%OD_INDEX) ELSE - WRITE(LU_ERR,'(A,I0,A)') 'ERROR(409): PROF ',PF%ORDINAL,' requires repositioning.' + WRITE(LU_ERR,'(A,I0,A)') 'ERROR(429): PROF ',PF%ORDINAL,' requires repositioning.' STOP_STATUS = SETUP_STOP RETURN ENDIF @@ -2651,7 +2651,7 @@ SUBROUTINE INITIALIZE_PROFILES(NM) ENDIF IF (SF%THERMAL_BC_INDEX/=THERMALLY_THICK) THEN - WRITE(LU_ERR,'(A,I0,A)') 'ERROR(410): PROF ',N,' must be associated with a heat-conducting surface.' + WRITE(LU_ERR,'(A,I0,A)') 'ERROR(430): PROF ',N,' must be associated with a heat-conducting surface.' STOP_STATUS = SETUP_STOP RETURN ENDIF @@ -2665,7 +2665,7 @@ SUBROUTINE INITIALIZE_PROFILES(NM) ENDIF ENDDO IF (.NOT. SUCCESS) THEN - WRITE(LU_ERR,'(A,I3,A,A,A,A,A)') 'ERROR PROFile ',N,'. MATL_ID ',TRIM(PF%MATL_ID),' not part of surface type ',& + WRITE(LU_ERR,'(A,I3,A,A,A,A,A)') 'ERROR PROF ',N,'. MATL_ID ',TRIM(PF%MATL_ID),' not part of surface type ',& TRIM(SF%ID),' at the profile location.' STOP_STATUS = SETUP_STOP RETURN @@ -3017,7 +3017,7 @@ SUBROUTINE INIT_WALL_CELL(NM,I,J,K,OBST_INDEX,IW,IOR,SURF_INDEX,IERR,TT) ! Check to see if the current interpolated cell face spans more than one other mesh IF (NOM_CHECK(0)/=NOM_CHECK(1)) THEN - WRITE(LU_ERR,'(A,I0,A,I0)') 'ERROR(411): MESH ',NM,' is not in alignment with MESH ',MAXVAL(NOM_CHECK) + WRITE(LU_ERR,'(A,I0,A,I0)') 'ERROR(431): MESH ',NM,' is not in alignment with MESH ',MAXVAL(NOM_CHECK) STOP_STATUS = SETUP_STOP IERR = 1 RETURN @@ -3036,7 +3036,7 @@ SUBROUTINE INIT_WALL_CELL(NM,I,J,K,OBST_INDEX,IW,IOR,SURF_INDEX,IERR,TT) IF (ABS( ((MM%Z(KKO_MAX)-MM%Z(KKO_MIN-1))-(M%Z(K)-M%Z(K-1))) / MM%DZ(KKO_MIN))>ALIGNMENT_TOLERANCE ) ALIGNED = .FALSE. ENDIF IF (.NOT.ALIGNED) THEN - WRITE(LU_ERR,'(A,I0,A,I0)') 'ERROR(411): MESH ',NM,' is out of alignment with MESH ',NOM + WRITE(LU_ERR,'(A,I0,A,I0)') 'ERROR(431): MESH ',NM,' is out of alignment with MESH ',NOM STOP_STATUS = SETUP_STOP IERR = 1 RETURN @@ -3054,7 +3054,7 @@ SUBROUTINE INIT_WALL_CELL(NM,I,J,K,OBST_INDEX,IW,IOR,SURF_INDEX,IERR,TT) IF ( (M%DY(J)>1.01_EB*MM%DY(JJO_MIN)) .AND. (M%DX(I)<0.99_EB*MM%DX(IIO_MIN)) ) ALIGNED = .FALSE. END SELECT IF (.NOT.ALIGNED) THEN - WRITE(LU_ERR,'(A,I0,A,I0)') 'ERROR(411): MESH ',NM,' is out of alignment with MESH ',NOM + WRITE(LU_ERR,'(A,I0,A,I0)') 'ERROR(431): MESH ',NM,' is out of alignment with MESH ',NOM STOP_STATUS = SETUP_STOP IERR = 1 RETURN @@ -3269,7 +3269,7 @@ SUBROUTINE INIT_WALL_CELL(NM,I,J,K,OBST_INDEX,IW,IOR,SURF_INDEX,IERR,TT) SF%MASS_FLUX = -RHOA*(RSUM0/RSUM_F)*(TMPA/SF%TMP_FRONT)*SF%MASS_FRACTION*B1%U_NORMAL_0 SF%SPECIES_BC_INDEX = SPECIFIED_MASS_FLUX ELSE - CALL SHUTDOWN('ERROR(412): SURF: '//TRIM(SF%ID)//' must specify velocity boundary condition for conversion',& + CALL SHUTDOWN('ERROR(432): SURF: '//TRIM(SF%ID)//' must specify velocity boundary condition for conversion',& PROCESS_0_ONLY=.FALSE.) IERR = 1 RETURN @@ -3358,7 +3358,7 @@ SUBROUTINE INIT_WALL_CELL(NM,I,J,K,OBST_INDEX,IW,IOR,SURF_INDEX,IERR,TT) IF (SF%PROFILE==ATMOSPHERIC_PROFILE) THEN IF (M%ZC(K) MESHES(NOM) ELSEIF (IW<=M%N_EXTERNAL_WALL_CELLS .AND. (SF%HT_DIM>1.OR.SF%VARIABLE_THICKNESS)) THEN ! Do not apply HT3D to VARIABLE_THICKNESS exterior boundary - WRITE(MESSAGE,'(3A)') 'ERROR(417): SURF ',TRIM(SURFACE(WC%SURF_INDEX)%ID),' cannot be applied to an exterior boundary.' + WRITE(MESSAGE,'(3A)') 'ERROR(437): SURF ',TRIM(SURFACE(WC%SURF_INDEX)%ID),' cannot be applied to an exterior boundary.' CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.) RETURN ENDIF @@ -3891,7 +3891,7 @@ SUBROUTINE FIND_WALL_BACK_INDEX(NM,IW) CALL ADD_MATERIAL(N_MATLS_NEW,SF_BACK%MATL_INDEX,MATL_INDEX_NEW) ! Add new materials from the back surface lining TOTAL_THICKNESS = SUM(LAYER_THICKNESS(1:N_LAYERS)) ! Thickness of the solid made up of OBSTs IF (TOTAL_THICKNESSNULL() NAMELIST /TABL/ FYI,ID,TABLE_DATA @@ -9433,8 +9433,6 @@ SUBROUTINE READ_TABL TA%NUMBER_COLUMNS = 6 CASE (PART_RADIATIVE_PROPERTY) TA%NUMBER_COLUMNS = 3 - CASE (TABLE_2D_TYPE) - TA%NUMBER_COLUMNS = 3 END SELECT SEARCH_LOOP: DO CALL CHECKREAD('TABL',LU_INPUT,IOS) ; IF (STOP_STATUS==SETUP_STOP) RETURN @@ -9455,61 +9453,42 @@ SUBROUTINE READ_TABL CALL SHUTDOWN(MESSAGE) ; RETURN ENDIF IF (TABLE_DATA(3)<-180._EB .OR. TABLE_DATA(3)>360._EB) THEN - WRITE(MESSAGE,'(A,I0,A,A,A)') 'ERROR(396): Row ',TA%NUMBER_ROWS,' of ',TRIM(TABLE_ID(N)),' has a bad 1st longitude.' + WRITE(MESSAGE,'(A,I0,A,A,A)') 'ERROR(398): Row ',TA%NUMBER_ROWS,' of ',TRIM(TABLE_ID(N)),' has a bad 1st longitude.' CALL SHUTDOWN(MESSAGE) ; RETURN ENDIF IF (TABLE_DATA(4)360._EB) THEN - WRITE(MESSAGE,'(A,I0,A,A,A)') 'ERROR: Row ',TA%NUMBER_ROWS,' of ',TRIM(TABLE_ID(N)),' has a bad 2nd longitude' + WRITE(MESSAGE,'(A,I0,A,A,A)') 'ERROR(399): Row ',TA%NUMBER_ROWS,' of ',TRIM(TABLE_ID(N)),' has a bad 2nd longitude.' CALL SHUTDOWN(MESSAGE) ; RETURN ENDIF IF (TABLE_DATA(5)<0._EB) THEN - WRITE(MESSAGE,'(A,I0,A,A,A)') 'ERROR: Row ',TA%NUMBER_ROWS,' of ',TRIM(TABLE_ID(N)),' has a bad velocity' + WRITE(MESSAGE,'(A,I0,A,A,A)') 'ERROR(400): Row ',TA%NUMBER_ROWS,' of ',TRIM(TABLE_ID(N)),' has a bad velocity.' CALL SHUTDOWN(MESSAGE) ; RETURN ENDIF IF (TABLE_DATA(6)<0._EB) THEN - WRITE(MESSAGE,'(A,I0,A,A,A)') 'ERROR: Row ',TA%NUMBER_ROWS,' of ',TRIM(TABLE_ID(N)),' has a bad mass flow' + WRITE(MESSAGE,'(A,I0,A,A,A)') 'ERROR(401): Row ',TA%NUMBER_ROWS,' of ',TRIM(TABLE_ID(N)),' has a bad mass flow.' CALL SHUTDOWN(MESSAGE) ; RETURN ENDIF CASE (PART_RADIATIVE_PROPERTY) IF (TABLE_DATA(1)<0._EB) THEN - WRITE(MESSAGE,'(A,I0,A,A,A)') 'ERROR: Row ',TA%NUMBER_ROWS,' of ',TRIM(TABLE_ID(N)),' has a bad wave length' + WRITE(MESSAGE,'(A,I0,A,A,A)') 'ERROR(402): Row ',TA%NUMBER_ROWS,' of ',TRIM(TABLE_ID(N)),' has a bad wavelength.' CALL SHUTDOWN(MESSAGE) ; RETURN ENDIF IF (TABLE_DATA(2)<=0._EB) THEN - WRITE(MESSAGE,'(A,I0,A,A,A)') 'ERROR: Row ',TA%NUMBER_ROWS,' of ',TRIM(TABLE_ID(N)),' has a bad real index' + WRITE(MESSAGE,'(A,I0,A,A,A)') 'ERROR(403): Row ',TA%NUMBER_ROWS,' of ',TRIM(TABLE_ID(N)),' has a bad real index.' CALL SHUTDOWN(MESSAGE) ; RETURN ENDIF IF (TABLE_DATA(3)< 0._EB) THEN - WRITE(MESSAGE,'(A,I0,A,A,A)') 'ERROR: Row ',TA%NUMBER_ROWS,' of ',TRIM(TABLE_ID(N)),' has a bad complex index' + WRITE(MESSAGE,'(A,I0,A,A,A)') 'ERROR(404): Row ',TA%NUMBER_ROWS,' of ',TRIM(TABLE_ID(N)),' has a bad complex index.' CALL SHUTDOWN(MESSAGE) ; RETURN ENDIF - CASE (TABLE_2D_TYPE) - IF (TA%NUMBER_ROWS == 1) THEN - IF (INT(TABLE_DATA(1)) <= 0._EB) THEN - WRITE(MESSAGE,'(A,I0,A,A,A)') 'ERROR: Row ',TA%NUMBER_ROWS,' of ',TRIM(TABLE_ID(N)),& - ' has < 1 x entries' - CALL SHUTDOWN(MESSAGE) ; RETURN - ENDIF - IF (INT(TABLE_DATA(2)) < 0._EB) THEN - WRITE(MESSAGE,'(A,I0,A,A,A)') 'ERROR: Row ',TA%NUMBER_ROWS,' of ',TRIM(TABLE_ID(N)),& - ' has < 1 y entries' - CALL SHUTDOWN(MESSAGE) ; RETURN - ENDIF - ENDIF END SELECT - 56 IF (IOS>0) THEN ; CALL SHUTDOWN('ERROR: Problem with TABLE '//TRIM(TABLE_ID(N)) ) ; RETURN ; ENDIF + 56 IF (IOS>0) THEN ; CALL SHUTDOWN('ERROR(101): Problem with TABLE '//TRIM(TABLE_ID(N)) ) ; RETURN ; ENDIF ENDDO SEARCH_LOOP IF (TA%NUMBER_ROWS<=0) THEN - WRITE(MESSAGE,'(A,A,A)') 'ERROR: TABLE ',TRIM(TABLE_ID(N)), ' not found' + WRITE(MESSAGE,'(A,A,A)') 'ERROR(407): TABLE ',TRIM(TABLE_ID(N)), ' not found.' CALL SHUTDOWN(MESSAGE) ; RETURN ENDIF - IF (TABLE_TYPE(N) == TABLE_2D_TYPE) THEN - IF (TA%NUMBER_ROWS<=1) THEN - WRITE(MESSAGE,'(A,A,A)') 'ERROR: 2D TABLE ',TRIM(TABLE_ID(N)), ' must have at least one row of data' - CALL SHUTDOWN(MESSAGE) ; RETURN - ENDIF - ENDIF ENDDO COUNT_TABLE_POINTS READ_TABL_LOOP: DO N=1,N_TABLE @@ -9526,47 +9505,6 @@ SUBROUTINE READ_TABL NN = NN+1 TA%TABLE_DATA(NN,:) = TABLE_DATA(1:TA%NUMBER_COLUMNS) ENDDO SEARCH_LOOP2 - TABLE_2D_IF: IF (TABLE_TYPE(N)==TABLE_2D_TYPE) THEN - IF (TA%NUMBER_ROWS-1/=INT(TA%TABLE_DATA(1,1))*INT(TA%TABLE_DATA(1,2))) THEN - WRITE(MESSAGE,'(A,A,A)') 'ERROR: 2D TABLE ',TRIM(TABLE_ID(N)), ' is not rectangular' - CALL SHUTDOWN(MESSAGE) ; RETURN - ENDIF - TA%LX = MINVAL(TA%TABLE_DATA(2:TA%NUMBER_ROWS,1),1) - TA%UX = MAXVAL(TA%TABLE_DATA(2:TA%NUMBER_ROWS,1),1) - TA%LY = MINVAL(TA%TABLE_DATA(2:TA%NUMBER_ROWS,2),1) - TA%UY = MAXVAL(TA%TABLE_DATA(2:TA%NUMBER_ROWS,2),1) - ALLOCATE(TA%X(INT(TA%TABLE_DATA(1,1))),STAT=IZERO) - CALL ChkMemErr('READ','TA%X',IZERO) - ALLOCATE(TA%Y(INT(TA%TABLE_DATA(1,2))),STAT=IZERO) - CALL ChkMemErr('READ','TA%Y',IZERO) - ALLOCATE(TA%Z(INT(TA%TABLE_DATA(1,1)),INT(TA%TABLE_DATA(1,2))),STAT=IZERO) - CALL ChkMemErr('READ','TA%Z',IZERO) - NN = 1 - TA%NUMBER_ROWS = INT(TA%TABLE_DATA(1,1)) - TA%NUMBER_COLUMNS = INT(TA%TABLE_DATA(1,2)) - DO I = 1, TA%NUMBER_ROWS - DO J = 1, TA%NUMBER_COLUMNS - NN = NN + 1 - IF (J==1) THEN - TA%X(I)=TA%TABLE_DATA(NN,1) - ELSE - IF (TA%TABLE_DATA(NN,1) /= TA%X(I)) THEN - WRITE(MESSAGE,'(A,A,A)') 'ERROR: 2D TABLE ',TRIM(TABLE_ID(N)), ' x value must be the same for each row' - CALL SHUTDOWN(MESSAGE) ; RETURN - ENDIF - ENDIF - IF (I==1) THEN - TA%Y(J)=TA%TABLE_DATA(NN,2) - ELSE - IF (TA%TABLE_DATA(NN,2) /= TA%Y(J)) THEN - WRITE(MESSAGE,'(A,A,A)') 'ERROR: 2D TABLE ',TRIM(TABLE_ID(N)), ' y value must be the same for each column' - CALL SHUTDOWN(MESSAGE) ; RETURN - ENDIF - ENDIF - TA%Z(I,J) = TA%TABLE_DATA(NN,3) - ENDDO - ENDDO - ENDIF TABLE_2D_IF ENDDO READ_TABL_LOOP END SUBROUTINE READ_TABL diff --git a/Source/type.f90 b/Source/type.f90 index ba9f1907df8..f82471bab7e 100644 --- a/Source/type.f90 +++ b/Source/type.f90 @@ -1420,9 +1420,7 @@ MODULE TYPES TYPE TABLES_TYPE INTEGER :: NUMBER_ROWS,NUMBER_COLUMNS - REAL(EB) :: LX,LY,UX,UY - REAL(EB), ALLOCATABLE, DIMENSION(:) :: X,Y - REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: TABLE_DATA,Z + REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: TABLE_DATA END TYPE TABLES_TYPE TYPE (TABLES_TYPE), DIMENSION(:), ALLOCATABLE, TARGET :: TABLES