Changeset 4872 for trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
- Timestamp:
- 2014-11-18T18:03:00+01:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
r4765 r4872 259 259 !------------------------- 260 260 261 CALL tab_2d_1d( nbpb, at_i_ b(1:nbpb), at_i , jpi, jpj, npb(1:nbpb) )262 CALL tab_2d_1d( nbpb, a_i_ b(1:nbpb), a_i(:,:,jl) , jpi, jpj, npb(1:nbpb) )263 CALL tab_2d_1d( nbpb, ht_i_ b(1:nbpb), ht_i(:,:,jl) , jpi, jpj, npb(1:nbpb) )264 CALL tab_2d_1d( nbpb, ht_s_ b(1:nbpb), ht_s(:,:,jl) , jpi, jpj, npb(1:nbpb) )265 266 CALL tab_2d_1d( nbpb, t_su_ b(1:nbpb), t_su(:,:,jl) , jpi, jpj, npb(1:nbpb) )267 CALL tab_2d_1d( nbpb, sm_i_ b(1:nbpb), sm_i(:,:,jl) , jpi, jpj, npb(1:nbpb) )261 CALL tab_2d_1d( nbpb, at_i_1d (1:nbpb), at_i , jpi, jpj, npb(1:nbpb) ) 262 CALL tab_2d_1d( nbpb, a_i_1d (1:nbpb), a_i(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 263 CALL tab_2d_1d( nbpb, ht_i_1d (1:nbpb), ht_i(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 264 CALL tab_2d_1d( nbpb, ht_s_1d (1:nbpb), ht_s(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 265 266 CALL tab_2d_1d( nbpb, t_su_1d (1:nbpb), t_su(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 267 CALL tab_2d_1d( nbpb, sm_i_1d (1:nbpb), sm_i(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 268 268 DO jk = 1, nlay_s 269 CALL tab_2d_1d( nbpb, t_s_ b(1:nbpb,jk), t_s(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) )270 CALL tab_2d_1d( nbpb, q_s_ b(1:nbpb,jk), e_s(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) )269 CALL tab_2d_1d( nbpb, t_s_1d(1:nbpb,jk), t_s(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) ) 270 CALL tab_2d_1d( nbpb, q_s_1d(1:nbpb,jk), e_s(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) ) 271 271 END DO 272 272 DO jk = 1, nlay_i 273 CALL tab_2d_1d( nbpb, t_i_ b(1:nbpb,jk), t_i(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) )274 CALL tab_2d_1d( nbpb, q_i_ b(1:nbpb,jk), e_i(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) )275 CALL tab_2d_1d( nbpb, s_i_ b(1:nbpb,jk), s_i(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) )273 CALL tab_2d_1d( nbpb, t_i_1d(1:nbpb,jk), t_i(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) ) 274 CALL tab_2d_1d( nbpb, q_i_1d(1:nbpb,jk), e_i(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) ) 275 CALL tab_2d_1d( nbpb, s_i_1d(1:nbpb,jk), s_i(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) ) 276 276 END DO 277 277 … … 287 287 ENDIF 288 288 CALL tab_2d_1d( nbpb, dqns_ice_1d(1:nbpb), dqns_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 289 CALL tab_2d_1d( nbpb, t_bo_ b(1:nbpb), t_bo , jpi, jpj, npb(1:nbpb) )289 CALL tab_2d_1d( nbpb, t_bo_1d (1:nbpb), t_bo , jpi, jpj, npb(1:nbpb) ) 290 290 CALL tab_2d_1d( nbpb, sprecip_1d (1:nbpb), sprecip , jpi, jpj, npb(1:nbpb) ) 291 291 CALL tab_2d_1d( nbpb, fhtur_1d (1:nbpb), fhtur , jpi, jpj, npb(1:nbpb) ) … … 341 341 342 342 ! --- Ice enthalpy remapping --- ! 343 CALL lim_thd_ent( 1, nbpb, q_i_ b(1:nbpb,:) )343 CALL lim_thd_ent( 1, nbpb, q_i_1d(1:nbpb,:) ) 344 344 345 345 !---------------------------------! … … 357 357 !-------------------------------- 358 358 359 CALL tab_1d_2d( nbpb, at_i , npb, at_i_ b(1:nbpb) , jpi, jpj )360 CALL tab_1d_2d( nbpb, ht_i(:,:,jl) , npb, ht_i_ b(1:nbpb) , jpi, jpj )361 CALL tab_1d_2d( nbpb, ht_s(:,:,jl) , npb, ht_s_ b(1:nbpb) , jpi, jpj )362 CALL tab_1d_2d( nbpb, a_i (:,:,jl) , npb, a_i_ b(1:nbpb) , jpi, jpj )363 CALL tab_1d_2d( nbpb, t_su(:,:,jl) , npb, t_su_ b(1:nbpb) , jpi, jpj )364 CALL tab_1d_2d( nbpb, sm_i(:,:,jl) , npb, sm_i_ b(1:nbpb) , jpi, jpj )359 CALL tab_1d_2d( nbpb, at_i , npb, at_i_1d (1:nbpb) , jpi, jpj ) 360 CALL tab_1d_2d( nbpb, ht_i(:,:,jl) , npb, ht_i_1d (1:nbpb) , jpi, jpj ) 361 CALL tab_1d_2d( nbpb, ht_s(:,:,jl) , npb, ht_s_1d (1:nbpb) , jpi, jpj ) 362 CALL tab_1d_2d( nbpb, a_i (:,:,jl) , npb, a_i_1d (1:nbpb) , jpi, jpj ) 363 CALL tab_1d_2d( nbpb, t_su(:,:,jl) , npb, t_su_1d (1:nbpb) , jpi, jpj ) 364 CALL tab_1d_2d( nbpb, sm_i(:,:,jl) , npb, sm_i_1d (1:nbpb) , jpi, jpj ) 365 365 DO jk = 1, nlay_s 366 CALL tab_1d_2d( nbpb, t_s(:,:,jk,jl), npb, t_s_ b(1:nbpb,jk), jpi, jpj)367 CALL tab_1d_2d( nbpb, e_s(:,:,jk,jl), npb, q_s_ b(1:nbpb,jk), jpi, jpj)366 CALL tab_1d_2d( nbpb, t_s(:,:,jk,jl), npb, t_s_1d (1:nbpb,jk), jpi, jpj) 367 CALL tab_1d_2d( nbpb, e_s(:,:,jk,jl), npb, q_s_1d (1:nbpb,jk), jpi, jpj) 368 368 END DO 369 369 DO jk = 1, nlay_i 370 CALL tab_1d_2d( nbpb, t_i(:,:,jk,jl), npb, t_i_ b(1:nbpb,jk), jpi, jpj)371 CALL tab_1d_2d( nbpb, e_i(:,:,jk,jl), npb, q_i_ b(1:nbpb,jk), jpi, jpj)372 CALL tab_1d_2d( nbpb, s_i(:,:,jk,jl), npb, s_i_ b(1:nbpb,jk), jpi, jpj)370 CALL tab_1d_2d( nbpb, t_i(:,:,jk,jl), npb, t_i_1d (1:nbpb,jk), jpi, jpj) 371 CALL tab_1d_2d( nbpb, e_i(:,:,jk,jl), npb, q_i_1d (1:nbpb,jk), jpi, jpj) 372 CALL tab_1d_2d( nbpb, s_i(:,:,jk,jl), npb, s_i_1d (1:nbpb,jk), jpi, jpj) 373 373 END DO 374 374 CALL tab_1d_2d( nbpb, qlead , npb, qlead_1d (1:nbpb) , jpi, jpj ) … … 507 507 DO jk = 1, nlay_i 508 508 DO ji = kideb, kiut 509 ztmelts = -tmut * s_i_ b(ji,jk) + rtt509 ztmelts = -tmut * s_i_1d(ji,jk) + rtt 510 510 ! Conversion q(S,T) -> T (second order equation) 511 511 zaaa = cpic 512 zbbb = ( rcp - cpic ) * ( ztmelts - rtt ) + q_i_ b(ji,jk) / rhoic - lfus512 zbbb = ( rcp - cpic ) * ( ztmelts - rtt ) + q_i_1d(ji,jk) / rhoic - lfus 513 513 zccc = lfus * ( ztmelts - rtt ) 514 514 zdiscrim = SQRT( MAX( zbbb * zbbb - 4._wp * zaaa * zccc, 0._wp ) ) 515 t_i_ b(ji,jk) = rtt - ( zbbb + zdiscrim ) / ( 2._wp * zaaa )515 t_i_1d(ji,jk) = rtt - ( zbbb + zdiscrim ) / ( 2._wp * zaaa ) 516 516 517 517 ! mask temperature 518 zswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_i_ b(ji) ) )519 t_i_ b(ji,jk) = zswitch * t_i_b(ji,jk) + ( 1._wp - zswitch ) * rtt518 zswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_i_1d(ji) ) ) 519 t_i_1d(ji,jk) = zswitch * t_i_1d(ji,jk) + ( 1._wp - zswitch ) * rtt 520 520 END DO 521 521 END DO
Note: See TracChangeset
for help on using the changeset viewer.