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 7910 for branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90 – NEMO

Ignore:
Timestamp:
2017-04-13T16:21:08+02:00 (7 years ago)
Author:
timgraham
Message:

All wrk_alloc removed

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90

    r7753 r7910  
    2727   USE in_out_manager   ! I/O manager 
    2828   USE lib_mpp          ! MPP library 
    29    USE wrk_nemo         ! work arrays 
    3029   USE lib_fortran      ! to use key_nosignedzero 
    3130   USE limcons          ! conservation tests 
     
    6766      CHARACTER (len = 15) :: fieldid 
    6867 
    69       INTEGER , POINTER, DIMENSION(:,:,:) ::   zdonor   ! donor category index 
    70  
    71       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdhice      ! ice thickness increment 
    72       REAL(wp), POINTER, DIMENSION(:,:,:) ::   g0          ! coefficients for fitting the line of the ITD 
    73       REAL(wp), POINTER, DIMENSION(:,:,:) ::   g1          ! coefficients for fitting the line of the ITD 
    74       REAL(wp), POINTER, DIMENSION(:,:,:) ::   hL          ! left boundary for the ITD for each thickness 
    75       REAL(wp), POINTER, DIMENSION(:,:,:) ::   hR          ! left boundary for the ITD for each thickness 
    76       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zht_i_b     ! old ice thickness 
    77       REAL(wp), POINTER, DIMENSION(:,:,:) ::   dummy_es 
    78       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdaice, zdvice          ! local increment of ice area and volume 
    79       REAL(wp), POINTER, DIMENSION(:)     ::   zvetamin, zvetamax      ! maximum values for etas 
    80       INTEGER , POINTER, DIMENSION(:)     ::   nind_i, nind_j          ! compressed indices for i/j directions 
     68      INTEGER , DIMENSION(jpi,jpj,jpl-1) ::   zdonor   ! donor category index 
     69 
     70      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zdhice      ! ice thickness increment 
     71      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   g0          ! coefficients for fitting the line of the ITD 
     72      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   g1          ! coefficients for fitting the line of the ITD 
     73      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   hL          ! left boundary for the ITD for each thickness 
     74      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   hR          ! left boundary for the ITD for each thickness 
     75      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zht_i_b     ! old ice thickness 
     76      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   dummy_es 
     77      REAL(wp), DIMENSION(jpi,jpj,jpl-1) ::   zdaice, zdvice          ! local increment of ice area and volume 
     78      REAL(wp), DIMENSION((jpi+1)*(jpj+1))     ::   zvetamin, zvetamax      ! maximum values for etas 
     79      INTEGER , DIMENSION((jpi+1)*(jpj+1))     ::   nind_i, nind_j          ! compressed indices for i/j directions 
    8180      INTEGER                             ::   nbrem                   ! number of cells with ice to transfer 
    8281      REAL(wp)                            ::   zslope                  ! used to compute local thermodynamic "speeds" 
    83       REAL(wp), POINTER, DIMENSION(:,:)   ::   zhb0, zhb1              ! category boundaries for thinnes categories 
    84       REAL(wp), POINTER, DIMENSION(:,:)   ::   vt_i_init, vt_i_final   !  ice volume summed over categories 
    85       REAL(wp), POINTER, DIMENSION(:,:)   ::   vt_s_init, vt_s_final   !  snow volume summed over categories 
    86       REAL(wp), POINTER, DIMENSION(:,:)   ::   et_i_init, et_i_final   !  ice energy summed over categories 
    87       REAL(wp), POINTER, DIMENSION(:,:)   ::   et_s_init, et_s_final   !  snow energy summed over categories 
    88       INTEGER , POINTER, DIMENSION(:,:)   ::   zremap_flag      ! compute remapping or not ???? 
    89       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zhbnew           ! new boundaries of ice categories 
    90       !!------------------------------------------------------------------ 
    91  
    92       CALL wrk_alloc( jpi,jpj, zremap_flag ) 
    93       CALL wrk_alloc( jpi,jpj,jpl-1, zdonor ) 
    94       CALL wrk_alloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_b, dummy_es ) 
    95       CALL wrk_alloc( jpi,jpj,jpl-1, zdaice, zdvice )    
    96       CALL wrk_alloc( jpi,jpj,jpl+1, zhbnew, kkstart = 0 )    
    97       CALL wrk_alloc( (jpi+1)*(jpj+1), zvetamin, zvetamax )    
    98       CALL wrk_alloc( (jpi+1)*(jpj+1), nind_i, nind_j )  
    99       CALL wrk_alloc( jpi,jpj, zhb0,zhb1,vt_i_init,vt_i_final,vt_s_init,vt_s_final,et_i_init,et_i_final,et_s_init,et_s_final ) 
     82      REAL(wp), DIMENSION(jpi,jpj)   ::   zhb0, zhb1              ! category boundaries for thinnes categories 
     83      REAL(wp), DIMENSION(jpi,jpj)   ::   vt_i_init, vt_i_final   !  ice volume summed over categories 
     84      REAL(wp), DIMENSION(jpi,jpj)   ::   vt_s_init, vt_s_final   !  snow volume summed over categories 
     85      REAL(wp), DIMENSION(jpi,jpj)   ::   et_i_init, et_i_final   !  ice energy summed over categories 
     86      REAL(wp), DIMENSION(jpi,jpj)   ::   et_s_init, et_s_final   !  snow energy summed over categories 
     87      INTEGER , DIMENSION(jpi,jpj)   ::   zremap_flag      ! compute remapping or not ???? 
     88      REAL(wp), DIMENSION(jpi,jpj,0:jpl) ::   zhbnew           ! new boundaries of ice categories 
     89      !!------------------------------------------------------------------ 
     90 
    10091 
    10192      !!---------------------------------------------------------------------------------------------- 
     
    383374      ENDIF 
    384375 
    385       CALL wrk_dealloc( jpi,jpj, zremap_flag ) 
    386       CALL wrk_dealloc( jpi,jpj,jpl-1, zdonor ) 
    387       CALL wrk_dealloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_b, dummy_es ) 
    388       CALL wrk_dealloc( jpi,jpj,jpl-1, zdaice, zdvice )    
    389       CALL wrk_dealloc( jpi,jpj,jpl+1, zhbnew, kkstart = 0 )    
    390       CALL wrk_dealloc( (jpi+1)*(jpj+1), zvetamin, zvetamax )    
    391       CALL wrk_dealloc( (jpi+1)*(jpj+1), nind_i, nind_j )  
    392       CALL wrk_dealloc( jpi,jpj, zhb0,zhb1,vt_i_init,vt_i_final,vt_s_init,vt_s_final,et_i_init,et_i_final,et_s_init,et_s_final ) 
    393376 
    394377   END SUBROUTINE lim_itd_th_rem 
     
    477460      INTEGER ::   ii, ij                     ! indices when changing from 2D-1D is done 
    478461 
    479       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zaTsfn 
    480       REAL(wp), POINTER, DIMENSION(:,:)   ::   zworka            ! temporary array used here 
     462      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zaTsfn 
     463      REAL(wp), DIMENSION(jpi,jpj)   ::   zworka            ! temporary array used here 
    481464 
    482465      REAL(wp) ::   zdvsnow, zdesnow   ! snow volume and energy transferred 
     
    486469      REAL(wp) ::   zdaTsf             ! aicen*Tsfcn transferred 
    487470 
    488       INTEGER, POINTER, DIMENSION(:) ::   nind_i, nind_j   ! compressed indices for i/j directions 
     471      INTEGER, DIMENSION((jpi+1)*(jpj+1)) ::   nind_i, nind_j   ! compressed indices for i/j directions 
    489472 
    490473      INTEGER  ::   nbrem             ! number of cells with ice to transfer 
    491474      !!------------------------------------------------------------------ 
    492475 
    493       CALL wrk_alloc( jpi,jpj,jpl, zaTsfn ) 
    494       CALL wrk_alloc( jpi,jpj, zworka ) 
    495       CALL wrk_alloc( (jpi+1)*(jpj+1), nind_i, nind_j ) 
    496476 
    497477      !---------------------------------------------------------------------------------------------- 
     
    621601      END DO 
    622602      ! 
    623       CALL wrk_dealloc( jpi,jpj,jpl, zaTsfn ) 
    624       CALL wrk_dealloc( jpi,jpj, zworka ) 
    625       CALL wrk_dealloc( (jpi+1)*(jpj+1), nind_i, nind_j ) 
    626603      ! 
    627604   END SUBROUTINE lim_itd_shiftice 
     
    643620      CHARACTER (len = 15) :: fieldid 
    644621 
    645       INTEGER , POINTER, DIMENSION(:,:,:) ::   zdonor           ! donor category index 
    646       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdaice, zdvice   ! ice area and volume transferred 
    647  
    648       REAL(wp), POINTER, DIMENSION(:,:) ::   vt_i_init, vt_i_final   ! ice volume summed over categories 
    649       REAL(wp), POINTER, DIMENSION(:,:) ::   vt_s_init, vt_s_final   ! snow volume summed over categories 
     622      INTEGER , DIMENSION(jpi,jpj,jpl) ::   zdonor           ! donor category index 
     623      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zdaice, zdvice   ! ice area and volume transferred 
     624 
     625      REAL(wp), DIMENSION(jpi,jpj) ::   vt_i_init, vt_i_final   ! ice volume summed over categories 
     626      REAL(wp), DIMENSION(jpi,jpj) ::   vt_s_init, vt_s_final   ! snow volume summed over categories 
    650627      !!------------------------------------------------------------------ 
    651628       
    652       CALL wrk_alloc( jpi,jpj,jpl, zdonor )   ! interger 
    653       CALL wrk_alloc( jpi,jpj,jpl, zdaice, zdvice ) 
    654       CALL wrk_alloc( jpi,jpj, vt_i_init, vt_i_final, vt_s_init, vt_s_final ) 
    655629      !      
    656630      IF( con_i ) THEN                 ! conservation check 
     
    772746      ENDIF 
    773747      ! 
    774       CALL wrk_dealloc( jpi,jpj,jpl, zdonor ) 
    775       CALL wrk_dealloc( jpi,jpj,jpl, zdaice, zdvice ) 
    776       CALL wrk_dealloc( jpi,jpj, vt_i_init, vt_i_final, vt_s_init, vt_s_final ) 
    777748 
    778749   END SUBROUTINE lim_itd_th_reb 
Note: See TracChangeset for help on using the changeset viewer.