Changeset 433 for trunk/NEMO/TOP_SRC
- Timestamp:
- 2006-04-10T17:40:29+02:00 (18 years ago)
- Location:
- trunk/NEMO/TOP_SRC
- Files:
-
- 30 edited
-
SMS/trcbio.F (modified) (5 diffs)
-
SMS/trclsm.lobster1.h90 (modified) (2 diffs)
-
TRP/trcadv_cen2.F90 (modified) (2 diffs)
-
TRP/trcadv_muscl.F90 (modified) (2 diffs)
-
TRP/trcadv_muscl2.F90 (modified) (2 diffs)
-
TRP/trcadv_smolar.F90 (modified) (5 diffs)
-
TRP/trcadv_tvd.F90 (modified) (4 diffs)
-
TRP/trcbbl.F90 (modified) (3 diffs)
-
TRP/trcdmp.F90 (modified) (3 diffs)
-
TRP/trcldf_bilap.F90 (modified) (2 diffs)
-
TRP/trcldf_bilapg.F90 (modified) (1 diff)
-
TRP/trcldf_iso.F90 (modified) (1 diff)
-
TRP/trcldf_iso_zps.F90 (modified) (2 diffs)
-
TRP/trcldf_lap.F90 (modified) (1 diff)
-
TRP/trcrad.F90 (modified) (4 diffs)
-
TRP/trcstp.F90 (modified) (3 diffs)
-
TRP/trctrp.F90 (modified) (1 diff)
-
TRP/trczdf_imp.F90 (modified) (2 diffs)
-
TRP/trczdf_iso.F90 (modified) (3 diffs)
-
TRP/trczdf_iso_vopt.F90 (modified) (6 diffs)
-
oce_trc.F90 (modified) (1 diff)
-
par_trc_trp.F90 (modified) (3 diffs)
-
trc.F90 (modified) (4 diffs)
-
trcdit.F90 (modified) (16 diffs)
-
trcdta.F90 (modified) (9 diffs)
-
trcdtr.F90 (modified) (4 diffs)
-
trcini.F90 (modified) (1 diff)
-
trclec.F90 (modified) (2 diffs)
-
trcrst.F90 (modified) (13 diffs)
-
trcsms.F90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/TOP_SRC/SMS/trcbio.F
r341 r433 212 212 C 4. zooplankton liquide excretion 213 213 C 214 zzoonh4 = tauzn * zzoo * fdoml215 zzoodom = tauzn * zzoo * (1-fdoml)216 214 zzoonh4 = tauzn * fzoolab * zzoo 215 zzoodom = tauzn * (1 - fzoolab) * zzoo 216 C 217 217 C 5. mortality 218 218 C … … 226 226 C 227 227 zzoobod = tmminz * zzoo * zzoo 228 fbod(ji,jj) = fbod(ji,jj) + zzoobod * fse3t(ji,jj,jk) 228 fbod(ji,jj) = fbod(ji,jj) 229 $ + (1-fdbod) * zzoobod * fse3t(ji,jj,jk) 230 zboddet = fdbod * zzoobod 229 231 C 230 232 C … … 232 234 C 233 235 C 234 zdetnh4 = taudn * fdoml * zdet 235 zdetdom = taudn * (1 - fdoml) * zdet 236 zdetnh4 = taudn * fdetlab * zdet 237 zdetdom = taudn * (1 - fdetlab) * zdet 238 236 239 zdomnh4 = taudomn * zdom 237 240 C 241 C flux added to express how the excess of nitrogen from 242 C PHY, ZOO and DET to DOM goes directly to NH4 (flux of ajustment) 243 zdomaju = (1 - redf/reddom) * (zphydom + zzoodom + zdetdom) 238 244 C 239 245 C 7. Nitrification … … 254 260 zno3a = - zno3phy + znh4no3 255 261 znh4a = - znh4phy - znh4no3 + zphynh4 + zzoonh4 + zdomnh4 256 $ + zdetnh4 257 zdeta = zphydet + zzoodet - zdetzoo - zdetnh4 - zdetdom 258 zdoma = zphydom + zzoodom + zdetdom - zdomnh4 262 $ + zdetnh4 + zdomaju 263 zdeta = zphydet + zzoodet - zdetzoo - zdetnh4 - zdetdom + 264 $ zboddet 265 zdoma = zphydom + zzoodom + zdetdom - zdomnh4 - zdomaju 259 266 C 260 267 #if defined key_trc_diabio … … 296 303 $ -zzoobod-zzoonh4-zzoodom) *ze3t(jk) 297 304 trc2d(ji,jj,18)=trc2d(ji,jj,18)+zdetdom*ze3t(jk) 298 305 c trend number 19 is in trcexp.F 299 306 trc3d(ji,jj,jk,1)= zno3phy *86400 300 307 trc3d(ji,jj,jk,2)= znh4phy *86400 -
trunk/NEMO/TOP_SRC/SMS/trclsm.lobster1.h90
r341 r433 23 23 !! local declarations 24 24 !! ================== 25 INTEGER :: ji26 25 CHARACTER (len=32) :: clname 27 26 … … 44 43 NAMELIST/natopt/xkg0,xkr0,xkgp,xkrp,xlg,xlr,rpig 45 44 #if defined key_trc_diabio 45 INTEGER :: ji 46 46 NAMELIST/natdbi/ctrbio,ctrbil,ctrbiu,nwritebio 47 47 #endif -
trunk/NEMO/TOP_SRC/TRP/trcadv_cen2.F90
r361 r433 249 249 & + zfvj1 * ( trn(ji ,jj ,jk,jn) - trn(ji,jj-1,jk,jn) ) ) 250 250 ! save i- and j- advective trends computed as Uh gradh(T) 251 trtrd(ji,jj,jk,jn,1) = ztai252 trtrd(ji,jj,jk,jn,2) = ztaj251 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),1) = ztai 252 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),2) = ztaj 253 253 #endif 254 254 END DO … … 317 317 #if defined key_trc_diatrd 318 318 ! save the vertical advective trends computed as w gradz(T) 319 trtrd(ji,jj,jk,jn,3) = ztra - trn(ji,jj,jk,jn) * hdivn(ji,jj,jk)319 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),3) = ztra - trn(ji,jj,jk,jn) * hdivn(ji,jj,jk) 320 320 #endif 321 321 END DO -
trunk/NEMO/TOP_SRC/TRP/trcadv_muscl.F90
r361 r433 226 226 ztaj =-zbtr * ( zt2(ji,jj,jk) - zt2(ji ,jj-1,jk) - trn(ji,jj,jk,jn) * zfvj ) 227 227 ! save i- and j- advective trends computed as Uh gradh(T) 228 trtrd(ji,jj,jk,jn,1) = ztai229 trtrd(ji,jj,jk,jn,2) = ztaj228 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),1) = ztai 229 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),2) = ztaj 230 230 #endif 231 231 END DO … … 314 314 #if defined key_trc_diatrd 315 315 ! save the vertical advective trends computed as w gradz(T) 316 trtrd(ji,jj,jk,jn,3) = ztra - trn(ji,jj,jk,jn) * hdivn(ji,jj,jk)316 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),3) = ztra - trn(ji,jj,jk,jn) * hdivn(ji,jj,jk) 317 317 #endif 318 318 END DO -
trunk/NEMO/TOP_SRC/TRP/trcadv_muscl2.F90
r361 r433 274 274 ztaj =-zbtr * ( zt2(ji,jj,jk) - zt2(ji ,jj-1,jk) - trn(ji,jj,jk,jn) * zfvj ) 275 275 ! save i- and j- advective trends computed as Uh gradh(T) 276 trtrd(ji,jj,jk,jn,1) = ztai277 trtrd(ji,jj,jk,jn,2) = ztaj276 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),1) = ztai 277 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),2) = ztaj 278 278 279 279 #endif … … 378 378 #if defined key_trc_diatrd 379 379 ! save the vertical advective trends computed as w gradz(T) 380 trtrd(ji,jj,jk,jn,3) = ztra - trn(ji,jj,jk,jn) * hdivn(ji,jj,jk)380 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),3) = ztra - trn(ji,jj,jk,jn) * hdivn(ji,jj,jk) 381 381 #endif 382 382 END DO -
trunk/NEMO/TOP_SRC/TRP/trcadv_smolar.F90
r361 r433 147 147 zti(ji,jj,jk) = trn(ji,jj,jk,jn) 148 148 #if defined key_trc_diatrd 149 trtrd(ji,jj,jk,jn,1) = 0.150 trtrd(ji,jj,jk,jn,2) = 0.151 trtrd(ji,jj,jk,jn,3) = 0.149 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),1) = 0. 150 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),2) = 0. 151 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),3) = 0. 152 152 #endif 153 153 END DO … … 219 219 & + zkz(ji,jj,jk) - zkz(ji,jj,jk + 1) ) 220 220 #if defined key_trc_diatrd 221 trtrd(ji,jj,jk,jn,1) = trtrd(ji,jj,jk,jn,1) - &221 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),1) = trtrd(ji,jj,jk,ikeep(jn),1) - & 222 222 & zbtr*( zkx(ji,jj,jk) - zkx(ji - 1,jj,jk) ) 223 223 224 trtrd(ji,jj,jk,jn,2) = trtrd(ji,jj,jk,jn,2) - &224 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),2) = trtrd(ji,jj,jk,ikeep(jn),2) - & 225 225 & zbtr*( zky(ji,jj,jk) - zky(ji,jj - 1,jk) ) 226 226 227 trtrd(ji,jj,jk,jn,3) = trtrd(ji,jj,jk,jn,3) - &227 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),3) = trtrd(ji,jj,jk,ikeep(jn),3) - & 228 228 & zbtr*( zkz(ji,jj,jk) - zkz(ji,jj,jk + 1) ) 229 229 #endif … … 446 446 & + zkz(ji,jj,jk) - zkz(ji,jj,jk + 1) ) 447 447 #if defined key_trc_diatrd 448 trtrd(ji,jj,jk,jn,1) = trtrd(ji,jj,jk,jn,1) - &448 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),1) = trtrd(ji,jj,jk,ikeep(jn),1) - & 449 449 & zbtr*( zkx(ji,jj,jk) - zkx(ji - 1,jj,jk) ) 450 450 451 trtrd(ji,jj,jk,jn,2) = trtrd(ji,jj,jk,jn,2) - &451 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),2) = trtrd(ji,jj,jk,ikeep(jn),2) - & 452 452 & zbtr*( zky(ji,jj,jk) - zky(ji,jj - 1,jk) ) 453 453 454 trtrd(ji,jj,jk,jn,3) = trtrd(ji,jj,jk,jn,3) - &454 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),3) = trtrd(ji,jj,jk,ikeep(jn),3) - & 455 455 & zbtr*( zkz(ji,jj,jk) - zkz(ji,jj,jk + 1) ) 456 456 #endif … … 491 491 & -zvn(ji,jj-1,jk) * e1v(ji,jj-1) * fse3v(ji,jj-1,jk)) 492 492 493 trtrd(ji,jj,jk,jn,1) = trtrd(ji,jj,jk,jn,1) + zgm494 trtrd(ji,jj,jk,jn,2) = trtrd(ji,jj,jk,jn,2) + zgz495 trtrd(ji,jj,jk,jn,3) = trtrd(ji,jj,jk,jn,3) &493 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),1) = trtrd(ji,jj,jk,ikeep(jn),1) + zgm 494 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),2) = trtrd(ji,jj,jk,ikeep(jn),2) + zgz 495 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),3) = trtrd(ji,jj,jk,ikeep(jn),3) & 496 496 & - trn(ji,jj,jk,jn) * hdivn(ji,jj,jk) 497 497 END DO … … 501 501 ! Lateral boundary conditions on trtrd: 502 502 503 CALL lbc_lnk( trtrd(:,:,:,jn,1), 'T', 1. )504 CALL lbc_lnk( trtrd(:,:,:,jn,2), 'T', 1. )505 CALL lbc_lnk( trtrd(:,:,:,jn,3), 'T', 1. )503 IF (luttrd(jn)) CALL lbc_lnk( trtrd(:,:,:,ikeep(jn),1), 'T', 1. ) 504 IF (luttrd(jn)) CALL lbc_lnk( trtrd(:,:,:,ikeep(jn),2), 'T', 1. ) 505 IF (luttrd(jn)) CALL lbc_lnk( trtrd(:,:,:,ikeep(jn),3), 'T', 1. ) 506 506 #endif 507 507 -
trunk/NEMO/TOP_SRC/TRP/trcadv_tvd.F90
r404 r433 81 81 zfm_ui, zfm_vj, zfm_wk ! " " 82 82 83 #if defined key_trc_diatrd 84 REAL(wp) :: & 85 zgm, zgz 86 #endif 87 83 88 CHARACTER (len=22) :: charout 84 89 !!---------------------------------------------------------------------- … … 168 173 & + ztv(ji,jj,jk) - ztv(ji ,jj-1,jk ) & 169 174 & + ztw(ji,jj,jk) - ztw(ji ,jj ,jk+1) ) * zbtr 175 176 #if defined key_trc_diatrd 177 IF ( luttrd(jn) ) & 178 trtrd(ji,jj,jk,ikeep(jn),1) = trtrd(ji,jj,jk,ikeep(jn),1) - & 179 & zbtr * ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) ) 180 IF ( luttrd(jn) ) & 181 trtrd(ji,jj,jk,ikeep(jn),2) = trtrd(ji,jj,jk,ikeep(jn),2) - & 182 & zbtr * ( ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) 183 IF ( luttrd(jn) ) & 184 trtrd(ji,jj,jk,ikeep(jn),3) = trtrd(ji,jj,jk,ikeep(jn),3) - & 185 & zbtr * ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) 186 #endif 170 187 END DO 171 188 END DO … … 231 248 DO ji = fs_2, fs_jpim1 ! vector opt. 232 249 zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 250 #if defined key_trc_diatrd 251 IF ( luttrd(jn) ) & 252 trtrd(ji,jj,jk,ikeep(jn),1) = trtrd(ji,jj,jk,ikeep(jn),1) - & 253 & zbtr * ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) ) 254 IF ( luttrd(jn) ) & 255 trtrd(ji,jj,jk,ikeep(jn),2) = trtrd(ji,jj,jk,ikeep(jn),2) - & 256 & zbtr * ( ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) 257 IF ( luttrd(jn) ) & 258 trtrd(ji,jj,jk,ikeep(jn),3) = trtrd(ji,jj,jk,ikeep(jn),3) - & 259 & zbtr * ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) 260 #endif 233 261 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) & 234 262 & - ( ztu(ji,jj,jk) - ztu(ji-1,jj ,jk ) & … … 238 266 END DO 239 267 END DO 268 ! 6.0 convert the transport trend into advection trend 269 ! ---------------------------------------------------- 270 271 #if defined key_trc_diatrd 272 DO jk = 1,jpk 273 DO jj = 2,jpjm1 274 DO ji = 2,jpim1 275 zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 276 zgm = zbtr * trn(ji,jj,jk,jn) * & 277 & ( zun(ji ,jj,jk) * e2u(ji ,jj) * fse3u(ji ,jj,jk) & 278 & - zun(ji-1,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) ) 279 280 zgz = zbtr * trn(ji,jj,jk,jn) * & 281 & ( zvn(ji,jj ,jk) * e1v(ji,jj ) * fse3v(ji,jj ,jk) & 282 & - zvn(ji,jj-1,jk) * e1v(ji,jj-1) * fse3v(ji,jj-1,jk) ) 283 284 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),1) = trtrd(ji,jj,jk,ikeep(jn),1) + zgm 285 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),2) = trtrd(ji,jj,jk,ikeep(jn),2) + zgz 286 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),3) = trtrd(ji,jj,jk,ikeep(jn),3) & 287 & - trn(ji,jj,jk,jn) * hdivn(ji,jj,jk) 288 END DO 289 END DO 290 END DO 291 292 ! Lateral boundary conditions on trtrd: 293 294 IF (luttrd(jn)) CALL lbc_lnk( trtrd(:,:,:,ikeep(jn),1), 'T', 1. ) 295 IF (luttrd(jn)) CALL lbc_lnk( trtrd(:,:,:,ikeep(jn),2), 'T', 1. ) 296 IF (luttrd(jn)) CALL lbc_lnk( trtrd(:,:,:,ikeep(jn),3), 'T', 1. ) 297 #endif 240 298 241 299 END DO -
trunk/NEMO/TOP_SRC/TRP/trcbbl.F90
r403 r433 383 383 384 384 END SELECT 385 385 386 386 ! 2. Additional second order diffusive trends 387 387 ! ------------------------------------------- … … 416 416 # endif 417 417 END DO 418 #endif 418 419 419 420 IF( cp_cfg == "orca" ) THEN … … 447 448 448 449 ENDIF 449 450 450 451 451 ! second derivative (divergence) and add to the general tracer trend -
trunk/NEMO/TOP_SRC/TRP/trcdmp.F90
r352 r433 108 108 # if defined key_trc_diatrd 109 109 ! save the trends for diagnostics 110 trtrd(ji,jj,jk,jn,jpdiatrc) = ztra110 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),jpdiatrc) = ztra 111 111 # endif 112 112 END DO … … 129 129 # if defined key_trc_diatrd 130 130 ! save the trends for diagnostics 131 trtrd(ji,jj,jk,jn,jpdiatrc) = ztra131 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),jpdiatrc) = ztra 132 132 # endif 133 133 END DO … … 149 149 # if defined key_trc_diatrd 150 150 ! save the trends for diagnostics 151 trtrd(ji,jj,jk,jn,jpdiatrc) = ztra151 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),jpdiatrc) = ztra 152 152 # endif 153 153 END DO -
trunk/NEMO/TOP_SRC/TRP/trcldf_bilap.F90
r349 r433 195 195 #if defined key_trc_diatrd 196 196 ! save the horizontal diffusive trends 197 trtrd(ji,jj,jk,jn,4) = ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) ) * zbtr(ji,jj)198 trtrd(ji,jj,jk,jn,5) = ( ztv(ji,jj,jk) - ztv(ji-1,jj,jk) ) * zbtr(ji,jj)197 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),4) = ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) ) * zbtr(ji,jj) 198 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),5) = ( ztv(ji,jj,jk) - ztv(ji-1,jj,jk) ) * zbtr(ji,jj) 199 199 #endif 200 200 END DO … … 205 205 #if defined key_trc_diatrd 206 206 ! Lateral boundary conditions on the laplacian zlt (unchanged sgn) 207 CALL lbc_lnk( trtrd(:,:,:,jn,5), 'T', 1. )207 IF (luttrd(jn)) CALL lbc_lnk( trtrd(:,:,:,ikeep(jn),5), 'T', 1. ) 208 208 #endif 209 209 END DO -
trunk/NEMO/TOP_SRC/TRP/trcldf_bilapg.F90
r349 r433 112 112 #if defined key_trc_diatrd 113 113 ! save the horizontal diffusive trends 114 trtrd(ji,jj,jk,jn,3) = wk2(ji,jj,jk,jn)114 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),3) = wk2(ji,jj,jk,jn) 115 115 #endif 116 116 END DO -
trunk/NEMO/TOP_SRC/TRP/trcldf_iso.F90
r349 r433 197 197 tra (ji,jj,jk,jn) = tra (ji,jj,jk,jn) + ztra 198 198 #if defined key_trc_diatrd 199 trtrd (ji,jj,jk,jn,4) = ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk ) ) * zbtr200 trtrd (ji,jj,jk,jn,5) = ( zftv(ji,jj,jk) - zftv(ji,jj-1,jk ) ) * zbtr199 IF (luttrd(jn)) trtrd (ji,jj,jk,ikeep(jn),4) = ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk ) ) * zbtr 200 IF (luttrd(jn)) trtrd (ji,jj,jk,ikeep(jn),5) = ( zftv(ji,jj,jk) - zftv(ji,jj-1,jk ) ) * zbtr 201 201 #endif 202 202 END DO -
trunk/NEMO/TOP_SRC/TRP/trcldf_iso_zps.F90
r349 r433 220 220 tra (ji,jj,jk,jn) = tra (ji,jj,jk,jn) + ztra 221 221 #if defined key_trc_diatrd 222 trtrd (ji,jj,jk,jn,4) = zbtr * ( zftu(ji,jj,jk) - zftu(ji-1, jj,jk) )223 trtrd (ji,jj,jk,jn,5) = zbtr * ( zftv(ji,jj,jk) - zftv(ji ,jj-1,jk) )222 IF (luttrd(jn)) trtrd (ji,jj,jk,ikeep(jn),4) = zbtr * ( zftu(ji,jj,jk) - zftu(ji-1, jj,jk) ) 223 IF (luttrd(jn)) trtrd (ji,jj,jk,ikeep(jn),5) = zbtr * ( zftv(ji,jj,jk) - zftv(ji ,jj-1,jk) ) 224 224 #endif 225 225 END DO … … 232 232 ztagu = ( zftug(ji,jj) - zftug(ji-1,jj ) ) * zbtr 233 233 ztagv = ( zftvg(ji,jj) - zftvg(ji ,jj-1) ) * zbtr 234 trtrd (ji,jj,jk,jn,4) = trtrd(ji,jj,jk,jn,4) - ztagu235 trtrd (ji,jj,jk,jn,5) = trtrd(ji,jj,jk,jn,5) - ztagv234 IF (luttrd(jn)) trtrd (ji,jj,jk,ikeep(jn),4) = trtrd(ji,jj,jk,ikeep(jn),4) - ztagu 235 IF (luttrd(jn)) trtrd (ji,jj,jk,ikeep(jn),5) = trtrd(ji,jj,jk,ikeep(jn),5) - ztagv 236 236 END DO 237 237 END DO -
trunk/NEMO/TOP_SRC/TRP/trcldf_lap.F90
r349 r433 132 132 #if defined key_trc_diatrd 133 133 ! save the horizontal diffusive trends 134 trtrd(ji,jj,jk,jn,4) = ztrax135 trtrd(ji,jj,jk,jn,5) = ztray134 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),4) = ztrax 135 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),5) = ztray 136 136 #endif 137 137 END DO -
trunk/NEMO/TOP_SRC/TRP/trcrad.F90
r349 r433 48 48 !! * Local declarations 49 49 INTEGER :: ji, jj, jk, jn ! dummy loop indices 50 #if defined key_trc_pisces 50 #if defined key_trc_pisces || defined key_trc_lobster1 51 51 REAL(wp) :: zvolk, trcorb, trmasb ,trcorn, trmasn 52 52 #endif … … 61 61 62 62 63 #if defined key_ trc_lobster1 || defined key_cfc63 #if defined key_cfc 64 64 DO jn = 1, jptra 65 65 DO jk = 1, jpkm1 … … 73 73 END DO 74 74 75 #elif defined key_trc_pisces 75 #elif defined key_trc_pisces || defined key_trc_lobster1 76 76 77 DO jn = 1, jptra 77 78 trcorb = 0. … … 86 87 & * facvol(ji,jj,jk) & 87 88 #endif 88 & * tmask(ji,jj,jk) 89 & * tmask(ji,jj,jk) * tmask_i(ji,jj) 89 90 90 91 trcorb = trcorb + MIN( 0., trb(ji,jj,jk,jn) ) * zvolk -
trunk/NEMO/TOP_SRC/TRP/trcstp.F90
r349 r433 12 12 USE trc ! ocean passive tracers variables 13 13 USE trctrp ! passive tracers transport 14 USE trctrp1d ! passive tracers transport 1D configuration 14 15 USE trcsms ! passive tracers sources and sinks 15 USE prtctl_trc 16 USE prtctl_trc ! Print control for debbuging 16 17 USE trcdia 18 USE trcdit 17 19 USE trcrst 20 USE ini1d 18 21 19 22 IMPLICIT NONE … … 48 51 CHARACTER (len=25) :: charout 49 52 50 IF( kt == nit000 ) CALL trc_dia( kt, kindic ) ! diagnostics init.51 52 53 ! this ROUTINE is called only every ndttrc time step 53 54 IF( MOD( kt , ndttrc ) /= 0 ) RETURN … … 63 64 64 65 IF(ln_ctl) THEN ! print mean trends (used for debugging) 65 WRITE(charout, FMT="(' sms')")66 WRITE(charout, FMT="('SMS')") 66 67 CALL prt_ctl_trc_info(charout) 67 68 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 68 69 ENDIF 69 70 70 71 71 ! transport of passive tracers 72 IF( lk_cfg_1d ) THEN 73 CALL trc_trp_1d( kt ) 74 ELSE 75 CALL trc_trp( kt ) 76 ENDIF 72 77 73 CALL trc_trp( kt ) 78 79 IF(ln_ctl) THEN ! print mean trends (used for debugging) 80 WRITE(charout, FMT="('TRP')") 81 CALL prt_ctl_trc_info(charout) 82 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 83 ENDIF 74 84 75 85 CALL trc_wri( kt ) ! outputs -
trunk/NEMO/TOP_SRC/TRP/trctrp.F90
r349 r433 125 125 CALL trc_nxt( kt ) ! tracer fields at next time step 126 126 127 CALL trc_rad( kt ) ! Correct artificial negative concentrations 128 ! ! for isopycnal scheme127 CALL trc_rad( kt ) ! Correct artificial negative concentrations for isopycnal scheme 128 ! 129 129 130 130 IF( lk_zps ) CALL zps_hde_trc( kt, trb, gtru, gtrv ) ! Partial steps: now horizontal gradient -
trunk/NEMO/TOP_SRC/TRP/trczdf_imp.F90
r349 r433 159 159 DO ji = fs_2, fs_jpim1 ! vector opt. 160 160 ztra = ( zwx(ji,jj,jk) - trb(ji,jj,jk,jn) ) / rdttrc(jk) 161 trtrd(ji,jj,jk,jn,6) = ztra - tra(ji,jj,jk,jn) + trtrd(ji,jj,jk,jn,6)161 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),6) = ztra - tra(ji,jj,jk,jn) + trtrd(ji,jj,jk,ikeep(jn),6) 162 162 END DO 163 163 END DO … … 168 168 DO ji = fs_2, fs_jpim1 ! vector opt. 169 169 ztra = ( zwx(ji,jj,jk) - trb(ji,jj,jk,jn) ) / rdttrc(jk) 170 trtrd(ji,jj,jk,jn,6) = ztra - tra(ji,jj,jk,jn)170 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),6) = ztra - tra(ji,jj,jk,jn) 171 171 END DO 172 172 END DO -
trunk/NEMO/TOP_SRC/TRP/trczdf_iso.F90
r377 r433 344 344 ! WARNING trtrd(ji,jj,jk,6) used for vertical gent velocity trend 345 345 ! not for damping !!! 346 trtrd(ji,jj,jk,jn,6) = ztavg346 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),6) = ztavg 347 347 # endif 348 trtrd(ji,jj,jk,jn,6) = ztav - ztavg348 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),6) = ztav - ztavg 349 349 #endif 350 350 END DO … … 408 408 DO ji = 2, jpim1 409 409 ztra = ( zwx(ji,jk) - trb(ji,jj,jk,jn) ) / rdttrc(jk) 410 trtrd(ji,jj,jk,jn,6) = ztra - tra(ji,jj,jk,jn) + trtrd(ji,jj,jk,jn,6)410 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),6) = ztra - tra(ji,jj,jk,jn) + trtrd(ji,jj,jk,ikeep(jn),6) 411 411 END DO 412 412 END DO … … 415 415 DO ji = 2, jpim1 416 416 ztra = ( zwx(ji,jk) - trb(ji,jj,jk,jn) ) / rdttrc(jk) 417 trtrd(ji,jj,jk,jn,6) = ztra - tra(ji,jj,jk,jn)417 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),6) = ztra - tra(ji,jj,jk,jn) 418 418 END DO 419 419 END DO -
trunk/NEMO/TOP_SRC/TRP/trczdf_iso_vopt.F90
r349 r433 164 164 zwi, zwt, zavsi ! temporary workspace arrays 165 165 REAL(wp) :: ztra !temporary scalars 166 # if defined key_trc_diatrd 167 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrd 168 # endif 166 169 !!--------------------------------------------------------------------- 167 170 … … 192 195 zavsi( :,:,1)=0.e0 ; zavsi(:,:,jpk)=0.e0 193 196 197 # if defined key_trc_diatrd 198 ! save the tra trend 199 ztrd(:,:,:) = tra(:,:,:,jn) 200 # endif 194 201 195 202 ! II. Vertical trend associated with the vertical physics … … 239 246 END DO 240 247 END DO 241 242 248 243 249 !! Matrix inversion from the first level … … 311 317 DO ji = fs_2, fs_jpim1 ! vector opt. 312 318 ztra = ( tra(ji,jj,jk,jn) - trb(ji,jj,jk,jn) ) / rdttrc(jk) 313 trtrd(ji,jj,jk,jn,6) = ztra - tra(ji,jj,jk,jn) + trtrd(ji,jj,jk,jn,6)319 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),6) = ztra - ztrd(ji,jj,jk) + trtrd(ji,jj,jk,ikeep(jn),6) 314 320 END DO 315 321 END DO … … 320 326 DO ji = fs_2, fs_jpim1 ! vector opt. 321 327 ztra = ( tra(ji,jj,jk,jn) - trb(ji,jj,jk,jn) ) / rdttrc(jk) 322 trtrd(ji,jj,jk,jn,6) = ztra - tra(ji,jj,jk,jn)328 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),6) = ztra - ztrd(ji,jj,jk) 323 329 END DO 324 330 END DO … … 544 550 ztavg = ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) * zbtr 545 551 ! WARNING trtrd(ji,jj,jk,7) used for vertical gent velocity trend not for damping !!! 546 trtrd(ji,jj,jk,jn,7) = ztavg552 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),7) = ztavg 547 553 # endif 548 trtrd(ji,jj,jk,jn,6) = ztav - ztavg554 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),6) = ztav - ztavg 549 555 #endif 550 556 END DO -
trunk/NEMO/TOP_SRC/oce_trc.F90
r375 r433 95 95 ibonit => ibonit , & !:i-processor neighbour existence 96 96 ibonjt => ibonjt , & !:j- processor neighbour existence 97 nlci => nlci , & !:i- & j-dimensions of the local subdomain 98 nlcj => nlcj , & !: 99 nldi => nldi , & !:first and last indoor i- and j-indexes 100 nlei => nlei , & !: 101 nldj => nldj , & !: 102 nlej => nlej , & !: 97 103 nlcit => nlcit , & !:dimensions of every i-subdomain 98 104 nlcjt => nlcjt , & !:dimensions of every j-subdomain -
trunk/NEMO/TOP_SRC/par_trc_trp.F90
r340 r433 28 28 !!--------------------------------------------------------------------- 29 29 INTEGER, PUBLIC, PARAMETER :: jptra = 6 30 # 30 #if defined key_trc_diaadd 31 31 INTEGER, PUBLIC, PARAMETER :: jpdia2d = 19 32 32 INTEGER, PUBLIC, PARAMETER :: jpdia3d = 3 33 # 33 #endif 34 34 #elif defined key_cfc 35 35 !!--------------------------------------------------------------------- … … 37 37 !!--------------------------------------------------------------------- 38 38 INTEGER, PUBLIC, PARAMETER :: jptra = 2 39 # 39 #if defined key_trc_diaadd 40 40 INTEGER, PUBLIC, PARAMETER :: jpdia2d = 1 41 41 INTEGER, PUBLIC, PARAMETER :: jpdia3d = 1 42 # 42 #endif 43 43 #elif defined key_trc_pisces 44 44 !!--------------------------------------------------------------------- … … 46 46 !!--------------------------------------------------------------------- 47 47 INTEGER, PUBLIC, PARAMETER :: jptra = 24 48 # 48 #if defined key_trc_diaadd 49 49 INTEGER, PUBLIC, PARAMETER :: jpdia2d = 13 50 50 INTEGER, PUBLIC, PARAMETER :: jpdia3d = 11 51 # 51 #endif 52 52 #else 53 53 !!--------------------------------------------------------------------- -
trunk/NEMO/TOP_SRC/trc.F90
r340 r433 49 49 !! passive tracers fields (before,now,after) 50 50 !! -------------------------------------------------- 51 REAL(wp), PUBLIC :: & 52 trai !!: initial total tracer 51 REAL(wp), PUBLIC, SAVE :: & 52 trai , & !!: initial total tracer 53 areatot !!: total volume 53 54 54 55 REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk,jptra) :: & … … 123 124 nwritetrc !!: time step frequency for concentration outputs (namelist) 124 125 125 # 126 #if defined key_trc_diaadd 126 127 !! additional 2D/3D outputs namelist 127 128 !! -------------------------------------------------- … … 153 154 #endif 154 155 155 # 156 #if defined key_trc_diatrd 156 157 157 158 !! non conservative trends (biological, ...) … … 174 175 175 176 176 REAL(wp), PUBLIC, DIMENSION( jpi,jpj,jpk,jptra,jpdiatrc):: &177 REAL(wp), PUBLIC, DIMENSION(:,:,:,:,:), ALLOCATABLE, SAVE :: & 177 178 trtrd !!: trends of the tracer equations 178 179 180 INTEGER, PUBLIC, DIMENSION(jptra), SAVE :: ikeep ! indice of tracer for which dyn trends are stored 181 INTEGER, PUBLIC, SAVE :: nkeep ! number of tracers for which dyn trends are stored 182 ! (used to allocate trtrd buffer) 183 179 184 !! netcdf files and index common 180 185 !! -------------------------------------------------- -
trunk/NEMO/TOP_SRC/trcdit.F90
r352 r433 11 11 USE dianam ! build name of file (routine) 12 12 USE in_out_manager ! I/O manager 13 USE lib_mpp 13 14 14 15 IMPLICIT NONE … … 48 49 ndepitb , & !!: id for depth mesh 49 50 nhoritb !!: id for horizontal mesh 51 50 52 # endif 51 53 … … 150 152 151 153 IF(ll_print)WRITE(numout,*)'trcdit_wr kt=',kt,' kindic ',kindic 152 IF(kt == nit000 .and.kindic == 1) THEN154 IF(kt == nit000) THEN 153 155 154 156 ! Compute julian date from starting date of the run … … 202 204 203 205 ENDIF 204 205 ! SOME diagnostics to DO first time206 206 207 207 ! 2. Start writing data … … 343 343 ! 344 344 IF(ll_print)WRITE(numout,*)'trcdid kt=',kt,' kindic ',kindic 345 IF(kt == nit000 .and.kindic == 1) THEN345 IF(kt == nit000) THEN 346 346 347 347 DO jn=1,jptra … … 381 381 IF (jl.eq.1) THEN 382 382 ! short and long title for x advection for tracer 383 WRITE (cltra,'("XAD_", a)') ctrcnm(jn)384 WRITE (cltral,'("X advective trend for ", a)') &385 & ctrcnl(jn) 383 WRITE (cltra,'("XAD_",16a)') ctrcnm(jn) 384 WRITE (cltral,'("X advective trend for ",58a)') & 385 & ctrcnl(jn)(1:58) 386 386 END IF 387 387 IF (jl.eq.2) THEN 388 388 ! short and long title for y advection for tracer 389 WRITE (cltra,'("YAD_", a)') ctrcnm(jn)390 WRITE (cltral,'("Y advective trend for ", a)') &391 & ctrcnl(jn) 389 WRITE (cltra,'("YAD_",16a)') ctrcnm(jn) 390 WRITE (cltral,'("Y advective trend for ",58a)') & 391 & ctrcnl(jn)(1:58) 392 392 END IF 393 393 IF (jl.eq.3) THEN 394 394 ! short and long title for Z advection for tracer 395 WRITE (cltra,'("ZAD_", a)') ctrcnm(jn)396 WRITE (cltral,'("Z advective trend for ", a)') &397 & ctrcnl(jn) 395 WRITE (cltra,'("ZAD_",16a)') ctrcnm(jn) 396 WRITE (cltral,'("Z advective trend for ",58a)') & 397 & ctrcnl(jn)(1:58) 398 398 END IF 399 399 IF (jl.eq.4) THEN 400 400 ! short and long title for X diffusion for tracer 401 WRITE (cltra,'("XDF_", a)') ctrcnm(jn)402 WRITE (cltral,'("X diffusion trend for ", a)') &403 & ctrcn m(jn)401 WRITE (cltra,'("XDF_",16a)') ctrcnm(jn) 402 WRITE (cltral,'("X diffusion trend for ",58a)') & 403 & ctrcnl(jn)(1:58) 404 404 END IF 405 405 IF (jl.eq.5) THEN 406 406 ! short and long title for Y diffusion for tracer 407 WRITE (cltra,'("YDF_", a)') ctrcnm(jn)408 WRITE (cltral,'("Y diffusion trend for ", a)') &409 & ctrcn m(jn)407 WRITE (cltra,'("YDF_",16a)') ctrcnm(jn) 408 WRITE (cltral,'("Y diffusion trend for ",58a)') & 409 & ctrcnl(jn)(1:58) 410 410 END IF 411 411 IF (jl.eq.6) THEN 412 412 ! short and long title for Z diffusion for tracer 413 WRITE (cltra,'("ZDF_", a)') ctrcnm(jn)414 WRITE (cltral,'("Z diffusion trend for ", a)') &415 & ctrcn m(jn)413 WRITE (cltra,'("ZDF_",16a)') ctrcnm(jn) 414 WRITE (cltral,'("Z diffusion trend for ",58a)') & 415 & ctrcnl(jn)(1:58) 416 416 END IF 417 417 # if defined key_trc_ldfeiv 418 418 IF (jl.eq.7) THEN 419 419 ! short and long title for x gent velocity for tracer 420 WRITE (cltra,'("X gv",a)') ctrcnm(jn)421 WRITE (cltral,'("X gent velocity trend for ", a)') &422 & ctrcnl(jn) 420 WRITE (cltra,'("XGV",16a)') ctrcnm(jn) 421 WRITE (cltral,'("X gent velocity trend for ",53a)') & 422 & ctrcnl(jn)(1:53) 423 423 END IF 424 424 IF (jl.eq.8) THEN 425 425 ! short and long title for y gent velocity for tracer 426 WRITE (cltra,'("YGV_", a)') ctrcnm(jn)427 WRITE (cltral,'("Y gent velocity trend for ", a)') &428 & i ctrcnl(jn)426 WRITE (cltra,'("YGV_",16a)') ctrcnm(jn) 427 WRITE (cltral,'("Y gent velocity trend for ",53a)') & 428 & ctrcnl(jn)(1:53) 429 429 END IF 430 430 IF (jl.eq.9) THEN 431 431 ! short and long title for Z gent velocity for tracer 432 WRITE (cltra,'("ZGV_", a)') ctrcnm(jn)433 WRITE (cltral,'("Z gent velocity trend for ", a)') &434 & i ctrcnl(jn)432 WRITE (cltra,'("ZGV_",16a)') ctrcnm(jn) 433 WRITE (cltral,'("Z gent velocity trend for ",53a)') & 434 & ctrcnl(jn)(1:53) 435 435 END IF 436 436 # endif … … 438 438 IF (jl.eq.jpdiatrc) THEN 439 439 ! last trends for tracer damping : short and long title 440 WRITE (cltra,'("TDM_", a)') ctrcnm(jn)441 WRITE (cltral,'("Tracer damping trend for ", a)') &442 & ctrcnl(jn) 440 WRITE (cltra,'("TDM_",16a)') ctrcnm(jn) 441 WRITE (cltral,'("Tracer damping trend for ",55a)') & 442 & ctrcnl(jn)(1:55) 443 443 END IF 444 444 # endif 445 call flush(numout) 445 446 cltrau=ctrcun(jn) ! UNIT for tracer /trends 446 447 CALL histdef(nit6(jn), cltra, cltral, cltrau, jpi,jpj, & … … 480 481 IF (jl.eq.1) THEN 481 482 ! short title for x advection for tracer 482 WRITE (cltra,'("XAD_", a)') ctrcnm(jn)483 WRITE (cltra,'("XAD_",16a)') ctrcnm(jn) 483 484 END IF 484 485 IF (jl.eq.2) THEN 485 486 ! short title for y advection for tracer 486 WRITE (cltra,'("YAD_", a)') ctrcnm(jn)487 WRITE (cltra,'("YAD_",16a)') ctrcnm(jn) 487 488 END IF 488 489 IF (jl.eq.3) THEN 489 490 ! short title for z advection for tracer 490 WRITE (cltra,'("ZAD_", a)') ctrcnm(jn)491 WRITE (cltra,'("ZAD_",16a)') ctrcnm(jn) 491 492 END IF 492 493 IF (jl.eq.4) THEN 493 494 ! short title for x diffusion for tracer 494 WRITE (cltra,'("XDF_", a)') ctrcnm(jn)495 WRITE (cltra,'("XDF_",16a)') ctrcnm(jn) 495 496 END IF 496 497 IF (jl.eq.5) THEN 497 498 ! short title for y diffusion for tracer 498 WRITE (cltra,'("YDF_", a)') ctrcnm(jn)499 WRITE (cltra,'("YDF_",16a)') ctrcnm(jn) 499 500 END IF 500 501 IF (jl.eq.6) THEN 501 502 ! short title for z diffusion for tracer 502 WRITE (cltra,'("ZDF_", a)') ctrcnm(jn)503 WRITE (cltra,'("ZDF_",16a)') ctrcnm(jn) 503 504 END IF 504 505 # if defined key_trc_ldfeiv 505 506 IF (jl.eq.7) THEN 506 507 ! short for x gent velocity for tracer 507 WRITE (cltra,'("XGV_", a)') ctrcnm(jn)508 WRITE (cltra,'("XGV_",16a)') ctrcnm(jn) 508 509 END IF 509 510 IF (jl.eq.8) THEN 510 511 ! short for y gent velocity for tracer 511 WRITE (cltra,'("YGV_", a)') ctrcnm(jn)512 WRITE (cltra,'("YGV_",16a)') ctrcnm(jn) 512 513 END IF 513 514 IF (jl.eq.9) THEN 514 515 ! short title for Z gent velocity for tracer 515 WRITE (cltra,'("ZGV_", a)') ctrcnm(jn)516 WRITE (cltra,'("ZGV_",16a)') ctrcnm(jn) 516 517 END IF 517 518 # endif … … 519 520 IF (jl.eq.jpdiatrc) THEN 520 521 ! short for x gent velocity for tracer 521 WRITE (cltra,'("TDM_", a)') ctrcnm(jn)522 WRITE (cltra,'("TDM_",16a)') ctrcnm(jn) 522 523 END IF 523 524 # endif 524 525 525 CALL histwrite(nit6(jn), cltra, it, trtrd(:,:,:, jn,jl) &526 CALL histwrite(nit6(jn), cltra, it, trtrd(:,:,:,ikeep(jn),jl) & 526 527 & ,ndimt50, ndext50) 527 528 END DO … … 533 534 IF( MOD( kt, nwritetrd ) == 0 .OR. kindic < 0 ) THEN 534 535 DO jn=1,jptra 535 CALL histsync(nit6(jn))536 IF (luttrd(jn)) CALL histsync(nit6(jn)) 536 537 END DO 537 538 ENDIF … … 542 543 IF( kt == nitend .OR. kindic < 0 ) THEN 543 544 DO jn=1,jptra 544 CALL histclo(nit6(jn))545 IF (luttrd(jn)) CALL histclo(nit6(jn)) 545 546 END DO 546 547 ENDIF … … 652 653 653 654 IF(ll_print)WRITE(numout,*)'trcdii_wr kt=',kt,' kindic ',kindic 654 IF(kt == nit000 .and.kindic == 1) THEN655 IF(kt == nit000) THEN 655 656 656 657 ! Define the NETCDF files for additional arrays : 2D or 3D … … 822 823 INTEGER :: iimi, iima, ijmi, ijma, ipk, it 823 824 824 REAL(wp) :: ztra,zder825 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zphy826 827 825 ! 828 826 ! 0. Initialisation … … 857 855 858 856 IF(ll_print)WRITE(numout,*)'trcdib_wr kt=',kt,' kindic ',kindic 859 IF(kt == nit000 .and.kindic == 1) THEN857 IF(kt == nit000) THEN 860 858 861 859 ! Define the NETCDF files for biological trends … … 892 890 IF(ll_print) CALL FLUSH(numout ) 893 891 894 ! SOME diagnostics to DO first time 895 896 # if defined key_trc_lobster1 897 898 ! initial total nitrogen 899 900 trai=0. 901 DO jn=1,jptra 902 DO jk=1,jpk 903 DO jj=1,jpj 904 DO ji=1,jpi 905 trai=trai+trn(ji,jj,jk,jn)*fse3t(ji,jj,jk)*tmask(ji,jj,jk) 906 END DO 907 END DO 908 END DO 909 END DO 910 911 IF (lwp) then 912 WRITE (numout,*) ' *** total nitrogen = ',trai, & 913 & ' at beginning of run it= ',kt 914 ENDIF 915 916 DO jk=1,jpk 917 DO jj=1,jpj 918 DO ji=1,jpi 919 zphy(ji,jj,jk)=trn(ji,jj,jk,jpphy) 920 END DO 921 END DO 922 END DO 923 924 IF (lwp) then 925 WRITE (numout,*) ' -------' 926 WRITE (numout,*) ' phyto' 927 WRITE (numout,*) ' -------' 928 CALL prizre(zphy,jpi,jpj,jpk,62,2,122,20,1,14,1,0.,numout) 929 ENDIF 930 931 # endif 932 933 ENDIF 892 ENDIF 934 893 935 894 ! 2. Start writing data … … 948 907 CALL histwrite(nitb, cltra, kt, trbio(:,:,:,jn), ndimt50,ndext50) 949 908 END DO 950 951 # if defined key_trc_lobster1952 953 IF( MOD(kt-nit000+1,nwritebio) == 0) THEN954 955 ! total nitrogen every nwritebio time step956 957 ztra=0.958 DO jn=1,jptra959 DO jk=1,jpk960 DO jj=1,jpj961 DO ji=1,jpi962 ztra=ztra+trn(ji,jj,jk,jn)*fse3t(ji,jj,jk)*tmask(ji,jj,jk)963 END DO964 END DO965 END DO966 END DO967 968 zder=(ztra-trai)/trai969 trai=ztra970 971 IF (lwp) THEN972 WRITE (numout,*)973 WRITE (numout,*) ' *** derive in total nitrogen = ', zder,' %',' at it= ',kt974 WRITE (numout,*) ' *** total nitrogen = ',trai, ' at it= ',kt975 ENDIF976 977 zphy(:,:,:)=trn(:,:,:,jpphy)978 979 IF (lwp) THEN980 WRITE (numout,*)981 WRITE (numout,*) ' *** trcdib: at it= ',kt982 WRITE (numout,*) ' -------'983 WRITE (numout,*) ' phyto'984 WRITE (numout,*) ' -------'985 CALL prizre(zphy,jpi,jpj,jpk,jpj-1,2,jpj-1,20,1,14,1, &986 & 0.,numout)987 ENDIF988 989 ENDIF990 991 # endif992 909 993 910 ! synchronise FILE -
trunk/NEMO/TOP_SRC/trcdta.F90
r376 r433 1 1 MODULE trcdta 2 2 !!====================================================================== 3 !! *** MODULE dtatem***4 !! Ocean data : read passive tracer data from monthly atlas data3 !! *** MODULE trcdta *** 4 !! Ocean data : reads passive tracer data 5 5 !!===================================================================== 6 6 !! TOP 1.0, LOCEAN-IPSL (2005) … … 29 29 !! * Shared module variables 30 30 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk,jptra) :: & !: 31 trdta !: t emperaturedata at given time-step31 trdta !: tracer data at given time-step 32 32 33 33 !! * Module variables 34 34 REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,2) :: & 35 tracdta ! t emperaturedata at two consecutive times35 tracdta ! tracer data at two consecutive times 36 36 INTEGER , DIMENSION(jptra) :: & 37 37 nlectr , & !!: switch for reading once 38 ntrc1 , & !!: ????39 ntrc2 !!: ????38 ntrc1 , & !!: number of first month when reading 12 monthly value 39 ntrc2 !!: number of second month when reading 12 monthly value 40 40 41 41 !! * Substitutions … … 99 99 !! 3D tracer data 100 100 IF(lwp)WRITE(numout,*) 101 IF(lwp)WRITE(numout,*) ' trcdta: reading tracer'102 IF(lwp)WRITE(numout,*) ' data file ', jn 101 IF(lwp)WRITE(numout,*) ' dta_trc: reading tracer' 102 IF(lwp)WRITE(numout,*) ' data file ', jn, ctrcnm(jn) 103 103 IF(lwp)WRITE(numout,*) 104 104 nlectr(jn) = 0 … … 112 112 ipi = jpiglo 113 113 ipj = jpjglo 114 ipk = jpk 114 115 115 116 ! First call kt=nit000 … … 120 121 IF(lwp) THEN 121 122 WRITE(numout,*) 122 WRITE(numout,*) ' Tracer monthlyfields'123 WRITE(numout,*) ' Tracer data fields' 123 124 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~' 124 125 WRITE(numout,*) ' NetCDF FORMAT' … … 127 128 128 129 ! open file 129 130 #if defined key_trc_pisces 130 131 clname(jn) = 'LEVITUS_'//ctrcnm(jn) 132 #else 133 itime=1 134 clname(jn) = ctrcnm(jn) 135 #endif 131 136 CALL flinopen(TRIM(clname(jn)),mig(1),nlci,mjg(1),nlcj, & 132 137 .FALSE.,ipi,ipj,ipk,zlon,zlat,zlev,itime, & 133 138 istep,zdate0,rdt,numtr(jn) ) 134 139 140 #if defined key_trc_pisces 135 141 ! title, dimensions and tests 136 142 IF( itime /= jpmois ) THEN … … 140 146 WRITE(numout,*) ' itime ',itime,' jpmois ',jpmois 141 147 ENDIF 142 STOP 'trc_dta' 143 ENDIF 148 STOP 'dta_trc' 149 ENDIF 150 #endif 144 151 145 152 IF( ipi /= jpidta .OR. ipj /= jpjdta .OR. ipk /= jpk ) THEN … … 151 158 WRITE(numout,*) ' ipk ',ipk,' jpk ',jpk 152 159 ENDIF 153 STOP ' trc_dta'154 ENDIF 155 IF(lwp)WRITE(numout,*) itime,istep ,zdate0,rdt,numtr(jn)160 STOP 'dta_trc' 161 ENDIF 162 IF(lwp)WRITE(numout,*) itime,istep(1),zdate0,rdt,numtr(jn) 156 163 trdta(:,:,:,jn) = 0. 157 164 158 165 ENDIF 159 166 160 167 #if defined key_trc_pisces 161 168 ! Read montly file 162 169 IF( ( kt == nit000 .AND. nlectr(jn) == 0) & … … 244 251 IF( jn == jpsil) trdta(:,:,:,jn) = trdta(:,:,:,jn) * 1.E-6 245 252 IF( jn == jppo4) trdta(:,:,:,jn) = trdta(:,:,:,jn) * 122.E-6 246 247 248 ENDIF 249 250 END DO 253 #else 254 ! Read init file only 255 IF( kt == nit000 ) THEN 256 CALL flinget( numtr(jn),ctrcnm(jn),jpidta,jpjdta,jpk, & 257 1,1,1,mig(1),nlci,mjg(1),nlcj, & 258 trdta(1:nlci,1:nlcj,1:jpk,jn) ) 259 trdta(:,:,:,jn)=trdta(:,:,:,jn)*tmask(:,:,:) 260 ENDIF 261 #endif 262 263 ENDIF 264 265 END DO 251 266 252 267 END SUBROUTINE dta_trc -
trunk/NEMO/TOP_SRC/trcdtr.F90
r383 r433 109 109 trn(:,:,:,jpdfe) = bioma0*5.E-6 110 110 trn(:,:,:,jpnfe) = bioma0*5.E-6 111 trn(:,:,:,jpdsi) = bioma0* 0.15111 trn(:,:,:,jpdsi) = bioma0*5.E-6 112 112 trn(:,:,:,jpnch) = bioma0*12./55. 113 113 trn(:,:,:,jpdch) = bioma0*12./55. … … 235 235 trn(ji,jj,jk,jpno3)=2.*tmask(ji,jj,jk) 236 236 ELSE 237 trn(ji,jj,jk,jpno3)=(1 3.24*(rhd(ji,jj,jk)*1000)-324.4)*tmask(ji,jj,jk)237 trn(ji,jj,jk,jpno3)=(15.55*(rhd(ji,jj,jk)*1000)-380.11)*tmask(ji,jj,jk) 238 238 ENDIF 239 239 END DO … … 244 244 245 245 !! general case 246 247 trn(:,:,:,:)=0.1 246 do jn = 1, jptra 247 trn(:,:,:,jn)=0.1*tmask(:,:,:) 248 enddo 248 249 249 250 #endif … … 252 253 !! Initialization of tracer from a file 253 254 !! that may also be used for damping 254 255 255 CALL dta_trc( nit000 ) 256 DO j n= 1, jptra257 IF( lutini(j n) ) THEN256 DO jk = 1, jptra 257 IF( lutini(jk) ) THEN 258 258 !! initialisation from file 259 trn(:,:,:,j n) = trdta(:,:,:,jn)259 trn(:,:,:,jk) = trdta(:,:,:,jk)*tmask(:,:,:) 260 260 ENDIF 261 261 END DO -
trunk/NEMO/TOP_SRC/trcini.F90
r340 r433 100 100 DO jl = 1, jpdiatrc 101 101 DO jn = 1, jptra 102 trtrd(:,:,:,jn,jl) = 0.e0102 IF (luttrd(jn)) trtrd(:,:,:,ikeep(jn),jl) = 0.e0 103 103 END DO 104 104 END DO -
trunk/NEMO/TOP_SRC/trclec.F90
r340 r433 150 150 READ(numnat,natrtd) 151 151 152 nkeep=0 153 ikeep(:)=0 154 DO ji=1,jptra 155 IF (luttrd(ji)) THEN 156 nkeep=nkeep+1 157 ikeep(ji)=nkeep 158 END IF 159 END DO 160 IF (nkeep.GT.0) THEN 161 IF (.NOT. ALLOCATED(trtrd)) ALLOCATE(trtrd(jpi,jpj,jpk,nkeep,jpdiatrc)) 162 trtrd(:,:,:,:,:)=0.0 163 ENDIF 152 164 IF(lwp) THEN 153 165 WRITE(numout,*) 'natrtd' … … 159 171 WRITE(numout,*) & 160 172 ' keep dynamical trends for tracer number :',ji & 161 ,luttrd(ji) 162 END DO 173 ,luttrd(ji), ikeep(ji) 174 END DO 175 WRITE(numout,*) 'total = ',nkeep,' tracers dyn trends saved' 176 WRITE(numout,*) 'size of trtrd = ',jpi*jpj*jpk*nkeep*jpdiatrc 163 177 ENDIF 164 178 #endif -
trunk/NEMO/TOP_SRC/trcrst.F90
r352 r433 19 19 USE sms 20 20 USE trctrp_lec 21 USE lib_mpp 21 22 22 23 IMPLICIT NONE … … 89 90 REAL(wp), DIMENSION(3) :: zinfo 90 91 91 #if defined key_trc_pisces && ( defined key_orca_r4 || defined key_orca_r2 || defined key_orca_r05 || defined key_orca_r025 )92 REAL(wp) , DIMENSION(jpi,jpj,jpk) :: zvolk 92 #if defined key_trc_pisces 93 #if ! defined key_cfg_1d && ( defined key_orca_r4 || defined key_orca_r2 || defined key_orca_r05 || defined key_orca_r025 ) 93 94 REAL(wp) :: zareatot, zpo4tot 95 #endif 94 96 #endif 95 97 … … 247 249 #if defined key_trc_pisces 248 250 249 #if defined key_orca_r4 || defined key_orca_r2 || defined key_orca_r05 || defined key_orca_r025 250 251 zvolk(:,:,:) = 0. 252 zareatot = 0. 253 DO jk = 1, jpkm1 254 DO jj = 2, jpjm1 255 DO ji = 2, jpim1 256 zvolk(ji,jj,jk) = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) * tmask(ji,jj,jk) 257 zareatot = zareatot + zvolk(ji,jj,jk) 258 ENDDO 259 ENDDO 260 ENDDO 261 251 #if ! defined key_cfg_1d && ( defined key_orca_r4 || defined key_orca_r2 || defined key_orca_r05 || defined key_orca_r025 ) 252 253 zareatot = 0. 254 DO jk = 1, jpk 255 DO jj = 1, jpj 256 DO ji = 1, jpi 257 zareatot = zareatot + tmask(ji,jj,jk) * tmask_i(ji,jj) * & 258 & e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 259 END DO 260 END DO 261 END DO 262 263 IF( lk_mpp ) THEN 264 CALL mpp_sum( zareatot ) ! sum over the global domain 265 END IF 262 266 263 267 zpo4tot = 0. 264 DO jk = 1, jpkm1 265 DO jj = 2, jpjm1 266 DO ji = 2, jpim1 267 zpo4tot = zpo4tot + trn(ji,jj,jk,jptal) * zvolk(ji,jj,jk) 268 DO jk = 1, jpk 269 DO jj = 1, jpj 270 DO ji = 1, jpi 271 zpo4tot = zpo4tot + trn(ji,jj,jk,jptal) * tmask(ji,jj,jk) * tmask_i(ji,jj) * & 272 & e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 268 273 END DO 269 274 END DO 270 275 END DO 276 277 IF( lk_mpp ) THEN 278 CALL mpp_sum( zpo4tot ) ! sum over the global domain 279 END IF 271 280 272 281 WRITE(0,*) 'TALK moyen ', zpo4tot/zareatot*1E6 … … 274 283 trn(:,:,:,jptal) = trn(:,:,:,jptal)*2391./zpo4tot 275 284 276 277 285 zpo4tot = 0. 278 DO jk = 1, jpkm1 279 DO jj = 2, jpjm1 280 DO ji = 2, jpim1 281 zpo4tot = zpo4tot + trn(ji,jj,jk,jppo4) * zvolk(ji,jj,jk) 286 DO jk = 1, jpk 287 DO jj = 1, jpj 288 DO ji = 1, jpi 289 zpo4tot = zpo4tot + trn(ji,jj,jk,jppo4) * tmask(ji,jj,jk) * tmask_i(ji,jj) * & 290 & e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 282 291 END DO 283 292 END DO 284 293 END DO 294 295 IF( lk_mpp ) THEN 296 CALL mpp_sum( zpo4tot ) ! sum over the global domain 297 END IF 298 285 299 286 300 WRITE(0,*) 'PO4 moyen ', zpo4tot/zareatot*1E6/122. … … 288 302 trn(:,:,:,jppo4) = trn(:,:,:,jppo4)*2.165/zpo4tot 289 303 290 291 304 zpo4tot = 0. 292 DO jk = 1, jpkm1 293 DO jj = 2, jpjm1 294 DO ji = 2, jpim1 295 zpo4tot = zpo4tot + trn(ji,jj,jk,jpno3) * zvolk(ji,jj,jk) 305 DO jk = 1, jpk 306 DO jj = 1, jpj 307 DO ji = 1, jpi 308 zpo4tot = zpo4tot + trn(ji,jj,jk,jpno3) * tmask(ji,jj,jk) * tmask_i(ji,jj) * & 309 & e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 296 310 END DO 297 311 END DO 298 312 END DO 313 314 IF( lk_mpp ) THEN 315 CALL mpp_sum( zpo4tot ) ! sum over the global domain 316 END IF 317 299 318 300 319 WRITE(0,*) 'NO3 moyen ', zpo4tot/zareatot*1E6/7.6 … … 303 322 304 323 zpo4tot = 0. 305 DO jk = 1, jpkm1 306 DO jj = 2, jpjm1 307 DO ji = 2, jpim1 308 zpo4tot = zpo4tot + trn(ji,jj,jk,jpsil) * zvolk(ji,jj,jk) 324 DO jk = 1, jpk 325 DO jj = 1, jpj 326 DO ji = 1, jpi 327 zpo4tot = zpo4tot + trn(ji,jj,jk,jpsil) * tmask(ji,jj,jk) * tmask_i(ji,jj) * & 328 & e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 309 329 END DO 310 330 END DO 311 331 END DO 332 333 IF( lk_mpp ) THEN 334 CALL mpp_sum( zpo4tot ) ! sum over the global domain 335 END IF 312 336 313 337 WRITE(0,*) 'SiO3 moyen ', zpo4tot/zareatot*1E6 … … 402 426 403 427 REAL(wp) :: zdate0, zinfo(3),zdiag_var, & 404 zdiag_varmin, zdiag_varmax 428 zdiag_varmin, zdiag_varmax, zdiag_tot, zder 405 429 406 430 … … 412 436 IF(lwp) WRITE(numout,*) 'trc_wri : write passive tracers restart.output NetCDF file' 413 437 IF(lwp) WRITE(numout,*) '~~~~~~~' 438 439 440 areatot = 0. 441 DO jk = 1, jpk 442 DO jj = 1, jpj 443 DO ji = 1, jpi 444 areatot = areatot + tmask(ji,jj,jk)*tmask_i(ji,jj)*e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) 445 END DO 446 END DO 447 END DO 448 449 IF( lk_mpp ) THEN 450 CALL mpp_sum(areatot) ! sum over the global domain 451 END IF 452 453 trai = 0. 454 DO jn = 1, jptra 455 DO jk = 1,jpk 456 DO jj = 1, jpj 457 DO ji = 1, jpi 458 trai=trai+tmask(ji,jj,jk)*trn(ji,jj,jk,jn)* & 459 & tmask_i(ji,jj)* e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 460 END DO 461 END DO 462 END DO 463 END DO 464 465 IF( lk_mpp ) THEN 466 CALL mpp_sum(trai) ! sum over the global domain 467 END IF 468 469 IF (lwp) WRITE(numout,*) 'Integral of all tracers over the full domain at NIT000 =',trai 470 414 471 ENDIF 415 472 … … 452 509 IF(cexper(jc:jc) /= ' ') ic = jc 453 510 END DO 454 WRITE(cln,'("_",i 2.2,i2.2,i2.2,"_restart.trc")') nyear, nmonth, nday511 WRITE(cln,'("_",i4.4,i2.2,i2.2,"_restart.trc")') nyear, nmonth, nday 455 512 clname=cexper(1:ic)//cln 456 513 ic=1 … … 469 526 ! -------------------- 470 527 528 IF (lwp) WRITE(numout,*) '----TRACER STAT----' 529 zdiag_tot=0. 471 530 DO jn=1,jptra 472 531 clname='TRN'//ctrcnm(jn) … … 476 535 zdiag_varmin=0. 477 536 zdiag_varmax=0. 478 IF (lwp) WRITE(numout,*) '----TRACER STAT----' 479 480 DO ji=1,jpi 481 DO jj=1,jpj 537 538 DO ji=1, jpi 539 DO jj=1, jpj 482 540 DO jk=1,jpk 483 484 zdiag_var=zdiag_var+tmask(ji,jj,jk)*trn(ji,jj,jk,jn) 485 486 IF (tmask(ji,jj,jk).EQ.1.) THEN 487 IF (zdiag_varmin.GT.trn(ji,jj,jk,jn)) & 488 zdiag_varmin = trn(ji,jj,jk,jn) 489 IF (zdiag_varmax.LT.trn(ji,jj,jk,jn)) & 490 zdiag_varmax = trn(ji,jj,jk,jn) 491 492 ENDIF 541 zdiag_var=zdiag_var+tmask(ji,jj,jk)*trn(ji,jj,jk,jn)* & 542 tmask_i(ji,jj)* e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 493 543 494 544 END DO … … 496 546 END DO 497 547 498 499 zdiag_var=zdiag_var/(jpi*jpj*jpk) 500 501 IF(lwp) WRITE(numout,*) 'MEAN NO ',jn,' =',zdiag_var,'MIN= ' & 548 zdiag_varmin=MINVAL(trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.))) 549 zdiag_varmax=MAXVAL(trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.))) 550 551 IF( lk_mpp ) THEN 552 CALL mpp_min(zdiag_varmin) ! min over the global domain 553 CALL mpp_max(zdiag_varmax) ! max over the global domain 554 CALL mpp_sum(zdiag_var) ! sum over the global domain 555 END IF 556 557 zdiag_tot=zdiag_tot+zdiag_var 558 zdiag_var=zdiag_var/areatot 559 560 IF (lwp) WRITE(numout,*) 'MEAN NO ',jn,ctrcnm(jn),' =',zdiag_var,'MIN= ' & 502 561 ,zdiag_varmin,'MAX= ',zdiag_varmax 503 562 504 563 END DO 564 565 zdiag_tot=zdiag_tot 566 zder=((zdiag_tot-trai)/trai)*100._wp 567 IF (lwp) WRITE(numout,*) 'Integral of all tracers over the full domain =',zdiag_tot 568 IF (lwp) WRITE(numout,*) 'Drift of the sum of all tracers =',zder, '%' 505 569 506 570 DO jn=1,jptra … … 508 572 CALL restput(nutwrs,clname,jpi,jpj,jpk,0,trb(:,:,:,jn)) 509 573 END DO 510 511 574 512 575 #if defined key_trc_lobster1 -
trunk/NEMO/TOP_SRC/trcsms.F90
r340 r433 17 17 USE trc 18 18 USE trcfreons 19 USE prtctl_trc ! Print control for debbuging 19 20 20 21 IMPLICIT NONE … … 75 76 INTEGER, INTENT( in ) :: kt ! ocean time-step index 76 77 78 !! * Local variables 79 !! ----------------- 80 81 CHARACTER (len=25) :: charout 82 77 83 !! this ROUTINE is called only every ndttrc time step 78 84 !! -------------------------------------------------- … … 90 96 CALL trcopt( kt) 91 97 98 IF(ln_ctl) THEN ! print mean trends (used for debugging) 99 WRITE(charout, FMT="('OPT')") 100 CALL prt_ctl_trc_info(charout) 101 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 102 ENDIF 103 92 104 !! tracers: biological model 93 105 !! ------------------------- … … 95 107 CALL trcbio( kt) 96 108 109 IF(ln_ctl) THEN ! print mean trends (used for debugging) 110 WRITE(charout, FMT="('BIO')") 111 CALL prt_ctl_trc_info(charout) 112 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 113 ENDIF 114 97 115 !! tracers: sedimentation model 98 116 !! ---------------------------- 99 117 100 118 CALL trcsed(kt) 119 IF(ln_ctl) THEN ! print mean trends (used for debugging) 120 WRITE(charout, FMT="('SED')") 121 CALL prt_ctl_trc_info(charout) 122 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 123 ENDIF 124 101 125 CALL trcexp(kt) 102 126 103 127 IF(ln_ctl) THEN ! print mean trends (used for debugging) 128 WRITE(charout, FMT="('EXP')") 129 CALL prt_ctl_trc_info(charout) 130 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 131 ENDIF 104 132 105 133 #elif defined key_trc_pisces
Note: See TracChangeset
for help on using the changeset viewer.
