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/OFF_SRC/dtadyn.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/OFF_SRC/dtadyn.F90

    r2559 r2715  
    6363   INTEGER ::   numfl_t, numfl_u, numfl_v, numfl_w 
    6464 
    65    REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: tdta       ! temperature at two consecutive times 
    66    REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: sdta       ! salinity at two consecutive times 
    67    REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: udta       ! zonal velocity at two consecutive times 
    68    REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: vdta       ! meridional velocity at two consecutive times 
    69    REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: wdta       ! vertical velocity at two consecutive times 
    70    REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: avtdta     ! vertical diffusivity coefficient 
    71  
    72    REAL(wp), DIMENSION(jpi,jpj    ,2) :: hmlddta    ! mixed layer depth at two consecutive times 
    73    REAL(wp), DIMENSION(jpi,jpj    ,2) :: wspddta    ! wind speed at two consecutive times 
    74    REAL(wp), DIMENSION(jpi,jpj    ,2) :: frlddta    ! sea-ice fraction at two consecutive times 
    75    REAL(wp), DIMENSION(jpi,jpj    ,2) :: empdta     ! E-P at two consecutive times 
    76    REAL(wp), DIMENSION(jpi,jpj    ,2) :: qsrdta     ! short wave heat flux at two consecutive times 
    77    REAL(wp), DIMENSION(jpi,jpj    ,2) :: bblxdta    ! frequency of bbl in the x direction at 2 consecutive times  
    78    REAL(wp), DIMENSION(jpi,jpj    ,2) :: bblydta    ! frequency of bbl in the y direction at 2 consecutive times  
     65   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: tdta       ! temperature at two consecutive times 
     66   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: sdta       ! salinity at two consecutive times 
     67   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: udta       ! zonal velocity at two consecutive times 
     68   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: vdta       ! meridional velocity at two consecutive times 
     69   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: wdta       ! vertical velocity at two consecutive times 
     70   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: avtdta     ! vertical diffusivity coefficient 
     71 
     72   REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:,:) :: hmlddta    ! mixed layer depth at two consecutive times 
     73   REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:,:) :: wspddta    ! wind speed at two consecutive times 
     74   REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:,:) :: frlddta    ! sea-ice fraction at two consecutive times 
     75   REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:,:) :: empdta     ! E-P at two consecutive times 
     76   REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:,:) :: qsrdta     ! short wave heat flux at two consecutive times 
     77   REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:,:) :: bblxdta    ! frequency of bbl in the x direction at 2 consecutive times  
     78   REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:,:) :: bblydta    ! frequency of bbl in the y direction at 2 consecutive times  
    7979   LOGICAL :: l_offbbl 
    8080#if defined key_ldfslp 
    81    REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: uslpdta    ! zonal isopycnal slopes 
    82    REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: vslpdta    ! meridional isopycnal slopes 
    83    REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: wslpidta   ! zonal diapycnal slopes 
    84    REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: wslpjdta   ! meridional diapycnal slopes 
     81   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: uslpdta    ! zonal isopycnal slopes 
     82   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: vslpdta    ! meridional isopycnal slopes 
     83   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: wslpidta   ! zonal diapycnal slopes 
     84   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: wslpjdta   ! meridional diapycnal slopes 
    8585#endif 
    8686#if ! defined key_degrad &&  defined key_traldf_c2d && defined key_traldf_eiv  
    87    REAL(wp), DIMENSION(jpi,jpj    ,2) :: aeiwdta    ! G&M coefficient 
     87   REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:,:) :: aeiwdta    ! G&M coefficient 
    8888#endif 
    8989#if defined key_degrad 
    90    REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: ahtudta, ahtvdta, ahtwdta   ! Lateral diffusivity 
     90   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: ahtudta, ahtvdta, ahtwdta   ! Lateral diffusivity 
    9191# if defined key_traldf_eiv 
    92    REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: aeiudta, aeivdta, aeiwdta   ! G&M coefficient 
     92   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: aeiudta, aeivdta, aeiwdta   ! G&M coefficient 
    9393# endif 
    9494#endif 
     
    297297 
    298298 
     299   INTEGER FUNCTION dta_dyn_alloc() 
     300      !!--------------------------------------------------------------------- 
     301      !!                 ***  ROUTINE dta_dyn_alloc  *** 
     302      !!--------------------------------------------------------------------- 
     303 
     304      ALLOCATE( tdta    (jpi,jpj,jpk,2), sdta    (jpi,jpj,jpk,2),    & 
     305         &      udta    (jpi,jpj,jpk,2), vdta    (jpi,jpj,jpk,2),    & 
     306         &      wdta    (jpi,jpj,jpk,2), avtdta  (jpi,jpj,jpk,2),    & 
     307#if defined key_ldfslp  
     308         &      uslpdta (jpi,jpj,jpk,2), vslpdta (jpi,jpj,jpk,2),    & 
     309         &      wslpidta(jpi,jpj,jpk,2), wslpjdta(jpi,jpj,jpk,2),    & 
     310#endif 
     311#if defined key_degrad 
     312         &      ahtudta (jpi,jpj,jpk,2), ahtvdta (jpi,jpj,jpk,2),    & 
     313         &      ahtwdta (jpi,jpj,jpk,2),                             & 
     314# if defined key_traldf_eiv 
     315         &      aeiudta (jpi,jpj,jpk,2), aeivdta (jpi,jpj,jpk,2),    & 
     316         &      aeiwdta (jpi,jpj,jpk,2),                             & 
     317# endif 
     318#endif 
     319#if ! defined key_degrad &&  defined key_traldf_c2d && defined key_traldf_eiv 
     320         &      aeiwdta (jpi,jpj,    2),                             & 
     321#endif 
     322         &      hmlddta (jpi,jpj,    2), wspddta (jpi,jpj,    2),    & 
     323         &      frlddta (jpi,jpj,    2), qsrdta  (jpi,jpj,    2),    & 
     324         &      empdta  (jpi,jpj,    2),                         STAT=dta_dyn_alloc )  
     325         ! 
     326      IF( dta_dyn_alloc /= 0 )   CALL ctl_warn('dta_dyn_alloc: failed to allocate facvol array') 
     327      ! 
     328   END FUNCTION dta_dyn_alloc 
     329 
     330 
    299331   SUBROUTINE dynrea( kt, kenr ) 
    300332      !!---------------------------------------------------------------------- 
     
    305337      !! ** Method : READ the kenr records of DATA and store in udta(...,2), ....   
    306338      !!---------------------------------------------------------------------- 
     339      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
     340      USE wrk_nemo, ONLY: zu    => wrk_3d_1 , zv    => wrk_3d_2 , zw    => wrk_3d_3 
     341      USE wrk_nemo, ONLY: zt    => wrk_3d_4 , zs    => wrk_3d_5 
     342      USE wrk_nemo, ONLY: zavt  => wrk_3d_6 , zhdiv => wrk_3d_7 
     343      USE wrk_nemo, ONLY: zahtu => wrk_3d_8 , zahtv => wrk_3d_9 , zahtw => wrk_3d_10 
     344      USE wrk_nemo, ONLY: zaeiu => wrk_3d_11, zaeiv => wrk_3d_12, zaeiw => wrk_3d_13 
     345      ! 
     346      USE wrk_nemo, ONLY: zemp  => wrk_2d_1 , zqsr  => wrk_2d_2 , zmld  => wrk_2d_3 
     347      USE wrk_nemo, ONLY: zice  => wrk_2d_4 , zwspd => wrk_2d_5  
     348      USE wrk_nemo, ONLY: ztaux => wrk_2d_6 , ztauy => wrk_2d_7 
     349      USE wrk_nemo, ONLY: zbblx => wrk_2d_8 , zbbly => wrk_2d_9 
     350      USE wrk_nemo, ONLY: zaeiw2d => wrk_2d_10 
     351      ! 
    307352      INTEGER, INTENT(in) ::   kt, kenr   ! time index 
    308353      !! 
    309354      INTEGER ::  jkenr 
    310       REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zu, zv, zw, zt, zs, zavt , zhdiv              ! 3D workspace 
    311       REAL(wp), DIMENSION(jpi,jpj)     ::  zemp, zqsr, zmld, zice, zwspd, ztaux, ztauy   ! 2D workspace 
    312       REAL(wp), DIMENSION(jpi,jpj)     ::  zbblx, zbbly 
    313  
    314 #if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv 
    315       REAL(wp), DIMENSION(jpi,jpj) :: zaeiw  
    316 #endif 
    317 #if defined key_degrad 
    318    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zahtu, zahtv, zahtw  !  Lateral diffusivity 
    319 # if defined key_traldf_eiv 
    320    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zaeiu, zaeiv, zaeiw  ! G&M coefficient 
    321 # endif 
    322 #endif 
    323       !!---------------------------------------------------------------------- 
    324  
    325       ! 0. Initialization 
     355      !!---------------------------------------------------------------------- 
     356      !  
     357      IF( wrk_in_use(3, 1,2,3,4,5,6,7,8,9,10,11,12,13) .OR. & 
     358          wrk_in_use(2, 1,2,3,4,5,6,7,8,9,10)               ) THEN 
     359         CALL ctl_stop('domrea/dta_dyn: requested workspace arrays unavailable')   ;   RETURN 
     360      ENDIF 
    326361       
    327362      ! cas d'un fichier non periodique : on utilise deux fois le premier et 
     
    390425 
    391426#if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv  
    392       CALL iom_get( numfl_w, jpdom_data, 'soleaeiw', zaeiw (:,: ), jkenr ) 
     427      CALL iom_get( numfl_w, jpdom_data, 'soleaeiw', zaeiw2d(:,: ), jkenr ) 
    393428#endif 
    394429 
     
    413448 
    414449#if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv 
    415       aeiwdta(:,:,2)  = zaeiw(:,:) * tmask(:,:,1) 
     450      aeiwdta(:,:,2)  = zaeiw2d(:,:) * tmask(:,:,1) 
    416451#endif 
    417452 
     
    451486      ENDIF 
    452487      !       
     488      IF( wrk_not_released(3, 1,2,3,4,5,6,7,8,9,10,11,12,13) .OR. & 
     489          wrk_not_released(2, 1,2,3,4,5,6,7,8,9,10)               ) THEN 
     490         CALL ctl_stop('domrea/dta_dyn: failed to release workspace arrays') 
     491      END IF 
     492      ! 
    453493   END SUBROUTINE dynrea 
    454494 
     
    462502      !! ** Method : 
    463503      !!---------------------------------------------------------------------- 
    464       REAL(wp) ::   znspyr   !: number of time step per year 
    465       !! 
     504      REAL(wp) :: znspyr   !: number of time step per year 
     505      ! 
    466506      NAMELIST/namdyn/ ndtadyn, ndtatot, nsptint, lperdyn,  & 
    467       &                cfile_grid_T, cfile_grid_U, cfile_grid_V, cfile_grid_W 
    468       !!---------------------------------------------------------------------- 
    469  
    470       !  Define the dynamical input parameters 
    471       ! ====================================== 
    472  
     507         &             cfile_grid_T, cfile_grid_U, cfile_grid_V, cfile_grid_W 
     508      !!---------------------------------------------------------------------- 
     509      ! 
     510      IF( dta_dyn_alloc() /= 0 )  CALL ctl_stop( 'STOP', 'dta_dyn_alloc: unable to allocate standard ocean arrays' ) 
     511      ! 
    473512      REWIND( numnam )              ! Read Namelist namdyn : Lateral physics on tracers 
    474513      READ  ( numnam, namdyn ) 
    475  
     514      ! 
    476515      IF(lwp) THEN                  ! control print 
    477516         WRITE(numout,*) 
     
    493532      ! 
    494533      znspyr   = nyear_len(1) * rday / rdt   
    495       rnspdta  = znspyr / FLOAT( ndtadyn ) 
     534      rnspdta  = znspyr / REAL( ndtadyn, wp ) 
    496535      rnspdta2 = rnspdta * 0.5  
    497536      ! 
Note: See TracChangeset for help on using the changeset viewer.