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 5568 for branches/UKMO/dev_r5107_hadgem3_mct/NEMOGCM/NEMO/OPA_SRC/LBC – NEMO

Ignore:
Timestamp:
2015-07-08T17:13:59+02:00 (9 years ago)
Author:
davestorkey
Message:

Upgrade UKMO/dev_r5107_hadgem3_mct branch to trunk revision 5518
( = branching point for NEMO 3.6_stable).

Location:
branches/UKMO/dev_r5107_hadgem3_mct/NEMOGCM/NEMO/OPA_SRC/LBC
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5107_hadgem3_mct/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90

    r5279 r5568  
    2222   USE lib_mpp          ! distributed memory computing library 
    2323 
     24 
     25   INTERFACE lbc_lnk_multi 
     26      MODULE PROCEDURE mpp_lnk_2d_9 
     27   END INTERFACE 
     28 
    2429   INTERFACE lbc_lnk 
    2530      MODULE PROCEDURE mpp_lnk_3d_gather, mpp_lnk_3d, mpp_lnk_2d 
     
    3944 
    4045   PUBLIC lbc_lnk       ! ocean lateral boundary conditions 
     46   PUBLIC lbc_lnk_multi ! modified ocean lateral boundary conditions 
    4147   PUBLIC lbc_lnk_e 
    4248   PUBLIC lbc_bdy_lnk   ! ocean lateral BDY boundary conditions 
  • branches/UKMO/dev_r5107_hadgem3_mct/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r5303 r5568  
    7272   PUBLIC   mpp_min, mpp_max, mpp_sum, mpp_minloc, mpp_maxloc 
    7373   PUBLIC   mpp_lnk_3d, mpp_lnk_3d_gather, mpp_lnk_2d, mpp_lnk_2d_e 
     74   PUBLIC   mpp_lnk_2d_9  
    7475   PUBLIC   mppscatter, mppgather 
    7576   PUBLIC   mpp_ini_ice, mpp_ini_znl 
     
    7980   PUBLIC   mpp_lbc_north_icb, mpp_lnk_2d_icb 
    8081 
     82   TYPE arrayptr 
     83      REAL , DIMENSION (:,:),  POINTER :: pt2d 
     84   END TYPE arrayptr 
     85    
    8186   !! * Interfaces 
    8287   !! define generic interface for these routine as they are called sometimes 
     
    165170 
    166171 
    167    FUNCTION mynode( ldtxt, kumnam_ref , kumnam_cfg , kumond , kstop, localComm ) 
     172   FUNCTION mynode( ldtxt, ldname, kumnam_ref , kumnam_cfg , kumond , kstop, localComm ) 
    168173      !!---------------------------------------------------------------------- 
    169174      !!                  ***  routine mynode  *** 
     
    172177      !!---------------------------------------------------------------------- 
    173178      CHARACTER(len=*),DIMENSION(:), INTENT(  out) ::   ldtxt 
     179      CHARACTER(len=*)             , INTENT(in   ) ::   ldname 
    174180      INTEGER                      , INTENT(in   ) ::   kumnam_ref     ! logical unit for reference namelist 
    175181      INTEGER                      , INTENT(in   ) ::   kumnam_cfg     ! logical unit for configuration namelist 
     
    298304 
    299305      IF( mynode == 0 ) THEN 
    300         CALL ctl_opn( kumond, 'output.namelist.dyn', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 ) 
    301         WRITE(kumond, nammpp)       
     306         CALL ctl_opn( kumond, TRIM(ldname), 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 ) 
     307         WRITE(kumond, nammpp)       
    302308      ENDIF 
    303309      ! 
     
    511517      ! 
    512518   END SUBROUTINE mpp_lnk_3d 
     519 
     520   SUBROUTINE mpp_lnk_2d_multiple( pt2d_array , type_array , psgn_array , num_fields , cd_mpp, pval ) 
     521      !!---------------------------------------------------------------------- 
     522      !!                  ***  routine mpp_lnk_2d_multiple  *** 
     523      !! 
     524      !! ** Purpose :   Message passing management for multiple 2d arrays 
     525      !! 
     526      !! ** Method  :   Use mppsend and mpprecv function for passing mask 
     527      !!      between processors following neighboring subdomains. 
     528      !!            domain parameters 
     529      !!                    nlci   : first dimension of the local subdomain 
     530      !!                    nlcj   : second dimension of the local subdomain 
     531      !!                    nbondi : mark for "east-west local boundary" 
     532      !!                    nbondj : mark for "north-south local boundary" 
     533      !!                    noea   : number for local neighboring processors 
     534      !!                    nowe   : number for local neighboring processors 
     535      !!                    noso   : number for local neighboring processors 
     536      !!                    nono   : number for local neighboring processors 
     537      !! 
     538      !!---------------------------------------------------------------------- 
     539 
     540      INTEGER :: num_fields 
     541      TYPE( arrayptr ), DIMENSION(:) :: pt2d_array 
     542      CHARACTER(len=1), DIMENSION(:), INTENT(in   ) ::   type_array   ! define the nature of ptab array grid-points 
     543      !                                                               ! = T , U , V , F , W and I points 
     544      REAL(wp)        , DIMENSION(:), INTENT(in   ) ::   psgn_array   ! =-1 the sign change across the north fold boundary 
     545      !                                                               ! =  1. , the sign is kept 
     546      CHARACTER(len=3), OPTIONAL    , INTENT(in   ) ::   cd_mpp       ! fill the overlap area only 
     547      REAL(wp)        , OPTIONAL    , INTENT(in   ) ::   pval         ! background value (used at closed boundaries) 
     548      !! 
     549      INTEGER  ::   ji, jj, jl   ! dummy loop indices 
     550      INTEGER  ::   ii    !!MULTI SEND DUMMY LOOP INDICES 
     551      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers 
     552      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend 
     553 
     554      REAL(wp) ::   zland 
     555      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend 
     556      ! 
     557      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ns, zt2sn   ! 2d for north-south & south-north 
     558      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ew, zt2we   ! 2d for east-west & west-east 
     559 
     560      !!---------------------------------------------------------------------- 
     561 
     562      ALLOCATE( zt2ns(jpi,jprecj,2*num_fields), zt2sn(jpi,jprecj,2*num_fields),  & 
     563         &      zt2ew(jpj,jpreci,2*num_fields), zt2we(jpj,jpreci,2*num_fields)   ) 
     564 
     565      ! 
     566      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value 
     567      ELSE                         ;   zland = 0.e0      ! zero by default 
     568      ENDIF 
     569 
     570      ! 1. standard boundary treatment 
     571      ! ------------------------------ 
     572      ! 
     573      !First Array 
     574      DO ii = 1 , num_fields 
     575         IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values 
     576            ! 
     577            ! WARNING pt2d is defined only between nld and nle 
     578            DO jj = nlcj+1, jpj                 ! added line(s)   (inner only) 
     579               pt2d_array(ii)%pt2d(nldi  :nlei  , jj) = pt2d_array(ii)%pt2d(nldi:nlei, nlej) 
     580               pt2d_array(ii)%pt2d(1     :nldi-1, jj) = pt2d_array(ii)%pt2d(nldi     , nlej) 
     581               pt2d_array(ii)%pt2d(nlei+1:nlci  , jj) = pt2d_array(ii)%pt2d(     nlei, nlej)  
     582            END DO 
     583            DO ji = nlci+1, jpi                 ! added column(s) (full) 
     584               pt2d_array(ii)%pt2d(ji, nldj  :nlej  ) = pt2d_array(ii)%pt2d(nlei, nldj:nlej) 
     585               pt2d_array(ii)%pt2d(ji, 1     :nldj-1) = pt2d_array(ii)%pt2d(nlei, nldj     ) 
     586               pt2d_array(ii)%pt2d(ji, nlej+1:jpj   ) = pt2d_array(ii)%pt2d(nlei,      nlej) 
     587            END DO 
     588            ! 
     589         ELSE                              ! standard close or cyclic treatment 
     590            ! 
     591            !                                   ! East-West boundaries 
     592            IF( nbondi == 2 .AND.   &                ! Cyclic east-west 
     593               &    (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN 
     594               pt2d_array(ii)%pt2d(  1  , : ) = pt2d_array(ii)%pt2d( jpim1, : )                                    ! west 
     595               pt2d_array(ii)%pt2d( jpi , : ) = pt2d_array(ii)%pt2d(   2  , : )                                    ! east 
     596            ELSE                                     ! closed 
     597               IF( .NOT. type_array(ii) == 'F' )   pt2d_array(ii)%pt2d(            1 : jpreci,:) = zland    ! south except F-point 
     598                                                   pt2d_array(ii)%pt2d(nlci-jpreci+1 : jpi   ,:) = zland    ! north 
     599            ENDIF 
     600            !                                   ! North-South boundaries (always closed) 
     601               IF( .NOT. type_array(ii) == 'F' )   pt2d_array(ii)%pt2d(:,             1:jprecj ) = zland    ! south except F-point 
     602                                                   pt2d_array(ii)%pt2d(:, nlcj-jprecj+1:jpj    ) = zland    ! north 
     603            ! 
     604         ENDIF 
     605      END DO 
     606 
     607      ! 2. East and west directions exchange 
     608      ! ------------------------------------ 
     609      ! we play with the neigbours AND the row number because of the periodicity 
     610      ! 
     611      DO ii = 1 , num_fields 
     612         SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions 
     613         CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case) 
     614            iihom = nlci-nreci 
     615            DO jl = 1, jpreci 
     616               zt2ew( : , jl , ii ) = pt2d_array(ii)%pt2d( jpreci+jl , : ) 
     617               zt2we( : , jl , ii ) = pt2d_array(ii)%pt2d( iihom +jl , : ) 
     618            END DO 
     619         END SELECT 
     620      END DO 
     621      ! 
     622      !                           ! Migrations 
     623      imigr = jpreci * jpj 
     624      ! 
     625      SELECT CASE ( nbondi ) 
     626      CASE ( -1 ) 
     627         CALL mppsend( 2, zt2we(1,1,1), num_fields*imigr, noea, ml_req1 ) 
     628         CALL mpprecv( 1, zt2ew(1,1,num_fields+1), num_fields*imigr, noea ) 
     629         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
     630      CASE ( 0 ) 
     631         CALL mppsend( 1, zt2ew(1,1,1), num_fields*imigr, nowe, ml_req1 ) 
     632         CALL mppsend( 2, zt2we(1,1,1), num_fields*imigr, noea, ml_req2 ) 
     633         CALL mpprecv( 1, zt2ew(1,1,num_fields+1), num_fields*imigr, noea ) 
     634         CALL mpprecv( 2, zt2we(1,1,num_fields+1), num_fields*imigr, nowe ) 
     635         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
     636         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 
     637      CASE ( 1 ) 
     638         CALL mppsend( 1, zt2ew(1,1,1), num_fields*imigr, nowe, ml_req1 ) 
     639         CALL mpprecv( 2, zt2we(1,1,num_fields+1), num_fields*imigr, nowe ) 
     640         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
     641      END SELECT 
     642      ! 
     643      !                           ! Write Dirichlet lateral conditions 
     644      iihom = nlci - jpreci 
     645      ! 
     646 
     647      DO ii = 1 , num_fields 
     648         SELECT CASE ( nbondi ) 
     649         CASE ( -1 ) 
     650            DO jl = 1, jpreci 
     651               pt2d_array(ii)%pt2d( iihom+jl , : ) = zt2ew(:,jl,num_fields+ii) 
     652            END DO 
     653         CASE ( 0 ) 
     654            DO jl = 1, jpreci 
     655               pt2d_array(ii)%pt2d( jl , : ) = zt2we(:,jl,num_fields+ii) 
     656               pt2d_array(ii)%pt2d( iihom+jl , : ) = zt2ew(:,jl,num_fields+ii) 
     657            END DO 
     658         CASE ( 1 ) 
     659            DO jl = 1, jpreci 
     660               pt2d_array(ii)%pt2d( jl , : )= zt2we(:,jl,num_fields+ii) 
     661            END DO 
     662         END SELECT 
     663      END DO 
     664       
     665      ! 3. North and south directions 
     666      ! ----------------------------- 
     667      ! always closed : we play only with the neigbours 
     668      ! 
     669      !First Array 
     670      DO ii = 1 , num_fields 
     671         IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions 
     672            ijhom = nlcj-nrecj 
     673            DO jl = 1, jprecj 
     674               zt2sn(:,jl , ii) = pt2d_array(ii)%pt2d( : , ijhom +jl ) 
     675               zt2ns(:,jl , ii) = pt2d_array(ii)%pt2d( : , jprecj+jl ) 
     676            END DO 
     677         ENDIF 
     678      END DO 
     679      ! 
     680      !                           ! Migrations 
     681      imigr = jprecj * jpi 
     682      ! 
     683      SELECT CASE ( nbondj ) 
     684      CASE ( -1 ) 
     685         CALL mppsend( 4, zt2sn(1,1,1), num_fields*imigr, nono, ml_req1 ) 
     686         CALL mpprecv( 3, zt2ns(1,1,num_fields+1), num_fields*imigr, nono ) 
     687         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
     688      CASE ( 0 ) 
     689         CALL mppsend( 3, zt2ns(1,1,1), num_fields*imigr, noso, ml_req1 ) 
     690         CALL mppsend( 4, zt2sn(1,1,1), num_fields*imigr, nono, ml_req2 ) 
     691         CALL mpprecv( 3, zt2ns(1,1,num_fields+1), num_fields*imigr, nono ) 
     692         CALL mpprecv( 4, zt2sn(1,1,num_fields+1), num_fields*imigr, noso ) 
     693         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
     694         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 
     695      CASE ( 1 ) 
     696         CALL mppsend( 3, zt2ns(1,1,1), num_fields*imigr, noso, ml_req1 ) 
     697         CALL mpprecv( 4, zt2sn(1,1,num_fields+1), num_fields*imigr, noso ) 
     698         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
     699      END SELECT 
     700      ! 
     701      !                           ! Write Dirichlet lateral conditions 
     702      ijhom = nlcj - jprecj 
     703      ! 
     704 
     705      DO ii = 1 , num_fields 
     706         !First Array 
     707         SELECT CASE ( nbondj ) 
     708         CASE ( -1 ) 
     709            DO jl = 1, jprecj 
     710               pt2d_array(ii)%pt2d( : , ijhom+jl ) = zt2ns( : , jl , num_fields+ii ) 
     711            END DO 
     712         CASE ( 0 ) 
     713            DO jl = 1, jprecj 
     714               pt2d_array(ii)%pt2d( : , jl ) = zt2sn( : , jl , num_fields + ii) 
     715               pt2d_array(ii)%pt2d( : , ijhom + jl ) = zt2ns( : , jl , num_fields + ii ) 
     716            END DO 
     717         CASE ( 1 ) 
     718            DO jl = 1, jprecj 
     719               pt2d_array(ii)%pt2d( : , jl ) = zt2sn( : , jl , num_fields + ii ) 
     720            END DO 
     721         END SELECT 
     722      END DO 
     723       
     724      ! 4. north fold treatment 
     725      ! ----------------------- 
     726      ! 
     727      DO ii = 1 , num_fields 
     728         !First Array 
     729         IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN 
     730            ! 
     731            SELECT CASE ( jpni ) 
     732            CASE ( 1 )     ;   CALL lbc_nfd      ( pt2d_array(ii)%pt2d( : , : ), type_array(ii) , psgn_array(ii) )   ! only 1 northern proc, no mpp 
     733            CASE DEFAULT   ;   CALL mpp_lbc_north( pt2d_array(ii)%pt2d( : , : ), type_array(ii), psgn_array(ii) )   ! for all northern procs. 
     734            END SELECT 
     735            ! 
     736         ENDIF 
     737         ! 
     738      END DO 
     739       
     740      DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we ) 
     741      ! 
     742   END SUBROUTINE mpp_lnk_2d_multiple 
     743 
     744    
     745   SUBROUTINE load_array(pt2d,cd_type,psgn,pt2d_array, type_array, psgn_array,num_fields) 
     746      !!--------------------------------------------------------------------- 
     747      REAL(wp), DIMENSION(jpi,jpj), TARGET   ,   INTENT(inout) ::   pt2d    ! Second 2D array on which the boundary condition is applied 
     748      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type ! define the nature of ptab array grid-points 
     749      REAL(wp)                    , INTENT(in   ) ::   psgn    ! =-1 the sign change across the north fold boundary 
     750      TYPE(arrayptr)   , DIMENSION(9) ::   pt2d_array 
     751      CHARACTER(len=1) , DIMENSION(9) ::   type_array    ! define the nature of ptab array grid-points 
     752      REAL(wp)         , DIMENSION(9) ::   psgn_array    ! =-1 the sign change across the north fold boundary 
     753      INTEGER                      , INTENT (inout):: num_fields  
     754      !!--------------------------------------------------------------------- 
     755      num_fields=num_fields+1 
     756      pt2d_array(num_fields)%pt2d=>pt2d 
     757      type_array(num_fields)=cd_type 
     758      psgn_array(num_fields)=psgn 
     759   END SUBROUTINE load_array 
     760    
     761    
     762   SUBROUTINE mpp_lnk_2d_9( pt2dA, cd_typeA, psgnA, pt2dB, cd_typeB, psgnB, pt2dC, cd_typeC, psgnC   & 
     763      &                   , pt2dD, cd_typeD, psgnD, pt2dE, cd_typeE, psgnE, pt2dF, cd_typeF, psgnF   & 
     764      &                   , pt2dG, cd_typeG, psgnG, pt2dH, cd_typeH, psgnH, pt2dI, cd_typeI, psgnI, cd_mpp, pval) 
     765      !!--------------------------------------------------------------------- 
     766      ! Second 2D array on which the boundary condition is applied 
     767      REAL(wp), DIMENSION(jpi,jpj), TARGET          , INTENT(inout) ::   pt2dA     
     768      REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dB , pt2dC , pt2dD , pt2dE 
     769      REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dF , pt2dG , pt2dH , pt2dI  
     770      ! define the nature of ptab array grid-points 
     771      CHARACTER(len=1)                              , INTENT(in   ) ::   cd_typeA 
     772      CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeB , cd_typeC , cd_typeD , cd_typeE 
     773      CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeF , cd_typeG , cd_typeH , cd_typeI 
     774      ! =-1 the sign change across the north fold boundary 
     775      REAL(wp)                                      , INTENT(in   ) ::   psgnA     
     776      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnB , psgnC , psgnD , psgnE 
     777      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnF , psgnG , psgnH , psgnI    
     778      CHARACTER(len=3)                    , OPTIONAL, INTENT(in   ) ::   cd_mpp   ! fill the overlap area only 
     779      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   pval     ! background value (used at closed boundaries) 
     780      !! 
     781      TYPE(arrayptr)   , DIMENSION(9) ::   pt2d_array  
     782      CHARACTER(len=1) , DIMENSION(9) ::   type_array    ! define the nature of ptab array grid-points 
     783      !                                                         ! = T , U , V , F , W and I points 
     784      REAL(wp)         , DIMENSION(9) ::   psgn_array    ! =-1 the sign change across the north fold boundary 
     785      INTEGER :: num_fields 
     786      !!--------------------------------------------------------------------- 
     787 
     788      num_fields = 0 
     789 
     790      !! Load the first array 
     791      CALL load_array(pt2dA,cd_typeA,psgnA,pt2d_array, type_array, psgn_array,num_fields) 
     792 
     793      !! Look if more arrays are added 
     794      IF(PRESENT (psgnB) )CALL load_array(pt2dB,cd_typeB,psgnB,pt2d_array, type_array, psgn_array,num_fields) 
     795      IF(PRESENT (psgnC) )CALL load_array(pt2dC,cd_typeC,psgnC,pt2d_array, type_array, psgn_array,num_fields) 
     796      IF(PRESENT (psgnD) )CALL load_array(pt2dD,cd_typeD,psgnD,pt2d_array, type_array, psgn_array,num_fields) 
     797      IF(PRESENT (psgnE) )CALL load_array(pt2dE,cd_typeE,psgnE,pt2d_array, type_array, psgn_array,num_fields) 
     798      IF(PRESENT (psgnF) )CALL load_array(pt2dF,cd_typeF,psgnF,pt2d_array, type_array, psgn_array,num_fields) 
     799      IF(PRESENT (psgnG) )CALL load_array(pt2dG,cd_typeG,psgnG,pt2d_array, type_array, psgn_array,num_fields) 
     800      IF(PRESENT (psgnH) )CALL load_array(pt2dH,cd_typeH,psgnH,pt2d_array, type_array, psgn_array,num_fields) 
     801      IF(PRESENT (psgnI) )CALL load_array(pt2dI,cd_typeI,psgnI,pt2d_array, type_array, psgn_array,num_fields) 
     802       
     803      CALL mpp_lnk_2d_multiple(pt2d_array,type_array,psgn_array,num_fields,cd_mpp,pval) 
     804   END SUBROUTINE mpp_lnk_2d_9 
    513805 
    514806 
     
    32003492   LOGICAL, PUBLIC            ::   ln_nnogather          !: namelist control of northfold comms (needed here in case "key_mpp_mpi" is not used) 
    32013493   INTEGER :: ncomm_ice 
     3494   INTEGER, PUBLIC            ::   mpi_comm_opa          ! opa local communicator 
    32023495   !!---------------------------------------------------------------------- 
    32033496CONTAINS 
     
    32083501   END FUNCTION lib_mpp_alloc 
    32093502 
    3210    FUNCTION mynode( ldtxt, kumnam_ref, knumnam_cfg,  kumond , kstop, localComm ) RESULT (function_value) 
     3503   FUNCTION mynode( ldtxt, ldname, kumnam_ref, knumnam_cfg,  kumond , kstop, localComm ) RESULT (function_value) 
    32113504      INTEGER, OPTIONAL            , INTENT(in   ) ::   localComm 
    32123505      CHARACTER(len=*),DIMENSION(:) ::   ldtxt 
     3506      CHARACTER(len=*) ::   ldname 
    32133507      INTEGER ::   kumnam_ref, knumnam_cfg , kumond , kstop 
    3214       IF( PRESENT( localComm ) .OR. .NOT.PRESENT( localComm ) )   function_value = 0 
     3508      IF( PRESENT( localComm ) ) mpi_comm_opa = localComm 
     3509      function_value = 0 
    32153510      IF( .FALSE. )   ldtxt(:) = 'never done' 
    3216       CALL ctl_opn( kumond, 'output.namelist.dyn', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 ) 
     3511      CALL ctl_opn( kumond, TRIM(ldname), 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 ) 
    32173512   END FUNCTION mynode 
    32183513 
  • branches/UKMO/dev_r5107_hadgem3_mct/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90

    r5279 r5568  
    4545      INTEGER ::  inum                        ! temporary logical unit 
    4646      INTEGER ::  idir                        ! temporary integers 
     47      INTEGER ::  jstartrow                   ! temporary integers 
    4748      INTEGER ::   ios                        ! Local integer output status for namelist read 
    4849      INTEGER ::   & 
     
    100101      ! open the file 
    101102      ! Remember that at this level in the code, mpp is not yet initialized, so 
    102       ! the file must be open with jpdom_unknown, and kstart amd kcount forced  
     103      ! the file must be open with jpdom_unknown, and kstart and kcount forced  
     104      jstartrow = 1 
    103105      IF ( ln_zco ) THEN  
    104106         CALL iom_open ( 'bathy_level.nc', inum )   ! Level bathymetry 
    105          CALL iom_get ( inum, jpdom_unknown, 'Bathy_level', zdta, kstart=(/jpizoom,jpjzoom/), kcount=(/jpiglo,jpjglo/) ) 
     107          ! Optionally use a file attribute (open_ocean_jstart) to set a start row for reading from the global file 
     108          ! This allows the unextended grid bathymetry to be stored in the same file as the under ice-shelf extended bathymetry 
     109         CALL iom_getatt(inum, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found 
     110         jstartrow = MAX(1,jstartrow) 
     111         CALL iom_get ( inum, jpdom_unknown, 'Bathy_level', zdta, kstart=(/jpizoom,jpjzoom+jstartrow-1/), kcount=(/jpiglo,jpjglo/) ) 
    106112      ELSE 
    107113         CALL iom_open ( 'bathy_meter.nc', inum )   ! Meter bathy in case of partial steps 
    108          CALL iom_get ( inum, jpdom_unknown, 'Bathymetry' , zdta, kstart=(/jpizoom,jpjzoom/), kcount=(/jpiglo,jpjglo/) ) 
     114         IF ( ln_isfcav ) THEN 
     115             CALL iom_get ( inum, jpdom_unknown, 'Bathymetry_isf' , zdta, kstart=(/jpizoom,jpjzoom/), kcount=(/jpiglo,jpjglo/) ) 
     116         ELSE 
     117             ! Optionally use a file attribute (open_ocean_jstart) to set a start row for reading from the global file 
     118             ! This allows the unextended grid bathymetry to be stored in the same file as the under ice-shelf extended bathymetry 
     119             CALL iom_getatt(inum, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found 
     120             jstartrow = MAX(1,jstartrow) 
     121             CALL iom_get ( inum, jpdom_unknown, 'Bathymetry' , zdta, kstart=(/jpizoom,jpjzoom+jstartrow-1/)   & 
     122                &                                                   , kcount=(/jpiglo,jpjglo/) ) 
     123         ENDIF 
    109124      ENDIF 
    110125      CALL iom_close (inum) 
Note: See TracChangeset for help on using the changeset viewer.