New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 3062 for branches/2011/dev_UKM0_2011 – NEMO

Ignore:
Timestamp:
2011-11-09T11:47:32+01:00 (12 years ago)
Author:
rfurner
Message:

ticket #885. added in changes from branches/2011/UKMO_MERCATOR_obc_bdy_merge@2888

Location:
branches/2011/dev_UKM0_2011/NEMOGCM/NEMO/OPA_SRC
Files:
22 edited
14 copied

Legend:

Unmodified
Added
Removed
  • branches/2011/dev_UKM0_2011/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90

    r2528 r3062  
    1818   USE lib_mpp         ! distributed memory computing library 
    1919   USE trabbc          ! bottom boundary condition 
     20   USE obc_par         ! (for lk_obc) 
    2021   USE bdy_par         ! (for lk_bdy) 
    21    USE obc_par         ! (for lk_obc) 
    2222 
    2323   IMPLICIT NONE 
     
    205205      WRITE(numout,*) "dia_hsb: heat salt volume budgets activated" 
    206206      WRITE(numout,*) "~~~~~~~  output written in the 'heat_salt_volume_budgets.txt' ASCII file" 
    207       IF( lk_obc .OR. lk_bdy) THEN 
     207      IF( lk_obc .or. lk_bdy ) THEN 
    208208         CALL ctl_warn( 'dia_hsb does not take open boundary fluxes into account' )          
    209209      ENDIF 
  • branches/2011/dev_UKM0_2011/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90

    r2715 r3062  
    150150   LOGICAL, PUBLIC, PARAMETER ::   lk_vvl = .FALSE.   !: fixed grid flag 
    151151#endif 
    152    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hur  , hvr    !: inverse of u and v-points ocean depth (1/m) 
    153    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hu   , hv     !: depth at u- and v-points (meters) 
    154    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hu_0 , hv_0   !: refernce depth at u- and v-points (meters) 
     152   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET ::   hur  , hvr    !: inverse of u and v-points ocean depth (1/m) 
     153   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   hu   , hv     !: depth at u- and v-points (meters) 
     154   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   hu_0 , hv_0   !: refernce depth at u- and v-points (meters) 
    155155 
    156156   INTEGER, PUBLIC ::   nla10              !: deepest    W level Above  ~10m (nlb10 - 1) 
  • branches/2011/dev_UKM0_2011/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90

    r2715 r3062  
    2525   USE oce             ! ocean dynamics and tracers 
    2626   USE dom_oce         ! ocean space and time domain 
    27    USE obc_oce         ! ocean open boundary conditions 
    2827   USE in_out_manager  ! I/O manager 
    2928   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
  • branches/2011/dev_UKM0_2011/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90

    r2715 r3062  
    2727   USE sbc_oce, ONLY : ln_rnf   ! surface boundary condition: ocean 
    2828   USE sbcrnf          ! river runoff  
    29    USE obc_oce         ! ocean lateral open boundary condition 
    3029   USE cla             ! cross land advection             (cla_div routine) 
    3130   USE in_out_manager  ! I/O manager 
     
    121120         END DO 
    122121 
    123 #if defined key_obc 
    124          IF( Agrif_Root() ) THEN 
    125             ! open boundaries (div must be zero behind the open boundary) 
    126             !  mpp remark: The zeroing of hdivn can probably be extended to 1->jpi/jpj for the correct row/column 
    127             IF( lp_obc_east  )   hdivn(nie0p1:nie1p1,nje0  :nje1  ,jk) = 0.e0      ! east 
    128             IF( lp_obc_west  )   hdivn(niw0  :niw1  ,njw0  :njw1  ,jk) = 0.e0      ! west 
    129             IF( lp_obc_north )   hdivn(nin0  :nin1  ,njn0p1:njn1p1,jk) = 0.e0      ! north 
    130             IF( lp_obc_south )   hdivn(nis0  :nis1  ,njs0  :njs1  ,jk) = 0.e0      ! south 
    131          ENDIF 
    132 #endif          
    133122         IF( .NOT. AGRIF_Root() ) THEN 
    134123            IF ((nbondi ==  1).OR.(nbondi == 2)) hdivn(nlci-1 , :     ,jk) = 0.e0      ! east 
     
    304293         END DO   
    305294 
    306 #if defined key_obc 
    307          IF( Agrif_Root() ) THEN 
    308             ! open boundaries (div must be zero behind the open boundary) 
    309             !  mpp remark: The zeroing of hdivn can probably be extended to 1->jpi/jpj for the correct row/column 
    310             IF( lp_obc_east  )   hdivn(nie0p1:nie1p1,nje0  :nje1  ,jk) = 0.e0      ! east 
    311             IF( lp_obc_west  )   hdivn(niw0  :niw1  ,njw0  :njw1  ,jk) = 0.e0      ! west 
    312             IF( lp_obc_north )   hdivn(nin0  :nin1  ,njn0p1:njn1p1,jk) = 0.e0      ! north 
    313             IF( lp_obc_south )   hdivn(nis0  :nis1  ,njs0  :njs1  ,jk) = 0.e0      ! south 
    314          ENDIF 
    315 #endif          
    316295         IF( .NOT. AGRIF_Root() ) THEN 
    317296            IF ((nbondi ==  1).OR.(nbondi == 2)) hdivn(nlci-1 , :     ,jk) = 0.e0      ! east 
  • branches/2011/dev_UKM0_2011/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90

    r2779 r3062  
    3333   USE obcdyn_bt       ! 2D open boundary condition for momentum (obc_dyn_bt routine) 
    3434   USE obcvol          ! ocean open boundary condition (obc_vol routines) 
    35    USE bdy_oce         ! unstructured open boundary conditions 
    36    USE bdydta          ! unstructured open boundary conditions 
    37    USE bdydyn          ! unstructured open boundary conditions 
     35   USE bdy_oce         ! ocean open boundary conditions 
     36   USE bdydta          ! ocean open boundary conditions 
     37   USE bdydyn          ! ocean open boundary conditions 
     38   USE bdyvol          ! ocean open boundary condition (bdy_vol routines) 
    3839   USE in_out_manager  ! I/O manager 
    3940   USE lbclnk          ! lateral boundary condition (or mpp link) 
     
    7778      !!              * Apply lateral boundary conditions on after velocity  
    7879      !!             at the local domain boundaries through lbc_lnk call, 
    79       !!             at the radiative open boundaries (lk_obc=T), 
    80       !!             at the relaxed   open boundaries (lk_bdy=T), and 
     80      !!             at the one-way open boundaries (lk_obc=T), 
    8181      !!             at the AGRIF zoom     boundaries (lk_agrif=T) 
    8282      !! 
     
    174174      ENDIF 
    175175      ! 
    176 # elif defined key_bdy  
     176# elif defined key_bdy 
    177177      !                                !* BDY open boundaries 
    178       IF( .NOT. lk_dynspg_flt ) THEN 
    179          CALL bdy_dyn_frs( kt ) 
    180 #  if ! defined key_vvl 
    181          ua_e(:,:) = 0.e0 
    182          va_e(:,:) = 0.e0 
    183          ! Set these variables for use in bdy_dyn_fla 
    184          hur_e(:,:) = hur(:,:) 
    185          hvr_e(:,:) = hvr(:,:) 
    186          DO jk = 1, jpkm1   !! Vertically integrated momentum trends 
    187             ua_e(:,:) = ua_e(:,:) + fse3u(:,:,jk) * umask(:,:,jk) * ua(:,:,jk) 
    188             va_e(:,:) = va_e(:,:) + fse3v(:,:,jk) * vmask(:,:,jk) * va(:,:,jk) 
    189          END DO 
    190          ua_e(:,:) = ua_e(:,:) * hur(:,:) 
    191          va_e(:,:) = va_e(:,:) * hvr(:,:) 
    192          DO jk = 1 , jpkm1 
    193             ua(:,:,jk) = ua(:,:,jk) - ua_e(:,:) 
    194             va(:,:,jk) = va(:,:,jk) - va_e(:,:) 
    195          END DO 
    196          CALL bdy_dta_fla( kt+1, 0,2*nn_baro) 
    197          CALL bdy_dyn_fla( sshn_b ) 
    198          CALL lbc_lnk( ua_e, 'U', -1. )   ! Boundary points should be updated 
    199          CALL lbc_lnk( va_e, 'V', -1. )   ! 
    200          DO jk = 1 , jpkm1 
    201             ua(:,:,jk) = ( ua(:,:,jk) + ua_e(:,:) ) * umask(:,:,jk) 
    202             va(:,:,jk) = ( va(:,:,jk) + va_e(:,:) ) * vmask(:,:,jk) 
    203          END DO 
    204 #  endif 
    205       ENDIF 
     178      IF( lk_dynspg_exp ) CALL bdy_dyn( kt ) 
     179      IF( lk_dynspg_ts )  CALL bdy_dyn( kt, dyn3d_only=.true. ) 
     180 
     181!!$   Do we need a call to bdy_vol here?? 
     182      ! 
    206183# endif 
    207184      ! 
  • branches/2011/dev_UKM0_2011/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90

    r2715 r3062  
    1515   USE dom_oce        ! ocean space and time domain variables 
    1616   USE phycst         ! physical constants 
    17    USE obc_oce        ! ocean open boundary conditions 
    1817   USE sbc_oce        ! surface boundary condition: ocean 
    1918   USE sbcapr         ! surface boundary condition: atmospheric pressure 
     
    222221      ENDIF 
    223222 
    224 #if defined key_obc 
    225       !                        ! Conservation of ocean volume (key_dynspg_flt) 
    226       IF( lk_dynspg_flt )   ln_vol_cst = .true. 
    227  
    228       !                        ! Application of Flather's algorithm at open boundaries 
    229       IF( lk_dynspg_flt )   ln_obc_fla = .false. 
    230       IF( lk_dynspg_exp )   ln_obc_fla = .true. 
    231       IF( lk_dynspg_ts  )   ln_obc_fla = .true. 
    232 #endif 
    233223      ! 
    234224   END SUBROUTINE dyn_spg_init 
  • branches/2011/dev_UKM0_2011/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_exp.F90

    r2715 r3062  
    2121   USE phycst          ! physical constants 
    2222   USE obc_par         ! open boundary condition parameters 
    23    USE obcdta          ! open boundary condition data     (obc_dta_bt routine) 
     23   USE obcdta          ! open boundary condition data     (bdy_dta_bt routine) 
    2424   USE in_out_manager  ! I/O manager 
    2525   USE lib_mpp         ! distributed memory computing library 
  • branches/2011/dev_UKM0_2011/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90

    r2715 r3062  
    2626   USE sbc_oce         ! surface boundary condition: ocean 
    2727   USE obc_oce         ! Lateral open boundary condition 
     28   USE bdy_oce         ! Lateral open boundary condition 
    2829   USE sol_oce         ! ocean elliptic solver 
    2930   USE phycst          ! physical constants 
     
    3334   USE solpcg          ! preconditionned conjugate gradient solver 
    3435   USE solsor          ! Successive Over-relaxation solver 
    35    USE obcdyn          ! ocean open boundary condition (obc_dyn routines) 
    36    USE obcvol          ! ocean open boundary condition (obc_vol routines) 
    37    USE bdy_oce         ! Unstructured open boundaries condition 
    38    USE bdydyn          ! Unstructured open boundaries condition (bdy_dyn routine)  
    39    USE bdyvol          ! Unstructured open boundaries condition (bdy_vol routine) 
     36   USE obcdyn          ! ocean open boundary condition on dynamics 
     37   USE obcvol          ! ocean open boundary condition (obc_vol routine) 
     38   USE bdydyn          ! ocean open boundary condition on dynamics 
     39   USE bdyvol          ! ocean open boundary condition (bdy_vol routine) 
    4040   USE cla             ! cross land advection 
    4141   USE in_out_manager  ! I/O manager 
     
    187187#endif 
    188188#if defined key_bdy 
    189       CALL bdy_dyn_frs( kt )       ! Update velocities on unstructured boundary using the Flow Relaxation Scheme 
    190       CALL bdy_vol( kt )           ! Correction of the barotropic component velocity to control the volume of the system 
     189      CALL bdy_dyn( kt )      ! Update velocities on each open boundary 
     190      CALL bdy_vol( kt )      ! Correction of the barotropic component velocity to control the volume of the system 
    191191#endif 
    192192#if defined key_agrif 
     
    304304#if defined key_obc 
    305305            ! caution : grad D = 0 along open boundaries 
     306            ! Remark: The filtering force could be reduced here in the FRS zone 
     307            !         by multiplying spgu/spgv by (1-alpha) ??   
    306308            spgu(ji,jj) = z2dt * ztdgu * obcumask(ji,jj) 
    307309            spgv(ji,jj) = z2dt * ztdgv * obcvmask(ji,jj) 
    308310#elif defined key_bdy 
    309311            ! caution : grad D = 0 along open boundaries 
    310             ! Remark: The filtering force could be reduced here in the FRS zone 
    311             !         by multiplying spgu/spgv by (1-alpha) ??   
    312312            spgu(ji,jj) = z2dt * ztdgu * bdyumask(ji,jj) 
    313             spgv(ji,jj) = z2dt * ztdgv * bdyvmask(ji,jj)            
     313            spgv(ji,jj) = z2dt * ztdgv * bdyvmask(ji,jj) 
    314314#else 
    315315            spgu(ji,jj) = z2dt * ztdgu 
  • branches/2011/dev_UKM0_2011/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_oce.F90

    r2715 r3062  
    3434 
    3535  !                                                                         !!! Time splitting scheme (key_dynspg_ts)  
    36    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshn_e, ssha_e   ! sea surface heigth (now, after, average) 
    37    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ua_e  , va_e     ! barotropic velocities (after) 
    38    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hu_e  , hv_e     ! now ocean depth ( = Ho+sshn_e ) 
    39    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hur_e , hvr_e    ! inverse of hu_e and hv_e 
    40    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshn_b       ! before field without time-filter 
     36   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET ::   sshn_e, ssha_e   ! sea surface heigth (now, after, average) 
     37   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET ::   ua_e  , va_e     ! barotropic velocities (after) 
     38   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   hu_e  , hv_e     ! now ocean depth ( = Ho+sshn_e ) 
     39   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET ::   hur_e , hvr_e    ! inverse of hu_e and hv_e 
     40   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET ::   sshn_b           ! before field without time-filter 
    4141 
    4242   !!---------------------------------------------------------------------- 
  • branches/2011/dev_UKM0_2011/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90

    r2724 r3062  
    2525   USE domvvl          ! variable volume 
    2626   USE zdfbfr          ! bottom friction 
    27    USE obcdta          ! open boundary condition data      
    28    USE obcfla          ! Flather open boundary condition   
    2927   USE dynvor          ! vorticity term 
    3028   USE obc_oce         ! Lateral open boundary condition 
    3129   USE obc_par         ! open boundary condition parameters 
    32    USE bdy_oce         ! unstructured open boundaries 
    33    USE bdy_par         ! unstructured open boundaries 
    34    USE bdydta          ! unstructured open boundaries 
    35    USE bdydyn          ! unstructured open boundaries 
    36    USE bdytides        ! tidal forcing at unstructured open boundaries. 
     30   USE obcdta          ! open boundary condition data      
     31   USE obcfla          ! Flather open boundary condition   
     32   USE bdy_par         ! for lk_bdy 
     33   USE bdy_oce         ! Lateral open boundary condition 
     34   USE bdydta          ! open boundary condition data      
     35   USE bdydyn2d        ! open boundary conditions on barotropic variables 
    3736   USE lib_mpp         ! distributed memory computing library 
    3837   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     
    367366         IF( jn == 1 )   z2dt_e = rdt / nn_baro 
    368367 
    369          !                                                !* Update the forcing (OBC, BDY and tides) 
     368         !                                                !* Update the forcing (BDY and tides) 
    370369         !                                                !  ------------------ 
    371370         IF( lk_obc )   CALL obc_dta_bt ( kt, jn   ) 
    372          IF( lk_bdy )   CALL bdy_dta_fla( kt, jn+1, icycle ) 
     371         IF( lk_bdy )   CALL bdy_dta ( kt, jit=jn, time_offset=+1 ) 
    373372 
    374373         !                                                !* after ssh_e 
     
    489488         !                                                !* domain lateral boundary 
    490489         !                                                !  ----------------------- 
    491          !                                                      ! Flather's boundary condition for the barotropic loop : 
    492          !                                                      !         - Update sea surface height on each open boundary 
    493          !                                                      !         - Correct the velocity 
    494  
     490 
     491                                                               ! OBC open boundaries 
    495492         IF( lk_obc               )   CALL obc_fla_ts ( ua_e, va_e, sshn_e, ssha_e ) 
    496          IF( lk_bdy .OR. ln_tides )   CALL bdy_dyn_fla( sshn_e )  
     493 
     494                                                               ! BDY open boundaries 
     495#if defined key_bdy 
     496         pssh => sshn_e 
     497         phur => hur_e 
     498         phvr => hvr_e 
     499         pu2d => ua_e 
     500         pv2d => va_e 
     501 
     502         IF( lk_bdy )   CALL bdy_dyn2d( kt )  
     503#endif 
     504 
    497505         ! 
    498506         CALL lbc_lnk( ua_e  , 'U', -1. )                      ! local domain boundaries  
  • branches/2011/dev_UKM0_2011/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90

    r2715 r3062  
    182182#if defined key_bdy 
    183183      ssha(:,:) = ssha(:,:) * bdytmask(:,:) 
    184       CALL lbc_lnk( ssha, 'T', 1. )  
     184      CALL lbc_lnk( ssha, 'T', 1. )                 ! absolutly compulsory !! (jmm) 
    185185#endif 
    186186 
  • branches/2011/dev_UKM0_2011/NEMOGCM/NEMO/OPA_SRC/FLO/floblk.F90

    r2715 r3062  
    345345      ! more time.       
    346346# if defined key_obc 
    347       DO jfl = 1, jpnfl 
    348          IF( lp_obc_east ) THEN 
    349             IF( jped <=  zgjfl(jfl) .AND. zgjfl(jfl) <= jpef .AND. nieob-1 <=  zgifl(jfl) ) THEN 
    350                zgifl (jfl) = INT(zgifl(jfl)) + 0.5 
    351                zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5 
    352                zagefl(jfl) = rdt 
    353             END IF 
    354          END IF 
    355          IF( lp_obc_west ) THEN 
    356             IF( jpwd <= zgjfl(jfl) .AND. zgjfl(jfl) <= jpwf .AND. niwob >=  zgifl(jfl) ) THEN 
    357                zgifl (jfl) = INT(zgifl(jfl)) + 0.5 
    358                zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5 
    359                zagefl(jfl) = rdt 
    360             END IF 
    361          END IF 
    362          IF( lp_obc_north ) THEN 
    363             IF( jpnd <=  zgifl(jfl) .AND. zgifl(jfl) <= jpnf .AND. njnob-1 >=  zgjfl(jfl) ) THEN 
    364                zgifl (jfl) = INT(zgifl(jfl)) + 0.5 
    365                zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5 
    366                zagefl(jfl) = rdt 
    367             END IF 
    368          END IF 
    369          IF( lp_obc_south ) THEN 
    370             IF( jpsd <=  zgifl(jfl) .AND. zgifl(jfl) <= jpsf .AND.  njsob >= zgjfl(jfl) ) THEN 
    371                zgifl (jfl) = INT(zgifl(jfl)) + 0.5 
    372                zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5 
    373                zagefl(jfl) = rdt 
    374             END IF 
    375          END IF 
    376       END DO 
     347!!!!!!!! NEED TO SORT THIS OUT !!!!!!!! 
     348!!$      DO jfl = 1, jpnfl 
     349!!$         IF( lp_obc_east ) THEN 
     350!!$            IF( jped <=  zgjfl(jfl) .AND. zgjfl(jfl) <= jpef .AND. nieob-1 <=  zgifl(jfl) ) THEN 
     351!!$               zgifl (jfl) = INT(zgifl(jfl)) + 0.5 
     352!!$               zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5 
     353!!$               zagefl(jfl) = rdt 
     354!!$            END IF 
     355!!$         END IF 
     356!!$         IF( lp_obc_west ) THEN 
     357!!$            IF( jpwd <= zgjfl(jfl) .AND. zgjfl(jfl) <= jpwf .AND. niwob >=  zgifl(jfl) ) THEN 
     358!!$               zgifl (jfl) = INT(zgifl(jfl)) + 0.5 
     359!!$               zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5 
     360!!$               zagefl(jfl) = rdt 
     361!!$            END IF 
     362!!$         END IF 
     363!!$         IF( lp_obc_north ) THEN 
     364!!$            IF( jpnd <=  zgifl(jfl) .AND. zgifl(jfl) <= jpnf .AND. njnob-1 >=  zgjfl(jfl) ) THEN 
     365!!$               zgifl (jfl) = INT(zgifl(jfl)) + 0.5 
     366!!$               zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5 
     367!!$               zagefl(jfl) = rdt 
     368!!$            END IF 
     369!!$         END IF 
     370!!$         IF( lp_obc_south ) THEN 
     371!!$            IF( jpsd <=  zgifl(jfl) .AND. zgifl(jfl) <= jpsf .AND.  njsob >= zgjfl(jfl) ) THEN 
     372!!$               zgifl (jfl) = INT(zgifl(jfl)) + 0.5 
     373!!$               zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5 
     374!!$               zagefl(jfl) = rdt 
     375!!$            END IF 
     376!!$         END IF 
     377!!$      END DO 
    377378#endif 
    378379 
  • branches/2011/dev_UKM0_2011/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r2731 r3062  
    4747   !!   mppsync       : 
    4848   !!   mppstop       : 
    49    !!   mppobc        : variant of mpp_lnk for open boundary condition 
    5049   !!   mpp_ini_north : initialisation of north fold 
    5150   !!   mpp_lbc_north : north fold processors gathering 
     
    6463   PUBLIC   mpp_min, mpp_max, mpp_sum, mpp_minloc, mpp_maxloc 
    6564   PUBLIC   mpp_lnk_3d, mpp_lnk_3d_gather, mpp_lnk_2d, mpp_lnk_2d_e 
    66    PUBLIC   mppobc, mpp_ini_ice, mpp_ini_znl 
     65   PUBLIC   mpp_ini_ice, mpp_ini_znl 
    6766   PUBLIC   mppsize 
    6867   PUBLIC   lib_mpp_alloc   ! Called in nemogcm.F90 
     
    17261725   END SUBROUTINE mppstop 
    17271726 
    1728  
    1729    SUBROUTINE mppobc( ptab, kd1, kd2, kl, kk, ktype, kij , kumout) 
    1730       !!---------------------------------------------------------------------- 
    1731       !!                  ***  routine mppobc  *** 
    1732       !!  
    1733       !! ** Purpose :   Message passing manadgement for open boundary 
    1734       !!     conditions array 
    1735       !! 
    1736       !! ** Method  :   Use mppsend and mpprecv function for passing mask 
    1737       !!       between processors following neighboring subdomains. 
    1738       !!       domain parameters 
    1739       !!                    nlci   : first dimension of the local subdomain 
    1740       !!                    nlcj   : second dimension of the local subdomain 
    1741       !!                    nbondi : mark for "east-west local boundary" 
    1742       !!                    nbondj : mark for "north-south local boundary" 
    1743       !!                    noea   : number for local neighboring processors  
    1744       !!                    nowe   : number for local neighboring processors 
    1745       !!                    noso   : number for local neighboring processors 
    1746       !!                    nono   : number for local neighboring processors 
    1747       !! 
    1748       !!---------------------------------------------------------------------- 
    1749       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    1750       USE wrk_nemo, ONLY:   ztab => wrk_2d_1 
    1751       ! 
    1752       INTEGER , INTENT(in   )                     ::   kd1, kd2   ! starting and ending indices 
    1753       INTEGER , INTENT(in   )                     ::   kl         ! index of open boundary 
    1754       INTEGER , INTENT(in   )                     ::   kk         ! vertical dimension 
    1755       INTEGER , INTENT(in   )                     ::   ktype      ! define north/south or east/west cdt 
    1756       !                                                           !  = 1  north/south  ;  = 2  east/west 
    1757       INTEGER , INTENT(in   )                     ::   kij        ! horizontal dimension 
    1758       INTEGER , INTENT(in   )                     ::   kumout     ! ocean.output logical unit 
    1759       REAL(wp), INTENT(inout), DIMENSION(kij,kk)  ::   ptab       ! variable array 
    1760       ! 
    1761       INTEGER ::   ji, jj, jk, jl        ! dummy loop indices 
    1762       INTEGER ::   iipt0, iipt1, ilpt1   ! local integers 
    1763       INTEGER ::   ijpt0, ijpt1          !   -       - 
    1764       INTEGER ::   imigr, iihom, ijhom   !   -       - 
    1765       INTEGER ::   ml_req1, ml_req2, ml_err    ! for key_mpi_isend 
    1766       INTEGER ::   ml_stat(MPI_STATUS_SIZE)    ! for key_mpi_isend 
    1767       !!---------------------------------------------------------------------- 
    1768  
    1769       IF( wrk_in_use(2, 1) ) THEN 
    1770          WRITE(kumout, cform_err) 
    1771          WRITE(kumout,*) 'mppobc : requested workspace array unavailable' 
    1772          CALL mppstop 
    1773       ENDIF 
    1774  
    1775       ! boundary condition initialization 
    1776       ! --------------------------------- 
    1777       ztab(:,:) = 0.e0 
    1778       ! 
    1779       IF( ktype==1 ) THEN                                  ! north/south boundaries 
    1780          iipt0 = MAX( 1, MIN(kd1 - nimpp+1, nlci     ) ) 
    1781          iipt1 = MAX( 0, MIN(kd2 - nimpp+1, nlci - 1 ) ) 
    1782          ilpt1 = MAX( 1, MIN(kd2 - nimpp+1, nlci     ) ) 
    1783          ijpt0 = MAX( 1, MIN(kl  - njmpp+1, nlcj     ) ) 
    1784          ijpt1 = MAX( 0, MIN(kl  - njmpp+1, nlcj - 1 ) ) 
    1785       ELSEIF( ktype==2 ) THEN                              ! east/west boundaries 
    1786          iipt0 = MAX( 1, MIN(kl  - nimpp+1, nlci     ) ) 
    1787          iipt1 = MAX( 0, MIN(kl  - nimpp+1, nlci - 1 ) ) 
    1788          ijpt0 = MAX( 1, MIN(kd1 - njmpp+1, nlcj     ) ) 
    1789          ijpt1 = MAX( 0, MIN(kd2 - njmpp+1, nlcj - 1 ) ) 
    1790          ilpt1 = MAX( 1, MIN(kd2 - njmpp+1, nlcj     ) ) 
    1791       ELSE 
    1792          WRITE(kumout, cform_err) 
    1793          WRITE(kumout,*) 'mppobc : bad ktype' 
    1794          CALL mppstop 
    1795       ENDIF 
    1796        
    1797       ! Communication level by level 
    1798       ! ---------------------------- 
    1799 !!gm Remark : this is very time consumming!!! 
    1800       !                                         ! ------------------------ ! 
    1801       DO jk = 1, kk                             !   Loop over the levels   ! 
    1802          !                                      ! ------------------------ ! 
    1803          ! 
    1804          IF( ktype == 1 ) THEN                               ! north/south boundaries 
    1805             DO jj = ijpt0, ijpt1 
    1806                DO ji = iipt0, iipt1 
    1807                   ztab(ji,jj) = ptab(ji,jk) 
    1808                END DO 
    1809             END DO 
    1810          ELSEIF( ktype == 2 ) THEN                           ! east/west boundaries 
    1811             DO jj = ijpt0, ijpt1 
    1812                DO ji = iipt0, iipt1 
    1813                   ztab(ji,jj) = ptab(jj,jk) 
    1814                END DO 
    1815             END DO 
    1816          ENDIF 
    1817  
    1818  
    1819          ! 1. East and west directions 
    1820          ! --------------------------- 
    1821          ! 
    1822          IF( nbondi /= 2 ) THEN         ! Read Dirichlet lateral conditions 
    1823             iihom = nlci-nreci 
    1824             DO jl = 1, jpreci 
    1825                t2ew(:,jl,1) = ztab(jpreci+jl,:) 
    1826                t2we(:,jl,1) = ztab(iihom +jl,:) 
    1827             END DO 
    1828          ENDIF 
    1829          ! 
    1830          !                              ! Migrations 
    1831          imigr=jpreci*jpj 
    1832          ! 
    1833          IF( nbondi == -1 ) THEN 
    1834             CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 ) 
    1835             CALL mpprecv( 1, t2ew(1,1,2), imigr ) 
    1836             IF(l_isend)   CALL mpi_wait( ml_req1, ml_stat, ml_err ) 
    1837          ELSEIF( nbondi == 0 ) THEN 
    1838             CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 ) 
    1839             CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req2 ) 
    1840             CALL mpprecv( 1, t2ew(1,1,2), imigr ) 
    1841             CALL mpprecv( 2, t2we(1,1,2), imigr ) 
    1842             IF(l_isend)   CALL mpi_wait( ml_req1, ml_stat, ml_err ) 
    1843             IF(l_isend)   CALL mpi_wait( ml_req2, ml_stat, ml_err ) 
    1844          ELSEIF( nbondi == 1 ) THEN 
    1845             CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 ) 
    1846             CALL mpprecv( 2, t2we(1,1,2), imigr ) 
    1847             IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 
    1848          ENDIF 
    1849          ! 
    1850          !                              ! Write Dirichlet lateral conditions 
    1851          iihom = nlci-jpreci 
    1852          ! 
    1853          IF( nbondi == 0 .OR. nbondi == 1 ) THEN 
    1854             DO jl = 1, jpreci 
    1855                ztab(jl,:) = t2we(:,jl,2) 
    1856             END DO 
    1857          ENDIF 
    1858          IF( nbondi == -1 .OR. nbondi == 0 ) THEN 
    1859             DO jl = 1, jpreci 
    1860                ztab(iihom+jl,:) = t2ew(:,jl,2) 
    1861             END DO 
    1862          ENDIF 
    1863  
    1864  
    1865          ! 2. North and south directions 
    1866          ! ----------------------------- 
    1867          ! 
    1868          IF( nbondj /= 2 ) THEN         ! Read Dirichlet lateral conditions 
    1869             ijhom = nlcj-nrecj 
    1870             DO jl = 1, jprecj 
    1871                t2sn(:,jl,1) = ztab(:,ijhom +jl) 
    1872                t2ns(:,jl,1) = ztab(:,jprecj+jl) 
    1873             END DO 
    1874          ENDIF 
    1875          ! 
    1876          !                              ! Migrations 
    1877          imigr = jprecj * jpi 
    1878          ! 
    1879          IF( nbondj == -1 ) THEN 
    1880             CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req1 ) 
    1881             CALL mpprecv( 3, t2ns(1,1,2), imigr ) 
    1882             IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 
    1883          ELSEIF( nbondj == 0 ) THEN 
    1884             CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 ) 
    1885             CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req2 ) 
    1886             CALL mpprecv( 3, t2ns(1,1,2), imigr ) 
    1887             CALL mpprecv( 4, t2sn(1,1,2), imigr ) 
    1888             IF( l_isend )   CALL mpi_wait( ml_req1, ml_stat, ml_err ) 
    1889             IF( l_isend )   CALL mpi_wait( ml_req2, ml_stat, ml_err ) 
    1890          ELSEIF( nbondj == 1 ) THEN 
    1891             CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 ) 
    1892             CALL mpprecv( 4, t2sn(1,1,2), imigr) 
    1893             IF( l_isend )   CALL mpi_wait( ml_req1, ml_stat, ml_err ) 
    1894          ENDIF 
    1895          ! 
    1896          !                              ! Write Dirichlet lateral conditions 
    1897          ijhom = nlcj - jprecj 
    1898          IF( nbondj == 0 .OR. nbondj == 1 ) THEN 
    1899             DO jl = 1, jprecj 
    1900                ztab(:,jl) = t2sn(:,jl,2) 
    1901             END DO 
    1902          ENDIF 
    1903          IF( nbondj == 0 .OR. nbondj == -1 ) THEN 
    1904             DO jl = 1, jprecj 
    1905                ztab(:,ijhom+jl) = t2ns(:,jl,2) 
    1906             END DO 
    1907          ENDIF 
    1908          IF( ktype==1 .AND. kd1 <= jpi+nimpp-1 .AND. nimpp <= kd2 ) THEN 
    1909             DO jj = ijpt0, ijpt1            ! north/south boundaries 
    1910                DO ji = iipt0,ilpt1 
    1911                   ptab(ji,jk) = ztab(ji,jj)   
    1912                END DO 
    1913             END DO 
    1914          ELSEIF( ktype==2 .AND. kd1 <= jpj+njmpp-1 .AND. njmpp <= kd2 ) THEN 
    1915             DO jj = ijpt0, ilpt1            ! east/west boundaries 
    1916                DO ji = iipt0,iipt1 
    1917                   ptab(jj,jk) = ztab(ji,jj)  
    1918                END DO 
    1919             END DO 
    1920          ENDIF 
    1921          ! 
    1922       END DO 
    1923       ! 
    1924       IF( wrk_not_released(2, 1) ) THEN 
    1925          WRITE(kumout, cform_err) 
    1926          WRITE(kumout,*) 'mppobc : failed to release workspace array' 
    1927          CALL mppstop 
    1928       ENDIF 
    1929       ! 
    1930    END SUBROUTINE mppobc 
    1931     
    1932  
    19331727   SUBROUTINE mpp_comm_free( kcom ) 
    19341728      !!---------------------------------------------------------------------- 
     
    24882282      MODULE PROCEDURE mppmin_a_int, mppmin_int, mppmin_a_real, mppmin_real 
    24892283   END INTERFACE 
    2490    INTERFACE mppobc 
    2491       MODULE PROCEDURE mppobc_1d, mppobc_2d, mppobc_3d, mppobc_4d 
    2492    END INTERFACE 
    24932284   INTERFACE mpp_minloc 
    24942285      MODULE PROCEDURE mpp_minloc2d ,mpp_minloc3d 
     
    26032394      WRITE(*,*) 'mppmin_int: You should not have seen this print! error?', kint, kcom 
    26042395   END SUBROUTINE mppmin_int 
    2605  
    2606    SUBROUTINE mppobc_1d( parr, kd1, kd2, kl, kk, ktype, kij, knum ) 
    2607       INTEGER  ::   kd1, kd2, kl , kk, ktype, kij, knum 
    2608       REAL, DIMENSION(:) ::   parr           ! variable array 
    2609       WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1), kd1, kd2, kl, kk, ktype, kij, knum 
    2610    END SUBROUTINE mppobc_1d 
    2611  
    2612    SUBROUTINE mppobc_2d( parr, kd1, kd2, kl, kk, ktype, kij, knum ) 
    2613       INTEGER  ::   kd1, kd2, kl , kk, ktype, kij, knum 
    2614       REAL, DIMENSION(:,:) ::   parr           ! variable array 
    2615       WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1,1), kd1, kd2, kl, kk, ktype, kij, knum 
    2616    END SUBROUTINE mppobc_2d 
    2617  
    2618    SUBROUTINE mppobc_3d( parr, kd1, kd2, kl, kk, ktype, kij, knum ) 
    2619       INTEGER  ::   kd1, kd2, kl , kk, ktype, kij, knum 
    2620       REAL, DIMENSION(:,:,:) ::   parr           ! variable array 
    2621       WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1,1,1), kd1, kd2, kl, kk, ktype, kij, knum 
    2622    END SUBROUTINE mppobc_3d 
    2623  
    2624    SUBROUTINE mppobc_4d( parr, kd1, kd2, kl, kk, ktype, kij, knum ) 
    2625       INTEGER  ::   kd1, kd2, kl , kk, ktype, kij, knum 
    2626       REAL, DIMENSION(:,:,:,:) ::   parr           ! variable array 
    2627       WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1,1,1,1), kd1, kd2, kl, kk, ktype, kij, knum 
    2628    END SUBROUTINE mppobc_4d 
    26292396 
    26302397   SUBROUTINE mpp_minloc2d( ptab, pmask, pmin, ki, kj ) 
  • branches/2011/dev_UKM0_2011/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90

    r2777 r3062  
    2424   IMPLICIT NONE 
    2525   PRIVATE    
     26  
     27   PUBLIC   fld_map    ! routine called by tides_init 
    2628 
    2729   TYPE, PUBLIC ::   FLD_N      !: Namelist field informations 
     
    5658      LOGICAL                         ::   rotn         ! flag to indicate whether field has been rotated 
    5759   END TYPE FLD 
     60 
     61   TYPE, PUBLIC ::   MAP_POINTER      !: Array of integer pointers to 1D arrays 
     62      INTEGER, POINTER   ::  ptr(:) 
     63   END TYPE MAP_POINTER 
    5864 
    5965!$AGRIF_DO_NOT_TREAT 
     
    98104CONTAINS 
    99105 
    100    SUBROUTINE fld_read( kt, kn_fsbc, sd ) 
     106   SUBROUTINE fld_read( kt, kn_fsbc, sd, map, jit, time_offset ) 
    101107      !!--------------------------------------------------------------------- 
    102108      !!                    ***  ROUTINE fld_read  *** 
     
    113119      INTEGER  , INTENT(in   )               ::   kn_fsbc   ! sbc computation period (in time step)  
    114120      TYPE(FLD), INTENT(inout), DIMENSION(:) ::   sd        ! input field related variables 
     121      TYPE(MAP_POINTER),INTENT(in), OPTIONAL, DIMENSION(:) ::   map   ! global-to-local mapping index 
     122      INTEGER  , INTENT(in   ), OPTIONAL     ::   jit       ! subcycle timestep for timesplitting option 
     123      INTEGER  , INTENT(in   ), OPTIONAL     ::   time_offset ! provide fields at time other than "now" 
     124                                                              ! time_offset = -1 => fields at "before" time level 
     125                                                              ! time_offset = +1 => fields at "after" time levels 
     126                                                              ! etc. 
    115127      !! 
    116128      INTEGER  ::   imf        ! size of the structure sd 
     
    119131      INTEGER  ::   isecend    ! number of second since Jan. 1st 00h of nit000 year at nitend 
    120132      INTEGER  ::   isecsbc    ! number of seconds between Jan. 1st 00h of nit000 year and the middle of sbc time step 
     133      INTEGER  ::   time_add   ! local time_offset variable 
    121134      LOGICAL  ::   llnxtyr    ! open next year  file? 
    122135      LOGICAL  ::   llnxtmth   ! open next month file? 
    123136      LOGICAL  ::   llstop     ! stop is the file does not exist 
     137      LOGICAL  ::   ll_firstcall ! true if this is the first call to fld_read for this set of fields 
    124138      REAL(wp) ::   ztinta     ! ratio applied to after  records when doing time interpolation 
    125139      REAL(wp) ::   ztintb     ! ratio applied to before records when doing time interpolation 
    126140      CHARACTER(LEN=1000) ::   clfmt   ! write format 
    127141      !!--------------------------------------------------------------------- 
     142      ll_firstcall = .false. 
     143      IF( PRESENT(jit) ) THEN 
     144         IF(kt == nit000 .and. jit == 1) ll_firstcall = .true. 
     145      ELSE 
     146         IF(kt == nit000) ll_firstcall = .true. 
     147      ENDIF 
     148 
     149      time_add = 0 
     150      IF( PRESENT(time_offset) ) THEN 
     151         time_add = time_offset 
     152      ENDIF 
     153          
    128154      ! Note that shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar  
    129       isecsbc = nsec_year + nsec1jan000 + NINT(0.5 * REAL(kn_fsbc - 1,wp) * rdttra(1))   ! middle of sbc time step 
     155      IF( present(jit) ) THEN  
     156         ! ignore kn_fsbc in this case 
     157         isecsbc = nsec_year + nsec1jan000 + (jit+time_add)*rdt/REAL(nn_baro,wp)  
     158      ELSE 
     159         isecsbc = nsec_year + nsec1jan000 + NINT(0.5 * REAL(kn_fsbc - 1,wp) * rdttra(1)) + time_add * rdttra(1)  ! middle of sbc time step 
     160      ENDIF 
    130161      imf = SIZE( sd ) 
    131162      ! 
    132       IF( kt == nit000 ) THEN                      ! initialization 
    133          DO jf = 1, imf  
    134             CALL fld_init( kn_fsbc, sd(jf) )       ! read each before field (put them in after as they will be swapped) 
    135          END DO 
     163      IF( ll_firstcall ) THEN                      ! initialization 
     164         IF( PRESENT(map) ) THEN 
     165            DO jf = 1, imf  
     166               CALL fld_init( kn_fsbc, sd(jf), map(jf)%ptr )  ! read each before field (put them in after as they will be swapped) 
     167            END DO 
     168         ELSE 
     169            DO jf = 1, imf  
     170               CALL fld_init( kn_fsbc, sd(jf) )       ! read each before field (put them in after as they will be swapped) 
     171            END DO 
     172         ENDIF 
    136173         IF( lwp ) CALL wgt_print()                ! control print 
    137174         CALL fld_rot( kt, sd )                    ! rotate vector fiels if needed 
     
    143180         DO jf = 1, imf                            ! ---   loop over field   --- ! 
    144181             
    145             IF( isecsbc > sd(jf)%nrec_a(2) .OR. kt == nit000 ) THEN  ! read/update the after data? 
     182            IF( isecsbc > sd(jf)%nrec_a(2) .OR. ll_firstcall ) THEN  ! read/update the after data? 
    146183 
    147184               IF( sd(jf)%ln_tint ) THEN                             ! swap before record field and informations 
     
    151188               ENDIF 
    152189 
    153                CALL fld_rec( kn_fsbc, sd(jf) )                       ! update record informations 
     190               IF( PRESENT(jit) ) THEN 
     191                  CALL fld_rec( kn_fsbc, sd(jf), jit=jit )              ! update record informations 
     192               ELSE 
     193                  CALL fld_rec( kn_fsbc, sd(jf) )                       ! update record informations 
     194               ENDIF 
    154195 
    155196               ! do we have to change the year/month/week/day of the forcing field??  
     
    212253 
    213254               ! read after data 
    214                CALL fld_get( sd(jf) ) 
     255               IF( PRESENT(map) ) THEN 
     256                  CALL fld_get( sd(jf), map(jf)%ptr ) 
     257               ELSE 
     258                  CALL fld_get( sd(jf) ) 
     259               ENDIF 
    215260 
    216261            ENDIF 
     
    225270                  clfmt = "('fld_read: var ', a, ' kt = ', i8, ' (', f7.2,' days), Y/M/D = ', i4.4,'/', i2.2,'/', i2.2," //   & 
    226271                     &    "', records b/a: ', i4.4, '/', i4.4, ' (days ', f7.2,'/', f7.2, ')')" 
    227                   WRITE(numout, clfmt)  TRIM( sd(jf)%clvar ), kt, REAL(isecsbc,wp)/rday, nyear, nmonth, nday,   & 
     272                  WRITE(numout, clfmt)  TRIM( sd(jf)%clvar ), kt, REAL(isecsbc,wp)/rday, nyear, nmonth, nday,   &             
    228273                     & sd(jf)%nrec_b(1), sd(jf)%nrec_a(1), REAL(sd(jf)%nrec_b(2),wp)/rday, REAL(sd(jf)%nrec_a(2),wp)/rday 
     274                  WRITE(numout, *) 'time_add is : ',time_add 
    229275               ENDIF 
    230276               ! temporal interpolation weights 
     
    253299 
    254300 
    255    SUBROUTINE fld_init( kn_fsbc, sdjf ) 
     301   SUBROUTINE fld_init( kn_fsbc, sdjf, map ) 
    256302      !!--------------------------------------------------------------------- 
    257303      !!                    ***  ROUTINE fld_init  *** 
     
    262308      INTEGER  , INTENT(in   ) ::   kn_fsbc   ! sbc computation period (in time step)  
    263309      TYPE(FLD), INTENT(inout) ::   sdjf      ! input field related variables 
     310      INTEGER  , INTENT(in), OPTIONAL, DIMENSION(:) :: map ! global-to-local mapping indices 
    264311      !! 
    265312      LOGICAL :: llprevyr              ! are we reading previous year  file? 
     
    364411 
    365412         ! read before data  
    366          CALL fld_get( sdjf )  ! read before values in after arrays(as we will swap it later) 
     413         IF( PRESENT(map) ) THEN 
     414            CALL fld_get( sdjf, map )  ! read before values in after arrays(as we will swap it later) 
     415         ELSE 
     416            CALL fld_get( sdjf )  ! read before values in after arrays(as we will swap it later) 
     417         ENDIF 
    367418 
    368419         clfmt = "('fld_init : time-interpolation for ', a, ' read previous record = ', i4, ' at time = ', f7.2, ' days')" 
     
    396447 
    397448 
    398    SUBROUTINE fld_rec( kn_fsbc, sdjf, ldbefore ) 
     449   SUBROUTINE fld_rec( kn_fsbc, sdjf, ldbefore, jit ) 
    399450      !!--------------------------------------------------------------------- 
    400451      !!                    ***  ROUTINE fld_rec  *** 
     
    410461      TYPE(FLD), INTENT(inout)           ::   sdjf      ! input field related variables 
    411462      LOGICAL  , INTENT(in   ), OPTIONAL ::   ldbefore  ! sent back before record values (default = .FALSE.) 
     463      INTEGER  , INTENT(in   ), OPTIONAL ::   jit       ! index of barotropic subcycle 
    412464                                                        ! used only if sdjf%ln_tint = .TRUE. 
    413465      !! 
     
    443495            !                             
    444496            ztmp = REAL( nday, wp ) / REAL( nyear_len(1), wp ) + 0.5 
     497            IF( PRESENT(jit) ) ztmp = ztmp + jit*rdt/REAL(nn_baro,wp) 
    445498            sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/)) 
    446499            ! swap at the middle of the year 
     
    471524            !                             
    472525            ztmp = REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) + 0.5 
     526            IF( PRESENT(jit) ) ztmp = ztmp + jit*rdt/REAL(nn_baro,wp) 
    473527            imth = nmonth + INT( ztmp ) - COUNT((/llbefore/)) 
    474528            IF( sdjf%cltype == 'monthly' ) THEN   ;   sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/)) 
     
    498552         ztmp = ztmp + 0.5 * REAL(kn_fsbc - 1, wp) * rdttra(1)   ! shift time to be centrered in the middle of sbc time step 
    499553         ztmp = ztmp + 0.01 * rdttra(1)                          ! add 0.01 time step to avoid truncation error  
     554         IF( PRESENT(jit) ) ztmp = ztmp + jit*rdt/REAL(nn_baro,wp) 
    500555         IF( sdjf%ln_tint ) THEN                ! time interpolation, shift by 1/2 record 
    501556            ! 
     
    546601 
    547602 
    548    SUBROUTINE fld_get( sdjf ) 
    549       !!--------------------------------------------------------------------- 
    550       !!                    ***  ROUTINE fld_clopn  *** 
     603   SUBROUTINE fld_get( sdjf, map ) 
     604      !!--------------------------------------------------------------------- 
     605      !!                    ***  ROUTINE fld_get  *** 
    551606      !! 
    552607      !! ** Purpose :   read the data 
    553608      !!---------------------------------------------------------------------- 
    554609      TYPE(FLD), INTENT(inout) ::   sdjf   ! input field related variables 
     610      INTEGER  , INTENT(in), OPTIONAL, DIMENSION(:) :: map ! global-to-local mapping indices 
    555611      !! 
    556612      INTEGER                  ::   ipk    ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk ) 
     
    559615             
    560616      ipk = SIZE( sdjf%fnow, 3 ) 
    561       IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN 
     617 
     618      IF( PRESENT(map) ) THEN 
     619         IF( sdjf%ln_tint ) THEN   ;   CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1), map ) 
     620         ELSE                      ;   CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fnow(:,:,:  ), sdjf%nrec_a(1), map ) 
     621         ENDIF 
     622      ELSE IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN 
    562623         CALL wgt_list( sdjf, iw ) 
    563624         IF( sdjf%ln_tint ) THEN   ;   CALL fld_interp( sdjf%num, sdjf%clvar, iw , ipk  , sdjf%fdta(:,:,:,2), sdjf%nrec_a(1) ) 
     
    581642   END SUBROUTINE fld_get 
    582643 
     644   SUBROUTINE fld_map( num, clvar, dta, nrec, map ) 
     645      !!--------------------------------------------------------------------- 
     646      !!                    ***  ROUTINE fld_get  *** 
     647      !! 
     648      !! ** Purpose :   read global data from file and map onto local data 
     649      !!                using a general mapping (for open boundaries) 
     650      !!---------------------------------------------------------------------- 
     651#if defined key_bdy 
     652      USE bdy_oce, ONLY:  dta_global         ! workspace to read in global data arrays 
     653#endif  
     654 
     655      INTEGER                   , INTENT(in ) ::   num     ! stream number 
     656      CHARACTER(LEN=*)          , INTENT(in ) ::   clvar   ! variable name 
     657      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   dta   ! output field on model grid (2 dimensional) 
     658      INTEGER                   , INTENT(in ) ::   nrec    ! record number to read (ie time slice) 
     659      INTEGER,  DIMENSION(:)    , INTENT(in ) ::   map     ! global-to-local mapping indices 
     660      !! 
     661      INTEGER                                 ::   ipi      ! length of boundary data on local process 
     662      INTEGER                                 ::   ipj      ! length of dummy dimension ( = 1 ) 
     663      INTEGER                                 ::   ipk      ! number of vertical levels of dta ( 2D: ipk=1 ; 3D: ipk=jpk ) 
     664      INTEGER                                 ::   ilendta  ! length of data in file 
     665      INTEGER                                 ::   idvar    ! variable ID 
     666      INTEGER                                 ::   ib, ik   ! loop counters 
     667      INTEGER                                 ::   ierr 
     668      REAL(wp), POINTER, DIMENSION(:,:,:)     ::   dta_read ! work space for global data 
     669      !!--------------------------------------------------------------------- 
     670             
     671#if defined key_bdy 
     672      dta_read => dta_global 
     673#endif 
     674 
     675      ipi = SIZE( dta, 1 ) 
     676      ipj = 1 
     677      ipk = SIZE( dta, 3 ) 
     678 
     679      idvar   = iom_varid( num, clvar ) 
     680      ilendta = iom_file(num)%dimsz(1,idvar) 
     681      IF(lwp) WRITE(numout,*) 'Dim size for ',TRIM(clvar),' is ', ilendta 
     682      IF(lwp) WRITE(numout,*) 'Number of levels for ',TRIM(clvar),' is ', ipk 
     683 
     684      SELECT CASE( ipk ) 
     685      CASE(1)    
     686         CALL iom_get ( num, jpdom_unknown, clvar, dta_read(1:ilendta,1:ipj,1    ), nrec ) 
     687      CASE DEFAULT 
     688         CALL iom_get ( num, jpdom_unknown, clvar, dta_read(1:ilendta,1:ipj,1:ipk), nrec ) 
     689      END SELECT 
     690      ! 
     691      DO ib = 1, ipi 
     692         DO ik = 1, ipk 
     693            dta(ib,1,ik) =  dta_read(map(ib),1,ik) 
     694         END DO 
     695      END DO 
     696 
     697   END SUBROUTINE fld_map 
     698 
    583699 
    584700   SUBROUTINE fld_rot( kt, sd ) 
    585701      !!--------------------------------------------------------------------- 
    586       !!                    ***  ROUTINE fld_clopn  *** 
     702      !!                    ***  ROUTINE fld_rot  *** 
    587703      !! 
    588704      !! ** Purpose :   Vector fields may need to be rotated onto the local grid direction 
    589705      !!---------------------------------------------------------------------- 
    590706      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    591       USE wrk_nemo, ONLY: utmp => wrk_2d_4, vtmp => wrk_2d_5      ! 2D workspace 
     707      USE wrk_nemo, ONLY: utmp => wrk_2d_24, vtmp => wrk_2d_25      ! 2D workspace 
    592708      !! 
    593709      INTEGER  , INTENT(in   )               ::   kt        ! ocean time step 
     
    601717      !!--------------------------------------------------------------------- 
    602718 
    603       IF(wrk_in_use(2, 4,5) ) THEN 
     719      IF(wrk_in_use(2, 24,25) ) THEN 
    604720         CALL ctl_stop('fld_rot: ERROR: requested workspace arrays are unavailable.')   ;   RETURN 
    605721      END IF 
     
    638754       END DO 
    639755      ! 
    640       IF(wrk_not_released(2, 4,5) )    CALL ctl_stop('fld_rot: ERROR: failed to release workspace arrays.') 
     756      IF(wrk_not_released(2, 24,25) )    CALL ctl_stop('fld_rot: ERROR: failed to release workspace arrays.') 
    641757      ! 
    642758   END SUBROUTINE fld_rot 
     
    672788      ! 
    673789      CALL iom_open( sdjf%clname, sdjf%num, ldstop = ldstop, ldiof =  LEN(TRIM(sdjf%wgtname)) > 0 ) 
    674       ! 
     790     ! 
    675791   END SUBROUTINE fld_clopn 
    676792 
  • branches/2011/dev_UKM0_2011/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90

    r2715 r3062  
    1010   !!   sbc_apr        : read atmospheric pressure in netcdf files  
    1111   !!---------------------------------------------------------------------- 
    12    USE bdy_par         ! Unstructured boundary parameters 
    1312   USE obc_par         ! open boundary condition parameters 
    1413   USE dom_oce         ! ocean space and time domain 
     
    3029   !                                         !!* namsbc_apr namelist (Atmospheric PRessure) * 
    3130   LOGICAL, PUBLIC ::   ln_apr_obc = .FALSE.  !: inverse barometer added to OBC ssh data  
    32    LOGICAL, PUBLIC ::   ln_apr_bdy = .FALSE.  !: inverse barometer added to BDY ssh data 
    3331   LOGICAL, PUBLIC ::   ln_ref_apr = .FALSE.  !: ref. pressure: global mean Patm (F) or a constant (F) 
    3432 
     
    115113         ! 
    116114         !                                            !* control check 
    117          IF( ln_apr_obc .OR. ln_apr_bdy  )   & 
    118             CALL ctl_stop( 'sbc_apr: inverse barometer added to OBC or BDY ssh data not yet implemented ' ) 
     115         IF( ln_apr_obc )   & 
     116            CALL ctl_stop( 'sbc_apr: inverse barometer added to OBC ssh data not yet implemented ' ) 
    119117         IF( ln_apr_obc .AND. .NOT. lk_obc )   & 
    120118            CALL ctl_stop( 'sbc_apr: add inverse barometer to OBC requires to use key_obc' ) 
    121          IF( ln_apr_bdy .AND. .NOT. lk_bdy )   & 
    122             CALL ctl_stop( 'sbc_apr: add inverse barometer to OBC requires to use key_bdy' ) 
    123          IF( ( ln_apr_obc .OR. ln_apr_bdy ) .AND. .NOT. lk_dynspg_ts )   & 
     119         IF( ( ln_apr_obc ) .AND. .NOT. lk_dynspg_ts )   & 
    124120            CALL ctl_stop( 'sbc_apr: use inverse barometer ssh at open boundary ONLY possible with time-splitting' ) 
    125          IF( ( ln_apr_obc .OR. ln_apr_bdy ) .AND. .NOT. ln_apr_dyn   )   & 
     121         IF( ( ln_apr_obc ) .AND. .NOT. ln_apr_dyn   )   & 
    126122            CALL ctl_stop( 'sbc_apr: use inverse barometer ssh at open boundary ONLY requires ln_apr_dyn=T' ) 
    127123      ENDIF 
  • branches/2011/dev_UKM0_2011/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r2715 r3062  
    3838   USE sbcfwb           ! surface boundary condition: freshwater budget 
    3939   USE closea           ! closed sea 
    40    USE bdy_par          ! unstructured open boundary data variables 
    41    USE bdyice           ! unstructured open boundary data  (bdy_ice_frs routine) 
     40   USE bdy_par          ! for lk_bdy 
     41   USE bdyice_lim2      ! unstructured open boundary data  (bdy_ice_lim_2 routine) 
    4242 
    4343   USE prtctl           ! Print control                    (prt_ctl routine) 
     
    253253         !                                                       
    254254      CASE(  2 )   ;       CALL sbc_ice_lim_2( kt, nsbc )            ! LIM-2 ice model 
    255          IF( lk_bdy )      CALL bdy_ice_frs  ( kt )                  ! BDY boundary condition 
     255         IF( lk_bdy )      CALL bdy_ice_lim_2( kt )                  ! BDY boundary condition 
    256256         !                                                      
    257257      CASE(  3 )   ;       CALL sbc_ice_lim  ( kt, nsbc )            ! LIM-3 ice model 
  • branches/2011/dev_UKM0_2011/NEMOGCM/NEMO/OPA_SRC/SOL/solver.F90

    r2715 r3062  
    2323   USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient 
    2424   USE solmat          ! matrix of the solver 
    25    USE obc_oce         ! Lateral open boundary condition 
    2625   USE in_out_manager  ! I/O manager 
    2726   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
  • branches/2011/dev_UKM0_2011/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90

    r2715 r3062  
    3636   USE obc_oce 
    3737   USE obctra          ! open boundary condition (obc_tra routine) 
    38    USE bdy_par         ! Unstructured open boundary condition (bdy_tra_frs routine) 
    39    USE bdytra          ! Unstructured open boundary condition (bdy_tra_frs routine) 
     38   USE bdy_oce 
     39   USE bdytra          ! open boundary condition (bdy_tra routine) 
    4040   USE in_out_manager  ! I/O manager 
    4141   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     
    4343   USE traqsr          ! penetrative solar radiation (needed for nksr) 
    4444   USE traswp          ! swap array 
    45    USE obc_oce  
    4645#if defined key_agrif 
    4746   USE agrif_opa_update 
     
    8180      !!              - Apply lateral boundary conditions on (ta,sa)  
    8281      !!             at the local domain   boundaries through lbc_lnk call,  
    83       !!             at the radiative open boundaries (lk_obc=T),  
    84       !!             at the relaxed   open boundaries (lk_bdy=T), and 
     82      !!             at the one-way open boundaries (lk_obc=T),  
    8583      !!             at the AGRIF zoom     boundaries (lk_agrif=T) 
    8684      !! 
     
    119117#endif 
    120118#if defined key_bdy  
    121       IF( lk_bdy )   CALL bdy_tra_frs( kt )  ! BDY open boundaries 
     119      IF( lk_bdy )   CALL bdy_tra( kt )  ! BDY open boundaries 
    122120#endif 
    123121#if defined key_agrif 
  • branches/2011/dev_UKM0_2011/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r2715 r3062  
    4646   USE domain          ! domain initialization             (dom_init routine) 
    4747   USE obcini          ! open boundary cond. initialization (obc_ini routine) 
    48    USE bdyini          ! unstructured open boundary cond. initialization (bdy_init routine) 
     48   USE bdyini          ! open boundary cond. initialization (bdy_init routine) 
     49   USE bdydta          ! open boundary cond. initialization (bdy_dta_init routine) 
     50   USE bdytides        ! open boundary cond. initialization (tide_init routine) 
    4951   USE istate          ! initial state setting          (istate_init routine) 
    5052   USE ldfdyn          ! lateral viscosity setting      (ldfdyn_init routine) 
     
    295297 
    296298      IF( lk_obc        )   CALL     obc_init   ! Open boundaries  
    297       IF( lk_bdy        )   CALL     bdy_init   ! Unstructured open boundaries 
     299      IF( lk_bdy        )   CALL     bdy_init       ! Open boundaries initialisation 
     300      IF( lk_bdy        )   CALL     bdy_dta_init   ! Open boundaries initialisation of external data arrays 
     301      IF( lk_bdy        )   CALL     tide_init      ! Open boundaries initialisation of tidal harmonic forcing 
    298302 
    299303                            CALL  istate_init   ! ocean initial state (Dynamics and tracers) 
  • branches/2011/dev_UKM0_2011/NEMOGCM/NEMO/OPA_SRC/oce.F90

    r2715 r3062  
    3535   !! free surface                                      !  before  ! now    ! after  ! 
    3636   !! ------------                                      !  fields  ! fields ! trends ! 
    37    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshb   , sshn   , ssha   !: sea surface height at t-point [m] 
    38    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshu_b , sshu_n , sshu_a !: sea surface height at u-point [m] 
    39    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshv_b , sshv_n , sshv_a !: sea surface height at u-point [m] 
    40    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::            sshf_n          !: sea surface height at f-point [m] 
     37   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET ::   sshb   , sshn   , ssha   !: sea surface height at t-point [m] 
     38   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   sshu_b , sshu_n , sshu_a !: sea surface height at u-point [m] 
     39   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   sshv_b , sshv_n , sshv_a !: sea surface height at u-point [m] 
     40   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::            sshf_n          !: sea surface height at f-point [m] 
    4141   ! 
    4242   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   spgu, spgv               !: horizontal surface pressure gradient 
  • branches/2011/dev_UKM0_2011/NEMOGCM/NEMO/OPA_SRC/step.F90

    r2715 r3062  
    9999      IF( lk_obc     )   CALL obc_dta( kstp )         ! update dynamic and tracer data at open boundaries 
    100100      IF( lk_obc     )   CALL obc_rad( kstp )         ! compute phase velocities at open boundaries 
    101       IF( lk_bdy     )   CALL bdy_dta_frs( kstp )     ! update dynamic and tracer data for FRS conditions (BDY) 
     101      IF( lk_bdy     )   CALL bdy_dta( kstp, time_offset=+1 ) ! update dynamic and tracer data at open boundaries 
    102102 
    103103      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
  • branches/2011/dev_UKM0_2011/NEMOGCM/NEMO/OPA_SRC/step_oce.F90

    r2528 r3062  
    5353   USE obcrad           ! open boundary cond. radiation    (obc_rad routine) 
    5454 
    55    USE bdy_par          ! unstructured open boundary data variables 
    56    USE bdydta           ! unstructured open boundary data  (bdy_dta routine) 
     55   USE bdy_par          ! for lk_bdy 
     56   USE bdydta           ! open boundary condition data     (bdy_dta routine) 
    5757 
    5858   USE sshwzv           ! vertical velocity and ssh        (ssh_wzv routine) 
Note: See TracChangeset for help on using the changeset viewer.