source: branches/UKMO/dev_3841_sbc/NEMOGCM/NEMO/OPA_SRC/SBC/sbcget.F90 @ 4827

MODULE sbcget
   !!======================================================================
   !!                       ***  MODULE  sbcget  ***
   !! Ocean forcing:  get input field for surface boundary condition
   !!=====================================================================

   !!----------------------------------------------------------------------
   !!   fld_read      : read input fields used for the computation of the
   !!                   surface boundary condition
   !!----------------------------------------------------------------------
   USE oce             ! ocean dynamics and tracers
   USE dom_oce         ! ocean space and time domain
   USE phycst          ! ???
   USE in_out_manager  ! I/O manager
   USE iom             ! I/O manager library
   USE lib_mpp         ! MPP library
   USE wrk_nemo        ! work arrays
   USE timing
   USE fldread2
   USE fld_def
   USE sbc_ice
#if defined key_cice
   USE ice_domain_size, only: ncat
#endif
   USE cpl_oasis3      ! OASIS3 coupling

   IMPLICIT NONE
   PRIVATE   

   PUBLIC  sbc_get_init, sbc_get

#if defined key_cice
   INTEGER, PUBLIC, PARAMETER ::   jpl = ncat 
#elif ! defined key_lim2   &&   ! defined key_lim3
   INTEGER, PUBLIC, PARAMETER ::   jpl = 1 
#endif

   TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   sf   ! structure of input fields (file informations, fields read)

   !!----------------------------------------------------------------------
   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
   !! $Id: fldread.F90 3851 2013-03-27 10:03:54Z smasson $
   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
   !!----------------------------------------------------------------------
CONTAINS

   SUBROUTINE sbc_get_init(  )
      !!---------------------------------------------------------------------
      !!                    ***  ROUTINE sbc_get_init  ***
      !!
      !! ** Purpose :  - read namelists, initialise stuff
      !!----------------------------------------------------------------------
      TYPE(FLD_N) ::   sn_wndi, sn_wndj, sn_otx1, sn_oty1, sn_otz1, sn_otx2, sn_oty2, sn_otz2,  sn_itx1, sn_ity1, sn_itz1, sn_itx2, sn_ity2, sn_itz2
      TYPE(FLD_N) ::   sn_qsroce, sn_qnsoce, sn_qlw, sn_tair, sn_humi, sn_prec, sn_rain, sn_snow, sn_tevp, sn_ievp, sn_tdif, sn_w10m, sn_qtot
      TYPE(FLD_N) ::   sn_oemp, sn_rnf, sn_cal, sn_topm, sn_botm, sn_qsrice, sn_qsrmix, sn_qnsice, sn_qnsmix, sn_taum, sn_sbpr, sn_semp, sn_dqnsdt, sn_co2
      TYPE(FLD_N), DIMENSION(jpfld) ::   slf_i
      INTEGER ::   jn       ! dummy loop index
      INTEGER ::   ierror   ! return error code
      CHARACTER(len=100) ::  cn_dir   !   Root directory for location of core files
      NAMELIST/namsbc_get/ cn_dir , sn_wndi, sn_wndj, sn_otx1, sn_oty1, sn_otz1, sn_otx2, sn_oty2, sn_otz2,  sn_itx1, sn_ity1, sn_itz1, sn_itx2, sn_ity2, sn_itz2, sn_qsroce, sn_qnsoce, sn_qlw, sn_tair, sn_humi, sn_prec, sn_rain, sn_snow, sn_tevp, sn_ievp, sn_tdif, sn_w10m, sn_qtot, sn_oemp, sn_rnf, sn_cal, sn_topm, sn_botm, sn_qsrice, sn_qsrmix, sn_qnsice, sn_qnsmix, sn_taum, sn_sbpr, sn_semp, sn_dqnsdt, sn_co2
      !!---------------------------------------------------------------------
      !
      IF( nn_timing == 1 )  CALL timing_start('sbc_get_init')

      ! set file information (default values)
      cn_dir = './'       ! directory in which the model is executed

      REWIND( numnam )                    ! ... read namlist namsbc_get
      READ  ( numnam, namsbc_get )

      slf_i(jp_wndi) = sn_wndi     ;   slf_i(jp_wndj) = sn_wndj
      slf_i(jp_otx1) = sn_otx1     ;   slf_i(jp_oty1) = sn_oty1     ;  slf_i(jp_otz1) = sn_otz1
      slf_i(jp_otx2) = sn_otx2     ;   slf_i(jp_oty2) = sn_oty2     ;  slf_i(jp_otz2) = sn_otz2
      slf_i(jp_itx1) = sn_itx1     ;   slf_i(jp_ity1) = sn_ity1     ;  slf_i(jp_itz1) = sn_itz1
      slf_i(jp_itx1) = sn_itx2     ;   slf_i(jp_ity2) = sn_ity2     ;  slf_i(jp_itz2) = sn_itz2
      slf_i(jp_qsroce) = sn_qsroce ;   slf_i(jp_qsrice) = sn_qsrice ;  slf_i(jp_qsrmix) = sn_qsrmix 
      slf_i(jp_qnsoce) = sn_qnsoce ;   slf_i(jp_qnsice) = sn_qnsice ;  slf_i(jp_qnsmix) = sn_qnsmix 
      slf_i(jp_qlw)  = sn_qlw      ;   slf_i(jp_tair) = sn_tair     ;  slf_i(jp_humi) = sn_humi 
      slf_i(jp_prec) = sn_prec     ;   slf_i(jp_rain) = sn_rain     ;  slf_i(jp_snow) = sn_snow      
      slf_i(jp_tevp) = sn_tevp     ;   slf_i(jp_ievp) = sn_ievp     ;  slf_i(jp_tdif) = sn_tdif
      slf_i(jp_taum) = sn_taum     ;   slf_i(jp_w10m) = sn_w10m     ;  slf_i(jp_qtot) = sn_qtot
      slf_i(jp_sbpr) = sn_sbpr     ;   slf_i(jp_semp) = sn_semp     ;  slf_i(jp_oemp) = sn_oemp     
      slf_i(jp_rnf)  = sn_rnf      ;   slf_i(jp_cal)  = sn_cal      ;  slf_i(jp_topm) = sn_topm
      slf_i(jp_botm) = sn_botm     ;   slf_i(jp_dqnsdt) = sn_dqnsdt ;  slf_i(jp_co2) = sn_co2

      ALLOCATE( sf(jpfld), STAT=ierror )         ! set sf structure
      IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_cpl: unable to allocate sf structure' )

      CALL fld_fill2( sf, slf_i, jpl, cn_dir, 'sbc_get', 'coupled formulation for ocean surface boundary condition', 'namsbc_get' )

      ! Allocate all parts of sf used for received fields
      DO jn = 1, jpfld
         IF ( sf(jn)%loasis .OR. sf(jn)%lfile ) ALLOCATE( sf(jn)%fnow(jpi,jpj,sf(jn)%nct) )
         IF ( sf(jn)%lfile .AND. sf(jn)%ln_tint ) ALLOCATE( sf(jn)%fdta(jpi,jpj,sf(jn)%nct,2) )
      END DO

      ! Allocate taum part of sf which is used even when not received as coupling field
      IF ( .NOT. sf(jp_taum)%loasis ) ALLOCATE( sf(jp_taum)%fnow(jpi,jpj,sf(jn)%nct) )

! **WE REALLY NEED A WHOLE LOAD OF CHECKS THAT NAMSBC_GET IS CONSISTENT WITH OTHER CHOICES RE COUPLED / BULK ETC  BUT DO THIS LATER** ! **MAY REQUIRE CHANGES TO OTHER NAME-LIST STRUCTURES** !

      IF( nn_timing == 1 )  CALL timing_stop('sbc_get_init')

   END SUBROUTINE sbc_get_init

   SUBROUTINE sbc_get( kt )
      !!---------------------------------------------------------------------
      !!                    ***  ROUTINE sbc_get  ***
      !!
      !! ** Purpose :   get the data
      !!----------------------------------------------------------------------
      INTEGER, INTENT(in) ::   kt       ! ocean model time step index
      INTEGER ::   jn       ! dummy loop index
      INTEGER  ::   isec                   ! number of seconds since nit000 (assuming rdttra did not change since nit000)

      isec = ( kt - nit000 ) * NINT( rdttra(1) )             ! date of exchanges

      DO jn= 1, jpfld
         IF( sf(jn)%lfile )  CALL fld_read2( kt, nn_fsbc, sf(jn:jn) )  ! input fields provided at the current time-step
         IF( sf(jn)%loasis )  CALL cpl_prism_rcv( isec, sf(jn) )        ! input fields provided at the current time-step
      END DO

! Need to sort out where / how rotation should work....
      CALL fld_rot2( kt, sf )                    ! rotate vector before/now/after fields if needed

   END SUBROUTINE sbc_get

END MODULE sbcget