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 2625 – NEMO

Changeset 2625


Ignore:
Timestamp:
2011-02-27T17:36:24+01:00 (13 years ago)
Author:
gm
Message:

dynamic mem: #785 ; OPA_SRC mpp compilation: suppression of the USE in_out_manager in lib_mpp + style in DYN

Location:
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC
Files:
18 edited

Legend:

Unmodified
Added
Removed
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90

    r2618 r2625  
    9797      INTEGER, DIMENSION(5) ::   ierr 
    9898      !!---------------------------------------------------------------------- 
    99  
    10099      ierr(:) = 0 
    101  
     100      ! 
    102101      ALLOCATE( btmsk(jpi,jpj,nptr) ,           & 
    103          &       htr_adv(jpj) , str_adv(jpj) ,   & 
    104          &       htr_ldf(jpj) , str_ldf(jpj) ,   & 
    105          &       htr_ove(jpj) , str_ove(jpj),    & 
    106          &       htr(jpj,nptr) , str(jpj,nptr) , & 
    107          &       tn_jk(jpj,jpk,nptr) , sn_jk (jpj,jpk,nptr) , v_msf(jpj,jpk,nptr) , & 
    108          &       sjk  (jpj,jpk,nptr) , r1_sjk(jpj,jpk,nptr) , STAT=ierr(1)  ) 
     102         &      htr_adv(jpj) , str_adv(jpj) ,   & 
     103         &      htr_ldf(jpj) , str_ldf(jpj) ,   & 
     104         &      htr_ove(jpj) , str_ove(jpj),    & 
     105         &      htr(jpj,nptr) , str(jpj,nptr) , & 
     106         &      tn_jk(jpj,jpk,nptr) , sn_jk (jpj,jpk,nptr) , v_msf(jpj,jpk,nptr) , & 
     107         &      sjk  (jpj,jpk,nptr) , r1_sjk(jpj,jpk,nptr) , STAT=ierr(1)  ) 
    109108         ! 
    110109#if defined key_diaeiv 
     
    112111         &      v_msf_eiv(jpj,jpk,nptr) , STAT=ierr(2) ) 
    113112#endif 
    114  
    115113      ALLOCATE( p_fval1d(jpj), p_fval2d(jpj,jpk), Stat=ierr(3)) 
    116  
     114      ! 
    117115      ALLOCATE(ndex(jpj*jpk),        ndex_atl(jpj*jpk), ndex_pac(jpj*jpk), & 
    118116         &     ndex_ind(jpj*jpk),    ndex_ipc(jpj*jpk),                    & 
     
    482480      ENDIF 
    483481       
    484       IF( lk_mpp )   CALL mpp_ini_znl     ! Define MPI communicator for zonal sum 
     482      IF( lk_mpp )   CALL mpp_ini_znl( numout )     ! Define MPI communicator for zonal sum 
    485483 
    486484      IF( ln_subbas ) THEN                ! load sub-basin mask 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r2613 r2625  
    4848   USE dtatem 
    4949   USE dtasal 
     50   USE lib_mpp         ! MPP library 
    5051 
    5152   IMPLICIT NONE 
     
    7576CONTAINS 
    7677 
    77    FUNCTION dia_wri_alloc() 
     78   INTEGER FUNCTION dia_wri_alloc() 
    7879      !!---------------------------------------------------------------------- 
    79       IMPLICIT none 
    80       INTEGER :: dia_wri_alloc 
    8180      INTEGER, DIMENSION(2) :: ierr 
    8281      !!---------------------------------------------------------------------- 
     
    8988         ! 
    9089      dia_wri_alloc = MAXVAL(ierr) 
    91       IF( lk_mpp )   CALL mpp_sum( ierr ) 
     90      IF( lk_mpp )   CALL mpp_sum( dia_wri_alloc ) 
    9291      ! 
    9392  END FUNCTION dia_wri_alloc 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90

    r2618 r2625  
    336336      IF( ln_rnf      )   CALL sbc_rnf_div( hdivn )          ! runoffs (update hdivn field) 
    337337      IF( nn_cla == 1 )   CALL cla_div    ( kt )             ! Cross Land Advection (update hdivn field) 
    338  
    339       ! 4. Lateral boundary conditions on hdivn and rotn 
    340       ! ---------------------------------=======---====== 
     338      ! 
    341339      CALL lbc_lnk( hdivn, 'T', 1. )   ;   CALL lbc_lnk( rotn , 'F', 1. )     ! lateral boundary cond. (no sign change) 
    342340      ! 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv.F90

    r2528 r2625  
    3838   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    3939   !! $Id$ 
    40    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     40   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4141   !!---------------------------------------------------------------------- 
    42  
    4342CONTAINS 
    4443 
     
    5857      !!---------------------------------------------------------------------- 
    5958      ! 
    60       SELECT CASE ( nadv )                     ! compute advection trend and add it to general trend 
     59      SELECT CASE ( nadv )                  ! compute advection trend and add it to general trend 
    6160      CASE ( 0 )      
    6261                      CALL dyn_keg     ( kt )    ! vector form : horizontal gradient of kinetic energy 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_cen2.F90

    r2590 r2625  
    2929#  include "vectopt_loop_substitute.h90" 
    3030   !!---------------------------------------------------------------------- 
    31    !! NEMO/OPA 3.2 , LODYC-IPSL  (2009) 
     31   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    3232   !! $Id$ 
    33    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     33   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3434   !!---------------------------------------------------------------------- 
    35  
    3635CONTAINS 
    3736 
     
    4746      !! ** Action  :   (ua,va) updated with the now vorticity term trend 
    4847      !!---------------------------------------------------------------------- 
    49       USE oce, ONLY:   zfu => ta   ! use ta as 3D workspace 
    50       USE oce, ONLY:   zfv => sa   ! use sa as 3D workspace 
    51       USE wrk_nemo, ONLY: zfu_t => wrk_3d_1, & ! 3D workspaces 
    52                           zfu_f => wrk_3d_2, & 
    53                           zfu_uw =>wrk_3d_3, & 
    54                           zfv_t => wrk_3d_4, &  
    55                           zfv_f => wrk_3d_5, &  
    56                           zfv_vw =>wrk_3d_6, & 
    57                           zfw   => wrk_3d_7, & 
    58                           wrk_use, wrk_release 
    59       IMPLICIT none 
     48      USE wrk_nemo, ONLY:   wrk_use, wrk_release 
     49      USE oce     , ONLY:   zfu   => ta       ! use ta as 3D workspace 
     50      USE oce     , ONLY:   zfv   => sa       ! use sa as 3D workspace 
     51      USE wrk_nemo, ONLY:   zfu_t => wrk_3d_1 , zfv_t => wrk_3d_4 , zfu_uw =>wrk_3d_6   ! 3D workspaces 
     52      USE wrk_nemo, ONLY:   zfu_f => wrk_3d_2 , zfv_f => wrk_3d_5 , zfv_vw =>wrk_3d_7 
     53      USE wrk_nemo, ONLY:   zfw   => wrk_3d_3  
    6054      !! 
    6155      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
     
    6559      !!---------------------------------------------------------------------- 
    6660 
    67       IF( kt == nit000 ) THEN 
    68          IF(lwp) WRITE(numout,*) 
    69          IF(lwp) WRITE(numout,*) 'dyn_adv_cen2 : 2nd order flux form momentum advection' 
    70          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 
     61      IF( kt == nit000 .AND. lwp ) THEN 
     62         WRITE(numout,*) 
     63         WRITE(numout,*) 'dyn_adv_cen2 : 2nd order flux form momentum advection' 
     64         WRITE(numout,*) '~~~~~~~~~~~~' 
    7165      ENDIF 
    7266 
    7367      ! Check that global workspace arrays aren't already in use 
    74       IF( .not. wrk_use(3, 1, 2, 3, 4, 5, 6, 7) )THEN 
    75          IF(lwp) WRITE(numout, *) 'dyn_adv_cen2 : run-time error - global workspace arrays already in use.' 
    76          CALL ctl_stop('dyn_adv_cen2 : run-time error - global workspace arrays already in use.') 
     68      IF( .not. wrk_use(3, 1,2,3,4,5,6,7) ) THEN 
     69         CALL ctl_stop('dyn_adv_cen2 : requested workspace array unavailable')   ;   RETURN 
    7770      END IF 
    7871 
     
    169162         &                       tab3d_2=va, clinfo2=           ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    170163      ! 
    171       ! Flag that the global workspace arrays are no longer in use 
    172       IF( .not. wrk_release(3, 1, 2, 3, 4, 5, 6, 7) )THEN 
    173          IF(lwp) WRITE(numout, *) 'dyn_adv_cen2 : run-time error - failed to release global workspace arrays.' 
    174       END IF 
     164      IF( .not. wrk_release(3, 1,2,3,4,5,6,7) )   CALL ctl_stop('dyn_adv_cen2 : failed to release workspace array') 
    175165      ! 
    176166   END SUBROUTINE dyn_adv_cen2 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90

    r2590 r2625  
    3434#  include "vectopt_loop_substitute.h90" 
    3535   !!---------------------------------------------------------------------- 
    36    !! NEMO/OPA 3.2 , LODYC-IPSL  (2009) 
     36   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    3737   !! $Id$ 
    38    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    39    !!---------------------------------------------------------------------- 
    40  
     38   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     39   !!---------------------------------------------------------------------- 
    4140CONTAINS 
    4241 
     
    6867      !! Reference : Shchepetkin & McWilliams, 2005, Ocean Modelling.  
    6968      !!---------------------------------------------------------------------- 
    70       USE oce, ONLY:   zfu => ta   ! use ta as 3D workspace 
    71       USE oce, ONLY:   zfv => sa   ! use sa as 3D workspace 
    72       USE wrk_nemo, ONLY: wrk_use, wrk_release 
    73       USE wrk_nemo, ONLY: zfu_t  =>wrk_3d_1, & 
    74                           zfu_f  =>wrk_3d_2, & 
    75                           zfv_t  =>wrk_3d_3, & 
    76                           zfv_f  =>wrk_3d_4, & 
    77                           zfw    =>wrk_3d_5, & 
    78                           zfu_uw =>wrk_3d_6, & 
    79                           zfv_vw =>wrk_3d_7  
    80       USE wrk_nemo, ONLY: zlu_uu=>wrk_4d_1, & 
    81                           zlu_uv=>wrk_4d_2, & 
    82                           zlv_vv=>wrk_4d_3, & 
    83                           zlv_vu=>wrk_4d_4 
    84       !! 
     69      USE wrk_nemo, ONLY:   wrk_use, wrk_release 
     70      USE oce     , ONLY:   zfu    => ta       ! ta used as 3D workspace 
     71      USE oce     , ONLY:   zfv    => sa       ! sa used as 3D workspace 
     72      USE wrk_nemo, ONLY:   zfu_t  => wrk_3d_1 , zfv_t  =>wrk_3d_4 , zfu_uw =>wrk_3d_6   ! 3D workspace 
     73      USE wrk_nemo, ONLY:   zfu_f  => wrk_3d_2 , zfv_f  =>wrk_3d_5 , zfv_vw =>wrk_3d_7 
     74      USE wrk_nemo, ONLY:   zfw    => wrk_3d_3 
     75      USE wrk_nemo, ONLY:   zlu_uu => wrk_4d_1 , zlv_vv=>wrk_4d_3   ! 4D workspace 
     76      USE wrk_nemo, ONLY:   zlu_uv => wrk_4d_2 , zlv_vu=>wrk_4d_4 
     77      ! 
    8578      INTEGER, INTENT(in) ::   kt     ! ocean time-step index 
    86       !! 
     79      ! 
    8780      INTEGER  ::   ji, jj, jk            ! dummy loop indices 
    8881      REAL(wp) ::   zbu, zbv    ! temporary scalars 
    8982      REAL(wp) ::   zui, zvj, zfuj, zfvi, zl_u, zl_v   ! temporary scalars 
    90 ! ARPDBG - arrays below replaced with global work spaces 
    91 !!$      REAL(wp), DIMENSION(jpi,jpj,jpk)   ::   zfu_t, zfu_f     ! temporary workspace 
    92 !!$      REAL(wp), DIMENSION(jpi,jpj,jpk)   ::   zfv_t, zfv_f     !    "           " 
    93 !!$      REAL(wp), DIMENSION(jpi,jpj,jpk)   ::   zfw, zfu_uw, zfv_vw 
    94 !!$      REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   zlu_uu, zlu_uv   ! temporary workspace 
    95 !!$      REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   zlv_vv, zlv_vu   ! temporary workspace 
    9683      !!---------------------------------------------------------------------- 
    9784 
     
    10390 
    10491      ! Check that required workspace arrays are not already in use 
    105       IF( .not. wrk_use(3, 1, 2, 3, 4, 5, 6, 7) )THEN 
    106          CALL ctl_stop('dyn_adv_ubs : error : required 3d workspace array is already in use') 
     92      IF( .not. wrk_use(3, 1,2,3,4,5,6,7) .AND. .not. wrk_use(4, 1,2,3,4) ) THEN 
     93         CALL ctl_stop('dyn_adv_ubs : requested workspace array unavailable')   ;   RETURN 
    10794      END IF 
    108       IF(.not. wrk_use(4, 1, 2, 3, 4) )THEN 
    109          CALL ctl_stop('dyn_adv_ubs : error : required 4d workspace array is already in use') 
    110       END IF 
    111  
    112       zfu_t(:,:,:) = 0.e0 
    113       zfv_t(:,:,:) = 0.e0 
    114       zfu_f(:,:,:) = 0.e0 
    115       zfv_f(:,:,:) = 0.e0 
    116       ! 
    117       zlu_uu(:,:,:,:) = 0.e0  
    118       zlv_vv(:,:,:,:) = 0.e0  
    119       zlu_uv(:,:,:,:) = 0.e0  
    120       zlv_vu(:,:,:,:) = 0.e0  
     95 
     96      zfu_t(:,:,:) = 0._wp 
     97      zfv_t(:,:,:) = 0._wp 
     98      zfu_f(:,:,:) = 0._wp 
     99      zfv_f(:,:,:) = 0._wp 
     100      ! 
     101      zlu_uu(:,:,:,:) = 0._wp 
     102      zlv_vv(:,:,:,:) = 0._wp  
     103      zlu_uv(:,:,:,:) = 0._wp  
     104      zlv_vu(:,:,:,:) = 0._wp  
    121105 
    122106      IF( l_trddyn ) THEN           ! Save ua and va trends 
     
    138122               zlu_uv(ji,jj,jk,1) = ( ub (ji,jj+1,jk)-2.*ub (ji,jj,jk)+ub (ji,jj-1,jk) ) * umask(ji,jj,jk) 
    139123               zlv_vu(ji,jj,jk,1) = ( vb (ji+1,jj,jk)-2.*vb (ji,jj,jk)+vb (ji-1,jj,jk) ) * vmask(ji,jj,jk) 
    140                 
     124               ! 
    141125               zlu_uu(ji,jj,jk,2) = ( zfu(ji+1,jj,jk)-2.*zfu(ji,jj,jk)+zfu(ji-1,jj,jk) ) * umask(ji,jj,jk) 
    142126               zlv_vv(ji,jj,jk,2) = ( zfv(ji,jj+1,jk)-2.*zfv(ji,jj,jk)+zfv(ji,jj-1,jk) ) * vmask(ji,jj,jk) 
     
    147131      END DO 
    148132!!gm BUG !!!  just below this should be +1 in all the communications 
    149       CALL lbc_lnk( zlu_uu(:,:,:,1), 'U', -1.)   ;   CALL lbc_lnk( zlu_uv(:,:,:,1), 'U', -1.) 
    150       CALL lbc_lnk( zlu_uu(:,:,:,2), 'U', -1.)   ;   CALL lbc_lnk( zlu_uv(:,:,:,2), 'U', -1.) 
    151       CALL lbc_lnk( zlv_vv(:,:,:,1), 'V', -1.)   ;   CALL lbc_lnk( zlv_vu(:,:,:,1), 'V', -1.) 
    152       CALL lbc_lnk( zlv_vv(:,:,:,2), 'V', -1.)   ;   CALL lbc_lnk( zlv_vu(:,:,:,2), 'V', -1.)  
    153  
     133!      CALL lbc_lnk( zlu_uu(:,:,:,1), 'U', -1.)   ;   CALL lbc_lnk( zlu_uv(:,:,:,1), 'U', -1.) 
     134!      CALL lbc_lnk( zlu_uu(:,:,:,2), 'U', -1.)   ;   CALL lbc_lnk( zlu_uv(:,:,:,2), 'U', -1.) 
     135!      CALL lbc_lnk( zlv_vv(:,:,:,1), 'V', -1.)   ;   CALL lbc_lnk( zlv_vu(:,:,:,1), 'V', -1.) 
     136!      CALL lbc_lnk( zlv_vv(:,:,:,2), 'V', -1.)   ;   CALL lbc_lnk( zlv_vu(:,:,:,2), 'V', -1.) 
     137! 
    154138!!gm corrected: 
    155139      CALL lbc_lnk( zlu_uu(:,:,:,1), 'U', 1. )   ;   CALL lbc_lnk( zlu_uv(:,:,:,1), 'U', 1. ) 
     
    270254         &                       tab3d_2=va, clinfo2=           ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    271255      ! 
    272       ! Signal that we're done with the 3D and 4D global workspace arrays 
    273       IF( (.not. wrk_release(3, 1, 2, 3, 4, 5, 6, 7)) .OR. & 
    274           (.not. wrk_release(4, 1, 2, 3, 4)) )THEN 
    275          IF(lwp) WRITE(numout,*) 'dyn_adv_ubs : failed to release workspace arrays' 
    276       END IF 
     256      IF( .not. wrk_release(3, 1,2,3,4,5,6,7) .OR. & 
     257          .not. wrk_release(4, 1,2,3,4)        )   CALL ctl_stop('dyn_adv_ubs : failed to release workspace array') 
    277258      ! 
    278259   END SUBROUTINE dyn_adv_ubs 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90

    r2590 r2625  
    7777      !!---------------------------------------------------------------------- 
    7878      USE wrk_nemo, ONLY: wrk_use, wrk_release 
    79       USE wrk_nemo, ONLY: ztrdu => wrk_3d_1, ztrdv => wrk_3d_2 
     79      USE wrk_nemo, ONLY: ztrdu => wrk_3d_1, ztrdv => wrk_3d_2   ! 3D workspace 
    8080      !! 
    8181      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     
    8383      !!---------------------------------------------------------------------- 
    8484      ! 
    85       IF(.NOT. wrk_use(3, 1,2))THEN 
    86          CALL ctl_stop('dyn_hpg: requested workspace arrays are unavailable.') 
    87          RETURN 
     85      IF(.NOT. wrk_use(3, 1,2) ) THEN 
     86         CALL ctl_stop('dyn_hpg: requested workspace arrays are unavailable')   ;   RETURN 
    8887      END IF 
    8988      ! 
     
    112111         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    113112      ! 
    114       IF(.NOT. wrk_release(3, 1,2))THEN 
    115          CALL ctl_stop('dyn_hpg: failed to release workspace arrays.') 
    116       END IF 
     113      IF(.NOT. wrk_release(3, 1,2) )   CALL ctl_stop('dyn_hpg: failed to release workspace arrays') 
    117114      ! 
    118115   END SUBROUTINE dyn_hpg 
     
    606603      USE oce, ONLY :   zhpj => sa   ! use sa as 3D workspace 
    607604      USE wrk_nemo, ONLY: wrk_use, wrk_release 
    608       USE wrk_nemo, ONLY: drhox => wrk_3d_1, dzx => wrk_3d_2 
    609       USE wrk_nemo, ONLY: drhou => wrk_3d_3, dzu => wrk_3d_4, rho_i => wrk_3d_5 
    610       USE wrk_nemo, ONLY: drhoy => wrk_3d_6, dzy => wrk_3d_7 
    611       USE wrk_nemo, ONLY: drhov => wrk_3d_8, dzv => wrk_3d_9, rho_j => wrk_3d_10 
    612       USE wrk_nemo, ONLY: drhoz => wrk_3d_11, dzz => wrk_3d_12  
    613       USE wrk_nemo, ONLY: drhow => wrk_3d_13, dzw => wrk_3d_14 
     605      USE wrk_nemo, ONLY: drhox => wrk_3d_1  , dzx => wrk_3d_2 
     606      USE wrk_nemo, ONLY: drhou => wrk_3d_3  , dzu => wrk_3d_4 , rho_i => wrk_3d_5 
     607      USE wrk_nemo, ONLY: drhoy => wrk_3d_6  , dzy => wrk_3d_7 
     608      USE wrk_nemo, ONLY: drhov => wrk_3d_8  , dzv => wrk_3d_9 , rho_j => wrk_3d_10 
     609      USE wrk_nemo, ONLY: drhoz => wrk_3d_11 , dzz => wrk_3d_12  
     610      USE wrk_nemo, ONLY: drhow => wrk_3d_13 , dzw => wrk_3d_14 
    614611      USE wrk_nemo, ONLY: rho_k => wrk_3d_15 
    615612      !! 
     
    622619      !!---------------------------------------------------------------------- 
    623620 
    624       IF(.NOT. wrk_use(3, 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15))THEN 
    625          CALL ctl_stop('dyn:hpg_djc : requested workspace arrays unavailable.') 
    626          RETURN 
     621      IF(.NOT. wrk_use(3, 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15) ) THEN 
     622         CALL ctl_stop('dyn:hpg_djc : requested workspace arrays unavailable')   ;   RETURN 
    627623      END IF 
    628624 
     
    823819      END DO 
    824820      ! 
    825       IF(.NOT. wrk_release(3, 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15))THEN 
     821      IF(.NOT. wrk_release(3, 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15) )   & 
    826822         CALL ctl_stop('dyn:hpg_djc : failed to release workspace arrays.') 
    827       END IF 
    828823      ! 
    829824   END SUBROUTINE hpg_djc 
     
    841836      USE oce, ONLY :   zhpj => sa   ! use sa as 3D workspace 
    842837      USE wrk_nemo, ONLY: wrk_use, wrk_release 
    843       USE wrk_nemo, ONLY: zdistr => wrk_2d_1, zsina => wrk_2d_2, & 
    844                           zcosa  => wrk_2d_3 
    845       USE wrk_nemo, ONLY: zhpiorg => wrk_3d_1, zhpirot => wrk_3d_2 
    846       USE wrk_nemo, ONLY: zhpitra => wrk_3d_3, zhpine => wrk_3d_4 
    847       USE wrk_nemo, ONLY: zhpjorg => wrk_3d_5, zhpjrot => wrk_3d_6 
    848       USE wrk_nemo, ONLY: zhpjtra => wrk_3d_7, zhpjne => wrk_3d_8 
     838      USE wrk_nemo, ONLY: zdistr  => wrk_2d_1 , zsina   => wrk_2d_2 , zcosa  => wrk_2d_3 
     839      USE wrk_nemo, ONLY: zhpiorg => wrk_3d_1 , zhpirot => wrk_3d_2 
     840      USE wrk_nemo, ONLY: zhpitra => wrk_3d_3 , zhpine  => wrk_3d_4 
     841      USE wrk_nemo, ONLY: zhpjorg => wrk_3d_5 , zhpjrot => wrk_3d_6 
     842      USE wrk_nemo, ONLY: zhpjtra => wrk_3d_7 , zhpjne  => wrk_3d_8 
    849843      !! 
    850844      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
     
    855849      !!---------------------------------------------------------------------- 
    856850 
    857       IF( (.NOT. wrk_use(2, 1,2,3)) .OR.               & 
    858           (.NOT. wrk_use(3, 1,2,3,4,5,6,7,8)))THEN 
    859          CALL ctl_stop('dyn:hpg_rot : requested workspace arrays unavailable.') 
    860          RETURN 
     851      IF( .NOT. wrk_use(2, 1,2,3) .OR.      & 
     852          .NOT. wrk_use(3, 1,2,3,4,5,6,7,8) ) THEN 
     853         CALL ctl_stop('dyn:hpg_rot : requested workspace arrays unavailable')   ;   RETURN 
    861854      END IF 
    862855 
     
    10161009      END DO 
    10171010      ! 
    1018       IF( (.NOT. wrk_release(2, 1,2,3)) .OR.               & 
    1019           (.NOT. wrk_release(3, 1,2,3,4,5,6,7,8)))THEN 
    1020          CALL ctl_stop('dyn:hpg_rot : failed to release workspace arrays.') 
    1021       END IF 
     1011      IF( .NOT. wrk_release(2, 1,2,3)  .OR.     & 
     1012          .NOT. wrk_release(3, 1,2,3,4,5,6,7,8) )   CALL ctl_stop('dyn:hpg_rot : failed to release workspace arrays') 
    10221013      ! 
    10231014   END SUBROUTINE hpg_rot 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90

    r2590 r2625  
    2929   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    3030   !! $Id$  
    31    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     31   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3232   !!---------------------------------------------------------------------- 
    33  
    3433CONTAINS 
    3534 
     
    5251      !!             - save this trends (l_trddyn=T) for post-processing 
    5352      !!---------------------------------------------------------------------- 
    54       USE oce, ONLY :   ztrdu => ta   ! use ta as 3D workspace    
    55       USE oce, ONLY :   ztrdv => sa   ! use sa as 3D workspace    
    56       USE wrk_nemo, ONLY: wrk_use, wrk_release 
    57       USE wrk_nemo, ONLY: zhke => wrk_3d_1 
     53      USE wrk_nemo, ONLY:   wrk_use, wrk_release 
     54      USE oce     , ONLY:   ztrdu => ta       , ztrdv => sa   ! (ta,sa) used as 3D workspace    
     55      USE wrk_nemo, ONLY:   zhke  => wrk_3d_1                 ! 3D workspace 
    5856      !! 
    5957      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
     
    6361      !!---------------------------------------------------------------------- 
    6462 
    65       IF(.NOT. wrk_use(3,1))THEN 
    66          CALL ctl_stop('dyn_key: requested workspace array is unavailable.') 
    67       END IF 
     63      IF(.NOT. wrk_use(3,1) ) THEN 
     64         CALL ctl_stop('dyn_key: requested workspace array is unavailable.')   ;   RETURN 
     65      ENDIF 
    6866 
    6967      IF( kt == nit000 ) THEN 
     
    8886                  &         + vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk)  ) 
    8987               zhke(ji,jj,jk) = zv + zu 
     88!!gm simplier coding  ==>>   ~ faster 
     89!    don't forget to suppress local zu zv scalars 
     90!               zhke(ji,jj,jk) = 0.25 * (   un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)   & 
     91!                  &                      + un(ji  ,jj  ,jk) * un(ji  ,jj  ,jk)   & 
     92!                  &                      + vn(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)   & 
     93!                  &                      + vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk)   ) 
     94!!gm end <<== 
    9095            END DO   
    9196         END DO   
     
    96101            END DO  
    97102         END DO 
     103!!gm idea to be tested  ==>>   is it faster on scalar computers ? 
     104!         DO jj = 2, jpjm1       ! add the gradient of kinetic energy to the general momentum trends 
     105!            DO ji = fs_2, fs_jpim1   ! vector opt. 
     106!               ua(ji,jj,jk) = ua(ji,jj,jk) - 0.25 * ( + un(ji+1,jj  ,jk) * un(ji+1,jj  ,jk)   & 
     107!                  &                                   + vn(ji+1,jj-1,jk) * vn(ji+1,jj-1,jk)   & 
     108!                  &                                   + vn(ji+1,jj  ,jk) * vn(ji+1,jj  ,jk)   & 
     109!                  ! 
     110!                  &                                   - un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)   & 
     111!                  &                                   - vn(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)   & 
     112!                  &                                   - vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk)   ) / e1u(ji,jj) 
     113!                  ! 
     114!               va(ji,jj,jk) = va(ji,jj,jk) - 0.25 * (   un(ji-1,jj+1,jk) * un(ji-1,jj+1,jk)   & 
     115!                  &                                   + un(ji  ,jj+1,jk) * un(ji  ,jj+1,jk)   & 
     116!                  &                                   + vn(ji  ,jj+1,jk) * vn(ji  ,jj+1,jk)   & 
     117!                  ! 
     118!                  &                                   - un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)   & 
     119!                  &                                   - un(ji  ,jj  ,jk) * un(ji  ,jj  ,jk)   & 
     120!                  &                                   - vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk)   ) / e2v(ji,jj) 
     121!            END DO  
     122!         END DO 
     123!!gm en idea            <<== 
    98124         !                                             ! =============== 
    99125      END DO                                           !   End of slab 
     
    109135         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    110136      ! 
    111       IF(.NOT. wrk_release(3,1))THEN 
    112          CALL ctl_stop('dyn_key: failed to release workspace array.') 
    113       END IF 
    114  
     137      IF(.NOT. wrk_release(3, 1) )   CALL ctl_stop('dyn_key: failed to release workspace array') 
     138      ! 
    115139   END SUBROUTINE dyn_keg 
    116140 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilap.F90

    r2590 r2625  
    44   !! Ocean dynamics:  lateral viscosity trend 
    55   !!====================================================================== 
     6   !! History :  OPA  ! 1990-09  (G. Madec)  Original code 
     7   !!            4.0  ! 1993-03  (M. Guyon)  symetrical conditions (M. Guyon) 
     8   !!            6.0  ! 1996-01  (G. Madec)  statement function for e3 
     9   !!            8.0  ! 1997-07  (G. Madec)  lbc calls 
     10   !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90: Free form and module 
     11   !!            2.0  ! 2004-08  (C. Talandier) New trends organization 
     12   !!---------------------------------------------------------------------- 
    613 
    714   !!---------------------------------------------------------------------- 
     
    916   !!                   using an iso-level bilaplacian operator 
    1017   !!---------------------------------------------------------------------- 
    11    !! * Modules used 
    1218   USE oce             ! ocean dynamics and tracers 
    1319   USE dom_oce         ! ocean space and time domain 
     
    3137   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    3238   !! $Id$  
    33    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    34    !!---------------------------------------------------------------------- 
    35  
     39   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     40   !!---------------------------------------------------------------------- 
    3641CONTAINS 
    3742 
     
    6974      !! ** Action : - Update (ua,va) with the before iso-level biharmonic 
    7075      !!               mixing trend. 
    71       !! 
    72       !! History : 
    73       !!        !  90-09  (G. Madec)  Original code 
    74       !!        !  91-11  (G. Madec) 
    75       !!        !  93-03  (M. Guyon)  symetrical conditions (M. Guyon) 
    76       !!        !  96-01  (G. Madec)  statement function for e3 
    77       !!        !  97-07  (G. Madec)  lbc calls 
    78       !!   8.5  !  02-08  (G. Madec)  F90: Free form and module 
    79       !!   9.0  !  04-08  (C. Talandier) New trends organization 
    8076      !!---------------------------------------------------------------------- 
    8177      USE wrk_nemo, ONLY: wrk_use, wrk_release 
    82       USE wrk_nemo, ONLY: zcu => wrk_2d_1, zcv => wrk_2d_2  
    83       USE wrk_nemo, ONLY: zuf => wrk_3d_1, zut => wrk_3d_2, & 
    84                           zlu => wrk_3d_3, zlv => wrk_3d_4 
    85       !! * Arguments 
    86       INTEGER, INTENT( in ) ::   kt           ! ocean time-step index 
    87  
    88       !! * Local declarations 
     78      USE wrk_nemo, ONLY: zcu => wrk_2d_1, zcv => wrk_2d_2   ! 3D workspace 
     79      USE wrk_nemo, ONLY: zuf => wrk_3d_1, zut => wrk_3d_2   ! 3D workspace 
     80      USE wrk_nemo, ONLY: zlu => wrk_3d_3, zlv => wrk_3d_4 
     81      ! 
     82      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     83      ! 
    8984      INTEGER  ::   ji, jj, jk                ! dummy loop indices 
    9085      REAL(wp) ::   zua, zva, zbt, ze2u, ze2v ! temporary scalar 
    9186      !!---------------------------------------------------------------------- 
    92       !!  OPA 8.5, LODYC-IPSL (2002) 
    93       !!---------------------------------------------------------------------- 
    94  
    95       IF( (.NOT. wrk_use(2, 1,2)) .OR. (.NOT. wrk_use(3, 1,2,3,4)) )THEN 
    96          CALL ctl_stop('dyn_ldf_bilap : requested workspace arrays unavailable.') 
    97          RETURN 
    98       END IF 
    99  
    100       IF( kt == nit000 ) THEN 
    101          IF(lwp) WRITE(numout,*) 
    102          IF(lwp) WRITE(numout,*) 'dyn_ldf_bilap : iso-level bilaplacian operator' 
    103          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~' 
     87 
     88      IF( .NOT. wrk_use(2, 1,2) .OR. .NOT. wrk_use(3, 1,2,3,4) ) THEN 
     89         CALL ctl_stop('dyn_ldf_bilap : requested workspace arrays unavailable')   ;   RETURN 
     90      ENDIF 
     91 
     92      IF( kt == nit000 .AND. lwp ) THEN 
     93         WRITE(numout,*) 
     94         WRITE(numout,*) 'dyn_ldf_bilap : iso-level bilaplacian operator' 
     95         WRITE(numout,*) '~~~~~~~~~~~~~' 
    10496      ENDIF 
    10597 
     
    109101!!$      zlu(:,:,jpk) = 0.e0 
    110102!!$      zlv(:,:,jpk) = 0.e0 
    111       zuf(:,:,:) = 0.e0 
    112       zut(:,:,:) = 0.e0 
    113       zlu(:,:,:) = 0.e0 
    114       zlv(:,:,:) = 0.e0 
     103      zuf(:,:,:) = 0._wp 
     104      zut(:,:,:) = 0._wp 
     105      zlu(:,:,:) = 0._wp 
     106      zlv(:,:,:) = 0._wp 
    115107 
    116108      !                                                ! =============== 
     
    142134            END DO   
    143135         ENDIF 
    144       ENDDO 
    145  
    146       ! Boundary conditions on the laplacian  (zlu,zlv) 
    147       CALL lbc_lnk( zlu, 'U', -1. ) 
    148       CALL lbc_lnk( zlv, 'V', -1. ) 
    149           
     136      END DO 
     137      CALL lbc_lnk( zlu, 'U', -1. )   ;   CALL lbc_lnk( zlv, 'V', -1. )   ! Boundary conditions 
     138 
    150139          
    151140      DO jk = 1, jpkm1 
     
    219208      END DO                                           !   End of slab 
    220209      !                                                ! =============== 
    221       IF( (.NOT. wrk_release(2, 1,2)) .OR.       & 
    222           (.NOT. wrk_release(3, 1,2,3,4)) )THEN 
    223          CALL ctl_stop('dyn_ldf_bilap : failed to release workspace arrays.') 
    224       END IF 
     210      IF( .NOT. wrk_release(2, 1,2)      .OR.   & 
     211          .NOT. wrk_release(3, 1,2,3,4) )   CALL ctl_stop('dyn_ldf_bilap : failed to release workspace arrays') 
    225212      ! 
    226213   END SUBROUTINE dyn_ldf_bilap 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90

    r2613 r2625  
    2020   USE lib_print     ! formated print library 
    2121   USE nc4interface  ! NetCDF4 interface 
    22    USE lib_mpp, ONLY :   lk_mpp 
     22   USE lib_mpp       ! MPP library 
    2323 
    2424   IMPLICIT NONE 
     
    173173            WRITE(numout,*)  
    174174            WRITE(numout,*) 'huge E-R-R-O-R : immediate stop' 
    175             IF(lk_mpp)   CALL mppstop() 
    176             STOP 
     175            CALL mppstop() 
    177176         ENDIF 
    178177      ENDIF 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r2590 r2625  
    2323   !!   'key_mpp_mpi'             MPI massively parallel processing library 
    2424   !!---------------------------------------------------------------------- 
    25    !!   mynode      : indentify the processor unit 
    26    !!   mpp_lnk     : interface (defined in lbclnk) for message passing of 2d or 3d arrays (mpp_lnk_2d, mpp_lnk_3d) 
     25   !!   lib_mpp_alloc : allocate mpp arrays 
     26   !!   mynode        : indentify the processor unit 
     27   !!   mpp_lnk       : interface (defined in lbclnk) for message passing of 2d or 3d arrays (mpp_lnk_2d, mpp_lnk_3d) 
    2728   !!   mpp_lnk_3d_gather :  Message passing manadgement for two 3D arrays 
    28    !!   mpp_lnk_e   : interface (defined in lbclnk) for message passing of 2d array with extra halo (mpp_lnk_2d_e) 
    29    !!   mpprecv     : 
    30    !!   mppsend     :   SUBROUTINE mpp_ini_znl 
    31    !!   mppscatter  : 
    32    !!   mppgather   : 
    33    !!   mpp_min     : generic interface for mppmin_int , mppmin_a_int , mppmin_real, mppmin_a_real 
    34    !!   mpp_max     : generic interface for mppmax_int , mppmax_a_int , mppmax_real, mppmax_a_real 
    35    !!   mpp_sum     : generic interface for mppsum_int , mppsum_a_int , mppsum_real, mppsum_a_real 
    36    !!   mpp_minloc  : 
    37    !!   mpp_maxloc  : 
    38    !!   mppsync     : 
    39    !!   mppstop     : 
    40    !!   mppobc      : variant of mpp_lnk for open boundary condition 
     29   !!   mpp_lnk_e     : interface (defined in lbclnk) for message passing of 2d array with extra halo (mpp_lnk_2d_e) 
     30   !!   mpprecv         : 
     31   !!   mppsend       :   SUBROUTINE mpp_ini_znl 
     32   !!   mppscatter    : 
     33   !!   mppgather     : 
     34   !!   mpp_min       : generic interface for mppmin_int , mppmin_a_int , mppmin_real, mppmin_a_real 
     35   !!   mpp_max       : generic interface for mppmax_int , mppmax_a_int , mppmax_real, mppmax_a_real 
     36   !!   mpp_sum       : generic interface for mppsum_int , mppsum_a_int , mppsum_real, mppsum_a_real 
     37   !!   mpp_minloc    : 
     38   !!   mpp_maxloc    : 
     39   !!   mppsync       : 
     40   !!   mppstop       : 
     41   !!   mppobc        : variant of mpp_lnk for open boundary condition 
    4142   !!   mpp_ini_north : initialisation of north fold 
    4243   !!   mpp_lbc_north : north fold processors gathering 
    4344   !!   mpp_lbc_north_e : variant of mpp_lbc_north for extra outer halo 
    4445   !!---------------------------------------------------------------------- 
    45    !! History : 
    46    !!        !  94 (M. Guyon, J. Escobar, M. Imbard)  Original code 
    47    !!        !  97  (A.M. Treguier)  SHMEM additions 
    48    !!        !  98  (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI 
    49    !!   9.0  !  03  (J.-M. Molines, G. Madec)  F90, free form 
    50    !!        !  04  (R. Bourdalle Badie)  isend option in mpi 
    51    !!        !  05  (G. Madec, S. Masson)  npolj=5,6 F-point & ice cases 
    52    !!        !  05  (R. Redler) Replacement of MPI_COMM_WORLD except for MPI_Abort 
    53    !!        !  09  (R. Benshila) SHMEM suppression, north fold in lbc_nfd 
     46   !! History :  OPA  ! 1994 (M. Guyon, J. Escobar, M. Imbard)  Original code 
     47   !!                 ! 1997  (A.M. Treguier)  SHMEM additions 
     48   !!                 ! 1998  (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI 
     49   !!   NEMO     1.0  ! 2003  (J.-M. Molines, G. Madec)  F90, free form 
     50   !!                 ! 2004  (R. Bourdalle Badie)  isend option in mpi 
     51   !!                 ! 2005  (G. Madec, S. Masson)  npolj=5,6 F-point & ice cases 
     52   !!                 ! 2005  (R. Redler) Replacement of MPI_COMM_WORLD except for MPI_Abort 
     53   !!                 ! 2009  (R. Benshila) SHMEM suppression, north fold in lbc_nfd 
    5454   !!---------------------------------------------------------------------- 
    55    USE dom_oce                    ! ocean space and time domain  
    56    USE in_out_manager             ! I/O manager 
    57    USE lbcnfd                     ! north fold treatment 
     55   USE dom_oce        ! ocean space and time domain  
     56   USE lbcnfd         ! north fold treatment 
    5857 
    5958   IMPLICIT NONE 
     
    117116# endif 
    118117 
     118   CHARACTER(lc) ::   cform_err = "(/,' ===>>> : E R R O R',     /,'         ===========',/)"       !: 
     119   CHARACTER(lc) ::   cform_war = "(/,' ===>>> : W A R N I N G', /,'         ===============',/)"   !: 
     120 
    119121   ! variables used in case of sea-ice 
    120122   INTEGER, PUBLIC ::   ncomm_ice       !: communicator made by the processors with sea-ice 
     
    152154   REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE, SAVE ::   t4ew, t4we   ! 2 x 3d for east-west & west-east 
    153155   REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE, SAVE ::   t4p1, t4p2   ! 2 x 3d for north fold 
    154    REAL(wp),   DIMENSION(:,:,:,:), ALLOCATABLE, SAVE ::   t3ns, t3sn   ! 3d for north-south & south-north 
    155    REAL(wp),   DIMENSION(:,:,:,:), ALLOCATABLE, SAVE ::   t3ew, t3we   ! 3d for east-west & west-east 
    156    REAL(wp),   DIMENSION(:,:,:,:), ALLOCATABLE, SAVE ::   t3p1, t3p2   ! 3d for north fold 
    157    REAL(wp),     DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   t2ns, t2sn   ! 2d for north-south & south-north 
    158    REAL(wp),     DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   t2ew, t2we   ! 2d for east-west & west-east 
    159    REAL(wp),     DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   t2p1, t2p2   ! 2d for north fold 
    160    REAL(wp),     DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   tr2ns, tr2sn ! 2d for north-south & south-north + extra outer halo 
    161    REAL(wp),     DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   tr2ew, tr2we ! 2d for east-west   & west-east   + extra outer halo 
     156   REAL(wp), DIMENSION(:,:,:,:)  , ALLOCATABLE, SAVE ::   t3ns, t3sn   ! 3d for north-south & south-north 
     157   REAL(wp), DIMENSION(:,:,:,:)  , ALLOCATABLE, SAVE ::   t3ew, t3we   ! 3d for east-west & west-east 
     158   REAL(wp), DIMENSION(:,:,:,:)  , ALLOCATABLE, SAVE ::   t3p1, t3p2   ! 3d for north fold 
     159   REAL(wp), DIMENSION(:,:,:)    , ALLOCATABLE, SAVE ::   t2ns, t2sn   ! 2d for north-south & south-north 
     160   REAL(wp), DIMENSION(:,:,:)    , ALLOCATABLE, SAVE ::   t2ew, t2we   ! 2d for east-west & west-east 
     161   REAL(wp), DIMENSION(:,:,:)    , ALLOCATABLE, SAVE ::   t2p1, t2p2   ! 2d for north fold 
     162   REAL(wp), DIMENSION(:,:,:)    , ALLOCATABLE, SAVE ::   tr2ns, tr2sn ! 2d for north-south & south-north + extra outer halo 
     163   REAL(wp), DIMENSION(:,:,:)    , ALLOCATABLE, SAVE ::   tr2ew, tr2we ! 2d for east-west   & west-east   + extra outer halo 
    162164 
    163165   ! Arrays used in mpp_lbc_north_3d() 
    164    REAL(wp),   DIMENSION(:,:,:), ALLOCATABLE, SAVE   ::   ztab 
    165    REAL(wp),   DIMENSION(:,:,:), ALLOCATABLE, SAVE   ::   znorthloc 
     166   REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE, SAVE   ::   ztab, znorthloc 
    166167   REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, SAVE   ::   znorthgloio 
    167168 
    168169   ! Arrays used in mpp_lbc_north_2d() 
    169    REAL(wp),   DIMENSION(:,:), ALLOCATABLE, SAVE    ::   ztab_2d 
    170    REAL(wp),   DIMENSION(:,:), ALLOCATABLE, SAVE    ::   znorthloc_2d 
     170   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, SAVE    ::   ztab_2d, znorthloc_2d 
    171171   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE    ::   znorthgloio_2d 
    172172 
    173173   ! Arrays used in mpp_lbc_north_e() 
    174    REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, SAVE    ::   ztab_e 
    175    REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, SAVE    ::   znorthloc_e 
     174   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, SAVE    ::   ztab_e, znorthloc_e 
    176175   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE    ::   znorthgloio_e 
    177176 
     
    179178   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    180179   !! $Id$ 
    181    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     180   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    182181   !!---------------------------------------------------------------------- 
    183  
    184182CONTAINS 
    185183 
    186    FUNCTION lib_mpp_alloc() 
     184   INTEGER FUNCTION lib_mpp_alloc( kumout ) 
    187185      !!---------------------------------------------------------------------- 
    188186      !!              ***  routine lib_mpp_alloc  *** 
    189187      !!---------------------------------------------------------------------- 
    190       INTEGER :: lib_mpp_alloc 
    191       !!---------------------------------------------------------------------- 
    192  
    193       ALLOCATE(t4ns(jpi,jprecj,jpk,2,2), t4sn(jpi,jprecj,jpk,2,2), & 
    194                t4ew(jpj,jpreci,jpk,2,2), t4we(jpj,jpreci,jpk,2,2), & 
    195                t4p1(jpi,jprecj,jpk,2,2), t4p2(jpi,jprecj,jpk,2,2), & 
    196                t3ns(jpi,jprecj,jpk,2),   t3sn(jpi,jprecj,jpk,2),   & 
    197                t3ew(jpj,jpreci,jpk,2),   t3we(jpj,jpreci,jpk,2),   & 
    198                t3p1(jpi,jprecj,jpk,2),   t3p2(jpi,jprecj,jpk,2),   & 
    199                t2ns(jpi,jprecj,2),       t2sn(jpi,jprecj,2),       & 
    200                t2ew(jpj,jpreci,2),       t2we(jpj,jpreci,2),       & 
    201                t2p1(jpi,jprecj,2),       t2p2(jpi,jprecj,2),       & 
    202                tr2ns(1-jpr2di:jpi+jpr2di,jprecj+jpr2dj,2),         & 
    203                tr2sn(1-jpr2di:jpi+jpr2di,jprecj+jpr2dj,2),         & 
    204                tr2ew(1-jpr2dj:jpj+jpr2dj,jpreci+jpr2di,2),         & 
    205                tr2we(1-jpr2dj:jpj+jpr2dj,jpreci+jpr2di,2),         & 
    206                ! 
    207                ztab(jpiglo,4,jpk),       znorthloc(jpi,4,jpk),     & 
    208                znorthgloio(jpi,4,jpk,jpni),                        & 
    209                ! 
    210                ztab_2d(jpiglo,4),        znorthloc_2d(jpi,4),      & 
    211                znorthgloio_2d(jpi,4,jpni),                         & 
    212                ! 
    213                ztab_e(jpiglo,4+2*jpr2dj),znorthloc_e(jpi,4+2*jpr2dj), & 
    214                znorthgloio_e(jpi,4+2*jpr2dj,jpni),                    & 
    215                Stat=lib_mpp_alloc) 
    216  
    217       IF(lib_mpp_alloc /= 0)THEN 
    218          CALL ctl_warn('lib_mpp_alloc : failed to allocate arrays.') 
    219       END IF 
    220  
     188      INTEGER, INTENT(in) ::   kumout   ! ocean.output logical unit 
     189      !!---------------------------------------------------------------------- 
     190      ! 
     191      ALLOCATE( t4ns(jpi,jprecj,jpk,2,2) , t4sn(jpi,jprecj,jpk,2,2) ,                                            & 
     192         &      t4ew(jpj,jpreci,jpk,2,2) , t4we(jpj,jpreci,jpk,2,2) ,                                            & 
     193         &      t4p1(jpi,jprecj,jpk,2,2) , t4p2(jpi,jprecj,jpk,2,2) ,                                            & 
     194         &      t3ns(jpi,jprecj,jpk,2)   , t3sn(jpi,jprecj,jpk,2)   ,                                            & 
     195         &      t3ew(jpj,jpreci,jpk,2)   , t3we(jpj,jpreci,jpk,2)   ,                                            & 
     196         &      t3p1(jpi,jprecj,jpk,2)   , t3p2(jpi,jprecj,jpk,2)   ,                                            & 
     197         &      t2ns(jpi,jprecj    ,2)   , t2sn(jpi,jprecj    ,2)   ,                                            & 
     198         &      t2ew(jpj,jpreci    ,2)   , t2we(jpj,jpreci    ,2)   ,                                            & 
     199         &      t2p1(jpi,jprecj    ,2)   , t2p2(jpi,jprecj    ,2)   ,                                            & 
     200         ! 
     201         &      tr2ns(1-jpr2di:jpi+jpr2di,jprecj+jpr2dj,2) ,                                                     & 
     202         &      tr2sn(1-jpr2di:jpi+jpr2di,jprecj+jpr2dj,2) ,                                                     & 
     203         &      tr2ew(1-jpr2dj:jpj+jpr2dj,jpreci+jpr2di,2) ,                                                     & 
     204         &      tr2we(1-jpr2dj:jpj+jpr2dj,jpreci+jpr2di,2) ,                                                     & 
     205         ! 
     206         &      ztab(jpiglo,4,jpk) , znorthloc(jpi,4,jpk) , znorthgloio(jpi,4,jpk,jpni) ,                        & 
     207         ! 
     208         &      ztab_2d(jpiglo,4)  , znorthloc_2d(jpi,4)  , znorthgloio_2d(jpi,4,jpni)  ,                        & 
     209         ! 
     210         &      ztab_e(jpiglo,4+2*jpr2dj) , znorthloc_e(jpi,4+2*jpr2dj) , znorthgloio_e(jpi,4+2*jpr2dj,jpni) ,   & 
     211         ! 
     212         &      STAT=lib_mpp_alloc ) 
     213         ! 
     214      IF( lib_mpp_alloc /= 0 ) THEN 
     215         WRITE(kumout,cform_war) 
     216         WRITE(kumout,*) 'lib_mpp_alloc : failed to allocate arrays' 
     217      ENDIF 
     218      ! 
    221219   END FUNCTION lib_mpp_alloc 
    222220 
    223221 
    224    FUNCTION mynode(ldtxt, localComm) 
     222   FUNCTION mynode( ldtxt, kumnam, kstop, localComm ) 
    225223      !!---------------------------------------------------------------------- 
    226224      !!                  ***  routine mynode  *** 
    227225      !!                     
    228226      !! ** Purpose :   Find processor unit 
    229       !! 
    230227      !!---------------------------------------------------------------------- 
    231228      CHARACTER(len=*),DIMENSION(:), INTENT(  out) ::   ldtxt  
     229      INTEGER                      , INTENT(in   ) ::   kumnam       ! namelist logical unit  
     230      INTEGER                      , INTENT(inout) ::   kstop        ! stop indicator  
    232231      INTEGER, OPTIONAL            , INTENT(in   ) ::   localComm 
     232      ! 
    233233      INTEGER ::   mynode, ierr, code, ji, ii 
    234234      LOGICAL ::   mpi_was_called 
    235        
     235      ! 
    236236      NAMELIST/nammpp/ cn_mpi_send, nn_buffer 
    237237      !!---------------------------------------------------------------------- 
     
    242242      WRITE(ldtxt(ii),*) '~~~~~~ '                                                                ;   ii = ii + 1 
    243243      ! 
    244       REWIND( numnam )               ! Namelist namrun : parameters of the run 
    245       READ  ( numnam, nammpp ) 
     244      REWIND( kumnam )               ! Namelist namrun : parameters of the run 
     245      READ  ( kumnam, nammpp ) 
    246246      !                              ! control print 
    247247      WRITE(ldtxt(ii),*) '   Namelist nammpp'                                                     ;   ii = ii + 1 
     
    273273            WRITE(ldtxt(ii),cform_err)                                                            ;   ii = ii + 1 
    274274            WRITE(ldtxt(ii),*) '           bad value for cn_mpi_send = ', cn_mpi_send             ;   ii = ii + 1 
    275             nstop = nstop + 1 
     275            kstop = kstop + 1 
    276276         END SELECT 
    277277      ELSE IF ( PRESENT(localComm) .and. .not. mpi_was_called ) THEN 
    278278         WRITE(ldtxt(ii),*) ' lib_mpp: You cannot provide a local communicator '                  ;   ii = ii + 1 
    279279         WRITE(ldtxt(ii),*) '          without calling MPI_Init before ! '                        ;   ii = ii + 1 
    280          nstop = nstop + 1 
     280         kstop = kstop + 1 
    281281      ELSE 
    282282         SELECT CASE ( cn_mpi_send ) 
     
    294294            WRITE(ldtxt(ii),cform_err)                                                            ;   ii = ii + 1 
    295295            WRITE(ldtxt(ii),*) '           bad value for cn_mpi_send = ', cn_mpi_send             ;   ii = ii + 1 
    296             nstop = nstop + 1 
     296            kstop = kstop + 1 
    297297         END SELECT 
    298298         ! 
     
    17061706 
    17071707 
    1708    SUBROUTINE mppobc( ptab, kd1, kd2, kl, kk, ktype, kij ) 
     1708   SUBROUTINE mppobc( ptab, kd1, kd2, kl, kk, ktype, kij , kumout) 
    17091709      !!---------------------------------------------------------------------- 
    17101710      !!                  ***  routine mppobc  *** 
     
    17261726      !! 
    17271727      !!---------------------------------------------------------------------- 
    1728       USE wrk_nemo, ONLY: wrk_use, wrk_release 
    1729       USE wrk_nemo, ONLY: ztab => wrk_2d_1 
     1728      USE wrk_nemo, ONLY:   wrk_use, wrk_release 
     1729      USE wrk_nemo, ONLY:   ztab => wrk_2d_1 
     1730      ! 
    17301731      INTEGER , INTENT(in   )                     ::   kd1, kd2   ! starting and ending indices 
    17311732      INTEGER , INTENT(in   )                     ::   kl         ! index of open boundary 
     
    17341735      !                                                           !  = 1  north/south  ;  = 2  east/west 
    17351736      INTEGER , INTENT(in   )                     ::   kij        ! horizontal dimension 
     1737      INTEGER , INTENT(in   )                     ::   kumout     ! ocean.output logical unit 
    17361738      REAL(wp), INTENT(inout), DIMENSION(kij,kk)  ::   ptab       ! variable array 
    1737       !!  
    1738       INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
    1739       INTEGER  ::   iipt0, iipt1, ilpt1   ! temporary integers 
    1740       INTEGER  ::   ijpt0, ijpt1          !    -          - 
    1741       INTEGER  ::   imigr, iihom, ijhom   !    -          - 
     1739      ! 
     1740      INTEGER ::   ji, jj, jk, jl        ! dummy loop indices 
     1741      INTEGER ::   iipt0, iipt1, ilpt1   ! local integers 
     1742      INTEGER ::   ijpt0, ijpt1          !   -       - 
     1743      INTEGER ::   imigr, iihom, ijhom   !   -       - 
    17421744      INTEGER ::   ml_req1, ml_req2, ml_err    ! for key_mpi_isend 
    17431745      INTEGER ::   ml_stat(MPI_STATUS_SIZE)    ! for key_mpi_isend 
    17441746      !!---------------------------------------------------------------------- 
    17451747 
    1746       IF(.NOT. wrk_use(2, 1))THEN 
    1747          CALL ctl_stop('mppobc : requested workspace array unavailable.') 
    1748          RETURN 
     1748      IF(.NOT. wrk_use(2, 1) ) THEN 
     1749         WRITE(kumout, cform_err) 
     1750         WRITE(kumout,*) 'mppobc : requested workspace array unavailable' 
     1751         CALL mppstop 
    17491752      END IF 
    17501753 
     
    17661769         ilpt1 = MAX( 1, MIN(kd2 - njmpp+1, nlcj     ) ) 
    17671770      ELSE 
    1768          CALL ctl_stop( 'mppobc: bad ktype' ) 
     1771         WRITE(kumout, cform_err) 
     1772         WRITE(kumout,*) 'mppobc : bad ktype' 
     1773         CALL mppstop 
    17691774      ENDIF 
    17701775       
     
    18961901      END DO 
    18971902      ! 
    1898       IF(.NOT. wrk_release(2, 1))THEN 
    1899          CALL ctl_stop('mppobc : failed to release workspace array.') 
    1900       END IF 
     1903      IF(.NOT. wrk_release(2, 1) ) THEN 
     1904         WRITE(kumout, cform_err) 
     1905         WRITE(kumout,*) 'mppobc : failed to release workspace array' 
     1906         CALL mppstop 
     1907      ENDIF 
    19011908      ! 
    19021909   END SUBROUTINE mppobc 
     
    19161923 
    19171924 
    1918    SUBROUTINE mpp_ini_ice( pindic ) 
     1925   SUBROUTINE mpp_ini_ice( pindic, kumout ) 
    19191926      !!---------------------------------------------------------------------- 
    19201927      !!               ***  routine mpp_ini_ice  *** 
     
    19381945      !! 
    19391946      !!---------------------------------------------------------------------- 
    1940       INTEGER, INTENT(in) :: pindic 
    1941       !! 
    1942       INTEGER :: ierr 
     1947      INTEGER, INTENT(in) ::   pindic 
     1948      INTEGER, INTENT(in) ::   kumout   ! ocean.output logical unit 
     1949      !! 
    19431950      INTEGER :: jjproc 
    1944       INTEGER :: ii 
    1945       INTEGER, ALLOCATABLE, DIMENSION(:) :: kice 
    1946       INTEGER, ALLOCATABLE, DIMENSION(:) :: zwork 
     1951      INTEGER :: ii, ierr 
     1952      INTEGER, ALLOCATABLE, DIMENSION(:) ::   kice 
     1953      INTEGER, ALLOCATABLE, DIMENSION(:) ::   zwork 
    19471954      !!---------------------------------------------------------------------- 
    19481955      ! 
    19491956      ! Since this is just an init routine and these arrays are of length jpnij 
    19501957      ! then don't use wrk_nemo module - just allocate and deallocate. 
    1951       ALLOCATE(kice(jpnij), zwork(jpnij), Stat=ierr) 
    1952       IF(ierr /= 0)THEN 
    1953          CALL ctl_stop('mpp_ini_ice : failed to allocate 2, 1D arrays (jpnij in length).') 
    1954          RETURN 
     1958      ALLOCATE( kice(jpnij), zwork(jpnij), STAT=ierr ) 
     1959      IF( ierr /= 0 ) THEN 
     1960         WRITE(kumout, cform_err) 
     1961         WRITE(kumout,*) 'mpp_ini_ice : failed to allocate 2, 1D arrays (jpnij in length)' 
     1962         CALL mppstop 
    19551963      ENDIF 
    19561964 
     
    19962004      ! CALL MPI_GROUP_TRANSLATE_RANKS(ngrp_ice,1,0,ngrp_world,n_ice_root,ierr) 
    19972005      ! 
    1998  
    19992006      DEALLOCATE(kice, zwork) 
    2000  
     2007      ! 
    20012008   END SUBROUTINE mpp_ini_ice 
    20022009 
    20032010 
    2004    SUBROUTINE mpp_ini_znl 
     2011   SUBROUTINE mpp_ini_znl ( kumout ) 
    20052012      !!---------------------------------------------------------------------- 
    20062013      !!               ***  routine mpp_ini_znl  *** 
     
    20212028      !! 
    20222029      !!---------------------------------------------------------------------- 
    2023       INTEGER :: ierr 
    2024       INTEGER :: jproc 
    2025       INTEGER :: ii 
    2026       INTEGER, ALLOCATABLE, DIMENSION(:) :: kwork 
    2027       ! 
     2030      INTEGER, INTENT(in) ::   kumout   ! ocean.output logical units 
     2031      ! 
     2032      INTEGER :: jproc      ! dummy loop integer 
     2033      INTEGER :: ierr, ii   ! local integer 
     2034      INTEGER, ALLOCATABLE, DIMENSION(:) ::   kwork 
     2035      !!---------------------------------------------------------------------- 
    20282036      !-$$     WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ngrp_world     : ', ngrp_world 
    20292037      !-$$     WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - mpi_comm_world : ', mpi_comm_world 
    20302038      !-$$     WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - mpi_comm_opa   : ', mpi_comm_opa 
    20312039      ! 
    2032       ALLOCATE(kwork(jpnij), Stat=ierr) 
    2033       IF(ierr /= 0)THEN 
    2034          CALL ctl_stop('mpp_ini_znl : failed to allocate 1D array of length jpnij') 
    2035          RETURN 
    2036       END IF 
    2037  
    2038       IF ( jpnj == 1 ) THEN 
     2040      ALLOCATE( kwork(jpnij), STAT=ierr ) 
     2041      IF( ierr /= 0 ) THEN 
     2042         WRITE(kumout, cform_err) 
     2043         WRITE(kumout,*) 'mpp_ini_znl : failed to allocate 1D array of length jpnij' 
     2044         CALL mppstop 
     2045      ENDIF 
     2046 
     2047      IF( jpnj == 1 ) THEN 
    20392048         ngrp_znl  = ngrp_world 
    20402049         ncomm_znl = mpi_comm_opa 
     
    24112420         ! Buffer allocation and attachment 
    24122421         ALLOCATE( tampon(nn_buffer), stat = ierr ) 
    2413          IF (ierr /= 0) THEN  
     2422         IF( ierr /= 0 ) THEN  
    24142423            DO ji = 1, SIZE(ldtxt)  
    24152424               IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode 
     
    24852494CONTAINS 
    24862495 
     2496   INTEGER FUNCTION lib_mpp_alloc()          ! Dummy function 
     2497      lib_mpp_alloc = 0 
     2498   END FUNCTION lib_mpp_alloc 
     2499 
    24872500   FUNCTION mynode( ldtxt, localComm ) RESULT (function_value) 
    24882501      CHARACTER(len=*),DIMENSION(:), INTENT(  out) ::   ldtxt  
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/OBC/obcrad.F90

    r2528 r2625  
    1212   !!   obc_rad_south  : compute the south phase velocities 
    1313   !!--------------------------------------------------------------------------------- 
    14    !! * Modules used 
    1514   USE oce             ! ocean dynamics and tracers variables 
    1615   USE dom_oce         ! ocean space and time domain variables 
     
    2423   PRIVATE 
    2524 
    26    !! * Accessibility 
    27    PUBLIC obc_rad        ! routine called by step.F90 
    28  
    29    !! * Module variables 
     25   PUBLIC   obc_rad    ! routine called by step.F90 
     26 
    3027   INTEGER ::   ji, jj, jk     ! dummy loop indices 
    3128 
     
    6966      !!                                                 J. Molines and G. Madec version 
    7067      !!------------------------------------------------------------------------------ 
    71       !! * Arguments 
    7268      INTEGER, INTENT( in ) ::   kt 
    7369      !!---------------------------------------------------------------------- 
     
    143139            END DO 
    144140         END DO 
    145          IF( lk_mpp )   CALL mppobc(uebnd,jpjed,jpjef,jpieob,jpk*3*3,2,jpj) 
     141         IF( lk_mpp )   CALL mppobc(uebnd,jpjed,jpjef,jpieob,jpk*3*3,2,jpj, numout ) 
    146142 
    147143         ! ... extremeties nie0, nie1 
     
    185181            END DO 
    186182         END DO 
    187          IF( lk_mpp )   CALL mppobc(vebnd,jpjed,jpjef,jpieob+1,jpk*3*3,2,jpj) 
     183         IF( lk_mpp )   CALL mppobc(vebnd,jpjed,jpjef,jpieob+1,jpk*3*3,2,jpj, numout ) 
    188184 
    189185         !... extremeties nie0, nie1 
     
    226222            END DO 
    227223         END DO 
    228          IF( lk_mpp )   CALL mppobc(tebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj) 
    229          IF( lk_mpp )   CALL mppobc(sebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj) 
     224         IF( lk_mpp )   CALL mppobc(tebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj, numout ) 
     225         IF( lk_mpp )   CALL mppobc(sebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj, numout ) 
    230226 
    231227         ! ... extremeties nie0, nie1 
     
    327323            END DO 
    328324         END DO 
    329          IF( lk_mpp )   CALL mppobc(v_cxebnd,jpjed,jpjef,jpieob+1,jpk,2,jpj) 
     325         IF( lk_mpp )   CALL mppobc(v_cxebnd,jpjed,jpjef,jpieob+1,jpk,2,jpj, numout ) 
    330326 
    331327         ! ... extremeties nie0, nie1 
     
    409405            END DO 
    410406         END DO 
    411          IF( lk_mpp )   CALL mppobc(uwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj) 
     407         IF( lk_mpp )   CALL mppobc(uwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj, numout ) 
    412408 
    413409         ! ... extremeties niw0, niw1 
     
    451447            END DO 
    452448         END DO 
    453          IF( lk_mpp )   CALL mppobc(vwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj) 
     449         IF( lk_mpp )   CALL mppobc(vwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj, numout ) 
    454450 
    455451         ! ... extremeties niw0, niw1  
     
    492488            END DO 
    493489         END DO 
    494          IF( lk_mpp )   CALL mppobc(twbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj) 
    495          IF( lk_mpp )   CALL mppobc(swbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj) 
     490         IF( lk_mpp )   CALL mppobc(twbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj, numout ) 
     491         IF( lk_mpp )   CALL mppobc(swbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj, numout ) 
    496492 
    497493         ! ... extremeties niw0, niw1 
     
    596592            END DO 
    597593         END DO 
    598          IF( lk_mpp )   CALL mppobc(v_cxwbnd,jpjwd,jpjwf,jpiwob,jpk,2,jpj) 
     594         IF( lk_mpp )   CALL mppobc(v_cxwbnd,jpjwd,jpjwf,jpiwob,jpk,2,jpj, numout ) 
    599595 
    600596         ! ... extremeties niw0, niw1 
     
    673669            END DO 
    674670         END DO 
    675          IF( lk_mpp )   CALL mppobc(unbnd,jpind,jpinf,jpjnob+1,jpk*3*3,1,jpi) 
     671         IF( lk_mpp )   CALL mppobc(unbnd,jpind,jpinf,jpjnob+1,jpk*3*3,1,jpi, numout ) 
    676672 
    677673         ! ... extremeties njn0,njn1  
     
    720716            END DO 
    721717         END DO 
    722          IF( lk_mpp )   CALL mppobc(vnbnd,jpind,jpinf,jpjnob,jpk*3*3,1,jpi) 
     718         IF( lk_mpp )   CALL mppobc(vnbnd,jpind,jpinf,jpjnob,jpk*3*3,1,jpi, numout ) 
    723719 
    724720         ! ... extremeties njn0,njn1 
     
    761757            END DO 
    762758         END DO 
    763          IF( lk_mpp )   CALL mppobc(tnbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi) 
    764          IF( lk_mpp )   CALL mppobc(snbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi) 
     759         IF( lk_mpp )   CALL mppobc(tnbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi, numout ) 
     760         IF( lk_mpp )   CALL mppobc(snbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi, numout ) 
    765761 
    766762         ! ... extremeties  njn0,njn1 
     
    828824            END DO 
    829825         END DO 
    830          IF( lk_mpp )   CALL mppobc(u_cynbnd,jpind,jpinf,jpjnob+1,jpk,1,jpi) 
     826         IF( lk_mpp )   CALL mppobc(u_cynbnd,jpind,jpinf,jpjnob+1,jpk,1,jpi, numout ) 
    831827 
    832828         ! ... extremeties  njn0,njn1 
     
    947943            END DO 
    948944         END DO 
    949          IF( lk_mpp )   CALL mppobc(usbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi) 
     945         IF( lk_mpp )   CALL mppobc(usbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi, numout ) 
    950946 
    951947         ! ... extremeties njs0,njs1 
     
    992988            END DO 
    993989         END DO 
    994          IF( lk_mpp )   CALL mppobc(vsbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi) 
     990         IF( lk_mpp )   CALL mppobc(vsbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi, numout ) 
    995991 
    996992         ! ... extremeties njs0,njs1 
     
    10331029            END DO 
    10341030         END DO 
    1035          IF( lk_mpp )   CALL mppobc(tsbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi) 
    1036          IF( lk_mpp )   CALL mppobc(ssbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi) 
     1031         IF( lk_mpp )   CALL mppobc(tsbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi, numout ) 
     1032         IF( lk_mpp )   CALL mppobc(ssbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi, numout ) 
    10371033 
    10381034         ! ... extremeties  njs0,njs1 
     
    11001096            END DO 
    11011097         END DO 
    1102          IF( lk_mpp )   CALL mppobc(u_cysbnd,jpisd,jpisf,jpjsob,jpk,1,jpi) 
     1098         IF( lk_mpp )   CALL mppobc(u_cysbnd,jpisd,jpisf,jpjsob,jpk,1,jpi, numout ) 
    11031099 
    11041100         ! ... extremeties  njs0,njs1 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/OBC/obcrst.F90

    r2528 r2625  
    77 
    88   !!--------------------------------------------------------------------------------- 
    9    !! * Modules used 
    109   USE oce             ! ocean dynamics and tracers variables 
    1110   USE dom_oce         ! ocean space and time domain variables 
     
    1918   PRIVATE 
    2019 
    21    !! * Accessibility 
    22    PUBLIC obc_rst_read       ! routine called by obc_ini 
    23    PUBLIC obc_rst_write      ! routine called by step 
    24  
    25    !!--------------------------------------------------------------------------------- 
     20   PUBLIC   obc_rst_read    ! routine called by obc_ini 
     21   PUBLIC   obc_rst_write   ! routine called by step 
     22 
     23   !!---------------------------------------------------------------------- 
    2624   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    2725   !! $Id$  
    28    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    29    !!--------------------------------------------------------------------------------- 
     26   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     27   !!---------------------------------------------------------------------- 
    3028 
    3129CONTAINS 
     
    565563      IF( lk_mpp ) THEN 
    566564         IF( lp_obc_east ) THEN 
    567             CALL mppobc(uebnd,jpjed,jpjef,jpieob,jpk*3*3,2,jpj) 
    568             CALL mppobc(vebnd,jpjed,jpjef,jpieob+1,jpk*3*3,2,jpj) 
    569             CALL mppobc(tebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj) 
    570             CALL mppobc(sebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj) 
     565            CALL mppobc(uebnd,jpjed,jpjef,jpieob  ,jpk*3*3,2,jpj, numout ) 
     566            CALL mppobc(vebnd,jpjed,jpjef,jpieob+1,jpk*3*3,2,jpj, numout ) 
     567            CALL mppobc(tebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj, numout ) 
     568            CALL mppobc(sebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj, numout ) 
    571569         ENDIF 
    572570         IF( lp_obc_west ) THEN 
    573             CALL mppobc(uwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj) 
    574             CALL mppobc(vwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj) 
    575             CALL mppobc(twbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj) 
    576             CALL mppobc(swbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj) 
     571            CALL mppobc(uwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj, numout ) 
     572            CALL mppobc(vwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj, numout ) 
     573            CALL mppobc(twbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj, numout ) 
     574            CALL mppobc(swbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj, numout ) 
    577575         ENDIF 
    578576         IF( lp_obc_north ) THEN  
    579             CALL mppobc(unbnd,jpind,jpinf,jpjnob+1,jpk*3*3,1,jpi) 
    580             CALL mppobc(vnbnd,jpind,jpinf,jpjnob  ,jpk*3*3,1,jpi) 
    581             CALL mppobc(tnbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi) 
    582             CALL mppobc(snbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi) 
     577            CALL mppobc(unbnd,jpind,jpinf,jpjnob+1,jpk*3*3,1,jpi, numout ) 
     578            CALL mppobc(vnbnd,jpind,jpinf,jpjnob  ,jpk*3*3,1,jpi, numout ) 
     579            CALL mppobc(tnbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi, numout ) 
     580            CALL mppobc(snbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi, numout ) 
    583581         ENDIF 
    584582         IF( lp_obc_south ) THEN 
    585             CALL mppobc(usbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi) 
    586             CALL mppobc(vsbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi) 
    587             CALL mppobc(tsbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi) 
    588             CALL mppobc(ssbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi) 
     583            CALL mppobc(usbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi, numout ) 
     584            CALL mppobc(vsbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi, numout ) 
     585            CALL mppobc(tsbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi, numout ) 
     586            CALL mppobc(ssbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi, numout ) 
    589587         ENDIF 
    590588      ENDIF 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/sbcdcy.F90

    r2620 r2625  
    1818   USE sbc_oce          ! Surface boundary condition: ocean fields 
    1919   USE in_out_manager   ! I/O manager 
     20   USE lib_mpp          ! MPP library 
    2021 
    2122   IMPLICIT NONE 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90

    r2623 r2625  
    2424   USE diaptr          ! poleward transport diagnostics 
    2525   USE trc_oce         ! share passive tracers/Ocean variables 
     26   USE lib_mpp         ! MPP library 
    2627 
    2728   IMPLICIT NONE 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r2623 r2625  
    204204      IF( Agrif_Root() ) THEN 
    205205# if defined key_oasis3 || defined key_oasis4 
    206          CALL cpl_prism_init( ilocal_comm )   ! nemo local communicator given by oasis 
     206         CALL cpl_prism_init( ilocal_comm )                 ! nemo local communicator given by oasis 
    207207# endif 
    208          CALL  init_ioclient( ilocal_comm )   ! exchange io_server nemo local communicator with the io_server 
    209       ENDIF 
    210       narea = mynode( cltxt, ilocal_comm )    ! Nodes selection 
     208         CALL  init_ioclient( ilocal_comm )                 ! exchange io_server nemo local communicator with the io_server 
     209      ENDIF 
     210      narea = mynode( cltxt, numnam, nstop, ilocal_comm )   ! Nodes selection 
    211211#else 
    212212# if defined key_oasis3 || defined key_oasis4 
    213213      IF( Agrif_Root() ) THEN 
    214          CALL cpl_prism_init( ilocal_comm )   ! nemo local communicator given by oasis 
    215       ENDIF 
    216       narea = mynode( cltxt, ilocal_comm )    ! Nodes selection (control print return in cltxt) 
     214         CALL cpl_prism_init( ilocal_comm )                 ! nemo local communicator given by oasis 
     215      ENDIF 
     216      narea = mynode( cltxt, numnam, nstop, ilocal_comm )   ! Nodes selection (control print return in cltxt) 
    217217# else 
    218218      ilocal_comm = 0 
    219       narea = mynode( cltxt )                 ! Nodes selection (control print return in cltxt) 
     219      narea = mynode( cltxt numnam, nstop )                 ! Nodes selection (control print return in cltxt) 
    220220# endif 
    221221#endif 
    222       narea = narea + 1                       ! mynode return the rank of proc (0 --> jpnij -1 ) 
    223  
    224       lwp = (narea == 1) .OR. ln_ctl          ! control of all listing output print 
     222      narea = narea + 1                                     ! mynode return the rank of proc (0 --> jpnij -1 ) 
     223 
     224      lwp = (narea == 1) .OR. ln_ctl                        ! control of all listing output print 
    225225 
    226226      ! Decide on size of grid now that we have our communicator size 
     
    469469     USE ldfdyn_oce,   ONLY: ldfdyn_oce_alloc 
    470470     USE ldftra_oce,   ONLY: ldftra_oce_alloc 
     471     USE trc_oce,      ONLY: trc_oce_alloc 
    471472 
    472473      
    473 #if   defined key_mpp_mpi   
    474      USE lib_mpp,      ONLY: lib_mpp_alloc 
    475 #endif 
    476474#if defined key_obc 
    477475     USE obcdta ,      ONLY: obc_dta_alloc 
     
    510508      ! ...end of LOBSTER-related alloc routines 
    511509 
    512       USE trc_oce,      ONLY: trc_oce_alloc 
    513510#if   defined key_trdmld   ||   defined key_esopa 
    514511      USE trdmld,       ONLY: trd_mld_alloc 
     
    527524      !!---------------------------------------------------------------------- 
    528525 
    529       ierr =        oce_alloc       ()    ! ocean  
     526      ierr =        oce_alloc       ()          ! ocean  
    530527      ierr = ierr + dia_wri_alloc   () 
    531       ierr = ierr + dom_oce_alloc   ()    ! ocean domain 
    532       ierr = ierr + ldfdyn_oce_alloc()    ! ocean lateral  physics : dynamics 
    533       ierr = ierr + ldftra_oce_alloc()    ! ocean lateral  physics : tracers 
    534       ierr = ierr + zdf_oce_alloc()       ! ocean vertical physics 
    535  
    536  
    537  
    538 #if defined key_mpp_mpi  
    539       ierr = ierr + lib_mpp_alloc() 
    540 #endif 
     528      ierr = ierr + dom_oce_alloc   ()          ! ocean domain 
     529      ierr = ierr + ldfdyn_oce_alloc()          ! ocean lateral  physics : dynamics 
     530      ierr = ierr + ldftra_oce_alloc()          ! ocean lateral  physics : tracers 
     531      ierr = ierr + zdf_oce_alloc   ()          ! ocean vertical physics 
     532      ! 
     533      ierr = ierr + lib_mpp_alloc   (numout)    ! mpp exchanges 
     534      ierr = ierr + trc_oce_alloc   ()          ! shared TRC / TRA arrays 
     535 
     536 
    541537#if defined key_obc 
    542538      ierr = ierr + obc_dta_alloc() 
     
    572568      ! ...end of LOBSTER-related alloc routines 
    573569 
    574       ierr = ierr + trc_oce_alloc() 
    575570#if   defined key_trdmld   ||   defined key_esopa 
    576571      ierr = ierr + trd_mld_alloc() 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/oce.F90

    r2618 r2625  
    5757   INTEGER FUNCTION oce_alloc() 
    5858      !!---------------------------------------------------------------------- 
     59      !!                   ***  FUNCTION oce_alloc  *** 
     60      !!---------------------------------------------------------------------- 
    5961      INTEGER :: ierr(2) 
    6062      !!---------------------------------------------------------------------- 
     
    8183         &     gru(jpi,jpj)      , grv(jpi,jpj)                      , STAT=ierr(2) ) 
    8284         ! 
    83       oce_alloc = maxval( ierr ) 
     85      oce_alloc = MAXVAL( ierr ) 
    8486      IF( oce_alloc /= 0 )   CALL ctl_warn('oce_alloc: failed to allocate arrays') 
    8587      ! 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90

    r2590 r2625  
    5454   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    5555   !! $Id$  
    56    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    57    !!---------------------------------------------------------------------- 
    58  
     56   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     57   !!---------------------------------------------------------------------- 
    5958CONTAINS 
    6059 
    61    FUNCTION trc_oce_alloc() 
    62       !!---------------------------------------------------------------------- 
    63       IMPLICIT none 
    64       INTEGER :: trc_oce_alloc 
    65       !!---------------------------------------------------------------------- 
    66  
    67       ALLOCATE(etot3(jpi,jpj,jpk), Stat = trc_oce_alloc) 
    68  
    69       IF(trc_oce_alloc /= 0)THEN 
    70          CALL ctl_warn('trc_oce_alloc: failed to allocate array etot3.') 
    71       END IF 
    72  
     60   INTEGER FUNCTION trc_oce_alloc() 
     61      !!---------------------------------------------------------------------- 
     62      !!                  ***  trc_oce_alloc  *** 
     63      !!---------------------------------------------------------------------- 
     64      ALLOCATE( etot3(jpi,jpj,jpk), Stat = trc_oce_alloc ) 
     65      ! 
     66      IF( trc_oce_alloc /= 0 )   CALL ctl_warn('trc_oce_alloc: failed to allocate array etot3') 
    7367   END FUNCTION trc_oce_alloc 
     68 
    7469 
    7570   SUBROUTINE trc_oce_rgb( prgb ) 
     
    265260   END FUNCTION trc_oce_ext_lev 
    266261 
    267  
    268262   !!====================================================================== 
    269263END MODULE trc_oce 
Note: See TracChangeset for help on using the changeset viewer.