Changeset 1255 for trunk/NEMO/TOP_SRC/CFC
- Timestamp:
- 2009-01-13T11:20:17+01:00 (15 years ago)
- Location:
- trunk/NEMO/TOP_SRC/CFC
- Files:
-
- 4 edited
-
trcctl_cfc.F90 (modified) (4 diffs)
-
trcini_cfc.F90 (modified) (6 diffs)
-
trclsm_cfc.F90 (modified) (3 diffs)
-
trcsms_cfc.F90 (modified) (11 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/TOP_SRC/CFC/trcctl_cfc.F90
r1146 r1255 33 33 !! ** Purpose : control the cpp options, namelist and files 34 34 !!---------------------------------------------------------------------- 35 INTEGER :: j n35 INTEGER :: jl, jn 36 36 37 37 IF(lwp) THEN … … 54 54 ! Check tracer names 55 55 ! ------------------ 56 IF( jp_cfc == 1 ) THEN 57 IF ( jp11 == 1 ) THEN 58 IF ( ctrcnm(jp11) /= 'CFC11') THEN 59 ctrcnm(jp11) = 'CFC11' 60 ctrcnl(jp11) = 'Chlorofuorocarbone 11 concentration' 61 ENDIF 62 ENDIF 63 IF( jp12 == 1 ) THEN 64 IF ( ctrcnm(jp12) /= 'CFC12') THEN 65 ctrcnm(jp12) = 'CFC12' 66 ctrcnl(jp12) = 'Chlorofuorocarbone 12 concentration' 67 ENDIF 68 ENDIF 69 ENDIF 70 71 IF( jp_cfc == 2 ) THEN 72 IF ( ctrcnm(jp11) /= 'CFC11' .OR. ctrcnm(jp12) /= 'CFC12' ) THEN 73 ctrcnm(jp11) = 'CFC11' 74 ctrcnl(jp11) = 'Chlorofuorocarbone 11 concentration' 75 ctrcnm(jp12) = 'CFC12' 76 ctrcnl(jp12) = 'Chlorofuorocarbone 12 concentration' 77 ENDIF 56 IF ( ctrcnm(jpc11) /= 'CFC11' .OR. ctrcnm(jpc12) /= 'CFC12' ) THEN 57 ctrcnm(jpc11) = 'CFC11' 58 ctrcnl(jpc11) = 'Chlorofuorocarbone 11 concentration' 59 ctrcnm(jpc12) = 'CFC12' 60 ctrcnl(jpc12) = 'Chlorofuorocarbone 12 concentration' 78 61 ENDIF 79 62 … … 82 65 WRITE (numout,*) ' ======= ============= ' 83 66 WRITE (numout,*) ' we force tracer names' 84 DO jn = jp_cfc0, jp_cfc1 67 DO jl = 1, jp_cfc 68 jn = jp_cfc0 + jl - 1 85 69 WRITE(numout,*) ' tracer nb: ',jn,' name = ',ctrcnm(jn), ctrcnl(jn) 86 70 END DO … … 91 75 ! Check tracer units 92 76 ! ------------------ 93 DO jn = jp_cfc0, jp_cfc1 77 DO jl = 1, jp_cfc 78 jn = jp_cfc0 + jl - 1 94 79 IF( ctrcun(jn) /= 'mole/m3' ) THEN 95 80 ctrcun(jn) = 'mole/m3' -
trunk/NEMO/TOP_SRC/CFC/trcini_cfc.F90
r1146 r1255 44 44 !! ** Method : - Read the namcfc namelist and check the parameter values 45 45 !!---------------------------------------------------------------------- 46 INTEGER :: ji, jj, jn, jl, jm 46 INTEGER :: ji, jj, jn, jl, jm, js 47 47 REAL(wp) :: zyy , zyd 48 48 !!---------------------------------------------------------------------- … … 55 55 ! Initialization of boundaries conditions 56 56 ! --------------------------------------- 57 qtr (:,:,:)= 0.e058 xphem (:,:) = 0.e059 DO jn = jp_cfc0, jp_cfc157 xphem (:,:) = 0.e0 58 DO jl = 1, jp_cfc 59 jn = jp_cfc0 + jl - 1 60 60 DO jm = 1, jphem 61 DO j l= 1, jpyear62 p_cfc(j l,jm,jn) = 0.061 DO js = 1, jpyear 62 p_cfc(js,jm,jn) = 0.0 63 63 END DO 64 64 END DO … … 68 68 ! Initialization of qint in case of no restart 69 69 !---------------------------------------------- 70 qtr_cfc(:,:,:) = 0.e0 70 71 IF( .NOT. lrsttr ) THEN 71 72 IF(lwp) THEN … … 73 74 WRITE(numout,*) 'Initialization de qint ; No restart : qint equal zero ' 74 75 ENDIF 75 DO jn = jp_cfc0, jp_cfc1 76 trn(:,:,:,jn) = 0.e0 77 qint(:,: ,jn) = 0.e0 76 DO jl = 1, jp_cfc 77 jn = jp_cfc0 + jl - 1 78 trn (:,:,:,jn) = 0.e0 79 qint_cfc(:,: ,jn) = 0.e0 78 80 END DO 79 81 ENDIF … … 96 98 97 99 DO jn = 31, 98 ! Read file 98 READ(inum,*) zyy, p_cfc(jn,1,jp11), p_cfc(jn,1,jp12), & 99 & p_cfc(jn,2,jp11), p_cfc(jn,2,jp12) 100 READ(inum,*) zyy, p_cfc(jn,1,1), p_cfc(jn,1,2), p_cfc(jn,2,1), p_cfc(jn,2,2) 100 101 WRITE(numout,'(f7.2, 4f8.2)' ) & 101 & zyy, p_cfc(jn,1,jp11), p_cfc(jn,1,jp12), & 102 & p_cfc(jn,2,jp11), p_cfc(jn,2,jp12) 102 & zyy, p_cfc(jn,1,1), p_cfc(jn,1,2), p_cfc(jn,2,1), p_cfc(jn,2,2) 103 103 END DO 104 104 105 p_cfc(32,1:2, jp11) = 5.e-4 ! modify the values of the first years106 p_cfc(33,1:2, jp11) = 8.e-4107 p_cfc(34,1:2, jp11) = 1.e-6108 p_cfc(35,1:2, jp11) = 2.e-3109 p_cfc(36,1:2, jp11) = 4.e-3110 p_cfc(37,1:2, jp11) = 6.e-3111 p_cfc(38,1:2, jp11) = 8.e-3112 p_cfc(39,1:2, jp11) = 1.e-2105 p_cfc(32,1:2,1) = 5.e-4 ! modify the values of the first years 106 p_cfc(33,1:2,1) = 8.e-4 107 p_cfc(34,1:2,1) = 1.e-6 108 p_cfc(35,1:2,1) = 2.e-3 109 p_cfc(36,1:2,1) = 4.e-3 110 p_cfc(37,1:2,1) = 6.e-3 111 p_cfc(38,1:2,1) = 8.e-3 112 p_cfc(39,1:2,1) = 1.e-2 113 113 114 114 IF(lwp) THEN ! Control print … … 117 117 DO jn = 30, 100 118 118 WRITE(numout, '( 1I4, 4F9.2)') & 119 & jn, p_cfc(jn,1,jp11), p_cfc(jn,2,jp11), & 120 & p_cfc(jn,1,jp12), p_cfc(jn,2,jp12) 119 & jn, p_cfc(jn,1,1), p_cfc(jn,2,1), p_cfc(jn,1,2), p_cfc(jn,2,2) 121 120 END DO 122 121 ENDIF -
trunk/NEMO/TOP_SRC/CFC/trclsm_cfc.F90
r1146 r1255 42 42 !!---------------------------------------------------------------------- 43 43 CHARACTER (len=32) :: clname = 'namelist_cfc' 44 INTEGER :: numnat 44 INTEGER :: numnatc 45 #if defined key_trc_diaadd 46 ! definition of additional diagnostic as a structure 47 INTEGER :: jl, jn 48 TYPE DIAG 49 CHARACTER(len = 20) :: snamedia !: short name 50 CHARACTER(len = 80 ) :: lnamedia !: long name 51 CHARACTER(len = 20 ) :: unitdia !: unit 52 END TYPE DIAG 53 54 TYPE(DIAG) , DIMENSION(jp_cfc_2d) :: cfcdia2d 55 #endif 45 56 !! 46 57 NAMELIST/namcfcdate/ ndate_beg, nyear_res 58 #if defined key_trc_diaadd 59 NAMELIST/namcfcdia/nwritedia, cfcdia2d ! additional diagnostics 60 #endif 47 61 !!------------------------------------------------------------------- 48 62 … … 51 65 52 66 ! ! Open namelist file 53 CALL ctlopn( numnat, clname, 'OLD', 'FORMATTED', 'SEQUENTIAL', & 54 & 1, numout, .FALSE., 1 ) 67 CALL ctlopn( numnatc, clname, 'OLD', 'FORMATTED', 'SEQUENTIAL', 1, numout, .FALSE., 1 ) 55 68 56 READ( numnat , namcfcdate ) ! read namelist69 READ( numnatc , namcfcdate ) ! read namelist 57 70 58 71 IF(lwp) THEN ! control print … … 66 79 IF(lwp) WRITE(numout,*) ' initial year (aa) nyear_beg = ', nyear_beg 67 80 ! 81 #if defined key_trc_diaadd 82 83 ! Namelist namcfcdia 84 ! ------------------- 85 nwritedia = 10 ! default values 86 87 DO jl = 1, jp_cfc_2d 88 jn = jp_cfc0_2d + jl - 1 89 WRITE(ctrc2d(jn),'("2D_",I1)') jn ! short name 90 WRITE(ctrc2l(jn),'("2D DIAGNOSTIC NUMBER ",I2)') jn ! long name 91 ctrc2u(jn) = ' ' ! units 92 END DO 93 94 REWIND( numnatc ) ! read natrtd 95 READ ( numnatc, namcfcdia ) 96 97 DO jl = 1, jp_cfc_2d 98 jn = jp_cfc0_2d + jl - 1 99 ctrc2d(jn) = cfcdia2d(jl)%snamedia 100 ctrc2l(jn) = cfcdia2d(jl)%lnamedia 101 ctrc2u(jn) = cfcdia2d(jl)%unitdia 102 END DO 103 104 105 IF(lwp) THEN ! control print 106 WRITE(numout,*) 107 WRITE(numout,*) ' Namelist : natadd' 108 WRITE(numout,*) ' frequency of outputs for additional arrays nwritedia = ', nwritedia 109 DO jl = 1, jp_cfc_2d 110 jn = jp_cfc0_2d + jl - 1 111 WRITE(numout,*) ' 2d output field No : ',jn 112 WRITE(numout,*) ' short name : ', TRIM(ctrc2d(jn)) 113 WRITE(numout,*) ' long name : ', TRIM(ctrc2l(jn)) 114 WRITE(numout,*) ' unit : ', TRIM(ctrc2u(jn)) 115 WRITE(numout,*) ' ' 116 END DO 117 ENDIF 118 #endif 119 68 120 END SUBROUTINE trc_lsm_cfc 69 121 -
trunk/NEMO/TOP_SRC/CFC/trcsms_cfc.F90
r1146 r1255 19 19 USE par_trc ! TOP parameters 20 20 USE trc ! TOP variables 21 USE trdmld_trc_oce 22 USE trdmld_trc 21 23 22 24 IMPLICIT NONE … … 31 33 INTEGER , PUBLIC :: nyear_beg ! initial year (aa) 32 34 33 REAL(wp), PUBLIC, DIMENSION(jpyear,jphem, jp_cfc 0:jp_cfc1) :: p_cfc! partial hemispheric pressure for CFC34 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) 35 REAL(wp), PUBLIC, DIMENSION(jpi,jpj ,jp_cfc0:jp_cfc1) :: qtr ! input function36 REAL(wp), PUBLIC, DIMENSION(jpi,jpj ,jp_cfc0:jp_cfc1) :: qint ! flux function37 38 REAL(wp), DIMENSION( jp_cfc0:jp_cfc1) :: soa1, soa2, soa3, soa4! coefficient for solubility of CFC [mol/l/atm]39 REAL(wp), DIMENSION( jp_cfc0:jp_cfc1) :: sob1, sob2, sob3! " "40 REAL(wp), DIMENSION( jp_cfc0:jp_cfc1) :: sca1, sca2, sca3, sca4! coefficients for schmidt number in degre Celcius35 REAL(wp), PUBLIC, DIMENSION(jpyear,jphem, jp_cfc) :: p_cfc ! partial hemispheric pressure for CFC 36 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: xphem ! spatial interpolation factor for patm 37 REAL(wp), PUBLIC, DIMENSION(jpi,jpj ,jp_cfc) :: qtr_cfc ! flux at surface 38 REAL(wp), PUBLIC, DIMENSION(jpi,jpj ,jp_cfc) :: qint_cfc ! cumulative flux 39 40 REAL(wp), DIMENSION(4,jp_cfc) :: soa ! coefficient for solubility of CFC [mol/l/atm] 41 REAL(wp), DIMENSION(3,jp_cfc) :: sob ! " " 42 REAL(wp), DIMENSION(4,jp_cfc) :: sca ! coefficients for schmidt number in degre Celcius 41 43 42 44 ! ! coefficients for conversion … … 74 76 INTEGER, INTENT( in ) :: kt ! ocean time-step index 75 77 !! 76 INTEGER :: ji, jj, jn, j m78 INTEGER :: ji, jj, jn, jl, jm, js 77 79 INTEGER :: iyear_beg, iyear_end 78 80 INTEGER :: im1, im2 … … 87 89 88 90 REAL(wp), DIMENSION(jphem,jp_cfc) :: zpatm ! atmospheric function 91 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrcfc ! use for CFC sms trend 89 92 !!---------------------------------------------------------------------- 90 93 … … 105 108 iyear_end = iyear_beg + 1 106 109 107 ! !------------! 108 DO jn = jp_cfc0, jp_cfc1 ! CFC loop ! 109 ! !------------! 110 ! !------------! 111 DO jl = 1, jp_cfc ! CFC loop ! 112 ! !------------! 113 jn = jp_cfc0 + jl - 1 110 114 ! time interpolation at time kt 111 115 DO jm = 1, jphem 112 zpatm(jm,j n) = ( p_cfc(iyear_beg, jm, jn) * FLOAT (im1) &113 & + p_cfc(iyear_end, jm, j n) * FLOAT (im2) ) / 12.116 zpatm(jm,jl) = ( p_cfc(iyear_beg, jm, jl) * FLOAT (im1) & 117 & + p_cfc(iyear_end, jm, jl) * FLOAT (im2) ) / 12. 114 118 END DO 115 119 … … 119 123 120 124 ! space interpolation 121 zpp_cfc = xphem(ji,jj) * zpatm(1,j n) &122 & + ( 1.- xphem(ji,jj) ) * zpatm(2,j n)125 zpp_cfc = xphem(ji,jj) * zpatm(1,jl) & 126 & + ( 1.- xphem(ji,jj) ) * zpatm(2,jl) 123 127 124 128 ! Computation of concentration at equilibrium : in picomol/l … … 126 130 IF( tmask(ji,jj,1) .GE. 0.5 ) THEN 127 131 ztap = ( tn(ji,jj,1) + 273.16 ) * 0.01 128 zdtap = ( sob3(jn) * ztap + sob2(jn) ) * ztap + sob1(jn)129 zsol = EXP( soa 1(jn) + soa2(jn) / ztap + soa3(jn) * LOG( ztap ) &130 & + soa4(jn) * ztap * ztap + sn(ji,jj,1) * zdtap )132 zdtap = sob(1,jl) + ztap * ( sob(2,jl) + ztap * sob(3,jl) ) 133 zsol = EXP( soa(1,jl) + soa(2,jl) / ztap + soa(3,jl) * LOG( ztap ) & 134 & + soa(4,jl) * ztap * ztap + sn(ji,jj,1) * zdtap ) 131 135 ELSE 132 136 zsol = 0.e0 … … 142 146 zt2 = zt1 * zt1 143 147 zt3 = zt1 * zt2 144 zsch = sca 1(jn) + sca2(jn) * zt1 + sca3(jn) * zt2 + sca4(jn) * zt3148 zsch = sca(1,jl) + sca(2,jl) * zt1 + sca(3,jl) * zt2 + sca(4,jl) * zt3 145 149 146 150 ! speed transfert : formulae of wanninkhof 1992 … … 151 155 ! Input function : speed *( conc. at equil - concen at surface ) 152 156 ! 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 ) &157 qtr_cfc(ji,jj,jl) = -zak_cfc * ( trb(ji,jj,1,jn) - zca_cfc ) & 154 158 #if defined key_off_degrad 155 & * facvol(ji,jj,1) &159 & * facvol(ji,jj,1) & 156 160 #endif 157 & * tmask(ji,jj,1) * ( 1. - fr_i(ji,jj) )161 & * tmask(ji,jj,1) * ( 1. - fr_i(ji,jj) ) 158 162 159 163 ! Add the surface flux to the trend 160 tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + qtr (ji,jj,jn) / fse3t(ji,jj,1)164 tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + qtr_cfc(ji,jj,jl) / fse3t(ji,jj,1) 161 165 162 166 ! cumulation of surface flux at each time step 163 qint(ji,jj,jn) = qint (ji,jj,jn) + qtr(ji,jj,jn) * rdt 167 qint_cfc(ji,jj,jl) = qint_cfc(ji,jj,jl) + qtr_cfc(ji,jj,jl) * rdt 168 169 # if defined key_trc_diaadd 170 ! Save diagnostics , just for CFC11 171 js = 1 172 trc2d(ji,jj,jp_cfc0_2d ) = qtr_cfc (ji,jj,js) 173 trc2d(ji,jj,jp_cfc0_2d + 1) = qint_cfc(ji,jj,js) 174 # endif 164 175 ! !----------------! 165 176 END DO ! end i-j loop ! … … 168 179 END DO ! end CFC loop ! 169 180 ! !----------------! 181 182 IF( l_trdtrc ) THEN 183 DO jn = jp_cfc0, jp_cfc1 184 ztrcfc(:,:,:) = tra(:,:,:,jn) 185 CALL trd_mod_trc( ztrcfc, jn, jptrc_trd_sms, kt ) ! save trends 186 END DO 187 END IF 188 170 189 END SUBROUTINE trc_sms_cfc 171 190 … … 177 196 !!--------------------------------------------------------------------- 178 197 179 ! coefficient for solubility of CFC11/CFC12 in mol/l/atm 180 181 soa1(jp11) = -229.9261 182 soa2(jp11) = 319.6552 183 soa3(jp11) = 119.4471 184 soa4(jp11) = -1.39165 185 sob1(jp11) = -0.142382 186 sob2(jp11) = 0.091459 187 sob3(jp11) = -0.0157274 188 189 soa1(jp12) = -218.0971 190 soa2(jp12) = 298.9702 191 soa3(jp12) = 113.8049 192 soa4(jp12) = -1.39165 193 sob1(jp12) = -0.143566 194 sob2(jp12) = 0.091015 195 sob3(jp12) = -0.0153924 196 197 198 ! coefficients for schmidt number in degre Celcius 199 sca1(jp11) = 3501.8 200 sca2(jp11) = -210.31 201 sca3(jp11) = 6.1851 202 sca4(jp11) = -0.07513 203 204 sca1(jp12) = 3845.4 205 sca2(jp12) = -228.95 206 sca3(jp12) = 6.1908 207 sca4(jp12) = -0.067430 198 199 ! coefficient for CFC11 200 !---------------------- 201 202 ! Solubility 203 soa(1,1) = -229.9261 204 soa(2,1) = 319.6552 205 soa(3,1) = 119.4471 206 soa(4,1) = -1.39165 207 208 sob(1,1) = -0.142382 209 sob(2,1) = 0.091459 210 sob(3,1) = -0.0157274 211 212 ! Schmidt number 213 sca(1,1) = 3501.8 214 sca(2,1) = -210.31 215 sca(3,1) = 6.1851 216 sca(4,1) = -0.07513 217 218 ! coefficient for CFC12 219 !---------------------- 220 221 ! Solubility 222 soa(1,2) = -218.0971 223 soa(2,2) = 298.9702 224 soa(3,2) = 113.8049 225 soa(4,2) = -1.39165 226 227 sob(1,2) = -0.143566 228 sob(2,2) = 0.091015 229 sob(3,2) = -0.0153924 230 231 ! schmidt number 232 sca(1,2) = 3845.4 233 sca(2,2) = -228.95 234 sca(3,2) = 6.1908 235 sca(4,2) = -0.067430 208 236 209 237 END SUBROUTINE trc_cfc_cst
Note: See TracChangeset
for help on using the changeset viewer.
