- Timestamp:
- 2015-07-10T13:28:53+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90
r4696 r5581 33 33 USE limtab_2 34 34 USE prtctl ! Print control 35 USE cpl_oasis3, ONLY : lk_cpl36 USE diaar5 , ONLY : lk_diaar537 35 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 38 36 … … 116 114 CALL wrk_alloc( jpi, jpj, jpk, zmsk ) 117 115 118 IF( kt == nit000 ) CALL lim_thd_init_2 ! Initialization (first time-step only)116 IF( kt == nit000 ) CALL lim_thd_init_2 ! Initialization (first time-step only) 119 117 120 118 !-------------------------------------------! … … 139 137 rdq_ice(:,:) = 0.e0 ! heat content associated with rdm_ice 140 138 zmsk (:,:,:) = 0.e0 141 IF( ltrcdm2dc_ice ) fstric_daymean (:,:) = 0.e0 ! part of solar radiation absorbing inside the ice142 139 143 140 ! set to zero snow thickness smaller than epsi04 … … 219 216 220 217 ! partial computation of the lead energy budget (qldif) 221 #if defined key_coupled222 qldif(ji,jj) = tms(ji,jj) * rdt_ice &223 & * ( ( qsr_tot(ji,jj) - qsr_ice(ji,jj,1) * zfricp ) * ( 1.0 - thcm(ji,jj) ) &224 & + ( qns_tot(ji,jj) - qns_ice(ji,jj,1) * zfricp ) &225 & + frld(ji,jj) * ( fdtcn(ji,jj) + ( 1.0 - zindb ) * fsbbq(ji,jj) ) )226 #else 227 qldif(ji,jj) = tms(ji,jj) * rdt_ice * frld(ji,jj) &228 & * ( qsr(ji,jj) * ( 1.0 - thcm(ji,jj) ) &229 & + qns(ji,jj) + fdtcn(ji,jj) &230 & + ( 1.0 - zindb ) * fsbbq(ji,jj) )231 #endif 218 IF( ln_cpl ) THEN 219 qldif(ji,jj) = tms(ji,jj) * rdt_ice & 220 & * ( ( qsr_tot(ji,jj) - qsr_ice(ji,jj,1) * zfricp ) * ( 1.0 - thcm(ji,jj) ) & 221 & + ( qns_tot(ji,jj) - qns_ice(ji,jj,1) * zfricp ) & 222 & + frld(ji,jj) * ( fdtcn(ji,jj) + ( 1.0 - zindb ) * fsbbq(ji,jj) ) ) 223 ELSE 224 qldif(ji,jj) = tms(ji,jj) * rdt_ice * frld(ji,jj) & 225 & * ( qsr(ji,jj) * ( 1.0 - thcm(ji,jj) ) & 226 & + qns(ji,jj) + fdtcn(ji,jj) & 227 & + ( 1.0 - zindb ) * fsbbq(ji,jj) ) 228 ENDIF 232 229 ! parlat : percentage of energy used for lateral ablation (0.0) 233 230 zfntlat = 1.0 - MAX( rzero , SIGN( rone , - qldif(ji,jj) ) ) … … 287 284 CALL tab_2d_1d_2( nbpb, tbif_1d (1:nbpb , 3 ), tbif(:,:,3) , jpi, jpj, npb(1:nbpb) ) 288 285 CALL tab_2d_1d_2( nbpb, qsr_ice_1d (1:nbpb) , qsr_ice(:,:,1) , jpi, jpj, npb(1:nbpb) ) 289 IF( ltrcdm2dc_ice ) &290 & CALL tab_2d_1d_2( nbpb, qsr_ice_mean_1d (1:nbpb), qsr_ice_mean(:,:,1), jpi, jpj, npb(1:nbpb) )291 286 CALL tab_2d_1d_2( nbpb, fr1_i0_1d (1:nbpb) , fr1_i0 , jpi, jpj, npb(1:nbpb) ) 292 287 CALL tab_2d_1d_2( nbpb, fr2_i0_1d (1:nbpb) , fr2_i0 , jpi, jpj, npb(1:nbpb) ) 293 288 CALL tab_2d_1d_2( nbpb, qns_ice_1d(1:nbpb) , qns_ice(:,:,1), jpi, jpj, npb(1:nbpb) ) 294 289 CALL tab_2d_1d_2( nbpb, dqns_ice_1d(1:nbpb) , dqns_ice(:,:,1), jpi, jpj, npb(1:nbpb) ) 295 IF( .NOT. l k_cpl ) THEN290 IF( .NOT. ln_cpl ) THEN 296 291 CALL tab_2d_1d_2( nbpb, qla_ice_1d (1:nbpb) , qla_ice(:,:,1), jpi, jpj, npb(1:nbpb) ) 297 292 CALL tab_2d_1d_2( nbpb, dqla_ice_1d(1:nbpb) , dqla_ice(:,:,1), jpi, jpj, npb(1:nbpb) ) … … 338 333 CALL tab_1d_2d_2( nbpb, qsr_ice(:,:,1), npb, qsr_ice_1d(1:nbpb) , jpi, jpj ) 339 334 CALL tab_1d_2d_2( nbpb, qns_ice(:,:,1), npb, qns_ice_1d(1:nbpb) , jpi, jpj ) 340 IF( ltrcdm2dc_ice )THEN 341 CALL tab_1d_2d_2( nbpb, fstric_daymean , npb, fstbif_daymean_1d (1:nbpb) , jpi, jpj ) 342 CALL tab_1d_2d_2( nbpb, qsr_ice_mean(:,:,1), npb, qsr_ice_mean_1d(1:nbpb) , jpi, jpj ) 343 ENDIF 344 IF( .NOT. lk_cpl ) CALL tab_1d_2d_2( nbpb, qla_ice(:,:,1), npb, qla_ice_1d(1:nbpb) , jpi, jpj ) 335 IF( .NOT. ln_cpl ) CALL tab_1d_2d_2( nbpb, qla_ice(:,:,1), npb, qla_ice_1d(1:nbpb), jpi, jpj ) 345 336 ! 346 337 ENDIF … … 440 431 !-------------------------------------------------------------------------------- 441 432 ztmp(:,:) = 1. - pfrld(:,:) ! fraction of ice after the dynamic, before the thermodynamic 442 CALL iom_put( 'ist_cea', (sist(:,:) - rt0) * ztmp(:,:) ) ! Ice surface temperature [Celius] 443 CALL iom_put( 'qsr_ai_cea', qsr_ice(:,:,1) * ztmp(:,:) ) ! Solar flux over the ice [W/m2] 444 CALL iom_put( 'qns_ai_cea', qns_ice(:,:,1) * ztmp(:,:) ) ! Non-solar flux over the ice [W/m2] 445 IF( .NOT. lk_cpl ) CALL iom_put( 'qla_ai_cea', qla_ice(:,:,1) * ztmp(:,:) ) ! Latent flux over the ice [W/m2] 433 IF( iom_use('ist_cea' ) ) CALL iom_put( 'ist_cea', (sist(:,:) - rt0) * ztmp(:,:) ) ! Ice surface temperature [Celius] 434 IF( iom_use('qsr_ai_cea' ) ) CALL iom_put( 'qsr_ai_cea', qsr_ice(:,:,1) * ztmp(:,:) ) ! Solar flux over the ice [W/m2] 435 IF( iom_use('qns_ai_cea' ) ) CALL iom_put( 'qns_ai_cea', qns_ice(:,:,1) * ztmp(:,:) ) ! Non-solar flux over the ice [W/m2] 436 IF( iom_use('qla_ai_cea' ) .AND. .NOT. ln_cpl ) & 437 & CALL iom_put( 'qla_ai_cea', qla_ice(:,:,1) * ztmp(:,:) ) ! Latent flux over the ice [W/m2] 446 438 ! 447 CALL iom_put( 'snowthic_cea', hsnif (:,:) * fr_i(:,:) ) ! Snow thickness[m]448 CALL iom_put( 'icethic_cea' , hicif (:,:) * fr_i(:,:) ) ! Ice thickness[m]439 IF( iom_use('snowthic_cea')) CALL iom_put( 'snowthic_cea', hsnif (:,:) * fr_i(:,:) ) ! Snow thickness [m] 440 IF( iom_use('icethic_cea' )) CALL iom_put( 'icethic_cea' , hicif (:,:) * fr_i(:,:) ) ! Ice thickness [m] 449 441 zztmp = 1.0 / rdt_ice 450 CALL iom_put( 'iceprod_cea' , hicifp (:,:) * zztmp ) ! Ice produced [m/s] 451 IF( lk_diaar5 ) THEN 452 CALL iom_put( 'snowmel_cea' , rdm_snw(:,:) * zztmp ) ! Snow melt [kg/m2/s] 453 zztmp = rhoic / rdt_ice 454 CALL iom_put( 'sntoice_cea' , zdvonif(:,:) * zztmp ) ! Snow to Ice transformation [kg/m2/s] 455 CALL iom_put( 'ticemel_cea' , zdvosif(:,:) * zztmp ) ! Melt at Sea Ice top [kg/m2/s] 456 CALL iom_put( 'bicemel_cea' , zdvomif(:,:) * zztmp ) ! Melt at Sea Ice bottom [kg/m2/s] 442 IF( iom_use('iceprod_cea') ) CALL iom_put( 'iceprod_cea' , hicifp (:,:) * zztmp ) ! Ice produced [m/s] 443 IF( iom_use('iiceconc' ) ) CALL iom_put( 'iiceconc' , fr_i(:,:) ) ! Ice concentration [-] 444 IF( iom_use('snowmel_cea') ) CALL iom_put( 'snowmel_cea' , rdm_snw(:,:) * zztmp ) ! Snow melt [kg/m2/s] 445 zztmp = rhoic / rdt_ice 446 IF( iom_use('sntoice_cea') ) CALL iom_put( 'sntoice_cea' , zdvonif(:,:) * zztmp ) ! Snow to Ice transformation [kg/m2/s] 447 IF( iom_use('ticemel_cea') ) CALL iom_put( 'ticemel_cea' , zdvosif(:,:) * zztmp ) ! Melt at Sea Ice top [kg/m2/s] 448 IF( iom_use('bicemel_cea') ) CALL iom_put( 'bicemel_cea' , zdvomif(:,:) * zztmp ) ! Melt at Sea Ice bottom [kg/m2/s] 449 IF( iom_use('licepro_cea') ) THEN 457 450 zlicegr(:,:) = MAX( 0.e0, rdm_ice(:,:)-zlicegr(:,:) ) 458 CALL iom_put( 'licepro_cea' , zlicegr(:,:) * zztmp ) ! Lateral sea ice growth[kg/m2/s]451 CALL iom_put( 'licepro_cea' , zlicegr(:,:) * zztmp ) ! Lateral sea ice growth [kg/m2/s] 459 452 ENDIF 460 453 ! 461 454 ! Compute the Eastward & Northward sea-ice transport 462 zztmp = 0.25 * rhoic 463 DO jj = 1, jpjm1 464 DO ji = 1, jpim1 ! NO vector opt. 465 ! Ice velocities, volume & transport at U & V-points 466 zuice_m = u_ice(ji+1,jj+1) + u_ice(ji+1,jj ) 467 zvice_m = v_ice(ji+1,jj+1) + v_ice(ji ,jj+1) 468 zhice_u = hicif(ji,jj)*e2t(ji,jj)*fr_i(ji,jj) + hicif(ji+1,jj )*e2t(ji+1,jj )*fr_i(ji+1,jj ) 469 zhice_v = hicif(ji,jj)*e1t(ji,jj)*fr_i(ji,jj) + hicif(ji ,jj+1)*e1t(ji ,jj+1)*fr_i(ji ,jj+1) 470 zu_imasstr(ji,jj) = zztmp * zhice_u * zuice_m 471 zv_imasstr(ji,jj) = zztmp * zhice_v * zvice_m 472 END DO 473 END DO 474 CALL lbc_lnk( zu_imasstr, 'U', -1. ) ; CALL lbc_lnk( zv_imasstr, 'V', -1. ) 475 CALL iom_put( 'u_imasstr', zu_imasstr(:,:) ) ! Ice transport along i-axis at U-point [kg/s] 476 CALL iom_put( 'v_imasstr', zv_imasstr(:,:) ) ! Ice transport along j-axis at V-point [kg/s] 455 IF( iom_use('u_imasstr') ) THEN 456 zztmp = 0.25 * rhoic 457 DO jj = 1, jpjm1 458 DO ji = 1, jpim1 ! NO vector opt. 459 ! Ice velocities, volume & transport at U-points 460 zuice_m = u_ice(ji+1,jj+1) + u_ice(ji+1,jj ) 461 zhice_u = hicif(ji,jj)*e2t(ji,jj)*fr_i(ji,jj) + hicif(ji+1,jj )*e2t(ji+1,jj )*fr_i(ji+1,jj ) 462 zu_imasstr(ji,jj) = zztmp * zhice_u * zuice_m 463 END DO 464 END DO 465 CALL lbc_lnk( zu_imasstr, 'U', -1. ) 466 CALL iom_put( 'u_imasstr', zu_imasstr(:,:) ) ! Ice transport along i-axis at U-point [kg/s] 467 ENDIF 468 IF( iom_use('v_imasstr') ) THEN 469 zztmp = 0.25 * rhoic 470 DO jj = 1, jpjm1 471 DO ji = 1, jpim1 ! NO vector opt. 472 ! Ice velocities, volume & transport at V-points 473 zvice_m = v_ice(ji+1,jj+1) + v_ice(ji ,jj+1) 474 zhice_v = hicif(ji,jj)*e1t(ji,jj)*fr_i(ji,jj) + hicif(ji ,jj+1)*e1t(ji ,jj+1)*fr_i(ji ,jj+1) 475 zv_imasstr(ji,jj) = zztmp * zhice_v * zvice_m 476 END DO 477 END DO 478 CALL lbc_lnk( zv_imasstr, 'V', -1. ) 479 CALL iom_put( 'v_imasstr', zv_imasstr(:,:) ) ! Ice transport along j-axis at V-point [kg/s] 480 ENDIF 477 481 478 482 !! Fram Strait sea-ice transport (sea-ice + snow) (in ORCA2 = 5 points) 479 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN ! ORCA R2 configuration483 IF( iom_use('fram_trans') .and. cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN ! ORCA R2 configuration 480 484 DO jj = mj0(137), mj1(137) ! B grid 481 485 IF( mj0(jj-1) >= nldj ) THEN … … 491 495 ENDIF 492 496 497 IF( iom_use('ice_pres') .OR. iom_use('ist_ipa') .OR. iom_use('uice_ipa') .OR. iom_use('vice_ipa') ) THEN 493 498 !! ce ztmp(:,:) = 1. - AINT( frld(:,:), wp ) ! return 1 as soon as there is ice 494 499 !! ce A big warning because the model crashes on IDRIS/IBM SP6 with xlf 13.1.0.3, see ticket #761 495 !! ce We Unroll the loop and everything works fine 496 DO jj = 1, jpj 497 DO ji = 1, jpi 498 ztmp(ji,jj) = 1. - AINT( frld(ji,jj), wp ) ! return 1 as soon as there is ice 499 END DO 500 END DO 501 ! 502 CALL iom_put( 'ice_pres' , ztmp ) ! Ice presence [-] 503 CALL iom_put( 'ist_ipa' , ( sist(:,:) - rt0 ) * ztmp(:,:) ) ! Ice surface temperature [Celius] 504 CALL iom_put( 'uice_ipa' , u_ice(:,:) * ztmp(:,:) ) ! Ice velocity along i-axis at I-point [m/s] 505 CALL iom_put( 'vice_ipa' , v_ice(:,:) * ztmp(:,:) ) ! Ice velocity along j-axis at I-point [m/s] 500 !! ce We Unroll the loop and everything works fine 501 DO jj = 1, jpj 502 DO ji = 1, jpi 503 ztmp(ji,jj) = 1. - AINT( frld(ji,jj), wp ) ! return 1 as soon as there is ice 504 END DO 505 END DO 506 ! 507 IF( iom_use('ice_pres') ) CALL iom_put( 'ice_pres', ztmp ) ! Ice presence [-] 508 IF( iom_use('ist_ipa' ) ) CALL iom_put( 'ist_ipa' , ( sist(:,:) - rt0 ) * ztmp(:,:) ) ! Ice surface temperature [Celius] 509 IF( iom_use('uice_ipa') ) CALL iom_put( 'uice_ipa', u_ice(:,:) * ztmp(:,:) ) ! Ice velocity along i-axis at I-point [m/s] 510 IF( iom_use('vice_ipa') ) CALL iom_put( 'vice_ipa', v_ice(:,:) * ztmp(:,:) ) ! Ice velocity along j-axis at I-point [m/s] 511 ENDIF 506 512 507 513 IF(ln_ctl) THEN … … 551 557 IF(lwm) WRITE ( numoni, namicethd ) 552 558 553 IF( l k_cpl .AND. parsub /= 0.0 ) CALL ctl_stop( 'In coupled mode, use parsub = 0. or send dqla' )559 IF( ln_cpl .AND. parsub /= 0.0 ) CALL ctl_stop( 'In coupled mode, use parsub = 0. or send dqla' ) 554 560 ! 555 561 IF(lwp) THEN ! control print
Note: See TracChangeset
for help on using the changeset viewer.