Changeset 2683


Ignore:
Timestamp:
2011-03-11T08:48:26+01:00 (10 years ago)
Author:
gm
Message:

dynamic mem: #785 ; add the allocation of s-coord arrays which were missing

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90

    r2633 r2683  
    4343 
    4444   PUBLIC   dom_zgr        ! called by dom_init.F90 
    45    PUBLIC   dom_zgr_alloc  ! called by nemo_alloc in nemogcm.F90 
    4645 
    4746   !                                       !!* Namelist namzgr_sco * 
     
    7271#  include "vectopt_loop_substitute.h90" 
    7372   !!---------------------------------------------------------------------- 
    74    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     73   !! NEMO/OPA 3.3.1 , NEMO Consortium (2011) 
    7574   !! $Id$ 
    7675   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    7877CONTAINS        
    7978 
    80    FUNCTION dom_zgr_alloc() 
    81       !!---------------------------------------------------------------------- 
    82       !!                ***  FUNCTION dom_zgr_alloc  *** 
    83       !!---------------------------------------------------------------------- 
    84       INTEGER :: dom_zgr_alloc 
    85       !!---------------------------------------------------------------------- 
    86  
    87       ALLOCATE(gsigw3(jpi,jpj,jpk),  gsigt3(jpi,jpj,jpk),   & 
    88                esigt3(jpi,jpj,jpk),  esigw3(jpi,jpj,jpk),   & 
    89                esigtu3(jpi,jpj,jpk), esigtv3(jpi,jpj,jpk),  & 
    90                esigtf3(jpi,jpj,jpk), esigwu3(jpi,jpj,jpk),  & 
    91                esigwv3(jpi,jpj,jpk), Stat=dom_zgr_alloc) 
    92  
    93       IF(dom_zgr_alloc /= 0)THEN 
    94          CALL ctl_warn('dom_zgr_alloc: failed to allocate arrays.') 
    95       END IF 
    96  
    97    END FUNCTION dom_zgr_alloc 
     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 
    9893 
    9994 
     
    619614      !!              - update bathy : meter bathymetry (in meters) 
    620615      !!---------------------------------------------------------------------- 
    621       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    622       USE wrk_nemo, ONLY: zbathy => wrk_2d_1 
     616      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     617      USE wrk_nemo, ONLY:   zbathy => wrk_2d_1 
    623618      !! 
    624619      INTEGER ::   ji, jj, jl                    ! dummy loop indices 
     
    626621      !!---------------------------------------------------------------------- 
    627622 
    628       IF(wrk_in_use(2, 1))THEN 
    629          CALL ctl_stop('zgr_bat_ctl: ERROR: requested workspace array unavailable.') 
    630          RETURN 
    631       END IF 
     623      IF( wrk_in_use(2, 1) ) THEN 
     624         CALL ctl_stop('zgr_bat_ctl: requested workspace array unavailable')   ;   RETURN 
     625      ENDIF 
    632626 
    633627      IF(lwp) WRITE(numout,*) 
     
    733727      ENDIF 
    734728      ! 
    735       IF(wrk_not_released(2, 1))THEN 
    736          CALL ctl_stop('zgr_bat_ctl: ERROR: failed to release workspace array.') 
    737          RETURN 
    738       END IF 
     729      IF( wrk_not_released(2, 1) )   CALL ctl_stop('zgr_bat_ctl: failed to release workspace array') 
    739730      ! 
    740731   END SUBROUTINE zgr_bat_ctl 
     
    753744      !!                                     (min value = 1 over land) 
    754745      !!---------------------------------------------------------------------- 
    755       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    756       USE wrk_nemo, ONLY: zmbk => wrk_2d_1 
     746      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     747      USE wrk_nemo, ONLY:   zmbk => wrk_2d_1 
    757748      !! 
    758749      INTEGER ::   ji, jj   ! dummy loop indices 
    759750      !!---------------------------------------------------------------------- 
    760751      ! 
    761       IF( wrk_in_use(2, 1))THEN 
    762          CALL ctl_stop('zgr_bot_level: ERROR - requested 2D workspace unavailable.') 
    763          RETURN 
    764       END IF 
     752      IF( wrk_in_use(2, 1) ) THEN 
     753         CALL ctl_stop('zgr_bot_level: requested 2D workspace unavailable')   ;   RETURN 
     754      ENDIF 
    765755      ! 
    766756      IF(lwp) WRITE(numout,*) 
     
    780770      zmbk(:,:) = REAL( mbkv(:,:), wp )   ;   CALL lbc_lnk(zmbk,'V',1.)   ;   mbkv  (:,:) = MAX( INT( zmbk(:,:) ), 1 ) 
    781771      ! 
    782       IF( wrk_not_released(2, 1))THEN 
    783          CALL ctl_stop('zgr_bot_level: ERROR - failed to release workspace array.') 
    784          RETURN 
    785       END IF 
     772      IF( wrk_not_released(2, 1) )   CALL ctl_stop('zgr_bot_level: failed to release workspace array') 
    786773      ! 
    787774   END SUBROUTINE zgr_bot_level 
     
    860847      !!  Reference :   Pacanowsky & Gnanadesikan 1997, Mon. Wea. Rev., 126, 3248-3270. 
    861848      !!---------------------------------------------------------------------- 
    862       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    863       USE wrk_nemo, ONLY: zprt => wrk_3d_1 
     849      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     850      USE wrk_nemo, ONLY:   zprt => wrk_3d_1 
    864851      !! 
    865852      INTEGER  ::   ji, jj, jk       ! dummy loop indices 
     
    873860      !!--------------------------------------------------------------------- 
    874861      !  
    875       IF( wrk_in_use(3, 1))THEN 
    876          CALL ctl_stop('zgr_zps: ERROR - requested workspace unavailable.') 
    877          RETURN 
    878       END IF 
     862      IF( wrk_in_use(3, 1) ) THEN 
     863         CALL ctl_stop('zgr_zps: requested workspace unavailable.')   ;   RETURN 
     864      ENDIF 
    879865 
    880866      IF(lwp) WRITE(numout,*) 
     
    884870 
    885871      ll_print = .FALSE.                   ! Local variable for debugging 
    886 !!    ll_print = .TRUE. 
    887872       
    888873      IF(lwp .AND. ll_print) THEN          ! control print of the ocean depth 
     
    10681053      ENDIF   
    10691054      ! 
    1070       IF( wrk_not_released(3, 1))THEN 
    1071          CALL ctl_stop('zgr_zps: ERROR - failed to release workspace.') 
    1072          RETURN 
    1073       END IF 
     1055      IF( wrk_not_released(3, 1) )   CALL ctl_stop('zgr_zps: failed to release workspace') 
    10741056      ! 
    10751057   END SUBROUTINE zgr_zps 
     
    11591141      !! Reference : Madec, Lott, Delecluse and Crepon, 1996. JPO, 26, 1393-1408. 
    11601142      !!---------------------------------------------------------------------- 
    1161       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    1162       USE wrk_nemo, ONLY: zenv => wrk_2d_1, ztmp => wrk_2d_2, zmsk => wrk_2d_3, & 
    1163                           zri => wrk_2d_4, zrj => wrk_2d_5, zhbat => wrk_2d_6 
    1164       !! 
     1143      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 
     1145      USE wrk_nemo, ONLY:   zri  => wrk_2d_4 , zrj  => wrk_2d_5 , zhbat => wrk_2d_6 
     1146      ! 
    11651147      INTEGER  ::   ji, jj, jk, jl           ! dummy loop argument 
    11661148      INTEGER  ::   iip1, ijp1, iim1, ijm1   ! temporary integers 
    11671149      REAL(wp) ::   zcoeft, zcoefw, zrmax, ztaper   ! temporary scalars 
    1168       !! 
     1150      ! 
    11691151      NAMELIST/namzgr_sco/ rn_sbot_max, rn_sbot_min, rn_theta, rn_thetb, rn_rmax, ln_s_sigma, rn_bb, rn_hc 
    11701152      !!---------------------------------------------------------------------- 
    11711153 
    1172       IF(wrk_in_use(2, 1,2,3,4,5,6))THEN 
    1173          CALL ctl_stop('zgr_sco: ERROR - requested workspace arrays unavailable') 
    1174          RETURN 
    1175       END IF 
    1176  
    1177       REWIND( numnam )                        ! Read Namelist namzgr_sco : sigma-stretching parameters 
     1154      IF( wrk_in_use(2, 1,2,3,4,5,6) ) THEN 
     1155         CALL ctl_stop('zgr_sco: ERROR - requested workspace arrays unavailable')   ;   RETURN 
     1156      ENDIF 
     1157 
     1158      REWIND( numnam )                       ! Read Namelist namzgr_sco : sigma-stretching parameters 
    11781159      READ  ( numnam, namzgr_sco ) 
    11791160 
    1180       IF(lwp) THEN                            ! control print 
     1161      IF(lwp) THEN                           ! control print 
    11811162         WRITE(numout,*) 
    11821163         WRITE(numout,*) 'dom:zgr_sco : s-coordinate or hybrid z-s-coordinate' 
     
    11941175      ENDIF 
    11951176 
     1177      !                                      ! allocate sco arrays 
     1178      IF( dom_zgr_sco_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dom:zgr_sco : unable to allocate arrays' ) 
     1179 
    11961180      gsigw3  = 0._wp   ;   gsigt3  = 0._wp   ;   gsi3w3  = 0._wp 
    11971181      esigt3  = 0._wp   ;   esigw3  = 0._wp  
     
    12091193      DO jj = 1, jpj 
    12101194         DO ji = 1, jpi 
    1211            IF( bathy(ji,jj) > 0._wp ) THEN 
    1212               bathy(ji,jj) = MAX( rn_sbot_min, bathy(ji,jj) ) 
    1213            ENDIF 
     1195           IF( bathy(ji,jj) > 0._wp )   bathy(ji,jj) = MAX( rn_sbot_min, bathy(ji,jj) ) 
    12141196         END DO 
    12151197      END DO 
     
    16161598!!gm bug    #endif 
    16171599      ! 
    1618       IF(wrk_not_released(2, 1,2,3,4,5,6))THEN 
    1619          CALL ctl_stop('zgr_sco: ERROR - failed to release workspace arrays') 
    1620       END IF 
     1600      IF( wrk_not_released(2, 1,2,3,4,5,6) )   CALL ctl_stop('dom:zgr_sco: failed to release workspace arrays') 
    16211601      ! 
    16221602   END SUBROUTINE zgr_sco 
    1623  
    16241603 
    16251604   !!====================================================================== 
Note: See TracChangeset for help on using the changeset viewer.