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 for branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN – NEMO

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/DYN
Files:
7 edited

Legend:

Unmodified
Added
Removed

  • 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 
Note: See TracChangeset for help on using the changeset viewer.