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 4187 – NEMO

Changeset 4187


Ignore:
Timestamp:
2013-11-13T16:56:06+01:00 (10 years ago)
Author:
cetlod
Message:

dev_LOCEAN_2013 : minor update to improve compilation of ORCA2_LIM_AGRIF

Location:
branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/OPA_SRC
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/OPA_SRC/CRS/crsdomwri.F90

    r4064 r4187  
    66   !!            8.1  ! 1999-11  (M. Imbard)  NetCDF FORMAT with IOIPSL 
    77   !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90 and several file 
    8    !!            3.0  ! 2008-01  (S. Masson) add dom_uniq 
     8   !!            3.0  ! 2008-01  (S. Masson) add dom_uniq_crs 
    99   !!            4.0  ! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation 
    1010   !!                 ! 2012-06  (J. Simeon, C. Calone, C Ethe )  Reduced and modified for coarse grid 
     
    2424   USE crsdom         ! coarse grid domain 
    2525   USE crslbclnk       ! crs mediator to lbclnk 
     26   USE wrk_nemo        ! Working array 
    2627 
    2728 
     
    6465      INTEGER           ::   ji, jj, jk   ! dummy loop indices 
    6566      !                                   !  workspaces 
    66       REAL(wp), ALLOCATABLE, DIMENSION(:,:  ) :: zprt, zprw  
    67       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zdepu, zdepv 
    68       REAL(wp), ALLOCATABLE, DIMENSION(:,:  ) :: ze3tp, ze3wp 
     67      REAL(wp), POINTER, DIMENSION(:,:  ) :: zprt, zprw  
     68      REAL(wp), POINTER, DIMENSION(:,:,:) :: zdepu, zdepv 
     69      REAL(wp), POINTER, DIMENSION(:,:  ) :: ze3tp, ze3wp 
    6970      !!---------------------------------------------------------------------- 
    7071      ! 
    7172      IF( nn_timing == 1 )  CALL timing_start('crs_dom_wri') 
    7273      ! 
    73       ALLOCATE( zprt  (jpi_crs,jpj_crs)   , zprw(jpi_crs,jpj_crs) ) 
    74       ALLOCATE( zdepu(jpi_crs,jpj_crs,jpk), zdepv(jpi_crs,jpj_crs,jpk) ) 
    75       ALLOCATE( ze3tp(jpi_crs,jpj_crs)    , ze3wp(jpi_crs,jpj_crs) ) 
     74      CALL wrk_alloc( jpi_crs, jpj_crs,      zprt , zprw ) 
     75      CALL wrk_alloc( jpi_crs, jpj_crs,      ze3tp, ze3wp ) 
     76      CALL wrk_alloc( jpi_crs, jpj_crs, jpk, zdepu, zdepv ) 
    7677 
    7778      ze3tp(:,:) = 0.0 
     
    155156      ENDIF 
    156157       
    157  !     CALL iom_rstput( 0, 0, inum2, 'tpol', pv_r2d=tpol_crs, ktype = jp_i1 )   
    158  !     CALL iom_rstput( 0, 0, inum2, 'fpol', pv_r2d=fpol_crs, ktype = jp_i1 )   
    159  
    160       !!! 
    161158      CALL iom_rstput( 0, 0, inum2, 'tmaskutil', tmask_i_crs, ktype = jp_i1 ) 
    162159                                   !    ! unique point mask 
    163       CALL dom_uniq( zprw, 'U' ) 
     160      CALL dom_uniq_crs( zprw, 'U' ) 
    164161      zprt = umask_crs(:,:,1) * zprw 
    165162      CALL iom_rstput( 0, 0, inum2, 'umaskutil', zprt, ktype = jp_i1 )   
    166       CALL dom_uniq( zprw, 'V' ) 
     163      CALL dom_uniq_crs( zprw, 'V' ) 
    167164      zprt = vmask_crs(:,:,1) * zprw 
    168165      CALL iom_rstput( 0, 0, inum2, 'vmaskutil', zprt, ktype = jp_i1 )   
    169       CALL dom_uniq( zprw, 'F' ) 
     166      CALL dom_uniq_crs( zprw, 'F' ) 
    170167      zprt = fmask_crs(:,:,1) * zprw 
    171168      CALL iom_rstput( 0, 0, inum2, 'fmaskutil', zprt, ktype = jp_i1 )   
     
    296293      END SELECT 
    297294      ! 
    298       ! 
    299       DEALLOCATE( zprt  , zprw ) 
    300       DEALLOCATE( zdepu , zdepv ) 
    301       DEALLOCATE( ze3tp , ze3wp ) 
     295      CALL wrk_dealloc( jpi_crs, jpj_crs,      zprt , zprw  ) 
     296      CALL wrk_dealloc( jpi_crs, jpj_crs,      ze3tp, ze3wp ) 
     297      CALL wrk_dealloc( jpi_crs, jpj_crs, jpk, zdepu, zdepv ) 
    302298      ! 
    303299      IF( nn_timing == 1 )  CALL timing_stop('crs_dom_wri') 
     
    307303 
    308304 
    309    SUBROUTINE dom_uniq( puniq, cdgrd ) 
    310       !!---------------------------------------------------------------------- 
    311       !!                  ***  ROUTINE crs_dom_uniq  *** 
     305   SUBROUTINE dom_uniq_crs( puniq, cdgrd ) 
     306      !!---------------------------------------------------------------------- 
     307      !!                  ***  ROUTINE crs_dom_uniq_crs  *** 
    312308      !!                    
    313309      !! ** Purpose :   identify unique point of a grid (TUVF) 
     
    323319      INTEGER  ::  ji       ! dummy loop indices 
    324320      LOGICAL, DIMENSION(SIZE(puniq,1),SIZE(puniq,2),1) ::  lldbl  ! store whether each point is unique or not 
    325 !      REAL(wp), POINTER, DIMENSION(:,:) :: ztstref 
    326       REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ztstref 
    327       !!---------------------------------------------------------------------- 
    328       ! 
    329       IF( nn_timing == 1 )  CALL timing_start('crs_dom_uniq') 
    330       ! 
    331 !      CALL wrk_alloc( jpi_crs, jpj_crs, ztstref ) 
    332       ALLOCATE( ztstref(jpi_crs,jpj_crs) ) 
     321      REAL(wp), POINTER, DIMENSION(:,:) :: ztstref 
     322      !!---------------------------------------------------------------------- 
     323      ! 
     324      IF( nn_timing == 1 )  CALL timing_start('crs_dom_uniq_crs') 
     325      ! 
     326      CALL wrk_alloc( jpi_crs, jpj_crs, ztstref ) 
    333327      ! 
    334328      ! build an array with different values for each element  
     
    346340      puniq(nldi_crs:nlei_crs,nldj_crs:nlej_crs) = REAL( COUNT( lldbl(nldi_crs:nlei_crs,nldj_crs:nlej_crs,:), dim = 3 ) , wp ) 
    347341      ! 
    348 !      CALL wrk_dealloc( jpi_crs, jpj_crs, ztstref ) 
    349  
    350       DEALLOCATE( ztstref ) 
    351       ! 
    352       IF( nn_timing == 1 )  CALL timing_stop('crs_dom_uniq') 
    353       ! 
    354        
    355    END SUBROUTINE dom_uniq 
     342      CALL wrk_dealloc( jpi_crs, jpj_crs, ztstref ) 
     343      ! 
     344      IF( nn_timing == 1 )  CALL timing_stop('crs_dom_uniq_crs') 
     345      ! 
     346       
     347   END SUBROUTINE dom_uniq_crs 
    356348 
    357349   !!====================================================================== 
  • branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r4161 r4187  
    3131   USE sbc_oce, ONLY :   nn_fsbc         ! ocean space and time domain 
    3232   USE trc_oce, ONLY :   nn_dttrc        !  !: frequency of step on passive tracers 
    33    USE icb_oce, ONLY :   class_num       !  !: iceberg classes 
     33   USE icb_oce, ONLY :   nclasses, class_num       !  !: iceberg classes 
    3434   USE domngb          ! ocean space and time domain 
    3535   USE phycst          ! physical constants 
     
    406406 
    407407 
    408    FUNCTION iom_varid ( kiomid, cdvar, kdimsz, kndims, ldstop )   
     408   FUNCTION iom_varid ( kiomid, cdvar, kdimsz, ldstop )   
    409409      !!----------------------------------------------------------------------- 
    410410      !!                  ***  FUNCTION  iom_varid  *** 
     
    415415      CHARACTER(len=*)     , INTENT(in   )           ::   cdvar    ! name of the variable 
    416416      INTEGER, DIMENSION(:), INTENT(  out), OPTIONAL ::   kdimsz   ! size of the dimensions 
    417       INTEGER,               INTENT(  out), OPTIONAL ::   kndims   ! size of the dimensions 
    418417      LOGICAL              , INTENT(in   ), OPTIONAL ::   ldstop   ! stop if looking for non-existing variable (default = .TRUE.) 
    419418      ! 
     
    447446                  SELECT CASE (iom_file(kiomid)%iolib) 
    448447                  CASE (jpioipsl )   ;   iom_varid = iom_ioipsl_varid( kiomid, cdvar, iiv, kdimsz ) 
    449                   CASE (jpnf90   )   ;   iom_varid = iom_nf90_varid  ( kiomid, cdvar, iiv, kdimsz, kndims ) 
     448                  CASE (jpnf90   )   ;   iom_varid = iom_nf90_varid  ( kiomid, cdvar, iiv, kdimsz ) 
    450449                  CASE (jprstdimg)   ;   iom_varid = -1   ! all variables are listed in iom_file 
    451450                  CASE DEFAULT    
     
    468467                  ENDIF 
    469468               ENDIF 
    470                IF( PRESENT(kndims) )  kndims = iom_file(kiomid)%ndims(iiv) 
    471469            ENDIF 
    472470         ENDIF 
Note: See TracChangeset for help on using the changeset viewer.