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

Changeset 2695


Ignore:
Timestamp:
2011-03-16T08:13:20+01:00 (13 years ago)
Author:
rblod
Message:

Avoid use of global saved arrays for computation of sco coordinate

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90

    r2690 r2695  
    5555   REAL(wp) ::   rn_hc       =  150._wp     ! Critical depth for s-sigma coordinates 
    5656 
    57    !! Arrays used in zgr_sco 
    58    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gsigw3 
    59    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gsigt3 
    60    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gsi3w3 
    61    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   esigt3 
    62    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   esigw3 
    63    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   esigtu3 
    64    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   esigtv3 
    65    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   esigtf3 
    66    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   esigwu3 
    67    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   esigwv3 
    68  
    69    !! * Substitutions 
     57  !! * Substitutions 
    7058#  include "domzgr_substitute.h90" 
    7159#  include "vectopt_loop_substitute.h90" 
    … …  
    7765CONTAINS        
    7866 
    79    INTEGER FUNCTION dom_zgr_sco_alloc() 
    80       !!---------------------------------------------------------------------- 
    81       !!                ***  FUNCTION dom_zgr_sco_alloc  *** 
    82       !!---------------------------------------------------------------------- 
    83       ALLOCATE( gsigw3 (jpi,jpj,jpk) , gsigt3 (jpi,jpj,jpk) ,     & 
    84          &      esigt3 (jpi,jpj,jpk) , esigw3 (jpi,jpj,jpk) ,     & 
    85          &      esigtu3(jpi,jpj,jpk) , esigtv3(jpi,jpj,jpk) ,     & 
    86          &      esigtf3(jpi,jpj,jpk) , esigwu3(jpi,jpj,jpk) ,     & 
    87          &      esigwv3(jpi,jpj,jpk)                        , STAT=dom_zgr_sco_alloc ) 
    88          ! 
    89       IF( lk_mpp                 )   CALL mpp_sum ( dom_zgr_sco_alloc ) 
    90       IF( dom_zgr_sco_alloc /= 0 )   CALL ctl_warn('dom_zgr_sco_alloc: failed to allocate arrays.') 
    91       ! 
    92    END FUNCTION dom_zgr_sco_alloc 
    93  
    94  
    9567   SUBROUTINE dom_zgr 
    9668      !!---------------------------------------------------------------------- 
    … …  
    149121      ! 
    150122      ! 
     123 
    151124      IF( nprint == 1 .AND. lwp )   THEN 
    152125         WRITE(numout,*) ' MIN val mbathy ', MINVAL( mbathy(:,:) ), ' MAX ', MAXVAL( mbathy(:,:) ) 
    … …  
    615588      !!---------------------------------------------------------------------- 
    616589      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    617       USE wrk_nemo, ONLY:   zbathy => wrk_2d_1     ! 2D workspace 
     590      USE wrk_nemo, ONLY:   zbathy => wrk_2d_1 
    618591      !! 
    619592      INTEGER ::   ji, jj, jl                    ! dummy loop indices 
    … …  
    745718      !!---------------------------------------------------------------------- 
    746719      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    747       USE wrk_nemo, ONLY:   zmbk => wrk_2d_1    ! 2D workspace 
     720      USE wrk_nemo, ONLY:   zmbk => wrk_2d_1 
    748721      !! 
    749722      INTEGER ::   ji, jj   ! dummy loop indices 
    … …  
    848821      !!---------------------------------------------------------------------- 
    849822      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    850       USE wrk_nemo, ONLY:   zprt => wrk_3d_1    ! 3D workspace 
     823      USE wrk_nemo, ONLY:   zprt => wrk_3d_1 
    851824      !! 
    852825      INTEGER  ::   ji, jj, jk       ! dummy loop indices 
    … …  
    861834      !  
    862835      IF( wrk_in_use(3, 1) ) THEN 
    863          CALL ctl_stop('zgr_zps: requested workspace unavailable')   ;   RETURN 
     836         CALL ctl_stop('zgr_zps: requested workspace unavailable.')   ;   RETURN 
    864837      ENDIF 
    865838 
    … …  
    11421115      !!---------------------------------------------------------------------- 
    11431116      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    1144       USE wrk_nemo, ONLY:   zenv => wrk_2d_1 , ztmp => wrk_2d_2 , zmsk  => wrk_2d_3    ! 2D workspace 
    1145       USE wrk_nemo, ONLY:   zri  => wrk_2d_4 , zrj  => wrk_2d_5 , zhbat => wrk_2d_6    !  -      - 
     1117      USE wrk_nemo, ONLY:   zenv => wrk_2d_1 , ztmp => wrk_2d_2 , zmsk  => wrk_2d_3 
     1118      USE wrk_nemo, ONLY:   zri  => wrk_2d_4 , zrj  => wrk_2d_5 , zhbat => wrk_2d_6 
     1119      USE wrk_nemo, ONLY:   gsigw3  => wrk_3d_1 
     1120      USE wrk_nemo, ONLY:   gsigt3  => wrk_3d_2 
     1121      USE wrk_nemo, ONLY:   gsi3w3  => wrk_3d_3 
     1122      USE wrk_nemo, ONLY:   esigt3  => wrk_3d_4 
     1123      USE wrk_nemo, ONLY:   esigw3  => wrk_3d_5 
     1124      USE wrk_nemo, ONLY:   esigtu3 => wrk_3d_6 
     1125      USE wrk_nemo, ONLY:   esigtv3 => wrk_3d_7 
     1126      USE wrk_nemo, ONLY:   esigtf3 => wrk_3d_8 
     1127      USE wrk_nemo, ONLY:   esigwu3 => wrk_3d_9 
     1128      USE wrk_nemo, ONLY:   esigwv3 => wrk_3d_10 
    11461129      ! 
    11471130      INTEGER  ::   ji, jj, jk, jl           ! dummy loop argument 
    … …  
    11491132      REAL(wp) ::   zcoeft, zcoefw, zrmax, ztaper   ! temporary scalars 
    11501133      ! 
     1134 
    11511135      NAMELIST/namzgr_sco/ rn_sbot_max, rn_sbot_min, rn_theta, rn_thetb, rn_rmax, ln_s_sigma, rn_bb, rn_hc 
    11521136      !!---------------------------------------------------------------------- 
    11531137 
    1154       IF( wrk_in_use(2, 1,2,3,4,5,6) ) THEN 
    1155          CALL ctl_stop('zgr_sco: requested workspace arrays unavailable')   ;   RETURN 
     1138      IF( wrk_in_use(2, 1,2,3,4,5,6) .OR. wrk_in_use(3, 1,2,3,4,5,6,7,8,9,10) ) THEN 
     1139         CALL ctl_stop('zgr_sco: ERROR - requested workspace arrays unavailable')   ;   RETURN 
    11561140      ENDIF 
    11571141 
    … …  
    11741158         WRITE(numout,*) '      Critical depth                               rn_hc         = ', rn_hc 
    11751159      ENDIF 
    1176  
    1177       !                                      ! allocate sco arrays 
    1178       IF( dom_zgr_sco_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dom:zgr_sco : unable to allocate arrays' ) 
    11791160 
    11801161      gsigw3  = 0._wp   ;   gsigt3  = 0._wp   ;   gsi3w3  = 0._wp 
    … …  
    14171398         END DO    ! for all ji's 
    14181399 
    1419          DO ji = 1, jpi 
    1420             DO jj = 1, jpj 
     1400         DO ji = 1, jpim1 
     1401            DO jj = 1, jpjm1 
    14211402               DO jk = 1, jpk 
    14221403                  esigtu3(ji,jj,jk) = ( hbatt(ji,jj)*esigt3(ji,jj,jk)+hbatt(ji+1,jj)*esigt3(ji+1,jj,jk) )   & 
    … …  
    15981579!!gm bug    #endif 
    15991580      ! 
    1600       IF( wrk_not_released(2, 1,2,3,4,5,6) )   CALL ctl_stop('dom:zgr_sco: failed to release workspace arrays') 
     1581      IF( wrk_not_released(2, 1,2,3,4,5,6) .OR. wrk_not_released(3, 1,2,3,4,5,6,7,8,9,10) )  & 
     1582        &  CALL ctl_stop('dom:zgr_sco: failed to release workspace arrays') 
    16011583      ! 
    16021584   END SUBROUTINE zgr_sco 
Note: See TracChangeset for help on using the changeset viewer.