- Timestamp:
- 2018-06-21T11:58:42+02:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_nemo2cice_prints/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90
r9816 r9817 7 7 !! NEMO 1.0 ! 2004-03 (C. Ethe) free form + modularity 8 8 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) reorganisation 9 !! ! 2016-06 (J. Palmieri) update for UKESM1 10 !! ! 2017-04 (A. Yool) update to add SF6, fix coefficients 9 11 !!---------------------------------------------------------------------- 10 12 #if defined key_cfc … … 15 17 !! cfc_init : sets constants for CFC surface forcing computation 16 18 !!---------------------------------------------------------------------- 19 USE dom_oce ! ocean space and time domain 17 20 USE oce_trc ! Ocean variables 18 21 USE par_trc ! TOP parameters … … 31 34 INTEGER , PUBLIC :: jpyear ! Number of years read in CFC1112 file 32 35 INTEGER , PUBLIC :: ndate_beg ! initial calendar date (aammjj) for CFC 36 INTEGER , PUBLIC :: simu_type ! Kind of simulation: 1- Spin-up 37 ! 2- Hindcast/projection 33 38 INTEGER , PUBLIC :: nyear_res ! restoring time constant (year) 34 39 INTEGER , PUBLIC :: nyear_beg ! initial year (aa) … … 40 45 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: patm ! atmospheric function 41 46 42 REAL(wp), DIMENSION(4, 2) :: soa ! coefficient for solubility of CFC [mol/l/atm]43 REAL(wp), DIMENSION(3, 2) :: sob ! " "44 REAL(wp), DIMENSION( 4,2) :: sca ! coefficients for schmidt number in degre Celcius47 REAL(wp), DIMENSION(4,3) :: soa ! coefficient for solubility of CFC [mol/l/atm] 48 REAL(wp), DIMENSION(3,3) :: sob ! " " 49 REAL(wp), DIMENSION(5,3) :: sca ! coefficients for schmidt number in degre Celcius 45 50 46 51 ! ! coefficients for conversion … … 79 84 ! 80 85 INTEGER :: ji, jj, jn, jl, jm, js 81 INTEGER :: iyear_beg, iyear_end 86 INTEGER :: iyear_beg, iyear_end, iyear_tmp 82 87 INTEGER :: im1, im2, ierr 83 88 REAL(wp) :: ztap, zdtap 84 REAL(wp) :: zt1, zt2, zt3, z v289 REAL(wp) :: zt1, zt2, zt3, zt4, zv2 85 90 REAL(wp) :: zsol ! solubility 86 91 REAL(wp) :: zsch ! schmidt number … … 103 108 ! Temporal interpolation 104 109 ! ---------------------- 105 iyear_beg = nyear - 1900 110 !! JPALM -- 15-06-2016 -- define 2 kinds of CFC run: 111 !! 1- the SPIN-UP and 2- Hindcast/Projections 112 !! -- main difference is the way to define the year of 113 !! simulation, that determine the atm pCFC. 114 !! 1-- Spin-up: our atm forcing is of 30y we cycle on. 115 !! So we do 90y CFC cycles to be in good 116 !! correspondence with the atmosphere 117 !! 2-- Hindcast/proj, instead of nyear-1900 we keep 118 !! the 2 last digit, and enable 3 cycle from 1800 to 2100. 119 !!---------------------------------------------------------------------- 120 IF (simu_type==1) THEN 121 !! 1 -- SPIN-UP 122 iyear_tmp = nyear - nyear_res !! JPALM -- in our spin-up, nyear_res is 1000 123 iyear_beg = MOD( iyear_tmp , 90 ) 124 !! JPALM -- the pCFC file only got 78 years. 125 !! So if iyear_beg > 78 then we set pCFC to 0 126 !! iyear_beg = 0 as well -- must try to avoid obvious problems 127 !! as Pcfc is set to 0.00 up to year 32, let set iyear_beg to year 10 128 !! else, must add 30 to iyear_beg to match with P_cfc indices 129 !!--------------------------------------- 130 IF ((iyear_beg > 77) .OR. (iyear_beg==0)) THEN 131 iyear_beg = 10 132 ELSE 133 iyear_beg = iyear_beg + 30 134 ENDIF 135 ELSEIF (simu_type==2) THEN 136 !! 2 -- Hindcast/proj 137 iyear_beg = MOD(nyear, 100) 138 IF (iyear_beg < 20) iyear_beg = iyear_beg + 100 139 !! JPALM -- Same than previously, if iyear_beg is out of P_cfc range, 140 !! we want to set p_CFC to 0.00 --> set iyear_beg = 10 141 IF ((iyear_beg < 30) .OR. (iyear_beg > 115)) iyear_beg = 10 142 ENDIF 143 !! 106 144 IF ( nmonth <= 6 ) THEN 107 145 iyear_beg = iyear_beg - 1 … … 152 190 zt2 = zt1 * zt1 153 191 zt3 = zt1 * zt2 154 zsch = sca(1,jl) + sca(2,jl) * zt1 + sca(3,jl) * zt2 + sca(4,jl) * zt3 192 zt4 = zt1 * zt3 193 zsch = sca(1,jl) + sca(2,jl) * zt1 + sca(3,jl) * zt2 + sca(4,jl) * zt3 + sca(5,jl) * zt4 155 194 156 195 ! speed transfert : formulae of wanninkhof 1992 157 196 zv2 = wndm(ji,jj) * wndm(ji,jj) 158 197 zsch = zsch / 660. 159 zak_cfc = ( 0.39 * xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1) 198 ! AXY (25/04/17): OMIP protocol specifies lower Wanninkhof (2014) value 199 ! zak_cfc = ( 0.39 * xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1) 200 zak_cfc = ( 0.251 * xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1) 160 201 161 202 ! Input function : speed *( conc. at equil - concen at surface ) … … 176 217 ! !----------------! 177 218 END DO ! end CFC loop ! 178 ! 179 IF( lrst_trc ) THEN 180 IF(lwp) WRITE(numout,*) 181 IF(lwp) WRITE(numout,*) 'trc_sms_cfc : cumulated input function fields written in ocean restart file ', & 182 & 'at it= ', kt,' date= ', ndastp 183 IF(lwp) WRITE(numout,*) '~~~~' 184 DO jn = jp_cfc0, jp_cfc1 185 CALL iom_rstput( kt, nitrst, numrtw, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) ) 186 END DO 187 ENDIF 219 ! 220 IF( kt == nittrc000 ) THEN 221 DO jl = 1, jp_cfc 222 WRITE(NUMOUT,*) ' ' 223 WRITE(NUMOUT,*) 'CFC interpolation verification ' !! Jpalm 224 WRITE(NUMOUT,*) '################################## ' 225 WRITE(NUMOUT,*) ' ' 226 if (jl.EQ.1) then 227 WRITE(NUMOUT,*) 'Traceur = CFC11: ' 228 elseif (jl.EQ.2) then 229 WRITE(NUMOUT,*) 'Traceur = CFC12: ' 230 elseif (jl.EQ.3) then 231 WRITE(NUMOUT,*) 'Traceur = SF6: ' 232 endif 233 WRITE(NUMOUT,*) 'nyear = ', nyear 234 WRITE(NUMOUT,*) 'nmonth = ', nmonth 235 WRITE(NUMOUT,*) 'iyear_beg= ', iyear_beg 236 WRITE(NUMOUT,*) 'iyear_end= ', iyear_end 237 WRITE(NUMOUT,*) 'p_cfc(iyear_beg)= ',p_cfc(iyear_beg, 1, jl) 238 WRITE(NUMOUT,*) 'p_cfc(iyear_end)= ',p_cfc(iyear_end, 1, jl) 239 WRITE(NUMOUT,*) 'Im1= ',im1 240 WRITE(NUMOUT,*) 'Im2= ',im2 241 WRITE(NUMOUT,*) 'zpp_cfc = ',zpp_cfc 242 WRITE(NUMOUT,*) ' ' 243 END DO 244 # if defined key_debug_medusa 245 CALL flush(numout) 246 # endif 247 ENDIF 248 ! 249 !IF( lrst_trc ) THEN 250 ! IF(lwp) WRITE(numout,*) 251 ! IF(lwp) WRITE(numout,*) 'trc_sms_cfc : cumulated input function fields written in ocean restart file ', & 252 ! & 'at it= ', kt,' date= ', ndastp 253 ! IF(lwp) WRITE(numout,*) '~~~~' 254 ! DO jn = jp_cfc0, jp_cfc1 255 ! CALL iom_rstput( kt, nitrst, numrtw, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) ) 256 ! END DO 257 !ENDIF 188 258 ! 189 259 IF( lk_iomput ) THEN 190 CALL iom_put( "qtrCFC11" , qtr_cfc (:,:,1) ) 191 CALL iom_put( "qintCFC11" , qint_cfc(:,:,1) ) 260 IF (iom_use("qtrCFC11")) CALL iom_put( "qtrCFC11" , qtr_cfc (:,:,1) ) 261 IF (iom_use("qintCFC11")) CALL iom_put( "qintCFC11" , qint_cfc(:,:,1) ) 262 IF (iom_use("qtrCFC12")) CALL iom_put( "qtrCFC12" , qtr_cfc (:,:,2) ) 263 IF (iom_use("qintCFC12")) CALL iom_put( "qintCFC12" , qint_cfc(:,:,2) ) 264 IF (iom_use("qtrSF6")) CALL iom_put( "qtrSF6" , qtr_cfc (:,:,3) ) 265 IF (iom_use("qintSF6")) CALL iom_put( "qintSF6" , qint_cfc(:,:,3) ) 192 266 ELSE 193 267 IF( ln_diatrc ) THEN 194 268 trc2d(:,:,jp_cfc0_2d ) = qtr_cfc (:,:,1) 195 269 trc2d(:,:,jp_cfc0_2d + 1) = qint_cfc(:,:,1) 270 trc2d(:,:,jp_cfc0_2d + 2) = qtr_cfc (:,:,2) 271 trc2d(:,:,jp_cfc0_2d + 3) = qint_cfc(:,:,2) 272 trc2d(:,:,jp_cfc0_2d + 4) = qtr_cfc (:,:,3) 273 trc2d(:,:,jp_cfc0_2d + 5) = qint_cfc(:,:,3) 196 274 END IF 197 275 END IF … … 203 281 END IF 204 282 ! 283 # if defined key_debug_medusa 284 IF(lwp) WRITE(numout,*) ' CFC - Check: nn_timing = ', nn_timing 285 CALL flush(numout) 286 # endif 205 287 IF( nn_timing == 1 ) CALL timing_stop('trc_sms_cfc') 206 288 ! … … 214 296 !! ** Purpose : sets constants for CFC model 215 297 !!--------------------------------------------------------------------- 216 INTEGER :: j n298 INTEGER :: jl, jn, iyear_beg, iyear_tmp 217 299 218 300 ! coefficient for CFC11 … … 223 305 soa(2,1) = 319.6552 224 306 soa(3,1) = 119.4471 225 soa(4,1) = -1.39165 226 227 sob(1,1) = -0.142382 228 sob(2,1) = 0.091459 229 sob(3,1) = -0.0157274 230 231 ! Schmidt number 232 sca(1,1) = 3501.8 233 sca(2,1) = -210.31 234 sca(3,1) = 6.1851 235 sca(4,1) = -0.07513 307 soa(4,1) = -1.39165 308 309 sob(1,1) = -0.142382 310 sob(2,1) = 0.091459 311 sob(3,1) = -0.0157274 312 313 ! Schmidt number AXY (25/04/17) 314 sca(1,1) = 3579.2 ! = 3501.8 315 sca(2,1) = -222.63 ! = -210.31 316 sca(3,1) = 7.5749 ! = 6.1851 317 sca(4,1) = -0.14595 ! = -0.07513 318 sca(5,1) = 0.0011874 ! = absent 236 319 237 320 ! coefficient for CFC12 … … 242 325 soa(2,2) = 298.9702 243 326 soa(3,2) = 113.8049 244 soa(4,2) = -1.39165 245 246 sob(1,2) = -0.143566 247 sob(2,2) = 0.091015 248 sob(3,2) = -0.0153924 249 250 ! schmidt number 251 sca(1,2) = 3845.4 252 sca(2,2) = -228.95 253 sca(3,2) = 6.1908 254 sca(4,2) = -0.067430 255 256 IF( ln_rsttr ) THEN 257 IF(lwp) WRITE(numout,*) 258 IF(lwp) WRITE(numout,*) ' Read specific variables from CFC model ' 259 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 260 ! 261 DO jn = jp_cfc0, jp_cfc1 262 CALL iom_get( numrtr, jpdom_autoglo, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) ) 263 END DO 327 soa(4,2) = -1.39165 328 329 sob(1,2) = -0.143566 330 sob(2,2) = 0.091015 331 sob(3,2) = -0.0153924 332 333 ! schmidt number AXY (25/04/17) 334 sca(1,2) = 3828.1 ! = 3845.4 335 sca(2,2) = -249.86 ! = -228.95 336 sca(3,2) = 8.7603 ! = 6.1908 337 sca(4,2) = -0.1716 ! = -0.067430 338 sca(5,2) = 0.001408 ! = absent 339 340 ! coefficients for SF6 AXY (25/04/17) 341 !--------------------- 342 343 ! Solubility 344 soa(1,3) = -80.0343 345 soa(2,3) = 117.232 346 soa(3,3) = 29.5817 347 soa(4,3) = 0.0 348 349 sob(1,3) = 0.0335183 350 sob(2,3) = -0.0373942 351 sob(3,3) = 0.00774862 352 353 ! Schmidt number 354 sca(1,3) = 3177.5 355 sca(2,3) = -200.57 356 sca(3,3) = 6.8865 357 sca(4,3) = -0.13335 358 sca(5,3) = 0.0010877 359 360 !!--------------------------------------------- 361 !! JPALM -- re-initialize CFC fields and diags if restart a CFC cycle, 362 !! Or if out of P_cfc range 363 IF (simu_type==1) THEN 364 iyear_tmp = nyear - nyear_res !! JPALM -- in our spin-up, nyear_res is 1000 365 iyear_beg = MOD( iyear_tmp , 90 ) 366 !!--------------------------------------- 367 IF ((iyear_beg > 77) .OR. (iyear_beg==0)) THEN 368 qtr_cfc(:,:,:) = 0._wp 369 IF(lwp) THEN 370 WRITE(numout,*) 371 WRITE(numout,*) 'restart a CFC cycle or out of P_cfc year bounds zero --' 372 WRITE(numout,*) ' -- set qtr_CFC = 0.00 --' 373 WRITE(numout,*) ' -- set qint_CFC = 0.00 --' 374 WRITE(numout,*) ' -- set trn(CFC) = 0.00 --' 375 ENDIF 376 qtr_cfc(:,:,:) = 0._wp 377 qint_cfc(:,:,:) = 0._wp 378 trn(:,:,:,jp_cfc0:jp_cfc1) = 0._wp 379 trb(:,:,:,jp_cfc0:jp_cfc1) = 0._wp 380 ENDIF 381 !! 382 !! 2 -- Hindcast/proj 383 ELSEIF (simu_type==2) THEN 384 iyear_beg = MOD(nyear, 100) 385 IF (iyear_beg < 20) iyear_beg = iyear_beg + 100 386 IF ((iyear_beg < 30) .OR. (iyear_beg > 115)) THEN 387 qtr_cfc(:,:,:) = 0._wp 388 IF(lwp) THEN 389 WRITE(numout,*) 390 WRITE(numout,*) 'restart a CFC cycle or out of P_cfc year bounds zero --' 391 WRITE(numout,*) ' -- set qtr_CFC = 0.00 --' 392 WRITE(numout,*) ' -- set qint_CFC = 0.00 --' 393 WRITE(numout,*) ' -- set trn(CFC) = 0.00 --' 394 ENDIF 395 qtr_cfc(:,:,:) = 0._wp 396 qint_cfc(:,:,:) = 0._wp 397 trn(:,:,:,jp_cfc0:jp_cfc1) = 0._wp 398 trb(:,:,:,jp_cfc0:jp_cfc1) = 0._wp 399 ENDIF 264 400 ENDIF 401 265 402 IF(lwp) WRITE(numout,*) 266 403 !
Note: See TracChangeset
for help on using the changeset viewer.
