- Timestamp:
- 2018-07-23T11:33:03+02:00 (6 years ago)
- Location:
- branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/TOP_SRC/CFC
- Files:
-
- 4 edited
-
par_cfc.F90 (modified) (5 diffs)
-
trcini_cfc.F90 (modified) (7 diffs)
-
trcnam_cfc.F90 (modified) (2 diffs)
-
trcsms_cfc.F90 (modified) (12 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/TOP_SRC/CFC/par_cfc.F90
r7960 r9987 5 5 !!====================================================================== 6 6 !! History : 2.0 ! 2007-12 (C. Ethe, G. Madec) revised architecture 7 !! ! 2017-04 (A. Yool) add SF6 7 8 !!---------------------------------------------------------------------- 8 9 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 15 16 USE par_pisces , ONLY : jp_pisces_trd !: number of biological diag in PISCES 16 17 18 USE par_medusa , ONLY : jp_medusa !: number of tracers in MEDUSA 19 USE par_medusa , ONLY : jp_medusa_2d !: number of 2D diag in MEDUSA 20 USE par_medusa , ONLY : jp_medusa_3d !: number of 3D diag in MEDUSA 21 USE par_medusa , ONLY : jp_medusa_trd !: number of biological diag in MEDUSA 22 23 USE par_idtra , ONLY : jp_idtra !: number of tracers in ideal tracer 24 USE par_idtra , ONLY : jp_idtra_2d !: number of tracers in ideal tracer 25 USE par_idtra , ONLY : jp_idtra_3d !: number of tracers in ideal tracer 26 USE par_idtra , ONLY : jp_idtra_trd !: number of tracers in ideal tracer 27 17 28 IMPLICIT NONE 18 29 19 INTEGER, PARAMETER :: jp_lc = jp_pisces !: cumulative number of passive tracers 20 INTEGER, PARAMETER :: jp_lc_2d = jp_pisces_2d !: 21 INTEGER, PARAMETER :: jp_lc_3d = jp_pisces_3d !: 22 INTEGER, PARAMETER :: jp_lc_trd = jp_pisces_trd !: 30 INTEGER, PARAMETER :: jp_lc = jp_pisces + jp_medusa + & 31 jp_idtra !: cumulative number of passive tracers 32 INTEGER, PARAMETER :: jp_lc_2d = jp_pisces_2d + jp_medusa_2d + & 33 jp_idtra_2d !: 34 INTEGER, PARAMETER :: jp_lc_3d = jp_pisces_3d + jp_medusa_3d + & 35 jp_idtra_3d !: 36 INTEGER, PARAMETER :: jp_lc_trd = jp_pisces_trd + jp_medusa_trd + & 37 jp_idtra_trd !: 23 38 24 39 #if defined key_cfc … … 27 42 !!--------------------------------------------------------------------- 28 43 LOGICAL, PUBLIC, PARAMETER :: lk_cfc = .TRUE. !: CFC flag 29 INTEGER, PUBLIC, PARAMETER :: jp_cfc = 1!: number of passive tracers30 INTEGER, PUBLIC, PARAMETER :: jp_cfc_2d = 2!: additional 2d output arrays ('key_trc_diaadd')44 INTEGER, PUBLIC, PARAMETER :: jp_cfc = 3 !: number of passive tracers 45 INTEGER, PUBLIC, PARAMETER :: jp_cfc_2d = 6 !: additional 2d output arrays ('key_trc_diaadd') 31 46 INTEGER, PUBLIC, PARAMETER :: jp_cfc_3d = 0 !: additional 3d output arrays ('key_trc_diaadd') 32 47 INTEGER, PUBLIC, PARAMETER :: jp_cfc_trd = 0 !: number of sms trends for CFC … … 34 49 ! assign an index in trc arrays for each CFC prognostic variables 35 50 INTEGER, PUBLIC, PARAMETER :: jpc11 = jp_lc + 1 !: CFC-11 36 INTEGER, PUBLIC, PARAMETER :: jpc12 = jp_lc + 2 !: CFC-12 51 INTEGER, PUBLIC, PARAMETER :: jpc12 = jp_lc + 2 !: CFC-12 (priority tracer for CMIP6) 52 INTEGER, PUBLIC, PARAMETER :: jpsf6 = jp_lc + 3 !: SF6 37 53 #else 38 54 !!--------------------------------------------------------------------- … … 47 63 48 64 ! Starting/ending CFC do-loop indices (N.B. no CFC : jp_cfc0 > jp_cfc1 the do-loop are never done) 49 INTEGER, PUBLIC, PARAMETER :: jp_cfc0 = jp_lc + 1 !: First index of CFC tracers50 INTEGER, PUBLIC, PARAMETER :: jp_cfc1 = jp_lc + jp_cfc !: Last index of CFC tracers51 INTEGER, PUBLIC, PARAMETER :: jp_cfc0_2d = jp_lc_2d + 1 !: First index of CFC tracers65 INTEGER, PUBLIC, PARAMETER :: jp_cfc0 = jp_lc + 1 !: First index of CFC tracers 66 INTEGER, PUBLIC, PARAMETER :: jp_cfc1 = jp_lc + jp_cfc !: Last index of CFC tracers 67 INTEGER, PUBLIC, PARAMETER :: jp_cfc0_2d = jp_lc_2d + 1 !: First index of CFC tracers 52 68 INTEGER, PUBLIC, PARAMETER :: jp_cfc1_2d = jp_lc_2d + jp_cfc_2d !: Last index of CFC tracers 53 INTEGER, PUBLIC, PARAMETER :: jp_cfc0_3d = jp_lc_3d + 1 !: First index of CFC tracers69 INTEGER, PUBLIC, PARAMETER :: jp_cfc0_3d = jp_lc_3d + 1 !: First index of CFC tracers 54 70 INTEGER, PUBLIC, PARAMETER :: jp_cfc1_3d = jp_lc_3d + jp_cfc_3d !: Last index of CFC tracers 55 INTEGER, PUBLIC, PARAMETER :: jp_cfc0_trd = jp_lc_trd + 1 !: First index of CFC tracers56 INTEGER, PUBLIC, PARAMETER :: jp_cfc1_trd = jp_lc_trd + jp_cfc_trd 71 INTEGER, PUBLIC, PARAMETER :: jp_cfc0_trd = jp_lc_trd + 1 !: First index of CFC tracers 72 INTEGER, PUBLIC, PARAMETER :: jp_cfc1_trd = jp_lc_trd + jp_cfc_trd !: Last index of CFC tracers 57 73 58 74 !!====================================================================== -
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/TOP_SRC/CFC/trcini_cfc.F90
r7960 r9987 5 5 !!====================================================================== 6 6 !! History : 2.0 ! 2007-12 (C. Ethe, G. Madec) 7 !! ! 2017-04 (A. Yool) Add SF6 7 8 !!---------------------------------------------------------------------- 8 9 #if defined key_cfc … … 22 23 PUBLIC trc_ini_cfc ! called by trcini.F90 module 23 24 24 CHARACTER (len=34) :: clname = 'cfc1112 .atm' ! ???25 CHARACTER (len=34) :: clname = 'cfc1112sf6.atm' ! ??? 25 26 26 27 INTEGER :: inum ! unit number … … 44 45 !!---------------------------------------------------------------------- 45 46 INTEGER :: ji, jj, jn, jl, jm, js, io, ierr 46 INTEGER :: iskip = 6! number of 1st descriptor lines47 INTEGER :: iskip = 7 ! number of 1st descriptor lines 47 48 REAL(wp) :: zyy, zyd 48 49 !!---------------------------------------------------------------------- … … 53 54 54 55 55 IF(lwp) WRITE(numout,*) 'read of formatted file cfc1112 atm'56 IF(lwp) WRITE(numout,*) 'read of formatted file cfc1112sf6.atm' 56 57 57 58 CALL ctl_opn( inum, clname, 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) … … 69 70 ! ! Allocate CFC arrays 70 71 71 ALLOCATE( p_cfc(jpyear,jphem, 2), STAT=ierr )72 ALLOCATE( p_cfc(jpyear,jphem,3), STAT=ierr ) 72 73 IF( ierr > 0 ) THEN 73 74 CALL ctl_stop( 'trc_ini_cfc: unable to allocate p_cfc array' ) ; RETURN … … 90 91 ENDIF 91 92 qint_cfc(:,:,:) = 0._wp 92 DO jl = 1, jp_cfc 93 jn = jp_cfc0 + jl - 1 94 trn(:,:,:,jn) = 0._wp 95 END DO 93 trn(:,:,:,jp_cfc0:jp_cfc1) = 0._wp 96 94 ENDIF 97 95 … … 105 103 jn = 31 106 104 DO 107 READ(inum,*, IOSTAT=io) zyy, p_cfc(jn,1,1), p_cfc(jn,1,2), p_cfc(jn,2,1), p_cfc(jn,2,2) 105 READ(inum,*, IOSTAT=io) zyy, p_cfc(jn,1,1), p_cfc(jn,1,2), & 106 & p_cfc(jn,1,3), p_cfc(jn,2,1), & 107 & p_cfc(jn,2,2), p_cfc(jn,2,3) 108 108 IF( io < 0 ) exit 109 109 jn = jn + 1 110 110 END DO 111 111 112 p_cfc(32,1:2,1) = 5.e-4 ! modify the values of the first years 113 p_cfc(33,1:2,1) = 8.e-4 114 p_cfc(34,1:2,1) = 1.e-6 115 p_cfc(35,1:2,1) = 2.e-3 116 p_cfc(36,1:2,1) = 4.e-3 117 p_cfc(37,1:2,1) = 6.e-3 118 p_cfc(38,1:2,1) = 8.e-3 119 p_cfc(39,1:2,1) = 1.e-2 112 ! AXY (25/04/17): do not adjust 113 ! p_cfc(32,1:2,1) = 5.e-4 ! modify the values of the first years 114 ! p_cfc(33,1:2,1) = 8.e-4 115 ! p_cfc(34,1:2,1) = 1.e-6 116 ! p_cfc(35,1:2,1) = 2.e-3 117 ! p_cfc(36,1:2,1) = 4.e-3 118 ! p_cfc(37,1:2,1) = 6.e-3 119 ! p_cfc(38,1:2,1) = 8.e-3 120 ! p_cfc(39,1:2,1) = 1.e-2 120 121 121 122 IF(lwp) THEN ! Control print 122 123 WRITE(numout,*) 123 WRITE(numout,*) ' Year p11HN p11HS p12HN p12HS '124 WRITE(numout,*) ' Year p11HN p11HS p12HN p12HS pSF6N pSF6S ' 124 125 DO jn = 30, jpyear 125 WRITE(numout, '( 1I4, 4F9.2)') jn, p_cfc(jn,1,1), p_cfc(jn,2,1), p_cfc(jn,1,2), p_cfc(jn,2,2) 126 WRITE(numout, '( 1I4, 6F9.2)') jn, p_cfc(jn,1,1), p_cfc(jn,2,1), & 127 & p_cfc(jn,1,2), p_cfc(jn,2,2), & 128 & p_cfc(jn,1,3), p_cfc(jn,2,3) 126 129 END DO 127 130 ENDIF 128 129 131 130 132 ! Interpolation factor of atmospheric partial pressure -
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/TOP_SRC/CFC/trcnam_cfc.F90
r7960 r9987 47 47 INTEGER :: ios ! Local integer output status for namelist read 48 48 INTEGER :: jl, jn 49 TYPE(DIAG), DIMENSION(jp_cfc_2d) :: cfcdia2d50 49 !! 51 NAMELIST/namcfcdate/ ndate_beg, nyear_res 52 NAMELIST/namcfcdia/ cfcdia2d ! additional diagnostics 50 NAMELIST/namcfcdate/ ndate_beg, nyear_res, simu_type 53 51 !!---------------------------------------------------------------------- 54 52 ! ! Open namelist files … … 72 70 WRITE(numout,*) ' initial calendar date (aammjj) for CFC ndate_beg = ', ndate_beg 73 71 WRITE(numout,*) ' restoring time constant (year) nyear_res = ', nyear_res 72 IF (simu_type==1) THEN 73 WRITE(numout,*) ' CFC running on SPIN-UP mode simu_type = ', simu_type 74 ELSEIF (simu_type==2) THEN 75 WRITE(numout,*) ' CFC running on HINDCAST/PROJECTION mode simu_type = ', simu_type 76 ENDIF 74 77 ENDIF 75 78 nyear_beg = ndate_beg / 10000 76 79 IF(lwp) WRITE(numout,*) ' initial year (aa) nyear_beg = ', nyear_beg 77 80 ! 78 79 IF( .NOT.lk_iomput .AND. ln_diatrc ) THEN80 !81 ! Namelist namcfcdia82 ! -------------------83 REWIND( numnatc_ref ) ! Namelist namcfcdia in reference namelist : CFC diagnostics84 READ ( numnatc_ref, namcfcdia, IOSTAT = ios, ERR = 903)85 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfcdia in reference namelist', lwp )86 87 REWIND( numnatc_cfg ) ! Namelist namcfcdia in configuration namelist : CFC diagnostics88 READ ( numnatc_cfg, namcfcdia, IOSTAT = ios, ERR = 904 )89 904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfcdia in configuration namelist', lwp )90 IF(lwm) WRITE ( numonc, namcfcdia )91 92 DO jl = 1, jp_cfc_2d93 jn = jp_cfc0_2d + jl - 194 ctrc2d(jn) = TRIM( cfcdia2d(jl)%sname )95 ctrc2l(jn) = TRIM( cfcdia2d(jl)%lname )96 ctrc2u(jn) = TRIM( cfcdia2d(jl)%units )97 END DO98 99 IF(lwp) THEN ! control print100 WRITE(numout,*)101 WRITE(numout,*) ' Namelist : natadd'102 DO jl = 1, jp_cfc_2d103 jn = jp_cfc0_2d + jl - 1104 WRITE(numout,*) ' 2d diag nb : ', jn, ' short name : ', ctrc2d(jn), &105 & ' long name : ', ctrc2l(jn), ' unit : ', ctrc2u(jn)106 END DO107 WRITE(numout,*) ' '108 ENDIF109 !110 ENDIF111 81 112 82 IF(lwm) CALL FLUSH ( numonc ) ! flush output namelist CFC -
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.
