Changeset 921 for trunk/NEMO/LIM_SRC_3/limwri.F90
- Timestamp:
- 2008-05-13T10:28:52+02:00 (16 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/LIM_SRC_3/limwri.F90
r888 r921 85 85 !!------------------------------------------------------------------- 86 86 INTEGER, INTENT(in) :: & 87 87 kindic ! if kindic < 0 there has been an error somewhere 88 88 89 89 !! * Local variables 90 90 REAL(wp),DIMENSION(1) :: zdept 91 91 92 92 REAL(wp) :: & 93 93 zsto, zsec, zjulian,zout, & … … 96 96 zcmo, & 97 97 zcmoa ! additional fields 98 98 99 99 REAL(wp), DIMENSION(jpi,jpj) :: & 100 100 zfield … … 118 118 ndexitd 119 119 !!------------------------------------------------------------------- 120 120 121 121 ipl = jpl 122 122 … … 124 124 125 125 CALL lim_wri_init 126 126 127 127 WRITE(numout,*) ' lim_wri, first time step ' 128 128 WRITE(numout,*) ' add_diag_swi ', add_diag_swi … … 135 135 ! Normal file 136 136 !------------- 137 137 138 138 zsto = rdt_ice 139 139 clop = "ave(x)" … … 148 148 CALL histvert( nice, "deptht", "Vertical T levels", "m", 1, zdept, ndepid) 149 149 CALL wheneq ( jpij , tmask(:,:,1), 1, 1., ndex51, ndim) 150 150 151 151 DO jf = 1 , noumef 152 152 WRITE(numout,*) 'jf', jf … … 160 160 161 161 CALL histend(nice) 162 162 163 163 !----------------- 164 164 ! ITD file output … … 173 173 CALL dia_nam ( clhstnama, nwrite, 'icemoa' ) 174 174 CALL histbeg ( clhstnama, jpi, glamt, jpj, gphit, & 175 176 177 178 175 1, jpi, 1, jpj, & ! zoom 176 0, zjulian, rdt_ice, & ! time 177 nhorida, & ! ? linked with horizontal ... 178 nicea , domain_id=nidom) ! file 179 179 CALL histvert( nicea, "icethi", "L levels", & 180 180 "m", ipl , hi_mean , nz ) 181 181 DO jl = 1, jpl 182 182 zmaskitd(:,:,jl) = tmask(:,:,1) … … 185 185 CALL wheneq( jpi*jpj*jpl, zmaskitd, 1, 1., ndexitd, ndimitd ) 186 186 CALL histdef( nicea, "iice_itd", "Ice area in categories" , "-" , & 187 187 jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 188 188 CALL histdef( nicea, "iice_hid", "Ice thickness in categories" , "m" , & 189 189 jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 190 190 CALL histdef( nicea, "iice_hsd", "Snow depth in in categories" , "m" , & 191 191 jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 192 192 CALL histdef( nicea, "iice_std", "Ice salinity distribution" , "ppt" , & 193 193 jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 194 194 CALL histdef( nicea, "iice_otd", "Ice age distribution" , "days", & 195 195 jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 196 196 CALL histdef( nicea, "iice_etd", "Brine volume distr. " , "%" , & 197 197 jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 198 198 CALL histend(nicea) 199 199 ENDIF 200 201 ! !-----------------------------------------------------------------------!202 ! !--2. Computation of instantaneous values !203 ! !-----------------------------------------------------------------------!204 205 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++200 201 ! !-----------------------------------------------------------------------! 202 ! !--2. Computation of instantaneous values ! 203 ! !-----------------------------------------------------------------------! 204 205 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 206 206 IF(lwp) THEN 207 207 WRITE(numout,*) … … 210 210 WRITE(numout,*) ' kindic = ', kindic 211 211 ENDIF 212 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++212 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 213 213 214 214 !-- calculs des valeurs instantanees … … 229 229 230 230 CALL lim_var_bv 231 231 232 232 DO jj = 2 , jpjm1 233 233 DO ji = 2 , jpim1 … … 240 240 zcmo(ji,jj,3) = vt_s(ji,jj)/MAX(at_i(ji,jj),epsi16)*zinda 241 241 zcmo(ji,jj,4) = diag_bot_gr(ji,jj) * & 242 242 86400.0 * zinda !Bottom thermodynamic ice production 243 243 zcmo(ji,jj,5) = diag_dyn_gr(ji,jj) * & 244 244 86400.0 * zinda !Dynamic ice production (rid/raft) 245 245 zcmo(ji,jj,22) = diag_lat_gr(ji,jj) * & 246 246 86400.0 * zinda !Lateral thermodynamic ice production 247 247 zcmo(ji,jj,23) = diag_sni_gr(ji,jj) * & 248 248 86400.0 * zinda !Snow ice production ice production 249 249 zcmo(ji,jj,24) = tm_i(ji,jj) - rtt 250 250 251 251 zcmo(ji,jj,6) = fbif (ji,jj) 252 252 zcmo(ji,jj,7) = zindb * ( u_ice(ji,jj ) * tmu(ji,jj) & 253 & + u_ice(ji-1,jj) * tmu(ji-1,jj) ) &254 & / 2.0253 & + u_ice(ji-1,jj) * tmu(ji-1,jj) ) & 254 & / 2.0 255 255 zcmo(ji,jj,8) = zindb * ( v_ice(ji,jj ) * tmv(ji,jj) & 256 & + v_ice(ji,jj-1) * tmv(ji,jj-1) ) &257 & / 2.0256 & + v_ice(ji,jj-1) * tmv(ji,jj-1) ) & 257 & / 2.0 258 258 zcmo(ji,jj,9) = sst_m(ji,jj) 259 259 zcmo(ji,jj,10) = sss_m(ji,jj) … … 274 274 zcmo(ji,jj,28) = fsbri(ji,jj) 275 275 zcmo(ji,jj,29) = fseqv(ji,jj) 276 276 277 277 zcmo(ji,jj,30) = bv_i(ji,jj) 278 278 zcmo(ji,jj,31) = hicol(ji,jj) 279 279 zcmo(ji,jj,32) = strength(ji,jj) 280 280 zcmo(ji,jj,33) = SQRT( zcmo(ji,jj,7)*zcmo(ji,jj,7) + & 281 281 zcmo(ji,jj,8)*zcmo(ji,jj,8) ) 282 282 zcmo(ji,jj,34) = diag_sur_me(ji,jj) * & 283 283 86400.0 * zinda ! Surface melt 284 284 zcmo(ji,jj,35) = diag_bot_me(ji,jj) * & 285 285 86400.0 * zinda ! Bottom melt 286 286 zcmo(ji,jj,36) = divu_i(ji,jj) 287 287 zcmo(ji,jj,37) = shear_i(ji,jj) … … 299 299 END DO 300 300 END DO 301 301 302 302 IF ( jf == 7 .OR. jf == 8 .OR. jf == 15 .OR. jf == 16 ) THEN 303 303 CALL lbc_lnk( zfield, 'T', -1. ) … … 306 306 ENDIF 307 307 308 !+++++308 !+++++ 309 309 WRITE(numout,*) 310 310 WRITE(numout,*) 'nc(jf), nice, nam(jf), niter, ndim' 311 311 WRITE(numout,*) nc(jf), nice, nam(jf), niter, ndim 312 !+++++312 !+++++ 313 313 IF ( nc(jf) == 1 ) CALL histwrite( nice, nam(jf), niter, zfield, ndim, ndex51 ) 314 314 315 315 END DO 316 316 317 317 IF ( ( nn_fsbc * niter + nit000 - 1 ) >= nitend .OR. kindic < 0 ) THEN 318 319 318 WRITE(numout,*) ' Closing the icemod file ' 319 CALL histclo( nice ) 320 320 ENDIF 321 321 … … 325 325 IF ( add_diag_swi .EQ. 1 ) THEN 326 326 327 DO jl = 1, jpl 328 CALL lbc_lnk( a_i(:,:,jl) , 'T' , 1. ) 329 CALL lbc_lnk( sm_i(:,:,jl) , 'T' , 1. ) 330 CALL lbc_lnk( oa_i(:,:,jl) , 'T' , 1. ) 331 CALL lbc_lnk( ht_i(:,:,jl) , 'T' , 1. ) 332 CALL lbc_lnk( ht_s(:,:,jl) , 'T' , 1. ) 333 END DO 334 335 ! Compute ice age 336 DO jl = 1, jpl 337 DO jj = 1, jpj 338 DO ji = 1, jpi 339 zinda = MAX( zzero , SIGN( zone , a_i(ji,jj,jl) - 1.0e-6 ) ) 340 zoi(ji,jj,jl) = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , 1.0e-6 ) * & 341 zinda 342 END DO 343 END DO 344 END DO 345 346 ! Compute brine volume 347 zei(:,:,:) = 0.0 348 DO jl = 1, jpl 349 DO jk = 1, nlay_i 327 DO jl = 1, jpl 328 CALL lbc_lnk( a_i(:,:,jl) , 'T' , 1. ) 329 CALL lbc_lnk( sm_i(:,:,jl) , 'T' , 1. ) 330 CALL lbc_lnk( oa_i(:,:,jl) , 'T' , 1. ) 331 CALL lbc_lnk( ht_i(:,:,jl) , 'T' , 1. ) 332 CALL lbc_lnk( ht_s(:,:,jl) , 'T' , 1. ) 333 END DO 334 335 ! Compute ice age 336 DO jl = 1, jpl 350 337 DO jj = 1, jpj 351 338 DO ji = 1, jpi 352 339 zinda = MAX( zzero , SIGN( zone , a_i(ji,jj,jl) - 1.0e-6 ) ) 353 zei(ji,jj,jl) = zei(ji,jj,jl) + 100.0* & 354 ( - tmut * s_i(ji,jj,jk,jl) / MIN( ( t_i(ji,jj,jk,jl) - rtt ), -1.0e-6 ) ) * & 355 zinda / nlay_i 340 zoi(ji,jj,jl) = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , 1.0e-6 ) * & 341 zinda 356 342 END DO 357 343 END DO 358 344 END DO 359 END DO 360 361 DO jl = 1, jpl 362 CALL lbc_lnk( zei(:,:,jl) , 'T' , 1. ) 363 END DO 364 365 CALL histwrite( nicea, "iice_itd", niter, a_i , ndimitd , ndexitd ) ! area 366 CALL histwrite( nicea, "iice_hid", niter, ht_i , ndimitd , ndexitd ) ! thickness 367 CALL histwrite( nicea, "iice_hsd", niter, ht_s , ndimitd , ndexitd ) ! snow depth 368 CALL histwrite( nicea, "iice_std", niter, sm_i , ndimitd , ndexitd ) ! salinity 369 CALL histwrite( nicea, "iice_otd", niter, zoi , ndimitd , ndexitd ) ! age 370 CALL histwrite( nicea, "iice_etd", niter, zei , ndimitd , ndexitd ) ! brine volume 371 372 ! ! Create an output files (output.lim.abort.nc) if S < 0 or u > 20 m/s 373 ! IF( kindic < 0 ) CALL lim_wri_state( 'output.abort' ) 374 ! not yet implemented 375 376 IF ( ( nn_fsbc * niter + nit000 - 1 ) >= nitend .OR. kindic < 0 ) THEN 377 WRITE(numout,*) ' Closing the icemod file ' 378 CALL histclo( nicea ) 379 ENDIF 345 346 ! Compute brine volume 347 zei(:,:,:) = 0.0 348 DO jl = 1, jpl 349 DO jk = 1, nlay_i 350 DO jj = 1, jpj 351 DO ji = 1, jpi 352 zinda = MAX( zzero , SIGN( zone , a_i(ji,jj,jl) - 1.0e-6 ) ) 353 zei(ji,jj,jl) = zei(ji,jj,jl) + 100.0* & 354 ( - tmut * s_i(ji,jj,jk,jl) / MIN( ( t_i(ji,jj,jk,jl) - rtt ), -1.0e-6 ) ) * & 355 zinda / nlay_i 356 END DO 357 END DO 358 END DO 359 END DO 360 361 DO jl = 1, jpl 362 CALL lbc_lnk( zei(:,:,jl) , 'T' , 1. ) 363 END DO 364 365 CALL histwrite( nicea, "iice_itd", niter, a_i , ndimitd , ndexitd ) ! area 366 CALL histwrite( nicea, "iice_hid", niter, ht_i , ndimitd , ndexitd ) ! thickness 367 CALL histwrite( nicea, "iice_hsd", niter, ht_s , ndimitd , ndexitd ) ! snow depth 368 CALL histwrite( nicea, "iice_std", niter, sm_i , ndimitd , ndexitd ) ! salinity 369 CALL histwrite( nicea, "iice_otd", niter, zoi , ndimitd , ndexitd ) ! age 370 CALL histwrite( nicea, "iice_etd", niter, zei , ndimitd , ndexitd ) ! brine volume 371 372 ! ! Create an output files (output.lim.abort.nc) if S < 0 or u > 20 m/s 373 ! IF( kindic < 0 ) CALL lim_wri_state( 'output.abort' ) 374 ! not yet implemented 375 376 IF ( ( nn_fsbc * niter + nit000 - 1 ) >= nitend .OR. kindic < 0 ) THEN 377 WRITE(numout,*) ' Closing the icemod file ' 378 CALL histclo( nicea ) 379 ENDIF 380 380 381 381 ENDIF … … 472 472 zfield(36) = field_36 473 473 zfield(37) = field_37 474 474 475 475 DO nf = 1, noumef 476 476 titn (nf) = zfield(nf)%ztitle … … 495 495 WRITE(numout,*) ' add_diag_swi ', add_diag_swi 496 496 ENDIF 497 497 498 498 END SUBROUTINE lim_wri_init 499 499
Note: See TracChangeset
for help on using the changeset viewer.