Changeset 1482 for trunk/NEMO/LIM_SRC_2
- Timestamp:
- 2009-07-03T17:28:06+02:00 (15 years ago)
- Location:
- trunk/NEMO/LIM_SRC_2
- Files:
-
- 3 edited
-
limsbc_2.F90 (modified) (6 diffs)
-
limthd_2.F90 (modified) (7 diffs)
-
limwri_2.F90 (modified) (7 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/LIM_SRC_2/limsbc_2.F90
r1479 r1482 25 25 USE lbclnk ! ocean lateral boundary condition 26 26 USE in_out_manager ! I/O manager 27 USE iom ! 27 28 USE albedo ! albedo parameters 28 29 USE prtctl ! Print control … … 92 93 REAL(wp) :: zsang, zmod, zfm 93 94 REAL(wp), DIMENSION(jpi,jpj) :: ztio_u, ztio_v ! ocean stress below sea-ice 95 REAL(wp), DIMENSION(jpi,jpj) :: zqnsoce ! save qns before its modification by ice model 94 96 95 97 !!--------------------------------------------------------------------- … … 121 123 !!gm re-verifies the non solar expression, especially over open ocen 122 124 !!gm 125 zqnsoce(:,:) = qns(:,:) 123 126 DO jj = 1, jpj 124 127 DO ji = 1, jpi … … 185 188 END DO 186 189 END DO 187 190 191 CALL iom_put( 'qns_io_cea', qns(:,:) - zqnsoce(:,:) * pfrld(:,:) ) 192 CALL iom_put( 'qsr_io_cea', fstric(:,:) * (1. - pfrld(:,:)) ) 193 188 194 !------------------------------------------! 189 195 ! mass flux at the ocean surface ! … … 275 281 276 282 !-----------------------------------------------! 277 ! Storing the transmitted variables!283 ! Coupling variables ! 278 284 !-----------------------------------------------! 279 280 fr_i(:,:) = 1.0 - frld(:,:) ! sea-ice fraction281 285 282 286 IF ( lk_cpl ) THEN … … 286 290 CALL albedo_ice( tn_ice, reshape( hicif, (/jpi,jpj,1/) ), reshape( hsnif, (/jpi,jpj,1/) ), zalbp, zalb ) 287 291 alb_ice(:,:,1) = 0.5 * ( zalbp(:,:,1) + zalb (:,:,1) ) ! Ice albedo (mean clear and overcast skys) 292 CALL iom_put( "icealb_cea", alb_ice(:,:,1) * fr_i(:,:) ) ! ice albedo 288 293 ENDIF 289 294 -
trunk/NEMO/LIM_SRC_2/limthd_2.F90
r1465 r1482 20 20 USE lbclnk 21 21 USE in_out_manager ! I/O manager 22 USE iom ! IOM library 22 23 USE ice_2 ! LIM sea-ice variables 23 24 USE sbc_oce ! … … 87 88 REAL(wp) :: zfntlat, zpareff ! test. the val. of lead heat budget 88 89 REAL(wp) :: zfi ! temporary scalar 89 REAL(wp), DIMENSION(jpi,jpj) :: z hicifp ! ice thickness for outputs90 REAL(wp), DIMENSION(jpi,jpj) :: ztmp ! working array 90 91 REAL(wp), DIMENSION(jpi,jpj) :: zqlbsbq ! link with lead energy budget qldif 91 92 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmsk ! working array … … 109 110 rdmsnif(:,:) = 0.e0 ! variation of snow mass per unit area 110 111 rdmicif(:,:) = 0.e0 ! variation of ice mass per unit area 111 hicifp (:,:) = 0.e0 ! daily thermodynamic ice production.112 112 zmsk (:,:,:) = 0.e0 113 113 … … 222 222 fbif (ji,jj) = zindb * ( fsbbq(ji,jj) / MAX( (1.0 - frld(ji,jj)) , epsi20 ) + fdtcn(ji,jj) ) 223 223 224 ! computation of the dailythermodynamic ice production (only needed for output)225 zhicifp(ji,jj) = hicif(ji,jj) * ( 1.0 - frld(ji,jj) )224 ! computation of the thermodynamic ice production (only needed for output) 225 hicifp(ji,jj) = hicif(ji,jj) * ( 1.0 - frld(ji,jj) ) 226 226 END DO 227 227 END DO 228 228 229 229 sst_m(:,:) = sst_m(:,:) - rt0 230 230 231 231 ! Select icy points and fulfill arrays for the vectorial grid. 232 232 !---------------------------------------------------------------------- … … 247 247 CALL prt_ctl(tab2d_1=qcmif, clinfo1=' lim_thd: qcmif : ', tab2d_2=fbif , clinfo2=' fbif : ') 248 248 zmsk(:,:,1) = tms(:,:) 249 CALL prt_ctl(tab2d_1=qcmif , clinfo1=' lim_thd: qcmif: ', mask1=zmsk)250 CALL prt_ctl(tab2d_1= zhicifp, clinfo1=' lim_thd: zhicifp : ')249 CALL prt_ctl(tab2d_1=qcmif , clinfo1=' lim_thd: qcmif : ', mask1=zmsk) 250 CALL prt_ctl(tab2d_1=hicifp, clinfo1=' lim_thd: hicifp : ') 251 251 WRITE(charout, FMT="('lim_thd: nbpb = ',I4)") nbpb 252 252 CALL prt_ctl_info(charout) … … 309 309 CALL tab_1d_2d_2( nbpb, fdvolif , npb, dvlbq_1d (1:nbpb) , jpi, jpj ) 310 310 CALL tab_1d_2d_2( nbpb, rdvonif , npb, dvnbq_1d (1:nbpb) , jpi, jpj ) 311 ! 312 ENDIF 313 314 311 CALL tab_1d_2d_2( nbpb, qsr_ice(:,:,1), npb, qsr_ice_1d(1:nbpb) , jpi, jpj ) 312 CALL tab_1d_2d_2( nbpb, qns_ice(:,:,1), npb, qns_ice_1d(1:nbpb) , jpi, jpj ) 313 IF( .NOT. lk_cpl ) CALL tab_1d_2d_2( nbpb, qla_ice(:,:,1), npb, qla_ice_1d(1:nbpb) , jpi, jpj ) 314 ! 315 ENDIF 316 315 317 ! Up-date sea ice thickness 316 318 !-------------------------- … … 395 397 DO ji = 1, jpi 396 398 frld (ji,jj) = MIN( frld(ji,jj), ABS( frld(ji,jj) - 2.0 ) ) 397 hicifp(ji,jj) = hicif(ji,jj) * ( 1.0 - frld(ji,jj) ) - zhicifp(ji,jj) + hicifp(ji,jj) 398 END DO 399 END DO 399 fr_i (ji,jj) = 1.0 - frld(ji,jj) 400 hicifp(ji,jj) = hicif(ji,jj) * fr_i(ji,jj) - hicifp(ji,jj) 401 END DO 402 END DO 403 404 ! Outputs 405 !-------------------------------------------------------------------------------- 406 ztmp(:,:) = 1. - pfrld(:,:) ! fraction of ice after the dynamic, before the thermodynamic 407 CALL iom_put( 'ioceflxb', fbif ) ! Oceanic flux at the ice base [W/m2 ???] 408 CALL iom_put( 'qsr_ai_cea', qsr_ice(:,:,1) * ztmp(:,:) ) ! Solar flux over the ice [W/m2] 409 CALL iom_put( 'qns_ai_cea', qns_ice(:,:,1) * ztmp(:,:) ) ! Non-solar flux over the ice [W/m2] 410 IF( .NOT. lk_cpl ) CALL iom_put( 'qla_ai_cea', qla_ice(:,:,1) * ztmp(:,:) ) ! Latent flux over the ice [W/m2] 411 ! 412 CALL iom_put( 'snowthic_cea', hsnif (:,:) * fr_i(:,:) ) ! Snow thickness [m] 413 CALL iom_put( 'icethic_cea' , hicif (:,:) * fr_i(:,:) ) ! Ice thickness [m] 414 CALL iom_put( 'iceprod_cea' , hicifp(:,:) / rdt_ice ) ! Ice produced [m/s] 415 ! 416 ztmp(:,:) = 1. - AINT( frld, wp ) ! return 1 as soon as there is ice 417 CALL iom_put( 'ice_pres', ztmp ) ! Ice presence [-] 418 CALL iom_put( 'ist_ipa' , ( sist(:,:) - rt0 ) * ztmp(:,:) ) ! Ice surface temperature [Celius] 419 CALL iom_put( 'uice_ipa', u_ice(:,:) * ztmp(:,:) ) ! Ice velocity along i-axis at I-point 420 CALL iom_put( 'vice_ipa', v_ice(:,:) * ztmp(:,:) ) ! Ice velocity along j-axis at I-point 400 421 401 422 IF(ln_ctl) THEN -
trunk/NEMO/LIM_SRC_2/limwri_2.F90
r1470 r1482 4 4 !! Ice diagnostics : write ice output files 5 5 !!====================================================================== 6 !! history : 2.0 ! 03-08 (C. Ethe) original code 7 !! 2.0 ! 04-10 (C. Ethe ) 1D configuration 6 !! history : 2.0 ! 2003-08 (C. Ethe) original code 7 !! 2.0 ! 2004-10 (C. Ethe ) 1D configuration 8 !! - ! 2009-06 (B. Lemaire ) iom_put + lim_wri_state_2 8 9 !!------------------------------------------------------------------- 9 10 #if defined key_lim2 … … 14 15 !! lim_wri_2 : write of the diagnostics variables in ouput file 15 16 !! lim_wri_init_2 : initialization and namelist read 17 !! lim_wri_state_2 : write for initial state or/and abandon: 18 !! > output.init.nc (if ninist = 1 in namelist) 19 !! > output.abort.nc 16 20 !!---------------------------------------------------------------------- 17 21 USE phycst … … 32 36 PRIVATE 33 37 34 PUBLIC lim_wri_2 ! routine called by sbc_ice_lim_2 38 #if ! defined key_iomput 39 PUBLIC lim_wri_2 ! called by sbc_ice_lim_2 40 #endif 41 PUBLIC lim_wri_state_2 ! called by dia_wri_state 35 42 36 43 INTEGER, PARAMETER :: jpnoumax = 40 ! maximum number of variable for ice output … … 61 68 CONTAINS 62 69 63 #if defined key_dimgout 70 #if ! defined key_iomput 71 # if defined key_dimgout 64 72 !!---------------------------------------------------------------------- 65 73 !! 'key_dimgout' Direct Access file 66 74 !!---------------------------------------------------------------------- 67 75 # include "limwri_dimg_2.h90" 68 #else 69 !!---------------------------------------------------------------------- 70 !! Default option NetCDF file 71 !!---------------------------------------------------------------------- 72 76 # else 73 77 SUBROUTINE lim_wri_2( kt ) 74 78 !!------------------------------------------------------------------- … … 92 96 REAL(wp), DIMENSION(jpi,jpj,jpnoumax) :: zcmo 93 97 !!------------------------------------------------------------------- 94 95 CALL iom_setkt( kt + nn_fsbc - 1 ) 96 ! !--------------------! 98 !--------------------! 97 99 IF( kt == nit000 ) THEN ! Initialisation ! 98 100 ! !--------------------! … … 180 182 181 183 IF( nc(jf) == 1 ) CALL histwrite( nice, nam(jf), niter, zfield, ndim, ndex51 ) 182 CALL iom_put( nam(jf), zfield )183 184 184 185 END DO 185 186 186 187 IF( ( nn_fsbc * niter ) >= nitend ) CALL histclo( nice ) 187 !188 CALL iom_setkt( kt )189 188 190 189 END SUBROUTINE lim_wri_2 191 192 #endif 193 190 191 194 192 SUBROUTINE lim_wri_init_2 195 193 !!------------------------------------------------------------------- … … 273 271 END SUBROUTINE lim_wri_init_2 274 272 273 # endif 274 #endif 275 276 SUBROUTINE lim_wri_state_2( kt, kid, kh_i ) 277 !!--------------------------------------------------------------------- 278 !! *** ROUTINE lim_wri_state_2 *** 279 !! 280 !! ** Purpose : create a NetCDF file named cdfile_name which contains 281 !! the instantaneous ice state and forcing fields for ice model 282 !! Used to find errors in the initial state or save the last 283 !! ocean state in case of abnormal end of a simulation 284 !! 285 !! History : 286 !! 2.0 ! 2009-06 (B. Lemaire) 287 !!---------------------------------------------------------------------- 288 INTEGER, INTENT( in ) :: kt ! ocean time-step index) 289 INTEGER, INTENT( in ) :: kid , kh_i 290 !!---------------------------------------------------------------------- 291 292 CALL histdef( kid, "isnowthi", "Snow thickness" , "m" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 293 CALL histdef( kid, "iicethic", "Ice thickness" , "m" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 294 CALL histdef( kid, "iiceprod", "Ice produced" , "m/kt" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 295 CALL histdef( kid, "ileadfra", "Ice concentration" , "-" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 296 CALL histdef( kid, "iicetemp", "Ice temperature" , "K" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 297 CALL histdef( kid, "ioceflxb", "flux at ice base" , "w/m2" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 298 CALL histdef( kid, "iicevelu", "i-Ice speed (I-point)" , "m/s" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 299 CALL histdef( kid, "iicevelv", "j-Ice speed (I-point)" , "m/s" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 300 CALL histdef( kid, "isstempe", "Sea surface temperature" , "C" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 301 CALL histdef( kid, "isssalin", "Sea surface salinity" , "PSU" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 302 CALL histdef( kid, "iicestru", "i-Wind stress over ice (I-pt)", "Pa", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 303 CALL histdef( kid, "iicestrv", "j-Wind stress over ice (I-pt)", "Pa", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 304 CALL histdef( kid, "iicesflx", "Solar flux over ice" , "w/m2" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 305 CALL histdef( kid, "iicenflx", "Non-solar flux over ice" , "w/m2" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 306 CALL histdef( kid, "isnowpre", "Snow precipitation" , "kg/m2/s", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 307 308 CALL histend( kid ) ! end of the file definition 309 310 CALL histwrite( kid, "isnowthi", kt, hsnif , jpi*jpj, (/1/) ) 311 CALL histwrite( kid, "iicethic", kt, hicif , jpi*jpj, (/1/) ) 312 CALL histwrite( kid, "iiceprod", kt, hicifp , jpi*jpj, (/1/) ) 313 CALL histwrite( kid, "ileadfra", kt, 1. - frld(:,:) , jpi*jpj, (/1/) ) 314 CALL histwrite( kid, "iicetemp", kt, sist(:,:) - rt0, jpi*jpj, (/1/) ) 315 CALL histwrite( kid, "ioceflxb", kt, fbif , jpi*jpj, (/1/) ) 316 CALL histwrite( kid, "iicevelv", kt, u_ice , jpi*jpj, (/1/) ) 317 CALL histwrite( kid, "iicevelu", kt, v_ice , jpi*jpj, (/1/) ) 318 CALL histwrite( kid, "isstempe", kt, sst_m , jpi*jpj, (/1/) ) 319 CALL histwrite( kid, "isssalin", kt, sss_m , jpi*jpj, (/1/) ) 320 CALL histwrite( kid, "iicestru", kt, utau_ice , jpi*jpj, (/1/) ) 321 CALL histwrite( kid, "iicestrv", kt, vtau_ice , jpi*jpj, (/1/) ) 322 CALL histwrite( kid, "iicesflx", kt, qsr_ice(:,:,1) , jpi*jpj, (/1/) ) 323 CALL histwrite( kid, "iicenflx", kt, qns_ice(:,:,1) , jpi*jpj, (/1/) ) 324 CALL histwrite( kid, "isnowpre", kt, sprecip , jpi*jpj, (/1/) ) 325 326 END SUBROUTINE lim_wri_state_2 327 275 328 #else 276 329 !!----------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.
