MODULE sbcflx !!====================================================================== !! *** MODULE sbcflx *** !! Ocean forcing: momentum, heat and freshwater flux formulation !!===================================================================== !! History : 9.0 ! 06-06 (G. Madec) Original code !!---------------------------------------------------------------------- !!---------------------------------------------------------------------- !! namflx : flux formulation namlist !! sbc_flx : flux formulation as ocean surface boundary condition !! (forced mode, fluxes read in NetCDF files) !!---------------------------------------------------------------------- !! question diverses !! * ajouter un test sur la division entier de freqh et rdttra ??? !! ** ajoute dans namelist: 1 year forcing files !! or forcing file starts at the begining of the run !! *** we assume that the forcing file start and end with the previous !! year last record and the next year first record (useful for !! time interpolation, required even if no time interp???) !! * ajouter un test sur la division de la frequence en pas de temps !! ==> daymod ajout de nsec_year = number of second since the begining of the year !! assumed to be 0 at 0h january the 1st (i.e. 24h december the 31) !! !! *** regrouper dtatem et dtasal !!---------------------------------------------------------------------- USE oce ! ocean dynamics and tracers USE dom_oce ! ocean space and time domain USE sbc_oce ! Surface boundary condition: ocean fields USE phycst ! physical constants USE daymod ! calendar USE fldread ! read input fields USE iom ! IOM library USE in_out_manager ! I/O manager USE lib_mpp ! distribued memory computing library USE lbclnk ! ocean lateral boundary conditions (or mpp link) IMPLICIT NONE PRIVATE PUBLIC sbc_flx ! routine called by step.F90 INTEGER , PARAMETER :: jpfld = 5 ! maximum number of files to read INTEGER , PARAMETER :: jp_utau = 1 ! index of wind stress (i-component) file INTEGER , PARAMETER :: jp_vtau = 2 ! index of wind stress (j-component) file INTEGER , PARAMETER :: jp_qtot = 3 ! index of total (non solar+solar) heat file INTEGER , PARAMETER :: jp_qsr = 4 ! index of solar heat file INTEGER , PARAMETER :: jp_emp = 5 ! index of evaporation-precipation file TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf ! structure of input fields (file informations, fields read) !! * Substitutions # include "domzgr_substitute.h90" # include "vectopt_loop_substitute.h90" !!---------------------------------------------------------------------- !! OPA 9.0 , LOCEAN-IPSL (2006) !! $Id$ !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) !!---------------------------------------------------------------------- CONTAINS SUBROUTINE sbc_flx( kt ) !!--------------------------------------------------------------------- !! *** ROUTINE sbc_flx *** !! !! ** Purpose : provide at each time step the surface ocean fluxes !! (momentum, heat, freshwater and runoff) !! !! ** Method : - READ each fluxes in NetCDF files: !! i-component of the stress utau (N/m2) !! j-component of the stress vtau (N/m2) !! net downward heat flux qtot (watt/m2) !! net downward radiative flux qsr (watt/m2) !! net upward freshwater (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 !! !! CAUTION : - never mask the surface stress fields !! - the stress is assumed to be in the mesh referential !! i.e. the (i,j) referential !! !! ** Action : update at each time-step !! - utau & vtau : stress components in (i,j) referential !! - qns : non solar heat flux !! - qsr : solar heat flux !! - emp : evap - precip (volume flux) !! - emps : evap - precip (concentration/dillution) !!---------------------------------------------------------------------- INTEGER, INTENT(in) :: kt ! ocean time step !! INTEGER :: ji, jj, jf ! dummy indices INTEGER :: ierror ! return error code REAL(wp) :: zfact ! temporary scalar !! CHARACTER(len=100) :: cn_dir ! Root directory for location of flx files TYPE(FLD_N), DIMENSION(jpfld) :: slf_i ! array of namelist information structures TYPE(FLD_N) :: sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp ! informations about the fields to be read NAMELIST/namsbc_flx/ cn_dir, sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp !!--------------------------------------------------------------------- ! ! ====================== ! IF( kt == nit000 ) THEN ! First call kt=nit000 ! ! ! ====================== ! ! set file information cn_dir = './' ! directory in which the model is executed ! ... default values (NB: frequency positive => hours, negative => months) ! ! file ! frequency ! variable ! time intep ! clim ! 'yearly' or ! ! ! name ! (hours) ! name ! (T/F) ! (T/F) ! 'monthly' ! sn_utau = FLD_N( 'utau' , 24. , 'utau' , .false. , .false. , 'yearly' ) sn_vtau = FLD_N( 'vtau' , 24. , 'vtau' , .false. , .false. , 'yearly' ) sn_qtot = FLD_N( 'qtot' , 24. , 'qtot' , .false. , .false. , 'yearly' ) sn_qsr = FLD_N( 'qsr' , 24. , 'qsr' , .false. , .false. , 'yearly' ) sn_emp = FLD_N( 'emp' , 24. , 'emp' , .false. , .false. , 'yearly' ) REWIND ( numnam ) ! ... read in namlist namflx READ ( numnam, namsbc_flx ) ! store namelist information in an array slf_i(jp_utau) = sn_utau ; slf_i(jp_vtau) = sn_vtau slf_i(jp_qtot) = sn_qtot ; slf_i(jp_qsr ) = sn_qsr slf_i(jp_emp ) = sn_emp ! set sf structure ALLOCATE( sf(jpfld), STAT=ierror ) IF( ierror > 0 ) THEN CALL ctl_stop( 'sbc_flx: unable to allocate sf structure' ) ; RETURN ENDIF DO ji= 1, jpfld ALLOCATE( sf(ji)%fnow(jpi,jpj) ) ALLOCATE( sf(ji)%fdta(jpi,jpj,2) ) END DO ! fill sf with slf_i and control print CALL fld_fill( sf, slf_i, cn_dir, 'sbc_flx', 'flux formulation for ocean surface boundary condition', 'namsbc_flx' ) ! ENDIF CALL fld_read( kt, nn_fsbc, sf ) ! Read input fields and provides the ! ! input fields at the current time-step IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN ! ! set the ocean fluxes from read fields !CDIR COLLAPSE DO jj = 1, jpj DO ji = 1, jpi utau(ji,jj) = sf(jp_utau)%fnow(ji,jj) vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj) qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj) - sf(jp_qsr)%fnow(ji,jj) qsr (ji,jj) = sf(jp_qsr )%fnow(ji,jj) emp (ji,jj) = sf(jp_emp )%fnow(ji,jj) END DO END DO ! Initialization of emps (when no ice model) emps(:,:) = emp (:,:) ! Estimation of wind speed as a function of wind stress ( |tau|=rhoa*Cd*|U|^2 ) CALL sbc_tau2wnd ! control print (if less than 100 time-step asked) IF( nitend-nit000 <= 100 .AND. lwp ) THEN WRITE(numout,*) WRITE(numout,*) ' read daily momentum, heat and freshwater fluxes OK' DO jf = 1, jpfld IF( jf == jp_utau .OR. jf == jp_vtau ) zfact = 1. IF( jf == jp_qtot .OR. jf == jp_qsr ) zfact = 0.1 IF( jf == jp_emp ) zfact = 86400. WRITE(numout,*) WRITE(numout,*) ' day: ', ndastp , TRIM(sf(jf)%clvar), ' * ', zfact CALL prihre( sf(jf)%fnow, jpi, jpj, 1, jpi, 20, 1, jpj, 10, zfact, numout ) END DO CALL FLUSH(numout) ENDIF ! ENDIF ! END SUBROUTINE sbc_flx !!====================================================================== END MODULE sbcflx