Changeset 2038 for branches/DEV_r2006_merge_TRA_TRC
- Timestamp:
- 2010-08-02T12:57:40+02:00 (14 years ago)
- Location:
- branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC
- Files:
-
- 6 added
- 12 deleted
- 41 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/C14b/par_c14b.F90
r1252 r2038 40 40 LOGICAL, PUBLIC, PARAMETER :: lk_c14b = .TRUE. !: C14 bomb flag 41 41 INTEGER, PUBLIC, PARAMETER :: jp_c14b = 1 !: number of passive tracers 42 INTEGER, PUBLIC, PARAMETER :: jp_c14b_2d = 2 !: additional 2d output arrays ('key_ trc_diaadd')43 INTEGER, PUBLIC, PARAMETER :: jp_c14b_3d = 1 !: additional 3d output arrays ('key_ trc_diaadd')42 INTEGER, PUBLIC, PARAMETER :: jp_c14b_2d = 2 !: additional 2d output arrays ('key_diatrc') 43 INTEGER, PUBLIC, PARAMETER :: jp_c14b_3d = 1 !: additional 3d output arrays ('key_diatrc') 44 44 INTEGER, PUBLIC, PARAMETER :: jp_c14b_trd = 0 !: number of sms trends for C14 45 45 -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/C14b/trcini_c14b.F90
r1581 r2038 59 59 !!---------------------------------------------------------------------- 60 60 61 IF(lwp) WRITE(numout,*) 62 IF(lwp) WRITE(numout,*) ' trc_ini_cfc: initialisation of CFC chemical model' 61 ! Control consitency 62 CALL trc_ctl_c14b 63 64 IF(lwp) WRITE(numout,*) '' 65 IF(lwp) WRITE(numout,*) ' trc_ini_c14b: initialisation of Bomb C14 chemical model' 63 66 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~' 64 67 … … 162 165 END SUBROUTINE trc_ini_c14b 163 166 167 SUBROUTINE trc_ctl_c14b 168 !!---------------------------------------------------------------------- 169 !! *** ROUTINE trc_ctl_c14b *** 170 !! 171 !! ** Purpose : control the cpp options, namelist and files 172 !!---------------------------------------------------------------------- 173 174 IF(lwp) THEN 175 WRITE(numout,*) ' C14 bomb Model ' 176 WRITE(numout,*) ' ' 177 ENDIF 178 179 ! Check number of tracers 180 ! ----------------------- 181 IF( jp_c14b > 1) THEN 182 IF(lwp) THEN 183 WRITE (numout,*) ' ===>>>> : w a r n i n g ' 184 WRITE (numout,*) ' ======= ============= ' 185 WRITE (numout,*) & 186 & ' STOP, change jp_c14b to 1 in par_C14b module ' 187 END IF 188 STOP 'TRC_CTL' 189 END IF 190 191 ! Check tracer names 192 ! ------------------ 193 IF ( ctrcnm(jpc14) /= 'C14B' ) THEN 194 ctrcnm(jpc14) = 'C14B' 195 ctrcnl(jpc14) = 'Bomb C14 concentration' 196 ENDIF 197 198 IF(lwp) THEN 199 WRITE (numout,*) ' ===>>>> : w a r n i n g ' 200 WRITE (numout,*) ' ======= ============= ' 201 WRITE (numout,*) ' we force tracer names' 202 WRITE(numout,*) ' tracer nb: ',jpc14,' name = ',ctrcnm(jpc14), ctrcnl(jpc14) 203 WRITE(numout,*) ' ' 204 ENDIF 205 206 ! Check tracer units 207 ! ------------------ 208 IF( ctrcun(jpc14) /= 'ration' ) THEN 209 ctrcun(jpc14) = 'ration' 210 IF(lwp) THEN 211 WRITE (numout,*) ' ===>>>> : w a r n i n g ' 212 WRITE (numout,*) ' ======= ============= ' 213 WRITE (numout,*) ' we force tracer unit' 214 WRITE(numout,*) ' tracer ',ctrcnm(jpc14), 'UNIT= ',ctrcun(jpc14) 215 WRITE(numout,*) ' ' 216 ENDIF 217 ENDIF 218 ! 219 END SUBROUTINE trc_ctl_c14b 164 220 #else 165 221 !!---------------------------------------------------------------------- -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/C14b/trcsms_c14b.F90
r1736 r2038 17 17 USE par_trc ! TOP parameters 18 18 USE trc ! TOP variables 19 USE trdm ld_trc_oce20 USE trdm ld_trc19 USE trdmod_oce 20 USE trdmod_trc 21 21 USE iom 22 22 … … 126 126 zpv , & !: piston velocity 127 127 zdemi, ztra 128 #if defined key_ trc_dia3d&& defined key_iomput128 #if defined key_diatrc && defined key_iomput 129 129 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d 130 130 #endif … … 259 259 qtr_c14(ji,jj) = -zpv * zsol * zpco2at & 260 260 & * ( trb(ji,jj,1,jpc14) - zatmbc14(ji,jj) ) & 261 #if defined key_ off_degrad261 #if defined key_degrad 262 262 & * facvol(ji,jj,1) & 263 263 #endif … … 270 270 qint_c14(ji,jj) = qint_c14(ji,jj) + qtr_c14(ji,jj) * rdt 271 271 272 # if defined key_ trc_diaadd&& ! defined key_iomput272 # if defined key_diatrc && ! defined key_iomput 273 273 ! Save 2D diagnostics 274 274 trc2d(ji,jj,jp_c14b0_2d ) = qtr_c14 (ji,jj) … … 282 282 DO jj = 1, jpj 283 283 DO ji = 1, jpi 284 #if ! defined key_ off_degrad284 #if ! defined key_degrad 285 285 ztra = trn(ji,jj,jk,jpc14) * xaccum 286 286 #else … … 288 288 #endif 289 289 tra(ji,jj,jk,jpc14) = tra(ji,jj,jk,jpc14) - ztra / rdt 290 #if defined key_ trc_dia3d290 #if defined key_diatrc 291 291 ! Save 3D diagnostics 292 292 # if ! defined key_iomput … … 300 300 END DO 301 301 302 #if defined key_ trc_diaadd&& defined key_iomput302 #if defined key_diatrc && defined key_iomput 303 303 CALL iom_put( "qtrC14b" , qtr_c14 ) 304 304 CALL iom_put( "qintC14b" , qint_c14 ) 305 305 #endif 306 #if defined key_ trc_dia3d&& defined key_iomput306 #if defined key_diatrc && defined key_iomput 307 307 CALL iom_put( "fdecay" , zw3d ) 308 308 #endif 309 309 IF( l_trdtrc ) THEN 310 CALL trd_mod_trc( tra(:,:,:,jpc14), jpc14, jptr c_trd_sms, kt ) ! save trends310 CALL trd_mod_trc( tra(:,:,:,jpc14), jpc14, jptra_trd_sms, kt ) ! save trends 311 311 END IF 312 312 -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/CFC/par_cfc.F90
r1253 r2038 34 34 LOGICAL, PUBLIC, PARAMETER :: lk_cfc = .TRUE. !: CFC flag 35 35 INTEGER, PUBLIC, PARAMETER :: jp_cfc = 2 !: number of passive tracers 36 INTEGER, PUBLIC, PARAMETER :: jp_cfc_2d = 2 !: additional 2d output arrays ('key_ trc_diaadd')37 INTEGER, PUBLIC, PARAMETER :: jp_cfc_3d = 0 !: additional 3d output arrays ('key_ trc_diaadd')36 INTEGER, PUBLIC, PARAMETER :: jp_cfc_2d = 2 !: additional 2d output arrays ('key_diatrc') 37 INTEGER, PUBLIC, PARAMETER :: jp_cfc_3d = 0 !: additional 3d output arrays ('key_diatrc') 38 38 INTEGER, PUBLIC, PARAMETER :: jp_cfc_trd = 0 !: number of sms trends for CFC 39 39 -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/CFC/trcini_cfc.F90
r1581 r2038 46 46 REAL(wp) :: zyy , zyd 47 47 !!---------------------------------------------------------------------- 48 48 49 49 50 IF(lwp) WRITE(numout,*) … … 95 96 END DO 96 97 97 DO jn = 31, 98 ! Read file 98 READ(inum,*) zyy, p_cfc(jn,1,1), p_cfc(jn,1,2), p_cfc(jn,2,1), p_cfc(jn,2,2) 99 WRITE(numout,'(f7.2, 4f8.2)' ) & 98 ! file starts in 1931 do jn represent the year in the century.jhh 99 ! Read file till the end 100 jn = 31 101 DO WHILE ( 1 /= 2 ) 102 READ(inum,*,END=100) zyy, p_cfc(jn,1,1), p_cfc(jn,1,2), p_cfc(jn,2,1), p_cfc(jn,2,2) 103 IF ( lwp) THEN 104 WRITE(numout,'(f7.2, 4f8.2)' ) & 100 105 & zyy, p_cfc(jn,1,1), p_cfc(jn,1,2), p_cfc(jn,2,1), p_cfc(jn,2,2) 106 ENDIF 107 jn = jn + 1 101 108 END DO 109 100 npyear = jn - 1 110 IF ( lwp) WRITE(numout,*) ' ', npyear ,' years read' 102 111 103 112 p_cfc(32,1:2,1) = 5.e-4 ! modify the values of the first years … … 138 147 139 148 END SUBROUTINE trc_ini_cfc 140 149 141 150 #else 142 151 !!---------------------------------------------------------------------- -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/CFC/trcsms_cfc.F90
r1459 r2038 18 18 USE par_trc ! TOP parameters 19 19 USE trc ! TOP variables 20 USE trdm ld_trc_oce21 USE trdm ld_trc20 USE trdmod_oce 21 USE trdmod_trc 22 22 USE iom 23 23 … … 32 32 INTEGER , PUBLIC :: nyear_res ! restoring time constant (year) 33 33 INTEGER , PUBLIC :: nyear_beg ! initial year (aa) 34 INTEGER , PUBLIC :: npyear ! Number of years read in CFC1112 file 34 35 35 36 REAL(wp), PUBLIC, DIMENSION(jpyear,jphem, jp_cfc) :: p_cfc ! partial hemispheric pressure for CFC … … 96 97 ! Temporal interpolation 97 98 ! ---------------------- 98 iyear_beg = nyear + ( nyear_res - 1900 - nyear_beg )99 iyear_beg = nyear - 1900 99 100 IF ( nmonth <= 6 ) THEN 100 iyear_beg = iyear_beg - 2 + nyear_beg101 iyear_beg = iyear_beg - 1 101 102 im1 = 6 - nmonth + 1 102 103 im2 = 6 + nmonth - 1 103 104 ELSE 104 iyear_beg = iyear_beg - 1 + nyear_beg105 105 im1 = 12 - nmonth + 7 106 106 im2 = nmonth - 7 … … 156 156 ! trn in pico-mol/l idem qtr; ak in en m/s 157 157 qtr_cfc(ji,jj,jl) = -zak_cfc * ( trb(ji,jj,1,jn) - zca_cfc ) & 158 #if defined key_ off_degrad158 #if defined key_degrad 159 159 & * facvol(ji,jj,1) & 160 160 #endif … … 173 173 ! !----------------! 174 174 175 #if defined key_ trc_diaadd175 #if defined key_diatrc 176 176 ! Save diagnostics , just for CFC11 177 177 # if ! defined key_iomput … … 187 187 DO jn = jp_cfc0, jp_cfc1 188 188 ztrcfc(:,:,:) = tra(:,:,:,jn) 189 CALL trd_mod_trc( ztrcfc, jn, jptr c_trd_sms, kt ) ! save trends189 CALL trd_mod_trc( ztrcfc, jn, jptra_trd_sms, kt ) ! save trends 190 190 END DO 191 191 END IF -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/LOBSTER/par_lobster.F90
r1176 r2038 20 20 LOGICAL, PUBLIC, PARAMETER :: lk_lobster = .TRUE. !: LOBSTER flag 21 21 INTEGER, PUBLIC, PARAMETER :: jp_lobster = 6 !: number of LOBSTER tracers 22 INTEGER, PUBLIC, PARAMETER :: jp_lobster_2d = 19 !: additional 2d output arrays ('key_ trc_diaadd')23 INTEGER, PUBLIC, PARAMETER :: jp_lobster_3d = 3 !: additional 3d output arrays ('key_ trc_diaadd')22 INTEGER, PUBLIC, PARAMETER :: jp_lobster_2d = 19 !: additional 2d output arrays ('key_diatrc') 23 INTEGER, PUBLIC, PARAMETER :: jp_lobster_3d = 3 !: additional 3d output arrays ('key_diatrc') 24 24 INTEGER, PUBLIC, PARAMETER :: jp_lobster_trd = 17 !: number of sms trends for LOBSTER 25 25 26 26 ! assign an index in trc arrays for each LOBSTER prognostic variables 27 INTEGER, PUBLIC, PARAMETER :: jp det= 1 !: detritus [mmoleN/m3]28 INTEGER, PUBLIC, PARAMETER :: jp zoo= 2 !: zooplancton concentration [mmoleN/m3]29 INTEGER, PUBLIC, PARAMETER :: jp phy= 3 !: phytoplancton concentration [mmoleN/m3]30 INTEGER, PUBLIC, PARAMETER :: jp no3= 4 !: nitrate concentration [mmoleN/m3]31 INTEGER, PUBLIC, PARAMETER :: jp nh4= 5 !: ammonium concentration [mmoleN/m3]32 INTEGER, PUBLIC, PARAMETER :: jp dom= 6 !: dissolved organic matter [mmoleN/m3]27 INTEGER, PUBLIC, PARAMETER :: jp_lob_det = 1 !: detritus [mmoleN/m3] 28 INTEGER, PUBLIC, PARAMETER :: jp_lob_zoo = 2 !: zooplancton concentration [mmoleN/m3] 29 INTEGER, PUBLIC, PARAMETER :: jp_lob_phy = 3 !: phytoplancton concentration [mmoleN/m3] 30 INTEGER, PUBLIC, PARAMETER :: jp_lob_no3 = 4 !: nitrate concentration [mmoleN/m3] 31 INTEGER, PUBLIC, PARAMETER :: jp_lob_nh4 = 5 !: ammonium concentration [mmoleN/m3] 32 INTEGER, PUBLIC, PARAMETER :: jp_lob_dom = 6 !: dissolved organic matter [mmoleN/m3] 33 33 34 34 ! productive layer depth -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/LOBSTER/trcbio.F90
r1953 r2038 20 20 USE lbclnk ! 21 21 USE prtctl_trc ! Print control for debbuging 22 USE trdmld_trc 23 USE trdmld_trc_oce 22 USE trdmod_trc 24 23 USE iom 25 24 … … 57 56 !! source sink 58 57 !! 59 !! IF 'key_ trc_diabio' defined , the biogeochemical trends58 !! IF 'key_diabio' defined , the biogeochemical trends 60 59 !! for passive tracers are saved for futher diagnostics. 61 60 !!--------------------------------------------------------------------- … … 71 70 REAL(wp) :: zfilpz, zfildz, zphya, zzooa, zno3a 72 71 REAL(wp) :: znh4a, zdeta, zdoma, zzoobod, zboddet, zdomaju 73 #if defined key_ trc_diaadd72 #if defined key_diatrc 74 73 REAL(wp) :: ze3t 75 74 #endif 76 #if defined key_ trc_diaadd&& defined key_iomput75 #if defined key_diatrc && defined key_iomput 77 76 REAL(wp), DIMENSION(jpi,jpj,17) :: zw2d 78 # if defined key_trc_dia3d79 77 REAL(wp), DIMENSION(jpi,jpj,jpk,3) :: zw3d 80 # endif81 78 #endif 82 79 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: ztrbio … … 91 88 92 89 fbod(:,:) = 0.e0 93 #if defined key_ trc_diaadd&& ! defined key_iomput90 #if defined key_diatrc && ! defined key_iomput 94 91 DO jl = jp_lob0_2d, jp_lob1_2d 95 92 trc2d(:,:,jl) = 0.e0 96 93 END DO 97 94 #endif 98 #if defined key_ trc_diaadd&& defined key_iomput95 #if defined key_diatrc && defined key_iomput 99 96 zw2d(:,:,:) = 0.e0 100 # if defined key_trc_dia3d101 97 zw3d(:,:,:,:) = 0.e0 102 # endif103 98 #endif 104 99 … … 117 112 118 113 ! negative trophic variables DO not contribute to the fluxes 119 zdet = MAX( 0.e0, trn(ji,jj,jk,jp det) )120 zzoo = MAX( 0.e0, trn(ji,jj,jk,jp zoo) )121 zphy = MAX( 0.e0, trn(ji,jj,jk,jp phy) )122 zno3 = MAX( 0.e0, trn(ji,jj,jk,jp no3) )123 znh4 = MAX( 0.e0, trn(ji,jj,jk,jp nh4) )124 zdom = MAX( 0.e0, trn(ji,jj,jk,jp dom) )114 zdet = MAX( 0.e0, trn(ji,jj,jk,jp_lob_det) ) 115 zzoo = MAX( 0.e0, trn(ji,jj,jk,jp_lob_zoo) ) 116 zphy = MAX( 0.e0, trn(ji,jj,jk,jp_lob_phy) ) 117 zno3 = MAX( 0.e0, trn(ji,jj,jk,jp_lob_no3) ) 118 znh4 = MAX( 0.e0, trn(ji,jj,jk,jp_lob_nh4) ) 119 zdom = MAX( 0.e0, trn(ji,jj,jk,jp_lob_dom) ) 125 120 126 121 ! Limitations … … 194 189 195 190 ! tracer flux at totox-point added to the general trend 196 tra(ji,jj,jk,jp det) = tra(ji,jj,jk,jpdet) + zdeta197 tra(ji,jj,jk,jp zoo) = tra(ji,jj,jk,jpzoo) + zzooa198 tra(ji,jj,jk,jp phy) = tra(ji,jj,jk,jpphy) + zphya199 tra(ji,jj,jk,jp no3) = tra(ji,jj,jk,jpno3) + zno3a200 tra(ji,jj,jk,jp nh4) = tra(ji,jj,jk,jpnh4) + znh4a201 tra(ji,jj,jk,jp dom) = tra(ji,jj,jk,jpdom) + zdoma202 203 #if defined key_ trc_diabio191 tra(ji,jj,jk,jp_lob_det) = tra(ji,jj,jk,jp_lob_det) + zdeta 192 tra(ji,jj,jk,jp_lob_zoo) = tra(ji,jj,jk,jp_lob_zoo) + zzooa 193 tra(ji,jj,jk,jp_lob_phy) = tra(ji,jj,jk,jp_lob_phy) + zphya 194 tra(ji,jj,jk,jp_lob_no3) = tra(ji,jj,jk,jp_lob_no3) + zno3a 195 tra(ji,jj,jk,jp_lob_nh4) = tra(ji,jj,jk,jp_lob_nh4) + znh4a 196 tra(ji,jj,jk,jp_lob_dom) = tra(ji,jj,jk,jp_lob_dom) + zdoma 197 198 #if defined key_diabio 204 199 trbio(ji,jj,jk,jp_lob0_trd ) = zno3phy 205 200 trbio(ji,jj,jk,jp_lob0_trd + 1) = znh4phy … … 238 233 ENDIF 239 234 240 #if defined key_ trc_diaadd235 #if defined key_diatrc 241 236 ! convert fluxes in per day 242 237 ze3t = fse3t(ji,jj,jk) * 86400. … … 282 277 zw2d(ji,jj,17) = zw2d(ji,jj,17) + zdetdom * ze3t 283 278 #endif 284 #if defined key_ trc_dia3d279 #if defined key_diatrc 285 280 # if ! defined key_iomput 286 281 trc3d(ji,jj,jk,jp_lob0_3d ) = zno3phy * 86400 … … 307 302 ! trophic variables( det, zoo, phy, no3, nh4, dom) 308 303 ! negative trophic variables DO not contribute to the fluxes 309 zdet = MAX( 0.e0, trn(ji,jj,jk,jp det) )310 zzoo = MAX( 0.e0, trn(ji,jj,jk,jp zoo) )311 zphy = MAX( 0.e0, trn(ji,jj,jk,jp phy) )312 zno3 = MAX( 0.e0, trn(ji,jj,jk,jp no3) )313 znh4 = MAX( 0.e0, trn(ji,jj,jk,jp nh4) )314 zdom = MAX( 0.e0, trn(ji,jj,jk,jp dom) )304 zdet = MAX( 0.e0, trn(ji,jj,jk,jp_lob_det) ) 305 zzoo = MAX( 0.e0, trn(ji,jj,jk,jp_lob_zoo) ) 306 zphy = MAX( 0.e0, trn(ji,jj,jk,jp_lob_phy) ) 307 zno3 = MAX( 0.e0, trn(ji,jj,jk,jp_lob_no3) ) 308 znh4 = MAX( 0.e0, trn(ji,jj,jk,jp_lob_nh4) ) 309 zdom = MAX( 0.e0, trn(ji,jj,jk,jp_lob_dom) ) 315 310 316 311 ! Limitations … … 363 358 364 359 ! tracer flux at totox-point added to the general trend 365 tra(ji,jj,jk,jp det) = tra(ji,jj,jk,jpdet) + zdeta366 tra(ji,jj,jk,jp zoo) = tra(ji,jj,jk,jpzoo) + zzooa367 tra(ji,jj,jk,jp phy) = tra(ji,jj,jk,jpphy) + zphya368 tra(ji,jj,jk,jp no3) = tra(ji,jj,jk,jpno3) + zno3a369 tra(ji,jj,jk,jp nh4) = tra(ji,jj,jk,jpnh4) + znh4a370 tra(ji,jj,jk,jp dom) = tra(ji,jj,jk,jpdom) + zdoma360 tra(ji,jj,jk,jp_lob_det) = tra(ji,jj,jk,jp_lob_det) + zdeta 361 tra(ji,jj,jk,jp_lob_zoo) = tra(ji,jj,jk,jp_lob_zoo) + zzooa 362 tra(ji,jj,jk,jp_lob_phy) = tra(ji,jj,jk,jp_lob_phy) + zphya 363 tra(ji,jj,jk,jp_lob_no3) = tra(ji,jj,jk,jp_lob_no3) + zno3a 364 tra(ji,jj,jk,jp_lob_nh4) = tra(ji,jj,jk,jp_lob_nh4) + znh4a 365 tra(ji,jj,jk,jp_lob_dom) = tra(ji,jj,jk,jp_lob_dom) + zdoma 371 366 ! 372 #if defined key_ trc_diabio367 #if defined key_diabio 373 368 trbio(ji,jj,jk,jp_lob0_trd ) = zno3phy 374 369 trbio(ji,jj,jk,jp_lob0_trd + 1) = znh4phy … … 406 401 ! trend number 17 in trcexp 407 402 ENDIF 408 #if defined key_ trc_diaadd && defined key_trc_dia3d403 #if defined key_diatrc 409 404 # if ! defined key_iomput 410 405 trc3d(ji,jj,jk,jp_lob0_3d ) = zno3phy * 86400 … … 421 416 END DO 422 417 423 #if defined key_ trc_diaadd418 #if defined key_diatrc 424 419 ! Lateral boundary conditions 425 420 # if ! defined key_iomput … … 452 447 #endif 453 448 454 #if defined key_ trc_diaadd && defined key_trc_dia3d449 #if defined key_diatrc 455 450 ! Lateral boundary conditions 456 451 # if ! defined key_iomput … … 469 464 #endif 470 465 471 #if defined key_ trc_diabio466 #if defined key_diabio 472 467 ! Lateral boundary conditions on trcbio 473 468 DO jl = jp_lob0_trd, jp_lob1_trd -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/LOBSTER/trcexp.F90
r1953 r2038 21 21 USE trctrp_lec 22 22 USE prtctl_trc ! Print control for debbuging 23 USE trdmld_trc 24 USE trdmld_trc_oce 23 USE trdmod_trc 25 24 USE iom 26 25 … … 75 74 IF( l_trdtrc )THEN 76 75 ALLOCATE( ztrbio(jpi,jpj,jpk) ) 77 ztrbio(:,:,:) = tra(:,:,:,jp no3)76 ztrbio(:,:,:) = tra(:,:,:,jp_lob_no3) 78 77 ENDIF 79 78 … … 82 81 DO ji = fs_2, fs_jpim1 83 82 ze3t = 1. / fse3t(ji,jj,jk) 84 tra(ji,jj,jk,jp no3) = tra(ji,jj,jk,jpno3) + ze3t * dmin3(ji,jj,jk) * fbod(ji,jj)83 tra(ji,jj,jk,jp_lob_no3) = tra(ji,jj,jk,jp_lob_no3) + ze3t * dmin3(ji,jj,jk) * fbod(ji,jj) 85 84 END DO 86 85 END DO … … 96 95 DO ji = fs_2, fs_jpim1 97 96 ikbot = mbathy(ji,jj) - 1 98 tra(ji,jj,ikbot,jp no3) = tra(ji,jj,ikbot,jpno3) + sedlam * sedpocn(ji,jj) / fse3t(ji,jj,ikbot)97 tra(ji,jj,ikbot,jp_lob_no3) = tra(ji,jj,ikbot,jp_lob_no3) + sedlam * sedpocn(ji,jj) / fse3t(ji,jj,ikbot) 99 98 ! Deposition of organic matter in the sediment 100 zwork = vsed * trn(ji,jj,ikbot,jp det)99 zwork = vsed * trn(ji,jj,ikbot,jp_lob_det) 101 100 sedpoca(ji,jj) = ( zwork + dminl(ji,jj) * fbod(ji,jj) & 102 101 & - sedlam * sedpocn(ji,jj) - sedlostpoc * sedpocn(ji,jj) ) * rdt … … 107 106 DO jj = 2, jpjm1 108 107 DO ji = fs_2, fs_jpim1 109 tra(ji,jj,1,jp no3) = tra(ji,jj,1,jpno3) + zgeolpoc * cmask(ji,jj) / areacot / fse3t(ji,jj,1)108 tra(ji,jj,1,jp_lob_no3) = tra(ji,jj,1,jp_lob_no3) + zgeolpoc * cmask(ji,jj) / areacot / fse3t(ji,jj,1) 110 109 END DO 111 110 END DO … … 114 113 115 114 ! Oa & Ek: diagnostics depending on jpdia2d ! left as example 116 #if defined key_ trc_diaadd115 #if defined key_diatrc 117 116 # if ! defined key_iomput 118 117 trc2d(:,:,jp_lob0_2d + 18) = sedpocn(:,:) … … 124 123 ! Leap-frog scheme (only in explicit case, otherwise the 125 124 ! ---------------- time stepping is already done in trczdf) 126 IF( l _trczdf_exp .AND. (ln_trcadv_cen2 .OR. ln_trcadv_tvd) ) THEN127 zfact = 2. * rdttra(jk) * FLOAT( n dttrc )128 IF( neuler == 0 .AND. kt == nittrc000 ) zfact = rdttra(jk) * FLOAT(n dttrc)125 IF( ln_trczdf_exp .AND. (ln_trcadv_cen2 .OR. ln_trcadv_tvd) ) THEN 126 zfact = 2. * rdttra(jk) * FLOAT( nn_dttrc ) 127 IF( neuler == 0 .AND. kt == nittrc000 ) zfact = rdttra(jk) * FLOAT(nn_dttrc) 129 128 sedpoca(:,:) = sedpocb(:,:) + zfact * sedpoca(:,:) 130 129 ENDIF … … 159 158 ! 160 159 IF( l_trdtrc ) THEN 161 ztrbio(:,:,:) = tra(:,:,:,jp no3) - ztrbio(:,:,:)160 ztrbio(:,:,:) = tra(:,:,:,jp_lob_no3) - ztrbio(:,:,:) 162 161 jl = jp_lob0_trd + 16 163 162 CALL trd_mod_trc( ztrbio, jl, kt ) ! handle the trend -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/LOBSTER/trcini_lobster.F90
r1953 r2038 20 20 USE oce_trc ! ocean variables 21 21 USE trc 22 USE lbclnk 23 USE lib_mpp 22 24 23 25 IMPLICIT NONE … … 46 48 !!---------------------------------------------------------------------- 47 49 50 ! Control consitency 51 CALL trc_ctl_lobster 52 53 48 54 IF(lwp) WRITE(numout,*) 49 55 IF(lwp) WRITE(numout,*) ' trc_ini_lobster : LOBSTER biochemical model initialisation' 50 56 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~' 51 52 57 53 58 ! initialization of fields for optical model … … 118 123 ! Coastal mask 119 124 ! ------------ 120 cmask = 0.e0125 cmask(:,:) = 0.e0 121 126 DO ji = 2, jpi-1 122 127 DO jj = 2, jpj-1 … … 128 133 END DO 129 134 130 cmask( 1 ,:) = cmask(jpi-1,:) 131 cmask(jpi,:) = cmask( 2 ,:) 132 133 !!gm BUG !!!!! not valid in mpp and also not valid for north fold !!!!! 135 CALL lbc_lnk( cmask, 'T', 1. ) 134 136 135 137 ! Coastal surface 136 138 ! --------------- 137 139 areacot = 0.e0 138 DO ji = 2, jpi-1139 DO jj = 2, jpj-1140 DO ji = 1, jpi 141 DO jj = 1, jpj 140 142 areacot = areacot + e1t(ji,jj) * e2t(ji,jj) * cmask(ji,jj) 141 143 END DO 142 144 END DO 143 145 ! 146 IF( lk_mpp ) CALL mpp_sum( areacot ) ! sum over the global domain 144 147 145 148 ! Initialization of tracer concentration in case of no restart … … 153 156 154 157 DO jk = 1, 7 155 trn(:,:,jk,jp det) = 0.016 * tmask(:,:,jk)156 trn(:,:,jk,jp zoo) = 0.018 * tmask(:,:,jk)157 trn(:,:,jk,jp phy) = 0.036 * tmask(:,:,jk)158 trn(:,:,jk,jp no3) = 1.e-5 * tmask(:,:,jk)159 trn(:,:,jk,jp nh4) = 5.e-4 * tmask(:,:,jk)160 trn(:,:,jk,jp dom) = 0.017 * tmask(:,:,jk)161 END DO 162 163 trn(:,:, 8,jp det) = 0.020 * tmask(:,:, 8)164 trn(:,:, 8,jp zoo) = 0.027 * tmask(:,:, 8)165 trn(:,:, 8,jp phy) = 0.041 * tmask(:,:, 8)166 trn(:,:, 8,jp no3) = 0.00022 * tmask(:,:, 8)167 trn(:,:, 8,jp nh4) = 0.0033 * tmask(:,:, 8)168 trn(:,:, 8,jp dom) = 0.021 * tmask(:,:, 8)169 170 trn(:,:, 9,jp det) = 0.0556 * tmask(:,:, 9)171 trn(:,:, 9,jp zoo) = 0.123 * tmask(:,:, 9)172 trn(:,:, 9,jp phy) = 0.122 * tmask(:,:, 9)173 trn(:,:, 9,jp no3) = 0.028 * tmask(:,:, 9)174 trn(:,:, 9,jp nh4) = 0.024 * tmask(:,:, 9)175 trn(:,:, 9,jp dom) = 0.06 * tmask(:,:, 9)176 177 trn(:,:,10,jp det) = 0.025 * tmask(:,:,10)178 trn(:,:,10,jp zoo) = 0.016 * tmask(:,:,10)179 trn(:,:,10,jp phy) = 0.029 * tmask(:,:,10)180 trn(:,:,10,jp no3) = 2.462 * tmask(:,:,10)181 trn(:,:,10,jp nh4) = 0.04 * tmask(:,:,10)182 trn(:,:,10,jp dom) = 0.022 * tmask(:,:,10)183 184 trn(:,:,11,jp det) = 0.0057 * tmask(:,:,11)185 trn(:,:,11,jp zoo) = 0.0005 * tmask(:,:,11)186 trn(:,:,11,jp phy) = 0.0006 * tmask(:,:,11)187 trn(:,:,11,jp no3) = 3.336 * tmask(:,:,11)188 trn(:,:,11,jp nh4) = 0.005 * tmask(:,:,11)189 trn(:,:,11,jp dom) = 0.004 * tmask(:,:,11)190 191 trn(:,:,12,jp det) = 0.002 * tmask(:,:,12)192 trn(:,:,12,jp zoo) = 1.e-6 * tmask(:,:,12)193 trn(:,:,12,jp phy) = 5.e-6 * tmask(:,:,12)194 trn(:,:,12,jp no3) = 4.24 * tmask(:,:,12)195 trn(:,:,12,jp nh4) = 0.001 * tmask(:,:,12)196 trn(:,:,12,jp dom) = 3.e-5 * tmask(:,:,12)158 trn(:,:,jk,jp_lob_det) = 0.016 * tmask(:,:,jk) 159 trn(:,:,jk,jp_lob_zoo) = 0.018 * tmask(:,:,jk) 160 trn(:,:,jk,jp_lob_phy) = 0.036 * tmask(:,:,jk) 161 trn(:,:,jk,jp_lob_no3) = 1.e-5 * tmask(:,:,jk) 162 trn(:,:,jk,jp_lob_nh4) = 5.e-4 * tmask(:,:,jk) 163 trn(:,:,jk,jp_lob_dom) = 0.017 * tmask(:,:,jk) 164 END DO 165 166 trn(:,:, 8,jp_lob_det) = 0.020 * tmask(:,:, 8) 167 trn(:,:, 8,jp_lob_zoo) = 0.027 * tmask(:,:, 8) 168 trn(:,:, 8,jp_lob_phy) = 0.041 * tmask(:,:, 8) 169 trn(:,:, 8,jp_lob_no3) = 0.00022 * tmask(:,:, 8) 170 trn(:,:, 8,jp_lob_nh4) = 0.0033 * tmask(:,:, 8) 171 trn(:,:, 8,jp_lob_dom) = 0.021 * tmask(:,:, 8) 172 173 trn(:,:, 9,jp_lob_det) = 0.0556 * tmask(:,:, 9) 174 trn(:,:, 9,jp_lob_zoo) = 0.123 * tmask(:,:, 9) 175 trn(:,:, 9,jp_lob_phy) = 0.122 * tmask(:,:, 9) 176 trn(:,:, 9,jp_lob_no3) = 0.028 * tmask(:,:, 9) 177 trn(:,:, 9,jp_lob_nh4) = 0.024 * tmask(:,:, 9) 178 trn(:,:, 9,jp_lob_dom) = 0.06 * tmask(:,:, 9) 179 180 trn(:,:,10,jp_lob_det) = 0.025 * tmask(:,:,10) 181 trn(:,:,10,jp_lob_zoo) = 0.016 * tmask(:,:,10) 182 trn(:,:,10,jp_lob_phy) = 0.029 * tmask(:,:,10) 183 trn(:,:,10,jp_lob_no3) = 2.462 * tmask(:,:,10) 184 trn(:,:,10,jp_lob_nh4) = 0.04 * tmask(:,:,10) 185 trn(:,:,10,jp_lob_dom) = 0.022 * tmask(:,:,10) 186 187 trn(:,:,11,jp_lob_det) = 0.0057 * tmask(:,:,11) 188 trn(:,:,11,jp_lob_zoo) = 0.0005 * tmask(:,:,11) 189 trn(:,:,11,jp_lob_phy) = 0.0006 * tmask(:,:,11) 190 trn(:,:,11,jp_lob_no3) = 3.336 * tmask(:,:,11) 191 trn(:,:,11,jp_lob_nh4) = 0.005 * tmask(:,:,11) 192 trn(:,:,11,jp_lob_dom) = 0.004 * tmask(:,:,11) 193 194 trn(:,:,12,jp_lob_det) = 0.002 * tmask(:,:,12) 195 trn(:,:,12,jp_lob_zoo) = 1.e-6 * tmask(:,:,12) 196 trn(:,:,12,jp_lob_phy) = 5.e-6 * tmask(:,:,12) 197 trn(:,:,12,jp_lob_no3) = 4.24 * tmask(:,:,12) 198 trn(:,:,12,jp_lob_nh4) = 0.001 * tmask(:,:,12) 199 trn(:,:,12,jp_lob_dom) = 3.e-5 * tmask(:,:,12) 197 200 198 201 DO jk=13,jpk 199 trn(:,:,jk,jp det) = 0.e0200 trn(:,:,jk,jp zoo) = 0.e0201 trn(:,:,jk,jp phy) = 0.e0202 trn(:,:,jk,jp nh4) = 0.e0203 trn(:,:,jk,jp dom) = 0.e0204 END DO 205 206 trn(:,:,13,jp no3) = 5.31 * tmask(:,:,13)207 trn(:,:,14,jp no3) = 6.73 * tmask(:,:,14)208 trn(:,:,15,jp no3) = 8.32 * tmask(:,:,15)209 trn(:,:,16,jp no3) = 10.13 * tmask(:,:,16)210 trn(:,:,17,jp no3) = 11.95 * tmask(:,:,17)211 trn(:,:,18,jp no3) = 13.57 * tmask(:,:,18)212 trn(:,:,19,jp no3) = 15.08 * tmask(:,:,19)213 trn(:,:,20,jp no3) = 16.41 * tmask(:,:,20)214 trn(:,:,21,jp no3) = 17.47 * tmask(:,:,21)215 trn(:,:,22,jp no3) = 18.29 * tmask(:,:,22)216 trn(:,:,23,jp no3) = 18.88 * tmask(:,:,23)217 trn(:,:,24,jp no3) = 19.30 * tmask(:,:,24)218 trn(:,:,25,jp no3) = 19.68 * tmask(:,:,25)219 trn(:,:,26,jp no3) = 19.91 * tmask(:,:,26)220 trn(:,:,27,jp no3) = 19.99 * tmask(:,:,27)221 trn(:,:,28,jp no3) = 20.01 * tmask(:,:,28)222 trn(:,:,29,jp no3) = 20.01 * tmask(:,:,29)223 trn(:,:,30,jp no3) = 20.01 * tmask(:,:,30)202 trn(:,:,jk,jp_lob_det) = 0.e0 203 trn(:,:,jk,jp_lob_zoo) = 0.e0 204 trn(:,:,jk,jp_lob_phy) = 0.e0 205 trn(:,:,jk,jp_lob_nh4) = 0.e0 206 trn(:,:,jk,jp_lob_dom) = 0.e0 207 END DO 208 209 trn(:,:,13,jp_lob_no3) = 5.31 * tmask(:,:,13) 210 trn(:,:,14,jp_lob_no3) = 6.73 * tmask(:,:,14) 211 trn(:,:,15,jp_lob_no3) = 8.32 * tmask(:,:,15) 212 trn(:,:,16,jp_lob_no3) = 10.13 * tmask(:,:,16) 213 trn(:,:,17,jp_lob_no3) = 11.95 * tmask(:,:,17) 214 trn(:,:,18,jp_lob_no3) = 13.57 * tmask(:,:,18) 215 trn(:,:,19,jp_lob_no3) = 15.08 * tmask(:,:,19) 216 trn(:,:,20,jp_lob_no3) = 16.41 * tmask(:,:,20) 217 trn(:,:,21,jp_lob_no3) = 17.47 * tmask(:,:,21) 218 trn(:,:,22,jp_lob_no3) = 18.29 * tmask(:,:,22) 219 trn(:,:,23,jp_lob_no3) = 18.88 * tmask(:,:,23) 220 trn(:,:,24,jp_lob_no3) = 19.30 * tmask(:,:,24) 221 trn(:,:,25,jp_lob_no3) = 19.68 * tmask(:,:,25) 222 trn(:,:,26,jp_lob_no3) = 19.91 * tmask(:,:,26) 223 trn(:,:,27,jp_lob_no3) = 19.99 * tmask(:,:,27) 224 trn(:,:,28,jp_lob_no3) = 20.01 * tmask(:,:,28) 225 trn(:,:,29,jp_lob_no3) = 20.01 * tmask(:,:,29) 226 trn(:,:,30,jp_lob_no3) = 20.01 * tmask(:,:,30) 224 227 225 228 # elif defined key_gyre … … 227 230 ! ---------------------- 228 231 ! here: init NO3=f(density) by asklod AS Kremeur 2005-07 229 trn(:,:,:,jp det) = 0.1 * tmask(:,:,:)230 trn(:,:,:,jp zoo) = 0.1 * tmask(:,:,:)231 trn(:,:,:,jp nh4) = 0.1 * tmask(:,:,:)232 trn(:,:,:,jp phy) = 0.1 * tmask(:,:,:)233 trn(:,:,:,jp dom) = 1.0 * tmask(:,:,:)232 trn(:,:,:,jp_lob_det) = 0.1 * tmask(:,:,:) 233 trn(:,:,:,jp_lob_zoo) = 0.1 * tmask(:,:,:) 234 trn(:,:,:,jp_lob_nh4) = 0.1 * tmask(:,:,:) 235 trn(:,:,:,jp_lob_phy) = 0.1 * tmask(:,:,:) 236 trn(:,:,:,jp_lob_dom) = 1.0 * tmask(:,:,:) 234 237 DO jk = 1, jpk 235 238 DO jj = 1, jpj 236 239 DO ji = 1, jpi 237 240 IF( rhd(ji,jj,jk) <= 24.5e-3 ) THEN 238 trn(ji,jj,jk,jp no3) = 2. * tmask(ji,jj,jk)241 trn(ji,jj,jk,jp_lob_no3) = 2. * tmask(ji,jj,jk) 239 242 ELSE 240 trn(ji,jj,jk,jp no3) = ( 15.55 * ( rhd(ji,jj,jk) * 1000. ) - 380.11 ) * tmask(ji,jj,jk)243 trn(ji,jj,jk,jp_lob_no3) = ( 15.55 * ( rhd(ji,jj,jk) * 1000. ) - 380.11 ) * tmask(ji,jj,jk) 241 244 ENDIF 242 245 END DO … … 259 262 END SUBROUTINE trc_ini_lobster 260 263 264 SUBROUTINE trc_ctl_lobster 265 !!---------------------------------------------------------------------- 266 !! *** ROUTINE trc_ctl_lobster *** 267 !! 268 !! ** Purpose : control the cpp options, namelist and files 269 !!---------------------------------------------------------------------- 270 INTEGER :: jl, jn 271 272 IF(lwp) WRITE(numout,*) 273 IF(lwp) WRITE(numout,*) ' use LOBSTER biological model ' 274 275 ! Check number of tracers 276 ! ----------------------- 277 IF (jp_lobster /= 6) THEN 278 IF (lwp) THEN 279 WRITE (numout,*) ' ===>>>> : w a r n i n g ' 280 WRITE (numout,*) ' ======= ============= ' 281 WRITE (numout,*) & 282 & ' STOP, change jp_lobster to 6 in ' & 283 & ,'par_lobster.F90 ' 284 END IF 285 STOP 'TRC_CTL' 286 END IF 287 ! Check tracer names 288 ! ------------------ 289 IF( ctrcnm(jp_lob_det) /= 'DET' .OR. ctrcnm(jp_lob_zoo) /= 'ZOO' .OR. & 290 & ctrcnm(jp_lob_phy) /= 'PHY' .OR. ctrcnm(jp_lob_no3) /= 'NO3' .OR. & 291 & ctrcnm(jp_lob_nh4) /= 'NH4' .OR. ctrcnm(jp_lob_dom) /= 'DOM' .OR. & 292 & ctrcnl(jp_lob_det) /= 'Detritus' .OR. & 293 & ctrcnl(jp_lob_zoo) /= 'Zooplankton concentration' .OR. & 294 & ctrcnl(jp_lob_phy) /= 'Phytoplankton concentration' .OR. & 295 & ctrcnl(jp_lob_no3) /= 'Nitrate concentration' .OR. & 296 & ctrcnl(jp_lob_nh4) /= 'Ammonium concentration' .OR. & 297 & ctrcnl(jp_lob_dom) /= 'Dissolved organic matter' ) THEN 298 ctrcnm(jp_lob_det)='DET' 299 ctrcnl(jp_lob_det)='Detritus' 300 ctrcnm(jp_lob_zoo)='ZOO' 301 ctrcnl(jp_lob_zoo)='Zooplankton concentration' 302 ctrcnm(jp_lob_phy)='PHY' 303 ctrcnl(jp_lob_phy)='Phytoplankton concentration' 304 ctrcnm(jp_lob_no3)='NO3' 305 ctrcnl(jp_lob_no3)='Nitrate concentration' 306 ctrcnm(jp_lob_nh4)='NH4' 307 ctrcnl(jp_lob_nh4)='Ammonium concentration' 308 ctrcnm(jp_lob_dom)='DOM' 309 ctrcnl(jp_lob_dom)='Dissolved organic matter' 310 IF(lwp) THEN 311 WRITE (numout,*) ' ===>>>> : w a r n i n g ' 312 WRITE (numout,*) ' ======= ============= ' 313 WRITE (numout,*) ' we force tracer names' 314 DO jl = 1, jp_lobster 315 jn = jp_lob0 + jl - 1 316 WRITE(numout,*) ' tracer nb: ',jn,' name = ',ctrcnm(jn), ctrcnl(jn) 317 END DO 318 WRITE(numout,*) ' ' 319 ENDIF 320 ENDIF 321 322 ! Check tracer units 323 DO jl = 1, jp_lobster 324 jn = jp_lob0 + jl - 1 325 IF( ctrcun(jn) /= 'mmole-N/m3') THEN 326 ctrcun(jn) = 'mmole-N/m3' 327 IF(lwp) THEN 328 WRITE (numout,*) ' ===>>>> : w a r n i n g ' 329 WRITE (numout,*) ' ======= ============= ' 330 WRITE (numout,*) ' we force tracer unit' 331 WRITE(numout,*) ' tracer ',ctrcnm(jn), 'UNIT= ',ctrcun(jn) 332 ENDIF 333 ENDIF 334 END DO 335 336 END SUBROUTINE trc_ctl_lobster 337 261 338 #else 262 339 !!---------------------------------------------------------------------- -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/LOBSTER/trcopt.F90
r1953 r2038 78 78 zparg (:,:,1) = zpar0m(:,:) * 0.5 79 79 80 !!gm optimisation : introduce zcoef and LOG computed once for all81 82 80 ! ! Photosynthetically Available Radiation (PAR) 83 81 zcoef = 12 * redf / rcchl / rpig ! -------------------------------------- … … 85 83 DO jj = 1, jpj 86 84 DO ji = 1, jpi 87 !!gm zpig = MAX( TINY(0.), trn(ji,jj,jk-1,jpphy) ) * zcoef 88 !!gm zkr = xkr0 + xkrp * EXP( xlr * LOG(zpig) ) 89 !!gm zkg = xkg0 + xkgp * EXP( xlg * LOG(zpig) ) 90 zpig = LOG( MAX( TINY(0.), trn(ji,jj,jk-1,jpphy) ) * zcoef ) 85 zpig = LOG( MAX( TINY(0.), trn(ji,jj,jk-1,jp_lob_phy) ) * zcoef ) 91 86 zkr = xkr0 + xkrp * EXP( xlr * zpig ) 92 87 zkg = xkg0 + xkgp * EXP( xlg * zpig ) … … 96 91 END DO 97 92 END DO 98 !!gm optimisation : suppress one division99 93 DO jk = 1, jpkm1 ! mean par at t-levels 100 94 DO jj = 1, jpj 101 95 DO ji = 1, jpi 102 zpig = LOG( MAX( TINY(0.), trn(ji,jj,jk,jp phy) ) * zcoef )96 zpig = LOG( MAX( TINY(0.), trn(ji,jj,jk,jp_lob_phy) ) * zcoef ) 103 97 zkr = xkr0 + xkrp * EXP( xlr * zpig ) 104 98 zkg = xkg0 + xkgp * EXP( xlg * zpig ) 105 !!gm zparr(ji,jj,jk) = zparr(ji,jj,jk) / zkr / fse3t(ji,jj,jk) * ( 1 - EXP( -zkr * fse3t(ji,jj,jk) ) )106 !!gm zparg(ji,jj,jk) = zparg(ji,jj,jk) / zkg / fse3t(ji,jj,jk) * ( 1 - EXP( -zkg * fse3t(ji,jj,jk) ) )107 99 zparr(ji,jj,jk) = zparr(ji,jj,jk) / ( zkr * fse3t(ji,jj,jk) ) * ( 1 - EXP( -zkr * fse3t(ji,jj,jk) ) ) 108 100 zparg(ji,jj,jk) = zparg(ji,jj,jk) / ( zkg * fse3t(ji,jj,jk) ) * ( 1 - EXP( -zkg * fse3t(ji,jj,jk) ) ) -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/LOBSTER/trcrst_lobster.F90
r1953 r2038 43 43 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 44 44 45 CALL iom_get( knum, jpdom_autoglo, 'SEDB'//ctrcnm(jp det), sedpocb(:,:) )46 CALL iom_get( knum, jpdom_autoglo, 'SEDN'//ctrcnm(jp det), sedpocn(:,:) )45 CALL iom_get( knum, jpdom_autoglo, 'SEDB'//ctrcnm(jp_lob_det), sedpocb(:,:) ) 46 CALL iom_get( knum, jpdom_autoglo, 'SEDN'//ctrcnm(jp_lob_det), sedpocn(:,:) ) 47 47 48 48 END SUBROUTINE trc_rst_read_lobster … … 64 64 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 65 65 66 CALL iom_rstput( kt, kitrst, knum, 'SEDB'//ctrcnm(jp det), sedpocb(:,:) )67 CALL iom_rstput( kt, kitrst, knum, 'SEDN'//ctrcnm(jp det), sedpocn(:,:) )66 CALL iom_rstput( kt, kitrst, knum, 'SEDB'//ctrcnm(jp_lob_det), sedpocb(:,:) ) 67 CALL iom_rstput( kt, kitrst, knum, 'SEDN'//ctrcnm(jp_lob_det), sedpocn(:,:) ) 68 68 69 69 END SUBROUTINE trc_rst_wri_lobster -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/LOBSTER/trcsed.F90
r1953 r2038 18 18 USE sms_lobster 19 19 USE lbclnk 20 USE trdmld_trc 21 USE trdmld_trc_oce 20 USE trdmod_trc 22 21 USE iom 23 22 USE prtctl_trc ! Print control for debbuging … … 53 52 !! tra = tra + dz(trn wn) 54 53 !! 55 !! IF 'key_ trc_diabio' is defined, the now vertical advection54 !! IF 'key_diabio' is defined, the now vertical advection 56 55 !! trend of passive tracers is saved for futher diagnostics. 57 56 !!--------------------------------------------------------------------- … … 61 60 REAL(wp) :: ztra 62 61 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwork 63 #if defined key_ trc_diaadd&& defined key_iomput62 #if defined key_diatrc && defined key_iomput 64 63 REAL(wp), DIMENSION(jpi,jpj) :: zw2d 65 64 #endif … … 77 76 ! -------------------------------------------- 78 77 79 ! for detritus sedimentation only - jp det78 ! for detritus sedimentation only - jp_lob_det 80 79 zwork(:,:,1 ) = 0.e0 ! surface value set to zero 81 80 zwork(:,:,jpk) = 0.e0 ! bottom value set to zero 82 81 83 #if defined key_ trc_diaadd&& defined key_iomput82 #if defined key_diatrc && defined key_iomput 84 83 zw2d(:,:) = 0. 85 84 # endif … … 87 86 IF( l_trdtrc )THEN 88 87 ALLOCATE( ztrbio(jpi,jpj,jpk) ) 89 ztrbio(:,:,:) = tra(:,:,:,jp det)88 ztrbio(:,:,:) = tra(:,:,:,jp_lob_det) 90 89 ENDIF 91 90 92 91 ! tracer flux at w-point: we use -vsed (downward flux) with simplification : no e1*e2 93 92 DO jk = 2, jpkm1 94 zwork(:,:,jk) = -vsed * trn(:,:,jk-1,jp det)93 zwork(:,:,jk) = -vsed * trn(:,:,jk-1,jp_lob_det) 95 94 END DO 96 95 … … 100 99 DO ji = 1,jpi 101 100 ztra = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / fse3t(ji,jj,jk) 102 tra(ji,jj,jk,jp det) = tra(ji,jj,jk,jpdet) + ztra103 #if defined key_ trc_diabio101 tra(ji,jj,jk,jp_lob_det) = tra(ji,jj,jk,jp_lob_det) + ztra 102 #if defined key_diabio 104 103 trbio(ji,jj,jk,jp_lob0_trd + 7) = ztra 105 104 #endif 106 #if defined key_ trc_diaadd105 #if defined key_diatrc 107 106 # if ! defined key_iomput 108 107 trc2d(ji,jj,jp_lob0_2d + 7) = trc2d(ji,jj,jp_lob0_2d + 7) + ztra * fse3t(ji,jj,jk) * 86400. … … 115 114 END DO 116 115 117 #if defined key_ trc_diabio116 #if defined key_diabio 118 117 jl = jp_lob0_trd + 7 119 118 CALL lbc_lnk (trbio(:,:,1,jl), 'T', 1. ) ! Lateral boundary conditions on trcbio 120 119 #endif 121 #if defined key_ trc_diaadd120 #if defined key_diatrc 122 121 # if ! defined key_iomput 123 122 jl = jp_lob0_2d + 7 … … 131 130 132 131 IF( l_trdtrc ) THEN 133 ztrbio(:,:,:) = tra(:,:,:,jp det) - ztrbio(:,:,:)132 ztrbio(:,:,:) = tra(:,:,:,jp_lob_det) - ztrbio(:,:,:) 134 133 jl = jp_lob0_trd + 7 135 134 CALL trd_mod_trc( ztrbio, jl, kt ) ! handle the trend -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/LOBSTER/trcsms_lobster.F90
r1255 r2038 19 19 USE trcsed 20 20 USE trcexp 21 USE trdmld_trc_oce 21 USE trdmod_oce 22 USE trdmod_trc 22 23 USE trdmld_trc 23 24 … … 50 51 51 52 CALL trc_opt( kt ) ! optical model 52 53 53 CALL trc_bio( kt ) ! biological model 54 55 54 CALL trc_sed( kt ) ! sedimentation model 56 57 55 CALL trc_exp( kt ) ! export 58 56 … … 60 58 DO jn = jp_lob0, jp_lob1 61 59 ztrlob(:,:,:) = tra(:,:,:,jn) 62 CALL trd_mod_trc( ztrlob, jn, jptr c_trd_sms, kt ) ! save trends60 CALL trd_mod_trc( ztrlob, jn, jptra_trd_sms, kt ) ! save trends 63 61 END DO 64 62 END IF -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/MY_TRC/par_my_trc.F90
r1253 r2038 44 44 LOGICAL, PUBLIC, PARAMETER :: lk_my_trc = .TRUE. !: PTS flag 45 45 INTEGER, PUBLIC, PARAMETER :: jp_my_trc = 2 !: number of PTS tracers 46 INTEGER, PUBLIC, PARAMETER :: jp_my_trc_2d = 0 !: additional 2d output arrays ('key_ trc_diaadd')47 INTEGER, PUBLIC, PARAMETER :: jp_my_trc_3d = 0 !: additional 3d output arrays ('key_ trc_diaadd')46 INTEGER, PUBLIC, PARAMETER :: jp_my_trc_2d = 0 !: additional 2d output arrays ('key_diatrc') 47 INTEGER, PUBLIC, PARAMETER :: jp_my_trc_3d = 0 !: additional 3d output arrays ('key_diatrc') 48 48 INTEGER, PUBLIC, PARAMETER :: jp_my_trc_trd = 0 !: number of sms trends for MY_TRC 49 49 -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/MY_TRC/trcini_my_trc.F90
r1542 r2038 37 37 !! ** Method : - Read the namcfc namelist and check the parameter values 38 38 !!---------------------------------------------------------------------- 39 !!---------------------------------------------------------------------- 39 40 ! Control consitency 41 CALL trc_ctl_my_trc 40 42 41 43 IF(lwp) WRITE(numout,*) … … 48 50 END SUBROUTINE trc_ini_my_trc 49 51 52 SUBROUTINE trc_ctl_my_trc 53 !!---------------------------------------------------------------------- 54 !! *** ROUTINE trc_ctl_pisces *** 55 !! 56 !! ** Purpose : control the cpp options, namelist and files 57 !!---------------------------------------------------------------------- 58 59 INTEGER :: jl, jn 60 61 IF(lwp) WRITE(numout,*) 62 IF(lwp) WRITE(numout,*) ' use COLOR tracer ' 63 64 DO jl = 1, jp_my_trc 65 jn = jp_myt0 + jl - 1 66 WRITE(ctrcnm(jn),'(a,i2.2)') 'CLR',jn 67 ctrcnl(jn)='Color concentration' 68 ctrcun(jn)='N/A' 69 END DO 70 71 72 END SUBROUTINE trc_ctl_my_trc 73 50 74 #else 51 75 !!---------------------------------------------------------------------- -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90
r1255 r2038 15 15 USE oce_trc ! Ocean variables 16 16 USE trc ! TOP variables 17 USE trdm ld_trc_oce18 USE trdm ld_trc17 USE trdmod_oce 18 USE trdmod_trc 19 19 20 20 IMPLICIT NONE … … 64 64 DO jn = jp_myt0, jp_myt1 65 65 ztrmyt(:,:,:) = tra(:,:,:,jn) 66 CALL trd_mod_trc( ztrmyt, jn, jptr c_trd_sms, kt ) ! save trends66 CALL trd_mod_trc( ztrmyt, jn, jptra_trd_sms, kt ) ! save trends 67 67 END DO 68 68 END IF -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/p4zflx.F90
r1970 r2038 75 75 REAL(wp) :: zph, zah2, zbot, zdic, zalk, zsch_o2, zalka, zsch_co2 76 76 REAL(wp), DIMENSION(jpi,jpj) :: zkgco2, zkgo2, zh2co3 77 #if defined key_ trc_diaadd&& defined key_iomput77 #if defined key_diatrc && defined key_iomput 78 78 REAL(wp), DIMENSION(jpi,jpj) :: zcflx, zoflx, zkg, zdpco2, zdpo2 79 79 #endif … … 138 138 ! Compute the piston velocity for O2 and CO2 139 139 zkgwan = 0.3 * zws + 2.5 * ( 0.5246 + 0.016256 * ztc + 0.00049946 * ztc2 ) 140 # if defined key_ off_degrad140 # if defined key_degrad 141 141 zkgwan = zkgwan * xconv * ( 1.- fr_i(ji,jj) ) * tmask(ji,jj,1) * facvol(ji,jj,1) 142 142 #else … … 169 169 tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy) + ( zfld16 - zflu16 ) / fse3t(ji,jj,1) 170 170 171 #if defined key_ trc_diaadd171 #if defined key_diatrc 172 172 ! Save diagnostics 173 173 # if ! defined key_iomput … … 228 228 ENDIF 229 229 230 # if defined key_ trc_diaadd&& defined key_iomput230 # if defined key_diatrc && defined key_iomput 231 231 CALL iom_put( "Cflx" , zcflx ) 232 232 CALL iom_put( "Oflx" , zoflx ) -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/p4zlys.F90
r1970 r2038 65 65 REAL(wp) :: zomegaca, zexcess, zexcess0 66 66 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zco3 67 #if defined key_ trc_dia3d&& defined key_iomput67 #if defined key_diatrc && defined key_iomput 68 68 REAL(wp) :: zrfact2 69 69 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zcaldiss … … 76 76 zco3(:,:,:) = 0. 77 77 78 # if defined key_ trc_dia3d&& defined key_iomput78 # if defined key_diatrc && defined key_iomput 79 79 zcaldiss(:,:,:) = 0. 80 80 # endif … … 146 146 ! (ACCORDING TO THIS FORMULATION ALSO SOME PARTICULATE 147 147 ! CACO3 GETS DISSOLVED EVEN IN THE CASE OF OVERSATURATION) 148 # if defined key_ off_degrad148 # if defined key_degrad 149 149 zdispot = kdca * zexcess * trn(ji,jj,jk,jpcal) * facvol(ji,jj,jk) 150 150 # else … … 160 160 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zremco3 161 161 162 # if defined key_ trc_dia3d&& defined key_iomput162 # if defined key_diatrc && defined key_iomput 163 163 zcaldiss(ji,jj,jk) = zremco3 ! calcite dissolution 164 164 # endif … … 167 167 END DO 168 168 169 # if defined key_ trc_diaadd && defined key_trc_dia3d169 # if defined key_diatrc 170 170 # if ! defined key_iomput 171 171 trc3d(:,:,:,jp_pcs0_3d ) = hi (:,:,:) * tmask(:,:,:) -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/p4zmeso.F90
r1970 r2038 74 74 REAL(wp),DIMENSION(jpi,jpj,jpk) :: zgrazfff,zgrazffe 75 75 CHARACTER (len=25) :: charout 76 #if defined key_ trc_diaadd && defined key_trc_dia3d&& defined key_iomput76 #if defined key_diatrc && defined key_iomput 77 77 REAL(wp) :: zrfact2 78 78 #endif … … 102 102 103 103 zcompam = MAX( ( trn(ji,jj,jk,jpmes) - 1.e-9 ), 0.e0 ) 104 # if defined key_ off_degrad104 # if defined key_degrad 105 105 zfact = zstep * tgfunc(ji,jj,jk) * zcompam * facvol(ji,jj,jk) 106 106 # else … … 140 140 141 141 zgraze2 = grazrat2 * zstep * Tgfunc2(ji,jj,jk) * zdenom & 142 # if defined key_ off_degrad142 # if defined key_degrad 143 143 & * facvol(ji,jj,jk) & 144 144 # endif … … 168 168 ! ---------------------------------- 169 169 # if ! defined key_kriest 170 # if ! defined key_ off_degrad170 # if ! defined key_degrad 171 171 zgrazffe(ji,jj,jk) = grazflux * zstep * wsbio4(ji,jj,jk) & 172 172 & * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpmes) … … 181 181 !! zgrazffe(ji,jj,jk) = 0.5 * 1.3e-2 / 5.5e-7 * 0.3 * zstep * wsbio3(ji,jj,jk) & 182 182 !! & * tgfunc(ji,jj,jk) * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpmes) & 183 # if defined key_ off_degrad183 # if defined key_degrad 184 184 !! & * facvol(ji,jj,jk) & 185 185 # endif … … 187 187 !!--------------------------- KRIEST3 ------------------------------------------- 188 188 189 # if ! defined key_ off_degrad189 # if ! defined key_degrad 190 190 zgrazffe(ji,jj,jk) = grazflux * zstep * wsbio3(ji,jj,jk) & 191 191 & * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpmes) … … 202 202 END DO 203 203 204 #if defined key_ trc_dia3d204 #if defined key_diatrc 205 205 ! Total grazing ( grazing by microzoo is already computed in p4zmicro ) 206 206 grazing(:,:,:) = grazing(:,:,:) + ( zgrazd (:,:,:) + zgrazz (:,:,:) + zgrazn(:,:,:) & … … 281 281 282 282 zprcaca = xfracal(ji,jj,jk) * unass2 * zgrazn(ji,jj,jk) 283 #if defined key_ trc_dia3d283 #if defined key_diatrc 284 284 prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 285 285 #endif … … 314 314 END DO 315 315 ! 316 #if defined key_ trc_diaadd && defined key_trc_dia3d&& defined key_iomput316 #if defined key_diatrc && defined key_iomput 317 317 zrfact2 = 1.e3 * rfact2r 318 318 ! Total grazing of phyto by zoo -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/p4zmicro.F90
r1970 r2038 84 84 zgrazpf(:,:,:) = 0. 85 85 86 #if defined key_ trc_dia3d86 #if defined key_diatrc 87 87 grazing(:,:,:) = 0. !: Initialisation of grazing 88 88 #endif … … 95 95 96 96 zcompaz = MAX( ( trn(ji,jj,jk,jpzoo) - 1.e-9 ), 0.e0 ) 97 # if defined key_ off_degrad97 # if defined key_degrad 98 98 zfact = zstep * tgfunc(ji,jj,jk) * zcompaz *facvol(ji,jj,jk) 99 99 # else … … 132 132 133 133 zgraze = grazrat * zstep * tgfunc(ji,jj,jk) & 134 # if defined key_ off_degrad134 # if defined key_degrad 135 135 & * facvol(ji,jj,jk) & 136 136 # endif … … 155 155 END DO 156 156 157 #if defined key_ trc_dia3d157 #if defined key_diatrc 158 158 ! Grazing by microzooplankton 159 159 grazing(:,:,:) = grazing(:,:,:) + zgrazp(:,:,:) + zgrazm(:,:,:) + zgrazsd(:,:,:) … … 220 220 & - (1.-unass) * zgrazmf(ji,jj,jk) 221 221 zprcaca = xfracal(ji,jj,jk) * unass * zgrazp(ji,jj,jk) 222 #if defined key_ trc_dia3d222 #if defined key_diatrc 223 223 prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 224 224 #endif -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/p4zmort.F90
r1953 r2038 89 89 90 90 91 #if defined key_ trc_dia3d91 #if defined key_diatrc 92 92 prodcal(:,:,:) = 0. !: Initialisation of calcite production variable 93 93 #endif … … 103 103 ! ----------------------------------------------------------------- 104 104 zrespp = wchl * 1.e6 * zstep * xdiss(ji,jj,jk) & 105 # if defined key_ off_degrad105 # if defined key_degrad 106 106 & * facvol(ji,jj,jk) & 107 107 # endif … … 113 113 ! ---------------------------------------------------------- 114 114 ztortp = mprat * zstep * trn(ji,jj,jk,jpphy) & 115 # if defined key_ off_degrad115 # if defined key_degrad 116 116 & * facvol(ji,jj,jk) & 117 117 # endif … … 130 130 tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zmortp * zfactfe 131 131 zprcaca = xfracal(ji,jj,jk) * zmortp 132 #if defined key_ trc_dia3d132 #if defined key_diatrc 133 133 prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 134 134 #endif … … 192 192 193 193 zrespp2 = 1.e6 * zstep * ( wchl + wchld * ( 1.- xlimdia(ji,jj,jk) ) ) & 194 # if defined key_ off_degrad194 # if defined key_degrad 195 195 & * facvol(ji,jj,jk) & 196 196 # endif … … 201 201 ! ------------------------ 202 202 ztortp2 = mprat2 * zstep * trn(ji,jj,jk,jpdia) & 203 # if defined key_ off_degrad203 # if defined key_degrad 204 204 & * facvol(ji,jj,jk) & 205 205 # endif -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/p4zopt.F90
r1970 r2038 16 16 USE trc ! tracer variables 17 17 USE oce_trc ! tracer-ocean share variables 18 USE trc_oce ! ocean-tracer share variables19 18 USE sms_pisces ! Source Minus Sink of PISCES 20 19 USE iom … … 227 226 END DO 228 227 229 #if defined key_ trc_diaadd228 #if defined key_diatrc 230 229 # if ! defined key_iomput 231 230 ! save for outputs -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/p4zprod.F90
r1970 r2038 79 79 REAL(wp) :: zpislopen , zpislope2n 80 80 REAL(wp) :: zrum, zcodel, zargu, zvol 81 #if defined key_ trc_diaadd && defined key_trc_dia3d81 #if defined key_diatrc 82 82 REAL(wp) :: zrfact2 83 83 #endif … … 109 109 ! Computation of the optimal production 110 110 111 # if defined key_ off_degrad111 # if defined key_degrad 112 112 prmax(:,:,:) = 0.6 / rday * tgfunc(:,:,:) * facvol(:,:,:) 113 113 # else … … 335 335 DO ji = 1, jpi 336 336 zvol = cvol(ji,jj,jk) 337 #if defined key_ off_degrad337 #if defined key_degrad 338 338 zvol = zvol * facvol(ji,jj,jk) 339 339 #endif … … 353 353 ENDIF 354 354 355 #if defined key_ trc_diaadd && defined key_trc_dia3d&& ! defined key_iomput355 #if defined key_diatrc && ! defined key_iomput 356 356 ! Supplementary diagnostics 357 357 zrfact2 = 1.e3 * rfact2r … … 367 367 #endif 368 368 369 #if defined key_ trc_diaadd && defined key_trc_dia3d&& defined key_iomput369 #if defined key_diatrc && defined key_iomput 370 370 zrfact2 = 1.e3 * rfact2r 371 371 IF ( jnt == nrdttrc ) then -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/p4zrem.F90
r1953 r2038 136 136 ! ---------------------------------------------------------------- 137 137 zremik = xremik * xstep / 1.e-6 * xlimbac(ji,jj,jk) & 138 # if defined key_ off_degrad138 # if defined key_degrad 139 139 & * facvol(ji,jj,jk) & 140 140 # endif … … 172 172 ! ---------------------------------------------------------- 173 173 zonitr = nitrif * xstep * trn(ji,jj,jk,jpnh4) / ( 1.+ emoy(ji,jj,jk) ) & 174 # if defined key_ off_degrad174 # if defined key_degrad 175 175 & * facvol(ji,jj,jk) & 176 176 # endif … … 234 234 ! ------------------------------------------------------------- 235 235 zremip = xremip * xstep * tgfunc(ji,jj,jk) & 236 # if defined key_ off_degrad236 # if defined key_degrad 237 237 & * facvol(ji,jj,jk) & 238 238 # endif … … 289 289 zsatur2 = zsatur * ( 1. + tn(ji,jj,jk) / 400.)**4 290 290 znusil = 0.225 * ( 1. + tn(ji,jj,jk) / 15.) * zsatur + 0.775 * zsatur2**9 291 # if defined key_ off_degrad291 # if defined key_degrad 292 292 zsiremin = xsirem * xstep * znusil * facvol(ji,jj,jk) 293 293 # else … … 350 350 #endif 351 351 352 # if defined key_ off_degrad352 # if defined key_degrad 353 353 zscave = zfeequi * zlam1b * xstep * facvol(ji,jj,jk) 354 354 # else … … 374 374 #endif 375 375 376 # if defined key_ off_degrad376 # if defined key_degrad 377 377 zaggdfe = zlam1b * xstep * 0.5 * ( trn(ji,jj,jk,jpfer) - zfeequi ) * facvol(ji,jj,jk) 378 378 # else -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/p4zsed.F90
r1970 r2038 93 93 REAL(wp), DIMENSION(jpi,jpj) :: zsidep 94 94 REAL(wp), DIMENSION(jpi,jpj,jpk) :: znitrpot, zirondep 95 #if defined key_dia add || defined key_trc_dia3d95 #if defined key_diatrc 96 96 REAL(wp) :: zrfact2 97 97 # if defined key_iomput … … 286 286 IF( zlim <= 0.2 ) zlim = 0.01 287 287 znitrpot(ji,jj,jk) = MAX( 0.e0, ( 0.6 * tgfunc(ji,jj,jk) - 2.15 ) / rday ) & 288 # if defined key_ off_degrad288 # if defined key_degrad 289 289 & * facvol(ji,jj,jk) & 290 290 # endif … … 325 325 END DO 326 326 327 #if defined key_ trc_diaadd || defined key_trc_dia3d327 #if defined key_diatrc 328 328 zrfact2 = 1.e+3 * rfact2r 329 329 # if ! defined key_iomput -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/p4zsink.F90
r1970 r2038 97 97 REAL(wp) :: zdiv , zdiv1, zdiv2, zdiv3, zdiv4, zdiv5 98 98 REAL(wp) :: zval1, zval2, zval3, zval4 99 #if defined key_ trc_diaadd99 #if defined key_diatrc 100 100 REAL(wp) :: zrfact2 101 101 INTEGER :: ik1 … … 207 207 & * (zfm*xkr_mass_max**2-xkr_mass_min**2) & 208 208 & * (zeps-1.)**2/(zdiv2*zdiv3)) & 209 # if defined key_ off_degrad209 # if defined key_degrad 210 210 & *facvol(ji,jj,jk) & 211 211 # endif … … 219 219 & -zfm*xkr_mass_max**3*(1.+3.*((zeps-1.)/ & 220 220 & (zeps-2.)+(zeps-1.)/zdiv3)+(zeps-1.)/zdiv1)) & 221 # if defined key_ off_degrad221 # if defined key_degrad 222 222 & *facvol(ji,jj,jk) & 223 223 # endif … … 225 225 226 226 zagg3 = ( 0.163*trn(ji,jj,jk,jpnum)**2*zfm**2*8. * xkr_mass_max**3 & 227 # if defined key_ off_degrad227 # if defined key_degrad 228 228 & *facvol(ji,jj,jk) & 229 229 # endif … … 242 242 & ((zfm*zfm*xkr_mass_max**2*zsm-xkr_mass_min**2) & 243 243 & *xkr_eta)/(zdiv*zdiv3*zdiv5) ) & 244 # if defined key_ off_degrad244 # if defined key_degrad 245 245 & *facvol(ji,jj,jk) & 246 246 # endif … … 252 252 & /zdiv3-(xkr_mass_min**2-zfm*zsm*xkr_mass_max**2) & 253 253 & /zdiv) & 254 # if defined key_ off_degrad254 # if defined key_degrad 255 255 & *facvol(ji,jj,jk) & 256 256 # endif … … 266 266 zaggdoc = ( 0.4 * trn(ji,jj,jk,jpdoc) & 267 267 & + 1018. * trn(ji,jj,jk,jppoc) ) * xstep & 268 # if defined key_ off_degrad268 # if defined key_degrad 269 269 & * facvol(ji,jj,jk) & 270 270 # endif … … 281 281 END DO 282 282 283 #if defined key_ trc_diaadd283 #if defined key_diatrc 284 284 zrfact2 = 1.e3 * rfact2r 285 285 ik1 = iksed + 1 … … 474 474 REAL(wp) :: zagg , zaggfe, zaggdoc, zaggdoc2 475 475 REAL(wp) :: zfact, zwsmax 476 #if defined key_ trc_dia3d476 #if defined key_diatrc 477 477 REAL(wp) :: zrfact2 478 478 INTEGER :: ik1 … … 552 552 zfact = xstep * xdiss(ji,jj,jk) 553 553 ! Part I : Coagulation dependent on turbulence 554 # if defined key_ off_degrad554 # if defined key_degrad 555 555 zagg1 = 940.* zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc) * facvol(ji,jj,jk) 556 556 zagg2 = 1.054e4 * zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc) * facvol(ji,jj,jk) … … 563 563 564 564 ! Aggregation of small into large particles 565 # if defined key_ off_degrad565 # if defined key_degrad 566 566 zagg3 = 0.66 * xstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc) * facvol(ji,jj,jk) 567 567 zagg4 = 0.e0 * xstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc) * facvol(ji,jj,jk) … … 574 574 575 575 ! Aggregation of DOC to small particles 576 #if defined key_ off_degrad576 #if defined key_degrad 577 577 zaggdoc = ( 80.* trn(ji,jj,jk,jpdoc) + 698. * trn(ji,jj,jk,jppoc) ) & 578 578 & * facvol(ji,jj,jk) * zfact * trn(ji,jj,jk,jpdoc) … … 595 595 END DO 596 596 597 #if defined key_ trc_diaadd597 #if defined key_diatrc 598 598 zrfact2 = 1.e3 * rfact2r 599 599 ik1 = iksed + 1 … … 651 651 652 652 DO jk = 1, jpkm1 653 # if defined key_ off_degrad653 # if defined key_degrad 654 654 zwsink2(:,:,jk+1) = -pwsink(:,:,jk) / rday * tmask(:,:,jk+1) * facvol(:,:,jk) 655 655 # else -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/par_pisces.F90
r1152 r2038 30 30 LOGICAL, PUBLIC, PARAMETER :: lk_kriest = .TRUE. !: Kriest flag 31 31 INTEGER, PUBLIC, PARAMETER :: jp_pisces = 23 !: number of passive tracers 32 INTEGER, PUBLIC, PARAMETER :: jp_pisces_2d = 13 !: additional 2d output ('key_ trc_diaadd')33 INTEGER, PUBLIC, PARAMETER :: jp_pisces_3d = 18 !: additional 3d output ('key_ trc_diaadd')32 INTEGER, PUBLIC, PARAMETER :: jp_pisces_2d = 13 !: additional 2d output ('key_diatrc') 33 INTEGER, PUBLIC, PARAMETER :: jp_pisces_3d = 18 !: additional 3d output ('key_diatrc') 34 34 INTEGER, PUBLIC, PARAMETER :: jp_pisces_trd = 1 !: number of sms trends for PISCES 35 35 … … 68 68 LOGICAL, PUBLIC, PARAMETER :: lk_kriest = .FALSE. !: Kriest flag 69 69 INTEGER, PUBLIC, PARAMETER :: jp_pisces = 24 !: number of PISCES passive tracers 70 INTEGER, PUBLIC, PARAMETER :: jp_pisces_2d = 13 !: additional 2d output ('key_ trc_diaadd')71 INTEGER, PUBLIC, PARAMETER :: jp_pisces_3d = 11 !: additional 3d output ('key_ trc_diaadd')70 INTEGER, PUBLIC, PARAMETER :: jp_pisces_2d = 13 !: additional 2d output ('key_diatrc') 71 INTEGER, PUBLIC, PARAMETER :: jp_pisces_3d = 11 !: additional 3d output ('key_diatrc') 72 72 INTEGER, PUBLIC, PARAMETER :: jp_pisces_trd = 1 !: number of sms trends for PISCES 73 73 -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/sms_pisces.F90
r1970 r2038 62 62 REAL(wp), DIMENSION(jpi,jpj,jpk) :: xlimbac !: ?? 63 63 REAL(wp), DIMENSION(jpi,jpj,jpk) :: xdiss !: ?? 64 #if defined key_ trc_dia3d64 #if defined key_diatrc 65 65 REAL(wp), DIMENSION(jpi,jpj,jpk) :: prodcal !: Calcite production 66 66 REAL(wp), DIMENSION(jpi,jpj,jpk) :: grazing !: Total zooplankton grazing -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/trcini_pisces.F90
r1953 r2038 55 55 56 56 57 ! Control consitency 58 CALL trc_ctl_pisces 59 60 57 61 IF(lwp) WRITE(numout,*) 58 62 IF(lwp) WRITE(numout,*) ' trc_ini_pisces : PISCES biochemical model initialisation' 59 63 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 60 64 61 62 65 ! ! Time-step 63 rfact = rdttra(1) * float(n dttrc) ! ---------66 rfact = rdttra(1) * float(nn_dttrc) ! --------- 64 67 rfactr = 1. / rfact 65 68 rfact2 = rfact / float(nrdttrc) … … 128 131 ! 129 132 END SUBROUTINE trc_ini_pisces 130 133 134 SUBROUTINE trc_ctl_pisces 135 !!---------------------------------------------------------------------- 136 !! *** ROUTINE trc_ctl_pisces *** 137 !! 138 !! ** Purpose : control the cpp options, namelist and files 139 !!---------------------------------------------------------------------- 140 141 IF(lwp) WRITE(numout,*) 142 IF(lwp) WRITE(numout,*) ' use PISCES biological model ' 143 144 ! Check number of tracers 145 ! ----------------------- 146 #if defined key_kriest 147 IF( jp_pisces /= 23) THEN 148 #else 149 IF( jp_pisces /= 24) THEN 150 #endif 151 IF (lwp) THEN 152 WRITE (numout,*) ' ===>>>> : w a r n i n g ' 153 WRITE (numout,*) ' ======= ============= ' 154 WRITE (numout,*) & 155 & ' STOP, change jp_pisces', & 156 & ' in par_pisces.F90' 157 END IF 158 STOP 'TRC_CTL' 159 END IF 160 161 END SUBROUTINE trc_ctl_pisces 162 131 163 #else 132 164 !!---------------------------------------------------------------------- -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/trcrst_pisces.F90
r1970 r2038 130 130 DO ji = 1, jpi 131 131 zvol = cvol(ji,jj,jk) 132 # if defined key_ off_degrad132 # if defined key_degrad 133 133 zvol = zvol * facvol(ji,jj,jk) 134 134 # endif -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/trcsms_pisces.F90
r1753 r2038 26 26 USE p4zflx ! 27 27 28 USE trdm ld_trc_oce29 USE trdm ld_trc28 USE trdmod_oce 29 USE trdmod_trc 30 30 31 31 USE sedmodel … … 94 94 DO jn = jp_pcs0, jp_pcs1 95 95 ztrpis(:,:,:) = tra(:,:,:,jn) 96 CALL trd_mod_trc( ztrpis, jn, jptr c_trd_sms, kt ) ! save trends96 CALL trd_mod_trc( ztrpis, jn, jptra_trd_sms, kt ) ! save trends 97 97 END DO 98 98 END IF -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/oce_trc.F90
r1753 r2038 32 32 USE par_oce , ONLY : jpkdta => jpkdta !: number of levels > or = jpk 33 33 USE par_oce , ONLY : lk_esopa => lk_esopa !: flag to activate the all option 34 USE par_oce , ONLY : jp_tem => jp_tem !: indice for temperature 35 USE par_oce , ONLY : jp_sal => jp_sal !: indice for salinity 34 36 35 37 !* IO manager * … … 112 114 USE dom_oce , ONLY : ln_zco => ln_zco !: z-coordinate flag 113 115 USE dom_oce , ONLY : lk_zco => lk_zco !: z-coordinate flag (1D or 3D arrays) 114 USE dom_oce , ONLY : hbatt => 115 USE dom_oce , ONLY : hbatu => 116 USE dom_oce , ONLY : hbatv => 117 USE dom_oce , ONLY : gsigt => 118 USE dom_oce , ONLY : gsigw => 119 USE dom_oce , ONLY : gsi3w => 120 USE dom_oce , ONLY : esigt => 121 USE dom_oce , ONLY : esigw => 122 USE dom_oce , ONLY : lk_vvl => lk_vvl !: variable grid flag116 USE dom_oce , ONLY : hbatt => hbatt !: ocean depth at the vertical of t-point (m) 117 USE dom_oce , ONLY : hbatu => hbatu !: ocean depth at the vertical of u-point (m) 118 USE dom_oce , ONLY : hbatv => hbatv !: ocean depth at the vertical of w-point (m) 119 USE dom_oce , ONLY : gsigt => gsigt !: model level depth coefficient at T-levels 120 USE dom_oce , ONLY : gsigw => gsigw !: model level depth coefficient at W-levels 121 USE dom_oce , ONLY : gsi3w => gsi3w !: model level depth coef at w-levels (defined as the sum of e3w) 122 USE dom_oce , ONLY : esigt => esigt !: vertical scale factor coef. at t-levels 123 USE dom_oce , ONLY : esigw => esigw !: vertical scale factor coef. at w-levels 124 USE dom_oce , ONLY : lk_vvl => lk_vvl !: variable grid flag 123 125 124 126 !* masks, bathymetry * … … 129 131 USE dom_oce , ONLY : vmask => vmask !: land/ocean mask at v-points 130 132 USE dom_oce , ONLY : fmask => fmask !: land/ocean mask at f-points 131 # if defined key_ off_degrad133 # if defined key_degrad 132 134 USE dom_oce , ONLY : facvol => facvol !: volume factor for degradation 133 135 # endif … … 166 168 USE oce , ONLY : tn => tn !: pot. temperature (celsius) 167 169 USE oce , ONLY : sn => sn !: salinity (psu) 170 USE oce , ONLY : tsn => tsn !: 4D array contaning ( tn, sn ) 171 USE oce , ONLY : tsb => tsb !: 4D array contaning ( tb, sb ) 172 USE oce , ONLY : tsa => tsa !: 4D array contaning ( ta, sa ) 168 173 USE oce , ONLY : rhop => rhop !: potential volumic mass (kg m-3) 169 174 USE oce , ONLY : rhd => rhd !: in situ density anomalie rhd=(rho-rau0)/rau0 (no units) 170 175 USE oce , ONLY : hdivn => hdivn !: horizontal divergence (1/s) 171 #if defined key_off_tra 176 USE oce , ONLY : l_traldf_rot => l_traldf_rot !: rotated laplacian operator for lateral diffusion 177 #if defined key_offline 172 178 USE oce , ONLY : gtu => gtu !: t-, s- and rd horizontal gradient at u- and 173 179 USE oce , ONLY : gsu => gsu !: v-points at bottom ocean level … … 196 202 USE sbcrnf , ONLY : rnfmsk_z => rnfmsk_z !: mixed adv scheme in runoffs vicinity (vert.) 197 203 198 !* bottom boundary layer * 199 # if defined key_trabbl_dif || defined key_trabbl_adv 200 # if ! defined key_off_tra 201 USE trabbl , ONLY : atrbbl => rn_ahtbbl !: lateral coeff. for bottom boundary layer scheme (m2/s) 202 # else 203 USE trabbl, ONLY : bblx => bblx !: ??? 204 USE trabbl, ONLY : bbly => bbly !: ??? 205 # endif 206 # endif 204 USE trc_oce 207 205 208 206 !* lateral diffusivity (tracers) * -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/par_trc.F90
r1970 r2038 40 40 LOGICAL, PUBLIC, PARAMETER :: lk_trc_c1d = .FALSE. !: 1D pass. tracer configuration flag 41 41 # endif 42 ! Passive tracers : size for TRP trends diagnotics (used if 'key_trc_diatrd' defined)43 # if defined key_trc_diatrd44 ! Passive tracers : size for TRP trends diagnotics (used if 'key_trc_diatrd' defined)45 INTEGER, PARAMETER :: jptrc_xad = 1 !: x- horizontal advection46 INTEGER, PARAMETER :: jptrc_yad = 2 !: y- horizontal advection47 INTEGER, PARAMETER :: jptrc_zad = 3 !: z- vertical advection48 INTEGER, PARAMETER :: jptrc_xdf = 4 !: lateral diffusion49 INTEGER, PARAMETER :: jptrc_ydf = 5 !: lateral diffusion50 INTEGER, PARAMETER :: jptrc_zdf = 6 !: vertical diffusion (Kz)51 INTEGER, PARAMETER :: jptrc_sbc = 7 !: surface boundary condition52 #if ! defined key_trcldf_eiv && ! defined key_trcdmp53 INTEGER, PARAMETER :: jpdiatrc = 7 !: trends: 3*(advection + diffusion ) + sbc54 #endif55 #if defined key_trcldf_eiv && defined key_trcdmp56 INTEGER, PARAMETER :: jptrc_xei = 8 !: x- horiz. EIV advection57 INTEGER, PARAMETER :: jptrc_yei = 9 !: y- horiz. EIV advection58 INTEGER, PARAMETER :: jptrc_zei = 10 !: z- vert. EIV advection59 INTEGER, PARAMETER :: jptrc_dmp = 11 !: damping60 INTEGER, PARAMETER :: jpdiatrc = 11 !: trends: 3*(advection + diffusion + eiv ) + sbc + damping61 #endif62 #if defined key_trcldf_eiv && ! defined key_trcdmp63 INTEGER, PARAMETER :: jptrc_xei = 8 !: x- horiz. EIV advection64 INTEGER, PARAMETER :: jptrc_yei = 9 !: y- horiz. EIV advection65 INTEGER, PARAMETER :: jptrc_zei = 10 !: z- vert. EIV advection66 INTEGER, PARAMETER :: jpdiatrc = 10 !: trends: 3*(advection + diffusion + eiv ) + sbc67 #endif68 #if ! defined key_trcldf_eiv && defined key_trcdmp69 INTEGER, PARAMETER :: jptrc_dmp = 8 !: damping70 INTEGER, PARAMETER :: jpdiatrc = 8 !: trends: 3*(advection + diffusion ) + sbc + damping71 #endif72 #endif73 42 74 43 REAL(wp), PUBLIC :: rtrn = 1.e-15 !: truncation value -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/trc.F90
r1542 r2038 34 34 INTEGER, PUBLIC :: numnat !: the number of the passive tracer NAMELIST 35 35 LOGICAL, PUBLIC, DIMENSION(jptra) :: lutini !: initialisation from FILE or not (NAMELIST) 36 LOGICAL, PUBLIC, DIMENSION(jptra) :: lutsav !: logical for saving tracer or not 37 INTEGER, PUBLIC, DIMENSION(jptra) :: nutini !: FORTRAN LOGICAL UNIT for initialisation file 36 LOGICAL, PUBLIC, DIMENSION(jptra) :: lutsav !: save the tracer or not 38 37 39 38 !! passive tracers fields (before,now,after) … … 47 46 REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk,jptra) :: trb !: traceur concentration for before time step 48 47 48 !! isopycnal scheme for passive tracers 49 !! ------------------------------------ 50 REAL(wp), PUBLIC :: ahtrb0 !: background diffusivity coefficient for passive tracer (m2/s) 51 52 #if ! defined key_zco 53 !! interpolated gradient 54 !!-------------------------------------------------- 55 REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jptra) :: gtru !: horizontal gradient at u-points at bottom ocean level 56 REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jptra) :: gtrv !: horizontal gradient at v-points at bottom ocean level 57 #endif 49 58 50 59 !! passive tracers restart (input and output) 51 60 !! ------------------------------------------ 52 INTEGER , PUBLIC :: n dttrc!: frequency of step on passive tracers53 INTEGER , PUBLIC :: nittrc000 !: first time step of passive tracers model54 LOGICAL , PUBLIC :: ln_rsttr !: boolean term for restart i/o for passive tracers (namelist)55 LOGICAL , PUBLIC :: lrst_trc !: logical to control the trc restart write56 INTEGER , PUBLIC :: nutwrs !: output FILE for passive tracers restart57 INTEGER , PUBLIC :: nutrst !: logical unit for restart FILE for passive tracers58 INTEGER , PUBLIC :: n rsttr!: control of the time step ( 0 or 1 ) for pass. tr.61 INTEGER , PUBLIC :: nn_dttrc !: frequency of step on passive tracers 62 INTEGER , PUBLIC :: nittrc000 !: first time step of passive tracers model 63 LOGICAL , PUBLIC :: ln_rsttr !: boolean term for restart i/o for passive tracers (namelist) 64 LOGICAL , PUBLIC :: lrst_trc !: logical to control the trc restart write 65 INTEGER , PUBLIC :: nutwrs !: output FILE for passive tracers restart 66 INTEGER , PUBLIC :: nutrst !: logical unit for restart FILE for passive tracers 67 INTEGER , PUBLIC :: nn_rsttr !: control of the time step ( 0 or 1 ) for pass. tr. 59 68 CHARACTER(len=50) :: cn_trcrst_in !: suffix of pass. tracer restart name (input) 60 69 CHARACTER(len=50) :: cn_trcrst_out !: suffix of pass. tracer restart name (output) … … 62 71 !! information for outputs 63 72 !! -------------------------------------------------- 64 INTEGER , PUBLIC :: n writetrc !: time step frequency for concentration outputs (namelist)73 INTEGER , PUBLIC :: nn_writetrc !: time step frequency for concentration outputs (namelist) 65 74 66 # if defined key_ trc_diaadd&& ! defined key_iomput75 # if defined key_diatrc && ! defined key_iomput 67 76 !! additional 2D/3D outputs namelist 68 77 !! -------------------------------------------------- … … 80 89 # endif 81 90 82 #if defined key_ trc_diabio || defined key_trdmld_trc91 #if defined key_diabio || defined key_trdmld_trc 83 92 CHARACTER(len=8), DIMENSION(jpdiabio) :: ctrbio !: biological trends name (NAMELIST) 84 93 CHARACTER(len=20), DIMENSION(jpdiabio) :: ctrbiu !: biological trends unit (NAMELIST) … … 86 95 INTEGER :: nwritebio !: time step frequency for biological outputs (NAMELIST) 87 96 #endif 88 # if defined key_ trc_diabio97 # if defined key_diabio 89 98 !! Biological trends 90 99 !! ----------------- -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/trcdia.F90
r1970 r2038 17 17 !! trc_dia : main routine of output passive tracer 18 18 !! trcdit_wr : outputs of concentration fields 19 !! trcdid_wr : outputs of dvection-diffusion trends20 19 !! trcdii_wr : outputs of additional 2D/3D diagnostics 21 20 !! trcdib_wr : outputs of biological fields … … 24 23 USE oce_trc 25 24 USE trc 26 USE trp_trc27 25 USE par_trc 28 USE trdmld_trc_oce, ONLY : luttrd29 26 USE dianam ! build name of file (routine) 30 27 USE in_out_manager ! I/O manager … … 45 42 INTEGER , DIMENSION (jpij*jpk) :: ndext50 !: integer arrays for ocean 3D index 46 43 INTEGER , DIMENSION (jpij) :: ndext51 !: integer arrays for ocean surface index 47 # if defined key_ trc_diaadd44 # if defined key_diatrc 48 45 INTEGER :: nitd !: id for additional array output file 49 46 INTEGER :: ndepitd !: id for depth mesh 50 47 INTEGER :: nhoritd !: id for horizontal mesh 51 48 # endif 52 # if defined key_trc_diatrd 53 INTEGER , DIMENSION (jptra) :: nit6 !: id for additional array output file 54 INTEGER , DIMENSION (jptra) :: ndepit6 !: id for depth mesh 55 INTEGER , DIMENSION (jptra) :: nhorit6 !: id for horizontal mesh 56 # endif 57 # if defined key_trc_diabio 49 # if defined key_diabio 58 50 INTEGER :: nitb !: id. for additional array output file 59 51 INTEGER :: ndepitb !: id for depth mesh … … 82 74 83 75 CALL trcdit_wr( kt, kindic ) ! outputs for tracer concentration 84 CALL trcdid_wr( kt, kindic ) ! outputs for dynamical trends85 76 CALL trcdii_wr( kt, kindic ) ! outputs for additional arrays 86 77 CALL trcdib_wr( kt, kindic ) ! outputs for biological trends … … 111 102 LOGICAL :: ll_print = .FALSE. 112 103 CHARACTER (len=40) :: clhstnam, clop 113 #if defined key_off _tra104 #if defined key_offline 114 105 INTEGER :: inum = 11 ! temporary logical unit 115 106 #endif … … 133 124 ENDIF 134 125 # if defined key_diainstant 135 zsto = n writetrc * rdt126 zsto = nn_writetrc * rdt 136 127 clop = "inst("//TRIM(clop)//")" 137 128 # else … … 139 130 clop = "ave("//TRIM(clop)//")" 140 131 # endif 141 zout = n writetrc * zdt132 zout = nn_writetrc * zdt 142 133 143 134 ! Define indices of the horizontal output zoom and vertical limit storage … … 168 159 & ' limit storage in depth = ', ipk 169 160 170 #if defined key_off _tra161 #if defined key_offline 171 162 ! WRITE root name in date.file for use by postpro 172 163 IF(lwp) THEN 173 CALL dia_nam( clhstnam, n writetrc,' ' )164 CALL dia_nam( clhstnam, nn_writetrc,' ' ) 174 165 CALL ctlopn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', 1, numout, lwp, narea ) 175 166 WRITE(inum,*) clhstnam … … 179 170 180 171 ! Define the NETCDF files for passive tracer concentration 181 CALL dia_nam( clhstnam, n writetrc, 'ptrc_T' )172 CALL dia_nam( clhstnam, nn_writetrc, 'ptrc_T' ) 182 173 IF(lwp)WRITE(numout,*)" Name of NETCDF file ", clhstnam 183 174 … … 216 207 ! --------------------------------------- 217 208 218 IF( lwp .AND. MOD( itmod, n writetrc ) == 0 ) THEN209 IF( lwp .AND. MOD( itmod, nn_writetrc ) == 0 ) THEN 219 210 WRITE(numout,*) 'trcdit_wr : write NetCDF passive tracer concentrations at ', kt, 'time-step' 220 211 WRITE(numout,*) '~~~~~~~~~ ' … … 233 224 END SUBROUTINE trcdit_wr 234 225 235 # if defined key_trc_diatrd 236 237 SUBROUTINE trcdid_wr( kt, kindic ) 238 !!---------------------------------------------------------------------- 239 !! *** ROUTINE trcdid_wr *** 240 !! 241 !! ** Purpose : output of passive tracer : advection-diffusion trends 242 !! 243 !! ** Method : At the beginning of the first time step (nit000), define all 244 !! the NETCDF files and fields for concentration of passive tracer 245 !! 246 !! At each time step call histdef to compute the mean if necessary 247 !! Each nwritetrd time step, output the instantaneous or mean fields 248 !! 249 !! IF kindic <0, output of fields before the model interruption. 250 !! IF kindic =0, time step loop 251 !! IF kindic >0, output of fields before the time step loop 252 !!---------------------------------------------------------------------- 253 INTEGER, INTENT( in ) :: kt ! ocean time-step 254 INTEGER, INTENT( in ) :: kindic ! indicator of abnormal termination 255 !! 256 LOGICAL :: ll_print = .FALSE. 257 CHARACTER (len=40) :: clhstnam, clop 258 CHARACTER (len=20) :: cltra, cltrau 259 CHARACTER (len=80) :: cltral 260 CHARACTER (len=10) :: csuff 261 INTEGER :: jn, jl, ikn 262 INTEGER :: iimi, iima, ijmi, ijma, ipk, it, itmod 263 REAL(wp) :: zsto, zout, zdt 264 !!---------------------------------------------------------------------- 265 266 ! 0. Initialisation 267 ! ----------------- 268 269 270 ! local variable for debugging 271 ll_print = .FALSE. 272 ll_print = ll_print .AND. lwp 273 ! 274 ! Define frequency of output and means 275 zdt = rdt 276 IF( ln_mskland ) THEN ; clop = "only(x)" ! put 1.e+20 on land (very expensive!!) 277 ELSE ; clop = "x" ! no use of the mask value (require less cpu time) 278 ENDIF 279 # if defined key_diainstant 280 zsto = nwritetrd * rdt 281 clop = "inst("//TRIM(clop)//")" 282 # else 283 zsto = zdt 284 clop = "ave("//TRIM(clop)//")" 285 # endif 286 zout = nwritetrd * zdt 287 288 ! Define indices of the horizontal output zoom and vertical limit storage 289 iimi = 1 ; iima = jpi 290 ijmi = 1 ; ijma = jpj 291 ipk = jpk 292 293 ! define time axis 294 itmod = kt - nittrc000 + 1 295 it = kt 296 297 ! Define the NETCDF files (one per tracer) 298 IF( ll_print ) WRITE(numout,*) 'trcdid kt=', kt, ' kindic ', kindic 299 300 301 IF( kt == nittrc000 ) THEN 302 303 DO jn = 1, jptra 304 ! 305 IF( luttrd(jn) ) THEN ! Define the file for dynamical trends - one per each tracer IF required 306 307 IF(lwp)WRITE(numout,*) ' indexes of zoom = ', iimi, iima, ijmi, ijma, & 308 & ' limit storage in depth = ', ipk 309 csuff='DY_'//ctrcnm(jn) 310 CALL dia_nam( clhstnam, nwritetrd, csuff ) 311 IF(lwp)WRITE(numout,*) " Name of NETCDF file for dynamical trends", & 312 & " of tracer number : ",clhstnam 313 314 CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & 315 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 316 & nittrc000-ndttrc, zjulian, zdt, nhorit6(jn), & 317 & nit6(jn) , domain_id=nidom ) 318 319 ! Vertical grid for tracer trend - one per each tracer IF needed 320 CALL histvert( nit6(jn), 'deptht', 'Vertical T levels', 'm', ipk, gdept_0, ndepit6(jn) ) 321 END IF 322 END DO 323 324 ! Declare all the output fields as NETCDF variables 325 DO jn = 1, jptra 326 IF( luttrd(jn) ) THEN 327 DO jl = 1, jpdiatrc 328 IF( jl == jptrc_xad ) THEN 329 ! short and long title for x advection for tracer 330 WRITE (cltra,'("XAD_",16a)') ctrcnm(jn) 331 WRITE (cltral,'("X advective trend for ",58a)') ctrcnl(jn)(1:58) 332 END IF 333 IF( jl == jptrc_yad ) THEN 334 ! short and long title for y advection for tracer 335 WRITE (cltra,'("YAD_",16a)') ctrcnm(jn) 336 WRITE (cltral,'("Y advective trend for ",58a)') ctrcnl(jn)(1:58) 337 END IF 338 IF( jl == jptrc_zad ) THEN 339 ! short and long title for Z advection for tracer 340 WRITE (cltra,'("ZAD_",16a)') ctrcnm(jn) 341 WRITE (cltral,'("Z advective trend for ",58a)') ctrcnl(jn)(1:58) 342 END IF 343 IF( jl == jptrc_xdf ) THEN 344 ! short and long title for X diffusion for tracer 345 WRITE (cltra,'("XDF_",16a)') ctrcnm(jn) 346 WRITE (cltral,'("X diffusion trend for ",58a)') ctrcnl(jn)(1:58) 347 END IF 348 IF( jl == jptrc_ydf ) THEN 349 ! short and long title for Y diffusion for tracer 350 WRITE (cltra,'("YDF_",16a)') ctrcnm(jn) 351 WRITE (cltral,'("Y diffusion trend for ",58a)') ctrcnl(jn)(1:58) 352 END IF 353 IF( jl == jptrc_zdf ) THEN 354 ! short and long title for Z diffusion for tracer 355 WRITE (cltra,'("ZDF_",16a)') ctrcnm(jn) 356 WRITE (cltral,'("Z diffusion trend for ",58a)') ctrcnl(jn)(1:58) 357 END IF 358 # if defined key_trcldf_eiv 359 IF( jl == jptrc_xei ) THEN 360 ! short and long title for x gent velocity for tracer 361 WRITE (cltra,'("XGV_",16a)') ctrcnm(jn) 362 WRITE (cltral,'("X gent velocity trend for ",53a)') ctrcnl(jn)(1:53) 363 END IF 364 IF( jl == jptrc_yei ) THEN 365 ! short and long title for y gent velocity for tracer 366 WRITE (cltra,'("YGV_",16a)') ctrcnm(jn) 367 WRITE (cltral,'("Y gent velocity trend for ",53a)') ctrcnl(jn)(1:53) 368 END IF 369 IF( jl == jptrc_zei ) THEN 370 ! short and long title for Z gent velocity for tracer 371 WRITE (cltra,'("ZGV_",16a)') ctrcnm(jn) 372 WRITE (cltral,'("Z gent velocity trend for ",53a)') ctrcnl(jn)(1:53) 373 END IF 374 # endif 375 # if defined key_trcdmp 376 IF( jl == jptrc_dmp ) THEN 377 ! last trends for tracer damping : short and long title 378 WRITE (cltra,'("TDM_",16a)') ctrcnm(jn) 379 WRITE (cltral,'("Tracer damping trend for ",55a)') ctrcnl(jn)(1:55) 380 END IF 381 # endif 382 IF( jl == jptrc_sbc ) THEN 383 ! last trends for tracer damping : short and long title 384 WRITE (cltra,'("SBC_",16a)') ctrcnm(jn) 385 WRITE (cltral,'("Surface boundary flux ",58a)') ctrcnl(jn)(1:55) 386 END IF 387 WRITE (cltral,'("Surface boundary flux ",58a)') ctrcnl(jn)(1:55) 388 END IF 389 CALL FLUSH( numout ) 390 cltrau = ctrcun(jn) ! UNIT for tracer /trends 391 CALL histdef( nit6(jn), cltra, cltral, cltrau, jpi,jpj, & 392 & nhorit6(jn), ipk, 1, ipk, ndepit6(jn), 32, clop , & 393 & zsto,zout ) 394 END DO 395 END IF 396 END DO 397 ! CLOSE netcdf Files 398 DO jn = 1, jptra 399 IF( luttrd(jn) ) CALL histend( nit6(jn) ) 400 END DO 401 402 IF(lwp) WRITE(numout,*) 403 IF(lwp) WRITE(numout,*) 'End of NetCDF Initialization in trcdid' 404 IF(ll_print) CALL FLUSH(numout ) 405 ! 406 ENDIF 407 408 ! SOME diagnostics to DO first time 409 410 ! Start writing data 411 ! --------------------- 412 413 ! trends for tracer concentrations 414 415 IF( lwp .AND. MOD( itmod, nwritetrd ) == 0 ) THEN 416 WRITE(numout,*) 'trcdid_wr : write NetCDF dynamical trends at ', kt, 'time-step' 417 WRITE(numout,*) '~~~~~~ ' 418 ENDIF 419 420 DO jn = 1, jptra 421 IF( luttrd(jn) ) THEN 422 ikn = ikeep(jn) 423 DO jl = 1, jpdiatrc 424 ! short titles 425 IF( jl == jptrc_xad) WRITE (cltra,'("XAD_",16a)') ctrcnm(jn) 426 IF( jl == jptrc_yad) WRITE (cltra,'("YAD_",16a)') ctrcnm(jn) 427 IF( jl == jptrc_zad) WRITE (cltra,'("ZAD_",16a)') ctrcnm(jn) 428 IF( jl == jptrc_xdf) WRITE (cltra,'("XDF_",16a)') ctrcnm(jn) 429 IF( jl == jptrc_ydf) WRITE (cltra,'("YDF_",16a)') ctrcnm(jn) 430 IF( jl == jptrc_zdf) WRITE (cltra,'("ZDF_",16a)') ctrcnm(jn) 431 # if defined key_trcldf_eiv 432 IF( jl == jptrc_xei) WRITE (cltra,'("XGV_",16a)') ctrcnm(jn) 433 IF( jl == jptrc_yei) WRITE (cltra,'("YGV_",16a)') ctrcnm(jn) 434 IF( jl == jptrc_zei) WRITE (cltra,'("ZGV_",16a)') ctrcnm(jn) 435 # endif 436 # if defined key_trcdmp 437 IF( jl == jptrc_dmp ) WRITE (cltra,'("TDM_",16a)') ctrcnm(jn) 438 # endif 439 IF( jl == jptrc_sbc ) WRITE (cltra,'("SBC_",16a)') ctrcnm(jn) 440 ! 441 CALL histwrite(nit6(jn), cltra, it, trtrd(:,:,:,ikn,jl),ndimt50, ndext50) 442 END DO 443 END IF 444 END DO 445 446 ! Closing all files 447 ! ----------------- 448 IF( kt == nitend .OR. kindic < 0 ) THEN 449 DO jn = 1, jptra 450 IF( luttrd(jn) ) CALL histclo( nit6(jn) ) 451 END DO 452 ENDIF 453 ! 454 455 END SUBROUTINE trcdid_wr 456 457 # else 458 459 SUBROUTINE trcdid_wr( kt, kindic ) ! Dummy routine 460 INTEGER, INTENT ( in ) :: kt, kindic 461 END SUBROUTINE trcdid_wr 462 463 # endif 464 465 #if defined key_trc_diaadd 226 #if defined key_diatrc 466 227 467 228 SUBROUTINE trcdii_wr( kt, kindic ) … … 506 267 ENDIF 507 268 # if defined key_diainstant 508 zsto = n writedia * zdt269 zsto = nn_writedia * zdt 509 270 clop = "inst("//TRIM(clop)//")" 510 271 # else … … 512 273 clop = "ave("//TRIM(clop)//")" 513 274 # endif 514 zout = n writedia * zdt275 zout = nn_writedia * zdt 515 276 516 277 ! Define indices of the horizontal output zoom and vertical limit storage … … 534 295 ! Define the T grid file for tracer auxiliary files 535 296 536 CALL dia_nam( clhstnam, n writedia, 'diad_T' )297 CALL dia_nam( clhstnam, nn_writedia, 'diad_T' ) 537 298 IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam 538 299 … … 581 342 ! --------------------- 582 343 583 IF( lwp .AND. MOD( itmod, n writedia ) == 0 ) THEN344 IF( lwp .AND. MOD( itmod, nn_writedia ) == 0 ) THEN 584 345 WRITE(numout,*) 'trcdii_wr : write NetCDF additional arrays at ', kt, 'time-step' 585 346 WRITE(numout,*) '~~~~~~ ' … … 613 374 # endif 614 375 615 # if defined key_ trc_diabio376 # if defined key_diabio 616 377 617 378 SUBROUTINE trcdib_wr( kt, kindic ) … … 658 419 ENDIF 659 420 # if defined key_diainstant 660 zsto = n writebio * zdt421 zsto = nn_writebio * zdt 661 422 clop = "inst("//TRIM(clop)//")" 662 423 # else … … 664 425 clop = "ave("//TRIM(clop)//")" 665 426 # endif 666 zout = n writebio * zdt427 zout = nn_writebio * zdt 667 428 668 429 ! Define indices of the horizontal output zoom and vertical limit storage … … 684 445 ! Define the NETCDF files for biological trends 685 446 686 CALL dia_nam(clhstnam,n writebio,'biolog')447 CALL dia_nam(clhstnam,nn_writebio,'biolog') 687 448 IF(lwp)WRITE(numout,*) " Name of NETCDF file for biological trends ", clhstnam 688 449 ! Horizontal grid : glamt and gphit … … 716 477 717 478 ! biological trends 718 IF( lwp .AND. MOD( itmod, n writebio ) == 0 ) THEN479 IF( lwp .AND. MOD( itmod, nn_writebio ) == 0 ) THEN 719 480 WRITE(numout,*) 'trcdit_wr : write NetCDF biological trends at ', kt, 'time-step' 720 481 WRITE(numout,*) '~~~~~~ ' -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/trcini.F90
r1970 r2038 18 18 USE oce_trc 19 19 USE trc 20 USE trp_trc21 20 USE trcrst 22 USE trcctl 23 USE trclec 21 USE trcnam ! Namelist read 24 22 USE trcini_cfc ! CFC initialisation 25 23 USE trcini_lobster ! LOBSTER initialisation … … 28 26 USE trcini_my_trc ! MY_TRC initialisation 29 27 USE trcdta 30 #if defined key_off _tra28 #if defined key_offline 31 29 USE daymod 32 30 #endif 33 USE zpshde _trc ! partial step: hor. derivative31 USE zpshde ! partial step: hor. derivative (zps_hde_trc routine) 34 32 USE in_out_manager ! I/O manager 35 33 USE prtctl_trc ! Print control passive tracers (prt_ctl_trc_init routine) … … 78 76 79 77 ! total volume of the ocean 80 #if ! defined key_ off_degrad78 #if ! defined key_degrad 81 79 areatot = SUM( cvol(:,:,:) ) 82 80 #else 83 areatot = SUM( cvol(:,:,:) * facvol(:,:,:) ) ! degrad option: reduction by facvol81 areatot = SUM( cvol(:,:,:) * facvol(:,:,:) ) ! degrad option: reduction by facvol 84 82 #endif 85 IF( lk_mpp ) CALL mpp_sum( areatot ) ! sum over the global domain83 IF( lk_mpp ) CALL mpp_sum( areatot ) ! sum over the global domain 86 84 87 CALL trc_ lec ! READpassive tracers namelists85 CALL trc_nam ! read passive tracers namelists 88 86 89 CALL trc_ctl ! control consistency between parameters, cpp key 87 ! restart for passive tracer (input) 88 IF( ln_rsttr ) THEN 89 IF(lwp) WRITE(numout,*) ' read a restart file for passive tracer : ', cn_trcrst_in 90 IF(lwp) WRITE(numout,*) ' ' 91 ELSE 92 IF(lwp) WRITE(numout,*) 93 DO jn = 1, jptra 94 IF( lwp .AND. lutini(jn) ) & ! open input FILE only IF lutini(jn) is true 95 & WRITE(numout,*) ' read an initial file for passive tracer number :', jn, ' traceur : ', ctrcnm(jn) 96 END DO 97 ENDIF 90 98 91 99 IF( lk_lobster ) THEN ; CALL trc_ini_lobster ! LOBSTER bio-model … … 110 118 111 119 IF( .NOT. ln_rsttr ) THEN 112 #if defined key_off _tra120 #if defined key_offline 113 121 CALL day_init ! calendar 114 122 #endif … … 130 138 131 139 IF( ln_zps .AND. .NOT. lk_trc_c1d ) & ! Partial steps: before horizontal gradient of passive 132 & CALL zps_hde_trc( nittrc000, trb, gtru, gtrv ) ! tracers at the bottom ocean level140 & CALL zps_hde_trc( nittrc000, jptra, trb, gtru, gtrv ) ! tracers at the bottom ocean level 133 141 134 142 … … 136 144 trai = 0.e0 137 145 DO jn = 1, jptra 138 #if ! defined key_ off_degrad146 #if ! defined key_degrad 139 147 trai = trai + SUM( trn(:,:,:,jn) * cvol(:,:,:) ) 140 148 #else -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/trcrst.F90
r1970 r2038 25 25 USE oce_trc 26 26 USE trc 27 USE trc trp_lec27 USE trcnam_trp 28 28 USE lib_mpp 29 29 USE iom … … 33 33 USE trcrst_c14b ! C14 bomb restart 34 34 USE trcrst_my_trc ! MY_TRC restart 35 #if defined key_off _tra35 #if defined key_offline 36 36 USE daymod 37 37 #endif … … 67 67 !!---------------------------------------------------------------------- 68 68 ! 69 # if ! defined key_off _tra69 # if ! defined key_offline 70 70 IF( kt == nit000 ) lrst_trc = .FALSE. 71 71 # else … … 82 82 # endif 83 83 ! to get better performances with NetCDF format: 84 ! we open and define the tracer restart file one tracer time step before writing the data (-> at nitrst - 2*n dttrc + 1)85 ! except if we write tracer restart files every tracer time step or if a tracer restart file was writen at nitend - 2*n dttrc + 186 IF( kt == nitrst - 2*n dttrc + 1 .OR. nstock == ndttrc .OR. ( kt == nitend - ndttrc + 1 .AND. .NOT. lrst_trc ) ) THEN84 ! we open and define the tracer restart file one tracer time step before writing the data (-> at nitrst - 2*nn_dttrc + 1) 85 ! except if we write tracer restart files every tracer time step or if a tracer restart file was writen at nitend - 2*nn_dttrc + 1 86 IF( kt == nitrst - 2*nn_dttrc + 1 .OR. nstock == nn_dttrc .OR. ( kt == nitend - nn_dttrc + 1 .AND. .NOT. lrst_trc ) ) THEN 87 87 ! beware of the format used to write kt (default is i8.8, that should be large enough) 88 88 IF( nitrst > 1.0e9 ) THEN ; WRITE(clkt,* ) nitrst … … 222 222 !! 223 223 !! According to namelist parameter nrstdt, 224 !! n rsttr = 0 no control on the date (nittrc000 is arbitrary).225 !! n rsttr = 1 we verify that nit000 is equal to the last224 !! nn_rsttr = 0 no control on the date (nittrc000 is arbitrary). 225 !! nn_rsttr = 1 we verify that nit000 is equal to the last 226 226 !! time step of previous run + 1. 227 227 !! In both those options, the exact duration of the experiment … … 230 230 !! This is valid is the time step has remained constant. 231 231 !! 232 !! n rsttr = 2 the duration of the experiment in days (adatrj)232 !! nn_rsttr = 2 the duration of the experiment in days (adatrj) 233 233 !! has been stored in the restart file. 234 234 !!---------------------------------------------------------------------- … … 237 237 ! 238 238 REAL(wp) :: zkt 239 #if defined key_off _tra239 #if defined key_offline 240 240 REAL(wp) :: zndastp 241 241 #endif … … 250 250 WRITE(numout,*) ' previous time-step : ', NINT( zkt ) 251 251 WRITE(numout,*) ' *** restart option' 252 SELECT CASE ( n rsttr )253 CASE ( 0 ) ; WRITE(numout,*) ' n rsttr = 0 : no control of nittrc000'254 CASE ( 1 ) ; WRITE(numout,*) ' n rsttr = 1 : no control the date at nit000 (use ndate0 read in the namelist)'255 CASE ( 2 ) ; WRITE(numout,*) ' n rsttr = 2 : calendar parameters read in restart'252 SELECT CASE ( nn_rsttr ) 253 CASE ( 0 ) ; WRITE(numout,*) ' nn_rsttr = 0 : no control of nittrc000' 254 CASE ( 1 ) ; WRITE(numout,*) ' nn_rsttr = 1 : no control the date at nit000 (use ndate0 read in the namelist)' 255 CASE ( 2 ) ; WRITE(numout,*) ' nn_rsttr = 2 : calendar parameters read in restart' 256 256 END SELECT 257 257 WRITE(numout,*) 258 258 ENDIF 259 259 ! Control of date 260 IF( nittrc000 - NINT( zkt ) /= 1 .AND. n rsttr /= 0 ) &260 IF( nittrc000 - NINT( zkt ) /= 1 .AND. nn_rsttr /= 0 ) & 261 261 & CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart', & 262 & ' verify the restart file or rerun with n rsttr = 0 (namelist)' )263 #if defined key_off _tra262 & ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' ) 263 #if defined key_offline 264 264 ! define ndastp and adatrj 265 IF ( n rsttr == 2 ) THEN265 IF ( nn_rsttr == 2 ) THEN 266 266 CALL iom_get( numrtr, 'ndastp', zndastp ) 267 267 ndastp = NINT( zndastp ) … … 329 329 DO ji = 1, jpi 330 330 zvol = cvol(ji,jj,jk) 331 # if defined key_ off_degrad331 # if defined key_degrad 332 332 zvol = zvol * facvol(ji,jj,jk) 333 333 # endif -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/trcsms.F90
r1254 r2038 48 48 !!--------------------------------------------------------------------- 49 49 50 IF ( MOD( kt,ndttrc) /= 0) RETURN ! this ROUTINE is called only every ndttrc time step50 IF ( MOD( kt, nn_dttrc) /= 0 ) RETURN ! this ROUTINE is called only every ndttrc time step 51 51 52 52 IF( lk_lobster ) CALL trc_sms_lobster( kt ) ! main program of LOBSTER -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/trcstp.F90
r1457 r2038 10 10 !! * Modules used 11 11 USE oce_trc ! ocean dynamics and active tracers variables 12 USE tr p_trc12 USE trc 13 13 USE trctrp ! passive tracers transport 14 14 USE trcsms ! passive tracers sources and sinks … … 17 17 USE trcwri 18 18 USE trcrst 19 USE trdm ld_trc_oce19 USE trdmod_trc_oce 20 20 USE trdmld_trc 21 21 USE iom … … 52 52 CHARACTER (len=25) :: charout 53 53 54 ! this ROUTINE is called only every n dttrc time step55 IF( MOD( kt , n dttrc ) /= 0 ) RETURN54 ! this ROUTINE is called only every nn_dttrc time step 55 IF( MOD( kt , nn_dttrc ) /= 0 ) RETURN 56 56 57 57 IF(ln_ctl) THEN … … 59 59 CALL prt_ctl_trc_info(charout) 60 60 ENDIF 61 62 tra(:,:,:,:) = 0. 61 63 62 64 IF( kt == nittrc000 .AND. lk_trdmld_trc ) & -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/trcwri.F90
r1970 r2038 5 5 !!==================================================================================== 6 6 !! History : 1.0 ! 2009-05 (C. Ethe) Original code 7 !! ! 2010-03 (C. Ethe, R. Seferian ) Add the tracer transport trends8 7 !!---------------------------------------------------------------------- 9 8 #if defined key_top && defined key_iomput … … 12 11 !!---------------------------------------------------------------------- 13 12 !! trc_wri_trc : outputs of concentration fields 14 !! trc_wri_trd : outputs of transport trends15 13 !!---------------------------------------------------------------------- 16 14 USE dom_oce ! ocean space and time domain variables 17 15 USE oce_trc 18 USE trp_trc19 16 USE trc 20 USE trdmld_trc_oce, ONLY : luttrd21 17 USE iom 22 #if defined key_off _tra18 #if defined key_offline 23 19 USE oce_trc 24 20 USE dianam … … 50 46 51 47 ! 52 CALL iom_setkt ( kt + n dttrc - 1 ) ! set the passive tracer time step48 CALL iom_setkt ( kt + nn_dttrc - 1 ) ! set the passive tracer time step 53 49 CALL trc_wri_trc( kt ) ! outputs for tracer concentration 54 CALL trc_wri_trd( kt ) ! outputs for dynamical trends55 50 CALL iom_setkt ( kt ) ! set the model time step 56 51 ! … … 65 60 INTEGER, INTENT( in ) :: kt ! ocean time-step 66 61 INTEGER :: jn 67 CHARACTER (len=20) :: cltra , cltras68 #if defined key_off _tra62 CHARACTER (len=20) :: cltra 63 #if defined key_offline 69 64 CHARACTER (len=40) :: clhstnam 70 65 INTEGER :: inum = 11 ! temporary logical unit … … 72 67 !!--------------------------------------------------------------------- 73 68 74 #if defined key_off _tra69 #if defined key_offline 75 70 IF( kt == nittrc000 ) THEN 76 71 ! WRITE root name in date.file for use by postpro 77 72 IF(lwp) THEN 78 CALL dia_nam( clhstnam, n writetrc,' ' )73 CALL dia_nam( clhstnam, nn_writetrc,' ' ) 79 74 CALL ctl_opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 80 75 WRITE(inum,*) clhstnam … … 92 87 END SUBROUTINE trc_wri_trc 93 88 94 # if defined key_trc_diatrd95 96 SUBROUTINE trc_wri_trd( kt )97 !!----------------------------------------------------------------------98 !! *** ROUTINE trc_wri_trd ***99 !!100 !! ** Purpose : output of passive tracer : advection-diffusion trends101 !!102 !!----------------------------------------------------------------------103 INTEGER, INTENT( in ) :: kt ! ocean time-step104 !!105 CHARACTER (len=3) :: cltra106 INTEGER :: jn, jl, ikn107 !!----------------------------------------------------------------------108 109 DO jn = 1, jptra110 IF( luttrd(jn) ) THEN111 ikn = ikeep(jn)112 DO jl = 1, jpdiatrc113 IF( jl == jptrc_xad ) WRITE (cltra,"(3a)") 'XAD' ! x advection for tracer114 IF( jl == jptrc_yad ) WRITE (cltra,"(3a)") 'YAD' ! y advection for tracer115 IF( jl == jptrc_zad ) WRITE (cltra,"(3a)") 'ZAD' ! z advection for tracer116 IF( jl == jptrc_xdf ) WRITE (cltra,"(3a)") 'XDF' ! x diffusion for tracer117 IF( jl == jptrc_ydf ) WRITE (cltra,"(3a)") 'YDF' ! y diffusion for tracer118 IF( jl == jptrc_zdf ) WRITE (cltra,"(3a)") 'ZDF' ! z diffusion for tracer119 # if defined key_trcldf_eiv120 IF( jl == jptrc_xei ) WRITE (cltra,"(3a)") 'XGV' ! x gent velocity for tracer121 IF( jl == jptrc_yei ) WRITE (cltra,"(3a)") 'YGV' ! y gent velocity for tracer122 IF( jl == jptrc_zei ) WRITE (cltra,"(3a)") 'ZGV' ! z gent velocity for tracer123 # endif124 # if defined key_trcdmp125 IF( jl == jptrc_dmp ) WRITE (cltra,"(3a)") 'DMP' ! damping126 # endif127 IF( jl == jptrc_sbc ) WRITE (cltra,"(3a)") 'SBC' ! surface boundary conditions128 ! write the trends129 CALL iom_put( cltra, trtrd(:,:,:,ikn,jl) )130 END DO131 END IF132 END DO133 !134 END SUBROUTINE trc_wri_trd135 136 # else137 SUBROUTINE trc_wri_trd( kt ) ! Dummy routine138 INTEGER, INTENT ( in ) :: kt139 END SUBROUTINE trc_wri_trd140 #endif141 89 #else 142 90 !!----------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.