Changeset 1249
- Timestamp:
- Nov 6, 2013 10:45:47 AM (10 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 2 edited
-
ls_forcing.f90 (modified) (17 diffs)
-
nudging.f90 (modified) (12 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/ls_forcing.f90
r1242 r1249 20 20 ! Current revisions: 21 21 ! ------------------ 22 ! 22 ! remove call of user module 23 ! reformatting 23 24 ! 24 25 ! Former revisions: … … 51 52 USE interfaces 52 53 USE pegrid 53 USE user54 54 55 55 IMPLICIT NONE 56 56 57 INTEGER :: finput = 90, ierrn, k, t58 CHARACTER (100):: chmess59 CHARACTER(1) :: hash60 REAL :: r_dummy, fac61 REAL :: highheight, highug_vert, highvg_vert, highwsubs_vert62 REAL :: lowheight, lowug_vert, lowvg_vert, lowwsubs_vert57 INTEGER :: finput = 90, ierrn, k, t 58 CHARACTER (100):: chmess 59 CHARACTER(1) :: hash 60 REAL :: r_dummy, fac 61 REAL :: highheight, highug_vert, highvg_vert, highwsubs_vert 62 REAL :: lowheight, lowug_vert, lowvg_vert, lowwsubs_vert 63 63 64 64 ALLOCATE( p_surf(0:nlsf), pt_surf(0:nlsf), q_surf(0:nlsf), & … … 72 72 73 73 74 OPEN ( finput, FILE='LSF_DATA', STATUS='OLD', &75 FORM='FORMATTED', IOSTAT=ierrn )76 77 IF ( ierrn /= 0 )THEN74 OPEN ( finput, FILE='LSF_DATA', STATUS='OLD', & 75 FORM='FORMATTED', IOSTAT=ierrn ) 76 77 IF ( ierrn /= 0 ) THEN 78 78 message_string = 'file LSF_DATA does not exist' 79 79 CALL message( 'ls_forcing', 'PA0368', 1, 2, 0, 6, 0 ) … … 83 83 ! 84 84 !-- First three lines of LSF_DATA contain header 85 READ ( finput, FMT='(a100)', IOSTAT=ierrn ) chmess86 READ ( finput, FMT='(a100)', IOSTAT=ierrn ) chmess87 READ ( finput, FMT='(a100)', IOSTAT=ierrn ) chmess88 89 IF ( ierrn /= 0 )THEN85 READ ( finput, FMT='(a100)', IOSTAT=ierrn ) chmess 86 READ ( finput, FMT='(a100)', IOSTAT=ierrn ) chmess 87 READ ( finput, FMT='(a100)', IOSTAT=ierrn ) chmess 88 89 IF ( ierrn /= 0 ) THEN 90 90 message_string = 'errors in file LSF_DATA' 91 91 CALL message( 'ls_forcing', 'PA0369', 1, 2, 0, 6, 0 ) … … 99 99 DO WHILE ( time_surf(t) < end_time ) 100 100 t = t + 1 101 READ ( finput, *, IOSTAT = ierrn ) time_surf(t), shf_surf(t), &101 READ ( finput, *, IOSTAT = ierrn ) time_surf(t), shf_surf(t), & 102 102 qsws_surf(t), pt_surf(t), & 103 103 q_surf(t), p_surf(t) 104 104 105 IF ( ierrn < 0 ) THEN106 WRITE ( message_string, * ) 'No time dependend surface variables ',&105 IF ( ierrn < 0 ) THEN 106 WRITE ( message_string, * ) 'No time dependend surface variables ',& 107 107 'in&LSF_DATA for end of run found' 108 108 … … 112 112 113 113 114 IF ( time_surf(1) > end_time ) THEN115 WRITE ( message_string, * ) 'No time dependend surface variables in ',&114 IF ( time_surf(1) > end_time ) THEN 115 WRITE ( message_string, * ) 'No time dependend surface variables in ',& 116 116 '&LSF_DATA for end of run found - ', & 117 117 'lsf_surf is set to FALSE' … … 123 123 !-- Go to the end of the list with surface variables 124 124 DO WHILE ( ierrn == 0 ) 125 READ ( finput, *, IOSTAT = ierrn) r_dummy125 READ ( finput, *, IOSTAT = ierrn ) r_dummy 126 126 ENDDO 127 127 … … 130 130 131 131 t = 0 132 DO WHILE ( time_vert(t) < end_time)132 DO WHILE ( time_vert(t) < end_time ) 133 133 t = t + 1 134 134 hash = "#" … … 138 138 !-- from there onwards the profiles will be read 139 139 DO WHILE ( .NOT. ( hash == "#" .AND. ierrn == 0 ) ) 140 READ ( finput, *, IOSTAT=ierrn ) hash, time_vert(t)141 IF ( ierrn < 0 ) THEN140 READ ( finput, *, IOSTAT=ierrn ) hash, time_vert(t) 141 IF ( ierrn < 0 ) THEN 142 142 WRITE( message_string, * ) 'No time dependend vertical profiles',& 143 143 ' in&LSF_DATA for end of run found' … … 148 148 IF ( t == 1 .AND. time_vert(t) > end_time ) EXIT 149 149 150 READ ( finput, *, IOSTAT=ierrn ) lowheight, lowug_vert, lowvg_vert, &151 lowwsubs_vert152 IF ( ierrn /= 0 )THEN150 READ ( finput, *, IOSTAT=ierrn ) lowheight, lowug_vert, lowvg_vert, & 151 lowwsubs_vert 152 IF ( ierrn /= 0 ) THEN 153 153 message_string = 'errors in file LSF_DATA' 154 154 CALL message( 'nudging', 'PA0369', 1, 2, 0, 6, 0 ) 155 155 ENDIF 156 156 157 READ ( finput, *, IOSTAT=ierrn ) highheight, highug_vert, highvg_vert, &158 highwsubs_vert157 READ ( finput, *, IOSTAT=ierrn ) highheight, highug_vert, highvg_vert, & 158 highwsubs_vert 159 159 160 IF ( ierrn /= 0 )THEN160 IF ( ierrn /= 0 ) THEN 161 161 message_string = 'errors in file LSF_DATA' 162 162 CALL message( 'nudging', 'PA0369', 1, 2, 0, 6, 0 ) … … 165 165 166 166 DO k = nzb, nzt+1 167 IF ( highheight < zu(k) ) THEN167 IF ( highheight < zu(k) ) THEN 168 168 lowheight = highheight 169 169 lowug_vert = highug_vert … … 172 172 173 173 ierrn = 0 174 READ ( finput, *, IOSTAT=ierrn ) highheight, highug_vert, &175 highvg_vert, highwsubs_vert176 177 IF ( ierrn /= 0 )THEN174 READ ( finput, *, IOSTAT=ierrn ) highheight, highug_vert, & 175 highvg_vert, highwsubs_vert 176 177 IF ( ierrn /= 0 ) THEN 178 178 message_string = 'errors in file LSF_DATA' 179 179 CALL message( 'nudging', 'PA0369', 1, 2, 0, 6, 0 ) … … 194 194 ENDDO 195 195 196 IF ( time_vert(1) > end_time ) THEN197 WRITE ( message_string, * ) 'Time dependent large scale profile ',&198 'forcing from&LSF_DATA sets in after end of ' ,&199 'simulation - lsf_vert is set to FALSE'196 IF ( time_vert(1) > end_time ) THEN 197 WRITE ( message_string, * ) 'Time dependent large scale profile ',& 198 'forcing from&LSF_DATA sets in after end of ' ,& 199 'simulation - lsf_vert is set to FALSE' 200 200 CALL message( 'ls_forcing', 'PA0373', 0, 0, 0, 6, 0 ) 201 201 lsf_vert = .FALSE. … … 216 216 USE interfaces 217 217 USE pegrid 218 USE user219 218 220 219 IMPLICIT NONE … … 230 229 t = t + 1 231 230 ENDDO 232 IF ( time /= time_surf(t) ) THEN231 IF ( time /= time_surf(t) ) THEN 233 232 t = t - 1 234 233 ENDIF … … 252 251 USE interfaces 253 252 USE pegrid 254 USE user255 253 256 254 IMPLICIT NONE … … 266 264 t = t + 1 267 265 ENDDO 268 IF ( time /= time_vert(t) ) THEN266 IF ( time /= time_vert(t) ) THEN 269 267 t = t - 1 270 268 ENDIF 271 269 272 fac = ( time-time_vert(t)) / (time_vert(t+1)-time_vert(t))270 fac = ( time-time_vert(t) ) / ( time_vert(t+1)-time_vert(t) ) 273 271 274 272 ug = ug_vert(:,t) + fac * ( ug_vert(:,t+1) - ug_vert(:,t) ) 275 273 vg = vg_vert(:,t) + fac * ( vg_vert(:,t+1) - vg_vert(:,t) ) 276 274 277 IF ( large_scale_subsidence ) THEN275 IF ( large_scale_subsidence ) THEN 278 276 w_subs = wsubs_vert(:,t) + fac * ( wsubs_vert(:,t+1) - wsubs_vert(:,t) ) 279 277 ENDIF -
palm/trunk/SOURCE/nudging.f90
r1242 r1249 20 20 ! Current revisions: 21 21 ! ------------------ 22 ! 22 ! remove call of user module 23 ! reformatting 23 24 ! 24 25 ! Former revisions: … … 55 56 USE interfaces 56 57 USE pegrid 57 USE user58 58 59 59 IMPLICIT NONE … … 79 79 80 80 t = 0 81 OPEN ( finput, FILE='NUDGING_DATA', STATUS='OLD', &82 FORM='FORMATTED', IOSTAT=ierrn )83 84 IF ( ierrn /= 0 )THEN81 OPEN ( finput, FILE='NUDGING_DATA', STATUS='OLD', & 82 FORM='FORMATTED', IOSTAT=ierrn ) 83 84 IF ( ierrn /= 0 ) THEN 85 85 message_string = 'file NUDGING_DATA does not exist' 86 86 CALL message( 'nudging', 'PA0365', 1, 2, 0, 6, 0 ) … … 98 98 DO WHILE ( .NOT. ( hash == "#" .AND. ierrn == 0 ) ) 99 99 100 READ ( finput, *, IOSTAT=ierrn ) hash, timenudge(t)101 IF ( ierrn < 0 ) EXIT rloop100 READ ( finput, *, IOSTAT=ierrn ) hash, timenudge(t) 101 IF ( ierrn < 0 ) EXIT rloop 102 102 103 103 ENDDO 104 104 105 105 ierrn = 0 106 READ ( finput, *, IOSTAT=ierrn ) lowheight, lowtnudge, lowunudge, &107 lowvnudge, lowwnudge , lowptnudge, &108 lowqnudge109 110 IF ( ierrn /= 0 )THEN106 READ ( finput, *, IOSTAT=ierrn ) lowheight, lowtnudge, lowunudge, & 107 lowvnudge, lowwnudge , lowptnudge, & 108 lowqnudge 109 110 IF ( ierrn /= 0 ) THEN 111 111 message_string = 'errors in file NUDGING_DATA' 112 112 CALL message( 'nudging', 'PA0366', 1, 2, 0, 6, 0 ) … … 114 114 115 115 ierrn = 0 116 READ ( finput, *, IOSTAT=ierrn ) highheight, hightnudge, highunudge, &117 highvnudge, highwnudge , highptnudge, &118 highqnudge119 120 IF ( ierrn /= 0 )THEN116 READ ( finput, *, IOSTAT=ierrn ) highheight, hightnudge, highunudge, & 117 highvnudge, highwnudge , highptnudge, & 118 highqnudge 119 120 IF ( ierrn /= 0 ) THEN 121 121 message_string = 'errors in file NUDGING_DATA' 122 122 CALL message( 'nudging', 'PA0366', 1, 2, 0, 6, 0 ) … … 124 124 125 125 DO k = nzb, nzt+1 126 IF ( highheight < zu(k) ) THEN126 IF ( highheight < zu(k) ) THEN 127 127 lowheight = highheight 128 128 lowtnudge = hightnudge … … 134 134 135 135 ierrn = 0 136 READ ( finput, *, IOSTAT=ierrn ) highheight , hightnudge , &137 highunudge , highvnudge , &138 highwnudge , highptnudge, &139 highqnudge140 IF (ierrn /= 0 ) THEN136 READ ( finput, *, IOSTAT=ierrn ) highheight , hightnudge , & 137 highunudge , highvnudge , & 138 highwnudge , highptnudge, & 139 highqnudge 140 IF (ierrn /= 0 ) THEN 141 141 message_string = 'errors in file NUDGING_DATA' 142 142 CALL message( 'nudging', 'PA0366', 1, 2, 0, 6, 0 ) … … 147 147 !-- Interpolation of prescribed profiles in space 148 148 149 fac = ( highheight-zu(k))/(highheight - lowheight)150 151 tnudge(k,t) = fac * lowtnudge + ( 1-fac) * hightnudge152 unudge(k,t) = fac * lowunudge + ( 1-fac) * highunudge153 vnudge(k,t) = fac * lowvnudge + ( 1-fac) * highvnudge154 wnudge(k,t) = fac * lowwnudge + ( 1-fac) * highwnudge155 ptnudge(k,t) = fac * lowptnudge + ( 1-fac) * highptnudge156 qnudge(k,t) = fac * lowqnudge + ( 1-fac) * highqnudge149 fac = ( highheight - zu(k) ) / ( highheight - lowheight ) 150 151 tnudge(k,t) = fac * lowtnudge + ( 1 - fac ) * hightnudge 152 unudge(k,t) = fac * lowunudge + ( 1 - fac ) * highunudge 153 vnudge(k,t) = fac * lowvnudge + ( 1 - fac ) * highvnudge 154 wnudge(k,t) = fac * lowwnudge + ( 1 - fac ) * highwnudge 155 ptnudge(k,t) = fac * lowptnudge + ( 1 - fac ) * highptnudge 156 qnudge(k,t) = fac * lowqnudge + ( 1 - fac ) * highqnudge 157 157 ENDDO 158 158 159 159 ENDDO rloop 160 160 161 CLOSE ( finput )161 CLOSE ( finput ) 162 162 163 163 ! … … 185 185 USE pegrid 186 186 USE statistics 187 USE user188 187 189 188 IMPLICIT NONE … … 297 296 USE pegrid 298 297 USE statistics 299 USE user300 298 301 299 IMPLICIT NONE … … 312 310 t = t+1 313 311 ENDDO 314 IF ( time /= timenudge(1) ) THEN312 IF ( time /= timenudge(1) ) THEN 315 313 t = t-1 316 314 ENDIF … … 328 326 329 327 currtnudge = MAX( dt_3d, tnudge(k,t) * dtp + tnudge(k,t+1) * dtm ) 330 331 !IF ((myid ==0 .AND. k==2) .AND. (i==1 .AND. j==1)) THEN332 ! PRINT*, time, dt_3d, intermediate_timestep_count, currtnudge, dtp, dtm333 !ENDIF334 328 335 329 tend(k,j,i) = tend(k,j,i) - ( hom(k,1,1,0) - &
Note: See TracChangeset
for help on using the changeset viewer.
