Changeset 1856 for branches/DEV_r1784_3DF/NEMO/OPA_SRC/SBC
- Timestamp:
- 2010-05-03T12:32:10+02:00 (14 years ago)
- Location:
- branches/DEV_r1784_3DF/NEMO/OPA_SRC/SBC
- Files:
-
- 7 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/DEV_r1784_3DF/NEMO/OPA_SRC/SBC/fldread.F90
r1824 r1856 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 step50 REAL(wp) , ALLOCATABLE, DIMENSION(:,:,: ) :: fnow ! input fields interpolated to now time step 51 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 … … 146 146 !CDIR COLLAPSE 147 147 sd(jf)%fdta(:,:,:,1) = sd(jf)%fdta(:,:,:,2) 148 sd(jf)%rotn(1) = sd(jf)%rotn(2)148 sd(jf)%rotn(1) = sd(jf)%rotn(2) 149 149 ENDIF 150 150 … … 204 204 205 205 ! read after data 206 ipk = SIZE( sd(jf)%fdta, 3 ) 206 207 IF( LEN(TRIM(sd(jf)%wgtname)) > 0 ) THEN 207 208 CALL wgt_list( sd(jf), kw ) 208 ipk = SIZE(sd(jf)%fdta,3) 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 ENDDO 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 212 212 ELSE 213 SELECT CASE( SIZE(sd(jf)%fdta,3) ) 214 CASE(1) 213 IF( ipk == 1 ) THEN 215 214 CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,1,2), sd(jf)%nrec_a(1) ) 216 CASE(jpk)215 ELSE 217 216 CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,:,2), sd(jf)%nrec_a(1) ) 218 END SELECT217 ENDIF 219 218 ENDIF 220 219 sd(jf)%rotn(2) = .FALSE. … … 256 255 vtmp(:,:) = 0.0 257 256 ! 258 ipk = SIZE( sd(kf)%fdta(:,:,:,nf) ,3 ) 259 DO jk = 1,ipk 257 DO jk = 1, SIZE( sd(kf)%fdta, 3 ) 260 258 CALL rot_rep( sd(jf)%fdta(:,:,jk,nf),sd(kf)%fdta(:,:,jk,nf),'T', 'en->i', utmp(:,:) ) 261 259 CALL rot_rep( sd(jf)%fdta(:,:,jk,nf),sd(kf)%fdta(:,:,jk,nf),'T', 'en->j', vtmp(:,:) ) 262 260 sd(jf)%fdta(:,:,jk,nf) = utmp(:,:) 263 261 sd(kf)%fdta(:,:,jk,nf) = vtmp(:,:) 264 END DO262 END DO 265 263 ! 266 264 sd(jf)%rotn(nf) = .TRUE. … … 335 333 INTEGER :: inrec ! number of record existing for this variable 336 334 INTEGER :: kwgt 337 INTEGER :: jk ! vertical loop variable338 INTEGER :: ipk ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk )335 INTEGER :: jk ! vertical loop variable 336 INTEGER :: ipk ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk ) 339 337 CHARACTER(LEN=1000) :: clfmt ! write format 340 338 !!--------------------------------------------------------------------- … … 401 399 402 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 ) 403 402 IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN 404 403 CALL wgt_list( sdjf, kwgt ) 405 ipk = SIZE(sdjf%fdta,3) 406 DO jk = 1,ipk 407 CALL fld_interp( sdjf%num,sdjf%clvar,kwgt,sdjf%fdta(:,:,jk,2),sdjf%nrec_a(1) ) 408 ENDDO 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 409 407 ELSE 410 SELECT CASE ( SIZE(sdjf%fdta,3) ) 411 CASE(1) 412 CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,1,2), sdjf%nrec_b(1) ) 413 CASE(jpk) 414 if(lwp)write(numout,*)'cbr00 ',sdjf%num,SIZE(sdjf%fdta,3) 415 CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_b(1) ) 416 END SELECT 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 417 413 ENDIF 418 414 sdjf%rotn(2) = .FALSE. … … 562 558 ELSE 563 559 ! build the new filename if climatological data 564 IF( sdjf%cltype == 'monthly' ) WRITE(sdjf%clname, '(a," m",i2.2)' ) TRIM( sdjf%clrootname ), kmonth ! add month560 IF( sdjf%cltype == 'monthly' ) WRITE(sdjf%clname, '(a,"_m",i2.2)' ) TRIM( sdjf%clrootname ), kmonth ! add month 565 561 ENDIF 566 562 CALL iom_open( sdjf%clname, sdjf%num, ldstop = ldstop, ldiof = LEN(TRIM(sdjf%wgtname)) > 0 ) -
branches/DEV_r1784_3DF/NEMO/OPA_SRC/SBC/sbcblk_clio.F90
r1806 r1856 162 162 163 163 DO ifpr= 1, jpfld 164 ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1 ) )164 ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1 ) ) 165 165 ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) ) 166 166 END DO … … 541 541 & / ( ztatm(ji,jj) - 35.86 + MAX( 0.e0, zmt3 ) ) ) 542 542 543 zev = sf(jp_humi)%fnow(ji,jj,1) * zes 543 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 … … 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(:,:,1) / rday 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... … … 741 741 zes = 611.0 * EXP( ABS( ztamr ) * MIN ( zmt1, zmt2 ) & ! Saturation water vapour 742 742 & / ( 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 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 … … 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,1) & 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 … … 871 871 zes = 611.0 * EXP( ABS( ztamr ) * MIN ( zmt1, zmt2 ) & ! Saturation water vapour 872 872 & / ( 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 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 -
branches/DEV_r1784_3DF/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r1806 r1856 164 164 ENDIF 165 165 DO ifpr= 1, jfld 166 ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1 ) )166 ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1 ) ) 167 167 ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) ) 168 168 END DO … … 262 262 ! ocean albedo assumed to be 0.066 263 263 !CDIR COLLAPSE 264 qsr (:,:) = ( 1. - 0.066 ) * sf(jp_qsr)%fnow(:,:,1) * tmask(:,:,1) ! Short Wave264 qsr (:,:) = ( 1. - 0.066 ) * sf(jp_qsr)%fnow(:,:,1) * tmask(:,:,1) ! Short Wave 265 265 !CDIR COLLAPSE 266 266 zqlw(:,:) = ( sf(jp_qlw)%fnow(:,:,1) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:) ) * tmask(:,:,1) ! Long Wave … … 463 463 ! ... scalar wind at T-point (fld being at T-point) 464 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 ) )465 & + pui(ji,jj ) + pui(ji+1,jj ) ) 466 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 ) )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 … … 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) ) &491 p_taui(ji,jj) = zcoef_wnorm2 * ( z_wnds_t(ji+1,jj ) + z_wnds_t(ji,jj) ) & 492 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) ) &493 p_tauj(ji,jj) = zcoef_wnorm2 * ( z_wnds_t(ji,jj+1 ) + z_wnds_t(ji,jj) ) & 494 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 … … 517 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,1) & 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 -
branches/DEV_r1784_3DF/NEMO/OPA_SRC/SBC/sbcflx.F90
r1806 r1856 126 126 ENDIF 127 127 DO ji= 1, jpfld 128 ALLOCATE( sf(ji)%fnow(jpi,jpj,1 ) )128 ALLOCATE( sf(ji)%fnow(jpi,jpj,1 ) ) 129 129 ALLOCATE( sf(ji)%fdta(jpi,jpj,1,2) ) 130 130 END DO -
branches/DEV_r1784_3DF/NEMO/OPA_SRC/SBC/sbcice_if.F90
r1806 r1856 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,1 ) )83 ALLOCATE( sf_ice(1)%fnow(jpi,jpj,1 ) ) 84 84 ALLOCATE( sf_ice(1)%fdta(jpi,jpj,1,2) ) 85 85 … … 107 107 ! 108 108 zt_fzp = fr_i(ji,jj) ! freezing point temperature 109 zfr_obs = sf_ice(1)%fnow(ji,jj,1) 109 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_3DF/NEMO/OPA_SRC/SBC/sbcrnf.F90
r1806 r1856 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,1 ) )77 ALLOCATE( sf_rnf(1)%fnow(jpi,jpj,1 ) ) 78 78 ALLOCATE( sf_rnf(1)%fdta(jpi,jpj,1,2) ) 79 79 ENDIF -
branches/DEV_r1784_3DF/NEMO/OPA_SRC/SBC/sbcssr.F90
r1806 r1856 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,1 ) )117 ALLOCATE( sf_sst(1)%fnow(jpi,jpj,1 ) ) 118 118 ALLOCATE( sf_sst(1)%fdta(jpi,jpj,1,2) ) 119 119 ! … … 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,1 ) )130 ALLOCATE( sf_sss(1)%fnow(jpi,jpj,1 ) ) 131 131 ALLOCATE( sf_sss(1)%fdta(jpi,jpj,1,2) ) 132 132 !
Note: See TracChangeset
for help on using the changeset viewer.