MODULE sbcblk_clio !!====================================================================== !! *** MODULE sbcblk_clio *** !! Ocean forcing: momentum, heat and freshwater flux formulation !!===================================================================== !! History : 8.0 ! 01-04 (Louvain-La-Neuve) Original code !! 8.5 ! 02-09 (C. Ethe , G. Madec ) F90: Free form and module !! 9.0 ! 06-06 (G. Madec) surface module !!---------------------------------------------------------------------- !!---------------------------------------------------------------------- !! sbc_blk_clio : bulk formulation as ocean surface boundary condition !! (forced mode, CORE bulk formulea) !! blk_oce_clio : ocean: computes momentum, heat and freshwater fluxes !! blk_ice_clio : ice : computes momentum, heat and freshwater fluxes !!---------------------------------------------------------------------- !! flx_blk_declin : Computation of the solar declination !!---------------------------------------------------------------------- USE oce ! ocean dynamics and tracers USE dom_oce ! ocean space and time domain USE cpl_oce ! ??? USE phycst ! physical constants USE daymod USE sbc_oce ! Surface boundary condition: ocean fields USE sbc_ice ! Surface boundary condition: ocean fields USE fldread ! read input fields USE ocfzpt ! ??? USE iom USE in_out_manager USE lbclnk USE prtctl ! Print control IMPLICIT NONE PRIVATE PUBLIC sbc_blk_clio ! routine called in sbcmod PUBLIC blk_ice_clio ! routine called in sbcice_lim module INTEGER , PARAMETER :: & jpfld = 7, & ! number of files to read jp_utau = 1, & ! index of wind stress (i-component) (m/s) at U-point jp_vtau = 2, & ! index of wind stress (j-component) (m/s) at V-point jp_wspd = 3, & ! index of XXm wind module (m/s) at T-point jp_tair = 4, & ! index of 2m air temperature (Celcius) jp_humi = 5, & ! index of specific humidity ( % ) jp_cldc = 6, & ! Cloud cover ( % ) jp_prec = 7 ! index of total precipitation (kg/m2/s) TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf ! structure of input fields (informations on files, fields read) !! * CLIO bulk parameters INTEGER, PARAMETER :: jpintsr = 24 ! number of time step between sunrise and sunset ! ! uses for heat flux computation LOGICAL :: lbulk_init = .TRUE. ! flag, bulk initialization done or not) REAL(wp), DIMENSION(jpi,jpj) :: stauc ! cloud optical depth REAL(wp), DIMENSION(jpi,jpj) :: sbudyko ! ??? !! * constants for bulk computation (flx_blk) REAL(wp), DIMENSION(19) :: budyko ! BUDYKO's coefficient ! ! BUDYKO's coefficient (cloudiness effect on LW radiation): DATA budyko / 1.00, 0.98, 0.95, 0.92, 0.89, 0.86, 0.83, 0.80, 0.78, 0.75, & & 0.72, 0.69, 0.67, 0.64, 0.61, 0.58, 0.56, 0.53, 0.50 / REAL(wp), DIMENSION(20) :: tauco ! cloud optical depth coefficient ! ! Cloud optical depth coefficient DATA tauco / 6.6, 6.6, 7.0, 7.2, 7.1, 6.8, 6.5, 6.6, 7.1, 7.6, & & 6.6, 6.1, 5.6, 5.5, 5.8, 5.8, 5.6, 5.6, 5.6, 5.6 / REAL(wp) :: zeps = 1.e-20 , & ! constant values & zeps0 = 1.e-13 , & & zeps1 = 1.e-06 , & & zzero = 0.e0 , & & zone = 1.0 REAL(wp) :: yearday ! !!---------------------------------------------------------------------- !! OPA 9.0 , LOCEAN-IPSL (2006) !! $Header: $ !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) !!---------------------------------------------------------------------- CONTAINS SUBROUTINE sbc_blk_clio( kt ) !!--------------------------------------------------------------------- !! *** ROUTINE sbc_blk_clio *** !! !! ** Purpose : provide at each time step the surface ocean fluxes !! (momentum, heat, freshwater and runoff) !! !! ** Method : READ each fluxes in NetCDF files !! The i-component of the stress utau (N/m2) !! The j-component of the stress vtau (N/m2) !! the net downward heat flux qtot (watt/m2) !! the net downward radiative flux qsr (watt/m2) !! the net upward water (evapo - precip) emp (kg/m2/s) !! Assumptions made: !! - each file content an entire year (read record, not the time axis) !! - first and last record are part of the previous and next year !! (useful for time interpolation) !! - the number of records is 2 + 365*24 / freqh(jf) !! or 366 in leap year case !! !! C A U T I O N : never mask the surface stress fields !! the stress is assumed to be in the mesh referential !! i.e. the (i,j) referential !! !! ** Action : defined at each time-step at the air-sea interface !! - utau & vtau : stress components in geographical ref. !! - qns & qsr : non solar and solar heat fluxes !! - emp : evap - precip (volume flux) !! - emps : evap - precip (concentration/dillution) !!---------------------------------------------------------------------- INTEGER, INTENT( in ) :: kt ! ocean time step !! INTEGER :: jf ! dummy indices INTEGER :: ierror ! return error code !! CHARACTER(len=100) :: cn_dir ! Root directory for location of clio files TYPE(FLD_N), DIMENSION(jpfld) :: slf_i ! array of namelist informations on the fields to read TYPE(FLD_N) :: sn_utau, sn_vtau, sn_wspd, sn_tair, & ! informations about the fields to be read & sn_humi, sn_cldc, sn_prec NAMELIST/namsbc_clio/ cn_dir, sn_utau, sn_vtau, sn_wspd, sn_tair, & & sn_humi, sn_cldc, sn_prec !!--------------------------------------------------------------------- ! ! ====================== ! IF( kt == nit000 ) THEN ! First call kt=nit000 ! ! ! ====================== ! ! set file information (default values) cn_dir = './' ! directory in which the model is executed ! (NB: frequency positive => hours, negative => months) ! ! file ! frequency ! variable ! time intep ! clim ! starting ! ! ! name ! (hours) ! name ! (T/F) ! (0/1) ! record ! sn_utau = FLD_N( 'utau' , 24. , 'utau' , .FALSE. , 0 , 0 ) sn_vtau = FLD_N( 'vtau' , 24. , 'vtau' , .FALSE. , 0 , 0 ) sn_wspd = FLD_N( 'wspd' , 24. , 'wspd' , .FALSE. , 0 , 0 ) sn_tair = FLD_N( 'tair' , 24. , 'Tair' , .FALSE. , 0 , 0 ) sn_humi = FLD_N( 'humi' , -12. , 'humi' , .FALSE. , 0 , 0 ) sn_cldc = FLD_N( 'cloud', -12. , 'cloud' , .FALSE. , 0 , 0 ) sn_prec = FLD_N( 'rain' , -12. , 'precip' , .FALSE. , 0 , 0 ) REWIND ( numnam ) ! ... read in namlist namsbc_clio READ ( numnam, namsbc_clio ) ! store namelist information in an array slf_i(jp_utau) = sn_utau ; slf_i(jp_vtau) = sn_vtau slf_i(jp_wspd) = sn_wspd ; slf_i(jp_tair) = sn_tair slf_i(jp_humi) = sn_humi ; slf_i(jp_cldc) = sn_cldc slf_i(jp_prec) = sn_prec ! set sf structure ALLOCATE( sf(jpfld), STAT=ierror ) IF( ierror > 0 ) THEN CALL ctl_stop( 'sbc_blk_clio: unable to allocate sf_sst structure' ) ; RETURN ENDIF DO jf = 1, jpfld WRITE(sf(jf)%clrootname,'(a,a)' ) TRIM( cn_dir ), TRIM( slf_i(jf)%clname ) sf(jf)%freqh = slf_i(jf)%freqh sf(jf)%clvar = slf_i(jf)%clvar sf(jf)%ln_tint = slf_i(jf)%ln_tint sf(jf)%nclim = slf_i(jf)%nclim sf(jf)%nstrec = slf_i(jf)%nstrec END DO IF(lwp) THEN ! control print WRITE(numout,*) WRITE(numout,*) 'sbc_blk_clio : CLIO bulk formulation for ocean surface boundary condition' WRITE(numout,*) '~~~~~~~~~~~~ ' WRITE(numout,*) ' namsbc_clio Namelist' WRITE(numout,*) ' list of files and frequency (>0: in hours ; <0 in months)' DO jf = 1, jpfld WRITE(numout,*) ' root filename: ' , trim( sf(jf)%clrootname ), & & ' variable name: ' , trim( sf(jf)%clvar ) WRITE(numout,*) ' frequency: ' , sf(jf)%freqh , & & ' time interp: ' , sf(jf)%ln_tint , & & ' climatology: ' , sf(jf)%nclim , & & ' starting record: ', sf(jf)%nstrec END DO ENDIF ! ENDIF CALL fld_read( kt, nn_fsbc, sf ) ! Read input fields and provides the ! ! input fields at the current time-step !CDIR COLLAPSE utau(:,:) = sf(jp_utau)%fnow(:,:) ! set surface ocean stresses directly !CDIR COLLAPSE vtau(:,:) = sf(jp_vtau)%fnow(:,:) ! from the input values CALL blk_oce_clio( ) ! set the ocean surface heat and freshwater fluxes ! ! using CLIO bulk formulea ! temporary staff : set fluxes to zero.... qns (:,:)= 0.e0 qsr (:,:)= 0.e0 emp (:,:)= 0.e0 emps(:,:)= 0.e0 ! control print (if less than 100 time-step asked) !!! IF( nitend-nit000 <= 100 .AND. lwp ) THEN IF( kt == nit000 .AND. lwp ) THEN WRITE(numout,*) WRITE(numout,*) ' CLIO bulk fields at nit000' DO jf = 1, jpfld WRITE(numout,*) WRITE(numout,*) ' day: ', ndastp , TRIM(sf(jf)%clvar) CALL prihre( sf(jf)%fnow, jpi, jpj, 1, jpi, 20, 1, jpj, 10, 1., numout ) END DO CALL FLUSH(numout) ENDIF END SUBROUTINE sbc_blk_clio SUBROUTINE blk_oce_clio( ) END SUBROUTINE blk_oce_clio SUBROUTINE blk_ice_clio END SUBROUTINE blk_ice_clio SUBROUTINE blk_qsr_clio( ) END SUBROUTINE blk_qsr_clio SUBROUTINE flx_blk_declin( ky, kday, pdecl ) !!--------------------------------------------------------------------------- !! *** ROUTINE flx_blk_declin *** !! !! ** Purpose : Computation of the solar declination for the day !! kday ( in decimal degrees ). !! !! ** Method : !!--------------------------------------------------------------------- INTEGER , INTENT(in ) :: ky ! = -1, 0, 1 for odd, normal and leap years resp. INTEGER , INTENT(in ) :: kday ! day of the year ( kday = 1 on january 1) REAL(wp), INTENT( out) :: pdecl ! solar declination REAL(wp) :: zday , & ! corresponding day of type year (cf. ky) & zp1, zp2, zp3, zp4 ! temporary scalars REAL(wp) :: a0 = 0.39507671 , & ! constants used in solar & a1 = 22.85684301 , & ! declinaison computation & a2 = -0.38637317 , & & a3 = 0.15096535 , & & a4 = -0.00961411 , & & b1 = -4.29692073 , & & b2 = 0.05702074 , & & b3 = -0.09028607 , & & b4 = 0.00592797 !!--------------------------------------------------------------------- ! SELECT CASE ( ky ) CASE ( 1 ) zday = REAL( kday, wp ) - 0.5 CASE ( 3 ) zday = REAL( kday, wp ) - 1.0 CASE DEFAULT zday = REAL( kday, wp ) END SELECT zp1 = rpi * ( 2.0 * zday - 367.0 ) / yearday zp2 = 2. * zp1 zp3 = 3. * zp1 zp4 = 4. * zp1 pdecl = a0 & & + a1 * COS( zp1 ) + a2 * COS( zp2 ) + a3 * COS( zp3 ) + a4 * COS( zp4 ) & & + b1 * SIN( zp1 ) + b2 * SIN( zp2 ) + b3 * SIN( zp3 ) + b4 * SIN( zp4 ) ! END SUBROUTINE flx_blk_declin !!====================================================================== END MODULE sbcblk_clio