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

Ignore:
Timestamp:
2011-02-25T11:45:57+01:00 (13 years ago)
Author:
gm
Message:

dynamic mem: #785 ; move the allocation of ice in iceini_2/iceini module + bug fixes (define key_esopa)

Location:
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DIA
Files:
5 edited

Legend:

Unmodified
Added
Removed

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90

    r2590 r2613  
    77   !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase + merge TRC-TRA 
    88   !!---------------------------------------------------------------------- 
    9 #if defined key_diaar5 
     9#if defined key_diaar5   || defined key_esopa 
    1010   !!---------------------------------------------------------------------- 
    1111   !!   'key_diaar5'  :                           activate ar5 diagnotics 
    … …  
    5050      INTEGER :: dia_ar5_alloc 
    5151      !!---------------------------------------------------------------------- 
    52  
    53       ALLOCATE(area(jpi,jpj), thick0(jpi,jpj), sn0(jpi,jpj,jpk), & 
    54                Stat=dia_ar5_alloc) 
    55  
    56       IF(dia_ar5_alloc /= 0)THEN 
    57          CALL ctl_warn('dia_ar5_alloc: failed to allocate arrays') 
    58       END IF 
    59  
     52      ! 
     53      ALLOCATE( area(jpi,jpj), thick0(jpi,jpj) , sn0(jpi,jpj,jpk) , STAT=dia_ar5_alloc ) 
     54      ! 
     55      IF( lk_mpp             )   CALL mpp_sum ( dia_ar5_alloc ) 
     56      IF( dia_ar5_alloc /= 0 )   CALL ctl_warn('dia_ar5_alloc: failed to allocate arrays') 
     57      ! 
    6058   END FUNCTION dia_ar5_alloc 
    6159 
    … …  
    6664      !! 
    6765      !! ** Purpose :   compute and output some AR5 diagnostics 
    68       !! 
    6966      !!---------------------------------------------------------------------- 
    7067      USE wrk_nemo, ONLY: wrk_use, wrk_release 
    … …  
    8279          (.NOT. wrk_use(3, 1,2)) .OR. & 
    8380          (.NOT. wrk_use(4, 1)) )THEN 
    84          CALL ctl_stop('dia_ar5: requested workspace arrays unavailable') 
    85          RETURN 
     81         CALL ctl_stop('dia_ar5: requested workspace arrays unavailable')   ;   RETURN 
    8682      END IF 
    8783 
    … …  
    190186      ! 
    191187      IF(.NOT. wrk_use(4, 1))THEN 
    192          CALL ctl_stop('dia_ar5_init: requested workspace array unavailable.') 
    193          RETURN 
     188         CALL ctl_stop('dia_ar5_init: requested workspace array unavailable.')   ;   RETURN 
    194189      END IF 
    195190      zsaldta => wrk_4d_1(:,:,:,1:2) 
     191 
     192      !                                      ! allocate dia_ar5 arrays 
     193      IF( dia_ar5_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' ) 
    196194 
    197195      area(:,:) = e1t(:,:) * e2t(:,:) * tmask_i(:,:) 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DIA/diadimg.F90

    r2590 r2613  
    66# if defined key_dimgout 
    77   !!---------------------------------------------------------------------- 
    8    !! * Modules used 
    98   USE oce             ! ocean dynamics and tracers  
    109   USE dom_oce         ! ocean space and time domain 
    … …  
    1514   PRIVATE 
    1615 
    17    !! * Accessibility 
    1816   PUBLIC dia_wri_dimg            ! called by trd_mld (eg) 
    1917   PUBLIC dia_wri_dimg_alloc      ! called by nemo_alloc in nemogcm.F90 
    2018 
     19 
     20   !! These workspace arrays are inside the module so that we can make them 
     21   !! allocatable in a clean way. Not done in wrk_nemo because these are of KIND(sp). 
     22   REAL(sp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: z42d    ! 2d temporary workspace (sp) 
     23   REAL(sp), ALLOCATABLE, SAVE, DIMENSION(:)   :: z4dep   ! vertical level (sp) 
     24 
    2125   !! * Substitutions 
    2226#  include "domzgr_substitute.h90" 
    23  
    24    !! These workspace arrays are inside the module so that we can make them 
    25    !! allocatable in a clean way. Not done in wrk_nemo because these are 
    26    !! of KIND(sp). 
    27    REAL(sp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: z42d  ! 2d temporary workspace (sp) 
    28    REAL(sp), ALLOCATABLE, SAVE,   DIMENSION(:) :: z4dep ! vertical level (sp) 
    29  
    3027   !!---------------------------------------------------------------------- 
    3128   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    … …  
    3330   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3431   !!---------------------------------------------------------------------- 
    35  
    3632CONTAINS 
    3733 
    38   FUNCTION dia_wri_dimg_alloc() 
    39      !!--------------------------------------------------------------------- 
    40      !!        *** ROUTINE dia_wri_dimg_alloc *** 
    41      !! 
    42      !!--------------------------------------------------------------------- 
    43      INTEGER :: dia_wri_dimg_alloc 
    44      !!--------------------------------------------------------------------- 
    45  
    46      ALLOCATE(z42d(jpi,jpj), z4dep(jpk), Stat=dia_wri_dimg_alloc) 
    47  
    48      IF(dia_wri_dimg_alloc /= 0)THEN 
    49         CALL ctl_warn('dia_wri_dimg_alloc: allocation of array failed.') 
    50      END IF 
    51  
     34   FUNCTION dia_wri_dimg_alloc() 
     35      !!--------------------------------------------------------------------- 
     36      !!        *** ROUTINE dia_wri_dimg_alloc *** 
     37      !! 
     38      !!--------------------------------------------------------------------- 
     39      INTEGER :: dia_wri_dimg_alloc   ! return value 
     40      !!--------------------------------------------------------------------- 
     41      ! 
     42      ALLOCATE( z42d(jpi,jpj), z4dep(jpk), STAT=dia_wri_dimg_alloc ) 
     43      ! 
     44      IF( lk_mpp                  )   CALL mpp_sum ( dia_wri_dimg_alloc ) 
     45      IF( dia_wri_dimg_alloc /= 0 )   CALL ctl_warn('dia_wri_dimg_alloc: allocation of array failed.') 
     46      ! 
    5247  END FUNCTION dia_wri_dimg_alloc 
    5348 
    5449 
    55   SUBROUTINE dia_wri_dimg(cd_name, cd_text, ptab, klev, cd_type , ksubi ) 
     50  SUBROUTINE dia_wri_dimg( cd_name, cd_text, ptab, klev, cd_type , ksubi ) 
    5651    !!------------------------------------------------------------------------- 
    5752    !!        *** ROUTINE dia_wri_dimg *** 
    5853    !! 
    59     !! ** Purpose : write ptab in the dimg file cd_name, with comment cd_text. 
    60     !!       ptab has klev x 2D fields 
     54    !! ** Purpose :   write ptab in the dimg file cd_name, with comment cd_text. 
     55    !!              ptab has klev x 2D fields 
    6156    !! 
    62     !! ** Action : 
    63     !!       Define header variables from the config parameters 
    64     !!       Open the dimg file on unit inum = 14 ( IEEE I4R4 file ) 
    65     !!       Write header on record 1 
    66     !!       Write ptab on the following klev records 
     57    !! ** Action :   Define header variables from the config parameters 
     58    !!               Open the dimg file on unit inum = 14 ( IEEE I4R4 file ) 
     59    !!               Write header on record 1 
     60    !!               Write ptab on the following klev records 
    6761    !! 
    68     !! History : 
    69     !!   03-12 (J.M. Molines ) : Original. Replace ctl_opn, writn2d 
     62    !! History :  2003-12 (J.M. Molines ) : Original. Replace ctl_opn, writn2d 
    7063    !!--------------------------------------------------------------------------- 
    71     !! * Arguments 
    7264    CHARACTER(len=*),INTENT(in) ::   & 
    7365         &                            cd_name,  &  ! dimg file name 
    … …  
    9183    CHARACTER(LEN=4) :: clver='@!01'           ! dimg string identifier 
    9284    !!--------------------------------------------------------------------------- 
     85 
     86    !                                      ! allocate dia_wri_dimg array 
     87    IF( dia_wri_dimg_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dia_wri_dimg : unable to allocate arrays' ) 
    9388 
    9489    !! * Initialisations 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90

    r2590 r2613  
    2121   USE phycst          ! physical constants 
    2222   USE in_out_manager  ! I/O manager 
     23   USE lib_mpp         ! MPP library 
    2324   USE iom             ! I/O library 
    2425 
    … …  
    2930   PUBLIC   dia_hth_alloc ! routine called by nemogcm.F90 
    3031 
    31    LOGICAL , PUBLIC, PARAMETER          ::   lk_diahth = .TRUE.   !: thermocline-20d depths flag 
     32   LOGICAL , PUBLIC, PARAMETER          ::   lk_diahth = .TRUE.    !: thermocline-20d depths flag 
    3233   ! note: following variables should move to local variables once iom_put is always used  
    33    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hth                  !: depth of the max vertical temperature gradient [m] 
    34    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hd20                 !: depth of 20 C isotherm                         [m] 
    35    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hd28                 !: depth of 28 C isotherm                         [m] 
    36    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   htc3                 !: heat content of first 300 m                    [W] 
     34   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hth    !: depth of the max vertical temperature gradient [m] 
     35   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hd20   !: depth of 20 C isotherm                         [m] 
     36   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hd28   !: depth of 28 C isotherm                         [m] 
     37   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   htc3   !: heat content of first 300 m                    [W] 
    3738 
    3839   !! * Substitutions 
    3940#  include "domzgr_substitute.h90" 
    4041   !!---------------------------------------------------------------------- 
    41    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     42   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    4243   !! $Id$  
    4344   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    4647 
    4748   FUNCTION dia_hth_alloc() 
    48      !!--------------------------------------------------------------------- 
    49       IMPLICIT none 
     49      !!--------------------------------------------------------------------- 
    5050      INTEGER :: dia_hth_alloc 
    51  
    52       ALLOCATE(hth(jpi,jpj), hd20(jpi,jpj), hd28(jpi,jpj), htc3(jpi,jpj), & 
    53                Stat=dia_hth_alloc) 
    54  
    55       IF(dia_hth_alloc /= 0)THEN 
    56          CALL ctl_warn('dia_hth_alloc: failed to allocate arrays.') 
    57       END IF 
     51      !!--------------------------------------------------------------------- 
     52      ! 
     53      ALLOCATE(hth(jpi,jpj), hd20(jpi,jpj), hd28(jpi,jpj), htc3(jpi,jpj), STAT=dia_hth_alloc) 
     54      ! 
     55      IF( lk_mpp           )   CALL mpp_sum ( dia_hth_alloc ) 
     56      IF(dia_hth_alloc /= 0)   CALL ctl_warn('dia_hth_alloc: failed to allocate arrays.') 
     57      ! 
    5858   END FUNCTION dia_hth_alloc 
    5959 
    … …  
    117117                     zmaxdzT(jpi,jpj), & 
    118118                     zthick(jpi,jpj),  & 
    119                      zdelr(jpi,jpj), Stat=ji) 
    120             IF(ji /= 0)THEN 
    121                WRITE(*,*) 'ERROR: allocation of arrays failed in dia_hth' 
    122                CALL mppabort() 
    123             END IF 
     119                     zdelr(jpi,jpj), STAT=ji) 
     120            IF( lk_mpp  )   CALL mpp_sum(ji) 
     121            IF( ji /= 0 )   CALL ctl_stop( 'STOP', 'dia_hth : unable to allocate standard ocean arrays' ) 
    124122         END IF 
    125123 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r2590 r2613  
    7575CONTAINS 
    7676 
    77   FUNCTION dia_wri_alloc() 
    78     !!---------------------------------------------------------------------- 
    79     IMPLICIT none 
    80     INTEGER :: dia_wri_alloc 
    81     INTEGER, DIMENSION(2) :: ierr 
    82     !!---------------------------------------------------------------------- 
    83      
    84     ierr = 0 
    85  
    86     ALLOCATE(ndex_hT(jpi*jpj), ndex_hU(jpi*jpj), ndex_hV(jpi*jpj), & 
    87              ndex_T(jpi*jpj*jpk), ndex_U(jpi*jpj*jpk), ndex_V(jpi*jpj*jpk), & 
    88              Stat=ierr(1)) 
    89  
    90     dia_wri_alloc = MAXVAL(ierr) 
    91  
     77   FUNCTION dia_wri_alloc() 
     78      !!---------------------------------------------------------------------- 
     79      IMPLICIT none 
     80      INTEGER :: dia_wri_alloc 
     81      INTEGER, DIMENSION(2) :: ierr 
     82      !!---------------------------------------------------------------------- 
     83      ! 
     84      ierr = 0 
     85      ! 
     86      ALLOCATE( ndex_hT(jpi*jpj) , ndex_T(jpi*jpj*jpk) ,     & 
     87         &      ndex_hU(jpi*jpj) , ndex_U(jpi*jpj*jpk) ,     & 
     88         &      ndex_hV(jpi*jpj) , ndex_V(jpi*jpj*jpk) , STAT=ierr(1) ) 
     89         ! 
     90      dia_wri_alloc = MAXVAL(ierr) 
     91      IF( lk_mpp )   CALL mpp_sum( ierr ) 
     92      ! 
    9293  END FUNCTION dia_wri_alloc 
    9394 
    … …  
    106107   !!   'key_iomput'                                        use IOM library 
    107108   !!---------------------------------------------------------------------- 
     109 
    108110   SUBROUTINE dia_wri( kt ) 
    109111      !!--------------------------------------------------------------------- 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DIA/diawri_dimg.h90

    r2590 r2613  
    6969    INTEGER ,INTENT(in) :: kt 
    7070    !! 
    71     INTEGER :: inbsel, jk 
    72     INTEGER :: iyear,imon,iday 
    73     INTEGER, SAVE :: nmoyct  
    74  
    7571#if defined key_diainstant 
    7672    LOGICAL, PARAMETER :: ll_dia_inst=.TRUE.  !: for instantaneous output 
    … …  
    7874    LOGICAL, PARAMETER :: ll_dia_inst=.FALSE. !: for average output 
    7975#endif 
    80  
    81     REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:,:,:) ::  um , vm   ! used to compute mean u, v fields 
    82     REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:,:,:) ::  wm        ! used to compute mean w fields 
    83     REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:,:,:) ::  avtm      ! used to compute mean kz fields 
    84     REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:,:,:) ::  tm , sm   ! used to compute mean t, s fields 
    85     REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:,:,:) ::  fsel      ! used to compute mean 2d fields 
     76    INTEGER              , SAVE                    ::  nmoyct  
     77    REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:,:,:) ::  um , vm, wm   ! mean u, v, w fields 
     78    REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:,:,:) ::  avtm          ! mean kz fields 
     79    REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:,:,:) ::  tm , sm       ! mean t, s fields 
     80    REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:,:,:) ::  fsel          ! mean 2d fields 
     81     
     82    INTEGER :: inbsel, jk 
     83    INTEGER :: iyear,imon,iday 
    8684    REAL(wp) :: zdtj 
    87     ! 
    8885    CHARACTER(LEN=80) :: clname 
    8986    CHARACTER(LEN=80) :: cltext 
    … …  
    260257       cltext=TRIM(cexper)//' U(m/s) '//TRIM(clmode) 
    261258       ! 
    262        IF( ll_dia_inst) THEN  
    263           CALL dia_wri_dimg(clname, cltext, un, jpk, 'T') 
    264  
    265        ELSE  
    266           CALL dia_wri_dimg(clname, cltext, um, jpk, 'T') 
     259       IF( ll_dia_inst) THEN   ;   CALL dia_wri_dimg(clname, cltext, un, jpk, 'T') 
     260       ELSE                    ;   CALL dia_wri_dimg(clname, cltext, um, jpk, 'T') 
    267261       ENDIF 
    268262 
Note: See TracChangeset for help on using the changeset viewer.