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 4409 for branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LBC/exchmod.F90 – NEMO

Ignore:
Timestamp:
2014-02-04T13:12:20+01:00 (10 years ago)
Author:
trackstand2
Message:

Changes to allow jpk to be modified to deepest level within a subdomain. jpkorig holds original value.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LBC/exchmod.F90

    r4400 r4409  
    11MODULE exchmod 
    2   USE par_oce, ONLY: wp, jpiglo, jpjglo, jpkdta, jpi, jpj, jpk 
     2  USE par_oce, ONLY: wp, jpiglo, jpjglo, jpkdta, jpi, jpj, jpk, jpkorig 
    33#if defined key_mpp_mpi 
    44  USE mpi ! For better interface checking 
     
    359359       ! we can limit the length of our z loops to the 
    360360       ! no. of levels above the ocean floor. 
    361        IF(kdim1 == jpk)kdim1 = jpkf 
     361       IF(kdim1 == jpkorig)kdim1 = jpkf 
    362362    ELSEIF ( PRESENT(ib3) ) THEN 
    363363#if defined key_z_first 
     
    27562756      !!---------------------------------------------------------------------- 
    27572757!FTRANS ptab3d :I :I :z 
    2758       REAL(wp),                         INTENT(inout) ::   ptab3d(jpi,jpj,jpk) 
     2758      REAL(wp),                         INTENT(inout) ::   ptab3d(:,:,:) 
    27592759      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points 
    27602760      !                                                             ! = T , U , V , F , W points 
     
    37573757             pack_patches3r: DO ipatch=1,npatchsend(isend,1) 
    37583758 
     3759                IF(nzsendp(ipatch,isend,1) > SIZE(b3,3))THEN 
     3760                   CALL MPI_Abort(mpi_comm_opa,-1,ierr) 
     3761                   CALL ctl_stop('STOP','exchs_generic: b3 has wrong z dimension') 
     3762                END IF 
     3763 
    37593764                jstart = jsrcsendp(ipatch,isend,1) 
    37603765                istart = isrcsendp(ipatch,isend,1) 
     
    39143919                istart = idesrecvp(ipatch,irecv,1)!+nhalo 
    39153920                iend   = istart+nxrecvp(ipatch,irecv,1)-1 
     3921 
     3922                IF(nzrecvp(ipatch,irecv,1) > SIZE(b3,3))THEN 
     3923                   CALL MPI_Abort(mpi_comm_opa,-1,ierr) 
     3924                   CALL ctl_stop('STOP', & 
     3925                                 'exchs_generic: wrong z dim for b3 in recv') 
     3926                END IF 
     3927 
    39163928#if defined key_z_first 
    39173929                DO j=jstart, jend, 1 
     
    43974409    IF(.not. ALLOCATED(ztab))THEN 
    43984410 
    4399        ALLOCATE(ztab(jpiglo,maxExchItems*ijpj,jpk),                 & 
    4400                 iztab(jpiglo,maxExchItems*ijpj,jpk),                & 
    4401                 znorthgloio(nwidthmax,maxExchItems*ijpj,jpk,jpni),  & 
    4402                 znorthloc(nwidthmax,maxExchItems*ijpj,jpk),         & 
    4403                 iznorthgloio(nwidthmax,maxExchItems*ijpj,jpk,jpni), & 
    4404                 iznorthloc(nwidthmax,maxExchItems*ijpj,jpk),        & 
     4411       ALLOCATE(ztab(jpiglo,maxExchItems*ijpj,jpkorig),                 & 
     4412                iztab(jpiglo,maxExchItems*ijpj,jpkorig),                & 
     4413                znorthgloio(nwidthmax,maxExchItems*ijpj,jpkorig,jpni),  & 
     4414                znorthloc(nwidthmax,maxExchItems*ijpj,jpkorig),         & 
     4415                iznorthgloio(nwidthmax,maxExchItems*ijpj,jpkorig,jpni), & 
     4416                iznorthloc(nwidthmax,maxExchItems*ijpj,jpkorig),        & 
    44054417                STAT=ierr) 
    44064418       IF(ierr .ne. 0)THEN 
     
    59305942     CHARACTER(len=1), INTENT( in ) :: cd_type ! nature of pt3d grid-points 
    59315943     !                                         ! = T,  U, V, F or W gridp'ts 
    5932      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::   & 
     5944     REAL(wp), DIMENSION(:,:,:), INTENT( inout ) ::   & 
    59335945          pt3d          ! 3D array on which the boundary condition is applied 
    59345946     REAL(wp), INTENT( in ) ::   & 
     
    59625974     IF(.not. ALLOCATED(ztab))THEN 
    59635975 
    5964         ALLOCATE(ztab(jpiglo,ijpj,jpk),                & 
    5965                  znorthgloio(nwidthmax,ijpj,jpk,jpni), & 
    5966                  znorthloc(nwidthmax,ijpj,jpk),        & 
     5976        ALLOCATE(ztab(jpiglo,ijpj,jpkorig),                & 
     5977                 znorthgloio(nwidthmax,ijpj,jpkorig,jpni), & 
     5978                 znorthloc(nwidthmax,ijpj,jpkorig),        & 
    59675979                 STAT=ierr) 
    59685980        IF(ierr .ne. 0)THEN 
     
    60066018       not done : compiler error 
    60076019#elif defined key_mpp_mpi 
    6008        itaille=nwidthmax*jpk*ijpj 
     6020       itaille=nwidthmax*jpkorig*ijpj 
    60096021       CALL MPI_GATHER(znorthloc,itaille,MPI_DOUBLE_PRECISION,   & 
    60106022                       znorthgloio,itaille,MPI_DOUBLE_PRECISION, & 
     
    63166328#elif key_mpp_mpi 
    63176329    IF ( npolj /= 0 ) THEN 
    6318        itaille=nwidthmax*jpk*ijpj 
     6330       itaille=nwidthmax*jpkorig*ijpj 
    63196331       CALL MPI_SCATTER(znorthgloio,itaille,MPI_DOUBLE_PRECISION, & 
    63206332                        znorthloc,  itaille,MPI_DOUBLE_PRECISION, & 
     
    63756387     CHARACTER(len=1), INTENT( in ) :: cd_type ! nature of pt3d grid-points 
    63766388     !                                         ! = T,  U, V, F or W gridp'ts 
    6377      INTEGER, DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::   & 
     6389     INTEGER, DIMENSION(:,:,:), INTENT( inout ) ::   & 
    63786390          ib3          ! 3D array on which the boundary condition is applied 
    63796391     INTEGER, INTENT( in ) ::   & 
     
    64086420     IF(.not. ALLOCATED(ztab))THEN 
    64096421 
    6410         ALLOCATE(ztab(jpiglo,ijpj,jpk),                & 
    6411                  znorthgloio(nwidthmax,ijpj,jpk,jpni), & 
    6412                  znorthloc(nwidthmax,ijpj,jpk),        & 
     6422        ALLOCATE(ztab(jpiglo,ijpj,jpkorig),                & 
     6423                 znorthgloio(nwidthmax,ijpj,jpkorig,jpni), & 
     6424                 znorthloc(nwidthmax,ijpj,jpkorig),        & 
    64136425                 STAT=ierr) 
    64146426        IF(ierr .ne. 0)THEN 
Note: See TracChangeset for help on using the changeset viewer.