Changeset 1756 for trunk/NEMO/LIM_SRC_2/limthd_2.F90
- Timestamp:
- 2009-11-25T15:15:20+01:00 (15 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/LIM_SRC_2/limthd_2.F90 (modified) (9 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/LIM_SRC_2/limthd_2.F90
r1755 r1756 20 20 USE lbclnk 21 21 USE in_out_manager ! I/O manager 22 USE lib_mpp 22 23 USE iom ! IOM library 23 24 USE ice_2 ! LIM sea-ice variables … … 31 32 USE prtctl ! Print control 32 33 USE cpl_oasis3, ONLY : lk_cpl 34 USE diaar5, ONLY : lk_diaar5 33 35 34 36 IMPLICIT NONE … … 90 92 REAL(wp), DIMENSION(jpi,jpj) :: ztmp ! 2D workspace 91 93 REAL(wp), DIMENSION(jpi,jpj) :: zqlbsbq ! link with lead energy budget qldif 94 REAL(wp) :: zuice_m, zvice_m ! Sea-ice velocities at U & V-points 95 REAL(wp) :: zhice_u, zhice_v ! Sea-ice volume at U & V-points 96 REAL(wp) :: ztr_fram ! Sea-ice transport through Fram strait 97 REAL(wp) :: zrhoij, zrhoijm1 ! temporary scalars 98 REAL(wp) :: zztmp ! temporary scalars within a loop 99 REAL(wp), DIMENSION(jpi,jpj) :: zlicegr ! link with lateral ice growth 92 100 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmsk ! 3D workspace 101 !!$ REAL(wp), DIMENSION(jpi,jpj) :: firic !: IR flux over the ice (outputs only) 102 !!$ REAL(wp), DIMENSION(jpi,jpj) :: fcsic !: Sensible heat flux over the ice (outputs only) 103 !!$ REAL(wp), DIMENSION(jpi,jpj) :: fleic !: Latent heat flux over the ice (outputs only) 104 !!$ REAL(wp), DIMENSION(jpi,jpj) :: qlatic !: latent flux (outputs only) 105 REAL(wp), DIMENSION(jpi,jpj) :: zdvosif !: Variation of volume at surface (outputs only) 106 REAL(wp), DIMENSION(jpi,jpj) :: zdvobif !: Variation of ice volume at the bottom ice (outputs only) 107 REAL(wp), DIMENSION(jpi,jpj) :: zdvolif !: Total variation of ice volume (outputs only) 108 REAL(wp), DIMENSION(jpi,jpj) :: zdvonif !: Surface accretion Snow to Ice transformation (outputs only) 109 REAL(wp), DIMENSION(jpi,jpj) :: zdvomif !: Bottom variation of ice volume due to melting (outputs only) 110 REAL(wp), DIMENSION(jpi,jpj) :: zu_imasstr !: Sea-ice transport along i-axis at U-point (outputs only) 111 REAL(wp), DIMENSION(jpi,jpj) :: zv_imasstr !: Sea-ice transport along j-axis at V-point (outputs only) 93 112 !!------------------------------------------------------------------- 94 113 … … 100 119 101 120 !!gm needed? yes at least for some of these arrays 102 rdvosif(:,:) = 0.e0 ! variation of ice volume at surface 103 rdvobif(:,:) = 0.e0 ! variation of ice volume at bottom 104 fdvolif(:,:) = 0.e0 ! total variation of ice volume 105 rdvonif(:,:) = 0.e0 ! lateral variation of ice volume 121 zdvosif(:,:) = 0.e0 ! variation of ice volume at surface 122 zdvobif(:,:) = 0.e0 ! variation of ice volume at bottom 123 zdvolif(:,:) = 0.e0 ! total variation of ice volume 124 zdvonif(:,:) = 0.e0 ! transformation of snow to sea-ice volume 125 ! zdvonif(:,:) = 0.e0 ! lateral variation of ice volume 126 zlicegr(:,:) = 0.e0 ! lateral variation of ice volume 127 zdvomif(:,:) = 0.e0 ! variation of ice volume at bottom due to melting only 128 ztr_fram = 0.e0 ! sea-ice transport through Fram strait 106 129 fstric (:,:) = 0.e0 ! part of solar radiation absorbing inside the ice 107 130 fscmbq (:,:) = 0.e0 ! linked with fstric … … 306 329 CALL tab_1d_2d_2( nbpb, dmgwi , npb, dmgwi_1d (1:nbpb) , jpi, jpj ) 307 330 CALL tab_1d_2d_2( nbpb, rdmsnif , npb, rdmsnif_1d(1:nbpb) , jpi, jpj ) 308 CALL tab_1d_2d_2( nbpb, rdvosif , npb, dvsbq_1d (1:nbpb) , jpi, jpj ) 309 CALL tab_1d_2d_2( nbpb, rdvobif , npb, dvbbq_1d (1:nbpb) , jpi, jpj ) 310 CALL tab_1d_2d_2( nbpb, fdvolif , npb, dvlbq_1d (1:nbpb) , jpi, jpj ) 311 CALL tab_1d_2d_2( nbpb, rdvonif , npb, dvnbq_1d (1:nbpb) , jpi, jpj ) 331 CALL tab_1d_2d_2( nbpb, zdvosif , npb, dvsbq_1d (1:nbpb) , jpi, jpj ) 332 CALL tab_1d_2d_2( nbpb, zdvobif , npb, dvbbq_1d (1:nbpb) , jpi, jpj ) 333 CALL tab_1d_2d_2( nbpb, zdvomif , npb, rdvomif_1d(1:nbpb) , jpi, jpj ) 334 CALL tab_1d_2d_2( nbpb, zdvolif , npb, dvlbq_1d (1:nbpb) , jpi, jpj ) 335 CALL tab_1d_2d_2( nbpb, zdvonif , npb, dvnbq_1d (1:nbpb) , jpi, jpj ) 312 336 CALL tab_1d_2d_2( nbpb, qsr_ice(:,:,1), npb, qsr_ice_1d(1:nbpb) , jpi, jpj ) 313 337 CALL tab_1d_2d_2( nbpb, qns_ice(:,:,1), npb, qns_ice_1d(1:nbpb) , jpi, jpj ) … … 362 386 IF( nbpac > 0 ) THEN 363 387 ! 388 zlicegr(:,:) = rdmicif(:,:) ! to output the lateral sea-ice growth 364 389 !...Put the variable in a 1-D array for lateral accretion 365 390 CALL tab_2d_1d_2( nbpac, frld_1d (1:nbpac) , frld , jpi, jpj, npac(1:nbpac) ) … … 373 398 CALL tab_2d_1d_2( nbpac, qstbif_1d (1:nbpac) , qstoif , jpi, jpj, npac(1:nbpac) ) 374 399 CALL tab_2d_1d_2( nbpac, rdmicif_1d(1:nbpac) , rdmicif , jpi, jpj, npac(1:nbpac) ) 375 CALL tab_2d_1d_2( nbpac, dvlbq_1d (1:nbpac) , fdvolif , jpi, jpj, npac(1:nbpac) )400 CALL tab_2d_1d_2( nbpac, dvlbq_1d (1:nbpac) , zdvolif , jpi, jpj, npac(1:nbpac) ) 376 401 CALL tab_2d_1d_2( nbpac, tfu_1d (1:nbpac) , tfu , jpi, jpj, npac(1:nbpac) ) 377 402 ! … … 387 412 CALL tab_1d_2d_2( nbpac, qstoif , npac(1:nbpac), qstbif_1d (1:nbpac) , jpi, jpj ) 388 413 CALL tab_1d_2d_2( nbpac, rdmicif , npac(1:nbpac), rdmicif_1d(1:nbpac) , jpi, jpj ) 389 CALL tab_1d_2d_2( nbpac, fdvolif , npac(1:nbpac), dvlbq_1d (1:nbpac) , jpi, jpj )414 CALL tab_1d_2d_2( nbpac, zdvolif , npac(1:nbpac), dvlbq_1d (1:nbpac) , jpi, jpj ) 390 415 ! 391 416 ENDIF … … 405 430 ! Outputs 406 431 !-------------------------------------------------------------------------------- 407 ztmp(:,:) = 1. - pfrld(:,:) ! fraction of ice after the dynamic, before the thermodynamic 408 CALL iom_put( 'ioceflxb', fbif ) ! Oceanic flux at the ice base [W/m2 ???] 409 CALL iom_put( 'qsr_ai_cea', qsr_ice(:,:,1) * ztmp(:,:) ) ! Solar flux over the ice [W/m2] 410 CALL iom_put( 'qns_ai_cea', qns_ice(:,:,1) * ztmp(:,:) ) ! Non-solar flux over the ice [W/m2] 432 ztmp(:,:) = 1. - pfrld(:,:) ! fraction of ice after the dynamic, before the thermodynamic 433 CALL iom_put( 'ioceflxb', fbif ) ! Oceanic flux at the ice base [W/m2 ???] 434 CALL iom_put( 'ist_cea', (sist(:,:) - rt0) * ztmp(:,:) ) ! Ice surface temperature [Celius] 435 CALL iom_put( 'qsr_ai_cea', qsr_ice(:,:,1) * ztmp(:,:) ) ! Solar flux over the ice [W/m2] 436 CALL iom_put( 'qns_ai_cea', qns_ice(:,:,1) * ztmp(:,:) ) ! Non-solar flux over the ice [W/m2] 411 437 IF( .NOT. lk_cpl ) CALL iom_put( 'qla_ai_cea', qla_ice(:,:,1) * ztmp(:,:) ) ! Latent flux over the ice [W/m2] 412 438 ! 413 CALL iom_put( 'snowthic_cea', hsnif (:,:) * fr_i(:,:) ) ! Snow thickness [m] 414 CALL iom_put( 'icethic_cea' , hicif (:,:) * fr_i(:,:) ) ! Ice thickness [m] 415 CALL iom_put( 'iceprod_cea' , hicifp(:,:) / rdt_ice ) ! Ice produced [m/s] 439 CALL iom_put( 'snowthic_cea', hsnif (:,:) * fr_i(:,:) ) ! Snow thickness [m] 440 CALL iom_put( 'icethic_cea' , hicif (:,:) * fr_i(:,:) ) ! Ice thickness [m] 441 zztmp = 1.0 / rdt_ice 442 CALL iom_put( 'iceprod_cea' , hicifp (:,:) * zztmp ) ! Ice produced [m/s] 443 IF( lk_diaar5 ) THEN 444 CALL iom_put( 'snowmel_cea' , rdmsnif(:,:) * zztmp ) ! Snow melt [kg/m2/s] 445 zztmp = rhoic / rdt_ice 446 CALL iom_put( 'sntoice_cea' , zdvonif(:,:) * zztmp ) ! Snow to Ice transformation [kg/m2/s] 447 CALL iom_put( 'ticemel_cea' , zdvosif(:,:) * zztmp ) ! Melt at Sea Ice top [kg/m2/s] 448 CALL iom_put( 'bicemel_cea' , zdvomif(:,:) * zztmp ) ! Melt at Sea Ice bottom [kg/m2/s] 449 zlicegr(:,:) = MAX( 0.e0, rdmicif(:,:)-zlicegr(:,:) ) 450 CALL iom_put( 'licepro_cea' , zlicegr(:,:) * zztmp ) ! Latereal sea ice growth [kg/m2/s] 451 ENDIF 416 452 ! 417 ztmp(:,:) = 1. - AINT( frld, wp ) ! return 1 as soon as there is ice 418 CALL iom_put( 'ice_pres', ztmp ) ! Ice presence [-] 419 CALL iom_put( 'ist_ipa' , ( sist(:,:) - rt0 ) * ztmp(:,:) ) ! Ice surface temperature [Celius] 420 CALL iom_put( 'uice_ipa', u_ice(:,:) * ztmp(:,:) ) ! Ice velocity along i-axis at I-point 421 CALL iom_put( 'vice_ipa', v_ice(:,:) * ztmp(:,:) ) ! Ice velocity along j-axis at I-point 453 ! Compute the Eastward & Northward sea-ice transport 454 zztmp = 0.25 * rhoic 455 DO jj = 1, jpjm1 456 DO ji = 1, jpim1 ! NO vector opt. 457 ! Ice velocities, volume & transport at U & V-points 458 zuice_m = u_ice(ji+1,jj+1) + u_ice(ji+1,jj ) 459 zvice_m = v_ice(ji+1,jj+1) + v_ice(ji ,jj+1) 460 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 ) 461 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) 462 zu_imasstr(ji,jj) = zztmp * zhice_u * zuice_m 463 zv_imasstr(ji,jj) = zztmp * zhice_v * zvice_m 464 END DO 465 END DO 466 CALL lbc_lnk( zu_imasstr, 'U', -1. ) ; CALL lbc_lnk( zv_imasstr, 'V', -1. ) 467 CALL iom_put( 'u_imasstr', zu_imasstr(:,:) ) ! Ice transport along i-axis at U-point [kg/s] 468 CALL iom_put( 'v_imasstr', zv_imasstr(:,:) ) ! Ice transport along j-axis at V-point [kg/s] 469 470 !! Fram Strait sea-ice transport (sea-ice + snow) (in ORCA2 = 5 points) 471 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN ! ORCA R2 configuration 472 DO jj = mj0(137), mj1(137) ! B grid 473 IF( mj0(jj-1) >= nldj ) THEN 474 DO ji = MAX(mi0(134),nldi), MIN(mi1(138),nlei) 475 zrhoij = e1t(ji,jj ) * fr_i(ji,jj ) * ( rhoic*hicif(ji,jj ) + rhosn*hsnif(ji,jj ) ) 476 zrhoijm1 = e1t(ji,jj-1) * fr_i(ji,jj-1) * ( rhoic*hicif(ji,jj-1) + rhosn*hsnif(ji,jj-1) ) 477 ztr_fram = ztr_fram - 0.25 * ( v_ice(ji,jj)+ v_ice(ji+1,jj) ) * ( zrhoij + zrhoijm1 ) 478 END DO 479 ENDIF 480 END DO 481 IF( lk_mpp ) CALL mpp_sum( ztr_fram ) 482 CALL iom_put( 'fram_trans', ztr_fram ) ! Ice transport through Fram strait [kg/s] 483 ENDIF 484 485 ztmp(:,:) = 1. - AINT( frld(:,:), wp ) ! return 1 as soon as there is ice 486 CALL iom_put( 'ice_pres' , ztmp ) ! Ice presence [-] 487 CALL iom_put( 'ist_ipa' , ( sist(:,:) - rt0 ) * ztmp(:,:) ) ! Ice surface temperature [Celius] 488 CALL iom_put( 'uice_ipa' , u_ice(:,:) * ztmp(:,:) ) ! Ice velocity along i-axis at I-point [m/s] 489 CALL iom_put( 'vice_ipa' , v_ice(:,:) * ztmp(:,:) ) ! Ice velocity along j-axis at I-point [m/s] 422 490 423 491 IF(ln_ctl) THEN
Note: See TracChangeset
for help on using the changeset viewer.
