Changeset 765 for branches/dev_001_GM/NEMO/TOP_SRC/CFC/trccfc.F90
- Timestamp:
- 2007-12-14T08:29:53+01:00 (16 years ago)
- File:
-
- 1 moved
Legend:
- Unmodified
- Added
- Removed
-
branches/dev_001_GM/NEMO/TOP_SRC/CFC/trccfc.F90
r764 r765 1 MODULE trc freons1 MODULE trccfc 2 2 !!====================================================================== 3 !! *** MODULE trc freons***3 !! *** MODULE trccfc *** 4 4 !! TOP : CFC main model 5 5 !!====================================================================== 6 6 !! History : - ! 1999-10 (JC. Dutay) original code 7 7 !! 1.0 ! 2004-03 (C. Ethe) free form + modularity 8 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) reorganisation 8 9 !!---------------------------------------------------------------------- 9 10 #if defined key_cfc 10 11 !!---------------------------------------------------------------------- 11 !! 'key_cfc' CFC chemical model12 !!---------------------------------------------------------------------- 13 !! trc_ freons: compute and add CFC suface forcing to CFC trends14 !! trc_ freons_cst : sets constants for CFC surface forcing computation15 !!---------------------------------------------------------------------- 16 USE daymod 17 USE sms18 USE oce_trc19 USE trc 12 !! 'key_cfc' CFC tracers 13 !!---------------------------------------------------------------------- 14 !! trc_cfc : compute and add CFC suface forcing to CFC trends 15 !! trc_cfc_cst : sets constants for CFC surface forcing computation 16 !!---------------------------------------------------------------------- 17 USE daymod ! calendar 18 USE oce_trc ! Ocean variables 19 USE par_trc ! TOP parameters 20 USE trc ! TOP variables 20 21 21 22 IMPLICIT NONE 22 23 PRIVATE 23 24 24 PUBLIC trc_freons ! called in ??? 25 PUBLIC trc_cfc ! called in ??? 26 27 INTEGER , PARAMETER :: jpyear = 100 ! temporal parameter 28 INTEGER , PARAMETER :: jphem = 2 ! parameter for the 2 hemispheres 29 INTEGER , PUBLIC :: ndate_beg ! initial calendar date (aammjj) for CFC 30 INTEGER , PUBLIC :: nyear_res ! restoring time constant (year) 31 INTEGER , PUBLIC :: nyear_beg ! initial year (aa) 32 33 REAL(wp), PUBLIC, DIMENSION(jpyear,jphem, jpf_cfc:jpl_cfc) :: p_cfc ! partial hemispheric pressure for CFC 34 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: xphem ! spatial interpolation factor for patm 35 REAL(wp), PUBLIC, DIMENSION(jpi,jpj ,jpf_cfc:jpl_cfc) :: qtr ! input function 36 REAL(wp), PUBLIC, DIMENSION(jpi,jpj ,jpf_cfc:jpl_cfc) :: qint ! flux function 25 37 26 38 REAL(wp), DIMENSION(jptra) :: soa1, soa2, soa3, soa4 ! coefficient for solubility of CFC [mol/l/atm] … … 37 49 # include "passivetrc_substitute.h90" 38 50 !!---------------------------------------------------------------------- 39 !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)40 !! $Id $51 !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 52 !! $Id:$ 41 53 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 42 54 !!---------------------------------------------------------------------- … … 44 56 CONTAINS 45 57 46 SUBROUTINE trc_ freons( kt )58 SUBROUTINE trc_cfc( kt ) 47 59 !!---------------------------------------------------------------------- 48 !! *** ROUTINE trc_freons *** 49 !! 50 !! ** Purpose : Compute the surface boundary contition on freon 11 51 !! passive tracer associated with air-mer fluxes and add it to 52 !! the general trend of tracers equations. 53 !! 54 !! ** Method : 55 !! - get the atmospheric partial pressure - given in pico - 56 !! - computation of solubility ( in 1.e-12 mol/l then in 1.e-9 mol/m3) 57 !! - computation of transfert speed ( given in cm/hour ----> cm/s ) 58 !! - the input function is given by : 59 !! speed * ( concentration at equilibrium - concemtration at surface ) 60 !! - the input function is in pico-mol/m3/s and the 61 !! freons concentration in pico-mol/m3 60 !! *** ROUTINE trc_cfc *** 61 !! 62 !! ** Purpose : Compute the surface boundary contition on CFC 11 63 !! passive tracer associated with air-mer fluxes and add it 64 !! to the general trend of tracers equations. 65 !! 66 !! ** Method : - get the atmospheric partial pressure - given in pico - 67 !! - computation of solubility ( in 1.e-12 mol/l then in 1.e-9 mol/m3) 68 !! - computation of transfert speed ( given in cm/hour ----> cm/s ) 69 !! - the input function is given by : 70 !! speed * ( concentration at equilibrium - concentration at surface ) 71 !! - the input function is in pico-mol/m3/s and the 72 !! CFC concentration in pico-mol/m3 62 73 !!---------------------------------------------------------------------- 63 74 INTEGER, INTENT( in ) :: kt ! ocean time-step index … … 65 76 INTEGER :: ji, jj, jn, jm 66 77 INTEGER :: iyear_beg, iyear_end 67 INTEGER :: im onth, im1, im278 INTEGER :: im1, im2 68 79 69 80 REAL(wp) :: ztap, zdtap 70 81 REAL(wp) :: zt1, zt2, zt3, zv2 71 REAL(wp) :: zsol ! solubility 72 REAL(wp) :: zsch ! schmidt number 82 REAL(wp) :: zsol ! solubility 83 REAL(wp) :: zsch ! schmidt number 84 REAL(wp) :: zpp_cfc ! atmospheric partial pressure of CFC 85 REAL(wp) :: zca_cfc ! concentration at equilibrium 86 REAL(wp) :: zak_cfc ! transfert coefficients 73 87 74 REAL(wp), DIMENSION(jphem,jptra) :: zpatm ! atmospheric function 75 REAL(wp), DIMENSION(jpi,jpj,jptra) :: zca_cfc ! concentration 76 REAL(wp), DIMENSION(jpi,jpj,jptra) :: zak_cfc ! transfert coefficients 88 REAL(wp), DIMENSION(jphem,jptra) :: zpatm ! atmospheric function 77 89 !!---------------------------------------------------------------------- 78 90 79 IF( kt == nittrc000 ) CALL trc_ freons_cst91 IF( kt == nittrc000 ) CALL trc_cfc_cst 80 92 81 93 ! Temporal interpolation 82 94 ! ---------------------- 83 95 iyear_beg = nyear + ( nyear_res - 1900 - nyear_beg ) 84 imonth = nmonth 85 86 IF ( imonth .LE. 6 ) THEN 96 IF ( nmonth <= 6 ) THEN 87 97 iyear_beg = iyear_beg - 2 + nyear_beg 88 im1 = 6 - imonth + 189 im2 = 6 + imonth - 198 im1 = 6 - nmonth + 1 99 im2 = 6 + nmonth - 1 90 100 ELSE 91 101 iyear_beg = iyear_beg - 1 + nyear_beg 92 im1 = 12 - imonth + 793 im2 = imonth - 7102 im1 = 12 - nmonth + 7 103 im2 = nmonth - 7 94 104 ENDIF 95 96 105 iyear_end = iyear_beg + 1 97 106 98 107 99 ! Temporal and spatial interpolation at time k 100 ! -------------------------------------------------- 101 DO jn = 1, jptra 102 DO jm = 1, jphem 108 ! !------------! 109 DO jn = jpf_cfc, jpl_cfc ! CFC loop ! 110 ! !------------! 111 ! time interpolation at time kt 112 DO jm = 1, jphem 103 113 zpatm(jm,jn) = ( p_cfc(iyear_beg, jm, jn) * FLOAT (im1) & 104 114 & + p_cfc(iyear_end, jm, jn) * FLOAT (im2) ) / 12. 105 115 END DO 106 END DO 107 108 DO jn = 1, jptra 109 pp_cfc(:,:,jn) = xphem(:,:) * zpatm(1,jn) & 110 & + ( 1.- xphem(:,:) ) * zpatm(2,jn) 111 END DO 112 113 114 !------------------------------------------------------------ 115 ! Computation of concentration at equilibrium : in picomol/l 116 ! ----------------------------------------------------------- 117 118 DO jn = 1, jptra 119 DO jj = 1 , jpj 120 DO ji = 1 , jpi 116 117 ! !------------! 118 DO jj = 1, jpj ! i-j loop ! 119 DO ji = 1, jpi !------------! 120 121 ! space interpolation 122 zpp_cfc = xphem(ji,jj) * zpatm(1,jn) & 123 & + ( 1.- xphem(ji,jj) ) * zpatm(2,jn) 124 125 ! Computation of concentration at equilibrium : in picomol/l 121 126 ! coefficient for solubility for CFC-11/12 in mol/l/atm 122 127 IF( tmask(ji,jj,1) .GE. 0.5 ) THEN 123 ztap = ( tn(ji,jj,1) + 273.16 ) * 0.01124 zdtap = ( sob3(jn) * ztap + sob2(jn) )* ztap + sob1(jn)125 zsol = EXP ( soa1(jn) + soa2(jn) / ztap + soa3(jn) * LOG( ztap ) &128 ztap = ( tn(ji,jj,1) + 273.16 ) * 0.01 129 zdtap = ( sob3(jn) * ztap + sob2(jn) ) * ztap + sob1(jn) 130 zsol = EXP( soa1(jn) + soa2(jn) / ztap + soa3(jn) * LOG( ztap ) & 126 131 & + soa4(jn) * ztap * ztap + sn(ji,jj,1) * zdtap ) 127 132 ELSE 128 zsol = 0. 133 zsol = 0.e0 129 134 ENDIF 130 135 ! conversion from mol/l/atm to mol/m3/atm and from mol/m3/atm to mol/m3/pptv 131 136 zsol = xconv4 * xconv3 * zsol * tmask(ji,jj,1) 132 137 ! concentration at equilibrium 133 zca_cfc(ji,jj,jn) = xconv1 * pp_cfc(ji,jj,jn) * zsol * tmask(ji,jj,1) 134 END DO 135 END DO 136 END DO 137 138 zca_cfc = xconv1 * zpp_cfc * zsol * tmask(ji,jj,1) 138 139 139 !------------------------------- 140 ! Computation of speed transfert 141 ! ------------------------------ 142 143 DO jn = 1, jptra 144 DO jj = 1, jpj 145 DO ji = 1, jpi 146 ! Schmidt number 140 ! Computation of speed transfert 141 ! Schmidt number 147 142 zt1 = tn(ji,jj,1) 148 143 zt2 = zt1 * zt1 149 144 zt3 = zt1 * zt2 150 145 zsch = sca1(jn) + sca2(jn) * zt1 + sca3(jn) * zt2 + sca4(jn) * zt3 151 ! speed transfert : formulae of wanninkhof 1992 152 zv2 = vatm(ji,jj) * vatm(ji,jj) 153 zsch = zsch / 660. 154 zak_cfc(ji,jj,jn) = ( 0.39 * xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1) 155 END DO 156 END DO 157 END DO 158 159 160 !---------------------------------------------------------------- 161 ! Input function : speed *( conc. at equil - concen at surface ) 162 ! trn in pico-mol/l idem qtr; ak in en m/s 163 !----------------------------------------------------------------- 164 165 DO jn = 1, jptra 166 DO jj = 1, jpj 167 DO ji = 1, jpi 168 qtr(ji,jj,jn) = -zak_cfc(ji,jj,jn) * ( trb(ji,jj,1,jn) - zca_cfc(ji,jj,jn) ) & 146 ! speed transfert : formulae of wanninkhof 1992 147 zv2 = vatm(ji,jj) * vatm(ji,jj) 148 zsch = zsch / 660. 149 zak_cfc = ( 0.39 * xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1) 150 151 ! Input function : speed *( conc. at equil - concen at surface ) 152 ! 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 ) & 169 154 #if defined key_off_degrad 170 & 155 & * facvol(ji,jj,1) & 171 156 #endif 172 & * tmask(ji,jj,1) * ( 1. - freeze(ji,jj) ) 173 END DO 174 END DO 175 END DO 176 177 178 ! --------------------- 179 ! Add the trend 180 ! --------------------- 181 182 DO jn = 1, jptra 183 DO jj = 1, jpj 184 DO ji = 1, jpi 157 & * tmask(ji,jj,1) * ( 1. - freeze(ji,jj) ) 158 159 ! Add the surface flux to the trend 185 160 tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + qtr(ji,jj,jn) / fse3t(ji,jj,1) 186 END DO 187 END DO 188 END DO 189 190 ! -------------------------------------------- 191 ! cumulation of tracer flux at each time step 192 ! -------------------------------------------- 193 DO jn = 1, jptra 194 DO jj = 1, jpj 195 DO ji = 1, jpi 161 162 ! cumulation of surface flux at each time step 196 163 qint(ji,jj,jn) = qint (ji,jj,jn) + qtr(ji,jj,jn) * rdt 197 END DO 198 END DO 199 END DO 200 ! 201 END SUBROUTINE trc_freons 202 203 204 SUBROUTINE trc_freons_cst 164 ! !----------------! 165 END DO ! end i-j loop ! 166 END DO !----------------! 167 ! !----------------! 168 END DO ! end CFC loop ! 169 ! !----------------! 170 END SUBROUTINE trc_cfc 171 172 173 SUBROUTINE trc_cfc_cst 205 174 !!--------------------------------------------------------------------- 206 !! *** trc_ freons_cst ***175 !! *** trc_cfc_cst *** 207 176 !! 208 177 !! ** Purpose : sets constants for CFC model … … 217 186 soa2(jn) = 319.6552 218 187 soa3(jn) = 119.4471 219 soa4(jn) = -1.39165220 sob1(jn) = -0.142382221 sob2(jn) = 0.091459222 sob3(jn) = -0.0157274188 soa4(jn) = -1.39165 189 sob1(jn) = -0.142382 190 sob2(jn) = 0.091459 191 sob3(jn) = -0.0157274 223 192 224 193 ! coefficients for schmidt number in degre Celcius 225 194 sca1(jn) = 3501.8 226 195 sca2(jn) = -210.31 227 sca3(jn) = 6.1851228 sca4(jn) = -0.07513196 sca3(jn) = 6.1851 197 sca4(jn) = -0.07513 229 198 230 199 ELSE IF( jn == jp12 ) THEN … … 234 203 soa2(jn) = 298.9702 235 204 soa3(jn) = 113.8049 236 soa4(jn) = -1.39165237 sob1(jn) = -0.143566238 sob2(jn) = 0.091015239 sob3(jn) = -0.0153924205 soa4(jn) = -1.39165 206 sob1(jn) = -0.143566 207 sob2(jn) = 0.091015 208 sob3(jn) = -0.0153924 240 209 241 210 ! coefficients for schmidt number in degre Celcius 242 211 sca1(jn) = 3845.4 243 sca2(jn) = -228.95244 sca3(jn) = 6.1908245 sca4(jn) = -0.067430212 sca2(jn) = -228.95 213 sca3(jn) = 6.1908 214 sca4(jn) = -0.067430 246 215 ENDIF 247 216 ENDDO … … 256 225 END DO 257 226 ! 258 END SUBROUTINE trc_ freons_cst227 END SUBROUTINE trc_cfc_cst 259 228 260 229 #else 261 230 !!---------------------------------------------------------------------- 262 !! Dummy module No CFC model231 !! Dummy module No CFC tracers 263 232 !!---------------------------------------------------------------------- 264 233 CONTAINS 265 SUBROUTINE trc_ freons( kt ) ! Empty routine266 WRITE(*,*) 'trc_ freons: You should not have seen this print! error?', kt267 END SUBROUTINE trc_ freons234 SUBROUTINE trc_cfc( kt ) ! Empty routine 235 WRITE(*,*) 'trc_cfc: You should not have seen this print! error?', kt 236 END SUBROUTINE trc_cfc 268 237 #endif 269 238 270 239 !!====================================================================== 271 END MODULE trc freons240 END MODULE trccfc
Note: See TracChangeset
for help on using the changeset viewer.
