Changeset 1255
- Timestamp:
- 2009-01-13T11:20:17+01:00 (15 years ago)
- Location:
- trunk/NEMO/TOP_SRC
- Files:
-
- 18 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/TOP_SRC/CFC/trcctl_cfc.F90
r1146 r1255 33 33 !! ** Purpose : control the cpp options, namelist and files 34 34 !!---------------------------------------------------------------------- 35 INTEGER :: j n35 INTEGER :: jl, jn 36 36 37 37 IF(lwp) THEN … … 54 54 ! Check tracer names 55 55 ! ------------------ 56 IF( jp_cfc == 1 ) THEN 57 IF ( jp11 == 1 ) THEN 58 IF ( ctrcnm(jp11) /= 'CFC11') THEN 59 ctrcnm(jp11) = 'CFC11' 60 ctrcnl(jp11) = 'Chlorofuorocarbone 11 concentration' 61 ENDIF 62 ENDIF 63 IF( jp12 == 1 ) THEN 64 IF ( ctrcnm(jp12) /= 'CFC12') THEN 65 ctrcnm(jp12) = 'CFC12' 66 ctrcnl(jp12) = 'Chlorofuorocarbone 12 concentration' 67 ENDIF 68 ENDIF 69 ENDIF 70 71 IF( jp_cfc == 2 ) THEN 72 IF ( ctrcnm(jp11) /= 'CFC11' .OR. ctrcnm(jp12) /= 'CFC12' ) THEN 73 ctrcnm(jp11) = 'CFC11' 74 ctrcnl(jp11) = 'Chlorofuorocarbone 11 concentration' 75 ctrcnm(jp12) = 'CFC12' 76 ctrcnl(jp12) = 'Chlorofuorocarbone 12 concentration' 77 ENDIF 56 IF ( ctrcnm(jpc11) /= 'CFC11' .OR. ctrcnm(jpc12) /= 'CFC12' ) THEN 57 ctrcnm(jpc11) = 'CFC11' 58 ctrcnl(jpc11) = 'Chlorofuorocarbone 11 concentration' 59 ctrcnm(jpc12) = 'CFC12' 60 ctrcnl(jpc12) = 'Chlorofuorocarbone 12 concentration' 78 61 ENDIF 79 62 … … 82 65 WRITE (numout,*) ' ======= ============= ' 83 66 WRITE (numout,*) ' we force tracer names' 84 DO jn = jp_cfc0, jp_cfc1 67 DO jl = 1, jp_cfc 68 jn = jp_cfc0 + jl - 1 85 69 WRITE(numout,*) ' tracer nb: ',jn,' name = ',ctrcnm(jn), ctrcnl(jn) 86 70 END DO … … 91 75 ! Check tracer units 92 76 ! ------------------ 93 DO jn = jp_cfc0, jp_cfc1 77 DO jl = 1, jp_cfc 78 jn = jp_cfc0 + jl - 1 94 79 IF( ctrcun(jn) /= 'mole/m3' ) THEN 95 80 ctrcun(jn) = 'mole/m3' -
trunk/NEMO/TOP_SRC/CFC/trcini_cfc.F90
r1146 r1255 44 44 !! ** Method : - Read the namcfc namelist and check the parameter values 45 45 !!---------------------------------------------------------------------- 46 INTEGER :: ji, jj, jn, jl, jm 46 INTEGER :: ji, jj, jn, jl, jm, js 47 47 REAL(wp) :: zyy , zyd 48 48 !!---------------------------------------------------------------------- … … 55 55 ! Initialization of boundaries conditions 56 56 ! --------------------------------------- 57 qtr (:,:,:)= 0.e058 xphem (:,:) = 0.e059 DO jn = jp_cfc0, jp_cfc157 xphem (:,:) = 0.e0 58 DO jl = 1, jp_cfc 59 jn = jp_cfc0 + jl - 1 60 60 DO jm = 1, jphem 61 DO j l= 1, jpyear62 p_cfc(j l,jm,jn) = 0.061 DO js = 1, jpyear 62 p_cfc(js,jm,jn) = 0.0 63 63 END DO 64 64 END DO … … 68 68 ! Initialization of qint in case of no restart 69 69 !---------------------------------------------- 70 qtr_cfc(:,:,:) = 0.e0 70 71 IF( .NOT. lrsttr ) THEN 71 72 IF(lwp) THEN … … 73 74 WRITE(numout,*) 'Initialization de qint ; No restart : qint equal zero ' 74 75 ENDIF 75 DO jn = jp_cfc0, jp_cfc1 76 trn(:,:,:,jn) = 0.e0 77 qint(:,: ,jn) = 0.e0 76 DO jl = 1, jp_cfc 77 jn = jp_cfc0 + jl - 1 78 trn (:,:,:,jn) = 0.e0 79 qint_cfc(:,: ,jn) = 0.e0 78 80 END DO 79 81 ENDIF … … 96 98 97 99 DO jn = 31, 98 ! Read file 98 READ(inum,*) zyy, p_cfc(jn,1,jp11), p_cfc(jn,1,jp12), & 99 & p_cfc(jn,2,jp11), p_cfc(jn,2,jp12) 100 READ(inum,*) zyy, p_cfc(jn,1,1), p_cfc(jn,1,2), p_cfc(jn,2,1), p_cfc(jn,2,2) 100 101 WRITE(numout,'(f7.2, 4f8.2)' ) & 101 & zyy, p_cfc(jn,1,jp11), p_cfc(jn,1,jp12), & 102 & p_cfc(jn,2,jp11), p_cfc(jn,2,jp12) 102 & zyy, p_cfc(jn,1,1), p_cfc(jn,1,2), p_cfc(jn,2,1), p_cfc(jn,2,2) 103 103 END DO 104 104 105 p_cfc(32,1:2, jp11) = 5.e-4 ! modify the values of the first years106 p_cfc(33,1:2, jp11) = 8.e-4107 p_cfc(34,1:2, jp11) = 1.e-6108 p_cfc(35,1:2, jp11) = 2.e-3109 p_cfc(36,1:2, jp11) = 4.e-3110 p_cfc(37,1:2, jp11) = 6.e-3111 p_cfc(38,1:2, jp11) = 8.e-3112 p_cfc(39,1:2, jp11) = 1.e-2105 p_cfc(32,1:2,1) = 5.e-4 ! modify the values of the first years 106 p_cfc(33,1:2,1) = 8.e-4 107 p_cfc(34,1:2,1) = 1.e-6 108 p_cfc(35,1:2,1) = 2.e-3 109 p_cfc(36,1:2,1) = 4.e-3 110 p_cfc(37,1:2,1) = 6.e-3 111 p_cfc(38,1:2,1) = 8.e-3 112 p_cfc(39,1:2,1) = 1.e-2 113 113 114 114 IF(lwp) THEN ! Control print … … 117 117 DO jn = 30, 100 118 118 WRITE(numout, '( 1I4, 4F9.2)') & 119 & jn, p_cfc(jn,1,jp11), p_cfc(jn,2,jp11), & 120 & p_cfc(jn,1,jp12), p_cfc(jn,2,jp12) 119 & jn, p_cfc(jn,1,1), p_cfc(jn,2,1), p_cfc(jn,1,2), p_cfc(jn,2,2) 121 120 END DO 122 121 ENDIF -
trunk/NEMO/TOP_SRC/CFC/trclsm_cfc.F90
r1146 r1255 42 42 !!---------------------------------------------------------------------- 43 43 CHARACTER (len=32) :: clname = 'namelist_cfc' 44 INTEGER :: numnat 44 INTEGER :: numnatc 45 #if defined key_trc_diaadd 46 ! definition of additional diagnostic as a structure 47 INTEGER :: jl, jn 48 TYPE DIAG 49 CHARACTER(len = 20) :: snamedia !: short name 50 CHARACTER(len = 80 ) :: lnamedia !: long name 51 CHARACTER(len = 20 ) :: unitdia !: unit 52 END TYPE DIAG 53 54 TYPE(DIAG) , DIMENSION(jp_cfc_2d) :: cfcdia2d 55 #endif 45 56 !! 46 57 NAMELIST/namcfcdate/ ndate_beg, nyear_res 58 #if defined key_trc_diaadd 59 NAMELIST/namcfcdia/nwritedia, cfcdia2d ! additional diagnostics 60 #endif 47 61 !!------------------------------------------------------------------- 48 62 … … 51 65 52 66 ! ! Open namelist file 53 CALL ctlopn( numnat, clname, 'OLD', 'FORMATTED', 'SEQUENTIAL', & 54 & 1, numout, .FALSE., 1 ) 67 CALL ctlopn( numnatc, clname, 'OLD', 'FORMATTED', 'SEQUENTIAL', 1, numout, .FALSE., 1 ) 55 68 56 READ( numnat , namcfcdate ) ! read namelist69 READ( numnatc , namcfcdate ) ! read namelist 57 70 58 71 IF(lwp) THEN ! control print … … 66 79 IF(lwp) WRITE(numout,*) ' initial year (aa) nyear_beg = ', nyear_beg 67 80 ! 81 #if defined key_trc_diaadd 82 83 ! Namelist namcfcdia 84 ! ------------------- 85 nwritedia = 10 ! default values 86 87 DO jl = 1, jp_cfc_2d 88 jn = jp_cfc0_2d + jl - 1 89 WRITE(ctrc2d(jn),'("2D_",I1)') jn ! short name 90 WRITE(ctrc2l(jn),'("2D DIAGNOSTIC NUMBER ",I2)') jn ! long name 91 ctrc2u(jn) = ' ' ! units 92 END DO 93 94 REWIND( numnatc ) ! read natrtd 95 READ ( numnatc, namcfcdia ) 96 97 DO jl = 1, jp_cfc_2d 98 jn = jp_cfc0_2d + jl - 1 99 ctrc2d(jn) = cfcdia2d(jl)%snamedia 100 ctrc2l(jn) = cfcdia2d(jl)%lnamedia 101 ctrc2u(jn) = cfcdia2d(jl)%unitdia 102 END DO 103 104 105 IF(lwp) THEN ! control print 106 WRITE(numout,*) 107 WRITE(numout,*) ' Namelist : natadd' 108 WRITE(numout,*) ' frequency of outputs for additional arrays nwritedia = ', nwritedia 109 DO jl = 1, jp_cfc_2d 110 jn = jp_cfc0_2d + jl - 1 111 WRITE(numout,*) ' 2d output field No : ',jn 112 WRITE(numout,*) ' short name : ', TRIM(ctrc2d(jn)) 113 WRITE(numout,*) ' long name : ', TRIM(ctrc2l(jn)) 114 WRITE(numout,*) ' unit : ', TRIM(ctrc2u(jn)) 115 WRITE(numout,*) ' ' 116 END DO 117 ENDIF 118 #endif 119 68 120 END SUBROUTINE trc_lsm_cfc 69 121 -
trunk/NEMO/TOP_SRC/CFC/trcsms_cfc.F90
r1146 r1255 19 19 USE par_trc ! TOP parameters 20 20 USE trc ! TOP variables 21 USE trdmld_trc_oce 22 USE trdmld_trc 21 23 22 24 IMPLICIT NONE … … 31 33 INTEGER , PUBLIC :: nyear_beg ! initial year (aa) 32 34 33 REAL(wp), PUBLIC, DIMENSION(jpyear,jphem, jp_cfc 0:jp_cfc1) :: p_cfc! partial hemispheric pressure for CFC34 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) 35 REAL(wp), PUBLIC, DIMENSION(jpi,jpj ,jp_cfc0:jp_cfc1) :: qtr ! input function36 REAL(wp), PUBLIC, DIMENSION(jpi,jpj ,jp_cfc0:jp_cfc1) :: qint ! flux function37 38 REAL(wp), DIMENSION( jp_cfc0:jp_cfc1) :: soa1, soa2, soa3, soa4! coefficient for solubility of CFC [mol/l/atm]39 REAL(wp), DIMENSION( jp_cfc0:jp_cfc1) :: sob1, sob2, sob3! " "40 REAL(wp), DIMENSION( jp_cfc0:jp_cfc1) :: sca1, sca2, sca3, sca4! coefficients for schmidt number in degre Celcius35 REAL(wp), PUBLIC, DIMENSION(jpyear,jphem, jp_cfc) :: p_cfc ! partial hemispheric pressure for CFC 36 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: xphem ! spatial interpolation factor for patm 37 REAL(wp), PUBLIC, DIMENSION(jpi,jpj ,jp_cfc) :: qtr_cfc ! flux at surface 38 REAL(wp), PUBLIC, DIMENSION(jpi,jpj ,jp_cfc) :: qint_cfc ! cumulative flux 39 40 REAL(wp), DIMENSION(4,jp_cfc) :: soa ! coefficient for solubility of CFC [mol/l/atm] 41 REAL(wp), DIMENSION(3,jp_cfc) :: sob ! " " 42 REAL(wp), DIMENSION(4,jp_cfc) :: sca ! coefficients for schmidt number in degre Celcius 41 43 42 44 ! ! coefficients for conversion … … 74 76 INTEGER, INTENT( in ) :: kt ! ocean time-step index 75 77 !! 76 INTEGER :: ji, jj, jn, j m78 INTEGER :: ji, jj, jn, jl, jm, js 77 79 INTEGER :: iyear_beg, iyear_end 78 80 INTEGER :: im1, im2 … … 87 89 88 90 REAL(wp), DIMENSION(jphem,jp_cfc) :: zpatm ! atmospheric function 91 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrcfc ! use for CFC sms trend 89 92 !!---------------------------------------------------------------------- 90 93 … … 105 108 iyear_end = iyear_beg + 1 106 109 107 ! !------------! 108 DO jn = jp_cfc0, jp_cfc1 ! CFC loop ! 109 ! !------------! 110 ! !------------! 111 DO jl = 1, jp_cfc ! CFC loop ! 112 ! !------------! 113 jn = jp_cfc0 + jl - 1 110 114 ! time interpolation at time kt 111 115 DO jm = 1, jphem 112 zpatm(jm,j n) = ( p_cfc(iyear_beg, jm, jn) * FLOAT (im1) &113 & + p_cfc(iyear_end, jm, j n) * FLOAT (im2) ) / 12.116 zpatm(jm,jl) = ( p_cfc(iyear_beg, jm, jl) * FLOAT (im1) & 117 & + p_cfc(iyear_end, jm, jl) * FLOAT (im2) ) / 12. 114 118 END DO 115 119 … … 119 123 120 124 ! space interpolation 121 zpp_cfc = xphem(ji,jj) * zpatm(1,j n) &122 & + ( 1.- xphem(ji,jj) ) * zpatm(2,j n)125 zpp_cfc = xphem(ji,jj) * zpatm(1,jl) & 126 & + ( 1.- xphem(ji,jj) ) * zpatm(2,jl) 123 127 124 128 ! Computation of concentration at equilibrium : in picomol/l … … 126 130 IF( tmask(ji,jj,1) .GE. 0.5 ) THEN 127 131 ztap = ( tn(ji,jj,1) + 273.16 ) * 0.01 128 zdtap = ( sob3(jn) * ztap + sob2(jn) ) * ztap + sob1(jn)129 zsol = EXP( soa 1(jn) + soa2(jn) / ztap + soa3(jn) * LOG( ztap ) &130 & + soa4(jn) * ztap * ztap + sn(ji,jj,1) * zdtap )132 zdtap = sob(1,jl) + ztap * ( sob(2,jl) + ztap * sob(3,jl) ) 133 zsol = EXP( soa(1,jl) + soa(2,jl) / ztap + soa(3,jl) * LOG( ztap ) & 134 & + soa(4,jl) * ztap * ztap + sn(ji,jj,1) * zdtap ) 131 135 ELSE 132 136 zsol = 0.e0 … … 142 146 zt2 = zt1 * zt1 143 147 zt3 = zt1 * zt2 144 zsch = sca 1(jn) + sca2(jn) * zt1 + sca3(jn) * zt2 + sca4(jn) * zt3148 zsch = sca(1,jl) + sca(2,jl) * zt1 + sca(3,jl) * zt2 + sca(4,jl) * zt3 145 149 146 150 ! speed transfert : formulae of wanninkhof 1992 … … 151 155 ! Input function : speed *( conc. at equil - concen at surface ) 152 156 ! trn in pico-mol/l idem qtr; ak in en m/s 153 qtr (ji,jj,jn) = -zak_cfc * ( trb(ji,jj,1,jn) - zca_cfc ) &157 qtr_cfc(ji,jj,jl) = -zak_cfc * ( trb(ji,jj,1,jn) - zca_cfc ) & 154 158 #if defined key_off_degrad 155 & * facvol(ji,jj,1) &159 & * facvol(ji,jj,1) & 156 160 #endif 157 & * tmask(ji,jj,1) * ( 1. - fr_i(ji,jj) )161 & * tmask(ji,jj,1) * ( 1. - fr_i(ji,jj) ) 158 162 159 163 ! Add the surface flux to the trend 160 tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + qtr (ji,jj,jn) / fse3t(ji,jj,1)164 tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + qtr_cfc(ji,jj,jl) / fse3t(ji,jj,1) 161 165 162 166 ! cumulation of surface flux at each time step 163 qint(ji,jj,jn) = qint (ji,jj,jn) + qtr(ji,jj,jn) * rdt 167 qint_cfc(ji,jj,jl) = qint_cfc(ji,jj,jl) + qtr_cfc(ji,jj,jl) * rdt 168 169 # if defined key_trc_diaadd 170 ! Save diagnostics , just for CFC11 171 js = 1 172 trc2d(ji,jj,jp_cfc0_2d ) = qtr_cfc (ji,jj,js) 173 trc2d(ji,jj,jp_cfc0_2d + 1) = qint_cfc(ji,jj,js) 174 # endif 164 175 ! !----------------! 165 176 END DO ! end i-j loop ! … … 168 179 END DO ! end CFC loop ! 169 180 ! !----------------! 181 182 IF( l_trdtrc ) THEN 183 DO jn = jp_cfc0, jp_cfc1 184 ztrcfc(:,:,:) = tra(:,:,:,jn) 185 CALL trd_mod_trc( ztrcfc, jn, jptrc_trd_sms, kt ) ! save trends 186 END DO 187 END IF 188 170 189 END SUBROUTINE trc_sms_cfc 171 190 … … 177 196 !!--------------------------------------------------------------------- 178 197 179 ! coefficient for solubility of CFC11/CFC12 in mol/l/atm 180 181 soa1(jp11) = -229.9261 182 soa2(jp11) = 319.6552 183 soa3(jp11) = 119.4471 184 soa4(jp11) = -1.39165 185 sob1(jp11) = -0.142382 186 sob2(jp11) = 0.091459 187 sob3(jp11) = -0.0157274 188 189 soa1(jp12) = -218.0971 190 soa2(jp12) = 298.9702 191 soa3(jp12) = 113.8049 192 soa4(jp12) = -1.39165 193 sob1(jp12) = -0.143566 194 sob2(jp12) = 0.091015 195 sob3(jp12) = -0.0153924 196 197 198 ! coefficients for schmidt number in degre Celcius 199 sca1(jp11) = 3501.8 200 sca2(jp11) = -210.31 201 sca3(jp11) = 6.1851 202 sca4(jp11) = -0.07513 203 204 sca1(jp12) = 3845.4 205 sca2(jp12) = -228.95 206 sca3(jp12) = 6.1908 207 sca4(jp12) = -0.067430 198 199 ! coefficient for CFC11 200 !---------------------- 201 202 ! Solubility 203 soa(1,1) = -229.9261 204 soa(2,1) = 319.6552 205 soa(3,1) = 119.4471 206 soa(4,1) = -1.39165 207 208 sob(1,1) = -0.142382 209 sob(2,1) = 0.091459 210 sob(3,1) = -0.0157274 211 212 ! Schmidt number 213 sca(1,1) = 3501.8 214 sca(2,1) = -210.31 215 sca(3,1) = 6.1851 216 sca(4,1) = -0.07513 217 218 ! coefficient for CFC12 219 !---------------------- 220 221 ! Solubility 222 soa(1,2) = -218.0971 223 soa(2,2) = 298.9702 224 soa(3,2) = 113.8049 225 soa(4,2) = -1.39165 226 227 sob(1,2) = -0.143566 228 sob(2,2) = 0.091015 229 sob(3,2) = -0.0153924 230 231 ! schmidt number 232 sca(1,2) = 3845.4 233 sca(2,2) = -228.95 234 sca(3,2) = 6.1908 235 sca(4,2) = -0.067430 208 236 209 237 END SUBROUTINE trc_cfc_cst -
trunk/NEMO/TOP_SRC/LOBSTER/trcbio.F90
r1194 r1255 93 93 fbod(:,:) = 0.e0 94 94 #if defined key_trc_diaadd 95 DO jl = 1, jp_lobster_2d95 DO jl = jp_lob0_2d, jp_lob1_2d 96 96 trc2d(:,:,jl) = 0.e0 97 97 END DO … … 191 191 192 192 #if defined key_trc_diabio 193 trbio(ji,jj,jk, 1) = zno3phy 194 trbio(ji,jj,jk, 2) = znh4phy 195 trbio(ji,jj,jk, 3) = zphynh4 196 trbio(ji,jj,jk, 4) = zphydom 197 trbio(ji,jj,jk, 5) = zphyzoo 198 trbio(ji,jj,jk, 6) = zphydet 199 trbio(ji,jj,jk, 7) = zdetzoo 200 trbio(ji,jj,jk, 9) = zzoodet 201 trbio(ji,jj,jk,10) = zzoobod 202 trbio(ji,jj,jk,11) = zzoonh4 203 trbio(ji,jj,jk,12) = zzoodom 204 trbio(ji,jj,jk,13) = znh4no3 205 trbio(ji,jj,jk,14) = zdomnh4 206 trbio(ji,jj,jk,15) = zdetnh4 207 #endif 208 #if defined key_trc_diaadd 209 trc2d(ji,jj, 1) = trc2d(ji,jj, 1) + zno3phy * ze3t(ji,jj,jk) 210 trc2d(ji,jj, 2) = trc2d(ji,jj, 2) + znh4phy * ze3t(ji,jj,jk) 211 trc2d(ji,jj, 3) = trc2d(ji,jj, 3) + zphydom * ze3t(ji,jj,jk) 212 trc2d(ji,jj, 4) = trc2d(ji,jj, 4) + zphynh4 * ze3t(ji,jj,jk) 213 trc2d(ji,jj, 5) = trc2d(ji,jj, 5) + zphyzoo * ze3t(ji,jj,jk) 214 trc2d(ji,jj, 6) = trc2d(ji,jj, 6) + zphydet * ze3t(ji,jj,jk) 215 trc2d(ji,jj, 7) = trc2d(ji,jj, 7) + zdetzoo * ze3t(ji,jj,jk) 193 trbio(ji,jj,jk,jp_lob0_trd ) = zno3phy 194 trbio(ji,jj,jk,jp_lob0_trd + 1) = znh4phy 195 trbio(ji,jj,jk,jp_lob0_trd + 2) = zphynh4 196 trbio(ji,jj,jk,jp_lob0_trd + 3) = zphydom 197 trbio(ji,jj,jk,jp_lob0_trd + 4) = zphyzoo 198 trbio(ji,jj,jk,jp_lob0_trd + 5) = zphydet 199 trbio(ji,jj,jk,jp_lob0_trd + 6) = zdetzoo 200 trbio(ji,jj,jk,jp_lob0_trd + 8) = zzoodet 201 trbio(ji,jj,jk,jp_lob0_trd + 9) = zzoobod 202 trbio(ji,jj,jk,jp_lob0_trd + 10) = zzoonh4 203 trbio(ji,jj,jk,jp_lob0_trd + 11) = zzoodom 204 trbio(ji,jj,jk,jp_lob0_trd + 12) = znh4no3 205 trbio(ji,jj,jk,jp_lob0_trd + 13) = zdomnh4 206 trbio(ji,jj,jk,jp_lob0_trd + 14) = zdetnh4 207 trbio(ji,jj,jk,jp_lob0_trd + 15) = zdetdom 208 #endif 209 #if defined key_trc_diaadd 210 trc2d(ji,jj,jp_lob0_2d ) = trc2d(ji,jj, jp_lob0_2d ) + zno3phy * ze3t(ji,jj,jk) 211 trc2d(ji,jj,jp_lob0_2d + 1) = trc2d(ji,jj, jp_lob0_2d + 1) + znh4phy * ze3t(ji,jj,jk) 212 trc2d(ji,jj,jp_lob0_2d + 2) = trc2d(ji,jj, jp_lob0_2d + 2) + zphydom * ze3t(ji,jj,jk) 213 trc2d(ji,jj,jp_lob0_2d + 3) = trc2d(ji,jj, jp_lob0_2d + 3) + zphynh4 * ze3t(ji,jj,jk) 214 trc2d(ji,jj,jp_lob0_2d + 4) = trc2d(ji,jj, jp_lob0_2d + 4) + zphyzoo * ze3t(ji,jj,jk) 215 trc2d(ji,jj,jp_lob0_2d + 5) = trc2d(ji,jj, jp_lob0_2d + 5) + zphydet * ze3t(ji,jj,jk) 216 trc2d(ji,jj,jp_lob0_2d + 6) = trc2d(ji,jj, jp_lob0_2d + 6) + zdetzoo * ze3t(ji,jj,jk) 216 217 ! trend number 8 is in trcsed.F 217 trc2d(ji,jj, 9) = trc2d(ji,jj, 9) + zzoodet * ze3t(ji,jj,jk) 218 trc2d(ji,jj,10) = trc2d(ji,jj,10) + zzoobod * ze3t(ji,jj,jk) 219 trc2d(ji,jj,11) = trc2d(ji,jj,11) + zzoonh4 * ze3t(ji,jj,jk) 220 trc2d(ji,jj,12) = trc2d(ji,jj,12) + zzoodom * ze3t(ji,jj,jk) 221 trc2d(ji,jj,13) = trc2d(ji,jj,13) + znh4no3 * ze3t(ji,jj,jk) 222 trc2d(ji,jj,14) = trc2d(ji,jj,14) + zdomnh4 * ze3t(ji,jj,jk) 223 trc2d(ji,jj,15) = trc2d(ji,jj,15) + zdetnh4 * ze3t(ji,jj,jk) 224 225 trc2d(ji,jj,16) = trc2d(ji,jj,16) + ( zno3phy + znh4phy - zphynh4 & 218 trc2d(ji,jj,jp_lob0_2d + 8) = trc2d(ji,jj,jp_lob0_2d + 8) + zzoodet * ze3t(ji,jj,jk) 219 trc2d(ji,jj,jp_lob0_2d + 9) = trc2d(ji,jj,jp_lob0_2d + 9) + zzoobod * ze3t(ji,jj,jk) 220 trc2d(ji,jj,jp_lob0_2d + 10) = trc2d(ji,jj,jp_lob0_2d + 10) + zzoonh4 * ze3t(ji,jj,jk) 221 trc2d(ji,jj,jp_lob0_2d + 11) = trc2d(ji,jj,jp_lob0_2d + 11) + zzoodom * ze3t(ji,jj,jk) 222 trc2d(ji,jj,jp_lob0_2d + 12) = trc2d(ji,jj,jp_lob0_2d + 12) + znh4no3 * ze3t(ji,jj,jk) 223 trc2d(ji,jj,jp_lob0_2d + 13) = trc2d(ji,jj,jp_lob0_2d + 13) + zdomnh4 * ze3t(ji,jj,jk) 224 trc2d(ji,jj,jp_lob0_2d + 14) = trc2d(ji,jj,jp_lob0_2d + 14) + zdetnh4 * ze3t(ji,jj,jk) 225 trc2d(ji,jj,jp_lob0_2d + 15) = trc2d(ji,jj,jp_lob0_2d + 15) + ( zno3phy + znh4phy - zphynh4 & 226 226 & - zphydom - zphyzoo - zphydet ) * ze3t(ji,jj,jk) 227 trc2d(ji,jj, 17) = trc2d(ji,jj,17) + ( zphyzoo + zdetzoo - zzoodet &227 trc2d(ji,jj,jp_lob0_2d + 16) = trc2d(ji,jj,jp_lob0_2d + 16) + ( zphyzoo + zdetzoo - zzoodet & 228 228 & - zzoobod - zzoonh4 - zzoodom ) * ze3t(ji,jj,jk) 229 trc2d(ji,jj, 18) = trc2d(ji,jj,18) + zdetdom * ze3t(ji,jj,jk)229 trc2d(ji,jj,jp_lob0_2d + 17) = trc2d(ji,jj,jp_lob0_2d + 17) + zdetdom * ze3t(ji,jj,jk) 230 230 ! trend number 19 is in trcexp.F 231 trc3d(ji,jj,jk, 1) = zno3phy * 86400232 trc3d(ji,jj,jk, 2) = znh4phy * 86400233 trc3d(ji,jj,jk, 3) = znh4no3 * 86400231 trc3d(ji,jj,jk,jp_lob0_3d ) = zno3phy * 86400 232 trc3d(ji,jj,jk,jp_lob0_3d + 1) = znh4phy * 86400 233 trc3d(ji,jj,jk,jp_lob0_3d + 2) = znh4no3 * 86400 234 234 #endif 235 235 IF( l_trdtrc ) THEN 236 ztrbio(ji,jj,jk, 1) = zno3phy237 ztrbio(ji,jj,jk, 2) = znh4phy238 ztrbio(ji,jj,jk, 3) = zphynh4239 ztrbio(ji,jj,jk, 4) = zphydom240 ztrbio(ji,jj,jk, 5) = zphyzoo241 ztrbio(ji,jj,jk, 6) = zphydet242 ztrbio(ji,jj,jk, 7) = zdetzoo236 ztrbio(ji,jj,jk,jp_lob0_trd ) = zno3phy 237 ztrbio(ji,jj,jk,jp_lob0_trd + 1) = znh4phy 238 ztrbio(ji,jj,jk,jp_lob0_trd + 2) = zphynh4 239 ztrbio(ji,jj,jk,jp_lob0_trd + 3) = zphydom 240 ztrbio(ji,jj,jk,jp_lob0_trd + 4) = zphyzoo 241 ztrbio(ji,jj,jk,jp_lob0_trd + 5) = zphydet 242 ztrbio(ji,jj,jk,jp_lob0_trd + 6) = zdetzoo 243 243 ! trend number 8 in trcsed 244 ztrbio(ji,jj,jk, 9) = zzoodet245 ztrbio(ji,jj,jk, 10) = zzoobod246 ztrbio(ji,jj,jk, 11) = zzoonh4247 ztrbio(ji,jj,jk, 12) = zzoodom248 ztrbio(ji,jj,jk, 13) = znh4no3249 ztrbio(ji,jj,jk, 14) = zdomnh4250 ztrbio(ji,jj,jk, 15) = zdetnh4251 ztrbio(ji,jj,jk, 16) = zdetdom244 ztrbio(ji,jj,jk,jp_lob0_trd + 8) = zzoodet 245 ztrbio(ji,jj,jk,jp_lob0_trd + 9) = zzoobod 246 ztrbio(ji,jj,jk,jp_lob0_trd + 10) = zzoonh4 247 ztrbio(ji,jj,jk,jp_lob0_trd + 11) = zzoodom 248 ztrbio(ji,jj,jk,jp_lob0_trd + 12) = znh4no3 249 ztrbio(ji,jj,jk,jp_lob0_trd + 13) = zdomnh4 250 ztrbio(ji,jj,jk,jp_lob0_trd + 14) = zdetnh4 251 ztrbio(ji,jj,jk,jp_lob0_trd + 15) = zdetdom 252 252 ! trend number 17 in trcexp 253 253 ENDIF … … 336 336 337 337 #if defined key_trc_diabio 338 trbio(ji,jj,jk, 1) = zno3phy 339 trbio(ji,jj,jk, 2) = znh4phy 340 trbio(ji,jj,jk, 3) = zphynh4 341 trbio(ji,jj,jk, 4) = zphydom 342 trbio(ji,jj,jk, 5) = zphyzoo 343 trbio(ji,jj,jk, 6) = zphydet 344 trbio(ji,jj,jk, 7) = zdetzoo 345 trbio(ji,jj,jk, 9) = zzoodet 346 trbio(ji,jj,jk,10) = zzoobod 347 trbio(ji,jj,jk,11) = zzoonh4 348 trbio(ji,jj,jk,12) = zzoodom 349 trbio(ji,jj,jk,13) = znh4no3 350 trbio(ji,jj,jk,14) = zdomnh4 351 trbio(ji,jj,jk,15) = zdetnh4 352 #endif 353 #if defined key_trc_diaadd 354 trc2d(ji,jj, 1) = trc2d(ji,jj, 1) + zno3phy * ze3t(ji,jj,jk) 355 trc2d(ji,jj, 2) = trc2d(ji,jj, 2) + znh4phy * ze3t(ji,jj,jk) 356 trc2d(ji,jj, 3) = trc2d(ji,jj, 3) + zphydom * ze3t(ji,jj,jk) 357 trc2d(ji,jj, 4) = trc2d(ji,jj, 4) + zphynh4 * ze3t(ji,jj,jk) 358 trc2d(ji,jj, 5) = trc2d(ji,jj, 5) + zphyzoo * ze3t(ji,jj,jk) 359 trc2d(ji,jj, 6) = trc2d(ji,jj, 6) + zphydet * ze3t(ji,jj,jk) 360 trc2d(ji,jj, 7) = trc2d(ji,jj, 7) + zdetzoo * ze3t(ji,jj,jk) 338 trbio(ji,jj,jk,jp_lob0_trd ) = zno3phy 339 trbio(ji,jj,jk,jp_lob0_trd + 1) = znh4phy 340 trbio(ji,jj,jk,jp_lob0_trd + 2) = zphynh4 341 trbio(ji,jj,jk,jp_lob0_trd + 3) = zphydom 342 trbio(ji,jj,jk,jp_lob0_trd + 4) = zphyzoo 343 trbio(ji,jj,jk,jp_lob0_trd + 5) = zphydet 344 trbio(ji,jj,jk,jp_lob0_trd + 6) = zdetzoo 345 trbio(ji,jj,jk,jp_lob0_trd + 8) = zzoodet 346 trbio(ji,jj,jk,jp_lob0_trd + 9) = zzoobod 347 trbio(ji,jj,jk,jp_lob0_trd + 10) = zzoonh4 348 trbio(ji,jj,jk,jp_lob0_trd + 11) = zzoodom 349 trbio(ji,jj,jk,jp_lob0_trd + 12) = znh4no3 350 trbio(ji,jj,jk,jp_lob0_trd + 13) = zdomnh4 351 trbio(ji,jj,jk,jp_lob0_trd + 14) = zdetnh4 352 trbio(ji,jj,jk,jp_lob0_trd + 15) = zdetdom 353 #endif 354 #if defined key_trc_diaadd 355 trc2d(ji,jj, jp_lob0_2d ) = trc2d(ji,jj, jp_lob0_2d ) + zno3phy * ze3t(ji,jj,jk) 356 trc2d(ji,jj, jp_lob0_2d + 1) = trc2d(ji,jj, jp_lob0_2d + 1) + znh4phy * ze3t(ji,jj,jk) 357 trc2d(ji,jj, jp_lob0_2d + 2) = trc2d(ji,jj, jp_lob0_2d + 2) + zphydom * ze3t(ji,jj,jk) 358 trc2d(ji,jj, jp_lob0_2d + 3) = trc2d(ji,jj, jp_lob0_2d + 3) + zphynh4 * ze3t(ji,jj,jk) 359 trc2d(ji,jj, jp_lob0_2d + 4) = trc2d(ji,jj, jp_lob0_2d + 4) + zphyzoo * ze3t(ji,jj,jk) 360 trc2d(ji,jj, jp_lob0_2d + 5) = trc2d(ji,jj, jp_lob0_2d + 5) + zphydet * ze3t(ji,jj,jk) 361 trc2d(ji,jj, jp_lob0_2d + 6) = trc2d(ji,jj, jp_lob0_2d + 6) + zdetzoo * ze3t(ji,jj,jk) 361 362 ! trend number 8 is in trcsed.F 362 trc2d(ji,jj, 9) = trc2d(ji,jj, 9) + zzoodet * ze3t(ji,jj,jk)363 trc2d(ji,jj, 10) = trc2d(ji,jj,10) + zzoobod * ze3t(ji,jj,jk)364 trc2d(ji,jj, 11) = trc2d(ji,jj,11) + zzoonh4 * ze3t(ji,jj,jk)365 trc2d(ji,jj, 12) = trc2d(ji,jj,12) + zzoodom * ze3t(ji,jj,jk)366 trc2d(ji,jj, 13) = trc2d(ji,jj,13) + znh4no3 * ze3t(ji,jj,jk)367 trc2d(ji,jj, 14) = trc2d(ji,jj,14) + zdomnh4 * ze3t(ji,jj,jk)368 trc2d(ji,jj, 15) = trc2d(ji,jj,15) + zdetnh4 * ze3t(ji,jj,jk)363 trc2d(ji,jj,jp_lob0_2d + 8) = trc2d(ji,jj,jp_lob0_2d + 8) + zzoodet * ze3t(ji,jj,jk) 364 trc2d(ji,jj,jp_lob0_2d + 9) = trc2d(ji,jj,jp_lob0_2d + 9) + zzoobod * ze3t(ji,jj,jk) 365 trc2d(ji,jj,jp_lob0_2d + 10) = trc2d(ji,jj,jp_lob0_2d + 10) + zzoonh4 * ze3t(ji,jj,jk) 366 trc2d(ji,jj,jp_lob0_2d + 11) = trc2d(ji,jj,jp_lob0_2d + 11) + zzoodom * ze3t(ji,jj,jk) 367 trc2d(ji,jj,jp_lob0_2d + 12) = trc2d(ji,jj,jp_lob0_2d + 12) + znh4no3 * ze3t(ji,jj,jk) 368 trc2d(ji,jj,jp_lob0_2d + 13) = trc2d(ji,jj,jp_lob0_2d + 13) + zdomnh4 * ze3t(ji,jj,jk) 369 trc2d(ji,jj,jp_lob0_2d + 14) = trc2d(ji,jj,jp_lob0_2d + 14) + zdetnh4 * ze3t(ji,jj,jk) 369 370 370 trc2d(ji,jj, 16) = trc2d(ji,jj,16) + ( zno3phy + znh4phy - zphynh4 &371 trc2d(ji,jj,jp_lob0_2d + 15) = trc2d(ji,jj,jp_lob0_2d + 15) + ( zno3phy + znh4phy - zphynh4 & 371 372 & - zphydom - zphyzoo - zphydet ) * ze3t(ji,jj,jk) 372 trc2d(ji,jj, 17) = trc2d(ji,jj,17) + ( zphyzoo + zdetzoo - zzoodet &373 trc2d(ji,jj,jp_lob0_2d + 16) = trc2d(ji,jj,jp_lob0_2d + 16) + ( zphyzoo + zdetzoo - zzoodet & 373 374 & - zzoobod - zzoonh4 - zzoodom ) * ze3t(ji,jj,jk) 374 trc2d(ji,jj, 18) = trc2d(ji,jj,18) + zdetdom * ze3t(ji,jj,jk)375 376 trc3d(ji,jj,jk, 1) = zno3phy * 86400377 trc3d(ji,jj,jk, 2) = znh4phy * 86400378 trc3d(ji,jj,jk, 3) = znh4no3 * 86400375 trc2d(ji,jj,jp_lob0_2d + 17) = trc2d(ji,jj,jp_lob0_2d + 17) + zdetdom * ze3t(ji,jj,jk) 376 377 trc3d(ji,jj,jk,jp_lob0_3d ) = zno3phy * 86400 378 trc3d(ji,jj,jk,jp_lob0_3d + 1) = znh4phy * 86400 379 trc3d(ji,jj,jk,jp_lob0_3d + 2) = znh4no3 * 86400 379 380 #endif 380 381 IF( l_trdtrc ) THEN 381 ztrbio(ji,jj,jk, 1) = zno3phy382 ztrbio(ji,jj,jk, 2) = znh4phy383 ztrbio(ji,jj,jk, 3) = zphynh4384 ztrbio(ji,jj,jk, 4) = zphydom385 ztrbio(ji,jj,jk, 5) = zphyzoo386 ztrbio(ji,jj,jk, 6) = zphydet387 ztrbio(ji,jj,jk, 7) = zdetzoo382 ztrbio(ji,jj,jk,jp_lob0_trd ) = zno3phy 383 ztrbio(ji,jj,jk,jp_lob0_trd + 1) = znh4phy 384 ztrbio(ji,jj,jk,jp_lob0_trd + 2) = zphynh4 385 ztrbio(ji,jj,jk,jp_lob0_trd + 3) = zphydom 386 ztrbio(ji,jj,jk,jp_lob0_trd + 4) = zphyzoo 387 ztrbio(ji,jj,jk,jp_lob0_trd + 5) = zphydet 388 ztrbio(ji,jj,jk,jp_lob0_trd + 6) = zdetzoo 388 389 ! trend number 8 in trcsed 389 ztrbio(ji,jj,jk, 9) = zzoodet390 ztrbio(ji,jj,jk, 10) = zzoobod391 ztrbio(ji,jj,jk, 11) = zzoonh4392 ztrbio(ji,jj,jk, 12) = zzoodom393 ztrbio(ji,jj,jk, 13) = znh4no3394 ztrbio(ji,jj,jk, 14) = zdomnh4395 ztrbio(ji,jj,jk, 15) = zdetnh4396 ztrbio(ji,jj,jk, 16) = zdetdom390 ztrbio(ji,jj,jk,jp_lob0_trd + 8) = zzoodet 391 ztrbio(ji,jj,jk,jp_lob0_trd + 9) = zzoobod 392 ztrbio(ji,jj,jk,jp_lob0_trd + 10) = zzoonh4 393 ztrbio(ji,jj,jk,jp_lob0_trd + 11) = zzoodom 394 ztrbio(ji,jj,jk,jp_lob0_trd + 12) = znh4no3 395 ztrbio(ji,jj,jk,jp_lob0_trd + 13) = zdomnh4 396 ztrbio(ji,jj,jk,jp_lob0_trd + 14) = zdetnh4 397 ztrbio(ji,jj,jk,jp_lob0_trd + 15) = zdetdom 397 398 ! trend number 17 in trcexp 398 399 ENDIF … … 413 414 #if defined key_trc_diaadd 414 415 ! Lateral boundary conditions on trc2d and trc3d 415 DO jl = 1, jp_lobster_2d416 DO jl = jp_lob0_2d, jp_lob1_2d 416 417 CALL lbc_lnk( trc2d(:,:,jl),'T', 1. ) 417 418 END DO 418 DO jl = 1, jp_lobster_3d419 DO jl = jp_lob0_3d, jp_lob1_3d 419 420 CALL lbc_lnk( trc3d(:,:,1,jl),'T', 1. ) 420 421 END DO … … 423 424 #if defined key_trc_diabio 424 425 ! Lateral boundary conditions on trcbio 425 DO jl = 1, jp_lobster_trd426 DO jl = jp_lob0_trd, jp_lob1_trd 426 427 CALL lbc_lnk( trbio(:,:,1,jl),'T', 1. ) 427 428 END DO … … 429 430 ! 430 431 IF( l_trdtrc ) THEN 431 DO jl = 1, jp_lobster_trd432 DO jl = jp_lob0_trd, jp_lob1_trd 432 433 CALL trd_mod_trc( ztrbio(:,:,:,jl), jl, kt ) ! handle the trend 433 434 END DO -
trunk/NEMO/TOP_SRC/LOBSTER/trcctl_lobster.F90
r1146 r1255 33 33 !! ** Purpose : control the cpp options, namelist and files 34 34 !!---------------------------------------------------------------------- 35 INTEGER :: j n35 INTEGER :: jl, jn 36 36 37 37 IF(lwp) WRITE(numout,*) … … 78 78 WRITE (numout,*) ' ======= ============= ' 79 79 WRITE (numout,*) ' we force tracer names' 80 DO jn = jp_lob0, jp_lob1 80 DO jl = 1, jp_lobster 81 jn = jp_lob0 + jl - 1 81 82 WRITE(numout,*) ' tracer nb: ',jn,' name = ',ctrcnm(jn), ctrcnl(jn) 82 83 END DO … … 86 87 87 88 ! Check tracer units 88 DO jn = jp_lob0, jp_lob1 89 DO jl = 1, jp_lobster 90 jn = jp_lob0 + jl - 1 89 91 IF( ctrcun(jn) /= 'mmole-N/m3') THEN 90 92 ctrcun(jn) = 'mmole-N/m3' -
trunk/NEMO/TOP_SRC/LOBSTER/trcexp.F90
r1194 r1255 134 134 ! Oa & Ek: diagnostics depending on jpdia2d ! left as example 135 135 # if defined key_trc_diaadd 136 trc2d(:,:, 19) = sedpocn(:,:)136 trc2d(:,:,jp_lob0_2d + 18) = sedpocn(:,:) 137 137 # endif 138 138 … … 175 175 IF( l_trdtrc ) THEN 176 176 ztrbio(:,:,:) = tra(:,:,:,jpno3) - ztrbio(:,:,:) 177 jl = 17177 jl = jp_lob0_trd + 16 178 178 CALL trd_mod_trc( ztrbio, jl, kt ) ! handle the trend 179 179 ENDIF -
trunk/NEMO/TOP_SRC/LOBSTER/trclsm_lobster.F90
r1146 r1255 40 40 !!---------------------------------------------------------------------- 41 41 CHARACTER (len=32) :: clname 42 INTEGER :: jn42 INTEGER :: numnatl 43 43 !! 44 44 #if defined key_trc_diaadd 45 INTEGER :: jl, jn 45 46 ! definition of additional diagnostic as a structure 46 47 TYPE DIAG … … 54 55 #endif 55 56 #if defined key_trc_diabio 57 INTEGER :: js, jd 56 58 ! definition of additional diagnostic as a structure 57 59 TYPE DIABIO … … 91 93 ! ! ---------------------- 92 94 clname ='namelist_lobster' 93 CALL ctlopn( numnat , clname, 'OLD', 'FORMATTED', 'SEQUENTIAL', 1, numout, .FALSE., 1 )95 CALL ctlopn( numnatl, clname, 'OLD', 'FORMATTED', 'SEQUENTIAL', 1, numout, .FALSE., 1 ) 94 96 95 97 ! namlobphy : parameters for phytoplankton … … 104 106 toptp = 0. 105 107 106 REWIND( numnat )107 READ ( numnat , namlobphy )108 REWIND( numnatl ) 109 READ ( numnatl, namlobphy ) 108 110 109 111 IF(lwp) THEN … … 128 130 taunn = 0. 129 131 130 REWIND( numnat )131 READ ( numnat , namlobnut )132 REWIND( numnatl ) 133 READ ( numnatl, namlobnut ) 132 134 IF(lwp) THEN 133 135 WRITE(numout,*) ' Namelist namlobnut' … … 155 157 fdbod = 0. 156 158 157 REWIND( numnat )158 READ ( numnat , namlobzoo )159 REWIND( numnatl ) 160 READ ( numnatl, namlobzoo ) 159 161 160 162 IF(lwp) THEN … … 182 184 fdetlab = 0. 183 185 184 REWIND( numnat )185 READ ( numnat , namlobdet )186 REWIND( numnatl ) 187 READ ( numnatl, namlobdet ) 186 188 187 189 IF(lwp) THEN … … 197 199 taudomn = 0. 198 200 199 REWIND( numnat )200 READ ( numnat , namlobdom )201 REWIND( numnatl ) 202 READ ( numnatl, namlobdom ) 201 203 202 204 IF(lwp) THEN … … 210 212 sedlostpoc = 0. 211 213 212 REWIND( numnat )213 READ ( numnat , namlobsed )214 REWIND( numnatl ) 215 READ ( numnatl, namlobsed ) 214 216 215 217 IF(lwp) THEN … … 233 235 afdmin = 0. 234 236 235 REWIND( numnat )236 READ ( numnat , namlobrat )237 REWIND( numnatl ) 238 READ ( numnatl, namlobrat ) 237 239 238 240 IF(lwp) THEN … … 262 264 rpig = 0. 263 265 264 REWIND( numnat )265 READ ( numnat , namlobopt )266 REWIND( numnatl ) 267 READ ( numnatl, namlobopt ) 266 268 267 269 IF(lwp) THEN … … 284 286 nwritedia = 10 ! default values 285 287 286 DO jn = jp_lob0_2d, jp_lob1_2d 288 DO jl = 1, jp_lobster_2d 289 jn = jp_lob0_2d + jl - 1 287 290 WRITE(ctrc2d(jn),'("2D_",I1)') jn ! short name 288 291 WRITE(ctrc2l(jn),'("2D DIAGNOSTIC NUMBER ",I2)') jn ! long name … … 290 293 END DO 291 294 ! ! 3D output arrays 292 DO jn = jp_lob0_3d, jp_lob1_3d 295 DO jl = 1, jp_lobster_3d 296 jn = jp_lob0_3d + jl - 1 293 297 WRITE(ctrc3d(jn),'("3D_",I1)') jn ! short name 294 298 WRITE(ctrc3l(jn),'("3D DIAGNOSTIC NUMBER ",I2)') jn ! long name … … 296 300 END DO 297 301 298 REWIND( numnat ) ! read natrtd 299 READ ( numnat, namlobdia ) 300 301 DO jn = jp_lob0_2d, jp_lob1_2d 302 ctrc2d(jn) = lobdia2d(jn)%snamedia 303 ctrc2l(jn) = lobdia2d(jn)%lnamedia 304 ctrc2u(jn) = lobdia2d(jn)%unitdia 305 END DO 306 307 DO jn = jp_lob0_3d, jp_lob1_3d 308 ctrc3d(jn) = lobdia3d(jn)%snamedia 309 ctrc3l(jn) = lobdia3d(jn)%lnamedia 310 ctrc3u(jn) = lobdia3d(jn)%unitdia 302 REWIND( numnatl ) ! read natrtd 303 READ ( numnatl, namlobdia ) 304 305 DO jl = 1, jp_lobster_2d 306 jn = jp_lob0_2d + jl - 1 307 ctrc2d(jn) = lobdia2d(jl)%snamedia 308 ctrc2l(jn) = lobdia2d(jl)%lnamedia 309 ctrc2u(jn) = lobdia2d(jl)%unitdia 310 END DO 311 312 DO jl = 1, jp_lobster_3d 313 jn = jp_lob0_3d + jl - 1 314 ctrc3d(jn) = lobdia3d(jl)%snamedia 315 ctrc3l(jn) = lobdia3d(jl)%lnamedia 316 ctrc3u(jn) = lobdia3d(jl)%unitdia 311 317 END DO 312 318 … … 315 321 WRITE(numout,*) ' Namelist : natadd' 316 322 WRITE(numout,*) ' frequency of outputs for additional arrays nwritedia = ', nwritedia 317 DO jn = jp_lob0_3d, jp_lob1_3d 323 DO jl = 1, jp_lobster_3d 324 jn = jp_lob0_3d + jl - 1 318 325 WRITE(numout,*) ' 3d output field No : ',jn 319 326 WRITE(numout,*) ' short name : ', TRIM(ctrc3d(jn)) … … 323 330 END DO 324 331 325 DO jn = jp_lob0_2d, jp_lob1_2d 332 DO jl = 1, jp_lobster_2d 333 jn = jp_lob0_2d + jl - 1 326 334 WRITE(numout,*) ' 2d output field No : ',jn 327 335 WRITE(numout,*) ' short name : ', TRIM(ctrc2d(jn)) … … 338 346 nwritebio = 10 ! default values 339 347 340 DO jn = jp_lob0_trd, jp_lob1_trd 341 IF( jn < 10 ) THEN ; WRITE (ctrbio(jn),'("BIO_",I1)') jn ! short name 342 ELSEIF (jn < 100 ) THEN ; WRITE (ctrbio(jn),'("BIO_",I2)') jn 343 ELSE ; WRITE (ctrbio(jn),'("BIO_",I3)') jn 348 DO js = 1, jp_lobster_trd 349 jd = jp_lob0_trd + js - 1 350 IF( jd < 10 ) THEN ; WRITE (ctrbio(jd),'("BIO_",I1)') jd ! short name 351 ELSEIF (jd < 100 ) THEN ; WRITE (ctrbio(jd),'("BIO_",I2)') jd 352 ELSE ; WRITE (ctrbio(jd),'("BIO_",I3)') jd 344 353 ENDIF 345 WRITE(ctrbil(j n),'("BIOLOGICAL TREND NUMBER ",I2)') jn! long name346 ctrbiu(j n) = 'mmoleN/m3/s ' ! units347 END DO 348 349 REWIND( numnat )350 READ ( numnat , namlobdbi )354 WRITE(ctrbil(jd),'("BIOLOGICAL TREND NUMBER ",I2)') jd ! long name 355 ctrbiu(jd) = 'mmoleN/m3/s ' ! units 356 END DO 357 358 REWIND( numnatl ) 359 READ ( numnatl, namlobdbi ) 351 360 352 DO jn = jp_lob0_trd, jp_lob1_trd 353 ctrbio(jn) = lobdiabio(jn)%snamebio 354 ctrbil(jn) = lobdiabio(jn)%lnamebio 355 ctrbiu(jn) = lobdiabio(jn)%unitbio 361 DO js = 1, jp_lobster_trd 362 jd = jp_lob0_trd + js - 1 363 ctrbio(jd) = lobdiabio(js)%snamebio 364 ctrbil(jd) = lobdiabio(js)%lnamebio 365 ctrbiu(jd) = lobdiabio(js)%unitbio 356 366 END DO 357 367 … … 360 370 WRITE(numout,*) ' Namelist : namlobdbi' 361 371 WRITE(numout,*) ' frequency of outputs for biological trends nwritebio = ', nwritebio 362 DO jn = jp_lob0_trd, jp_lob1_trd 363 WRITE(numout,*) ' biological trend No : ',jn 364 WRITE(numout,*) ' short name : ', TRIM(ctrbio(jn)) 365 WRITE(numout,*) ' long name : ', TRIM(ctrbil(jn)) 366 WRITE(numout,*) ' unit : ', TRIM(ctrbiu(jn)) 372 DO js = 1, jp_lobster_trd 373 jd = jp_lob0_trd + js - 1 374 WRITE(numout,*) ' biological trend No : ',jd 375 WRITE(numout,*) ' short name : ', TRIM(ctrbio(jd)) 376 WRITE(numout,*) ' long name : ', TRIM(ctrbil(jd)) 377 WRITE(numout,*) ' unit : ', TRIM(ctrbiu(jd)) 367 378 WRITE(numout,*) ' ' 368 379 END DO -
trunk/NEMO/TOP_SRC/LOBSTER/trcsed.F90
r1194 r1255 98 98 tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + ztra 99 99 # if defined key_trc_diabio 100 trbio(ji,jj,jk, 8) = ztra100 trbio(ji,jj,jk,jp_lob0_trd + 7) = ztra 101 101 # endif 102 102 # if defined key_trc_diaadd 103 trc2d(ji,jj, 8) = trc2d(ji,jj,8) + ztra * fse3t(ji,jj,jk) * 86400.103 trc2d(ji,jj,jp_lob0_2d + 7) = trc2d(ji,jj,jp_lob0_2d + 7) + ztra * fse3t(ji,jj,jk) * 86400. 104 104 # endif 105 105 END DO … … 108 108 109 109 #if defined key_trc_diabio 110 CALL lbc_lnk (trbio(:,:,1,8), 'T', 1. ) ! Lateral boundary conditions on trcbio 110 jl = jp_lob0_trd + 7 111 CALL lbc_lnk (trbio(:,:,1,jl), 'T', 1. ) ! Lateral boundary conditions on trcbio 111 112 #endif 112 113 #if defined key_trc_diaadd 113 CALL lbc_lnk( trc2d(:,:,8), 'T', 1. ) ! Lateral boundary conditions on trc2d 114 jl = jp_lob0_2d + 7 115 CALL lbc_lnk( trc2d(:,:,jl), 'T', 1. ) ! Lateral boundary conditions on trc2d 114 116 #endif 115 117 ! … … 117 119 IF( l_trdtrc ) THEN 118 120 ztrbio(:,:,:) = tra(:,:,:,jpdet) - ztrbio(:,:,:) 119 jl = 8121 jl = jp_lob0_trd + 7 120 122 CALL trd_mod_trc( ztrbio, jl, kt ) ! handle the trend 121 123 ENDIF -
trunk/NEMO/TOP_SRC/LOBSTER/trcsms_lobster.F90
r1176 r1255 58 58 59 59 IF( l_trdtrc ) THEN 60 DO jn = 1, jptra60 DO jn = jp_lob0, jp_lob1 61 61 ztrlob(:,:,:) = tra(:,:,:,jn) 62 62 CALL trd_mod_trc( ztrlob, jn, jptrc_trd_sms, kt ) ! save trends -
trunk/NEMO/TOP_SRC/MY_TRC/trcctl_my_trc.F90
r1162 r1255 35 35 !!---------------------------------------------------------------------- 36 36 37 INTEGER :: j n37 INTEGER :: jl, jn 38 38 39 39 IF(lwp) WRITE(numout,*) 40 40 IF(lwp) WRITE(numout,*) ' use COLOR tracer ' 41 41 42 DO jn = jp_myt0, jp_myt1 42 DO jn = 1, jp_my_trc 43 jn = jp_myt0 + jl - 1 43 44 WRITE(ctrcnm(jn),'(a,i2.2)') 'CLR',jn 44 45 ctrcnl(jn)='Color concentration' -
trunk/NEMO/TOP_SRC/MY_TRC/trcini_my_trc.F90
r1162 r1255 43 43 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 44 44 45 trn(:,:,:,jp_myt0:jp_myt1) = 0.45 IF( .NOT. lrsttr ) trn(:,:,:,jp_myt0:jp_myt1) = 0. 46 46 47 47 ! -
trunk/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90
r1162 r1255 13 13 !!---------------------------------------------------------------------- 14 14 USE par_trc ! TOP parameters 15 USE oce_trc 16 USE trc 15 USE oce_trc ! Ocean variables 16 USE trc ! TOP variables 17 USE trdmld_trc_oce 18 USE trdmld_trc 17 19 18 20 IMPLICIT NONE … … 38 40 !!---------------------------------------------------------------------- 39 41 INTEGER, INTENT(in) :: kt ! ocean time-step index 42 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrmyt 43 INTEGER :: jn 44 40 45 41 46 IF(lwp) WRITE(numout,*) … … 55 60 END WHERE 56 61 62 ! Save the trends in the ixed layer 63 IF( l_trdtrc ) THEN 64 DO jn = jp_myt0, jp_myt1 65 ztrmyt(:,:,:) = tra(:,:,:,jn) 66 CALL trd_mod_trc( ztrmyt, jn, jptrc_trd_sms, kt ) ! save trends 67 END DO 68 END IF 57 69 ! 58 70 END SUBROUTINE trc_sms_my_trc -
trunk/NEMO/TOP_SRC/PISCES/p4zprod.F90
r1180 r1255 73 73 REAL(wp) :: zmxltst, zmxlday, zlim1 74 74 REAL(wp) :: zpislopen , zpislope2n 75 REAL(wp) :: zrum, zcodel, zargu 75 REAL(wp) :: zrum, zcodel, zargu, zvol 76 76 REAL(wp), DIMENSION(jpi,jpj) :: zmixnano , zmixdiat, zstrn 77 77 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpislopead , zpislopead2 … … 355 355 DO jj = 1, jpj 356 356 DO ji = 1, jpi 357 tpp = tpp + ( zprorca(ji,jj,jk) + zprorcad(ji,jj,jk) ) &357 zvol = cvol(ji,jj,jk) 358 358 #if defined key_off_degrad 359 & * facvol(ji,jj,jk) &359 zvol = zvol * facvol(ji,jj,jk) 360 360 #endif 361 & * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) * tmask_i(ji,jj)361 tpp = tpp + ( zprorca(ji,jj,jk) + zprorcad(ji,jj,jk) ) * zvol 362 362 END DO 363 363 END DO 364 364 END DO 365 366 IF( lk_mpp ) CALL mpp_sum( tpp ) 365 367 366 368 IF( MOD( kt, nspyr ) == 0 ) THEN -
trunk/NEMO/TOP_SRC/PISCES/p4zrem.F90
r1152 r1255 65 65 REAL(wp) :: zkeq , zfeequi, zsiremin 66 66 REAL(wp) :: zsatur, zsatur2, znusil 67 REAL(wp) :: zbactfer, zorem, zorem2, zofer, zofer2 68 REAL(wp) :: zosil, zdenom, zdenom1, zdenom2, zscave, zaggdfe 67 REAL(wp) :: zbactfer, zorem, zorem2, zofer 68 REAL(wp) :: zosil, zdenom1, zscave, zaggdfe 69 #if ! defined key_kriest 70 REAL(wp) :: zofer2, zdenom, zdenom2 71 #endif 69 72 REAL(wp) :: zlamfac, zstep, zonitr 70 73 REAL(wp), DIMENSION(jpi,jpj) :: ztempbac … … 302 305 303 306 #if defined key_kriest 304 zdenom1 = trn(ji,jj,jk,jppoc) / &307 zdenom1 = trn(ji,jj,jk,jppoc) / & 305 308 & ( trn(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpdsi) + trn(ji,jj,jk,jpcal) + rtrn ) 306 309 #else -
trunk/NEMO/TOP_SRC/PISCES/p4zsed.F90
r1180 r1255 269 269 DO jj = 1,jpj 270 270 DO ji = 1,jpi 271 zdenitot = zdenitot + denitr(ji,jj,jk) * rdenit * e1t(ji,jj) * e2t(ji,jj) & 272 & *fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) * xnegtr(ji,jj,jk) 271 zdenitot = zdenitot + denitr(ji,jj,jk) * rdenit * cvol(ji,jj,jk) * xnegtr(ji,jj,jk) 273 272 END DO 274 273 END DO … … 302 301 DO jj = 1, jpj 303 302 DO ji = 1, jpi 304 znitrpottot = znitrpottot + znitrpot(ji,jj,jk) * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) & 305 & * tmask(ji,jj,jk) * tmask_i(ji,jj) 303 znitrpottot = znitrpottot + znitrpot(ji,jj,jk) * cvol(ji,jj,jk) 306 304 END DO 307 305 END DO … … 596 594 DO jj = 2 , jpjm1 597 595 DO ji = 2, jpim1 598 zcoef = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,1) * tmask(ji,jj,1) * tmask_i(ji,jj) * raass596 zcoef = cvol(ji,jj,1) * raass 599 597 rivpo4input = rivpo4input + rivinp(ji,jj) * zcoef 600 598 rivalkinput = rivalkinput + cotdep(ji,jj) * zcoef -
trunk/NEMO/TOP_SRC/PISCES/trclsm_pisces.F90
r1146 r1255 46 46 !!---------------------------------------------------------------------- 47 47 CHARACTER (len=32) :: clname 48 INTEGER :: jn49 48 !! 50 49 #if defined key_trc_diaadd 50 INTEGER :: jl, jn 51 51 ! definition of additional diagnostic as a structure 52 52 TYPE DIAG … … 127 127 nwritedia = 10 ! default values 128 128 129 DO jn = jp_pcs0_2d, jp_pcs1_2d 129 DO jl = 1, jp_pisces_2d 130 jn = jp_pcs0_2d + jl - 1 130 131 WRITE(ctrc2d(jn),'("2D_",I1)') jn ! short name 131 132 WRITE(ctrc2l(jn),'("2D DIAGNOSTIC NUMBER ",I2)') jn ! long name … … 133 134 END DO 134 135 ! ! 3D output arrays 135 DO jn = jp_pcs0_3d, jp_pcs1_3d 136 DO jl = 1, jp_pisces_3d 137 jn = jp_pcs0_3d + jl - 1 136 138 WRITE(ctrc3d(jn),'("3D_",I1)') jn ! short name 137 139 WRITE(ctrc3l(jn),'("3D DIAGNOSTIC NUMBER ",I2)') jn ! long name … … 142 144 READ ( numnat, nampisdia ) 143 145 144 DO jn = jp_pcs0_2d, jp_pcs1_2d 145 ctrc2d(jn) = pisdia2d(jn)%snamedia 146 ctrc2l(jn) = pisdia2d(jn)%lnamedia 147 ctrc2u(jn) = pisdia2d(jn)%unitdia 146 DO jl = 1, jp_pisces_2d 147 jn = jp_pcs0_2d + jl - 1 148 ctrc2d(jn) = pisdia2d(jl)%snamedia 149 ctrc2l(jn) = pisdia2d(jl)%lnamedia 150 ctrc2u(jn) = pisdia2d(jl)%unitdia 148 151 END DO 149 152 150 DO jn = jp_pcs0_3d, jp_pcs1_3d 151 ctrc3d(jn) = pisdia3d(jn)%snamedia 152 ctrc3l(jn) = pisdia3d(jn)%lnamedia 153 ctrc3u(jn) = pisdia3d(jn)%unitdia 153 DO jl = 1, jp_pisces_3d 154 jn = jp_pcs0_3d + jl - 1 155 ctrc3d(jn) = pisdia3d(jl)%snamedia 156 ctrc3l(jn) = pisdia3d(jl)%lnamedia 157 ctrc3u(jn) = pisdia3d(jl)%unitdia 154 158 END DO 155 159 … … 158 162 WRITE(numout,*) ' Namelist : natadd' 159 163 WRITE(numout,*) ' frequency of outputs for additional arrays nwritedia = ', nwritedia 160 DO jn = jp_pcs0_3d, jp_pcs1_3d 164 DO jl = 1, jp_pisces_3d 165 jn = jp_pcs0_3d + jl - 1 161 166 WRITE(numout,*) ' 3d output field No : ',jn 162 167 WRITE(numout,*) ' short name : ', TRIM(ctrc3d(jn)) … … 166 171 END DO 167 172 168 DO jn = jp_pcs0_2d, jp_pcs1_2d 173 DO jl = 1, jp_pisces_2d 174 jn = jp_pcs0_2d + jl - 1 169 175 WRITE(numout,*) ' 2d output field No : ',jn 170 176 WRITE(numout,*) ' short name : ', TRIM(ctrc2d(jn)) -
trunk/NEMO/TOP_SRC/PISCES/trcsms_pisces.F90
r1185 r1255 25 25 USE p4zlys ! 26 26 USE p4zflx ! 27 28 USE trdmld_trc_oce 29 USE trdmld_trc 27 30 28 31 USE sedmodel … … 55 58 !! 56 59 INTEGER :: jnt, jn 60 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrpis ! used for pisces sms trends 57 61 !!--------------------------------------------------------------------- 58 62 … … 62 66 63 67 CALL p4z_che ! computation of chemical constants 64 65 68 CALL p4z_int ! computation of various rates for biogeochemistry 66 69 ! … … 71 74 ! 72 75 CALL p4z_bio (kt, jnt) ! Compute soft tissue production (POC) 73 74 75 76 CALL p4z_sed (kt, jnt) ! compute soft tissue remineralisation 76 77 77 ! 78 78 trb(:,:,:,:) = trn(:,:,:,:) … … 81 81 82 82 CALL p4z_lys( kt ) ! Compute CaCO3 saturation 83 84 83 CALL p4z_flx( kt ) ! Compute surface fluxes 85 84 … … 90 89 CALL lbc_lnk( tra(:,:,:,jn), 'T', 1. ) 91 90 END DO 91 92 IF( l_trdtrc ) THEN 93 DO jn = jp_pcs0, jp_pcs1 94 ztrpis(:,:,:) = tra(:,:,:,jn) 95 CALL trd_mod_trc( ztrpis, jn, jptrc_trd_sms, kt ) ! save trends 96 END DO 97 END IF 92 98 93 99 #if defined key_sed
Note: See TracChangeset
for help on using the changeset viewer.