Changeset 13373 for NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src
- Timestamp:
- 2020-08-03T11:46:38+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src
- Files:
-
- 30 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/NST/agrif_top_sponge.F90
r12489 r13373 67 67 ! 68 68 INTEGER :: ji, jj, jk, jn ! dummy loop indices 69 REAL(wp) :: zabe1, zabe2, ztrelax 70 REAL(wp), DIMENSION(i1:i2,j1:j2) :: ztu, ztv 71 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,1:jptra) :: trbdiff 69 INTEGER :: iku, ikv 70 REAL(wp) :: ztra, zabe1, zabe2, zbtr 71 REAL(wp), DIMENSION(i1:i2,j1:j2,jpk) :: ztu, ztv 72 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) :: trbdiff 72 73 ! vertical interpolation: 73 REAL(wp), DIMENSION(i1:i2,j1:j2,jpk, 1:jptra) ::tabres_child74 REAL(wp), DIMENSION(i1:i2,j1:j2,jpk,n1:n2) ::tabres_child 74 75 REAL(wp), DIMENSION(k1:k2,1:jptra) :: tabin 75 76 REAL(wp), DIMENSION(k1:k2) :: h_in 76 77 REAL(wp), DIMENSION(1:jpk) :: h_out 77 78 INTEGER :: N_in, N_out 78 REAL(wp) :: h_diff79 79 !!---------------------------------------------------------------------- 80 80 ! … … 94 94 DO jj=j1,j2 95 95 DO ji=i1,i2 96 tabres(ji,jj,jk,jpts+1) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kbb_a) 96 tabres(ji,jj,jk,jpts+1) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kbb_a) 97 97 END DO 98 98 END DO … … 128 128 DO jk=1,jpkm1 129 129 # if defined key_vertical 130 trbdiff(ji,jj,jk,1:jptra) = tr(ji,jj,jk,1:jptra,Kbb_a) - tabres_child(ji,jj,jk,1:jptra)130 trbdiff(ji,jj,jk,1:jptra) = ( tr(ji,jj,jk,1:jptra,Kbb_a) - tabres_child(ji,jj,jk,1:jptra) ) * tmask(ji,jj,jk) 131 131 # else 132 trbdiff(ji,jj,jk,1:jptra) = tr(ji,jj,jk,1:jptra,Kbb_a) - tabres(ji,jj,jk,1:jptra)132 trbdiff(ji,jj,jk,1:jptra) = ( tr(ji,jj,jk,1:jptra,Kbb_a) - tabres(ji,jj,jk,1:jptra)) * tmask(ji,jj,jk) 133 133 # endif 134 134 ENDDO … … 136 136 ENDDO 137 137 138 !* set relaxation time scale139 IF( l_1st_euler .AND. lk_agrif_fstep ) THEN ; ztrelax = rn_trelax_tra / ( rn_Dt )140 ELSE ; ztrelax = rn_trelax_tra / (2._wp * rn_Dt )141 ENDIF142 143 138 DO jn = 1, jptra 144 139 DO jk = 1, jpkm1 145 DO jj = j1,j2-1 140 ztu(i1:i2,j1:j2,jk) = 0._wp 141 DO jj = j1,j2 146 142 DO ji = i1,i2-1 147 zabe1 = rn_sponge_tra * fspu(ji,jj) * e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm_a) * umask(ji,jj,jk) 148 zabe2 = rn_sponge_tra * fspv(ji,jj) * e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm_a) * vmask(ji,jj,jk) 149 ztu(ji,jj) = zabe1 * ( trbdiff(ji+1,jj ,jk,jn) - trbdiff(ji,jj,jk,jn) ) 150 ztv(ji,jj) = zabe2 * ( trbdiff(ji ,jj+1,jk,jn) - trbdiff(ji,jj,jk,jn) ) 143 zabe1 = rn_sponge_tra * r1_Dt * fspu(ji,jj) * umask(ji,jj,jk) * e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm_a) 144 ztu(ji,jj,jk) = zabe1 * ( trbdiff(ji+1,jj,jk,jn) - trbdiff(ji,jj,jk,jn) ) 145 END DO 146 END DO 147 ztv(i1:i2,j1:j2,jk) = 0._wp 148 DO ji = i1,i2 149 DO jj = j1,j2-1 150 zabe2 = rn_sponge_tra * r1_Dt * fspv(ji,jj) * vmask(ji,jj,jk) * e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm_a) 151 ztv(ji,jj,jk) = zabe2 * ( trbdiff(ji,jj+1,jk,jn) - trbdiff(ji,jj,jk,jn) ) 151 152 END DO 152 153 END DO 153 154 ! 155 IF( ln_zps ) THEN ! set gradient at partial step level 156 DO jj = j1,j2 157 DO ji = i1,i2 158 ! last level 159 iku = mbku(ji,jj) 160 ikv = mbkv(ji,jj) 161 IF( iku == jk ) ztu(ji,jj,jk) = 0._wp 162 IF( ikv == jk ) ztv(ji,jj,jk) = 0._wp 163 END DO 164 END DO 165 ENDIF 166 END DO 167 ! 168 DO jk = 1, jpkm1 154 169 DO jj = j1+1,j2-1 155 170 DO ji = i1+1,i2-1 156 IF( .NOT. tabspongedone_trn(ji,jj) ) THEN 157 tr(ji,jj,jk,jn,Krhs_a) = tr(ji,jj,jk,jn,Krhs_a) + ( ztu(ji,jj) - ztu(ji-1,jj ) & 158 & + ztv(ji,jj) - ztv(ji ,jj-1) ) & 159 & * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm_a) & 160 & - ztrelax * fspt(ji,jj) * trbdiff(ji,jj,jk,jn) 171 IF( .NOT. tabspongedone_trn(ji,jj) ) THEN 172 zbtr = r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm_a) 173 ! horizontal diffusive trends 174 ztra = zbtr * ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) & 175 & - rn_trelax_tra * r1_Dt * fspt(ji,jj) * trbdiff(ji,jj,jk,jn) 176 ! add it to the general tracer trends 177 tr(ji,jj,jk,jn,Krhs_a) = tr(ji,jj,jk,jn,Krhs_a) + ztra 161 178 ENDIF 162 179 END DO 163 180 END DO 164 181 END DO 165 !166 182 END DO 167 183 ! -
NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/NST/agrif_user.F90
r13295 r13373 749 749 CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge) 750 750 ! reset tsa to zero 751 tr a(:,:,:,:) = 0._wp751 tr(:,:,:,:,Krhs_a) = 0._wp 752 752 753 753 ! 3. Some controls … … 808 808 # else 809 809 ! LAURENT: STRANGE why (3,3) here ? 810 CALL agrif_declare_variable((/2,2,0,0/),(/ 3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_id)811 CALL agrif_declare_variable((/2,2,0,0/),(/ 3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_sponge_id)810 CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_id) 811 CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_sponge_id) 812 812 # endif 813 813 -
NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/OCE/IOM/iom_def.F90
r13286 r13373 25 25 INTEGER, PARAMETER, PUBLIC :: jp_i1 = 204 !: write INTEGER(1) 26 26 27 INTEGER, PARAMETER, PUBLIC :: jpmax_files = 100 !: maximum number of simultaneously opened file27 INTEGER, PARAMETER, PUBLIC :: jpmax_files = 200 !: maximum number of simultaneously opened file 28 28 INTEGER, PARAMETER, PUBLIC :: jpmax_vars = 1200 !: maximum number of variables in one file 29 29 INTEGER, PARAMETER, PUBLIC :: jpmax_dims = 4 !: maximum number of dimensions for one variable -
NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/PISCES/P4Z/p4zche.F90
r13295 r13373 188 188 ! CHEMICAL CONSTANTS - SURFACE LAYER 189 189 ! ---------------------------------- 190 !CDIR NOVERRCHK 191 DO jj = 1, jpj 192 !CDIR NOVERRCHK 193 DO ji = 1, jpi 194 ! ! SET ABSOLUTE TEMPERATURE 195 ztkel = tempis(ji,jj,1) + 273.15 196 zt = ztkel * 0.01 197 zsal = salinprac(ji,jj,1) + ( 1.- tmask(ji,jj,1) ) * 35. 198 ! ! LN(K0) OF SOLUBILITY OF CO2 (EQ. 12, WEISS, 1980) 199 ! ! AND FOR THE ATMOSPHERE FOR NON IDEAL GAS 200 zcek1 = 9345.17/ztkel - 60.2409 + 23.3585 * LOG(zt) + zsal*(0.023517 - 0.00023656*ztkel & 201 & + 0.0047036e-4*ztkel**2) 202 chemc(ji,jj,1) = EXP( zcek1 ) * 1E-6 * rhop(ji,jj,1) / 1000. ! mol/(L atm) 203 chemc(ji,jj,2) = -1636.75 + 12.0408*ztkel - 0.0327957*ztkel**2 + 0.0000316528*ztkel**3 204 chemc(ji,jj,3) = 57.7 - 0.118*ztkel 205 ! 206 END DO 207 END DO 190 DO_2D( 1, 1, 1, 1 ) 191 ! ! SET ABSOLUTE TEMPERATURE 192 ztkel = tempis(ji,jj,1) + 273.15 193 zt = ztkel * 0.01 194 zsal = salinprac(ji,jj,1) + ( 1.- tmask(ji,jj,1) ) * 35. 195 ! ! LN(K0) OF SOLUBILITY OF CO2 (EQ. 12, WEISS, 1980) 196 ! ! AND FOR THE ATMOSPHERE FOR NON IDEAL GAS 197 zcek1 = 9345.17/ztkel - 60.2409 + 23.3585 * LOG(zt) + zsal*(0.023517 - 0.00023656*ztkel & 198 & + 0.0047036e-4*ztkel**2) 199 chemc(ji,jj,1) = EXP( zcek1 ) * 1E-6 * rhop(ji,jj,1) / 1000. ! mol/(L atm) 200 chemc(ji,jj,2) = -1636.75 + 12.0408*ztkel - 0.0327957*ztkel**2 + 0.0000316528*ztkel**3 201 chemc(ji,jj,3) = 57.7 - 0.118*ztkel 202 END_2D 208 203 209 204 ! OXYGEN SOLUBILITY - DEEP OCEAN 210 205 ! ------------------------------- 211 !CDIR NOVERRCHK 212 DO jk = 1, jpk 213 !CDIR NOVERRCHK 214 DO jj = 1, jpj 215 !CDIR NOVERRCHK 216 DO ji = 1, jpi 217 ztkel = tempis(ji,jj,jk) + 273.15 218 zsal = salinprac(ji,jj,jk) + ( 1.- tmask(ji,jj,jk) ) * 35. 219 zsal2 = zsal * zsal 220 ztgg = LOG( ( 298.15 - tempis(ji,jj,jk) ) / ztkel ) ! Set the GORDON & GARCIA scaled temperature 221 ztgg2 = ztgg * ztgg 222 ztgg3 = ztgg2 * ztgg 223 ztgg4 = ztgg3 * ztgg 224 ztgg5 = ztgg4 * ztgg 225 226 zoxy = 2.00856 + 3.22400 * ztgg + 3.99063 * ztgg2 + 4.80299 * ztgg3 & 227 & + 9.78188e-1 * ztgg4 + 1.71069 * ztgg5 + zsal * ( -6.24097e-3 & 228 & - 6.93498e-3 * ztgg - 6.90358e-3 * ztgg2 - 4.29155e-3 * ztgg3 ) & 229 & - 3.11680e-7 * zsal2 230 chemo2(ji,jj,jk) = ( EXP( zoxy ) * o2atm ) * oxyco * atcox ! mol/(L atm) 231 END DO 232 END DO 233 END DO 206 DO_3D( 1, 1, 1, 1, 1, jpk ) 207 ztkel = tempis(ji,jj,jk) + 273.15 208 zsal = salinprac(ji,jj,jk) + ( 1.- tmask(ji,jj,jk) ) * 35. 209 zsal2 = zsal * zsal 210 ztgg = LOG( ( 298.15 - tempis(ji,jj,jk) ) / ztkel ) ! Set the GORDON & GARCIA scaled temperature 211 ztgg2 = ztgg * ztgg 212 ztgg3 = ztgg2 * ztgg 213 ztgg4 = ztgg3 * ztgg 214 ztgg5 = ztgg4 * ztgg 215 216 zoxy = 2.00856 + 3.22400 * ztgg + 3.99063 * ztgg2 + 4.80299 * ztgg3 & 217 & + 9.78188e-1 * ztgg4 + 1.71069 * ztgg5 + zsal * ( -6.24097e-3 & 218 & - 6.93498e-3 * ztgg - 6.90358e-3 * ztgg2 - 4.29155e-3 * ztgg3 ) & 219 & - 3.11680e-7 * zsal2 220 chemo2(ji,jj,jk) = ( EXP( zoxy ) * o2atm ) * oxyco * atcox ! mol/(L atm) 221 END_3D 234 222 235 223 ! CHEMICAL CONSTANTS - DEEP OCEAN 236 224 ! ------------------------------- 237 !CDIR NOVERRCHK 238 DO jk = 1, jpk 239 !CDIR NOVERRCHK 240 DO jj = 1, jpj 241 !CDIR NOVERRCHK 242 DO ji = 1, jpi 243 244 ! SET PRESSION ACCORDING TO SAUNDER (1980) 245 zplat = SIN ( ABS(gphit(ji,jj)*3.141592654/180.) ) 246 zc1 = 5.92E-3 + zplat**2 * 5.25E-3 247 zpres = ((1-zc1)-SQRT(((1-zc1)**2)-(8.84E-6*gdept(ji,jj,jk,Kmm)))) / 4.42E-6 248 zpres = zpres / 10.0 249 250 ! SET ABSOLUTE TEMPERATURE 251 ztkel = tempis(ji,jj,jk) + 273.15 252 zsal = salinprac(ji,jj,jk) + ( 1.-tmask(ji,jj,jk) ) * 35. 253 zsqrt = SQRT( zsal ) 254 zsal15 = zsqrt * zsal 255 zlogt = LOG( ztkel ) 256 ztr = 1. / ztkel 257 zis = 19.924 * zsal / ( 1000.- 1.005 * zsal ) 258 zis2 = zis * zis 259 zisqrt = SQRT( zis ) 260 ztc = tempis(ji,jj,jk) + ( 1.- tmask(ji,jj,jk) ) * 20. 261 262 ! CHLORINITY (WOOSTER ET AL., 1969) 263 zcl = zsal / 1.80655 264 265 ! TOTAL SULFATE CONCENTR. [MOLES/kg soln] 266 zst = 0.14 * zcl /96.062 267 268 ! TOTAL FLUORIDE CONCENTR. [MOLES/kg soln] 269 zft = 0.000067 * zcl /18.9984 270 271 ! DISSOCIATION CONSTANT FOR SULFATES on free H scale (Dickson 1990) 272 zcks = EXP(-4276.1 * ztr + 141.328 - 23.093 * zlogt & 273 & + (-13856. * ztr + 324.57 - 47.986 * zlogt) * zisqrt & 274 & + (35474. * ztr - 771.54 + 114.723 * zlogt) * zis & 275 & - 2698. * ztr * zis**1.5 + 1776.* ztr * zis2 & 276 & + LOG(1.0 - 0.001005 * zsal)) 277 278 ! DISSOCIATION CONSTANT FOR FLUORIDES on free H scale (Dickson and Riley 79) 279 zckf = EXP( 1590.2*ztr - 12.641 + 1.525*zisqrt & 280 & + LOG(1.0d0 - 0.001005d0*zsal) & 281 & + LOG(1.0d0 + zst/zcks)) 282 283 ! DISSOCIATION CONSTANT FOR CARBONATE AND BORATE 284 zckb= (-8966.90 - 2890.53*zsqrt - 77.942*zsal & 285 & + 1.728*zsal15 - 0.0996*zsal*zsal)*ztr & 286 & + (148.0248 + 137.1942*zsqrt + 1.62142*zsal) & 287 & + (-24.4344 - 25.085*zsqrt - 0.2474*zsal) & 288 & * zlogt + 0.053105*zsqrt*ztkel 289 290 ! DISSOCIATION COEFFICIENT FOR CARBONATE ACCORDING TO 291 ! MEHRBACH (1973) REFIT BY MILLERO (1995), seawater scale 292 zck1 = -1.0*(3633.86*ztr - 61.2172 + 9.6777*zlogt & 293 - 0.011555*zsal + 0.0001152*zsal*zsal) 294 zck2 = -1.0*(471.78*ztr + 25.9290 - 3.16967*zlogt & 295 - 0.01781*zsal + 0.0001122*zsal*zsal) 296 297 ! PKW (H2O) (MILLERO, 1995) from composite data 298 zckw = -13847.26 * ztr + 148.9652 - 23.6521 * zlogt + ( 118.67 * ztr & 299 - 5.977 + 1.0495 * zlogt ) * zsqrt - 0.01615 * zsal 300 301 ! CONSTANTS FOR PHOSPHATE (MILLERO, 1995) 302 zck1p = -4576.752*ztr + 115.540 - 18.453*zlogt & 303 & + (-106.736*ztr + 0.69171) * zsqrt & 304 & + (-0.65643*ztr - 0.01844) * zsal 305 306 zck2p = -8814.715*ztr + 172.1033 - 27.927*zlogt & 307 & + (-160.340*ztr + 1.3566)*zsqrt & 308 & + (0.37335*ztr - 0.05778)*zsal 309 310 zck3p = -3070.75*ztr - 18.126 & 311 & + (17.27039*ztr + 2.81197) * zsqrt & 312 & + (-44.99486*ztr - 0.09984) * zsal 313 314 ! CONSTANT FOR SILICATE, MILLERO (1995) 315 zcksi = -8904.2*ztr + 117.400 - 19.334*zlogt & 316 & + (-458.79*ztr + 3.5913) * zisqrt & 317 & + (188.74*ztr - 1.5998) * zis & 318 & + (-12.1652*ztr + 0.07871) * zis2 & 319 & + LOG(1.0 - 0.001005*zsal) 320 321 ! APPARENT SOLUBILITY PRODUCT K'SP OF CALCITE IN SEAWATER 322 ! (S=27-43, T=2-25 DEG C) at pres =0 (atmos. pressure) (MUCCI 1983) 323 zaksp0 = -171.9065 -0.077993*ztkel + 2839.319*ztr + 71.595*LOG10( ztkel ) & 324 & + (-0.77712 + 0.00284263*ztkel + 178.34*ztr) * zsqrt & 325 & - 0.07711*zsal + 0.0041249*zsal15 326 327 ! CONVERT FROM DIFFERENT PH SCALES 328 total2free = 1.0/(1.0 + zst/zcks) 329 free2SWS = 1. + zst/zcks + zft/(zckf*total2free) 330 total2SWS = total2free * free2SWS 331 SWS2total = 1.0 / total2SWS 332 333 ! K1, K2 OF CARBONIC ACID, KB OF BORIC ACID, KW (H2O) (LIT.?) 334 zak1 = 10**(zck1) * total2SWS 335 zak2 = 10**(zck2) * total2SWS 336 zakb = EXP( zckb ) * total2SWS 337 zakw = EXP( zckw ) 338 zaksp1 = 10**(zaksp0) 339 zak1p = exp( zck1p ) 340 zak2p = exp( zck2p ) 341 zak3p = exp( zck3p ) 342 zaksi = exp( zcksi ) 343 zckf = zckf * total2SWS 344 345 ! FORMULA FOR CPEXP AFTER EDMOND & GIESKES (1970) 346 ! (REFERENCE TO CULBERSON & PYTKOQICZ (1968) AS MADE 347 ! IN BROECKER ET AL. (1982) IS INCORRECT; HERE RGAS IS 348 ! TAKEN TENFOLD TO CORRECT FOR THE NOTATION OF pres IN 349 ! DBAR INSTEAD OF BAR AND THE EXPRESSION FOR CPEXP IS 350 ! MULTIPLIED BY LN(10.) TO ALLOW USE OF EXP-FUNCTION 351 ! WITH BASIS E IN THE FORMULA FOR AKSPP (CF. EDMOND 352 ! & GIESKES (1970), P. 1285-1286 (THE SMALL 353 ! FORMULA ON P. 1286 IS RIGHT AND CONSISTENT WITH THE 354 ! SIGN IN PARTIAL MOLAR VOLUME CHANGE AS SHOWN ON P. 1285)) 355 zcpexp = zpres / (rgas*ztkel) 356 zcpexp2 = zpres * zcpexp 357 358 ! KB OF BORIC ACID, K1,K2 OF CARBONIC ACID PRESSURE 359 ! CORRECTION AFTER CULBERSON AND PYTKOWICZ (1968) 360 ! (CF. BROECKER ET AL., 1982) 361 362 zbuf1 = - ( devk10 + devk20 * ztc + devk30 * ztc * ztc ) 363 zbuf2 = 0.5 * ( devk40 + devk50 * ztc ) 364 ak13(ji,jj,jk) = zak1 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 365 366 zbuf1 = - ( devk11 + devk21 * ztc + devk31 * ztc * ztc ) 367 zbuf2 = 0.5 * ( devk41 + devk51 * ztc ) 368 ak23(ji,jj,jk) = zak2 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 369 370 zbuf1 = - ( devk12 + devk22 * ztc + devk32 * ztc * ztc ) 371 zbuf2 = 0.5 * ( devk42 + devk52 * ztc ) 372 akb3(ji,jj,jk) = zakb * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 373 374 zbuf1 = - ( devk13 + devk23 * ztc + devk33 * ztc * ztc ) 375 zbuf2 = 0.5 * ( devk43 + devk53 * ztc ) 376 akw3(ji,jj,jk) = zakw * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 377 378 zbuf1 = - ( devk14 + devk24 * ztc + devk34 * ztc * ztc ) 379 zbuf2 = 0.5 * ( devk44 + devk54 * ztc ) 380 aks3(ji,jj,jk) = zcks * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 381 382 zbuf1 = - ( devk15 + devk25 * ztc + devk35 * ztc * ztc ) 383 zbuf2 = 0.5 * ( devk45 + devk55 * ztc ) 384 akf3(ji,jj,jk) = zckf * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 385 386 zbuf1 = - ( devk17 + devk27 * ztc + devk37 * ztc * ztc ) 387 zbuf2 = 0.5 * ( devk47 + devk57 * ztc ) 388 ak1p3(ji,jj,jk) = zak1p * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 389 390 zbuf1 = - ( devk18 + devk28 * ztc + devk38 * ztc * ztc ) 391 zbuf2 = 0.5 * ( devk48 + devk58 * ztc ) 392 ak2p3(ji,jj,jk) = zak2p * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 393 394 zbuf1 = - ( devk19 + devk29 * ztc + devk39 * ztc * ztc ) 395 zbuf2 = 0.5 * ( devk49 + devk59 * ztc ) 396 ak3p3(ji,jj,jk) = zak3p * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 397 398 zbuf1 = - ( devk110 + devk210 * ztc + devk310 * ztc * ztc ) 399 zbuf2 = 0.5 * ( devk410 + devk510 * ztc ) 400 aksi3(ji,jj,jk) = zaksi * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 401 402 ! CONVERT FROM DIFFERENT PH SCALES 403 total2free = 1.0/(1.0 + zst/aks3(ji,jj,jk)) 404 free2SWS = 1. + zst/aks3(ji,jj,jk) + zft/akf3(ji,jj,jk) 405 total2SWS = total2free * free2SWS 406 SWS2total = 1.0 / total2SWS 407 408 ! Convert to total scale 409 ak13(ji,jj,jk) = ak13(ji,jj,jk) * SWS2total 410 ak23(ji,jj,jk) = ak23(ji,jj,jk) * SWS2total 411 akb3(ji,jj,jk) = akb3(ji,jj,jk) * SWS2total 412 akw3(ji,jj,jk) = akw3(ji,jj,jk) * SWS2total 413 ak1p3(ji,jj,jk) = ak1p3(ji,jj,jk) * SWS2total 414 ak2p3(ji,jj,jk) = ak2p3(ji,jj,jk) * SWS2total 415 ak3p3(ji,jj,jk) = ak3p3(ji,jj,jk) * SWS2total 416 aksi3(ji,jj,jk) = aksi3(ji,jj,jk) * SWS2total 417 akf3(ji,jj,jk) = akf3(ji,jj,jk) / total2free 418 419 ! APPARENT SOLUBILITY PRODUCT K'SP OF CALCITE 420 ! AS FUNCTION OF PRESSURE FOLLOWING MILLERO 421 ! (P. 1285) AND BERNER (1976) 422 zbuf1 = - ( devk16 + devk26 * ztc + devk36 * ztc * ztc ) 423 zbuf2 = 0.5 * ( devk46 + devk56 * ztc ) 424 aksp(ji,jj,jk) = zaksp1 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 425 426 ! TOTAL F, S, and BORATE CONCENTR. [MOLES/L] 427 borat(ji,jj,jk) = 0.0002414 * zcl / 10.811 428 sulfat(ji,jj,jk) = zst 429 fluorid(ji,jj,jk) = zft 430 431 ! Iron and SIO3 saturation concentration from ... 432 sio3eq(ji,jj,jk) = EXP( LOG( 10.) * ( 6.44 - 968. / ztkel ) ) * 1.e-6 433 fekeq (ji,jj,jk) = 10**( 17.27 - 1565.7 / ztkel ) 434 435 ! Liu and Millero (1999) only valid 5 - 50 degC 436 ztkel1 = MAX( 5. , tempis(ji,jj,jk) ) + 273.16 437 fesol(ji,jj,jk,1) = 10**(-13.486 - 0.1856* zis**0.5 + 0.3073*zis + 5254.0/ztkel1) 438 fesol(ji,jj,jk,2) = 10**(2.517 - 0.8885*zis**0.5 + 0.2139 * zis - 1320.0/ztkel1 ) 439 fesol(ji,jj,jk,3) = 10**(0.4511 - 0.3305*zis**0.5 - 1996.0/ztkel1 ) 440 fesol(ji,jj,jk,4) = 10**(-0.2965 - 0.7881*zis**0.5 - 4086.0/ztkel1 ) 441 fesol(ji,jj,jk,5) = 10**(4.4466 - 0.8505*zis**0.5 - 7980.0/ztkel1 ) 442 END DO 443 END DO 444 END DO 225 DO_3D( 1, 1, 1, 1, 1, jpk ) 226 ! SET PRESSION ACCORDING TO SAUNDER (1980) 227 zplat = SIN ( ABS(gphit(ji,jj)*3.141592654/180.) ) 228 zc1 = 5.92E-3 + zplat**2 * 5.25E-3 229 zpres = ((1-zc1)-SQRT(((1-zc1)**2)-(8.84E-6*gdept(ji,jj,jk,Kmm)))) / 4.42E-6 230 zpres = zpres / 10.0 231 232 ! SET ABSOLUTE TEMPERATURE 233 ztkel = tempis(ji,jj,jk) + 273.15 234 zsal = salinprac(ji,jj,jk) + ( 1.-tmask(ji,jj,jk) ) * 35. 235 zsqrt = SQRT( zsal ) 236 zsal15 = zsqrt * zsal 237 zlogt = LOG( ztkel ) 238 ztr = 1. / ztkel 239 zis = 19.924 * zsal / ( 1000.- 1.005 * zsal ) 240 zis2 = zis * zis 241 zisqrt = SQRT( zis ) 242 ztc = tempis(ji,jj,jk) + ( 1.- tmask(ji,jj,jk) ) * 20. 243 244 ! CHLORINITY (WOOSTER ET AL., 1969) 245 zcl = zsal / 1.80655 246 247 ! TOTAL SULFATE CONCENTR. [MOLES/kg soln] 248 zst = 0.14 * zcl /96.062 249 250 ! TOTAL FLUORIDE CONCENTR. [MOLES/kg soln] 251 zft = 0.000067 * zcl /18.9984 252 253 ! DISSOCIATION CONSTANT FOR SULFATES on free H scale (Dickson 1990) 254 zcks = EXP(-4276.1 * ztr + 141.328 - 23.093 * zlogt & 255 & + (-13856. * ztr + 324.57 - 47.986 * zlogt) * zisqrt & 256 & + (35474. * ztr - 771.54 + 114.723 * zlogt) * zis & 257 & - 2698. * ztr * zis**1.5 + 1776.* ztr * zis2 & 258 & + LOG(1.0 - 0.001005 * zsal)) 259 260 ! DISSOCIATION CONSTANT FOR FLUORIDES on free H scale (Dickson and Riley 79) 261 zckf = EXP( 1590.2*ztr - 12.641 + 1.525*zisqrt & 262 & + LOG(1.0d0 - 0.001005d0*zsal) & 263 & + LOG(1.0d0 + zst/zcks)) 264 265 ! DISSOCIATION CONSTANT FOR CARBONATE AND BORATE 266 zckb= (-8966.90 - 2890.53*zsqrt - 77.942*zsal & 267 & + 1.728*zsal15 - 0.0996*zsal*zsal)*ztr & 268 & + (148.0248 + 137.1942*zsqrt + 1.62142*zsal) & 269 & + (-24.4344 - 25.085*zsqrt - 0.2474*zsal) & 270 & * zlogt + 0.053105*zsqrt*ztkel 271 272 ! DISSOCIATION COEFFICIENT FOR CARBONATE ACCORDING TO 273 ! MEHRBACH (1973) REFIT BY MILLERO (1995), seawater scale 274 zck1 = -1.0*(3633.86*ztr - 61.2172 + 9.6777*zlogt & 275 - 0.011555*zsal + 0.0001152*zsal*zsal) 276 zck2 = -1.0*(471.78*ztr + 25.9290 - 3.16967*zlogt & 277 - 0.01781*zsal + 0.0001122*zsal*zsal) 278 279 ! PKW (H2O) (MILLERO, 1995) from composite data 280 zckw = -13847.26 * ztr + 148.9652 - 23.6521 * zlogt + ( 118.67 * ztr & 281 - 5.977 + 1.0495 * zlogt ) * zsqrt - 0.01615 * zsal 282 283 ! CONSTANTS FOR PHOSPHATE (MILLERO, 1995) 284 zck1p = -4576.752*ztr + 115.540 - 18.453*zlogt & 285 & + (-106.736*ztr + 0.69171) * zsqrt & 286 & + (-0.65643*ztr - 0.01844) * zsal 287 288 zck2p = -8814.715*ztr + 172.1033 - 27.927*zlogt & 289 & + (-160.340*ztr + 1.3566)*zsqrt & 290 & + (0.37335*ztr - 0.05778)*zsal 291 292 zck3p = -3070.75*ztr - 18.126 & 293 & + (17.27039*ztr + 2.81197) * zsqrt & 294 & + (-44.99486*ztr - 0.09984) * zsal 295 296 ! CONSTANT FOR SILICATE, MILLERO (1995) 297 zcksi = -8904.2*ztr + 117.400 - 19.334*zlogt & 298 & + (-458.79*ztr + 3.5913) * zisqrt & 299 & + (188.74*ztr - 1.5998) * zis & 300 & + (-12.1652*ztr + 0.07871) * zis2 & 301 & + LOG(1.0 - 0.001005*zsal) 302 303 ! APPARENT SOLUBILITY PRODUCT K'SP OF CALCITE IN SEAWATER 304 ! (S=27-43, T=2-25 DEG C) at pres =0 (atmos. pressure) (MUCCI 1983) 305 zaksp0 = -171.9065 -0.077993*ztkel + 2839.319*ztr + 71.595*LOG10( ztkel ) & 306 & + (-0.77712 + 0.00284263*ztkel + 178.34*ztr) * zsqrt & 307 & - 0.07711*zsal + 0.0041249*zsal15 308 309 ! CONVERT FROM DIFFERENT PH SCALES 310 total2free = 1.0/(1.0 + zst/zcks) 311 free2SWS = 1. + zst/zcks + zft/(zckf*total2free) 312 total2SWS = total2free * free2SWS 313 SWS2total = 1.0 / total2SWS 314 315 ! K1, K2 OF CARBONIC ACID, KB OF BORIC ACID, KW (H2O) (LIT.?) 316 zak1 = 10**(zck1) * total2SWS 317 zak2 = 10**(zck2) * total2SWS 318 zakb = EXP( zckb ) * total2SWS 319 zakw = EXP( zckw ) 320 zaksp1 = 10**(zaksp0) 321 zak1p = exp( zck1p ) 322 zak2p = exp( zck2p ) 323 zak3p = exp( zck3p ) 324 zaksi = exp( zcksi ) 325 zckf = zckf * total2SWS 326 327 ! FORMULA FOR CPEXP AFTER EDMOND & GIESKES (1970) 328 ! (REFERENCE TO CULBERSON & PYTKOQICZ (1968) AS MADE 329 ! IN BROECKER ET AL. (1982) IS INCORRECT; HERE RGAS IS 330 ! TAKEN TENFOLD TO CORRECT FOR THE NOTATION OF pres IN 331 ! DBAR INSTEAD OF BAR AND THE EXPRESSION FOR CPEXP IS 332 ! MULTIPLIED BY LN(10.) TO ALLOW USE OF EXP-FUNCTION 333 ! WITH BASIS E IN THE FORMULA FOR AKSPP (CF. EDMOND 334 ! & GIESKES (1970), P. 1285-1286 (THE SMALL 335 ! FORMULA ON P. 1286 IS RIGHT AND CONSISTENT WITH THE 336 ! SIGN IN PARTIAL MOLAR VOLUME CHANGE AS SHOWN ON P. 1285)) 337 zcpexp = zpres / (rgas*ztkel) 338 zcpexp2 = zpres * zcpexp 339 340 ! KB OF BORIC ACID, K1,K2 OF CARBONIC ACID PRESSURE 341 ! CORRECTION AFTER CULBERSON AND PYTKOWICZ (1968) 342 ! (CF. BROECKER ET AL., 1982) 343 344 zbuf1 = - ( devk10 + devk20 * ztc + devk30 * ztc * ztc ) 345 zbuf2 = 0.5 * ( devk40 + devk50 * ztc ) 346 ak13(ji,jj,jk) = zak1 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 347 348 zbuf1 = - ( devk11 + devk21 * ztc + devk31 * ztc * ztc ) 349 zbuf2 = 0.5 * ( devk41 + devk51 * ztc ) 350 ak23(ji,jj,jk) = zak2 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 351 352 zbuf1 = - ( devk12 + devk22 * ztc + devk32 * ztc * ztc ) 353 zbuf2 = 0.5 * ( devk42 + devk52 * ztc ) 354 akb3(ji,jj,jk) = zakb * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 355 356 zbuf1 = - ( devk13 + devk23 * ztc + devk33 * ztc * ztc ) 357 zbuf2 = 0.5 * ( devk43 + devk53 * ztc ) 358 akw3(ji,jj,jk) = zakw * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 359 360 zbuf1 = - ( devk14 + devk24 * ztc + devk34 * ztc * ztc ) 361 zbuf2 = 0.5 * ( devk44 + devk54 * ztc ) 362 aks3(ji,jj,jk) = zcks * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 363 364 zbuf1 = - ( devk15 + devk25 * ztc + devk35 * ztc * ztc ) 365 zbuf2 = 0.5 * ( devk45 + devk55 * ztc ) 366 akf3(ji,jj,jk) = zckf * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 367 368 zbuf1 = - ( devk17 + devk27 * ztc + devk37 * ztc * ztc ) 369 zbuf2 = 0.5 * ( devk47 + devk57 * ztc ) 370 ak1p3(ji,jj,jk) = zak1p * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 371 372 zbuf1 = - ( devk18 + devk28 * ztc + devk38 * ztc * ztc ) 373 zbuf2 = 0.5 * ( devk48 + devk58 * ztc ) 374 ak2p3(ji,jj,jk) = zak2p * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 375 376 zbuf1 = - ( devk19 + devk29 * ztc + devk39 * ztc * ztc ) 377 zbuf2 = 0.5 * ( devk49 + devk59 * ztc ) 378 ak3p3(ji,jj,jk) = zak3p * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 379 380 zbuf1 = - ( devk110 + devk210 * ztc + devk310 * ztc * ztc ) 381 zbuf2 = 0.5 * ( devk410 + devk510 * ztc ) 382 aksi3(ji,jj,jk) = zaksi * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 383 384 ! CONVERT FROM DIFFERENT PH SCALES 385 total2free = 1.0/(1.0 + zst/aks3(ji,jj,jk)) 386 free2SWS = 1. + zst/aks3(ji,jj,jk) + zft/akf3(ji,jj,jk) 387 total2SWS = total2free * free2SWS 388 SWS2total = 1.0 / total2SWS 389 390 ! Convert to total scale 391 ak13(ji,jj,jk) = ak13(ji,jj,jk) * SWS2total 392 ak23(ji,jj,jk) = ak23(ji,jj,jk) * SWS2total 393 akb3(ji,jj,jk) = akb3(ji,jj,jk) * SWS2total 394 akw3(ji,jj,jk) = akw3(ji,jj,jk) * SWS2total 395 ak1p3(ji,jj,jk) = ak1p3(ji,jj,jk) * SWS2total 396 ak2p3(ji,jj,jk) = ak2p3(ji,jj,jk) * SWS2total 397 ak3p3(ji,jj,jk) = ak3p3(ji,jj,jk) * SWS2total 398 aksi3(ji,jj,jk) = aksi3(ji,jj,jk) * SWS2total 399 akf3(ji,jj,jk) = akf3(ji,jj,jk) / total2free 400 401 ! APPARENT SOLUBILITY PRODUCT K'SP OF CALCITE 402 ! AS FUNCTION OF PRESSURE FOLLOWING MILLERO 403 ! (P. 1285) AND BERNER (1976) 404 zbuf1 = - ( devk16 + devk26 * ztc + devk36 * ztc * ztc ) 405 zbuf2 = 0.5 * ( devk46 + devk56 * ztc ) 406 aksp(ji,jj,jk) = zaksp1 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 407 408 ! TOTAL F, S, and BORATE CONCENTR. [MOLES/L] 409 borat(ji,jj,jk) = 0.0002414 * zcl / 10.811 410 sulfat(ji,jj,jk) = zst 411 fluorid(ji,jj,jk) = zft 412 413 ! Iron and SIO3 saturation concentration from ... 414 sio3eq(ji,jj,jk) = EXP( LOG( 10.) * ( 6.44 - 968. / ztkel ) ) * 1.e-6 415 fekeq (ji,jj,jk) = 10**( 17.27 - 1565.7 / ztkel ) 416 ! Liu and Millero (1999) only valid 5 - 50 degC 417 ztkel1 = MAX( 5. , tempis(ji,jj,jk) ) + 273.16 418 fesol(ji,jj,jk,1) = 10**(-13.486 - 0.1856* zis**0.5 + 0.3073*zis + 5254.0/ztkel1) 419 fesol(ji,jj,jk,2) = 10**(2.517 - 0.8885*zis**0.5 + 0.2139 * zis - 1320.0/ztkel1 ) 420 fesol(ji,jj,jk,3) = 10**(0.4511 - 0.3305*zis**0.5 - 1996.0/ztkel1 ) 421 fesol(ji,jj,jk,4) = 10**(-0.2965 - 0.7881*zis**0.5 - 4086.0/ztkel1 ) 422 fesol(ji,jj,jk,5) = 10**(4.4466 - 0.8505*zis**0.5 - 7980.0/ztkel1 ) 423 END_3D 445 424 ! 446 425 IF( ln_timing ) CALL timing_stop('p4z_che') -
NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/PISCES/P4Z/p4zint.F90
r12377 r13373 19 19 REAL(wp) :: xksilim = 16.5e-6_wp ! Half-saturation constant for the Si half-saturation constant computation 20 20 21 # include "do_loop_substitute.h90" 21 22 !!---------------------------------------------------------------------- 22 23 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 49 50 ! Computation of the silicon dependant half saturation constant for silica uptake 50 51 ! --------------------------------------------------- 51 DO ji = 1, jpi 52 DO jj = 1, jpj 53 zvar = tr(ji,jj,1,jpsil,Kbb) * tr(ji,jj,1,jpsil,Kbb) 54 xksimax(ji,jj) = MAX( xksimax(ji,jj), ( 1.+ 7.* zvar / ( xksilim * xksilim + zvar ) ) * 1e-6 ) 55 END DO 56 END DO 52 DO_2D( 1, 1, 1, 1 ) 53 zvar = tr(ji,jj,1,jpsil,Kbb) * tr(ji,jj,1,jpsil,Kbb) 54 xksimax(ji,jj) = MAX( xksimax(ji,jj), ( 1.+ 7.* zvar / ( xksilim * xksilim + zvar ) ) * 1e-6 ) 55 END_2D 57 56 ! 58 57 IF( nday_year == nyear_len(1) ) THEN -
NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/PISCES/P4Z/p4zopt.F90
r13333 r13373 32 32 REAL(wp) :: xsi0r ! 1. /rn_si0 33 33 34 INTEGER :: nksr1 ! levels below which the light cannot penetrate ( depth larger than 391 m) 35 34 36 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_par ! structure of input par 35 INTEGER , PARAMETER :: nbtimes = 366 !: maximum number of times record in a file36 INTEGER :: ntimes_par ! number of time steps in a file37 37 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: par_varsw ! PAR fraction of shortwave 38 38 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ekb, ekg, ekr ! wavelength (Red-Green-Blue) … … 279 279 pe3(:,:,1) = zqsr(:,:) 280 280 ! 281 DO jk = 2, nksr + 1 282 DO jj = 1, jpj 283 DO ji = 1, jpi 284 pe0(ji,jj,jk) = pe0(ji,jj,jk-1) * EXP( -e3t(ji,jj,jk-1,Kmm) * xsi0r ) 285 pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -ekb (ji,jj,jk-1 ) ) 286 pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -ekg (ji,jj,jk-1 ) ) 287 pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -ekr (ji,jj,jk-1 ) ) 288 END DO 289 ! 290 END DO 291 ! 292 END DO 281 DO_3D( 1, 1, 1, 1, 2, nksr1 ) 282 pe0(ji,jj,jk) = pe0(ji,jj,jk-1) * EXP( -e3t(ji,jj,jk-1,Kmm) * xsi0r ) 283 pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -ekb (ji,jj,jk-1 ) ) 284 pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -ekg (ji,jj,jk-1 ) ) 285 pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -ekr (ji,jj,jk-1 ) ) 286 END_3D 293 287 ! 294 288 ELSE ! T- level … … 331 325 ! Compute par_varsw at nit000 or only if there is more than 1 time record in par coefficient file 332 326 IF( ln_varpar ) THEN 333 IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_par > 1 ) ) THEN 334 CALL fld_read( kt, 1, sf_par ) 335 par_varsw(:,:) = ( sf_par(1)%fnow(:,:,1) ) / 3.0 336 ENDIF 327 CALL fld_read( kt, 1, sf_par ) 328 par_varsw(:,:) = ( sf_par(1)%fnow(:,:,1) ) / 3.0 337 329 ENDIF 338 330 ! … … 377 369 xparsw = parlux / 3.0 378 370 xsi0r = 1.e0 / rn_si0 371 nksr1 = nksr + 1 379 372 ! 380 373 ! Variable PAR at the surface of the ocean … … 392 385 ALLOCATE( sf_par(1)%fnow(jpi,jpj,1) ) 393 386 IF( sn_par%ln_tint ) ALLOCATE( sf_par(1)%fdta(jpi,jpj,1,2) ) 394 395 CALL iom_open ( TRIM( sn_par%clname ) , numpar )396 ntimes_par = iom_getszuld( numpar ) ! get number of record in file397 387 ENDIF 398 388 ! -
NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/PISCES/P4Z/p4zsms.F90
r13295 r13373 11 11 USE oce_trc ! shared variables between ocean and passive tracers 12 12 USE trc ! passive tracers common variables 13 USE trcdta !14 13 USE sms_pisces ! PISCES Source Minus Sink variables 15 14 USE p4zbio ! Biological model -
NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/PISCES/SED/oce_sed.F90
r13237 r13373 8 8 !!---------------------------------------------------------------------- 9 9 USE par_sed 10 USE par_trc , ONLY : rtrn => rtrn 11 USE par_pisces 10 12 USE timing 11 USE par_trc12 13 13 14 USE dom_oce , ONLY : glamt => glamt !: longitude of t-point (degre) -
NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/PISCES/SED/par_sed.F90
r10222 r13373 20 20 jp_sal => jp_sal !: indice of salintity 21 21 22 INTEGER, P ARAMETER :: jpdta = 1722 INTEGER, PUBLIC, PARAMETER :: jpdta = 17 23 23 24 24 ! Vertical sediment geometry 25 INTEGER, PUBLIC :: & 26 jpksed = 11 , & 27 jpksedm1 = 10 25 INTEGER, PUBLIC :: jpksed = 11 26 INTEGER, PUBLIC :: jpksedm1 28 27 29 28 ! sediment tracer species 30 INTEGER, P ARAMETER :: &29 INTEGER, PUBLIC, PARAMETER :: & 31 30 jpsol = 8, & !: number of solid component 32 31 jpwat = 10, & !: number of pore water component … … 36 35 37 36 ! pore water components 38 INTEGER, P ARAMETER :: &37 INTEGER, PUBLIC, PARAMETER :: & 39 38 jwsil = 1, & !: silic acid 40 39 jwoxy = 2, & !: oxygen … … 49 48 50 49 ! solid components 51 INTEGER, P ARAMETER :: &50 INTEGER, PUBLIC, PARAMETER :: & 52 51 jsopal = 1, & !: opal sediment 53 52 jsclay = 2, & !: clay … … 59 58 jsfes = 8 !: FeS 60 59 61 INTEGER, P ARAMETER :: &60 INTEGER, PUBLIC, PARAMETER :: & 62 61 jptrased = jpsol + jpwat , & 63 62 jpdia3dsed = 2 , & -
NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/PISCES/SED/sed.F90
r10425 r13373 7 7 !! ! 06-12 (C. Ethe) Orignal 8 8 !!---------------------------------------------------------------------- 9 USE par_sed10 9 USE oce_sed 11 10 USE in_out_manager … … 63 62 REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: solcp !: solid sediment data at given time-step 64 63 REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: solcp0 !: solid sediment data at initial time 65 REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: trc_dta66 64 REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: diff 67 65 -
NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/PISCES/SED/sedarr.F90
r10222 r13373 10 10 !!---------------------------------------------------------------------- 11 11 !! * Modules used 12 USE par_oce 12 13 USE par_sed 13 USE dom_oce14 USE sed14 USE in_out_manager, ONLY : ln_timing 15 USE timing 15 16 16 17 IMPLICIT NONE -
NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/PISCES/SED/sedchem.F90
r13295 r13373 6 6 !!====================================================================== 7 7 !! modules used 8 USE par_sed 8 9 USE sed ! sediment global variable 9 10 USE sedarr -
NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/PISCES/SED/sedini.F90
r13295 r13373 9 9 !!---------------------------------------------------------------------- 10 10 !! * Modules used 11 USE par_trc ! need jptra, number of passive tracers 12 USE par_sed 11 13 USE sed ! sediment global variable 12 14 USE sed_oce -
NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/PISCES/SED/sedwri.F90
r12489 r13373 4 4 !! Sediment diagnostics : write sediment output files 5 5 !!====================================================================== 6 USE par_sed 6 7 USE sed 7 8 USE sedarr -
NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/PISCES/SED/trcdmp_sed.F90
r13295 r13373 91 91 ! 92 92 jl = n_trc_index(jn) 93 CALL trc_dta( kt, Kmm, sf_trcdta(jl), rf_trfac(jl), ztrcdta ) ! read tracer data at nit00093 CALL trc_dta( kt, jl, ztrcdta ) ! read tracer data at nit000 94 94 ! 95 95 DO_2D( 1, 1, 1, 1 ) … … 108 108 WRITE(charout, FMT="('dmp ')") 109 109 CALL prt_ctl_info( charout, cdcomp = 'top' ) 110 CALL prt_ctl( tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, 110 CALL prt_ctl( tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm,clinfo3='trd' ) 111 111 ENDIF 112 112 ! -
NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/PISCES/trcini_pisces.F90
r12377 r13373 79 79 ! 80 80 INTEGER, INTENT(in) :: Kmm ! time level indices 81 REAL(wp), SAVE :: sco2 = 2.312e-3_wp82 REAL(wp), SAVE :: alka0 = 2.426e-3_wp83 REAL(wp), SAVE :: oxyg0 = 177.6e-6_wp84 REAL(wp), SAVE :: po4 = 2.165e-6_wp85 REAL(wp), SAVE :: bioma0 = 1.000e-8_wp86 REAL(wp), SAVE :: silic1 = 91.51e-6_wp87 REAL(wp), SAVE :: no3 = 30.9e-6_wp * 7.625_wp88 81 ! 89 82 INTEGER :: ji, jj, jk, jn, ierr 90 83 REAL(wp) :: zcaralk, zbicarb, zco3 91 84 REAL(wp) :: ztmas, ztmas1 85 REAL(wp) :: sco2, alka0, oxyg0, po4, bioma0, silic1, no3 92 86 CHARACTER(len = 20) :: cltra 93 87 !!---------------------------------------------------------------------- … … 103 97 ENDIF 104 98 ENDIF 99 ! 100 sco2 = 2.312e-3_wp 101 alka0 = 2.426e-3_wp 102 oxyg0 = 177.6e-6_wp 103 po4 = 2.165e-6_wp 104 bioma0 = 1.000e-8_wp 105 silic1 = 91.51e-6_wp 106 no3 = 30.9e-6_wp * 7.625_wp 105 107 ! 106 108 ! Allocate PISCES arrays -
NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/TRP/trcadv.F90
r13286 r13373 16 16 !! trc_adv_ini : control the different options of advection scheme 17 17 !!---------------------------------------------------------------------- 18 USE par_trc ! need jptra, number of passive tracers 18 19 USE oce_trc ! ocean dynamics and active tracers 19 20 USE trc ! ocean passive tracers variables -
NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/TRP/trcatf.F90
r13295 r13373 27 27 !! trc_atf : time stepping on passive tracers 28 28 !!---------------------------------------------------------------------- 29 USE par_trc ! need jptra, number of passive tracers 29 30 USE oce_trc ! ocean dynamics and tracers variables 30 31 USE trc ! ocean passive tracers variables -
NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/TRP/trcbbl.F90
r13286 r13373 20 20 !! trc_bbl : update the tracer trends due to the bottom boundary layer (advective and/or diffusive) 21 21 !!---------------------------------------------------------------------- 22 USE par_trc ! need jptra, number of passive tracers 22 23 USE oce_trc ! ocean dynamics and passive tracers variables 23 24 USE trc ! ocean passive tracers variables -
NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/TRP/trcdmp.F90
r13295 r13373 16 16 !! trc_dmp_init : initialization, namlist read, parameters control 17 17 !!---------------------------------------------------------------------- 18 USE par_trc ! need jptra, number of passive tracers 18 19 USE oce_trc ! ocean dynamics and tracers variables 19 20 USE trc ! ocean passive tracers variables … … 108 109 ! 109 110 jl = n_trc_index(jn) 110 CALL trc_dta( kt, Kmm, sf_trcdta(jl), rf_trfac(jl), ztrcdta ) ! read tracer data at nit000111 CALL trc_dta( kt, jl, ztrcdta ) ! read tracer data at nit000 111 112 ! 112 113 SELECT CASE ( nn_zdmp_tr ) … … 350 351 IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file 351 352 jl = n_trc_index(jn) 352 CALL trc_dta( kt, Kmm, sf_trcdta(jl), rf_trfac(jl), ztrcdta ) ! read tracer data at nit000353 CALL trc_dta( kt, jl, ztrcdta ) ! read tracer data at nit000 353 354 DO jc = 1, npncts 354 355 DO jk = 1, jpkm1 -
NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/TRP/trcldf.F90
r13295 r13373 15 15 !! trc_ldf_ini : initialization, namelist read, and parameters control 16 16 !!---------------------------------------------------------------------- 17 USE par_trc ! need jptra, number of passive tracers 17 18 USE trc ! ocean passive tracers variables 18 19 USE oce_trc ! ocean dynamics and active tracers -
NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/TRP/trcsbc.F90
r13295 r13373 16 16 !! trc_sbc : update the tracer trend at ocean surface 17 17 !!---------------------------------------------------------------------- 18 USE par_trc ! need jptra, number of passive tracers 18 19 USE oce_trc ! ocean dynamics and active tracers variables 19 20 USE trc ! ocean passive tracers variables -
NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/TRP/trctrp.F90
r12377 r13373 13 13 !! trc_trp : passive tracer transport 14 14 !!---------------------------------------------------------------------- 15 USE par_trc ! need jptra, number of passive tracers 15 16 USE oce_trc ! ocean dynamics and active tracers variables 16 17 USE trc ! ocean passive tracers variables … … 27 28 USE bdy_oce , ONLY: ln_bdy 28 29 USE trcbdy ! BDY open boundaries 30 USE in_out_manager 29 31 30 32 #if defined key_agrif … … 62 64 IF( .NOT. lk_c1d ) THEN 63 65 ! 66 ! ! Partial top/bottom cell: GRADh( trb ) 67 IF( ln_zps ) THEN 68 IF( ln_isfcav ) THEN ; CALL zps_hde_isf( kt, Kmm, jptra, tr(:,:,:,:,Kbb), pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi ) ! both top & bottom 69 ELSE ; CALL zps_hde ( kt, Kmm, jptra, tr(:,:,:,:,Kbb), gtru, gtrv ) ! only bottom 70 ENDIF 71 ENDIF 72 ! 64 73 CALL trc_sbc ( kt, Kmm, tr, Krhs ) ! surface boundary condition 65 74 IF( ln_trcbc .AND. lltrcbc .AND. kt /= nit000 ) & … … 68 77 IF( ln_trcdmp ) CALL trc_dmp ( kt, Kbb, Kmm, tr, Krhs ) ! internal damping trends 69 78 IF( ln_bdy ) CALL trc_bdy_dmp( kt, Kbb, Krhs ) ! BDY damping trends 70 CALL trc_adv ( kt, Kbb, Kmm, tr, Krhs ) ! horizontal & vertical advection71 ! ! Partial top/bottom cell: GRADh( trb )72 IF( ln_zps ) THEN73 IF( ln_isfcav ) THEN ; CALL zps_hde_isf( kt, Kmm, jptra, tr(:,:,:,:,Kbb), pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi ) ! both top & bottom74 ELSE ; CALL zps_hde ( kt, Kmm, jptra, tr(:,:,:,:,Kbb), gtru, gtrv ) ! only bottom75 ENDIF76 ENDIF77 !78 CALL trc_ldf ( kt, Kbb, Kmm, tr, Krhs ) ! lateral mixing79 79 #if defined key_agrif 80 80 IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_trc ! tracers sponge 81 81 #endif 82 CALL trc_adv ( kt, Kbb, Kmm, tr, Krhs ) ! horizontal & vertical advection 83 CALL trc_ldf ( kt, Kbb, Kmm, tr, Krhs ) ! lateral mixing 82 84 CALL trc_zdf ( kt, Kbb, Kmm, Krhs, tr, Kaa ) ! vert. mixing & after tracer ==> after 83 85 CALL trc_atf ( kt, Kbb, Kmm, Kaa , tr ) ! time filtering of "now" tracer fields -
NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/TRP/trczdf.F90
r13286 r13373 14 14 !! trc_zdf : update the tracer trend with the vertical diffusion 15 15 !!---------------------------------------------------------------------- 16 USE par_trc ! need jptra, number of passive tracers 16 17 USE trc ! ocean passive tracers variables 17 18 USE oce_trc ! ocean dynamics and active tracers 18 19 USE trd_oce ! trends: ocean variables 19 20 USE trazdf ! tracer: vertical diffusion 20 !!gm do we really need this ?21 USE trcldf ! passive tracers: lateral diffusion22 !!gm23 21 USE trdtra ! trends manager: tracers 24 22 USE prtctl ! Print control -
NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/trcdta.F90
r13295 r13373 31 31 PUBLIC trc_dta_ini ! called in trcini.F90 32 32 33 INTEGER , SAVE, PUBLIC :: nb_trcdta ! number of tracers to be initialised with data 34 INTEGER , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: n_trc_index ! indice of tracer which is initialised with data 35 INTEGER , SAVE, PUBLIC :: ntra ! MAX( 1, nb_trcdta ) to avoid compilation error with bounds checking 36 REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: rf_trfac ! multiplicative factor for tracer values 37 !$AGRIF_DO_NOT_TREAT 38 TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: sf_trcdta ! structure of input SST (file informations, fields read) 39 !$AGRIF_END_DO_NOT_TREAT 33 INTEGER , PUBLIC :: nb_trcdta ! number of tracers to be initialised with data 34 INTEGER , PUBLIC, ALLOCATABLE, DIMENSION(:) :: n_trc_index ! indice of tracer which is initialised with data 35 INTEGER , PUBLIC :: ntra ! MAX( 1, nb_trcdta ) to avoid compilation error with bounds checking 36 REAL(wp) , ALLOCATABLE, DIMENSION(:) :: rf_trfac ! multiplicative factor for tracer values 37 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_trcdta ! structure of input SST (file informations, fields read) 40 38 41 39 !! Substitutions … … 155 153 156 154 157 SUBROUTINE trc_dta( kt, Kmm, sf_trcdta, ptrcfac, ptrcdta)155 SUBROUTINE trc_dta( kt, kjl, ptrcdta) 158 156 !!---------------------------------------------------------------------- 159 157 !! *** ROUTINE trc_dta *** … … 168 166 !!---------------------------------------------------------------------- 169 167 INTEGER , INTENT(in ) :: kt ! ocean time-step 170 INTEGER , INTENT(in ) :: Kmm ! time level index 171 TYPE(FLD), DIMENSION(1) , INTENT(inout) :: sf_trcdta ! array of information on the field to read 172 REAL(wp) , INTENT(in ) :: ptrcfac ! multiplication factor 168 INTEGER , INTENT(in ) :: kjl ! tracer index 173 169 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout ) :: ptrcdta ! 3D data array 174 170 ! … … 191 187 ! read data at kt time step 192 188 CALL fld_read( kt, 1, sf_trcdta ) 193 ptrcdta(:,:,:) = sf_trcdta( 1)%fnow(:,:,:) * tmask(:,:,:)189 ptrcdta(:,:,:) = sf_trcdta(kjl)%fnow(:,:,:) * tmask(:,:,:) 194 190 ! 195 191 IF( ln_sco ) THEN !== s- or mixed s-zps-coordinate ==! … … 201 197 DO_2D( 1, 1, 1, 1 ) 202 198 DO jk = 1, jpk ! determines the intepolated T-S profiles at each (i,j) points 203 zl = gdept (ji,jj,jk,Kmm)199 zl = gdept_0(ji,jj,jk) 204 200 IF( zl < gdept_1d(1 ) ) THEN ! above the first level of data 205 201 ztp(jk) = ptrcdta(ji,jj,1) … … 223 219 ELSE !== z- or zps- coordinate ==! 224 220 ! zps-coordinate (partial steps) interpolation at the last ocean level 225 ! IF( ln_zps ) THEN 226 ! DO jj = 1, jpj 227 ! DO ji = 1, jpi 228 ! ik = mbkt(ji,jj) 229 ! IF( ik > 1 ) THEN 230 ! zl = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 231 ! ptrcdta(ji,jj,ik) = (1.-zl) * ptrcdta(ji,jj,ik) + zl * ptrcdta(ji,jj,ik-1) 232 ! ENDIF 233 ! ik = mikt(ji,jj) 234 ! IF( ik > 1 ) THEN 235 ! zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) ) 236 ! ptrcdta(ji,jj,ik) = (1.-zl) * ptrcdta(ji,jj,ik) + zl * ptrcdta(ji,jj,ik+1) 237 ! ENDIF 238 ! END DO 239 ! END DO 240 ! ENDIF 221 IF( ln_zps ) THEN 222 DO_2D( 1, 1, 1, 1 ) 223 ik = mbkt(ji,jj) 224 IF( ik > 1 ) THEN 225 zl = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 226 ptrcdta(ji,jj,ik) = (1.-zl) * ptrcdta(ji,jj,ik) + zl * ptrcdta(ji,jj,ik-1) 227 ENDIF 228 ik = mikt(ji,jj) 229 IF( ik > 1 ) THEN 230 zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) ) 231 ptrcdta(ji,jj,ik) = (1.-zl) * ptrcdta(ji,jj,ik) + zl * ptrcdta(ji,jj,ik+1) 232 ENDIF 233 END_2D 234 ENDIF 241 235 ! 242 236 ENDIF 243 !244 237 ! Scale by multiplicative factor 245 ptrcdta(:,:,:) = ptrcdta(:,:,:) * ptrcfac238 ptrcdta(:,:,:) = ptrcdta(:,:,:) * rf_trfac(kjl) 246 239 ! 247 240 ENDIF … … 256 249 !!---------------------------------------------------------------------- 257 250 CONTAINS 258 SUBROUTINE trc_dta( kt, sf_trcdta, ptrcfac, ptrcdta) ! Empty routine251 SUBROUTINE trc_dta( kt, kjl, ptrcdta) ! Empty routine 259 252 WRITE(*,*) 'trc_dta: You should not have seen this print! error?', kt 260 253 END SUBROUTINE trc_dta -
NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/trcice.F90
r12377 r13373 12 12 !! trc_ice : Call the appropriate sea ice tracer subroutine 13 13 !!---------------------------------------------------------------------- 14 USE par_trc ! need jptra, number of passive tracers 14 15 USE oce_trc ! shared variables between ocean and passive tracers 15 16 USE trc ! passive tracers common variables -
NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/trcini.F90
r13286 r13373 16 16 !! top_alloc : allocate the TOP arrays 17 17 !!---------------------------------------------------------------------- 18 USE par_trc ! need jptra, number of passive tracers 18 19 USE oce_trc ! shared variables between ocean and passive tracers 19 20 USE trc ! passive tracers common variables … … 95 96 CHARACTER (len=25) :: charout 96 97 REAL(wp), DIMENSION(jpi,jpj,jpk,jptra) :: zzmsk 97 CHARACTER (len=25), DIMENSION(jptra) :: clseb98 98 !!---------------------------------------------------------------------- 99 99 ! … … 131 131 CALL prt_ctl_info( charout, cdcomp = 'top' ) 132 132 CALL prt_ctl( tab4d_1=tr(:,:,:,:,Kmm), mask1=tmask, clinfo=ctrcnm ) 133 DO jn = 1, jptra134 zzmsk(:,:,:,jn) = tmask(:,:,:)135 WRITE(clseb(jn),'(a,i2.2)') 'seb ', jn136 END DO137 CALL prt_ctl( tab4d_1=zzmsk, mask1=tmask, clinfo=clseb )138 133 ENDIF 139 134 9000 FORMAT(' tracer nb : ',i2,' name :',a10,' initial content :',e18.10) … … 254 249 ! 255 250 ELSE ! Initialisation of tracer from a file that may also be used for damping 256 !!gm BUG ? if damping and restart, what's happening ?257 251 IF( ln_trcdta .AND. nb_trcdta > 0 ) THEN 258 252 ! update passive tracers arrays with input data read from file … … 260 254 IF( ln_trc_ini(jn) ) THEN 261 255 jl = n_trc_index(jn) 262 CALL trc_dta( nit000, Kmm, sf_trcdta(jl), rf_trfac(jl), tr(:,:,:,jn,Kmm) ) 263 ! 264 ! deallocate data structure if data are not used for damping 265 IF( .NOT.ln_trcdmp .AND. .NOT.ln_trcdmp_clo ) THEN 266 IF(lwp) WRITE(numout,*) 'trc_ini_state: deallocate data arrays as they are only used to initialize the run' 267 DEALLOCATE( sf_trcdta(jl)%fnow ) 268 IF( sf_trcdta(jl)%ln_tint ) DEALLOCATE( sf_trcdta(jl)%fdta ) 269 ! 270 ENDIF 256 CALL trc_dta( nit000, jl, tr(:,:,:,jn,Kmm) ) 271 257 ENDIF 272 258 END DO -
NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/trcnam.F90
r12489 r13373 18 18 !! trc_nam : Read and print options for the passive tracer run (namelist) 19 19 !!---------------------------------------------------------------------- 20 USE par_trc ! need jptra, number of passive tracers 20 21 USE oce_trc ! shared variables between ocean and passive tracers 21 22 USE trc ! passive tracers common variables -
NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/trcrst.F90
r13286 r13373 19 19 !! trc_rst_wri : write restart file 20 20 !!---------------------------------------------------------------------- 21 USE par_trc ! need jptra, number of passive tracers 21 22 USE oce_trc 22 23 USE trc -
NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/trcstp.F90
r13286 r13373 11 11 !! trc_stp : passive tracer system time-stepping 12 12 !!---------------------------------------------------------------------- 13 USE par_trc ! need jptra, number of passive tracers 13 14 USE oce_trc ! ocean dynamics and active tracers variables 14 15 USE sbc_oce
Note: See TracChangeset
for help on using the changeset viewer.