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/DOM/domzgr.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/DOM/domzgr.F90

    r2712 r2715  
    4242   PRIVATE 
    4343 
    44    PUBLIC   dom_zgr      ! called by dom_init.F90 
     44   PUBLIC   dom_zgr        ! called by dom_init.F90 
    4545 
    4646   !                                       !!* Namelist namzgr_sco * 
     
    5454   !                                        ! ( rn_bb=0; top only, rn_bb =1; top and bottom) 
    5555   REAL(wp) ::   rn_hc       =  150._wp     ! Critical depth for s-sigma coordinates 
    56   
    57    !! * Substitutions 
     56 
     57  !! * Substitutions 
    5858#  include "domzgr_substitute.h90" 
    5959#  include "vectopt_loop_substitute.h90" 
    6060   !!---------------------------------------------------------------------- 
    61    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     61   !! NEMO/OPA 3.3.1 , NEMO Consortium (2011) 
    6262   !! $Id$ 
    6363   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    121121      ! 
    122122      ! 
     123 
    123124      IF( nprint == 1 .AND. lwp )   THEN 
    124125         WRITE(numout,*) ' MIN val mbathy ', MINVAL( mbathy(:,:) ), ' MAX ', MAXVAL( mbathy(:,:) ) 
     
    588589      !!              - update bathy : meter bathymetry (in meters) 
    589590      !!---------------------------------------------------------------------- 
     591      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     592      USE wrk_nemo, ONLY:   zbathy => wrk_2d_1 
     593      !! 
    590594      INTEGER ::   ji, jj, jl                    ! dummy loop indices 
    591595      INTEGER ::   icompt, ibtest, ikmax         ! temporary integers 
    592       REAL(wp), DIMENSION(jpi,jpj) ::   zbathy   ! temporary workspace 
    593       !!---------------------------------------------------------------------- 
     596      !!---------------------------------------------------------------------- 
     597 
     598      IF( wrk_in_use(2, 1) ) THEN 
     599         CALL ctl_stop('zgr_bat_ctl: requested workspace array unavailable')   ;   RETURN 
     600      ENDIF 
    594601 
    595602      IF(lwp) WRITE(numout,*) 
     
    695702      ENDIF 
    696703      ! 
     704      IF( wrk_not_released(2, 1) )   CALL ctl_stop('zgr_bat_ctl: failed to release workspace array') 
     705      ! 
    697706   END SUBROUTINE zgr_bat_ctl 
    698707 
     
    710719      !!                                     (min value = 1 over land) 
    711720      !!---------------------------------------------------------------------- 
     721      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     722      USE wrk_nemo, ONLY:   zmbk => wrk_2d_1 
     723      !! 
    712724      INTEGER ::   ji, jj   ! dummy loop indices 
    713       REAL(wp), DIMENSION(jpi,jpj) ::   zmbk   ! 2D workspace  
    714       !!---------------------------------------------------------------------- 
     725      !!---------------------------------------------------------------------- 
     726      ! 
     727      IF( wrk_in_use(2, 1) ) THEN 
     728         CALL ctl_stop('zgr_bot_level: requested 2D workspace unavailable')   ;   RETURN 
     729      ENDIF 
    715730      ! 
    716731      IF(lwp) WRITE(numout,*) 
     
    729744      zmbk(:,:) = REAL( mbku(:,:), wp )   ;   CALL lbc_lnk(zmbk,'U',1.)   ;   mbku  (:,:) = MAX( INT( zmbk(:,:) ), 1 ) 
    730745      zmbk(:,:) = REAL( mbkv(:,:), wp )   ;   CALL lbc_lnk(zmbk,'V',1.)   ;   mbkv  (:,:) = MAX( INT( zmbk(:,:) ), 1 ) 
     746      ! 
     747      IF( wrk_not_released(2, 1) )   CALL ctl_stop('zgr_bot_level: failed to release workspace array') 
    731748      ! 
    732749   END SUBROUTINE zgr_bot_level 
     
    805822      !!  Reference :   Pacanowsky & Gnanadesikan 1997, Mon. Wea. Rev., 126, 3248-3270. 
    806823      !!---------------------------------------------------------------------- 
     824      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     825      USE wrk_nemo, ONLY:   zprt => wrk_3d_1 
     826      !! 
    807827      INTEGER  ::   ji, jj, jk       ! dummy loop indices 
    808828      INTEGER  ::   ik, it           ! temporary integers 
     
    813833      REAL(wp) ::   zdiff            ! temporary scalar 
    814834      REAL(wp) ::   zrefdep          ! temporary scalar 
    815       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zprt   ! 3D workspace 
    816835      !!--------------------------------------------------------------------- 
     836      !  
     837      IF( wrk_in_use(3, 1) ) THEN 
     838         CALL ctl_stop('zgr_zps: requested workspace unavailable.')   ;   RETURN 
     839      ENDIF 
    817840 
    818841      IF(lwp) WRITE(numout,*) 
     
    822845 
    823846      ll_print = .FALSE.                   ! Local variable for debugging 
    824 !!    ll_print = .TRUE. 
    825847       
    826848      IF(lwp .AND. ll_print) THEN          ! control print of the ocean depth 
     
    10061028      ENDIF   
    10071029      ! 
     1030      IF( wrk_not_released(3, 1) )   CALL ctl_stop('zgr_zps: failed to release workspace') 
     1031      ! 
    10081032   END SUBROUTINE zgr_zps 
    10091033 
     
    10921116      !! Reference : Madec, Lott, Delecluse and Crepon, 1996. JPO, 26, 1393-1408. 
    10931117      !!---------------------------------------------------------------------- 
     1118      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     1119      USE wrk_nemo, ONLY:   zenv => wrk_2d_1 , ztmp => wrk_2d_2 , zmsk  => wrk_2d_3 
     1120      USE wrk_nemo, ONLY:   zri  => wrk_2d_4 , zrj  => wrk_2d_5 , zhbat => wrk_2d_6 
     1121      USE wrk_nemo, ONLY:   gsigw3  => wrk_3d_1 
     1122      USE wrk_nemo, ONLY:   gsigt3  => wrk_3d_2 
     1123      USE wrk_nemo, ONLY:   gsi3w3  => wrk_3d_3 
     1124      USE wrk_nemo, ONLY:   esigt3  => wrk_3d_4 
     1125      USE wrk_nemo, ONLY:   esigw3  => wrk_3d_5 
     1126      USE wrk_nemo, ONLY:   esigtu3 => wrk_3d_6 
     1127      USE wrk_nemo, ONLY:   esigtv3 => wrk_3d_7 
     1128      USE wrk_nemo, ONLY:   esigtf3 => wrk_3d_8 
     1129      USE wrk_nemo, ONLY:   esigwu3 => wrk_3d_9 
     1130      USE wrk_nemo, ONLY:   esigwv3 => wrk_3d_10 
     1131      ! 
    10941132      INTEGER  ::   ji, jj, jk, jl           ! dummy loop argument 
    10951133      INTEGER  ::   iip1, ijp1, iim1, ijm1   ! temporary integers 
    10961134      REAL(wp) ::   zcoeft, zcoefw, zrmax, ztaper   ! temporary scalars 
    1097       REAL(wp), DIMENSION(jpi,jpj) ::   zenv, ztmp, zmsk    ! 2D workspace 
    1098       REAL(wp), DIMENSION(jpi,jpj) ::   zri , zrj , zhbat   !  -     - 
    1099       !! 
    1100       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   gsigw3 
    1101       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   gsigt3 
    1102       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   gsi3w3 
    1103       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   esigt3 
    1104       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   esigw3 
    1105       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   esigtu3 
    1106       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   esigtv3 
    1107       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   esigtf3 
    1108       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   esigwu3 
    1109       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   esigwv3 
    1110       !! 
     1135      ! 
     1136 
    11111137      NAMELIST/namzgr_sco/ rn_sbot_max, rn_sbot_min, rn_theta, rn_thetb, rn_rmax, ln_s_sigma, rn_bb, rn_hc 
    11121138      !!---------------------------------------------------------------------- 
    11131139 
    1114       REWIND( numnam )                        ! Read Namelist namzgr_sco : sigma-stretching parameters 
     1140      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 
     1141         CALL ctl_stop('zgr_sco: ERROR - requested workspace arrays unavailable')   ;   RETURN 
     1142      ENDIF 
     1143 
     1144      REWIND( numnam )                       ! Read Namelist namzgr_sco : sigma-stretching parameters 
    11151145      READ  ( numnam, namzgr_sco ) 
    11161146 
    1117       IF(lwp) THEN                            ! control print 
     1147      IF(lwp) THEN                           ! control print 
    11181148         WRITE(numout,*) 
    11191149         WRITE(numout,*) 'dom:zgr_sco : s-coordinate or hybrid z-s-coordinate' 
     
    11461176      DO jj = 1, jpj 
    11471177         DO ji = 1, jpi 
    1148            IF( bathy(ji,jj) > 0._wp ) THEN 
    1149               bathy(ji,jj) = MAX( rn_sbot_min, bathy(ji,jj) ) 
    1150            ENDIF 
     1178           IF( bathy(ji,jj) > 0._wp )   bathy(ji,jj) = MAX( rn_sbot_min, bathy(ji,jj) ) 
    11511179         END DO 
    11521180      END DO 
     
    13721400         END DO    ! for all ji's 
    13731401 
    1374          DO ji = 1, jpi 
    1375             DO jj = 1, jpj 
     1402         DO ji = 1, jpim1 
     1403            DO jj = 1, jpjm1 
    13761404               DO jk = 1, jpk 
    13771405                  esigtu3(ji,jj,jk) = ( hbatt(ji,jj)*esigt3(ji,jj,jk)+hbatt(ji+1,jj)*esigt3(ji+1,jj,jk) )   & 
     
    13981426            END DO 
    13991427         END DO 
     1428 
     1429         CALL lbc_lnk( e3t , 'T', 1._wp ) 
     1430         CALL lbc_lnk( e3u , 'U', 1._wp ) 
     1431         CALL lbc_lnk( e3v , 'V', 1._wp ) 
     1432         CALL lbc_lnk( e3f , 'F', 1._wp ) 
     1433         CALL lbc_lnk( e3w , 'W', 1._wp ) 
     1434         CALL lbc_lnk( e3uw, 'U', 1._wp ) 
     1435         CALL lbc_lnk( e3vw, 'V', 1._wp ) 
     1436 
    14001437         ! 
    14011438      ELSE   ! not ln_s_sigma 
     
    15531590!!gm bug    #endif 
    15541591      ! 
     1592      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) )  & 
     1593        &  CALL ctl_stop('dom:zgr_sco: failed to release workspace arrays') 
     1594      ! 
    15551595   END SUBROUTINE zgr_sco 
    1556  
    15571596 
    15581597   !!====================================================================== 
Note: See TracChangeset for help on using the changeset viewer.