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 951 for branches/dev_001_GM/NEMO/OFF_SRC/IOM/iom_nf90.F90 – NEMO

Ignore:
Timestamp:
2008-05-14T18:42:10+02:00 (16 years ago)
Author:
cetlod
Message:

phasing the OFFLINE module to the new version of NEMO, see ticket 146

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/dev_001_GM/NEMO/OFF_SRC/IOM/iom_nf90.F90

    r719 r951  
    66   !! History :  9.0  ! 05 12  (J. Belier) Original code 
    77   !!            9.0  ! 06 02  (S. Masson) Adaptation to NEMO 
     8   !!             "   ! 07 07  (D. Storkey) Changes to iom_nf90_gettime 
    89   !!-------------------------------------------------------------------- 
    910   !!gm  caution add !DIR nec: improved performance to be checked as well as no result changes 
    … …  
    3637   !!---------------------------------------------------------------------- 
    3738   !!  OPA 9.0 , LOCEAN-IPSL (2006) 
    38    !! $Header$ 
     39   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/IOM/iom_nf90.F90,v 1.8 2007/06/29 14:10:50 opalod Exp $ 
    3940   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4041   !!---------------------------------------------------------------------- 
    … …  
    4849      !! ** Purpose : open an input file with NF90 
    4950      !!--------------------------------------------------------------------- 
    50       CHARACTER(len=*)       , INTENT(inout) ::   cdname    ! File name 
    51       INTEGER                , INTENT(  out) ::   kiomid    ! nf90 identifier of the opened file 
    52       LOGICAL                , INTENT(in   ) ::   ldwrt     ! read or write the file? 
    53       LOGICAL                , INTENT(in   ) ::   ldok      ! check the existence  
    54       INTEGER, DIMENSION(2,5), INTENT(in   ) ::   kdompar   ! domain parameters:  
     51      CHARACTER(len=*)       , INTENT(inout)           ::   cdname    ! File name 
     52      INTEGER                , INTENT(  out)           ::   kiomid    ! nf90 identifier of the opened file 
     53      LOGICAL                , INTENT(in   )           ::   ldwrt     ! read or write the file? 
     54      LOGICAL                , INTENT(in   )           ::   ldok      ! check the existence  
     55      INTEGER, DIMENSION(2,5), INTENT(in   ), OPTIONAL ::   kdompar   ! domain parameters:  
    5556 
    5657      CHARACTER(LEN=100) ::   clinfo   ! info character 
    … …  
    6061      INTEGER            ::   if90id   ! nf90 identifier of the opened file 
    6162      INTEGER            ::   idmy     ! dummy variable 
     63      INTEGER            ::   jl       ! loop variable 
    6264      !--------------------------------------------------------------------- 
    6365 
    … …  
    103105            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_type'           , 'BOX'              ), clinfo) 
    104106         ELSE              ! the file should be open for read mode so it must exist... 
    105             CALL ctl_stop( TRIM(clinfo), 'File '//cdname(1:iln-1)//'* not found' ) 
     107            CALL ctl_stop( TRIM(clinfo), ' should be impossible case...' ) 
    106108         ENDIF 
    107109      ENDIF 
    … …  
    109111      ! ============= 
    110112      IF( istop == nstop ) THEN   ! no error within this routine 
    111          kiomid = MINLOC(iom_file(:)%nfid, dim = 1) 
     113!does not work with some compilers         kiomid = MINLOC(iom_file(:)%nfid, dim = 1) 
     114         kiomid = 0 
     115         DO jl = jpmax_files, 1, -1 
     116            IF( iom_file(jl)%nfid == 0 )   kiomid = jl 
     117         ENDDO 
    112118         iom_file(kiomid)%name   = TRIM(cdname) 
    113119         iom_file(kiomid)%nfid   = if90id 
    … …  
    116122         iom_file(kiomid)%irec   = -1   ! useless for NetCDF files, used to know if the file is in define mode  
    117123         CALL iom_nf90_check(NF90_Inquire(if90id, unlimitedDimId = iom_file(kiomid)%iduld), clinfo) 
     124         IF ( iom_file(kiomid)%iduld .GE. 0 ) THEN 
     125           CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, iom_file(kiomid)%iduld,   & 
     126        &                                               name = iom_file(kiomid)%uldname), clinfo) 
     127         ENDIF 
    118128         IF(lwp) WRITE(numout,*) '                   ---> '//TRIM(cdname)//' OK' 
    119129      ELSE 
    … …  
    174184         iom_file(kiomid)%ndims(kiv)  = i_nvd 
    175185         CALL iom_nf90_check(NF90_Inquire_Variable(if90id, ivarid, dimids = idimid(1:i_nvd)), clinfo)   ! dimensions ids 
    176          DO ji = 1, i_nvd   ! dimensions size 
     186         iom_file(kiomid)%luld(kiv) = .FALSE.   ! default value 
     187         DO ji = 1, i_nvd                       ! dimensions size 
    177188            CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, idimid(ji), len = iom_file(kiomid)%dimsz(ji,kiv)), clinfo)    
    178189            IF( idimid(ji) == iom_file(kiomid)%iduld ) iom_file(kiomid)%luld(kiv) = .TRUE.   ! unlimited dimension?  
    179190         END DO 
    180          !---------- Deal with scale_factor and offset 
     191         !---------- Deal with scale_factor and add_offset 
    181192         llok = NF90_Inquire_attribute(if90id, ivarid, 'scale_factor') == nf90_noerr 
    182193         IF( llok) THEN 
    … …  
    185196            iom_file(kiomid)%scf(kiv) = 1. 
    186197         END IF 
    187          llok = NF90_Inquire_attribute(if90id, ivarid, 'offset') == nf90_noerr 
     198         llok = NF90_Inquire_attribute(if90id, ivarid, 'add_offset') == nf90_noerr 
    188199         IF( llok ) THEN 
    189             CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, 'offset', iom_file(kiomid)%ofs(kiv)), clinfo) 
     200            CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, 'add_offset', iom_file(kiomid)%ofs(kiv)), clinfo) 
    190201         ELSE 
    191202            iom_file(kiomid)%ofs(kiv) = 0. 
    … …  
    200211            ENDIF 
    201212         ENDIF 
    202 !!$                  ELSE   
    203 !!$                     CALL ctl_warn( trim(clinfo), 'Variable '//trim(cdvar)// & 
    204 !!$                        &                         ' is not found in the file '//trim(iom_file(kiomid)%name) ) 
     213      ELSE   
     214         iom_nf90_varid = -1   !   variable not found, return error code: -1 
    205215      ENDIF 
    206216      ! 
    … …  
    226236 
    227237 
    228    SUBROUTINE iom_nf90_g123d( kiomid, kdom, kvid, knbdim, kstart, kcount,    & 
    229          &                          pv_r1d, pv_r2d, pv_r3d) 
     238   SUBROUTINE iom_nf90_g123d( kiomid, kvid, knbdim, kstart, kcount, kx1, kx2, ky1, ky2,   & 
     239         &                    pv_r1d, pv_r2d, pv_r3d ) 
    230240      !!----------------------------------------------------------------------- 
    231241      !!                  ***  ROUTINE  iom_nf90_g123d  *** 
    … …  
    236246      !!----------------------------------------------------------------------- 
    237247      INTEGER                    , INTENT(in   )           ::   kiomid    ! iom identifier of the file 
    238       INTEGER                    , INTENT(in   )           ::   kdom      ! Type of domain to be read 
    239248      INTEGER                    , INTENT(in   )           ::   kvid      ! Name of the variable 
    240249      INTEGER                    , INTENT(in   )           ::   knbdim    ! number of dimensions of the variable 
    241250      INTEGER , DIMENSION(:)     , INTENT(in   )           ::   kstart    ! start position of the reading in each axis  
    242251      INTEGER , DIMENSION(:)     , INTENT(in   )           ::   kcount    ! number of points to be read in each axis 
     252      INTEGER ,                    INTENT(in   )           ::   kx1, kx2, ky1, ky2   ! subdomain indexes 
    243253      REAL(wp), DIMENSION(:)     , INTENT(  out), OPTIONAL ::   pv_r1d    ! read field (1D case) 
    244254      REAL(wp), DIMENSION(:,:)   , INTENT(  out), OPTIONAL ::   pv_r2d    ! read field (2D case) 
    245255      REAL(wp), DIMENSION(:,:,:) , INTENT(  out), OPTIONAL ::   pv_r3d    ! read field (3D case) 
    246256      ! 
    247       CHARACTER(LEN=100) ::   clinfo   ! info character 
    248       INTEGER            ::   if90id   ! nf90 identifier of the opened file 
    249       INTEGER            ::   ivid     ! nf90 variable id 
     257      CHARACTER(LEN=100) ::   clinfo               ! info character 
     258      INTEGER            ::   if90id               ! nf90 identifier of the opened file 
     259      INTEGER            ::   ivid                 ! nf90 variable id 
    250260      !--------------------------------------------------------------------- 
    251261      clinfo = 'iom_nf90_g123d , file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(iom_file(kiomid)%cn_var(kvid)) 
    252262      if90id = iom_file(kiomid)%nfid         ! get back NetCDF file id 
    253263      ivid   = iom_file(kiomid)%nvid(kvid)   ! get back NetCDF var id 
    254       IF( PRESENT(pv_r1d) ) THEN 
    255          CALL iom_nf90_check(NF90_GET_VAR(if90id, ivid, pv_r1d(:), start=kstart(1:knbdim), count=kcount(1:knbdim)), clinfo ) 
     264      ! 
     265      IF(     PRESENT(pv_r1d) ) THEN 
     266         CALL iom_nf90_check( NF90_GET_VAR(if90id, ivid, pv_r1d(:                ), start = kstart(1:knbdim),   & 
     267            &                                                                       count = kcount(1:knbdim)), clinfo ) 
    256268      ELSEIF( PRESENT(pv_r2d) ) THEN 
    257          IF( kdom /= jpdom_unknown ) THEN 
    258             CALL iom_nf90_check(NF90_GET_VAR(if90id, ivid, pv_r2d(nldi:nlei,nldj:nlej),   & 
    259                   &                           start=kstart(1:knbdim), count=kcount(1:knbdim)), clinfo) 
    260             !--- Fill the overlap areas and extra hallows (mpp) 
    261             CALL lbc_lnk (pv_r2d,'Z',-999.,'no0') 
    262          ELSE 
    263             CALL iom_nf90_check(NF90_GET_VAR(if90id, ivid, pv_r2d(:,:), start=kstart(1:knbdim), count=kcount(1:knbdim)), clinfo) 
    264          ENDIF 
     269         CALL iom_nf90_check( NF90_GET_VAR(if90id, ivid, pv_r2d(kx1:kx2,ky1:ky2  ), start = kstart(1:knbdim),   & 
     270            &                                                                       count = kcount(1:knbdim)), clinfo ) 
    265271      ELSEIF( PRESENT(pv_r3d) ) THEN 
    266          IF( kdom /= jpdom_unknown ) THEN 
    267             CALL iom_nf90_check(NF90_GET_VAR(if90id, ivid, pv_r3d(nldi:nlei,nldj:nlej,:),   & 
    268                   &                           start=kstart(1:knbdim), count=kcount  (1:knbdim)), clinfo) 
    269             !--- Fill the overlap areas and extra hallows (mpp) 
    270             ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension 
    271             IF( kcount(3) == jpk ) THEN 
    272                CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' ) 
    273             ELSE   ! put some arbitrary value (a call to lbc_lnk will be done later...) 
    274                pv_r3d(nlei+1:jpi,      :   ,:) = 1.             
    275                pv_r3d(      :   ,nlej+1:jpj,:) = 1.             
    276             ENDIF 
    277          ELSE 
    278             CALL iom_nf90_check(NF90_GET_VAR(if90id, ivid, pv_r3d(:,:,:),   & 
    279                   &                           start=kstart(1:knbdim), count=kcount  (1:knbdim)), clinfo) 
    280          ENDIF 
     272         CALL iom_nf90_check( NF90_GET_VAR(if90id, ivid, pv_r3d(kx1:kx2,ky1:ky2,:), start = kstart(1:knbdim),   & 
     273            &                                                                       count = kcount(1:knbdim)), clinfo ) 
    281274      ENDIF 
    282275      ! 
    … …  
    284277 
    285278 
    286    SUBROUTINE iom_nf90_gettime( kiomid, kvid, ptime ) 
     279   SUBROUTINE iom_nf90_gettime( kiomid, kvid, ptime, cdunits, cdcalendar ) 
    287280      !!-------------------------------------------------------------------- 
    288281      !!                   ***  SUBROUTINE iom_gettime  *** 
    … …  
    290283      !! ** Purpose : read the time axis kvid in the file with NF90 
    291284      !!-------------------------------------------------------------------- 
    292       INTEGER               , INTENT(in   ) ::   kiomid   ! file Identifier 
    293       INTEGER               , INTENT(in   ) ::   kvid     ! variable id 
    294       REAL(wp), DIMENSION(:), INTENT(  out) ::   ptime    ! the time axis 
     285      INTEGER                   , INTENT(in   ) ::   kiomid     ! file Identifier 
     286      INTEGER                   , INTENT(in   ) ::   kvid       ! variable id 
     287      REAL(wp), DIMENSION(:)    , INTENT(  out) ::   ptime      ! the time axis 
     288      CHARACTER(len=*), OPTIONAL, INTENT(  out) ::   cdunits    ! units attribute 
     289      CHARACTER(len=*), OPTIONAL, INTENT(  out) ::   cdcalendar ! calendar attribute 
    295290      ! 
    296291      CHARACTER(LEN=100) ::   clinfo     ! info character 
    … …  
    299294      CALL iom_nf90_check(NF90_GET_VAR(iom_file(kiomid)%nfid, iom_file(kiomid)%nvid(kvid), ptime(:),   & 
    300295            &                           start=(/ 1 /), count=(/ iom_file(kiomid)%dimsz(1, kvid) /)), clinfo) 
     296      IF ( PRESENT(cdunits) ) THEN  
     297         CALL iom_nf90_check(NF90_GET_ATT(iom_file(kiomid)%nfid, iom_file(kiomid)%nvid(kvid), "units", & 
     298            &                           values=cdunits), clinfo) 
     299      ENDIF 
     300      IF ( PRESENT(cdcalendar) ) THEN  
     301         CALL iom_nf90_check(NF90_GET_ATT(iom_file(kiomid)%nfid, iom_file(kiomid)%nvid(kvid), "calendar", & 
     302            &                           values=cdcalendar), clinfo) 
     303      ENDIF 
    301304      ! 
    302305   END SUBROUTINE iom_nf90_gettime 
    … …  
    355358         iom_file(kiomid)%cn_var(1:4) = cltmp 
    356359         iom_file(kiomid)%ndims(1:4)  = (/ 2, 2, 1, 1 /)   
    357          CALL iom_nf90_check(NF90_INQUIRE_DIMENSION( if90id, 1, len = iom_file(kiomid)%dimsz(1,1) ), clinfo) 
    358          CALL iom_nf90_check(NF90_INQUIRE_DIMENSION( if90id, 2, len = iom_file(kiomid)%dimsz(2,1) ), clinfo) 
    359          iom_file(kiomid)%dimsz(1:2, 2) = iom_file(kiomid)%dimsz(1:2, 1) 
    360          CALL iom_nf90_check(NF90_INQUIRE_DIMENSION( if90id, 3, len = iom_file(kiomid)%dimsz(1,3) ), clinfo) 
    361          iom_file(kiomid)%dimsz(1  , 4) = 1   ! unlimited dimension 
     360         ! trick: defined to 0 to say that dimension variables are defined but not yet written 
     361         iom_file(kiomid)%dimsz(1, 1)  = 0    
    362362         IF(lwp) WRITE(numout,*) TRIM(clinfo)//' define dimension variables done' 
    363363      ENDIF 
    … …  
    433433            ! write dimension variables if it is not already done 
    434434            ! ============= 
     435            ! trick: is defined to 0 => dimension variable are defined but not yet written 
    435436            IF( iom_file(kiomid)%dimsz(1, 1) == 0 ) THEN 
    436437               CALL iom_nf90_check(NF90_INQ_VARID( if90id, 'nav_lon'     , idmy ), clinfo) 
    … …  
    443444               CALL iom_nf90_check(NF90_INQ_VARID( if90id, 'time_counter', idmy ), clinfo) 
    444445               CALL iom_nf90_check(NF90_PUT_VAR( if90id, idmy, kt                      ), clinfo)    
     446               ! update the values of the variables dimensions size 
     447               CALL iom_nf90_check(NF90_INQUIRE_DIMENSION( if90id, 1, len = iom_file(kiomid)%dimsz(1,1) ), clinfo) 
     448               CALL iom_nf90_check(NF90_INQUIRE_DIMENSION( if90id, 2, len = iom_file(kiomid)%dimsz(2,1) ), clinfo) 
     449               iom_file(kiomid)%dimsz(1:2, 2) = iom_file(kiomid)%dimsz(1:2, 1) 
     450               CALL iom_nf90_check(NF90_INQUIRE_DIMENSION( if90id, 3, len = iom_file(kiomid)%dimsz(1,3) ), clinfo) 
     451               iom_file(kiomid)%dimsz(1  , 4) = 1   ! unlimited dimension 
    445452               IF(lwp) WRITE(numout,*) TRIM(clinfo)//' write dimension variables done' 
    446453            ENDIF 
Note: See TracChangeset for help on using the changeset viewer.