Changeset 2000 for branches/DEV_r1784_mid_year_merge_2010/NEMO/OPA_SRC/SBC
- Timestamp:
- 2010-07-09T13:27:11+02:00 (14 years ago)
- Location:
- branches/DEV_r1784_mid_year_merge_2010/NEMO/OPA_SRC/SBC
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/DEV_r1784_mid_year_merge_2010/NEMO/OPA_SRC/SBC/sbc_oce.F90
r1705 r2000 49 49 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: emp !: freshwater budget: volume flux [Kg/m2/s] 50 50 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: emps !: freshwater budget: concentration/dillution [Kg/m2/s] 51 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: rnf !: river runoff [Kg/m2/s] 51 52 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: emp_tot !: total evaporation - (liquid + solid) precpitation over oce and ice 52 53 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: tprecip !: total precipitation [Kg/m2/s] -
branches/DEV_r1784_mid_year_merge_2010/NEMO/OPA_SRC/SBC/sbcfwb.F90
r1976 r2000 32 32 REAL(wp) :: a_fwb_b ! annual domain averaged freshwater budget 33 33 REAL(wp) :: a_fwb ! for 2 year before (_b) and before year. 34 REAL(wp) :: empold ! empold to be suppressed34 REAL(wp) :: fwfold ! fwfold to be suppressed 35 35 REAL(wp) :: area ! global mean ocean surface (interior domain) 36 36 … … 66 66 INTEGER :: inum ! temporary logical unit 67 67 INTEGER :: ikty, iyear ! 68 REAL(wp) :: z_ emp, z_emp_nsrf ! temporary scalars68 REAL(wp) :: z_fwf, z_fwf_nsrf ! temporary scalars 69 69 REAL(wp) :: zsurf_neg, zsurf_pos, zsurf_tospread 70 70 REAL(wp), DIMENSION(jpi,jpj) :: ztmsk_neg, ztmsk_pos, ztmsk_tospread … … 80 80 IF( kn_fwb == 1 ) WRITE(numout,*) ' instantaneously set to zero' 81 81 IF( kn_fwb == 2 ) WRITE(numout,*) ' adjusted from previous year budget' 82 IF( kn_fwb == 3 ) WRITE(numout,*) ' empset to zero and spread out over erp area'82 IF( kn_fwb == 3 ) WRITE(numout,*) ' fwf set to zero and spread out over erp area' 83 83 ! 84 84 IF( kn_fwb == 3 .AND. nn_sssr /= 2 ) & … … 101 101 102 102 ! 103 CASE ( 1 ) ! global mean empset to zero103 CASE ( 1 ) ! global mean fwf set to zero 104 104 IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN 105 z_ emp = glob_sum( e1e2_i(:,:) * emp(:,:) ) / area ! sum over the global domain106 emp (:,:) = emp (:,:) - z_ emp107 emps(:,:) = emps(:,:) - z_ emp108 ENDIF 109 ! 110 CASE ( 2 ) ! empbudget adjusted from the previous year105 z_fwf = glob_sum( e1e2_i(:,:) * ( emp(:,:) - rnf(:,:) ) ) / area ! sum over the global domain 106 emp (:,:) = emp (:,:) - z_fwf 107 emps(:,:) = emps(:,:) - z_fwf 108 ENDIF 109 ! 110 CASE ( 2 ) ! fwf budget adjusted from the previous year 111 111 ! initialisation 112 112 IF( kt == nit000 ) THEN 113 ! Read the corrective factor on precipitations ( empold)113 ! Read the corrective factor on precipitations (fwfold) 114 114 CALL ctl_opn( inum, 'EMPave_old.dat', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 115 115 READ ( inum, "(24X,I8,2ES24.16)" ) iyear, a_fwb_b, a_fwb 116 116 CLOSE( inum ) 117 empold = a_fwb ! current year freshwater budget correction117 fwfold = a_fwb ! current year freshwater budget correction 118 118 ! ! estimate from the previous year budget 119 119 IF(lwp)WRITE(numout,*) 120 IF(lwp)WRITE(numout,*)'sbc_fwb : year = ',iyear , ' freshwater budget correction = ', empold120 IF(lwp)WRITE(numout,*)'sbc_fwb : year = ',iyear , ' freshwater budget correction = ', fwfold 121 121 IF(lwp)WRITE(numout,*)' year = ',iyear-1, ' freshwater budget read = ', a_fwb 122 122 IF(lwp)WRITE(numout,*)' year = ',iyear-2, ' freshwater budget read = ', a_fwb_b 123 123 ENDIF 124 124 ! 125 ! Update empold if new year start125 ! Update fwfold if new year start 126 126 ikty = 365 * 86400 / rdttra(1) !!bug use of 365 days leap year or 360d year !!!!!!! 127 127 IF( MOD( kt, ikty ) == 0 ) THEN … … 130 130 a_fwb = a_fwb * 1.e+3 / ( area * 86400. * 365. ) ! convert in Kg/m3/s = mm/s 131 131 !!gm ! !!bug 365d year 132 empold = a_fwb ! current year freshwater budget correction132 fwfold = a_fwb ! current year freshwater budget correction 133 133 ! ! estimate from the previous year budget 134 134 ENDIF … … 136 136 ! correct the freshwater fluxes 137 137 IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN 138 emp (:,:) = emp (:,:) + empold139 emps(:,:) = emps(:,:) + empold140 ENDIF 141 ! 142 ! save empold value in a file138 emp (:,:) = emp (:,:) + fwfold 139 emps(:,:) = emps(:,:) + fwfold 140 ENDIF 141 ! 142 ! save fwfold value in a file 143 143 IF( kt == nitend .AND. lwp ) THEN 144 144 CALL ctl_opn( inum, 'EMPave.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea ) … … 147 147 ENDIF 148 148 ! 149 CASE ( 3 ) ! global empset to zero and spread out over erp area149 CASE ( 3 ) ! global fwf set to zero and spread out over erp area 150 150 ! 151 151 IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN … … 159 159 zsurf_pos = SUM( e1e2_i(:,:)*ztmsk_pos(:,:) ) 160 160 161 ! empglobal mean162 z_ emp = glob_sum( e1e2_i(:,:) * emp(:,:) ) / area161 ! fwf global mean 162 z_fwf = glob_sum( e1e2_i(:,:) * ( emp(:,:) - rnf(:,:) ) ) / area 163 163 ! 164 164 165 IF( z_ emp< 0.e0 ) THEN165 IF( z_fwf < 0.e0 ) THEN 166 166 ! to spread out over >0 erp area to increase evaporation damping process 167 167 zsurf_tospread = zsurf_pos … … 173 173 ENDIF 174 174 175 ! empglobal mean over <0 or >0 erp area176 z_ emp_nsrf = SUM( e1e2_i(:,:) * z_emp) / ( zsurf_tospread + rsmall )175 ! fwf global mean over <0 or >0 erp area 176 z_fwf_nsrf = SUM( e1e2_i(:,:) * z_fwf ) / ( zsurf_tospread + rsmall ) 177 177 ! weight to respect erp field 2D structure 178 178 z_wgt(:,:) = ztmsk_tospread(:,:) * erp(:,:) / ( SUM( ztmsk_tospread(:,:) * erp(:,:) * e1e2_i(:,:) ) + rsmall ) 179 179 ! final correction term to apply 180 zerp_cor(:,:) = -1. * z_ emp_nsrf * zsurf_tospread * z_wgt(:,:)180 zerp_cor(:,:) = -1. * z_fwf_nsrf * zsurf_tospread * z_wgt(:,:) 181 181 182 182 CALL lbc_lnk( zerp_cor, 'T', 1. ) … … 187 187 188 188 IF( nprint == 1 .AND. lwp ) THEN 189 IF( z_ emp< 0.e0 ) THEN190 WRITE(numout,*)' z_ emp< 0'189 IF( z_fwf < 0.e0 ) THEN 190 WRITE(numout,*)' z_fwf < 0' 191 191 WRITE(numout,*)' SUM(erp+) = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2_i(:,:) )*1.e-3,' m3.s-1' 192 192 ELSE 193 WRITE(numout,*)' z_ emp>= 0'193 WRITE(numout,*)' z_fwf >= 0' 194 194 WRITE(numout,*)' SUM(erp-) = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2_i(:,:) )*1.e-3,' m3.s-1' 195 195 ENDIF 196 WRITE(numout,*)' SUM(empG) = ', SUM( z_ emp*e1e2_i(:,:) )*1.e-3,' m3.s-1'197 WRITE(numout,*)' z_ emp = ', z_emp,' mm.s-1'198 WRITE(numout,*)' z_ emp_nsrf = ', z_emp_nsrf ,' mm.s-1'196 WRITE(numout,*)' SUM(empG) = ', SUM( z_fwf*e1e2_i(:,:) )*1.e-3,' m3.s-1' 197 WRITE(numout,*)' z_fwf = ', z_fwf ,' mm.s-1' 198 WRITE(numout,*)' z_fwf_nsrf = ', z_fwf_nsrf ,' mm.s-1' 199 199 WRITE(numout,*)' MIN(zerp_cor) = ', MINVAL(zerp_cor) 200 200 WRITE(numout,*)' MAX(zerp_cor) = ', MAXVAL(zerp_cor) -
branches/DEV_r1784_mid_year_merge_2010/NEMO/OPA_SRC/SBC/sbcmod.F90
r1953 r2000 237 237 ! 238 238 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN 239 CALL iom_put( "emp " , emp ) ! upward water flux240 CALL iom_put( "emps " , emps ) ! c/d water flux241 CALL iom_put( "qns+qsr" , qns + qsr )! total heat flux (caution if ln_dm2dc=true, to be242 CALL iom_put( "qns" , qns )! solar heat flux moved after the call to iom_setkt)243 CALL iom_put( "qsr" , qsr )! solar heat flux moved after the call to iom_setkt)239 CALL iom_put( "emp-rnf" , (emp-rnf) ) ! upward water flux 240 CALL iom_put( "emps-rnf" , (emps-rnf) ) ! c/d water flux 241 CALL iom_put( "qns+qsr" , qns + qsr ) ! total heat flux (caution if ln_dm2dc=true, to be 242 CALL iom_put( "qns" , qns ) ! solar heat flux moved after the call to iom_setkt) 243 CALL iom_put( "qsr" , qsr ) ! solar heat flux moved after the call to iom_setkt) 244 244 IF( nn_ice > 0 ) CALL iom_put( "ice_cover", fr_i ) ! ice fraction 245 245 ENDIF … … 254 254 IF(ln_ctl) THEN ! print mean trends (used for debugging) 255 255 CALL prt_ctl(tab2d_1=fr_i , clinfo1=' fr_i - : ', mask1=tmask, ovlap=1 ) 256 CALL prt_ctl(tab2d_1= emp , clinfo1=' emp - : ', mask1=tmask, ovlap=1 )257 CALL prt_ctl(tab2d_1= emps , clinfo1=' emps - : ', mask1=tmask, ovlap=1 )256 CALL prt_ctl(tab2d_1=(emp-rnf) , clinfo1=' emp-rnf - : ', mask1=tmask, ovlap=1 ) 257 CALL prt_ctl(tab2d_1=(emps-rnf), clinfo1=' emps-rnf - : ', mask1=tmask, ovlap=1 ) 258 258 CALL prt_ctl(tab2d_1=qns , clinfo1=' qns - : ', mask1=tmask, ovlap=1 ) 259 259 CALL prt_ctl(tab2d_1=qsr , clinfo1=' qsr - : ', mask1=tmask, ovlap=1 ) -
branches/DEV_r1784_mid_year_merge_2010/NEMO/OPA_SRC/SBC/sbcrnf.F90
r1951 r2000 32 32 TYPE(FLD_N) , PUBLIC :: sn_rnf !: information about the runoff file to be read 33 33 TYPE(FLD_N) , PUBLIC :: sn_cnf !: information about the runoff mouth file to be read 34 TYPE(FLD_N) :: sn_sal_rnf !: information about the salinities of runoff file to be read 35 TYPE(FLD_N) :: sn_tmp_rnf !: information about the temperatures of runoff file to be read 36 TYPE(FLD_N) :: sn_dep_rnf !: information about the depth which river inflow affects 34 37 LOGICAL , PUBLIC :: ln_rnf_mouth = .false. !: specific treatment in mouths vicinity 35 38 REAL(wp) , PUBLIC :: rn_hrnf = 0.e0 !: runoffs, depth over which enhanced vertical mixing is used 36 39 REAL(wp) , PUBLIC :: rn_avt_rnf = 0.e0 !: runoffs, value of the additional vertical mixing coef. [m2/s] 40 LOGICAL , PUBLIC :: ln_rnf_att = .false. !: river runoffs attributes (temp, sal & depth) are specified in a file 37 41 REAL(wp) , PUBLIC :: rn_rfact = 1.e0 !: multiplicative factor for runoff 38 42 … … 41 45 REAL(wp), PUBLIC, DIMENSION(jpk) :: rnfmsk_z !: river mouth mask (vert.) 42 46 43 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_rnf ! structure of input SST (file information, fields read) 47 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_rnf !: structure of input river runoff (file information, fields read) 48 49 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_sal_rnf !: structure of input river runoff salinity (file information, fields read) 50 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_tmp_rnf !: structure of input river runoff temperature (file information, fields read) 51 52 REAL, PUBLIC, DIMENSION(jpi,jpj) :: rnf_dep !: depth of runoff in m 53 INTEGER, PUBLIC, DIMENSION(jpi,jpj) :: rnf_mod_dep !: depth of runoff in model levels 54 REAL, PUBLIC, DIMENSION(jpi,jpj) :: rnf_sal !: salinity of river runoff 55 REAL, PUBLIC, DIMENSION(jpi,jpj) :: rnf_tmp !: temperature of river runoff 56 57 INTEGER :: ji, jj ,jk ! dummy loop indices 58 INTEGER :: inum ! temporary logical unit 59 60 !! * Substitutions 61 # include "domzgr_substitute.h90" 44 62 45 63 !!---------------------------------------------------------------------- … … 70 88 ! 71 89 IF( kt == nit000 ) THEN 72 IF( .NOT. ln_rnf_emp ) THEN 73 ALLOCATE( sf_rnf(1), STAT=ierror ) 74 IF( ierror > 0 ) THEN 75 CALL ctl_stop( 'sbc_rnf: unable to allocate sf_rnf structure' ) ; RETURN 76 ENDIF 77 ALLOCATE( sf_rnf(1)%fnow(jpi,jpj,1 ) ) 78 ALLOCATE( sf_rnf(1)%fdta(jpi,jpj,1,2) ) 79 ENDIF 80 CALL sbc_rnf_init(sf_rnf) 90 CALL sbc_rnf_init ! Read namelist and allocate structures 81 91 ENDIF 82 92 … … 87 97 CALL fld_read( kt, nn_fsbc, sf_rnf ) ! Read Runoffs data and provides it 88 98 ! ! at the current time-step 99 IF ( ln_rnf_att ) THEN 100 CALL fld_read ( kt, nn_fsbc, sf_sal_rnf ) 101 CALL fld_read ( kt, nn_fsbc, sf_tmp_rnf ) 102 ENDIF 89 103 90 104 ! Runoff reduction only associated to the ORCA2_LIM configuration … … 101 115 102 116 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN 103 emp (:,:) = emp (:,:) - rn_rfact * ABS( sf_rnf(1)%fnow(:,:,1) ) 104 emps(:,:) = emps(:,:) - rn_rfact * ABS( sf_rnf(1)%fnow(:,:,1) ) 105 CALL iom_put( "runoffs", sf_rnf(1)%fnow ) ! runoffs 117 rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:) ) 118 IF ( ln_rnf_att ) THEN 119 rnf_sal(:,:) = ( sf_sal_rnf(1)%fnow(:,:) ) 120 rnf_tmp(:,:) = ( sf_tmp_rnf(1)%fnow(:,:) ) 121 ELSE 122 rnf_sal(:,:) = 0 123 rnf_tmp(:,:) = -999 124 ENDIF 125 CALL iom_put( "runoffs", rnf ) ! runoffs 106 126 ENDIF 107 127 ! … … 111 131 112 132 113 SUBROUTINE sbc_rnf_init ( sf_rnf )133 SUBROUTINE sbc_rnf_init 114 134 !!---------------------------------------------------------------------- 115 135 !! *** ROUTINE sbc_rnf_init *** … … 121 141 !! ** Action : - read parameters 122 142 !!---------------------------------------------------------------------- 123 TYPE(FLD), INTENT(inout), DIMENSION(:) :: sf_rnf ! input data124 !! 125 NAMELIST/namsbc_rnf/ cn_dir, ln_rnf_emp, sn_rnf, sn_cnf, ln_rnf_mouth, &126 & rn_hrnf, rn_avt_rnf, rn_rfact143 CHARACTER(len=32) :: rn_dep_file ! runoff file name 144 !! 145 NAMELIST/namsbc_rnf/ cn_dir, ln_rnf_emp, sn_rnf, sn_cnf, sn_sal_rnf, sn_tmp_rnf, sn_dep_rnf, & 146 & ln_rnf_mouth, ln_rnf_att, rn_hrnf, rn_avt_rnf, rn_rfact 127 147 !!---------------------------------------------------------------------- 128 148 … … 136 156 sn_cnf = FLD_N( 'runoffs', 0 , 'sorunoff' , .FALSE. , .true. , 'yearly' , '' , '' ) 137 157 158 sn_sal_rnf = FLD_N( 'runoffs', 24. , 'rosaline' , .TRUE. , .true. , 'yearly' , '' , '' ) 159 sn_tmp_rnf = FLD_N( 'runoffs', 24. , 'rotemper' , .TRUE. , .true. , 'yearly' , '' , '' ) 160 sn_dep_rnf = FLD_N( 'runoffs', 0. , 'rodepth' , .FALSE. , .true. , 'yearly' , '' , '' ) 138 161 ! 139 162 REWIND ( numnam ) ! Read Namelist namsbc_rnf … … 160 183 IF(lwp) WRITE(numout,*) 161 184 IF(lwp) WRITE(numout,*) ' runoffs directly provided in the precipitations' 185 IF ( ln_rnf_att ) THEN 186 CALL ctl_warn( 'runoffs already included in precipitations & so runoff attributes will not be used' ) 187 ln_rnf_att = .FALSE. 188 ENDIF 162 189 ! 163 190 ELSE ! runoffs read in a file : set sf_rnf structure 164 191 ! 165 ! sf_rnf already allocated in main routine 192 ! Allocate sf_rnf structure and (if required) sf_sal_rnf and sf_tmp_rnf structures 193 ALLOCATE( sf_rnf(1), STAT=ierror ) 194 IF( ierror > 0 ) THEN 195 CALL ctl_stop( 'sbc_rnf: unable to allocate sf_rnf structure' ) ; RETURN 196 ENDIF 197 ALLOCATE( sf_rnf(1)%fnow(jpi,jpj) ) 198 ALLOCATE( sf_rnf(1)%fdta(jpi,jpj,2) ) 199 200 IF( ln_rnf_att ) THEN 201 ALLOCATE( sf_sal_rnf(1), STAT=ierror ) 202 IF( ierror > 0 ) THEN 203 CALL ctl_stop( 'sbc_sal_rnf: unable to allocate sf_sal_rnf structure' ) ; RETURN 204 ENDIF 205 ALLOCATE( sf_sal_rnf(1)%fnow(jpi,jpj) ) 206 ALLOCATE( sf_sal_rnf(1)%fdta(jpi,jpj,2) ) 207 208 ALLOCATE( sf_tmp_rnf(1), STAT=ierror ) 209 IF( ierror > 0 ) THEN 210 CALL ctl_stop( 'sbc_tmp_rnf: unable to allocate sf_tmp_rnf structure' ) ; RETURN 211 ENDIF 212 ALLOCATE( sf_tmp_rnf(1)%fnow(jpi,jpj) ) 213 ALLOCATE( sf_tmp_rnf(1)%fdta(jpi,jpj,2) ) 214 ENDIF 166 215 ! fill sf_rnf with sn_rnf and control print 167 216 CALL fld_fill( sf_rnf, (/ sn_rnf /), cn_dir, 'sbc_rnf_init', 'read runoffs data', 'namsbc_rnf' ) 168 ! 217 218 IF ( ln_rnf_att ) THEN 219 CALL fld_fill (sf_sal_rnf, (/ sn_sal_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff salinity data', 'namsbc_rnf' ) 220 CALL fld_fill (sf_tmp_rnf, (/ sn_tmp_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff temperature data', 'namsbc_rnf' ) 221 222 rn_dep_file = TRIM( cn_dir )//TRIM( sn_dep_rnf%clname ) 223 CALL iom_open ( rn_dep_file, inum ) ! open file 224 CALL iom_get ( inum, jpdom_data, sn_dep_rnf%clvar, rnf_dep ) ! read the river mouth array 225 CALL iom_close( inum ) ! close file 226 227 rnf_mod_dep(:,:)=0 228 DO jj=1,jpj 229 DO ji=1,jpi 230 IF ( rnf_dep(ji,jj) > 0.e0 ) THEN 231 jk=2 232 DO WHILE ( jk/=jpkm1 .AND. fsdept(ji,jj,jk) < rnf_dep(ji,jj) ); jk=jk+1; ENDDO 233 rnf_mod_dep(ji,jj)=jk 234 ELSE IF ( rnf_dep(ji,jj) .eq. -1 ) THEN 235 rnf_mod_dep(ji,jj)=1 236 ELSE IF ( rnf_dep(ji,jj) .eq. -999 ) THEN 237 rnf_mod_dep(ji,jj)=jpkm1 238 ELSE IF ( rnf_dep(ji,jj) /= 0 ) THEN 239 CALL ctl_stop( 'runoff depth not positive, and not -999 or -1, rnf value in file fort.999' ) 240 WRITE(999,*) 'ji, jj, rnf(ji,jj) :', ji, jj, rnf(ji,jj) 241 ENDIF 242 ENDDO 243 ENDDO 244 ELSE 245 rnf_mod_dep(:,:)=1 246 ENDIF 247 ! 169 248 ENDIF 170 249 … … 179 258 ! 180 259 ! ! Number of level over which Kz increase 260 IF ( ln_rnf_att ) & 261 & CALL ctl_warn( 'increased mixing turned on but effects may already be spread through depth by ln_rnf_att' ) 181 262 nkrnf = 0 182 263 IF( rn_hrnf > 0.e0 ) THEN
Note: See TracChangeset
for help on using the changeset viewer.