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 2618 for branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DTA – NEMO

Ignore:
Timestamp:
2011-02-26T13:31:38+01:00 (13 years ago)
Author:
gm
Message:

dynamic mem: #785 ; move dyn allocation from nemogcm to module when possible (continuation)

Location:
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DTA
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DTA/dtasal.F90

    r2590 r2618  
    2525   PRIVATE 
    2626 
    27    PUBLIC   dta_sal        ! called by step.F90 and inidta.F90 
    28    PUBLIC   dta_sal_alloc  ! Called by nemogcm.F90 
    29  
    30    LOGICAL , PUBLIC, PARAMETER              :: lk_dtasal = .TRUE. !: salinity data flag 
    31    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: s_dta !: salinity data at given time-step 
    32  
    33    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_sal       ! structure of input SST (file informations, fields read) 
     27   PUBLIC   dta_sal    ! called by step.F90 and inidta.F90 
     28 
     29   LOGICAL , PUBLIC, PARAMETER                     ::   lk_dtasal = .TRUE. !: salinity data flag 
     30   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) ::   s_dta              !: salinity data at given time-step 
     31 
     32   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_sal   ! structure of input SST (file informations, fields read) 
    3433 
    3534   !! * Substitutions 
    3635#  include "domzgr_substitute.h90" 
    3736   !!---------------------------------------------------------------------- 
    38    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     37   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    3938   !! $Id$  
    4039   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4140   !!---------------------------------------------------------------------- 
    4241CONTAINS 
    43  
    44    FUNCTION dta_sal_alloc() 
    45      IMPLICIT none 
    46      INTEGER :: dta_sal_alloc 
    47      INTEGER :: ierr 
    48  
    49      ALLOCATE(s_dta(jpi,jpj,jpk),  & 
    50               sf_sal(1),           & 
    51               Stat=ierr) 
    52      IF(ierr <= 0)THEN 
    53         ALLOCATE( sf_sal(1)%fnow(jpi,jpj,jpk)   ) 
    54      END IF 
    55  
    56      dta_sal_alloc = ierr 
    57  
    58    END FUNCTION dta_sal_alloc 
    5942 
    6043   SUBROUTINE dta_sal( kt ) 
    … …  
    6952      !!                between two monthly values. 
    7053      !!---------------------------------------------------------------------- 
    71       INTEGER, INTENT(in) ::   kt             ! ocean time step 
     54      INTEGER, INTENT(in) ::   kt   ! ocean time step 
    7255      ! 
    73       INTEGER ::   ji, jj, jk, jl, jkk            ! dummy loop indicies 
    74       INTEGER ::   ik, ierror                     ! temporary integers 
     56      INTEGER ::   ji, jj, jk, jl, jkk       ! local loop indicies 
     57      INTEGER ::   ik, ierr0, ierr1, ierr2   ! local integers 
    7558#if defined key_tradmp 
    76       INTEGER ::   il0, il1, ii0, ii1, ij0, ij1   ! temporary integers 
     59      INTEGER ::   il0, il1, ii0, ii1, ij0, ij1   ! local integers 
    7760#endif 
    7861      REAL(wp)::   zl 
    … …  
    10588            WRITE(numout,*) '~~~~~~~ ' 
    10689         ENDIF 
    107 ! ARPDBG moved first two allocate's into dta_sal_alloc() 
    108 !!$         ALLOCATE( sf_sal(1), STAT=ierror ) 
    109 !!$         IF( ierror > 0 ) THEN 
    110 !!$             CALL ctl_stop( 'dta_sal: unable to allocate sf_sal structure' )   ;   RETURN 
    111 !!$         ENDIF 
    112 !!$                                ALLOCATE( sf_sal(1)%fnow(jpi,jpj,jpk)   ) 
    113          IF( sn_sal%ln_tint )   ALLOCATE( sf_sal(1)%fdta(jpi,jpj,jpk,2) ) 
     90                                ALLOCATE( sf_sal(1)                    , STAT=ierr0 ) 
     91                                ALLOCATE( sf_sal(1)%fnow(jpi,jpj,jpk)  , STAT=ierr1 ) 
     92         IF( sn_sal%ln_tint )   ALLOCATE( sf_sal(1)%fdta(jpi,jpj,jpk,2), STAT=ierr2 ) 
     93         IF( ierr0+ierr1+ierr2 > 0 )   CALL ctl_stop( 'STOP', 'dta_sal: unable to allocate sf_sal structure' ) 
    11494         !                         ! fill sf_sal with sn_sal and control print 
    11595         CALL fld_fill( sf_sal, (/ sn_sal /), cn_dir, 'dta_sal', 'Salinity data', 'namdta_sal' ) 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DTA/dtatem.F90

    r2590 r2618  
    2525   PRIVATE 
    2626 
    27    PUBLIC   dta_tem        ! called by step.F90 and inidta.F90 
    28    PUBLIC   dta_tem_alloc  ! called by nemo_init in nemogcm.F90 
    29  
    30    LOGICAL , PUBLIC, PARAMETER ::   lk_dtatem = .TRUE.   !: temperature data flag 
    31    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: t_dta !: temperature data at given time-step 
     27   PUBLIC   dta_tem    ! called by step.F90 and inidta.F90 
     28 
     29   LOGICAL , PUBLIC, PARAMETER                     ::   lk_dtatem = .TRUE. !: temperature data flag 
     30   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) ::   t_dta              !: temperature data at given time-step 
    3231 
    3332   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_tem      ! structure of input SST (file informations, fields read) 
    … …  
    3635#  include "domzgr_substitute.h90" 
    3736   !!---------------------------------------------------------------------- 
    38    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     37   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    3938   !! $Id$  
    4039   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4140   !!---------------------------------------------------------------------- 
    4241CONTAINS 
    43  
    44    FUNCTION dta_tem_alloc() 
    45      IMPLICIT none 
    46      INTEGER :: dta_tem_alloc 
    47      INTEGER :: ierror 
    48      ALLOCATE(t_dta(jpi,jpj,jpk), & 
    49               sf_tem(1),          & 
    50               STAT=ierror ) 
    51      IF( ierror <= 0 ) THEN 
    52         ALLOCATE( sf_tem(1)%fnow(jpi,jpj,jpk), STAT=ierror   ) 
    53      END IF 
    54  
    55      dta_tem_alloc = ierror 
    56  
    57    END FUNCTION dta_tem_alloc 
    58  
    5942 
    6043   SUBROUTINE dta_tem( kt ) 
    … …  
    7558      !! ** Action  :   define t_dta array at time-step kt 
    7659      !!---------------------------------------------------------------------- 
    77       INTEGER, INTENT( in ) ::   kt     ! ocean time-step 
     60      INTEGER, INTENT( in ) ::   kt   ! ocean time-step 
    7861      ! 
    79       INTEGER ::   ji, jj, jk, jl, jkk            ! dummy loop indicies 
    80       INTEGER ::   ik, ierror                     ! temporary integers 
     62      INTEGER ::   ji, jj, jk, jl, jkk       ! dummy loop indicies 
     63      INTEGER ::   ik, ierr0, ierr1, ierr2   ! local integers 
    8164#if defined key_tradmp 
    82       INTEGER ::   il0, il1, ii0, ii1, ij0, ij1   ! temporary integers 
     65      INTEGER ::   il0, il1, ii0, ii1, ij0, ij1   ! local integers 
    8366#endif 
    8467      REAL(wp)::   zl 
    … …  
    11295            WRITE(numout,*) '~~~~~~~ ' 
    11396         ENDIF 
    114 ! ARPDBG - moved into dta_tem_alloc() 
    115 !!$         ALLOCATE( sf_tem(1), STAT=ierror ) 
    116 !!$         IF( ierror > 0 ) THEN 
    117 !!$             CALL ctl_stop( 'dta_tem: unable to allocate sf_tem structure' )   ;   RETURN 
    118 !!$         ENDIF 
    119 !!$                                ALLOCATE( sf_tem(1)%fnow(jpi,jpj,jpk)   ) 
    120          IF( sn_tem%ln_tint )   ALLOCATE( sf_tem(1)%fdta(jpi,jpj,jpk,2) ) 
     97                                ALLOCATE( sf_tem(1)                    , STAT=ierr0 ) 
     98                                ALLOCATE( sf_tem(1)%fnow(jpi,jpj,jpk)  , STAT=ierr1 ) 
     99         IF( sn_tem%ln_tint )   ALLOCATE( sf_tem(1)%fdta(jpi,jpj,jpk,2), STAT=ierr2 ) 
     100         IF( ierr0+ierr1+ierr2 > 0 )   CALL ctl_stop( 'STOP', 'dta_sal: unable to allocate sf_sal structure' ) 
    121101         !                         ! fill sf_tem with sn_tem and control print 
    122102         CALL fld_fill( sf_tem, (/ sn_tem /), cn_dir, 'dta_tem', 'Temperature data', 'namdta_tem' ) 
Note: See TracChangeset for help on using the changeset viewer.