Changeset 4827 for branches/UKMO/dev_3841_sbc/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

Timestamp:

2014-10-31T12:45:41+01:00 (9 years ago)

Author:

charris

Message:

Some demonstration code changes.

File:

• branches/UKMO/dev_3841_sbc/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90 (modified) (6 diffs)

branches/UKMO/dev_3841_sbc/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

@@ -27 +27 @@
    USE dom_oce         ! ocean space and time domain
    USE phycst          ! physical constants
-   USE fldread         ! read input fields
+   USE fldread2        ! read input fields
+   USE fld_def
+   USE sbcget
    USE sbc_oce         ! Surface boundary condition: ocean fields
    USE cyclone         ! Cyclone 10m wind form trac of cyclone centres
@@ -49 +51 @@
    PUBLIC   blk_ice_core         ! routine called in sbc_ice_lim module
    PUBLIC   turb_core_2z         ! routine calles in sbcblk_mfs module
-
-   INTEGER , PARAMETER ::   jpfld   = 9           ! maximum number of files to read 
-   INTEGER , PARAMETER ::   jp_wndi = 1           ! index of 10m wind velocity (i-component) (m/s)    at T-point
-   INTEGER , PARAMETER ::   jp_wndj = 2           ! index of 10m wind velocity (j-component) (m/s)    at T-point
-   INTEGER , PARAMETER ::   jp_humi = 3           ! index of specific humidity               ( % )
-   INTEGER , PARAMETER ::   jp_qsr  = 4           ! index of solar heat                      (W/m2)
-   INTEGER , PARAMETER ::   jp_qlw  = 5           ! index of Long wave                       (W/m2)
-   INTEGER , PARAMETER ::   jp_tair = 6           ! index of 10m air temperature             (Kelvin)
-   INTEGER , PARAMETER ::   jp_prec = 7           ! index of total precipitation (rain+snow) (Kg/m2/s)
-   INTEGER , PARAMETER ::   jp_snow = 8           ! index of snow (solid prcipitation)       (kg/m2/s)
-   INTEGER , PARAMETER ::   jp_tdif = 9           ! index of tau diff associated to HF tau   (N/m2)   at T-point
    
-   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf   ! structure of input fields (file informations, fields read)
+   TYPE(MAP_POINTER), ALLOCATABLE, DIMENSION(:) :: nbmap_ptr
          
    !                                             !!! CORE bulk parameters
@@ -119 +110 @@
       INTEGER, INTENT(in) ::   kt   ! ocean time step
       !!
-      INTEGER  ::   ierror   ! return error code
-      INTEGER  ::   ifpr     ! dummy loop indice
-      INTEGER  ::   jfld     ! dummy loop arguments
-      !!
-      CHARACTER(len=100) ::  cn_dir   !   Root directory for location of core files
-      TYPE(FLD_N), DIMENSION(jpfld) ::   slf_i     ! array of namelist informations on the fields to read
-      TYPE(FLD_N) ::   sn_wndi, sn_wndj, sn_humi, sn_qsr             ! informations about the fields to be read
-      TYPE(FLD_N) ::   sn_qlw , sn_tair, sn_prec, sn_snow, sn_tdif   !       -                       -
-      NAMELIST/namsbc_core/ cn_dir , ln_2m  , ln_taudif, rn_pfac,           &
-         &                  sn_wndi, sn_wndj, sn_humi  , sn_qsr ,           &
-         &                  sn_qlw , sn_tair, sn_prec  , sn_snow, sn_tdif
+!      NAMELIST/namsbc_core/ cn_dir , ln_2m  , ln_taudif, rn_pfac,           &
+!         &                  sn_wndi, sn_wndj, sn_humi  , sn_qsr ,           &
+!         &                  sn_qlw , sn_tair, sn_prec  , sn_snow, sn_tdif
       !!---------------------------------------------------------------------
 
@@ -135 +118 @@
       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   ! 'yearly' or ! weights  ! rotation !
-         !            !    name    !  (hours)  !  name    !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs    !
-         sn_wndi = FLD_N( 'uwnd10m',    24     , 'u_10'   ,  .false.   , .false. ,   'yearly'  , ''       , ''       )
-         sn_wndj = FLD_N( 'vwnd10m',    24     , 'v_10'   ,  .false.   , .false. ,   'yearly'  , ''       , ''       )
-         sn_qsr  = FLD_N( 'qsw'    ,    24     , 'qsw'    ,  .false.   , .false. ,   'yearly'  , ''       , ''       )
-         sn_qlw  = FLD_N( 'qlw'    ,    24     , 'qlw'    ,  .false.   , .false. ,   'yearly'  , ''       , ''       )
-         sn_tair = FLD_N( 'tair10m',    24     , 't_10'   ,  .false.   , .false. ,   'yearly'  , ''       , ''       )
-         sn_humi = FLD_N( 'humi10m',    24     , 'q_10'   ,  .false.   , .false. ,   'yearly'  , ''       , ''       )
-         sn_prec = FLD_N( 'precip' ,    -1     , 'precip' ,  .true.    , .false. ,   'yearly'  , ''       , ''       )
-         sn_snow = FLD_N( 'snow'   ,    -1     , 'snow'   ,  .true.    , .false. ,   'yearly'  , ''       , ''       )
-         sn_tdif = FLD_N( 'taudif' ,    24     , 'taudif' ,  .true.    , .false. ,   'yearly'  , ''       , ''       )
-         !
-         REWIND( numnam )                          ! read in namlist namsbc_core
-         READ  ( numnam, namsbc_core )
          !                                         ! check: do we plan to use ln_dm2dc with non-daily forcing?
-         IF( ln_dm2dc .AND. sn_qsr%nfreqh /= 24 )   & 
+         IF( ln_dm2dc .AND. sf(jp_qsroce)%nfreqh /= 24 )   & 
             &   CALL ctl_stop( 'sbc_blk_core: ln_dm2dc can be activated only with daily short-wave forcing' ) 
-         IF( ln_dm2dc .AND. sn_qsr%ln_tint ) THEN
+         IF( ln_dm2dc .AND. sf(jp_qsroce)%ln_tint ) THEN
             CALL ctl_warn( 'sbc_blk_core: ln_dm2dc is taking care of the temporal interpolation of daily qsr',   &
                  &         '              ==> We force time interpolation = .false. for qsr' )
-            sn_qsr%ln_tint = .false.
+            sf(jp_qsroce)%ln_tint = .false.
          ENDIF
-         !                                         ! store namelist information in an array
-         slf_i(jp_wndi) = sn_wndi   ;   slf_i(jp_wndj) = sn_wndj
-         slf_i(jp_qsr ) = sn_qsr    ;   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_snow) = sn_snow
-         slf_i(jp_tdif) = sn_tdif
          !                 
          lhftau = ln_taudif                        ! do we use HF tau information?
-         jfld = jpfld - COUNT( (/.NOT. lhftau/) )
-         !
-         ALLOCATE( sf(jfld), STAT=ierror )         ! set sf structure
-         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_blk_core: unable to allocate sf structure' )
-         DO ifpr= 1, jfld
-            ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) )
-            IF( slf_i(ifpr)%ln_tint )   ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) )
-         END DO
-         !                                         ! fill sf with slf_i and control print
-         CALL fld_fill( sf, slf_i, cn_dir, 'sbc_blk_core', 'flux formulation for ocean surface boundary condition', 'namsbc_core' )
          !
          sfx(:,:) = 0._wp                          ! salt flux; zero unless ice is present (computed in limsbc(_2).F90)
          !
       ENDIF
-
-      CALL fld_read( kt, nn_fsbc, sf )             ! input fields provided at the current time-step
-
       !                                            ! compute the surface ocean fluxes using CORE bulk formulea
       IF( MOD( kt - 1, nn_fsbc ) == 0 )   CALL blk_oce_core( kt, sf, sst_m, ssu_m, ssv_m )
@@ -192 +139 @@
       IF( MOD( kt - 1, nn_fsbc ) == 0 )   THEN
          qlw_ice(:,:,1)   = sf(jp_qlw)%fnow(:,:,1) 
-         qsr_ice(:,:,1)   = sf(jp_qsr)%fnow(:,:,1)
+         qsr_ice(:,:,1)   = sf(jp_qsroce)%fnow(:,:,1)
          tatm_ice(:,:)    = sf(jp_tair)%fnow(:,:,1)         
          qatm_ice(:,:)    = sf(jp_humi)%fnow(:,:,1)
@@ -298 +245 @@
       ! ocean albedo assumed to be constant + modify now Qsr to include the diurnal cycle                    ! Short Wave
       zztmp = 1. - albo
-      IF( ln_dm2dc ) THEN   ;   qsr(:,:) = zztmp * sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) * tmask(:,:,1)
-      ELSE                  ;   qsr(:,:) = zztmp *          sf(jp_qsr)%fnow(:,:,1)   * tmask(:,:,1)
+      IF( ln_dm2dc ) THEN   ;   qsr(:,:) = zztmp * sbc_dcy( sf(jp_qsroce)%fnow(:,:,1) ) * tmask(:,:,1)
+      ELSE                  ;   qsr(:,:) = zztmp *          sf(jp_qsroce)%fnow(:,:,1)   * tmask(:,:,1)
       ENDIF
 !CDIR COLLAPSE