Changeset 9987 for branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90
- Timestamp:
- 2018-07-23T11:33:03+02:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90
r7960 r9987 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 188 ! 189 IF( lk_iomput ) THEN 190 CALL iom_put( "qtrCFC11" , qtr_cfc (:,:,1) ) 191 CALL iom_put( "qintCFC11" , qint_cfc(:,:,1) ) 192 ELSE 193 IF( ln_diatrc ) THEN 194 trc2d(:,:,jp_cfc0_2d ) = qtr_cfc (:,:,1) 195 trc2d(:,:,jp_cfc0_2d + 1) = qint_cfc(:,:,1) 196 END IF 197 END IF 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 258 ! 259 IF (iom_use("qtrCFC11")) CALL iom_put( "qtrCFC11" , qtr_cfc (:,:,1) ) 260 IF (iom_use("qintCFC11")) CALL iom_put( "qintCFC11" , qint_cfc(:,:,1) ) 261 IF (iom_use("qtrCFC12")) CALL iom_put( "qtrCFC12" , qtr_cfc (:,:,2) ) 262 IF (iom_use("qintCFC12")) CALL iom_put( "qintCFC12" , qint_cfc(:,:,2) ) 263 IF (iom_use("qtrSF6")) CALL iom_put( "qtrSF6" , qtr_cfc (:,:,3) ) 264 IF (iom_use("qintSF6")) CALL iom_put( "qintSF6" , qint_cfc(:,:,3) ) 198 265 ! 199 266 IF( l_trdtrc ) THEN … … 203 270 END IF 204 271 ! 272 # if defined key_debug_medusa 273 IF(lwp) WRITE(numout,*) ' CFC - Check: nn_timing = ', nn_timing 274 CALL flush(numout) 275 # endif 205 276 IF( nn_timing == 1 ) CALL timing_stop('trc_sms_cfc') 206 277 ! … … 214 285 !! ** Purpose : sets constants for CFC model 215 286 !!--------------------------------------------------------------------- 216 INTEGER :: j n287 INTEGER :: jl, jn, iyear_beg, iyear_tmp 217 288 218 289 ! coefficient for CFC11 … … 223 294 soa(2,1) = 319.6552 224 295 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 296 soa(4,1) = -1.39165 297 298 sob(1,1) = -0.142382 299 sob(2,1) = 0.091459 300 sob(3,1) = -0.0157274 301 302 ! Schmidt number AXY (25/04/17) 303 sca(1,1) = 3579.2 ! = 3501.8 304 sca(2,1) = -222.63 ! = -210.31 305 sca(3,1) = 7.5749 ! = 6.1851 306 sca(4,1) = -0.14595 ! = -0.07513 307 sca(5,1) = 0.0011874 ! = absent 236 308 237 309 ! coefficient for CFC12 … … 242 314 soa(2,2) = 298.9702 243 315 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 316 soa(4,2) = -1.39165 317 318 sob(1,2) = -0.143566 319 sob(2,2) = 0.091015 320 sob(3,2) = -0.0153924 321 322 ! schmidt number AXY (25/04/17) 323 sca(1,2) = 3828.1 ! = 3845.4 324 sca(2,2) = -249.86 ! = -228.95 325 sca(3,2) = 8.7603 ! = 6.1908 326 sca(4,2) = -0.1716 ! = -0.067430 327 sca(5,2) = 0.001408 ! = absent 328 329 ! coefficients for SF6 AXY (25/04/17) 330 !--------------------- 331 332 ! Solubility 333 soa(1,3) = -80.0343 334 soa(2,3) = 117.232 335 soa(3,3) = 29.5817 336 soa(4,3) = 0.0 337 338 sob(1,3) = 0.0335183 339 sob(2,3) = -0.0373942 340 sob(3,3) = 0.00774862 341 342 ! Schmidt number 343 sca(1,3) = 3177.5 344 sca(2,3) = -200.57 345 sca(3,3) = 6.8865 346 sca(4,3) = -0.13335 347 sca(5,3) = 0.0010877 348 349 !!--------------------------------------------- 350 !! JPALM -- re-initialize CFC fields and diags if restart a CFC cycle, 351 !! Or if out of P_cfc range 352 IF (simu_type==1) THEN 353 iyear_tmp = nyear - nyear_res !! JPALM -- in our spin-up, nyear_res is 1000 354 iyear_beg = MOD( iyear_tmp , 90 ) 355 !!--------------------------------------- 356 IF ((iyear_beg > 77) .OR. (iyear_beg==0)) THEN 357 qtr_cfc(:,:,:) = 0._wp 358 IF(lwp) THEN 359 WRITE(numout,*) 360 WRITE(numout,*) 'restart a CFC cycle or out of P_cfc year bounds zero --' 361 WRITE(numout,*) ' -- set qtr_CFC = 0.00 --' 362 WRITE(numout,*) ' -- set qint_CFC = 0.00 --' 363 WRITE(numout,*) ' -- set trn(CFC) = 0.00 --' 364 ENDIF 365 qtr_cfc(:,:,:) = 0._wp 366 qint_cfc(:,:,:) = 0._wp 367 trn(:,:,:,jp_cfc0:jp_cfc1) = 0._wp 368 trb(:,:,:,jp_cfc0:jp_cfc1) = 0._wp 369 ENDIF 370 !! 371 !! 2 -- Hindcast/proj 372 ELSEIF (simu_type==2) THEN 373 iyear_beg = MOD(nyear, 100) 374 IF (iyear_beg < 20) iyear_beg = iyear_beg + 100 375 IF ((iyear_beg < 30) .OR. (iyear_beg > 115)) THEN 376 qtr_cfc(:,:,:) = 0._wp 377 IF(lwp) THEN 378 WRITE(numout,*) 379 WRITE(numout,*) 'restart a CFC cycle or out of P_cfc year bounds zero --' 380 WRITE(numout,*) ' -- set qtr_CFC = 0.00 --' 381 WRITE(numout,*) ' -- set qint_CFC = 0.00 --' 382 WRITE(numout,*) ' -- set trn(CFC) = 0.00 --' 383 ENDIF 384 qtr_cfc(:,:,:) = 0._wp 385 qint_cfc(:,:,:) = 0._wp 386 trn(:,:,:,jp_cfc0:jp_cfc1) = 0._wp 387 trb(:,:,:,jp_cfc0:jp_cfc1) = 0._wp 388 ENDIF 264 389 ENDIF 390 265 391 IF(lwp) WRITE(numout,*) 266 392 !
Note: See TracChangeset
for help on using the changeset viewer.
