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 2715 for trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90 – NEMO

Ignore:
Timestamp:
2011-03-30T17:58:35+02:00 (13 years ago)
Author:
rblod
Message:

First attempt to put dynamic allocation on the trunk

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90

    r2528 r2715  
    3131   USE dom_oce         ! ocean space and time domain 
    3232   USE phycst          ! physical constants 
    33    USE in_out_manager  ! I/O manager 
    3433   USE trdmod          ! ocean dynamics trends  
    3534   USE trdmod_oce      ! ocean variables trends 
     35   USE in_out_manager  ! I/O manager 
    3636   USE prtctl          ! Print control 
    3737   USE lbclnk          ! lateral boundary condition  
     38   USE lib_mpp         ! MPP library 
    3839 
    3940   IMPLICIT NONE 
    … …  
    7677      !!             - Save the trend (l_trddyn=T) 
    7778      !!---------------------------------------------------------------------- 
     79      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     80      USE wrk_nemo, ONLY:   ztrdu => wrk_3d_1 , ztrdv => wrk_3d_2   ! 3D workspace 
     81      !! 
    7882      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    79       !! 
    80       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztrdu, ztrdv   ! 3D temporary workspace 
    81       !!---------------------------------------------------------------------- 
     83      !!---------------------------------------------------------------------- 
     84      ! 
     85      IF( wrk_in_use(3, 1,2) ) THEN 
     86         CALL ctl_stop('dyn_hpg: requested workspace arrays are unavailable')   ;   RETURN 
     87      ENDIF 
    8288      ! 
    8389      IF( l_trddyn ) THEN                    ! Temporary saving of ua and va trends (l_trddyn) 
    … …  
    104110      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' hpg  - Ua: ', mask1=umask,   & 
    105111         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     112      ! 
     113      IF( wrk_not_released(3, 1,2) )   CALL ctl_stop('dyn_hpg: failed to release workspace arrays') 
    106114      ! 
    107115   END SUBROUTINE dyn_hpg 
    … …  
    144152      ! 
    145153      IF( lk_vvl .AND. .NOT. ln_hpg_sco )   & 
    146          &   CALL ctl_stop( 'dyn_hpg_init : variable volume key_vvl require the standard jacobian formulation hpg_sco') 
     154         &   CALL ctl_stop('dyn_hpg_init : variable volume key_vvl require the standard jacobian formulation hpg_sco') 
    147155      ! 
    148156      !                               ! Set nhpg from ln_hpg_... flags 
    … …  
    164172      IF( ln_hpg_djc )   ioptio = ioptio + 1 
    165173      IF( ln_hpg_rot )   ioptio = ioptio + 1 
    166       IF ( ioptio /= 1 )   CALL ctl_stop( ' NO or several hydrostatic pressure gradient options used' ) 
     174      IF( ioptio /= 1 )   CALL ctl_stop( 'NO or several hydrostatic pressure gradient options used' ) 
    167175      ! 
    168176   END SUBROUTINE dyn_hpg_init 
    … …  
    185193      !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend 
    186194      !!---------------------------------------------------------------------- 
    187       USE oce, ONLY :   zhpi => ta   ! use ta as 3D workspace 
    188       USE oce, ONLY :   zhpj => sa   ! use sa as 3D workspace 
     195      USE oce, ONLY:   zhpi => ta , zhpj => sa   ! (ta,sa) used as 3D workspace 
    189196      !! 
    190197      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
    … …  
    200207      ENDIF 
    201208       
    202       ! Local constant initialization  
    203       zcoef0 = - grav * 0.5_wp 
     209      zcoef0 = - grav * 0.5_wp      ! Local constant initialization  
    204210 
    205211      ! Surface value 
    … …  
    247253      !! ** Action  : - Update (ua,va) with the now hydrastatic pressure trend 
    248254      !!----------------------------------------------------------------------  
    249       USE oce, ONLY :   zhpi => ta   ! use ta as 3D workspace 
    250       USE oce, ONLY :   zhpj => sa   ! use sa as 3D workspace 
     255      USE oce, ONLY:   zhpi => ta , zhpj => sa   ! (ta,sa) used as 3D workspace 
    251256      !! 
    252257      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
    … …  
    349354      !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend 
    350355      !!---------------------------------------------------------------------- 
    351       USE oce, ONLY :   zhpi => ta   ! use ta as 3D workspace 
    352       USE oce, ONLY :   zhpj => sa   ! use sa as 3D workspace 
     356      USE oce, ONLY:   zhpi => ta , zhpj => sa   ! (ta,sa) used as 3D workspace 
    353357      !! 
    354358      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
    … …  
    435439      !!             - Save the trend (l_trddyn=T) 
    436440      !!---------------------------------------------------------------------- 
    437       USE oce, ONLY :   zhpi => ta   ! use ta as 3D workspace 
    438       USE oce, ONLY :   zhpj => sa   ! use sa as 3D workspace 
     441      USE oce, ONLY:   zhpi => ta , zhpj => sa   ! (ta,sa) used as 3D workspace 
    439442      !! 
    440443      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
    … …  
    512515      !! Reference : Song, Mon. Wea. Rev., 126, 3213-3230, 1998. 
    513516      !!---------------------------------------------------------------------- 
    514       USE oce, ONLY :   zhpi => ta   ! use ta as 3D workspace 
    515       USE oce, ONLY :   zhpj => sa   ! use sa as 3D workspace 
     517      USE oce, ONLY:   zhpi => ta , zhpj => sa   ! (ta,sa) used as 3D workspace 
    516518      !! 
    517519      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
    … …  
    592594      !! Reference: Shchepetkin and McWilliams, J. Geophys. Res., 108(C3), 3090, 2003 
    593595      !!---------------------------------------------------------------------- 
    594       USE oce, ONLY :   zhpi => ta   ! use ta as 3D workspace 
    595       USE oce, ONLY :   zhpj => sa   ! use sa as 3D workspace 
     596      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     597      USE oce     , ONLY:   zhpi  => ta        , zhpj => sa       ! (ta,sa) used as 3D workspace 
     598      USE wrk_nemo, ONLY:   drhox => wrk_3d_1  , dzx  => wrk_3d_2 
     599      USE wrk_nemo, ONLY:   drhou => wrk_3d_3  , dzu  => wrk_3d_4 , rho_i => wrk_3d_5 
     600      USE wrk_nemo, ONLY:   drhoy => wrk_3d_6  , dzy  => wrk_3d_7 
     601      USE wrk_nemo, ONLY:   drhov => wrk_3d_8  , dzv  => wrk_3d_9 , rho_j => wrk_3d_10 
     602      USE wrk_nemo, ONLY:   drhoz => wrk_3d_11 , dzz  => wrk_3d_12  
     603      USE wrk_nemo, ONLY:   drhow => wrk_3d_13 , dzw  => wrk_3d_14 
     604      USE wrk_nemo, ONLY:   rho_k => wrk_3d_15 
    596605      !! 
    597606      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
    … …  
    601610      REAL(wp) ::   z1_10, cffu, cffx   !    "         " 
    602611      REAL(wp) ::   z1_12, cffv, cffy   !    "         " 
    603       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   drhox, dzx, drhou, dzu, rho_i   ! 3D workspace 
    604       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   drhoy, dzy, drhov, dzv, rho_j   !  "      " 
    605       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   drhoz, dzz, drhow, dzw, rho_k   !  "      " 
    606       !!---------------------------------------------------------------------- 
     612      !!---------------------------------------------------------------------- 
     613 
     614      IF( wrk_in_use(3, 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15) ) THEN 
     615         CALL ctl_stop('dyn:hpg_djc: requested workspace arrays unavailable')   ;   RETURN 
     616      ENDIF 
    607617 
    608618      IF( kt == nit000 ) THEN 
    … …  
    611621         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   s-coordinate case, density Jacobian with cubic polynomial scheme' 
    612622      ENDIF 
    613  
    614623 
    615624      ! Local constant initialization 
    … …  
    802811      END DO 
    803812      ! 
     813      IF( wrk_not_released(3, 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15) )   & 
     814         CALL ctl_stop('dyn:hpg_djc: failed to release workspace arrays') 
     815      ! 
    804816   END SUBROUTINE hpg_djc 
    805817 
    … …  
    813825      !! Reference: Thiem & Berntsen, Ocean Modelling, In press, 2005. 
    814826      !!---------------------------------------------------------------------- 
    815       USE oce, ONLY :   zhpi => ta   ! use ta as 3D workspace 
    816       USE oce, ONLY :   zhpj => sa   ! use sa as 3D workspace 
     827      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     828      USE oce     , ONLY:   zhpi    => ta       , zhpj    => sa       ! (ta,sa) used as 3D workspace 
     829      USE wrk_nemo, ONLY:   zdistr  => wrk_2d_1 , zsina   => wrk_2d_2 , zcosa  => wrk_2d_3 
     830      USE wrk_nemo, ONLY:   zhpiorg => wrk_3d_1 , zhpirot => wrk_3d_2 
     831      USE wrk_nemo, ONLY:   zhpitra => wrk_3d_3 , zhpine  => wrk_3d_4 
     832      USE wrk_nemo, ONLY:   zhpjorg => wrk_3d_5 , zhpjrot => wrk_3d_6 
     833      USE wrk_nemo, ONLY:   zhpjtra => wrk_3d_7 , zhpjne  => wrk_3d_8 
    817834      !! 
    818835      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
    … …  
    821838      REAL(wp) ::   zforg, zcoef0, zuap, zmskd1, zmskd1m   ! temporary scalar 
    822839      REAL(wp) ::   zfrot        , zvap, zmskd2, zmskd2m   !    "         " 
    823       REAL(wp), DIMENSION(jpi,jpj)     ::   zdistr, zsina, zcosa                ! 2D workspace 
    824       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zhpiorg, zhpirot, zhpitra, zhpine   ! 3D workspace 
    825       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zhpjorg, zhpjrot, zhpjtra, zhpjne   !  "      " 
    826       !!---------------------------------------------------------------------- 
     840      !!---------------------------------------------------------------------- 
     841 
     842      IF( wrk_in_use(2, 1,2,3)             .OR.   & 
     843          wrk_in_use(3, 1,2,3,4,5,6,7,8) ) THEN 
     844         CALL ctl_stop('dyn:hpg_rot: requested workspace arrays unavailable')   ;   RETURN 
     845      ENDIF 
    827846 
    828847      IF( kt == nit000 ) THEN 
    … …  
    9811000      END DO 
    9821001      ! 
     1002      IF( wrk_not_released(2, 1,2,3)           .OR.   & 
     1003          wrk_not_released(3, 1,2,3,4,5,6,7,8) )   CALL ctl_stop('dyn:hpg_rot: failed to release workspace arrays') 
     1004      ! 
    9831005   END SUBROUTINE hpg_rot 
    9841006 
Note: See TracChangeset for help on using the changeset viewer.