Changeset 1119 for trunk/NEMO/TOP_SRC/trcrst.F90
- Timestamp:
- 2008-06-20T17:17:41+02:00 (16 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/TOP_SRC/trcrst.F90 (modified) (7 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/TOP_SRC/trcrst.F90
r1100 r1119 33 33 INTEGER, PUBLIC :: numrtr, numrtw !: logical unit for trc restart (read and write) 34 34 35 #if defined key_pisces36 REAL(wp) :: &37 alkmean = 2426. , & ! mean value of alkalinity ( Glodap ; for Goyet 2391. )38 po4mean = 2.165 , & ! mean value of phosphates39 no3mean = 30.90 , & ! mean value of nitrate40 siomean = 91.51 ! mean value of silicate41 #endif42 35 43 36 !! * Substitutions … … 98 91 INTEGER :: iarak0 99 92 REAL(wp) :: zkt, zarak0 100 # if defined key_pisces101 REAL(wp) :: ztrasum102 INTEGER :: ji, jj, jk103 REAL(wp) :: caralk, bicarb, co3104 # endif105 93 !!---------------------------------------------------------------------- 106 94 … … 172 160 CALL iom_get( numrtr, jpdom_autoglo, 'Silicalim', xksi(:,:) ) 173 161 CALL iom_get( numrtr, jpdom_autoglo, 'Silicamax', xksimax(:,:) ) 162 CALL trc_rst_ini ! Initialisation of some variables 174 163 #endif 175 164 … … 181 170 #endif 182 171 183 #if defined key_pisces184 ! ! --------------------------- !185 IF( cp_cfg == "orca" .AND. .NOT. lk_trc_c1d ) THEN ! ORCA condiguration (not 1D) !186 ! ! --------------------------- !187 ! set total alkalinity, phosphate, NO3 & silicate188 ! total alkalinity189 ! -----------------------------------------------190 ztrasum = 0.e0191 DO jk = 1, jpk192 DO jj = 1, jpj193 DO ji = 1, jpi194 ztrasum = ztrasum + trn(ji,jj,jk,jptal) * tmask(ji,jj,jk) * tmask_i(ji,jj) &195 # if defined key_off_degrad196 & * facvol(ji,jj,jk) &197 # endif198 & * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)199 END DO200 END DO201 END DO202 IF( lk_mpp ) CALL mpp_sum( ztrasum ) ! sum over the global domain203 204 205 ztrasum = ztrasum / areatot * 1.e6206 IF(lwp) WRITE(numout,*) 'TALK moyen ', ztrasum207 trn(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / ztrasum208 209 ! phosphate210 ! ---------211 ztrasum = 0.e0212 DO jk = 1, jpk213 DO jj = 1, jpj214 DO ji = 1, jpi215 ztrasum = ztrasum + trn(ji,jj,jk,jppo4) * tmask(ji,jj,jk) * tmask_i(ji,jj) &216 # if defined key_off_degrad217 & * facvol(ji,jj,jk) &218 # endif219 & * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)220 END DO221 END DO222 END DO223 IF( lk_mpp ) CALL mpp_sum( ztrasum ) ! sum over the global domain224 225 ztrasum = ztrasum / areatot * 1.e6 / 122.226 IF(lwp) WRITE(numout,*) 'PO4 moyen ', ztrasum227 trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / ztrasum228 229 ! NO3230 ! ---231 ztrasum = 0.e0232 DO jk = 1, jpk233 DO jj = 1, jpj234 DO ji = 1, jpi235 ztrasum = ztrasum + trn(ji,jj,jk,jpno3) * tmask(ji,jj,jk) * tmask_i(ji,jj) &236 # if defined key_off_degrad237 & * facvol(ji,jj,jk) &238 # endif239 & * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)240 END DO241 END DO242 END DO243 IF( lk_mpp ) CALL mpp_sum( ztrasum ) ! sum over the global domain244 245 ztrasum = ztrasum / areatot * 1.e6 / 7.6246 IF(lwp) WRITE(numout,*) 'NO3 moyen ', ztrasum247 trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / ztrasum248 249 ! Silicate250 ! --------251 ztrasum = 0.e0252 DO jk = 1, jpk253 DO jj = 1, jpj254 DO ji = 1, jpi255 ztrasum = ztrasum + trn(ji,jj,jk,jpsil) * tmask(ji,jj,jk) * tmask_i(ji,jj) &256 # if defined key_off_degrad257 & * facvol(ji,jj,jk) &258 # endif259 & * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)260 END DO261 END DO262 END DO263 IF( lk_mpp ) CALL mpp_sum( ztrasum ) ! sum over the global domain264 265 IF(lwp) WRITE(numout,*) 'SiO3 moyen ', ztrasum / areatot * 1.e6266 ztrasum = ztrasum / areatot * 1.e6267 trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * siomean / ztrasum )268 !269 ENDIF270 271 !#if defined key_kriest272 ! !! Initialize number of particles from a standart restart file273 ! !! The name of big organic particles jpgoc has been only change274 ! !! and replace by jpnum but the values here are concentration275 ! trn(:,:,:,jppoc) = trn(:,:,:,jppoc) + trn(:,:,:,jpnum)276 ! trn(:,:,:,jpnum) = trn(:,:,:,jppoc) / ( 6. * xkr_massp )277 !#endif278 !! Set hi (???) from total alcalinity, borat (???), akb3 (???) and ak23 (???)279 !! ---------------------------------------------------------------------280 DO jk = 1, jpk281 DO jj = 1, jpj282 DO ji = 1,jpi283 caralk = trn(ji,jj,jk,jptal) - borat(ji,jj,jk) / ( 1. + 1.e-8 / ( rtrn + akb3(ji,jj,jk) ) )284 co3 = ( caralk - trn(ji,jj,jk,jpdic) ) * tmask(ji,jj,jk) &285 & + 0.5e-3 * ( 1.- tmask(ji,jj,jk) )286 bicarb = 2.* trn(ji,jj,jk,jpdic) - caralk287 hi(ji,jj,jk) = ( ak23(ji,jj,jk) * bicarb / co3 ) * tmask(ji,jj,jk) &288 & + 1.0e-9 * ( 1.- tmask(ji,jj,jk) )289 END DO290 END DO291 END DO292 #endif293 294 172 CALL iom_close( numrtr ) 295 173 ! … … 306 184 !! 307 185 INTEGER :: ji, jj, jk, jn 308 REAL(wp) :: zdiag_var, zdiag_varmin, zdiag_varmax, zdiag_tot309 REAL(wp) :: zder310 186 !!---------------------------------------------------------------------- 311 187 … … 352 228 353 229 IF( kt == nitrst ) THEN 354 IF(lwp) WRITE(numout,*) '----TRACER STAT----' 355 356 zdiag_tot = 0.e0 357 DO jn = 1, jptra 358 zdiag_var = 0.e0 359 zdiag_varmin = 0.e0 360 zdiag_varmax = 0.e0 361 DO ji = 1, jpi 362 DO jj = 1, jpj 363 DO jk = 1,jpk 364 zdiag_var = zdiag_var + trn(ji,jj,jk,jn) * tmask(ji,jj,jk) * tmask_i(ji,jj) & 365 #if defined key_off_degrad 366 & * facvol(ji,jj,jk) & 367 #endif 368 & * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 369 END DO 370 END DO 371 END DO 372 373 zdiag_varmin = MINVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) ) 374 zdiag_varmax = MAXVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) ) 375 IF( lk_mpp ) THEN 376 CALL mpp_min( zdiag_varmin ) ! min over the global domain 377 CALL mpp_max( zdiag_varmax ) ! max over the global domain 378 CALL mpp_sum( zdiag_var ) ! sum over the global domain 379 END IF 380 zdiag_tot = zdiag_tot + zdiag_var 381 zdiag_var = zdiag_var / areatot 382 IF(lwp) WRITE(numout,*) ' MEAN NO ', jn, ctrcnm(jn), ' = ', zdiag_var, & 383 & ' MIN = ', zdiag_varmin, ' MAX = ', zdiag_varmax 384 END DO 385 386 zder = ( ( zdiag_tot - trai ) / ( trai + 1.e-12 ) ) * 100._wp 387 IF(lwp) WRITE(numout,*) ' Integral of all tracers over the full domain = ', zdiag_tot 388 IF(lwp) WRITE(numout,*) ' Drift of the sum of all tracers =', zder, ' %' 389 230 CALL trc_rst_stat ! statistics 390 231 CALL iom_close( numrtw ) ! close the restart file (only at last time step) 391 232 lrst_trc = .FALSE. … … 393 234 ! 394 235 END SUBROUTINE trc_rst_wri 236 237 # if defined key_pisces 238 239 SUBROUTINE trc_rst_ini 240 !!---------------------------------------------------------------------- 241 !! *** trc_rst_ini *** 242 !! 243 !! ** purpose : Initialisation of some variables ( hi 244 !!---------------------------------------------------------------------- 245 INTEGER :: ji, jj, jk, jn 246 REAL(wp) :: & 247 alkmean = 2426. , & ! mean value of alkalinity ( Glodap ; for Goyet 2391. ) 248 po4mean = 2.165 , & ! mean value of phosphates 249 no3mean = 30.90 , & ! mean value of nitrate 250 siomean = 91.51 ! mean value of silicate 251 252 REAL(wp) :: ztrasum 253 REAL(wp) :: caralk, bicarb, co3 254 255 IF(lwp) WRITE(numout,*) 256 257 IF( cp_cfg == "orca" .AND. .NOT. lk_trc_c1d ) THEN ! ORCA condiguration (not 1D) ! 258 ! ! --------------------------- ! 259 ! set total alkalinity, phosphate, NO3 & silicate 260 261 ! total alkalinity 262 ztrasum = 0.e0 263 DO jk = 1, jpk 264 DO jj = 1, jpj 265 DO ji = 1, jpi 266 ztrasum = ztrasum + trn(ji,jj,jk,jptal) * tmask(ji,jj,jk) * tmask_i(ji,jj) & 267 # if defined key_off_degrad 268 & * facvol(ji,jj,jk) & 269 # endif 270 & * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 271 END DO 272 END DO 273 END DO 274 IF( lk_mpp ) CALL mpp_sum( ztrasum ) ! sum over the global domain 275 276 ztrasum = ztrasum / areatot * 1.e6 277 IF(lwp) WRITE(numout,*) ' TALK mean : ', ztrasum 278 trn(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / ztrasum 279 280 ! phosphate 281 ztrasum = 0.e0 282 DO jk = 1, jpk 283 DO jj = 1, jpj 284 DO ji = 1, jpi 285 ztrasum = ztrasum + trn(ji,jj,jk,jppo4) * tmask(ji,jj,jk) * tmask_i(ji,jj) & 286 # if defined key_off_degrad 287 & * facvol(ji,jj,jk) & 288 # endif 289 & * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 290 END DO 291 END DO 292 END DO 293 IF( lk_mpp ) CALL mpp_sum( ztrasum ) ! sum over the global domain 294 295 ztrasum = ztrasum / areatot * 1.e6 / 122. 296 IF(lwp) WRITE(numout,*) ' PO4 mean : ', ztrasum 297 trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / ztrasum 298 299 ! Nitrates 300 ztrasum = 0.e0 301 DO jk = 1, jpk 302 DO jj = 1, jpj 303 DO ji = 1, jpi 304 ztrasum = ztrasum + trn(ji,jj,jk,jpno3) * tmask(ji,jj,jk) * tmask_i(ji,jj) & 305 # if defined key_off_degrad 306 & * facvol(ji,jj,jk) & 307 # endif 308 & * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 309 END DO 310 END DO 311 END DO 312 IF( lk_mpp ) CALL mpp_sum( ztrasum ) ! sum over the global domain 313 314 ztrasum = ztrasum / areatot * 1.e6 / 7.6 315 IF(lwp) WRITE(numout,*) ' NO3 mean : ', ztrasum 316 trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / ztrasum 317 318 ! Silicate 319 ztrasum = 0.e0 320 DO jk = 1, jpk 321 DO jj = 1, jpj 322 DO ji = 1, jpi 323 ztrasum = ztrasum + trn(ji,jj,jk,jpsil) * tmask(ji,jj,jk) * tmask_i(ji,jj) & 324 # if defined key_off_degrad 325 & * facvol(ji,jj,jk) & 326 # endif 327 & * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 328 END DO 329 END DO 330 END DO 331 IF( lk_mpp ) CALL mpp_sum( ztrasum ) ! sum over the global domain 332 ztrasum = ztrasum / areatot * 1.e6 333 IF(lwp) WRITE(numout,*) ' SiO3 mean : ', ztrasum 334 trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * siomean / ztrasum ) 335 ! 336 ENDIF 337 338 !#if defined key_kriest 339 ! !! Initialize number of particles from a standart restart file 340 ! !! The name of big organic particles jpgoc has been only change 341 ! !! and replace by jpnum but the values here are concentration 342 ! trn(:,:,:,jppoc) = trn(:,:,:,jppoc) + trn(:,:,:,jpnum) 343 ! trn(:,:,:,jpnum) = trn(:,:,:,jppoc) / ( 6. * xkr_massp ) 344 !#endif 345 !! Set hi (???) from total alcalinity, borat (???), akb3 (???) and ak23 (???) 346 !! --------------------------------------------------------------------- 347 DO jk = 1, jpk 348 DO jj = 1, jpj 349 DO ji = 1,jpi 350 caralk = trn(ji,jj,jk,jptal) - borat(ji,jj,jk) / ( 1. + 1.e-8 / ( rtrn + akb3(ji,jj,jk) ) ) 351 co3 = ( caralk - trn(ji,jj,jk,jpdic) ) * tmask(ji,jj,jk) & 352 & + 0.5e-3 * ( 1.- tmask(ji,jj,jk) ) 353 bicarb = 2.* trn(ji,jj,jk,jpdic) - caralk 354 hi(ji,jj,jk) = ( ak23(ji,jj,jk) * bicarb / co3 ) * tmask(ji,jj,jk) & 355 & + 1.0e-9 * ( 1.- tmask(ji,jj,jk) ) 356 END DO 357 END DO 358 END DO 359 360 END SUBROUTINE trc_rst_ini 361 362 #endif 363 !!---------------------------------------------------------------------- 364 365 SUBROUTINE trc_rst_stat 366 !!---------------------------------------------------------------------- 367 !! *** trc_rst_stat *** 368 !! 369 !! ** purpose : Compute tracers statistics 370 !!---------------------------------------------------------------------- 371 372 INTEGER :: ji, jj, jk, jn 373 REAL(wp) :: zdiag_var, zdiag_varmin, zdiag_varmax, zdiag_tot 374 REAL(wp) :: zder 375 !!---------------------------------------------------------------------- 376 377 378 IF( lwp ) THEN 379 WRITE(numout,*) 380 WRITE(numout,*) ' ----TRACER STAT---- ' 381 WRITE(numout,*) 382 ENDIF 383 384 zdiag_tot = 0.e0 385 DO jn = 1, jptra 386 zdiag_var = 0.e0 387 zdiag_varmin = 0.e0 388 zdiag_varmax = 0.e0 389 DO ji = 1, jpi 390 DO jj = 1, jpj 391 DO jk = 1,jpk 392 zdiag_var = zdiag_var + trn(ji,jj,jk,jn) * tmask(ji,jj,jk) * tmask_i(ji,jj) & 393 #if defined key_off_degrad 394 & * facvol(ji,jj,jk) & 395 #endif 396 & * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 397 END DO 398 END DO 399 END DO 400 401 zdiag_varmin = MINVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) ) 402 zdiag_varmax = MAXVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) ) 403 IF( lk_mpp ) THEN 404 CALL mpp_min( zdiag_varmin ) ! min over the global domain 405 CALL mpp_max( zdiag_varmax ) ! max over the global domain 406 CALL mpp_sum( zdiag_var ) ! sum over the global domain 407 END IF 408 zdiag_tot = zdiag_tot + zdiag_var 409 zdiag_var = zdiag_var / areatot 410 IF(lwp) WRITE(numout,*) ' MEAN NO ', jn, ctrcnm(jn), ' = ', zdiag_var, & 411 & ' MIN = ', zdiag_varmin, ' MAX = ', zdiag_varmax 412 END DO 413 414 zder = ( ( zdiag_tot - trai ) / ( trai + 1.e-12 ) ) * 100._wp 415 IF(lwp) WRITE(numout,*) ' Integral of all tracers over the full domain = ', zdiag_tot 416 IF(lwp) WRITE(numout,*) ' Drift of the sum of all tracers =', zder, ' %' 417 418 END SUBROUTINE trc_rst_stat 395 419 396 420 #else
Note: See TracChangeset
for help on using the changeset viewer.
