Changeset 3340


Ignore:
Timestamp:
2012-04-02T13:05:35+02:00 (9 years ago)
Author:
sga
Message:

NEMO branch dev_r3337_NOCS10_ICB: add changes to ocean code to allow interface to iceberg code

Location:
branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC
Files:
9 edited

Legend:

Unmodified
Added
Removed
  • branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r3294 r3340  
    3232   USE sbc_oce         ! Surface boundary condition: ocean fields 
    3333   USE sbc_ice         ! Surface boundary condition: ice fields 
     34   USE icb_oce         ! Icebergs 
     35   USE icbdia          ! Iceberg budgets 
    3436   USE sbcssr          ! restoring term toward SST/SSS climatology 
    3537   USE phycst          ! physical constants 
     
    5961 
    6062   INTEGER ::   nid_T, nz_T, nh_T, ndim_T, ndim_hT   ! grid_T file 
     63   INTEGER ::          nb_T              , ndim_bT   ! grid_T file 
    6164   INTEGER ::   nid_U, nz_U, nh_U, ndim_U, ndim_hU   ! grid_U file 
    6265   INTEGER ::   nid_V, nz_V, nh_V, ndim_V, ndim_hV   ! grid_V file 
     
    6568   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hT, ndex_hU, ndex_hV 
    6669   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_T, ndex_U, ndex_V 
     70   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_bT 
    6771 
    6872   !! * Substitutions 
     
    234238      INTEGER  ::   ierr                                     ! error code return from allocation 
    235239      INTEGER  ::   iimi, iima, ipk, it, itmod, ijmi, ijma   ! local integers 
     240      INTEGER  ::   jn, ierror                               ! local integers 
    236241      REAL(wp) ::   zsto, zout, zmax, zjulian, zdt           ! local scalars 
    237242      !! 
     
    320325         CALL wheneq( jpi*jpj*ipk, tmask, 1, 1., ndex_T , ndim_T  )      ! volume 
    321326         CALL wheneq( jpi*jpj    , tmask, 1, 1., ndex_hT, ndim_hT )      ! surface 
     327         ! 
     328         IF( ln_icebergs ) THEN 
     329            ! 
     330            !! allocation cant go in dia_wri_alloc because ln_icebergs is only set after  
     331            !! that routine is called from nemogcm, so do it here immediately before its needed 
     332            ALLOCATE( ndex_bT(jpi*jpj*nclasses), STAT=ierror ) 
     333            IF( lk_mpp )   CALL mpp_sum( ierror ) 
     334            IF( ierror /= 0 ) THEN 
     335               CALL ctl_stop('dia_wri: failed to allocate iceberg diagnostic array') 
     336               RETURN 
     337            ENDIF 
     338            ! 
     339            !! iceberg vertical coordinate is class number 
     340            CALL histvert( nid_T, "class", "Iceberg class",      &  ! Vertical grid: class 
     341               &           "number", nclasses, class_num, nb_T ) 
     342            ! 
     343            !! each class just needs the surface index pattern 
     344            ndim_bT = 3 
     345            DO jn = 1,nclasses 
     346               ndex_bT((jn-1)*jpi*jpj+1:jn*jpi*jpj) = ndex_hT(1:jpi*jpj) 
     347            ENDDO 
     348            ! 
     349         ENDIF 
    322350 
    323351         ! Define the U grid FILE ( nid_U ) 
     
    401429         CALL histdef( nid_T, "sowindsp", "wind speed at 10m"                  , "m/s"    ,   &  ! wndm 
    402430            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     431! 
     432         IF( ln_icebergs ) THEN 
     433            CALL histdef( nid_T, "calving"             , "calving mass input"                       , "kg/s"   , & 
     434               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     435            CALL histdef( nid_T, "calving_heat"        , "calving heat flux"                        , "XXXX"   , & 
     436               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     437            CALL histdef( nid_T, "berg_floating_melt"  , "Melt rate of icebergs + bits"             , "kg/m2/s", & 
     438               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     439            CALL histdef( nid_T, "berg_stored_ice"     , "Accumulated ice mass by class"            , "kg"     , & 
     440               &          jpi, jpj, nh_T, nclasses  , 1, nclasses  , nb_T , 32, clop, zsto, zout ) 
     441            IF( ln_bergdia ) THEN 
     442               CALL histdef( nid_T, "berg_melt"           , "Melt rate of icebergs"                    , "kg/m2/s", & 
     443                  &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     444               CALL histdef( nid_T, "berg_melt_buoy"      , "Buoyancy component of iceberg melt rate"  , "kg/m2/s", & 
     445                  &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     446               CALL histdef( nid_T, "berg_melt_eros"      , "Erosion component of iceberg melt rate"   , "kg/m2/s", & 
     447                  &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     448               CALL histdef( nid_T, "berg_melt_conv"      , "Convective component of iceberg melt rate", "kg/m2/s", & 
     449                  &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     450               CALL histdef( nid_T, "berg_virtual_area"   , "Virtual coverage by icebergs"             , "m2"     , & 
     451                  &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     452               CALL histdef( nid_T, "bits_src"           , "Mass source of bergy bits"                , "kg/m2/s", & 
     453                  &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     454               CALL histdef( nid_T, "bits_melt"          , "Melt rate of bergy bits"                  , "kg/m2/s", & 
     455                  &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     456               CALL histdef( nid_T, "bits_mass"          , "Bergy bit density field"                  , "kg/m2"  , & 
     457                  &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     458               CALL histdef( nid_T, "berg_mass"           , "Iceberg density field"                    , "kg/m2"  , & 
     459                  &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     460               CALL histdef( nid_T, "berg_real_calving"   , "Calving into iceberg class"               , "kg/s"   , & 
     461                  &          jpi, jpj, nh_T, nclasses  , 1, nclasses  , nb_T , 32, clop, zsto, zout ) 
     462            ENDIF 
     463         ENDIF 
     464 
    403465#if ! defined key_coupled  
    404466         CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping"         , "W/m2"   ,   &  ! qrp 
     
    555617      CALL histwrite( nid_T, "soicecov", it, fr_i          , ndim_hT, ndex_hT )   ! ice fraction    
    556618      CALL histwrite( nid_T, "sowindsp", it, wndm          , ndim_hT, ndex_hT )   ! wind speed    
     619! 
     620      IF( ln_icebergs ) THEN 
     621         ! 
     622         CALL histwrite( nid_T, "calving"             , it, berg_grid%calving      , ndim_hT, ndex_hT )   
     623         CALL histwrite( nid_T, "calving_heat"        , it, berg_grid%calving_hflx , ndim_hT, ndex_hT )          
     624         CALL histwrite( nid_T, "berg_floating_melt"  , it, berg_grid%floating_melt, ndim_hT, ndex_hT )   
     625         ! 
     626         CALL histwrite( nid_T, "berg_stored_ice"     , it, berg_grid%stored_ice   , ndim_bT, ndex_bT ) 
     627         ! 
     628         IF( ln_bergdia ) THEN 
     629            CALL histwrite( nid_T, "berg_melt"           , it, berg_melt        , ndim_hT, ndex_hT   )   
     630            CALL histwrite( nid_T, "berg_melt_buoy"      , it, melt_buoy        , ndim_hT, ndex_hT   )   
     631            CALL histwrite( nid_T, "berg_melt_eros"      , it, melt_eros        , ndim_hT, ndex_hT   )   
     632            CALL histwrite( nid_T, "berg_melt_conv"      , it, melt_conv        , ndim_hT, ndex_hT   )   
     633            CALL histwrite( nid_T, "berg_virtual_area"   , it, virtual_area     , ndim_hT, ndex_hT   )   
     634            CALL histwrite( nid_T, "bits_src"           , it, bits_src        , ndim_hT, ndex_hT   )   
     635            CALL histwrite( nid_T, "bits_melt"          , it, bits_melt       , ndim_hT, ndex_hT   )   
     636            CALL histwrite( nid_T, "bits_mass"          , it, bits_mass       , ndim_hT, ndex_hT   )   
     637            CALL histwrite( nid_T, "berg_mass"           , it, berg_mass        , ndim_hT, ndex_hT   )   
     638            ! 
     639            CALL histwrite( nid_T, "berg_real_calving"   , it, real_calving     , ndim_bT, ndex_bT   ) 
     640         ENDIF 
     641      ENDIF 
     642 
    557643#if ! defined key_coupled 
    558644      CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping 
  • branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90

    r3294 r3340  
    256256      END DO 
    257257      ! applied the lateral boundary conditions 
    258       IF( nn_solv == 2 .AND. MAX( jpr2di, jpr2dj ) > 0 )   CALL lbc_lnk_e( gcb, c_solver_pt, 1. )    
     258      IF( nn_solv == 2 .AND. MAX( jpr2di, jpr2dj ) > 0 )   CALL lbc_lnk_e( gcb, c_solver_pt, 1., jpr2di, jpr2dj )    
    259259 
    260260#if defined key_agrif 
  • branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90

    r2442 r3340  
    5555 
    5656   INTERFACE lbc_lnk_e 
    57       MODULE PROCEDURE lbc_lnk_2d 
     57      MODULE PROCEDURE lbc_lnk_2d_e 
    5858   END INTERFACE 
    5959 
     
    270270   END SUBROUTINE lbc_lnk_2d 
    271271 
     272   SUBROUTINE lbc_lnk_2d_e( pt2d, cd_type, psgn, jpri, jprj ) 
     273      !!--------------------------------------------------------------------- 
     274      !!                 ***  ROUTINE lbc_lnk_2d  *** 
     275      !! 
     276      !! ** Purpose :   set lateral boundary conditions on a 2D array (non mpp case) 
     277      !!                special dummy routine to allow for use of halo indexing in mpp case 
     278      !! 
     279      !! ** Method  :   psign = -1 :    change the sign across the north fold 
     280      !!                      =  1 : no change of the sign across the north fold 
     281      !!                      =  0 : no change of the sign across the north fold and 
     282      !!                             strict positivity preserved: use inner row/column 
     283      !!                             for closed boundaries. 
     284      !!---------------------------------------------------------------------- 
     285      CHARACTER(len=1)            , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points 
     286      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)           ::   pt2d      ! 2D array on which the lbc is applied 
     287      REAL(wp)                    , INTENT(in   )           ::   psgn      ! control of the sign  
     288      INTEGER                     , INTENT(in   )           ::   jpri      ! size of extra halo (not needed in non-mpp) 
     289      INTEGER                     , INTENT(in   )           ::   jprj      ! size of extra halo (not needed in non-mpp) 
     290      !!---------------------------------------------------------------------- 
     291 
     292      CALL lbc_lnk_2d( pt2d, cd_type, psgn ) 
     293      !     
     294   END SUBROUTINE lbc_lnk_2d_e 
     295 
    272296#endif 
    273297 
  • branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r3294 r3340  
    6767   PUBLIC   mppobc, mpp_ini_ice, mpp_ini_znl 
    6868   PUBLIC   mppsize 
     69   PUBLIC   mppsend, mpprecv                          ! needed by ICB routines 
    6970   PUBLIC   lib_mpp_alloc   ! Called in nemogcm.F90 
    7071 
     
    143144 
    144145   ! Type of send : standard, buffered, immediate 
    145    CHARACTER(len=1) ::   cn_mpi_send = 'S'    ! type od mpi send/recieve (S=standard, B=bsend, I=isend) 
    146    LOGICAL          ::   l_isend = .FALSE.   ! isend use indicator (T if cn_mpi_send='I') 
    147    INTEGER          ::   nn_buffer = 0       ! size of the buffer in case of mpi_bsend  
     146   CHARACTER(len=1)         ::   cn_mpi_send = 'S'    ! type od mpi send/recieve (S=standard, B=bsend, I=isend) 
     147   LOGICAL         , PUBLIC ::   l_isend = .FALSE.   ! isend use indicator (T if cn_mpi_send='I') 
     148   INTEGER                  ::   nn_buffer = 0       ! size of the buffer in case of mpi_bsend  
    148149       
    149150   REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE :: tampon  ! buffer in case of bsend 
     
    159160   REAL(wp), DIMENSION(:,:,:)    , ALLOCATABLE, SAVE ::   t2ew, t2we   ! 2d for east-west & west-east 
    160161   REAL(wp), DIMENSION(:,:,:)    , ALLOCATABLE, SAVE ::   t2p1, t2p2   ! 2d for north fold 
    161    REAL(wp), DIMENSION(:,:,:)    , ALLOCATABLE, SAVE ::   tr2ns, tr2sn ! 2d for north-south & south-north + extra outer halo 
    162    REAL(wp), DIMENSION(:,:,:)    , ALLOCATABLE, SAVE ::   tr2ew, tr2we ! 2d for east-west   & west-east   + extra outer halo 
    163162 
    164163   ! Arrays used in mpp_lbc_north_3d() 
     
    207206         &      t2ew(jpj,jpreci    ,2)   , t2we(jpj,jpreci    ,2)   ,                                            & 
    208207         &      t2p1(jpi,jprecj    ,2)   , t2p2(jpi,jprecj    ,2)   ,                                            & 
    209          ! 
    210          &      tr2ns(1-jpr2di:jpi+jpr2di,jprecj+jpr2dj,2) ,                                                     & 
    211          &      tr2sn(1-jpr2di:jpi+jpr2di,jprecj+jpr2dj,2) ,                                                     & 
    212          &      tr2ew(1-jpr2dj:jpj+jpr2dj,jpreci+jpr2di,2) ,                                                     & 
    213          &      tr2we(1-jpr2dj:jpj+jpr2dj,jpreci+jpr2di,2) ,                                                     & 
    214208         ! 
    215209         &      ztab(jpiglo,4,jpk) , znorthloc(jpi,4,jpk) , znorthgloio(jpi,4,jpk,jpni) ,                        & 
     
    947941 
    948942 
    949    SUBROUTINE mpp_lnk_2d_e( pt2d, cd_type, psgn ) 
     943   SUBROUTINE mpp_lnk_2d_e( pt2d, cd_type, psgn, jpri, jprj ) 
    950944      !!---------------------------------------------------------------------- 
    951945      !!                  ***  routine mpp_lnk_2d_e  *** 
     
    958952      !!                    nlci   : first dimension of the local subdomain 
    959953      !!                    nlcj   : second dimension of the local subdomain 
    960       !!                    jpr2di : number of rows for extra outer halo 
    961       !!                    jpr2dj : number of columns for extra outer halo 
     954      !!                    jpr : number of rows for extra outer halo 
     955      !!                    jpr : number of columns for extra outer halo 
    962956      !!                    nbondi : mark for "east-west local boundary" 
    963957      !!                    nbondj : mark for "north-south local boundary" 
     
    968962      !! 
    969963      !!---------------------------------------------------------------------- 
    970       REAL(wp), DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj), INTENT(inout) ::   pt2d     ! 2D array with extra halo 
    971       CHARACTER(len=1)                                            , INTENT(in   ) ::   cd_type  ! nature of ptab array grid-points 
    972       !                                                                                         ! = T , U , V , F , W and I points 
    973       REAL(wp)                                                    , INTENT(in   ) ::   psgn     ! =-1 the sign change across the 
    974       !!                                                                                        ! north boundary, =  1. otherwise 
     964      INTEGER                                             , INTENT(in   ) ::   jpri 
     965      INTEGER                                             , INTENT(in   ) ::   jprj 
     966      REAL(wp), DIMENSION(1-jpri:jpi+jpri,1-jprj:jpj+jprj), INTENT(inout) ::   pt2d     ! 2D array with extra halo 
     967      CHARACTER(len=1)                                    , INTENT(in   ) ::   cd_type  ! nature of ptab array grid-points 
     968      !                                                                                 ! = T , U , V , F , W and I points 
     969      REAL(wp)                                            , INTENT(in   ) ::   psgn     ! =-1 the sign change across the 
     970      !!                                                                                ! north boundary, =  1. otherwise 
    975971      INTEGER  ::   jl   ! dummy loop indices 
    976972      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers 
     
    978974      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend 
    979975      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend 
    980       !!---------------------------------------------------------------------- 
    981  
    982       ipreci = jpreci + jpr2di      ! take into account outer extra 2D overlap area 
    983       iprecj = jprecj + jpr2dj 
     976      !! 
     977      REAL(wp), DIMENSION(1-jpri:jpi+jpri,jprecj+jprj,2) :: r2dns 
     978      REAL(wp), DIMENSION(1-jpri:jpi+jpri,jprecj+jprj,2) :: r2dsn 
     979      REAL(wp), DIMENSION(1-jprj:jpj+jprj,jpreci+jpri,2) :: r2dwe 
     980      REAL(wp), DIMENSION(1-jprj:jpj+jprj,jpreci+jpri,2) :: r2dew 
     981      !!---------------------------------------------------------------------- 
     982 
     983      ipreci = jpreci + jpri      ! take into account outer extra 2D overlap area 
     984      iprecj = jprecj + jprj 
    984985 
    985986 
     
    989990      ! 
    990991      !                                      !* North-South boundaries (always colsed) 
    991       IF( .NOT. cd_type == 'F' )   pt2d(:,  1-jpr2dj   :  jprecj  ) = 0.e0    ! south except at F-point 
    992                                    pt2d(:,nlcj-jprecj+1:jpj+jpr2dj) = 0.e0    ! north 
     992      IF( .NOT. cd_type == 'F' )   pt2d(:,  1-jprj   :  jprecj  ) = 0.e0    ! south except at F-point 
     993                                   pt2d(:,nlcj-jprecj+1:jpj+jprj) = 0.e0    ! north 
    993994                                 
    994995      !                                      ! East-West boundaries 
    995996      !                                           !* Cyclic east-west 
    996997      IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN 
    997          pt2d(1-jpr2di:     1    ,:) = pt2d(jpim1-jpr2di:  jpim1 ,:)       ! east 
    998          pt2d(   jpi  :jpi+jpr2di,:) = pt2d(     2      :2+jpr2di,:)       ! west 
     998         pt2d(1-jpri:     1    ,:) = pt2d(jpim1-jpri:  jpim1 ,:)       ! east 
     999         pt2d(   jpi  :jpi+jpri,:) = pt2d(     2      :2+jpri,:)       ! west 
    9991000         ! 
    10001001      ELSE                                        !* closed 
    1001          IF( .NOT. cd_type == 'F' )   pt2d(  1-jpr2di   :jpreci    ,:) = 0.e0    ! south except at F-point 
    1002                                       pt2d(nlci-jpreci+1:jpi+jpr2di,:) = 0.e0    ! north 
     1002         IF( .NOT. cd_type == 'F' )   pt2d(  1-jpri   :jpreci    ,:) = 0.e0    ! south except at F-point 
     1003                                      pt2d(nlci-jpreci+1:jpi+jpri,:) = 0.e0    ! north 
    10031004      ENDIF 
    10041005      ! 
     
    10091010         ! 
    10101011         SELECT CASE ( jpni ) 
    1011          CASE ( 1 )     ;   CALL lbc_nfd        ( pt2d(1:jpi,1:jpj+jpr2dj), cd_type, psgn, pr2dj=jpr2dj ) 
     1012         CASE ( 1 )     ;   CALL lbc_nfd        ( pt2d(1:jpi,1:jpj+jprj), cd_type, psgn, pr2dj=jprj ) 
    10121013         CASE DEFAULT   ;   CALL mpp_lbc_north_e( pt2d                    , cd_type, psgn               ) 
    10131014         END SELECT  
     
    10211022      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions 
    10221023      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case) 
    1023          iihom = nlci-nreci-jpr2di 
     1024         iihom = nlci-nreci-jpri 
    10241025         DO jl = 1, ipreci 
    1025             tr2ew(:,jl,1) = pt2d(jpreci+jl,:) 
    1026             tr2we(:,jl,1) = pt2d(iihom +jl,:) 
     1026            r2dew(:,jl,1) = pt2d(jpreci+jl,:) 
     1027            r2dwe(:,jl,1) = pt2d(iihom +jl,:) 
    10271028         END DO 
    10281029      END SELECT 
    10291030      ! 
    10301031      !                           ! Migrations 
    1031       imigr = ipreci * ( jpj + 2*jpr2dj) 
     1032      imigr = ipreci * ( jpj + 2*jprj) 
    10321033      ! 
    10331034      SELECT CASE ( nbondi ) 
    10341035      CASE ( -1 ) 
    1035          CALL mppsend( 2, tr2we(1-jpr2dj,1,1), imigr, noea, ml_req1 ) 
    1036          CALL mpprecv( 1, tr2ew(1-jpr2dj,1,2), imigr, noea ) 
     1036         CALL mppsend( 2, r2dwe(1-jprj,1,1), imigr, noea, ml_req1 ) 
     1037         CALL mpprecv( 1, r2dew(1-jprj,1,2), imigr, noea ) 
    10371038         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    10381039      CASE ( 0 ) 
    1039          CALL mppsend( 1, tr2ew(1-jpr2dj,1,1), imigr, nowe, ml_req1 ) 
    1040          CALL mppsend( 2, tr2we(1-jpr2dj,1,1), imigr, noea, ml_req2 ) 
    1041          CALL mpprecv( 1, tr2ew(1-jpr2dj,1,2), imigr, noea ) 
    1042          CALL mpprecv( 2, tr2we(1-jpr2dj,1,2), imigr, nowe ) 
     1040         CALL mppsend( 1, r2dew(1-jprj,1,1), imigr, nowe, ml_req1 ) 
     1041         CALL mppsend( 2, r2dwe(1-jprj,1,1), imigr, noea, ml_req2 ) 
     1042         CALL mpprecv( 1, r2dew(1-jprj,1,2), imigr, noea ) 
     1043         CALL mpprecv( 2, r2dwe(1-jprj,1,2), imigr, nowe ) 
    10431044         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    10441045         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 
    10451046      CASE ( 1 ) 
    1046          CALL mppsend( 1, tr2ew(1-jpr2dj,1,1), imigr, nowe, ml_req1 ) 
    1047          CALL mpprecv( 2, tr2we(1-jpr2dj,1,2), imigr, nowe ) 
     1047         CALL mppsend( 1, r2dew(1-jprj,1,1), imigr, nowe, ml_req1 ) 
     1048         CALL mpprecv( 2, r2dwe(1-jprj,1,2), imigr, nowe ) 
    10481049         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    10491050      END SELECT 
     
    10551056      CASE ( -1 ) 
    10561057         DO jl = 1, ipreci 
    1057             pt2d(iihom+jl,:) = tr2ew(:,jl,2) 
     1058            pt2d(iihom+jl,:) = r2dew(:,jl,2) 
    10581059         END DO 
    10591060      CASE ( 0 ) 
    10601061         DO jl = 1, ipreci 
    1061             pt2d(jl-jpr2di,:) = tr2we(:,jl,2) 
    1062             pt2d( iihom+jl,:) = tr2ew(:,jl,2) 
     1062            pt2d(jl-jpri,:) = r2dwe(:,jl,2) 
     1063            pt2d( iihom+jl,:) = r2dew(:,jl,2) 
    10631064         END DO 
    10641065      CASE ( 1 ) 
    10651066         DO jl = 1, ipreci 
    1066             pt2d(jl-jpr2di,:) = tr2we(:,jl,2) 
     1067            pt2d(jl-jpri,:) = r2dwe(:,jl,2) 
    10671068         END DO 
    10681069      END SELECT 
     
    10741075      ! 
    10751076      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions 
    1076          ijhom = nlcj-nrecj-jpr2dj 
     1077         ijhom = nlcj-nrecj-jprj 
    10771078         DO jl = 1, iprecj 
    1078             tr2sn(:,jl,1) = pt2d(:,ijhom +jl) 
    1079             tr2ns(:,jl,1) = pt2d(:,jprecj+jl) 
     1079            r2dsn(:,jl,1) = pt2d(:,ijhom +jl) 
     1080            r2dns(:,jl,1) = pt2d(:,jprecj+jl) 
    10801081         END DO 
    10811082      ENDIF 
    10821083      ! 
    10831084      !                           ! Migrations 
    1084       imigr = iprecj * ( jpi + 2*jpr2di ) 
     1085      imigr = iprecj * ( jpi + 2*jpri ) 
    10851086      ! 
    10861087      SELECT CASE ( nbondj ) 
    10871088      CASE ( -1 ) 
    1088          CALL mppsend( 4, tr2sn(1-jpr2di,1,1), imigr, nono, ml_req1 ) 
    1089          CALL mpprecv( 3, tr2ns(1-jpr2di,1,2), imigr, nono ) 
     1089         CALL mppsend( 4, r2dsn(1-jpri,1,1), imigr, nono, ml_req1 ) 
     1090         CALL mpprecv( 3, r2dns(1-jpri,1,2), imigr, nono ) 
    10901091         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    10911092      CASE ( 0 ) 
    1092          CALL mppsend( 3, tr2ns(1-jpr2di,1,1), imigr, noso, ml_req1 ) 
    1093          CALL mppsend( 4, tr2sn(1-jpr2di,1,1), imigr, nono, ml_req2 ) 
    1094          CALL mpprecv( 3, tr2ns(1-jpr2di,1,2), imigr, nono ) 
    1095          CALL mpprecv( 4, tr2sn(1-jpr2di,1,2), imigr, noso ) 
     1093         CALL mppsend( 3, r2dns(1-jpri,1,1), imigr, noso, ml_req1 ) 
     1094         CALL mppsend( 4, r2dsn(1-jpri,1,1), imigr, nono, ml_req2 ) 
     1095         CALL mpprecv( 3, r2dns(1-jpri,1,2), imigr, nono ) 
     1096         CALL mpprecv( 4, r2dsn(1-jpri,1,2), imigr, noso ) 
    10961097         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    10971098         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 
    10981099      CASE ( 1 ) 
    1099          CALL mppsend( 3, tr2ns(1-jpr2di,1,1), imigr, noso, ml_req1 ) 
    1100          CALL mpprecv( 4, tr2sn(1-jpr2di,1,2), imigr, noso ) 
     1100         CALL mppsend( 3, r2dns(1-jpri,1,1), imigr, noso, ml_req1 ) 
     1101         CALL mpprecv( 4, r2dsn(1-jpri,1,2), imigr, noso ) 
    11011102         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    11021103      END SELECT 
     
    11081109      CASE ( -1 ) 
    11091110         DO jl = 1, iprecj 
    1110             pt2d(:,ijhom+jl) = tr2ns(:,jl,2) 
     1111            pt2d(:,ijhom+jl) = r2dns(:,jl,2) 
    11111112         END DO 
    11121113      CASE ( 0 ) 
    11131114         DO jl = 1, iprecj 
    1114             pt2d(:,jl-jpr2dj) = tr2sn(:,jl,2) 
    1115             pt2d(:,ijhom+jl ) = tr2ns(:,jl,2) 
     1115            pt2d(:,jl-jprj) = r2dsn(:,jl,2) 
     1116            pt2d(:,ijhom+jl ) = r2dns(:,jl,2) 
    11161117         END DO 
    11171118      CASE ( 1 )  
    11181119         DO jl = 1, iprecj 
    1119             pt2d(:,jl-jpr2dj) = tr2sn(:,jl,2) 
     1120            pt2d(:,jl-jprj) = r2dsn(:,jl,2) 
    11201121         END DO 
    11211122      END SELECT 
  • branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90

    r3294 r3340  
    3939   LOGICAL , PUBLIC ::   ln_ssr      = .FALSE.   !: Sea Surface restoring on SST and/or SSS       
    4040   LOGICAL , PUBLIC ::   ln_apr_dyn  = .FALSE.   !: Atmospheric pressure forcing used on dynamics (ocean & ice) 
     41   LOGICAL , PUBLIC ::   ln_icebergs = .FALSE.   !: Icebergs 
    4142   INTEGER , PUBLIC ::   nn_ice      = 0         !: flag on ice in the surface boundary condition (=0/1/2/3) 
    4243   INTEGER , PUBLIC ::   nn_fwb      = 0         !: FreshWater Budget:  
  • branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r3294 r3340  
    4343   USE bdy_par          ! for lk_bdy 
    4444   USE bdyice_lim2      ! unstructured open boundary data  (bdy_ice_lim_2 routine) 
     45   USE icbrun           ! Icebergs! 
    4546 
    4647   USE prtctl           ! Print control                    (prt_ctl routine) 
     
    282283      CASE(  4 )   ;       CALL sbc_ice_cice ( kt, nsbc )            ! CICE ice model 
    283284      END SELECT                                               
     285 
     286      IF( ln_icebergs )    CALL icb_stp( kt )                   ! compute icebergs 
    284287 
    285288      IF( ln_rnf       )   CALL sbc_rnf( kt )                   ! add runoffs to fresh water fluxes 
  • branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/SOL/solmat.F90

    r3294 r3340  
    284284 
    285285      IF( nn_solv == 2 .AND. MAX( jpr2di, jpr2dj ) > 0) THEN 
    286          CALL lbc_lnk_e( gcp   (:,:,1), c_solver_pt, 1. )   ! lateral boundary conditions 
    287          CALL lbc_lnk_e( gcp   (:,:,2), c_solver_pt, 1. )   ! lateral boundary conditions 
    288          CALL lbc_lnk_e( gcp   (:,:,3), c_solver_pt, 1. )   ! lateral boundary conditions 
    289          CALL lbc_lnk_e( gcp   (:,:,4), c_solver_pt, 1. )   ! lateral boundary conditions 
    290          CALL lbc_lnk_e( gcdprc(:,:)  , c_solver_pt, 1. )   ! lateral boundary conditions 
    291          CALL lbc_lnk_e( gcdmat(:,:)  , c_solver_pt, 1. )   ! lateral boundary conditions          
     286         CALL lbc_lnk_e( gcp   (:,:,1), c_solver_pt, 1., jpr2di, jpr2dj )   ! lateral boundary conditions 
     287         CALL lbc_lnk_e( gcp   (:,:,2), c_solver_pt, 1., jpr2di, jpr2dj )   ! lateral boundary conditions 
     288         CALL lbc_lnk_e( gcp   (:,:,3), c_solver_pt, 1., jpr2di, jpr2dj )   ! lateral boundary conditions 
     289         CALL lbc_lnk_e( gcp   (:,:,4), c_solver_pt, 1., jpr2di, jpr2dj )   ! lateral boundary conditions 
     290         CALL lbc_lnk_e( gcdprc(:,:)  , c_solver_pt, 1., jpr2di, jpr2dj )   ! lateral boundary conditions 
     291         CALL lbc_lnk_e( gcdmat(:,:)  , c_solver_pt, 1., jpr2di, jpr2dj )   ! lateral boundary conditions          
    292292         IF( npolj /= 0 ) CALL sol_exd( gcp , c_solver_pt ) ! switch northernelements 
    293293      END IF 
  • branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/SOL/solsor.F90

    r3294 r3340  
    8181         !                                                    ! ============== 
    8282 
    83          IF( MOD(icount,ijpr2d+1) == 0 )   CALL lbc_lnk_e( gcx, c_solver_pt, 1. )   ! lateral boundary conditions 
     83         IF( MOD(icount,ijpr2d+1) == 0 )   CALL lbc_lnk_e( gcx, c_solver_pt, 1., jpr2di, jpr2dj )   ! lateral boundary conditions 
    8484         
    8585         ! Residus 
     
    104104         icount = icount + 1  
    105105  
    106          IF( MOD(icount,ijpr2d+1) == 0 )   CALL lbc_lnk_e( gcx, c_solver_pt, 1. )   ! lateral boundary conditions 
     106         IF( MOD(icount,ijpr2d+1) == 0 )   CALL lbc_lnk_e( gcx, c_solver_pt, 1., jpr2di, jpr2dj )   ! lateral boundary conditions 
    107107 
    108108         ! Guess red update 
     
    167167      !  Output in gcx 
    168168      !  ------------- 
    169       CALL lbc_lnk_e( gcx, c_solver_pt, 1. )    ! boundary conditions 
     169      CALL lbc_lnk_e( gcx, c_solver_pt, 1._wp, jpr2di, jpr2dj )    ! boundary conditions 
    170170      ! 
    171171      CALL wrk_dealloc( jpi, jpj, ztab ) 
  • branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r3294 r3340  
    6161   USE diaobs          ! Observation diagnostics       (dia_obs_init routine) 
    6262   USE step            ! NEMO time-stepping                 (stp     routine) 
     63   USE icbini          ! handle bergs, initialisation 
     64   USE icbrun          ! handle bergs, calving, themodynamics and transport 
    6365#if defined key_oasis3 
    6466   USE cpl_oasis3      ! OASIS3 coupling 
     
    162164 
    163165      IF( lk_diaobs ) CALL dia_obs_wri 
     166      IF( ln_icebergs ) CALL icb_end( nitend ) 
    164167        
    165168      !                            !------------------------! 
     
    360363      !                                     ! Misc. options 
    361364      IF( nn_cla == 1   )   CALL cla_init       ! Cross Land Advection 
     365                            CALL icb_init( rdt, nit000)   ! initialise icebergs instance 
    362366       
    363367#if defined key_top 
Note: See TracChangeset for help on using the changeset viewer.