Changeset 2715 for trunk/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90
- Timestamp:
- 2011-03-30T17:58:35+02:00 (13 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90 (modified) (17 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90
r2528 r2715 15 15 USE phycst 16 16 USE dom_oce 17 USE in_out_manager18 17 USE sbc_oce ! Surface boundary condition: ocean fields 19 18 USE sbc_ice ! Surface boundary condition: ice fields 20 19 USE dom_ice 21 20 USE ice 21 USE limvar 22 USE in_out_manager 22 23 USE lbclnk 24 USE lib_mpp ! MPP library 23 25 USE par_ice 24 USE limvar25 26 26 27 IMPLICIT NONE 27 28 PRIVATE 28 29 29 !! * Accessibility30 30 PUBLIC lim_wri ! routine called by lim_step.F90 31 31 32 !! * Module variables 33 INTEGER, PARAMETER :: & !: 34 jpnoumax = 40 !: maximum number of variable for ice output 35 INTEGER :: & 36 noumef , & ! number of fields 37 noumefa , & ! number of additional fields 38 add_diag_swi , & ! additional diagnostics 39 nz ! dimension for the itd field 40 41 REAL(wp) , DIMENSION(jpnoumax) :: & 42 cmulti , & ! multiplicative constant 43 cadd , & ! additive constant 44 cmultia , & ! multiplicative constant 45 cadda ! additive constant 46 CHARACTER(len = 35), DIMENSION(jpnoumax) :: & 47 titn, titna ! title of the field 48 CHARACTER(len = 8 ), DIMENSION(jpnoumax) :: & 49 nam, nama ! name of the field 50 CHARACTER(len = 8 ), DIMENSION(jpnoumax) :: & 51 uni, unia ! unit of the field 52 INTEGER , DIMENSION(jpnoumax) :: & 53 nc, nca ! switch for saving field ( = 1 ) or not ( = 0 ) 54 55 REAL(wp) :: & ! constant values 56 epsi16 = 1e-16 , & 57 zzero = 0.e0 , & 58 zone = 1.e0 32 INTEGER, PARAMETER :: jpnoumax = 40 !: maximum number of variable for ice output 33 34 INTEGER :: noumef ! number of fields 35 INTEGER :: noumefa ! number of additional fields 36 INTEGER :: add_diag_swi ! additional diagnostics 37 INTEGER :: nz ! dimension for the itd field 38 39 REAL(wp) , DIMENSION(jpnoumax) :: cmulti ! multiplicative constant 40 REAL(wp) , DIMENSION(jpnoumax) :: cadd ! additive constant 41 REAL(wp) , DIMENSION(jpnoumax) :: cmultia ! multiplicative constant 42 REAL(wp) , DIMENSION(jpnoumax) :: cadda ! additive constant 43 CHARACTER(len = 35), DIMENSION(jpnoumax) :: titn, titna ! title of the field 44 CHARACTER(len = 8 ), DIMENSION(jpnoumax) :: nam , nama ! name of the field 45 CHARACTER(len = 8 ), DIMENSION(jpnoumax) :: uni , unia ! unit of the field 46 INTEGER , DIMENSION(jpnoumax) :: nc , nca ! switch for saving field ( = 1 ) or not ( = 0 ) 47 48 REAL(wp) :: epsi16 = 1e-16_wp 49 REAL(wp) :: zzero = 0._wp 50 REAL(wp) :: zone = 1._wp 59 51 60 52 !!---------------------------------------------------------------------- 61 !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)53 !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 62 54 !! $Id$ 63 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)55 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 64 56 !!---------------------------------------------------------------------- 65 57 CONTAINS … … 79 71 !! modif : 03/06/98 80 72 !!------------------------------------------------------------------- 81 INTEGER, INTENT(in) :: & 82 kindic ! if kindic < 0 there has been an error somewhere 83 84 !! * Local variables 73 USE wrk_nemo, ONLY: wrk_not_released, wrk_in_use 74 USE wrk_nemo, ONLY: zfield => wrk_2d_1 ! 2D workspace 75 USE wrk_nemo, ONLY: wrk_3d_1, wrk_3D_2, wrk_3d_3 ! 3D workspace 76 ! 77 INTEGER, INTENT(in) :: kindic ! if kindic < 0 there has been an error somewhere 78 ! 79 INTEGER :: ji, jj, jk, jl, jf, ipl ! dummy loop indices 80 INTEGER :: ierr 85 81 REAL(wp),DIMENSION(1) :: zdept 86 87 REAL(wp) :: & 88 zsto, zjulian,zout, & 89 zindh,zinda,zindb 90 REAL(wp), DIMENSION(jpi,jpj,jpnoumax) :: & 91 zcmo, & 92 zcmoa ! additional fields 93 94 REAL(wp), DIMENSION(jpi,jpj) :: & 95 zfield 96 97 REAL(wp), DIMENSION(jpi,jpj,jpl) :: & 98 zmaskitd, zoi, zei 99 100 INTEGER :: ji, jj, jk, jl, jf, ipl ! dummy loop indices 101 102 CHARACTER(len = 40) :: & 103 clhstnam, clop, & 104 clhstnama 105 106 INTEGER , SAVE :: & 107 nice, nhorid, ndim, niter, ndepid 108 INTEGER , SAVE :: & 109 nicea, nhorida, ndimitd 110 INTEGER , DIMENSION( jpij ) , SAVE :: & 111 ndex51 112 INTEGER , DIMENSION( jpij*jpl ) , SAVE :: & 113 ndexitd 82 REAL(wp) :: zsto, zjulian, zout, zindh, zinda, zindb 83 REAL(wp), POINTER, DIMENSION(:,:,:) :: zcmo, zcmoa ! additional fields 84 REAL(wp), POINTER, DIMENSION(:,:,:) :: zmaskitd, zoi, zei 85 86 CHARACTER(len = 40) :: clhstnam, clop, clhstnama 87 88 INTEGER , SAVE :: nice, nhorid, ndim, niter, ndepid 89 INTEGER , SAVE :: nicea, nhorida, ndimitd 90 INTEGER , ALLOCATABLE, DIMENSION(:), SAVE :: ndex51 91 INTEGER , ALLOCATABLE, DIMENSION(:), SAVE :: ndexitd 114 92 !!------------------------------------------------------------------- 115 93 116 94 ipl = jpl 117 95 118 IF ( numit == nstart ) THEN 96 zcmo => wrk_3d_1(:,:,1:jpnoumax) 97 zcmoa => wrk_3d_2(:,:,1:jpnoumax) 98 zmaskitd => wrk_3d_2(:,:,1:jpl) 99 zoi => wrk_3d_2(:,:,1:jpl) 100 zei => wrk_3d_2(:,:,1:jpl) 101 102 103 IF( numit == nstart ) THEN 104 105 ALLOCATE( ndex51(jpij) , ndexitd(jpij*jpl) , STAT=ierr ) 106 IF( ierr /= 0 ) THEN 107 CALL ctl_stop( 'lim_wri : unable to allocate standard arrays' ) ; RETURN 108 ENDIF 119 109 120 110 CALL lim_wri_init … … 209 199 210 200 !-- calculs des valeurs instantanees 211 zcmo ( 1:jpi, 1:jpj, 1:jpnoumax ) = 0.0212 zcmoa( 1:jpi, 1:jpj, 1:jpnoumax ) = 0. 0201 zcmo ( 1:jpi, 1:jpj, 1:jpnoumax ) = 0._wp 202 zcmoa( 1:jpi, 1:jpj, 1:jpnoumax ) = 0._wp 213 203 214 204 DO jl = 1, jpl … … 233 223 234 224 zcmo(ji,jj,1) = at_i(ji,jj) 235 zcmo(ji,jj,2) = vt_i(ji,jj)/MAX(at_i(ji,jj),epsi16)*zinda 236 zcmo(ji,jj,3) = vt_s(ji,jj)/MAX(at_i(ji,jj),epsi16)*zinda 237 zcmo(ji,jj,4) = diag_bot_gr(ji,jj) * & 238 86400.0 * zinda !Bottom thermodynamic ice production 239 zcmo(ji,jj,5) = diag_dyn_gr(ji,jj) * & 240 86400.0 * zinda !Dynamic ice production (rid/raft) 241 zcmo(ji,jj,22) = diag_lat_gr(ji,jj) * & 242 86400.0 * zinda !Lateral thermodynamic ice production 243 zcmo(ji,jj,23) = diag_sni_gr(ji,jj) * & 244 86400.0 * zinda !Snow ice production ice production 225 zcmo(ji,jj,2) = vt_i(ji,jj) / MAX( at_i(ji,jj), epsi16 ) * zinda 226 zcmo(ji,jj,3) = vt_s(ji,jj) / MAX( at_i(ji,jj), epsi16 ) * zinda 227 zcmo(ji,jj,4) = diag_bot_gr(ji,jj) * 86400.0 * zinda ! Bottom thermodynamic ice production 228 zcmo(ji,jj,5) = diag_dyn_gr(ji,jj) * 86400.0 * zinda ! Dynamic ice production (rid/raft) 229 zcmo(ji,jj,22) = diag_lat_gr(ji,jj) * 86400.0 * zinda ! Lateral thermodynamic ice production 230 zcmo(ji,jj,23) = diag_sni_gr(ji,jj) * 86400.0 * zinda ! Snow ice production ice production 245 231 zcmo(ji,jj,24) = tm_i(ji,jj) - rtt 246 232 247 233 zcmo(ji,jj,6) = fbif (ji,jj) 248 zcmo(ji,jj,7) = zindb * ( u_ice(ji,jj ) * tmu(ji,jj) & 249 & + u_ice(ji-1,jj) * tmu(ji-1,jj) ) & 250 & / 2.0 251 zcmo(ji,jj,8) = zindb * ( v_ice(ji,jj ) * tmv(ji,jj) & 252 & + v_ice(ji,jj-1) * tmv(ji,jj-1) ) & 253 & / 2.0 234 zcmo(ji,jj,7) = zindb * ( u_ice(ji,jj) * tmu(ji,jj) + u_ice(ji-1,jj) * tmu(ji-1,jj) ) * 0.5_wp 235 zcmo(ji,jj,8) = zindb * ( v_ice(ji,jj) * tmv(ji,jj) + v_ice(ji,jj-1) * tmv(ji,jj-1) ) * 0.5_wp 254 236 zcmo(ji,jj,9) = sst_m(ji,jj) 255 237 zcmo(ji,jj,10) = sss_m(ji,jj) … … 261 243 zcmo(ji,jj,15) = utau_ice(ji,jj) 262 244 zcmo(ji,jj,16) = vtau_ice(ji,jj) 263 zcmo(ji,jj,17) = zcmo(ji,jj,17) + ( 1.0-at_i(ji,jj))*qsr(ji,jj)264 zcmo(ji,jj,18) = zcmo(ji,jj,18) + ( 1.0-at_i(ji,jj))*qns(ji,jj)245 zcmo(ji,jj,17) = zcmo(ji,jj,17) + ( 1._wp - at_i(ji,jj) ) * qsr(ji,jj) 246 zcmo(ji,jj,18) = zcmo(ji,jj,18) + ( 1._wp - at_i(ji,jj) ) * qns(ji,jj) 265 247 zcmo(ji,jj,19) = sprecip(ji,jj) 266 248 zcmo(ji,jj,20) = smt_i(ji,jj) … … 274 256 zcmo(ji,jj,31) = hicol(ji,jj) 275 257 zcmo(ji,jj,32) = strength(ji,jj) 276 zcmo(ji,jj,33) = SQRT( zcmo(ji,jj,7)*zcmo(ji,jj,7) + & 277 zcmo(ji,jj,8)*zcmo(ji,jj,8) ) 278 zcmo(ji,jj,34) = diag_sur_me(ji,jj) * & 279 86400.0 * zinda ! Surface melt 280 zcmo(ji,jj,35) = diag_bot_me(ji,jj) * & 281 86400.0 * zinda ! Bottom melt 258 zcmo(ji,jj,33) = SQRT( zcmo(ji,jj,7)*zcmo(ji,jj,7) + zcmo(ji,jj,8)*zcmo(ji,jj,8) ) 259 zcmo(ji,jj,34) = diag_sur_me(ji,jj) * 86400.0 * zinda ! Surface melt 260 zcmo(ji,jj,35) = diag_bot_me(ji,jj) * 86400.0 * zinda ! Bottom melt 282 261 zcmo(ji,jj,36) = divu_i(ji,jj) 283 262 zcmo(ji,jj,37) = shear_i(ji,jj) … … 290 269 niter = niter + 1 291 270 DO jf = 1 , noumef 292 DO jj = 1 , jpj 293 DO ji = 1 , jpi 294 zfield(ji,jj) = zcmo(ji,jj,jf) * cmulti(jf) + cadd(jf) 295 END DO 296 END DO 297 298 IF ( jf == 7 .OR. jf == 8 .OR. jf == 15 .OR. jf == 16 ) THEN 299 CALL lbc_lnk( zfield, 'T', -1. ) 300 ELSE 301 CALL lbc_lnk( zfield, 'T', 1. ) 271 ! 272 zfield(:,:) = zcmo(:,:,jf) * cmulti(jf) + cadd(jf) 273 ! 274 IF( jf == 7 .OR. jf == 8 .OR. jf == 15 .OR. jf == 16 ) THEN ; CALL lbc_lnk( zfield, 'T', -1. ) 275 ELSE ; CALL lbc_lnk( zfield, 'T', 1. ) 302 276 ENDIF 303 277 ! 304 278 IF( ln_nicep ) THEN 305 279 WRITE(numout,*) … … 307 281 WRITE(numout,*) nc(jf), nice, nam(jf), niter, ndim 308 282 ENDIF 309 IF 310 283 IF( nc(jf) == 1 ) CALL histwrite( nice, nam(jf), niter, zfield, ndim, ndex51 ) 284 ! 311 285 END DO 312 286 313 IF 287 IF( ( nn_fsbc * niter ) >= nitend .OR. kindic < 0 ) THEN 314 288 IF( lwp) WRITE(numout,*) ' Closing the icemod file ' 315 289 CALL histclo( nice ) … … 319 293 ! Thickness distribution file 320 294 !----------------------------- 321 IF ( add_diag_swi .EQ.1 ) THEN295 IF( add_diag_swi == 1 ) THEN 322 296 323 297 DO jl = 1, jpl … … 334 308 DO ji = 1, jpi 335 309 zinda = MAX( zzero , SIGN( zone , a_i(ji,jj,jl) - 1.0e-6 ) ) 336 zoi(ji,jj,jl) = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , 1.0e-6 ) * & 337 zinda 310 zoi(ji,jj,jl) = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , 1.0e-6 ) * zinda 338 311 END DO 339 312 END DO … … 341 314 342 315 ! Compute brine volume 343 zei(:,:,:) = 0. 0316 zei(:,:,:) = 0._wp 344 317 DO jl = 1, jpl 345 318 DO jk = 1, nlay_i … … 370 343 ! not yet implemented 371 344 372 IF 345 IF( ( nn_fsbc * niter ) >= nitend .OR. kindic < 0 ) THEN 373 346 IF(lwp) WRITE(numout,*) ' Closing the icemod file ' 374 347 CALL histclo( nicea ) 375 348 ENDIF 376 349 ! 377 350 ENDIF 378 351 … … 390 363 !! 391 364 !! ** input : Namelist namicewri 392 !! 393 !! history : 394 !! 8.5 ! 03-08 (C. Ethe) original code 395 !!------------------------------------------------------------------- 396 !! * Local declarations 365 !!------------------------------------------------------------------- 397 366 INTEGER :: nf ! ??? 398 367 … … 416 385 417 386 TYPE(FIELD) , DIMENSION(jpnoumax) :: zfield 418 387 ! 419 388 NAMELIST/namiceout/ noumef, & 420 389 field_1 , field_2 , field_3 , field_4 , field_5 , field_6 , & … … 427 396 !!------------------------------------------------------------------- 428 397 429 ! Read Namelist namicewri 430 REWIND ( numnam_ice ) 431 READ ( numnam_ice , namiceout ) 398 REWIND( numnam_ice ) ! Read Namelist namicewri 399 READ ( numnam_ice , namiceout ) 432 400 433 401 zfield(1) = field_1 … … 478 446 END DO 479 447 480 IF(lwp) THEN 448 IF(lwp) THEN ! control print 481 449 WRITE(numout,*) 482 450 WRITE(numout,*) 'lim_wri_init : Ice parameters for outputs' … … 486 454 & ' multiplicative constant additive constant ' 487 455 DO nf = 1 , noumef 488 WRITE(numout,*) ' ', titn(nf), ' ' , nam(nf),' ', uni(nf),' ', nc(nf),' ', cmulti(nf), &489 ' ', cadd(nf)456 WRITE(numout,*) ' ', titn(nf), ' ' , nam (nf), ' ' , uni (nf), & 457 & ' ' , nc (nf),' ', cmulti(nf), ' ', cadd(nf) 490 458 END DO 491 459 WRITE(numout,*) ' add_diag_swi ', add_diag_swi 492 460 ENDIF 493 461 ! 494 462 END SUBROUTINE lim_wri_init 495 463
Note: See TracChangeset
for help on using the changeset viewer.
