Changeset 1951 for branches/DEV_r1784_mid_year_merge_2010/NEMO/OPA_SRC/SBC
- Timestamp:
- 2010-06-24T17:00:16+02:00 (14 years ago)
- Location:
- branches/DEV_r1784_mid_year_merge_2010/NEMO/OPA_SRC/SBC
- Files:
-
- 7 edited
-
fldread.F90 (modified) (12 diffs)
-
sbcblk_clio.F90 (modified) (23 diffs)
-
sbcblk_core.F90 (modified) (14 diffs)
-
sbcflx.F90 (modified) (2 diffs)
-
sbcice_if.F90 (modified) (2 diffs)
-
sbcrnf.F90 (modified) (3 diffs)
-
sbcssr.F90 (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/DEV_r1784_mid_year_merge_2010/NEMO/OPA_SRC/SBC/fldread.F90
r1730 r1951 48 48 INTEGER , DIMENSION(2) :: nrec_b ! before record (1: index, 2: second since Jan. 1st 00h of nit000 year) 49 49 INTEGER , DIMENSION(2) :: nrec_a ! after record (1: index, 2: second since Jan. 1st 00h of nit000 year) 50 REAL(wp) , ALLOCATABLE, DIMENSION(:,: ) :: fnow! input fields interpolated to now time step51 REAL(wp) , ALLOCATABLE, DIMENSION(:,:,: ) :: fdta! 2 consecutive record of input fields50 REAL(wp) , ALLOCATABLE, DIMENSION(:,:,: ) :: fnow ! input fields interpolated to now time step 51 REAL(wp) , ALLOCATABLE, DIMENSION(:,:,:,:) :: fdta ! 2 consecutive record of input fields 52 52 CHARACTER(len = 256) :: wgtname ! current name of the NetCDF weight file acting as a key 53 53 ! into the WGTLIST structure … … 120 120 121 121 INTEGER :: jf ! dummy indices 122 INTEGER :: jk ! dummy indices 123 INTEGER :: ipk ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk ) 122 124 INTEGER :: kw ! index into wgts array 123 125 INTEGER :: ireclast ! last record to be read in the current year file … … 143 145 IF( sd(jf)%ln_tint ) THEN ! time interpolation: swap before record field 144 146 !CDIR COLLAPSE 145 sd(jf)%fdta(:,:, 1) = sd(jf)%fdta(:,:,2)146 sd(jf)%rotn(1) = sd(jf)%rotn(2)147 sd(jf)%fdta(:,:,:,1) = sd(jf)%fdta(:,:,:,2) 148 sd(jf)%rotn(1) = sd(jf)%rotn(2) 147 149 ENDIF 148 150 … … 202 204 203 205 ! read after data 206 ipk = SIZE( sd(jf)%fdta, 3 ) 204 207 IF( LEN(TRIM(sd(jf)%wgtname)) > 0 ) THEN 205 208 CALL wgt_list( sd(jf), kw ) 206 CALL fld_interp( sd(jf)%num, sd(jf)%clvar, kw, sd(jf)%fdta(:,:,2), sd(jf)%nrec_a(1) ) 209 DO jk = 1, ipk 210 CALL fld_interp( sd(jf)%num, sd(jf)%clvar, kw, sd(jf)%fdta(:,:,jk,2), sd(jf)%nrec_a(1) ) 211 END DO 207 212 ELSE 208 CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,2), sd(jf)%nrec_a(1) ) 213 IF( ipk == 1 ) THEN 214 CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,1,2), sd(jf)%nrec_a(1) ) 215 ELSE 216 CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,:,2), sd(jf)%nrec_a(1) ) 217 ENDIF 209 218 ENDIF 210 219 sd(jf)%rotn(2) = .FALSE. … … 245 254 utmp(:,:) = 0.0 246 255 vtmp(:,:) = 0.0 247 CALL rot_rep( sd(jf)%fdta(:,:,nf), sd(kf)%fdta(:,:,nf), 'T', 'en->i', utmp(:,:) ) 248 CALL rot_rep( sd(jf)%fdta(:,:,nf), sd(kf)%fdta(:,:,nf), 'T', 'en->j', vtmp(:,:) ) 249 sd(jf)%fdta(:,:,nf) = utmp(:,:) 250 sd(kf)%fdta(:,:,nf) = vtmp(:,:) 256 ! 257 DO jk = 1, SIZE( sd(kf)%fdta, 3 ) 258 CALL rot_rep( sd(jf)%fdta(:,:,jk,nf),sd(kf)%fdta(:,:,jk,nf),'T', 'en->i', utmp(:,:) ) 259 CALL rot_rep( sd(jf)%fdta(:,:,jk,nf),sd(kf)%fdta(:,:,jk,nf),'T', 'en->j', vtmp(:,:) ) 260 sd(jf)%fdta(:,:,jk,nf) = utmp(:,:) 261 sd(kf)%fdta(:,:,jk,nf) = vtmp(:,:) 262 END DO 263 ! 251 264 sd(jf)%rotn(nf) = .TRUE. 252 265 sd(kf)%rotn(nf) = .TRUE. … … 280 293 ztintb = 1. - ztinta 281 294 !CDIR COLLAPSE 282 sd(jf)%fnow(:,: ) = ztintb * sd(jf)%fdta(:,:,1) + ztinta * sd(jf)%fdta(:,:,2)295 sd(jf)%fnow(:,:,:) = ztintb * sd(jf)%fdta(:,:,:,1) + ztinta * sd(jf)%fdta(:,:,:,2) 283 296 ELSE 284 297 IF(lwp .AND. kt - nit000 <= 100 ) THEN … … 288 301 ENDIF 289 302 !CDIR COLLAPSE 290 sd(jf)%fnow(:,: ) = sd(jf)%fdta(:,:,2) ! piecewise constant field303 sd(jf)%fnow(:,:,:) = sd(jf)%fdta(:,:,:,2) ! piecewise constant field 291 304 292 305 ENDIF … … 320 333 INTEGER :: inrec ! number of record existing for this variable 321 334 INTEGER :: kwgt 335 INTEGER :: jk ! vertical loop variable 336 INTEGER :: ipk ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk ) 322 337 CHARACTER(LEN=1000) :: clfmt ! write format 323 338 !!--------------------------------------------------------------------- … … 339 354 IF( sdjf%cltype == 'monthly' ) THEN ! monthly file 340 355 sdjf%nrec_b(1) = 1 ! force to read the unique record 341 llprevmth = . NOT. sdjf%ln_clim! use previous month file?356 llprevmth = .TRUE. ! use previous month file? 342 357 llprevyr = llprevmth .AND. nmonth == 1 ! use previous year file? 343 358 ELSE ! yearly file … … 384 399 385 400 ! read before data into sdjf%fdta(:,:,2) because we will swap data in the following part of fld_read 401 ipk = SIZE( sdjf%fdta, 3 ) 386 402 IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN 387 403 CALL wgt_list( sdjf, kwgt ) 388 CALL fld_interp( sdjf%num, sdjf%clvar, kwgt, sdjf%fdta(:,:,2), sdjf%nrec_b(1) ) 404 DO jk = 1, ipk 405 CALL fld_interp( sdjf%num, sdjf%clvar, kwgt, sdjf%fdta(:,:,jk,2), sdjf%nrec_b(1) ) 406 END DO 389 407 ELSE 390 CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,2), sdjf%nrec_b(1) ) 408 IF( ipk == 1 ) THEN 409 CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,1,2), sdjf%nrec_b(1) ) 410 ELSE 411 CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_b(1) ) 412 ENDIF 391 413 ENDIF 392 414 sdjf%rotn(2) = .FALSE. … … 534 556 IF( sdjf%cltype /= 'yearly' ) WRITE(sdjf%clname, '(a,"m" ,i2.2)' ) TRIM( sdjf%clname ), kmonth ! add month 535 557 IF( sdjf%cltype == 'daily' ) WRITE(sdjf%clname, '(a,"d" ,i2.2)' ) TRIM( sdjf%clname ), kday ! add day 558 ELSE 559 ! build the new filename if climatological data 560 IF( sdjf%cltype == 'monthly' ) WRITE(sdjf%clname, '(a,"_m",i2.2)' ) TRIM( sdjf%clrootname ), kmonth ! add month 536 561 ENDIF 537 562 CALL iom_open( sdjf%clname, sdjf%num, ldstop = ldstop, ldiof = LEN(TRIM(sdjf%wgtname)) > 0 ) … … 564 589 sdf(jf)%ln_tint = sdf_n(jf)%ln_tint 565 590 sdf(jf)%ln_clim = sdf_n(jf)%ln_clim 566 IF( sdf(jf)%nfreqh == -1. ) THEN ; sdf(jf)%cltype = 'yearly' 567 ELSE ; sdf(jf)%cltype = sdf_n(jf)%cltype 568 ENDIF 591 sdf(jf)%cltype = sdf_n(jf)%cltype 569 592 sdf(jf)%wgtname = " " 570 593 IF( LEN( TRIM(sdf_n(jf)%wname) ) > 0 ) sdf(jf)%wgtname = TRIM( cdir )//TRIM( sdf_n(jf)%wname ) -
branches/DEV_r1784_mid_year_merge_2010/NEMO/OPA_SRC/SBC/sbcblk_clio.F90
r1732 r1951 162 162 163 163 DO ifpr= 1, jpfld 164 ALLOCATE( sf(ifpr)%fnow(jpi,jpj ) )165 ALLOCATE( sf(ifpr)%fdta(jpi,jpj, 2) )164 ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1 ) ) 165 ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) ) 166 166 END DO 167 167 … … 178 178 ! 179 179 #if defined key_lim3 180 tatm_ice(:,:) = sf(jp_tair)%fnow(:,: ) !RB ugly patch180 tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1) !RB ugly patch 181 181 #endif 182 182 ! … … 272 272 DO jj = 1 , jpj 273 273 DO ji = 1, jpi 274 utau(ji,jj) = sf(jp_utau)%fnow(ji,jj )275 vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj )274 utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) 275 vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) 276 276 END DO 277 277 END DO … … 297 297 DO jj = 1 , jpj 298 298 DO ji = 1, jpi 299 wndm(ji,jj) = sf(jp_wndm)%fnow(ji,jj )299 wndm(ji,jj) = sf(jp_wndm)%fnow(ji,jj,1) 300 300 END DO 301 301 END DO … … 317 317 ! 318 318 zsst = pst(ji,jj) + rt0 ! converte Celcius to Kelvin the SST 319 ztatm = sf(jp_tair)%fnow(ji,jj )! and set minimum value far above 0 K (=rt0 over land)320 zcco1 = 1.0 - sf(jp_ccov)%fnow(ji,jj )! fraction of clear sky ( 1 - cloud cover)319 ztatm = sf(jp_tair)%fnow(ji,jj,1) ! and set minimum value far above 0 K (=rt0 over land) 320 zcco1 = 1.0 - sf(jp_ccov)%fnow(ji,jj,1) ! fraction of clear sky ( 1 - cloud cover) 321 321 zrhoa = zpatm / ( 287.04 * ztatm ) ! air density (equation of state for dry air) 322 322 ztamr = ztatm - rtt ! Saturation water vapour … … 325 325 zmt3 = SIGN( 28.200, -ztamr ) ! \/ 326 326 zes = 611.0 * EXP( ABS( ztamr ) * MIN ( zmt1, zmt2 ) / ( ztatm - 35.86 + MAX( 0.e0, zmt3 ) ) ) 327 zev = sf(jp_humi)%fnow(ji,jj ) * zes! vapour pressure327 zev = sf(jp_humi)%fnow(ji,jj,1) * zes ! vapour pressure 328 328 zevsqr = SQRT( zev * 0.01 ) ! square-root of vapour pressure 329 329 zqatm = 0.622 * zev / ( zpatm - 0.378 * zev ) ! specific humidity … … 333 333 !--------------------------------------! 334 334 ztatm3 = ztatm * ztatm * ztatm 335 zcldeff = 1.0 - sbudyko(ji,jj) * sf(jp_ccov)%fnow(ji,jj ) * sf(jp_ccov)%fnow(ji,jj)335 zcldeff = 1.0 - sbudyko(ji,jj) * sf(jp_ccov)%fnow(ji,jj,1) * sf(jp_ccov)%fnow(ji,jj,1) 336 336 ztaevbk = ztatm * ztatm3 * zcldeff * ( 0.39 - 0.05 * zevsqr ) 337 337 ! … … 351 351 zdeltaq = zqatm - zqsato 352 352 ztvmoy = ztatm * ( 1. + 2.2e-3 * ztatm * zqatm ) 353 zdenum = MAX( sf(jp_wndm)%fnow(ji,jj ) * sf(jp_wndm)%fnow(ji,jj) * ztvmoy, zeps )353 zdenum = MAX( sf(jp_wndm)%fnow(ji,jj,1) * sf(jp_wndm)%fnow(ji,jj,1) * ztvmoy, zeps ) 354 354 zdtetar = zdteta / zdenum 355 355 ztvmoyr = ztvmoy * ztvmoy * zdeltaq / zdenum … … 373 373 zpsil = zpsih 374 374 375 zvatmg = MAX( 0.032 * 1.5e-3 * sf(jp_wndm)%fnow(ji,jj ) * sf(jp_wndm)%fnow(ji,jj) / grav, zeps )375 zvatmg = MAX( 0.032 * 1.5e-3 * sf(jp_wndm)%fnow(ji,jj,1) * sf(jp_wndm)%fnow(ji,jj,1) / grav, zeps ) 376 376 zcmn = vkarmn / LOG ( 10. / zvatmg ) 377 377 zchn = 0.0327 * zcmn … … 387 387 zcleo = zcln * zclcm 388 388 389 zrhova = zrhoa * sf(jp_wndm)%fnow(ji,jj )389 zrhova = zrhoa * sf(jp_wndm)%fnow(ji,jj,1) 390 390 391 391 ! sensible heat flux … … 408 408 DO ji = 1, jpi 409 409 qns (ji,jj) = zqlw(ji,jj) - zqsb(ji,jj) - zqla(ji,jj) ! Downward Non Solar flux 410 emp (ji,jj) = zqla(ji,jj) / cevap - sf(jp_prec)%fnow(ji,jj ) / rday * tmask(ji,jj,1)410 emp (ji,jj) = zqla(ji,jj) / cevap - sf(jp_prec)%fnow(ji,jj,1) / rday * tmask(ji,jj,1) 411 411 END DO 412 412 END DO … … 530 530 !CDIR NOVERRCHK 531 531 DO ji = 1, jpi 532 ztatm (ji,jj) = sf(jp_tair)%fnow(ji,jj )! air temperature in Kelvins532 ztatm (ji,jj) = sf(jp_tair)%fnow(ji,jj,1) ! air temperature in Kelvins 533 533 534 534 zrhoa(ji,jj) = zpatm / ( 287.04 * ztatm(ji,jj) ) ! air density (equation of state for dry air) … … 541 541 & / ( ztatm(ji,jj) - 35.86 + MAX( 0.e0, zmt3 ) ) ) 542 542 543 zev = sf(jp_humi)%fnow(ji,jj ) * zes! vapour pressure543 zev = sf(jp_humi)%fnow(ji,jj,1) * zes ! vapour pressure 544 544 zevsqr(ji,jj) = SQRT( zev * 0.01 ) ! square-root of vapour pressure 545 545 zqatm(ji,jj) = 0.622 * zev / ( zpatm - 0.378 * zev ) ! specific humidity … … 551 551 zmt2 = ( 272.0 - ztatm(ji,jj) ) / 38.0 ; zind2 = MAX( 0.e0, SIGN( 1.e0, zmt2 ) ) 552 552 zmt3 = ( 281.0 - ztatm(ji,jj) ) / 18.0 ; zind3 = MAX( 0.e0, SIGN( 1.e0, zmt3 ) ) 553 p_spr(ji,jj) = sf(jp_prec)%fnow(ji,jj ) / rday &! rday = converte mm/day to kg/m2/s553 p_spr(ji,jj) = sf(jp_prec)%fnow(ji,jj,1) / rday & ! rday = converte mm/day to kg/m2/s 554 554 & * ( zind1 & ! solid (snow) precipitation [kg/m2/s] 555 555 & + ( 1.0 - zind1 ) * ( zind2 * ( 0.5 + zmt2 ) & … … 561 561 ! fraction of qsr_ice which is NOT absorbed in the thin surface layer 562 562 ! and thus which penetrates inside the ice cover ( Maykut and Untersteiner, 1971 ; Elbert anbd Curry, 1993 ) 563 p_fr1(ji,jj) = 0.18 * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj ) ) + 0.35 * sf(jp_ccov)%fnow(ji,jj)564 p_fr2(ji,jj) = 0.82 * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj ) ) + 0.65 * sf(jp_ccov)%fnow(ji,jj)563 p_fr1(ji,jj) = 0.18 * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.35 * sf(jp_ccov)%fnow(ji,jj,1) 564 p_fr2(ji,jj) = 0.82 * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.65 * sf(jp_ccov)%fnow(ji,jj,1) 565 565 END DO 566 566 END DO … … 584 584 !-------------------------------------------! 585 585 ztatm3 = ztatm(ji,jj) * ztatm(ji,jj) * ztatm(ji,jj) 586 zcldeff = 1.0 - sbudyko(ji,jj) * sf(jp_ccov)%fnow(ji,jj ) * sf(jp_ccov)%fnow(ji,jj)586 zcldeff = 1.0 - sbudyko(ji,jj) * sf(jp_ccov)%fnow(ji,jj,1) * sf(jp_ccov)%fnow(ji,jj,1) 587 587 ztaevbk = ztatm3 * ztatm(ji,jj) * zcldeff * ( 0.39 - 0.05 * zevsqr(ji,jj) ) 588 588 ! … … 609 609 610 610 ! sensible and latent fluxes over ice 611 zrhova = zrhoa(ji,jj) * sf(jp_wndm)%fnow(ji,jj ) ! computation of intermediate values611 zrhova = zrhoa(ji,jj) * sf(jp_wndm)%fnow(ji,jj,1) ! computation of intermediate values 612 612 zrhovaclei = zrhova * zcshi * 2.834e+06 613 613 zrhovacshi = zrhova * zclei * 1004.0 … … 639 639 p_qns(:,:,:) = z_qlw (:,:,:) - z_qsb (:,:,:) - p_qla (:,:,:) ! Downward Non Solar flux 640 640 !CDIR COLLAPSE 641 p_tpr(:,:) = sf(jp_prec)%fnow(:,: ) / rday! total precipitation [kg/m2/s]641 p_tpr(:,:) = sf(jp_prec)%fnow(:,:,1) / rday ! total precipitation [kg/m2/s] 642 642 ! 643 643 !!gm : not necessary as all input data are lbc_lnk... … … 735 735 !CDIR NOVERRCHK 736 736 DO ji = 1, jpi 737 ztamr = sf(jp_tair)%fnow(ji,jj ) - rtt737 ztamr = sf(jp_tair)%fnow(ji,jj,1) - rtt 738 738 zmt1 = SIGN( 17.269, ztamr ) 739 739 zmt2 = SIGN( 21.875, ztamr ) 740 740 zmt3 = SIGN( 28.200, -ztamr ) 741 741 zes = 611.0 * EXP( ABS( ztamr ) * MIN ( zmt1, zmt2 ) & ! Saturation water vapour 742 & / ( sf(jp_tair)%fnow(ji,jj ) - 35.86 + MAX( 0.e0, zmt3 ) ) )743 zev(ji,jj) = sf(jp_humi)%fnow(ji,jj ) * zes * 1.0e-05! vapour pressure742 & / ( sf(jp_tair)%fnow(ji,jj,1) - 35.86 + MAX( 0.e0, zmt3 ) ) ) 743 zev(ji,jj) = sf(jp_humi)%fnow(ji,jj,1) * zes * 1.0e-05 ! vapour pressure 744 744 END DO 745 745 END DO … … 798 798 799 799 ! ocean albedo depending on the cloud cover (Payne, 1972) 800 za_oce = ( 1.0 - sf(jp_ccov)%fnow(ji,jj ) ) * 0.05 / ( 1.1 * zcmue**1.4 + 0.15 ) & ! clear sky801 & + sf(jp_ccov)%fnow(ji,jj ) * 0.06 ! overcast800 za_oce = ( 1.0 - sf(jp_ccov)%fnow(ji,jj,1) ) * 0.05 / ( 1.1 * zcmue**1.4 + 0.15 ) & ! clear sky 801 & + sf(jp_ccov)%fnow(ji,jj,1) * 0.06 ! overcast 802 802 803 803 ! solar heat flux absorbed by the ocean (Zillman, 1972) … … 814 814 DO ji = 1, jpi 815 815 zlmunoon = ASIN( zps(ji,jj) + zpc(ji,jj) ) / rad ! local noon solar altitude 816 zcldcor = MIN( 1.e0, ( 1.e0 - 0.62 * sf(jp_ccov)%fnow(ji,jj ) &! cloud correction (Reed 1977)816 zcldcor = MIN( 1.e0, ( 1.e0 - 0.62 * sf(jp_ccov)%fnow(ji,jj,1) & ! cloud correction (Reed 1977) 817 817 & + 0.0019 * zlmunoon ) ) 818 pqsr_oce(ji,jj) = zcoef1 * zcldcor * pqsr_oce(ji,jj) * tmask(ji,jj,1) ! and zcoef1: ellipsity818 pqsr_oce(ji,jj) = zcoef1 * zcldcor * pqsr_oce(ji,jj) * tmask(ji,jj,1) ! and zcoef1: ellipsity 819 819 END DO 820 820 END DO … … 865 865 !CDIR NOVERRCHK 866 866 DO ji = 1, jpi 867 ztamr = sf(jp_tair)%fnow(ji,jj ) - rtt867 ztamr = sf(jp_tair)%fnow(ji,jj,1) - rtt 868 868 zmt1 = SIGN( 17.269, ztamr ) 869 869 zmt2 = SIGN( 21.875, ztamr ) 870 870 zmt3 = SIGN( 28.200, -ztamr ) 871 871 zes = 611.0 * EXP( ABS( ztamr ) * MIN ( zmt1, zmt2 ) & ! Saturation water vapour 872 & / ( sf(jp_tair)%fnow(ji,jj ) - 35.86 + MAX( 0.e0, zmt3 ) ) )873 zev(ji,jj) = sf(jp_humi)%fnow(ji,jj ) * zes * 1.0e-05! vapour pressure872 & / ( sf(jp_tair)%fnow(ji,jj,1) - 35.86 + MAX( 0.e0, zmt3 ) ) ) 873 zev(ji,jj) = sf(jp_humi)%fnow(ji,jj,1) * zes * 1.0e-05 ! vapour pressure 874 874 END DO 875 875 END DO … … 938 938 & / ( 1.0 + 0.139 * stauc(ji,jj) * ( 1.0 - 0.9435 * pa_ice_os(ji,jj,jl) ) ) 939 939 940 pqsr_ice(ji,jj,jl) = pqsr_ice(ji,jj,jl) + ( ( 1.0 - sf(jp_ccov)%fnow(ji,jj ) ) * zqsr_ice_cs &941 & + sf(jp_ccov)%fnow(ji,jj ) * zqsr_ice_os )940 pqsr_ice(ji,jj,jl) = pqsr_ice(ji,jj,jl) + ( ( 1.0 - sf(jp_ccov)%fnow(ji,jj,1) ) * zqsr_ice_cs & 941 & + sf(jp_ccov)%fnow(ji,jj,1) * zqsr_ice_os ) 942 942 END DO 943 943 END DO -
branches/DEV_r1784_mid_year_merge_2010/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r1730 r1951 164 164 ENDIF 165 165 DO ifpr= 1, jfld 166 ALLOCATE( sf(ifpr)%fnow(jpi,jpj ) )167 ALLOCATE( sf(ifpr)%fdta(jpi,jpj, 2) )166 ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1 ) ) 167 ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) ) 168 168 END DO 169 169 ! … … 176 176 177 177 #if defined key_lim3 178 tatm_ice(:,:) = sf(jp_tair)%fnow(:,: )178 tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1) 179 179 #endif 180 180 … … 244 244 DO jj = 2, jpjm1 245 245 DO ji = fs_2, fs_jpim1 ! vect. opt. 246 zwnd_i(ji,jj) = ( sf(jp_wndi)%fnow(ji,jj ) - 0.5 * ( pu(ji-1,jj ) + pu(ji,jj) ) )247 zwnd_j(ji,jj) = ( sf(jp_wndj)%fnow(ji,jj ) - 0.5 * ( pv(ji ,jj-1) + pv(ji,jj) ) )246 zwnd_i(ji,jj) = ( sf(jp_wndi)%fnow(ji,jj,1) - 0.5 * ( pu(ji-1,jj ) + pu(ji,jj) ) ) 247 zwnd_j(ji,jj) = ( sf(jp_wndj)%fnow(ji,jj,1) - 0.5 * ( pv(ji ,jj-1) + pv(ji,jj) ) ) 248 248 END DO 249 249 END DO … … 262 262 ! ocean albedo assumed to be 0.066 263 263 !CDIR COLLAPSE 264 qsr (:,:) = ( 1. - 0.066 ) * sf(jp_qsr)%fnow(:,: ) * tmask(:,:,1)! Short Wave265 !CDIR COLLAPSE 266 zqlw(:,:) = ( sf(jp_qlw)%fnow(:,: ) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:) ) * tmask(:,:,1) ! Long Wave264 qsr (:,:) = ( 1. - 0.066 ) * sf(jp_qsr)%fnow(:,:,1) * tmask(:,:,1) ! Short Wave 265 !CDIR COLLAPSE 266 zqlw(:,:) = ( sf(jp_qlw)%fnow(:,:,1) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:) ) * tmask(:,:,1) ! Long Wave 267 267 268 268 ! ----------------------------------------------------------------------------- ! … … 307 307 IF( lhftau ) THEN 308 308 !CDIR COLLAPSE 309 taum(:,:) = taum(:,:) + sf(jp_tdif)%fnow(:,: )309 taum(:,:) = taum(:,:) + sf(jp_tdif)%fnow(:,:,1) 310 310 ENDIF 311 311 CALL iom_put( "taum_oce", taum ) ! output wind stress module … … 330 330 ELSE 331 331 !CDIR COLLAPSE 332 zevap(:,:) = MAX( 0.e0, rhoa *Ce(:,:)*( zqsatw(:,:) - sf(jp_humi)%fnow(:,: ) ) * wndm(:,:) ) ! Evaporation333 !CDIR COLLAPSE 334 zqsb (:,:) = rhoa*cpa*Ch(:,:)*( zst (:,:) - sf(jp_tair)%fnow(:,: ) ) * wndm(:,:) ! Sensible Heat332 zevap(:,:) = MAX( 0.e0, rhoa *Ce(:,:)*( zqsatw(:,:) - sf(jp_humi)%fnow(:,:,1) ) * wndm(:,:) ) ! Evaporation 333 !CDIR COLLAPSE 334 zqsb (:,:) = rhoa*cpa*Ch(:,:)*( zst (:,:) - sf(jp_tair)%fnow(:,:,1) ) * wndm(:,:) ! Sensible Heat 335 335 ENDIF 336 336 !CDIR COLLAPSE … … 355 355 qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:) ! Downward Non Solar flux 356 356 !CDIR COLLAPSE 357 emp (:,:) = zevap(:,:) - sf(jp_prec)%fnow(:,: ) * rn_pfac * tmask(:,:,1)357 emp (:,:) = zevap(:,:) - sf(jp_prec)%fnow(:,:,1) * rn_pfac * tmask(:,:,1) 358 358 !CDIR COLLAPSE 359 359 emps(:,:) = emp(:,:) … … 453 453 DO ji = 2, jpim1 ! B grid : no vector opt 454 454 ! ... scalar wind at I-point (fld being at T-point) 455 zwndi_f = 0.25 * ( sf(jp_wndi)%fnow(ji-1,jj ) + sf(jp_wndi)%fnow(ji ,jj) &456 & + sf(jp_wndi)%fnow(ji-1,jj-1 ) + sf(jp_wndi)%fnow(ji ,jj-1) ) - pui(ji,jj)457 zwndj_f = 0.25 * ( sf(jp_wndj)%fnow(ji-1,jj ) + sf(jp_wndj)%fnow(ji ,jj) &458 & + sf(jp_wndj)%fnow(ji-1,jj-1 ) + sf(jp_wndj)%fnow(ji ,jj-1) ) - pvi(ji,jj)455 zwndi_f = 0.25 * ( sf(jp_wndi)%fnow(ji-1,jj ,1) + sf(jp_wndi)%fnow(ji ,jj ,1) & 456 & + sf(jp_wndi)%fnow(ji-1,jj-1,1) + sf(jp_wndi)%fnow(ji ,jj-1,1) ) - pui(ji,jj) 457 zwndj_f = 0.25 * ( sf(jp_wndj)%fnow(ji-1,jj ,1) + sf(jp_wndj)%fnow(ji ,jj ,1) & 458 & + sf(jp_wndj)%fnow(ji-1,jj-1,1) + sf(jp_wndj)%fnow(ji ,jj-1,1) ) - pvi(ji,jj) 459 459 zwnorm_f = zcoef_wnorm * SQRT( zwndi_f * zwndi_f + zwndj_f * zwndj_f ) 460 460 ! ... ice stress at I-point … … 462 462 p_tauj(ji,jj) = zwnorm_f * zwndj_f 463 463 ! ... scalar wind at T-point (fld being at T-point) 464 zwndi_t = sf(jp_wndi)%fnow(ji,jj ) - 0.25 * ( pui(ji,jj+1) + pui(ji+1,jj+1) &465 & + pui(ji,jj ) + pui(ji+1,jj ) )466 zwndj_t = sf(jp_wndj)%fnow(ji,jj ) - 0.25 * ( pvi(ji,jj+1) + pvi(ji+1,jj+1) &467 & + pvi(ji,jj ) + pvi(ji+1,jj ) )464 zwndi_t = sf(jp_wndi)%fnow(ji,jj,1) - 0.25 * ( pui(ji,jj+1) + pui(ji+1,jj+1) & 465 & + pui(ji,jj ) + pui(ji+1,jj ) ) 466 zwndj_t = sf(jp_wndj)%fnow(ji,jj,1) - 0.25 * ( pvi(ji,jj+1) + pvi(ji+1,jj+1) & 467 & + pvi(ji,jj ) + pvi(ji+1,jj ) ) 468 468 z_wnds_t(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1) 469 469 END DO … … 479 479 DO jj = 2, jpj 480 480 DO ji = fs_2, jpi ! vect. opt. 481 zwndi_t = ( sf(jp_wndi)%fnow(ji,jj ) - 0.5 * ( pui(ji-1,jj ) + pui(ji,jj) ) )482 zwndj_t = ( sf(jp_wndj)%fnow(ji,jj ) - 0.5 * ( pvi(ji ,jj-1) + pvi(ji,jj) ) )481 zwndi_t = ( sf(jp_wndi)%fnow(ji,jj,1) - 0.5 * ( pui(ji-1,jj ) + pui(ji,jj) ) ) 482 zwndj_t = ( sf(jp_wndj)%fnow(ji,jj,1) - 0.5 * ( pvi(ji ,jj-1) + pvi(ji,jj) ) ) 483 483 z_wnds_t(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1) 484 484 END DO … … 489 489 DO jj = 2, jpjm1 490 490 DO ji = fs_2, fs_jpim1 ! vect. opt. 491 p_taui(ji,jj) = zcoef_wnorm2 * ( z_wnds_t(ji+1,jj ) + z_wnds_t(ji,jj) ) &492 & * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj ) + sf(jp_wndi)%fnow(ji,jj) ) - pui(ji,jj) )493 p_tauj(ji,jj) = zcoef_wnorm2 * ( z_wnds_t(ji,jj+1 ) + z_wnds_t(ji,jj) ) &494 & * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1 ) + sf(jp_wndj)%fnow(ji,jj) ) - pvi(ji,jj) )491 p_taui(ji,jj) = zcoef_wnorm2 * ( z_wnds_t(ji+1,jj ) + z_wnds_t(ji,jj) ) & 492 & * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj,1) + sf(jp_wndi)%fnow(ji,jj,1) ) - pui(ji,jj) ) 493 p_tauj(ji,jj) = zcoef_wnorm2 * ( z_wnds_t(ji,jj+1 ) + z_wnds_t(ji,jj) ) & 494 & * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1,1) + sf(jp_wndj)%fnow(ji,jj,1) ) - pvi(ji,jj) ) 495 495 END DO 496 496 END DO … … 515 515 zst3 = pst(ji,jj,jl) * zst2 516 516 ! Short Wave (sw) 517 p_qsr(ji,jj,jl) = ( 1. - palb(ji,jj,jl) ) * sf(jp_qsr)%fnow(ji,jj ) * tmask(ji,jj,1)517 p_qsr(ji,jj,jl) = ( 1. - palb(ji,jj,jl) ) * sf(jp_qsr)%fnow(ji,jj,1) * tmask(ji,jj,1) 518 518 ! Long Wave (lw) 519 z_qlw(ji,jj,jl) = 0.95 * ( sf(jp_qlw)%fnow(ji,jj) & 520 & - Stef * pst(ji,jj,jl) * zst3 ) * tmask(ji,jj,1) 519 z_qlw(ji,jj,jl) = 0.95 * ( sf(jp_qlw)%fnow(ji,jj,1) - Stef * pst(ji,jj,jl) * zst3 ) * tmask(ji,jj,1) 521 520 ! lw sensitivity 522 521 z_dqlw(ji,jj,jl) = zcoef_dqlw * zst3 … … 528 527 ! ... turbulent heat fluxes 529 528 ! Sensible Heat 530 z_qsb(ji,jj,jl) = rhoa * cpa * Cice * z_wnds_t(ji,jj) * ( pst(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj ) )529 z_qsb(ji,jj,jl) = rhoa * cpa * Cice * z_wnds_t(ji,jj) * ( pst(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj,1) ) 531 530 ! Latent Heat 532 531 p_qla(ji,jj,jl) = MAX( 0.e0, rhoa * Ls * Cice * z_wnds_t(ji,jj) & 533 & * ( 11637800. * EXP( -5897.8 / pst(ji,jj,jl) ) / rhoa - sf(jp_humi)%fnow(ji,jj ) ) )532 & * ( 11637800. * EXP( -5897.8 / pst(ji,jj,jl) ) / rhoa - sf(jp_humi)%fnow(ji,jj,1) ) ) 534 533 ! Latent heat sensitivity for ice (Dqla/Dt) 535 534 p_dqla(ji,jj,jl) = zcoef_dqla * z_wnds_t(ji,jj) / ( zst2 ) * EXP( -5897.8 / pst(ji,jj,jl) ) … … 561 560 562 561 !CDIR COLLAPSE 563 p_tpr(:,:) = sf(jp_prec)%fnow(:,: ) * rn_pfac ! total precipitation [kg/m2/s]564 !CDIR COLLAPSE 565 p_spr(:,:) = sf(jp_snow)%fnow(:,: ) * rn_pfac ! solid precipitation [kg/m2/s]562 p_tpr(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac ! total precipitation [kg/m2/s] 563 !CDIR COLLAPSE 564 p_spr(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac ! solid precipitation [kg/m2/s] 566 565 CALL iom_put( 'snowpre', p_spr ) ! Snow precipitation 567 566 ! -
branches/DEV_r1784_mid_year_merge_2010/NEMO/OPA_SRC/SBC/sbcflx.F90
r1730 r1951 126 126 ENDIF 127 127 DO ji= 1, jpfld 128 ALLOCATE( sf(ji)%fnow(jpi,jpj ) )129 ALLOCATE( sf(ji)%fdta(jpi,jpj, 2) )128 ALLOCATE( sf(ji)%fnow(jpi,jpj,1 ) ) 129 ALLOCATE( sf(ji)%fdta(jpi,jpj,1,2) ) 130 130 END DO 131 131 … … 145 145 DO jj = 1, jpj 146 146 DO ji = 1, jpi 147 utau(ji,jj) = sf(jp_utau)%fnow(ji,jj )148 vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj )149 qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj ) - sf(jp_qsr)%fnow(ji,jj)150 qsr (ji,jj) = sf(jp_qsr )%fnow(ji,jj )151 emp (ji,jj) = sf(jp_emp )%fnow(ji,jj )147 utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) 148 vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) 149 qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1) 150 qsr (ji,jj) = sf(jp_qsr )%fnow(ji,jj,1) 151 emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1) 152 152 END DO 153 153 END DO -
branches/DEV_r1784_mid_year_merge_2010/NEMO/OPA_SRC/SBC/sbcice_if.F90
r1730 r1951 81 81 CALL ctl_stop( 'sbc_ice_if: unable to allocate sf_ice structure' ) ; RETURN 82 82 ENDIF 83 ALLOCATE( sf_ice(1)%fnow(jpi,jpj ) )84 ALLOCATE( sf_ice(1)%fdta(jpi,jpj, 2) )83 ALLOCATE( sf_ice(1)%fnow(jpi,jpj,1 ) ) 84 ALLOCATE( sf_ice(1)%fdta(jpi,jpj,1,2) ) 85 85 86 86 … … 107 107 ! 108 108 zt_fzp = fr_i(ji,jj) ! freezing point temperature 109 zfr_obs = sf_ice(1)%fnow(ji,jj )! observed ice cover109 zfr_obs = sf_ice(1)%fnow(ji,jj,1) ! observed ice cover 110 110 ! ! ocean ice fraction (0/1) from the freezing point temperature 111 111 IF( sst_m(ji,jj) <= zt_fzp ) THEN ; fr_i(ji,jj) = 1.e0 -
branches/DEV_r1784_mid_year_merge_2010/NEMO/OPA_SRC/SBC/sbcrnf.F90
r1730 r1951 75 75 CALL ctl_stop( 'sbc_rnf: unable to allocate sf_rnf structure' ) ; RETURN 76 76 ENDIF 77 ALLOCATE( sf_rnf(1)%fnow(jpi,jpj ) )78 ALLOCATE( sf_rnf(1)%fdta(jpi,jpj, 2) )77 ALLOCATE( sf_rnf(1)%fnow(jpi,jpj,1 ) ) 78 ALLOCATE( sf_rnf(1)%fdta(jpi,jpj,1,2) ) 79 79 ENDIF 80 80 CALL sbc_rnf_init(sf_rnf) … … 93 93 DO jj = 1, jpj 94 94 DO ji = 1, jpi 95 IF( gphit(ji,jj) > 40 .AND. gphit(ji,jj) < 65 ) sf_rnf(1)%fnow(ji,jj ) = 0.85 * sf_rnf(1)%fnow(ji,jj)95 IF( gphit(ji,jj) > 40 .AND. gphit(ji,jj) < 65 ) sf_rnf(1)%fnow(ji,jj,1) = 0.85 * sf_rnf(1)%fnow(ji,jj,1) 96 96 END DO 97 97 END DO … … 101 101 102 102 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN 103 emp (:,:) = emp (:,:) - rn_rfact * ABS( sf_rnf(1)%fnow(:,: ) )104 emps(:,:) = emps(:,:) - rn_rfact * ABS( sf_rnf(1)%fnow(:,: ) )103 emp (:,:) = emp (:,:) - rn_rfact * ABS( sf_rnf(1)%fnow(:,:,1) ) 104 emps(:,:) = emps(:,:) - rn_rfact * ABS( sf_rnf(1)%fnow(:,:,1) ) 105 105 CALL iom_put( "runoffs", sf_rnf(1)%fnow ) ! runoffs 106 106 ENDIF -
branches/DEV_r1784_mid_year_merge_2010/NEMO/OPA_SRC/SBC/sbcssr.F90
r1730 r1951 115 115 CALL ctl_stop( 'sbc_ssr: unable to allocate sf_sst structure' ) ; RETURN 116 116 ENDIF 117 ALLOCATE( sf_sst(1)%fnow(jpi,jpj ) )118 ALLOCATE( sf_sst(1)%fdta(jpi,jpj, 2) )117 ALLOCATE( sf_sst(1)%fnow(jpi,jpj,1 ) ) 118 ALLOCATE( sf_sst(1)%fdta(jpi,jpj,1,2) ) 119 119 ! 120 120 ! fill sf_sst with sn_sst and control print … … 128 128 CALL ctl_stop( 'sbc_ssr: unable to allocate sf_sss structure' ) ; RETURN 129 129 ENDIF 130 ALLOCATE( sf_sss(1)%fnow(jpi,jpj ) )131 ALLOCATE( sf_sss(1)%fdta(jpi,jpj, 2) )130 ALLOCATE( sf_sss(1)%fnow(jpi,jpj,1 ) ) 131 ALLOCATE( sf_sss(1)%fdta(jpi,jpj,1,2) ) 132 132 ! 133 133 ! fill sf_sss with sn_sss and control print … … 153 153 DO jj = 1, jpj 154 154 DO ji = 1, jpi 155 zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj ) )155 zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) ) 156 156 qns(ji,jj) = qns(ji,jj) + zqrp 157 157 qrp(ji,jj) = zqrp … … 167 167 DO ji = 1, jpi 168 168 zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) ) & ! No damping in vicinity of river mouths 169 & * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj ) ) &169 & * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) ) & 170 170 & / ( sss_m(ji,jj) + 1.e-20 ) 171 171 emps(ji,jj) = emps(ji,jj) + zerp … … 182 182 DO ji = 1, jpi 183 183 zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) ) & ! No damping in vicinity of river mouths 184 & * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj ) ) &184 & * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) ) & 185 185 & / ( sss_m(ji,jj) + 1.e-20 ) 186 186 IF( ln_sssr_bnd ) zerp = SIGN( 1., zerp ) * MIN( zerp_bnd, ABS(zerp) )
Note: See TracChangeset
for help on using the changeset viewer.
